From bab072f950a643ac109660a223b57e635492ac25 Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Wed, 14 Feb 2018 07:03:37 +0100 Subject: [PATCH] Twenex Muddle. --- /_chkdcl.temp.1 | Bin 0 -> 54048 bytes /_clr.ev.1 | Bin 0 -> 1117 bytes /_clr.opcodes.1 | Bin 0 -> 4670 bytes /_clr.opcodes.2 | Bin 0 -> 4847 bytes /_clr.rmode.1 | Bin 0 -> 95631 bytes /agc.bin.16 | Bin 0 -> 40834 bytes /agc.bin.21 | Bin 0 -> 41134 bytes /agc.mid.131 | 3601 +++++++++++++++++++++++++++ /agc.mid.139 | 3632 +++++++++++++++++++++++++++ /agc.mid.140 | 3632 +++++++++++++++++++++++++++ /agc.mid.141 | 3634 +++++++++++++++++++++++++++ /agcmrk.bin.3 | Bin 0 -> 185 bytes /agcmrk.mid.1 | 14 + /amsgc.bin.12 | Bin 0 -> 14090 bytes /amsgc.mid.107 | 865 +++++++ /amsgc.mid.108 | 886 +++++++ /amsgc.mid.109 | 886 +++++++ /amsgc.mid.110 | 887 +++++++ /arith.bin.4 | Bin 0 -> 28945 bytes /arith.mid.94 | 856 +++++++ /assem.all.7 | 115 + /atomhk.bin.6 | Bin 0 -> 26260 bytes /atomhk.bin.7 | Bin 0 -> 26280 bytes /atomhk.mid.144 | 1185 +++++++++ /atomhk.mid.149 | 1193 +++++++++ /atomhk.mid.150 | 1198 +++++++++ /bufmod.bin.2 | Bin 0 -> 250 bytes /bufmod.mid.4 | 18 + /chess.script.1 | 171 ++ /chkdcl.mud.2 | 1319 ++++++++++ /chkdcl.nbin.2 | Bin 0 -> 72869 bytes /const.bin.4 | Bin 0 -> 390 bytes /const.mid.5 | 26 + /core.bin.4 | Bin 0 -> 7520 bytes /core.mid.13 | 145 ++ /create.bin.3 | Bin 0 -> 15860 bytes /create.mid.40 | 376 +++ /decl.bin.3 | Bin 0 -> 37399 bytes /decl.mid.102 | 1064 ++++++++ /decl.mid.103 | 1091 +++++++++ /ecagc.bin.1 | 0 /eval.bin.13 | Bin 0 -> 76577 bytes /eval.bin.14 | Bin 0 -> 76620 bytes /eval.mid.122 | 4211 ++++++++++++++++++++++++++++++++ /eval.mid.123 | 4217 ++++++++++++++++++++++++++++++++ /eval.mid.124 | 4245 ++++++++++++++++++++++++++++++++ /eval.mid.125 | 4245 ++++++++++++++++++++++++++++++++ /first.cmd.2 | 84 + /fopen.bin.16 | Bin 0 -> 60804 bytes /fopen.bin.22 | Bin 0 -> 61564 bytes /fopen.mid.35 | 4538 ++++++++++++++++++++++++++++++++++ /fopen.mid.54 | 4686 +++++++++++++++++++++++++++++++++++ /fopen.mid.56 | 4686 +++++++++++++++++++++++++++++++++++ /fopen.mid.57 | 4703 +++++++++++++++++++++++++++++++++++ /fopen.mid.58 | 4703 +++++++++++++++++++++++++++++++++++ /fopen.mid.59 | 4703 +++++++++++++++++++++++++++++++++++ /fopen.mid.60 | 4712 +++++++++++++++++++++++++++++++++++ /fopen.mid.61 | 4715 +++++++++++++++++++++++++++++++++++ /fopen.mid.62 | 4722 ++++++++++++++++++++++++++++++++++++ /gcgdgl.mud.1 | 186 ++ /gcgdgl.nbin.1 | Bin 0 -> 11173 bytes /gcgld.mud.1 | 0 /gchack.bin.2 | Bin 0 -> 7139 bytes /gchack.bin.3 | Bin 0 -> 7210 bytes /gchack.mid.45 | 538 ++++ /gchack.mid.46 | 540 +++++ /initm.bin.17 | Bin 0 -> 57661 bytes /initm.mid.371 | 1360 +++++++++++ /initm.mid.373 | 1360 +++++++++++ /interr.bin.28 | Bin 0 -> 65510 bytes /interr.bin.30 | Bin 0 -> 65699 bytes /interr.mid.419 | 2890 ++++++++++++++++++++++ /interr.mid.425 | 2898 ++++++++++++++++++++++ /ipc.bin.2 | Bin 0 -> 16110 bytes /ipc.mid.19 | 815 +++++++ /ldgc.bin.11 | Bin 0 -> 9880 bytes /ldgc.mid.100 | 504 ++++ /main.bin.9 | Bin 0 -> 97590 bytes /main.mid.350 | 2056 ++++++++++++++++ /main.mid.351 | 2058 ++++++++++++++++ /main.mid.352 | 2058 ++++++++++++++++ /mappur.bin.34 | Bin 0 -> 21455 bytes /mappur.bin.37 | Bin 0 -> 21600 bytes /mappur.mid.146 | 1928 +++++++++++++++ /mappur.mid.159 | 1972 +++++++++++++++ /mappur.mid.160 | 1974 +++++++++++++++ /mappur.mid.161 | 1975 +++++++++++++++ /mappur.mid.162 | 1986 +++++++++++++++ /maps.bin.2 | Bin 0 -> 8690 bytes /maps.mid.29 | 247 ++ /mdl106.agc.1 | Bin 0 -> 35840 bytes /mdl106.agc.2 | Bin 0 -> 35840 bytes /mdl106.dec.1 | Bin 0 -> 20480 bytes /mdl106.dec.2 | Bin 0 -> 20480 bytes /mdl106.exe.2 | Bin 0 -> 207353 bytes /mdl106.exe.3 | Bin 0 -> 250865 bytes /mdl106.exe.4 | Bin 0 -> 207353 bytes /mdl106.exe.5 | Bin 0 -> 273893 bytes /mdl106.sec.1 | Bin 0 -> 20480 bytes /mdl106.sec.2 | Bin 0 -> 20480 bytes /mdl106.sgc.1 | Bin 0 -> 5120 bytes /mdl106.sgc.2 | Bin 0 -> 5120 bytes /mdl106.symbols.1 | Bin 0 -> 127947 bytes /mdl106.symbols.2 | Bin 0 -> 127947 bytes /mdlxxx.exe.1 | Bin 0 -> 220820 bytes /mdlxxx.exe.2 | Bin 0 -> 250865 bytes /mdlxxx.symbols.1 | Bin 0 -> 127942 bytes /midas.bin.3 | 0 /midas.exe.5 | Bin 0 -> 48636 bytes /midas.symbols.2 | Bin 0 -> 19492 bytes /mud105.stink.10 | 35 + /muddle.mid.346 | 1254 ++++++++++ /mudex.bin.34 | Bin 0 -> 20435 bytes /mudex.bin.38 | Bin 0 -> 20625 bytes /mudex.mid.177 | 1025 ++++++++ /mudex.mid.183 | 1053 ++++++++ /mudits.mcr130.1 | 566 +++++ /mudits.mid.131 | 570 +++++ /mudsqu.bin.6 | Bin 0 -> 3745 bytes /mudsqu.mcr025.1 | 138 ++ /mudsqu.mid.28 | 181 ++ /mudxxx.stink.2 | 34 + /mymode.teco.1 | Bin 0 -> 4961 bytes /nfopen.bin.2 | Bin 0 -> 60168 bytes /nfopen.mid.4 | 4481 ++++++++++++++++++++++++++++++++++ /nfree.bin.5 | Bin 0 -> 4610 bytes /nfree.mcr052.1 | 276 +++ /nfree.mid.53 | 281 +++ /oreadch.mid.208 | 1433 +++++++++++ /primit.bin.5 | Bin 0 -> 51990 bytes /primit.mid.315 | 2822 +++++++++++++++++++++ /primit.mid.316 | 2830 +++++++++++++++++++++ /print.bin.11 | Bin 0 -> 39308 bytes /print.bin.9 | Bin 0 -> 39240 bytes /print.mid.340 | 2692 ++++++++++++++++++++ /print.mid.346 | 2711 +++++++++++++++++++++ /pure.bin.5 | Bin 0 -> 210 bytes /pure.mid.15 | 24 + /putget.bin.3 | Bin 0 -> 8920 bytes /putget.mid.51 | 397 +++ /pxcore.bin.2 | Bin 0 -> 2445 bytes /pxcore.mid.9 | 77 + /readch.bin.12 | Bin 0 -> 20490 bytes /readch.bin.16 | Bin 0 -> 19815 bytes /readch.mid.206 | 1448 +++++++++++ /readch.mid.210 | 1405 +++++++++++ /readch.mid.211 | 1405 +++++++++++ /readch.mid.212 | 1407 +++++++++++ /readch.mid.213 | 1408 +++++++++++ /readch.mid.214 | 1407 +++++++++++ /reader.bin.10 | Bin 0 -> 45165 bytes /reader.mid.353 | 2201 +++++++++++++++++ /reader.mid.355 | 2202 +++++++++++++++++ /reader.mid.356 | 2203 +++++++++++++++++ /reader.mid.357 | 2203 +++++++++++++++++ /save.bin.13 | Bin 0 -> 15643 bytes /save.bin.9 | Bin 0 -> 15678 bytes /save.mid.169 | 774 ++++++ /save.mid.174 | 790 ++++++ /save.mid.175 | 792 ++++++ /save.mid.176 | 799 ++++++ /secagc.bin.32 | Bin 0 -> 33545 bytes /secagc.mid.80 | 2288 +++++++++++++++++ /secagc.mid.81 | 2290 +++++++++++++++++ /second.cmd.10 | 22 + /specs.bin.7 | Bin 0 -> 31730 bytes /specs.mid.110 | 345 +++ /specs.mid.111 | 347 +++ /stbuil.bin.10 | Bin 0 -> 38675 bytes /stbuil.mid.15 | 2132 ++++++++++++++++ /stbuil.mid.16 | 2132 ++++++++++++++++ /stbuil.mid.17 | 2133 ++++++++++++++++ /stbuil.mid.18 | 2133 ++++++++++++++++ /stbuil.mid.19 | 2145 ++++++++++++++++ /stbuil.mid.20 | 2145 ++++++++++++++++ /stenex.mid.11 | 604 +++++ /stink.exe.13 | Bin 0 -> 17920 bytes /stink.mid.1 | 3424 ++++++++++++++++++++++++++ /stink.symbols.4 | Bin 0 -> 10496 bytes /symbol.cmd.4 | 95 + /tmudv.bin.1 | 0 /tmudv.mid.1 | 50 + /txpure.bin.2 | Bin 0 -> 200 bytes /txpure.mid.3 | 23 + /utilit.bin.15 | Bin 0 -> 14775 bytes /utilit.bin.16 | Bin 0 -> 14785 bytes /utilit.mid.103 | 829 +++++++ /utilit.mid.104 | 830 +++++++ /utilit.mid.105 | 830 +++++++ /uuoh.bin.23 | Bin 0 -> 17024 bytes /uuoh.bin.25 | Bin 0 -> 17059 bytes /uuoh.mid.179 | 1086 +++++++++ /uuoh.mid.181 | 1092 +++++++++ /uuoh.mid.182 | 1095 +++++++++ /uuoh.mid.183 | 1095 +++++++++ /x.x.3 | Bin 0 -> 10 bytes README.md | 4 +- 197 files changed, 185801 insertions(+), 1 deletion(-) create mode 100644 /_chkdcl.temp.1 create mode 100644 /_clr.ev.1 create mode 100644 /_clr.opcodes.1 create mode 100644 /_clr.opcodes.2 create mode 100644 /_clr.rmode.1 create mode 100644 /agc.bin.16 create mode 100644 /agc.bin.21 create mode 100644 /agc.mid.131 create mode 100644 /agc.mid.139 create mode 100644 /agc.mid.140 create mode 100644 /agc.mid.141 create mode 100644 /agcmrk.bin.3 create mode 100644 /agcmrk.mid.1 create mode 100644 /amsgc.bin.12 create mode 100644 /amsgc.mid.107 create mode 100644 /amsgc.mid.108 create mode 100644 /amsgc.mid.109 create mode 100644 /amsgc.mid.110 create mode 100644 /arith.bin.4 create mode 100644 /arith.mid.94 create mode 100644 /assem.all.7 create mode 100644 /atomhk.bin.6 create mode 100644 /atomhk.bin.7 create mode 100644 /atomhk.mid.144 create mode 100644 /atomhk.mid.149 create mode 100644 /atomhk.mid.150 create mode 100644 /bufmod.bin.2 create mode 100644 /bufmod.mid.4 create mode 100644 /chess.script.1 create mode 100644 /chkdcl.mud.2 create mode 100644 /chkdcl.nbin.2 create mode 100644 /const.bin.4 create mode 100644 /const.mid.5 create mode 100644 /core.bin.4 create mode 100644 /core.mid.13 create mode 100644 /create.bin.3 create mode 100644 /create.mid.40 create mode 100644 /decl.bin.3 create mode 100644 /decl.mid.102 create mode 100644 /decl.mid.103 create mode 100644 /ecagc.bin.1 create mode 100644 /eval.bin.13 create mode 100644 /eval.bin.14 create mode 100644 /eval.mid.122 create mode 100644 /eval.mid.123 create mode 100644 /eval.mid.124 create mode 100644 /eval.mid.125 create mode 100644 /first.cmd.2 create mode 100644 /fopen.bin.16 create mode 100644 /fopen.bin.22 create mode 100644 /fopen.mid.35 create mode 100644 /fopen.mid.54 create mode 100644 /fopen.mid.56 create mode 100644 /fopen.mid.57 create mode 100644 /fopen.mid.58 create mode 100644 /fopen.mid.59 create mode 100644 /fopen.mid.60 create mode 100644 /fopen.mid.61 create mode 100644 /fopen.mid.62 create mode 100644 /gcgdgl.mud.1 create mode 100644 /gcgdgl.nbin.1 create mode 100644 /gcgld.mud.1 create mode 100644 /gchack.bin.2 create mode 100644 /gchack.bin.3 create mode 100644 /gchack.mid.45 create mode 100644 /gchack.mid.46 create mode 100644 /initm.bin.17 create mode 100644 /initm.mid.371 create mode 100644 /initm.mid.373 create mode 100644 /interr.bin.28 create mode 100644 /interr.bin.30 create mode 100644 /interr.mid.419 create mode 100644 /interr.mid.425 create mode 100644 /ipc.bin.2 create mode 100644 /ipc.mid.19 create mode 100644 /ldgc.bin.11 create mode 100644 /ldgc.mid.100 create mode 100644 /main.bin.9 create mode 100644 /main.mid.350 create mode 100644 /main.mid.351 create mode 100644 /main.mid.352 create mode 100644 /mappur.bin.34 create mode 100644 /mappur.bin.37 create mode 100644 /mappur.mid.146 create mode 100644 /mappur.mid.159 create mode 100644 /mappur.mid.160 create mode 100644 /mappur.mid.161 create mode 100644 /mappur.mid.162 create mode 100644 /maps.bin.2 create mode 100644 /maps.mid.29 create mode 100644 /mdl106.agc.1 create mode 100644 /mdl106.agc.2 create mode 100644 /mdl106.dec.1 create mode 100644 /mdl106.dec.2 create mode 100644 /mdl106.exe.2 create mode 100644 /mdl106.exe.3 create mode 100644 /mdl106.exe.4 create mode 100644 /mdl106.exe.5 create mode 100644 /mdl106.sec.1 create mode 100644 /mdl106.sec.2 create mode 100644 /mdl106.sgc.1 create mode 100644 /mdl106.sgc.2 create mode 100644 /mdl106.symbols.1 create mode 100644 /mdl106.symbols.2 create mode 100644 /mdlxxx.exe.1 create mode 100644 /mdlxxx.exe.2 create mode 100644 /mdlxxx.symbols.1 create mode 100644 /midas.bin.3 create mode 100644 /midas.exe.5 create mode 100644 /midas.symbols.2 create mode 100644 /mud105.stink.10 create mode 100644 /muddle.mid.346 create mode 100644 /mudex.bin.34 create mode 100644 /mudex.bin.38 create mode 100644 /mudex.mid.177 create mode 100644 /mudex.mid.183 create mode 100644 /mudits.mcr130.1 create mode 100644 /mudits.mid.131 create mode 100644 /mudsqu.bin.6 create mode 100644 /mudsqu.mcr025.1 create mode 100644 /mudsqu.mid.28 create mode 100644 /mudxxx.stink.2 create mode 100644 /mymode.teco.1 create mode 100644 /nfopen.bin.2 create mode 100644 /nfopen.mid.4 create mode 100644 /nfree.bin.5 create mode 100644 /nfree.mcr052.1 create mode 100644 /nfree.mid.53 create mode 100644 /oreadch.mid.208 create mode 100644 /primit.bin.5 create mode 100644 /primit.mid.315 create mode 100644 /primit.mid.316 create mode 100644 /print.bin.11 create mode 100644 /print.bin.9 create mode 100644 /print.mid.340 create mode 100644 /print.mid.346 create mode 100644 /pure.bin.5 create mode 100644 /pure.mid.15 create mode 100644 /putget.bin.3 create mode 100644 /putget.mid.51 create mode 100644 /pxcore.bin.2 create mode 100644 /pxcore.mid.9 create mode 100644 /readch.bin.12 create mode 100644 /readch.bin.16 create mode 100644 /readch.mid.206 create mode 100644 /readch.mid.210 create mode 100644 /readch.mid.211 create mode 100644 /readch.mid.212 create mode 100644 /readch.mid.213 create mode 100644 /readch.mid.214 create mode 100644 /reader.bin.10 create mode 100644 /reader.mid.353 create mode 100644 /reader.mid.355 create mode 100644 /reader.mid.356 create mode 100644 /reader.mid.357 create mode 100644 /save.bin.13 create mode 100644 /save.bin.9 create mode 100644 /save.mid.169 create mode 100644 /save.mid.174 create mode 100644 /save.mid.175 create mode 100644 /save.mid.176 create mode 100644 /secagc.bin.32 create mode 100644 /secagc.mid.80 create mode 100644 /secagc.mid.81 create mode 100644 /second.cmd.10 create mode 100644 /specs.bin.7 create mode 100644 /specs.mid.110 create mode 100644 /specs.mid.111 create mode 100644 /stbuil.bin.10 create mode 100644 /stbuil.mid.15 create mode 100644 /stbuil.mid.16 create mode 100644 /stbuil.mid.17 create mode 100644 /stbuil.mid.18 create mode 100644 /stbuil.mid.19 create mode 100644 /stbuil.mid.20 create mode 100644 /stenex.mid.11 create mode 100644 /stink.exe.13 create mode 100644 /stink.mid.1 create mode 100644 /stink.symbols.4 create mode 100644 /symbol.cmd.4 create mode 100644 /tmudv.bin.1 create mode 100644 /tmudv.mid.1 create mode 100644 /txpure.bin.2 create mode 100644 /txpure.mid.3 create mode 100644 /utilit.bin.15 create mode 100644 /utilit.bin.16 create mode 100644 /utilit.mid.103 create mode 100644 /utilit.mid.104 create mode 100644 /utilit.mid.105 create mode 100644 /uuoh.bin.23 create mode 100644 /uuoh.bin.25 create mode 100644 /uuoh.mid.179 create mode 100644 /uuoh.mid.181 create mode 100644 /uuoh.mid.182 create mode 100644 /uuoh.mid.183 create mode 100644 /x.x.3 diff --git a//_chkdcl.temp.1 b//_chkdcl.temp.1 new file mode 100644 index 0000000000000000000000000000000000000000..1532f0479a3c9ede70e5f110ef6ceb4f0319fe2b GIT binary patch literal 54048 zcmcIt30oA$)~=pm7ZCR~u~bx4z}c6CAiH4LWHAUyz--Q zc$0p#>7K5xuI1F(&nc~Obd9V|uRXdxr1jIa)$2oZi*svp$Cc2c+Os;ut7 zgW_zT{q5d&JE|l3?n#|_et0Mq=(b(eqC0RxRU=#X@ioQ5r}?1{R@xT|KRAyEXxjhX z?k}N&{t^l+)u$p9RheF`3i1O^9V*(&HFfsp)bynEdf>*>@%i=X8+v^48ArkVxvQ^l zt*))CPp+-6Oi%Im`K8J6wYjI$Qf7I1er|GnV&2@zi`T!>w#u(K%=~&MPikuXy9di} z&tkyjc4F?@VC~P(YpTcGKFQzvX}?%gZE`zx{lWZ_I=ig0ay$9;+v1q&n02?O=dbkd z{*Y4{c{+;89AA{yjf}6Z&OKV3o_fgkJwk`@cT^ACD?PHjzQ!kmjg#&QT;Iy)s-;@F zQmmDAAzv-mbNN~>m(w|2s1)+0+V!tSN7=DB1Qmv+=cgAMfyi{e`#r#@G6wMA#J1^7 zyXw&W=oW7~1Rge905_$n9RNj!utb33w0Fw1hso|(`Fdec2Eatce2o?GyTD&~&7Phg9t>7+(l>y% zfL12Q2|*X)hy$+?dtga9?9u&fZ9OlO=m08ZjG6(e0fFEh12LLaHQ<8tQvKxC*6!9` ztxuhk+v$H_`r#85^{Fmd;Qu%-Na3s}^Fngk#lKE0zVB|MFuZ=>`;rv32nCa(rTi2z!T5)F>Z zZ|w_{gwrf0c40-gJU@J+JDwlDEf2JJ6bCDKBB$^n!cB$XCe-A*yfNIe1Hy*a_Vqnf zTJGOb*VxF6ZX;9)L{6~gDb$P)O}u2`H@X|Q!`-M)cLB7tYFDj#j1L~O1%siM9BaX8 z^90MGs<(Qc5b54HV9ke8^Tsr3A!0&Je~+yPiFd6Z{2Eg>JPeZe1SjX6!L*xRA`7|y7!wW8i)HJc&HAf-NOoFY9 zxYXs8;Z=sqx+N^@F|4mbZAbpTB`6d`1|V@LH{!q9FB12L#z+QY$$`z?TAxRP?D6a9jg z^(^rm5b6Pm#YK5g?gz;c&ZYPRKS}(`*WMa*3wcBphBrV7dU=}X(?whna(kt4VSY#5 z;_X!_Qdso2jw#l<4UN>`J+nfoNHJdMHrGKRL-HH(Yi4*rtClA?34Rr_(HfAf<#n{m zJUl!+{B;b_(Ie=#yS8%sGVXX7SWlm?W?;9BvPZBZf@sNEZ>>xV53OhBHpmf;66^8< zy*vd7zbUs9qc48x-5cCfAFCGh)dPGNG2=(71q3OEX*0N;dT-Ratqhv?>je09!#3kX zR!92S#Fj@4(^m7ENixmd~P!K|lY+2q;*nmuyuJPcfvN3!5} zcZ9ZD0p5c7j{1~W9fK8I8K@e-*axT@B>CeBs2cDkr{r?j2lHfvvmW8d?``j>6Pv^{ z1o$`R=`1An%?_;;pZ0EIHdXOEz$U@`3|Gg#6y{QT!$q~9{KlKo6c-gaFuB^KU{IRp zZ@rjyauw!{NbjhT^5Y$KMV2P3FO?pn+-4j4Rhp5dc@b~O!sTzp+qN0H_#fduu-Xbg z*sB`_NR!gYTSb(OSYLl}$CWGo7gxn$`=G!F5m#kYz;9U%pw8M4r7u^*qlV?mF*q#E zqLCX@7%RDwQ43dwm~}&}Va>5Wr?*Y#46G)Fo4aLr>)Q zl~Fr*90mAa#xS*ZsJd#`sK60mFcLUE1jVEeZa^^=$Ys?cq_KRpR?I<9qiaAgVCzc! zo2wS9C7_s+t`zFUd;uIC5l*#M&7lCfy+XZ|pwvMGb5<(#p`}?DXX4 z4ICc(bR~v%lG;L|m@cB23xr4@5s24vimh@`uY=(>5pbOTr+k}wzFscZ3{NuzctI=> z%Cdppfz;K%Cgk?&4t$8;5a2$=m8GN{Yra@QeH~n%8S;P^y)N-sHNn(9@`abUCc0uP z0V04=6Ig|TaEMelX21J%m7{^fP|bG@Udrk)11$uzV0pr?unx~|(Xfslqyf2mP*q~F1Zc(>;P?<| ze%G)BxCZD_B!SWaP+Tb&Y9(DP767-UGQjwF-NWMAtQnr9Jfhj^^GCv~AVpG}R`QBx zay!sHVD70&5I_b5#UPg&?-JO*p639q=)n}8>OrldXQX#e2JRdlKEOC#NkksR04+pyzVcjZheAY@i2gw*7sw9Eln0l z>cX`L!2~$|r5A&sZKY$U6h9+v_i_wKCJqmb1~xq~wyMlPjQwjROK3SdhiN|?Hq%Bf z0gt6>Jy*(Cbfucl)oPXUyEUuR8*9r+oXOs89SMTOmaFz;ktc3NG{J*7^nn4W0C7**DgRs;x#uM?}nwOn>JorXx0vrTU=1SGQdvX*2FSVQq%2&g_Ku9?#Ln;yI3%dCg zUwx70oRm)x>8fo6e zqB7rL_2!dab@rAmJ@736s@_pgw0wvWpm5zh5{8er4rqTlPSEst6F{GA}c+m)vjveC$r&d zxEG%+50hI}{2HD{;fk+amHJqfNRFTC$3P-{Fm7-PY-jB(vf;nBY-G}TZOV<^+u2d0 zd}CQ-C1LDQfxIiPafqe98IJv1+cXH0;p#bQ`HgMhynz;AwFmupqo2r7uFPv-V>41I zMdPPNG*%cQJq84+{Z;h`+xk;7=Opq1i7PbszyyR7TPnA(5A3Q=BEyY9kNZm)zy1=& z*`72SgX*Kh!(F4)kHjv>ayZ5mzCfh8y7cWVf52gpX467VL7B!}&{ciXj)4$eX^I0~6y@j)z-)wzxJ9 z5qx@OWoZSrUwyZ+AT_2#&BdrCHh)8H%)XL!`DmodcFpZqf~~4BUi^+mthaBR!UH5 z=}IkMu2%D4wJX(XtyHh-p?n3DpjIoF$~2lnk|!r#D3r^^9Ay0}^r$RasOG`El%X9f zf&))uUIN!WH9a%EvX~?qR041WzBz_)SR%0*hy?L|D~U<$H?Hzcj~s+CKL8`Wb%hJ9 zk84(L%e2C0jjdt|zZEH%vPduShtaosW9|9a6>Rx1Q{as>TYjjI&DdfyWP!J`0>S(8 zjSb((U{JiokAG2xeMNZuFUZ~t-rq7*q3t5DOBYWR99Y4Z#l<+*y)CUWY6N3e2AY*} zrUJ1(W`HIz8k>tT{fCihfOdSPZGQZQ-lI}VJW!=b%{vCag{s!L z*-)R*$e<_)R}}l9RoGFJ)JTZz^OfmpZww5^wgBKn926?kU(y(-mPlJE zONA@YCDcd(5;Umm`K4d3q9hMPgHjfLGZ9LV3G1UWw$lfSs7mt7lw&v zYtzK`!9ztqSzlU{XK_~tL*R_r8gz-3Sn=|#w9|{1n{qobSKs_;|1NZ6=GK|Nz%E== zcfm%fih@Uv^0eTpY8k)^hlT7D)wuz};XGkZn+ldcF1*^WY*_o*gmaAPG#_{3YKy`& z1_=ST+iFC0?x~HncnrUL-~6K7AzNs%mftLs*=*D*pjU zaOnv-kgML@45pC3b&{UIn~bM>_)Y8_e9&vfBh(PwKJ*RVe%wBFPm{yY9k>mzaVf*= zO!S^`AG4+quE{IUSMH-c53?q*+?x8-yeOR-({OZm9WSU^PlIB{2&-N(V>B^dyzNvG z){8fQpbgtG-pS|?y=ZK2|981Jt&<4=FXak_VzH|67Z$!+0btVT5|#vonaQPvD$=T09u~w!D|oOX%xIn*t}T$kFEZ4aA4zu zD}+8HQ4<)i2D(DT1qB?$niIXR7JeiI;V{6MI;zdk_}ARp;23zEvzzAU8(`Rwt;ug% z7Eb=Ty9YeWV`A>ps|UaLFT=?(GZq8d9z2U-Yjf)X9vvG~#+cv{wSnsoQ7)zqP=Mr0 z4Hy?HMR51Pj5*vwS5Cy5z=_Q&agSp4{OZz51A=4k9>qYqSp_aE_=IQ1kGuktxT7Xw z019y1_n_Yh(s~Nuo9hQ+6D&yB+~?KUZT{wE@%<9)(gpFs3#{R1-+|XRw-D^r$~I26 zea{bHi@ivgKbrmC$cewbmfu8cAdRHaZGub0cmRnehL-Go>Wn@n=Q$Rhie*cdmozdw zkk@FPx=HTw23NXhsKz$t(JB`Hh@9f2VO^H^ zpX{Yf&nJRJQl7qD*=AwzzHc}XBQgtY%cvE4XdZ-rl{j+2XMwHvNQvbx5|d2F$(q8^ z5^1L!LG@%)p)Wz3$uyz!AbQ>RFZ~EmlEdJcW+-n)GLGcgzjt-o+H+b1d>M!59w+41 ztq1)MZ5){OZZ`>(A|KZpwnr>Pfm3JE$}Q?IZw?vs*Sj( zD~Wp!xlSUXq!u|4=CIxmMUA{M4X6>52?6f}0gwKfkTpw#f+GF0?%f68@!jH7%@B(__x=l1DDCra7=4XbU3{#29rGpSlHIDX zTNoTjwS@XJO}HK-M3M+kU>QW|%&zJ#!gL|z>JDRE#E}c#N*|Z|#N0+r#t&6FF5(U& zDiaWp^w%mfx+H5dx)sVhSk`iKgxa>5MEM4mE5>wkoL#`m$E~;j$R`5>`iU%D5(cL) z=PD2Wk59Mvze627%o1*fyXF;~Sh(8xK$>6g>XfzczTq}YD>Dg@cMNYLCMQuD(1y`% ztgNn2NYIB|48bROMPhzt))yzKK8MCbPtGr`BIbve3*(b3OSl+?n%z-6ZwuAy;c{(y zVR?SsXjJg!MvcrW94N-=@Thf67lS&NOb8M~i>RPsjFF2qdTQ_2?O*qN9QRPr_L3UB}{`U7DFeV3?_0M(Zoh2{#g}N1s?{IDFg!KnBNz)7)4^j?>&U zxU8O3*=2QIwboQo6hjkpcYlBJ>Zd-{P1P2-*=+-XbV2bTFk7lp>{C6*ReC$`|XP+Zrkx#6Xlw#eANMmKy%$YE<`>N^rv| zRY2Ao-CzTuezY>Q!l7=^lxX%iPN)O!2C|`xd{Z2rNU@*IKr|*!33^xf-H1VecvY|! zPYxv*=av(eS_`43z?pmW+RUz7dx8vjUef@ABM1cVv7dj@Bm<@ z*aLvQbpY_;QesN40tCRc591BgUop?AV1*{<*Hys!CEqyCs(MJ`C)z@ z8b3lUnA0kl4|sA@aS3n+H=4?B#<-8k@x`S@gh9>^nZU;cICCy<#rTjU(-~Mzf~RpX z73w4mrUi~gZ}aD#zk!L}lvUhSlm?ZPcI@U;AH z%it)bPu)J>OFm?WF4R;qHd0S`T`}BZKLNp9Ig%Z;&oqjvU=e zjz$Yv>zkf9Lw-XCt^9^}W17pUkukH@+}b^6Zr-tm?>2?XqAtdHCh%1X{eCpP*bE4U z?mBZrDoMF6UGWm%MU}l6qcCUW>2z`P^4|Vu9WV^@m|m!UwDf8mK_GJLQHT)=y)4;9 zD{{an24{GTVs9Nr`Eb7en6VC+g$RX?nq2Q(pK#19V6_$*WrIb|H4Xd$c0WbA8YssX zD^oKt;Kx@QN8s1kLJLIWD2AWH-VX%4HjR-M{nU^A?Z>bxb;}FT3;0#G>Dd?5@Zgr~ zu3LA%0GR;?-KG~=WFEI%azApV3afrqiin#wAN<$AKQ%XU>&u;!a+YDm)4>X=;^|Oy zDZ+wFk)vu6;p3*S1?wqM3oE$cn`R1!Zyec3TMMdUGmIoa?X7V@(G%NL>1?ZrHUGrE z2~xsvy4KT3(KQSO#5W-Vk-ZdedyI4Qm4Y)-YqGwVx()SRzt?_vPy%(&Z_>bh@B1C~ zfZh5Rr{^FA*+_%X(mpfTyBusmS^tvy_>EmNAFOY%;!d=#bPcyjo850|Ee*e=wi$xU z2_Q`)2Zq5}7ic=Zxtg|jX*eKmY0Di@#V4Ck!{^TzSRY~hwC z(cs|=;yLXP-hg)w-aPx8AjDgC7l;{TC;b=wn`BmoYR zs6EBvn*&)Pl`+ss2{U-`{Se?8w55GPMG$2bkNy(66?dqT-_T!6c>o&{5!YLJvkuHE zhmi=I5z~=m#)Sc-1ZN)e$O(>!%U@`)GLF+hJ;_c_uA$K6YywlJ2kWH!*Qb!T2A8U4 zCnfEMn#>!daz~3OPga7RuhlW`VsCG=E zrq3a8(fTPPqWl6JWC$YoYUqgs(v0%fp~g z(Gje=aQ!)$`>T`%U{PoNb#U)+T?e6uy+04Ox=}KWrPS~eMLkz5Q|k-maV=kf=KvfC zC~~6GGHkJwF7Q8xNDtvBN@#DXScI5RuGMoDnC>Ac7g7QQS{6YpXAP`~DPDl50={0TSMo(FpXt_y0fSRqo*4n)O@MEs1RBXE;o}q} zDD%_{uosJl8?rE5=h6jEC<&(5;z*W#bcNqG;yzN zUyqL$&4hSSs~ixYB_IV6HN5!<{7z??pV}VTiyH6L};haIyH#bqVoX&5^;2 zOH`JuCw(F%K)S&$Z7dHSVS#Gl@S*`m0LS}>isE&Tmk=e|VSQge1REVOEHRW6!bIWh z1L2^80BT6$)f`rA74Ag*wUCp*{FF%iAd*|`0c2FBBWevOu8_;q4HXhT9E)VZa!FIm zKt%#n2Ec(>rN9NXO1_@Q4^kQ~P53a4Pc@)KgpP>=6XRATPXN^hC;(jve3kesG!-m? zqyiPVz6w%+x*?B{aN}A857;3{KX?iqglIOP`~ZFgZiHJ&wG4kK>LOST9H{EN2BxLg z5_$k!U4qsG=?BmrhO||2SHxuv7?pa8MuggcTf~u3@6Lip9ojvktJb~Q?>Dk5SK~PeiB~)3{60Y`nyYD68$6}hJC^#pgV7Myt zH+d=#q~#}XhCTv6moT437D;JGA`Tq2P?;k5>ZquTeF)k|Kw`3oS#i*#B($c>>s zZ~2>+VG@sNG~5J_PKRNqxYQc-k9=U(yLljV6zeEr2Mvi2wKR-|AI{06nmfe@zzgt9 z;Z>K|0L=*DHf;iABw_BfugPsUZ@Z}_T(SgPQC0&W1yx~x2~rzLH%=H0A>vAnQQ`v@ zLaM7TYIw%OV4;*XbtDdY4|y#`I7`I?$0*T^4p9(?ZW5pHb5fon(sNNY@08hSsLrX}R?Qv=!A3Ce3pi@O2)DNm*L8jH#Sz--VwEc*P)KouFp(zEtILEukvL zY1rHU9oMGJVhq#P;9FcJX=b`VFaxk2&`^LVTSx`aL_$I;l8l1}!xR7~W&8}uq6mRU zuyP4JL=is9bQoqjunOc8I4}_`l7MA`^ip3?kt>G$%6kxmpQi}SHKuXamBBg-4`-N3^_%}Kg@UQkU zDG3xEFTxL(Tj{Tg+sW}8Hbo7a52Qh<`gF(uZh842enpG zF+{N;>Xlx4bEx1HdT&&UfoyY)cyBLdCOzFnOcbzwyTrT~*L= zrdLJnJqNf8Z_uw6o3okf)!vAv|xUP zMZj-y7AD>dt|%*SAN37s_)-0Zi=AU7d^xZCjkT(WjWj5Y<*?ZCnw%O2f|J||1$uP0 zK@*P7h+Z3=VJ<$C9H$FQO{UxEIwZ9rDlmi1PD>KC9tBF(l;y*R-X2mSZC6KgA}cf?o=w1pRLjY8mKS zX~w1JMM)z?GL#cFakW5b6?CzZtpu81XhBNM!~>rV_>z>6Ylj+-9BjSNWx(~KUMw*g z4;8djJB!|fQDOzSYnYc1>;;C5`qVnzh6`{V87e{rlrJ+x418I=idW0f#6oI@9t8ZE zc|-^5TJ8X z1Xq+nfpNrce47;r^C3@>?Kegb)hItCf~fKM1Rg|H-sg!)%+7ep?m3?#q{q5dO33hS z%U;9@45*f4oycfpfo5YL!W&Kk^zVXMuzH@)qf|X= zLxHtn=<4jp-O!*=fzVvarN}kme8MHGrqBm)xzJ7S|d&uO#EIVrNUt_qQlcJd|~ct_Q{`Dc5O-~k4TYVX-u70 znLQ*u$U^#nA_AzgUB}R8C-sIwNq4+|kwuD%DNN}?yp z_7zs8AeK`BN(tr?v~!-Q=uj9+u8E6*jg*8nKB(wYQ05WzkxMEpaChYw_ywuTBgi8Q zi-QKR70{yKMlKuVJFq(&z#I=E%4LJ;_qyYrYrpOR8h9A3P4kc)y=s#C9HgX?Po;_} z3p36Dz1O7TgOv6i!yFDa zCHDi|x>{+me5;umyo^k<2#1bqX(>2gwB+ z8&8g^s->YS&nZ3O>>GWR3}SIMKA~``qLRdUTZJ|+vGC8n7L>yzlQl9^!CHbSKEa6> z)lx6f&d+SAxFDTOsdrr~Q7FZu2x zo@Uu9GatMi5A~s3eb#d}u@9MY=&DH?D=xmAeF5}+!rB`;f_{r*>*CWZ`ycCReBq2!+9ruEE3cYCN#;_|5Jfsq&K1D!Jlf9c*1Y;$Lks-w7tUVh- z>Qbv~j%B@ad;bVW*JMFBg8j2HxYiuO^E`!^R^ysAG4pHB-9ImNK=S3`Hwjo&^h}?a zyWd{;^P8G746m1qKT#c+GM^0Pnt9hr+{Pu$Gm6~`j*^Ix-K9U3R{xU1-kKl~5d0Pp z?5b_rT2Eh*LUC4!A|V(sT2$9Ij1d33)gc9Xl5`Xdp-8wz9B?Lb0W*aHT(anW1ve|? zBS9^nc0qqWmt^uoAFoi2+1W6#j3Ed75NP#q4@X!*+sB!^jj6&Wd=_*5Z#(VG% zfZ&ebV5C4`1@6+M}IB^;pPWCYC!@qqv|F-Qx0=n!)hd7^WQIDQX!D~dec zmo(6O!8KMeC-ISaz`_|{0e-{BNo3oIDi0-(k`(dvT|esMc<}u2&tzduq%IAT?R$hu zUnf#;lMk^Ou%H6TF=AeblPT=KcKKJ(b^50M0xR0Pz6#)WBLdAwoD&CL2xmXp8j;(cVfH-e>#BdPc%xN%vo{u;fJt ze`1I8HyO@kBfnv}-`U8B&gO6m!7%ZJE3`mPBESh(q9-&4af&BDtI6-qHr&c^O2aw( z?Mx61TPRo#g8VKY0OTdXC;4rf`j}bMT(JlOInXybc^!;_CVr^huMb9AM;+mo`mZhx z^p8ct9&u|3ri*yRO0~S}$KEh5OwjR`j8zCk7IQ?1A;c~8#Y};QEhO+Y;X80+*bDF& zeX4~gWRw6D)42fhmvIBt+v{`hDCVUpSGk^SC$cv-pcHB-lK1CI-&{EjHzvOw%>JD zoU?f^gRdT`P7qDcpI9q_+tiRaN(C>AcDh-fP;Fz(o<9p0^Ap?Z4|Q@k#+u;MI6lM) zGYyymZvx#E^z}o~Xd(I$&e|H8#tWr#30vFH|GJ3%ZNO%Trz4d2OsR&10@8p*pJfkUCctKk14r{{-4Gh(L( zj{u==LQJHktV*`Y5gMw&1G)`o;E% z#5>OiEjIk$r&Vb8OHwT*?PtuQiNoR8^oW&#d?B@egBMcTz$c&{V697wh0s_^$ppcjIV)= zRq#__efu_fxn^OWx;X*d)JA-dL``Rl)bMnkClqr_(lC++yxkIV%Sr$p8oDf!iQqSB zIJ^IvoB9b$xz8)vY6rk2Re@b5Y;F=Ahn{ebq8U)y(@#_+XBp!1wtWf|sJux_C_^F_e@N9~e_l1G9gSV8|2uPTrq<@U;wt|Jv6ah_rs-0p1|+mmmTk9&R%G z0tAZa8NnhmGKL4N?`cD;{JsrFzGZ`6lDNJB`(e`CQLM{~`AuN**Q2K5-!fos7mMh7 z8LR3TWDb7!`=c6;`Y_IJ_bwYbpR9DyS9;Gp#Z>I4kr=6zV_--s zuLA#CFo?$v6PNC5DZ+1n9Fu4QCQqB&BxG}#WC;P0H7%=kw$JkinP*{L`qvhv zhzEYT^~5l1>}<`{$~-Vah>U@+;M?YApfE;5R+#`lo68D7KGQ&j^$7#c@SDt!QqK4^ zz%&3V&Jz$6_G@tT1MRERfyxv<_=LFKf8#YBfXE?dUUOh=PGmIbm5b!bUSaFOBxvvl zZ9MVHS1Q_0ks#sCVHv}HNA00K^;Io<-JAKiZ(rcYNjlILOFCY0VH<(Xyn*%^Wfng^ z%iqLd%!KX)emC|s2@HM~gt&T6Fx%-k!7K%icL6nr$uxt7d)PsdCBGv(7|Z-@4Rsi7 zD#!k?9<>m}#Qy{2d)XvPW;xNR!7&6nHJJTW8?XNBRdGLw_0QJQM;)CuCwc89AAE1N zDNv|ZMPmwjn2V~VYk&8V@y&1wxHPT8(F(Y@H;7e@LA#dvtI?R<)v3D+r#NJ#*aTC| ziz(Kp_tU|p>4vtxY6>-KvMtJPIdd-SQOv&BWKwK0PI6bCloS$H%P2~}h4E(-)5+MT zn4*tkXE!x>I=>v|6Y{vtww47b;h3-`clyEz))yRJ-S@LPxse6cgly_kjs3o z1~)RlsJyhmX1DlAwaltJs&g-j)Y;uAr!MqG4`J?#X4U0dw5_ggM=#aKv(cf_dzl_} zLuHoL{aWU0m0QNBIS(V7johgyFVjmIy|gsh&_Km1;>{$elWrmR>i(MYsi>vTP z#@_K&xF$>C5+cax6kX55Lkhmi5>aN-Y9K-!$uW?@!X%Lp*JY|uO%Y_kgA!DH2caoN zP`KzuYYaul_80gZW7VlLWj;D=QUOyg+XMwIGF{-BDpKsafvuDAGcCRFL_|_|cxu6@ z4C69VFj6aPo{v!2QjH6nHohU*|ByHY8Nk>q zj2~RTxkVJi?rF+K77;WbDLW8d2lq&1;y_*wxLI;Cpp?dbuG|Du27#JqUUOqi$=}Dc z8%RuocECc8p! zl3){n1id&sOfeNO+tc%%%|Kto1&=993QV7f@q-(HBsfIlkg*V6`2Ymy@TopW9kNR( zMiaiKjBhLfhB3Ewegvh_1}0SiR50UmvomUJRCKf33Xq>tcT)B03R9so zB2y>zZQwP?x-sQF9)L|#Hx1)tLdcAK#iUzh%oKTDN+Sn3%m>OB)hoO@PhtY7N zq6W=4vU<=4sgK|2r&DW}{}9Xtu0HDO#DaZI8Y%pxcvd-1Gv4NyE*7sr36CKX-E*uy zw2IP?x)FX0SE9lNSETwee*bq{_#S(rmQq2uH$LP4>4BS;IgImb^8_8ur5H-=vWN#F z>dbf8zNI;xREm#mYPQ2P10O%t6ztl>O3->UWLg#DBe1)lq${?u&&C5u!e@=OhnawV zZbgoWA*YT70A1nX>9I+z=m~2FDV3pjp8Oda^AF^HXmZ34^oNe(SiHz=k_Yucm<^nD zfR;f#az$=k4O1Bsf)q)L(iUpKUpj64>2S+Y82U@gl?&splk3cKZKLQc{xK%sPqK(a z=7%E2g(finl&`!aq{vq=Qp80AH4s|~SU?i7=r!`{o?o9AQ&$$>2oJcF#H&LpH7=W6 z%*imwSfyC>7$U!1jYA?=syMOBKm>nQsyx&kc3)Z*9$?|(LFh-QlnoL;cR2RO{oJAG z2!8GuA(4W@Qt#UN^x7yV4~JRmX)}D}Vz=D1lQtSdKT<@9W=vx1h%MN3*4;7TV4HFH z6?j)}9TN@?QJy+x^PgI6X`_@_Z?yuLC7YEDre$ypOa*|{KHNBrksSy|V>%WxaUioy z|8-nIe_HYxx9%>buDf7<#??Fh<|NbtAWhIR-Z3;Eh~FHyYMNh%p_kDZSf4E7%ogcI zkO>%y0((jn3DlZTe`z=gO(lIgk54XK5Xe=ThmgS`Twr41!_u|f)&Q?*BlCXn>T=fm zom_3SlTT*<{txb^BE}{mb-<bN-q^AHpMmFPwY3TIPECbpOjKI z-3^pdToq1N$2JT%4~;agq+DDGh;!*%$eJM(2s72K^s*5S`< z+?maWvuK*J#L%nYfOdYw;2{Pi-U8Pa!OiA1sGtwU2b6En;H);os0A^E+=uW)CJ`db zea&(rc8vsy=9mhcf?D_~cJ;6@YxLjf1{^nD#T_@$QZ{IhO%o@QddPESXPT<&Im|RU z$#xCz*LKpAufr^mfkHwk83?+BQ28#?!!bSN&S2xlutgo2yldZpghWGkD_ix3P9$&n z;8uBXN5L1E1J-L{?GbO0!W+Mtj{~J*XHA~&p;FMciI*a*(tp&r)JncH8Z!^Z#xT=C z^UrU{#$#U#9I(FU53mfL)2!5LW|a-+tbReE(b|i9(XA5V&Jdi0?>c+2S{1o+W0sxn zKyxh|Q2GP&+G?81UV5$(3?mAYYlLiw7Azr_!?0Hd}Csxc&6K*R{r)iTYbRWu?g1N52Ln2mWT5xOji9gv|CLMD}Uh+{@R2T{m@ z7lv|^fu4w6p^qn&PBmPn$fALIq|CLa9-sbY>QSNe*FZhQ<|iww*Xm@j8?Ib2(9JxR zTjIA$K#;tx@>b-rkL5O5eIJ+g1-qdIu6*_8iq)H^?@>K@=tkufm$fi8wfL3e#D%G0 zt7;xu_ovt5-iXNpzGkU~{U`@1oBl9HLZ{7-HcoYyPmM*;7q$k%=E6gvDk<#A6#4;# zD<`28LGBF=HzWkyal~e{3k4vqeL=L{M$}gKSk1+J3u;6AWW_Xy#y#IZd$c7F9P&y5 zxn|^*5Q)93dKzz>vb@ABHDa|;rY7byC$2I&mL6%4$5tS~IGhzp0Za4Nr9imDouGpE z_hpsML1ERpZ5__NnhG`-&;l!h(Hz#Xz&xhrzp@w*~(*X@W9eqWNaNwO#|NXun)4S<;T@&rntga`8+-xkA*!xnuv zLIslIEw!p{*3!ol7^k;-83==4+wvN(`|JUN>1=>FZo%WED5EXAnautrYA@FJCF>L3 z@0s*XzQN|20}fyMC03n756phbyta1UMxohA)Mj1VzgOjIQvZHpIH7Tj^=> z7Az5Vmgl<)Y*VYTV053^UNJv8#ia zU&wDB!O|AU8X2-f(UONS0FrOPd`-vYeJ>bz8OW#OQ+=Yp+x4LY_`#{1-e+ z+e&_w64c*9I8rcojBwDFii9}eBw>EUHgC9qoxB3;2KdhkGN{8+$t+$lY8I(#lBgfX zKs$>#p1>Fk!!oSdIpkYMeHG|t8F>Wu75fyzT>K7ZG!-1cj&cB?`Jbhv#S%k_dznY)ynoS+mBUi0knz9OI?ZjftQ$Wbnj*UoVLr{?iX{%=otP#QOs%R{D ze(jjG=xu&yq|F}mv3B<0n8L&7_%kcUFG%A9=J_onp!xM=Z(XhcBX)mCKwj$bg@r?T z3>$26KN9hZ!2TsjGR*aXtqCd!se8X|MV3BqisonE<4_OKw=r>m|5V#O>Gpvn&J@sM zW*x)h_)H`xM4uv%W{QAn1~v$Ohqxv27MbfZX%;>y)XRxSvYzDIsNl9(q?Xqa!xF!2Uo`G&BnbF>N;8kc12p3b z+!0TJYgmKR@wyRP2^m3v75-6@1PP{?9u2qRvj*2Rum+7DT>)6UQ z8s}KOJP5Ma!?Xs;7J|b6+o#07$ln3iD{uzJctJEubX)W}q7&{|cq;x<7HLyhK+nN8 zy#QmxQR4&LqUO+j-Lg$Z&$jAdOK(!v46@v??q&yjZ3p{92aV(iB~b?@Jrl+W1`3)Y zYLCFLMB-;r;?*rt$n%ZMa!ctiq<}bDk8i$#RL}?V8g%y2ZQaHOp}7(%W};p7EPtEA zZ${o`9wTPY`jiySJF!LAHmT8<>~c&eH=4+q6r0WrEmDjfC&nbR3=N6LLMQ6E0p%MBXQmQ86@xMKS@nJxoe#pHRL z#|z$q$fKpYZGcaC!rITsuyu@tFAFo*)IoP~=r6|Bl& z0nYSqG<$V(2U(F6e&W5qjK9|0ncE5aoX zSR*fVyZ!_ ztOl7kn}!-$fSZOQnTykZ9P;pHIm1;dHKqXYB1<_FoE5jw5A=d3a+=5ilgvk#PQ%{C zDA;Z2b*hX3No;7jVGGfjC3?KXc+Z62rIFp7Qe@)U+B7!y)Nwz|STu(HsFmEvVrX{I zq-}Rwdmflxx~)AUDdH`1QKb52gGG+FV>I7w?QZSW`ml&jjv?>+=>aO!t%WbA+IDCT z+{169FMjFW8{C5m5}Sb{(rq@nh6bQM#}gwp%ZB<|b)!-*C-xwYN`0wLY#^sxw^rXO zYGl0-*hTwaV0t>SZJ`RPdqCtKB!kR0aeAh?NgG&zy%%3en_dv8H-dh2rIxR ziwLTq0TDj+b?l#q=WtTT=6QG%!3}Ua;s$zfV26;PYse`JBSIY!3de~AQBiy7*K~G z48k!E09zNL(9MmLN*f2|9azH34^0|T5h^Xy?{qBZRAwN@MTCLVzj-AvqG70(ld9M5HcauAvbBfKVA|RAR}6f)FvcO2MQ_iK5x#uQZq+ zNp%P+3`iM1y#pVP0($#=8;=JvfP�JFrGw>!3vh66hFUuAL_+a%^xAMbp5Ycul2Gq-H7zLWw}`49x_x$^8v) zk1$uX8c3MNTRniO<|o$;Z`Gl(5`Zm@XA_MQ;*PXVW|IJ6&X}~hNKL9~ zA6JoUi{a$l*W?ZH2qGKKs-7mD!o<>Hynl?b2JT3QrA0atF+Hj=!fa_s%NbVsMX1!IfM)eFZ}i&wf)$vw58}$?`Mj8)yQIrxRT~!u zU|K6qZ9t7MhSBwEw(*c#ff(W$duh^+$f%j$fJ9teGAa&q5aBO?w$xRfaP&JKKV*n3$~N@-vFue#(bNdI*b*+@yr8jm$Z+kP0^HCh6tY& zOA$|RJmVw=CS=gVAXNGrigf)On;3>;OT0`u0P+D?4a^7VEsgaGyj8jN`EVD_ ztuq%rHn+|e1c!kEV3yWBD4cjq%+)u4+P}M_uFI`wc`m8!9vqljXRUXE=WJxZ@;GM` z-$)IJ}g=SiE6fUB{KHUcma)<>=du1ki~Kv*Cm6_G4XBKzRI zir7c+HF%CVNxCX?Q(Q#<;kmnnqbq_s!SmopB++Fw9YXowwqUmL<_6|=&ls>L@QE!T z@GeFGVx9?WOUpx~0SW%tY91$JYNRB?K@2g%Rc@3=Ndz9YjX|a^NK3NN{3@61T`eM> z7wHSgCD(WFyB*a@As@l?c!N$ft&~gX|39+j-$f>SUu1$;Qz*=37(RI>6k*LH{%Ifx zvUg0t25=TdE!PLyjVI$dLFEjy`3>ftu$aDm$N)iun>(~2w2ER$e!`B8Y_@p^;DuU$u3Al4LHiin=(i>iw zmA#1{(qD7T4}>%_=+p8EJ&zeHDH8NIHR(sQ+Cq()rX}fI@1TLWo=vZ3C_aWE5H=?{BWYob;`q4X)9(Y?sL2|~d_*!xGHUd@PI)I=QdiE~PA!THm*UtyA z4{3z(`j*$OKzB2@_=tKIEGT0HUtcy0ZDwVB!7MM&LzqSHc?fF+cOEDP!aYa>W#I58 z9CPbeN1Mt3k$MRKUnzac@C7Khgnn08bmLh?h=dB$K`uF61FB9Ds!mz9-AZJ#d8UC^ z0w~C{15on8rz{_g*{}?)Xa}hY{N=(QcV(J9B2Vk*Uk5~o;nSecd0Ftg1}Hp00bk)u0>TDZ!ES*_Jxnkv&@>ohiVZ9Rn0H4*j<4O`d4C<0;ClvT>p6UwCHZ2r-L?oA;%_WPtE<^tU|)?f9$s7)sZ-B`G_nOBv3&qQ;eY=$@ti4g+AlL7f82FL;9;mW!~;0m@{o&e^IBWnBB zgL#=?jw~b?qapBJw+JX@!jjmXE{pdry?{i=Q=$DaxDE>#?GrYU%yLH|MYD??qYlcs z-=J2qz znrF|kO^TdQGy8^7bKXp$)6z@IC)kk#Cx2_q(j+gnIC+tEjH;}zMXpf2^~%LYBUsTN z8AC~IMW;hs^RiCJ4=!}uD^up6t=DdiAFn@Im|L7rKz7=48lO*=F-XHX3mTN7X&)i` zoLSFx%Gyoi>giJ1e^ToG?HJ%@Q0BTJpQn^4u5<&+jQg_4@jf{ zrk?qf5T=#Sf$OK*1F;t{+hF;YN{|w`O&`Oz^4KUBmKY>68X{ptuosmiu+YF6t6U2j Ik1UV>2h3LHO#lD@ literal 0 HcmV?d00001 diff --git a//_clr.ev.1 b//_clr.ev.1 new file mode 100644 index 0000000000000000000000000000000000000000..3a73985259dcf3ada120a13d3ee43d985d489434 GIT binary patch literal 1117 zcmZuw!ET#C5JkNisn<%qjW{K0f`X$YQfeVNHcpW+Sb#0%RISZApln!|UE=1%uXkpR z6D8`NfSq~s-kV3);qfjmuVLtUSJ&PR42M^j9$ejA58-AA7Ifb&YmwcK=Hc93q(PL7 zr+ygc?tD3QFS>7*m8BEBoklKx^?y&I)D2dy*L}6DX)p`p0Dg_*X%uvpWp!UHD_GgV zY8*jTYu+^NPP?{k=Mogx?GALw-)}(H98@V=Q9vQh-Bt=A_f`FPYukg-BpPQKIE3fG z=m(6D!g&;|g2)HY_Xj_nysQ*KEBFlV5I`2>_wbM`)AIw#)EkjD8{b7iuhGXnJP_g=SsY$( zbR}yzkqykVx1d;60DobkWn}Mx82uvqN>Kzc z73!(lkxJrlhReb1)W9GLvz!p9m<#@lB4OLeXTu$nMxil5wg0nwrj*=N46VRHx->n# V52!Ln^+!mYAS#7gD1~co{{y6aQZfJl literal 0 HcmV?d00001 diff --git a//_clr.opcodes.1 b//_clr.opcodes.1 new file mode 100644 index 0000000000000000000000000000000000000000..ca2dca165d1133b2ca4ac428cea496dc5a0764b5 GIT binary patch literal 4670 zcmY+HPjBNk5XFt&?4EnB?i;wV7s<9kHh?5b8@be<4i&@ABIrl)SMQ^&H#5m$^PAzD z$01G9+3OWQ$K!o*JRBY#58sO8@!{*CczFEl&*Iy$*c8{_Hk&CuJ=alQ#;G1dllFZV z_V?G{H=88&({mrI9TX0yG&ZZ@0iubYh<8mGB>+DbDu<-C14>!kfo8wmNrjKKdhUV(a^EfRXv!>YXb{HtD z?J516w%au*!zoP~-LF~x4s989Ftn+1L2qTD4QCrEgR4nzuBLyBCJUXb>Bn^zfNJs*M9K4a&Y@|;hW_vqxw$&=FzRyjEN;N*jo zyL9j5cpq+;56$$HceoF0IwR$oDbLKkF|`vrt&?`RTyzGiGgzI$bT+jUJFSzJ>2)=h zab78E?$oy9cFjV`3k4|=T4LQvO>uLn>03qmmSc6|$;`};;v|WZQ(JQjFEx{WInj4| zORuN3q0GdQzSB5y{FHd~@FcFnQz}V9!uz)7K-^j&cNWNv#p}09L6ib11yWF#90zet zK%VZLbfqCJp?IqR6-NUJrN&N;2d zyyNAV%s81@a>jbbAa=&dj1!HMb_}91kj6Rdm>nan#$X!fH1~RB$H_VdnwfQsv>98+ zNSm>B+|2Ks1IR<3z&w|kc@4@zFV|p~Yp}~T=;ea6W*-aFdkJX11a!wt%x7dlW}l}# z*D}8_3zp#12uonao-(o^GxeD%zl?lyKokS11yb6n6htYIQXr+dy-!T}GQff*pse|a zUl<_DffNHNMgO|*3sb%XELZ}TjG`48S&*6f%#`O^<`-tc5_}qA3Cfwz$b!s1@8lkx zT;FDt>f?-gM?1tLZ7>?jyS5b#1CPd>l!93$!(dj)Fql;`6#i{IM/_clr.opcodes.2 b//_clr.opcodes.2 new file mode 100644 index 0000000000000000000000000000000000000000..c94fe33bafe0449b4f52a79023759ee0dc21cd89 GIT binary patch literal 4847 zcmZ{oL37(S5QR0pNj>*m_S(9t<&2XyBYTD-$eId3umG)*9eeUq^w;}9@$GI7@ge?p z@%CZ4B49h03%>4mA9mHB2_o=$OyGL~Y@t?n|Pj}U-y8N}ME zhTd&&FTbui&^3!UyzP+qgtIN-;m05Ca*AH!#@x2;0>p14$ zhKGmS&3bB6=!eZFwPRaP)qa1!yW9Tt;p6u4kKN)DzRPV@(l=kr>b%dos(RQ|XC&kJzFC(<(S1F?_cvGBj@iLx(Im9j zKC5@L$8g=_T8n+SlwZPA-F&I$&d}!DK92JfQNU;BP!@gZ81g)X>wo|c4`ot-w>?(B z!RXIDX7f88A0K6c%d=OT%_feR$NHFG@_M}lwL9ifqT40Q@2;zzEV?cqOc1opb?&4q zwKFyO+0=w*uQJ!0nh;N|E+HBu>iV;Ad!E|Cv3FOhf{g}=P?e;t^OFY8T`dc)GyCLb zdHVh^lDs=CsMNcWNhJ(w5rXt75d_V%4B4dF)Js2Q!RV6|WJAV1A4HuGMk4O{VBHZJ zy}AcJZx=@69!60Id1Oe$9cX$-Wc2FpPJC8(GVbmqYIl;}-AUYm#vPH-i+gzm7W;y| zVaiKBYu=)fXCu!>Gic>trZNx@vq;-B;j8mKz@{&7tU0g3&D0!eDB|=MV`qWU|o*VieJbmkU zIP%Rb%#Y%jG9|~Z;Rw$Slc65zJ3i;9p9#pfyJQWs8KnO;X^yC*mz|rMyMfd=XjL%AL5+hk z4r&}|e0-LBqadvd(|gX_fbL~M>`OrZd4V(g((`l3KyFZ&o^##?+@LJT1|{GI^8!D= z$j`oxN7@5vSh9xcjkH*U>0Huc%rjoctj1Z*vN4u-3}R!P)i~2QOUED@18H2chS@RF zVhpBnNpseb9cS$rsAk$R(rT<7Bdx~TaXY0Xz2|`Db3k|O#C$;(6t;QFOD*#=vtSOsTVV;T*i%6k6sEo~<>$yd2ShQDS|Fvp zNI{eWDFsqm+WU?vpBGp#2b8t{@dpNoav;S(O3}Z}eP+t%fCY2Fl9;5TAPWjpUzqYz z%lynNn1k5Hfq`ai*UYM3oo<|czF_2myPuo)x zX;NuYX;P{8JV`K+lT_FkzZz$eCnE=o94vD0`G|0oM=UIIu*j3jf%1@Gk%L9<?2t%8^$&PtjA7qX87_ltk)9>Q(Ah>Q$PO4lwDwkv7I=fGYP!4i-6B z8c9j!4b(?WW`M~IQ03mp!Ny(XDe>mU9LxZd8DP=@dX)pE8L)8|`ILCkPhKbu+!0B^ zH1Ik^Rxk}x<`tbJ/_clr.rmode.1 b//_clr.rmode.1 new file mode 100644 index 0000000000000000000000000000000000000000..4a4eaf369342d527ca6c8a39b2b9799f34cba2b3 GIT binary patch literal 95631 zcmdqK%adDIlIEFaGm8mW^hq$|OZ);uR4f5dacEh@{x6T6E8% z&DyHW%G#`#`LECK``rE9dl5mUvZ`h?*N{BFA0EZ6?I z+>dXz`|SaZn>TNkUtW!F-@LiupV8`OIbIzPlTZA0H95<#569(Z z`GK#08ofT=tq$YeetWy0-jDC5hw*ZA+^?30S7T`FeX;PM8gY_}}SbHsKrA z#=keK^>V)5eN=<#;=sq7+sWwl+1c5c|G8B@9B-D#!*P0~5B{3Y=l=IF8T04zpno?D zcXz)0usR$Me*_B0yX9dyK0M6!+lS+7vpg`z4e%PTzS@rIcgea9Mj94W0LgKAf5F#h zUc%YA;e8lS-MgDFSA4Mdl$r0CeR#iLF~IG`7=VqB(|5~*7ICv;2ev!jOxNS-{`TP> z_|TIEU9Y$A53e*#j5B`z-D0)>e)63_G8V9|`aiDuu~`1FnlJey=IBP>e=&NkKKwB_ zLLbZdakbrydy^bLUu|{|$1gNf!*u+7`=AFGW z(_)S7BlW6I0WW_UXlLEm*WdH?f&I;$@q~My2lD1uxi~Gs%N*bAxA)`scPp^>xb+_N zK4rR#!@KzlA1D)mQ-5G^&jO*nDWJVFL~6f4V+w z8`=ay)8k?b#!kl<@nFoJy0`swegykw(*sZt6JUgVCfqq_T93!2?R5MDOVkJ3%@O9Z zx*ZGg0~dwJs}0@VPlY~OnrFT}d#(A3VrnIuhx^%b&&)5!_sc2Z+iY2a@Mm3ZF8Dll z;p}yXlF$1%S-1!SpBdfHUI(V>hxWmQ0Jy|RmJ9W$H`iyc6Q%m?G@Q|f;R1agcEBsq zheg)h0fYLZy|Jcd2d)@Zc)riccsacpJ!dL`FU!Sv_OVfa^(^M}aL{Vp1M_qby~*m8 zXP2*Hrh1xlNxB9y4TEb|(fir!AEx`&_Td2c(rDuudqW4SEu5W=+Q8HvlKej`=MP7w z3h|iwJ30lE43Iz?K2MB$ort!hH({7?YcIB%&!6-A;Xs#qu~;2;>*+`1j2As!d|+ME z#p**LrGyp8VQdl3{jl60619H!yWgGQ-py*chQQQya1&;^{y3%~6I`!0>&@Bg^>TB2 zyc2Fr$2@|MZ#v{JPA=A96yUr0-F~+PF!P5!0_ZsA2YedD;Q!Y%bwtzM^!9WJ9_bAY z2Az21*-``}wvRZZJJHKii&~3oXi>Qb-I|u$oB3vO_WBmNHeUWPT|Xe)7Gq6~R~q+l zoZp?jo=xZP9(LV2dGmg{I%>bw@A0TTfcs9yGg$3?u#Cfcx!i&N%uS7%E1xYt%pPv` zk3LIoApVeT$F#cv0oDjozT+2ob@sZ?eL^Y+IzSltfhM%sZq7BS*aW!IYj)b3a$^xJ zmeXyde$^Mz$%uc}nvAY5Qrm)jkZy*!RIgddHnT! zGP&dr{oe(2u-)nDa(}^0KR>LX=jjH;bifNoqagY>Z@jFLDO}@< zOO1l6-@Nh4MnSA@sh6-@r1P6Mu?mT;j{S~c*YJ|=<;}w;gn&4<)ZdAi|6YH6A$c%c zj;FibdX=o)++HdwShBYIkVqiN(S}Di?Vsz(?Bj7K9Gt#+b3v!{(7?LY=^y~DR_4XEo}}NTnh;Qvpa@!v z7J_bql9D2(i^b+)-KLUcABZ(Ep#*kLl2XKGuYlQNc|Eyh#QD3)?Y)+}+UTFw(eXml znFQaM+2ETjwm^3k|7`h(DI6xKiN}wV#q$1UeXG4*YtZs1c)~w>-to_T zeV8ohey<pV$ zxU<=t^`-xNCCI?8CxPgz8`SpYv7a1v`lrok2A;5$@Auoy?Ls|i zRky(aZ&wJeca!OE{bwM!10xZ~bhn9rEY+g(tJdG`em1#%Kb!2Y44L=wk05`z5>9P* z*OU9*cK3FIKCoNv)o?rU<7Cf&T35$=HsGLL5N{0abTZ$~@2)2M`A5xq9_yRK z0x`|!DCO(r z@pO5QP@0X-^yk^-WEy|n^JniN{s=elWBn+8`#L15)jD*0%r`WO?aj?WY8CUruHwOQ zCyg1oD*0#wV064V>=x@cZ!Qt$F^9Y^m%tcI%3v^HocSJGp~#u2*tAa%$iz)$w*VfzPE z8f??eQqGU*{v(Y+_j@y*Qug=gV_ZE(QZqR0~r_ z&v##p-;BTeFaPq-|Knf(<-d>r=fC{xfBk+k`R>2|w}1VA{>%UPZ~yYo-{W`M$Xdn& z#RrC$KVE&1_LorGuWs*-wHTea*@uJs-UR?9SAUAvu@kIds zaPfhi{n|6eDYQG#^n*53|Gs$h=39JVJug|!QE&N99jo<=Z2eNL*@K()^cDk7+TP7a zk%U;8EnZ>j`|V!Z<8fS;p0rPd>}D&Tl0@YVz)%SDdx1HhTIXi@UXCq#J&f+5*d>T_ zEixQ_Vbe;ZJ)_05g5(@G$a}c)VFU39H|smicoN8nIuV+~Xz_zvU7E@T(`d!6bZs`* z(Z*Bg+8FGpw8zorDjImKVS_6-c!}E#8ucjMdojn=0t|ljdz>v`%Uf+I+!eR zOjxUHS~MF7UlqM#CkPRXSlENZan?;4SDEC(g<{Gwg}22C#6)HL;%n(U18b4WkK9@Ph90KM%)EHqP;u#~;Tt z6Im{<8)!gZr_0(MCOCd^wNGk+8i^qXi}?9Td*{IoSq z{pjk|nY`^V)ZN43?(Nxbf>MgaK6}l-NIa-Jr9juh`s>+i(8_27Z)Mnr``sEt2orb( z;F;FhV)E(bWb*PSwjaA^*p&q~EkZr`61x>o7^(tF2@6Vnuz7Q7uINfhV?dcrT>7(1Yj48E76PGs|aRUioQ_^@-_kcTB#w zjxY~RSqBAY)=RWK#C_?fXmv;?RM7=0MQOtQ?KBR-6~^B7;ZEl-ZI32oo}>P0yz@W7n1R z%{?Z92wXmjl<4?drYo5SgI#>j9w)9ca`hn$rH|a&8H|R`W65t>0+u^Mohi-lmZ-jH zra_o`%G|>oIny`nmQ++Wkk&E}!tE$IXuqP>!7~U!EB$mmnOuuq&S0jn3g+Lm;y!eq z0#3|C{a#rWUudVz<8o5LGcPAr;X--bVez6pd6TrPa8@wBxs(}pXo1hs+Jmzl@2BEv z9shFE#Y6%N)^G0*APF@iT$stml4V`KYNQ9wnhNlK*oaD$j)!_cCakJ!M&_T4K3Q6#5LLSiPY z!?9j7!9`#rzAvSjKtVQq5BcSE9L{w_#NmkhpFS+WtA~+s9aJyP;0^`cn1;^8L>({? zyNUiovV~+d`#`i|&Zoo=k2E8PphJ{4XSv$!trY}Qkk%`!#vG%sB%FW!+_Z_eZbmrL zD2Y4=ALJ_2?$GV6BJg)BJPgEViB&qJAu-tVkthGU=hJYjqkX_LY6}z`Xa59~h)HWZ zERREg#F#y1(WCraN<4{f&teTWFf~kW{B7ES>I@6Y#tEzDf+9e(4Tps5n*~8+e?<>EE*U+{1++pGUDJdPgKe zxZC?PA+f(;^FRdYb@9Ru64-MNCmOrQSHSQI;V)n6u?dy-Ne91DU~ngz z|9}?x7n~@lMOqC%OzpCJR*0YuPe3I3ALk(1*%i)p)c+0!^jg#EAds7wl8WIH2+?O~ zfoLinS4PXXJMoE=e{Z5Ela zQajVlPFM0&mm4R1tFdCpbGraS?xO&W$n9_klh)Cn@%i~9jp_h!?{WVSj=KeyGgm8J z&8%^=nC^)@V{F}Sw+nLNMkB|NN@8E8$I06Oa|mdJwni^EN}lnup3w}9vp0$XuqsI6cKxauTYU}O9Hdc*jVtC6vn>sXujgxHinORO z>O+)E!XR?@)Aum8*jB2Z<}@fg-FyV`@vQ`bi>%X-un_>al^syZM;HR58xeA6 zd?Rj;yD#W<3PT0vZ0;^SDq;=sI#kX88RnK)d;m9ke+zNktPclU?wC6084J60cT=46 zC5JGMv={Gz-S}>ci?>KdR4C31-8B6>ybDHiY>{QK$|>-h&|gH313u{kKq ztF@UT^J^0#D}WCOH;}vLO$Z*AvJ=Z+v;kCcn!+x^4WPB40iDud2|iO%5SUtC7l7>t zjV%Yjq;rpVxOeIMXIEX(kJDwpKs=(}EGAd#(lMm*b!sGN+NDm%LL~3gQR{x{sq_>4 zw9N8_XL*pp*;G-<42khn<*X|pdDL0kBBN{1K$BJ7x7V4Qc+<|F4BLf#ucdR?8tynaw{Z0*S7Ig8i;*HU1YgklsIl1^UB7uoS;G={|AZ6(mM7qT% z1wy|B#q=AtVQ~b)hMuMd;S-aOYaRZr6SSa75Qmw+QP%r`fcndJ_}Pnmh}k>rFze@)g{LJ)JcdC=j7FkYFJl>%`x z`;f#i;jcw6i;2JO!qAcQ8Kw|TlcDpM%`O=oy{>zGN32)9!r4rAAZt?wYFN_g-{^S-W=j%_$ly2p$o)kaJ-{|lJd=NxfU~7!-P~J$aJb6j8s_QV z*1$r6$h0m(Lo*72-T6y|YaJ$7NkJyq8_{gnaP?bG+L#=6+Oz;%3E`*7kh$}1x}k|2 zX_q7u?JqnbcoqGXJpY>%7f| zaIEu=WX2Td>IV**KrMY&-HvPmz5NW-{ zsrV9L7{(d}cn400>Y%NA*e#@LGE!6M&19rQdSdAH`qJx^<<`{t{IYbC;u3vJHc}dd z#E0VzE=(IH7NmIk1@}=1TR4+K-QgQjY_|Qpc6c^_f<678a+~!Uf3UhhfO@|`erK1F zRA!HhI|)DM$?xml@8%knBfJY6z-i;;Sso*h-=i};ESC42Yf^%}5*|r_Hnqxk%c8N< z157w}pEk(-7~w83uX_fvsUQFt`TFTa)m2~ zW+wrIgIqj`Y`8WwxWRnC57A2sO47d`>}gCWKTbWhCI;N_#%NU%!O^ zLtCXAiP^_+p$st=^Ub~jz!15Y-J+i{^fcL`U8*BCsc8bzsI1}-)cF`x7UzB!u}pJ_ zsgf7HLDR{z@3bE{gs>Z)MF4<9M$g7&EHcQ(;z%9?l8|HT6a_Tx;lNE$L2_0SJX864 zSF_z&u_!^+Dyuj~S@7K^F$mm@iRmJ&0{vES-h{9C^nNfr)cZ2xr&Jdv-}ZDH#Ahh zgNZg%MngJ!1?Ilhb`~FE=+p*&?+r}z0Q$j|<8cB|Lm=-sjRTM|+<SPu0}R z1#0hs;~-L76+L54_9&*KeYtiIQ7kqY7zBxYn7##YGDY44kkPbF7^ zVlbrKEf}KhcPfcKM0ne`y?;oSg!@W9zoy9L3*eg!c&^V-F$}zv z9vBYO?>d;Q`!a|12S!2IqN6&q37-_=&tW^U0I;f19K7aFV-48e#87(=SFQK2yZ7xG zxkU91mc5;J0iqabhpJ%aOO#5B`+FgZ9cl&W>EtC!mEJL7VgP`7CV(QMhzS267=O(e zNlzJ{~o7hQxCRXQfon&>Zd$B z4C#If$+iDD3A`vXRO!Y0=Ita!P+-aZ?tIflyjq-no%ZI2^Ju@dgPZ)eIkBQ^`eKlc za}1`Qz&TDxpDYDN5w@Grv{B>~ z2A|_&Uro5~0f) z^$rJ$9t<_`aVm}FE-eL4Dg$!@IHF(2iZu;@sz{G=;9}=s4~$$MOqwfiOqi+}6B|^y z1s`FT(`yTw1vG#$2d48hGA*qZ2R#TK)J`*gvVnDm=>##_i^N?Kic#jIFjm<7tv+YA z;VC37XMA<(Q7Csoo*D56>&n6Z?5lWs(n^X2v8|LV#Y2C4bNDg-EvIGV&nvZCleoH+ z@nH}JzlcOcu+VST#tj{s5AMB3KeIumuB>8LIR}5$*I!HL4JHecef_TkpV1Mk&dS`=r3v&#d z12K3^qQBUDj4Tt%c2(4Y2|2u+Ovljy^bTZkIGZ^J_o=Wk35&O!Dt9_3NG|6CJ2N(r z=6AddFSt_6oqMBjh8%hR3~W`&0|>SsvP7_k5h8= z@eZ$9U>*r|&{L?z_rh$!2uyKs5KT=^vEPqEy0jg_Z?=SBQ`xLc zBLO!pWv~}0(iyI{*`F+{$DE7Q;YyLbkPSBDQ=ZXGehdG!KgH-dq`fDIEpwJ&Zr*GT zf#NZY?!<_Ge~G4|p49hR$FbeF+d|`VER1yG1BjBC8F-zUBhEvBjIHs>wQMh$T)RHL z|J*-WIR+4HH(4;cTK!v6sw z+%h&Qhp^OSaLeHmJUOBOk8QCwKHRNtbU-gQz;g$v{uh!()~cJ|{sD5--%^i$i+VK< z;tUGW2y*Y@$xz1=R}Y{=hlnBgS~XJ^vHcbrAx@<|k@n?^G69HR$G98A?ni@;ItFw8 za6DQlXVKg~W8+Yp29q}(;M+RFBUFc}Wg~hTxKACmZ60_|gKBzsjdTL$Phx69F?;`t z)zS%#-W5{?@tmxIZV{O>;ss6p@qxYwADSOqM>@MW5TH7qeY!ZvD9tpA&J8^zWuq*} z2)(XJ8igZ?t}PpqjcZ-uko3fCSg4JZ)!uAmeGSN4GtvW-cB$VKtU8*PacWI$B3*aH z#8jwCr!=3ZbJzi2g%D-Qr~Db@m--ou(kE3-s@)(ub)I~K_x+?OjJ4L`FhrXi!x`1k zwcNeV#G-IQ3c9a!8g9B(dbB0S$(y6!m=_R^j+2NgyJYM`Qa`$^?(O3*YGI0*7I%63G35*u8mnM!gTov&~t$S1|+17%(12ycqp@JM~yT z@Mte8xe%I68u@NQ3({}+9}q-aqJ@ z7QSVuPpT`9K+QOI)j2C7>J_RGb={D}2kG97nmjDh(lR+kc1%(_!@^5AqCJH{+H-as`bQ}QXxN7(qNTP)Koe-JebgYZNKRf-Cf%O_?^l@SkzoJt-?2#sDHyo_!m%eGN+Uw5b_4UUQ! z<9zC+93rE$N9RJ4M*!qGX1Q2J(F%Ulp5VB{S*L?t~-+ZPEvsCv7nLTk^q|zq(&8Y z+>o3_q+3c>x=q;$o%+vD)LwpRCex3a#i7~pbNxHE_vX?ZsI;(31q>fg1iekr z>8t6V?-@M09=3A8q#pIfC$PNweIk6!lUgaxVQ=o-WQ^gpZKr%Yb-{#O=XVpwmT}_P zuQHuDLDGwns&IP2c9OLuT}oX%jV_QbbIU_!VU4~BT@_vrFE$s&HG`$qFP){A=B^3j$6}3+ zy`dtnx3_4H>(uh)R>9|;;vh`LVT;r&nX55oHZl;3Qz-GdbFM>Kwk$Et?TPiU-Eb84 zbslg;{|eA?Qmv$%oQ;03bM7osF|yM>Hz+wIo5dk2SgUEfzuSr)+TlN)B)%92`b6{y z2V&5Nrf3s`BtX-8i3QcNK`3qfRZ`@zvu+EYu{*5?{E+L`d5LZON$NS&`U;dTsiU5KaH^X$DaXl`%Q#aPx3+r~Xd3!BeJuhS0{^1E?*) zSYTXG2(Mf$(=>I1S>qU1)^th0QSjlP<*bSS_Pm(abZkF}<1IANREkgoWFXr3EnM&P zg-)0&zdRuU8;Oj!e%~3BvVoD78)b9+1*V5IUFyhr{nHN>K%<-r+(Hipsxb0nN(mYk zOs%cqk3xn{FB5{*Z3P9HXVE|V$!5oRW7;K zg9|tvKMhpX_=*>X+gs3gwerbhiw~s(5hH{j&&I8=2HsOUojNjs^ zEZ^D==i1fagmCRb^KD0pzWj-KYFVsL!A3+{dKvBU`UwS8dT1_e=$r;RbDx+`uiTRI z1foE=QsiW$#ICc6v~R8pEP7eQ;r*YlR?2UZA|z|;M@9DrMqC(h-PUcX*)U(xAFc^T zb1;ktD=|Rjvk2~p)D>@gHI~)Px-edP)c~QgaIWiAV-0+nXE{f9AtjwZQjkOs#9$W30DY45!F6y@|>#vT7W)pa+=yJ#_V*#{~TJ2mQSi1t3jTg(PA zZ>A}ipt1vqIHZ!RBk~npV9?leEB4G@FphWtuQXF46T}h(%Xg?|stkY1B|GP*KAsPuoAyP1Tq21bRJa zW^Js#Eyfbdt5yq2N*8!paR>h>stJJQISruCCh<^@6elH!5O`y+Ux=f`I2Y9Rcfmz8 znl{|Ho@MDpCQ`opGts%Q{)B62G8QR`D^O@)zDk6Z&sX2KC{$_U?^RDI>N}O<1s1@$ zHH%XDgN>ogs4m`@Xf*LJys@;L?44Kj7cZ@5=-d#eZ+qx~&Wp9dY^u_|i%W$2OJuq- zCu9El(b8b7TF5Wpv?-kurevKI_nNl2Fm)=rVi|HSQE&SunO|?;`^hlEavu?E1Rr?i$0`mGyvU(Pt5Q?xk{}X04Crrh^OQ*lq%rff#`!ZcX9bcPD{XQt z;i!I|NexSIL|_+IH<;>Q>C<6e&n#*b^{>Ezhw&yYq%KOVMY+5aF)sU)y*HZG28|Z=SdyZ8x349s=yl)C?QW2X|M;&B%As8{8Dk(1dj zXchELOp1g8#l0#c#CMMXNzmUL(&5i7`*XyRQuw5scKAJzCdNo#PA zn@l-RsW&IIC9(Ke*Nl*=u8#;8DZzLS_@qZA1QTeLNe?fz;9{A+cR)-EWQWfa!tW8F z{R?AHNmn?jJOKG2s$2vN2PqUnQRJ~}2&`F-VnVKPL}HusU3;C2T$up}!tq2q*N*O)ug;_uf$w>F_)$|LzWUvzjxJ`N z*W>&iY?VB2W8FVd67;a`5U;$jj9e`u=kHr89g~456zx6%qrng5YP>Wmy!ghgDxAxe z8NSOR&_+BuzjYpY?s}LkY;?5MLBQb%g=^kPh0T8NL83c`R~}Ym->?VF(fOSHE(8~a zS>dt)sMCy7f%aUA630u42=@gLU~zH^G_V+MyA`XS---so#FxO+C#I$Xb+7`7)I9W; z2iyN(JR^NAZgi0?77dDKUS5j#vOs;y;>CkSF(Shejp<|My}#w8BTHw^bcOG0m* z^D6ekl2vymbsR`vU1?1CsF;p^$6JhgpKY%G0Z+u+La%L&i~Zw>P(PA8;_}P9yQv#$ z)lKeT2g3tp*K@8zZ64XN=0uxS6huid|D?59*0e9{B)Y;tJW+7FqpTQ>%*`s6$Q2bU z9O!wz!2ONO~Q+z4U)_Lh@KVQxMl9b<>Vw~FP=+^mle(0AIm*g zBW#6dVM;;*J5ll)qd*7@my~NLG4D!jOG*mFY1c_B(qS0sY5|7wXm>jpZ9=~rw24!h z@*Hzy{0c{@47vrlc*G=An?@8d%V50*>lH!M;y}eG*B^$5)d~DePGHdVr zM7lVV)$`&Syu@dP|%_Z0T&XI`ppXwyVXSNsZKQ~D~_}z zXx7@oK%oN!{+%f z3DUN+%W;xA5nRBAsl9B3Cz~vG9l&bz|G&3DiU=LUqxTv}s)S$@I zP!VIM&X$X0Ee}%6oMThJUxfTsy3}XE;n{^^-GhzwjsnKv1QfAmEe3~yiwq@5;)t_K zKqenNU4?k#(<=e4A@!ozVcX5Z0^~Ix=Uy~mf@VQ~j2Lv5N76-DdXR)QkGQGufTMj_ z&~oN#m!t&A{h@vJshlXi+`_TF%o`lr%ClA^wfU1sfYZf?aW~@l>z8psAW=cmQx)s< z=0f*-+#8Z;VgXUGQ~EVYtTrRDvm)toPTd;x078gai29;t*(;GMF^CLr8#+3R+aGvF zCKZZs|0T-`h9`-;mq#354e>i#E=UxeuFv8jb)E@sU0%Kr(?Id&rm6Y`LmK?L?)`$j z{N((t3mIc)|M&WUfh<^BDo|_{Jr0FP)yAoSEKP3$t|QD4d@1|vvSam7T#kf*BV z3Z7*p_cMqMd}_zPQ-j2#sE-m+`(=-l9~6^q7=Ey(-L@0piKmt5!s6nlm_P&Qu@^9> zq41f_>ZgWMbjEg*1x67MP7rcQo8)d>qveE(V0$HV*)*QyppB22s}Z_&u4;H&iYW_b zzEhIO8JE8GzKzyT&Zf^LgRh3|&>-{3`}Aam0cQFh7Am00;bUvh8e`J_(6yRSYhy48 zPz2A@WgLTRj;NMkOU?z5OGXg7#aBWDS6J1;!^OlN6*}~S&38zH^(9HkJO!baV?W0tok@z z1|>!wq?a}2y5=k}Cd>bD-EZo2@8B#D)N`(5IGkT!elchgAQoIMBUh6QP_pH$ujy!* z{RuJhtFx;Mav3iEFg_>eK_?}ZEy{t-sw;SQc75^t^A{J8w)8&UDg#e%)zgX~Rk~YA zA-krl>tR<6+v_UE`hDx_nk%#WUEOhYk6=SzFX-#VurE@-2Yvm4!N?%ZX}x&S^##62 zEWSE>NiQ#ly}TIo^5WuK8W3vE-J1qx;WK}P{W^=F{dw6ic!*r;!MJ$-BrYZqgbMv+ z=Y>cO2VZ(JM5_zw9@qG=8&Jg*O-+T;iTv@*jImE)EZ`SVn8$vJGnplS{Uo33QHZ!l z4bEhx#6YnfJ5VQJPy-PMoF9{`fd}6iyz!SF-eMMx1^XQ2)dz3v-0x1S?~*l8hi)$x z<439XI>D=Ji&3&yYl=tL>?jSH8{7ri?Qc>VO!BFgC~pTQwq67(V(sf&^rerWSk$Xsd|DR+wd!*rZFq`J(dz*jahpd z|NZFfW_naQU>S&Z zNOdKLQzhhkgHDI&rEjRC&f%n)iV9Agdh*%D!GC31$Tk^x^#Zo(it9i;@V@>0hEcSv zd@;Sv2v?!Kf*e+GgTAuX!>B|gv(wuJ+DXGL8^;OEWkvPlZX1KGA`!zv*g2%T(HV?!SI6i@Y7%Z|=&#KRN2MjB?DQ2ko4h z>l7_FQ5sPmBPYsnlqH@NE=hd{N=m|TpQLQyTJqW|8$B1w=F0d;6E`zXD>b7_KotUx z&PG6sOK(ftCXb+L9nFm>^F}|cE>P($6%72(RtM0~;WuR*Yh2;}H*^$5Y0ljz zS9?`$E8soT9@^~;O1Z#FGd$cAYsxAqOg273q+Mfpcr^f6Gk5%ezXjbmpX3BWodNd# z*BCRefp|#`&*(l@i@BgZ^pRRmm&xergn-sSHS+dJA&;^Xl)QFYChCjvH?A@8pIQLf zeM0;Bofd+g50=3eRVJGZ3!h_T*h5;2GFFt;l3h6%kf`n>V(wK>hdwYIy@_uPhegHa z6DaBc0X^b{V5Vgc7y^T5^+M$4k|Y7isk>(8E7PoT3fjukB{L?68!!zK2sQ-#IPBRE zRxsFdC&IfL$9kn>J371&6KNbK+yi}9X2w#u^`A!3@hcZ4SmDrsH2+f_?y?Q1V_qA% znEvWxZ@s&?>e_Y>ue*l=_Y?hgZC`e6ZCcQH$Grl(&7ynJwf;BHxYsuxqrb85Ml=+6 zGJsyC0+K~+nj#X=r>Z;CZ-z%YdC2FMyHVb}P_9t2Qmrz}!8a%Jk=II9V8jN~B{G{l z+v}B4ymYg~Zx6*W6z)s#v8@~+5)@rQ08BB?I}&6_g32nFlu1hsj~r&#Ft!;KEmhKM zN~{v@)xnkZk@ReHOqAO^$+uBqp~S%IK7jF_Gx%H0u!BL0ko@egOfs-tT6;L^-ip1C zjGD0A>uo613WgSRe*aylM*!rWyn3RWUqEw6?mFK*Z-=_yD~0qIA}4 zBo_2YsUg8Slp4<}z4`x^cn7dHf+=Off6VaK{M8UhLZgBn1&?dlmiTP;lBvL>p?Ah{ zXm=2=?>l&(n)_#CSji6?`^^+rR85&`HF#`QOd(1Eb=j7Vb{)}bmBN?_GNjt*HrJxacwlg z$N_g$&=qpStNFS7vV=j2Vc@pjK^-=NBWH?NDNG#*k#Y;eP-?1!H&NEUIo;vqin*vp z5Nd_yg93SsBnSK9<0u*@1T+#Xg5@~RBM-l%A9~>Ochf8Nr4%An=1`SN%Ig%&TM!^J zCcMj^i2^A5tf&&98xU?a!QaP^f7aYMZb``n zLOTWvO=5|pY3NWT8xO*!#F7%%6XTCuZ#z;fNbR6WJxyhnT=FG(|&p5So&c{!P(BNiB`M z-9`w#5+jk!;Oqd-x~si4HJ6ExU!{>zxkgM0g~LT`3Rb}lblU9n=zBp~SUmWo=jOnu z>^c~FV^4{I2s5pd3RY*kA8@*8LMrofPt3<`ncVkto#lb}ip||JQY&PB!pQ+hm?7_P?Y z@nRT6u8-A_PVD2EnQOyE7VVZ@>BDrJfC-%tm7Pb(#pqWsM8BKe=^?r)#OcI9x#yglY3~h#Mn@huisTO zF(pr$Zq~R>8(u~ynA#n_uo(rbM(bqw`<7nxxfEPuyE6uu6frMCOp*WgAm?-kDZQEB zDY$z=#p>WXBibUSclcMLp+hUi zha!y7;<9Of$SY;&&Zc{g@##!_w;bJJ-M-u3u!1(aVD^t0N^rM&ZPZc*qSJZn*h3H+ zIf45Jt`q_N7i*WJ7KaN_8V6GA_kC1q)-s<96 z)GbA-jlwhJef`$lm2`LZV&dzA)Po#g#zP&v^#ylP46}ViaG<_Na@3!{IU))%t?T!v zKR>K=J&_8n6cBRR%BRe?HU9Oafuzp8lWzF{UJat-0=Rrb<;@Ac!w52s^6K%}trON0 z5972H2ECzK}u8zPYD-QY@+`6Pa6Nz5D({)g>%oTBZI;N336vE_W^(QZ% zFjA~%0ct6AR&jd@f%Q1N#!UfG%@Qbi94VE3hliT>LIORTr^#XWc47?P>!CK>FJ&u7 z$wbcz$$>LEK{=GSe9=?&O)VW{>!EA0Y zsU^Kyo#g2Dt9bTmby^7{frB-<@*&i~)fhU$mNt5sCd~?|GKaZGaquWg914>FNEJCW ziu~cJ<2TyVW=Dc+J<6KGm8h;Sv0}`3b|{F~(Hd?`P%l+DQSskIQVq@j{S?%+a1lkL zqLcJ!Bw!^(qr>%5p#OS$bmV3N9@VC(!Gtu&AFyC3(-l$hJNR{tZqSfhX0FyjCU7wL zYo|ju3T=9Cm%btdYVUD${tf9Vpi-X$5hBh!o)+}DW`F#li4RPsbNAk4~+Q z-}q_rfQfls000F197ii@998ska|UJfreQwHlRj_7_ywM~? z&iu*Y79BC1dn8=eDuHz0FaM+XP${cTOK|I^?zYEN#-VghQtQ38K>OZf6qTjt<1~YM zfHlOYQO=~4o>PZN=|^}7iap|&M+tO_wlsB2d~Y=H<*@=MDQo!Tg*7^PJH(vC!E<9< z6Sf4C6)|p2W@mSXRH4F`NGFplskAMkCX|ZxkWP%tP)+cAjX9YxtPljBldnr~Tgyig zg~6Mpp}cAf%ckyVvwC;N_A5`}Oi!=KQa6U=$K(a*oA=?w((zaD_cn@Epm`Bt|E|jR z;q?Fh3)(6=T9%`@IDs)qMvxbwztm00@-_kz+x{YAUr&MD43GciWVv>>gnnvP=cGcs zXyV7OD6CR}g>3AL_QF2Pdz3O`)rLdenQdF`hT4vWSj(wg{diFj_cjXp zRu7YR5U@Gf2{jvFt?BM`W5m#E-`NhRGgQQGA5Y9pL`1JfT#^4(k2^E~JCi9lzJQLa zK@cjOiHc`_$<7nUHp|VK%LSQ78oOyW-)^d>B|!%h@OG9X%lT)fDeu(v$o~u&QBB|x z(}}hSelpB-!p+<6#1ZtFcnQ}jGCd*9MtdF*!c9_)@d3jVSJsLNBDbZAWgRprFx?UF zk^@Qy!>tkp`w$Wn2WAG>*4Q~?8!PmB<1*^{IbLx`{1B+_rKj)8mj(2FZx)`EVzySV zv^~Ctu$6c^QLP&U=%?bEx7+PvWn@*-yf?zb!kYw%x7aK#xM+l3$&x#XF_O)t zD`C$)ab_8cAk}*ir7=524F#S4F>)E~&}t>YXJ%-unth9t!HY>if$5+MFq^)Kz1X6Q zw5S&Z3J;)DZ^Kh3c~eD~=#<*W<&nEDl|w0=1^jnb5xr6Bm1IS~>4q0tytWxw zI!PYy(bdrl+(+gozH$TEhc?ZnTu8&zGh7Zxv0F-;JG!0{_muKW4lmho=Mtbk=r(KO zLm3uW!5DKd#lTW_NMEUw9R2%BKgN#QMa(IC2PSm~- zW&P%lBmrnBWN2^}U5J9;jckyj=BRd?iM^`7l`eGa>A}9E;IAvqEAS{ecd9wSuSs8^ z=cH^-0Ixov`5f^ z3ny#jB6LqPE41?56^uN44f0FM9OYp&?`L-f8n7H(rI#p_6?qs^ns(=*a0Mv`g2)I; zH62|V`Bs?An~5c(oe2DBzh-bWv4(o=}0AeS?Zq{0LK z=9q2M;6@D)uH|fh9xo#-H5lX@GET|JNgUKR18PpPnEY0X(VFELVHtrikPH4OOljVuBNm{NI-V?%>An7MoZv^DuvoV9qva*DjHr80~q4d!Vu)M#E500K5rXfi>7cy*@I zauYCR#9#4m{rZ-ph5VmP$-;QCK(mgKi8_kiNXdVB6$=&pQh^EnhQC}1gOsBr?Hm%} zkR(r#5Wy+==3AK)I;gI4Nhk;^H1X(zA9E7{4z1B5;Al{z+%thKc}|oO9=N0hp6(M# z{U#!1UUw`7;!z!F%J+yZ^)u>pcNMXWHb;TLIHb0Q;aiDQq*<%V0IvjB(QX`CSZ;Jp zPF%xI0J2NByzy(7Wte=DL_3eH+CQSRoDsm@ljvdI8W*UeHZq*JfpZfEe%l?B4!>bfUvXBX$?p1~s@g_meS> zN&V+~bk>Cy17k$ZHN$#BtRNQJgS!V|>K~{@b^z?`t=t|}+pD^$MY6$c!^d5;{LDHe zld}YqFydy(%!ePGtP};VipqE*;G*XBmW}n59KyJ`l0%rTdqR^gNTJfZ<93T_hF!=j zZa1Ya4TolGFVlPi1FSr%z4&`dPhiDm==r4}7M4Q9-E2=5tZBnjkpf!$9$%^pp zh&`4cUHZ9iAG7-j?}^sYlG#Fw)rk@Dx)*qu{fDY;_zxA~&>xr1hco3n-(CG|(I@=m zX0d+1b-0Otd|7pRA6cQHfeKVrNbGS1V~XBNUMD!Ib*nS3#IQ>Vl)h9E{IMcAy@gHQh5v7~l?{K+l6GMyA0Ns2^ifl=$i_ z7~4cSg7xQ%C;#N!hiQ>x`FVfGC+Rppj=%EEh2Ezx5a&-lh92~o0J3eXCXE(KTaV(V zq}pLKc{>J@D4th=p#K=rQ_NnKnF`kwd%_luRwOg|tc+wLQzeuq z74~Ffb=s3S|4s?WSWbd0NHqrh@0EZyeeeVIYOTz)_T+Ayii@F}*1G3li8TQBpf8G= zhzPKB!a4!}*QEs?N>7yC9ck?fSUM{kh01Po*jJ&jF_-hF%QY+`_n<5|M^P+9BB%TD zMV5`_M|YD?zlh}*e~)^6Q|jxI{G7+`N5Pal6BH|aN4>i1vq=?9$9WUIV9~3J} z2~U(SD{ftCi!qL-_-u=wbkts|rFB8Q*BmPR*Bn>#y~;HsKSPiFbWRjRL6AfGt^ype z{I!o$gkuX+7-6!lNdjED>B^d_rpjb;t(lM?YQ_MZ ztcdfj@IuEhbcr0~op=$Xw`+i?th<(#8h{{SAXXBeVg@TrDAYL<_$p3bi}wccg9+-j zT+gU`os0@EGbJ&4Q9KE!e-jFrymY@0~+lJ%tu{u6@n@J~Zg-zT;ju`jfxw+{uo zl=zb;kJJIH_iUn=;wwCx#9>lscS5-TG-f90+}RBJR$XEvc5afG)u~alISGbn1FXU0nt!D#6az zG;g*K3Murqz{YAV-f6bS5h#(`;45j!?S>C4uNr#(}2^Se;d9u z#L|Z*ei#nr(ac)sy0eAOa+!(o8fC1OsaGU z=2V0w0&SSL6$lso9#fae^%;V z3O<>BIZ2#3jGFs4$X}zoa0m5{sO0Xpj5eT`rg78E&{~FP{o1CtTnXg}9mN!E+5*Tl zfAdJF-WY%e2V4A9vq(~F&1APEZVh|$?b2?Rr*Gx1g7M=NzqpYMtQ^4@tVyOv0$)o% zCDm9y^gC!>s}b{C|C3ge6xwF?eg7faL1xfCsPs9 zyM6}tP~E59KP*z(Qr_D}i1i~0`P|L!w6W6a`}opJo>PUO%1~Qw?%!{n_w;!RaNobE zH`fTwEGqXWa--;6c_s4Cr~;Y;3PWrm=P-@kWYvg91BIR~1}R89iaz!rprB%_QPdAD zW@V##Brd4HU$=EJL_$>sP?~Dn`czG$>OdZC_t{lemPey~6>7B>^1mel#L@4*U@yc< zHHta4&y_=xofQl|qfhI?Eme6^EX9ZlLB@S}QAtD~mU@j=`IMW3kIX>v%4A@v1sI>w zL`(lfmBU;iHO9CN*F%y9>^zoI_&Xgmawy`APuq64o7*HP9ThJ-J{pqa38`1g*+66T zU}3x9%MXAg$>SUBxtZGCAj6KmO)WqM%LAa&2blPZpDYUJ7@lvLf}JTSb>DTlW1h;$Yx8uroM2=lk*KW_ zW&+e{_=)LmQ3R6ZT6@M36H@>5QURW#x14YH=TY)24olMf?>dDstTgBNc2}$PLkw;Z zAqM{m`0d{5s^}K6IB{!OWZ~&5x&lUHEFoO${H_)+p<0d`U&DT-rwY3PRI57@4e)p>za*Woh$ z%}TX=ypJXt^Ir&AuYIb}r+BU=OxlKq#a%M?C+5`YHp+#Mydu^@wcMBhu=EIKIeZ`S z^gB+^>Krm`M)!==98OM1;7K7lZ#>213y7zfOd*zs|0`inh4&9C<6gZ@y=}eUw)Y8) zDyy!0e41$+A}lvUDN2leQpA!cEoVvO6SMP)Y7PDtMoCzBE5021tlap@oQhs0oYPhr zMAU($f~Bb|YWG4@RJ0&8ygvIBDIdBBBLO5*DTri_ZiEeFBjwIL&SH`b`IFP1A}XaN zPNA0Y!-ghNJJRj#zNvs#3LW_?{a~h!HV6liN zSj6xMQQM|g2%=8nN!Kx3_pT2|6CMI2>VPP%BePHL*88Y%BDcy3(&}^R@0KWwhx>bO z*zUJ^{P$aMz;vLo$^j<#s;^-QYp9@%a*k88F$swMB;=*X90Y!O2yo&yNWnJRYgNMr_ya*O^SHZ zt6L$(UXIfMWuL+VrMv3KxE``?nXsBX8*M!`;G+F_VaJ>@skmOAtQJKDQ&xujESZji zVI1jk=~Hebt*|(<_Zn0yRm{SQqDUtoESGl`;#uC`tZ#)#637nFF7LM+-Q6UuRXJ*U zu{rI@orwQPZ+N4&F z$10al#3JI=v1e_e^?RvXXhy2`lVAG2D(;ux?t@7tOX?~h=y4O_PWe_9CY^4Cz3Mc# z-A=v25XLHrWbv~45!DpY>|M#9iDl-!Q)WcC+qd}pmMTuKS;t%G`+gMjw2MbTgU0NW zlcfx3*n@ygl_CJ3l0qtc5u2)@$KhcK=jt}Yn1Br=*OR&_hxO^KS%Q>`nzmv4Ba;YD zl17X>0A1W2^EAHCsVvj^wXD=j8}H=-LJqFt!5(5+TaH{w*~J*L zLh|#Z7LbU|(e|Ta>!y-EMgeLsK0wlE7edQJCy-N&r|ZKGNkz+`c@Toznwo&_N0}O) z1d2bF)2E)4l(W_w@-&G)g`zCG1Aiopnzzj21faxe&QAW7O;w$N%3N>>w4!On;`m#bK$ z8MdFM$IawQVRKcJ7C0nSC%pi6&?2~>pLhA$Wp!-$rn%o*0!=YzJn@$K^jpq5wCArN zcpEsq#|m@sIN0*)@a|6J?Hn5=aFIuGzg$teak++fpLR)N-;;eF_VZubr<^~L_wi^^ zhzk-ud;pEw4dr~O(m~RBB~WU`j~2$uHVKKxMI8FbTmm#>0Z=&ubwfiJxPJC<{O4zl z(e~+ez-*(oZ}A`9C$w4X_%O~Aj;`qnBk>9{b3-2s-6!tFF0CmKp$oLb9YrR1@wqcz zfEjOGiMIa8#g0>aGKJa?M@mox2PNV1aeq@4b9IVUN?8Ch=x^8^&68N3=<9y{H}ysH z&-b;s|C{=vdF!iZi-lSP=oMfF=2m6k(&J9RJ=Sy@=6y2jUSLc5bi+%Lq5+Ov59f3g zX6idC1EcZ_SDPMwVRtrM&QC9+BcxZQZ#E^Xu>aFYG)M7bvmyM9J8K8_7jbs-K&r;^ z?9;_T4>e?2cPzgKgZmBpeB;KOOIvELcG;wyFQL>rog-&}?**ZMAoDw@)Zah)T`$sT<#p zo?Z8u7(|(;-=YiiczWkM%n=t^7f^H>Ljmars%p$9KIq8Q=nod3LrWb~eIRd-?gEAv z9p2-|X=;b-XgGh5E@B%&r5rv=ZPf7H;X332!4w^ii6T8rzCRFJRId5Tu+25+;gKg6 zoTd%Zs(il4tx{!OKAPQ5NmqzKF8=~ItCIRiX^h-+IfUQiKk4Qr0i~m4VX0@UFUf8P zQUqtb@P*XA0OMi+Mrn?aP~DAQ6R>}s>B+aN85_9x6cUPgtg8!sblVY5>fEa+2;n>8 z7PVm=K~-T&pH7K$!C6$JD`DD7H{>A$SAH0y;biHD0+r8I^?7mPE?TbkCy+%DN$5*$ z0F!UlI_Vxxnz}~;A&Mq_Spbcf7y+Ah6qlq_b=qCr+s%T34jPaB(s_o`7K0lZQyv0u zyZPA^2yHXma*~`}8FNu289Y)mzE7uICn9u1fW~ZYHr8j%?ghe{5gkxa;0x|0yVst{ z+T+f!^t}b!S9Hzs=T-juDyG3K!U8+^rVU|wE=5)Kc0Wibuj*u~i!*S8-IGQ%EogQ?pPA^mN(ey6R&41fv=%J9m`=)FFp6$FB}1(FKo`YWD-Rb;_3{L4#S zRYQP_p5p8^{97(4pmI5o7UsG#imk6?u16m(m{We+l#^I=IqP&Mp%$VN#Z~l?NY6;d8?vxWA{7)RUf?fD8dx>Xp4Qva%?0MyT5j(Q5xT>mwftM10xx+Sn zBNy>bwTJciRwWz!8RqYaae!s6H)Z$((k#}Yy}5rN#w4pR>T}rO1kKA(iHd~2Ai-&8 z$t>@u+^Xm4kQ^>~CAp`nFgj6$MJXXtG8YWiICydG*YA}pLW+JOaoD>X*AXev&JLD1 zDO>DJ9ULSnWTH6dSW;xp_b>FdFe8AVd6?6+;rlSt-a0ZVwY9}Fx4WBmi6RaLjg_*1 z&e%Csd5wHLBYEE3TTCxFO7?-S3kT%l0Z;g-GsFZl@^H?eWdf%^yH%sFK3#WP`cXIfBIP^fFS zv?F918Gmz(K)w)-ZKAaZnJSOiF52rb7Tw{wCf0`nT$o}k#hCc87}HOqa4Lk-nhGZ6 zJUP-qhPlN?xDhCx(MX}^_-1XoI6&UvX4N8qN;u&HCPY;{v;(kDa>)A?2QKma>~=ES zU`vxvvU`LI6}MXc!@&k0EZEhf9rMF7>RRwdfh|Lo$3?|H!na@g&|%s^(46EXAv03R zDTp05ZYbp1s7G^ZOJNLff6++kB86y z@8XO!UVvNt;ej?f7zglo%lV4C+?$K3@7s((SspDjt|@+ykzbZ!50XyqIhzXFBeD{K zU|xoD!5dp~EBS3IGe0r|U2sHaR}wl;$BB0a7Ft)S7Ue$VaaHi z)~*wF(?yzT6ak{#M1%qp6)Kd<4#o7v&Fnh1jr=II%JmL@o4n$aF%Qwk^RzG|6k1&S zHKWaRFP;{&!j-oHHu>!U*|ik4v3CiTLVt%dC)@u_1gM#o)iYSs?6q|HSW9YMIiMk| zEUT;FoP=VFUi;U4K9EXU^oC3C4Y-Xy zGGO}d$}T+s5Ni4&swEWw0dV&OGUrYaYj5Ogs(U zv?|IJIMW$Tf)V4QmxGD`s(WCFZoLDC;7*J>oQQ5!jYPg zge3}i`FInh^F@iJwD1OEP#+DvRtb&%_C-dU3j0OU1@*I7E!g0t#xwL3NP!tr#6T5I zf-^<$ybzXD77tME9?b8$;-1~p$jGXXJQvW|%Ix)o5*I>)sA722SHwMB3c!}hm4w$Y ztPxJ{)Ja+;eTN5!!+&HYk<_KF1jkSeK+QZHAeIu6+RVkoi?&>6r`*a9txgOw@4C7C zG}4@3WnJI$^QGSWWj`|H>K93|95O$shFd7jU2pjyR6`4eANe+HUL|kE zTAUb^8dd;(5SvMn;G~jJ<=={p?%{I-8&po}HTpw(7sF|dftF7-E-4C0@1)`CH7txvU z{3P8E0@#x*|6MkyZPKBH^EeCi{fKZhbyQF_Td7OTNVUwO*1V=fR{LP|`tD*(c@vd1 z`u3~qZ@&5#B<%_p+{aL=+OUeCto@V|*TIB+-#r<(uLC)g zkTG$-%j~^4PVoJgy7tkW$f?=rUr?CF{5**ofZA02bp54;GN1`QZ@Z(bb~ zImvR5H<~>my}*2RPc)q|l8ZI-jHAw>&}eB&db#-WW$~%B;Iaw4jJ2rotbqK-`Y4Yz zymmAOUCmZC(iByFv6^$TiSnELAGPwQM0*5_w#UB1swe84fr6dp=?-;|r=KDHMO8&$>+z&<=hIL_7{&es`M5`H+FGw=x zJ@<+)P@8$sl@B_u2sRtj<1A&m3^eOA4f;%j0%S%je}QDE8%W7m51(axmwmyl zqzF;`CfYmG>NY&@^yHy%`zE2lyiYsS*ADJrV5xL1dO`0iv;6+-fl)>*o~?l{=_Aj$ z2vUnn%q#i8y5OwAY5K-g?t5Pc&I2m3E_v38{PnJKVh`9F-H!NhkINc$gNr#SUyDms zCGB-W`H{Tr+-4>$1d_`7P{VJDew6slc=jRnS%`4p)Hs!{5)N?t@;ZAxDBHBzA(9?; z1E3zLOY^#@ZJgZJ7q)p?#kG1otEXX@eI%rmXAzgLy9F6{Enu45`y)G%a!HoS*_?9mmLnV{faygA*q&QUIdt?)I`dfFwR_a ztTX_~TR3Z%Ko~$A3MNpXkm`{yf=QEghL#;2$tkLhNowjC9ui;Lb}(8w=!MQ=%LSbQ zTM$kwXEPp_%_PIPvIt7k5LppGc{6^Nn8{|D|JZb5=FDe#adCkN!^a5wZYo)y>VlRY z8Cag}xyoj95*<3F8Hm~0Lv4$VMp__GxXlGiC77T;fC*YbxalKaaKjr)XYvUFrQdyh z{t~tkq0<|k?-94GPYeO$+06-_4O$3ntN6%Wdf@xkOYq#76E#!zl>F_<4g-v`fqnUr zFhyUC^%T{0fpG6O%MU}(k-c}1*x7)oT01fg1^MhVI$#^X9t$5SVl5lzIW}A*z@iY# zWU?&1#CRXQaKMO-$HTi0v>CeB%lGavP8nt{vLDTvJDTIHqosBw3OGvmWcB2@oI|#} z{Lg_0DbkW2NWvVls$Le=P~0m==$u_4RD5pb@|;`9a2d%^wVoB67kbV-wI~CCBYz2< z4g1msW@L+-kj~KXo7o^icQo3~Za8$G`*LAvph%4d`f<63 zxD?wKRjBCtY&`Ci z1(SW8SA~n&@J(&2XU6DmBo(=H-e_mj>ZeP}6P-qt!pe=Cd&hzInh-9z6AQSt6`y5Z z+4kdc%b`ZpGf&8tlEAiH<8hGN!OQCoXEaBlbi(j6?QI04)WHoB=M6j8D`AbE1t%;l zfkk!7XBsT}Qr_#ul>19A#4ejTcDM?f=}mCN5~QdW;B3(K7aWy>W=p9oijVe!5?wcd zD2c1|+?)t1NT5i0iA(ruo_(WFx(ev^mK1}s$`BNY^s6{Y)yy%vgFR3?lP@ynQ1L0F znq4e0<`Si_YxGO(x2J43P(Xmim{4dbh^lZgt)X0_#tZHW-%F+1U|CK?Ow1+t)N&Hv zsaxR%PF+^wv~w9$6wA1>_m(qAGP*a9ki(cx+`2 z&v+St#HFQ?B%C825d+81nk$)&`b4TCJXd+H@WAbZG6nR&G9-LU#T=ZqA4)oA=K0sd zqBv6VToJF}HkIb1|aM15r1<*KY4_XW#-mWKq!LG_GZ11X5XerN%NiDP>X< z8+Wo_Nq1PmrEy1iCzB89^f$z#WaiE|Y7hMuo7t5sYsBd$b1~f_$C=v`z9Lfl{#3 zRMg2=;zuVUh3*O-$HSnfUOc&fi6a!&4jWp;Lmd9swpOYs)k0Nm`{s7sb+*Dn_J|DF zajH1wNCD}{{+H^}?@|&%Nk*w=yq3|;$EJGqk_R3+{)MjtMOv{M_JdU)ln$}szNbHY zbw%jph22ck`D(q=nJ+cxP_^`5UwKD1$z~~2OMYqeO0(p9RfJvM+^ps+qAD)Ah^Y2Z zv_7IOzq9Ftr^R=H%1BnAn(I|I2Utrp(B5umhYLclSEyn*RZ0ab$tLcsH%szDmvjAMA}~Kybzd` z76OmnCvI3$!2F$ZWu(Y@s)ZC2yuGO5LXCO18`!_0EnyzvAT=$s>gieUymocXQ4Chs zdeN0o22g#ew`tF;sgTdr*!r?biqxcKs$z(Y2@52H9Wi+`ec z?(e0$jx$iaf5T}K24OewDv2n$vy`275TH-1sCjwNfQL%7$X)-cn8#e#^1qh1}=qc z@wWL7c;M`UE`Xb*BV`12c^nz}Tt#qnki~JWF05^4(Yj%@H~07{mw|?8>SBHzBB9yj zd<_Ekmn*^80ll-(m03e|){ME70(-lk8FO2Dz9Pj=rO&j5(0#iOLo^lo3Onz(&OYw6 zi=aX*)^`}XYsG7!F)Y8E?V3tL;$Z!K?)v5hrl?_+S0L)itFzpcZku}#Ag56 z5Z+XAZfZn@F=}C(*xOeunOnes0oGy6IUUptQlClN z)@PQ^vGx8o1vu&9V(tmgSbzbAGGYYR(d_16#?^?>SmTyYQhGd|qLVRREK2HbliD=* zDI(@4jlz!q(12Zh(94$vD<^wz4JCfMuF#a(mR&ScS4C6in;Nq(E#Z9b4%$#=2ySz+ zB3KZW*-!~2(XdG3B0C}|!g6gxn`^d1gdC|V1;+1Eu>C8WZP)rJ(z9n-5Nh}_e zRlix8(G4&~n*2$BDb8DG74Yrj?A-glQ2mS^cd3>GXaoad_z+J8tu56+NeO}_hj4Gr zf>YA1D7#If(U)^JJCjc!b#+2#uA;Kjo1VdP{3l+_)w(%gRl&o175uA)1|X6P5ZHGz z=G-59NFU#Gen#Y6#g1VUs$Jo(wUQi0De_hR=FHYxrs!37?GT782mEst%F@Xy&eb^J z>wSE`2}XUKz5^$`s7tNqS_ejuxEXG}#GDHyob$~sM-RofXg!8b_U~BuE z%?A2$NTyTfu|8`(m1G#atlx9BNXM*U`gnyRM;+>uieH$*6k5^!)hLfll5`6Bjq6wfLS!&%z%-)-?Ak1&=0aA3f3l^uq~DL#-wO zRK*9n)qP&0wMHO)wtXARtGS`~7;c@)RJw4S826_mJic)u-sYG$L(AUtT+X$UV#28vT)+tzm3k&TAGQ5Y^1Jd%2fzrU<|U zGl3PwDFx$Y^ZjwAP(wKTSWXP1=#kthIleR_pJ*%69kLS!v@*ogQh8zxUO7lOTZC$b zMO4}W>%fJ7d#9VmKmI~9p>+7@F+Y+NPAQ)Y-=q^N6_9ykod&Y$FmM|9y4}zbgWfFZ z(|#m*Hs2j}6rouVO1s79t0=>Xr$(4QQ{IuM)eAeJ<&Dz)VLG-FCAAL*X2u4TvEoX zD%(4B_r5g_*1J|nT4L>|!NCdoN9LG20ToIiiMS1U0fSl>ak2JL0&~dfQpZ_Dc9CIi zT~#9K4vheLC4I7q25)F-+Tp4udJm4`q4B#+W5+#R8o|L9OrEQk*5JL&-}Wf4SMPMr zTwC4V&n9*|b6P;Q#NE;-`4*ryG?%J}CKlZsF2+K7;gHX@&ZtA}6gx^PNZD;~P`Fr8 zs(rRLWAU3;{1vs-OVuD6q!p zva#LRVAU$b`AM4Xjjh@Dw?g_~|96{A@=edCn*_69Jh&!zY2u@T`WG$mpg4p|@lv*9 z{}ELSmRi_wh68E8xeW!eTRKhb<_Ky-zNWS2!U2G{Nn(8hh#o1D|8H~Wwj9TioZ)LA z>~|Q`;SebU5J>7Quf2nr!GQt>Fa{7MA*={4MXeai05*8AW8dE2|7T`(^#IgL){SpS zOm}rvR#sM?Dl60al$_cy8AU=}ZGXX!AW12e#ek(rYZ(tAaO;;3rC)v=`lZ`XHna*H zCiPICbx?Omx(zmE0T}BR*y+;#6<~k%8^C^?YHwv@9bGjhf}D_;R>-?jGaNY|h#F`x zSESUMh|eN|9{pKnXv5C1oR3vg{pfTE2rL7n3@`v*wcDaWQVT71%pB#lK4_X=X~b!< z6t$pDy`NG9L?d#qJ9M^2FC8-9OEjMc(J&orZsUZ;4|k)f%)mIW;Sd)WJOH*T zjlv9fARSJXr?>!=Q^892JQn?9-CgWG1HlFq2|f^rPYAL2!;qqXv(2V z(%ny}$#e|MZF+1I7{>I*&h}^8jBvAjq2mo1SQj|C@S!!ishi2DK8gcdA6~?90!oy? zoko#&>5$zVfml@I;Q*wlKN>3%i`M-j05C*wjAn`9(Ub3>;fO={bb7H251g0KC-BO7 z5BnX*YI{Amvr_lAl&9?gV>`nC%tJ7_8Lrre>egrc-9R6o1ucE@W&HoCZ@Ma+%uAE; zV9k1KDDyn5c#1d4?#w*soWa1!5ra8aN+55x&+aDJPm5p&ugiEl3QM)6W4rEdWyocq zd=%8#mI>{4xGN&(m3R7XhGF{G5DyxM13I@v&=*-2=4yeBRNiL*RN^?*u4%W}sx z?KlD>69ha4XAeXQ;x^jZrEaQZ;Z)iJ@?OFgu6&F=M8izz6eK7;E7(^0gxW$4hVc_L zLiRo@)kcYoL8w8<0de zS^_?W1Ml#cU}Tbp$yN1zqwS2a)-X_9svZ1!@6Gm<+UO7{&amJXK&R{>J2 zr3I%iiNGGrC=@!2s0t3yZh{ytA#{o5>#HP$)}=o%_>u@d1+gxcfXRG4Uu0ZLzArYQ zfQ}@@&P~+qc7xzGBHj@F-P_J0E?fj>=SW5G-5P}Gl7{Euqk+mrNbDV zUBp3Ikb%alqbJd1iXP;jXn`5Q>uM7N8eW&%w30j_cX#fMCvAwgd-BTRlg1lK2MO>LP;8p1yKGLQ z|xW2b_NE-G7;{`5x?CB!K9jsH|9b~RBLimiy(nEJ0q~kGgVGw z-1$-rl1FR=b|5|j*g~Y&ebNdKXucn<6Y(N2syb;1DnN}1p^_Bl^2fKxFIZD9*(PTQ zP`ou$BsRW>{$heGXoUk^qM38*ek&8py z^Ivy#iDM_e%1gz3WuPJq(0>Lek$98R>U*MyTK&Cud;!5Q6}~b%DF94GUF-h#a+*@r zREJXZkerx1crA&M@91`TN-2BAfdi=9%5gtb1e#unjYsPQr8q&ZOmhuyqV)X!WiZ=j zJOXrUD!+(!nDH8_iSQnU!&Ga5R_Z+v^LMZjX~_pic{q&LZ+hC# zlm>%~)Ww0~I7bhAi}&JEC>?Ph(Hm}Z|7d5iqeu8z z^43c`Z#uX*U_kLH6d}7>Vtnq#tEb3`l5BM|8mA$77hr>jA7HHhRvJk@WqlY%_K#q} z^GKM5j`-z;k2t9~7zhCD?ri0?C->uKl#=`SdK6RC;Ri|3F&E}5=7We_F3uI(kGAS8 z4|R_!E8AK5WPQFXB9D&_%gZl%3fzROWMye3t^mzYAC%+LpIOMno|%-#shU?LXPbA9J>|A>JptwDIn zacfZ*Y*L#PTSp54^>N+qa-XH{>M$xNh7U}s^)+YdhluCFX)8wcQ1A?na9`J#mIF`K zMLW`EguV-o(K+}4s#TI(*!)W0?~;+x$&95^Oea5p-;w~4TyLLH7prFVNRHbQQDp z(3O@g!%|Uq`U-Kx?v~-f#r_=ev~~x{y-ArC_Pf@`1dbUEHCBow=?tiSg!3)C-Bw(T zAdn93r#@r{4>&M^C?**dOUFv8DQ3h=;$FkYe; zp#-xiZN=?Rve*FBs_=XpRJscV#_iqxC-&5y1xz-DF;RM zhyk_}<~t0WoPgH(^*S?7?GfDpwW{2S@Xp1wIcC)#at z9Km>M3LRD=6PQWMFIr6~;SUFNaEIud~Slc6EBBniDvZBI{yaYNcpbs_)NkvGe zaEZpwZQ4W-JD?)=8nWaHtcNql+I4JNJ^&qc>JU~S26z$?@Og`fA={1NNwcEFM$9ny zfI0~SB75nXtx0dXW!D01L2+#r4;V+k6?7tMznwf4G!Bk0abHQyNT#Y?FZvS2-Qvr+ z9V?+^pDhZil;g*7cWIlCUk6V4G$9qoHu>?0-2f|8%xDp}R$|Qil>&)bEp*iq(_hW; zNDQ6XQ8h+nhAW)2f0f0;nc&!=Y%!Jb%MZ+pGt!*ldr-WEV@xsL5_J|ZT-Xdj^W{i% zpa}5{AkpL>YNez&lIVr( zD;D9guVSinez`Z$w`v7S&zdQynhmSX0^c9)*tCaO2SyCRAt89*s^f$B2CBwc7g$1e z?JCX87&k|!fg4oYHsLs4SCMQ%EC|BRVAav|l|MwY!Q*OICvf4$aWxs3P>H3x3TEKi zs)8B84JBWRn~EA51DqAsRhCt2(fFB_BSPwR+GFOd8%$X-LYULvs(NsFqGa1(0rq=- zDvR;a;~fF7k9ZF3=*wh3KZa%CkE6kr`zE4QVunZhdi6D_eJ{|0^-juOUJUS00v%Ma z!yz~55Qz3bgW~>;sKvL7nUe8|_4a_1>H61K`Uq!Lhpc$eA+$EvDC-)e49HCzEYXea zcgxaedxoS3SK4iMzxvOV<57dB(R(twIOoH&C$xTx?GQU6Nrp?n`k}c zAM9$IcwO0jg6auo88UJ@8?vg;w@#NJx~OJeiEXN<4l~(P>;&sY9j*Aj>snoh)YW|U zww>M=sa?SW@{C$EB&TFLsii<-`b8vB9%ZE}l6G&^f)QclN51r=oh?@Jf1rnMl0gpx zPSCz|17DsH&%Z^<_0jWYJLpGO31aHk>?TtaD~iio>anv~co}i*>q0?B96QuY0a?vn z?YMlbSR+1ILc(&3ImBIksLt+%w%-MLyb9st9*WMzrp3MP;NCqmBaN~0N|Y-jSYYUT zu{oj=5dD<;8bZMJffRtZuKq#=zf=t)X$RfaL+))wa<5I_1M=CL-{6X(Bd-i%Fko0P zTB)n?2fd7Gs3xD)iwe4&q(xu=j-2}k7!~piw@0cro$Ew3GEa`k6lvmTvJO#HeSS~hm5-*fS8G>wsRP`yge z;(dndhAF7Me7+DPf*uWN=*4=H)iIp(B0z7tv{_YC3+erKH5Lu zEg_51TSJkmZ?ZMFE>E($biG>fF%k8k%6#|?>8o51Sq31mX`(DQ zui2{4@5~MdsE1s5e4Gvb2m+hBh!Syd3jIhK5ZvV~2||%>5xC+oEYj)VpGK3`8ial} z!Yn{PRN#)z2kyq}XfKI4`9zsT%d<4rJ5}5)x%}Aa+mkmv#9}LbahlEsA0rU>Yqf$p zIe%au6?H}y^>n}C9FW6Z5ZR3zje@Gt+Jqq-1UfHM7L0+eFhRUebmiRU5R*AGsSMAN zrAk#-q{y_2Yk6nYAuhO9l1)Z9y<|j!34^hS7YJ73-d#~ujsTte$`z|>7v#>6-mc_$ z?)NTzstuIdXfzd^Qe3BU^q8k*v8qbPk=>?bNc^Z_I9X9dmGD#`yX8dcxUy2W@Mr9h z1{-@xZhnDM{0@<#EyiQpkzzM>imX|o?K&9Hox}RlIqNcpjN)8>ao|kL^Zn%sUQVpE zggW?mAdWHRB=t2xt)~6v1o`ObZ=a>8NFnKlQbE$?xRY30Tj$FeU6`r1_x-;TO*~&qv8#sYLc-ZORxw+9j^Qz~e^&3{LqM)?f4g$Gc^kn+IXqy9+864%}*h;`-m4~jhqdVJ=OukB*6T|~0 z;xbIVJKTSb5_B7fZe}zF@A@GWJ%R8-X9lvgVA)GzCAu%F)g7kq9kvQLmF?hZ+jguxQX%M z2z>#hZOnhG+;Y`U1!2BrleG}?pjatZ7ZWDjJnWGhav zViMN`Xr$6?!h}5Vk`${$^6ucl#(U1u^2d+GLXez#+Sy!dSvFLRjiBN%goy;1R6A9g6d{c0O0)U;_;Rjf zop%vZ5>Z20AqtOEkkLFP{+Nu?4c$nhk#B4#=_0a6ajnd_AB;X1oTP;`#V`t!)DewV zVer74nAqWa`zQ`0jfQ5oCKsZ0;ApuNozhcN@*_K-y&Z3uk0VW=RGX)wfe6q%^` z6tU&+MtszZIodnRoXgfQWi@~dlt&9IFrbv=U;}Podi^eac3mFofK+4j{62G0?@yh~ zQi-W2N<^j{N7fMcTOkDVt%|0c93lm?$AbtEwj^jOjnx#5r3js4CFD-63jpdms~_eX z6#G;#67QX_MA(K{NmbC6>LJ{2cIXozk3fQDG^Wed{R4Oz(o`};?q{hgbQ9C^4}zOW zKhTh%;Eoc{`Ot=U=FN@|{iER{2Rs;y!>ok>9`VJh7Q$6jyxsdRc>ZKZqi+1m@d|Ge zgb4cHR}&%RgXemyyu#jZ>?$Fh0ja6sd+f}ycc&C%y@%T=H@Xr}gEO=eNP{tYa3F@ueakhL6Xz>f*4CA&ScjZjobCNK+|xRQ4=`#|%Mln7Bv6g7 zL6Z>+ekd%o`)<09ad9fYLa9$KctW0-raP~w!0Nu@>_h?YT}Y_0u~Nv+eeE6);^U>+ z)~AUl?#e0SS>r(hHGEhYP9rNenM$`oG!;eo?kRgHR3a2=uYK%=KO^|Ufz7Kk)&Guu zpGd2)XDD1;>De4Wut2TMgvr9@urMEoAz89Qg{bNuH)G)Pg9+f<6|nA_L*gJL$A_G- zmYfnIPX%h4i1vz=i7Lfn9GAcoOv>;nYE2j4(xqbMSVIw|Cc_hFU6qXC$W)4f*NzXd zg%Zb2GnkRUQ4%$B($K#>W+`t6S6MD2VK7`2T1Y=FADMr1JvB$+R%W?(7D9pht`WKUYXU=eUBn@tXcB` z$C61j1wl{epffiNq{3wZVsLdPW>2FyTlq$WrU28g1e^a@b4!*_rT;7u6ygbN#EA-3 zC68sC#$lVWCm#o~IF93%x3n>)O=8;&*Z49O&}Pw#ZD-Zr78z_SQu~rxT7(=**TACO zyhWjo&MoRwIO6Xh(ff7Zd&>!Gw`5}Zq@J)fc(@Q(8@N#@$JMfG?-`E8{2m}sruzRW zouRa8p}fa11ls;wCrXQgXv&;dm)_IxmCNPKsS56c7<3XmWu%ctI2ZMb0?t=83ZHr; z)%J<)d~ax~8QplaWrF9m|2Nj#z_ki)Z^92c$0w_UpkhKa>yHhBMna$vPSk)bvZTAq2kJoG zvVzjW$=$_nUfr&&nPXt|mOR&Y0pzG;xZ@b2_kAF!+81kJ#Ug0p&Zbq-xx2kPl+W$( zt*in3meyl;c*$Ww*}D~6>BK#pAgWq&TR-Cq(J{A374P`fV3MgX94Qw^So!jueB#bZ z38lX{Z^O}rZ-r3j^C^MHMNRKhONWr^&`TLZXJmM(b@IaJ-2uGs2cgjs(HjaguWe*E z4OKy@(#KuwSS$X7)d;PUj^jpzy01NCELi(TNw*}Dwq^>X4;4LT1_QrfKT5X}19c?A z5P!T@p0z7EB#@S|Ik&F#)pmRZ={f1fZ`rA##T8MQq%}bb&>rh-vxhsLDfRtwf{_t> zTy|b(oq!Teht+lfj+k69Hg|e>PHiVTwdIGyK-%{C-v?-?(*J_xIo*xao+oPItQ^fCc6_W%~GDe!UDJ5M9dLQ&wsNc zEP-}RwYIrs1oDVX?ZfATP0nO;G`Vmpj%{PdGC=D>(_9zAjaC{~;%ai}e78##ir(iS zLv`IcVO_QAR`v42OfE|%aOp}Ju$v%N?(TL*M5xS@H(k^1D` z?!7*`cg^A_qla8aTshbfHn8rPKqzW*X9U9RpoP3f4i57+T&O9zhz8DnSP+(semL6a zkLFbyu4jpU`*`m7A{xpVZ`Ba^+YV{5NNV|__{y>kH`ECLq2|hWjOoT-UKBf|Je?RF zFxoV(Hof2&q?|Ks2t~GJO!p=T`DVRWbq;j&EhIVlD1Lv$EVT_!H!u-->D!Kbq*XJ{ z+7zRWnWD1hAZ9)j###i>=a0Sgr1iIMfS02@;TGN$|pyW>`N&jPl>r@U|K5pxT z$p=~>9^Z|8-io=~Q|uU;a^xt_!NZw=O);RTnD2q8yH?!)dvSVdAI;JDt&cC>`?c>H zod_NH5TC+QzafGUJ8^O_J>Me$W^(^*e*9qj6!?9neV_CS54I~umE@9e)Wz7418lZE zojkv}e*5g@^_$6GZ(d%%eerto_Ga>@S2xf9GP(IlsnWG%KR$c=49T-W4A}YPKXikL ze>q%z82>%uzt!?Yg?eS}HM=lJ_`~Gip8x#p`ufGI$vnHPW^9Ea+LD!{z=`M=w9!ykmfO*YDoE__4;Aa0s2@ z^48eizWy6v+`Ro6Oy=~wo#hvQ=;;1uuU|}_y?QmFNws)0ahG%z{&<1yEpf_M+Er?w zy=B`sH^k%r0aPZ75RjM0BzF_6weJb4)84{K1r_HZ#L12p@y)B7w}kYaUO*IfQ*T{a z$UabNqX#N)_CUEzq%PXAgzbvHw&4IV0rckG^XD(#y!q+ft4U!0e|~;(J$e1&?Yr04 zFR%Y>I4-GQ=M;?3bmf)^E$!Z*;dJ}PwZfg9FllwCtn#+XbHA|A)xPQc|?6_ z-FpfO`Er77;0HvVeMO>P^2EelCf%vITrI#{-NQmxQetRxFnM7%;iR0|eJS%7j}Z6wGeJDrn&WNe%3 z#^0ygY+!X3cHH*SQumk^+e=kj+9VDIl;$$c9CXWRPHr%~&WBML`-*m)0+MD8&0zWs zCo_r+mRL)LlN1Q2%8tx(hgumDKBOQOXyoAllLC4jNR*VC>x!Z#httaySEMlZNb!b; i`O)J?yN{?ns(&Bt`YBOVeyW@6k9T>$xrvh&{`kM@F~xZR literal 0 HcmV?d00001 diff --git a//agc.bin.16 b//agc.bin.16 new file mode 100644 index 0000000000000000000000000000000000000000..426d2968dc4a36a16805f9c1a185a1a2332f9a39 GIT binary patch literal 40834 zcmdUYiCLfxY;eBZ)f`Djm?|5{exJ8SKc)zD*EKaTOW zG_-#E3-i6=Zto`(mi2z|)z)8Dw864{er+B8Hrd34)sg%(y>E@9ZTKku#9LrqQGMmo zW&pmv^h0TZ#m&Kpw;nJgX>JFrN>=Ll^6iUFBeu-#Vd`@7yGE;Sf%!tjdw^5TV-`iADEi6%4;J% zMTBV;*FBl@kQcUofK^t}l0EC-U&|@(pRy-jhW#7wgkQq35>9Jbwle9Jpt!Z<`?%-r z3|Llk_dwZ+*M_{lhX7N(^D<4JUP7g{qjjgQO8a&!%Z{>zI%;}bxa6;}+3%z7@B;BGNH}53Y5m-=GvpC} zq#l=eNu=syXxv|eRL%I);^#um>$SomqHB8*6jaqNeex|Q9Ia5PdSeyGi!|g)RZum& z`Q^UXjursF+9A{o3COY%`~cDQAr%Pw8=)6(Hi=((w4z|o@>oR#nzlmHL7vx%5BGCJ z`}}SMbk;I8(!~OPwaB_vU}_U*Yt%#Cn#7Hy(NAghNnEeI)f@63hj7r1FDS1&d+P#XTo3ATP-`fjZ({DZ_PW;*EYv|eDy0p zTh)>?8CK~P{=1ji15o``GYAmw8UDUind`YNikiDG zAkX&hgL%NuQ@(c|5#mKhtNNg-}+#09L)0)A+H4#wM=cob~Yi^dJRjiu^ zglYYw6hLETRwFa<=U5hy4F1+P)}BmlJXxE*Gqtk3k(ggzzw=}{^<*iXNG?v_+1N@? zTfPNWe59>Qv)wE90UHNcuf5)gH9lZP*zfVD#ROSSp^DaTKmJYybJynhu&_p!S4-g@I~&U^O&A zj{w9{TPCc*)kd%~KeX(KDr`FPSP=60^I`9(7=I-GlW3#2iyAl^$Ys2a4a(v_AKE={=5o&hTaVk*OrSx==Osge*R)&uLHWv53ZOZBe9 z;9Ede>wi(pK3`~AB}NW^)UrZ${vT=?amF9C?86T>Gn(QvFW}mLizfe-cc?p}Q%J`QnW+ zOc!a-gp8}c&Qn3qY^%gLmSuVnJN&R+!-{TF4jGLo0c22w(qe6jbxB9p)wf0Rkk z=KY_ONnm=>(aAr{B)l}scdWCM+J|>)jLr5^pp0vmYOby3B#vGZd9;{rn3mP7Kb(TS zP=;=*oa1;K4Se$CviWxjbj3$o8Dtsw;%rL;{Z1{bTJ{D0s(Z;L=;GV@g@U^$1N+Lnz*hb&1G76()@>OAGh3? z_GZ94ErLNFxB=SWO1{iA8gB6G`{&V$`^2wIPHJo+lzE_11AyH398iw0?RT_jB?gmn zQiDb7DI7?lHc6h^W|@Jub}cIpcL53kObUQXHGNiB?cSM+#ykiTaR~-MRBBPvaQJMd zi}=-oD43nx8ppCy9aiYP$0<1fZr3cO2n(?)*Lk&tms&g<_InNcwzeF&&Iw4u% zV0BlMJ}L~0iB}wTvx@$60V7%a@?kdmiTHKV$#>-B2MZWr+ULu0Xzm{Q6!L(w)pGPb z7urys7^}Dd03Zqhgb=MD9S%~a8JK7ZwSMNAB`8BB!Em#(SqgfL9W{4*Z;VP-y?QhO z&*<3dH>(&nlU|z6cTicp5`c@gy&uHWV7;X!Pm~Jg`vQNlNFpf2eJ-esO}D>$s%Bw#9#H-&{)zYb-g0c$ zfL`IVAG7R}AWY?Tf>!s#*=aNrMb8TU#F4N!Qy!SQwJ}wyNK7JhoTHMXZ`ZPg!ZA?d zme(KOeuT~eziHV&Lw+0D$L2Rz&%{42Zp~Wvs$HW71Zz$Lh#B4D@U&#wc74TAVsm~& zSfDN~f`897n2<^s^-57cXCug1#j5OHqPzY6?$Rsbx0tXHjA?ybcWR80k#T6P!XnlH z*j_e>53A<(4R=H~f?p$5v6e^XE9B2UVO~YeQM}OPWvG~HF+7L1tz{JjiMxkL_0OOn zOi+9K;Ioe`)ay7e6l68y!o>O58VMzd-xKJ^sZ~31tH%|oLFIn|3Mewe`45W`G^_77 z`oNm0aAX?^$6$p%3|2!PQUPuK_-3#AKvG%}6gZ@J7o`q`!Rp`dI{Hccc3>W?icA&- zvLHh}C{^fmfT;jL#`3^Z4q>J0s}8GmbLFn zH+&WN6m(2zot0PxWBKJ_+-_q%XQ8*w%CBn&C#%=GwP4N%%-zun=WX<}?-Cvwp;TZ3I73-0SVWogk(Uz`uJ#1ElpUBQR|l`uYX1@kH#g`{zMl8mivPSJVQ(de{*)I z4PmN_ou4WW5A!SUlOSltLZIOD2M^@h*JGmh|UsiL_A$KS+l>KGsiGuTx|B4D zYXJa_5$(=ppk$&*_}=jQx z$@@!C=%kt;5l6Mv{_5Q~jvOpf&g}t*!mv3{k{Zk1=)6}={BE4l8wnFY;2pyG44um_ zZtiYu^)Go}fZ_&FE*26`lEHMW7IHd-hEiS&Mj@D;nc6B(doaUozzjlQP( zilpWD|7u?$euLN(!Hh^cxI{5Nzsn$?mI|%*muI27S;ET)0fYFT_AAD+ko%xik-#A8 z*PlY$%`~bgq!-k4M{1ht52+;LJ^Ad8p|0hY#8xNYR=bani68eItXRHE#O&QsO0?uL zTar|bo(R@68ZCakExIcoq3o`l7ax_$A8I1&0-~79sAc<}nS480IzR^Q`8+4}}SO z@MbQn?)$#jBk2rQSsF_%U$w)bRO`lROMEShX7WliRY*k%WpxOowm#hsN4ySv&51l# z4vX#a=^ElUXH_5+%xJA)*m@Qz)1s4kVQ{UVt3U`fRzOMQVd=XS6^F(=unz8)Ujas} zPAV_Y13TuAg-4aAaF+Df$9OWr95!2Jn}jF%Ya5>W74m(2ts74Ll^8w#@pO^+twM&P zmI|tCcbY>Pwt)VI6{ogh$rt`7)5mbZsnv4pUact*sUGUW^g_Y3nr)s+w)9*fRSPlD zh8-tDj-^Vo?SdDZeUmkieL@jg9GS4ja`VZ-JMGD3&Jaxrh3J_ZD5zqQ@*jed8+h1* z*wp!}x5{JX%puHr$ncac)YjM%I7?Pg*%a&`F93B22l7%C?a_}R%c`Z$sE^a0(EUO3 zZ!d8I{sGFDjFHpN4F&rH``9kTc5uOGtLo6$!lC+@ zox|5FajDHD@-kU|gz=H+wCr;m{EKZeh&8wmH#7hMUBK}Hau@Pqt*v_akdkQ3u|r;P zV51Ow*04Tzu@l4{@`3|(UQqGm91hj7^(7huPy)DAs}X32<|RJR^o76dN#;7g#<^6>RvDft$KGp9cexJUKd z0)Ez{1&d^W5?-jg;rrlW>QO=ZpZx6e3qSiLTTH`^Mm(Bxkt(%c9UDixXt(JG$6kTU zy*i~d<6svm_Z1tPWxfjj)08wmsN6L9x;!ihGyBfX5ZG=<)CVGv&ENhJa?mUQ6_D_c zNCs5`00A*UN=OEbP#@iAqf_PZv+a_=&ki~d_ssvTc=shvUe}xQAal9DlB4*hp>nsf zVfgJIe)dV0mFQ;|l>SfrYzGxXJ3X$S*SB!6y|>LHDEkqNWV|DGe%{fAk5#m=wGC}m zc)sFwmPZ{VfNU&{E21W;<64k)`yO^a;@7Gxjihd5nu ztqXXy;mjEZ3SR}ZDRsxbE4`GnqwUPDH>L9p#IFj`nS`Tgs4Ao1n6X1Hq5LyT=tkjO z(4h&aUFw4cnw`ZaARar^6v#!o+41biBBj50XZQK}I&6u(*#-3bJMguasfO?EDMf`4 zy2UiMmc`!ZMwV6BVlxTiG`S|Zje3b|l7lwDCjZJs(P`+|4v~LlX53^b$j;4F00pU_ zg(_z$SDtkOFU`k5c`2lVDpkA1wTg=0z&vO>#ZQl#z1F)Q7IoqSULTH?^%4yk%e-LP zEnAtPF`4FzfN8>!Rc@~Tc{8CY+EhuREmB7&_S%%*dFNl0BF~g=7tWc*05NS!?-tDE zs-R$gXya^vfzJ7YAeX)>^A_vZNS$p+~}B`FZ77tAp7`v z4ZPg?2=G1z@baKcm=yYZ=ETA0V1a4}yw`~`VO9Jzo9VpdEOMZ~onrb|xc z-QyaoCHbaoiTI6+2fmMbvJAaEK-kc`fK3{I0Bmo2j#QGVu}Y*;Os&iyHN(`KU*_zL z zy{H%~w_Bk#`QCE7ow=7gCvTqrRj767OnDmM3Aw;oD%{vMLWm&?dmU*Z`75{e1}S!H zL+b-o8f4)Yt$2uK4moZZ<^XY4sZ|yDlV5jb6QxmFX-b*kwS>;48uEs<{*}iac+$P? znTPcp-zAW5Rb27HHQY5@zspXgI0BFXerBnFH8?!4t@+{d_qH5>_Lh1TD9F*Wk^Js?APtJ`-G29o zNu@j=DcRU7NY<7#A9j8(Z#n;9HKZ-<4x*;UBOp*!OkTdE1WOw3rbmy`}?i`<^BEmzXEMbTMe7)VZpj` z@ML3de*I2*ZDneDeH}IaJbi+5%@CU5_QMCyxzn!`3;mA?h^J5D`JH~$tI+9_Umr-D z>RpG%V&EhtCgK3(MAA@gQ4p{#%B} zrcLDGQmt`Hjj?p_HCW@Ab1hu}%C%al`I@f+xVeeX6eRK0jSQBJ(B?#?)6z0cpLI3e z)iXw2sDsL@iWRn+Ww`2TvaXuj`EKe7Kvi32%52nE&8^%wk%`u)nbFQ1sEecR#*h)U zU^7-aZEOS!WHAx4Nt0ugQYNqlJ&e zuO4%E)WpIur^K-@j!iQeH#kZk!t#P-`CIROFEMeX07(oje6D;Tv}viR+iXLt^3Y3k zUR?V6+p;Dqe8EO8kHz0*0eH}ly8uWTXJ>qEq**Lci%?6^TQ1_Pw!}|}PaZ%SknBHE z_;W0kgYrWF6kt-ncRO+gKg-h(6UO&pvmbKVH9yDX;r$OgZ4Kwf* zBtXd=#+gzToscw@RVo4DpfuP2I5`xif#YyxWZpG?KH4UJL(~s5My4aO7?J#(Fc7t0 zLYJuh{8M~R>C=R+Atq>XiI^*(4%tzFsgZF>C)qTzIuL(G{3a41gm2jPOdSPC5}`9m zqLhSHeyU2C*fU~iP8hUS9^N+*!$4C^T)Af>YwQc?ZBMGLf-nHkp3KHPSUp+>vnHn2 z8gV4z+m9YC>%6=V&%*~DSn^2O2NY-RYIr{=c(Td^9awZh?Q?lvXVgAVG3>RP1t=T; zod7k<>SaB#m_8=1G9Yd%bJM|6nebJfQwR~%;30HZZchNY64mPUbthcA^^5#lkPc2z zK-8>tB(!u#O5%QqOx@J#DZlP15zbN^98|&qnohv`b6Hhl=8s_IU=2VVwQ`_GtCa&p zil&cWwS0&$#pQz+MM^7 GV4ed3o!Wpq@80^=9+7{s-kC0a;Su=LNv`UU_mF$6&l zvvMdyUa*0pWr0W)F1}egU=0D*0NoN)4i>ksCnI-w6Bl2STXrTHxwsOs+e zj`HkkdyVY#E&`1SBllR*H*X3Gy@E*d&Op;f{;L~&4H1AD?D%*i_hW64J+ zk~MeuThoY~7~`m$dKcSR)cvYFLXFLgOsJVd0L?p@=_%t(uuByL)16M*0b{GNmVKCJ ztf#eAQ|jY+G4XpZ@$r3Blz}%XLN=-V4U|@Qp>SAv;LH1PuGH)MA^@7zn!DSJJd@fv zyK64S$v~NAciZc8gIx9a&E)WNcFC0ds}XL+wMG|i9*d&W?b@v~;`b#{@o+AtdRGWU zeXK3Gd<}?Z-c5vjnm5hJJj6g5{y~#_15MTlwstz@b2nj!tam82dm{Dc{Td1ddIX>g zZlf!Ia`-i>C^dm&i0A3@9}7Ckc8dK4TVi4JXo*#IkT~>(DbR461z>gVgia~|Ktx?L z(M#13m-j6;v(fBBHrH(D*x%;v9BpDlAhr^-`wse$K|ZZO%3*KBxjv}JuMN*zUoJ6b zWV?(BhJsRIV1$8PUTIrhh0ay#a`k=)3yZmSEuJ0$P)nPl+AWCFQfIQrlQ0Y=ks`X@ z4dj6lJZ0e^uV!naaz^lUqE-dU%T}HJy+i!UEXcU=|Jr-tCvM`y?(IQ{FwC~nJWcei zN9z^7QZ=c=6<0uE+jFNF!pxJx%0Ix@g<~%QDA}2U--cnFNzTxA`G-Z+hWGKoO(gmJ z=SN}4fl39rxqh)~p7_?fc*r*S1y%Si%EZ zR;ZubDnS)DT=nGz`F9J_qBgn4iol|3 zZew{&t@grh+$OiMA9a6JyaI~g8bs>Om5!2qe?RLaev^rlhtZIM=K+fLvfdAcu}tOu z);?1LCEBzab5XE#SkYJQ%=J09&Fm*bOM`cWGn>sSt!_S~!>c)~Sg}Yr9L#-sS}t*a0j}v zhGGUe%&jT|iBM(kN>{U9_4A6u)>-1Wj)S;SV2@@R0M&Cypk|@IhhVnXg)T1>$jO1R zTpbIzLRO{-r8?|!g@2+b-bT-ed!*`3lL+M{?IqESJXlu2v-&R+-1D-ZpVGd#6p#$n zPuzvPJgdEKjHqwZ0)Q6JYWG6NI0sG0K|xse#W^uc4it*T)bZzG3J)yGpOk2BC|>jF zikqcxEV=h(elWHbqJL_?idqQSN11|}-RYAN6 z1>(>w5_fO=_{_IWC>T7%wmR6MlsP+-2gN>;swYtMcE{hn#P2U37OCPNAxmpD(qx3A zby?eRYT3|>``A`RKvoZ`xF#^21TNy55HhRx9q?3wNdnDs?vxwrrAOxD2vvtBAN{Rs z9%3iW=I#9yN;|TkoHzW!j1MA9{3Nv$Zj| zDMo~P<}2Rt7`DAnhe`#*KE6XX{8%l9XHJGp);rz>T+q>8=`JU}x==^wkcigo$AU6H z2K0mIr7k+DfcNff49Z?A)X%|888rykCgRWas6a=aO^jsSiLHDOhCFu6V@tTZxXS>p0_r{3r<&)t}_J$?io z1rG(tI$p^W(Ei>SJWB#d{5qz$ey`T};|@CtQNp&vz~%mE-Rm~uhX5JgE09RhcG|Tg z#UqbI^j-?15SY?-4;1v1jvx<%5>FmN!A`2Cvqj^&8nq@t?}SIOn!@;cK0Y+aqS9eK zpLxPB0Oe9j`0-pL*t9k?&-ufFu;4Ek%YME`AxY$=VoMI6?qo7$uV?YW(%{2M@PLm9 zR5SK*yiKjxFG7=eM;y}$gS;qc3QHy-u}wa^wIrCD7c>QOerw?T=5#gQ(AgvBuJ6E6 zs=4>vyDI`&rJGg4H4{~@8}fN2%FBF(>@Ipv{yo4N40p6C=p-w5i-hQAI8e`d$V3EQXa9U2 zOD1i1M8_&GJ#nHc3Y0U<(llqz01d*ktqPzfZ?m6^JyxM)=dd4tni=GtrZWQr<~y3t z`~R$x&vW7c@H=SxysN=d=&C|&0!|3vKz1)-unXF3GR%%+cr3Zj`f8SQJ}U!p6T`Dl z@U`7THN{j((crU&aFp>~Ck_7!H{nRa6*L6z3Rag`%+bgEhP|EqNRxHd!B)yBm5EZ) zDDG-}wGpH_MFl`C=V@)GNfC~a{a%Ik*zSi|c#`;S@oc=fartWK0LEj5;KKyZ(GPhZ zK6K=!U*~Qp3^?+TFjJfAT^UB98%Sb6s-y{Qry`=Gz;ojnYa^`R#y0N>zn45HS0UO0 z03PxRE`6og3MjjDw=r&)%)bI)o6HMZjCSzr*2bG9!#Xr83oylXt~X1n4B-Mol#MGI z@TKqb;$!mfuT!hwV=}}sk{aYC_P245XbPxN8;a59fO?mJ8m~&WlUB-XrRZyhH!RJg z3gK{Wu^gwR(Vy&9e=p(;GI+9Znu-!!N5#tj>a~gAw*++138tdJq6brl!*_rbtqA;a zZJ$9l%Kf1Z^jFmsAH6AFF%D&1KZkj;iAwDv-{rQdOOwVHv9@6kDP4$Xy-RN)y;*&< z_JH{PhJ7*dAvfp)@M3LT5V(oBK}%ucEoW2wGWMp zO(^nc!w-+TQ^XJNRe6b%p&a<|8?^}hY?C7Rw!!pwhQdPUMDlgNSAI&8PptvIdsO@W z)4O|W+uw_VRWxvWy&j{DxcmvO$?Nk#YD64AB~X{m$UhsK7P;9}ZT;-b-CE)YJ@Zbj zUJs>mAp2W5xkAuwfg-5~7gUC!LSUVod;x`T5p@E0|9{ET7qfLHD-ZrlARt{6yLi3@ z__c$7rxh3S5;3xIoxFf+k%UA=UK-t1{zYSf&|D`aV;(GjKkTkXH6Zo14YxbDnxIJi z$%wD-x=MfW%wnh)`jI$Mzd;o^XuswrxsYwouh}0^2pv9<#>x(+PaI1|3Nc_XJE$jX zmNyyZj*~+-PvJnhh-iIbpeVq4k8HmSsu4Jlo;y*(_wYi)eg*F0izRYg<)mKzih-BB zppSxW*%vWePBg-RW_rR&HeC3<`;z_sR+n&f4HUT3)>;-M9CcZ~7-kD08Abqy*3vo# zl`|IF*4}e6^iM+%5)1>N)cv6)MSk&fd*8Rr(#WiPwB*T`nx#<(`n522&oF_ zaDV8HH*bct?VvY9V6FcQ1YXdA2A7Eu_F|5(PwjLqF+Luev$)4B?izR`-=!0Mg;$i~ z9Gf~WAY)>*Lh@dBAw#yI9Bn5Qg3A+gl~ma<_A!wKBy064+cJb1AH@f+=DC%RZ-3=Y z>d+d_p8KIV^05AZz=_n-{n80f%A^=$;Dzso!Ho>#$}Xxr2YB0ITU&D(eJNXenwy;3 zjC3+~!)d!L@Ck*u^dsJe7Mn>_4*DpnX`ArAZY1#52Jm~%^`#T6#kmr8G7)^#5(DXe zQR|oYVa?8R&xMBERmL{0D{J;DR#r1j2?-C8&p{u4I}2PD4B)H7yru*&vw{MLZT*+9 zd0$=s?oHx%0R6Qr|Ic*~>$x7+AN@3&gx5p^8rrt%&(DPEfR6$n`r!l!VK?Xe{CQXX z`EM~Sa9H9Fy3BB0CK26az)uWAfG+3%6*m-4c)H=ST~~g7b~xKV$Neo_{$MvlDU5l* zVm|3-2@M7x&AFgpco>XyJc_Rhrr*4am;mwn=`(13B^J)9!_E|SE+)9UC1pSAwz=RS^(>&Tf6c<_Ap?GV?OVK^Y* zfb3}ybQduqP_o+&D_SwjeuDyC2;jY^itQ|ji46@tyDKyTtqA<$RfY(q6;g-*d&MV< zyIOElkHL_pnD-*A%b%}a6^D4YFAOUkwnBp`_=GAIR(kS7zOoJt1Y{|AYlfC0RYZ7) zI4O~P^spV63csTvhocX6R`+bo$HjJxYIH*24LhNOpbP)UId!aZp{UbO;p9oS`Di6x z!1D*;I@_@j1BC%7qQKeaZLgPX%2%og&tB~S_5qT_50>y^v)JcT063LhTB*+I{lgmp zWeGz_|x0t%LR8VZm zVOur}j%GW;kG_Q^6A9)NjE$g6%%RuFDNA)lDG*V`PlJ($oJJ=C5t!<(DWUxf_asgj zpCka0AL4if=J4N#Cb7R@n|*c#5RD!+7bF%Nnoe1MSXYcpw{= zqsR$G%DHX>ikjzeg<)UWA<~wRc51wC&>>C^&R_r(OxijheaZ7f;R*WpW)16gaVlp= z{BR?ocP;H6jjC3kN0j0~q%`mt-?NH`Tn^W<@&sqeV2pyOl}ptl_6PQn;aZvz-@+~f{gs;;XbPDMVwm%2%P#G}^4H*cSWNOP z)5jLpYznUz4w97w9}}A<>gvw9ehY8o?llDXPZtOHJqgRA1Ktx?7M;&**aPskE&nBC zQaEFJ&z+qCD_KLvb>^qFApa`qLY{G7s(2Kc}U;vPq44ZYn+&tr*i|{`8 zAg2hli1tsG@DKZUfs4QwwJo1?N(ddKZoaGVR&n@iZ8pBzf!+d%t!jI|WbBnn#phtU zlWr}5Qmc7qr*psgG72K6{cIhQJPyZ?%nl2-*2{^;C8tm@-x zFKm13L27=|szRTNoMc`j#qD$_=%{A%@%OvH&xL@~#lqiGAU?J4KDtJHMt#7mi~RaH zDdq^WHW*tErpx03PXlG$X1#3;pgHa&5#RTlhi&z{TZAtAdp&as#93W9KRZ|o4ZSS^5$pF3N7fM#-Q`?)>u zv8^|U7Go)VuyWM{)J7y4=<2;7xkt#sSy*fm{%+5Lwl0=-AZ2A9Hr(X;(yiwD$YT8Y zOny6eo6ivAL5Pt46@l8ss!EuOO}9M&V7=eiKSKB#7@X^QDDj2cifQh+|JH?>OZGm3 zJh183J<;KX(GdV~kS{1wxRM3G?;J;e^X|3V202Ka2>in+IuZtf9I*W=SGd2$Fb%Sp z$msqlV!>g?_=aH+!AsEAfHo~13`Xaf+>{%F5J{P0p7_6Uqc%A$ZRQfdKvT7ExgJk}Nl zl&7{bs#?0KO4PcU+y7u&Q%`EZ4_A=YVz&<9B{W>7Mw+Opo(}HN zn7gv*wdt}_u8-UY^P4irIV<)qZKnNk30o|V^n*#HD{D`ci5*i30}F61GYkl9o^>u zSes7)Mg3A!Y}I>^MM2;c(f2mNxKWRwD6E1a0dB!BIy@zQOMFlNr~Ioxl);zwiLn_{ z#FUz4$Tb$+6Jy~z`xSZ(f>liD*>F4@1Bd7{Y!@NL(#eqp;F2MSf<+gOAZZ5u55KdEg~unW%20rzsb*jr2AF(|CsHB9EQV9A+Yin0zhVy{W<1 z)8QF(>EVC7pNrc~AEm5pv(&6k*esZ5Y}5r%?!Rqz9-}h+h>(XYHxBu;qT`9jTpzh7 zV4kf7WdY+-<_9pugUl(2W^kY&7#`AFKt3CHM$!aL!CnxDEVu?0s9KPxWw^uJalsux z?eAYTH+$9JCl2QQN7UblrTCDsJ}i)kDzcNG11`DUvaB+o`f%8Svz2)~rHWr=MudyY zTU%E`5oVw~to$vgmbDM5H4aM;zJ(B`&z+e0P=8oV{zVY!gMLUhE{OoyE+0-pO+V@7Chv?fr_r4Bu{x zRAcB9=5lnNIcAE{RUtvv+*9*#=G4R)Xm@9XDV!@`=W{}u-f4!-152YGgfJ%-uohRy z;>7Ym>tADTFgaMvo48n;mft^YqU#6zaM8&_K%)&+I5U~?B{3#Oc11absSuZmtZVvS zcnC@NLt26=il{szB|Q2}6?d;h5oH+^MT`)@AxByya20Kff13?e@Na-04i=LK#4pc3 zTg2pBObT%w4qBz@)4Xcq*e@)Nk7fgC%e;G=Gr7`xnMi}7chV>}kgOJS5{QOUp3BX< z&V+2{9uXZ_vs9?Dl;_tXcd*A|hXVY>p*(7an4pw_b2|V^tR}N?&_a4_!s`H5M9oyu z{K3i(^iT>PNK=8C#Um$}60&67W+!CQ_mPxD^zOrjh^79XShpIpkxB@AJf?tN)oiDSh^CSUxSpE?02A6`61bZ)6PpEZIM&(>}!FGvZz^5Er0D}t}r zrMORWs>%V-AeBI8R&_(+PF7VAh%Yyl2ji#v?HuWp`oIgeZ*x!(QZcEZx1brq1Ro5j zOMMW@;Olh=1poq|K}tvl=f<2!7JZA+xM`XSK_gBx)aP-CJ>F6zWsRPf!%e36&It>#)`P33o zIz=(;%9NkVo(4NaS~6-*8KYnZEkYbJ#PED<;ZUa`aA#(#n>^5V>yQV0#Y9QsgT_}! zJUVGb?URCRC;){J$jIp~>N;A-^Xu7_-Vn9=kUhkWG!wPbF-di4WSkPA?E&>R>;qN+ zPf-d_@eN)8<6~o&&?P9ZoyU3WZpJHkG~24=((-3NRzR2P;W5q4AKO_V`7fy927Gll zUc|sdOo(_n0PnPAlDBdmEe2O+-7uE^bB3F-n9I)J%6e-mLbQh_2*Y6JJif`MR6h@w z!kImPTm9zof}UGx;L4xYnu_Fi72g2Mb%^!RO;l0)n_?5QubO7(FhnI&(03U;QVX@GG>q4LcZ#L3iBQJ0-H3iP~ z&u{W*7~Z6XYl@98Kv4@x_Mng1MK6TugcVDVM^b>2@xdm2&0~MO7dl3G1~U^+X6EQ1 zR>zug5}hGz`GInKl|i=n3{u+=JzHBJ!c?^CS(F1FYq37f_!w&JT-ShKp z&YZ0LNpi3{15g2NZ2Kv5!Qv0P-gyN)j?K7Jx~?Yx(iG_o5AN9V+ZE^mwGa!wwsl1; zBspF6g@1PwzXZ(n8Ge23U-$DUD!IMD-vAY2Aj-2slwjw_3?@xUC#pDS}@brs!dgCU3&L__>wqQS&_j2!dft7|>oFh*08)E~ZCeU=ptFIp~ zwO~-zv;d2L|4R$NOLu(wed%Y<@`HkP$e%45Pq<49?+{0p`r8FGNEP$pGvyVHRYqx^ z^jFUL>_7S|8ml-MFX0<+xIv+NG}t0a?+oaOI&LBEEt*tWRmx{dO8LfzN{jf`i&7{k!z*Ev=8Auh@1H<AnCzFnhIQr(vlE5u`&a9zZGCJg+rWmTZNaIlda1$A*7J{PCfnGNfeNh4S8Q_z&?jnibZ_pLRP*yNx^; zQMJ2lw+HX&oh@4hF^uG*rR244uco7^UI#426_jvlU8D~*_%mhBo@7CtGl6w*M%%&cGuQc*1W{* z)E)dJD1Q#r+gS0I5@`=P>*>VQv^T$uoT-(yX|K7II9vwBuK|E`Vs?7nTVC1l5>FHJ zi-M*$LFYkbL1cSteQIs`nfD}}gMTkFd-px@GnQd?<;jMpdNvIq=%QB5S?+Z}mvflr z`d2eU(t2WJetl-kTbo{eGQGaB{;$LYsI5I&UY=i`_14w};7M}Ldp5lcs-7jbyyjSK zYKF%JEMs%Tlk0Hd&#HP)r>8c+U-D#S#=D%AW2R+o%r8wp0AcXhdEc^%5hRNroqS>Q zI><|jwa3#bFP)fYD{IXIi`M5;)67}(3KR1umBeqzc2H^tk-h2C0`BGJ?iVO!vCBDz z(XZ=B;GZn7O;4@NF3)Gs=X!d2Y93OQqbpB@XF2}}AXhiN0!do;R&Li;y-O0mhX%Ys z9o)&)3lK*6bwC4n0wAD}k?SE`2S98RIsyQkOmpS0rz;~nT2q^OUpjD|6ekm4M`8o| zLG>~6L{+ncE(Kn4wK2VvUQBFEdy6aU>rfL`59$S?m!s|3{KlM@nO+ls6?TzYfiyi^ zSxb4zjj6HkC_z$i=wsZX>T3UhwkuwBYkImBQf=u zMflrTN#8L9PCuPq1X^gg&a&CXl_Uo^u?Ri6s0>jyX@J<6Us+D9ZF%!c=_djO%Mf&f zYlid5Qa(3gy-{hdTR={(08int?j;vjo-G4<8b3;WsWptw8Y#&2D*()!2Co5NaRvNl z=Iq+aGbJqksH#cjSclT}X=LGJ))XMea3eF#j7%gmF=#cMSYMbg4DQf!fd`2cIEXw9 zr)5D}r`Oh=q&M!&C6-f*Dp{U>CLLC@dE>-vu|;^l|86mVB>I=;R2qHzbguH;xptX? zsqI%m7+cIfn&w}l44vO9nfVK+XnL#=ZGe^Hhw3rGztDN#=QsCGIX42pm*E_M+P1?+ zmEXFv`0}q{g;LKd`s?}p_hT%X{%N)X;+U=QSH_!1Uq@rnN7o`Atd??XpDBd2d47D`&ravN0s#>KF*X2@+DYEKB>=^IYvKxkn@uCr_?=Zhd)7F}8xY4n?*y*z*K(e#^wfa+S@W$0CfC_{V2WyAiz%;Oz%D%GE|n@ySU>K>y4wd+f{wWB&99KB`pFqiX9{axKje^pF-Y`w4&QwBl)*tW1^&kz`a`Zl)b3NPo3QeF13ON0 zed&+p`rJw!!(fffd_Jy3QI)g2&xal&R#7ODHg(<5VDiH)<~>ht)GT_+#jns+&#^@& zG`P4mz*M92{FFZn8L?ZOMX!e`E8)It*@PP(vA%@1H(pw-cgNWs#*cX-Z`e)OjC;&0 zj|_a;c+0jk`QEnUH#R;!GWZ=1Fp3tj8^S&1ak&4M-4Pm`+h}0hm!Y3icLl`?FbLJ$ zzQcNWj^^{?L6*JU4&7?o-DlptP~9(vb3nMWTb1c#UOd1#eCvVZBg+cAPapmyR@Sbw zdviwEH>aML9niIR`pUiyw=4?3aH9QqlTdCE17X^nZ@Yu*jkDs_raQLs{D}1io#oBL z5>oV-9KXdrqRDfAvSFC(KYRrPIBXJ!4%4@ipcNOE5i-^Fi`&{^TMH;JB7W3 z_r%?3D9^HwsqwY3kSF|{*p0?4OWy>&xg&FFQGPSjvwmN+`H{Y-KYX@*<(yPkn||GJ zO{2%WeRt{C=Xqk9a&{bp^UFR0Z}(kzqICa=r315Ne)Dgz7L9vWJ4L1CKK$&xW$BCQqbeS01b)ujqSANB zvn&5TO%?VDKlIxsoLx7)^5m3|*Fv}b5ls0Jt0BPDop_TLS*F0h#!f-G8{oJ7+I?DM@T>U9 zBSR7UuCqIdTXJae0UUa&wzHwnqc=U`T;guDxWvlZghYfz$Bw)3y+icgNp94C=feVy z1x?wBvc;tPH1#3NR1f)#YX6obY{!X(KdZNHCszHzB9u6=|ClAF^W@NbrUpZU8!N&k8tMD%nKbIT`|b$4 z*Ju%P_8wo@mprEK(vND%!8k`tQqn*SL`UEF{@Bu>@Qb92N(seIgo{3B=h++Lsoj=1 ze&7!G7ijcL!L~!MeRh+n zTkhJ}SGDcJ5xK?z<~0RarN&=2Zy?JmDZIOMTS^3dzTO= zE8MNaW2Fk5llsrZz^Vx_O^v4n7-kRtsrb_1%#S+a-#~yfG`?+~w9Tfr7VjmAi{*^m zJW{=vq0Qq|m>A&Ek@b(S&G7(6?9#>qXp+?!Uh0(GB=E+?sz`Cy2QWfl2~IO z8i1tQ#jk{H7hb{?I1AH0lzx%?Mcw5}V^2GsSZz|JU!jc`IFHSG7BQ$xZVVmMg9=;j z(nfV5A*U{Iwz{d8v>Voz^ETBbx$1T|C(ngn_0j7ePbSUyg3m>4TboL4d{cbfCVuL- z#~Hw;4tuL{$0NTug4QH3ZINWZ4)?sTd&|6XccRzmZ{hUQN6&Ghm3AEb!|j`h)eSpY z#CrB7^RmoqbVpJ-{Us+22JX}6r4{UL_RY(uu>A60oCn7oBdZPb^b=ulpZKX?_!|>% zr4>D}IhlF(al{#s<6$4o|iFmp5xXBjBHRc9q%%Qs*#Na;lNRnL} zVDCPi-nvB&y(jh>L13S)VLkg(s3&anZ3te*8}TX~da)SAzDvYD4JfiEhNnvmej_h$ zX!I*X<)ed=-Dy$;1R|Cw667uSa3D%}_AO^6-6#wWoZ0bhpO|{oL1CZeXce-z8h6Pu zxZF){R88MOH9QdZuq?vf>@>$nwDqHHvn=|iySY*xW$A-o^`$p^yNf4LwY} zldRppL{Y`ZezveA*+@k2ur#p$!c-!sFU*JAHuqd(i=S!HvrxE4Vq3y4yglsQf z!U~o_dOqUpy^X5hK6ibxPpOC5@*n%Q@C)BK_9cII@@)GzEE48WXK%sixi~2(H{pG~ zCjamhMMIyNt@>b}!-BVjeh(IjbFcH}?dKlWTO}@kF)vOlC5py43z5(ETlkX(t08Bo zbF|e<;dl0J*u7_14J08A3S=RjftDzY=G5A-lldevp5{ zxt{z}Z;?=gJI0i?K`SNgDRhRnD}BPNao1Yp``Evxhrbp4L>A_mr&E_k+Ry>nNPBEi z=DjU1yKV5xQxv-8oc0o{V)_xXFK3r9xa|)MO4}t|VmF$iY;lNr+IWoP?#Roq=C@AF z8q+EEwuSeb45qc@pSW=tzOg^S-mngsoz7`8EdxivejWbX{d6NIf6nPG<`qHnj4x0D z+ZhrkUqhPe#e)`jf~GX>K7Cm_$9}iLNrQ7M#wZ~ub;O=BX+3dE_P$uG*9P4RWtob& zlS>Q2?;D`xX3jj$`vK15p?CPPG}=FM&EN;WDeV*T480NYZ#)!lDHr4^j_*86HNFVX zMXXNZCtO-xM7$S?K`Ov6HNJWX?&1&gN4a>KbPk7%gbfgv+k_GcZ#^^IU2sPZOdr1n zYI<)U2){`DZO*HQ6`d8Pjn3=(*IBf+KLCRfbU<8o*WUU}Y33|t>9;(7ElgqViC8y? zpXA^vdG(g{zProyolIE|ox@=>BYuNt`9<^|I)^umkJ%OA-2PX~lv)3BMJiqmPrY0j z0xtM-qi0V9FYT;0E@}SQ&0~549@MZPa~*&m(L}!iejNdR&UtoK_9YBYHRttRgYzS2 zZ>RPa>1d)~BERnMy_Pe)Bf;^#M8}&CO_GgK+5=gO(a`*sS^vHYa0Vw|dBkcCbM1=~ z5>!E}j8w$_n#Z}BDXfYj@Zj&9f0UFIu(t)~y`{gQ-lEQIztKziz?2vJ-Mhb^Z^jLN zOPiyTVwBbC>Fw6n^rz@ed#y*$cn!4_w6i0GIaA;M<}@O5&cIcApD_`miYlzhi__#iQ9cgB6XVm#l6#NaXec;_zH8Y;)&>E~7_q1)51 z1zmFl=en=yw`Tp8$FJUXa6y3M*2;K}`t>7` z(+>Gk`_61?OqhDq9{J-Vv&}`PkORxNrr&+oeS{Qz<&lGn_3!%R%`D-y=dr4Wr7_-8 zG5Q^ilC~zSiHjBUXbMj~=+L+wjJ6d1Dl+4n$Ax;N(JFBs_kR#BWmDaw&M>-why3Kz zro692a-+NUF7v!gEne4WeU94)a*edva~#25Vo(UrQX?3(+;lh>Wg=g+c8(=C+D~2) zp6~4b9FVWFTr`qxU(d@QS3vgb$9myQef(@QUdHX9H(C`)j%5|PCHToaawx{$ zj)+Ta+Fewr3jX~j-sWKGJY!mtx>ou*@?>s9>f{YW>dHrl#g{C+w4CmT%Qk8r2tUj& zT0_{O@XgwtoL1a>l3Q83_imfHrw%i5V~V|P5!2hmrO5T`Q^M~NBa7nIb9eZ0Zg!q( zm^JiT&hCd!VY&<}YN9yxd5YSIGd0vi_zWFC$KKReT7DMuZytL}9ZRibKJxiJkA2uV zh#6_>z!({x_NLx7*~^v(;6?QnTx^HCzkZ$Dt}C)OF(ldrRrEK+T^{%NcG}mLskW?i WDral<=s|;(1%Tl1JciJ&{{9D2xDf&X literal 0 HcmV?d00001 diff --git a//agc.bin.21 b//agc.bin.21 new file mode 100644 index 0000000000000000000000000000000000000000..052657460bb92203e22da55fc399b2c9f68d13dd GIT binary patch literal 41134 zcmdVDiC+`T)-K%LNr%Wh&yWTY5P<+PJ9R=BWe9`Fv>_-cx>0dP1^L(S^E?&O$YGy* z?)$#?cfXHwcC7BITJ_YbRjXF58rmB5EGyJ8{Fm=r_$wLiO!HsM>V9jjJh5s!E$hb# z9*aV&_rCDGSJ2`8WWciC&A;6I+ltm&w$I0=!EfXB3|OtnkCO-1DDsAnVwRz#%er29ajP*L$l zHk4mDtyic=+nEX3;!FOc{_JD^vsWhM9JT(u9kuGfHdDs?hHOOPvk%=SSaiHRyn$dC z)$dEh`EsDBc%_=}EU)OKU7A{cc z3(rSLNfg`AF}$BpY}Ih}nXB0DUCXkg%%Otn-`ra8mzeGMaYuNL`0^4?*m9aa)$R^> z#E;O^LNAF>O$?cPD-o(3T`$-XG_T7FhX~j9B8VujTKMQ&PB>bsSe3>kju)xT#wwzG zaO2BEuLU_kez{f9Ocn6TO7I7jt_dkZ=x>Mqdc8q>CDGEneamAKRnX)WNC)q{HvG7s zYFlRaBB*B-LqqM1;G;#>Ed!}d%+|1nw3Uh5BOipSp|&Ws;Z314#@Hph(D&>hmX)!h zrT7u4AhGz8UpC$LjreLylBhn}WD7f5QfKiOt4gb4LH7`AIV`PVcV}f|#K)sw zin^6AIOAc(UgKX&tL0mUFUfykqEG&r`rbw;-iq#`91mAdP8*4@Ga3uq)-nm?1kQF? zBn2tU9LgH16?P0%aZT7Od|ATm0?7XBZ%lFhxp^DYe=4rVCD)+zJ2$xl=%9i zmS=}pnjMhpWjFIc;O-6YN`rUK;fGB4sML#=Ho4t98xq2b-Tg0{s)Bh(F_Wxa*AdNq zmtEs{uYb_1#$(e#-SVJUiO|mUR&t;C#u64}yuPvv5#@+zsJ(R(_G%IGF@)r)$NS_) zLr3jPKO1U1t5isUK;Wzts0K1p0I}qDa!L4vs{Zt_dBn)Z#YC|$Ua<D~zG&XODOMy+Y;M?Yu3n6fE23q;E}hbt?7X@4tI6lfV8rg}>=}Ha zSQZJ@`bR8?#)_>vzQmtnSpXUQt*)&+n^=3cGTAe+w78a-U0m&XwwQXhkWM7$Cwta5 z)038OffXO9>(b2kl4U^0fz~UpD`JiISrL|d@-!E##1$r8sbxJKs5x&ZKBc<}U-XKt za?)N;We8g(FLAgfTg5%Om-grQPL(b?DYqqCR(apY-3pmPMx;>WuH~SD0>lhf=bf*+ z{Vd$Z*j?Y|^IgEY)|RrWt)TEMW+ds}DF09-o))teu4QZa`NoH9xXy zYtfHD#8O@ctp4RXurk-QEQnp$6yz}?mw zDBG2rbCcF!3bD=A3m-%G4-m3{qBJiIQCV)wySQ*rZX`A^Qafc-3;Uo9hw=6gtHb}) z2TMQ*RHA78y}gl(6Ehm7(SE$6j`eh5v`WjF|CqQ_+v;{2LT*nQ`@X(5g1NG^ zw02D<>m-x)e$(7xP9|$}GFg|CNu19Eu|16WR(k$Px&QGfz_f#64?WIsN&Rr@vx0;bSdP%&a#&pBf ztY-e<McK;*BRmz;vmzp0tK zODmGIKp3esx4a!h7)xslA=7cz8Itk2hLEweRuD4Q<_1FNPS|$b;*yE6n+nocrimxj zf4J&tj}&VNko%s4n&Yvh zN0U|}7?+V6Oj^%iKnmJ8d1{+!2J+ffOgz{QDkLy20*ck}Sy8^%GZBq>5F}y=8bGzw zq^9=h`BXdcRiRQ)JJ~soWu;oJ&_$<{ck#=oyGHby+<~rXk*e%G`Y=0)*0<_M%g)-i z5WrtJ8tb%>!)q;t$rM2&$CCir=Yc(a8MSYEc1-OXOP2onB2wW^yi@j82RX=HdzpG_ zHG`kM($lF{;)_KwQ;PMr;vKB@G0RIK6q|awm=KjtWOFM=S2mB-C_z=7!;!LC&M^MP zgTdJes}&Arca`bmTVXNrnxSrH(SJ^0Bx_&ZPe(rzUptL_M@D`yfdSHPUxq_N$I!=+ z2gp|A@%OB2L+`{``2|1#UI+k!w}SO>5Hi`oL`%?m`OZv1=_(1Dn~BX-(4+6Dp~HJ^ zx@7swCu6XTPOM%ti(xkPOH=qR5{p+NaGAI3y?7eTw>0I6vV-})$X`y9ND6+R%UZ@J zTi&iKZ%zn95<6$9jayGx>G%eS4wr#5ZJ9{D^OZht4#HKzyj?GlIB02~4Unr$=wB*>1_+pa6Q4~dPJ(E_?17!lcMkDAqWqQq z6Yq1SW!bIP+n08u2|lE49D@7P)_bmZ`kgdT~pIiwb8kPSx1m zPFK|rVnxqBwMvo!(J=E$Q|ErH?%ya9Gpbud+Xy%Y6#!U+plnbLcnAfR?!}YcUh8FE z65n6&GFi^De_10zQ!NisnbLqS-VBn6_fnIaIV50oP!Kxq4hvBf2ENwFhQh6mDCNM2YYz?8{~@>pw6 zr*Z`H%*kzO)!U*qUlAbMR%XR4FqV#rWe>u2k26_Rp{?v&fAmM~jn+Ca|A0vnEp^^R zKlv`{ArrFYLgBl2*Y(N@LXqml0dwJqknKMWB}nB;V)Q6Od2l)Lr3XB z{$}h@b8|3NC};EVeOXWOUQy4#H=@trinUaapuY{Xy9DyG6~SY?9Y0cxy*b55H@#6> zs-@9VJ&~?bBW8ha%Dt23q6&9>_T6;#hN9g+IkYe#PspZk4uME0n=LZI#v zXWpf?jjz?jSK&K(8OK0F*-#IFCZ!ONmpJZ$Yf>%tum`(SvEX0U{lp}9spf2>(%L~P zAh2a2N1WNDcoboC5SFLtT4@r!*ByELe-mFr)WJMS91rMSZ(s8MChlfI!o{ZQOW?Kv z(ouv4uWO{PQHfH?EVH44!oxJwGrJeoBJs7Mzm=qo-;5H`WPkM@Ua=y{~z;0xjjn;)`+^Pa!8-5T!p+wv_kUm5vE7LcP|n85_JND zg(0)j0D9}L$wsL&q!^;C<;k!y26(VSN$bYU2meFQJEhUOwge#?`0M(|^>gCuXBi>i zN4hJk0J)U`Bu<%S&-$9uq_J+m&IvQ+ap?oyrxm2>Qj`7VdFXxyqyk51-~%1WK<8|hMbkav8^>g?BrPvzkk=imtglg1kmHdNl5x6XL1iSN#Gvf@LKSaDt4gbcxTt&tu_(>K4XFx@sLQ>x z8oJ-#N@&hh(fxhCQ-TR;hh34IX{s$Xh1V*NLQQLDjq$#+FY{Z(H>3W$l0l_qsBe`c zv^;=HH?41nBVH>Wv%-&g6rI(ESF0I>lmsRTWTcG|VQ{UNGhs+EW`Rk(!}NbMDh`c! zhJVZBfvv(y+dh(6F@GdHtO&XE%6A7#PKXcYpO(t74(p#F9RP*R>fr{-HxEwyGSXQ+ znEE^6`*>GTwc8NdVl29D*g^$u`Rc)!zx-<~JHV1Dmc;WuDWX3GUuD&&nxk?(_VH2V)l;?!h>72n z_#mAng~W>0TvxGY4Ws$1#P_CT0?nE$@{{RrB%liFu@hxr(40YownMl^I8gcGMrdU2 zNO`Ac@a~##ZiBwLtqgy{_(`-`_QeK$c>M=3SEZjTas(j!*g`>~5E^Tx{&$yELwsLg z$NHtqsLP5vi9`UK2J#NK@}Y;#zNw>@_U$RyM1bKmF-v0tsZG8Od z@03iEaSPhV7%?Oj>ZtwRpFzNSezzp{{vV8T+qpE#PcsEv!D0sN&$$d0*)LCwRi3|B zf13gz=k0#ALb7+U5|@3%;%>38i2pRCh6)nbkH0Dji^9}_1E)ER@~Fyy7q;QsKT-~| z1*C#1{3FO9NkAZ|Ob`;tfDtOA<9v9ch(e)}94v8ea~sY<1T7hFja^){w&Q0R zIczP(L*M(dK`f6Qkp#klnsREeSRvPLfn6d9ufJzlXU$F>7C za=@XIwl*f(pjQ>%IxoC3vZs3N`|6i6akQk{{<>(kmiWryp-MRN2nzwqjTt@UlFC1` zgmx45MjaWaVtr5sBQ!dTO#mJ{lFdqAfm!u!%^;+|cw5KC#VT}(z0nT%y{&lcVyO0e zOG=(GxUVsbUddpZu|}(^mpL|)sI&&xB$tw}a7}X14BF&hiE4BfIjkDCw$^nK zhLmMaFzv?8t$`7#=1Zq>!jT$osQG!vm?S1i5_u6iHvZ@O^zK_(hIAGub4Fm>pOLRp~GSUf;r3p4&jP6bacInN)8$)p4_`7*$8h=x7%BE`!{rS z?|2@^8FhB~G0i)UI1L@uPq(sbC!iu9V@^_04*|U#DdQ?e|2=o&;BzpWwFBO3SDjE5tY@~`WGou%kPXGYWm+q= zdo*8v#i+c0QfW0NUl+^h9Tg9JAN7!C=;9QmwrdUxRem4X-n@fQlA)0@gi;JGO(8VJ z(Cc4j|B&O&;IYB#L&O|H!7j`j*Syxcu;D7rblhhI35O*9xdfKK7=I-Bdm?=wtcW$8 z^frgRMV6+WSX>)3DveZ{inkC;;O5;t-hqJa0O`Z$(jdYtxb<@jKTCVMki-nf2u1r~ zB;=RZlzCAxR(3Z0r_g3OW80Z|v3vS@=kHq;Y~QJpG{}>3p0jXkZQBSTnk?+KrUmj> zcKH!f>{f+V`^weG!WS)loUpEJTXg`ONvf0t_T<++=|uG?%`erNV7i1Z)HP%cYZ5FI zJ20oaTDBg`C|W@EtZQ8;LDN?FEf(j~$d6z3Uc(?qu;jgzh8fe%6w~JCC z?c92`cQ|sA$<%q0!3jb1UPT1!Nq%9fnx=f4T!l`_{GFVTsu+?N#$hD%c+KKd}R+ zteZ4d(8|BJ31Oky4m#6<*-74*+4)S<*hhQ#{6Sx}Y>gF|o`ONNjlTJ#Zym@QFY*r|rS$b$Z6HV(|!);kom)rY| zA|te5L0Wy<=mm6+=taDB+z6pGc(!2Jl zmvysvFiI`waB%TR-jqO7d$jQ6my)ka+YFZJYq5z%**4l>YQ$0{dB%ZQ(O&!ac;5W+ z+y~;T!Pp%&j&qDDaqJDis-Tn`45jzsIH^eUH$C`XXq-s_NHi^MuAC#Zej&fZEX6DF zzzgIpD0=m6Q3DkotXp!e-Dd=N(2MgB2pMB%bY-YPEK!b7WB!{E@iixYLVR)rN&vF= zR8G&4RF=vQ5s-sP<=$`2M*J*EKTa6ihuMC}WS2S3$6rB{RjuWJHifHh#uDTP5OYi+ ziIAzAgOK=~7n=JxOni6F9nUXy-{+O5o64qJp9fXQVXg@Bij%TW&8QK>aMCn%I6kRI zO@4$l;AFt;hR(J1?>CLf0kg?d!;Lo$CHt?5uN&fBk~VC=qV`3KZm;DGNZI)R zDWF+a7t@Kwv@vm<15Qt=n^wk3g)eijMu_D5k5G`zo`7;0lGW&OH(a&(i~O5Y9~`5A zC|lD|XrV`)#C;!`xTD!qZr)QU%<4Gs-(wR|8|eKxttvF*M=*1+`XG*)Inbij%mE@r z)yGFoA0iBK`rt(o(##>T()jp*_|iy>g7OhzCKCU+SfYtUDbxLVV8IaJL5{%5VP+1+ zEG>72L(>9PRaks8bHE$|tO49YBn~FGuf`)iT1eY~jy0R1wBqiVmZk_u7$ka{=JqDd zyRg|Sq&ckgxH@s;CML20SJ zxusJ2c@KW{gpqs9=o>afg;qhNVYjb-E%)dKk0BB;jeO}dstvp;il9rhuIYGst6_Tz z2%3&pGSMxD*dZMLXqIYAzo?UlfT~qqQ(n>eZTEcO3)}ZKbVRgt&@d-w5R4?BoJ!W* z!Eg0LGGdIOZqi*YUa{|&2Y?#rnNT)|1R8d?CMS$B!6FqA40qaX2*g%>70WQ$m`-!6 z`qYPueByg2@$r2ml!7-QQZ}L7DV!#E?$)5*fiLgE*;ua|>p>7;jcN@YE%}}a?VjH^ zhXbXcOt$+iHQ7ckfBJfSaEC=QB>QTJOL0xnxjQGS(b;y@rWX3XBuXF8#FXw@1(6|C*KQtvRbgI%_*6=13hHDMXcQ!sk!J?Q^?UH0_`vx zUD=cHX=W|UF>J-WNSFMWll^yw1!?T2qC{w`RQX}z$QM$;a2rHmc?Pp;R?CKnx@MqP zSHn87Z!w#VZ0|GKY`Z7^Hkae56Keypm6$zrP(vwX?2@8IhSG?+CP>G}+MT8s3-lS; zE`5TbAXW&BFtEsLc`M3MxME$--jASRG1jic(?cL?X;D&a`ljR6 zQeUCU)X|cw9MJ9PjlWS)nD5kKWgp;i?!=3LN@gnWw_zAZl5^x;{9zH=-~oQPh$Nf; z;y4UBP^>67)XbO95?{?(=!<;{dW%19XHd5UMCC${lB*gJ=oSJptV$fhtPcnMA|QW- zP3%24v8i%%e#5%PA)jk3LBzlC1vx&%3M&30KJ+~+5o(J5b_{cxZWUEpVpGm#W(!}F zo2nfZb5P5<6BX%l`hP?L4kjk1GKjci*1$QQZ&#y_n)-UE?|~0qac*n1f+gG?W`%mW ztddL8>=55wFx&p69M=*DCscJnNXzLeybx6CiK=!&r-bOM>A8P(SUKowXGdZMa^N1y%Wsnab_p>O3iwN^bLKKLxL6pL1k zU5Kc(4_D62PIs;GZMgt|B=&{Y@>Loor?l#DvbrAn&o%=P#(odupaerSiAy6a1A2WbFH9c_vhzr#5bNeeH;xLdLF1~E$iJt7}Hd)Zyhis zQmUI~V=f{Vj!N5X?kbs1+;2x2X1Rf(Kb2+g2q$M%Lk(*W#U?FSO7&ekpliGZ%6j+cXJqXvN)#AA+ zt7@gY+BfzZA{KREp?t6I??D?WtU>Guu$Jl054PxUkxF^v{!iLh_MD9!=RbAGw#9>c zFrX&~wnU}B15{YP;j>7K(1H}9ancxz)uVo<+e*S)E2DxW+w+v zLBx{#UuOGbn<3h#_RFXRm#qXOHdi*Br;t3j8k5CNmog-J_sKPifZ67fU|vPU^ARBq zO(Ssso{!&L-h`aN1I#NwutJHScnnCfjHJ?u)U4h5nWtgwzkO&Vvtx#o2d`09uT@Kv z5sv0%&4Z~$Q(tVfwn~F)bs~vt9MehA64wI9w5jiI7L}RKopB>t(eY}XCzYXvVM%e( zgSA)O$YOu-xoTj#WD61-HPQtU4z@t)7^pVY^r5dB!(Yyo>gvV4eohd~2$o)9N8B7J z>>Xmil*OnqPe#IhVpgmKMCL*Z9C;b7IrLJicxFEm2voeZGhB1E&!LQLU;&_t(D;+j zI_jc^qT1{}NFla018L$d2j)5n6YFt^*Fc2^aG1mlRH|Sv5_9)wBDKfu65enp*ohGg zR~q0)Ly?9jn~f}y(ip`YlepF)e%ROly>JltoIK0P%ajhjWjYA8HPS|-;~@0pqH=R> zWnrB9eOxio%4lF2Wzi5vGUv;RpZ9tXQ=*Ng+ zKL+@L_fm(w6v4BHHX3EWsHm*?-6rvsU?Yod{2LLHlIB7mj2}u~q%Am*^0tcjE47T2 zxoyFRwzHW}59&!F_MjXmZ72X-I5OVak z$TCVDy*{9Q>eRrvvPwsMNRBrJ){(#uK@+O-!|~M#p;F6?WQgVKZjI@`*hy~1)O-90 z3JNYukaoQGPDFdVVz4YpAo1%2ISwCG8GGDeK_N=mb{JS54p+ZwCO$aGaA!kKciL4$ z1w&6%>HQR1AyB0)9%|6bdIay#DDmVGI@oFXWF~)9$HP`6=xwklmQ!e7&&Q7%S+#VS z&gVPf3rM+?68`L{1?yL)W;uR15ElFeZQ08^IV6cZSZ&GR)45cJ?9~i@#IW3tli-mF zRZ!Vj#>qB&#X&x@#9QMSPUz%CM15E?35l)uS*#_&)VQD_kmFk|$2X_F?)JqP@!j_w z7)q57cD(zlAd_@3Nw{*X{8er4T_N9fXg?uCF&tJJcr89-0J2qhtp-C`3Rg}#V%w^! zA5s5+Y+PA`%){UcofEv<0&`f8?wY!eeA=hZBh0~YPMw0zYMJvhVZzn!;~j1?Q3Y?( zf7k@QZ?SGYs>d=9esQ464>~7F^`tp+1~5p^wn_m_)@Cm!drU&f&Y~Y(-|FX@rZZ(j zO*k6Qd;d(5d*{SK;CGOBr@hva>#9_20;cSpIzf^>2%$}e*>NIQz;fdrYa^`RMm8P@-wXJ! zu=N2=aYaBpyvqydc@$d_Ws&YS69*C|2iV4+1cqBlZ*%SSf?*x96$eOhr0w;B$V0dQ z2sWW1A2iRG?oabi$-lqPth^7&5Zg%IASbcEjd?^>z#g?GA8nSXcZI02s%Ur0WoDLA z^ti=SrsiUaa5y_zj#Ja*XgakBIL#^o#Kixj`AA7i;E($fZJd6;dq&I}8UZu;!Yi@AWrAE=JgcpbBaQ zj=E-hmnx%m19YY*W^BYJPm}FPRoKR4!8*WrY3bgmnT^7{2H*?jS(yHx?x9AGmW<<^ z$M+6r^B!(NVjWrlmRFAuVH|pR%9GcRW3n;S?>|HcfNTROu>5k?=(GiYzYH5%??Z z*%8M<)IKsMHmS&>4L?5aND-elDV`2w$%kJnM_^~05Xm?9r@zw`7P=tFSG``z8LNC| z_3`efs&^mXK2YA?E<`LNgWKhGn%;;5u;7}kJ`YtjN6^kl)MYmE&&Hxfb~II9KQnc| ziulmayfdrIL#zzQ-o~t;+akrP9$wZmj4lM$$;cN`*cMSIF!%qDEPXLsd$MxmzXSr( zKDLJ|Y=Ex?4Ruy}DK8Nt8#l=dxE4uBRAi;mT;*Rh76{EvQZnK}^Y=pUs#SxkzOrF< zXJ-=>sXrO<^=*3*PTK)r7y3uyROJRqV4(e)8RtZ{B{ye(L?Lu|NgNY97(Ppq%0^{r z2kE5Eaw@}k2OXMuatF#pMD9xkMFG~GYzOV=8i4`nxnqUA6EHOBm*PGGu|$TejMS@- zXn6Hdl##bB{UT<|h=v=`3{Tj}hC|QyU$9(uXM;u7FwALdC4(v)w_Cm#W(!bo(By#H z(GNIraZY=Gc{^Oxt0z4FO8l6 zA0EnqOBtke&z(2Ly6vJgQ^6|#IVyNr48KD<*gg&*~zQFbA(2T`3W^vchWA$Ac z(bsrIDbBK~^^!6MMk^%ibq_LRo0=oT^7j2s(DBo4~RuWTOkzOE&3-w5#SaDM3ob8*guovjFd zs)#^+KfmeAyRb%QndgEbbCteL>)M>XoQai9LqfuX=ac9CY8l}wq7RP_-_<98%nBkL z=Jj7d=Y4hk`*(=%5dGJ}=9@pNz;v$1`A09+Ch65vfrhrNnu~KG?eh`gqklL7AgtzG zTKWp0)r*)pvW!G%Os*3bohy3aL{G#zk=FZW1fzAY*&|DoF7g1&d`4qI#DqL zDYSXOVqR-#2?m{yW?xXyJoHRh8%Y%D!IFjs^sG{~ZxhABaGbmSb)Z}7hDBZ^hT$OY zhpge`WK+?$(xGrTQYd=mOo9ZivP6}*iP{G(h|MUBT7W9;%O{n<7!$tZ0d#N8geyANW_3W{n9gYK=$Ohdd`9QA zHk%{gn~1L(`Xzx=#89ovoJ(qhR5*E>X&{z-3ZZT8JbOWw@b)f}vX@(d9?nzyilt9{ zP?49b$k?e}RHkw{BY=ehTP$cn9@(*F#9%jgQJGdzG?H+5vR~dmf56)o!ZCpLW1Mn_ z%28>f05tU#K8=hnER{`8Mboz$@)GmL$u^8> zxpDoSK86aXY{>QJG~_**8Mh$l2qot8Q@&Um&cQZ_R87_44OyY6iSnG)1nl6ql5oJ962mrTRPHOQQf7uSFkVVIc`p`GP& zT$vq1fN$eo8%mJ#1J{JSN|=@c$`?8keH=gVT^ z+O@mKfbUsYDjcMqxiovsIe*?hVE4fcxBM3nOktM&2U5>mgBe9u2)LII?qbSgS(&$J zRgn^^KrN{r#UDDq^B`*Y047A#i~)uotF=WcIsGT^(I5Kn5=P0y*X-Vf{N}~eHVL7F z(4G3`mFf6$E9x6aYSUY+rfU})EMWN;p1iNPSk05 zF;tc5rPXpRadTyRx1}66#j4WL@>EIE4BI&bID_yauDl$8ta4%=N`kz@B$6TFy9J<@ z^r>>_-G~ok=b+N=5WY`|Q_SB`x9q+V5O~`8&(;XjDVEE|E21YS!c8Lth(0yDn&3y@ z>krfjFW}MNgFw(7Dv!Vnjnsa9K>tSgN689qE0YLZqe2SC?`?*Yoc3|;FK?S?xNSNp zl8I-6(gIcGatpvUEhW_~a|?R>$%O|e)`#UT==P?=)aSEuIN+ExXk7OSfKu zK3CkGKZ{%l#HZ@*2iJ(tun$tzkzXIiRjmXSlqhTEvFUKKB(5^}^=6P`B!wTQE0>Y_hyXngn023#Y^1ur z>BA}FD@R;3HiUJ=-z_N8Zf80cZqX-wE?b@}(C6^`z->tTiu7y(LS86A!4GnVK;2Sy1iK7*PFbt`x!l%xp{eRcy3od0y z*@j9t6Ouoi^@V+<9-!OL;+?2dFE^}-R4_uYjPWhDQFk+bwEBRKh+ojkK!P=L}LOGbH^jEP>pm0l*E3${F2e!S1 zR3q()(JdJ}88i=bL>Y0cTmKF|p$U2D<&kR6)_?dR?I9fwxQyR)T8G18f!~~3<^DA{ zg)Jzy5|53*NU(S=#u$OTImnK4dr~@yh+WO189TI&N{_IgWBn}?V-B-f0E zFdni2tc`V|Cjqr8yNj)Kk1~i2ETitLAl_0xaqE*Sr*N1~Kn)iT%fVBztUAEg+4 zX&D=tVig!tI?N3c&Q_LdEf2(9T@%41#vN@q9*$wEN`qiKA0ft$%Re*(^V8ZQUxJw- z3mSji+c+K}zBLS_QAc?eUzY6vA`bp%}8Y^wOs?An%TCIe@ofGPx$k65Xw4>Y;KYZ~s$x^kIP~$s7P=6}yhvw#){PtKst3~e7Jj%!P|DRC zBA7bbiX4Gq2%Qa10fvYF>|V}mH+)1eoy}M?JHdqqs5uh{A|L0P+^?RNop;3dog_*( z+8_)xD?+5_#vy+)F!JcDG9LyJ54O%wU)rL1fjpyw!NG(|=aJdQrU|4eI2sjnwcwrl zsz5qCHW#Ry@3S@DL*R?RxdHPiI4daa1FI5hNAT zcuoy$ZeAMpAcR@5fODMFg5V0h^kjAY_ghDS7g3K!O1K@G3c!^Y(Ffl*7(qg zs0_1>o8Aqi6*-oe`>q-L;MZ>W;*|KhA*@+Pl&UY~7H}wFP7d02^jHAEb-eAUmMDu& zgf^}VD7;nxA}SNB@q_6e>GBjU9`NQg#hOt(a*A=GcKp^bZ*z_eVIvxbCoCRdkpaAy zfOH+eIT}dBb}4v3qJ{v3wd5hJWcp#XVro}D-H<}HVX6|L` zKY;L8CLcUa-Lp}+wjRKNICS>#$UWG>Cp{wAK!B!DrNd0;A9nZPOA$AG5eAica(QFX zg{8uo^-74_Z#VTW2&pu^<3L{;Jl+)IQp%YU-$Xuv!mNtgTe}%0ffK*PB<_!&9e8B6 zxw;tl(Z0!2frrI}g3^L)@EW`~q=M1}GI+cRP(UCc8iWKgsJ_ZLoM|4xWIh_1=UCww z^Z`if7rhJ04MIU_A__5rAn^w`6mR@c=;g{Wc1A=YqI$$Nq8Ch{8;h)W|NeCPId;eR z+(5mlBDE(vxH*^WU}s_ClZh>f<(BIh7H&$;q)&rIBuySQx{OdxgB&3?8Rl8&-BjG< z)wx*>Cl9nDJKzDYm?%knRQK|jyDP1zeVUgE1*G5t89L)e7Dw}VKAvAI4gRb5nIm2y zEIqEBlq%B5I3+^M11fFM2d#jf3~NuG4xSO?Eo4{Vl9boN9lzCg;-%cZZIwX**gtzQ zA-a+d_ib+c*vcKZfWTh*6&<6Jjr;Wq*e zsr5@zM_eKa@Da<~0LwKPO4rLd1Yx{A0!`c;1XrER0OtK$d9CE%f3w3{u>@xCr7H3! zEQX%uJDVeOIz5orZ~e0>p0RFp%K-S1;`(IsNqgvHpCp%kcW z`CyYCbLda@ISt}v;M}~Ktp`z^Xu&Pf7Q&JrYHlyn=N6wrXd9wuo7oeQYMc%bs7Cww zr}?_;egvjhNphPGhJg)|GKI^yS}yXghz`Hf?DZg3E@Nzd~VPvX1(esDOWW$v6FzPfk8KUVcauE=+} z(ED7-#A=XZ87H}jkGasNTi~Zku zRvKb)0YAlWv<-xsMANM=zkaxqgFaf511$diFF8Oj-TLwOm9N9)8U@Rhf99w=#SXw& z-u@|eHTAZLXb>vk-DrB3KT;N@deUDB$Fu+FFMp);aI}!uz~PXEj@n>FKfT*GqTGd} z`|~DL9C@*ueaB<)0qv6Ak83>TXGH}vpZC5gHa}g6jm!K4`HiR9cf0E*q{N6Y6B`z3 z76y=byWmzf@!l;H$|m0CCNlh?3_A1`+TC1G2&9gEh16F-@2z?KIZ<4EM0_O%-@;-x zqJS62DF;Gxyr~38yU)KtzhPph#03Li%%fBEskZQd5mwRq7N?W&x)<@iqO^$wU!vGAZIUAd1cBbubDQ@?tE8 z!Uen<1jkBCNYBI3D3~dXu<}1=14TTkt5*d)`+k`gKFf~AUxr`!r1HJD*(A7nTOly* zeRv<@X8wwJRY`wl_ApL(4S{?V@q8}-{30I6MF1ZM=ILF8qCBcq>R%>C1aBb7M#xDf z$d6XUW~-okt$gY-F_`k~YWSDWZ!`soAtl>J#EbY5W+is{!DWRC`0d<35;wIfqKMZdC{)N#!y{#AJTYr_^)x0= zU%kBW5!*HhV;vg?NF`&1W0S8QnQL)kQ}eC~VSA)yw+(_JDrS0i(KGjww^3D$H+WNt zqrsDRvU!c#T}#Y+lPfDrD_&xHq6eQ(<)>4+tV}-lo~6BpM(x`owf1{F8G z^lZ&jVw>8~@}ZfrTxq#C5naq8O>p@IzK|>kRA4o+HoH2t>8(sIKbu@#Tm7Rl*PyLD zTU?wKfyHTWW%XHd#d|)vh+4gQ-t=mKo!#i1=ZVcMnVYci6SUs?r%5(}-*a9d5w+-RwC8g)A01L)ZGXf{4e;ip9$0#M1QQ?ABxo)FvlpAvW21WhH_Q zEM6*=L-y100L_mBI zfj_gSCnD}HJ+_t^_y1(ybu7sQ*pXO6|6unqg21k3t4NU#&PcBZc&5+)+)yWlaA~8Qd znd7LcK#KcoZUH+{trF-Tl*C*!z3mI1#H$A_UWCJJW(ND68 zDYqsJ5^J+di-{G3z?)r2;}gu6#SGManAP_cU#kS=&K3*G$tB)zw~?&@mF)> z5lUx;HOQ7LDttEyUW35=68O!R(<@8Q6|ndLS`*5$4za6~*;forn^r-TFtlz4$ za5X*uCK*KpJ=9#_K_UeX;vJgPvLIMcj?dC-Ju`{L)VyLAC!ebiBMtwMcNRJYp(m;K z`vv@<_Ad>r)cp3@OxXo?c;4V<#rXCsFMQ%dnc?qpd<$LNEu8urUtQ?5Lev3Pia$!n z0RKW4-Jf1RIO6~b0$&ER1ge^kP$~S~?U{e^cQ8$w07QWw#L3M%Fm3qD_$+*b?&zPW$ zwvrD|lh+6oGF_GcO#X?r$o*9jC>m>N-nvGh^+)VS!8HN_J|URgdpuxjS!C~Zjb9^h zyKf)PyPU9AbPWHc6jpb-zxA=omC0$c1#@}01wI7L$WH9A6Q9#aMFp=q7f$~-RC0y? zzjZGBGw>U&Ykb4%3h@7z)^)BkG~0VME{pj@XD)*NA*8mT**;RqKfG0`tf4q-*D*vDO!MajNSpe;40B;9cSb3TtTU(@7bk%ALgnUI-Df@xE{qviB4AnV1XZ(s~#BOxvy-tR#g!{H}19Odt^(C~u_QGPi z9%pY5pF737K{s7F>hWDkr0?U}8|IzLm9`zfz4q~m!FSY0S6alb#bK2ADRS7Yq5he* zTIPKb`Z;l5RIC6&sPbM9(_s(Dr}@JSOS>1k+q`$ccMn3xc7W2WnO7B`LxS)-@q_+6F}Ol% zG~B=kgnBplE*z@txz$B_&)l`zk_^k37+o0&dBW$!Zr5cP`#LDi9hyn2=66D!s}EH- zKhnMa!)M-?&S^!3Dc22G)_Ht);4b|7G)tr@XV)>9kFS*L7eqv*H`IUd*F)xbvcmn(__4y*p{;EeItR8-;2t)IS?lEz`-1#qFcPMr6S$ zBPY$g;n3d7U-&m-O|yMR8R`n~x$`3*4wx>3*n?xn_DvW24Zp!!WbRyUQ!Op`@h9&M zWB-~wF6TB!;B(&O7rn(hyX^B>>Q=Y#q17l4^@tps^$yM{&BVH_8{!9w4f_Stj_^HXJKQMSnN*rnK{OOM^CBAFa-Y9 zwTa680N?g2cfHc!EB(M7L=pSGvo{_-VvhIV(7N(YhdvG8@rb$5U2AlS%G!WLgjJ7S zckX+u>f4iCtNG3g2pkJNWjD$kwd1}$#u7Gigq;1Sm-;1#)Lr;dAvqXjYe`CKi9q$}9z7UY=oh|7I=_fi z>_j;KQ)ZT>!KvC|iQ|XvU~isUzX)8bW!>xp$~`%0uSGn2rIUFVou{o4)qE7%u~KE= z@`<+kBjOu$Ucbw1Fm%^l8TqQb?btC_*T;AD0jkvKiw4b(3vb{pqSE@E{kI8mveex?I#DRkIj#9b1Xg8$G&PzMVW>UWr{YVkGdt{ve|-UF^!Vmk z)@?eqIsYJu!XOhvcaD|rMQGzB6(#~)PO|#pm1*C{^$$J1dz3@fc?CiLt53?2kNy@b zWV(pE*75lZL(4&FAxN?KG7u^~Fj`>PecG^)VY&pg=!DNuBSs;|M*v3}#)no5i1dro zoNlBPTl>kixLLihXFDtM&G?b58fxh*^N@x3&Y5lieb7@+`NUo(*%)>g&a*lZ+WV_Y zd+I)J`9e9cmjZm~Wv=?~2g+3i5uAcD%Z*sw;lF#^yNPrrz=zmFX^Xq=(&40P)Kb&f zp4Tq^O%}%Lx{(1@s+#{w%J!`*NP$^MyAk_E@)va%%Zxs4b7ECV#ePL^yu>^Lw*V1T zC)Wl}XhDT7cVVsK7AdDLFD%F1hM(H^wi7uj2UCk7whieZl8^=B-Ml z*1pL}ZWEu%?R5IEvcu9U-OYm7SK-cg)o=KxE0{rA@7`jZ{(a-|*z z|8NE*Vs$`I<};nW!FL(Ht8<4^+5SsT8U*h8PEjdKn|}Rb9hzVEi}UD&ZDciLoPH(* z4~b9Z!rmBrqh8SoowGH|GLAVSvOVm>9OegTbEC~}yNmT1kM#V|onJ;<^r2O=a-XYF zaX9~-k<+1EJ=%kM{5A4q_BhACTP&?IwX^zc0fap(xi+$cwuCp^d0KCa<7#t*8Dr?) z8WB8XKaylu1?b)N$<4du&^w}63j%$nlIiS^q0X@BZv(J0UW-@h&|mXW_*5hISx_Tu zY;dyB;2U~zTdiLfDjDvV>`t;q01&ZMBT?RTkNTpdXWw;}(se>`=uD4p`$X!o4+?#T zt#yl~Rk{n7!E!&jRzBH-WVlG|adCvD*=e?s>eh?A4btcv?#5C{l(CO~)fC;{6F!Vb znOR~v3q4M}m8?CyQlrujz06@rvJr^j0&1ZD!ccu^^ZRR|&vVxgElRBY=?YTVG^%+; zX#49KDckc`P(d@OpAR|vZ=x!<+g%;+R_Jl24Qd9avwl$Uj_JQQK`st8VD$u;?wI+{1Zd?s8tg`P9jD%f#|G-^Hn=RHG4&Lgcgk z2KJ;uHQ)>sKFKggnY+GV#?bapdC!+Z!sn#?Bh`EglpETZZiW1tB9-${=}J`mD|Dvk zGIK2L2l*$=HRPX4i-c<35r(WaYAN-eTh8EinNNC^?n zn|eSt(jIdZdv8jL?-_i#8inpUXI(^9Ks!SE<@^eQd;XxPG+)6IyImh;jw6iI#$p_G zhhBs=zO`Z0m`t&>P2BTjkXDg@;>J<<_Q4oS!#rSmGTW1>8Q2Q;tMF&{Q_+U4seNvvHH6s3vhT@GSqCCO& zon@@r7w)-;)kb{6(&WO~Jx>Iw0AFf!`3T&_AI6Uo@igfi4HyaQBbIxl5(#fUH{6|b zhYn2{zxpb>?i~tWB>pCA)kBL;3u&G6s^(P&dF}T=FoXh#WpCw;&yYsWBF28p;cH|F zV^74oO?;Arb@J*B(|varYuXsH9y>>aW<>l3%kqord*mG5Ha2E^fVt)G#tAe3<&0Fk z8k~5sGyp94bED_aL@(_u*DYxL*vlck4GU^elsOL=RJs6PYk<$W$Sh00gkh;>t-c#D zKXLYVtM0NM^|VW5*L~h^JjdMTU!vN243AZ;-mn%y+>-h; z{i~1_Dy3FNC}MxjVQyduv!Vzr_@0Xol9D`@Hph2wXm6;rs59Mb`lW1O%8UK>?dP41 zxWTuuF)S%YY*kX|zq;$|S-UCx?6a{CARC!WyY3Gx;(dUnCDi{W|A>;f@21@yA$W)p zr$!cIllx%VSg$qVRO5-b8@qxzhxFl{p&!P6VVje?R+zn;T9h;4jiY>qW?_39e08Dk zyLqxtUpss4VV?+IlS9H+&5&%z7T6#$_3kZqeaTq9kBQ(Z%XsT9R+(Ckz|zmoPD1x4 zUx}U@U>X0m-}N-xzPIbBZSBJV6-Mz9>6a<@(UUpmwLKshQk&Q1uz2pXkK2+Q-(76D zqgr0Tm(ihdrX1G#r7e2@WJ+z+%Q6aB+8n(B-NallVSUpEW_&TYb0gc&TbJB!V?VPr zwdx#{Xw(`*7<@|Sb{7#1ST5_l=plOV? zRDg1aqpVv!=EMc^dDMp|9<{374u>0W{mM7(o5R9>q}D2Qp7y>Mmg0$yVP_CUz(RiZ zaYNQuBDvO4b)WCND>+`(WPG;Udvc9+vuD_XT|{sTmZe%SYPsof*2_e`XzmVs|xo0#!|N3=+lzaHPOzIC36o_Cu(zGPsfW&3`(c&+l0@L_b( z9KsHT?^Nw(d&Pri*_pNb;GP+KsxcDRrHEydNbeC#zU$YdgzpJGi{jOeJNPs^I#1M2 zoBCSL-upI5&LXs^@#56vYSc{3?4icPXX^2D7;7bSp3m<&^kL^P zW~8YVZDe@bm3mumFIpam=hu{SvK{XD`gLZzI^WtrlV}xG{_zl3dEAqGX/agc.mid.131 b//agc.mid.131 new file mode 100644 index 0000000..e44c5e7 --- /dev/null +++ b//agc.mid.131 @@ -0,0 +1,3601 @@ +TITLE AGC MUDDLE GARBAGE COLLECTOR + +;SYSTEM WIDE DEFINITIONS GO HERE + +RELOCATABLE +GCST==$. + + +.GLOBAL RCL,VECTOP,GCSTOP,GCSBOT,FRETOP,GCSNEW,VECBOT,PARTOP,PARBOT,HITOP,HIBOT,GETPAG +.GLOBAL PDLBUF,PDLEX,PDLEXP,GCFLG,GCPDL,GETNUM,PARNEW,MOVPUR,RCLV,RCLVEC,PGCNT +.GLOBAL PGROW,TPGROW,MAINPR,MSGTYP,PURTOP,PURBOT,STOSTR,GCSET,CKPUR +.GLOBAL MTYI,UPLO,FRMUNG,BYTDOP,GLOBSP,FREDIF,FREMIN,GCHAPN,INTFLG,FINAGC,NGCS,INQAGC +.GLOBAL SAT,TTOCHN,TYPVEC,ICONS,INCONS,IBLOCK,IEUVEC,IEVECTI,CELL2,MKTBS,RLENGC +.GLOBAL GIBLOK,REHASH,IBLOK1,IILIST,IIFORM,CIVEC,CIUVEC,CICONS,CPOPJ,RBLDM,GCOFFS +.GLOBAL SPBASE,OUTRNG,CISTNG,CBYTES,%RUNAM,PURVEC,GCDOWN,N.CHNS,CHNL1,PLODR,MRKPDL +.GLOBAL CAFRE,CAFRET,STOGC,GCHN,WNDP,FRNP,FRONT,%GCJOB,%SHWND,%INFMP,%GETIP,CHKPGI +.GLOBAL TD.PUT,TD.GET,TD.AGC,TD.AGC,TD.LNT,GLOTOP,UBIT,FLGSET,PURMNG,RPURBT,%IFMP2 +.GLOBAL CTIME,IMTYO,ILOC,NODES,GPURFL,GCDANG,GCHACK,LPUR,HITOP,BADCHN,IMPURX,PURCLN +.GLOBAL GCTIM,GCCAUS,GCCALL,IAAGC,LVLINC,STORIC,GVLINC,TYPIC,GCRSET,ACCESS,NOSHUF,SQUPNT +; GLOBALS ASSOCIATE WITH THE ASSOCIATION VECTOR + +.GLOBAL ASOVEC,ASOLNT,ITEM,INDIC,VAL,NWORDT,NODPNT,PNTRS,DSTORE,HASHTB +.GLOBAL CELL,BINDID,GCFLCH,TYPBOT,GLOBAS,TPBASE,NOWLVL,CURPLN,PVSTOR,SPSTOR + +.GLOBAL P.TOP,P.CORE,PMAPB,IGET,CIGTPR,ROOT,STBL,CAFREE,%MPIN1,%PURIF,%MPINX,GCHK10 +.GLOBAL %SAVRP,%RSTRP,LENGC,AGCLD,PAGEGC,REALGC,MARK +.GLOBAL %MPINT,%GBINT,%CLSMP,%CLSM1,PINIT,PGFIND,NPRFLG +.GLOBAL GCKNUM,CORTOP,GCHPN,INTAGC,WNDP,WNDBOT,BUFGC,WIND,GCDFLG,SAVM,AGC,GCSET + +.GLOBAL GCRET,PAIRMK,DEFMK,VECTMK,TBMK,TPMK,ARGMK,VECTMK,FRMK,BYTMK,ATOMK,GATOMK +.GLOBAL BYTMK,ABMK,LOCRMK,GCRDMK,DEFQMK,ASMRK,LOCMK,OFFSMK,INBLOT,MARK2A + +NOPAGS==1 ; NUMBER OF WINDOWS +EOFBIT==1000 +PDLBUF=100 +NTPMAX==20000 ; NORMAL MAX TP SIZE +NTPGOO==4000 ; NORMAL GOOD TP +ETPMAX==2000 ; TPMAX IN AN EMERGENCY (I.E. GC RECALL) +ETPGOO==2000 ; GOOD TP IN EMERGENCY + +.ATOM.==200000 ; FLAG SAYING ATOMS MARKED (FOR VAL FLUSH LOGIC) + +GCHN==0 ; CHANNEL FOR FUNNNY INFERIOR +STATNO==19. ; # OF STATISTICS FOR BLOAT-STAT +STATGC==8. ; # OF GC-STATISTICS FOR BLOAT-STAT + + +LOC REALGC +OFFS==AGCLD-$. +GCOFFS=OFFS +OFFSET OFFS + +.INSRT MUDDLE > +SYSQ +IFE ITS,[ +.INSRT STENEX > +] +IFN ITS, PGSZ==10. +IFE ITS, PGSZ==9. + +TYPNT=AB ;SPECIAL AC USAGE DURING GC +F=TP ;ALSO SPECIAL DURING GC +LPVP=SP ;SPECIAL FOR GC, HOLDS POINTER TO PROCESS CHAIN +FPTR=TB ; POINT TO CURRENT FRONTIER OF INFERIOR + + +; WINDOW AND FRONTIER PAGES + +MAPCH==0 ; MAPPING CHANNEL +.LIST.==400000 +FPAG==2000 ; START OF PAGES FOR GC-READ AND GCDUMP +CONADJ==5 ; ADJUSTMENT OF DUMPERS CONSTANT TABLE + + +; INTERNAL GCDUMP ROUTINE +.GLOBAL GODUMP,EGCDUM,EPURIF,ERRKIL,IPURIF + +GODUMP: MOVE PVP,PVSTOR+1 + MOVEM P,PSTO+1(PVP) ; SAVE P + MOVE P,GCPDL + PUSH P,AB + PUSHJ P,INFSU1 ; SET UP INFERIORS + +; MARK PHASE + SETZM PURMNG ; INITIALIZE FLAG INDICATING IF PURIFIED PAGES + ; WERE MUNGED + MOVEI 0,HIBOT ; SET UP NEW PURBOT TO CONVINCE THE GARBAGE COLLECTOR + ; TO COLLECT PURIFIED STRUCTURES + EXCH 0,PURBOT + MOVEM 0,RPURBT ; SAVE THE OLD PURBOT + MOVEI 0,HIBOT + EXCH 0,GCSTOP + MOVEM 0,RGCSTP ; SAVE THE OLD GCSTOP + POP P,C ; SET UP PTR TO TYPE/VALUE PAIR + MOVE P,A ; GET NEW PDL PTR + SETOM DUMFLG ; FLAG INDICATING IN DUMPER + MOVE A,TYPVEC+1 + MOVEM A,TYPSAV + ADD FPTR,[7,,7] ; ADJUST FOR FIRST STATUS WORDS + PUSHJ P,MARK2 + MOVEI E,FPAG+6 ; SEND OUT PAIR + PUSH P,C ; SAVE C + MOVE C,A + PUSHJ P,ADWD + POP P,C ; RESTORE C + MOVEI E,FPAG+5 + MOVE C,(C) ; SEND OUT UPDATED PTR + PUSHJ P,ADWD + + MOVEI 0,@BOTNEW ; CALCULATE START OF TYPE-TABLE + MOVEM 0,TYPTAB + MOVE 0,RPURBT ; RESTORE PURBOT + MOVEM 0,PURBOT + MOVE 0,RGCSTP ; RESTORE GCSTOP + MOVEM 0,GCSTOP + + +; ROUTINE TO SCAN THE TYPE-VECTOR FOR MARKED TYPE SLOTS AND BUILD A TYPE-TABLE OUT OF +; THEM + + MOVE A,TYPSAV ; GET AOBJN POINTER TO TYPE-VECTOR + MOVEI B,0 ; INITIALIZE TYPE COUNT +TYPLP2: HLRE C,(A) ; GET MARKING + JUMPGE C,TYPLP1 ; IF NOT MARKED DON'T OUTPUT + MOVE C,(A) ; GET FIRST WORD + HRL C,B ; FIX UP SO TYPE-NUMBER REPLACES TYPE-CELL + PUSH P,A + SKIPL FPTR + PUSHJ P,MOVFNT + MOVEM C,FRONT(FPTR) + AOBJN FPTR,.+2 + PUSHJ P,MOVFNT ; EXTEND THE FRONTIER + POP P,A + MOVE C,1(A) ; OUTPUT SECOND WORD + MOVEM C,FRONT(FPTR) + ADD FPTR,[1,,1] +TYPLP1: ADDI B,1 ; INCREMENT TYPE COUNT + ADD A,[2,,2] ; POINT TO NEXT SLOT + JUMPL A,TYPLP2 ; LOOP + +; ROUTINE TO BUILD UP ATOM TABLE USING LPVP CHAIN + + HRRZ F,ABOTN + MOVEI 0,@BOTNEW ; GET CURRENT BEGINNING OF TRANSFER + MOVEM 0,ABOTN ; SAVE IT + PUSHJ P,ALLOGC ; ALLOCATE ROOM FOR ATOMS + MOVSI D,400000 ; SET UP UNMARK BIT +SPOUT: JUMPE LPVP,DPGC4 ; END OF CHAIN + MOVEI F,(LPVP) ; GET COPY OF LPVP + HRRZ LPVP,-1(LPVP) ; LPVP POINTS TO NEXT ON CHAIN + ANDCAM D,(F) ; UNMARK IT + HLRZ C,(F) ; GET LENGTH + HRRZ E,(F) ; POINTER INTO INF + ADD E,ABOTN + SUBI C,2 ; WE'RE NOT SENDING OUT THE VALUE PAIR + HRLM C,(F) ; ADJUSTED LENGTH + MOVE 0,C ; COPY C FOR TRBLKX + SUBI E,(C) ; ADJUST PTRS FOR SENDOUT + SUBI F,-1(C) + PUSHJ P,TRBLKX ; OUT IT GOES + JRST SPOUT + + +; HERE TO SEND OUT DELIMITER INFORMATION +DPGC4: SKIPN INCORF ; SKIP IF TRANSFREING TO UVECTOR IN CORE + JRST CONSTO + SKIPL FPTR ; SEE IF ROOM IN FRONTEIR + PUSHJ P,MOVFNT ; EXTEND FRONTEIR + MOVSI A,.VECT. + MOVEM A,FRONT(FPTR) + AOBJN FPTR,.+2 + PUSHJ P,MOVFNT + MOVEI A,@BOTNEW ; LENGTH + SUBI A,FPAG + HRLM A,FRONT(FPTR) + ADD FPTR,[1,,1] + + +CONSTO: MOVEI E,FPAG + MOVE C,ABOTN ; START OF ATOMS + SUBI C,FPAG+CONADJ ; ADJUSTMENT FOR STARTING ON PAGE ONE + PUSHJ P,ADWD ; OUT IT GOES + MOVEI E,FPAG+1 + MOVEI C,@BOTNEW + SUBI C,FPAG+CONADJ + SKIPE INCORF ; SKIP IF TO CHANNEL + SUBI C,2 ; SUBTRACT FOR DOPE WORDS + PUSHJ P,ADWD + SKIPE INCORF + ADDI C,2 ; RESTORE C TO REAL ABOTN + ADDI C,CONADJ + PUSH P,C + MOVE C,TYPTAB + SUBI C,FPAG+CONADJ + MOVEI E,FPAG+2 ; SEND OUT START OF TYPE TABLE + PUSHJ P,ADWD + ADDI E,1 ; SEND OUT NUMPRI + MOVEI C,NUMPRI + PUSHJ P,ADWD + ADDI E,1 ; SEND OUT NUMSAT + MOVEI C,NUMSAT + PUSHJ P,ADWD + + + +; FINAL CLOSING OF INFERIORS + +DPCLS: PUSH P,PGCNT + PUSHJ P,INFCL1 + POP P,PGCNT + POP P,A ; LENGTH OF CODE + +; RESTORE AC'S + MOVE PVP,PVSTOR+1 + IRP AC,,[P,TP,TB,AB,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + + SETZB M,R + SETZM DUMFLG + SETZM GCDFLG ; ZERO FLAG INDICATING IN DUMPER + SETZM GCFLG ; AND INDICTOR TO INTERRUPT HANDLER THAT AGC IS ON + PUSH P,A + MOVE A,INF2 ; GET POINTER TO PURE MAPPED OUT + PUSHJ P,%GBINT + + POP P,A + JRST EGCDUM + + +ERDP: PUSH P,B + PUSHJ P,INFCLS + PUSHJ P,INFCL1 + SETZM GCFLG + SETZM GPURFL ; PURE FLAG + SETZM DUMFLG + SETZM GCDFLG + POP P,A + +; RESTORE AC'S + MOVE PVP,PVSTOR+1 + IRP AC,,[P,R,M,TP,TB,AB,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + +ERDUMP: PUSH TP,$TATOM + +OFFSET 0 + + PUSH TP,EQUOTE STRUCTURE-CONTAINS-UNDUMPABLE-TYPE + +OFFSET OFFS + + PUSH TP,$TATOM ; PUSH ON PRIMTYPE + PUSH TP,@STBL(A) ; PUSH ON PRIMTYPE + MOVEI A,2 + JRST ERRKIL + +; ALTERNATE ATOM MARKER FOR DUMPER + +DATOMK: SKIPE GPURFL ; SKIP IF NOT IN PURIFIER + JRST PATOMK + CAILE A,0 ; SEE IF ALREADY MARKED + JRST GCRET + PUSH P,A ; SAVE PTR TO ATOM + HLRE B,A ; POINT TO DOPE WORD + SUB A,B ; TO FIRST DOPE WORD + MOVEI A,1(A) ; TO SECOND + PUSH P,A ; SAVE PTR TO DOPE WORD + HLRZ B,(A) ; GET LENGTH AND MARKING + TRZE B,400000 ; TURN OFF BIT AND SKIP IF UNMARKED + JRST DATMK1 + IORM D,(A) ; MARK IT + MOVE 0,ABOTN ; GET CURRENT TOP OF ATOM TABLE + ADDI 0,-2(B) ; PLACE OF DOPE WORD IN TABLE + HRRM 0,(A) ; PUT IN RELOCATION + MOVEM 0,ABOTN ; FIXUP TOP OF TABLE + HRRM LPVP,-1(A) ; FIXUP CHAIN + MOVEI LPVP,(A) + MOVE A,-1(P) ; GET POINTER TO ATOM BACK + HRRZ B,2(A) ; GET OBLIST POINTER + JUMPE B,NOOB ; IF ZERO ON NO OBLIST + CAMG B,VECBOT ; DON'T SKIP IF OFFSET FROM TVP + MOVE B,(B) + HRLI B,-1 +DATMK3: MOVE A,$TOBLS ; SET UP FOR GET + MOVE C,$TATOM + +OFFSET 0 + MOVE D,IMQUOTE OBLIST + +OFFSET OFFS + + PUSH P,TP ; SAVE FPTR + MOVE TP,MAINPR + MOVE TP,TPSTO+1(TP) ; GET TP + PUSHJ P,IGET + POP P,TP ; RESTORE FPTR + MOVE C,-1(P) ; RECOVER PTR TO ATOM + ADDI C,1 ; SET UP TO MARK OBLIST ATOM + MOVSI D,400000 ; RESTORE MARK WORD + +OFFSET 0 + + CAMN B,MQUOTE ROOT + +OFFSET OFFS + + JRST RTSET + MOVEM B,1(C) + MOVEI B,TATOM + PUSHJ P,MARK1 ; MARK IT + MOVEM A,1(C) ; SMASH IN ITS ID +DATMK1: +NOOB: POP P,A ; GET PTR TO DOPE WORD BACK + HRRZ A,(A) ; RETURN ID + SUB P,[1,,1] ; CLEAN OFF STACK + MOVEM A,(P) + JRST GCRET ; EXIT + +; HERE FOR A ROOT ATOM +RTSET: SETOM 1(C) ; INDICATOR OF ROOT ATOM + JRST NOOB ; CONTINUE + + +; INTERNAL PURIFY ROUTINE +; SAVE AC's + +IPURIF: PUSHJ P,PURCLN ; GET RID OF PURE MAPPED + MOVE PVP,PVSTOR+1 + IRP AC,,[P,R,M,TP,TB,AB,FRM] + MOVEM AC,AC!STO"+1(PVP) + TERMIN + + +; HERE TO CREATE INFERIORS AND MARK THE ITEM +PURIT1: MOVE PVP,PVSTOR+1 + MOVEM P,PSTO+1(PVP) ; SAVE P + SETOM GPURFL ; INDICATE PURIFICATION IS TAKING PLACE + MOVE C,AB ; ARG PAIR + MOVEM C,SAVRS1 ; SAV PTR TO PAIR + MOVE P,GCPDL + PUSHJ P,INFSUP ; GET INFERIORS + MOVE P,A ; GET NEW PDL PTR + PUSHJ P,%SAVRP ; SAVE RPMAP TABLE FOR TENEX + MOVE C,SAVRS1 ; SET UP FOR MARKING + MOVE A,(C) ; GET TYPE WORD + MOVEM A,SAVRE2 +PURIT3: PUSH P,C + PUSHJ P,MARK2 +PURIT4: POP P,C ; RESTORE C + ADD C,[2,,2] ; TO NEXT ARG + JUMPL C,PURIT3 + MOVEM A,SAVRES ; SAVE UPDATED POINTER + +; FIX UP IMPURE PART OF ATOM CHAIN + + PUSH P,[0] ; FLAG INDICATING NON PURE SCAN + PUSHJ P,FIXATM + SUB P,[1,,1] ; CLEAN OFF STACK + +; NOW TO GET PURE STORAGE + +PURIT2: MOVEI A,@BOTNEW ; GET BOTNEW + SUBI A,2000-1777 ; START AT PAGE 1 AND ROUND + ANDCMI A,1777 + ASH A,-10. ; TO PAGES + SETZ M, + PUSH P,A + PUSHJ P,PGFIND ; FIND THEM + JUMPL B,LOSLP2 ; LOST GO TO CAUSE AGC + HRRZ 0,BUFGC ;GET BUFFER PAGE + ASH 0,-10. + MOVEI A,(B) ; GET LOWER PORTION OF PAGES + MOVN C,(P) + SUBM A,C ; GET END PAGE + CAIL 0,(A) ; L? LOWER + CAILE 0,(C) ; G? HIGER + JRST NOREMP ; DON'T GET NEW BUFFER + PUSHJ P,%FDBUF ; GET A NEW BUFFER PAGE +NOREMP: MOVN A,(P) ; SET UP AOBJN PTR FOR MAPIN + MOVE C,B ; SAVE B + HRL B,A + HRLZS A + ADDI A,1 + MOVEM B,INF3 ; SAVE PTR FOR PURIFICATION + PUSHJ P,%MPIN1 ; MAP IT INTO PURE + ASH C,10. ; TO WORDS + MOVEM C,MAPUP + SUB P,[1,,1] ; CLEAN OFF STACK + +DONMAP: +; RESTORE AC's + MOVE PVP,PVSTOR+1 + MOVE P,PSTO+1(PVP) ; GET REAL P + PUSH P,LPVP + MOVEI A,@BOTNEW + MOVEM A,NABOTN + + IRP AC,,[M,TP,TB,R,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + MOVE A,INF1 + +; NOW FIX UP POINTERS IN PURE STRUCTURE + MOVE 0,GCSBOT + MOVEM 0,OGCSTP + PUSH P,GCSBOT ; SAVE GCSBOT AND GCSTOP + PUSH P,GCSTOP + MOVE A,MAPUP ; NEW GCSBOT AND TOP TO FOOL GCHACK + MOVEM A,GCSBOT + ADD A,NABOTN + SUBI A,2000 ; ADJUSTMENT FOR START ON PAGE ONE + MOVEM A,GCSTOP + MOVE A,[PUSHJ P,NPRFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHK10 + POP P,GCSTOP + POP P,GCSBOT + +; NOW FIX UP POINTERS TO PURIFIED STRUCTURE + + MOVE A,[PUSHJ P,PURFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + + SETZM GCDFLG + SETZM DUMFLG + SETZM GCFLG + + POP P,LPVP ; GET BACK LPVP + MOVE A,INF1 + PUSHJ P,%KILJB ; KILL IMAGE SAVING INFERIOR + PUSH P,[-1] ; INDICATION OF PURE ATOM SCAN + PUSHJ P,FIXATM + +; SET UP PMAP SO THAT NEW PURE PAGES ARE INDICATED + + MOVE A,INF3 ; GET AOBJN PTR TO PAGES +FIXPMP: HRRZ B,A ; GET A PAGE + IDIVI B,16. ; DIVIDE SO AS TO PT TO PMAP WORD + PUSHJ P,PINIT ; SET UP PARAMETER + LSH D,-1 + TDO E,D ; FIX UP WORD + MOVEM E,PMAPB(B) ; SEND IT BACK + AOBJN A,FIXPMP + + SUB P,[1,,1] + MOVE A,[PUSHJ P,PURTFX] ; FIX UP PURE ATOM POINTERS + MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + +; NOW FIX UP POINTERS IN PURE STRUCTURE + PUSH P,GCSBOT ; SAVE GCSBOT AND GCSTOP + PUSH P,GCSTOP + MOVE A,MAPUP ; NEW GCSBOT AND TOP TO FOOL GCHACK + MOVEM A,GCSBOT + ADD A,NABOTN + SUBI A,2000 ; ADJUSTMENT FOR START ON PAGE ONE + MOVEM A,GCSTOP + MOVE A,[PUSHJ P,PURTFX] + MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHK10 + POP P,GCSTOP + POP P,GCSBOT + +; HERE TO FIX UP ATOMS WITH TYPES HACKED INTO THEIR GROWTH FIELD + + MOVE A,TYPVEC+1 ; GET TYPE VECTOR + MOVEI B,400000 ; TLOSE==0 +TTFIX: HRRZ D,1(A) ; GET ADDR + HLRE C,1(A) + SUB D,C + HRRM B,(D) ; SMASH IT IN +NOTFIX: ADDI B,1 ; NEXT TYPE + ADD A,[2,,2] + JUMPL A,TTFIX + +; NOW CLOSE UP INFERIORS AND RETURN + +PURCLS: MOVE P,[-2000,,MRKPDL] + PUSHJ P,%RSTRP ;RESETORE RPMAP TABLE FOR TENEX + PUSHJ P,INFCLS + + MOVE PVP,PVSTOR+1 + MOVE P,PSTO+1(PVP) ; RESTORE P + MOVE AB,ABSTO+1(PVP) ; RESTORE R + + MOVE A,INF3 ; GET PTR TO PURIFIED STRUCTURE + SKIPN NPRFLG + PUSHJ P,%PURIF ; PURIFY + + SETZM GPURFL + JRST EPURIF ; FINISH UP + +NPRFIX: PUSH P,A + PUSH P,B + PUSH P,C + EXCH A,C + PUSHJ P,SAT ; GET STORAGE ALLOCATION TYPE + MOVE C,MAPUP ; FIXUP AMOUNT + SUBI C,FPAG ; ADJUST FOR START ON FIRST PAGE + CAIE A,SLOCR ; DONT HACK TLOCRS + CAIN A,S1WORD ; SKIP IF NOT OF PRIMTYPE WORD + JRST LSTFXP + CAIN A,SATOM + JRST ATMFXP + CAIN A,SOFFS + JRST OFFFXP ; FIXUP OFFSETS + HRRZ D,1(B) + JUMPE D,LSTFXP ; SKIP IF NIL + CAMG D,PURTOP ; SEE IF ALREADY PURE + ADDM C,1(B) +LSTFXP: TLNN B,.LIST. ; SKIP IF NOT A PAIR + JRST LSTEX1 + HRRZ D,(B) ; GET REST OF LIST + SKIPE D ; SKIP IF POINTS TO NIL + PUSHJ P,RLISTQ + JRST LSTEX1 + CAMG D,PURTOP ; SKIP IF ALREADY PURE + ADDM C,(B) ; FIX UP LIST +LSTEX1: POP P,C + POP P,B ; RESTORE GCHACK AC'S + POP P,A + POPJ P, + +OFFFXP: HLRZ 0,D ; POINT TO LIST + JUMPE 0,LSTFXP ; POINTS TO NIL + CAML 0,PURTOP ; ALREADY PURE? + JRST LSTFXP ; YES + ADD 0,C ; UPDATE THE POINTER + HRLM 0,1(B) ; STUFF IT OUT + JRST LSTFXP ; DONE + +ATMFXP: HLRE 0,D ; GET LENGTH + SUB D,0 ; POINT TO FIRST DOPE WORD + HRRZS D + CAML D,OGCSTP + CAIL D,HIBOT ; SKIP IF IMPURE + JRST LSTFXP + HRRZ 0,1(D) ; GET RELOCATION + SUBI 0,1(D) + ADDM 0,1(B) ; FIX UP PTR IN STRUCTURE + JRST LSTFXP + +; FIXUP OF PURE ATOM POINTERS + +PURTFX: CAIE C,TATOM ; SKIP IF ATOM POINTER + POPJ P, + HLRE E,D ; GET TO DOPE WORD + SUBM D,E + SKIPL 1(E) ; SKIP IF MARKED + POPJ P, + HRRZ 0,1(E) ; RELATAVIZE PTR + SUBI 0,1(E) + ADD D,0 ; FIX UP PASSED POINTER + SKIPE B ; AND IF APPROPRIATE MUNG POINTER + ADDM 0,1(B) ; FIX UP POINTER + POPJ P, + +PURFIX: PUSH P,D + PUSH P,A + PUSH P,B + PUSH P,C ; SAVE AC'S FOR GCHACK + EXCH A,C ; GET TYPE IN A + CAIN A,TATOM ; CHECK FOR ATOM + JRST ATPFX + PUSHJ P,SAT + + CAILE A,NUMSAT ; SKIP IF TEMPLATE + JRST TLFX +IFN ITS, JRST @PURDSP(A) +IFE ITS,[ + HRRZ 0,PURDSP(A) + HRLI 0,400000 + JRST @0 +] +PURDSP: + +OFFSET 0 + +DISTBS DUM1,TLFX,[[S2WORD,LPLSTF],[S2DEFR,LPLSTF],[SNWORD,VECFX], +[S2NWORD,VECFX],[SSTORE,VECFX],[SBYTE,STRFX],[SATOM,ATPFX],[SLOCB,STRFX] +[SCHSTR,STRFX],[SLOCL,LPLSTF],[SLOCV,VECFX],[SLOCU,VECFX],[SLOCS,VECFX],[SOFFS,OFFSFX]] + +OFFSET OFFS + +VECFX: HLRE 0,D ; GET LENGTH + SUB D,0 ; POINT TO D.W. + SKIPL 1(D) ; SKIP IF MARKED + JRST TLFX + HRRZ C,1(D) + SUBI C,1(D) ; CALCULATE RELOCATION + ADD C,MAPUP ; ADJUSTMENT + SUBI C,FPAG + ADDM C,1(B) +TLFX: TLNN B,.LIST. ; SEE IF PAIR + JRST LVPUR ; LEAVE IF NOT + PUSHJ P,RLISTQ + JRST LVPUR + HRRZ D,(B) ; GET CDR + SKIPN D ; SKIP IF NOT ZERO + JRST LVPUR + MOVE D,(D) ; GET CADR + SKIPL D ; SKIP IF MARKED + JRST LVPUR + ADD D,MAPUP + SUBI D,FPAG + HRRM D,(B) ; FIX UP +LVPUR: POP P,C + POP P,B + POP P,A + POP P,D + POPJ P, + +STRFX: MOVE C,B ; GET ARG FOR BYTDOP + PUSHJ P,BYTDOP + SKIPL (A) ; SKIP IF MARKED + JRST TLFX + HRRZ 0,(A) ; GET PTR IN NEW STRUCTURE + SUBI 0,(A) ; RELATAVIZE + ADD 0,MAPUP ; ADJUST + SUBI 0,FPAG + ADDM 0,1(B) ; FIX UP PTR + JRST TLFX + +ATPFX: HLRE C,D + SUBM D,C + SKIPL 1(C) ; SKIP IF MARKED + JRST TLFX + HRRZS C ; SEE IF PURE + CAIL C,HIBOT ; SKIP IF NOT PURE + JRST TLFX + HRRZ 0,1(C) ; GET PTR TO NEW ATOM + SUBI 0,1(C) ; RELATAVIZE + ADD D,0 + JUMPE B,TLFX + ADDM 0,1(B) ; FIX UP + JRST TLFX + +LPLSTF: SKIPN D ; SKIP IF NOT PTR TO NIL + JRST TLFX + SKIPL (D) ; SKIP IF MARKED + JRST TLFX + HRRZ D,(D) ; GET UPDATED POINTER + ADD D,MAPUP ; ADJUSTMENT + SUBI D,FPAG + HRRM D,1(B) + JRST TLFX + +OFFSFX: HLRZS D ; LIST POINTER + JUMPE D,TLFX ; NIL + SKIPL (D) ; MARKED? + JRST TLFX ; NO + ADD D,MAPUP + SUBI D,FPAG ; ADJUST + HRLM D,1(B) + JRST TLFX ; RETURN + +; ROUTINES TO CAUSE A GARBAGE COLLECT WHEN EFFORTS TO GET STORAGE FAIL + +LOSLP1: MOVE A,ABOTN + MOVEM A,PARNEW ; SET UP GC PARAMS + MOVE C,[12.,,6] + JRST PURLOS + +LOSLP2: MOVEI A,@BOTNEW ; TOTAL AMOUNT NEEDED + ADDI A,1777 + ANDCMI A,1777 ; CALCULATE PURE PAGES NEEDED + MOVEM A,GCDOWN + MOVE C,[12.,,8.] + JRST PURLOS + +PURLOS: MOVE P,[-2000,,MRKPDL] + PUSH P,GCDOWN + PUSH P,PARNEW + MOVE R,C ; GET A COPY OF A + PUSHJ P,INFCLS ; CLOSE INFERIORS AND FIX UP WORLD + PUSHJ P,INFCL2 +PURLS1: POP P,PARNEW + POP P,GCDOWN + MOVE C,R + +; RESTORE AC'S + MOVE PVP,PVSTOR+1 + IRP AC,,[P,R,M,TP,TB,AB,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + + SETZM GCDFLG ; ZERO OUT FLAGS + SETZM DUMFLG + SETZM GPURFL + SETZM GCDANG + + PUSHJ P,AGC ; GARBAGE COLLECT + JRST PURIT1 ; TRY AGAIN + +; PURIFIER ATOM MARKER + +PATOMK: HRRZ 0,A + CAMG 0,PARBOT + JRST GCRET ; DONE IF FROZEN + HLRE B,A ; GET TO D.W. + SUB A,B + SKIPG 1(A) ; SKIP IF NOT MARKED + JRST GCRET + HLRZ B,1(A) + IORM D,1(A) ; MARK THE ATOM + ADDM B,ABOTN + HRRM LPVP,(A) ; LINK ONTO CHAIN + MOVEI LPVP,1(A) + JRST GCRET ; EXIT + + +.GLOBAL %LDRDO,%MPRDO + +; ROUTINES TO ALLOW GC-DUMPING OF PURIFIED STRUCTURES. + +; PROPUR MAPS PAGES CONTAINING PURIFIED STUFF INTO THE AGD INFERIOR SO THAT IN CASE +; THE PAGES ARE MUNGED THEY CAN BE RESTORED USING MAPPING + +; REPURE REMAPS ANY PAGES THAT WERE MUNGED BY GC-DUMP BY RELOADING THEM FROM THE AGD +; INFERIOR IN READ/EXEC MODE + +REPURE: PUSH P,[PUSHJ P,%LDRDO] ; INSTRUCTION FOR MAPPING IN PAGES FROM AGD INF + SKIPA +PROPUR: PUSH P,[PUSHJ P,%MPRDO] ; INSTRUCTION FOR MAPPING PAGES TO AGD INF + MOVE A,PURBOT ; GET STARTING PAGE OF PURENESS + ASH A,-10. ; CONVERT TO PAGES + MOVEI C,HIBOT ; GET ENDING PAGE + ASH C,-10. ; CONVERT TO PAGES + PUSH P,A ; SAVE PAGE POINTER + PUSH P,C ; SAVE END OF PURENESS POINTER +PROLOP: CAML A,(P) ; SKIP IF STILL PURE PAGES TO CHECK + JRST PRODON ; DONE MAPPING PAGES + PUSHJ P,CHKPGI ; SKIP IF PAGE IS PURE + JRST NOTPUR ; IT IS NOT + MOVE A,-1(P) ; GET PAGE TO MAP + XCT -2(P) ; MAP IN/OUT TO AGD INFERIOR IN READ/EXEC MODE +NOTPUR: AOS A,-1(P) ; INCREMENT PAGE POINTER AND LOAD + JRST PROLOP ; LOOP BACK +PRODON: SUB P,[3,,3] ; CLEAN OFF STACK + POPJ P, ; EXIT + + + +.GLOBAL %SAVIN,STOSTR,%CLMP1,%IMSAV,%IMSV1,ILOOKC,PSHGCF,BSETG,%GCJB1 +.GLOBAL %CLSJB,%KILJB,%IFMP1,%OPGFX,%FDBUF +INFSU1: PUSH P,[-1] ; ENTRY USED BY GC-DUMP + SKIPA +INFSUP: PUSH P,[0] + MOVE A,GLOTOP+1 ; GET GLOTOP FOR LOCR HACKS + MOVEM A,GLTOP + PUSHJ P,%FDBUF ; GET A BUFFER FOR C/W HACKS + SETOM GCDFLG + SETOM GCFLG + HLLZS SQUPNT + HRRZ TYPNT,TYPVEC+1 ; SETUP TYPNT + HRLI TYPNT,B + MOVEI A,STOSTR + ANDCMI A,1777 ; TO PAGE BOUNDRY + SUB A,GCSTOP ; SET UP AOBJN POINTER FOR C/W HACK + ASH A,-10. ; TO PAGES + HRLZS A + MOVEI B,STOSTR ; GET START OF MAPPING + ASH B,-10. + ADDI A,(B) + MOVEM A,INF1 + PUSHJ P,%SAVIN ; PROTECT THE CORE IMAGE + SKIPGE (P) ; IF < 0 GC-DUMP CALL + PUSHJ P,PROPUR ; PROTECT PURE PAGES + SUB P,[1,,1] ; CLEAN OFF PSTACK + PUSHJ P,%CLSJB ; CLOSE INFERIOR + + MOVSI D,400000 ; CREATE MARK WORD + SETZB LPVP,ABOTN ; ZERO ATOM COUNTER + MOVEI A,2000 ; MARKED INF STARTS AT PAGE ONE + HRRM A,BOTNEW + SETZM WNDBOT + SETZM WNDTOP + HRRZM A,FNTBOT + ADDI A,2000 ; WNDTOP + MOVEI A,1 ; TO PAGES + PUSHJ P,%GCJB1 ; CREATE THE JOB + MOVSI FPTR,-2000 + MOVEI A,LPUR ; SAVE THE PURE CORE IMAGE + ANDCMI A,1777 ; TO PAGE BOUNDRY + MOVE 0,A ; COPY TO 0 + ASH 0,-10. ; TO PAGES + SUB A,HITOP ; SUBTRACT TOP OF CORE + ASH A,-10. + HRLZS A + ADD A,0 + MOVEM A,INF2 + PUSHJ P,%IMSV1 ; MAP OUT INTERPRETER + PUSHJ P,%OPGFX + +; CREATE A PDL TO USE FOR THESE DUMPING FUNCTIONS + + MOVE A,[-2000,,MRKPDL] + POPJ P, + +; ROUTINE TO CLOSE GC's INFERIOR + + +INFCLS: MOVE A,INF2 ; GET POINTER TO PURE MAPPED OUT + PUSHJ P,%CLSMP + POPJ P, + +; CLOSE INFERIOR PROTECTING CORE IMAGE FOR GCDUMP + +INFCL2: PUSHJ P,%IFMP1 ; OPEN AGD INF TO RESTORE PAGES +INFCL3: MOVE A,INF1 ; RESTORE OPENING POINTER + PUSH P,INF2 + MOVE B,A ; SATIFY MUDITS + PUSHJ P,%IFMP2 ; MAP IN GC PAGES AND CLOSE INFERIOR + POP P,INF2 ; RESTOR INF2 PARAMETER + POPJ P, + +INFCL1: PUSHJ P,%IFMP1 ; OPEN AGD INF TO RESTORE PAGES + SKIPGE PURMNG ; SKIP IF NO PURE PAGES WERE MUNGED + PUSHJ P,REPURE ; REPURIFY MUNGED PAGES + JRST INFCL3 + + + +; ROUTINE TO DO TYPE HACKING FOR GC-DUMP. IT MARKS THE TYPE-WORD OF THE +; SLOT IN THE TYPE VECTOR. IT ALSO MARKS THE ATOM REPLACING THE I.D. IN +; THE RIGHT HALF OF THE ATOM SLOT. IF THE TYPE IS A TEMPLATE THE FIRST +; USE OF THE SAT HAS ITS ATOM MARKED AND THE I.D. IS PLACED IN THE LEFT +; HALF OF THE ATOM SLOT (IT GETS THE REAL PRIMTYPE). + +TYPHK: CAILE B,NUMPRI ; SKIP IF A MUDDLE TYPE + JRST TYPHKR ; ITS A NEWTYPE SO GO TO TYPHACKER + CAIN B,TTYPEC ; SKIP IF NOT TYPE-C + JRST TYPCHK ; GO TO HACK TYPE-C + CAIE B,TTYPEW ; SKIP IF TYPE-W + POPJ P, + PUSH P,B + HLRZ B,A ; GET TYPE + JRST TYPHKA ; GO TO TYPE-HACKER +TYPCHK: PUSH P,B ; SAVE TYPE-WORD + HRRZ B,A + JRST TYPHKA + +; GENERAL TYPE-HACKER FOR GC-DUMP + +TYPHKR: PUSH P,B ; SAVE AC'S +TYPHKA: PUSH P,A + PUSH P,C + LSH B,1 ; GET OFFSET TO SLOT IN TYPE VECTOR + MOVEI C,(TYPNT) ; GET TO SLOT + ADDI C,(B) + SKIPGE (C) + JRST EXTYP + IORM D,(C) ; MARK THE SLOT + MOVEI B,TATOM ; NOW MARK THE ATOM SLOT + PUSHJ P,MARK1 ; MARK IT + HRRM A,1(C) ; SMASH IN ID + HRRZS 1(C) ; MAKE SURE THAT THATS ALL THATS THERE + HRRZ B,(C) ; GET SAT + ANDI B,SATMSK ; GET RID OF MAGIC BITS + HRRM B,(C) ; SMASH SAT BACK IN + CAIG B,NUMSAT ; SKIP IF TEMPLATE + JRST EXTYP + MOVE A,TYPSAV ; GET POINTER TO TYPE VECTOR + ADDI A,NUMPRI*2 ; GET TO NEWTYPES SLOTS + HRLI 0,NUMPRI*2 + HLLZS 0 ; MAKE SURE ONLY LEFT HALF + ADD A,0 +TYPHK1: HRRZ E,(A) ; GET SAT OF SLOT + CAMN E,B ; SKIP IF NOT EQUAL + JRST TYPHK2 ; GOT IT + ADDI A,2 ; TO NEXT + JRST TYPHK1 +TYPHK2: PUSH P,C ; SAVE POINTER TO ORIGINAL SLOT + MOVE C,A ; COPY A + MOVEI B,TATOM ; SET UP FOR MARK + MOVE A,1(C) ; ASSUME MARK DOESN'T HAVE TO TAKE PLACE + SKIPL (C) ; DON'T MARK IF ALREADY MARKED + PUSHJ P,MARK + POP P,C ; RESTORE C + HRLM A,1(C) ; SMASH IN PRIMTYPE OF TEMPLATE +EXTYP: POP P,C ; RESTORE AC'S + POP P,A + POP P,B + POPJ P, ; EXIT + + +; A ROUTINE TO DISTINGUISH BETWEEN A DEFERRED AND A LIST POINTER +RLISTQ: PUSH P,A + GETYP A,(B) ; GET TYPE + PUSHJ P,SAT ; GET SAT + CAIG A,NUMSAT ; NOT DEFERRED IF TEMPLATE + SKIPL MKTBS(A) + AOS -1(P) ; SKIP IF NOT DEFFERED + POP P,A + POPJ P, ; EXIT + + +; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED) + +GCDISP: + +OFFSET 0 + +DISTBS DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK],[STBASE,ERDP] +[STPSTK,ERDP],[SARGS,ERDP],[S2NWORD,VECTMK],[SPSTK,ERDP],[SSTORE,VECTMK] +[SFRAME,ERDP],[SBYTE,],[SATOM,DATOMK],[SPVP,ERDP],[SGATOM,ERDP] +[SLOCID,ERDP],[SCHSTR,],[SASOC,ERDP],[SLOCL,PAIRMK],[SABASE,ERDP] +[SLOCA,ERDP],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,],[SLOCN,ERDP] +[SLOCB,],[SLOCR,LOCRDP],[SOFFS,OFFSMK]] + +OFFSET OFFS + + +; THIS SUBROUTINE IMPURIFIES A PURE ATOM TO ALLOW MODIFICATION OF SYSTEM SUBRS + +IMPRF: PUSH P,A + PUSH P,LPVP + PUSH TP,$TATOM + HLRZ C,(A) ; GET LENGTH + TRZ C,400000 ; TURN OF 400000 BIT + SUBI A,-1(C) ; POINT TO START OF ATOM + MOVNI C,-2(C) ; MAKE IT LOOK LIKE AN ATOM POINTER + HRL A,C + PUSH TP,A + MOVE C,A + MOVEI 0,(C) + PUSH P,AB + MOVE PVP,PVSTOR+1 + MOVE AB,ABSTO+1(PVP) + PUSHJ P,IMPURX + POP P,AB + POP P,LPVP ; RESTORE A + POP P,A + POPJ P, + +FIXATM: PUSH P,[0] +FIXTM5: JUMPE LPVP,FIXTM4 + MOVEI B,(LPVP) ; GET PTR TO ATOMS DOPE WORD + HRRZ LPVP,-1(B) ; SET UP LPVP FOR NEXT IN CHAIN + SKIPE -2(P) ; SEE IF PURE SCAN + JRST FIXTM2 + CAIL B,HIBOT + JRST FIXTM3 +FIXTM2: CAMG B,PARBOT ; SKIP IF NOT FROZEN + JRST FIXTM1 + HLRZ A,(B) + TRZ A,400000 ; GET RID OF MARK BIT + MOVE D,A ; GET A COPY OF LENGTH + SKIPE -2(P) + JRST PFATM + PUSHJ P,CAFREE ; GET STORAGE + SKIPE GCDANG ; SEE IF WON + JRST LOSLP1 ; GO TO CAUSE GC + JRST FIXT10 +PFATM: PUSH P,AB + MOVE PVP,PVSTOR+1 + MOVE AB,ABSTO+1(PVP) + SETZM GPURFL + PUSHJ P,CAFREE + SETOM GPURFL + POP P,AB +FIXT10: SUBM D,ABOTN + MOVNS ABOTN + SUBI B,-1(D) ; POINT TO START OF ATOM + HRLZ C,B ; SET UP FOR BLT + HRRI C,(A) + ADDI A,-1(D) ; FIX UP TO POINT TO NEW DOPE WORD + BLT C,(A) + HLLZS -1(A) + HLLOS (A) ; -1 IN RELOCATION FIELD SINCE ITS NOT GARBAGE + ADDI B,-1(D) ; B POINTS TO SECOND D.W. + HRRM A,(B) ; PUT IN RELOCATION + MOVSI D,400000 ; UNMARK ATOM + ANDCAM D,(A) + CAIL B,HIBOT ; SKIP IF IMPURE + PUSHJ P,IMPRF + JRST FIXTM5 ; CONTINE FIXUP + +FIXTM4: POP P,LPVP ; FIX UP LPVP TO POINT TO NEW CHAIN + POPJ P, ; EXIT + +FIXTM1: HRRM B,(B) ; SMASH IN RELOCATION + MOVSI D,400000 + ANDCAM D,(B) ; CLEAR MARK BIT + JRST FIXTM5 + +FIXTM3: MOVE 0,(P) + HRRM 0,-1(B) + MOVEM B,(P) ; FIX UP CHAIN + JRST FIXTM5 + + + +IAGC": + +;SET FLAG FOR INTERRUPT HANDLER + SETZB M,RCL ; CLEAR OUT RECYCLE LIST CELLS, AND RSUBR BASE PNTR + EXCH P,GCPDL ; IN CASE CURRENT PDL LOSES + PUSH P,B + PUSH P,A + PUSH P,C ; SAVE C + +; HERE TO CLEAN UP ANY POSSIBLE PURENESS IN GC SPACE BEFORE COLLECTING + + + + MOVE A,NOWFRE + ADD A,GCSTOP ; ADJUSTMENT TO KEEP FREE REAL + SUB A,FRETOP + MOVEM A,NOWFRE + MOVE A,NOWP ; ADJUSTMENTS FOR STACKS + SUB A,CURP + MOVEM A,NOWP + MOVE A,NOWTP + SUB A,CURTP + MOVEM A,NOWTP + + MOVEI B,[ASCIZ /GIN /] + SKIPE GCMONF ; MONITORING + PUSHJ P,MSGTYP +NOMON1: HRRZ C,(P) ; GET CAUSE OF GC INDICATOR + MOVE B,GCNO(C) ; ADD 1 TO COUNT OF GC'S CAUSED BY GIVEN REASON + ADDI B,1 + MOVEM B,GCNO(C) + MOVEM C,GCCAUS ; SAVE CAUSE OF GC + SKIPN GCMONF ; MONITORING + JRST NOMON2 + MOVE B,MSGGCT(C) ; GET CAUSE MESSAGE + PUSHJ P,MSGTYP +NOMON2: HLRZ C,(P) ; FIND OUT WHO CAUSED THE GC + MOVEM C,GCCALL ; SAVE CALLER OF GC + SKIPN GCMONF ; MONITORING + JRST NOMON3 + MOVE B,MSGGFT(C) + PUSHJ P,MSGTYP +NOMON3: SUB P,[1,,1] ; POP OFF C + POP P,A + POP P,B + EXCH P,GCPDL + JRST .+1 +IAAGC: + HLLZS SQUPNT ; FLUSH SQUOZE TABLE + SETZB M,RCL ; ALTERNATE GC-ENTRY POINT FOR INITIALIZATION +INITGC: SETOM GCFLG + SETZM RCLV + +;SAVE AC'S + EXCH PVP,PVSTOR+1 + IRP AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM] + MOVEM AC,AC!STO"+1(PVP) + TERMIN + + MOVE 0,PVSTOR+1 + MOVEM 0,PVPSTO+1(PVP) + MOVEM PVP,PVSTOR+1 + MOVE D,DSTORE + MOVEM D,DSTO(PVP) + JSP E,CKPUR ; CHECK FOR PURE RSUBR + + +;SET UP E TO POINT TO TYPE VECTOR + GETYP E,TYPVEC + CAIE E,TVEC + JRST AGCE1 + HRRZ TYPNT,TYPVEC+1 + HRLI TYPNT,B + +CHPDL: MOVE D,P ; SAVE FOR LATER +CORGET: MOVE P,[-2000,,MRKPDL] + +;FENCE POST PDLS AND CHECK IF ANY SHOULD BE SHRUNK + + MOVEI A,(TB) ;POINT TO CURRENT FRAME IN PROCESS + PUSHJ P,FRMUNG ;AND MUNG IT + MOVE A,TP ;THEN TEMPORARY PDL + PUSHJ P,PDLCHK + MOVE PVP,PVSTOR+1 + MOVE A,PSTO+1(PVP) ;AND UNMARKED P STACK + PUSHJ P,PDLCHP + + ; FIRST CREATE INFERIOR TO HOLD NEW PAGES + +INFCRT: MOVE A,PARBOT ; GENERATE NEW PARBOT AND PARNEW + ADD A,PARNEW + ADDI A,1777 + ANDCMI A,1777 ; EVEN PAGE BOUNDARY + HRRM A,BOTNEW ; INTO POINTER WORD + HRRZM A,FNTBOT + SETZM WNDBOT + SETZM WNDTOP + MOVEM A,NPARBO + HRRZ A,BOTNEW ; GET PAGE TO START INF AT + ASH A,-10. ; TO PAGES + MOVEI R,(A) ; COPY A + PUSHJ P,%GCJOB ; GET PAGE HOLDER + MOVSI FPTR,-2000 ; FIX UP FRONTIER POINTER + MOVE A,WNDBOT + ADDI A,2000 ; FIND WNDTOP + MOVEM A,WNDTOP + +;MARK PHASE: MARK ALL LISTS AND VECTORS +;POINTED TO WITH ONE BIT IN SIGN BIT +;START AT TRANSFER VECTOR +NOMAP: MOVE A,GLOBSP+1 ; GET GLOBSP TO SAVE + MOVEM A,GCGBSP + MOVE A,ASOVEC+1 ; ALSO SAVE FOR USE BY GC + MOVEM A,GCASOV + MOVE A,NODES+1 ; SAVE FOR ASSOCIATION UPDATE AND MOVEMENT PHASE + MOVEM A,GCNOD + MOVE A,GLOTOP+1 ; GET GLOTOP FOR LOCR HACKS + MOVEM A,GLTOP + MOVE A,PURVEC+1 ; SAVE PURE VECTOR FOR GETPAG + MOVEM A,PURSVT + MOVE A,HASHTB+1 + MOVEM A,GCHSHT + + SETZ LPVP, ;CLEAR NUMBER OF PAIRS + MOVE 0,NGCS ; SEE IF NEED HAIR + SOSGE GCHAIR + MOVEM 0,GCHAIR ; RESUME COUNTING + MOVSI D,400000 ;SIGN BIT FOR MARKING + MOVE A,ASOVEC+1 ;MARK ASSOC. VECTOR NOW + PUSHJ P,PRMRK ; PRE-MARK + MOVE A,GLOBSP+1 + PUSHJ P,PRMRK + MOVE A,HASHTB+1 + PUSHJ P,PRMRK +OFFSET 0 + + MOVE A,IMQUOTE THIS-PROCESS + +OFFSET OFFS + + MOVEM A,GCATM + +; HAIR TO DO AUTO CHANNEL CLOSE + + MOVEI 0,N.CHNS-1 ; NUMBER OF CHANNELS + MOVEI A,CHNL1 ; 1ST SLOT + + SKIPE 1(A) ; NOW A CHANNEL? + SETZM (A) ; DON'T MARK AS CHANNELS + ADDI A,2 + SOJG 0,.-3 + + MOVEI C,PVSTOR + MOVEI B,TPVP + MOVE A,PVSTOR+1 ; MARK MAIN PROCES EVEN IF SWAPPED OUT + PUSHJ P,MARK + MOVEI C,MAINPR-1 + MOVEI B,TPVP + MOVE A,MAINPR ; MARK MAIN PROCES EVEN IF SWAPPED OUT + PUSHJ P,MARK + MOVEM A,MAINPR ; ADJUST PTR + +; ASSOCIATION AND VALUE FLUSHING PHASE + + SKIPN GCHAIR ; ONLY IF HAIR + PUSHJ P,VALFLS + + SKIPN GCHAIR + PUSHJ P,ATCLEA ; CLEAN UP ATOM TABLE + + SKIPE GCHAIR ; IF NOT HAIR, DO CHANNELS NOW + PUSHJ P,CHNFLS + + PUSHJ P,ASSOUP ; UPDATE AND MOVE ASSOCIATIONS + PUSHJ P,CHFIX ; SEND OUT CHANNELS AND MARK LOSERS + PUSHJ P,STOGC ; FIX UP FROZEN WORLD + MOVE P,GCPDL ; SWITCH PDLS IN CASE THIS ONE DISSAPPEARS + + + MOVE A,NPARBO ; UPDATE GCSBOT + MOVEM A,GCSBOT + MOVE A,PURSVT + PUSH P,PURVEC+1 + MOVEM A,PURVEC+1 ; RESTORE PURVEC + PUSHJ P,CORADJ ; ADJUST CORE SIZE + POP P,PURVEC+1 + + + + ; MAP NEW PAIR SPACE IN FOR PAIR SPACE UPDATE + +NOMAP1: MOVEI A,@BOTNEW + ADDI A,1777 ; TO PAGE BOUNDRY + ANDCMI A,1777 + MOVE B,A +DOMAP: ASH B,-10. ; TO PAGES + MOVE A,PARBOT + MOVEI C,(A) ; COMPUTE HIS TOP + ASH C,-10. + ASH A,-10. + SUBM A,B ; B==> - # OF PAGES + HRLI A,(B) ; AOBJN TO SOURCE AND DEST + MOVE B,A ; IN CASE OF FUNNY + HRRI B,(C) ; MAP HIS POSSIBLE HIGHER OR LOWER PAGES + PUSHJ P,%INFMP ; NOW FLUSH INF AND MAKE HIS CORE MINE + JRST GARZER + + ; CORE ADJUSTMENT PHASE + +CORADJ: MOVE A,PURTOP + SUB A,CURPLN ; ADJUST FOR RSUBR + ANDCMI A,1777 ; ROUND DOWN + MOVEM A,RPTOP + MOVEI A,@BOTNEW ; NEW GCSTOP + ADDI A,1777 ; GCPDL AND ROUND + ANDCMI A,1777 ; TO PAGE BOUNDRY + MOVEM A,CORTOP ; TAKE CARE OF POSSIBLE LATER LOSSAGE + CAMLE A,RPTOP ; SEE IF WE CAN MAP THE WORLD BACK IN + FATAL AGC--UNABLE TO MAP GC-SPACE INTO CORE + CAMG A,PURBOT ; SEE IF WE HAVE TO PUNT SOME PURE TO DO IT + JRST CORAD0 ; DON'T HAVE TO PUNT SOME PURE + PUSHJ P,MAPOUT ; GET THE CORE + FATAL AGC--PAGES NOT AVAILABLE + +; NOW THAT WE ARE ABLE TO MAP TO GCS INTO CORE WE WILL TRY TO HONOR SOME REQUESTS +; FIRST LETS SEE IF WE HAVE TO CORE DOWN. +; GCDOWN IS DEFINED AS AMOUNT FROM FRETOP TO PURBOT NEEDED + +CORAD0: SKIPN B,GCDOWN ; CORE DOWN? + JRST CORAD1 ; NO, LETS GET CORE REQUIREMENTS + ADDI A,(B) ; AMOUNT+ONE FREE BLOCK + CAMGE A,RPTOP ; CAN WE WIN + JRST CORAD3 ; POSSIBLY + +; THIS IS A EXIT FOR LOSSAGE WITHOUT A FATAL ERROR +CORAD2: SETOM GCDANG ; INDICATE LOSSAGE + +; CALCULATE PARAMETERS BEFORE LEAVING +CORAD6: MOVE A,PURSVT ; GET PURE TABLE + PUSHJ P,SPCOUT ; OUT IT GOES IN CASE IT WAS CHANGED + MOVEI A,@BOTNEW ; GCSTOP + MOVEM A,GCSTOP + MOVE A,CORTOP ; ADJUST CORE IMAGE + ASH A,-10. ; TO PAGES +TRYPCO: PUSHJ P,P.CORE + FATAL AGC--CORE SCREW UP + MOVE A,CORTOP ; GET IT BACK + ANDCMI A,1777 + MOVEM A,FRETOP + MOVEM A,RFRETP + POPJ P, + +; TRIES TO SATISFY REQUEST FOR CORE +CORAD1: MOVEM A,CORTOP + MOVEI A,@BOTNEW + ADD A,GETNUM ; ADD MINIMUM CORE NEEDED + ADDI A,1777 ; ONE BLOCK+ROUND + ANDCMI A,1777 ; TO BLOCK BOUNDRY + CAMLE A,RPTOP ; CAN WE WIN + JRST CORAD2 ; LOSE + CAMGE A,PURBOT + JRST CORAD7 ; DON'T HAVE TO MAP OUT PURE + PUSHJ P,MAPOUT + JRST CORAD2 ; LOSS + +; NOW TRY TO GET SLOP SPACE. NOT NECESSARY BUT NICE +CORAD7: MOVEM A,CORTOP ; STORE POSSIBLE VALUE + MOVE B,RPTOP ; GET REAL PURTOP + SUB B,PURMIN ; KEEP PURMIN + CAMG B,CORTOP ; SEE IF CORTOP IS ALREADY HIGH + MOVE B,CORTOP ; DONT GIVE BACK WHAT WE GOT + MOVEM B,RPTOP ; FOOL CORE HACKING + ADD A,FREMIN + ANDCMI A,1777 ; TO PAGE BOUNDRY + CAMGE A,RPTOP ; DO WE WIN TOTALLY + JRST CORAD4 + MOVE A,RPTOP ; GET AS MUCH CORE AS POSSIBLE + PUSHJ P,MAPOUT + JRST CORAD6 ; LOSE, BUT YOU CAN'T HAVE EVERYTHING +CORAD4: CAMG A,PURBOT ; DO WE HAVE TO PUNT SOME PURE + JRST CORAD8 + PUSHJ P,MAPOUT ; GET IT + JRST CORAD6 +CORAD8: MOVEM A,CORTOP ; ADJUST PARAMETER + JRST CORAD6 ; WIN TOTALLY + +; WE CAN CORE DOWN NOW TO SEE IF WE CAN GET SOME SLOP SPACE + +CORAD3: ADD A,FREMIN + ANDCMI A,1777 + CAMGE A,PURBOT ; CAN WE WIN + JRST CORAD9 + MOVE A,RPTOP +CORAD9: SUB A,GCDOWN ; SATISFY GCDOWN REQUEST + JRST CORAD4 ; GO CHECK ALLOCATION + +MAPOUT: PUSH P,A ; SAVE A + SUB A,P.TOP ; AMOUNT TO GET + ADDI A,1777 ; ROUND + ANDCMI A,1777 ; TO PAGE BOUNDRY + ASH A,-PGSZ ; TO PAGES + PUSHJ P,GETPAG ; GET THEN + JRST MAPLOS ; LOSSAGE + AOS -1(P) ; INDICATE WINNAGE +MAPLOS: POP P,A + POPJ P, + + + ;GARBAGE ZEROING PHASE +GARZER: MOVE A,GCSTOP ;FIRST WORD OF GARBAGE IS AFTER PAIR SPACE + MOVE B,FRETOP ;LAST ADDRESS OF GARBAGE + 1 + CAIL A,(B) + JRST GARZR1 + CLEARM (A) ;ZERO THE FIRST WORD + CAIL A,-1(B) ; ARE WE AT THE TOP OF THE WORLD (FORMERLY CAML A,FRETOP) + JRST GARZR1 ; DON'T BLT +IFE ITS,[ + MOVEI B,777(A) + ANDCMI B,777 +] + HRLS A + ADDI A,1 ;MAKE A A BLT POINTER + BLT A,-1(B) ;AND COPY ZEROES INTO REST OF AREA +IFE ITS,[ + +; MAP UNWANTED PAGES OUT ON TWENEX (AFTER ZEROING REST OF LAST PAGE) + + MOVE D,PURBOT + ASH D,-PGSZ + ASH B,-PGSZ + MOVNI A,1 + MOVEI C,0 + HRLI B,400000 + +GARZR2: CAIG D,(B) + JRST GARZR1 + + PMAP + AOJA B,GARZR2 +] + + +; NOW REHASH THE ASSOCIATIONS BASED ON VALUES +GARZR1: PUSHJ P,REHASH + + + ;RESTORE AC'S +TRYCOX: SKIPN GCMONF + JRST NOMONO + MOVEI B,[ASCIZ /GOUT /] + PUSHJ P,MSGTYP +NOMONO: MOVE PVP,PVSTOR+1 + IRP AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + SKIPN DSTORE + SETZM DSTO(PVP) + MOVE PVP,PVPSTO+1(PVP) + +; CLOSING ROUTINE FOR G-C + PUSH P,A ; SAVE AC'C + PUSH P,B + PUSH P,C + PUSH P,D + + MOVE A,FRETOP ; ADJUST BLOAT-STAT PARAMETERS + SUB A,GCSTOP + ADDM A,NOWFRE + PUSHJ P,GCSET ; FIX UP BLOAT-STAT PARAMETERS + MOVE A,CURTP + ADDM A,NOWTP + MOVE A,CURP + ADDM A,NOWP + + PUSHJ P,CTIME + FSBR B,GCTIM ; GET TIME ELAPSED + MOVEM B,GCTIM ; SAVE ELAPSED TIME FOR INT-HANDLER + SKIPN GCMONF ; SEE IF MONITORING + JRST GCCONT + PUSHJ P,FIXSEN ; OUTPUT TIME + MOVEI A,15 ; OUTPUT C/R LINE-FEED + PUSHJ P,IMTYO + MOVEI A,12 + PUSHJ P,IMTYO +GCCONT: MOVE C,[NTPGOO,,NTPMAX] ; MAY FIX UP TP PARAMS TO ENCOURAGE + ; SHRINKAGE FOR EXTRA ROOM + SKIPE GCDANG + MOVE C,[ETPGOO,,ETPMAX] + HLRZM C,TPGOOD + HRRZM C,TPMAX + POP P,D ; RESTORE AC'C + POP P,C + POP P,B + POP P,A + MOVE A,GCDANG + JUMPE A,AGCWIN ; IF ZERO THE GC WORKED + SKIPN GCHAIR ; SEE IF HAIRY GC + JRST BTEST +REAGCX: MOVEI A,1 ; PREPARE FOR A HAIRY GC + MOVEM A,GCHAIR + SETZM GCDANG + MOVE C,[11,,10.] ; REASON FOR GC + JRST IAGC + +BTEST: SKIPE INBLOT + JRST AGCWIN + FATAL AGC--NO CORE AVAILABLE TO SATISFY REQUESTS + JRST REAGCX + +AGCWIN: SETZM PARNEW ;CLEAR FOR NEXT AGC CALL + SETZM GETNUM ;ALSO CLEAR THIS + SETZM INBLOT + SETZM GCFLG + + SETZM PGROW ; CLEAR GROWTH + SETZM TPGROW + SETOM GCHAPN ; INDICATE A GC HAS HAPPENED + SETOM GCHPN + SETOM INTFLG ; AND REQUEST AN INTERRUPT + SETZM GCDOWN + PUSHJ P,RBLDM + JUMPE R,FINAGC + JUMPN M,FINAGC ; IF M 0, RUNNING RSUBR SWAPPED OUT + SKIPE PLODR ; LOADING ONE, M = 0 IS OK + JRST FINAGC + + FATAL AGC--RUNNING RSUBR WENT AWAY + +AGCE1: FATAL AGC--TYPE VECTOR NOT OF TYPE VECTOR + + ; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL +; POINT. + +FIXSEN: PUSH P,B ; SAVE TIME + MOVEI B,[ASCIZ /TIME= /] + PUSHJ P,MSGTYP ; PRINT OUT MESSAGE + POP P,B ; RESTORE B + FMPRI B,(100.0) ; CONVERT TO FIX + MULI B,400 + TSC B,B + ASH C,-163.(B) + MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME + PUSH P,C + IDIVI C,10. ; START COUNTING + JUMPLE C,.+2 + AOJA A,.-2 + POP P,C + CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER + JRST DOT1 +FIXOUT: IDIVI C,10. ; RECOVER NUMBER + HRLM D,(P) + SKIPE C + PUSHJ P,FIXOUT + PUSH P,A ; SAVE A + CAIN A,2 ; DECIMAL POINT HERE? + JRST DOT2 +FIX1: HLRZ A,(P)-1 ; GET NUMBER + ADDI A,60 ; MAKE IT A CHARACTER + PUSHJ P,IMTYO ; OUT IT GOES + POP P,A + SOJ A, + POPJ P, +DOT1: MOVEI A,". ; OUTPUT DECIMAL POINT AND PADDING 0 + PUSHJ P,IMTYO + MOVEI A,"0 + PUSHJ P,IMTYO + JRST FIXOUT ; CONTINUE +DOT2: MOVEI A,". ; OUTPUT DECIMAL POINT + PUSHJ P,IMTYO + JRST FIX1 + + + ; SUBROUTINE TO CHECK SIZE OF PDLS AND DO FENCEPOSTING + +PDLCHK: JUMPGE A,CPOPJ + HLRE B,A ;GET NEGATIVE COUNT + MOVE C,A ;SAVE A COPY OF PDL POINTER + SUBI A,-1(B) ;LOCATE DOPE WORD PAIR + HRRZS A ; ISOLATE POINTER + CAME A,TPGROW ;GROWING? + ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD + MOVMS B + CAIN A,2(C) + JRST NOFENC + SETOM 1(C) ; START FENECE POST + CAIN A,3(C) + JRST NOFENC + MOVSI D,1(C) ;YES, SET UP TO BLT FENCE POSTS + HRRI D,2(C) + BLT D,-2(A) ;FENCE POST ALL EXCEPT DOPE WORDS + + +NOFENC: CAMG B,TPMAX ;NOW CHECK SIZE + CAMG B,TPMIN + JRST MUNGTP ;TOO BIG OR TOO SMALL + POPJ P, + +MUNGTP: SUB B,TPGOOD ;FIND DELTA TP +MUNG3: MOVE C,-1(A) ;IS GROWTH ALREADY SPECIFIED + TRNE C,777000 ;SKIP IF NOT + POPJ P, ;ASSUME GROWTH GIVEN WILL WIN + + ASH B,-6 ;CONVERT TO NUMBER OF BLOCKS + JUMPLE B,MUNGT1 + CAILE B,377 ; SKIP IF BELOW MAX + MOVEI B,377 ; ELSE USE MAX + TRO B,400 ;TURN ON SHRINK BIT + JRST MUNGT2 +MUNGT1: MOVMS B + ANDI B,377 +MUNGT2: DPB B,[111100,,-1(A)] ;STORE IN DOPE WORD + POPJ P, + +; CHECK UNMARKED STACK (NO NEED TO FENCE POST) + +PDLCHP: HLRE B,A ;-LENGTH TO B + MOVE C,A + SUBI A,-1(B) ;POINT TO DOPE WORD + HRRZS A ;ISOLATE POINTER + CAME A,PGROW ;GROWING? + ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD + MOVMS B + CAIN A,2(C) + JRST NOPF + SETOM 1(C) ; START FENECE POST + CAIN A,3(C) + JRST NOPF + MOVSI D,1(C) + HRRI D,2(C) + BLT D,-2(A) + +NOPF: CAMG B,PMAX ;TOO BIG? + CAMG B,PMIN ;OR TOO LITTLE + JRST .+2 ;YES, MUNG IT + POPJ P, + SUB B,PGOOD + JRST MUNG3 + + +; ROUTINE TO PRE MARK SPECIAL HACKS + +PRMRK: SKIPE GCHAIR ; FLUSH IF NO HAIR + POPJ P, +PRMRK2: HLRE B,A + SUBI A,(B) ;POINT TO DOPE WORD + HLRZ F,1(A) ; GET LNTH + LDB 0,[111100,,(A)] ; GET GROWTHS + TRZE 0,400 ; SIGN HACK + MOVNS 0 + ASH 0,6 ; TO WORDS + ADD F,0 + LDB 0,[001100,,(A)] + TRZE 0,400 + MOVNS 0 + ASH 0,6 + ADD F,0 + PUSHJ P,ALLOGC + HRRM 0,1(A) ; NEW RELOCATION FIELD + IORM D,1(A) ;AND MARK + POPJ P, + + + ;GENERAL MARK SUBROUTINE. CALLED TO MARK ALL THINGS +; A/ GOODIE TO MARK FROM +; B/ TYPE OF A (IN RH) +; C/ TYPE,DATUM PAIR POINTER + +MARK2A: +MARK2: HLRZ B,(C) ;GET TYPE +MARK1: MOVE A,1(C) ;GET GOODIE +MARK: SKIPN DUMFLG + JUMPE A,CPOPJ ; NEVER MARK 0 + MOVEI 0,1(A) + CAIL 0,@PURBOT + JRST GCRETD +MARCON: PUSH P,A + HRLM C,-1(P) ;AND POINTER TO IT + ANDI B,TYPMSK ; FLUSH MONITORS + SKIPE DUMFLG ; SKIP IF NOT IN DUMPER + PUSHJ P,TYPHK ; HACK SOME TYPES + LSH B,1 ;TIMES 2 TO GET SAT + HRRZ B,@TYPNT ;GET SAT + ANDI B,SATMSK + JUMPE A,GCRET + CAILE B,NUMSAT ; SKIP IF TEMPLATE DATA + JRST TD.MRK + SKIPN GCDFLG +IFN ITS,[ + JRST @MKTBS(B) ;AND GO MARK + JRST @GCDISP(B) ; DISPATCH FOR DUMPERS +] +IFE ITS,[ + SKIPA E,MKTBS(B) + MOVE E,GCDISP(B) + HRLI E,-1 + JRST (E) +] +; HERE TO MARK A POSSIBLE DEFER POINTER + +DEFQMK: GETYP B,(A) ; GET ITS TYPE + LSH B,1 + HRRZ B,@TYPNT + ANDI B,SATMSK ; AND TO SAT + SKIPGE MKTBS(B) + +;HERE TO MARK THAT WHICH IS POINTED TO BY A DEFERRED POINTER + +DEFMK: TLOA TYPNT,400000 ;USE SIGN BIT AS FLAG + +;HERE TO MARK LIST ELEMENTS + +PAIRMK: TLZ TYPNT,400000 ;TURN OF DEFER BIT + PUSH P,[0] ; WILL HOLD BACK PNTR + MOVEI C,(A) ; POINT TO LIST +PAIRM1: CAMGE C,PARTOP ;CHECK FOR BEING IN BOUNDS + CAMGE C,PARBOT + FATAL AGC--MARKED PAIR OUTSIDE PAIR SPACE + SKIPGE B,(C) ;SKIP IF NOT MARKED + JRST RETNEW ;ALREADY MARKED, RETURN + IORM D,(C) ;MARK IT + SKIPL FPTR ; SEE IF IN FRONTEIR + PUSHJ P,MOVFNT ; EXPAND THE FRONTEIR + MOVEM B,FRONT(FPTR) + MOVE 0,1(C) ; AND 2D + AOBJN FPTR,.+2 ; AOS AND CHECK FRONTEIR + PUSHJ P,MOVFNT ; EXPAND FRONTEIR + MOVEM 0,FRONT(FPTR) + ADD FPTR,[1,,1] ; MOVE ALONG IN FRONTIER + + +PAIRM2: MOVEI A,@BOTNEW ; GET INF ADDR + SUBI A,2 + HRRM A,(C) ; LEAVE A POINTER TO NEW HOME + HRRZ E,(P) ; GET BACK POINTER + JUMPE E,PAIRM7 ; 1ST ONE, NEW FIXUP + MOVSI 0,(HRRM) ; INS FOR CLOBBER + PUSHJ P,SMINF ; SMASH INF'S CORE IMAGE +PAIRM4: MOVEM A,(P) ; NEW BACK POINTER + JUMPL TYPNT,DEFDO ;GO HANDLE DEFERRED POINTER + HRLM B,(P) ; SAVE OLD CDR + PUSHJ P,MARK2 ;MARK THIS DATUM + HRRZ E,(P) ; SMASH CAR IN CASE CHANGED + ADDI E,1 + MOVSI 0,(MOVEM) + PUSHJ P,SMINF + HLRZ C,(P) ;GET CDR OF LIST + CAIGE C,@PURBOT ; SKIP IF PURE (I.E. DONT MARK) + JUMPN C,PAIRM1 ;IF NOT NIL, MARK IT +GCRETP: SUB P,[1,,1] + +GCRET: TLZ TYPNT,400000 ;FOR PAIRMKS BENEFIT + HLRZ C,-1(P) ;RESTORE C + POP P,A + POPJ P, ;AND RETURN TO CALLER + +GCRETD: ANDI B,TYPMSK ; TURN OFF MONITORS + CAIN B,TLOCR ; SEE IF A LOCR + JRST MARCON + SKIPN GCDFLG ; SKIP IF IN PURIFIER OR DUMPER + POPJ P, + CAIE B,TATOM ; WE MARK PURE ATOMS + CAIN B,TCHSTR ; AND STRINGS + JRST MARCON + POPJ P, + +;HERE TO MARK DEFERRED POINTER + +DEFDO: PUSH P,B ; PUSH OLD PAIR ON STACK + PUSH P,1(C) + MOVEI C,-1(P) ; USE AS NEW DATUM + PUSHJ P,MARK2 ;MARK THE DATUM + HRRZ E,-2(P) ; GET POINTER IN INF CORE + ADDI E,1 + MOVSI 0,(MOVEM) + PUSHJ P,SMINF ; AND CLOBBER + HRRZ E,-2(P) + MOVE A,-1(P) + MOVSI 0,(HRRM) ; SMASH IN RIGHT HALF + PUSHJ P,SMINF + SUB P,[3,,3] + JRST GCRET ;AND RETURN + + +PAIRM7: MOVEM A,-1(P) ; SAVE NEW VAL FOR RETURN + JRST PAIRM4 + +RETNEW: HRRZ A,(C) ; POINT TO NEW WORLD LOCN + HRRZ E,(P) ; BACK POINTER + JUMPE E,RETNW1 ; NONE + MOVSI 0,(HRRM) + PUSHJ P,SMINF + JRST GCRETP + +RETNW1: MOVEM A,-1(P) + JRST GCRETP + +; ROUTINE TO EXPAND THE FRONTEIR + +MOVFNT: PUSH P,B ; SAVE REG B + HRRZ A,BOTNEW ; CURRENT BOTTOM OF WINDOW + ADDI A,2000 ; MOVE IT UP + HRRM A,BOTNEW + HRRZM A,FNTBOT ; BOTTOM OF FRONTEIR + MOVEI B,FRNP + ASH A,-10. ; TO PAGES + PUSHJ P,%GETIP + PUSHJ P,%SHWND ; SHARE THE PAGE + MOVSI FPTR,-2000 ; FIX UP FPTR + POP P,B + POPJ P, + + +; ROUTINE TO SMASH INFERIORS PPAGES +; E/ ADDR IN INF, A/ THING TO SMASH ,0/ INS TO USE + +SMINF: CAMGE E,FNTBOT + JRST SMINF1 ; NOT IN FRONTEIR + SUB E,FNTBOT ; ADJUST POINTER + IOR 0,[0 A,FRONT(E)] ; BUILD INSTRUCTION + XCT 0 ; XCT IT + POPJ P, ; EXIT +SMINF1: CAML E,WNDBOT + CAML E,WNDTOP ; SEE IF IN WINDOW + JRST SMINF2 +SMINF3: SUB E,WNDBOT ; FIX UP + IOR 0,[0 A,WIND(E)] ; FIX INS + XCT 0 + POPJ P, +SMINF2: PUSH P,A ; SAVE E + PUSH P,B ; SAVE B + HRRZ A,E ; E SOMETIMES HAS STUFF IN LH + ASH A,-10. + MOVEI B,WNDP ; WINDOW PAGE + PUSHJ P,%SHWND ; SHARE IT + ASH A,10. ; TO PAGES + MOVEM A,WNDBOT ; UPDATE POINTERS + ADDI A,2000 + MOVEM A,WNDTOP + POP P,B ; RESTORE ACS + POP P,A + JRST SMINF3 ; FIX UP INF + + + + ; VECTOR AND TP MARKER, SIGN OF TYPNT IS SET BASED ON WHICH ONE + +TPMK: TLOA TYPNT,400000 ;SET TP MARK FLAG +VECTMK: TLZ TYPNT,400000 + MOVEI 0,@BOTNEW ; POINTER TO INF + PUSH P,0 + MOVEI E,(A) ;SAVE A POINTER TO THE VECTOR + HLRE B,A ;GET -LNTH + SUB A,B ;LOCATE DOPE WORD + MOVEI A,1(A) ;ZERO LH AND POINT TO 2ND DOPE WORD + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST VECTB1 ;LOSE, COMPLAIN + + HLLM TYPNT,(P) ; SAVE MARKER INDICATING STACK + JUMPGE TYPNT,NOBUFR ;IF A VECTOR, NO BUFFER CHECK + CAME A,PGROW ;IS THIS THE BLOWN P + CAMN A,TPGROW ;IS THIS THE GROWING PDL + JRST NOBUFR ;YES, DONT ADD BUFFER + ADDI A,PDLBUF ;POINT TO REAL DOPE WORD + MOVSI 0,-PDLBUF ;ALSO FIX UP POINTER + ADD 0,1(C) + MOVEM 0,-1(P) ; FIXUP RET'D PNTR + +NOBUFR: HLRE B,(A) ;GET LENGTH FROM DOPE WORD + JUMPL B,EXVECT ; MARKED, LEAVE + LDB B,[111100,,-1(A)] ; GET TOP GROWTH + TRZE B,400 ; HACK SIGN BIT + MOVNS B + ASH B,6 ; CONVERT TO WORDS + PUSH P,B ; SAVE TOP GROWTH + LDB 0,[001100,,-1(A)] ;GET GROWTH FACTOR + TRZE 0,400 ;KILL SIGN BIT AND SKIP IF + + MOVNS 0 ;NEGATE + ASH 0,6 ;CONVERT TO NUMBER OF WORDS + PUSH P,0 ; SAVE BOTTOM GROWTH + ADD B,0 ;TOTAL GROWTH TO B +VECOK: HLRE E,(A) ;GET LENGTH AND MARKING + MOVEI F,(E) ;SAVE A COPY + ADD F,B ;ADD GROWTH + SUBI E,2 ;- DOPE WORD LENGTH + IORM D,(A) ;MAKE SURE NOW MARKED + PUSHJ P,ALLOGC ; ALLOCATE SPACE FOR VECTOR IN THE INF + HRRM 0,(A) +VECOK1: JUMPLE E,MOVEC2 ; ZERO LENGTH, LEAVE + PUSH P,A ; SAVE POINTER TO DOPE WORD + SKIPGE B,-1(A) ;SKIP IF UNIFORM + TLNE B,377777-.VECT. ;SKIP IF NOT SPECIAL + JUMPGE TYPNT,NOTGEN ;JUMP IF NOT A GENERAL VECTOR + +GENRAL: HLRZ 0,B ;CHECK FOR PSTACK + TRZ 0,.VECT. + JUMPE 0,NOTGEN ;IT ISN'T GENERAL + JUMPL TYPNT,TPMK1 ; JUMP IF TP + MOVEI C,(A) + SUBI C,1(E) ; C POINTS TO BEGINNING OF VECTOR + + ; LOOP TO MARK ELEMENTS IN A GENERAL VECTOR +VECTM2: HLRE B,(C) ;GET TYPE AND MARKING + JUMPL B,UMOVEC ;RETURN, (EITHER DOPE WORD OR FENCE POST) + MOVE A,1(C) ;DATUM TO A + + +VECTM3: PUSHJ P,MARK ;MARK DATUM + MOVEM A,1(C) ; IN CASE WAS FIXED +VECTM4: ADDI C,2 + JRST VECTM2 + +UMOVEC: POP P,A +MOVEC2: POP P,C ; RESTORE BOTTOM GROWTH + HRRZ E,-1(P) ; GET POINTER INTO INF + SKIPN C ; SKIP IF NO BOTTOM GROWTH + JRST MOVEC3 + JUMPL C,.+3 ; SEE IF BOTTOM SHRINKAGE + ADD E,C ; GROW IT + JRST MOVEC3 ; CONTINUE + HRLM C,E ; MOVE SHRINKAGE FOR TRANSFER PHASE +MOVEC3: PUSHJ P,DOPMOD ; MODIFY DOPE WORD AND PLACE IN INF + PUSHJ P,TRBLKV ; SEND VECTOR INTO INF +TGROT: CAMGE A,PARBOT ; SKIP IF NOT STORAGE + JRST TGROT1 + MOVE C,DOPSV1 ; RESTORE DOPE WORD + SKIPN (P) ; DON'T RESTORE D.W.'S YET IF THERE IS GROWTH + MOVEM C,-1(A) +TGROT1: POP P,C ; IS THERE TOP GROWH + SKIPN C ; SEE IF ANY GROWTH + JRST DOPEAD + SUBI E,2 + SKIPG C + JRST OUTDOP + PUSH P,C ; SAVE C + SETZ C, ; ZERO C + PUSHJ P,ADWD + ADDI E,1 + SETZ C, ; ZERO WHERE OLD DOPE WORDS WERE + PUSHJ P,ADWD + POP P,C + ADDI E,-1(C) ; MAKE ADJUSTMENT FOR TOP GROWTH +OUTDOP: PUSHJ P,DOPOUT +DOPEAD: +EXVECT: HLRZ B,(P) + SUB P,[1,,1] ; GET RID OF FPTR + PUSHJ P,RELATE ; RELATIVIZE + TRNN B,400000 ; WAS THIS A STACK + JRST GCRET + MOVSI 0,PDLBUF ; FIX UP STACK PTR + ADDM 0,(P) + JRST GCRET ; EXIT + +VECLOS: JUMPL C,CCRET ;JUMP IF CAN'T MUNG TYPE + HLLZ 0,(C) ;GET TYPE + MOVEI B,TILLEG ;GET ILLEGAL TYPE + HRLM B,(C) + MOVEM 0,1(C) ;AND STORE OLD TYPE AS VALUE + JRST UMOVEC ;RETURN WITHOUT MARKING VECTOR + +CCRET: CLEARM 1(C) ;CLOBBER THE DATUM + JRST GCRET + + +; ROUTINE TO MARK A TP. IT SCANS THE TP. IT MARKS ALL THE ITEMS AND IT MAPS AN +; UPDATED VERSION INTO THE INFERIOR WITHOUT CHANGING THE ORIGINAL. + +TPMK1: +TPMK2: POP P,A + POP P,C + HRRZ E,-1(P) ; FIX UP PARAMS + ADDI E,(C) + PUSH P,A ; REPUSH A + HRRZ B,(A) ; CALCULATE RELOCATION + SUB B,A + MOVE C,-1(P) ; ADJUST FOR GROWTH + SUB B,C + HRLZS C + PUSH P,C + PUSH P,B + PUSH P,E + PUSH P,[0] +TPMK3: HLRZ E,(A) ; GET LENGTH + TRZ E,400000 ; GET RID OF MARK BIT + SUBI A,-1(E) ;POINT TO FIRST ELEMENT + MOVEI C,(A) ;POINT TO FIRST ELEMENT WITH C +TPMK4: HLRE B,(C) ;GET TYPE AND MARKING + JUMPL B,TPMK7 ;RETURN, (EITHER DOPE WORD OR FENCE POST) + HRRZ A,(C) ;DATUM TO A + ANDI B,TYPMSK ; FLUSH MONITORS + CAIE B,TCBLK + CAIN B,TENTRY ;IS THIS A STACK FRAME + JRST MFRAME ;YES, MARK IT + CAIE B,TUBIND ; BIND + CAIN B,TBIND ;OR A BINDING BLOCK + JRST MBIND + CAIE B,TBVL ; CHECK FOR OTHER BINDING HACKS + CAIN B,TUNWIN + SKIPA ; FIX UP SP-CHAIN + CAIN B,TSKIP ; OTHER BINDING HACK + PUSHJ P,FIXBND + + +TPMK5: PUSH P,(C) ; SAVE BECAUSE FRAMES MIGHT MUNG IT + HRRM A,(C) ; FIX UP IN CASE OF SP CHAIN + PUSHJ P,MARK1 ;MARK DATUM + MOVE R,A ; SAVE A + POP P,M + MOVE A,(C) + PUSHJ P,OUTTP ; MOVE OUT TYPE + MOVE A,R + PUSHJ P,OUTTP ; SEND OUT VALUE + MOVEM M,(C) ; RESTORE TO OLD VALUE +TPMK6: ADDI C,2 + JRST TPMK4 + +MFRAME: HRRZ 0,1(C) ; SET UP RELITIVIZATION OF PTR TO PREVIOUS FRAME + HRROI C,FRAMLN+FSAV-1(C) ;POINT TO FUNCTION + HRRZ A,1(C) ; GET IT + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST MFRAM1 ; IGNORE, NOT IN VECTOR SPACE + HRL A,(A) ; GET LENGTH + MOVEI B,TVEC + PUSHJ P,MARK ; AND MARK IT +MFRAM1: HLL A,1(C) + PUSHJ P,OUTTP ; SEND IT OUT + HRRZ A,OTBSAV-FSAV+1(C) ; POINT TO TB TO PREVIOUS FRAME + SKIPE A + ADD A,-2(P) ; RELOCATE IF NOT 0 + HLL A,2(C) + PUSHJ P,OUTTP ; SEND IT OUT + MOVE A,-2(P) ; ADJUST AB SLOT + ADD A,ABSAV-FSAV+1(C) ; POINT TO SAVED AB + PUSHJ P,OUTTP ; SEND IT OUT + MOVE A,-2(P) ; ADJUST SP SLOT + ADD A,SPSAV-FSAV+1(C) ;POINT TO SAVED SP + SUB A,-3(P) ; ADJUSTMENT OF LENGTH IF GROWTH + PUSHJ P,OUTTP ; SEND IT OUT + HRROI C,PSAV-FSAV(C) ;POINT TO SAVED P + MOVEI B,TPDL + PUSHJ P,MARK1 ;AND MARK IT + PUSHJ P,OUTTP ; SEND IT OUT + HLRE 0,TPSAV-PSAV+1(C) + MOVE A,TPSAV-PSAV+1(C) + SUB A,0 + MOVEI 0,1(A) + MOVE A,TPSAV-PSAV+1(C) + CAME 0,TPGROW ; SEE IF BLOWN + JRST MFRAM9 + MOVSI 0,PDLBUF + ADD A,0 +MFRAM9: ADD A,-2(P) + SUB A,-3(P) ; ADJUST + PUSHJ P,OUTTP + MOVE A,PCSAV-PSAV+1(C) + PUSHJ P,OUTTP + HRROI C,-PSAV+1(C) ; POINT PAST THE FRAME + JRST TPMK4 ;AND DO MORE MARKING + + +MBIND: PUSHJ P,FIXBND + MOVEI B,TATOM ;FIRST MARK ATOM + SKIPN GCHAIR ; IF NO HAIR, MARK ALL NOW + SKIPE (P) ; PASSED MARKER, IF SO DONT SKIP + JRST MBIND2 ; GO MARK + MOVE A,1(C) ; RESTORE A + CAME A,GCATM + JRST MBIND1 ; NOT IT, CONTINUE SKIPPING + HRRM LPVP,2(C) ; SAVE IN RH OF TPVP,,0 + MOVE 0,-4(P) ; RECOVER PTR TO DOPE WORD + HRLM 0,2(C) ; SAVE FOR MOVEMENT + MOVEI B,TATOM ; MARK THE BINDING TO THIS PROCESS + PUSHJ P,MARK1 ; MARK THE ATOM + MOVEI LPVP,(C) ; POINT + SETOM (P) ; INDICATE PASSAGE +MBIND1: ADDI C,6 ; SKIP BINDING + MOVEI 0,6 + SKIPE -1(P) ; ONLY UPDATE IF SENDING OVER + ADDM 0,-1(P) + JRST TPMK4 + +MBIND2: HLL A,(C) + PUSHJ P,OUTTP ; FIX UP CHAIN + MOVEI B,TATOM ; RESTORE IN CASE SMASHED + PUSHJ P,MARK1 ; MARK ATOM + PUSHJ P,OUTTP ; SEND IT OUT + ADDI C,2 + PUSH P,(C) ; SAVE BECAUSE FRAMES MIGHT MUNG IT + PUSHJ P,MARK2 ;MARK DATUM + MOVE R,A ; SAVE A + POP P,M + MOVE A,(C) + PUSHJ P,OUTTP ; MOVE OUT TYPE + MOVE A,R + PUSHJ P,OUTTP ; SEND OUT VALUE + MOVEM M,(C) ; RESTORE TO OLD VALUE + ADDI C,2 + MOVEI B,TLIST ; POINT TO DECL SPECS + HLRZ A,(C) + PUSHJ P,MARK ; AND MARK IT + HRR A,(C) ; LIST FIX UP + PUSHJ P,OUTTP + SKIPL A,1(C) ; PREV LOC? + JRST NOTLCI + MOVEI B,TLOCI ; NOW MARK LOCATIVE + PUSHJ P,MARK1 +NOTLCI: PUSHJ P,OUTTP + ADDI C,2 + JRST TPMK4 + +FIXBND: HRRZ A,(C) ; GET PTR TO CHAIN + SKIPE A ; DO NOTHING IF EMPTY + ADD A,-3(P) + POPJ P, +TPMK7: +TPMK8: MOVNI A,1 ; FENCE-POST THE STACK + PUSHJ P,OUTTP + ADDI C,1 ; INCREMENT C FOR FENCE-POST + SUB P,[1,,1] ; CLEAN UP STACK + POP P,E ; GET UPDATED PTR TO INF + SUB P,[2,,2] ; POP OFF RELOCATION + HRRZ A,(P) + HLRZ B,(A) + TRZ B,400000 + SUBI A,-1(B) + SUBI C,(A) ; GET # OF WORDS TRANSFERED + SUB B,C ; GET # LEFT + ADDI E,-2(B) ; ADJUST POINTER TO INF + POP P,A + POP P,C ; IS THERE TOP GROWH + ADD E,C ; MAKE ADJUSTMENT FOR TOP GROWTH + ANDI E,-1 + PUSHJ P,DOPMOD ; FIX UP DOPE WORDS + PUSHJ P,DOPOUT ; SEND THEM OUT + JRST DOPEAD + + + ; ROUTINE TO ALLOCATE ROOM FOR VECTORS IN INFERIOR +; F= # OF WORDS TO ALLOCATE + +ALLOGC: HRRZS A ; GET ABS VALUE + SKIPN GCDFLG ; SKIP IF IN DUMPER + CAML A,GCSBOT ; SKIP IF IN STORAGE + JRST ALOGC2 ; JUMP IF ALLOCATING + HRRZ 0,A + POPJ P, +ALOGC2: PUSH P,A ; SAVE A +ALOGC1: HLRE 0,FPTR ; GET ROOM LEFT + ADD 0,F ; SEE IF ITS ENOUGH + JUMPL 0,ALOCOK + MOVE F,0 ; MODIFY F + PUSH P,F + PUSHJ P,MOVFNT ; MOVE UP FRONTEIR + POP P,F + JRST ALOGC1 ; CONTINUE +ALOCOK: ADD FPTR,F ; MODIFY FPTR + HRLZS F + ADD FPTR,F + POP P,A ; RESTORE A + MOVEI 0,@BOTNEW + SUBI 0,1 ; RELOCATION PTR + POPJ P, ; EXIT + + + + +; TRBLK MOVES A VECTOR INTO THE INFERIOR +; E= STARTING ADDR IN INF A= DOPE WORD OF VECTOR + +TRBLK: HRRZS A + SKIPE GCDFLG + JRST TRBLK7 + CAMGE A,GCSBOT ; SEE IF IN GC-SPACE + JRST FIXDOP +TRBLK7: PUSH P,A + HLRZ 0,(A) + TRZ 0,400000 ; TURN OFF GC FLAG + HRRZ F,A + HLRE A,E ; GET SHRINKAGE + ADD 0,A ; MUNG LENGTH + SUB F,0 + ADDI F,1 ; F POINTS TO START OF VECTOR +TRBLK2: HRRZ R,E ; SAVE POINTER TO INFERIOR + ADD E,0 ; E NOW POINTS TO FINAL ADDRESS+1 + MOVE M,E ;SAVE E +TRBLK1: MOVE 0,R + SUBI E,1 + CAMGE R,FNTBOT ; SEE IF IN FRONTEIR + JRST TRBL10 + SUB E,FNTBOT ; ADJUST E + SUB 0,FNTBOT ; ADJ START + MOVEI A,FRONT+1777 + JRST TRBLK4 +TRBL10: CAML R,WNDBOT + CAML R,WNDTOP ; SEE IF IN WINDOW + JRST TRBLK5 ; NO + SUB E,WNDBOT + SUB 0,WNDBOT + MOVEI A,WIND+1777 +TRBLK4: ADDI 0,-1777(A) ; CALCULATE START IN WINDOW OR FRONTEIR + CAIL E,2000 + JRST TRNSWD + ADDI E,-1777(A) ; SUBTRACT WINDBOT + HRL 0,F ; SET UP FOR BLT + BLT 0,(E) + POP P,A + +FIXDOP: IORM D,(A) + MOVE E,M ; GET END OF WORD + POPJ P, +TRNSWD: PUSH P,B + MOVEI B,1(A) ; GET TOP OF WORLD + SUB B,0 + HRL 0,F + BLT 0,(A) + ADD F,B ; ADJUST F + ADD R,B + POP P,B + MOVE E,M ; RESTORE E + JRST TRBLK1 ; CONTINUE +TRBLK5: HRRZ A,R ; COPY E + ASH A,-10. ; TO PAGES + PUSH P,B ; SAVE B + MOVEI B,WNDP ; IT IS WINDOW + PUSHJ P,%SHWND + ASH A,10. ; TO PAGES + MOVEM A,WNDBOT ; UPDATE POINTERS + ADDI A,2000 + MOVEM A,WNDTOP + POP P,B ; RESTORE B + JRST TRBL10 + + + + +; ALTERNATE ENTRY FOR VECTORS WHICH TAKES CARE OF SHRINKAGE + +TRBLKV: HRRZS A + SKIPE GCDFLG ; SKIP IF NOT IN DUMPER + JRST TRBLV2 + CAMGE A,GCSBOT ; SEE IF IN GC-SPACE + JRST FIXDOP +TRBLV2: PUSH P,A ; SAVE A + HLRZ 0,DOPSV2 + TRZ 0,400000 + HRRZ F,A + HLRE A,E ; GET SHRINKAGE + ADD 0,A ; MUNG LENGTH + SUB F,0 + ADDI F,1 ; F POINTS TO START OF VECTOR + SKIPGE -2(P) ; SEE IF SHRINKAGE + ADD 0,-2(P) ; IF SO COMPENSATE + JRST TRBLK2 ; CONTINUE + +; ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT TO SEND IN 0= # OF WORDS + +TRBLK3: PUSH P,A ; SAVE A + MOVE F,A + JRST TRBLK2 + +; FINAL ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT +; F==> START OF TRANSFER IN GCS 0= # OF WORDS + +TRBLKX: PUSH P,A ; SAVE A + JRST TRBLK2 ; SEND IT OUT + + +; OUTTP IS THE ROUTINE THAT TPMK USES TO SEND OUT ELEMENTS FOR THE SCAN +; -2(P) CONTAINS THE ADDR IN THE INF AND IT IS UPDATED +; A CONTAINS THE WORD TO BE SENT OUT + +OUTTP: AOS E,-2(P) ; INCREMENT PLACE + MOVSI 0,(MOVEM) ; INS FOR SMINF + SOJA E,SMINF + + +; ADWD PLACES ONE WORD IN THE INF +; E ==> INF C IS THE WORD + +ADWD: PUSH P,E ; SAVE AC'S + PUSH P,A + MOVE A,C ; GET WORD + MOVSI 0,(MOVEM) ; INS FOR SMINF + PUSHJ P,SMINF ; SMASH IT IN + POP P,A + POP P,E + POPJ P, ; EXIT + +; DOPOUT IS USED TO SEND OUT THE DOPE WORDS IN UNUSUAL CALSE +; SUCH AS THE TP AND GROWTH + + +DOPOUT: MOVE C,-1(A) + PUSHJ P,ADWD + ADDI E,1 + MOVE C,(A) ; GET SECOND DOPE WORD + TLZ C,400000 ; TURN OFF POSSIBLE MARK BIT + PUSHJ P,ADWD + MOVE C,DOPSV1 ; FIX UP FIRST DOPE WORD + MOVEM C,-1(A) + MOVE C,DOPSV2 + MOVEM C,(A) ; RESTORE SECOND D.W. + POPJ P, + +; DOPMOD MODIFIES THE DOPE WORD OF A VECTOR AND PLACES A NEW DOPE-WORD IN INF +; A ==> DOPE WORD E==> INF + +DOPMOD: SKIPE GCDFLG ; CHECK TO SEE IF IN DUMPER AND PURIFY + JRST .+3 + CAMG A,GCSBOT + POPJ P, ; EXIT IF NOT IN GCS + MOVE C,-1(A) ; GET FIRST DOPE WORD + MOVEM C,DOPSV1 + HLLZS C ; CLEAR OUT GROWTH + TLO C,.VECT. ; FIX UP FOR GCHACK + PUSH P,C + MOVE C,(A) ; GET SECOND DOPE WORD + HLRZ B,(A) ; GET LENGTH + TRZ B,400000 ; TURN OFF MARK BIT + MOVEM C,DOPSV2 + HRRZ 0,-1(A) ; CHECK FOR GROWTH + JUMPE 0,DOPMD1 + LDB 0,[111100,,-1(A)] ; MODIFY WITH GROWTH + TRZE 0,400 + MOVNS 0 + ASH 0,6 + ADD B,0 + LDB 0,[001100,,-1(A)] + TRZE 0,400 + MOVNS 0 + ASH 0,6 + ADD B,0 +DOPMD1: HRL C,B ; FIX IT UP + MOVEM C,(A) ; FIX IT UP + POP P,-1(A) + POPJ P, + +ADPMOD: CAMG A,GCSBOT + POPJ P, ; EXIT IF NOT IN GCS + MOVE C,-1(A) ; GET FIRST DOPE WORD + TLO C,.VECT. ; FIX UP FOR GCHACK + MOVEM C,-1(A) + MOVE C,(A) ; GET SECOND DOPE WORD + TLZ C,400000 ; TURN OFF PARK BIT + MOVEM C,(A) + POPJ P, + + + + + ; RELATE RELATAVIZES A POINTER TO A VECTOR +; B IS THE POINTER A==> DOPE WORD + +RELATE: SKIPE GCDFLG ; SEE IF DUMPER OR PURIFIER + JRST .+3 + CAMGE A,GCSBOT ; SEE IF IN VECTOR SPACE + POPJ P, ; IF NOT EXIT + MOVE C,-1(P) + HLRE F,C ; GET LENGTH + HRRZ 0,-1(A) ; CHECK FO GROWTH + JUMPE A,RELAT1 + LDB 0,[111100,,-1(A)] ; GET TOP GROWTH + TRZE 0,400 ; HACK SIGN BIT + MOVNS 0 + ASH 0,6 ; CONVERT TO WORDS + SUB F,0 ; ACCOUNT FOR GROWTH +RELAT1: HRLM F,C ; PLACE CORRECTED LENGTH BACK IN POINTER + HRRZ F,(A) ; GET RELOCATED ADDR + SUBI F,(A) ; FIND RELATIVIZATION AMOUNT + ADD C,F ; ADJUST POINTER + SUB C,0 ; ACCOUNT FOR GROWTH + MOVEM C,-1(P) + POPJ P, + + + + ; MARK TB POINTERS +TBMK: HRRZS A ; CHECK FOR NIL POINTER + SKIPN A + JRST GCRET ; IF POINTING TO NIL THEN RETURN + HLRE B,TPSAV(A) ; MAKE POINTER LOOK LIKE A TP POINTER + HRRZ C,TPSAV(A) ; GET TO DOPE WORD +TBMK2: SUB C,B ; POINT TO FIRST DOPE WORD + HRRZ A,(P) ; GET PTR TO FRAME + SUB A,C ; GET PTR TO FRAME + HRLS A + HRR A,(P) + PUSH P,A + MOVEI C,-1(P) + MOVEI B,TTP + PUSHJ P,MARK + SUB P,[1,,1] + HRRM A,(P) + JRST GCRET +ABMK: HLRE B,A ; FIX UP TO GET TO FRAME + SUB A,B + HLRE B,FRAMLN+TPSAV(A) ; FIX UP TO LOOK LIKE TP + HRRZ C,FRAMLN+TPSAV(A) + JRST TBMK2 + + + +; MARK ARG POINTERS + +ARGMK: HRRZ A,1(C) ; GET POINTER + HLRE B,1(C) ; AND LNTH + SUB A,B ; POINT TO BASE + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST ARGMK0 + HLRZ 0,(A) ; GET TYPE + ANDI 0,TYPMSK + CAIN 0,TCBLK + JRST ARGMK1 + CAIE 0,TENTRY ; IS NEXT A WINNER? + CAIN 0,TINFO + JRST ARGMK1 ; YES, GO ON TO WIN CODE + +ARGMK0: SETZB A,1(C) ; CLOBBER THE CELL + SETZM (P) ; AND SAVED COPY + JRST GCRET + +ARGMK1: MOVE B,1(A) ; ASSUME TTB + ADDI B,(A) ; POINT TO FRAME + CAIE 0,TINFO ; IS IT? + MOVEI B,FRAMLN(A) ; NO, USE OTHER GOODIE + HLRZ 0,OTBSAV(B) ; GET TIME + HRRZ A,(C) ; AND FROM POINTER + CAIE 0,(A) ; SKIP IF WINNER + JRST ARGMK0 + MOVE A,TPSAV(B) ; GET A RELATAVIZED TP + HRROI C,TPSAV-1(B) + MOVEI B,TTP + PUSHJ P,MARK1 + SUB A,1(C) ; AMOUNT TO RELATAVIZE ARGS + HRRZ B,(P) + ADD B,A + HRRM B,(P) ; PUT RELATAVIZED PTR BACK + JRST GCRET + + +; MARK FRAME POINTERS + +FRMK: HLRZ B,A ; GET TIME FROM FRAME PTR + HLRZ F,OTBSAV(A) ; GET TIME FROM FRAME + CAME B,F ; SEE IF EQUAL + JRST GCRET + SUBI C,1 ;PREPARE TO MARK PROCESS VECTOR + HRRZ A,1(C) ;USE AS DATUM + SUBI A,1 ;FUDGE FOR VECTMK + MOVEI B,TPVP ;IT IS A VECTRO + PUSHJ P,MARK ;MARK IT + ADDI A,1 ; READJUST PTR + HRRM A,1(C) ; FIX UP PROCESS SLOT + MOVEI C,1(C) ; SET UP FOR TBMK + HRRZ A,(P) + JRST TBMK ; MARK LIKE TB + + +; MARK BYTE POINTER + +BYTMK: PUSHJ P,BYTDOP ; GET DOPE WORD IN A + HLRZ F,-1(A) ; GET THE TYPE + ANDI F,SATMSK ; FLUSH MONITOR BITS + CAIN F,SATOM ; SEE IF ATOM + JRST ATMSET + HLRE F,(A) ; GET MARKING + JUMPL F,BYTREL ; JUMP IF MARKED + HLRZ F,(A) ; GET LENGTH + PUSHJ P,ALLOGC ; ALLOCATE FOR IT + HRRM 0,(A) ; SMASH IT IN + MOVE E,0 + HLRZ F,(A) + SUBI E,-1(F) ; ADJUST INF POINTER + IORM D,(A) + PUSHJ P,ADPMOD + PUSHJ P,TRBLK +BYTREL: HRRZ E,(A) + SUBI E,(A) + ADDM E,(P) ; RELATAVIZE + JRST GCRET + +ATMSET: PUSH P,A ; SAVE A + HLRZ B,(A) ; GET LENGTH + TRZ B,400000 ; GET RID OF MARK BIT + MOVNI B,-2(B) ; GET LENGTH + ADDI A,-1(B) ; CALCULATE POINTER + HRLI A,(B) + MOVEI B,TATOM ; TYPE + PUSHJ P,MARK + POP P,A ; RESTORE A + SKIPN DUMFLG + JRST BYTREL + HRRM A,(P) + MOVSI E,STATM ; GET "STRING IS ATOM BIT" + IORM E,(P) + JRST BYTREL ; TO BYTREL + + +; MARK OFFSET + +OFFSMK: HLRZS A + PUSH P,$TLIST + PUSH P,A ; PUSH LIST POINTER ON THE STACK + MOVEI C,-1(P) ; POINTER TO PAIR + PUSHJ P,MARK2 ; MARK THE LIST + HRLM A,-2(P) ; UPDATE POINTER IN OFFSET + SUB P,[2,,2] + JRST GCRET + + +; MARK ATOMS IN GVAL STACK + +GATOMK: HRRZ B,(C) ; POINT TO POSSIBLE GDECL + JUMPE B,ATOMK + CAIN B,-1 + JRST ATOMK + MOVEI A,(B) ; POINT TO DECL FOR MARK + MOVEI B,TLIST + MOVEI C,0 + PUSHJ P,MARK + HLRZ C,-1(P) ; RESTORE HOME POINTER + HRRM A,(C) ; CLOBBER UPDATED LIST IN + MOVE A,1(C) ; RESTORE ATOM POINTER + +; MARK ATOMS + +ATOMK: + MOVEI 0,@BOTNEW + PUSH P,0 ; SAVE POINTER TO INF + TLO TYPNT,.ATOM. ; SAY ATOM WAS MARKED + MOVEI C,1(A) + PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS + JRST ATMRL1 ; ALREADY MARKED + PUSH P,A ; SAVE DOPE WORD PTR FOR LATER + HLRZ C,(A) ; FIND REAL ATOM PNTR + SUBI C,400001 ; KILL MARK BIT AND ADJUST + HRLI C,-1(C) + SUBM A,C ; NOW TOP OF ATOM +MRKOBL: MOVEI B,TOBLS + HRRZ A,2(C) ; IF > 0, NOT OBL + CAMG A,VECBOT + JRST .+3 + HRLI A,-1 + PUSHJ P,MARK ; AND MARK IT + HRRM A,2(C) + SKIPN GCHAIR + JRST NOMKNX + HLRZ A,2(C) + MOVEI B,TATOM + PUSHJ P,MARK + HRLM A,2(C) +NOMKNX: HLRZ B,(C) ; SEE IF UNBOUND + TRZ B,400000 ; TURN OFF MARK BIT + SKIPE B + CAIN B,TUNBOUND + JRST ATOMK1 ; IT IS UNBOUND + HRRZ 0,(C) ; SEE IF VECTOR OR TP POINTER + MOVEI B,TVEC ; ASSUME VECTOR + SKIPE 0 + MOVEI B,TTP ; ITS A LOCAL VALUE + PUSHJ P,MARK1 ; MARK IT + MOVEM A,1(C) ; SMASH INTO SLOT +ATOMK1: HRRZ 0,2(C) ; MAKE SURE ATOMS NOT ON OBLISTS GET SENT + POP P,A ; RESTORE A + POP P,E ; GET POINTER INTO INF + SKIPN GCHAIR + JUMPN 0,ATMREL + PUSHJ P,ADPMOD + PUSHJ P,TRBLK +ATMREL: HRRZ E,(A) ; RELATAVIZE + SUBI E,(A) + ADDM E,(P) + JRST GCRET +ATMRL1: SUB P,[1,,1] ; POP OFF STACK + JRST ATMREL + + +GETLNT: HLRE B,A ;GET -LNTH + SUB A,B ;POINT TO 1ST DOPE WORD + MOVEI A,1(A) ;POINT TO 2ND DOPE WORD + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST VECTB1 ;BAD VECTOR, COMPLAIN + HLRE B,(A) ;GET LENGTH AND MARKING + IORM D,(A) ;MAKE SURE MARKED + JUMPL B,AMTKE + MOVEI F,(B) ; AMOUNT TO ALLOCATE + PUSHJ P,ALLOGC ;ALLOCATE ROOM + HRRM 0,(A) ; RELATIVIZE +AMTK1: AOS (P) ; A NON MARKED ITEM +AMTKE: POPJ P, ;AND RETURN + +GCRET1: SUB P,[1,,1] ;FLUSH RETURN ADDRESS + JRST GCRET + + + +; MARK NON-GENERAL VECTORS + +NOTGEN: CAMN B,[GENERAL+] + JRST GENRAL ;YES, MARK AS A VECTOR + JUMPL B,SPECLS ; COMPLAIN IF A SPECIAL HACK + SUBI A,1(E) ;POINT TO TOP OF A UNIFORM VECTOR + HLRZS B ;ISOLATE TYPE + ANDI B,TYPMSK + PUSH P,E + SKIPE DUMFLG ; SKIP IF NOT IN DUMPER + PUSHJ P,TYPHK ; HACK WITH TYPE IF SPECIAL + POP P,E ; RESTORE LENGTH + MOVE F,B ; AND COPY IT + LSH B,1 ;FIND OUT WHERE IT WILL GO + HRRZ B,@TYPNT ;GET SAT IN B + ANDI B,SATMSK + MOVEI C,@MKTBS(B) ;POINT TO MARK SR + CAIN C,GCRET ;IF NOT A MARKED FROM GOODIE, IGNORE + JRST UMOVEC + MOVEI C,-1(A) ;POINT 1 PRIOR TO VECTOR START + PUSH P,E ;SAVE NUMBER OF ELEMENTS + PUSH P,F ;AND UNIFORM TYPE + +UNLOOP: MOVE B,(P) ;GET TYPE + MOVE A,1(C) ;AND GOODIE + TLO C,400000 ;CAN'T MUNG TYPE + PUSHJ P,MARK ;MARK THIS ONE + MOVEM A,1(C) ; LIST FIXUP + SOSE -1(P) ;COUNT + AOJA C,UNLOOP ;IF MORE, DO NEXT + + SUB P,[2,,2] ;REMOVE STACK CRAP + JRST UMOVEC + + +SPECLS: FATAL AGC--UNRECOGNIZED SPECIAL VECTOR + SUB P,[4,,4] ; REOVER + JRST AFIXUP + + + +; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS +; AND UPDATES PTR TO THE TABLE. + +GCRDMK: PUSH P,A ; SAVE PTR TO TOP + MOVEI 0,@BOTNEW ; SAVE PTR TO INF + PUSH P,0 + PUSHJ P,GETLNT ; GET TO D.W. AND CHECK MARKING + JRST GCRDRL ; RELATIVIZE + PUSH P,A ; SAVE D.W POINTER + SUBI A,2 + MOVE B,ABOTN ; GET TOP OF ATOM TABLE + HRRZ 0,-2(P) + ADD B,0 ; GET BOTTOM OF ATOM TABLE +GCRD1: CAMG A,B ; DON'T SKIP IF DONE + JRST GCRD2 + HLRZ C,(A) ; GET MARKING + TRZN C,400000 ; SKIP IF MARKED + JRST GCRD3 + MOVEI E,(A) + SUBI A,(C) ; GO BACK ONE ATOM + PUSH P,B ; SAVE B + PUSH P,A ; SAVE POINTER + MOVEI C,-2(E) ; SET UP POINTER + MOVEI B,TATOM ; GO TO MARK + MOVE A,1(C) + PUSHJ P,MARK + MOVEM A,1(C) ; SMASH FIXED UP ATOM BACK IN + POP P,A + POP P,B + JRST GCRD1 +GCRD3: SUBI A,(C) ; TO NEXT ATOM + JRST GCRD1 +GCRD2: POP P,A ; GET PTR TO D.W. + POP P,E ; GET PTR TO INF + SUB P,[1,,1] ; GET RID OF TOP + PUSHJ P,ADPMOD ; FIX UP D.W. + PUSHJ P,TRBLK ; SEND IT OUT + JRST ATMREL ; RELATIVIZE AND LEAVE +GCRDRL: POP P,A ; GET PTR TO D.W + SUB P,[2,,2] ; GET RID OF TOP AND PTR TO INF + JRST ATMREL ; RELATAVIZE + + + +;MARK RELATAVIZED GLOC HACKS + +LOCRMK: SKIPE GCHAIR + JRST GCRET +LOCRDP: PUSH P,C ; SAVE C + MOVEI C,-2(A) ; RELATAVIZED PTR TO ATOM + ADD C,GLTOP ; ADD GLOTOP TO GET TO ATOM + MOVEI B,TATOM ; ITS AN ATOM + SKIPL (C) + PUSHJ P,MARK1 + POP P,C ; RESTORE C + SKIPN DUMFLG ; IF GC-DUMP, WILL STORE ATOM FOR LOCR + JRST LOCRDD + MOVEI B,1 + IORM B,3(A) ; MUNG ATOM TO SAY IT IS LOCR + CAIA +LOCRDD: MOVE A,1(C) ; GET RELATIVIZATION + MOVEM A,(P) ; IT STAYS THE SAVE + JRST GCRET + +;MARK LOCID TYPE GOODIES + +LOCMK: HRRZ B,(C) ;GET TIME + JUMPE B,LOCMK1 ; SKIP LEGAL CHECK FOR GLOBAL + HRRZ 0,2(A) ; GET OTHER TIME + CAIE 0,(B) ; SAME? + SETZB A,(P) ; NO, SMASH LOCATIVE + JUMPE A,GCRET ; LEAVE IF DONE +LOCMK1: PUSH P,C + MOVEI B,TATOM ; MARK ATOM + MOVEI C,-2(A) ; POINT TO ATOM + MOVE E,(C) ; SEE IF BLOCK IS MARKED + TLNE E,400000 ; SKIP IF MARKED + JRST LOCMK2 ; SKIP OVER BLOCK + SKIPN GCHAIR ; DO NOT MARK IF NOT HAIRY (WILL BE MARKED) + PUSHJ P,MARK1 ; LET LOCATIVE SAVE THE ATOM +LOCMK2: POP P,C + HRRZ E,(C) ; TIME BACK + MOVEI B,TVEC ; ASSUME GLOBAL + SKIPE E + MOVEI B,TTP ; ITS LOCAL + PUSHJ P,MARK1 ; MARK IT + MOVEM A,(P) + JRST GCRET + + +; MARK ASSOCIATION BLOCKS + +ASMRK: PUSH P,A +ASMRK1: HRLI A,-ASOLNT ;LOOK LIKE A VECTOR POINTER + PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS + JRST ASTREL ; ALREADY MARKED + MOVEI C,-ASOLNT-1(A) ;COPY POINTER + PUSHJ P,MARK2 ;MARK ITEM CELL + MOVEM A,1(C) + ADDI C,INDIC-ITEM ;POINT TO INDICATOR + PUSHJ P,MARK2 + MOVEM A,1(C) + ADDI C,VAL-INDIC + PUSHJ P,MARK2 + MOVEM A,1(C) + SKIPN GCHAIR ; IF NO HAIR, MARK ALL FRIENDS + JRST ASTREL + HRRZ A,NODPNT-VAL(C) ; NEXT + JUMPN A,ASMRK1 ; IF EXISTS, GO +ASTREL: POP P,A ; RESTORE PTR TO ASSOCIATION + MOVEI A,ASOLNT+1(A) ; POINT TO D.W. + SKIPN NODPNT-ASOLNT-1(A) ; SEE IF EMPTY NODPTR + JRST ASTX ; JUMP TO SEND OUT +ASTR1: HRRZ E,(A) ; RELATAVIZE + SUBI E,(A) + ADDM E,(P) + JRST GCRET ; EXIT +ASTX: HRRZ E,(A) ; GET PTR IN FRONTEIR + SUBI E,ASOLNT+1 ; ADJUST TO POINT TO BEGINNING + PUSHJ P,ADPMOD + PUSHJ P,TRBLK + JRST ASTR1 + +;HERE WHEN A VECTOR POINTER IS BAD + +VECTB1:FATAL AGC--VECTOR POINTS OUTSIDE OF VECTOR SPACE + SUB P,[1,,1] ; RECOVERY +AFIXUP: SETZM (P) ; CLOBBER SLOT + JRST GCRET ; CONTINUE + + +VECTB2: FATAL AGC--VECTOR POINTS OUT OF VECTOR SPACE + SUB P,[2,,2] + JRST AFIXUP ; RECOVER + +PARERR: FATAL AGC--PAIR POINTS OUT OF PAIR SPACE + SUB P,[1,,1] ; RECOVER + JRST AFIXUP + + + ; HERE TO MARK TEMPLATE DATA STRUCTURES + +TD.MRK: MOVEI 0,@BOTNEW ; SAVE PTR TO INF + PUSH P,0 + HLRZ B,(A) ; GET REAL SPEC TYPE + ANDI B,37777 ; KILL SIGN BIT + MOVEI E,-NUMSAT-1(B) ; GET REL POINTER TO TABLE + HRLI E,(E) + ADD E,TD.AGC+1 + HRRZS C,A ; FLUSH COUNT AND SAVE + SKIPL E ; WITHIN BOUNDS + FATAL BAD SAT IN AGC + PUSHJ P,GETLNT ; GOODIE IS NOW MARKED + JRST TMPREL ; ALREADY MARKED + + SKIPE (E) + JRST USRAGC + SUB E,TD.AGC+1 ; POINT TO LENGTH + ADD E,TD.LNT+1 + XCT (E) ; RET # OF ELEMENTS IN B + + HLRZ D,B ; GET POSSIBLE "BASIC LENGTH" FOR RESTS + PUSH P,[0] ; TEMP USED IF RESTS EXIST + PUSH P,D + MOVEI B,(B) ; ZAP TO ONLY LENGTH + PUSH P,C ; SAVE POINTER TO TEMPLATE STRUCTURE + PUSH P,[0] ; HOME FOR VALUES + PUSH P,[0] ; SLOT FOR TEMP + PUSH P,B ; SAVE + SUB E,TD.LNT+1 + PUSH P,E ; SAVE FOR FINDING OTHER TABLES + JUMPE D,TD.MR2 ; NO REPEATING SEQ + ADD E,TD.GET+1 ; COMP LNTH OF REPEATING SEQ + HLRE E,(E) ; E ==> - LNTH OF TEMPLATE + ADDI E,(D) ; E ==> -LENGTH OF REP SEQ + MOVNS E + HRLM E,-5(P) ; SAVE IT AND BASIC + +TD.MR2: SKIPG D,-1(P) ; ANY LEFT? + JRST TD.MR1 + + MOVE E,TD.GET+1 + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + MOVEM D,-6(P) ; SAVE ELMENT # + SKIPN B,-5(P) ; SKIP IF "RESTS" EXIST + SOJA D,TD.MR3 + + MOVEI 0,(B) ; BASIC LNT TO 0 + SUBI 0,(D) ; SEE IF PAST BASIC + JUMPGE 0,.-3 ; JUMP IF O.K. + MOVSS B ; REP LNT TO RH, BASIC TO LH + IDIVI 0,(B) ; A==> -WHICH REPEATER + MOVNS A + ADD A,-5(P) ; PLUS BASIC + ADDI A,1 ; AND FUDGE + MOVEM A,-6(P) ; SAVE FOR PUTTER + ADDI E,-1(A) ; POINT + SOJA D,.+2 + +TD.MR3: ADDI E,(D) ; POINT TO SLOT + XCT (E) ; GET THIS ELEMENT INTO A AND B + JFCL ; NO-OP FOR ANY CASE + MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT + MOVEM B,-2(P) + EXCH A,B ; REARRANGE + GETYP B,B + MOVEI C,-3(P) ; TELL OTHER GUYS THEY CANT DIRECTLY MUNG + MOVSI D,400000 ; RESET FOR MARK + PUSHJ P,MARK ; AND MARK THIS GUY (RET FIXED POINTER IN A) + MOVE C,-4(P) ; REGOBBLE POINTER TO TEMPLATE + MOVE E,TD.PUT+1 + MOVE B,-6(P) ; RESTORE COUNT + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + ADDI E,(B)-1 ; POINT TO SLOT + MOVE B,-3(P) ; RESTORE TYPE WORD + EXCH A,B + SOS D,-1(P) ; GET ELEMENT # + XCT (E) ; SMASH IT BACK + FATAL TEMPLATE LOSSAGE + MOVE C,-4(P) ; RESTORE POINTER IN CASE MUNGED + JRST TD.MR2 + +TD.MR1: MOVE A,-8(P) ; PTR TO DOPE WORD + MOVE E,-7(P) ; RESTORE PTR TO FRONTEIR + SUB P,[7,,7] ; CLEAN UP STACK +USRAG1: ADDI A,1 ; POINT TO SECOND D.W. + MOVSI D,400000 ; SET UP MARK BIT + PUSHJ P,ADPMOD + PUSHJ P,TRBLK ; SEND IT OUT +TMPREL: SUB P,[1,,1] + HRRZ D,(A) + SUBI D,(A) + ADDM D,(P) + MOVSI D,400000 ; RESTORE MARK/UNMARK BIT + JRST GCRET + +USRAGC: HRRZ E,(E) ; MARK THE TEMPLATE + PUSHJ P,(E) + MOVE A,-1(P) ; POINTER TO D.W + MOVE E,(P) ; TOINTER TO FRONTIER + JRST USRAG1 + +; This phase attempts to remove any unwanted associations. The program +; loops through the structure marking values of associations. It can only +; stop when no new values (potential items and/or indicators) are marked. + +VALFLS: PUSH P,LPVP ; SAVE LPVP FOR LATER + PUSH P,[0] ; INDICATE WHETHER ANY ON THIS PASS + PUSH P,[0] ; OR THIS BUCKET +ASOMK1: MOVE A,GCASOV ; GET VECTOR POINTER + SETOM -1(P) ; INITIALIZE FLAG + +ASOM6: SKIPG C,(A) ; SKIP IF BUCKET TO BE SCANNED + JRST ASOM1 + SETOM (P) ; SAY BUCKET NOT CHANGED + +ASOM2: MOVEI F,(C) ; COPY POINTER + SKIPG ASOLNT+1(C) ; SKIP IF NOT ALREADY MARKED + JRST ASOM4 ; MARKED, GO ON + PUSHJ P,MARKQ ; SEE IF ITEM IS MARKED + JRST ASOM3 ; IT IS NOT, IGNORE IT + MOVEI F,(C) ; IN CASE CLOBBERED BY MARK2 + MOVEI C,INDIC(C) ; POINT TO INDICATOR SLOT + PUSHJ P,MARKQ + JRST ASOM3 ; NOT MARKED + + PUSH P,A ; HERE TO MARK VALUE + PUSH P,F + HLRE F,ASOLNT-INDIC+1(C) ; GET LENGTH + JUMPL F,.+3 ; SKIP IF MARKED + CAMGE C,VECBOT ; SKIP IF IN VECT SPACE + JRST ASOM20 + HRRM FPTR,ASOLNT-INDIC+1(C) ; PUT IN RELATIVISATION + MOVEI F,12 ; AMOUNT TO ALLOCATE IN INF + PUSHJ P,ALLOGC + HRRM 0,5(C) ; STICK IN RELOCATION + +ASOM20: PUSHJ P,MARK2 ; AND MARK + MOVEM A,1(C) ; LIST FIX UP + ADDI C,ITEM-INDIC ; POINT TO ITEM + PUSHJ P,MARK2 + MOVEM A,1(C) + ADDI C,VAL-ITEM ; POINT TO VALUE + PUSHJ P,MARK2 + MOVEM A,1(C) + IORM D,ASOLNT-VAL+1(C) ; MARK ASOC BLOCK + POP P,F + POP P,A + AOSA -1(P) ; INDICATE A MARK TOOK PLACE + +ASOM3: AOS (P) ; INDICATE AN UNMARKED IN THIS BUCKET +ASOM4: HRRZ C,ASOLNT-1(F) ; POINT TO NEXT IN BUCKET + JUMPN C,ASOM2 ; IF NOT EMPTY, CONTINUE + SKIPGE (P) ; SKIP IF ANY NOT MARKED + HRROS (A) ; MARK BUCKET AS NOT INTERESTING +ASOM1: AOBJN A,ASOM6 ; GO TO NEXT BUCKET + TLZE TYPNT,.ATOM. ; ANY ATOMS MARKED? + JRST VALFLA ; YES, CHECK VALUES +VALFL8: + +; NOW SEE WHICH CHANNELS STILL POINTED TO + +CHNFL3: MOVEI 0,N.CHNS-1 + MOVEI A,CHNL1 ; SLOTS + HRLI A,TCHAN ; TYPE HERE TOO + +CHNFL2: SKIPN B,1(A) + JRST CHNFL1 + HLRE C,B + SUBI B,(C) ; POINT TO DOPE + HLLM A,(A) ; PUT TYPE BACK + HRRE F,(A) ; SEE IF ALREADY MARKED + JUMPN F,CHNFL1 + SKIPGE 1(B) + JRST CHNFL8 + HLLOS (A) ; MARK AS A LOSER + SETZM -1(P) + JRST CHNFL1 +CHNFL8: MOVEI F,1 ; MARK A GOOD CHANNEL + HRRM F,(A) +CHNFL1: ADDI A,2 + SOJG 0,CHNFL2 + + SKIPE GCHAIR ; IF NOT HAIRY CASE + POPJ P, ; LEAVE + + SKIPL -1(P) ; SKIP IF NOTHING NEW MARKED + JRST ASOMK1 + + SUB P,[2,,2] ; REMOVE FLAGS + + + +; HERE TO REEMOVE UNUSED ASSOCIATIONS + + MOVE A,GCASOV ; GET ASOVEC BACK FOR FLUSHES + +ASOFL1: SKIPN C,(A) ; SKIP IF BUCKET NOT EMPTY + JRST ASOFL2 ; EMPTY BUCKET, IGNORE + HRRZS (A) ; UNDO DAMAGE OF BEFORE + +ASOFL5: SKIPGE ASOLNT+1(C) ; SKIP IF UNMARKED + JRST ASOFL6 ; MARKED, DONT FLUSH + + HRRZ B,ASOLNT-1(C) ; GET FORWARD POINTER + HLRZ E,ASOLNT-1(C) ; AND BACK POINTER + JUMPN E,ASOFL4 ; JUMP IF NO BACK POINTER (FIRST IN BUCKET) + HRRZM B,(A) ; FIX BUCKET + JRST .+2 + +ASOFL4: HRRM B,ASOLNT-1(E) ; FIX UP PREVIOUS + JUMPE B,.+2 ; JUMP IF NO NEXT POINTER + HRLM E,ASOLNT-1(B) ; FIX NEXT'S BACK POINTER + HRRZ B,NODPNT(C) ; SPLICE OUT THRAD + HLRZ E,NODPNT(C) + SKIPE E + HRRM B,NODPNT(E) + SKIPE B + HRLM E,NODPNT(B) + +ASOFL3: HRRZ C,ASOLNT-1(C) ; GO TO NEXT + JUMPN C,ASOFL5 +ASOFL2: AOBJN A,ASOFL1 + + + +; NOW CLOBBER UNMARKED LOCAL NAD GLOBAL VALUES + + MOVE A,GCGBSP ; GET GLOBAL PDL + +GLOFLS: SKIPGE (A) ; SKIP IF NOT ALREADY MARKED + JRST SVDCL + MOVSI B,-3 + PUSHJ P,ZERSLT ; CLOBBER THE SLOT + HLLZS (A) +SVDCL: ANDCAM D,(A) ; UNMARK + ADD A,[4,,4] + JUMPL A,GLOFLS ; MORE?, KEEP LOOPING + + MOVEM LPVP,(P) +LOCFL1: HRRZ A,(LPVP) ; NOW CLOBBER LOCAL SLOTS + HRRZ C,2(LPVP) + MOVEI LPVP,(C) + JUMPE A,LOCFL2 ; NONE TO FLUSH + +LOCFLS: SKIPGE (A) ; MARKDE? + JRST .+3 + MOVSI B,-5 + PUSHJ P,ZERSLT + ANDCAM D,(A) ;UNMARK + HRRZ A,(A) ; GO ON + JUMPN A,LOCFLS +LOCFL2: JUMPN LPVP,LOCFL1 ; JUMP IF MORE PROCESS + +; AT THIS POINT THE LOCALS ARE FINALLY SENT OUT. +; THIS ROUTINE UPDATES THE THIS-PROCESS BINDING. IT FIXES UP THE SP-CHAIN AND IT +; SENDS OUT THE ATOMS. + +LOCFL3: MOVE C,(P) + MOVEI B,TATOM ; MARK THE BINDING TO THIS PROCESS + PUSHJ P,MARK1 ; MARK THE ATOM + MOVEM A,1(C) ; NEW HOME + MOVEI C,2(C) ; MARK VALUE + MOVEI B,TPVP ; IT IS A PROCESS VECTOR POINTER + PUSHJ P,MARK1 ; MARK IT + MOVEM A,1(C) + POP P,R +NEXPRO: MOVEI 0,TPVP ; FIX UP SLOT + HLRZ A,2(R) ; GET PTR TO NEXT PROCESS + HRLM 0,2(R) + HRRZ E,(A) ; ADRESS IN INF + HRRZ B,(A) ; CALCULATE RELOCATION + SUB B,A + PUSH P,B + HRRZ F,A ; CALCULATE START OF TP IN F + HLRZ B,(A) ; ADJUST INF PTR + TRZ B,400000 + SUBI F,-1(B) + LDB M,[111100,,-1(A)] ; CALCULATE TOP GROWTH + TRZE M,400 ; FUDGE SIGN + MOVNS M + ASH M,6 + ADD B,M ; FIX UP LENGTH + EXCH M,(P) + SUBM M,(P) ; FIX RELOCATION TO TAKE INTO ACCOUNT CHANGE IN LENGTH + MOVE M,R ; GET A COPY OF R +NEXP1: HRRZ C,(M) ; GET PTR TO NEXT IN CHAIN + JUMPE C,NEXP2 ; EXIT IF END OF CHAIN + MOVE 0,C ; GET COPY OF CHAIN PTR TO UPDATE + ADD 0,(P) ; UPDATE + HRRM 0,(M) ; PUT IN + MOVE M,C ; NEXT + JRST NEXP1 +NEXP2: SUB P,[1,,1] ; CLEAN UP STACK + SUBI E,-1(B) + HRRI B,(R) ; GET POINTER TO THIS-PROCESS BINDING + MOVEI B,6(B) ; POINT AFTER THE BINDING + MOVE 0,F ; CALCULATE # OF WORDS TO SEND OUT + SUBM B,0 + PUSH P,R ; PRESERVE R + PUSHJ P,TRBLKX ; SEND IT OUT + POP P,R ; RESTORE R + HRRZS R,2(R) ; GET THE NEXT PROCESS + SKIPN R + JRST .+3 + PUSH P,R + JRST LOCFL3 + MOVE A,GCGBSP ; PTR TO GLOBAL STACK + PUSHJ P,SPCOUT ; SEND IT OUT + MOVE A,GCASOV + PUSHJ P,SPCOUT ; SEND IT OUT + POPJ P, + +; THIS ROUTINE MARKS ALL THE CHANNELS +; IT THEN SENDS OUT A COPY OF THE TVP + +CHFIX: MOVEI 0,N.CHNS-1 + MOVEI A,CHNL1 ; SLOTS + HRLI A,TCHAN ; TYPE HERE TOO + +DHNFL2: SKIPN B,1(A) + JRST DHNFL1 + MOVEI C,(A) ; MARK THE CHANNEL + PUSH P,0 ; SAVE 0 + PUSH P,A ; SAVE A + PUSHJ P,MARK2 + MOVEM A,1(C) ; ADJUST PTR + POP P,A ; RESTORE A + POP P,0 ; RESTORE +DHNFL1: ADDI A,2 + SOJG 0,DHNFL2 + POPJ P, + + +; ROUTINE TO SEND OUT SPECIAL STUFF FROM GCHAIR + +SPCOUT: HLRE B,A + SUB A,B + MOVEI A,1(A) ; POINT TO DOPE WORD + LDB 0,[001100,,-1(A)] ;GET GROWTH FACTOR + TRZE 0,400 ;KILL SIGN BIT AND SKIP IF + + MOVNS 0 ;NEGATE + ASH 0,6 ;CONVERT TO NUMBER OF WORDS + PUSHJ P,DOPMOD + HRRZ E,(A) ; GET PTR TO INF + HLRZ B,(A) ; LENGTH + TRZ B,400000 ; GET RID OF MARK BIT + SUBI E,-1(B) + ADD E,0 + PUSH P,0 ; DUMMY FOR TRBLKV + PUSHJ P,TRBLKV ; OUT IT GOES + SUB P,[1,,1] + POPJ P, ;RETURN + +ASOFL6: HLRZ E,ASOLNT-1(C) ; SEE IF FIRST IN BUCKET + JUMPN E,ASOFL3 ; IF NOT CONTINUE + HRRZ E,ASOLNT+1(C) ; GET PTR FROM DOPE WORD + SUBI E,ASOLNT+1 ; ADJUST TO POINT TO BEGINNING OF ALSSOCIATION + HRRZM E,(A) ; SMASH IT IN + JRST ASOFL3 + + +MARK23: PUSH P,A ; SAVE BUCKET POINTER + PUSH P,F + PUSHJ P,MARK2 + MOVEM A,1(C) + POP P,F + POP P,A + AOS -2(P) ; MARKING HAS OCCURRED + IORM D,ASOLNT+1(C) ; MARK IT + JRST MKD + + ; CHANNEL FLUSHER FOR NON HAIRY GC + +CHNFLS: PUSH P,[-1] + SETOM (P) ; RESET FOR RETRY + PUSHJ P,CHNFL3 + SKIPL (P) + JRST .-3 ; REDO + SUB P,[1,,1] + POPJ P, + +; VALUE FLUSHING PHASE, HACKS BOTTOM OF TP AND GLOBAL SP + +VALFLA: MOVE C,GCGBSP ; GET POINTER TO GLOBAL STACK +VALFL1: SKIPL (C) ; SKIP IF NOT MARKED + PUSHJ P,MARKQ ; SEE IF ATOM IS MARKED + JRST VALFL2 + PUSH P,C + MOVEI B,TATOM ; UPDATE ATOM SLOT + PUSHJ P,MARK1 + MOVEM A,1(C) + IORM D,(C) + AOS -2(P) ; INDICATE MARK OCCURRED + HRRZ B,(C) ; GET POSSIBLE GDECL + JUMPE B,VLFL10 ; NONE + CAIN B,-1 ; MAINFIFEST + JRST VLFL10 + MOVEI A,(B) + MOVEI B,TLIST + MOVEI C,0 + PUSHJ P,MARK ; MARK IT + MOVE C,(P) ; POINT + HRRM A,(C) ; CLOBBER UPDATE IN +VLFL10: ADD C,[2,,2] ; BUMP TO VALUE + PUSHJ P,MARK2 ; MARK VALUE + MOVEM A,1(C) + POP P,C +VALFL2: ADD C,[4,,4] + JUMPL C,VALFL1 ; JUMP IF MORE + + HRLM LPVP,(P) ; SAVE POINTER +VALFL7: MOVEI C,(LPVP) + MOVEI LPVP,0 +VALFL6: HRRM C,(P) + +VALFL5: HRRZ C,(C) ; CHAIN + JUMPE C,VALFL4 + MOVEI B,TATOM ; TREAT LIKE AN ATOM + SKIPL (C) ; MARKED? + PUSHJ P,MARKQ1 ; NO, SEE + JRST VALFL5 ; LOOP + AOS -1(P) ; MARK WILL OCCUR + MOVEI B,TATOM ; RELATAVIZE + PUSHJ P,MARK1 + MOVEM A,1(C) + IORM D,(C) + ADD C,[2,,2] ; POINT TO VALUE + PUSHJ P,MARK2 ; MARK VALUE + MOVEM A,1(C) + SUBI C,2 + JRST VALFL5 + +VALFL4: HRRZ C,(P) ; GET SAVED LPVP + MOVEI A,(C) + HRRZ C,2(C) ; POINT TO NEXT + JUMPN C,VALFL6 + JUMPE LPVP,VALFL9 + + HRRM LPVP,2(A) ; NEW PROCESS WAS MARKED + JRST VALFL7 + +ZERSLT: HRRI B,(A) ; COPY POINTER + SETZM 1(B) + AOBJN B,.-1 + POPJ P, + +VALFL9: HLRZ LPVP,(P) ; RESTORE CHAIN + JRST VALFL8 + + ;SUBROUTINE TO SEE IF A GOODIE IS MARKED +;RECEIVES POINTER IN C +;SKIPS IF MARKED NOT OTHERWISE + +MARKQ: HLRZ B,(C) ;TYPE TO B +MARKQ1: MOVE E,1(C) ;DATUM TO C + MOVEI 0,(E) + CAIL 0,@PURBOT ; DONT CHACK PURE + JRST MKD ; ALWAYS MARKED + ANDI B,TYPMSK ; FLUSH MONITORS + LSH B,1 + HRRZ B,@TYPNT ;GOBBLE SAT + ANDI B,SATMSK + CAIG B,NUMSAT ; SKIP FOR TEMPLATE + JRST @MQTBS(B) ;DISPATCH + ANDI E,-1 ; FLUSH REST HACKS + JRST VECMQ + + +MQTBS: + +OFFSET 0 + +DISTB2 DUM3,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ] +[STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SLOCID,LOCMQ] +[SATOM,ATMMQ],[SPVP,VECMQ],[SCHSTR,BYTMQ],[SLOCA,ARGMQ],[SLOCU,VECMQ] +[SLOCV,VECMQ],[SLOCS,BYTMQ],[SLOCN,ASMQ],[SASOC,ASMQ],[SLOCL,PAIRMQ],[SGATOM,ATMMQ] +[SBYTE,BYTMQ],[SLOCB,BYTMQ],[SDEFQ,PAIRMQ],[SOFFS,OFFSMQ]] + +OFFSET OFFS + +PAIRMQ: JUMPE E,MKD ; NIL ALWAYS MARKED + SKIPL (E) ; SKIP IF MARKED + POPJ P, +ARGMQ: +MKD: AOS (P) + POPJ P, + +BYTMQ: PUSH P,A ; SAVE A + PUSHJ P,BYTDOP ; GET PTR TO DOPE WORD + MOVE E,A ; COPY POINTER + POP P,A ; RESTORE A + SKIPGE (E) ; SKIP IF NOT MARKED + AOS (P) + POPJ P, ; EXIT + +FRMQ: HRRZ E,(C) ; POINT TO PV DOPE WORD + SOJA E,VECMQ1 + +ATMMQ: CAML 0,GCSBOT ; ALWAYS KEEP FROZEN ATOMS + JRST VECMQ + AOS (P) + POPJ P, + +VECMQ: HLRE 0,E ;GET LENGTH + SUB E,0 ;POINT TO DOPE WORDS + +VECMQ1: SKIPGE 1(E) ;SKIP IF NOT MARKED + AOS (P) ;MARKED, CAUSE SKIP RETURN + POPJ P, + +ASMQ: ADDI E,ASOLNT + JRST VECMQ1 + +LOCMQ: HRRZ 0,(C) ; GET TIME + JUMPE 0,VECMQ ; GLOBAL, LIKE VECTOR + HLRE 0,E ; FIND DOPE + SUB E,0 + MOVEI E,1(E) ; POINT TO LAST DOPE + CAMN E,TPGROW ; GROWING? + SOJA E,VECMQ1 ; YES, CHECK + ADDI E,PDLBUF ; FUDGE + MOVSI 0,-PDLBUF + ADDM 0,1(C) + SOJA E,VECMQ1 + +OFFSMQ: HLRZS E ; POINT TO LIST STRUCTURE + SKIPGE (E) ; MARKED? + AOS (P) ; YES + POPJ P, + + ; SUBROUTINE TO UPDATE ASSOCIATIONS AND MOVE THEM INTO THE INF + +ASSOUP: MOVE A,GCNOD ; RECOVER PTR TO START OF CHAIN +ASSOP1: HRRZ B,NODPNT(A) + PUSH P,B ; SAVE NEXT ON CHAIN + PUSH P,A ; SAVE IT + HRRZ B,ASOLNT-1(A) ;POINT TO NEXT + JUMPE B,ASOUP1 + HRRZ C,ASOLNT+1(B) ;AND GET ITS RELOC IN C + SUBI C,ASOLNT+1(B) ; RELATIVIZE + ADDM C,ASOLNT-1(A) ;C NOW HAS UPDATED POINTER +ASOUP1: HLRZ B,ASOLNT-1(A) ;GET PREV BLOCK POINTER + JUMPE B,ASOUP2 + HRRZ F,ASOLNT+1(B) ;AND ITS RELOCATION + SUBI F,ASOLNT+1(B) ; RELATIVIZE + MOVSI F,(F) + ADDM F,ASOLNT-1(A) ;RELOCATE +ASOUP2: HRRZ B,NODPNT(A) ;UPDATE NODE CHAIN + JUMPE B,ASOUP4 + HRRZ C,ASOLNT+1(B) ;GET RELOC + SUBI C,ASOLNT+1(B) ; RELATIVIZE + ADDM C,NODPNT(A) ;AND UPDATE +ASOUP4: HLRZ B,NODPNT(A) ;GET PREV POINTER + JUMPE B,ASOUP5 + HRRZ F,ASOLNT+1(B) ;RELOC + SUBI F,ASOLNT+1(B) + MOVSI F,(F) + ADDM F,NODPNT(A) +ASOUP5: POP P,A ; RECOVER PTR TO DOPE WORD + MOVEI A,ASOLNT+1(A) + MOVSI B,400000 ;UNMARK IT + XORM B,(A) + HRRZ E,(A) ; SET UP PTR TO INF + HLRZ B,(A) + SUBI E,-1(B) ; ADJUST PTR + PUSHJ P,ADPMOD + PUSHJ P,TRBLK ; OUT IT GOES + POP P,A ; RECOVER PTR TO ASSOCIATION + JUMPN A,ASSOP1 ; IF NOT ZERO CONTINUP + POPJ P, ; DONE + + +; HERE TO CLEAN UP ATOM HASH TABLE + +ATCLEA: MOVE A,GCHSHT ; GET TABLE POINTER + +ATCLE1: MOVEI B,0 + SKIPE C,(A) ; GET NEXT + JRST ATCLE2 ; GOT ONE + +ATCLE3: PUSHJ P,OUTATM + AOBJN A,ATCLE1 + + MOVE A,GCHSHT ; MOVE OUT TABLE + PUSHJ P,SPCOUT + POPJ P, + +; HAVE AN ATOM IN C + +ATCLE2: MOVEI B,0 + +ATCLE5: CAIL C,HIBOT + JRST ATCLE3 + CAMG C,VECBOT ; FROZEN ATOMS ALWAYS MARKED + JRST .+3 + SKIPL 1(C) ; SKIP IF ATOM MARKED + JRST ATCLE6 + + HRRZ 0,1(C) ; GET DESTINATION + CAIN 0,-1 ; FROZEN/MAGIC ATOM + MOVEI 0,1(C) ; USE CURRENT POSN + SUBI 0,1 ; POINT TO CORRECT DOPE + JUMPN B,ATCLE7 ; JUMP IF GOES INTO ATOM + + HRRZM 0,(A) ; INTO HASH TABLE + JRST ATCLE8 + +ATCLE7: HRLM 0,2(B) ; INTO PREV ATOM + PUSHJ P,OUTATM + +ATCLE8: HLRZ B,1(C) + ANDI B,377777 ; KILL MARK BIT + SUBI B,2 + HRLI B,(B) + SUBM C,B + HLRZ C,2(B) + JUMPE C,ATCLE3 ; DONE WITH BUCKET + JRST ATCLE5 + +; HERE TO PASS OVER LOST ATOM + +ATCLE6: HLRZ F,1(C) ; FIND NEXT ATOM + SUBI C,-2(F) + HLRZ C,2(C) + JUMPE B,ATCLE9 + HRLM C,2(B) + JRST .+2 +ATCLE9: HRRZM C,(A) + JUMPE C,ATCLE3 + JRST ATCLE5 + +OUTATM: JUMPE B,CPOPJ + PUSH P,A + PUSH P,C + HLRE A,B + SUBM B,A + MOVSI D,400000 ;UNMARK IT + XORM D,1(A) + HRRZ E,1(A) ; SET UP PTR TO INF + HLRZ B,1(A) + SUBI E,-1(B) ; ADJUST PTR + MOVEI A,1(A) + PUSHJ P,ADPMOD + PUSHJ P,TRBLK ; OUT IT GOES + POP P,C + POP P,A ; RECOVER PTR TO ASSOCIATION + POPJ P, + + +VCMLOS: FATAL AGC--VECTOR WITH ZERO IN DOPE WORD LENGTH + + +; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC + +MSGGCT: [ASCIZ /USER CALLED- /] + [ASCIZ /FREE STORAGE- /] + [ASCIZ /TP-STACK- /] + [ASCIZ /TOP-LEVEL LOCALS- /] + [ASCIZ /GLOBAL VALUES- /] + [ASCIZ /TYPES- /] + [ASCIZ /STATIONARY IMPURE STORAGE- /] + [ASCIZ /P-STACK /] + [ASCIZ /BOTH STACKS BLOWN- /] + [ASCIZ /PURE STORAGE- /] + [ASCIZ /GC-RCALL- /] + +; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC + +GCPAT: SPBLOK 100 +EGCPAT: -1 + +MSGGFT: [ASCIZ /GC-READ /] + [ASCIZ /BLOAT /] + [ASCIZ /GROW /] + [ASCIZ /LIST /] + [ASCIZ /VECTOR /] + [ASCIZ /SET /] + [ASCIZ /SETG /] + [ASCIZ /FREEZE /] + [ASCIZ /PURE-PAGE LOADER /] + [ASCIZ /GC /] + [ASCIZ /INTERRUPT-HANDLER /] + [ASCIZ /NEWTYPE /] + [ASCIZ /PURIFY /] + +.GLOBAL GCNO,BSTGC,BSTAT,NOWFRE,CURFRE,MAXFRE,USEFRE,NOWTP,CURTP,CTPMX,NOWLFL +.GLOBAL CURLVL,NOWGVL,CURGVL,NOWTYP,CURTYP,NOWSTO,CURSTO,CURMAX,NOWP,CURP,CPMX +.GLOBAL GCCAUS,GCCALL,LVLINC,GVLINC,TYPIC,STORIC,RCL,RCLV,GCDANG,GETNUM,RPTOP,CORTOP +.GLOBAL TPGROW,PPGROW,PGROW,PMAIN,PGOOD,PMAX,TPGOOD,TPMIN,TPMAX,RFRETP,TYPTAB +.GLOBAL NNPRI,NNSAT,TYPSAV,BUFGC,GCTIM,GPURFL,GCDFLG,DUMFLG +.GLOBAL TPBINC,GBLINC,TYPINC,CONADJ,OGCSTP,ABOTN,MAXLEN +.GLOBAL PURMIN,GCMONF,.LIST.,FPAG,PMIN,GLBINC,INCORF,PURCOR,GCHAIR + + +;LOCAL VARIABLES + +OFFSET 0 + +IMPURE +; LOCACTIONS USED BY THE PAGE HACKER + +DOPSV1: 0 ;SAVED FIRST D.W. +DOPSV2: 0 ; SAVED LENGTH + + +; LOCATIONS USED BY BLOAT-STAT TO HELP THE USER PICK BLOAT SPECIFICATIONS. +; + +GCNO: 0 ; USER-CALLED GC +BSTGC: 0 ; FREE STORAGE + 0 ; BLOWN TP + 0 ; TOP-LEVEL LVALS + 0 ; GVALS + 0 ; TYPE + 0 ; STORAGE + 0 ; P-STACK + 0 ; BOTH STATCKS BLOWN + 0 ; STORAGE + +BSTAT: +NOWFRE: 0 ; FREE STORAGE FROM LAST GC +CURFRE: 0 ; STORAGE USED SINCE LAST GC +MAXFRE: 0 ; MAXIMUM FREE STORAGE ALLOCATED +USEFRE: 0 ; TOTAL FREE STORAGE USED +NOWTP: 0 ; TP LENGTH FROM LAST GC +CURTP: 0 ; # WORDS ON TP +CTPMX: 0 ; MAXIMUM SIZE OF TP SO FAR +NOWLVL: 0 ; # OF TOP-LEVEL LVAL-SLOTS +CURLVL: 0 ; # OF TOP-LEVEL LVALS +NOWGVL: 0 ; # OF GVAL SLOTS +CURGVL: 0 ; # OF GVALS +NOWTYP: 0 ; SIZE OF TYPE-VECTOR +CURTYP: 0 ; # OF TYPES +NOWSTO: 0 ; SIZE OF STATIONARY STORAGE +CURSTO: 0 ; STATIONARY STORAGE IN USE +CURMAX: 0 ; MAXIMUM BLOCK OF CONTIGUOUS STORAGE +NOWP: 0 ; SIZE OF P-STACK +CURP: 0 ; #WORDS ON P +CPMX: 0 ; MAXIMUM P-STACK LENGTH SO FAR +GCCAUS: 0 ; INDICATOR FOR CAUSE OF GC +GCCALL: 0 ; INDICATOR FOR CALLER OF GC + + +; THIS GROUP OF VARIABLES DETERMINES HOW THINGS GROW +LVLINC: 6 ; LVAL INCREMENT ASSUMED TO BE 64 SLOTS +GVLINC: 4 ; GVAL INCREMENT ASSUMED TO BE 64 SLOTS +TYPIC: 1 ; TYPE INCREMENT ASSUMED TO BE 32 TYPES +STORIC: 2000 ; STORAGE INCREMENT USED BY NFREE (MINIMUM BLOCK-SIZE) + + +RCL: 0 ; POINTER TO LIST OF RECYCLEABLE LIST CELLS +RCLV: 0 ; POINTER TO RECYCLED VECTORS +GCMONF: 0 ; NON-ZERO SAY GIN/GOUT +GCDANG: 0 ; NON-ZERO, STORAGE IS LOW +INBLOT: 0 ; INDICATE THAT WE ARE RUNNING OIN A BLOAT +GETNUM: 0 ;NO OF WORDS TO GET +RFRETP: +RPTOP: 0 ;NO OF BLOCKS OF CORE, IF GIVING CORE AWAY +CORTOP: 0 ;CURRENT TOP OF CORE, EXCLUDING ANY TO BE GIVEN AWAY +NGCS: 8 ; NUMBER OF GARBAGE COLLECTS BETWEEN HAIRY GCS + +;VARIABLES WHICH DETERMIN WHEN MUDDLE WILL ASK FOR MORE CORE, +;AND WHEN IT WILL GET UNHAPPY + +FREMIN: 20000 ;MINIMUM FREE WORDS + +;POINTER TO GROWING PDL + +TPGROW: 0 ;POINTS TO A BLOWN TP +PPGROW: 0 ;POINTS TO A BLOWN PP +PGROW: 0 ;POINTS TO A BLOWN P + +;IN GC FLAG + +GCFLG: 0 +GCFLCH: 0 ; TELL INT HANDLER TO ITIC CHARS +GCHAIR: 1 ; COUNTS GCS AND TELLS WHEN TO HAIRIFY +GCDOWN: 0 ; AMOUNT TO TRY AND MOVE DOWN +CURPLN: 0 ; LENGTH OF CURRENTLY RUNNING PURE RSUBR +PURMIN: 0 ; MINIMUM PURE STORAGE + +; VARS ASSOCIATED WITH BLOAT LOGIC +PMIN: 200 ; MINIMUM FOR PSTACK +PGOOD: 1000 ; GOOD SIZE FOR PSTACK +PMAX: 4000 ; MAX SIZE FOR PSTACK +TPMIN: 1000 ; MINIMUM SIZE FOR TP +TPGOOD: NTPGOO ; GOOD SIZE OF TP +TPMAX: NTPMAX ; MAX SIZE OF TP + +TPBINC: 0 +GLBINC: 0 +TYPINC: 0 + +; VARS FOR PAGE WINDOW HACKS + +GCHSHT: 0 ; SAVED ATOM TABLE +PURSVT: 0 ; SAVED PURVEC TABLE +GLTOP: 0 ; SAVE GLOTOP +GCNOD: 0 ; PTR TO START OF ASSOCIATION CHAIN +GCGBSP: 0 ; SAVED GLOBAL SP +GCASOV: 0 ; SAVED PTR TO ASSOCIATION VECTOR +GCATM: 0 ; PTR TO IMQUOT THIS-PROCESS +FNTBOT: 0 ; BOTTOM OF FRONTEIR +WNDBOT: 0 ; BOTTOM OF WINDOW +WNDTOP: 0 +BOTNEW: (FPTR) ; POINTER TO FRONTIER +GCTIM: 0 +NPARBO: 0 ; SAVED PARBOT + +; FLAGS TO INDICATE DUMPER IS IN USE + +GPURFL: 0 ; INDICATE PURIFIER IS RUNNING +GCDFLG: 0 ; INDICATE EITHER GCDUMP OR PURIFIER IS RUNNING +DUMFLG: 0 ; FLAG INDICATING DUMPER IS RUNNING + +; CONSTANTS FOR DUMPER,READER AND PURIFYER + +ABOTN: 0 ; COUNTER FOR ATOMS +NABOTN: 0 ; POINTER USED BY PURIFY +OGCSTP: 0 ; CONTAINS OLD GCSTOP FOR READER +MAPUP: 0 ; BEGINNING OF MAPPED UP PURE STUFF +SAVRES: 0 ; SAVED UPDATED ITEM OF PURIFIER +SAVRE2: 0 ; SAVED TYPE WORD +SAVRS1: 0 ; SAVED PTR TO OBJECT +INF1: 0 ; AOBJN PTR USED IN CREATING PROTECTION INF +INF2: 0 ; AOBJN PTR USED IN CREATING SECOND INF +INF3: 0 ; AOBJN PTR USED TO PURIFY A STRUCTURE + +; VARIABLES USED BY GC INTERRUPT HANDLER + +GCHPN: 0 ; SET TO -1 EVERYTIME A GC HAS OCCURED +GCKNUM: 0 ; NUMBER OF WORDS OF REQUEST TO INTERRUPT + +; VARIABLE TO INDICATE WHETHER AGC HAS PUSHED THE MAPPING CHANNEL TO WIN + +PSHGCF: 0 + +; VARIABLES USED BY DUMPER AND READER TO HANDLE NEWTYPES + +TYPTAB: 0 ; POINTER TO TYPE TABLE +NNPRI: 0 ; NUMPRI FROM DUMPED OBJECT +NNSAT: 0 ; NUMSAT FROM DUMPED OBJECT +TYPSAV: 0 ; SAVE PTR TO TYPE VECTOR + +; VARIABLES USED BY GC-DUMP FOR COPY-WRITE MAPPING + +BUFGC: 0 ; BUFFER FOR COPY ON WRITE HACKING +PURMNG: 0 ; FLAG INDICATING IF A PURIFIED PAGE WAS MUNGED DURING GC-DUMP +RPURBT: 0 ; SAVED VALUE OF PURTOP +RGCSTP: 0 ; SAVED GCSTOP + +; VARIABLES USED TO DETERMINE WHERE THE GC-DUMPED STRUCTURE SHOULD GO + +INCORF: 0 ; INDICATION OF UVECTOR HACKS FOR GC-DUMP +PURCOR: 0 ; INDICATION OF UVECTOR TO PURE CORE + ; ARE NOT GENERATED + + +PLODR: 0 ; INDICATE A PLOAD IS IN OPERATION +NPRFLG: 0 + +; VARIABLE USED BY MARK SWEEP GARBAGE COLLECTOR + +MAXLEN: 0 ; MAXIMUM RECLAIMED SLOT + +PURE + +OFFSET OFFS + +CONSTANTS + +HERE + +CONSTANTS + +OFFSET 0 + +ZZ==$.+1777 + +.LOP ANDCM ZZ 1777 + +ZZ1==.LVAL1 + +LOC ZZ1 + + +OFFSET OFFS + +WIND: SPBLOK 2000 +FRONT: SPBLOK 2000 +MRKPD: SPBLOK 1777 +ENDPDL: -1 + +MRKPDL=MRKPD-1 + +ENDGC: + +OFFSET 0 + +.LOP WIND <,-10.> +WNDP==.LVAL1 + +.LOP FRONT <,-10.> +FRNP==.LVAL1 + +ZZ2==ENDGC-AGCLD +.LOP ZZ2 <,-10.> +LENGC==.LVAL1 + +.LOP LENGC <,10.> +RLENGC==.LVAL1 + +.LOP AGCLD <,-10.> +PAGEGC==.LVAL1 + +OFFSET 0 + +LOC GCST +.LPUR==$. + +END + diff --git a//agc.mid.139 b//agc.mid.139 new file mode 100644 index 0000000..1a58c58 --- /dev/null +++ b//agc.mid.139 @@ -0,0 +1,3632 @@ +TITLE AGC MUDDLE GARBAGE COLLECTOR + +;SYSTEM WIDE DEFINITIONS GO HERE + +RELOCATABLE +GCST==$. + + +.GLOBAL RCL,VECTOP,GCSTOP,GCSBOT,FRETOP,GCSNEW,VECBOT,PARTOP,PARBOT,HITOP,HIBOT,GETPAG +.GLOBAL PDLBUF,PDLEX,PDLEXP,GCFLG,GCPDL,GETNUM,PARNEW,MOVPUR,RCLV,RCLVEC,PGCNT +.GLOBAL PGROW,TPGROW,MAINPR,MSGTYP,PURTOP,PURBOT,STOSTR,GCSET,CKPUR +.GLOBAL MTYI,UPLO,FRMUNG,BYTDOP,GLOBSP,FREDIF,FREMIN,GCHAPN,INTFLG,FINAGC,NGCS,INQAGC +.GLOBAL SAT,TTOCHN,TYPVEC,ICONS,INCONS,IBLOCK,IEUVEC,IEVECTI,CELL2,MKTBS,RLENGC +.GLOBAL GIBLOK,REHASH,IBLOK1,IILIST,IIFORM,CIVEC,CIUVEC,CICONS,CPOPJ,RBLDM,GCOFFS +.GLOBAL SPBASE,OUTRNG,CISTNG,CBYTES,%RUNAM,PURVEC,GCDOWN,N.CHNS,CHNL1,PLODR,MRKPDL +.GLOBAL CAFRE,CAFRET,STOGC,GCHN,WNDP,FRNP,FRONT,%GCJOB,%SHWND,%INFMP,%GETIP,CHKPGI +.GLOBAL TD.PUT,TD.GET,TD.AGC,TD.AGC,TD.LNT,GLOTOP,UBIT,FLGSET,PURMNG,RPURBT,%IFMP2 +.GLOBAL CTIME,IMTYO,ILOC,NODES,GPURFL,GCDANG,GCHACK,LPUR,HITOP,BADCHN,IMPURX,PURCLN +.GLOBAL GCTIM,GCCAUS,GCCALL,IAAGC,LVLINC,STORIC,GVLINC,TYPIC,GCRSET,ACCESS,NOSHUF,SQUPNT +; GLOBALS ASSOCIATE WITH THE ASSOCIATION VECTOR + +.GLOBAL ASOVEC,ASOLNT,ITEM,INDIC,VAL,NWORDT,NODPNT,PNTRS,DSTORE,HASHTB +.GLOBAL CELL,BINDID,GCFLCH,TYPBOT,GLOBAS,TPBASE,NOWLVL,CURPLN,PVSTOR,SPSTOR + +.GLOBAL P.TOP,P.CORE,PMAPB,IGET,CIGTPR,ROOT,STBL,CAFREE,%MPIN1,%PURIF,%MPINX,GCHK10 +.GLOBAL %SAVRP,%RSTRP,LENGC,AGCLD,PAGEGC,REALGC,MARK +.GLOBAL %MPINT,%GBINT,%CLSMP,%CLSM1,PINIT,PGFIND,NPRFLG,%PURMD +.GLOBAL GCKNUM,CORTOP,GCHPN,INTAGC,WNDP,WNDBOT,BUFGC,WIND,GCDFLG,SAVM,AGC,GCSET + +.GLOBAL GCRET,PAIRMK,DEFMK,VECTMK,TBMK,TPMK,ARGMK,VECTMK,FRMK,BYTMK,ATOMK,GATOMK +.GLOBAL BYTMK,ABMK,LOCRMK,GCRDMK,DEFQMK,ASMRK,LOCMK,OFFSMK,INBLOT,MARK2A + +NOPAGS==1 ; NUMBER OF WINDOWS +EOFBIT==1000 +PDLBUF=100 +NTPMAX==20000 ; NORMAL MAX TP SIZE +NTPGOO==4000 ; NORMAL GOOD TP +ETPMAX==2000 ; TPMAX IN AN EMERGENCY (I.E. GC RECALL) +ETPGOO==2000 ; GOOD TP IN EMERGENCY + +.ATOM.==200000 ; FLAG SAYING ATOMS MARKED (FOR VAL FLUSH LOGIC) + +GCHN==0 ; CHANNEL FOR FUNNNY INFERIOR +STATNO==19. ; # OF STATISTICS FOR BLOAT-STAT +STATGC==8. ; # OF GC-STATISTICS FOR BLOAT-STAT + + +LOC REALGC +OFFS==AGCLD-$. +GCOFFS=OFFS +OFFSET OFFS + +.INSRT MUDDLE > +SYSQ +IFE ITS,[ +.INSRT STENEX > +] +IFN ITS, PGSZ==10. +IFE ITS, PGSZ==9. + +TYPNT=AB ;SPECIAL AC USAGE DURING GC +F=TP ;ALSO SPECIAL DURING GC +LPVP=SP ;SPECIAL FOR GC, HOLDS POINTER TO PROCESS CHAIN +FPTR=TB ; POINT TO CURRENT FRONTIER OF INFERIOR + + +; WINDOW AND FRONTIER PAGES + +MAPCH==0 ; MAPPING CHANNEL +.LIST.==400000 +FPAG==2000 ; START OF PAGES FOR GC-READ AND GCDUMP +CONADJ==5 ; ADJUSTMENT OF DUMPERS CONSTANT TABLE + + +; INTERNAL GCDUMP ROUTINE +.GLOBAL GODUMP,EGCDUM,EPURIF,ERRKIL,IPURIF + +GODUMP: MOVE PVP,PVSTOR+1 + MOVEM P,PSTO+1(PVP) ; SAVE P + MOVE P,GCPDL + PUSH P,AB + PUSHJ P,INFSU1 ; SET UP INFERIORS + +; MARK PHASE + SETZM PURMNG ; INITIALIZE FLAG INDICATING IF PURIFIED PAGES + ; WERE MUNGED + MOVEI 0,HIBOT ; SET UP NEW PURBOT TO CONVINCE THE GARBAGE COLLECTOR + ; TO COLLECT PURIFIED STRUCTURES + EXCH 0,PURBOT + MOVEM 0,RPURBT ; SAVE THE OLD PURBOT + MOVEI 0,HIBOT + EXCH 0,GCSTOP + MOVEM 0,RGCSTP ; SAVE THE OLD GCSTOP + POP P,C ; SET UP PTR TO TYPE/VALUE PAIR + MOVE P,A ; GET NEW PDL PTR + SETOM DUMFLG ; FLAG INDICATING IN DUMPER + MOVE A,TYPVEC+1 + MOVEM A,TYPSAV + ADD FPTR,[7,,7] ; ADJUST FOR FIRST STATUS WORDS + PUSHJ P,MARK2 + MOVEI E,FPAG+6 ; SEND OUT PAIR + PUSH P,C ; SAVE C + MOVE C,A + PUSHJ P,ADWD + POP P,C ; RESTORE C + MOVEI E,FPAG+5 + MOVE C,(C) ; SEND OUT UPDATED PTR + PUSHJ P,ADWD + + MOVEI 0,@BOTNEW ; CALCULATE START OF TYPE-TABLE + MOVEM 0,TYPTAB + MOVE 0,RPURBT ; RESTORE PURBOT + MOVEM 0,PURBOT + MOVE 0,RGCSTP ; RESTORE GCSTOP + MOVEM 0,GCSTOP + + +; ROUTINE TO SCAN THE TYPE-VECTOR FOR MARKED TYPE SLOTS AND BUILD A TYPE-TABLE OUT OF +; THEM + + MOVE A,TYPSAV ; GET AOBJN POINTER TO TYPE-VECTOR + MOVEI B,0 ; INITIALIZE TYPE COUNT +TYPLP2: HLRE C,(A) ; GET MARKING + JUMPGE C,TYPLP1 ; IF NOT MARKED DON'T OUTPUT + MOVE C,(A) ; GET FIRST WORD + HRL C,B ; FIX UP SO TYPE-NUMBER REPLACES TYPE-CELL + PUSH P,A + SKIPL FPTR + PUSHJ P,MOVFNT + MOVEM C,FRONT(FPTR) + AOBJN FPTR,.+2 + PUSHJ P,MOVFNT ; EXTEND THE FRONTIER + POP P,A + MOVE C,1(A) ; OUTPUT SECOND WORD + MOVEM C,FRONT(FPTR) + ADD FPTR,[1,,1] +TYPLP1: ADDI B,1 ; INCREMENT TYPE COUNT + ADD A,[2,,2] ; POINT TO NEXT SLOT + JUMPL A,TYPLP2 ; LOOP + +; ROUTINE TO BUILD UP ATOM TABLE USING LPVP CHAIN + + HRRZ F,ABOTN + MOVEI 0,@BOTNEW ; GET CURRENT BEGINNING OF TRANSFER + MOVEM 0,ABOTN ; SAVE IT + PUSHJ P,ALLOGC ; ALLOCATE ROOM FOR ATOMS + MOVSI D,400000 ; SET UP UNMARK BIT +SPOUT: JUMPE LPVP,DPGC4 ; END OF CHAIN + MOVEI F,(LPVP) ; GET COPY OF LPVP + HRRZ LPVP,-1(LPVP) ; LPVP POINTS TO NEXT ON CHAIN + ANDCAM D,(F) ; UNMARK IT + HLRZ C,(F) ; GET LENGTH + HRRZ E,(F) ; POINTER INTO INF + ADD E,ABOTN + SUBI C,2 ; WE'RE NOT SENDING OUT THE VALUE PAIR + HRLM C,(F) ; ADJUSTED LENGTH + MOVE 0,C ; COPY C FOR TRBLKX + SUBI E,(C) ; ADJUST PTRS FOR SENDOUT + SUBI F,-1(C) + PUSHJ P,TRBLKX ; OUT IT GOES + JRST SPOUT + + +; HERE TO SEND OUT DELIMITER INFORMATION +DPGC4: SKIPN INCORF ; SKIP IF TRANSFREING TO UVECTOR IN CORE + JRST CONSTO + SKIPL FPTR ; SEE IF ROOM IN FRONTEIR + PUSHJ P,MOVFNT ; EXTEND FRONTEIR + MOVSI A,.VECT. + MOVEM A,FRONT(FPTR) + AOBJN FPTR,.+2 + PUSHJ P,MOVFNT + MOVEI A,@BOTNEW ; LENGTH + SUBI A,FPAG + HRLM A,FRONT(FPTR) + ADD FPTR,[1,,1] + + +CONSTO: MOVEI E,FPAG + MOVE C,ABOTN ; START OF ATOMS + SUBI C,FPAG+CONADJ ; ADJUSTMENT FOR STARTING ON PAGE ONE + PUSHJ P,ADWD ; OUT IT GOES + MOVEI E,FPAG+1 + MOVEI C,@BOTNEW + SUBI C,FPAG+CONADJ + SKIPE INCORF ; SKIP IF TO CHANNEL + SUBI C,2 ; SUBTRACT FOR DOPE WORDS + PUSHJ P,ADWD + SKIPE INCORF + ADDI C,2 ; RESTORE C TO REAL ABOTN + ADDI C,CONADJ + PUSH P,C + MOVE C,TYPTAB + SUBI C,FPAG+CONADJ + MOVEI E,FPAG+2 ; SEND OUT START OF TYPE TABLE + PUSHJ P,ADWD + ADDI E,1 ; SEND OUT NUMPRI + MOVEI C,NUMPRI + PUSHJ P,ADWD + ADDI E,1 ; SEND OUT NUMSAT + MOVEI C,NUMSAT + PUSHJ P,ADWD + + + +; FINAL CLOSING OF INFERIORS + +DPCLS: PUSH P,PGCNT + PUSHJ P,INFCL1 + POP P,PGCNT + POP P,A ; LENGTH OF CODE + +; RESTORE AC'S + MOVE PVP,PVSTOR+1 + IRP AC,,[P,TP,TB,AB,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + + SETZB M,R + SETZM DUMFLG + SETZM GCDFLG ; ZERO FLAG INDICATING IN DUMPER + SETZM GCFLG ; AND INDICTOR TO INTERRUPT HANDLER THAT AGC IS ON + PUSH P,A + MOVE A,INF2 ; GET POINTER TO PURE MAPPED OUT + PUSHJ P,%GBINT + + POP P,A + JRST EGCDUM + + +ERDP: PUSH P,B + PUSHJ P,INFCLS + PUSHJ P,INFCL1 + SETZM GCFLG + SETZM GPURFL ; PURE FLAG + SETZM DUMFLG + SETZM GCDFLG + POP P,A + +; RESTORE AC'S + MOVE PVP,PVSTOR+1 + IRP AC,,[P,R,M,TP,TB,AB,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + +ERDUMP: PUSH TP,$TATOM + +OFFSET 0 + + PUSH TP,EQUOTE STRUCTURE-CONTAINS-UNDUMPABLE-TYPE + +OFFSET OFFS + + PUSH TP,$TATOM ; PUSH ON PRIMTYPE + PUSH TP,@STBL(A) ; PUSH ON PRIMTYPE + MOVEI A,2 + JRST ERRKIL + +; ALTERNATE ATOM MARKER FOR DUMPER + +DATOMK: SKIPE GPURFL ; SKIP IF NOT IN PURIFIER + JRST PATOMK + CAILE A,0 ; SEE IF ALREADY MARKED + JRST GCRET + PUSH P,A ; SAVE PTR TO ATOM + HLRE B,A ; POINT TO DOPE WORD + SUB A,B ; TO FIRST DOPE WORD + MOVEI A,1(A) ; TO SECOND + PUSH P,A ; SAVE PTR TO DOPE WORD + HLRZ B,(A) ; GET LENGTH AND MARKING + TRZE B,400000 ; TURN OFF BIT AND SKIP IF UNMARKED + JRST DATMK1 + IORM D,(A) ; MARK IT + MOVE 0,ABOTN ; GET CURRENT TOP OF ATOM TABLE + ADDI 0,-2(B) ; PLACE OF DOPE WORD IN TABLE + HRRM 0,(A) ; PUT IN RELOCATION + MOVEM 0,ABOTN ; FIXUP TOP OF TABLE + HRRM LPVP,-1(A) ; FIXUP CHAIN + MOVEI LPVP,(A) + MOVE A,-1(P) ; GET POINTER TO ATOM BACK + HRRZ B,2(A) ; GET OBLIST POINTER + JUMPE B,NOOB ; IF ZERO ON NO OBLIST + CAMG B,VECBOT ; DON'T SKIP IF OFFSET FROM TVP + MOVE B,(B) + HRLI B,-1 +DATMK3: MOVE A,$TOBLS ; SET UP FOR GET + MOVE C,$TATOM + +OFFSET 0 + MOVE D,IMQUOTE OBLIST + +OFFSET OFFS + + PUSH P,TP ; SAVE FPTR + MOVE TP,MAINPR + MOVE TP,TPSTO+1(TP) ; GET TP + PUSHJ P,IGET + POP P,TP ; RESTORE FPTR + MOVE C,-1(P) ; RECOVER PTR TO ATOM + ADDI C,1 ; SET UP TO MARK OBLIST ATOM + MOVSI D,400000 ; RESTORE MARK WORD + +OFFSET 0 + + CAMN B,MQUOTE ROOT + +OFFSET OFFS + + JRST RTSET + MOVEM B,1(C) + MOVEI B,TATOM + PUSHJ P,MARK1 ; MARK IT + MOVEM A,1(C) ; SMASH IN ITS ID +DATMK1: +NOOB: POP P,A ; GET PTR TO DOPE WORD BACK + HRRZ A,(A) ; RETURN ID + SUB P,[1,,1] ; CLEAN OFF STACK + MOVEM A,(P) + JRST GCRET ; EXIT + +; HERE FOR A ROOT ATOM +RTSET: SETOM 1(C) ; INDICATOR OF ROOT ATOM + JRST NOOB ; CONTINUE + + +; INTERNAL PURIFY ROUTINE +; SAVE AC's + +IPURIF: PUSHJ P,PURCLN ; GET RID OF PURE MAPPED + MOVE PVP,PVSTOR+1 + IRP AC,,[P,R,M,TP,TB,AB,FRM] + MOVEM AC,AC!STO"+1(PVP) + TERMIN + + +; HERE TO CREATE INFERIORS AND MARK THE ITEM +PURIT1: MOVE PVP,PVSTOR+1 + MOVEM P,PSTO+1(PVP) ; SAVE P + SETOM GPURFL ; INDICATE PURIFICATION IS TAKING PLACE + MOVE C,AB ; ARG PAIR + MOVEM C,SAVRS1 ; SAV PTR TO PAIR + MOVE P,GCPDL + PUSHJ P,INFSUP ; GET INFERIORS + MOVE P,A ; GET NEW PDL PTR + PUSHJ P,%SAVRP ; SAVE RPMAP TABLE FOR TENEX + MOVE C,SAVRS1 ; SET UP FOR MARKING + MOVE A,(C) ; GET TYPE WORD + MOVEM A,SAVRE2 +PURIT3: PUSH P,C + PUSHJ P,MARK2 +PURIT4: POP P,C ; RESTORE C + ADD C,[2,,2] ; TO NEXT ARG + JUMPL C,PURIT3 + MOVEM A,SAVRES ; SAVE UPDATED POINTER + +; FIX UP IMPURE PART OF ATOM CHAIN + + PUSH P,[0] ; FLAG INDICATING NON PURE SCAN + PUSHJ P,FIXATM + SUB P,[1,,1] ; CLEAN OFF STACK + +; NOW TO GET PURE STORAGE + +PURIT2: MOVEI A,@BOTNEW ; GET BOTNEW + SUBI A,2000-1777 ; START AT PAGE 1 AND ROUND + ANDCMI A,1777 + ASH A,-10. ; TO PAGES + SETZ M, + PUSH P,A + PUSHJ P,PGFIND ; FIND THEM + JUMPL B,LOSLP2 ; LOST GO TO CAUSE AGC + HRRZ 0,BUFGC ;GET BUFFER PAGE + ASH 0,-10. + MOVEI A,(B) ; GET LOWER PORTION OF PAGES + MOVN C,(P) + SUBM A,C ; GET END PAGE + CAIL 0,(A) ; L? LOWER + CAILE 0,(C) ; G? HIGER + JRST NOREMP ; DON'T GET NEW BUFFER + PUSHJ P,%FDBUF ; GET A NEW BUFFER PAGE +NOREMP: MOVN A,(P) ; SET UP AOBJN PTR FOR MAPIN + MOVE C,B ; SAVE B + HRL B,A + HRLZS A + ADDI A,1 + MOVEM B,INF3 ; SAVE PTR FOR PURIFICATION + PUSHJ P,%MPIN1 ; MAP IT INTO PURE + ASH C,10. ; TO WORDS + MOVEM C,MAPUP + SUB P,[1,,1] ; CLEAN OFF STACK + +DONMAP: +; RESTORE AC's + MOVE PVP,PVSTOR+1 + MOVE P,PSTO+1(PVP) ; GET REAL P + PUSH P,LPVP + MOVEI A,@BOTNEW + MOVEM A,NABOTN + + IRP AC,,[M,TP,TB,R,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + MOVE A,INF1 + +; NOW FIX UP POINTERS IN PURE STRUCTURE + MOVE 0,GCSBOT + MOVEM 0,OGCSTP + PUSH P,GCSBOT ; SAVE GCSBOT AND GCSTOP + PUSH P,GCSTOP + MOVE A,MAPUP ; NEW GCSBOT AND TOP TO FOOL GCHACK + MOVEM A,GCSBOT + ADD A,NABOTN + SUBI A,2000 ; ADJUSTMENT FOR START ON PAGE ONE + MOVEM A,GCSTOP + MOVE A,[PUSHJ P,NPRFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHK10 + POP P,GCSTOP + POP P,GCSBOT + +; NOW FIX UP POINTERS TO PURIFIED STRUCTURE + + MOVE A,[PUSHJ P,PURFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + + SETZM GCDFLG + SETZM DUMFLG + SETZM GCFLG + + POP P,LPVP ; GET BACK LPVP + MOVE A,INF1 + PUSHJ P,%KILJB ; KILL IMAGE SAVING INFERIOR + PUSH P,[-1] ; INDICATION OF PURE ATOM SCAN + PUSHJ P,FIXATM + +; SET UP PMAP SO THAT NEW PURE PAGES ARE INDICATED + + MOVE A,INF3 ; GET AOBJN PTR TO PAGES +FIXPMP: HRRZ B,A ; GET A PAGE + IDIVI B,16. ; DIVIDE SO AS TO PT TO PMAP WORD + PUSHJ P,PINIT ; SET UP PARAMETER + LSH D,-1 + TDO E,D ; FIX UP WORD + MOVEM E,PMAPB(B) ; SEND IT BACK + AOBJN A,FIXPMP + + SUB P,[1,,1] + MOVE A,[PUSHJ P,PURTFX] ; FIX UP PURE ATOM POINTERS + MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + +; NOW FIX UP POINTERS IN PURE STRUCTURE + PUSH P,GCSBOT ; SAVE GCSBOT AND GCSTOP + PUSH P,GCSTOP + MOVE A,MAPUP ; NEW GCSBOT AND TOP TO FOOL GCHACK + MOVEM A,GCSBOT + ADD A,NABOTN + SUBI A,2000 ; ADJUSTMENT FOR START ON PAGE ONE + MOVEM A,GCSTOP + MOVE A,[PUSHJ P,PURTFX] + MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHK10 + POP P,GCSTOP + POP P,GCSBOT + +; HERE TO FIX UP ATOMS WITH TYPES HACKED INTO THEIR GROWTH FIELD + + MOVE A,TYPVEC+1 ; GET TYPE VECTOR + MOVEI B,400000 ; TLOSE==0 +TTFIX: HRRZ D,1(A) ; GET ADDR + HLRE C,1(A) + SUB D,C + HRRM B,(D) ; SMASH IT IN +NOTFIX: ADDI B,1 ; NEXT TYPE + ADD A,[2,,2] + JUMPL A,TTFIX + +; NOW CLOSE UP INFERIORS AND RETURN + +PURCLS: MOVE P,[-2000,,MRKPDL] + PUSHJ P,%RSTRP ;RESETORE RPMAP TABLE FOR TENEX + PUSHJ P,INFCLS + + MOVE PVP,PVSTOR+1 + MOVE P,PSTO+1(PVP) ; RESTORE P + MOVE AB,ABSTO+1(PVP) ; RESTORE R + + MOVE A,INF3 ; GET PTR TO PURIFIED STRUCTURE + SKIPN NPRFLG + PUSHJ P,%PURIF ; PURIFY + PUSHJ P,%PURMD + + SETZM GPURFL + JRST EPURIF ; FINISH UP + +NPRFIX: PUSH P,A + PUSH P,B + PUSH P,C + EXCH A,C + PUSHJ P,SAT ; GET STORAGE ALLOCATION TYPE + MOVE C,MAPUP ; FIXUP AMOUNT + SUBI C,FPAG ; ADJUST FOR START ON FIRST PAGE + CAIE A,SLOCR ; DONT HACK TLOCRS + CAIN A,S1WORD ; SKIP IF NOT OF PRIMTYPE WORD + JRST LSTFXP + CAIN A,SCHSTR + JRST STRFXP + CAIN A,SATOM + JRST ATMFXP + CAIN A,SOFFS + JRST OFFFXP ; FIXUP OFFSETS +STRFXQ: HRRZ D,1(B) + JUMPE D,LSTFXP ; SKIP IF NIL + CAMG D,PURTOP ; SEE IF ALREADY PURE + ADDM C,1(B) +LSTFXP: TLNN B,.LIST. ; SKIP IF NOT A PAIR + JRST LSTEX1 + HRRZ D,(B) ; GET REST OF LIST + SKIPE D ; SKIP IF POINTS TO NIL + PUSHJ P,RLISTQ + JRST LSTEX1 + CAMG D,PURTOP ; SKIP IF ALREADY PURE + ADDM C,(B) ; FIX UP LIST +LSTEX1: POP P,C + POP P,B ; RESTORE GCHACK AC'S + POP P,A + POPJ P, + +OFFFXP: HLRZ 0,D ; POINT TO LIST + JUMPE 0,LSTFXP ; POINTS TO NIL + CAML 0,PURTOP ; ALREADY PURE? + JRST LSTFXP ; YES + ADD 0,C ; UPDATE THE POINTER + HRLM 0,1(B) ; STUFF IT OUT + JRST LSTFXP ; DONE + +STRFXP: TLZN D,STATM ; SKIP IF REALLY ATOM + JRST STRFXQ + MOVEM D,1(B) + PUSH P,C + MOVE C,B ; GET ARG FOR BYTDOP + PUSHJ P,BYTDOP + POP P,C + MOVEI D,-1(A) + JRST ATMFXQ + +ATMFXP: HLRE 0,D ; GET LENGTH + SUB D,0 ; POINT TO FIRST DOPE WORD + HRRZS D +ATMFXQ: CAML D,OGCSTP + CAIL D,HIBOT ; SKIP IF IMPURE + JRST LSTFXP + HRRZ 0,1(D) ; GET RELOCATION + SUBI 0,1(D) + ADDM 0,1(B) ; FIX UP PTR IN STRUCTURE + JRST LSTFXP + +; FIXUP OF PURE ATOM POINTERS + +PURTFX: CAIE C,TATOM ; SKIP IF ATOM POINTER + JRST PURSFX + HLRE E,D ; GET TO DOPE WORD + SUBM D,E +PURSF1: SKIPL 1(E) ; SKIP IF MARKED + POPJ P, + HRRZ 0,1(E) ; RELATAVIZE PTR + SUBI 0,1(E) + ADD D,0 ; FIX UP PASSED POINTER + SKIPE B ; AND IF APPROPRIATE MUNG POINTER + ADDM 0,1(B) ; FIX UP POINTER + POPJ P, + +PURSFX: CAIE C,TCHSTR + POPJ P, + MOVE C,B ; GET ARG FOR BYTDOP + PUSHJ P,BYTDOP + GETYP 0,-1(A) + MOVEI E,-1(A) + MOVE A,[PUSHJ P,PURTFX] + CAIE 0,SATOM + POPJ P, + JRST PURSF1 + +PURFIX: PUSH P,D + PUSH P,A + PUSH P,B + PUSH P,C ; SAVE AC'S FOR GCHACK + EXCH A,C ; GET TYPE IN A + CAIN A,TATOM ; CHECK FOR ATOM + JRST ATPFX + PUSHJ P,SAT + + CAILE A,NUMSAT ; SKIP IF TEMPLATE + JRST TLFX +IFN ITS, JRST @PURDSP(A) +IFE ITS,[ + HRRZ 0,PURDSP(A) + HRLI 0,400000 + JRST @0 +] +PURDSP: + +OFFSET 0 + +DISTBS DUM1,TLFX,[[S2WORD,LPLSTF],[S2DEFR,LPLSTF],[SNWORD,VECFX], +[S2NWORD,VECFX],[SSTORE,VECFX],[SBYTE,STRFX],[SATOM,ATPFX],[SLOCB,STRFX] +[SCHSTR,STRFX],[SLOCL,LPLSTF],[SLOCV,VECFX],[SLOCU,VECFX],[SLOCS,VECFX],[SOFFS,OFFSFX]] + +OFFSET OFFS + +VECFX: HLRE 0,D ; GET LENGTH + SUB D,0 ; POINT TO D.W. + SKIPL 1(D) ; SKIP IF MARKED + JRST TLFX + HRRZ C,1(D) + SUBI C,1(D) ; CALCULATE RELOCATION + ADD C,MAPUP ; ADJUSTMENT + SUBI C,FPAG + ADDM C,1(B) +TLFX: TLNN B,.LIST. ; SEE IF PAIR + JRST LVPUR ; LEAVE IF NOT + PUSHJ P,RLISTQ + JRST LVPUR + HRRZ D,(B) ; GET CDR + SKIPN D ; SKIP IF NOT ZERO + JRST LVPUR + MOVE D,(D) ; GET CADR + SKIPL D ; SKIP IF MARKED + JRST LVPUR + ADD D,MAPUP + SUBI D,FPAG + HRRM D,(B) ; FIX UP +LVPUR: POP P,C + POP P,B + POP P,A + POP P,D + POPJ P, + +STRFX: MOVE C,B ; GET ARG FOR BYTDOP + PUSHJ P,BYTDOP + SKIPL (A) ; SKIP IF MARKED + JRST TLFX + GETYP 0,-1(A) + MOVE D,1(B) + MOVEI C,-1(A) + CAIN 0,SATOM ; REALLY ATOM? + JRST ATPFX1 + HRRZ 0,(A) ; GET PTR IN NEW STRUCTURE + SUBI 0,(A) ; RELATAVIZE + ADD 0,MAPUP ; ADJUST + SUBI 0,FPAG + ADDM 0,1(B) ; FIX UP PTR + JRST TLFX + +ATPFX: HLRE C,D + SUBM D,C + SKIPL 1(C) ; SKIP IF MARKED + JRST TLFX +ATPFX1: HRRZS C ; SEE IF PURE + CAIL C,HIBOT ; SKIP IF NOT PURE + JRST TLFX + HRRZ 0,1(C) ; GET PTR TO NEW ATOM + SUBI 0,1(C) ; RELATAVIZE + ADD D,0 + JUMPE B,TLFX + ADDM 0,1(B) ; FIX UP + JRST TLFX + +LPLSTF: SKIPN D ; SKIP IF NOT PTR TO NIL + JRST TLFX + SKIPL (D) ; SKIP IF MARKED + JRST TLFX + HRRZ D,(D) ; GET UPDATED POINTER + ADD D,MAPUP ; ADJUSTMENT + SUBI D,FPAG + HRRM D,1(B) + JRST TLFX + +OFFSFX: HLRZS D ; LIST POINTER + JUMPE D,TLFX ; NIL + SKIPL (D) ; MARKED? + JRST TLFX ; NO + ADD D,MAPUP + SUBI D,FPAG ; ADJUST + HRLM D,1(B) + JRST TLFX ; RETURN + +; ROUTINES TO CAUSE A GARBAGE COLLECT WHEN EFFORTS TO GET STORAGE FAIL + +LOSLP1: MOVE A,ABOTN + MOVEM A,PARNEW ; SET UP GC PARAMS + MOVE C,[12.,,6] + JRST PURLOS + +LOSLP2: MOVEI A,@BOTNEW ; TOTAL AMOUNT NEEDED + ADDI A,1777 + ANDCMI A,1777 ; CALCULATE PURE PAGES NEEDED + MOVEM A,GCDOWN + MOVE C,[12.,,8.] + JRST PURLOS + +PURLOS: MOVE P,[-2000,,MRKPDL] + PUSH P,GCDOWN + PUSH P,PARNEW + MOVE R,C ; GET A COPY OF A + PUSHJ P,INFCLS ; CLOSE INFERIORS AND FIX UP WORLD + PUSHJ P,INFCL2 +PURLS1: POP P,PARNEW + POP P,GCDOWN + MOVE C,R + +; RESTORE AC'S + MOVE PVP,PVSTOR+1 + IRP AC,,[P,R,M,TP,TB,AB,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + + SETZM GCDFLG ; ZERO OUT FLAGS + SETZM DUMFLG + SETZM GPURFL + SETZM GCDANG + + PUSHJ P,AGC ; GARBAGE COLLECT + JRST PURIT1 ; TRY AGAIN + +; PURIFIER ATOM MARKER + +PATOMK: HRRZ 0,A + CAMG 0,PARBOT + JRST GCRET ; DONE IF FROZEN + HLRE B,A ; GET TO D.W. + SUB A,B + SKIPG 1(A) ; SKIP IF NOT MARKED + JRST GCRET + HLRZ B,1(A) + IORM D,1(A) ; MARK THE ATOM + ADDM B,ABOTN + HRRM LPVP,(A) ; LINK ONTO CHAIN + MOVEI LPVP,1(A) + JRST GCRET ; EXIT + + +.GLOBAL %LDRDO,%MPRDO + +; ROUTINES TO ALLOW GC-DUMPING OF PURIFIED STRUCTURES. + +; PROPUR MAPS PAGES CONTAINING PURIFIED STUFF INTO THE AGD INFERIOR SO THAT IN CASE +; THE PAGES ARE MUNGED THEY CAN BE RESTORED USING MAPPING + +; REPURE REMAPS ANY PAGES THAT WERE MUNGED BY GC-DUMP BY RELOADING THEM FROM THE AGD +; INFERIOR IN READ/EXEC MODE + +REPURE: PUSH P,[PUSHJ P,%LDRDO] ; INSTRUCTION FOR MAPPING IN PAGES FROM AGD INF + SKIPA +PROPUR: PUSH P,[PUSHJ P,%MPRDO] ; INSTRUCTION FOR MAPPING PAGES TO AGD INF + MOVE A,PURBOT ; GET STARTING PAGE OF PURENESS + ASH A,-10. ; CONVERT TO PAGES + MOVEI C,HIBOT ; GET ENDING PAGE + ASH C,-10. ; CONVERT TO PAGES + PUSH P,A ; SAVE PAGE POINTER + PUSH P,C ; SAVE END OF PURENESS POINTER +PROLOP: CAML A,(P) ; SKIP IF STILL PURE PAGES TO CHECK + JRST PRODON ; DONE MAPPING PAGES + PUSHJ P,CHKPGI ; SKIP IF PAGE IS PURE + JRST NOTPUR ; IT IS NOT + MOVE A,-1(P) ; GET PAGE TO MAP + XCT -2(P) ; MAP IN/OUT TO AGD INFERIOR IN READ/EXEC MODE +NOTPUR: AOS A,-1(P) ; INCREMENT PAGE POINTER AND LOAD + JRST PROLOP ; LOOP BACK +PRODON: SUB P,[3,,3] ; CLEAN OFF STACK + POPJ P, ; EXIT + + + +.GLOBAL %SAVIN,STOSTR,%CLMP1,%IMSAV,%IMSV1,ILOOKC,PSHGCF,BSETG,%GCJB1 +.GLOBAL %CLSJB,%KILJB,%IFMP1,%OPGFX,%FDBUF +INFSU1: PUSH P,[-1] ; ENTRY USED BY GC-DUMP + SKIPA +INFSUP: PUSH P,[0] + MOVE A,GLOTOP+1 ; GET GLOTOP FOR LOCR HACKS + MOVEM A,GLTOP + PUSHJ P,%FDBUF ; GET A BUFFER FOR C/W HACKS + SETOM GCDFLG + SETOM GCFLG + HLLZS SQUPNT + HRRZ TYPNT,TYPVEC+1 ; SETUP TYPNT + HRLI TYPNT,B + MOVEI A,STOSTR + ANDCMI A,1777 ; TO PAGE BOUNDRY + SUB A,GCSTOP ; SET UP AOBJN POINTER FOR C/W HACK + ASH A,-10. ; TO PAGES + HRLZS A + MOVEI B,STOSTR ; GET START OF MAPPING + ASH B,-10. + ADDI A,(B) + MOVEM A,INF1 + PUSHJ P,%SAVIN ; PROTECT THE CORE IMAGE + SKIPGE (P) ; IF < 0 GC-DUMP CALL + PUSHJ P,PROPUR ; PROTECT PURE PAGES + SUB P,[1,,1] ; CLEAN OFF PSTACK + PUSHJ P,%CLSJB ; CLOSE INFERIOR + + MOVSI D,400000 ; CREATE MARK WORD + SETZB LPVP,ABOTN ; ZERO ATOM COUNTER + MOVEI A,2000 ; MARKED INF STARTS AT PAGE ONE + HRRM A,BOTNEW + SETZM WNDBOT + SETZM WNDTOP + HRRZM A,FNTBOT + ADDI A,2000 ; WNDTOP + MOVEI A,1 ; TO PAGES + PUSHJ P,%GCJB1 ; CREATE THE JOB + MOVSI FPTR,-2000 + MOVEI A,LPUR ; SAVE THE PURE CORE IMAGE + ANDCMI A,1777 ; TO PAGE BOUNDRY + MOVE 0,A ; COPY TO 0 + ASH 0,-10. ; TO PAGES + SUB A,HITOP ; SUBTRACT TOP OF CORE + ASH A,-10. + HRLZS A + ADD A,0 + MOVEM A,INF2 + PUSHJ P,%IMSV1 ; MAP OUT INTERPRETER + PUSHJ P,%OPGFX + +; CREATE A PDL TO USE FOR THESE DUMPING FUNCTIONS + + MOVE A,[-2000,,MRKPDL] + POPJ P, + +; ROUTINE TO CLOSE GC's INFERIOR + + +INFCLS: MOVE A,INF2 ; GET POINTER TO PURE MAPPED OUT + PUSHJ P,%CLSMP + POPJ P, + +; CLOSE INFERIOR PROTECTING CORE IMAGE FOR GCDUMP + +INFCL2: PUSHJ P,%IFMP1 ; OPEN AGD INF TO RESTORE PAGES +INFCL3: MOVE A,INF1 ; RESTORE OPENING POINTER + PUSH P,INF2 + MOVE B,A ; SATIFY MUDITS + PUSHJ P,%IFMP2 ; MAP IN GC PAGES AND CLOSE INFERIOR + POP P,INF2 ; RESTOR INF2 PARAMETER + POPJ P, + +INFCL1: PUSHJ P,%IFMP1 ; OPEN AGD INF TO RESTORE PAGES + SKIPGE PURMNG ; SKIP IF NO PURE PAGES WERE MUNGED + PUSHJ P,REPURE ; REPURIFY MUNGED PAGES + JRST INFCL3 + + + +; ROUTINE TO DO TYPE HACKING FOR GC-DUMP. IT MARKS THE TYPE-WORD OF THE +; SLOT IN THE TYPE VECTOR. IT ALSO MARKS THE ATOM REPLACING THE I.D. IN +; THE RIGHT HALF OF THE ATOM SLOT. IF THE TYPE IS A TEMPLATE THE FIRST +; USE OF THE SAT HAS ITS ATOM MARKED AND THE I.D. IS PLACED IN THE LEFT +; HALF OF THE ATOM SLOT (IT GETS THE REAL PRIMTYPE). + +TYPHK: CAILE B,NUMPRI ; SKIP IF A MUDDLE TYPE + JRST TYPHKR ; ITS A NEWTYPE SO GO TO TYPHACKER + CAIN B,TTYPEC ; SKIP IF NOT TYPE-C + JRST TYPCHK ; GO TO HACK TYPE-C + CAIE B,TTYPEW ; SKIP IF TYPE-W + POPJ P, + PUSH P,B + HLRZ B,A ; GET TYPE + JRST TYPHKA ; GO TO TYPE-HACKER +TYPCHK: PUSH P,B ; SAVE TYPE-WORD + HRRZ B,A + JRST TYPHKA + +; GENERAL TYPE-HACKER FOR GC-DUMP + +TYPHKR: PUSH P,B ; SAVE AC'S +TYPHKA: PUSH P,A + PUSH P,C + LSH B,1 ; GET OFFSET TO SLOT IN TYPE VECTOR + MOVEI C,(TYPNT) ; GET TO SLOT + ADDI C,(B) + SKIPGE (C) + JRST EXTYP + IORM D,(C) ; MARK THE SLOT + MOVEI B,TATOM ; NOW MARK THE ATOM SLOT + PUSHJ P,MARK1 ; MARK IT + HRRM A,1(C) ; SMASH IN ID + HRRZS 1(C) ; MAKE SURE THAT THATS ALL THATS THERE + HRRZ B,(C) ; GET SAT + ANDI B,SATMSK ; GET RID OF MAGIC BITS + HRRM B,(C) ; SMASH SAT BACK IN + CAIG B,NUMSAT ; SKIP IF TEMPLATE + JRST EXTYP + MOVE A,TYPSAV ; GET POINTER TO TYPE VECTOR + ADDI A,NUMPRI*2 ; GET TO NEWTYPES SLOTS + HRLI 0,NUMPRI*2 + HLLZS 0 ; MAKE SURE ONLY LEFT HALF + ADD A,0 +TYPHK1: HRRZ E,(A) ; GET SAT OF SLOT + CAMN E,B ; SKIP IF NOT EQUAL + JRST TYPHK2 ; GOT IT + ADDI A,2 ; TO NEXT + JRST TYPHK1 +TYPHK2: PUSH P,C ; SAVE POINTER TO ORIGINAL SLOT + MOVE C,A ; COPY A + MOVEI B,TATOM ; SET UP FOR MARK + MOVE A,1(C) ; ASSUME MARK DOESN'T HAVE TO TAKE PLACE + SKIPL (C) ; DON'T MARK IF ALREADY MARKED + PUSHJ P,MARK + POP P,C ; RESTORE C + HRLM A,1(C) ; SMASH IN PRIMTYPE OF TEMPLATE +EXTYP: POP P,C ; RESTORE AC'S + POP P,A + POP P,B + POPJ P, ; EXIT + + +; A ROUTINE TO DISTINGUISH BETWEEN A DEFERRED AND A LIST POINTER +RLISTQ: PUSH P,A + GETYP A,(B) ; GET TYPE + PUSHJ P,SAT ; GET SAT + CAIG A,NUMSAT ; NOT DEFERRED IF TEMPLATE + SKIPL MKTBS(A) + AOS -1(P) ; SKIP IF NOT DEFFERED + POP P,A + POPJ P, ; EXIT + + +; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED) + +GCDISP: + +OFFSET 0 + +DISTBS DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK],[STBASE,ERDP] +[STPSTK,ERDP],[SARGS,ERDP],[S2NWORD,VECTMK],[SPSTK,ERDP],[SSTORE,VECTMK] +[SFRAME,ERDP],[SBYTE,],[SATOM,DATOMK],[SPVP,ERDP],[SGATOM,ERDP] +[SLOCID,ERDP],[SCHSTR,],[SASOC,ERDP],[SLOCL,PAIRMK],[SABASE,ERDP] +[SLOCA,ERDP],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,],[SLOCN,ERDP] +[SLOCB,],[SLOCR,LOCRDP],[SOFFS,OFFSMK]] + +OFFSET OFFS + + +; THIS SUBROUTINE IMPURIFIES A PURE ATOM TO ALLOW MODIFICATION OF SYSTEM SUBRS + +IMPRF: PUSH P,A + PUSH P,LPVP + PUSH TP,$TATOM + HLRZ C,(A) ; GET LENGTH + TRZ C,400000 ; TURN OF 400000 BIT + SUBI A,-1(C) ; POINT TO START OF ATOM + MOVNI C,-2(C) ; MAKE IT LOOK LIKE AN ATOM POINTER + HRL A,C + PUSH TP,A + MOVE C,A + MOVEI 0,(C) + PUSH P,AB + MOVE PVP,PVSTOR+1 + MOVE AB,ABSTO+1(PVP) + PUSHJ P,IMPURX + POP P,AB + POP P,LPVP ; RESTORE A + POP P,A + POPJ P, + +FIXATM: PUSH P,[0] +FIXTM5: JUMPE LPVP,FIXTM4 + MOVEI B,(LPVP) ; GET PTR TO ATOMS DOPE WORD + HRRZ LPVP,-1(B) ; SET UP LPVP FOR NEXT IN CHAIN + SKIPE -2(P) ; SEE IF PURE SCAN + JRST FIXTM2 + CAIL B,HIBOT + JRST FIXTM3 +FIXTM2: CAMG B,PARBOT ; SKIP IF NOT FROZEN + JRST FIXTM1 + HLRZ A,(B) + TRZ A,400000 ; GET RID OF MARK BIT + MOVE D,A ; GET A COPY OF LENGTH + SKIPE -2(P) + JRST PFATM + PUSHJ P,CAFREE ; GET STORAGE + SKIPE GCDANG ; SEE IF WON + JRST LOSLP1 ; GO TO CAUSE GC + JRST FIXT10 +PFATM: PUSH P,AB + MOVE PVP,PVSTOR+1 + MOVE AB,ABSTO+1(PVP) + SETZM GPURFL + PUSHJ P,CAFREE + SETOM GPURFL + POP P,AB +FIXT10: SUBM D,ABOTN + MOVNS ABOTN + SUBI B,-1(D) ; POINT TO START OF ATOM + HRLZ C,B ; SET UP FOR BLT + HRRI C,(A) + ADDI A,-1(D) ; FIX UP TO POINT TO NEW DOPE WORD + BLT C,(A) + HLLZS -1(A) + HLLOS (A) ; -1 IN RELOCATION FIELD SINCE ITS NOT GARBAGE + ADDI B,-1(D) ; B POINTS TO SECOND D.W. + HRRM A,(B) ; PUT IN RELOCATION + MOVSI D,400000 ; UNMARK ATOM + ANDCAM D,(A) + CAIL B,HIBOT ; SKIP IF IMPURE + PUSHJ P,IMPRF + JRST FIXTM5 ; CONTINE FIXUP + +FIXTM4: POP P,LPVP ; FIX UP LPVP TO POINT TO NEW CHAIN + POPJ P, ; EXIT + +FIXTM1: HRRM B,(B) ; SMASH IN RELOCATION + MOVSI D,400000 + ANDCAM D,(B) ; CLEAR MARK BIT + JRST FIXTM5 + +FIXTM3: MOVE 0,(P) + HRRM 0,-1(B) + MOVEM B,(P) ; FIX UP CHAIN + JRST FIXTM5 + + + +IAGC": + +;SET FLAG FOR INTERRUPT HANDLER + SETZB M,RCL ; CLEAR OUT RECYCLE LIST CELLS, AND RSUBR BASE PNTR + EXCH P,GCPDL ; IN CASE CURRENT PDL LOSES + PUSH P,B + PUSH P,A + PUSH P,C ; SAVE C + +; HERE TO CLEAN UP ANY POSSIBLE PURENESS IN GC SPACE BEFORE COLLECTING + + + + MOVE A,NOWFRE + ADD A,GCSTOP ; ADJUSTMENT TO KEEP FREE REAL + SUB A,FRETOP + MOVEM A,NOWFRE + MOVE A,NOWP ; ADJUSTMENTS FOR STACKS + SUB A,CURP + MOVEM A,NOWP + MOVE A,NOWTP + SUB A,CURTP + MOVEM A,NOWTP + + MOVEI B,[ASCIZ /GIN /] + SKIPE GCMONF ; MONITORING + PUSHJ P,MSGTYP +NOMON1: HRRZ C,(P) ; GET CAUSE OF GC INDICATOR + MOVE B,GCNO(C) ; ADD 1 TO COUNT OF GC'S CAUSED BY GIVEN REASON + ADDI B,1 + MOVEM B,GCNO(C) + MOVEM C,GCCAUS ; SAVE CAUSE OF GC + SKIPN GCMONF ; MONITORING + JRST NOMON2 + MOVE B,MSGGCT(C) ; GET CAUSE MESSAGE + PUSHJ P,MSGTYP +NOMON2: HLRZ C,(P) ; FIND OUT WHO CAUSED THE GC + MOVEM C,GCCALL ; SAVE CALLER OF GC + SKIPN GCMONF ; MONITORING + JRST NOMON3 + MOVE B,MSGGFT(C) + PUSHJ P,MSGTYP +NOMON3: SUB P,[1,,1] ; POP OFF C + POP P,A + POP P,B + EXCH P,GCPDL + JRST .+1 +IAAGC: + HLLZS SQUPNT ; FLUSH SQUOZE TABLE + SETZB M,RCL ; ALTERNATE GC-ENTRY POINT FOR INITIALIZATION +INITGC: SETOM GCFLG + SETZM RCLV + +;SAVE AC'S + EXCH PVP,PVSTOR+1 + IRP AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM] + MOVEM AC,AC!STO"+1(PVP) + TERMIN + + MOVE 0,PVSTOR+1 + MOVEM 0,PVPSTO+1(PVP) + MOVEM PVP,PVSTOR+1 + MOVE D,DSTORE + MOVEM D,DSTO(PVP) + JSP E,CKPUR ; CHECK FOR PURE RSUBR + + +;SET UP E TO POINT TO TYPE VECTOR + GETYP E,TYPVEC + CAIE E,TVEC + JRST AGCE1 + HRRZ TYPNT,TYPVEC+1 + HRLI TYPNT,B + +CHPDL: MOVE D,P ; SAVE FOR LATER +CORGET: MOVE P,[-2000,,MRKPDL] + +;FENCE POST PDLS AND CHECK IF ANY SHOULD BE SHRUNK + + MOVEI A,(TB) ;POINT TO CURRENT FRAME IN PROCESS + PUSHJ P,FRMUNG ;AND MUNG IT + MOVE A,TP ;THEN TEMPORARY PDL + PUSHJ P,PDLCHK + MOVE PVP,PVSTOR+1 + MOVE A,PSTO+1(PVP) ;AND UNMARKED P STACK + PUSHJ P,PDLCHP + + ; FIRST CREATE INFERIOR TO HOLD NEW PAGES + +INFCRT: MOVE A,PARBOT ; GENERATE NEW PARBOT AND PARNEW + ADD A,PARNEW + ADDI A,1777 + ANDCMI A,1777 ; EVEN PAGE BOUNDARY + HRRM A,BOTNEW ; INTO POINTER WORD + HRRZM A,FNTBOT + SETZM WNDBOT + SETZM WNDTOP + MOVEM A,NPARBO + HRRZ A,BOTNEW ; GET PAGE TO START INF AT + ASH A,-10. ; TO PAGES + MOVEI R,(A) ; COPY A + PUSHJ P,%GCJOB ; GET PAGE HOLDER + MOVSI FPTR,-2000 ; FIX UP FRONTIER POINTER + MOVE A,WNDBOT + ADDI A,2000 ; FIND WNDTOP + MOVEM A,WNDTOP + +;MARK PHASE: MARK ALL LISTS AND VECTORS +;POINTED TO WITH ONE BIT IN SIGN BIT +;START AT TRANSFER VECTOR +NOMAP: MOVE A,GLOBSP+1 ; GET GLOBSP TO SAVE + MOVEM A,GCGBSP + MOVE A,ASOVEC+1 ; ALSO SAVE FOR USE BY GC + MOVEM A,GCASOV + MOVE A,NODES+1 ; SAVE FOR ASSOCIATION UPDATE AND MOVEMENT PHASE + MOVEM A,GCNOD + MOVE A,GLOTOP+1 ; GET GLOTOP FOR LOCR HACKS + MOVEM A,GLTOP + MOVE A,PURVEC+1 ; SAVE PURE VECTOR FOR GETPAG + MOVEM A,PURSVT + MOVE A,HASHTB+1 + MOVEM A,GCHSHT + + SETZ LPVP, ;CLEAR NUMBER OF PAIRS + MOVE 0,NGCS ; SEE IF NEED HAIR + SOSGE GCHAIR + MOVEM 0,GCHAIR ; RESUME COUNTING + MOVSI D,400000 ;SIGN BIT FOR MARKING + MOVE A,ASOVEC+1 ;MARK ASSOC. VECTOR NOW + PUSHJ P,PRMRK ; PRE-MARK + MOVE A,GLOBSP+1 + PUSHJ P,PRMRK + MOVE A,HASHTB+1 + PUSHJ P,PRMRK +OFFSET 0 + + MOVE A,IMQUOTE THIS-PROCESS + +OFFSET OFFS + + MOVEM A,GCATM + +; HAIR TO DO AUTO CHANNEL CLOSE + + MOVEI 0,N.CHNS-1 ; NUMBER OF CHANNELS + MOVEI A,CHNL1 ; 1ST SLOT + + SKIPE 1(A) ; NOW A CHANNEL? + SETZM (A) ; DON'T MARK AS CHANNELS + ADDI A,2 + SOJG 0,.-3 + + MOVEI C,PVSTOR + MOVEI B,TPVP + MOVE A,PVSTOR+1 ; MARK MAIN PROCES EVEN IF SWAPPED OUT + PUSHJ P,MARK + MOVEI C,MAINPR-1 + MOVEI B,TPVP + MOVE A,MAINPR ; MARK MAIN PROCES EVEN IF SWAPPED OUT + PUSHJ P,MARK + MOVEM A,MAINPR ; ADJUST PTR + +; ASSOCIATION AND VALUE FLUSHING PHASE + + SKIPN GCHAIR ; ONLY IF HAIR + PUSHJ P,VALFLS + + SKIPN GCHAIR + PUSHJ P,ATCLEA ; CLEAN UP ATOM TABLE + + SKIPE GCHAIR ; IF NOT HAIR, DO CHANNELS NOW + PUSHJ P,CHNFLS + + PUSHJ P,ASSOUP ; UPDATE AND MOVE ASSOCIATIONS + PUSHJ P,CHFIX ; SEND OUT CHANNELS AND MARK LOSERS + PUSHJ P,STOGC ; FIX UP FROZEN WORLD + MOVE P,GCPDL ; SWITCH PDLS IN CASE THIS ONE DISSAPPEARS + + + MOVE A,NPARBO ; UPDATE GCSBOT + MOVEM A,GCSBOT + MOVE A,PURSVT + PUSH P,PURVEC+1 + MOVEM A,PURVEC+1 ; RESTORE PURVEC + PUSHJ P,CORADJ ; ADJUST CORE SIZE + POP P,PURVEC+1 + + + + ; MAP NEW PAIR SPACE IN FOR PAIR SPACE UPDATE + +NOMAP1: MOVEI A,@BOTNEW + ADDI A,1777 ; TO PAGE BOUNDRY + ANDCMI A,1777 + MOVE B,A +DOMAP: ASH B,-10. ; TO PAGES + MOVE A,PARBOT + MOVEI C,(A) ; COMPUTE HIS TOP + ASH C,-10. + ASH A,-10. + SUBM A,B ; B==> - # OF PAGES + HRLI A,(B) ; AOBJN TO SOURCE AND DEST + MOVE B,A ; IN CASE OF FUNNY + HRRI B,(C) ; MAP HIS POSSIBLE HIGHER OR LOWER PAGES + PUSHJ P,%INFMP ; NOW FLUSH INF AND MAKE HIS CORE MINE + JRST GARZER + + ; CORE ADJUSTMENT PHASE + +CORADJ: MOVE A,PURTOP + SUB A,CURPLN ; ADJUST FOR RSUBR + ANDCMI A,1777 ; ROUND DOWN + MOVEM A,RPTOP + MOVEI A,@BOTNEW ; NEW GCSTOP + ADDI A,1777 ; GCPDL AND ROUND + ANDCMI A,1777 ; TO PAGE BOUNDRY + MOVEM A,CORTOP ; TAKE CARE OF POSSIBLE LATER LOSSAGE + CAMLE A,RPTOP ; SEE IF WE CAN MAP THE WORLD BACK IN + FATAL AGC--UNABLE TO MAP GC-SPACE INTO CORE + CAMG A,PURBOT ; SEE IF WE HAVE TO PUNT SOME PURE TO DO IT + JRST CORAD0 ; DON'T HAVE TO PUNT SOME PURE + PUSHJ P,MAPOUT ; GET THE CORE + FATAL AGC--PAGES NOT AVAILABLE + +; NOW THAT WE ARE ABLE TO MAP TO GCS INTO CORE WE WILL TRY TO HONOR SOME REQUESTS +; FIRST LETS SEE IF WE HAVE TO CORE DOWN. +; GCDOWN IS DEFINED AS AMOUNT FROM FRETOP TO PURBOT NEEDED + +CORAD0: SKIPN B,GCDOWN ; CORE DOWN? + JRST CORAD1 ; NO, LETS GET CORE REQUIREMENTS + ADDI A,(B) ; AMOUNT+ONE FREE BLOCK + CAMGE A,RPTOP ; CAN WE WIN + JRST CORAD3 ; POSSIBLY + +; THIS IS A EXIT FOR LOSSAGE WITHOUT A FATAL ERROR +CORAD2: SETOM GCDANG ; INDICATE LOSSAGE + +; CALCULATE PARAMETERS BEFORE LEAVING +CORAD6: MOVE A,PURSVT ; GET PURE TABLE + PUSHJ P,SPCOUT ; OUT IT GOES IN CASE IT WAS CHANGED + MOVEI A,@BOTNEW ; GCSTOP + MOVEM A,GCSTOP + MOVE A,CORTOP ; ADJUST CORE IMAGE + ASH A,-10. ; TO PAGES +TRYPCO: PUSHJ P,P.CORE + FATAL AGC--CORE SCREW UP + MOVE A,CORTOP ; GET IT BACK + ANDCMI A,1777 + MOVEM A,FRETOP + MOVEM A,RFRETP + POPJ P, + +; TRIES TO SATISFY REQUEST FOR CORE +CORAD1: MOVEM A,CORTOP + MOVEI A,@BOTNEW + ADD A,GETNUM ; ADD MINIMUM CORE NEEDED + ADDI A,1777 ; ONE BLOCK+ROUND + ANDCMI A,1777 ; TO BLOCK BOUNDRY + CAMLE A,RPTOP ; CAN WE WIN + JRST CORAD2 ; LOSE + CAMGE A,PURBOT + JRST CORAD7 ; DON'T HAVE TO MAP OUT PURE + PUSHJ P,MAPOUT + JRST CORAD2 ; LOSS + +; NOW TRY TO GET SLOP SPACE. NOT NECESSARY BUT NICE +CORAD7: MOVEM A,CORTOP ; STORE POSSIBLE VALUE + MOVE B,RPTOP ; GET REAL PURTOP + SUB B,PURMIN ; KEEP PURMIN + CAMG B,CORTOP ; SEE IF CORTOP IS ALREADY HIGH + MOVE B,CORTOP ; DONT GIVE BACK WHAT WE GOT + MOVEM B,RPTOP ; FOOL CORE HACKING + ADD A,FREMIN + ANDCMI A,1777 ; TO PAGE BOUNDRY + CAMGE A,RPTOP ; DO WE WIN TOTALLY + JRST CORAD4 + MOVE A,RPTOP ; GET AS MUCH CORE AS POSSIBLE + PUSHJ P,MAPOUT + JRST CORAD6 ; LOSE, BUT YOU CAN'T HAVE EVERYTHING +CORAD4: CAMG A,PURBOT ; DO WE HAVE TO PUNT SOME PURE + JRST CORAD8 + PUSHJ P,MAPOUT ; GET IT + JRST CORAD6 +CORAD8: MOVEM A,CORTOP ; ADJUST PARAMETER + JRST CORAD6 ; WIN TOTALLY + +; WE CAN CORE DOWN NOW TO SEE IF WE CAN GET SOME SLOP SPACE + +CORAD3: ADD A,FREMIN + ANDCMI A,1777 + CAMGE A,PURBOT ; CAN WE WIN + JRST CORAD9 + MOVE A,RPTOP +CORAD9: SUB A,GCDOWN ; SATISFY GCDOWN REQUEST + JRST CORAD4 ; GO CHECK ALLOCATION + +MAPOUT: PUSH P,A ; SAVE A + SUB A,P.TOP ; AMOUNT TO GET + ADDI A,1777 ; ROUND + ANDCMI A,1777 ; TO PAGE BOUNDRY + ASH A,-PGSZ ; TO PAGES + PUSHJ P,GETPAG ; GET THEN + JRST MAPLOS ; LOSSAGE + AOS -1(P) ; INDICATE WINNAGE +MAPLOS: POP P,A + POPJ P, + + + ;GARBAGE ZEROING PHASE +GARZER: MOVE A,GCSTOP ;FIRST WORD OF GARBAGE IS AFTER PAIR SPACE + MOVE B,FRETOP ;LAST ADDRESS OF GARBAGE + 1 + CAIL A,(B) + JRST GARZR1 + CLEARM (A) ;ZERO THE FIRST WORD + CAIL A,-1(B) ; ARE WE AT THE TOP OF THE WORLD (FORMERLY CAML A,FRETOP) + JRST GARZR1 ; DON'T BLT +IFE ITS,[ + MOVEI B,777(A) + ANDCMI B,777 +] + HRLS A + ADDI A,1 ;MAKE A A BLT POINTER + BLT A,-1(B) ;AND COPY ZEROES INTO REST OF AREA +IFE ITS,[ + +; MAP UNWANTED PAGES OUT ON TWENEX (AFTER ZEROING REST OF LAST PAGE) + + MOVE D,PURBOT + ASH D,-PGSZ + ASH B,-PGSZ + MOVNI A,1 + MOVEI C,0 + HRLI B,400000 + +GARZR2: CAIG D,(B) + JRST GARZR1 + + PMAP + AOJA B,GARZR2 +] + + +; NOW REHASH THE ASSOCIATIONS BASED ON VALUES +GARZR1: PUSHJ P,REHASH + + + ;RESTORE AC'S +TRYCOX: SKIPN GCMONF + JRST NOMONO + MOVEI B,[ASCIZ /GOUT /] + PUSHJ P,MSGTYP +NOMONO: MOVE PVP,PVSTOR+1 + IRP AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + SKIPN DSTORE + SETZM DSTO(PVP) + MOVE PVP,PVPSTO+1(PVP) + +; CLOSING ROUTINE FOR G-C + PUSH P,A ; SAVE AC'C + PUSH P,B + PUSH P,C + PUSH P,D + + MOVE A,FRETOP ; ADJUST BLOAT-STAT PARAMETERS + SUB A,GCSTOP + ADDM A,NOWFRE + PUSHJ P,GCSET ; FIX UP BLOAT-STAT PARAMETERS + MOVE A,CURTP + ADDM A,NOWTP + MOVE A,CURP + ADDM A,NOWP + + PUSHJ P,CTIME + FSBR B,GCTIM ; GET TIME ELAPSED + MOVEM B,GCTIM ; SAVE ELAPSED TIME FOR INT-HANDLER + SKIPN GCMONF ; SEE IF MONITORING + JRST GCCONT + PUSHJ P,FIXSEN ; OUTPUT TIME + MOVEI A,15 ; OUTPUT C/R LINE-FEED + PUSHJ P,IMTYO + MOVEI A,12 + PUSHJ P,IMTYO +GCCONT: MOVE C,[NTPGOO,,NTPMAX] ; MAY FIX UP TP PARAMS TO ENCOURAGE + ; SHRINKAGE FOR EXTRA ROOM + SKIPE GCDANG + MOVE C,[ETPGOO,,ETPMAX] + HLRZM C,TPGOOD + HRRZM C,TPMAX + POP P,D ; RESTORE AC'C + POP P,C + POP P,B + POP P,A + MOVE A,GCDANG + JUMPE A,AGCWIN ; IF ZERO THE GC WORKED + SKIPN GCHAIR ; SEE IF HAIRY GC + JRST BTEST +REAGCX: MOVEI A,1 ; PREPARE FOR A HAIRY GC + MOVEM A,GCHAIR + SETZM GCDANG + MOVE C,[11,,10.] ; REASON FOR GC + JRST IAGC + +BTEST: SKIPE INBLOT + JRST AGCWIN + FATAL AGC--NO CORE AVAILABLE TO SATISFY REQUESTS + JRST REAGCX + +AGCWIN: SETZM PARNEW ;CLEAR FOR NEXT AGC CALL + SETZM GETNUM ;ALSO CLEAR THIS + SETZM INBLOT + SETZM GCFLG + + SETZM PGROW ; CLEAR GROWTH + SETZM TPGROW + SETOM GCHAPN ; INDICATE A GC HAS HAPPENED + SETOM GCHPN + SETOM INTFLG ; AND REQUEST AN INTERRUPT + SETZM GCDOWN + PUSHJ P,RBLDM + JUMPE R,FINAGC + JUMPN M,FINAGC ; IF M 0, RUNNING RSUBR SWAPPED OUT + SKIPE PLODR ; LOADING ONE, M = 0 IS OK + JRST FINAGC + + FATAL AGC--RUNNING RSUBR WENT AWAY + +AGCE1: FATAL AGC--TYPE VECTOR NOT OF TYPE VECTOR + + ; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL +; POINT. + +FIXSEN: PUSH P,B ; SAVE TIME + MOVEI B,[ASCIZ /TIME= /] + PUSHJ P,MSGTYP ; PRINT OUT MESSAGE + POP P,B ; RESTORE B + FMPRI B,(100.0) ; CONVERT TO FIX + MULI B,400 + TSC B,B + ASH C,-163.(B) + MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME + PUSH P,C + IDIVI C,10. ; START COUNTING + JUMPLE C,.+2 + AOJA A,.-2 + POP P,C + CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER + JRST DOT1 +FIXOUT: IDIVI C,10. ; RECOVER NUMBER + HRLM D,(P) + SKIPE C + PUSHJ P,FIXOUT + PUSH P,A ; SAVE A + CAIN A,2 ; DECIMAL POINT HERE? + JRST DOT2 +FIX1: HLRZ A,(P)-1 ; GET NUMBER + ADDI A,60 ; MAKE IT A CHARACTER + PUSHJ P,IMTYO ; OUT IT GOES + POP P,A + SOJ A, + POPJ P, +DOT1: MOVEI A,". ; OUTPUT DECIMAL POINT AND PADDING 0 + PUSHJ P,IMTYO + MOVEI A,"0 + PUSHJ P,IMTYO + JRST FIXOUT ; CONTINUE +DOT2: MOVEI A,". ; OUTPUT DECIMAL POINT + PUSHJ P,IMTYO + JRST FIX1 + + + ; SUBROUTINE TO CHECK SIZE OF PDLS AND DO FENCEPOSTING + +PDLCHK: JUMPGE A,CPOPJ + HLRE B,A ;GET NEGATIVE COUNT + MOVE C,A ;SAVE A COPY OF PDL POINTER + SUBI A,-1(B) ;LOCATE DOPE WORD PAIR + HRRZS A ; ISOLATE POINTER + CAME A,TPGROW ;GROWING? + ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD + MOVMS B + CAIN A,2(C) + JRST NOFENC + SETOM 1(C) ; START FENECE POST + CAIN A,3(C) + JRST NOFENC + MOVSI D,1(C) ;YES, SET UP TO BLT FENCE POSTS + HRRI D,2(C) + BLT D,-2(A) ;FENCE POST ALL EXCEPT DOPE WORDS + + +NOFENC: CAMG B,TPMAX ;NOW CHECK SIZE + CAMG B,TPMIN + JRST MUNGTP ;TOO BIG OR TOO SMALL + POPJ P, + +MUNGTP: SUB B,TPGOOD ;FIND DELTA TP +MUNG3: MOVE C,-1(A) ;IS GROWTH ALREADY SPECIFIED + TRNE C,777000 ;SKIP IF NOT + POPJ P, ;ASSUME GROWTH GIVEN WILL WIN + + ASH B,-6 ;CONVERT TO NUMBER OF BLOCKS + JUMPLE B,MUNGT1 + CAILE B,377 ; SKIP IF BELOW MAX + MOVEI B,377 ; ELSE USE MAX + TRO B,400 ;TURN ON SHRINK BIT + JRST MUNGT2 +MUNGT1: MOVMS B + ANDI B,377 +MUNGT2: DPB B,[111100,,-1(A)] ;STORE IN DOPE WORD + POPJ P, + +; CHECK UNMARKED STACK (NO NEED TO FENCE POST) + +PDLCHP: HLRE B,A ;-LENGTH TO B + MOVE C,A + SUBI A,-1(B) ;POINT TO DOPE WORD + HRRZS A ;ISOLATE POINTER + CAME A,PGROW ;GROWING? + ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD + MOVMS B + CAIN A,2(C) + JRST NOPF + SETOM 1(C) ; START FENECE POST + CAIN A,3(C) + JRST NOPF + MOVSI D,1(C) + HRRI D,2(C) + BLT D,-2(A) + +NOPF: CAMG B,PMAX ;TOO BIG? + CAMG B,PMIN ;OR TOO LITTLE + JRST .+2 ;YES, MUNG IT + POPJ P, + SUB B,PGOOD + JRST MUNG3 + + +; ROUTINE TO PRE MARK SPECIAL HACKS + +PRMRK: SKIPE GCHAIR ; FLUSH IF NO HAIR + POPJ P, +PRMRK2: HLRE B,A + SUBI A,(B) ;POINT TO DOPE WORD + HLRZ F,1(A) ; GET LNTH + LDB 0,[111100,,(A)] ; GET GROWTHS + TRZE 0,400 ; SIGN HACK + MOVNS 0 + ASH 0,6 ; TO WORDS + ADD F,0 + LDB 0,[001100,,(A)] + TRZE 0,400 + MOVNS 0 + ASH 0,6 + ADD F,0 + PUSHJ P,ALLOGC + HRRM 0,1(A) ; NEW RELOCATION FIELD + IORM D,1(A) ;AND MARK + POPJ P, + + + ;GENERAL MARK SUBROUTINE. CALLED TO MARK ALL THINGS +; A/ GOODIE TO MARK FROM +; B/ TYPE OF A (IN RH) +; C/ TYPE,DATUM PAIR POINTER + +MARK2A: +MARK2: HLRZ B,(C) ;GET TYPE +MARK1: MOVE A,1(C) ;GET GOODIE +MARK: SKIPN DUMFLG + JUMPE A,CPOPJ ; NEVER MARK 0 + MOVEI 0,1(A) + CAIL 0,@PURBOT + JRST GCRETD +MARCON: PUSH P,A + HRLM C,-1(P) ;AND POINTER TO IT + ANDI B,TYPMSK ; FLUSH MONITORS + SKIPE DUMFLG ; SKIP IF NOT IN DUMPER + PUSHJ P,TYPHK ; HACK SOME TYPES + LSH B,1 ;TIMES 2 TO GET SAT + HRRZ B,@TYPNT ;GET SAT + ANDI B,SATMSK + JUMPE A,GCRET + CAILE B,NUMSAT ; SKIP IF TEMPLATE DATA + JRST TD.MRK + SKIPN GCDFLG +IFN ITS,[ + JRST @MKTBS(B) ;AND GO MARK + JRST @GCDISP(B) ; DISPATCH FOR DUMPERS +] +IFE ITS,[ + SKIPA E,MKTBS(B) + MOVE E,GCDISP(B) + HRLI E,-1 + JRST (E) +] +; HERE TO MARK A POSSIBLE DEFER POINTER + +DEFQMK: GETYP B,(A) ; GET ITS TYPE + LSH B,1 + HRRZ B,@TYPNT + ANDI B,SATMSK ; AND TO SAT + SKIPGE MKTBS(B) + +;HERE TO MARK THAT WHICH IS POINTED TO BY A DEFERRED POINTER + +DEFMK: TLOA TYPNT,400000 ;USE SIGN BIT AS FLAG + +;HERE TO MARK LIST ELEMENTS + +PAIRMK: TLZ TYPNT,400000 ;TURN OF DEFER BIT + PUSH P,[0] ; WILL HOLD BACK PNTR + MOVEI C,(A) ; POINT TO LIST +PAIRM1: CAMGE C,PARTOP ;CHECK FOR BEING IN BOUNDS + CAMGE C,PARBOT + FATAL AGC--MARKED PAIR OUTSIDE PAIR SPACE + SKIPGE B,(C) ;SKIP IF NOT MARKED + JRST RETNEW ;ALREADY MARKED, RETURN + IORM D,(C) ;MARK IT + SKIPL FPTR ; SEE IF IN FRONTEIR + PUSHJ P,MOVFNT ; EXPAND THE FRONTEIR + MOVEM B,FRONT(FPTR) + MOVE 0,1(C) ; AND 2D + AOBJN FPTR,.+2 ; AOS AND CHECK FRONTEIR + PUSHJ P,MOVFNT ; EXPAND FRONTEIR + MOVEM 0,FRONT(FPTR) + ADD FPTR,[1,,1] ; MOVE ALONG IN FRONTIER + + +PAIRM2: MOVEI A,@BOTNEW ; GET INF ADDR + SUBI A,2 + HRRM A,(C) ; LEAVE A POINTER TO NEW HOME + HRRZ E,(P) ; GET BACK POINTER + JUMPE E,PAIRM7 ; 1ST ONE, NEW FIXUP + MOVSI 0,(HRRM) ; INS FOR CLOBBER + PUSHJ P,SMINF ; SMASH INF'S CORE IMAGE +PAIRM4: MOVEM A,(P) ; NEW BACK POINTER + JUMPL TYPNT,DEFDO ;GO HANDLE DEFERRED POINTER + HRLM B,(P) ; SAVE OLD CDR + PUSHJ P,MARK2 ;MARK THIS DATUM + HRRZ E,(P) ; SMASH CAR IN CASE CHANGED + ADDI E,1 + MOVSI 0,(MOVEM) + PUSHJ P,SMINF + HLRZ C,(P) ;GET CDR OF LIST + CAIGE C,@PURBOT ; SKIP IF PURE (I.E. DONT MARK) + JUMPN C,PAIRM1 ;IF NOT NIL, MARK IT +GCRETP: SUB P,[1,,1] + +GCRET: TLZ TYPNT,400000 ;FOR PAIRMKS BENEFIT + HLRZ C,-1(P) ;RESTORE C + POP P,A + POPJ P, ;AND RETURN TO CALLER + +GCRETD: ANDI B,TYPMSK ; TURN OFF MONITORS + CAIN B,TLOCR ; SEE IF A LOCR + JRST MARCON + SKIPN GCDFLG ; SKIP IF IN PURIFIER OR DUMPER + POPJ P, + CAIE B,TATOM ; WE MARK PURE ATOMS + CAIN B,TCHSTR ; AND STRINGS + JRST MARCON + POPJ P, + +;HERE TO MARK DEFERRED POINTER + +DEFDO: PUSH P,B ; PUSH OLD PAIR ON STACK + PUSH P,1(C) + MOVEI C,-1(P) ; USE AS NEW DATUM + PUSHJ P,MARK2 ;MARK THE DATUM + HRRZ E,-2(P) ; GET POINTER IN INF CORE + ADDI E,1 + MOVSI 0,(MOVEM) + PUSHJ P,SMINF ; AND CLOBBER + HRRZ E,-2(P) + MOVE A,-1(P) + MOVSI 0,(HRRM) ; SMASH IN RIGHT HALF + PUSHJ P,SMINF + SUB P,[3,,3] + JRST GCRET ;AND RETURN + + +PAIRM7: MOVEM A,-1(P) ; SAVE NEW VAL FOR RETURN + JRST PAIRM4 + +RETNEW: HRRZ A,(C) ; POINT TO NEW WORLD LOCN + HRRZ E,(P) ; BACK POINTER + JUMPE E,RETNW1 ; NONE + MOVSI 0,(HRRM) + PUSHJ P,SMINF + JRST GCRETP + +RETNW1: MOVEM A,-1(P) + JRST GCRETP + +; ROUTINE TO EXPAND THE FRONTEIR + +MOVFNT: PUSH P,B ; SAVE REG B + HRRZ A,BOTNEW ; CURRENT BOTTOM OF WINDOW + ADDI A,2000 ; MOVE IT UP + HRRM A,BOTNEW + HRRZM A,FNTBOT ; BOTTOM OF FRONTEIR + MOVEI B,FRNP + ASH A,-10. ; TO PAGES + PUSHJ P,%GETIP + PUSHJ P,%SHWND ; SHARE THE PAGE + MOVSI FPTR,-2000 ; FIX UP FPTR + POP P,B + POPJ P, + + +; ROUTINE TO SMASH INFERIORS PPAGES +; E/ ADDR IN INF, A/ THING TO SMASH ,0/ INS TO USE + +SMINF: CAMGE E,FNTBOT + JRST SMINF1 ; NOT IN FRONTEIR + SUB E,FNTBOT ; ADJUST POINTER + IOR 0,[0 A,FRONT(E)] ; BUILD INSTRUCTION + XCT 0 ; XCT IT + POPJ P, ; EXIT +SMINF1: CAML E,WNDBOT + CAML E,WNDTOP ; SEE IF IN WINDOW + JRST SMINF2 +SMINF3: SUB E,WNDBOT ; FIX UP + IOR 0,[0 A,WIND(E)] ; FIX INS + XCT 0 + POPJ P, +SMINF2: PUSH P,A ; SAVE E + PUSH P,B ; SAVE B + HRRZ A,E ; E SOMETIMES HAS STUFF IN LH + ASH A,-10. + MOVEI B,WNDP ; WINDOW PAGE + PUSHJ P,%SHWND ; SHARE IT + ASH A,10. ; TO PAGES + MOVEM A,WNDBOT ; UPDATE POINTERS + ADDI A,2000 + MOVEM A,WNDTOP + POP P,B ; RESTORE ACS + POP P,A + JRST SMINF3 ; FIX UP INF + + + + ; VECTOR AND TP MARKER, SIGN OF TYPNT IS SET BASED ON WHICH ONE + +TPMK: TLOA TYPNT,400000 ;SET TP MARK FLAG +VECTMK: TLZ TYPNT,400000 + MOVEI 0,@BOTNEW ; POINTER TO INF + PUSH P,0 + MOVEI E,(A) ;SAVE A POINTER TO THE VECTOR + HLRE B,A ;GET -LNTH + SUB A,B ;LOCATE DOPE WORD + MOVEI A,1(A) ;ZERO LH AND POINT TO 2ND DOPE WORD + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST VECTB1 ;LOSE, COMPLAIN + + HLLM TYPNT,(P) ; SAVE MARKER INDICATING STACK + JUMPGE TYPNT,NOBUFR ;IF A VECTOR, NO BUFFER CHECK + CAME A,PGROW ;IS THIS THE BLOWN P + CAMN A,TPGROW ;IS THIS THE GROWING PDL + JRST NOBUFR ;YES, DONT ADD BUFFER + ADDI A,PDLBUF ;POINT TO REAL DOPE WORD + MOVSI 0,-PDLBUF ;ALSO FIX UP POINTER + ADD 0,1(C) + MOVEM 0,-1(P) ; FIXUP RET'D PNTR + +NOBUFR: HLRE B,(A) ;GET LENGTH FROM DOPE WORD + JUMPL B,EXVECT ; MARKED, LEAVE + LDB B,[111100,,-1(A)] ; GET TOP GROWTH + TRZE B,400 ; HACK SIGN BIT + MOVNS B + ASH B,6 ; CONVERT TO WORDS + PUSH P,B ; SAVE TOP GROWTH + LDB 0,[001100,,-1(A)] ;GET GROWTH FACTOR + TRZE 0,400 ;KILL SIGN BIT AND SKIP IF + + MOVNS 0 ;NEGATE + ASH 0,6 ;CONVERT TO NUMBER OF WORDS + PUSH P,0 ; SAVE BOTTOM GROWTH + ADD B,0 ;TOTAL GROWTH TO B +VECOK: HLRE E,(A) ;GET LENGTH AND MARKING + MOVEI F,(E) ;SAVE A COPY + ADD F,B ;ADD GROWTH + SUBI E,2 ;- DOPE WORD LENGTH + IORM D,(A) ;MAKE SURE NOW MARKED + PUSHJ P,ALLOGC ; ALLOCATE SPACE FOR VECTOR IN THE INF + HRRM 0,(A) +VECOK1: JUMPLE E,MOVEC2 ; ZERO LENGTH, LEAVE + PUSH P,A ; SAVE POINTER TO DOPE WORD + SKIPGE B,-1(A) ;SKIP IF UNIFORM + TLNE B,377777-.VECT. ;SKIP IF NOT SPECIAL + JUMPGE TYPNT,NOTGEN ;JUMP IF NOT A GENERAL VECTOR + +GENRAL: HLRZ 0,B ;CHECK FOR PSTACK + TRZ 0,.VECT. + JUMPE 0,NOTGEN ;IT ISN'T GENERAL + JUMPL TYPNT,TPMK1 ; JUMP IF TP + MOVEI C,(A) + SUBI C,1(E) ; C POINTS TO BEGINNING OF VECTOR + + ; LOOP TO MARK ELEMENTS IN A GENERAL VECTOR +VECTM2: HLRE B,(C) ;GET TYPE AND MARKING + JUMPL B,UMOVEC ;RETURN, (EITHER DOPE WORD OR FENCE POST) + MOVE A,1(C) ;DATUM TO A + + +VECTM3: PUSHJ P,MARK ;MARK DATUM + MOVEM A,1(C) ; IN CASE WAS FIXED +VECTM4: ADDI C,2 + JRST VECTM2 + +UMOVEC: POP P,A +MOVEC2: POP P,C ; RESTORE BOTTOM GROWTH + HRRZ E,-1(P) ; GET POINTER INTO INF + SKIPN C ; SKIP IF NO BOTTOM GROWTH + JRST MOVEC3 + JUMPL C,.+3 ; SEE IF BOTTOM SHRINKAGE + ADD E,C ; GROW IT + JRST MOVEC3 ; CONTINUE + HRLM C,E ; MOVE SHRINKAGE FOR TRANSFER PHASE +MOVEC3: PUSHJ P,DOPMOD ; MODIFY DOPE WORD AND PLACE IN INF + PUSHJ P,TRBLKV ; SEND VECTOR INTO INF +TGROT: CAMGE A,PARBOT ; SKIP IF NOT STORAGE + JRST TGROT1 + MOVE C,DOPSV1 ; RESTORE DOPE WORD + SKIPN (P) ; DON'T RESTORE D.W.'S YET IF THERE IS GROWTH + MOVEM C,-1(A) +TGROT1: POP P,C ; IS THERE TOP GROWH + SKIPN C ; SEE IF ANY GROWTH + JRST DOPEAD + SUBI E,2 + SKIPG C + JRST OUTDOP + PUSH P,C ; SAVE C + SETZ C, ; ZERO C + PUSHJ P,ADWD + ADDI E,1 + SETZ C, ; ZERO WHERE OLD DOPE WORDS WERE + PUSHJ P,ADWD + POP P,C + ADDI E,-1(C) ; MAKE ADJUSTMENT FOR TOP GROWTH +OUTDOP: PUSHJ P,DOPOUT +DOPEAD: +EXVECT: HLRZ B,(P) + SUB P,[1,,1] ; GET RID OF FPTR + PUSHJ P,RELATE ; RELATIVIZE + TRNN B,400000 ; WAS THIS A STACK + JRST GCRET + MOVSI 0,PDLBUF ; FIX UP STACK PTR + ADDM 0,(P) + JRST GCRET ; EXIT + +VECLOS: JUMPL C,CCRET ;JUMP IF CAN'T MUNG TYPE + HLLZ 0,(C) ;GET TYPE + MOVEI B,TILLEG ;GET ILLEGAL TYPE + HRLM B,(C) + MOVEM 0,1(C) ;AND STORE OLD TYPE AS VALUE + JRST UMOVEC ;RETURN WITHOUT MARKING VECTOR + +CCRET: CLEARM 1(C) ;CLOBBER THE DATUM + JRST GCRET + + +; ROUTINE TO MARK A TP. IT SCANS THE TP. IT MARKS ALL THE ITEMS AND IT MAPS AN +; UPDATED VERSION INTO THE INFERIOR WITHOUT CHANGING THE ORIGINAL. + +TPMK1: +TPMK2: POP P,A + POP P,C + HRRZ E,-1(P) ; FIX UP PARAMS + ADDI E,(C) + PUSH P,A ; REPUSH A + HRRZ B,(A) ; CALCULATE RELOCATION + SUB B,A + MOVE C,-1(P) ; ADJUST FOR GROWTH + SUB B,C + HRLZS C + PUSH P,C + PUSH P,B + PUSH P,E + PUSH P,[0] +TPMK3: HLRZ E,(A) ; GET LENGTH + TRZ E,400000 ; GET RID OF MARK BIT + SUBI A,-1(E) ;POINT TO FIRST ELEMENT + MOVEI C,(A) ;POINT TO FIRST ELEMENT WITH C +TPMK4: HLRE B,(C) ;GET TYPE AND MARKING + JUMPL B,TPMK7 ;RETURN, (EITHER DOPE WORD OR FENCE POST) + HRRZ A,(C) ;DATUM TO A + ANDI B,TYPMSK ; FLUSH MONITORS + CAIE B,TCBLK + CAIN B,TENTRY ;IS THIS A STACK FRAME + JRST MFRAME ;YES, MARK IT + CAIE B,TUBIND ; BIND + CAIN B,TBIND ;OR A BINDING BLOCK + JRST MBIND + CAIE B,TBVL ; CHECK FOR OTHER BINDING HACKS + CAIN B,TUNWIN + SKIPA ; FIX UP SP-CHAIN + CAIN B,TSKIP ; OTHER BINDING HACK + PUSHJ P,FIXBND + + +TPMK5: PUSH P,(C) ; SAVE BECAUSE FRAMES MIGHT MUNG IT + HRRM A,(C) ; FIX UP IN CASE OF SP CHAIN + PUSHJ P,MARK1 ;MARK DATUM + MOVE R,A ; SAVE A + POP P,M + MOVE A,(C) + PUSHJ P,OUTTP ; MOVE OUT TYPE + MOVE A,R + PUSHJ P,OUTTP ; SEND OUT VALUE + MOVEM M,(C) ; RESTORE TO OLD VALUE +TPMK6: ADDI C,2 + JRST TPMK4 + +MFRAME: HRRZ 0,1(C) ; SET UP RELITIVIZATION OF PTR TO PREVIOUS FRAME + HRROI C,FRAMLN+FSAV-1(C) ;POINT TO FUNCTION + HRRZ A,1(C) ; GET IT + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST MFRAM1 ; IGNORE, NOT IN VECTOR SPACE + HRL A,(A) ; GET LENGTH + MOVEI B,TVEC + PUSHJ P,MARK ; AND MARK IT +MFRAM1: HLL A,1(C) + PUSHJ P,OUTTP ; SEND IT OUT + HRRZ A,OTBSAV-FSAV+1(C) ; POINT TO TB TO PREVIOUS FRAME + SKIPE A + ADD A,-2(P) ; RELOCATE IF NOT 0 + HLL A,2(C) + PUSHJ P,OUTTP ; SEND IT OUT + MOVE A,-2(P) ; ADJUST AB SLOT + ADD A,ABSAV-FSAV+1(C) ; POINT TO SAVED AB + PUSHJ P,OUTTP ; SEND IT OUT + MOVE A,-2(P) ; ADJUST SP SLOT + ADD A,SPSAV-FSAV+1(C) ;POINT TO SAVED SP + SUB A,-3(P) ; ADJUSTMENT OF LENGTH IF GROWTH + PUSHJ P,OUTTP ; SEND IT OUT + HRROI C,PSAV-FSAV(C) ;POINT TO SAVED P + MOVEI B,TPDL + PUSHJ P,MARK1 ;AND MARK IT + PUSHJ P,OUTTP ; SEND IT OUT + HLRE 0,TPSAV-PSAV+1(C) + MOVE A,TPSAV-PSAV+1(C) + SUB A,0 + MOVEI 0,1(A) + MOVE A,TPSAV-PSAV+1(C) + CAME 0,TPGROW ; SEE IF BLOWN + JRST MFRAM9 + MOVSI 0,PDLBUF + ADD A,0 +MFRAM9: ADD A,-2(P) + SUB A,-3(P) ; ADJUST + PUSHJ P,OUTTP + MOVE A,PCSAV-PSAV+1(C) + PUSHJ P,OUTTP + HRROI C,-PSAV+1(C) ; POINT PAST THE FRAME + JRST TPMK4 ;AND DO MORE MARKING + + +MBIND: PUSHJ P,FIXBND + MOVEI B,TATOM ;FIRST MARK ATOM + SKIPN GCHAIR ; IF NO HAIR, MARK ALL NOW + SKIPE (P) ; PASSED MARKER, IF SO DONT SKIP + JRST MBIND2 ; GO MARK + MOVE A,1(C) ; RESTORE A + CAME A,GCATM + JRST MBIND1 ; NOT IT, CONTINUE SKIPPING + HRRM LPVP,2(C) ; SAVE IN RH OF TPVP,,0 + MOVE 0,-4(P) ; RECOVER PTR TO DOPE WORD + HRLM 0,2(C) ; SAVE FOR MOVEMENT + MOVEI B,TATOM ; MARK THE BINDING TO THIS PROCESS + PUSHJ P,MARK1 ; MARK THE ATOM + MOVEI LPVP,(C) ; POINT + SETOM (P) ; INDICATE PASSAGE +MBIND1: ADDI C,6 ; SKIP BINDING + MOVEI 0,6 + SKIPE -1(P) ; ONLY UPDATE IF SENDING OVER + ADDM 0,-1(P) + JRST TPMK4 + +MBIND2: HLL A,(C) + PUSHJ P,OUTTP ; FIX UP CHAIN + MOVEI B,TATOM ; RESTORE IN CASE SMASHED + PUSHJ P,MARK1 ; MARK ATOM + PUSHJ P,OUTTP ; SEND IT OUT + ADDI C,2 + PUSH P,(C) ; SAVE BECAUSE FRAMES MIGHT MUNG IT + PUSHJ P,MARK2 ;MARK DATUM + MOVE R,A ; SAVE A + POP P,M + MOVE A,(C) + PUSHJ P,OUTTP ; MOVE OUT TYPE + MOVE A,R + PUSHJ P,OUTTP ; SEND OUT VALUE + MOVEM M,(C) ; RESTORE TO OLD VALUE + ADDI C,2 + MOVEI B,TLIST ; POINT TO DECL SPECS + HLRZ A,(C) + PUSHJ P,MARK ; AND MARK IT + HRR A,(C) ; LIST FIX UP + PUSHJ P,OUTTP + SKIPL A,1(C) ; PREV LOC? + JRST NOTLCI + MOVEI B,TLOCI ; NOW MARK LOCATIVE + PUSHJ P,MARK1 +NOTLCI: PUSHJ P,OUTTP + ADDI C,2 + JRST TPMK4 + +FIXBND: HRRZ A,(C) ; GET PTR TO CHAIN + SKIPE A ; DO NOTHING IF EMPTY + ADD A,-3(P) + POPJ P, +TPMK7: +TPMK8: MOVNI A,1 ; FENCE-POST THE STACK + PUSHJ P,OUTTP + ADDI C,1 ; INCREMENT C FOR FENCE-POST + SUB P,[1,,1] ; CLEAN UP STACK + POP P,E ; GET UPDATED PTR TO INF + SUB P,[2,,2] ; POP OFF RELOCATION + HRRZ A,(P) + HLRZ B,(A) + TRZ B,400000 + SUBI A,-1(B) + SUBI C,(A) ; GET # OF WORDS TRANSFERED + SUB B,C ; GET # LEFT + ADDI E,-2(B) ; ADJUST POINTER TO INF + POP P,A + POP P,C ; IS THERE TOP GROWH + ADD E,C ; MAKE ADJUSTMENT FOR TOP GROWTH + ANDI E,-1 + PUSHJ P,DOPMOD ; FIX UP DOPE WORDS + PUSHJ P,DOPOUT ; SEND THEM OUT + JRST DOPEAD + + + ; ROUTINE TO ALLOCATE ROOM FOR VECTORS IN INFERIOR +; F= # OF WORDS TO ALLOCATE + +ALLOGC: HRRZS A ; GET ABS VALUE + SKIPN GCDFLG ; SKIP IF IN DUMPER + CAML A,GCSBOT ; SKIP IF IN STORAGE + JRST ALOGC2 ; JUMP IF ALLOCATING + HRRZ 0,A + POPJ P, +ALOGC2: PUSH P,A ; SAVE A +ALOGC1: HLRE 0,FPTR ; GET ROOM LEFT + ADD 0,F ; SEE IF ITS ENOUGH + JUMPL 0,ALOCOK + MOVE F,0 ; MODIFY F + PUSH P,F + PUSHJ P,MOVFNT ; MOVE UP FRONTEIR + POP P,F + JRST ALOGC1 ; CONTINUE +ALOCOK: ADD FPTR,F ; MODIFY FPTR + HRLZS F + ADD FPTR,F + POP P,A ; RESTORE A + MOVEI 0,@BOTNEW + SUBI 0,1 ; RELOCATION PTR + POPJ P, ; EXIT + + + + +; TRBLK MOVES A VECTOR INTO THE INFERIOR +; E= STARTING ADDR IN INF A= DOPE WORD OF VECTOR + +TRBLK: HRRZS A + SKIPE GCDFLG + JRST TRBLK7 + CAMGE A,GCSBOT ; SEE IF IN GC-SPACE + JRST FIXDOP +TRBLK7: PUSH P,A + HLRZ 0,(A) + TRZ 0,400000 ; TURN OFF GC FLAG + HRRZ F,A + HLRE A,E ; GET SHRINKAGE + ADD 0,A ; MUNG LENGTH + SUB F,0 + ADDI F,1 ; F POINTS TO START OF VECTOR +TRBLK2: HRRZ R,E ; SAVE POINTER TO INFERIOR + ADD E,0 ; E NOW POINTS TO FINAL ADDRESS+1 + MOVE M,E ;SAVE E +TRBLK1: MOVE 0,R + SUBI E,1 + CAMGE R,FNTBOT ; SEE IF IN FRONTEIR + JRST TRBL10 + SUB E,FNTBOT ; ADJUST E + SUB 0,FNTBOT ; ADJ START + MOVEI A,FRONT+1777 + JRST TRBLK4 +TRBL10: CAML R,WNDBOT + CAML R,WNDTOP ; SEE IF IN WINDOW + JRST TRBLK5 ; NO + SUB E,WNDBOT + SUB 0,WNDBOT + MOVEI A,WIND+1777 +TRBLK4: ADDI 0,-1777(A) ; CALCULATE START IN WINDOW OR FRONTEIR + CAIL E,2000 + JRST TRNSWD + ADDI E,-1777(A) ; SUBTRACT WINDBOT + HRL 0,F ; SET UP FOR BLT + BLT 0,(E) + POP P,A + +FIXDOP: IORM D,(A) + MOVE E,M ; GET END OF WORD + POPJ P, +TRNSWD: PUSH P,B + MOVEI B,1(A) ; GET TOP OF WORLD + SUB B,0 + HRL 0,F + BLT 0,(A) + ADD F,B ; ADJUST F + ADD R,B + POP P,B + MOVE E,M ; RESTORE E + JRST TRBLK1 ; CONTINUE +TRBLK5: HRRZ A,R ; COPY E + ASH A,-10. ; TO PAGES + PUSH P,B ; SAVE B + MOVEI B,WNDP ; IT IS WINDOW + PUSHJ P,%SHWND + ASH A,10. ; TO PAGES + MOVEM A,WNDBOT ; UPDATE POINTERS + ADDI A,2000 + MOVEM A,WNDTOP + POP P,B ; RESTORE B + JRST TRBL10 + + + + +; ALTERNATE ENTRY FOR VECTORS WHICH TAKES CARE OF SHRINKAGE + +TRBLKV: HRRZS A + SKIPE GCDFLG ; SKIP IF NOT IN DUMPER + JRST TRBLV2 + CAMGE A,GCSBOT ; SEE IF IN GC-SPACE + JRST FIXDOP +TRBLV2: PUSH P,A ; SAVE A + HLRZ 0,DOPSV2 + TRZ 0,400000 + HRRZ F,A + HLRE A,E ; GET SHRINKAGE + ADD 0,A ; MUNG LENGTH + SUB F,0 + ADDI F,1 ; F POINTS TO START OF VECTOR + SKIPGE -2(P) ; SEE IF SHRINKAGE + ADD 0,-2(P) ; IF SO COMPENSATE + JRST TRBLK2 ; CONTINUE + +; ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT TO SEND IN 0= # OF WORDS + +TRBLK3: PUSH P,A ; SAVE A + MOVE F,A + JRST TRBLK2 + +; FINAL ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT +; F==> START OF TRANSFER IN GCS 0= # OF WORDS + +TRBLKX: PUSH P,A ; SAVE A + JRST TRBLK2 ; SEND IT OUT + + +; OUTTP IS THE ROUTINE THAT TPMK USES TO SEND OUT ELEMENTS FOR THE SCAN +; -2(P) CONTAINS THE ADDR IN THE INF AND IT IS UPDATED +; A CONTAINS THE WORD TO BE SENT OUT + +OUTTP: AOS E,-2(P) ; INCREMENT PLACE + MOVSI 0,(MOVEM) ; INS FOR SMINF + SOJA E,SMINF + + +; ADWD PLACES ONE WORD IN THE INF +; E ==> INF C IS THE WORD + +ADWD: PUSH P,E ; SAVE AC'S + PUSH P,A + MOVE A,C ; GET WORD + MOVSI 0,(MOVEM) ; INS FOR SMINF + PUSHJ P,SMINF ; SMASH IT IN + POP P,A + POP P,E + POPJ P, ; EXIT + +; DOPOUT IS USED TO SEND OUT THE DOPE WORDS IN UNUSUAL CALSE +; SUCH AS THE TP AND GROWTH + + +DOPOUT: MOVE C,-1(A) + PUSHJ P,ADWD + ADDI E,1 + MOVE C,(A) ; GET SECOND DOPE WORD + TLZ C,400000 ; TURN OFF POSSIBLE MARK BIT + PUSHJ P,ADWD + MOVE C,DOPSV1 ; FIX UP FIRST DOPE WORD + MOVEM C,-1(A) + MOVE C,DOPSV2 + MOVEM C,(A) ; RESTORE SECOND D.W. + POPJ P, + +; DOPMOD MODIFIES THE DOPE WORD OF A VECTOR AND PLACES A NEW DOPE-WORD IN INF +; A ==> DOPE WORD E==> INF + +DOPMOD: SKIPE GCDFLG ; CHECK TO SEE IF IN DUMPER AND PURIFY + JRST .+3 + CAMG A,GCSBOT + POPJ P, ; EXIT IF NOT IN GCS + MOVE C,-1(A) ; GET FIRST DOPE WORD + MOVEM C,DOPSV1 + HLLZS C ; CLEAR OUT GROWTH + TLO C,.VECT. ; FIX UP FOR GCHACK + PUSH P,C + MOVE C,(A) ; GET SECOND DOPE WORD + HLRZ B,(A) ; GET LENGTH + TRZ B,400000 ; TURN OFF MARK BIT + MOVEM C,DOPSV2 + HRRZ 0,-1(A) ; CHECK FOR GROWTH + JUMPE 0,DOPMD1 + LDB 0,[111100,,-1(A)] ; MODIFY WITH GROWTH + TRZE 0,400 + MOVNS 0 + ASH 0,6 + ADD B,0 + LDB 0,[001100,,-1(A)] + TRZE 0,400 + MOVNS 0 + ASH 0,6 + ADD B,0 +DOPMD1: HRL C,B ; FIX IT UP + MOVEM C,(A) ; FIX IT UP + POP P,-1(A) + POPJ P, + +ADPMOD: CAMG A,GCSBOT + POPJ P, ; EXIT IF NOT IN GCS + MOVE C,-1(A) ; GET FIRST DOPE WORD + TLO C,.VECT. ; FIX UP FOR GCHACK + MOVEM C,-1(A) + MOVE C,(A) ; GET SECOND DOPE WORD + TLZ C,400000 ; TURN OFF PARK BIT + MOVEM C,(A) + POPJ P, + + + + + ; RELATE RELATAVIZES A POINTER TO A VECTOR +; B IS THE POINTER A==> DOPE WORD + +RELATE: SKIPE GCDFLG ; SEE IF DUMPER OR PURIFIER + JRST .+3 + CAMGE A,GCSBOT ; SEE IF IN VECTOR SPACE + POPJ P, ; IF NOT EXIT + MOVE C,-1(P) + HLRE F,C ; GET LENGTH + HRRZ 0,-1(A) ; CHECK FO GROWTH + JUMPE A,RELAT1 + LDB 0,[111100,,-1(A)] ; GET TOP GROWTH + TRZE 0,400 ; HACK SIGN BIT + MOVNS 0 + ASH 0,6 ; CONVERT TO WORDS + SUB F,0 ; ACCOUNT FOR GROWTH +RELAT1: HRLM F,C ; PLACE CORRECTED LENGTH BACK IN POINTER + HRRZ F,(A) ; GET RELOCATED ADDR + SUBI F,(A) ; FIND RELATIVIZATION AMOUNT + ADD C,F ; ADJUST POINTER + SUB C,0 ; ACCOUNT FOR GROWTH + MOVEM C,-1(P) + POPJ P, + + + + ; MARK TB POINTERS +TBMK: HRRZS A ; CHECK FOR NIL POINTER + SKIPN A + JRST GCRET ; IF POINTING TO NIL THEN RETURN + HLRE B,TPSAV(A) ; MAKE POINTER LOOK LIKE A TP POINTER + HRRZ C,TPSAV(A) ; GET TO DOPE WORD +TBMK2: SUB C,B ; POINT TO FIRST DOPE WORD + HRRZ A,(P) ; GET PTR TO FRAME + SUB A,C ; GET PTR TO FRAME + HRLS A + HRR A,(P) + PUSH P,A + MOVEI C,-1(P) + MOVEI B,TTP + PUSHJ P,MARK + SUB P,[1,,1] + HRRM A,(P) + JRST GCRET +ABMK: HLRE B,A ; FIX UP TO GET TO FRAME + SUB A,B + HLRE B,FRAMLN+TPSAV(A) ; FIX UP TO LOOK LIKE TP + HRRZ C,FRAMLN+TPSAV(A) + JRST TBMK2 + + + +; MARK ARG POINTERS + +ARGMK: HRRZ A,1(C) ; GET POINTER + HLRE B,1(C) ; AND LNTH + SUB A,B ; POINT TO BASE + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST ARGMK0 + HLRZ 0,(A) ; GET TYPE + ANDI 0,TYPMSK + CAIN 0,TCBLK + JRST ARGMK1 + CAIE 0,TENTRY ; IS NEXT A WINNER? + CAIN 0,TINFO + JRST ARGMK1 ; YES, GO ON TO WIN CODE + +ARGMK0: SETZB A,1(C) ; CLOBBER THE CELL + SETZM (P) ; AND SAVED COPY + JRST GCRET + +ARGMK1: MOVE B,1(A) ; ASSUME TTB + ADDI B,(A) ; POINT TO FRAME + CAIE 0,TINFO ; IS IT? + MOVEI B,FRAMLN(A) ; NO, USE OTHER GOODIE + HLRZ 0,OTBSAV(B) ; GET TIME + HRRZ A,(C) ; AND FROM POINTER + CAIE 0,(A) ; SKIP IF WINNER + JRST ARGMK0 + MOVE A,TPSAV(B) ; GET A RELATAVIZED TP + HRROI C,TPSAV-1(B) + MOVEI B,TTP + PUSHJ P,MARK1 + SUB A,1(C) ; AMOUNT TO RELATAVIZE ARGS + HRRZ B,(P) + ADD B,A + HRRM B,(P) ; PUT RELATAVIZED PTR BACK + JRST GCRET + + +; MARK FRAME POINTERS + +FRMK: HLRZ B,A ; GET TIME FROM FRAME PTR + HLRZ F,OTBSAV(A) ; GET TIME FROM FRAME + CAME B,F ; SEE IF EQUAL + JRST GCRET + SUBI C,1 ;PREPARE TO MARK PROCESS VECTOR + HRRZ A,1(C) ;USE AS DATUM + SUBI A,1 ;FUDGE FOR VECTMK + MOVEI B,TPVP ;IT IS A VECTRO + PUSHJ P,MARK ;MARK IT + ADDI A,1 ; READJUST PTR + HRRM A,1(C) ; FIX UP PROCESS SLOT + MOVEI C,1(C) ; SET UP FOR TBMK + HRRZ A,(P) + JRST TBMK ; MARK LIKE TB + + +; MARK BYTE POINTER + +BYTMK: PUSHJ P,BYTDOP ; GET DOPE WORD IN A + HLRZ F,-1(A) ; GET THE TYPE + ANDI F,SATMSK ; FLUSH MONITOR BITS + CAIN F,SATOM ; SEE IF ATOM + JRST ATMSET + HLRE F,(A) ; GET MARKING + JUMPL F,BYTREL ; JUMP IF MARKED + HLRZ F,(A) ; GET LENGTH + PUSHJ P,ALLOGC ; ALLOCATE FOR IT + HRRM 0,(A) ; SMASH IT IN + MOVE E,0 + HLRZ F,(A) + SUBI E,-1(F) ; ADJUST INF POINTER + IORM D,(A) + PUSHJ P,ADPMOD + PUSHJ P,TRBLK +BYTREL: HRRZ E,(A) + SUBI E,(A) + ADDM E,(P) ; RELATAVIZE + JRST GCRET + +ATMSET: PUSH P,A ; SAVE A + HLRZ B,(A) ; GET LENGTH + TRZ B,400000 ; GET RID OF MARK BIT + MOVNI B,-2(B) ; GET LENGTH + ADDI A,-1(B) ; CALCULATE POINTER + HRLI A,(B) + MOVEI B,TATOM ; TYPE + PUSHJ P,MARK + POP P,A ; RESTORE A + SKIPN GCDFLG + JRST BYTREL + MOVSI E,STATM ; GET "STRING IS ATOM BIT" + IORM E,(P) + SKIPN DUMFLG + JRST GCRET + HRRM A,(P) + JRST BYTREL ; TO BYTREL + + +; MARK OFFSET + +OFFSMK: HLRZS A + PUSH P,$TLIST + PUSH P,A ; PUSH LIST POINTER ON THE STACK + MOVEI C,-1(P) ; POINTER TO PAIR + PUSHJ P,MARK2 ; MARK THE LIST + HRLM A,-2(P) ; UPDATE POINTER IN OFFSET + SUB P,[2,,2] + JRST GCRET + + +; MARK ATOMS IN GVAL STACK + +GATOMK: HRRZ B,(C) ; POINT TO POSSIBLE GDECL + JUMPE B,ATOMK + CAIN B,-1 + JRST ATOMK + MOVEI A,(B) ; POINT TO DECL FOR MARK + MOVEI B,TLIST + MOVEI C,0 + PUSHJ P,MARK + HLRZ C,-1(P) ; RESTORE HOME POINTER + HRRM A,(C) ; CLOBBER UPDATED LIST IN + MOVE A,1(C) ; RESTORE ATOM POINTER + +; MARK ATOMS + +ATOMK: + MOVEI 0,@BOTNEW + PUSH P,0 ; SAVE POINTER TO INF + TLO TYPNT,.ATOM. ; SAY ATOM WAS MARKED + MOVEI C,1(A) + PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS + JRST ATMRL1 ; ALREADY MARKED + PUSH P,A ; SAVE DOPE WORD PTR FOR LATER + HLRZ C,(A) ; FIND REAL ATOM PNTR + SUBI C,400001 ; KILL MARK BIT AND ADJUST + HRLI C,-1(C) + SUBM A,C ; NOW TOP OF ATOM +MRKOBL: MOVEI B,TOBLS + HRRZ A,2(C) ; IF > 0, NOT OBL + CAMG A,VECBOT + JRST .+3 + HRLI A,-1 + PUSHJ P,MARK ; AND MARK IT + HRRM A,2(C) + SKIPN GCHAIR + JRST NOMKNX + HLRZ A,2(C) + MOVEI B,TATOM + PUSHJ P,MARK + HRLM A,2(C) +NOMKNX: HLRZ B,(C) ; SEE IF UNBOUND + TRZ B,400000 ; TURN OFF MARK BIT + SKIPE B + CAIN B,TUNBOUND + JRST ATOMK1 ; IT IS UNBOUND + HRRZ 0,(C) ; SEE IF VECTOR OR TP POINTER + MOVEI B,TVEC ; ASSUME VECTOR + SKIPE 0 + MOVEI B,TTP ; ITS A LOCAL VALUE + PUSHJ P,MARK1 ; MARK IT + MOVEM A,1(C) ; SMASH INTO SLOT +ATOMK1: HRRZ 0,2(C) ; MAKE SURE ATOMS NOT ON OBLISTS GET SENT + POP P,A ; RESTORE A + POP P,E ; GET POINTER INTO INF + SKIPN GCHAIR + JUMPN 0,ATMREL + PUSHJ P,ADPMOD + PUSHJ P,TRBLK +ATMREL: HRRZ E,(A) ; RELATAVIZE + SUBI E,(A) + ADDM E,(P) + JRST GCRET +ATMRL1: SUB P,[1,,1] ; POP OFF STACK + JRST ATMREL + + +GETLNT: HLRE B,A ;GET -LNTH + SUB A,B ;POINT TO 1ST DOPE WORD + MOVEI A,1(A) ;POINT TO 2ND DOPE WORD + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST VECTB1 ;BAD VECTOR, COMPLAIN + HLRE B,(A) ;GET LENGTH AND MARKING + IORM D,(A) ;MAKE SURE MARKED + JUMPL B,AMTKE + MOVEI F,(B) ; AMOUNT TO ALLOCATE + PUSHJ P,ALLOGC ;ALLOCATE ROOM + HRRM 0,(A) ; RELATIVIZE +AMTK1: AOS (P) ; A NON MARKED ITEM +AMTKE: POPJ P, ;AND RETURN + +GCRET1: SUB P,[1,,1] ;FLUSH RETURN ADDRESS + JRST GCRET + + + +; MARK NON-GENERAL VECTORS + +NOTGEN: CAMN B,[GENERAL+] + JRST GENRAL ;YES, MARK AS A VECTOR + JUMPL B,SPECLS ; COMPLAIN IF A SPECIAL HACK + SUBI A,1(E) ;POINT TO TOP OF A UNIFORM VECTOR + HLRZS B ;ISOLATE TYPE + ANDI B,TYPMSK + PUSH P,E + SKIPE DUMFLG ; SKIP IF NOT IN DUMPER + PUSHJ P,TYPHK ; HACK WITH TYPE IF SPECIAL + POP P,E ; RESTORE LENGTH + MOVE F,B ; AND COPY IT + LSH B,1 ;FIND OUT WHERE IT WILL GO + HRRZ B,@TYPNT ;GET SAT IN B + ANDI B,SATMSK + MOVEI C,@MKTBS(B) ;POINT TO MARK SR + CAIN C,GCRET ;IF NOT A MARKED FROM GOODIE, IGNORE + JRST UMOVEC + MOVEI C,-1(A) ;POINT 1 PRIOR TO VECTOR START + PUSH P,E ;SAVE NUMBER OF ELEMENTS + PUSH P,F ;AND UNIFORM TYPE + +UNLOOP: MOVE B,(P) ;GET TYPE + MOVE A,1(C) ;AND GOODIE + TLO C,400000 ;CAN'T MUNG TYPE + PUSHJ P,MARK ;MARK THIS ONE + MOVEM A,1(C) ; LIST FIXUP + SOSE -1(P) ;COUNT + AOJA C,UNLOOP ;IF MORE, DO NEXT + + SUB P,[2,,2] ;REMOVE STACK CRAP + JRST UMOVEC + + +SPECLS: FATAL AGC--UNRECOGNIZED SPECIAL VECTOR + SUB P,[4,,4] ; REOVER + JRST AFIXUP + + + +; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS +; AND UPDATES PTR TO THE TABLE. + +GCRDMK: PUSH P,A ; SAVE PTR TO TOP + MOVEI 0,@BOTNEW ; SAVE PTR TO INF + PUSH P,0 + PUSHJ P,GETLNT ; GET TO D.W. AND CHECK MARKING + JRST GCRDRL ; RELATIVIZE + PUSH P,A ; SAVE D.W POINTER + SUBI A,2 + MOVE B,ABOTN ; GET TOP OF ATOM TABLE + HRRZ 0,-2(P) + ADD B,0 ; GET BOTTOM OF ATOM TABLE +GCRD1: CAMG A,B ; DON'T SKIP IF DONE + JRST GCRD2 + HLRZ C,(A) ; GET MARKING + TRZN C,400000 ; SKIP IF MARKED + JRST GCRD3 + MOVEI E,(A) + SUBI A,(C) ; GO BACK ONE ATOM + PUSH P,B ; SAVE B + PUSH P,A ; SAVE POINTER + MOVEI C,-2(E) ; SET UP POINTER + MOVEI B,TATOM ; GO TO MARK + MOVE A,1(C) + PUSHJ P,MARK + MOVEM A,1(C) ; SMASH FIXED UP ATOM BACK IN + POP P,A + POP P,B + JRST GCRD1 +GCRD3: SUBI A,(C) ; TO NEXT ATOM + JRST GCRD1 +GCRD2: POP P,A ; GET PTR TO D.W. + POP P,E ; GET PTR TO INF + SUB P,[1,,1] ; GET RID OF TOP + PUSHJ P,ADPMOD ; FIX UP D.W. + PUSHJ P,TRBLK ; SEND IT OUT + JRST ATMREL ; RELATIVIZE AND LEAVE +GCRDRL: POP P,A ; GET PTR TO D.W + SUB P,[2,,2] ; GET RID OF TOP AND PTR TO INF + JRST ATMREL ; RELATAVIZE + + + +;MARK RELATAVIZED GLOC HACKS + +LOCRMK: SKIPE GCHAIR + JRST GCRET +LOCRDP: PUSH P,C ; SAVE C + MOVEI C,-2(A) ; RELATAVIZED PTR TO ATOM + ADD C,GLTOP ; ADD GLOTOP TO GET TO ATOM + MOVEI B,TATOM ; ITS AN ATOM + SKIPL (C) + PUSHJ P,MARK1 + POP P,C ; RESTORE C + SKIPN DUMFLG ; IF GC-DUMP, WILL STORE ATOM FOR LOCR + JRST LOCRDD + MOVEI B,1 + IORM B,3(A) ; MUNG ATOM TO SAY IT IS LOCR + CAIA +LOCRDD: MOVE A,1(C) ; GET RELATIVIZATION + MOVEM A,(P) ; IT STAYS THE SAVE + JRST GCRET + +;MARK LOCID TYPE GOODIES + +LOCMK: HRRZ B,(C) ;GET TIME + JUMPE B,LOCMK1 ; SKIP LEGAL CHECK FOR GLOBAL + HRRZ 0,2(A) ; GET OTHER TIME + CAIE 0,(B) ; SAME? + SETZB A,(P) ; NO, SMASH LOCATIVE + JUMPE A,GCRET ; LEAVE IF DONE +LOCMK1: PUSH P,C + MOVEI B,TATOM ; MARK ATOM + MOVEI C,-2(A) ; POINT TO ATOM + MOVE E,(C) ; SEE IF BLOCK IS MARKED + TLNE E,400000 ; SKIP IF MARKED + JRST LOCMK2 ; SKIP OVER BLOCK + SKIPN GCHAIR ; DO NOT MARK IF NOT HAIRY (WILL BE MARKED) + PUSHJ P,MARK1 ; LET LOCATIVE SAVE THE ATOM +LOCMK2: POP P,C + HRRZ E,(C) ; TIME BACK + MOVEI B,TVEC ; ASSUME GLOBAL + SKIPE E + MOVEI B,TTP ; ITS LOCAL + PUSHJ P,MARK1 ; MARK IT + MOVEM A,(P) + JRST GCRET + + +; MARK ASSOCIATION BLOCKS + +ASMRK: PUSH P,A +ASMRK1: HRLI A,-ASOLNT ;LOOK LIKE A VECTOR POINTER + PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS + JRST ASTREL ; ALREADY MARKED + MOVEI C,-ASOLNT-1(A) ;COPY POINTER + PUSHJ P,MARK2 ;MARK ITEM CELL + MOVEM A,1(C) + ADDI C,INDIC-ITEM ;POINT TO INDICATOR + PUSHJ P,MARK2 + MOVEM A,1(C) + ADDI C,VAL-INDIC + PUSHJ P,MARK2 + MOVEM A,1(C) + SKIPN GCHAIR ; IF NO HAIR, MARK ALL FRIENDS + JRST ASTREL + HRRZ A,NODPNT-VAL(C) ; NEXT + JUMPN A,ASMRK1 ; IF EXISTS, GO +ASTREL: POP P,A ; RESTORE PTR TO ASSOCIATION + MOVEI A,ASOLNT+1(A) ; POINT TO D.W. + SKIPN NODPNT-ASOLNT-1(A) ; SEE IF EMPTY NODPTR + JRST ASTX ; JUMP TO SEND OUT +ASTR1: HRRZ E,(A) ; RELATAVIZE + SUBI E,(A) + ADDM E,(P) + JRST GCRET ; EXIT +ASTX: HRRZ E,(A) ; GET PTR IN FRONTEIR + SUBI E,ASOLNT+1 ; ADJUST TO POINT TO BEGINNING + PUSHJ P,ADPMOD + PUSHJ P,TRBLK + JRST ASTR1 + +;HERE WHEN A VECTOR POINTER IS BAD + +VECTB1:FATAL AGC--VECTOR POINTS OUTSIDE OF VECTOR SPACE + SUB P,[1,,1] ; RECOVERY +AFIXUP: SETZM (P) ; CLOBBER SLOT + JRST GCRET ; CONTINUE + + +VECTB2: FATAL AGC--VECTOR POINTS OUT OF VECTOR SPACE + SUB P,[2,,2] + JRST AFIXUP ; RECOVER + +PARERR: FATAL AGC--PAIR POINTS OUT OF PAIR SPACE + SUB P,[1,,1] ; RECOVER + JRST AFIXUP + + + ; HERE TO MARK TEMPLATE DATA STRUCTURES + +TD.MRK: MOVEI 0,@BOTNEW ; SAVE PTR TO INF + PUSH P,0 + HLRZ B,(A) ; GET REAL SPEC TYPE + ANDI B,37777 ; KILL SIGN BIT + MOVEI E,-NUMSAT-1(B) ; GET REL POINTER TO TABLE + HRLI E,(E) + ADD E,TD.AGC+1 + HRRZS C,A ; FLUSH COUNT AND SAVE + SKIPL E ; WITHIN BOUNDS + FATAL BAD SAT IN AGC + PUSHJ P,GETLNT ; GOODIE IS NOW MARKED + JRST TMPREL ; ALREADY MARKED + + SKIPE (E) + JRST USRAGC + SUB E,TD.AGC+1 ; POINT TO LENGTH + ADD E,TD.LNT+1 + XCT (E) ; RET # OF ELEMENTS IN B + + HLRZ D,B ; GET POSSIBLE "BASIC LENGTH" FOR RESTS + PUSH P,[0] ; TEMP USED IF RESTS EXIST + PUSH P,D + MOVEI B,(B) ; ZAP TO ONLY LENGTH + PUSH P,C ; SAVE POINTER TO TEMPLATE STRUCTURE + PUSH P,[0] ; HOME FOR VALUES + PUSH P,[0] ; SLOT FOR TEMP + PUSH P,B ; SAVE + SUB E,TD.LNT+1 + PUSH P,E ; SAVE FOR FINDING OTHER TABLES + JUMPE D,TD.MR2 ; NO REPEATING SEQ + ADD E,TD.GET+1 ; COMP LNTH OF REPEATING SEQ + HLRE E,(E) ; E ==> - LNTH OF TEMPLATE + ADDI E,(D) ; E ==> -LENGTH OF REP SEQ + MOVNS E + HRLM E,-5(P) ; SAVE IT AND BASIC + +TD.MR2: SKIPG D,-1(P) ; ANY LEFT? + JRST TD.MR1 + + MOVE E,TD.GET+1 + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + MOVEM D,-6(P) ; SAVE ELMENT # + SKIPN B,-5(P) ; SKIP IF "RESTS" EXIST + SOJA D,TD.MR3 + + MOVEI 0,(B) ; BASIC LNT TO 0 + SUBI 0,(D) ; SEE IF PAST BASIC + JUMPGE 0,.-3 ; JUMP IF O.K. + MOVSS B ; REP LNT TO RH, BASIC TO LH + IDIVI 0,(B) ; A==> -WHICH REPEATER + MOVNS A + ADD A,-5(P) ; PLUS BASIC + ADDI A,1 ; AND FUDGE + MOVEM A,-6(P) ; SAVE FOR PUTTER + ADDI E,-1(A) ; POINT + SOJA D,.+2 + +TD.MR3: ADDI E,(D) ; POINT TO SLOT + XCT (E) ; GET THIS ELEMENT INTO A AND B + JFCL ; NO-OP FOR ANY CASE + MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT + MOVEM B,-2(P) + EXCH A,B ; REARRANGE + GETYP B,B + MOVEI C,-3(P) ; TELL OTHER GUYS THEY CANT DIRECTLY MUNG + MOVSI D,400000 ; RESET FOR MARK + PUSHJ P,MARK ; AND MARK THIS GUY (RET FIXED POINTER IN A) + MOVE C,-4(P) ; REGOBBLE POINTER TO TEMPLATE + MOVE E,TD.PUT+1 + MOVE B,-6(P) ; RESTORE COUNT + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + ADDI E,(B)-1 ; POINT TO SLOT + MOVE B,-3(P) ; RESTORE TYPE WORD + EXCH A,B + SOS D,-1(P) ; GET ELEMENT # + XCT (E) ; SMASH IT BACK + FATAL TEMPLATE LOSSAGE + MOVE C,-4(P) ; RESTORE POINTER IN CASE MUNGED + JRST TD.MR2 + +TD.MR1: MOVE A,-8(P) ; PTR TO DOPE WORD + MOVE E,-7(P) ; RESTORE PTR TO FRONTEIR + SUB P,[7,,7] ; CLEAN UP STACK +USRAG1: ADDI A,1 ; POINT TO SECOND D.W. + MOVSI D,400000 ; SET UP MARK BIT + PUSHJ P,ADPMOD + PUSHJ P,TRBLK ; SEND IT OUT +TMPREL: SUB P,[1,,1] + HRRZ D,(A) + SUBI D,(A) + ADDM D,(P) + MOVSI D,400000 ; RESTORE MARK/UNMARK BIT + JRST GCRET + +USRAGC: HRRZ E,(E) ; MARK THE TEMPLATE + PUSHJ P,(E) + MOVE A,-1(P) ; POINTER TO D.W + MOVE E,(P) ; TOINTER TO FRONTIER + JRST USRAG1 + +; This phase attempts to remove any unwanted associations. The program +; loops through the structure marking values of associations. It can only +; stop when no new values (potential items and/or indicators) are marked. + +VALFLS: PUSH P,LPVP ; SAVE LPVP FOR LATER + PUSH P,[0] ; INDICATE WHETHER ANY ON THIS PASS + PUSH P,[0] ; OR THIS BUCKET +ASOMK1: MOVE A,GCASOV ; GET VECTOR POINTER + SETOM -1(P) ; INITIALIZE FLAG + +ASOM6: SKIPG C,(A) ; SKIP IF BUCKET TO BE SCANNED + JRST ASOM1 + SETOM (P) ; SAY BUCKET NOT CHANGED + +ASOM2: MOVEI F,(C) ; COPY POINTER + SKIPG ASOLNT+1(C) ; SKIP IF NOT ALREADY MARKED + JRST ASOM4 ; MARKED, GO ON + PUSHJ P,MARKQ ; SEE IF ITEM IS MARKED + JRST ASOM3 ; IT IS NOT, IGNORE IT + MOVEI F,(C) ; IN CASE CLOBBERED BY MARK2 + MOVEI C,INDIC(C) ; POINT TO INDICATOR SLOT + PUSHJ P,MARKQ + JRST ASOM3 ; NOT MARKED + + PUSH P,A ; HERE TO MARK VALUE + PUSH P,F + HLRE F,ASOLNT-INDIC+1(C) ; GET LENGTH + JUMPL F,.+3 ; SKIP IF MARKED + CAMGE C,VECBOT ; SKIP IF IN VECT SPACE + JRST ASOM20 + HRRM FPTR,ASOLNT-INDIC+1(C) ; PUT IN RELATIVISATION + MOVEI F,12 ; AMOUNT TO ALLOCATE IN INF + PUSHJ P,ALLOGC + HRRM 0,5(C) ; STICK IN RELOCATION + +ASOM20: PUSHJ P,MARK2 ; AND MARK + MOVEM A,1(C) ; LIST FIX UP + ADDI C,ITEM-INDIC ; POINT TO ITEM + PUSHJ P,MARK2 + MOVEM A,1(C) + ADDI C,VAL-ITEM ; POINT TO VALUE + PUSHJ P,MARK2 + MOVEM A,1(C) + IORM D,ASOLNT-VAL+1(C) ; MARK ASOC BLOCK + POP P,F + POP P,A + AOSA -1(P) ; INDICATE A MARK TOOK PLACE + +ASOM3: AOS (P) ; INDICATE AN UNMARKED IN THIS BUCKET +ASOM4: HRRZ C,ASOLNT-1(F) ; POINT TO NEXT IN BUCKET + JUMPN C,ASOM2 ; IF NOT EMPTY, CONTINUE + SKIPGE (P) ; SKIP IF ANY NOT MARKED + HRROS (A) ; MARK BUCKET AS NOT INTERESTING +ASOM1: AOBJN A,ASOM6 ; GO TO NEXT BUCKET + TLZE TYPNT,.ATOM. ; ANY ATOMS MARKED? + JRST VALFLA ; YES, CHECK VALUES +VALFL8: + +; NOW SEE WHICH CHANNELS STILL POINTED TO + +CHNFL3: MOVEI 0,N.CHNS-1 + MOVEI A,CHNL1 ; SLOTS + HRLI A,TCHAN ; TYPE HERE TOO + +CHNFL2: SKIPN B,1(A) + JRST CHNFL1 + HLRE C,B + SUBI B,(C) ; POINT TO DOPE + HLLM A,(A) ; PUT TYPE BACK + HRRE F,(A) ; SEE IF ALREADY MARKED + JUMPN F,CHNFL1 + SKIPGE 1(B) + JRST CHNFL8 + HLLOS (A) ; MARK AS A LOSER + SETZM -1(P) + JRST CHNFL1 +CHNFL8: MOVEI F,1 ; MARK A GOOD CHANNEL + HRRM F,(A) +CHNFL1: ADDI A,2 + SOJG 0,CHNFL2 + + SKIPE GCHAIR ; IF NOT HAIRY CASE + POPJ P, ; LEAVE + + SKIPL -1(P) ; SKIP IF NOTHING NEW MARKED + JRST ASOMK1 + + SUB P,[2,,2] ; REMOVE FLAGS + + + +; HERE TO REEMOVE UNUSED ASSOCIATIONS + + MOVE A,GCASOV ; GET ASOVEC BACK FOR FLUSHES + +ASOFL1: SKIPN C,(A) ; SKIP IF BUCKET NOT EMPTY + JRST ASOFL2 ; EMPTY BUCKET, IGNORE + HRRZS (A) ; UNDO DAMAGE OF BEFORE + +ASOFL5: SKIPGE ASOLNT+1(C) ; SKIP IF UNMARKED + JRST ASOFL6 ; MARKED, DONT FLUSH + + HRRZ B,ASOLNT-1(C) ; GET FORWARD POINTER + HLRZ E,ASOLNT-1(C) ; AND BACK POINTER + JUMPN E,ASOFL4 ; JUMP IF NO BACK POINTER (FIRST IN BUCKET) + HRRZM B,(A) ; FIX BUCKET + JRST .+2 + +ASOFL4: HRRM B,ASOLNT-1(E) ; FIX UP PREVIOUS + JUMPE B,.+2 ; JUMP IF NO NEXT POINTER + HRLM E,ASOLNT-1(B) ; FIX NEXT'S BACK POINTER + HRRZ B,NODPNT(C) ; SPLICE OUT THRAD + HLRZ E,NODPNT(C) + SKIPE E + HRRM B,NODPNT(E) + SKIPE B + HRLM E,NODPNT(B) + +ASOFL3: HRRZ C,ASOLNT-1(C) ; GO TO NEXT + JUMPN C,ASOFL5 +ASOFL2: AOBJN A,ASOFL1 + + + +; NOW CLOBBER UNMARKED LOCAL NAD GLOBAL VALUES + + MOVE A,GCGBSP ; GET GLOBAL PDL + +GLOFLS: SKIPGE (A) ; SKIP IF NOT ALREADY MARKED + JRST SVDCL + MOVSI B,-3 + PUSHJ P,ZERSLT ; CLOBBER THE SLOT + HLLZS (A) +SVDCL: ANDCAM D,(A) ; UNMARK + ADD A,[4,,4] + JUMPL A,GLOFLS ; MORE?, KEEP LOOPING + + MOVEM LPVP,(P) +LOCFL1: HRRZ A,(LPVP) ; NOW CLOBBER LOCAL SLOTS + HRRZ C,2(LPVP) + MOVEI LPVP,(C) + JUMPE A,LOCFL2 ; NONE TO FLUSH + +LOCFLS: SKIPGE (A) ; MARKDE? + JRST .+3 + MOVSI B,-5 + PUSHJ P,ZERSLT + ANDCAM D,(A) ;UNMARK + HRRZ A,(A) ; GO ON + JUMPN A,LOCFLS +LOCFL2: JUMPN LPVP,LOCFL1 ; JUMP IF MORE PROCESS + +; AT THIS POINT THE LOCALS ARE FINALLY SENT OUT. +; THIS ROUTINE UPDATES THE THIS-PROCESS BINDING. IT FIXES UP THE SP-CHAIN AND IT +; SENDS OUT THE ATOMS. + +LOCFL3: MOVE C,(P) + MOVEI B,TATOM ; MARK THE BINDING TO THIS PROCESS + PUSHJ P,MARK1 ; MARK THE ATOM + MOVEM A,1(C) ; NEW HOME + MOVEI C,2(C) ; MARK VALUE + MOVEI B,TPVP ; IT IS A PROCESS VECTOR POINTER + PUSHJ P,MARK1 ; MARK IT + MOVEM A,1(C) + POP P,R +NEXPRO: MOVEI 0,TPVP ; FIX UP SLOT + HLRZ A,2(R) ; GET PTR TO NEXT PROCESS + HRLM 0,2(R) + HRRZ E,(A) ; ADRESS IN INF + HRRZ B,(A) ; CALCULATE RELOCATION + SUB B,A + PUSH P,B + HRRZ F,A ; CALCULATE START OF TP IN F + HLRZ B,(A) ; ADJUST INF PTR + TRZ B,400000 + SUBI F,-1(B) + LDB M,[111100,,-1(A)] ; CALCULATE TOP GROWTH + TRZE M,400 ; FUDGE SIGN + MOVNS M + ASH M,6 + ADD B,M ; FIX UP LENGTH + EXCH M,(P) + SUBM M,(P) ; FIX RELOCATION TO TAKE INTO ACCOUNT CHANGE IN LENGTH + MOVE M,R ; GET A COPY OF R +NEXP1: HRRZ C,(M) ; GET PTR TO NEXT IN CHAIN + JUMPE C,NEXP2 ; EXIT IF END OF CHAIN + MOVE 0,C ; GET COPY OF CHAIN PTR TO UPDATE + ADD 0,(P) ; UPDATE + HRRM 0,(M) ; PUT IN + MOVE M,C ; NEXT + JRST NEXP1 +NEXP2: SUB P,[1,,1] ; CLEAN UP STACK + SUBI E,-1(B) + HRRI B,(R) ; GET POINTER TO THIS-PROCESS BINDING + MOVEI B,6(B) ; POINT AFTER THE BINDING + MOVE 0,F ; CALCULATE # OF WORDS TO SEND OUT + SUBM B,0 + PUSH P,R ; PRESERVE R + PUSHJ P,TRBLKX ; SEND IT OUT + POP P,R ; RESTORE R + HRRZS R,2(R) ; GET THE NEXT PROCESS + SKIPN R + JRST .+3 + PUSH P,R + JRST LOCFL3 + MOVE A,GCGBSP ; PTR TO GLOBAL STACK + PUSHJ P,SPCOUT ; SEND IT OUT + MOVE A,GCASOV + PUSHJ P,SPCOUT ; SEND IT OUT + POPJ P, + +; THIS ROUTINE MARKS ALL THE CHANNELS +; IT THEN SENDS OUT A COPY OF THE TVP + +CHFIX: MOVEI 0,N.CHNS-1 + MOVEI A,CHNL1 ; SLOTS + HRLI A,TCHAN ; TYPE HERE TOO + +DHNFL2: SKIPN B,1(A) + JRST DHNFL1 + MOVEI C,(A) ; MARK THE CHANNEL + PUSH P,0 ; SAVE 0 + PUSH P,A ; SAVE A + PUSHJ P,MARK2 + MOVEM A,1(C) ; ADJUST PTR + POP P,A ; RESTORE A + POP P,0 ; RESTORE +DHNFL1: ADDI A,2 + SOJG 0,DHNFL2 + POPJ P, + + +; ROUTINE TO SEND OUT SPECIAL STUFF FROM GCHAIR + +SPCOUT: HLRE B,A + SUB A,B + MOVEI A,1(A) ; POINT TO DOPE WORD + LDB 0,[001100,,-1(A)] ;GET GROWTH FACTOR + TRZE 0,400 ;KILL SIGN BIT AND SKIP IF + + MOVNS 0 ;NEGATE + ASH 0,6 ;CONVERT TO NUMBER OF WORDS + PUSHJ P,DOPMOD + HRRZ E,(A) ; GET PTR TO INF + HLRZ B,(A) ; LENGTH + TRZ B,400000 ; GET RID OF MARK BIT + SUBI E,-1(B) + ADD E,0 + PUSH P,0 ; DUMMY FOR TRBLKV + PUSHJ P,TRBLKV ; OUT IT GOES + SUB P,[1,,1] + POPJ P, ;RETURN + +ASOFL6: HLRZ E,ASOLNT-1(C) ; SEE IF FIRST IN BUCKET + JUMPN E,ASOFL3 ; IF NOT CONTINUE + HRRZ E,ASOLNT+1(C) ; GET PTR FROM DOPE WORD + SUBI E,ASOLNT+1 ; ADJUST TO POINT TO BEGINNING OF ALSSOCIATION + HRRZM E,(A) ; SMASH IT IN + JRST ASOFL3 + + +MARK23: PUSH P,A ; SAVE BUCKET POINTER + PUSH P,F + PUSHJ P,MARK2 + MOVEM A,1(C) + POP P,F + POP P,A + AOS -2(P) ; MARKING HAS OCCURRED + IORM D,ASOLNT+1(C) ; MARK IT + JRST MKD + + ; CHANNEL FLUSHER FOR NON HAIRY GC + +CHNFLS: PUSH P,[-1] + SETOM (P) ; RESET FOR RETRY + PUSHJ P,CHNFL3 + SKIPL (P) + JRST .-3 ; REDO + SUB P,[1,,1] + POPJ P, + +; VALUE FLUSHING PHASE, HACKS BOTTOM OF TP AND GLOBAL SP + +VALFLA: MOVE C,GCGBSP ; GET POINTER TO GLOBAL STACK +VALFL1: SKIPL (C) ; SKIP IF NOT MARKED + PUSHJ P,MARKQ ; SEE IF ATOM IS MARKED + JRST VALFL2 + PUSH P,C + MOVEI B,TATOM ; UPDATE ATOM SLOT + PUSHJ P,MARK1 + MOVEM A,1(C) + IORM D,(C) + AOS -2(P) ; INDICATE MARK OCCURRED + HRRZ B,(C) ; GET POSSIBLE GDECL + JUMPE B,VLFL10 ; NONE + CAIN B,-1 ; MAINFIFEST + JRST VLFL10 + MOVEI A,(B) + MOVEI B,TLIST + MOVEI C,0 + PUSHJ P,MARK ; MARK IT + MOVE C,(P) ; POINT + HRRM A,(C) ; CLOBBER UPDATE IN +VLFL10: ADD C,[2,,2] ; BUMP TO VALUE + PUSHJ P,MARK2 ; MARK VALUE + MOVEM A,1(C) + POP P,C +VALFL2: ADD C,[4,,4] + JUMPL C,VALFL1 ; JUMP IF MORE + + HRLM LPVP,(P) ; SAVE POINTER +VALFL7: MOVEI C,(LPVP) + MOVEI LPVP,0 +VALFL6: HRRM C,(P) + +VALFL5: HRRZ C,(C) ; CHAIN + JUMPE C,VALFL4 + MOVEI B,TATOM ; TREAT LIKE AN ATOM + SKIPL (C) ; MARKED? + PUSHJ P,MARKQ1 ; NO, SEE + JRST VALFL5 ; LOOP + AOS -1(P) ; MARK WILL OCCUR + MOVEI B,TATOM ; RELATAVIZE + PUSHJ P,MARK1 + MOVEM A,1(C) + IORM D,(C) + ADD C,[2,,2] ; POINT TO VALUE + PUSHJ P,MARK2 ; MARK VALUE + MOVEM A,1(C) + SUBI C,2 + JRST VALFL5 + +VALFL4: HRRZ C,(P) ; GET SAVED LPVP + MOVEI A,(C) + HRRZ C,2(C) ; POINT TO NEXT + JUMPN C,VALFL6 + JUMPE LPVP,VALFL9 + + HRRM LPVP,2(A) ; NEW PROCESS WAS MARKED + JRST VALFL7 + +ZERSLT: HRRI B,(A) ; COPY POINTER + SETZM 1(B) + AOBJN B,.-1 + POPJ P, + +VALFL9: HLRZ LPVP,(P) ; RESTORE CHAIN + JRST VALFL8 + + ;SUBROUTINE TO SEE IF A GOODIE IS MARKED +;RECEIVES POINTER IN C +;SKIPS IF MARKED NOT OTHERWISE + +MARKQ: HLRZ B,(C) ;TYPE TO B +MARKQ1: MOVE E,1(C) ;DATUM TO C + MOVEI 0,(E) + CAIL 0,@PURBOT ; DONT CHACK PURE + JRST MKD ; ALWAYS MARKED + ANDI B,TYPMSK ; FLUSH MONITORS + LSH B,1 + HRRZ B,@TYPNT ;GOBBLE SAT + ANDI B,SATMSK + CAIG B,NUMSAT ; SKIP FOR TEMPLATE + JRST @MQTBS(B) ;DISPATCH + ANDI E,-1 ; FLUSH REST HACKS + JRST VECMQ + + +MQTBS: + +OFFSET 0 + +DISTB2 DUM3,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ] +[STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SLOCID,LOCMQ] +[SATOM,ATMMQ],[SPVP,VECMQ],[SCHSTR,BYTMQ],[SLOCA,ARGMQ],[SLOCU,VECMQ] +[SLOCV,VECMQ],[SLOCS,BYTMQ],[SLOCN,ASMQ],[SASOC,ASMQ],[SLOCL,PAIRMQ],[SGATOM,ATMMQ] +[SBYTE,BYTMQ],[SLOCB,BYTMQ],[SDEFQ,PAIRMQ],[SOFFS,OFFSMQ]] + +OFFSET OFFS + +PAIRMQ: JUMPE E,MKD ; NIL ALWAYS MARKED + SKIPL (E) ; SKIP IF MARKED + POPJ P, +ARGMQ: +MKD: AOS (P) + POPJ P, + +BYTMQ: PUSH P,A ; SAVE A + PUSHJ P,BYTDOP ; GET PTR TO DOPE WORD + MOVE E,A ; COPY POINTER + POP P,A ; RESTORE A + SKIPGE (E) ; SKIP IF NOT MARKED + AOS (P) + POPJ P, ; EXIT + +FRMQ: HRRZ E,(C) ; POINT TO PV DOPE WORD + SOJA E,VECMQ1 + +ATMMQ: CAML 0,GCSBOT ; ALWAYS KEEP FROZEN ATOMS + JRST VECMQ + AOS (P) + POPJ P, + +VECMQ: HLRE 0,E ;GET LENGTH + SUB E,0 ;POINT TO DOPE WORDS + +VECMQ1: SKIPGE 1(E) ;SKIP IF NOT MARKED + AOS (P) ;MARKED, CAUSE SKIP RETURN + POPJ P, + +ASMQ: ADDI E,ASOLNT + JRST VECMQ1 + +LOCMQ: HRRZ 0,(C) ; GET TIME + JUMPE 0,VECMQ ; GLOBAL, LIKE VECTOR + HLRE 0,E ; FIND DOPE + SUB E,0 + MOVEI E,1(E) ; POINT TO LAST DOPE + CAMN E,TPGROW ; GROWING? + SOJA E,VECMQ1 ; YES, CHECK + ADDI E,PDLBUF ; FUDGE + MOVSI 0,-PDLBUF + ADDM 0,1(C) + SOJA E,VECMQ1 + +OFFSMQ: HLRZS E ; POINT TO LIST STRUCTURE + SKIPGE (E) ; MARKED? + AOS (P) ; YES + POPJ P, + + ; SUBROUTINE TO UPDATE ASSOCIATIONS AND MOVE THEM INTO THE INF + +ASSOUP: MOVE A,GCNOD ; RECOVER PTR TO START OF CHAIN +ASSOP1: HRRZ B,NODPNT(A) + PUSH P,B ; SAVE NEXT ON CHAIN + PUSH P,A ; SAVE IT + HRRZ B,ASOLNT-1(A) ;POINT TO NEXT + JUMPE B,ASOUP1 + HRRZ C,ASOLNT+1(B) ;AND GET ITS RELOC IN C + SUBI C,ASOLNT+1(B) ; RELATIVIZE + ADDM C,ASOLNT-1(A) ;C NOW HAS UPDATED POINTER +ASOUP1: HLRZ B,ASOLNT-1(A) ;GET PREV BLOCK POINTER + JUMPE B,ASOUP2 + HRRZ F,ASOLNT+1(B) ;AND ITS RELOCATION + SUBI F,ASOLNT+1(B) ; RELATIVIZE + MOVSI F,(F) + ADDM F,ASOLNT-1(A) ;RELOCATE +ASOUP2: HRRZ B,NODPNT(A) ;UPDATE NODE CHAIN + JUMPE B,ASOUP4 + HRRZ C,ASOLNT+1(B) ;GET RELOC + SUBI C,ASOLNT+1(B) ; RELATIVIZE + ADDM C,NODPNT(A) ;AND UPDATE +ASOUP4: HLRZ B,NODPNT(A) ;GET PREV POINTER + JUMPE B,ASOUP5 + HRRZ F,ASOLNT+1(B) ;RELOC + SUBI F,ASOLNT+1(B) + MOVSI F,(F) + ADDM F,NODPNT(A) +ASOUP5: POP P,A ; RECOVER PTR TO DOPE WORD + MOVEI A,ASOLNT+1(A) + MOVSI B,400000 ;UNMARK IT + XORM B,(A) + HRRZ E,(A) ; SET UP PTR TO INF + HLRZ B,(A) + SUBI E,-1(B) ; ADJUST PTR + PUSHJ P,ADPMOD + PUSHJ P,TRBLK ; OUT IT GOES + POP P,A ; RECOVER PTR TO ASSOCIATION + JUMPN A,ASSOP1 ; IF NOT ZERO CONTINUP + POPJ P, ; DONE + + +; HERE TO CLEAN UP ATOM HASH TABLE + +ATCLEA: MOVE A,GCHSHT ; GET TABLE POINTER + +ATCLE1: MOVEI B,0 + SKIPE C,(A) ; GET NEXT + JRST ATCLE2 ; GOT ONE + +ATCLE3: PUSHJ P,OUTATM + AOBJN A,ATCLE1 + + MOVE A,GCHSHT ; MOVE OUT TABLE + PUSHJ P,SPCOUT + POPJ P, + +; HAVE AN ATOM IN C + +ATCLE2: MOVEI B,0 + +ATCLE5: CAIL C,HIBOT + JRST ATCLE3 + CAMG C,VECBOT ; FROZEN ATOMS ALWAYS MARKED + JRST .+3 + SKIPL 1(C) ; SKIP IF ATOM MARKED + JRST ATCLE6 + + HRRZ 0,1(C) ; GET DESTINATION + CAIN 0,-1 ; FROZEN/MAGIC ATOM + MOVEI 0,1(C) ; USE CURRENT POSN + SUBI 0,1 ; POINT TO CORRECT DOPE + JUMPN B,ATCLE7 ; JUMP IF GOES INTO ATOM + + HRRZM 0,(A) ; INTO HASH TABLE + JRST ATCLE8 + +ATCLE7: HRLM 0,2(B) ; INTO PREV ATOM + PUSHJ P,OUTATM + +ATCLE8: HLRZ B,1(C) + ANDI B,377777 ; KILL MARK BIT + SUBI B,2 + HRLI B,(B) + SUBM C,B + HLRZ C,2(B) + JUMPE C,ATCLE3 ; DONE WITH BUCKET + JRST ATCLE5 + +; HERE TO PASS OVER LOST ATOM + +ATCLE6: HLRZ F,1(C) ; FIND NEXT ATOM + SUBI C,-2(F) + HLRZ C,2(C) + JUMPE B,ATCLE9 + HRLM C,2(B) + JRST .+2 +ATCLE9: HRRZM C,(A) + JUMPE C,ATCLE3 + JRST ATCLE5 + +OUTATM: JUMPE B,CPOPJ + PUSH P,A + PUSH P,C + HLRE A,B + SUBM B,A + MOVSI D,400000 ;UNMARK IT + XORM D,1(A) + HRRZ E,1(A) ; SET UP PTR TO INF + HLRZ B,1(A) + SUBI E,-1(B) ; ADJUST PTR + MOVEI A,1(A) + PUSHJ P,ADPMOD + PUSHJ P,TRBLK ; OUT IT GOES + POP P,C + POP P,A ; RECOVER PTR TO ASSOCIATION + POPJ P, + + +VCMLOS: FATAL AGC--VECTOR WITH ZERO IN DOPE WORD LENGTH + + +; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC + +MSGGCT: [ASCIZ /USER CALLED- /] + [ASCIZ /FREE STORAGE- /] + [ASCIZ /TP-STACK- /] + [ASCIZ /TOP-LEVEL LOCALS- /] + [ASCIZ /GLOBAL VALUES- /] + [ASCIZ /TYPES- /] + [ASCIZ /STATIONARY IMPURE STORAGE- /] + [ASCIZ /P-STACK /] + [ASCIZ /BOTH STACKS BLOWN- /] + [ASCIZ /PURE STORAGE- /] + [ASCIZ /GC-RCALL- /] + +; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC + +GCPAT: SPBLOK 100 +EGCPAT: -1 + +MSGGFT: [ASCIZ /GC-READ /] + [ASCIZ /BLOAT /] + [ASCIZ /GROW /] + [ASCIZ /LIST /] + [ASCIZ /VECTOR /] + [ASCIZ /SET /] + [ASCIZ /SETG /] + [ASCIZ /FREEZE /] + [ASCIZ /PURE-PAGE LOADER /] + [ASCIZ /GC /] + [ASCIZ /INTERRUPT-HANDLER /] + [ASCIZ /NEWTYPE /] + [ASCIZ /PURIFY /] + +.GLOBAL GCNO,BSTGC,BSTAT,NOWFRE,CURFRE,MAXFRE,USEFRE,NOWTP,CURTP,CTPMX,NOWLFL +.GLOBAL CURLVL,NOWGVL,CURGVL,NOWTYP,CURTYP,NOWSTO,CURSTO,CURMAX,NOWP,CURP,CPMX +.GLOBAL GCCAUS,GCCALL,LVLINC,GVLINC,TYPIC,STORIC,RCL,RCLV,GCDANG,GETNUM,RPTOP,CORTOP +.GLOBAL TPGROW,PPGROW,PGROW,PMAIN,PGOOD,PMAX,TPGOOD,TPMIN,TPMAX,RFRETP,TYPTAB +.GLOBAL NNPRI,NNSAT,TYPSAV,BUFGC,GCTIM,GPURFL,GCDFLG,DUMFLG +.GLOBAL TPBINC,GBLINC,TYPINC,CONADJ,OGCSTP,ABOTN,MAXLEN +.GLOBAL PURMIN,GCMONF,.LIST.,FPAG,PMIN,GLBINC,INCORF,PURCOR,GCHAIR + + +;LOCAL VARIABLES + +OFFSET 0 + +IMPURE +; LOCACTIONS USED BY THE PAGE HACKER + +DOPSV1: 0 ;SAVED FIRST D.W. +DOPSV2: 0 ; SAVED LENGTH + + +; LOCATIONS USED BY BLOAT-STAT TO HELP THE USER PICK BLOAT SPECIFICATIONS. +; + +GCNO: 0 ; USER-CALLED GC +BSTGC: 0 ; FREE STORAGE + 0 ; BLOWN TP + 0 ; TOP-LEVEL LVALS + 0 ; GVALS + 0 ; TYPE + 0 ; STORAGE + 0 ; P-STACK + 0 ; BOTH STATCKS BLOWN + 0 ; STORAGE + +BSTAT: +NOWFRE: 0 ; FREE STORAGE FROM LAST GC +CURFRE: 0 ; STORAGE USED SINCE LAST GC +MAXFRE: 0 ; MAXIMUM FREE STORAGE ALLOCATED +USEFRE: 0 ; TOTAL FREE STORAGE USED +NOWTP: 0 ; TP LENGTH FROM LAST GC +CURTP: 0 ; # WORDS ON TP +CTPMX: 0 ; MAXIMUM SIZE OF TP SO FAR +NOWLVL: 0 ; # OF TOP-LEVEL LVAL-SLOTS +CURLVL: 0 ; # OF TOP-LEVEL LVALS +NOWGVL: 0 ; # OF GVAL SLOTS +CURGVL: 0 ; # OF GVALS +NOWTYP: 0 ; SIZE OF TYPE-VECTOR +CURTYP: 0 ; # OF TYPES +NOWSTO: 0 ; SIZE OF STATIONARY STORAGE +CURSTO: 0 ; STATIONARY STORAGE IN USE +CURMAX: 0 ; MAXIMUM BLOCK OF CONTIGUOUS STORAGE +NOWP: 0 ; SIZE OF P-STACK +CURP: 0 ; #WORDS ON P +CPMX: 0 ; MAXIMUM P-STACK LENGTH SO FAR +GCCAUS: 0 ; INDICATOR FOR CAUSE OF GC +GCCALL: 0 ; INDICATOR FOR CALLER OF GC + + +; THIS GROUP OF VARIABLES DETERMINES HOW THINGS GROW +LVLINC: 6 ; LVAL INCREMENT ASSUMED TO BE 64 SLOTS +GVLINC: 4 ; GVAL INCREMENT ASSUMED TO BE 64 SLOTS +TYPIC: 1 ; TYPE INCREMENT ASSUMED TO BE 32 TYPES +STORIC: 2000 ; STORAGE INCREMENT USED BY NFREE (MINIMUM BLOCK-SIZE) + + +RCL: 0 ; POINTER TO LIST OF RECYCLEABLE LIST CELLS +RCLV: 0 ; POINTER TO RECYCLED VECTORS +GCMONF: 0 ; NON-ZERO SAY GIN/GOUT +GCDANG: 0 ; NON-ZERO, STORAGE IS LOW +INBLOT: 0 ; INDICATE THAT WE ARE RUNNING OIN A BLOAT +GETNUM: 0 ;NO OF WORDS TO GET +RFRETP: +RPTOP: 0 ;NO OF BLOCKS OF CORE, IF GIVING CORE AWAY +CORTOP: 0 ;CURRENT TOP OF CORE, EXCLUDING ANY TO BE GIVEN AWAY +NGCS: 8 ; NUMBER OF GARBAGE COLLECTS BETWEEN HAIRY GCS + +;VARIABLES WHICH DETERMIN WHEN MUDDLE WILL ASK FOR MORE CORE, +;AND WHEN IT WILL GET UNHAPPY + +FREMIN: 20000 ;MINIMUM FREE WORDS + +;POINTER TO GROWING PDL + +TPGROW: 0 ;POINTS TO A BLOWN TP +PPGROW: 0 ;POINTS TO A BLOWN PP +PGROW: 0 ;POINTS TO A BLOWN P + +;IN GC FLAG + +GCFLG: 0 +GCFLCH: 0 ; TELL INT HANDLER TO ITIC CHARS +GCHAIR: 1 ; COUNTS GCS AND TELLS WHEN TO HAIRIFY +GCDOWN: 0 ; AMOUNT TO TRY AND MOVE DOWN +CURPLN: 0 ; LENGTH OF CURRENTLY RUNNING PURE RSUBR +PURMIN: 0 ; MINIMUM PURE STORAGE + +; VARS ASSOCIATED WITH BLOAT LOGIC +PMIN: 200 ; MINIMUM FOR PSTACK +PGOOD: 1000 ; GOOD SIZE FOR PSTACK +PMAX: 4000 ; MAX SIZE FOR PSTACK +TPMIN: 1000 ; MINIMUM SIZE FOR TP +TPGOOD: NTPGOO ; GOOD SIZE OF TP +TPMAX: NTPMAX ; MAX SIZE OF TP + +TPBINC: 0 +GLBINC: 0 +TYPINC: 0 + +; VARS FOR PAGE WINDOW HACKS + +GCHSHT: 0 ; SAVED ATOM TABLE +PURSVT: 0 ; SAVED PURVEC TABLE +GLTOP: 0 ; SAVE GLOTOP +GCNOD: 0 ; PTR TO START OF ASSOCIATION CHAIN +GCGBSP: 0 ; SAVED GLOBAL SP +GCASOV: 0 ; SAVED PTR TO ASSOCIATION VECTOR +GCATM: 0 ; PTR TO IMQUOT THIS-PROCESS +FNTBOT: 0 ; BOTTOM OF FRONTEIR +WNDBOT: 0 ; BOTTOM OF WINDOW +WNDTOP: 0 +BOTNEW: (FPTR) ; POINTER TO FRONTIER +GCTIM: 0 +NPARBO: 0 ; SAVED PARBOT + +; FLAGS TO INDICATE DUMPER IS IN USE + +GPURFL: 0 ; INDICATE PURIFIER IS RUNNING +GCDFLG: 0 ; INDICATE EITHER GCDUMP OR PURIFIER IS RUNNING +DUMFLG: 0 ; FLAG INDICATING DUMPER IS RUNNING + +; CONSTANTS FOR DUMPER,READER AND PURIFYER + +ABOTN: 0 ; COUNTER FOR ATOMS +NABOTN: 0 ; POINTER USED BY PURIFY +OGCSTP: 0 ; CONTAINS OLD GCSTOP FOR READER +MAPUP: 0 ; BEGINNING OF MAPPED UP PURE STUFF +SAVRES: 0 ; SAVED UPDATED ITEM OF PURIFIER +SAVRE2: 0 ; SAVED TYPE WORD +SAVRS1: 0 ; SAVED PTR TO OBJECT +INF1: 0 ; AOBJN PTR USED IN CREATING PROTECTION INF +INF2: 0 ; AOBJN PTR USED IN CREATING SECOND INF +INF3: 0 ; AOBJN PTR USED TO PURIFY A STRUCTURE + +; VARIABLES USED BY GC INTERRUPT HANDLER + +GCHPN: 0 ; SET TO -1 EVERYTIME A GC HAS OCCURED +GCKNUM: 0 ; NUMBER OF WORDS OF REQUEST TO INTERRUPT + +; VARIABLE TO INDICATE WHETHER AGC HAS PUSHED THE MAPPING CHANNEL TO WIN + +PSHGCF: 0 + +; VARIABLES USED BY DUMPER AND READER TO HANDLE NEWTYPES + +TYPTAB: 0 ; POINTER TO TYPE TABLE +NNPRI: 0 ; NUMPRI FROM DUMPED OBJECT +NNSAT: 0 ; NUMSAT FROM DUMPED OBJECT +TYPSAV: 0 ; SAVE PTR TO TYPE VECTOR + +; VARIABLES USED BY GC-DUMP FOR COPY-WRITE MAPPING + +BUFGC: 0 ; BUFFER FOR COPY ON WRITE HACKING +PURMNG: 0 ; FLAG INDICATING IF A PURIFIED PAGE WAS MUNGED DURING GC-DUMP +RPURBT: 0 ; SAVED VALUE OF PURTOP +RGCSTP: 0 ; SAVED GCSTOP + +; VARIABLES USED TO DETERMINE WHERE THE GC-DUMPED STRUCTURE SHOULD GO + +INCORF: 0 ; INDICATION OF UVECTOR HACKS FOR GC-DUMP +PURCOR: 0 ; INDICATION OF UVECTOR TO PURE CORE + ; ARE NOT GENERATED + + +PLODR: 0 ; INDICATE A PLOAD IS IN OPERATION +NPRFLG: 0 + +; VARIABLE USED BY MARK SWEEP GARBAGE COLLECTOR + +MAXLEN: 0 ; MAXIMUM RECLAIMED SLOT + +PURE + +OFFSET OFFS + +CONSTANTS + +HERE + +CONSTANTS + +OFFSET 0 + +ZZ==$.+1777 + +.LOP ANDCM ZZ 1777 + +ZZ1==.LVAL1 + +LOC ZZ1 + + +OFFSET OFFS + +WIND: SPBLOK 2000 +FRONT: SPBLOK 2000 +MRKPD: SPBLOK 1777 +ENDPDL: -1 + +MRKPDL=MRKPD-1 + +ENDGC: + +OFFSET 0 + +.LOP WIND <,-10.> +WNDP==.LVAL1 + +.LOP FRONT <,-10.> +FRNP==.LVAL1 + +ZZ2==ENDGC-AGCLD +.LOP ZZ2 <,-10.> +LENGC==.LVAL1 + +.LOP LENGC <,10.> +RLENGC==.LVAL1 + +.LOP AGCLD <,-10.> +PAGEGC==.LVAL1 + +OFFSET 0 + +LOC GCST +.LPUR==$. + +END + diff --git a//agc.mid.140 b//agc.mid.140 new file mode 100644 index 0000000..433a455 --- /dev/null +++ b//agc.mid.140 @@ -0,0 +1,3632 @@ +TITLE AGC MUDDLE GARBAGE COLLECTOR + +;SYSTEM WIDE DEFINITIONS GO HERE + +RELOCATABLE +GCST==$. + + +.GLOBAL RCL,VECTOP,GCSTOP,GCSBOT,FRETOP,GCSNEW,VECBOT,PARTOP,PARBOT,HITOP,HIBOT,GETPAG +.GLOBAL PDLBUF,PDLEX,PDLEXP,GCFLG,GCPDL,GETNUM,PARNEW,MOVPUR,RCLV,RCLVEC,PGCNT +.GLOBAL PGROW,TPGROW,MAINPR,MSGTYP,PURTOP,PURBOT,STOSTR,GCSET,CKPUR +.GLOBAL MTYI,UPLO,FRMUNG,BYTDOP,GLOBSP,FREDIF,FREMIN,GCHAPN,INTFLG,FINAGC,NGCS,INQAGC +.GLOBAL SAT,TTOCHN,TYPVEC,ICONS,INCONS,IBLOCK,IEUVEC,IEVECTI,CELL2,MKTBS,RLENGC +.GLOBAL GIBLOK,REHASH,IBLOK1,IILIST,IIFORM,CIVEC,CIUVEC,CICONS,CPOPJ,RBLDM,GCOFFS +.GLOBAL SPBASE,OUTRNG,CISTNG,CBYTES,%RUNAM,PURVEC,GCDOWN,N.CHNS,CHNL1,PLODR,MRKPDL +.GLOBAL CAFRE,CAFRET,STOGC,GCHN,WNDP,FRNP,FRONT,%GCJOB,%SHWND,%INFMP,%GETIP,CHKPGI +.GLOBAL TD.PUT,TD.GET,TD.AGC,TD.AGC,TD.LNT,GLOTOP,UBIT,FLGSET,PURMNG,RPURBT,%IFMP2 +.GLOBAL CTIME,IMTYO,ILOC,NODES,GPURFL,GCDANG,GCHACK,LPUR,HITOP,BADCHN,IMPURX,PURCLN +.GLOBAL GCTIM,GCCAUS,GCCALL,IAAGC,LVLINC,STORIC,GVLINC,TYPIC,GCRSET,ACCESS,NOSHUF,SQUPNT +; GLOBALS ASSOCIATE WITH THE ASSOCIATION VECTOR + +.GLOBAL ASOVEC,ASOLNT,ITEM,INDIC,VAL,NWORDT,NODPNT,PNTRS,DSTORE,HASHTB +.GLOBAL CELL,BINDID,GCFLCH,TYPBOT,GLOBAS,TPBASE,NOWLVL,CURPLN,PVSTOR,SPSTOR + +.GLOBAL P.TOP,P.CORE,PMAPB,IGET,CIGTPR,ROOT,STBL,CAFREE,%MPIN1,%PURIF,%MPINX,GCHK10 +.GLOBAL %SAVRP,%RSTRP,LENGC,AGCLD,PAGEGC,REALGC,MARK +.GLOBAL %MPINT,%GBINT,%CLSMP,%CLSM1,PINIT,PGFIND,NPRFLG,%PURMD +.GLOBAL GCKNUM,CORTOP,GCHPN,INTAGC,WNDP,WNDBOT,BUFGC,WIND,GCDFLG,SAVM,AGC,GCSET + +.GLOBAL GCRET,PAIRMK,DEFMK,VECTMK,TBMK,TPMK,ARGMK,VECTMK,FRMK,BYTMK,ATOMK,GATOMK +.GLOBAL BYTMK,ABMK,LOCRMK,GCRDMK,DEFQMK,ASMRK,LOCMK,OFFSMK,INBLOT,MARK2A + +NOPAGS==1 ; NUMBER OF WINDOWS +EOFBIT==1000 +PDLBUF=100 +NTPMAX==20000 ; NORMAL MAX TP SIZE +NTPGOO==4000 ; NORMAL GOOD TP +ETPMAX==2000 ; TPMAX IN AN EMERGENCY (I.E. GC RECALL) +ETPGOO==2000 ; GOOD TP IN EMERGENCY + +.ATOM.==200000 ; FLAG SAYING ATOMS MARKED (FOR VAL FLUSH LOGIC) + +GCHN==0 ; CHANNEL FOR FUNNNY INFERIOR +STATNO==19. ; # OF STATISTICS FOR BLOAT-STAT +STATGC==8. ; # OF GC-STATISTICS FOR BLOAT-STAT + + +LOC REALGC +OFFS==AGCLD-$. +GCOFFS=OFFS +OFFSET OFFS + +.INSRT MUDDLE > +SYSQ +IFE ITS,[ +.INSRT STENEX > +] +IFN ITS, PGSZ==10. +IFE ITS, PGSZ==9. + +TYPNT=AB ;SPECIAL AC USAGE DURING GC +F=TP ;ALSO SPECIAL DURING GC +LPVP=SP ;SPECIAL FOR GC, HOLDS POINTER TO PROCESS CHAIN +FPTR=TB ; POINT TO CURRENT FRONTIER OF INFERIOR + + +; WINDOW AND FRONTIER PAGES + +MAPCH==0 ; MAPPING CHANNEL +.LIST.==400000 +FPAG==2000 ; START OF PAGES FOR GC-READ AND GCDUMP +CONADJ==5 ; ADJUSTMENT OF DUMPERS CONSTANT TABLE + + +; INTERNAL GCDUMP ROUTINE +.GLOBAL GODUMP,EGCDUM,EPURIF,ERRKIL,IPURIF + +GODUMP: MOVE PVP,PVSTOR+1 + MOVEM P,PSTO+1(PVP) ; SAVE P + MOVE P,GCPDL + PUSH P,AB + PUSHJ P,INFSU1 ; SET UP INFERIORS + +; MARK PHASE + SETZM PURMNG ; INITIALIZE FLAG INDICATING IF PURIFIED PAGES + ; WERE MUNGED + MOVEI 0,HIBOT ; SET UP NEW PURBOT TO CONVINCE THE GARBAGE COLLECTOR + ; TO COLLECT PURIFIED STRUCTURES + EXCH 0,PURBOT + MOVEM 0,RPURBT ; SAVE THE OLD PURBOT + MOVEI 0,HIBOT + EXCH 0,GCSTOP + MOVEM 0,RGCSTP ; SAVE THE OLD GCSTOP + POP P,C ; SET UP PTR TO TYPE/VALUE PAIR + MOVE P,A ; GET NEW PDL PTR + SETOM DUMFLG ; FLAG INDICATING IN DUMPER + MOVE A,TYPVEC+1 + MOVEM A,TYPSAV + ADD FPTR,[7,,7] ; ADJUST FOR FIRST STATUS WORDS + PUSHJ P,MARK2 + MOVEI E,FPAG+6 ; SEND OUT PAIR + PUSH P,C ; SAVE C + MOVE C,A + PUSHJ P,ADWD + POP P,C ; RESTORE C + MOVEI E,FPAG+5 + MOVE C,(C) ; SEND OUT UPDATED PTR + PUSHJ P,ADWD + + MOVEI 0,@BOTNEW ; CALCULATE START OF TYPE-TABLE + MOVEM 0,TYPTAB + MOVE 0,RPURBT ; RESTORE PURBOT + MOVEM 0,PURBOT + MOVE 0,RGCSTP ; RESTORE GCSTOP + MOVEM 0,GCSTOP + + +; ROUTINE TO SCAN THE TYPE-VECTOR FOR MARKED TYPE SLOTS AND BUILD A TYPE-TABLE OUT OF +; THEM + + MOVE A,TYPSAV ; GET AOBJN POINTER TO TYPE-VECTOR + MOVEI B,0 ; INITIALIZE TYPE COUNT +TYPLP2: HLRE C,(A) ; GET MARKING + JUMPGE C,TYPLP1 ; IF NOT MARKED DON'T OUTPUT + MOVE C,(A) ; GET FIRST WORD + HRL C,B ; FIX UP SO TYPE-NUMBER REPLACES TYPE-CELL + PUSH P,A + SKIPL FPTR + PUSHJ P,MOVFNT + MOVEM C,FRONT(FPTR) + AOBJN FPTR,.+2 + PUSHJ P,MOVFNT ; EXTEND THE FRONTIER + POP P,A + MOVE C,1(A) ; OUTPUT SECOND WORD + MOVEM C,FRONT(FPTR) + ADD FPTR,[1,,1] +TYPLP1: ADDI B,1 ; INCREMENT TYPE COUNT + ADD A,[2,,2] ; POINT TO NEXT SLOT + JUMPL A,TYPLP2 ; LOOP + +; ROUTINE TO BUILD UP ATOM TABLE USING LPVP CHAIN + + HRRZ F,ABOTN + MOVEI 0,@BOTNEW ; GET CURRENT BEGINNING OF TRANSFER + MOVEM 0,ABOTN ; SAVE IT + PUSHJ P,ALLOGC ; ALLOCATE ROOM FOR ATOMS + MOVSI D,400000 ; SET UP UNMARK BIT +SPOUT: JUMPE LPVP,DPGC4 ; END OF CHAIN + MOVEI F,(LPVP) ; GET COPY OF LPVP + HRRZ LPVP,-1(LPVP) ; LPVP POINTS TO NEXT ON CHAIN + ANDCAM D,(F) ; UNMARK IT + HLRZ C,(F) ; GET LENGTH + HRRZ E,(F) ; POINTER INTO INF + ADD E,ABOTN + SUBI C,2 ; WE'RE NOT SENDING OUT THE VALUE PAIR + HRLM C,(F) ; ADJUSTED LENGTH + MOVE 0,C ; COPY C FOR TRBLKX + SUBI E,(C) ; ADJUST PTRS FOR SENDOUT + SUBI F,-1(C) + PUSHJ P,TRBLKX ; OUT IT GOES + JRST SPOUT + + +; HERE TO SEND OUT DELIMITER INFORMATION +DPGC4: SKIPN INCORF ; SKIP IF TRANSFREING TO UVECTOR IN CORE + JRST CONSTO + SKIPL FPTR ; SEE IF ROOM IN FRONTEIR + PUSHJ P,MOVFNT ; EXTEND FRONTEIR + MOVSI A,.VECT. + MOVEM A,FRONT(FPTR) + AOBJN FPTR,.+2 + PUSHJ P,MOVFNT + MOVEI A,@BOTNEW ; LENGTH + SUBI A,FPAG + HRLM A,FRONT(FPTR) + ADD FPTR,[1,,1] + + +CONSTO: MOVEI E,FPAG + MOVE C,ABOTN ; START OF ATOMS + SUBI C,FPAG+CONADJ ; ADJUSTMENT FOR STARTING ON PAGE ONE + PUSHJ P,ADWD ; OUT IT GOES + MOVEI E,FPAG+1 + MOVEI C,@BOTNEW + SUBI C,FPAG+CONADJ + SKIPE INCORF ; SKIP IF TO CHANNEL + SUBI C,2 ; SUBTRACT FOR DOPE WORDS + PUSHJ P,ADWD + SKIPE INCORF + ADDI C,2 ; RESTORE C TO REAL ABOTN + ADDI C,CONADJ + PUSH P,C + MOVE C,TYPTAB + SUBI C,FPAG+CONADJ + MOVEI E,FPAG+2 ; SEND OUT START OF TYPE TABLE + PUSHJ P,ADWD + ADDI E,1 ; SEND OUT NUMPRI + MOVEI C,NUMPRI + PUSHJ P,ADWD + ADDI E,1 ; SEND OUT NUMSAT + MOVEI C,NUMSAT + PUSHJ P,ADWD + + + +; FINAL CLOSING OF INFERIORS + +DPCLS: PUSH P,PGCNT + PUSHJ P,INFCL1 + POP P,PGCNT + POP P,A ; LENGTH OF CODE + +; RESTORE AC'S + MOVE PVP,PVSTOR+1 + IRP AC,,[P,TP,TB,AB,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + + SETZB M,R + SETZM DUMFLG + SETZM GCDFLG ; ZERO FLAG INDICATING IN DUMPER + SETZM GCFLG ; AND INDICTOR TO INTERRUPT HANDLER THAT AGC IS ON + PUSH P,A + MOVE A,INF2 ; GET POINTER TO PURE MAPPED OUT + PUSHJ P,%GBINT + + POP P,A + JRST EGCDUM + + +ERDP: PUSH P,B + PUSHJ P,INFCLS + PUSHJ P,INFCL1 + SETZM GCFLG + SETZM GPURFL ; PURE FLAG + SETZM DUMFLG + SETZM GCDFLG + POP P,A + +; RESTORE AC'S + MOVE PVP,PVSTOR+1 + IRP AC,,[P,R,M,TP,TB,AB,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + +ERDUMP: PUSH TP,$TATOM + +OFFSET 0 + + PUSH TP,EQUOTE STRUCTURE-CONTAINS-UNDUMPABLE-TYPE + +OFFSET OFFS + + PUSH TP,$TATOM ; PUSH ON PRIMTYPE + PUSH TP,@STBL(A) ; PUSH ON PRIMTYPE + MOVEI A,2 + JRST ERRKIL + +; ALTERNATE ATOM MARKER FOR DUMPER + +DATOMK: SKIPE GPURFL ; SKIP IF NOT IN PURIFIER + JRST PATOMK + CAILE A,0 ; SEE IF ALREADY MARKED + JRST GCRET + PUSH P,A ; SAVE PTR TO ATOM + HLRE B,A ; POINT TO DOPE WORD + SUB A,B ; TO FIRST DOPE WORD + MOVEI A,1(A) ; TO SECOND + PUSH P,A ; SAVE PTR TO DOPE WORD + HLRZ B,(A) ; GET LENGTH AND MARKING + TRZE B,400000 ; TURN OFF BIT AND SKIP IF UNMARKED + JRST DATMK1 + IORM D,(A) ; MARK IT + MOVE 0,ABOTN ; GET CURRENT TOP OF ATOM TABLE + ADDI 0,-2(B) ; PLACE OF DOPE WORD IN TABLE + HRRM 0,(A) ; PUT IN RELOCATION + MOVEM 0,ABOTN ; FIXUP TOP OF TABLE + HRRM LPVP,-1(A) ; FIXUP CHAIN + MOVEI LPVP,(A) + MOVE A,-1(P) ; GET POINTER TO ATOM BACK + HRRZ B,2(A) ; GET OBLIST POINTER + JUMPE B,NOOB ; IF ZERO ON NO OBLIST + CAMG B,VECBOT ; DON'T SKIP IF OFFSET FROM TVP + MOVE B,(B) + HRLI B,-1 +DATMK3: MOVE A,$TOBLS ; SET UP FOR GET + MOVE C,$TATOM + +OFFSET 0 + MOVE D,IMQUOTE OBLIST + +OFFSET OFFS + + PUSH P,TP ; SAVE FPTR + MOVE TP,MAINPR + MOVE TP,TPSTO+1(TP) ; GET TP + PUSHJ P,IGET + POP P,TP ; RESTORE FPTR + MOVE C,-1(P) ; RECOVER PTR TO ATOM + ADDI C,1 ; SET UP TO MARK OBLIST ATOM + MOVSI D,400000 ; RESTORE MARK WORD + +OFFSET 0 + + CAMN B,MQUOTE ROOT + +OFFSET OFFS + + JRST RTSET + MOVEM B,1(C) + MOVEI B,TATOM + PUSHJ P,MARK1 ; MARK IT + MOVEM A,1(C) ; SMASH IN ITS ID +DATMK1: +NOOB: POP P,A ; GET PTR TO DOPE WORD BACK + HRRZ A,(A) ; RETURN ID + SUB P,[1,,1] ; CLEAN OFF STACK + MOVEM A,(P) + JRST GCRET ; EXIT + +; HERE FOR A ROOT ATOM +RTSET: SETOM 1(C) ; INDICATOR OF ROOT ATOM + JRST NOOB ; CONTINUE + + +; INTERNAL PURIFY ROUTINE +; SAVE AC's + +IPURIF: PUSHJ P,PURCLN ; GET RID OF PURE MAPPED + MOVE PVP,PVSTOR+1 + IRP AC,,[P,R,M,TP,TB,AB,FRM] + MOVEM AC,AC!STO"+1(PVP) + TERMIN + + +; HERE TO CREATE INFERIORS AND MARK THE ITEM +PURIT1: MOVE PVP,PVSTOR+1 + MOVEM P,PSTO+1(PVP) ; SAVE P + SETOM GPURFL ; INDICATE PURIFICATION IS TAKING PLACE + MOVE C,AB ; ARG PAIR + MOVEM C,SAVRS1 ; SAV PTR TO PAIR + MOVE P,GCPDL + PUSHJ P,INFSUP ; GET INFERIORS + MOVE P,A ; GET NEW PDL PTR + PUSHJ P,%SAVRP ; SAVE RPMAP TABLE FOR TENEX + MOVE C,SAVRS1 ; SET UP FOR MARKING + MOVE A,(C) ; GET TYPE WORD + MOVEM A,SAVRE2 +PURIT3: PUSH P,C + PUSHJ P,MARK2 +PURIT4: POP P,C ; RESTORE C + ADD C,[2,,2] ; TO NEXT ARG + JUMPL C,PURIT3 + MOVEM A,SAVRES ; SAVE UPDATED POINTER + +; FIX UP IMPURE PART OF ATOM CHAIN + + PUSH P,[0] ; FLAG INDICATING NON PURE SCAN + PUSHJ P,FIXATM + SUB P,[1,,1] ; CLEAN OFF STACK + +; NOW TO GET PURE STORAGE + +PURIT2: MOVEI A,@BOTNEW ; GET BOTNEW + SUBI A,2000-1777 ; START AT PAGE 1 AND ROUND + ANDCMI A,1777 + ASH A,-10. ; TO PAGES + SETZ M, + PUSH P,A + PUSHJ P,PGFIND ; FIND THEM + JUMPL B,LOSLP2 ; LOST GO TO CAUSE AGC + HRRZ 0,BUFGC ;GET BUFFER PAGE + ASH 0,-10. + MOVEI A,(B) ; GET LOWER PORTION OF PAGES + MOVN C,(P) + SUBM A,C ; GET END PAGE + CAIL 0,(A) ; L? LOWER + CAILE 0,(C) ; G? HIGER + JRST NOREMP ; DON'T GET NEW BUFFER + PUSHJ P,%FDBUF ; GET A NEW BUFFER PAGE +NOREMP: MOVN A,(P) ; SET UP AOBJN PTR FOR MAPIN + MOVE C,B ; SAVE B + HRL B,A + HRLZS A + ADDI A,1 + MOVEM B,INF3 ; SAVE PTR FOR PURIFICATION + PUSHJ P,%MPIN1 ; MAP IT INTO PURE + ASH C,10. ; TO WORDS + MOVEM C,MAPUP + SUB P,[1,,1] ; CLEAN OFF STACK + +DONMAP: +; RESTORE AC's + MOVE PVP,PVSTOR+1 + MOVE P,PSTO+1(PVP) ; GET REAL P + PUSH P,LPVP + MOVEI A,@BOTNEW + MOVEM A,NABOTN + + IRP AC,,[M,TP,TB,R,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + MOVE A,INF1 + +; NOW FIX UP POINTERS IN PURE STRUCTURE + MOVE 0,GCSBOT + MOVEM 0,OGCSTP + PUSH P,GCSBOT ; SAVE GCSBOT AND GCSTOP + PUSH P,GCSTOP + MOVE A,MAPUP ; NEW GCSBOT AND TOP TO FOOL GCHACK + MOVEM A,GCSBOT + ADD A,NABOTN + SUBI A,2000 ; ADJUSTMENT FOR START ON PAGE ONE + MOVEM A,GCSTOP + MOVE A,[PUSHJ P,NPRFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHK10 + POP P,GCSTOP + POP P,GCSBOT + +; NOW FIX UP POINTERS TO PURIFIED STRUCTURE + + MOVE A,[PUSHJ P,PURFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + + SETZM GCDFLG + SETZM DUMFLG + SETZM GCFLG + + POP P,LPVP ; GET BACK LPVP + MOVE A,INF1 + PUSHJ P,%KILJB ; KILL IMAGE SAVING INFERIOR + PUSH P,[-1] ; INDICATION OF PURE ATOM SCAN + PUSHJ P,FIXATM + +; SET UP PMAP SO THAT NEW PURE PAGES ARE INDICATED + + MOVE A,INF3 ; GET AOBJN PTR TO PAGES +FIXPMP: HRRZ B,A ; GET A PAGE + IDIVI B,16. ; DIVIDE SO AS TO PT TO PMAP WORD + PUSHJ P,PINIT ; SET UP PARAMETER + LSH D,-1 + TDO E,D ; FIX UP WORD + MOVEM E,PMAPB(B) ; SEND IT BACK + AOBJN A,FIXPMP + + SUB P,[1,,1] + MOVE A,[PUSHJ P,PURTFX] ; FIX UP PURE ATOM POINTERS + MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + +; NOW FIX UP POINTERS IN PURE STRUCTURE + PUSH P,GCSBOT ; SAVE GCSBOT AND GCSTOP + PUSH P,GCSTOP + MOVE A,MAPUP ; NEW GCSBOT AND TOP TO FOOL GCHACK + MOVEM A,GCSBOT + ADD A,NABOTN + SUBI A,2000 ; ADJUSTMENT FOR START ON PAGE ONE + MOVEM A,GCSTOP + MOVE A,[PUSHJ P,PURTFX] + MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHK10 + POP P,GCSTOP + POP P,GCSBOT + +; HERE TO FIX UP ATOMS WITH TYPES HACKED INTO THEIR GROWTH FIELD + + MOVE A,TYPVEC+1 ; GET TYPE VECTOR + MOVEI B,400000 ; TLOSE==0 +TTFIX: HRRZ D,1(A) ; GET ADDR + HLRE C,1(A) + SUB D,C + HRRM B,(D) ; SMASH IT IN +NOTFIX: ADDI B,1 ; NEXT TYPE + ADD A,[2,,2] + JUMPL A,TTFIX + +; NOW CLOSE UP INFERIORS AND RETURN + +PURCLS: MOVE P,[-2000,,MRKPDL] + PUSHJ P,%RSTRP ;RESETORE RPMAP TABLE FOR TENEX + PUSHJ P,INFCLS + + MOVE PVP,PVSTOR+1 + MOVE P,PSTO+1(PVP) ; RESTORE P + MOVE AB,ABSTO+1(PVP) ; RESTORE R + + MOVE A,INF3 ; GET PTR TO PURIFIED STRUCTURE + SKIPN NPRFLG + PUSHJ P,%PURIF ; PURIFY + PUSHJ P,%PURMD + + SETZM GPURFL + JRST EPURIF ; FINISH UP + +NPRFIX: PUSH P,A + PUSH P,B + PUSH P,C + EXCH A,C + PUSHJ P,SAT ; GET STORAGE ALLOCATION TYPE + MOVE C,MAPUP ; FIXUP AMOUNT + SUBI C,FPAG ; ADJUST FOR START ON FIRST PAGE + CAIE A,SLOCR ; DONT HACK TLOCRS + CAIN A,S1WORD ; SKIP IF NOT OF PRIMTYPE WORD + JRST LSTFXP + CAIN A,SCHSTR + JRST STRFXP + CAIN A,SATOM + JRST ATMFXP + CAIN A,SOFFS + JRST OFFFXP ; FIXUP OFFSETS +STRFXQ: HRRZ D,1(B) + JUMPE D,LSTFXP ; SKIP IF NIL + CAMG D,PURTOP ; SEE IF ALREADY PURE + ADDM C,1(B) +LSTFXP: TLNN B,.LIST. ; SKIP IF NOT A PAIR + JRST LSTEX1 + HRRZ D,(B) ; GET REST OF LIST + SKIPE D ; SKIP IF POINTS TO NIL + PUSHJ P,RLISTQ + JRST LSTEX1 + CAMG D,PURTOP ; SKIP IF ALREADY PURE + ADDM C,(B) ; FIX UP LIST +LSTEX1: POP P,C + POP P,B ; RESTORE GCHACK AC'S + POP P,A + POPJ P, + +OFFFXP: HLRZ 0,D ; POINT TO LIST + JUMPE 0,LSTFXP ; POINTS TO NIL + CAML 0,PURTOP ; ALREADY PURE? + JRST LSTFXP ; YES + ADD 0,C ; UPDATE THE POINTER + HRLM 0,1(B) ; STUFF IT OUT + JRST LSTFXP ; DONE + +STRFXP: TLZN D,STATM ; SKIP IF REALLY ATOM + JRST STRFXQ + MOVEM D,1(B) + PUSH P,C + MOVE C,B ; GET ARG FOR BYTDOP + PUSHJ P,BYTDOP + POP P,C + MOVEI D,-1(A) + JRST ATMFXQ + +ATMFXP: HLRE 0,D ; GET LENGTH + SUB D,0 ; POINT TO FIRST DOPE WORD + HRRZS D +ATMFXQ: CAML D,OGCSTP + CAIL D,HIBOT ; SKIP IF IMPURE + JRST LSTFXP + HRRZ 0,1(D) ; GET RELOCATION + SUBI 0,1(D) + ADDM 0,1(B) ; FIX UP PTR IN STRUCTURE + JRST LSTFXP + +; FIXUP OF PURE ATOM POINTERS + +PURTFX: CAIE C,TATOM ; SKIP IF ATOM POINTER + JRST PURSFX + HLRE E,D ; GET TO DOPE WORD + SUBM D,E +PURSF1: SKIPL 1(E) ; SKIP IF MARKED + POPJ P, + HRRZ 0,1(E) ; RELATAVIZE PTR + SUBI 0,1(E) + ADD D,0 ; FIX UP PASSED POINTER + SKIPE B ; AND IF APPROPRIATE MUNG POINTER + ADDM 0,1(B) ; FIX UP POINTER + POPJ P, + +PURSFX: CAIE C,TCHSTR + POPJ P, + MOVE C,B ; GET ARG FOR BYTDOP + PUSHJ P,BYTDOP + GETYP 0,-1(A) + MOVEI E,-1(A) + MOVE A,[PUSHJ P,PURTFX] + CAIE 0,SATOM + POPJ P, + JRST PURSF1 + +PURFIX: PUSH P,D + PUSH P,A + PUSH P,B + PUSH P,C ; SAVE AC'S FOR GCHACK + EXCH A,C ; GET TYPE IN A + CAIN A,TATOM ; CHECK FOR ATOM + JRST ATPFX + PUSHJ P,SAT + + CAILE A,NUMSAT ; SKIP IF TEMPLATE + JRST TLFX +IFN ITS, JRST @PURDSP(A) +IFE ITS,[ + HRRZ 0,PURDSP(A) + HRLI 0,400000 + JRST @0 +] +PURDSP: + +OFFSET 0 + +DISTBS DUM1,TLFX,[[S2WORD,LPLSTF],[S2DEFR,LPLSTF],[SNWORD,VECFX], +[S2NWORD,VECFX],[SSTORE,VECFX],[SBYTE,STRFX],[SATOM,ATPFX],[SLOCB,STRFX] +[SCHSTR,STRFX],[SLOCL,LPLSTF],[SLOCV,VECFX],[SLOCU,VECFX],[SLOCS,VECFX],[SOFFS,OFFSFX]] + +OFFSET OFFS + +VECFX: HLRE 0,D ; GET LENGTH + SUB D,0 ; POINT TO D.W. + SKIPL 1(D) ; SKIP IF MARKED + JRST TLFX + HRRZ C,1(D) + SUBI C,1(D) ; CALCULATE RELOCATION + ADD C,MAPUP ; ADJUSTMENT + SUBI C,FPAG + ADDM C,1(B) +TLFX: TLNN B,.LIST. ; SEE IF PAIR + JRST LVPUR ; LEAVE IF NOT + PUSHJ P,RLISTQ + JRST LVPUR + HRRZ D,(B) ; GET CDR + SKIPN D ; SKIP IF NOT ZERO + JRST LVPUR + MOVE D,(D) ; GET CADR + SKIPL D ; SKIP IF MARKED + JRST LVPUR + ADD D,MAPUP + SUBI D,FPAG + HRRM D,(B) ; FIX UP +LVPUR: POP P,C + POP P,B + POP P,A + POP P,D + POPJ P, + +STRFX: MOVE C,B ; GET ARG FOR BYTDOP + PUSHJ P,BYTDOP + SKIPL (A) ; SKIP IF MARKED + JRST TLFX + GETYP 0,-1(A) + MOVE D,1(B) + MOVEI C,-1(A) + CAIN 0,SATOM ; REALLY ATOM? + JRST ATPFX1 + HRRZ 0,(A) ; GET PTR IN NEW STRUCTURE + SUBI 0,(A) ; RELATAVIZE + ADD 0,MAPUP ; ADJUST + SUBI 0,FPAG + ADDM 0,1(B) ; FIX UP PTR + JRST TLFX + +ATPFX: HLRE C,D + SUBM D,C + SKIPL 1(C) ; SKIP IF MARKED + JRST TLFX +ATPFX1: HRRZS C ; SEE IF PURE + CAIL C,HIBOT ; SKIP IF NOT PURE + JRST TLFX + HRRZ 0,1(C) ; GET PTR TO NEW ATOM + SUBI 0,1(C) ; RELATAVIZE + ADD D,0 + JUMPE B,TLFX + ADDM 0,1(B) ; FIX UP + JRST TLFX + +LPLSTF: SKIPN D ; SKIP IF NOT PTR TO NIL + JRST TLFX + SKIPL (D) ; SKIP IF MARKED + JRST TLFX + HRRZ D,(D) ; GET UPDATED POINTER + ADD D,MAPUP ; ADJUSTMENT + SUBI D,FPAG + HRRM D,1(B) + JRST TLFX + +OFFSFX: HLRZS D ; LIST POINTER + JUMPE D,TLFX ; NIL + SKIPL (D) ; MARKED? + JRST TLFX ; NO + ADD D,MAPUP + SUBI D,FPAG ; ADJUST + HRLM D,1(B) + JRST TLFX ; RETURN + +; ROUTINES TO CAUSE A GARBAGE COLLECT WHEN EFFORTS TO GET STORAGE FAIL + +LOSLP1: MOVE A,ABOTN + MOVEM A,PARNEW ; SET UP GC PARAMS + MOVE C,[12.,,6] + JRST PURLOS + +LOSLP2: MOVEI A,@BOTNEW ; TOTAL AMOUNT NEEDED + ADDI A,1777 + ANDCMI A,1777 ; CALCULATE PURE PAGES NEEDED + MOVEM A,GCDOWN + MOVE C,[12.,,8.] + JRST PURLOS + +PURLOS: MOVE P,[-2000,,MRKPDL] + PUSH P,GCDOWN + PUSH P,PARNEW + MOVE R,C ; GET A COPY OF A + PUSHJ P,INFCLS ; CLOSE INFERIORS AND FIX UP WORLD + PUSHJ P,INFCL2 +PURLS1: POP P,PARNEW + POP P,GCDOWN + MOVE C,R + +; RESTORE AC'S + MOVE PVP,PVSTOR+1 + IRP AC,,[P,R,M,TP,TB,AB,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + + SETZM GCDFLG ; ZERO OUT FLAGS + SETZM DUMFLG + SETZM GPURFL + SETZM GCDANG + + PUSHJ P,AGC ; GARBAGE COLLECT + JRST PURIT1 ; TRY AGAIN + +; PURIFIER ATOM MARKER + +PATOMK: HRRZ 0,A + CAMG 0,PARBOT + JRST GCRET ; DONE IF FROZEN + HLRE B,A ; GET TO D.W. + SUB A,B + SKIPG 1(A) ; SKIP IF NOT MARKED + JRST GCRET + HLRZ B,1(A) + IORM D,1(A) ; MARK THE ATOM + ADDM B,ABOTN + HRRM LPVP,(A) ; LINK ONTO CHAIN + MOVEI LPVP,1(A) + JRST GCRET ; EXIT + + +.GLOBAL %LDRDO,%MPRDO + +; ROUTINES TO ALLOW GC-DUMPING OF PURIFIED STRUCTURES. + +; PROPUR MAPS PAGES CONTAINING PURIFIED STUFF INTO THE AGD INFERIOR SO THAT IN CASE +; THE PAGES ARE MUNGED THEY CAN BE RESTORED USING MAPPING + +; REPURE REMAPS ANY PAGES THAT WERE MUNGED BY GC-DUMP BY RELOADING THEM FROM THE AGD +; INFERIOR IN READ/EXEC MODE + +REPURE: PUSH P,[PUSHJ P,%LDRDO] ; INSTRUCTION FOR MAPPING IN PAGES FROM AGD INF + SKIPA +PROPUR: PUSH P,[PUSHJ P,%MPRDO] ; INSTRUCTION FOR MAPPING PAGES TO AGD INF + MOVE A,PURBOT ; GET STARTING PAGE OF PURENESS + ASH A,-10. ; CONVERT TO PAGES + MOVEI C,HIBOT ; GET ENDING PAGE + ASH C,-10. ; CONVERT TO PAGES + PUSH P,A ; SAVE PAGE POINTER + PUSH P,C ; SAVE END OF PURENESS POINTER +PROLOP: CAML A,(P) ; SKIP IF STILL PURE PAGES TO CHECK + JRST PRODON ; DONE MAPPING PAGES + PUSHJ P,CHKPGI ; SKIP IF PAGE IS PURE + JRST NOTPUR ; IT IS NOT + MOVE A,-1(P) ; GET PAGE TO MAP + XCT -2(P) ; MAP IN/OUT TO AGD INFERIOR IN READ/EXEC MODE +NOTPUR: AOS A,-1(P) ; INCREMENT PAGE POINTER AND LOAD + JRST PROLOP ; LOOP BACK +PRODON: SUB P,[3,,3] ; CLEAN OFF STACK + POPJ P, ; EXIT + + + +.GLOBAL %SAVIN,STOSTR,%CLMP1,%IMSAV,%IMSV1,ILOOKC,PSHGCF,BSETG,%GCJB1 +.GLOBAL %CLSJB,%KILJB,%IFMP1,%OPGFX,%FDBUF +INFSU1: PUSH P,[-1] ; ENTRY USED BY GC-DUMP + SKIPA +INFSUP: PUSH P,[0] + MOVE A,GLOTOP+1 ; GET GLOTOP FOR LOCR HACKS + MOVEM A,GLTOP + PUSHJ P,%FDBUF ; GET A BUFFER FOR C/W HACKS + SETOM GCDFLG + SETOM GCFLG + HLLZS SQUPNT + HRRZ TYPNT,TYPVEC+1 ; SETUP TYPNT + HRLI TYPNT,B + MOVEI A,STOSTR + ANDCMI A,1777 ; TO PAGE BOUNDRY + SUB A,GCSTOP ; SET UP AOBJN POINTER FOR C/W HACK + ASH A,-10. ; TO PAGES + HRLZS A + MOVEI B,STOSTR ; GET START OF MAPPING + ASH B,-10. + ADDI A,(B) + MOVEM A,INF1 + PUSHJ P,%SAVIN ; PROTECT THE CORE IMAGE + SKIPGE (P) ; IF < 0 GC-DUMP CALL + PUSHJ P,PROPUR ; PROTECT PURE PAGES + SUB P,[1,,1] ; CLEAN OFF PSTACK + PUSHJ P,%CLSJB ; CLOSE INFERIOR + + MOVSI D,400000 ; CREATE MARK WORD + SETZB LPVP,ABOTN ; ZERO ATOM COUNTER + MOVEI A,2000 ; MARKED INF STARTS AT PAGE ONE + HRRM A,BOTNEW + SETZM WNDBOT + SETZM WNDTOP + HRRZM A,FNTBOT + ADDI A,2000 ; WNDTOP + MOVEI A,1 ; TO PAGES + PUSHJ P,%GCJB1 ; CREATE THE JOB + MOVSI FPTR,-2000 + MOVEI A,LPUR ; SAVE THE PURE CORE IMAGE + ANDCMI A,1777 ; TO PAGE BOUNDRY + MOVE 0,A ; COPY TO 0 + ASH 0,-10. ; TO PAGES + SUB A,HITOP ; SUBTRACT TOP OF CORE + ASH A,-10. + HRLZS A + ADD A,0 + MOVEM A,INF2 + PUSHJ P,%IMSV1 ; MAP OUT INTERPRETER + PUSHJ P,%OPGFX + +; CREATE A PDL TO USE FOR THESE DUMPING FUNCTIONS + + MOVE A,[-2000,,MRKPDL] + POPJ P, + +; ROUTINE TO CLOSE GC's INFERIOR + + +INFCLS: MOVE A,INF2 ; GET POINTER TO PURE MAPPED OUT + PUSHJ P,%CLSMP + POPJ P, + +; CLOSE INFERIOR PROTECTING CORE IMAGE FOR GCDUMP + +INFCL2: PUSHJ P,%IFMP1 ; OPEN AGD INF TO RESTORE PAGES +INFCL3: MOVE A,INF1 ; RESTORE OPENING POINTER + PUSH P,INF2 + MOVE B,A ; SATIFY MUDITS + PUSHJ P,%IFMP2 ; MAP IN GC PAGES AND CLOSE INFERIOR + POP P,INF2 ; RESTOR INF2 PARAMETER + POPJ P, + +INFCL1: PUSHJ P,%IFMP1 ; OPEN AGD INF TO RESTORE PAGES + SKIPGE PURMNG ; SKIP IF NO PURE PAGES WERE MUNGED + PUSHJ P,REPURE ; REPURIFY MUNGED PAGES + JRST INFCL3 + + + +; ROUTINE TO DO TYPE HACKING FOR GC-DUMP. IT MARKS THE TYPE-WORD OF THE +; SLOT IN THE TYPE VECTOR. IT ALSO MARKS THE ATOM REPLACING THE I.D. IN +; THE RIGHT HALF OF THE ATOM SLOT. IF THE TYPE IS A TEMPLATE THE FIRST +; USE OF THE SAT HAS ITS ATOM MARKED AND THE I.D. IS PLACED IN THE LEFT +; HALF OF THE ATOM SLOT (IT GETS THE REAL PRIMTYPE). + +TYPHK: CAILE B,NUMPRI ; SKIP IF A MUDDLE TYPE + JRST TYPHKR ; ITS A NEWTYPE SO GO TO TYPHACKER + CAIN B,TTYPEC ; SKIP IF NOT TYPE-C + JRST TYPCHK ; GO TO HACK TYPE-C + CAIE B,TTYPEW ; SKIP IF TYPE-W + POPJ P, + PUSH P,B + HLRZ B,A ; GET TYPE + JRST TYPHKA ; GO TO TYPE-HACKER +TYPCHK: PUSH P,B ; SAVE TYPE-WORD + HRRZ B,A + JRST TYPHKA + +; GENERAL TYPE-HACKER FOR GC-DUMP + +TYPHKR: PUSH P,B ; SAVE AC'S +TYPHKA: PUSH P,A + PUSH P,C + LSH B,1 ; GET OFFSET TO SLOT IN TYPE VECTOR + MOVEI C,(TYPNT) ; GET TO SLOT + ADDI C,(B) + SKIPGE (C) + JRST EXTYP + IORM D,(C) ; MARK THE SLOT + MOVEI B,TATOM ; NOW MARK THE ATOM SLOT + PUSHJ P,MARK1 ; MARK IT + HRRM A,1(C) ; SMASH IN ID + HRRZS 1(C) ; MAKE SURE THAT THATS ALL THATS THERE + HRRZ B,(C) ; GET SAT + ANDI B,SATMSK ; GET RID OF MAGIC BITS + HRRM B,(C) ; SMASH SAT BACK IN + CAIG B,NUMSAT ; SKIP IF TEMPLATE + JRST EXTYP + MOVE A,TYPSAV ; GET POINTER TO TYPE VECTOR + ADDI A,NUMPRI*2 ; GET TO NEWTYPES SLOTS + HRLI 0,NUMPRI*2 + HLLZS 0 ; MAKE SURE ONLY LEFT HALF + ADD A,0 +TYPHK1: HRRZ E,(A) ; GET SAT OF SLOT + CAMN E,B ; SKIP IF NOT EQUAL + JRST TYPHK2 ; GOT IT + ADDI A,2 ; TO NEXT + JRST TYPHK1 +TYPHK2: PUSH P,C ; SAVE POINTER TO ORIGINAL SLOT + MOVE C,A ; COPY A + MOVEI B,TATOM ; SET UP FOR MARK + MOVE A,1(C) ; ASSUME MARK DOESN'T HAVE TO TAKE PLACE + SKIPL (C) ; DON'T MARK IF ALREADY MARKED + PUSHJ P,MARK + POP P,C ; RESTORE C + HRLM A,1(C) ; SMASH IN PRIMTYPE OF TEMPLATE +EXTYP: POP P,C ; RESTORE AC'S + POP P,A + POP P,B + POPJ P, ; EXIT + + +; A ROUTINE TO DISTINGUISH BETWEEN A DEFERRED AND A LIST POINTER +RLISTQ: PUSH P,A + GETYP A,(B) ; GET TYPE + PUSHJ P,SAT ; GET SAT + CAIG A,NUMSAT ; NOT DEFERRED IF TEMPLATE + SKIPL MKTBS(A) + AOS -1(P) ; SKIP IF NOT DEFFERED + POP P,A + POPJ P, ; EXIT + + +; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED) + +GCDISP: + +OFFSET 0 + +DISTBS DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK],[STBASE,ERDP] +[STPSTK,ERDP],[SARGS,ERDP],[S2NWORD,VECTMK],[SPSTK,ERDP],[SSTORE,VECTMK] +[SFRAME,ERDP],[SBYTE,],[SATOM,DATOMK],[SPVP,ERDP],[SGATOM,ERDP] +[SLOCID,ERDP],[SCHSTR,],[SASOC,ERDP],[SLOCL,PAIRMK],[SABASE,ERDP] +[SLOCA,ERDP],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,],[SLOCN,ERDP] +[SLOCB,],[SLOCR,LOCRDP],[SOFFS,OFFSMK]] + +OFFSET OFFS + + +; THIS SUBROUTINE IMPURIFIES A PURE ATOM TO ALLOW MODIFICATION OF SYSTEM SUBRS + +IMPRF: PUSH P,A + PUSH P,LPVP + PUSH TP,$TATOM + HLRZ C,(A) ; GET LENGTH + TRZ C,400000 ; TURN OF 400000 BIT + SUBI A,-1(C) ; POINT TO START OF ATOM + MOVNI C,-2(C) ; MAKE IT LOOK LIKE AN ATOM POINTER + HRL A,C + PUSH TP,A + MOVE C,A + MOVEI 0,(C) + PUSH P,AB + MOVE PVP,PVSTOR+1 + MOVE AB,ABSTO+1(PVP) + PUSHJ P,IMPURX + POP P,AB + POP P,LPVP ; RESTORE A + POP P,A + POPJ P, + +FIXATM: PUSH P,[0] +FIXTM5: JUMPE LPVP,FIXTM4 + MOVEI B,(LPVP) ; GET PTR TO ATOMS DOPE WORD + HRRZ LPVP,-1(B) ; SET UP LPVP FOR NEXT IN CHAIN + SKIPE -2(P) ; SEE IF PURE SCAN + JRST FIXTM2 + CAIL B,HIBOT + JRST FIXTM3 +FIXTM2: CAMG B,PARBOT ; SKIP IF NOT FROZEN + JRST FIXTM1 + HLRZ A,(B) + TRZ A,400000 ; GET RID OF MARK BIT + MOVE D,A ; GET A COPY OF LENGTH + SKIPE -2(P) + JRST PFATM + PUSHJ P,CAFREE ; GET STORAGE + SKIPE GCDANG ; SEE IF WON + JRST LOSLP1 ; GO TO CAUSE GC + JRST FIXT10 +PFATM: PUSH P,AB + MOVE PVP,PVSTOR+1 + MOVE AB,ABSTO+1(PVP) + SETZM GPURFL + PUSHJ P,CAFREE + SETOM GPURFL + POP P,AB +FIXT10: SUBM D,ABOTN + MOVNS ABOTN + SUBI B,-1(D) ; POINT TO START OF ATOM + HRLZ C,B ; SET UP FOR BLT + HRRI C,(A) + ADDI A,-1(D) ; FIX UP TO POINT TO NEW DOPE WORD + BLT C,(A) + HLLZS -1(A) + HLLOS (A) ; -1 IN RELOCATION FIELD SINCE ITS NOT GARBAGE + ADDI B,-1(D) ; B POINTS TO SECOND D.W. + HRRM A,(B) ; PUT IN RELOCATION + MOVSI D,400000 ; UNMARK ATOM + ANDCAM D,(A) + CAIL B,HIBOT ; SKIP IF IMPURE + PUSHJ P,IMPRF + JRST FIXTM5 ; CONTINE FIXUP + +FIXTM4: POP P,LPVP ; FIX UP LPVP TO POINT TO NEW CHAIN + POPJ P, ; EXIT + +FIXTM1: HRRM B,(B) ; SMASH IN RELOCATION + MOVSI D,400000 + ANDCAM D,(B) ; CLEAR MARK BIT + JRST FIXTM5 + +FIXTM3: MOVE 0,(P) + HRRM 0,-1(B) + MOVEM B,(P) ; FIX UP CHAIN + JRST FIXTM5 + + + +IAGC": + +;SET FLAG FOR INTERRUPT HANDLER + SETZB M,RCL ; CLEAR OUT RECYCLE LIST CELLS, AND RSUBR BASE PNTR + EXCH P,GCPDL ; IN CASE CURRENT PDL LOSES + PUSH P,B + PUSH P,A + PUSH P,C ; SAVE C + +; HERE TO CLEAN UP ANY POSSIBLE PURENESS IN GC SPACE BEFORE COLLECTING + + + + MOVE A,NOWFRE + ADD A,GCSTOP ; ADJUSTMENT TO KEEP FREE REAL + SUB A,FRETOP + MOVEM A,NOWFRE + MOVE A,NOWP ; ADJUSTMENTS FOR STACKS + SUB A,CURP + MOVEM A,NOWP + MOVE A,NOWTP + SUB A,CURTP + MOVEM A,NOWTP + + MOVEI B,[ASCIZ /GIN /] + SKIPE GCMONF ; MONITORING + PUSHJ P,MSGTYP +NOMON1: HRRZ C,(P) ; GET CAUSE OF GC INDICATOR + MOVE B,GCNO(C) ; ADD 1 TO COUNT OF GC'S CAUSED BY GIVEN REASON + ADDI B,1 + MOVEM B,GCNO(C) + MOVEM C,GCCAUS ; SAVE CAUSE OF GC + SKIPN GCMONF ; MONITORING + JRST NOMON2 + MOVE B,MSGGCT(C) ; GET CAUSE MESSAGE + PUSHJ P,MSGTYP +NOMON2: HLRZ C,(P) ; FIND OUT WHO CAUSED THE GC + MOVEM C,GCCALL ; SAVE CALLER OF GC + SKIPN GCMONF ; MONITORING + JRST NOMON3 + MOVE B,MSGGFT(C) + PUSHJ P,MSGTYP +NOMON3: SUB P,[1,,1] ; POP OFF C + POP P,A + POP P,B + EXCH P,GCPDL + JRST .+1 +IAAGC: + HLLZS SQUPNT ; FLUSH SQUOZE TABLE + SETZB M,RCL ; ALTERNATE GC-ENTRY POINT FOR INITIALIZATION +INITGC: SETOM GCFLG + SETZM RCLV + +;SAVE AC'S + EXCH PVP,PVSTOR+1 + IRP AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM] + MOVEM AC,AC!STO"+1(PVP) + TERMIN + + MOVE 0,PVSTOR+1 + MOVEM 0,PVPSTO+1(PVP) + MOVEM PVP,PVSTOR+1 + MOVE D,DSTORE + MOVEM D,DSTO(PVP) + JSP E,CKPUR ; CHECK FOR PURE RSUBR + + +;SET UP E TO POINT TO TYPE VECTOR + GETYP E,TYPVEC + CAIE E,TVEC + JRST AGCE1 + HRRZ TYPNT,TYPVEC+1 + HRLI TYPNT,B + +CHPDL: MOVE D,P ; SAVE FOR LATER +CORGET: MOVE P,[-2000,,MRKPDL] + +;FENCE POST PDLS AND CHECK IF ANY SHOULD BE SHRUNK + + MOVEI A,(TB) ;POINT TO CURRENT FRAME IN PROCESS + PUSHJ P,FRMUNG ;AND MUNG IT + MOVE A,TP ;THEN TEMPORARY PDL + PUSHJ P,PDLCHK + MOVE PVP,PVSTOR+1 + MOVE A,PSTO+1(PVP) ;AND UNMARKED P STACK + PUSHJ P,PDLCHP + + ; FIRST CREATE INFERIOR TO HOLD NEW PAGES + +INFCRT: MOVE A,PARBOT ; GENERATE NEW PARBOT AND PARNEW + ADD A,PARNEW + ADDI A,1777 + ANDCMI A,1777 ; EVEN PAGE BOUNDARY + HRRM A,BOTNEW ; INTO POINTER WORD + HRRZM A,FNTBOT + SETZM WNDBOT + SETZM WNDTOP + MOVEM A,NPARBO + HRRZ A,BOTNEW ; GET PAGE TO START INF AT + ASH A,-10. ; TO PAGES + MOVEI R,(A) ; COPY A + PUSHJ P,%GCJOB ; GET PAGE HOLDER + MOVSI FPTR,-2000 ; FIX UP FRONTIER POINTER + MOVE A,WNDBOT + ADDI A,2000 ; FIND WNDTOP + MOVEM A,WNDTOP + +;MARK PHASE: MARK ALL LISTS AND VECTORS +;POINTED TO WITH ONE BIT IN SIGN BIT +;START AT TRANSFER VECTOR +NOMAP: MOVE A,GLOBSP+1 ; GET GLOBSP TO SAVE + MOVEM A,GCGBSP + MOVE A,ASOVEC+1 ; ALSO SAVE FOR USE BY GC + MOVEM A,GCASOV + MOVE A,NODES+1 ; SAVE FOR ASSOCIATION UPDATE AND MOVEMENT PHASE + MOVEM A,GCNOD + MOVE A,GLOTOP+1 ; GET GLOTOP FOR LOCR HACKS + MOVEM A,GLTOP + MOVE A,PURVEC+1 ; SAVE PURE VECTOR FOR GETPAG + MOVEM A,PURSVT + MOVE A,HASHTB+1 + MOVEM A,GCHSHT + + SETZ LPVP, ;CLEAR NUMBER OF PAIRS + MOVE 0,NGCS ; SEE IF NEED HAIR + SOSGE GCHAIR + MOVEM 0,GCHAIR ; RESUME COUNTING + MOVSI D,400000 ;SIGN BIT FOR MARKING + MOVE A,ASOVEC+1 ;MARK ASSOC. VECTOR NOW + PUSHJ P,PRMRK ; PRE-MARK + MOVE A,GLOBSP+1 + PUSHJ P,PRMRK + MOVE A,HASHTB+1 + PUSHJ P,PRMRK +OFFSET 0 + + MOVE A,IMQUOTE THIS-PROCESS + +OFFSET OFFS + + MOVEM A,GCATM + +; HAIR TO DO AUTO CHANNEL CLOSE + + MOVEI 0,N.CHNS-1 ; NUMBER OF CHANNELS + MOVEI A,CHNL1 ; 1ST SLOT + + SKIPE 1(A) ; NOW A CHANNEL? + SETZM (A) ; DON'T MARK AS CHANNELS + ADDI A,2 + SOJG 0,.-3 + + MOVEI C,PVSTOR + MOVEI B,TPVP + MOVE A,PVSTOR+1 ; MARK MAIN PROCES EVEN IF SWAPPED OUT + PUSHJ P,MARK + MOVEI C,MAINPR-1 + MOVEI B,TPVP + MOVE A,MAINPR ; MARK MAIN PROCES EVEN IF SWAPPED OUT + PUSHJ P,MARK + MOVEM A,MAINPR ; ADJUST PTR + +; ASSOCIATION AND VALUE FLUSHING PHASE + + SKIPN GCHAIR ; ONLY IF HAIR + PUSHJ P,VALFLS + + SKIPN GCHAIR + PUSHJ P,ATCLEA ; CLEAN UP ATOM TABLE + + SKIPE GCHAIR ; IF NOT HAIR, DO CHANNELS NOW + PUSHJ P,CHNFLS + + PUSHJ P,ASSOUP ; UPDATE AND MOVE ASSOCIATIONS + PUSHJ P,CHFIX ; SEND OUT CHANNELS AND MARK LOSERS + PUSHJ P,STOGC ; FIX UP FROZEN WORLD + MOVE P,GCPDL ; SWITCH PDLS IN CASE THIS ONE DISSAPPEARS + + + MOVE A,NPARBO ; UPDATE GCSBOT + MOVEM A,GCSBOT + MOVE A,PURSVT + PUSH P,PURVEC+1 + MOVEM A,PURVEC+1 ; RESTORE PURVEC + PUSHJ P,CORADJ ; ADJUST CORE SIZE + POP P,PURVEC+1 + + + + ; MAP NEW PAIR SPACE IN FOR PAIR SPACE UPDATE + +NOMAP1: MOVEI A,@BOTNEW + ADDI A,1777 ; TO PAGE BOUNDRY + ANDCMI A,1777 + MOVE B,A +DOMAP: ASH B,-10. ; TO PAGES + MOVE A,PARBOT + MOVEI C,(A) ; COMPUTE HIS TOP + ASH C,-10. + ASH A,-10. + SUBM A,B ; B==> - # OF PAGES + HRLI A,(B) ; AOBJN TO SOURCE AND DEST + MOVE B,A ; IN CASE OF FUNNY + HRRI B,(C) ; MAP HIS POSSIBLE HIGHER OR LOWER PAGES + PUSHJ P,%INFMP ; NOW FLUSH INF AND MAKE HIS CORE MINE + JRST GARZER + + ; CORE ADJUSTMENT PHASE + +CORADJ: MOVE A,PURTOP + SUB A,CURPLN ; ADJUST FOR RSUBR + ANDCMI A,1777 ; ROUND DOWN + MOVEM A,RPTOP + MOVEI A,@BOTNEW ; NEW GCSTOP + ADDI A,1777 ; GCPDL AND ROUND + ANDCMI A,1777 ; TO PAGE BOUNDRY + MOVEM A,CORTOP ; TAKE CARE OF POSSIBLE LATER LOSSAGE + CAMLE A,RPTOP ; SEE IF WE CAN MAP THE WORLD BACK IN + FATAL AGC--UNABLE TO MAP GC-SPACE INTO CORE + CAMG A,PURBOT ; SEE IF WE HAVE TO PUNT SOME PURE TO DO IT + JRST CORAD0 ; DON'T HAVE TO PUNT SOME PURE + PUSHJ P,MAPOUT ; GET THE CORE + FATAL AGC--PAGES NOT AVAILABLE + +; NOW THAT WE ARE ABLE TO MAP TO GCS INTO CORE WE WILL TRY TO HONOR SOME REQUESTS +; FIRST LETS SEE IF WE HAVE TO CORE DOWN. +; GCDOWN IS DEFINED AS AMOUNT FROM FRETOP TO PURBOT NEEDED + +CORAD0: SKIPN B,GCDOWN ; CORE DOWN? + JRST CORAD1 ; NO, LETS GET CORE REQUIREMENTS + ADDI A,(B) ; AMOUNT+ONE FREE BLOCK + CAMGE A,RPTOP ; CAN WE WIN + JRST CORAD3 ; POSSIBLY + +; THIS IS A EXIT FOR LOSSAGE WITHOUT A FATAL ERROR +CORAD2: SETOM GCDANG ; INDICATE LOSSAGE + +; CALCULATE PARAMETERS BEFORE LEAVING +CORAD6: MOVE A,PURSVT ; GET PURE TABLE + PUSHJ P,SPCOUT ; OUT IT GOES IN CASE IT WAS CHANGED + MOVEI A,@BOTNEW ; GCSTOP + MOVEM A,GCSTOP + MOVE A,CORTOP ; ADJUST CORE IMAGE + ASH A,-10. ; TO PAGES +TRYPCO: PUSHJ P,P.CORE + FATAL AGC--CORE SCREW UP + MOVE A,CORTOP ; GET IT BACK + ANDCMI A,1777 + MOVEM A,FRETOP + MOVEM A,RFRETP + POPJ P, + +; TRIES TO SATISFY REQUEST FOR CORE +CORAD1: MOVEM A,CORTOP + MOVEI A,@BOTNEW + ADD A,GETNUM ; ADD MINIMUM CORE NEEDED + ADDI A,1777 ; ONE BLOCK+ROUND + ANDCMI A,1777 ; TO BLOCK BOUNDRY + CAMLE A,RPTOP ; CAN WE WIN + JRST CORAD2 ; LOSE + CAMGE A,PURBOT + JRST CORAD7 ; DON'T HAVE TO MAP OUT PURE + PUSHJ P,MAPOUT + JRST CORAD2 ; LOSS + +; NOW TRY TO GET SLOP SPACE. NOT NECESSARY BUT NICE +CORAD7: MOVEM A,CORTOP ; STORE POSSIBLE VALUE + MOVE B,RPTOP ; GET REAL PURTOP + SUB B,PURMIN ; KEEP PURMIN + CAMG B,CORTOP ; SEE IF CORTOP IS ALREADY HIGH + MOVE B,CORTOP ; DONT GIVE BACK WHAT WE GOT + MOVEM B,RPTOP ; FOOL CORE HACKING + ADD A,FREMIN + ANDCMI A,1777 ; TO PAGE BOUNDRY + CAMGE A,RPTOP ; DO WE WIN TOTALLY + JRST CORAD4 + MOVE A,RPTOP ; GET AS MUCH CORE AS POSSIBLE + PUSHJ P,MAPOUT + JRST CORAD6 ; LOSE, BUT YOU CAN'T HAVE EVERYTHING +CORAD4: CAMG A,PURBOT ; DO WE HAVE TO PUNT SOME PURE + JRST CORAD8 + PUSHJ P,MAPOUT ; GET IT + JRST CORAD6 +CORAD8: MOVEM A,CORTOP ; ADJUST PARAMETER + JRST CORAD6 ; WIN TOTALLY + +; WE CAN CORE DOWN NOW TO SEE IF WE CAN GET SOME SLOP SPACE + +CORAD3: ADD A,FREMIN + ANDCMI A,1777 + CAMGE A,PURBOT ; CAN WE WIN + JRST CORAD9 + MOVE A,RPTOP +CORAD9: SUB A,GCDOWN ; SATISFY GCDOWN REQUEST + JRST CORAD4 ; GO CHECK ALLOCATION + +MAPOUT: PUSH P,A ; SAVE A + SUB A,P.TOP ; AMOUNT TO GET + ADDI A,1777 ; ROUND + ANDCMI A,1777 ; TO PAGE BOUNDRY + ASH A,-PGSZ ; TO PAGES + PUSHJ P,GETPAG ; GET THEN + JRST MAPLOS ; LOSSAGE + AOS -1(P) ; INDICATE WINNAGE +MAPLOS: POP P,A + POPJ P, + + + ;GARBAGE ZEROING PHASE +GARZER: MOVE A,GCSTOP ;FIRST WORD OF GARBAGE IS AFTER PAIR SPACE + MOVE B,FRETOP ;LAST ADDRESS OF GARBAGE + 1 + CAIL A,(B) + JRST GARZR1 + CLEARM (A) ;ZERO THE FIRST WORD + CAIL A,-1(B) ; ARE WE AT THE TOP OF THE WORLD (FORMERLY CAML A,FRETOP) + JRST GARZR1 ; DON'T BLT +IFE ITS,[ + MOVEI B,777(A) + ANDCMI B,777 +] + HRLS A + ADDI A,1 ;MAKE A A BLT POINTER + BLT A,-1(B) ;AND COPY ZEROES INTO REST OF AREA +IFE ITS,[ + +; MAP UNWANTED PAGES OUT ON TWENEX (AFTER ZEROING REST OF LAST PAGE) + + MOVE D,PURBOT + ASH D,-PGSZ + ASH B,-PGSZ + MOVNI A,1 + MOVEI C,0 + HRLI B,400000 + +GARZR2: CAIG D,(B) + JRST GARZR1 + + PMAP + AOJA B,GARZR2 +] + + +; NOW REHASH THE ASSOCIATIONS BASED ON VALUES +GARZR1: PUSHJ P,REHASH + + + ;RESTORE AC'S +TRYCOX: SKIPN GCMONF + JRST NOMONO + MOVEI B,[ASCIZ /GOUT /] + PUSHJ P,MSGTYP +NOMONO: MOVE PVP,PVSTOR+1 + IRP AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + SKIPN DSTORE + SETZM DSTO(PVP) + MOVE PVP,PVPSTO+1(PVP) + +; CLOSING ROUTINE FOR G-C + PUSH P,A ; SAVE AC'C + PUSH P,B + PUSH P,C + PUSH P,D + + MOVE A,FRETOP ; ADJUST BLOAT-STAT PARAMETERS + SUB A,GCSTOP + ADDM A,NOWFRE + PUSHJ P,GCSET ; FIX UP BLOAT-STAT PARAMETERS + MOVE A,CURTP + ADDM A,NOWTP + MOVE A,CURP + ADDM A,NOWP + + PUSHJ P,CTIME + FSBR B,GCTIM ; GET TIME ELAPSED + MOVEM B,GCTIM ; SAVE ELAPSED TIME FOR INT-HANDLER + SKIPN GCMONF ; SEE IF MONITORING + JRST GCCONT + PUSHJ P,FIXSEN ; OUTPUT TIME + MOVEI A,15 ; OUTPUT C/R LINE-FEED + PUSHJ P,IMTYO + MOVEI A,12 + PUSHJ P,IMTYO +GCCONT: MOVE C,[NTPGOO,,NTPMAX] ; MAY FIX UP TP PARAMS TO ENCOURAGE + ; SHRINKAGE FOR EXTRA ROOM + SKIPE GCDANG + MOVE C,[ETPGOO,,ETPMAX] + HLRZM C,TPGOOD + HRRZM C,TPMAX + POP P,D ; RESTORE AC'C + POP P,C + POP P,B + POP P,A + MOVE A,GCDANG + JUMPE A,AGCWIN ; IF ZERO THE GC WORKED + SKIPN GCHAIR ; SEE IF HAIRY GC + JRST BTEST +REAGCX: MOVEI A,1 ; PREPARE FOR A HAIRY GC + MOVEM A,GCHAIR + SETZM GCDANG + MOVE C,[11,,10.] ; REASON FOR GC + JRST IAGC + +BTEST: SKIPE INBLOT + JRST AGCWIN + FATAL AGC--NO CORE AVAILABLE TO SATISFY REQUESTS + JRST REAGCX + +AGCWIN: SETZM PARNEW ;CLEAR FOR NEXT AGC CALL + SETZM GETNUM ;ALSO CLEAR THIS + SETZM INBLOT + SETZM GCFLG + + SETZM PGROW ; CLEAR GROWTH + SETZM TPGROW + SETOM GCHAPN ; INDICATE A GC HAS HAPPENED + SETOM GCHPN + SETOM INTFLG ; AND REQUEST AN INTERRUPT + SETZM GCDOWN + PUSHJ P,RBLDM +; JUMPE R,FINAGC +; JUMPN M,FINAGC ; IF M 0, RUNNING RSUBR SWAPPED OUT +; SKIPE PLODR ; LOADING ONE, M = 0 IS OK + JRST FINAGC + + FATAL AGC--RUNNING RSUBR WENT AWAY + +AGCE1: FATAL AGC--TYPE VECTOR NOT OF TYPE VECTOR + + ; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL +; POINT. + +FIXSEN: PUSH P,B ; SAVE TIME + MOVEI B,[ASCIZ /TIME= /] + PUSHJ P,MSGTYP ; PRINT OUT MESSAGE + POP P,B ; RESTORE B + FMPRI B,(100.0) ; CONVERT TO FIX + MULI B,400 + TSC B,B + ASH C,-163.(B) + MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME + PUSH P,C + IDIVI C,10. ; START COUNTING + JUMPLE C,.+2 + AOJA A,.-2 + POP P,C + CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER + JRST DOT1 +FIXOUT: IDIVI C,10. ; RECOVER NUMBER + HRLM D,(P) + SKIPE C + PUSHJ P,FIXOUT + PUSH P,A ; SAVE A + CAIN A,2 ; DECIMAL POINT HERE? + JRST DOT2 +FIX1: HLRZ A,(P)-1 ; GET NUMBER + ADDI A,60 ; MAKE IT A CHARACTER + PUSHJ P,IMTYO ; OUT IT GOES + POP P,A + SOJ A, + POPJ P, +DOT1: MOVEI A,". ; OUTPUT DECIMAL POINT AND PADDING 0 + PUSHJ P,IMTYO + MOVEI A,"0 + PUSHJ P,IMTYO + JRST FIXOUT ; CONTINUE +DOT2: MOVEI A,". ; OUTPUT DECIMAL POINT + PUSHJ P,IMTYO + JRST FIX1 + + + ; SUBROUTINE TO CHECK SIZE OF PDLS AND DO FENCEPOSTING + +PDLCHK: JUMPGE A,CPOPJ + HLRE B,A ;GET NEGATIVE COUNT + MOVE C,A ;SAVE A COPY OF PDL POINTER + SUBI A,-1(B) ;LOCATE DOPE WORD PAIR + HRRZS A ; ISOLATE POINTER + CAME A,TPGROW ;GROWING? + ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD + MOVMS B + CAIN A,2(C) + JRST NOFENC + SETOM 1(C) ; START FENECE POST + CAIN A,3(C) + JRST NOFENC + MOVSI D,1(C) ;YES, SET UP TO BLT FENCE POSTS + HRRI D,2(C) + BLT D,-2(A) ;FENCE POST ALL EXCEPT DOPE WORDS + + +NOFENC: CAMG B,TPMAX ;NOW CHECK SIZE + CAMG B,TPMIN + JRST MUNGTP ;TOO BIG OR TOO SMALL + POPJ P, + +MUNGTP: SUB B,TPGOOD ;FIND DELTA TP +MUNG3: MOVE C,-1(A) ;IS GROWTH ALREADY SPECIFIED + TRNE C,777000 ;SKIP IF NOT + POPJ P, ;ASSUME GROWTH GIVEN WILL WIN + + ASH B,-6 ;CONVERT TO NUMBER OF BLOCKS + JUMPLE B,MUNGT1 + CAILE B,377 ; SKIP IF BELOW MAX + MOVEI B,377 ; ELSE USE MAX + TRO B,400 ;TURN ON SHRINK BIT + JRST MUNGT2 +MUNGT1: MOVMS B + ANDI B,377 +MUNGT2: DPB B,[111100,,-1(A)] ;STORE IN DOPE WORD + POPJ P, + +; CHECK UNMARKED STACK (NO NEED TO FENCE POST) + +PDLCHP: HLRE B,A ;-LENGTH TO B + MOVE C,A + SUBI A,-1(B) ;POINT TO DOPE WORD + HRRZS A ;ISOLATE POINTER + CAME A,PGROW ;GROWING? + ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD + MOVMS B + CAIN A,2(C) + JRST NOPF + SETOM 1(C) ; START FENECE POST + CAIN A,3(C) + JRST NOPF + MOVSI D,1(C) + HRRI D,2(C) + BLT D,-2(A) + +NOPF: CAMG B,PMAX ;TOO BIG? + CAMG B,PMIN ;OR TOO LITTLE + JRST .+2 ;YES, MUNG IT + POPJ P, + SUB B,PGOOD + JRST MUNG3 + + +; ROUTINE TO PRE MARK SPECIAL HACKS + +PRMRK: SKIPE GCHAIR ; FLUSH IF NO HAIR + POPJ P, +PRMRK2: HLRE B,A + SUBI A,(B) ;POINT TO DOPE WORD + HLRZ F,1(A) ; GET LNTH + LDB 0,[111100,,(A)] ; GET GROWTHS + TRZE 0,400 ; SIGN HACK + MOVNS 0 + ASH 0,6 ; TO WORDS + ADD F,0 + LDB 0,[001100,,(A)] + TRZE 0,400 + MOVNS 0 + ASH 0,6 + ADD F,0 + PUSHJ P,ALLOGC + HRRM 0,1(A) ; NEW RELOCATION FIELD + IORM D,1(A) ;AND MARK + POPJ P, + + + ;GENERAL MARK SUBROUTINE. CALLED TO MARK ALL THINGS +; A/ GOODIE TO MARK FROM +; B/ TYPE OF A (IN RH) +; C/ TYPE,DATUM PAIR POINTER + +MARK2A: +MARK2: HLRZ B,(C) ;GET TYPE +MARK1: MOVE A,1(C) ;GET GOODIE +MARK: SKIPN DUMFLG + JUMPE A,CPOPJ ; NEVER MARK 0 + MOVEI 0,1(A) + CAIL 0,@PURBOT + JRST GCRETD +MARCON: PUSH P,A + HRLM C,-1(P) ;AND POINTER TO IT + ANDI B,TYPMSK ; FLUSH MONITORS + SKIPE DUMFLG ; SKIP IF NOT IN DUMPER + PUSHJ P,TYPHK ; HACK SOME TYPES + LSH B,1 ;TIMES 2 TO GET SAT + HRRZ B,@TYPNT ;GET SAT + ANDI B,SATMSK + JUMPE A,GCRET + CAILE B,NUMSAT ; SKIP IF TEMPLATE DATA + JRST TD.MRK + SKIPN GCDFLG +IFN ITS,[ + JRST @MKTBS(B) ;AND GO MARK + JRST @GCDISP(B) ; DISPATCH FOR DUMPERS +] +IFE ITS,[ + SKIPA E,MKTBS(B) + MOVE E,GCDISP(B) + HRLI E,-1 + JRST (E) +] +; HERE TO MARK A POSSIBLE DEFER POINTER + +DEFQMK: GETYP B,(A) ; GET ITS TYPE + LSH B,1 + HRRZ B,@TYPNT + ANDI B,SATMSK ; AND TO SAT + SKIPGE MKTBS(B) + +;HERE TO MARK THAT WHICH IS POINTED TO BY A DEFERRED POINTER + +DEFMK: TLOA TYPNT,400000 ;USE SIGN BIT AS FLAG + +;HERE TO MARK LIST ELEMENTS + +PAIRMK: TLZ TYPNT,400000 ;TURN OF DEFER BIT + PUSH P,[0] ; WILL HOLD BACK PNTR + MOVEI C,(A) ; POINT TO LIST +PAIRM1: CAMGE C,PARTOP ;CHECK FOR BEING IN BOUNDS + CAMGE C,PARBOT + FATAL AGC--MARKED PAIR OUTSIDE PAIR SPACE + SKIPGE B,(C) ;SKIP IF NOT MARKED + JRST RETNEW ;ALREADY MARKED, RETURN + IORM D,(C) ;MARK IT + SKIPL FPTR ; SEE IF IN FRONTEIR + PUSHJ P,MOVFNT ; EXPAND THE FRONTEIR + MOVEM B,FRONT(FPTR) + MOVE 0,1(C) ; AND 2D + AOBJN FPTR,.+2 ; AOS AND CHECK FRONTEIR + PUSHJ P,MOVFNT ; EXPAND FRONTEIR + MOVEM 0,FRONT(FPTR) + ADD FPTR,[1,,1] ; MOVE ALONG IN FRONTIER + + +PAIRM2: MOVEI A,@BOTNEW ; GET INF ADDR + SUBI A,2 + HRRM A,(C) ; LEAVE A POINTER TO NEW HOME + HRRZ E,(P) ; GET BACK POINTER + JUMPE E,PAIRM7 ; 1ST ONE, NEW FIXUP + MOVSI 0,(HRRM) ; INS FOR CLOBBER + PUSHJ P,SMINF ; SMASH INF'S CORE IMAGE +PAIRM4: MOVEM A,(P) ; NEW BACK POINTER + JUMPL TYPNT,DEFDO ;GO HANDLE DEFERRED POINTER + HRLM B,(P) ; SAVE OLD CDR + PUSHJ P,MARK2 ;MARK THIS DATUM + HRRZ E,(P) ; SMASH CAR IN CASE CHANGED + ADDI E,1 + MOVSI 0,(MOVEM) + PUSHJ P,SMINF + HLRZ C,(P) ;GET CDR OF LIST + CAIGE C,@PURBOT ; SKIP IF PURE (I.E. DONT MARK) + JUMPN C,PAIRM1 ;IF NOT NIL, MARK IT +GCRETP: SUB P,[1,,1] + +GCRET: TLZ TYPNT,400000 ;FOR PAIRMKS BENEFIT + HLRZ C,-1(P) ;RESTORE C + POP P,A + POPJ P, ;AND RETURN TO CALLER + +GCRETD: ANDI B,TYPMSK ; TURN OFF MONITORS + CAIN B,TLOCR ; SEE IF A LOCR + JRST MARCON + SKIPN GCDFLG ; SKIP IF IN PURIFIER OR DUMPER + POPJ P, + CAIE B,TATOM ; WE MARK PURE ATOMS + CAIN B,TCHSTR ; AND STRINGS + JRST MARCON + POPJ P, + +;HERE TO MARK DEFERRED POINTER + +DEFDO: PUSH P,B ; PUSH OLD PAIR ON STACK + PUSH P,1(C) + MOVEI C,-1(P) ; USE AS NEW DATUM + PUSHJ P,MARK2 ;MARK THE DATUM + HRRZ E,-2(P) ; GET POINTER IN INF CORE + ADDI E,1 + MOVSI 0,(MOVEM) + PUSHJ P,SMINF ; AND CLOBBER + HRRZ E,-2(P) + MOVE A,-1(P) + MOVSI 0,(HRRM) ; SMASH IN RIGHT HALF + PUSHJ P,SMINF + SUB P,[3,,3] + JRST GCRET ;AND RETURN + + +PAIRM7: MOVEM A,-1(P) ; SAVE NEW VAL FOR RETURN + JRST PAIRM4 + +RETNEW: HRRZ A,(C) ; POINT TO NEW WORLD LOCN + HRRZ E,(P) ; BACK POINTER + JUMPE E,RETNW1 ; NONE + MOVSI 0,(HRRM) + PUSHJ P,SMINF + JRST GCRETP + +RETNW1: MOVEM A,-1(P) + JRST GCRETP + +; ROUTINE TO EXPAND THE FRONTEIR + +MOVFNT: PUSH P,B ; SAVE REG B + HRRZ A,BOTNEW ; CURRENT BOTTOM OF WINDOW + ADDI A,2000 ; MOVE IT UP + HRRM A,BOTNEW + HRRZM A,FNTBOT ; BOTTOM OF FRONTEIR + MOVEI B,FRNP + ASH A,-10. ; TO PAGES + PUSHJ P,%GETIP + PUSHJ P,%SHWND ; SHARE THE PAGE + MOVSI FPTR,-2000 ; FIX UP FPTR + POP P,B + POPJ P, + + +; ROUTINE TO SMASH INFERIORS PPAGES +; E/ ADDR IN INF, A/ THING TO SMASH ,0/ INS TO USE + +SMINF: CAMGE E,FNTBOT + JRST SMINF1 ; NOT IN FRONTEIR + SUB E,FNTBOT ; ADJUST POINTER + IOR 0,[0 A,FRONT(E)] ; BUILD INSTRUCTION + XCT 0 ; XCT IT + POPJ P, ; EXIT +SMINF1: CAML E,WNDBOT + CAML E,WNDTOP ; SEE IF IN WINDOW + JRST SMINF2 +SMINF3: SUB E,WNDBOT ; FIX UP + IOR 0,[0 A,WIND(E)] ; FIX INS + XCT 0 + POPJ P, +SMINF2: PUSH P,A ; SAVE E + PUSH P,B ; SAVE B + HRRZ A,E ; E SOMETIMES HAS STUFF IN LH + ASH A,-10. + MOVEI B,WNDP ; WINDOW PAGE + PUSHJ P,%SHWND ; SHARE IT + ASH A,10. ; TO PAGES + MOVEM A,WNDBOT ; UPDATE POINTERS + ADDI A,2000 + MOVEM A,WNDTOP + POP P,B ; RESTORE ACS + POP P,A + JRST SMINF3 ; FIX UP INF + + + + ; VECTOR AND TP MARKER, SIGN OF TYPNT IS SET BASED ON WHICH ONE + +TPMK: TLOA TYPNT,400000 ;SET TP MARK FLAG +VECTMK: TLZ TYPNT,400000 + MOVEI 0,@BOTNEW ; POINTER TO INF + PUSH P,0 + MOVEI E,(A) ;SAVE A POINTER TO THE VECTOR + HLRE B,A ;GET -LNTH + SUB A,B ;LOCATE DOPE WORD + MOVEI A,1(A) ;ZERO LH AND POINT TO 2ND DOPE WORD + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST VECTB1 ;LOSE, COMPLAIN + + HLLM TYPNT,(P) ; SAVE MARKER INDICATING STACK + JUMPGE TYPNT,NOBUFR ;IF A VECTOR, NO BUFFER CHECK + CAME A,PGROW ;IS THIS THE BLOWN P + CAMN A,TPGROW ;IS THIS THE GROWING PDL + JRST NOBUFR ;YES, DONT ADD BUFFER + ADDI A,PDLBUF ;POINT TO REAL DOPE WORD + MOVSI 0,-PDLBUF ;ALSO FIX UP POINTER + ADD 0,1(C) + MOVEM 0,-1(P) ; FIXUP RET'D PNTR + +NOBUFR: HLRE B,(A) ;GET LENGTH FROM DOPE WORD + JUMPL B,EXVECT ; MARKED, LEAVE + LDB B,[111100,,-1(A)] ; GET TOP GROWTH + TRZE B,400 ; HACK SIGN BIT + MOVNS B + ASH B,6 ; CONVERT TO WORDS + PUSH P,B ; SAVE TOP GROWTH + LDB 0,[001100,,-1(A)] ;GET GROWTH FACTOR + TRZE 0,400 ;KILL SIGN BIT AND SKIP IF + + MOVNS 0 ;NEGATE + ASH 0,6 ;CONVERT TO NUMBER OF WORDS + PUSH P,0 ; SAVE BOTTOM GROWTH + ADD B,0 ;TOTAL GROWTH TO B +VECOK: HLRE E,(A) ;GET LENGTH AND MARKING + MOVEI F,(E) ;SAVE A COPY + ADD F,B ;ADD GROWTH + SUBI E,2 ;- DOPE WORD LENGTH + IORM D,(A) ;MAKE SURE NOW MARKED + PUSHJ P,ALLOGC ; ALLOCATE SPACE FOR VECTOR IN THE INF + HRRM 0,(A) +VECOK1: JUMPLE E,MOVEC2 ; ZERO LENGTH, LEAVE + PUSH P,A ; SAVE POINTER TO DOPE WORD + SKIPGE B,-1(A) ;SKIP IF UNIFORM + TLNE B,377777-.VECT. ;SKIP IF NOT SPECIAL + JUMPGE TYPNT,NOTGEN ;JUMP IF NOT A GENERAL VECTOR + +GENRAL: HLRZ 0,B ;CHECK FOR PSTACK + TRZ 0,.VECT. + JUMPE 0,NOTGEN ;IT ISN'T GENERAL + JUMPL TYPNT,TPMK1 ; JUMP IF TP + MOVEI C,(A) + SUBI C,1(E) ; C POINTS TO BEGINNING OF VECTOR + + ; LOOP TO MARK ELEMENTS IN A GENERAL VECTOR +VECTM2: HLRE B,(C) ;GET TYPE AND MARKING + JUMPL B,UMOVEC ;RETURN, (EITHER DOPE WORD OR FENCE POST) + MOVE A,1(C) ;DATUM TO A + + +VECTM3: PUSHJ P,MARK ;MARK DATUM + MOVEM A,1(C) ; IN CASE WAS FIXED +VECTM4: ADDI C,2 + JRST VECTM2 + +UMOVEC: POP P,A +MOVEC2: POP P,C ; RESTORE BOTTOM GROWTH + HRRZ E,-1(P) ; GET POINTER INTO INF + SKIPN C ; SKIP IF NO BOTTOM GROWTH + JRST MOVEC3 + JUMPL C,.+3 ; SEE IF BOTTOM SHRINKAGE + ADD E,C ; GROW IT + JRST MOVEC3 ; CONTINUE + HRLM C,E ; MOVE SHRINKAGE FOR TRANSFER PHASE +MOVEC3: PUSHJ P,DOPMOD ; MODIFY DOPE WORD AND PLACE IN INF + PUSHJ P,TRBLKV ; SEND VECTOR INTO INF +TGROT: CAMGE A,PARBOT ; SKIP IF NOT STORAGE + JRST TGROT1 + MOVE C,DOPSV1 ; RESTORE DOPE WORD + SKIPN (P) ; DON'T RESTORE D.W.'S YET IF THERE IS GROWTH + MOVEM C,-1(A) +TGROT1: POP P,C ; IS THERE TOP GROWH + SKIPN C ; SEE IF ANY GROWTH + JRST DOPEAD + SUBI E,2 + SKIPG C + JRST OUTDOP + PUSH P,C ; SAVE C + SETZ C, ; ZERO C + PUSHJ P,ADWD + ADDI E,1 + SETZ C, ; ZERO WHERE OLD DOPE WORDS WERE + PUSHJ P,ADWD + POP P,C + ADDI E,-1(C) ; MAKE ADJUSTMENT FOR TOP GROWTH +OUTDOP: PUSHJ P,DOPOUT +DOPEAD: +EXVECT: HLRZ B,(P) + SUB P,[1,,1] ; GET RID OF FPTR + PUSHJ P,RELATE ; RELATIVIZE + TRNN B,400000 ; WAS THIS A STACK + JRST GCRET + MOVSI 0,PDLBUF ; FIX UP STACK PTR + ADDM 0,(P) + JRST GCRET ; EXIT + +VECLOS: JUMPL C,CCRET ;JUMP IF CAN'T MUNG TYPE + HLLZ 0,(C) ;GET TYPE + MOVEI B,TILLEG ;GET ILLEGAL TYPE + HRLM B,(C) + MOVEM 0,1(C) ;AND STORE OLD TYPE AS VALUE + JRST UMOVEC ;RETURN WITHOUT MARKING VECTOR + +CCRET: CLEARM 1(C) ;CLOBBER THE DATUM + JRST GCRET + + +; ROUTINE TO MARK A TP. IT SCANS THE TP. IT MARKS ALL THE ITEMS AND IT MAPS AN +; UPDATED VERSION INTO THE INFERIOR WITHOUT CHANGING THE ORIGINAL. + +TPMK1: +TPMK2: POP P,A + POP P,C + HRRZ E,-1(P) ; FIX UP PARAMS + ADDI E,(C) + PUSH P,A ; REPUSH A + HRRZ B,(A) ; CALCULATE RELOCATION + SUB B,A + MOVE C,-1(P) ; ADJUST FOR GROWTH + SUB B,C + HRLZS C + PUSH P,C + PUSH P,B + PUSH P,E + PUSH P,[0] +TPMK3: HLRZ E,(A) ; GET LENGTH + TRZ E,400000 ; GET RID OF MARK BIT + SUBI A,-1(E) ;POINT TO FIRST ELEMENT + MOVEI C,(A) ;POINT TO FIRST ELEMENT WITH C +TPMK4: HLRE B,(C) ;GET TYPE AND MARKING + JUMPL B,TPMK7 ;RETURN, (EITHER DOPE WORD OR FENCE POST) + HRRZ A,(C) ;DATUM TO A + ANDI B,TYPMSK ; FLUSH MONITORS + CAIE B,TCBLK + CAIN B,TENTRY ;IS THIS A STACK FRAME + JRST MFRAME ;YES, MARK IT + CAIE B,TUBIND ; BIND + CAIN B,TBIND ;OR A BINDING BLOCK + JRST MBIND + CAIE B,TBVL ; CHECK FOR OTHER BINDING HACKS + CAIN B,TUNWIN + SKIPA ; FIX UP SP-CHAIN + CAIN B,TSKIP ; OTHER BINDING HACK + PUSHJ P,FIXBND + + +TPMK5: PUSH P,(C) ; SAVE BECAUSE FRAMES MIGHT MUNG IT + HRRM A,(C) ; FIX UP IN CASE OF SP CHAIN + PUSHJ P,MARK1 ;MARK DATUM + MOVE R,A ; SAVE A + POP P,M + MOVE A,(C) + PUSHJ P,OUTTP ; MOVE OUT TYPE + MOVE A,R + PUSHJ P,OUTTP ; SEND OUT VALUE + MOVEM M,(C) ; RESTORE TO OLD VALUE +TPMK6: ADDI C,2 + JRST TPMK4 + +MFRAME: HRRZ 0,1(C) ; SET UP RELITIVIZATION OF PTR TO PREVIOUS FRAME + HRROI C,FRAMLN+FSAV-1(C) ;POINT TO FUNCTION + HRRZ A,1(C) ; GET IT + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST MFRAM1 ; IGNORE, NOT IN VECTOR SPACE + HRL A,(A) ; GET LENGTH + MOVEI B,TVEC + PUSHJ P,MARK ; AND MARK IT +MFRAM1: HLL A,1(C) + PUSHJ P,OUTTP ; SEND IT OUT + HRRZ A,OTBSAV-FSAV+1(C) ; POINT TO TB TO PREVIOUS FRAME + SKIPE A + ADD A,-2(P) ; RELOCATE IF NOT 0 + HLL A,2(C) + PUSHJ P,OUTTP ; SEND IT OUT + MOVE A,-2(P) ; ADJUST AB SLOT + ADD A,ABSAV-FSAV+1(C) ; POINT TO SAVED AB + PUSHJ P,OUTTP ; SEND IT OUT + MOVE A,-2(P) ; ADJUST SP SLOT + ADD A,SPSAV-FSAV+1(C) ;POINT TO SAVED SP + SUB A,-3(P) ; ADJUSTMENT OF LENGTH IF GROWTH + PUSHJ P,OUTTP ; SEND IT OUT + HRROI C,PSAV-FSAV(C) ;POINT TO SAVED P + MOVEI B,TPDL + PUSHJ P,MARK1 ;AND MARK IT + PUSHJ P,OUTTP ; SEND IT OUT + HLRE 0,TPSAV-PSAV+1(C) + MOVE A,TPSAV-PSAV+1(C) + SUB A,0 + MOVEI 0,1(A) + MOVE A,TPSAV-PSAV+1(C) + CAME 0,TPGROW ; SEE IF BLOWN + JRST MFRAM9 + MOVSI 0,PDLBUF + ADD A,0 +MFRAM9: ADD A,-2(P) + SUB A,-3(P) ; ADJUST + PUSHJ P,OUTTP + MOVE A,PCSAV-PSAV+1(C) + PUSHJ P,OUTTP + HRROI C,-PSAV+1(C) ; POINT PAST THE FRAME + JRST TPMK4 ;AND DO MORE MARKING + + +MBIND: PUSHJ P,FIXBND + MOVEI B,TATOM ;FIRST MARK ATOM + SKIPN GCHAIR ; IF NO HAIR, MARK ALL NOW + SKIPE (P) ; PASSED MARKER, IF SO DONT SKIP + JRST MBIND2 ; GO MARK + MOVE A,1(C) ; RESTORE A + CAME A,GCATM + JRST MBIND1 ; NOT IT, CONTINUE SKIPPING + HRRM LPVP,2(C) ; SAVE IN RH OF TPVP,,0 + MOVE 0,-4(P) ; RECOVER PTR TO DOPE WORD + HRLM 0,2(C) ; SAVE FOR MOVEMENT + MOVEI B,TATOM ; MARK THE BINDING TO THIS PROCESS + PUSHJ P,MARK1 ; MARK THE ATOM + MOVEI LPVP,(C) ; POINT + SETOM (P) ; INDICATE PASSAGE +MBIND1: ADDI C,6 ; SKIP BINDING + MOVEI 0,6 + SKIPE -1(P) ; ONLY UPDATE IF SENDING OVER + ADDM 0,-1(P) + JRST TPMK4 + +MBIND2: HLL A,(C) + PUSHJ P,OUTTP ; FIX UP CHAIN + MOVEI B,TATOM ; RESTORE IN CASE SMASHED + PUSHJ P,MARK1 ; MARK ATOM + PUSHJ P,OUTTP ; SEND IT OUT + ADDI C,2 + PUSH P,(C) ; SAVE BECAUSE FRAMES MIGHT MUNG IT + PUSHJ P,MARK2 ;MARK DATUM + MOVE R,A ; SAVE A + POP P,M + MOVE A,(C) + PUSHJ P,OUTTP ; MOVE OUT TYPE + MOVE A,R + PUSHJ P,OUTTP ; SEND OUT VALUE + MOVEM M,(C) ; RESTORE TO OLD VALUE + ADDI C,2 + MOVEI B,TLIST ; POINT TO DECL SPECS + HLRZ A,(C) + PUSHJ P,MARK ; AND MARK IT + HRR A,(C) ; LIST FIX UP + PUSHJ P,OUTTP + SKIPL A,1(C) ; PREV LOC? + JRST NOTLCI + MOVEI B,TLOCI ; NOW MARK LOCATIVE + PUSHJ P,MARK1 +NOTLCI: PUSHJ P,OUTTP + ADDI C,2 + JRST TPMK4 + +FIXBND: HRRZ A,(C) ; GET PTR TO CHAIN + SKIPE A ; DO NOTHING IF EMPTY + ADD A,-3(P) + POPJ P, +TPMK7: +TPMK8: MOVNI A,1 ; FENCE-POST THE STACK + PUSHJ P,OUTTP + ADDI C,1 ; INCREMENT C FOR FENCE-POST + SUB P,[1,,1] ; CLEAN UP STACK + POP P,E ; GET UPDATED PTR TO INF + SUB P,[2,,2] ; POP OFF RELOCATION + HRRZ A,(P) + HLRZ B,(A) + TRZ B,400000 + SUBI A,-1(B) + SUBI C,(A) ; GET # OF WORDS TRANSFERED + SUB B,C ; GET # LEFT + ADDI E,-2(B) ; ADJUST POINTER TO INF + POP P,A + POP P,C ; IS THERE TOP GROWH + ADD E,C ; MAKE ADJUSTMENT FOR TOP GROWTH + ANDI E,-1 + PUSHJ P,DOPMOD ; FIX UP DOPE WORDS + PUSHJ P,DOPOUT ; SEND THEM OUT + JRST DOPEAD + + + ; ROUTINE TO ALLOCATE ROOM FOR VECTORS IN INFERIOR +; F= # OF WORDS TO ALLOCATE + +ALLOGC: HRRZS A ; GET ABS VALUE + SKIPN GCDFLG ; SKIP IF IN DUMPER + CAML A,GCSBOT ; SKIP IF IN STORAGE + JRST ALOGC2 ; JUMP IF ALLOCATING + HRRZ 0,A + POPJ P, +ALOGC2: PUSH P,A ; SAVE A +ALOGC1: HLRE 0,FPTR ; GET ROOM LEFT + ADD 0,F ; SEE IF ITS ENOUGH + JUMPL 0,ALOCOK + MOVE F,0 ; MODIFY F + PUSH P,F + PUSHJ P,MOVFNT ; MOVE UP FRONTEIR + POP P,F + JRST ALOGC1 ; CONTINUE +ALOCOK: ADD FPTR,F ; MODIFY FPTR + HRLZS F + ADD FPTR,F + POP P,A ; RESTORE A + MOVEI 0,@BOTNEW + SUBI 0,1 ; RELOCATION PTR + POPJ P, ; EXIT + + + + +; TRBLK MOVES A VECTOR INTO THE INFERIOR +; E= STARTING ADDR IN INF A= DOPE WORD OF VECTOR + +TRBLK: HRRZS A + SKIPE GCDFLG + JRST TRBLK7 + CAMGE A,GCSBOT ; SEE IF IN GC-SPACE + JRST FIXDOP +TRBLK7: PUSH P,A + HLRZ 0,(A) + TRZ 0,400000 ; TURN OFF GC FLAG + HRRZ F,A + HLRE A,E ; GET SHRINKAGE + ADD 0,A ; MUNG LENGTH + SUB F,0 + ADDI F,1 ; F POINTS TO START OF VECTOR +TRBLK2: HRRZ R,E ; SAVE POINTER TO INFERIOR + ADD E,0 ; E NOW POINTS TO FINAL ADDRESS+1 + MOVE M,E ;SAVE E +TRBLK1: MOVE 0,R + SUBI E,1 + CAMGE R,FNTBOT ; SEE IF IN FRONTEIR + JRST TRBL10 + SUB E,FNTBOT ; ADJUST E + SUB 0,FNTBOT ; ADJ START + MOVEI A,FRONT+1777 + JRST TRBLK4 +TRBL10: CAML R,WNDBOT + CAML R,WNDTOP ; SEE IF IN WINDOW + JRST TRBLK5 ; NO + SUB E,WNDBOT + SUB 0,WNDBOT + MOVEI A,WIND+1777 +TRBLK4: ADDI 0,-1777(A) ; CALCULATE START IN WINDOW OR FRONTEIR + CAIL E,2000 + JRST TRNSWD + ADDI E,-1777(A) ; SUBTRACT WINDBOT + HRL 0,F ; SET UP FOR BLT + BLT 0,(E) + POP P,A + +FIXDOP: IORM D,(A) + MOVE E,M ; GET END OF WORD + POPJ P, +TRNSWD: PUSH P,B + MOVEI B,1(A) ; GET TOP OF WORLD + SUB B,0 + HRL 0,F + BLT 0,(A) + ADD F,B ; ADJUST F + ADD R,B + POP P,B + MOVE E,M ; RESTORE E + JRST TRBLK1 ; CONTINUE +TRBLK5: HRRZ A,R ; COPY E + ASH A,-10. ; TO PAGES + PUSH P,B ; SAVE B + MOVEI B,WNDP ; IT IS WINDOW + PUSHJ P,%SHWND + ASH A,10. ; TO PAGES + MOVEM A,WNDBOT ; UPDATE POINTERS + ADDI A,2000 + MOVEM A,WNDTOP + POP P,B ; RESTORE B + JRST TRBL10 + + + + +; ALTERNATE ENTRY FOR VECTORS WHICH TAKES CARE OF SHRINKAGE + +TRBLKV: HRRZS A + SKIPE GCDFLG ; SKIP IF NOT IN DUMPER + JRST TRBLV2 + CAMGE A,GCSBOT ; SEE IF IN GC-SPACE + JRST FIXDOP +TRBLV2: PUSH P,A ; SAVE A + HLRZ 0,DOPSV2 + TRZ 0,400000 + HRRZ F,A + HLRE A,E ; GET SHRINKAGE + ADD 0,A ; MUNG LENGTH + SUB F,0 + ADDI F,1 ; F POINTS TO START OF VECTOR + SKIPGE -2(P) ; SEE IF SHRINKAGE + ADD 0,-2(P) ; IF SO COMPENSATE + JRST TRBLK2 ; CONTINUE + +; ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT TO SEND IN 0= # OF WORDS + +TRBLK3: PUSH P,A ; SAVE A + MOVE F,A + JRST TRBLK2 + +; FINAL ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT +; F==> START OF TRANSFER IN GCS 0= # OF WORDS + +TRBLKX: PUSH P,A ; SAVE A + JRST TRBLK2 ; SEND IT OUT + + +; OUTTP IS THE ROUTINE THAT TPMK USES TO SEND OUT ELEMENTS FOR THE SCAN +; -2(P) CONTAINS THE ADDR IN THE INF AND IT IS UPDATED +; A CONTAINS THE WORD TO BE SENT OUT + +OUTTP: AOS E,-2(P) ; INCREMENT PLACE + MOVSI 0,(MOVEM) ; INS FOR SMINF + SOJA E,SMINF + + +; ADWD PLACES ONE WORD IN THE INF +; E ==> INF C IS THE WORD + +ADWD: PUSH P,E ; SAVE AC'S + PUSH P,A + MOVE A,C ; GET WORD + MOVSI 0,(MOVEM) ; INS FOR SMINF + PUSHJ P,SMINF ; SMASH IT IN + POP P,A + POP P,E + POPJ P, ; EXIT + +; DOPOUT IS USED TO SEND OUT THE DOPE WORDS IN UNUSUAL CALSE +; SUCH AS THE TP AND GROWTH + + +DOPOUT: MOVE C,-1(A) + PUSHJ P,ADWD + ADDI E,1 + MOVE C,(A) ; GET SECOND DOPE WORD + TLZ C,400000 ; TURN OFF POSSIBLE MARK BIT + PUSHJ P,ADWD + MOVE C,DOPSV1 ; FIX UP FIRST DOPE WORD + MOVEM C,-1(A) + MOVE C,DOPSV2 + MOVEM C,(A) ; RESTORE SECOND D.W. + POPJ P, + +; DOPMOD MODIFIES THE DOPE WORD OF A VECTOR AND PLACES A NEW DOPE-WORD IN INF +; A ==> DOPE WORD E==> INF + +DOPMOD: SKIPE GCDFLG ; CHECK TO SEE IF IN DUMPER AND PURIFY + JRST .+3 + CAMG A,GCSBOT + POPJ P, ; EXIT IF NOT IN GCS + MOVE C,-1(A) ; GET FIRST DOPE WORD + MOVEM C,DOPSV1 + HLLZS C ; CLEAR OUT GROWTH + TLO C,.VECT. ; FIX UP FOR GCHACK + PUSH P,C + MOVE C,(A) ; GET SECOND DOPE WORD + HLRZ B,(A) ; GET LENGTH + TRZ B,400000 ; TURN OFF MARK BIT + MOVEM C,DOPSV2 + HRRZ 0,-1(A) ; CHECK FOR GROWTH + JUMPE 0,DOPMD1 + LDB 0,[111100,,-1(A)] ; MODIFY WITH GROWTH + TRZE 0,400 + MOVNS 0 + ASH 0,6 + ADD B,0 + LDB 0,[001100,,-1(A)] + TRZE 0,400 + MOVNS 0 + ASH 0,6 + ADD B,0 +DOPMD1: HRL C,B ; FIX IT UP + MOVEM C,(A) ; FIX IT UP + POP P,-1(A) + POPJ P, + +ADPMOD: CAMG A,GCSBOT + POPJ P, ; EXIT IF NOT IN GCS + MOVE C,-1(A) ; GET FIRST DOPE WORD + TLO C,.VECT. ; FIX UP FOR GCHACK + MOVEM C,-1(A) + MOVE C,(A) ; GET SECOND DOPE WORD + TLZ C,400000 ; TURN OFF PARK BIT + MOVEM C,(A) + POPJ P, + + + + + ; RELATE RELATAVIZES A POINTER TO A VECTOR +; B IS THE POINTER A==> DOPE WORD + +RELATE: SKIPE GCDFLG ; SEE IF DUMPER OR PURIFIER + JRST .+3 + CAMGE A,GCSBOT ; SEE IF IN VECTOR SPACE + POPJ P, ; IF NOT EXIT + MOVE C,-1(P) + HLRE F,C ; GET LENGTH + HRRZ 0,-1(A) ; CHECK FO GROWTH + JUMPE A,RELAT1 + LDB 0,[111100,,-1(A)] ; GET TOP GROWTH + TRZE 0,400 ; HACK SIGN BIT + MOVNS 0 + ASH 0,6 ; CONVERT TO WORDS + SUB F,0 ; ACCOUNT FOR GROWTH +RELAT1: HRLM F,C ; PLACE CORRECTED LENGTH BACK IN POINTER + HRRZ F,(A) ; GET RELOCATED ADDR + SUBI F,(A) ; FIND RELATIVIZATION AMOUNT + ADD C,F ; ADJUST POINTER + SUB C,0 ; ACCOUNT FOR GROWTH + MOVEM C,-1(P) + POPJ P, + + + + ; MARK TB POINTERS +TBMK: HRRZS A ; CHECK FOR NIL POINTER + SKIPN A + JRST GCRET ; IF POINTING TO NIL THEN RETURN + HLRE B,TPSAV(A) ; MAKE POINTER LOOK LIKE A TP POINTER + HRRZ C,TPSAV(A) ; GET TO DOPE WORD +TBMK2: SUB C,B ; POINT TO FIRST DOPE WORD + HRRZ A,(P) ; GET PTR TO FRAME + SUB A,C ; GET PTR TO FRAME + HRLS A + HRR A,(P) + PUSH P,A + MOVEI C,-1(P) + MOVEI B,TTP + PUSHJ P,MARK + SUB P,[1,,1] + HRRM A,(P) + JRST GCRET +ABMK: HLRE B,A ; FIX UP TO GET TO FRAME + SUB A,B + HLRE B,FRAMLN+TPSAV(A) ; FIX UP TO LOOK LIKE TP + HRRZ C,FRAMLN+TPSAV(A) + JRST TBMK2 + + + +; MARK ARG POINTERS + +ARGMK: HRRZ A,1(C) ; GET POINTER + HLRE B,1(C) ; AND LNTH + SUB A,B ; POINT TO BASE + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST ARGMK0 + HLRZ 0,(A) ; GET TYPE + ANDI 0,TYPMSK + CAIN 0,TCBLK + JRST ARGMK1 + CAIE 0,TENTRY ; IS NEXT A WINNER? + CAIN 0,TINFO + JRST ARGMK1 ; YES, GO ON TO WIN CODE + +ARGMK0: SETZB A,1(C) ; CLOBBER THE CELL + SETZM (P) ; AND SAVED COPY + JRST GCRET + +ARGMK1: MOVE B,1(A) ; ASSUME TTB + ADDI B,(A) ; POINT TO FRAME + CAIE 0,TINFO ; IS IT? + MOVEI B,FRAMLN(A) ; NO, USE OTHER GOODIE + HLRZ 0,OTBSAV(B) ; GET TIME + HRRZ A,(C) ; AND FROM POINTER + CAIE 0,(A) ; SKIP IF WINNER + JRST ARGMK0 + MOVE A,TPSAV(B) ; GET A RELATAVIZED TP + HRROI C,TPSAV-1(B) + MOVEI B,TTP + PUSHJ P,MARK1 + SUB A,1(C) ; AMOUNT TO RELATAVIZE ARGS + HRRZ B,(P) + ADD B,A + HRRM B,(P) ; PUT RELATAVIZED PTR BACK + JRST GCRET + + +; MARK FRAME POINTERS + +FRMK: HLRZ B,A ; GET TIME FROM FRAME PTR + HLRZ F,OTBSAV(A) ; GET TIME FROM FRAME + CAME B,F ; SEE IF EQUAL + JRST GCRET + SUBI C,1 ;PREPARE TO MARK PROCESS VECTOR + HRRZ A,1(C) ;USE AS DATUM + SUBI A,1 ;FUDGE FOR VECTMK + MOVEI B,TPVP ;IT IS A VECTRO + PUSHJ P,MARK ;MARK IT + ADDI A,1 ; READJUST PTR + HRRM A,1(C) ; FIX UP PROCESS SLOT + MOVEI C,1(C) ; SET UP FOR TBMK + HRRZ A,(P) + JRST TBMK ; MARK LIKE TB + + +; MARK BYTE POINTER + +BYTMK: PUSHJ P,BYTDOP ; GET DOPE WORD IN A + HLRZ F,-1(A) ; GET THE TYPE + ANDI F,SATMSK ; FLUSH MONITOR BITS + CAIN F,SATOM ; SEE IF ATOM + JRST ATMSET + HLRE F,(A) ; GET MARKING + JUMPL F,BYTREL ; JUMP IF MARKED + HLRZ F,(A) ; GET LENGTH + PUSHJ P,ALLOGC ; ALLOCATE FOR IT + HRRM 0,(A) ; SMASH IT IN + MOVE E,0 + HLRZ F,(A) + SUBI E,-1(F) ; ADJUST INF POINTER + IORM D,(A) + PUSHJ P,ADPMOD + PUSHJ P,TRBLK +BYTREL: HRRZ E,(A) + SUBI E,(A) + ADDM E,(P) ; RELATAVIZE + JRST GCRET + +ATMSET: PUSH P,A ; SAVE A + HLRZ B,(A) ; GET LENGTH + TRZ B,400000 ; GET RID OF MARK BIT + MOVNI B,-2(B) ; GET LENGTH + ADDI A,-1(B) ; CALCULATE POINTER + HRLI A,(B) + MOVEI B,TATOM ; TYPE + PUSHJ P,MARK + POP P,A ; RESTORE A + SKIPN GCDFLG + JRST BYTREL + MOVSI E,STATM ; GET "STRING IS ATOM BIT" + IORM E,(P) + SKIPN DUMFLG + JRST GCRET + HRRM A,(P) + JRST BYTREL ; TO BYTREL + + +; MARK OFFSET + +OFFSMK: HLRZS A + PUSH P,$TLIST + PUSH P,A ; PUSH LIST POINTER ON THE STACK + MOVEI C,-1(P) ; POINTER TO PAIR + PUSHJ P,MARK2 ; MARK THE LIST + HRLM A,-2(P) ; UPDATE POINTER IN OFFSET + SUB P,[2,,2] + JRST GCRET + + +; MARK ATOMS IN GVAL STACK + +GATOMK: HRRZ B,(C) ; POINT TO POSSIBLE GDECL + JUMPE B,ATOMK + CAIN B,-1 + JRST ATOMK + MOVEI A,(B) ; POINT TO DECL FOR MARK + MOVEI B,TLIST + MOVEI C,0 + PUSHJ P,MARK + HLRZ C,-1(P) ; RESTORE HOME POINTER + HRRM A,(C) ; CLOBBER UPDATED LIST IN + MOVE A,1(C) ; RESTORE ATOM POINTER + +; MARK ATOMS + +ATOMK: + MOVEI 0,@BOTNEW + PUSH P,0 ; SAVE POINTER TO INF + TLO TYPNT,.ATOM. ; SAY ATOM WAS MARKED + MOVEI C,1(A) + PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS + JRST ATMRL1 ; ALREADY MARKED + PUSH P,A ; SAVE DOPE WORD PTR FOR LATER + HLRZ C,(A) ; FIND REAL ATOM PNTR + SUBI C,400001 ; KILL MARK BIT AND ADJUST + HRLI C,-1(C) + SUBM A,C ; NOW TOP OF ATOM +MRKOBL: MOVEI B,TOBLS + HRRZ A,2(C) ; IF > 0, NOT OBL + CAMG A,VECBOT + JRST .+3 + HRLI A,-1 + PUSHJ P,MARK ; AND MARK IT + HRRM A,2(C) + SKIPN GCHAIR + JRST NOMKNX + HLRZ A,2(C) + MOVEI B,TATOM + PUSHJ P,MARK + HRLM A,2(C) +NOMKNX: HLRZ B,(C) ; SEE IF UNBOUND + TRZ B,400000 ; TURN OFF MARK BIT + SKIPE B + CAIN B,TUNBOUND + JRST ATOMK1 ; IT IS UNBOUND + HRRZ 0,(C) ; SEE IF VECTOR OR TP POINTER + MOVEI B,TVEC ; ASSUME VECTOR + SKIPE 0 + MOVEI B,TTP ; ITS A LOCAL VALUE + PUSHJ P,MARK1 ; MARK IT + MOVEM A,1(C) ; SMASH INTO SLOT +ATOMK1: HRRZ 0,2(C) ; MAKE SURE ATOMS NOT ON OBLISTS GET SENT + POP P,A ; RESTORE A + POP P,E ; GET POINTER INTO INF + SKIPN GCHAIR + JUMPN 0,ATMREL + PUSHJ P,ADPMOD + PUSHJ P,TRBLK +ATMREL: HRRZ E,(A) ; RELATAVIZE + SUBI E,(A) + ADDM E,(P) + JRST GCRET +ATMRL1: SUB P,[1,,1] ; POP OFF STACK + JRST ATMREL + + +GETLNT: HLRE B,A ;GET -LNTH + SUB A,B ;POINT TO 1ST DOPE WORD + MOVEI A,1(A) ;POINT TO 2ND DOPE WORD + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST VECTB1 ;BAD VECTOR, COMPLAIN + HLRE B,(A) ;GET LENGTH AND MARKING + IORM D,(A) ;MAKE SURE MARKED + JUMPL B,AMTKE + MOVEI F,(B) ; AMOUNT TO ALLOCATE + PUSHJ P,ALLOGC ;ALLOCATE ROOM + HRRM 0,(A) ; RELATIVIZE +AMTK1: AOS (P) ; A NON MARKED ITEM +AMTKE: POPJ P, ;AND RETURN + +GCRET1: SUB P,[1,,1] ;FLUSH RETURN ADDRESS + JRST GCRET + + + +; MARK NON-GENERAL VECTORS + +NOTGEN: CAMN B,[GENERAL+] + JRST GENRAL ;YES, MARK AS A VECTOR + JUMPL B,SPECLS ; COMPLAIN IF A SPECIAL HACK + SUBI A,1(E) ;POINT TO TOP OF A UNIFORM VECTOR + HLRZS B ;ISOLATE TYPE + ANDI B,TYPMSK + PUSH P,E + SKIPE DUMFLG ; SKIP IF NOT IN DUMPER + PUSHJ P,TYPHK ; HACK WITH TYPE IF SPECIAL + POP P,E ; RESTORE LENGTH + MOVE F,B ; AND COPY IT + LSH B,1 ;FIND OUT WHERE IT WILL GO + HRRZ B,@TYPNT ;GET SAT IN B + ANDI B,SATMSK + MOVEI C,@MKTBS(B) ;POINT TO MARK SR + CAIN C,GCRET ;IF NOT A MARKED FROM GOODIE, IGNORE + JRST UMOVEC + MOVEI C,-1(A) ;POINT 1 PRIOR TO VECTOR START + PUSH P,E ;SAVE NUMBER OF ELEMENTS + PUSH P,F ;AND UNIFORM TYPE + +UNLOOP: MOVE B,(P) ;GET TYPE + MOVE A,1(C) ;AND GOODIE + TLO C,400000 ;CAN'T MUNG TYPE + PUSHJ P,MARK ;MARK THIS ONE + MOVEM A,1(C) ; LIST FIXUP + SOSE -1(P) ;COUNT + AOJA C,UNLOOP ;IF MORE, DO NEXT + + SUB P,[2,,2] ;REMOVE STACK CRAP + JRST UMOVEC + + +SPECLS: FATAL AGC--UNRECOGNIZED SPECIAL VECTOR + SUB P,[4,,4] ; REOVER + JRST AFIXUP + + + +; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS +; AND UPDATES PTR TO THE TABLE. + +GCRDMK: PUSH P,A ; SAVE PTR TO TOP + MOVEI 0,@BOTNEW ; SAVE PTR TO INF + PUSH P,0 + PUSHJ P,GETLNT ; GET TO D.W. AND CHECK MARKING + JRST GCRDRL ; RELATIVIZE + PUSH P,A ; SAVE D.W POINTER + SUBI A,2 + MOVE B,ABOTN ; GET TOP OF ATOM TABLE + HRRZ 0,-2(P) + ADD B,0 ; GET BOTTOM OF ATOM TABLE +GCRD1: CAMG A,B ; DON'T SKIP IF DONE + JRST GCRD2 + HLRZ C,(A) ; GET MARKING + TRZN C,400000 ; SKIP IF MARKED + JRST GCRD3 + MOVEI E,(A) + SUBI A,(C) ; GO BACK ONE ATOM + PUSH P,B ; SAVE B + PUSH P,A ; SAVE POINTER + MOVEI C,-2(E) ; SET UP POINTER + MOVEI B,TATOM ; GO TO MARK + MOVE A,1(C) + PUSHJ P,MARK + MOVEM A,1(C) ; SMASH FIXED UP ATOM BACK IN + POP P,A + POP P,B + JRST GCRD1 +GCRD3: SUBI A,(C) ; TO NEXT ATOM + JRST GCRD1 +GCRD2: POP P,A ; GET PTR TO D.W. + POP P,E ; GET PTR TO INF + SUB P,[1,,1] ; GET RID OF TOP + PUSHJ P,ADPMOD ; FIX UP D.W. + PUSHJ P,TRBLK ; SEND IT OUT + JRST ATMREL ; RELATIVIZE AND LEAVE +GCRDRL: POP P,A ; GET PTR TO D.W + SUB P,[2,,2] ; GET RID OF TOP AND PTR TO INF + JRST ATMREL ; RELATAVIZE + + + +;MARK RELATAVIZED GLOC HACKS + +LOCRMK: SKIPE GCHAIR + JRST GCRET +LOCRDP: PUSH P,C ; SAVE C + MOVEI C,-2(A) ; RELATAVIZED PTR TO ATOM + ADD C,GLTOP ; ADD GLOTOP TO GET TO ATOM + MOVEI B,TATOM ; ITS AN ATOM + SKIPL (C) + PUSHJ P,MARK1 + POP P,C ; RESTORE C + SKIPN DUMFLG ; IF GC-DUMP, WILL STORE ATOM FOR LOCR + JRST LOCRDD + MOVEI B,1 + IORM B,3(A) ; MUNG ATOM TO SAY IT IS LOCR + CAIA +LOCRDD: MOVE A,1(C) ; GET RELATIVIZATION + MOVEM A,(P) ; IT STAYS THE SAVE + JRST GCRET + +;MARK LOCID TYPE GOODIES + +LOCMK: HRRZ B,(C) ;GET TIME + JUMPE B,LOCMK1 ; SKIP LEGAL CHECK FOR GLOBAL + HRRZ 0,2(A) ; GET OTHER TIME + CAIE 0,(B) ; SAME? + SETZB A,(P) ; NO, SMASH LOCATIVE + JUMPE A,GCRET ; LEAVE IF DONE +LOCMK1: PUSH P,C + MOVEI B,TATOM ; MARK ATOM + MOVEI C,-2(A) ; POINT TO ATOM + MOVE E,(C) ; SEE IF BLOCK IS MARKED + TLNE E,400000 ; SKIP IF MARKED + JRST LOCMK2 ; SKIP OVER BLOCK + SKIPN GCHAIR ; DO NOT MARK IF NOT HAIRY (WILL BE MARKED) + PUSHJ P,MARK1 ; LET LOCATIVE SAVE THE ATOM +LOCMK2: POP P,C + HRRZ E,(C) ; TIME BACK + MOVEI B,TVEC ; ASSUME GLOBAL + SKIPE E + MOVEI B,TTP ; ITS LOCAL + PUSHJ P,MARK1 ; MARK IT + MOVEM A,(P) + JRST GCRET + + +; MARK ASSOCIATION BLOCKS + +ASMRK: PUSH P,A +ASMRK1: HRLI A,-ASOLNT ;LOOK LIKE A VECTOR POINTER + PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS + JRST ASTREL ; ALREADY MARKED + MOVEI C,-ASOLNT-1(A) ;COPY POINTER + PUSHJ P,MARK2 ;MARK ITEM CELL + MOVEM A,1(C) + ADDI C,INDIC-ITEM ;POINT TO INDICATOR + PUSHJ P,MARK2 + MOVEM A,1(C) + ADDI C,VAL-INDIC + PUSHJ P,MARK2 + MOVEM A,1(C) + SKIPN GCHAIR ; IF NO HAIR, MARK ALL FRIENDS + JRST ASTREL + HRRZ A,NODPNT-VAL(C) ; NEXT + JUMPN A,ASMRK1 ; IF EXISTS, GO +ASTREL: POP P,A ; RESTORE PTR TO ASSOCIATION + MOVEI A,ASOLNT+1(A) ; POINT TO D.W. + SKIPN NODPNT-ASOLNT-1(A) ; SEE IF EMPTY NODPTR + JRST ASTX ; JUMP TO SEND OUT +ASTR1: HRRZ E,(A) ; RELATAVIZE + SUBI E,(A) + ADDM E,(P) + JRST GCRET ; EXIT +ASTX: HRRZ E,(A) ; GET PTR IN FRONTEIR + SUBI E,ASOLNT+1 ; ADJUST TO POINT TO BEGINNING + PUSHJ P,ADPMOD + PUSHJ P,TRBLK + JRST ASTR1 + +;HERE WHEN A VECTOR POINTER IS BAD + +VECTB1:FATAL AGC--VECTOR POINTS OUTSIDE OF VECTOR SPACE + SUB P,[1,,1] ; RECOVERY +AFIXUP: SETZM (P) ; CLOBBER SLOT + JRST GCRET ; CONTINUE + + +VECTB2: FATAL AGC--VECTOR POINTS OUT OF VECTOR SPACE + SUB P,[2,,2] + JRST AFIXUP ; RECOVER + +PARERR: FATAL AGC--PAIR POINTS OUT OF PAIR SPACE + SUB P,[1,,1] ; RECOVER + JRST AFIXUP + + + ; HERE TO MARK TEMPLATE DATA STRUCTURES + +TD.MRK: MOVEI 0,@BOTNEW ; SAVE PTR TO INF + PUSH P,0 + HLRZ B,(A) ; GET REAL SPEC TYPE + ANDI B,37777 ; KILL SIGN BIT + MOVEI E,-NUMSAT-1(B) ; GET REL POINTER TO TABLE + HRLI E,(E) + ADD E,TD.AGC+1 + HRRZS C,A ; FLUSH COUNT AND SAVE + SKIPL E ; WITHIN BOUNDS + FATAL BAD SAT IN AGC + PUSHJ P,GETLNT ; GOODIE IS NOW MARKED + JRST TMPREL ; ALREADY MARKED + + SKIPE (E) + JRST USRAGC + SUB E,TD.AGC+1 ; POINT TO LENGTH + ADD E,TD.LNT+1 + XCT (E) ; RET # OF ELEMENTS IN B + + HLRZ D,B ; GET POSSIBLE "BASIC LENGTH" FOR RESTS + PUSH P,[0] ; TEMP USED IF RESTS EXIST + PUSH P,D + MOVEI B,(B) ; ZAP TO ONLY LENGTH + PUSH P,C ; SAVE POINTER TO TEMPLATE STRUCTURE + PUSH P,[0] ; HOME FOR VALUES + PUSH P,[0] ; SLOT FOR TEMP + PUSH P,B ; SAVE + SUB E,TD.LNT+1 + PUSH P,E ; SAVE FOR FINDING OTHER TABLES + JUMPE D,TD.MR2 ; NO REPEATING SEQ + ADD E,TD.GET+1 ; COMP LNTH OF REPEATING SEQ + HLRE E,(E) ; E ==> - LNTH OF TEMPLATE + ADDI E,(D) ; E ==> -LENGTH OF REP SEQ + MOVNS E + HRLM E,-5(P) ; SAVE IT AND BASIC + +TD.MR2: SKIPG D,-1(P) ; ANY LEFT? + JRST TD.MR1 + + MOVE E,TD.GET+1 + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + MOVEM D,-6(P) ; SAVE ELMENT # + SKIPN B,-5(P) ; SKIP IF "RESTS" EXIST + SOJA D,TD.MR3 + + MOVEI 0,(B) ; BASIC LNT TO 0 + SUBI 0,(D) ; SEE IF PAST BASIC + JUMPGE 0,.-3 ; JUMP IF O.K. + MOVSS B ; REP LNT TO RH, BASIC TO LH + IDIVI 0,(B) ; A==> -WHICH REPEATER + MOVNS A + ADD A,-5(P) ; PLUS BASIC + ADDI A,1 ; AND FUDGE + MOVEM A,-6(P) ; SAVE FOR PUTTER + ADDI E,-1(A) ; POINT + SOJA D,.+2 + +TD.MR3: ADDI E,(D) ; POINT TO SLOT + XCT (E) ; GET THIS ELEMENT INTO A AND B + JFCL ; NO-OP FOR ANY CASE + MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT + MOVEM B,-2(P) + EXCH A,B ; REARRANGE + GETYP B,B + MOVEI C,-3(P) ; TELL OTHER GUYS THEY CANT DIRECTLY MUNG + MOVSI D,400000 ; RESET FOR MARK + PUSHJ P,MARK ; AND MARK THIS GUY (RET FIXED POINTER IN A) + MOVE C,-4(P) ; REGOBBLE POINTER TO TEMPLATE + MOVE E,TD.PUT+1 + MOVE B,-6(P) ; RESTORE COUNT + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + ADDI E,(B)-1 ; POINT TO SLOT + MOVE B,-3(P) ; RESTORE TYPE WORD + EXCH A,B + SOS D,-1(P) ; GET ELEMENT # + XCT (E) ; SMASH IT BACK + FATAL TEMPLATE LOSSAGE + MOVE C,-4(P) ; RESTORE POINTER IN CASE MUNGED + JRST TD.MR2 + +TD.MR1: MOVE A,-8(P) ; PTR TO DOPE WORD + MOVE E,-7(P) ; RESTORE PTR TO FRONTEIR + SUB P,[7,,7] ; CLEAN UP STACK +USRAG1: ADDI A,1 ; POINT TO SECOND D.W. + MOVSI D,400000 ; SET UP MARK BIT + PUSHJ P,ADPMOD + PUSHJ P,TRBLK ; SEND IT OUT +TMPREL: SUB P,[1,,1] + HRRZ D,(A) + SUBI D,(A) + ADDM D,(P) + MOVSI D,400000 ; RESTORE MARK/UNMARK BIT + JRST GCRET + +USRAGC: HRRZ E,(E) ; MARK THE TEMPLATE + PUSHJ P,(E) + MOVE A,-1(P) ; POINTER TO D.W + MOVE E,(P) ; TOINTER TO FRONTIER + JRST USRAG1 + +; This phase attempts to remove any unwanted associations. The program +; loops through the structure marking values of associations. It can only +; stop when no new values (potential items and/or indicators) are marked. + +VALFLS: PUSH P,LPVP ; SAVE LPVP FOR LATER + PUSH P,[0] ; INDICATE WHETHER ANY ON THIS PASS + PUSH P,[0] ; OR THIS BUCKET +ASOMK1: MOVE A,GCASOV ; GET VECTOR POINTER + SETOM -1(P) ; INITIALIZE FLAG + +ASOM6: SKIPG C,(A) ; SKIP IF BUCKET TO BE SCANNED + JRST ASOM1 + SETOM (P) ; SAY BUCKET NOT CHANGED + +ASOM2: MOVEI F,(C) ; COPY POINTER + SKIPG ASOLNT+1(C) ; SKIP IF NOT ALREADY MARKED + JRST ASOM4 ; MARKED, GO ON + PUSHJ P,MARKQ ; SEE IF ITEM IS MARKED + JRST ASOM3 ; IT IS NOT, IGNORE IT + MOVEI F,(C) ; IN CASE CLOBBERED BY MARK2 + MOVEI C,INDIC(C) ; POINT TO INDICATOR SLOT + PUSHJ P,MARKQ + JRST ASOM3 ; NOT MARKED + + PUSH P,A ; HERE TO MARK VALUE + PUSH P,F + HLRE F,ASOLNT-INDIC+1(C) ; GET LENGTH + JUMPL F,.+3 ; SKIP IF MARKED + CAMGE C,VECBOT ; SKIP IF IN VECT SPACE + JRST ASOM20 + HRRM FPTR,ASOLNT-INDIC+1(C) ; PUT IN RELATIVISATION + MOVEI F,12 ; AMOUNT TO ALLOCATE IN INF + PUSHJ P,ALLOGC + HRRM 0,5(C) ; STICK IN RELOCATION + +ASOM20: PUSHJ P,MARK2 ; AND MARK + MOVEM A,1(C) ; LIST FIX UP + ADDI C,ITEM-INDIC ; POINT TO ITEM + PUSHJ P,MARK2 + MOVEM A,1(C) + ADDI C,VAL-ITEM ; POINT TO VALUE + PUSHJ P,MARK2 + MOVEM A,1(C) + IORM D,ASOLNT-VAL+1(C) ; MARK ASOC BLOCK + POP P,F + POP P,A + AOSA -1(P) ; INDICATE A MARK TOOK PLACE + +ASOM3: AOS (P) ; INDICATE AN UNMARKED IN THIS BUCKET +ASOM4: HRRZ C,ASOLNT-1(F) ; POINT TO NEXT IN BUCKET + JUMPN C,ASOM2 ; IF NOT EMPTY, CONTINUE + SKIPGE (P) ; SKIP IF ANY NOT MARKED + HRROS (A) ; MARK BUCKET AS NOT INTERESTING +ASOM1: AOBJN A,ASOM6 ; GO TO NEXT BUCKET + TLZE TYPNT,.ATOM. ; ANY ATOMS MARKED? + JRST VALFLA ; YES, CHECK VALUES +VALFL8: + +; NOW SEE WHICH CHANNELS STILL POINTED TO + +CHNFL3: MOVEI 0,N.CHNS-1 + MOVEI A,CHNL1 ; SLOTS + HRLI A,TCHAN ; TYPE HERE TOO + +CHNFL2: SKIPN B,1(A) + JRST CHNFL1 + HLRE C,B + SUBI B,(C) ; POINT TO DOPE + HLLM A,(A) ; PUT TYPE BACK + HRRE F,(A) ; SEE IF ALREADY MARKED + JUMPN F,CHNFL1 + SKIPGE 1(B) + JRST CHNFL8 + HLLOS (A) ; MARK AS A LOSER + SETZM -1(P) + JRST CHNFL1 +CHNFL8: MOVEI F,1 ; MARK A GOOD CHANNEL + HRRM F,(A) +CHNFL1: ADDI A,2 + SOJG 0,CHNFL2 + + SKIPE GCHAIR ; IF NOT HAIRY CASE + POPJ P, ; LEAVE + + SKIPL -1(P) ; SKIP IF NOTHING NEW MARKED + JRST ASOMK1 + + SUB P,[2,,2] ; REMOVE FLAGS + + + +; HERE TO REEMOVE UNUSED ASSOCIATIONS + + MOVE A,GCASOV ; GET ASOVEC BACK FOR FLUSHES + +ASOFL1: SKIPN C,(A) ; SKIP IF BUCKET NOT EMPTY + JRST ASOFL2 ; EMPTY BUCKET, IGNORE + HRRZS (A) ; UNDO DAMAGE OF BEFORE + +ASOFL5: SKIPGE ASOLNT+1(C) ; SKIP IF UNMARKED + JRST ASOFL6 ; MARKED, DONT FLUSH + + HRRZ B,ASOLNT-1(C) ; GET FORWARD POINTER + HLRZ E,ASOLNT-1(C) ; AND BACK POINTER + JUMPN E,ASOFL4 ; JUMP IF NO BACK POINTER (FIRST IN BUCKET) + HRRZM B,(A) ; FIX BUCKET + JRST .+2 + +ASOFL4: HRRM B,ASOLNT-1(E) ; FIX UP PREVIOUS + JUMPE B,.+2 ; JUMP IF NO NEXT POINTER + HRLM E,ASOLNT-1(B) ; FIX NEXT'S BACK POINTER + HRRZ B,NODPNT(C) ; SPLICE OUT THRAD + HLRZ E,NODPNT(C) + SKIPE E + HRRM B,NODPNT(E) + SKIPE B + HRLM E,NODPNT(B) + +ASOFL3: HRRZ C,ASOLNT-1(C) ; GO TO NEXT + JUMPN C,ASOFL5 +ASOFL2: AOBJN A,ASOFL1 + + + +; NOW CLOBBER UNMARKED LOCAL NAD GLOBAL VALUES + + MOVE A,GCGBSP ; GET GLOBAL PDL + +GLOFLS: SKIPGE (A) ; SKIP IF NOT ALREADY MARKED + JRST SVDCL + MOVSI B,-3 + PUSHJ P,ZERSLT ; CLOBBER THE SLOT + HLLZS (A) +SVDCL: ANDCAM D,(A) ; UNMARK + ADD A,[4,,4] + JUMPL A,GLOFLS ; MORE?, KEEP LOOPING + + MOVEM LPVP,(P) +LOCFL1: HRRZ A,(LPVP) ; NOW CLOBBER LOCAL SLOTS + HRRZ C,2(LPVP) + MOVEI LPVP,(C) + JUMPE A,LOCFL2 ; NONE TO FLUSH + +LOCFLS: SKIPGE (A) ; MARKDE? + JRST .+3 + MOVSI B,-5 + PUSHJ P,ZERSLT + ANDCAM D,(A) ;UNMARK + HRRZ A,(A) ; GO ON + JUMPN A,LOCFLS +LOCFL2: JUMPN LPVP,LOCFL1 ; JUMP IF MORE PROCESS + +; AT THIS POINT THE LOCALS ARE FINALLY SENT OUT. +; THIS ROUTINE UPDATES THE THIS-PROCESS BINDING. IT FIXES UP THE SP-CHAIN AND IT +; SENDS OUT THE ATOMS. + +LOCFL3: MOVE C,(P) + MOVEI B,TATOM ; MARK THE BINDING TO THIS PROCESS + PUSHJ P,MARK1 ; MARK THE ATOM + MOVEM A,1(C) ; NEW HOME + MOVEI C,2(C) ; MARK VALUE + MOVEI B,TPVP ; IT IS A PROCESS VECTOR POINTER + PUSHJ P,MARK1 ; MARK IT + MOVEM A,1(C) + POP P,R +NEXPRO: MOVEI 0,TPVP ; FIX UP SLOT + HLRZ A,2(R) ; GET PTR TO NEXT PROCESS + HRLM 0,2(R) + HRRZ E,(A) ; ADRESS IN INF + HRRZ B,(A) ; CALCULATE RELOCATION + SUB B,A + PUSH P,B + HRRZ F,A ; CALCULATE START OF TP IN F + HLRZ B,(A) ; ADJUST INF PTR + TRZ B,400000 + SUBI F,-1(B) + LDB M,[111100,,-1(A)] ; CALCULATE TOP GROWTH + TRZE M,400 ; FUDGE SIGN + MOVNS M + ASH M,6 + ADD B,M ; FIX UP LENGTH + EXCH M,(P) + SUBM M,(P) ; FIX RELOCATION TO TAKE INTO ACCOUNT CHANGE IN LENGTH + MOVE M,R ; GET A COPY OF R +NEXP1: HRRZ C,(M) ; GET PTR TO NEXT IN CHAIN + JUMPE C,NEXP2 ; EXIT IF END OF CHAIN + MOVE 0,C ; GET COPY OF CHAIN PTR TO UPDATE + ADD 0,(P) ; UPDATE + HRRM 0,(M) ; PUT IN + MOVE M,C ; NEXT + JRST NEXP1 +NEXP2: SUB P,[1,,1] ; CLEAN UP STACK + SUBI E,-1(B) + HRRI B,(R) ; GET POINTER TO THIS-PROCESS BINDING + MOVEI B,6(B) ; POINT AFTER THE BINDING + MOVE 0,F ; CALCULATE # OF WORDS TO SEND OUT + SUBM B,0 + PUSH P,R ; PRESERVE R + PUSHJ P,TRBLKX ; SEND IT OUT + POP P,R ; RESTORE R + HRRZS R,2(R) ; GET THE NEXT PROCESS + SKIPN R + JRST .+3 + PUSH P,R + JRST LOCFL3 + MOVE A,GCGBSP ; PTR TO GLOBAL STACK + PUSHJ P,SPCOUT ; SEND IT OUT + MOVE A,GCASOV + PUSHJ P,SPCOUT ; SEND IT OUT + POPJ P, + +; THIS ROUTINE MARKS ALL THE CHANNELS +; IT THEN SENDS OUT A COPY OF THE TVP + +CHFIX: MOVEI 0,N.CHNS-1 + MOVEI A,CHNL1 ; SLOTS + HRLI A,TCHAN ; TYPE HERE TOO + +DHNFL2: SKIPN B,1(A) + JRST DHNFL1 + MOVEI C,(A) ; MARK THE CHANNEL + PUSH P,0 ; SAVE 0 + PUSH P,A ; SAVE A + PUSHJ P,MARK2 + MOVEM A,1(C) ; ADJUST PTR + POP P,A ; RESTORE A + POP P,0 ; RESTORE +DHNFL1: ADDI A,2 + SOJG 0,DHNFL2 + POPJ P, + + +; ROUTINE TO SEND OUT SPECIAL STUFF FROM GCHAIR + +SPCOUT: HLRE B,A + SUB A,B + MOVEI A,1(A) ; POINT TO DOPE WORD + LDB 0,[001100,,-1(A)] ;GET GROWTH FACTOR + TRZE 0,400 ;KILL SIGN BIT AND SKIP IF + + MOVNS 0 ;NEGATE + ASH 0,6 ;CONVERT TO NUMBER OF WORDS + PUSHJ P,DOPMOD + HRRZ E,(A) ; GET PTR TO INF + HLRZ B,(A) ; LENGTH + TRZ B,400000 ; GET RID OF MARK BIT + SUBI E,-1(B) + ADD E,0 + PUSH P,0 ; DUMMY FOR TRBLKV + PUSHJ P,TRBLKV ; OUT IT GOES + SUB P,[1,,1] + POPJ P, ;RETURN + +ASOFL6: HLRZ E,ASOLNT-1(C) ; SEE IF FIRST IN BUCKET + JUMPN E,ASOFL3 ; IF NOT CONTINUE + HRRZ E,ASOLNT+1(C) ; GET PTR FROM DOPE WORD + SUBI E,ASOLNT+1 ; ADJUST TO POINT TO BEGINNING OF ALSSOCIATION + HRRZM E,(A) ; SMASH IT IN + JRST ASOFL3 + + +MARK23: PUSH P,A ; SAVE BUCKET POINTER + PUSH P,F + PUSHJ P,MARK2 + MOVEM A,1(C) + POP P,F + POP P,A + AOS -2(P) ; MARKING HAS OCCURRED + IORM D,ASOLNT+1(C) ; MARK IT + JRST MKD + + ; CHANNEL FLUSHER FOR NON HAIRY GC + +CHNFLS: PUSH P,[-1] + SETOM (P) ; RESET FOR RETRY + PUSHJ P,CHNFL3 + SKIPL (P) + JRST .-3 ; REDO + SUB P,[1,,1] + POPJ P, + +; VALUE FLUSHING PHASE, HACKS BOTTOM OF TP AND GLOBAL SP + +VALFLA: MOVE C,GCGBSP ; GET POINTER TO GLOBAL STACK +VALFL1: SKIPL (C) ; SKIP IF NOT MARKED + PUSHJ P,MARKQ ; SEE IF ATOM IS MARKED + JRST VALFL2 + PUSH P,C + MOVEI B,TATOM ; UPDATE ATOM SLOT + PUSHJ P,MARK1 + MOVEM A,1(C) + IORM D,(C) + AOS -2(P) ; INDICATE MARK OCCURRED + HRRZ B,(C) ; GET POSSIBLE GDECL + JUMPE B,VLFL10 ; NONE + CAIN B,-1 ; MAINFIFEST + JRST VLFL10 + MOVEI A,(B) + MOVEI B,TLIST + MOVEI C,0 + PUSHJ P,MARK ; MARK IT + MOVE C,(P) ; POINT + HRRM A,(C) ; CLOBBER UPDATE IN +VLFL10: ADD C,[2,,2] ; BUMP TO VALUE + PUSHJ P,MARK2 ; MARK VALUE + MOVEM A,1(C) + POP P,C +VALFL2: ADD C,[4,,4] + JUMPL C,VALFL1 ; JUMP IF MORE + + HRLM LPVP,(P) ; SAVE POINTER +VALFL7: MOVEI C,(LPVP) + MOVEI LPVP,0 +VALFL6: HRRM C,(P) + +VALFL5: HRRZ C,(C) ; CHAIN + JUMPE C,VALFL4 + MOVEI B,TATOM ; TREAT LIKE AN ATOM + SKIPL (C) ; MARKED? + PUSHJ P,MARKQ1 ; NO, SEE + JRST VALFL5 ; LOOP + AOS -1(P) ; MARK WILL OCCUR + MOVEI B,TATOM ; RELATAVIZE + PUSHJ P,MARK1 + MOVEM A,1(C) + IORM D,(C) + ADD C,[2,,2] ; POINT TO VALUE + PUSHJ P,MARK2 ; MARK VALUE + MOVEM A,1(C) + SUBI C,2 + JRST VALFL5 + +VALFL4: HRRZ C,(P) ; GET SAVED LPVP + MOVEI A,(C) + HRRZ C,2(C) ; POINT TO NEXT + JUMPN C,VALFL6 + JUMPE LPVP,VALFL9 + + HRRM LPVP,2(A) ; NEW PROCESS WAS MARKED + JRST VALFL7 + +ZERSLT: HRRI B,(A) ; COPY POINTER + SETZM 1(B) + AOBJN B,.-1 + POPJ P, + +VALFL9: HLRZ LPVP,(P) ; RESTORE CHAIN + JRST VALFL8 + + ;SUBROUTINE TO SEE IF A GOODIE IS MARKED +;RECEIVES POINTER IN C +;SKIPS IF MARKED NOT OTHERWISE + +MARKQ: HLRZ B,(C) ;TYPE TO B +MARKQ1: MOVE E,1(C) ;DATUM TO C + MOVEI 0,(E) + CAIL 0,@PURBOT ; DONT CHACK PURE + JRST MKD ; ALWAYS MARKED + ANDI B,TYPMSK ; FLUSH MONITORS + LSH B,1 + HRRZ B,@TYPNT ;GOBBLE SAT + ANDI B,SATMSK + CAIG B,NUMSAT ; SKIP FOR TEMPLATE + JRST @MQTBS(B) ;DISPATCH + ANDI E,-1 ; FLUSH REST HACKS + JRST VECMQ + + +MQTBS: + +OFFSET 0 + +DISTB2 DUM3,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ] +[STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SLOCID,LOCMQ] +[SATOM,ATMMQ],[SPVP,VECMQ],[SCHSTR,BYTMQ],[SLOCA,ARGMQ],[SLOCU,VECMQ] +[SLOCV,VECMQ],[SLOCS,BYTMQ],[SLOCN,ASMQ],[SASOC,ASMQ],[SLOCL,PAIRMQ],[SGATOM,ATMMQ] +[SBYTE,BYTMQ],[SLOCB,BYTMQ],[SDEFQ,PAIRMQ],[SOFFS,OFFSMQ]] + +OFFSET OFFS + +PAIRMQ: JUMPE E,MKD ; NIL ALWAYS MARKED + SKIPL (E) ; SKIP IF MARKED + POPJ P, +ARGMQ: +MKD: AOS (P) + POPJ P, + +BYTMQ: PUSH P,A ; SAVE A + PUSHJ P,BYTDOP ; GET PTR TO DOPE WORD + MOVE E,A ; COPY POINTER + POP P,A ; RESTORE A + SKIPGE (E) ; SKIP IF NOT MARKED + AOS (P) + POPJ P, ; EXIT + +FRMQ: HRRZ E,(C) ; POINT TO PV DOPE WORD + SOJA E,VECMQ1 + +ATMMQ: CAML 0,GCSBOT ; ALWAYS KEEP FROZEN ATOMS + JRST VECMQ + AOS (P) + POPJ P, + +VECMQ: HLRE 0,E ;GET LENGTH + SUB E,0 ;POINT TO DOPE WORDS + +VECMQ1: SKIPGE 1(E) ;SKIP IF NOT MARKED + AOS (P) ;MARKED, CAUSE SKIP RETURN + POPJ P, + +ASMQ: ADDI E,ASOLNT + JRST VECMQ1 + +LOCMQ: HRRZ 0,(C) ; GET TIME + JUMPE 0,VECMQ ; GLOBAL, LIKE VECTOR + HLRE 0,E ; FIND DOPE + SUB E,0 + MOVEI E,1(E) ; POINT TO LAST DOPE + CAMN E,TPGROW ; GROWING? + SOJA E,VECMQ1 ; YES, CHECK + ADDI E,PDLBUF ; FUDGE + MOVSI 0,-PDLBUF + ADDM 0,1(C) + SOJA E,VECMQ1 + +OFFSMQ: HLRZS E ; POINT TO LIST STRUCTURE + SKIPGE (E) ; MARKED? + AOS (P) ; YES + POPJ P, + + ; SUBROUTINE TO UPDATE ASSOCIATIONS AND MOVE THEM INTO THE INF + +ASSOUP: MOVE A,GCNOD ; RECOVER PTR TO START OF CHAIN +ASSOP1: HRRZ B,NODPNT(A) + PUSH P,B ; SAVE NEXT ON CHAIN + PUSH P,A ; SAVE IT + HRRZ B,ASOLNT-1(A) ;POINT TO NEXT + JUMPE B,ASOUP1 + HRRZ C,ASOLNT+1(B) ;AND GET ITS RELOC IN C + SUBI C,ASOLNT+1(B) ; RELATIVIZE + ADDM C,ASOLNT-1(A) ;C NOW HAS UPDATED POINTER +ASOUP1: HLRZ B,ASOLNT-1(A) ;GET PREV BLOCK POINTER + JUMPE B,ASOUP2 + HRRZ F,ASOLNT+1(B) ;AND ITS RELOCATION + SUBI F,ASOLNT+1(B) ; RELATIVIZE + MOVSI F,(F) + ADDM F,ASOLNT-1(A) ;RELOCATE +ASOUP2: HRRZ B,NODPNT(A) ;UPDATE NODE CHAIN + JUMPE B,ASOUP4 + HRRZ C,ASOLNT+1(B) ;GET RELOC + SUBI C,ASOLNT+1(B) ; RELATIVIZE + ADDM C,NODPNT(A) ;AND UPDATE +ASOUP4: HLRZ B,NODPNT(A) ;GET PREV POINTER + JUMPE B,ASOUP5 + HRRZ F,ASOLNT+1(B) ;RELOC + SUBI F,ASOLNT+1(B) + MOVSI F,(F) + ADDM F,NODPNT(A) +ASOUP5: POP P,A ; RECOVER PTR TO DOPE WORD + MOVEI A,ASOLNT+1(A) + MOVSI B,400000 ;UNMARK IT + XORM B,(A) + HRRZ E,(A) ; SET UP PTR TO INF + HLRZ B,(A) + SUBI E,-1(B) ; ADJUST PTR + PUSHJ P,ADPMOD + PUSHJ P,TRBLK ; OUT IT GOES + POP P,A ; RECOVER PTR TO ASSOCIATION + JUMPN A,ASSOP1 ; IF NOT ZERO CONTINUP + POPJ P, ; DONE + + +; HERE TO CLEAN UP ATOM HASH TABLE + +ATCLEA: MOVE A,GCHSHT ; GET TABLE POINTER + +ATCLE1: MOVEI B,0 + SKIPE C,(A) ; GET NEXT + JRST ATCLE2 ; GOT ONE + +ATCLE3: PUSHJ P,OUTATM + AOBJN A,ATCLE1 + + MOVE A,GCHSHT ; MOVE OUT TABLE + PUSHJ P,SPCOUT + POPJ P, + +; HAVE AN ATOM IN C + +ATCLE2: MOVEI B,0 + +ATCLE5: CAIL C,HIBOT + JRST ATCLE3 + CAMG C,VECBOT ; FROZEN ATOMS ALWAYS MARKED + JRST .+3 + SKIPL 1(C) ; SKIP IF ATOM MARKED + JRST ATCLE6 + + HRRZ 0,1(C) ; GET DESTINATION + CAIN 0,-1 ; FROZEN/MAGIC ATOM + MOVEI 0,1(C) ; USE CURRENT POSN + SUBI 0,1 ; POINT TO CORRECT DOPE + JUMPN B,ATCLE7 ; JUMP IF GOES INTO ATOM + + HRRZM 0,(A) ; INTO HASH TABLE + JRST ATCLE8 + +ATCLE7: HRLM 0,2(B) ; INTO PREV ATOM + PUSHJ P,OUTATM + +ATCLE8: HLRZ B,1(C) + ANDI B,377777 ; KILL MARK BIT + SUBI B,2 + HRLI B,(B) + SUBM C,B + HLRZ C,2(B) + JUMPE C,ATCLE3 ; DONE WITH BUCKET + JRST ATCLE5 + +; HERE TO PASS OVER LOST ATOM + +ATCLE6: HLRZ F,1(C) ; FIND NEXT ATOM + SUBI C,-2(F) + HLRZ C,2(C) + JUMPE B,ATCLE9 + HRLM C,2(B) + JRST .+2 +ATCLE9: HRRZM C,(A) + JUMPE C,ATCLE3 + JRST ATCLE5 + +OUTATM: JUMPE B,CPOPJ + PUSH P,A + PUSH P,C + HLRE A,B + SUBM B,A + MOVSI D,400000 ;UNMARK IT + XORM D,1(A) + HRRZ E,1(A) ; SET UP PTR TO INF + HLRZ B,1(A) + SUBI E,-1(B) ; ADJUST PTR + MOVEI A,1(A) + PUSHJ P,ADPMOD + PUSHJ P,TRBLK ; OUT IT GOES + POP P,C + POP P,A ; RECOVER PTR TO ASSOCIATION + POPJ P, + + +VCMLOS: FATAL AGC--VECTOR WITH ZERO IN DOPE WORD LENGTH + + +; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC + +MSGGCT: [ASCIZ /USER CALLED- /] + [ASCIZ /FREE STORAGE- /] + [ASCIZ /TP-STACK- /] + [ASCIZ /TOP-LEVEL LOCALS- /] + [ASCIZ /GLOBAL VALUES- /] + [ASCIZ /TYPES- /] + [ASCIZ /STATIONARY IMPURE STORAGE- /] + [ASCIZ /P-STACK /] + [ASCIZ /BOTH STACKS BLOWN- /] + [ASCIZ /PURE STORAGE- /] + [ASCIZ /GC-RCALL- /] + +; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC + +GCPAT: SPBLOK 100 +EGCPAT: -1 + +MSGGFT: [ASCIZ /GC-READ /] + [ASCIZ /BLOAT /] + [ASCIZ /GROW /] + [ASCIZ /LIST /] + [ASCIZ /VECTOR /] + [ASCIZ /SET /] + [ASCIZ /SETG /] + [ASCIZ /FREEZE /] + [ASCIZ /PURE-PAGE LOADER /] + [ASCIZ /GC /] + [ASCIZ /INTERRUPT-HANDLER /] + [ASCIZ /NEWTYPE /] + [ASCIZ /PURIFY /] + +.GLOBAL GCNO,BSTGC,BSTAT,NOWFRE,CURFRE,MAXFRE,USEFRE,NOWTP,CURTP,CTPMX,NOWLFL +.GLOBAL CURLVL,NOWGVL,CURGVL,NOWTYP,CURTYP,NOWSTO,CURSTO,CURMAX,NOWP,CURP,CPMX +.GLOBAL GCCAUS,GCCALL,LVLINC,GVLINC,TYPIC,STORIC,RCL,RCLV,GCDANG,GETNUM,RPTOP,CORTOP +.GLOBAL TPGROW,PPGROW,PGROW,PMAIN,PGOOD,PMAX,TPGOOD,TPMIN,TPMAX,RFRETP,TYPTAB +.GLOBAL NNPRI,NNSAT,TYPSAV,BUFGC,GCTIM,GPURFL,GCDFLG,DUMFLG +.GLOBAL TPBINC,GBLINC,TYPINC,CONADJ,OGCSTP,ABOTN,MAXLEN +.GLOBAL PURMIN,GCMONF,.LIST.,FPAG,PMIN,GLBINC,INCORF,PURCOR,GCHAIR + + +;LOCAL VARIABLES + +OFFSET 0 + +IMPURE +; LOCACTIONS USED BY THE PAGE HACKER + +DOPSV1: 0 ;SAVED FIRST D.W. +DOPSV2: 0 ; SAVED LENGTH + + +; LOCATIONS USED BY BLOAT-STAT TO HELP THE USER PICK BLOAT SPECIFICATIONS. +; + +GCNO: 0 ; USER-CALLED GC +BSTGC: 0 ; FREE STORAGE + 0 ; BLOWN TP + 0 ; TOP-LEVEL LVALS + 0 ; GVALS + 0 ; TYPE + 0 ; STORAGE + 0 ; P-STACK + 0 ; BOTH STATCKS BLOWN + 0 ; STORAGE + +BSTAT: +NOWFRE: 0 ; FREE STORAGE FROM LAST GC +CURFRE: 0 ; STORAGE USED SINCE LAST GC +MAXFRE: 0 ; MAXIMUM FREE STORAGE ALLOCATED +USEFRE: 0 ; TOTAL FREE STORAGE USED +NOWTP: 0 ; TP LENGTH FROM LAST GC +CURTP: 0 ; # WORDS ON TP +CTPMX: 0 ; MAXIMUM SIZE OF TP SO FAR +NOWLVL: 0 ; # OF TOP-LEVEL LVAL-SLOTS +CURLVL: 0 ; # OF TOP-LEVEL LVALS +NOWGVL: 0 ; # OF GVAL SLOTS +CURGVL: 0 ; # OF GVALS +NOWTYP: 0 ; SIZE OF TYPE-VECTOR +CURTYP: 0 ; # OF TYPES +NOWSTO: 0 ; SIZE OF STATIONARY STORAGE +CURSTO: 0 ; STATIONARY STORAGE IN USE +CURMAX: 0 ; MAXIMUM BLOCK OF CONTIGUOUS STORAGE +NOWP: 0 ; SIZE OF P-STACK +CURP: 0 ; #WORDS ON P +CPMX: 0 ; MAXIMUM P-STACK LENGTH SO FAR +GCCAUS: 0 ; INDICATOR FOR CAUSE OF GC +GCCALL: 0 ; INDICATOR FOR CALLER OF GC + + +; THIS GROUP OF VARIABLES DETERMINES HOW THINGS GROW +LVLINC: 6 ; LVAL INCREMENT ASSUMED TO BE 64 SLOTS +GVLINC: 4 ; GVAL INCREMENT ASSUMED TO BE 64 SLOTS +TYPIC: 1 ; TYPE INCREMENT ASSUMED TO BE 32 TYPES +STORIC: 2000 ; STORAGE INCREMENT USED BY NFREE (MINIMUM BLOCK-SIZE) + + +RCL: 0 ; POINTER TO LIST OF RECYCLEABLE LIST CELLS +RCLV: 0 ; POINTER TO RECYCLED VECTORS +GCMONF: 0 ; NON-ZERO SAY GIN/GOUT +GCDANG: 0 ; NON-ZERO, STORAGE IS LOW +INBLOT: 0 ; INDICATE THAT WE ARE RUNNING OIN A BLOAT +GETNUM: 0 ;NO OF WORDS TO GET +RFRETP: +RPTOP: 0 ;NO OF BLOCKS OF CORE, IF GIVING CORE AWAY +CORTOP: 0 ;CURRENT TOP OF CORE, EXCLUDING ANY TO BE GIVEN AWAY +NGCS: 8 ; NUMBER OF GARBAGE COLLECTS BETWEEN HAIRY GCS + +;VARIABLES WHICH DETERMIN WHEN MUDDLE WILL ASK FOR MORE CORE, +;AND WHEN IT WILL GET UNHAPPY + +FREMIN: 20000 ;MINIMUM FREE WORDS + +;POINTER TO GROWING PDL + +TPGROW: 0 ;POINTS TO A BLOWN TP +PPGROW: 0 ;POINTS TO A BLOWN PP +PGROW: 0 ;POINTS TO A BLOWN P + +;IN GC FLAG + +GCFLG: 0 +GCFLCH: 0 ; TELL INT HANDLER TO ITIC CHARS +GCHAIR: 1 ; COUNTS GCS AND TELLS WHEN TO HAIRIFY +GCDOWN: 0 ; AMOUNT TO TRY AND MOVE DOWN +CURPLN: 0 ; LENGTH OF CURRENTLY RUNNING PURE RSUBR +PURMIN: 0 ; MINIMUM PURE STORAGE + +; VARS ASSOCIATED WITH BLOAT LOGIC +PMIN: 200 ; MINIMUM FOR PSTACK +PGOOD: 1000 ; GOOD SIZE FOR PSTACK +PMAX: 4000 ; MAX SIZE FOR PSTACK +TPMIN: 1000 ; MINIMUM SIZE FOR TP +TPGOOD: NTPGOO ; GOOD SIZE OF TP +TPMAX: NTPMAX ; MAX SIZE OF TP + +TPBINC: 0 +GLBINC: 0 +TYPINC: 0 + +; VARS FOR PAGE WINDOW HACKS + +GCHSHT: 0 ; SAVED ATOM TABLE +PURSVT: 0 ; SAVED PURVEC TABLE +GLTOP: 0 ; SAVE GLOTOP +GCNOD: 0 ; PTR TO START OF ASSOCIATION CHAIN +GCGBSP: 0 ; SAVED GLOBAL SP +GCASOV: 0 ; SAVED PTR TO ASSOCIATION VECTOR +GCATM: 0 ; PTR TO IMQUOT THIS-PROCESS +FNTBOT: 0 ; BOTTOM OF FRONTEIR +WNDBOT: 0 ; BOTTOM OF WINDOW +WNDTOP: 0 +BOTNEW: (FPTR) ; POINTER TO FRONTIER +GCTIM: 0 +NPARBO: 0 ; SAVED PARBOT + +; FLAGS TO INDICATE DUMPER IS IN USE + +GPURFL: 0 ; INDICATE PURIFIER IS RUNNING +GCDFLG: 0 ; INDICATE EITHER GCDUMP OR PURIFIER IS RUNNING +DUMFLG: 0 ; FLAG INDICATING DUMPER IS RUNNING + +; CONSTANTS FOR DUMPER,READER AND PURIFYER + +ABOTN: 0 ; COUNTER FOR ATOMS +NABOTN: 0 ; POINTER USED BY PURIFY +OGCSTP: 0 ; CONTAINS OLD GCSTOP FOR READER +MAPUP: 0 ; BEGINNING OF MAPPED UP PURE STUFF +SAVRES: 0 ; SAVED UPDATED ITEM OF PURIFIER +SAVRE2: 0 ; SAVED TYPE WORD +SAVRS1: 0 ; SAVED PTR TO OBJECT +INF1: 0 ; AOBJN PTR USED IN CREATING PROTECTION INF +INF2: 0 ; AOBJN PTR USED IN CREATING SECOND INF +INF3: 0 ; AOBJN PTR USED TO PURIFY A STRUCTURE + +; VARIABLES USED BY GC INTERRUPT HANDLER + +GCHPN: 0 ; SET TO -1 EVERYTIME A GC HAS OCCURED +GCKNUM: 0 ; NUMBER OF WORDS OF REQUEST TO INTERRUPT + +; VARIABLE TO INDICATE WHETHER AGC HAS PUSHED THE MAPPING CHANNEL TO WIN + +PSHGCF: 0 + +; VARIABLES USED BY DUMPER AND READER TO HANDLE NEWTYPES + +TYPTAB: 0 ; POINTER TO TYPE TABLE +NNPRI: 0 ; NUMPRI FROM DUMPED OBJECT +NNSAT: 0 ; NUMSAT FROM DUMPED OBJECT +TYPSAV: 0 ; SAVE PTR TO TYPE VECTOR + +; VARIABLES USED BY GC-DUMP FOR COPY-WRITE MAPPING + +BUFGC: 0 ; BUFFER FOR COPY ON WRITE HACKING +PURMNG: 0 ; FLAG INDICATING IF A PURIFIED PAGE WAS MUNGED DURING GC-DUMP +RPURBT: 0 ; SAVED VALUE OF PURTOP +RGCSTP: 0 ; SAVED GCSTOP + +; VARIABLES USED TO DETERMINE WHERE THE GC-DUMPED STRUCTURE SHOULD GO + +INCORF: 0 ; INDICATION OF UVECTOR HACKS FOR GC-DUMP +PURCOR: 0 ; INDICATION OF UVECTOR TO PURE CORE + ; ARE NOT GENERATED + + +PLODR: 0 ; INDICATE A PLOAD IS IN OPERATION +NPRFLG: 0 + +; VARIABLE USED BY MARK SWEEP GARBAGE COLLECTOR + +MAXLEN: 0 ; MAXIMUM RECLAIMED SLOT + +PURE + +OFFSET OFFS + +CONSTANTS + +HERE + +CONSTANTS + +OFFSET 0 + +ZZ==$.+1777 + +.LOP ANDCM ZZ 1777 + +ZZ1==.LVAL1 + +LOC ZZ1 + + +OFFSET OFFS + +WIND: SPBLOK 2000 +FRONT: SPBLOK 2000 +MRKPD: SPBLOK 1777 +ENDPDL: -1 + +MRKPDL=MRKPD-1 + +ENDGC: + +OFFSET 0 + +.LOP WIND <,-10.> +WNDP==.LVAL1 + +.LOP FRONT <,-10.> +FRNP==.LVAL1 + +ZZ2==ENDGC-AGCLD +.LOP ZZ2 <,-10.> +LENGC==.LVAL1 + +.LOP LENGC <,10.> +RLENGC==.LVAL1 + +.LOP AGCLD <,-10.> +PAGEGC==.LVAL1 + +OFFSET 0 + +LOC GCST +.LPUR==$. + +END + diff --git a//agc.mid.141 b//agc.mid.141 new file mode 100644 index 0000000..a0f2684 --- /dev/null +++ b//agc.mid.141 @@ -0,0 +1,3634 @@ +TITLE AGC MUDDLE GARBAGE COLLECTOR + +;SYSTEM WIDE DEFINITIONS GO HERE + +RELOCATABLE +GCST==$. + + +.GLOBAL RCL,VECTOP,GCSTOP,GCSBOT,FRETOP,GCSNEW,VECBOT,PARTOP,PARBOT,HITOP,HIBOT,GETPAG +.GLOBAL PDLBUF,PDLEX,PDLEXP,GCFLG,GCPDL,GETNUM,PARNEW,MOVPUR,RCLV,RCLVEC,PGCNT +.GLOBAL PGROW,TPGROW,MAINPR,MSGTYP,PURTOP,PURBOT,STOSTR,GCSET,CKPUR +.GLOBAL MTYI,UPLO,FRMUNG,BYTDOP,GLOBSP,FREDIF,FREMIN,GCHAPN,INTFLG,FINAGC,NGCS,INQAGC +.GLOBAL SAT,TTOCHN,TYPVEC,ICONS,INCONS,IBLOCK,IEUVEC,IEVECTI,CELL2,MKTBS,RLENGC +.GLOBAL GIBLOK,REHASH,IBLOK1,IILIST,IIFORM,CIVEC,CIUVEC,CICONS,CPOPJ,RBLDM,GCOFFS +.GLOBAL SPBASE,OUTRNG,CISTNG,CBYTES,%RUNAM,PURVEC,GCDOWN,N.CHNS,CHNL1,PLODR,MRKPDL +.GLOBAL CAFRE,CAFRET,STOGC,GCHN,WNDP,FRNP,FRONT,%GCJOB,%SHWND,%INFMP,%GETIP,CHKPGI +.GLOBAL TD.PUT,TD.GET,TD.AGC,TD.AGC,TD.LNT,GLOTOP,UBIT,FLGSET,PURMNG,RPURBT,%IFMP2 +.GLOBAL CTIME,IMTYO,ILOC,NODES,GPURFL,GCDANG,GCHACK,LPUR,HITOP,BADCHN,IMPURX,PURCLN +.GLOBAL GCTIM,GCCAUS,GCCALL,IAAGC,LVLINC,STORIC,GVLINC,TYPIC,GCRSET,ACCESS,NOSHUF,SQUPNT +; GLOBALS ASSOCIATE WITH THE ASSOCIATION VECTOR + +.GLOBAL ASOVEC,ASOLNT,ITEM,INDIC,VAL,NWORDT,NODPNT,PNTRS,DSTORE,HASHTB +.GLOBAL CELL,BINDID,GCFLCH,TYPBOT,GLOBAS,TPBASE,NOWLVL,CURPLN,PVSTOR,SPSTOR + +.GLOBAL P.TOP,P.CORE,PMAPB,IGET,CIGTPR,ROOT,STBL,CAFREE,%MPIN1,%PURIF,%MPINX,GCHK10 +.GLOBAL %SAVRP,%RSTRP,LENGC,AGCLD,PAGEGC,REALGC,MARK +.GLOBAL %MPINT,%GBINT,%CLSMP,%CLSM1,PINIT,PGFIND,NPRFLG,%PURMD +.GLOBAL GCKNUM,CORTOP,GCHPN,INTAGC,WNDP,WNDBOT,BUFGC,WIND,GCDFLG,SAVM,AGC,GCSET + +.GLOBAL GCRET,PAIRMK,DEFMK,VECTMK,TBMK,TPMK,ARGMK,VECTMK,FRMK,BYTMK,ATOMK,GATOMK +.GLOBAL BYTMK,ABMK,LOCRMK,GCRDMK,DEFQMK,ASMRK,LOCMK,OFFSMK,INBLOT,MARK2A + +NOPAGS==1 ; NUMBER OF WINDOWS +EOFBIT==1000 +PDLBUF=100 +NTPMAX==20000 ; NORMAL MAX TP SIZE +NTPGOO==4000 ; NORMAL GOOD TP +ETPMAX==2000 ; TPMAX IN AN EMERGENCY (I.E. GC RECALL) +ETPGOO==2000 ; GOOD TP IN EMERGENCY + +.ATOM.==200000 ; FLAG SAYING ATOMS MARKED (FOR VAL FLUSH LOGIC) + +GCHN==0 ; CHANNEL FOR FUNNNY INFERIOR +STATNO==19. ; # OF STATISTICS FOR BLOAT-STAT +STATGC==8. ; # OF GC-STATISTICS FOR BLOAT-STAT + + +LOC REALGC +OFFS==AGCLD-$. +GCOFFS=OFFS +OFFSET OFFS + +.INSRT MUDDLE > +SYSQ +IFE ITS,[ +.INSRT STENEX > +] +IFN ITS, PGSZ==10. +IFE ITS, PGSZ==9. + +TYPNT=AB ;SPECIAL AC USAGE DURING GC +F=TP ;ALSO SPECIAL DURING GC +LPVP=SP ;SPECIAL FOR GC, HOLDS POINTER TO PROCESS CHAIN +FPTR=TB ; POINT TO CURRENT FRONTIER OF INFERIOR + + +; WINDOW AND FRONTIER PAGES + +MAPCH==0 ; MAPPING CHANNEL +.LIST.==400000 +FPAG==2000 ; START OF PAGES FOR GC-READ AND GCDUMP +CONADJ==5 ; ADJUSTMENT OF DUMPERS CONSTANT TABLE + + +; INTERNAL GCDUMP ROUTINE +.GLOBAL GODUMP,EGCDUM,EPURIF,ERRKIL,IPURIF + +GODUMP: MOVE PVP,PVSTOR+1 + MOVEM P,PSTO+1(PVP) ; SAVE P + MOVE P,GCPDL + PUSH P,AB + PUSHJ P,INFSU1 ; SET UP INFERIORS + +; MARK PHASE + SETZM PURMNG ; INITIALIZE FLAG INDICATING IF PURIFIED PAGES + ; WERE MUNGED + MOVEI 0,HIBOT ; SET UP NEW PURBOT TO CONVINCE THE GARBAGE COLLECTOR + ; TO COLLECT PURIFIED STRUCTURES + EXCH 0,PURBOT + MOVEM 0,RPURBT ; SAVE THE OLD PURBOT + MOVEI 0,HIBOT + EXCH 0,GCSTOP + MOVEM 0,RGCSTP ; SAVE THE OLD GCSTOP + POP P,C ; SET UP PTR TO TYPE/VALUE PAIR + MOVE P,A ; GET NEW PDL PTR + SETOM DUMFLG ; FLAG INDICATING IN DUMPER + MOVE A,TYPVEC+1 + MOVEM A,TYPSAV + ADD FPTR,[7,,7] ; ADJUST FOR FIRST STATUS WORDS + PUSHJ P,MARK2 + MOVEI E,FPAG+6 ; SEND OUT PAIR + PUSH P,C ; SAVE C + MOVE C,A + PUSHJ P,ADWD + POP P,C ; RESTORE C + MOVEI E,FPAG+5 + MOVE C,(C) ; SEND OUT UPDATED PTR + PUSHJ P,ADWD + + MOVEI 0,@BOTNEW ; CALCULATE START OF TYPE-TABLE + MOVEM 0,TYPTAB + MOVE 0,RPURBT ; RESTORE PURBOT + MOVEM 0,PURBOT + MOVE 0,RGCSTP ; RESTORE GCSTOP + MOVEM 0,GCSTOP + + +; ROUTINE TO SCAN THE TYPE-VECTOR FOR MARKED TYPE SLOTS AND BUILD A TYPE-TABLE OUT OF +; THEM + + MOVE A,TYPSAV ; GET AOBJN POINTER TO TYPE-VECTOR + MOVEI B,0 ; INITIALIZE TYPE COUNT +TYPLP2: HLRE C,(A) ; GET MARKING + JUMPGE C,TYPLP1 ; IF NOT MARKED DON'T OUTPUT + MOVE C,(A) ; GET FIRST WORD + HRL C,B ; FIX UP SO TYPE-NUMBER REPLACES TYPE-CELL + PUSH P,A + SKIPL FPTR + PUSHJ P,MOVFNT + MOVEM C,FRONT(FPTR) + AOBJN FPTR,.+2 + PUSHJ P,MOVFNT ; EXTEND THE FRONTIER + POP P,A + MOVE C,1(A) ; OUTPUT SECOND WORD + MOVEM C,FRONT(FPTR) + ADD FPTR,[1,,1] +TYPLP1: ADDI B,1 ; INCREMENT TYPE COUNT + ADD A,[2,,2] ; POINT TO NEXT SLOT + JUMPL A,TYPLP2 ; LOOP + +; ROUTINE TO BUILD UP ATOM TABLE USING LPVP CHAIN + + HRRZ F,ABOTN + MOVEI 0,@BOTNEW ; GET CURRENT BEGINNING OF TRANSFER + MOVEM 0,ABOTN ; SAVE IT + PUSHJ P,ALLOGC ; ALLOCATE ROOM FOR ATOMS + MOVSI D,400000 ; SET UP UNMARK BIT +SPOUT: JUMPE LPVP,DPGC4 ; END OF CHAIN + MOVEI F,(LPVP) ; GET COPY OF LPVP + HRRZ LPVP,-1(LPVP) ; LPVP POINTS TO NEXT ON CHAIN + ANDCAM D,(F) ; UNMARK IT + HLRZ C,(F) ; GET LENGTH + HRRZ E,(F) ; POINTER INTO INF + ADD E,ABOTN + SUBI C,2 ; WE'RE NOT SENDING OUT THE VALUE PAIR + HRLM C,(F) ; ADJUSTED LENGTH + MOVE 0,C ; COPY C FOR TRBLKX + SUBI E,(C) ; ADJUST PTRS FOR SENDOUT + SUBI F,-1(C) + PUSHJ P,TRBLKX ; OUT IT GOES + JRST SPOUT + + +; HERE TO SEND OUT DELIMITER INFORMATION +DPGC4: SKIPN INCORF ; SKIP IF TRANSFREING TO UVECTOR IN CORE + JRST CONSTO + SKIPL FPTR ; SEE IF ROOM IN FRONTEIR + PUSHJ P,MOVFNT ; EXTEND FRONTEIR + MOVSI A,.VECT. + MOVEM A,FRONT(FPTR) + AOBJN FPTR,.+2 + PUSHJ P,MOVFNT + MOVEI A,@BOTNEW ; LENGTH + SUBI A,FPAG + HRLM A,FRONT(FPTR) + ADD FPTR,[1,,1] + + +CONSTO: MOVEI E,FPAG + MOVE C,ABOTN ; START OF ATOMS + SUBI C,FPAG+CONADJ ; ADJUSTMENT FOR STARTING ON PAGE ONE + PUSHJ P,ADWD ; OUT IT GOES + MOVEI E,FPAG+1 + MOVEI C,@BOTNEW + SUBI C,FPAG+CONADJ + SKIPE INCORF ; SKIP IF TO CHANNEL + SUBI C,2 ; SUBTRACT FOR DOPE WORDS + PUSHJ P,ADWD + SKIPE INCORF + ADDI C,2 ; RESTORE C TO REAL ABOTN + ADDI C,CONADJ + PUSH P,C + MOVE C,TYPTAB + SUBI C,FPAG+CONADJ + MOVEI E,FPAG+2 ; SEND OUT START OF TYPE TABLE + PUSHJ P,ADWD + ADDI E,1 ; SEND OUT NUMPRI + MOVEI C,NUMPRI + PUSHJ P,ADWD + ADDI E,1 ; SEND OUT NUMSAT + MOVEI C,NUMSAT + PUSHJ P,ADWD + + + +; FINAL CLOSING OF INFERIORS + +DPCLS: PUSH P,PGCNT + PUSHJ P,INFCL1 + POP P,PGCNT + POP P,A ; LENGTH OF CODE + +; RESTORE AC'S + MOVE PVP,PVSTOR+1 + IRP AC,,[P,TP,TB,AB,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + + SETZB M,R + SETZM DUMFLG + SETZM GCDFLG ; ZERO FLAG INDICATING IN DUMPER + SETZM GCFLG ; AND INDICTOR TO INTERRUPT HANDLER THAT AGC IS ON + PUSH P,A + MOVE A,INF2 ; GET POINTER TO PURE MAPPED OUT + PUSHJ P,%GBINT + + POP P,A + JRST EGCDUM + + +ERDP: PUSH P,B + PUSHJ P,INFCLS + PUSHJ P,INFCL1 + SETZM GCFLG + SETZM GPURFL ; PURE FLAG + SETZM DUMFLG + SETZM GCDFLG + POP P,A + +; RESTORE AC'S + MOVE PVP,PVSTOR+1 + IRP AC,,[P,R,M,TP,TB,AB,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + +ERDUMP: PUSH TP,$TATOM + +OFFSET 0 + + PUSH TP,EQUOTE STRUCTURE-CONTAINS-UNDUMPABLE-TYPE + +OFFSET OFFS + + PUSH TP,$TATOM ; PUSH ON PRIMTYPE + PUSH TP,@STBL(A) ; PUSH ON PRIMTYPE + MOVEI A,2 + JRST ERRKIL + +; ALTERNATE ATOM MARKER FOR DUMPER + +DATOMK: SKIPE GPURFL ; SKIP IF NOT IN PURIFIER + JRST PATOMK + CAILE A,0 ; SEE IF ALREADY MARKED + JRST GCRET + PUSH P,A ; SAVE PTR TO ATOM + HLRE B,A ; POINT TO DOPE WORD + SUB A,B ; TO FIRST DOPE WORD + MOVEI A,1(A) ; TO SECOND + PUSH P,A ; SAVE PTR TO DOPE WORD + HLRZ B,(A) ; GET LENGTH AND MARKING + TRZE B,400000 ; TURN OFF BIT AND SKIP IF UNMARKED + JRST DATMK1 + IORM D,(A) ; MARK IT + MOVE 0,ABOTN ; GET CURRENT TOP OF ATOM TABLE + ADDI 0,-2(B) ; PLACE OF DOPE WORD IN TABLE + HRRM 0,(A) ; PUT IN RELOCATION + MOVEM 0,ABOTN ; FIXUP TOP OF TABLE + HRRM LPVP,-1(A) ; FIXUP CHAIN + MOVEI LPVP,(A) + MOVE A,-1(P) ; GET POINTER TO ATOM BACK + HRRZ B,2(A) ; GET OBLIST POINTER + JUMPE B,NOOB ; IF ZERO ON NO OBLIST + CAMG B,VECBOT ; DON'T SKIP IF OFFSET FROM TVP + MOVE B,(B) + HRLI B,-1 +DATMK3: MOVE A,$TOBLS ; SET UP FOR GET + MOVE C,$TATOM + +OFFSET 0 + MOVE D,IMQUOTE OBLIST + +OFFSET OFFS + + PUSH P,TP ; SAVE FPTR + MOVE TP,MAINPR + MOVE TP,TPSTO+1(TP) ; GET TP + PUSHJ P,IGET + POP P,TP ; RESTORE FPTR + MOVE C,-1(P) ; RECOVER PTR TO ATOM + ADDI C,1 ; SET UP TO MARK OBLIST ATOM + MOVSI D,400000 ; RESTORE MARK WORD + +OFFSET 0 + + CAMN B,MQUOTE ROOT + +OFFSET OFFS + + JRST RTSET + MOVEM B,1(C) + MOVEI B,TATOM + PUSHJ P,MARK1 ; MARK IT + MOVEM A,1(C) ; SMASH IN ITS ID +DATMK1: +NOOB: POP P,A ; GET PTR TO DOPE WORD BACK + HRRZ A,(A) ; RETURN ID + SUB P,[1,,1] ; CLEAN OFF STACK + MOVEM A,(P) + JRST GCRET ; EXIT + +; HERE FOR A ROOT ATOM +RTSET: SETOM 1(C) ; INDICATOR OF ROOT ATOM + JRST NOOB ; CONTINUE + + +; INTERNAL PURIFY ROUTINE +; SAVE AC's + +IPURIF: PUSHJ P,PURCLN ; GET RID OF PURE MAPPED + MOVE PVP,PVSTOR+1 + IRP AC,,[P,R,M,TP,TB,AB,FRM] + MOVEM AC,AC!STO"+1(PVP) + TERMIN + + +; HERE TO CREATE INFERIORS AND MARK THE ITEM +PURIT1: MOVE PVP,PVSTOR+1 + MOVEM P,PSTO+1(PVP) ; SAVE P + SETOM GPURFL ; INDICATE PURIFICATION IS TAKING PLACE + MOVE C,AB ; ARG PAIR + MOVEM C,SAVRS1 ; SAV PTR TO PAIR + MOVE P,GCPDL + PUSHJ P,INFSUP ; GET INFERIORS + MOVE P,A ; GET NEW PDL PTR + PUSHJ P,%SAVRP ; SAVE RPMAP TABLE FOR TENEX + MOVE C,SAVRS1 ; SET UP FOR MARKING + MOVE A,(C) ; GET TYPE WORD + MOVEM A,SAVRE2 +PURIT3: PUSH P,C + PUSHJ P,MARK2 +PURIT4: POP P,C ; RESTORE C + ADD C,[2,,2] ; TO NEXT ARG + JUMPL C,PURIT3 + MOVEM A,SAVRES ; SAVE UPDATED POINTER + +; FIX UP IMPURE PART OF ATOM CHAIN + + PUSH P,[0] ; FLAG INDICATING NON PURE SCAN + PUSHJ P,FIXATM + SUB P,[1,,1] ; CLEAN OFF STACK + +; NOW TO GET PURE STORAGE + +PURIT2: MOVEI A,@BOTNEW ; GET BOTNEW + SUBI A,2000-1777 ; START AT PAGE 1 AND ROUND + ANDCMI A,1777 + ASH A,-10. ; TO PAGES + SETZ M, + PUSH P,A + PUSHJ P,PGFIND ; FIND THEM + JUMPL B,LOSLP2 ; LOST GO TO CAUSE AGC + HRRZ 0,BUFGC ;GET BUFFER PAGE + ASH 0,-10. + MOVEI A,(B) ; GET LOWER PORTION OF PAGES + MOVN C,(P) + SUBM A,C ; GET END PAGE + CAIL 0,(A) ; L? LOWER + CAILE 0,(C) ; G? HIGER + JRST NOREMP ; DON'T GET NEW BUFFER + PUSHJ P,%FDBUF ; GET A NEW BUFFER PAGE +NOREMP: MOVN A,(P) ; SET UP AOBJN PTR FOR MAPIN + MOVE C,B ; SAVE B + HRL B,A + HRLZS A + ADDI A,1 + MOVEM B,INF3 ; SAVE PTR FOR PURIFICATION + PUSHJ P,%MPIN1 ; MAP IT INTO PURE + ASH C,10. ; TO WORDS + MOVEM C,MAPUP + SUB P,[1,,1] ; CLEAN OFF STACK + +DONMAP: +; RESTORE AC's + MOVE PVP,PVSTOR+1 + MOVE P,PSTO+1(PVP) ; GET REAL P + PUSH P,LPVP + MOVEI A,@BOTNEW + MOVEM A,NABOTN + + IRP AC,,[M,TP,TB,R,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + MOVE A,INF1 + +; NOW FIX UP POINTERS IN PURE STRUCTURE + MOVE 0,GCSBOT + MOVEM 0,OGCSTP + PUSH P,GCSBOT ; SAVE GCSBOT AND GCSTOP + PUSH P,GCSTOP + MOVE A,MAPUP ; NEW GCSBOT AND TOP TO FOOL GCHACK + MOVEM A,GCSBOT + ADD A,NABOTN + SUBI A,2000 ; ADJUSTMENT FOR START ON PAGE ONE + MOVEM A,GCSTOP + MOVE A,[PUSHJ P,NPRFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHK10 + POP P,GCSTOP + POP P,GCSBOT + +; NOW FIX UP POINTERS TO PURIFIED STRUCTURE + + MOVE A,[PUSHJ P,PURFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + + SETZM GCDFLG + SETZM DUMFLG + SETZM GCFLG + + POP P,LPVP ; GET BACK LPVP + MOVE A,INF1 + PUSHJ P,%KILJB ; KILL IMAGE SAVING INFERIOR + PUSH P,[-1] ; INDICATION OF PURE ATOM SCAN + PUSHJ P,FIXATM + +; SET UP PMAP SO THAT NEW PURE PAGES ARE INDICATED + + MOVE A,INF3 ; GET AOBJN PTR TO PAGES +FIXPMP: HRRZ B,A ; GET A PAGE + IDIVI B,16. ; DIVIDE SO AS TO PT TO PMAP WORD + PUSHJ P,PINIT ; SET UP PARAMETER + LSH D,-1 + TDO E,D ; FIX UP WORD + MOVEM E,PMAPB(B) ; SEND IT BACK + AOBJN A,FIXPMP + + SUB P,[1,,1] + MOVE A,[PUSHJ P,PURTFX] ; FIX UP PURE ATOM POINTERS + MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + +; NOW FIX UP POINTERS IN PURE STRUCTURE + PUSH P,GCSBOT ; SAVE GCSBOT AND GCSTOP + PUSH P,GCSTOP + MOVE A,MAPUP ; NEW GCSBOT AND TOP TO FOOL GCHACK + MOVEM A,GCSBOT + ADD A,NABOTN + SUBI A,2000 ; ADJUSTMENT FOR START ON PAGE ONE + MOVEM A,GCSTOP + MOVE A,[PUSHJ P,PURTFX] + MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHK10 + POP P,GCSTOP + POP P,GCSBOT + +; HERE TO FIX UP ATOMS WITH TYPES HACKED INTO THEIR GROWTH FIELD + + MOVE A,TYPVEC+1 ; GET TYPE VECTOR + MOVEI B,400000 ; TLOSE==0 +TTFIX: HRRZ D,1(A) ; GET ADDR + HLRE C,1(A) + SUB D,C + HRRM B,(D) ; SMASH IT IN +NOTFIX: ADDI B,1 ; NEXT TYPE + ADD A,[2,,2] + JUMPL A,TTFIX + +; NOW CLOSE UP INFERIORS AND RETURN + +PURCLS: MOVE P,[-2000,,MRKPDL] + PUSHJ P,%RSTRP ;RESETORE RPMAP TABLE FOR TENEX + PUSHJ P,INFCLS + + MOVE PVP,PVSTOR+1 + MOVE P,PSTO+1(PVP) ; RESTORE P + MOVE AB,ABSTO+1(PVP) ; RESTORE R + + MOVE A,INF3 ; GET PTR TO PURIFIED STRUCTURE + SKIPN NPRFLG + PUSHJ P,%PURIF ; PURIFY + PUSHJ P,%PURMD + + SETZM GPURFL + JRST EPURIF ; FINISH UP + +NPRFIX: PUSH P,A + PUSH P,B + PUSH P,C + EXCH A,C + PUSHJ P,SAT ; GET STORAGE ALLOCATION TYPE + MOVE C,MAPUP ; FIXUP AMOUNT + SUBI C,FPAG ; ADJUST FOR START ON FIRST PAGE + CAIE A,SLOCR ; DONT HACK TLOCRS + CAIN A,S1WORD ; SKIP IF NOT OF PRIMTYPE WORD + JRST LSTFXP + CAIN A,SCHSTR + JRST STRFXP + CAIN A,SATOM + JRST ATMFXP + CAIN A,SOFFS + JRST OFFFXP ; FIXUP OFFSETS +STRFXQ: HRRZ D,1(B) + JUMPE D,LSTFXP ; SKIP IF NIL + CAMG D,PURTOP ; SEE IF ALREADY PURE + ADDM C,1(B) +LSTFXP: TLNN B,.LIST. ; SKIP IF NOT A PAIR + JRST LSTEX1 + HRRZ D,(B) ; GET REST OF LIST + SKIPE D ; SKIP IF POINTS TO NIL + PUSHJ P,RLISTQ + JRST LSTEX1 + CAMG D,PURTOP ; SKIP IF ALREADY PURE + ADDM C,(B) ; FIX UP LIST +LSTEX1: POP P,C + POP P,B ; RESTORE GCHACK AC'S + POP P,A + POPJ P, + +OFFFXP: HLRZ 0,D ; POINT TO LIST + JUMPE 0,LSTFXP ; POINTS TO NIL + CAML 0,PURTOP ; ALREADY PURE? + JRST LSTFXP ; YES + ADD 0,C ; UPDATE THE POINTER + HRLM 0,1(B) ; STUFF IT OUT + JRST LSTFXP ; DONE + +STRFXP: TLZN D,STATM ; SKIP IF REALLY ATOM + JRST STRFXQ + MOVEM D,1(B) + PUSH P,C + MOVE C,B ; GET ARG FOR BYTDOP + PUSHJ P,BYTDOP + POP P,C + MOVEI D,-1(A) + JRST ATMFXQ + +ATMFXP: HLRE 0,D ; GET LENGTH + SUB D,0 ; POINT TO FIRST DOPE WORD + HRRZS D +ATMFXQ: CAML D,OGCSTP + CAIL D,HIBOT ; SKIP IF IMPURE + JRST LSTFXP + HRRZ 0,1(D) ; GET RELOCATION + SUBI 0,1(D) + ADDM 0,1(B) ; FIX UP PTR IN STRUCTURE + JRST LSTFXP + +; FIXUP OF PURE ATOM POINTERS + +PURTFX: CAIE C,TATOM ; SKIP IF ATOM POINTER + JRST PURSFX + HLRE E,D ; GET TO DOPE WORD + SUBM D,E +PURSF1: SKIPL 1(E) ; SKIP IF MARKED + POPJ P, + HRRZ 0,1(E) ; RELATAVIZE PTR + SUBI 0,1(E) + ADD D,0 ; FIX UP PASSED POINTER + SKIPE B ; AND IF APPROPRIATE MUNG POINTER + ADDM 0,1(B) ; FIX UP POINTER + POPJ P, + +PURSFX: CAIE C,TCHSTR + POPJ P, + MOVE C,B ; GET ARG FOR BYTDOP + PUSHJ P,BYTDOP + GETYP 0,-1(A) + MOVEI E,-1(A) + MOVE A,[PUSHJ P,PURTFX] + CAIE 0,SATOM + POPJ P, + JRST PURSF1 + +PURFIX: PUSH P,D + PUSH P,A + PUSH P,B + PUSH P,C ; SAVE AC'S FOR GCHACK + EXCH A,C ; GET TYPE IN A + CAIN A,TATOM ; CHECK FOR ATOM + JRST ATPFX + PUSHJ P,SAT + + CAILE A,NUMSAT ; SKIP IF TEMPLATE + JRST TLFX +IFN ITS, JRST @PURDSP(A) +IFE ITS,[ + HRRZ 0,PURDSP(A) + HRLI 0,400000 + JRST @0 +] +PURDSP: + +OFFSET 0 + +DISTBS DUM1,TLFX,[[S2WORD,LPLSTF],[S2DEFR,LPLSTF],[SNWORD,VECFX], +[S2NWORD,VECFX],[SSTORE,VECFX],[SBYTE,STRFX],[SATOM,ATPFX],[SLOCB,STRFX] +[SCHSTR,STRFX],[SLOCL,LPLSTF],[SLOCV,VECFX],[SLOCU,VECFX],[SLOCS,VECFX],[SOFFS,OFFSFX]] + +OFFSET OFFS + +VECFX: HLRE 0,D ; GET LENGTH + SUB D,0 ; POINT TO D.W. + SKIPL 1(D) ; SKIP IF MARKED + JRST TLFX + HRRZ C,1(D) + SUBI C,1(D) ; CALCULATE RELOCATION + ADD C,MAPUP ; ADJUSTMENT + SUBI C,FPAG + ADDM C,1(B) +TLFX: TLNN B,.LIST. ; SEE IF PAIR + JRST LVPUR ; LEAVE IF NOT + PUSHJ P,RLISTQ + JRST LVPUR + HRRZ D,(B) ; GET CDR + SKIPN D ; SKIP IF NOT ZERO + JRST LVPUR + MOVE D,(D) ; GET CADR + SKIPL D ; SKIP IF MARKED + JRST LVPUR + ADD D,MAPUP + SUBI D,FPAG + HRRM D,(B) ; FIX UP +LVPUR: POP P,C + POP P,B + POP P,A + POP P,D + POPJ P, + +STRFX: MOVE C,B ; GET ARG FOR BYTDOP + PUSHJ P,BYTDOP + SKIPL (A) ; SKIP IF MARKED + JRST TLFX + GETYP 0,-1(A) + MOVE D,1(B) + MOVEI C,-1(A) + CAIN 0,SATOM ; REALLY ATOM? + JRST ATPFX1 + HRRZ 0,(A) ; GET PTR IN NEW STRUCTURE + SUBI 0,(A) ; RELATAVIZE + ADD 0,MAPUP ; ADJUST + SUBI 0,FPAG + ADDM 0,1(B) ; FIX UP PTR + JRST TLFX + +ATPFX: HLRE C,D + SUBM D,C + SKIPL 1(C) ; SKIP IF MARKED + JRST TLFX +ATPFX1: HRRZS C ; SEE IF PURE + CAIL C,HIBOT ; SKIP IF NOT PURE + JRST TLFX + HRRZ 0,1(C) ; GET PTR TO NEW ATOM + SUBI 0,1(C) ; RELATAVIZE + ADD D,0 + JUMPE B,TLFX + ADDM 0,1(B) ; FIX UP + JRST TLFX + +LPLSTF: SKIPN D ; SKIP IF NOT PTR TO NIL + JRST TLFX + SKIPL (D) ; SKIP IF MARKED + JRST TLFX + HRRZ D,(D) ; GET UPDATED POINTER + ADD D,MAPUP ; ADJUSTMENT + SUBI D,FPAG + HRRM D,1(B) + JRST TLFX + +OFFSFX: HLRZS D ; LIST POINTER + JUMPE D,TLFX ; NIL + SKIPL (D) ; MARKED? + JRST TLFX ; NO + ADD D,MAPUP + SUBI D,FPAG ; ADJUST + HRLM D,1(B) + JRST TLFX ; RETURN + +; ROUTINES TO CAUSE A GARBAGE COLLECT WHEN EFFORTS TO GET STORAGE FAIL + +LOSLP1: MOVE A,ABOTN + MOVEM A,PARNEW ; SET UP GC PARAMS + MOVE C,[12.,,6] + JRST PURLOS + +LOSLP2: MOVEI A,@BOTNEW ; TOTAL AMOUNT NEEDED + ADDI A,1777 + ANDCMI A,1777 ; CALCULATE PURE PAGES NEEDED + MOVEM A,GCDOWN + MOVE C,[12.,,8.] + JRST PURLOS + +PURLOS: MOVE P,[-2000,,MRKPDL] + PUSH P,GCDOWN + PUSH P,PARNEW + MOVE R,C ; GET A COPY OF A + PUSHJ P,INFCLS ; CLOSE INFERIORS AND FIX UP WORLD + PUSHJ P,INFCL2 +PURLS1: POP P,PARNEW + POP P,GCDOWN + MOVE C,R + +; RESTORE AC'S + MOVE PVP,PVSTOR+1 + IRP AC,,[P,R,M,TP,TB,AB,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + + SETZM GCDFLG ; ZERO OUT FLAGS + SETZM DUMFLG + SETZM GPURFL + SETZM GCDANG + + PUSHJ P,AGC ; GARBAGE COLLECT + JRST PURIT1 ; TRY AGAIN + +; PURIFIER ATOM MARKER + +PATOMK: HRRZ 0,A + CAMG 0,PARBOT + JRST GCRET ; DONE IF FROZEN + HLRE B,A ; GET TO D.W. + SUB A,B + SKIPG 1(A) ; SKIP IF NOT MARKED + JRST GCRET + HLRZ B,1(A) + IORM D,1(A) ; MARK THE ATOM + ADDM B,ABOTN + HRRM LPVP,(A) ; LINK ONTO CHAIN + MOVEI LPVP,1(A) + JRST GCRET ; EXIT + + +.GLOBAL %LDRDO,%MPRDO + +; ROUTINES TO ALLOW GC-DUMPING OF PURIFIED STRUCTURES. + +; PROPUR MAPS PAGES CONTAINING PURIFIED STUFF INTO THE AGD INFERIOR SO THAT IN CASE +; THE PAGES ARE MUNGED THEY CAN BE RESTORED USING MAPPING + +; REPURE REMAPS ANY PAGES THAT WERE MUNGED BY GC-DUMP BY RELOADING THEM FROM THE AGD +; INFERIOR IN READ/EXEC MODE + +REPURE: PUSH P,[PUSHJ P,%LDRDO] ; INSTRUCTION FOR MAPPING IN PAGES FROM AGD INF + SKIPA +PROPUR: PUSH P,[PUSHJ P,%MPRDO] ; INSTRUCTION FOR MAPPING PAGES TO AGD INF + MOVE A,PURBOT ; GET STARTING PAGE OF PURENESS + ASH A,-10. ; CONVERT TO PAGES + MOVEI C,HIBOT ; GET ENDING PAGE + ASH C,-10. ; CONVERT TO PAGES + PUSH P,A ; SAVE PAGE POINTER + PUSH P,C ; SAVE END OF PURENESS POINTER +PROLOP: CAML A,(P) ; SKIP IF STILL PURE PAGES TO CHECK + JRST PRODON ; DONE MAPPING PAGES + PUSHJ P,CHKPGI ; SKIP IF PAGE IS PURE + JRST NOTPUR ; IT IS NOT + MOVE A,-1(P) ; GET PAGE TO MAP + XCT -2(P) ; MAP IN/OUT TO AGD INFERIOR IN READ/EXEC MODE +NOTPUR: AOS A,-1(P) ; INCREMENT PAGE POINTER AND LOAD + JRST PROLOP ; LOOP BACK +PRODON: SUB P,[3,,3] ; CLEAN OFF STACK + POPJ P, ; EXIT + + + +.GLOBAL %SAVIN,STOSTR,%CLMP1,%IMSAV,%IMSV1,ILOOKC,PSHGCF,BSETG,%GCJB1 +.GLOBAL %CLSJB,%KILJB,%IFMP1,%OPGFX,%FDBUF +INFSU1: PUSH P,[-1] ; ENTRY USED BY GC-DUMP + SKIPA +INFSUP: PUSH P,[0] + MOVE A,GLOTOP+1 ; GET GLOTOP FOR LOCR HACKS + MOVEM A,GLTOP + PUSHJ P,%FDBUF ; GET A BUFFER FOR C/W HACKS + SETOM GCDFLG + SETOM GCFLG + HLLZS SQUPNT + HRRZ TYPNT,TYPVEC+1 ; SETUP TYPNT + HRLI TYPNT,B + MOVEI A,STOSTR + ANDCMI A,1777 ; TO PAGE BOUNDRY + SUB A,GCSTOP ; SET UP AOBJN POINTER FOR C/W HACK + ASH A,-10. ; TO PAGES + HRLZS A + MOVEI B,STOSTR ; GET START OF MAPPING + ASH B,-10. + ADDI A,(B) + MOVEM A,INF1 + PUSHJ P,%SAVIN ; PROTECT THE CORE IMAGE + SKIPGE (P) ; IF < 0 GC-DUMP CALL + PUSHJ P,PROPUR ; PROTECT PURE PAGES + SUB P,[1,,1] ; CLEAN OFF PSTACK + PUSHJ P,%CLSJB ; CLOSE INFERIOR + + MOVSI D,400000 ; CREATE MARK WORD + SETZB LPVP,ABOTN ; ZERO ATOM COUNTER + MOVEI A,2000 ; MARKED INF STARTS AT PAGE ONE + HRRM A,BOTNEW + SETZM WNDBOT + SETZM WNDTOP + HRRZM A,FNTBOT + ADDI A,2000 ; WNDTOP + MOVEI A,1 ; TO PAGES + PUSHJ P,%GCJB1 ; CREATE THE JOB + MOVSI FPTR,-2000 + MOVEI A,LPUR ; SAVE THE PURE CORE IMAGE + ANDCMI A,1777 ; TO PAGE BOUNDRY + MOVE 0,A ; COPY TO 0 + ASH 0,-10. ; TO PAGES + SUB A,HITOP ; SUBTRACT TOP OF CORE + ASH A,-10. + HRLZS A + ADD A,0 + MOVEM A,INF2 + PUSHJ P,%IMSV1 ; MAP OUT INTERPRETER + PUSHJ P,%OPGFX + +; CREATE A PDL TO USE FOR THESE DUMPING FUNCTIONS + + MOVE A,[-2000,,MRKPDL] + POPJ P, + +; ROUTINE TO CLOSE GC's INFERIOR + + +INFCLS: MOVE A,INF2 ; GET POINTER TO PURE MAPPED OUT + PUSHJ P,%CLSMP + POPJ P, + +; CLOSE INFERIOR PROTECTING CORE IMAGE FOR GCDUMP + +INFCL2: PUSHJ P,%IFMP1 ; OPEN AGD INF TO RESTORE PAGES +INFCL3: MOVE A,INF1 ; RESTORE OPENING POINTER + PUSH P,INF2 + MOVE B,A ; SATIFY MUDITS + PUSHJ P,%IFMP2 ; MAP IN GC PAGES AND CLOSE INFERIOR + POP P,INF2 ; RESTOR INF2 PARAMETER + POPJ P, + +INFCL1: PUSHJ P,%IFMP1 ; OPEN AGD INF TO RESTORE PAGES + SKIPGE PURMNG ; SKIP IF NO PURE PAGES WERE MUNGED + PUSHJ P,REPURE ; REPURIFY MUNGED PAGES + JRST INFCL3 + + + +; ROUTINE TO DO TYPE HACKING FOR GC-DUMP. IT MARKS THE TYPE-WORD OF THE +; SLOT IN THE TYPE VECTOR. IT ALSO MARKS THE ATOM REPLACING THE I.D. IN +; THE RIGHT HALF OF THE ATOM SLOT. IF THE TYPE IS A TEMPLATE THE FIRST +; USE OF THE SAT HAS ITS ATOM MARKED AND THE I.D. IS PLACED IN THE LEFT +; HALF OF THE ATOM SLOT (IT GETS THE REAL PRIMTYPE). + +TYPHK: CAILE B,NUMPRI ; SKIP IF A MUDDLE TYPE + JRST TYPHKR ; ITS A NEWTYPE SO GO TO TYPHACKER + CAIN B,TTYPEC ; SKIP IF NOT TYPE-C + JRST TYPCHK ; GO TO HACK TYPE-C + CAIE B,TTYPEW ; SKIP IF TYPE-W + POPJ P, + PUSH P,B + HLRZ B,A ; GET TYPE + JRST TYPHKA ; GO TO TYPE-HACKER +TYPCHK: PUSH P,B ; SAVE TYPE-WORD + HRRZ B,A + JRST TYPHKA + +; GENERAL TYPE-HACKER FOR GC-DUMP + +TYPHKR: PUSH P,B ; SAVE AC'S +TYPHKA: PUSH P,A + PUSH P,C + LSH B,1 ; GET OFFSET TO SLOT IN TYPE VECTOR + MOVEI C,(TYPNT) ; GET TO SLOT + ADDI C,(B) + SKIPGE (C) + JRST EXTYP + IORM D,(C) ; MARK THE SLOT + MOVEI B,TATOM ; NOW MARK THE ATOM SLOT + PUSHJ P,MARK1 ; MARK IT + HRRM A,1(C) ; SMASH IN ID + HRRZS 1(C) ; MAKE SURE THAT THATS ALL THATS THERE + HRRZ B,(C) ; GET SAT + ANDI B,SATMSK ; GET RID OF MAGIC BITS + HRRM B,(C) ; SMASH SAT BACK IN + CAIG B,NUMSAT ; SKIP IF TEMPLATE + JRST EXTYP + MOVE A,TYPSAV ; GET POINTER TO TYPE VECTOR + ADDI A,NUMPRI*2 ; GET TO NEWTYPES SLOTS + HRLI 0,NUMPRI*2 + HLLZS 0 ; MAKE SURE ONLY LEFT HALF + ADD A,0 +TYPHK1: HRRZ E,(A) ; GET SAT OF SLOT + CAMN E,B ; SKIP IF NOT EQUAL + JRST TYPHK2 ; GOT IT + ADDI A,2 ; TO NEXT + JRST TYPHK1 +TYPHK2: PUSH P,C ; SAVE POINTER TO ORIGINAL SLOT + MOVE C,A ; COPY A + MOVEI B,TATOM ; SET UP FOR MARK + MOVE A,1(C) ; ASSUME MARK DOESN'T HAVE TO TAKE PLACE + SKIPL (C) ; DON'T MARK IF ALREADY MARKED + PUSHJ P,MARK + POP P,C ; RESTORE C + HRLM A,1(C) ; SMASH IN PRIMTYPE OF TEMPLATE +EXTYP: POP P,C ; RESTORE AC'S + POP P,A + POP P,B + POPJ P, ; EXIT + + +; A ROUTINE TO DISTINGUISH BETWEEN A DEFERRED AND A LIST POINTER +RLISTQ: PUSH P,A + GETYP A,(B) ; GET TYPE + PUSHJ P,SAT ; GET SAT + CAIG A,NUMSAT ; NOT DEFERRED IF TEMPLATE + SKIPL MKTBS(A) + AOS -1(P) ; SKIP IF NOT DEFFERED + POP P,A + POPJ P, ; EXIT + + +; DISPATCH TABLE FOR MARK PHASE ("SETZ'D" ENTRIES MUST BE DEFERRED) + +GCDISP: + +OFFSET 0 + +DISTBS DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,VECTMK],[STBASE,ERDP] +[STPSTK,ERDP],[SARGS,ERDP],[S2NWORD,VECTMK],[SPSTK,ERDP],[SSTORE,VECTMK] +[SFRAME,ERDP],[SBYTE,],[SATOM,DATOMK],[SPVP,ERDP],[SGATOM,ERDP] +[SLOCID,ERDP],[SCHSTR,],[SASOC,ERDP],[SLOCL,PAIRMK],[SABASE,ERDP] +[SLOCA,ERDP],[SLOCV,VECTMK],[SLOCU,VECTMK],[SLOCS,],[SLOCN,ERDP] +[SLOCB,],[SLOCR,LOCRDP],[SOFFS,OFFSMK]] + +OFFSET OFFS + + +; THIS SUBROUTINE IMPURIFIES A PURE ATOM TO ALLOW MODIFICATION OF SYSTEM SUBRS + +IMPRF: PUSH P,A + PUSH P,LPVP + PUSH TP,$TATOM + HLRZ C,(A) ; GET LENGTH + TRZ C,400000 ; TURN OF 400000 BIT + SUBI A,-1(C) ; POINT TO START OF ATOM + MOVNI C,-2(C) ; MAKE IT LOOK LIKE AN ATOM POINTER + HRL A,C + PUSH TP,A + MOVE C,A + MOVEI 0,(C) + PUSH P,AB + MOVE PVP,PVSTOR+1 + MOVE AB,ABSTO+1(PVP) + PUSHJ P,IMPURX + POP P,AB + POP P,LPVP ; RESTORE A + POP P,A + POPJ P, + +FIXATM: PUSH P,[0] +FIXTM5: JUMPE LPVP,FIXTM4 + MOVEI B,(LPVP) ; GET PTR TO ATOMS DOPE WORD + HRRZ LPVP,-1(B) ; SET UP LPVP FOR NEXT IN CHAIN + SKIPE -2(P) ; SEE IF PURE SCAN + JRST FIXTM2 + CAIL B,HIBOT + JRST FIXTM3 +FIXTM2: CAMG B,PARBOT ; SKIP IF NOT FROZEN + JRST FIXTM1 + HLRZ A,(B) + TRZ A,400000 ; GET RID OF MARK BIT + MOVE D,A ; GET A COPY OF LENGTH + SKIPE -2(P) + JRST PFATM + PUSHJ P,CAFREE ; GET STORAGE + SKIPE GCDANG ; SEE IF WON + JRST LOSLP1 ; GO TO CAUSE GC + JRST FIXT10 +PFATM: PUSH P,AB + MOVE PVP,PVSTOR+1 + MOVE AB,ABSTO+1(PVP) + SETZM GPURFL + PUSHJ P,CAFREE + SETOM GPURFL + POP P,AB +FIXT10: SUBM D,ABOTN + MOVNS ABOTN + SUBI B,-1(D) ; POINT TO START OF ATOM + HRLZ C,B ; SET UP FOR BLT + HRRI C,(A) + ADDI A,-1(D) ; FIX UP TO POINT TO NEW DOPE WORD + BLT C,(A) + HLLZS -1(A) + HLLOS (A) ; -1 IN RELOCATION FIELD SINCE ITS NOT GARBAGE + ADDI B,-1(D) ; B POINTS TO SECOND D.W. + HRRM A,(B) ; PUT IN RELOCATION + MOVSI D,400000 ; UNMARK ATOM + ANDCAM D,(A) + CAIL B,HIBOT ; SKIP IF IMPURE + PUSHJ P,IMPRF + JRST FIXTM5 ; CONTINE FIXUP + +FIXTM4: POP P,LPVP ; FIX UP LPVP TO POINT TO NEW CHAIN + POPJ P, ; EXIT + +FIXTM1: HRRM B,(B) ; SMASH IN RELOCATION + MOVSI D,400000 + ANDCAM D,(B) ; CLEAR MARK BIT + JRST FIXTM5 + +FIXTM3: MOVE 0,(P) + HRRM 0,-1(B) + MOVEM B,(P) ; FIX UP CHAIN + JRST FIXTM5 + + + +IAGC": + +;SET FLAG FOR INTERRUPT HANDLER + SETZB M,RCL ; CLEAR OUT RECYCLE LIST CELLS, AND RSUBR BASE PNTR + EXCH P,GCPDL ; IN CASE CURRENT PDL LOSES + PUSH P,B + PUSH P,A + PUSH P,C ; SAVE C + +; HERE TO CLEAN UP ANY POSSIBLE PURENESS IN GC SPACE BEFORE COLLECTING + + + + MOVE A,NOWFRE + ADD A,GCSTOP ; ADJUSTMENT TO KEEP FREE REAL + SUB A,FRETOP + MOVEM A,NOWFRE + MOVE A,NOWP ; ADJUSTMENTS FOR STACKS + SUB A,CURP + MOVEM A,NOWP + MOVE A,NOWTP + SUB A,CURTP + MOVEM A,NOWTP + + MOVEI B,[ASCIZ /GIN /] + SKIPE GCMONF ; MONITORING + PUSHJ P,MSGTYP +NOMON1: HRRZ C,(P) ; GET CAUSE OF GC INDICATOR + MOVE B,GCNO(C) ; ADD 1 TO COUNT OF GC'S CAUSED BY GIVEN REASON + ADDI B,1 + MOVEM B,GCNO(C) + MOVEM C,GCCAUS ; SAVE CAUSE OF GC + SKIPN GCMONF ; MONITORING + JRST NOMON2 + MOVE B,MSGGCT(C) ; GET CAUSE MESSAGE + PUSHJ P,MSGTYP +NOMON2: HLRZ C,(P) ; FIND OUT WHO CAUSED THE GC + MOVEM C,GCCALL ; SAVE CALLER OF GC + SKIPN GCMONF ; MONITORING + JRST NOMON3 + MOVE B,MSGGFT(C) + PUSHJ P,MSGTYP +NOMON3: SUB P,[1,,1] ; POP OFF C + POP P,A + POP P,B + EXCH P,GCPDL + JRST .+1 +IAAGC: + HLLZS SQUPNT ; FLUSH SQUOZE TABLE + SETZB M,RCL ; ALTERNATE GC-ENTRY POINT FOR INITIALIZATION +INITGC: SETOM GCFLG + SETZM RCLV + +;SAVE AC'S + EXCH PVP,PVSTOR+1 + IRP AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM] + MOVEM AC,AC!STO"+1(PVP) + TERMIN + + MOVE 0,PVSTOR+1 + MOVEM 0,PVPSTO+1(PVP) + MOVEM PVP,PVSTOR+1 + MOVE D,DSTORE + MOVEM D,DSTO(PVP) + JSP E,CKPUR ; CHECK FOR PURE RSUBR + + +;SET UP E TO POINT TO TYPE VECTOR + GETYP E,TYPVEC + CAIE E,TVEC + JRST AGCE1 + HRRZ TYPNT,TYPVEC+1 + HRLI TYPNT,B + +CHPDL: MOVE D,P ; SAVE FOR LATER +CORGET: MOVE P,[-2000,,MRKPDL] + +;FENCE POST PDLS AND CHECK IF ANY SHOULD BE SHRUNK + + MOVEI A,(TB) ;POINT TO CURRENT FRAME IN PROCESS + PUSHJ P,FRMUNG ;AND MUNG IT + MOVE A,TP ;THEN TEMPORARY PDL + PUSHJ P,PDLCHK + MOVE PVP,PVSTOR+1 + MOVE A,PSTO+1(PVP) ;AND UNMARKED P STACK + PUSHJ P,PDLCHP + + ; FIRST CREATE INFERIOR TO HOLD NEW PAGES + +INFCRT: MOVE A,PARBOT ; GENERATE NEW PARBOT AND PARNEW + ADD A,PARNEW + ADDI A,1777 + ANDCMI A,1777 ; EVEN PAGE BOUNDARY + HRRM A,BOTNEW ; INTO POINTER WORD + HRRZM A,FNTBOT + SETZM WNDBOT + SETZM WNDTOP + MOVEM A,NPARBO + HRRZ A,BOTNEW ; GET PAGE TO START INF AT + ASH A,-10. ; TO PAGES + MOVEI R,(A) ; COPY A + PUSHJ P,%GCJOB ; GET PAGE HOLDER + MOVSI FPTR,-2000 ; FIX UP FRONTIER POINTER + MOVE A,WNDBOT + ADDI A,2000 ; FIND WNDTOP + MOVEM A,WNDTOP + +;MARK PHASE: MARK ALL LISTS AND VECTORS +;POINTED TO WITH ONE BIT IN SIGN BIT +;START AT TRANSFER VECTOR +NOMAP: MOVE A,GLOBSP+1 ; GET GLOBSP TO SAVE + MOVEM A,GCGBSP + MOVE A,ASOVEC+1 ; ALSO SAVE FOR USE BY GC + MOVEM A,GCASOV + MOVE A,NODES+1 ; SAVE FOR ASSOCIATION UPDATE AND MOVEMENT PHASE + MOVEM A,GCNOD + MOVE A,GLOTOP+1 ; GET GLOTOP FOR LOCR HACKS + MOVEM A,GLTOP + MOVE A,PURVEC+1 ; SAVE PURE VECTOR FOR GETPAG + MOVEM A,PURSVT + MOVE A,HASHTB+1 + MOVEM A,GCHSHT + + SETZ LPVP, ;CLEAR NUMBER OF PAIRS + MOVE 0,NGCS ; SEE IF NEED HAIR + SOSGE GCHAIR + MOVEM 0,GCHAIR ; RESUME COUNTING + MOVSI D,400000 ;SIGN BIT FOR MARKING + MOVE A,ASOVEC+1 ;MARK ASSOC. VECTOR NOW + PUSHJ P,PRMRK ; PRE-MARK + MOVE A,GLOBSP+1 + PUSHJ P,PRMRK + MOVE A,HASHTB+1 + PUSHJ P,PRMRK +OFFSET 0 + + MOVE A,IMQUOTE THIS-PROCESS + +OFFSET OFFS + + MOVEM A,GCATM + +; HAIR TO DO AUTO CHANNEL CLOSE + + MOVEI 0,N.CHNS-1 ; NUMBER OF CHANNELS + MOVEI A,CHNL1 ; 1ST SLOT + + SKIPE 1(A) ; NOW A CHANNEL? + SETZM (A) ; DON'T MARK AS CHANNELS + ADDI A,2 + SOJG 0,.-3 + + MOVEI C,PVSTOR + MOVEI B,TPVP + MOVE A,PVSTOR+1 ; MARK MAIN PROCES EVEN IF SWAPPED OUT + PUSHJ P,MARK + MOVEI C,MAINPR-1 + MOVEI B,TPVP + MOVE A,MAINPR ; MARK MAIN PROCES EVEN IF SWAPPED OUT + PUSHJ P,MARK + MOVEM A,MAINPR ; ADJUST PTR + +; ASSOCIATION AND VALUE FLUSHING PHASE + + SKIPN GCHAIR ; ONLY IF HAIR + PUSHJ P,VALFLS + + SKIPN GCHAIR + PUSHJ P,ATCLEA ; CLEAN UP ATOM TABLE + + SKIPE GCHAIR ; IF NOT HAIR, DO CHANNELS NOW + PUSHJ P,CHNFLS + + PUSHJ P,ASSOUP ; UPDATE AND MOVE ASSOCIATIONS + PUSHJ P,CHFIX ; SEND OUT CHANNELS AND MARK LOSERS + PUSHJ P,STOGC ; FIX UP FROZEN WORLD + MOVE P,GCPDL ; SWITCH PDLS IN CASE THIS ONE DISSAPPEARS + + + MOVE A,NPARBO ; UPDATE GCSBOT + MOVEM A,GCSBOT + MOVE A,PURSVT + PUSH P,PURVEC+1 + MOVEM A,PURVEC+1 ; RESTORE PURVEC + PUSHJ P,CORADJ ; ADJUST CORE SIZE + POP P,PURVEC+1 + + + + ; MAP NEW PAIR SPACE IN FOR PAIR SPACE UPDATE + +NOMAP1: MOVEI A,@BOTNEW + ADDI A,1777 ; TO PAGE BOUNDRY + ANDCMI A,1777 + MOVE B,A +DOMAP: ASH B,-10. ; TO PAGES + MOVE A,PARBOT + MOVEI C,(A) ; COMPUTE HIS TOP + ASH C,-10. + ASH A,-10. + SUBM A,B ; B==> - # OF PAGES + HRLI A,(B) ; AOBJN TO SOURCE AND DEST + MOVE B,A ; IN CASE OF FUNNY + HRRI B,(C) ; MAP HIS POSSIBLE HIGHER OR LOWER PAGES + PUSHJ P,%INFMP ; NOW FLUSH INF AND MAKE HIS CORE MINE + JRST GARZER + + ; CORE ADJUSTMENT PHASE + +CORADJ: MOVE A,PURTOP + SUB A,CURPLN ; ADJUST FOR RSUBR + ANDCMI A,1777 ; ROUND DOWN + MOVEM A,RPTOP + MOVEI A,@BOTNEW ; NEW GCSTOP + ADDI A,1777 ; GCPDL AND ROUND + ANDCMI A,1777 ; TO PAGE BOUNDRY + MOVEM A,CORTOP ; TAKE CARE OF POSSIBLE LATER LOSSAGE + CAMLE A,RPTOP ; SEE IF WE CAN MAP THE WORLD BACK IN + FATAL AGC--UNABLE TO MAP GC-SPACE INTO CORE + CAMG A,PURBOT ; SEE IF WE HAVE TO PUNT SOME PURE TO DO IT + JRST CORAD0 ; DON'T HAVE TO PUNT SOME PURE + PUSHJ P,MAPOUT ; GET THE CORE + FATAL AGC--PAGES NOT AVAILABLE + +; NOW THAT WE ARE ABLE TO MAP TO GCS INTO CORE WE WILL TRY TO HONOR SOME REQUESTS +; FIRST LETS SEE IF WE HAVE TO CORE DOWN. +; GCDOWN IS DEFINED AS AMOUNT FROM FRETOP TO PURBOT NEEDED + +CORAD0: SKIPN B,GCDOWN ; CORE DOWN? + JRST CORAD1 ; NO, LETS GET CORE REQUIREMENTS + ADDI A,(B) ; AMOUNT+ONE FREE BLOCK + CAMGE A,RPTOP ; CAN WE WIN + JRST CORAD3 ; POSSIBLY + +; THIS IS A EXIT FOR LOSSAGE WITHOUT A FATAL ERROR +CORAD2: SETOM GCDANG ; INDICATE LOSSAGE + +; CALCULATE PARAMETERS BEFORE LEAVING +CORAD6: MOVE A,PURSVT ; GET PURE TABLE + PUSHJ P,SPCOUT ; OUT IT GOES IN CASE IT WAS CHANGED + MOVEI A,@BOTNEW ; GCSTOP + MOVEM A,GCSTOP + MOVE A,CORTOP ; ADJUST CORE IMAGE + ASH A,-10. ; TO PAGES +TRYPCO: PUSHJ P,P.CORE + FATAL AGC--CORE SCREW UP + MOVE A,CORTOP ; GET IT BACK + ANDCMI A,1777 + MOVEM A,FRETOP + MOVEM A,RFRETP + POPJ P, + +; TRIES TO SATISFY REQUEST FOR CORE +CORAD1: MOVEM A,CORTOP + MOVEI A,@BOTNEW + ADD A,GETNUM ; ADD MINIMUM CORE NEEDED + ADDI A,1777 ; ONE BLOCK+ROUND + ANDCMI A,1777 ; TO BLOCK BOUNDRY + CAMLE A,RPTOP ; CAN WE WIN + JRST CORAD2 ; LOSE + CAMGE A,PURBOT + JRST CORAD7 ; DON'T HAVE TO MAP OUT PURE + PUSHJ P,MAPOUT + JRST CORAD2 ; LOSS + +; NOW TRY TO GET SLOP SPACE. NOT NECESSARY BUT NICE +CORAD7: MOVEM A,CORTOP ; STORE POSSIBLE VALUE + MOVE B,RPTOP ; GET REAL PURTOP + SUB B,PURMIN ; KEEP PURMIN + CAMG B,CORTOP ; SEE IF CORTOP IS ALREADY HIGH + MOVE B,CORTOP ; DONT GIVE BACK WHAT WE GOT + MOVEM B,RPTOP ; FOOL CORE HACKING + ADD A,FREMIN + ANDCMI A,1777 ; TO PAGE BOUNDRY + CAMGE A,RPTOP ; DO WE WIN TOTALLY + JRST CORAD4 + MOVE A,RPTOP ; GET AS MUCH CORE AS POSSIBLE + PUSHJ P,MAPOUT + JRST CORAD6 ; LOSE, BUT YOU CAN'T HAVE EVERYTHING +CORAD4: CAMG A,PURBOT ; DO WE HAVE TO PUNT SOME PURE + JRST CORAD8 + PUSHJ P,MAPOUT ; GET IT + JRST CORAD6 +CORAD8: MOVEM A,CORTOP ; ADJUST PARAMETER + JRST CORAD6 ; WIN TOTALLY + +; WE CAN CORE DOWN NOW TO SEE IF WE CAN GET SOME SLOP SPACE + +CORAD3: ADD A,FREMIN + ANDCMI A,1777 + CAMGE A,PURBOT ; CAN WE WIN + JRST CORAD9 + MOVE A,RPTOP +CORAD9: SUB A,GCDOWN ; SATISFY GCDOWN REQUEST + JRST CORAD4 ; GO CHECK ALLOCATION + +MAPOUT: PUSH P,A ; SAVE A + SUB A,P.TOP ; AMOUNT TO GET + ADDI A,1777 ; ROUND + ANDCMI A,1777 ; TO PAGE BOUNDRY + ASH A,-PGSZ ; TO PAGES + PUSHJ P,GETPAG ; GET THEN + JRST MAPLOS ; LOSSAGE + AOS -1(P) ; INDICATE WINNAGE +MAPLOS: POP P,A + POPJ P, + + + ;GARBAGE ZEROING PHASE +GARZER: MOVE A,GCSTOP ;FIRST WORD OF GARBAGE IS AFTER PAIR SPACE + MOVE B,FRETOP ;LAST ADDRESS OF GARBAGE + 1 + CAIL A,(B) + JRST GARZR1 + CLEARM (A) ;ZERO THE FIRST WORD + CAIL A,-1(B) ; ARE WE AT THE TOP OF THE WORLD (FORMERLY CAML A,FRETOP) + JRST GARZR1 ; DON'T BLT +IFE ITS,[ + MOVEI B,777(A) + ANDCMI B,777 +] + HRLS A + ADDI A,1 ;MAKE A A BLT POINTER + BLT A,-1(B) ;AND COPY ZEROES INTO REST OF AREA +IFE ITS,[ + +; MAP UNWANTED PAGES OUT ON TWENEX (AFTER ZEROING REST OF LAST PAGE) + + MOVE D,PURBOT + ASH D,-PGSZ + ASH B,-PGSZ + MOVNI A,1 + MOVEI C,0 + HRLI B,400000 + +GARZR2: CAIG D,(B) + JRST GARZR1 + + PMAP + AOJA B,GARZR2 +] + + +; NOW REHASH THE ASSOCIATIONS BASED ON VALUES +GARZR1: PUSHJ P,REHASH + + + ;RESTORE AC'S +TRYCOX: SKIPN GCMONF + JRST NOMONO + MOVEI B,[ASCIZ /GOUT /] + PUSHJ P,MSGTYP +NOMONO: MOVE PVP,PVSTOR+1 + IRP AC,,[0,A,B,C,D,E,P,R,M,SP,TP,TB,AB,TVP,FRM] + MOVE AC,AC!STO+1(PVP) + TERMIN + SKIPN DSTORE + SETZM DSTO(PVP) + MOVE PVP,PVPSTO+1(PVP) + +; CLOSING ROUTINE FOR G-C + PUSH P,A ; SAVE AC'C + PUSH P,B + PUSH P,C + PUSH P,D + + MOVE A,FRETOP ; ADJUST BLOAT-STAT PARAMETERS + SUB A,GCSTOP + ADDM A,NOWFRE + PUSHJ P,GCSET ; FIX UP BLOAT-STAT PARAMETERS + MOVE A,CURTP + ADDM A,NOWTP + MOVE A,CURP + ADDM A,NOWP + + PUSHJ P,CTIME + FSBR B,GCTIM ; GET TIME ELAPSED + SKIPN INBLOT ; STORE TIME ONLY IF NO RETRY + SKIPN GCDANG + MOVEM B,GCTIM ; SAVE ELAPSED TIME FOR INT-HANDLER + SKIPN GCMONF ; SEE IF MONITORING + JRST GCCONT + PUSHJ P,FIXSEN ; OUTPUT TIME + MOVEI A,15 ; OUTPUT C/R LINE-FEED + PUSHJ P,IMTYO + MOVEI A,12 + PUSHJ P,IMTYO +GCCONT: MOVE C,[NTPGOO,,NTPMAX] ; MAY FIX UP TP PARAMS TO ENCOURAGE + ; SHRINKAGE FOR EXTRA ROOM + SKIPE GCDANG + MOVE C,[ETPGOO,,ETPMAX] + HLRZM C,TPGOOD + HRRZM C,TPMAX + POP P,D ; RESTORE AC'C + POP P,C + POP P,B + POP P,A + MOVE A,GCDANG + JUMPE A,AGCWIN ; IF ZERO THE GC WORKED + SKIPN GCHAIR ; SEE IF HAIRY GC + JRST BTEST +REAGCX: MOVEI A,1 ; PREPARE FOR A HAIRY GC + MOVEM A,GCHAIR + SETZM GCDANG + MOVE C,[11,,10.] ; REASON FOR GC + JRST IAGC + +BTEST: SKIPE INBLOT + JRST AGCWIN + FATAL AGC--NO CORE AVAILABLE TO SATISFY REQUESTS + JRST REAGCX + +AGCWIN: SETZM PARNEW ;CLEAR FOR NEXT AGC CALL + SETZM GETNUM ;ALSO CLEAR THIS + SETZM INBLOT + SETZM GCFLG + + SETZM PGROW ; CLEAR GROWTH + SETZM TPGROW + SETOM GCHAPN ; INDICATE A GC HAS HAPPENED + SETOM GCHPN + SETOM INTFLG ; AND REQUEST AN INTERRUPT + SETZM GCDOWN + PUSHJ P,RBLDM +; JUMPE R,FINAGC +; JUMPN M,FINAGC ; IF M 0, RUNNING RSUBR SWAPPED OUT +; SKIPE PLODR ; LOADING ONE, M = 0 IS OK + JRST FINAGC + + FATAL AGC--RUNNING RSUBR WENT AWAY + +AGCE1: FATAL AGC--TYPE VECTOR NOT OF TYPE VECTOR + + ; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL +; POINT. + +FIXSEN: PUSH P,B ; SAVE TIME + MOVEI B,[ASCIZ /TIME= /] + PUSHJ P,MSGTYP ; PRINT OUT MESSAGE + POP P,B ; RESTORE B + FMPRI B,(100.0) ; CONVERT TO FIX + MULI B,400 + TSC B,B + ASH C,-163.(B) + MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME + PUSH P,C + IDIVI C,10. ; START COUNTING + JUMPLE C,.+2 + AOJA A,.-2 + POP P,C + CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER + JRST DOT1 +FIXOUT: IDIVI C,10. ; RECOVER NUMBER + HRLM D,(P) + SKIPE C + PUSHJ P,FIXOUT + PUSH P,A ; SAVE A + CAIN A,2 ; DECIMAL POINT HERE? + JRST DOT2 +FIX1: HLRZ A,(P)-1 ; GET NUMBER + ADDI A,60 ; MAKE IT A CHARACTER + PUSHJ P,IMTYO ; OUT IT GOES + POP P,A + SOJ A, + POPJ P, +DOT1: MOVEI A,". ; OUTPUT DECIMAL POINT AND PADDING 0 + PUSHJ P,IMTYO + MOVEI A,"0 + PUSHJ P,IMTYO + JRST FIXOUT ; CONTINUE +DOT2: MOVEI A,". ; OUTPUT DECIMAL POINT + PUSHJ P,IMTYO + JRST FIX1 + + + ; SUBROUTINE TO CHECK SIZE OF PDLS AND DO FENCEPOSTING + +PDLCHK: JUMPGE A,CPOPJ + HLRE B,A ;GET NEGATIVE COUNT + MOVE C,A ;SAVE A COPY OF PDL POINTER + SUBI A,-1(B) ;LOCATE DOPE WORD PAIR + HRRZS A ; ISOLATE POINTER + CAME A,TPGROW ;GROWING? + ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD + MOVMS B + CAIN A,2(C) + JRST NOFENC + SETOM 1(C) ; START FENECE POST + CAIN A,3(C) + JRST NOFENC + MOVSI D,1(C) ;YES, SET UP TO BLT FENCE POSTS + HRRI D,2(C) + BLT D,-2(A) ;FENCE POST ALL EXCEPT DOPE WORDS + + +NOFENC: CAMG B,TPMAX ;NOW CHECK SIZE + CAMG B,TPMIN + JRST MUNGTP ;TOO BIG OR TOO SMALL + POPJ P, + +MUNGTP: SUB B,TPGOOD ;FIND DELTA TP +MUNG3: MOVE C,-1(A) ;IS GROWTH ALREADY SPECIFIED + TRNE C,777000 ;SKIP IF NOT + POPJ P, ;ASSUME GROWTH GIVEN WILL WIN + + ASH B,-6 ;CONVERT TO NUMBER OF BLOCKS + JUMPLE B,MUNGT1 + CAILE B,377 ; SKIP IF BELOW MAX + MOVEI B,377 ; ELSE USE MAX + TRO B,400 ;TURN ON SHRINK BIT + JRST MUNGT2 +MUNGT1: MOVMS B + ANDI B,377 +MUNGT2: DPB B,[111100,,-1(A)] ;STORE IN DOPE WORD + POPJ P, + +; CHECK UNMARKED STACK (NO NEED TO FENCE POST) + +PDLCHP: HLRE B,A ;-LENGTH TO B + MOVE C,A + SUBI A,-1(B) ;POINT TO DOPE WORD + HRRZS A ;ISOLATE POINTER + CAME A,PGROW ;GROWING? + ADDI A,PDLBUF ;NO, POINT TO REAL DOPE WORD + MOVMS B + CAIN A,2(C) + JRST NOPF + SETOM 1(C) ; START FENECE POST + CAIN A,3(C) + JRST NOPF + MOVSI D,1(C) + HRRI D,2(C) + BLT D,-2(A) + +NOPF: CAMG B,PMAX ;TOO BIG? + CAMG B,PMIN ;OR TOO LITTLE + JRST .+2 ;YES, MUNG IT + POPJ P, + SUB B,PGOOD + JRST MUNG3 + + +; ROUTINE TO PRE MARK SPECIAL HACKS + +PRMRK: SKIPE GCHAIR ; FLUSH IF NO HAIR + POPJ P, +PRMRK2: HLRE B,A + SUBI A,(B) ;POINT TO DOPE WORD + HLRZ F,1(A) ; GET LNTH + LDB 0,[111100,,(A)] ; GET GROWTHS + TRZE 0,400 ; SIGN HACK + MOVNS 0 + ASH 0,6 ; TO WORDS + ADD F,0 + LDB 0,[001100,,(A)] + TRZE 0,400 + MOVNS 0 + ASH 0,6 + ADD F,0 + PUSHJ P,ALLOGC + HRRM 0,1(A) ; NEW RELOCATION FIELD + IORM D,1(A) ;AND MARK + POPJ P, + + + ;GENERAL MARK SUBROUTINE. CALLED TO MARK ALL THINGS +; A/ GOODIE TO MARK FROM +; B/ TYPE OF A (IN RH) +; C/ TYPE,DATUM PAIR POINTER + +MARK2A: +MARK2: HLRZ B,(C) ;GET TYPE +MARK1: MOVE A,1(C) ;GET GOODIE +MARK: SKIPN DUMFLG + JUMPE A,CPOPJ ; NEVER MARK 0 + MOVEI 0,1(A) + CAIL 0,@PURBOT + JRST GCRETD +MARCON: PUSH P,A + HRLM C,-1(P) ;AND POINTER TO IT + ANDI B,TYPMSK ; FLUSH MONITORS + SKIPE DUMFLG ; SKIP IF NOT IN DUMPER + PUSHJ P,TYPHK ; HACK SOME TYPES + LSH B,1 ;TIMES 2 TO GET SAT + HRRZ B,@TYPNT ;GET SAT + ANDI B,SATMSK + JUMPE A,GCRET + CAILE B,NUMSAT ; SKIP IF TEMPLATE DATA + JRST TD.MRK + SKIPN GCDFLG +IFN ITS,[ + JRST @MKTBS(B) ;AND GO MARK + JRST @GCDISP(B) ; DISPATCH FOR DUMPERS +] +IFE ITS,[ + SKIPA E,MKTBS(B) + MOVE E,GCDISP(B) + HRLI E,-1 + JRST (E) +] +; HERE TO MARK A POSSIBLE DEFER POINTER + +DEFQMK: GETYP B,(A) ; GET ITS TYPE + LSH B,1 + HRRZ B,@TYPNT + ANDI B,SATMSK ; AND TO SAT + SKIPGE MKTBS(B) + +;HERE TO MARK THAT WHICH IS POINTED TO BY A DEFERRED POINTER + +DEFMK: TLOA TYPNT,400000 ;USE SIGN BIT AS FLAG + +;HERE TO MARK LIST ELEMENTS + +PAIRMK: TLZ TYPNT,400000 ;TURN OF DEFER BIT + PUSH P,[0] ; WILL HOLD BACK PNTR + MOVEI C,(A) ; POINT TO LIST +PAIRM1: CAMGE C,PARTOP ;CHECK FOR BEING IN BOUNDS + CAMGE C,PARBOT + FATAL AGC--MARKED PAIR OUTSIDE PAIR SPACE + SKIPGE B,(C) ;SKIP IF NOT MARKED + JRST RETNEW ;ALREADY MARKED, RETURN + IORM D,(C) ;MARK IT + SKIPL FPTR ; SEE IF IN FRONTEIR + PUSHJ P,MOVFNT ; EXPAND THE FRONTEIR + MOVEM B,FRONT(FPTR) + MOVE 0,1(C) ; AND 2D + AOBJN FPTR,.+2 ; AOS AND CHECK FRONTEIR + PUSHJ P,MOVFNT ; EXPAND FRONTEIR + MOVEM 0,FRONT(FPTR) + ADD FPTR,[1,,1] ; MOVE ALONG IN FRONTIER + + +PAIRM2: MOVEI A,@BOTNEW ; GET INF ADDR + SUBI A,2 + HRRM A,(C) ; LEAVE A POINTER TO NEW HOME + HRRZ E,(P) ; GET BACK POINTER + JUMPE E,PAIRM7 ; 1ST ONE, NEW FIXUP + MOVSI 0,(HRRM) ; INS FOR CLOBBER + PUSHJ P,SMINF ; SMASH INF'S CORE IMAGE +PAIRM4: MOVEM A,(P) ; NEW BACK POINTER + JUMPL TYPNT,DEFDO ;GO HANDLE DEFERRED POINTER + HRLM B,(P) ; SAVE OLD CDR + PUSHJ P,MARK2 ;MARK THIS DATUM + HRRZ E,(P) ; SMASH CAR IN CASE CHANGED + ADDI E,1 + MOVSI 0,(MOVEM) + PUSHJ P,SMINF + HLRZ C,(P) ;GET CDR OF LIST + CAIGE C,@PURBOT ; SKIP IF PURE (I.E. DONT MARK) + JUMPN C,PAIRM1 ;IF NOT NIL, MARK IT +GCRETP: SUB P,[1,,1] + +GCRET: TLZ TYPNT,400000 ;FOR PAIRMKS BENEFIT + HLRZ C,-1(P) ;RESTORE C + POP P,A + POPJ P, ;AND RETURN TO CALLER + +GCRETD: ANDI B,TYPMSK ; TURN OFF MONITORS + CAIN B,TLOCR ; SEE IF A LOCR + JRST MARCON + SKIPN GCDFLG ; SKIP IF IN PURIFIER OR DUMPER + POPJ P, + CAIE B,TATOM ; WE MARK PURE ATOMS + CAIN B,TCHSTR ; AND STRINGS + JRST MARCON + POPJ P, + +;HERE TO MARK DEFERRED POINTER + +DEFDO: PUSH P,B ; PUSH OLD PAIR ON STACK + PUSH P,1(C) + MOVEI C,-1(P) ; USE AS NEW DATUM + PUSHJ P,MARK2 ;MARK THE DATUM + HRRZ E,-2(P) ; GET POINTER IN INF CORE + ADDI E,1 + MOVSI 0,(MOVEM) + PUSHJ P,SMINF ; AND CLOBBER + HRRZ E,-2(P) + MOVE A,-1(P) + MOVSI 0,(HRRM) ; SMASH IN RIGHT HALF + PUSHJ P,SMINF + SUB P,[3,,3] + JRST GCRET ;AND RETURN + + +PAIRM7: MOVEM A,-1(P) ; SAVE NEW VAL FOR RETURN + JRST PAIRM4 + +RETNEW: HRRZ A,(C) ; POINT TO NEW WORLD LOCN + HRRZ E,(P) ; BACK POINTER + JUMPE E,RETNW1 ; NONE + MOVSI 0,(HRRM) + PUSHJ P,SMINF + JRST GCRETP + +RETNW1: MOVEM A,-1(P) + JRST GCRETP + +; ROUTINE TO EXPAND THE FRONTEIR + +MOVFNT: PUSH P,B ; SAVE REG B + HRRZ A,BOTNEW ; CURRENT BOTTOM OF WINDOW + ADDI A,2000 ; MOVE IT UP + HRRM A,BOTNEW + HRRZM A,FNTBOT ; BOTTOM OF FRONTEIR + MOVEI B,FRNP + ASH A,-10. ; TO PAGES + PUSHJ P,%GETIP + PUSHJ P,%SHWND ; SHARE THE PAGE + MOVSI FPTR,-2000 ; FIX UP FPTR + POP P,B + POPJ P, + + +; ROUTINE TO SMASH INFERIORS PPAGES +; E/ ADDR IN INF, A/ THING TO SMASH ,0/ INS TO USE + +SMINF: CAMGE E,FNTBOT + JRST SMINF1 ; NOT IN FRONTEIR + SUB E,FNTBOT ; ADJUST POINTER + IOR 0,[0 A,FRONT(E)] ; BUILD INSTRUCTION + XCT 0 ; XCT IT + POPJ P, ; EXIT +SMINF1: CAML E,WNDBOT + CAML E,WNDTOP ; SEE IF IN WINDOW + JRST SMINF2 +SMINF3: SUB E,WNDBOT ; FIX UP + IOR 0,[0 A,WIND(E)] ; FIX INS + XCT 0 + POPJ P, +SMINF2: PUSH P,A ; SAVE E + PUSH P,B ; SAVE B + HRRZ A,E ; E SOMETIMES HAS STUFF IN LH + ASH A,-10. + MOVEI B,WNDP ; WINDOW PAGE + PUSHJ P,%SHWND ; SHARE IT + ASH A,10. ; TO PAGES + MOVEM A,WNDBOT ; UPDATE POINTERS + ADDI A,2000 + MOVEM A,WNDTOP + POP P,B ; RESTORE ACS + POP P,A + JRST SMINF3 ; FIX UP INF + + + + ; VECTOR AND TP MARKER, SIGN OF TYPNT IS SET BASED ON WHICH ONE + +TPMK: TLOA TYPNT,400000 ;SET TP MARK FLAG +VECTMK: TLZ TYPNT,400000 + MOVEI 0,@BOTNEW ; POINTER TO INF + PUSH P,0 + MOVEI E,(A) ;SAVE A POINTER TO THE VECTOR + HLRE B,A ;GET -LNTH + SUB A,B ;LOCATE DOPE WORD + MOVEI A,1(A) ;ZERO LH AND POINT TO 2ND DOPE WORD + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST VECTB1 ;LOSE, COMPLAIN + + HLLM TYPNT,(P) ; SAVE MARKER INDICATING STACK + JUMPGE TYPNT,NOBUFR ;IF A VECTOR, NO BUFFER CHECK + CAME A,PGROW ;IS THIS THE BLOWN P + CAMN A,TPGROW ;IS THIS THE GROWING PDL + JRST NOBUFR ;YES, DONT ADD BUFFER + ADDI A,PDLBUF ;POINT TO REAL DOPE WORD + MOVSI 0,-PDLBUF ;ALSO FIX UP POINTER + ADD 0,1(C) + MOVEM 0,-1(P) ; FIXUP RET'D PNTR + +NOBUFR: HLRE B,(A) ;GET LENGTH FROM DOPE WORD + JUMPL B,EXVECT ; MARKED, LEAVE + LDB B,[111100,,-1(A)] ; GET TOP GROWTH + TRZE B,400 ; HACK SIGN BIT + MOVNS B + ASH B,6 ; CONVERT TO WORDS + PUSH P,B ; SAVE TOP GROWTH + LDB 0,[001100,,-1(A)] ;GET GROWTH FACTOR + TRZE 0,400 ;KILL SIGN BIT AND SKIP IF + + MOVNS 0 ;NEGATE + ASH 0,6 ;CONVERT TO NUMBER OF WORDS + PUSH P,0 ; SAVE BOTTOM GROWTH + ADD B,0 ;TOTAL GROWTH TO B +VECOK: HLRE E,(A) ;GET LENGTH AND MARKING + MOVEI F,(E) ;SAVE A COPY + ADD F,B ;ADD GROWTH + SUBI E,2 ;- DOPE WORD LENGTH + IORM D,(A) ;MAKE SURE NOW MARKED + PUSHJ P,ALLOGC ; ALLOCATE SPACE FOR VECTOR IN THE INF + HRRM 0,(A) +VECOK1: JUMPLE E,MOVEC2 ; ZERO LENGTH, LEAVE + PUSH P,A ; SAVE POINTER TO DOPE WORD + SKIPGE B,-1(A) ;SKIP IF UNIFORM + TLNE B,377777-.VECT. ;SKIP IF NOT SPECIAL + JUMPGE TYPNT,NOTGEN ;JUMP IF NOT A GENERAL VECTOR + +GENRAL: HLRZ 0,B ;CHECK FOR PSTACK + TRZ 0,.VECT. + JUMPE 0,NOTGEN ;IT ISN'T GENERAL + JUMPL TYPNT,TPMK1 ; JUMP IF TP + MOVEI C,(A) + SUBI C,1(E) ; C POINTS TO BEGINNING OF VECTOR + + ; LOOP TO MARK ELEMENTS IN A GENERAL VECTOR +VECTM2: HLRE B,(C) ;GET TYPE AND MARKING + JUMPL B,UMOVEC ;RETURN, (EITHER DOPE WORD OR FENCE POST) + MOVE A,1(C) ;DATUM TO A + + +VECTM3: PUSHJ P,MARK ;MARK DATUM + MOVEM A,1(C) ; IN CASE WAS FIXED +VECTM4: ADDI C,2 + JRST VECTM2 + +UMOVEC: POP P,A +MOVEC2: POP P,C ; RESTORE BOTTOM GROWTH + HRRZ E,-1(P) ; GET POINTER INTO INF + SKIPN C ; SKIP IF NO BOTTOM GROWTH + JRST MOVEC3 + JUMPL C,.+3 ; SEE IF BOTTOM SHRINKAGE + ADD E,C ; GROW IT + JRST MOVEC3 ; CONTINUE + HRLM C,E ; MOVE SHRINKAGE FOR TRANSFER PHASE +MOVEC3: PUSHJ P,DOPMOD ; MODIFY DOPE WORD AND PLACE IN INF + PUSHJ P,TRBLKV ; SEND VECTOR INTO INF +TGROT: CAMGE A,PARBOT ; SKIP IF NOT STORAGE + JRST TGROT1 + MOVE C,DOPSV1 ; RESTORE DOPE WORD + SKIPN (P) ; DON'T RESTORE D.W.'S YET IF THERE IS GROWTH + MOVEM C,-1(A) +TGROT1: POP P,C ; IS THERE TOP GROWH + SKIPN C ; SEE IF ANY GROWTH + JRST DOPEAD + SUBI E,2 + SKIPG C + JRST OUTDOP + PUSH P,C ; SAVE C + SETZ C, ; ZERO C + PUSHJ P,ADWD + ADDI E,1 + SETZ C, ; ZERO WHERE OLD DOPE WORDS WERE + PUSHJ P,ADWD + POP P,C + ADDI E,-1(C) ; MAKE ADJUSTMENT FOR TOP GROWTH +OUTDOP: PUSHJ P,DOPOUT +DOPEAD: +EXVECT: HLRZ B,(P) + SUB P,[1,,1] ; GET RID OF FPTR + PUSHJ P,RELATE ; RELATIVIZE + TRNN B,400000 ; WAS THIS A STACK + JRST GCRET + MOVSI 0,PDLBUF ; FIX UP STACK PTR + ADDM 0,(P) + JRST GCRET ; EXIT + +VECLOS: JUMPL C,CCRET ;JUMP IF CAN'T MUNG TYPE + HLLZ 0,(C) ;GET TYPE + MOVEI B,TILLEG ;GET ILLEGAL TYPE + HRLM B,(C) + MOVEM 0,1(C) ;AND STORE OLD TYPE AS VALUE + JRST UMOVEC ;RETURN WITHOUT MARKING VECTOR + +CCRET: CLEARM 1(C) ;CLOBBER THE DATUM + JRST GCRET + + +; ROUTINE TO MARK A TP. IT SCANS THE TP. IT MARKS ALL THE ITEMS AND IT MAPS AN +; UPDATED VERSION INTO THE INFERIOR WITHOUT CHANGING THE ORIGINAL. + +TPMK1: +TPMK2: POP P,A + POP P,C + HRRZ E,-1(P) ; FIX UP PARAMS + ADDI E,(C) + PUSH P,A ; REPUSH A + HRRZ B,(A) ; CALCULATE RELOCATION + SUB B,A + MOVE C,-1(P) ; ADJUST FOR GROWTH + SUB B,C + HRLZS C + PUSH P,C + PUSH P,B + PUSH P,E + PUSH P,[0] +TPMK3: HLRZ E,(A) ; GET LENGTH + TRZ E,400000 ; GET RID OF MARK BIT + SUBI A,-1(E) ;POINT TO FIRST ELEMENT + MOVEI C,(A) ;POINT TO FIRST ELEMENT WITH C +TPMK4: HLRE B,(C) ;GET TYPE AND MARKING + JUMPL B,TPMK7 ;RETURN, (EITHER DOPE WORD OR FENCE POST) + HRRZ A,(C) ;DATUM TO A + ANDI B,TYPMSK ; FLUSH MONITORS + CAIE B,TCBLK + CAIN B,TENTRY ;IS THIS A STACK FRAME + JRST MFRAME ;YES, MARK IT + CAIE B,TUBIND ; BIND + CAIN B,TBIND ;OR A BINDING BLOCK + JRST MBIND + CAIE B,TBVL ; CHECK FOR OTHER BINDING HACKS + CAIN B,TUNWIN + SKIPA ; FIX UP SP-CHAIN + CAIN B,TSKIP ; OTHER BINDING HACK + PUSHJ P,FIXBND + + +TPMK5: PUSH P,(C) ; SAVE BECAUSE FRAMES MIGHT MUNG IT + HRRM A,(C) ; FIX UP IN CASE OF SP CHAIN + PUSHJ P,MARK1 ;MARK DATUM + MOVE R,A ; SAVE A + POP P,M + MOVE A,(C) + PUSHJ P,OUTTP ; MOVE OUT TYPE + MOVE A,R + PUSHJ P,OUTTP ; SEND OUT VALUE + MOVEM M,(C) ; RESTORE TO OLD VALUE +TPMK6: ADDI C,2 + JRST TPMK4 + +MFRAME: HRRZ 0,1(C) ; SET UP RELITIVIZATION OF PTR TO PREVIOUS FRAME + HRROI C,FRAMLN+FSAV-1(C) ;POINT TO FUNCTION + HRRZ A,1(C) ; GET IT + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST MFRAM1 ; IGNORE, NOT IN VECTOR SPACE + HRL A,(A) ; GET LENGTH + MOVEI B,TVEC + PUSHJ P,MARK ; AND MARK IT +MFRAM1: HLL A,1(C) + PUSHJ P,OUTTP ; SEND IT OUT + HRRZ A,OTBSAV-FSAV+1(C) ; POINT TO TB TO PREVIOUS FRAME + SKIPE A + ADD A,-2(P) ; RELOCATE IF NOT 0 + HLL A,2(C) + PUSHJ P,OUTTP ; SEND IT OUT + MOVE A,-2(P) ; ADJUST AB SLOT + ADD A,ABSAV-FSAV+1(C) ; POINT TO SAVED AB + PUSHJ P,OUTTP ; SEND IT OUT + MOVE A,-2(P) ; ADJUST SP SLOT + ADD A,SPSAV-FSAV+1(C) ;POINT TO SAVED SP + SUB A,-3(P) ; ADJUSTMENT OF LENGTH IF GROWTH + PUSHJ P,OUTTP ; SEND IT OUT + HRROI C,PSAV-FSAV(C) ;POINT TO SAVED P + MOVEI B,TPDL + PUSHJ P,MARK1 ;AND MARK IT + PUSHJ P,OUTTP ; SEND IT OUT + HLRE 0,TPSAV-PSAV+1(C) + MOVE A,TPSAV-PSAV+1(C) + SUB A,0 + MOVEI 0,1(A) + MOVE A,TPSAV-PSAV+1(C) + CAME 0,TPGROW ; SEE IF BLOWN + JRST MFRAM9 + MOVSI 0,PDLBUF + ADD A,0 +MFRAM9: ADD A,-2(P) + SUB A,-3(P) ; ADJUST + PUSHJ P,OUTTP + MOVE A,PCSAV-PSAV+1(C) + PUSHJ P,OUTTP + HRROI C,-PSAV+1(C) ; POINT PAST THE FRAME + JRST TPMK4 ;AND DO MORE MARKING + + +MBIND: PUSHJ P,FIXBND + MOVEI B,TATOM ;FIRST MARK ATOM + SKIPN GCHAIR ; IF NO HAIR, MARK ALL NOW + SKIPE (P) ; PASSED MARKER, IF SO DONT SKIP + JRST MBIND2 ; GO MARK + MOVE A,1(C) ; RESTORE A + CAME A,GCATM + JRST MBIND1 ; NOT IT, CONTINUE SKIPPING + HRRM LPVP,2(C) ; SAVE IN RH OF TPVP,,0 + MOVE 0,-4(P) ; RECOVER PTR TO DOPE WORD + HRLM 0,2(C) ; SAVE FOR MOVEMENT + MOVEI B,TATOM ; MARK THE BINDING TO THIS PROCESS + PUSHJ P,MARK1 ; MARK THE ATOM + MOVEI LPVP,(C) ; POINT + SETOM (P) ; INDICATE PASSAGE +MBIND1: ADDI C,6 ; SKIP BINDING + MOVEI 0,6 + SKIPE -1(P) ; ONLY UPDATE IF SENDING OVER + ADDM 0,-1(P) + JRST TPMK4 + +MBIND2: HLL A,(C) + PUSHJ P,OUTTP ; FIX UP CHAIN + MOVEI B,TATOM ; RESTORE IN CASE SMASHED + PUSHJ P,MARK1 ; MARK ATOM + PUSHJ P,OUTTP ; SEND IT OUT + ADDI C,2 + PUSH P,(C) ; SAVE BECAUSE FRAMES MIGHT MUNG IT + PUSHJ P,MARK2 ;MARK DATUM + MOVE R,A ; SAVE A + POP P,M + MOVE A,(C) + PUSHJ P,OUTTP ; MOVE OUT TYPE + MOVE A,R + PUSHJ P,OUTTP ; SEND OUT VALUE + MOVEM M,(C) ; RESTORE TO OLD VALUE + ADDI C,2 + MOVEI B,TLIST ; POINT TO DECL SPECS + HLRZ A,(C) + PUSHJ P,MARK ; AND MARK IT + HRR A,(C) ; LIST FIX UP + PUSHJ P,OUTTP + SKIPL A,1(C) ; PREV LOC? + JRST NOTLCI + MOVEI B,TLOCI ; NOW MARK LOCATIVE + PUSHJ P,MARK1 +NOTLCI: PUSHJ P,OUTTP + ADDI C,2 + JRST TPMK4 + +FIXBND: HRRZ A,(C) ; GET PTR TO CHAIN + SKIPE A ; DO NOTHING IF EMPTY + ADD A,-3(P) + POPJ P, +TPMK7: +TPMK8: MOVNI A,1 ; FENCE-POST THE STACK + PUSHJ P,OUTTP + ADDI C,1 ; INCREMENT C FOR FENCE-POST + SUB P,[1,,1] ; CLEAN UP STACK + POP P,E ; GET UPDATED PTR TO INF + SUB P,[2,,2] ; POP OFF RELOCATION + HRRZ A,(P) + HLRZ B,(A) + TRZ B,400000 + SUBI A,-1(B) + SUBI C,(A) ; GET # OF WORDS TRANSFERED + SUB B,C ; GET # LEFT + ADDI E,-2(B) ; ADJUST POINTER TO INF + POP P,A + POP P,C ; IS THERE TOP GROWH + ADD E,C ; MAKE ADJUSTMENT FOR TOP GROWTH + ANDI E,-1 + PUSHJ P,DOPMOD ; FIX UP DOPE WORDS + PUSHJ P,DOPOUT ; SEND THEM OUT + JRST DOPEAD + + + ; ROUTINE TO ALLOCATE ROOM FOR VECTORS IN INFERIOR +; F= # OF WORDS TO ALLOCATE + +ALLOGC: HRRZS A ; GET ABS VALUE + SKIPN GCDFLG ; SKIP IF IN DUMPER + CAML A,GCSBOT ; SKIP IF IN STORAGE + JRST ALOGC2 ; JUMP IF ALLOCATING + HRRZ 0,A + POPJ P, +ALOGC2: PUSH P,A ; SAVE A +ALOGC1: HLRE 0,FPTR ; GET ROOM LEFT + ADD 0,F ; SEE IF ITS ENOUGH + JUMPL 0,ALOCOK + MOVE F,0 ; MODIFY F + PUSH P,F + PUSHJ P,MOVFNT ; MOVE UP FRONTEIR + POP P,F + JRST ALOGC1 ; CONTINUE +ALOCOK: ADD FPTR,F ; MODIFY FPTR + HRLZS F + ADD FPTR,F + POP P,A ; RESTORE A + MOVEI 0,@BOTNEW + SUBI 0,1 ; RELOCATION PTR + POPJ P, ; EXIT + + + + +; TRBLK MOVES A VECTOR INTO THE INFERIOR +; E= STARTING ADDR IN INF A= DOPE WORD OF VECTOR + +TRBLK: HRRZS A + SKIPE GCDFLG + JRST TRBLK7 + CAMGE A,GCSBOT ; SEE IF IN GC-SPACE + JRST FIXDOP +TRBLK7: PUSH P,A + HLRZ 0,(A) + TRZ 0,400000 ; TURN OFF GC FLAG + HRRZ F,A + HLRE A,E ; GET SHRINKAGE + ADD 0,A ; MUNG LENGTH + SUB F,0 + ADDI F,1 ; F POINTS TO START OF VECTOR +TRBLK2: HRRZ R,E ; SAVE POINTER TO INFERIOR + ADD E,0 ; E NOW POINTS TO FINAL ADDRESS+1 + MOVE M,E ;SAVE E +TRBLK1: MOVE 0,R + SUBI E,1 + CAMGE R,FNTBOT ; SEE IF IN FRONTEIR + JRST TRBL10 + SUB E,FNTBOT ; ADJUST E + SUB 0,FNTBOT ; ADJ START + MOVEI A,FRONT+1777 + JRST TRBLK4 +TRBL10: CAML R,WNDBOT + CAML R,WNDTOP ; SEE IF IN WINDOW + JRST TRBLK5 ; NO + SUB E,WNDBOT + SUB 0,WNDBOT + MOVEI A,WIND+1777 +TRBLK4: ADDI 0,-1777(A) ; CALCULATE START IN WINDOW OR FRONTEIR + CAIL E,2000 + JRST TRNSWD + ADDI E,-1777(A) ; SUBTRACT WINDBOT + HRL 0,F ; SET UP FOR BLT + BLT 0,(E) + POP P,A + +FIXDOP: IORM D,(A) + MOVE E,M ; GET END OF WORD + POPJ P, +TRNSWD: PUSH P,B + MOVEI B,1(A) ; GET TOP OF WORLD + SUB B,0 + HRL 0,F + BLT 0,(A) + ADD F,B ; ADJUST F + ADD R,B + POP P,B + MOVE E,M ; RESTORE E + JRST TRBLK1 ; CONTINUE +TRBLK5: HRRZ A,R ; COPY E + ASH A,-10. ; TO PAGES + PUSH P,B ; SAVE B + MOVEI B,WNDP ; IT IS WINDOW + PUSHJ P,%SHWND + ASH A,10. ; TO PAGES + MOVEM A,WNDBOT ; UPDATE POINTERS + ADDI A,2000 + MOVEM A,WNDTOP + POP P,B ; RESTORE B + JRST TRBL10 + + + + +; ALTERNATE ENTRY FOR VECTORS WHICH TAKES CARE OF SHRINKAGE + +TRBLKV: HRRZS A + SKIPE GCDFLG ; SKIP IF NOT IN DUMPER + JRST TRBLV2 + CAMGE A,GCSBOT ; SEE IF IN GC-SPACE + JRST FIXDOP +TRBLV2: PUSH P,A ; SAVE A + HLRZ 0,DOPSV2 + TRZ 0,400000 + HRRZ F,A + HLRE A,E ; GET SHRINKAGE + ADD 0,A ; MUNG LENGTH + SUB F,0 + ADDI F,1 ; F POINTS TO START OF VECTOR + SKIPGE -2(P) ; SEE IF SHRINKAGE + ADD 0,-2(P) ; IF SO COMPENSATE + JRST TRBLK2 ; CONTINUE + +; ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT TO SEND IN 0= # OF WORDS + +TRBLK3: PUSH P,A ; SAVE A + MOVE F,A + JRST TRBLK2 + +; FINAL ALTERNATE ENTRY POINT TO TRBLK A==> OBJECT +; F==> START OF TRANSFER IN GCS 0= # OF WORDS + +TRBLKX: PUSH P,A ; SAVE A + JRST TRBLK2 ; SEND IT OUT + + +; OUTTP IS THE ROUTINE THAT TPMK USES TO SEND OUT ELEMENTS FOR THE SCAN +; -2(P) CONTAINS THE ADDR IN THE INF AND IT IS UPDATED +; A CONTAINS THE WORD TO BE SENT OUT + +OUTTP: AOS E,-2(P) ; INCREMENT PLACE + MOVSI 0,(MOVEM) ; INS FOR SMINF + SOJA E,SMINF + + +; ADWD PLACES ONE WORD IN THE INF +; E ==> INF C IS THE WORD + +ADWD: PUSH P,E ; SAVE AC'S + PUSH P,A + MOVE A,C ; GET WORD + MOVSI 0,(MOVEM) ; INS FOR SMINF + PUSHJ P,SMINF ; SMASH IT IN + POP P,A + POP P,E + POPJ P, ; EXIT + +; DOPOUT IS USED TO SEND OUT THE DOPE WORDS IN UNUSUAL CALSE +; SUCH AS THE TP AND GROWTH + + +DOPOUT: MOVE C,-1(A) + PUSHJ P,ADWD + ADDI E,1 + MOVE C,(A) ; GET SECOND DOPE WORD + TLZ C,400000 ; TURN OFF POSSIBLE MARK BIT + PUSHJ P,ADWD + MOVE C,DOPSV1 ; FIX UP FIRST DOPE WORD + MOVEM C,-1(A) + MOVE C,DOPSV2 + MOVEM C,(A) ; RESTORE SECOND D.W. + POPJ P, + +; DOPMOD MODIFIES THE DOPE WORD OF A VECTOR AND PLACES A NEW DOPE-WORD IN INF +; A ==> DOPE WORD E==> INF + +DOPMOD: SKIPE GCDFLG ; CHECK TO SEE IF IN DUMPER AND PURIFY + JRST .+3 + CAMG A,GCSBOT + POPJ P, ; EXIT IF NOT IN GCS + MOVE C,-1(A) ; GET FIRST DOPE WORD + MOVEM C,DOPSV1 + HLLZS C ; CLEAR OUT GROWTH + TLO C,.VECT. ; FIX UP FOR GCHACK + PUSH P,C + MOVE C,(A) ; GET SECOND DOPE WORD + HLRZ B,(A) ; GET LENGTH + TRZ B,400000 ; TURN OFF MARK BIT + MOVEM C,DOPSV2 + HRRZ 0,-1(A) ; CHECK FOR GROWTH + JUMPE 0,DOPMD1 + LDB 0,[111100,,-1(A)] ; MODIFY WITH GROWTH + TRZE 0,400 + MOVNS 0 + ASH 0,6 + ADD B,0 + LDB 0,[001100,,-1(A)] + TRZE 0,400 + MOVNS 0 + ASH 0,6 + ADD B,0 +DOPMD1: HRL C,B ; FIX IT UP + MOVEM C,(A) ; FIX IT UP + POP P,-1(A) + POPJ P, + +ADPMOD: CAMG A,GCSBOT + POPJ P, ; EXIT IF NOT IN GCS + MOVE C,-1(A) ; GET FIRST DOPE WORD + TLO C,.VECT. ; FIX UP FOR GCHACK + MOVEM C,-1(A) + MOVE C,(A) ; GET SECOND DOPE WORD + TLZ C,400000 ; TURN OFF PARK BIT + MOVEM C,(A) + POPJ P, + + + + + ; RELATE RELATAVIZES A POINTER TO A VECTOR +; B IS THE POINTER A==> DOPE WORD + +RELATE: SKIPE GCDFLG ; SEE IF DUMPER OR PURIFIER + JRST .+3 + CAMGE A,GCSBOT ; SEE IF IN VECTOR SPACE + POPJ P, ; IF NOT EXIT + MOVE C,-1(P) + HLRE F,C ; GET LENGTH + HRRZ 0,-1(A) ; CHECK FO GROWTH + JUMPE A,RELAT1 + LDB 0,[111100,,-1(A)] ; GET TOP GROWTH + TRZE 0,400 ; HACK SIGN BIT + MOVNS 0 + ASH 0,6 ; CONVERT TO WORDS + SUB F,0 ; ACCOUNT FOR GROWTH +RELAT1: HRLM F,C ; PLACE CORRECTED LENGTH BACK IN POINTER + HRRZ F,(A) ; GET RELOCATED ADDR + SUBI F,(A) ; FIND RELATIVIZATION AMOUNT + ADD C,F ; ADJUST POINTER + SUB C,0 ; ACCOUNT FOR GROWTH + MOVEM C,-1(P) + POPJ P, + + + + ; MARK TB POINTERS +TBMK: HRRZS A ; CHECK FOR NIL POINTER + SKIPN A + JRST GCRET ; IF POINTING TO NIL THEN RETURN + HLRE B,TPSAV(A) ; MAKE POINTER LOOK LIKE A TP POINTER + HRRZ C,TPSAV(A) ; GET TO DOPE WORD +TBMK2: SUB C,B ; POINT TO FIRST DOPE WORD + HRRZ A,(P) ; GET PTR TO FRAME + SUB A,C ; GET PTR TO FRAME + HRLS A + HRR A,(P) + PUSH P,A + MOVEI C,-1(P) + MOVEI B,TTP + PUSHJ P,MARK + SUB P,[1,,1] + HRRM A,(P) + JRST GCRET +ABMK: HLRE B,A ; FIX UP TO GET TO FRAME + SUB A,B + HLRE B,FRAMLN+TPSAV(A) ; FIX UP TO LOOK LIKE TP + HRRZ C,FRAMLN+TPSAV(A) + JRST TBMK2 + + + +; MARK ARG POINTERS + +ARGMK: HRRZ A,1(C) ; GET POINTER + HLRE B,1(C) ; AND LNTH + SUB A,B ; POINT TO BASE + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST ARGMK0 + HLRZ 0,(A) ; GET TYPE + ANDI 0,TYPMSK + CAIN 0,TCBLK + JRST ARGMK1 + CAIE 0,TENTRY ; IS NEXT A WINNER? + CAIN 0,TINFO + JRST ARGMK1 ; YES, GO ON TO WIN CODE + +ARGMK0: SETZB A,1(C) ; CLOBBER THE CELL + SETZM (P) ; AND SAVED COPY + JRST GCRET + +ARGMK1: MOVE B,1(A) ; ASSUME TTB + ADDI B,(A) ; POINT TO FRAME + CAIE 0,TINFO ; IS IT? + MOVEI B,FRAMLN(A) ; NO, USE OTHER GOODIE + HLRZ 0,OTBSAV(B) ; GET TIME + HRRZ A,(C) ; AND FROM POINTER + CAIE 0,(A) ; SKIP IF WINNER + JRST ARGMK0 + MOVE A,TPSAV(B) ; GET A RELATAVIZED TP + HRROI C,TPSAV-1(B) + MOVEI B,TTP + PUSHJ P,MARK1 + SUB A,1(C) ; AMOUNT TO RELATAVIZE ARGS + HRRZ B,(P) + ADD B,A + HRRM B,(P) ; PUT RELATAVIZED PTR BACK + JRST GCRET + + +; MARK FRAME POINTERS + +FRMK: HLRZ B,A ; GET TIME FROM FRAME PTR + HLRZ F,OTBSAV(A) ; GET TIME FROM FRAME + CAME B,F ; SEE IF EQUAL + JRST GCRET + SUBI C,1 ;PREPARE TO MARK PROCESS VECTOR + HRRZ A,1(C) ;USE AS DATUM + SUBI A,1 ;FUDGE FOR VECTMK + MOVEI B,TPVP ;IT IS A VECTRO + PUSHJ P,MARK ;MARK IT + ADDI A,1 ; READJUST PTR + HRRM A,1(C) ; FIX UP PROCESS SLOT + MOVEI C,1(C) ; SET UP FOR TBMK + HRRZ A,(P) + JRST TBMK ; MARK LIKE TB + + +; MARK BYTE POINTER + +BYTMK: PUSHJ P,BYTDOP ; GET DOPE WORD IN A + HLRZ F,-1(A) ; GET THE TYPE + ANDI F,SATMSK ; FLUSH MONITOR BITS + CAIN F,SATOM ; SEE IF ATOM + JRST ATMSET + HLRE F,(A) ; GET MARKING + JUMPL F,BYTREL ; JUMP IF MARKED + HLRZ F,(A) ; GET LENGTH + PUSHJ P,ALLOGC ; ALLOCATE FOR IT + HRRM 0,(A) ; SMASH IT IN + MOVE E,0 + HLRZ F,(A) + SUBI E,-1(F) ; ADJUST INF POINTER + IORM D,(A) + PUSHJ P,ADPMOD + PUSHJ P,TRBLK +BYTREL: HRRZ E,(A) + SUBI E,(A) + ADDM E,(P) ; RELATAVIZE + JRST GCRET + +ATMSET: PUSH P,A ; SAVE A + HLRZ B,(A) ; GET LENGTH + TRZ B,400000 ; GET RID OF MARK BIT + MOVNI B,-2(B) ; GET LENGTH + ADDI A,-1(B) ; CALCULATE POINTER + HRLI A,(B) + MOVEI B,TATOM ; TYPE + PUSHJ P,MARK + POP P,A ; RESTORE A + SKIPN GCDFLG + JRST BYTREL + MOVSI E,STATM ; GET "STRING IS ATOM BIT" + IORM E,(P) + SKIPN DUMFLG + JRST GCRET + HRRM A,(P) + JRST BYTREL ; TO BYTREL + + +; MARK OFFSET + +OFFSMK: HLRZS A + PUSH P,$TLIST + PUSH P,A ; PUSH LIST POINTER ON THE STACK + MOVEI C,-1(P) ; POINTER TO PAIR + PUSHJ P,MARK2 ; MARK THE LIST + HRLM A,-2(P) ; UPDATE POINTER IN OFFSET + SUB P,[2,,2] + JRST GCRET + + +; MARK ATOMS IN GVAL STACK + +GATOMK: HRRZ B,(C) ; POINT TO POSSIBLE GDECL + JUMPE B,ATOMK + CAIN B,-1 + JRST ATOMK + MOVEI A,(B) ; POINT TO DECL FOR MARK + MOVEI B,TLIST + MOVEI C,0 + PUSHJ P,MARK + HLRZ C,-1(P) ; RESTORE HOME POINTER + HRRM A,(C) ; CLOBBER UPDATED LIST IN + MOVE A,1(C) ; RESTORE ATOM POINTER + +; MARK ATOMS + +ATOMK: + MOVEI 0,@BOTNEW + PUSH P,0 ; SAVE POINTER TO INF + TLO TYPNT,.ATOM. ; SAY ATOM WAS MARKED + MOVEI C,1(A) + PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS + JRST ATMRL1 ; ALREADY MARKED + PUSH P,A ; SAVE DOPE WORD PTR FOR LATER + HLRZ C,(A) ; FIND REAL ATOM PNTR + SUBI C,400001 ; KILL MARK BIT AND ADJUST + HRLI C,-1(C) + SUBM A,C ; NOW TOP OF ATOM +MRKOBL: MOVEI B,TOBLS + HRRZ A,2(C) ; IF > 0, NOT OBL + CAMG A,VECBOT + JRST .+3 + HRLI A,-1 + PUSHJ P,MARK ; AND MARK IT + HRRM A,2(C) + SKIPN GCHAIR + JRST NOMKNX + HLRZ A,2(C) + MOVEI B,TATOM + PUSHJ P,MARK + HRLM A,2(C) +NOMKNX: HLRZ B,(C) ; SEE IF UNBOUND + TRZ B,400000 ; TURN OFF MARK BIT + SKIPE B + CAIN B,TUNBOUND + JRST ATOMK1 ; IT IS UNBOUND + HRRZ 0,(C) ; SEE IF VECTOR OR TP POINTER + MOVEI B,TVEC ; ASSUME VECTOR + SKIPE 0 + MOVEI B,TTP ; ITS A LOCAL VALUE + PUSHJ P,MARK1 ; MARK IT + MOVEM A,1(C) ; SMASH INTO SLOT +ATOMK1: HRRZ 0,2(C) ; MAKE SURE ATOMS NOT ON OBLISTS GET SENT + POP P,A ; RESTORE A + POP P,E ; GET POINTER INTO INF + SKIPN GCHAIR + JUMPN 0,ATMREL + PUSHJ P,ADPMOD + PUSHJ P,TRBLK +ATMREL: HRRZ E,(A) ; RELATAVIZE + SUBI E,(A) + ADDM E,(P) + JRST GCRET +ATMRL1: SUB P,[1,,1] ; POP OFF STACK + JRST ATMREL + + +GETLNT: HLRE B,A ;GET -LNTH + SUB A,B ;POINT TO 1ST DOPE WORD + MOVEI A,1(A) ;POINT TO 2ND DOPE WORD + CAIL A,STOSTR ; CHECK IN VECTOR SPACE + CAMLE A,GCSTOP + JRST VECTB1 ;BAD VECTOR, COMPLAIN + HLRE B,(A) ;GET LENGTH AND MARKING + IORM D,(A) ;MAKE SURE MARKED + JUMPL B,AMTKE + MOVEI F,(B) ; AMOUNT TO ALLOCATE + PUSHJ P,ALLOGC ;ALLOCATE ROOM + HRRM 0,(A) ; RELATIVIZE +AMTK1: AOS (P) ; A NON MARKED ITEM +AMTKE: POPJ P, ;AND RETURN + +GCRET1: SUB P,[1,,1] ;FLUSH RETURN ADDRESS + JRST GCRET + + + +; MARK NON-GENERAL VECTORS + +NOTGEN: CAMN B,[GENERAL+] + JRST GENRAL ;YES, MARK AS A VECTOR + JUMPL B,SPECLS ; COMPLAIN IF A SPECIAL HACK + SUBI A,1(E) ;POINT TO TOP OF A UNIFORM VECTOR + HLRZS B ;ISOLATE TYPE + ANDI B,TYPMSK + PUSH P,E + SKIPE DUMFLG ; SKIP IF NOT IN DUMPER + PUSHJ P,TYPHK ; HACK WITH TYPE IF SPECIAL + POP P,E ; RESTORE LENGTH + MOVE F,B ; AND COPY IT + LSH B,1 ;FIND OUT WHERE IT WILL GO + HRRZ B,@TYPNT ;GET SAT IN B + ANDI B,SATMSK + MOVEI C,@MKTBS(B) ;POINT TO MARK SR + CAIN C,GCRET ;IF NOT A MARKED FROM GOODIE, IGNORE + JRST UMOVEC + MOVEI C,-1(A) ;POINT 1 PRIOR TO VECTOR START + PUSH P,E ;SAVE NUMBER OF ELEMENTS + PUSH P,F ;AND UNIFORM TYPE + +UNLOOP: MOVE B,(P) ;GET TYPE + MOVE A,1(C) ;AND GOODIE + TLO C,400000 ;CAN'T MUNG TYPE + PUSHJ P,MARK ;MARK THIS ONE + MOVEM A,1(C) ; LIST FIXUP + SOSE -1(P) ;COUNT + AOJA C,UNLOOP ;IF MORE, DO NEXT + + SUB P,[2,,2] ;REMOVE STACK CRAP + JRST UMOVEC + + +SPECLS: FATAL AGC--UNRECOGNIZED SPECIAL VECTOR + SUB P,[4,,4] ; REOVER + JRST AFIXUP + + + +; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS +; AND UPDATES PTR TO THE TABLE. + +GCRDMK: PUSH P,A ; SAVE PTR TO TOP + MOVEI 0,@BOTNEW ; SAVE PTR TO INF + PUSH P,0 + PUSHJ P,GETLNT ; GET TO D.W. AND CHECK MARKING + JRST GCRDRL ; RELATIVIZE + PUSH P,A ; SAVE D.W POINTER + SUBI A,2 + MOVE B,ABOTN ; GET TOP OF ATOM TABLE + HRRZ 0,-2(P) + ADD B,0 ; GET BOTTOM OF ATOM TABLE +GCRD1: CAMG A,B ; DON'T SKIP IF DONE + JRST GCRD2 + HLRZ C,(A) ; GET MARKING + TRZN C,400000 ; SKIP IF MARKED + JRST GCRD3 + MOVEI E,(A) + SUBI A,(C) ; GO BACK ONE ATOM + PUSH P,B ; SAVE B + PUSH P,A ; SAVE POINTER + MOVEI C,-2(E) ; SET UP POINTER + MOVEI B,TATOM ; GO TO MARK + MOVE A,1(C) + PUSHJ P,MARK + MOVEM A,1(C) ; SMASH FIXED UP ATOM BACK IN + POP P,A + POP P,B + JRST GCRD1 +GCRD3: SUBI A,(C) ; TO NEXT ATOM + JRST GCRD1 +GCRD2: POP P,A ; GET PTR TO D.W. + POP P,E ; GET PTR TO INF + SUB P,[1,,1] ; GET RID OF TOP + PUSHJ P,ADPMOD ; FIX UP D.W. + PUSHJ P,TRBLK ; SEND IT OUT + JRST ATMREL ; RELATIVIZE AND LEAVE +GCRDRL: POP P,A ; GET PTR TO D.W + SUB P,[2,,2] ; GET RID OF TOP AND PTR TO INF + JRST ATMREL ; RELATAVIZE + + + +;MARK RELATAVIZED GLOC HACKS + +LOCRMK: SKIPE GCHAIR + JRST GCRET +LOCRDP: PUSH P,C ; SAVE C + MOVEI C,-2(A) ; RELATAVIZED PTR TO ATOM + ADD C,GLTOP ; ADD GLOTOP TO GET TO ATOM + MOVEI B,TATOM ; ITS AN ATOM + SKIPL (C) + PUSHJ P,MARK1 + POP P,C ; RESTORE C + SKIPN DUMFLG ; IF GC-DUMP, WILL STORE ATOM FOR LOCR + JRST LOCRDD + MOVEI B,1 + IORM B,3(A) ; MUNG ATOM TO SAY IT IS LOCR + CAIA +LOCRDD: MOVE A,1(C) ; GET RELATIVIZATION + MOVEM A,(P) ; IT STAYS THE SAVE + JRST GCRET + +;MARK LOCID TYPE GOODIES + +LOCMK: HRRZ B,(C) ;GET TIME + JUMPE B,LOCMK1 ; SKIP LEGAL CHECK FOR GLOBAL + HRRZ 0,2(A) ; GET OTHER TIME + CAIE 0,(B) ; SAME? + SETZB A,(P) ; NO, SMASH LOCATIVE + JUMPE A,GCRET ; LEAVE IF DONE +LOCMK1: PUSH P,C + MOVEI B,TATOM ; MARK ATOM + MOVEI C,-2(A) ; POINT TO ATOM + MOVE E,(C) ; SEE IF BLOCK IS MARKED + TLNE E,400000 ; SKIP IF MARKED + JRST LOCMK2 ; SKIP OVER BLOCK + SKIPN GCHAIR ; DO NOT MARK IF NOT HAIRY (WILL BE MARKED) + PUSHJ P,MARK1 ; LET LOCATIVE SAVE THE ATOM +LOCMK2: POP P,C + HRRZ E,(C) ; TIME BACK + MOVEI B,TVEC ; ASSUME GLOBAL + SKIPE E + MOVEI B,TTP ; ITS LOCAL + PUSHJ P,MARK1 ; MARK IT + MOVEM A,(P) + JRST GCRET + + +; MARK ASSOCIATION BLOCKS + +ASMRK: PUSH P,A +ASMRK1: HRLI A,-ASOLNT ;LOOK LIKE A VECTOR POINTER + PUSHJ P,GETLNT ;GET LENGTH AND CHECK BOUNDS + JRST ASTREL ; ALREADY MARKED + MOVEI C,-ASOLNT-1(A) ;COPY POINTER + PUSHJ P,MARK2 ;MARK ITEM CELL + MOVEM A,1(C) + ADDI C,INDIC-ITEM ;POINT TO INDICATOR + PUSHJ P,MARK2 + MOVEM A,1(C) + ADDI C,VAL-INDIC + PUSHJ P,MARK2 + MOVEM A,1(C) + SKIPN GCHAIR ; IF NO HAIR, MARK ALL FRIENDS + JRST ASTREL + HRRZ A,NODPNT-VAL(C) ; NEXT + JUMPN A,ASMRK1 ; IF EXISTS, GO +ASTREL: POP P,A ; RESTORE PTR TO ASSOCIATION + MOVEI A,ASOLNT+1(A) ; POINT TO D.W. + SKIPN NODPNT-ASOLNT-1(A) ; SEE IF EMPTY NODPTR + JRST ASTX ; JUMP TO SEND OUT +ASTR1: HRRZ E,(A) ; RELATAVIZE + SUBI E,(A) + ADDM E,(P) + JRST GCRET ; EXIT +ASTX: HRRZ E,(A) ; GET PTR IN FRONTEIR + SUBI E,ASOLNT+1 ; ADJUST TO POINT TO BEGINNING + PUSHJ P,ADPMOD + PUSHJ P,TRBLK + JRST ASTR1 + +;HERE WHEN A VECTOR POINTER IS BAD + +VECTB1:FATAL AGC--VECTOR POINTS OUTSIDE OF VECTOR SPACE + SUB P,[1,,1] ; RECOVERY +AFIXUP: SETZM (P) ; CLOBBER SLOT + JRST GCRET ; CONTINUE + + +VECTB2: FATAL AGC--VECTOR POINTS OUT OF VECTOR SPACE + SUB P,[2,,2] + JRST AFIXUP ; RECOVER + +PARERR: FATAL AGC--PAIR POINTS OUT OF PAIR SPACE + SUB P,[1,,1] ; RECOVER + JRST AFIXUP + + + ; HERE TO MARK TEMPLATE DATA STRUCTURES + +TD.MRK: MOVEI 0,@BOTNEW ; SAVE PTR TO INF + PUSH P,0 + HLRZ B,(A) ; GET REAL SPEC TYPE + ANDI B,37777 ; KILL SIGN BIT + MOVEI E,-NUMSAT-1(B) ; GET REL POINTER TO TABLE + HRLI E,(E) + ADD E,TD.AGC+1 + HRRZS C,A ; FLUSH COUNT AND SAVE + SKIPL E ; WITHIN BOUNDS + FATAL BAD SAT IN AGC + PUSHJ P,GETLNT ; GOODIE IS NOW MARKED + JRST TMPREL ; ALREADY MARKED + + SKIPE (E) + JRST USRAGC + SUB E,TD.AGC+1 ; POINT TO LENGTH + ADD E,TD.LNT+1 + XCT (E) ; RET # OF ELEMENTS IN B + + HLRZ D,B ; GET POSSIBLE "BASIC LENGTH" FOR RESTS + PUSH P,[0] ; TEMP USED IF RESTS EXIST + PUSH P,D + MOVEI B,(B) ; ZAP TO ONLY LENGTH + PUSH P,C ; SAVE POINTER TO TEMPLATE STRUCTURE + PUSH P,[0] ; HOME FOR VALUES + PUSH P,[0] ; SLOT FOR TEMP + PUSH P,B ; SAVE + SUB E,TD.LNT+1 + PUSH P,E ; SAVE FOR FINDING OTHER TABLES + JUMPE D,TD.MR2 ; NO REPEATING SEQ + ADD E,TD.GET+1 ; COMP LNTH OF REPEATING SEQ + HLRE E,(E) ; E ==> - LNTH OF TEMPLATE + ADDI E,(D) ; E ==> -LENGTH OF REP SEQ + MOVNS E + HRLM E,-5(P) ; SAVE IT AND BASIC + +TD.MR2: SKIPG D,-1(P) ; ANY LEFT? + JRST TD.MR1 + + MOVE E,TD.GET+1 + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + MOVEM D,-6(P) ; SAVE ELMENT # + SKIPN B,-5(P) ; SKIP IF "RESTS" EXIST + SOJA D,TD.MR3 + + MOVEI 0,(B) ; BASIC LNT TO 0 + SUBI 0,(D) ; SEE IF PAST BASIC + JUMPGE 0,.-3 ; JUMP IF O.K. + MOVSS B ; REP LNT TO RH, BASIC TO LH + IDIVI 0,(B) ; A==> -WHICH REPEATER + MOVNS A + ADD A,-5(P) ; PLUS BASIC + ADDI A,1 ; AND FUDGE + MOVEM A,-6(P) ; SAVE FOR PUTTER + ADDI E,-1(A) ; POINT + SOJA D,.+2 + +TD.MR3: ADDI E,(D) ; POINT TO SLOT + XCT (E) ; GET THIS ELEMENT INTO A AND B + JFCL ; NO-OP FOR ANY CASE + MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT + MOVEM B,-2(P) + EXCH A,B ; REARRANGE + GETYP B,B + MOVEI C,-3(P) ; TELL OTHER GUYS THEY CANT DIRECTLY MUNG + MOVSI D,400000 ; RESET FOR MARK + PUSHJ P,MARK ; AND MARK THIS GUY (RET FIXED POINTER IN A) + MOVE C,-4(P) ; REGOBBLE POINTER TO TEMPLATE + MOVE E,TD.PUT+1 + MOVE B,-6(P) ; RESTORE COUNT + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + ADDI E,(B)-1 ; POINT TO SLOT + MOVE B,-3(P) ; RESTORE TYPE WORD + EXCH A,B + SOS D,-1(P) ; GET ELEMENT # + XCT (E) ; SMASH IT BACK + FATAL TEMPLATE LOSSAGE + MOVE C,-4(P) ; RESTORE POINTER IN CASE MUNGED + JRST TD.MR2 + +TD.MR1: MOVE A,-8(P) ; PTR TO DOPE WORD + MOVE E,-7(P) ; RESTORE PTR TO FRONTEIR + SUB P,[7,,7] ; CLEAN UP STACK +USRAG1: ADDI A,1 ; POINT TO SECOND D.W. + MOVSI D,400000 ; SET UP MARK BIT + PUSHJ P,ADPMOD + PUSHJ P,TRBLK ; SEND IT OUT +TMPREL: SUB P,[1,,1] + HRRZ D,(A) + SUBI D,(A) + ADDM D,(P) + MOVSI D,400000 ; RESTORE MARK/UNMARK BIT + JRST GCRET + +USRAGC: HRRZ E,(E) ; MARK THE TEMPLATE + PUSHJ P,(E) + MOVE A,-1(P) ; POINTER TO D.W + MOVE E,(P) ; TOINTER TO FRONTIER + JRST USRAG1 + +; This phase attempts to remove any unwanted associations. The program +; loops through the structure marking values of associations. It can only +; stop when no new values (potential items and/or indicators) are marked. + +VALFLS: PUSH P,LPVP ; SAVE LPVP FOR LATER + PUSH P,[0] ; INDICATE WHETHER ANY ON THIS PASS + PUSH P,[0] ; OR THIS BUCKET +ASOMK1: MOVE A,GCASOV ; GET VECTOR POINTER + SETOM -1(P) ; INITIALIZE FLAG + +ASOM6: SKIPG C,(A) ; SKIP IF BUCKET TO BE SCANNED + JRST ASOM1 + SETOM (P) ; SAY BUCKET NOT CHANGED + +ASOM2: MOVEI F,(C) ; COPY POINTER + SKIPG ASOLNT+1(C) ; SKIP IF NOT ALREADY MARKED + JRST ASOM4 ; MARKED, GO ON + PUSHJ P,MARKQ ; SEE IF ITEM IS MARKED + JRST ASOM3 ; IT IS NOT, IGNORE IT + MOVEI F,(C) ; IN CASE CLOBBERED BY MARK2 + MOVEI C,INDIC(C) ; POINT TO INDICATOR SLOT + PUSHJ P,MARKQ + JRST ASOM3 ; NOT MARKED + + PUSH P,A ; HERE TO MARK VALUE + PUSH P,F + HLRE F,ASOLNT-INDIC+1(C) ; GET LENGTH + JUMPL F,.+3 ; SKIP IF MARKED + CAMGE C,VECBOT ; SKIP IF IN VECT SPACE + JRST ASOM20 + HRRM FPTR,ASOLNT-INDIC+1(C) ; PUT IN RELATIVISATION + MOVEI F,12 ; AMOUNT TO ALLOCATE IN INF + PUSHJ P,ALLOGC + HRRM 0,5(C) ; STICK IN RELOCATION + +ASOM20: PUSHJ P,MARK2 ; AND MARK + MOVEM A,1(C) ; LIST FIX UP + ADDI C,ITEM-INDIC ; POINT TO ITEM + PUSHJ P,MARK2 + MOVEM A,1(C) + ADDI C,VAL-ITEM ; POINT TO VALUE + PUSHJ P,MARK2 + MOVEM A,1(C) + IORM D,ASOLNT-VAL+1(C) ; MARK ASOC BLOCK + POP P,F + POP P,A + AOSA -1(P) ; INDICATE A MARK TOOK PLACE + +ASOM3: AOS (P) ; INDICATE AN UNMARKED IN THIS BUCKET +ASOM4: HRRZ C,ASOLNT-1(F) ; POINT TO NEXT IN BUCKET + JUMPN C,ASOM2 ; IF NOT EMPTY, CONTINUE + SKIPGE (P) ; SKIP IF ANY NOT MARKED + HRROS (A) ; MARK BUCKET AS NOT INTERESTING +ASOM1: AOBJN A,ASOM6 ; GO TO NEXT BUCKET + TLZE TYPNT,.ATOM. ; ANY ATOMS MARKED? + JRST VALFLA ; YES, CHECK VALUES +VALFL8: + +; NOW SEE WHICH CHANNELS STILL POINTED TO + +CHNFL3: MOVEI 0,N.CHNS-1 + MOVEI A,CHNL1 ; SLOTS + HRLI A,TCHAN ; TYPE HERE TOO + +CHNFL2: SKIPN B,1(A) + JRST CHNFL1 + HLRE C,B + SUBI B,(C) ; POINT TO DOPE + HLLM A,(A) ; PUT TYPE BACK + HRRE F,(A) ; SEE IF ALREADY MARKED + JUMPN F,CHNFL1 + SKIPGE 1(B) + JRST CHNFL8 + HLLOS (A) ; MARK AS A LOSER + SETZM -1(P) + JRST CHNFL1 +CHNFL8: MOVEI F,1 ; MARK A GOOD CHANNEL + HRRM F,(A) +CHNFL1: ADDI A,2 + SOJG 0,CHNFL2 + + SKIPE GCHAIR ; IF NOT HAIRY CASE + POPJ P, ; LEAVE + + SKIPL -1(P) ; SKIP IF NOTHING NEW MARKED + JRST ASOMK1 + + SUB P,[2,,2] ; REMOVE FLAGS + + + +; HERE TO REEMOVE UNUSED ASSOCIATIONS + + MOVE A,GCASOV ; GET ASOVEC BACK FOR FLUSHES + +ASOFL1: SKIPN C,(A) ; SKIP IF BUCKET NOT EMPTY + JRST ASOFL2 ; EMPTY BUCKET, IGNORE + HRRZS (A) ; UNDO DAMAGE OF BEFORE + +ASOFL5: SKIPGE ASOLNT+1(C) ; SKIP IF UNMARKED + JRST ASOFL6 ; MARKED, DONT FLUSH + + HRRZ B,ASOLNT-1(C) ; GET FORWARD POINTER + HLRZ E,ASOLNT-1(C) ; AND BACK POINTER + JUMPN E,ASOFL4 ; JUMP IF NO BACK POINTER (FIRST IN BUCKET) + HRRZM B,(A) ; FIX BUCKET + JRST .+2 + +ASOFL4: HRRM B,ASOLNT-1(E) ; FIX UP PREVIOUS + JUMPE B,.+2 ; JUMP IF NO NEXT POINTER + HRLM E,ASOLNT-1(B) ; FIX NEXT'S BACK POINTER + HRRZ B,NODPNT(C) ; SPLICE OUT THRAD + HLRZ E,NODPNT(C) + SKIPE E + HRRM B,NODPNT(E) + SKIPE B + HRLM E,NODPNT(B) + +ASOFL3: HRRZ C,ASOLNT-1(C) ; GO TO NEXT + JUMPN C,ASOFL5 +ASOFL2: AOBJN A,ASOFL1 + + + +; NOW CLOBBER UNMARKED LOCAL NAD GLOBAL VALUES + + MOVE A,GCGBSP ; GET GLOBAL PDL + +GLOFLS: SKIPGE (A) ; SKIP IF NOT ALREADY MARKED + JRST SVDCL + MOVSI B,-3 + PUSHJ P,ZERSLT ; CLOBBER THE SLOT + HLLZS (A) +SVDCL: ANDCAM D,(A) ; UNMARK + ADD A,[4,,4] + JUMPL A,GLOFLS ; MORE?, KEEP LOOPING + + MOVEM LPVP,(P) +LOCFL1: HRRZ A,(LPVP) ; NOW CLOBBER LOCAL SLOTS + HRRZ C,2(LPVP) + MOVEI LPVP,(C) + JUMPE A,LOCFL2 ; NONE TO FLUSH + +LOCFLS: SKIPGE (A) ; MARKDE? + JRST .+3 + MOVSI B,-5 + PUSHJ P,ZERSLT + ANDCAM D,(A) ;UNMARK + HRRZ A,(A) ; GO ON + JUMPN A,LOCFLS +LOCFL2: JUMPN LPVP,LOCFL1 ; JUMP IF MORE PROCESS + +; AT THIS POINT THE LOCALS ARE FINALLY SENT OUT. +; THIS ROUTINE UPDATES THE THIS-PROCESS BINDING. IT FIXES UP THE SP-CHAIN AND IT +; SENDS OUT THE ATOMS. + +LOCFL3: MOVE C,(P) + MOVEI B,TATOM ; MARK THE BINDING TO THIS PROCESS + PUSHJ P,MARK1 ; MARK THE ATOM + MOVEM A,1(C) ; NEW HOME + MOVEI C,2(C) ; MARK VALUE + MOVEI B,TPVP ; IT IS A PROCESS VECTOR POINTER + PUSHJ P,MARK1 ; MARK IT + MOVEM A,1(C) + POP P,R +NEXPRO: MOVEI 0,TPVP ; FIX UP SLOT + HLRZ A,2(R) ; GET PTR TO NEXT PROCESS + HRLM 0,2(R) + HRRZ E,(A) ; ADRESS IN INF + HRRZ B,(A) ; CALCULATE RELOCATION + SUB B,A + PUSH P,B + HRRZ F,A ; CALCULATE START OF TP IN F + HLRZ B,(A) ; ADJUST INF PTR + TRZ B,400000 + SUBI F,-1(B) + LDB M,[111100,,-1(A)] ; CALCULATE TOP GROWTH + TRZE M,400 ; FUDGE SIGN + MOVNS M + ASH M,6 + ADD B,M ; FIX UP LENGTH + EXCH M,(P) + SUBM M,(P) ; FIX RELOCATION TO TAKE INTO ACCOUNT CHANGE IN LENGTH + MOVE M,R ; GET A COPY OF R +NEXP1: HRRZ C,(M) ; GET PTR TO NEXT IN CHAIN + JUMPE C,NEXP2 ; EXIT IF END OF CHAIN + MOVE 0,C ; GET COPY OF CHAIN PTR TO UPDATE + ADD 0,(P) ; UPDATE + HRRM 0,(M) ; PUT IN + MOVE M,C ; NEXT + JRST NEXP1 +NEXP2: SUB P,[1,,1] ; CLEAN UP STACK + SUBI E,-1(B) + HRRI B,(R) ; GET POINTER TO THIS-PROCESS BINDING + MOVEI B,6(B) ; POINT AFTER THE BINDING + MOVE 0,F ; CALCULATE # OF WORDS TO SEND OUT + SUBM B,0 + PUSH P,R ; PRESERVE R + PUSHJ P,TRBLKX ; SEND IT OUT + POP P,R ; RESTORE R + HRRZS R,2(R) ; GET THE NEXT PROCESS + SKIPN R + JRST .+3 + PUSH P,R + JRST LOCFL3 + MOVE A,GCGBSP ; PTR TO GLOBAL STACK + PUSHJ P,SPCOUT ; SEND IT OUT + MOVE A,GCASOV + PUSHJ P,SPCOUT ; SEND IT OUT + POPJ P, + +; THIS ROUTINE MARKS ALL THE CHANNELS +; IT THEN SENDS OUT A COPY OF THE TVP + +CHFIX: MOVEI 0,N.CHNS-1 + MOVEI A,CHNL1 ; SLOTS + HRLI A,TCHAN ; TYPE HERE TOO + +DHNFL2: SKIPN B,1(A) + JRST DHNFL1 + MOVEI C,(A) ; MARK THE CHANNEL + PUSH P,0 ; SAVE 0 + PUSH P,A ; SAVE A + PUSHJ P,MARK2 + MOVEM A,1(C) ; ADJUST PTR + POP P,A ; RESTORE A + POP P,0 ; RESTORE +DHNFL1: ADDI A,2 + SOJG 0,DHNFL2 + POPJ P, + + +; ROUTINE TO SEND OUT SPECIAL STUFF FROM GCHAIR + +SPCOUT: HLRE B,A + SUB A,B + MOVEI A,1(A) ; POINT TO DOPE WORD + LDB 0,[001100,,-1(A)] ;GET GROWTH FACTOR + TRZE 0,400 ;KILL SIGN BIT AND SKIP IF + + MOVNS 0 ;NEGATE + ASH 0,6 ;CONVERT TO NUMBER OF WORDS + PUSHJ P,DOPMOD + HRRZ E,(A) ; GET PTR TO INF + HLRZ B,(A) ; LENGTH + TRZ B,400000 ; GET RID OF MARK BIT + SUBI E,-1(B) + ADD E,0 + PUSH P,0 ; DUMMY FOR TRBLKV + PUSHJ P,TRBLKV ; OUT IT GOES + SUB P,[1,,1] + POPJ P, ;RETURN + +ASOFL6: HLRZ E,ASOLNT-1(C) ; SEE IF FIRST IN BUCKET + JUMPN E,ASOFL3 ; IF NOT CONTINUE + HRRZ E,ASOLNT+1(C) ; GET PTR FROM DOPE WORD + SUBI E,ASOLNT+1 ; ADJUST TO POINT TO BEGINNING OF ALSSOCIATION + HRRZM E,(A) ; SMASH IT IN + JRST ASOFL3 + + +MARK23: PUSH P,A ; SAVE BUCKET POINTER + PUSH P,F + PUSHJ P,MARK2 + MOVEM A,1(C) + POP P,F + POP P,A + AOS -2(P) ; MARKING HAS OCCURRED + IORM D,ASOLNT+1(C) ; MARK IT + JRST MKD + + ; CHANNEL FLUSHER FOR NON HAIRY GC + +CHNFLS: PUSH P,[-1] + SETOM (P) ; RESET FOR RETRY + PUSHJ P,CHNFL3 + SKIPL (P) + JRST .-3 ; REDO + SUB P,[1,,1] + POPJ P, + +; VALUE FLUSHING PHASE, HACKS BOTTOM OF TP AND GLOBAL SP + +VALFLA: MOVE C,GCGBSP ; GET POINTER TO GLOBAL STACK +VALFL1: SKIPL (C) ; SKIP IF NOT MARKED + PUSHJ P,MARKQ ; SEE IF ATOM IS MARKED + JRST VALFL2 + PUSH P,C + MOVEI B,TATOM ; UPDATE ATOM SLOT + PUSHJ P,MARK1 + MOVEM A,1(C) + IORM D,(C) + AOS -2(P) ; INDICATE MARK OCCURRED + HRRZ B,(C) ; GET POSSIBLE GDECL + JUMPE B,VLFL10 ; NONE + CAIN B,-1 ; MAINFIFEST + JRST VLFL10 + MOVEI A,(B) + MOVEI B,TLIST + MOVEI C,0 + PUSHJ P,MARK ; MARK IT + MOVE C,(P) ; POINT + HRRM A,(C) ; CLOBBER UPDATE IN +VLFL10: ADD C,[2,,2] ; BUMP TO VALUE + PUSHJ P,MARK2 ; MARK VALUE + MOVEM A,1(C) + POP P,C +VALFL2: ADD C,[4,,4] + JUMPL C,VALFL1 ; JUMP IF MORE + + HRLM LPVP,(P) ; SAVE POINTER +VALFL7: MOVEI C,(LPVP) + MOVEI LPVP,0 +VALFL6: HRRM C,(P) + +VALFL5: HRRZ C,(C) ; CHAIN + JUMPE C,VALFL4 + MOVEI B,TATOM ; TREAT LIKE AN ATOM + SKIPL (C) ; MARKED? + PUSHJ P,MARKQ1 ; NO, SEE + JRST VALFL5 ; LOOP + AOS -1(P) ; MARK WILL OCCUR + MOVEI B,TATOM ; RELATAVIZE + PUSHJ P,MARK1 + MOVEM A,1(C) + IORM D,(C) + ADD C,[2,,2] ; POINT TO VALUE + PUSHJ P,MARK2 ; MARK VALUE + MOVEM A,1(C) + SUBI C,2 + JRST VALFL5 + +VALFL4: HRRZ C,(P) ; GET SAVED LPVP + MOVEI A,(C) + HRRZ C,2(C) ; POINT TO NEXT + JUMPN C,VALFL6 + JUMPE LPVP,VALFL9 + + HRRM LPVP,2(A) ; NEW PROCESS WAS MARKED + JRST VALFL7 + +ZERSLT: HRRI B,(A) ; COPY POINTER + SETZM 1(B) + AOBJN B,.-1 + POPJ P, + +VALFL9: HLRZ LPVP,(P) ; RESTORE CHAIN + JRST VALFL8 + + ;SUBROUTINE TO SEE IF A GOODIE IS MARKED +;RECEIVES POINTER IN C +;SKIPS IF MARKED NOT OTHERWISE + +MARKQ: HLRZ B,(C) ;TYPE TO B +MARKQ1: MOVE E,1(C) ;DATUM TO C + MOVEI 0,(E) + CAIL 0,@PURBOT ; DONT CHACK PURE + JRST MKD ; ALWAYS MARKED + ANDI B,TYPMSK ; FLUSH MONITORS + LSH B,1 + HRRZ B,@TYPNT ;GOBBLE SAT + ANDI B,SATMSK + CAIG B,NUMSAT ; SKIP FOR TEMPLATE + JRST @MQTBS(B) ;DISPATCH + ANDI E,-1 ; FLUSH REST HACKS + JRST VECMQ + + +MQTBS: + +OFFSET 0 + +DISTB2 DUM3,MKD,[[S2WORD,PAIRMQ],[S2DEFR,PAIRMQ],[SNWORD,VECMQ],[S2NWORD,VECMQ] +[STPSTK,VECMQ],[SARGS,ARGMQ],[SPSTK,VECMQ],[SFRAME,FRMQ],[SLOCID,LOCMQ] +[SATOM,ATMMQ],[SPVP,VECMQ],[SCHSTR,BYTMQ],[SLOCA,ARGMQ],[SLOCU,VECMQ] +[SLOCV,VECMQ],[SLOCS,BYTMQ],[SLOCN,ASMQ],[SASOC,ASMQ],[SLOCL,PAIRMQ],[SGATOM,ATMMQ] +[SBYTE,BYTMQ],[SLOCB,BYTMQ],[SDEFQ,PAIRMQ],[SOFFS,OFFSMQ]] + +OFFSET OFFS + +PAIRMQ: JUMPE E,MKD ; NIL ALWAYS MARKED + SKIPL (E) ; SKIP IF MARKED + POPJ P, +ARGMQ: +MKD: AOS (P) + POPJ P, + +BYTMQ: PUSH P,A ; SAVE A + PUSHJ P,BYTDOP ; GET PTR TO DOPE WORD + MOVE E,A ; COPY POINTER + POP P,A ; RESTORE A + SKIPGE (E) ; SKIP IF NOT MARKED + AOS (P) + POPJ P, ; EXIT + +FRMQ: HRRZ E,(C) ; POINT TO PV DOPE WORD + SOJA E,VECMQ1 + +ATMMQ: CAML 0,GCSBOT ; ALWAYS KEEP FROZEN ATOMS + JRST VECMQ + AOS (P) + POPJ P, + +VECMQ: HLRE 0,E ;GET LENGTH + SUB E,0 ;POINT TO DOPE WORDS + +VECMQ1: SKIPGE 1(E) ;SKIP IF NOT MARKED + AOS (P) ;MARKED, CAUSE SKIP RETURN + POPJ P, + +ASMQ: ADDI E,ASOLNT + JRST VECMQ1 + +LOCMQ: HRRZ 0,(C) ; GET TIME + JUMPE 0,VECMQ ; GLOBAL, LIKE VECTOR + HLRE 0,E ; FIND DOPE + SUB E,0 + MOVEI E,1(E) ; POINT TO LAST DOPE + CAMN E,TPGROW ; GROWING? + SOJA E,VECMQ1 ; YES, CHECK + ADDI E,PDLBUF ; FUDGE + MOVSI 0,-PDLBUF + ADDM 0,1(C) + SOJA E,VECMQ1 + +OFFSMQ: HLRZS E ; POINT TO LIST STRUCTURE + SKIPGE (E) ; MARKED? + AOS (P) ; YES + POPJ P, + + ; SUBROUTINE TO UPDATE ASSOCIATIONS AND MOVE THEM INTO THE INF + +ASSOUP: MOVE A,GCNOD ; RECOVER PTR TO START OF CHAIN +ASSOP1: HRRZ B,NODPNT(A) + PUSH P,B ; SAVE NEXT ON CHAIN + PUSH P,A ; SAVE IT + HRRZ B,ASOLNT-1(A) ;POINT TO NEXT + JUMPE B,ASOUP1 + HRRZ C,ASOLNT+1(B) ;AND GET ITS RELOC IN C + SUBI C,ASOLNT+1(B) ; RELATIVIZE + ADDM C,ASOLNT-1(A) ;C NOW HAS UPDATED POINTER +ASOUP1: HLRZ B,ASOLNT-1(A) ;GET PREV BLOCK POINTER + JUMPE B,ASOUP2 + HRRZ F,ASOLNT+1(B) ;AND ITS RELOCATION + SUBI F,ASOLNT+1(B) ; RELATIVIZE + MOVSI F,(F) + ADDM F,ASOLNT-1(A) ;RELOCATE +ASOUP2: HRRZ B,NODPNT(A) ;UPDATE NODE CHAIN + JUMPE B,ASOUP4 + HRRZ C,ASOLNT+1(B) ;GET RELOC + SUBI C,ASOLNT+1(B) ; RELATIVIZE + ADDM C,NODPNT(A) ;AND UPDATE +ASOUP4: HLRZ B,NODPNT(A) ;GET PREV POINTER + JUMPE B,ASOUP5 + HRRZ F,ASOLNT+1(B) ;RELOC + SUBI F,ASOLNT+1(B) + MOVSI F,(F) + ADDM F,NODPNT(A) +ASOUP5: POP P,A ; RECOVER PTR TO DOPE WORD + MOVEI A,ASOLNT+1(A) + MOVSI B,400000 ;UNMARK IT + XORM B,(A) + HRRZ E,(A) ; SET UP PTR TO INF + HLRZ B,(A) + SUBI E,-1(B) ; ADJUST PTR + PUSHJ P,ADPMOD + PUSHJ P,TRBLK ; OUT IT GOES + POP P,A ; RECOVER PTR TO ASSOCIATION + JUMPN A,ASSOP1 ; IF NOT ZERO CONTINUP + POPJ P, ; DONE + + +; HERE TO CLEAN UP ATOM HASH TABLE + +ATCLEA: MOVE A,GCHSHT ; GET TABLE POINTER + +ATCLE1: MOVEI B,0 + SKIPE C,(A) ; GET NEXT + JRST ATCLE2 ; GOT ONE + +ATCLE3: PUSHJ P,OUTATM + AOBJN A,ATCLE1 + + MOVE A,GCHSHT ; MOVE OUT TABLE + PUSHJ P,SPCOUT + POPJ P, + +; HAVE AN ATOM IN C + +ATCLE2: MOVEI B,0 + +ATCLE5: CAIL C,HIBOT + JRST ATCLE3 + CAMG C,VECBOT ; FROZEN ATOMS ALWAYS MARKED + JRST .+3 + SKIPL 1(C) ; SKIP IF ATOM MARKED + JRST ATCLE6 + + HRRZ 0,1(C) ; GET DESTINATION + CAIN 0,-1 ; FROZEN/MAGIC ATOM + MOVEI 0,1(C) ; USE CURRENT POSN + SUBI 0,1 ; POINT TO CORRECT DOPE + JUMPN B,ATCLE7 ; JUMP IF GOES INTO ATOM + + HRRZM 0,(A) ; INTO HASH TABLE + JRST ATCLE8 + +ATCLE7: HRLM 0,2(B) ; INTO PREV ATOM + PUSHJ P,OUTATM + +ATCLE8: HLRZ B,1(C) + ANDI B,377777 ; KILL MARK BIT + SUBI B,2 + HRLI B,(B) + SUBM C,B + HLRZ C,2(B) + JUMPE C,ATCLE3 ; DONE WITH BUCKET + JRST ATCLE5 + +; HERE TO PASS OVER LOST ATOM + +ATCLE6: HLRZ F,1(C) ; FIND NEXT ATOM + SUBI C,-2(F) + HLRZ C,2(C) + JUMPE B,ATCLE9 + HRLM C,2(B) + JRST .+2 +ATCLE9: HRRZM C,(A) + JUMPE C,ATCLE3 + JRST ATCLE5 + +OUTATM: JUMPE B,CPOPJ + PUSH P,A + PUSH P,C + HLRE A,B + SUBM B,A + MOVSI D,400000 ;UNMARK IT + XORM D,1(A) + HRRZ E,1(A) ; SET UP PTR TO INF + HLRZ B,1(A) + SUBI E,-1(B) ; ADJUST PTR + MOVEI A,1(A) + PUSHJ P,ADPMOD + PUSHJ P,TRBLK ; OUT IT GOES + POP P,C + POP P,A ; RECOVER PTR TO ASSOCIATION + POPJ P, + + +VCMLOS: FATAL AGC--VECTOR WITH ZERO IN DOPE WORD LENGTH + + +; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC + +MSGGCT: [ASCIZ /USER CALLED- /] + [ASCIZ /FREE STORAGE- /] + [ASCIZ /TP-STACK- /] + [ASCIZ /TOP-LEVEL LOCALS- /] + [ASCIZ /GLOBAL VALUES- /] + [ASCIZ /TYPES- /] + [ASCIZ /STATIONARY IMPURE STORAGE- /] + [ASCIZ /P-STACK /] + [ASCIZ /BOTH STACKS BLOWN- /] + [ASCIZ /PURE STORAGE- /] + [ASCIZ /GC-RCALL- /] + +; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC + +GCPAT: SPBLOK 100 +EGCPAT: -1 + +MSGGFT: [ASCIZ /GC-READ /] + [ASCIZ /BLOAT /] + [ASCIZ /GROW /] + [ASCIZ /LIST /] + [ASCIZ /VECTOR /] + [ASCIZ /SET /] + [ASCIZ /SETG /] + [ASCIZ /FREEZE /] + [ASCIZ /PURE-PAGE LOADER /] + [ASCIZ /GC /] + [ASCIZ /INTERRUPT-HANDLER /] + [ASCIZ /NEWTYPE /] + [ASCIZ /PURIFY /] + +.GLOBAL GCNO,BSTGC,BSTAT,NOWFRE,CURFRE,MAXFRE,USEFRE,NOWTP,CURTP,CTPMX,NOWLFL +.GLOBAL CURLVL,NOWGVL,CURGVL,NOWTYP,CURTYP,NOWSTO,CURSTO,CURMAX,NOWP,CURP,CPMX +.GLOBAL GCCAUS,GCCALL,LVLINC,GVLINC,TYPIC,STORIC,RCL,RCLV,GCDANG,GETNUM,RPTOP,CORTOP +.GLOBAL TPGROW,PPGROW,PGROW,PMAIN,PGOOD,PMAX,TPGOOD,TPMIN,TPMAX,RFRETP,TYPTAB +.GLOBAL NNPRI,NNSAT,TYPSAV,BUFGC,GCTIM,GPURFL,GCDFLG,DUMFLG +.GLOBAL TPBINC,GBLINC,TYPINC,CONADJ,OGCSTP,ABOTN,MAXLEN +.GLOBAL PURMIN,GCMONF,.LIST.,FPAG,PMIN,GLBINC,INCORF,PURCOR,GCHAIR + + +;LOCAL VARIABLES + +OFFSET 0 + +IMPURE +; LOCACTIONS USED BY THE PAGE HACKER + +DOPSV1: 0 ;SAVED FIRST D.W. +DOPSV2: 0 ; SAVED LENGTH + + +; LOCATIONS USED BY BLOAT-STAT TO HELP THE USER PICK BLOAT SPECIFICATIONS. +; + +GCNO: 0 ; USER-CALLED GC +BSTGC: 0 ; FREE STORAGE + 0 ; BLOWN TP + 0 ; TOP-LEVEL LVALS + 0 ; GVALS + 0 ; TYPE + 0 ; STORAGE + 0 ; P-STACK + 0 ; BOTH STATCKS BLOWN + 0 ; STORAGE + +BSTAT: +NOWFRE: 0 ; FREE STORAGE FROM LAST GC +CURFRE: 0 ; STORAGE USED SINCE LAST GC +MAXFRE: 0 ; MAXIMUM FREE STORAGE ALLOCATED +USEFRE: 0 ; TOTAL FREE STORAGE USED +NOWTP: 0 ; TP LENGTH FROM LAST GC +CURTP: 0 ; # WORDS ON TP +CTPMX: 0 ; MAXIMUM SIZE OF TP SO FAR +NOWLVL: 0 ; # OF TOP-LEVEL LVAL-SLOTS +CURLVL: 0 ; # OF TOP-LEVEL LVALS +NOWGVL: 0 ; # OF GVAL SLOTS +CURGVL: 0 ; # OF GVALS +NOWTYP: 0 ; SIZE OF TYPE-VECTOR +CURTYP: 0 ; # OF TYPES +NOWSTO: 0 ; SIZE OF STATIONARY STORAGE +CURSTO: 0 ; STATIONARY STORAGE IN USE +CURMAX: 0 ; MAXIMUM BLOCK OF CONTIGUOUS STORAGE +NOWP: 0 ; SIZE OF P-STACK +CURP: 0 ; #WORDS ON P +CPMX: 0 ; MAXIMUM P-STACK LENGTH SO FAR +GCCAUS: 0 ; INDICATOR FOR CAUSE OF GC +GCCALL: 0 ; INDICATOR FOR CALLER OF GC + + +; THIS GROUP OF VARIABLES DETERMINES HOW THINGS GROW +LVLINC: 6 ; LVAL INCREMENT ASSUMED TO BE 64 SLOTS +GVLINC: 4 ; GVAL INCREMENT ASSUMED TO BE 64 SLOTS +TYPIC: 1 ; TYPE INCREMENT ASSUMED TO BE 32 TYPES +STORIC: 2000 ; STORAGE INCREMENT USED BY NFREE (MINIMUM BLOCK-SIZE) + + +RCL: 0 ; POINTER TO LIST OF RECYCLEABLE LIST CELLS +RCLV: 0 ; POINTER TO RECYCLED VECTORS +GCMONF: 0 ; NON-ZERO SAY GIN/GOUT +GCDANG: 0 ; NON-ZERO, STORAGE IS LOW +INBLOT: 0 ; INDICATE THAT WE ARE RUNNING OIN A BLOAT +GETNUM: 0 ;NO OF WORDS TO GET +RFRETP: +RPTOP: 0 ;NO OF BLOCKS OF CORE, IF GIVING CORE AWAY +CORTOP: 0 ;CURRENT TOP OF CORE, EXCLUDING ANY TO BE GIVEN AWAY +NGCS: 8 ; NUMBER OF GARBAGE COLLECTS BETWEEN HAIRY GCS + +;VARIABLES WHICH DETERMIN WHEN MUDDLE WILL ASK FOR MORE CORE, +;AND WHEN IT WILL GET UNHAPPY + +FREMIN: 20000 ;MINIMUM FREE WORDS + +;POINTER TO GROWING PDL + +TPGROW: 0 ;POINTS TO A BLOWN TP +PPGROW: 0 ;POINTS TO A BLOWN PP +PGROW: 0 ;POINTS TO A BLOWN P + +;IN GC FLAG + +GCFLG: 0 +GCFLCH: 0 ; TELL INT HANDLER TO ITIC CHARS +GCHAIR: 1 ; COUNTS GCS AND TELLS WHEN TO HAIRIFY +GCDOWN: 0 ; AMOUNT TO TRY AND MOVE DOWN +CURPLN: 0 ; LENGTH OF CURRENTLY RUNNING PURE RSUBR +PURMIN: 0 ; MINIMUM PURE STORAGE + +; VARS ASSOCIATED WITH BLOAT LOGIC +PMIN: 200 ; MINIMUM FOR PSTACK +PGOOD: 1000 ; GOOD SIZE FOR PSTACK +PMAX: 4000 ; MAX SIZE FOR PSTACK +TPMIN: 1000 ; MINIMUM SIZE FOR TP +TPGOOD: NTPGOO ; GOOD SIZE OF TP +TPMAX: NTPMAX ; MAX SIZE OF TP + +TPBINC: 0 +GLBINC: 0 +TYPINC: 0 + +; VARS FOR PAGE WINDOW HACKS + +GCHSHT: 0 ; SAVED ATOM TABLE +PURSVT: 0 ; SAVED PURVEC TABLE +GLTOP: 0 ; SAVE GLOTOP +GCNOD: 0 ; PTR TO START OF ASSOCIATION CHAIN +GCGBSP: 0 ; SAVED GLOBAL SP +GCASOV: 0 ; SAVED PTR TO ASSOCIATION VECTOR +GCATM: 0 ; PTR TO IMQUOT THIS-PROCESS +FNTBOT: 0 ; BOTTOM OF FRONTEIR +WNDBOT: 0 ; BOTTOM OF WINDOW +WNDTOP: 0 +BOTNEW: (FPTR) ; POINTER TO FRONTIER +GCTIM: 0 +NPARBO: 0 ; SAVED PARBOT + +; FLAGS TO INDICATE DUMPER IS IN USE + +GPURFL: 0 ; INDICATE PURIFIER IS RUNNING +GCDFLG: 0 ; INDICATE EITHER GCDUMP OR PURIFIER IS RUNNING +DUMFLG: 0 ; FLAG INDICATING DUMPER IS RUNNING + +; CONSTANTS FOR DUMPER,READER AND PURIFYER + +ABOTN: 0 ; COUNTER FOR ATOMS +NABOTN: 0 ; POINTER USED BY PURIFY +OGCSTP: 0 ; CONTAINS OLD GCSTOP FOR READER +MAPUP: 0 ; BEGINNING OF MAPPED UP PURE STUFF +SAVRES: 0 ; SAVED UPDATED ITEM OF PURIFIER +SAVRE2: 0 ; SAVED TYPE WORD +SAVRS1: 0 ; SAVED PTR TO OBJECT +INF1: 0 ; AOBJN PTR USED IN CREATING PROTECTION INF +INF2: 0 ; AOBJN PTR USED IN CREATING SECOND INF +INF3: 0 ; AOBJN PTR USED TO PURIFY A STRUCTURE + +; VARIABLES USED BY GC INTERRUPT HANDLER + +GCHPN: 0 ; SET TO -1 EVERYTIME A GC HAS OCCURED +GCKNUM: 0 ; NUMBER OF WORDS OF REQUEST TO INTERRUPT + +; VARIABLE TO INDICATE WHETHER AGC HAS PUSHED THE MAPPING CHANNEL TO WIN + +PSHGCF: 0 + +; VARIABLES USED BY DUMPER AND READER TO HANDLE NEWTYPES + +TYPTAB: 0 ; POINTER TO TYPE TABLE +NNPRI: 0 ; NUMPRI FROM DUMPED OBJECT +NNSAT: 0 ; NUMSAT FROM DUMPED OBJECT +TYPSAV: 0 ; SAVE PTR TO TYPE VECTOR + +; VARIABLES USED BY GC-DUMP FOR COPY-WRITE MAPPING + +BUFGC: 0 ; BUFFER FOR COPY ON WRITE HACKING +PURMNG: 0 ; FLAG INDICATING IF A PURIFIED PAGE WAS MUNGED DURING GC-DUMP +RPURBT: 0 ; SAVED VALUE OF PURTOP +RGCSTP: 0 ; SAVED GCSTOP + +; VARIABLES USED TO DETERMINE WHERE THE GC-DUMPED STRUCTURE SHOULD GO + +INCORF: 0 ; INDICATION OF UVECTOR HACKS FOR GC-DUMP +PURCOR: 0 ; INDICATION OF UVECTOR TO PURE CORE + ; ARE NOT GENERATED + + +PLODR: 0 ; INDICATE A PLOAD IS IN OPERATION +NPRFLG: 0 + +; VARIABLE USED BY MARK SWEEP GARBAGE COLLECTOR + +MAXLEN: 0 ; MAXIMUM RECLAIMED SLOT + +PURE + +OFFSET OFFS + +CONSTANTS + +HERE + +CONSTANTS + +OFFSET 0 + +ZZ==$.+1777 + +.LOP ANDCM ZZ 1777 + +ZZ1==.LVAL1 + +LOC ZZ1 + + +OFFSET OFFS + +WIND: SPBLOK 2000 +FRONT: SPBLOK 2000 +MRKPD: SPBLOK 1777 +ENDPDL: -1 + +MRKPDL=MRKPD-1 + +ENDGC: + +OFFSET 0 + +.LOP WIND <,-10.> +WNDP==.LVAL1 + +.LOP FRONT <,-10.> +FRNP==.LVAL1 + +ZZ2==ENDGC-AGCLD +.LOP ZZ2 <,-10.> +LENGC==.LVAL1 + +.LOP LENGC <,10.> +RLENGC==.LVAL1 + +.LOP AGCLD <,-10.> +PAGEGC==.LVAL1 + +OFFSET 0 + +LOC GCST +.LPUR==$. + +END + diff --git a//agcmrk.bin.3 b//agcmrk.bin.3 new file mode 100644 index 0000000000000000000000000000000000000000..780f18aca631ab54d193b16e1bc7575410abcfa4 GIT binary patch literal 185 zcmZRuP+(wS3(8Vpa9{ueelv{#5Y1e#Y3Iwsz`&uwz{~*>Z~+lubsz=^FxTs</agcmrk.mid.1 b//agcmrk.mid.1 new file mode 100644 index 0000000..6c87a46 --- /dev/null +++ b//agcmrk.mid.1 @@ -0,0 +1,14 @@ +TITLE AGCMRK ESTABLISH AGC LOADING POINT + +RELOCA + +.GLOBAL AGCLD + +XX==$.+1777 + +.LOP ANDCM XX,1777 + +AGCLD=.LVAL1 + +END + \ No newline at end of file diff --git a//amsgc.bin.12 b//amsgc.bin.12 new file mode 100644 index 0000000000000000000000000000000000000000..113a9e53fc35d3edce3e927e3c51e164c86b8704 GIT binary patch literal 14090 zcmdU0`&$}IlkOP?L1oBJE`+Ur{H0+C{Ji4>dHO3v>{zTm5l&qwSt^Fd zzD~7=A9i;ZsU&{YXZ!2LNv}!SJ+F5SuCucOSJSy!)EZiy zAR#_x^@7t2gOi-^w7ETYj^M);j=r1 zo>a#TFgj+R4A#dwK@}YsOmVYu@L5q$Uy4moyTFV2K4lPu2+YoGj5@nCr%%^fuPV@} z$rfn|^#`Bc)#uQd?OF;{R*<~Za#p1v@nK>tK=|Ch1k{s0mAjAtJ|%{}@I!ioV5M3G5SBdea4O9WtOndQjgzz=7jqu4XBsRbZwbq|&`X;E3*-dCJlGyYs zP}@Ygzk%8zih%3XeNv!?8;dZ`=->W){G1skNUAd%(`3dzXo;fx!`Z*XeLN2C^JFYsWB%=2T`0LouCl?$Ip4Vm`O+o3^N&!DjTOwiE+Y*m4^K1 zhJ+mUL@D%8+n3A2&AtltPX=Ql1O@{UlpNC-U5bqjHTAbdygV+O{ClBI7Nc-GLOa9l z1*>S6MH@-%k^g8&s@Awv_PzI;dkNnZg~vt=*u|t}7)A_^a zGKU#yHXf z>$CNbxhB1{=R)u_rxJ|VZ^&w->Zqq-))1I|$={V<`P*6fr)c$wIo>R&@0_0u@%yd& zJMC!{gIf8yj;Nu=UC)eYMK291Hjy=^PK?nn^Zz3f3fY*xjg8w&sAS{uZEW0L!bUb8 z-NuGS5>vO4_}{Q$CsYq_gQ{AhS$TcF!C7*AsCfr&$Px$Hn3OjD4T(CkF>xCkx0i5| zjq%&qxV=O@*?1sr_;=eM^Wq{tI2UKLH+Z*NBIw-yu5&!z?KU`eZ;)`2jWKECzabG^ zdZ3v$R@$Eayun5T*%-ZI<6n?)la2egv2l9|57`*Gjg8w&G?I;BX`}gMt*sKlpMk@h zB6xcVFWE@k#)gk1;#VYUj`Kex>b;-LmE?G5(^I}7OYV@3A!)-O{`|qrs}Bo*`ESar zKO_R34^3ZvSX-F8$ya`|5tBBW-*_q#$F|}>l4xqJuSlFM@7yTSL^cMc4gb`kx6+Rx z<@~08{2|e$zpO}P=OZ^s1jt5I+6W9RteX<=pL9n5i9~Hw&1B=Av{Ad~x0eW#jR9%H z-?_9iDz;}40Ns9MQJpR`eXw^S{``#N*wR3pbXMX-%* z^hz7Im#B@Zoow_-8?_}uBysnege}PZz&^2bbi+9BAc@E|i5ff0YKdUY^&?C+x}}ZU zSyC-gyXT!`LzgygFHsv+7uo2NHf}Fbd;QSKMyIsluQ~ffNTNeZ)ZWA0C5e!fs2#y> zk_g{MqPicoZB+N8cF(K(QM>0o)Q@)AkJ?$%OA>AWu0$W%XuV>iuOsx;9JR@3Z=5%b z+CL;}u7mw#qveW?ns1QR617+70kRR4HfpbGe@N8aQ&&f@cFe1DxAv-bkNVLp`w=)v zY?|>n{yEuyQ#>jXfBP{4Z~21X@-;d-DEB-byZJN#2PEPb9a7>n;9^f^r=(P)I$r?ve^EIlnHcD&!PRHketUw0- zX!P_DA-i%gbFnAzqfKv}hZr`N_~R=S0$S?Qlfq7WbiEI{iCPTxkH1Qe9zsKSV@q?4 z^nvmZezx`TVbU%gY#Bb}0mB{Z0e3!&Iyx{l&uEJd6ix0NX=$V*F4Dqv<`LJ0E(E!0 zk&7zj%Pu}3m`#oXpWHhX&^qDMe+jn1_^J#^eNgat+&pjwASa)UDXQi*GlWQ`n^=u!M>ON&XnYCfNtWgr5C!{}5Cr_}*?Od|tyRO1>)RRQV;* z*HSK%dON#Lat+@M&g(3%#bHCCM6#QJCO;cEpxMKw*v z0G$12xv5@{!W&hmhD(3qjoXOntqO{LW1j|a>poi65j z4V)%3AUnPKN?(O-YlEMw99HEkh19U@E*;OB{fMBBJ+!lU@JS(j1KyNSM551IF56F5 zW{j!`;@GvTJPhZwl84m5qiubZl~P?l4y(NeF|@!#|6waLs>0n&N|~XN>~>#Qxm+Yb zNhF~;{DujYiGCjx*%%u9nQ1H%z7gS@QOtgRh-vr^CQf%kR3+^C^ zHOj^swPSq}ft}v`IgFSm4IdB0e-KMn&vBDUQzCqJdS@^0fvS8mz`-;({=94Zh7a85 zBBiKxdq`2lw+f$BrP5L)lS_x6*`19^+qrV3`%=P2JDxR-JmmJ4e+|?3Jjvzwa{eVK zv}D&K{leUZ?80$|@I6ajV4~$Ekb$do(jl>!a}#Ni2_g*%RT%0Tjl!f(d1@dS0Yv-M!Sf^|SVK0IlQH_#gDKZR>j(TC_H416xLa3biNP*mXptVQ zLh%S5E97x=eY@TdDf?*Zm9|g#K9+p6*3+30N0l~Ic8+Qhd8G_vdASk*>fn`rAUBd1 zQYmS%TaNvstF%$#v>=`M?72Fhpii}!4=#gT*=nHpWi}RTBYfYnUt3WrbIb`Uw6oLm zM#tpFYWBs_kpxNoe97hK0$CI)iZ7H9vL{e0us^PU4gZa_iM@$+noF|#Uo3Il@lg%2{`1Zy6ocBhU8*HhqA zoM>YBw(wLKICU#P56o}~15x~KR$&FKin%yZ3f>vZLbD<2Ua7Ely2a{uT~Hs7>Ow^J zpk?K0x%?ab4c?hJf}2?E65r_-#4#!eU)*&;6lC=*B*wos#RmzWAKMSi-f7g4tbZCv z@$nSU5;_=NbYtrQKKK9b-UHG;Vvt=CS0Taag9Qi@DJn)WdRT(AD1^$-NZBQWP$!}) z7+X-F@U;NWL^&<#j>|55Xg|0UBz$3SUN8B$N8C$m{}Pbt+htuzXbNtgjoE^n z@^VJ6n$l>6P}&2Lce;-0Ma1cWAxXE^M$1PubD3K(MzG~TzYgZm=H=Je!7<_MHPC|W z3KOIrMUw=r(^hCPF(%9juc>OQ#?vrv%y{!e!4OQcApjRX)*|b0%i`M{-@)MP7a04M z-JA}eHmlj?g`9YWWwbO0+h-e9`IllQ&qFPM8q8o_o&`%FTSLU zmlM;2w7w}5Xlba&Xsir4TFP;{VPLwhuMhhR&ZaSpRfVaCDwYmbHIhO*|3UJ|@ETgh z_cs5YJ;Y)wS!6q}6}Y=#5Aobi@em}YKh!)Gc$jKpJ=@cqU^CF2CQMc#m*qN#u-Xny{|2-q4VPWP%Ln#eeF?R1facNwBf zhgT3S?2GX*j**Sp;J|TPsQ&?0Q+Pu>9?Q6R{4N-@k!unUj@wwvuG&>Dhf9y@jlC4w z1-qsyjKJW%*wF*v6R9kkG;a>=H!?`%pK?KllmOXaEgChB)B6XBl^#5Wm>xyu5TnG6 zIsc@DgADObKiKssc9hQrUdG6Oc|{Y7xefV>n2Hhi>78=3@nmn)?zB4D|mHu zxsQJBeAZ$WLlzabs7{O0Eh=JBcd3)YD)w1af421f3$|Rt$~)}QuQa)5H5s(^Cw@)F zN}sWfx#{YQb(+Eho9yU%@=0Q+_GyZ$UK|__Vz`#e8v1)?nT%P~kVVCr;!`2Ak+2xU z7Byl~_bo~~ag6JDBSH$sttOJ1417pEwjo+L9=i}&uP+1ekg3JB`GqB>03`80kh{ z&ln0*A$=}cNapm+>gw{Ujv7N0UgR_SMrO8vilya(zC5R2tqOTCTv8W@ugeCSL-X=_ zfdqTTpqYO?V;J4IrX&=pe$@5d!S^Tq+=Q*=mlu`_nN^+tuIZ!)w&s(ospNb{pIy%7 z03wst*Ye5Pj81l09~3z8QgVqol|+kVK}QFZ^RwK{gn?5J+&7~ug4o0gQCL{aOzW4d z>Yg8IO%n&?zbQcWYlYyhAYsR+-uTMQCMK{<)!563w>cRPXN{m zEhGAmL&6s`xfQEeNKLcQoLVkq(GnQe^i*#7`4Y@kq%T3v&kn7c7thg+3R0@ez=u$f zTZSJ=|NQE*dF4~&7S_xvQOO8m({C+(%)%=5wvG=LZhLv~^A1qgBRar47_x~rDtQ*26VrIfu> zethG=p43IMPCGY{%=lg2*teDMx#!-`;NVc$I91cc<#t5S&sL6odi$s(Oa-6EDhirA zkJ^}jZz%V=SDwPQXlTN}flq%u`~COx2J{Jy#*9I&84yn%gG)0D_;QBL9(POqZtfOl?>g;kT+oawxH11r0+mE}Jab}`eH&0v$Bmf_y8JWy@x`h_eG{IQjn1M$ z9Iw^4$lmdHca;KeN6q+WPxUIVI!p!AD??d>YOg5xe0JO^ozq1Bb3rXcEI$&NVKHxW zz~$r0%b;M+E#2)slRlu(subE^A`8E;gtytDe0$|t|LdZL7CEDn1RK})U;VBVc`TA; ztaiTzoeLxgMn3ZT%bA30tpT{c`XurD4+-eYM?U_(^6}+ANc=5uX!)c2Bk`+B30ejC z+LzNmVEntltxU9{Q2PHH1xj=^cN(6r^7v4C!9OVj-<~`D$(sz(8~v_bxqr&C9E$1o z@B3FI{G^l_L(%X16aT?O|Hs4q4?Pr`O?6=E!LMhm_w|PSF8Pl=bS zB;?2f$P$fX(q7J6#}Y3b!w`RION4Z$+)}P%*8cTxPMOZ)kHd7 z_==qjCXZCXpBW-TI6kO_PQKTj8T(rIgScWoYaG%?#huJY>OO%?i^ zN2!^fDs*4GCdx<^hW2!#wAt2qlM*}gA;)8(WB9v5cKUA@t^doH^x?fjvB@((78~|B hFIhad^P2LyzWK$v*fVDhQi)%=3r^&pK}DWz{|kWH)O`Q| literal 0 HcmV?d00001 diff --git a//amsgc.mid.107 b//amsgc.mid.107 new file mode 100644 index 0000000..2d66f20 --- /dev/null +++ b//amsgc.mid.107 @@ -0,0 +1,865 @@ +TITLE AMSGC MUDDLE MARK SWEEP GARBAGE COLLECTOR + +RELOCATABLE + +.GLOBAL RCL,RCLV,IAMSGC,MAXLEN,REALGC,RGCLEN,GCFLG,SQUPNT,GCMONF,MSGTYP,GCCAUS +.GLOBAL GCCALL,PVSTOR,DSTORE,TYPVEC,N.CHNS,CHNL1,MAINPR,STOGC,CTIME,GCTIM,IMTYO +.GLOBAL FNMSGC,SATMSK,NUMSAT,NUMPRI,PURBOT,GCSTOP,GCSBOT,STOSTR,TYPMSK,PDLBUF,ITEM,INDIC +.GLOBAL VAL,NODPNT,UBIT,ASOLNT,GCHAPN,RBLDM,TOTCNT,MARK2S,MKTBS +.GLOBAL FRMUNG,BYTDOP,TD.GET,TD.LNT,TD.AGC,ABOTN,SLENGC,LENGC,REALGC,AGCLD,RLENGC +.GLOBAL RSLENG + +GCST=$. + +LOC REALGC+RLENGC + +OFFS=AGCLD-$. +OFFSET OFFS + +.INSRT MUDDLE > + +TYPNT==AB +F==PVP + + +; THIS IS THE MUDDLE MARK SWEEP GARBAGE COLLECTOR. IT IS MUCH FASTER THAN THE COPYING +; GARBAGE COLLECTOR BUT DOESN'T COMPACT. IT CONSES FREE THINGS ONTO RCL AND RCLV. +; THIS GARBAGE COLLECTOR CAN ONLY BE USED IF THE GARBAGE COLLECT IS A FREE STORAGE +; GARBAGE COLLECT + + +; FIRST INITIALIZE VARIABLES + +IAMSGC: SETZB M,RCL ; CLEAR OUT LIST RECYCLE AND RSUBR BASE + SETZM RCLV ; CLEAR VECTOR RECYCLE + SETZM MAXLEN ; CLEAR MAXIMUM LENGTH FOUND TO RECYCLE + SETOM GCFLG ; A GC HAS HAPPENED + SETZM TOTCNT + HLLZS SQUPNT ; CLEAR OUT SQUOZE TABLE + +; SET UP MESSAGE PRINTING AND SAVE CAUSE AND CAUSER + + PUSH P,A + PUSH P,B + PUSH P,C ; SAVE ACS + MOVEI B,[ASCIZ /MSGIN / ] ; PRINT GIN IF WINNING + SKIPE GCMONF + PUSHJ P,MSGTYP + HRRZ C,(P) ; GET CAUSE INDICATOR + ADDI B,1 ; AOS TO GET REAL CAUS + MOVEM B,GCCAUS + SKIPN GCMONF + JRST NOMON2 + MOVE B,MSGGCT(C) ; GET CAUSE MESSAGE + PUSHJ P,MSGTYP +NOMON2: HLRZ C,(P) ; FIND OUT WHO CAUSED THE GC + MOVEM C,GCCALL + SKIPN GCMONF ; PRINT IF GCMON IS ON + JRST NOMON3 + MOVE B,MSGGFT(C) ; GET POINTER TO MESSAGE + PUSHJ P,MSGTYP +NOMON3: SUB P,[1,,1] + POP P,B ; RESTORE ACS + POP P,A + +; MOVE ACS INTO THE PVP + + EXCH PVP,PVSTOR+1 ; GET REAL PROCESS VECTOR + + IRP AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P] + MOVEM AC,AC!STO+1(PVP) + TERMIN + + MOVE 0,PVSTOR+1 ; GET OLD VALUE OF PVP + MOVEM 0,PVPSTO+1(PVP) ; SAVE PVP + MOVE 0,DSTORE ; SAVE D'S TYPE + MOVEM 0,DSTO(PVP) + MOVEM PVP,PVSTOR+1 + +; SET UP TYPNT TO POINT TO TYPE VECTOR + + GETYP E,TYPVEC ; FIRST SEE IF TYPVEC IS A VECTOR + CAIE E,TVEC + FATAL TYPE VECTOR NOT OF TYPE VECTOR + HRRZ TYPNT,TYPVEC+1 + HRLI TYPNT,B ; TYPNT IS NOW TYPEVECTOR(B) + +; NOW SET UP GCPDL AND FENCE POST PDL'S + + MOVEI A,(TB) + MOVE D,P ; SAVE P POINTER + PUSHJ P,FRMUNG + MOVE P,[-2000,,MRKPDL] ; SET UP MARK PDL + MOVEI A,(TB) ; FIXUP TOP FRAME + SETOM 1(TP) ; FENCEPOST TP + SETOM 1(D) ; FENCEPOST P + +; NOW SETUP AUTO CHANNEL CLOSE + + MOVEI 0,N.CHNS-1 ; NUMBER OF CHANNELS + MOVEI A,CHNL1 ; FIRST CHANNEL SLOT +CHNCLR: SKIPE 1(A) ; IS IT A CHANNEL + SETZM (A) ; CLEAR UP TYPE SLOT + ADDI A,2 + SOJG 0,CHNCLR + +; NOW DO MARK AND SWEEP PHASES + + MOVSI D,400000 ; MARK BIT + MOVEI B,TPVP ; GET TYPE + MOVE A,PVSTOR+1 ; GET VALUE OF CURRENT PROCESS VECTOR + PUSHJ P,MARK + MOVEI B,TPVP ; GET TYPE OF MAIN PROCESS VECTOR + MOVE A,MAINPR + PUSHJ P,MARK ; MARK + PUSHJ P,CHNFLS ; DO CHANNEL FLUSHING + PUSHJ P,STOGC ; FIX UP FROZEN WORLD + PUSHJ P,SWEEP ; SWEEP WORLD + +; PRINT GOUT + + MOVEI B,[ASCIZ /MSGOUT /] ; PRINT OUT ENDING MESSAGE IF GCMONING + SKIPE GCMONF + PUSHJ P,MSGTYP + +; RESTORE ACS + + MOVE PVP,PVSTOR+1 ; GET PVP + IRP AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P] + MOVE AC,AC!STO+1(PVP) + TERMIN + + SKIPN DSTORE ; CLEAR OUT TYPE IF NO TYPE THERE + SETZM DSTO(PVP) + MOVE PVP,PVPSTO+1(PVP) + +; PRINT TIME + + PUSH P,A ; SAVE ACS + PUSH P,B + PUSH P,C + PUSH P,D + PUSHJ P,CTIME ; GET CURRENT CPU TIME + FSBR B,GCTIM ; COMPUTE TIME ELAPSED + MOVEM B,GCTIM ; SAVE TIME AWAY + SKIPN GCMONF ; PRINT IT OUT? + JRST GCCONT + PUSHJ P,FIXSEN + MOVEI A,15 ; OUTPUT CR/LF + PUSHJ P,IMTYO + MOVEI A,12 + PUSHJ P,IMTYO +GCCONT: POP P,D ; RESTORE ACS + POP P,C + POP P,B + POP P,A + SETZM GCFLG + SETOM GCHAPN + SETOM INTFLG + PUSHJ P,RBLDM + JRST FNMSGC ; DONE + + +; THIS IS THE MARK PHASE + +; GENERAL MARK ROUTINE, CALLED TO MARK ALL THINGS +; /A POINTER TO GOODIE +; /B TYPE OF GOODIE +; FOR MARK2, MARK1 /C POINTER TO PAIR NOT NEEDED FOR CALLS DIRECTLY TO MARK + +MARK2S: +MARK2: HLRZ B,(C) ; TYPE +MARK1: MOVE A,1(C) ; VALUE +MARK: JUMPE A,CPOPJ ; DONE IF ZERO + MOVEI 0,1(A) ; SEE IF PURE + CAML 0,PURBOT + JRST CPOPJ + ANDI B,TYPMSK ; FLUSH MONITORS + HRLM C,(P) + CAIG B,NUMPRI ; IS A BASIC TYPE + JRST @MTYTBS(B) ; TYPE DISPATCH + LSH B,1 ; NOW GET PRIMTYPE + HRRZ B,@TYPNT ; GET PRIMTYPE + ANDI B,SATMSK ; FLUSH DOWN TO SAT + CAIG B,NUMSAT ; SKIP IF TEMPLATE DATA + JRST @MSATBS(B) ; JUMP OFF SAT TABLE + JRST TD.MK + +GCRET: HLRZ C,(P) ; GET SAVED C +CPOPJ: POPJ P, + +; TYPE DISPATCH TABLE +MTYTBS: + +OFFSET 0 + +DUM1: + +IRP XX,,[[TLOSE,GCRET],[TFIX,GCRET],[TFLOAT,GCRET],[TCHRS,GCRET] +[TENTRY,GCRET],[TSUBR,GCRET],[TFSUBR,GCRET],[TILLEG,GCRET],[TUNBOU,GCRET] +[TBIND,GCRET],[TTIME,GCRET],[TLIST,PAIRMK],[TFORM,PAIRMK],[TSEG,PAIRMK] +[TEXPR,PAIRMK],[TFUNAR,PAIRMK],[TLOCL,PAIRMK],[TFALSE,PAIRMK],[TDEFER,DEFQMK] +[TUVEC,UVMK],[TOBLS,UVMK],[TVEC,VECMK],[TCHAN,VECMK] ,[TLOCV,VECMK] +[TTVP,VECMK],[TBVL,VECMK],[TTAG,VECMK],[TPVP,VECMK],[TLOCI,TPMK],[TTP,TPMK] +[TSP,TPMK],[TMACRO,PAIRMK],[TPDL,PMK],[TARGS,ARGMK],[TAB,ABMK] +[TTB,TBMK],[TFRAME,FRMK],[TCHSTR,BYTMK],[TATOM,ATOMK],[TLOCD,LOCMK],[TBYTE,BYTMK] +[TENV,FRMK],[TACT,FRMK],[TASOC,ASMK],[TLOCU,UVMK],[TLOCS,BYTMK],[TLOCA,ASMK] +[TCBLK,GCRET],[TTMPLT,TD.MK],[TLOCT,TD.MK],[TLOCR,GCRET],[TINFO,GCRET] +[TRDTB,GCRDMK],[TWORD,GCRET],[TRSUBR,VECMK],[TCODE,UVMK],[TSATC,GCRET] +[TBITS,GCRET],[TSTORA,UVMK],[TPICTU,UVMK],[TSKIP,TPMK],[TLINK,ATOMK] +[TDECL,PAIRMK],[TENTER,VECMK],[THAND,VECMK],[TINTH,VECMK],[TDISMI,ATOMK] +[TDCLI,PAIRMK],[TPCODE,GCRET],[TTYPEW,GCRET],[TTYPEC,GCRET] +[TGATOM,GATOMK],[TREADA,FRMK],[TUBIND,GCRET],[TUNWIN,TBMK],[TLOCB,BYTMK] +[TDEFQ,DEFQMK],[TSPLIC,PAIRMK],[TLOCN,ASMK],[TOFFS,OFFSMK]] + IRP A,B,[XX] + LOC DUM1+A + SETZ B + .ISTOP + TERMIN +TERMIN + +LOC DUM1+NUMPRI+1 + +OFFSET OFFS + +; SAT DISPATCH TABLE + +MSATBS: + +OFFSET 0 + +DISTB2 DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,UVMK],[STBASE,TBMK] +[STPSTK,TPMK],[SARGS,],[S2NWORD,VECMK],[SPSTK,TPMK],[SSTORE,UVMK] +[SFRAME,],[SBYTE,],[SATOM,ATOMK],[SPVP,VECMK],[SGATOM,GATOMK] +[SLOCID,],[SCHSTR,],[SASOC,ASMK],[SLOCL,PAIRMK],[SABASE,ABMK] +[SLOCA,],[SLOCV,VECMK],[SLOCU,UVMK],[SLOCS,],[SLOCN,ASMK] +[SRDTB,GCRDMK],[SLOCB,],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]] + +OFFSET OFFS + + +; ROUTINE TO MARK PAIRS + +PAIRMK: MOVEI C,(A) +PAIRM1: CAMG C,GCSTOP ; SEE IF IN RANGE + CAIGE C,STOSTR + JRST BADPTR ; FATAL ERROR + HLRE B,(C) ; SKIP IF NOT MARKED + JUMPL B,GCRET + IORM D,(C) ; MARK IT + PUSHJ P,MARK1 ; MARK THE ITEM + HRRZ C,(C) ; GET NEXT ELEMENT OF LIST + JUMPE C,GCRET + CAML C,PURBOT + JRST GCRET + JRST PAIRM1 + +; ROUTINE TO MARK DEFERS + +DEFMK: HLRE B,(A) + JUMPL B,GCRET + MOVEI C,(A) + IORM D,(C) + PUSHJ P,MARK1 + JRST GCRET + +; ROUTINE TO MARK POSSIBLE DEFERS DEF? + +DEFQMK: GETYP B,(A) ; GET THE TYPE OF THE OBJECT + LSH B,1 ; COMPUTE THE SAT + HRRZ B,@TYPNT + ANDI B,SATMSK + SKIPL MKTBS(B) ; SKIP IF NOT DEFERED + JRST PAIRMK + JRST DEFMK ; GO TO DEFMK + + +; ROUTINE TO MARK VECTORS + +VECMK: HLRE B,A ; GET LENGTH + SUB A,B + MOVEI C,1(A) ; POINT TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + HLRE B,(C) + JUMPL B,GCRET + IORM D,(C) ; MARK IT + SUBI C,-1(B) ; GET TO BEGINNING +VECMK1: HLRE B,(C) ; GET TYPE AND SKIP IF NOT DOPE WORD + JUMPL B,GCRET ; DONE + PUSHJ P,MARK1 ; MARK IT + ADDI C,2 ; NEXT ELEMENT + JRST VECMK1 + +; ROUTINE TO MARK UVECTORS + +UVMK: HLRE B,A ; GET LENGTH + SUB A,B ; A POINTS TO FIRST DOPE WORD + MOVEI C,1(A) ; C POINTS TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + HLRE F,(C) ; GET LENGTH + JUMPL F,GCRET + IORM D,(C) ; MARK IT + GETYP B,-1(C) ; GET TYPE + MOVEI E,(B) ; COPY TYPE FOR SAT COMPUTATION + LSH B,1 + HRRZ B,@TYPNT ; GET SAT + ANDI B,SATMSK + MOVEI B,@MSATBS(B) ; GET JUMP LOCATION + CAIN B,GCRET + JRST GCRET + SUBI C,(F) ; POINT TO BEGINNING OF UVECTOR + SUBI F,2 + JUMPE F,GCRET + PUSH P,F ; SAVE LENGTH + PUSH P,E +UNLOOP: MOVE B,(P) + MOVE A,1(C) ; GET VALUE POINTER + PUSHJ P,MARK + SOSE -1(P) ; SKIP IF NON-ZERO + AOJA C,UNLOOP ; GO BACK AGAIN + SUB P,[2,,2] ; CLEAN OFF STACK + JRST GCRET + +; ROUTINE TO INDICATE A BAD POINTER + +BADPTR: FATAL POINTER POINTS OUT OF GARBAGE COLLECTED SPACE + JRST GCRET + + +; ROUTINE TO MARK A TPSTACK + +TPMK: HLRE B,A ; GET LENGTH + SUB A,B ; A POINTS TO FIRST DOPE WORD + MOVEI C,PDLBUF+1(A) ; C POINTS TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + HLRE A,(C) + JUMPL A,GCRET + IORM D,(C) ; MARK IT + SUBI C,-1(A) ; GO TO BEGINNING + +TPLP: HLRE B,(C) ; GET TYPE AND MARKING + JUMPL B,GCRET ; EXIT ON FENCE-POST + ANDI B,TYPMSK ; FLUSH MONITORS + CAIE B,TCBLK ; CHECK FOR FRAME + CAIN B,TENTRY + JRST MFRAME ; MARK THE FRAME + CAIE B,TUBIND ; BINDING BLOCK + CAIN B,TBIND + JRST MBIND + PUSHJ P,MARK1 ; NOTHING SPECIAL SO MARK IT + ADDI C,2 ; POINT TO NEXT OBJECT + JRST TPLP ; MARK IT + +; MARK A FRAME ON THE STACK, [I.E. ITS FSAV AND PSAV SLOTS] + +MFRAME: HRROI C,FRAMLN+FSAV-1(C) ; POINT TO FUNCTION + HRRZ A,1(C) ; GET POINTER + CAIL A,STOSTR ; SEE IF IN GC SPACE + CAMLE A,GCSTOP + JRST MFRAM1 ; SKIP OVER IT, NOT IN GC-SPACE + HRL A,(A) ; GET LENGTH + MOVEI B,TVEC ; TYPE IS VECTOR [RSUBR OR RSUBR-ENTRY] + PUSHJ P,MARK +MFRAM1: MOVE A,PSAV-FSAV+1(C) ; MARK THE PSTACK + MOVEI B,TPDL + PUSHJ P,MARK + HRROI C,-FSAV+1(C) ; POINT PAST FRAME + JRST TPLP ; GO BACK TO START OF LOOP + +; MARK A BINDING ON THE STACK [I.E. THE ATOM, VALUE, DECL, AND PREVIOUS BINDING] + +MBIND: MOVEI B,TATOM ; START BY MARKING THE ATOM + PUSHJ P,MARK1 ; MARK IT + ADDI C,2 ; POINT TO VALUE SLOT + PUSHJ P,MARK2 ; MARK THE VALUE + ADDI C,2 ; POINT TO DECL AND PREV BINDING + MOVEI B,TLIST ; MARK DECL + HLRZ A,(C) + PUSHJ P,MARK + SKIPL A,1(C) ; SKIP IF PREVIOUS BINDING + JRST NOTLCI + MOVEI B,TLOCI ; GET TYPE + PUSHJ P,MARK +NOTLCI: ADDI C,2 ; POINT PAST BINDING + JRST TPLP + + +PMK: HLRE B,A ; GET LENGTH + SUB A,B ; A POINTS TO FIRST DOPE WORD + MOVEI C,PDLBUF+1(A) ; C POINTS TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + IORM D,(C) ; MARK IT + JRST GCRET + +; ROUTINE TO MARK TB POINTER + +TBMK: HRRZS A ; CHECK FOR NIL POINTER + SKIPN A + JRST GCRET + MOVE A,TPSAV(A) ; GET A TP POINTER + MOVEI B,TTP ; TYPE WORD + PUSHJ P,MARK + JRST GCRET + +; ROUTINE TO MARK AB POINTERS + +ABMK: HLRE B,A ; GET TO FRAME + SUB A,B + MOVE A,FRAMLN+TPSAV(A) ; GET A TP POINTER + MOVEI B,TTP ; TYPE WORD + PUSHJ P,MARK + JRST GCRET + +; ROUTINE TO MARK FRAME POINTERS + +FRMK: HRLZ B,A ; GET THE TIME + HLRZ F,OTBSAV(A) ; GET TIME FROM FRAME + CAIE B,(F) ; SKIP IF TIMES AGREE + JRST GCRET ; IGNORE POINTER IF THEY DONT + HRRZ A,(C) ; GET POINTER TO PROCESS + SUBI A,1 ; FUDGE FOR VECTOR MARKING + MOVEI B,TPVP ; TYPE WORD + PUSHJ P,MARK + HRRZ A,1(C) ; GET POINTER TO FRAME + JRST TBMK ; MARK IT + +; ROUTINE TO MARK ARGUMENT BLOCKS [TUPLES] + +ARGMK: HLRE B,A ; GET LENGTH + SUB A,B ; POINT PAST BLOCK + CAIL A,STOSTR + CAMLE A,GCSTOP ; SEE IF IN GCSPACE + JRST GCRET + HRLZ 0,(A) ; GET TYPE + ANDI 0,TYPMSK ; FLUSH MONITORS + CAIE 0,TENTRY + CAIN 0,TCBLK + JRST ARGMK1 ; AT FRAME + CAIE 0,TINFO ; AT FRAME + JRST GCRET ; NOT A LEGAL TYPE GO AWAY + HRRZ A,1(A) ; POINTING TO FRAME + HRL A,(C) ; GET TIME + JRST TBMK +ARGMK1: HRRI A,FRAMLN(A) ; MAKE POINTER + HRL A,(C) ; GET TIME + JRST TBMK + + +; ROUTINE TO MARK GLOBAL SLOTS + +GATOMK: HRRZ B,(C) ; GET POSSIBLE GDECL + JUMPE B,ATOMK ; NONE GO TO MARK ATOM + CAIN B,-1 ; SKIP IF NOT MANIFEST + JRST ATOMK + PUSH P,A ; I DOUBT THIS IS RIGHT, BUT IT WORKED ONCE--TAA + MOVEI C,(A) + MOVEI A,(B) + MOVEI B,TLIST ; TYPE WORD LIST + PUSHJ P,MARK ; MARK IT + POP P,A + JRST ATOMK5 + +ATOMK: +ATOMK5: HLRE B,A + SUB A,B ; A POINTS TO DOPE WORD + SKIPGE 1(A) ; SKIP IF NOT MARKED + JRST GCRET ; EXIT IF MARKED + HLRZ B,1(A) + SUBI B,3 + HRLI B,1(B) + MOVEI C,-1(A) + SUB C,B ; IN CASE WAS DW + IORM D,1(A) ; MARK IT + HRRZ A,2(C) ; MARK OBLIST + CAMG A,VECBOT + JRST NOOBL ; NO IMPURE OBLIST + HRLI A,-1 + MOVEI B,TOBLS ; MARK THE OBLIST + PUSHJ P,MARK +NOOBL: HLRZ A,2(C) ; GET NEXT ATOM + MOVEI B,TATOM + PUSHJ P,MARK + HLRZ B,(C) ; GET VALUE SLOT + TRZ B,400000 ; TURN OFF MARK BIT + SKIPE B ; SEE IF 0 + CAIN B,TUNBOUN ; SEE IF UNBOUND + JRST GCRET + HRRZ 0,(C) ; SEE IF VECTOR OR TP POINTER + MOVEI B,TVEC ; ASSUME VECTOR + SKIPE 0 ; SKIP IF VECTOR + MOVEI B,TTP ; IT IS A TP POINTER + PUSHJ P,MARK1 ; GO MARK IT + JRST GCRET + +; ROUTINE TO MARK BYTE AND STRING POINTERS + +BYTMK: PUSHJ P,BYTDOP ; GET TO DOPE WORD INTO A + HRLZ F,-1(A) ; SEE IF SPECIAL ATOM [SPNAME] + ANDI F,SATMSK ; GET SAT + CAIN F,SATOM + JRST ATMSET ; IT IS AN ATOM + IORM D,(A) ; MARK IT + JRST GCRET + +ATMSET: HLRZ B,(A) ; GET LENGTH + TRZ B,400000 ; TURN OFF POSSIBLE MARK BIT + MOVNI B,-2(B) ; GENERATE AOBJN POINTER + ADDI A,-1(B) ; GET BACK TO BEGINNING + HRLI A,(B) ; PUT IN LEFT HALF + MOVEI B,TATOM ; MARK AS AN ATOM + PUSHJ P,MARK ; GO MARK + JRST GCRET + +; MARK LOCID GOODIES + +LOCMK: HRRZ B,(C) ; CHECK FOR TIME + JUMPE B,LOCMK1 ; SKIP LEGAL CHECK FOR GLOBAL + HRRZ 0,2(A) ; GET OTHER TIME + CAIE 0,(B) ; SAME? + JRST GCRET + MOVEI B,TTP + PUSHJ P,MARK1 + JRST GCRET +LOCMK1: MOVEI B,TVEC ; GLOBAL + PUSHJ P,MARK1 ; MARK VALUE + JRST GCRET + +; MARK ASSOCIATION BLOCK + +ASMK: MOVEI C,(A) ; SAVE POINTER TO BEGINNING OF ASSOCATION + ADDI A,ASOLNT ; POINT TO DOPE WORD + HLRE B,1(A) ; GET SECOND D.W. + JUMPL B,GCRET ; MARKED SO LEAVE + IORM D,1(A) ; MARK ASSOCATION + PUSHJ P,MARK2 ; MARK ITEM + MOVEI C,INDIC(C) + PUSHJ P,MARK2 + MOVEI C,VAL-INDIC(C) + PUSHJ P,MARK2 + HRRZ A,NODPNT-VAL(C) ; GET NEXT IN CHAIN + JUMPN A,ASMK ; GO MARK IT + JRST GCRET + +; MARK OFFSETS + +OFFSMK: PUSH P,$TLIST + HLRZ 0,1(C) ; PICK UP LIST POINTER + PUSH P,0 + MOVEI C,-1(P) + PUSHJ P,MARK2 ; MARK THE LIST + SUB P,[2,,2] + JRST GCRET ; AND RETURN + +; HERE TO MARK TEMPLATE DATA STRUCTURES + +TD.MK: HLRZ B,(A) ; GET REAL SPEC TYPE + ANDI B,37777 ; KILL SIGN BIT + MOVEI E,-NUMSAT-1(B) ; GET REL POINTER TO TABLE + HRLI E,(E) + ADD E,TD.AGC+1 + HRRZS C,A ; FLUSH COUNT AND SAVE + SKIPL E ; WITHIN BOUNDS + FATAL BAD SAT IN AGC + SKIPL 1(A) ; SEE IF MARKED + JRST GCRET ; IF MARKED LEAVE + IORM D,1(A) + + SKIPE (E) + JRST USRAGC + SUB E,TD.AGC+1 ; POINT TO LENGTH + ADD E,TD.LNT+1 + XCT (E) ; RET # OF ELEMENTS IN B + + HLRZ D,B ; GET POSSIBLE "BASIC LENGTH" FOR RESTS + PUSH P,[0] ; TEMP USED IF RESTS EXIST + PUSH P,D + MOVEI B,(B) ; ZAP TO ONLY LENGTH + PUSH P,C ; SAVE POINTER TO TEMPLATE STRUCTURE + PUSH P,B ; SAVE + SUB E,TD.LNT+1 + PUSH P,E ; SAVE FOR FINDING OTHER TABLES + JUMPE D,TD.MR2 ; NO REPEATING SEQ + ADD E,TD.GET+1 ; COMP LNTH OF REPEATING SEQ + HLRE E,(E) ; E ==> - LNTH OF TEMPLATE + ADDI E,(D) ; E ==> -LENGTH OF REP SEQ + MOVNS E + HRLM E,-3(P) ; SAVE IT AND BASIC + +TD.MR2: SKIPG D,-1(P) ; ANY LEFT? + JRST TD.MR1 + + MOVE E,TD.GET+1 + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + MOVEM D,-4(P) ; SAVE ELMENT # + SKIPN B,-3(P) ; SKIP IF "RESTS" EXIST + SOJA D,TD.MR3 + + MOVEI 0,(B) ; BASIC LNT TO 0 + SUBI 0,(D) ; SEE IF PAST BASIC + JUMPGE 0,.-3 ; JUMP IF O.K. + MOVSS B ; REP LNT TO RH, BASIC TO LH + IDIVI 0,(B) ; A==> -WHICH REPEATER + MOVNS A + ADD A,-3(P) ; PLUS BASIC + ADDI A,1 ; AND FUDGE + MOVEM A,-4(P) ; SAVE FOR PUTTER + ADDI E,-1(A) ; POINT + SOJA D,.+2 + +TD.MR3: ADDI E,(D) ; POINT TO SLOT + XCT (E) ; GET THIS ELEMENT INTO A AND B + JFCL ; NO-OP FOR ANY CASE + EXCH A,B ; REARRANGE + HLRZS B + MOVSI D,400000 ; RESET FOR MARK + PUSHJ P,MARK ; AND MARK THIS GUY (RET FIXED POINTER IN A) + MOVE C,-2(P) ; RESTORE POINTER IN CASE MUNGED + JRST TD.MR2 + +TD.MR1: SUB P,[5,,5] + JRST GCRET + +USRAGC: XCT (E) ; MARK THE TEMPLATE + JRST GCRET + + +; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS +; AND UPDATES PTR TO THE TABLE. + +GCRDMK: MOVEI C,(A) ; SAVE POINTER TO GCREAD TABLE + HLRE B,A ; GET TO DOPE WORD + SUB A,B + SKIPGE 1(A) ; SKIP IF NOT MARKED + JRST GCRET + SUBI A,2 + MOVE B,ABOTN ; GET TOP OF ATOM TABLE + ADD B,0 ; GET BOTTOM OF ATOM TABLE +GCRD1: CAMG A,B ; DON'T SKIP IF DONE + JRST GCRET + HLRZ C,(A) ; GET MARKING + TRZN C,400000 ; SKIP IF MARKED + JRST GCRD3 + MOVEI E,(A) + SUBI A,(C) ; GO BACK ONE ATOM + PUSH P,B ; SAVE B + PUSH P,A ; SAVE POINTER + MOVEI C,-2(E) ; SET UP POINTER + MOVEI B,TATOM ; GO TO MARK + MOVE A,1(C) + PUSHJ P,MARK + POP P,A + POP P,B + JRST GCRD1 +GCRD3: SUBI A,(C) ; TO NEXT ATOM + JRST GCRD1 + + +; ROUTINE TO FIX UP CHANNELS + +CHNFLS: MOVEI 0,N.CHNS-1 + MOVE A,[TCHAN,,CHNL1] ; SET UP POINTER +CHFL1: SKIPN B,1(A) ; GET POINTER TO CHANNEL + JRST CHFL2 ; NO CHANNEL LOOP TO NEXT + HLRE C,B ; POINT TO DOPE WORD OF CHANNEL + SUBI B,(C) + HLLM A,(A) ; PUT TYPE BACK + SKIPL 1(B) ; SKIP IF MARKED + JRST FLSCH ; FLUSH THE CHANNEL + MOVEI F,1 ; MARK THE CHANNEL AS GOOD + HRRM F,(A) ; SMASH IT IN +CHFL2: ADDI A,2 + SOJG 0,CHFL1 + POPJ P, ; EXIT +FLSCH: HLLOS F,(A) ; -1 INTO SLOT INDICATES LOSSAGE + JRST CHFL2 + + + + +; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL +; POINT. + +FIXSEN: PUSH P,B ; SAVE TIME + MOVEI B,[ASCIZ /TIME= /] + PUSHJ P,MSGTYP ; PRINT OUT MESSAGE + POP P,B ; RESTORE B + FMPRI B,(100.0) ; CONVERT TO FIX + MULI B,400 + TSC B,B + ASH C,-163.(B) + MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME + PUSH P,C + IDIVI C,10. ; START COUNTING + JUMPLE C,.+2 + AOJA A,.-2 + POP P,C + CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER + JRST DOT1 +FIXOUT: IDIVI C,10. ; RECOVER NUMBER + HRLM D,(P) + SKIPE C + PUSHJ P,FIXOUT + PUSH P,A ; SAVE A + CAIN A,2 ; DECIMAL POINT HERE? + JRST DOT2 +FIX1: HLRZ A,(P)-1 ; GET NUMBER + ADDI A,60 ; MAKE IT A CHARACTER + PUSHJ P,IMTYO ; OUT IT GOES + POP P,A + SOJ A, + POPJ P, +DOT1: MOVEI A,". ; OUTPUT DECIMAL POINT AND PADDING 0 + PUSHJ P,IMTYO + MOVEI A,"0 + PUSHJ P,IMTYO + JRST FIXOUT ; CONTINUE +DOT2: MOVEI A,". ; OUTPUT DECIMAL POINT + PUSHJ P,IMTYO + JRST FIX1 + + +; ROUTINE TO SEEP THROUGH GC SPACE LOOKING FOR FREE SLOTS. PAIRS ARE PLACED ON THE +; RCL LIST, VECTORS ON THE RCLV LIST. + +SWEEP: MOVE C,GCSTOP ; GET TOP OF GC SPACE + SUBI C,1 ; POINT TO FIRST OBJECT + SETZB E,F ; CURRENT SLOT AND CURRENT LENGTH +LSWEEP: CAMG C,GCSBOT ; SKIP IF ABOVE GCSBOT + JRST ESWEEP ; DONE + HLRE A,-1(C) ; SEE IF LIST OR VECTOR + TRNE A,UBIT ; SKIP IF LIST + JRST VSWEEP ; IT IS A VECTOR + JUMPGE A,LSWP1 ; JUMP IF NOT MARKED + ANDCAM D,-1(C) ; TURN OFF MARK BIT + PUSHJ P,SWCONS ; CONS ON CURRENT OBJECT + SUBI C,2 ; SKIP OVER LIST + JRST LSWEEP +LSWP1: ADDI F,2 ; ADD TO CURRENT OBJECT COUNT + JUMPN E,LSWP2 ; JUMP IF CURRENT OBJECT EXISTS + MOVEI E,(C) ; GET ADDRESS +LSWP2: SUBI C,2 + JRST LSWEEP + +VSWEEP: HLRE A,(C) ; GET LENGTH + JUMPGE A,VSWP1 ; SKIP IF MARKED + ANDCAM D,(C) ; TURN OFF MARK BIT + PUSHJ P,SWCONS + ANDI A,377777 ; GET LENGTH PART + SUBI C,(A) ; GO PAST VECTOR + JRST LSWEEP +VSWP1: ADDI F,(A) ; ADD LENGTH + JUMPN E,VSWP2 + MOVEI E,(C) ; GET NEW OBJECT LOCATION +VSWP2: SUBI C,(A) ; GO BACK PAST VECTOR + JRST LSWEEP + +ESWEEP: +SWCONS: JUMPE E,CPOPJ + ADDM F,TOTCNT ; HACK TOTCNT + CAMLE F,MAXLEN ; SEE IF NEW MAXIMUM + MOVEM F,MAXLEN + CAIGE F,2 ; MAKE SURE AT LEAST TWO LONG + FATAL SWEEP FAILURE + CAIN F,2 + JRST LCONS + SETZM (E) + MOVEI 0,(E) + SUBI 0,-1(F) + SETZM @0 + HRLS 0 + ADDI 0,1 + BLT 0,-2(E) + HRRZ 0,RCLV ; GET VECTOR RECYCLE + HRRM 0,(E) ; SMASH INTO LINKING SLOT + HRRZM E,RCLV ; NEW RECYCLE SLOT + HRLM F,(E) + MOVSI F,UBIT + MOVEM F,-1(E) + SETZB E,F + POPJ P, ; DONE +LCONS: SETZM (E) + SUBI E,1 + HRRZ 0,RCL ; GET RECYCLE LIST + HRRZM 0,(E) ; SMASH IN + HRRZM E,RCL + SETZB E,F + POPJ P, + + +; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC + +MSGGCT: [ASCIZ /USER CALLED- /] + [ASCIZ /FREE STORAGE- /] + [ASCIZ /TP-STACK- /] + [ASCIZ /TOP-LEVEL LOCALS- /] + [ASCIZ /GLOBAL VALUES- /] + [ASCIZ /TYPES- /] + [ASCIZ /STATIONARY IMPURE STORAGE- /] + [ASCIZ /P-STACK /] + [ASCIZ /BOTH STACKS BLOWN- /] + [ASCIZ /PURE STORAGE- /] + [ASCIZ /GC-RCALL- /] + +; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC + +GCPAT: SPBLOK 100 +EGCPAT: -1 + +MSGGFT: [ASCIZ /GC-READ /] + [ASCIZ /BLOAT /] + [ASCIZ /GROW /] + [ASCIZ /LIST /] + [ASCIZ /VECTOR /] + [ASCIZ /SET /] + [ASCIZ /SETG /] + [ASCIZ /FREEZE /] + [ASCIZ /PURE-PAGE LOADER /] + [ASCIZ /GC /] + [ASCIZ /INTERRUPT-HANDLER /] + [ASCIZ /NEWTYPE /] + [ASCIZ /PURIFY /] + +CONSTANTS + +HERE + +CONSTANTS + +OFFSET 0 + +ZZ==$.+1777 + +.LOP ANDCM ZZ 1777 + +ZZ1==.LVAL1 + +LOC ZZ1 + +OFFSET OFFS + +MRKPDL==.-1 + +ENDGC: + +OFFSET 0 + +ZZ2==ENDGC-AGCLD + +.LOP ZZ2 <,-10.> +SLENGC==.LVAL1 +.LOP SLENGC <10.> +RSLENG==.LVAL1 +LOC GCST + +.LPUR=$. + +END diff --git a//amsgc.mid.108 b//amsgc.mid.108 new file mode 100644 index 0000000..4379f68 --- /dev/null +++ b//amsgc.mid.108 @@ -0,0 +1,886 @@ +TITLE AMSGC MUDDLE MARK SWEEP GARBAGE COLLECTOR + +RELOCATABLE + +.GLOBAL RCL,RCLV,IAMSGC,MAXLEN,REALGC,RGCLEN,GCFLG,SQUPNT,GCMONF,MSGTYP,GCCAUS +.GLOBAL GCCALL,PVSTOR,DSTORE,TYPVEC,N.CHNS,CHNL1,MAINPR,STOGC,CTIME,GCTIM,IMTYO +.GLOBAL FNMSGC,SATMSK,NUMSAT,NUMPRI,PURBOT,GCSTOP,GCSBOT,STOSTR,TYPMSK,PDLBUF,ITEM,INDIC +.GLOBAL VAL,NODPNT,UBIT,ASOLNT,GCHAPN,RBLDM,TOTCNT,MARK2S,MKTBS +.GLOBAL FRMUNG,BYTDOP,TD.GET,TD.LNT,TD.AGC,ABOTN,SLENGC,LENGC,REALGC,AGCLD,RLENGC +.GLOBAL RSLENG + +GCST=$. + +LOC REALGC+RLENGC + +OFFS=AGCLD-$. +OFFSET OFFS + +.INSRT MUDDLE > + +TYPNT==AB +F==PVP + + +; THIS IS THE MUDDLE MARK SWEEP GARBAGE COLLECTOR. IT IS MUCH FASTER THAN THE COPYING +; GARBAGE COLLECTOR BUT DOESN'T COMPACT. IT CONSES FREE THINGS ONTO RCL AND RCLV. +; THIS GARBAGE COLLECTOR CAN ONLY BE USED IF THE GARBAGE COLLECT IS A FREE STORAGE +; GARBAGE COLLECT + + +; FIRST INITIALIZE VARIABLES + +IAMSGC: SETZB M,RCL ; CLEAR OUT LIST RECYCLE AND RSUBR BASE + SETZM RCLV ; CLEAR VECTOR RECYCLE + SETZM MAXLEN ; CLEAR MAXIMUM LENGTH FOUND TO RECYCLE + SETOM GCFLG ; A GC HAS HAPPENED + SETZM TOTCNT + HLLZS SQUPNT ; CLEAR OUT SQUOZE TABLE + +; SET UP MESSAGE PRINTING AND SAVE CAUSE AND CAUSER + + PUSH P,A + PUSH P,B + PUSH P,C ; SAVE ACS + MOVEI B,[ASCIZ /MSGIN / ] ; PRINT GIN IF WINNING + SKIPE GCMONF + PUSHJ P,MSGTYP + HRRZ C,(P) ; GET CAUSE INDICATOR + ADDI B,1 ; AOS TO GET REAL CAUS + MOVEM B,GCCAUS + SKIPN GCMONF + JRST NOMON2 + MOVE B,MSGGCT(C) ; GET CAUSE MESSAGE + PUSHJ P,MSGTYP +NOMON2: HLRZ C,(P) ; FIND OUT WHO CAUSED THE GC + MOVEM C,GCCALL + SKIPN GCMONF ; PRINT IF GCMON IS ON + JRST NOMON3 + MOVE B,MSGGFT(C) ; GET POINTER TO MESSAGE + PUSHJ P,MSGTYP +NOMON3: SUB P,[1,,1] + POP P,B ; RESTORE ACS + POP P,A + +; MOVE ACS INTO THE PVP + + EXCH PVP,PVSTOR+1 ; GET REAL PROCESS VECTOR + + IRP AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P] + MOVEM AC,AC!STO+1(PVP) + TERMIN + + MOVE 0,PVSTOR+1 ; GET OLD VALUE OF PVP + MOVEM 0,PVPSTO+1(PVP) ; SAVE PVP + MOVE 0,DSTORE ; SAVE D'S TYPE + MOVEM 0,DSTO(PVP) + MOVEM PVP,PVSTOR+1 + +; SET UP TYPNT TO POINT TO TYPE VECTOR + + GETYP E,TYPVEC ; FIRST SEE IF TYPVEC IS A VECTOR + CAIE E,TVEC + FATAL TYPE VECTOR NOT OF TYPE VECTOR + HRRZ TYPNT,TYPVEC+1 + HRLI TYPNT,B ; TYPNT IS NOW TYPEVECTOR(B) + +; NOW SET UP GCPDL AND FENCE POST PDL'S + + MOVEI A,(TB) + MOVE D,P ; SAVE P POINTER + PUSHJ P,FRMUNG + MOVE P,[-2000,,MRKPDL] ; SET UP MARK PDL + MOVEI A,(TB) ; FIXUP TOP FRAME + SETOM 1(TP) ; FENCEPOST TP + SETOM 1(D) ; FENCEPOST P + +; NOW SETUP AUTO CHANNEL CLOSE + + MOVEI 0,N.CHNS-1 ; NUMBER OF CHANNELS + MOVEI A,CHNL1 ; FIRST CHANNEL SLOT +CHNCLR: SKIPE 1(A) ; IS IT A CHANNEL + SETZM (A) ; CLEAR UP TYPE SLOT + ADDI A,2 + SOJG 0,CHNCLR + +; NOW DO MARK AND SWEEP PHASES + + MOVSI D,400000 ; MARK BIT + MOVEI B,TPVP ; GET TYPE + MOVE A,PVSTOR+1 ; GET VALUE OF CURRENT PROCESS VECTOR + PUSHJ P,MARK + MOVEI B,TPVP ; GET TYPE OF MAIN PROCESS VECTOR + MOVE A,MAINPR + PUSHJ P,MARK ; MARK + PUSHJ P,CHNFLS ; DO CHANNEL FLUSHING + PUSHJ P,CHFIX + PUSHJ P,STOGC ; FIX UP FROZEN WORLD + PUSHJ P,SWEEP ; SWEEP WORLD + +; PRINT GOUT + + MOVEI B,[ASCIZ /MSGOUT /] ; PRINT OUT ENDING MESSAGE IF GCMONING + SKIPE GCMONF + PUSHJ P,MSGTYP + +; RESTORE ACS + + MOVE PVP,PVSTOR+1 ; GET PVP + IRP AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P] + MOVE AC,AC!STO+1(PVP) + TERMIN + + SKIPN DSTORE ; CLEAR OUT TYPE IF NO TYPE THERE + SETZM DSTO(PVP) + MOVE PVP,PVPSTO+1(PVP) + +; PRINT TIME + + PUSH P,A ; SAVE ACS + PUSH P,B + PUSH P,C + PUSH P,D + PUSHJ P,CTIME ; GET CURRENT CPU TIME + FSBR B,GCTIM ; COMPUTE TIME ELAPSED + MOVEM B,GCTIM ; SAVE TIME AWAY + SKIPN GCMONF ; PRINT IT OUT? + JRST GCCONT + PUSHJ P,FIXSEN + MOVEI A,15 ; OUTPUT CR/LF + PUSHJ P,IMTYO + MOVEI A,12 + PUSHJ P,IMTYO +GCCONT: POP P,D ; RESTORE ACS + POP P,C + POP P,B + POP P,A + SETZM GCFLG + SETOM GCHAPN + SETOM INTFLG + PUSHJ P,RBLDM + JRST FNMSGC ; DONE + + +; THIS IS THE MARK PHASE + +; GENERAL MARK ROUTINE, CALLED TO MARK ALL THINGS +; /A POINTER TO GOODIE +; /B TYPE OF GOODIE +; FOR MARK2, MARK1 /C POINTER TO PAIR NOT NEEDED FOR CALLS DIRECTLY TO MARK + +MARK2S: +MARK2: HLRZ B,(C) ; TYPE +MARK1: MOVE A,1(C) ; VALUE +MARK: JUMPE A,CPOPJ ; DONE IF ZERO + MOVEI 0,1(A) ; SEE IF PURE + CAML 0,PURBOT + JRST CPOPJ + ANDI B,TYPMSK ; FLUSH MONITORS + HRLM C,(P) + CAIG B,NUMPRI ; IS A BASIC TYPE + JRST @MTYTBS(B) ; TYPE DISPATCH + LSH B,1 ; NOW GET PRIMTYPE + HRRZ B,@TYPNT ; GET PRIMTYPE + ANDI B,SATMSK ; FLUSH DOWN TO SAT + CAIG B,NUMSAT ; SKIP IF TEMPLATE DATA + JRST @MSATBS(B) ; JUMP OFF SAT TABLE + JRST TD.MK + +GCRET: HLRZ C,(P) ; GET SAVED C +CPOPJ: POPJ P, + +; TYPE DISPATCH TABLE +MTYTBS: + +OFFSET 0 + +DUM1: + +IRP XX,,[[TLOSE,GCRET],[TFIX,GCRET],[TFLOAT,GCRET],[TCHRS,GCRET] +[TENTRY,GCRET],[TSUBR,GCRET],[TFSUBR,GCRET],[TILLEG,GCRET],[TUNBOU,GCRET] +[TBIND,GCRET],[TTIME,GCRET],[TLIST,PAIRMK],[TFORM,PAIRMK],[TSEG,PAIRMK] +[TEXPR,PAIRMK],[TFUNAR,PAIRMK],[TLOCL,PAIRMK],[TFALSE,PAIRMK],[TDEFER,DEFQMK] +[TUVEC,UVMK],[TOBLS,UVMK],[TVEC,VECMK],[TCHAN,VECMK] ,[TLOCV,VECMK] +[TTVP,VECMK],[TBVL,VECMK],[TTAG,VECMK],[TPVP,VECMK],[TLOCI,TPMK],[TTP,TPMK] +[TSP,TPMK],[TMACRO,PAIRMK],[TPDL,PMK],[TARGS,ARGMK],[TAB,ABMK] +[TTB,TBMK],[TFRAME,FRMK],[TCHSTR,BYTMK],[TATOM,ATOMK],[TLOCD,LOCMK],[TBYTE,BYTMK] +[TENV,FRMK],[TACT,FRMK],[TASOC,ASMK],[TLOCU,UVMK],[TLOCS,BYTMK],[TLOCA,ASMK] +[TCBLK,GCRET],[TTMPLT,TD.MK],[TLOCT,TD.MK],[TLOCR,GCRET],[TINFO,GCRET] +[TRDTB,GCRDMK],[TWORD,GCRET],[TRSUBR,VECMK],[TCODE,UVMK],[TSATC,GCRET] +[TBITS,GCRET],[TSTORA,UVMK],[TPICTU,UVMK],[TSKIP,TPMK],[TLINK,ATOMK] +[TDECL,PAIRMK],[TENTER,VECMK],[THAND,VECMK],[TINTH,VECMK],[TDISMI,ATOMK] +[TDCLI,PAIRMK],[TPCODE,GCRET],[TTYPEW,GCRET],[TTYPEC,GCRET] +[TGATOM,GATOMK],[TREADA,FRMK],[TUBIND,GCRET],[TUNWIN,TBMK],[TLOCB,BYTMK] +[TDEFQ,DEFQMK],[TSPLIC,PAIRMK],[TLOCN,ASMK],[TOFFS,OFFSMK]] + IRP A,B,[XX] + LOC DUM1+A + SETZ B + .ISTOP + TERMIN +TERMIN + +LOC DUM1+NUMPRI+1 + +OFFSET OFFS + +; SAT DISPATCH TABLE + +MSATBS: + +OFFSET 0 + +DISTB2 DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,UVMK],[STBASE,TBMK] +[STPSTK,TPMK],[SARGS,],[S2NWORD,VECMK],[SPSTK,TPMK],[SSTORE,UVMK] +[SFRAME,],[SBYTE,],[SATOM,ATOMK],[SPVP,VECMK],[SGATOM,GATOMK] +[SLOCID,],[SCHSTR,],[SASOC,ASMK],[SLOCL,PAIRMK],[SABASE,ABMK] +[SLOCA,],[SLOCV,VECMK],[SLOCU,UVMK],[SLOCS,],[SLOCN,ASMK] +[SRDTB,GCRDMK],[SLOCB,],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]] + +OFFSET OFFS + + +; ROUTINE TO MARK PAIRS + +PAIRMK: MOVEI C,(A) +PAIRM1: CAMG C,GCSTOP ; SEE IF IN RANGE + CAIGE C,STOSTR + JRST BADPTR ; FATAL ERROR + HLRE B,(C) ; SKIP IF NOT MARKED + JUMPL B,GCRET + IORM D,(C) ; MARK IT + PUSHJ P,MARK1 ; MARK THE ITEM + HRRZ C,(C) ; GET NEXT ELEMENT OF LIST + JUMPE C,GCRET + CAML C,PURBOT + JRST GCRET + JRST PAIRM1 + +; ROUTINE TO MARK DEFERS + +DEFMK: HLRE B,(A) + JUMPL B,GCRET + MOVEI C,(A) + IORM D,(C) + PUSHJ P,MARK1 + JRST GCRET + +; ROUTINE TO MARK POSSIBLE DEFERS DEF? + +DEFQMK: GETYP B,(A) ; GET THE TYPE OF THE OBJECT + LSH B,1 ; COMPUTE THE SAT + HRRZ B,@TYPNT + ANDI B,SATMSK + SKIPL MKTBS(B) ; SKIP IF NOT DEFERED + JRST PAIRMK + JRST DEFMK ; GO TO DEFMK + + +; ROUTINE TO MARK VECTORS + +VECMK: HLRE B,A ; GET LENGTH + SUB A,B + MOVEI C,1(A) ; POINT TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + HLRE B,(C) + JUMPL B,GCRET + IORM D,(C) ; MARK IT + SUBI C,-1(B) ; GET TO BEGINNING +VECMK1: HLRE B,(C) ; GET TYPE AND SKIP IF NOT DOPE WORD + JUMPL B,GCRET ; DONE + PUSHJ P,MARK1 ; MARK IT + ADDI C,2 ; NEXT ELEMENT + JRST VECMK1 + +; ROUTINE TO MARK UVECTORS + +UVMK: HLRE B,A ; GET LENGTH + SUB A,B ; A POINTS TO FIRST DOPE WORD + MOVEI C,1(A) ; C POINTS TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + HLRE F,(C) ; GET LENGTH + JUMPL F,GCRET + IORM D,(C) ; MARK IT + GETYP B,-1(C) ; GET TYPE + MOVEI E,(B) ; COPY TYPE FOR SAT COMPUTATION + LSH B,1 + HRRZ B,@TYPNT ; GET SAT + ANDI B,SATMSK + MOVEI B,@MSATBS(B) ; GET JUMP LOCATION + CAIN B,GCRET + JRST GCRET + SUBI C,(F) ; POINT TO BEGINNING OF UVECTOR + SUBI F,2 + JUMPE F,GCRET + PUSH P,F ; SAVE LENGTH + PUSH P,E +UNLOOP: MOVE B,(P) + MOVE A,1(C) ; GET VALUE POINTER + PUSHJ P,MARK + SOSE -1(P) ; SKIP IF NON-ZERO + AOJA C,UNLOOP ; GO BACK AGAIN + SUB P,[2,,2] ; CLEAN OFF STACK + JRST GCRET + +; ROUTINE TO INDICATE A BAD POINTER + +BADPTR: FATAL POINTER POINTS OUT OF GARBAGE COLLECTED SPACE + JRST GCRET + + +; ROUTINE TO MARK A TPSTACK + +TPMK: HLRE B,A ; GET LENGTH + SUB A,B ; A POINTS TO FIRST DOPE WORD + MOVEI C,PDLBUF+1(A) ; C POINTS TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + HLRE A,(C) + JUMPL A,GCRET + IORM D,(C) ; MARK IT + SUBI C,-1(A) ; GO TO BEGINNING + +TPLP: HLRE B,(C) ; GET TYPE AND MARKING + JUMPL B,GCRET ; EXIT ON FENCE-POST + ANDI B,TYPMSK ; FLUSH MONITORS + CAIE B,TCBLK ; CHECK FOR FRAME + CAIN B,TENTRY + JRST MFRAME ; MARK THE FRAME + CAIE B,TUBIND ; BINDING BLOCK + CAIN B,TBIND + JRST MBIND + PUSHJ P,MARK1 ; NOTHING SPECIAL SO MARK IT + ADDI C,2 ; POINT TO NEXT OBJECT + JRST TPLP ; MARK IT + +; MARK A FRAME ON THE STACK, [I.E. ITS FSAV AND PSAV SLOTS] + +MFRAME: HRROI C,FRAMLN+FSAV-1(C) ; POINT TO FUNCTION + HRRZ A,1(C) ; GET POINTER + CAIL A,STOSTR ; SEE IF IN GC SPACE + CAMLE A,GCSTOP + JRST MFRAM1 ; SKIP OVER IT, NOT IN GC-SPACE + HRL A,(A) ; GET LENGTH + MOVEI B,TVEC ; TYPE IS VECTOR [RSUBR OR RSUBR-ENTRY] + PUSHJ P,MARK +MFRAM1: MOVE A,PSAV-FSAV+1(C) ; MARK THE PSTACK + MOVEI B,TPDL + PUSHJ P,MARK + HRROI C,-FSAV+1(C) ; POINT PAST FRAME + JRST TPLP ; GO BACK TO START OF LOOP + +; MARK A BINDING ON THE STACK [I.E. THE ATOM, VALUE, DECL, AND PREVIOUS BINDING] + +MBIND: MOVEI B,TATOM ; START BY MARKING THE ATOM + PUSHJ P,MARK1 ; MARK IT + ADDI C,2 ; POINT TO VALUE SLOT + PUSHJ P,MARK2 ; MARK THE VALUE + ADDI C,2 ; POINT TO DECL AND PREV BINDING + MOVEI B,TLIST ; MARK DECL + HLRZ A,(C) + PUSHJ P,MARK + SKIPL A,1(C) ; SKIP IF PREVIOUS BINDING + JRST NOTLCI + MOVEI B,TLOCI ; GET TYPE + PUSHJ P,MARK +NOTLCI: ADDI C,2 ; POINT PAST BINDING + JRST TPLP + + +PMK: HLRE B,A ; GET LENGTH + SUB A,B ; A POINTS TO FIRST DOPE WORD + MOVEI C,PDLBUF+1(A) ; C POINTS TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + IORM D,(C) ; MARK IT + JRST GCRET + +; ROUTINE TO MARK TB POINTER + +TBMK: HRRZS A ; CHECK FOR NIL POINTER + SKIPN A + JRST GCRET + MOVE A,TPSAV(A) ; GET A TP POINTER + MOVEI B,TTP ; TYPE WORD + PUSHJ P,MARK + JRST GCRET + +; ROUTINE TO MARK AB POINTERS + +ABMK: HLRE B,A ; GET TO FRAME + SUB A,B + MOVE A,FRAMLN+TPSAV(A) ; GET A TP POINTER + MOVEI B,TTP ; TYPE WORD + PUSHJ P,MARK + JRST GCRET + +; ROUTINE TO MARK FRAME POINTERS + +FRMK: HRLZ B,A ; GET THE TIME + HLRZ F,OTBSAV(A) ; GET TIME FROM FRAME + CAIE B,(F) ; SKIP IF TIMES AGREE + JRST GCRET ; IGNORE POINTER IF THEY DONT + HRRZ A,(C) ; GET POINTER TO PROCESS + SUBI A,1 ; FUDGE FOR VECTOR MARKING + MOVEI B,TPVP ; TYPE WORD + PUSHJ P,MARK + HRRZ A,1(C) ; GET POINTER TO FRAME + JRST TBMK ; MARK IT + +; ROUTINE TO MARK ARGUMENT BLOCKS [TUPLES] + +ARGMK: HLRE B,A ; GET LENGTH + SUB A,B ; POINT PAST BLOCK + CAIL A,STOSTR + CAMLE A,GCSTOP ; SEE IF IN GCSPACE + JRST GCRET + HRLZ 0,(A) ; GET TYPE + ANDI 0,TYPMSK ; FLUSH MONITORS + CAIE 0,TENTRY + CAIN 0,TCBLK + JRST ARGMK1 ; AT FRAME + CAIE 0,TINFO ; AT FRAME + JRST GCRET ; NOT A LEGAL TYPE GO AWAY + HRRZ A,1(A) ; POINTING TO FRAME + HRL A,(C) ; GET TIME + JRST TBMK +ARGMK1: HRRI A,FRAMLN(A) ; MAKE POINTER + HRL A,(C) ; GET TIME + JRST TBMK + + +; ROUTINE TO MARK GLOBAL SLOTS + +GATOMK: HRRZ B,(C) ; GET POSSIBLE GDECL + JUMPE B,ATOMK ; NONE GO TO MARK ATOM + CAIN B,-1 ; SKIP IF NOT MANIFEST + JRST ATOMK + PUSH P,A ; I DOUBT THIS IS RIGHT, BUT IT WORKED ONCE--TAA + MOVEI C,(A) + MOVEI A,(B) + MOVEI B,TLIST ; TYPE WORD LIST + PUSHJ P,MARK ; MARK IT + POP P,A + JRST ATOMK5 + +ATOMK: +ATOMK5: HLRE B,A + SUB A,B ; A POINTS TO DOPE WORD + SKIPGE 1(A) ; SKIP IF NOT MARKED + JRST GCRET ; EXIT IF MARKED + HLRZ B,1(A) + SUBI B,3 + HRLI B,1(B) + MOVEI C,-1(A) + SUB C,B ; IN CASE WAS DW + IORM D,1(A) ; MARK IT + HRRZ A,2(C) ; MARK OBLIST + CAMG A,VECBOT + JRST NOOBL ; NO IMPURE OBLIST + HRLI A,-1 + MOVEI B,TOBLS ; MARK THE OBLIST + PUSHJ P,MARK +NOOBL: HLRZ A,2(C) ; GET NEXT ATOM + MOVEI B,TATOM + PUSHJ P,MARK + HLRZ B,(C) ; GET VALUE SLOT + TRZ B,400000 ; TURN OFF MARK BIT + SKIPE B ; SEE IF 0 + CAIN B,TUNBOUN ; SEE IF UNBOUND + JRST GCRET + HRRZ 0,(C) ; SEE IF VECTOR OR TP POINTER + MOVEI B,TVEC ; ASSUME VECTOR + SKIPE 0 ; SKIP IF VECTOR + MOVEI B,TTP ; IT IS A TP POINTER + PUSHJ P,MARK1 ; GO MARK IT + JRST GCRET + +; ROUTINE TO MARK BYTE AND STRING POINTERS + +BYTMK: PUSHJ P,BYTDOP ; GET TO DOPE WORD INTO A + HRLZ F,-1(A) ; SEE IF SPECIAL ATOM [SPNAME] + ANDI F,SATMSK ; GET SAT + CAIN F,SATOM + JRST ATMSET ; IT IS AN ATOM + IORM D,(A) ; MARK IT + JRST GCRET + +ATMSET: HLRZ B,(A) ; GET LENGTH + TRZ B,400000 ; TURN OFF POSSIBLE MARK BIT + MOVNI B,-2(B) ; GENERATE AOBJN POINTER + ADDI A,-1(B) ; GET BACK TO BEGINNING + HRLI A,(B) ; PUT IN LEFT HALF + MOVEI B,TATOM ; MARK AS AN ATOM + PUSHJ P,MARK ; GO MARK + JRST GCRET + +; MARK LOCID GOODIES + +LOCMK: HRRZ B,(C) ; CHECK FOR TIME + JUMPE B,LOCMK1 ; SKIP LEGAL CHECK FOR GLOBAL + HRRZ 0,2(A) ; GET OTHER TIME + CAIE 0,(B) ; SAME? + JRST GCRET + MOVEI B,TTP + PUSHJ P,MARK1 + JRST GCRET +LOCMK1: MOVEI B,TVEC ; GLOBAL + PUSHJ P,MARK1 ; MARK VALUE + JRST GCRET + +; MARK ASSOCIATION BLOCK + +ASMK: MOVEI C,(A) ; SAVE POINTER TO BEGINNING OF ASSOCATION + ADDI A,ASOLNT ; POINT TO DOPE WORD + HLRE B,1(A) ; GET SECOND D.W. + JUMPL B,GCRET ; MARKED SO LEAVE + IORM D,1(A) ; MARK ASSOCATION + PUSHJ P,MARK2 ; MARK ITEM + MOVEI C,INDIC(C) + PUSHJ P,MARK2 + MOVEI C,VAL-INDIC(C) + PUSHJ P,MARK2 + HRRZ A,NODPNT-VAL(C) ; GET NEXT IN CHAIN + JUMPN A,ASMK ; GO MARK IT + JRST GCRET + +; MARK OFFSETS + +OFFSMK: PUSH P,$TLIST + HLRZ 0,1(C) ; PICK UP LIST POINTER + PUSH P,0 + MOVEI C,-1(P) + PUSHJ P,MARK2 ; MARK THE LIST + SUB P,[2,,2] + JRST GCRET ; AND RETURN + +; HERE TO MARK TEMPLATE DATA STRUCTURES + +TD.MK: HLRZ B,(A) ; GET REAL SPEC TYPE + ANDI B,37777 ; KILL SIGN BIT + MOVEI E,-NUMSAT-1(B) ; GET REL POINTER TO TABLE + HRLI E,(E) + ADD E,TD.AGC+1 + HRRZS C,A ; FLUSH COUNT AND SAVE + SKIPL E ; WITHIN BOUNDS + FATAL BAD SAT IN AGC + SKIPL 1(A) ; SEE IF MARKED + JRST GCRET ; IF MARKED LEAVE + IORM D,1(A) + + SKIPE (E) + JRST USRAGC + SUB E,TD.AGC+1 ; POINT TO LENGTH + ADD E,TD.LNT+1 + XCT (E) ; RET # OF ELEMENTS IN B + + HLRZ D,B ; GET POSSIBLE "BASIC LENGTH" FOR RESTS + PUSH P,[0] ; TEMP USED IF RESTS EXIST + PUSH P,D + MOVEI B,(B) ; ZAP TO ONLY LENGTH + PUSH P,C ; SAVE POINTER TO TEMPLATE STRUCTURE + PUSH P,B ; SAVE + SUB E,TD.LNT+1 + PUSH P,E ; SAVE FOR FINDING OTHER TABLES + JUMPE D,TD.MR2 ; NO REPEATING SEQ + ADD E,TD.GET+1 ; COMP LNTH OF REPEATING SEQ + HLRE E,(E) ; E ==> - LNTH OF TEMPLATE + ADDI E,(D) ; E ==> -LENGTH OF REP SEQ + MOVNS E + HRLM E,-3(P) ; SAVE IT AND BASIC + +TD.MR2: SKIPG D,-1(P) ; ANY LEFT? + JRST TD.MR1 + + MOVE E,TD.GET+1 + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + MOVEM D,-4(P) ; SAVE ELMENT # + SKIPN B,-3(P) ; SKIP IF "RESTS" EXIST + SOJA D,TD.MR3 + + MOVEI 0,(B) ; BASIC LNT TO 0 + SUBI 0,(D) ; SEE IF PAST BASIC + JUMPGE 0,.-3 ; JUMP IF O.K. + MOVSS B ; REP LNT TO RH, BASIC TO LH + IDIVI 0,(B) ; A==> -WHICH REPEATER + MOVNS A + ADD A,-3(P) ; PLUS BASIC + ADDI A,1 ; AND FUDGE + MOVEM A,-4(P) ; SAVE FOR PUTTER + ADDI E,-1(A) ; POINT + SOJA D,.+2 + +TD.MR3: ADDI E,(D) ; POINT TO SLOT + XCT (E) ; GET THIS ELEMENT INTO A AND B + JFCL ; NO-OP FOR ANY CASE + EXCH A,B ; REARRANGE + HLRZS B + MOVSI D,400000 ; RESET FOR MARK + PUSHJ P,MARK ; AND MARK THIS GUY (RET FIXED POINTER IN A) + MOVE C,-2(P) ; RESTORE POINTER IN CASE MUNGED + JRST TD.MR2 + +TD.MR1: SUB P,[5,,5] + JRST GCRET + +USRAGC: XCT (E) ; MARK THE TEMPLATE + JRST GCRET + + +; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS +; AND UPDATES PTR TO THE TABLE. + +GCRDMK: MOVEI C,(A) ; SAVE POINTER TO GCREAD TABLE + HLRE B,A ; GET TO DOPE WORD + SUB A,B + SKIPGE 1(A) ; SKIP IF NOT MARKED + JRST GCRET + SUBI A,2 + MOVE B,ABOTN ; GET TOP OF ATOM TABLE + ADD B,0 ; GET BOTTOM OF ATOM TABLE +GCRD1: CAMG A,B ; DON'T SKIP IF DONE + JRST GCRET + HLRZ C,(A) ; GET MARKING + TRZN C,400000 ; SKIP IF MARKED + JRST GCRD3 + MOVEI E,(A) + SUBI A,(C) ; GO BACK ONE ATOM + PUSH P,B ; SAVE B + PUSH P,A ; SAVE POINTER + MOVEI C,-2(E) ; SET UP POINTER + MOVEI B,TATOM ; GO TO MARK + MOVE A,1(C) + PUSHJ P,MARK + POP P,A + POP P,B + JRST GCRD1 +GCRD3: SUBI A,(C) ; TO NEXT ATOM + JRST GCRD1 + + +; ROUTINE TO FIX UP CHANNELS + +CHNFLS: MOVEI 0,N.CHNS-1 + MOVEI A,,CHNL1 ; SET UP POINTER +CHFL1: SKIPN B,1(A) ; GET POINTER TO CHANNEL + JRST CHFL2 ; NO CHANNEL LOOP TO NEXT + HLRE C,B ; POINT TO DOPE WORD OF CHANNEL + SUBI B,(C) + MOVEI F,TCHAN + HRLM F,(A) ; PUT TYPE BACK + SKIPL 1(B) ; SKIP IF MARKED + JRST FLSCH ; FLUSH THE CHANNEL + MOVEI F,1 ; MARK THE CHANNEL AS GOOD + HRRM F,(A) ; SMASH IT IN +CHFL2: ADDI A,2 + SOJG 0,CHFL1 + POPJ P, ; EXIT +FLSCH: HLLOS F,(A) ; -1 INTO SLOT INDICATES LOSSAGE + JRST CHFL2 + + +; THIS ROUTINE MARKS ALL THE CHANNELS + +CHFIX: MOVEI 0,N.CHNS-1 + MOVEI A,CHNL1 ; SLOTS + +DHNFL2: SKIPN 1(A) + JRST DHNFL1 + PUSH P,0 ; SAVE 0 + PUSH P,A ; SAVE A + MOVEI C,(A) + MOVE A,1(A) + MOVEI B,TCHAN + PUSHJ P,MARK + POP P,A ; RESTORE A + POP P,0 ; RESTORE +DHNFL1: ADDI A,2 + SOJG 0,DHNFL2 + POPJ P, + + + +; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL +; POINT. + +FIXSEN: PUSH P,B ; SAVE TIME + MOVEI B,[ASCIZ /TIME= /] + PUSHJ P,MSGTYP ; PRINT OUT MESSAGE + POP P,B ; RESTORE B + FMPRI B,(100.0) ; CONVERT TO FIX + MULI B,400 + TSC B,B + ASH C,-163.(B) + MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME + PUSH P,C + IDIVI C,10. ; START COUNTING + JUMPLE C,.+2 + AOJA A,.-2 + POP P,C + CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER + JRST DOT1 +FIXOUT: IDIVI C,10. ; RECOVER NUMBER + HRLM D,(P) + SKIPE C + PUSHJ P,FIXOUT + PUSH P,A ; SAVE A + CAIN A,2 ; DECIMAL POINT HERE? + JRST DOT2 +FIX1: HLRZ A,(P)-1 ; GET NUMBER + ADDI A,60 ; MAKE IT A CHARACTER + PUSHJ P,IMTYO ; OUT IT GOES + POP P,A + SOJ A, + POPJ P, +DOT1: MOVEI A,". ; OUTPUT DECIMAL POINT AND PADDING 0 + PUSHJ P,IMTYO + MOVEI A,"0 + PUSHJ P,IMTYO + JRST FIXOUT ; CONTINUE +DOT2: MOVEI A,". ; OUTPUT DECIMAL POINT + PUSHJ P,IMTYO + JRST FIX1 + + +; ROUTINE TO SEEP THROUGH GC SPACE LOOKING FOR FREE SLOTS. PAIRS ARE PLACED ON THE +; RCL LIST, VECTORS ON THE RCLV LIST. + +SWEEP: MOVE C,GCSTOP ; GET TOP OF GC SPACE + SUBI C,1 ; POINT TO FIRST OBJECT + SETZB E,F ; CURRENT SLOT AND CURRENT LENGTH +LSWEEP: CAMG C,GCSBOT ; SKIP IF ABOVE GCSBOT + JRST ESWEEP ; DONE + HLRE A,-1(C) ; SEE IF LIST OR VECTOR + TRNE A,UBIT ; SKIP IF LIST + JRST VSWEEP ; IT IS A VECTOR + JUMPGE A,LSWP1 ; JUMP IF NOT MARKED + ANDCAM D,-1(C) ; TURN OFF MARK BIT + PUSHJ P,SWCONS ; CONS ON CURRENT OBJECT + SUBI C,2 ; SKIP OVER LIST + JRST LSWEEP +LSWP1: ADDI F,2 ; ADD TO CURRENT OBJECT COUNT + JUMPN E,LSWP2 ; JUMP IF CURRENT OBJECT EXISTS + MOVEI E,(C) ; GET ADDRESS +LSWP2: SUBI C,2 + JRST LSWEEP + +VSWEEP: HLRE A,(C) ; GET LENGTH + JUMPGE A,VSWP1 ; SKIP IF MARKED + ANDCAM D,(C) ; TURN OFF MARK BIT + PUSHJ P,SWCONS + ANDI A,377777 ; GET LENGTH PART + SUBI C,(A) ; GO PAST VECTOR + JRST LSWEEP +VSWP1: ADDI F,(A) ; ADD LENGTH + JUMPN E,VSWP2 + MOVEI E,(C) ; GET NEW OBJECT LOCATION +VSWP2: SUBI C,(A) ; GO BACK PAST VECTOR + JRST LSWEEP + +ESWEEP: +SWCONS: JUMPE E,CPOPJ + ADDM F,TOTCNT ; HACK TOTCNT + CAMLE F,MAXLEN ; SEE IF NEW MAXIMUM + MOVEM F,MAXLEN + CAIGE F,2 ; MAKE SURE AT LEAST TWO LONG + FATAL SWEEP FAILURE + CAIN F,2 + JRST LCONS + SETZM (E) + MOVEI 0,(E) + SUBI 0,-1(F) + SETZM @0 + HRLS 0 + ADDI 0,1 + BLT 0,-2(E) + HRRZ 0,RCLV ; GET VECTOR RECYCLE + HRRM 0,(E) ; SMASH INTO LINKING SLOT + HRRZM E,RCLV ; NEW RECYCLE SLOT + HRLM F,(E) + MOVSI F,UBIT + MOVEM F,-1(E) + SETZB E,F + POPJ P, ; DONE +LCONS: SETZM (E) + SUBI E,1 + HRRZ 0,RCL ; GET RECYCLE LIST + HRRZM 0,(E) ; SMASH IN + HRRZM E,RCL + SETZB E,F + POPJ P, + + +; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC + +MSGGCT: [ASCIZ /USER CALLED- /] + [ASCIZ /FREE STORAGE- /] + [ASCIZ /TP-STACK- /] + [ASCIZ /TOP-LEVEL LOCALS- /] + [ASCIZ /GLOBAL VALUES- /] + [ASCIZ /TYPES- /] + [ASCIZ /STATIONARY IMPURE STORAGE- /] + [ASCIZ /P-STACK /] + [ASCIZ /BOTH STACKS BLOWN- /] + [ASCIZ /PURE STORAGE- /] + [ASCIZ /GC-RCALL- /] + +; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC + +GCPAT: SPBLOK 100 +EGCPAT: -1 + +MSGGFT: [ASCIZ /GC-READ /] + [ASCIZ /BLOAT /] + [ASCIZ /GROW /] + [ASCIZ /LIST /] + [ASCIZ /VECTOR /] + [ASCIZ /SET /] + [ASCIZ /SETG /] + [ASCIZ /FREEZE /] + [ASCIZ /PURE-PAGE LOADER /] + [ASCIZ /GC /] + [ASCIZ /INTERRUPT-HANDLER /] + [ASCIZ /NEWTYPE /] + [ASCIZ /PURIFY /] + +CONSTANTS + +HERE + +CONSTANTS + +OFFSET 0 + +ZZ==$.+1777 + +.LOP ANDCM ZZ 1777 + +ZZ1==.LVAL1 + +LOC ZZ1 + +OFFSET OFFS + +MRKPDL==.-1 + +ENDGC: + +OFFSET 0 + +ZZ2==ENDGC-AGCLD + +.LOP ZZ2 <,-10.> +SLENGC==.LVAL1 +.LOP SLENGC <10.> +RSLENG==.LVAL1 +LOC GCST + +.LPUR=$. + +END diff --git a//amsgc.mid.109 b//amsgc.mid.109 new file mode 100644 index 0000000..fda1ffa --- /dev/null +++ b//amsgc.mid.109 @@ -0,0 +1,886 @@ +TITLE AMSGC MUDDLE MARK SWEEP GARBAGE COLLECTOR + +RELOCATABLE + +.GLOBAL RCL,RCLV,IAMSGC,MAXLEN,REALGC,RGCLEN,GCFLG,SQUPNT,GCMONF,MSGTYP,GCCAUS +.GLOBAL GCCALL,PVSTOR,DSTORE,TYPVEC,N.CHNS,CHNL1,MAINPR,STOGC,CTIME,GCTIM,IMTYO +.GLOBAL FNMSGC,SATMSK,NUMSAT,NUMPRI,PURBOT,GCSTOP,GCSBOT,STOSTR,TYPMSK,PDLBUF,ITEM,INDIC +.GLOBAL VAL,NODPNT,UBIT,ASOLNT,GCHAPN,RBLDM,TOTCNT,MARK2S,MKTBS +.GLOBAL FRMUNG,BYTDOP,TD.GET,TD.LNT,TD.AGC,ABOTN,SLENGC,LENGC,REALGC,AGCLD,RLENGC +.GLOBAL RSLENG + +GCST=$. + +LOC REALGC+RLENGC + +OFFS=AGCLD-$. +OFFSET OFFS + +.INSRT MUDDLE > + +TYPNT==AB +F==PVP + + +; THIS IS THE MUDDLE MARK SWEEP GARBAGE COLLECTOR. IT IS MUCH FASTER THAN THE COPYING +; GARBAGE COLLECTOR BUT DOESN'T COMPACT. IT CONSES FREE THINGS ONTO RCL AND RCLV. +; THIS GARBAGE COLLECTOR CAN ONLY BE USED IF THE GARBAGE COLLECT IS A FREE STORAGE +; GARBAGE COLLECT + + +; FIRST INITIALIZE VARIABLES + +IAMSGC: SETZB M,RCL ; CLEAR OUT LIST RECYCLE AND RSUBR BASE + SETZM RCLV ; CLEAR VECTOR RECYCLE + SETZM MAXLEN ; CLEAR MAXIMUM LENGTH FOUND TO RECYCLE + SETOM GCFLG ; A GC HAS HAPPENED + SETZM TOTCNT + HLLZS SQUPNT ; CLEAR OUT SQUOZE TABLE + +; SET UP MESSAGE PRINTING AND SAVE CAUSE AND CAUSER + + PUSH P,A + PUSH P,B + PUSH P,C ; SAVE ACS + MOVEI B,[ASCIZ /MSGIN / ] ; PRINT GIN IF WINNING + SKIPE GCMONF + PUSHJ P,MSGTYP + HRRZ C,(P) ; GET CAUSE INDICATOR + ADDI B,1 ; AOS TO GET REAL CAUS + MOVEM B,GCCAUS + SKIPN GCMONF + JRST NOMON2 + MOVE B,MSGGCT(C) ; GET CAUSE MESSAGE + PUSHJ P,MSGTYP +NOMON2: HLRZ C,(P) ; FIND OUT WHO CAUSED THE GC + MOVEM C,GCCALL + SKIPN GCMONF ; PRINT IF GCMON IS ON + JRST NOMON3 + MOVE B,MSGGFT(C) ; GET POINTER TO MESSAGE + PUSHJ P,MSGTYP +NOMON3: SUB P,[1,,1] + POP P,B ; RESTORE ACS + POP P,A + +; MOVE ACS INTO THE PVP + + EXCH PVP,PVSTOR+1 ; GET REAL PROCESS VECTOR + + IRP AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P] + MOVEM AC,AC!STO+1(PVP) + TERMIN + + MOVE 0,PVSTOR+1 ; GET OLD VALUE OF PVP + MOVEM 0,PVPSTO+1(PVP) ; SAVE PVP + MOVE 0,DSTORE ; SAVE D'S TYPE + MOVEM 0,DSTO(PVP) + MOVEM PVP,PVSTOR+1 + +; SET UP TYPNT TO POINT TO TYPE VECTOR + + GETYP E,TYPVEC ; FIRST SEE IF TYPVEC IS A VECTOR + CAIE E,TVEC + FATAL TYPE VECTOR NOT OF TYPE VECTOR + HRRZ TYPNT,TYPVEC+1 + HRLI TYPNT,B ; TYPNT IS NOW TYPEVECTOR(B) + +; NOW SET UP GCPDL AND FENCE POST PDL'S + + MOVEI A,(TB) + MOVE D,P ; SAVE P POINTER + PUSHJ P,FRMUNG + MOVE P,[-2000,,MRKPDL] ; SET UP MARK PDL + MOVEI A,(TB) ; FIXUP TOP FRAME + SETOM 1(TP) ; FENCEPOST TP + SETOM 1(D) ; FENCEPOST P + +; NOW SETUP AUTO CHANNEL CLOSE + + MOVEI 0,N.CHNS-1 ; NUMBER OF CHANNELS + MOVEI A,CHNL1 ; FIRST CHANNEL SLOT +CHNCLR: SKIPE 1(A) ; IS IT A CHANNEL + SETZM (A) ; CLEAR UP TYPE SLOT + ADDI A,2 + SOJG 0,CHNCLR + +; NOW DO MARK AND SWEEP PHASES + + MOVSI D,400000 ; MARK BIT + MOVEI B,TPVP ; GET TYPE + MOVE A,PVSTOR+1 ; GET VALUE OF CURRENT PROCESS VECTOR + PUSHJ P,MARK + MOVEI B,TPVP ; GET TYPE OF MAIN PROCESS VECTOR + MOVE A,MAINPR + PUSHJ P,MARK ; MARK + PUSHJ P,CHNFLS ; DO CHANNEL FLUSHING + PUSHJ P,CHFIX + PUSHJ P,STOGC ; FIX UP FROZEN WORLD + PUSHJ P,SWEEP ; SWEEP WORLD + +; PRINT GOUT + + MOVEI B,[ASCIZ /MSGOUT /] ; PRINT OUT ENDING MESSAGE IF GCMONING + SKIPE GCMONF + PUSHJ P,MSGTYP + +; RESTORE ACS + + MOVE PVP,PVSTOR+1 ; GET PVP + IRP AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P] + MOVE AC,AC!STO+1(PVP) + TERMIN + + SKIPN DSTORE ; CLEAR OUT TYPE IF NO TYPE THERE + SETZM DSTO(PVP) + MOVE PVP,PVPSTO+1(PVP) + +; PRINT TIME + + PUSH P,A ; SAVE ACS + PUSH P,B + PUSH P,C + PUSH P,D + PUSHJ P,CTIME ; GET CURRENT CPU TIME + FSBR B,GCTIM ; COMPUTE TIME ELAPSED + MOVEM B,GCTIM ; SAVE TIME AWAY + SKIPN GCMONF ; PRINT IT OUT? + JRST GCCONT + PUSHJ P,FIXSEN + MOVEI A,15 ; OUTPUT CR/LF + PUSHJ P,IMTYO + MOVEI A,12 + PUSHJ P,IMTYO +GCCONT: POP P,D ; RESTORE ACS + POP P,C + POP P,B + POP P,A + SETZM GCFLG + SETOM GCHAPN + SETOM INTFLG + PUSHJ P,RBLDM + JRST FNMSGC ; DONE + + +; THIS IS THE MARK PHASE + +; GENERAL MARK ROUTINE, CALLED TO MARK ALL THINGS +; /A POINTER TO GOODIE +; /B TYPE OF GOODIE +; FOR MARK2, MARK1 /C POINTER TO PAIR NOT NEEDED FOR CALLS DIRECTLY TO MARK + +MARK2S: +MARK2: HLRZ B,(C) ; TYPE +MARK1: MOVE A,1(C) ; VALUE +MARK: JUMPE A,CPOPJ ; DONE IF ZERO + MOVEI 0,1(A) ; SEE IF PURE + CAML 0,PURBOT + JRST CPOPJ + ANDI B,TYPMSK ; FLUSH MONITORS + HRLM C,(P) + CAIG B,NUMPRI ; IS A BASIC TYPE + JRST @MTYTBS(B) ; TYPE DISPATCH + LSH B,1 ; NOW GET PRIMTYPE + HRRZ B,@TYPNT ; GET PRIMTYPE + ANDI B,SATMSK ; FLUSH DOWN TO SAT + CAIG B,NUMSAT ; SKIP IF TEMPLATE DATA + JRST @MSATBS(B) ; JUMP OFF SAT TABLE + JRST TD.MK + +GCRET: HLRZ C,(P) ; GET SAVED C +CPOPJ: POPJ P, + +; TYPE DISPATCH TABLE +MTYTBS: + +OFFSET 0 + +DUM1: + +IRP XX,,[[TLOSE,GCRET],[TFIX,GCRET],[TFLOAT,GCRET],[TCHRS,GCRET] +[TENTRY,GCRET],[TSUBR,GCRET],[TFSUBR,GCRET],[TILLEG,GCRET],[TUNBOU,GCRET] +[TBIND,GCRET],[TTIME,GCRET],[TLIST,PAIRMK],[TFORM,PAIRMK],[TSEG,PAIRMK] +[TEXPR,PAIRMK],[TFUNAR,PAIRMK],[TLOCL,PAIRMK],[TFALSE,PAIRMK],[TDEFER,DEFQMK] +[TUVEC,UVMK],[TOBLS,UVMK],[TVEC,VECMK],[TCHAN,VECMK] ,[TLOCV,VECMK] +[TTVP,VECMK],[TBVL,VECMK],[TTAG,VECMK],[TPVP,VECMK],[TLOCI,TPMK],[TTP,TPMK] +[TSP,TPMK],[TMACRO,PAIRMK],[TPDL,PMK],[TARGS,ARGMK],[TAB,ABMK] +[TTB,TBMK],[TFRAME,FRMK],[TCHSTR,BYTMK],[TATOM,ATOMK],[TLOCD,LOCMK],[TBYTE,BYTMK] +[TENV,FRMK],[TACT,FRMK],[TASOC,ASMK],[TLOCU,UVMK],[TLOCS,BYTMK],[TLOCA,ARGMK] +[TCBLK,GCRET],[TTMPLT,TD.MK],[TLOCT,TD.MK],[TLOCR,GCRET],[TINFO,GCRET] +[TRDTB,GCRDMK],[TWORD,GCRET],[TRSUBR,VECMK],[TCODE,UVMK],[TSATC,GCRET] +[TBITS,GCRET],[TSTORA,UVMK],[TPICTU,UVMK],[TSKIP,TPMK],[TLINK,ATOMK] +[TDECL,PAIRMK],[TENTER,VECMK],[THAND,VECMK],[TINTH,VECMK],[TDISMI,ATOMK] +[TDCLI,PAIRMK],[TPCODE,GCRET],[TTYPEW,GCRET],[TTYPEC,GCRET] +[TGATOM,GATOMK],[TREADA,FRMK],[TUBIND,GCRET],[TUNWIN,TBMK],[TLOCB,BYTMK] +[TDEFQ,DEFQMK],[TSPLIC,PAIRMK],[TLOCN,ASMK],[TOFFS,OFFSMK]] + IRP A,B,[XX] + LOC DUM1+A + SETZ B + .ISTOP + TERMIN +TERMIN + +LOC DUM1+NUMPRI+1 + +OFFSET OFFS + +; SAT DISPATCH TABLE + +MSATBS: + +OFFSET 0 + +DISTB2 DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,UVMK],[STBASE,TBMK] +[STPSTK,TPMK],[SARGS,],[S2NWORD,VECMK],[SPSTK,TPMK],[SSTORE,UVMK] +[SFRAME,],[SBYTE,],[SATOM,ATOMK],[SPVP,VECMK],[SGATOM,GATOMK] +[SLOCID,],[SCHSTR,],[SASOC,ASMK],[SLOCL,PAIRMK],[SABASE,ABMK] +[SLOCA,],[SLOCV,VECMK],[SLOCU,UVMK],[SLOCS,],[SLOCN,ASMK] +[SRDTB,GCRDMK],[SLOCB,],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]] + +OFFSET OFFS + + +; ROUTINE TO MARK PAIRS + +PAIRMK: MOVEI C,(A) +PAIRM1: CAMG C,GCSTOP ; SEE IF IN RANGE + CAIGE C,STOSTR + JRST BADPTR ; FATAL ERROR + HLRE B,(C) ; SKIP IF NOT MARKED + JUMPL B,GCRET + IORM D,(C) ; MARK IT + PUSHJ P,MARK1 ; MARK THE ITEM + HRRZ C,(C) ; GET NEXT ELEMENT OF LIST + JUMPE C,GCRET + CAML C,PURBOT + JRST GCRET + JRST PAIRM1 + +; ROUTINE TO MARK DEFERS + +DEFMK: HLRE B,(A) + JUMPL B,GCRET + MOVEI C,(A) + IORM D,(C) + PUSHJ P,MARK1 + JRST GCRET + +; ROUTINE TO MARK POSSIBLE DEFERS DEF? + +DEFQMK: GETYP B,(A) ; GET THE TYPE OF THE OBJECT + LSH B,1 ; COMPUTE THE SAT + HRRZ B,@TYPNT + ANDI B,SATMSK + SKIPL MKTBS(B) ; SKIP IF NOT DEFERED + JRST PAIRMK + JRST DEFMK ; GO TO DEFMK + + +; ROUTINE TO MARK VECTORS + +VECMK: HLRE B,A ; GET LENGTH + SUB A,B + MOVEI C,1(A) ; POINT TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + HLRE B,(C) + JUMPL B,GCRET + IORM D,(C) ; MARK IT + SUBI C,-1(B) ; GET TO BEGINNING +VECMK1: HLRE B,(C) ; GET TYPE AND SKIP IF NOT DOPE WORD + JUMPL B,GCRET ; DONE + PUSHJ P,MARK1 ; MARK IT + ADDI C,2 ; NEXT ELEMENT + JRST VECMK1 + +; ROUTINE TO MARK UVECTORS + +UVMK: HLRE B,A ; GET LENGTH + SUB A,B ; A POINTS TO FIRST DOPE WORD + MOVEI C,1(A) ; C POINTS TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + HLRE F,(C) ; GET LENGTH + JUMPL F,GCRET + IORM D,(C) ; MARK IT + GETYP B,-1(C) ; GET TYPE + MOVEI E,(B) ; COPY TYPE FOR SAT COMPUTATION + LSH B,1 + HRRZ B,@TYPNT ; GET SAT + ANDI B,SATMSK + MOVEI B,@MSATBS(B) ; GET JUMP LOCATION + CAIN B,GCRET + JRST GCRET + SUBI C,(F) ; POINT TO BEGINNING OF UVECTOR + SUBI F,2 + JUMPE F,GCRET + PUSH P,F ; SAVE LENGTH + PUSH P,E +UNLOOP: MOVE B,(P) + MOVE A,1(C) ; GET VALUE POINTER + PUSHJ P,MARK + SOSE -1(P) ; SKIP IF NON-ZERO + AOJA C,UNLOOP ; GO BACK AGAIN + SUB P,[2,,2] ; CLEAN OFF STACK + JRST GCRET + +; ROUTINE TO INDICATE A BAD POINTER + +BADPTR: FATAL POINTER POINTS OUT OF GARBAGE COLLECTED SPACE + JRST GCRET + + +; ROUTINE TO MARK A TPSTACK + +TPMK: HLRE B,A ; GET LENGTH + SUB A,B ; A POINTS TO FIRST DOPE WORD + MOVEI C,PDLBUF+1(A) ; C POINTS TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + HLRE A,(C) + JUMPL A,GCRET + IORM D,(C) ; MARK IT + SUBI C,-1(A) ; GO TO BEGINNING + +TPLP: HLRE B,(C) ; GET TYPE AND MARKING + JUMPL B,GCRET ; EXIT ON FENCE-POST + ANDI B,TYPMSK ; FLUSH MONITORS + CAIE B,TCBLK ; CHECK FOR FRAME + CAIN B,TENTRY + JRST MFRAME ; MARK THE FRAME + CAIE B,TUBIND ; BINDING BLOCK + CAIN B,TBIND + JRST MBIND + PUSHJ P,MARK1 ; NOTHING SPECIAL SO MARK IT + ADDI C,2 ; POINT TO NEXT OBJECT + JRST TPLP ; MARK IT + +; MARK A FRAME ON THE STACK, [I.E. ITS FSAV AND PSAV SLOTS] + +MFRAME: HRROI C,FRAMLN+FSAV-1(C) ; POINT TO FUNCTION + HRRZ A,1(C) ; GET POINTER + CAIL A,STOSTR ; SEE IF IN GC SPACE + CAMLE A,GCSTOP + JRST MFRAM1 ; SKIP OVER IT, NOT IN GC-SPACE + HRL A,(A) ; GET LENGTH + MOVEI B,TVEC ; TYPE IS VECTOR [RSUBR OR RSUBR-ENTRY] + PUSHJ P,MARK +MFRAM1: MOVE A,PSAV-FSAV+1(C) ; MARK THE PSTACK + MOVEI B,TPDL + PUSHJ P,MARK + HRROI C,-FSAV+1(C) ; POINT PAST FRAME + JRST TPLP ; GO BACK TO START OF LOOP + +; MARK A BINDING ON THE STACK [I.E. THE ATOM, VALUE, DECL, AND PREVIOUS BINDING] + +MBIND: MOVEI B,TATOM ; START BY MARKING THE ATOM + PUSHJ P,MARK1 ; MARK IT + ADDI C,2 ; POINT TO VALUE SLOT + PUSHJ P,MARK2 ; MARK THE VALUE + ADDI C,2 ; POINT TO DECL AND PREV BINDING + MOVEI B,TLIST ; MARK DECL + HLRZ A,(C) + PUSHJ P,MARK + SKIPL A,1(C) ; SKIP IF PREVIOUS BINDING + JRST NOTLCI + MOVEI B,TLOCI ; GET TYPE + PUSHJ P,MARK +NOTLCI: ADDI C,2 ; POINT PAST BINDING + JRST TPLP + + +PMK: HLRE B,A ; GET LENGTH + SUB A,B ; A POINTS TO FIRST DOPE WORD + MOVEI C,PDLBUF+1(A) ; C POINTS TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + IORM D,(C) ; MARK IT + JRST GCRET + +; ROUTINE TO MARK TB POINTER + +TBMK: HRRZS A ; CHECK FOR NIL POINTER + SKIPN A + JRST GCRET + MOVE A,TPSAV(A) ; GET A TP POINTER + MOVEI B,TTP ; TYPE WORD + PUSHJ P,MARK + JRST GCRET + +; ROUTINE TO MARK AB POINTERS + +ABMK: HLRE B,A ; GET TO FRAME + SUB A,B + MOVE A,FRAMLN+TPSAV(A) ; GET A TP POINTER + MOVEI B,TTP ; TYPE WORD + PUSHJ P,MARK + JRST GCRET + +; ROUTINE TO MARK FRAME POINTERS + +FRMK: HRLZ B,A ; GET THE TIME + HLRZ F,OTBSAV(A) ; GET TIME FROM FRAME + CAIE B,(F) ; SKIP IF TIMES AGREE + JRST GCRET ; IGNORE POINTER IF THEY DONT + HRRZ A,(C) ; GET POINTER TO PROCESS + SUBI A,1 ; FUDGE FOR VECTOR MARKING + MOVEI B,TPVP ; TYPE WORD + PUSHJ P,MARK + HRRZ A,1(C) ; GET POINTER TO FRAME + JRST TBMK ; MARK IT + +; ROUTINE TO MARK ARGUMENT BLOCKS [TUPLES] + +ARGMK: HLRE B,A ; GET LENGTH + SUB A,B ; POINT PAST BLOCK + CAIL A,STOSTR + CAMLE A,GCSTOP ; SEE IF IN GCSPACE + JRST GCRET + HRLZ 0,(A) ; GET TYPE + ANDI 0,TYPMSK ; FLUSH MONITORS + CAIE 0,TENTRY + CAIN 0,TCBLK + JRST ARGMK1 ; AT FRAME + CAIE 0,TINFO ; AT FRAME + JRST GCRET ; NOT A LEGAL TYPE GO AWAY + HRRZ A,1(A) ; POINTING TO FRAME + HRL A,(C) ; GET TIME + JRST TBMK +ARGMK1: HRRI A,FRAMLN(A) ; MAKE POINTER + HRL A,(C) ; GET TIME + JRST TBMK + + +; ROUTINE TO MARK GLOBAL SLOTS + +GATOMK: HRRZ B,(C) ; GET POSSIBLE GDECL + JUMPE B,ATOMK ; NONE GO TO MARK ATOM + CAIN B,-1 ; SKIP IF NOT MANIFEST + JRST ATOMK + PUSH P,A ; I DOUBT THIS IS RIGHT, BUT IT WORKED ONCE--TAA + MOVEI C,(A) + MOVEI A,(B) + MOVEI B,TLIST ; TYPE WORD LIST + PUSHJ P,MARK ; MARK IT + POP P,A + JRST ATOMK5 + +ATOMK: +ATOMK5: HLRE B,A + SUB A,B ; A POINTS TO DOPE WORD + SKIPGE 1(A) ; SKIP IF NOT MARKED + JRST GCRET ; EXIT IF MARKED + HLRZ B,1(A) + SUBI B,3 + HRLI B,1(B) + MOVEI C,-1(A) + SUB C,B ; IN CASE WAS DW + IORM D,1(A) ; MARK IT + HRRZ A,2(C) ; MARK OBLIST + CAMG A,VECBOT + JRST NOOBL ; NO IMPURE OBLIST + HRLI A,-1 + MOVEI B,TOBLS ; MARK THE OBLIST + PUSHJ P,MARK +NOOBL: HLRZ A,2(C) ; GET NEXT ATOM + MOVEI B,TATOM + PUSHJ P,MARK + HLRZ B,(C) ; GET VALUE SLOT + TRZ B,400000 ; TURN OFF MARK BIT + SKIPE B ; SEE IF 0 + CAIN B,TUNBOUN ; SEE IF UNBOUND + JRST GCRET + HRRZ 0,(C) ; SEE IF VECTOR OR TP POINTER + MOVEI B,TVEC ; ASSUME VECTOR + SKIPE 0 ; SKIP IF VECTOR + MOVEI B,TTP ; IT IS A TP POINTER + PUSHJ P,MARK1 ; GO MARK IT + JRST GCRET + +; ROUTINE TO MARK BYTE AND STRING POINTERS + +BYTMK: PUSHJ P,BYTDOP ; GET TO DOPE WORD INTO A + HRLZ F,-1(A) ; SEE IF SPECIAL ATOM [SPNAME] + ANDI F,SATMSK ; GET SAT + CAIN F,SATOM + JRST ATMSET ; IT IS AN ATOM + IORM D,(A) ; MARK IT + JRST GCRET + +ATMSET: HLRZ B,(A) ; GET LENGTH + TRZ B,400000 ; TURN OFF POSSIBLE MARK BIT + MOVNI B,-2(B) ; GENERATE AOBJN POINTER + ADDI A,-1(B) ; GET BACK TO BEGINNING + HRLI A,(B) ; PUT IN LEFT HALF + MOVEI B,TATOM ; MARK AS AN ATOM + PUSHJ P,MARK ; GO MARK + JRST GCRET + +; MARK LOCID GOODIES + +LOCMK: HRRZ B,(C) ; CHECK FOR TIME + JUMPE B,LOCMK1 ; SKIP LEGAL CHECK FOR GLOBAL + HRRZ 0,2(A) ; GET OTHER TIME + CAIE 0,(B) ; SAME? + JRST GCRET + MOVEI B,TTP + PUSHJ P,MARK1 + JRST GCRET +LOCMK1: MOVEI B,TVEC ; GLOBAL + PUSHJ P,MARK1 ; MARK VALUE + JRST GCRET + +; MARK ASSOCIATION BLOCK + +ASMK: MOVEI C,(A) ; SAVE POINTER TO BEGINNING OF ASSOCATION + ADDI A,ASOLNT ; POINT TO DOPE WORD + HLRE B,1(A) ; GET SECOND D.W. + JUMPL B,GCRET ; MARKED SO LEAVE + IORM D,1(A) ; MARK ASSOCATION + PUSHJ P,MARK2 ; MARK ITEM + MOVEI C,INDIC(C) + PUSHJ P,MARK2 + MOVEI C,VAL-INDIC(C) + PUSHJ P,MARK2 + HRRZ A,NODPNT-VAL(C) ; GET NEXT IN CHAIN + JUMPN A,ASMK ; GO MARK IT + JRST GCRET + +; MARK OFFSETS + +OFFSMK: PUSH P,$TLIST + HLRZ 0,1(C) ; PICK UP LIST POINTER + PUSH P,0 + MOVEI C,-1(P) + PUSHJ P,MARK2 ; MARK THE LIST + SUB P,[2,,2] + JRST GCRET ; AND RETURN + +; HERE TO MARK TEMPLATE DATA STRUCTURES + +TD.MK: HLRZ B,(A) ; GET REAL SPEC TYPE + ANDI B,37777 ; KILL SIGN BIT + MOVEI E,-NUMSAT-1(B) ; GET REL POINTER TO TABLE + HRLI E,(E) + ADD E,TD.AGC+1 + HRRZS C,A ; FLUSH COUNT AND SAVE + SKIPL E ; WITHIN BOUNDS + FATAL BAD SAT IN AGC + SKIPL 1(A) ; SEE IF MARKED + JRST GCRET ; IF MARKED LEAVE + IORM D,1(A) + + SKIPE (E) + JRST USRAGC + SUB E,TD.AGC+1 ; POINT TO LENGTH + ADD E,TD.LNT+1 + XCT (E) ; RET # OF ELEMENTS IN B + + HLRZ D,B ; GET POSSIBLE "BASIC LENGTH" FOR RESTS + PUSH P,[0] ; TEMP USED IF RESTS EXIST + PUSH P,D + MOVEI B,(B) ; ZAP TO ONLY LENGTH + PUSH P,C ; SAVE POINTER TO TEMPLATE STRUCTURE + PUSH P,B ; SAVE + SUB E,TD.LNT+1 + PUSH P,E ; SAVE FOR FINDING OTHER TABLES + JUMPE D,TD.MR2 ; NO REPEATING SEQ + ADD E,TD.GET+1 ; COMP LNTH OF REPEATING SEQ + HLRE E,(E) ; E ==> - LNTH OF TEMPLATE + ADDI E,(D) ; E ==> -LENGTH OF REP SEQ + MOVNS E + HRLM E,-3(P) ; SAVE IT AND BASIC + +TD.MR2: SKIPG D,-1(P) ; ANY LEFT? + JRST TD.MR1 + + MOVE E,TD.GET+1 + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + MOVEM D,-4(P) ; SAVE ELMENT # + SKIPN B,-3(P) ; SKIP IF "RESTS" EXIST + SOJA D,TD.MR3 + + MOVEI 0,(B) ; BASIC LNT TO 0 + SUBI 0,(D) ; SEE IF PAST BASIC + JUMPGE 0,.-3 ; JUMP IF O.K. + MOVSS B ; REP LNT TO RH, BASIC TO LH + IDIVI 0,(B) ; A==> -WHICH REPEATER + MOVNS A + ADD A,-3(P) ; PLUS BASIC + ADDI A,1 ; AND FUDGE + MOVEM A,-4(P) ; SAVE FOR PUTTER + ADDI E,-1(A) ; POINT + SOJA D,.+2 + +TD.MR3: ADDI E,(D) ; POINT TO SLOT + XCT (E) ; GET THIS ELEMENT INTO A AND B + JFCL ; NO-OP FOR ANY CASE + EXCH A,B ; REARRANGE + HLRZS B + MOVSI D,400000 ; RESET FOR MARK + PUSHJ P,MARK ; AND MARK THIS GUY (RET FIXED POINTER IN A) + MOVE C,-2(P) ; RESTORE POINTER IN CASE MUNGED + JRST TD.MR2 + +TD.MR1: SUB P,[5,,5] + JRST GCRET + +USRAGC: XCT (E) ; MARK THE TEMPLATE + JRST GCRET + + +; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS +; AND UPDATES PTR TO THE TABLE. + +GCRDMK: MOVEI C,(A) ; SAVE POINTER TO GCREAD TABLE + HLRE B,A ; GET TO DOPE WORD + SUB A,B + SKIPGE 1(A) ; SKIP IF NOT MARKED + JRST GCRET + SUBI A,2 + MOVE B,ABOTN ; GET TOP OF ATOM TABLE + ADD B,0 ; GET BOTTOM OF ATOM TABLE +GCRD1: CAMG A,B ; DON'T SKIP IF DONE + JRST GCRET + HLRZ C,(A) ; GET MARKING + TRZN C,400000 ; SKIP IF MARKED + JRST GCRD3 + MOVEI E,(A) + SUBI A,(C) ; GO BACK ONE ATOM + PUSH P,B ; SAVE B + PUSH P,A ; SAVE POINTER + MOVEI C,-2(E) ; SET UP POINTER + MOVEI B,TATOM ; GO TO MARK + MOVE A,1(C) + PUSHJ P,MARK + POP P,A + POP P,B + JRST GCRD1 +GCRD3: SUBI A,(C) ; TO NEXT ATOM + JRST GCRD1 + + +; ROUTINE TO FIX UP CHANNELS + +CHNFLS: MOVEI 0,N.CHNS-1 + MOVEI A,,CHNL1 ; SET UP POINTER +CHFL1: SKIPN B,1(A) ; GET POINTER TO CHANNEL + JRST CHFL2 ; NO CHANNEL LOOP TO NEXT + HLRE C,B ; POINT TO DOPE WORD OF CHANNEL + SUBI B,(C) + MOVEI F,TCHAN + HRLM F,(A) ; PUT TYPE BACK + SKIPL 1(B) ; SKIP IF MARKED + JRST FLSCH ; FLUSH THE CHANNEL + MOVEI F,1 ; MARK THE CHANNEL AS GOOD + HRRM F,(A) ; SMASH IT IN +CHFL2: ADDI A,2 + SOJG 0,CHFL1 + POPJ P, ; EXIT +FLSCH: HLLOS F,(A) ; -1 INTO SLOT INDICATES LOSSAGE + JRST CHFL2 + + +; THIS ROUTINE MARKS ALL THE CHANNELS + +CHFIX: MOVEI 0,N.CHNS-1 + MOVEI A,CHNL1 ; SLOTS + +DHNFL2: SKIPN 1(A) + JRST DHNFL1 + PUSH P,0 ; SAVE 0 + PUSH P,A ; SAVE A + MOVEI C,(A) + MOVE A,1(A) + MOVEI B,TCHAN + PUSHJ P,MARK + POP P,A ; RESTORE A + POP P,0 ; RESTORE +DHNFL1: ADDI A,2 + SOJG 0,DHNFL2 + POPJ P, + + + +; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL +; POINT. + +FIXSEN: PUSH P,B ; SAVE TIME + MOVEI B,[ASCIZ /TIME= /] + PUSHJ P,MSGTYP ; PRINT OUT MESSAGE + POP P,B ; RESTORE B + FMPRI B,(100.0) ; CONVERT TO FIX + MULI B,400 + TSC B,B + ASH C,-163.(B) + MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME + PUSH P,C + IDIVI C,10. ; START COUNTING + JUMPLE C,.+2 + AOJA A,.-2 + POP P,C + CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER + JRST DOT1 +FIXOUT: IDIVI C,10. ; RECOVER NUMBER + HRLM D,(P) + SKIPE C + PUSHJ P,FIXOUT + PUSH P,A ; SAVE A + CAIN A,2 ; DECIMAL POINT HERE? + JRST DOT2 +FIX1: HLRZ A,(P)-1 ; GET NUMBER + ADDI A,60 ; MAKE IT A CHARACTER + PUSHJ P,IMTYO ; OUT IT GOES + POP P,A + SOJ A, + POPJ P, +DOT1: MOVEI A,". ; OUTPUT DECIMAL POINT AND PADDING 0 + PUSHJ P,IMTYO + MOVEI A,"0 + PUSHJ P,IMTYO + JRST FIXOUT ; CONTINUE +DOT2: MOVEI A,". ; OUTPUT DECIMAL POINT + PUSHJ P,IMTYO + JRST FIX1 + + +; ROUTINE TO SEEP THROUGH GC SPACE LOOKING FOR FREE SLOTS. PAIRS ARE PLACED ON THE +; RCL LIST, VECTORS ON THE RCLV LIST. + +SWEEP: MOVE C,GCSTOP ; GET TOP OF GC SPACE + SUBI C,1 ; POINT TO FIRST OBJECT + SETZB E,F ; CURRENT SLOT AND CURRENT LENGTH +LSWEEP: CAMG C,GCSBOT ; SKIP IF ABOVE GCSBOT + JRST ESWEEP ; DONE + HLRE A,-1(C) ; SEE IF LIST OR VECTOR + TRNE A,UBIT ; SKIP IF LIST + JRST VSWEEP ; IT IS A VECTOR + JUMPGE A,LSWP1 ; JUMP IF NOT MARKED + ANDCAM D,-1(C) ; TURN OFF MARK BIT + PUSHJ P,SWCONS ; CONS ON CURRENT OBJECT + SUBI C,2 ; SKIP OVER LIST + JRST LSWEEP +LSWP1: ADDI F,2 ; ADD TO CURRENT OBJECT COUNT + JUMPN E,LSWP2 ; JUMP IF CURRENT OBJECT EXISTS + MOVEI E,(C) ; GET ADDRESS +LSWP2: SUBI C,2 + JRST LSWEEP + +VSWEEP: HLRE A,(C) ; GET LENGTH + JUMPGE A,VSWP1 ; SKIP IF MARKED + ANDCAM D,(C) ; TURN OFF MARK BIT + PUSHJ P,SWCONS + ANDI A,377777 ; GET LENGTH PART + SUBI C,(A) ; GO PAST VECTOR + JRST LSWEEP +VSWP1: ADDI F,(A) ; ADD LENGTH + JUMPN E,VSWP2 + MOVEI E,(C) ; GET NEW OBJECT LOCATION +VSWP2: SUBI C,(A) ; GO BACK PAST VECTOR + JRST LSWEEP + +ESWEEP: +SWCONS: JUMPE E,CPOPJ + ADDM F,TOTCNT ; HACK TOTCNT + CAMLE F,MAXLEN ; SEE IF NEW MAXIMUM + MOVEM F,MAXLEN + CAIGE F,2 ; MAKE SURE AT LEAST TWO LONG + FATAL SWEEP FAILURE + CAIN F,2 + JRST LCONS + SETZM (E) + MOVEI 0,(E) + SUBI 0,-1(F) + SETZM @0 + HRLS 0 + ADDI 0,1 + BLT 0,-2(E) + HRRZ 0,RCLV ; GET VECTOR RECYCLE + HRRM 0,(E) ; SMASH INTO LINKING SLOT + HRRZM E,RCLV ; NEW RECYCLE SLOT + HRLM F,(E) + MOVSI F,UBIT + MOVEM F,-1(E) + SETZB E,F + POPJ P, ; DONE +LCONS: SETZM (E) + SUBI E,1 + HRRZ 0,RCL ; GET RECYCLE LIST + HRRZM 0,(E) ; SMASH IN + HRRZM E,RCL + SETZB E,F + POPJ P, + + +; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC + +MSGGCT: [ASCIZ /USER CALLED- /] + [ASCIZ /FREE STORAGE- /] + [ASCIZ /TP-STACK- /] + [ASCIZ /TOP-LEVEL LOCALS- /] + [ASCIZ /GLOBAL VALUES- /] + [ASCIZ /TYPES- /] + [ASCIZ /STATIONARY IMPURE STORAGE- /] + [ASCIZ /P-STACK /] + [ASCIZ /BOTH STACKS BLOWN- /] + [ASCIZ /PURE STORAGE- /] + [ASCIZ /GC-RCALL- /] + +; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC + +GCPAT: SPBLOK 100 +EGCPAT: -1 + +MSGGFT: [ASCIZ /GC-READ /] + [ASCIZ /BLOAT /] + [ASCIZ /GROW /] + [ASCIZ /LIST /] + [ASCIZ /VECTOR /] + [ASCIZ /SET /] + [ASCIZ /SETG /] + [ASCIZ /FREEZE /] + [ASCIZ /PURE-PAGE LOADER /] + [ASCIZ /GC /] + [ASCIZ /INTERRUPT-HANDLER /] + [ASCIZ /NEWTYPE /] + [ASCIZ /PURIFY /] + +CONSTANTS + +HERE + +CONSTANTS + +OFFSET 0 + +ZZ==$.+1777 + +.LOP ANDCM ZZ 1777 + +ZZ1==.LVAL1 + +LOC ZZ1 + +OFFSET OFFS + +MRKPDL==.-1 + +ENDGC: + +OFFSET 0 + +ZZ2==ENDGC-AGCLD + +.LOP ZZ2 <,-10.> +SLENGC==.LVAL1 +.LOP SLENGC <10.> +RSLENG==.LVAL1 +LOC GCST + +.LPUR=$. + +END diff --git a//amsgc.mid.110 b//amsgc.mid.110 new file mode 100644 index 0000000..6b51e0c --- /dev/null +++ b//amsgc.mid.110 @@ -0,0 +1,887 @@ +TITLE AMSGC MUDDLE MARK SWEEP GARBAGE COLLECTOR + +RELOCATABLE + +.GLOBAL RCL,RCLV,IAMSGC,MAXLEN,REALGC,RGCLEN,GCFLG,SQUPNT,GCMONF,MSGTYP,GCCAUS +.GLOBAL GCCALL,PVSTOR,DSTORE,TYPVEC,N.CHNS,CHNL1,MAINPR,STOGC,CTIME,GCTIM,IMTYO +.GLOBAL FNMSGC,SATMSK,NUMSAT,NUMPRI,PURBOT,GCSTOP,GCSBOT,STOSTR,TYPMSK,PDLBUF,ITEM,INDIC +.GLOBAL VAL,NODPNT,UBIT,ASOLNT,GCHAPN,RBLDM,TOTCNT,MARK2S,MKTBS +.GLOBAL FRMUNG,BYTDOP,TD.GET,TD.LNT,TD.AGC,ABOTN,SLENGC,LENGC,REALGC,AGCLD,RLENGC +.GLOBAL RSLENG + +GCST=$. + +LOC REALGC+RLENGC + +OFFS=AGCLD-$. +OFFSET OFFS + +.INSRT MUDDLE > + +TYPNT==AB +F==PVP + + +; THIS IS THE MUDDLE MARK SWEEP GARBAGE COLLECTOR. IT IS MUCH FASTER THAN THE COPYING +; GARBAGE COLLECTOR BUT DOESN'T COMPACT. IT CONSES FREE THINGS ONTO RCL AND RCLV. +; THIS GARBAGE COLLECTOR CAN ONLY BE USED IF THE GARBAGE COLLECT IS A FREE STORAGE +; GARBAGE COLLECT + + +; FIRST INITIALIZE VARIABLES + +IAMSGC: SETZB M,RCL ; CLEAR OUT LIST RECYCLE AND RSUBR BASE + SETZM RCLV ; CLEAR VECTOR RECYCLE + SETZM MAXLEN ; CLEAR MAXIMUM LENGTH FOUND TO RECYCLE + SETOM GCFLG ; A GC HAS HAPPENED + SETZM TOTCNT + HLLZS SQUPNT ; CLEAR OUT SQUOZE TABLE + +; SET UP MESSAGE PRINTING AND SAVE CAUSE AND CAUSER + + PUSH P,A + PUSH P,B + PUSH P,C ; SAVE ACS + MOVEI B,[ASCIZ /MSGIN / ] ; PRINT GIN IF WINNING + SKIPE GCMONF + PUSHJ P,MSGTYP + HRRZ C,(P) ; GET CAUSE INDICATOR + ADDI B,1 ; AOS TO GET REAL CAUS + MOVEM B,GCCAUS + SKIPN GCMONF + JRST NOMON2 + MOVE B,MSGGCT(C) ; GET CAUSE MESSAGE + PUSHJ P,MSGTYP +NOMON2: HLRZ C,(P) ; FIND OUT WHO CAUSED THE GC + MOVEM C,GCCALL + SKIPN GCMONF ; PRINT IF GCMON IS ON + JRST NOMON3 + MOVE B,MSGGFT(C) ; GET POINTER TO MESSAGE + PUSHJ P,MSGTYP +NOMON3: SUB P,[1,,1] + POP P,B ; RESTORE ACS + POP P,A + +; MOVE ACS INTO THE PVP + + EXCH PVP,PVSTOR+1 ; GET REAL PROCESS VECTOR + + IRP AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P] + MOVEM AC,AC!STO+1(PVP) + TERMIN + + MOVE 0,PVSTOR+1 ; GET OLD VALUE OF PVP + MOVEM 0,PVPSTO+1(PVP) ; SAVE PVP + MOVE 0,DSTORE ; SAVE D'S TYPE + MOVEM 0,DSTO(PVP) + MOVEM PVP,PVSTOR+1 + +; SET UP TYPNT TO POINT TO TYPE VECTOR + + GETYP E,TYPVEC ; FIRST SEE IF TYPVEC IS A VECTOR + CAIE E,TVEC + FATAL TYPE VECTOR NOT OF TYPE VECTOR + HRRZ TYPNT,TYPVEC+1 + HRLI TYPNT,B ; TYPNT IS NOW TYPEVECTOR(B) + +; NOW SET UP GCPDL AND FENCE POST PDL'S + + MOVEI A,(TB) + MOVE D,P ; SAVE P POINTER + PUSHJ P,FRMUNG + MOVE P,[-2000,,MRKPDL] ; SET UP MARK PDL + MOVEI A,(TB) ; FIXUP TOP FRAME + SETOM 1(TP) ; FENCEPOST TP + SETOM 1(D) ; FENCEPOST P + +; NOW SETUP AUTO CHANNEL CLOSE + + MOVEI 0,N.CHNS-1 ; NUMBER OF CHANNELS + MOVEI A,CHNL1 ; FIRST CHANNEL SLOT +CHNCLR: SKIPE 1(A) ; IS IT A CHANNEL + SETZM (A) ; CLEAR UP TYPE SLOT + ADDI A,2 + SOJG 0,CHNCLR + +; NOW DO MARK AND SWEEP PHASES + + MOVSI D,400000 ; MARK BIT + MOVEI B,TPVP ; GET TYPE + MOVE A,PVSTOR+1 ; GET VALUE OF CURRENT PROCESS VECTOR + PUSHJ P,MARK + MOVEI B,TPVP ; GET TYPE OF MAIN PROCESS VECTOR + MOVE A,MAINPR + PUSHJ P,MARK ; MARK + PUSHJ P,CHNFLS ; DO CHANNEL FLUSHING + PUSHJ P,CHFIX + PUSHJ P,STOGC ; FIX UP FROZEN WORLD + PUSHJ P,SWEEP ; SWEEP WORLD + +; PRINT GOUT + + MOVEI B,[ASCIZ /MSGOUT /] ; PRINT OUT ENDING MESSAGE IF GCMONING + SKIPE GCMONF + PUSHJ P,MSGTYP + +; RESTORE ACS + + MOVE PVP,PVSTOR+1 ; GET PVP + IRP AC,,[0,A,B,C,D,E,TVP,SP,AB,TB,TP,FRM,M,R,P] + MOVE AC,AC!STO+1(PVP) + TERMIN + + SKIPN DSTORE ; CLEAR OUT TYPE IF NO TYPE THERE + SETZM DSTO(PVP) + MOVE PVP,PVPSTO+1(PVP) + +; PRINT TIME + + PUSH P,A ; SAVE ACS + PUSH P,B + PUSH P,C + PUSH P,D + PUSHJ P,CTIME ; GET CURRENT CPU TIME + FSBR B,GCTIM ; COMPUTE TIME ELAPSED + MOVEM B,GCTIM ; SAVE TIME AWAY + SKIPN GCMONF ; PRINT IT OUT? + JRST GCCONT + PUSHJ P,FIXSEN + MOVEI A,15 ; OUTPUT CR/LF + PUSHJ P,IMTYO + MOVEI A,12 + PUSHJ P,IMTYO +GCCONT: POP P,D ; RESTORE ACS + POP P,C + POP P,B + POP P,A + SETZM GCFLG + SETOM GCHAPN + SETOM INTFLG + PUSHJ P,RBLDM + JRST FNMSGC ; DONE + + +; THIS IS THE MARK PHASE + +; GENERAL MARK ROUTINE, CALLED TO MARK ALL THINGS +; /A POINTER TO GOODIE +; /B TYPE OF GOODIE +; FOR MARK2, MARK1 /C POINTER TO PAIR NOT NEEDED FOR CALLS DIRECTLY TO MARK + +MARK2S: +MARK2: HLRZ B,(C) ; TYPE +MARK1: MOVE A,1(C) ; VALUE +MARK: JUMPE A,CPOPJ ; DONE IF ZERO + MOVEI 0,1(A) ; SEE IF PURE + CAML 0,PURBOT + JRST CPOPJ + ANDI B,TYPMSK ; FLUSH MONITORS + HRLM C,(P) + CAIG B,NUMPRI ; IS A BASIC TYPE + JRST @MTYTBS(B) ; TYPE DISPATCH + LSH B,1 ; NOW GET PRIMTYPE + HRRZ B,@TYPNT ; GET PRIMTYPE + ANDI B,SATMSK ; FLUSH DOWN TO SAT + CAIG B,NUMSAT ; SKIP IF TEMPLATE DATA + JRST @MSATBS(B) ; JUMP OFF SAT TABLE + JRST TD.MK + +GCRET: HLRZ C,(P) ; GET SAVED C +CPOPJ: POPJ P, + +; TYPE DISPATCH TABLE +MTYTBS: + +OFFSET 0 + +DUM1: + +IRP XX,,[[TLOSE,GCRET],[TFIX,GCRET],[TFLOAT,GCRET],[TCHRS,GCRET] +[TENTRY,GCRET],[TSUBR,GCRET],[TFSUBR,GCRET],[TILLEG,GCRET],[TUNBOU,GCRET] +[TBIND,GCRET],[TTIME,GCRET],[TLIST,PAIRMK],[TFORM,PAIRMK],[TSEG,PAIRMK] +[TEXPR,PAIRMK],[TFUNAR,PAIRMK],[TLOCL,PAIRMK],[TFALSE,PAIRMK],[TDEFER,DEFQMK] +[TUVEC,UVMK],[TOBLS,UVMK],[TVEC,VECMK],[TCHAN,VECMK] ,[TLOCV,VECMK] +[TTVP,VECMK],[TBVL,VECMK],[TTAG,VECMK],[TPVP,VECMK],[TLOCI,TPMK],[TTP,TPMK] +[TSP,TPMK],[TMACRO,PAIRMK],[TPDL,PMK],[TARGS,ARGMK],[TAB,ABMK] +[TTB,TBMK],[TFRAME,FRMK],[TCHSTR,BYTMK],[TATOM,ATOMK],[TLOCD,LOCMK],[TBYTE,BYTMK] +[TENV,FRMK],[TACT,FRMK],[TASOC,ASMK],[TLOCU,UVMK],[TLOCS,BYTMK],[TLOCA,ARGMK] +[TCBLK,GCRET],[TTMPLT,TD.MK],[TLOCT,TD.MK],[TLOCR,GCRET],[TINFO,GCRET] +[TRDTB,GCRDMK],[TWORD,GCRET],[TRSUBR,VECMK],[TCODE,UVMK],[TSATC,GCRET] +[TBITS,GCRET],[TSTORA,UVMK],[TPICTU,UVMK],[TSKIP,TPMK],[TLINK,ATOMK] +[TDECL,PAIRMK],[TENTER,VECMK],[THAND,VECMK],[TINTH,VECMK],[TDISMI,ATOMK] +[TDCLI,PAIRMK],[TPCODE,GCRET],[TTYPEW,GCRET],[TTYPEC,GCRET] +[TGATOM,GATOMK],[TREADA,FRMK],[TUBIND,GCRET],[TUNWIN,TBMK],[TLOCB,BYTMK] +[TDEFQ,DEFQMK],[TSPLIC,PAIRMK],[TLOCN,ASMK],[TOFFS,OFFSMK]] + IRP A,B,[XX] + LOC DUM1+A + SETZ B + .ISTOP + TERMIN +TERMIN + +LOC DUM1+NUMPRI+1 + +OFFSET OFFS + +; SAT DISPATCH TABLE + +MSATBS: + +OFFSET 0 + +DISTB2 DUM2,GCRET,[[S2WORD,PAIRMK],[S2DEFR,DEFMK],[SNWORD,UVMK],[STBASE,TBMK] +[STPSTK,TPMK],[SARGS,],[S2NWORD,VECMK],[SPSTK,TPMK],[SSTORE,UVMK] +[SFRAME,],[SBYTE,],[SATOM,ATOMK],[SPVP,VECMK],[SGATOM,GATOMK] +[SLOCID,],[SCHSTR,],[SASOC,ASMK],[SLOCL,PAIRMK],[SABASE,ABMK] +[SLOCA,],[SLOCV,VECMK],[SLOCU,UVMK],[SLOCS,],[SLOCN,ASMK] +[SRDTB,GCRDMK],[SLOCB,],[SDEFQ,DEFQMK],[SOFFS,OFFSMK]] + +OFFSET OFFS + + +; ROUTINE TO MARK PAIRS + +PAIRMK: MOVEI C,(A) +PAIRM1: CAMG C,GCSTOP ; SEE IF IN RANGE + CAIGE C,STOSTR + JRST BADPTR ; FATAL ERROR + HLRE B,(C) ; SKIP IF NOT MARKED + JUMPL B,GCRET + IORM D,(C) ; MARK IT + PUSHJ P,MARK1 ; MARK THE ITEM + HRRZ C,(C) ; GET NEXT ELEMENT OF LIST + JUMPE C,GCRET + CAML C,PURBOT + JRST GCRET + JRST PAIRM1 + +; ROUTINE TO MARK DEFERS + +DEFMK: HLRE B,(A) + JUMPL B,GCRET + MOVEI C,(A) + IORM D,(C) + PUSHJ P,MARK1 + JRST GCRET + +; ROUTINE TO MARK POSSIBLE DEFERS DEF? + +DEFQMK: GETYP B,(A) ; GET THE TYPE OF THE OBJECT + LSH B,1 ; COMPUTE THE SAT + HRRZ B,@TYPNT + ANDI B,SATMSK + SKIPL MKTBS(B) ; SKIP IF NOT DEFERED + JRST PAIRMK + JRST DEFMK ; GO TO DEFMK + + +; ROUTINE TO MARK VECTORS + +VECMK: HLRE B,A ; GET LENGTH + SUB A,B + MOVEI C,1(A) ; POINT TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + HLRE B,(C) + JUMPL B,GCRET + IORM D,(C) ; MARK IT + SUBI C,-1(B) ; GET TO BEGINNING +VECMK1: HLRE B,(C) ; GET TYPE AND SKIP IF NOT DOPE WORD + JUMPL B,GCRET ; DONE + PUSHJ P,MARK1 ; MARK IT + ADDI C,2 ; NEXT ELEMENT + JRST VECMK1 + +; ROUTINE TO MARK UVECTORS + +UVMK: HLRE B,A ; GET LENGTH + SUB A,B ; A POINTS TO FIRST DOPE WORD + MOVEI C,1(A) ; C POINTS TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + HLRE F,(C) ; GET LENGTH + JUMPL F,GCRET + IORM D,(C) ; MARK IT + GETYP B,-1(C) ; GET TYPE + MOVEI E,(B) ; COPY TYPE FOR SAT COMPUTATION + LSH B,1 + HRRZ B,@TYPNT ; GET SAT + ANDI B,SATMSK + MOVEI B,@MSATBS(B) ; GET JUMP LOCATION + CAIN B,GCRET + JRST GCRET + SUBI C,(F) ; POINT TO BEGINNING OF UVECTOR + SUBI F,2 + JUMPE F,GCRET + PUSH P,F ; SAVE LENGTH + PUSH P,E +UNLOOP: MOVE B,(P) + MOVE A,1(C) ; GET VALUE POINTER + PUSHJ P,MARK + SOSE -1(P) ; SKIP IF NON-ZERO + AOJA C,UNLOOP ; GO BACK AGAIN + SUB P,[2,,2] ; CLEAN OFF STACK + JRST GCRET + +; ROUTINE TO INDICATE A BAD POINTER + +BADPTR: FATAL POINTER POINTS OUT OF GARBAGE COLLECTED SPACE + JRST GCRET + + +; ROUTINE TO MARK A TPSTACK + +TPMK: HLRE B,A ; GET LENGTH + SUB A,B ; A POINTS TO FIRST DOPE WORD + MOVEI C,PDLBUF+1(A) ; C POINTS TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + HLRE A,(C) + JUMPL A,GCRET + IORM D,(C) ; MARK IT + SUBI C,-1(A) ; GO TO BEGINNING + +TPLP: HLRE B,(C) ; GET TYPE AND MARKING + JUMPL B,GCRET ; EXIT ON FENCE-POST + ANDI B,TYPMSK ; FLUSH MONITORS + CAIE B,TCBLK ; CHECK FOR FRAME + CAIN B,TENTRY + JRST MFRAME ; MARK THE FRAME + CAIE B,TUBIND ; BINDING BLOCK + CAIN B,TBIND + JRST MBIND + PUSHJ P,MARK1 ; NOTHING SPECIAL SO MARK IT + ADDI C,2 ; POINT TO NEXT OBJECT + JRST TPLP ; MARK IT + +; MARK A FRAME ON THE STACK, [I.E. ITS FSAV AND PSAV SLOTS] + +MFRAME: HRROI C,FRAMLN+FSAV-1(C) ; POINT TO FUNCTION + HRRZ A,1(C) ; GET POINTER + CAIL A,STOSTR ; SEE IF IN GC SPACE + CAMLE A,GCSTOP + JRST MFRAM1 ; SKIP OVER IT, NOT IN GC-SPACE + HRL A,(A) ; GET LENGTH + MOVEI B,TVEC ; TYPE IS VECTOR [RSUBR OR RSUBR-ENTRY] + PUSHJ P,MARK +MFRAM1: MOVE A,PSAV-FSAV+1(C) ; MARK THE PSTACK + MOVEI B,TPDL + PUSHJ P,MARK + HRROI C,-FSAV+1(C) ; POINT PAST FRAME + JRST TPLP ; GO BACK TO START OF LOOP + +; MARK A BINDING ON THE STACK [I.E. THE ATOM, VALUE, DECL, AND PREVIOUS BINDING] + +MBIND: MOVEI B,TATOM ; START BY MARKING THE ATOM + PUSHJ P,MARK1 ; MARK IT + ADDI C,2 ; POINT TO VALUE SLOT + PUSHJ P,MARK2 ; MARK THE VALUE + ADDI C,2 ; POINT TO DECL AND PREV BINDING + MOVEI B,TLIST ; MARK DECL + HLRZ A,(C) + PUSHJ P,MARK + SKIPL A,1(C) ; SKIP IF PREVIOUS BINDING + JRST NOTLCI + MOVEI B,TLOCI ; GET TYPE + PUSHJ P,MARK +NOTLCI: ADDI C,2 ; POINT PAST BINDING + JRST TPLP + + +PMK: HLRE B,A ; GET LENGTH + SUB A,B ; A POINTS TO FIRST DOPE WORD + MOVEI C,PDLBUF+1(A) ; C POINTS TO SECOND DOPE WORD + CAIL C,STOSTR ; CHECK FOR IN RANGE + CAMLE C,GCSTOP + JRST BADPTR + IORM D,(C) ; MARK IT + JRST GCRET + +; ROUTINE TO MARK TB POINTER + +TBMK: HRRZS A ; CHECK FOR NIL POINTER + SKIPN A + JRST GCRET + MOVE A,TPSAV(A) ; GET A TP POINTER + MOVEI B,TTP ; TYPE WORD + PUSHJ P,MARK + JRST GCRET + +; ROUTINE TO MARK AB POINTERS + +ABMK: HLRE B,A ; GET TO FRAME + SUB A,B + MOVE A,FRAMLN+TPSAV(A) ; GET A TP POINTER + MOVEI B,TTP ; TYPE WORD + PUSHJ P,MARK + JRST GCRET + +; ROUTINE TO MARK FRAME POINTERS + +FRMK: HRLZ B,A ; GET THE TIME + HLRZ F,OTBSAV(A) ; GET TIME FROM FRAME + CAIE B,(F) ; SKIP IF TIMES AGREE + JRST GCRET ; IGNORE POINTER IF THEY DONT + HRRZ A,(C) ; GET POINTER TO PROCESS + SUBI A,1 ; FUDGE FOR VECTOR MARKING + MOVEI B,TPVP ; TYPE WORD + PUSHJ P,MARK + HRRZ A,1(C) ; GET POINTER TO FRAME + JRST TBMK ; MARK IT + +; ROUTINE TO MARK ARGUMENT BLOCKS [TUPLES] + +ARGMK: HLRE B,A ; GET LENGTH + SUB A,B ; POINT PAST BLOCK + CAIL A,STOSTR + CAMLE A,GCSTOP ; SEE IF IN GCSPACE + JRST GCRET + HRLZ 0,(A) ; GET TYPE + ANDI 0,TYPMSK ; FLUSH MONITORS + CAIE 0,TENTRY + CAIN 0,TCBLK + JRST ARGMK1 ; AT FRAME + CAIE 0,TINFO ; AT FRAME + JRST GCRET ; NOT A LEGAL TYPE GO AWAY + HRRZ A,1(A) ; POINTING TO FRAME + HRL A,(C) ; GET TIME + JRST TBMK +ARGMK1: HRRI A,FRAMLN(A) ; MAKE POINTER + HRL A,(C) ; GET TIME + JRST TBMK + + +; ROUTINE TO MARK GLOBAL SLOTS + +GATOMK: HRRZ B,(C) ; GET POSSIBLE GDECL + JUMPE B,ATOMK ; NONE GO TO MARK ATOM + CAIN B,-1 ; SKIP IF NOT MANIFEST + JRST ATOMK + PUSH P,A ; I DOUBT THIS IS RIGHT, BUT IT WORKED ONCE--TAA + MOVEI C,(A) + MOVEI A,(B) + MOVEI B,TLIST ; TYPE WORD LIST + PUSHJ P,MARK ; MARK IT + POP P,A + JRST ATOMK5 + +ATOMK: +ATOMK5: HLRE B,A + SUB A,B ; A POINTS TO DOPE WORD + SKIPGE 1(A) ; SKIP IF NOT MARKED + JRST GCRET ; EXIT IF MARKED + HLRZ B,1(A) + SUBI B,3 + HRLI B,1(B) + MOVEI C,-1(A) + SUB C,B ; IN CASE WAS DW + IORM D,1(A) ; MARK IT + HRRZ A,2(C) ; MARK OBLIST + CAMG A,VECBOT + JRST NOOBL ; NO IMPURE OBLIST + HRLI A,-1 + MOVEI B,TOBLS ; MARK THE OBLIST + PUSHJ P,MARK +NOOBL: HLRZ A,2(C) ; GET NEXT ATOM + MOVEI B,TATOM + PUSHJ P,MARK + HLRZ B,(C) ; GET VALUE SLOT + TRZ B,400000 ; TURN OFF MARK BIT + SKIPE B ; SEE IF 0 + CAIN B,TUNBOUN ; SEE IF UNBOUND + JRST GCRET + HRRZ 0,(C) ; SEE IF VECTOR OR TP POINTER + MOVEI B,TVEC ; ASSUME VECTOR + SKIPE 0 ; SKIP IF VECTOR + MOVEI B,TTP ; IT IS A TP POINTER + PUSHJ P,MARK1 ; GO MARK IT + JRST GCRET + +; ROUTINE TO MARK BYTE AND STRING POINTERS + +BYTMK: PUSHJ P,BYTDOP ; GET TO DOPE WORD INTO A + HRLZ F,-1(A) ; SEE IF SPECIAL ATOM [SPNAME] + ANDI F,SATMSK ; GET SAT + CAIN F,SATOM + JRST ATMSET ; IT IS AN ATOM + IORM D,(A) ; MARK IT + JRST GCRET + +ATMSET: HLRZ B,(A) ; GET LENGTH + TRZ B,400000 ; TURN OFF POSSIBLE MARK BIT + MOVNI B,-2(B) ; GENERATE AOBJN POINTER + ADDI A,-1(B) ; GET BACK TO BEGINNING + HRLI A,(B) ; PUT IN LEFT HALF + MOVEI B,TATOM ; MARK AS AN ATOM + PUSHJ P,MARK ; GO MARK + JRST GCRET + +; MARK LOCID GOODIES + +LOCMK: HRRZ B,(C) ; CHECK FOR TIME + JUMPE B,LOCMK1 ; SKIP LEGAL CHECK FOR GLOBAL + HRRZ 0,2(A) ; GET OTHER TIME + CAIE 0,(B) ; SAME? + JRST GCRET + MOVEI B,TTP + PUSHJ P,MARK1 + JRST GCRET +LOCMK1: MOVEI B,TVEC ; GLOBAL + PUSHJ P,MARK1 ; MARK VALUE + JRST GCRET + +; MARK ASSOCIATION BLOCK + +ASMK: MOVEI C,(A) ; SAVE POINTER TO BEGINNING OF ASSOCATION + ADDI A,ASOLNT ; POINT TO DOPE WORD + HLRE B,1(A) ; GET SECOND D.W. + JUMPL B,GCRET ; MARKED SO LEAVE + IORM D,1(A) ; MARK ASSOCATION + PUSHJ P,MARK2 ; MARK ITEM + MOVEI C,INDIC(C) + PUSHJ P,MARK2 + MOVEI C,VAL-INDIC(C) + PUSHJ P,MARK2 + HRRZ A,NODPNT-VAL(C) ; GET NEXT IN CHAIN + JUMPN A,ASMK ; GO MARK IT + JRST GCRET + +; MARK OFFSETS + +OFFSMK: PUSH P,$TLIST + HLRZ 0,1(C) ; PICK UP LIST POINTER + PUSH P,0 + MOVEI C,-1(P) + PUSHJ P,MARK2 ; MARK THE LIST + SUB P,[2,,2] + JRST GCRET ; AND RETURN + +; HERE TO MARK TEMPLATE DATA STRUCTURES + +TD.MK: HLRZ B,(A) ; GET REAL SPEC TYPE + ANDI B,37777 ; KILL SIGN BIT + MOVEI E,-NUMSAT-1(B) ; GET REL POINTER TO TABLE + HRLI E,(E) + ADD E,TD.AGC+1 + HRRZS C,A ; FLUSH COUNT AND SAVE + SKIPL E ; WITHIN BOUNDS + FATAL BAD SAT IN AGC + SKIPL 1(A) ; SEE IF MARKED + JRST GCRET ; IF MARKED LEAVE + IORM D,1(A) + + SKIPE (E) + JRST USRAGC + SUB E,TD.AGC+1 ; POINT TO LENGTH + ADD E,TD.LNT+1 + XCT (E) ; RET # OF ELEMENTS IN B + + HLRZ D,B ; GET POSSIBLE "BASIC LENGTH" FOR RESTS + PUSH P,[0] ; TEMP USED IF RESTS EXIST + PUSH P,D + MOVEI B,(B) ; ZAP TO ONLY LENGTH + PUSH P,C ; SAVE POINTER TO TEMPLATE STRUCTURE + PUSH P,B ; SAVE + SUB E,TD.LNT+1 + PUSH P,E ; SAVE FOR FINDING OTHER TABLES + JUMPE D,TD.MR2 ; NO REPEATING SEQ + ADD E,TD.GET+1 ; COMP LNTH OF REPEATING SEQ + HLRE E,(E) ; E ==> - LNTH OF TEMPLATE + ADDI E,(D) ; E ==> -LENGTH OF REP SEQ + MOVNS E + HRLM E,-3(P) ; SAVE IT AND BASIC + +TD.MR2: SKIPG D,-1(P) ; ANY LEFT? + JRST TD.MR1 + + MOVE E,TD.GET+1 + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + MOVEM D,-4(P) ; SAVE ELMENT # + SKIPN B,-3(P) ; SKIP IF "RESTS" EXIST + SOJA D,TD.MR3 + + MOVEI 0,(B) ; BASIC LNT TO 0 + SUBI 0,(D) ; SEE IF PAST BASIC + JUMPGE 0,.-3 ; JUMP IF O.K. + MOVSS B ; REP LNT TO RH, BASIC TO LH + IDIVI 0,(B) ; A==> -WHICH REPEATER + MOVNS A + ADD A,-3(P) ; PLUS BASIC + ADDI A,1 ; AND FUDGE + MOVEM A,-4(P) ; SAVE FOR PUTTER + ADDI E,-1(A) ; POINT + SOJA D,.+2 + +TD.MR3: ADDI E,(D) ; POINT TO SLOT + XCT (E) ; GET THIS ELEMENT INTO A AND B + JFCL ; NO-OP FOR ANY CASE + EXCH A,B ; REARRANGE + HLRZS B + MOVSI D,400000 ; RESET FOR MARK + PUSHJ P,MARK ; AND MARK THIS GUY (RET FIXED POINTER IN A) + MOVE C,-2(P) ; RESTORE POINTER IN CASE MUNGED + JRST TD.MR2 + +TD.MR1: SUB P,[5,,5] + JRST GCRET + +USRAGC: XCT (E) ; MARK THE TEMPLATE + JRST GCRET + + +; ROUTINE TO MARK THE GC-READ TABLE. MARKS THE ATOMS AT THE DOPE WORDS +; AND UPDATES PTR TO THE TABLE. + +GCRDMK: MOVEI C,(A) ; SAVE POINTER TO GCREAD TABLE + HLRE B,A ; GET TO DOPE WORD + SUB A,B + SKIPGE 1(A) ; SKIP IF NOT MARKED + JRST GCRET + IORM D,1(A) ; MARK THE CHOMPER!!! + SUBI A,2 + MOVE B,ABOTN ; GET TOP OF ATOM TABLE + ADD B,0 ; GET BOTTOM OF ATOM TABLE +GCRD1: CAMG A,B ; DON'T SKIP IF DONE + JRST GCRET + HLRZ C,(A) ; GET MARKING + TRZN C,400000 ; SKIP IF MARKED + JRST GCRD3 + MOVEI E,(A) + SUBI A,(C) ; GO BACK ONE ATOM + PUSH P,B ; SAVE B + PUSH P,A ; SAVE POINTER + MOVEI C,-2(E) ; SET UP POINTER + MOVEI B,TATOM ; GO TO MARK + MOVE A,1(C) + PUSHJ P,MARK + POP P,A + POP P,B + JRST GCRD1 +GCRD3: SUBI A,(C) ; TO NEXT ATOM + JRST GCRD1 + + +; ROUTINE TO FIX UP CHANNELS + +CHNFLS: MOVEI 0,N.CHNS-1 + MOVEI A,,CHNL1 ; SET UP POINTER +CHFL1: SKIPN B,1(A) ; GET POINTER TO CHANNEL + JRST CHFL2 ; NO CHANNEL LOOP TO NEXT + HLRE C,B ; POINT TO DOPE WORD OF CHANNEL + SUBI B,(C) + MOVEI F,TCHAN + HRLM F,(A) ; PUT TYPE BACK + SKIPL 1(B) ; SKIP IF MARKED + JRST FLSCH ; FLUSH THE CHANNEL + MOVEI F,1 ; MARK THE CHANNEL AS GOOD + HRRM F,(A) ; SMASH IT IN +CHFL2: ADDI A,2 + SOJG 0,CHFL1 + POPJ P, ; EXIT +FLSCH: HLLOS F,(A) ; -1 INTO SLOT INDICATES LOSSAGE + JRST CHFL2 + + +; THIS ROUTINE MARKS ALL THE CHANNELS + +CHFIX: MOVEI 0,N.CHNS-1 + MOVEI A,CHNL1 ; SLOTS + +DHNFL2: SKIPN 1(A) + JRST DHNFL1 + PUSH P,0 ; SAVE 0 + PUSH P,A ; SAVE A + MOVEI C,(A) + MOVE A,1(A) + MOVEI B,TCHAN + PUSHJ P,MARK + POP P,A ; RESTORE A + POP P,0 ; RESTORE +DHNFL1: ADDI A,2 + SOJG 0,DHNFL2 + POPJ P, + + + +; CONVERSION FROM FLOAT TO DECIMAL. X 100 AND SEND OUT WITH APPROPRIATELY PLACED DECIMAL +; POINT. + +FIXSEN: PUSH P,B ; SAVE TIME + MOVEI B,[ASCIZ /TIME= /] + PUSHJ P,MSGTYP ; PRINT OUT MESSAGE + POP P,B ; RESTORE B + FMPRI B,(100.0) ; CONVERT TO FIX + MULI B,400 + TSC B,B + ASH C,-163.(B) + MOVEI A,1 ; INITIALIZE COUNT OF CHARACTERS FOR PUTTING OUT TIME + PUSH P,C + IDIVI C,10. ; START COUNTING + JUMPLE C,.+2 + AOJA A,.-2 + POP P,C + CAIN A,1 ; SEE IF THERE IS ONLY ONE CHARACTER + JRST DOT1 +FIXOUT: IDIVI C,10. ; RECOVER NUMBER + HRLM D,(P) + SKIPE C + PUSHJ P,FIXOUT + PUSH P,A ; SAVE A + CAIN A,2 ; DECIMAL POINT HERE? + JRST DOT2 +FIX1: HLRZ A,(P)-1 ; GET NUMBER + ADDI A,60 ; MAKE IT A CHARACTER + PUSHJ P,IMTYO ; OUT IT GOES + POP P,A + SOJ A, + POPJ P, +DOT1: MOVEI A,". ; OUTPUT DECIMAL POINT AND PADDING 0 + PUSHJ P,IMTYO + MOVEI A,"0 + PUSHJ P,IMTYO + JRST FIXOUT ; CONTINUE +DOT2: MOVEI A,". ; OUTPUT DECIMAL POINT + PUSHJ P,IMTYO + JRST FIX1 + + +; ROUTINE TO SEEP THROUGH GC SPACE LOOKING FOR FREE SLOTS. PAIRS ARE PLACED ON THE +; RCL LIST, VECTORS ON THE RCLV LIST. + +SWEEP: MOVE C,GCSTOP ; GET TOP OF GC SPACE + SUBI C,1 ; POINT TO FIRST OBJECT + SETZB E,F ; CURRENT SLOT AND CURRENT LENGTH +LSWEEP: CAMG C,GCSBOT ; SKIP IF ABOVE GCSBOT + JRST ESWEEP ; DONE + HLRE A,-1(C) ; SEE IF LIST OR VECTOR + TRNE A,UBIT ; SKIP IF LIST + JRST VSWEEP ; IT IS A VECTOR + JUMPGE A,LSWP1 ; JUMP IF NOT MARKED + ANDCAM D,-1(C) ; TURN OFF MARK BIT + PUSHJ P,SWCONS ; CONS ON CURRENT OBJECT + SUBI C,2 ; SKIP OVER LIST + JRST LSWEEP +LSWP1: ADDI F,2 ; ADD TO CURRENT OBJECT COUNT + JUMPN E,LSWP2 ; JUMP IF CURRENT OBJECT EXISTS + MOVEI E,(C) ; GET ADDRESS +LSWP2: SUBI C,2 + JRST LSWEEP + +VSWEEP: HLRE A,(C) ; GET LENGTH + JUMPGE A,VSWP1 ; SKIP IF MARKED + ANDCAM D,(C) ; TURN OFF MARK BIT + PUSHJ P,SWCONS + ANDI A,377777 ; GET LENGTH PART + SUBI C,(A) ; GO PAST VECTOR + JRST LSWEEP +VSWP1: ADDI F,(A) ; ADD LENGTH + JUMPN E,VSWP2 + MOVEI E,(C) ; GET NEW OBJECT LOCATION +VSWP2: SUBI C,(A) ; GO BACK PAST VECTOR + JRST LSWEEP + +ESWEEP: +SWCONS: JUMPE E,CPOPJ + ADDM F,TOTCNT ; HACK TOTCNT + CAMLE F,MAXLEN ; SEE IF NEW MAXIMUM + MOVEM F,MAXLEN + CAIGE F,2 ; MAKE SURE AT LEAST TWO LONG + FATAL SWEEP FAILURE + CAIN F,2 + JRST LCONS + SETZM (E) + MOVEI 0,(E) + SUBI 0,-1(F) + SETZM @0 + HRLS 0 + ADDI 0,1 + BLT 0,-2(E) + HRRZ 0,RCLV ; GET VECTOR RECYCLE + HRRM 0,(E) ; SMASH INTO LINKING SLOT + HRRZM E,RCLV ; NEW RECYCLE SLOT + HRLM F,(E) + MOVSI F,UBIT + MOVEM F,-1(E) + SETZB E,F + POPJ P, ; DONE +LCONS: SETZM (E) + SUBI E,1 + HRRZ 0,RCL ; GET RECYCLE LIST + HRRZM 0,(E) ; SMASH IN + HRRZM E,RCL + SETZB E,F + POPJ P, + + +; THESE ARE THE MESSAGES INDICATING THE CAUSE OF THE GC + +MSGGCT: [ASCIZ /USER CALLED- /] + [ASCIZ /FREE STORAGE- /] + [ASCIZ /TP-STACK- /] + [ASCIZ /TOP-LEVEL LOCALS- /] + [ASCIZ /GLOBAL VALUES- /] + [ASCIZ /TYPES- /] + [ASCIZ /STATIONARY IMPURE STORAGE- /] + [ASCIZ /P-STACK /] + [ASCIZ /BOTH STACKS BLOWN- /] + [ASCIZ /PURE STORAGE- /] + [ASCIZ /GC-RCALL- /] + +; THESE ARE MESSAGES INDICATING WHO CAUSED THE GC + +GCPAT: SPBLOK 100 +EGCPAT: -1 + +MSGGFT: [ASCIZ /GC-READ /] + [ASCIZ /BLOAT /] + [ASCIZ /GROW /] + [ASCIZ /LIST /] + [ASCIZ /VECTOR /] + [ASCIZ /SET /] + [ASCIZ /SETG /] + [ASCIZ /FREEZE /] + [ASCIZ /PURE-PAGE LOADER /] + [ASCIZ /GC /] + [ASCIZ /INTERRUPT-HANDLER /] + [ASCIZ /NEWTYPE /] + [ASCIZ /PURIFY /] + +CONSTANTS + +HERE + +CONSTANTS + +OFFSET 0 + +ZZ==$.+1777 + +.LOP ANDCM ZZ 1777 + +ZZ1==.LVAL1 + +LOC ZZ1 + +OFFSET OFFS + +MRKPDL==.-1 + +ENDGC: + +OFFSET 0 + +ZZ2==ENDGC-AGCLD + +.LOP ZZ2 <,-10.> +SLENGC==.LVAL1 +.LOP SLENGC <10.> +RSLENG==.LVAL1 +LOC GCST + +.LPUR=$. + +END diff --git a//arith.bin.4 b//arith.bin.4 new file mode 100644 index 0000000000000000000000000000000000000000..2d7fdce9afdedf2852398ba64c27209fbc9ad3a1 GIT binary patch literal 28945 zcmd6Qi$5FB7xwH5g2W|4E`&vB+=Eius-LrjyyTGtZp!oHLi5ED<^v;?J*db2Xm7TY^)*w{_acdAeT9T%PxBQsb=4d(bFz zx!y0IbuP>03JS}U@~f*T=LSqc)lK9xU{&Qr0Dkp2UYcQP}M*UaUl!(7eee&Uw&F zT@-D-Szr;(>z*vqNkSD~+6QZtOh;q%w z=W}F4-DYS$A^J6{Vz1yLqNA*&FE)?=g=mkpKi%T1Ikn5B$2!XFt8K?ywZ$Shfzn1H zbU_W-X$e_f>2Z|FZogH75#CMgG!TAkmIW?S1#pBg_!CNTs5O{mdn(5 zk=>(6vMC%zO`<-3c;|!Yj|q{RY@OHNpo}qllRl*t--IuI{Ha_7H6eohT_xa*g}-f& zE*=%5U4_&hj_N41J6&H_R`J1Z*MLhRZL7W`>Xs%%F|?~wQOa#~fA_?weH$5Ia~KjZ zK+T{C5)d6<`Cep1*FtEX?kE*1=|U#u==aghr3mUmAyNqOT%1$8*K`q!H>M!^<1+xC(?<}kjxRl8HhkqW|`Yu@i z55kB`S4l^K+D}3RG-|v{7eZmfhdT?yMeRfe$%8eLbHzvUZ*JOKs7&6`L^-05TWBtF z-L5h7-Zz%)gIt}k7RzMCy-bK05Fb#Ya1Zv@`ywqIN|sJ^)-q@ZqC>EOHJJ8ZrM(LpPLkSx#ML za;1Lo6(SO|iOCvT^DLahU7A>bRlZN#EYx(eTu{|*v*~{B64z0gJ?VhE%-NMjmM(MT z^sT=B`(=V>G7LKhFp5kpVsE7W*^T5M?ntY&{^g6dgk34kWXj@bmiaf!{DWH!r`-lD zuXylx3mW`&5fdp*as^|PtLY9)lO00%w&&CSpf&jGmctHP4oh;RXPWw53;+QS%$X3p zuz}ylVF@#}gy|9Nrjq^9RqmXhW^bJjQ+uX6ccETNWko?1Y^rKf1qHKfPWf6HVe1=`9i~NWH1*HoWvI~X% z%{-!rfzE@8wR+pW_i~}iRUM#h15kJkrIO}07g7PE(8MCX4|&(J3H5SgfyvNhxzJt) zES0tk350sPN#GX4BX5Opy3iiGP-r0Ztip1kUCV{`EEggIBIFhWB2H5nrwg@Z=BW^atpu;X0Smjg z8LyyK=v=*7dqQ2aVsAyM&n%v_^f?9+A64;O;9Cii;r;rwvDoyVux-c%H^x zQ1qo$rf}Rvnb1^Xu_|bvwTW^{Z&ZlU4q~=~aLvqqB}qN_N`t%@ujxLm{$*?YUZf5X zBPcmY?J(o5qy`L+iA8)p_%f6YsRL-0&9i%Lk~$z~q)se{>7=%rC}UC= z6%@pNn4}JrnxqbtnWToCB=!EJN$QLUzS}B(5UClsLFxdtOsUrGnmEdW)WA%MNWDva z(;ku3;~;gP2*$;@T1`!AMCBatbWW16e}fhhlqM>6pM`5|4c(7~ejRl=4WFv^TS*8Q z9utfBdRCLw0x&?kZ6kKHWI3UQD|Zj`wf>JZHv*jogeVFrcH%iDk?tp`4mpO+r@i6Eer}9vEN}wstgprfoU-04mULk#N8w zA<0P+?(sexlQ0v4*S3luLPBXblY}%+qojSAznPF)yVEWN`bG&_8+}|7z5xk)K*Bc` z33=5fBVl-Rv5z;WrUFBw7uyp@JLZkbDO`9+vQmTA~ z5Wr0m%7^FLmt+?|)w<&xGeDRrL2F%)OTsCTkaQmxQ<+E@*^Rq7n9un8znwmKPB^cl zTTT+Ds{J++<^qP-#3HsUZ;qa2L&AA9%j)c~NVut^%!#GOCLs^Uc9W15G*w9_;U<&t z$CI5QvadnH4U2@E770mCl28t9Ou|eEQU;rckWkvqB;f{di^#g~^M%yf-6A1jrUVkw z9-j7y!|@DA7zYVwEE1}%)V7R-5%T()BRqeNu5HP$Z z7O}I^J!x!j-)%US^IE7gY?840^j|FHg*FL!IJTPvZn+8Vh=kRrG7{#$`nG41u=>O# zVfCp=LdZ!HzGs7igc%X!+bVt#30YSL39C;Sea*{*{O?(i5SS^E*1i-xE(vEr!cIY( zt+enfNakZ@c&t*kA@9`5mV_1KwFIv>tN?tcPp| znU4!^Q!dO*Z*eGH;+j#xYIyEOgdw+_Qa1IGRu39VDXriFua8!T+#hCVf$v??MFQce z8C8eKJ6lAH5nlWg3o(smZY$Jxt7<5(=dfvCyTrpAG z8W-Y|M)!-}5g|4-H74r$>Pz~%qq*qHFkQ5dL8x5I>sQI`9pKv%T0%5+5Db-1MWCzu z$T4?!@HORL>$t>Gs~!^}u1a;ego`T}+@dD?blgj*a(K%kWrvxb)TkPiWz}-nM!OlJ zl#2LSWl7s7%Av`hmG5`{#DVWnC470fgH5*0SFNwI0(&!^E8sSOuUg`xr$)lUw-0=~ z7Cxy-2%oU7c;CBwTca)YD1G38J`gTD4KS$Mbc zxMo795^>S~Q|XT##RFA(c{<#3dV`33sbL$VY*_f$5M;F+W^UU}c zDfkzQ?@R>e5zzQVR7?oFNv@!4i2ifLzeoYczoyS;e|ydN7jaKP`b+I{q`-`SkdyIm zbrT2>|1u&-nddwt{#CQCjQAIUSJH{WrD)igy4-0H24+eW|F%vaH~w89{?SfvTwGX# zFgp(IchXX-=6q^S1lPG(+#gmmbnUtEbiisBgB?0s)O zeW!B-4%E{HJXQonl^pDLb1)y~=k`5`n3C^vQIN*fJbbu%-b@%@F^I@Ro^(Mh;Hx~{ z`};ciE#(B${g};9R@2xto5ktgNEZ`{PWSp|EF#6H2q{OiE{jMcCyDfqW_?C9%hdRk zJz(62NSb}RSII-fi~|ae;B98JuYzt-0*9zu+T*PzlzigQH4P&DN`7gME^VHRwuL64 zQ#7ltf0v|7LMd>Uo_kts4c*V?Pf=Hz%~REWTQqY4hR47n#JBo*O*TVncd0I5Hn}n>G9;9&Q98yP_gr3gp1#4X!NmwKtwMa;E1_|3O5@tg1%vSMz zNJt~kFpx^Snb9nPB2invf1J&_HbR&wfr%8UwMS%P0ho9~L#k3>4XKDyN-+R-p- z(D+@4RKiRNB;;v;c&s5+DFg|BfrN#bNLXFJc7b`F;;FcPsXX+=W#prdZaEE~s`lGR z=mHFnfd!E;R*==a?jxFIb=F%X{Gp@FiN%*jLc2-Gis^snbw6Yz>=+ocHdi7C772e? zBqTY5gtQ1ThT}{KO8y%XO1qgPlqWfA>%V@@W^*M%m??pTWvsPFBO#8(U(>PpxZ<%$ z$a6Cz62?0^p?SqyncSNR+8VlFB;=@?X82UK-$ue5z$h}XP$bOHsmtbpTO?_zlYjSw z2W~ZVZiAA8gk{%hB($643da8-VGYe>-E;z5`{sLPM#36llCVZGNeDSf!ett^B?&Vk zxUg0Hph(ENGDt|Ri$wxrNqmdAY^{;VQU-1f;OHEr`@S&P( zUOs4aPR7`w(g3YSC^Z1cV)yRUOL;qK+rH7>%K?nkLCzRjm|0mExx zp}j=4n-s(B#2sms{`(NUhIBy*?EH({;L{BiI?5bA?b#PWnhB8B-q58O{Q$&j60(AR zZk3puLC!JHZm8gU`l}99`mLp$;xzcDAom3gnT`!P>DXg00RvlC8DV_2_52XWmc}z2 zyMgwjDb@JCZ?;L*-D&Fzm?@F!KJo(f@f`$7+`?Roc{+`z5G z;N41Opf{+|4luc(Izb;Jlnc+ktqfvoT-4;bga#H@a2b^-&6+Bdn7j>ikU8AejGqLK zZIcK#5#)Jl8qtv80ZV7Eb;>I3&99dSQ!H~Y4`>LYt~AztOELGY9sn3#0}CzO2Y;St zv&d`+qFFZMSIYyMb(A?hU?pu-vzvshc)PH;B%I`LX7cCkO*hh$d4v2hi~P+N`ANb8xLN{{Oen}VjEFWYr zmBTZITj-C{TUIht`QFy^{ixigqcSIbQjK>Tl~uqfG_cS^rI|M`vZ8Vunq{LbT2vm? zQRc)ll162_Nyv)Vb8m%kQhAW6T>0zShhdA#FD)t$T2v-EN##*KUBpz*gkZ>4@k8Rc zw3|s~c@{@IfA;rvHgTLVQv#K#Z`vd7m-K?l6Qp~kH|TOFC6zgj<5!3-@cB6t6Qu5x zF?Q~f5YgBE(=z{l%47Wd5mVPunUf5urnrrmxq#s{uuzO0|2C8rF}Yb*G0pEaIm=k! zLMN7vG-BFK5^RdG{~TIwSdcOHY^s_z=!_UUZxM6BA|}Zh#N_AfOw3FOXdE@)e(?}u zMp#!SG3Ob5Q9N3V?FTVO1x+ye>AATZOcZ%eIzDSqiG^~~ zL7~!RKcvRbXmeQ@zxt&qV!!WYgoNb^BSg8}2;E`4cwkQ7q2b5lp;j%h{$Gs4`NVN4tyMczE=~k%l|4CJ`>%k5C^CbTmV$j?L4`g1(OC zb?+>`u}ynF?^)7OnUk@pe7VhgT!7&*u+ZjDenFlSF_w48>b7Bdnd5_&B zWX1FxEoz)$eTTir6S($;EbrO2yl2Pq9+H#Zli-IN>^+$f1Z)*Q#CxROOz+ud^tIJL zyQ{JZ>x7vSyodUxJz`iNh4=Ksdq#aP3v?OQ!QF8%@p*VE^pu(x${6$XDRsxgWW@pI z+)nz?x1;&j;vlN3blO96s~Y)?Qbm*Uw=^y&Z)@N^5%MzWewf|lMKHyYly`nrs3j4i zvV2>l>Dj@b4*HFlGDlZ+`>NrgB<#jn4Hc888U7_d*Ni6Jb@kK``ol6@-^f}H=xx1`-n z-#TaXbxnh@{A_%SFjInWQQx#j^sOcMRx^BS$@kLj#-JoerWN?sSU54B&!8FXiW&353CG25gu7%5xlTiSzc`=46x@*#STMvBD3j}KKu26Om z1-_vlbU2N2&or`H{RVw!=j8f2NiXdBa%|KFO0V~M2vlD!^bOGqD3skK=}A<*9~;x@ ze`WWixUTomrqumL#7oqb<|(N>z0GTL0HesjBE;^~#h+Pu?IoIJ{;8(dM!h=999~=W zGtF!5CLt?ES7~PE@Y<-Cy|#S)`jk$l%lTx~V|s1WYkDo@q}RUY^)I|OBZ4Da#Sa+~ zrQHm#jmlF#wcjr*db03ZV5US~yT;EE#iPw9cj2`a@QPjXT7?f~@_ce1EM5+eyCn(t zQ@oZuO3`)tU_N64S;E*giuZ_ zUoGU(6o=d-K6q_m9~@DX(uUfz1VMunt7$H2Pm=>Q6D=7=Lz+9Ls;EkS0FU6WK!2=t z_Z|%O)X%!}L@21-;37S92#+4rCL6AAYP(kkH*1c+_x`N$|IUd$cpK=6X{W)j-!D4 z>`jPHk{eM#n}RTn?9nDFS)mpr-uE{sw$|=P z%&3m8I?0e~id%^Z7$pW4BIeSor&$q`yqpqLOiw*Da{1cj=3X6T4lH?Z(urv`30bi? zx0FWAW^!l*jnS5Mg;@r~J3B58*Ef8@{#2v&`c(kYc{ z&|B#Z7$pW4qW50ZYeW#-kyh!y&kUPs1fc{&(a&QwN$*J=Wlnn2&*105SM#L1-6UiM zJu(~-j@ei9B-7ikc3)U)rsfHY-jf!+NzR~m9S|_RGa=~tkLb<1GU-jmrBt04UC(CC zguYRN*7yL8c(l0d1HHeCpsxDdc&YEFC_Vp>(UxLIDbZ04Nji>y?*S&&ADF!!>$G)s zuV~vmt)nt01yT)gD;)u&#K1yyTrCJ?6K$KP(JU*LUKp!MIn&DyLT))Wk;L%U_WJ zYgXE9y%)Rr*rFrJ8FXy6=$HvXk*(qf(UF0hbc6+I@IQ}K8CtvB;7^z-fsS6*+M`9s zO3?8e=vevxpyTj*faw@qUiNSH*}A$P9Zz(0&`E(*1KdhSz$h`W5FNK0=d+^Y37Tca z7MgTy$<+Ip)SWU|TTMb%j4rIC(Xl0$=~!~P`O%t-wz$mb*kZk?8*-A4T|Z1Z zW<>DYR`G-A$iNLc;tUt1>YSZd*~~?OnG(@a9yAn>M#muNNIxsp)Sx?$W|Pjr+Sl7n zy9Cy36Vp)DW4`)I^=dTR;eprfrZYhUFh?BV8k7N+}1*~7fLY7nMLK0jxr~e=`G=_ z%*{7+DMoukR+Eqwx4d}1g(gMR!i!%!WlQF0-x9R=Y`q&Cat5E{7N0Z0*s}Hf5I#%e znS2g%7i#9ZudAi%?i5~unG#gTGnB{Ub1nEx8!mCRwiG*0IL3KGV>}YgMd`&2IUAH! zwY>gsX9u>1?#IMxo$5-n{ujH_TVH@oFWku4ptoP-Y~X&paN~R^8z!P>Qk~YHy=ZCI zQRZagV%ivQHwjs>G&wWs9OGNsnS|=6zya;i$_0K)n?*wFjpdM&B#fV0B+P^$b(Bv4ytdy{`lH$)Asf|5Z8`gCy(^pzM~EhKxyS%`%PKp zkrxL)t6Gvj8(n8*ZGO5+Thhqkt>rhao$F^o>bX!HJ^#g_l*$N(j&9im)-Jm`@={Qt zZ;+s#zdb$tryq~o^H5TVOEjL3KW7oe7E|=;g#1w0XQEFvT&E7=s)9aWYj_S;{kN)L zu691tU?BQvcTTCj*m>Tr`36=st>#N&T6~ zdSIi(5>!WwPVkChOiIS_F@}#xd}!lMef=V;Zdj^Tydo53Atqn_H3oHv!{boTJo?F^NqGc zPL#jPP3Xw2SaOHRv0{EwYu}+OHB`~P@>hdg%$G>yu-C4SK0V9-OJ(#b3IDK)`ouY| z4j{K$UNt|dBiH9|^#pP#qZUC2Y~LO9mva~XkNJH1Q+O`6U2Sg0SHAY4V}kBb_A57v zW_9H9eE#GNxTb`Ck&_NS5SmxTAOEk(T#pS=h(=>t7RmD<5YO-s*s_+tw)y3i8+@ddx zZ*>3gGx$t4O1wVdp1TO?2yUgL@=y9yuBHU|4pCI$KX?)5)=EZ}p3n&mN}6>wFtSv4 z{sm?F$Wr@;hMdc_#r0CQeEl6yW0dhgD0YI2%JbL3aVaN!bV!z&Gdxsrl-v@Su@sU8 msSVeY)6?OfQ}4tom2t@6KWlfkzfyKCHmJ-_H?`#Zoc<5o)BmCX literal 0 HcmV?d00001 diff --git a//arith.mid.94 b//arith.mid.94 new file mode 100644 index 0000000..602aabf --- /dev/null +++ b//arith.mid.94 @@ -0,0 +1,856 @@ +TITLE ARITHMETIC PRIMITIVES FOR MUDDLE + +.GLOBAL HI,RLOW,CPLUS,CMINUS,CTIMES,CDIVID,CFIX,CFLOAT +.GLOBAL CLQ,CGQ,CLEQ,CGEQ,C1Q,C0Q,CMAX,CMIN,CABS,CMOD,CCOS,CSIN,CATAN,CLOG +.GLOBAL CEXP,CSQRT,CTIME,CORB,CXORB,CANDB,CEQVB,CRAND,CLSH,CROT, +.GLOBAL SAT,BFLOAT,FLGSET + +;BKD + +;DEFINES MUDDLE PRIMITIVES: FIX,FLOAT,ATAN,IEXP,LOG, +; G?,L?,0?,1?,+,-,*,/,MAX,MIN,ABS,SIN,COS,SQRT,RANDOM, +; TIME,SORT. + +RELOCATABLE + +.INSRT MUDDLE > + +O=0 + + +DEFINE TYP1 + (AB) TERMIN +DEFINE VAL1 + (AB)+1 TERMIN + +DEFINE TYP2 + (AB)+2 TERMIN +DEFINE VAL2 + (AB)+3 TERMIN + +DEFINE TYP3 + (AB)+4 TERMIN +DEFINE VAL3 + (AB)+5 TERMIN + +DEFINE TYPN + (D) TERMIN +DEFINE VALN + (D)+1 TERMIN + + +YES: MOVSI A,TATOM ;RETURN PATH FOR 'TRUE' + MOVE B,IMQUOTE T + AOS (P) + POPJ P, + +NO: MOVSI A,TFALSE ;RETURN PATH FOR 'FALSE' + MOVEI B,NIL + POPJ P, + + ;ERROR RETURNS AND OTHER UTILITY ROUTINES + +OVRFLW==10 +OVRFLD: ERRUUO EQUOTE OVERFLOW + +CARGCH: GETYP 0,A ; GET TYPE + CAIN 0,TFLOAT + POPJ P, + JSP A,BFLOAT + POPJ P, + +ARGCHK: ;CHECK FOR SINGLE FIXED OR FLOATING + ;ARGUMENT IF FIXED CONVERT TO FLOATING + ;RETURN FLOATING ARGRUMENT IN B ALWAYS + ENTRY 1 + GETYP C,TYP1 + MOVE B,VAL1 + CAIN C,TFLOAT ;FLOATING? + POPJ P, ;YES, RETURN + CAIE C,TFIX ;FIXED? + JRST WTYP1 ;NO, ERROR + JSP A,BFLOAT ;YES, CONVERT TO FLOATING AND RETURN + POPJ P, + +OUTRNG: ERRUUO EQUOTE ARGUMENT-OUT-OF-RANGE + +NSQRT: ERRUUO EQUOTE NEGATIVE-ARGUMENT + +DEFINE MFLOAT AC + IDIVI AC,400000 + FSC AC+1,233 + FSC AC,254 + FADR AC,AC+1 + TERMIN + +BFLOAT: MFLOAT B + JRST (A) + +OFLOAT: MFLOAT O + JRST (C) + +BFIX: MULI B,400 + TSC B,B + ASH C,(B)-243 + MOVE B,C + JRST (A) + + ;DISPATCH TABLES USED TO CONTROL THE FLOW OF THE VARIOUS PRIMITIVES + +TABLE2: SETZ NO ;TABLE2 (0) +TABLE3: SETZ YES ;TABLE2 (1) & TABLE3 (0) + SETZ NO ;TABLE2 (2) + SETZ YES + SETZ NO + +TABLE4: SETZ NO + SETZ NO + SETZ YES + SETZ YES + + + +FUNC: JSP A,BFIX + JSP A,BFLOAT + SUB B,VALN + IDIV B,VALN + ADD B,VALN + IMUL B,VALN + JSP C,SWITCH + JSP C,SWITCH + + + +FLFUNC==.-2 + FSBR B,O + FDVR B,O + FADR B,O + FMPR B,O + JSP C,FLSWCH + JSP C,FLSWCH + +DEFVAL==.-2 + 0 + 1 + 0 + 1 + 377777,,-1 + 400000,,1 + +DEFTYP==.-2 + TFIX,, + TFIX,, + TFIX,, + TFIX,, + TFLOAT,, + TFLOAT,, + ;PRIMITIVES FLOAT AND FIX + +IMFUNCTION FIX,SUBR + + ENTRY 1 + + JSP C,FXFL + MOVE B,1(AB) + CAIE A,TFIX + JSP A,BFIX + MOVSI A,TFIX + JRST FINIS + +IMFUNCTION FLOAT,SUBR + + ENTRY 1 + + JSP C,FXFL + MOVE B,1(AB) + CAIE A,TFLOAT + JSP A,BFLOAT + MOVSI A,TFLOAT + JRST FINIS + +CFIX: GETYP 0,A + CAIN 0,TFIX + POPJ P, + JSP A,BFIX + MOVSI A,TFIX + POPJ P, + +CFLOAT: GETYP 0,A + CAIN 0,TFLOAT + POPJ P, + JSP A,BFLOAT + MOVSI A,TFLOAT + POPJ P, + +FXFL: GETYP A,(AB) + CAIE A,TFIX + CAIN A,TFLOAT + JRST (C) + JRST WTYP1 + + +MFUNCTION ABS,SUBR + ENTRY 1 + GETYP A,TYP1 + CAIE A,TFIX + CAIN A,TFLOAT + JRST MOVIT + JRST WTYP1 +MOVIT: MOVM B,VAL1 ;GET ABSOLUTE VALUE OF ARGUMENT +AFINIS: HRLZS A ;MOVE TYPE CODE INTO LEFT HALF + JRST FINIS + + + +MFUNCTION MOD,SUBR + ENTRY 2 + GETYP A,TYP1 + CAIE A,TFIX ;FIRST ARG FIXED ? + JRST WTYP1 + GETYP A,TYP2 + CAIE A,TFIX ;SECOND ARG FIXED ? + JRST WTYP2 + MOVE A,VAL1 + IDIV A,VAL2 ;FORM QUOTIENT & REMAINDER + JUMPGE B,.+2 ;Only return positive remainders + ADD B,VAL2 + MOVSI A,TFIX + JRST FINIS + ;PRIMITIVES PLUS, DIFFERENCE, TIMES, DIVIDE, MIN, AND MAX + +MFUNCTION MIN,SUBR + + ENTRY + + MOVEI E,6 + JRST GOPT + +IMFUNCTION MAX,SUBR + + ENTRY + + MOVEI E,7 + JRST GOPT + +MFUNCTION DIVIDE,SUBR,[/] + + ENTRY + + MOVEI E,3 + JRST GOPT + +MFUNCTION DIFFERENCE,SUBR,[-] + + ENTRY + + MOVEI E,2 + JRST GOPT + +IMFUNCTION TIMES,SUBR,[*] + + ENTRY + + MOVEI E,5 + JRST GOPT + +MFUNCTION PLUS,SUBR,[+] + + ENTRY + + MOVEI E,4 + +GOPT: MOVE D,AB ;ARGUMENT POINTER + HLRE A,AB + MOVMS A + ASH A,-1 + PUSHJ P,CARITH + JRST FINIS + +; BUILD COMPILER ENTRIES TO THESE ROUTINES + +IRP NAME,,[CMINUS,CDIVID,CPLUS,CTIMES,CMIN,CMAX]CODE,,[2,3,4,5,6,7] + +NAME: MOVEI E,CODE + JRST CARIT1 +TERMIN + +CARIT1: MOVEI D,(A) + ASH D,1 ; TIMES 2 + HRLI D,(D) + SUBM TP,D ; POINT TO ARGS + PUSH TP,$TTP + AOBJN D,.+1 + PUSH TP,D + PUSHJ P,CARITH + MOVE TP,(TP) + SUB TP,[1,,1] + POPJ P, + +CARITH: MOVE B,DEFVAL(E) ; GET VAL + JFCL OVRFLW,.+1 + MOVEI 0,TFIX ; FIX UNTIL CHANGE + JUMPN A,ARITH0 ; AT LEAST ONE ARG + MOVE A,DEFTYP(E) + POPJ P, + +ARITH0: SOJE A,ARITH1 ; FALL IN WITH ONE ARG + MOVE B,1(D) + GETYP C,(D) ; TYPE OF 1ST ARG + ADD D,[2,,2] ; GO TO NEXT + CAIN C,TFLOAT + JRST ARITH3 + CAIN C,TFIX + JRST ARITH1 + JRST WRONGT + +ARITH1: GETYP C,0(D) ; GET NEXT TYPE + CAIE C,TFIX + JRST ARITH2 ; TO FLOAT LOOP + XCT FUNC(E) ; DO IT + ADD D,[2,,2] + SOJG A,ARITH1 ; KEEP ADDING OR WHATEVER + SKIPE OVFLG + JFCL OVRFLW,OVRFLD + MOVSI A,TFIX + POPJ P, + +ARITH3: GETYP C,0(D) + MOVE 0,1(D) ; GET ARG + CAIE C,TFIX + JRST ARITH4 + PUSH P,A + JSP C,OFLOAT ; FLOAT IT + POP P,A + JRST ARITH5 +ARITH4: CAIE C,TFLOAT + JRST WRONGT + JRST ARITH5 + +ARITH2: CAIE C,TFLOAT ; FLOATER? + JRST WRONGT + PUSH P,A + JSP A,BFLOAT + POP P,A + MOVE 0,1(D) + +ARITH5: XCT FLFUNC(E) + ADD D,[2,,2] + SOJG A,ARITH3 + + SKIPE OVFLG + JFCL OVRFLW,OVRFLD + MOVSI A,TFLOAT + POPJ P, + +SWITCH: XCT COMPAR(E) ;FOR MAX & MIN TESTING + MOVE B,VALN + JRST (C) +COMPAR==.-6 + CAMLE B,VALN + CAMGE B,VALN + + + +FLSWCH: XCT FLCMPR(E) + MOVE B,O + JRST (C) +FLCMPR==.-6 + CAMLE B,O + CAMGE B,O + ;PRIMITIVES ONEP AND ZEROP + +MFUNCTION ONEP,SUBR,[1?] + MOVEI E,1 + JRST JOIN + +MFUNCTION ZEROP,SUBR,[0?] + MOVEI E, + +JOIN: ENTRY 1 + GETYP A,TYP1 + CAIN A,TFIX ;fixed ? + JRST TESTFX + CAIE A,TFLOAT ;floating ? + JRST WTYP1 + MOVE B,VAL1 + CAMN B,NUMBR(E) ;equal to correct value ? + JRST YES1 + JRST NO1 + +TESTFX: CAMN E,VAL1 ;equal to correct value ? + JRST YES1 + +NO1: MOVSI A,TFALSE + MOVEI B,0 + JRST FINIS + +YES1: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +NUMBR: 0 ;FLOATING PT ZERO + 201400,,0 ;FLOATING PT ONE + ;PRIMITIVES LESSP AND GREATERP + +MFUNCTION LEQP,SUBR,[L=?] + MOVEI E,3 + JRST ARGS + +MFUNCTION GEQP,SUBR,[G=?] + MOVEI E,2 + JRST ARGS + + +MFUNCTION LESSP,SUBR,[L?] + MOVEI E,1 + JRST ARGS + +MFUNCTION GREATERP,SUBR,[G?] + MOVEI E,0 + +ARGS: ENTRY 2 + MOVE B,VAL1 + MOVE A,TYP1 + GETYP 0,A + PUSHJ P,CMPTYP + JRST WTYP1 + MOVE D,VAL2 + MOVE C,TYP2 + GETYP 0,C + PUSHJ P,CMPTYP + JRST WTYP2 + PUSHJ P,ACOMPS + JFCL + JRST FINIS + +; COMPILERS ENTRIES TO THESE GUYS + +IRP NAME,,[CGQ,CLQ,CGEQ,CLEQ]COD,,[0,1,2,3] + +NAME: MOVEI E,COD + JRST ACOMPS +TERMIN + +ACOMPS: GETYP A,A + GETYP 0,C + CAIE 0,(A) + JRST COMPD ; COMPARING FIX AND FLOAT +TEST: CAMN B,D + JRST @TABLE4(E) + CAMG B,D + JRST @TABLE2(E) + JRST @TABLE3(E) + +CMPTYP: CAIE 0,TFIX + CAIN 0,TFLOAT + AOS (P) + POPJ P, +COMPD: EXCH B,D + CAIN A,TFLOAT + JSP A,BFLOAT + EXCH B,D + CAIN 0,TFLOAT + JSP A,BFLOAT +COMPF: JRST TEST + +MFUNCTION RANDOM,SUBR + ENTRY + HLRE A,AB + CAMGE A,[-4] ;At most two arguments to random to set seeds + JRST TMA + JRST RANDGO(A) + MOVE B,VAL2 ;Set second seed + MOVEM B,RLOW + MOVE A,VAL1 ;Set first seed + MOVEM A,RHI +RANDGO: PUSHJ P,CRAND + JRST FINIS + +CRAND: MOVE A,RHI + MOVE B,RLOW + MOVEM A,RLOW ;Update Low seed + LSHC A,-1 ;Shift both right one bit + XORB B,RHI ;Generate output and update High seed + MOVSI A,TFIX + POPJ P, + + + MFUNCTION SQRT,SUBR + PUSHJ P,ARGCHK + JUMPL B,NSQRT + PUSHJ P,ISQRT + JRST FINIS + +ISQRT: MOVE A,B + ASH B,-1 + FSC B,100 +SQ2: MOVE C,B ;NEWTON'S METHOD, SPECINER'S HACK. + FDVRM A,B + FADRM C,B + FSC B,-1 + CAME C,B + JRST SQ2 + MOVSI A,TFLOAT + POPJ P, + +MFUNCTION COS,SUBR + PUSHJ P,ARGCHK + FADR B,[1.570796326] ;COS(X)=SIN (X+PI/2) + PUSHJ P,.SIN + MOVSI A,TFLOAT + JRST FINIS + +MFUNCTION SIN,SUBR + PUSHJ P,ARGCHK + PUSHJ P,.SIN + MOVSI A,TFLOAT + JRST FINIS + +.SIN: MOVM A,B + CAMG A,[.0001] + POPJ P, ;GOSPER'S RECURSIVE SIN. + FDVR B,[-3.0] ;SIN(X)=4*SIN(X/-3)**3-3*SIN(X/-3) + PUSHJ P,.SIN + FSC A,1 + FMPR A,A + FADR A,[-3.0] + FMPRB A,B + POPJ P, + +CSQRT: PUSHJ P,CARGCH + JUMPL B,NSQRT + JRST ISQRT + +CSIN: PUSHJ P,CARGCH +CSIN1: PUSHJ P,.SIN + MOVSI A,TFLOAT + POPJ P, + +CCOS: PUSHJ P,CARGCH + FADR B,[1.570796326] + JRST CSIN1 + MFUNCTION LOG,SUBR + PUSHJ P,ARGCHK ;LEAVES ARGUMENT IN B + PUSHJ P,ILOG + JRST FINIS + +CLOG: PUSHJ P,CARGCH + +ILOG: JUMPLE B,OUTRNG + LDB D,[331100,,B] ;GRAB EXPONENT + SUBI D,201 ;REMOVE BIAS + TLZ B,777000 ;SET EXPONENT + TLO B,201000 ; TO 1 + MOVE A,B + FSBR A,RT2 + FADR B,RT2 + FDVB A,B + FMPR B,B + MOVE C,[0.434259751] + FMPR C,B + FADR C,[0.576584342] + FMPR C,B + FADR C,[0.961800762] + FMPR C,B + FADR C,[2.88539007] + FMPR C,A + FADR C,[0.5] + MOVE B,D + FSC B,233 + FADR B,C + FMPR B,[0.693147180] ;LOG E OF 2 + MOVSI A,TFLOAT + POPJ P, + +RT2: 1.41421356 + MFUNCTION ATAN,SUBR + PUSHJ P,ARGCHK + PUSHJ P,IATAN + JRST FINIS + +CATAN: PUSHJ P,CARGCH + +IATAN: PUSH P,B + MOVM D,B + CAMG D,[0.4^-8] ;SMALL ENOUGH SO ATAN(X)=X? + JRST ATAN3 ;YES + CAML D,[7.0^7] ;LARGE ENOUGH SO THAT ATAN(X)=PI/2? + JRST ATAN1 ;YES + MOVN C,[1.0] + CAMLE D,[1.0] ;IS ABS(X)<1.0? + FDVM C,D ;NO,SCALE IT DOWN + MOVE B,D + FMPR B,B + MOVE C,[1.44863154] + FADR C,B + MOVE A,[-0.264768620] + FDVM A,C + FADR C,B + FADR C,[3.31633543] + MOVE A,[-7.10676005] + FDVM A,C + FADR C,B + FADR C,[6.76213924] + MOVE B,[3.70925626] + FDVR B,C + FADR B,[0.174655439] + FMPR B,D + JUMPG D,ATAN2 ;WAS ARG SCALED? + FADR B,PI2 ;YES, ATAN(X)=PI/2-ATAN(1/X) + JRST ATAN2 +ATAN1: MOVE B,PI2 +ATAN2: SKIPGE (P) ;WAS INPUT NEGATIVE? + MOVNS B ;YES,COMPLEMENT +ATAN3: MOVSI A,TFLOAT + SUB P,[1,,1] + POPJ P, + +PI2: 1.57079632 + MFUNCTION IEXP,SUBR,[EXP] + PUSHJ P,ARGCHK ;LEAVE FLOATING POINT ARG IN B + PUSHJ P,IIEXP + JRST FINIS + +CEXP: PUSHJ P,CARGCH + +IIEXP: PUSH P,B + MOVM A,B + SETZM B + FMPR A,[0.434294481] ;LOG BASE 10 OF E + MOVE D,[1.0] + CAMG A,D + JRST RATEX + MULI A,400 + ASHC B,-243(A) + CAILE B,43 + JRST OUTRNG + CAILE B,7 + JRST EXPR2 +EXPR1: FMPR D,FLOAP1(B) + LDB A,[103300,,C] + SKIPE A + TLO A,177000 + FADR A,A +RATEX: MOVEI B,7 + SETZM C +RATEY: FADR C,COEF2-1(B) + FMPR C,A + SOJN B,RATEY + FADR C,[1.0] + FMPR C,C + FMPR D,C + MOVE B,[1.0] + SKIPL (P) ;SKIP IF INPUT NEGATIVE + SKIPN B,D + FDVR B,D + MOVSI A,TFLOAT + SUB P,[1,,1] + POPJ P, + +EXPR2: LDB E,[030300,,B] + ANDI B,7 + MOVE D,FLOAP1(E) + FMPR D,D ;TO THE 8TH POWER + FMPR D,D + FMPR D,D + JRST EXPR1 + +COEF2: 1.15129278 + 0.662730884 + 0.254393575 + 0.0729517367 + 0.0174211199 + 2.55491796^-3 + 9.3264267^-4 + +FLOAP1: 1.0 + 10.0 + 100.0 + 1000.0 + 10000.0 + 100000.0 + 1000000.0 + 10000000.0 + +;LSH AND ROT (ERB WOULD BE PLEASED) PDL 2/22/79 + +MFUNCTION %LSH,SUBR,LSH + ENTRY 2 + MOVE C,[LSH B,(A)] + JRST LSHROT + +MFUNCTION %ROT,SUBR,ROT + ENTRY 2 + MOVE C,[ROT B,(A)] +LSHROT: GETYP A,(AB) + PUSHJ P,SAT + CAIE A,S1WORD + JRST WRONGT + GETYP A,2(AB) + CAIE A,TFIX + JRST WTYP2 + MOVE A,3(AB) + MOVE B,1(AB) + XCT C + MOVE A,$TWORD + JRST FINIS + +;BITWISE BOOLEAN FUNCTIONS + +MFUNCTION %ANDB,SUBR,ANDB + ENTRY + HRREI B,-1 ;START ANDING WITH ALL ONES + MOVE D,[AND B,A] ;LOGICAL INSTRUCTION + JRST LOGFUN ;DO THE OPERATION + +MFUNCTION %ORB,SUBR,ORB + ENTRY + MOVEI B,0 + MOVE D,[IOR B,A] + JRST LOGFUN + +MFUNCTION %XORB,SUBR,XORB + ENTRY + MOVEI B,0 + MOVE D,[XOR B,A] + JRST LOGFUN + +MFUNCTION %EQVB,SUBR,EQVB + ENTRY + HRREI B,-1 + MOVE D,[EQV B,A] + +LOGFUN: JUMPGE AB,ZROARG +LOGTYP: GETYP A,(AB) ;GRAB THE TYPE + PUSHJ P,SAT ;STORAGE ALLOCATION TYPE + CAIE A,S1WORD + JRST WRONGT ;WRONG TYPE...LOSE + MOVE A,1(AB) ;LOAD ARG INTO A + XCT D ;DO THE LOGICAL OPERATION + AOBJP AB,.+2 ;ADD ONE TO BOTH HALVES + AOBJN AB,LOGTYP ;ADD AGAIN AND LOOP IF NEEDED + +ZROARG: MOVE A,$TWORD + JRST FINIS + REPEAT 0,[ +;routine to sort lists or vectors of either fixed point or floating numbers +;the components are interchanged repeatedly to acheive the sort +;first arg: the structure to be sorted +;if no second arg sort in descending order +;second arg: if false then sort in ascending order +; else sort in descending order + +MFUNCTION SORT,SUBR + ENTRY + HLRZ A,AB + CAIGE A,-4 ;Only two arguments allowed + JRST TMA + MOVE O,DESCEND ;Set up "O" to test for descending order as default condition + CAIE A,-4 ;Optional second argument? + JRST .+4 + GETYP B,TYP2 ;See if it is other than false + CAIN B,TFALSE + MOVE O,ASCEND ;Set up "O" to test for ascending order + GETYP A,TYP1 ;CHECK TYPE OF FIRST ARGUMENT + CAIN A,TLIST + JRST LSORT + CAIN A,TVEC + JRST VSORT + JRST WTYP1 + + + + +GOBACK: MOVE A,TYP1 ;RETURN THE SORTED ARGUMENT AS VALUE + MOVE B,VAL1 + JRST FINIS + +DESCEND: CAMG C,(A)+1 +ASCEND: CAML C,(A)+1 + ;ROUTINE TO SORT LISTS IN NUMERICAL ORDER + +LSORT: MOVE A,VAL1 + JUMPE A,GOBACK ;EMPTY LIST? + HLRZ B,(A) ;TYPE OF FIRST COMPONENT + CAIE B,TFIX + CAIN B,TFLOAT + SKIPA + JRST WRONGT + MOVEI E,0 ;FOR COUNT OF LENGTH OF LIST +LCOUNT: JUMPE A,LLSORT ;REACHED END OF LIST? + MOVE A,(A) ;NEXT COMPONENT + TLZ A,(B) ;SAME TYPE AS FIRST COMPONENT? + TLNE A,-1 + JRST WRONGT + AOJA E,LCOUNT ;INCREMENT COUNT AND CONTINUE + +LLSORT: SOJE E,GOBACK ;FINISHED WITH SORTING? + HRRZ A,VAL1 ;START THIS LOOP OF SORTING AT THE BEGINNING + MOVEM E,(P)+1 ;Save the iteration depth +CLSORT: HRRZ B,(A) ;NEXT COMPONENT + MOVE C,(B)+1 ;ITS VALUE + XCT O ;ARE THESE TWO COMPONENTS IN ORDER? + JRST .+4 + MOVE D,(A)+1 ;INTERCHANGE THEM + MOVEM D,(B)+1 + MOVEM C,(A)+1 + MOVE A,B ;MAKE THE COMPONENT IN "B" THE CURRENT ONE + SOJG E,CLSORT + MOVE E,(P)+1 ;Restore the iteration depth + JRST LLSORT + ;ROUTINE TO SORT VECTORS IN NUMERICAL ORDER + +VSORT: HLRE D,VAL1 ;GET COUNT FIELD OF VECTOR + IDIV D,[-2] ;LENGTH + JUMPE D,GOBACK ;EMPTY VECTOR? + MOVE E,D ;SAVE LENGTH IN "E" + HRRZ A,VAL1 ;POINTER TO VECTOR + MOVE B,(A) ;TYPE OF FIRST COMPONENT + CAME B,$TFIX + CAMN B,$TFLOAT + SKIPA + JRST WRONGT + SOJLE D,GOBACK ;IF ONLY ONE COMPONENT THEN FINISHED +VCOUNT: ADDI A,2 ;CHECK NEXT COMPONENT + CAME B,(A) ;SAME TYPE AS FIRST COMPONENT? + JRST WRONGT + SOJG D,VCOUNT ;CONTINUE WITH NEXT COMPONENT + +VVSORT: SOJE E,GOBACK ;FINISHED SORTING? + HRRZ A,VAL1 ;START THIS LOOP OF SORTING AT THE BEGINNING + MOVEM E,(P)+1 ;Save the iteration depth +CVSORT: MOVE C,(A)+3 ;VALUE OF NEXT COMPONENT + XCT O ;ARE THESE TWO COMPONENTS IN ORDER? + JRST .+4 + MOVE D,(A)+1 ;INTERCHANGE THEM + MOVEM D,(A)+3 + MOVEM C,(A)+1 + ADDI A,2 ;UPDATE THE CURRENT COMPONENT + SOJG E,CVSORT + MOVE E,(P)+1 ;Restore the iteration depth + JRST VVSORT +] + +MFUNCTION OVERFLOW,SUBR + + ENTRY + + MOVEI E,OVFLG + JRST FLGSET + + +MFUNCTION TIME,SUBR + ENTRY + PUSHJ P,CTIME + JRST FINIS + +IMPURE + +RHI: 267762113337 +RLOW: 155256071112 +OVFLG: -1 +PURE + + +END + \ No newline at end of file diff --git a//assem.all.7 b//assem.all.7 new file mode 100644 index 0000000..c155adb --- /dev/null +++ b//assem.all.7 @@ -0,0 +1,115 @@ +LOGIN CLRt +CONN INT: +MIDAS +AGC BIN_AGC MID +RESET MIDAS +MIDAS +AGCMRK BIN_AGCMRK MID +RESET MIDAS +MIDAS +AMSGC BIN_AMSGC MID +RESET MIDAS +MIDAS +ARITH BIN_ARITH MID +RESET MIDAS +MIDAS +ATOMHK BIN_ATOMHK MID +RESET MIDAS +MIDAS +BUFMOD BIN_BUFMOD MID +RESET MIDAS +MIDAS +CORE BIN_CORE MID +RESET MIDAS +MIDAS +CREATE BIN_CREATE MID +RESET MIDAS +MIDAS +DECL BIN_DECL MID +RESET MIDAS +MIDAS +EVAL BIN_EVAL MID +RESET MIDAS +MIDAS +FOPEN BIN_FOPEN MID +RESET MIDAS +MIDAS +GCHACK BIN_GCHACK MID +RESET MIDAS +MIDAS +INITM BIN_INITM MID +RESET MIDAS +MIDAS +INTERR BIN_INTERR MID +RESET MIDAS +MIDAS +IPC BIN_IPC MID +RESET MIDAS +MIDAS +LDGC BIN_LDGC MID +RESET MIDAS +MIDAS +MAIN BIN_MAIN MID +RESET MIDAS +MIDAS +MAPPUR BIN_MAPPUR MID +RESET MIDAS +MIDAS +MAPS BIN_MAPS MID +RESET MIDAS +MIDAS +MUDEX BIN_MUDEX MID +RESET MIDAS +MIDAS +MUDITS BIN_MUDITS MID +RESET MIDAS +MIDAS +MUDSQU BIN_MUDSQU MID +RESET MIDAS +MIDAS +NFREE BIN_NFREE MID +RESET MIDAS +MIDAS +PRIMIT BIN_PRIMIT MID +RESET MIDAS +MIDAS +PRINT BIN_PRINT MID +RESET MIDAS +MIDAS +PURE BIN_PURE MID +RESET MIDAS +MIDAS +PUTGET BIN_PUTGET MID +RESET MIDAS +MIDAS +PXCORE BIN_PXCORE MID +RESET MIDAS +MIDAS +READCH BIN_READCH MID +RESET MIDAS +MIDAS +READER BIN_READER MID +RESET MIDAS +MIDAS +SAVE BIN_SAVE MID +RESET MIDAS +MIDAS +SPECS BIN_SPECS MID +RESET MIDAS +MIDAS +STBUIL BIN_STBUIL MID +RESET MIDAS +MIDAS +STENEX BIN_STENEX MID +RESET MIDAS +MIDAS +TMUDV BIN_TMUDV MID +RESET MIDAS +MIDAS +TXPURE BIN_TXPURE MID +RESET MIDAS +MIDAS +UTILIT BIN_UTILIT MID +RESET MIDAS +MIDAS +UUOH BIN_UUOH MID diff --git a//atomhk.bin.6 b//atomhk.bin.6 new file mode 100644 index 0000000000000000000000000000000000000000..dd396385b51844ace8e63d9f9996b0be6b9e040d GIT binary patch literal 26260 zcmd6Q30K=X(6(#`2w@9h3roO2*!P|8P8ujsC_ANrLZFoGcA>ppC|9RKyKPI#a)f}d?8LtH6a>Aa@*ub9qJ^)a_$pz=uV9*RcD>A%pj}O=iT+{3FQqc z&Ejo+<*UAj%&5kl>V=pZH$mqp|98k@S;=Vo0{<%2)7~?@D^HDvRe!=_nftW+%Wgx1 zOEk1{ZrDVdn*KSDsi3Kpmn}SGqtM}H|NZ{jF^OtLY+)7zQ+=otDYr>?Yn(`v=<7ymS<(zaaSfUl- zzUU;NbxD;#|Cg;Y6-1Q??``Gj&yq=DNUAh=CTk{a(UG#nLRSV&jinWFxAPRws6x>d ziRg-{_$$pC&yG|!Hg<#oVx#_v3I-`KBx%cx8d$7eKnuUpA&^x1{PT12LIo`d$wbl6 zpfcXcxJCvsW>cR6mOZ#MwklO-ddHQD_xwE9Ty}4T$)1WctMbR>OTU{>mp zyS<5}Pe1=c`(zgh+W!P(n<))iEOSBgpJ?Ah?f+8M?Qmj9p6+^FhoZO$1k5Jnqzu}( za<;unX?-ya&zv-Y2t4%(N~)Tau_q+@(Y8$5%F}MRV-GKy3!mkRCUJ5?_4t%cTVAmbiUExy%=TT~diSU67qTjud^C$(o zNQBS(`-M*t;d4UgQDk>H3P;f`7Xs-z=kcrcAi3#^>2})hvDlq!3)KG7Uu(Z7t$oj> zqy272`#p~KQP0-??{ALwujAmAJFL5E-%st^VFtAy{TuCrT_kFM@qV>mO6`B3*h`h^ zJ%Qrkz3mIMU);S0v*$&8NxlR&wf)hVQ?gec-!6>3a0PZd9Q0eHm5qaWm*^h@8-r{V zqblx@u{Denn-)G^Lop z;bimtMjyfjJEkeM985+WOrl;2lMl!NW14F@c$6WHJH#}$-cm75sU_T-6{`7#Ew!7u zB|A7FFrSFj?k%P%Coqo~RF*4UD^?piW+Bc@s;3hd6Spe#sA0r1IqPw@Dznkqr6pt@ z3^x1bHom)}yB#`X7ARjqM5aFe6m}bAqae+TIx5|KmWm#3hE7b-NR;!#G&(C+EtX}W zv%2$2*zI=7x@!8>%EZ#r>cYx$7DOvo1)@)^V`Negtz1b%v~o2KQP#5|`pdN^xZnHfVcGrr)QV^}=Y5|(AiR8Ea1w_d+5=3{@ala4^5~A;^fS_vnUl6Sjh}Ldh z9M?J!t+FB7zVKW0TN|D>3m&?nyA?z$*Da1W8y0OY(LXy-vQd!cMIBW>_5KY+?Ip6v z8F9O*6x>(k(KWnOUWKUBCHYps=ls$#bJ-9*5{O31KN(2}qK6Jdj~s}iUJ9a?1JUc) z2xN%lE?!i)Peb&Od@Hl=%g5!vfhc%JB19|h7oxR<=&nMXTMLNlSG;JoK(r>gHR?jN zW-R7cvM6qDY{J?g63$B|hxUYFRg7gMguTeJhYCSJ_az>fVO&_*E4PC2x?_DW!A326 zg%`_9uIz7z@edYhWn;X|CHhBSrcH-asu879d75UV0nU|VHJeA&Ewx(ZvTOCc~jKmT%df!QqBR+S2DA6M-t z$2C{^)3B{7O~aP;Y}g)8kqyH3S~iX|L~<9{3im14R-tF4hPs{oHCuEyf-QMQqUb(~ z=2k3XBNxpKZzq$yEijap zDigHV%unpu+d!sgJ+;R}dh^{|*!Nj%HavFSE-Em>{7Oi9?p6W z+JwJR%RtxdP`_Vv*W8;oB^USg;UK^2*Zms~0TFw(}OTbL0K)_*+g-9@=mC zCF{LIuEnu))PsnzIe%P8n~{3gv9ack?KZ0fGh=6VUU(rZ3Y#m3((eto)~diR5>5Qg z{hIhZO}v*7okxfMT-S7)^kg!**i>TMuWi%4O(-+rtPg0Q>e$34Lg%hh%e7Bm{e-zf zu-m|uYD(bJ%u6e)EH>dHReJf<%*7?Hqs%%+ZaAvc{)P{?k|Lc(GT8_JqAezXU8}d^ z_Y?BBsVggB_MtZ&REz`D3%}9Z4u*!OlsYu&9|jjdg(kGqiLxWIwiVamf~wk;aj2Vk zB{6^pIV0%u8!!84r1TBFU1_|HOJ(MEgf%y86vv~ZvK>!Kl`*+}y*(rHJ3>sVOm?{= zRK_ekmSxpS0vyEI$50cBOpbgrfv3V%KNu1x^OXZsgHcrG5Z$-3C6Se{st1%I{+dLS<7(Qb5QB^@DGjlX0I zx}XP+3qn2H1syGrdkHnJV<@_Dy-?S9i?e@G?IQg z;yO3x`gqY~@|W2j1hlYB;4)P@WnNNltGUdtNPs`h8}KW?ylh$o0b`#b&P8T814ER^ zL*fm~+D=~baxoH9+JqRf>?Aq7WJF6S(+ob)(N^!IE0y2K{ChOp5=|_O; zfdq0at1(J~m!ssb!VmsPR4XDWP25QBR(nk~8G=WG+cbS(h%W8$N*^0|FAgt;8jDfn z7AammGd@9^-ZDe zu%)z7(}$c$Enp%yU@EPgq8p~HDt@#ytnHD%K3!M3C`IQ3L5Y4v<5R54k+|9=L|lz#a2{iz^sW7g(!yx-2 zh9>gB4fvi;*DQW>J<{zw|D45Mv%T#gCnctQ^Gd)MS(%^fiOeodL}G7xR;DJFCX~u{ zxpU%jx1;ad@WL_`_07H{F}mD2$K|44%H@_hQQvjE^tc1OW7MZjaCVs`D~$T~KiL!2 z%@%fG7m40>fX(jB+iDZ=wwL2Lx}i;2?9x?t|Joz{sVj}!se8vJ>Kqfod(&Y3AJsko zsweWQ$KHQRt36xYJEHFC^_nxwQFp>o_l~1()U(xn_}WqTb-Yx&1N=|aouCXw-4d~f)W$9SIc^7M8H z+p|FHibJW*(CVLdt#ZglQHmF+?Be+sIcjmkqh?im>{e7(BPxTj*L}BGmgU^ad{;tA zw@cPlOA~YRYw&7U{94_20lHN&^0goxO4fZ#1HJBh8tANN1N}`M*Tj}ys^j5Z-{pCj0Cj5%fDZ=FA(iLoXQt;b6QtCI^>==)67=f4&wOP zF%i331@XP_w^D1cONl2IJeejzf*2s9OVL8zw7rrn{5 zVC+)D83}RNEIwi>?cWVl(oD-9rS@Gm2c&EfWg57Hkyxz4$jCGi2!A*mwf4#158b2r z5k{fy@C-%Akdu^ulZq}6o+Om^Qv#*NCJ4d~j~IBZ&!Aa7A|Vf3oP{0?%NC|~!NG`Q zq%PU-DfSrv8oiYla}u{)xbJZ%!6&~@fa>} z&AOL^K13}WK7Kp!kHJ$PT~^NQU^>PQWjG(3iVTzGY1*ypHDlaPkim#EM@}m;>2qXN zG-!?EWyI;|yStvS3guhmFUxlZuv@XfQaR0nj@%TRn2fB>atWRlAB6J7ZEpN{rkQEC z8S=hlJA{Lw{IuI-Jq!Vxfa{60+q{;8uXl5srn?EKSHLxgykv#(L1O1GJSN#ig2&wb zey<)=uY||EI8fDoz0!|8sIVwrHl`^!g0NGu&!&M)=waJRjjn4jd+ zYz&21galpf2ID7>2&5b;ukIy_38at%BveiTsfn7Ade^a*VIOx4H1&}1LRJJwlYavw zdu#-f;7{GxE{+}|kP=u|=qYJ9?+vi7(Dv`DeNJUpwf{<0vk*zYM*As`kw(Gt!o>6G z$?4~jmFf9cXyQUZJPwsSAP^|(>(V3y%ca=+9S96K5I{W}0yyU(7k?=zPM_IqIc!-sPD6bqtOCcRH^p z{$esZ>Rc9zH`Tc;Fhu8ac=P^sZtC^L!YW@L)HIlH61dYFUQgvUW*k|+o#&sjNIBc{ zk7daDPb)s1Z1_^VDD_WAJ+>ib*>aSg9 zm#nLZ#4D(KBdB{**HY`8!40iDsC(m}4)tu*t$iT}T(u-%}{{1cD!-at;)oSV){4zaDyz(!lEiA~k= z(3IYkUc}iC*0Gq)b~Ipn3tVd(wJ)b_#OnB=Amg5Z+qOHA_PHM|5|layoeZkIw};Z3&p@6nwHs|Nb8JYITIv0o|c4!f1%l{40I{ZTC3acW36<%Jtxv+=dI z-YOPK>v_!Erkd%2t^@F?KN8~%n40c)o;KTWgJ1@#85jF)5Z<`!Pfa=L2`UkJB~&xD zxn-X&;+XAM8sRXgiq)QM^jlGE(CJa^eiSRd2v;%IYfmUWwq=$iKew7NHEg(~+S(?x z(y%^+5`A*N*9v5O#d$mHIk7lq{LUhptS&bX^7uc{r)hA&>*5hmw z8gu3-F`)-?UbJTZ>B|F7EV5F6D7U!LUqZ@$C3}Y^<{9O_@HG|A_G~9$N6oy@$|5q8 ztaEd(F|0}x>*2O!Qo~c*gv1PL1~+z5p!B8Q*re~S-&WOoEE3Cx-tP>Z|H%w=vf)ed zg1Am^e}t2sCibar6xVU%4~e=w6I}v-%@r2QvUn*xb|(=#u5-F%T@{_3fBrJd0-7tt z0@nSA&tAlb;5Yc0-CW>LTU``pZ#M? z?M4uj?GQL%~O;}-O>`$%{b%-;Nu)d5-zc*Z8a#%%`;kvDNO;ew?Q+zKr)uuB76{adXX_K4LO-wvV?On6H$5wl>kwaZ z9S0e&_V0?EO(N$phePDNkzKHxA_wdu5jk>@Pu-gvc}wJ&5WD_X^UJrxQ`9srf{oDJ zJVrolbisMd0R33gUF4s|P@-=Sryyn#*ubHM@T zq619SO99jCxU}oo$T(Ae8(_kNMaZtLy!0d|#)if6_|9KVa^M+>=zBo$ zX5%2&#esNC*09s+tGUR^^C?V1*&*>S!NKzBSIp089Gp5h_~qaL^-?(SJKo|t4s>@| zxA7Kc1`ZC0gHvIj)0p`;H~_my#6iye;^2Tdz(>kK{lH?Eu9Epu<*rH&7uiHJU#b** z{o{GPSJSihyVUu~)a#VxY;}i=MBTA3Bc)g+*vB)&g=uw%i_+?5JzL$+<;;_okNIi$KP6n4-KPq3Tfk?kyWt>Y98_luj5 zZRLe)_Ac2V-j@C1T$Gt!g^yXzn4!new@lQX(qI}ue9;kTw^_=|uTg-Xa^q|k0se_r< zZ1GLD;P@%sF%KTg9z~L6x^uztZPb)$%+Hf7!;?zCkYnQD-uR~q51lX9^ozt{UP30m zvkw?0dIPD4Dw({L(~Bs9QnpAwebJgjeO>eTsWg0anBdb()?sib$DxrmwBfyqwJjG{ zxAKl*zeT!P-m&1bOZ1PyorkBg3wdFCbr5>_;BQ_^g+(WVL^)r~9q@3YMN-+kY>B6K ze;CH?l6BSW^sARD%TtFN#dHfBAJ1V^!k)3irenH|j_IOa%5-H4hi!S|`{NX)xFgfL5a@xTp z>ZLF#!JT08It~W^J52J_Uk8+dL`*jRMU=r|ArX`EZc*LW-iX0df9E*$cWP9gm|75D zd*T~0bZt~}LHUmRYnlx%6LG|VsWiGTV~6z`kpn<@+<1sbMe)s<4X#?jOFJ;BLSKVh zgT2hfb3q`26Uj*i1i4bBkDspg;&M4^p(8DUdgc_!$kUpK?_WnyVl*Zzllwf(ZNPg^ z;YS{yqOuc5;JYkP=4sqdRh_t)P3`#PxE&Wc``d>d9UUJ$8eRO57pDW2%4Z7$C@adJ;=}j1%6Fo>AVSh)(W6u13%jl3nE0ZK}+Z{*08f?{gSl-n(`<49lz`XpP zO?-396`GMp`GG(1VwxzE1G|H%W3|R02d&mQ-T_k?LH02U@_x0%wS8Quz}O$khhp+6 zoe&UVv+~166Z_u$`XVVOe&hVn8yO+a{u+I908>s(d*fBlMShRSf?pUH*8Ij2M|JW83Zm|SCld5<(38U!E^(@M0F?*H&?Lh$`CWqn3s0ZB2f-m& zBPQpIg+Gkkm|%;!Z5{Bb3az!QQGPG@-KT0w*i=9YF7k+yBpmUD8^463j#MvSPj!Z& zyv8tGf_$_lNxpFar*CV_Q+7^4%ifWH0qieC__(?8YsNY}ZWkM?$`;sl|(5PdYJn1fB9j zh_->D%Aw@&1))-5d|ZGFDWIaxTTO24k~jX#NUVY5{r+Osvrhe_T8s?Wg{PCY4D z|MyTR=avkP1!?p~ua7@t#-}0t5c?McIc>`~RyuC7Y%Z^1OKHuQbAeh|#h<_hY*?tA z1+M0nOpO0OwF<=iN}v4{dU1tGoWO+_#axR`Or)CGProC~sFu!Oo{ZlRm$vfYNzJd_ zj1~bBl?OeYzjnv|4+;H$ZhkkEQ0?<*UAv4oJlygQubkmaE#BW)LImGATM$?J`BW)? zejT^TgCvd;65DP{;>Q<~DsqC|8U%Occwo#05Q1@iWOPJV%4bcf9GIG`5iJ}$^;XMX z=i0|9J7XPBbc^*ovCZQ5m?*I&6Q~&}Cl}fTS{RR!Ge#;NmOQptwijI)%6pES@|SJ= z^Jbf6`oz~@?>fso6;GS1`PA6if3Wp=K=`Z3-+ftvGCdOL`uCVi8U3KV#n;k{oc3(u zLm;qwszfT6f#vJ)kw8q1-t@GS5aBv?$cEIoVInyc|Njf%|u~CHA4=Za9J5V zq0T+P#(B;La@u$-w(=v%hZ@VunHh#wqY37|fU+SY8m_=cb%^+tUQ=$JFA5rS*aGJa z@UgJ-w9tCoKmJSji>?IZ*Q+!Ym~7weK|M8B*1i%KndX!)&u?2Sdq*m7kkM;MWrDd9 zqH~H*e@3^f?KxP1t4|h+w13OqTnw1VspfQBt;lKXWp6Uxxw77!5!v~?Ku%<@B~B|p z?jH+(K*Sogs-mPqoND1fL-9E!Zd6YU|HwPzQx%xnc-)A;`dP(8e}RRZb_QLJi0ngU zJMEX0kQOihGB7^Q+(h7I^)buTi}Lowg^Xhh-0!kT`$;SNj+`E5y$%*mI=Pv)^2asj z!XH}50#ZASwfhzd&;Yy)ZpP}__MrT2^_kerr$FdiuLNWd1F>=Y*J{Sf-p=MR1~>ea z^CA1#Arfhq>L4(Cyh?M*cfz21f*y*&1|E`;7-$>F=s_rdJ-mc9wNH}8Dp0%h(GnMY^&|;E6W}_eyywgZB5H5pU#g>pEeFCt6!<- z!520aMJ>p99@2p}Zo^zl$UE_HF<{bKJ`~KaU!4FieqfA`0{P!I{j@L?0`Gaj4 LDcJxYE9rj#KvzS6 literal 0 HcmV?d00001 diff --git a//atomhk.bin.7 b//atomhk.bin.7 new file mode 100644 index 0000000000000000000000000000000000000000..9925a39cd8c52ed2b8e260f7dbd540a0ec297551 GIT binary patch literal 26280 zcmd6Q30K=X(6(#`2w@9h3roO2pzK@Ox+kc76FcFh z@1bxx-=}kGWLX-GW}X?1WI0vUKb89R@8Lpy;n|*&lvmU_m&z6PKeuzaMJuPKWIaXi zTkKp;(c2wM%5sE&uk6&m^%MlX!}1`v=(KBJaz;_{Mk?nkd?7_j`NHRRPWyF=jBl(z zb?aL@uyguR(^<1uRZpdu^nI*NJt$oJ)MaOj-Y*SrAnQ>D5Beg#EF35*Uan-BGK)@I zC0EE%MiK>kGfPs%Eb>klSg4_^BJJzy337v~xN`m@bLdWuDphBlug)N=)Th0T>Ivly zD$U|;edWvE$IPh4-Ri}d8Z|-ZIRAIZVp+*>+amue)!o)TxF=7IhBbe}VwwB2>+@bi zgG)5DdT!W6o0|SPkEx)kl$R|$WTVjG<>1}H`U#0@MQmZQic7TV>65OQOSFvrvWDu~ z2z;t{c=>Fx%xy+qid7IYLzf(Ln^JCJ@P4b<~1H9Jss(MC3;-gRvFT<$}stu za9?y9&^o0`pzrf`nF^vxg!i`c^k>PWFeFtPJd-sOw&+ONVxcR8rpD5WxZ8P(XH=o+ zibQn9RQ#1@jc3Oy8ymaA0I^X&rh-8V3`yEDqxzSs7tzA6bO1WG+=2$bfeA;5Yz1kT^5A#g1R-`!!|1_Gv15IT}RDljYc z$ldNYqrBu`g8t`DQQ2n5U~k>k@F}8 zyGVr3yZePt5#e)6=TT&LISfb9B^LteI_L4L^)R{Ris^RR@3z>TYYWu=@?UGeJFR`s zrK9~WNBiB5_EFE){_n4j_OIjMr8}&NGlr$3og+=1~vxS zC`j|7j&tKDCANrf6xfvZv0D-GOA#@(6|q>B&C9r8(yK6`Nnqo4$+~KJVPREe#Wbau zz~N-`{6;Ur1v{oGwH!=F9898K3X_k>0b`nLIe3yGjXT6Nw%$@PO{pc^n-!}0g)Oz4 zxg|R|Auz{8YWEh?loOc83@Xc&t`)0I9kUQ;Ce_`6i-}tmdeSgtnVj`FTb0@9?9>u6 z4+fik^PAsX(cKQ6F$jaq;L@QU*5UpHGLzMMwi2ie)hUm3y zw7PP>joWNXh26CxuoOfqxmtjxYa;m%{sN-p84030ZoglM1_{x3R6tNQ{V#}C2t;eQ zFHUM5h*sGUZCm^;`mGI5n+1j(h(GqV^J5 z5_aa;B#Slg}H2q9t%Vx1 zYy>hyau+Wu+@~RWM81_-_xZ!h-#`>RBN3t%_Y2WlLUd0d&aDMR^($VqS|D1J+#Yrz zS~C*!D_ImbH#T8y5DDiclMnZWVO5M}B!s=hvd0QRK-VQ6m|SSH( zENOkR55nbeeWwZjI`I!Tqo~-nt5@UBP8}6Fl}8x}yA^D!pl+lrs05Q4I{H)e;2|%C z4nv2Pq2Kei>~92HOfyW7{Sj70rogt!j`*^9`FIt!PM1PpZed||ZIRh5*jAMaY@b%` zD#tZf`O~niDow+d^=#OlOpy)3_F6VhGDLD0*b4V4*jAxuq=vfPgLPYUH-asBMxy9G zi0JMOwjG4+imEcIArux%wohl$Sin%U}OnIF4*<8-;$iIIzDhIf)l-WC{2 zOO*-QYZfN#gh7CrqBQLXoFyvQxTB52IL3_)&%XPsGT%N9|Sd!O$gZ}0q|{48Z60&4@&;;wN##>F`3M4^(s zFEbaFcPHTw*mfaQoG6W&g~*zdeTX|-@jzDzzdf}{+r|!09EIJJ}d`m^Z|Im3hm=W0#6$^{Hv$RG2LBfBpSiT+n7+ z^mB)63%Bz*Enw=Z&xwnjqnOGX<@0oUxi&Y~y|TJI{qhBivhBP@?A&;_H~NOtlZW;j zo@Kqa$hA0jj(QL=Hs?;+VMWTtn zzF!kxpo#Yoq6_HIpX-`#lb%c_mzqj!`?YPlrwL^yob@3MRGpaEMCjO4YNdAkhxi<(T(xq!NaI& z5Af8k!m_v*W#$xe0W?#T#=&4rsk2QVSlWyh?|xUog!%zXDNS&wD$+y|gR+QN^->F@ zcM|sn?Hnq@25Yx}4>pkI?}HEKaJy?7w=?@Ti?p(*_g5~_KSsy~*(gZ!qK?{+t0MM% zd9zRhBSxYz$u!GVVAUgwW!bz;UI{haE?E~F6)O|Vvf$5lL65`*J=u${uBId8s?k}t zpbL8BxFFQCUC{9&xtCDmIyRyiBDq7TVJj~kYS$lr|woEIUaKFB#Di$~1!ybhOnw=t|{17z`E>z{m_pk;yvvS^5#+ zx<7#&%W900;N>v+tMG$A64i=GN)tCyyWLh(O@`o+;5JPk7@|u%y3)rc-iyPFp~g}a zxh2b9Xlo(1NOsV9EJaaf`aor4Msg^l0-o9A`9RV}3=hP8$$~r?FPVEr{+ghh0Oo)c z2ggH`!Bkvluhi+Thb^xx@U;nX^*fv}IHzb`<6c_PlsH=L0V5O)5M8K^_xm7r|1SLtBUU}4eR^luUFTVE=tk)Kv1Gz6(Z*z5sAzT6rwI2 zIr0mqy#T55JLP9w$Kdr&c#REz47%H0{3}IsuaxRQFY^6)dlu1C6^=byLOYqqx?;H1QqZ(a%bBC8AY-I2NFiAd~q_v+Nd@`O^^ zE_YsB?oRaG1H7slOS#-KC+fS7mu`1}cZ~Y93C=EaWQ9@R!AE>|n(yi(R_v?puGNkGs;iow|2zqRufPyf+Qj|54ow zFS{czyY2m_wA!=Py({XT-l#dV9Cargb?-XrMm<~IN3R@pU&l+eJHY=$-3iK2)Gg8a zO($2di$ryY?pNKDRQHIgUeqQ}J^2B%cKbYs`@7mCorla7Ud|Pgiy&tl(DfBNxe`9r z#K#6yM6aW(U!bF%H#xtVlkie>bN;Sz+|n%_iyJ|i{!pwtG*q1TfL$(@?i$ZCUY_0# zVfz+nU2!P28Cw0*u2l}%C`$1Hm0djlEJrPFc+{+FpWTYeYD8r)_PTEt%d(tXneR#{ z>2}GwYI$OQVI5xWieIbyCP23;hQ1V}L&>_YX`t7AO9P$tY@olcBO44QuVo`QLnLb}8|s>4cYMiF{>pcHUrRRWm(Qmq2svl@nRY14asBJ(z!CIMZS- zq`Z$=6`_WOnVbaPu%oiUx1-TH^0(y=djk@_?Z>e+)v$Ea&K@3N-$>SUL#;|n^i5%A zM_awV$AeX`#A^(Nu!RH&_&t{H@7Pz`o@~}^O>NlW;1Sy{vNw&LmyM7Qa*)Sx_0kPj zm5B#eBB+bq>Mt+I-?8%Km#Ql}a#&hwXJ!*R?{89C4~c%}pkIg#G6GEnUJ$D3vT1i@ zA{e`ra7IELHj58gO8a*cl{C|`N2z_2%>gM}LYW5cU?di+FfuYt1j6snhOGng_g(jB zeuPnIJ2*qpG2|rW-=w0;gRz9ten_Cy*aSh?;SmF`jTtnnMbgJ@O!Aum~Be301v3y(>5k>D}+ zzTK*nu$Rhb{yzKG4nxue)8g`!7Xe5@7D;Ji#dAQqNPAp9F zX*PyJEJA{=_JZ-#Cj?Rsl~*^*Vgf1T011^-Kx(39q~3L`W!T3Z15G_7ypRszT~r$KRAY=>G%) zeKJ=15?LeOF#6)KkO%>JOM8D1s3!z=2!VQwUAhk7KY>7My_&hS3_MoBBX))ToGTEJ zodm2eW7Ct9*hYA{ngT+G;;C~);xPL&Z%@7)?-z59IXa(kbdGu{op(BBe;q?Z|DDe3 ziNBbPjyjix;!Slf3k=b@9NxTtott`nv9QXQ2Q>}m>jdufhF4R0jTuMQZ|C`^EK<() z{3981{?m$2CmX&LFG~H>UXN`^S+?BhENBJm39UJL48*R|9-XK+Is4(eVzs6#y)b?cwW0T+AMa?qS1jXNy%Y`vuxdm+r| zNR6#c-oH768v@TrbT=&`wR@X!8t87e8EiKwGyl}%yf=`OHRq@r5ADbgAFXEG$pGxcj1HsWSMqlGgw~Ui%$&Y&o1&nfh2u+X!X<5PZuw@ zGs!KB)UwSW6NG;<$sF=hJ3}YLgM`_Yjc|T;Fu)prA%_jG0E#VC~-x6o5>$aj<9oEd1;d* zcCm7O@*|LEOYKIR%N!dLrB-^sCOJ%#TwfFmcbpp1O?lzQ*KB;P zt+$GW(t4iqwy9>izw;1$>QBTt1E!|?ou|$A+aQ>MYR1KW8-zFR`nV}4JwYWRuY_u* zwzlolMI5vJN+TQwRk7OB%|0uN4LUuF-H&3$7vU<#dTj}%$F|LqriKldR9oAG zRvR`RqC}rO=&=GBUvb{fdQL6Sx?(+YwIr9LKlMi`J{O3Ds+96JkBvgw}qN z4bE!UvT^nwnUHXwG9fx_q|oQ){5e~6H!>mej06+fy%5pe+pNY7`wMK?|I{a8Le|r4 z6B=>mC^4Z&a$dA%VSM(G6N{|WAImLn^jS#RuVnAg#5|+i7rv&#*`A#Q?5LR+T3JM9 zk_~R|HHKAbVk7(@nbh#qHX$*Cnt{zd6exYUCpPK3>$g?)9*e}Xq4zsO=YKK-oox70 zydbXA+n(U0r-^;48^v|p_(P&D&qSBNUvq`UvMgQ-Puxkwj_aH*Syx5p7M{;$SwM4z zSipw=qza#-+ZNDVp0W8{Dqa4iRi8Pd2*TqlgDET9=HC8Wl{!P!5y z)NW(}zqHP1;C~U>yKgY z!EVN9P`7f@&FvP)n~jKdL4@p2B1+)%bo#^R&oCq90(XZv`of%!_=XKSN<`fI6d#?TD(v=3dw zP-xRY?az#*tV4Xs zbsS{8+P^Duwuqdk91fB5T6V#1iX5gVx;lQ#$>xu_?<`Vtmp+}u;_)@&!EbE6k z-*?+n-)MeomTpDF<6@lD*3vb+^jrz^+%Cztns^zLDeg*`*SsXaoKQb=@CG^s%tZ&7 zOAatmF9l4m7#kMLqq~1K$$@7iqO<#c{n`%EiGwje z^&Qn`mZm2;bk3F1itE?JOO4P=5vPZ7el8$oaef~F&!unKJkxz`2KGXC-EM1sXOUp` z#8>mz?(3c7zVN;xg_3;-CGQ-RpdLnq7jrR*$HjeJ$3bO=;oKq=GBYN=eHz3*2Py7r z#I~)QML}Q}i2$j-Ux4frAk}nV`znA%+A?0*rYAn+uJK{p?tc4+k2AqKS75huU%xC4 zH5&)HE)K+FvWA`3Ud~5WpHE>D$_|Nt2@Y0%e!={l#=%bq2frK~pk4|Ge#cu}$ARt+ z>o(rP%)r4Raqv^v=QL*i4GzFA5^<1ozc@G~4)Bq3P(QTTrK@DVRJp5?!$mgH%$F(! zU;cPr@8$HI{VsK3GW9xTC0pI$B2jnj^H3>P3HI^KaA8{A;i9yZUF$eS!~NnW zWLtURn!Qsth<9YaI2UE6SK(upHl=?wdE8i;N1M*`Y>_6A-luaz4wf+Sf!hx5tGXCj9Sd=e2+x->eU(U(jzr~z)O%M94nL3<# z#TH*>3yz=Co$%nX>`^3HraKoL-$qTD#{4|VGB~O93ppkZ?u~z{@X+~kO}|JS?tq6IEt1OSWm`P8 z`@=A9m#nMireDsgEKeP76w@tid^(R!346v4n~v!=I;M+yDbtlHkTdqR9BgJt;}$b^ zIj*ckg{NrJL68^){S;B+K1AC+uv0W*R2UI{9rIK?HND%(}HLyR0&^1JuQ!Q_;K$!Q0Z zsF%W|1b2eT>o^$r?=Zg+xrsyG3UxK9&_gRTSmJKTA3t)+pakJ)nKc}5v;y2D8y^#^(?61))2QcNtv^QS$T;%tJEck_SaV^kH_HlA$ zeCis9I6DrMF-{TNAJxeZD2TcPo=DKcK~D}^xWuX2epDVHLz4{4$VN(GqxX5Ell5oTqZu}CCI#NA+J=GD0 z@*2Z%3G&gJkoS8u<*70ecMeBUrQbp)>?qzfjLNBtGVIg&JX5aZGGc*y)>}g@8G`b- zTQ9y3m4Q+6x9a6tcFM(5Q{J&OXa@R(Nu1gMfn^fdAb%dYhyvW7CN#;A4xT;cByyAi z-&YuW7#mNV!wfjo%^gLB%6E%^lfBe8@wNLWvkSK@vRyOD9}D@arWP-LJ?Yfg6?DoE zA=(CpDo2vT7lcZM@o@nzq=1S#Z#B8GOJ4ggPg1u)c6bmB(QTrNrJz_$`N`xF34r_X zAOtm42Y!;tMTJ28l$S)B+BvE`1&*{nUaIw%zu?=0#wXD}Dj613Yg9+355EnoDZg=A zQc>>nmsI3xKX!}OPPtE*Dziw^4PDIh=EjVlrfFac)==i&?q!|=D_XJ_%K|k8{(4Dt zvFYu%jM=KeS>c+IXT6vIs|DySHhsSIx)Z_w(E_8)V*FoukBu@=vB*^>S3#7X;>NxiT?I3SPyetua-w5nPS2Y_RB{dmMmL z+P<7$DLPr~k=vz`fx0)(SYgi3_L#_Ku$N18{>$K@`C3L-k;1xeZyaE%4-Gj?O;%za^y#B zu_pYL478kMVXBNRaCT% z%C(PEcEsApbc^*ov902Fm?*I&6Q~&~Cl}fTS{P4}GlnW2mprvtwjW)6nD-nxId8Es{Hc+14n#l2YRi{8HMGq zSDzmurw-CBjCzc>5c3Q6$jTB$_JOdc-zEcJVvhVMTH|rq_Id6Ia@sumC8tK5ROIba zQ*3mvb`@o+5WPK+-h8pqm=qz9L%nr8)RP$HSuJxR(93y)oHk5)oJ@^jXhye?Q#zk+ zA)|$&tGx&0PiY+a3UkA?O=A;=&EKosg0Cn7_h~Aj6njr^HxU3GG zQs*9E<2+{*Ic+o+Tm7EoLycwS%nU-S(FAj!LD`TI4OZZzIz;?RuZgaXY!L@uRc@Ux zF{g6a7AFqy*>G87_p=3Czv&i*(ba(bj+LeYlWlw5Y%yQfwi*}d=9I52>{u*&ODeCC z(QDY-1al?C=@g&-i0)L|v#|nyA1xGV|CYVJ=r@s5&FQvUk<-@8-elzSWj(t?vIlzc zy|Cs-nJvGbUD1b@05;aCUlk=4B326r8j8;;d!u?{@O$1FpQ^yr=F>*})z2y(`wJ}O zv@>XRNVE_t+ikm~th9Lf=l;=A<|YEO)h8@dFUs2z7c!1*aKFbQ?Fa4c8*+M>_1alD z+1mFt|EusfvHt8$An#-pu7OE;sy?_z@}Z5}mYFbr_gCStIIHJtZzyb`;pD-gtl_y*&1&E`;8| z%k+<$_xr-1Q|}mD9hrEjeS1;sJLkr(r6x{3?mR;dzYqd?)TKH_z0CwN+VAHNhV?;~ zl~8KTXd6zwFVWQp6%ScxMpqkuzGcpeu68F(<~&4u1v17STM(1#YuWaLvo9=rJiJpI zs#F$Sg5&i%%iq+r{A9g_=fM{?6-9l>c;loZp788r=&|RS;uMY}|6B9u>%q5g)(n2M cY6E5BuI0b<_/atomhk.mid.144 b//atomhk.mid.144 new file mode 100644 index 0000000..1d1855c --- /dev/null +++ b//atomhk.mid.144 @@ -0,0 +1,1185 @@ + +TITLE ATOMHACKER FOR MUDDLE + +RELOCATABLE + +.INSRT MUDDLE > +.GLOBAL RLOOKU,CHMAK,OBLNT,ROOT,INTOBL,ERROBL,IFALSE,PVSTOR,SPSTOR +.GLOBAL .BLOCK,IDVAL,NXTDCL,CHRWRD,CSTACK,CSTAK,ILOOKC,IGVAL,BYTDOP,HASHTB +.GLOBAL ICONS,INCONS,IBLOCK,INSRTX,GCHACK,IMPURIFY,BSETG,TYPVEC,IGET,IPUT +.GLOBAL CINSER,CIRMV,CLOOKU,CATOM,CIPNAM,MPOPJ,CSETG,CSPNAM,GPURFL,IMPURX + +LPVP==SP +TYPNT==AB +LNKBIT==200000 + +; FUNCTION TO GENERATE AN EMPTY OBLIST + +MFUNCTION MOBLIST,SUBR + + ENTRY + CAMGE AB,[-5,,0] ;CHECK NUMBER OF ARGS + JRST TMA + JUMPGE AB,MOBL2 ; NO ARGS + MOVE A,(AB) + MOVE B,1(AB) + MOVSI C,TATOM + MOVE D,IMQUOTE OBLIST + PUSHJ P,IGET ; CHECK IF IT EXISTS ALREADY + CAMN A,$TOBLS + JRST FINIS +MOBL2: + MOVEI A,1 + PUSHJ P,IBLOCK ;GET A UNIFORM VECTOR + MOVSI C,TLIST+.VECT. ;IT IS OF TYPE LIST + HLRE D,B ;-LENGTH TO D + SUBM B,D ;D POINTS TO DOPE WORD + MOVEM C,(D) ;CLOBBER TYPE IN + MOVSI A,TOBLS + JUMPGE AB,FINIS ; IF NO ARGS, DONE + GETYP A,(AB) + CAIE A,TATOM + JRST WTYP1 + MOVSI A,TOBLS + PUSH TP,$TOBLS + PUSH TP,B + MOVSI C,TATOM + MOVE D,IMQUOTE OBLIST + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,IPUT ; PUT THE NAME ON THE OBLIST + MOVE A,(AB) + MOVE B,1(AB) + MOVSI C,TATOM + MOVE D,IMQUOTE OBLIST + PUSH TP,(TB) + PUSH TP,1(TB) + PUSHJ P,IPUT ; PUT THE OBLIST ON THE NAME + + POP TP,B + POP TP,A + JRST FINIS + +MFUNCTION GROOT,SUBR,ROOT + ENTRY 0 + MOVE A,ROOT + MOVE B,ROOT+1 + JRST FINIS + +MFUNCTION GINTS,SUBR,INTERRUPTS + ENTRY 0 + MOVE A,INTOBL + MOVE B,INTOBL+1 + JRST FINIS + +MFUNCTION GERRS,SUBR,ERRORS + ENTRY 0 + MOVE A,ERROBL + MOVE B,ERROBL+1 + JRST FINIS + + +COBLQ: SKIPN B,2(B) ; SKIP IF EXISTS + JRST IFLS + MOVSI A,TOBLS + + ANDI B,-1 + CAMG B,VECBOT ; TVP IS IN FROZEN SPACE, NEVER OBLISTS + MOVE B,(B) + HRLI B,-1 + +CPOPJ1: AOS (P) + POPJ P, + +IFLS: MOVEI B,0 + MOVSI A,TFALSE + POPJ P, + +MFUNCTION OBLQ,SUBR,[OBLIST?] + + ENTRY 1 + GETYP A,(AB) + CAIE A,TATOM + JRST WTYP1 + MOVE B,1(AB) ; GET ATOM + PUSHJ P,COBLQ + JFCL + JRST FINIS + + ; FUNCTION TO FIND AN ATOM ON A GIVEN OBLIST WITH A GIVEN PNAME + +MFUNCTION LOOKUP,SUBR + + ENTRY 2 + PUSHJ P,ILOOKU ;CALL INTERNAL ROUTINE + JRST FINIS + +CLOOKU: SUBM M,(P) + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + PUSH TP,$TOBLS + PUSH TP,C + GETYP A,A + PUSHJ P,CSTAK + MOVE B,(TP) + MOVSI A,TOBLS ; THIS IS AN OBLIST + PUSHJ P,ILOOK + POP P,D + HRLI D,(D) + SUB P,D + SKIPE B + SOS (P) + SUB TP,[4,,4] + JRST MPOPJ + +ILOOKU: PUSHJ P,ARGCHK ;CHECK ARGS + PUSHJ P,CSTACK ;PUT CHARACTERS ON THE STACK + +CALLIT: MOVE B,3(AB) ;GET OBLIST + MOVSI A,TOBLS +ILOOKC: PUSHJ P,ILOOK ;LOOK IT UP + POP P,D ;RESTORE COUNT + HRLI D,(D) ;TO BOTH SIDES + SUB P,D + POPJ P, + +;THIS ROUTINE CHECKS ARG TYPES + +ARGCHK: GETYP A,(AB) ;GET TYPES + GETYP C,2(AB) + CAIE A,TCHRS ;IS IT EITHER CHAR STRING + CAIN A,TCHSTR + CAIE C,TOBLS ;IS 2ND AN OBLIST + JRST WRONGT ;TYPES ARE WRONG + POPJ P, + +;THIS SUBROUTINE PUTS CHARACTERS ON THE STACK (P WILL BE CHANGED) + + +CSTACK: MOVEI B,(AB) +CSTAK: POP P,D ;RETURN ADDRESS TO D + CAIE A,TCHRS ;IMMEDIATE? + JRST NOTIMM ;NO, HAIR + MOVE A,1(B) ; GET CHAR + LSH A,29. ; POSITION + PUSH P,A ;ONTO P + PUSH P,[1] ;WITH NUMBER + JRST (D) ;GO CALL SEARCHER + +NOTIMM: MOVEI A,1 ; CLEAR CHAR COUNT + MOVE C,(B) ; GET COUNT OF CHARS + TRNN C,-1 + JRST NULST ; FLUSH NULL STRING + MOVE PVP,PVSTOR+1 + MOVEM C,BSTO(PVP) + ANDI C,-1 + MOVE B,1(B) ;GET BYTE POINTER + +CLOOP1: PUSH P,[0] ; STORE CHARS ON STACK + MOVSI E,(<440700,,(P)>) ; SETUP BYTE POINTER +CLOOP: SKIPL INTFLG ; SO CAN WIN WITH INTERRUPTS + JRST CLOOP2 + MOVE PVP,PVSTOR+1 + HRRM C,BSTO(PVP) ;SAVE STRING LENGTH + JSR LCKINT +CLOOP2: ILDB 0,B ;GET A CHARACTER + IDPB 0,E ;STORE IT + SOJE C,CDONE ; ANY MORE? + TLNE E,760000 ; WORD FULL + JRST CLOOP ;NO CONTINUE + AOJA A,CLOOP1 ;AND CONTINUE + +CDONE: +CDONE1: MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + PUSH P,A ;AND NUMBER OF WORDS + JRST (D) ;RETURN + + +NULST: ERRUUO EQUOTE NULL-STRING + ; THIS FUNCTION LOOKS FOR ATOMS. CALLED BY PUSHJ P,ILOOK +; A,B/ OBLIST POINTER (CAN BE LIST OF SAME) +; -1(P)/ LENGTH IN WORDS OF CHARACTER BLOCK +; CHAR STRING IS ON THE STACK +; IF ATOM EXISTS RETURNS: +; B/ THE ATOM +; C/ THE BUCKET +; 0/ THE PREVIOUS BUCKET +; +; IF NOT +; B/ 0 +; 0/ PREV IF ONE WITH SAME PNAME, ELSE 0 +; C/ BUCKET + +ILOOK: PUSH TP,A + PUSH TP,B + + MOVN A,-1(P) ;GET -LENGTH + HRLI A,-1(A) ;<-LENGTH-1>,,-LENGTH + PUSH TP,$TFIX ;SAVE + PUSH TP,A + ADDI A,-1(P) ;HAVE AOBJN POINTER TO CHARS + MOVE 0,[202622077324] ;HASH WORD + ROT 0,1 + TSC 0,(A) + AOBJN A,.-2 ;XOR THEM ALL TOGETHER + HLRE A,HASHTB+1 + MOVNS A + MOVMS 0 ; MAKE SURE + HASH CODE + IDIVI 0,(A) ;DIVIDE + HRLI A,(A) ;TO BOTH HALVES + ADD A,HASHTB+1 + + MOVE C,A + HRRZ A,(A) ; POINT TO FIRST ATOM + SETZB E,0 ; INDICATE NO ATOM + + JUMPE A,NOTFND +LOOK2: HLRZ E,1(A) ; PREPARE TO BUILD AOBJN + ANDI E,377777 ; SIGN MIGHT BE ON IF IN PURIFY ETC. + SUBI E,2 + HRLS E + SUBB A,E + + ADD A,[3,,3] ;POINT TO ATOMS PNAME + MOVE D,(TP) ;GET PSEUDO AOBJN POINTER TO CHARS + ADDI D,-1(P) ;NOW ITS A REAL AOBJN POINTER + JUMPE D,CHECK0 ;ONE IS EMPTY +LOOK1: + MOVE SP,(D) + CAME SP,(A) + + JRST NEXT1 ;THIS ONE DOESN'T MATCH + AOBJP D,CHECK ;ONE RAN OUT + AOBJN A,LOOK1 ;JUMP IF STILL MIGHT WIN + +NEXT1: HRRZ A,-1(TP) ; SEE IF WE'VE ALREADY SEEN THIS NAME + GETYP D,-3(TP) ; SEE IF LIST OF OBLISTS + CAIN D,TLIST + JUMPN A,CHECK3 ; DON'T LOOK FURTHER + JUMPN A,NOTFND +NEXT: + MOVE 0,E + HLRZ A,2(E) ; NEXT ATOM + JUMPN A,LOOK2 + HRRZ A,-1(TP) + JUMPN A,NEXT1 + + SETZB E,0 + +NOTFND: + MOVEI B,0 + MOVSI A,TFALSE +CPOPJT: + + SUB TP,[4,,4] + POPJ P, + +CHECK0: JUMPN A,NEXT1 ;JUMP IF NOT ALSO EMPTY + SKIPA +CHECK: AOBJN A,NEXT1 ;JUMP IF NO MATCH + +CHECK5: HRRZ A,-1(TP) ; SEE IF FIRST SHOT AT THIS GUY? + SKIPN A + MOVE B,0 ; REMEMBER ATOM FOR FALL BACK + HLLOS -1(TP) ; INDICATE NAME MATCH HAS OCCURRED + HRRZ A,2(E) ; COMPUTE OBLIST POINTER + CAMGE A,VECBOT + MOVE A,(A) + HRROS A + GETYP D,-3(TP) ; SEE IF LIST OF OBLISTS OR + CAIE D,TOBLS + JRST CHECK1 + CAME A,-2(TP) ; DO OBLISTS MATCH? + JRST NEXT + +CHECK2: MOVE B,E ; RETURN ATOM + MOVSI A,TATOM + JRST CPOPJT + +CHECK1: MOVE D,-2(TP) ; ANY LEFT? + CAMN A,1(D) ; MATCH + JRST CHECK2 + JRST NEXT + +CHECK3: MOVE D,-2(TP) + HRRZ D,(D) + MOVEM D,-2(TP) + JUMPE D,NOTFND + JUMPE B,CHECK6 + HLRZ E,2(B) +CHECK7: HLRZ A,1(E) + ANDI A,377777 ; SIGN MIGHT BE ON IF IN PURIFY ETC. + SUBI A,2 + HRLS A + SUBB E,A + JRST CHECK5 + +CHECK6: HRRZ E,(C) + JRST CHECK7 + + ; FUNCTION TO INSERT AN ATOM ON AN OBLIST + +MFUNCTION INSERT,SUBR + + ENTRY 2 + GETYP A,2(AB) + CAIE A,TOBLS + JRST WTYP2 + MOVE A,(AB) + MOVE B,1(AB) + MOVE C,3(AB) + PUSHJ P,IINSRT + JRST FINIS + +CINSER: SUBM M,(P) + PUSHJ P,IINSRT + JRST MPOPJ + +IINSRT: PUSH TP,A + PUSH TP,B + PUSH TP,$TOBLS + PUSH TP,C + GETYP A,A + CAIN A,TATOM + JRST INSRT0 + +;INSERT WITH A GIVEN PNAME + + CAIE A,TCHRS + CAIN A,TCHSTR + JRST .+2 + JRST WTYP1 + + PUSH TP,$TFIX ;FLAG CALL + PUSH TP,[0] + MOVEI B,-5(TP) + PUSHJ P,CSTAK ;COPY ONTO STACK + MOVE B,-2(TP) + MOVSI A,TOBLS + PUSHJ P,ILOOK ;LOOK IT UP (BUCKET RETURNS IN C) + SETZM -4(TP) + SETZM -5(TP) ; KILL STRING POINTER TO KEEP FROM CONFUSING GC + JUMPN B,ALRDY ;EXISTS, LOSE + MOVE D,-2(TP) ; GET OBLIST BACK +INSRT1: PUSH TP,$TATOM + PUSH TP,0 ; PREV ATOM + PUSH TP,$TUVEC ;SAVE BUCKET POINTER + PUSH TP,C + PUSH TP,$TOBLS + PUSH TP,D ; SAVE OBLIST +INSRT3: PUSHJ P,IATOM ; MAKE AN ATOM + HLRE A,B ; FIND DOPE WORD + SUBM B,A + ANDI A,-1 + SKIPN E,-4(TP) ; AFTER AN ATOM? + JRST INSRT7 ; NO, FIRST IN BUCKET + MOVEI 0,(E) ; CHECK IF PURE + CAIG 0,HIBOT + JRST INSRNP + PUSH TP,$TATOM ; SAVE NEW ATOM + PUSH TP,B + MOVE B,E + PUSHJ P,IMPURIF + MOVE B,(TP) + MOVE E,-6(TP) + SUB TP,[2,,2] + HLRE A,B ; FIND DOPE WORD + SUBM B,A + ANDI A,-1 + +INSRNP: HLRZ 0,2(E) ; NEXT + HRLM A,2(E) ; SPLICE + HRLM 0,2(B) + JRST INSRT8 + +INSRT7: MOVE E,-2(TP) + EXCH A,(E) + HRLM A,2(B) ; IN CASE OLD ONE + +INSRT8: MOVE E,(TP) ; GET OBLIST + HRRM E,2(B) ; STORE OBLIST + MOVE E,(E) ; POINT TO LIST OF ATOMS + PUSHJ P,LINKCK + PUSHJ P,ICONS + MOVE E,(TP) + HRRM B,(E) ;INTO NEW BUCKET + MOVSI A,TATOM + MOVE B,1(B) ;GET ATOM BACK + MOVE C,-6(TP) ;GET FLAG + SUB TP,[8,,8] ;POP STACK + JUMPN C,(C) + SUB TP,[4,,4] + POPJ P, + +;INSERT WITH GIVEN ATOM +INSRT0: MOVE A,-2(TP) ;GOBBLE PNAME + SKIPE 2(A) ; SKIP IF NOT ON AN OBLIST + JRST ONOBL + ADD A,[3,,3] + HLRE C,A + MOVNS C + PUSH P,(A) ;FLUSH PNAME ONTO P STACK + AOBJN A,.-1 + PUSH P,C + MOVE B,(TP) ; GET OBLIST FOR LOOKUP + MOVSI A,TOBLS + PUSHJ P,ILOOK ;ALREADY THERE? + JUMPN B,ALRDY + MOVE D,-2(TP) + + HLRE A,-2(TP) ; FIND DOPE WORD + SUBM D,A ; TO A + JUMPE 0,INSRT9 ; NO CURRENT ATOM + MOVE E,0 + MOVEI 0,(E) + CAIGE 0,HIBOT ; PURE? + JRST INSRPN + PUSH TP,$TATOM + PUSH TP,E + PUSH TP,$TATOM + PUSH TP,D + MOVE B,E + PUSHJ P,IMPURIF + MOVE D,(TP) + MOVE E,-2(TP) + SUB TP,[4,,4] + HLRE A,D + SUBM D,A + + +INSRPN: HLRZ 0,2(E) ; POINT TO NEXT + HRLM A,2(E) ; CLOBBER NEW GUY IN + HRLM 0,2(D) ; FINISH SLPICE + JRST INSRT6 + +INSRT9: ANDI A,-1 + EXCH A,(C) ; INTO BUCKET + HRLM A,2(D) + +INSRT6: HRRZ E,(TP) + HRRZ E,(E) + MOVE B,D + PUSHJ P,LINKCK + PUSHJ P,ICONS + MOVE C,(TP) ;RESTORE OBLIST + HRRZM B,(C) + MOVE B,-2(TP) ; GET BACK ATOM + HRRM C,2(B) ; CLOBBER OBLIST IN + MOVSI A,TATOM + SUB TP,[4,,4] + POP P,C + HRLI C,(C) + SUB P,C + POPJ P, + +LINKCK: HRRZ C,FSAV(TB) ;CALLER'S NAME + MOVE D,B + CAIE C,LINK + SKIPA C,$TATOM ;LET US INSERT A LINK INSTEAD OF AN ATOM + SKIPA C,$TLINK ;GET REAL ATOM FOR CALL TO ICONS + POPJ P, + HLRE A,D + SUBM D,A + MOVEI B,LNKBIT + IORM B,(A) + POPJ P, + + +ALRDY: ERRUUO EQUOTE ATOM-ALREADY-THERE + +ONOBL: ERRUUO EQUOTE ON-AN-OBLIST-ALREADY + +; INTERNAL INSERT CALL + +INSRTX: POP P,0 ; GET RET ADDR + PUSH TP,$TFIX + PUSH TP,0 + PUSH TP,$TATOM + PUSH TP,[0] + PUSH TP,$TUVEC + PUSH TP,[0] + PUSH TP,$TOBLS + PUSH TP,B + MOVSI A,TOBLS + PUSHJ P,ILOOK + JUMPN B,INSRXT + MOVEM 0,-4(TP) + MOVEM C,-2(TP) + JRST INSRT3 ; INTO INSERT CODE + +INSRXT: PUSH P,-4(TP) + SUB TP,[6,,6] + POPJ P, + JRST IATM1 + +; FUNCTION TO REMOVE AN ATOM FROM AN OBLIST + +MFUNCTION REMOVE,SUBR + + ENTRY + + JUMPGE AB,TFA + CAMGE AB,[-5,,] + JRST TMA + MOVEI C,0 + CAML AB,[-3,,] ; SKIP IF OBLIST GIVEN + JRST .+5 + GETYP 0,2(AB) + CAIE 0,TOBLS + JRST WTYP2 + MOVE C,3(AB) + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,IRMV + JRST FINIS + +CIRMV: SUBM M,(P) + PUSHJ P,IRMV + JRST MPOPJ + +IRMV: PUSH TP,A + PUSH TP,B + PUSH TP,$TOBLS + PUSH TP,C +IRMV1: GETYP 0,A ; CHECK 1ST ARG + CAIN 0,TLINK + JRST .+3 + CAIE 0,TATOM ; ATOM, TREAT ACCORDINGLY + JRST RMV1 + + HRRZ D,2(B) ; SKIP IF ON OBLIST AND GET SAME + JUMPE D,RMVDON + CAMG D,VECBOT ; SKIP IF REAL OBLIST + HRRZ D,(D) ; NO, REF, GET IT + + JUMPGE C,GOTOBL + CAIE D,(C) ; BETTER BE THE SAME + JRST ONOTH + +GOTOBL: ADD B,[3,,3] ; POINT TO PNAME + HLRE A,B + MOVNS A + PUSH P,(B) ; PUSH PNAME + AOBJN B,.-1 + PUSH P,A + HRROM D,(TP) ; SAVE OBLIST + JRST RMV3 + +RMV1: JUMPGE C,TFA + CAIE 0,TCHRS + CAIN 0,TCHSTR + SKIPA A,0 + JRST WTYP1 + MOVEI B,-3(TP) + PUSHJ P,CSTAK +RMV3: MOVE B,(TP) + MOVSI A,TOBLS + PUSHJ P,ILOOK + POP P,D + HRLI D,(D) + SUB P,D + JUMPE B,RMVDON + + MOVEI A,(B) + CAIGE A,HIBOT ; SKIP IF PURE + JRST RMV2 + PUSH TP,$TATOM + PUSH TP,0 + PUSHJ P,IMPURIFY + MOVE 0,(TP) + SUB TP,[2,,2] + MOVE A,-3(TP) + MOVE B,-2(TP) + MOVE C,(TP) + JRST IRMV1 + +RMV2: JUMPN 0,RMV9 ; JUMP IF FIRST NOT IN BUCKET + HLRZ 0,2(B) ; POINT TO NEXT + MOVEM 0,(C) + JRST RMV8 + +RMV9: MOVE C,0 ; C IS PREV ATOM + HLRZ 0,2(B) ; NEXT + HRLM 0,2(C) + +RMV8: SETZM 2(B) ; CLOBBER OBLIST SLOT + MOVE C,(TP) ; GET OBLIST FOR SPLICE OUT + MOVEI 0,-1 + HRRZ E,(C) + +RMV7: JUMPE E,RMVDON + CAMN B,1(E) ; SEARCH OBLIST + JRST RMV6 + MOVE C,E + HRRZ E,(C) + SOJG 0,RMV7 + +RMVDON: SUB TP,[4,,4] + MOVSI A,TATOM + POPJ P, + +RMV6: HRRZ E,(E) + HRRM E,(C) ; SMASH IN + JRST RMVDON + + +;INTERNAL CALL FROM THE READER + +RLOOKU: PUSH TP,$TFIX ;PUSH A FLAG + POP P,C ;POP OFF RET ADR + PUSH TP,C ;AND USE AS A FLAG FOR INTERNAL + MOVE C,(P) ; CHANGE CHAR COUNT TO WORD + ADDI C,4 + IDIVI C,5 + MOVEM C,(P) + GETYP D,A + + CAIN D,TOBLS ;IS IT ONE OBLIST? + JRST .+3 + CAIE D,TLIST ;IS IT A LIST + JRST BADOBL + + JUMPE B,BADLST + PUSH TP,$TUVEC ; SLOT FOR REMEBERIG + PUSH TP,[0] + PUSH TP,$TOBLS + PUSH TP,[0] + PUSH TP,A + PUSH TP,B + CAIE D,TLIST + JRST RLOOK1 + + PUSH TP,$TLIST + PUSH TP,B +RLOOK2: GETYP A,(B) ;CHECK THIS IS AN OBLIST + CAIE A,TOBLS + JRST DEFALT + + SKIPE -4(TP) ; SKIP IF DEFAULT NOT STORED + JRST RLOOK4 + MOVE D,1(B) ; OBLIST + MOVEM D,-4(TP) +RLOOK4: INTGO + HRRZ B,@(TP) ;CDR THE LIST + HRRZM B,(TP) + JUMPN B,RLOOK2 + SUB TP,[2,,2] + JRST .+3 + +RLOOK1: MOVE B,(TP) + MOVEM B,-2(TP) + MOVE A,-1(TP) + MOVE B,(TP) + PUSHJ P,ILOOK + JUMPN B,RLOOK3 + SKIPN D,-2(TP) ; RESTORE FOR INSERT + JRST BADDEF ; NO DEFAULT, USER LOST ON SPECIFICATION + SUB TP,[6,,6] ; FLUSH CRAP + JRST INSRT1 + +DEFFLG==1 ;SPECIAL FLAG USED TO INDICATE THAT A DEFAULT HAS ALREADY BEEN + ; SPECIFIED +DEFALT: MOVE 0,1(B) + CAIN A,TATOM ;SPECIAL DEFAULT INDICATING ATOM ? + CAME 0,MQUOTE DEFAULT + JRST BADDEF ;NO, LOSE + MOVEI A,DEFFLG + XORB A,-11(TP) ;SET AND TEST FLAG + TRNN A,DEFFLG ; HAVE WE BEEN HERE BEFORE ? + JRST BADDEF ; YES, LOSE + SETZM -6(TP) ;ZERO OUT PREVIOUS DEFAULT + SETZM -4(TP) + JRST RLOOK4 ;CONTINUE + + +INSRT2: JRST .+2 ; +RLOOK3: SUB TP,[6,,6] ;POP OFF LOSSAGE + PUSHJ P,ILINK ;IF THIS IS A LINK FOLLOW IT + PUSH P,(TP) ;GET BACK RET ADR + SUB TP,[2,,2] ;POP TP + JRST IATM1 ;AND RETURN + + +BADOBL: ERRUUO EQUOTE BAD-OBLIST-OR-LIST-THEREOF + +BADDEF: ERRUUO EQUOTE BAD-DEFAULT-OBLIST-SPECIFICATION + +ONOTH: ERRUUO EQUOTE ATOM-ON-DIFFERENT-OBLIST + ;SUBROUTINE TO MAKE AN ATOM + +IMFUNCTION ATOM,SUBR + + ENTRY 1 + + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,IATOMI + JRST FINIS + +CATOM: SUBM M,(P) + PUSHJ P,IATOMI + JRST MPOPJ + +IATOMI: GETYP 0,A ;CHECK ARG TYPE + CAIE 0,TCHRS + CAIN 0,TCHSTR + JRST .+2 ;JUMP IF WINNERS + JRST WTYP1 + + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + MOVE A,0 + PUSHJ P,CSTAK ;COPY ONTO STACK + PUSHJ P,IATOM ;NOW MAKE THE ATOM + SUB TP,[2,,2] + POPJ P, + +;INTERNAL ATOM MAKER + +IATOM: MOVE A,-1(P) ;GET WORDS IN PNAME + ADDI A,3 ;FOR VALUE CELL + PUSHJ P,IBLOCK ; GET BLOCK + MOVSI C,<(GENERAL)>+SATOM ;FOR TYPE FIELD + MOVE D,-1(P) ;RE-GOBBLE LENGTH + ADDI D,3(B) ;POINT TO DOPE WORD + MOVEM C,(D) + SKIPG -1(P) ;EMPTY PNAME ? + JRST IATM0 ;YES, NO CHARACTERS TO MOVE + MOVE E,B ;COPY ATOM POINTER + ADD E,[3,,3] ;POINT TO PNAME AREA + MOVEI C,-1(P) + SUB C,-1(P) ;POINT TO STRING ON STACK + MOVE D,(C) ;GET SOME CHARS + MOVEM D,(E) ;AND COPY THEM + ADDI C,1 + AOBJN E,.-3 +IATM0: MOVSI A,TATOM ;TYPE TO ATOM +IATM1: POP P,D ;RETURN ADR + POP P,C + HRLI C,(C) + SUB P,C + JRST (D) ;RETURN + + ;SUBROUTINE TO GET AN ATOM'S PNAME + +MFUNCTION PNAME,SUBR + + ENTRY 1 + + GETYP A,(AB) + CAIE A,TATOM ;CHECK TYPE IS ATOM + JRST WTYP1 + MOVE A,1(AB) + PUSHJ P,IPNAME + JRST FINIS + +CIPNAM: SUBM M,(P) + PUSHJ P,IPNAME + JRST MPOPJ + +IPNAME: ADD A,[3,,3] + HLRE B,A + MOVM B,B + PUSH P,(A) ;FLUSH PNAME ONTO P + AOBJN A,.-1 + MOVE 0,(P) ; LAST WORD + PUSHJ P,PNMCNT + PUSH P,B + PUSHJ P,CHMAK ;MAKE A STRING + POPJ P, + +PNMCNT: IMULI B,5 ; CHARS TO B + MOVE A,0 + SUBI A,1 ; FIND LAST 1 + ANDCM 0,A ; 0 HAS 1ST 1 + JFFO 0,.+1 + HRREI 0,-34.(A) ; FIND HOW MUCH TO ADD + IDIVI 0,7 + ADD B,0 + POPJ P, + +MFUNCTION SPNAME,SUBR + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP1 + + MOVE B,1(AB) + PUSHJ P,CSPNAM + JRST FINIS + +CSPNAM: ADD B,[3,,3] + MOVEI D,(B) + HLRE A,B + SUBM B,A + MOVE 0,-1(A) + HLRES B + MOVMS B + PUSHJ P,PNMCNT + MOVSI A,TCHSTR + HRRI A,(B) + MOVSI B,010700 + HRRI B,-1(D) + POPJ P, + + ; BLOCK STRUCTURE SUBROUTINES FOR MUDDLE + +IMFUNCTION BLK,SUBR,BLOCK + + ENTRY 1 + + GETYP A,(AB) ;CHECK TYPE OF ARG + CAIE A,TOBLS ;IS IT AN OBLIST + CAIN A,TLIST ;OR A LIAT + JRST .+2 + JRST WTYP1 + MOVSI A,TATOM ;LOOK UP OBLIST + MOVE B,IMQUOTE OBLIST + PUSHJ P,IDVAL ;GET VALUE + PUSH TP,A + PUSH TP,B + MOVE PVP,PVSTOR+1 + PUSH TP,.BLOCK(PVP) ;HACK THE LIST + PUSH TP,.BLOCK+1(PVP) + MCALL 2,CONS ;CONS THE LIST + MOVE PVP,PVSTOR+1 + MOVEM A,.BLOCK(PVP) ;STORE IT BACK + MOVEM B,.BLOCK+1(PVP) + PUSH TP,$TATOM + PUSH TP,IMQUOTE OBLIST + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,SET ;SET OBLIST TO ARG + JRST FINIS + +MFUNCTION ENDBLOCK,SUBR + + ENTRY 0 + + MOVE PVP,PVSTOR+1 + SKIPN B,.BLOCK+1(PVP) ;IS THE LIST NIL? + JRST BLKERR ;YES, LOSE + HRRZ C,(B) ;CDR THE LIST + HRRZM C,.BLOCK+1(PVP) + PUSH TP,$TATOM ;NOW RESET OBLIST + PUSH TP,IMQUOTE OBLIST + HLLZ A,(B) ;PUSH THE TYPE OF THE CAR + PUSH TP,A + PUSH TP,1(B) ;AND VALUE OF CAR + MCALL 2,SET + JRST FINIS + +BLKERR: ERRUUO EQUOTE UNMATCHED + +BADLST: ERRUUO EQUOTE NIL-LIST-OF-OBLISTS + ;SUBROUTINE TO CREATE CHARACTER STRING GOODIE + +CHMAK: MOVE A,-1(P) + ADDI A,4 + IDIVI A,5 + PUSHJ P,IBLOCK + MOVEI C,-1(P) ;FIND START OF CHARS + HLRE E,B ; - LENGTH + ADD C,E ;C POINTS TO START + MOVE D,B ;COPY VECTOR RESULT + JUMPGE D,NULLST ;JUMP IF EMPTY + MOVE A,(C) ;GET ONE + MOVEM A,(D) + ADDI C,1 ;BUMP POINTER + AOBJN D,.-3 ;COPY +NULLST: MOVSI C,TCHRS+.VECT. ;GET TYPE + MOVEM C,(D) ;CLOBBER IT IN + MOVE A,-1(P) ; # WORDS + HRLI A,TCHSTR + HRLI B,010700 + MOVMM E,-1(P) ; SO IATM1 WORKS + SOJA B,IATM1 ;RETURN + +; SUBROUTINE TO READ FIVE CHARS FROM STRING. +; TWO CALLS, ONE WITH A POINTING TO LIST ELEMENT, +; THE OTHER WITH B POINTING TO PAIR. SKIPS IF WINNER, ELSE DOESNT + +NXTDCL: GETYP B,(A) ;CHECK TYPE + CAIE B,TDEFER ;LOSE IF NOT DEFERRED + POPJ P, + + MOVE B,1(A) ;GET REAL BYTE POINTER +CHRWRD: PUSH P,C + GETYP C,(B) ;CHECK IT IS CHSTR + CAIE C,TCHSTR + JRST CPOPJC ;NO, QUIT + PUSH P,D + PUSH P,E + PUSH P,0 + MOVEI E,0 ;INITIALIZE DESTINATION + HRRZ C,(B) ; GET CHAR COUNT + JUMPE C,GOTDCL ; NULL, FINISHED + MOVE B,1(B) ;GET BYTE POINTER + MOVE D,[440700,,E] ;BYTE POINT TO E +CHLOOP: ILDB 0,B ; GET A CHR + IDPB 0,D ;CLOBBER AWAY + SOJE C,GOTDCL ; JUMP IF DONE + TLNE D,760000 ; SKIP IF WORD FULL + JRST CHLOOP ; MORE THAN 5 CHARS + TRO E,1 ; TURN ON FLAG + +GOTDCL: MOVE B,E ;RESULT TO B + AOS -4(P) ;SKIP RETURN +CPOPJ0: POP P,0 + POP P,E + POP P,D +CPOPJC: POP P,C + POPJ P, + + ;ROUTINES TO DEFINE AND HANDLE LINKS + +MFUNCTION LINK,SUBR + ENTRY + CAML AB,[-6,,0] ;NO MORE THAN 3 ARGS + CAML AB,[-2,,0] ;NO LESS THAN 2 ARGS + JRST WNA + CAML AB,[-4,,0] ;ONLY TWO ARGS SUPPLIED ? + JRST GETOB ;YES, GET OBLIST FROM CURRENT PATH + MOVE A,2(AB) + MOVE B,3(AB) + MOVE C,5(AB) + JRST LINKIN +GETOB: MOVSI A,TATOM + MOVE B,IMQUOTE OBLIST + PUSHJ P,IDVAL + CAMN A,$TOBLS + JRST LINKP + CAME A,$TLIST + JRST BADOBL + JUMPE B,BADLST + GETYPF A,(B) + MOVE B,(B)+1 +LINKP: MOVE C,B + MOVE A,2(AB) + MOVE B,3(AB) +LINKIN: PUSHJ P,IINSRT + CAMN A,$TFALSE ;LINK NAME ALREADY USED ? + JRST ALRDY ;YES, LOSE + MOVE C,B + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,CSETG + JRST FINIS + + +ILINK: HLRE A,B + SUBM B,A ;FOUND A LINK ? + MOVE A,(A) + TRNE A,LNKBIT + JRST .+3 + MOVSI A,TATOM + POPJ P, ;NO, FINISHED + MOVSI A,TATOM + PUSHJ P,IGVAL ;GET THE LINK'S DESTINATION + CAME A,$TUNBOUND ;WELL FORMED LINK ? + POPJ P, ;YES + ERRUUO EQUOTE BAD-LINK + + +; THIS SUBROUTINE IMPURIFIES A PURE ATOM TO ALLOW MODIFICATION OF SYSTEM SUBRS + +IMPURIFY: + PUSH TP,$TATOM + PUSH TP,B + MOVE C,B + MOVEI 0,(C) + CAIGE 0,HIBOT + JRST RTNATM ; NOT PURE, RETURN + JRST IMPURX + +; ROUTINE PASSED TO GCHACK + +ATFIX: CAME D,(TP) + CAMN D,-2(TP) + JRST .+2 + POPJ P, + + ASH C,1 + ADD C,TYPVEC+1 ; COMPUTE SAT + HRRZ C,(C) + ANDI C,SATMSK + CAIE C,SATOM +CPOPJ: POPJ P, + + SUB D,-2(TP) + ADD D,-4(TP) + SKIPE B + MOVEM D,1(B) + POPJ P, + + +; SUBROUTINE TO FIND A BYTE STRINGS DOPE WORD +; RECEIVES POINTER TO PAIR CONNTAINIGN CHSTR IN C, RETURNS DOPE WORD IN A + +BYTDOP: PUSH P,B ; SAVE SOME ACS + PUSH P,D + PUSH P,E + MOVE B,1(C) ; GET BYTE POINTER + LDB D,[360600,,B] ; POSITION TO D + LDB E,[300600,,B] ; AND BYTE SIZE + MOVEI A,(E) ; A COPY IN A + IDIVI D,(E) ; D=> # OF BYTES IN WORD 1 + HRRZ E,(C) ; GET LENGTH + SUBM E,D ; # OF BYTES IN OTHER WORDS + JUMPL D,BYTDO1 ; NEAR DOPE WORD + MOVEI B,36. ; COMPUTE BYTES PER WORD + IDIVM B,A + ADDI D,-1(A) ; NOW COMPUTE WORDS + IDIVI D,(A) ; D/ # NO. OF WORDS PAST 1ST + ADD D,1(C) ; D POINTS TO DOPE WORD + MOVEI A,2(D) + +BYTDO2: POP P,E + POP P,D + POP P,B + POPJ P, +BYTDO1: MOVEI A,2(B) + JRST BYTDO2 + +; 1) IMPURIFY ITS OBLIST LIST + +IMPURX: HRRZ B,2(C) ; PICKUP OBLIST IF IT EXISTS + JUMPE B,IMPUR0 ; NOT ON ONE, IGNORE THIS CODE + + HRRO E,(B) + PUSH TP,$TOBLS ; SAVE BUCKET + PUSH TP,E + + MOVE B,(E) ; GET NEXT ONE +IMPUR4: MOVEI 0,(B) + MOVE D,1(B) + CAME D,-2(TP) + JRST .+3 + SKIPE GPURFL ; IF PURIFY SMASH THE OBLIST SLOT TO PROTECT + ; ATOM + HRRM D,1(B) + CAIGE 0,HIBOT ; SKIP IF PURE + JRST IMPUR3 ; FOUND IMPURE NESS, SKIP IT + HLLZ C,(B) ; SET UP ICONS CALL + HRRZ E,(B) +IMPR1: PUSHJ P,ICONS ; CONS IT UP +IMPR2: HRRZ E,(TP) ; RETRV PREV + HRRM B,(E) ; AND CLOBBER +IMPUR3: MOVE D,1(B) + CAMN D,-2(TP) ; HAVE GOTTEN TO OUR SLOT? + JRST IMPPR3 + MOVSI 0,TLIST + MOVEM 0,-1(TP) ; FIX TYPE + HRRZM B,(TP) ; STORE GOODIE + HRRZ B,(B) ; CDR IT + JUMPN B,IMPUR4 ; LOOP +IMPPR3: SUB TP,[2,,2] ; FLUSH TP CRUFT + +; 1.5) IMPURIFY GLOBAL HASH BUCKET, A REAL PAIN + +IMPUR0: MOVE C,(TP) ; GET ATOM + + HRRZ B,2(C) + MOVE B,(B) + ADD C,[3,,3] ; POINT TO PNAME + HLRE A,C ; GET LNTH IN WORDS OF PNAME + MOVNS A + PUSH P,[IMPUR2] ; FAKE OUT ILOOKC + PUSH P,(C) ; PUSH UP THE PNAME + AOBJN C,.-1 + PUSH P,A ; NOW THE COUNT + MOVSI A,TOBLS + JRST ILOOKC ; GO FIND BUCKET + +IMPUR2: JUMPE B,IMPUR1 + JUMPE 0,IMPUR1 ; YUP, DONE + HRRZ C,0 + CAIG C,HIBOT ; SKIP IF PREV IS PURE + JRST IMPUR1 + + MOVE B,0 + PUSH P,GPURFL ; PRERTEND OUT OF PURIFY + SETZM GPURFL + PUSHJ P,IMPURIF ; RECURSE + POP P,GPURFL + MOVE B,(TP) ; AND RETURN ORIGINAL + +; 2) GENERATE A DUPLICATE ATOM + +IMPUR1: SKIPE GPURFL ; SEE IF IN PURIFY + JRST IMPUR7 + HLRE A,(TP) ; GET LNTH OF ATOM + MOVNS A + PUSH P,A + PUSHJ P,IBLOCK ; GET NEW BLOCK FOR ATOM + PUSH TP,$TATOM + PUSH TP,B + HRL B,-2(TP) ; SETUP BLT + POP P,A + ADDI A,(B) ; END OF BLT + BLT B,(A) ; CLOBBER NEW ATOM + MOVSI B,.VECT. ; TURN ON BIT FOR GCHACK + IORM B,(A) + +; 3) NOW COPY GLOBAL VALUE + +IMPUR7: MOVE B,(TP) ; ATOM BACK + GETYP 0,(B) + SKIPE A,1(B) ; NON-ZER POINTER? + CAIN 0,TUNBOU ; BOUND? + JRST IMPUR5 ; NO, DONT COPY GLOB VAL + PUSH TP,(A) + PUSH TP,1(A) + PUSH TP,$TATOM + PUSH TP,B + SETZM (B) + SETZM 1(B) + SKIPN GPURFL ; HERE IS SOME CODE NEEDED FOR PURIFY + JRST IMPUR8 + PUSH P,LPVP + MOVE PVP,PVSTOR+1 + PUSH P,AB ; GET AB BACK + MOVE AB,ABSTO+1(PVP) +IMPUR8: PUSHJ P,BSETG ; SETG IT + SKIPN GPURFL + JRST .+3 ; RESTORE SP AND AB FOR PURIFY + POP P,TYPNT + POP P,SP + SUB TP,[2,,2] ; KILL ATOM SLOTS ON TP + POP TP,C ;POP OFF VALUE SLOTS + POP TP,A + MOVEM A,(B) ; FILL IN SLOTS ON GLOBAL STACK + MOVEM C,1(B) +IMPUR5: SKIPE GPURFL ; FINISH OFF DIFFERENTLY FOR PURIFY + JRST IMPUR9 + + PUSH TP,$TFIX ;SAVE OLD ATOM WITH FUNNY TYPE TO AVOID LOSSAGE + PUSH TP,-3(TP) + PUSH TP,$TFIX ; OTHER KIND OF POINTER ALSO + HLRE 0,-1(TP) + HRRZ A,-1(TP) + SUB A,0 + PUSH TP,A + +; 4) UPDATE ALL POINTERS TO THIS ATOM + + MOVE A,[PUSHJ P,ATFIX] ; INS TO PASS TO GCHACK + MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + SUB TP,[6,,6] + +RTNATM: POP TP,B + POP TP,A + POPJ P, + +IMPUR9: SUB TP,[2,,2] + POPJ P, ; RESTORE AND GO + + + +END diff --git a//atomhk.mid.149 b//atomhk.mid.149 new file mode 100644 index 0000000..1fe87fa --- /dev/null +++ b//atomhk.mid.149 @@ -0,0 +1,1193 @@ + +TITLE ATOMHACKER FOR MUDDLE + +RELOCATABLE + +.INSRT MUDDLE > +.GLOBAL RLOOKU,CHMAK,OBLNT,ROOT,INTOBL,ERROBL,IFALSE,PVSTOR,SPSTOR +.GLOBAL .BLOCK,IDVAL,NXTDCL,CHRWRD,CSTACK,CSTAK,ILOOKC,IGVAL,BYTDOP,HASHTB +.GLOBAL ICONS,INCONS,IBLOCK,INSRTX,GCHACK,IMPURIFY,BSETG,TYPVEC,IGET,IPUT +.GLOBAL CINSER,CIRMV,CLOOKU,CATOM,CIPNAM,MPOPJ,CSETG,CSPNAM,GPURFL,IMPURX + +LPVP==SP +TYPNT==AB +LNKBIT==200000 + +; FUNCTION TO GENERATE AN EMPTY OBLIST + +MFUNCTION MOBLIST,SUBR + + ENTRY + CAMGE AB,[-5,,0] ;CHECK NUMBER OF ARGS + JRST TMA + JUMPGE AB,MOBL2 ; NO ARGS + MOVE A,(AB) + MOVE B,1(AB) + MOVSI C,TATOM + MOVE D,IMQUOTE OBLIST + PUSHJ P,IGET ; CHECK IF IT EXISTS ALREADY + CAMN A,$TOBLS + JRST FINIS +MOBL2: + MOVEI A,1 + PUSHJ P,IBLOCK ;GET A UNIFORM VECTOR + MOVSI C,TLIST+.VECT. ;IT IS OF TYPE LIST + HLRE D,B ;-LENGTH TO D + SUBM B,D ;D POINTS TO DOPE WORD + MOVEM C,(D) ;CLOBBER TYPE IN + MOVSI A,TOBLS + JUMPGE AB,FINIS ; IF NO ARGS, DONE + GETYP A,(AB) + CAIE A,TATOM + JRST WTYP1 + MOVSI A,TOBLS + PUSH TP,$TOBLS + PUSH TP,B + MOVSI C,TATOM + MOVE D,IMQUOTE OBLIST + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,IPUT ; PUT THE NAME ON THE OBLIST + MOVE A,(AB) + MOVE B,1(AB) + MOVSI C,TATOM + MOVE D,IMQUOTE OBLIST + PUSH TP,(TB) + PUSH TP,1(TB) + PUSHJ P,IPUT ; PUT THE OBLIST ON THE NAME + + POP TP,B + POP TP,A + JRST FINIS + +MFUNCTION GROOT,SUBR,ROOT + ENTRY 0 + MOVE A,ROOT + MOVE B,ROOT+1 + JRST FINIS + +MFUNCTION GINTS,SUBR,INTERRUPTS + ENTRY 0 + MOVE A,INTOBL + MOVE B,INTOBL+1 + JRST FINIS + +MFUNCTION GERRS,SUBR,ERRORS + ENTRY 0 + MOVE A,ERROBL + MOVE B,ERROBL+1 + JRST FINIS + + +COBLQ: SKIPN B,2(B) ; SKIP IF EXISTS + JRST IFLS + MOVSI A,TOBLS + + ANDI B,-1 + CAMG B,VECBOT ; TVP IS IN FROZEN SPACE, NEVER OBLISTS + MOVE B,(B) + HRLI B,-1 + +CPOPJ1: AOS (P) + POPJ P, + +IFLS: MOVEI B,0 + MOVSI A,TFALSE + POPJ P, + +MFUNCTION OBLQ,SUBR,[OBLIST?] + + ENTRY 1 + GETYP A,(AB) + CAIE A,TATOM + JRST WTYP1 + MOVE B,1(AB) ; GET ATOM + PUSHJ P,COBLQ + JFCL + JRST FINIS + + ; FUNCTION TO FIND AN ATOM ON A GIVEN OBLIST WITH A GIVEN PNAME + +MFUNCTION LOOKUP,SUBR + + ENTRY 2 + PUSHJ P,ILOOKU ;CALL INTERNAL ROUTINE + JRST FINIS + +CLOOKU: SUBM M,(P) + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + PUSH TP,$TOBLS + PUSH TP,C + GETYP A,A + PUSHJ P,CSTAK + MOVE B,(TP) + MOVSI A,TOBLS ; THIS IS AN OBLIST + PUSHJ P,ILOOK + POP P,D + HRLI D,(D) + SUB P,D + SKIPE B + SOS (P) + SUB TP,[4,,4] + JRST MPOPJ + +ILOOKU: PUSHJ P,ARGCHK ;CHECK ARGS + PUSHJ P,CSTACK ;PUT CHARACTERS ON THE STACK + +CALLIT: MOVE B,3(AB) ;GET OBLIST + MOVSI A,TOBLS +ILOOKC: PUSHJ P,ILOOK ;LOOK IT UP + POP P,D ;RESTORE COUNT + HRLI D,(D) ;TO BOTH SIDES + SUB P,D + POPJ P, + +;THIS ROUTINE CHECKS ARG TYPES + +ARGCHK: GETYP A,(AB) ;GET TYPES + GETYP C,2(AB) + CAIE A,TCHRS ;IS IT EITHER CHAR STRING + CAIN A,TCHSTR + CAIE C,TOBLS ;IS 2ND AN OBLIST + JRST WRONGT ;TYPES ARE WRONG + POPJ P, + +;THIS SUBROUTINE PUTS CHARACTERS ON THE STACK (P WILL BE CHANGED) + + +CSTACK: MOVEI B,(AB) +CSTAK: POP P,D ;RETURN ADDRESS TO D + CAIE A,TCHRS ;IMMEDIATE? + JRST NOTIMM ;NO, HAIR + MOVE A,1(B) ; GET CHAR + LSH A,29. ; POSITION + PUSH P,A ;ONTO P + PUSH P,[1] ;WITH NUMBER + JRST (D) ;GO CALL SEARCHER + +NOTIMM: MOVEI A,1 ; CLEAR CHAR COUNT + MOVE C,(B) ; GET COUNT OF CHARS + TRNN C,-1 + JRST NULST ; FLUSH NULL STRING + MOVE PVP,PVSTOR+1 + MOVEM C,BSTO(PVP) + ANDI C,-1 + MOVE B,1(B) ;GET BYTE POINTER + +CLOOP1: PUSH P,[0] ; STORE CHARS ON STACK + MOVSI E,(<440700,,(P)>) ; SETUP BYTE POINTER +CLOOP: SKIPL INTFLG ; SO CAN WIN WITH INTERRUPTS + JRST CLOOP2 + MOVE PVP,PVSTOR+1 + HRRM C,BSTO(PVP) ;SAVE STRING LENGTH + JSR LCKINT +CLOOP2: ILDB 0,B ;GET A CHARACTER + IDPB 0,E ;STORE IT + SOJE C,CDONE ; ANY MORE? + TLNE E,760000 ; WORD FULL + JRST CLOOP ;NO CONTINUE + AOJA A,CLOOP1 ;AND CONTINUE + +CDONE: +CDONE1: MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + PUSH P,A ;AND NUMBER OF WORDS + JRST (D) ;RETURN + + +NULST: ERRUUO EQUOTE NULL-STRING + ; THIS FUNCTION LOOKS FOR ATOMS. CALLED BY PUSHJ P,ILOOK +; A,B/ OBLIST POINTER (CAN BE LIST OF SAME) +; -1(P)/ LENGTH IN WORDS OF CHARACTER BLOCK +; CHAR STRING IS ON THE STACK +; IF ATOM EXISTS RETURNS: +; B/ THE ATOM +; C/ THE BUCKET +; 0/ THE PREVIOUS BUCKET +; +; IF NOT +; B/ 0 +; 0/ PREV IF ONE WITH SAME PNAME, ELSE 0 +; C/ BUCKET + +ILOOK: PUSH TP,A + PUSH TP,B + + MOVN A,-1(P) ;GET -LENGTH + HRLI A,-1(A) ;<-LENGTH-1>,,-LENGTH + PUSH TP,$TFIX ;SAVE + PUSH TP,A + ADDI A,-1(P) ;HAVE AOBJN POINTER TO CHARS + MOVE 0,[202622077324] ;HASH WORD + ROT 0,1 + TSC 0,(A) + AOBJN A,.-2 ;XOR THEM ALL TOGETHER + HLRE A,HASHTB+1 + MOVNS A + MOVMS 0 ; MAKE SURE + HASH CODE + IDIVI 0,(A) ;DIVIDE + HRLI A,(A) ;TO BOTH HALVES + ADD A,HASHTB+1 + + MOVE C,A + HRRZ A,(A) ; POINT TO FIRST ATOM + SETZB E,0 ; INDICATE NO ATOM + + JUMPE A,NOTFND +LOOK2: HLRZ E,1(A) ; PREPARE TO BUILD AOBJN + ANDI E,377777 ; SIGN MIGHT BE ON IF IN PURIFY ETC. + SUBI E,2 + HRLS E + SUBB A,E + + ADD A,[3,,3] ;POINT TO ATOMS PNAME + MOVE D,(TP) ;GET PSEUDO AOBJN POINTER TO CHARS + ADDI D,-1(P) ;NOW ITS A REAL AOBJN POINTER + JUMPE D,CHECK0 ;ONE IS EMPTY +LOOK1: + MOVE SP,(D) + CAME SP,(A) + + JRST NEXT1 ;THIS ONE DOESN'T MATCH + AOBJP D,CHECK ;ONE RAN OUT + AOBJN A,LOOK1 ;JUMP IF STILL MIGHT WIN + +NEXT1: HRRZ A,-1(TP) ; SEE IF WE'VE ALREADY SEEN THIS NAME + GETYP D,-3(TP) ; SEE IF LIST OF OBLISTS + CAIN D,TLIST + JUMPN A,CHECK3 ; DON'T LOOK FURTHER + JUMPN A,NOTFND +NEXT: + MOVE 0,E + HLRZ A,2(E) ; NEXT ATOM + JUMPN A,LOOK2 + HRRZ A,-1(TP) + JUMPN A,NEXT1 + + SETZB E,0 + +NOTFND: + MOVEI B,0 + MOVSI A,TFALSE +CPOPJT: + + SUB TP,[4,,4] + POPJ P, + +CHECK0: JUMPN A,NEXT1 ;JUMP IF NOT ALSO EMPTY + SKIPA +CHECK: AOBJN A,NEXT1 ;JUMP IF NO MATCH + +CHECK5: HRRZ A,-1(TP) ; SEE IF FIRST SHOT AT THIS GUY? + SKIPN A + MOVE B,0 ; REMEMBER ATOM FOR FALL BACK + HLLOS -1(TP) ; INDICATE NAME MATCH HAS OCCURRED + HRRZ A,2(E) ; COMPUTE OBLIST POINTER + CAMGE A,VECBOT + MOVE A,(A) + HRROS A + GETYP D,-3(TP) ; SEE IF LIST OF OBLISTS OR + CAIE D,TOBLS + JRST CHECK1 + CAME A,-2(TP) ; DO OBLISTS MATCH? + JRST NEXT + +CHECK2: MOVE B,E ; RETURN ATOM + MOVSI A,TATOM + JRST CPOPJT + +CHECK1: MOVE D,-2(TP) ; ANY LEFT? + CAMN A,1(D) ; MATCH + JRST CHECK2 + JRST NEXT + +CHECK3: MOVE D,-2(TP) + HRRZ D,(D) + MOVEM D,-2(TP) + JUMPE D,NOTFND + JUMPE B,CHECK6 + HLRZ E,2(B) +CHECK7: HLRZ A,1(E) + ANDI A,377777 ; SIGN MIGHT BE ON IF IN PURIFY ETC. + SUBI A,2 + HRLS A + SUBB E,A + JRST CHECK5 + +CHECK6: HRRZ E,(C) + JRST CHECK7 + + ; FUNCTION TO INSERT AN ATOM ON AN OBLIST + +MFUNCTION INSERT,SUBR + + ENTRY 2 + GETYP A,2(AB) + CAIE A,TOBLS + JRST WTYP2 + MOVE A,(AB) + MOVE B,1(AB) + MOVE C,3(AB) + PUSHJ P,IINSRT + JRST FINIS + +CINSER: SUBM M,(P) + PUSHJ P,IINSRT + JRST MPOPJ + +IINSRT: PUSH TP,A + PUSH TP,B + PUSH TP,$TOBLS + PUSH TP,C + GETYP A,A + CAIN A,TATOM + JRST INSRT0 + +;INSERT WITH A GIVEN PNAME + + CAIE A,TCHRS + CAIN A,TCHSTR + JRST .+2 + JRST WTYP1 + + PUSH TP,$TFIX ;FLAG CALL + PUSH TP,[0] + MOVEI B,-5(TP) + PUSHJ P,CSTAK ;COPY ONTO STACK + MOVE B,-2(TP) + MOVSI A,TOBLS + PUSHJ P,ILOOK ;LOOK IT UP (BUCKET RETURNS IN C) + SETZM -4(TP) + SETZM -5(TP) ; KILL STRING POINTER TO KEEP FROM CONFUSING GC + JUMPN B,ALRDY ;EXISTS, LOSE + MOVE D,-2(TP) ; GET OBLIST BACK +INSRT1: PUSH TP,$TATOM + PUSH TP,0 ; PREV ATOM + PUSH TP,$TUVEC ;SAVE BUCKET POINTER + PUSH TP,C + PUSH TP,$TOBLS + PUSH TP,D ; SAVE OBLIST +INSRT3: PUSHJ P,IATOM ; MAKE AN ATOM + HLRE A,B ; FIND DOPE WORD + SUBM B,A + ANDI A,-1 + SKIPN E,-4(TP) ; AFTER AN ATOM? + JRST INSRT7 ; NO, FIRST IN BUCKET + MOVEI 0,(E) ; CHECK IF PURE + CAIG 0,HIBOT + JRST INSRNP + PUSH TP,$TATOM ; SAVE NEW ATOM + PUSH TP,B + MOVE B,E + PUSHJ P,IMPURIF + MOVE B,(TP) + MOVE E,-6(TP) + SUB TP,[2,,2] + HLRE A,B ; FIND DOPE WORD + SUBM B,A + ANDI A,-1 + +INSRNP: HLRZ 0,2(E) ; NEXT + HRLM A,2(E) ; SPLICE + HRLM 0,2(B) + JRST INSRT8 + +INSRT7: MOVE E,-2(TP) + EXCH A,(E) + HRLM A,2(B) ; IN CASE OLD ONE + +INSRT8: MOVE E,(TP) ; GET OBLIST + HRRM E,2(B) ; STORE OBLIST + MOVE E,(E) ; POINT TO LIST OF ATOMS + PUSHJ P,LINKCK + PUSHJ P,ICONS + MOVE E,(TP) + HRRM B,(E) ;INTO NEW BUCKET + MOVSI A,TATOM + MOVE B,1(B) ;GET ATOM BACK + MOVE C,-6(TP) ;GET FLAG + SUB TP,[8,,8] ;POP STACK + JUMPN C,(C) + SUB TP,[4,,4] + POPJ P, + +;INSERT WITH GIVEN ATOM +INSRT0: MOVE A,-2(TP) ;GOBBLE PNAME + SKIPE 2(A) ; SKIP IF NOT ON AN OBLIST + JRST ONOBL + ADD A,[3,,3] + HLRE C,A + MOVNS C + PUSH P,(A) ;FLUSH PNAME ONTO P STACK + AOBJN A,.-1 + PUSH P,C + MOVE B,(TP) ; GET OBLIST FOR LOOKUP + MOVSI A,TOBLS + PUSHJ P,ILOOK ;ALREADY THERE? + JUMPN B,ALRDY + MOVE D,-2(TP) + + HLRE A,-2(TP) ; FIND DOPE WORD + SUBM D,A ; TO A + JUMPE 0,INSRT9 ; NO CURRENT ATOM + MOVE E,0 + MOVEI 0,(E) + CAIGE 0,HIBOT ; PURE? + JRST INSRPN + PUSH TP,$TATOM + PUSH TP,E + PUSH TP,$TATOM + PUSH TP,D + MOVE B,E + PUSHJ P,IMPURIF + MOVE D,(TP) + MOVE E,-2(TP) + SUB TP,[4,,4] + HLRE A,D + SUBM D,A + + +INSRPN: HLRZ 0,2(E) ; POINT TO NEXT + HRLM A,2(E) ; CLOBBER NEW GUY IN + HRLM 0,2(D) ; FINISH SLPICE + JRST INSRT6 + +INSRT9: ANDI A,-1 + EXCH A,(C) ; INTO BUCKET + HRLM A,2(D) + +INSRT6: HRRZ E,(TP) + HRRZ E,(E) + MOVE B,D + PUSHJ P,LINKCK + PUSHJ P,ICONS + MOVE C,(TP) ;RESTORE OBLIST + HRRZM B,(C) + MOVE B,-2(TP) ; GET BACK ATOM + HRRM C,2(B) ; CLOBBER OBLIST IN + MOVSI A,TATOM + SUB TP,[4,,4] + POP P,C + HRLI C,(C) + SUB P,C + POPJ P, + +LINKCK: HRRZ C,FSAV(TB) ;CALLER'S NAME + MOVE D,B + CAIE C,LINK + SKIPA C,$TATOM ;LET US INSERT A LINK INSTEAD OF AN ATOM + SKIPA C,$TLINK ;GET REAL ATOM FOR CALL TO ICONS + POPJ P, + HLRE A,D + SUBM D,A + MOVEI B,LNKBIT + IORM B,(A) + POPJ P, + + +ALRDY: ERRUUO EQUOTE ATOM-ALREADY-THERE + +ONOBL: ERRUUO EQUOTE ON-AN-OBLIST-ALREADY + +; INTERNAL INSERT CALL + +INSRTX: POP P,0 ; GET RET ADDR + PUSH TP,$TFIX + PUSH TP,0 + PUSH TP,$TATOM + PUSH TP,[0] + PUSH TP,$TUVEC + PUSH TP,[0] + PUSH TP,$TOBLS + PUSH TP,B + MOVSI A,TOBLS + PUSHJ P,ILOOK + JUMPN B,INSRXT + MOVEM 0,-4(TP) + MOVEM C,-2(TP) + JRST INSRT3 ; INTO INSERT CODE + +INSRXT: PUSH P,-4(TP) + SUB TP,[6,,6] + POPJ P, + JRST IATM1 + +; FUNCTION TO REMOVE AN ATOM FROM AN OBLIST + +MFUNCTION REMOVE,SUBR + + ENTRY + + JUMPGE AB,TFA + CAMGE AB,[-5,,] + JRST TMA + MOVEI C,0 + CAML AB,[-3,,] ; SKIP IF OBLIST GIVEN + JRST .+5 + GETYP 0,2(AB) + CAIE 0,TOBLS + JRST WTYP2 + MOVE C,3(AB) + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,IRMV + JRST FINIS + +CIRMV: SUBM M,(P) + PUSHJ P,IRMV + JRST MPOPJ + +IRMV: PUSH TP,A + PUSH TP,B + PUSH TP,$TOBLS + PUSH TP,C +IRMV1: GETYP 0,A ; CHECK 1ST ARG + CAIN 0,TLINK + JRST .+3 + CAIE 0,TATOM ; ATOM, TREAT ACCORDINGLY + JRST RMV1 + + HRRZ D,2(B) ; SKIP IF ON OBLIST AND GET SAME + JUMPE D,RMVDON + CAMG D,VECBOT ; SKIP IF REAL OBLIST + HRRZ D,(D) ; NO, REF, GET IT + + JUMPGE C,GOTOBL + CAIE D,(C) ; BETTER BE THE SAME + JRST ONOTH + +GOTOBL: ADD B,[3,,3] ; POINT TO PNAME + HLRE A,B + MOVNS A + PUSH P,(B) ; PUSH PNAME + AOBJN B,.-1 + PUSH P,A + HRROM D,(TP) ; SAVE OBLIST + JRST RMV3 + +RMV1: JUMPGE C,TFA + CAIE 0,TCHRS + CAIN 0,TCHSTR + SKIPA A,0 + JRST WTYP1 + MOVEI B,-3(TP) + PUSHJ P,CSTAK +RMV3: MOVE B,(TP) + MOVSI A,TOBLS + PUSHJ P,ILOOK + POP P,D + HRLI D,(D) + SUB P,D + JUMPE B,RMVDON + + MOVEI A,(B) + CAIGE A,HIBOT ; SKIP IF PURE + JRST RMV2 + PUSH TP,$TATOM + PUSH TP,0 + PUSHJ P,IMPURIFY + MOVE 0,(TP) + SUB TP,[2,,2] + MOVE A,-3(TP) + MOVE B,-2(TP) + MOVE C,(TP) + JRST IRMV1 + +RMV2: JUMPN 0,RMV9 ; JUMP IF FIRST NOT IN BUCKET + HLRZ 0,2(B) ; POINT TO NEXT + MOVEM 0,(C) + JRST RMV8 + +RMV9: MOVE C,0 ; C IS PREV ATOM + HLRZ 0,2(B) ; NEXT + HRLM 0,2(C) + +RMV8: SETZM 2(B) ; CLOBBER OBLIST SLOT + MOVE C,(TP) ; GET OBLIST FOR SPLICE OUT + MOVEI 0,-1 + HRRZ E,(C) + +RMV7: JUMPE E,RMVDON + CAMN B,1(E) ; SEARCH OBLIST + JRST RMV6 + MOVE C,E + HRRZ E,(C) + SOJG 0,RMV7 + +RMVDON: SUB TP,[4,,4] + MOVSI A,TATOM + POPJ P, + +RMV6: HRRZ E,(E) + HRRM E,(C) ; SMASH IN + JRST RMVDON + + +;INTERNAL CALL FROM THE READER + +RLOOKU: PUSH TP,$TFIX ;PUSH A FLAG + POP P,C ;POP OFF RET ADR + PUSH TP,C ;AND USE AS A FLAG FOR INTERNAL + MOVE C,(P) ; CHANGE CHAR COUNT TO WORD + ADDI C,4 + IDIVI C,5 + MOVEM C,(P) + GETYP D,A + + CAIN D,TOBLS ;IS IT ONE OBLIST? + JRST .+3 + CAIE D,TLIST ;IS IT A LIST + JRST BADOBL + + JUMPE B,BADLST + PUSH TP,$TUVEC ; SLOT FOR REMEBERIG + PUSH TP,[0] + PUSH TP,$TOBLS + PUSH TP,[0] + PUSH TP,A + PUSH TP,B + CAIE D,TLIST + JRST RLOOK1 + + PUSH TP,$TLIST + PUSH TP,B +RLOOK2: GETYP A,(B) ;CHECK THIS IS AN OBLIST + CAIE A,TOBLS + JRST DEFALT + + SKIPE -4(TP) ; SKIP IF DEFAULT NOT STORED + JRST RLOOK4 + MOVE D,1(B) ; OBLIST + MOVEM D,-4(TP) +RLOOK4: INTGO + HRRZ B,@(TP) ;CDR THE LIST + HRRZM B,(TP) + JUMPN B,RLOOK2 + SUB TP,[2,,2] + JRST .+3 + +RLOOK1: MOVE B,(TP) + MOVEM B,-2(TP) + MOVE A,-1(TP) + MOVE B,(TP) + PUSHJ P,ILOOK + JUMPN B,RLOOK3 + SKIPN D,-2(TP) ; RESTORE FOR INSERT + JRST BADDEF ; NO DEFAULT, USER LOST ON SPECIFICATION + SUB TP,[6,,6] ; FLUSH CRAP + SKIPN NOATMS + JRST INSRT1 + JRST INSRT1 + +DEFFLG==1 ;SPECIAL FLAG USED TO INDICATE THAT A DEFAULT HAS ALREADY BEEN + ; SPECIFIED +DEFALT: MOVE 0,1(B) + CAIN A,TATOM ;SPECIAL DEFAULT INDICATING ATOM ? + CAME 0,MQUOTE DEFAULT + JRST BADDEF ;NO, LOSE + MOVEI A,DEFFLG + XORB A,-11(TP) ;SET AND TEST FLAG + TRNN A,DEFFLG ; HAVE WE BEEN HERE BEFORE ? + JRST BADDEF ; YES, LOSE + SETZM -6(TP) ;ZERO OUT PREVIOUS DEFAULT + SETZM -4(TP) + JRST RLOOK4 ;CONTINUE + + +INSRT2: JRST .+2 ; +RLOOK3: SUB TP,[6,,6] ;POP OFF LOSSAGE + PUSHJ P,ILINK ;IF THIS IS A LINK FOLLOW IT + PUSH P,(TP) ;GET BACK RET ADR + SUB TP,[2,,2] ;POP TP + JRST IATM1 ;AND RETURN + + +BADOBL: ERRUUO EQUOTE BAD-OBLIST-OR-LIST-THEREOF + +BADDEF: ERRUUO EQUOTE BAD-DEFAULT-OBLIST-SPECIFICATION + +ONOTH: ERRUUO EQUOTE ATOM-ON-DIFFERENT-OBLIST + ;SUBROUTINE TO MAKE AN ATOM + +IMFUNCTION ATOM,SUBR + + ENTRY 1 + + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,IATOMI + JRST FINIS + +CATOM: SUBM M,(P) + PUSHJ P,IATOMI + JRST MPOPJ + +IATOMI: GETYP 0,A ;CHECK ARG TYPE + CAIE 0,TCHRS + CAIN 0,TCHSTR + JRST .+2 ;JUMP IF WINNERS + JRST WTYP1 + + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + MOVE A,0 + PUSHJ P,CSTAK ;COPY ONTO STACK + PUSHJ P,IATOM ;NOW MAKE THE ATOM + SUB TP,[2,,2] + POPJ P, + +;INTERNAL ATOM MAKER + +IATOM: MOVE A,-1(P) ;GET WORDS IN PNAME + ADDI A,3 ;FOR VALUE CELL + PUSHJ P,IBLOCK ; GET BLOCK + MOVSI C,<(GENERAL)>+SATOM ;FOR TYPE FIELD + MOVE D,-1(P) ;RE-GOBBLE LENGTH + ADDI D,3(B) ;POINT TO DOPE WORD + MOVEM C,(D) + SKIPG -1(P) ;EMPTY PNAME ? + JRST IATM0 ;YES, NO CHARACTERS TO MOVE + MOVE E,B ;COPY ATOM POINTER + ADD E,[3,,3] ;POINT TO PNAME AREA + MOVEI C,-1(P) + SUB C,-1(P) ;POINT TO STRING ON STACK + MOVE D,(C) ;GET SOME CHARS + MOVEM D,(E) ;AND COPY THEM + ADDI C,1 + AOBJN E,.-3 +IATM0: MOVSI A,TATOM ;TYPE TO ATOM +IATM1: POP P,D ;RETURN ADR + POP P,C + HRLI C,(C) + SUB P,C + JRST (D) ;RETURN + + ;SUBROUTINE TO GET AN ATOM'S PNAME + +MFUNCTION PNAME,SUBR + + ENTRY 1 + + GETYP A,(AB) + CAIE A,TATOM ;CHECK TYPE IS ATOM + JRST WTYP1 + MOVE A,1(AB) + PUSHJ P,IPNAME + JRST FINIS + +CIPNAM: SUBM M,(P) + PUSHJ P,IPNAME + JRST MPOPJ + +IPNAME: ADD A,[3,,3] + HLRE B,A + MOVM B,B + PUSH P,(A) ;FLUSH PNAME ONTO P + AOBJN A,.-1 + MOVE 0,(P) ; LAST WORD + PUSHJ P,PNMCNT + PUSH P,B + PUSHJ P,CHMAK ;MAKE A STRING + POPJ P, + +PNMCNT: IMULI B,5 ; CHARS TO B + MOVE A,0 + SUBI A,1 ; FIND LAST 1 + ANDCM 0,A ; 0 HAS 1ST 1 + JFFO 0,.+1 + HRREI 0,-34.(A) ; FIND HOW MUCH TO ADD + IDIVI 0,7 + ADD B,0 + POPJ P, + +MFUNCTION SPNAME,SUBR + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP1 + + MOVE B,1(AB) + PUSHJ P,CSPNAM + JRST FINIS + +CSPNAM: ADD B,[3,,3] + MOVEI D,(B) + HLRE A,B + SUBM B,A + MOVE 0,-1(A) + HLRES B + MOVMS B + PUSHJ P,PNMCNT + MOVSI A,TCHSTR + HRRI A,(B) + MOVSI B,010700 + HRRI B,-1(D) + POPJ P, + + ; BLOCK STRUCTURE SUBROUTINES FOR MUDDLE + +IMFUNCTION BLK,SUBR,BLOCK + + ENTRY 1 + + GETYP A,(AB) ;CHECK TYPE OF ARG + CAIE A,TOBLS ;IS IT AN OBLIST + CAIN A,TLIST ;OR A LIAT + JRST .+2 + JRST WTYP1 + MOVSI A,TATOM ;LOOK UP OBLIST + MOVE B,IMQUOTE OBLIST + PUSHJ P,IDVAL ;GET VALUE + PUSH TP,A + PUSH TP,B + MOVE PVP,PVSTOR+1 + PUSH TP,.BLOCK(PVP) ;HACK THE LIST + PUSH TP,.BLOCK+1(PVP) + MCALL 2,CONS ;CONS THE LIST + MOVE PVP,PVSTOR+1 + MOVEM A,.BLOCK(PVP) ;STORE IT BACK + MOVEM B,.BLOCK+1(PVP) + PUSH TP,$TATOM + PUSH TP,IMQUOTE OBLIST + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,SET ;SET OBLIST TO ARG + JRST FINIS + +MFUNCTION ENDBLOCK,SUBR + + ENTRY 0 + + MOVE PVP,PVSTOR+1 + SKIPN B,.BLOCK+1(PVP) ;IS THE LIST NIL? + JRST BLKERR ;YES, LOSE + HRRZ C,(B) ;CDR THE LIST + HRRZM C,.BLOCK+1(PVP) + PUSH TP,$TATOM ;NOW RESET OBLIST + PUSH TP,IMQUOTE OBLIST + HLLZ A,(B) ;PUSH THE TYPE OF THE CAR + PUSH TP,A + PUSH TP,1(B) ;AND VALUE OF CAR + MCALL 2,SET + JRST FINIS + +BLKERR: ERRUUO EQUOTE UNMATCHED + +BADLST: ERRUUO EQUOTE NIL-LIST-OF-OBLISTS + ;SUBROUTINE TO CREATE CHARACTER STRING GOODIE + +CHMAK: MOVE A,-1(P) + ADDI A,4 + IDIVI A,5 + PUSHJ P,IBLOCK + MOVEI C,-1(P) ;FIND START OF CHARS + HLRE E,B ; - LENGTH + ADD C,E ;C POINTS TO START + MOVE D,B ;COPY VECTOR RESULT + JUMPGE D,NULLST ;JUMP IF EMPTY + MOVE A,(C) ;GET ONE + MOVEM A,(D) + ADDI C,1 ;BUMP POINTER + AOBJN D,.-3 ;COPY +NULLST: MOVSI C,TCHRS+.VECT. ;GET TYPE + MOVEM C,(D) ;CLOBBER IT IN + MOVE A,-1(P) ; # WORDS + HRLI A,TCHSTR + HRLI B,010700 + MOVMM E,-1(P) ; SO IATM1 WORKS + SOJA B,IATM1 ;RETURN + +; SUBROUTINE TO READ FIVE CHARS FROM STRING. +; TWO CALLS, ONE WITH A POINTING TO LIST ELEMENT, +; THE OTHER WITH B POINTING TO PAIR. SKIPS IF WINNER, ELSE DOESNT + +NXTDCL: GETYP B,(A) ;CHECK TYPE + CAIE B,TDEFER ;LOSE IF NOT DEFERRED + POPJ P, + + MOVE B,1(A) ;GET REAL BYTE POINTER +CHRWRD: PUSH P,C + GETYP C,(B) ;CHECK IT IS CHSTR + CAIE C,TCHSTR + JRST CPOPJC ;NO, QUIT + PUSH P,D + PUSH P,E + PUSH P,0 + MOVEI E,0 ;INITIALIZE DESTINATION + HRRZ C,(B) ; GET CHAR COUNT + JUMPE C,GOTDCL ; NULL, FINISHED + MOVE B,1(B) ;GET BYTE POINTER + MOVE D,[440700,,E] ;BYTE POINT TO E +CHLOOP: ILDB 0,B ; GET A CHR + IDPB 0,D ;CLOBBER AWAY + SOJE C,GOTDCL ; JUMP IF DONE + TLNE D,760000 ; SKIP IF WORD FULL + JRST CHLOOP ; MORE THAN 5 CHARS + TRO E,1 ; TURN ON FLAG + +GOTDCL: MOVE B,E ;RESULT TO B + AOS -4(P) ;SKIP RETURN +CPOPJ0: POP P,0 + POP P,E + POP P,D +CPOPJC: POP P,C + POPJ P, + + ;ROUTINES TO DEFINE AND HANDLE LINKS + +MFUNCTION LINK,SUBR + ENTRY + CAML AB,[-6,,0] ;NO MORE THAN 3 ARGS + CAML AB,[-2,,0] ;NO LESS THAN 2 ARGS + JRST WNA + CAML AB,[-4,,0] ;ONLY TWO ARGS SUPPLIED ? + JRST GETOB ;YES, GET OBLIST FROM CURRENT PATH + MOVE A,2(AB) + MOVE B,3(AB) + MOVE C,5(AB) + JRST LINKIN +GETOB: MOVSI A,TATOM + MOVE B,IMQUOTE OBLIST + PUSHJ P,IDVAL + CAMN A,$TOBLS + JRST LINKP + CAME A,$TLIST + JRST BADOBL + JUMPE B,BADLST + GETYPF A,(B) + MOVE B,(B)+1 +LINKP: MOVE C,B + MOVE A,2(AB) + MOVE B,3(AB) +LINKIN: PUSHJ P,IINSRT + CAMN A,$TFALSE ;LINK NAME ALREADY USED ? + JRST ALRDY ;YES, LOSE + MOVE C,B + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,CSETG + JRST FINIS + + +ILINK: HLRE A,B + SUBM B,A ;FOUND A LINK ? + MOVE A,(A) + TRNE A,LNKBIT + JRST .+3 + MOVSI A,TATOM + POPJ P, ;NO, FINISHED + MOVSI A,TATOM + PUSHJ P,IGVAL ;GET THE LINK'S DESTINATION + CAME A,$TUNBOUND ;WELL FORMED LINK ? + POPJ P, ;YES + ERRUUO EQUOTE BAD-LINK + + +; THIS SUBROUTINE IMPURIFIES A PURE ATOM TO ALLOW MODIFICATION OF SYSTEM SUBRS + +IMPURIFY: + PUSH TP,$TATOM + PUSH TP,B + MOVE C,B + MOVEI 0,(C) + CAIGE 0,HIBOT + JRST RTNATM ; NOT PURE, RETURN + JRST IMPURX + +; ROUTINE PASSED TO GCHACK + +ATFIX: CAME D,(TP) + CAMN D,-2(TP) + JRST .+2 + POPJ P, + + ASH C,1 + ADD C,TYPVEC+1 ; COMPUTE SAT + HRRZ C,(C) + ANDI C,SATMSK + CAIE C,SATOM +CPOPJ: POPJ P, + + SUB D,-2(TP) + ADD D,-4(TP) + SKIPE B + MOVEM D,1(B) + POPJ P, + + +; SUBROUTINE TO FIND A BYTE STRINGS DOPE WORD +; RECEIVES POINTER TO PAIR CONNTAINIGN CHSTR IN C, RETURNS DOPE WORD IN A + +BYTDOP: PUSH P,B ; SAVE SOME ACS + PUSH P,D + PUSH P,E + MOVE B,1(C) ; GET BYTE POINTER + LDB D,[360600,,B] ; POSITION TO D + LDB E,[300600,,B] ; AND BYTE SIZE + MOVEI A,(E) ; A COPY IN A + IDIVI D,(E) ; D=> # OF BYTES IN WORD 1 + HRRZ E,(C) ; GET LENGTH + SUBM E,D ; # OF BYTES IN OTHER WORDS + JUMPL D,BYTDO1 ; NEAR DOPE WORD + MOVEI B,36. ; COMPUTE BYTES PER WORD + IDIVM B,A + ADDI D,-1(A) ; NOW COMPUTE WORDS + IDIVI D,(A) ; D/ # NO. OF WORDS PAST 1ST + ADD D,1(C) ; D POINTS TO DOPE WORD + MOVEI A,2(D) + +BYTDO2: POP P,E + POP P,D + POP P,B + POPJ P, +BYTDO1: MOVEI A,2(B) + JRST BYTDO2 + +; 1) IMPURIFY ITS OBLIST LIST + +IMPURX: HRRZ B,2(C) ; PICKUP OBLIST IF IT EXISTS + JUMPE B,IMPUR0 ; NOT ON ONE, IGNORE THIS CODE + + HRRO E,(B) + PUSH TP,$TOBLS ; SAVE BUCKET + PUSH TP,E + + MOVE B,(E) ; GET NEXT ONE +IMPUR4: MOVEI 0,(B) + MOVE D,1(B) + CAME D,-2(TP) + JRST .+3 + SKIPE GPURFL ; IF PURIFY SMASH THE OBLIST SLOT TO PROTECT + ; ATOM + HRRM D,1(B) + CAIGE 0,HIBOT ; SKIP IF PURE + JRST IMPUR3 ; FOUND IMPURE NESS, SKIP IT + HLLZ C,(B) ; SET UP ICONS CALL + HRRZ E,(B) +IMPR1: PUSHJ P,ICONS ; CONS IT UP +IMPR2: HRRZ E,(TP) ; RETRV PREV + HRRM B,(E) ; AND CLOBBER +IMPUR3: MOVE D,1(B) + CAMN D,-2(TP) ; HAVE GOTTEN TO OUR SLOT? + JRST IMPPR3 + MOVSI 0,TLIST + MOVEM 0,-1(TP) ; FIX TYPE + HRRZM B,(TP) ; STORE GOODIE + HRRZ B,(B) ; CDR IT + JUMPN B,IMPUR4 ; LOOP +IMPPR3: SUB TP,[2,,2] ; FLUSH TP CRUFT + +; 1.5) IMPURIFY GLOBAL HASH BUCKET, A REAL PAIN + +IMPUR0: MOVE C,(TP) ; GET ATOM + + HRRZ B,2(C) + MOVE B,(B) + ADD C,[3,,3] ; POINT TO PNAME + HLRE A,C ; GET LNTH IN WORDS OF PNAME + MOVNS A +; PUSH P,[SETZ IMPUR2] ; FAKE OUT ILOOKC + XMOVEI 0,IMPUR2 + PUSH P,0 + PUSH P,(C) ; PUSH UP THE PNAME + AOBJN C,.-1 + PUSH P,A ; NOW THE COUNT + MOVSI A,TOBLS + JRST ILOOKC ; GO FIND BUCKET + +IMPUR2: JUMPE B,IMPUR1 + JUMPE 0,IMPUR1 ; YUP, DONE + HRRZ C,0 + CAIG C,HIBOT ; SKIP IF PREV IS PURE + JRST IMPUR1 + + MOVE B,0 + PUSH P,GPURFL ; PRERTEND OUT OF PURIFY + HLRE C,B + SUBM B,C + HRRZ C,(C) ; ARE WE ON PURIFY LIST + CAIG C,HIBOT ; IF SO, WE ARE STILL PURIFY + SETZM GPURFL + PUSHJ P,IMPURIF ; RECURSE + POP P,GPURFL + MOVE B,(TP) ; AND RETURN ORIGINAL + +; 2) GENERATE A DUPLICATE ATOM + +IMPUR1: SKIPE GPURFL ; SEE IF IN PURIFY + JRST IMPUR7 + HLRE A,(TP) ; GET LNTH OF ATOM + MOVNS A + PUSH P,A + PUSHJ P,IBLOCK ; GET NEW BLOCK FOR ATOM + PUSH TP,$TATOM + PUSH TP,B + HRL B,-2(TP) ; SETUP BLT + POP P,A + ADDI A,(B) ; END OF BLT + BLT B,(A) ; CLOBBER NEW ATOM + MOVSI B,.VECT. ; TURN ON BIT FOR GCHACK + IORM B,(A) + +; 3) NOW COPY GLOBAL VALUE + +IMPUR7: MOVE B,(TP) ; ATOM BACK + GETYP 0,(B) + SKIPE A,1(B) ; NON-ZER POINTER? + CAIN 0,TUNBOU ; BOUND? + JRST IMPUR5 ; NO, DONT COPY GLOB VAL + PUSH TP,(A) + PUSH TP,1(A) + PUSH TP,$TATOM + PUSH TP,B + SETZM (B) + SETZM 1(B) + SKIPN GPURFL ; HERE IS SOME CODE NEEDED FOR PURIFY + JRST IMPUR8 + PUSH P,LPVP + MOVE PVP,PVSTOR+1 + PUSH P,AB ; GET AB BACK + MOVE AB,ABSTO+1(PVP) +IMPUR8: PUSHJ P,BSETG ; SETG IT + SKIPN GPURFL + JRST .+3 ; RESTORE SP AND AB FOR PURIFY + POP P,TYPNT + POP P,SP + SUB TP,[2,,2] ; KILL ATOM SLOTS ON TP + POP TP,C ;POP OFF VALUE SLOTS + POP TP,A + MOVEM A,(B) ; FILL IN SLOTS ON GLOBAL STACK + MOVEM C,1(B) +IMPUR5: SKIPE GPURFL ; FINISH OFF DIFFERENTLY FOR PURIFY + JRST IMPUR9 + + PUSH TP,$TFIX ;SAVE OLD ATOM WITH FUNNY TYPE TO AVOID LOSSAGE + PUSH TP,-3(TP) + PUSH TP,$TFIX ; OTHER KIND OF POINTER ALSO + HLRE 0,-1(TP) + HRRZ A,-1(TP) + SUB A,0 + PUSH TP,A + +; 4) UPDATE ALL POINTERS TO THIS ATOM + + MOVE A,[PUSHJ P,ATFIX] ; INS TO PASS TO GCHACK + MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + SUB TP,[6,,6] + +RTNATM: POP TP,B + POP TP,A + POPJ P, + +IMPUR9: SUB TP,[2,,2] + POPJ P, ; RESTORE AND GO + + + +END diff --git a//atomhk.mid.150 b//atomhk.mid.150 new file mode 100644 index 0000000..3bb9765 --- /dev/null +++ b//atomhk.mid.150 @@ -0,0 +1,1198 @@ + +TITLE ATOMHACKER FOR MUDDLE + +RELOCATABLE + +.INSRT MUDDLE > +.GLOBAL RLOOKU,CHMAK,OBLNT,ROOT,INTOBL,ERROBL,IFALSE,PVSTOR,SPSTOR +.GLOBAL .BLOCK,IDVAL,NXTDCL,CHRWRD,CSTACK,CSTAK,ILOOKC,IGVAL,BYTDOP,HASHTB +.GLOBAL ICONS,INCONS,IBLOCK,INSRTX,GCHACK,IMPURIFY,BSETG,TYPVEC,IGET,IPUT +.GLOBAL CINSER,CIRMV,CLOOKU,CATOM,CIPNAM,MPOPJ,CSETG,CSPNAM,GPURFL,IMPURX + +LPVP==SP +TYPNT==AB +LNKBIT==200000 + +; FUNCTION TO GENERATE AN EMPTY OBLIST + +MFUNCTION MOBLIST,SUBR + + ENTRY + CAMGE AB,[-5,,0] ;CHECK NUMBER OF ARGS + JRST TMA + JUMPGE AB,MOBL2 ; NO ARGS + MOVE A,(AB) + MOVE B,1(AB) + MOVSI C,TATOM + MOVE D,IMQUOTE OBLIST + PUSHJ P,IGET ; CHECK IF IT EXISTS ALREADY + CAMN A,$TOBLS + JRST FINIS +MOBL2: + MOVEI A,1 + PUSHJ P,IBLOCK ;GET A UNIFORM VECTOR + MOVSI C,TLIST+.VECT. ;IT IS OF TYPE LIST + HLRE D,B ;-LENGTH TO D + SUBM B,D ;D POINTS TO DOPE WORD + MOVEM C,(D) ;CLOBBER TYPE IN + MOVSI A,TOBLS + JUMPGE AB,FINIS ; IF NO ARGS, DONE + GETYP A,(AB) + CAIE A,TATOM + JRST WTYP1 + MOVSI A,TOBLS + PUSH TP,$TOBLS + PUSH TP,B + MOVSI C,TATOM + MOVE D,IMQUOTE OBLIST + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,IPUT ; PUT THE NAME ON THE OBLIST + MOVE A,(AB) + MOVE B,1(AB) + MOVSI C,TATOM + MOVE D,IMQUOTE OBLIST + PUSH TP,(TB) + PUSH TP,1(TB) + PUSHJ P,IPUT ; PUT THE OBLIST ON THE NAME + + POP TP,B + POP TP,A + JRST FINIS + +MFUNCTION GROOT,SUBR,ROOT + ENTRY 0 + MOVE A,ROOT + MOVE B,ROOT+1 + JRST FINIS + +MFUNCTION GINTS,SUBR,INTERRUPTS + ENTRY 0 + MOVE A,INTOBL + MOVE B,INTOBL+1 + JRST FINIS + +MFUNCTION GERRS,SUBR,ERRORS + ENTRY 0 + MOVE A,ERROBL + MOVE B,ERROBL+1 + JRST FINIS + + +COBLQ: SKIPN B,2(B) ; SKIP IF EXISTS + JRST IFLS + MOVSI A,TOBLS + + ANDI B,-1 + CAMG B,VECBOT ; TVP IS IN FROZEN SPACE, NEVER OBLISTS + MOVE B,(B) + HRLI B,-1 + +CPOPJ1: AOS (P) + POPJ P, + +IFLS: MOVEI B,0 + MOVSI A,TFALSE + POPJ P, + +MFUNCTION OBLQ,SUBR,[OBLIST?] + + ENTRY 1 + GETYP A,(AB) + CAIE A,TATOM + JRST WTYP1 + MOVE B,1(AB) ; GET ATOM + PUSHJ P,COBLQ + JFCL + JRST FINIS + + ; FUNCTION TO FIND AN ATOM ON A GIVEN OBLIST WITH A GIVEN PNAME + +MFUNCTION LOOKUP,SUBR + + ENTRY 2 + PUSHJ P,ILOOKU ;CALL INTERNAL ROUTINE + JRST FINIS + +CLOOKU: SUBM M,(P) + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + PUSH TP,$TOBLS + PUSH TP,C + GETYP A,A + PUSHJ P,CSTAK + MOVE B,(TP) + MOVSI A,TOBLS ; THIS IS AN OBLIST + PUSHJ P,ILOOK + POP P,D + HRLI D,(D) + SUB P,D + SKIPE B + SOS (P) + SUB TP,[4,,4] + JRST MPOPJ + +ILOOKU: PUSHJ P,ARGCHK ;CHECK ARGS + PUSHJ P,CSTACK ;PUT CHARACTERS ON THE STACK + +CALLIT: MOVE B,3(AB) ;GET OBLIST + MOVSI A,TOBLS +ILOOKC: PUSHJ P,ILOOK ;LOOK IT UP + POP P,D ;RESTORE COUNT + HRLI D,(D) ;TO BOTH SIDES + SUB P,D + POPJ P, + +;THIS ROUTINE CHECKS ARG TYPES + +ARGCHK: GETYP A,(AB) ;GET TYPES + GETYP C,2(AB) + CAIE A,TCHRS ;IS IT EITHER CHAR STRING + CAIN A,TCHSTR + CAIE C,TOBLS ;IS 2ND AN OBLIST + JRST WRONGT ;TYPES ARE WRONG + POPJ P, + +;THIS SUBROUTINE PUTS CHARACTERS ON THE STACK (P WILL BE CHANGED) + + +CSTACK: MOVEI B,(AB) +CSTAK: POP P,D ;RETURN ADDRESS TO D + CAIE A,TCHRS ;IMMEDIATE? + JRST NOTIMM ;NO, HAIR + MOVE A,1(B) ; GET CHAR + LSH A,29. ; POSITION + PUSH P,A ;ONTO P + PUSH P,[1] ;WITH NUMBER + JRST (D) ;GO CALL SEARCHER + +NOTIMM: MOVEI A,1 ; CLEAR CHAR COUNT + MOVE C,(B) ; GET COUNT OF CHARS + TRNN C,-1 + JRST NULST ; FLUSH NULL STRING + MOVE PVP,PVSTOR+1 + MOVEM C,BSTO(PVP) + ANDI C,-1 + MOVE B,1(B) ;GET BYTE POINTER + +CLOOP1: PUSH P,[0] ; STORE CHARS ON STACK + MOVSI E,(<440700,,(P)>) ; SETUP BYTE POINTER +CLOOP: SKIPL INTFLG ; SO CAN WIN WITH INTERRUPTS + JRST CLOOP2 + MOVE PVP,PVSTOR+1 + HRRM C,BSTO(PVP) ;SAVE STRING LENGTH + JSR LCKINT +CLOOP2: ILDB 0,B ;GET A CHARACTER + IDPB 0,E ;STORE IT + SOJE C,CDONE ; ANY MORE? + TLNE E,760000 ; WORD FULL + JRST CLOOP ;NO CONTINUE + AOJA A,CLOOP1 ;AND CONTINUE + +CDONE: +CDONE1: MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + PUSH P,A ;AND NUMBER OF WORDS + JRST (D) ;RETURN + + +NULST: ERRUUO EQUOTE NULL-STRING + ; THIS FUNCTION LOOKS FOR ATOMS. CALLED BY PUSHJ P,ILOOK +; A,B/ OBLIST POINTER (CAN BE LIST OF SAME) +; -1(P)/ LENGTH IN WORDS OF CHARACTER BLOCK +; CHAR STRING IS ON THE STACK +; IF ATOM EXISTS RETURNS: +; B/ THE ATOM +; C/ THE BUCKET +; 0/ THE PREVIOUS BUCKET +; +; IF NOT +; B/ 0 +; 0/ PREV IF ONE WITH SAME PNAME, ELSE 0 +; C/ BUCKET + +ILOOK: PUSH TP,A + PUSH TP,B + + MOVN A,-1(P) ;GET -LENGTH + HRLI A,-1(A) ;<-LENGTH-1>,,-LENGTH + PUSH TP,$TFIX ;SAVE + PUSH TP,A + ADDI A,-1(P) ;HAVE AOBJN POINTER TO CHARS + MOVE 0,[202622077324] ;HASH WORD + ROT 0,1 + TSC 0,(A) + AOBJN A,.-2 ;XOR THEM ALL TOGETHER + HLRE A,HASHTB+1 + MOVNS A + MOVMS 0 ; MAKE SURE + HASH CODE + IDIVI 0,(A) ;DIVIDE + HRLI A,(A) ;TO BOTH HALVES + ADD A,HASHTB+1 + + MOVE C,A + HRRZ A,(A) ; POINT TO FIRST ATOM + SETZB E,0 ; INDICATE NO ATOM + + JUMPE A,NOTFND +LOOK2: HLRZ E,1(A) ; PREPARE TO BUILD AOBJN + ANDI E,377777 ; SIGN MIGHT BE ON IF IN PURIFY ETC. + SUBI E,2 + HRLS E + SUBB A,E + + ADD A,[3,,3] ;POINT TO ATOMS PNAME + MOVE D,(TP) ;GET PSEUDO AOBJN POINTER TO CHARS + ADDI D,-1(P) ;NOW ITS A REAL AOBJN POINTER + JUMPE D,CHECK0 ;ONE IS EMPTY +LOOK1: + MOVE SP,(D) + CAME SP,(A) + + JRST NEXT1 ;THIS ONE DOESN'T MATCH + AOBJP D,CHECK ;ONE RAN OUT + AOBJN A,LOOK1 ;JUMP IF STILL MIGHT WIN + +NEXT1: HRRZ A,-1(TP) ; SEE IF WE'VE ALREADY SEEN THIS NAME + GETYP D,-3(TP) ; SEE IF LIST OF OBLISTS + CAIN D,TLIST + JUMPN A,CHECK3 ; DON'T LOOK FURTHER + JUMPN A,NOTFND +NEXT: + MOVE 0,E + HLRZ A,2(E) ; NEXT ATOM + JUMPN A,LOOK2 + HRRZ A,-1(TP) + JUMPN A,NEXT1 + + SETZB E,0 + +NOTFND: + MOVEI B,0 + MOVSI A,TFALSE +CPOPJT: + + SUB TP,[4,,4] + POPJ P, + +CHECK0: JUMPN A,NEXT1 ;JUMP IF NOT ALSO EMPTY + SKIPA +CHECK: AOBJN A,NEXT1 ;JUMP IF NO MATCH + +CHECK5: HRRZ A,-1(TP) ; SEE IF FIRST SHOT AT THIS GUY? + SKIPN A + MOVE B,0 ; REMEMBER ATOM FOR FALL BACK + HLLOS -1(TP) ; INDICATE NAME MATCH HAS OCCURRED + HRRZ A,2(E) ; COMPUTE OBLIST POINTER + CAMGE A,VECBOT + MOVE A,(A) + HRROS A + GETYP D,-3(TP) ; SEE IF LIST OF OBLISTS OR + CAIE D,TOBLS + JRST CHECK1 + CAME A,-2(TP) ; DO OBLISTS MATCH? + JRST NEXT + +CHECK2: MOVE B,E ; RETURN ATOM + HLRE A,B + SUBM B,A + MOVE A,(A) + TRNE A,LNKBIT + SKIPA A,$TLINK + MOVSI A,TATOM + JRST CPOPJT + +CHECK1: MOVE D,-2(TP) ; ANY LEFT? + CAMN A,1(D) ; MATCH + JRST CHECK2 + JRST NEXT + +CHECK3: MOVE D,-2(TP) + HRRZ D,(D) + MOVEM D,-2(TP) + JUMPE D,NOTFND + JUMPE B,CHECK6 + HLRZ E,2(B) +CHECK7: HLRZ A,1(E) + ANDI A,377777 ; SIGN MIGHT BE ON IF IN PURIFY ETC. + SUBI A,2 + HRLS A + SUBB E,A + JRST CHECK5 + +CHECK6: HRRZ E,(C) + JRST CHECK7 + + ; FUNCTION TO INSERT AN ATOM ON AN OBLIST + +MFUNCTION INSERT,SUBR + + ENTRY 2 + GETYP A,2(AB) + CAIE A,TOBLS + JRST WTYP2 + MOVE A,(AB) + MOVE B,1(AB) + MOVE C,3(AB) + PUSHJ P,IINSRT + JRST FINIS + +CINSER: SUBM M,(P) + PUSHJ P,IINSRT + JRST MPOPJ + +IINSRT: PUSH TP,A + PUSH TP,B + PUSH TP,$TOBLS + PUSH TP,C + GETYP A,A + CAIN A,TATOM + JRST INSRT0 + +;INSERT WITH A GIVEN PNAME + + CAIE A,TCHRS + CAIN A,TCHSTR + JRST .+2 + JRST WTYP1 + + PUSH TP,$TFIX ;FLAG CALL + PUSH TP,[0] + MOVEI B,-5(TP) + PUSHJ P,CSTAK ;COPY ONTO STACK + MOVE B,-2(TP) + MOVSI A,TOBLS + PUSHJ P,ILOOK ;LOOK IT UP (BUCKET RETURNS IN C) + SETZM -4(TP) + SETZM -5(TP) ; KILL STRING POINTER TO KEEP FROM CONFUSING GC + JUMPN B,ALRDY ;EXISTS, LOSE + MOVE D,-2(TP) ; GET OBLIST BACK +INSRT1: PUSH TP,$TATOM + PUSH TP,0 ; PREV ATOM + PUSH TP,$TUVEC ;SAVE BUCKET POINTER + PUSH TP,C + PUSH TP,$TOBLS + PUSH TP,D ; SAVE OBLIST +INSRT3: PUSHJ P,IATOM ; MAKE AN ATOM + HLRE A,B ; FIND DOPE WORD + SUBM B,A + ANDI A,-1 + SKIPN E,-4(TP) ; AFTER AN ATOM? + JRST INSRT7 ; NO, FIRST IN BUCKET + MOVEI 0,(E) ; CHECK IF PURE + CAIG 0,HIBOT + JRST INSRNP + PUSH TP,$TATOM ; SAVE NEW ATOM + PUSH TP,B + MOVE B,E + PUSHJ P,IMPURIF + MOVE B,(TP) + MOVE E,-6(TP) + SUB TP,[2,,2] + HLRE A,B ; FIND DOPE WORD + SUBM B,A + ANDI A,-1 + +INSRNP: HLRZ 0,2(E) ; NEXT + HRLM A,2(E) ; SPLICE + HRLM 0,2(B) + JRST INSRT8 + +INSRT7: MOVE E,-2(TP) + EXCH A,(E) + HRLM A,2(B) ; IN CASE OLD ONE + +INSRT8: MOVE E,(TP) ; GET OBLIST + HRRM E,2(B) ; STORE OBLIST + MOVE E,(E) ; POINT TO LIST OF ATOMS + PUSHJ P,LINKCK + PUSHJ P,ICONS + MOVE E,(TP) + HRRM B,(E) ;INTO NEW BUCKET + MOVSI A,TATOM + MOVE B,1(B) ;GET ATOM BACK + MOVE C,-6(TP) ;GET FLAG + SUB TP,[8,,8] ;POP STACK + JUMPN C,(C) + SUB TP,[4,,4] + POPJ P, + +;INSERT WITH GIVEN ATOM +INSRT0: MOVE A,-2(TP) ;GOBBLE PNAME + SKIPE 2(A) ; SKIP IF NOT ON AN OBLIST + JRST ONOBL + ADD A,[3,,3] + HLRE C,A + MOVNS C + PUSH P,(A) ;FLUSH PNAME ONTO P STACK + AOBJN A,.-1 + PUSH P,C + MOVE B,(TP) ; GET OBLIST FOR LOOKUP + MOVSI A,TOBLS + PUSHJ P,ILOOK ;ALREADY THERE? + JUMPN B,ALRDY + MOVE D,-2(TP) + + HLRE A,-2(TP) ; FIND DOPE WORD + SUBM D,A ; TO A + JUMPE 0,INSRT9 ; NO CURRENT ATOM + MOVE E,0 + MOVEI 0,(E) + CAIGE 0,HIBOT ; PURE? + JRST INSRPN + PUSH TP,$TATOM + PUSH TP,E + PUSH TP,$TATOM + PUSH TP,D + MOVE B,E + PUSHJ P,IMPURIF + MOVE D,(TP) + MOVE E,-2(TP) + SUB TP,[4,,4] + HLRE A,D + SUBM D,A + + +INSRPN: HLRZ 0,2(E) ; POINT TO NEXT + HRLM A,2(E) ; CLOBBER NEW GUY IN + HRLM 0,2(D) ; FINISH SLPICE + JRST INSRT6 + +INSRT9: ANDI A,-1 + EXCH A,(C) ; INTO BUCKET + HRLM A,2(D) + +INSRT6: HRRZ E,(TP) + HRRZ E,(E) + MOVE B,D + PUSHJ P,LINKCK + PUSHJ P,ICONS + MOVE C,(TP) ;RESTORE OBLIST + HRRZM B,(C) + MOVE B,-2(TP) ; GET BACK ATOM + HRRM C,2(B) ; CLOBBER OBLIST IN + MOVSI A,TATOM + SUB TP,[4,,4] + POP P,C + HRLI C,(C) + SUB P,C + POPJ P, + +LINKCK: HRRZ C,FSAV(TB) ;CALLER'S NAME + MOVE D,B + CAIE C,LINK + SKIPA C,$TATOM ;LET US INSERT A LINK INSTEAD OF AN ATOM + SKIPA C,$TLINK ;GET REAL ATOM FOR CALL TO ICONS + POPJ P, + HLRE A,D + SUBM D,A + MOVEI B,LNKBIT + IORM B,(A) + POPJ P, + + +ALRDY: ERRUUO EQUOTE ATOM-ALREADY-THERE + +ONOBL: ERRUUO EQUOTE ON-AN-OBLIST-ALREADY + +; INTERNAL INSERT CALL + +INSRTX: POP P,0 ; GET RET ADDR + PUSH TP,$TFIX + PUSH TP,0 + PUSH TP,$TATOM + PUSH TP,[0] + PUSH TP,$TUVEC + PUSH TP,[0] + PUSH TP,$TOBLS + PUSH TP,B + MOVSI A,TOBLS + PUSHJ P,ILOOK + JUMPN B,INSRXT + MOVEM 0,-4(TP) + MOVEM C,-2(TP) + JRST INSRT3 ; INTO INSERT CODE + +INSRXT: PUSH P,-4(TP) + SUB TP,[6,,6] + POPJ P, + JRST IATM1 + +; FUNCTION TO REMOVE AN ATOM FROM AN OBLIST + +MFUNCTION REMOVE,SUBR + + ENTRY + + JUMPGE AB,TFA + CAMGE AB,[-5,,] + JRST TMA + MOVEI C,0 + CAML AB,[-3,,] ; SKIP IF OBLIST GIVEN + JRST .+5 + GETYP 0,2(AB) + CAIE 0,TOBLS + JRST WTYP2 + MOVE C,3(AB) + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,IRMV + JRST FINIS + +CIRMV: SUBM M,(P) + PUSHJ P,IRMV + JRST MPOPJ + +IRMV: PUSH TP,A + PUSH TP,B + PUSH TP,$TOBLS + PUSH TP,C +IRMV1: GETYP 0,A ; CHECK 1ST ARG + CAIN 0,TLINK + JRST .+3 + CAIE 0,TATOM ; ATOM, TREAT ACCORDINGLY + JRST RMV1 + + HRRZ D,2(B) ; SKIP IF ON OBLIST AND GET SAME + JUMPE D,RMVDON + CAMG D,VECBOT ; SKIP IF REAL OBLIST + HRRZ D,(D) ; NO, REF, GET IT + + JUMPGE C,GOTOBL + CAIE D,(C) ; BETTER BE THE SAME + JRST ONOTH + +GOTOBL: ADD B,[3,,3] ; POINT TO PNAME + HLRE A,B + MOVNS A + PUSH P,(B) ; PUSH PNAME + AOBJN B,.-1 + PUSH P,A + HRROM D,(TP) ; SAVE OBLIST + JRST RMV3 + +RMV1: JUMPGE C,TFA + CAIE 0,TCHRS + CAIN 0,TCHSTR + SKIPA A,0 + JRST WTYP1 + MOVEI B,-3(TP) + PUSHJ P,CSTAK +RMV3: MOVE B,(TP) + MOVSI A,TOBLS + PUSHJ P,ILOOK + POP P,D + HRLI D,(D) + SUB P,D + JUMPE B,RMVDON + + MOVEI A,(B) + CAIGE A,HIBOT ; SKIP IF PURE + JRST RMV2 + PUSH TP,$TATOM + PUSH TP,0 + PUSHJ P,IMPURIFY + MOVE 0,(TP) + SUB TP,[2,,2] + MOVE A,-3(TP) + MOVE B,-2(TP) + MOVE C,(TP) + JRST IRMV1 + +RMV2: JUMPN 0,RMV9 ; JUMP IF FIRST NOT IN BUCKET + HLRZ 0,2(B) ; POINT TO NEXT + MOVEM 0,(C) + JRST RMV8 + +RMV9: MOVE C,0 ; C IS PREV ATOM + HLRZ 0,2(B) ; NEXT + HRLM 0,2(C) + +RMV8: SETZM 2(B) ; CLOBBER OBLIST SLOT + MOVE C,(TP) ; GET OBLIST FOR SPLICE OUT + MOVEI 0,-1 + HRRZ E,(C) + +RMV7: JUMPE E,RMVDON + CAMN B,1(E) ; SEARCH OBLIST + JRST RMV6 + MOVE C,E + HRRZ E,(C) + SOJG 0,RMV7 + +RMVDON: SUB TP,[4,,4] + MOVSI A,TATOM + POPJ P, + +RMV6: HRRZ E,(E) + HRRM E,(C) ; SMASH IN + JRST RMVDON + + +;INTERNAL CALL FROM THE READER + +RLOOKU: PUSH TP,$TFIX ;PUSH A FLAG + POP P,C ;POP OFF RET ADR + PUSH TP,C ;AND USE AS A FLAG FOR INTERNAL + MOVE C,(P) ; CHANGE CHAR COUNT TO WORD + ADDI C,4 + IDIVI C,5 + MOVEM C,(P) + GETYP D,A + + CAIN D,TOBLS ;IS IT ONE OBLIST? + JRST .+3 + CAIE D,TLIST ;IS IT A LIST + JRST BADOBL + + JUMPE B,BADLST + PUSH TP,$TUVEC ; SLOT FOR REMEBERIG + PUSH TP,[0] + PUSH TP,$TOBLS + PUSH TP,[0] + PUSH TP,A + PUSH TP,B + CAIE D,TLIST + JRST RLOOK1 + + PUSH TP,$TLIST + PUSH TP,B +RLOOK2: GETYP A,(B) ;CHECK THIS IS AN OBLIST + CAIE A,TOBLS + JRST DEFALT + + SKIPE -4(TP) ; SKIP IF DEFAULT NOT STORED + JRST RLOOK4 + MOVE D,1(B) ; OBLIST + MOVEM D,-4(TP) +RLOOK4: INTGO + HRRZ B,@(TP) ;CDR THE LIST + HRRZM B,(TP) + JUMPN B,RLOOK2 + SUB TP,[2,,2] + JRST .+3 + +RLOOK1: MOVE B,(TP) + MOVEM B,-2(TP) + MOVE A,-1(TP) + MOVE B,(TP) + PUSHJ P,ILOOK + JUMPN B,RLOOK3 + SKIPN D,-2(TP) ; RESTORE FOR INSERT + JRST BADDEF ; NO DEFAULT, USER LOST ON SPECIFICATION + SUB TP,[6,,6] ; FLUSH CRAP + SKIPN NOATMS + JRST INSRT1 + JRST INSRT1 + +DEFFLG==1 ;SPECIAL FLAG USED TO INDICATE THAT A DEFAULT HAS ALREADY BEEN + ; SPECIFIED +DEFALT: MOVE 0,1(B) + CAIN A,TATOM ;SPECIAL DEFAULT INDICATING ATOM ? + CAME 0,MQUOTE DEFAULT + JRST BADDEF ;NO, LOSE + MOVEI A,DEFFLG + XORB A,-11(TP) ;SET AND TEST FLAG + TRNN A,DEFFLG ; HAVE WE BEEN HERE BEFORE ? + JRST BADDEF ; YES, LOSE + SETZM -6(TP) ;ZERO OUT PREVIOUS DEFAULT + SETZM -4(TP) + JRST RLOOK4 ;CONTINUE + + +INSRT2: JRST .+2 ; +RLOOK3: SUB TP,[6,,6] ;POP OFF LOSSAGE + PUSHJ P,ILINK ;IF THIS IS A LINK FOLLOW IT + PUSH P,(TP) ;GET BACK RET ADR + SUB TP,[2,,2] ;POP TP + JRST IATM1 ;AND RETURN + + +BADOBL: ERRUUO EQUOTE BAD-OBLIST-OR-LIST-THEREOF + +BADDEF: ERRUUO EQUOTE BAD-DEFAULT-OBLIST-SPECIFICATION + +ONOTH: ERRUUO EQUOTE ATOM-ON-DIFFERENT-OBLIST + ;SUBROUTINE TO MAKE AN ATOM + +IMFUNCTION ATOM,SUBR + + ENTRY 1 + + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,IATOMI + JRST FINIS + +CATOM: SUBM M,(P) + PUSHJ P,IATOMI + JRST MPOPJ + +IATOMI: GETYP 0,A ;CHECK ARG TYPE + CAIE 0,TCHRS + CAIN 0,TCHSTR + JRST .+2 ;JUMP IF WINNERS + JRST WTYP1 + + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + MOVE A,0 + PUSHJ P,CSTAK ;COPY ONTO STACK + PUSHJ P,IATOM ;NOW MAKE THE ATOM + SUB TP,[2,,2] + POPJ P, + +;INTERNAL ATOM MAKER + +IATOM: MOVE A,-1(P) ;GET WORDS IN PNAME + ADDI A,3 ;FOR VALUE CELL + PUSHJ P,IBLOCK ; GET BLOCK + MOVSI C,<(GENERAL)>+SATOM ;FOR TYPE FIELD + MOVE D,-1(P) ;RE-GOBBLE LENGTH + ADDI D,3(B) ;POINT TO DOPE WORD + MOVEM C,(D) + SKIPG -1(P) ;EMPTY PNAME ? + JRST IATM0 ;YES, NO CHARACTERS TO MOVE + MOVE E,B ;COPY ATOM POINTER + ADD E,[3,,3] ;POINT TO PNAME AREA + MOVEI C,-1(P) + SUB C,-1(P) ;POINT TO STRING ON STACK + MOVE D,(C) ;GET SOME CHARS + MOVEM D,(E) ;AND COPY THEM + ADDI C,1 + AOBJN E,.-3 +IATM0: MOVSI A,TATOM ;TYPE TO ATOM +IATM1: POP P,D ;RETURN ADR + POP P,C + HRLI C,(C) + SUB P,C + JRST (D) ;RETURN + + ;SUBROUTINE TO GET AN ATOM'S PNAME + +MFUNCTION PNAME,SUBR + + ENTRY 1 + + GETYP A,(AB) + CAIE A,TATOM ;CHECK TYPE IS ATOM + JRST WTYP1 + MOVE A,1(AB) + PUSHJ P,IPNAME + JRST FINIS + +CIPNAM: SUBM M,(P) + PUSHJ P,IPNAME + JRST MPOPJ + +IPNAME: ADD A,[3,,3] + HLRE B,A + MOVM B,B + PUSH P,(A) ;FLUSH PNAME ONTO P + AOBJN A,.-1 + MOVE 0,(P) ; LAST WORD + PUSHJ P,PNMCNT + PUSH P,B + PUSHJ P,CHMAK ;MAKE A STRING + POPJ P, + +PNMCNT: IMULI B,5 ; CHARS TO B + MOVE A,0 + SUBI A,1 ; FIND LAST 1 + ANDCM 0,A ; 0 HAS 1ST 1 + JFFO 0,.+1 + HRREI 0,-34.(A) ; FIND HOW MUCH TO ADD + IDIVI 0,7 + ADD B,0 + POPJ P, + +MFUNCTION SPNAME,SUBR + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP1 + + MOVE B,1(AB) + PUSHJ P,CSPNAM + JRST FINIS + +CSPNAM: ADD B,[3,,3] + MOVEI D,(B) + HLRE A,B + SUBM B,A + MOVE 0,-1(A) + HLRES B + MOVMS B + PUSHJ P,PNMCNT + MOVSI A,TCHSTR + HRRI A,(B) + MOVSI B,010700 + HRRI B,-1(D) + POPJ P, + + ; BLOCK STRUCTURE SUBROUTINES FOR MUDDLE + +IMFUNCTION BLK,SUBR,BLOCK + + ENTRY 1 + + GETYP A,(AB) ;CHECK TYPE OF ARG + CAIE A,TOBLS ;IS IT AN OBLIST + CAIN A,TLIST ;OR A LIAT + JRST .+2 + JRST WTYP1 + MOVSI A,TATOM ;LOOK UP OBLIST + MOVE B,IMQUOTE OBLIST + PUSHJ P,IDVAL ;GET VALUE + PUSH TP,A + PUSH TP,B + MOVE PVP,PVSTOR+1 + PUSH TP,.BLOCK(PVP) ;HACK THE LIST + PUSH TP,.BLOCK+1(PVP) + MCALL 2,CONS ;CONS THE LIST + MOVE PVP,PVSTOR+1 + MOVEM A,.BLOCK(PVP) ;STORE IT BACK + MOVEM B,.BLOCK+1(PVP) + PUSH TP,$TATOM + PUSH TP,IMQUOTE OBLIST + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,SET ;SET OBLIST TO ARG + JRST FINIS + +MFUNCTION ENDBLOCK,SUBR + + ENTRY 0 + + MOVE PVP,PVSTOR+1 + SKIPN B,.BLOCK+1(PVP) ;IS THE LIST NIL? + JRST BLKERR ;YES, LOSE + HRRZ C,(B) ;CDR THE LIST + HRRZM C,.BLOCK+1(PVP) + PUSH TP,$TATOM ;NOW RESET OBLIST + PUSH TP,IMQUOTE OBLIST + HLLZ A,(B) ;PUSH THE TYPE OF THE CAR + PUSH TP,A + PUSH TP,1(B) ;AND VALUE OF CAR + MCALL 2,SET + JRST FINIS + +BLKERR: ERRUUO EQUOTE UNMATCHED + +BADLST: ERRUUO EQUOTE NIL-LIST-OF-OBLISTS + ;SUBROUTINE TO CREATE CHARACTER STRING GOODIE + +CHMAK: MOVE A,-1(P) + ADDI A,4 + IDIVI A,5 + PUSHJ P,IBLOCK + MOVEI C,-1(P) ;FIND START OF CHARS + HLRE E,B ; - LENGTH + ADD C,E ;C POINTS TO START + MOVE D,B ;COPY VECTOR RESULT + JUMPGE D,NULLST ;JUMP IF EMPTY + MOVE A,(C) ;GET ONE + MOVEM A,(D) + ADDI C,1 ;BUMP POINTER + AOBJN D,.-3 ;COPY +NULLST: MOVSI C,TCHRS+.VECT. ;GET TYPE + MOVEM C,(D) ;CLOBBER IT IN + MOVE A,-1(P) ; # WORDS + HRLI A,TCHSTR + HRLI B,010700 + MOVMM E,-1(P) ; SO IATM1 WORKS + SOJA B,IATM1 ;RETURN + +; SUBROUTINE TO READ FIVE CHARS FROM STRING. +; TWO CALLS, ONE WITH A POINTING TO LIST ELEMENT, +; THE OTHER WITH B POINTING TO PAIR. SKIPS IF WINNER, ELSE DOESNT + +NXTDCL: GETYP B,(A) ;CHECK TYPE + CAIE B,TDEFER ;LOSE IF NOT DEFERRED + POPJ P, + + MOVE B,1(A) ;GET REAL BYTE POINTER +CHRWRD: PUSH P,C + GETYP C,(B) ;CHECK IT IS CHSTR + CAIE C,TCHSTR + JRST CPOPJC ;NO, QUIT + PUSH P,D + PUSH P,E + PUSH P,0 + MOVEI E,0 ;INITIALIZE DESTINATION + HRRZ C,(B) ; GET CHAR COUNT + JUMPE C,GOTDCL ; NULL, FINISHED + MOVE B,1(B) ;GET BYTE POINTER + MOVE D,[440700,,E] ;BYTE POINT TO E +CHLOOP: ILDB 0,B ; GET A CHR + IDPB 0,D ;CLOBBER AWAY + SOJE C,GOTDCL ; JUMP IF DONE + TLNE D,760000 ; SKIP IF WORD FULL + JRST CHLOOP ; MORE THAN 5 CHARS + TRO E,1 ; TURN ON FLAG + +GOTDCL: MOVE B,E ;RESULT TO B + AOS -4(P) ;SKIP RETURN +CPOPJ0: POP P,0 + POP P,E + POP P,D +CPOPJC: POP P,C + POPJ P, + + ;ROUTINES TO DEFINE AND HANDLE LINKS + +MFUNCTION LINK,SUBR + ENTRY + CAML AB,[-6,,0] ;NO MORE THAN 3 ARGS + CAML AB,[-2,,0] ;NO LESS THAN 2 ARGS + JRST WNA + CAML AB,[-4,,0] ;ONLY TWO ARGS SUPPLIED ? + JRST GETOB ;YES, GET OBLIST FROM CURRENT PATH + MOVE A,2(AB) + MOVE B,3(AB) + MOVE C,5(AB) + JRST LINKIN +GETOB: MOVSI A,TATOM + MOVE B,IMQUOTE OBLIST + PUSHJ P,IDVAL + CAMN A,$TOBLS + JRST LINKP + CAME A,$TLIST + JRST BADOBL + JUMPE B,BADLST + GETYPF A,(B) + MOVE B,(B)+1 +LINKP: MOVE C,B + MOVE A,2(AB) + MOVE B,3(AB) +LINKIN: PUSHJ P,IINSRT + CAMN A,$TFALSE ;LINK NAME ALREADY USED ? + JRST ALRDY ;YES, LOSE + MOVE C,B + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,CSETG + JRST FINIS + + +ILINK: HLRE A,B + SUBM B,A ;FOUND A LINK ? + MOVE A,(A) + TRNE A,LNKBIT + JRST .+3 + MOVSI A,TATOM + POPJ P, ;NO, FINISHED + MOVSI A,TATOM + PUSHJ P,IGVAL ;GET THE LINK'S DESTINATION + CAME A,$TUNBOUND ;WELL FORMED LINK ? + POPJ P, ;YES + ERRUUO EQUOTE BAD-LINK + + +; THIS SUBROUTINE IMPURIFIES A PURE ATOM TO ALLOW MODIFICATION OF SYSTEM SUBRS + +IMPURIFY: + PUSH TP,$TATOM + PUSH TP,B + MOVE C,B + MOVEI 0,(C) + CAIGE 0,HIBOT + JRST RTNATM ; NOT PURE, RETURN + JRST IMPURX + +; ROUTINE PASSED TO GCHACK + +ATFIX: CAME D,(TP) + CAMN D,-2(TP) + JRST .+2 + POPJ P, + + ASH C,1 + ADD C,TYPVEC+1 ; COMPUTE SAT + HRRZ C,(C) + ANDI C,SATMSK + CAIE C,SATOM +CPOPJ: POPJ P, + + SUB D,-2(TP) + ADD D,-4(TP) + SKIPE B + MOVEM D,1(B) + POPJ P, + + +; SUBROUTINE TO FIND A BYTE STRINGS DOPE WORD +; RECEIVES POINTER TO PAIR CONNTAINIGN CHSTR IN C, RETURNS DOPE WORD IN A + +BYTDOP: PUSH P,B ; SAVE SOME ACS + PUSH P,D + PUSH P,E + MOVE B,1(C) ; GET BYTE POINTER + LDB D,[360600,,B] ; POSITION TO D + LDB E,[300600,,B] ; AND BYTE SIZE + MOVEI A,(E) ; A COPY IN A + IDIVI D,(E) ; D=> # OF BYTES IN WORD 1 + HRRZ E,(C) ; GET LENGTH + SUBM E,D ; # OF BYTES IN OTHER WORDS + JUMPL D,BYTDO1 ; NEAR DOPE WORD + MOVEI B,36. ; COMPUTE BYTES PER WORD + IDIVM B,A + ADDI D,-1(A) ; NOW COMPUTE WORDS + IDIVI D,(A) ; D/ # NO. OF WORDS PAST 1ST + ADD D,1(C) ; D POINTS TO DOPE WORD + MOVEI A,2(D) + +BYTDO2: POP P,E + POP P,D + POP P,B + POPJ P, +BYTDO1: MOVEI A,2(B) + JRST BYTDO2 + +; 1) IMPURIFY ITS OBLIST LIST + +IMPURX: HRRZ B,2(C) ; PICKUP OBLIST IF IT EXISTS + JUMPE B,IMPUR0 ; NOT ON ONE, IGNORE THIS CODE + + HRRO E,(B) + PUSH TP,$TOBLS ; SAVE BUCKET + PUSH TP,E + + MOVE B,(E) ; GET NEXT ONE +IMPUR4: MOVEI 0,(B) + MOVE D,1(B) + CAME D,-2(TP) + JRST .+3 + SKIPE GPURFL ; IF PURIFY SMASH THE OBLIST SLOT TO PROTECT + ; ATOM + HRRM D,1(B) + CAIGE 0,HIBOT ; SKIP IF PURE + JRST IMPUR3 ; FOUND IMPURE NESS, SKIP IT + HLLZ C,(B) ; SET UP ICONS CALL + HRRZ E,(B) +IMPR1: PUSHJ P,ICONS ; CONS IT UP +IMPR2: HRRZ E,(TP) ; RETRV PREV + HRRM B,(E) ; AND CLOBBER +IMPUR3: MOVE D,1(B) + CAMN D,-2(TP) ; HAVE GOTTEN TO OUR SLOT? + JRST IMPPR3 + MOVSI 0,TLIST + MOVEM 0,-1(TP) ; FIX TYPE + HRRZM B,(TP) ; STORE GOODIE + HRRZ B,(B) ; CDR IT + JUMPN B,IMPUR4 ; LOOP +IMPPR3: SUB TP,[2,,2] ; FLUSH TP CRUFT + +; 1.5) IMPURIFY GLOBAL HASH BUCKET, A REAL PAIN + +IMPUR0: MOVE C,(TP) ; GET ATOM + + HRRZ B,2(C) + MOVE B,(B) + ADD C,[3,,3] ; POINT TO PNAME + HLRE A,C ; GET LNTH IN WORDS OF PNAME + MOVNS A +; PUSH P,[SETZ IMPUR2] ; FAKE OUT ILOOKC + XMOVEI 0,IMPUR2 + PUSH P,0 + PUSH P,(C) ; PUSH UP THE PNAME + AOBJN C,.-1 + PUSH P,A ; NOW THE COUNT + MOVSI A,TOBLS + JRST ILOOKC ; GO FIND BUCKET + +IMPUR2: JUMPE B,IMPUR1 + JUMPE 0,IMPUR1 ; YUP, DONE + HRRZ C,0 + CAIG C,HIBOT ; SKIP IF PREV IS PURE + JRST IMPUR1 + + MOVE B,0 + PUSH P,GPURFL ; PRERTEND OUT OF PURIFY + HLRE C,B + SUBM B,C + HRRZ C,(C) ; ARE WE ON PURIFY LIST + CAIG C,HIBOT ; IF SO, WE ARE STILL PURIFY + SETZM GPURFL + PUSHJ P,IMPURIF ; RECURSE + POP P,GPURFL + MOVE B,(TP) ; AND RETURN ORIGINAL + +; 2) GENERATE A DUPLICATE ATOM + +IMPUR1: SKIPE GPURFL ; SEE IF IN PURIFY + JRST IMPUR7 + HLRE A,(TP) ; GET LNTH OF ATOM + MOVNS A + PUSH P,A + PUSHJ P,IBLOCK ; GET NEW BLOCK FOR ATOM + PUSH TP,$TATOM + PUSH TP,B + HRL B,-2(TP) ; SETUP BLT + POP P,A + ADDI A,(B) ; END OF BLT + BLT B,(A) ; CLOBBER NEW ATOM + MOVSI B,.VECT. ; TURN ON BIT FOR GCHACK + IORM B,(A) + +; 3) NOW COPY GLOBAL VALUE + +IMPUR7: MOVE B,(TP) ; ATOM BACK + GETYP 0,(B) + SKIPE A,1(B) ; NON-ZER POINTER? + CAIN 0,TUNBOU ; BOUND? + JRST IMPUR5 ; NO, DONT COPY GLOB VAL + PUSH TP,(A) + PUSH TP,1(A) + PUSH TP,$TATOM + PUSH TP,B + SETZM (B) + SETZM 1(B) + SKIPN GPURFL ; HERE IS SOME CODE NEEDED FOR PURIFY + JRST IMPUR8 + PUSH P,LPVP + MOVE PVP,PVSTOR+1 + PUSH P,AB ; GET AB BACK + MOVE AB,ABSTO+1(PVP) +IMPUR8: PUSHJ P,BSETG ; SETG IT + SKIPN GPURFL + JRST .+3 ; RESTORE SP AND AB FOR PURIFY + POP P,TYPNT + POP P,SP + SUB TP,[2,,2] ; KILL ATOM SLOTS ON TP + POP TP,C ;POP OFF VALUE SLOTS + POP TP,A + MOVEM A,(B) ; FILL IN SLOTS ON GLOBAL STACK + MOVEM C,1(B) +IMPUR5: SKIPE GPURFL ; FINISH OFF DIFFERENTLY FOR PURIFY + JRST IMPUR9 + + PUSH TP,$TFIX ;SAVE OLD ATOM WITH FUNNY TYPE TO AVOID LOSSAGE + PUSH TP,-3(TP) + PUSH TP,$TFIX ; OTHER KIND OF POINTER ALSO + HLRE 0,-1(TP) + HRRZ A,-1(TP) + SUB A,0 + PUSH TP,A + +; 4) UPDATE ALL POINTERS TO THIS ATOM + + MOVE A,[PUSHJ P,ATFIX] ; INS TO PASS TO GCHACK + MOVEI PVP,1 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + SUB TP,[6,,6] + +RTNATM: POP TP,B + POP TP,A + POPJ P, + +IMPUR9: SUB TP,[2,,2] + POPJ P, ; RESTORE AND GO + + + +END diff --git a//bufmod.bin.2 b//bufmod.bin.2 new file mode 100644 index 0000000000000000000000000000000000000000..100f02e90034d0ebbc6b1126426f614ece038541 GIT binary patch literal 250 zcmZRuP+(wSc4Spea9{ueelv{#5Y1e#6JW%qz`&uwz{~*>Z~=>g)PWcvz+7)&78EAK z05X6#EP=hm0VK*VDwiP%VlXI0C-N5|4A5W%ihUQ>#LpQ^DB5^2E?d1fMk#j zNU(NdkN}F+r`OllGjIri-%Eme;+(PxMNIvDJu>a?OL Od4>d3ZSp{EU;qF!AtE~f literal 0 HcmV?d00001 diff --git a//bufmod.mid.4 b//bufmod.mid.4 new file mode 100644 index 0000000..0d96216 --- /dev/null +++ b//bufmod.mid.4 @@ -0,0 +1,18 @@ +TITLE BUFMOD BUFFER MODULE + +RELOCA + +; HERE TO DEFINE MUDDLES BUFFER SPACE + +.GLOBAL STRBUF,STRPAG + +HERE==$.+1777 + +.LOP ANDCM HERE 1777 + +STRBUF==.LVAL1 +.LOP STRBUF <,-10.> +STRPAG==.LVAL1 + +END +  \ No newline at end of file diff --git a//chess.script.1 b//chess.script.1 new file mode 100644 index 0000000..6d925a2 --- /dev/null +++ b//chess.script.1 @@ -0,0 +1,171 @@ +%% 30 December 1980 23:47:54 +Type ? for help. +White to move: p-k4 +Black to move: pb +1. ... P-K4 ; (1.0 85%) +White to move: p-q3 +2. ... P-Q4 ; (1.7 93%) +White to move: n-kb4 +; Impossible +White to move: n-kb3 +; T-reject B-Q3 +3. ... N-QB3 ; (3.8 91%) +White to move: b-k2 +4. ... P-Q5 ; (3.0 94%) +White to move: o-o +; T-reject N-QN5 +5. ... B-Q3 ; (6.9 94%) +White to move: p-qb3 +; Foo! +6. ... PxP ; (3.0 91%) +White to move: nxp(qb3) +; T-reject N-Q5 +7. ... B-QN5 ; (8.3 88%) +White to move: b-n5 +8. ... N-KB3 ; (3.4 91%) +White to move: p-qr3 +9. ... B-QB4 ; (5.1 95%) +White to move: p-qn4 +10. ... B-QN3 ; (5.4 92%) +White to move: q-r4 +11. ... O-O ; (4.4 92%) +White to move: p-n5 +; T-reject N-Q5 N-QR4 N-QN1 ... +; Foo! +12. ... N-Q5 ; (11.6 90%) +White to move: r-k1 +; Ambiguous +White to move: r(b1)-k1 +13. ... NxB+ ; (3.9 94%) +White to move: rxn +14. ... QxP ; (4.6 77%) +White to move: q-b2 +15. ... Q-Q3 ; (6.3 87%) +White to move: r-q1 +; T-reject QxP +16. ... Q-QB4 ; (9.5 91%) +White to move: r(k2)-q2 +; T-reject QxP(QR6) +17. ... B-QR4 ; (7.0 92%) +White to move: r-q8 +18. ... QxN ; (6.1 95%) +White to move: qxq +19. ... BxQ ; (3.5 92%) +White to move: b-k3 +20. ... NxP ; (5.4 90%) +White to move: nxp +21. ... BxN ; (4.5 91%) +White to move: p-b3 +22. ... N-QB6 ; (4.6 95%) +White to move: r-q2 +; Ambiguous +White to move: r(q1)-q2 +; T-reject NxP +; M-reject RxR +23. ... NxP ; (6.3 86%) +White to move: b-b5 +; M-reject RxR +24. ... B-Q3 ; (19.7 91%) +White to move: bxb +25. ... RxR ; (2.8 92%) +White to move: u +Black to move: u +White to move: rxr +Black to move: pb +25. ... BxR ; (1.6 95%) +White to move: bxb +26. ... KxB ; (2.2 94%) +White to move: r-q8 +27. ... K-K2 ; (0.0 92%) +White to move: r-r8 +28. ... NxP ; (1.6 94%) +White to move: rxp +29. ... P-KN4 ; (3.2 91%) +White to move: r-r6 +30. ... R-QN1 ; (1.9 90%) +White to move: k-b2 +31. ... K-Q2 ; (3.2 89%) +White to move: r-b6 +; Ambiguous +White to move: r-kb6 +32. ... K-K2 ; (1.6 93%) +White to move: r-b5 +33. ... BxR ; (1.4 96%) +White to move: u +Black to move: u +White to move: r-r6 +; Ambiguous +White to move: r-kr6 +Black to move: pb +33. ... K-Q2 ; (3.2 95%) +White to move: k-k3 +34. ... P-QB4 ; (5.0 91%) +White to move: k-q3 +35. ... K-QB2 ; (1.8 88%) +White to move: k-b3 +36. ... P-QB5 ; (2.2 87%) +White to move: k-n4 +; T-reject N-QN8 N-QB7+ +; Foo! +37. ... N-QN8 ; (3.2 88%) +White to move: kxp +38. ... P-QN4+ ; (1.8 96%) +White to move: k-n4 +; T-reject K-QN2 R-QR1 +39. ... P-KB4 ; (3.4 92%) +White to move: r-kn6 +40. ... P-KN5 ; (2.0 76%) +White to move: pxp +41. ... PxP ; (1.8 95%) +White to move: r-n7 +42. ... K-QN3 ; (1.2 96%) +White to move: r-b7 +; Ambiguous +White to move: r-kb7 +43. ... R-QR1 ; (2.3 95%) +White to move: r-b1 +44. ... N-Q7 ; (2.4 85%) +White to move: r-q1 +45. ... N-K5 ; (3.7 72%) +White to move: p-r3 +46. ... PxP ; (2.7 95%) +White to move: pxp +47. ... BxP ; (2.5 90%) +White to move: r-q3 +48. ... N-KB7 ; (4.4 87%) +White to move: rq-6 +; Move what?? +White to move: r-q6 +; T-reject K-QB2 K-QN2 +; Foo! +49. ... K-QB2 ; (2.2 85%) +White to move: r-kr6 +50. ... P-QR3 ; (2.3 92%) +White to move: r-r7 +51. ... K-QN3 ; (1.4 95%) +White to move: r-kb7 +52. ... N-K5 ; (5.0 93%) +White to move: r-b5 +53. ... BxR ; (2.0 92%) +White to move: u +Black to move: u +White to move: r-b4 +Black to move: pb +53. ... N-Q7 ; (4.6 95%) +White to move: r-b6 +54. ... K-QN2 ; (1.3 88%) +White to move: k-r5 +55. ... N-K5 ; (2.9 94%) +White to move: r-b7 +56. ... K-QB3 ; (1.0 95%) +White to move: r-r7 +; Ambiguous +White to move: r-kr7 +57. ... N-KN4 ; (2.8 93%) +White to move: r-r5 +; T-reject N-KB6 N-K5 N-K3 ... +; Foo! +58. ... R-KN1 ; (4.4 85%) +White to move: kxp +59. ... R-QR1+ ; (0.7 8%) +; Checkmate. diff --git a//chkdcl.mud.2 b//chkdcl.mud.2 new file mode 100644 index 0000000..452a57c --- /dev/null +++ b//chkdcl.mud.2 @@ -0,0 +1,1319 @@ + + + + + + + + + + + + + + + + + + + + + + +> + + <==? .D NO-RETURN>> ANY) + ( > .D) + ( ATOM> >> + > + .TEM) + ( + + ANY> >>) + (<==? <1 .D> FIX> FIX) + ( 2> <==? <1 .D> NOT>> ANY) + ( + SEGMENT>) + (ELSE FORM>)>) + ( + [ OPT> OPTIONAL) (ELSE <1 .D>)> + !>]) + (ELSE .D)>> + + + <==? 2> + LIST>> + + <==? 2> + LIST>> + <> T>> + >) + (<=? .P1 '> .P2) + (<=? .P2 '> .P1) + (ELSE .P2>) FORM>)>> + + <>>> + + <> <>>> + +>) + > + +> + > + .PAT1) + (> ATOM> >) + (> ATOM> ) + ( > + ) + (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>> + + + + > + .X> + > + .X>> + +) + > >>>> + + + > + > + .TYP> + + >>) + ( ) + (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>> + + > .TYP> > + > .PAT> + >>>>> + +" " + +) + #FALSE (EMPTY-TYPE-FORM!-ERRORS)) + ( '![OR AND NOT PRIMTYPE!]> ) + ( QUOTE> <2-ELEM .FORT>> + > .PAT>) + (ELSE )>> + +) TEM1) + #DECL ((FORT) ) + + >> + #FALSE (EMPTY-OR-MATCH!-ERRORS)) + (ELSE + > ATOM> + ) + (> + + >) + (ELSE T)>> + >> + >>> + + )> + >) + (ELSE + + >)>)>) + (ELSE )>)>) + (> )> + >> + > + > <1 .AL>) + (ELSE + >)>>>)>>)>) + (<==? .ACTOR NOT> ) + (ELSE )>> + + + <==? <1 .FORTYP> PRIMTYPE>> + ) + (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>) + ( ) + (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>> + +" " + + + <>) + (<==? .TYP APPLICABLE> + ) + (ELSE + ')>>) + ( + + '![LIST VECTOR UVECTOR TEMPLATE STRING TUPLE + STORAGE BYTES!]>>)>) + (<==? .WRD LOCATIVE> + ) + (<==? .WRD APPLICABLE> + >) + (<==? .TYP STRUCTURED> + >) + ()>)> + ) + (ELSE + > >) + (ELSE <>)>)>>> + + + (PTYP) >) + + + <==? 2> + <==? <1 .PAT1> PRIMTYPE>> + <2 .PTYP>> .PAT1) + (ELSE >)>)>) + ( + ) + ( + T> + ) + (ELSE >)>)>) + ( + <==? <2 .PTYP>> + >) + (ELSE >)>)>) + ( + + >> + > OR> ) + (<==? .ACTOR NOT> + ) + (ELSE + >> + > .PTYP) + ( .TEM) + ( ANY)>)>) + (>> + +
>) + (ELSE + ) SEGMENT>)>) + (ELSE T)>)>)>> + +" " + +) + + > + OR> <==? <1 .PAT> AND>>> + ) + (ELSE + 2> + .PAT>>> + ) + (<==? <2 .NF> ANY> ) + ( + + + >> + ANY) (ELSE T)>) + (.ORF ANY)>) + (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)>> + + + <==? 2> + <==? <1 .D> NOT>> + <2 .D>) + (ELSE )>> +" " + + > + (RPAT) ) + ATOM> <==? <1 .FRM> .RPAT>> + ) + (ELSE + >>) + (ELSE >)> + + <> <> T>>> + >) + (ELSE + ATOM> .PAT>) + ( FORM> .PAT>)>)>> + .TEM> + ) FORM>) + (ELSE ) SEGMENT>)>) + (ELSE .TEM)>) + ( + '![OR AND NOT PRIMTYPE!]> ) + (ELSE + 2> LIST>> + ) + ( 2> FIX>> + ) + ( 2> FIX>> + >) + ( + <> T>>> + >) + ( <> T>>> + >) + (ELSE + > + + + 1> + <==? <1 .TEM> OR> + + .EX> + + >> + >> + .TEM)>)>)>)>> + +" " + + (MLF1 MLF2) FIX) + > + > #FALSE (EMPTY-FORM-IN-DECL!-ERRORS))> + + ATOM> .RPAT>) + ( FORM> .RPAT>) + (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>) + ( >) + (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>> + .FST) + (ELSE + <> <> <>> + > + > + 2> FIX>> + ' <> <> <>> + <2 .F1>> + >) + (ELSE >)>) + ( <2 .F1>> + + + <2 .F2>>>>> + >)>) + (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>) + (> + + + '[REST FIX]>) + (ELSE + + [.MLF1 FIX] + '[REST FIX]>)>>> + ) + (ELSE >)>) + ( + ) + (ELSE + )>> + >)>) + (ELSE >) (ELSE <>)>)>) + (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)>> + +)) + ) SEGMENT>) + (ELSE ) FORM>)>> + + >) + (ELSE >)>> + +) + >> + >>> + #FALSE (EMPTY-FORM-IN-DECL!-ERRORS))> + + ATOM> .RPAT>) + ( FORM> .RPAT>) + (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>) + ( >) + (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>> + .FST) + (ELSE + <> <>> + LIST>> + ,ALLWORDS <> <><>> + !<2 .F2>>> + .FST) + (ELSE )>) + ( <2 .F2>>> + )>) + (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>) + (ELSE >) (ELSE <>)>)>) + (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>)>> + +) (LOW <1 .PAIRS>)) + #DECL ((PAIRS) (HIGH LOW) FIX) + >> )> + >> + >>> + FIX>> + <==? .LOW FIX>>> + ()) + (ELSE (.LOW .HIGH))>> + + +) HIGH LOW TEM (L (0)) (LL .L)) + #DECL ((L LL L1 L2) (HIGH LOW) FIX) + > + + + )> + > + > + (LO HI) FIX) + )> + > + > .LOW> + > + > + > + >> + > + > + 2>> + + )> + >> + >> + ) (ELSE <>)>>)>>> + +" " + + + + LIST>> + >>>> .TT)>)>> + +" " + + 0 <> <> '[]>) (FAIL <>) (INOPT <>) + (S2 0 <> <> '[]>) (FL ()) (FP '<>) FSTL + SEGF RTEM) + #DECL ((S1 S2) ANY FIX ANY ANY ANY> + (F1 F2) (FP) (FL) LIST) + > + > #FALSE (EMPTY-FORM-IN-DECL!-ERRORS)) + ( .RTYP>>> >) + (ELSE + + ATOM> >) + ( FORM> .RTYP>) + (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>) + ( >) + (ELSE #FALSE (BAD-SYNTAX!-ERRORS))>> + ) + (ELSE )>> + LIST>>)> + > + > + ) (TEM2 <>) T1 T2 TEM TT) + #DECL ((TT) ) + >> + > >> + >> + > >> + >>> + >> + <1 .FP>) (ELSE .FP)>>)> + + > + .T2) + (ELSE <>)>) + ( + > + .T1) + (ELSE <>)>) + (ELSE )>>> + >>) + (.MAYBEF >) (ELSE )>) + (ELSE >)>> + + + >> + + + >>> + >) + ( + 1>> (.TEM)>)> + > + <0? >>> + > + <0? >>>> + > + >)> + >> + >>>> + + >>> + + >>>>> + + >>> + + <1 .FP>) + (ELSE .FP)>>) + (ELSE + + > + <1 .T1>) + (ELSE .T1)>>)>) + (>>> + + <1 .FP>) + (ELSE .FP)>>) + (ELSE + + > + <1 .T1>) + (ELSE .T1)>>)>)>) + (ELSE )>) + ( + > + >> + )> + + .ANDF + + >>>> + VECTOR> + <=? <2 >> .TEM>> + 1>>) + ( .FL> <=? .TEM <1 .FL>>> + ) + (ELSE >>)>)>) + (ELSE + >> + <1 .FP>) (ELSE .FP)>>) + (ELSE )>) + (ELSE )>)>>)>)>> + +" " + +) (TEM1 T) (TEM2 T) (OPTIT <>)) + #DECL ((S1 S2) (FL) + (TT) VECTOR) + > + > >> + )> + > + >>> T) + (> + > + >>>>>> + >> + + ) + > > + + ) (ELSE ANY)>>>> + > + > + > + > + >)> + + > .T1>>>)> + > >> + ]> 2>> + ) + (ELSE >)> + T) + ( >> .TEM1) + (ELSE .TEM2)>) + (ELSE 0)>> + +)) + #DECL ((V) ) + + )>> + >) + (ELSE [REST .FRST])>> + + + ANY FIX ANY ANY ANY> (N) FIX + (TT) VECTOR) + > >)> + ) + (>> + 1>> + ) + (>> <>) + ( ATOM FORM SEGMENT> + > + >> + ) + ( VECTOR> + > + >> + > + 1> + REST> + 2> + <==? <2 .TT> ANY>> + <>) + (ELSE + + >)>) + ( FIX> >> + '![OPT OPTIONAL!]> + >> + FIX> + > + 1>> 1>> + > + <>) (ELSE .S)>) + (#FALSE (BAD-VECTOR-SYNTAX!-ERRORS))>) + (ELSE #FALSE (BAD-FORM-SYNTAX!-ERRORS))>) + (ELSE #FALSE (BAD-FORM-SYNTAX!-ERRORS))>> + +" " + +>)) + #DECL ((S) (TEM) VECTOR) + >>)> + + >> +" " + +) (PT <>) + "AUX" (LN 0) (CNT 0) ITYP DC SDC DCL (N 0) DC1 (QOK <>) + (FMOK <>) STRU (GD '<>) (GP ()) (K 0) (DCL1 .DCL2) + (SEGF <>) TEM) + #DECL ((LN CNT K N) FIX (DCL) (SDC DC) VECTOR + (GD) (GP) LIST) + >> + .PT>>)> + >> + )> + BYTES> + >)> + ) (ELSE STRUCTURED)>>) + (.PT + ) + (> ) + (ELSE STRUCTURED)>>)> + + + > 1> + '![OR AND NOT!]>>> + QUOTE>>> + PRIMTYPE>>> + + > LIST>>> + > VECTOR> + + 2> + <==? <1 .DC> REST> + 2> + ]>) + (.PT .PT>]>) + (ELSE <2 .DC>)>) + (.RST >]>) + (.PT + > + >]>) + (ELSE >)>> + >>) (D .DCL) TEM) + #DECL ((D) ) + >> + <==? <1 .TT> REST>>>> + ) + (.PT .GD) + (ELSE .CK)>) + (.PT .GD) + (.RST .STRU) + (ELSE ANY)>>)> + >>>> + + [<1 .TT> + !> + >]) + (ELSE + )>)>>>>>>) + (ELSE + + > LIST>>> + >> + >> + > .PT>) + (ELSE ANY)>>)> + > + >> + > + >> + >> + > .PT)> + .GD) + (ELSE ANY)>>) + (ELSE )>>)> + >) + ( ATOM FORM SEGMENT> + > + >) + (> VECTOR> + + REST> + >> .PT> + <==? 2 > + <=? <2 .DC> '> + >> + <- 1>>> + <- 1>>> + .DC) + (ELSE [REST >])>>) + (.PT + ()) + (<1? .N> (!)) + (ELSE ([.N !]))> + !> -1> .PT) + (ELSE .O)>> + > + .DC)> + .GD) + (ELSE >)>>) + ( FIX> <==? <1 .DC> OPT> <==? <1 .DC> OPTIONAL>> + FIX> <1 .DC>) (ELSE 1)>> + + )>)> + >> + <0? .CNT>> .STRU) + ( (.ITYP !.DCL)) + (> + >> + (!.SDC !)) + (ELSE + (!.SDC + [.CNT !] + !))>) + (ELSE ([.CNT !.SDC] !))>>)>) + (.PT + >> + >> + <0? .CNT>> .GD) + ( + <==? .SDC >>> + .DCL) + (<==? .SDC > + ([.CNT !] !)) + (> 0> + (!.SDC !)) + (ELSE + (!.SDC + [.CNT !] + !))>> + .GD)>) + (ELSE .ITYP)>>> + <=? .ITYP '> >> + >>> + + > .PT)> + .GD) + (ELSE ANY)>>)>>)>) + (.QOK >> ) + ( OR>> + > + > + .IT) + (ELSE )>> + >) + ( AND>> + + + >>> + > + .ITYP) + (.RST ) (ELSE STRUCTURED)>) + (.PT + .DCL1) + (ELSE > .PT>)>) + (ELSE ANY)>>> + +" " + +) + .DCL) + (>)>) + (.RST + >) + (> ) + (ELSE .N>>)> + > ) + (ELSE BYTES)>) + (ELSE FIX)>> + +> STRING> 7) + ( 2> + > FIX>> + .TEM)>> + +) (ANDOK <>) TT (OROK <>)) + #DECL ((N VALUE LN) FIX (DC) (D) VECTOR) + >> + + + 1> + > PRIMTYPE> + >> + >> + >> + > + > + > FIX>> + > + > + 2> FIX>> + <2 .DC>) + (ELSE 0)>) + (ELSE + > VECTOR> + + 1>> + '[REST OPT OPTIONAL]> ) + ( FIX> + > + 1>>>>) + (ELSE )>) + ( >) + (ELSE )> + >> >>)>) + ( ,MINL > + FIX>) + (.QOK > >) (ELSE 0)>) + ( 0) + (ELSE )>> + +> + + >) + ( + ) + ( FORM> <>>)>)>> + +)) + #DECL ((FRM) (LN) FIX) + + > PRIMTYPE> + > ATOM> + + >>) + (<==? .TEM QUOTE> >) + (<==? .TEM NOT> <>)>>) + (> + > OR> + + + .TEM>>> > + > .TEM)>) + (<==? .TEM AND> + + > )>> + > + .TEM) + ( > + )>)>> + +" " + +> + <==? .T1 >>> + +)) + > + '![BYTES STRING LOCD TUPLE FRAME!]>> + .TYP>> + + > + >> + >)> + .TYP) + ( >> + > OR> + >) + (<==? .TT NOT> ANY) + (<==? .TT QUOTE> >) + (<==? .TT PRIMTYPE> .TYP) + (ELSE .TT)>)>> + +) "AUX" TY) + >>> + + 2> <==? <1 .TYP> QUOTE>> + >>) + (<==? <1 .TYP> OR> + >>> + + > + >>)>> + >) + (ELSE >)>)> + + .TYP) + (> )>>>> + + + + >> 2> + <2 .TT>) + (ELSE >)>>) + (ELSE .IT)>> + +"DETERMINE IF A TYPE PATTERN REQUIRES DEFERMENT 0=> NO 1=> YES 2=> DONT KNOW " + +" " + + + + > + '![STRING TUPLE LOCD FRAME BYTES!]> + 1) + (ELSE 0)>) + (> ) + (ELSE 2)>) + ( >> + > QUOTE> >>) + (<==? .TEM PRIMTYPE> >) + ( >>> + >> + + .STATE> >> + > + .STATE) + (<==? .TEM NOT> 2) + (<==? .TEM AND> + + + > 2> + )>> + > + .STATE) + (ELSE >)>) + (ELSE 2)>>> + +" Define a decl for a given quoted object for maximum winnage." + +" " + + > ) + (<==? BYTES> + ) SEGMENT>) + (ELSE + >) (CNT 1) + (FRM ) SEGMENT>) (FRME .FRM) TT T1) + #DECL ((CNT) FIX (FRME) < ANY>) + >> + + >>) + (ELSE >>)> + ) + (>> .DC> .DC> + >) + (ELSE + + >>) + (ELSE >>)> + + )>>)>> + +" " + + + > OR> <==? .TT AND>> + )) + + ) + (ELSE )>) + (ELSE .IT)>> + >) + FORM>> + > ANY) + (> <2 .TT>) + (ELSE .TT)>) + (<==? .TT NOT> ANY) + (<==? BYTES> + + .DC) + (<==? 2> + ) + ( <+ FIX> .N>>)>) + (<==? .TT PRIMTYPE> + .DC) + (ELSE ) FORM>)>) + (ELSE + > ) + (ELSE STRUCTURED)> + ! + !>)>) + (> + + <==? .TEM BYTES>> ) + (ELSE !) FORM>)>) + (ELSE + STRUCTURED) + (ELSE ) FORM>)>)>> + + ()) (<1? .N> (ANY)) (ELSE ([.N ANY]))>> + +" TYPE-OK? are two type patterns compatible. If the patterns + don't parse, send user a message." + + <==? .P2 NO-RETURN>> NO-RETURN) + (> .TEM) + ( .TEM) + (ELSE " " .P1 " " .P2>)>> + +" TYPE-ATOM-OK? does an atom's initial value agree with its DECL?" + + + >> + +" Merge a group of type specs into an OR." + +" " + + <>) + (ELSE + )) + >> )> + NO-RETURN> .ORS) + (<==? .ORS NO-RETURN> <1 .TYPS>) + (ELSE >)>>>)>> + + (VALUE) LIST) + + > + <==? <1 .ELE> OR>> + >>) + (ELSE )> + .L1) + ( .L1> + .L1>> + >) + (ELSE >)> + )> + >>> + >>> + .TT) + (ELSE .L1)>> + .LST>> + .LST) + (ELSE 1>> .LST> .ELE)>>> + +) >>> + +) + > 2> )> + 1>>>>> + + > + > + + + ) + (ELSE )>) + ( + ) + (ELSE )>) + (ELSE + > + > + > + 0>) + ( T) + ( <>) + (ELSE )> + >>) + (ELSE >>)> + + >) + (ELSE >>)>)>>>> +" " + +) (L2 )) + #DECL ((F1 F2) (L1 L2) FIX) + + > 0>) + ()>> + + +> + >> + OR> + >>>) + (<==? <1 .D> QUOTE> >>) + (ELSE )>) + (ELSE .D)>> + + +) SAMCNT TT TEM) + #DECL ((L) (SAMCNT) FIX) + > + !) (LAST >)) + + 2> FIX>> + >> + > + >> + )>) + (ELSE + >) + (ELSE >)> + + > + >) + (ELSE )>) + (.TEM) + (ELSE )>)>) + ( REST> + <==? 2> + <==? <2 .ELE> ANY>> + > + > + ) + (ELSE )>) + (ELSE + >) + (ELSE >)> + >> + OPT> OPTIONAL) (ELSE <1 .ELE>)>> + + >>> + + > + > + ) (ELSE .TT)>)>) + (ELSE + > + > + > + ) (ELSE )>) + (ELSE + >) + (ELSE >)> + + + ) (ELSE .ELE)>) + (.TEM) + (ELSE )>)>)>> + >) + FORM>> + + .X)(ELSE [.N .X])>> + + diff --git a//chkdcl.nbin.2 b//chkdcl.nbin.2 new file mode 100644 index 0000000000000000000000000000000000000000..6979ad1df1e084e80d52716199242d4fc56409bf GIT binary patch literal 72869 zcmce9iC+}Q)^_zQFs$N^#v~=8q7j^ZNer?JihzKM8kI!7A&F7q5^?2U|DNa6);$ac zbMO1{OWN+~>RL~o{haE&v@*SVMNdsn&JQn7udGf_>B6Y)?2P?9JwJVYdSO);n|_~L zoxVOixp)(=O3kkpq%vLJ`MZ2Dd~14ASDIe3d3jNl7uUxZ=4S9yqHoeq*CBa`^};;c zrrkqmPkwQYgtlkruFOtg6jSj5&M)3JznRJKeF=qKiBQq_{QT|3<*5~Y_R`Yw-1XHv zOVgS^jD{ksLStM;GsI@wW~2QZ6;E)YPz2 z(dnalL%k}DDV6(9ZKw{NdAR*a=N@iv%Zt+Nrpn~;_8{MO>eQyn>I^P?d?7{r+g^UV zec_w-drN%V%gbM(K0SrEdUj1I-=tJ}=t33!;3cIdHdR_ru-p{NRR%ZIah>9029LUJ zQ?= zr?Z`{nF`8N8>(=ZZG^iDfAbaOd<6yRBwxJZZ!*B?3)Oa&wJRO&9&Q6Hco{`E!s^S! zR`r%rzR3xh`=)U;jaRo}?sX39rqAOJ>oM`X%2`{R=4x@JIfQ)t z3myT~yi0BKPpP~Dz5);_)u$qR;gixp1$dF_d35daEBS?w(Y?G*;=5CV^@av+jnChl z9?;_pcliG~J-0$!d08(kf@-YZTwah@Qg~)=4L`5y#U=TFZgF9J{=Q}#{k&AB#vfl? z`uJ5|z2u{sn7g$2cx!rH{UwjnrMt(s-cK&6P4jrY_Vwc1*}Qr#j}vqKsot&OO?6py z_Nm|Hw=2cMhd)@lq}pcHl*+BC8P&O=)>U`EdZcQko_P{9wXV+rlf ze0X!|ueQ7zP+jQQ#N4+R>Tj-XsiUT$8-?@F-+!-Ek33GDyg0w84lSvSYTHtCsvGEk z^1;W_n99xaw@v;whTjg%e>J%IG|$<^pHPu;kf}@KD=TwX7N(~z>noVZQ9Z(c^rfYn ztNKE6#^uGydxdsqy3D^@G{a#`0)jY^?fsG@v5 zUudAQy3XrjwOA6ac5Trp?b0* z2-*-hqUBzXEzKPfw0SEpqym0xhy@>Od=#qrjXWl+@8d=~D#)1CANAFnJ63Pr?xA|3 z`A<78?J7r_P$vp;cOc^zs<^1DAiL~Uot+duU~oqTQmOkwKC>5BpVY!}R02XsknF}I zzC9NRx-Z;eC+E;kO7(}( z9pb8n;3|uz1UbnC)C;v4T!nuG8}+Gl&+m7x7{unWk%6<;Xvm}A(%m1Oi-;AYL#lErpu*jshF=e>UmwL z7i;-ywTc(IRH`@1g?hD7;qQe;zE-W&%TlIZE9Q$t8+lzRmWz#Yat{N84--3uUEKRc zyLdMU2CN9cSh(%-JEBV^Gl(2VX3>MHoust z76ABvv1YEPVb$`Dda(}V2_#%8SE~8ei(r6PmVjOTU#!5+dEfI2{C?w)>oQ|u1Ip&w z!~A2bna%e36=)|T(jjg9Uo3-}&e$T<8>QkuErLTKVIv%Cxe-9qQhXs7aFVlRC&2)i z3y2-$gSaGk#BKyH8juzkr2b9&^$wB?DbmKB^v+&d7is5Pu%~iK6bV$7Z^7s%E=193 z?zkgB%-64(ZI`+X{2Q$+aK=Nbt#hgE+tI|LyZP9C)%B&tWj!-KzcQ`IR~N63{?qe0 zJ!R1}5YCJqYWn;fQ1y(yK7MCnddBdIAS!WQ@rd+q`d0737jN&>)nR$`@N+;OJ?h@A4R4Uf1dBAp~2+5#YYLu!)3K;cb zrQ9giAgky?6^u!x27=du)8H%w=s)ZM9{{)!*PaDb#ueS~;S5Z^f!2FVH4c_*yN^Jg z7BDW&f~L!F=O1sVT=Ls}fg2{1n&HmL0Pth#tpk2@$v!Z=GC|^i2MGraB1Y#_s#mL` zOgk=yRpA(0L&7sa`DMHj)1Hu8mf9{fy8 z(Xcp7Wp8Y~yZ5l(RVr1ugl!ZZa(d9NGO!(9cwsHWEt{5==lXOQa%PkpSe4xJgXZRCjz7WwJcc2+u zJs}NeSivV>!GWd<{Eh>y0UEhb--An3 zJbagg?@PWfA4wFmP2ZNN-IYc0c&{8NSr|UM(bm*j=x&Ree>^&bWn}f+`7v#_9%OZJ z5urn&0@34e!;RVv2hjJbN8IPBX6%Ff{-Xc%HQ5#pD_ZDm+JB-(DA>uz?!~o3iO+qqMh8t>^>Otwf zv1gFRo=)Eo7)Q6m3Go>kx4xB5ihaov5o>9R^*LBxWTPbam*s-Fzob{8jc~_4w{v@d z>4aw9YT-rE1yy`tA$$JQ16!E+GvvvvON-qh^3me*b-glug_hh=vsK0?R~MII)-@#d z%JhPr1P5hN-F_<~z@3f+HabgzksBGDrQug50>dxH{cZ0y`!B z_FD6PmF|xz)0migcDrDmGkj=?6#*P#R(E)=U^J)xrp*IBNW3;9wV%5dna z8&tUz$)B`fM(rHB&G32;n;`%ZLHlU{_W(L!zZmhV6Ko3$|5<|SHyEcL>t4X<-QGH& zA_uz6O%+VfEd- zkbdZSV0kIxx5`DSCBkQ$p~!hGSQ-S^7?)452N0210ZBBO=PqvVt|ark>3M;(Bwj&G zlo!GaoaRsiPj`m(ebU{Q?)M8tw5@G|4anfa?uME#hP}qS_i__2A=ps1M~D^RZeyl$dfD>W6@HJ)plQtbL%V<&o}2yOsG3buY;ejo)p{ z;|0*3W*8p3kKFZQ!O*^PaE z+J6i47w!a`^9yW0H@o4EZ*yFu7jazACf(n<2=9YsY(KHg^7o&uc@`jmL8#PV8RJmO z@lBnF-d%dgAMj@ggGExUD1*b+T4WVN7ZNH4YY2flfwTe$es~Tzeic=Mo$|btAq|Vm z!$L6vWe^)K?I%#vISveU7@BZ|Jq&{BQ$E6y`m*QTn`5(T**rQM?Si6L#>Cur?Zr30 zY$?MSdj9HrmBS2qq4rzztrKd$l1I<4!PL?RE)5&vHjt3|S>Ad=BNHAhFYTm7$E1k2 z)nrv_R*7sK48IxGxgImwehCj}mnTr98u&8kN%AHBK~yFaS1#8}#bTjQq?19t?VHgHHi`!Cv5`&7Mx1XCKrW_=jbwo&ncjM_d z+m42uqg8&AA$)Z$`nrQnBASIJ~&0l z)-!@i&$lnP1VY?~Gc(mBP;c@9f7 z;6VWS-*HoBs4>`ua{&~105~`i6f2N90AJ;NsR7M)f`5uj6h>$ht%K$;Ajr<{RB7Wk zYcPSL4~y!IBLT_`3h%@^5kJ?-Ed_75!{nB>OAA(Ed!dLsLF;|8(4ICnJed_5Djb05 z2Rlez9Ln!)UukG4|)K21GP*}2N{Z# zSmZfr(lCJ}pWoXJiZ48EbPh}XD${do{rzLY75)rGGyu2T2KCAWOZEOi-%7QDC;@{C zHhf`>S<5RoCziEbharG1-_bKS7baKX&ZH;j7gwOlg}rKWd2tl76e+QWe=LMEebfF6 zPur#W@zrUKisu%t=+&D`Q1q^#$T%ElChn|GuRz|yw~KHqrA~N-S5Xh&;@wSN zO08Z6El(KmJj%C(G&s2A7+RadTg@UGrU^=((SG91;0ik^a;f;?%3Jdp-Ews&FTK2w zpKeuzUmQ3(h)Zb!?|^PC7G0eT-9?CbDIbkL#Y2wn{kn(QUcR2!rB=MYEKE2H!% zc!ix5#j?0}ju7K{&2)6oiec%xrtD4NRHv*Jx>@E)fU~hoG?PpDH1qhUn9QH z3$EuQ2pm_H03tIP;6?f@l+VvDK5IRl7uZIl>8%@9^ZFVAoqaZUP3tS&^{X0o!0m)A z$jRYcq4&niSuEY$3pWLnS;2lYm?RYQ1>iI;rT-iwqP|yTG|4*}2$L^@ME>_KLsd;O zW6(vA&EP~hx+n_}q+rJ!M~6(Gclx-;{PJaGWOivYAYT!H3-f{<@Ih7;>)ZH6+9mtz zHAnGokQ9T55Y-M4RKmcJs5H6oZfVsvA=a2gO+&kFD|XVLG?v3=cS?$;iQppB-#I$8 z)8Bb=+O&cFwq3poRjq6~S#GDjn0W4ZI!puxEvBg+uoTf@VJQ^-!f%+yKZ!l%Pa6$(7cN)2hd1XXi^ViI`<@CX`q@Itv*hnpXC&TyB`qYS(vV2CLf zp^YxrsSluAbq(rj@EDM&s!&STDsV|FH%gH1>t%Qmfm6ZDBAAp0ygNmSP|3q>lfKum z1U0G+Sc2*WJq%?+zEG*79(Z0fYWTELC~4S)3hYm_0w6A|StxUQfaSfhFX|dq&#_B_ zeNpoy8Uc9=`*KKPQm}{BA=&l732HvzyQDJUdQb*#O{-mJ}y@SD1i==T~o^%&?>)%zbhp2PrY4u&O zMrE|&r+r$cNl2|DDGEZIn|85_1?K2+;AE@H43C6)Y3E?emW<2>+Td^z(06H z$sHo%AYbxPCf2ihv5A$L6sI@&OdgHenv&+?4zd8eLlOWwAY=i(52QjVM+ds^tlqBU z9si67YPZoYR6vM8OLLvr-)L-`9A8*mfXj~!CKNj~k9iFu_*^FiB zTUM_^-I>?Geu!BiUMs@2tWYQ+6ow9G5ZP)CYEPk~f`$rmAM~zeNOjP#7Klml8v=ta1#x61yNDK&K%L9=LZM)kn8gxkH3O&s9)Jo+{`3To#WKZdq_>?rA^&O&AU@+r6^&8I z$Hf?EdFRk3f5YnFZGv(}<9?wJlS;lP=R6)jgO3wUMTBw|XF;fB-H9SQ9f^r1JSjRz z4E&yzvRrhTkME=nd6b5H&0mMYO~zeM7ru%WnXq!$b|3`oi)ImPB0hsrTTUJ5jY-F??ICBe?lIc0Q}nQ?aq37)&4+r?R#`4gQbYIcG;+i+g?&Y3>! zmZZ*7^sEyki?TeEW_idsuxnF(M3D4R#Ht0bEyL@GiqiH^-S-ltq4QC!Y{-t}Bwfx(?$^~eN6C>SvcE1dbu$Fk&f;eJga+=Tx zr=-cf%|K_E9Ik3d*vZN1lx-?Bz;B^wh?S0V^+)eA=K(ZfX8*?4JRx93Gvq3I+&&^w z0Ll)8X9_)M5A)Y!k?rsV3DGWBqBy9Ysp76I|c@o;4q-F=f&|*OnH*)HK#0cb6Kh_8Y zOAWlqT>z0)09nJa)d1aIo|;)R_MqX}@yTl%-t!a~L@cn*7)DT_Hpq$$;CfXSO0k4)697cO$rUC$Ec)DghA z7iwTS+EkETw5qH24ajI68_*ziE}j3#iccRVzT*1mURy*I-Ii@Q{QC3Oz$3D2+a#g(9Mb3%G6a zl#DaRVyZNtN!A!pqoV6AdE?!z{rrZGg$oE`gp!fSXDZwU-k8YIg*du9V)bs}aAN!! zP-mKM$!~di2c!buIq*au#bhR!)FD0fEfLZ?r%W*v%P3P=ZpN4EmvZbCq6*O87@`J4 zA>80uDdG`zQ!TleQLA<=IK7k$}}XFFi>% zd&U#zN%r0mdvb`NUAS11Cvz{HbL@_sGb0G1PzwxTZWX8ik_c2o#blo4H$y7S6mO^x zR&#|rnFw!m5=NnE!i4oP<(lR+4BB@5U-dpfPGVT&`*pG#VSk7<)ZnJ% z3*k6T1=SgFDePYtD>Y_ZN>Fday2a0~8W89N&AdR%(lK0EOE0Dus9-1-J_o*(dA zJ56Xvrb%$3vvzN)1MHeynq~t-2t5ep{>wqP7^)1WYV z2*G<_u(4$llY;eRAP!`tuO)Tg;El1Fys{g2VEVik9QtsuTx6fOczJ70r+`VI52(PA zzbVuC{gVgAtHI70`HcS-KpvCh}$7UuC8(hWE!+B;!R z51Vu;G@X9N2QwDrDP3lE7=4eq1vR+z`@GOq%SP$8W~r^c(`KxS4ywcT7}I=T9o({9 zx95Hj!s3qPG3_~ZNpWX%qo^E1@P@) z%FFQ5u9Ry?-hu}3VHMT!9_&5tVE1J_UO5l*0u8ye3fF3Qf@wBihj(@r9CZs%GJ#;n zMZ=vYr4Xi8gjZ*r37#b-z-8nBl4O@c^^u(Z*QOC9sNK-Nxi2TlXn2MUVjr9 zZQ&uvgMF+FfxQVFRcHvrM^zoms7}fk%z;CxeU&}9z&JcpOP;mha<_}+gl9)|(kK6g2_KT0O`=28EP4i0 zeHm39CH;ivlf8o0R9K2qtoLvk4!tkhc75*|YDKcfESjeGCK9Pd??18k+w8ro<)3SI;(RLU`;cLR-#3{M4G!{10{9`Xw957YKeVA&UQGaWHmlC4>{bk6 zSwD4$GsG;Urs}gVhTlHeBH6%SQ{EMit5PZgpnIV|QpBHoLohOOhgwQ-n82Q_VJ8-_ zMfq>FCOCnHzgm%~Bwt3TAlxf}3?L07e2}J~QX%2#>8X%40@1?ewj=LsH2rRZZgO+& z_nV81qe*8W&`SNbI>5K`*iAYvze&am`Ay`zG~ruJ-+fJA1fmZrpG;GMy+No!oKapu z2SQ)!>(%8eTm}3YsPV&W0Xgx!2*wS`rhK%jEdxKYtX|h-v+H>H=}{3N#ILd?BQ9U! ze?e7z$KApsVg~qLSEw8TT8CFoOT258Y=U?-r{U!nEh`ij>M2>{Hr-;<$0HZ>Pp^46Aw@)6$`{X!JU|~`dGzHD zOF65dz}pK|RK?3S*;Z=d;XTaOcB@4I>y)nr8j3_MtYE-*%@hu8?Al3N3#wu_Oc(>1 zP~>b81@}5I{?xjPShK{aQiA1ly539t#Yj%2e+g8|=_)wSMr#qjqpl*GtnUxqhWeOq z_!Av~3L@FlP;`;4{mkY0w3A_XL9^C+qBc3%V)pr2>SG%c(P^{-!DWc{($0}K=`%pW zzS!B*(EFBs#teB6<=EsPR#dexSnE9D-B8omvmNyb_A3zR@~ zS-7E7T(=C?&8`+6FI4dulMn|$!a?iAXHz|G)n^VL+og|H?OcHHmXOn)Tu=bWKQ_s( z!H(B@65*%otipsf$ds5GJ?L~gW zc&#V}*bo%lTm5izi1+w2DA-`6Cj3i$yOVnF{6!?DT?D1^B`Xg>obr;9M1p=!I68f4 z`3mAqv`>hRj046OH6aO2Kku8usz2X8C_|Y%oO@N=e7mMhAgDJVtilqnew8B5*%S$K zp|V%gE}!qL>R68nGULFMU<58a>ljy;Gz>TGm@Y3x^(i0}&Gf!?m0MTyQnQzs5QDOX zY)oKOV1HOrS5*hyPCGZ%9ma|V(WgU2btMAXd6msW{%IdmKdSb1#*_}(WWt_i34sfo zNxL-Z*%-6>dt+40N;`sulm*nwi=zs&de$`DNyQ6PviR0P#cD7%Kng*U-%0@`!OkFf z6uzNG`asT4<^>iNu}3~X4BBm>7_(0yADM5l z3yc~7&e282vO-EPVWS~$)-H^GK#t}_hs!M)!sduBfy@o&y0)bL2LlMeRVn~NAdys3 znnVpr2!4N(0wDRr9wG4O*O3zEE|H3e)8_3gGUSK>g>QTB5+Riy1Dpto61w@`$lied z50VNb*@j8LAR@bAe7GZo%hbJCLUH4fFPH`7QswG~`bu^at1p|_i#Ci)Odqj>ZUBM^NrsD|cDgQk705mUQ(Ak`7sCFGw0YE6l-`;3vm>j$Lk>b7%jUBaqAcBms zfO(uUKiocz77nSf;RXy{BJ^@hngvu)16n|Vqz`c1#C>IYb$EGv!6dY2@4ktlgQPRC zWm-4Xv9R69xgPW4Jkn$VJ9t{rPb6R*$Owqpk&L3GgUu)xk=80=Td1;<)2_!+U;68Rw4A~uhJGokjY0JWk)h=)mO z&Wcvx36SZjYiRW;_O1LGZZ=HdKL9Z}S2)fX{?%yk1AcG8gA#z*3}!1%w`_6`cT|M+ zHFm7!Ar=nIqm6-b4)D-Tpzog3wCbwQCUN&L4bTPdmFhh!h$+F}-oQCblLcq6fk>nY zpOG3J-T~8yTGmMIUO`4UoXpUa@G%au&Pxak8=6le_Zc>+zx;!qij(RbGJ>Okp=oJY z+6k6e9sYLCwrNp38ifYS zN%C7!GXBUm{+0`=Ai5^bFx-1n#-~kbL|Th=0B#BazzY0+(e+%y=vHOw(&K9ZT?L03i z=C-69L1e+(Z6UX<1kjQGEe#fsWahl>&^sC{#O3}y?}Q_i6_nGAIN8@ zSP(9S#BLz}CHxvV#RoXWuQ^HtrE|@Pu;y%++S=G)zU8CTCvAK!fa!lDRxxcDA6=<{ z+t2xlxjXJMFd5{_MIu4tFWLAjc0=ImBP*4}Oj0Qh9cw-JNZS|3Va}z-IeqMk!w9Fw zl*Ud<^#`%~lE@(dQUs$8ri4Yx36=}%(PHY7eZH|2C9q&Z6McwKawy0|oRURhKz-`HzqxpC z_~L;~gm3KuC!*Cj@PckiIGL{uCK90%&gc9N!6J2O3@=#Ut)^aiQ?7~skxr7h0;s{p z(x}UHm1#*4CgAgOx21R@6IL68_Kyuo9*eEo7`RaLxJ$=TALhC0K6@!sTy>vGYpurn z7nxyfFbo=;bGomIbH+HPMgm}ljmU}poBQLtLAX;J4QSuP?PS|kOx z@m^yEeT6A(7uMpP22&U1MQIA?l`o{eGhBstCocfn5nPcvWwb9(H&Q3j+GnT%-*!oT z(o^m&>Fzmpaz0t<1z#!7o8Vh41wwj^gcoOfq*Bg-A*s9z{9l-`Fij#3O1o9!1DFf# zG}U-#s0ODgEpxTUX}Z&5nx>K?8uuf*%s%fWGp2|K_+)M3S%~8mkIE*yQ~0|vlXbYL&AVFBU0*5DQA3jQsm|`yZ}Lc3YZ$$ zOoDby;ZNTaxBE8UF+l)14)n#6j<>|XMqo2vVBtS;yq-Hu%P|5*sS)^Hc8!cH-X?*; zEl)~_tLFsM9gY)BOLX5q05zw{bOUVw;4nauB_ER=JP}u`C~q1B)rh-aQp!@%lF6ZM zJugwIbpV3;kay2$Rzxjt$)hfTy5xS%b2hyBBQ108 zBcxJ)sF5+~jjUEFdd|Y$U}+yGuB-F!{%RYGZmF-pB0CLev>=6jCfvW&zBMR|@(}F2 z@6@U~HWvM)E{?@CuQiq1Qg>C?TGXMwT1yS8(@Uudb#5s2SdH|hw$#O?bf?tpO{+y1 zHY1~I_2$v@3ft|n>c~Z%YH%$zqK5LRYwE&U>V+yu5A2Z!u;t9+bi(RP8u^#=QzL|}-mEKDAr~#E)Qs3264^)0BrVlpiYwxplTn7YuDDI}5agJUd^$Exb8tB3S;g?DTn4zE3Z(NT4z z9xX!68NGlDZR(ghvzDr=5%$G7n`I@%u-C;=UfHWI&cVI2Dv3WR^vXysk%y61k_gsI zFvpfEOeIgRRcPo64a89)BM;ooYOuFT;WEOrsC;JRmIQP$jRlX(X&}@JuB&AjWQ~KX zr0=2bT24_yI2H~E6r(ND)x&`l_e^b1PbMZUz}c^GjjiCYF&yzwspOgU7y4|ZXho)A z$eZmT#vmOi;W z9~Qp1I7On&m^Ta=35TRI<}ZRztT@Mtw=KfQ5CDfxz$dnjv(7jNNUe}Z8e@El)JC;( zqk=l&fQzs>o>hU<&@e=V$+0m})XvZK zjVo0hV)Bk+4BMFfoL&`g!B5#shIcqyD(RgIS_mBsBCtuPKnvxu&zu7Y6&W;Z@e4RL zDI64kxqP;{~dg~a0V=#q5)Ejjh`M;cX1Ice@b7_ z_?EoMjiIyn7S*TV=!}~lH5H+90jc%KIU{Rb=JSFfTo58Tc?1qj zZsBD?4G73Q<032)zygc{m1UBaFC@$e3p&X;{abt094AcD5tAiUS7m*DAk>V;0O8kQ zCqnWi#URJe^BmZcNIdnPGM{mWND9FdVz)J4;^I;H8w0po@>>glGcN={JTTlcum(#k zyd-H%rV%zdqI;}Q46gT*h2OIsSnf4D8Bqlv z^I_ux7~7nv;5peyZvuERYFjXyMh}&2ced$Krc*l3)o(8Yyy11TCR{C)t7se`4-Qr< zil&t6!yT7V4x!z4ziyJMAr~I$e9&n$bxt4j2Nf)$-PY`+BvF&OGTtxD zp81j7YDfhw`5is;%5;xlCPaC}Vc}aBiEqt;!faYDRN{%i=SYM-ppFBR?25vLB4QuY z$;$^R!aM7m9BGApJfzxsD#y0p0ciPW_)&+0Tk)eds-BEq^Z(`*c+|a=5#u>(5KE-7 zMlK{c)SC-)H*QW3o4ST4XQwBxfwd&FDgi@m+%cHKSRP^jJ!6S^;Gbg-6?h>&x`Xaz zzj{7XK_thYcZ{pZqqohUr{h3L^{kU?wC5}wR5&_e*_3mMyn0ny!iGStyboKC6!DxI zkwcOz%c(BaHbw*eEZpY0*45u?-)78IkEZdrH`}ILH)q*IhQvC2>~UZL=r(wOA{@2L zl`^B_LC|raJ<@fNXft*PXJ5hWiEM}<>DW0q5dmxqgLGiSheKO~r}~t@BEg{tObxlD zI#>yEMr4>8##o8~064x?E8x1yj4FcLKQca>xFT{&WCCy^gURxYrxqu*wpw=MAM{m> z57_AtK>7}I1+furUO+Io#3(rA+D{{G61qZ7%pfMUa)u{kNz&yMXq%oP<^hetIVT`A zl+^usEt26CzG+Z)fefK4;*9-N_e#R%ZPwghMtwQrf)w_>^7@F+rwE%G!5)W`00~^! z=(3CLjzxVCV-)r{?Eby!$3Lu~RsNaH+G@g@Hm=){_ln$T_rnf#Kb(_2W!+2>78Kh^ za7y8y-#Nz6?^D|ufcD^Spw)wWR=$nf?za@qecOn^H^zp)y}@^@p*mOx2aI47CjS&} z6u?ZEOC0EdBRraH_%`*NU>omjdG9mOwV_rBUAPE^vv)A{<1PkbBr;CttvaZL&ymt( z#&{t}ta`eE1pZPL5jJ@bg4427v#WihPzH&27fyR3siNOlAlE#z2U*4(7|XZ5dTP|2$;ybZ z4r~o?BW6G`cl_*x)W@o*LQ_BJt83S`^Q|q(g8Jk5#(3VvD8F42yP}>& z1@bLxUgH!?%`=?)kG5-CL8mC)#oa@qy@7Q=(@+Ln^+jU0LAuDvo%swZzLZo-58Ydq z8Nw9lF|8u4++FRd?frgPbK*mR#AQkm;p9PiH1Q?GUuyw%S^XI1+4|#abOzN&+uNJ` z4W0CC3|@>Wv;f4`y|VadmL>6L5Sw8Kno$`;myJiBnJpvIbXatvi0I9l3OM&ENCa`Ly28ic{s%S;X@2E5 zuTnZhpZdT_G@(}W=us;saf$O*R|m+2K+Tj>r|J2(D3yBk%$J~Bvj85!GWQOGfuX2C z_M1i?Cm!KcC1^#UjgX8yJR3=Zfe`@AW7(;HKsuZ{m=8n)7YpzQrq^H*vB8K0hGqr| z0~UpEJ#cje{6Pucf=#$Ot{QMFMx4!29oZFSi$5LFT9%IP2lE@)6e6a2w3~|KZ9qH) zhMs?vT2YmkTJ=0WGdo=I4u~NuzV+f(uNAszk%hbCMiIR22t76h3X!~X1N<~~`g;xw ze|7^{2yNa1dttBtxr~iMB?}YSX6OX@=jl1*5d3+1-UM_w(Q7CM#90;1s(t1QmjddG z;LVQLLmUFdaR3q&OUU-b#7dRVdE?Qs4+=#&X)~OB-3DKO1%;4TAt9nW`;1W&>ft)N zDiPfy15g)T_!hGcAZdFv227merJWb3hCpdS>$A_p-Nn1un)Wx)SKV)75?RESBR`sb zt~FH_@w7{(7Wb`5PMU=U(O7HZZG_f%hi=%K>35f`OR^RYS`bqjBztdmZB?Zr>GE z*gOnpg{Np-D)6&mEtk-J9ngpqJHQt&{XGAy$(Z_lqrWhW^kH!L;55Nz+pbUx8fRZR z*%x{Mm|8e|bhj7%<8QAxB^_E$W{oqA*;iy55BhdR87F62^s98zhG&kxVi6C!Jki8;k|2e+e7V#qY~$kKD(;KyeiK+Td%;6?1h@Rp z)knAw_y8CftB?TT&orb{>=1^^nCGy;vVY1blf%MM+&jAgwm1!XU`(?diyJ7f^UE4LS`Gt}}^8)W0Hzig&T8EDb*7pd3Cf1klsqZ52AK^Hjl}9$B z3;(jud!2};c_yMri=%`@={T2(>>C5I^ui9JtsR>JE+HD$KpFdqfn~oP;SM;e6`)v; z*}F9F`fD1T$}o`GX|~oMTC*;9ER1jancZ|lcN1x0O8Ph(x7pn{ev{nd+x?Xbl=37p zs}14{i)@u<;`;;TNHBo3h#sQb#;a!pfLTGMkNHK|E)QF+FMk8y%C1>7{23@_eF0v6 z(J3MY43*g`vVZdN2p^GO9*aHeopiy`;>*#EKHk279stv8!Q)J6j3$wVtKeI z;-{46dh`*@%%bpx*@yylL{(;ulHHw?n%xwqpd{xMCo|!Yu?g&qxdX?Z{ks*%Zkg+i zR90gM&ql`907Kn?0ihM4yJ3@<{*h@VnSdFK9jC`8;|sP;a+@jK$%!enzfn^Vi5Jr+ zFzZ=Z@z_7?{kKhfAGJ*Jgt8QuA_Z-Z+n1bJLFW5+ZM+89?Gb5YZJM|p^JlO;8=uoN z>kzZAg4iUcGbPA!FSLT6y%0F~9?K08J+Tq}))1nZ#@0xk4PUSazb4wvN)mwPcDY?T zE?(et8pai%!VTNmJXf3-RGR%=_G*N#!B3q#c?!L%0j}uUlUnA!%n7E+KXam*v8-S= z+6j6&?Ap|V?!>pSJOV(x<Ze5RDVDqhfv&c5mHYWd5S9t2k~_XPn-jG@*rZnQuDElO^P95Sa?%Ts=C{Oa#SHl zI=saY4$|=v;T6F5x(#rvbGVpfO|INQHhG9m9+s*INQYV9p$fj8mL3qy;Cx4~t!r`z zq`-B{HKDn%9-L=r!PhAUZKQwGBftU#28$kqdGgcA7w-sWUc;CY1s9pc)K8iiM0euS zv?)5s+=d1Zo>-b3@$A4iafe!V$wXdJfPv!ud-x6 zVqSjZ3y)7z&+lPgQ~B9;0nrrBG#kQFpi-DV!eaWnq$zGXQ}!r@hy2drw5t z$oRUGMMU!a6s(7+iVFp_>6kJ34f;LokH>x=0f))H`~v>P>!v~dxI>#bxAYxuSm8<| z&Th(V5`d3@;~#|1gM>~T8?_U`%NM(2d8#cTGN!+dVR^3vAH|@1i&I!ej{K>5fo>={lcmKMv%J5IZ7lFuRiG$bIPe}nX~T8FTI)8EDRF9u@}0CyQA7FG{% zJb=B5a(mdTZtKPn0C(*{w`E`yP(4w$8NgE`Da<|dhV&cR^M zpf#z!jH>D!(IHtB8G@%3QOh9^PBk`;FxxE&E*G?kl>fo%BbmDL!bbXba`=LB4Tmh9 zVg? zr3KBsBHA=Q1Y9Gbp@u+mjbI2^7o$_^EO%4~Xk+F@0&Ql_vs{{Ed*IjiLHx`~QmZo?nQyo<*v@Wc zJY*jxI2!n4lSg8Zja5AicsAd*BBTP(rUK58+1-R<1bn%w0L2+DK<4YFu5luuy5huo zuq7ZJZf1axe1zBs9@kuWgO)H}izm@gPQcOhlvE>zbKL%o?Xu7{`AnMppNtY29nmXp zKhhK|8P_r_h2Of!hsQw!XoN}q!tr9Rgq?mL*lDzuWrphP9|`K5#ZFGJU;<6Mvd;YW zJw?kjdtc!+<(fzgWwlO^WJZ_$2;MfChjRv1^-Vrwt@_6*h|6$8vGBHdXDT(a2-nqzcH;7T)ZxsSlY0#EMbHZv0WVI+D2 zwNwCWH@^U6#{}6}yTDvAS&}tVy36)UyCM%_QFcgotWQK9AfCj2BW5+i1&g#2c???e zBF_=9OxYtbfb&RoC(DF#t!OPE%u;NDF!$Js>K*}Q%I@O=90*hw15B@pgp0e>*{X)N z7I#@Kvk~+|t+Y`#P#zKsN7TjP8_NJHP$xNwAKX%8M_FH&n9v`R{h*_3`sffOkrgaa zO04_x1rPs`7*-Nye1;W_sc}Wkhg6B#ABBnG7gnJwq89xcL}M+oGvdv&A1Nh3?TR+6 zx?^Wjy_hNj=9L^P_4a`55AsNHNn)C$SIC=#M;ZW*`&3!*)zvmt7CR1g5vGNg$Y>TZ zj>8h20|c5qA2f?nSVr#WYE9(FiBs*F1q?_}1faexjP9p}Z(nmq2DIuZwfJnVj9ywu_#@(9B>v>P2d%pSly z72Ob92i$S8bJ}lbKL=ij%RV6L3%0SO(T9pWXMyqGdMOo}JM7Ed3<}xDY}XjW>_Ww* zMbo4Ro?#Al)zc7iw*6Wfu`j>|MI+kKk$REN9GDRNA&pCRn}0S5Bl==}J7E7vCc1~y z2jJPde_(ldmlBr{sm~^Bgz}6p(n^WLn`s5Daa&3S(&}It6q}b$sfDf&3j7L-|8C*X9Hz{>H$ogw43g%pUU=(F4vWMDjNqZ&ie2;fScqOqM@A zjMylfx&F?Qua)`NO~QOBV^ZW#O|J3#;id6a6f`kbrjEsHm$f}?N;0?m)1_iL@e{{S z!9nH5%|*03imJ^w$@?Tf_BqmumE9_Nl2YgfY!y8Qs}dsXx^sO1em^R7#!PNd2IOhEi8m zX()YCRr=CpRa;9hsPEU(FV*F>Oh!%2X1-F>>zPFb?*BjP`da3LTH46=sO8yM5ZHh^ zI-AO=!S!@X)i*NTYHBufPR%Z59;o{|cAp%-M6m%;~Y-Y2%p63`JyMW1buMO-FNTa4S2k?qGI(_*RdU zyHYHC_ybj9r(olBs|aXBfkcNmF(fF1DFqU%`i3E5k5tc6q}AaqPz1!(-BRCdL~j&Q z%(tmi_0%bKdN!3;XJ=F6YG^DqtA^LPrPtCus<58kugdG`v#Od;S5<8&eM!~(F@KHO z^rHHHEd4=^4P`pjL_Tv&P4z(?H#3`=P;={*!>ehzKYLKEU~hZJrmT!( zZ+@hSZEw9zN+ozh^5yC|nxt%Qgx#8>gicZ6`!n+c}^;Ftpmio&tS zIEEgd$&m-8I((y$3=NLg^+pjM(v3=il_FXT0ab8xVwjqofB?r9_+=N7ON~KcI99oc z05Uj3@g#c0Trqbj+^=y4TBU-xF#2ql%MEx)v0Df>V^|owiy*Ihk*6l$#00ovA!#X{ zwCXsVp#e{;atWQqkqh`1&Q|VcoWH%JLhxL_(hqoPif}=11UA#j8C35jq;KPp^ia0Wl%@qJuRXGX-V_@VXq5_8taM^F5 zYxOdqk)HY`#v{TZ55WMK1xz&a_A{w1eEQ+XkKBJqlE$^b5q9{9YmOO#Zyy5}ncrWA zg5{EEKLktS+q}#6ANTBY8&W8ycgg-fcx~|xES$Z7kDDbk=L7%1voW1(+au?fr7G}y zQi#uV7Gki8s^XYZFqUl$E5b1l^wLmOI&!p$F#}u_3d(2u8CJKU)1Qs5qf_z zbeF82#F(86zloWX9@^XTwm7&ZiVk&_?lj8yAHx!Ak_@r&^Wj_h;v(kdW5~jid`s3= z)qGD294|cKkd#o)Tk({XJHc9lpWA-I9`co7gD^j*Ne(P`@|&15S^Wtkb0!^GWM7G6 zFpGT6nyE!J7zNsW>@~vj*Kt@z5ev{*ek;#t@?JT`ET3IBQGkCQj0O6dAUGtd<#D$J z-E%=60hG=yTrua{+8Cb>))*jDj;#&6=wZGMfQqE;=(q<(3d1o_w2uxH(Q*9knGch} zc!yu`MdYlIJsRHN2*>B4uR>lxEpfmj3(!&2*hB~B+1GNWwp zBGyj1Yjpu&`Eub7nB0Ebd>0@XFc1lJQLO>BL5d1C9Krxi9%4_Z;K+hn#Qatd#frqe zUrj9mM(OawQy09#ZfYG`Cuk+ouw&t<^=@r^F{x6IzBYiG!*7}|bT2PZb);z)q{C?R zb!ov-5WiK-w|pT1tTKc_B4-@_SE>GaA#lR9DEb@vpo8}dyUE)2B_rjD% z-Z6-WNM>{!*Jx%VI(V1vn&qoZaN0MYRPYcfFT zco;`;u;X}T%_Co*(AbBBgH-XtMs$)33J+V(3*6i2EggL$lgJk^FaSA~uGS4YTZ8pE zIth;)6O4r>;+L^nR(`N2Yv5OrzeF|84%lpH+Ut1gh_VPF}B80 zz7g%7T*~N6R{hd`rNF{%7jAKYxX2mtgBKyq5Awxvj#rFhhb-*ExGg~Fa@j_w4ZsOt zGK>}|?Z;#M_F&UYI<0$rtLYTr%H-sQrwykwIxexfa>ofX2vlZGDiw%u01_P}Fzf&U z@&>{YfXrahA1q_P*$aR*uA5v}3R4J{nSZ3#xDzF4j*l2L z)>Ngsf4qEdjQ996)LLj$6RGAQmqMRyvZm|PD=XtjdoHR!pWO+Z=&IB1LAOY~UI=Rw z7IRcjFE69mz{L2JWNI2Vk!J(;M9sJc@V=BXO$=z4TEg0NkJ9s^37Jkmyn`A5$$3~e^d*qNU2!nECA8n%q#e8%L zjSF)RRRGcf6`jh6+Jn|iml1rR>-NHWJo|Z)xes`b+&rT5C0m2H26!B{CZX6qr=P9aAtzXEN!8$P2W zWdim9+#;&NTi%iP!+{N~lzhEOGe;gCSi#{I0aTAJQa!iU- z*kSfs+#Ikf3Vqlh!_}0qndu zIrC9W2!OC@^+o{7bW-BH%hkihxG1W-6!1Qtq_K}&VNTdZ1~RqDu`n!WXlwvz-3E}z z&wzFkD8HjZ>4W%t5OnSq#xQr9T%7LZCC3X=dWQh{dsN+oDD;6)ft-fYvZ`*@(#H$3 z@qE-v5Rlp0JrYLY(!b*fkOHgS>>NC@S4?jzBl3{`lj$EJJ!$+VW2=5*eZtt@k+De| zNlnwaJ=81&o_%5BV|B;Z5`>EHs#BOmz8y|V=XXR&=lBeD-*i{_3?J(xhud;aWe)CB zT*>)~xI%FS5n{Y_V-8H>_bImkj8>a)He~f6R=uPIVMDUgup#rDbj#00k}*kC68z0T z1W}Dm9wfX6Sg(&p(S~-not0SCIQ)mce-}7^pZr4INhSr7xsnkDK?tW3avWSTg6OnH zgdJIWW!JJhPcY+!chYHsz? z-P3(=ecAk^3}0n8d<%rR%Rzk})5I*Xp4T!)RI*rLrxq56m#0^6E-!#do3hN1V9=l~ zxhs9~*z%5fy#CYG=kG^1IRN~5EW8Y4Q=W0Q!_b44qPM>0MM$9~Bu=L*4GIn+?Ql@Qf(?66pWlIv|&G_0*>H_ag&TzQ^raPM~#0_)=gWs_Ok(ky0^_;3ID$AA#t9SBR! zN2GHgzz}0{<>~xQBZYU6fh__f>r-GIa&SQTCG+mNEQl0=14?2(_5cD&N0f8+`^ykI zL?$F_NL4S65uMWJ48oaZY@Cz#jX^>-eSwJ8ewURE-I zwKx2d7_!YD#Vk8iRq9QSD15?R)*EZrKX$@kTo4{Xk}=)L>g$c zzyVgc$$#|w8|T{47m5VV>k#o9;es(?9xnO_7acLJ?JkO4APBGfjVpFzO#+f!5dzjF z-=QGj98JRBCF$hJA?Vb|3>-H6>IO28v4Z2g9G2J^sVc_acUM5R^*g;;`4VBJJ!@%IIvl4K7nTvO_f(o4S2`1G&j;^XrR=X zp9tw>U>TtRralj%ETmIqHlrke7D z)hAh1lH+2w`4@IJce@b*d6(*W+Ep<^lt=pxXq)zYQsy%rV<+z!?&aq4^pqZ7TAH7m z9G{qn*B3G%Vxy0*&fUTWH_9DhV8jK?DvunKOMc&jqCRt686C{BJ@#hgtRx!lgvoaYN^kNw0 zOSCT@2Y5lUk*Dtim<^;kL?U81JwVk`f{#K8o*raj;JH$kV|q>g!U9e!ggOLl3mqNc zsi7M<1Q?m4Y1|~%Dc2LWO-F`B|Dido`z>hL$`{kH74N}dQqF}9=jGIu@EiBqDzTRA zg9GwN_!c?v0I8mlN~rq)dBw%kKcC#xR1mPtA;SC&N!mxEl>skpm^;b@1M*f6VX4{V zO|zwPnsNs(y}Ur=5a)`UL@;p~mo-bJv2O`AVLJxzf_Psbz&3y3;{y5O7QL;5AB4y; zADA}Iieiuwx62C@gXvx^ck-F(J%3{w3wr_jX`_dQIoH&x<@v3Q67rpyKib=7$Yz?= zl2|uZdOK9AkxLy@f{Uyh<+0lwph-0>7Gn|0Z*5FvK?pXd46YB}mcrd>a zW!~Y82e*wG^BdTc4`#J;Yc}^DJm*!>Of1|$K8PBD4M}!FftpUGCnDf9{V0s=`A&=va{B$#A8)C zVm)A0Jmw9|1T5XABF)1JP~(5Wz+Ki!-VJVWOu!GfJ-X3}7bSCcfsuoI9kk5IlaI{u zJSG--=IJX26*V%&lhL!c;QrvaR+rOd%M=q!aC2nhd857NakFJ3CzkRpc|kf?2aF62 z@T`*)v7cl9CP@q`q2po?g~9y3>cYLXKs$)IBFYg137S1HHN85$3>(d~o}1C*;?bqyfsY>-;5mQe<{VtNuz_b# zXnJ8)=YJf9B1jkT&mFud;@_!7{C;g=@wSGRwll7skk1xkaQDluaA$SMzSgQ8a!_9Dv)B9aEFWzBao@D8;5s@sxIMeeA=_6 zlH9===~WB1J*KP^Z`{ zkp9;R0!DAag$lD4)1J!;`soa!)lE|=M`XC6FCD^zRznaKb%7AZc5&tc5V7wr&yAu~ z4>`*t_?q7xd>6)5UoBu_TmIS z=buHZL=p?TVpb8>sDd%t7g5BB3dXqKIXTU!oSkrH^v)F9pmAnXtrgBrEaN@~KjAnA zt>6!IPGvQOF>L3AfJRoLEw8?(89i_y!k+}ak5MUmhQvs!o}b7l%zfY|@VE{+v12PH z^#P|ZsUxZjz4H9Tmxyl`g9h9VH+vkaLn~kd90bDFKRaHFnd4LYi@?o4r1&86#|DCJ_7>~TDos*P8Pd)k1Z_l3SpY`J> zkDluPJb!`PUw`}i$us@e>*ueYJl4;D`TfbGSMui1pSOPd^Yx$l&2P`1{ru~bk!I51 z1H8bLaLw+2mNGE^70*1j_Q>0TMg)WnH2q`FivVy&116V?nrOfBmb+E5@Cd^0_K!kF zptNRTD78f2amzoxDNccmaEl?)f-4f!hn`2z@!7;5vPVOc@`!dDr&|<8LJ)wQIi1;) z8`RR+-=Z*%%?{I+^KKQ-xNCW}- z6323gBqDRrsv8=LT0|fdH44sTU)T*aP85OPKFXrdBq-*(Es~bEz6bM^cFfs$9IBwL zQ5N}7c#Ix!SjhSZ0%|(x7tcAuC(=atX_v|2x0i&Tidd@MTRYEa*EoBzwT~iO$s}^n zO`U9>rdXw@#ZZ3s{t+vQL05TY7}wfJ8Q>qe{xyABKF<|D1RpCl!Y zq?o7Vx=rJ+?GQMVwzxov85b^DsDQQ0!KTQ^Pu3;_6yG&8+jxPZ{4*%t@7gBz*$as{ zZ;x!E^|Q7P|5|HSApxd=kv5h;7bU5tSOkdJgdzfA!)+-XDq`aJCg#e&m)^|HdI50w z!O)wleK>!OiNKuGl{uvlkNqhGW^SsZs=cmmnCid(PkH3cp*3Z=cz*`UL6sf@p=i%p zgW-fTSy~3((H9sX`*21b|KP;cH?g(dZ+$=}=DwRzZ_o-r7=NBd81293@v|z6?d;_P zkcTmtJ0Y*0SJ^RDRvrE7mQ?VssD)piKre9QTODyrh<`&c8-mV2I%uy%P@Y&JdBO=2 zjx#6^7Dk-n21)|kBafSt;3?!FFGI2vFRH4X+*WPS6w##li!=QU^$@Q+^8FY~gfJOM zhyJpgQ8Lop`oRYsj~o2W;QZEif^x)yiOm?DB#ReVZgTlinuJd-&a zmZvj#5#|*lZ}FYQbfV@ke4U}UcWzzM8bqh)jS~3P5#7xJ_O2@#;9wY_L04dnjO)5b zoqy;~R1b_HzOJgwyVGN1=smwUE{~)Vv3wh!%OM7o2>&1E5Q|RJf%XhdBp50>1avy_ zoLL9zhr?w zA7}4DW)Ole?&r>k9i3s&OfYV2nErL5FRbM(gW!zcJS&)^Jqki1R@yYlRBK4FrS4kw zsk>wU?$VndL&f67W*3j2IK@aUGQ_vMK+k}5c%0Mubu2vRh3P@;Zvaur*N!i8`~nw~ z_;6w!axP|#VyekCmf>g2Po-8hh9LGCnGz(*MD+q!()*plWE>KM+}EnGg<_+5j(=uO zWZ@c(U|xhr5MWI^N-hbHu~2|m0|K%G2(e*`|EkU7TTb?@r=F5VGh=25i63xe7$%W} zW{#wYmc8g(R%NgNzkS7=wB1ZpEnMDfld_ubADjc(M{+S!5`cj?LTEZn1n8B$*w1`2 zXOkox=an(jI_y30xpzfupD_ehnjr!>8`N4&(@8lEd02KNP^L?N^ld9(b^VKu)n?5! zMPz83pg4lx#y|9)d8R*Cq$MLLu;wumLC>rV6NH&Ox*QQh6QXacu76*JX|ls=H>;46 z8M3R&nS{oLIqN6>u(epTA}A&PXj??~jD9PyZu8Hp!sYN3p{S6=#Lqx9-q zEZc*)azt%I@Rf7|(3;obSdNfQoT~!krUc95bX$gjL;VhCS{OAER|mgz_?y?@cBT0- zq-1!V;|SY2*d8cQ;jo3nS&RbTc!Wcvk2=Urk%_9qw}dkZg>h0zez4`O2S5IC%d#N8i z{}cDW{qpq5h}Lue(XTeb%TBEyKYw=i6-vK&`Q(Cr`Q+JS{rcq-s$Twl^75rqtr!^b z4G~B0fe`-@2>Amv(Wj#1cU8*m}>{5JgdmQB7@FtAJf zfr%?79WYeFQUq`*U_umlMpA?qM_)53CI1Yl`uS{vRRDpYdi)!Yfw$pG!B5tPA?X2! z?sKd=fOJ!Ev2i-{*cDU^e;#Plf?Bf96@Tx+=9#+ z%@}CF2KuiqULPhLKYsq?rT+Pu{`uAOKhM6@zdify)o(vP)qnr|^flCjzrJ|#1bV+$ z8~V3bFU9tIncBY?h%%FaRAeMXwZA2p0$?Hk@B;J(Z&DW$9{@He+`^p)uwF`o0$>si zX<}+TfC1FN7RqN57fA$$lMCRZD4?OBV!#ads|=vx<$`|Fu}qHXU&DP zS*YNm=<9PUH^Dv-K-fkTd`R?4z;OoUdHC3&T3`*Hf*Nqy8wC~k@FTK7B1!<}QW4=F zL=+yZ$+OAz^(QZWr9SxA7tddB>gPaRL~JiNpFAQ^yn0R;SzO+s`<3R52bXbMKCiI@ zGZlEXX5x$MP!|rSQfKHd6g^zW5anR1Q@kT!fYEe-abZ+`Yrp;`)Kb%y0(Ox)g#-tu zs13A-m{v9EC@%6DHJE3RAyu6XM=eml`AHm77{o2Et-=0$ma@jFP(*uAAL6gGl(s`Y z2AqP!b~|maPKHMo9wN>Sg}){Po+fiFI_Q&ego@upiZO0WCN1z^Q~=I06|+v4l7Liy=j`dM#joK&(4J7&n*Z zrvdz?phtThS+_Rj5lLOFWQ23jw&%PLb`+)o;|2&j)+%YE4fYNF}7YLV_q5U-&DM{2*Twu;wr+f63+XF&J;@=ISuQ zNe!g`(h}2As}sOD053s8jNL)0#fW1j_O$SGz|&$IQald5Bb)9 z0jwZ!AaP*g6UY~*D;MbMh@NiiUJGkijFF)iznR7bIblNv@nQGlV?=pKlZ)}WV;lXZ z7EBH`gRoFz8$4t#Y8-3p(JffR+tgE)0iuY#qF#xrHiUbj-AiM5!Kzk7m9@s81Tl|W zIKbGbUdWn;ymTV2LSAhE(u2Qk{#n~M9);9eP5>y=vIByA$SL+7td8+3{28QZH+d66 z6qzOjr}NQTMr?$;MUV3za zCaNkAc^>go%)wNqXC0jA#B+`b;u^^0WD?OKjutulAnya8GY*UAx#y9l4Yw^N@Wo|W zCWFYqQ#$rUEUE#06ZXU;+ZhnKVKx9pksw|Vo{?-|(L5SEFP-cNt-`I4wXuo40M~>< z2-Mv#UlfyiE8DLo*t^6dcb$}i6Mz$s=d^&_E@Fu#xhF5qFRDXJTstmYSWG^8Fu^)* zDD#D<%IGQn_C|7T@9o-Rsd!j9q!X)FF}A6MKyApX*)yUI(QFO4|1%3B1Zu*Qhh6W$ z2O{(}xp41K64_8l?UL1F;B$urJ`4TJ4`Nw~gph0)XrFguXZV{xVfuY}5a(O40vw9s zJf(kpj0imQn85&+*Kx7^v&8L#0G6SmB&8&H@8mZRn#G5!K;zo+Ho z8xqyA@OEtqZLpJK6^^}-&*;8>ii85TD&STb$J#u;;N90Gf|G_=GJsb1^3sM&?1k_i zOo!vre5)zSV4{2(Pxm(+e!Y*H#{daMca+r$tH zFU-I-oMDPNF!l{Y2|=_tN?D%o`4%qxvJ~ttCRW~lTwdoRDAET`#3jCvxf->OdnCit zq)m7M-kQDtf1O=xPa8)Roxwy$P`hX3yL?_s*SrFHdPJnokR3ci3kzL8GtYoFjsb z9@uwiJO}l|+Xoo=DmI}Qyenf`^9c_#+3M0}XY1L{ig`t$*2URkQ8!xpW4Lqk=&zRh zTBlK9-*>~W3X=x{*-pb#dSn!n2MdWf;~PU6V2SD`T8k3Jz^JR?o1z$KJ7}a>hIB)1 z1o~z9Ujo5ep5#Fb``Qq3Qvw~v+WE%}vr5Y@>}(M4*vl!Wr{szQZA z0FnUMDu^L&FM7NRm~wbvw;PbmyPVO#hN03P%y5{8?Hm!3g{#0BfE@s993defltHIO|Cd|W|}Af8+-t-9E51>{gciCI}F9}8@sXs;pi!%RP~sb z;v$K$qslon$Y2_&ScA22;v&R9(W4iC{C48JH#N@S%@yZRxftZRy#@<_5N~tw;9>S7?(f1hk=AjGVyI!}W~hs_?n=Srg5ykUmu^ne;5)N)Bjt=Rm}8=W=hz0{o?L zo9w>)WIRP?4~gOW@^|g`_~KCv#+6r60duee&tyOUw433l%(4!HmuO=2#lij;`Lvp( z7RgS${+^x{Z6AmtF1{YZnt!CLk*|Mfr=6#FH&1?OI6I9nHgO%LeBITi3q!yF9fv?T z&5g;{5re_K(j`eyi(}7O+@^W#V8P~tY!-2-5e%848p~W*A*rs8MC7aQBAxRu`eHuF z$5(z0LidV;>HWM={G?cvYiYa?!KXR8{F*TvBCd?C8rew@oDc8`G8679%Yg!5z!jfC zlIhn-AC42xivwhcZU6|G7-DLwes%i?>T+K44e|(j#%D~ULO_3BKiWf5q&w;O`}*WtdGc<1zzJks?Q(`6-@y~lUhe-bNCIX4BjN|=qh?2R6J&3q=s%Pwqp5P8`nTiwS??iVbIcKFBEbt%4@$j0TUYi{TQ)G{IX1;ItecB|bcCZ?U zgoV{v9Z^UKioYH6Cnq%3r0Tw4^EYDi<*?afqYsmY07ul&t?rP48QpD${pJ;S+Q%D zAFkdV02bY>PP#LRUSkNQ9%s_SmjLy}Irr(fU(`P$;~R6eRza_?Ggwx`VVeETfpwm{ z@vOiHjpjx^2-huKja(8vNktz0t28&a+|WKO(g4k@8~N4ky6ao+4P3$eb*zQ@`|jfw z66ml*{R!^_Wne-n@|Tz-Lh8dUN;>`glX>iCrRIc<(g=oySp3Kf10yYi@-vkQ5|u!^ zXRZz;Vj=r%A)5%C*bxmhYcUSLf-NaF7t96NVNC~jrjB74McN3Iu%?OB9QY;nV#5cE zxk-@Zg_&2Nx6xgT`8^O%6u-jGD?ArjS?Eg-w|XuQaufGANRh&ebPYqg5e8*cb`m8v zp;e+{b}-)i+%P5D%ML4Am0`~OSAQJ{_XUKPL8{dt(q$h2tCUQ`)I|AZyPy(FL02aMJ=?K#9OYy-=b}35Y_8 kC=92$Rss~F3/const.bin.4 b//const.bin.4 new file mode 100644 index 0000000000000000000000000000000000000000..74fb0880f5c0792660d064de147959b3f1d7bf3b GIT binary patch literal 390 zcmY+Ay-xx`5XB$I0T(MU7I%wqX9&^4!U7Xx;}uXDf`yw{=_VS!V&WYi0jl}eof+;( znBwhkW?p7z7ttO#tY?$1vF$8{gt48>6%^+R6=QGmM3AYMr$U~w{oE-P1EQs5sPd?v zk~*JCzOnH~NyAktSTlCGcS?th4^CI_lGdfMQM&&A{dz_CBuhHA(3LbA#*S)(l3HpG z9@pXG9#JS|jX<=C3J{7U@PIp!2UL%aQn|}-qf=;|h(CvjcO#mMIFUD&=?ho+o`7aV iI|NPj7ec!~A|zb97</const.mid.5 b//const.mid.5 new file mode 100644 index 0000000..32a0ea4 --- /dev/null +++ b//const.mid.5 @@ -0,0 +1,26 @@ +TITLE CONSTS + +RELOCA + +DEFINE C%MAKE A,B + .GLOBAL A + + IRP LH,RH,[B] + A==[LH,,RH] + .ISTOP + TERMIM +TERMIN +TERMIN + +IRP X,,[[C%11,1,1],[C%22,2,2],[C%33,3,3],[C%44,4,4],[C%55,5,5],[C%66,6,6] +[C%0,0,0],[C%1,0,1],[C%2,0,2],[C%3,0,3],[C%M1,-1,-1],[C%M2,-1,-2] +[C%M10,-1,0],[C%M20,-2,0],[C%M30,-3,0],[C%M40,-4,0],[C%M60,-6,0]] + + IRP A,B,[X] + C%MAKE A,[B] + .ISTOP + TERMIN + +TERMIN +TERMIN +END diff --git a//core.bin.4 b//core.bin.4 new file mode 100644 index 0000000000000000000000000000000000000000..4a82c04791a1481fd2413f8e2c3e3ffa10530dad GIT binary patch literal 7520 zcmdT}2~%1@5}r5j4I+o4f`Fhr1r-&~fLEdcMe#z>puuPajRzQm#Av+buWxq`0rse^ zt*zSHU8?fZnWOvbue)dZy)gF!V~@Wswz@1&Cyag#)}f7xWEo$SlEM0^q?4#wuX?2< ztlzRx8WW_z)K-%J)XXm9BuyBsrO+u!s0oy7F4ilGoP$& z(-PfkTs22w1!q>}Hhl?Fm^HO0izuzI&Xz>aXOI|k`i>YIQb58#EXWxX6G)ZWdj5NJ zshn8}BR(a{6r)^>%V1qY`8hNX`tiZ0qVNcHG1j()QfEv4L-30RQc#0+6Q>Xb8;jcb z9E{nv1MvJ}1d9_vm>7a(rWSZOM*{G~e>Q{w6vGEcKpN?T5pZ|`98)xqu27N%&Bz4|0&BZxRrp!iQ3Q z&;;#gp*Q&ZPBp)k*ouvHG&}4jTeHKU+#g$ae;u)Dy)qWX<;|196#flvz4&`~nbCzj z!_S91P+A^{5z2US+`sn z#$I$V-he4jzgdsI981SG^rfAhtsQ+K7T04t2|c}~CzjIs;?~ZR?!nA5tlOpy=(+f7 z&wrukax97p>pl1PUe=NQUk&L0Z^$6=e;kw`9h;h+DyEKN?)SdfQBp1OvycTPt2Lbu zxln4y&?+u(-rn&~@)Xi63XA_HTJ^>BUyT+P6W=IyCjJKGaD26Ox|UKM8^vc?m%W3J z+8lGa7^5Au7uIc@`JELGm{c?)|p+Z!m;O zMRz#n6@OW2DZetHnUycfyyvT5a;r!Kf*49ujCFBAt* zI$TKGH+0%1_Hu12xbBNOzOg@slA9mCWZ}XxC|Ofca6vy84Z0nZ*N~3j1_vW7v0n74i?=m6v#1EU! z=3yBRIsP;qHZ9g&%HZAsv_|+m#p}t`faLFwmLm}{Cy1epnA$qL!X4v$Gn2QVN9)M$ z09rHFwD5S}6k+BI>30p(-q{Rq@o$m?)jr%fh~0;$PDS$hW))Gz`4N}+uIlVY%?8pp zqK=<_{eU~>L?qv;p)@5ThxTcd{9?Ov)P~X!FqxtqW;M3yB~&x&_^OdSN~ys#PvJUE z8@#d%6FxP&^A$!6EP-*GMrp8yN^DGBpW==j%${E1?3fnZ4vTpP0Ewk!F{Jsh`?peDfoY z0o2!_+GlL!Z;~HhwUck}wdhVa6qbSgs^R0w%rv4>f>;Y{IC~Ej;LM=}thocE<=sC( z+MwF5M=9p-cy?CHdj=Yj_56=9*=-x!}?8o1>$2F$PJBrI}&U6J;cHA zLfUyh0vkAkS~xP|-dV91FXm7RA_78c1IZG`F%MMZk2p#_z}oHxN*~qWu8r#Vt!Axe zgKv-QQ(hf$pLRnw`rnps^eExuzP2JmEu-MabqPx!Jgcmq5#whfJkmgU zU=5s3Y}hLJ{4VrOImNt3CY3Z_?=g_S({Sq9Npp$61v>KRN0?vy$YoF(5Ia+Mw4;x& zY`Mp9tfPh{K7Haz!w|Dnu{^0q7ljh88$=Gs#yCH|j1hk}v7axI)X=rAo3|yt2j>kU zVD=im_;j2UWAqL0hz%ECo#e#YSPe7OdDkj>l;DxxE1Eq~Go`qO2sXrg#|Isyxhj?* zuUQ*EzoB&|s4|}g*BL~*|JN-_+YegD?VilPstwFtVq-$Joyyvu6ziU34tK=hbX<(0 z}OW`J_m`R!%*! zH-AT(*J}u_HjPcMlE3V%pbEXld}%{#51<)s7+6UAKGGLLR4X+sFndNP!+_X2TO#z` zOBSD7zT$Gn#vSTY8td=@QoAS|_IV-RM>*6lGP7mE*M{g#xWf^Tr+=40i{y{& z2Km^%v|$(1hG&csn+2p^%Gh%)_@ljmW6fe_P*!8(=M?u}5k5rFinIN2{+V!{lEJYY zj=4o7Ua7_!0*&c)w9&Dn9C^7A!&uqN*hHK@rtnt)#5 zf_O=(UpI_Pxb8)*q8E`9KSi}gZJr#boLoZ80KmWqGil!ETPZi$J>!Y#gDB$Dv3dw| zuI7#{z&QXV>YGa|FqjHkCU2X{qo745#L^RY`t z9Moa9U60^8M%f91f%PKNTa-G~{rd|-+93AM80MdHQ-=@w4f3*0J-B;8&B{g%6;?OZ zY9yC@y^{AEKQ0&vK}dX>4Usgj`AbpCD}^7g$qFT|Xm2lcM(4z{!d)SGe}v%d)M#%K ztetHj(m{SvxCx>k+lb&hj*TJ$@?#1z(S@8U1?c7^f(brh`Iy5UE!}-b#x+^Ldr5h} z_3?N#PyQ~0W={au?I3H*sO43)?HGwQ3s0=&*3jA`vPPJl$QoHQs4g)@u}tGhL$%Pz z!v`%<)MpnvUg}Vk=cVxPh9?+;^P-9#qMy=nU6WqWg3B_#RX@}L{xXPI%y^&E$?#fd zcPJVr4!Y_P`1~D4+>wWyQ}%Gvkf$2mH~~1(m*Qw`Uwq0*d=6xdILK@M(;2kJ1Wzng zY7na%xmV7$U*f0i?-A7ij+vmMTM>?ix|~aoTaG3=Sc$##NU7RLIgF&9O;V*un(Uc5i{ZI6v>qAui|x> zlj&w+cY)_8WL}LSDta$7X#1Zf&uhM$-o9sKTMyH^ z8or(yK3>jk)2X6C?^x-`{sHEX{P@T*fPQow&s;v{i9hTus1N&9=f_2{gR*22&jUIw zCe_t_`Of*Rh8dXrrXw4~qy;tKRgrp7f)A_)=%k0s*OVm3fL)-4I@vC$hx#* zPGW8-m!ZaZ+o7!AWM-1G7-k&{g!E3^{Uz`7H4(}E>9pW3t05qsYY4j4@q#Ij6>uz4 z;*jiqfSbfg-CU=5zb(5+rxy2?h)G`^(kecTCGy9#%}mdvUE+h9#uF3YNHcj8N~;dj zxS;ZN7emB>}|>ZbRMy+quoof z>5%?TLGN98OHhZF&PkuB;TyEse>PX~;Tfx()$qZcJVocrvY7k0hI%F}Gg@22_wx{9hSN4vscFN$cS8u}^pp)UFb~AfK9vQ{8|AZKNQ2XCk-h{=u^0g5)--^uU7~Ls(=p!W0%{2sK z3qBwt&ki2%rydEu@xWUpA-LAQTZd_OHU8Dx37FykI;!}b?RTldti;F1Pib8zemNn# zQG?;7hdQHEo`_EoQXMM=Zz~o_cuX&l2k?Dw>9Uyp2oiL(k+VN!31=) zyFWA3OT`w_{f>7yrenQTcAPtNQLv^Iku~&9S;4psB7#Pd(kfqZkQaJi^(~~kAHJcM zD9=8PQ4g|-w;H~aDCZ05;hc`Mn&rD{l;?Au=BF;%M-0{3uoUIHsSj;jpg({L|P2d}7Fuj8na+3$BN@2ledki0e8;Wl;0k^B7* zYnL0{l0Wcw2<@6g)EOs_KH?WS;^0t(*DH7JqAMYNV?0|7P)2ORNhrUUIIHNp5GnOE z^tDW)uVKar;uu?~ekZ)IqSyGDPv%C?SR#1z6aEhl-f&ZzWNk2i{r!HI=`dzWHZJ9W i<^H?7)|1vjmVuO^56LeFjqnXQ2TN+dvJXCW((f-XRnYPP literal 0 HcmV?d00001 diff --git a//core.mid.13 b//core.mid.13 new file mode 100644 index 0000000..f1f2dbf --- /dev/null +++ b//core.mid.13 @@ -0,0 +1,145 @@ +TITLE CORE + +RELOCATABLE + +.INSRT MUDDLE > + +SYSQ + +IF1,[ +IFE ITS,.INSRT STENEX > +] + +.GLOBAL P.CORE,P.TOP,PHIBOT,PURBOT,FRETOP,SQKIL,GCFLG,KILBUF +.GLOBAL MULTSG + +; .CORE AND .SUSET [.RMEMT,,---] FOR PAGED ENVIRONMENT + +IFN ITS,[ + +P.CORE: PUSH P,0 + PUSH P,A + PUSH P,B + PUSH P,C + PUSH P,D + PUSH P,E + SKIPN GCFLG + PUSHJ P,SQKIL + MOVE A,-4(P) + ASH A,10. ; CHECK IT + CAMLE A,PURBOT ; A CAML HERE IS OBSERVED TO LOSE + FATAL BAD ARG TO GET CORE + MOVE A,-4(P) ; RESTORE A + HRRZ B,P.TOP ; GET FIRST ADDRESS ABOVE TOP + ASH B,-10. ; TO BLOCKS + CAIG A,(B) ; SKIP IF GROWING + JRST P.COR1 + SUBM B,A ; A/ -NUMBER OF BLOCKS TO GET + HRLI B,(A) ; AOBJN TO BLOCKS + + .CALL P.CORU ; TRY + JRST POPBJ ; LOSE + MOVE A,B +P.COR2: ASH B,10. ; TO WORDS + MOVEM B,P.TOP ; NEW TOP +POPBJ1: AOS -6(P) ; SKIP RETURN ON SUCCESS +POPBJ: POP P,E + POP P,D + POP P,C + POP P,B + POP P,A + POP P,0 + POPJ P, + +; HERE TO CORE DOWN + +P.COR1: SUBM A,B + JUMPE B,POPBJ1 ; SUCCESS, YOU ALREADY HAVE WHAT YOU WANT + HRLI A,(B) + MOVEI B,(A) + .CALL P.CORD + JRST POPBJ + JRST P.COR2 + +P.CORU: SETZ + SIXBIT /CORBLK/ + 1000,,100000 + 1000,,-1 + B + 401000,,400001 + +P.CORD: SETZ + SIXBIT /CORBLK/ + 1000,,0 + 1000,,-1 + SETZ A +] + +IFE ITS,[ + +MFORK==400000 + +P.CORE: JRST @[.+1] + ASH A,10. ; CHECK IT + CAMLE A,PURBOT + FATAL BAD ARG TO GET CORE + ASH A,-9. ; TO PAGES + PUSH P,D + PUSH P,A + SKIPN GCFLG + PUSHJ P,SQK + SETOM A ; FLUSH PAGES + HRRZ B,P.TOP ; GET P.TOP + ASH B,-9. ; TO PAGES + CAMLE B,(P) + SOJA B,P.CORD ; CORING DOWN + HRLI B,MFORK ; SET UP FORK POINTER +P.COR2: HRRZ D,B + CAML D,(P) ; SEE IF DONE + JRST P.COR1 + PMAP ; MAP OUT PAGE + ADDI B,1 ; NEXT PAGE + JRST P.COR2 ; LOOP BACK +P.COR1: POP P,A ; RESTORE NEW P.TOP + POP P,D + ASH A,9. ; TO WORDS + MOVEM A,P.TOP + AOS (P) +POPJA: ASH A,-10. + SKIPN MULTSG + POPJ P, + POP P,21 + SETZM 20 + JRST 5,20 + +P.CORD: HRLI B,400000 + PMAP + MOVEI D,-1(B) + CAMLE D,(P) + SOJA B,.-3 + JRST P.COR1 + +SQK: PUSH P,0 + PUSH P,A + PUSH P,B + PUSH P,C + PUSH P,D + PUSH P,E + PUSHJ P,SQKIL + POP P,E + POP P,D + POP P,C + POP P,B + POP P,A + POP P,0 + POPJ P, + +] + +IMPURE + +P.TOP==FRETOP + +PURE + +END diff --git a//create.bin.3 b//create.bin.3 new file mode 100644 index 0000000000000000000000000000000000000000..2ff15e39d592ad5e2abcb65f262bd27e2b2b48c6 GIT binary patch literal 15860 zcmeHO30o7*vaW;xF(eQIgn(H_0*FX7pg{CfnS?}8K_Z0Jg?$lO6;Rgv^;2)nWG2H0 z_ac0pbI)__=ONVeT3z*abyxKaHT)tv{INO`b{{Q}q;k*0A)Rt}_G?s`XKY6i(&5=? z(Wp|-;;brprP6_`W=DH;R0NzoQc&jE=~xn~#8Ww?Q!e*_WD&WVPc+JQxWk0&WvBk= z8eh>U`&!dc)JYA4I+L!gyLy3pe7i#c5D70QiS zCg&;^-hPlOipTk;LggBE^4Rur>r6eRO8@W{C?1XyL?L(hbcRWy?fUMWZgK|5rs6T| zfB*P72)Z}lkWEuU;eNi}IS#4FtLkaX;y+QWE%tOlN=qW+-Z>R{W@*RnLL_2#8p@rN zXq`4SeLG20Kp}FXMJd?u7`!ZxG&$a)Q=11ZR8%oLZF=!nN80SP2IHazbxirT!v-(A zD)P)`;H8oREHfVREf=*BnM0y3Wk*N)Gh<^+skFu-!7LZK`(0`ClM-<%!BltN zp@o!6J+Q&`yhQK1>QCFihSa-=4VTG%Xs5NY89h-`d2)G%63kWU&cmz<4mIvQJ3iY( zJdrQH`=y2gTqTJ|O?mddd|ntr7KNWhce^#wp=T9&rVN_yRoBg!gX=tV6^PCwqN{}B z&o#Su^p!GZGseceFaT_XUs50dfpLy@cEc%Lzs0Qem8xa^`c|sS+cQH&i)Sol@LPcBT0z z_%J&BTp8lZ9cL()HQ3!){sgq|<;uP2J&T;Lu?F{4^kwQCxUVofy?hOV4Nrj=S~`8W z8_QA;g_rQr`88+^iMlkJ85N?>QYgfS{MEKtFQ*E z9fdVmU0PU!s0Uqk)t_vD4XnWn**GW?$xYUvaIdeyY6tkHu(xe>P!rvi)*yK1#A|Tt zP(*iYYtV-^_zjzl&+eF0o4UJr+$a2#7wj@+6BM_auocAirsEpCA1GzKYNfPSRns=J@IYZRKT@1n`&OEoUGtlp$24f zvdcgkjbGii$KH?RVx!~llc}LhY-BVhaKi&vF#(rF3%2dm+#8#UAMVs=-jCu`1~df> z)HN8W<9a&k9zlar?;`%@%t>Fz@+(Aayg1nt)F`~j(^6)1Yxs8nrwIvwTfSYuH3D#p zF#3%uDM@TuXFjp$Y~aZzmO94vS+}C8Hl_@VsY8mPrzl)GNltrQx3-+uSliC_xr|!? zaDufa#m?eU9Q*@JR(15m$rJjM{z%}D1pY|ij|Bcm;Ex3UNZ^kI{$ELe8WiePn+FTN zID9ntJ%1VAPKU%EaEkPZ8>Bec-@nJ_Q>X6y@X_8IRkcH9D+;9E3-K@-ds-g(xJ!DK z9uIGxnCJUzIW_(b9_E}=(@Ri-Xl*Kj*!hL!vIFMl;EGv9ZhtGMy>*qx`4hN3B1ZuZ$MFcmGMjkMf@u{3z7Z z{HSjZumSJ=A~phNMIyO@_pT{V_ul84JzL20Z1{B-GnKGR83DZe0u{)^AaGV;oU>D+RTA++0cNEIC zbIi@fl=3!`KT~*&F;IDlw2{J-HcLC$4?Fv*R8Mvxy70!!tTanrM;k9D`B4VB?Ns~y zeEvf_NBy|eW#J4n&kFv)76r1%b>KGvs*nWtnNfbU;J&_EaKH3TEpIB|zTR8FeSLKS z_o&AcZ#$aes zx#Oa_aZEKZLxEq&<+$xRFeG!i%y2dr%Zu5STPOy>w$Hu;DE5LR<3-j>p*=U6V2wc4g6zQ>A?KqupxN zCk)g*Gf>C%G}L|l01m`9UBp3uku+|wCu@4s_vCub%0}(|>$95Ft_D5knG>YOD@wUV z166=tmL>yU=Z@S~t(hTAOy)rDd$2vRdE)s*vW-c(@0mGzwfv&Vl-l)x`9kHM&w-&> z6_?$)mV=F|0xvW-(0=+m_dWG|{N)4@rwm{YtH`qgv+LZ6(Hs(W>GfzPgMj?`opV^w z`J#StAZws=$Ux_?fljWcqqEjP=S6HhGUa@oos(CTTzP8BE1*+*i{S2l+kMt74%=5l zC-ck+qU*d}bk4vqMsZ@C33%OnWy<%f=h4}P+eo1Evw&4q^~Y&>>?u61l#uF;OTeD5 zR&6#p9nRpySkDu;cdA70uEBuT)pD=OFA|{BWpgcHo2ITIyazNj4P%%tw1Crm=GTkXIAxBGA_q>@pZq> zRfCgONx5U!uJPeJJE7zy!*`L}|30e+{#-n8g^%{yHMzN|2NUU;2>99TKbVQsnp3?9 z5&!G^D#3jfeOc69Q~YwqWwz4+HrxeXXystyovImtD{bn*eGCf&uy{ud0LwXepd!!8 z3oi`;nK&G5g3KXNmxhyX-doR;!2`i$g}=OUtzb5T2k%gM5o2uQl@>-P>haQLhhtid zJ~s8>PZjm79F&?Oz7CoSW>eFfZZgQ}Mcw#S zl})TDb~m!L$&U6;;Z+qL9**``g+oYjKv^8^HQCgI&nI?-z1^34fuP%z+O>cgx}%~q ziz)Ds{qW9s{l;Y(||ek2^;{JA$g1KoHTY#5#I=y!nh7h49+Ry`u6=mliHPl z8LE(GklGKC+N}X|7r=Bw_PZ4S8!)%Dy%qt^hy1rKzzj|FeU#wdo;o`cahg)Q9x%_p z|Hp2SZ^7*JQa7j+Yah$_ylNuD7D3OHeZZGjYlx5FI6521>dN zlyE%_C6h}AN}gQ6LD96XW4;vQl$M}FtOXvI6NhN#bK0`Hn&lEdQ~>f$mes8R%CBXM}Ymw4mT_50e;?`uQ9 zTu;}p@rrL~-~tYcUZuXNevhDE9+wmJ+xI*A9gt=)0KNaM`khfR2djQtF4r$!AC>p{ ztoof1{Z5xJ-{&xzuHP9$zcYq@xt^xq3FGzA(8minD0)rzAJH$5%L)2@_&fUjD9xZ> zzE@LjG0t_2^~;xkUOJW`jrHreseRs3(Vo*R8$u7Qq0S6v)S~u12G1f1S%L)4R|Bin7495xjt@Bl{VwIZ5BUyKGtE(dLBCOdLBFV{>GyS_pxJ>jK` zaXGPmKgwn26@$FddTGY`{j~aT(QgBPKf`BfDr z&VPP~2$eZbsnFOOt||((QNRJk;G>O4ZW{F3>{WHOE^k#`neFGiXZ$;Y1A3l{CME=w zlW6m%selMtNT3=`Ia{SIG;bGL1yhSI?XmM?iYOv5HUV2Q<8m;&;Hhe`^z@% zo)tN=|3eGLi-qwY{OyQ>JnlsWTg8lba$MW^{w)I5P=l0(vHh*Tv2nYMbHJW9KlW^X z^h`b2QNc&BGLed(fJ(Z83+Xvf_KK-c8`cClDttqCn?W5`eEBq532N1|5_=`3?Vk1Q zBcYyEbt&aFC|z-XC?8Qlm3Z(y6R0N7hAS^)oJz!iqm5I36l`PgHBbjt9X|s61&_-7 z&GIvD84tL?W~*o$uPjBCeGlFn0aace`9ij5ZHsD_F?5+KSd!eERTa^eVnqB$F$BEW zhqnH9$d9Gp_!1^w8i%%ylb8mzv>!T(zKN5zQt-0zaG|J$51mRuto@LW=a)<9|2SB$ zD51OksbHJTxA|$y;)MCt;FTrBJD9eG0ax~u!D{}Tkc|}K)+3LP4U1Bq_q;qMcledG zT^VYStB+s7s{l2YPNZ`ngaf+@!k)@KUJ;XQo0^)q z?-u?t?npxiN~xyq)zK=5&*^mTAP>q`(>c{5PWoT9+@HvA8)H~@$ za^Zk{=|rz^HC8)4+$wpG>n7t-1@(Grw|lx(P$hMf!I4j(;&mKql6r@A6LUWmY-lD/create.mid.40 b//create.mid.40 new file mode 100644 index 0000000..b0f5b48 --- /dev/null +++ b//create.mid.40 @@ -0,0 +1,376 @@ + +TITLE PROCESS-HACKER FOR MUDDLE + +RELOCATABLE + +.INSRT MUDDLE > + +.GLOBAL ICR,NAPT,IGVAL,CHKARG,RESFUN,RETPROC,SWAP,MAINPR,PROCHK,NOTRES +.GLOBAL PSTAT,LSTRES,TOPLEV,MAINPR,1STEPR,INCONS +.GLOBAL TBINIT,APLQ,PVSTOR,SPSTOR + +MFUNCTION PROCESS,SUBR + + ENTRY 1 + GETYP A,(AB) ;GET TYPE OF ARG + ;MUST BE SOME APPLIABLE TYPE + PUSHJ P,APLQ + JRST NAPT ;NO, ERROR - NON-APPLIABLE TYPE +OKFUN: + + MOVEI A,TPLNT/2 ;SMALL STACK PARAMETERS + MOVEI B,PLNT/2 + PUSHJ P,ICR ;CREATE A NEW PROCESS + MOVE C,TPSTO+1(B) ;GET ITS SRTACK + PUSH C,[TENTRY,,TOPLEV] + PUSH C,[1,,0] ;TIME + PUSH C,[0] + PUSH C,SPSTO(B) + PUSH C,PSTO+1(B) + MOVE D,C + ADD D,[3,,3] + PUSH C,D ;SAVED STACK POINTER + PUSH C,[SUICID] + MOVEM C,TPSTO+1(B) ;STORE NEW TP + HRRI D,1(C) ;MAKE A TB + HRLI D,400002 ;WITH A TIME + MOVEM D,TBINIT+1(B) + MOVEM D,TBSTO+1(B) ;SAVE ALSO FOR SIMULATED START + MOVE C,(AB) ;STORE ARG + MOVEM C,RESFUN(B) ;INTO PV + MOVE C,1(AB) + MOVEM C,RESFUN+1(B) + MOVEI 0,RUNABL + MOVEM 0,PSTAT+1(B) + JRST FINIS + +REPEAT 0,[ +MFUNCTION RETPROC,SUBR +; WHO KNOWS WHAT THIS SHOULD REALLY DO +;PROBABLY, JUST AN EXIT +;FOR NOW, PRINT OUT AN ERROR MESSAGE + ERRUUO EQUOTE ATTEMPT-TO-RETURN-OUT-OF-PROCESS + + + + + + + +MFUNCTION RESUME,FSUBR +;RESUME IS CALLED WITH TWO ARGS +;THE FIRST IS A PROCESS FORM OF THE PROCESS TO BE RESUMED +;THE SECOND IS A FUNCTION TO BE CALLED WHEN THIS PROCESS +; (THE PARENT) IS ITSELF RESUMED +;IF THE FUNCTION IS NOT GIVEN SOME STANDARD FUNCTION IS +;PLUGGED IN +; +; NOTE - TYPE AND NUMBER OF ARGS CHECKS MUST BE ADDED TO BOTH RESUME AND CREATE + + ENTRY 1 + HRRZ C,@1(AB) ;GET CDR ADDRESS + JUMPE C,NOFUN ;IF NO SECOND ARG, SUPPLY STANDARD + HLLZ A,(C) ;GET CDR TYPE + CAME A,$TATOM ;ATOMIC? + JRST RES2 ;NO, MUST EVAL TO GET FUNCTION + MOVE B,1(C) ;YES + PUSHJ P,IGVAL ;TRY TO GET GLOBAL VALUE + CAMN A,$TUNBOUND ;GLOBALLY UNBOUND? + JRST LFUN ;YES, TRY FOR LOCAL VALUE +RES1: MOVE PVP,PVSTOR+1 + MOVEM A,RESFUN(PVP) ;STORE IN THIS PROCESS + MOVEM B,RESFUN+1(PVP) + + HRRZ C,1(AB) ;GET CAR ADDRESS + PUSH TP,(C) ;PUSH PROCESS FORM + PUSH TP,1(C) + JSP E,CHKARG ;CHECK FOR DEFERED TYPE + ;INSERT CHECKS FOR PROCESS FORM + MCALL 1,EVAL ;EVAL PROCESS FORM WHICH WILL SWITCH + ; PROCESSES + JRST FINIS + +RES2: PUSH TP,(C) ;PUSH FUNCTION ARG + PUSH TP,1(C) + JSP E,CHKARG ;CHECK FOR DEFERED + MCALL 1,EVAL ;EVAL TO GET FUNCTION + JRST RES1 + +LFUN: HRRZ C,1(AB) ;GET CDR ADDRESS + PUSH TP,(C) + PUSH TP,1(C) + MCALL 1,VALUE ;GET LOCAL VALUE OF ATOM FOR FUNCTION + JRST RES1 + +NOFUN: MOVSI A,TUNBOUND ;MAKE RESUME FUNCTION UNBOUND + JRST RES1 +] + +; PROCHK - SETUP LAST RESUMER SLOT + +PROCHK: MOVE PVP,PVSTOR+1 + CAME B,MAINPR ; MAIN PROCESS? + MOVEM PVP,LSTRES+1(B) + POPJ P, + +; THIS FUNCTION RESUMES A PROCESS, CALLED WITH ONE OR TWO ARGS +; THE FIRST IS A VALUE TO RETURN TO THE OTHER PROCESS OR PASS TO ITS +; RESFUN +; THE SECOND IS THE PROCESS TO RESUME (IF NOT SUPPLIED, USE THE LSTRES) + + +MFUNCTION RESUME,SUBR + + ENTRY + JUMPGE AB,TFA + CAMGE AB,[-4,,0] + JRST TMA + CAMGE AB,[-2,,0] + JRST CHPROC ; VALIDITY CHECK ON PROC + MOVE PVP,PVSTOR+1 + SKIPN B,LSTRES+1(PVP) ; ANY RESUMERS? + JRST NORES ; NO, COMPLAIN +GOTPRO: MOVE C,AB + CAMN B,PVSTOR+1 ; DO THEY DIFFER? + JRST RETARG + MOVE A,PSTAT+1(B) ; CHECK STATE + CAIE A,RUNABL ; MUST BE RUNABL + CAIN A,RESMBL ; OR RESUMABLE + JRST RESUM1 +NOTRES: +NOTRUN: ERRUUO EQUOTE PROCESS-NOT-RUNABLE-OR-RESUMABLE + +RESUM1: PUSHJ P,PROCHK ; FIX LISTS UP + MOVEI A,RESMBL ; GET NEW STATE + MOVE D,B ; FOR SWAP +STRTN: JSP C,SWAP ; SWAP THEM + MOVEM A,PSTAT+1(E) ; CLOBBER OTHER STATE + MOVE PVP,PVSTOR+1 + MOVE A,PSTAT+1(PVP) ; DECIDE HOW TO PROCEED + MOVEI 0,RUNING + MOVEM 0,PSTAT+1(PVP) ; NEW STATE + MOVE C,ABSTO+1(E) ; OLD ARGS + CAIE A,RESMBL + JRST DORUN ; THEY DO RUN RUN, THEY DO RUN RUN +RETARG: MOVE A,(C) + MOVE B,1(C) ; RETURN + JRST FINIS + +DORUN: PUSH TP,RESFUN(PVP) + PUSH TP,RESFUN+1(PVP) + PUSH TP,(C) + PUSH TP,1(C) + MCALL 2,APPLY + PUSH TP,A ; CALL SUICIDE WITH THESE ARGS + PUSH TP,B + MCALL 1,SUICID ; IF IT RETURNS, KILL IT + JRST FINIS + +CHPROC: GETYP A,2(AB) + CAIE A,TPVP + JRST WTYP2 + MOVE B,3(AB) + JRST GOTPRO + +NORES: ERRUUO EQUOTE NO-PROCESS-TO-RESUME + +; FUNCTION TO CAUSE PROCESSES TO SELF DESTRUCT + +MFUNCTION SUICIDE,SUBR + + ENTRY + + JUMPGE AB,TFA + HLRE A,AB + ASH A,-1 ; DIV BY 2 + AOJE A,NOPROC ; NO PROCESS GIVEN + AOJL A,TMA + GETYP A,2(AB) ; MAKE SURE OF PROCESS + CAIE A,TPVP + JRST WTYP2 + MOVE C,3(AB) + JRST SUIC2 + +NOPROC: MOVE PVP,PVSTOR+1 + SKIPN C,LSTRES+1(PVP) + MOVE C,MAINPR ; IF NOT DEFAULT TO MAIN +SUIC2: CAMN C,PVP ; DONT SUICIDE TO SELF + JRST SUSELF + MOVE B,PSTAT+1(C) + CAIE B,RUNABL + CAIN B,RESMBL + JRST .+2 + JRST NOTRUN + MOVE B,C + PUSHJ P,PROCHK + MOVE D,B ; RESTORE NEWPROCESS + MOVEI A,DEAD + JRST STRTN + +SUSELF: ERRUUO EQUOTE ATTEMPT-TO-SUICIDE-TO-SELF + + +MFUNCTION RESER,SUBR,RESUMER + + ENTRY + MOVE B,PVSTOR+1 + JUMPGE AB,GTLAST + CAMGE AB,[-2,,0] + JRST TMA + + GETYP A,(AB) ; CHECK FOR PROCESS + CAIE A,TPVP + JRST WTYP1 + MOVE B,1(AB) ; GET PROCESS +GTLAST: MOVSI A,TFALSE ; ASSUME NONE + SKIPN B,LSTRES+1(B) ; GET IT IF IT EXISTS + JRST FINIS + MOVSI A,TPVP ; GET TYPE + JRST FINIS + +; FUNCTION TO PUT AN EVAL CALL ON ANOTHER PROCESSES STACK + +MFUNCTION BREAKSEQ,SUBR,BREAK-SEQ + + ENTRY 2 + + GETYP A,2(AB) ; 2D ARG MUST BE PROCESS + CAIE A,TPVP + JRST WTYP2 + + MOVE B,3(AB) ; GET PROCESS + CAMN B,PVSTOR+1 ; SKIP IF NOT ME + JRST BREAKM + MOVE A,PSTAT+1(B) ; CHECK STATE + CAIE A,RESMBL ; BEST BE RESUMEABLE + JRST NOTRUN + MOVE C,TBSTO+1(B) ; GET SAVE ACS TO BUILD UP A DUMMY FRAME + MOVE D,TPSTO+1(B) ; STACK POINTER + MOVE E,SPSTO+1(B) ; FIX UP OLD FRAME + MOVEM E,SPSAV(C) + MOVEI E,CALLEV ; FUNNY PC + MOVEM E,PCSAV(C) + MOVE E,PSTO+1(B) ; SET UP P,PP AND TP SAVES + MOVEM E,PSAV(C) + PUSH D,[0] ; ALLOCATES SOME SLOTS + PUSH D,[0] + PUSH D,(AB) ; NOW THAT WHIC IS TO BE EVALLED + PUSH D,1(AB) + MOVEM D,TPSAV(C) + HRRI E,-1(D) ; BUILD UP ARG POINTER + HRLI E,-2 + PUSH D,[TENTRY,,BREAKE] + PUSH D,C ; OLD TB + PUSH D,E ; NEW ARG POINTER +REPEAT 4,PUSH D,[0] ; OTHER SLOTS + MOVEM D,TPSTO+1(B) + MOVEI C,(D) ; BUILD NEW AB + AOBJN C,.+1 + MOVEM C,TBSTO+1(B) ; STORE IT + MOVE A,2(AB) ; RETURN PROCESS + MOVE B,3(AB) + JRST FINIS + +MQUOTE BREAKER + +BREAKE: +CALLEV: MOVEM A,-3(TP) ; HERE TO EVAL THE GOODIE (SAVE REAL RESULT) + MOVEM B,-2(TP) + MCALL 1,EVAL + POP TP,B + POP TP,A + JRST FINIS + +BREAKM: ERRUUO EQUOTE ATTEMPT-TO-BREAK-OWN-SEQUENCE + +; FUNCTION TOP PUT PROCESS IN 1 STEP MODE + +MFUNCTION 1STEP,SUBR + PUSHJ P,1PROC + MOVE PVP,PVSTOR+1 + MOVEM PVP,1STEPR+1(B) ; CLOBBER TARGET PROCESS + JRST FINIS + +; FUNCTION TO UNDO ABOVE + +MFUNCTION %%FREE,SUBR,FREE-RUN + PUSHJ P,1PROC + MOVE PVP,PVSTOR+1 + CAME PVP,1STEPR+1(B) + JRST FNDBND + SETZM 1STEPR+1(B) + JRST FINIS + +FNDBND: SKIPE 1STEPR+1(B) ; DOES IT HAVE ANY 1STEPPER? + JRST NOTMIN ; YES, COMPLAIN + MOVE D,B ; COPY PROCESS + ADD D,[1STEPR,,1STEPR] ; POINTER FOR SEARCH + HRRZ C,SPSTO+1(B) ; GET THIS BINDING STACK + +FNDLP: GETYP 0,(C) ; IS THIS A TBVL? + CAIN 0,TBVL + CAME D,1(C) ; SKIP IF THIS IS SAVED 1STEP SLOT + JRST FNDNXT + SKIPN 3(C) ; IS IT SAVING A REAL 1STEPPER? + JRST FNDNXT + MOVE PVP,PVSTOR+1 + CAME PVP,3(C) ; IS IT ME? + JRST NOTMIN + SETZM 3(C) ; CLEAR OUT SAVED 1STEPPER + JRST FINIS +FNDNXT: HRRZ C,(C) ; NEXT BINDING + JUMPN C,FNDLP + +NOTMIN: MOVE C,$TCHSTR + MOVE D,CHQUOTE NOT-YOUR-1STEPEE + PUSHJ P,INCONS + MOVSI A,TFALSE + JRST FINIS + +1PROC: ENTRY 1 + GETYP A,(AB) + CAIE A,TPVP + JRST WTYP1 + MOVE B,1(AB) + MOVE A,(AB) + POPJ P, + +; FUNCTION TO RETRUN THE MAIN PROCESS + +MFUNCTION MAIN%%,SUBR,MAIN + ENTRY 0 + + MOVE B,MAINPR +MAIN1: MOVSI A,TPVP + JRST FINIS + +; FUNCTION TO RETURN THE CURRENT PROCESS + +MFUNCTION ME,SUBR + ENTRY 0 + + MOVE B,PVSTOR+1 + JRST MAIN1 + +; FUNCTION TO RETURN THE STATE OF A PROCESS + +MFUNCTION STATE,SUBR + ENTRY 1 + GETYP A,(AB) + CAIE A,TPVP + JRST WTYP1 + MOVE A,1(AB) ; GET PROCESS + MOVE A,PSTAT+1(A) + MOVE B,@STATES(A) ; GET STATE + MOVSI A,TATOM + JRST FINIS + +STATES: + IRP A,,[ILLEGAL,RUNABLE,RESUMABLE,RUNNING,DEAD,BLOCKED] + MQUOTE A + TERMIN + + + +END + \ No newline at end of file diff --git a//decl.bin.3 b//decl.bin.3 new file mode 100644 index 0000000000000000000000000000000000000000..82f61edf4c0d0ddc6e18fc65863bfb72104ffdb0 GIT binary patch literal 37399 zcmd6QiC@z|7wsf1Sjtw)E)>F|0)j2brXNZQ6hT&@D2pQC2ClfE?ETl@IX6wxV)-7l z_I+=DKjSo+%-orC=H5F?233Ek)X~om3r!`*J4(Wh(z~Zg)I`oA_LAC#$ak$pPvn`BI;GecOua+Z}ydzE!FUzGD`Pv zORR*ojBXY0Jbflfj8flpv56GAD%F0)KO)wz%4+7mGKS*Ruu?at=5Ed)s?_(58_O}} zt5cfEpG`IM;fIWS>v4TFG*m zLUpeOzco3sd^dT|eT}k|sXEB*Q(j8n0X&={nO052#%D)OwX4)OR`3mS{w@;M=-yqA z8jdIrYq>8iCQl_DB|y4>QZs$EXPuNl(q)pM*cCjqfBR;;l-qhE`fgnfL!g5FyNl*i z-W0)0_k-G9NfL~F->g)1ND}353pafwe^i~R z3KdZmejDrvMA|2qi*9N*f3L4nDBsk^+AY7^OxXeNGntp$AqaeG+h3-eZcvPJTNbtT z?#I&wt6{ICn<{)PRvPxVG%PWyH+e5zmiMX-wMA-n{|-ELiey^RO+DjNvGJL7I@ZfO zbJ2>A)ear&96HuJbVRx&9U~Nj3M!)*J8nB?Lq`ZM`oRJ(sh}z>hBkU-|7rO4lDbLQDRd0Q%Wftpk3UgdICbVWQ+9N0 zL@^gB@W##bQd3z#F-mP&)Z5W<@CATg(NtD6vRG+T$81;hn7o%x$0bqMpkt9Cbaabk zTD80w8=sEO_RK9z#PBnnlRd)8vvuEIJvr$m*SZ}}_BfnGI*XGhzgPuHmr0iSly=F% zXj%x`oV0wa(D(l3_;ol5nGwjzXZhu%pPc-u>UNdiR9i~bHg76*zYm2ACyheH2Jo{& z9@HB688Klht*3PG4CqsJ--M3+eRPtTbsI4|#zv9*MV34khYHqw5sy%i8&>9%6uH0+ zXa|sL`Okjup`))%hZ|9c8%USr#xUDi^i?Ja9=g@aMqe2z=Ch1EHKhtPpQ0zPYCc8j z2`wJwmloxu#aB9B$~6&M3icw_3S^Tn>W$jOxZ60{VZLXgh;;Q|Uvq8D_Z-Y; z9n5zf%=aA3kuHh3>0q8of}mTiTrm$4^IcX_FfX_c<`5Twn8Uv^^5_=_iTNjX?4T4m zgu*Zuf>P}m592{@L-U$5lewmMZ2eM@FVWsLXSVk49&tcEbwECIKt{SG$X*BJ3=-6x zyVc4S2~b)McXqAOdqZuK#m5H1$ z@Hs^%Udm?=#VEFAQG0b|*BZUoRw*U0vqiV$+YSTrxw!& zNwv3x#lg1MT?4i%t!;N$e9K`m(j{3evvhQXYcomk!foPgRB1MVq#_U^|eG9YK`EE;krZSuxF}!$91vJ&V?qq-&(&V79*1+r^ zCGaqVh*5}~S0`%|3I6O@_u;2xieGpGzN6mK>Vp`5h*#eB=~1z&UsUMoUOixV4Lm3W z84MpT$+p59GEp1)`0Uf1l*^nS82;6y1mPMKjyn4S21{F=3MUJfB!-TkhS$zi5sPe$ClM_)HEw3lvm%1#@PEkBCB~xdC0@HkTllIheks$>!g%!r46Ft$TCo6NY z`FPLlG^PSB8k+~wO$Rpno~$^=W_X5gzd=WQ;B-@@v%2Y?%npjN$s|kEtzb6Y)JPex zj!+d0Qxv+jyT#Y(p%52=Jv5fz9y-Dv8s$>YNSTyL!^mv-T9xcBaF-P1c$qw@o zlX;~pf6r;qJMZNz$K9`(>x*8o}ZV=d}_Z&KIo4l7!$EFK( zbcR|KVTX=e4js20IwGA#$K6$jj+w-`nbIUVxZM_bHXXO53e6?I z<}tl!Ty5y!Qp?o<9ldn63moI0I+u&}P(`cTbJsjf z68K&a1g_YE%(S5{i|I?KiCahIJ1KT_H=9SKzh7`!iNv2R2*7C{X9#TqV5f-;w zP+X10ZzWSgaZ{jxQf)jic{5FxN`D3xTSZC+Hj76w65e$e^cxRs7T#EN(oo zS9dVHEb&y6n3+WfT4$_$}r*yg73GodJ$x0+AQp-q4vocep2& z=EhHr8$Y?-Q>op#k>6g*_nw+4AlpJ^$irM<7I9(rYlfdcWm56BWYEEsM8u5*^5H7PBC3D`( zgJ)at=2q>e7_fm1H)nrXTQ4cLI*g8=ZP&OhnVm*|X)>>LZluCLIi^Eu?OEOlN!(n(vG0NO_&c?Usu=mwVgV`GWGv!vs;o`I`AYWCZLuLfhwj#e8 z{gAXRz!EJKSlTdLH2TYQ{U^Hf%g`3I9_gK;+#)8Fo9@AtYEH)8-zABVx?yv(9Lhzh z#7gY+QChw*3 zx#C>hWcL#hw@9W{)AJLt)if$MX+q`logZH?cW5c!CS_B(NwcZUbQYCYWQRSeoKb=k zw~2G1vV~ic$~3PC&F|kX{jpl@N;687839z@KFcqa6QJ_>IgNh;R8}L7b0RZJN9k0S zarX(;u-ddW@SmGgt0xP%qj^m#8`;7=h^XqOQFm7|={TIX7;s`jWm^?vMhTu8n2WV8 zd{C)yv3{DIjU2+yj`zXtz-!2-`2!J6H#pOXrPVrF3D)je^0lM%2;4v}G;8-{(H8G& zek9iX_s4)fA5`kzEuUKFD1Tr=X=Uq$$bVoGNnl;Huw*3*sv@|R^KE!q5lk#_IauT5 zFKWcZtd_xx{`OD%hhfTBqjaDq3%N@=ayAN4U&Dtb*fbYRYcu?>u`G+HXVOfqNUH{M zsngU}0Mj1`QT((N#eEb`&7fI}<9+yfgFlT4h^C$t;$lo9tMx+IdK15_*I17m#w671 zo8_GZ7MeS>R;8mKwBWS@zLAhxiY!i5eZ9!u!|dxVAtC*_;YDJ}-p3)n!05Eq4RQT& zTkA+74Rbsh{26O>J5yHrs;$~YuIW0W1RJ zty&bt@6PJ*F%<=uh})`W`0^XXs%=HVbe5u+#3nmy-%>^~-n(_nMo}29m!@@!EK(1Q zr#ECd^NQw<;vzstyxhyHj?g-(BjWJVv`(~-Dg@FF+;vJVZ2^?-LBwRUg7gYrG@}*$ z18hq6ndF88{w8>vlS_$TZcApzl1`JkrCE}a=l^xr0cUWdOVRlB!n|xeNT*7tP~~86 zWgi=(lT_(&sM6_B1?eoR#1alwGRgAHtzfQH36m=5&U-0SXhppEc)1}eNVFrQ)A|fZmSR6-FDB@tx%+**beUvO zC^~UQJSZgbbXhtKQ@cJH9Si@&oLF?E9cEUK25ho z_Q)YC(k00nBl>iJ+AeeV%vOZ=RBNRo*Dw~n7N>+%AK(eA*MjpvJO0wchnmTQi zdQAv2BKTIch0nZhYh;J-Gn1L7>!y3EZjpEK-Hw@V!ItAoE93E%rPxHeMtUY7d*5xr zawomqwnYczXAa0nmjv18fSgH!ln;4x1$mSpOLYkHdU9BBB?q?+;vx{_p8SGr5@dcb zZ4EjIGQQhkCvIsApQlhhJCNU*%r70}o0ozdU0j@<9*>UAVsdoX9hJAe6Oiwm{bwWrHP*6CAPxQYQbB+BY3C@W zfGzafOKkMpOKtR-&O(1&Ts5MfvG8whjdDdl#xgh@x4O6}@`NI6BtwvK{b_e&|l{IYvQ!=BIdoHZ`{){VW8Ii zXy^W?N?Slyo))l4Tk12xm!}_Vzl^!9n;l|>q_CDp?z|2{|YalBnBTZL98Q#^@acIAZ0k2F_ ziWrbt8)1P%;S znsRS>28$(-Z`X%S<}#ycJ&=O#nst`iJR35hW0~o(b&n4?+p|pNn=mF&1xzpM?M5LY zh7So1FSRoFRaq@=Ab~WPJ!aPn3Dl5eYWR=~-o(3whbWTS8&kMj zviY?424z_6|tp)CD~>2!VL_@53P$7CG+~#T;{*bJ962dT9Ra?dSKlo#~vK zVIFUwk)|CzgmkC}PTRU~IC?0P1bzQZ59y*4F{O(@J#_y%dI;hoP!A38wY=#e-3vW* zc7*YVPMobib0p40@J{$N#Zk`=u0%Fg%;u>5L#5r$Un68!+Jr`TNI=Vku)8>rsW3cKACmK z1HG6^KjAnS$A+R6GL_Eb)3hIYpvbiWp1#*GhL$z$dynI*ki>J}wgGypsE3xK(MKCO za;U2Sf?nWILCVp3|5x?U1yaLgLp>B=h1}v$mv@GlLj89+N9!@2#i8CWHit46o_f4n z7Tf%c6b|v&m@c?F2v85p$LJ%-fx7BV zW|*cP3f^DWym!?*=Do(j*V-^ee4VrEm@bKL#KAX{1Ua5nXI#V=-W~$+eQ^yPL2(g? zuUM=6;mc!z&TuSHogP5@hT`qFP2C zZ9oO_{fuFTUJ(eCD1(~1pPRd6V^&gyV=zS(uDf4Z`JJImBX{0vuOY3b3}6xFFbLB< z7<0lnG`6&IE)uSxW)xyj^BQ1jOp@HhdmBGnZX+=bOMfL^m2v1XO4FD?j^y~7{*|J&aA>Kvl3#L(8Phx5kqz@Z*1>@Q1!ozauGTHw>?p)n zGX}ZQZZu zC3)f4R2y0p?L`~J)6VCD?-paOLc&ttk|2b05Rq=RLW;NKmdr*m6Cmq}4Xfd;OlKp`#yJJ_TA zb}()WIK#F8Y#stXReK5r$hCF713R(Cl*b|~kIE>Pjpg#y7D>bT9DP6r^NQYp5MB6U z_d!pW5Lira-%IUBuAg*-S4@!Bu&P`@3?&-SFJq6GB8R+fL5OSc@5G~Tm+D2Q3ewEv%141O^jA|Sac33 z;PKm5_c+&YwZeNQ>yf4z6i(lp;@!Wk?!ppor{lXP_`Z7dMO8caItTBCorCwnNSDM{ z_A>~+nF_D`clZty-(A*3@V(B*%oG=a_@Y`y9zriYz7{9?Pk!1wrENh1Ps%WIdyXO5WxBq5E z+en2;Aya9)%@b#@tdSxWNsaUwXP71#8wuEqjW`GNF`dQOW?7#hV>1?>deB>rhzc|GK0^zKkg(yRx7Z*oz@i7P4k1jvMO<0>a zRi&Gl*%{VfsCGPc93WYl+7n_L6jwNjE&YFdxpMNBNiotnx$gSUS5u`C*i%%8suX)f zEL9q5cZlhnxyN)#VwR8~Ld;AOqznskb%oYROg5%POwox~RHYObfy7+PuPR+9G22MY z^?)(qlc8I9or`Pz@S4L|))%Ga=`h+6vq%U{=yU1lxXI{*nohl|&pDh-YG5!-MRouI zN&U&d$EKn{AKW$Ypyf8MqI`A!wAMa3oMYk-&z7IB2q>H@!_uk8RY;JKj8o%fP zMBta84QdX4Y&!Fzk>MHU@dl)E&Y)vDi?&UR4sA0@kg}^JSK59iZHFle_37-!b@Zv_ zZjrXJ{L=O_Y0Kqh{j*PP=@u<6kbxxZmwWeMu{|~?^{-Y8UV$~q0TZpfg9dcxV_wL* z16Ns6JGx7{7R`o?RV&?}4Nm2VM(#CH2&v~Y3KNO*uA@I+Us1k8)jl1BgYi0X#xGw^ zji*ZQyb(~)yr!x2Gj|PquoV&*I_Pax5F&Vt zG2Zi*gYr5q@}SlLD+9PFqYJ%)3lEiuX+uZT>(A~&K95%!MXH^h*xLQhr%RtXG2Y$O zVb$^{o8Htg~gP)~(Ue8sZlFHf8G24==eBV%VGWN`0L5yx+~${?3`KR=WM|yYw@tF&wKowib^qTL%@TjaMUcqRmSB@9$z9YJJ-h zagH^NIL8_?9cqb1{w8cXGvsrrNG35-W>|96W}e&BX7c5mXfrYXS2e;A7lGQWH?P{v za|hb&6dxBEo;yJnN#-^yjkT7U7*ZEqO;v$d&q5M*ygA`c7l!XUM7eV^@>sLdkDThF3<**DKn9MH? z_+!7S2U^MS-+@m~T=zH|4O0}rQ|9n3`G@re4nzw~$3J|6?;cTwX!e0$HU$QpbNHCf zqClDK-IsKkg!H%??q5(~;Fr`F6qwv0mRHmQ6c+&$cv_TS3h-mdQ+y2B;px;_r09Fm z0xkS4jM#tBe3YvTJ6L2g`!q%z{k~KcaL0L1Y&IqbD$g&(dnOl_=6V*EdZO`#IhCdg z28)<60>~9PinX@bs$kGLwQkTkwT_7`9+b)~B2_^~(NdPWbLBx7%dnVF9>}LISL8vm zZs5VREODxQ%@ug=k_T9&H9dFh*qB0r6hGoQyabs{B0(yJ78`4wM}=;8$x2ZShD?^0 zP7AnTmnaIN-$Odc2h#J=xfnTNYm4Qzxv>Q?yF!pOMKKr>f<#ZvaeU%xDT={HTTu); z=gl!)k{}?GAqpjTk2I$?S~(H7wZ!nWA({2TGh5H`Mh_Jf!4kwN4zzuN`2sb<)BY&$I9xid70)RSCI0M|d z9)~a(Gg*)HZvT*fq>e$Wy5JaEa4#%{9fy$S04dWA0VX`4H@r2=tILiJm~b$6j&~bG zx+Laz*@$8TG6|G&NM^2>b6IOufK9fK#|E{z568KftnVmg$of9T0E&_qSm0#d{3H&TOdvAu$p6fyOgI`S6BOUYL zr8eI7`YaOfFX?;BS8IY9cQiB0AkGs3@KX+3^@mAF|mcd zUwR|8Kt|CH|D6`N&oV3#sRgbx1W48m=;MzC!&<4l4FT>GeSGv+=eeH&{aUv*vO<5P z+GGQyq5t#arCMNedTBY{ljMM{66pDJzo-lZdnTu$SO50(N2-Mfp61Xdz8Jv9o=CLoFiL1kPnUS5qiF%uE+s-yEbI3efEQB`za6 z8b1H)4dl1j`u#kGotM9Xzm2M7w^1?wKD&rxoQohpo-_qxA zmdM`-x|AiUocy1&uFilof-o%{iHPRza2zOYbaiy>1yZGCuPH9 z5v&9&bzagEo?YP6DSzY6#1>=G;my8|)(w0QIEzR7e` z{-&41EJKTYMpmlyNA0;3d0ZTvZD2u~r{QJe+94KRl@j@o%TgI0sDsjvi}w^`)#ZJS zuXwJNXTU$Ty1U4je__(fxVN~fvv-5Zipu+<^HOYq|HH}13nsf$I)gvxi5sZu?n%+!mi>C``=IL4p+vmW_g-zE zNsfv)UcGpTn2NHg*rb|X(lPy&ji!yErY9em?u~zH<6#feeJ$=-DdS&w)D)`m3H<`o zs>M6rg&&NW%!N`Z(?3*^tQ)(uwuO7@=hOeRY-UhWHvOPuOr}d!Qf;?VmFWLe?b3PG zXTOFpcuy0uXJR@y?AnH#vtLi5OrdUd9eH`wmFSb?yYk@C&7+-^H-gMm9`tk_?F{{w z7Rs!~|G(*=S8Sn%@v%lIS%mifTW{byUAu+IJF$Qymwq}`kvQYmJu2}58XSLqQ!-Cp z5;z<>p`!cfg9A6!W8C!=jm4{G4S60s*&n-wnBHPP)xTHPv^8^s z#Xbky*%ta+%J+z|edKqD-jB^J)gPbju?%g-e(Ld6MOBkDSw(OTbCi5K!gkr_yP<~u zRqSbz_JdR-%%vwdwR(6HF%@yrwK8X7qKBEwGsKw7x960=b8}*NB8~_`W$)^7J0qVf z3vSE~Bcg@z?xz*T`hkpYBBu1Qc=)}KF^y#$@K#6lK*JxC_X^lTY+X;+MC`+@Q%AmT z-s^~!G}kkRzsbDmqanu`MAbj)Zb@r&@m)#RR*64PyvAfL6BF^@3C1*}yA3A<>+->> zW9%eExl?=to+EO0-sq_8h}W_;RGh6#kUaOCclVq(x^{bv`Wqr2>M?nSblMr;px@$& zRL9F2SP$(H-{|7Keka`?Voz@H>1nlpsGhviV@|sJOn1(w$7mM=5o~qgQ+nN=KKrR& zh}Qi`e6@wD;rSl&K#f-Ye7k8PqR&4q|F(4C$j3I&ejvX&Nw*s7|9#^a_t1OLF0c5s z4P_jWVIt|1BHnw=ayxjhD|o8cd_YWZB+@bhSg(FxI=RbqOK3HV zE%_as)c5%AAK>;55v2t}JKoaQNqkEu<>_Fxwi;r7I$G#gjlr0&y0oKS?tQ9U`!MUp zJ*zdyXCQ+XHy8^~ylM;;Bc=jR8vLhzL`)U?`1Lh=w^vn-J+3)K%;P6t*y7sISo}`) zeZ-UjMvS~hM4yKA2R=TnFPbV^xv!!TFdK}J-u;3sdBZnG0?jkK8;E#X#^No9a?hmn zChqC0WAUCX12N@AeK)rd(fsU}g7nw%x+m6C#W$pHp(V9HB41ZsVExGmPO-svkguzF n_>1?>!GU_wwIzR0NeorN{@q3M_s8cIhdjzUB_x`m6D9l~e%n*} literal 0 HcmV?d00001 diff --git a//decl.mid.102 b//decl.mid.102 new file mode 100644 index 0000000..0cede3c --- /dev/null +++ b//decl.mid.102 @@ -0,0 +1,1064 @@ + +TITLE DECLARATION PROCESSOR + +RELOCA + +.INSRT MUDDLE > + +.GLOBAL STBL,TYPFND,TYPSGR,CHKDCL,TESTR,VALG,INCR1,TYPG,ISTRUC,TMATCH,SAT +.GLOBAL TYPMIS,CHKAB,CHKARG,IGDECL,LOCQQ,APLQ,CALER,IEQUAL,IIGLOC,IGLOC +.GLOBAL CHLOCI,INCONS,SPCCHK,OUTRNG,WTYP1,FLGSET,IGET,PVSTOR,SPSTOR,DSTORE + +; Subr to allow user to access the DECL checking code + +MFUNCTION CHECKD,SUBR,[DECL?] + + ENTRY 2 + + MOVE C,(AB) + MOVE D,1(AB) + MOVE A,2(AB) + MOVE B,3(AB) + PUSHJ P,TMATCX ; CHECK THEM + JRST IFALS + +RETT: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +RETF: +IFALS: MOVEI B,0 + MOVSI A,TFALSE + JRST FINIS + +; Subr to turn DECL checking on and off. + +MFUNCTION %DECL,SUBR,[DECL-CHECK] + + ENTRY + + HRROI E,IGDECL + JRST FLGSET + +; Change special unspecial normal mode + +MFUNCTION SPECM%,SUBR,[SPECIAL-MODE] + + ENTRY + + CAMGE AB,[-3,,] + JRST TMA + MOVE C,SPCCHK ; GET CURRENT + JUMPGE AB,MODER ; RET CURRENT + GETYP 0,(AB) ; CHECK IT IS ATOM + CAIE 0,TATOM + JRST WTYP1 + MOVE 0,1(AB) + MOVEI A,1 + CAMN 0,MQUOTE UNSPECIAL + MOVSI A,(SETZ) + CAMN 0,MQUOTE SPECIAL + MOVEI A,0 + JUMPG A,WTYP1 + HLLM A,SPCCHK + +MODER: MOVSI A,TATOM + MOVE B,MQUOTE SPECIAL + SKIPGE C + MOVE B,MQUOTE UNSPECIAL + JRST FINIS + +; Function to turn special checking on and of + +MFUNCTION SPECC%,SUBR,[SPECIAL-CHECK] + + ENTRY + CAMGE AB,[-3,,] + JRST TMA + + MOVE C,SPCCHK + JUMPGE AB,SCHEK1 + + MOVEI A,0 + GETYP 0,(AB) + CAIE 0,TFALSE + MOVEI A,1 + HRRM A,SPCCHK + +SCHEK1: TRNN C,1 + JRST IFALS + JRST RETT + +; Finction to set decls for GLOBAL values. + +MFUNCTION GDECL,FSUBR + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TLIST + JRST WTYP1 + + PUSH TP,$TLIST + PUSH TP,1(AB) + PUSH TP,$TLIST + PUSH TP,[0] + PUSH TP,$TLIST + PUSH TP,[0] + +GDECL1: INTGO + SKIPN C,1(TB) + JRST RETT + HRRZ D,(C) ; MAKE SURE PAIRS + JUMPE D,GDECLL ; LOSER, GO AWAY + GETYP 0,(C) + CAIE 0,TLIST + JRST GDECLL + HRRZ 0,(D) + MOVEM 0,1(TB) ; READY FOR NEXT CALL + MOVE C,1(C) ; SAVE ATOM LIST + MOVEM C,5(TB) + MOVEM D,3(TB) + +GDECL2: INTGO + SKIPN C,5(TB) + JRST GDECL1 ; OUT OF ATOMS + GETYP 0,(C) ; IS THIS AN ATOM + CAIE 0,TATOM + JRST GDECLL ; NO, LOSE + MOVE B,1(C) + HRRZ C,(C) + MOVEM C,5(TB) + PUSHJ P,IIGLOC ; GET ITS VAL (OR MAKE ONE) + GETYP 0,(B) ; UNBOUND? + CAIE 0,TUNBOU + JRST CHKCUR ; CHECK CURRENT VALUE + MOVE C,3(TB) ; GET DECL + HRRM C,-2(B) + JRST GDECL2 + +CHKCUR: HRRZ D,3(TB) + GETYP A,(D) + MOVSI A,(A) + MOVE E,B + MOVE B,1(D) + MOVE C,(E) + MOVE D,1(E) + PUSH TP,$TVEC + PUSH TP,E + JSP E,CHKAB + PUSHJ P,TMATCH + JRST TYPMI3 + MOVE E,(TP) + SUB TP,[2,,2] + MOVE D,3(TB) + HRRM D,-2(E) + JRST GDECL2 + +TYPMI3: MOVE E,(TP) ; POINT BACK TO SLOT + MOVE A,-1(E) ; ATOM TO A + MOVE B,1(E) + MOVE D,(E) ; GET OLD VALUE + MOVE C,3(TB) + JRST TYPMIS ; GO COMPLAIN + +GDECLL: ERRUUO EQUOTE BAD-ARGUMENT-LIST + +MFUNCTION UNMANIFEST,SUBR + + ENTRY + + PUSH P,[HLLZS -2(B)] + JRST MANLP + +MFUNCTION MANIFEST,SUBR + + ENTRY + + PUSH P,[HLLOS -2(B)] +MANLP: JUMPGE AB,RETT + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP + MOVE B,1(AB) + PUSHJ P,IIGLOC + XCT (P) + ADD AB,[2,,2] + JRST MANLP + +MFUNCTION MANIFQ,SUBR,[MANIFEST?] + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP1 + + MOVE B,1(AB) + PUSHJ P,IGLOC ; GET POINTER IF ANY + GETYP 0,A + CAIN 0,TUNBOU + JRST RETF + HRRZ 0,-2(B) + CAIE 0,-1 + JRST RETF + JRST RETT + +MFUNCTION GETDECL,SUBR,[GET-DECL] + + ENTRY 1 + + GETYP 0,(AB) + CAIN 0,TOFFS + JRST GETDOF + PUSHJ P,GTLOC + JRST GTLOCA + + HRRZ C,-2(B) ; GET GLOBAL DECL +GETD1: JUMPE C,RETF + CAIN C,-1 + JRST RETMAN + GETYP A,(C) + MOVSI A,(A) + MOVE B,1(C) + JSP E,CHKAB + JRST FINIS +GETDOF: HLRZ B,1(AB) + JUMPE B,GETDO1 + MOVE A,(B) + MOVE B,1(B) + JRST FINIS +GETDO1: MOVSI A,TATOM + MOVE B,IMQUOTE ANY + JRST FINIS + +RETMAN: MOVSI A,TATOM + MOVE B,MQUOTE MANIFEST + JRST FINIS + +GTLOCA: HLRZ C,2(B) ; LOCAL DECL + JRST GETD1 + +MFUNCTION PUTDECL,SUBR,[PUT-DECL] + + ENTRY 2 + + GETYP 0,(AB) + CAIN 0,TOFFS + JRST PUTDOF ; MAKE OFFSET WITH NEW DECL + PUSHJ P,GTLOC + SKIPA E,[HRLM B,2(C)] + MOVE E,[HRRM B,-2(C)] + PUSH P,E + GETYP 0,(B) ; ANY VALUE + CAIN 0,TUNBOU + JRST PUTD1 + MOVE C,(B) ; GET CURRENT VALUE + MOVE D,1(B) + MOVE A,2(AB) + MOVE B,3(AB) + PUSHJ P,TMATCH + JRST TYPMI4 +PUTD1: MOVE C,2(AB) ; GET DECL BACK + MOVE D,3(AB) + PUSHJ P,INCONS ; CONS IT UP + MOVE C,1(AB) ; LOCATIVE BACK + XCT (P) ; CLOBBER + MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +TYPMI4: MOVE E,1(AB) ; GET LOCATIVE + MOVE A,-1(E) ; NOW ATOM + MOVEI C,2(AB) ; POINT TO DECL + MOVE D,(E) ; AND CURRENT VAL + MOVE B,1(E) + JRST TYPMIS + +GTLOC: GETYP 0,(AB) + CAIE 0,TLOCD + JRST WTYP1 + MOVEI B,(AB) + PUSHJ P,CHLOCI + HRRZ 0,(AB) ; LOCAL OR GLOBAL + SKIPN 0 + AOS (P) + MOVE B,1(AB) ; RETURN LOCATIVE IN B + POPJ P, + +; MAKE OFFSET WITH SUPPLIED DECL +PUTDOF: MOVE D,3(AB) + GETYP 0,2(AB) + CAIN TATOM + CAME D,IMQUOTE ANY + JRST PUTDO1 + MOVSI A,TOFFS + HRRZ B,1(AB) + JRST FINIS +PUTDO1: MOVE C,2(AB) + PUSHJ P,INCONS ; BUILD A LIST + MOVSI A,TOFFS + HRLS B + HRR B,1(AB) ; SET UP OFFSET + JRST FINIS + +; BUILD AN OFFSET--TAKES FIX AND DECL (OR ATOM FORM) +; JUMPS INTO PUT-DECL CODE FOR OFFSETS. + MFUNCTION COFFSET,SUBR,[OFFSET] + + ENTRY 2 + GETYP 0,(AB) + CAIE 0,TFIX + JRST WTYP1 + SKIPG 1(AB) + JRST OUTRNG ; CAN'T HAVE NEGATIVE OFFSETS + GETYP 0,2(AB) + CAIE 0,TATOM + CAIN 0,TFORM + JRST PUTDOF + JRST WTYP2 + +; GET FIX PART OF OFFSET + MFUNCTION INDEX,SUBR + + ENTRY 1 + GETYP 0,(AB) + CAIE 0,TOFFS + JRST WTYP1 + MOVSI A,TFIX + HRRE B,1(AB) + JRST FINIS + +; Interface between EVAL and declaration processor. +; E points into stack at a binding and C points to decl list. + +CHKDCL: SKIPE IGDECL ; IGNORING DECLS? + POPJ P, ; YUP, JUST LEAVE + + PUSH TP,$TTP ; SAVE BINDING + PUSH TP,E + MOVE A,-4(E) ; GET ATOM + MOVSI 0,TLIST ; SETUP FOR INTERRUPTABLE + MOVE PVP,PVSTOR+1 + MOVEM 0,CSTO(PVP) + MOVEM 0,BSTO(PVP) + MOVSI 0,TATOM + MOVEM 0,ASTO(PVP) + SETZB B,0 ; CLOBBER FOR INTGO + +DCL2: INTGO + HRRZ D,(C) ; MAKE SURE EVEN ELEMENTS + JUMPE D,BADCL + GETYP B,(C) ; MUST BE LIST OF ATOMS + CAIE B,TLIST + JRST BADCL + MOVE B,1(C) ; GET LIST + +DCL1: INTGO + CAMN A,1(B) ; SKIP IF NOT WINNER + JRST DCLQ ; MAY BE WINNER +DCL3: HRRZ B,(B) ; CDR ON + JUMPN B,DCL1 ; JUMP IF MORE + + HRRZ C,(D) ; CDR MAIN LIST + JUMPN C,DCL2 ; AND JUMP IF WINNING + + PUSHJ P,E.GET ; GET BINDING BACK + SUB TP,[2,,2] ; POP OF JUNK + POPJ P, + +DCLQ: GETYP C,(B) ; CHECK ATOMIC + CAIE C,TATOM + JRST BADCL ; LOSER + PUSHJ P,E.GET ; GOT IT + PUSH TP,$TLIST ; SAVE PATTERN + PUSH TP,D + MOVE B,1(D) ; GET PATTERN + HLLZ A,(D) + MOVE C,-3(E) ; PROPOSED VALUE + MOVE D,-2(E) + PUSHJ P,TMATCH ; MATCH TYPE + JRST TYPMI1 ; LOSER +DCLQ1: MOVE E,-2(TP) + MOVE C,-5(E) ; CHECK FOR SPEC CHANGE + SKIPE 0 ; MAKE SURE NON ZERO IS -1 + MOVNI 0,1 + SKIPL SPCCHK ; SKIP IF NORMAL UNSPECIAL + SETCM 0 ; COMPLEMENT + ANDI 0,1 ; ONE BIT + CAMN C,[TATOM,,-1] + JRST .+3 + CAME C,[TATOM,,-2] + JRST .+3 + ANDCMI C,1 + IOR C,0 ; MUNG BIT + MOVEM C,-5(E) + HRRZ C,(TP) + SUB TP,[4,,4] + MOVEM C,(E) ; STORE DECLS + MOVSI C,TLIST + MOVEM C,-1(E) + POPJ P, + +TYPMI1: MOVE E,-2(TP) + GETYP C,-3(E) + CAIN C,TUNBOU + JRST DCLQ1 + MOVE E,-2(TP) ; GET POINTER TO BIND + MOVE D,-3(E) ; GET VAL + MOVE B,-2(E) + HRRZ C,(TP) ; DCL LIST + MOVE A,-4(E) ; GET ATOM + SUB TP,[4,,4] +TYPMIS: PUSH TP,$TATOM + PUSH TP,EQUOTE TYPE-MISMATCH + PUSH TP,$TATOM + PUSH TP,A + PUSH TP,(C) + HLLZS (TP) + PUSH TP,1(C) + JSP E,CHKARG ; HACK DEFER + PUSH TP,D + PUSH TP,B + MOVEI A,4 ; 3 ERROR ARGS + JRST CALER + +BADCL: PUSHJ P,E.GET + ERRUUO EQUOTE BAD-DECLARATION-LIST + +; ROUTINE TO RESSET INT STUFF + +E.GET: MOVE E,(TP) + MOVE PVP,PVSTOR+1 + SETZM ASTO(PVP) + SETZM BSTO(PVP) + SETZM CSTO(PVP) + POPJ P, + +; Declarations processor for MUDDLE type declarations. +; Receives a pattern in a and B and an object in C and D. +; It skip returns if the object fits otherwise it doesn't. +; Declaration syntax errors are caught and sent to ERROR. + +TMATCH: MOVEI 0,1 ; RET SPECIAL INDICATOR + SKIPE IGDECL ; IGNORING DECLS? + JRST CPOPJ1 ; YUP, ACT LIKE THEY WON + +TMATCX: GETYP 0,A ; GET PATTERNS TYPE + CAIE 0,TSEG + CAIN 0,TFORM ; MUST BE FORM OR ATOM + JRST TMAT1 + CAIE 0,TATOM + JRST TERR1 ; WRONG TYPE FOR A DCL + +; SIMPLE TYPE MATCHER + +TYPMAT: GETYP E,C ; OBJECTS TYPE TO E + PUSH P,E ; SAVE IT + PUSH TP,C + PUSH TP,D + PUSHJ P,TYPFND ; CONVERT TYPE NAME TO CODE + JRST SPECS ; NOT A TYPE NAME, TRY SPECIALS + SUB TP,[2,,2] + POP P,E ; RESTORE TYPE OF OBJECT + MOVEI 0,0 ; SPECIAL INDICATOR + CAIN E,(D) ; SKIP IF LOSERS +CPOPJ1: AOS (P) ; GOOD RETURN +CPOPJ: POPJ P, + +SPECS: POP P,A ; RESTORE OBJECTS TYPE + POP TP,D + POP TP,C + CAMN B,IMQUOTE ANY + JRST CPOPJ1 ; RETURN IMMEDIATELY IF ANYTHING WINS + CAMN B,IMQUOTE STRUCTURED + JRST ISTRUC ; LET ISTRUC DO THE WORK + CAMN B,IMQUOTE APPLICABLE + JRST APLQ + CAMN B,IMQUOTE LOCATIVE + JRST LOCQQ + PUSH TP,$TATOM + PUSH TP,B + PUSH TP,C + PUSH TP,D + MOVSI A,TATOM + MOVSI C,TATOM + MOVE D,IMQUOTE DECL + PUSHJ P,IGET + JUMPE B,TERR2X + MOVEM A,-3(TP) + MOVEM B,-2(TP) + INTGO + POP TP,D + POP TP,C + POP TP,B + POP TP,A + JRST TMATCX + +; ARRIVE HERE FOR A FORM IN THE DCLS + +TMAT1: JUMPE B,TERR3 ; EMPTY FORM LOSES + HRRZ E,(B) ; CDR IT + JUMPE E,TMAT3 ; CANT BE SPECIAL/UNSPECIAL, LEAVE + PUSHJ P,0ATGET ; GET POSSIBLE ATOM IN 0 + JRST TEXP1 ; NOT ATOM + CAME 0,MQUOTE SPECIAL + CAMN 0,MQUOTE UNSPECIAL + JRST TMAT2 ; IGNORE SPECIAL/UNSPECIAL +TMAT3: PUSHJ P,TEXP1 + JRST .+2 + AOS (P) + MOVEI 0,0 ; RET UNSPECIAL INDICATION + POPJ P, + +TEXP1: JUMPE B,TERR3 ; EMPTY FORM + GETYP E,A ; CHECK CURRENT TYPE + CAIN E,TATOM ; IF ATOM, + JRST TYPMA1 ; SIMPLE MATCH + CAIN E,TSEG + JRST .+3 + CAIE E,TFORM + JRST TERR4 + GETYP 0,(B) ; WHAT IS FIRST ELEMEMT + CAIE 0,TFORM ; FORM=> <....> OR <....> + JRST TEXP12 + PUSH TP,$TLIST ; SAVE LIST + PUSH TP,B + MOVE B,1(B) ; GET FORM + PUSH TP,C + PUSH TP,D + PUSH P,E + PUSHJ P,ACTRT1 + TDZA 0,0 ; REMEMBER LACK OF SKIP + MOVEI 0,1 + POP P,E + POP TP,D + POP TP,C + MOVE B,(TP) ; GET BACK SAVED LIST + SUB TP,[2,,2] + JUMPE 0,CPOPJ ; LOSERS EXIT IMMEDIATELY + HRRZ B,(B) ; OTHERWISE REST THE LIST AND FALL INTO ELETYPE + +; CHECKS TYPES OF ELEMENTS OF STRUCTURES + +ELETYP: CAIE E,TSEG ; MUST BE EXAXT? + JUMPE B,CPOPJ1 ; EMPTY=> WON + PUSH TP,$TLIST ; SAVE DCL LIST + PUSH TP,B + MOVE A,C ; GET OBJ IN A AND B + MOVE B,D + CAIE E,TSEG + TDZA E,E + MOVNI E,1 + PUSH P,E + PUSHJ P,TYPSGR ; GET REST/NTH CODE + JRST ELETYL ; LOSER + CAIN C,5 ; BYTE STRING COMES HERE + JRST ELEBYT ; HACK IT + PUSH TP,DSTORE + PUSH TP,D + PUSH P,C ; SAVE CODE + PUSH TP,[0] ; AND SLOTS + PUSH TP,[0] + +; MAIN ELEMENT SCANNING LOOP + +ELETY1: XCT TESTR(C) ; SKIP IF OBJ NOT EMPTY + JRST ELETY2 ; CHEK EMPTY WINNER + SKIPN -4(TP) + JRST ELETY4 + XCT TYPG(C) ; GET ELEMENT + XCT VALG(C) + JSP E,CHKAB ; CHECK OUT DEFER + MOVEM A,-1(TP) ; AND SAVE IT + MOVEM B,(TP) + MOVE C,A + MOVE D,B ; FOR OTHER MATCHERS + MOVE B,-4(TP) ; GET PATTERN + MOVE A,(B) + GETYP 0,(B) ; GET TYPE OF <1 pattern> + MOVE B,1(B) ; GET ATOM OR WHATEVER + CAIE 0,TATOM ; ATOM ... SIMPLE TYPE + JRST ELETY3 + PUSHJ P,TYPMAT ; DO SIMPLE TYPE MATCH + JRST ELETY4 ; LOSER + +; HERE TO REST EVERYTHING AND GO ON BACK + +ELETY6: MOVE D,-2(TP) ; GET OBJ POINTER + MOVE C,(P) ; GET INCREMENT CODE + XCT INCR1(C) + MOVEM D,-2(TP) ; SAVED INCREMENTED GOODIR + MOVE 0,DSTORE + MOVEM 0,-3(TP) + +ELETY9: HRRZ B,@-4(TP) ; CDR IT + MOVEM B,-4(TP) + JUMPN B,ELETY1 + + SKIPN -1(P) ; SKIP IF EXACT REQUIRED + JRST ELETY8 + XCT TESTR(C) + JRST ELETY8 + JRST ELETY4 + + +; HERE IF PATTERN EMPTY + +ELETY8: AOS -2(P) ; SKIP RETURN +ELETY4: SETZM DSTORE + SUB P,[2,,2] + SUB TP,[6,,6] + POPJ P, + +ELETYL: SUB P,[1,,1] + SUB TP,[2,,2] + POPJ P, + +; HERE TO HANDLE EMPTY OBJECT + +ELETY2: MOVE B,-4(TP) ; GET PATTERN + JUMPE B,ELETY8 + GETYP 0,(B) ; CHECK FOR [REST ...] + SETZM DSTORE + CAIE 0,TVEC + JRST ELETY4 ; LOSER + HLRZ 0,1(B) ; SIZE OF IT + CAILE 0,-4 ; MUST BE 2 + JRST ELETY4 + MOVE B,1(B) ; GET IT + PUSHJ P,0ATGET ; LOOK FOR REST + JRST ELETY4 + CAMN 0,MQUOTE OPTIONAL + JRST ELETY8 + CAME 0,MQUOTE OPT + CAMN 0,IMQUOTE REST + JRST ELETY8 ; WINNER!!!! + JRST ELETY4 ; LOSER + +; HERE TO CHECK OUT A FORM ELEMNT + +ELETY3: CAIN 0,TSEG + JRST ELGO + CAIE 0,TFORM + JRST ELETY7 +ELGO: SETZM DSTORE + PUSHJ P,TEXP1 ; AND ANALYSE IT + JRST ELETY4 ; LOSER + MOVE 0,-3(TP) ; RESET DSTO + MOVEM 0,DSTORE + JRST ELETY6 ; WINNER + +; CHECK FOR VECTOR IN PATTERN + +ELETY7: CAIE 0,TVEC ; SKIP IF WINNER + JRST TERR12 ; YET ANOTHER ERROR + HLRE C,B ; CHECK LEENGTH + CAMLE C,[-4] ; MUST BE 2 LONG + JRST TERR13 + PUSHJ P,0ATGET ; 1ST ELEMENT ATOM? + JRST ELET71 ; COULD BE FORM + CAME 0,MQUOTE OPT + CAMN 0,MQUOTE OPTIONAL + JRST ELET72 + CAME 0,IMQUOTE REST + JRST TERR14 + MOVE 0,(P) ; GET STRUC CODE + CAIN 0,2 + CAME C,[-4] + JRST ELNUVE + + GETYP 0,2(B) ; SEE IF UVECTOR REST SIMPLE TYPE + CAIE 0,TATOM + JRST ELNUVE + + MOVE C,3(B) ; GET ATOM + HLRE 0,C + SUB C,0 ; POINT TO DOPE WDS + HRRE 0,(C) + JUMPE 0,ELNUVE + MOVSI A,TATOM + MOVE B,3(B) + MOVE C,-2(TP) + HLRE D,C + SUB C,D + GETYP C,(C) + MOVSI C,(C) + PUSHJ P,TMATCX + JRST ELETY4 + JRST ELETY8 + +ELNUVE: TDOA 0,[-1] +ELET72: MOVSI 0,(SETZ) ; FLAG USED IN RESTIT + PUSH P,0 + PUSHJ P,RESTIT ; CHECK REST OF STRUCTUR + JRST ELET41 + POP P,0 + TRNE 0,-1 + JRST ELETY8 ; WIN AND DONE + JRST ELET81 + +ELET41: SUB P,[1,,1] + JRST ELETY4 + +; CHECK FOR [fix .... ] + +ELET71: CAIE 0,TFIX + JRST TERR15 + MOVNS C + ASH C,-1 + MOVE 0,1(B) ; GET NUMBER + IMULI 0,-1(C) ; COUNT MORE + PUSH P,0 + PUSHJ P,RESTIT ; AND CHECK FIX NUM OF ELEMENTS + TDZA 0,0 + MOVEI 0,1 + SUB P,[1,,1] + JUMPE 0,ELETY4 +ELET81: MOVE D,-2(TP) ; GET OBJECT BACK + MOVE 0,-3(TP) ; RESET DSTO + MOVEM 0,DSTORE + MOVE C,(P) ; RESTORE CODE FOR RESTING ETC. + JRST ELETY9 + + +; HERE TO DO A TASTEFUL TYPMAT + +TYPMA1: PUSH TP,C + PUSH TP,D + PUSHJ P,TYPMAT + TDZA 0,0 ; REMEMBER LOSSAGE + MOVEI 0,1 ; OR WINNAGE + POP TP,D + POP TP,C ; RESTORE OBJECT + JUMPN 0,CPOPJ1 ; SKIPPED BEFORE, SKIP AGAIN + POPJ P, + +; HERE TO SKIP SPECIAL/UNSPECIAL + +TMAT2: CAME 0,MQUOTE SPECIAL + TDZA 0,0 + MOVEI 0,1 + PUSH P,0 ; SAVE INDICATOR + HRRZ A,(E) ; CHECK FOR EXACT LENGTH + JUMPN A,TERR16 + GETYP A,(E) ; TYPE OF NEW PAT + MOVE B,1(E) ; VALUE + MOVSI A,(A) + PUSHJ P,TEXP1 + JRST .+2 + AOS -1(P) + POP P,0 + POPJ P, + +; LOOK FOR SIMPLE TYPE + CAIE 0,TSEG + CAIN 0,TFORM ; FORM--> HAIRY PATTERN + MOVEI E,TEXP1 + TLO E,400000 + PUSHJ P,(E) ; DO IT + JRST RESTI5 + JRST RESTI4 + +RESTI2: SKIPGE (P) ; SKIP IF WON + AOS -2(P) ; COUNTERACT CPOPJ1 + JRST RESTI5 + +RESTI3: TEXP1 + TYPMAT + +; HERE TO MATHC A QUOTED OBJ +; B/ FORM QUOTE... C,D/ OBJECT TO MATCH AGAINST + +MQUOT: HRRZ B,(B) ; LOOK AT NEXT + JUMPE B,TERR7 + GETYP A,(B) ; GET TYPE + MOVSI A,(A) + MOVE B,1(B) ; AND VALUE + JSP E,CHKAB ; HACK DEFER + PUSH TP,A + PUSH TP,B + PUSH TP,C + PUSH TP,D + MOVEI D,-3(TP) + MOVEI C,-1(TP) + PUSHJ P,IEQUAL + TDZA 0,0 + MOVEI 0,1 + JRST POPPIT + +; HERE TO HANDLE SPECIAL BYTE STRING HAIR + +ELEBYT: MOVE B,(TP) ; GET DECL LIST BACK + POP P,E ; EXACTNESS FLAG + JUMPE B,ELEBY2 + GETYP 0,(B) + CAIE 0,TFIX + JRST TERR17 + MOVE A,1(B) + HRRZ B,(B) + HRRZ 0,(B) + SKIPE B + JUMPN 0,TERR17 + LDB C,[300600,,D] ; GET BYTE SIZE + CAIE A,(C) + JRST ELEBY3 + HRRZ C,DSTORE +ELEBY2: MOVEI A,0 + JUMPE B,ELEBY4 + GETYP 0,(B) + CAIE 0,TFIX + JRST TERR17 + MOVE A,1(B) +ELEBY4: CAIGE C,(A) + JRST ELEBY3 + CAIE A,(C) + JUMPN E,ELEBY3 + AOS (P) +ELEBY3: SETZM DSTORE + SUB TP,[2,,2] + POPJ P, + + + +; GET ATOM IN AC 0 + +0ATGET: GETYP 0,(B) + CAIE 0,TATOM ; SKIP IF ATOM + POPJ P, + MOVE 0,1(B) ; GET ATOM + JRST CPOPJ1 + +TERR17: MOVE B,-2(TP) + MOVE B,1(B) + HRRZ 0,(P) + CAIN 0,FOOPC + MOVE B,-4(TP) + MOVSI A,TFORM + MOVE E,EQUOTE BAD-BYTES-DECL + SETZM DSTORE + JRST TERRD + +TERR18: SKIPA E,EQUOTE TOO-MANY-ARGS-TO-PRIMTYPE-DECL +TERR16: MOVE E,EQUOTE TOO-MANY-ARGS-TO-SPECIAL-UNSPECIAL-DECL + MOVSI A,TFORM + JRST TERRD + +TERR9: MOVS A,0 ; TYPE TO A +TERR4: +TERR5: +TERR15: +TERR1: MOVE E,EQUOTE DECL-ELEMENT-NOT-FORM-OR-ATOM + JRST TERRD + +TERR2X: SUB TP,[2,,2] + POP TP,B + POP TP,A + +TERR2: MOVSI A,TATOM + MOVE E,EQUOTE ATOM-NOT-TYPE-NAME-OR-SPECIAL-SYMBOL + JRST TERRD +TERR6: +TERR3: MOVE E,EQUOTE EMPTY-FORM-IN-DECL + JRST TERRD +TERR7: MOVE E,EQUOTE EMPTY-OR/PRIMTYPE-FORM + JRST TERRD + +TERR8: MOVS A,0 ; TYPE TO A + MOVE E,EQUOTE NON-TYPE-FOR-PRIMTYPE-ARG + JRST TERRD +TERR12: MOVE E,EQUOTE ELEMENT-TYPE-NOT-ATOM-FORM-OR-VECTOR + JRST TERRD +TERR13: MOVE E,EQUOTE VECTOR-LESS-THAN-2-ELEMENTS + JRST TERRD +TERR14: MOVE E,EQUOTE FIRST-VECTOR-ELEMENT-NOT-REST-OR-A-FIX + +TERRD: PUSH TP,$TATOM + PUSH TP,EQUOTE BAD-TYPE-SPECIFICATION + PUSH TP,$TATOM + PUSH TP,E + PUSH TP,A + PUSH TP,B + MOVEI A,3 + JRST CALER + +IMPURE + +IGDECL: 0 + +PURE + +END + \ No newline at end of file diff --git a//decl.mid.103 b//decl.mid.103 new file mode 100644 index 0000000..1fce52b --- /dev/null +++ b//decl.mid.103 @@ -0,0 +1,1091 @@ + +TITLE DECLARATION PROCESSOR + +RELOCA + +.INSRT MUDDLE > + +.GLOBAL STBL,TYPFND,TYPSGR,CHKDCL,TESTR,VALG,INCR1,TYPG,ISTRUC,TMATCH,SAT +.GLOBAL TYPMIS,CHKAB,CHKARG,IGDECL,LOCQQ,APLQ,CALER,IEQUAL,IIGLOC,IGLOC +.GLOBAL CHLOCI,INCONS,SPCCHK,OUTRNG,WTYP1,FLGSET,IGET,PVSTOR,SPSTOR,DSTORE +.GLOBAL NOATMS,NOSET,NOSETG +; Subr to allow user to access the DECL checking code + +MFUNCTION CHECKD,SUBR,[DECL?] + + ENTRY 2 + + MOVE C,(AB) + MOVE D,1(AB) + MOVE A,2(AB) + MOVE B,3(AB) + PUSHJ P,TMATCX ; CHECK THEM + JRST IFALS + +RETT: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +RETF: +IFALS: MOVEI B,0 + MOVSI A,TFALSE + JRST FINIS + +; Subr to turn DECL checking on and off. + +MFUNCTION %DECL,SUBR,[DECL-CHECK] + + ENTRY + + HRROI E,IGDECL + JRST FLGSET + +; Subr to turn on and off allowing new atoms + +MFUNCTION %NEWAT,SUBR,[ALLOW-NEW-ATOMS] + + ENTRY + + MOVEI E,NOATMS + JRST FLGSET + +; Subr to turn on and off allowing new GVALS + +MFUNCTION %NEWGV,SUBR,[ALLOW-NEW-GVALS] + + ENTRY + + MOVEI E,NOSETG + JRST FLGSET + +; Subr to turn on and off allowing new LVALs + +MFUNCTION %NEWLV,SUBR,[ALLOW-NEW-LVALS] + + ENTRY + + MOVEI E,NOSET + JRST FLGSET + +; Change special unspecial normal mode + +MFUNCTION SPECM%,SUBR,[SPECIAL-MODE] + + ENTRY + + CAMGE AB,[-3,,] + JRST TMA + MOVE C,SPCCHK ; GET CURRENT + JUMPGE AB,MODER ; RET CURRENT + GETYP 0,(AB) ; CHECK IT IS ATOM + CAIE 0,TATOM + JRST WTYP1 + MOVE 0,1(AB) + MOVEI A,1 + CAMN 0,MQUOTE UNSPECIAL + MOVSI A,(SETZ) + CAMN 0,MQUOTE SPECIAL + MOVEI A,0 + JUMPG A,WTYP1 + HLLM A,SPCCHK + +MODER: MOVSI A,TATOM + MOVE B,MQUOTE SPECIAL + SKIPGE C + MOVE B,MQUOTE UNSPECIAL + JRST FINIS + +; Function to turn special checking on and of + +MFUNCTION SPECC%,SUBR,[SPECIAL-CHECK] + + ENTRY + CAMGE AB,[-3,,] + JRST TMA + + MOVE C,SPCCHK + JUMPGE AB,SCHEK1 + + MOVEI A,0 + GETYP 0,(AB) + CAIE 0,TFALSE + MOVEI A,1 + HRRM A,SPCCHK + +SCHEK1: TRNN C,1 + JRST IFALS + JRST RETT + +; Finction to set decls for GLOBAL values. + +MFUNCTION GDECL,FSUBR + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TLIST + JRST WTYP1 + + PUSH TP,$TLIST + PUSH TP,1(AB) + PUSH TP,$TLIST + PUSH TP,[0] + PUSH TP,$TLIST + PUSH TP,[0] + +GDECL1: INTGO + SKIPN C,1(TB) + JRST RETT + HRRZ D,(C) ; MAKE SURE PAIRS + JUMPE D,GDECLL ; LOSER, GO AWAY + GETYP 0,(C) + CAIE 0,TLIST + JRST GDECLL + HRRZ 0,(D) + MOVEM 0,1(TB) ; READY FOR NEXT CALL + MOVE C,1(C) ; SAVE ATOM LIST + MOVEM C,5(TB) + MOVEM D,3(TB) + +GDECL2: INTGO + SKIPN C,5(TB) + JRST GDECL1 ; OUT OF ATOMS + GETYP 0,(C) ; IS THIS AN ATOM + CAIE 0,TATOM + JRST GDECLL ; NO, LOSE + MOVE B,1(C) + HRRZ C,(C) + MOVEM C,5(TB) + PUSHJ P,IIGLOC ; GET ITS VAL (OR MAKE ONE) + GETYP 0,(B) ; UNBOUND? + CAIE 0,TUNBOU + JRST CHKCUR ; CHECK CURRENT VALUE + MOVE C,3(TB) ; GET DECL + HRRM C,-2(B) + JRST GDECL2 + +CHKCUR: HRRZ D,3(TB) + GETYP A,(D) + MOVSI A,(A) + MOVE E,B + MOVE B,1(D) + MOVE C,(E) + MOVE D,1(E) + PUSH TP,$TVEC + PUSH TP,E + JSP E,CHKAB + PUSHJ P,TMATCH + JRST TYPMI3 + MOVE E,(TP) + SUB TP,[2,,2] + MOVE D,3(TB) + HRRM D,-2(E) + JRST GDECL2 + +TYPMI3: MOVE E,(TP) ; POINT BACK TO SLOT + MOVE A,-1(E) ; ATOM TO A + MOVE B,1(E) + MOVE D,(E) ; GET OLD VALUE + MOVE C,3(TB) + JRST TYPMIS ; GO COMPLAIN + +GDECLL: ERRUUO EQUOTE BAD-ARGUMENT-LIST + +MFUNCTION UNMANIFEST,SUBR + + ENTRY + + PUSH P,[HLLZS -2(B)] + JRST MANLP + +MFUNCTION MANIFEST,SUBR + + ENTRY + + PUSH P,[HLLOS -2(B)] +MANLP: JUMPGE AB,RETT + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP + MOVE B,1(AB) + PUSHJ P,IIGLOC + XCT (P) + ADD AB,[2,,2] + JRST MANLP + +MFUNCTION MANIFQ,SUBR,[MANIFEST?] + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP1 + + MOVE B,1(AB) + PUSHJ P,IGLOC ; GET POINTER IF ANY + GETYP 0,A + CAIN 0,TUNBOU + JRST RETF + HRRZ 0,-2(B) + CAIE 0,-1 + JRST RETF + JRST RETT + +MFUNCTION GETDECL,SUBR,[GET-DECL] + + ENTRY 1 + + GETYP 0,(AB) + CAIN 0,TOFFS + JRST GETDOF + PUSHJ P,GTLOC + JRST GTLOCA + + HRRZ C,-2(B) ; GET GLOBAL DECL +GETD1: JUMPE C,RETF + CAIN C,-1 + JRST RETMAN + GETYP A,(C) + MOVSI A,(A) + MOVE B,1(C) + JSP E,CHKAB + JRST FINIS +GETDOF: HLRZ B,1(AB) + JUMPE B,GETDO1 + MOVE A,(B) + MOVE B,1(B) + JRST FINIS +GETDO1: MOVSI A,TATOM + MOVE B,IMQUOTE ANY + JRST FINIS + +RETMAN: MOVSI A,TATOM + MOVE B,MQUOTE MANIFEST + JRST FINIS + +GTLOCA: HLRZ C,2(B) ; LOCAL DECL + JRST GETD1 + +MFUNCTION PUTDECL,SUBR,[PUT-DECL] + + ENTRY 2 + + GETYP 0,(AB) + CAIN 0,TOFFS + JRST PUTDOF ; MAKE OFFSET WITH NEW DECL + PUSHJ P,GTLOC + SKIPA E,[HRLM B,2(C)] + MOVE E,[HRRM B,-2(C)] + PUSH P,E + GETYP 0,(B) ; ANY VALUE + CAIN 0,TUNBOU + JRST PUTD1 + MOVE C,(B) ; GET CURRENT VALUE + MOVE D,1(B) + MOVE A,2(AB) + MOVE B,3(AB) + PUSHJ P,TMATCH + JRST TYPMI4 +PUTD1: MOVE C,2(AB) ; GET DECL BACK + MOVE D,3(AB) + PUSHJ P,INCONS ; CONS IT UP + MOVE C,1(AB) ; LOCATIVE BACK + XCT (P) ; CLOBBER + MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +TYPMI4: MOVE E,1(AB) ; GET LOCATIVE + MOVE A,-1(E) ; NOW ATOM + MOVEI C,2(AB) ; POINT TO DECL + MOVE D,(E) ; AND CURRENT VAL + MOVE B,1(E) + JRST TYPMIS + +GTLOC: GETYP 0,(AB) + CAIE 0,TLOCD + JRST WTYP1 + MOVEI B,(AB) + PUSHJ P,CHLOCI + HRRZ 0,(AB) ; LOCAL OR GLOBAL + SKIPN 0 + AOS (P) + MOVE B,1(AB) ; RETURN LOCATIVE IN B + POPJ P, + +; MAKE OFFSET WITH SUPPLIED DECL +PUTDOF: MOVE D,3(AB) + GETYP 0,2(AB) + CAIN TATOM + CAME D,IMQUOTE ANY + JRST PUTDO1 + MOVSI A,TOFFS + HRRZ B,1(AB) + JRST FINIS +PUTDO1: MOVE C,2(AB) + PUSHJ P,INCONS ; BUILD A LIST + MOVSI A,TOFFS + HRLS B + HRR B,1(AB) ; SET UP OFFSET + JRST FINIS + +; BUILD AN OFFSET--TAKES FIX AND DECL (OR ATOM FORM) +; JUMPS INTO PUT-DECL CODE FOR OFFSETS. + MFUNCTION COFFSET,SUBR,[OFFSET] + + ENTRY 2 + GETYP 0,(AB) + CAIE 0,TFIX + JRST WTYP1 + SKIPG 1(AB) + JRST OUTRNG ; CAN'T HAVE NEGATIVE OFFSETS + GETYP 0,2(AB) + CAIE 0,TATOM + CAIN 0,TFORM + JRST PUTDOF + JRST WTYP2 + +; GET FIX PART OF OFFSET + MFUNCTION INDEX,SUBR + + ENTRY 1 + GETYP 0,(AB) + CAIE 0,TOFFS + JRST WTYP1 + MOVSI A,TFIX + HRRE B,1(AB) + JRST FINIS + +; Interface between EVAL and declaration processor. +; E points into stack at a binding and C points to decl list. + +CHKDCL: SKIPE IGDECL ; IGNORING DECLS? + POPJ P, ; YUP, JUST LEAVE + + PUSH TP,$TTP ; SAVE BINDING + PUSH TP,E + MOVE A,-4(E) ; GET ATOM + MOVSI 0,TLIST ; SETUP FOR INTERRUPTABLE + MOVE PVP,PVSTOR+1 + MOVEM 0,CSTO(PVP) + MOVEM 0,BSTO(PVP) + MOVSI 0,TATOM + MOVEM 0,ASTO(PVP) + SETZB B,0 ; CLOBBER FOR INTGO + +DCL2: INTGO + HRRZ D,(C) ; MAKE SURE EVEN ELEMENTS + JUMPE D,BADCL + GETYP B,(C) ; MUST BE LIST OF ATOMS + CAIE B,TLIST + JRST BADCL + MOVE B,1(C) ; GET LIST + +DCL1: INTGO + CAMN A,1(B) ; SKIP IF NOT WINNER + JRST DCLQ ; MAY BE WINNER +DCL3: HRRZ B,(B) ; CDR ON + JUMPN B,DCL1 ; JUMP IF MORE + + HRRZ C,(D) ; CDR MAIN LIST + JUMPN C,DCL2 ; AND JUMP IF WINNING + + PUSHJ P,E.GET ; GET BINDING BACK + SUB TP,[2,,2] ; POP OF JUNK + POPJ P, + +DCLQ: GETYP C,(B) ; CHECK ATOMIC + CAIE C,TATOM + JRST BADCL ; LOSER + PUSHJ P,E.GET ; GOT IT + PUSH TP,$TLIST ; SAVE PATTERN + PUSH TP,D + MOVE B,1(D) ; GET PATTERN + HLLZ A,(D) + MOVE C,-3(E) ; PROPOSED VALUE + MOVE D,-2(E) + PUSHJ P,TMATCH ; MATCH TYPE + JRST TYPMI1 ; LOSER +DCLQ1: MOVE E,-2(TP) + MOVE C,-5(E) ; CHECK FOR SPEC CHANGE + SKIPE 0 ; MAKE SURE NON ZERO IS -1 + MOVNI 0,1 + SKIPL SPCCHK ; SKIP IF NORMAL UNSPECIAL + SETCM 0 ; COMPLEMENT + ANDI 0,1 ; ONE BIT + CAMN C,[TATOM,,-1] + JRST .+3 + CAME C,[TATOM,,-2] + JRST .+3 + ANDCMI C,1 + IOR C,0 ; MUNG BIT + MOVEM C,-5(E) + HRRZ C,(TP) + SUB TP,[4,,4] + MOVEM C,(E) ; STORE DECLS + MOVSI C,TLIST + MOVEM C,-1(E) + POPJ P, + +TYPMI1: MOVE E,-2(TP) + GETYP C,-3(E) + CAIN C,TUNBOU + JRST DCLQ1 + MOVE E,-2(TP) ; GET POINTER TO BIND + MOVE D,-3(E) ; GET VAL + MOVE B,-2(E) + HRRZ C,(TP) ; DCL LIST + MOVE A,-4(E) ; GET ATOM + SUB TP,[4,,4] +TYPMIS: PUSH TP,$TATOM + PUSH TP,EQUOTE TYPE-MISMATCH + PUSH TP,$TATOM + PUSH TP,A + PUSH TP,(C) + HLLZS (TP) + PUSH TP,1(C) + JSP E,CHKARG ; HACK DEFER + PUSH TP,D + PUSH TP,B + MOVEI A,4 ; 3 ERROR ARGS + JRST CALER + +BADCL: PUSHJ P,E.GET + ERRUUO EQUOTE BAD-DECLARATION-LIST + +; ROUTINE TO RESSET INT STUFF + +E.GET: MOVE E,(TP) + MOVE PVP,PVSTOR+1 + SETZM ASTO(PVP) + SETZM BSTO(PVP) + SETZM CSTO(PVP) + POPJ P, + +; Declarations processor for MUDDLE type declarations. +; Receives a pattern in a and B and an object in C and D. +; It skip returns if the object fits otherwise it doesn't. +; Declaration syntax errors are caught and sent to ERROR. + +TMATCH: MOVEI 0,1 ; RET SPECIAL INDICATOR + SKIPE IGDECL ; IGNORING DECLS? + JRST CPOPJ1 ; YUP, ACT LIKE THEY WON + +TMATCX: GETYP 0,A ; GET PATTERNS TYPE + CAIE 0,TSEG + CAIN 0,TFORM ; MUST BE FORM OR ATOM + JRST TMAT1 + CAIE 0,TATOM + JRST TERR1 ; WRONG TYPE FOR A DCL + +; SIMPLE TYPE MATCHER + +TYPMAT: GETYP E,C ; OBJECTS TYPE TO E + PUSH P,E ; SAVE IT + PUSH TP,C + PUSH TP,D + PUSHJ P,TYPFND ; CONVERT TYPE NAME TO CODE + JRST SPECS ; NOT A TYPE NAME, TRY SPECIALS + SUB TP,[2,,2] + POP P,E ; RESTORE TYPE OF OBJECT + MOVEI 0,0 ; SPECIAL INDICATOR + CAIN E,(D) ; SKIP IF LOSERS +CPOPJ1: AOS (P) ; GOOD RETURN +CPOPJ: POPJ P, + +SPECS: POP P,A ; RESTORE OBJECTS TYPE + POP TP,D + POP TP,C + CAMN B,IMQUOTE ANY + JRST CPOPJ1 ; RETURN IMMEDIATELY IF ANYTHING WINS + CAMN B,IMQUOTE STRUCTURED + JRST ISTRUC ; LET ISTRUC DO THE WORK + CAMN B,IMQUOTE APPLICABLE + JRST APLQ + CAMN B,IMQUOTE LOCATIVE + JRST LOCQQ + PUSH TP,$TATOM + PUSH TP,B + PUSH TP,C + PUSH TP,D + MOVSI A,TATOM + MOVSI C,TATOM + MOVE D,IMQUOTE DECL + PUSHJ P,IGET + JUMPE B,TERR2X + MOVEM A,-3(TP) + MOVEM B,-2(TP) + INTGO + POP TP,D + POP TP,C + POP TP,B + POP TP,A + JRST TMATCX + +; ARRIVE HERE FOR A FORM IN THE DCLS + +TMAT1: JUMPE B,TERR3 ; EMPTY FORM LOSES + HRRZ E,(B) ; CDR IT + JUMPE E,TMAT3 ; CANT BE SPECIAL/UNSPECIAL, LEAVE + PUSHJ P,0ATGET ; GET POSSIBLE ATOM IN 0 + JRST TEXP1 ; NOT ATOM + CAME 0,MQUOTE SPECIAL + CAMN 0,MQUOTE UNSPECIAL + JRST TMAT2 ; IGNORE SPECIAL/UNSPECIAL +TMAT3: PUSHJ P,TEXP1 + JRST .+2 + AOS (P) + MOVEI 0,0 ; RET UNSPECIAL INDICATION + POPJ P, + +TEXP1: JUMPE B,TERR3 ; EMPTY FORM + GETYP E,A ; CHECK CURRENT TYPE + CAIN E,TATOM ; IF ATOM, + JRST TYPMA1 ; SIMPLE MATCH + CAIN E,TSEG + JRST .+3 + CAIE E,TFORM + JRST TERR4 + GETYP 0,(B) ; WHAT IS FIRST ELEMEMT + CAIE 0,TFORM ; FORM=> <....> OR <....> + JRST TEXP12 + PUSH TP,$TLIST ; SAVE LIST + PUSH TP,B + MOVE B,1(B) ; GET FORM + PUSH TP,C + PUSH TP,D + PUSH P,E + PUSHJ P,ACTRT1 + TDZA 0,0 ; REMEMBER LACK OF SKIP + MOVEI 0,1 + POP P,E + POP TP,D + POP TP,C + MOVE B,(TP) ; GET BACK SAVED LIST + SUB TP,[2,,2] + JUMPE 0,CPOPJ ; LOSERS EXIT IMMEDIATELY + HRRZ B,(B) ; OTHERWISE REST THE LIST AND FALL INTO ELETYPE + +; CHECKS TYPES OF ELEMENTS OF STRUCTURES + +ELETYP: CAIE E,TSEG ; MUST BE EXAXT? + JUMPE B,CPOPJ1 ; EMPTY=> WON + PUSH TP,$TLIST ; SAVE DCL LIST + PUSH TP,B + MOVE A,C ; GET OBJ IN A AND B + MOVE B,D + CAIE E,TSEG + TDZA E,E + MOVNI E,1 + PUSH P,E + PUSHJ P,TYPSGR ; GET REST/NTH CODE + JRST ELETYL ; LOSER + CAIN C,5 ; BYTE STRING COMES HERE + JRST ELEBYT ; HACK IT + PUSH TP,DSTORE + PUSH TP,D + PUSH P,C ; SAVE CODE + PUSH TP,[0] ; AND SLOTS + PUSH TP,[0] + +; MAIN ELEMENT SCANNING LOOP + +ELETY1: XCT TESTR(C) ; SKIP IF OBJ NOT EMPTY + JRST ELETY2 ; CHEK EMPTY WINNER + SKIPN -4(TP) + JRST ELETY4 + XCT TYPG(C) ; GET ELEMENT + XCT VALG(C) + JSP E,CHKAB ; CHECK OUT DEFER + MOVEM A,-1(TP) ; AND SAVE IT + MOVEM B,(TP) + MOVE C,A + MOVE D,B ; FOR OTHER MATCHERS + MOVE B,-4(TP) ; GET PATTERN + MOVE A,(B) + GETYP 0,(B) ; GET TYPE OF <1 pattern> + MOVE B,1(B) ; GET ATOM OR WHATEVER + CAIE 0,TATOM ; ATOM ... SIMPLE TYPE + JRST ELETY3 + PUSHJ P,TYPMAT ; DO SIMPLE TYPE MATCH + JRST ELETY4 ; LOSER + +; HERE TO REST EVERYTHING AND GO ON BACK + +ELETY6: MOVE D,-2(TP) ; GET OBJ POINTER + MOVE C,(P) ; GET INCREMENT CODE + XCT INCR1(C) + MOVEM D,-2(TP) ; SAVED INCREMENTED GOODIR + MOVE 0,DSTORE + MOVEM 0,-3(TP) + +ELETY9: HRRZ B,@-4(TP) ; CDR IT + MOVEM B,-4(TP) + JUMPN B,ELETY1 + + SKIPN -1(P) ; SKIP IF EXACT REQUIRED + JRST ELETY8 + XCT TESTR(C) + JRST ELETY8 + JRST ELETY4 + + +; HERE IF PATTERN EMPTY + +ELETY8: AOS -2(P) ; SKIP RETURN +ELETY4: SETZM DSTORE + SUB P,[2,,2] + SUB TP,[6,,6] + POPJ P, + +ELETYL: SUB P,[1,,1] + SUB TP,[2,,2] + POPJ P, + +; HERE TO HANDLE EMPTY OBJECT + +ELETY2: MOVE B,-4(TP) ; GET PATTERN + JUMPE B,ELETY8 + GETYP 0,(B) ; CHECK FOR [REST ...] + SETZM DSTORE + CAIE 0,TVEC + JRST ELETY4 ; LOSER + HLRZ 0,1(B) ; SIZE OF IT + CAILE 0,-4 ; MUST BE 2 + JRST ELETY4 + MOVE B,1(B) ; GET IT + PUSHJ P,0ATGET ; LOOK FOR REST + JRST ELETY4 + CAMN 0,MQUOTE OPTIONAL + JRST ELETY8 + CAME 0,MQUOTE OPT + CAMN 0,IMQUOTE REST + JRST ELETY8 ; WINNER!!!! + JRST ELETY4 ; LOSER + +; HERE TO CHECK OUT A FORM ELEMNT + +ELETY3: CAIN 0,TSEG + JRST ELGO + CAIE 0,TFORM + JRST ELETY7 +ELGO: SETZM DSTORE + PUSHJ P,TEXP1 ; AND ANALYSE IT + JRST ELETY4 ; LOSER + MOVE 0,-3(TP) ; RESET DSTO + MOVEM 0,DSTORE + JRST ELETY6 ; WINNER + +; CHECK FOR VECTOR IN PATTERN + +ELETY7: CAIE 0,TVEC ; SKIP IF WINNER + JRST TERR12 ; YET ANOTHER ERROR + HLRE C,B ; CHECK LEENGTH + CAMLE C,[-4] ; MUST BE 2 LONG + JRST TERR13 + PUSHJ P,0ATGET ; 1ST ELEMENT ATOM? + JRST ELET71 ; COULD BE FORM + CAME 0,MQUOTE OPT + CAMN 0,MQUOTE OPTIONAL + JRST ELET72 + CAME 0,IMQUOTE REST + JRST TERR14 + MOVE 0,(P) ; GET STRUC CODE + CAIN 0,2 + CAME C,[-4] + JRST ELNUVE + + GETYP 0,2(B) ; SEE IF UVECTOR REST SIMPLE TYPE + CAIE 0,TATOM + JRST ELNUVE + + MOVE C,3(B) ; GET ATOM + HLRE 0,C + SUB C,0 ; POINT TO DOPE WDS + HRRE 0,(C) + JUMPE 0,ELNUVE + MOVSI A,TATOM + MOVE B,3(B) + MOVE C,-2(TP) + HLRE D,C + SUB C,D + GETYP C,(C) + MOVSI C,(C) + PUSHJ P,TMATCX + JRST ELETY4 + JRST ELETY8 + +ELNUVE: TDOA 0,[-1] +ELET72: MOVSI 0,(SETZ) ; FLAG USED IN RESTIT + PUSH P,0 + PUSHJ P,RESTIT ; CHECK REST OF STRUCTUR + JRST ELET41 + POP P,0 + TRNE 0,-1 + JRST ELETY8 ; WIN AND DONE + JRST ELET81 + +ELET41: SUB P,[1,,1] + JRST ELETY4 + +; CHECK FOR [fix .... ] + +ELET71: CAIE 0,TFIX + JRST TERR15 + MOVNS C + ASH C,-1 + MOVE 0,1(B) ; GET NUMBER + IMULI 0,-1(C) ; COUNT MORE + PUSH P,0 + PUSHJ P,RESTIT ; AND CHECK FIX NUM OF ELEMENTS + TDZA 0,0 + MOVEI 0,1 + SUB P,[1,,1] + JUMPE 0,ELETY4 +ELET81: MOVE D,-2(TP) ; GET OBJECT BACK + MOVE 0,-3(TP) ; RESET DSTO + MOVEM 0,DSTORE + MOVE C,(P) ; RESTORE CODE FOR RESTING ETC. + JRST ELETY9 + + +; HERE TO DO A TASTEFUL TYPMAT + +TYPMA1: PUSH TP,C + PUSH TP,D + PUSHJ P,TYPMAT + TDZA 0,0 ; REMEMBER LOSSAGE + MOVEI 0,1 ; OR WINNAGE + POP TP,D + POP TP,C ; RESTORE OBJECT + JUMPN 0,CPOPJ1 ; SKIPPED BEFORE, SKIP AGAIN + POPJ P, + +; HERE TO SKIP SPECIAL/UNSPECIAL + +TMAT2: CAME 0,MQUOTE SPECIAL + TDZA 0,0 + MOVEI 0,1 + PUSH P,0 ; SAVE INDICATOR + HRRZ A,(E) ; CHECK FOR EXACT LENGTH + JUMPN A,TERR16 + GETYP A,(E) ; TYPE OF NEW PAT + MOVE B,1(E) ; VALUE + MOVSI A,(A) + PUSHJ P,TEXP1 + JRST .+2 + AOS -1(P) + POP P,0 + POPJ P, + +; LOOK FOR SIMPLE TYPE + CAIE 0,TSEG + CAIN 0,TFORM ; FORM--> HAIRY PATTERN + MOVEI E,TEXP1 + TLO E,400000 + PUSHJ P,(E) ; DO IT + JRST RESTI5 + JRST RESTI4 + +RESTI2: SKIPGE (P) ; SKIP IF WON + AOS -2(P) ; COUNTERACT CPOPJ1 + JRST RESTI5 + +RESTI3: TEXP1 + TYPMAT + +; HERE TO MATHC A QUOTED OBJ +; B/ FORM QUOTE... C,D/ OBJECT TO MATCH AGAINST + +MQUOT: HRRZ B,(B) ; LOOK AT NEXT + JUMPE B,TERR7 + GETYP A,(B) ; GET TYPE + MOVSI A,(A) + MOVE B,1(B) ; AND VALUE + JSP E,CHKAB ; HACK DEFER + PUSH TP,A + PUSH TP,B + PUSH TP,C + PUSH TP,D + MOVEI D,-3(TP) + MOVEI C,-1(TP) + PUSHJ P,IEQUAL + TDZA 0,0 + MOVEI 0,1 + JRST POPPIT + +; HERE TO HANDLE SPECIAL BYTE STRING HAIR + +ELEBYT: MOVE B,(TP) ; GET DECL LIST BACK + POP P,E ; EXACTNESS FLAG + JUMPE B,ELEBY2 + GETYP 0,(B) + CAIE 0,TFIX + JRST TERR17 + MOVE A,1(B) + HRRZ B,(B) + HRRZ 0,(B) + SKIPE B + JUMPN 0,TERR17 + LDB C,[300600,,D] ; GET BYTE SIZE + CAIE A,(C) + JRST ELEBY3 + HRRZ C,DSTORE +ELEBY2: MOVEI A,0 + JUMPE B,ELEBY4 + GETYP 0,(B) + CAIE 0,TFIX + JRST TERR17 + MOVE A,1(B) +ELEBY4: CAIGE C,(A) + JRST ELEBY3 + CAIE A,(C) + JUMPN E,ELEBY3 + AOS (P) +ELEBY3: SETZM DSTORE + SUB TP,[2,,2] + POPJ P, + + + +; GET ATOM IN AC 0 + +0ATGET: GETYP 0,(B) + CAIE 0,TATOM ; SKIP IF ATOM + POPJ P, + MOVE 0,1(B) ; GET ATOM + JRST CPOPJ1 + +TERR17: MOVE B,-2(TP) + MOVE B,1(B) + HRRZ 0,(P) + CAIN 0,FOOPC + MOVE B,-4(TP) + MOVSI A,TFORM + MOVE E,EQUOTE BAD-BYTES-DECL + SETZM DSTORE + JRST TERRD + +TERR18: SKIPA E,EQUOTE TOO-MANY-ARGS-TO-PRIMTYPE-DECL +TERR16: MOVE E,EQUOTE TOO-MANY-ARGS-TO-SPECIAL-UNSPECIAL-DECL + MOVSI A,TFORM + JRST TERRD + +TERR9: MOVS A,0 ; TYPE TO A +TERR4: +TERR5: +TERR15: +TERR1: MOVE E,EQUOTE DECL-ELEMENT-NOT-FORM-OR-ATOM + JRST TERRD + +TERR2X: SUB TP,[2,,2] + POP TP,B + POP TP,A + +TERR2: MOVSI A,TATOM + MOVE E,EQUOTE ATOM-NOT-TYPE-NAME-OR-SPECIAL-SYMBOL + JRST TERRD +TERR6: +TERR3: MOVE E,EQUOTE EMPTY-FORM-IN-DECL + JRST TERRD +TERR7: MOVE E,EQUOTE EMPTY-OR/PRIMTYPE-FORM + JRST TERRD + +TERR8: MOVS A,0 ; TYPE TO A + MOVE E,EQUOTE NON-TYPE-FOR-PRIMTYPE-ARG + JRST TERRD +TERR12: MOVE E,EQUOTE ELEMENT-TYPE-NOT-ATOM-FORM-OR-VECTOR + JRST TERRD +TERR13: MOVE E,EQUOTE VECTOR-LESS-THAN-2-ELEMENTS + JRST TERRD +TERR14: MOVE E,EQUOTE FIRST-VECTOR-ELEMENT-NOT-REST-OR-A-FIX + +TERRD: PUSH TP,$TATOM + PUSH TP,EQUOTE BAD-TYPE-SPECIFICATION + PUSH TP,$TATOM + PUSH TP,E + PUSH TP,A + PUSH TP,B + MOVEI A,3 + JRST CALER + +IMPURE + +IGDECL: 0 + +PURE + +END + \ No newline at end of file diff --git a//ecagc.bin.1 b//ecagc.bin.1 new file mode 100644 index 0000000..e69de29 diff --git a//eval.bin.13 b//eval.bin.13 new file mode 100644 index 0000000000000000000000000000000000000000..c13d12be24ac490e79505527e4409dd118b62165 GIT binary patch literal 76577 zcmc$Hhg%yv^R>M04U9>EPz7;-Pz@x&O&YMA zdSS{tzYvI&?^{28(W+3tdl>W}s0`MHmW$o(GsXJlpD zdNOvJeq9f#YZEq;k&iX@huF$qhxHhLztF#qN1uweq=&lsvNv9`SiyHn$M>7%DaKq5 zZA3Sx79@y{hbE&YLKrIU`Leu=r(3F|V)i4SkenJ+s>a(jWAXY)H#bhIP?hqS_@wG9 z=DP3jK{dX-mKjll8g$->&KM?xxI~-o-R&50iIy{6hEN^r$-R1q zmro|&xzWf=iK;@GA;~FxYE{Zjl3~^8dS+;Dgiog0QEHF5+yePe5+`#jIrc*hrok=V z?N2kDe3fuy1K|=%P4`y*Z6zBLt{58;m;1W?=IRtFsixr2>#Q0CSN{F>j7bhH?&JGO zPdk69Wct(da#e*OL;Pt8&vdS7`Jj3hu4ND-p$rs=eeHeUJNm1xAuvkG zR8I^5Iz1dbI_hl0tGbenvSA&=lWs~YbD;^@t$XEv6V<-7QW;<6(ccbMIo>=*EyJZ= z938P>P=g0i8lJD?CVr{l#D~v^^9Agl1Ik~7mRod$Pt+xPGL*?iG{=j2yY*%N$dbqD zp!|hd5P3vI9uRGr|KGgS|58<`f+6M0pezYxCrKeNx;iw24|ymq^9zcX2cF;kCx_xP zUk=4({v3)K&O-5@59EL-F3Q38ywbP`iiL3-#brL>UO$>`xoef$sZdOwaRJ32e@dxc z8j6EN@i%pCUj>JhS)K>ms^P=G-}=V@R$wyN@4}l9eOTF~;wymYQMi8$zxl4zP#dTz zn@Zi}&k}7+0MtI*NT9vOsA=1KYJ~U`x31>gt=~iyVvMALn;ICie@5FCp1h0mSGUMt zQW?6Twxb{K>>DU|^y5}~b$s`Fb?t8Q4_XvEwX3t{@`#CFF-aE>>S{7InG_8YlMiRQ zA-=yYsqv3j7Ju;t6ZhDwhwHa%$zR=xFd7ClV+YxY#@4@7RaXpTBcH z^4E58@)syS;pznb)^Dk6PUPvLU2|75uT-9B^vQ0Y)YQ#BtFW=gP|9tI+Ma7*&t zBl*dvah;k_o{oB@W(8bwn=m{!%q*=;pk~$D(I5HQW8x>`2HS-^NyX(!2SBQi^#h=_ zFdnH}ZtJRX7EQ|GNd=cC#3_> zX2_6IeVLY{!;V9ePN1RDKKyLdN;RzO^;`o)PP`636)ip%6j?9m!?LTnrE+eEP8GtCy?4Zc-jEp4|v z%WY+Dcz$JWq;qv>adK#QW|S`ro3UzX#(MfDI$p9F^RaolHqCHbc&c`qF@!@Yz!>|} z!6re%72{>Y&ER>AF>QlY8H4JT@IqG9tI@@e##vf0u#1Z=*sIHJ!CtWiyQZqr>Q#d3 zpW@yUl-SJ#nD6L^^y_^Ce;3@sIiK{qOlGUVjH+KyRluZDHz-;pDs3Y#UIl5pq^@LbWhnNJl@&`%R1ELLD^qx zbBUhV%{AD4h)5rT1m1N;vq4M$ovNE#vBFp^*ta*OU?HQ5Rg>=udAX^oGK5yHo9iaY zuu&9&racXRFRH@2>? zc3Gu%Dmap7Tr4$lFsaMx=6b?};}>)@JYneUWa@S=($!ErJ{rf59jy#i1s!4El=?#b z{5Yqd6+DYT>^^y}TYYdaga4k=*y@k$wp*s>gY8?BL<^x(;SxO&wtlh^w|Rj+xU*UP z<}9#%%Vb3WR~^{yntWHt%T?FWXsR^&H%^iatCp6B9!-zUFV3n0En2ZF*!_F8fBKJu z-M0>QcOC2^oQ>W44t9&NQI=OE7r?G1yc~9|GN{}0ew#WAcEK|)V)u#^-KAl-l-T_U zi^5Z?Qp)hTo*1^K9;Y|!7o|!Iz>}rd<<dXJOVBwORLhxPkoDma#^G4NpUQ6Lv}MLU7&` zuBvMfrt+OXg?0pEH1$ttm;$g!KmbpCSJ!W5l$TG9Vpg;n8RgN#cz5h48Cqw!+I>Vt zn}XEv-_v3Os`J%>#c#A2J+0zmzz5^Cd~k1g=K;sc^UQr$>?!A?h|eRimwg=LbFpwI zzRS5l;`45hi9f%ayyWk;OWyq|PYS8Uj=d}P^F#v00vCH%oWEaRXfb*o9V4$$V4sRn zIq}^w0&cj|k}Aeu=+AG@xT;EcGQhfA#_PQ|d%veJAmdpmv0hoGMq(JhJPT`6_up5$ zy5xL1`_LriLOtnmiJqvlVQM6X(e4W`Vro2>7W+2&WO_jygIzl1}SZdDEY-zu9eh{nhEK|DfT&~>xPEK@F5?*_X8V#9Kd*tt%0Y9y9&s#iOv56=fzP=F^e-4I>iVr55%HG`1FgPF%P(t_`pVi2W+Wom1@qj^U&jOT*D1Tg2aQ3O#qEN;hmMYm-3Y~m1erau5kKs|8RvK zdZXUZrlDNMAt;zfHh_&Lw^rOyAiyLWq=I#gfyq|-r6l`w=T|c@#}|Tgd@`Q4V$`?0 zwMwa-)`p`a7FgNiz#0Yshy%AsObsG=?wERIT&a5;cuT{dJ7=PSdui`I{ zRTrm11X&?|Gu$TOUCU^_W;*0iZWY42NUYSUAM#TQ$7RUnMKjZKxdkCOXxV<;T}l21 z655j>UW{Q{Uh?$FDr~Bj4ZQQ*8dJt7Zk}?DQUeZ9B(4t%u65-T?~!J4QjdAseCtZJ z87My#r_o08?ZV3|GLr*{=MTvn0GJJVk=q+k@gys+ym?OkMpP($FdkwJ*wl#)JyF%IXOQ2`OV$o=g*3Ntoo*V-$%oC8>$w#TZja!&pKZ#`5G{ zV|$YPJ%jpEss1L&P1LJ&s+kW+u=MCi8@LJ4f$>}rDGfG(YaE0NsnihKk3(=Snk%oY zq)h=Swi?EpT>D|{I06`#;zUfl{pje29+#Wv!?O_@uEws>tnoEhVc(O~2c&^kgJZ|F zPlqv00gaW#y^CTe#(q-2lAet*DbdLI7MUa%JV~KaSCYI3S?8z>Kr*65XT<-U#CvsX zLd9nY3-LeuCtuh1ye5C&5-G?Rq~bFYx#X%hBJqGtkAp1`EHLfT)lEA|U` z$rQI=>={R(>`ACZg4|0h?#Zi{2H)j?DZTAAQA>?Y&_QknMZpvD9?F9yalc7F@7nJl?zlJQqgp!WCGEHc2-Spz< z&q5QbRa+ATAo&%A=h|G9Ae%OCi=N7$f`N)^gnbZ_HcF(QIvj3$O#WJ6USfpYL_#dJ zS;-*t5oC;@a0<}GXC)fL(J1m_8qyC+8h}IXNm{lFV+7n7YzNgk%Vhu`Sc$!T8foMi zK*G3%zj_tfqp?WHdw0_Z6^izY_jb}ZVKVzh6+b-822l32OJ4Ek9cJ}43o%$bI8mO# zPlycfw)ypz*hq;K>_7fAT?@sHMiptH#EG_sCx7`%pq;IicUSaZ&RX&gi?y`*db_@g z{0%4cq#@)-gbl{M;>HyVic}_xC7$&oaU(ThSR*wq2aF~Xe9w1Q2F*>oa=tN9oc^4G z@`3~|DM=T_6Dx)9mh_-11 zNh%)zyuhD&H~}ks1UGW^okXAHvKpUlY{D#y-jR@ZuWeI#AK!+aoYji>@P8a^@*)=d$YgDvl$`hp1+1 zDGsT5ce1b#{&qDX3nZ$#BVeO{Y+V2%x4=yuL4G-G1+xMln55w9(_qt!p$YQ0YiJnQ zPGLU*Wn)h|XU@BiOzoXmeSCU6^k`YBxuMxnHM9bv$_K~u==$>F5ThBnTl{sd#`_*S zbt`;*S_iZbkb$j{ea;a37n_#)njZyXf#9_PTmCVd&f#0ICT>KX6cWP&va}MXqk%zDw`eowm9-dI9t8}N4~{4Sa!2@QTfvMRmmQN49mV+Ig5P3E-uP&W%c5xAAqV+BhW@S_(@6mGl%GffcDE;EEjjlg@D2EFe46D{t zcmfs6u<_^#VA7%hs~PA76&eYi+l{N;>>2tR417+>J4Tzy!WQ`Z6t>Ub?i5nnNumGI z1Y#0E`~8`*l>%1NT|8ik+Od zn5ObIr#^p}93g*ga4Z;_T(JY~gNp%KKp`4CQizDAzDY^aC}(w!Puxo3CgHTkJD4si zl~v#rv!A>lFe>P~L$ksoH_GF#P|?FIp%IV=r@j_&>TBuf$Gb3ypw#f>_KKz^CNN3= z+Jpgk_eum4w_^h*U}bHp$;cA;zQzXaEmq|`)eMr#If=%~nU*$y^?css%R*k#(rCIfNZcfaKoM<*u}a`^cR{>4YP`?YGu*|(wf2_5^}G( z`Q^^ZxlZ&fI%g)AmJ4m9EfIIqSmXB_xv{&-O-I~Yj<^xd68Fv`i%#s9Vr=9!#}{q9 zh6(CT$p>uUEi4by>XcL0D#0!;O1kE9CH;t!zJsx2-=h*qlVxACxjfC5#P?{`x77C2 ztpVo}ckMTmlnW|$dDta-qLT5Fji}8Fny04z9YBMHcq%1R`;E!65Vt~7h>%C^ca!f5 zc?r4mePry|O_E{N3Fdk2cY)s2`kM}{cCzfI+HX1N)qc-GkKrunJ+2@d>>3qi!wQ=Q5v z^|bCm*)sWi3NMoKk-w|1uX(*GtxRkE<)Ord$B=PfNVu#IUT3EEjBXZW-(zUnNHQEO z?(%X;S4Wry<^zHK2NIaYNq-$OL&{RR;6mK1F7 zd7hm^^9Vn2BRz5bk<>1I$cFg;63VlWl}#9x5!c^)j=0kaZD<7X<_1gr2jZs&4WG<@ zmwbfVxy({7ZJ;)a!(QH%sx^4Hz~5I)3rK1K1Km^sVS^lmB)^<$CITAp9{2?0h9&{B$7tLwJhMG6vTM`8_&9UO<_SDF1;$26OaKun+KIu>NZN zsk*k~Hw^S)F>HqzRvPqAiVMyqpquy(ec0QQ5I@j829f#jfxQz=lXx@h0~PlPUp3As=!~x zCu<;0MhkKp#4qkyQ8$fSd;W<}`y0?9!ue2Iji!?5T`Y|Sv_mqMp1(vqfJP(femC( zo@Cfg=7SJSsJa9{1%<%D_T8zOPxr{*oS7Ob-*lZEXe#|X)RXT>bRjn##y@YOm^nkk ze@6m?qJI%jGlo%%l0pm%m|IUI)qL)mzmn(@R*10I>MfgjdSLw@pu zasTtd-Ussc7~iak9Uhrxz##Gz;FH03VdqJz!B%<`;v=V<+Nkn>Rz3{O2~lZNGGyph zGpBe=A%hHeAOzOiz#D&Vu`-88KZZX|t1|b=yAAe!E$P zuZMV1cTjoAB1MvXSAV6YLd#R{+Sk-SyZzzob{m%i;>itz~^Jl(8Obqk+&Xh8)KVA2k^ zF%mpFa!V}>CFLdM5TC-LzId~S1~sTycm_Z*vyk9tl{B22M zS*e$AJ)0^C6FWz~Zg!xKKAAv`s}#g=MHWOU1nOn}DaqHGCen~TwopdgDvopo8h*SR zj2x(IKLQPA3NKtzm^TtgFQSIE=?j&Jbx4gAXm%1$iJId( zEfb36CX3|BK`R6aO^C|w_io??CBu3dXqQ~k6HHT8P(TbZ7H)I}6)~irwqk#_00zP1()@(~Rg-k_Yq7lJ6i6H~S0|ttYh3Ml4 zTE2n%ZYL=lKqb~q08hF}Xoplfy^SX+H9bO7C?q9&cQEcfv9slC8brxUV9}*#lE3Qo z_g{~)R1XUXQu6NbFt|hhhH1tlAIM;rkN)D}DkL<*TL|x12AwPo&gHa9u_;ZQ?gc(f12 zPD^W7@FL_tkwVSdgKZRw3Oo@GM)sc^Hj_W<9ndGw-EHHLK8Gp*J&1M;rN%+MLk{X4 ztsv*+{P|aE51)?o1OnHq37I|`*d&0t8ByS+fFH0$?~}LgESby!_-_G3gBJcQoDQRe z)~8UQQ$bG+ySafk=w>NBAh~2`UO?z#Ltvp5VW9zwKB`hm`WNerHAz9mIb6zP(lZlKg!(^a$ohv7^}2qyi=r|JL!~NJf$% z%jZW&f8B&Eb{!N8Sd}tC-XOcr!6a|;#P&DvTN}tx8>?i7m9tSQB1GY{K!^_tQ9*!p znkwV5X89Q{OZO7w?lp;@=Mb#*ZWyElm;)Lrmqx;S&xXgN zy0eHTXo8SyJ|k4nFJ;P^b~0!d7VdQdKP^%j1dZ*EoAN7(qo!hD+1_&ec#e(Nv{H^F}Js+i)0uH_uCWORt1;T`0i|zv^jtweR@w@v=&~*u% z&&knXlBnC?$ACw2L!C4qWOQ|Aer1_4Ots_gWLMW9qFwrD@H2e5wx^?hn&If_XmC6o z2!~A2(;*w`(cxTIjDx3cwk|l<5$t3d^<;$u^-s<+P|s}PqNn4<1?20A5+y!?k2pE-^HjJp(;YzF}_IB3jVQGSL zQz1j+P7BY=?%XG&8(1zsxPukX;BRSbqK8x*HvRUWa8i--3^B!D7uMHF0Nw4nx z-FKXi6kHPnLuT1x-a6twz>Qsf`uV+jK&zk^tOkAS=vR1@nm2T}@q_Jo>Curpm%SS{ zHJu#c^4h0Mu@ou45K-LU;1iRSn!L~da9Qlf@IUx6byzmwxu^yiGfA{igZ$$XJ#knz zKsHKjUeNYDOf;Nj8-_aA6S!DI2SwkrvX7g5SIEntG?4Dx4>w7MRsY^@s%~6Vnt4b6 zfveqaAjce)Htwi2gahQzK(5K86=@)gad11YG%heAYst-cC|kYS*{|!V29%*sPpj9! zGcK0ez~#1*FR9nK5HEP4dRu;io!};)taU8x;P2IYS0B^H z1gFIAzTrtEBnSgzXEJ`k&ExK0*E_6&TO_(ehlYnYB^y);6^IFS72QLt<0*9^6}j0t zKvQj3YK3g5hfu-Y&v%Ym-?<_?U%Q$$nPednZ@5HHtQ9`)>lfpV@ztA>k~3``TL;G& zF3LCM)QTr2-xczbI#w&(BpFuC{A=sjI`o*KC}(2tx}4pe>ax=eyoH+g#HkesXVr>T znRhL~c6SadSmP+gi;`hhrw0Dc5NV5X|N?%=cw`Z-9qaPU(jtQ#*^HmP|N zH_iQXw1FGHz7xdO^tRo!3~;a={9Kp)T91v4F9h3q!vw8DsFeM6iJqugz2qh8F!a_N z#ZI!Phi$#VWLfqvu`iQG)*DvpX)hk<<##{lM%Y?XI!E_3N9?M@_ zb&`Jek&T$m3rvV>pC|3TUQVT-uU9ZxO6%!P4(Qh_O};D8&#@iXgpm1;ZjubEW@hFe z6{_azm4fkD?fmoc9LBF#4{GKX=7voJm;Mk-ZvQ4U_aMSKy}Y{|{WxSjom`kA3g zOFf)QHIrvtEH&xHs7u56A7b1?6XH)Yt;$>zLR9k?*Jhx8zOrs$S_NTiLA3f-_G1hf`JE4e#oZ+U3?wog_`|1`qKa1!D*X=({=}^2xsAR)Y(4rdNDSzlsDJr zT?D6=@Nzh{%Ahgv=A-QYcS>E%yx}5Fu{EZ~h{7eE^$}9Q>G!{IC5A9x0NqZ-e85u=4@)feBj2z%b+zJsFr}BVzNS)VsEJx;5Fo zJ{>S0Fj*;G(*fo~lkWq`OpC- z!r8!lKsH2y7GvXHUXfhDNU(&L1Ey65jmh{`e^$1Peaz?8kMA(BvF-@pDX@4S=q0dvu$d<(&lzc%QkM%~L@{-eAxzItou zGx-IsFG@64d)Wz}*6Z~plP?Q->2Mo$Q;w8zk`w~t|MCl5UlL3%2EM>)lEdVpgUKZa zlL%*H((7Qd7za218%$bq%VE;WzD{mkk@IX$t1Q7YE|yxmROd@mmH}e&JCs5wP!;f$ zRW3Tkrmv`r~Ch0w1a>BmkC*~@}WP~8(ArYZSve}bN zU|7-L(${NkJ?ZPAd08)AcsYKe7au+WqM_1CEI(LDn|Q2w@@(yneDz|H4rb4`VzUlt z)}X6drO#xYQbZszn&P`_QdaV_rsHFnmMR7me7Nbr1a2Cgs?^=BEtnOV(A8uBQ+Ru{ z3UceZP)H*jr>+IR9j`de)ptaDS8Yx2CG++!KbQ7Sm6+tJ0IboxCgDV**Go2{HZQ0+ zHSJORfP_;Sy(x@q;sOMo?B^;@s?_AWLSFWd8NF_j46DW+tG7Ufr(lQC=zaWbZ#bvI zQzg0DlPb;C9)`1O&m%Z~EfrprjrV!FJwOwQlOt&{;!t zZc?|`z;B!6rlt9QTh~`mxE=H&-Loq)k)Fe6{Qz)0qtpi0UvegMBZWj|<_ebYS`$BS=>TL-0`=|*dFuKI+6zY0fl8U59jb5Fh*9%w%`&69TzUg0 z2w*HQw8K`YL}n!_2DWE8;t7Ql8YwS%HFcBxVN+UdShG%h$MBVjkGS(`WFqc5C*t;U z;D%ox$s$%3i5JtC{nrdN;Z-lE?6?oJ5loTc_K`D*&zb#vn$@jHDUD;0t~v)$85Yq9h+>sh=v5yl$S3hjVk}g)a`qFD z(r~Tv{U9eRgfIgO^;GDwh&?(5M-Y%f%IW!hB ze3;Vr9C6+3>t-{D4V0RQ=T??8tC`T44yjQ8ORyn7WiwNi<;lB86-SQb@Pr1A`2^99UDm`4!;f!UV>3!nM&t(O4Mg zse6CFvAvtiBNn($PJVXrr>xr%$>23G39cT>DhSQh13l@jonG>Xl`can#l;TXxD`P{ zpxoc4#R(nS;!jS|3cVB==_&ieLz%%u5E@{xJ`Vzoz`a-2NXS$W7bT>!Ee0Rh3B6^w z5&^aF$FJ`M*%Iw%`qyHT{Jrxk?D{9w$|BJ5;o1VZQny<{uWv+KMYqQZaIYBT0}IDq zWTEjDgVtpnH42RgWj%~{n$hH^*q92@K4XGPsKJ`0;tW8^>^8xlOh%z;D(lL7k%n8u zGTR2P!#;N)O_Hphy!n+~)v$G-T1a8zVmajb*dm5r@{AbaGEtjYNeETG>9OBQS@oF6 zU`{_H9M_s_WM<)T;@isw@`s6S(9bUs&ML$wssXABKU*Y&d74m^R&&}WFJEOcURgqY z;$+6qcPV?BjcZRb0a15BK=ow*t3kX8U&$lN)jD`bu0VM~6O){TU$?h25g>mR31ucU zbBSt*4~yh~V*{w?yS7&v{Ep)nUx#BGCZ71A)`gi0P`@1F!xIJdAbDeunmjfnZ>@IT zxP&xZV=>;3(nU-Z4spes^%M>d-x(%;YA-~L#UWcq>iLqDh(4qZ}G(C zaOWoji&Lwo%YUU1D%_cuX_kF{u_vse>$BQ71imK4nLrbjA{&E(b_?h%PKT>D;mXZE zRDF0rDw71chOi=(UJDx>Y5lQy`~H%;mJSc#Kxgb>W!ORbpKvJIkx_3RyZMb~cz_J` zR*%N^#yt=Kukbxdt&oj}54hrijF)TQAP(D#)%NDizdx5{eiLgKaTQp@=+vIL^&bNl z*uXajPz5nwR{9~}jO*U)pJuqNhLxKGIUAVaAQViP>|4v(z(o_!o7!|9|AxkFdM1v& z6T%PR+PF!W%N+38v+Q0&c5%V{T@|0;rJ29shcJJ?Js`XvCW5Ag&T?t+`db-{MJ+i8?n&)>Xt1wX>Gni4_c;ZaPhu=rb) zy>T@aUC)jReR7oGQ&-m&CNwPxfu5zbEX^gV>c-V8&F|E;AK?`!4{yS4fbx_Ut-~Uk zD{E`6OtThslkg46@zzB(*Sw=6tTl>c$YR5#;@!YIS94WQ#Kl7&-l*~2XvG5E{qP2t zuKIHF2+y*dUu8q!FTJC}^YT+u3~uA8BbuAQr2MksDBnEE}tH*!7WrYgAFC>cP+66>~ zp1iX>LYxy*cRMLdkiz@FdY<20bvw7`Q&m$Y881{-`O~XU@(ugRM%?BFs^IUPH95%W zlmiquX|-FbK-MI2`0VDi$#;dk+;W`=CM^IrNrqL6qnXhmDUU)0IxPzH)79oCxHhbD z-J4T*X(`ZYM}guMP(lSNQ`b1ITa=BoTh8ZEpsn_tMN4?L6TvQn`b65eP3?V37uQY6 zhG@|~@xNS_6Cu1$EgHutMR;FEDe7VkS9CiIQAR0XZGJcL82g}k6306%-}4M6B7DFiZ$^W(=r_*pWY(g!4+{0`62xZaENI*{}cS`p{Ws6Wj#PxL9g3yr(Wr6CMzR zQJNYDDus;%3cRMFddJ`C7wtGOHX+tSsL9-g&5Zs&cI4CK6eo*R@{j``ElUQrPdR}N z;-3^lgh49!mFow?e>J9Vo8kUu_u)fVZs*d^Z9$=207w51fg_Bw3{W?yJWSiVW(Y;i=K`JB78E#|4|}(} zb2_mtkb`4eFb7A5v*6exyR#9FMLGE5X6rmU5ggJGW6vf+8-z|dTv#hT{qqd!knG|D z5?8)osyd8t65!XrKw?B;UW>piVz`@C5^HY?mWxJ03r+TEa~N8M@{n!w0j@|Ofm6A- zC{}%wGsEO;6YOmh@n>=L+aIx2xOal$d0Cvr6^UiXKwtplu-Q(`fPG?Ud=;Yn>Zj#< z@ajh=7G73mA~6D8c1`3I$;g$gLfl)Xid1pmMh^pvtBydAT+zg7^QZZLa3a8kW-7MT zm|&_3vmanlL;!tULQhca1i=6#=qtbsGd)4cAHG2P;F+; z0>^F#j?V59ZCwr=yB#0mizPn$-@#E6j$O>3z_I5n8WZf|A{=F+`lYqq z5luKgQ&p`I?b$$*z!fjZw|4jgw&H^JY3v{A9re29az059o1k?}()V4WCw5?bWFuzt zqSW@Lzfa7WQ+B1>hMBCCu7;ZkaT7TAc`r zDqLTpPHZFyu@6vHq!9+BX>k8KYY-g+=8<-&s>u61m4@9-j;bf-e+{v9mhB6yZ6>QH zK6tJ`8sM295aiAzHf79rVAtKevzuq5p9{*}YbIzG!UuDgPw&9)UK7y3fvs9{ZD{vu z4m90sInXei1sW}O6G2ln@f#Ndjm|UkTA9Ww^GBsM<~f7XBD=VNmkhF{FA*=T#LEit z(z>rF3@wsI(vem+fwH%?SXEcGhFP|5uF2p%swt*lq@3;u+t5&}!5OA9T>?KNH$?SS zSH>qy((9gnzMC-J(mfwuc1i0PUh*gQp5#R|$VSBG1-_eqMm`={@;FtuxqFw%iaf4} zJSf_CCf^mPK6OR$JU#V8!lS& z4owm(L_3Nq*M&OK=%r!)+v=SnJCVmb&ClNCEfhOf!X%M3Spm}fT=h$rn|zmF{azluKUV$RBpFsM4~-wIe(7?le#X0+ z*N(q9ot$Q1RKK)ycqzl#)$dWR`W59Me}Vl4s-Gn{yZYJLuiH%c&*Cp8&$w9qkT-pa z=G$XdzZ9$AV;t_0(3mM3seFR8eNN32OukHGCj{;&tR6ZaXtYH-rKOXb0s$YNQ0Z{v z*Iia7tLl<~v@Ypmm6*-gln{WIkkzH2);_A}_=yu%e?+!TjjzWmF}yQJQj_UBOtLX# zv#2~8Kds4|tXoo@Z{iyoL(ZKUm`Kj$jZvMiMzxrvSBT=gBU;T@!Jxo@p;R6Ceq*8{B+Sl;PhRjbzJ&5G&RGwrygWT!_q^SN!*l)!8o>_1~xGP3E#t0i@3i0oau`1l~9hm~$X7 zpR*#<2xmi}#DPFD4m$oj2pkXs;%E~EAR7vt76LSvEeOCFr!TPu)^ zALjIy$b4hCy$idC*wud1k@=P*bA+>GUMD+tu+N?@mU#X`?F&}>uS{c;IT4w+o~7D@ zU0kg8HJ2;%uar3sU7Uz~J*nC!q4Xm^i&XoIx*TuIRH8!Z{~|BU`)QLkN3te*9V zM>%phZw%CoUrM@&#Jgv!saF3}Tx9tPQn*t}qqq}ivLvvj)pnMV=D$K9CrJiv+@|u!fyOY z4!cD;$X}#<4(ztt(-keb*_|#s`}&7@aF*$cq~O>yX>XTi(Vr zy^UD?7#VdsSe$ng{vur?xyih69xcf(S+tbl)(oE+O0t(FlXT|9A8~6K{*6kUcqZq> zc@{U;kuAC+j-Bf!bw}DH(w(d%+tR zG7^v}88Y93;j9H))VrL#9*w#4f$P0Tx6p}K(Xz!aYxF{1s1fe32cyUFoIio#B!@V_U&wfE6v z)iueaTL%9=k&-;)V$r?0)Cv~m#EvhV*byy51xus~oQjbn0)1s*c*1hGJ27H3i z@+`~rwy7eU^ik}gg$VzJE5_hK5AiH~c+rWPt*bq)mix{Cfh>)8jZ=z#%XAJ_Nvuc2 zJNFPc+pEExqs6g&k&(gHoj>HS&b)`f?k4!GGYLrp;iL7pvMSp20*`_2Ebc=ZIwIY? zg9R1rmospaN{!&K8oncW-g2kl+E4jI0qYs40&8So)e5ZqtonIz7eG0YXzc6zN&Z@u z*Hl^<=PjsL;c$`mQv8^R8EwmAO)yTkfM$>zCT2xDO%n;p=}j2Tz;Fo9V;NvVZuRj*%IK|6c$KJ&4E)1L z(Od4Qha7oR>~Ig<^-&f=0@1fHCI{f13j|AxsV7q=j<_ySiXeJx@f&3!c zZ#{x=*#L-22c}1>$Q^W36A5`D2RO=*!!;qVmB1|&l`YwNeHIxkkbD8LfmiAU{75ernnz03pnCFGYN z+EBZ!eBpcbB%rYjueIUmsA&U5{3?9qm7n~r03KLP*^0Kpvg>HtaIr9E1VSj1)xIf6 zQ6!kF0m?%$ay~0S=u;k57yI^lP-3vDq-!#|sX;ZYjlhSPRnE1_Y;ZTBErY2wT8-{Q_6YfL5cJk00nc=q?1 zpqZy*J3hVqIisp}_*Qwa-pZ;h@)Ol+asJWh(o*N#{Bq~w=+esU(D2MCzZJGPebVAQ z{u0@B*q-nIVWu}oQ*n}$U+xLQ4aE#f?c2^VaY9L=UCaV`+ji!+F76n zo^cU+1OH#32R*q(JIC!v9HJu;l>=c{aw9PDj0|T&MMmTp4Ug6+*tAyBQR?DfCR7;C z&B)s@J9OmkG{C*CJUWD1BXpuQW1$TK^k@UOY@`LdW@`|*HKk(S^i)tt7HT-=t!&0Sepu--(Yp4IfDHBXSNZB_bR>gIe0VQ| z^R;)oP+i()SXWR#fjg)x1KpD&N?V|PR77m za2v%@(P4t(VjO6>C-O&c z*tsQkz1)gN`jS712<}`EMZXp;-TXh{DeM+>v2Ns^$*dOQ0LMu3B`%<@ph+ECULKvz zEO#!?cRrdJnj0VOoE@5*92;F)?pz&OoMZ#*0whBUY(w`1B{y$)et#oM0+h^02PJ!Z z{Wzqm+zMyux~S~bD&dOp7jZLvQIz}=UdX7lu;OSuElQ9rTto?mF7@TP_@lpw5--ic zUkOY}$pO#0Y3EBs+02_GsmD&O)?c%2xcQlE&ZIc)lnV7_ehESm$5d&SkT0+XF zL+glPP{YaQOv4&Kb9$&w?DlK`rm5&Z#H1c#U^QVyQwQk>Cij?$1?!;&Wu1r?-HD*F z5VroS*u{a^P_Nu_21ifB)a5OmvXx+^cy>hj8rtKr=FDPmmgp||E3rBkW0gloiyOG{ zU5&Lt%L8Oz$V;YQfT-A`3f&APHn6IErQ)AQ+n)cpLH?3ua`rMhAw2j%7^>K%txPL6 zR)#`SUSVx%1CR1#ksrZN+4?2q!+x}~$B|@4;v!u9Rbw-j#pp2r*k%_`RuIOOlZqQ5 ztrEPJvX9lf2N!4O4#u&EMkrQiD34)v@z^A+v6;ZZr)U?%zR&F@6lO6y17;UlK3`gM|IScUd$cIXkGTm=Q)G~gB8lzi9v@O!QW z8!)CBPQK=J6T?Aru>NtuH`m$UrtCHZK5X%l@mg^bPJ+FjP?dzB{N74ovu%g&_)W>Gd?xeDMsjV4s%5ZSeaX9LqN z1O0mHTbKwtB{0b|E*2fe{PiUQvxUH1rRHx@sUf3qIdJR-fEmxSm6TorM-ZZ(fsqNz z0KejTl-RD~(0Lri$Jtp$hY`@K!gxoM^$S$u8HvH0M>YqO#wLlJa@XBhly#vG?_ziB zzVA2gV_tKt7ZU|#_r2I1M2mHG^ur4#J(euJZ)`e(1NMf0u|e7Jk1bA6DD!K=lK=rX zU3Xg+#rDm0ATn|6B8ZCE^M0Ug$c4qZ+J$@VCa52S{IV*T2*d#PbwWqt9+)E9fB$|S zchKH8%}7wg_ndP_7|ufbFKI*s?Zr6AxY;@n+O_M1iQQ$5qQN94;=oyY!ekd0fi4pm z)MZU0j@={Bhj27b>>fK3I&T`-zd91JhhQr+ionu2YOQY;+xS$DZL@a2)?>!Xc z1blZi#$wVqG#1i&;2_627=+<$u;!&Raf|LtzeLwDzh4 znnoI{dVb_>UUoj@EFzub$jO`eePUDY=azYK**A{_Ud;>zkF3Hzm7DM0B4bHmJ4b}v zTQd2s5XBv$*JQqc?dIcFea;0p-*I#<2|6GB`ShmU(QAtiI-Mgz?jf9wPFWTydaW1- zH{Hs49=(=p#VxtzT5&7;b>BbZSobqP6g=Z1M3FariLE%-NPOlRiP#9YfK0tWQ{ih3 z!O7Nz40&$vs93u@>%|(RVJG<3go-T=wyNk=HsxRFO-W+7%hb8ujbn4}6Tiwl>F30_ zK`PEB#<4}N%Hw!S)XKC3kxh)V4E)0Tcb1#P#WEhOk$@W#vg}UboND1JBkeC{;Eb?! zrUNJPTb>-tLuQD-l)7c;N%SB!2&Cbf++mV$r9+9Q5YIV__24OncLfefYcEFxe$Sq) z;w&G}6QfmmZXw2|aWl5LO#Yr>K7$wuG1bHK!cDfp6z#|lcP)`&+fwzq zJn(Cj{Ow}P7Nz@UX#0$b0fd|E#G7TAT3h+j9xC)7{I$B=DUeF)koXU*vRY?C2RZ_V z^pxc~hGbPY3s`-&AN!_K8>a3;F2%#5DtCY@ z_#Wb4DU_s}Ba5gnjd0-L8w<{IEO@9PmNxKPvS5W9K{)X#Si8%zOeL#Yc6n{8Jo>vn z4E`FMfP2IQ(P6yP2D8Pd?K?{oovL;(HK5kwA$^Yn@xnJ_%tt zoCYB5AzhB)LSOA;G!jll@%9jt9@o*s;tWbBuJ-ZLQv}8W2;IDj{ev&$g}k?Il2)Oz z%^Ng2QStl8Ma*UeEAnp*j-N^KZ!=j@Vb1A0_uiO%SIA41a>jS875Pq*46880NU`p? zQ(W)85ycTb7r~n(Y_%5;{d?0H+X(r`u;OobZda`-Y*9L&dE3T5Y7fb)B!-T z#650~&eQU1*Dj66X_x*I)?t@o;wpf5+O9j;#YNeRp>k=mkC#yRd)N&mUQ)J!B&mAd zTB_&spoteMUfNv#rs}6#F6S~j@BjPkn3o6n(=tzTZ2HJX%;p8UM}5Rx7%9n98J+hn zPc2Gv*f~4qeyL=v0CfjAJ0?Rc$*P((O2J8zg`nnXy%p%5`=tWCiK*qyy&UxJm*k*# zzjV(YZ(%qKdOzlK&@0M8-eBW-py%iwVcga|cJ}KRBZfWw@Kkf?$TKdM8uF$u&*+So z5`Q1D`B1zxS<58pD*_1PWtJ1O=Jx&uUdI!^KfTOexhM#mOwcM+HwVvLq9-elkW;a_|yd+0IP-Z90;xKH@3wV?6Xc!2SV_Si>3DD zazU6N2tUB`j3>A|bBZ9`F7U3$-7{S1zl^o%$PX;=9798eLtx_d=x9W_8zIJ(d9Kyf%@VR2)u> zm&k-@K2_jmAFJd%)uv4VqlY)CM>W^J_QNJt@x}_Bd6ja7d>&=K7U>7!LhNqb$g>4b ztVdq55w&^2E(?8M%VoIfboB`7GFc!Z@pVEF;cZxpV4?@E{Cc!;W8&CgfSV-4sN%MRknMks@z^udYU z23yPb&zayZe#5NTiQRQe?R@B*BCTVH$e*}%lBr?TfQ<-mj1Mh;uz3bkV=aOSqPSSZ zxjnqsBGV?{6{7Q2zLrO`?Iy{v)bfSLGJ}e(<*UZAW<<0+QgeWr+rC@E*}$x^wR~|7 zdfXzu2r#Rqta8A#vftPiX+Fatqrx*X%~I>TTrGctz{Jw|!T60Nn?7tp5XX8Gcom35 z$YBs2x6kiVltH{DQ~Bx|PLj#h-}52yIg&Xp{YIDQiF(pUHexm}GSIWBlVn&Jz3`9c+Z$_<7lOplpBEd5*A`yAhmuU2Iy!3$MrSX=e^3(@`#Aqpz_)Ye~ zyS@Q79qwr1$z!4em)0j1`_=hR& z8jh-Oa3Qu$fJ&vtEXZ~fW(w)`@(8NONd&`=$oSgLpBe;}@1JjROTU>Rb+j|Ps=$FtuB4F=K}qFwdXUEK91Pf>74^>kt!`09Wa;cT$VL_}%NizOa*b95fCqU@@eBMe%_2WT@K$gfwUnKx(H_dv3Rh{UP* zGSsCtPdra zL~LF#xn!aJ`?OW#Pvaa|iw2l1OY+MPsqqj>G-&c&fu2nLaP3KPOu9)jta>yvzqGPA zil+i)8HEoQm2jl5*&E8?FB-@-+tJ+S-bgZszmnYM-o@Ft;O5?~xydC`V79Wf%Rv8X z-WN@MN@Yo&ak1#cv2}SM93%)iY!M$cF#BBfL&@;$nAljC0eyuYRZzC4vs?%LO&M`w z#UHu5V!2O=qzWsEriT$u##&`0w*E@XeoPt6k<~+kinO-#x^d;cX-)0m2ZoR!qCoG; zK*D2>aa51Fyz!9*3HG|mQL7ZHi) zEl~xRrc@`0=i92P%Gz->Pu%I%JKrwa`H6O$%zvT!!v5MDe5?K??y<>5Oe%-0JJ%NH z=f*piA7@4j#oaC9{`~CbOW0DjxVs#2=eFBkiz1vQ?zrsWB;qc{%k+ON?k>p~#SI;M zYFm%&;-a|4DSLV9Ym(wdkFPa8xv!CAy?6C72V>(r-y&wpe4wheiKD!3!TIX>BNJ4Q z37!*9`1ap|UzwBRrk(W!3{)uiMG}N6nr1Mn^Qv@CZ;nUwf(JvmL~+3KWqGt zV?R2<0Xm+Z%K7cLZV8&QH}(KC{CWPXQbFETI222MlG`A{w@^BKx~SMoubPo72QU>6r< zF5@4UC-WJ~yob&EjL9TjNway+Q-bHK;zt(Id~2=&-O3D;lKpl5C22Uj(Y_Z7`ACGk zeDrtDadangdkU{5a(fEnDJSGVhb(M%j1xsTsQ>dH3)$*tQpn;-J!PMS?BarutzFYE zPspiqD!%^1l^wS-C|tU&!^?XM`!?GLBW}*-(+F=d|9r>Umj<$$S(RF?`qSeEV;WJ~6b^ z$rYoIJBQ~-9v2#NWi2AbB|XQ=-p$Hx4Ga}l_6tk;uE~59N;+?g*JG8PZ8s|R%2HuB zt?aG{`FZT^ESh7>)me7O5pr&e*ENQ-g!~&DKUo^RtQZHT3*d`3+j9ic9cGf%dE*T8 zpoCpSqmUo{UkW*I^zeMudER993x$mKV}o!1-8tj3jM4SUrDa%Wow6tSvCdi9yofv9 z)cOGBVs*~S<{WY7wsT!$I9uFU@MBqNWyN@D|BuCup>vR|Ev|Sp`4mz~bE-daXlldqVH|B4gpuM?s&g5LD99D{G1*TfrmPk6B%r48mIii&} z9Z7HPS+mU67|xRPuSG}F#n`C&?<76XioMC4ilpbxB5AOTi;|X+YISMuww$C}`}a_4t+e}ldQE$PX3SyNR_#LPuCdElKJjq79uvu!n-02nQ|fi{=0qf;tRx8FO#6mv-Zr)Qw^VyU0js848Z?i z$-LLC0q0ZeaFpRHEaJfvEw{;;8H|_CbS{mK|I3qFIWCf}zWHz)vpcK?ymHJ@=DEG+ z))>yJ-EZM#w`}yvVr=9!Sr@I{BIz;aR3!c8EXo}0;-aJn813>Ty~x_#&f2|bGReZ) zePKyIv4|GbZfwoA!KD7(B^yS+8=daX`7!Lp^=MH#DuosMiHJLUcVrHBm@V$CBktTL zZEHOC$P)L?TSwf*c*z?SxTv@nS+TQ{F;?uQvxpn);-a`^Zq)ykxbtSLp08r>naoFF z#ZF+)K)%I#)?;oKn&yu?=NCJdmWLiqkIgU6Qu1R35p46=>MAGsV52;%kceu&ig*xHC)D}&$F5w8@t zpHAIsl{dKk0pscq2r$}_`lI6qQTNf&p_)MUyGbK4WjUmAJ($|mwV&ifdzqYT`hbR3X zp2T+--pzuK*o*i(_x!s%%CZp|LQ?nfr( z_ut?tG*vPFwW7yB7&?4FUhk<#9dzzp8`CL$w)B?&ymmx(wPzhfM5 z%Yd*EUwz`^I{)ZsGI)K;gF0jL7k&P>kGw=crRFUv5hBHxLyhft3fze%XKGS>Hy+>p z__CYtVv)+kFvG=uM4vxh_zz~Gvg1$%7g3AT>j$TrS>oQ5c?LHH6CEWJ~rZy$LbGR zR?%#Png&nt)yVwVpvIFof>JwRX~gCttSS6@5F09A#xzA0ds5mvG-u)|+8lZF``#L! z0y;ij@rRuHSK{%sis4CF~*TE>YROsI>kZ&@;&+Frzbi<&)3E>3CDxyzD$ez9x`*q z_chwsK(tE#9uY0q#y-AsG+nHXwLcMg$9%D$6`xyf76r)smkxh5g9(Rh?`CbRBeH=3 z?XB^qFV64BfAMc^EOkfQd~Lqya*fWpZ8dR`-Y2qZW62WPFt?!JM3~RL_3dfJDJm5G;^-oH}!^l7!_?CqV88pFHo(&}S?0_hYp*ivi<{|HsrR zi7;>6!KXMbY!Q56Kni@4HO89f)M)uC$={cYk7a&Q$N!M_$Xd?&FKPd#{h!t6-&(KO zdn@^~@PEH5^kt{T$ltZ8F@N?rK{KTG?guS_c3R@m_A-}1N;E#~{bPpUqRv2H_rqTN ze_;saHN^-2Lkr{ok)ftcIuv#6eLL8`zw-ZJs2(x$A<%2Vz&j(i@M&);yyp9W#{CEVU zZ3HHY{5=AE8`I=abi+BCW&5ySaIW4VLT51??UMW?%AeYofxNo4m5R>;xraq)_cp=N zuqbC*uYt5$yHK3l0W#;Ni;2YpN58E;NKw^&{IF|hvOaGIlq>K-m= zYC|OHp99-gieG!-^IQGtO*C2f!D4&3bD31=kyj`!d^6q{&TiI}$AOgIs#Yz5_CUr1 znM;V!$}d_ZZ&~uL1t3We-G>b;C6`EZzC zb!Rcx`TGJ{&S+0bS|lmZukZ#yKe5z!cppeR6}h#O5g>PKx-?*9fTUN}o;J1$VAR=# zrF(~GFD>GrciA?#W8Z+ZZ`FOrF5hVGCPzPOYau&?QU5|FT-t@h@v;l^J+#gDWTAW= z0O^k9V?c5!@G*Uvrfm1~Tt;pHl5`O&pU@&DMhzTUjR-9_lY6z(PK+;510^_lqP=Hq zNJemEqNN?cpA)mKsZk)GY9BQ9F~W?w@!?m?Hx>RuyJcFWY}#i=z=_`}a=;nx=IU;~ z>Td5Qe+Z`y)E-`q>R(w^Ty?hmpr?S$NG3dgU13**9&V|N`olg>eFczQ?&U(NluZGe zqUZXQR{9sKyM@K}-Q0T)jywqE;9VvDCW?bx1rat_R8vGzQJ=h_z3xAvdA6Qbnn~)H z15(5GnalYBbuAl+h6m^*-EG;)#sHAFAVRD9B#?3)I4|x{X3C5@#-H2@I|lkFYfhKy z?)a%|fJ7%c1SJkRb%r>mjHvcCpIvwG2-eWs4 zHs?fpohV50Pn5Nj1Ku{()t&rw;oQ;BF2w5?C9WpyL4zbcW1nxoO983#$mBTR#ZcNr zIh7vd=$r_hekoIy5z}2aTR@)IB2@ayER!#Qc9_%hCFYJQd@dn!r&0}&50y&_tpQ0o zYZKQaYvq$xAo;?cn|dw*DNFs6?Vn%r7d{U`W_AVEm;L;JfNu|6ozh$&@T$Xt_?>BV={N>Zo`b@oJTTz(ii zrp6d@=H4-~clcO3r||v{`Qtuh<{y7o;+4mVp znW^p(#raW*@j0HM-!ZBQF>vB%MCcYy(`5jBB^*xdiyTK6to3hsACRv$U5alqCf$-~ z>76;?Xb`()o%4M0{n&WCyP{vit`KoxK^p!I_79sZdI@>rrJ+(MqE@8p?rpxvZPVv=^q5>IS;MsKxC zzPbXCYcV>UYV%d%ujl%f*L8m`_+ep*nWvryMsmHh*T{2UMvfjJ&#csvKwR}WYz(0i z&Jnp!0}};JEHeHRtAMMSJ&n_4TykGB#C@OJIO-b# zYfTX#eHOZCF(CJ0&~KgFh4XvfA|M7dW%9k5O(>b zO_`QNmlh5Ic?U#Gt3j^3yY_K<4FKnFP(2wxqU;))nma(Uj@rZ~NYc^Q?cOr}){SZzrc22mC>o|BIoa>2R#Q>P4}w$#TcDIjuyf0`8|+k;DpsuK&C2k_qG9~eq>&< zcKThcLjaQd0C~9-0a7NB)6?v^{PSXRvqYZtC}W8H>2EUn+cjD#8PS8j-C0LJ#6cHp zm{~`!Mu4;>`}8>*1@il`9=?~!S?}IDXJi|n@!XYDRW4}&0y4kzWS^icM8@eO&1IKD;~X_C zJm=Ifv&NF2QyY*;U&xRNpv`>oy{mue55R#1nd^}pF#eRLz{u1+I{!Te?ExSl&fceSl-~CQq%ryZv=nsF4>vaQZx(GJh zHv&nMfd#|qMg7J7jz9Ci9sW?mDnGK9L#J@DgU4J^^1|L5y!^FqCwe%U4Eeel#Y8T2 zc>9}IK&olShuWDl#t|c88pvJvTLavHx)&kSj_pE{w2vIy`b$@_h7D`k3ptB5_NHuHM`ygknc+pPY*)+r!gV!Eg9Bf4DxhSM4RH4tU(;zOl>>Ep_keFN(& z7jX>w+HA8F;d9#I=X_HlB26Hdu*c#hWbPBP!N^wEt*zA-Rt9&nx^gB{KULXHg3p)9 zq/eval.bin.14 b//eval.bin.14 new file mode 100644 index 0000000000000000000000000000000000000000..8bf7d1475fe682b35dea4901b5ee2b5f003d488c GIT binary patch literal 76620 zcmc$Hhg%yv^R>M04U9?XMSw3MRFeXPw54}2otP8?DWpPrBk-?(=gh8mZLWDA%H{j* z^RTS7T4|&?Ga8MWs{X0euP?6`8e+em9M40`cX2EswtV`+uw_e|+be zDPev|AX2_>{q#kvLVfZg5Z~{7Ay3|T$%g$DiA_k5Qjyew_2l`rkB7+pUi)Wc^_BHx z>^A>y390Hyo5;w=TKh$8b+6NUjK5#(+rXnwMX#lYdKh>kUb0ldFs0-Bt@0FODTlVA z+tZ5@MaM%^Q4=u?7598yd5fo8s-$A>BcG6+8c?d%+dXU1`boDoO{q|o@|bv~8Y<>{ z2Kk_xo>yl^)qqAiZ^D1-O@@{BwPpBUsjjxJTif#1+qjz8G8yK+?fkUe*ytu&zjENU z5^ZjNcQC4|v{E5{;UyVShn6?bjaQ$Ts3*=ZOh$1NZN7K6bJR_=ocS__>fA`~H8`|< zG8yK6Mp{Z#73vIGPUBUZQf`)vtHw4mL-V72GS#k9do1M+lK&*%WNszLf2x5rs72WR z4CBdLiAORJFQL@Tjmp1mBtzmABO~HcU%%g4lVVD$IXLt(s|G-of4?JRl0u96_Epe48-wO9dxCd^ubwAom1Fq-h}AG%4QYc07Q?%edGAeuu?;9K~lDr zy3U^^+L#2WeYi1!?pmX^eebam;!oVVTXVNQ6C%Vfk_K+7f872V?NE5~E-gUBL0?iC zy0Naa4`KEVDR=haR(f^fZA(qv+vEXS6g#)8bLPsZiC;0v7Z2)cGBuSH4HA54qk8?cHdPo6#*6C3TN(z7%7m^R{nf2iXf;|vA8E-jy-_|X9e_4N zft0$Lxps8edB~&_XlS$#Kby2tjT?F+*8q{yZWv6DYHq&!DveFvZIExJ6~ccc5Ft>V zMyX1FgLMJ=);ubve9})Q)O^rCUPhRX=>A9atZgzBy+0cf*>M-KrvtT#VRGm-pmRTB-)JNl=FK?+fKPObU z+@Oa0?zSYhGQt;pTE;EDi71{LNzd&xi1lTpLuRVaOiOMazo=5n<|5wkg~!vo4RcFO zoPL^C8f3(%Xk&cqM+iE+2=luscelLkUm|^fl@Icwhmm~0Mm*uXiQN7!8K^MPu{Dz$ zyBX=vh+6M%LyB_iGw}(udWg-Z$KTJNcv8Q#VL$y5@mt#3phzM;B=xRJk`k6#4Jp1r zz2VPl#wb0pzjYtlTu`4+OovURc}z^vv17Fr5!0beX7*8`n4$_%)OQc-7Iz#m9h%|i z)XKw-m?EAnrhSf>4x5Zus3Qj55?xSCJt2ze5VN3G{vi2!;50c!@3;));-Z+|yHqjt zgdnDe-_SaHLhyVjRX4CS2qQ;%LSm>BD!A~%vfJ?@ocwydZpW>rb1}YR)nvK_bzj}? zCVFBw*I@S{B7F!Z@UAlc> z`^LfUTL-&{XJhxigWY0el;u^)1+Z%|FNa;L4(j*3->1)lUC@k+*u5fEcWKxyC3Zie z#rBk{lrns-Cx)%5$LY=bMXAyP@MP(Axit#3XML#H``gM>o@K`=p*+cyYm#Jx2qXB# z8gZUHapL|-4)>lC>nFpiSZHSXw5D$RNtn{2w(GwPCrDpi86^s2cpB5&uuJL|gA1lm zRa5tQI^X$IXh-mi=DtY{QvenT62KF~>if)$^75%k%!+m+qda;TVaI-wpiRcB+sCJ9 zQ;-|}d#;&)>QYT$>ATR^CN2iNFkZ?F_l7VJC{~^)ZdkFWoR1>Dgveg@af~m;;++_l zbAiN{+$fU=f0~9^f4AM_-M8|jkX!6nSh1fcCQvMLv9RLw{r(y!eIv(`SE#U0#Zoyj z>{tSBywfICjK0vpA9bLr5}pjOE|>9g@AclFX$;7C7E7!k%hX5=?@8Zd<@0!K&mC26KRkKt&Bj-?0hOB#W|Zow zfYN7MVKo!diBs%zO4khyi{V2#eDC|W@a>?=D1TEkwE4s^e)i)gdi<4!;VVzCI~%P$ zJZ~gX>U=9@`IdygY6?%iVOQVtMrjyZq{Yt!Je3->^qNYwFy1~Jst=_l4ec$;Kt%{a zx)n4p!igGaZ+&+3JCRmN%_2OLx7HVlwYT|S1d#HLRzzW<+stE&Zh~g{iFA=N3uxCt zl`=ludRn$a`o0_R(+c&x#h(t=YS(Gwx3n-t+ z`cS)i6hD!#@YlF`b5zBjgCL{ggNdf{M($@A6c7ifA-s)eGzz2M{@MZX?mm-PfJZUy{Buh3fTbmUl_q80JrL8035pISWO+DI|j^ zwu)+WN`)n0@uW~|@k~LjdFb&ss&PY=AoE~TGe9Fx2(!xeLf$e>rJ1jgE0liRKU^&# zeGP^-4doIJM!`I?0cz6my(GNr_}L9J9r7qwgb)@fEp_BWeoE!I1i7?m7FsU1A_NE5UOnpZlfM3h z_9TcGW0;ngJdIeDP1Ul6Fwd=VWsKqGDc7hq-~d(P`k>%iS3dC`X;vron5W&hp;Wtp z`a^XZ?M%KyXn8?mascrhFnI$2vmq~hdyP~)$;vCQH%Z^9N`(!dM%{x?D9mlpa$jmv zNMp*Kybbav`5VtT+~*6t@`V#g(UT~GZ(E8$4U(mn3h>)`3h{S5`9Is$gaQ_Gg%Nr_ zioI|3pz-G*>C2cZlvMSft7cY26>Ok}467pW^o|XTKNh+i&t0x&Hq>MFrGEHbDA(BszP$kB+T3qyM7>IOFmYd?%#hXE5(o%qsjKRWxM$K~ev@MLtA^u0A&HQwd~_C1sOfIQG@aO}A5 z@i3+-ps}*3cTwzov7gj0q-SGH$!8?|6^SGmJV{BVz9e}Myw0W44}ORiT@e3s65;CB zq>3*P7UF;QPrYpDeMI`cCsN=ql8P_n{M1%F8T|^%i`=+4px2^-U!K%muHK`r-JhRID9p?k_3HTZ$gJv zLdc+V*)EnZ!Q3`1(||sdKpVd`mMCnRZ(SXcNXHCmKHmzF6tF|rCk?MNeqva$I#;LO znrsA0FdOPQI!aHf;4D&;%J!CKBR%$unzlcU4@h5W681}?cM?;cK%}=q+Fz0@_6umq z6t`dO8AnLjlTe8Ssh3vVlP8x3!*als-gZ{hQd2W@kXt}e@PxdF{9p}vYM)kn-ZzoH znuHoM*zfk%v$ay9i=`s&H!E+gXbXH1@jIZ&NE6cyCH<;TgO?yeNylB8CbYM1es*-Q z*bK31Zw3RTyrS@2n~NNL&f2)9r!x>Rq@tQ&AB3ch67HuChufz~-!+(*7$G;25o;|Y z1!Osb{30ln0yOcAe8zaqOc~RVev;Dw9Hb{{*(&@Z;C{h&P;IbY`tgE7?7gXxN1g#B zgj@J)P?66x772Op+w|wFM|-62cG5R#viL?7Up&kPQ1`S;Ui0T5iz@mrST`_PPWb@K z5cZ01Z;6eRNWuQ&Pt&zf+|Q^YEtEK)t>ejG{v2p$Yvp|_`Y&fKd56VX+J5<}Ax!#) z6MD*!NrAP^ zTgX!R0N_Rb)WZo_;iI^bsvk^rGgs7jrl}dTEN+a3ynF52%KPXx^khaW;*Xb(P(F~6 zhawql4K&dJ7yvh~T^GzH_QVvng z)KVN$^X_J0AN=iZMiH2(>WP4izVQtKh};6#bp++*uocV-ykM4st4{;X&xRh7zPE;k zf$dZ_T}{TGbk3ZxkIe0zSbcnYG&HiJ)cnxgm>OC|qRI!y^Vr79(hxs0a<}+yPU3x! z9N7xDZ2h#j^&=M#_6zC5&-fE+eoH?OfBsS3qpCCBp9wvbq~p!^XbUALVtu1zitzkT zziFi>O^5F_s>!?E*>?oH2~W@E$?#!{48Ne}^2M`(1l)YN7J~MR&o9jw!>qwm3DZ<7 zH_QR0KHdBndG7Y|&*f67EH^=Np&O&>{fWbNE328=u>!wEWx4n*HU{fvTXPQQ%H#|a zh2NsGJmZ}qM5&OOLW0uJD=nsRse_XUc5Pj%Yx+MqRT=C|@#hzOX&f5Hb(5@}z1IKdk6RJvV=Y~=$633fI2Z8v?xbzQ!$Zy>A?fM_P93Vh<+WLn|2@ zP@BWhC7K;Ed2$r!kLDDL)zl1qDB7ZL`X@%t_MSbX0WKUup`n6g^Z|WPK;Zer(Gn=T z(6s%^yC#z_@P<}lcK#$o{~@FbuvSEk+|8+x8MrmmmU|VUuj)> zO{;h86WjJXEsBSXoFs-Gx3RJ2rF9#==xJ-CM+vhW+aYHj-G-;dHjS=7d?<&D7!0e? z(|AHEmSN-3lfa~v0<31B6RFTh@Z4@%>)|9AU!#H7DGB3e3t89#e;>p4`P-91Zo4V; zKe~~!XR#eWd)Dm6HGnVBqvyPqNwrm;-;Za4=ud+_^tQ8ZpS>T19_GeAVn7j4iN>x}B0f{!r6y^VQ=H>7w^F!CJgpH1 z(?zAS3Y22@llKEg1$~1wD?D-|KkiB@dYCmdisV75?;0reUF+;aSQv?**6`%^il!$g zRimoj^7X@TNMclyQOLXpw&~)#t$jyuY{3!rShqt+NPUHHmC4^`^0!fm@h7m%l~z=$J;`23B^ClB3R35!~@_W*n zA3yb4oHu^2UWBxH%@WR2%^<0qm(M7iX=wu}=L;qS3u#G9qv_5dakG>JifFS1(PqQb zFKbULTi?u<%VUt;wCceTbVoQ=<8$8NW@aIF_j+Lmh4h^%4tLkLZ1@fB4A2M>U z`Gu9PsrfGSEV^c=mRAaGq#a>*^LW#be{y4YmD>)xcN}&jp2hCnC03o-FU82Hx){4P z#vz4rW572|P;bjG*uXnj9;VePr><3kTwLUI?d5WMgq$A4*s*V zijv{WtC9<78jE?hrm^dwarqw3*LY`R{gOBF24E>78f$)W zAWza6V9G)1u;%<%zGazI{bKlK+cz2~8AHMAO#7a0L*KMXKZBbG!n{97=^iQFW0Y0g zFhoZewU{KyL@1GhU1E7AUec%KsT-L1`30m|w!lpPG)UvOo2F?$ZP2WEBxb-qnId1{ zzwfb5Wt4hc|DbG!^gV_bN%=_MRoBuSls31lCO@i2rLI8`#;ksL$9BBTu~UNEVV0c8>aUSW{)r>aIOC4UJ2bwzTG57 zwRE4hxL|wF^Xwd&NBD^w(-YSplX^=ZvLXJzg!1fTWfMka#P#={BkpuU8yZo(xxo_u zXYo@b4WG<@mvV$VxXe;6Z9p2uVJ~5&YJIbr^nJs$fTR{M&`lK(GDty4%FC%{V$g5r zO78nDwLx1{d`1WKi?Sm8F^TNFC0_h=Ao@diif8x**9Q4LIzn2IG96L=&jtz1rH6`r zfENP|SL17{de?6l=)+>z4qsS#&_5|II5z>^%rNv}Z%ameLH8I~=EDp2PBcy8?W_-} zxK9|LW*DMWY8Bs=FaAw#JVWx7rZ$uA>yKyOK3{ZVQGL{8q6G>$`Srx^>*DIdN}(65 zJ}PQ>bFlsaX5(6FxIQw&L}BpNM{{bJ@jy7dU>ln`HC#0FPZv|e+O+`urBL`;2<3-(Wl0LW4|6bZna&bWeZ-0@->#{VkpEE9hbH=5=6iXbW`wFE+U=j>(a$tpL zI|321gq@z*4&dqveY9@?6>*LG+YAL2o^#6juk*>%XZvIQ9L4cW478qOfw{i>@L+6^}jGH?=MbcWBx%3f5 zjx2w65-kKh$NttHDAgAn!Vc!fFnn)Wj&D}6p5j}p|7KI~>y$5me!C9jTSjjCQ+8Wx z(#J)o=w72rM1(r|B-JEOZ{#N(_HS*iH)-`g@3MP%j{`v}k@8qNcDzqR{omeJ{_#rm zaNqW~;^)#9s`K_Mu*MuGF)@3S^4kDuwp_FBviLA7o>Vg;&^x#SC) z{0~^lcN~_m^lp~xVzd`Gxvb8&_|gn~)_wPSm=h=bh(81t({CZF`B?zbdx#;{LAEIc zOx`z?|E5$9GoO(rnr)f?A^X$Gq{mWtSk9_^GQ??(Zr02hw*fq)$Im9^v;HjRKD#xInY%4cc~}eG10}`bQu4FiE8Ey4ga7- zMvDF=Jk1(L9cl_+SioEnVUib&vck4U^36&V@vAhqB8-y;JThSeKdhgI{NxMc{+G{t zuSwq{yt5{Dcx0LZqsUW$PX@!n&Xb72PI?>cBc%MHGxedhv2(61xhHUU4<>|)yx6~cd_i2c4T{Tks^zrjHiDHSyAzv$?Q+ZHctjca#l*4k)NH)g6MHinkYxa+OaUa}8Y0 zLbl%anV=6(0i%bkt$#UI+JhM`n0pjJIq;wLhicr!gQtfQRloRUmljk25vJ^TTcg3F zBe&MFP*Pr|9O6@0)E95o(4a;t7M=l6%q*mQP$UiK<`GV3efXBCl=7(*_Di75&4cwv zqUeJMee#8*{Q1-Uo&nN#1@KO&O5|pxSFwdWz@q>qAW#W<0$1fTK2^xmGnClq0cS-n z-+Q)I5+-&o`TDv3dirDnwXRYS!xcpkr4VS4`KL_2&NPvS^syynd|Snlu0Z3@cLNa& z{QnFznkfXhNnzedAjQubYz+r}WfhA)Mn{f_5|N`oQ_>eI5$li|DbVU(!;3&$dJ8}KcAjG~AHZZ~Y)or3 zkZgZ7hf=iBhMNyJ6dpu2s8G7eKnG?KFECMS?piD9qarZTh#*Y9kb&WT169XL^zj8P z-@tvhlaviWh;=grJKZd4hg3TK3QtmNdX!0_l9cS-!Ef)0oh@(ENR+e$mfZAA(pQuI z@p~jo^{|L2CGQRogS(_}m}Wf6fdY2>=r10I8quS?g%HL%=wfYfE~ix+uaDIRQ@5)m z1gbQ63gHA3^*El6|3v1oMHbpk9{I2^$j#cwfMxb3<^nVV0}CEy8orH;MwCfZyA@>; zQF>r9Jr?|lsuwMfTVN^IpAK+^uR;rl%w%5!&fYmigauUL!hQ9D} z)(63hB>#yi)UH2xg-TI@O`%|PfAf$=R=^T*O`3b!C%}CURRDTm?KogROJ{s62fVmk_;JJVwuto2ax1KDC%mMgs0Yrlq{w$mhqlPx7 zQK8d8PwhR@_ZrkgeKGVX=0~xk*xRfECNuxu`QS)KlEBNS zM@N6%j4W~;6bo3DGLgJNa-V`o-sFkxZ{UwMP@;B=Sn)G24$$)H(SsMiVnw35mol6+y}Aumh$tgE8Cn)`zUBM_v7u*Z{b zM@$eIyt)~{Q}4J^*Z8v}jVIby!Ai{+O&Xl;YcrL>CoioG-?1v*AR_urMA3+%G%XZ8 ziJQr=Y{G<5guY5dq;>=`R5bqTJ4aFCABFmbox?C^R|c<&DNg8G&H;-@hxkdVVx+28 zsL~-*c_a__iEqn|#85&C(S=%N%nc8hhvVfDMRtTwC*Q<7Hgbk3I!bosF znr;f3uHDg-e;qX4aL{zqK@;LxXj;eC5n2W}>WgKbw>#xU(R7Dsy20`Zn##|DCXkDZ zXp%WB>ax6Q!9k*FgbH~uq0#FAe?3v6#3%3(7YKfy3Rh-2WoQ>%KvS^qL|ln2#lBFM z{+DJbG8Hm3?zI2B?Cf!!e_*Bj^I))x^o#@Z*wRv-x|3+n?-(jLCEgU*)g&|L-69C}n)*~HAO@yJdag2;A`Emd&(WX? zE&yLx^aF+5y(#8CGB1;MTDN7;&Tz7f{KRzV&oBT~a7l;IMsd|O21_PC-%(yuR6TAi zAa7O&(0Yq6Ru|h)aK11er`VvSw8C_lYce4$xQLIe&#r zj@+5V((Dpn`G@fOXhI&{VxG13mqVFl}6DGq7X&I0P(w!ONX34nf z-_4Z^lE}2-Yrs zeQyn*EJNL=8!Z6MxL9lbQfrr{*SG=M&uYr$i>lzLS7DV}C{?@h#ompMVmcr{K~C@` zpR83b?EddHc-J1$0tKbS?!MtkBqRzWb8HqbaPzpk+uayeK`v|vzN5Rt!<&-rt0Wb$ z39?#|>z0Zvq$1b58ZmPv_(7yXw%bFj;D;}RM{O@%mYq*3vL>@EMB+bgq9;m)kGuZG zc;ol#bxFyYHkPf2+YA@^n{uRL(_~m7E!ZM3Lzw$A%H)WrnE22!(>HKL8qE+Q~#0K3PckQME6XF6+#r% zgccT7IPk|Go2I-qGG49h~ktI7K`gr?NSd;ItSS zdA+vt7^EP4h~!$#%i+|jgZiNlZ|$l(o%ROJxQJ7ki>NM5d+!scaaHv*xQ}_PswIch zP%rdzkgIxvUz=dvc)9LLEtt4z?yjQ^-1rs+9N@Nr?bj^>9ApQ-*Jr;qFCM1_d#)6~*3FV} z)r5oF0@yZq1-1_!ES7xB!M4H3!M4GhgDvA(uw8X_z${9}&%7$RfO@q!Xv5a716^J< zAibhfP7)){xL9?6r0OmWw%-ZcAiL(@t9;nEo3Pcj*_n2kNUw<9Pl8WM)-Ch%8R2=N&dX3;Gy4D2apL7VO2EwA>1nqUL-)lAA1&`Jv zH(iA^O?Pl5y4S?7~Q)YHq0%jK}I0o=)U2-cpgncuQpteB*Z)}(ynzGcxsZ=v*#>HBbUW~dlj2{8xKMrX^93|7L%rPM>)%?S?8K|GH zY#5kyLD*Ult+|!`SOq#m-i^#Z-}OZy+HSJYg|Jw46Fm{42FZxnv|vY;!}gX1tFliA zQMzQU%3g6G+F>%Rkd~EWy4cNw6Qj82N^vx~Zx(H4!=H+l|)j?C@^+(wq@RYikWy3|BV&hB=tLlN5m;Pf|K zi6L(?g>Glgga~_}hC>`$wKsMW-C5I+t)-n53cOl<+WgL~uyYv+Ee}kjbqowcZlWgx zlVn6}T9kU%-a)sfKJ85MmIusMYS(mt`OsuoAu!G3z;v=?TxD6dW1|m`0TWmSFsC;f z8=x31&qT`u2bd2XU?QFk%m*Yx6lgIr?&Vd<1&joXc{yNObHCe z5OKaVWyzg*e_%HAMkrhr@RZ~X*W6hU)R;l>3jmm6e1;4`XMJB=JKepZSl4iQ`GwK> z%4G6|h^Wrv$4Th)lZ?1c3r1W1ly->acFF}fEw7lZ)N_^8Gtv3lWLP0BRW3Tk+N2D+HnM7zo`g8CMa5$C~Xw z0>Wg)#uLYN+Va~0;U5Qth-ZT^>VU8q1)jXxxBv)+jWWZJ@@5rZSFM_7ahcb zcJs;lpuF{B2@mGhwqYv|Xx50US*6cponb^E@iWD+YN;#vS=;$BOiL953O?L)U=lZt zPF3pe&JK>e$%Lws0ZcsU)hhUl6yR(-j!0lKz^~(i(^@kq+PijVW-l3Zxq2?aNtKwS zssOCf{6#7!3J%GL+O$A$YCEF#@d^CmSfc+vmoZhsYzcwQ{hZ*WN{@YpsVdR^V@9u= zr6e%nSiJ=*JXI>vGyUkv-f&KZr%H0tlPb+g593+VGXlr2rNWDn@!qZH3mF(vVYUjl z>p(ZQHO(>eQ>t*%jEhybCslW8(o;+6*(N$`t9+CD#S9FtG|TUj)wXW!q2H!L4RdRI z3wa|0=R;?+iL{QP^GO~nPDUrlh}yIOoiz;_XJ?$cOO}H4;$js)mMVs>OSPB`E0mPS z|3ar#e8$8z;W!Hl(b*#CoO``>Fz%qU*+FNEgHFV=(U~L}?2;8FVOeOP!wsSZjj}Or>cv;K48rpRz} z$)nzBOr)2v%?SMCX++^H*3fWG=4p50W(tY&=LkF$Xc5~GMaq#yKI-+4dsnbC%6`ZU zA)`d^uE`og!QIa+BFPzRX692)3q52~?YOyBf~{3T*c2JbGq>>td)-|qquY>EnujFG z7g9r3q7fv3HCUn7H#vPiiC;qLN@W{oKLII?)s^oDcphYE25BVZt+lFFr{K9m+l^(- zSljIB0WIcYd+^9)wJ(xVthYj+2i?3Tv6oF^o-k3&Gd~qwwdDkq$ z6owH(cb);a(_1T~Z#@yfK4enun{X;BQZHP1B3#IZ zz=d=hUNFj-OMx{JoNoa>E?eNYPP}$nC>qP=JoWGIH+A%I@x&rm(aFzl{*+Zc!Wjeu zlb~u?)<|fsE$B_}>~hw9XxqSWXNpT9xUDOqgphJyyA~&O=oNo*idN`_@JLVFFNS3X z6G3Qzz=k{sGy(TsSwSISa8bfk-iW~mazgJJuS7sC^zrRSLAHGMEB$-%2kHChRoD|y z#L7yb^F#F_sZzJwklxKvZB^Z8PJrWnhoOB|j=cm!<1GfQ%Q$Kjny}D0j4;j5J4|o3%}?^VZw&Ym;rr!g1V6eXam;?^^ywS zVyyzl4P-W&M5(xOKp$J;aDz1Siz}iwvCa^xeA{D(NnQ1tC}2)MBOX_xYgG2i;pF${eWVWt74-9S z#Iq`KQ#C?W;pa6epamb!ezTNTYuZj;-pXXWvV{7?$&8`jQui_&*Pdj8&)nq#HB)^r z1`rai%uAGOc@Rdbkn*A?COJjFes6bzdyk0#(*TQzy`kF4-v$8S?Py>Gp>8RZ-()9 z8dtCP=WJlc15+?z^5%NZ1}>WUm|LRr^w2bB(=&5r41|YZXJ04GWe)gU(CRsy%D+Z( zal!mu6QAIvnZIG~qV@eQ;XRxPnie`Mq|GCzxfe*dqGojbE+j&QM~lIN+HsdK^OkRU zWJyuj?pzTaJI7S8q8FDaS|%_jI`&o5_#(GV4$rA(w$26O z(l6p7vS2&i?K~=K7Ovl-x(R1AIfBf?lbBXv(YGo)=V~gt-dz>?>L|fyuC6Q02s;Zx zX(2sJX<3>}RMkIMue4@V_0RAIl!rIrHb8kwi`HQg&Gp3AT$xra>L%eElEbfyYOW#=4!5*$+&pv!#lOUf7;eri91}_>dWyXoMAn`&W1o=dRK*)>{V~ z@aY`RZ3%@x0z*|C2g_k-;@2ArRCup2QLY`%PgK&AFv}yv8DRCdlPkDYop%#r`lp_2^Mk(rJjaPIB zD^W%%U~T>|@fiO4q(p5ExHWV>BtB(Y$GD$ArTHWz8YClP(}EcW{{6(6kVwnhLZX)H zBm|zB3@bz;G;W5d!US*V6{XxP8CMNY&5x==5Iz$SR$U$c{mcR3QwN0491tR&1;QJM z2X%WA1@&$fUj&2}-*O z68@IG@n~ett)cUQ@UzKc6*4~VCVJvD7e7TK&Ktj1FBh8DA6nIUDv$s5&+-|oGbYtZ z2z)UaSV&9E1)-%5oh&7R%+kWdF%W(c5KiQb)2(98b+-Vs)%WQ({pcxlyO@{Z>Ww}$s-w47GO^t6Vg>423yr!Wh$KT2Q z=CGQ4d{V53&_Cu|*v#nfW4}I4N^$N;4Ua(Z(XwP@?Cr%aH*669lw|-RN;Thd{UBGo z<85vW=14W7gb!$&ST+*U^M2#9`UADFw!4PCL?Z@1MPHoikbOzjAA!wqf4k=}Z)VcD zM58?@DHp)e|5M-y<17Qz4cMk62~e|yqUKY9PHYbf9LGQ_ zh!^u(1ZEMxyOkxe_PSuXXe7GWY@bDkq16o0lo8)yB%HvRU0f8azRQVXa`FjwzKLMl zML3?xz=lkEQ729hCqHFUy zjb-|l?bu%9K(y9@DB{@=mAOm;pJJImcT04hW?Sb$w47p4!}4(f_RQj0APRDE5u%tg zp)b#Dj9ei^-w>i#5~Y}e>@LyX?ZC0efg|Esa7@d{ zx4^Mj=5ua|E(*sM!m*p>6FADUuTvV3?I0Hy;V2W;FRks4v=ENi1-LEJ;@Lu$z!fj> zw{G|YHtK?IO7)H27|mPqbUscGn@H;zr|;)g_DLNWAIXT>v?%pz+kaEcnNxP9+lQI0 z)Z{%8Y%*oUWLP2U?zvrQYk7&2CF7ziy|TJA&!@r`8}4^V)If0Iq1$2)JNO%M@P~Ld z{%(*A!Cx^l@;Zv=!C#x*mA05?8<2J#G#aZtGHL3xAOy|02tsTmt}jt1rU*jp5>ypQ z!GJUk?rvudqGP~3(hXG=*~?RD*xlr)W^&>85L;*2zQEdqvS#vw=L)z1n)w1z2B)xP zW4;5s{`%lss!wb!fpB#$DEF+(w*~OQg3;4EuzS`8G;m<6Yq>VGXDtVsp7k7P7|#NY z7Q2a{DVllS9LV#4M(4Gm9n52mbwi~!hO;V8-RmW}xPX@oilr|RFCD}SPL8RHbnNR% zLkp*ob)NyRj6)M{>0vsRG&dIA~r4X-P{@dcx3V8RNdwtARQO^aYgt+ z*1j_tR*2mz(oeB{H>d$OOU6}06GO*#;purN0Iu#GZ}2++e(M1EodaORvjHp`L;zfj zg1p&Y=K(Ni9wMa{-)yaC7r&|dcJM66fU#`2SZlI_kGizZ$_=8JTjWP>s1#-)Nw>Lo z7*mHjz=J+$u79aMz8EL~u<=PYxbdh^2nOFIpK{o(yL1KKTGM6{ zNI++>f1O@K@|x#p126lSXwitUr+Cq?@nSLM!@i%SfW>+sl2_Z^%CA*q;$z$OM;JT3 znB*OrOso*?sH$9|CpxUWBqM6mf=PhU@@Hp~yhCOy7(%JEqW`|<$YfX{El|9uHCOW7 zEE!i#EZ|mPZ}c3A?6<=4@nI21DoytwXvf+Z{EeOq*CwUW;JkH;UOyJCMl_+png}*xj#wn_iCBXZC zm>&s4%Pv}BY#v`l`ABf018y>2R(IE5vL&N)7_Evg${AWsP*;9A6phJmz}A7s9A-+K zKl^1WVQDs1WAv!$cS9$D9cko5%N#FN})A8S)#eUDg1 zBJr}Xsce$o)GVX=KnW8-#}W-+{fYD@sBB0{aVypT##@{Osb_Zzud`@fVY3TogZ)O<$t< z_L$8+8+IQk=@F;g~Dvx&TYj^qg@U!<`U0{0tM51kh@+9GLb>Ex!6fR9fQI^6j7 z1BJ;FT_zx{%gtj#%w`OG@uR);Ao=4`J5tg43oekKkvFEs+v7qE@63@%GJS_hHim2# zm51BUS(7&@TO!V#c!$Q2b7%S|lk-l_x4sc~W8^r+!#lKVCzH^=>F*dE0) zA<}~m_nmW9(}-trzhT4Y5}jDzAOIwrkd>6yz#;FL14jTDGL=q`pgi3T?r!r3gFpm2LkgB z1f0Vt(}-t7pu~YdF$y~WI|zIu1jNxM3PAder-cB`WeWmu#_3CJ!MO3yx1g#ThZDba#C$0KY|gwl^36cKw=eXh@WF0sEYQ;7<>{~O0co|^l& zf8@A--PvUH_V*n3Z##!VGM>f#lFFRK7tK6>h4clv{|DT^{ax4y?mvv5f%_yE7q~wi zyj<=dkoz80oroM%B|=r!u${Xlu{F^eD>rZo6+Dn)4&oNHmc(#mPtFv0#21EVi!@uE zWO^ItJmOJ~dKQfS+PndPb3vsqVj}fIsQmio;_t*xmq9WjHZ9mBY3_06ES;`CmQh$S z^;K8_uJ%Puh846{zp(8@hG2ANiaA*_t{Pc5K2xkOD%h>~a=!#q`Yg@W7s+9_&pAnt z@ht4(yd7u|YObObz)=qX{PjRp z??*k{M&9x^rs-|O>c_~W)4}4roA3|m8p%!Oh4*u2171YsG^niMGeb%CvSgCZqWB|j z4a2`tiSy9p6gkh*)&`12SH!VX-((!ykW%w51~c2sP)|wb$u{N#N8<@KX-IAfYf46- z%3kn>QSJyggN%e_N`}n0AXR~a$?MTlcRp}~_vjWn@hW;{>FfHzMfZ8?YXG6g@ti+_ z;UrIffMk@|w7^&J?0Lmm78Un3Fk3;%mLpq@Cc_G4Yb$>cGYtdC$&zughv_=!Vd5$< z4f+~I!0z9_fi;&o0dtOM=yQ%}U_4vEoFf|giji@_BN}o7W-%`(U{)Q}4~<;4_tB*2 znk}Dmpl+Z+H@E=x?x{7uv zucjBxgHeGy}sSJfo!_v4v(+ z4$|srHaQ%O;>(FJJPgJrErX|xTlkI7qIO>r3=eOaudXl^PT0bMADe+cR}NW!!%Fk*@Ux=>iP96mcKv$X8Ia-7Og8Wn<;7=z z^eEzG14vXlFuhtu?k80!k&q`+Fl`Oj;P|HiQxS*SCXWdDL+I^Fbqcxv8-L-g$TW`v ziY^Rofjut%DCa|8d34d~u@9fYT|u<53#%u*H-W*~(}b-*$NLS!v?ypFiTxA8$$} zU%95=`RvJ?CeqB)v7Miu|H6?iy9`wxthXAFC;Ntpts`U0%U$yeD_u)t%d2xk!?R<2 zSJ>j*losdF$E~LZTO2=4wHq^xw}U6=7?(c8Lycn?D<<>rC0;Rt@)jjt&<7QLDYTFj zIw0=DL84FVfh4)O*x1ZmZe#O`jZGz{G)G^##!mfQrd1>V=&P0L_2Kf1GJf1dTE`fF znv*vCBqMIqf=Zlyc=MrEiKm*j&^OL(r4pT!Hu@$^hPe$rK{%kCj)d$T=w`{dYI$ts z*lhnkSb~thk%Rqv=-k>JiE#&Y&Pf}LXQNIgvPegw7zKF_-SeOh0&B^+)K$*Tv5H^+ z<8w>(S)d1+aS?j`|6ia7J^6}uj@ywqL`Nce)#*rZ1SY;L!-ReapYSUzTg($X8#&AY&7{R`l#zx1+r{|NQNm82YZ5&>;HKE zV5vqL#~dTQ-oZ|Rh+1Z%`;BFfj$9*;F=7JIWqKajpMt8+14 zd33b2g&V^ftPNTop!kx!6#5ww6?;^no1w%8R+TSQ{QFq@Qyl35`mUDA$;{}4a4Q+; zdy+<5nO1D<3Mxr?g|y`@Jj#<5WfVVU>z9xZ8zsvgM^YI17V+Y*n_96fMvnu)Ho17R zqVQWe$G8dHDnYQ+eXPkn);K%=d146urkFOA$FTgdY!b3;CU7h&+6A%ibGr$}{vm(4 zn^3I9-AzcMxF%T5vzjKT4i&rh{ON3c-u(7++1~vINI9k`e&)~EI?3N;kc@~;3w*iP zJMPJr@u!?L-wzdp3sN@e96r+TH5pc*w0`CtJ|YV)-7Fbbq5Ya08sU?xprD)jy`r0v z@7f;z$hBbo#th@h+r2&r(BJeLvKnh6STO|!%}LF(A9GtEEY`l#H-Nbd z7aNbd2d4wB0x*2ZpUZSIFhNGdrUk&fw*TTReS>=y%$Bt~;v5!ouhL{#AuTv81nL#? zIt}Qh;W2iyWLyGM469?nM7Mz7B;L*>@8p1auObJ`d(Md=j3>aX_#-=)(zGf{#tXNe z&tqD-z$Ei*VA^${UruA;H=4jxww$CH7pqRXwCb|vHOJZs%w=l+c9j}33YP=N+5pV> z6Q`HJ5rn9(e{|9^z$;yk65Cbmr;DTbIGwWSFoL3VNDv&0=12>^3F}%I|CJ9=QOb1_x)wq8S+BI!S^~$q<#$Y zE2>~35F^;v2_1=hAc|=J^XDnXT&?c#J?Gq!d(OEdjAx9INCL~g!OIk+0A#2 z56v!*v8&;NCam#cK?8p8p&%#V8`Kz!N#oF1aO=Sg(?(4C2&`h}Sf?Hv5nALI+;@HUaVn=8D4UsX2N& zkWthdVuo^VcSz2ow|ppvq)jGi%U*Rr(?nBM@6U_wTySp*`5Z^iX^sf-lZ?1c3*CG} z!6U0ZI+dI6-V(Ew%9f5N*GSx3HW^lk;^RkzxLGnT-F(NTg9*c@dc+{pP>~8&A13rluch=|2M`p z5?{DRA~wM-AXCrKRQTFLaI$ryK%U#XD%S1Jda;JK*a^NhsbZ@GZ7N#Dru+woK9U&j zGIefuqd9PYUN$3so6ue=!4RLK#Sm8DkhJ!4MC3j8WEE%mcs7kT<+%lWaWe|m;K%5Y zjE8ju=Bn)Z=;oovQPFx5H^9_@uK>xj>x(*onIgNH%G!Spo|e!}p!!VE!FJ}I9>x+tT@ZD;Gu?C-okGwf)#HR@x-TK z?JmnYm7;3d<+Zu;=YJ@ zFGj)D|3>p$e9LKmtN0D?KE6K701s)#Ma_@0>C4mnah`ng8HZ;~#^anRR_IuWbvO!C z{NqW&+u9s9IlVV`QIFTXKPF3Ahy(cQA#~0(XFl2&0B{@v82JXxk4oQvL8ESWYJNKq za1Ot@hj=ywq7DR#W$w8c1hi|K#uGGgehcX^O>fII$sK(X`lNgl2`$!Kj+WPJjsRRBN;K97HA*! z5z}EH5U2EQ-nX2!sL5gH_?Y{pMQDKpWQZlqQxzAIn@>=O3eKhlVODdfm32~AcS!WKc||Ai~?Y9>H7>T={ae^$+%! zhn$SLa7orWWQ4g$YT?H{r~;=edoNk>w1(*kMMtFiAWSretEx7N+84 zjOJCz1%%0Bo+V7VI?x?652X%HXHf{vC2#$*52Rb@6wSDs@sEfCm6}zz>x7N;w&S|D~3=#Qrw@xxO43ZJCX`zY^92CIp~}*8CHl+%vN%>d>ggAReZ+81ub8AGV?lDzW~hDtyL3PHX>Rc zxjDeh?cgo(Y+%+pz$`{VuUo|zadBCE%K_6Wep7p-^$h2X3e6}qfq7GE?b3kRMqsXD z6=%FH$)*qc5X7X%zh=R@LCWOJPRdA|P>^`wtv z#B5q<^oIM-gv6)JR_atcNPK28tPqL%7!utq85c$`T;%!o#(LzLATc!crnk{S;!_8S zxox~9o`uBHXATmJQBdzz@kNkm@hyi$tN0CztBXy{{In_(Wy3`zqHOvSjb09!e&&#A zygjKr4M89=nj{i`$yRtRTOdOYmD7-Vu04$3AVja#jNbh-iFfhte!{k9E)p>ft&;FZ zAxsj0FEZYz+wdL#Fsog|SM?oU#P&&~QmHW!vcrU#!t`$Q6spHbM8l@Yc-zCD8VM@j zo$p_;+IS;=oBW3>7GW~=r3nuqCxJUu<{_C_WWB{t%Q+CODSeSQLEwDS^95NSM{Ml$ z&VlvF7Xj;|(s%!$({HQI+;-o1>$K;HXM5#VN?eMVyK+e3jV3Y29uDEJ$_+3F4D@D~l_lw~xxzc;eX;jbjOzjtvmF1WvUTW;c$ zRG6(S?K;rETlYm%pAv+m85gS#le+XJD$BbBAy2Q1-!(7+UG+i9@c5Y6RJQ?rg&tK< zcBr#l2Yt;jt*G3_-Hox_r$kbPm3*d$5l@C&WiYnk%C-HNGFT$3hXxgC?dbK-mHVcQ z2*?Y@u;!dFj|VcA@W^8v1u&gAJ^|f4sY**4+FR=6Gb=rW+Usj`-yTbuS~SS?x=beT zF6b$Lb+hcjMP;kjN|cTOxjH{>rCwkxT7HDJm_70=xB0P&p_Qq%v96(|iPgEWdAeK+ zL0v1LzPWMrDduFQm5(x0GsBN}@RZvT98V6YuM;2=uNW=Q+yb7*0?>I%bw+3*DWX)* zuy9n!#b?Cx&gJ5HhIqcAs;c6)W$vusO0Nxmzu(L&Q#V=G}*kXH&q3U1k9-msm zymIimYkg^9exhsTQD&@=-95tYFHf#Nhb?8ZyW3%RZpUrpn`3ueb|DjX7o%n7KW2Bg z6pU>s_9i{Gtw(Zkk=^2yy}UMbmhA3j8#=qMk!6E-?GeXg&C64{mwp$<<7a1>elrE3)b7VaBY8r^o4Q-ilavZh)Me%;TlQDyhnAP8Cg#URT@(~R zAh9kGc)IoIWor%siM1RA61k15*BMVBQ1(}P{*?Wqw6wSdyeI_bna7$G3=nuO4&qZn zfaKx=1omXT-{nDIo)GAv?9UG|OBVue8~lN zzm;;3=i_J4_aqk=c`oB0m&fx3^1PeP`+~_VT~4!kzjaYgA6bd!TXT)DfW)?wEq4CJ zX*j#lz85n2NSM5G^mpEIbSDlSCg-*lUdP#SHj@uzXLxpu6GbR!IB<*gpD@|#XOhX% zrkqx=K`t&Z+1fb$@|c_qbv*LP$VKaLM`2vBw!*UQQU0^Z5_5A~FDECgIH%WZ9ox4Gt>@hmw%Fez^m zuNZxK8xLF*0vVx&tYq{49Q2*qt|Pg)2!VI}?EeY^H(h}^mqstUX0jXw8odEKziu$} z-x_^#Xt|4vMjv$zFN{7aG~~*z38$}gC%?YPY4ozzoUoVWwtrn`Je$)2RvlaMqGbGc z+rP$z)12vNaT;Ed({mc+;v%QlFPGDc6n0EYu8J?3%(76UUzpQ(twaliee{27bO`q9 za$z^E?5;5RY3$7$nq$k=SvKe}Ik(H}I^$VP{*&9~6=6jvFkJv&RGb$Hq(Rmk#d+%t z^Pq%Wd`2dZ{9iKpf-88|%WPYqfXV0^Y_U@QZJBdr#@NQx@(Qf8F4>m+Sm&&4LD-#c zZhL@wu{vjE^A5XnJGvrYhuyNzqR4bHS~~t?c4KHA7ukIlry|M4MRxaGF1wc~(;bxQ zC6iee%JhZVy<;U>z;2GGFspxSZ*HD5HQy!YmEwJYsaCcloDL_mE3$QtaB$n<^p4X` zBc3JLzn55b60aB;d47hA3ic8Odt1sxPTQXM(@Zd1XR&aR(=t+hdF^zL({1skPt3Az zF(?8MUvhcA<8P_P)c=djEnBbnVKVuG7P}gIwr(-BxQGvBGP6@7+|WV%ZiS4m_#uq% zUp7my!=xqR6}c^3kz0=OjAt?a-PIi9i_(&JmgIlI_=@jRFfe{o7R8>@Mkl$r!1y=8 z%N6luig-IkeA#4{F1y(g%bNjlE(5JHY9*R4;#FTy+$T#kI*->JS{ZX04yp=-y)r61 ze-nN16V55wCu_ZulRw0_UYXnabe-`mp1*y>O2j@{2rEKR-oV^NdA`g%A|!=seY2VQ zo|5Mz7Z-TGi|H%+5{>fz&GYmHMZB`nWH|~%9P<4?MSNvpZfe9GOethHdhQ`CYXjl?@KNa~pB4S0bLxZs`kAw-=>l(=FhC!tMqZSJ*Aq!)e(Ka&eK}()eGVZeO8@ zU#Ez}iG{0B#4pV5n^vL)B0hVfh>x@9jYYLxvlvK02V4xeWl&Yf^P9r+Ye8&$?TC18 zE4=l}+*Wva%JKY7ZYw;56(Q)q+X^qfLR{Sd#lrLKud|3a$i+pTiy82L#q*2K9jt_- z3|FCuW9PXOEVrrIS&Wy?b}f%h{L7PCIU$^`x&H7KW{Fx2c;&bw-MQ`O))~)|?lCVD0aC&79a&eK<{gO)Jp? z=}w)f%!lDKN2j}MVI13WjVwt=rBJXph27b^qw}!CY<6cIcIWnKTdzbsi`~0#9CjC@ zrSZR0=BpI!EbCC%ojD7;K`t(`TjoYxo?!oPc6YnAaXx!(&ty3Y1v`Ol0~v}Xt;dE) zXqrFjT3G5@UKtvh8DChMBj?ALSBIAnyO8mFl7etQv-vV3O}SWPA06)J_Fr4CL}Z)$ zvJ7706(jAx+kY)C-2W&?4CkBtn?&Z@uVE$!Dy-!|SQ)ItU`V{n^VSX^Cz zO}{j;tX5Vt-24_Mol^TMhy;w~)Gch)jP0kDf7sfKT`Pm{)e)~0cc4z)YLgJ$4nVj% zKmz>iNF8Xtke|45MUa=%&#VLnYxVfh%FwLFZXOFudNXq`bz4=Nak9+gTh8c(wXvnl zLPpoZ(l{0w+Dsz`-*}<>V(okUSLxL&kwod$fak~a`07gz9ob=smM??)pr!J=E7*dYR@=hk5J9{>K+6XaV70 ztT};F4wF>5%0nOYV(zTtFlZ!ci~+)zzkU1{8JA0V^}bRcHv2wo#@{Z!n*$xO?fB=a z*0*?y$Ko5;_f0%SpGPJ){w&}ray7mZX-(oOd^4K8Tf4`%Um}wW`>*j7nkyL?P9NYY zwh-(5`<0G%$;jwHNdiytb*vY~zd_?OcMS;p<7=C~0G^_g z$zaPA&b8dP>5D%7dy}+8kV@?v2$724kFSK9I`9-2j3#GmQw*Dqzy0{UhhecuWn!4| zVt=AfA1`rVzt~`OqiSW8Z(HK8x*kX>_u_9e-4bu6^hVv2hj<&GE4|V5j%D-B34NtE z8j=(ItRwcUe2j(h2V&*HjWL(LxOchZD_+EYMdpkLShJ74_~WsLL)KOFNrajPPw_{Q zh4BH6CvOC`_L;R2TZ~Xr`1V_DsC)&}6jkhL>5ZXz6Hn3Wk=K9jt>Y=6<1-Zpq}0Fq z|C+n9k=UGJCtKvLmve#r+;b9U)9#dk>#%r!Jm{;K_lU+uu>jX@0P z^+3ORfjoz`1L?OTAm5u$E|=*5ZJ~A`6}LTj=S#J?OOW}ueBWb@4MgAQ-!r1k+JT8W zo9SBZKzo_UoA3=hRD2$EvnW8OKiK?ghT^udy?eC-9g%GesBNy+-qFIJ{H$l{=4$wQ)G?LeYHYxs-cHxuS_oxTG#e+Q)8`nHm__dwoDZ}v;=0g!fr8G;2; z8zpDXRT9v=d;#Px`{X5ihBjY`zn>e0c?`IA^`EnsG=#t84wgsp)~g6UGQfg8X*I^0 z=f>6YU6OySp!G@Yx|$o=l`@`p=Fnpg{$y?zOnSC=fofHB5Yi^ zdYz#fQv1gjHI8;#k}Uq$o=YIb8($9om?5~RJ<$8{jd3(NwZ01Ii%;A8O zv%Egh|NN=}IeSxDbRE4YV6qTch!9DJ;*DDPtz|{a+v^#Sx*eFw^D7A?eJL{>+qREp z**xhJoU3(+(A5Brc1bRas>ZKv9#XBKi2XDO!d42O%}e%KInM+@EOQAWiEun^s0LnbM3z`kmZzGPEaFB z0l!=;fOcUxM#G0d>ZQnTUW@^`+meMrR|-g~GY-_L4FK1BGq+l@?d+vS9Q1CQ{=I=y zAoaAmZ{oI9bvtc-#_n=@7^8Y26)x<<;rKCgOWoAX_hz7c9RX>!=2Jj&C@_({O;Wc1 zWicf;07;q%9bZr*Wq=H9S&ay-HPiNvPBT8eOa@9YbD{P#HY8VYY^J3hK%W=$QEME? z=QNL+dKqD^<>`^SwUdhdLi@+mNZB#3Tmd_NXK4e@a7U}V`Kr5p%KQ{|8>qh2jceao zRh;il`9-sU{H>|*(tX9cBJ}b^E{>n(x%C}Da=O=YRv~Qx`bGEsCAHMos=GzR-t%HV z2Pa>Iaulh=-%Ngpt02OL@(zorThu2Wsjo*C&GYrt(w`*1ERZ8?UODaWP*>A|Sa^_5 z(%gobXbb>(mqcho%K$0&f$MycGQY~GWBkcc=rPz!Su|OA|IBw4D-yD72zLWA2;B@b z4&)y_=c_GVn;&ejQi9BBi0sKXz5wP(S6OAulgei==pT%R$7C~C$(swId9rsG#J{{N zw7A!coSCqIv{{i``NRxW52~y_i1~&M>ZVT{vAGDJ^In?qsYN^58%0hUoun*A8}PR2 z*eEW{xDAQp39pGe~qp3 zF;z5;EYO#Fz|4)TGRw5XDueSXgJ$Znj!}81x{8Tt;-{}k&UZKi6bndFl7&wvl;N%x zEg>X%eu%;ITl=}rlqPT6H+3iTh%$d%3|zS)oN&qAXkAYu_3Z+3p9LL-C)}hZ*DY(} z9+2b`>GUkCt$Hkud%v>^sNETVOG6JwC0gxb3yb^7$ zv-u?p12?mfsgkMZhnYv(y?C#;TR`5ibh_|_8zcyd>{W~w@+e~7_{CK`lcv8m#!PWM zitK!Zaiu;Y7wozEm%vuGRD#Tz$s|`kk(H#73psmQO>`gjRANksO1)r`ioVWOr2)X@%(hh(Q=hl09C-v zfYx%RcjRFK$P*MT;TGCi`awH04%EkFL1d_hEb+vqXSAqU@V(CgIagvMRv7Qr?Iao@KO9Q94YYE2O!Z5~|I0U-B}ptIz9 z59I9PDs;8-4P8b<1W0;i{o4Ux{X1E+Pm)WlQd5LX>nlX+abvXe_iW~syQytvp{9Xe zbsn0oP^<&UlVmQ~Xgo9Yl-=O1S`i!zCF!dLKWDT{6O^~GJdEzks?^FIAK)_$nO-{lIa3+OfWB5J9Q815P;-9MP9B(fRqe! zdX7DpzA7?11=?AQF@|VAtu>{!ZBk3g6+7zPulN^n(8U_&Z=_cvK2+8S zpUY&gS2C^{*)Dqj&aNuA)Pp{E{-XC;+Z8{uHfsU-*Qy%rGQyaHj%L`ZD*~h~S6Ou# za`~0|YTdurb4i7(i}9X{e}AvczWAB_f%cJhW**5+toJ+{T^{pfdCTV9%6MViE5{<8 zTBbGBBgC3<4&>}&1-5|vKY6mxP!^)a=_A!?7DCe;bs2chu3`RnhWuu2LneKrh5P{O z*KfX0^_BjQoDImFue1TLj|-XV!MdkU89>(Yme&kv$%_fHZ$#E4Mohgl}U+rREHu2s#hLJUQiWRrY7= zXVD*9761O$V}#xs!*gm8{5p$3+CMRxylJ&?l^rQk0n zp=(~C9z1dsQF7HwJ(ODZlgtJGw9&W!gIxUEv<5w+4|BbbK&mE!4W&jPDRbO&*SlNE z-({EGpXw{9W|eQ;n@7)ZQ^aG=812F?9CrD=ZzsArnHKW(GB${u==BbF?tmPAb9A_! z+2gukY|H_30w~_P10%cNqHx%Zn zE7j4a&Rt|_e(R}W)E8I0tA$yf2 zu%Bezb)bX)Tl3kfZYQ*Xg;AWp@G57xzfg}DkZRvpSgPH-j4<2I336tBIHRe~k;*Al z8|ZFbr3baMk8Q!@bDN)eVm~kG(LcB>3=fdAK5n{3>n$LUW$dmPoU0cYb@sWsm@IUf zgOEuPR$x|4$C=S{8D>Vg?|$=hJhKYWA4;*xsx8pn=9-60lkv(#2fgam0^5&0%rgH) zd+>U5$>s-ZjM*M+AwR|jPVB*pU2<_Gl7(pL5J<8(3Uk}%`PD!zkfNsJi9Nd#sfbYoD8vJ8?fM z;3;TGDZYymbG?Retie z%?je~tFE$5_FpMmW(UQr@HUC&ohi=Hrl^qxq)x=c=`211xDE{E$63hK&c}z{r@F5a ik7fI%M2#1G?WTLlx((~`A*qOm|M_`q!OLFu&%Xf{)F++* literal 0 HcmV?d00001 diff --git a//eval.mid.122 b//eval.mid.122 new file mode 100644 index 0000000..bf17181 --- /dev/null +++ b//eval.mid.122 @@ -0,0 +1,4211 @@ +TITLE EVAL -- MUDDLE EVALUATOR + +RELOCATABLE + +; GERALD JAY SUSSMAN, 1971. REWRITTEN MANY TIMES SINCE C. REEVE (1972--1974) + + +.GLOBAL BINDID,LPROG,GLOBSP,GLOBASE,SPBASE,TPBASE,PTIME,SWAP,CHFRAM +.GLOBAL IGVAL,CHKARG,NXTDCL,TPOVFL,CHFRM,PROCHK,CHFSWP,VECBOT,TYPSGR +.GLOBAL ILVAL,ER1ARG,SPECBIND,MAKACT,SPECSTORE,MAKTUP,TPALOC,IBIND,SSPECS +.GLOBAL IDVAL,EVECTO,EUVECT,CHARGS,BCKTRK,CELL,ILOC,IGLOC,CHKDCL,SSPEC1 +.GLOBAL PDLBUF,MESS,FACTI,CHKARG,MAKENV,PSTAT,BNDV,UNBOU,UNAS,IGDECL +.GLOBAL 1STEPR,SEGMNT,SEGLST,NAPT,EVTYPE,EVATYP,APTYPE,APLTYP,APLQ,IDVAL1 +.GLOBAL TESTR,VALG,TYPG,INCR1,TMATCH,TYPMIS,SAT,MAKACT,NTPALO,SPECBND +.GLOBAL TPGROW,CHKAB,TYPSEG,NXTLM,MONCH0,CHFINI,RMONC0,IMPURIFY,ICONS,INCONS +.GLOBAL CILVAL,CISET,CIGVAL,CSETG,MAPPLY,CLLOC,CGLOC,CASSQ,CGASSQ,CBOUND +.GLOBAL IIGLOC,CHUNW,IUNWIN,UNWIN2,SPCCHK,CURFCN,TMPLNT,TD.LNT,TBINIT +.GLOBAL SPECBE,BSETG,GLOTOP,CANDP,CORP,TFA,TMA,DSTORE,PVSTOR,SPSTOR +.GLOBAL AGC,GVLINC,LVLINC,CGBOUN,IEVECT,MAKTU2,STOSTR,HIBOT,POPUNW,ISTRUC + +.INSRT MUDDLE > + +MONITOR + + +; ENTRY TO EXPAND A MACRO + +MFUNCTION EXPAND,SUBR + + ENTRY 1 + + MOVE PVP,PVSTOR+1 + MOVEI A,PVLNT*2+1(PVP) + HRLI A,TFRAME + MOVE B,TBINIT+1(PVP) + HLL B,OTBSAV(B) + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + JRST AEVAL2 + +; MAIN EVAL ENTRANCE + +IMFUNCTION EVAL,SUBR + + ENTRY + + MOVE PVP,PVSTOR+1 + SKIPE C,1STEPR+1(PVP) ; BEING 1 STEPPED? + JRST 1STEPI ; YES HANDLE +EVALON: HLRZ A,AB ;GET NUMBER OF ARGS + CAIE A,-2 ;EXACTLY 1? + JRST AEVAL ;EVAL WITH AN ALIST +SEVAL: GETYP A,(AB) ;GET TYPE OF ARG + SKIPE C,EVATYP+1 ; USER TYPE TABLE? + JRST EVDISP +SEVAL1: CAIG A,NUMPRI ;PRIMITIVE? + JRST SEVAL2 ;YES-DISPATCH + +SELF: MOVE A,(AB) ;TYPES WHICH EVALUATE + MOVE B,1(AB) + JRST EFINIS ;TO SELF-EG NUMBERS + +SEVAL2: HRRO A,EVTYPE(A) + JRST (A) + +; HERE FOR USER EVAL DISPATCH + +EVDISP: ADDI C,(A) ; POINT TO SLOT + ADDI C,(A) + SKIPE (C) ; SKIP EITHER A LOSER OR JRST DISP + JRST EVDIS1 ; APPLY EVALUATOR + SKIPN C,1(C) ; GET ADDR OR GO TO PURE DISP + JRST SEVAL1 + JRST (C) + +EVDIS1: PUSH TP,(C) + PUSH TP,1(C) + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,APPLY ; APPLY HACKER TO OBJECT + JRST EFINIS + + +; EVAL DISPATCH TABLE + +IF2,SELFS==400000,,SELF + +DISTBL EVTYPE,SELFS,[[TFORM,EVFORM],[TLIST,EVLIST],[TVEC,EVECT],[TUVEC,EUVEC] +[TSEG,ILLSEG]] + + +;WATCH FOR SUBTLE BUG 43 LERR,LPROG OR BINDID +AEVAL: + CAIE A,-4 ;EXACTLY 2 ARGS? + JRST WNA ;NO-ERROR + GETYP A,2(AB) ;CHECK THAT WE HAVE A FRAME + CAIE A,TACT + CAIN A,TFRAME + JRST .+3 + CAIE A,TENV + JRST TRYPRO ; COULD BE PROCESS + MOVEI B,2(AB) ; POINT TO FRAME +AEVAL2: PUSHJ P,CHENV ; HACK ENVIRONMENT CHANGE +AEVAL1: PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 1,EVAL +AEVAL3: HRRZ 0,FSAV(TB) + CAIN 0,EVAL + JRST EFINIS + JRST FINIS + +TRYPRO: CAIE A,TPVP ; SKIP IF IT IS A PROCESS + JRST WTYP2 + MOVE C,3(AB) ; GET PROCESS + CAMN C,PVSTOR ; DIFFERENT FROM ME? + JRST SEVAL ; NO, NORMAL EVAL WINS + MOVE B,SPSTO+1(C) ; GET SP FOR PROCESS + MOVE D,TBSTO+1(C) ; GET TOP FRAME + HLL D,OTBSAV(D) ; TIME IT + MOVEI C,PVLNT*2+1(C) ; CONS UP POINTER TO PROC DOPE WORD + HRLI C,TFRAME ; LOOK LIK E A FRAME + PUSHJ P,SWITSP ; SPLICE ENVIRONMENT + JRST AEVAL1 + +; ROUTINE TO CHANGE LOOK UP PATH FOR BINDINGS + +CHENV: PUSHJ P,CHFRM ; CHECK OUT FRAME + MOVE C,(B) ; POINT TO PROCESS + MOVE D,1(B) ; GET TB POINTER FROM FRAME + CAMN SP,SPSAV(D) ; CHANGE? + POPJ P, ; NO, JUST RET + MOVE B,SPSAV(D) ; GET SP OF INTEREST +SWITSP: MOVSI 0,TSKIP ; SET UP SKIP + HRRI 0,1(TP) ; POINT TO UNBIND PATH + MOVE A,PVSTOR+1 + ADD A,[BINDID,,BINDID] ; BIND THE BINDING ID + PUSH TP,BNDV + PUSH TP,A + PUSH TP,$TFIX + AOS A,PTIME ; NEW ID + PUSH TP,A + MOVE E,TP ; FOR SPECBIND + PUSH TP,0 + PUSH TP,B + PUSH TP,C ; SAVE PROCESS + PUSH TP,D + PUSHJ P,SPECBE ; BIND BINDID + MOVE SP,TP ; GET NEW SP + SUB SP,[3,,3] ; SET UP SP FORK + MOVEM SP,SPSTOR+1 + POPJ P, + + +; HERE TO EVALUATE A FORM (99% OF EVAL'S WORK) + +EVFORM: SKIPN C,1(AB) ; EMPTY FORM, RETURN FALSE + JRST EFALSE + GETYP A,(C) ; 1ST ELEMENT OF FORM + CAIE A,TATOM ; ATOM? + JRST EV0 ; NO, EVALUATE IT + MOVE B,1(C) ; GET ATOM + PUSHJ P,IGVAL ; GET ITS GLOBAL VALUE + +; SPECIAL HACK TO SPEED UP LVAL AND GVAL CALLS + + CAIE B,LVAL + CAIN B,GVAL + JRST ATMVAL ; FAST ATOM VALUE + + GETYP 0,A + CAIE 0,TUNBOU ; BOUND? + JRST IAPPLY ; YES APPLY IT + + MOVE C,1(AB) ; LOOK FOR LOCAL + MOVE B,1(C) + PUSHJ P,ILVAL + GETYP 0,A + CAIE 0,TUNBOU + JRST IAPPLY ; WIN, GO APPLY IT + + PUSH TP,$TATOM + PUSH TP,EQUOTE UNBOUND-VARIABLE + PUSH TP,$TATOM + MOVE C,1(AB) ; FORM BACK + PUSH TP,1(C) + PUSH TP,$TATOM + PUSH TP,IMQUOTE VALUE + MCALL 3,ERROR ; REPORT THE ERROR + JRST IAPPLY + +EFALSE: MOVSI A,TFALSE ; SPECIAL FALSE FOR EVAL OF EMPTY FORM + MOVEI B,0 + JRST EFINIS + +ATMVAL: HRRZ D,(C) ; CDR THE FORM + HRRZ 0,(D) ; AND AGAIN + JUMPN 0,IAPPLY + GETYP 0,(D) ; MAKE SURE APPLYING TO ATOM + CAIE 0,TATOM + JRST IAPPLY + MOVEI E,IGVAL ; ASSUME GLOBAAL + CAIE B,GVAL ; SKIP IF OK + MOVEI E,ILVAL ; ELSE USE LOCAL + PUSH P,B ; SAVE SUBR + MOVE B,(D)+1 ; CLR BUG #1637 (GET THE ATOM FOR THE SUBR) + PUSHJ P,(E) ; AND GET VALUE + CAME A,$TUNBOU + JRST EFINIS ; RETURN FROM EVAL + POP P,B + MOVSI A,TSUBR ; CAUSE REAL SUBR TO GET EROR + JRST IAPPLY + +; HERE FOR 1ST ELEMENT NOT A FORM + +EV0: PUSHJ P,FASTEV ; EVAL IT + +; HERE TO APPLY THINGS IN FORMS + +IAPPLY: PUSH TP,(AB) ; SAVE THE FORM + PUSH TP,1(AB) + PUSH TP,A + PUSH TP,B ; SAVE THE APPLIER + PUSH TP,$TFIX ; AND THE ARG GETTER + PUSH TP,[ARGCDR] + PUSHJ P,APLDIS ; GO TO INTERNAL APPLIER + JRST EFINIS ; LEAVE EVAL + +; HERE TO EVAL 1ST ELEMENT OF A FORM + +FASTEV: MOVE PVP,PVSTOR+1 + SKIPE 1STEPR+1(PVP) ; BEING 1 STEPPED? + JRST EV02 ; YES, LET LOSER SEE THIS EVAL + GETYP A,(C) ; GET TYPE + SKIPE D,EVATYP+1 ; USER TABLE? + JRST EV01 ; YES, HACK IT +EV03: CAIG A,NUMPRI ; SKIP IF SELF + SKIPA A,EVTYPE(A) ; GET DISPATCH + MOVEI A,SELF ; USE SLEF + +EV04: CAIE A,SELF ; IF EVAL'S TO SELF, JUST USE IT + JRST EV02 + MOVSI A,TLIST + MOVE PVP,PVSTOR+1 + MOVEM A,CSTO(PVP) + INTGO + SETZM CSTO(PVP) + HLLZ A,(C) ; GET IT + MOVE B,1(C) + JSP E,CHKAB ; CHECK DEFERS + POPJ P, ; AND RETURN + +EV01: ADDI D,(A) ; POINT TO SLOT OF USER EVAL TABLE + ADDI D,(A) + SKIPE (D) ; EITHER NOT GIVEN OR SIMPLE + JRST EV02 + SKIPN 1(D) ; SKIP IF SIMPLE + JRST EV03 ; NOT GIVEN + MOVE A,1(D) + JRST EV04 + +EV02: PUSH TP,(C) + HLLZS (TP) ; FIX UP LH + PUSH TP,1(C) + JSP E,CHKARG + MCALL 1,EVAL + POPJ P, + + +; MAPF/MAPR CALL TO APPLY + + IMQUOTE APPLY + +MAPPLY: JRST APPLY + +; APPLY, FALLS INTO EVAL'S APPLY CODE AT APLDIS + +IMFUNCTION APPLY,SUBR + + ENTRY + + JUMPGE AB,TFA ; MUST BE AT LEAST 1 ARGUMENT + MOVE A,AB + ADD A,[2,,2] + PUSH TP,$TAB + PUSH TP,A + PUSH TP,(AB) ; SAVE FCN + PUSH TP,1(AB) + PUSH TP,$TFIX ; AND ARG GETTER + PUSH TP,[SETZ APLARG] + PUSHJ P,APLDIS + JRST FINIS + +; STACKFROM, ALSO FALLS INTO EVAL'S APPLIER AT APLDIS + +IMFUNCTION STACKFORM,FSUBR + + ENTRY 1 + + GETYP A,(AB) + CAIE A,TLIST + JRST WTYP1 + MOVEI A,3 ; CHECK ALL GOODIES SUPPLIED + HRRZ B,1(AB) + + JUMPE B,TFA + HRRZ B,(B) ; CDR IT + SOJG A,.-2 + + HRRZ C,1(AB) ; GET LIST BACK + PUSHJ P,FASTEV ; DO A FAST EVALUATION + PUSH TP,(AB) + HRRZ C,@1(AB) ; POINT TO ARG GETTING FORMS + PUSH TP,C + PUSH TP,A ; AND FCN + PUSH TP,B + PUSH TP,$TFIX + PUSH TP,[SETZ EVALRG] + PUSHJ P,APLDIS + JRST FINIS + + +; OFFSETS FOR TEMPORARIES ETC. USED IN APPLYING STUFF + +E.FRM==0 ; POINTS TO FORM BEING EVALED (OR ARGS FOR APPLY STACKFORM) +E.FCN==2 ; FUNCTION/SUBR/RSUBR BEING APPLIED +E.ARG==4 ; POINTS TO ARG GETTING ROUTINE (<0 => MUST EVAL ARGS) +E.EXTR==6 ; CONTAINS 1ST ARG IN USER APPLY CASE +E.SEG==10 ; POINTS TO SEGMENT IN FORM BEING HACKED +E.CNT==12 ; COUNTER FOR TUPLES OF ARGS +E.DECL==14 ; POINTS TO DECLARATION LIST IN FUNCTIONS +E.ARGL==16 ; POINTS TO ARG LIST IN FUNCTIONS +E.HEW==20 ; POINTS TO HEWITT ATOM IF IT EXISTS + +E.VAL==E.ARGL ; VALUE TYPE FOR RSUBRS + +MINTM==E.EXTR+2 ; MIN # OF TEMPS EVER ALLOCATED +E.TSUB==E.CNT+2 ; # OF TEMPS FOR SUBR/NUMBER APPLICATION +XP.TMP==E.HEW-E.EXTR ; # EXTRA TEMPS FOR FUNCTION APPLICATION +R.TMP==4 ; TEMPS AFTER ARGS ARE BOUND +TM.OFF==E.HEW+2-R.TMP ; TEMPS TO FLUSH AFTER BIND OF ARGS + +RE.FCN==0 ; AFTER BINDING CONTAINS FCN BODY +RE.ARG==2 ; ARG LIST AFTER BINDING + +; GENERAL THING APPLYER + +APLDIS: PUSH TP,[0] ; SLOT USED FOR USER APPLYERS + PUSH TP,[0] +APLDIX: GETYP A,E.FCN(TB) ; GET TYPE + +APLDI: SKIPE D,APLTYP+1 ; USER TABLE EXISTS? + JRST APLDI1 ; YES, USE IT +APLDI2: CAILE A,NUMPRI ; SKIP IF NOT PRIM + JRST NAPT + HRRO A,APTYPE(A) + JRST (A) + +APLDI1: ADDI D,(A) ; POINT TO SLOT + ADDI D,(A) + SKIPE (D) ; SKIP IF NOT GIVEN OR STANDARD + JRST APLDI3 +APLDI4: SKIPE D,1(D) ; GET DISP + JRST (D) + JRST APLDI2 ; USE SYSTEM DISPATCH + +APLDI3: SKIPE E.EXTR+1(TB) ; SKIP IF HAVEN'T BEEN HERE BEFORE + JRST APLDI4 + MOVE A,(D) ; GET ITS HANDLER + EXCH A,E.FCN(TB) ; AND USE AS FCN + MOVEM A,E.EXTR(TB) ; SAVE + MOVE A,1(D) + EXCH A,E.FCN+1(TB) + MOVEM A,E.EXTR+1(TB) ; STASH OLD FCN AS EXTRG + GETYP A,(D) ; GET TYPE + JRST APLDI + + +; APPLY DISPATCH TABLE + +DISTBL APTYPE,,[[TSUBR,APSUBR],[TFSUBR,APFSUB],[TRSUBR,APRSUB],[TFIX,APNUM] +[TEXPR,APEXPR],[TFUNAR,APFUNARG],[TENTER,APENTR],[TMACRO,APMACR],[TOFFS,APNUM]] + +; SUBR TO SAY IF TYPE IS APPLICABLE + +MFUNCTION APPLIC,SUBR,[APPLICABLE?] + + ENTRY 1 + + GETYP A,(AB) + PUSHJ P,APLQ + JRST IFALSE + JRST TRUTH + +; HERE TO DETERMINE IF A TYPE IS APPLICABLE + +APLQ: PUSH P,B + SKIPN B,APLTYP+1 + JRST USEPUR ; USE PURE TABLE + ADDI B,(A) + ADDI B,(A) ; POINT TO SLOT + SKIPG 1(B) ; SKIP IF WINNER + SKIPE (B) ; SKIP IF POTENIAL LOSER + JRST CPPJ1B ; WIN + SKIPE 1(B) ; SKIP IF MUST USE PURE TABBLE + JRST CPOPJB +USEPUR: CAILE A,NUMPRI ; SKIP IF NOT PRIM + JRST CPOPJB + SKIPL APTYPE(A) ; SKIP IF APLLICABLE +CPPJ1B: AOS -1(P) +CPOPJB: POP P,B + POPJ P, + +; FSUBR APPLYER + +APFSUBR: + SKIPN E.EXTR(TB) ; IF EXTRA ARG + SKIPGE E.ARG+1(TB) ; OR APPLY/STACKFORM, LOSE + JRST BADFSB + MOVE A,E.FCN+1(TB) ; GET FCN + HRRZ C,@E.FRM+1(TB) ; GET ARG LIST + SUB TP,[MINTM,,MINTM] ; FLUSH UNWANTED TEMPS + PUSH TP,$TLIST + PUSH TP,C ; ARG TO STACK + .MCALL 1,(A) ; AND CALL + POPJ P, ; AND LEAVE + +; SUBR APPLYER + +APSUBR: + PUSHJ P,PSH4ZR ; SET UP ZEROED SLOTS + SKIPG E.ARG+1(TB) + AOS E.CNT(TB) ; INDICATES IF MUST EVAL ARGS + MOVSI A,400000 ; MAKE SURE OF GOOD INDIRECT + IORM A,E.ARG+1(TB) + SKIPN A,E.EXTR(TB) ; FUNNY ARGS + JRST APSUB1 ; NO, GO + MOVE B,E.EXTR+1(TB) ; YES , GET VAL + JRST APSUB2 ; AND FALL IN + +APSUB1: PUSHJ P,@E.ARG+1(TB) ; EAT AN ARG + JRST APSUBD ; DONE +APSUB2: PUSH TP,A + PUSH TP,B + AOS E.CNT+1(TB) ; COUNT IT + JRST APSUB1 + +APSUBD: MOVE A,E.CNT+1(TB) ; FINISHED, GET COUNT + MOVE B,E.FCN+1(TB) ; AND SUBR + GETYP 0,E.FCN(TB) + CAIN 0,TENTER + JRST APENDN + PUSHJ P,BLTDN ; FLUSH CRUFT + .ACALL A,(B) + POPJ P, + +BLTDN: MOVEI C,(TB) ; POINT TO DEST + HRLI C,E.TSUB(C) ; AND SOURCE + BLT C,-E.TSUB(TP) ;BL..............T + SUB TP,[E.TSUB,,E.TSUB] + POPJ P, + +APENDN: PUSHJ P,BLTDN +APNDN1: .ECALL A,(B) + POPJ P, + +; FLAGS FOR RSUBR HACKER + +F.STR==1 +F.OPT==2 +F.QUO==4 +F.NFST==10 + +; APPLY OBJECTS OF TYPE RSUBR + +APENTR: +APRSUBR: + MOVE C,E.FCN+1(TB) ; GET THE RSUBR + CAML C,[-5,,] ; IS IT LONG ENOUGH FOR DECLS + JRST APSUBR ; NO TREAT AS A SUBR + GETYP 0,4(C) ; GET TYPE OF 3D ELEMENT + CAIE 0,TDECL ; DECLARATION? + JRST APSUBR ; NO, TREAT AS SUBR + PUSHJ P,PSH4ZR ; ALLOCATE SOME EXTRA ROOM + PUSH TP,$TDECL ; PUSH UP THE DECLS + PUSH TP,5(C) + PUSH TP,$TLOSE ; SAVE ROOM FOR VAL DECL + PUSH TP,[0] + SKIPG E.ARG+1(TB) + AOS E.CNT(TB) ; INDICATES IF MUST EVAL ARGS + MOVSI A,400000 ; MAKE SURE OF GOOD INDIRECT + IORM A,E.ARG+1(TB) + + SKIPN E.EXTR(TB) ; "EXTRA" ARG? + JRST APRSU1 ; NO, + MOVE 0,[SETZ EXTRGT] ; CHANGE THE ACCESS FCN + EXCH 0,E.ARG+1(TB) + HRRM 0,E.ARG(TB) ; REMEMBER IT + +APRSU1: MOVEI 0,0 ; INIT FLAG REGISTER + PUSH P,0 ; SAVE + +APRSU2: HRRZ A,E.DECL+1(TB) ; GET DECL LIST + JUMPE A,APRSU3 ; DONE! + HRRZ B,(A) ; CDR IT + MOVEM B,E.DECL+1(TB) + PUSHJ P,NXTDCL ; IS NEXT THING A STRING? + JRST APRSU4 ; NO, BETTER BE A TYPE + CAMN B,[ASCII /VALUE/] + JRST RSBVAL ; SAVE VAL DECL + TRON 0,F.NFST ; IF NOT FIRST, LOSE + CAME B,[ASCII /CALL/] ; CALL DECL + JRST APRSU7 + SKIPE E.CNT(TB) ; LEGAL? + JRST MPD + MOVE C,E.FRM(TB) + MOVE D,E.FRM+1(TB) ; GET FORM + JRST APRS10 ; HACK IT + +APRSU5: TROE 0,F.STR ; STRING STRING? + JRST MPD ; LOSER + CAMN B,[] + JRST .+3 + CAME B,[+1] ; OPTIONA? + JRST APRSU8 + TROE 0,F.OPT ; CHECK AND SET + JRST MPD ; OPTINAL OPTIONAL LOSES + JRST APRSU2 ; TO MAIN LOOP + +APRSU7: CAME B,[ASCII /QUOTE/] + JRST APRSU5 + TRO 0,F.STR + TROE 0,F.QUO ; TURN ON AND CHECK QUOTE + JRST MPD ; QUOTE QUOTE LOSES + JRST APRSU2 ; GO TO END OF LOOP + + +APRSU8: CAME B,[ASCII /ARGS/] + JRST APRSU9 + SKIPE E.CNT(TB) ; SKIP IF LEGAL + JRST MPD + HRRZ D,@E.FRM+1(TB) ; GET ARG LIST + MOVSI C,TLIST + +APRS10: HRRZ A,(A) ; GET THE DECL + MOVEM A,E.DECL+1(TB) ; CLOBBER + HRRZ B,(A) ; CHECK FOR TOO MUCH + JUMPN B,MPD + MOVE B,1(A) ; GET DECL + HLLZ A,(A) ; GOT THE DECL + MOVEM 0,(P) ; SAVE FLAGS + JSP E,CHKAB ; CHECK DEFER + PUSH TP,C + PUSH TP,D ; SAVE + PUSHJ P,TMATCH + JRST WTYP + AOS E.CNT+1(TB) ; COUNT ARG + JRST APRDON ; GO CALL RSUBR + +RSBVAL: HRRZ A,E.DECL+1(TB) ; GET DECL + JUMPE A,MPD + HRRZ B,(A) ; POINT TO DECL + MOVEM B,E.DECL+1(TB) ; SAVE NEW DECL POINTER + PUSHJ P,NXTDCL + JRST .+2 + JRST MPD + MOVEM A,E.VAL+1(TB) ; SAVE VAL DECL + MOVSI A,TDCLI + MOVEM A,E.VAL(TB) ; SET ITS TYPE + JRST APRSU2 + + +APRSU9: CAME B,[ASCII /TUPLE/] + JRST MPD + MOVEM 0,(P) ; SAVE FLAGS + HRRZ A,(A) ; CDR DECLS + MOVEM A,E.DECL+1(TB) + HRRZ B,(A) + JUMPN B,MPD ; LOSER + PUSH P,[0] ; COUNT ELEMENTS IN TUPLE + +APRTUP: PUSHJ P,@E.ARG+1(TB) ; GOBBLE ARGS + JRST APRTPD ; DONE + PUSH TP,A + PUSH TP,B + AOS (P) ; COUNT IT + JRST APRTUP ; AND GO + +APRTPD: POP P,C ; GET COUNT + ADDM C,E.CNT+1(TB) ; UPDATE MAIN COUNT + ASH C,1 ; # OF WORDS + HRLI C,TINFO ; BUILD FENCE POST + PUSH TP,C + PUSHJ P,TBTOTP ; GEN REL OFFSET TO TOP + PUSH TP,D + HRROI D,-1(TP) ; POINT TO TOP + SUBI D,(C) ; TO BASE + TLC D,-1(C) + MOVSI C,TARGS ; BUILD TYPE WORD + HLR C,OTBSAV(TB) + MOVE A,E.DECL+1(TB) + MOVE B,1(A) + HLLZ A,(A) ; TYPE/VAL + JSP E,CHKAB ; CHECK + PUSHJ P,TMATCH ; GOTO TYPE CHECKER + JRST WTYP + + SUB TP,[2,,2] ; REMOVE FENCE POST + +APRDON: SUB P,[1,,1] ; FLUSH CRUFT + MOVE A,E.CNT+1(TB) ; GET # OF ARGS + MOVE B,E.FCN+1(TB) + GETYP 0,E.FCN(TB) ; COULD BE ENTRY + MOVEI C,(TB) ; PREPARE TO BLT DOWN + HRLI C,E.TSUB+2(C) + BLT C,-E.TSUB+2(TP) + SUB TP,[E.TSUB+2,,E.TSUB+2] + CAIE 0,TRSUBR + JRST APNDNX + .ACALL A,(B) ; CALL THE RSUBR + JRST PFINIS + +APNDNX: .ECALL A,(B) + JRST PFINIS + + + + +APRSU4: MOVEM 0,(P) ; SAVE FLAGS + MOVE B,1(A) ; GET DECL + HLLZ A,(A) + JSP E,CHKAB + MOVE 0,(P) ; RESTORE FLAGS + PUSH TP,A + PUSH TP,B ; AND SAVE + SKIPE E.CNT(TB) ; ALREADY EVAL'D + JRST APREV0 + TRZN 0,F.QUO + JRST APREVA ; MUST EVAL ARG + MOVEM 0,(P) + HRRZ C,@E.FRM+1(TB) ; GET ARG? + TRNE 0,F.OPT ; OPTIONAL + JUMPE C,APRDN + JUMPE C,TFA ; NO, TOO FEW ARGS + MOVEM C,E.FRM+1(TB) + HLLZ A,(C) ; GET ARG + MOVE B,1(C) + JSP E,CHKAB ; CHECK THEM + +APRTYC: MOVE C,A ; SET UP FOR TMATCH + MOVE D,B + EXCH B,(TP) + EXCH A,-1(TP) ; SAVE STUFF +APRS11: PUSHJ P,TMATCH ; CHECK TYPE + JRST WTYP + + MOVE 0,(P) ; RESTORE FLAGS + TRZ 0,F.STR + AOS E.CNT+1(TB) + JRST APRSU2 ; AND GO ON + +APREV0: TRNE 0,F.QUO ; ATTEMPT TO QUOTE ALREADY EVAL'D ARG ? + JRST MPD ; YES, LOSE +APREVA: PUSHJ P,@E.ARG+1(TB) ; EVAL ONE + TDZA C,C ; C=0 ==> NONE LEFT + MOVEI C,1 + MOVE 0,(P) ; FLAGS + JUMPN C,APRTYC ; GO CHECK TYPE +APRDN: SUB TP,[2,,2] ; FLUSH DECL + TRNE 0,F.OPT ; OPTIONAL? + JRST APRDON ; ALL DONE + JRST TFA + +APRSU3: TRNE 0,F.STR ; END IN STRING? + JRST MPD + PUSHJ P,@E.ARG+1(TB) ; SEE IF ANYMORE ARGS + JRST APRDON + JRST TMA + + +; STANDARD ARGUMENT GETTERS USED IN APPLYING THINGS + +ARGCDR: HRRZ C,@E.FRM+1(TB) ; POINT TO ARGLIST (NOTE: POINTS 1 BEFORE WHERE ARG IS) + JUMPE C,CPOPJ ; LEAVE IF DONE + MOVEM C,E.FRM+1(TB) + GETYP 0,(C) ; GET TYPE OF ARG + CAIN 0,TSEG + JRST ARGCD1 ; SEG MENT HACK + PUSHJ P,FASTEV + JRST CPOPJ1 + +ARGCD1: PUSH TP,$TFORM ; PRETEND WE ARE A FORM + PUSH TP,1(C) + MCALL 1,EVAL + MOVEM A,E.SEG(TB) + MOVEM B,E.SEG+1(TB) + PUSHJ P,TYPSEG ; GET SEG TYPE CODE + HRRM C,E.ARG(TB) ; SAVE IT IN OBSCCURE PLACE + MOVE C,DSTORE ; FIX FOR TEMPLATE + MOVEM C,E.SEG(TB) + MOVE C,[SETZ SGARG] + MOVEM C,E.ARG+1(TB) ; SET NEW ARG GETTER + +; FALL INTO SEGARG + +SGARG: INTGO + HRRZ C,E.ARG(TB) ; SEG CODE TO C + MOVE D,E.SEG+1(TB) + MOVE A,E.SEG(TB) + MOVEM A,DSTORE + PUSHJ P,NXTLM ; GET NEXT ELEMENT + JRST SEGRG1 ; DONE + MOVEM D,E.SEG+1(TB) + MOVE D,DSTORE ; KEEP TYPE WINNING + MOVEM D,E.SEG(TB) + SETZM DSTORE + JRST CPOPJ1 ; RETURN + +SEGRG1: SETZM DSTORE + MOVEI C,ARGCDR + HRRM C,E.ARG+1(TB) ; RESET ARG GETTER + JRST ARGCDR + +; ARGUMENT GETTER FOR APPLY + +APLARG: INTGO + SKIPL A,E.FRM+1(TB) ; ANY ARGS LEFT + POPJ P, ; NO, EXIT IMMEDIATELY + ADD A,[2,,2] + MOVEM A,E.FRM+1(TB) + MOVE B,-1(A) ; RET NEXT ARG + MOVE A,-2(A) + JRST CPOPJ1 + +; STACKFORM ARG GETTER + +EVALRG: SKIPN C,@E.FRM+1(TB) ; ANY FORM? + POPJ P, + PUSHJ P,FASTEV + GETYP A,A ; CHECK FOR FALSE + CAIN A,TFALSE + POPJ P, + MOVE C,E.FRM+1(TB) ; GET OTHER FORM + PUSHJ P,FASTEV + JRST CPOPJ1 + + +; HERE TO APPLY NUMBERS + +APNUM: PUSHJ P,PSH4ZR ; TP SLOTS + SKIPN A,E.EXTR(TB) ; FUNNY ARG? + JRST APNUM1 ; NOPE + MOVE B,E.EXTR+1(TB) ; GET ARG + JRST APNUM2 + +APNUM1: PUSHJ P,@E.ARG+1(TB) ; GET ARG + JRST TFA +APNUM2: PUSH TP,A + PUSH TP,B + PUSH TP,E.FCN(TB) + PUSH TP,E.FCN+1(TB) + PUSHJ P,@E.ARG+1(TB) + JRST .+2 + JRST APNUM3 + PUSHJ P,BLTDN ; FLUSH JUNK + MCALL 2,NTH + POPJ P, +; HACK FOR TURNING <3 .FOO .BAR> INTO +APNUM3: PUSH TP,A + PUSH TP,B + PUSHJ P,@E.ARG+1(TB) + JRST .+2 + JRST TMA + PUSHJ P,BLTDN + GETYP A,-5(TP) + PUSHJ P,ISTRUC ; STRUCTURED FIRST ARG? + JRST WTYP1 + MCALL 3,PUT + POPJ P, + +; HERE TO APPLY SUSSMAN FUNARGS + +APFUNARG: + + SKIPN C,E.FCN+1(TB) + JRST FUNERR + HRRZ D,(C) ; MUST BE AT LEAST 2 LONG + JUMPE D,FUNERR + GETYP 0,(D) ; CHECK FOR LIST + CAIE 0,TLIST + JRST FUNERR + HRRZ 0,(D) ; SHOULD BE END + JUMPN 0,FUNERR + GETYP 0,(C) ; 1ST MUST BE FCN + CAIE 0,TEXPR + JRST FUNERR + SKIPN C,1(C) + JRST NOBODY + PUSHJ P,APEXPF ; BIND THE ARGS AND AUX'S + HRRZ C,RE.FCN+1(TB) ; GET BODY OF FUNARG + MOVE B,1(C) ; GET FCN + MOVEM B,RE.FCN+1(TB) ; AND SAVE + HRRZ C,(C) ; CDR FUNARG BODY + MOVE C,1(C) + MOVSI 0,TLIST ; SET UP TYPE + MOVE PVP,PVSTOR+1 + MOVEM 0,CSTO(PVP) ; FOR INTS TO WIN + +FUNLP: INTGO + JUMPE C,DOF ; RUN IT + GETYP 0,(C) + CAIE 0,TLIST ; BETTER BE LIST + JRST FUNERR + PUSH TP,$TLIST + PUSH TP,C + PUSHJ P,NEXTDC ; GET POSSIBILITY + JRST FUNERR ; LOSER + CAIE A,2 + JRST FUNERR + HRRZ B,(B) ; GET TO VALUE + MOVE C,(TP) + SUB TP,[2,,2] + PUSH TP,BNDA + PUSH TP,E + HLLZ A,(B) ; GET VAL + MOVE B,1(B) + JSP E,CHKAB ; HACK DEFER + PUSHJ P,PSHAB4 ; PUT VAL IN + HRRZ C,(C) ; CDR + JUMPN C,FUNLP + +; HERE TO RUN FUNARG + +DOF: MOVE PVP,PVSTOR+1 + SETZM CSTO(PVP) ; DONT CONFUSE GC + PUSHJ P,SPECBIND ; BIND 'EM UP + JRST RUNFUN + + + +; HERE TO DO MACROS + +APMACR: HRRZ E,OTBSAV(TB) + HRRZ D,PCSAV(E) ; SEE WHERE FROM + CAIE D,EFCALL+1 ; 1STEP + JRST .+3 + HRRZ E,OTBSAV(E) + HRRZ D,PCSAV(E) + CAIN D,AEVAL3 ; SKIP IF NOT RIGHT + JRST APMAC1 + SKIPG E.ARG+1(TB) ; SKIP IF REAL FORM EXISTS + JRST BADMAC + MOVE A,E.FRM(TB) + MOVE B,E.FRM+1(TB) + SUB TP,[E.EXTR+2,,E.EXTR+2] ; FLUSH JUNK + PUSH TP,A + PUSH TP,B + MCALL 1,EXPAND ; EXPAND THE MACRO + PUSH TP,A + PUSH TP,B + MCALL 1,EVAL ; EVAL THE RESULT + POPJ P, + +APMAC1: MOVE C,E.FCN+1(TB) ; GET MACRO BODY + GETYP A,(C) + MOVE B,1(C) + MOVSI A,(A) + JSP E,CHKAB ; FIX DEFERS + MOVEM A,E.FCN(TB) + MOVEM B,E.FCN+1(TB) + JRST APLDIX + +; HERE TO APPLY EXPRS (FUNCTIONS) + +APEXPR: PUSHJ P,APEXP ; BIND ARGS AND AUX'S +RUNFUN: HRRZ A,RE.FCN(TB) ; AMOUNT OF FCN TO SKIP + MOVEI C,RE.FCN+1(TB) ; POINT TO FCN + HRRZ C,(C) ; SKIP SOMETHING + SOJGE A,.-1 ; UNTIL 1ST FORM + MOVEM C,RE.FCN+1(TB) ; AND STORE + JRST DOPROG ; GO RUN PROGRAM + +APEXP: SKIPN C,E.FCN+1(TB) ; CHECK FRO BODY + JRST NOBODY +APEXPF: PUSH P,[0] ; COUNT INIT CRAP + ADD TP,[XP.TMP,,XP.TMP] ; SLOTS FOR HACKING + SKIPL TP + PUSHJ P,TPOVFL + SETZM 1-XP.TMP(TP) ; ZERO OUT + MOVEI A,-XP.TMP+2(TP) + HRLI A,-1(A) + BLT A,(TP) ; ZERO SLOTS + SKIPG E.ARG+1(TB) + AOS E.CNT(TB) ; INDICATES IF MUST EVAL ARGS + MOVSI A,400000 ; MAKE E.ARG BE NEG FOR SAFE @ING + IORM A,E.ARG+1(TB) + PUSHJ P,CARATC ; SEE IF HEWITT ATOM EXISTS + JRST APEXP1 ; NO, GO LOOK FOR ARGLIST + MOVEM E,E.HEW+1(TB) ; SAVE ATOM + MOVSM 0,E.HEW(TB) ; AND TYPE + AOS (P) ; COUNT HEWITT ATOM +APEXP1: GETYP 0,(C) ; LOOK AT NEXT THING + CAIE 0,TLIST ; BETTER BE LIST!!! + JRST MPD.0 ; LOSE + MOVE B,1(C) ; GET LIST + MOVEM B,E.ARGL+1(TB) ; SAVE + MOVSM 0,E.ARGL(TB) ; WITH TYPE + HRRZ C,(C) ; CDR THE FCN + JUMPE C,NOBODY ; BODYLESS FCN + GETYP 0,(C) ; SEE IF DCL LIST SUPPLIED + CAIE 0,TDECL + JRST APEXP2 ; NO, START PROCESSING ARGS + AOS (P) ; COUNT DCL + MOVE B,1(C) + MOVEM B,E.DECL+1(TB) + MOVSM 0,E.DECL(TB) + HRRZ C,(C) ; CDR ON + JUMPE C,NOBODY + + ; CHECK FOR EXISTANCE OF EXTRA ARG + +APEXP2: POP P,A ; GET COUNT + HRRM A,E.FCN(TB) ; AND SAVE + SKIPN E.EXTR(TB) ; SKIP IF FUNNY EXTRA ARG EXISTS + JRST APEXP3 + MOVE 0,[SETZ EXTRGT] + EXCH 0,E.ARG+1(TB) + HRRM 0,E.ARG(TB) ; SAVE OLD GETTER AROUND + AOS E.CNT(TB) + +; FALL THROUGH + +; LOOK FOR "BIND" DECLARATION + +APEXP3: PUSHJ P,UNPROG ; UNASSIGN LPROG IF NEC +APXP3A: SKIPN A,E.ARGL+1(TB) ; GET ARGLIST + JRST APEXP4 ; NONE, VERIFY NONE WERE GIVEN + PUSHJ P,NXTDCL ; SEE IF A DECL IS THERE + JRST BNDRG ; NO, GO BIND NORMAL ARGS + HRRZ C,(A) ; CDR THE DCLS + CAME B,[ASCII /BIND/] + JRST CH.CAL ; GO LOOK FOR "CALL" + PUSHJ P,CARTMC ; MUST BE AN ATOM + MOVEM C,E.ARGL+1(TB) ; AND SAVE CDR'D ARGS + PUSHJ P,MAKENV ; GENERATE AN ENVIRONMENT + PUSHJ P,PSBND1 ; PUSH THE BINDING AND CHECK THE DCL + JRST APXP3A ; IN CASE <"BIND" B "BIND" C...... + + +; LOOK FOR "CALL" DCL + +CH.CAL: CAME B,[ASCII /CALL/] + JRST CHOPT ; TRY SOMETHING ELSE +; SKIPG E.ARG+1(TB) ; DONT SKIP IF CANT WIN + SKIPE E.CNT(TB) + JRST MPD.2 + PUSHJ P,CARTMC ; BETTER BE AN ATOM + MOVEM C,E.ARGL+1(TB) + MOVE A,E.FRM(TB) ; RETURN FORM + MOVE B,E.FRM+1(TB) + PUSHJ P,PSBND1 ; BIND AND CHECK + JRST APEXP5 + +; BIND NORMAL ARGS BY CALLING BNDEM1, RETURNS WHEN ALL DONE + +BNDRG: PUSHJ P,BNDEM1 ; GO BIND THEM UP + TRNN A,4 ; SKIP IF HIT A DCL + JRST APEXP4 ; NOT A DCL, MUST BE DONE + +; LOOK FOR "OPTIONAL" DECLARATION + +CHOPT: CAMN B,[] + JRST .+3 + CAME B,[+1] + JRST CHREST ; TRY TUPLE/ARGS + MOVEM C,E.ARGL+1(TB) ; SAVE RESTED ARGLIST + PUSHJ P,BNDEM2 ; DO ALL SUPPLIED OPTIONALS + TRNN A,4 ; SKIP IF NEW DCL READ + JRST APEXP4 + +; CHECK FOR "ARGS" DCL + +CHREST: CAME B,[ASCII /ARGS/] + JRST CHRST1 ; GO LOOK FOR "TUPLE" +; SKIPGE E.ARG+1(TB) ; SKIP IF LEGAL + SKIPE E.CNT(TB) + JRST MPD.3 + PUSHJ P,CARTMC ; GOBBLE ATOM + MOVEM C,E.ARGL+1(TB) ; SAVE CDR'D ARG + HRRZ B,@E.FRM+1(TB) ; GET ARG LIST + MOVSI A,TLIST ; GET TYPE + PUSHJ P,PSBND1 + JRST APEXP5 + +; HERE TO CHECK FOR "TUPLE" + +CHRST1: CAME B,[ASCII /TUPLE/] + JRST APXP10 + PUSHJ P,CARTMC ; GOBBLE ATOM + MOVEM C,E.ARGL+1(TB) + SETZB A,B + PUSHJ P,PSHBND ; SET UP BINDING + SETZM E.CNT+1(TB) ; ZERO ARG COUNTER + +TUPLP: PUSHJ P,@E.ARG+1(TB) ; GET AN ARG + JRST TUPDON ; FINIS + AOS E.CNT+1(TB) + PUSH TP,A + PUSH TP,B + JRST TUPLP + +TUPDON: PUSHJ P,MAKINF ; MAKE INFO CELL + PUSH TP,$TINFO ; FENCE POST TUPLE + PUSHJ P,TBTOTP + ADDI D,TM.OFF ; COMPENSATE FOR MOVEMENT + PUSH TP,D + MOVE C,E.CNT+1(TB) ; GET COUNT + ASH C,1 ; TO WORDS + HRRM C,-1(TP) ; INTO FENCE POST + MOVEI B,-TM.OFF-1(TP) ; SETUP ARG POINTER + SUBI B,(C) ; POINT TO BASE OF TUPLE + MOVNS C ; FOR AOBJN POINTER + HRLI B,(C) ; GOOD ARGS POINTER + MOVEM A,TM.OFF-4(B) ; STORE + MOVEM B,TM.OFF-3(B) + + +; CHECK FOR VALID ENDING TO ARGS + +APEXP5: PUSHJ P,NEXTD ; READ NEXT THING IN ARGLIST + JRST APEXP8 ; DONE + TRNN A,4 ; SKIP IF DCL + JRST MPD.4 ; LOSER +APEXP7: MOVSI A,-NWINS ; CHECK FOR A WINNER + CAME B,WINRS(A) + AOBJN A,.-1 + JUMPGE A,MPD.6 ; NOT A WINNER + +; HERE TO BLT THE WORLD DOWN ON TOP OF ALL THE USELESS TEMPS + +APEXP8: MOVE 0,E.HEW+1(TB) ; GET HEWITT ATOM + MOVE E,E.FCN(TB) ; SAVE COUNTER + MOVE C,E.FCN+1(TB) ; FCN + MOVE B,E.ARGL+1(TB) ; ARG LIST + MOVE D,E.DECL+1(TB) ; AND DCLS + MOVEI A,R.TMP(TB) ; SET UP BLT + HRLI A,TM.OFF(A) + BLT A,-TM.OFF(TP) ; BLLLLLLLLLLLLLT + SUB TP,[TM.OFF,,TM.OFF] ; FLUSH CRUFT + MOVEM E,RE.FCN(TB) + MOVEM C,RE.FCN+1(TB) + MOVEM B,RE.ARGL+1(TB) + MOVE E,TP + PUSH TP,$TATOM + PUSH TP,0 + PUSH TP,$TDECL + PUSH TP,D + GETYP A,-5(TP) ; TUPLE ON TOP? + CAIE A,TINFO ; SKIP IF YES + JRST APEXP9 + HRRZ A,-5(TP) ; GET SIZE + ADDI A,2 + HRLI A,(A) + SUB E,A ; POINT TO BINDINGS + SKIPE C,(TP) ; IF DCL + PUSHJ P,CHKDCL ; CHECK TYPE SPEC ON TUPLE +APEXP9: PUSHJ P,USPCBE ; DO ACTUAL BINDING + + MOVE E,-2(TP) ; RESTORE HEWITT ATOM + MOVE D,(TP) ; AND DCLS + SUB TP,[4,,4] + + JRST AUXBND ; GO BIND AUX'S + +; HERE TO VERIFY CHECK IF ANY ARGS LEFT + +APEXP4: PUSHJ P,@E.ARG+1(TB) + JRST APEXP8 ; WIN + JRST TMA ; TOO MANY ARGS + +APXP10: PUSH P,B + PUSHJ P,@E.ARG+1(TB) + JRST .+2 + JRST TMA + POP P,B + JRST APEXP7 + +; LIST OF POSSIBLE TERMINATING NAMES + +WINRS: +AS.ACT: ASCII /ACT/ +AS.NAM: ASCII /NAME/ +AS.AUX: ASCII /AUX/ +AS.EXT: ASCII /EXTRA/ +NWINS==.-WINRS + + +; HERE TO BIND AUX VARIABLES FOR PROGS AND FCNS + +AUXBND: PUSH P,E ; SAVE HEWITT ATOM ( WILL PUT ON MARKED STACK + ; WHEN NECESSARY) + PUSH P,D ; SAME WITH DCL LIST + PUSH P,[-1] ; FLAG SAYING WE ARE FCN + SKIPN C,RE.ARG+1(TB) ; GET ARG LIST + JRST AUXDON + GETYP 0,(C) ; GET TYPE + CAIE 0,TDEFER ; SKIP IF CHSTR + MOVMS (P) ; SAY WE ARE IN OPTIONALS + JRST AUXB1 + +PRGBND: PUSH P,E + PUSH P,D + PUSH P,[0] ; WE ARE IN AUXS + +AUXB1: HRRZ C,RE.ARG+1(TB) ; POINT TO ARGLIST + PUSHJ P,NEXTDC ; GET NEXT THING OFF OF ARG LIST + JRST AUXDON + TRNE A,4 ; SKIP IF SOME KIND OF ATOM + JRST TRYDCL ; COUDL BE DCL + TRNN A,1 ; SKIP IF QUOTED + JRST AUXB2 + SKIPN (P) ; SKIP IF QUOTED OK + JRST MPD.11 +AUXB2: PUSHJ P,PSHBND ; SET UP BINDING + PUSH TP,$TDECL ; SAVE HEWITT ATOM + PUSH TP,-1(P) + PUSH TP,$TATOM ; AND DECLS + PUSH TP,-2(P) + TRNN A,2 ; SKIP IF INIT VAL EXISTS + JRST AUXB3 ; NO, USE UNBOUND + +; EVALUATE EXPRESSION + + HRRZ C,(B) ; CDR ATOM OFF + +; CHECK FOR SPECIAL FORMS + + GETYP 0,(C) ; GET TYPE OF GOODIE + CAIE 0,TFORM ; SMELLS LIKE A FORM + JRST AUXB13 + HRRZ D,1(C) ; GET 1ST ELEMENT + GETYP 0,(D) ; AND ITS VAL + CAIE 0,TATOM ; FEELS LIKE THE RIGHT FORM + JRST AUXB13 + + MOVE 0,1(D) ; GET THE ATOM + CAME 0,IMQUOTE TUPLE + CAMN 0,MQUOTE ITUPLE + JRST DOTUPL ; SURE GLAD I DIDN'T STEP IN THAT FORM + + +AUXB13: PUSHJ P,FASTEV +AUXB14: MOVE E,TP +AUXB4: MOVEM A,-7(E) ; STORE VAL IN BINDING + MOVEM B,-6(E) + +; HERE TO CHECK AGAINST DECLARATIONS AND COMPLETE THE BINDING + +AUXB5: SUB E,[4,,4] ; POINT TO BINDING TOP + SKIPE C,-2(TP) ; POINT TO DECLARATINS + PUSHJ P,CHKDCL ; CHECK IT + PUSHJ P,USPCBE ; AND BIND UP + SKIPE C,RE.ARG+1(TB) ; CDR DCLS + HRRZ C,(C) ; IF ANY TO CDR + MOVEM C,RE.ARG+1(TB) + MOVE A,(TP) ; NOW PUT HEWITT ATOM AND DCL AWAY + MOVEM A,-2(P) + MOVE A,-2(TP) + MOVEM A,-1(P) + SUB TP,[4,,4] ; FLUSH SLOTS + JRST AUXB1 + + +AUXB3: MOVNI B,1 + MOVSI A,TUNBOU + JRST AUXB14 + + + +; HERE TO HANDLE "CALLS" TO TUPLE AND ITUPLE + +DOTUPL: SKIPE E,(P) ; SKIP IF IN AUX LIST + JRST TUPLE + PUSH TP,$TLIST ; SAVE THE MAGIC FORM + PUSH TP,D + CAME 0,IMQUOTE TUPLE + JRST DOITUP ; DO AN ITUPLE + +; FALL INTO A TUPLE PUSHING LOOP + +DOTUP1: HRRZ C,@(TP) ; CDR THE FORM + JUMPE C,ATUPDN ; FINISHED + MOVEM C,(TP) ; SAVE CDR'D RESULT + GETYP 0,(C) ; CHECK FOR SEGMENT + CAIN 0,TSEG + JRST DTPSEG ; GO PULL IT APART + PUSHJ P,FASTEV ; EVAL IT + PUSHJ P,CNTARG ; PUSH IT UP AND COUNT THEM + JRST DOTUP1 + +; HERE WHEN WE FINISH + +ATUPDN: SUB TP,[2,,2] ; FLUSH THE LIST + ASH E,1 ; E HAS # OF ARGS DOUBLE IT + MOVEI D,(TP) ; FIND BASE OF STACK AREA + SUBI D,(E) + MOVSI C,-3(D) ; PREPARE BLT POINTER + BLT C,C ; HEWITT ATOM AND DECL TO 0,A,B,C + +; NOW PREPEARE TO BLT TUPLE DOWN + + MOVEI D,-3(D) ; NEW DEST + HRLI D,4(D) ; SOURCE + BLT D,-4(TP) ; SLURP THEM DOWN + + HRLI E,TINFO ; SET UP FENCE POST + MOVEM E,-3(TP) ; AND STORE + PUSHJ P,TBTOTP ; GET OFFSET + ADDI D,3 ; FUDGE FOR NOT AT TOP OF STACK + MOVEM D,-2(TP) + MOVEM 0,-1(TP) ; RESTORE HEW ATOM AND DECLS + MOVEM A,(TP) + PUSH TP,B + PUSH TP,C + + PUSHJ P,MAKINF ; MAKE 1ST WORD OF FUNNYS + + HRRZ E,-5(TP) ; RESTORE WORDS OF TUPLE + HRROI B,-5(TP) ; POINT TO TOP OF TUPLE + SUBI B,(E) ; NOW BASE + TLC B,-1(E) ; FIX UP AOBJN PNTR + ADDI E,2 ; COPNESATE FOR FENCE PST + HRLI E,(E) + SUBM TP,E ; E POINT TO BINDING + JRST AUXB4 ; GO CLOBBER IT IN + + +; HERE TO HANDLE SEGMENTS IN THESE FUNNY FORMS + +DTPSEG: PUSH TP,$TFORM ; SAVE THE HACKER + PUSH TP,1(C) + MCALL 1,EVAL ; AND EVALUATE IT + MOVE D,B ; GET READY FOR A SEG LOOP + MOVEM A,DSTORE + PUSHJ P,TYPSEG ; TYPE AND CHECK IT + +DTPSG1: INTGO ; DONT BLOW YOUR STACK + PUSHJ P,NXTLM ; ELEMENT TO A AND B + JRST DTPSG2 ; DONE + PUSHJ P,CNTARG ; PUSH AND COUNT + JRST DTPSG1 + +DTPSG2: SETZM DSTORE + HRRZ E,-1(TP) ; GET COUNT IN CASE END + JRST DOTUP1 ; REST OF ARGS STILL TO DO + +; HERE TO HACK + +DOITUP: HRRZ C,@(TP) ; GET COUNT FILED + JUMPE C,TFA + MOVEM C,(TP) + PUSHJ P,FASTEV ; EVAL IT + GETYP 0,A + CAIE 0,TFIX + JRST WTY1TP + + JUMPL B,BADNUM + + HRRZ C,@(TP) ; GET EXP TO EVAL + MOVEI 0,0 ; DONT LOSE IN 1 ARG CASE + HRRZ 0,(C) ; VERIFY WINNAGE + JUMPN 0,TMA ; TOO MANY + + JUMPE B,DOIDON + PUSH P,B ; SAVE COUNT + PUSH P,B + JUMPE C,DOILOS + PUSHJ P,FASTEV ; EVAL IT ONCE + MOVEM A,-1(TP) + MOVEM B,(TP) + +DOILP: INTGO + PUSH TP,-1(TP) + PUSH TP,-1(TP) + MCALL 1,EVAL + PUSHJ P,CNTRG + SOSLE (P) + JRST DOILP + +DOIDO1: MOVE B,-1(P) ; RESTORE COUNT + SUB P,[2,,2] + +DOIDON: MOVEI E,(B) + JRST ATUPDN + +; FOR CASE OF NO EVALE + +DOILOS: SUB TP,[2,,2] +DOILLP: INTGO + PUSH TP,[0] + PUSH TP,[0] + SOSL (P) + JRST DOILLP + JRST DOIDO1 + +; ROUTINE TO PUSH NEXT TUPLE ELEMENT + +CNTARG: AOS E,-1(TP) ; KEEP ARG COUNT UP TO DATE IN E +CNTRG: EXCH A,-1(TP) ; STORE ELEM AND GET SAVED + EXCH B,(TP) + PUSH TP,A + PUSH TP,B + POPJ P, + + +; DUMMY TUPLE AND ITUPLE + +IMFUNCTION TUPLE,SUBR + + ENTRY + ERRUUO EQUOTE NOT-IN-AUX-LIST + +MFUNCTIO ITUPLE,SUBR + JRST TUPLE + + +; PROCESS A DCL IN THE AUX VAR LISTS + +TRYDCL: SKIPN (P) ; SKIP IF NOT IN AUX'S + JRST AUXB7 + CAME B,AS.AUX ; "AUX" ? + CAMN B,AS.EXT ; OR "EXTRA" + JRST AUXB9 ; YES + CAME B,[ASCII /TUPLE/] + JRST AUXB10 + PUSHJ P,MAKINF ; BUILD EMPTY TUPLE + MOVEI B,1(TP) + PUSH TP,$TINFO ; FENCE POST + PUSHJ P,TBTOTP + PUSH TP,D +AUXB6: HRRZ C,(C) ; CDR PAST DCL + MOVEM C,RE.ARG+1(TB) +AUXB8: PUSHJ P,CARTMC ; GET ATOM +AUXB12: PUSHJ P,PSHBND ; UP GOES THE BINDING + PUSH TP,$TATOM ; HIDE HEWITT ATOM AND DCL + PUSH TP,-1(P) + PUSH TP,$TDECL + PUSH TP,-2(P) + MOVE E,TP + JRST AUXB5 + +; CHECK FOR ARGS + +AUXB10: CAME B,[ASCII /ARGS/] + JRST AUXB7 + MOVEI B,0 ; NULL ARG LIST + MOVSI A,TLIST + JRST AUXB6 ; GO BIND + +AUXB9: SETZM (P) ; NOW READING AUX + HRRZ C,(C) + MOVEM C,RE.ARG+1(TB) + JRST AUXB1 + +; CHECK FOR NAME/ACT + +AUXB7: CAME B,AS.NAM + CAMN B,AS.ACT + JRST .+2 + JRST MPD.12 ; LOSER + HRRZ C,(C) ; CDR ON + HRRZ 0,(C) ; BETTER BE END + JUMPN 0,MPD.13 + PUSHJ P,CARTMC ; FORCE ATOM READ + SETZM RE.ARG+1(TB) +AUXB11: PUSHJ P,MAKACT ; MAKE ACTIVATION + JRST AUXB12 ; AND BIND IT + + +; DONE BIND HEWITT ATOM IF NECESARY + +AUXDON: SKIPN E,-2(P) + JRST AUXD1 + SETZM -2(P) + JRST AUXB11 + +; FINISHED, RETURN + +AUXD1: SUB P,[3,,3] + POPJ P, + + +; MAKE AN ACTIVATION OR ENVIRONMNENT + +MAKACT: MOVEI B,(TB) + MOVSI A,TACT +MAKAC1: MOVE PVP,PVSTOR+1 + HRRI A,PVLNT*2+1(PVP) ; POINT TO PROCESS + HLL B,OTBSAV(B) ; GET TIME + POPJ P, + +MAKENV: MOVSI A,TENV + HRRZ B,OTBSAV(TB) + JRST MAKAC1 + +; SEVERAL USEFUL LITTLE ROUTINES FOR HACKING THIS STUFF + +; CARAT/CARATC/CARATM/CARTMC ALL LOOK FOR THE NEXT ATOM + +CARAT: HRRZ C,E.ARGL+1(TB) ; PICK UP ARGLIST +CARATC: JUMPE C,CPOPJ ; FOUND + GETYP 0,(C) ; GET ITS TYPE + CAIE 0,TATOM +CPOPJ: POPJ P, ; RETURN, NOT ATOM + MOVE E,1(C) ; GET ATOM + HRRZ C,(C) ; CDR DCLS + JRST CPOPJ1 + +CARATM: HRRZ C,E.ARGL+1(TB) +CARTMC: PUSHJ P,CARATC + JRST MPD.7 ; REALLY LOSE + POPJ P, + + +; SUBROUTINES TO PUSH BINDINGS ETC. UP ON THE STACK + +PSBND1: PUSHJ P,PSHBND ; PUSH THEBINDING + JRST CHDCL ; NOW CHECK IT AGAINST DECLARATION + +PSHBND: SKIPGE SPCCHK ; SKIP IF NORMAL SPECIAL + PUSH TP,BNDA1 ; ATOM IN E + SKIPL SPCCHK ; SKIP IF NORMAL UNSPEC OR NO CHECK + PUSH TP,BNDA + PUSH TP,E ; PUSH IT +PSHAB4: PUSH TP,A + PUSH TP,B + PUSH TP,[0] + PUSH TP,[0] + POPJ P, + +; ROUTINE TO PUSH 4 0'S + +PSH4ZR: SETZB A,B + JRST PSHAB4 + + +; EXTRRA ARG GOBBLER + +EXTRGT: HRRZ A,E.ARG(TB) ; RESET SLOT + SETZM E.CNT(TB) + CAIE A,ARGCDR ; IF NOT ARGCDR + AOS E.CNT(TB) + TLO A,400000 ; SET FLAG + MOVEM A,E.ARG+1(TB) + MOVE A,E.EXTR(TB) ; RET ARG + MOVE B,E.EXTR+1(TB) + JRST CPOPJ1 + +; CHECK A/B FOR DEFER + +CHKAB: GETYP 0,A + CAIE 0,TDEFER ; SKIP IF DEFER + JRST (E) + MOVE A,(B) + MOVE B,1(B) ; GET REAL THING + JRST (E) +; IF DECLARATIONS EXIST, DO THEM + +CHDCL: MOVE E,TP +CHDCLE: SKIPN C,E.DECL+1(TB) + POPJ P, + JRST CHKDCL + +; ROUTINE TO READ NEXT THING FROM ARGLIST + +NEXTD: HRRZ C,E.ARGL+1(TB) ; GET ARG LIST +NEXTDC: MOVEI A,0 + JUMPE C,CPOPJ + PUSHJ P,CARATC ; TRY FOR AN ATOM + JRST NEXTD1 ; NO + JRST CPOPJ1 + +NEXTD1: CAIE 0,TFORM ; FORM? + JRST NXT.L ; COULD BE LIST + PUSHJ P,CHQT ; VERIFY 'ATOM + MOVEI A,1 + JRST CPOPJ1 + +NXT.L: CAIE 0,TLIST ; COULD BE (A ) OR ('A ) + JRST NXT.S ; BETTER BE A DCL + PUSHJ P,LNT.2 ; VERIFY LENGTH IS 2 + JRST MPD.8 + CAIE 0,TATOM ; TYPE OF 1ST RET IN 0 + JRST LST.QT ; MAY BE 'ATOM + MOVE E,1(B) ; GET ATOM + MOVEI A,2 + JRST CPOPJ1 +LST.QT: CAIE 0,TFORM ; FORM? + JRST MPD.9 ; LOSE + PUSH P,C + MOVEI C,(B) ; VERIFY 'ATOM + PUSHJ P,CHQT + MOVEI B,(C) ; POINT BACK TO LIST + POP P,C + MOVEI A,3 ; CODE + JRST CPOPJ1 + +NXT.S: MOVEI A,(C) ; LET NXTDCL FIND OUT + PUSHJ P,NXTDCL + JRST MPD.3 ; LOSER + MOVEI A,4 ; SET DCL READ FLAG + JRST CPOPJ1 + +; ROUTINE TO CHECK LENGTH OF LIST/FORM FOR BEING 2 + +LNT.2: HRRZ B,1(C) ; GET LIST/FORM + JUMPE B,CPOPJ + HRRZ B,(B) + JUMPE B,CPOPJ + HRRZ B,(B) ; BETTER END HERE + JUMPN B,CPOPJ + HRRZ B,1(C) ; LIST BACK + GETYP 0,(B) ; TYPE OF 1ST ELEMENT + JRST CPOPJ1 + +; ROUTINE TO VERIFY FORM IS 'ATOM AND RET ATOM + +CHQT: PUSHJ P,LNT.2 ; 1ST LENGTH CHECK + JRST MPD.5 + CAIE 0,TATOM + JRST MPD.5 + MOVE 0,1(B) + CAME 0,IMQUOTE QUOTE + JRST MPD.5 ; BETTER BE QUOTE + HRRZ E,(B) ; CDR + GETYP 0,(E) ; TYPE + CAIE 0,TATOM + JRST MPD.5 + MOVE E,1(E) ; GET QUOTED ATOM + POPJ P, + +; ARG BINDER FOR REGULAR ARGS AND OPTIONALS + +BNDEM1: PUSH P,[0] ; REGULAR FLAG + JRST .+2 +BNDEM2: PUSH P,[1] +BNDEM: PUSHJ P,NEXTD ; GET NEXT THING + JRST CCPOPJ ; END OF THINGS + TRNE A,4 ; CHECK FOR DCL + JRST BNDEM4 + TRNE A,2 ; SKIP IF NOT (ATM ..) OR ('ATM ...) + SKIPE (P) ; SKIP IF REG ARGS + JRST .+2 ; WINNER, GO ON + JRST MPD.6 ; LOSER + SKIPGE SPCCHK + PUSH TP,BNDA1 ; SAVE ATOM + SKIPL SPCCHK + PUSH TP,BNDA + PUSH TP,E +; SKIPGE E.ARG+1(TB) ; ALREADY EVAL'D ARG? + SKIPE E.CNT(TB) + JRST RGLAR0 + TRNN A,1 ; SKIP IF ARG QUOTED + JRST RGLARG + HRRZ D,@E.FRM+1(TB) ; GET AND CDR ARG + JUMPE D,TFACHK ; OH OH MAYBE TOO FEW ARGS + MOVEM D,E.FRM+1(TB) ; STORE WINNER + HLLZ A,(D) ; GET ARG + MOVE B,1(D) + JSP E,CHKAB ; HACK DEFER + JRST BNDEM3 ; AND GO ON + +RGLAR0: TRNE A,1 ; ATTEMPT TO QUOTE ALREADY EVAL'D ARG ? + JRST MPD ; YES, LOSE +RGLARG: PUSH P,A ; SAVE FLAGS + PUSHJ P,@E.ARG+1(TB) + JRST TFACH1 ; MAY GE TOO FEW + SUB P,[1,,1] +BNDEM3: HRRZ C,@E.ARGL+1(TB) ; CDR THHE ARGS + MOVEM C,E.ARGL+1(TB) + PUSHJ P,PSHAB4 ; PUSH VALUE AND SLOTS + PUSHJ P,CHDCL ; CHECK DCLS + JRST BNDEM ; AND BIND ON! + +; HERE WHEN ARGS RUN OUT, IF NOT OPTIONAL, GIVE TFA + +TFACH1: POP P,A +TFACHK: SUB TP,[2,,2] ; FLUSH ATOM + SKIPN (P) ; SKIP IF OPTIONALS + JRST TFA +CCPOPJ: SUB P,[1,,1] + POPJ P, + +BNDEM4: HRRZ C,@E.ARGL+1(TB) ; POINT TO REST OF ARGL + JRST CCPOPJ + + +; EVALUATE LISTS, VECTORS, UNIFROM VECTORS + +EVLIST: PUSH P,[-1] ;-1 -- THIS IS A LIST + JRST EVL1 ;GO TO HACKER + +EVECT: PUSH P,[0] ;0 -- THIS IS A GENERAL VECTOR + JRST EVL1 + +EUVEC: PUSH P,[1] ;1 -- THIS IS A UNIFORM VECTOR + +EVL1: PUSH P,[0] ;PUSH A COUNTER + GETYPF A,(AB) ;GET FULL TYPE + PUSH TP,A + PUSH TP,1(AB) ;AND VALUE + +EVL2: INTGO ;CHECK INTERRUPTS + SKIPN A,1(TB) ;ANYMORE + JRST EVL3 ;NO, QUIT + SKIPL -1(P) ;SKIP IF LIST + JUMPG A,EVL3 ;JUMP IF VECTOR EMPTY + GETYPF B,(A) ;GET FULL TYPE + SKIPGE C,-1(P) ;SKIP IF NOT LIST + HLLZS B ;CLOBBER CDR FIELD + JUMPG C,EVL7 ;HACK UNIFORM VECS +EVL8: PUSH P,B ;SAVE TYPE WORD ON P + CAMN B,$TSEG ;SEGMENT? + MOVSI B,TFORM ;FAKE OUT EVAL + PUSH TP,B ;PUSH TYPE + PUSH TP,1(A) ;AND VALUE + JSP E,CHKARG ; CHECK DEFER + MCALL 1,EVAL ;AND EVAL IT + POP P,C ;AND RESTORE REAL TYPE + CAMN C,$TSEG ;SEGMENT? + JRST DOSEG ;YES, HACK IT + AOS (P) ;COUNT ELEMENT + PUSH TP,A ;AND PUSH IT + PUSH TP,B +EVL6: SKIPGE A,-1(P) ;DONT SKIP IF LIST + HRRZ B,@1(TB) ;CDR IT + JUMPL A,ASTOTB ;AND STORE IT + MOVE B,1(TB) ;GET VECTOR POINTER + ADD B,AMNT(A) ;INCR BY APPROPRIATE AMOUNT +ASTOTB: MOVEM B,1(TB) ;AND STORE BACK + JRST EVL2 ;AND LOOP BACK + +AMNT: 2,,2 ;INCR FOR GENERAL VECTOR + 1,,1 ;SAME FOR UNIFORM VECTOR + +CHKARG: GETYP A,-1(TP) + CAIE A,TDEFER + JRST (E) + HRRZS (TP) ;MAKE SURE INDIRECT WINS + MOVE A,@(TP) + MOVEM A,-1(TP) ;CLOBBER IN TYPE SLOT + MOVE A,(TP) ;NOW GET POINTER + MOVE A,1(A) ;GET VALUE + MOVEM A,(TP) ;CLOBBER IN + JRST (E) + + + +EVL7: HLRE C,A ; FIND TYPE OF UVECTOR + SUBM A,C ;C POINTS TO DOPE WORD + GETYP B,(C) ;GET TYPE + MOVSI B,(B) ;TO LH NOW + SOJA A,EVL8 ;AND RETURN TO DO EVAL + +EVL3: SKIPL -1(P) ;SKIP IF LIST + JRST EVL4 ;EITHER VECTOR OR UVECTOR + + MOVEI B,0 ;GET A NIL +EVL9: MOVSI A,TLIST ;MAKE TYPE WIN +EVL5: SOSGE (P) ;COUNT DOWN + JRST EVL10 ;DONE, RETURN + PUSH TP,$TLIST ;SET TO CALL CONS + PUSH TP,B + MCALL 2,CONS + JRST EVL5 ;LOOP TIL DONE + + +EVL4: MOVEI B,EUVECT ;UNIFORM CASE + SKIPG -1(P) ;SKIP IF UNIFORM CASE + MOVEI B,EVECTO ;NO, GENERAL CASE + POP P,A ;GET COUNT + .ACALL A,(B) ;CALL CREATOR +EVL10: GETYPF A,(AB) ; USE SENT TYPE + JRST EFINIS + + +; PROCESS SEGMENTS FOR THESE HACKS + +DOSEG: PUSHJ P,TYPSEG ; FIND WHAT IS BEING SEGMENTED + JUMPE C,LSTSEG ; CHECK END SPLICE IF LIST + +SEG3: PUSHJ P,NXTELM ; GET THE NEXTE ELEMT + JRST SEG4 ; RETURN TO CALLER + AOS (P) ; COUNT + JRST SEG3 ; TRY AGAIN +SEG4: SETZM DSTORE + JRST EVL6 + +TYPSEG: PUSHJ P,TYPSGR + JRST ILLSEG + POPJ P, + +TYPSGR: MOVE E,A ; SAVE TYPE + GETYP A,A ; TYPE TO RH + PUSHJ P,SAT ;GET STORAGE TYPE + MOVE D,B ; GOODIE TO D + + MOVNI C,1 ; C <0 IF ILLEGAL + CAIN A,S2WORD ;LIST? + MOVEI C,0 + CAIN A,S2NWORD ;GENERAL VECTOR? + MOVEI C,1 + CAIN A,SNWORD ;UNIFORM VECTOR? + MOVEI C,2 + CAIN A,SCHSTR + MOVEI C,3 + CAIN A,SBYTE + MOVEI C,5 + CAIN A,SSTORE ;SPECIAL AFREE STORAGE ? + MOVEI C,4 ;TREAT LIKE A UVECTOR + CAIN A,SARGS ;ARGS TUPLE? + JRST SEGARG ;NO, ERROR + CAILE A,NUMSAT ; SKIP IF NOT TEMPLATE + JRST SEGTMP + MOVE A,PTYPS(C) + CAIN A,4 + MOVEI A,2 ; NOW TREAT LIKE A UVECTOR + HLL E,A +MSTOR1: JUMPL C,CPOPJ + +MDSTOR: MOVEM E,DSTORE + JRST CPOPJ1 + +SEGTMP: MOVEI C,4 + HRRI E,(A) + JRST MSTOR1 + +SEGARG: MOVSI A,TARGS + HRRI A,(E) + PUSH TP,A ;PREPARE TO CHECK ARGS + PUSH TP,D + MOVEI B,-1(TP) ;POINT TO SAVED COPY + PUSHJ P,CHARGS ;CHECK ARG POINTER + POP TP,D ;AND RESTORE WINNER + POP TP,E ;AND TYPE AND FALL INTO VECTOR CODE + MOVEI C,1 + JRST MSTOR1 + +LSTSEG: SKIPL -1(P) ;SKIP IF IN A LIST + JRST SEG3 ;ELSE JOIN COMMON CODE + HRRZ A,@1(TB) ;CHECK FOR END OF LIST + JUMPN A,SEG3 ;NO, JOIN COMMON CODE + SETZM DSTORE ;CLOBBER SAVED GOODIES + JRST EVL9 ;AND FINISH UP + +NXTELM: INTGO + PUSHJ P,NXTLM ; GOODIE TO A AND B + POPJ P, ; DONE + PUSH TP,A + PUSH TP,B + JRST CPOPJ1 +NXTLM: XCT TESTR(C) ; SKIP IF MORE IN SEGEMNT + POPJ P, + XCT TYPG(C) ; GET THE TYPE + XCT VALG(C) ; AND VALUE + JSP E,CHKAB ; CHECK DEFERRED + XCT INCR1(C) ; AND INCREMENT TO NEXT +CPOPJ1: AOS (P) ; SKIP RETURN + POPJ P, + +; TABLES FOR SEGMENT OPERATIONS (0->LIST, 1->VECTOR/ARGS, 2->UVEC, 3->STRING) + +PTYPS: TLIST,, + TVEC,, + TUVEC,, + TCHSTR,, + TSTORA,, + TBYTE,, + +TESTR: SKIPN D + SKIPL D + SKIPL D + PUSHJ P,CHRDON + PUSHJ P,TM1 + PUSHJ P,CHRDON + +TYPG: PUSHJ P,LISTYP + GETYPF A,(D) + PUSHJ P,UTYPE + MOVSI A,TCHRS + PUSHJ P,TM2 + MOVSI A,TFIX + +VALG: MOVE B,1(D) + MOVE B,1(D) + MOVE B,(D) + PUSHJ P,1CHGT + PUSHJ P,TM3 + PUSHJ P,1CHGT + +INCR1: HRRZ D,(D) + ADD D,[2,,2] + ADD D,[1,,1] + PUSHJ P,1CHINC + ADD D,[1,,] + PUSHJ P,1CHINC + +TM1: HRRZ A,DSTORE + SKIPE DSTORE + HRRZ A,DSTORE ; GET SAT + SUBI A,NUMSAT+1 + ADD A,TD.LNT+1 + EXCH C,D + XCT (A) + HLRZ 0,C ; GET AMNT RESTED + SUB B,0 + EXCH C,D + TRNE B,-1 + AOS (P) + POPJ P, + +TM3: +TM2: HRRZ 0,DSTORE + SKIPE DSTORE + HRRZ 0,DSTORE + PUSH P,C + PUSH P,D + PUSH P,E + MOVE B,D + MOVEI C,0 ; GET "1ST ELEMENT" + PUSHJ P,TMPLNT ; GET NTH IN A AND B + POP P,E + POP P,D + POP P,C + POPJ P, + +CHRDON: HRRZ B,DSTORE + SKIPE DSTORE + HRRZ B,DSTORE ; POIT TO DOPE WORD + JUMPE B,CHRFIN + AOS (P) +CHRFIN: POPJ P, + +LISTYP: GETYP A,(D) + MOVSI A,(A) + POPJ P, +1CHGT: MOVE B,D + ILDB B,B + POPJ P, + +1CHINC: IBP D + SKIPN DSTORE + JRST 1CHIN1 + SOS DSTORE + POPJ P, + +1CHIN1: SOS DSTORE + POPJ P, + +UTYPE: HLRE A,D + SUBM D,A + GETYP A,(A) + MOVSI A,(A) + POPJ P, + + +;COMPILER's CALL TO DOSEG +SEGMNT: PUSHJ P,TYPSEG +SEGLP1: SETZB A,B +SEGLOP: PUSHJ P,NXTELM + JRST SEGRET + AOS (P)-2 ; INCREMENT COMPILER'S COUNT + JRST SEGLOP + +SEGRET: SETZM DSTORE + POPJ P, + +SEGLST: PUSHJ P,TYPSEG + JUMPN C,SEGLS2 +SEGLS3: SETZM DSTORE + MOVSI A,TLIST +SEGLS1: SOSGE -2(P) ; START COUNT DOWN + POPJ P, + MOVEI E,(B) + POP TP,D + POP TP,C + PUSHJ P,ICONS + JRST SEGLS1 + +SEGLS2: PUSHJ P,NXTELM + JRST SEGLS4 + AOS -2(P) + JRST SEGLS2 + +SEGLS4: MOVEI B,0 + JRST SEGLS3 + + +;SPECBIND BINDS IDENTIFIERS. IT IS CALLED BY PUSHJ P,SPECBIND. +;SPECBIND IS PROVIDED WITH A CONTIGUOUS SET OF TRIPLETS ON TP. +;EACH TRIPLET IS AS FOLLOWS: +;THE FIRST ELEMENT IS THE IDENTIFIER TO BE BOUND, ITS TYPE WORD IS [TATOM,,-1], +;THE SECOND IS THE VALUE TO WHICH IT IS TO BE ASSIGNED, +;AND THE THIRD IS A PAIR OF ZEROES. + +BNDA1: TATOM,,-2 +BNDA: TATOM,,-1 +BNDV: TVEC,,-1 + +USPECBIND: + MOVE E,TP +USPCBE: PUSH P,$TUBIND + JRST .+3 + +SPECBIND: + MOVE E,TP ;GET THE POINTER TO TOP +SPECBE: PUSH P,$TBIND + ADD E,[1,,1] ;BUMP POINTER ONCE + SETZB 0,D ;CLEAR TEMPS + PUSH P,0 + MOVEI 0,(TB) ; FOR CHECKS + +BINDLP: MOVE A,-4(E) ; CHECK FOR VEC BIND + CAMN A,BNDV + JRST NONID + MOVE A,-6(E) ;GET TYPE + CAME A,BNDA1 ; FOR UNSPECIAL + CAMN A,BNDA ;NORMAL ID BIND? + CAILE 0,-6(E) ; MAKE SURE NOT GOING UNDER FRAME + JRST SPECBD + SUB E,[6,,6] ;MOVE PTR + SKIPE D ;LINK? + HRRM E,(D) ;YES -- LOBBER + SKIPN (P) ;UPDATED? + MOVEM E,(P) ;NO -- DO IT + + MOVE A,0(E) ;GET ATOM PTR + MOVE B,1(E) + PUSHJ P,SILOC ;GET LAST BINDING + MOVS A,OTBSAV (TB) ;GET TIME + HRL A,5(E) ; GET DECL POINTER + MOVEM A,4(E) ;CLOBBER IT AWAY + MOVE A,(E) ; SEE IF SPEC/UNSPEC + TRNN A,1 ; SKIP, ALWAYS SPEC + SKIPA A,-1(P) ; USE SUPPLIED + MOVSI A,TBIND + MOVEM A,(E) ;IDENTIFY AS BIND BLOCK + JUMPE B,SPEB10 + MOVE PVP,PVSTOR+1 + HRRZ C,SPBASE(PVP) ; CHECK FOR CROSS OF PROC + MOVEI A,(TP) + CAIL A,(B) ; LOSER + CAILE C,(B) ; SKIP IFF WINNER + MOVEI B,1 +SPEB10: MOVEM B,5(E) ;IN RESTORE CELLS + + MOVE C,1(E) ;GET ATOM PTR + SKIPE (C) + JUMPE B,.-4 + MOVEI A,(C) + MOVEI B,0 ; FOR SPCUNP + CAIL A,HIBOT ; SKIP IF IMPURE ATOM + PUSHJ P,SPCUNP + MOVE PVP,PVSTOR+1 + HRRZ A,BINDID+1(PVP) ;GET PROCESS NUMBER + HRLI A,TLOCI ;MAKE LOC PTR + MOVE B,E ;TO NEW VALUE + ADD B,[2,,2] + MOVEM A,(C) ;CLOBBER ITS VALUE + MOVEM B,1(C) ;CELL + MOVE D,E ;REMEMBER LINK + JRST BINDLP ;DO NEXT + +NONID: CAILE 0,-4(E) + JRST SPECBD + SUB E,[4,,4] + SKIPE D + HRRM E,(D) + SKIPN (P) + MOVEM E,(P) + + MOVE D,1(E) ;GET PTR TO VECTOR + MOVE C,(D) ;EXCHANGE TYPES + EXCH C,2(E) + MOVEM C,(D) + + MOVE C,1(D) ;EXCHANGE DATUMS + EXCH C,3(E) + MOVEM C,1(D) + + MOVEI A,TBVL + HRLM A,(E) ;IDENTIFY BIND BLOCK + MOVE D,E ;REMEMBER LINK + JRST BINDLP + +SPECBD: SKIPE D + MOVE SP,SPSTOR+1 + HRRM SP,(D) + SKIPE D,(P) + MOVEM D,SPSTOR+1 + SUB P,[2,,2] + POPJ P, + + +; HERE TO IMPURIFY THE ATOM + +SPCUNP: PUSH TP,$TSP + PUSH TP,E + PUSH TP,$TSP + PUSH TP,-1(P) ; LINK BACK IS AN SP + PUSH TP,$TSP + PUSH TP,B + CAIN B,1 + SETZM -1(TP) ; FIXUP SOME FUNNYNESS + MOVE B,C + PUSHJ P,IMPURIFY + MOVE 0,-2(TP) ; RESTORE LINK BACK POINTER + MOVEM 0,-1(P) + MOVE E,-4(TP) + MOVE C,B + MOVE B,(TP) + SUB TP,[6,,6] + MOVEI 0,(TB) + POPJ P, + +; ENTRY FROM COMPILER TO SET UP A BINDING + +IBIND: MOVE SP,SPSTOR+1 + SUBI E,-5(SP) ; CHANGE TO PDL POINTER + HRLI E,(E) + ADD E,SP + MOVEM C,-4(E) + MOVEM A,-3(E) + MOVEM B,-2(E) + HRLOI A,TATOM + MOVEM A,-5(E) + MOVSI A,TLIST + MOVEM A,-1(E) + MOVEM D,(E) + JRST SPECB1 ; NOW BIND IT + +; "FAST CALL TO SPECBIND" + + + +; Compiler's call to SPECBIND all atom bindings, no TBVLs etc. + +SPECBND: + MOVE E,TP ; POINT TO BINDING WITH E +SPECB1: PUSH P,[0] ; SLOTS OF INTEREST + PUSH P,[0] + SUBM M,-2(P) + +SPECB2: MOVEI 0,(TB) ; FOR FRAME CHECK + MOVE A,-5(E) ; LOOK AT FIRST THING + CAMN A,BNDA ; SKIP IF LOSER + CAILE 0,-5(E) ; SKIP IF REAL WINNER + JRST SPECB3 + + SUB E,[5,,5] ; POINT TO BINDING + SKIPE A,(P) ; LINK? + HRRM E,(A) ; YES DO IT + SKIPN -1(P) ; FIRST ONE? + MOVEM E,-1(P) ; THIS IS IT + + MOVE A,1(E) ; POINT TO ATOM + MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; QUICK CHECK + HRLI 0,TLOCI + CAMN 0,(A) ; WINNERE? + JRST SPECB4 ; YES, GO ON + + PUSH P,B ; SAVE REST OF ACS + PUSH P,C + PUSH P,D + MOVE B,A ; FOR ILOC TO WORK + PUSHJ P,SILOC ; GO LOOK IT UP + JUMPE B,SPECB9 + MOVE PVP,PVSTOR+1 + HRRZ C,SPBASE+1(PVP) + MOVEI A,(TP) + CAIL A,(B) ; SKIP IF LOSER + CAILE C,(B) ; SKIP IF WINNER + MOVEI B,1 ; SAY NO BACK POINTER +SPECB9: MOVE C,1(E) ; POINT TO ATOM + SKIPE (C) ; IF GLOBALLY BOUND, MAKE SURE OK + JUMPE B,.-3 + MOVEI A,(C) ; PURE ATOM? + CAIGE A,HIBOT ; SKIP IF OK + JRST .+4 + PUSH P,-4(P) ; MAKE HAPPINESS + PUSHJ P,SPCUNP ; IMPURIFY + POP P,-5(P) + MOVE PVP,PVSTOR+1 + MOVE A,BINDID+1(PVP) + HRLI A,TLOCI + MOVEM A,(C) ; STOR POINTER INDICATOR + MOVE A,B + POP P,D + POP P,C + POP P,B + JRST SPECB5 + +SPECB4: MOVE A,1(A) ; GET LOCATIVE +SPECB5: EXCH A,5(E) ; CLOBBER INTO REBIND SLOT (GET DECL) + HLL A,OTBSAV(TB) ; TIME IT + MOVSM A,4(E) ; SAVE DECL AND TIME + MOVEI A,TBIND + HRLM A,(E) ; CHANGE TO A BINDING + MOVE A,1(E) ; POINT TO ATOM + MOVEM E,(P) ; REMEMBER THIS GUY + ADD E,[2,,2] ; POINT TO VAL CELL + MOVEM E,1(A) ; INTO ATOM SLOT + SUB E,[3,,3] ; POINT TO NEXT ONE + JRST SPECB2 + +SPECB3: SKIPE A,(P) + MOVE SP,SPSTOR+1 + HRRM SP,(A) ; LINK OLD STUFF + SKIPE A,-1(P) ; NEW SP? + MOVEM A,SPSTOR+1 + SUB P,[2,,2] + INTGO ; IN CASE BLEW STACK + SUBM M,(P) + POPJ P, + + +;SPECSTORE RESTORES THE BINDINGS SP TO THE ENVIRONMENT POINTER IN +;SPSAV (TB). IT IS CALLED BY PUSHJ P,SPECSTORE. + +SPECSTORE: + PUSH P,E + HRRZ E,SPSAV (TB) ;GET TARGET POINTER + PUSHJ P,STLOOP + POP P,E + MOVE SP,SPSAV(TB) ; GET NEW SP + MOVEM SP,SPSTOR+1 + POPJ P, + +STLOOP: MOVE SP,SPSTOR+1 + PUSH P,D + PUSH P,C + +STLOO1: CAIL E,(SP) ;ARE WE DONE? + JRST STLOO2 + HLRZ C,(SP) ;GET TYPE OF BIND + CAIN C,TUBIND + JRST .+3 + CAIE C,TBIND ;NORMAL IDENTIFIER? + JRST ISTORE ;NO -- SPECIAL HACK + + + MOVE C,1(SP) ;GET TOP ATOM + MOVSI 0,TLOCI ; MAYBE LOCI OR UNBOUND + SKIPL D,5(SP) + MOVSI 0,TUNBOU + MOVE PVP,PVSTOR+1 + HRR 0,BINDID+1(PVP) ;STORE SIGNATURE + SKIPN 5(SP) + MOVEI 0,0 ; TOTALLY UNBOUND IN ALL CASES + MOVEM 0,(C) ;CLOBBER INTO ATOM + MOVEM D,1(C) + SETZM 4(SP) +SPLP: HRRZ SP,(SP) ;FOLOW LINK + JUMPN SP,STLOO1 ;IF MORE + SKIPE E ; OK IF E=0 + FATAL SP OVERPOP +STLOO2: MOVEM SP,SPSTOR+1 + POP P,C + POP P,D + POPJ P, + +ISTORE: CAIE C,TBVL + JRST CHSKIP + MOVE C,1(SP) + MOVE D,2(SP) + MOVEM D,(C) + MOVE D,3(SP) + MOVEM D,1(C) + JRST SPLP + +CHSKIP: CAIN C,TSKIP + JRST SPLP + CAIE C,TUNWIN ; UNWIND HACK + FATAL BAD SP + HRRZ C,-2(P) ; WHERE FROM? + CAIE C,CHUNPC + JRST SPLP ; IGNORE + MOVEI E,(TP) ; FIXUP SP + SUBI E,(SP) + MOVSI E,(E) + HLL SP,TP + SUB SP,E + POP P,C + POP P,D + AOS (P) + POPJ P, + +; ENTRY FOR FUNNY COMPILER UNBIND (1) + +SSPECS: PUSH P,E + MOVEI E,(TP) + PUSHJ P,STLOOP +SSPEC2: SUBI E,(SP) ; MAKE SP BE AOBJN + MOVSI E,(E) + HLL SP,TP + SUB SP,E + MOVEM SP,SPSTOR+1 + POP P,E + POPJ P, + +; ENTRY FOR FUNNY COMPILER UNBIND (2) + +SSPEC1: PUSH P,E + SUBI E,1 ; MAKE SURE GET CURRENT BINDING + PUSHJ P,STLOOP ; UNBIND + MOVEI E,(TP) ; NOW RESET SP + JRST SSPEC2 + +EFINIS: MOVE PVP,PVSTOR+1 + SKIPN C,1STEPR+1(PVP) ; SKIP NIF BEING ONE PROCEEDED + JRST FINIS + PUSH TP,$TATOM + PUSH TP,MQUOTE EVLOUT + PUSH TP,A ;SAVE EVAL RESULTS + PUSH TP,B + PUSH TP,[TINFO,,2] ; FENCE POST + PUSHJ P,TBTOTP + PUSH TP,D + PUSHJ P,MAKINF ; MAKE ARG BLOCK INFO + PUSH TP,A + MOVEI B,-6(TP) + HRLI B,-4 ; AOBJN TO ARGS BLOCK + PUSH TP,B + MOVE PVP,PVSTOR+1 + PUSH TP,1STEPR(PVP) + PUSH TP,1STEPR+1(PVP) ; PROCESS DOING THE 1STEPPING + MCALL 2,RESUME + MOVE A,-3(TP) ; GET BACK EVAL VALUE + MOVE B,-2(TP) + JRST FINIS + +1STEPI: PUSH TP,$TATOM + PUSH TP,MQUOTE EVLIN + PUSH TP,$TAB ; PUSH EVALS ARGGS + PUSH TP,AB + PUSHJ P,MAKINF ; TURN INTO ARGS BLOCK + MOVEM A,-1(TP) ; AND CLOBBER + PUSH TP,[TINFO,,2] ; FENCE POST 2D TUPLE + PUSHJ P,TBTOTP + PUSH TP,D + PUSHJ P,MAKINF ; TURN IT INTO ARGS BLOCK + PUSH TP,A + MOVEI B,-6(TP) ; SETUP TUPLE + HRLI B,-4 + PUSH TP,B + MOVE PVP,PVSTOR+1 + PUSH TP,1STEPR(PVP) + PUSH TP,1STEPR+1(PVP) + MCALL 2,RESUME ; START UP 1STEPERR + SUB TP,[6,,6] ; REMOVE CRUD + GETYP A,A ; GET 1STEPPERS TYPE + CAIE A,TDISMI ; IF DISMISS, STOP 1 STEPPING + JRST EVALON + +; HERE TO PUSH DOWN THE 1 STEP STATE AND RUN + + MOVE D,PVP + ADD D,[1STEPR,,1STEPR] ; POINT TO 1 STEP SLOT + PUSH TP,$TSP ; SAVE CURRENT SP + PUSH TP,SPSTOR+1 + PUSH TP,BNDV + PUSH TP,D ; BIND IT + PUSH TP,$TPVP + PUSH TP,[0] ; NO 1 STEPPER UNTIL POPJ + PUSHJ P,SPECBIND + +; NOW PUSH THE ARGS UP TO RE-CALL EVAL + + MOVEI A,0 +EFARGL: JUMPGE AB,EFCALL + PUSH TP,(AB) + PUSH TP,1(AB) + ADD AB,[2,,2] + AOJA A,EFARGL + +EFCALL: ACALL A,EVAL ; NOW DO THE EVAL + MOVE C,(TP) ; PRE-UNBIND + MOVE PVP,PVSTOR+1 + MOVEM C,1STEPR+1(PVP) + MOVE SP,-4(TP) ; AVOID THE UNBIND + MOVEM SP,SPSTOR+1 + SUB TP,[6,,6] ; AND FLUSH LOSERS + JRST EFINIS ; AND TRY TO FINISH UP + +MAKINF: HLRZ A,OTBSAV(TB) ; TIME IT + HRLI A,TARGS + POPJ P, + + +TBTOTP: MOVEI D,(TB) ; COMPUTE REL DIST FROM TP TO TB + SUBI D,(TP) + POPJ P, +; ARRIVE HERE TO COMPLETE A COMPILER GENERATED TUPLE +; D/ LENGTH OF THE TUPLE IN WORDS + +MAKTU2: MOVE D,-1(P) ; GET LENGTH + ASH D,1 + PUSHJ P,MAKTUP + PUSH TP,A + PUSH TP,B + POPJ P, + +MAKTUP: HRLI D,TINFO ; FIRST WORD OF FENCE POST + PUSH TP,D + HRROI B,(TP) ; TOP OF TUPLE + SUBI B,(D) + TLC B,-1(D) ; AOBJN IT + PUSHJ P,TBTOTP + PUSH TP,D + HLRZ A,OTBSAV(TB) ; TIME IT + HRLI A,TARGS + POPJ P, + +; HERE TO ALLOCATE SLOTS FOR COMPILER (AMNT IN A) + +TPALOC: SUBM M,(P) + ;Once here ==>ADDI A,1 Bug??? + HRLI A,(A) + ADD TP,A + PUSH P,A + SKIPL TP + PUSHJ P,TPOVFL ; IN CASE IT LOST + INTGO ; TAKE THE GC IF NEC + HRRI A,2(TP) + SUB A,(P) + SETZM -1(A) + HRLI A,-1(A) + BLT A,(TP) + SUB P,[1,,1] + JRST POPJM + + +NTPALO: PUSH TP,[0] + SOJG 0,.-1 + POPJ P, + + ;EVALUATES A IDENTIFIER -- GETS LOCAL VALUE IF THERE IS ONE, OTHERWISE GLOBAL. + +IMFUNCTION VALUE,SUBR + JSP E,CHKAT + PUSHJ P,IDVAL + JRST FINIS + +IDVAL: PUSHJ P,IDVAL1 + CAMN A,$TUNBOU + JRST UNBOU + POPJ P, + +IDVAL1: PUSH TP,A + PUSH TP,B ;SAVE ARG IN CASE NEED TO CHECK GLOBAL VALUE + PUSHJ P,ILVAL ;LOCAL VALUE FINDER + CAME A,$TUNBOUND ;IF NOT UNBOUND OR UNASSIGNED + JRST RIDVAL ;DONE - CLEAN UP AND RETURN + POP TP,B ;GET ARG BACK + POP TP,A + JRST IGVAL +RIDVAL: SUB TP,[2,,2] + POPJ P, + +;GETS THE LOCAL VALUE OF AN IDENTIFIER + +IMFUNCTION LVAL,SUBR + JSP E,CHKAT + PUSHJ P,AILVAL + CAME A,$TUNBOUND + JRST FINIS + JUMPN B,UNAS + JRST UNBOU + +; MAKE AN ATOM UNASSIGNED + +MFUNCTION UNASSIGN,SUBR + JSP E,CHKAT ; GET ATOM ARG + PUSHJ P,AILOC +UNASIT: CAMN A,$TUNBOU ; IF UNBOUND + JRST RETATM + MOVSI A,TUNBOU + MOVEM A,(B) + SETOM 1(B) ; MAKE SURE +RETATM: MOVE B,1(AB) + MOVE A,(AB) + JRST FINIS + +; UNASSIGN GLOBALLY + +MFUNCTION GUNASSIGN,SUBR + JSP E,CHKAT2 + PUSHJ P,IGLOC + CAMN A,$TUNBOU + JRST RETATM + MOVE B,1(AB) ; ATOM BACK + MOVEI 0,(B) + CAIL 0,HIBOT ; SKIP IF IMPURE + PUSHJ P,IMPURIFY ; YES, MAKE IT IMPURE + PUSHJ P,IGLOC ; RESTORE LOCATIVE + HRRZ 0,-2(B) ; SEE IF MANIFEST + GETYP A,(B) ; AND CURRENT TYPE + CAIN 0,-1 + CAIN A,TUNBOU + JRST UNASIT + SKIPE IGDECL + JRST UNASIT + MOVE D,B + JRST MANILO + +; GETS A LOCATIVE TO THE LOCAL VALUE OF AN IDENTIFIER. + +MFUNCTION LLOC,SUBR + JSP E,CHKAT + PUSHJ P,AILOC + CAMN A,$TUNBOUND + JRST UNBOU + MOVSI A,TLOCD + HRR A,2(B) + JRST FINIS + +;TESTS TO SEE IF AN IDENTIFIER IS LOCALLY BOUND + +MFUNCTION BOUND,SUBR,[BOUND?] + JSP E,CHKAT + PUSHJ P,AILVAL + CAMN A,$TUNBOUND + JUMPE B,IFALSE + JRST TRUTH + +;TESTS TO SEE IF AN IDENTIFIER IS LOCALLY ASSIGNED + +MFUNCTION ASSIGP,SUBR,[ASSIGNED?] + JSP E,CHKAT + PUSHJ P,AILVAL + CAME A,$TUNBOUND + JRST TRUTH +; JUMPE B,UNBOU + JRST IFALSE + +;GETS THE GLOBAL VALUE OF AN IDENTIFIER + +IMFUNCTION GVAL,SUBR + JSP E,CHKAT2 + PUSHJ P,IGVAL + CAMN A,$TUNBOUND + JRST UNAS + JRST FINIS + +;GETS A LOCATIVE TO THE GLOBAL VALUE OF AN IDENTIFIER + +MFUNCTION RGLOC,SUBR + + JRST GLOC + +MFUNCTION GLOC,SUBR + + JUMPGE AB,TFA + CAMGE AB,[-5,,] + JRST TMA + JSP E,CHKAT1 + MOVEI E,IGLOC + CAML AB,[-2,,] + JRST .+4 + GETYP 0,2(AB) + CAIE 0,TFALSE + MOVEI E,IIGLOC + PUSHJ P,(E) + CAMN A,$TUNBOUND + JRST UNAS + MOVSI A,TLOCD + HRRZ 0,FSAV(TB) + CAIE 0,GLOC + MOVSI A,TLOCR + CAIE 0,GLOC + SUB B,GLOTOP+1 + MOVE C,1(AB) ; GE ATOM + MOVEI 0,(C) + CAIGE 0,HIBOT ; SKIP IF PURE ATOM + JRST FINIS + +; MAKE ATOM AND VALUE IMPURE IF GETTING GLOC TO IT + + MOVE B,C ; ATOM TO B + PUSHJ P,IMPURIFY + JRST GLOC ; AND TRY AGAIN + +;TESTS TO SEE IF AN IDENTIFIER IS GLOBALLY ASSIGNED + +MFUNCTION GASSIG,SUBR,[GASSIGNED?] + JSP E,CHKAT2 + PUSHJ P,IGVAL + CAMN A,$TUNBOUND + JRST IFALSE + JRST TRUTH + +; TEST FOR GLOBALLY BOUND + +MFUNCTION GBOUND,SUBR,[GBOUND?] + + JSP E,CHKAT2 + PUSHJ P,IGLOC + JUMPE B,IFALSE + JRST TRUTH + + + +CHKAT2: ENTRY 1 +CHKAT1: GETYP A,(AB) + MOVSI A,(A) + CAME A,$TATOM + JRST NONATM + MOVE B,1(AB) + JRST (E) + +CHKAT: HLRE A,AB ; - # OF ARGS + ASH A,-1 ; TO ACTUAL WORDS + JUMPGE AB,TFA + MOVE C,SPSTOR+1 ; FOR BINDING LOOKUPS + AOJE A,CHKAT1 ; ONLY ONE ARG, NO ENVIRONMENT + AOJL A,TMA ; TOO MANY + GETYP A,2(AB) ; MAKE SURE OF TENV OR TFRAME + CAIE A,TFRAME + CAIN A,TENV + JRST CHKAT3 + CAIN A,TACT ; FOR PFISTERS LOSSAGE + JRST CHKAT3 + CAIE A,TPVP ; OR PROCESS + JRST WTYP2 + MOVE B,3(AB) ; GET PROCESS + MOVE C,SPSTOR+1 ; IN CASE ITS ME + CAME B,PVSTOR+1 ; SKIP IF DIFFERENT + MOVE C,SPSTO+1(B) ; GET ITS SP + JRST CHKAT1 +CHKAT3: MOVEI B,2(AB) ; POINT TO FRAME POINTER + PUSHJ P,CHFRM ; VALIDITY CHECK + MOVE B,3(AB) ; GET TB FROM FRAME + MOVE C,SPSAV(B) ; GET ENVIRONMENT POINTER + JRST CHKAT1 + + +; SILOC--CALLS ILOC IGNORING SPECIAL CHECKING + +SILOC: JFCL + +;ILOC RETURNS IN A AND B A LOCATIVE TO THE LOCAL VALUE OF THE IDENTIFIER +; PASSED TO IT IN A AND B. IF THE IDENTIFIER IS LOCALLY UNBOUND IT RETURNS +; $TUNBOUND IN A AND 0 IN B, IT IS CALLED BY PUSHJ P,ILOC. + +ILOC: MOVE C,SPSTOR+1 ; SETUP SEARCH START +AILOC: SKIPN (B) ; ANY KIND OF VALUE AT ALL? + JUMPN B,FUNPJ + MOVSI A,TLOCI ;MAKE A LOCATIVE TYPE CELL + PUSH P,E + PUSH P,D + MOVEI E,0 ; FLAG TO CLOBBER ATOM + JUMPE B,SCHSP ; IF LOOKING FOR SLOT, SEARCH NOW + CAME C,SPSTOR+1 ; ENVIRONMENT CHANGE? + JRST SCHSP ; YES, MUST SEARCH + MOVE PVP,PVSTOR+1 + HRR A,BINDID+1(PVP) ;FOR THE CURRENT PROCESS + CAME A,(B) ;IS THERE ONE IN THE VALUE CELL? + JRST SCHLP ;NO -- SEARCH THE LOCAL BINDINGS + MOVE B,1(B) ;YES -- GET LOCATIVE POINTER + MOVE C,PVP +ILCPJ: MOVE E,SPCCHK + TRNN E,1 ; SKIP IF DOING SPEC UNSPEC CHECK + JRST ILOCPJ + HRRZ E,-2(P) ; IF IGNORING, IGNORE + HRRZ E,-1(E) + CAIN E,SILOC + JRST ILOCPJ + HLRZ E,-2(B) + CAIE E,TUBIND + JRST ILOCPJ + CAMGE B,CURFCN+1(PVP) + JRST SCHLPX + MOVEI D,-2(B) + HRRZ SP,SPSTOR+1 + CAIG D,(SP) + CAMGE B,SPBASE+1(PVP) + JRST SCHLPX + MOVE C,PVSTOR+1 +ILOCPJ: POP P,D + POP P,E + POPJ P, ;FROM THE VALUE CELL + +SCHLPX: MOVEI E,1 + MOVE C,SPSTOR+1 + MOVE B,-1(B) + JRST SCHLP + + +SCHLP5: SETOM (P) + JRST SCHLP2 + +SCHLP: MOVEI D,(B) + CAIL D,HIBOT ; SKIP IF IMPURE ATOM +SCHSP: MOVEI E,1 ; DONT STORE LOCATIVE + + PUSH P,E ; PUSH SWITCH + MOVE E,PVSTOR+1 ; GET PROC +SCHLP1: JUMPE C,UNPJ ;IF NO MORE -- LOSE + CAMN B,1(C) ;ARE WE POINTING AT THE WINNER? + JRST SCHFND ;YES + GETYP D,(C) ; CHECK SKIP + CAIE D,TSKIP + JRST SCHLP2 + PUSH P,B ; CHECK DETOUR + MOVEI B,2(C) + PUSHJ P,CHFRAM ; NON-FATAL FRAME CHECKER + HRRZ E,2(C) ; CONS UP PROCESS + SUBI E,PVLNT*2+1 + HRLI E,-2*PVLNT + JUMPE B,SCHLP3 ; LOSER, FIX IT + POP P,B + MOVEI C,1(C) ; FOLLOW LOOKUP CHAIN +SCHLP2: HRRZ C,(C) ;FOLLOW LINK + JRST SCHLP1 + +SCHLP3: POP P,B + HRRZ SP,SPSTOR+1 + MOVEI C,(SP) ; *** NDR'S BUG *** + CAME E,PVSTOR+1 ; USE IF CURRENT PROCESS + HRRZ C,SPSTO+1(E) ; USE CURRENT SP FOR PROC + JRST SCHLP1 + +SCHFND: MOVE D,SPCCHK + TRNN D,1 ; SKIP IF DOING SPEC UNSPEC CHECK + JRST SCHFN1 + HRRZ D,-2(P) ; IF IGNORING, IGNORE + HRRZ D,-1(D) + CAIN D,SILOC + JRST ILOCPJ + HLRZ D,(C) + CAIE D,TUBIND + JRST SCHFN1 + HRRZ D,CURFCN+1(PVP) + CAIL D,(C) + JRST SCHLP5 + HRRZ SP,SPSTOR+1 + HRRZ D,SPBASE+1(PVP) + CAIL SP,(C) + CAIL D,(C) + JRST SCHLP5 + +SCHFN1: EXCH B,C ;SAVE THE ATOM PTR IN C + MOVEI B,2(B) ;MAKE UP THE LOCATIVE + SUB B,TPBASE+1(E) + HRLI B,(B) + ADD B,TPBASE+1(E) + EXCH C,E ; RET PROCESS IN C + POP P,D ; RESTORE SWITCH + + JUMPN D,ILOCPJ ; DONT CLOBBER ATOM + MOVEM A,(E) ;CLOBBER IT AWAY INTO THE + MOVE D,1(E) ; GET OLD POINTER + MOVEM B,1(E) ;ATOM'S VALUE CELL + JUMPE D,ILOCPJ ; IF POINTS TO GLOBAL OR OTHER PROCES + ; MAKE SURE BINDING SO INDICATES + MOVE D,B ; POINT TO BINDING + SKIPL E,3(D) ; GO TO FIRST ONE, JUST IN CASE + JRST .+3 + MOVE D,E + JRST .-3 ; LOOP THROUGH + MOVEI E,1 + MOVEM E,3(D) ; MAGIC INDICATION + JRST ILOCPJ + +UNPJ: SUB P,[1,,1] ; FLUSH CRUFT +UNPJ1: MOVE C,E ; RET PROCESS ANYWAY +UNPJ11: POP P,D + POP P,E +UNPOPJ: MOVSI A,TUNBOUND + MOVEI B,0 + POPJ P, + +FUNPJ: MOVE C,PVSTOR+1 + JRST UNPOPJ + +;IGLOC RETURNS IN A AND B A LOCATIVE TO THE GLOBAL VALUE OF THE +;IDENTIFIER PASSED TO IT IN A AND B. IF THE IDENTIFIER IS GLOBALLY +;UNBPOUND IT RETURNS $TUNBOUND IN A AND 0 IN B. IT IS CALLED BY PUSHJ P,IGLOC. + +IGLOC: MOVSI A,TLOCI ;DO WE HAVE A LOCATIVE TO + CAME A,(B) ;A PROCESS #0 VALUE? + JRST SCHGSP ;NO -- SEARCH + MOVE B,1(B) ;YES -- GET VALUE CELL + POPJ P, + +SCHGSP: SKIPN (B) + JRST UNPOPJ + MOVE D,GLOBSP+1 ;GET GLOBAL SP PTR + +SCHG1: JUMPGE D,UNPOPJ ;IF NO MORE, LEAVE + CAMN B,1(D) ;ARE WE FOUND? + JRST GLOCFOUND ;YES + ADD D,[4,,4] ;NO -- TRY NEXT + JRST SCHG1 + +GLOCFOUND: + EXCH B,D ;SAVE ATOM PTR + ADD B,[2,,2] ;MAKE LOCATIVE + MOVEI 0,(D) + CAIL 0,HIBOT + POPJ P, + MOVEM A,(D) ;CLOBBER IT AWAY + MOVEM B,1(D) + POPJ P, + +IIGLOC: PUSH TP,$TATOM + PUSH TP,B + PUSHJ P,IGLOC + MOVE C,(TP) + SUB TP,[2,,2] + GETYP 0,A + CAIE 0,TUNBOU + POPJ P, + PUSH TP,$TATOM + PUSH TP,C + MOVEI 0,(C) + MOVE B,C + CAIL 0,$TLOSE + PUSHJ P,IMPURI ; IMPURIFY THE POOR ATOM + PUSHJ P,BSETG ; MAKE A SLOT + SETOM 1(B) ; UNBOUNDIFY IT + MOVSI A,TLOCD + MOVSI 0,TUNBOU + MOVEM 0,(B) + SUB TP,[2,,2] + POPJ P, + + + +;ILVAL RETURNS IN A AND B THE LOCAL VALUE OF THE IDENTIFIER PASSED TO IT IN A AND B +;IF THE IDENTIFIER IS UNBOUND ITS VALUE IS $TUNBOUND IN A AND 0 IN B. IF +;IT IS UNASSIGNED ITS VALUE IS $TUNBOUND IN A AND -1 IN B. CALL - PUSHJ P,IVAL + +AILVAL: + PUSHJ P,AILOC ; USE SUPPLIED SP + JRST CHVAL +ILVAL: + PUSHJ P,ILOC ;GET LOCATIVE TO VALUE +CHVAL: CAMN A,$TUNBOUND ;BOUND + POPJ P, ;NO -- RETURN + MOVSI A,TLOCD ; GET GOOD TYPE + HRR A,2(B) ; SHOULD BE TIME OR 0 + PUSH P,0 + PUSHJ P,RMONC0 ; CHECK READ MONITOR + POP P,0 + MOVE A,(B) ;GET THE TYPE OF THE VALUE + MOVE B,1(B) ;GET DATUM + POPJ P, + +;IGVAL -- LIKE ILVAL EXCEPT FOR GLOBAL VALUES + +IGVAL: PUSHJ P,IGLOC + JRST CHVAL + + + +; COMPILERS INTERFACE TO LVAL/GVAL/SETG/SET + +CILVAL: MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; CURRENT BIND + HRLI 0,TLOCI + CAME 0,(B) ; HURRAY FOR SPEED + JRST CILVA1 ; TOO BAD + MOVE C,1(B) ; POINTER + MOVE A,(C) ; VAL TYPE + TLNE A,.RDMON ; MONITORS? + JRST CILVA1 + GETYP 0,A + CAIN 0,TUNBOU + JRST CUNAS ; COMPILER ERROR + MOVE B,1(C) ; GOT VAL + MOVE 0,SPCCHK + TRNN 0,1 + POPJ P, + HLRZ 0,-2(C) ; SPECIAL CHECK + CAIE 0,TUBIND + POPJ P, ; RETURN + MOVE PVP,PVSTOR+1 + CAMGE C,CURFCN+1(PVP) + JRST CUNAS + POPJ P, + +CUNAS: +CILVA1: SUBM M,(P) ; FIX (P) + PUSH TP,$TATOM ; SAVE ATOM + PUSH TP,B + MCALL 1,LVAL ; GET ERROR/MONITOR + +POPJM: SUBM M,(P) ; REPAIR DAMAGE + POPJ P, + +; COMPILERS INTERFACE TO SET C/ ATOM A,B/ NEW VALUE + +CISET: MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; CURRENT BINDING ENVIRONMENT + HRLI 0,TLOCI + CAME 0,(C) ; CAN WE WIN? + JRST CISET1 ; NO, MORE HAIR + MOVE D,1(C) ; POINT TO SLOT +CISET3: HLLZ 0,(D) ; MON CHECK + TLNE 0,.WRMON + JRST CISET4 ; YES, LOSE + TLZ 0,TYPMSK + IOR A,0 ; LEAVE MONITOR ON + MOVE 0,SPCCHK + TRNE 0,1 + JRST CISET5 ; SPEC/UNSPEC CHECK +CISET6: MOVEM A,(D) ; STORE + MOVEM B,1(D) + POPJ P, + +CISET5: HLRZ 0,-2(D) + CAIE 0,TUBIND + JRST CISET6 + MOVE PVP,PVSTOR+1 + CAMGE D,CURFCN+1(PVP) + JRST CISET4 + JRST CISET6 + +CISET1: SUBM M,(P) ; FIX ADDR + PUSH TP,$TATOM ; SAVE ATOM + PUSH TP,C + PUSH TP,A + PUSH TP,B + MOVE B,C ; GET ATOM + PUSHJ P,ILOC ; SEARCH + MOVE D,B ; POSSIBLE POINTER + GETYP E,A + MOVE 0,A + MOVE A,-1(TP) ; VAL BACK + MOVE B,(TP) + CAIE E,TUNBOU ; SKIP IF WIN + JRST CISET2 ; GO CLOBBER IT IN + MCALL 2,SET + JRST POPJM + +CISET2: MOVE C,-2(TP) ; ATOM BACK + SUBM M,(P) ; RESET (P) + SUB TP,[4,,4] + JRST CISET3 + +; HERE TO DO A MONITORED SET + +CISET4: SUBM M,(P) ; AGAIN FIX (P) + PUSH TP,$TATOM + PUSH TP,C + PUSH TP,A + PUSH TP,B + MCALL 2,SET + JRST POPJM + +; COMPILER LLOC + +CLLOC: MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; GET CURRENT LOCATIVE + HRLI 0,TLOCI + CAME 0,(B) ; WIN? + JRST CLLOC1 + MOVE B,1(B) + MOVE 0,SPCCHK + TRNE 0,1 ; SKIP IF NOT CHECKING + JRST CLLOC9 +CLLOC3: MOVSI A,TLOCD + HRR A,2(B) ; GET BIND TIME + POPJ P, + +CLLOC1: SUBM M,(P) + PUSH TP,$TATOM + PUSH TP,B + PUSHJ P,ILOC ; LOOK IT UP + JUMPE B,CLLOC2 + SUB TP,[2,,2] +CLLOC4: SUBM M,(P) + JRST CLLOC3 + +CLLOC2: MCALL 1,LLOC + JRST CLLOC4 + +CLLOC9: HLRZ 0,-2(B) + CAIE 0,TUBIND + JRST CLLOC3 + MOVE PVP,PVSTOR+1 + CAMGE B,CURFCN+1(PVP) + JRST CLLOC2 + JRST CLLOC3 + +; COMPILER BOUND? + +CBOUND: SUBM M,(P) + PUSHJ P,ILOC + JUMPE B,PJFALS ; IF UNBOUND RET FALSE AND NO SSKIP +PJT1: SOS (P) + MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST POPJM + +PJFALS: MOVEI B,0 + MOVSI A,TFALSE + JRST POPJM + +; COMPILER ASSIGNED? + +CASSQ: SUBM M,(P) + PUSHJ P,ILOC + JUMPE B,PJFALS + GETYP 0,(B) + CAIE 0,TUNBOU + JRST PJT1 + JRST PJFALS + + +; COMPILER GVAL B/ ATOM + +CIGVAL: MOVE 0,(B) ; GLOBAL VAL HERE? + CAME 0,$TLOCI ; TIME=0 ,TYPE=TLOCI => GLOB VAL + JRST CIGVA1 ; NO, GO LOOK + MOVE C,1(B) ; POINT TO SLOT + MOVE A,(C) ; GET TYPE + TLNE A,.RDMON + JRST CIGVA1 + GETYP 0,A ; CHECK FOR UNBOUND + CAIN 0,TUNBOU ; SKIP IF WINNER + JRST CGUNAS + MOVE B,1(C) + POPJ P, + +CGUNAS: +CIGVA1: SUBM M,(P) + PUSH TP,$TATOM + PUSH TP,B + .MCALL 1,GVAL ; GET ERROR/MONITOR + JRST POPJM + +; COMPILER INTERFACET TO SETG + +CSETG: MOVE 0,(C) ; GET V CELL + CAME 0,$TLOCI ; SKIP IF FAST + JRST CSETG1 + HRRZ D,1(C) ; POINT TO SLOT + MOVE 0,(D) ; OLD VAL +CSETG3: CAIG D,HIBOT ; SKIP IF PURE ATOM + TLNE 0,.WRMON ; MONITOR + JRST CSETG2 + MOVEM A,(D) + MOVEM B,1(D) + POPJ P, + +CSETG1: SUBM M,(P) ; FIX UP P + PUSH TP,$TATOM + PUSH TP,C + PUSH TP,A + PUSH TP,B + MOVE B,C + PUSHJ P,IGLOC ; FIND GLOB LOCATIVE + GETYP E,A + MOVE 0,A + MOVEI D,(B) ; SETUP TO RESTORE NEW VAL + MOVE A,-1(TP) + MOVE B,(TP) + CAIE E,TUNBOU + JRST CSETG4 + MCALL 2,SETG + JRST POPJM + +CSETG4: MOVE C,-2(TP) ; ATOM BACK + SUBM M,(P) ; RESET (P) + SUB TP,[4,,4] + JRST CSETG3 + +CSETG2: SUBM M,(P) + PUSH TP,$TATOM ; CAUSE A SETG MONITOR + PUSH TP,C + PUSH TP,A + PUSH TP,B + MCALL 2,SETG + JRST POPJM + +; COMPILER GLOC + +CGLOC: MOVE 0,(B) ; GET CURRENT GUY + CAME 0,$TLOCI ; WIN? + JRST CGLOC1 ; NOPE + HRRZ D,1(B) ; POINT TO SLOT + CAILE D,HIBOT ; PURE? + JRST CGLOC1 + MOVE A,$TLOCD + MOVE B,1(B) + POPJ P, + +CGLOC1: SUBM M,(P) + PUSH TP,$TATOM + PUSH TP,B + MCALL 1,GLOC + JRST POPJM + +; COMPILERS GASSIGNED? + +CGASSQ: MOVE 0,(B) + SUBM M,(P) + CAMN 0,$TLOCD + JRST PJT1 + PUSHJ P,IGLOC + JUMPE B,PJFALS + GETYP 0,(B) + CAIE 0,TUNBOU + JRST PJT1 + JRST PJFALS + +; COMPILERS GBOUND? + +CGBOUN: MOVE 0,(B) + SUBM M,(P) + CAMN 0,$TLOCD + JRST PJT1 + PUSHJ P,IGLOC + JUMPE B,PJFALS + JRST PJT1 + + +IMFUNCTION REP,FSUBR,[REPEAT] + JRST PROG +MFUNCTION BIND,FSUBR + JRST PROG +IMFUNCTION PROG,FSUBR + ENTRY 1 + GETYP A,(AB) ;GET ARG TYPE + CAIE A,TLIST ;IS IT A LIST? + JRST WRONGT ;WRONG TYPE + SKIPN C,1(AB) ;GET AND CHECK ARGUMENT + JRST TFA ;TOO FEW ARGS + SETZB E,D ; INIT HEWITT ATOM AND DECL + PUSHJ P,CARATC ; IS 1ST THING AN ATOM + JFCL + PUSHJ P,RSATY1 ; CDR AND GET TYPE + CAIE 0,TLIST ; MUST BE LIST + JRST MPD.13 + MOVE B,1(C) ; GET ARG LIST + PUSH TP,$TLIST + PUSH TP,C + PUSHJ P,RSATYP + CAIE 0,TDECL + JRST NOP.DC ; JUMP IF NO DCL + MOVE D,1(C) + MOVEM C,(TP) + PUSHJ P,RSATYP ; CDR ON +NOP.DC: PUSH TP,$TLIST + PUSH TP,B ; AND ARG LIST + PUSHJ P,PRGBND ; BIND AUX VARS + HRRZ E,FSAV(TB) + CAIE E,BIND + SKIPA E,IMQUOTE LPROG,[LPROG ]INTRUP + JRST .+3 + PUSHJ P,MAKACT ; MAKE ACTIVATION + PUSHJ P,PSHBND ; BIND AND CHECK + PUSHJ P,SPECBI ; NAD BIND IT + +; HERE TO RUN PROGS FUNCTIONS ETC. + +DOPROG: MOVEI A,REPROG + HRLI A,TDCLI ; FLAG AS FUNNY + MOVEM A,(TB) ; WHERE TO AGAIN TO + MOVE C,1(TB) + MOVEM C,3(TB) ; RESTART POINTER + JRST .+2 ; START BY SKIPPING DECL + +DOPRG1: PUSHJ P,FASTEV + HRRZ C,@1(TB) ;GET THE REST OF THE BODY +DOPRG2: MOVEM C,1(TB) + JUMPN C,DOPRG1 +ENDPROG: + HRRZ C,FSAV(TB) + CAIN C,REP +REPROG: SKIPN C,@3(TB) + JRST PFINIS + HRRZM C,1(TB) + INTGO + MOVE C,1(TB) + JRST DOPRG1 + + +PFINIS: GETYP 0,(TB) + CAIE 0,TDCLI ; DECL'D ? + JRST PFINI1 + HRRZ 0,(TB) ; SEE IF RSUBR + JUMPE 0,RSBVCK ; CHECK RSUBR VALUE + HRRZ C,3(TB) ; GET START OF FCN + GETYP 0,(C) ; CHECK FOR DECL + CAIE 0,TDECL + JRST PFINI1 ; NO, JUST RETURN + MOVE E,IMQUOTE VALUE + PUSHJ P,PSHBND ; BUILD FAKE BINDING + MOVE C,1(C) ; GET DECL LIST + MOVE E,TP + PUSHJ P,CHKDCL ; AND CHECK IT + MOVE A,-3(TP) ; GET VAL BAKC + MOVE B,-2(TP) + SUB TP,[6,,6] + +PFINI1: HRRZ C,FSAV(TB) + CAIE C,EVAL + JRST FINIS + JRST EFINIS + +RSATYP: HRRZ C,(C) +RSATY1: JUMPE C,TFA + GETYP 0,(C) + POPJ P, + +; HERE TO CHECK RSUBR VALUE + +RSBVCK: PUSH TP,A + PUSH TP,B + MOVE C,A + MOVE D,B + MOVE A,1(TB) ; GET DECL + MOVE B,1(A) + HLLZ A,(A) + PUSHJ P,TMATCH + JRST RSBVC1 + POP TP,B + POP TP,A + POPJ P, + +RSBVC1: MOVE C,1(TB) + POP TP,B + POP TP,D + MOVE A,IMQUOTE VALUE + JRST TYPMIS + + +MFUNCTION MRETUR,SUBR,[RETURN] + ENTRY + HLRE A,AB ; GET # OF ARGS + ASH A,-1 ; TO NUMBER + AOJL A,RET2 ; 2 OR MORE ARGS + PUSHJ P,PROGCH ;CHECK IN A PROG + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) ; VERIFY IT +COMRET: PUSHJ P,CHFSWP + SKIPL C ; ARGS? + MOVEI C,0 ; REAL NONE + PUSHJ P,CHUNW + JUMPN A,CHFINI ; WINNER + MOVSI A,TATOM + MOVE B,IMQUOTE T + +; SEE IF MUST CHECK RETURNS TYPE + +CHFINI: GETYP 0,(TB) ; SPECIAL TYPE IF SO + CAIE 0,TDCLI + JRST FINIS ; NO, JUST FINIS + MOVEI 0,PFINIS ; CAUSE TO FALL INTO FUNCTION CODE + HRRM 0,PCSAV(TB) + JRST CONTIN + + +RET2: AOJL A,TMA + GETYP A,(AB)+2 + CAIE A,TACT ; AS FOR "EXIT" SHOULD BE ACTIVATION + JRST WTYP2 + MOVEI B,(AB)+2 ; ADDRESS OF FRAME POINTER + JRST COMRET + + + +MFUNCTION AGAIN,SUBR + ENTRY + HLRZ A,AB ;GET # OF ARGS + CAIN A,-2 ;1 ARG? + JRST NLCLA ;YES + JUMPN A,TMA ;0 ARGS? + PUSHJ P,PROGCH ;CHECK FOR IN A PROG + PUSH TP,A + PUSH TP,B + JRST AGAD +NLCLA: GETYP A,(AB) + CAIE A,TACT + JRST WTYP1 + PUSH TP,(AB) + PUSH TP,1(AB) +AGAD: MOVEI B,-1(TP) ; POINT TO FRAME + PUSHJ P,CHFSWP + HRRZ C,(B) ; GET RET POINT +GOJOIN: PUSH TP,$TFIX + PUSH TP,C + MOVEI C,-1(TP) + PUSHJ P,CHUNW ; RESTORE FRAME, UNWIND IF NEC. + HRRM B,PCSAV(TB) + HRRZ 0,FSAV(TB) ; CHECK FOR RSUBR + CAIGE 0,HIBOT + CAIGE 0,STOSTR + JRST CONTIN + HRRZ E,1(TB) + PUSH TP,$TFIX + PUSH TP,B + MOVEI C,-1(TP) + MOVEI B,(TB) + PUSHJ P,CHUNW1 + MOVE TP,1(TB) + MOVE SP,SPSTOR+1 + MOVEM SP,SPSAV(TB) + MOVEM TP,TPSAV(TB) + MOVE C,OTBSAV(TB) ; AND RESTORE P FROM FATHER + MOVE P,PSAV(C) + MOVEM P,PSAV(TB) + SKIPGE PCSAV(TB) + HRLI B,400000+M + MOVEM B,PCSAV(TB) + JRST CONTIN + +MFUNCTION GO,SUBR + ENTRY 1 + GETYP A,(AB) + CAIE A,TATOM + JRST NLCLGO + PUSHJ P,PROGCH ;CHECK FOR A PROG + PUSH TP,A ;SAVE + PUSH TP,B + MOVEI B,-1(TP) + PUSHJ P,CHFSWP + PUSH TP,$TATOM + PUSH TP,1(C) + PUSH TP,2(B) + PUSH TP,3(B) + MCALL 2,MEMQ ;DOES IT HAVE THIS TAG? + JUMPE B,NXTAG ;NO -- ERROR +FNDGO: EXCH B,(TP) ;SAVE PLACE TO GO + MOVSI D,TLIST + MOVEM D,-1(TP) + JRST GODON + +NLCLGO: CAIE A,TTAG ;CHECK TYPE + JRST WTYP1 + MOVE B,1(AB) + MOVEI B,2(B) ; POINT TO SLOT + PUSHJ P,CHFSWP + MOVE A,1(C) + GETYP 0,(A) ; SEE IF COMPILED + CAIE 0,TFIX + JRST GODON1 + MOVE C,1(A) + JRST GOJOIN + +GODON1: PUSH TP,(A) ;SAVE BODY + PUSH TP,1(A) +GODON: MOVEI C,0 + PUSHJ P,CHUNW ;GO BACK TO CORRECT FRAME + MOVE B,(TP) ;RESTORE ITERATION MARKER + MOVEM B,1(TB) + MOVSI A,TATOM + MOVE B,1(B) + JRST CONTIN + + + + +MFUNCTION TAG,SUBR + ENTRY + JUMPGE AB,TFA + HLRZ 0,AB + GETYP A,(AB) ;GET TYPE OF ARGUMENT + CAIE A,TFIX ; FIX ==> COMPILED + JRST ATOTAG + CAIE 0,-4 + JRST WNA + GETYP A,2(AB) + CAIE A,TACT + JRST WTYP2 + PUSH TP,(AB) + PUSH TP,1(AB) + PUSH TP,2(AB) + PUSH TP,3(AB) + JRST GENTV +ATOTAG: CAIE A,TATOM ;CHECK THAT IT IS AN ATOM + JRST WTYP1 + CAIE 0,-2 + JRST TMA + PUSHJ P,PROGCH ;CHECK PROG + PUSH TP,A ;SAVE VAL + PUSH TP,B + PUSH TP,$TATOM + PUSH TP,1(AB) + PUSH TP,2(B) + PUSH TP,3(B) + MCALL 2,MEMQ + JUMPE B,NXTAG ;IF NOT FOUND -- ERROR + EXCH A,-1(TP) ;SAVE PLACE + EXCH B,(TP) + HRLI A,TFRAME + PUSH TP,A + PUSH TP,B +GENTV: MOVEI A,2 + PUSHJ P,IEVECT + MOVSI A,TTAG + JRST FINIS + +PROGCH: MOVE B,IMQUOTE LPROG,[LPROG ]INTRUP + PUSHJ P,ILVAL ;GET VALUE + GETYP 0,A + CAIE 0,TACT + JRST NXPRG + POPJ P, + +; HERE TO UNASSIGN LPROG IF NEC + +UNPROG: MOVE B,IMQUOTE LPROG,[LPROG ]INTRUP + PUSHJ P,ILVAL + GETYP 0,A + CAIE 0,TACT ; SKIP IF MUST UNBIND + JRST UNMAP + MOVSI A,TUNBOU + MOVNI B,1 + MOVE E,IMQUOTE LPROG,[LPROG ]INTRUP + PUSHJ P,PSHBND +UNMAP: HRRZ 0,FSAV(TB) ; CHECK FOR FUNNY + CAIN 0,MAPPLY ; SKIP IF NOT + POPJ P, + MOVE B,IMQUOTE LMAP,[LMAP ]INTRUP + PUSHJ P,ILVAL + GETYP 0,A + CAIE 0,TFRAME + JRST UNSPEC + MOVSI A,TUNBOU + MOVNI B,1 + MOVE E,IMQUOTE LMAP,[LMAP ]INTRUP + PUSHJ P,PSHBND +UNSPEC: PUSH TP,BNDV + MOVE B,PVSTOR+1 + ADD B,[CURFCN,,CURFCN] + PUSH TP,B + PUSH TP,$TSP + MOVE E,SPSTOR+1 + ADD E,[3,,3] + PUSH TP,E + POPJ P, + +REPEAT 0,[ +MFUNCTION MEXIT,SUBR,[EXIT] + ENTRY 2 + GETYP A,(AB) + CAIE A,TACT + JRST WTYP1 + MOVEI B,(AB) + PUSHJ P,CHFSWP + ADD C,[2,,2] + PUSHJ P,CHUNW ;RESTORE FRAME + JRST CHFINI ; CHECK FOR WINNING VALUE +] + +MFUNCTION COND,FSUBR + ENTRY 1 + GETYP A,(AB) + CAIE A,TLIST + JRST WRONGT + PUSH TP,(AB) + PUSH TP,1(AB) ;CREATE UNNAMED TEMP + MOVEI B,0 ; SET TO FALSE IN CASE + +CLSLUP: SKIPN C,1(TB) ;IS THE CLAUSELIST NIL? + JRST IFALS1 ;YES -- RETURN NIL + GETYP A,(C) ;NO -- GET TYPE OF CAR + CAIE A,TLIST ;IS IT A LIST? + JRST BADCLS ; + MOVE A,1(C) ;YES -- GET CLAUSE + JUMPE A,BADCLS + GETYPF B,(A) + PUSH TP,B ; EVALUATION OF + HLLZS (TP) + PUSH TP,1(A) ;THE PREDICATE + JSP E,CHKARG + MCALL 1,EVAL + GETYP 0,A + CAIN 0,TFALSE + JRST NXTCLS ;FALSE TRY NEXT CLAUSE + MOVE C,1(TB) ;IF NOT, DO FIRST CLAUSE + MOVE C,1(C) + HRRZ C,(C) + JUMPE C,FINIS ;(UNLESS DONE WITH IT) + JRST DOPRG2 ;AS THOUGH IT WERE A PROG +NXTCLS: HRRZ C,@1(TB) ;SET THE CLAUSLIST + HRRZM C,1(TB) ;TO CDR OF THE CLAUSLIST + JRST CLSLUP + +IFALSE: + MOVEI B,0 +IFALS1: MOVSI A,TFALSE ;RETURN FALSE + JRST FINIS + + + +MFUNCTION UNWIND,FSUBR + + ENTRY 1 + + GETYP 0,(AB) ; CHECK THE ARGS FOR WINNAGE + SKIPN A,1(AB) ; NONE? + JRST TFA + HRRZ B,(A) ; CHECK FOR 2D + JUMPE B,TFA + HRRZ 0,(B) ; 3D? + JUMPN 0,TMA + +; Unbind LPROG and LMAPF so that nothing cute happens + + PUSHJ P,UNPROG + +; Push thing to do upon UNWINDing + + PUSH TP,$TLIST + PUSH TP,[0] + + MOVEI C,UNWIN1 + PUSHJ P,IUNWIN ; GOT TO INTERNAL SET UP + +; Now EVAL the first form + + MOVE A,1(AB) + HRRZ 0,(A) ; SAVE POINTER TO OTHER GUY + MOVEM 0,-12(TP) + MOVE B,1(A) + GETYP A,(A) + MOVSI A,(A) + JSP E,CHKAB ; DEFER? + PUSH TP,A + PUSH TP,B + MCALL 1,EVAL ; EVAL THE LOSER + + JRST FINIS + +; Now push slots to hold undo info on the way down + +IUNWIN: JUMPE M,NOUNRE + HLRE 0,M ; CHECK BOUNDS + SUBM M,0 + ANDI 0,-1 + CAIL C,(M) + CAML C,0 + JRST .+2 + SUBI C,(M) + +NOUNRE: PUSH TP,$TTB ; DESTINATION FRAME + PUSH TP,[0] + PUSH TP,[0] ; ARGS TO WHOEVER IS DOING IT + PUSH TP,[0] + +; Now bind UNWIND word + + PUSH TP,$TUNWIN ; FIRST WORD OF IT + MOVE SP,SPSTOR+1 + HRRM SP,(TP) ; CHAIN + MOVEM TP,SPSTOR+1 + PUSH TP,TB ; AND POINT TO HERE + PUSH TP,$TTP + PUSH TP,[0] + HRLI C,TPDL + PUSH TP,C + PUSH TP,P ; SAVE PDL ALSO + MOVEM TP,-2(TP) ; SAVE FOR LATER + POPJ P, + +; Do a non-local return with UNWIND checking + +CHUNW: HRRZ E,SPSAV(B) ; GET DESTINATION FRAME +CHUNW1: PUSH TP,(C) ; FINAL VAL + PUSH TP,1(C) + JUMPN C,.+3 ; WAS THERE REALLY ANYTHING + SETZM (TP) + SETZM -1(TP) + PUSHJ P,STLOOP ; UNBIND +CHUNPC: SKIPA ; WILL NOT SKIP UNLESS UNWIND FOUND + JRST GOTUND + MOVEI A,(TP) + SUBI A,(SP) + MOVSI A,(A) + HLL SP,TP + SUB SP,A + MOVEM SP,SPSTOR+1 + HRRI TB,(B) ; UPDATE TB + PUSHJ P,UNWFRMS + POP TP,B + POP TP,A + POPJ P, + +POPUNW: MOVE SP,SPSTOR+1 + HRRZ SP,(SP) + MOVEI E,(TP) + SUBI E,(SP) + MOVSI E,(E) + HLL SP,TP + SUB SP,E + MOVEM SP,SPSTOR+1 + POPJ P, + + +UNWFRM: JUMPE FRM,CPOPJ + MOVE B,FRM +UNWFR2: JUMPE B,UNWFR1 + CAMG B,TPSAV(TB) + JRST UNWFR1 + MOVE B,(B) + JRST UNWFR2 + +UNWFR1: MOVE FRM,B + POPJ P, + +; Here if an UNDO found + +GOTUND: MOVE TB,1(SP) ; GET FRAME OF UNDO + MOVE A,-1(TP) ; GET FUNNY ARG FOR PASS ON + MOVE C,(TP) + MOVE TP,3(SP) ; GET FUTURE TP + MOVEM C,-6(TP) ; SAVE ARG + MOVEM A,-7(TP) + MOVE C,(TP) ; SAVED P + SUB C,[1,,1] + MOVEM C,PSAV(TB) ; MAKE CONTIN WIN + MOVEM TP,TPSAV(TB) + MOVEM SP,SPSAV(TB) + HRRZ C,(P) ; PC OF CHUNW CALLER + HRRM C,-11(TP) ; SAVE ALSO AND GET WHERE TO GO PC + MOVEM B,-10(TP) ; AND DESTINATION FRAME + HRRZ C,-1(TP) ; WHERE TO UNWIND PC + HRRZ 0,FSAV(TB) ; RSUBR? + CAIGE 0,HIBOT + CAIGE 0,STOSTR + JRST .+3 + SKIPGE PCSAV(TB) + HRLI C,400000+M + MOVEM C,PCSAV(TB) + JRST CONTIN + +UNWIN1: MOVE B,-12(TP) ; POINT TO THING TO DO UNWINDING + GETYP A,(B) + MOVSI A,(A) + MOVE B,1(B) + JSP E,CHKAB + PUSH TP,A + PUSH TP,B + MCALL 1,EVAL +UNWIN2: MOVEI C,-7(TP) ; POINT TO SAVED RET VALS + MOVE B,-10(TP) + HRRZ E,-11(TP) + PUSH P,E + MOVE SP,SPSTOR+1 + HRRZ SP,(SP) ; UNBIND THIS GUY + MOVEI E,(TP) ; AND FIXUP SP + SUBI E,(SP) + MOVSI E,(E) + HLL SP,TP + SUB SP,E + MOVEM SP,SPSTOR+1 + JRST CHUNW ; ANY MORE TO UNWIND? + + +; CHFSWP - CHECK FRAMES VALIDITY AND SWAP PROCESS IF NECESSARY. +; CALLED BY ALL CONTROL FLOW +; ROUTINES (GO,RETURN,EXIT,AGAIN,ERRET...) + +CHFSWP: PUSHJ P,CHFRM ; CHECK FOR VALID FRAME + HRRZ D,(B) ; PROCESS VECTOR DOPE WD + HLRZ C,(D) ; LENGTH + SUBI D,-1(C) ; POINT TO TOP + MOVNS C ; NEGATE COUNT + HRLI D,2(C) ; BUILD PVP + MOVE E,PVSTOR+1 + MOVE C,AB + MOVE A,(B) ; GET FRAME + MOVE B,1(B) + CAMN E,D ; SKIP IF SWAP NEEDED + POPJ P, + PUSH TP,A ; SAVE FRAME + PUSH TP,B + MOVE B,D + PUSHJ P,PROCHK ; FIX UP PROCESS LISTS + MOVE A,PSTAT+1(B) ; GET STATE + CAIE A,RESMBL + JRST NOTRES + MOVE D,B ; PREPARE TO SWAP + POP P,0 ; RET ADDR + POP TP,B + POP TP,A + JSP C,SWAP ; SWAP IN + MOVE C,ABSTO+1(E) ; GET OLD ARRGS + MOVEI A,RUNING ; FIX STATES + MOVE PVP,PVSTOR+1 + MOVEM A,PSTAT+1(PVP) + MOVEI A,RESMBL + MOVEM A,PSTAT+1(E) + JRST @0 + +NOTRES: ERRUUO EQUOTE PROCESS-NOT-RESUMABLE + + +;SETG IS USED TO SET THE GLOBAL VALUE OF ITS FIRST ARGUMENT, +;AN IDENTIFIER, TO THE VALUE OF ITS SECOND ARGUMENT. ITS VALUE IS +; ITS SECOND ARGUMENT. + +IMFUNCTION SETG,SUBR + ENTRY 2 + GETYP A,(AB) ;GET TYPE OF FIRST ARGUMENT + CAIE A,TATOM ;CHECK THAT IT IS AN ATOM + JRST NONATM ;IF NOT -- ERROR + MOVE B,1(AB) ;GET POINTER TO ATOM + PUSH TP,$TATOM + PUSH TP,B + MOVEI 0,(B) + CAIL 0,HIBOT ; PURE ATOM? + PUSHJ P,IMPURIFY ; YES IMPURIFY + PUSHJ P,IGLOC ;GET LOCATIVE TO VALUE + CAMN A,$TUNBOUND ;IF BOUND + PUSHJ P,BSETG ;IF NOT -- BIND IT + MOVE C,2(AB) ; GET PROPOSED VVAL + MOVE D,3(AB) + MOVSI A,TLOCD ; MAKE SURE MONCH WINS + PUSHJ P,MONCH0 ; WOULD YOU BELIEVE MONITORS!!!! + EXCH D,B ;SAVE PTR + MOVE A,C + HRRZ E,-2(D) ; POINT TO POSSIBLE GDECL (OR MAINIFEST) + JUMPE E,OKSETG ; NONE ,OK + CAIE E,-1 ; MANIFEST? + JRST SETGTY + GETYP 0,(D) ; IF UNBOUND, LET IT HAPPEN + SKIPN IGDECL + CAIN 0,TUNBOU + JRST OKSETG +MANILO: GETYP C,(D) + GETYP 0,2(AB) + CAIN 0,(C) + CAME B,1(D) + JRST .+2 + JRST OKSETG + PUSH TP,$TVEC + PUSH TP,D + MOVE B,IMQUOTE REDEFINE + PUSHJ P,ILVAL ; SEE IF REDEFINE OK + GETYP A,A + CAIE A,TUNBOU + CAIN A,TFALSE + JRST .+2 + JRST OKSTG + PUSH TP,$TATOM + PUSH TP,EQUOTE ATTEMPT-TO-CHANGE-MANIFEST-VARIABLE + PUSH TP,$TATOM + PUSH TP,1(AB) + MOVEI A,2 + JRST CALER + +SETGTY: PUSH TP,$TVEC + PUSH TP,D + MOVE C,A + MOVE D,B + GETYP A,(E) + MOVSI A,(A) + MOVE B,1(E) + JSP E,CHKAB + PUSHJ P,TMATCH + JRST TYPMI3 + +OKSTG: MOVE D,(TP) + MOVE A,2(AB) + MOVE B,3(AB) + +OKSETG: MOVEM A,(D) ;DEPOSIT INTO THE + MOVEM B,1(D) ;INDICATED VALUE CELL + JRST FINIS + +TYPMI3: MOVE C,(TP) + HRRZ C,-2(C) + MOVE D,2(AB) + MOVE B,3(AB) + MOVE 0,(AB) + MOVE A,1(AB) + JRST TYPMIS + +BSETG: HRRZ A,GLOBASE+1 + HRRZ B,GLOBSP+1 + SUB B,A + CAIL B,6 + JRST SETGIT + MOVEI B,0 ; MAKE SURE OF NO EMPTY SLOTS + PUSHJ P,IGLOC + CAMN A,$TUNBOU ; SKIP IF SLOT FOUND + JRST BSETG1 + MOVE C,(TP) ; GET ATOM + MOVEM C,-1(B) ; CLOBBER ATOM SLOT + HLLZS -2(B) ; CLOBBER OLD DECL + JRST BSETGX +; BSETG1: PUSH TP,GLOBASE ; MUST REALLY GROW STACK +; PUSH TP,GLOBASE+1 +; PUSH TP,$TFIX +; PUSH TP,[0] +; PUSH TP,$TFIX +; PUSH TP,[100] +; MCALL 3,GROW +BSETG1: PUSH P,0 + PUSH P,C + MOVE C,GLOBASE+1 + HLRE B,C + SUB C,B + MOVE B,GVLINC ; GROW BY INDICATED GVAL SLOTS + DPB B,[001100,,(C)] +; MOVEM A,GLOBASE + MOVE C,[6,,4] ; INDICATOR FOR AGC + PUSHJ P,AGC + MOVE B,GLOBASE+1 + MOVE 0,GVLINC ; ADJUST GLOBAL SPBASE + ASH 0,6 + SUB B,0 + HRLZS 0 + SUB B,0 + MOVEM B,GLOBASE+1 +; MOVEM B,GLOBASE+1 + POP P,0 + POP P,C +SETGIT: + MOVE B,GLOBSP+1 + SUB B,[4,,4] + MOVSI C,TGATOM + MOVEM C,(B) + MOVE C,(TP) + MOVEM C,1(B) + MOVEM B,GLOBSP+1 + ADD B,[2,,2] +BSETGX: MOVSI A,TLOCI + PUSHJ P,PATSCH ; FIXUP SCHLPAGE + MOVEM A,(C) + MOVEM B,1(C) + POPJ P, + +PATSCH: GETYP 0,(C) + CAIN 0,TLOCI + SKIPL D,1(C) + POPJ P, + +PATL: SKIPL E,3(D) ; SKIP IF NEXT EXISTS + JRST PATL1 + MOVE D,E + JRST PATL + +PATL1: MOVEI E,1 + MOVEM E,3(D) ; SAY GVAL ETC. EXISTS IF WE UNBIND + POPJ P, + + +IMFUNCTION DEFMAC,FSUBR + + ENTRY 1 + + PUSH P,. + JRST DFNE2 + +IMFUNCTION DFNE,FSUBR,[DEFINE] + + ENTRY 1 + + PUSH P,[0] +DFNE2: GETYP A,(AB) + CAIE A,TLIST + JRST WRONGT + SKIPN B,1(AB) ; GET ATOM + JRST TFA + GETYP A,(B) ; MAKE SURE ATOM + MOVSI A,(A) + PUSH TP,A + PUSH TP,1(B) + JSP E,CHKARG + MCALL 1,EVAL ; EVAL IT TO AN ATOM + CAME A,$TATOM + JRST NONATM + PUSH TP,A ; SAVE TWO COPIES + PUSH TP,B + PUSHJ P,IGVAL ; SEE IF A VALUE EXISTS + CAMN A,$TUNBOU ; SKIP IF A WINNER + JRST .+3 + PUSHJ P,ASKUSR ; CHECK WITH USER + JRST DFNE1 + PUSH TP,$TATOM + PUSH TP,-1(TP) + MOVE B,1(AB) + HRRZ B,(B) + MOVSI A,TEXPR + SKIPN (P) ; SKIP IF MACRO + JRST DFNE3 + MOVEI D,(B) ; READY TO CONS + MOVSI C,TEXPR + PUSHJ P,INCONS + MOVSI A,TMACRO +DFNE3: PUSH TP,A + PUSH TP,B + MCALL 2,SETG +DFNE1: POP TP,B ; RETURN ATOM + POP TP,A + JRST FINIS + + +ASKUSR: MOVE B,IMQUOTE REDEFINE + PUSHJ P,ILVAL ; SEE IF REDEFINE OK + GETYP A,A + CAIE A,TUNBOU + CAIN A,TFALSE + JRST ASKUS1 + JRST ASKUS2 +ASKUS1: PUSH TP,$TATOM + PUSH TP,-1(TP) + PUSH TP,$TATOM + PUSH TP,EQUOTE ALREADY-DEFINED-ERRET-NON-FALSE-TO-REDEFINE + MCALL 2,ERROR + GETYP 0,A + CAIE 0,TFALSE +ASKUS2: AOS (P) + MOVE B,1(AB) + POPJ P, + + + +;SET CLOBBERS THE LOCAL VALUE OF THE IDENTIFIER GIVEN BY ITS +;FIRST ARGUMENT TO THE SECOND ARG. ITS VALUE IS ITS SECOND ARGUMENT. + +IMFUNCTION SET,SUBR + HLRE D,AB ; 2 TIMES # OF ARGS TO D + ASH D,-1 ; - # OF ARGS + ADDI D,2 + JUMPG D,TFA ; NOT ENOUGH + MOVE B,PVSTOR+1 + MOVE C,SPSTOR+1 + JUMPE D,SET1 ; NO ENVIRONMENT + AOJL D,TMA ; TOO MANY + GETYP A,4(AB) ; CHECK ARG IS A FRAME OR PROCESS + CAIE A,TFRAME + CAIN A,TENV + JRST SET2 ; WINNING ENVIRONMENT/FRAME + CAIN A,TACT + JRST SET2 ; TO MAKE PFISTER HAPPY + CAIE A,TPVP + JRST WTYP2 + MOVE B,5(AB) ; GET PROCESS + MOVE C,SPSTO+1(B) + JRST SET1 +SET2: MOVEI B,4(AB) ; POINT TO FRAME + PUSHJ P,CHFRM ; CHECK IT OUT + MOVE B,5(AB) ; GET IT BACK + MOVE C,SPSAV(B) ; GET BINDING POINTER + HRRZ B,4(AB) ; POINT TO PROCESS + HLRZ A,(B) ; GET LENGTH + SUBI B,-1(A) ; POINT TO START THEREOF + HLL B,PVSTOR+1 ; GET -LNTRH, (ALL PROCESS VECS SAME LENGTH) +SET1: PUSH TP,$TPVP ; SAVE PROCESS + PUSH TP,B + PUSH TP,$TSP ; SAVE PATH POINTER + PUSH TP,C + GETYP A,(AB) ;GET TYPE OF FIRST + CAIE A,TATOM ;ARGUMENT -- + JRST WTYP1 ;BETTER BE AN ATOM + MOVE B,1(AB) ;GET PTR TO IT + MOVEI 0,(B) + CAIL 0,HIBOT + PUSHJ P,IMPURIFY + MOVE C,(TP) + PUSHJ P,AILOC ;GET LOCATIVE TO VALUE +GOTLOC: CAMN A,$TUNBOUND ;BOUND? + PUSHJ P, BSET ;BIND IT + MOVE C,2(AB) ; GET NEW VAL + MOVE D,3(AB) + MOVSI A,TLOCD ; FOR MONCH + HRR A,2(B) + PUSHJ P,MONCH0 ; HURRAY FOR MONITORS!!!!! + MOVE E,B + HLRZ A,2(E) ; GET DECLS + JUMPE A,SET3 ; NONE, GO + PUSH TP,$TSP + PUSH TP,E + MOVE B,1(A) + HLLZ A,(A) ; GET PATTERN + PUSHJ P,TMATCH ; MATCH TMEM + JRST TYPMI2 ; LOSES + MOVE E,(TP) + SUB TP,[2,,2] + MOVE C,2(AB) + MOVE D,3(AB) +SET3: MOVEM C,(E) ;CLOBBER IDENTIFIER + MOVEM D,1(E) + MOVE A,C + MOVE B,D + MOVE C,-2(TP) ; GET PROC + HRRZ C,BINDID+1(C) + HRLI C,TLOCI + +; HERE WE NOTE THAT EFFICIENCY CAN SOMETIMES GET IN THE WAY OF CORRECTNESS +; BY SETTING THE SHALLOW BINDING WE MANAGE TO CLOBBER THE TOP LEVEL LVAL +; EVEN IF WE ARE SETTING WITH RESPECT TO A DIFFERENT FRAME. TO CORRECT +; THIS GLITCH THIS ACTIVITY WILL ONLY TAKE PLACE IF THE ATOM ALREADY POINTS +; TO A BINDING + + MOVE D,1(AB) + SKIPE (D) + JRST NSHALL + MOVEM C,(D) + MOVEM E,1(D) +NSHALL: SUB TP,[4,,4] + JRST FINIS +BSET: + MOVE PVP,PVSTOR+1 + CAMN PVP,-2(TP) ; SKIP IF PROC DIFFERS + MOVEM C,-2(TP) ; ELSE USE RESULT FROM LOC SEARCH + MOVE B,-2(TP) ; GET PROCESS + HRRZ A,TPBASE+1(B) ;GET ACTUAL STACK BASE + HRRZ B,SPBASE+1(B) ;AND FIRST BINDING + SUB B,A ;ARE THERE 6 + CAIL B,6 ;CELLS AVAILABLE? + JRST SETIT ;YES + MOVE C,(TP) ; GET POINTER BACK + MOVEI B,0 ; LOOK FOR EMPTY SLOT + PUSHJ P,AILOC + CAMN A,$TUNBOUND ; SKIP IF FOUND + JRST BSET1 + MOVE E,1(AB) ; GET ATOM + MOVEM E,-1(B) ; AND STORE + JRST BSET2 +BSET1: MOVE B,-2(TP) ; GET PROCESS +; PUSH TP,TPBASE(B) ;NO -- GROW THE TP +; PUSH TP,TPBASE+1(B) ;AT THE BASE END +; PUSH TP,$TFIX +; PUSH TP,[0] +; PUSH TP,$TFIX +; PUSH TP,[100] +; MCALL 3,GROW +; MOVE C,-2(TP) ; GET PROCESS +; MOVEM A,TPBASE(C) ;SAVE RESULT + PUSH P,0 ; MANUALLY GROW VECTOR + PUSH P,C + MOVE C,TPBASE+1(B) + HLRE B,C + SUB C,B + MOVEI C,1(C) + CAME C,TPGROW + ADDI C,PDLBUF + MOVE D,LVLINC + DPB D,[001100,,-1(C)] + MOVE C,[5,,3] ; SET UP INDICATORS FOR AGC + PUSHJ P,AGC + MOVE PVP,PVSTOR+1 + MOVE B,TPBASE+1(PVP) ; MODIFY POINTER + MOVE 0,LVLINC ; ADJUST SPBASE POINTER + ASH 0,6 + SUB B,0 + HRLZS 0 + SUB B,0 + MOVEM B,TPBASE+1(PVP) + POP P,C + POP P,0 +; MOVEM B,TPBASE+1(C) +SETIT: MOVE C,-2(TP) ; GET PROCESS + MOVE B,SPBASE+1(C) + MOVEI A,-6(B) ;MAKE UP BINDING + HRRM A,(B) ;LINK PREVIOUS BIND BLOCK + MOVSI A,TBIND + MOVEM A,-6(B) + MOVE A,1(AB) + MOVEM A,-5(B) + SUB B,[6,,6] + MOVEM B,SPBASE+1(C) + ADD B,[2,,2] +BSET2: MOVE C,-2(TP) ; GET PROC + MOVSI A,TLOCI + HRR A,BINDID+1(C) + HLRZ D,OTBSAV(TB) ; TIME IT + MOVEM D,2(B) ; AND FIX IT + POPJ P, + +; HERE TO ELABORATE ON TYPE MISMATCH + +TYPMI2: MOVE C,(TP) ; FIND DECLS + HLRZ C,2(C) + MOVE D,2(AB) + MOVE B,3(AB) + MOVE 0,(AB) ; GET ATOM + MOVE A,1(AB) + JRST TYPMIS + + + +MFUNCTION NOT,SUBR + ENTRY 1 + GETYP A,(AB) ; GET TYPE + CAIE A,TFALSE ;IS IT FALSE? + JRST IFALSE ;NO -- RETURN FALSE + +TRUTH: + MOVSI A,TATOM ;RETURN T (VERITAS) + MOVE B,IMQUOTE T + JRST FINIS + +IMFUNCTION OR,FSUBR + + PUSH P,[0] + JRST ANDOR + +MFUNCTION ANDA,FSUBR,AND + + PUSH P,[1] +ANDOR: ENTRY 1 + GETYP A,(AB) + CAIE A,TLIST + JRST WRONGT ;IF ARG DOESN'T CHECK OUT + MOVE E,(P) + SKIPN C,1(AB) ;IF NIL + JRST TF(E) ;RETURN TRUTH + PUSH TP,$TLIST ;CREATE UNNAMED TEMP + PUSH TP,C +ANDLP: + MOVE E,(P) + JUMPE C,TFI(E) ;ANY MORE ARGS? + MOVEM C,1(TB) ;STORE CRUFT + GETYP A,(C) + MOVSI A,(A) + PUSH TP,A + PUSH TP,1(C) ;ARGUMENT + JSP E,CHKARG + MCALL 1,EVAL + GETYP 0,A + MOVE E,(P) + XCT TFSKP(E) + JRST FINIS ;IF FALSE -- RETURN + HRRZ C,@1(TB) ;GET CDR OF ARGLIST + JRST ANDLP + +TF: JRST IFALSE + JRST TRUTH + +TFI: JRST IFALS1 + JRST FINIS + +TFSKP: CAIE 0,TFALSE + CAIN 0,TFALSE + +IMFUNCTION FUNCTION,FSUBR + + ENTRY 1 + + MOVSI A,TEXPR + MOVE B,1(AB) + JRST FINIS + + ;SUBR VERSIONS OF AND/OR + +MFUNCTION ANDP,SUBR,[AND?] + JUMPGE AB,TRUTH + MOVE C,[CAIN 0,TFALSE] + JRST BOOL + +MFUNCTION ORP,SUBR,[OR?] + JUMPGE AB,IFALSE + MOVE C,[CAIE 0,TFALSE] +BOOL: HLRE A,AB ; GET ARG COUNTER + MOVMS A + ASH A,-1 ; DIVIDES BY 2 + MOVE D,AB + PUSHJ P,CBOOL + JRST FINIS + +CANDP: SKIPA C,[CAIN 0,TFALSE] +CORP: MOVE C,[CAIE 0,TFALSE] + JUMPE A,CNOARG + MOVEI D,(A) + ASH D,1 ; TIMES 2 + HRLI D,(D) + SUBB TP,D ; POINT TO ARGS & FIXUP TP PTR + AOBJP D,.+1 ; FIXUP ARG PTR AND FALL INTO CBOOL + +CBOOL: GETYP 0,(D) + XCT C ; WINNER ? + JRST CBOOL1 ; YES RETURN IT + ADD D,[2,,2] + SOJG A,CBOOL ; ANY MORE ? + SUB D,[2,,2] ; NO, USE LAST +CBOOL1: MOVE A,(D) + MOVE B,(D)+1 + POPJ P, + + +CNOARG: MOVSI 0,TFALSE + XCT C + JRST CNOAND + MOVSI A,TFALSE + MOVEI B,0 + POPJ P, +CNOAND: MOVSI A,TATOM + MOVE B,IMQUOTE T + POPJ P, + + +MFUNCTION CLOSURE,SUBR + ENTRY + SKIPL A,AB ;ANY ARGS + JRST TFA ;NO -- LOSE + ADD A,[2,,2] ;POINT AT IDS + PUSH TP,$TAB + PUSH TP,A + PUSH P,[0] ;MAKE COUNTER + +CLOLP: SKIPL A,1(TB) ;ANY MORE IDS? + JRST CLODON ;NO -- LOSE + PUSH TP,(A) ;SAVE ID + PUSH TP,1(A) + PUSH TP,(A) ;GET ITS VALUE + PUSH TP,1(A) + ADD A,[2,,2] ;BUMP POINTER + MOVEM A,1(TB) + AOS (P) + MCALL 1,VALUE + PUSH TP,A + PUSH TP,B + MCALL 2,LIST ;MAKE PAIR + PUSH TP,A + PUSH TP,B + JRST CLOLP + +CLODON: POP P,A + ACALL A,LIST ;MAKE UP LIST + PUSH TP,(AB) ;GET FUNCTION + PUSH TP,1(AB) + PUSH TP,A + PUSH TP,B + MCALL 2,LIST ;MAKE LIST + MOVSI A,TFUNARG + JRST FINIS + + + +;ERROR COMMENTS FOR EVAL + +BADNUM: ERRUUO EQUOTE NEGATIVE-ARGUMENT + +WTY1TP: ERRUUO EQUOTE FIRST-ARG-WRONG-TYPE + +UNBOU: PUSH TP,$TATOM + PUSH TP,EQUOTE UNBOUND-VARIABLE + JRST ER1ARG + +UNAS: PUSH TP,$TATOM + PUSH TP,EQUOTE UNASSIGNED-VARIABLE + JRST ER1ARG + +BADENV: + ERRUUO EQUOTE BAD-ENVIRONMENT + +FUNERR: + ERRUUO EQUOTE BAD-FUNARG + + +MPD.0: +MPD.1: +MPD.2: +MPD.3: +MPD.4: +MPD.5: +MPD.6: +MPD.7: +MPD.8: +MPD.9: +MPD.10: +MPD.11: +MPD.12: +MPD.13: +MPD: ERRUUO EQUOTE MEANINGLESS-PARAMETER-DECLARATION + +NOBODY: ERRUUO EQUOTE HAS-EMPTY-BODY + +BADCLS: ERRUUO EQUOTE BAD-CLAUSE + +NXTAG: ERRUUO EQUOTE NON-EXISTENT-TAG + +NXPRG: ERRUUO EQUOTE NOT-IN-PROG + +NAPTL: +NAPT: ERRUUO EQUOTE NON-APPLICABLE-TYPE + +NONEVT: ERRUUO EQUOTE NON-EVALUATEABLE-TYPE + + +NONATM: ERRUUO EQUOTE NON-ATOMIC-ARGUMENT + + +ILLFRA: ERRUUO EQUOTE FRAME-NO-LONGER-EXISTS + +ILLSEG: ERRUUO EQUOTE ILLEGAL-SEGMENT + +BADMAC: ERRUUO EQUOTE BAD-USE-OF-MACRO + +BADFSB: ERRUUO EQUOTE APPLY-OR-STACKFORM-OF-FSUBR + + +ER1ARG: PUSH TP,(AB) + PUSH TP,1(AB) + MOVEI A,2 + JRST CALER + +END + \ No newline at end of file diff --git a//eval.mid.123 b//eval.mid.123 new file mode 100644 index 0000000..e75e261 --- /dev/null +++ b//eval.mid.123 @@ -0,0 +1,4217 @@ +TITLE EVAL -- MUDDLE EVALUATOR + +RELOCATABLE + +; GERALD JAY SUSSMAN, 1971. REWRITTEN MANY TIMES SINCE C. REEVE (1972--1974) + + +.GLOBAL BINDID,LPROG,GLOBSP,GLOBASE,SPBASE,TPBASE,PTIME,SWAP,CHFRAM +.GLOBAL IGVAL,CHKARG,NXTDCL,TPOVFL,CHFRM,PROCHK,CHFSWP,VECBOT,TYPSGR +.GLOBAL ILVAL,ER1ARG,SPECBIND,MAKACT,SPECSTORE,MAKTUP,TPALOC,IBIND,SSPECS +.GLOBAL IDVAL,EVECTO,EUVECT,CHARGS,BCKTRK,CELL,ILOC,IGLOC,CHKDCL,SSPEC1 +.GLOBAL PDLBUF,MESS,FACTI,CHKARG,MAKENV,PSTAT,BNDV,UNBOU,UNAS,IGDECL +.GLOBAL 1STEPR,SEGMNT,SEGLST,NAPT,EVTYPE,EVATYP,APTYPE,APLTYP,APLQ,IDVAL1 +.GLOBAL TESTR,VALG,TYPG,INCR1,TMATCH,TYPMIS,SAT,MAKACT,NTPALO,SPECBND +.GLOBAL TPGROW,CHKAB,TYPSEG,NXTLM,MONCH0,CHFINI,RMONC0,IMPURIFY,ICONS,INCONS +.GLOBAL CILVAL,CISET,CIGVAL,CSETG,MAPPLY,CLLOC,CGLOC,CASSQ,CGASSQ,CBOUND +.GLOBAL IIGLOC,CHUNW,IUNWIN,UNWIN2,SPCCHK,CURFCN,TMPLNT,TD.LNT,TBINIT +.GLOBAL SPECBE,BSETG,GLOTOP,CANDP,CORP,TFA,TMA,DSTORE,PVSTOR,SPSTOR +.GLOBAL AGC,GVLINC,LVLINC,CGBOUN,IEVECT,MAKTU2,STOSTR,HIBOT,POPUNW,ISTRUC + +.INSRT MUDDLE > + +MONITOR + + +; ENTRY TO EXPAND A MACRO + +MFUNCTION EXPAND,SUBR + + ENTRY 1 + + MOVE PVP,PVSTOR+1 + MOVEI A,PVLNT*2+1(PVP) + HRLI A,TFRAME + MOVE B,TBINIT+1(PVP) + HLL B,OTBSAV(B) + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + JRST AEVAL2 + +; MAIN EVAL ENTRANCE + +IMFUNCTION EVAL,SUBR + + ENTRY + + MOVE PVP,PVSTOR+1 + SKIPE C,1STEPR+1(PVP) ; BEING 1 STEPPED? + JRST 1STEPI ; YES HANDLE +EVALON: HLRZ A,AB ;GET NUMBER OF ARGS + CAIE A,-2 ;EXACTLY 1? + JRST AEVAL ;EVAL WITH AN ALIST +SEVAL: GETYP A,(AB) ;GET TYPE OF ARG + SKIPE C,EVATYP+1 ; USER TYPE TABLE? + JRST EVDISP +SEVAL1: CAIG A,NUMPRI ;PRIMITIVE? + JRST SEVAL2 ;YES-DISPATCH + +SELF: MOVE A,(AB) ;TYPES WHICH EVALUATE + MOVE B,1(AB) + JRST EFINIS ;TO SELF-EG NUMBERS + +SEVAL2: HRRO A,EVTYPE(A) + JRST (A) + +; HERE FOR USER EVAL DISPATCH + +EVDISP: ADDI C,(A) ; POINT TO SLOT + ADDI C,(A) + SKIPE (C) ; SKIP EITHER A LOSER OR JRST DISP + JRST EVDIS1 ; APPLY EVALUATOR + SKIPN C,1(C) ; GET ADDR OR GO TO PURE DISP + JRST SEVAL1 + JRST (C) + +EVDIS1: PUSH TP,(C) + PUSH TP,1(C) + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,APPLY ; APPLY HACKER TO OBJECT + JRST EFINIS + + +; EVAL DISPATCH TABLE + +IF2,SELFS==400000,,SELF + +DISTBL EVTYPE,SELFS,[[TFORM,EVFORM],[TLIST,EVLIST],[TVEC,EVECT],[TUVEC,EUVEC] +[TSEG,ILLSEG]] + + +;WATCH FOR SUBTLE BUG 43 LERR,LPROG OR BINDID +AEVAL: + CAIE A,-4 ;EXACTLY 2 ARGS? + JRST WNA ;NO-ERROR + GETYP A,2(AB) ;CHECK THAT WE HAVE A FRAME + CAIE A,TACT + CAIN A,TFRAME + JRST .+3 + CAIE A,TENV + JRST TRYPRO ; COULD BE PROCESS + MOVEI B,2(AB) ; POINT TO FRAME +AEVAL2: PUSHJ P,CHENV ; HACK ENVIRONMENT CHANGE +AEVAL1: PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 1,EVAL +AEVAL3: HRRZ 0,FSAV(TB) + CAIN 0,EVAL + JRST EFINIS + JRST FINIS + +TRYPRO: CAIE A,TPVP ; SKIP IF IT IS A PROCESS + JRST WTYP2 + MOVE C,3(AB) ; GET PROCESS + CAMN C,PVSTOR ; DIFFERENT FROM ME? + JRST SEVAL ; NO, NORMAL EVAL WINS + MOVE B,SPSTO+1(C) ; GET SP FOR PROCESS + MOVE D,TBSTO+1(C) ; GET TOP FRAME + HLL D,OTBSAV(D) ; TIME IT + MOVEI C,PVLNT*2+1(C) ; CONS UP POINTER TO PROC DOPE WORD + HRLI C,TFRAME ; LOOK LIK E A FRAME + PUSHJ P,SWITSP ; SPLICE ENVIRONMENT + JRST AEVAL1 + +; ROUTINE TO CHANGE LOOK UP PATH FOR BINDINGS + +CHENV: PUSHJ P,CHFRM ; CHECK OUT FRAME + MOVE C,(B) ; POINT TO PROCESS + MOVE D,1(B) ; GET TB POINTER FROM FRAME + CAMN SP,SPSAV(D) ; CHANGE? + POPJ P, ; NO, JUST RET + MOVE B,SPSAV(D) ; GET SP OF INTEREST +SWITSP: MOVSI 0,TSKIP ; SET UP SKIP + HRRI 0,1(TP) ; POINT TO UNBIND PATH + MOVE A,PVSTOR+1 + ADD A,[BINDID,,BINDID] ; BIND THE BINDING ID + PUSH TP,BNDV + PUSH TP,A + PUSH TP,$TFIX + AOS A,PTIME ; NEW ID + PUSH TP,A + MOVE E,TP ; FOR SPECBIND + PUSH TP,0 + PUSH TP,B + PUSH TP,C ; SAVE PROCESS + PUSH TP,D + PUSHJ P,SPECBE ; BIND BINDID + MOVE SP,TP ; GET NEW SP + SUB SP,[3,,3] ; SET UP SP FORK + MOVEM SP,SPSTOR+1 + POPJ P, + + +; HERE TO EVALUATE A FORM (99% OF EVAL'S WORK) + +EVFORM: SKIPN C,1(AB) ; EMPTY FORM, RETURN FALSE + JRST EFALSE + GETYP A,(C) ; 1ST ELEMENT OF FORM + CAIE A,TATOM ; ATOM? + JRST EV0 ; NO, EVALUATE IT + MOVE B,1(C) ; GET ATOM + PUSHJ P,IGVAL ; GET ITS GLOBAL VALUE + +; SPECIAL HACK TO SPEED UP LVAL AND GVAL CALLS + + CAIE B,LVAL + CAIN B,GVAL + JRST ATMVAL ; FAST ATOM VALUE + + GETYP 0,A + CAIE 0,TUNBOU ; BOUND? + JRST IAPPLY ; YES APPLY IT + + MOVE C,1(AB) ; LOOK FOR LOCAL + MOVE B,1(C) + PUSHJ P,ILVAL + GETYP 0,A + CAIE 0,TUNBOU + JRST IAPPLY ; WIN, GO APPLY IT + + PUSH TP,$TATOM + PUSH TP,EQUOTE UNBOUND-VARIABLE + PUSH TP,$TATOM + MOVE C,1(AB) ; FORM BACK + PUSH TP,1(C) + PUSH TP,$TATOM + PUSH TP,IMQUOTE VALUE + MCALL 3,ERROR ; REPORT THE ERROR + JRST IAPPLY + +EFALSE: MOVSI A,TFALSE ; SPECIAL FALSE FOR EVAL OF EMPTY FORM + MOVEI B,0 + JRST EFINIS + +ATMVAL: HRRZ D,(C) ; CDR THE FORM + HRRZ 0,(D) ; AND AGAIN + JUMPN 0,IAPPLY + GETYP 0,(D) ; MAKE SURE APPLYING TO ATOM + CAIE 0,TATOM + JRST IAPPLY + MOVEI E,IGVAL ; ASSUME GLOBAAL + CAIE B,GVAL ; SKIP IF OK + MOVEI E,ILVAL ; ELSE USE LOCAL + PUSH P,B ; SAVE SUBR + MOVE B,(D)+1 ; CLR BUG #1637 (GET THE ATOM FOR THE SUBR) + PUSHJ P,(E) ; AND GET VALUE + CAME A,$TUNBOU + JRST EFINIS ; RETURN FROM EVAL + POP P,B + MOVSI A,TSUBR ; CAUSE REAL SUBR TO GET EROR + JRST IAPPLY + +; HERE FOR 1ST ELEMENT NOT A FORM + +EV0: PUSHJ P,FASTEV ; EVAL IT + +; HERE TO APPLY THINGS IN FORMS + +IAPPLY: PUSH TP,(AB) ; SAVE THE FORM + PUSH TP,1(AB) + PUSH TP,A + PUSH TP,B ; SAVE THE APPLIER + PUSH TP,$TFIX ; AND THE ARG GETTER + PUSH TP,[ARGCDR] + PUSHJ P,APLDIS ; GO TO INTERNAL APPLIER + JRST EFINIS ; LEAVE EVAL + +; HERE TO EVAL 1ST ELEMENT OF A FORM + +FASTEV: MOVE PVP,PVSTOR+1 + SKIPE 1STEPR+1(PVP) ; BEING 1 STEPPED? + JRST EV02 ; YES, LET LOSER SEE THIS EVAL + GETYP A,(C) ; GET TYPE + SKIPE D,EVATYP+1 ; USER TABLE? + JRST EV01 ; YES, HACK IT +EV03: CAIG A,NUMPRI ; SKIP IF SELF + SKIPA A,EVTYPE(A) ; GET DISPATCH + MOVEI A,SELF ; USE SLEF + +EV04: CAIE A,SELF ; IF EVAL'S TO SELF, JUST USE IT + JRST EV02 + MOVSI A,TLIST + MOVE PVP,PVSTOR+1 + MOVEM A,CSTO(PVP) + INTGO + SETZM CSTO(PVP) + HLLZ A,(C) ; GET IT + MOVE B,1(C) + JSP E,CHKAB ; CHECK DEFERS + POPJ P, ; AND RETURN + +EV01: ADDI D,(A) ; POINT TO SLOT OF USER EVAL TABLE + ADDI D,(A) + SKIPE (D) ; EITHER NOT GIVEN OR SIMPLE + JRST EV02 + SKIPN 1(D) ; SKIP IF SIMPLE + JRST EV03 ; NOT GIVEN + MOVE A,1(D) + JRST EV04 + +EV02: PUSH TP,(C) + HLLZS (TP) ; FIX UP LH + PUSH TP,1(C) + JSP E,CHKARG + MCALL 1,EVAL + POPJ P, + + +; MAPF/MAPR CALL TO APPLY + + IMQUOTE APPLY + +MAPPLY: JRST APPLY + +; APPLY, FALLS INTO EVAL'S APPLY CODE AT APLDIS + +IMFUNCTION APPLY,SUBR + + ENTRY + + JUMPGE AB,TFA ; MUST BE AT LEAST 1 ARGUMENT + MOVE A,AB + ADD A,[2,,2] + PUSH TP,$TAB + PUSH TP,A + PUSH TP,(AB) ; SAVE FCN + PUSH TP,1(AB) + PUSH TP,$TFIX ; AND ARG GETTER + PUSH TP,[SETZ APLARG] + PUSHJ P,APLDIS + JRST FINIS + +; STACKFROM, ALSO FALLS INTO EVAL'S APPLIER AT APLDIS + +IMFUNCTION STACKFORM,FSUBR + + ENTRY 1 + + GETYP A,(AB) + CAIE A,TLIST + JRST WTYP1 + MOVEI A,3 ; CHECK ALL GOODIES SUPPLIED + HRRZ B,1(AB) + + JUMPE B,TFA + HRRZ B,(B) ; CDR IT + SOJG A,.-2 + + HRRZ C,1(AB) ; GET LIST BACK + PUSHJ P,FASTEV ; DO A FAST EVALUATION + PUSH TP,(AB) + HRRZ C,@1(AB) ; POINT TO ARG GETTING FORMS + PUSH TP,C + PUSH TP,A ; AND FCN + PUSH TP,B + PUSH TP,$TFIX + PUSH TP,[SETZ EVALRG] + PUSHJ P,APLDIS + JRST FINIS + + +; OFFSETS FOR TEMPORARIES ETC. USED IN APPLYING STUFF + +E.FRM==0 ; POINTS TO FORM BEING EVALED (OR ARGS FOR APPLY STACKFORM) +E.FCN==2 ; FUNCTION/SUBR/RSUBR BEING APPLIED +E.ARG==4 ; POINTS TO ARG GETTING ROUTINE (<0 => MUST EVAL ARGS) +E.EXTR==6 ; CONTAINS 1ST ARG IN USER APPLY CASE +E.SEG==10 ; POINTS TO SEGMENT IN FORM BEING HACKED +E.CNT==12 ; COUNTER FOR TUPLES OF ARGS +E.DECL==14 ; POINTS TO DECLARATION LIST IN FUNCTIONS +E.ARGL==16 ; POINTS TO ARG LIST IN FUNCTIONS +E.HEW==20 ; POINTS TO HEWITT ATOM IF IT EXISTS + +E.VAL==E.ARGL ; VALUE TYPE FOR RSUBRS + +MINTM==E.EXTR+2 ; MIN # OF TEMPS EVER ALLOCATED +E.TSUB==E.CNT+2 ; # OF TEMPS FOR SUBR/NUMBER APPLICATION +XP.TMP==E.HEW-E.EXTR ; # EXTRA TEMPS FOR FUNCTION APPLICATION +R.TMP==4 ; TEMPS AFTER ARGS ARE BOUND +TM.OFF==E.HEW+2-R.TMP ; TEMPS TO FLUSH AFTER BIND OF ARGS + +RE.FCN==0 ; AFTER BINDING CONTAINS FCN BODY +RE.ARG==2 ; ARG LIST AFTER BINDING + +; GENERAL THING APPLYER + +APLDIS: PUSH TP,[0] ; SLOT USED FOR USER APPLYERS + PUSH TP,[0] +APLDIX: GETYP A,E.FCN(TB) ; GET TYPE + +APLDI: SKIPE D,APLTYP+1 ; USER TABLE EXISTS? + JRST APLDI1 ; YES, USE IT +APLDI2: CAILE A,NUMPRI ; SKIP IF NOT PRIM + JRST NAPT + HRRO A,APTYPE(A) + JRST (A) + +APLDI1: ADDI D,(A) ; POINT TO SLOT + ADDI D,(A) + SKIPE (D) ; SKIP IF NOT GIVEN OR STANDARD + JRST APLDI3 +APLDI4: SKIPE D,1(D) ; GET DISP + JRST (D) + JRST APLDI2 ; USE SYSTEM DISPATCH + +APLDI3: SKIPE E.EXTR+1(TB) ; SKIP IF HAVEN'T BEEN HERE BEFORE + JRST APLDI4 + MOVE A,(D) ; GET ITS HANDLER + EXCH A,E.FCN(TB) ; AND USE AS FCN + MOVEM A,E.EXTR(TB) ; SAVE + MOVE A,1(D) + EXCH A,E.FCN+1(TB) + MOVEM A,E.EXTR+1(TB) ; STASH OLD FCN AS EXTRG + GETYP A,(D) ; GET TYPE + JRST APLDI + + +; APPLY DISPATCH TABLE + +DISTBL APTYPE,,[[TSUBR,APSUBR],[TFSUBR,APFSUB],[TRSUBR,APRSUB],[TFIX,APNUM] +[TEXPR,APEXPR],[TFUNAR,APFUNARG],[TENTER,APENTR],[TMACRO,APMACR],[TOFFS,APNUM]] + +; SUBR TO SAY IF TYPE IS APPLICABLE + +MFUNCTION APPLIC,SUBR,[APPLICABLE?] + + ENTRY 1 + + GETYP A,(AB) + PUSHJ P,APLQ + JRST IFALSE + JRST TRUTH + +; HERE TO DETERMINE IF A TYPE IS APPLICABLE + +APLQ: PUSH P,B + SKIPN B,APLTYP+1 + JRST USEPUR ; USE PURE TABLE + ADDI B,(A) + ADDI B,(A) ; POINT TO SLOT + SKIPG 1(B) ; SKIP IF WINNER + SKIPE (B) ; SKIP IF POTENIAL LOSER + JRST CPPJ1B ; WIN + SKIPE 1(B) ; SKIP IF MUST USE PURE TABBLE + JRST CPOPJB +USEPUR: CAILE A,NUMPRI ; SKIP IF NOT PRIM + JRST CPOPJB + SKIPL APTYPE(A) ; SKIP IF APLLICABLE +CPPJ1B: AOS -1(P) +CPOPJB: POP P,B + POPJ P, + +; FSUBR APPLYER + +APFSUBR: + SKIPN E.EXTR(TB) ; IF EXTRA ARG + SKIPGE E.ARG+1(TB) ; OR APPLY/STACKFORM, LOSE + JRST BADFSB + MOVE A,E.FCN+1(TB) ; GET FCN + HRRZ C,@E.FRM+1(TB) ; GET ARG LIST + SUB TP,[MINTM,,MINTM] ; FLUSH UNWANTED TEMPS + PUSH TP,$TLIST + PUSH TP,C ; ARG TO STACK + .MCALL 1,(A) ; AND CALL + POPJ P, ; AND LEAVE + +; SUBR APPLYER + +APSUBR: + PUSHJ P,PSH4ZR ; SET UP ZEROED SLOTS + SKIPG E.ARG+1(TB) + AOS E.CNT(TB) ; INDICATES IF MUST EVAL ARGS + MOVSI A,400000 ; MAKE SURE OF GOOD INDIRECT + IORM A,E.ARG+1(TB) + SKIPN A,E.EXTR(TB) ; FUNNY ARGS + JRST APSUB1 ; NO, GO + MOVE B,E.EXTR+1(TB) ; YES , GET VAL + JRST APSUB2 ; AND FALL IN + +APSUB1: PUSHJ P,@E.ARG+1(TB) ; EAT AN ARG + JRST APSUBD ; DONE +APSUB2: PUSH TP,A + PUSH TP,B + AOS E.CNT+1(TB) ; COUNT IT + JRST APSUB1 + +APSUBD: MOVE A,E.CNT+1(TB) ; FINISHED, GET COUNT + MOVE B,E.FCN+1(TB) ; AND SUBR + GETYP 0,E.FCN(TB) + CAIN 0,TENTER + JRST APENDN + PUSHJ P,BLTDN ; FLUSH CRUFT + .ACALL A,(B) + POPJ P, + +BLTDN: MOVEI C,(TB) ; POINT TO DEST + HRLI C,E.TSUB(C) ; AND SOURCE + BLT C,-E.TSUB(TP) ;BL..............T + SUB TP,[E.TSUB,,E.TSUB] + POPJ P, + +APENDN: PUSHJ P,BLTDN +APNDN1: .ECALL A,(B) + POPJ P, + +; FLAGS FOR RSUBR HACKER + +F.STR==1 +F.OPT==2 +F.QUO==4 +F.NFST==10 + +; APPLY OBJECTS OF TYPE RSUBR + +APENTR: +APRSUBR: + MOVE C,E.FCN+1(TB) ; GET THE RSUBR + CAML C,[-5,,] ; IS IT LONG ENOUGH FOR DECLS + JRST APSUBR ; NO TREAT AS A SUBR + GETYP 0,4(C) ; GET TYPE OF 3D ELEMENT + CAIE 0,TDECL ; DECLARATION? + JRST APSUBR ; NO, TREAT AS SUBR + PUSHJ P,PSH4ZR ; ALLOCATE SOME EXTRA ROOM + PUSH TP,$TDECL ; PUSH UP THE DECLS + PUSH TP,5(C) + PUSH TP,$TLOSE ; SAVE ROOM FOR VAL DECL + PUSH TP,[0] + SKIPG E.ARG+1(TB) + AOS E.CNT(TB) ; INDICATES IF MUST EVAL ARGS + MOVSI A,400000 ; MAKE SURE OF GOOD INDIRECT + IORM A,E.ARG+1(TB) + + SKIPN E.EXTR(TB) ; "EXTRA" ARG? + JRST APRSU1 ; NO, + MOVE 0,[SETZ EXTRGT] ; CHANGE THE ACCESS FCN + EXCH 0,E.ARG+1(TB) + HRRM 0,E.ARG(TB) ; REMEMBER IT + +APRSU1: MOVEI 0,0 ; INIT FLAG REGISTER + PUSH P,0 ; SAVE + +APRSU2: HRRZ A,E.DECL+1(TB) ; GET DECL LIST + JUMPE A,APRSU3 ; DONE! + HRRZ B,(A) ; CDR IT + MOVEM B,E.DECL+1(TB) + PUSHJ P,NXTDCL ; IS NEXT THING A STRING? + JRST APRSU4 ; NO, BETTER BE A TYPE + CAMN B,[ASCII /VALUE/] + JRST RSBVAL ; SAVE VAL DECL + TRON 0,F.NFST ; IF NOT FIRST, LOSE + CAME B,[ASCII /CALL/] ; CALL DECL + JRST APRSU7 + SKIPE E.CNT(TB) ; LEGAL? + JRST MPD + MOVE C,E.FRM(TB) + MOVE D,E.FRM+1(TB) ; GET FORM + JRST APRS10 ; HACK IT + +APRSU5: TROE 0,F.STR ; STRING STRING? + JRST MPD ; LOSER + CAMN B,[] + JRST .+3 + CAME B,[+1] ; OPTIONA? + JRST APRSU8 + TROE 0,F.OPT ; CHECK AND SET + JRST MPD ; OPTINAL OPTIONAL LOSES + JRST APRSU2 ; TO MAIN LOOP + +APRSU7: CAME B,[ASCII /QUOTE/] + JRST APRSU5 + TRO 0,F.STR + TROE 0,F.QUO ; TURN ON AND CHECK QUOTE + JRST MPD ; QUOTE QUOTE LOSES + JRST APRSU2 ; GO TO END OF LOOP + + +APRSU8: CAME B,[ASCII /ARGS/] + JRST APRSU9 + SKIPE E.CNT(TB) ; SKIP IF LEGAL + JRST MPD + HRRZ D,@E.FRM+1(TB) ; GET ARG LIST + MOVSI C,TLIST + +APRS10: HRRZ A,(A) ; GET THE DECL + MOVEM A,E.DECL+1(TB) ; CLOBBER + HRRZ B,(A) ; CHECK FOR TOO MUCH + JUMPN B,MPD + MOVE B,1(A) ; GET DECL + HLLZ A,(A) ; GOT THE DECL + MOVEM 0,(P) ; SAVE FLAGS + JSP E,CHKAB ; CHECK DEFER + PUSH TP,C + PUSH TP,D ; SAVE + PUSHJ P,TMATCH + JRST WTYP + AOS E.CNT+1(TB) ; COUNT ARG + JRST APRDON ; GO CALL RSUBR + +RSBVAL: HRRZ A,E.DECL+1(TB) ; GET DECL + JUMPE A,MPD + HRRZ B,(A) ; POINT TO DECL + MOVEM B,E.DECL+1(TB) ; SAVE NEW DECL POINTER + PUSHJ P,NXTDCL + JRST .+2 + JRST MPD + MOVEM A,E.VAL+1(TB) ; SAVE VAL DECL + MOVSI A,TDCLI + MOVEM A,E.VAL(TB) ; SET ITS TYPE + JRST APRSU2 + + +APRSU9: CAME B,[ASCII /TUPLE/] + JRST MPD + MOVEM 0,(P) ; SAVE FLAGS + HRRZ A,(A) ; CDR DECLS + MOVEM A,E.DECL+1(TB) + HRRZ B,(A) + JUMPN B,MPD ; LOSER + PUSH P,[0] ; COUNT ELEMENTS IN TUPLE + +APRTUP: PUSHJ P,@E.ARG+1(TB) ; GOBBLE ARGS + JRST APRTPD ; DONE + PUSH TP,A + PUSH TP,B + AOS (P) ; COUNT IT + JRST APRTUP ; AND GO + +APRTPD: POP P,C ; GET COUNT + ADDM C,E.CNT+1(TB) ; UPDATE MAIN COUNT + ASH C,1 ; # OF WORDS + HRLI C,TINFO ; BUILD FENCE POST + PUSH TP,C + PUSHJ P,TBTOTP ; GEN REL OFFSET TO TOP + PUSH TP,D + HRROI D,-1(TP) ; POINT TO TOP + SUBI D,(C) ; TO BASE + TLC D,-1(C) + MOVSI C,TARGS ; BUILD TYPE WORD + HLR C,OTBSAV(TB) + MOVE A,E.DECL+1(TB) + MOVE B,1(A) + HLLZ A,(A) ; TYPE/VAL + JSP E,CHKAB ; CHECK + PUSHJ P,TMATCH ; GOTO TYPE CHECKER + JRST WTYP + + SUB TP,[2,,2] ; REMOVE FENCE POST + +APRDON: SUB P,[1,,1] ; FLUSH CRUFT + MOVE A,E.CNT+1(TB) ; GET # OF ARGS + MOVE B,E.FCN+1(TB) + GETYP 0,E.FCN(TB) ; COULD BE ENTRY + MOVEI C,(TB) ; PREPARE TO BLT DOWN + HRLI C,E.TSUB+2(C) + BLT C,-E.TSUB+2(TP) + SUB TP,[E.TSUB+2,,E.TSUB+2] + CAIE 0,TRSUBR + JRST APNDNX + .ACALL A,(B) ; CALL THE RSUBR + JRST PFINIS + +APNDNX: .ECALL A,(B) + JRST PFINIS + + + + +APRSU4: MOVEM 0,(P) ; SAVE FLAGS + MOVE B,1(A) ; GET DECL + HLLZ A,(A) + JSP E,CHKAB + MOVE 0,(P) ; RESTORE FLAGS + PUSH TP,A + PUSH TP,B ; AND SAVE + SKIPE E.CNT(TB) ; ALREADY EVAL'D + JRST APREV0 + TRZN 0,F.QUO + JRST APREVA ; MUST EVAL ARG + MOVEM 0,(P) + HRRZ C,@E.FRM+1(TB) ; GET ARG? + TRNE 0,F.OPT ; OPTIONAL + JUMPE C,APRDN + JUMPE C,TFA ; NO, TOO FEW ARGS + MOVEM C,E.FRM+1(TB) + HLLZ A,(C) ; GET ARG + MOVE B,1(C) + JSP E,CHKAB ; CHECK THEM + +APRTYC: MOVE C,A ; SET UP FOR TMATCH + MOVE D,B + EXCH B,(TP) + EXCH A,-1(TP) ; SAVE STUFF +APRS11: PUSHJ P,TMATCH ; CHECK TYPE + JRST WTYP + + MOVE 0,(P) ; RESTORE FLAGS + TRZ 0,F.STR + AOS E.CNT+1(TB) + JRST APRSU2 ; AND GO ON + +APREV0: TRNE 0,F.QUO ; ATTEMPT TO QUOTE ALREADY EVAL'D ARG ? + JRST MPD ; YES, LOSE +APREVA: PUSHJ P,@E.ARG+1(TB) ; EVAL ONE + TDZA C,C ; C=0 ==> NONE LEFT + MOVEI C,1 + MOVE 0,(P) ; FLAGS + JUMPN C,APRTYC ; GO CHECK TYPE +APRDN: SUB TP,[2,,2] ; FLUSH DECL + TRNE 0,F.OPT ; OPTIONAL? + JRST APRDON ; ALL DONE + JRST TFA + +APRSU3: TRNE 0,F.STR ; END IN STRING? + JRST MPD + PUSHJ P,@E.ARG+1(TB) ; SEE IF ANYMORE ARGS + JRST APRDON + JRST TMA + + +; STANDARD ARGUMENT GETTERS USED IN APPLYING THINGS + +ARGCDR: HRRZ C,@E.FRM+1(TB) ; POINT TO ARGLIST (NOTE: POINTS 1 BEFORE WHERE ARG IS) + JUMPE C,CPOPJ ; LEAVE IF DONE + MOVEM C,E.FRM+1(TB) + GETYP 0,(C) ; GET TYPE OF ARG + CAIN 0,TSEG + JRST ARGCD1 ; SEG MENT HACK + PUSHJ P,FASTEV + JRST CPOPJ1 + +ARGCD1: PUSH TP,$TFORM ; PRETEND WE ARE A FORM + PUSH TP,1(C) + MCALL 1,EVAL + MOVEM A,E.SEG(TB) + MOVEM B,E.SEG+1(TB) + PUSHJ P,TYPSEG ; GET SEG TYPE CODE + HRRM C,E.ARG(TB) ; SAVE IT IN OBSCCURE PLACE + MOVE C,DSTORE ; FIX FOR TEMPLATE + MOVEM C,E.SEG(TB) + MOVE C,[SETZ SGARG] + MOVEM C,E.ARG+1(TB) ; SET NEW ARG GETTER + +; FALL INTO SEGARG + +SGARG: INTGO + HRRZ C,E.ARG(TB) ; SEG CODE TO C + MOVE D,E.SEG+1(TB) + MOVE A,E.SEG(TB) + MOVEM A,DSTORE + PUSHJ P,NXTLM ; GET NEXT ELEMENT + JRST SEGRG1 ; DONE + MOVEM D,E.SEG+1(TB) + MOVE D,DSTORE ; KEEP TYPE WINNING + MOVEM D,E.SEG(TB) + SETZM DSTORE + JRST CPOPJ1 ; RETURN + +SEGRG1: SETZM DSTORE + MOVEI C,ARGCDR + HRRM C,E.ARG+1(TB) ; RESET ARG GETTER + JRST ARGCDR + +; ARGUMENT GETTER FOR APPLY + +APLARG: INTGO + SKIPL A,E.FRM+1(TB) ; ANY ARGS LEFT + POPJ P, ; NO, EXIT IMMEDIATELY + ADD A,[2,,2] + MOVEM A,E.FRM+1(TB) + MOVE B,-1(A) ; RET NEXT ARG + MOVE A,-2(A) + JRST CPOPJ1 + +; STACKFORM ARG GETTER + +EVALRG: SKIPN C,@E.FRM+1(TB) ; ANY FORM? + POPJ P, + PUSHJ P,FASTEV + GETYP A,A ; CHECK FOR FALSE + CAIN A,TFALSE + POPJ P, + MOVE C,E.FRM+1(TB) ; GET OTHER FORM + PUSHJ P,FASTEV + JRST CPOPJ1 + + +; HERE TO APPLY NUMBERS + +APNUM: PUSHJ P,PSH4ZR ; TP SLOTS + SKIPN A,E.EXTR(TB) ; FUNNY ARG? + JRST APNUM1 ; NOPE + MOVE B,E.EXTR+1(TB) ; GET ARG + JRST APNUM2 + +APNUM1: PUSHJ P,@E.ARG+1(TB) ; GET ARG + JRST TFA +APNUM2: PUSH TP,A + PUSH TP,B + PUSH TP,E.FCN(TB) + PUSH TP,E.FCN+1(TB) + PUSHJ P,@E.ARG+1(TB) + JRST .+2 + JRST APNUM3 + PUSHJ P,BLTDN ; FLUSH JUNK + MCALL 2,NTH + POPJ P, +; HACK FOR TURNING <3 .FOO .BAR> INTO +APNUM3: PUSH TP,A + PUSH TP,B + PUSHJ P,@E.ARG+1(TB) + JRST .+2 + JRST TMA + PUSHJ P,BLTDN + GETYP A,-5(TP) + PUSHJ P,ISTRUC ; STRUCTURED FIRST ARG? + JRST WTYP1 + MCALL 3,PUT + POPJ P, + +; HERE TO APPLY SUSSMAN FUNARGS + +APFUNARG: + + SKIPN C,E.FCN+1(TB) + JRST FUNERR + HRRZ D,(C) ; MUST BE AT LEAST 2 LONG + JUMPE D,FUNERR + GETYP 0,(D) ; CHECK FOR LIST + CAIE 0,TLIST + JRST FUNERR + HRRZ 0,(D) ; SHOULD BE END + JUMPN 0,FUNERR + GETYP 0,(C) ; 1ST MUST BE FCN + CAIE 0,TEXPR + JRST FUNERR + SKIPN C,1(C) + JRST NOBODY + PUSHJ P,APEXPF ; BIND THE ARGS AND AUX'S + HRRZ C,RE.FCN+1(TB) ; GET BODY OF FUNARG + MOVE B,1(C) ; GET FCN + MOVEM B,RE.FCN+1(TB) ; AND SAVE + HRRZ C,(C) ; CDR FUNARG BODY + MOVE C,1(C) + MOVSI 0,TLIST ; SET UP TYPE + MOVE PVP,PVSTOR+1 + MOVEM 0,CSTO(PVP) ; FOR INTS TO WIN + +FUNLP: INTGO + JUMPE C,DOF ; RUN IT + GETYP 0,(C) + CAIE 0,TLIST ; BETTER BE LIST + JRST FUNERR + PUSH TP,$TLIST + PUSH TP,C + PUSHJ P,NEXTDC ; GET POSSIBILITY + JRST FUNERR ; LOSER + CAIE A,2 + JRST FUNERR + HRRZ B,(B) ; GET TO VALUE + MOVE C,(TP) + SUB TP,[2,,2] + PUSH TP,BNDA + PUSH TP,E + HLLZ A,(B) ; GET VAL + MOVE B,1(B) + JSP E,CHKAB ; HACK DEFER + PUSHJ P,PSHAB4 ; PUT VAL IN + HRRZ C,(C) ; CDR + JUMPN C,FUNLP + +; HERE TO RUN FUNARG + +DOF: MOVE PVP,PVSTOR+1 + SETZM CSTO(PVP) ; DONT CONFUSE GC + PUSHJ P,SPECBIND ; BIND 'EM UP + JRST RUNFUN + + + +; HERE TO DO MACROS + +APMACR: HRRZ E,OTBSAV(TB) + HRRZ D,PCSAV(E) ; SEE WHERE FROM + CAIE D,EFCALL+1 ; 1STEP + JRST .+3 + HRRZ E,OTBSAV(E) + HRRZ D,PCSAV(E) + CAIN D,AEVAL3 ; SKIP IF NOT RIGHT + JRST APMAC1 + SKIPG E.ARG+1(TB) ; SKIP IF REAL FORM EXISTS + JRST BADMAC + MOVE A,E.FRM(TB) + MOVE B,E.FRM+1(TB) + SUB TP,[E.EXTR+2,,E.EXTR+2] ; FLUSH JUNK + PUSH TP,A + PUSH TP,B + MCALL 1,EXPAND ; EXPAND THE MACRO + PUSH TP,A + PUSH TP,B + MCALL 1,EVAL ; EVAL THE RESULT + POPJ P, + +APMAC1: MOVE C,E.FCN+1(TB) ; GET MACRO BODY + GETYP A,(C) + MOVE B,1(C) + MOVSI A,(A) + JSP E,CHKAB ; FIX DEFERS + MOVEM A,E.FCN(TB) + MOVEM B,E.FCN+1(TB) + JRST APLDIX + +; HERE TO APPLY EXPRS (FUNCTIONS) + +APEXPR: PUSHJ P,APEXP ; BIND ARGS AND AUX'S +RUNFUN: HRRZ A,RE.FCN(TB) ; AMOUNT OF FCN TO SKIP + MOVEI C,RE.FCN+1(TB) ; POINT TO FCN + HRRZ C,(C) ; SKIP SOMETHING + SOJGE A,.-1 ; UNTIL 1ST FORM + MOVEM C,RE.FCN+1(TB) ; AND STORE + JRST DOPROG ; GO RUN PROGRAM + +APEXP: SKIPN C,E.FCN+1(TB) ; CHECK FRO BODY + JRST NOBODY +APEXPF: PUSH P,[0] ; COUNT INIT CRAP + ADD TP,[XP.TMP,,XP.TMP] ; SLOTS FOR HACKING + SKIPL TP + PUSHJ P,TPOVFL + SETZM 1-XP.TMP(TP) ; ZERO OUT + MOVEI A,-XP.TMP+2(TP) + HRLI A,-1(A) + BLT A,(TP) ; ZERO SLOTS + SKIPG E.ARG+1(TB) + AOS E.CNT(TB) ; INDICATES IF MUST EVAL ARGS + MOVSI A,400000 ; MAKE E.ARG BE NEG FOR SAFE @ING + IORM A,E.ARG+1(TB) + PUSHJ P,CARATC ; SEE IF HEWITT ATOM EXISTS + JRST APEXP1 ; NO, GO LOOK FOR ARGLIST + MOVEM E,E.HEW+1(TB) ; SAVE ATOM + MOVSM 0,E.HEW(TB) ; AND TYPE + AOS (P) ; COUNT HEWITT ATOM +APEXP1: GETYP 0,(C) ; LOOK AT NEXT THING + CAIE 0,TLIST ; BETTER BE LIST!!! + JRST MPD.0 ; LOSE + MOVE B,1(C) ; GET LIST + MOVEM B,E.ARGL+1(TB) ; SAVE + MOVSM 0,E.ARGL(TB) ; WITH TYPE + HRRZ C,(C) ; CDR THE FCN + JUMPE C,NOBODY ; BODYLESS FCN + GETYP 0,(C) ; SEE IF DCL LIST SUPPLIED + CAIE 0,TDECL + JRST APEXP2 ; NO, START PROCESSING ARGS + AOS (P) ; COUNT DCL + MOVE B,1(C) + MOVEM B,E.DECL+1(TB) + MOVSM 0,E.DECL(TB) + HRRZ C,(C) ; CDR ON + JUMPE C,NOBODY + + ; CHECK FOR EXISTANCE OF EXTRA ARG + +APEXP2: POP P,A ; GET COUNT + HRRM A,E.FCN(TB) ; AND SAVE + SKIPN E.EXTR(TB) ; SKIP IF FUNNY EXTRA ARG EXISTS + JRST APEXP3 + MOVE 0,[SETZ EXTRGT] + EXCH 0,E.ARG+1(TB) + HRRM 0,E.ARG(TB) ; SAVE OLD GETTER AROUND + AOS E.CNT(TB) + +; FALL THROUGH + +; LOOK FOR "BIND" DECLARATION + +APEXP3: PUSHJ P,UNPROG ; UNASSIGN LPROG IF NEC +APXP3A: SKIPN A,E.ARGL+1(TB) ; GET ARGLIST + JRST APEXP4 ; NONE, VERIFY NONE WERE GIVEN + PUSHJ P,NXTDCL ; SEE IF A DECL IS THERE + JRST BNDRG ; NO, GO BIND NORMAL ARGS + HRRZ C,(A) ; CDR THE DCLS + CAME B,[ASCII /BIND/] + JRST CH.CAL ; GO LOOK FOR "CALL" + PUSHJ P,CARTMC ; MUST BE AN ATOM + MOVEM C,E.ARGL+1(TB) ; AND SAVE CDR'D ARGS + PUSHJ P,MAKENV ; GENERATE AN ENVIRONMENT + PUSHJ P,PSBND1 ; PUSH THE BINDING AND CHECK THE DCL + JRST APXP3A ; IN CASE <"BIND" B "BIND" C...... + + +; LOOK FOR "CALL" DCL + +CH.CAL: CAME B,[ASCII /CALL/] + JRST CHOPT ; TRY SOMETHING ELSE +; SKIPG E.ARG+1(TB) ; DONT SKIP IF CANT WIN + SKIPE E.CNT(TB) + JRST MPD.2 + PUSHJ P,CARTMC ; BETTER BE AN ATOM + MOVEM C,E.ARGL+1(TB) + MOVE A,E.FRM(TB) ; RETURN FORM + MOVE B,E.FRM+1(TB) + PUSHJ P,PSBND1 ; BIND AND CHECK + JRST APEXP5 + +; BIND NORMAL ARGS BY CALLING BNDEM1, RETURNS WHEN ALL DONE + +BNDRG: PUSHJ P,BNDEM1 ; GO BIND THEM UP + TRNN A,4 ; SKIP IF HIT A DCL + JRST APEXP4 ; NOT A DCL, MUST BE DONE + +; LOOK FOR "OPTIONAL" DECLARATION + +CHOPT: CAMN B,[] + JRST .+3 + CAME B,[+1] + JRST CHREST ; TRY TUPLE/ARGS + MOVEM C,E.ARGL+1(TB) ; SAVE RESTED ARGLIST + PUSHJ P,BNDEM2 ; DO ALL SUPPLIED OPTIONALS + TRNN A,4 ; SKIP IF NEW DCL READ + JRST APEXP4 + +; CHECK FOR "ARGS" DCL + +CHREST: CAME B,[ASCII /ARGS/] + JRST CHRST1 ; GO LOOK FOR "TUPLE" +; SKIPGE E.ARG+1(TB) ; SKIP IF LEGAL + SKIPE E.CNT(TB) + JRST MPD.3 + PUSHJ P,CARTMC ; GOBBLE ATOM + MOVEM C,E.ARGL+1(TB) ; SAVE CDR'D ARG + HRRZ B,@E.FRM+1(TB) ; GET ARG LIST + MOVSI A,TLIST ; GET TYPE + PUSHJ P,PSBND1 + JRST APEXP5 + +; HERE TO CHECK FOR "TUPLE" + +CHRST1: CAME B,[ASCII /TUPLE/] + JRST APXP10 + PUSHJ P,CARTMC ; GOBBLE ATOM + MOVEM C,E.ARGL+1(TB) + SETZB A,B + PUSHJ P,PSHBND ; SET UP BINDING + SETZM E.CNT+1(TB) ; ZERO ARG COUNTER + +TUPLP: PUSHJ P,@E.ARG+1(TB) ; GET AN ARG + JRST TUPDON ; FINIS + AOS E.CNT+1(TB) + PUSH TP,A + PUSH TP,B + JRST TUPLP + +TUPDON: PUSHJ P,MAKINF ; MAKE INFO CELL + PUSH TP,$TINFO ; FENCE POST TUPLE + PUSHJ P,TBTOTP + ADDI D,TM.OFF ; COMPENSATE FOR MOVEMENT + PUSH TP,D + MOVE C,E.CNT+1(TB) ; GET COUNT + ASH C,1 ; TO WORDS + HRRM C,-1(TP) ; INTO FENCE POST + MOVEI B,-TM.OFF-1(TP) ; SETUP ARG POINTER + SUBI B,(C) ; POINT TO BASE OF TUPLE + MOVNS C ; FOR AOBJN POINTER + HRLI B,(C) ; GOOD ARGS POINTER + MOVEM A,TM.OFF-4(B) ; STORE + MOVEM B,TM.OFF-3(B) + + +; CHECK FOR VALID ENDING TO ARGS + +APEXP5: PUSHJ P,NEXTD ; READ NEXT THING IN ARGLIST + JRST APEXP8 ; DONE + TRNN A,4 ; SKIP IF DCL + JRST MPD.4 ; LOSER +APEXP7: MOVSI A,-NWINS ; CHECK FOR A WINNER + CAME B,WINRS(A) + AOBJN A,.-1 + JUMPGE A,MPD.6 ; NOT A WINNER + +; HERE TO BLT THE WORLD DOWN ON TOP OF ALL THE USELESS TEMPS + +APEXP8: MOVE 0,E.HEW+1(TB) ; GET HEWITT ATOM + MOVE E,E.FCN(TB) ; SAVE COUNTER + MOVE C,E.FCN+1(TB) ; FCN + MOVE B,E.ARGL+1(TB) ; ARG LIST + MOVE D,E.DECL+1(TB) ; AND DCLS + MOVEI A,R.TMP(TB) ; SET UP BLT + HRLI A,TM.OFF(A) + BLT A,-TM.OFF(TP) ; BLLLLLLLLLLLLLT + SUB TP,[TM.OFF,,TM.OFF] ; FLUSH CRUFT + MOVEM E,RE.FCN(TB) + MOVEM C,RE.FCN+1(TB) + MOVEM B,RE.ARGL+1(TB) + MOVE E,TP + PUSH TP,$TATOM + PUSH TP,0 + PUSH TP,$TDECL + PUSH TP,D + GETYP A,-5(TP) ; TUPLE ON TOP? + CAIE A,TINFO ; SKIP IF YES + JRST APEXP9 + HRRZ A,-5(TP) ; GET SIZE + ADDI A,2 + HRLI A,(A) + SUB E,A ; POINT TO BINDINGS + SKIPE C,(TP) ; IF DCL + PUSHJ P,CHKDCL ; CHECK TYPE SPEC ON TUPLE +APEXP9: PUSHJ P,USPCBE ; DO ACTUAL BINDING + + MOVE E,-2(TP) ; RESTORE HEWITT ATOM + MOVE D,(TP) ; AND DCLS + SUB TP,[4,,4] + + JRST AUXBND ; GO BIND AUX'S + +; HERE TO VERIFY CHECK IF ANY ARGS LEFT + +APEXP4: PUSHJ P,@E.ARG+1(TB) + JRST APEXP8 ; WIN + JRST TMA ; TOO MANY ARGS + +APXP10: PUSH P,B + PUSHJ P,@E.ARG+1(TB) + JRST .+2 + JRST TMA + POP P,B + JRST APEXP7 + +; LIST OF POSSIBLE TERMINATING NAMES + +WINRS: +AS.ACT: ASCII /ACT/ +AS.NAM: ASCII /NAME/ +AS.AUX: ASCII /AUX/ +AS.EXT: ASCII /EXTRA/ +NWINS==.-WINRS + + +; HERE TO BIND AUX VARIABLES FOR PROGS AND FCNS + +AUXBND: PUSH P,E ; SAVE HEWITT ATOM ( WILL PUT ON MARKED STACK + ; WHEN NECESSARY) + PUSH P,D ; SAME WITH DCL LIST + PUSH P,[-1] ; FLAG SAYING WE ARE FCN + SKIPN C,RE.ARG+1(TB) ; GET ARG LIST + JRST AUXDON + GETYP 0,(C) ; GET TYPE + CAIE 0,TDEFER ; SKIP IF CHSTR + MOVMS (P) ; SAY WE ARE IN OPTIONALS + JRST AUXB1 + +PRGBND: PUSH P,E + PUSH P,D + PUSH P,[0] ; WE ARE IN AUXS + +AUXB1: HRRZ C,RE.ARG+1(TB) ; POINT TO ARGLIST + PUSHJ P,NEXTDC ; GET NEXT THING OFF OF ARG LIST + JRST AUXDON + TRNE A,4 ; SKIP IF SOME KIND OF ATOM + JRST TRYDCL ; COUDL BE DCL + TRNN A,1 ; SKIP IF QUOTED + JRST AUXB2 + SKIPN (P) ; SKIP IF QUOTED OK + JRST MPD.11 +AUXB2: PUSHJ P,PSHBND ; SET UP BINDING + PUSH TP,$TDECL ; SAVE HEWITT ATOM + PUSH TP,-1(P) + PUSH TP,$TATOM ; AND DECLS + PUSH TP,-2(P) + TRNN A,2 ; SKIP IF INIT VAL EXISTS + JRST AUXB3 ; NO, USE UNBOUND + +; EVALUATE EXPRESSION + + HRRZ C,(B) ; CDR ATOM OFF + +; CHECK FOR SPECIAL FORMS + + GETYP 0,(C) ; GET TYPE OF GOODIE + CAIE 0,TFORM ; SMELLS LIKE A FORM + JRST AUXB13 + HRRZ D,1(C) ; GET 1ST ELEMENT + GETYP 0,(D) ; AND ITS VAL + CAIE 0,TATOM ; FEELS LIKE THE RIGHT FORM + JRST AUXB13 + + MOVE 0,1(D) ; GET THE ATOM + CAME 0,IMQUOTE TUPLE + CAMN 0,MQUOTE ITUPLE + JRST DOTUPL ; SURE GLAD I DIDN'T STEP IN THAT FORM + + +AUXB13: PUSHJ P,FASTEV +AUXB14: MOVE E,TP +AUXB4: MOVEM A,-7(E) ; STORE VAL IN BINDING + MOVEM B,-6(E) + +; HERE TO CHECK AGAINST DECLARATIONS AND COMPLETE THE BINDING + +AUXB5: SUB E,[4,,4] ; POINT TO BINDING TOP + SKIPE C,-2(TP) ; POINT TO DECLARATINS + PUSHJ P,CHKDCL ; CHECK IT + PUSHJ P,USPCBE ; AND BIND UP + SKIPE C,RE.ARG+1(TB) ; CDR DCLS + HRRZ C,(C) ; IF ANY TO CDR + MOVEM C,RE.ARG+1(TB) + MOVE A,(TP) ; NOW PUT HEWITT ATOM AND DCL AWAY + MOVEM A,-2(P) + MOVE A,-2(TP) + MOVEM A,-1(P) + SUB TP,[4,,4] ; FLUSH SLOTS + JRST AUXB1 + + +AUXB3: MOVNI B,1 + MOVSI A,TUNBOU + JRST AUXB14 + + + +; HERE TO HANDLE "CALLS" TO TUPLE AND ITUPLE + +DOTUPL: SKIPE E,(P) ; SKIP IF IN AUX LIST + JRST TUPLE + PUSH TP,$TLIST ; SAVE THE MAGIC FORM + PUSH TP,D + CAME 0,IMQUOTE TUPLE + JRST DOITUP ; DO AN ITUPLE + +; FALL INTO A TUPLE PUSHING LOOP + +DOTUP1: HRRZ C,@(TP) ; CDR THE FORM + JUMPE C,ATUPDN ; FINISHED + MOVEM C,(TP) ; SAVE CDR'D RESULT + GETYP 0,(C) ; CHECK FOR SEGMENT + CAIN 0,TSEG + JRST DTPSEG ; GO PULL IT APART + PUSHJ P,FASTEV ; EVAL IT + PUSHJ P,CNTARG ; PUSH IT UP AND COUNT THEM + JRST DOTUP1 + +; HERE WHEN WE FINISH + +ATUPDN: SUB TP,[2,,2] ; FLUSH THE LIST + ASH E,1 ; E HAS # OF ARGS DOUBLE IT + MOVEI D,(TP) ; FIND BASE OF STACK AREA + SUBI D,(E) + MOVSI C,-3(D) ; PREPARE BLT POINTER + BLT C,C ; HEWITT ATOM AND DECL TO 0,A,B,C + +; NOW PREPEARE TO BLT TUPLE DOWN + + MOVEI D,-3(D) ; NEW DEST + HRLI D,4(D) ; SOURCE + BLT D,-4(TP) ; SLURP THEM DOWN + + HRLI E,TINFO ; SET UP FENCE POST + MOVEM E,-3(TP) ; AND STORE + PUSHJ P,TBTOTP ; GET OFFSET + ADDI D,3 ; FUDGE FOR NOT AT TOP OF STACK + MOVEM D,-2(TP) + MOVEM 0,-1(TP) ; RESTORE HEW ATOM AND DECLS + MOVEM A,(TP) + PUSH TP,B + PUSH TP,C + + PUSHJ P,MAKINF ; MAKE 1ST WORD OF FUNNYS + + HRRZ E,-5(TP) ; RESTORE WORDS OF TUPLE + HRROI B,-5(TP) ; POINT TO TOP OF TUPLE + SUBI B,(E) ; NOW BASE + TLC B,-1(E) ; FIX UP AOBJN PNTR + ADDI E,2 ; COPNESATE FOR FENCE PST + HRLI E,(E) + SUBM TP,E ; E POINT TO BINDING + JRST AUXB4 ; GO CLOBBER IT IN + + +; HERE TO HANDLE SEGMENTS IN THESE FUNNY FORMS + +DTPSEG: PUSH TP,$TFORM ; SAVE THE HACKER + PUSH TP,1(C) + MCALL 1,EVAL ; AND EVALUATE IT + MOVE D,B ; GET READY FOR A SEG LOOP + MOVEM A,DSTORE + PUSHJ P,TYPSEG ; TYPE AND CHECK IT + +DTPSG1: INTGO ; DONT BLOW YOUR STACK + PUSHJ P,NXTLM ; ELEMENT TO A AND B + JRST DTPSG2 ; DONE + PUSHJ P,CNTARG ; PUSH AND COUNT + JRST DTPSG1 + +DTPSG2: SETZM DSTORE + HRRZ E,-1(TP) ; GET COUNT IN CASE END + JRST DOTUP1 ; REST OF ARGS STILL TO DO + +; HERE TO HACK + +DOITUP: HRRZ C,@(TP) ; GET COUNT FILED + JUMPE C,TFA + MOVEM C,(TP) + PUSHJ P,FASTEV ; EVAL IT + GETYP 0,A + CAIE 0,TFIX + JRST WTY1TP + + JUMPL B,BADNUM + + HRRZ C,@(TP) ; GET EXP TO EVAL + MOVEI 0,0 ; DONT LOSE IN 1 ARG CASE + HRRZ 0,(C) ; VERIFY WINNAGE + JUMPN 0,TMA ; TOO MANY + + JUMPE B,DOIDON + PUSH P,B ; SAVE COUNT + PUSH P,B + JUMPE C,DOILOS + PUSHJ P,FASTEV ; EVAL IT ONCE + MOVEM A,-1(TP) + MOVEM B,(TP) + +DOILP: INTGO + PUSH TP,-1(TP) + PUSH TP,-1(TP) + MCALL 1,EVAL + PUSHJ P,CNTRG + SOSLE (P) + JRST DOILP + +DOIDO1: MOVE B,-1(P) ; RESTORE COUNT + SUB P,[2,,2] + +DOIDON: MOVEI E,(B) + JRST ATUPDN + +; FOR CASE OF NO EVALE + +DOILOS: SUB TP,[2,,2] +DOILLP: INTGO + PUSH TP,[0] + PUSH TP,[0] + SOSL (P) + JRST DOILLP + JRST DOIDO1 + +; ROUTINE TO PUSH NEXT TUPLE ELEMENT + +CNTARG: AOS E,-1(TP) ; KEEP ARG COUNT UP TO DATE IN E +CNTRG: EXCH A,-1(TP) ; STORE ELEM AND GET SAVED + EXCH B,(TP) + PUSH TP,A + PUSH TP,B + POPJ P, + + +; DUMMY TUPLE AND ITUPLE + +IMFUNCTION TUPLE,SUBR + + ENTRY + ERRUUO EQUOTE NOT-IN-AUX-LIST + +MFUNCTIO ITUPLE,SUBR + JRST TUPLE + + +; PROCESS A DCL IN THE AUX VAR LISTS + +TRYDCL: SKIPN (P) ; SKIP IF NOT IN AUX'S + JRST AUXB7 + CAME B,AS.AUX ; "AUX" ? + CAMN B,AS.EXT ; OR "EXTRA" + JRST AUXB9 ; YES + CAME B,[ASCII /TUPLE/] + JRST AUXB10 + PUSHJ P,MAKINF ; BUILD EMPTY TUPLE + MOVEI B,1(TP) + PUSH TP,$TINFO ; FENCE POST + PUSHJ P,TBTOTP + PUSH TP,D +AUXB6: HRRZ C,(C) ; CDR PAST DCL + MOVEM C,RE.ARG+1(TB) +AUXB8: PUSHJ P,CARTMC ; GET ATOM +AUXB12: PUSHJ P,PSHBND ; UP GOES THE BINDING + PUSH TP,$TATOM ; HIDE HEWITT ATOM AND DCL + PUSH TP,-1(P) + PUSH TP,$TDECL + PUSH TP,-2(P) + MOVE E,TP + JRST AUXB5 + +; CHECK FOR ARGS + +AUXB10: CAME B,[ASCII /ARGS/] + JRST AUXB7 + MOVEI B,0 ; NULL ARG LIST + MOVSI A,TLIST + JRST AUXB6 ; GO BIND + +AUXB9: SETZM (P) ; NOW READING AUX + HRRZ C,(C) + MOVEM C,RE.ARG+1(TB) + JRST AUXB1 + +; CHECK FOR NAME/ACT + +AUXB7: CAME B,AS.NAM + CAMN B,AS.ACT + JRST .+2 + JRST MPD.12 ; LOSER + HRRZ C,(C) ; CDR ON + HRRZ 0,(C) ; BETTER BE END + JUMPN 0,MPD.13 + PUSHJ P,CARTMC ; FORCE ATOM READ + SETZM RE.ARG+1(TB) +AUXB11: PUSHJ P,MAKACT ; MAKE ACTIVATION + JRST AUXB12 ; AND BIND IT + + +; DONE BIND HEWITT ATOM IF NECESARY + +AUXDON: SKIPN E,-2(P) + JRST AUXD1 + SETZM -2(P) + JRST AUXB11 + +; FINISHED, RETURN + +AUXD1: SUB P,[3,,3] + POPJ P, + + +; MAKE AN ACTIVATION OR ENVIRONMNENT + +MAKACT: MOVEI B,(TB) + MOVSI A,TACT +MAKAC1: MOVE PVP,PVSTOR+1 + HRRI A,PVLNT*2+1(PVP) ; POINT TO PROCESS + HLL B,OTBSAV(B) ; GET TIME + POPJ P, + +MAKENV: MOVSI A,TENV + HRRZ B,OTBSAV(TB) + JRST MAKAC1 + +; SEVERAL USEFUL LITTLE ROUTINES FOR HACKING THIS STUFF + +; CARAT/CARATC/CARATM/CARTMC ALL LOOK FOR THE NEXT ATOM + +CARAT: HRRZ C,E.ARGL+1(TB) ; PICK UP ARGLIST +CARATC: JUMPE C,CPOPJ ; FOUND + GETYP 0,(C) ; GET ITS TYPE + CAIE 0,TATOM +CPOPJ: POPJ P, ; RETURN, NOT ATOM + MOVE E,1(C) ; GET ATOM + HRRZ C,(C) ; CDR DCLS + JRST CPOPJ1 + +CARATM: HRRZ C,E.ARGL+1(TB) +CARTMC: PUSHJ P,CARATC + JRST MPD.7 ; REALLY LOSE + POPJ P, + + +; SUBROUTINES TO PUSH BINDINGS ETC. UP ON THE STACK + +PSBND1: PUSHJ P,PSHBND ; PUSH THEBINDING + JRST CHDCL ; NOW CHECK IT AGAINST DECLARATION + +PSHBND: SKIPGE SPCCHK ; SKIP IF NORMAL SPECIAL + PUSH TP,BNDA1 ; ATOM IN E + SKIPL SPCCHK ; SKIP IF NORMAL UNSPEC OR NO CHECK + PUSH TP,BNDA + PUSH TP,E ; PUSH IT +PSHAB4: PUSH TP,A + PUSH TP,B + PUSH TP,[0] + PUSH TP,[0] + POPJ P, + +; ROUTINE TO PUSH 4 0'S + +PSH4ZR: SETZB A,B + JRST PSHAB4 + + +; EXTRRA ARG GOBBLER + +EXTRGT: HRRZ A,E.ARG(TB) ; RESET SLOT + SETZM E.CNT(TB) + CAIE A,ARGCDR ; IF NOT ARGCDR + AOS E.CNT(TB) + TLO A,400000 ; SET FLAG + MOVEM A,E.ARG+1(TB) + MOVE A,E.EXTR(TB) ; RET ARG + MOVE B,E.EXTR+1(TB) + JRST CPOPJ1 + +; CHECK A/B FOR DEFER + +CHKAB: GETYP 0,A + CAIE 0,TDEFER ; SKIP IF DEFER + JRST (E) + MOVE A,(B) + MOVE B,1(B) ; GET REAL THING + JRST (E) +; IF DECLARATIONS EXIST, DO THEM + +CHDCL: MOVE E,TP +CHDCLE: SKIPN C,E.DECL+1(TB) + POPJ P, + JRST CHKDCL + +; ROUTINE TO READ NEXT THING FROM ARGLIST + +NEXTD: HRRZ C,E.ARGL+1(TB) ; GET ARG LIST +NEXTDC: MOVEI A,0 + JUMPE C,CPOPJ + PUSHJ P,CARATC ; TRY FOR AN ATOM + JRST NEXTD1 ; NO + JRST CPOPJ1 + +NEXTD1: CAIE 0,TFORM ; FORM? + JRST NXT.L ; COULD BE LIST + PUSHJ P,CHQT ; VERIFY 'ATOM + MOVEI A,1 + JRST CPOPJ1 + +NXT.L: CAIE 0,TLIST ; COULD BE (A ) OR ('A ) + JRST NXT.S ; BETTER BE A DCL + PUSHJ P,LNT.2 ; VERIFY LENGTH IS 2 + JRST MPD.8 + CAIE 0,TATOM ; TYPE OF 1ST RET IN 0 + JRST LST.QT ; MAY BE 'ATOM + MOVE E,1(B) ; GET ATOM + MOVEI A,2 + JRST CPOPJ1 +LST.QT: CAIE 0,TFORM ; FORM? + JRST MPD.9 ; LOSE + PUSH P,C + MOVEI C,(B) ; VERIFY 'ATOM + PUSHJ P,CHQT + MOVEI B,(C) ; POINT BACK TO LIST + POP P,C + MOVEI A,3 ; CODE + JRST CPOPJ1 + +NXT.S: MOVEI A,(C) ; LET NXTDCL FIND OUT + PUSHJ P,NXTDCL + JRST MPD.3 ; LOSER + MOVEI A,4 ; SET DCL READ FLAG + JRST CPOPJ1 + +; ROUTINE TO CHECK LENGTH OF LIST/FORM FOR BEING 2 + +LNT.2: HRRZ B,1(C) ; GET LIST/FORM + JUMPE B,CPOPJ + HRRZ B,(B) + JUMPE B,CPOPJ + HRRZ B,(B) ; BETTER END HERE + JUMPN B,CPOPJ + HRRZ B,1(C) ; LIST BACK + GETYP 0,(B) ; TYPE OF 1ST ELEMENT + JRST CPOPJ1 + +; ROUTINE TO VERIFY FORM IS 'ATOM AND RET ATOM + +CHQT: PUSHJ P,LNT.2 ; 1ST LENGTH CHECK + JRST MPD.5 + CAIE 0,TATOM + JRST MPD.5 + MOVE 0,1(B) + CAME 0,IMQUOTE QUOTE + JRST MPD.5 ; BETTER BE QUOTE + HRRZ E,(B) ; CDR + GETYP 0,(E) ; TYPE + CAIE 0,TATOM + JRST MPD.5 + MOVE E,1(E) ; GET QUOTED ATOM + POPJ P, + +; ARG BINDER FOR REGULAR ARGS AND OPTIONALS + +BNDEM1: PUSH P,[0] ; REGULAR FLAG + JRST .+2 +BNDEM2: PUSH P,[1] +BNDEM: PUSHJ P,NEXTD ; GET NEXT THING + JRST CCPOPJ ; END OF THINGS + TRNE A,4 ; CHECK FOR DCL + JRST BNDEM4 + TRNE A,2 ; SKIP IF NOT (ATM ..) OR ('ATM ...) + SKIPE (P) ; SKIP IF REG ARGS + JRST .+2 ; WINNER, GO ON + JRST MPD.6 ; LOSER + SKIPGE SPCCHK + PUSH TP,BNDA1 ; SAVE ATOM + SKIPL SPCCHK + PUSH TP,BNDA + PUSH TP,E +; SKIPGE E.ARG+1(TB) ; ALREADY EVAL'D ARG? + SKIPE E.CNT(TB) + JRST RGLAR0 + TRNN A,1 ; SKIP IF ARG QUOTED + JRST RGLARG + HRRZ D,@E.FRM+1(TB) ; GET AND CDR ARG + JUMPE D,TFACHK ; OH OH MAYBE TOO FEW ARGS + MOVEM D,E.FRM+1(TB) ; STORE WINNER + HLLZ A,(D) ; GET ARG + MOVE B,1(D) + JSP E,CHKAB ; HACK DEFER + JRST BNDEM3 ; AND GO ON + +RGLAR0: TRNE A,1 ; ATTEMPT TO QUOTE ALREADY EVAL'D ARG ? + JRST MPD ; YES, LOSE +RGLARG: PUSH P,A ; SAVE FLAGS + PUSHJ P,@E.ARG+1(TB) + JRST TFACH1 ; MAY GE TOO FEW + SUB P,[1,,1] +BNDEM3: HRRZ C,@E.ARGL+1(TB) ; CDR THHE ARGS + MOVEM C,E.ARGL+1(TB) + PUSHJ P,PSHAB4 ; PUSH VALUE AND SLOTS + PUSHJ P,CHDCL ; CHECK DCLS + JRST BNDEM ; AND BIND ON! + +; HERE WHEN ARGS RUN OUT, IF NOT OPTIONAL, GIVE TFA + +TFACH1: POP P,A +TFACHK: SUB TP,[2,,2] ; FLUSH ATOM + SKIPN (P) ; SKIP IF OPTIONALS + JRST TFA +CCPOPJ: SUB P,[1,,1] + POPJ P, + +BNDEM4: HRRZ C,@E.ARGL+1(TB) ; POINT TO REST OF ARGL + JRST CCPOPJ + + +; EVALUATE LISTS, VECTORS, UNIFROM VECTORS + +EVLIST: PUSH P,[-1] ;-1 -- THIS IS A LIST + JRST EVL1 ;GO TO HACKER + +EVECT: PUSH P,[0] ;0 -- THIS IS A GENERAL VECTOR + JRST EVL1 + +EUVEC: PUSH P,[1] ;1 -- THIS IS A UNIFORM VECTOR + +EVL1: PUSH P,[0] ;PUSH A COUNTER + GETYPF A,(AB) ;GET FULL TYPE + PUSH TP,A + PUSH TP,1(AB) ;AND VALUE + +EVL2: INTGO ;CHECK INTERRUPTS + SKIPN A,1(TB) ;ANYMORE + JRST EVL3 ;NO, QUIT + SKIPL -1(P) ;SKIP IF LIST + JUMPG A,EVL3 ;JUMP IF VECTOR EMPTY + GETYPF B,(A) ;GET FULL TYPE + SKIPGE C,-1(P) ;SKIP IF NOT LIST + HLLZS B ;CLOBBER CDR FIELD + JUMPG C,EVL7 ;HACK UNIFORM VECS +EVL8: PUSH P,B ;SAVE TYPE WORD ON P + CAMN B,$TSEG ;SEGMENT? + MOVSI B,TFORM ;FAKE OUT EVAL + PUSH TP,B ;PUSH TYPE + PUSH TP,1(A) ;AND VALUE + JSP E,CHKARG ; CHECK DEFER + MCALL 1,EVAL ;AND EVAL IT + POP P,C ;AND RESTORE REAL TYPE + CAMN C,$TSEG ;SEGMENT? + JRST DOSEG ;YES, HACK IT + AOS (P) ;COUNT ELEMENT + PUSH TP,A ;AND PUSH IT + PUSH TP,B +EVL6: SKIPGE A,-1(P) ;DONT SKIP IF LIST + HRRZ B,@1(TB) ;CDR IT + JUMPL A,ASTOTB ;AND STORE IT + MOVE B,1(TB) ;GET VECTOR POINTER + ADD B,AMNT(A) ;INCR BY APPROPRIATE AMOUNT +ASTOTB: MOVEM B,1(TB) ;AND STORE BACK + JRST EVL2 ;AND LOOP BACK + +AMNT: 2,,2 ;INCR FOR GENERAL VECTOR + 1,,1 ;SAME FOR UNIFORM VECTOR + +CHKARG: GETYP A,-1(TP) + CAIE A,TDEFER + JRST (E) + HRRZS (TP) ;MAKE SURE INDIRECT WINS + MOVE A,@(TP) + MOVEM A,-1(TP) ;CLOBBER IN TYPE SLOT + MOVE A,(TP) ;NOW GET POINTER + MOVE A,1(A) ;GET VALUE + MOVEM A,(TP) ;CLOBBER IN + JRST (E) + + + +EVL7: HLRE C,A ; FIND TYPE OF UVECTOR + SUBM A,C ;C POINTS TO DOPE WORD + GETYP B,(C) ;GET TYPE + MOVSI B,(B) ;TO LH NOW + SOJA A,EVL8 ;AND RETURN TO DO EVAL + +EVL3: SKIPL -1(P) ;SKIP IF LIST + JRST EVL4 ;EITHER VECTOR OR UVECTOR + + MOVEI B,0 ;GET A NIL +EVL9: MOVSI A,TLIST ;MAKE TYPE WIN +EVL5: SOSGE (P) ;COUNT DOWN + JRST EVL10 ;DONE, RETURN + PUSH TP,$TLIST ;SET TO CALL CONS + PUSH TP,B + MCALL 2,CONS + JRST EVL5 ;LOOP TIL DONE + + +EVL4: MOVEI B,EUVECT ;UNIFORM CASE + SKIPG -1(P) ;SKIP IF UNIFORM CASE + MOVEI B,EVECTO ;NO, GENERAL CASE + POP P,A ;GET COUNT + .ACALL A,(B) ;CALL CREATOR +EVL10: GETYPF A,(AB) ; USE SENT TYPE + JRST EFINIS + + +; PROCESS SEGMENTS FOR THESE HACKS + +DOSEG: PUSHJ P,TYPSEG ; FIND WHAT IS BEING SEGMENTED + JUMPE C,LSTSEG ; CHECK END SPLICE IF LIST + +SEG3: PUSHJ P,NXTELM ; GET THE NEXTE ELEMT + JRST SEG4 ; RETURN TO CALLER + AOS (P) ; COUNT + JRST SEG3 ; TRY AGAIN +SEG4: SETZM DSTORE + JRST EVL6 + +TYPSEG: PUSHJ P,TYPSGR + JRST ILLSEG + POPJ P, + +TYPSGR: MOVE E,A ; SAVE TYPE + GETYP A,A ; TYPE TO RH + PUSHJ P,SAT ;GET STORAGE TYPE + MOVE D,B ; GOODIE TO D + + MOVNI C,1 ; C <0 IF ILLEGAL + CAIN A,S2WORD ;LIST? + MOVEI C,0 + CAIN A,S2NWORD ;GENERAL VECTOR? + MOVEI C,1 + CAIN A,SNWORD ;UNIFORM VECTOR? + MOVEI C,2 + CAIN A,SCHSTR + MOVEI C,3 + CAIN A,SBYTE + MOVEI C,5 + CAIN A,SSTORE ;SPECIAL AFREE STORAGE ? + MOVEI C,4 ;TREAT LIKE A UVECTOR + CAIN A,SARGS ;ARGS TUPLE? + JRST SEGARG ;NO, ERROR + CAILE A,NUMSAT ; SKIP IF NOT TEMPLATE + JRST SEGTMP + MOVE A,PTYPS(C) + CAIN A,4 + MOVEI A,2 ; NOW TREAT LIKE A UVECTOR + HLL E,A +MSTOR1: JUMPL C,CPOPJ + +MDSTOR: MOVEM E,DSTORE + JRST CPOPJ1 + +SEGTMP: MOVEI C,4 + HRRI E,(A) + JRST MSTOR1 + +SEGARG: MOVSI A,TARGS + HRRI A,(E) + PUSH TP,A ;PREPARE TO CHECK ARGS + PUSH TP,D + MOVEI B,-1(TP) ;POINT TO SAVED COPY + PUSHJ P,CHARGS ;CHECK ARG POINTER + POP TP,D ;AND RESTORE WINNER + POP TP,E ;AND TYPE AND FALL INTO VECTOR CODE + MOVEI C,1 + JRST MSTOR1 + +LSTSEG: SKIPL -1(P) ;SKIP IF IN A LIST + JRST SEG3 ;ELSE JOIN COMMON CODE + HRRZ A,@1(TB) ;CHECK FOR END OF LIST + JUMPN A,SEG3 ;NO, JOIN COMMON CODE + SETZM DSTORE ;CLOBBER SAVED GOODIES + JRST EVL9 ;AND FINISH UP + +NXTELM: INTGO + PUSHJ P,NXTLM ; GOODIE TO A AND B + POPJ P, ; DONE + PUSH TP,A + PUSH TP,B + JRST CPOPJ1 +NXTLM: XCT TESTR(C) ; SKIP IF MORE IN SEGEMNT + POPJ P, + XCT TYPG(C) ; GET THE TYPE + XCT VALG(C) ; AND VALUE + JSP E,CHKAB ; CHECK DEFERRED + XCT INCR1(C) ; AND INCREMENT TO NEXT +CPOPJ1: AOS (P) ; SKIP RETURN + POPJ P, + +; TABLES FOR SEGMENT OPERATIONS (0->LIST, 1->VECTOR/ARGS, 2->UVEC, 3->STRING) + +PTYPS: TLIST,, + TVEC,, + TUVEC,, + TCHSTR,, + TSTORA,, + TBYTE,, + +TESTR: SKIPN D + SKIPL D + SKIPL D + PUSHJ P,CHRDON + PUSHJ P,TM1 + PUSHJ P,CHRDON + +TYPG: PUSHJ P,LISTYP + GETYPF A,(D) + PUSHJ P,UTYPE + MOVSI A,TCHRS + PUSHJ P,TM2 + MOVSI A,TFIX + +VALG: MOVE B,1(D) + MOVE B,1(D) + MOVE B,(D) + PUSHJ P,1CHGT + PUSHJ P,TM3 + PUSHJ P,1CHGT + +INCR1: HRRZ D,(D) + ADD D,[2,,2] + ADD D,[1,,1] + PUSHJ P,1CHINC + ADD D,[1,,] + PUSHJ P,1CHINC + +TM1: HRRZ A,DSTORE + SKIPE DSTORE + HRRZ A,DSTORE ; GET SAT + SUBI A,NUMSAT+1 + ADD A,TD.LNT+1 + EXCH C,D + XCT (A) + HLRZ 0,C ; GET AMNT RESTED + SUB B,0 + EXCH C,D + TRNE B,-1 + AOS (P) + POPJ P, + +TM3: +TM2: HRRZ 0,DSTORE + SKIPE DSTORE + HRRZ 0,DSTORE + PUSH P,C + PUSH P,D + PUSH P,E + MOVE B,D + MOVEI C,0 ; GET "1ST ELEMENT" + PUSHJ P,TMPLNT ; GET NTH IN A AND B + POP P,E + POP P,D + POP P,C + POPJ P, + +CHRDON: HRRZ B,DSTORE + SKIPE DSTORE + HRRZ B,DSTORE ; POIT TO DOPE WORD + JUMPE B,CHRFIN + AOS (P) +CHRFIN: POPJ P, + +LISTYP: GETYP A,(D) + MOVSI A,(A) + POPJ P, +1CHGT: MOVE B,D + ILDB B,B + POPJ P, + +1CHINC: IBP D + SKIPN DSTORE + JRST 1CHIN1 + SOS DSTORE + POPJ P, + +1CHIN1: SOS DSTORE + POPJ P, + +UTYPE: HLRE A,D + SUBM D,A + GETYP A,(A) + MOVSI A,(A) + POPJ P, + + +;COMPILER's CALL TO DOSEG +SEGMNT: PUSHJ P,TYPSEG +SEGLP1: SETZB A,B +SEGLOP: PUSHJ P,NXTELM + JRST SEGRET + AOS (P)-2 ; INCREMENT COMPILER'S COUNT + JRST SEGLOP + +SEGRET: SETZM DSTORE + POPJ P, + +SEGLST: PUSHJ P,TYPSEG + JUMPN C,SEGLS2 +SEGLS3: SETZM DSTORE + MOVSI A,TLIST +SEGLS1: SOSGE -2(P) ; START COUNT DOWN + POPJ P, + MOVEI E,(B) + POP TP,D + POP TP,C + PUSHJ P,ICONS + JRST SEGLS1 + +SEGLS2: PUSHJ P,NXTELM + JRST SEGLS4 + AOS -2(P) + JRST SEGLS2 + +SEGLS4: MOVEI B,0 + JRST SEGLS3 + + +;SPECBIND BINDS IDENTIFIERS. IT IS CALLED BY PUSHJ P,SPECBIND. +;SPECBIND IS PROVIDED WITH A CONTIGUOUS SET OF TRIPLETS ON TP. +;EACH TRIPLET IS AS FOLLOWS: +;THE FIRST ELEMENT IS THE IDENTIFIER TO BE BOUND, ITS TYPE WORD IS [TATOM,,-1], +;THE SECOND IS THE VALUE TO WHICH IT IS TO BE ASSIGNED, +;AND THE THIRD IS A PAIR OF ZEROES. + +BNDA1: TATOM,,-2 +BNDA: TATOM,,-1 +BNDV: TVEC,,-1 + +USPECBIND: + MOVE E,TP +USPCBE: PUSH P,$TUBIND + JRST .+3 + +SPECBIND: + MOVE E,TP ;GET THE POINTER TO TOP +SPECBE: PUSH P,$TBIND + ADD E,[1,,1] ;BUMP POINTER ONCE + SETZB 0,D ;CLEAR TEMPS + PUSH P,0 + MOVEI 0,(TB) ; FOR CHECKS + +BINDLP: MOVE A,-4(E) ; CHECK FOR VEC BIND + CAMN A,BNDV + JRST NONID + MOVE A,-6(E) ;GET TYPE + CAME A,BNDA1 ; FOR UNSPECIAL + CAMN A,BNDA ;NORMAL ID BIND? + CAILE 0,-6(E) ; MAKE SURE NOT GOING UNDER FRAME + JRST SPECBD + SUB E,[6,,6] ;MOVE PTR + SKIPE D ;LINK? + HRRM E,(D) ;YES -- LOBBER + SKIPN (P) ;UPDATED? + MOVEM E,(P) ;NO -- DO IT + + MOVE A,0(E) ;GET ATOM PTR + MOVE B,1(E) + PUSHJ P,SILOC ;GET LAST BINDING + MOVS A,OTBSAV (TB) ;GET TIME + HRL A,5(E) ; GET DECL POINTER + MOVEM A,4(E) ;CLOBBER IT AWAY + MOVE A,(E) ; SEE IF SPEC/UNSPEC + TRNN A,1 ; SKIP, ALWAYS SPEC + SKIPA A,-1(P) ; USE SUPPLIED + MOVSI A,TBIND + MOVEM A,(E) ;IDENTIFY AS BIND BLOCK + JUMPE B,SPEB10 + MOVE PVP,PVSTOR+1 + HRRZ C,SPBASE(PVP) ; CHECK FOR CROSS OF PROC + MOVEI A,(TP) + CAIL A,(B) ; LOSER + CAILE C,(B) ; SKIP IFF WINNER + MOVEI B,1 +SPEB10: MOVEM B,5(E) ;IN RESTORE CELLS + + MOVE C,1(E) ;GET ATOM PTR + SKIPE (C) + JUMPE B,.-4 + MOVEI A,(C) + MOVEI B,0 ; FOR SPCUNP + CAIL A,HIBOT ; SKIP IF IMPURE ATOM + PUSHJ P,SPCUNP + MOVE PVP,PVSTOR+1 + HRRZ A,BINDID+1(PVP) ;GET PROCESS NUMBER + HRLI A,TLOCI ;MAKE LOC PTR + MOVE B,E ;TO NEW VALUE + ADD B,[2,,2] + MOVEM A,(C) ;CLOBBER ITS VALUE + MOVEM B,1(C) ;CELL + MOVE D,E ;REMEMBER LINK + JRST BINDLP ;DO NEXT + +NONID: CAILE 0,-4(E) + JRST SPECBD + SUB E,[4,,4] + SKIPE D + HRRM E,(D) + SKIPN (P) + MOVEM E,(P) + + MOVE D,1(E) ;GET PTR TO VECTOR + MOVE C,(D) ;EXCHANGE TYPES + EXCH C,2(E) + MOVEM C,(D) + + MOVE C,1(D) ;EXCHANGE DATUMS + EXCH C,3(E) + MOVEM C,1(D) + + MOVEI A,TBVL + HRLM A,(E) ;IDENTIFY BIND BLOCK + MOVE D,E ;REMEMBER LINK + JRST BINDLP + +SPECBD: SKIPE D + MOVE SP,SPSTOR+1 + HRRM SP,(D) + SKIPE D,(P) + MOVEM D,SPSTOR+1 + SUB P,[2,,2] + POPJ P, + + +; HERE TO IMPURIFY THE ATOM + +SPCUNP: PUSH TP,$TSP + PUSH TP,E + PUSH TP,$TSP + PUSH TP,-1(P) ; LINK BACK IS AN SP + PUSH TP,$TSP + PUSH TP,B + CAIN B,1 + SETZM -1(TP) ; FIXUP SOME FUNNYNESS + MOVE B,C + PUSHJ P,IMPURIFY + MOVE 0,-2(TP) ; RESTORE LINK BACK POINTER + MOVEM 0,-1(P) + MOVE E,-4(TP) + MOVE C,B + MOVE B,(TP) + SUB TP,[6,,6] + MOVEI 0,(TB) + POPJ P, + +; ENTRY FROM COMPILER TO SET UP A BINDING + +IBIND: MOVE SP,SPSTOR+1 + SUBI E,-5(SP) ; CHANGE TO PDL POINTER + HRLI E,(E) + ADD E,SP + MOVEM C,-4(E) + MOVEM A,-3(E) + MOVEM B,-2(E) + HRLOI A,TATOM + MOVEM A,-5(E) + MOVSI A,TLIST + MOVEM A,-1(E) + MOVEM D,(E) + JRST SPECB1 ; NOW BIND IT + +; "FAST CALL TO SPECBIND" + + + +; Compiler's call to SPECBIND all atom bindings, no TBVLs etc. + +SPECBND: + MOVE E,TP ; POINT TO BINDING WITH E +SPECB1: PUSH P,[0] ; SLOTS OF INTEREST + PUSH P,[0] + SUBM M,-2(P) + +SPECB2: MOVEI 0,(TB) ; FOR FRAME CHECK + MOVE A,-5(E) ; LOOK AT FIRST THING + CAMN A,BNDA ; SKIP IF LOSER + CAILE 0,-5(E) ; SKIP IF REAL WINNER + JRST SPECB3 + + SUB E,[5,,5] ; POINT TO BINDING + SKIPE A,(P) ; LINK? + HRRM E,(A) ; YES DO IT + SKIPN -1(P) ; FIRST ONE? + MOVEM E,-1(P) ; THIS IS IT + + MOVE A,1(E) ; POINT TO ATOM + MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; QUICK CHECK + HRLI 0,TLOCI + CAMN 0,(A) ; WINNERE? + JRST SPECB4 ; YES, GO ON + + PUSH P,B ; SAVE REST OF ACS + PUSH P,C + PUSH P,D + MOVE B,A ; FOR ILOC TO WORK + PUSHJ P,SILOC ; GO LOOK IT UP + JUMPE B,SPECB9 + MOVE PVP,PVSTOR+1 + HRRZ C,SPBASE+1(PVP) + MOVEI A,(TP) + CAIL A,(B) ; SKIP IF LOSER + CAILE C,(B) ; SKIP IF WINNER + MOVEI B,1 ; SAY NO BACK POINTER +SPECB9: MOVE C,1(E) ; POINT TO ATOM + SKIPE (C) ; IF GLOBALLY BOUND, MAKE SURE OK + JUMPE B,.-3 + MOVEI A,(C) ; PURE ATOM? + CAIGE A,HIBOT ; SKIP IF OK + JRST .+4 + PUSH P,-4(P) ; MAKE HAPPINESS + PUSHJ P,SPCUNP ; IMPURIFY + POP P,-5(P) + MOVE PVP,PVSTOR+1 + MOVE A,BINDID+1(PVP) + HRLI A,TLOCI + MOVEM A,(C) ; STOR POINTER INDICATOR + MOVE A,B + POP P,D + POP P,C + POP P,B + JRST SPECB5 + +SPECB4: MOVE A,1(A) ; GET LOCATIVE +SPECB5: EXCH A,5(E) ; CLOBBER INTO REBIND SLOT (GET DECL) + HLL A,OTBSAV(TB) ; TIME IT + MOVSM A,4(E) ; SAVE DECL AND TIME + MOVEI A,TBIND + HRLM A,(E) ; CHANGE TO A BINDING + MOVE A,1(E) ; POINT TO ATOM + MOVEM E,(P) ; REMEMBER THIS GUY + ADD E,[2,,2] ; POINT TO VAL CELL + MOVEM E,1(A) ; INTO ATOM SLOT + SUB E,[3,,3] ; POINT TO NEXT ONE + JRST SPECB2 + +SPECB3: SKIPE A,(P) + MOVE SP,SPSTOR+1 + HRRM SP,(A) ; LINK OLD STUFF + SKIPE A,-1(P) ; NEW SP? + MOVEM A,SPSTOR+1 + SUB P,[2,,2] + INTGO ; IN CASE BLEW STACK + SUBM M,(P) + POPJ P, + + +;SPECSTORE RESTORES THE BINDINGS SP TO THE ENVIRONMENT POINTER IN +;SPSAV (TB). IT IS CALLED BY PUSHJ P,SPECSTORE. + +SPECSTORE: + PUSH P,E + HRRZ E,SPSAV (TB) ;GET TARGET POINTER + PUSHJ P,STLOOP + POP P,E + MOVE SP,SPSAV(TB) ; GET NEW SP + MOVEM SP,SPSTOR+1 + POPJ P, + +STLOOP: MOVE SP,SPSTOR+1 + PUSH P,D + PUSH P,C + +STLOO1: CAIL E,(SP) ;ARE WE DONE? + JRST STLOO2 + HLRZ C,(SP) ;GET TYPE OF BIND + CAIN C,TUBIND + JRST .+3 + CAIE C,TBIND ;NORMAL IDENTIFIER? + JRST ISTORE ;NO -- SPECIAL HACK + + + MOVE C,1(SP) ;GET TOP ATOM + MOVSI 0,TLOCI ; MAYBE LOCI OR UNBOUND + SKIPL D,5(SP) + MOVSI 0,TUNBOU + MOVE PVP,PVSTOR+1 + HRR 0,BINDID+1(PVP) ;STORE SIGNATURE + SKIPN 5(SP) + MOVEI 0,0 ; TOTALLY UNBOUND IN ALL CASES + MOVEM 0,(C) ;CLOBBER INTO ATOM + MOVEM D,1(C) + SETZM 4(SP) +SPLP: HRRZ SP,(SP) ;FOLOW LINK + JUMPN SP,STLOO1 ;IF MORE + SKIPE E ; OK IF E=0 + FATAL SP OVERPOP +STLOO2: MOVEM SP,SPSTOR+1 + POP P,C + POP P,D + POPJ P, + +ISTORE: CAIE C,TBVL + JRST CHSKIP + MOVE C,1(SP) + MOVE D,2(SP) + MOVEM D,(C) + MOVE D,3(SP) + MOVEM D,1(C) + JRST SPLP + +CHSKIP: CAIN C,TSKIP + JRST SPLP + CAIE C,TUNWIN ; UNWIND HACK + FATAL BAD SP + HRRZ C,-2(P) ; WHERE FROM? + CAIE C,CHUNPC + JRST SPLP ; IGNORE + MOVEI E,(TP) ; FIXUP SP + SUBI E,(SP) + MOVSI E,(E) + HLL SP,TP + SUB SP,E + POP P,C + POP P,D + AOS (P) + POPJ P, + +; ENTRY FOR FUNNY COMPILER UNBIND (1) + +SSPECS: PUSH P,E + PUSH P,PVP + PUSH P,SP + MOVEI E,(TP) + PUSHJ P,STLOOP +SSPEC2: SUBI E,(SP) ; MAKE SP BE AOBJN + MOVSI E,(E) + HLL SP,TP + SUB SP,E + MOVEM SP,SPSTOR+1 + POP P,SP + POP P,PVP + POP P,E + POPJ P, + +; ENTRY FOR FUNNY COMPILER UNBIND (2) + +SSPEC1: PUSH P,E + PUSH P,PVP + PUSH P,SP + SUBI E,1 ; MAKE SURE GET CURRENT BINDING + PUSHJ P,STLOOP ; UNBIND + MOVEI E,(TP) ; NOW RESET SP + JRST SSPEC2 + +EFINIS: MOVE PVP,PVSTOR+1 + SKIPN C,1STEPR+1(PVP) ; SKIP NIF BEING ONE PROCEEDED + JRST FINIS + PUSH TP,$TATOM + PUSH TP,MQUOTE EVLOUT + PUSH TP,A ;SAVE EVAL RESULTS + PUSH TP,B + PUSH TP,[TINFO,,2] ; FENCE POST + PUSHJ P,TBTOTP + PUSH TP,D + PUSHJ P,MAKINF ; MAKE ARG BLOCK INFO + PUSH TP,A + MOVEI B,-6(TP) + HRLI B,-4 ; AOBJN TO ARGS BLOCK + PUSH TP,B + MOVE PVP,PVSTOR+1 + PUSH TP,1STEPR(PVP) + PUSH TP,1STEPR+1(PVP) ; PROCESS DOING THE 1STEPPING + MCALL 2,RESUME + MOVE A,-3(TP) ; GET BACK EVAL VALUE + MOVE B,-2(TP) + JRST FINIS + +1STEPI: PUSH TP,$TATOM + PUSH TP,MQUOTE EVLIN + PUSH TP,$TAB ; PUSH EVALS ARGGS + PUSH TP,AB + PUSHJ P,MAKINF ; TURN INTO ARGS BLOCK + MOVEM A,-1(TP) ; AND CLOBBER + PUSH TP,[TINFO,,2] ; FENCE POST 2D TUPLE + PUSHJ P,TBTOTP + PUSH TP,D + PUSHJ P,MAKINF ; TURN IT INTO ARGS BLOCK + PUSH TP,A + MOVEI B,-6(TP) ; SETUP TUPLE + HRLI B,-4 + PUSH TP,B + MOVE PVP,PVSTOR+1 + PUSH TP,1STEPR(PVP) + PUSH TP,1STEPR+1(PVP) + MCALL 2,RESUME ; START UP 1STEPERR + SUB TP,[6,,6] ; REMOVE CRUD + GETYP A,A ; GET 1STEPPERS TYPE + CAIE A,TDISMI ; IF DISMISS, STOP 1 STEPPING + JRST EVALON + +; HERE TO PUSH DOWN THE 1 STEP STATE AND RUN + + MOVE D,PVP + ADD D,[1STEPR,,1STEPR] ; POINT TO 1 STEP SLOT + PUSH TP,$TSP ; SAVE CURRENT SP + PUSH TP,SPSTOR+1 + PUSH TP,BNDV + PUSH TP,D ; BIND IT + PUSH TP,$TPVP + PUSH TP,[0] ; NO 1 STEPPER UNTIL POPJ + PUSHJ P,SPECBIND + +; NOW PUSH THE ARGS UP TO RE-CALL EVAL + + MOVEI A,0 +EFARGL: JUMPGE AB,EFCALL + PUSH TP,(AB) + PUSH TP,1(AB) + ADD AB,[2,,2] + AOJA A,EFARGL + +EFCALL: ACALL A,EVAL ; NOW DO THE EVAL + MOVE C,(TP) ; PRE-UNBIND + MOVE PVP,PVSTOR+1 + MOVEM C,1STEPR+1(PVP) + MOVE SP,-4(TP) ; AVOID THE UNBIND + MOVEM SP,SPSTOR+1 + SUB TP,[6,,6] ; AND FLUSH LOSERS + JRST EFINIS ; AND TRY TO FINISH UP + +MAKINF: HLRZ A,OTBSAV(TB) ; TIME IT + HRLI A,TARGS + POPJ P, + + +TBTOTP: MOVEI D,(TB) ; COMPUTE REL DIST FROM TP TO TB + SUBI D,(TP) + POPJ P, +; ARRIVE HERE TO COMPLETE A COMPILER GENERATED TUPLE +; D/ LENGTH OF THE TUPLE IN WORDS + +MAKTU2: MOVE D,-1(P) ; GET LENGTH + ASH D,1 + PUSHJ P,MAKTUP + PUSH TP,A + PUSH TP,B + POPJ P, + +MAKTUP: HRLI D,TINFO ; FIRST WORD OF FENCE POST + PUSH TP,D + HRROI B,(TP) ; TOP OF TUPLE + SUBI B,(D) + TLC B,-1(D) ; AOBJN IT + PUSHJ P,TBTOTP + PUSH TP,D + HLRZ A,OTBSAV(TB) ; TIME IT + HRLI A,TARGS + POPJ P, + +; HERE TO ALLOCATE SLOTS FOR COMPILER (AMNT IN A) + +TPALOC: SUBM M,(P) + ;Once here ==>ADDI A,1 Bug??? + HRLI A,(A) + ADD TP,A + PUSH P,A + SKIPL TP + PUSHJ P,TPOVFL ; IN CASE IT LOST + INTGO ; TAKE THE GC IF NEC + HRRI A,2(TP) + SUB A,(P) + SETZM -1(A) + HRLI A,-1(A) + BLT A,(TP) + SUB P,[1,,1] + JRST POPJM + + +NTPALO: PUSH TP,[0] + SOJG 0,.-1 + POPJ P, + + ;EVALUATES A IDENTIFIER -- GETS LOCAL VALUE IF THERE IS ONE, OTHERWISE GLOBAL. + +IMFUNCTION VALUE,SUBR + JSP E,CHKAT + PUSHJ P,IDVAL + JRST FINIS + +IDVAL: PUSHJ P,IDVAL1 + CAMN A,$TUNBOU + JRST UNBOU + POPJ P, + +IDVAL1: PUSH TP,A + PUSH TP,B ;SAVE ARG IN CASE NEED TO CHECK GLOBAL VALUE + PUSHJ P,ILVAL ;LOCAL VALUE FINDER + CAME A,$TUNBOUND ;IF NOT UNBOUND OR UNASSIGNED + JRST RIDVAL ;DONE - CLEAN UP AND RETURN + POP TP,B ;GET ARG BACK + POP TP,A + JRST IGVAL +RIDVAL: SUB TP,[2,,2] + POPJ P, + +;GETS THE LOCAL VALUE OF AN IDENTIFIER + +IMFUNCTION LVAL,SUBR + JSP E,CHKAT + PUSHJ P,AILVAL + CAME A,$TUNBOUND + JRST FINIS + JUMPN B,UNAS + JRST UNBOU + +; MAKE AN ATOM UNASSIGNED + +MFUNCTION UNASSIGN,SUBR + JSP E,CHKAT ; GET ATOM ARG + PUSHJ P,AILOC +UNASIT: CAMN A,$TUNBOU ; IF UNBOUND + JRST RETATM + MOVSI A,TUNBOU + MOVEM A,(B) + SETOM 1(B) ; MAKE SURE +RETATM: MOVE B,1(AB) + MOVE A,(AB) + JRST FINIS + +; UNASSIGN GLOBALLY + +MFUNCTION GUNASSIGN,SUBR + JSP E,CHKAT2 + PUSHJ P,IGLOC + CAMN A,$TUNBOU + JRST RETATM + MOVE B,1(AB) ; ATOM BACK + MOVEI 0,(B) + CAIL 0,HIBOT ; SKIP IF IMPURE + PUSHJ P,IMPURIFY ; YES, MAKE IT IMPURE + PUSHJ P,IGLOC ; RESTORE LOCATIVE + HRRZ 0,-2(B) ; SEE IF MANIFEST + GETYP A,(B) ; AND CURRENT TYPE + CAIN 0,-1 + CAIN A,TUNBOU + JRST UNASIT + SKIPE IGDECL + JRST UNASIT + MOVE D,B + JRST MANILO + +; GETS A LOCATIVE TO THE LOCAL VALUE OF AN IDENTIFIER. + +MFUNCTION LLOC,SUBR + JSP E,CHKAT + PUSHJ P,AILOC + CAMN A,$TUNBOUND + JRST UNBOU + MOVSI A,TLOCD + HRR A,2(B) + JRST FINIS + +;TESTS TO SEE IF AN IDENTIFIER IS LOCALLY BOUND + +MFUNCTION BOUND,SUBR,[BOUND?] + JSP E,CHKAT + PUSHJ P,AILVAL + CAMN A,$TUNBOUND + JUMPE B,IFALSE + JRST TRUTH + +;TESTS TO SEE IF AN IDENTIFIER IS LOCALLY ASSIGNED + +MFUNCTION ASSIGP,SUBR,[ASSIGNED?] + JSP E,CHKAT + PUSHJ P,AILVAL + CAME A,$TUNBOUND + JRST TRUTH +; JUMPE B,UNBOU + JRST IFALSE + +;GETS THE GLOBAL VALUE OF AN IDENTIFIER + +IMFUNCTION GVAL,SUBR + JSP E,CHKAT2 + PUSHJ P,IGVAL + CAMN A,$TUNBOUND + JRST UNAS + JRST FINIS + +;GETS A LOCATIVE TO THE GLOBAL VALUE OF AN IDENTIFIER + +MFUNCTION RGLOC,SUBR + + JRST GLOC + +MFUNCTION GLOC,SUBR + + JUMPGE AB,TFA + CAMGE AB,[-5,,] + JRST TMA + JSP E,CHKAT1 + MOVEI E,IGLOC + CAML AB,[-2,,] + JRST .+4 + GETYP 0,2(AB) + CAIE 0,TFALSE + MOVEI E,IIGLOC + PUSHJ P,(E) + CAMN A,$TUNBOUND + JRST UNAS + MOVSI A,TLOCD + HRRZ 0,FSAV(TB) + CAIE 0,GLOC + MOVSI A,TLOCR + CAIE 0,GLOC + SUB B,GLOTOP+1 + MOVE C,1(AB) ; GE ATOM + MOVEI 0,(C) + CAIGE 0,HIBOT ; SKIP IF PURE ATOM + JRST FINIS + +; MAKE ATOM AND VALUE IMPURE IF GETTING GLOC TO IT + + MOVE B,C ; ATOM TO B + PUSHJ P,IMPURIFY + JRST GLOC ; AND TRY AGAIN + +;TESTS TO SEE IF AN IDENTIFIER IS GLOBALLY ASSIGNED + +MFUNCTION GASSIG,SUBR,[GASSIGNED?] + JSP E,CHKAT2 + PUSHJ P,IGVAL + CAMN A,$TUNBOUND + JRST IFALSE + JRST TRUTH + +; TEST FOR GLOBALLY BOUND + +MFUNCTION GBOUND,SUBR,[GBOUND?] + + JSP E,CHKAT2 + PUSHJ P,IGLOC + JUMPE B,IFALSE + JRST TRUTH + + + +CHKAT2: ENTRY 1 +CHKAT1: GETYP A,(AB) + MOVSI A,(A) + CAME A,$TATOM + JRST NONATM + MOVE B,1(AB) + JRST (E) + +CHKAT: HLRE A,AB ; - # OF ARGS + ASH A,-1 ; TO ACTUAL WORDS + JUMPGE AB,TFA + MOVE C,SPSTOR+1 ; FOR BINDING LOOKUPS + AOJE A,CHKAT1 ; ONLY ONE ARG, NO ENVIRONMENT + AOJL A,TMA ; TOO MANY + GETYP A,2(AB) ; MAKE SURE OF TENV OR TFRAME + CAIE A,TFRAME + CAIN A,TENV + JRST CHKAT3 + CAIN A,TACT ; FOR PFISTERS LOSSAGE + JRST CHKAT3 + CAIE A,TPVP ; OR PROCESS + JRST WTYP2 + MOVE B,3(AB) ; GET PROCESS + MOVE C,SPSTOR+1 ; IN CASE ITS ME + CAME B,PVSTOR+1 ; SKIP IF DIFFERENT + MOVE C,SPSTO+1(B) ; GET ITS SP + JRST CHKAT1 +CHKAT3: MOVEI B,2(AB) ; POINT TO FRAME POINTER + PUSHJ P,CHFRM ; VALIDITY CHECK + MOVE B,3(AB) ; GET TB FROM FRAME + MOVE C,SPSAV(B) ; GET ENVIRONMENT POINTER + JRST CHKAT1 + + +; SILOC--CALLS ILOC IGNORING SPECIAL CHECKING + +SILOC: JFCL + +;ILOC RETURNS IN A AND B A LOCATIVE TO THE LOCAL VALUE OF THE IDENTIFIER +; PASSED TO IT IN A AND B. IF THE IDENTIFIER IS LOCALLY UNBOUND IT RETURNS +; $TUNBOUND IN A AND 0 IN B, IT IS CALLED BY PUSHJ P,ILOC. + +ILOC: MOVE C,SPSTOR+1 ; SETUP SEARCH START +AILOC: SKIPN (B) ; ANY KIND OF VALUE AT ALL? + JUMPN B,FUNPJ + MOVSI A,TLOCI ;MAKE A LOCATIVE TYPE CELL + PUSH P,E + PUSH P,D + MOVEI E,0 ; FLAG TO CLOBBER ATOM + JUMPE B,SCHSP ; IF LOOKING FOR SLOT, SEARCH NOW + CAME C,SPSTOR+1 ; ENVIRONMENT CHANGE? + JRST SCHSP ; YES, MUST SEARCH + MOVE PVP,PVSTOR+1 + HRR A,BINDID+1(PVP) ;FOR THE CURRENT PROCESS + CAME A,(B) ;IS THERE ONE IN THE VALUE CELL? + JRST SCHLP ;NO -- SEARCH THE LOCAL BINDINGS + MOVE B,1(B) ;YES -- GET LOCATIVE POINTER + MOVE C,PVP +ILCPJ: MOVE E,SPCCHK + TRNN E,1 ; SKIP IF DOING SPEC UNSPEC CHECK + JRST ILOCPJ + HRRZ E,-2(P) ; IF IGNORING, IGNORE + HRRZ E,-1(E) + CAIN E,SILOC + JRST ILOCPJ + HLRZ E,-2(B) + CAIE E,TUBIND + JRST ILOCPJ + CAMGE B,CURFCN+1(PVP) + JRST SCHLPX + MOVEI D,-2(B) + HRRZ SP,SPSTOR+1 + CAIG D,(SP) + CAMGE B,SPBASE+1(PVP) + JRST SCHLPX + MOVE C,PVSTOR+1 +ILOCPJ: POP P,D + POP P,E + POPJ P, ;FROM THE VALUE CELL + +SCHLPX: MOVEI E,1 + MOVE C,SPSTOR+1 + MOVE B,-1(B) + JRST SCHLP + + +SCHLP5: SETOM (P) + JRST SCHLP2 + +SCHLP: MOVEI D,(B) + CAIL D,HIBOT ; SKIP IF IMPURE ATOM +SCHSP: MOVEI E,1 ; DONT STORE LOCATIVE + + PUSH P,E ; PUSH SWITCH + MOVE E,PVSTOR+1 ; GET PROC +SCHLP1: JUMPE C,UNPJ ;IF NO MORE -- LOSE + CAMN B,1(C) ;ARE WE POINTING AT THE WINNER? + JRST SCHFND ;YES + GETYP D,(C) ; CHECK SKIP + CAIE D,TSKIP + JRST SCHLP2 + PUSH P,B ; CHECK DETOUR + MOVEI B,2(C) + PUSHJ P,CHFRAM ; NON-FATAL FRAME CHECKER + HRRZ E,2(C) ; CONS UP PROCESS + SUBI E,PVLNT*2+1 + HRLI E,-2*PVLNT + JUMPE B,SCHLP3 ; LOSER, FIX IT + POP P,B + MOVEI C,1(C) ; FOLLOW LOOKUP CHAIN +SCHLP2: HRRZ C,(C) ;FOLLOW LINK + JRST SCHLP1 + +SCHLP3: POP P,B + HRRZ SP,SPSTOR+1 + MOVEI C,(SP) ; *** NDR'S BUG *** + CAME E,PVSTOR+1 ; USE IF CURRENT PROCESS + HRRZ C,SPSTO+1(E) ; USE CURRENT SP FOR PROC + JRST SCHLP1 + +SCHFND: MOVE D,SPCCHK + TRNN D,1 ; SKIP IF DOING SPEC UNSPEC CHECK + JRST SCHFN1 + HRRZ D,-2(P) ; IF IGNORING, IGNORE + HRRZ D,-1(D) + CAIN D,SILOC + JRST ILOCPJ + HLRZ D,(C) + CAIE D,TUBIND + JRST SCHFN1 + HRRZ D,CURFCN+1(PVP) + CAIL D,(C) + JRST SCHLP5 + HRRZ SP,SPSTOR+1 + HRRZ D,SPBASE+1(PVP) + CAIL SP,(C) + CAIL D,(C) + JRST SCHLP5 + +SCHFN1: EXCH B,C ;SAVE THE ATOM PTR IN C + MOVEI B,2(B) ;MAKE UP THE LOCATIVE + SUB B,TPBASE+1(E) + HRLI B,(B) + ADD B,TPBASE+1(E) + EXCH C,E ; RET PROCESS IN C + POP P,D ; RESTORE SWITCH + + JUMPN D,ILOCPJ ; DONT CLOBBER ATOM + MOVEM A,(E) ;CLOBBER IT AWAY INTO THE + MOVE D,1(E) ; GET OLD POINTER + MOVEM B,1(E) ;ATOM'S VALUE CELL + JUMPE D,ILOCPJ ; IF POINTS TO GLOBAL OR OTHER PROCES + ; MAKE SURE BINDING SO INDICATES + MOVE D,B ; POINT TO BINDING + SKIPL E,3(D) ; GO TO FIRST ONE, JUST IN CASE + JRST .+3 + MOVE D,E + JRST .-3 ; LOOP THROUGH + MOVEI E,1 + MOVEM E,3(D) ; MAGIC INDICATION + JRST ILOCPJ + +UNPJ: SUB P,[1,,1] ; FLUSH CRUFT +UNPJ1: MOVE C,E ; RET PROCESS ANYWAY +UNPJ11: POP P,D + POP P,E +UNPOPJ: MOVSI A,TUNBOUND + MOVEI B,0 + POPJ P, + +FUNPJ: MOVE C,PVSTOR+1 + JRST UNPOPJ + +;IGLOC RETURNS IN A AND B A LOCATIVE TO THE GLOBAL VALUE OF THE +;IDENTIFIER PASSED TO IT IN A AND B. IF THE IDENTIFIER IS GLOBALLY +;UNBPOUND IT RETURNS $TUNBOUND IN A AND 0 IN B. IT IS CALLED BY PUSHJ P,IGLOC. + +IGLOC: MOVSI A,TLOCI ;DO WE HAVE A LOCATIVE TO + CAME A,(B) ;A PROCESS #0 VALUE? + JRST SCHGSP ;NO -- SEARCH + MOVE B,1(B) ;YES -- GET VALUE CELL + POPJ P, + +SCHGSP: SKIPN (B) + JRST UNPOPJ + MOVE D,GLOBSP+1 ;GET GLOBAL SP PTR + +SCHG1: JUMPGE D,UNPOPJ ;IF NO MORE, LEAVE + CAMN B,1(D) ;ARE WE FOUND? + JRST GLOCFOUND ;YES + ADD D,[4,,4] ;NO -- TRY NEXT + JRST SCHG1 + +GLOCFOUND: + EXCH B,D ;SAVE ATOM PTR + ADD B,[2,,2] ;MAKE LOCATIVE + MOVEI 0,(D) + CAIL 0,HIBOT + POPJ P, + MOVEM A,(D) ;CLOBBER IT AWAY + MOVEM B,1(D) + POPJ P, + +IIGLOC: PUSH TP,$TATOM + PUSH TP,B + PUSHJ P,IGLOC + MOVE C,(TP) + SUB TP,[2,,2] + GETYP 0,A + CAIE 0,TUNBOU + POPJ P, + PUSH TP,$TATOM + PUSH TP,C + MOVEI 0,(C) + MOVE B,C + CAIL 0,$TLOSE + PUSHJ P,IMPURI ; IMPURIFY THE POOR ATOM + PUSHJ P,BSETG ; MAKE A SLOT + SETOM 1(B) ; UNBOUNDIFY IT + MOVSI A,TLOCD + MOVSI 0,TUNBOU + MOVEM 0,(B) + SUB TP,[2,,2] + POPJ P, + + + +;ILVAL RETURNS IN A AND B THE LOCAL VALUE OF THE IDENTIFIER PASSED TO IT IN A AND B +;IF THE IDENTIFIER IS UNBOUND ITS VALUE IS $TUNBOUND IN A AND 0 IN B. IF +;IT IS UNASSIGNED ITS VALUE IS $TUNBOUND IN A AND -1 IN B. CALL - PUSHJ P,IVAL + +AILVAL: + PUSHJ P,AILOC ; USE SUPPLIED SP + JRST CHVAL +ILVAL: + PUSHJ P,ILOC ;GET LOCATIVE TO VALUE +CHVAL: CAMN A,$TUNBOUND ;BOUND + POPJ P, ;NO -- RETURN + MOVSI A,TLOCD ; GET GOOD TYPE + HRR A,2(B) ; SHOULD BE TIME OR 0 + PUSH P,0 + PUSHJ P,RMONC0 ; CHECK READ MONITOR + POP P,0 + MOVE A,(B) ;GET THE TYPE OF THE VALUE + MOVE B,1(B) ;GET DATUM + POPJ P, + +;IGVAL -- LIKE ILVAL EXCEPT FOR GLOBAL VALUES + +IGVAL: PUSHJ P,IGLOC + JRST CHVAL + + + +; COMPILERS INTERFACE TO LVAL/GVAL/SETG/SET + +CILVAL: MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; CURRENT BIND + HRLI 0,TLOCI + CAME 0,(B) ; HURRAY FOR SPEED + JRST CILVA1 ; TOO BAD + MOVE C,1(B) ; POINTER + MOVE A,(C) ; VAL TYPE + TLNE A,.RDMON ; MONITORS? + JRST CILVA1 + GETYP 0,A + CAIN 0,TUNBOU + JRST CUNAS ; COMPILER ERROR + MOVE B,1(C) ; GOT VAL + MOVE 0,SPCCHK + TRNN 0,1 + POPJ P, + HLRZ 0,-2(C) ; SPECIAL CHECK + CAIE 0,TUBIND + POPJ P, ; RETURN + MOVE PVP,PVSTOR+1 + CAMGE C,CURFCN+1(PVP) + JRST CUNAS + POPJ P, + +CUNAS: +CILVA1: SUBM M,(P) ; FIX (P) + PUSH TP,$TATOM ; SAVE ATOM + PUSH TP,B + MCALL 1,LVAL ; GET ERROR/MONITOR + +POPJM: SUBM M,(P) ; REPAIR DAMAGE + POPJ P, + +; COMPILERS INTERFACE TO SET C/ ATOM A,B/ NEW VALUE + +CISET: MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; CURRENT BINDING ENVIRONMENT + HRLI 0,TLOCI + CAME 0,(C) ; CAN WE WIN? + JRST CISET1 ; NO, MORE HAIR + MOVE D,1(C) ; POINT TO SLOT +CISET3: HLLZ 0,(D) ; MON CHECK + TLNE 0,.WRMON + JRST CISET4 ; YES, LOSE + TLZ 0,TYPMSK + IOR A,0 ; LEAVE MONITOR ON + MOVE 0,SPCCHK + TRNE 0,1 + JRST CISET5 ; SPEC/UNSPEC CHECK +CISET6: MOVEM A,(D) ; STORE + MOVEM B,1(D) + POPJ P, + +CISET5: HLRZ 0,-2(D) + CAIE 0,TUBIND + JRST CISET6 + MOVE PVP,PVSTOR+1 + CAMGE D,CURFCN+1(PVP) + JRST CISET4 + JRST CISET6 + +CISET1: SUBM M,(P) ; FIX ADDR + PUSH TP,$TATOM ; SAVE ATOM + PUSH TP,C + PUSH TP,A + PUSH TP,B + MOVE B,C ; GET ATOM + PUSHJ P,ILOC ; SEARCH + MOVE D,B ; POSSIBLE POINTER + GETYP E,A + MOVE 0,A + MOVE A,-1(TP) ; VAL BACK + MOVE B,(TP) + CAIE E,TUNBOU ; SKIP IF WIN + JRST CISET2 ; GO CLOBBER IT IN + MCALL 2,SET + JRST POPJM + +CISET2: MOVE C,-2(TP) ; ATOM BACK + SUBM M,(P) ; RESET (P) + SUB TP,[4,,4] + JRST CISET3 + +; HERE TO DO A MONITORED SET + +CISET4: SUBM M,(P) ; AGAIN FIX (P) + PUSH TP,$TATOM + PUSH TP,C + PUSH TP,A + PUSH TP,B + MCALL 2,SET + JRST POPJM + +; COMPILER LLOC + +CLLOC: MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; GET CURRENT LOCATIVE + HRLI 0,TLOCI + CAME 0,(B) ; WIN? + JRST CLLOC1 + MOVE B,1(B) + MOVE 0,SPCCHK + TRNE 0,1 ; SKIP IF NOT CHECKING + JRST CLLOC9 +CLLOC3: MOVSI A,TLOCD + HRR A,2(B) ; GET BIND TIME + POPJ P, + +CLLOC1: SUBM M,(P) + PUSH TP,$TATOM + PUSH TP,B + PUSHJ P,ILOC ; LOOK IT UP + JUMPE B,CLLOC2 + SUB TP,[2,,2] +CLLOC4: SUBM M,(P) + JRST CLLOC3 + +CLLOC2: MCALL 1,LLOC + JRST CLLOC4 + +CLLOC9: HLRZ 0,-2(B) + CAIE 0,TUBIND + JRST CLLOC3 + MOVE PVP,PVSTOR+1 + CAMGE B,CURFCN+1(PVP) + JRST CLLOC2 + JRST CLLOC3 + +; COMPILER BOUND? + +CBOUND: SUBM M,(P) + PUSHJ P,ILOC + JUMPE B,PJFALS ; IF UNBOUND RET FALSE AND NO SSKIP +PJT1: SOS (P) + MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST POPJM + +PJFALS: MOVEI B,0 + MOVSI A,TFALSE + JRST POPJM + +; COMPILER ASSIGNED? + +CASSQ: SUBM M,(P) + PUSHJ P,ILOC + JUMPE B,PJFALS + GETYP 0,(B) + CAIE 0,TUNBOU + JRST PJT1 + JRST PJFALS + + +; COMPILER GVAL B/ ATOM + +CIGVAL: MOVE 0,(B) ; GLOBAL VAL HERE? + CAME 0,$TLOCI ; TIME=0 ,TYPE=TLOCI => GLOB VAL + JRST CIGVA1 ; NO, GO LOOK + MOVE C,1(B) ; POINT TO SLOT + MOVE A,(C) ; GET TYPE + TLNE A,.RDMON + JRST CIGVA1 + GETYP 0,A ; CHECK FOR UNBOUND + CAIN 0,TUNBOU ; SKIP IF WINNER + JRST CGUNAS + MOVE B,1(C) + POPJ P, + +CGUNAS: +CIGVA1: SUBM M,(P) + PUSH TP,$TATOM + PUSH TP,B + .MCALL 1,GVAL ; GET ERROR/MONITOR + JRST POPJM + +; COMPILER INTERFACET TO SETG + +CSETG: MOVE 0,(C) ; GET V CELL + CAME 0,$TLOCI ; SKIP IF FAST + JRST CSETG1 + HRRZ D,1(C) ; POINT TO SLOT + MOVE 0,(D) ; OLD VAL +CSETG3: CAIG D,HIBOT ; SKIP IF PURE ATOM + TLNE 0,.WRMON ; MONITOR + JRST CSETG2 + MOVEM A,(D) + MOVEM B,1(D) + POPJ P, + +CSETG1: SUBM M,(P) ; FIX UP P + PUSH TP,$TATOM + PUSH TP,C + PUSH TP,A + PUSH TP,B + MOVE B,C + PUSHJ P,IGLOC ; FIND GLOB LOCATIVE + GETYP E,A + MOVE 0,A + MOVEI D,(B) ; SETUP TO RESTORE NEW VAL + MOVE A,-1(TP) + MOVE B,(TP) + CAIE E,TUNBOU + JRST CSETG4 + MCALL 2,SETG + JRST POPJM + +CSETG4: MOVE C,-2(TP) ; ATOM BACK + SUBM M,(P) ; RESET (P) + SUB TP,[4,,4] + JRST CSETG3 + +CSETG2: SUBM M,(P) + PUSH TP,$TATOM ; CAUSE A SETG MONITOR + PUSH TP,C + PUSH TP,A + PUSH TP,B + MCALL 2,SETG + JRST POPJM + +; COMPILER GLOC + +CGLOC: MOVE 0,(B) ; GET CURRENT GUY + CAME 0,$TLOCI ; WIN? + JRST CGLOC1 ; NOPE + HRRZ D,1(B) ; POINT TO SLOT + CAILE D,HIBOT ; PURE? + JRST CGLOC1 + MOVE A,$TLOCD + MOVE B,1(B) + POPJ P, + +CGLOC1: SUBM M,(P) + PUSH TP,$TATOM + PUSH TP,B + MCALL 1,GLOC + JRST POPJM + +; COMPILERS GASSIGNED? + +CGASSQ: MOVE 0,(B) + SUBM M,(P) + CAMN 0,$TLOCD + JRST PJT1 + PUSHJ P,IGLOC + JUMPE B,PJFALS + GETYP 0,(B) + CAIE 0,TUNBOU + JRST PJT1 + JRST PJFALS + +; COMPILERS GBOUND? + +CGBOUN: MOVE 0,(B) + SUBM M,(P) + CAMN 0,$TLOCD + JRST PJT1 + PUSHJ P,IGLOC + JUMPE B,PJFALS + JRST PJT1 + + +IMFUNCTION REP,FSUBR,[REPEAT] + JRST PROG +MFUNCTION BIND,FSUBR + JRST PROG +IMFUNCTION PROG,FSUBR + ENTRY 1 + GETYP A,(AB) ;GET ARG TYPE + CAIE A,TLIST ;IS IT A LIST? + JRST WRONGT ;WRONG TYPE + SKIPN C,1(AB) ;GET AND CHECK ARGUMENT + JRST TFA ;TOO FEW ARGS + SETZB E,D ; INIT HEWITT ATOM AND DECL + PUSHJ P,CARATC ; IS 1ST THING AN ATOM + JFCL + PUSHJ P,RSATY1 ; CDR AND GET TYPE + CAIE 0,TLIST ; MUST BE LIST + JRST MPD.13 + MOVE B,1(C) ; GET ARG LIST + PUSH TP,$TLIST + PUSH TP,C + PUSHJ P,RSATYP + CAIE 0,TDECL + JRST NOP.DC ; JUMP IF NO DCL + MOVE D,1(C) + MOVEM C,(TP) + PUSHJ P,RSATYP ; CDR ON +NOP.DC: PUSH TP,$TLIST + PUSH TP,B ; AND ARG LIST + PUSHJ P,PRGBND ; BIND AUX VARS + HRRZ E,FSAV(TB) + CAIE E,BIND + SKIPA E,IMQUOTE LPROG,[LPROG ]INTRUP + JRST .+3 + PUSHJ P,MAKACT ; MAKE ACTIVATION + PUSHJ P,PSHBND ; BIND AND CHECK + PUSHJ P,SPECBI ; NAD BIND IT + +; HERE TO RUN PROGS FUNCTIONS ETC. + +DOPROG: MOVEI A,REPROG + HRLI A,TDCLI ; FLAG AS FUNNY + MOVEM A,(TB) ; WHERE TO AGAIN TO + MOVE C,1(TB) + MOVEM C,3(TB) ; RESTART POINTER + JRST .+2 ; START BY SKIPPING DECL + +DOPRG1: PUSHJ P,FASTEV + HRRZ C,@1(TB) ;GET THE REST OF THE BODY +DOPRG2: MOVEM C,1(TB) + JUMPN C,DOPRG1 +ENDPROG: + HRRZ C,FSAV(TB) + CAIN C,REP +REPROG: SKIPN C,@3(TB) + JRST PFINIS + HRRZM C,1(TB) + INTGO + MOVE C,1(TB) + JRST DOPRG1 + + +PFINIS: GETYP 0,(TB) + CAIE 0,TDCLI ; DECL'D ? + JRST PFINI1 + HRRZ 0,(TB) ; SEE IF RSUBR + JUMPE 0,RSBVCK ; CHECK RSUBR VALUE + HRRZ C,3(TB) ; GET START OF FCN + GETYP 0,(C) ; CHECK FOR DECL + CAIE 0,TDECL + JRST PFINI1 ; NO, JUST RETURN + MOVE E,IMQUOTE VALUE + PUSHJ P,PSHBND ; BUILD FAKE BINDING + MOVE C,1(C) ; GET DECL LIST + MOVE E,TP + PUSHJ P,CHKDCL ; AND CHECK IT + MOVE A,-3(TP) ; GET VAL BAKC + MOVE B,-2(TP) + SUB TP,[6,,6] + +PFINI1: HRRZ C,FSAV(TB) + CAIE C,EVAL + JRST FINIS + JRST EFINIS + +RSATYP: HRRZ C,(C) +RSATY1: JUMPE C,TFA + GETYP 0,(C) + POPJ P, + +; HERE TO CHECK RSUBR VALUE + +RSBVCK: PUSH TP,A + PUSH TP,B + MOVE C,A + MOVE D,B + MOVE A,1(TB) ; GET DECL + MOVE B,1(A) + HLLZ A,(A) + PUSHJ P,TMATCH + JRST RSBVC1 + POP TP,B + POP TP,A + POPJ P, + +RSBVC1: MOVE C,1(TB) + POP TP,B + POP TP,D + MOVE A,IMQUOTE VALUE + JRST TYPMIS + + +MFUNCTION MRETUR,SUBR,[RETURN] + ENTRY + HLRE A,AB ; GET # OF ARGS + ASH A,-1 ; TO NUMBER + AOJL A,RET2 ; 2 OR MORE ARGS + PUSHJ P,PROGCH ;CHECK IN A PROG + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) ; VERIFY IT +COMRET: PUSHJ P,CHFSWP + SKIPL C ; ARGS? + MOVEI C,0 ; REAL NONE + PUSHJ P,CHUNW + JUMPN A,CHFINI ; WINNER + MOVSI A,TATOM + MOVE B,IMQUOTE T + +; SEE IF MUST CHECK RETURNS TYPE + +CHFINI: GETYP 0,(TB) ; SPECIAL TYPE IF SO + CAIE 0,TDCLI + JRST FINIS ; NO, JUST FINIS + MOVEI 0,PFINIS ; CAUSE TO FALL INTO FUNCTION CODE + HRRM 0,PCSAV(TB) + JRST CONTIN + + +RET2: AOJL A,TMA + GETYP A,(AB)+2 + CAIE A,TACT ; AS FOR "EXIT" SHOULD BE ACTIVATION + JRST WTYP2 + MOVEI B,(AB)+2 ; ADDRESS OF FRAME POINTER + JRST COMRET + + + +MFUNCTION AGAIN,SUBR + ENTRY + HLRZ A,AB ;GET # OF ARGS + CAIN A,-2 ;1 ARG? + JRST NLCLA ;YES + JUMPN A,TMA ;0 ARGS? + PUSHJ P,PROGCH ;CHECK FOR IN A PROG + PUSH TP,A + PUSH TP,B + JRST AGAD +NLCLA: GETYP A,(AB) + CAIE A,TACT + JRST WTYP1 + PUSH TP,(AB) + PUSH TP,1(AB) +AGAD: MOVEI B,-1(TP) ; POINT TO FRAME + PUSHJ P,CHFSWP + HRRZ C,(B) ; GET RET POINT +GOJOIN: PUSH TP,$TFIX + PUSH TP,C + MOVEI C,-1(TP) + PUSHJ P,CHUNW ; RESTORE FRAME, UNWIND IF NEC. + HRRM B,PCSAV(TB) + HRRZ 0,FSAV(TB) ; CHECK FOR RSUBR + CAIGE 0,HIBOT + CAIGE 0,STOSTR + JRST CONTIN + HRRZ E,1(TB) + PUSH TP,$TFIX + PUSH TP,B + MOVEI C,-1(TP) + MOVEI B,(TB) + PUSHJ P,CHUNW1 + MOVE TP,1(TB) + MOVE SP,SPSTOR+1 + MOVEM SP,SPSAV(TB) + MOVEM TP,TPSAV(TB) + MOVE C,OTBSAV(TB) ; AND RESTORE P FROM FATHER + MOVE P,PSAV(C) + MOVEM P,PSAV(TB) + SKIPGE PCSAV(TB) + HRLI B,400000+M + MOVEM B,PCSAV(TB) + JRST CONTIN + +MFUNCTION GO,SUBR + ENTRY 1 + GETYP A,(AB) + CAIE A,TATOM + JRST NLCLGO + PUSHJ P,PROGCH ;CHECK FOR A PROG + PUSH TP,A ;SAVE + PUSH TP,B + MOVEI B,-1(TP) + PUSHJ P,CHFSWP + PUSH TP,$TATOM + PUSH TP,1(C) + PUSH TP,2(B) + PUSH TP,3(B) + MCALL 2,MEMQ ;DOES IT HAVE THIS TAG? + JUMPE B,NXTAG ;NO -- ERROR +FNDGO: EXCH B,(TP) ;SAVE PLACE TO GO + MOVSI D,TLIST + MOVEM D,-1(TP) + JRST GODON + +NLCLGO: CAIE A,TTAG ;CHECK TYPE + JRST WTYP1 + MOVE B,1(AB) + MOVEI B,2(B) ; POINT TO SLOT + PUSHJ P,CHFSWP + MOVE A,1(C) + GETYP 0,(A) ; SEE IF COMPILED + CAIE 0,TFIX + JRST GODON1 + MOVE C,1(A) + JRST GOJOIN + +GODON1: PUSH TP,(A) ;SAVE BODY + PUSH TP,1(A) +GODON: MOVEI C,0 + PUSHJ P,CHUNW ;GO BACK TO CORRECT FRAME + MOVE B,(TP) ;RESTORE ITERATION MARKER + MOVEM B,1(TB) + MOVSI A,TATOM + MOVE B,1(B) + JRST CONTIN + + + + +MFUNCTION TAG,SUBR + ENTRY + JUMPGE AB,TFA + HLRZ 0,AB + GETYP A,(AB) ;GET TYPE OF ARGUMENT + CAIE A,TFIX ; FIX ==> COMPILED + JRST ATOTAG + CAIE 0,-4 + JRST WNA + GETYP A,2(AB) + CAIE A,TACT + JRST WTYP2 + PUSH TP,(AB) + PUSH TP,1(AB) + PUSH TP,2(AB) + PUSH TP,3(AB) + JRST GENTV +ATOTAG: CAIE A,TATOM ;CHECK THAT IT IS AN ATOM + JRST WTYP1 + CAIE 0,-2 + JRST TMA + PUSHJ P,PROGCH ;CHECK PROG + PUSH TP,A ;SAVE VAL + PUSH TP,B + PUSH TP,$TATOM + PUSH TP,1(AB) + PUSH TP,2(B) + PUSH TP,3(B) + MCALL 2,MEMQ + JUMPE B,NXTAG ;IF NOT FOUND -- ERROR + EXCH A,-1(TP) ;SAVE PLACE + EXCH B,(TP) + HRLI A,TFRAME + PUSH TP,A + PUSH TP,B +GENTV: MOVEI A,2 + PUSHJ P,IEVECT + MOVSI A,TTAG + JRST FINIS + +PROGCH: MOVE B,IMQUOTE LPROG,[LPROG ]INTRUP + PUSHJ P,ILVAL ;GET VALUE + GETYP 0,A + CAIE 0,TACT + JRST NXPRG + POPJ P, + +; HERE TO UNASSIGN LPROG IF NEC + +UNPROG: MOVE B,IMQUOTE LPROG,[LPROG ]INTRUP + PUSHJ P,ILVAL + GETYP 0,A + CAIE 0,TACT ; SKIP IF MUST UNBIND + JRST UNMAP + MOVSI A,TUNBOU + MOVNI B,1 + MOVE E,IMQUOTE LPROG,[LPROG ]INTRUP + PUSHJ P,PSHBND +UNMAP: HRRZ 0,FSAV(TB) ; CHECK FOR FUNNY + CAIN 0,MAPPLY ; SKIP IF NOT + POPJ P, + MOVE B,IMQUOTE LMAP,[LMAP ]INTRUP + PUSHJ P,ILVAL + GETYP 0,A + CAIE 0,TFRAME + JRST UNSPEC + MOVSI A,TUNBOU + MOVNI B,1 + MOVE E,IMQUOTE LMAP,[LMAP ]INTRUP + PUSHJ P,PSHBND +UNSPEC: PUSH TP,BNDV + MOVE B,PVSTOR+1 + ADD B,[CURFCN,,CURFCN] + PUSH TP,B + PUSH TP,$TSP + MOVE E,SPSTOR+1 + ADD E,[3,,3] + PUSH TP,E + POPJ P, + +REPEAT 0,[ +MFUNCTION MEXIT,SUBR,[EXIT] + ENTRY 2 + GETYP A,(AB) + CAIE A,TACT + JRST WTYP1 + MOVEI B,(AB) + PUSHJ P,CHFSWP + ADD C,[2,,2] + PUSHJ P,CHUNW ;RESTORE FRAME + JRST CHFINI ; CHECK FOR WINNING VALUE +] + +MFUNCTION COND,FSUBR + ENTRY 1 + GETYP A,(AB) + CAIE A,TLIST + JRST WRONGT + PUSH TP,(AB) + PUSH TP,1(AB) ;CREATE UNNAMED TEMP + MOVEI B,0 ; SET TO FALSE IN CASE + +CLSLUP: SKIPN C,1(TB) ;IS THE CLAUSELIST NIL? + JRST IFALS1 ;YES -- RETURN NIL + GETYP A,(C) ;NO -- GET TYPE OF CAR + CAIE A,TLIST ;IS IT A LIST? + JRST BADCLS ; + MOVE A,1(C) ;YES -- GET CLAUSE + JUMPE A,BADCLS + GETYPF B,(A) + PUSH TP,B ; EVALUATION OF + HLLZS (TP) + PUSH TP,1(A) ;THE PREDICATE + JSP E,CHKARG + MCALL 1,EVAL + GETYP 0,A + CAIN 0,TFALSE + JRST NXTCLS ;FALSE TRY NEXT CLAUSE + MOVE C,1(TB) ;IF NOT, DO FIRST CLAUSE + MOVE C,1(C) + HRRZ C,(C) + JUMPE C,FINIS ;(UNLESS DONE WITH IT) + JRST DOPRG2 ;AS THOUGH IT WERE A PROG +NXTCLS: HRRZ C,@1(TB) ;SET THE CLAUSLIST + HRRZM C,1(TB) ;TO CDR OF THE CLAUSLIST + JRST CLSLUP + +IFALSE: + MOVEI B,0 +IFALS1: MOVSI A,TFALSE ;RETURN FALSE + JRST FINIS + + + +MFUNCTION UNWIND,FSUBR + + ENTRY 1 + + GETYP 0,(AB) ; CHECK THE ARGS FOR WINNAGE + SKIPN A,1(AB) ; NONE? + JRST TFA + HRRZ B,(A) ; CHECK FOR 2D + JUMPE B,TFA + HRRZ 0,(B) ; 3D? + JUMPN 0,TMA + +; Unbind LPROG and LMAPF so that nothing cute happens + + PUSHJ P,UNPROG + +; Push thing to do upon UNWINDing + + PUSH TP,$TLIST + PUSH TP,[0] + + MOVEI C,UNWIN1 + PUSHJ P,IUNWIN ; GOT TO INTERNAL SET UP + +; Now EVAL the first form + + MOVE A,1(AB) + HRRZ 0,(A) ; SAVE POINTER TO OTHER GUY + MOVEM 0,-12(TP) + MOVE B,1(A) + GETYP A,(A) + MOVSI A,(A) + JSP E,CHKAB ; DEFER? + PUSH TP,A + PUSH TP,B + MCALL 1,EVAL ; EVAL THE LOSER + + JRST FINIS + +; Now push slots to hold undo info on the way down + +IUNWIN: JUMPE M,NOUNRE + HLRE 0,M ; CHECK BOUNDS + SUBM M,0 + ANDI 0,-1 + CAIL C,(M) + CAML C,0 + JRST .+2 + SUBI C,(M) + +NOUNRE: PUSH TP,$TTB ; DESTINATION FRAME + PUSH TP,[0] + PUSH TP,[0] ; ARGS TO WHOEVER IS DOING IT + PUSH TP,[0] + +; Now bind UNWIND word + + PUSH TP,$TUNWIN ; FIRST WORD OF IT + MOVE SP,SPSTOR+1 + HRRM SP,(TP) ; CHAIN + MOVEM TP,SPSTOR+1 + PUSH TP,TB ; AND POINT TO HERE + PUSH TP,$TTP + PUSH TP,[0] + HRLI C,TPDL + PUSH TP,C + PUSH TP,P ; SAVE PDL ALSO + MOVEM TP,-2(TP) ; SAVE FOR LATER + POPJ P, + +; Do a non-local return with UNWIND checking + +CHUNW: HRRZ E,SPSAV(B) ; GET DESTINATION FRAME +CHUNW1: PUSH TP,(C) ; FINAL VAL + PUSH TP,1(C) + JUMPN C,.+3 ; WAS THERE REALLY ANYTHING + SETZM (TP) + SETZM -1(TP) + PUSHJ P,STLOOP ; UNBIND +CHUNPC: SKIPA ; WILL NOT SKIP UNLESS UNWIND FOUND + JRST GOTUND + MOVEI A,(TP) + SUBI A,(SP) + MOVSI A,(A) + HLL SP,TP + SUB SP,A + MOVEM SP,SPSTOR+1 + HRRI TB,(B) ; UPDATE TB + PUSHJ P,UNWFRMS + POP TP,B + POP TP,A + POPJ P, + +POPUNW: MOVE SP,SPSTOR+1 + HRRZ SP,(SP) + MOVEI E,(TP) + SUBI E,(SP) + MOVSI E,(E) + HLL SP,TP + SUB SP,E + MOVEM SP,SPSTOR+1 + POPJ P, + + +UNWFRM: JUMPE FRM,CPOPJ + MOVE B,FRM +UNWFR2: JUMPE B,UNWFR1 + CAMG B,TPSAV(TB) + JRST UNWFR1 + MOVE B,(B) + JRST UNWFR2 + +UNWFR1: MOVE FRM,B + POPJ P, + +; Here if an UNDO found + +GOTUND: MOVE TB,1(SP) ; GET FRAME OF UNDO + MOVE A,-1(TP) ; GET FUNNY ARG FOR PASS ON + MOVE C,(TP) + MOVE TP,3(SP) ; GET FUTURE TP + MOVEM C,-6(TP) ; SAVE ARG + MOVEM A,-7(TP) + MOVE C,(TP) ; SAVED P + SUB C,[1,,1] + MOVEM C,PSAV(TB) ; MAKE CONTIN WIN + MOVEM TP,TPSAV(TB) + MOVEM SP,SPSAV(TB) + HRRZ C,(P) ; PC OF CHUNW CALLER + HRRM C,-11(TP) ; SAVE ALSO AND GET WHERE TO GO PC + MOVEM B,-10(TP) ; AND DESTINATION FRAME + HRRZ C,-1(TP) ; WHERE TO UNWIND PC + HRRZ 0,FSAV(TB) ; RSUBR? + CAIGE 0,HIBOT + CAIGE 0,STOSTR + JRST .+3 + SKIPGE PCSAV(TB) + HRLI C,400000+M + MOVEM C,PCSAV(TB) + JRST CONTIN + +UNWIN1: MOVE B,-12(TP) ; POINT TO THING TO DO UNWINDING + GETYP A,(B) + MOVSI A,(A) + MOVE B,1(B) + JSP E,CHKAB + PUSH TP,A + PUSH TP,B + MCALL 1,EVAL +UNWIN2: MOVEI C,-7(TP) ; POINT TO SAVED RET VALS + MOVE B,-10(TP) + HRRZ E,-11(TP) + PUSH P,E + MOVE SP,SPSTOR+1 + HRRZ SP,(SP) ; UNBIND THIS GUY + MOVEI E,(TP) ; AND FIXUP SP + SUBI E,(SP) + MOVSI E,(E) + HLL SP,TP + SUB SP,E + MOVEM SP,SPSTOR+1 + JRST CHUNW ; ANY MORE TO UNWIND? + + +; CHFSWP - CHECK FRAMES VALIDITY AND SWAP PROCESS IF NECESSARY. +; CALLED BY ALL CONTROL FLOW +; ROUTINES (GO,RETURN,EXIT,AGAIN,ERRET...) + +CHFSWP: PUSHJ P,CHFRM ; CHECK FOR VALID FRAME + HRRZ D,(B) ; PROCESS VECTOR DOPE WD + HLRZ C,(D) ; LENGTH + SUBI D,-1(C) ; POINT TO TOP + MOVNS C ; NEGATE COUNT + HRLI D,2(C) ; BUILD PVP + MOVE E,PVSTOR+1 + MOVE C,AB + MOVE A,(B) ; GET FRAME + MOVE B,1(B) + CAMN E,D ; SKIP IF SWAP NEEDED + POPJ P, + PUSH TP,A ; SAVE FRAME + PUSH TP,B + MOVE B,D + PUSHJ P,PROCHK ; FIX UP PROCESS LISTS + MOVE A,PSTAT+1(B) ; GET STATE + CAIE A,RESMBL + JRST NOTRES + MOVE D,B ; PREPARE TO SWAP + POP P,0 ; RET ADDR + POP TP,B + POP TP,A + JSP C,SWAP ; SWAP IN + MOVE C,ABSTO+1(E) ; GET OLD ARRGS + MOVEI A,RUNING ; FIX STATES + MOVE PVP,PVSTOR+1 + MOVEM A,PSTAT+1(PVP) + MOVEI A,RESMBL + MOVEM A,PSTAT+1(E) + JRST @0 + +NOTRES: ERRUUO EQUOTE PROCESS-NOT-RESUMABLE + + +;SETG IS USED TO SET THE GLOBAL VALUE OF ITS FIRST ARGUMENT, +;AN IDENTIFIER, TO THE VALUE OF ITS SECOND ARGUMENT. ITS VALUE IS +; ITS SECOND ARGUMENT. + +IMFUNCTION SETG,SUBR + ENTRY 2 + GETYP A,(AB) ;GET TYPE OF FIRST ARGUMENT + CAIE A,TATOM ;CHECK THAT IT IS AN ATOM + JRST NONATM ;IF NOT -- ERROR + MOVE B,1(AB) ;GET POINTER TO ATOM + PUSH TP,$TATOM + PUSH TP,B + MOVEI 0,(B) + CAIL 0,HIBOT ; PURE ATOM? + PUSHJ P,IMPURIFY ; YES IMPURIFY + PUSHJ P,IGLOC ;GET LOCATIVE TO VALUE + CAMN A,$TUNBOUND ;IF BOUND + PUSHJ P,BSETG ;IF NOT -- BIND IT + MOVE C,2(AB) ; GET PROPOSED VVAL + MOVE D,3(AB) + MOVSI A,TLOCD ; MAKE SURE MONCH WINS + PUSHJ P,MONCH0 ; WOULD YOU BELIEVE MONITORS!!!! + EXCH D,B ;SAVE PTR + MOVE A,C + HRRZ E,-2(D) ; POINT TO POSSIBLE GDECL (OR MAINIFEST) + JUMPE E,OKSETG ; NONE ,OK + CAIE E,-1 ; MANIFEST? + JRST SETGTY + GETYP 0,(D) ; IF UNBOUND, LET IT HAPPEN + SKIPN IGDECL + CAIN 0,TUNBOU + JRST OKSETG +MANILO: GETYP C,(D) + GETYP 0,2(AB) + CAIN 0,(C) + CAME B,1(D) + JRST .+2 + JRST OKSETG + PUSH TP,$TVEC + PUSH TP,D + MOVE B,IMQUOTE REDEFINE + PUSHJ P,ILVAL ; SEE IF REDEFINE OK + GETYP A,A + CAIE A,TUNBOU + CAIN A,TFALSE + JRST .+2 + JRST OKSTG + PUSH TP,$TATOM + PUSH TP,EQUOTE ATTEMPT-TO-CHANGE-MANIFEST-VARIABLE + PUSH TP,$TATOM + PUSH TP,1(AB) + MOVEI A,2 + JRST CALER + +SETGTY: PUSH TP,$TVEC + PUSH TP,D + MOVE C,A + MOVE D,B + GETYP A,(E) + MOVSI A,(A) + MOVE B,1(E) + JSP E,CHKAB + PUSHJ P,TMATCH + JRST TYPMI3 + +OKSTG: MOVE D,(TP) + MOVE A,2(AB) + MOVE B,3(AB) + +OKSETG: MOVEM A,(D) ;DEPOSIT INTO THE + MOVEM B,1(D) ;INDICATED VALUE CELL + JRST FINIS + +TYPMI3: MOVE C,(TP) + HRRZ C,-2(C) + MOVE D,2(AB) + MOVE B,3(AB) + MOVE 0,(AB) + MOVE A,1(AB) + JRST TYPMIS + +BSETG: HRRZ A,GLOBASE+1 + HRRZ B,GLOBSP+1 + SUB B,A + CAIL B,6 + JRST SETGIT + MOVEI B,0 ; MAKE SURE OF NO EMPTY SLOTS + PUSHJ P,IGLOC + CAMN A,$TUNBOU ; SKIP IF SLOT FOUND + JRST BSETG1 + MOVE C,(TP) ; GET ATOM + MOVEM C,-1(B) ; CLOBBER ATOM SLOT + HLLZS -2(B) ; CLOBBER OLD DECL + JRST BSETGX +; BSETG1: PUSH TP,GLOBASE ; MUST REALLY GROW STACK +; PUSH TP,GLOBASE+1 +; PUSH TP,$TFIX +; PUSH TP,[0] +; PUSH TP,$TFIX +; PUSH TP,[100] +; MCALL 3,GROW +BSETG1: PUSH P,0 + PUSH P,C + MOVE C,GLOBASE+1 + HLRE B,C + SUB C,B + MOVE B,GVLINC ; GROW BY INDICATED GVAL SLOTS + DPB B,[001100,,(C)] +; MOVEM A,GLOBASE + MOVE C,[6,,4] ; INDICATOR FOR AGC + PUSHJ P,AGC + MOVE B,GLOBASE+1 + MOVE 0,GVLINC ; ADJUST GLOBAL SPBASE + ASH 0,6 + SUB B,0 + HRLZS 0 + SUB B,0 + MOVEM B,GLOBASE+1 +; MOVEM B,GLOBASE+1 + POP P,0 + POP P,C +SETGIT: + MOVE B,GLOBSP+1 + SUB B,[4,,4] + MOVSI C,TGATOM + MOVEM C,(B) + MOVE C,(TP) + MOVEM C,1(B) + MOVEM B,GLOBSP+1 + ADD B,[2,,2] +BSETGX: MOVSI A,TLOCI + PUSHJ P,PATSCH ; FIXUP SCHLPAGE + MOVEM A,(C) + MOVEM B,1(C) + POPJ P, + +PATSCH: GETYP 0,(C) + CAIN 0,TLOCI + SKIPL D,1(C) + POPJ P, + +PATL: SKIPL E,3(D) ; SKIP IF NEXT EXISTS + JRST PATL1 + MOVE D,E + JRST PATL + +PATL1: MOVEI E,1 + MOVEM E,3(D) ; SAY GVAL ETC. EXISTS IF WE UNBIND + POPJ P, + + +IMFUNCTION DEFMAC,FSUBR + + ENTRY 1 + + PUSH P,. + JRST DFNE2 + +IMFUNCTION DFNE,FSUBR,[DEFINE] + + ENTRY 1 + + PUSH P,[0] +DFNE2: GETYP A,(AB) + CAIE A,TLIST + JRST WRONGT + SKIPN B,1(AB) ; GET ATOM + JRST TFA + GETYP A,(B) ; MAKE SURE ATOM + MOVSI A,(A) + PUSH TP,A + PUSH TP,1(B) + JSP E,CHKARG + MCALL 1,EVAL ; EVAL IT TO AN ATOM + CAME A,$TATOM + JRST NONATM + PUSH TP,A ; SAVE TWO COPIES + PUSH TP,B + PUSHJ P,IGVAL ; SEE IF A VALUE EXISTS + CAMN A,$TUNBOU ; SKIP IF A WINNER + JRST .+3 + PUSHJ P,ASKUSR ; CHECK WITH USER + JRST DFNE1 + PUSH TP,$TATOM + PUSH TP,-1(TP) + MOVE B,1(AB) + HRRZ B,(B) + MOVSI A,TEXPR + SKIPN (P) ; SKIP IF MACRO + JRST DFNE3 + MOVEI D,(B) ; READY TO CONS + MOVSI C,TEXPR + PUSHJ P,INCONS + MOVSI A,TMACRO +DFNE3: PUSH TP,A + PUSH TP,B + MCALL 2,SETG +DFNE1: POP TP,B ; RETURN ATOM + POP TP,A + JRST FINIS + + +ASKUSR: MOVE B,IMQUOTE REDEFINE + PUSHJ P,ILVAL ; SEE IF REDEFINE OK + GETYP A,A + CAIE A,TUNBOU + CAIN A,TFALSE + JRST ASKUS1 + JRST ASKUS2 +ASKUS1: PUSH TP,$TATOM + PUSH TP,-1(TP) + PUSH TP,$TATOM + PUSH TP,EQUOTE ALREADY-DEFINED-ERRET-NON-FALSE-TO-REDEFINE + MCALL 2,ERROR + GETYP 0,A + CAIE 0,TFALSE +ASKUS2: AOS (P) + MOVE B,1(AB) + POPJ P, + + + +;SET CLOBBERS THE LOCAL VALUE OF THE IDENTIFIER GIVEN BY ITS +;FIRST ARGUMENT TO THE SECOND ARG. ITS VALUE IS ITS SECOND ARGUMENT. + +IMFUNCTION SET,SUBR + HLRE D,AB ; 2 TIMES # OF ARGS TO D + ASH D,-1 ; - # OF ARGS + ADDI D,2 + JUMPG D,TFA ; NOT ENOUGH + MOVE B,PVSTOR+1 + MOVE C,SPSTOR+1 + JUMPE D,SET1 ; NO ENVIRONMENT + AOJL D,TMA ; TOO MANY + GETYP A,4(AB) ; CHECK ARG IS A FRAME OR PROCESS + CAIE A,TFRAME + CAIN A,TENV + JRST SET2 ; WINNING ENVIRONMENT/FRAME + CAIN A,TACT + JRST SET2 ; TO MAKE PFISTER HAPPY + CAIE A,TPVP + JRST WTYP2 + MOVE B,5(AB) ; GET PROCESS + MOVE C,SPSTO+1(B) + JRST SET1 +SET2: MOVEI B,4(AB) ; POINT TO FRAME + PUSHJ P,CHFRM ; CHECK IT OUT + MOVE B,5(AB) ; GET IT BACK + MOVE C,SPSAV(B) ; GET BINDING POINTER + HRRZ B,4(AB) ; POINT TO PROCESS + HLRZ A,(B) ; GET LENGTH + SUBI B,-1(A) ; POINT TO START THEREOF + HLL B,PVSTOR+1 ; GET -LNTRH, (ALL PROCESS VECS SAME LENGTH) +SET1: PUSH TP,$TPVP ; SAVE PROCESS + PUSH TP,B + PUSH TP,$TSP ; SAVE PATH POINTER + PUSH TP,C + GETYP A,(AB) ;GET TYPE OF FIRST + CAIE A,TATOM ;ARGUMENT -- + JRST WTYP1 ;BETTER BE AN ATOM + MOVE B,1(AB) ;GET PTR TO IT + MOVEI 0,(B) + CAIL 0,HIBOT + PUSHJ P,IMPURIFY + MOVE C,(TP) + PUSHJ P,AILOC ;GET LOCATIVE TO VALUE +GOTLOC: CAMN A,$TUNBOUND ;BOUND? + PUSHJ P, BSET ;BIND IT + MOVE C,2(AB) ; GET NEW VAL + MOVE D,3(AB) + MOVSI A,TLOCD ; FOR MONCH + HRR A,2(B) + PUSHJ P,MONCH0 ; HURRAY FOR MONITORS!!!!! + MOVE E,B + HLRZ A,2(E) ; GET DECLS + JUMPE A,SET3 ; NONE, GO + PUSH TP,$TSP + PUSH TP,E + MOVE B,1(A) + HLLZ A,(A) ; GET PATTERN + PUSHJ P,TMATCH ; MATCH TMEM + JRST TYPMI2 ; LOSES + MOVE E,(TP) + SUB TP,[2,,2] + MOVE C,2(AB) + MOVE D,3(AB) +SET3: MOVEM C,(E) ;CLOBBER IDENTIFIER + MOVEM D,1(E) + MOVE A,C + MOVE B,D + MOVE C,-2(TP) ; GET PROC + HRRZ C,BINDID+1(C) + HRLI C,TLOCI + +; HERE WE NOTE THAT EFFICIENCY CAN SOMETIMES GET IN THE WAY OF CORRECTNESS +; BY SETTING THE SHALLOW BINDING WE MANAGE TO CLOBBER THE TOP LEVEL LVAL +; EVEN IF WE ARE SETTING WITH RESPECT TO A DIFFERENT FRAME. TO CORRECT +; THIS GLITCH THIS ACTIVITY WILL ONLY TAKE PLACE IF THE ATOM ALREADY POINTS +; TO A BINDING + + MOVE D,1(AB) + SKIPE (D) + JRST NSHALL + MOVEM C,(D) + MOVEM E,1(D) +NSHALL: SUB TP,[4,,4] + JRST FINIS +BSET: + MOVE PVP,PVSTOR+1 + CAMN PVP,-2(TP) ; SKIP IF PROC DIFFERS + MOVEM C,-2(TP) ; ELSE USE RESULT FROM LOC SEARCH + MOVE B,-2(TP) ; GET PROCESS + HRRZ A,TPBASE+1(B) ;GET ACTUAL STACK BASE + HRRZ B,SPBASE+1(B) ;AND FIRST BINDING + SUB B,A ;ARE THERE 6 + CAIL B,6 ;CELLS AVAILABLE? + JRST SETIT ;YES + MOVE C,(TP) ; GET POINTER BACK + MOVEI B,0 ; LOOK FOR EMPTY SLOT + PUSHJ P,AILOC + CAMN A,$TUNBOUND ; SKIP IF FOUND + JRST BSET1 + MOVE E,1(AB) ; GET ATOM + MOVEM E,-1(B) ; AND STORE + JRST BSET2 +BSET1: MOVE B,-2(TP) ; GET PROCESS +; PUSH TP,TPBASE(B) ;NO -- GROW THE TP +; PUSH TP,TPBASE+1(B) ;AT THE BASE END +; PUSH TP,$TFIX +; PUSH TP,[0] +; PUSH TP,$TFIX +; PUSH TP,[100] +; MCALL 3,GROW +; MOVE C,-2(TP) ; GET PROCESS +; MOVEM A,TPBASE(C) ;SAVE RESULT + PUSH P,0 ; MANUALLY GROW VECTOR + PUSH P,C + MOVE C,TPBASE+1(B) + HLRE B,C + SUB C,B + MOVEI C,1(C) + CAME C,TPGROW + ADDI C,PDLBUF + MOVE D,LVLINC + DPB D,[001100,,-1(C)] + MOVE C,[5,,3] ; SET UP INDICATORS FOR AGC + PUSHJ P,AGC + MOVE PVP,PVSTOR+1 + MOVE B,TPBASE+1(PVP) ; MODIFY POINTER + MOVE 0,LVLINC ; ADJUST SPBASE POINTER + ASH 0,6 + SUB B,0 + HRLZS 0 + SUB B,0 + MOVEM B,TPBASE+1(PVP) + POP P,C + POP P,0 +; MOVEM B,TPBASE+1(C) +SETIT: MOVE C,-2(TP) ; GET PROCESS + MOVE B,SPBASE+1(C) + MOVEI A,-6(B) ;MAKE UP BINDING + HRRM A,(B) ;LINK PREVIOUS BIND BLOCK + MOVSI A,TBIND + MOVEM A,-6(B) + MOVE A,1(AB) + MOVEM A,-5(B) + SUB B,[6,,6] + MOVEM B,SPBASE+1(C) + ADD B,[2,,2] +BSET2: MOVE C,-2(TP) ; GET PROC + MOVSI A,TLOCI + HRR A,BINDID+1(C) + HLRZ D,OTBSAV(TB) ; TIME IT + MOVEM D,2(B) ; AND FIX IT + POPJ P, + +; HERE TO ELABORATE ON TYPE MISMATCH + +TYPMI2: MOVE C,(TP) ; FIND DECLS + HLRZ C,2(C) + MOVE D,2(AB) + MOVE B,3(AB) + MOVE 0,(AB) ; GET ATOM + MOVE A,1(AB) + JRST TYPMIS + + + +MFUNCTION NOT,SUBR + ENTRY 1 + GETYP A,(AB) ; GET TYPE + CAIE A,TFALSE ;IS IT FALSE? + JRST IFALSE ;NO -- RETURN FALSE + +TRUTH: + MOVSI A,TATOM ;RETURN T (VERITAS) + MOVE B,IMQUOTE T + JRST FINIS + +IMFUNCTION OR,FSUBR + + PUSH P,[0] + JRST ANDOR + +MFUNCTION ANDA,FSUBR,AND + + PUSH P,[1] +ANDOR: ENTRY 1 + GETYP A,(AB) + CAIE A,TLIST + JRST WRONGT ;IF ARG DOESN'T CHECK OUT + MOVE E,(P) + SKIPN C,1(AB) ;IF NIL + JRST TF(E) ;RETURN TRUTH + PUSH TP,$TLIST ;CREATE UNNAMED TEMP + PUSH TP,C +ANDLP: + MOVE E,(P) + JUMPE C,TFI(E) ;ANY MORE ARGS? + MOVEM C,1(TB) ;STORE CRUFT + GETYP A,(C) + MOVSI A,(A) + PUSH TP,A + PUSH TP,1(C) ;ARGUMENT + JSP E,CHKARG + MCALL 1,EVAL + GETYP 0,A + MOVE E,(P) + XCT TFSKP(E) + JRST FINIS ;IF FALSE -- RETURN + HRRZ C,@1(TB) ;GET CDR OF ARGLIST + JRST ANDLP + +TF: JRST IFALSE + JRST TRUTH + +TFI: JRST IFALS1 + JRST FINIS + +TFSKP: CAIE 0,TFALSE + CAIN 0,TFALSE + +IMFUNCTION FUNCTION,FSUBR + + ENTRY 1 + + MOVSI A,TEXPR + MOVE B,1(AB) + JRST FINIS + + ;SUBR VERSIONS OF AND/OR + +MFUNCTION ANDP,SUBR,[AND?] + JUMPGE AB,TRUTH + MOVE C,[CAIN 0,TFALSE] + JRST BOOL + +MFUNCTION ORP,SUBR,[OR?] + JUMPGE AB,IFALSE + MOVE C,[CAIE 0,TFALSE] +BOOL: HLRE A,AB ; GET ARG COUNTER + MOVMS A + ASH A,-1 ; DIVIDES BY 2 + MOVE D,AB + PUSHJ P,CBOOL + JRST FINIS + +CANDP: SKIPA C,[CAIN 0,TFALSE] +CORP: MOVE C,[CAIE 0,TFALSE] + JUMPE A,CNOARG + MOVEI D,(A) + ASH D,1 ; TIMES 2 + HRLI D,(D) + SUBB TP,D ; POINT TO ARGS & FIXUP TP PTR + AOBJP D,.+1 ; FIXUP ARG PTR AND FALL INTO CBOOL + +CBOOL: GETYP 0,(D) + XCT C ; WINNER ? + JRST CBOOL1 ; YES RETURN IT + ADD D,[2,,2] + SOJG A,CBOOL ; ANY MORE ? + SUB D,[2,,2] ; NO, USE LAST +CBOOL1: MOVE A,(D) + MOVE B,(D)+1 + POPJ P, + + +CNOARG: MOVSI 0,TFALSE + XCT C + JRST CNOAND + MOVSI A,TFALSE + MOVEI B,0 + POPJ P, +CNOAND: MOVSI A,TATOM + MOVE B,IMQUOTE T + POPJ P, + + +MFUNCTION CLOSURE,SUBR + ENTRY + SKIPL A,AB ;ANY ARGS + JRST TFA ;NO -- LOSE + ADD A,[2,,2] ;POINT AT IDS + PUSH TP,$TAB + PUSH TP,A + PUSH P,[0] ;MAKE COUNTER + +CLOLP: SKIPL A,1(TB) ;ANY MORE IDS? + JRST CLODON ;NO -- LOSE + PUSH TP,(A) ;SAVE ID + PUSH TP,1(A) + PUSH TP,(A) ;GET ITS VALUE + PUSH TP,1(A) + ADD A,[2,,2] ;BUMP POINTER + MOVEM A,1(TB) + AOS (P) + MCALL 1,VALUE + PUSH TP,A + PUSH TP,B + MCALL 2,LIST ;MAKE PAIR + PUSH TP,A + PUSH TP,B + JRST CLOLP + +CLODON: POP P,A + ACALL A,LIST ;MAKE UP LIST + PUSH TP,(AB) ;GET FUNCTION + PUSH TP,1(AB) + PUSH TP,A + PUSH TP,B + MCALL 2,LIST ;MAKE LIST + MOVSI A,TFUNARG + JRST FINIS + + + +;ERROR COMMENTS FOR EVAL + +BADNUM: ERRUUO EQUOTE NEGATIVE-ARGUMENT + +WTY1TP: ERRUUO EQUOTE FIRST-ARG-WRONG-TYPE + +UNBOU: PUSH TP,$TATOM + PUSH TP,EQUOTE UNBOUND-VARIABLE + JRST ER1ARG + +UNAS: PUSH TP,$TATOM + PUSH TP,EQUOTE UNASSIGNED-VARIABLE + JRST ER1ARG + +BADENV: + ERRUUO EQUOTE BAD-ENVIRONMENT + +FUNERR: + ERRUUO EQUOTE BAD-FUNARG + + +MPD.0: +MPD.1: +MPD.2: +MPD.3: +MPD.4: +MPD.5: +MPD.6: +MPD.7: +MPD.8: +MPD.9: +MPD.10: +MPD.11: +MPD.12: +MPD.13: +MPD: ERRUUO EQUOTE MEANINGLESS-PARAMETER-DECLARATION + +NOBODY: ERRUUO EQUOTE HAS-EMPTY-BODY + +BADCLS: ERRUUO EQUOTE BAD-CLAUSE + +NXTAG: ERRUUO EQUOTE NON-EXISTENT-TAG + +NXPRG: ERRUUO EQUOTE NOT-IN-PROG + +NAPTL: +NAPT: ERRUUO EQUOTE NON-APPLICABLE-TYPE + +NONEVT: ERRUUO EQUOTE NON-EVALUATEABLE-TYPE + + +NONATM: ERRUUO EQUOTE NON-ATOMIC-ARGUMENT + + +ILLFRA: ERRUUO EQUOTE FRAME-NO-LONGER-EXISTS + +ILLSEG: ERRUUO EQUOTE ILLEGAL-SEGMENT + +BADMAC: ERRUUO EQUOTE BAD-USE-OF-MACRO + +BADFSB: ERRUUO EQUOTE APPLY-OR-STACKFORM-OF-FSUBR + + +ER1ARG: PUSH TP,(AB) + PUSH TP,1(AB) + MOVEI A,2 + JRST CALER + +END + \ No newline at end of file diff --git a//eval.mid.124 b//eval.mid.124 new file mode 100644 index 0000000..f377766 --- /dev/null +++ b//eval.mid.124 @@ -0,0 +1,4245 @@ +TITLE EVAL -- MUDDLE EVALUATOR + +RELOCATABLE + +; GERALD JAY SUSSMAN, 1971. REWRITTEN MANY TIMES SINCE C. REEVE (1972--1974) + + +.GLOBAL BINDID,LPROG,GLOBSP,GLOBASE,SPBASE,TPBASE,PTIME,SWAP,CHFRAM +.GLOBAL IGVAL,CHKARG,NXTDCL,TPOVFL,CHFRM,PROCHK,CHFSWP,VECBOT,TYPSGR +.GLOBAL ILVAL,ER1ARG,SPECBIND,MAKACT,SPECSTORE,MAKTUP,TPALOC,IBIND,SSPECS +.GLOBAL IDVAL,EVECTO,EUVECT,CHARGS,BCKTRK,CELL,ILOC,IGLOC,CHKDCL,SSPEC1 +.GLOBAL PDLBUF,MESS,FACTI,CHKARG,MAKENV,PSTAT,BNDV,UNBOU,UNAS,IGDECL +.GLOBAL 1STEPR,SEGMNT,SEGLST,NAPT,EVTYPE,EVATYP,APTYPE,APLTYP,APLQ,IDVAL1 +.GLOBAL TESTR,VALG,TYPG,INCR1,TMATCH,TYPMIS,SAT,MAKACT,NTPALO,SPECBND +.GLOBAL TPGROW,CHKAB,TYPSEG,NXTLM,MONCH0,CHFINI,RMONC0,IMPURIFY,ICONS,INCONS +.GLOBAL CILVAL,CISET,CIGVAL,CSETG,MAPPLY,CLLOC,CGLOC,CASSQ,CGASSQ,CBOUND +.GLOBAL IIGLOC,CHUNW,IUNWIN,UNWIN2,SPCCHK,CURFCN,TMPLNT,TD.LNT,TBINIT +.GLOBAL SPECBE,BSETG,GLOTOP,CANDP,CORP,TFA,TMA,DSTORE,PVSTOR,SPSTOR +.GLOBAL AGC,GVLINC,LVLINC,CGBOUN,IEVECT,MAKTU2,STOSTR,HIBOT,POPUNW,ISTRUC +.GLOBAL NOSET,NOSETG + +.INSRT MUDDLE > + +MONITOR + + +; ENTRY TO EXPAND A MACRO + +MFUNCTION EXPAND,SUBR + + ENTRY 1 + + MOVE PVP,PVSTOR+1 + MOVEI A,PVLNT*2+1(PVP) + HRLI A,TFRAME + MOVE B,TBINIT+1(PVP) + HLL B,OTBSAV(B) + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + JRST AEVAL2 + +; MAIN EVAL ENTRANCE + +IMFUNCTION EVAL,SUBR + + ENTRY + + MOVE PVP,PVSTOR+1 + SKIPE C,1STEPR+1(PVP) ; BEING 1 STEPPED? + JRST 1STEPI ; YES HANDLE +EVALON: HLRZ A,AB ;GET NUMBER OF ARGS + CAIE A,-2 ;EXACTLY 1? + JRST AEVAL ;EVAL WITH AN ALIST +SEVAL: GETYP A,(AB) ;GET TYPE OF ARG + SKIPE C,EVATYP+1 ; USER TYPE TABLE? + JRST EVDISP +SEVAL1: CAIG A,NUMPRI ;PRIMITIVE? + JRST SEVAL2 ;YES-DISPATCH + +SELF: MOVE A,(AB) ;TYPES WHICH EVALUATE + MOVE B,1(AB) + JRST EFINIS ;TO SELF-EG NUMBERS + +SEVAL2: HRRO A,EVTYPE(A) + JRST (A) + +; HERE FOR USER EVAL DISPATCH + +EVDISP: ADDI C,(A) ; POINT TO SLOT + ADDI C,(A) + SKIPE (C) ; SKIP EITHER A LOSER OR JRST DISP + JRST EVDIS1 ; APPLY EVALUATOR + SKIPN C,1(C) ; GET ADDR OR GO TO PURE DISP + JRST SEVAL1 + JRST (C) + +EVDIS1: PUSH TP,(C) + PUSH TP,1(C) + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,APPLY ; APPLY HACKER TO OBJECT + JRST EFINIS + + +; EVAL DISPATCH TABLE + +IF2,SELFS==400000,,SELF + +DISTBL EVTYPE,SELFS,[[TFORM,EVFORM],[TLIST,EVLIST],[TVEC,EVECT],[TUVEC,EUVEC] +[TSEG,ILLSEG]] + + +;WATCH FOR SUBTLE BUG 43 LERR,LPROG OR BINDID +AEVAL: + CAIE A,-4 ;EXACTLY 2 ARGS? + JRST WNA ;NO-ERROR + GETYP A,2(AB) ;CHECK THAT WE HAVE A FRAME + CAIE A,TACT + CAIN A,TFRAME + JRST .+3 + CAIE A,TENV + JRST TRYPRO ; COULD BE PROCESS + MOVEI B,2(AB) ; POINT TO FRAME +AEVAL2: PUSHJ P,CHENV ; HACK ENVIRONMENT CHANGE +AEVAL1: PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 1,EVAL +AEVAL3: HRRZ 0,FSAV(TB) + CAIN 0,EVAL + JRST EFINIS + JRST FINIS + +TRYPRO: CAIE A,TPVP ; SKIP IF IT IS A PROCESS + JRST WTYP2 + MOVE C,3(AB) ; GET PROCESS + CAMN C,PVSTOR ; DIFFERENT FROM ME? + JRST SEVAL ; NO, NORMAL EVAL WINS + MOVE B,SPSTO+1(C) ; GET SP FOR PROCESS + MOVE D,TBSTO+1(C) ; GET TOP FRAME + HLL D,OTBSAV(D) ; TIME IT + MOVEI C,PVLNT*2+1(C) ; CONS UP POINTER TO PROC DOPE WORD + HRLI C,TFRAME ; LOOK LIK E A FRAME + PUSHJ P,SWITSP ; SPLICE ENVIRONMENT + JRST AEVAL1 + +; ROUTINE TO CHANGE LOOK UP PATH FOR BINDINGS + +CHENV: PUSHJ P,CHFRM ; CHECK OUT FRAME + MOVE C,(B) ; POINT TO PROCESS + MOVE D,1(B) ; GET TB POINTER FROM FRAME + CAMN SP,SPSAV(D) ; CHANGE? + POPJ P, ; NO, JUST RET + MOVE B,SPSAV(D) ; GET SP OF INTEREST +SWITSP: MOVSI 0,TSKIP ; SET UP SKIP + HRRI 0,1(TP) ; POINT TO UNBIND PATH + MOVE A,PVSTOR+1 + ADD A,[BINDID,,BINDID] ; BIND THE BINDING ID + PUSH TP,BNDV + PUSH TP,A + PUSH TP,$TFIX + AOS A,PTIME ; NEW ID + PUSH TP,A + MOVE E,TP ; FOR SPECBIND + PUSH TP,0 + PUSH TP,B + PUSH TP,C ; SAVE PROCESS + PUSH TP,D + PUSHJ P,SPECBE ; BIND BINDID + MOVE SP,TP ; GET NEW SP + SUB SP,[3,,3] ; SET UP SP FORK + MOVEM SP,SPSTOR+1 + POPJ P, + + +; HERE TO EVALUATE A FORM (99% OF EVAL'S WORK) + +EVFORM: SKIPN C,1(AB) ; EMPTY FORM, RETURN FALSE + JRST EFALSE + GETYP A,(C) ; 1ST ELEMENT OF FORM + CAIE A,TATOM ; ATOM? + JRST EV0 ; NO, EVALUATE IT + MOVE B,1(C) ; GET ATOM + PUSHJ P,IGVAL ; GET ITS GLOBAL VALUE + +; SPECIAL HACK TO SPEED UP LVAL AND GVAL CALLS + + CAIE B,LVAL + CAIN B,GVAL + JRST ATMVAL ; FAST ATOM VALUE + + GETYP 0,A + CAIE 0,TUNBOU ; BOUND? + JRST IAPPLY ; YES APPLY IT + + MOVE C,1(AB) ; LOOK FOR LOCAL + MOVE B,1(C) + PUSHJ P,ILVAL + GETYP 0,A + CAIE 0,TUNBOU + JRST IAPPLY ; WIN, GO APPLY IT + + PUSH TP,$TATOM + PUSH TP,EQUOTE UNBOUND-VARIABLE + PUSH TP,$TATOM + MOVE C,1(AB) ; FORM BACK + PUSH TP,1(C) + PUSH TP,$TATOM + PUSH TP,IMQUOTE VALUE + MCALL 3,ERROR ; REPORT THE ERROR + JRST IAPPLY + +EFALSE: MOVSI A,TFALSE ; SPECIAL FALSE FOR EVAL OF EMPTY FORM + MOVEI B,0 + JRST EFINIS + +ATMVAL: HRRZ D,(C) ; CDR THE FORM + HRRZ 0,(D) ; AND AGAIN + JUMPN 0,IAPPLY + GETYP 0,(D) ; MAKE SURE APPLYING TO ATOM + CAIE 0,TATOM + JRST IAPPLY + MOVEI E,IGVAL ; ASSUME GLOBAAL + CAIE B,GVAL ; SKIP IF OK + MOVEI E,ILVAL ; ELSE USE LOCAL + PUSH P,B ; SAVE SUBR + MOVE B,(D)+1 ; CLR BUG #1637 (GET THE ATOM FOR THE SUBR) + PUSHJ P,(E) ; AND GET VALUE + CAME A,$TUNBOU + JRST EFINIS ; RETURN FROM EVAL + POP P,B + MOVSI A,TSUBR ; CAUSE REAL SUBR TO GET EROR + JRST IAPPLY + +; HERE FOR 1ST ELEMENT NOT A FORM + +EV0: PUSHJ P,FASTEV ; EVAL IT + +; HERE TO APPLY THINGS IN FORMS + +IAPPLY: PUSH TP,(AB) ; SAVE THE FORM + PUSH TP,1(AB) + PUSH TP,A + PUSH TP,B ; SAVE THE APPLIER + PUSH TP,$TFIX ; AND THE ARG GETTER + PUSH TP,[ARGCDR] + PUSHJ P,APLDIS ; GO TO INTERNAL APPLIER + JRST EFINIS ; LEAVE EVAL + +; HERE TO EVAL 1ST ELEMENT OF A FORM + +FASTEV: MOVE PVP,PVSTOR+1 + SKIPE 1STEPR+1(PVP) ; BEING 1 STEPPED? + JRST EV02 ; YES, LET LOSER SEE THIS EVAL + GETYP A,(C) ; GET TYPE + SKIPE D,EVATYP+1 ; USER TABLE? + JRST EV01 ; YES, HACK IT +EV03: CAIG A,NUMPRI ; SKIP IF SELF + SKIPA A,EVTYPE(A) ; GET DISPATCH + MOVEI A,SELF ; USE SLEF + +EV04: CAIE A,SELF ; IF EVAL'S TO SELF, JUST USE IT + JRST EV02 + MOVSI A,TLIST + MOVE PVP,PVSTOR+1 + MOVEM A,CSTO(PVP) + INTGO + SETZM CSTO(PVP) + HLLZ A,(C) ; GET IT + MOVE B,1(C) + JSP E,CHKAB ; CHECK DEFERS + POPJ P, ; AND RETURN + +EV01: ADDI D,(A) ; POINT TO SLOT OF USER EVAL TABLE + ADDI D,(A) + SKIPE (D) ; EITHER NOT GIVEN OR SIMPLE + JRST EV02 + SKIPN 1(D) ; SKIP IF SIMPLE + JRST EV03 ; NOT GIVEN + MOVE A,1(D) + JRST EV04 + +EV02: PUSH TP,(C) + HLLZS (TP) ; FIX UP LH + PUSH TP,1(C) + JSP E,CHKARG + MCALL 1,EVAL + POPJ P, + + +; MAPF/MAPR CALL TO APPLY + + IMQUOTE APPLY + +MAPPLY: JRST APPLY + +; APPLY, FALLS INTO EVAL'S APPLY CODE AT APLDIS + +IMFUNCTION APPLY,SUBR + + ENTRY + + JUMPGE AB,TFA ; MUST BE AT LEAST 1 ARGUMENT + MOVE A,AB + ADD A,[2,,2] + PUSH TP,$TAB + PUSH TP,A + PUSH TP,(AB) ; SAVE FCN + PUSH TP,1(AB) + PUSH TP,$TFIX ; AND ARG GETTER + PUSH TP,[SETZ APLARG] + PUSHJ P,APLDIS + JRST FINIS + +; STACKFROM, ALSO FALLS INTO EVAL'S APPLIER AT APLDIS + +IMFUNCTION STACKFORM,FSUBR + + ENTRY 1 + + GETYP A,(AB) + CAIE A,TLIST + JRST WTYP1 + MOVEI A,3 ; CHECK ALL GOODIES SUPPLIED + HRRZ B,1(AB) + + JUMPE B,TFA + HRRZ B,(B) ; CDR IT + SOJG A,.-2 + + HRRZ C,1(AB) ; GET LIST BACK + PUSHJ P,FASTEV ; DO A FAST EVALUATION + PUSH TP,(AB) + HRRZ C,@1(AB) ; POINT TO ARG GETTING FORMS + PUSH TP,C + PUSH TP,A ; AND FCN + PUSH TP,B + PUSH TP,$TFIX + PUSH TP,[SETZ EVALRG] + PUSHJ P,APLDIS + JRST FINIS + + +; OFFSETS FOR TEMPORARIES ETC. USED IN APPLYING STUFF + +E.FRM==0 ; POINTS TO FORM BEING EVALED (OR ARGS FOR APPLY STACKFORM) +E.FCN==2 ; FUNCTION/SUBR/RSUBR BEING APPLIED +E.ARG==4 ; POINTS TO ARG GETTING ROUTINE (<0 => MUST EVAL ARGS) +E.EXTR==6 ; CONTAINS 1ST ARG IN USER APPLY CASE +E.SEG==10 ; POINTS TO SEGMENT IN FORM BEING HACKED +E.CNT==12 ; COUNTER FOR TUPLES OF ARGS +E.DECL==14 ; POINTS TO DECLARATION LIST IN FUNCTIONS +E.ARGL==16 ; POINTS TO ARG LIST IN FUNCTIONS +E.HEW==20 ; POINTS TO HEWITT ATOM IF IT EXISTS + +E.VAL==E.ARGL ; VALUE TYPE FOR RSUBRS + +MINTM==E.EXTR+2 ; MIN # OF TEMPS EVER ALLOCATED +E.TSUB==E.CNT+2 ; # OF TEMPS FOR SUBR/NUMBER APPLICATION +XP.TMP==E.HEW-E.EXTR ; # EXTRA TEMPS FOR FUNCTION APPLICATION +R.TMP==4 ; TEMPS AFTER ARGS ARE BOUND +TM.OFF==E.HEW+2-R.TMP ; TEMPS TO FLUSH AFTER BIND OF ARGS + +RE.FCN==0 ; AFTER BINDING CONTAINS FCN BODY +RE.ARG==2 ; ARG LIST AFTER BINDING + +; GENERAL THING APPLYER + +APLDIS: PUSH TP,[0] ; SLOT USED FOR USER APPLYERS + PUSH TP,[0] +APLDIX: GETYP A,E.FCN(TB) ; GET TYPE + +APLDI: SKIPE D,APLTYP+1 ; USER TABLE EXISTS? + JRST APLDI1 ; YES, USE IT +APLDI2: CAILE A,NUMPRI ; SKIP IF NOT PRIM + JRST NAPT + HRRO A,APTYPE(A) + JRST (A) + +APLDI1: ADDI D,(A) ; POINT TO SLOT + ADDI D,(A) + SKIPE (D) ; SKIP IF NOT GIVEN OR STANDARD + JRST APLDI3 +APLDI4: SKIPE D,1(D) ; GET DISP + JRST (D) + JRST APLDI2 ; USE SYSTEM DISPATCH + +APLDI3: SKIPE E.EXTR+1(TB) ; SKIP IF HAVEN'T BEEN HERE BEFORE + JRST APLDI4 + MOVE A,(D) ; GET ITS HANDLER + EXCH A,E.FCN(TB) ; AND USE AS FCN + MOVEM A,E.EXTR(TB) ; SAVE + MOVE A,1(D) + EXCH A,E.FCN+1(TB) + MOVEM A,E.EXTR+1(TB) ; STASH OLD FCN AS EXTRG + GETYP A,(D) ; GET TYPE + JRST APLDI + + +; APPLY DISPATCH TABLE + +DISTBL APTYPE,,[[TSUBR,APSUBR],[TFSUBR,APFSUB],[TRSUBR,APRSUB],[TFIX,APNUM] +[TEXPR,APEXPR],[TFUNAR,APFUNARG],[TENTER,APENTR],[TMACRO,APMACR],[TOFFS,APNUM]] + +; SUBR TO SAY IF TYPE IS APPLICABLE + +MFUNCTION APPLIC,SUBR,[APPLICABLE?] + + ENTRY 1 + + GETYP A,(AB) + PUSHJ P,APLQ + JRST IFALSE + JRST TRUTH + +; HERE TO DETERMINE IF A TYPE IS APPLICABLE + +APLQ: PUSH P,B + SKIPN B,APLTYP+1 + JRST USEPUR ; USE PURE TABLE + ADDI B,(A) + ADDI B,(A) ; POINT TO SLOT + SKIPG 1(B) ; SKIP IF WINNER + SKIPE (B) ; SKIP IF POTENIAL LOSER + JRST CPPJ1B ; WIN + SKIPE 1(B) ; SKIP IF MUST USE PURE TABBLE + JRST CPOPJB +USEPUR: CAILE A,NUMPRI ; SKIP IF NOT PRIM + JRST CPOPJB + SKIPL APTYPE(A) ; SKIP IF APLLICABLE +CPPJ1B: AOS -1(P) +CPOPJB: POP P,B + POPJ P, + +; FSUBR APPLYER + +APFSUBR: + SKIPN E.EXTR(TB) ; IF EXTRA ARG + SKIPGE E.ARG+1(TB) ; OR APPLY/STACKFORM, LOSE + JRST BADFSB + MOVE A,E.FCN+1(TB) ; GET FCN + HRRZ C,@E.FRM+1(TB) ; GET ARG LIST + SUB TP,[MINTM,,MINTM] ; FLUSH UNWANTED TEMPS + PUSH TP,$TLIST + PUSH TP,C ; ARG TO STACK + .MCALL 1,(A) ; AND CALL + POPJ P, ; AND LEAVE + +; SUBR APPLYER + +APSUBR: + PUSHJ P,PSH4ZR ; SET UP ZEROED SLOTS + SKIPG E.ARG+1(TB) + AOS E.CNT(TB) ; INDICATES IF MUST EVAL ARGS + MOVSI A,400000 ; MAKE SURE OF GOOD INDIRECT + IORM A,E.ARG+1(TB) + SKIPN A,E.EXTR(TB) ; FUNNY ARGS + JRST APSUB1 ; NO, GO + MOVE B,E.EXTR+1(TB) ; YES , GET VAL + JRST APSUB2 ; AND FALL IN + +APSUB1: PUSHJ P,@E.ARG+1(TB) ; EAT AN ARG + JRST APSUBD ; DONE +APSUB2: PUSH TP,A + PUSH TP,B + AOS E.CNT+1(TB) ; COUNT IT + JRST APSUB1 + +APSUBD: MOVE A,E.CNT+1(TB) ; FINISHED, GET COUNT + MOVE B,E.FCN+1(TB) ; AND SUBR + GETYP 0,E.FCN(TB) + CAIN 0,TENTER + JRST APENDN + PUSHJ P,BLTDN ; FLUSH CRUFT + .ACALL A,(B) + POPJ P, + +BLTDN: MOVEI C,(TB) ; POINT TO DEST + HRLI C,E.TSUB(C) ; AND SOURCE + BLT C,-E.TSUB(TP) ;BL..............T + SUB TP,[E.TSUB,,E.TSUB] + POPJ P, + +APENDN: PUSHJ P,BLTDN +APNDN1: .ECALL A,(B) + POPJ P, + +; FLAGS FOR RSUBR HACKER + +F.STR==1 +F.OPT==2 +F.QUO==4 +F.NFST==10 + +; APPLY OBJECTS OF TYPE RSUBR + +APENTR: +APRSUBR: + MOVE C,E.FCN+1(TB) ; GET THE RSUBR + CAML C,[-5,,] ; IS IT LONG ENOUGH FOR DECLS + JRST APSUBR ; NO TREAT AS A SUBR + GETYP 0,4(C) ; GET TYPE OF 3D ELEMENT + CAIE 0,TDECL ; DECLARATION? + JRST APSUBR ; NO, TREAT AS SUBR + PUSHJ P,PSH4ZR ; ALLOCATE SOME EXTRA ROOM + PUSH TP,$TDECL ; PUSH UP THE DECLS + PUSH TP,5(C) + PUSH TP,$TLOSE ; SAVE ROOM FOR VAL DECL + PUSH TP,[0] + SKIPG E.ARG+1(TB) + AOS E.CNT(TB) ; INDICATES IF MUST EVAL ARGS + MOVSI A,400000 ; MAKE SURE OF GOOD INDIRECT + IORM A,E.ARG+1(TB) + + SKIPN E.EXTR(TB) ; "EXTRA" ARG? + JRST APRSU1 ; NO, + MOVE 0,[SETZ EXTRGT] ; CHANGE THE ACCESS FCN + EXCH 0,E.ARG+1(TB) + HRRM 0,E.ARG(TB) ; REMEMBER IT + +APRSU1: MOVEI 0,0 ; INIT FLAG REGISTER + PUSH P,0 ; SAVE + +APRSU2: HRRZ A,E.DECL+1(TB) ; GET DECL LIST + JUMPE A,APRSU3 ; DONE! + HRRZ B,(A) ; CDR IT + MOVEM B,E.DECL+1(TB) + PUSHJ P,NXTDCL ; IS NEXT THING A STRING? + JRST APRSU4 ; NO, BETTER BE A TYPE + CAMN B,[ASCII /VALUE/] + JRST RSBVAL ; SAVE VAL DECL + TRON 0,F.NFST ; IF NOT FIRST, LOSE + CAME B,[ASCII /CALL/] ; CALL DECL + JRST APRSU7 + SKIPE E.CNT(TB) ; LEGAL? + JRST MPD + MOVE C,E.FRM(TB) + MOVE D,E.FRM+1(TB) ; GET FORM + JRST APRS10 ; HACK IT + +APRSU5: TROE 0,F.STR ; STRING STRING? + JRST MPD ; LOSER + CAMN B,[] + JRST .+3 + CAME B,[+1] ; OPTIONA? + JRST APRSU8 + TROE 0,F.OPT ; CHECK AND SET + JRST MPD ; OPTINAL OPTIONAL LOSES + JRST APRSU2 ; TO MAIN LOOP + +APRSU7: CAME B,[ASCII /QUOTE/] + JRST APRSU5 + TRO 0,F.STR + TROE 0,F.QUO ; TURN ON AND CHECK QUOTE + JRST MPD ; QUOTE QUOTE LOSES + JRST APRSU2 ; GO TO END OF LOOP + + +APRSU8: CAME B,[ASCII /ARGS/] + JRST APRSU9 + SKIPE E.CNT(TB) ; SKIP IF LEGAL + JRST MPD + HRRZ D,@E.FRM+1(TB) ; GET ARG LIST + MOVSI C,TLIST + +APRS10: HRRZ A,(A) ; GET THE DECL + MOVEM A,E.DECL+1(TB) ; CLOBBER + HRRZ B,(A) ; CHECK FOR TOO MUCH + JUMPN B,MPD + MOVE B,1(A) ; GET DECL + HLLZ A,(A) ; GOT THE DECL + MOVEM 0,(P) ; SAVE FLAGS + JSP E,CHKAB ; CHECK DEFER + PUSH TP,C + PUSH TP,D ; SAVE + PUSHJ P,TMATCH + JRST WTYP + AOS E.CNT+1(TB) ; COUNT ARG + JRST APRDON ; GO CALL RSUBR + +RSBVAL: HRRZ A,E.DECL+1(TB) ; GET DECL + JUMPE A,MPD + HRRZ B,(A) ; POINT TO DECL + MOVEM B,E.DECL+1(TB) ; SAVE NEW DECL POINTER + PUSHJ P,NXTDCL + JRST .+2 + JRST MPD + MOVEM A,E.VAL+1(TB) ; SAVE VAL DECL + MOVSI A,TDCLI + MOVEM A,E.VAL(TB) ; SET ITS TYPE + JRST APRSU2 + + +APRSU9: CAME B,[ASCII /TUPLE/] + JRST MPD + MOVEM 0,(P) ; SAVE FLAGS + HRRZ A,(A) ; CDR DECLS + MOVEM A,E.DECL+1(TB) + HRRZ B,(A) + JUMPN B,MPD ; LOSER + PUSH P,[0] ; COUNT ELEMENTS IN TUPLE + +APRTUP: PUSHJ P,@E.ARG+1(TB) ; GOBBLE ARGS + JRST APRTPD ; DONE + PUSH TP,A + PUSH TP,B + AOS (P) ; COUNT IT + JRST APRTUP ; AND GO + +APRTPD: POP P,C ; GET COUNT + ADDM C,E.CNT+1(TB) ; UPDATE MAIN COUNT + ASH C,1 ; # OF WORDS + HRLI C,TINFO ; BUILD FENCE POST + PUSH TP,C + PUSHJ P,TBTOTP ; GEN REL OFFSET TO TOP + PUSH TP,D + HRROI D,-1(TP) ; POINT TO TOP + SUBI D,(C) ; TO BASE + TLC D,-1(C) + MOVSI C,TARGS ; BUILD TYPE WORD + HLR C,OTBSAV(TB) + MOVE A,E.DECL+1(TB) + MOVE B,1(A) + HLLZ A,(A) ; TYPE/VAL + JSP E,CHKAB ; CHECK + PUSHJ P,TMATCH ; GOTO TYPE CHECKER + JRST WTYP + + SUB TP,[2,,2] ; REMOVE FENCE POST + +APRDON: SUB P,[1,,1] ; FLUSH CRUFT + MOVE A,E.CNT+1(TB) ; GET # OF ARGS + MOVE B,E.FCN+1(TB) + GETYP 0,E.FCN(TB) ; COULD BE ENTRY + MOVEI C,(TB) ; PREPARE TO BLT DOWN + HRLI C,E.TSUB+2(C) + BLT C,-E.TSUB+2(TP) + SUB TP,[E.TSUB+2,,E.TSUB+2] + CAIE 0,TRSUBR + JRST APNDNX + .ACALL A,(B) ; CALL THE RSUBR + JRST PFINIS + +APNDNX: .ECALL A,(B) + JRST PFINIS + + + + +APRSU4: MOVEM 0,(P) ; SAVE FLAGS + MOVE B,1(A) ; GET DECL + HLLZ A,(A) + JSP E,CHKAB + MOVE 0,(P) ; RESTORE FLAGS + PUSH TP,A + PUSH TP,B ; AND SAVE + SKIPE E.CNT(TB) ; ALREADY EVAL'D + JRST APREV0 + TRZN 0,F.QUO + JRST APREVA ; MUST EVAL ARG + MOVEM 0,(P) + HRRZ C,@E.FRM+1(TB) ; GET ARG? + TRNE 0,F.OPT ; OPTIONAL + JUMPE C,APRDN + JUMPE C,TFA ; NO, TOO FEW ARGS + MOVEM C,E.FRM+1(TB) + HLLZ A,(C) ; GET ARG + MOVE B,1(C) + JSP E,CHKAB ; CHECK THEM + +APRTYC: MOVE C,A ; SET UP FOR TMATCH + MOVE D,B + EXCH B,(TP) + EXCH A,-1(TP) ; SAVE STUFF +APRS11: PUSHJ P,TMATCH ; CHECK TYPE + JRST WTYP + + MOVE 0,(P) ; RESTORE FLAGS + TRZ 0,F.STR + AOS E.CNT+1(TB) + JRST APRSU2 ; AND GO ON + +APREV0: TRNE 0,F.QUO ; ATTEMPT TO QUOTE ALREADY EVAL'D ARG ? + JRST MPD ; YES, LOSE +APREVA: PUSHJ P,@E.ARG+1(TB) ; EVAL ONE + TDZA C,C ; C=0 ==> NONE LEFT + MOVEI C,1 + MOVE 0,(P) ; FLAGS + JUMPN C,APRTYC ; GO CHECK TYPE +APRDN: SUB TP,[2,,2] ; FLUSH DECL + TRNE 0,F.OPT ; OPTIONAL? + JRST APRDON ; ALL DONE + JRST TFA + +APRSU3: TRNE 0,F.STR ; END IN STRING? + JRST MPD + PUSHJ P,@E.ARG+1(TB) ; SEE IF ANYMORE ARGS + JRST APRDON + JRST TMA + + +; STANDARD ARGUMENT GETTERS USED IN APPLYING THINGS + +ARGCDR: HRRZ C,@E.FRM+1(TB) ; POINT TO ARGLIST (NOTE: POINTS 1 BEFORE WHERE ARG IS) + JUMPE C,CPOPJ ; LEAVE IF DONE + MOVEM C,E.FRM+1(TB) + GETYP 0,(C) ; GET TYPE OF ARG + CAIN 0,TSEG + JRST ARGCD1 ; SEG MENT HACK + PUSHJ P,FASTEV + JRST CPOPJ1 + +ARGCD1: PUSH TP,$TFORM ; PRETEND WE ARE A FORM + PUSH TP,1(C) + MCALL 1,EVAL + MOVEM A,E.SEG(TB) + MOVEM B,E.SEG+1(TB) + PUSHJ P,TYPSEG ; GET SEG TYPE CODE + HRRM C,E.ARG(TB) ; SAVE IT IN OBSCCURE PLACE + MOVE C,DSTORE ; FIX FOR TEMPLATE + MOVEM C,E.SEG(TB) + MOVE C,[SETZ SGARG] + MOVEM C,E.ARG+1(TB) ; SET NEW ARG GETTER + +; FALL INTO SEGARG + +SGARG: INTGO + HRRZ C,E.ARG(TB) ; SEG CODE TO C + MOVE D,E.SEG+1(TB) + MOVE A,E.SEG(TB) + MOVEM A,DSTORE + PUSHJ P,NXTLM ; GET NEXT ELEMENT + JRST SEGRG1 ; DONE + MOVEM D,E.SEG+1(TB) + MOVE D,DSTORE ; KEEP TYPE WINNING + MOVEM D,E.SEG(TB) + SETZM DSTORE + JRST CPOPJ1 ; RETURN + +SEGRG1: SETZM DSTORE + MOVEI C,ARGCDR + HRRM C,E.ARG+1(TB) ; RESET ARG GETTER + JRST ARGCDR + +; ARGUMENT GETTER FOR APPLY + +APLARG: INTGO + SKIPL A,E.FRM+1(TB) ; ANY ARGS LEFT + POPJ P, ; NO, EXIT IMMEDIATELY + ADD A,[2,,2] + MOVEM A,E.FRM+1(TB) + MOVE B,-1(A) ; RET NEXT ARG + MOVE A,-2(A) + JRST CPOPJ1 + +; STACKFORM ARG GETTER + +EVALRG: SKIPN C,@E.FRM+1(TB) ; ANY FORM? + POPJ P, + PUSHJ P,FASTEV + GETYP A,A ; CHECK FOR FALSE + CAIN A,TFALSE + POPJ P, + MOVE C,E.FRM+1(TB) ; GET OTHER FORM + PUSHJ P,FASTEV + JRST CPOPJ1 + + +; HERE TO APPLY NUMBERS + +APNUM: PUSHJ P,PSH4ZR ; TP SLOTS + SKIPN A,E.EXTR(TB) ; FUNNY ARG? + JRST APNUM1 ; NOPE + MOVE B,E.EXTR+1(TB) ; GET ARG + JRST APNUM2 + +APNUM1: PUSHJ P,@E.ARG+1(TB) ; GET ARG + JRST TFA +APNUM2: PUSH TP,A + PUSH TP,B + PUSH TP,E.FCN(TB) + PUSH TP,E.FCN+1(TB) + PUSHJ P,@E.ARG+1(TB) + JRST .+2 + JRST APNUM3 + PUSHJ P,BLTDN ; FLUSH JUNK + MCALL 2,NTH + POPJ P, +; HACK FOR TURNING <3 .FOO .BAR> INTO +APNUM3: PUSH TP,A + PUSH TP,B + PUSHJ P,@E.ARG+1(TB) + JRST .+2 + JRST TMA + PUSHJ P,BLTDN + GETYP A,-5(TP) + PUSHJ P,ISTRUC ; STRUCTURED FIRST ARG? + JRST WTYP1 + MCALL 3,PUT + POPJ P, + +; HERE TO APPLY SUSSMAN FUNARGS + +APFUNARG: + + SKIPN C,E.FCN+1(TB) + JRST FUNERR + HRRZ D,(C) ; MUST BE AT LEAST 2 LONG + JUMPE D,FUNERR + GETYP 0,(D) ; CHECK FOR LIST + CAIE 0,TLIST + JRST FUNERR + HRRZ 0,(D) ; SHOULD BE END + JUMPN 0,FUNERR + GETYP 0,(C) ; 1ST MUST BE FCN + CAIE 0,TEXPR + JRST FUNERR + SKIPN C,1(C) + JRST NOBODY + PUSHJ P,APEXPF ; BIND THE ARGS AND AUX'S + HRRZ C,RE.FCN+1(TB) ; GET BODY OF FUNARG + MOVE B,1(C) ; GET FCN + MOVEM B,RE.FCN+1(TB) ; AND SAVE + HRRZ C,(C) ; CDR FUNARG BODY + MOVE C,1(C) + MOVSI 0,TLIST ; SET UP TYPE + MOVE PVP,PVSTOR+1 + MOVEM 0,CSTO(PVP) ; FOR INTS TO WIN + +FUNLP: INTGO + JUMPE C,DOF ; RUN IT + GETYP 0,(C) + CAIE 0,TLIST ; BETTER BE LIST + JRST FUNERR + PUSH TP,$TLIST + PUSH TP,C + PUSHJ P,NEXTDC ; GET POSSIBILITY + JRST FUNERR ; LOSER + CAIE A,2 + JRST FUNERR + HRRZ B,(B) ; GET TO VALUE + MOVE C,(TP) + SUB TP,[2,,2] + PUSH TP,BNDA + PUSH TP,E + HLLZ A,(B) ; GET VAL + MOVE B,1(B) + JSP E,CHKAB ; HACK DEFER + PUSHJ P,PSHAB4 ; PUT VAL IN + HRRZ C,(C) ; CDR + JUMPN C,FUNLP + +; HERE TO RUN FUNARG + +DOF: MOVE PVP,PVSTOR+1 + SETZM CSTO(PVP) ; DONT CONFUSE GC + PUSHJ P,SPECBIND ; BIND 'EM UP + JRST RUNFUN + + + +; HERE TO DO MACROS + +APMACR: HRRZ E,OTBSAV(TB) + HRRZ D,PCSAV(E) ; SEE WHERE FROM + CAIE D,EFCALL+1 ; 1STEP + JRST .+3 + HRRZ E,OTBSAV(E) + HRRZ D,PCSAV(E) + CAIN D,AEVAL3 ; SKIP IF NOT RIGHT + JRST APMAC1 + SKIPG E.ARG+1(TB) ; SKIP IF REAL FORM EXISTS + JRST BADMAC + MOVE A,E.FRM(TB) + MOVE B,E.FRM+1(TB) + SUB TP,[E.EXTR+2,,E.EXTR+2] ; FLUSH JUNK + PUSH TP,A + PUSH TP,B + MCALL 1,EXPAND ; EXPAND THE MACRO + PUSH TP,A + PUSH TP,B + MCALL 1,EVAL ; EVAL THE RESULT + POPJ P, + +APMAC1: MOVE C,E.FCN+1(TB) ; GET MACRO BODY + GETYP A,(C) + MOVE B,1(C) + MOVSI A,(A) + JSP E,CHKAB ; FIX DEFERS + MOVEM A,E.FCN(TB) + MOVEM B,E.FCN+1(TB) + JRST APLDIX + +; HERE TO APPLY EXPRS (FUNCTIONS) + +APEXPR: PUSHJ P,APEXP ; BIND ARGS AND AUX'S +RUNFUN: HRRZ A,RE.FCN(TB) ; AMOUNT OF FCN TO SKIP + MOVEI C,RE.FCN+1(TB) ; POINT TO FCN + HRRZ C,(C) ; SKIP SOMETHING + SOJGE A,.-1 ; UNTIL 1ST FORM + MOVEM C,RE.FCN+1(TB) ; AND STORE + JRST DOPROG ; GO RUN PROGRAM + +APEXP: SKIPN C,E.FCN+1(TB) ; CHECK FRO BODY + JRST NOBODY +APEXPF: PUSH P,[0] ; COUNT INIT CRAP + ADD TP,[XP.TMP,,XP.TMP] ; SLOTS FOR HACKING + SKIPL TP + PUSHJ P,TPOVFL + SETZM 1-XP.TMP(TP) ; ZERO OUT + MOVEI A,-XP.TMP+2(TP) + HRLI A,-1(A) + BLT A,(TP) ; ZERO SLOTS + SKIPG E.ARG+1(TB) + AOS E.CNT(TB) ; INDICATES IF MUST EVAL ARGS + MOVSI A,400000 ; MAKE E.ARG BE NEG FOR SAFE @ING + IORM A,E.ARG+1(TB) + PUSHJ P,CARATC ; SEE IF HEWITT ATOM EXISTS + JRST APEXP1 ; NO, GO LOOK FOR ARGLIST + MOVEM E,E.HEW+1(TB) ; SAVE ATOM + MOVSM 0,E.HEW(TB) ; AND TYPE + AOS (P) ; COUNT HEWITT ATOM +APEXP1: GETYP 0,(C) ; LOOK AT NEXT THING + CAIE 0,TLIST ; BETTER BE LIST!!! + JRST MPD.0 ; LOSE + MOVE B,1(C) ; GET LIST + MOVEM B,E.ARGL+1(TB) ; SAVE + MOVSM 0,E.ARGL(TB) ; WITH TYPE + HRRZ C,(C) ; CDR THE FCN + JUMPE C,NOBODY ; BODYLESS FCN + GETYP 0,(C) ; SEE IF DCL LIST SUPPLIED + CAIE 0,TDECL + JRST APEXP2 ; NO, START PROCESSING ARGS + AOS (P) ; COUNT DCL + MOVE B,1(C) + MOVEM B,E.DECL+1(TB) + MOVSM 0,E.DECL(TB) + HRRZ C,(C) ; CDR ON + JUMPE C,NOBODY + + ; CHECK FOR EXISTANCE OF EXTRA ARG + +APEXP2: POP P,A ; GET COUNT + HRRM A,E.FCN(TB) ; AND SAVE + SKIPN E.EXTR(TB) ; SKIP IF FUNNY EXTRA ARG EXISTS + JRST APEXP3 + MOVE 0,[SETZ EXTRGT] + EXCH 0,E.ARG+1(TB) + HRRM 0,E.ARG(TB) ; SAVE OLD GETTER AROUND + AOS E.CNT(TB) + +; FALL THROUGH + +; LOOK FOR "BIND" DECLARATION + +APEXP3: PUSHJ P,UNPROG ; UNASSIGN LPROG IF NEC +APXP3A: SKIPN A,E.ARGL+1(TB) ; GET ARGLIST + JRST APEXP4 ; NONE, VERIFY NONE WERE GIVEN + PUSHJ P,NXTDCL ; SEE IF A DECL IS THERE + JRST BNDRG ; NO, GO BIND NORMAL ARGS + HRRZ C,(A) ; CDR THE DCLS + CAME B,[ASCII /BIND/] + JRST CH.CAL ; GO LOOK FOR "CALL" + PUSHJ P,CARTMC ; MUST BE AN ATOM + MOVEM C,E.ARGL+1(TB) ; AND SAVE CDR'D ARGS + PUSHJ P,MAKENV ; GENERATE AN ENVIRONMENT + PUSHJ P,PSBND1 ; PUSH THE BINDING AND CHECK THE DCL + JRST APXP3A ; IN CASE <"BIND" B "BIND" C...... + + +; LOOK FOR "CALL" DCL + +CH.CAL: CAME B,[ASCII /CALL/] + JRST CHOPT ; TRY SOMETHING ELSE +; SKIPG E.ARG+1(TB) ; DONT SKIP IF CANT WIN + SKIPE E.CNT(TB) + JRST MPD.2 + PUSHJ P,CARTMC ; BETTER BE AN ATOM + MOVEM C,E.ARGL+1(TB) + MOVE A,E.FRM(TB) ; RETURN FORM + MOVE B,E.FRM+1(TB) + PUSHJ P,PSBND1 ; BIND AND CHECK + JRST APEXP5 + +; BIND NORMAL ARGS BY CALLING BNDEM1, RETURNS WHEN ALL DONE + +BNDRG: PUSHJ P,BNDEM1 ; GO BIND THEM UP + TRNN A,4 ; SKIP IF HIT A DCL + JRST APEXP4 ; NOT A DCL, MUST BE DONE + +; LOOK FOR "OPTIONAL" DECLARATION + +CHOPT: CAMN B,[] + JRST .+3 + CAME B,[+1] + JRST CHREST ; TRY TUPLE/ARGS + MOVEM C,E.ARGL+1(TB) ; SAVE RESTED ARGLIST + PUSHJ P,BNDEM2 ; DO ALL SUPPLIED OPTIONALS + TRNN A,4 ; SKIP IF NEW DCL READ + JRST APEXP4 + +; CHECK FOR "ARGS" DCL + +CHREST: CAME B,[ASCII /ARGS/] + JRST CHRST1 ; GO LOOK FOR "TUPLE" +; SKIPGE E.ARG+1(TB) ; SKIP IF LEGAL + SKIPE E.CNT(TB) + JRST MPD.3 + PUSHJ P,CARTMC ; GOBBLE ATOM + MOVEM C,E.ARGL+1(TB) ; SAVE CDR'D ARG + HRRZ B,@E.FRM+1(TB) ; GET ARG LIST + MOVSI A,TLIST ; GET TYPE + PUSHJ P,PSBND1 + JRST APEXP5 + +; HERE TO CHECK FOR "TUPLE" + +CHRST1: CAME B,[ASCII /TUPLE/] + JRST APXP10 + PUSHJ P,CARTMC ; GOBBLE ATOM + MOVEM C,E.ARGL+1(TB) + SETZB A,B + PUSHJ P,PSHBND ; SET UP BINDING + SETZM E.CNT+1(TB) ; ZERO ARG COUNTER + +TUPLP: PUSHJ P,@E.ARG+1(TB) ; GET AN ARG + JRST TUPDON ; FINIS + AOS E.CNT+1(TB) + PUSH TP,A + PUSH TP,B + JRST TUPLP + +TUPDON: PUSHJ P,MAKINF ; MAKE INFO CELL + PUSH TP,$TINFO ; FENCE POST TUPLE + PUSHJ P,TBTOTP + ADDI D,TM.OFF ; COMPENSATE FOR MOVEMENT + PUSH TP,D + MOVE C,E.CNT+1(TB) ; GET COUNT + ASH C,1 ; TO WORDS + HRRM C,-1(TP) ; INTO FENCE POST + MOVEI B,-TM.OFF-1(TP) ; SETUP ARG POINTER + SUBI B,(C) ; POINT TO BASE OF TUPLE + MOVNS C ; FOR AOBJN POINTER + HRLI B,(C) ; GOOD ARGS POINTER + MOVEM A,TM.OFF-4(B) ; STORE + MOVEM B,TM.OFF-3(B) + + +; CHECK FOR VALID ENDING TO ARGS + +APEXP5: PUSHJ P,NEXTD ; READ NEXT THING IN ARGLIST + JRST APEXP8 ; DONE + TRNN A,4 ; SKIP IF DCL + JRST MPD.4 ; LOSER +APEXP7: MOVSI A,-NWINS ; CHECK FOR A WINNER + CAME B,WINRS(A) + AOBJN A,.-1 + JUMPGE A,MPD.6 ; NOT A WINNER + +; HERE TO BLT THE WORLD DOWN ON TOP OF ALL THE USELESS TEMPS + +APEXP8: MOVE 0,E.HEW+1(TB) ; GET HEWITT ATOM + MOVE E,E.FCN(TB) ; SAVE COUNTER + MOVE C,E.FCN+1(TB) ; FCN + MOVE B,E.ARGL+1(TB) ; ARG LIST + MOVE D,E.DECL+1(TB) ; AND DCLS + MOVEI A,R.TMP(TB) ; SET UP BLT + HRLI A,TM.OFF(A) + BLT A,-TM.OFF(TP) ; BLLLLLLLLLLLLLT + SUB TP,[TM.OFF,,TM.OFF] ; FLUSH CRUFT + MOVEM E,RE.FCN(TB) + MOVEM C,RE.FCN+1(TB) + MOVEM B,RE.ARGL+1(TB) + MOVE E,TP + PUSH TP,$TATOM + PUSH TP,0 + PUSH TP,$TDECL + PUSH TP,D + GETYP A,-5(TP) ; TUPLE ON TOP? + CAIE A,TINFO ; SKIP IF YES + JRST APEXP9 + HRRZ A,-5(TP) ; GET SIZE + ADDI A,2 + HRLI A,(A) + SUB E,A ; POINT TO BINDINGS + SKIPE C,(TP) ; IF DCL + PUSHJ P,CHKDCL ; CHECK TYPE SPEC ON TUPLE +APEXP9: PUSHJ P,USPCBE ; DO ACTUAL BINDING + + MOVE E,-2(TP) ; RESTORE HEWITT ATOM + MOVE D,(TP) ; AND DCLS + SUB TP,[4,,4] + + JRST AUXBND ; GO BIND AUX'S + +; HERE TO VERIFY CHECK IF ANY ARGS LEFT + +APEXP4: PUSHJ P,@E.ARG+1(TB) + JRST APEXP8 ; WIN + JRST TMA ; TOO MANY ARGS + +APXP10: PUSH P,B + PUSHJ P,@E.ARG+1(TB) + JRST .+2 + JRST TMA + POP P,B + JRST APEXP7 + +; LIST OF POSSIBLE TERMINATING NAMES + +WINRS: +AS.ACT: ASCII /ACT/ +AS.NAM: ASCII /NAME/ +AS.AUX: ASCII /AUX/ +AS.EXT: ASCII /EXTRA/ +NWINS==.-WINRS + + +; HERE TO BIND AUX VARIABLES FOR PROGS AND FCNS + +AUXBND: PUSH P,E ; SAVE HEWITT ATOM ( WILL PUT ON MARKED STACK + ; WHEN NECESSARY) + PUSH P,D ; SAME WITH DCL LIST + PUSH P,[-1] ; FLAG SAYING WE ARE FCN + SKIPN C,RE.ARG+1(TB) ; GET ARG LIST + JRST AUXDON + GETYP 0,(C) ; GET TYPE + CAIE 0,TDEFER ; SKIP IF CHSTR + MOVMS (P) ; SAY WE ARE IN OPTIONALS + JRST AUXB1 + +PRGBND: PUSH P,E + PUSH P,D + PUSH P,[0] ; WE ARE IN AUXS + +AUXB1: HRRZ C,RE.ARG+1(TB) ; POINT TO ARGLIST + PUSHJ P,NEXTDC ; GET NEXT THING OFF OF ARG LIST + JRST AUXDON + TRNE A,4 ; SKIP IF SOME KIND OF ATOM + JRST TRYDCL ; COUDL BE DCL + TRNN A,1 ; SKIP IF QUOTED + JRST AUXB2 + SKIPN (P) ; SKIP IF QUOTED OK + JRST MPD.11 +AUXB2: PUSHJ P,PSHBND ; SET UP BINDING + PUSH TP,$TDECL ; SAVE HEWITT ATOM + PUSH TP,-1(P) + PUSH TP,$TATOM ; AND DECLS + PUSH TP,-2(P) + TRNN A,2 ; SKIP IF INIT VAL EXISTS + JRST AUXB3 ; NO, USE UNBOUND + +; EVALUATE EXPRESSION + + HRRZ C,(B) ; CDR ATOM OFF + +; CHECK FOR SPECIAL FORMS + + GETYP 0,(C) ; GET TYPE OF GOODIE + CAIE 0,TFORM ; SMELLS LIKE A FORM + JRST AUXB13 + HRRZ D,1(C) ; GET 1ST ELEMENT + GETYP 0,(D) ; AND ITS VAL + CAIE 0,TATOM ; FEELS LIKE THE RIGHT FORM + JRST AUXB13 + + MOVE 0,1(D) ; GET THE ATOM + CAME 0,IMQUOTE TUPLE + CAMN 0,MQUOTE ITUPLE + JRST DOTUPL ; SURE GLAD I DIDN'T STEP IN THAT FORM + + +AUXB13: PUSHJ P,FASTEV +AUXB14: MOVE E,TP +AUXB4: MOVEM A,-7(E) ; STORE VAL IN BINDING + MOVEM B,-6(E) + +; HERE TO CHECK AGAINST DECLARATIONS AND COMPLETE THE BINDING + +AUXB5: SUB E,[4,,4] ; POINT TO BINDING TOP + SKIPE C,-2(TP) ; POINT TO DECLARATINS + PUSHJ P,CHKDCL ; CHECK IT + PUSHJ P,USPCBE ; AND BIND UP + SKIPE C,RE.ARG+1(TB) ; CDR DCLS + HRRZ C,(C) ; IF ANY TO CDR + MOVEM C,RE.ARG+1(TB) + MOVE A,(TP) ; NOW PUT HEWITT ATOM AND DCL AWAY + MOVEM A,-2(P) + MOVE A,-2(TP) + MOVEM A,-1(P) + SUB TP,[4,,4] ; FLUSH SLOTS + JRST AUXB1 + + +AUXB3: MOVNI B,1 + MOVSI A,TUNBOU + JRST AUXB14 + + + +; HERE TO HANDLE "CALLS" TO TUPLE AND ITUPLE + +DOTUPL: SKIPE E,(P) ; SKIP IF IN AUX LIST + JRST TUPLE + PUSH TP,$TLIST ; SAVE THE MAGIC FORM + PUSH TP,D + CAME 0,IMQUOTE TUPLE + JRST DOITUP ; DO AN ITUPLE + +; FALL INTO A TUPLE PUSHING LOOP + +DOTUP1: HRRZ C,@(TP) ; CDR THE FORM + JUMPE C,ATUPDN ; FINISHED + MOVEM C,(TP) ; SAVE CDR'D RESULT + GETYP 0,(C) ; CHECK FOR SEGMENT + CAIN 0,TSEG + JRST DTPSEG ; GO PULL IT APART + PUSHJ P,FASTEV ; EVAL IT + PUSHJ P,CNTARG ; PUSH IT UP AND COUNT THEM + JRST DOTUP1 + +; HERE WHEN WE FINISH + +ATUPDN: SUB TP,[2,,2] ; FLUSH THE LIST + ASH E,1 ; E HAS # OF ARGS DOUBLE IT + MOVEI D,(TP) ; FIND BASE OF STACK AREA + SUBI D,(E) + MOVSI C,-3(D) ; PREPARE BLT POINTER + BLT C,C ; HEWITT ATOM AND DECL TO 0,A,B,C + +; NOW PREPEARE TO BLT TUPLE DOWN + + MOVEI D,-3(D) ; NEW DEST + HRLI D,4(D) ; SOURCE + BLT D,-4(TP) ; SLURP THEM DOWN + + HRLI E,TINFO ; SET UP FENCE POST + MOVEM E,-3(TP) ; AND STORE + PUSHJ P,TBTOTP ; GET OFFSET + ADDI D,3 ; FUDGE FOR NOT AT TOP OF STACK + MOVEM D,-2(TP) + MOVEM 0,-1(TP) ; RESTORE HEW ATOM AND DECLS + MOVEM A,(TP) + PUSH TP,B + PUSH TP,C + + PUSHJ P,MAKINF ; MAKE 1ST WORD OF FUNNYS + + HRRZ E,-5(TP) ; RESTORE WORDS OF TUPLE + HRROI B,-5(TP) ; POINT TO TOP OF TUPLE + SUBI B,(E) ; NOW BASE + TLC B,-1(E) ; FIX UP AOBJN PNTR + ADDI E,2 ; COPNESATE FOR FENCE PST + HRLI E,(E) + SUBM TP,E ; E POINT TO BINDING + JRST AUXB4 ; GO CLOBBER IT IN + + +; HERE TO HANDLE SEGMENTS IN THESE FUNNY FORMS + +DTPSEG: PUSH TP,$TFORM ; SAVE THE HACKER + PUSH TP,1(C) + MCALL 1,EVAL ; AND EVALUATE IT + MOVE D,B ; GET READY FOR A SEG LOOP + MOVEM A,DSTORE + PUSHJ P,TYPSEG ; TYPE AND CHECK IT + +DTPSG1: INTGO ; DONT BLOW YOUR STACK + PUSHJ P,NXTLM ; ELEMENT TO A AND B + JRST DTPSG2 ; DONE + PUSHJ P,CNTARG ; PUSH AND COUNT + JRST DTPSG1 + +DTPSG2: SETZM DSTORE + HRRZ E,-1(TP) ; GET COUNT IN CASE END + JRST DOTUP1 ; REST OF ARGS STILL TO DO + +; HERE TO HACK + +DOITUP: HRRZ C,@(TP) ; GET COUNT FILED + JUMPE C,TFA + MOVEM C,(TP) + PUSHJ P,FASTEV ; EVAL IT + GETYP 0,A + CAIE 0,TFIX + JRST WTY1TP + + JUMPL B,BADNUM + + HRRZ C,@(TP) ; GET EXP TO EVAL + MOVEI 0,0 ; DONT LOSE IN 1 ARG CASE + HRRZ 0,(C) ; VERIFY WINNAGE + JUMPN 0,TMA ; TOO MANY + + JUMPE B,DOIDON + PUSH P,B ; SAVE COUNT + PUSH P,B + JUMPE C,DOILOS + PUSHJ P,FASTEV ; EVAL IT ONCE + MOVEM A,-1(TP) + MOVEM B,(TP) + +DOILP: INTGO + PUSH TP,-1(TP) + PUSH TP,-1(TP) + MCALL 1,EVAL + PUSHJ P,CNTRG + SOSLE (P) + JRST DOILP + +DOIDO1: MOVE B,-1(P) ; RESTORE COUNT + SUB P,[2,,2] + +DOIDON: MOVEI E,(B) + JRST ATUPDN + +; FOR CASE OF NO EVALE + +DOILOS: SUB TP,[2,,2] +DOILLP: INTGO + PUSH TP,[0] + PUSH TP,[0] + SOSL (P) + JRST DOILLP + JRST DOIDO1 + +; ROUTINE TO PUSH NEXT TUPLE ELEMENT + +CNTARG: AOS E,-1(TP) ; KEEP ARG COUNT UP TO DATE IN E +CNTRG: EXCH A,-1(TP) ; STORE ELEM AND GET SAVED + EXCH B,(TP) + PUSH TP,A + PUSH TP,B + POPJ P, + + +; DUMMY TUPLE AND ITUPLE + +IMFUNCTION TUPLE,SUBR + + ENTRY + ERRUUO EQUOTE NOT-IN-AUX-LIST + +MFUNCTIO ITUPLE,SUBR + JRST TUPLE + + +; PROCESS A DCL IN THE AUX VAR LISTS + +TRYDCL: SKIPN (P) ; SKIP IF NOT IN AUX'S + JRST AUXB7 + CAME B,AS.AUX ; "AUX" ? + CAMN B,AS.EXT ; OR "EXTRA" + JRST AUXB9 ; YES + CAME B,[ASCII /TUPLE/] + JRST AUXB10 + PUSHJ P,MAKINF ; BUILD EMPTY TUPLE + MOVEI B,1(TP) + PUSH TP,$TINFO ; FENCE POST + PUSHJ P,TBTOTP + PUSH TP,D +AUXB6: HRRZ C,(C) ; CDR PAST DCL + MOVEM C,RE.ARG+1(TB) +AUXB8: PUSHJ P,CARTMC ; GET ATOM +AUXB12: PUSHJ P,PSHBND ; UP GOES THE BINDING + PUSH TP,$TATOM ; HIDE HEWITT ATOM AND DCL + PUSH TP,-1(P) + PUSH TP,$TDECL + PUSH TP,-2(P) + MOVE E,TP + JRST AUXB5 + +; CHECK FOR ARGS + +AUXB10: CAME B,[ASCII /ARGS/] + JRST AUXB7 + MOVEI B,0 ; NULL ARG LIST + MOVSI A,TLIST + JRST AUXB6 ; GO BIND + +AUXB9: SETZM (P) ; NOW READING AUX + HRRZ C,(C) + MOVEM C,RE.ARG+1(TB) + JRST AUXB1 + +; CHECK FOR NAME/ACT + +AUXB7: CAME B,AS.NAM + CAMN B,AS.ACT + JRST .+2 + JRST MPD.12 ; LOSER + HRRZ C,(C) ; CDR ON + HRRZ 0,(C) ; BETTER BE END + JUMPN 0,MPD.13 + PUSHJ P,CARTMC ; FORCE ATOM READ + SETZM RE.ARG+1(TB) +AUXB11: PUSHJ P,MAKACT ; MAKE ACTIVATION + JRST AUXB12 ; AND BIND IT + + +; DONE BIND HEWITT ATOM IF NECESARY + +AUXDON: SKIPN E,-2(P) + JRST AUXD1 + SETZM -2(P) + JRST AUXB11 + +; FINISHED, RETURN + +AUXD1: SUB P,[3,,3] + POPJ P, + + +; MAKE AN ACTIVATION OR ENVIRONMNENT + +MAKACT: MOVEI B,(TB) + MOVSI A,TACT +MAKAC1: MOVE PVP,PVSTOR+1 + HRRI A,PVLNT*2+1(PVP) ; POINT TO PROCESS + HLL B,OTBSAV(B) ; GET TIME + POPJ P, + +MAKENV: MOVSI A,TENV + HRRZ B,OTBSAV(TB) + JRST MAKAC1 + +; SEVERAL USEFUL LITTLE ROUTINES FOR HACKING THIS STUFF + +; CARAT/CARATC/CARATM/CARTMC ALL LOOK FOR THE NEXT ATOM + +CARAT: HRRZ C,E.ARGL+1(TB) ; PICK UP ARGLIST +CARATC: JUMPE C,CPOPJ ; FOUND + GETYP 0,(C) ; GET ITS TYPE + CAIE 0,TATOM +CPOPJ: POPJ P, ; RETURN, NOT ATOM + MOVE E,1(C) ; GET ATOM + HRRZ C,(C) ; CDR DCLS + JRST CPOPJ1 + +CARATM: HRRZ C,E.ARGL+1(TB) +CARTMC: PUSHJ P,CARATC + JRST MPD.7 ; REALLY LOSE + POPJ P, + + +; SUBROUTINES TO PUSH BINDINGS ETC. UP ON THE STACK + +PSBND1: PUSHJ P,PSHBND ; PUSH THEBINDING + JRST CHDCL ; NOW CHECK IT AGAINST DECLARATION + +PSHBND: SKIPGE SPCCHK ; SKIP IF NORMAL SPECIAL + PUSH TP,BNDA1 ; ATOM IN E + SKIPL SPCCHK ; SKIP IF NORMAL UNSPEC OR NO CHECK + PUSH TP,BNDA + PUSH TP,E ; PUSH IT +PSHAB4: PUSH TP,A + PUSH TP,B + PUSH TP,[0] + PUSH TP,[0] + POPJ P, + +; ROUTINE TO PUSH 4 0'S + +PSH4ZR: SETZB A,B + JRST PSHAB4 + + +; EXTRRA ARG GOBBLER + +EXTRGT: HRRZ A,E.ARG(TB) ; RESET SLOT + SETZM E.CNT(TB) + CAIE A,ARGCDR ; IF NOT ARGCDR + AOS E.CNT(TB) + TLO A,400000 ; SET FLAG + MOVEM A,E.ARG+1(TB) + MOVE A,E.EXTR(TB) ; RET ARG + MOVE B,E.EXTR+1(TB) + JRST CPOPJ1 + +; CHECK A/B FOR DEFER + +CHKAB: GETYP 0,A + CAIE 0,TDEFER ; SKIP IF DEFER + JRST (E) + MOVE A,(B) + MOVE B,1(B) ; GET REAL THING + JRST (E) +; IF DECLARATIONS EXIST, DO THEM + +CHDCL: MOVE E,TP +CHDCLE: SKIPN C,E.DECL+1(TB) + POPJ P, + JRST CHKDCL + +; ROUTINE TO READ NEXT THING FROM ARGLIST + +NEXTD: HRRZ C,E.ARGL+1(TB) ; GET ARG LIST +NEXTDC: MOVEI A,0 + JUMPE C,CPOPJ + PUSHJ P,CARATC ; TRY FOR AN ATOM + JRST NEXTD1 ; NO + JRST CPOPJ1 + +NEXTD1: CAIE 0,TFORM ; FORM? + JRST NXT.L ; COULD BE LIST + PUSHJ P,CHQT ; VERIFY 'ATOM + MOVEI A,1 + JRST CPOPJ1 + +NXT.L: CAIE 0,TLIST ; COULD BE (A ) OR ('A ) + JRST NXT.S ; BETTER BE A DCL + PUSHJ P,LNT.2 ; VERIFY LENGTH IS 2 + JRST MPD.8 + CAIE 0,TATOM ; TYPE OF 1ST RET IN 0 + JRST LST.QT ; MAY BE 'ATOM + MOVE E,1(B) ; GET ATOM + MOVEI A,2 + JRST CPOPJ1 +LST.QT: CAIE 0,TFORM ; FORM? + JRST MPD.9 ; LOSE + PUSH P,C + MOVEI C,(B) ; VERIFY 'ATOM + PUSHJ P,CHQT + MOVEI B,(C) ; POINT BACK TO LIST + POP P,C + MOVEI A,3 ; CODE + JRST CPOPJ1 + +NXT.S: MOVEI A,(C) ; LET NXTDCL FIND OUT + PUSHJ P,NXTDCL + JRST MPD.3 ; LOSER + MOVEI A,4 ; SET DCL READ FLAG + JRST CPOPJ1 + +; ROUTINE TO CHECK LENGTH OF LIST/FORM FOR BEING 2 + +LNT.2: HRRZ B,1(C) ; GET LIST/FORM + JUMPE B,CPOPJ + HRRZ B,(B) + JUMPE B,CPOPJ + HRRZ B,(B) ; BETTER END HERE + JUMPN B,CPOPJ + HRRZ B,1(C) ; LIST BACK + GETYP 0,(B) ; TYPE OF 1ST ELEMENT + JRST CPOPJ1 + +; ROUTINE TO VERIFY FORM IS 'ATOM AND RET ATOM + +CHQT: PUSHJ P,LNT.2 ; 1ST LENGTH CHECK + JRST MPD.5 + CAIE 0,TATOM + JRST MPD.5 + MOVE 0,1(B) + CAME 0,IMQUOTE QUOTE + JRST MPD.5 ; BETTER BE QUOTE + HRRZ E,(B) ; CDR + GETYP 0,(E) ; TYPE + CAIE 0,TATOM + JRST MPD.5 + MOVE E,1(E) ; GET QUOTED ATOM + POPJ P, + +; ARG BINDER FOR REGULAR ARGS AND OPTIONALS + +BNDEM1: PUSH P,[0] ; REGULAR FLAG + JRST .+2 +BNDEM2: PUSH P,[1] +BNDEM: PUSHJ P,NEXTD ; GET NEXT THING + JRST CCPOPJ ; END OF THINGS + TRNE A,4 ; CHECK FOR DCL + JRST BNDEM4 + TRNE A,2 ; SKIP IF NOT (ATM ..) OR ('ATM ...) + SKIPE (P) ; SKIP IF REG ARGS + JRST .+2 ; WINNER, GO ON + JRST MPD.6 ; LOSER + SKIPGE SPCCHK + PUSH TP,BNDA1 ; SAVE ATOM + SKIPL SPCCHK + PUSH TP,BNDA + PUSH TP,E +; SKIPGE E.ARG+1(TB) ; ALREADY EVAL'D ARG? + SKIPE E.CNT(TB) + JRST RGLAR0 + TRNN A,1 ; SKIP IF ARG QUOTED + JRST RGLARG + HRRZ D,@E.FRM+1(TB) ; GET AND CDR ARG + JUMPE D,TFACHK ; OH OH MAYBE TOO FEW ARGS + MOVEM D,E.FRM+1(TB) ; STORE WINNER + HLLZ A,(D) ; GET ARG + MOVE B,1(D) + JSP E,CHKAB ; HACK DEFER + JRST BNDEM3 ; AND GO ON + +RGLAR0: TRNE A,1 ; ATTEMPT TO QUOTE ALREADY EVAL'D ARG ? + JRST MPD ; YES, LOSE +RGLARG: PUSH P,A ; SAVE FLAGS + PUSHJ P,@E.ARG+1(TB) + JRST TFACH1 ; MAY GE TOO FEW + SUB P,[1,,1] +BNDEM3: HRRZ C,@E.ARGL+1(TB) ; CDR THHE ARGS + MOVEM C,E.ARGL+1(TB) + PUSHJ P,PSHAB4 ; PUSH VALUE AND SLOTS + PUSHJ P,CHDCL ; CHECK DCLS + JRST BNDEM ; AND BIND ON! + +; HERE WHEN ARGS RUN OUT, IF NOT OPTIONAL, GIVE TFA + +TFACH1: POP P,A +TFACHK: SUB TP,[2,,2] ; FLUSH ATOM + SKIPN (P) ; SKIP IF OPTIONALS + JRST TFA +CCPOPJ: SUB P,[1,,1] + POPJ P, + +BNDEM4: HRRZ C,@E.ARGL+1(TB) ; POINT TO REST OF ARGL + JRST CCPOPJ + + +; EVALUATE LISTS, VECTORS, UNIFROM VECTORS + +EVLIST: PUSH P,[-1] ;-1 -- THIS IS A LIST + JRST EVL1 ;GO TO HACKER + +EVECT: PUSH P,[0] ;0 -- THIS IS A GENERAL VECTOR + JRST EVL1 + +EUVEC: PUSH P,[1] ;1 -- THIS IS A UNIFORM VECTOR + +EVL1: PUSH P,[0] ;PUSH A COUNTER + GETYPF A,(AB) ;GET FULL TYPE + PUSH TP,A + PUSH TP,1(AB) ;AND VALUE + +EVL2: INTGO ;CHECK INTERRUPTS + SKIPN A,1(TB) ;ANYMORE + JRST EVL3 ;NO, QUIT + SKIPL -1(P) ;SKIP IF LIST + JUMPG A,EVL3 ;JUMP IF VECTOR EMPTY + GETYPF B,(A) ;GET FULL TYPE + SKIPGE C,-1(P) ;SKIP IF NOT LIST + HLLZS B ;CLOBBER CDR FIELD + JUMPG C,EVL7 ;HACK UNIFORM VECS +EVL8: PUSH P,B ;SAVE TYPE WORD ON P + CAMN B,$TSEG ;SEGMENT? + MOVSI B,TFORM ;FAKE OUT EVAL + PUSH TP,B ;PUSH TYPE + PUSH TP,1(A) ;AND VALUE + JSP E,CHKARG ; CHECK DEFER + MCALL 1,EVAL ;AND EVAL IT + POP P,C ;AND RESTORE REAL TYPE + CAMN C,$TSEG ;SEGMENT? + JRST DOSEG ;YES, HACK IT + AOS (P) ;COUNT ELEMENT + PUSH TP,A ;AND PUSH IT + PUSH TP,B +EVL6: SKIPGE A,-1(P) ;DONT SKIP IF LIST + HRRZ B,@1(TB) ;CDR IT + JUMPL A,ASTOTB ;AND STORE IT + MOVE B,1(TB) ;GET VECTOR POINTER + ADD B,AMNT(A) ;INCR BY APPROPRIATE AMOUNT +ASTOTB: MOVEM B,1(TB) ;AND STORE BACK + JRST EVL2 ;AND LOOP BACK + +AMNT: 2,,2 ;INCR FOR GENERAL VECTOR + 1,,1 ;SAME FOR UNIFORM VECTOR + +CHKARG: GETYP A,-1(TP) + CAIE A,TDEFER + JRST (E) + HRRZS (TP) ;MAKE SURE INDIRECT WINS + MOVE A,@(TP) + MOVEM A,-1(TP) ;CLOBBER IN TYPE SLOT + MOVE A,(TP) ;NOW GET POINTER + MOVE A,1(A) ;GET VALUE + MOVEM A,(TP) ;CLOBBER IN + JRST (E) + + + +EVL7: HLRE C,A ; FIND TYPE OF UVECTOR + SUBM A,C ;C POINTS TO DOPE WORD + GETYP B,(C) ;GET TYPE + MOVSI B,(B) ;TO LH NOW + SOJA A,EVL8 ;AND RETURN TO DO EVAL + +EVL3: SKIPL -1(P) ;SKIP IF LIST + JRST EVL4 ;EITHER VECTOR OR UVECTOR + + MOVEI B,0 ;GET A NIL +EVL9: MOVSI A,TLIST ;MAKE TYPE WIN +EVL5: SOSGE (P) ;COUNT DOWN + JRST EVL10 ;DONE, RETURN + PUSH TP,$TLIST ;SET TO CALL CONS + PUSH TP,B + MCALL 2,CONS + JRST EVL5 ;LOOP TIL DONE + + +EVL4: MOVEI B,EUVECT ;UNIFORM CASE + SKIPG -1(P) ;SKIP IF UNIFORM CASE + MOVEI B,EVECTO ;NO, GENERAL CASE + POP P,A ;GET COUNT + .ACALL A,(B) ;CALL CREATOR +EVL10: GETYPF A,(AB) ; USE SENT TYPE + JRST EFINIS + + +; PROCESS SEGMENTS FOR THESE HACKS + +DOSEG: PUSHJ P,TYPSEG ; FIND WHAT IS BEING SEGMENTED + JUMPE C,LSTSEG ; CHECK END SPLICE IF LIST + +SEG3: PUSHJ P,NXTELM ; GET THE NEXTE ELEMT + JRST SEG4 ; RETURN TO CALLER + AOS (P) ; COUNT + JRST SEG3 ; TRY AGAIN +SEG4: SETZM DSTORE + JRST EVL6 + +TYPSEG: PUSHJ P,TYPSGR + JRST ILLSEG + POPJ P, + +TYPSGR: MOVE E,A ; SAVE TYPE + GETYP A,A ; TYPE TO RH + PUSHJ P,SAT ;GET STORAGE TYPE + MOVE D,B ; GOODIE TO D + + MOVNI C,1 ; C <0 IF ILLEGAL + CAIN A,S2WORD ;LIST? + MOVEI C,0 + CAIN A,S2NWORD ;GENERAL VECTOR? + MOVEI C,1 + CAIN A,SNWORD ;UNIFORM VECTOR? + MOVEI C,2 + CAIN A,SCHSTR + MOVEI C,3 + CAIN A,SBYTE + MOVEI C,5 + CAIN A,SSTORE ;SPECIAL AFREE STORAGE ? + MOVEI C,4 ;TREAT LIKE A UVECTOR + CAIN A,SARGS ;ARGS TUPLE? + JRST SEGARG ;NO, ERROR + CAILE A,NUMSAT ; SKIP IF NOT TEMPLATE + JRST SEGTMP + MOVE A,PTYPS(C) + CAIN A,4 + MOVEI A,2 ; NOW TREAT LIKE A UVECTOR + HLL E,A +MSTOR1: JUMPL C,CPOPJ + +MDSTOR: MOVEM E,DSTORE + JRST CPOPJ1 + +SEGTMP: MOVEI C,4 + HRRI E,(A) + JRST MSTOR1 + +SEGARG: MOVSI A,TARGS + HRRI A,(E) + PUSH TP,A ;PREPARE TO CHECK ARGS + PUSH TP,D + MOVEI B,-1(TP) ;POINT TO SAVED COPY + PUSHJ P,CHARGS ;CHECK ARG POINTER + POP TP,D ;AND RESTORE WINNER + POP TP,E ;AND TYPE AND FALL INTO VECTOR CODE + MOVEI C,1 + JRST MSTOR1 + +LSTSEG: SKIPL -1(P) ;SKIP IF IN A LIST + JRST SEG3 ;ELSE JOIN COMMON CODE + HRRZ A,@1(TB) ;CHECK FOR END OF LIST + JUMPN A,SEG3 ;NO, JOIN COMMON CODE + SETZM DSTORE ;CLOBBER SAVED GOODIES + JRST EVL9 ;AND FINISH UP + +NXTELM: INTGO + PUSHJ P,NXTLM ; GOODIE TO A AND B + POPJ P, ; DONE + PUSH TP,A + PUSH TP,B + JRST CPOPJ1 +NXTLM: XCT TESTR(C) ; SKIP IF MORE IN SEGEMNT + POPJ P, + XCT TYPG(C) ; GET THE TYPE + XCT VALG(C) ; AND VALUE + JSP E,CHKAB ; CHECK DEFERRED + XCT INCR1(C) ; AND INCREMENT TO NEXT +CPOPJ1: AOS (P) ; SKIP RETURN + POPJ P, + +; TABLES FOR SEGMENT OPERATIONS (0->LIST, 1->VECTOR/ARGS, 2->UVEC, 3->STRING) + +PTYPS: TLIST,, + TVEC,, + TUVEC,, + TCHSTR,, + TSTORA,, + TBYTE,, + +TESTR: SKIPN D + SKIPL D + SKIPL D + PUSHJ P,CHRDON + PUSHJ P,TM1 + PUSHJ P,CHRDON + +TYPG: PUSHJ P,LISTYP + GETYPF A,(D) + PUSHJ P,UTYPE + MOVSI A,TCHRS + PUSHJ P,TM2 + MOVSI A,TFIX + +VALG: MOVE B,1(D) + MOVE B,1(D) + MOVE B,(D) + PUSHJ P,1CHGT + PUSHJ P,TM3 + PUSHJ P,1CHGT + +INCR1: HRRZ D,(D) + ADD D,[2,,2] + ADD D,[1,,1] + PUSHJ P,1CHINC + ADD D,[1,,] + PUSHJ P,1CHINC + +TM1: HRRZ A,DSTORE + SKIPE DSTORE + HRRZ A,DSTORE ; GET SAT + SUBI A,NUMSAT+1 + ADD A,TD.LNT+1 + EXCH C,D + XCT (A) + HLRZ 0,C ; GET AMNT RESTED + SUB B,0 + EXCH C,D + TRNE B,-1 + AOS (P) + POPJ P, + +TM3: +TM2: HRRZ 0,DSTORE + SKIPE DSTORE + HRRZ 0,DSTORE + PUSH P,C + PUSH P,D + PUSH P,E + MOVE B,D + MOVEI C,0 ; GET "1ST ELEMENT" + PUSHJ P,TMPLNT ; GET NTH IN A AND B + POP P,E + POP P,D + POP P,C + POPJ P, + +CHRDON: HRRZ B,DSTORE + SKIPE DSTORE + HRRZ B,DSTORE ; POIT TO DOPE WORD + JUMPE B,CHRFIN + AOS (P) +CHRFIN: POPJ P, + +LISTYP: GETYP A,(D) + MOVSI A,(A) + POPJ P, +1CHGT: MOVE B,D + ILDB B,B + POPJ P, + +1CHINC: IBP D + SKIPN DSTORE + JRST 1CHIN1 + SOS DSTORE + POPJ P, + +1CHIN1: SOS DSTORE + POPJ P, + +UTYPE: HLRE A,D + SUBM D,A + GETYP A,(A) + MOVSI A,(A) + POPJ P, + + +;COMPILER's CALL TO DOSEG +SEGMNT: PUSHJ P,TYPSEG +SEGLP1: SETZB A,B +SEGLOP: PUSHJ P,NXTELM + JRST SEGRET + AOS (P)-2 ; INCREMENT COMPILER'S COUNT + JRST SEGLOP + +SEGRET: SETZM DSTORE + POPJ P, + +SEGLST: PUSHJ P,TYPSEG + JUMPN C,SEGLS2 +SEGLS3: SETZM DSTORE + MOVSI A,TLIST +SEGLS1: SOSGE -2(P) ; START COUNT DOWN + POPJ P, + MOVEI E,(B) + POP TP,D + POP TP,C + PUSHJ P,ICONS + JRST SEGLS1 + +SEGLS2: PUSHJ P,NXTELM + JRST SEGLS4 + AOS -2(P) + JRST SEGLS2 + +SEGLS4: MOVEI B,0 + JRST SEGLS3 + + +;SPECBIND BINDS IDENTIFIERS. IT IS CALLED BY PUSHJ P,SPECBIND. +;SPECBIND IS PROVIDED WITH A CONTIGUOUS SET OF TRIPLETS ON TP. +;EACH TRIPLET IS AS FOLLOWS: +;THE FIRST ELEMENT IS THE IDENTIFIER TO BE BOUND, ITS TYPE WORD IS [TATOM,,-1], +;THE SECOND IS THE VALUE TO WHICH IT IS TO BE ASSIGNED, +;AND THE THIRD IS A PAIR OF ZEROES. + +BNDA1: TATOM,,-2 +BNDA: TATOM,,-1 +BNDV: TVEC,,-1 + +USPECBIND: + MOVE E,TP +USPCBE: PUSH P,$TUBIND + JRST .+3 + +SPECBIND: + MOVE E,TP ;GET THE POINTER TO TOP +SPECBE: PUSH P,$TBIND + ADD E,[1,,1] ;BUMP POINTER ONCE + SETZB 0,D ;CLEAR TEMPS + PUSH P,0 + MOVEI 0,(TB) ; FOR CHECKS + +BINDLP: MOVE A,-4(E) ; CHECK FOR VEC BIND + CAMN A,BNDV + JRST NONID + MOVE A,-6(E) ;GET TYPE + CAME A,BNDA1 ; FOR UNSPECIAL + CAMN A,BNDA ;NORMAL ID BIND? + CAILE 0,-6(E) ; MAKE SURE NOT GOING UNDER FRAME + JRST SPECBD + SUB E,[6,,6] ;MOVE PTR + SKIPE D ;LINK? + HRRM E,(D) ;YES -- LOBBER + SKIPN (P) ;UPDATED? + MOVEM E,(P) ;NO -- DO IT + + MOVE A,0(E) ;GET ATOM PTR + MOVE B,1(E) + PUSHJ P,SILOC ;GET LAST BINDING + MOVS A,OTBSAV (TB) ;GET TIME + HRL A,5(E) ; GET DECL POINTER + MOVEM A,4(E) ;CLOBBER IT AWAY + MOVE A,(E) ; SEE IF SPEC/UNSPEC + TRNN A,1 ; SKIP, ALWAYS SPEC + SKIPA A,-1(P) ; USE SUPPLIED + MOVSI A,TBIND + MOVEM A,(E) ;IDENTIFY AS BIND BLOCK + JUMPE B,SPEB10 + MOVE PVP,PVSTOR+1 + HRRZ C,SPBASE(PVP) ; CHECK FOR CROSS OF PROC + MOVEI A,(TP) + CAIL A,(B) ; LOSER + CAILE C,(B) ; SKIP IFF WINNER + MOVEI B,1 +SPEB10: MOVEM B,5(E) ;IN RESTORE CELLS + + MOVE C,1(E) ;GET ATOM PTR + SKIPE (C) + JUMPE B,.-4 + MOVEI A,(C) + MOVEI B,0 ; FOR SPCUNP + CAIL A,HIBOT ; SKIP IF IMPURE ATOM + PUSHJ P,SPCUNP + MOVE PVP,PVSTOR+1 + HRRZ A,BINDID+1(PVP) ;GET PROCESS NUMBER + HRLI A,TLOCI ;MAKE LOC PTR + MOVE B,E ;TO NEW VALUE + ADD B,[2,,2] + MOVEM A,(C) ;CLOBBER ITS VALUE + MOVEM B,1(C) ;CELL + MOVE D,E ;REMEMBER LINK + JRST BINDLP ;DO NEXT + +NONID: CAILE 0,-4(E) + JRST SPECBD + SUB E,[4,,4] + SKIPE D + HRRM E,(D) + SKIPN (P) + MOVEM E,(P) + + MOVE D,1(E) ;GET PTR TO VECTOR + MOVE C,(D) ;EXCHANGE TYPES + EXCH C,2(E) + MOVEM C,(D) + + MOVE C,1(D) ;EXCHANGE DATUMS + EXCH C,3(E) + MOVEM C,1(D) + + MOVEI A,TBVL + HRLM A,(E) ;IDENTIFY BIND BLOCK + MOVE D,E ;REMEMBER LINK + JRST BINDLP + +SPECBD: SKIPE D + MOVE SP,SPSTOR+1 + HRRM SP,(D) + SKIPE D,(P) + MOVEM D,SPSTOR+1 + SUB P,[2,,2] + POPJ P, + + +; HERE TO IMPURIFY THE ATOM + +SPCUNP: PUSH TP,$TSP + PUSH TP,E + PUSH TP,$TSP + PUSH TP,-1(P) ; LINK BACK IS AN SP + PUSH TP,$TSP + PUSH TP,B + CAIN B,1 + SETZM -1(TP) ; FIXUP SOME FUNNYNESS + MOVE B,C + PUSHJ P,IMPURIFY + MOVE 0,-2(TP) ; RESTORE LINK BACK POINTER + MOVEM 0,-1(P) + MOVE E,-4(TP) + MOVE C,B + MOVE B,(TP) + SUB TP,[6,,6] + MOVEI 0,(TB) + POPJ P, + +; ENTRY FROM COMPILER TO SET UP A BINDING + +IBIND: MOVE SP,SPSTOR+1 + SUBI E,-5(SP) ; CHANGE TO PDL POINTER + HRLI E,(E) + ADD E,SP + MOVEM C,-4(E) + MOVEM A,-3(E) + MOVEM B,-2(E) + HRLOI A,TATOM + MOVEM A,-5(E) + MOVSI A,TLIST + MOVEM A,-1(E) + MOVEM D,(E) + JRST SPECB1 ; NOW BIND IT + +; "FAST CALL TO SPECBIND" + + + +; Compiler's call to SPECBIND all atom bindings, no TBVLs etc. + +SPECBND: + MOVE E,TP ; POINT TO BINDING WITH E +SPECB1: PUSH P,[0] ; SLOTS OF INTEREST + PUSH P,[0] + SUBM M,-2(P) + +SPECB2: MOVEI 0,(TB) ; FOR FRAME CHECK + MOVE A,-5(E) ; LOOK AT FIRST THING + CAMN A,BNDA ; SKIP IF LOSER + CAILE 0,-5(E) ; SKIP IF REAL WINNER + JRST SPECB3 + + SUB E,[5,,5] ; POINT TO BINDING + SKIPE A,(P) ; LINK? + HRRM E,(A) ; YES DO IT + SKIPN -1(P) ; FIRST ONE? + MOVEM E,-1(P) ; THIS IS IT + + MOVE A,1(E) ; POINT TO ATOM + MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; QUICK CHECK + HRLI 0,TLOCI + CAMN 0,(A) ; WINNERE? + JRST SPECB4 ; YES, GO ON + + PUSH P,B ; SAVE REST OF ACS + PUSH P,C + PUSH P,D + MOVE B,A ; FOR ILOC TO WORK + PUSHJ P,SILOC ; GO LOOK IT UP + JUMPE B,SPECB9 + MOVE PVP,PVSTOR+1 + HRRZ C,SPBASE+1(PVP) + MOVEI A,(TP) + CAIL A,(B) ; SKIP IF LOSER + CAILE C,(B) ; SKIP IF WINNER + MOVEI B,1 ; SAY NO BACK POINTER +SPECB9: MOVE C,1(E) ; POINT TO ATOM + SKIPE (C) ; IF GLOBALLY BOUND, MAKE SURE OK + JUMPE B,.-3 + MOVEI A,(C) ; PURE ATOM? + CAIGE A,HIBOT ; SKIP IF OK + JRST .+4 + PUSH P,-4(P) ; MAKE HAPPINESS + PUSHJ P,SPCUNP ; IMPURIFY + POP P,-5(P) + MOVE PVP,PVSTOR+1 + MOVE A,BINDID+1(PVP) + HRLI A,TLOCI + MOVEM A,(C) ; STOR POINTER INDICATOR + MOVE A,B + POP P,D + POP P,C + POP P,B + JRST SPECB5 + +SPECB4: MOVE A,1(A) ; GET LOCATIVE +SPECB5: EXCH A,5(E) ; CLOBBER INTO REBIND SLOT (GET DECL) + HLL A,OTBSAV(TB) ; TIME IT + MOVSM A,4(E) ; SAVE DECL AND TIME + MOVEI A,TBIND + HRLM A,(E) ; CHANGE TO A BINDING + MOVE A,1(E) ; POINT TO ATOM + MOVEM E,(P) ; REMEMBER THIS GUY + ADD E,[2,,2] ; POINT TO VAL CELL + MOVEM E,1(A) ; INTO ATOM SLOT + SUB E,[3,,3] ; POINT TO NEXT ONE + JRST SPECB2 + +SPECB3: SKIPE A,(P) + MOVE SP,SPSTOR+1 + HRRM SP,(A) ; LINK OLD STUFF + SKIPE A,-1(P) ; NEW SP? + MOVEM A,SPSTOR+1 + SUB P,[2,,2] + INTGO ; IN CASE BLEW STACK + SUBM M,(P) + POPJ P, + + +;SPECSTORE RESTORES THE BINDINGS SP TO THE ENVIRONMENT POINTER IN +;SPSAV (TB). IT IS CALLED BY PUSHJ P,SPECSTORE. + +SPECSTORE: + PUSH P,E + HRRZ E,SPSAV (TB) ;GET TARGET POINTER + PUSHJ P,STLOOP + POP P,E + MOVE SP,SPSAV(TB) ; GET NEW SP + MOVEM SP,SPSTOR+1 + POPJ P, + +STLOOP: MOVE SP,SPSTOR+1 + PUSH P,D + PUSH P,C + +STLOO1: CAIL E,(SP) ;ARE WE DONE? + JRST STLOO2 + HLRZ C,(SP) ;GET TYPE OF BIND + CAIN C,TUBIND + JRST .+3 + CAIE C,TBIND ;NORMAL IDENTIFIER? + JRST ISTORE ;NO -- SPECIAL HACK + + + MOVE C,1(SP) ;GET TOP ATOM + MOVSI 0,TLOCI ; MAYBE LOCI OR UNBOUND + SKIPL D,5(SP) + MOVSI 0,TUNBOU + MOVE PVP,PVSTOR+1 + HRR 0,BINDID+1(PVP) ;STORE SIGNATURE + SKIPN 5(SP) + MOVEI 0,0 ; TOTALLY UNBOUND IN ALL CASES + MOVEM 0,(C) ;CLOBBER INTO ATOM + MOVEM D,1(C) + SETZM 4(SP) +SPLP: HRRZ SP,(SP) ;FOLOW LINK + JUMPN SP,STLOO1 ;IF MORE + SKIPE E ; OK IF E=0 + FATAL SP OVERPOP +STLOO2: MOVEM SP,SPSTOR+1 + POP P,C + POP P,D + POPJ P, + +ISTORE: CAIE C,TBVL + JRST CHSKIP + MOVE C,1(SP) + MOVE D,2(SP) + MOVEM D,(C) + MOVE D,3(SP) + MOVEM D,1(C) + JRST SPLP + +CHSKIP: CAIN C,TSKIP + JRST SPLP + CAIE C,TUNWIN ; UNWIND HACK + FATAL BAD SP + HRRZ C,-2(P) ; WHERE FROM? + CAIE C,CHUNPC + JRST SPLP ; IGNORE + MOVEI E,(TP) ; FIXUP SP + SUBI E,(SP) + MOVSI E,(E) + HLL SP,TP + SUB SP,E + POP P,C + POP P,D + AOS (P) + POPJ P, + +; ENTRY FOR FUNNY COMPILER UNBIND (1) + +SSPECS: PUSH P,E + PUSH P,PVP + PUSH P,SP + MOVEI E,(TP) + PUSHJ P,STLOOP +SSPEC2: SUBI E,(SP) ; MAKE SP BE AOBJN + MOVSI E,(E) + HLL SP,TP + SUB SP,E + MOVEM SP,SPSTOR+1 + POP P,SP + POP P,PVP + POP P,E + POPJ P, + +; ENTRY FOR FUNNY COMPILER UNBIND (2) + +SSPEC1: PUSH P,E + PUSH P,PVP + PUSH P,SP + SUBI E,1 ; MAKE SURE GET CURRENT BINDING + PUSHJ P,STLOOP ; UNBIND + MOVEI E,(TP) ; NOW RESET SP + JRST SSPEC2 + +EFINIS: MOVE PVP,PVSTOR+1 + SKIPN C,1STEPR+1(PVP) ; SKIP NIF BEING ONE PROCEEDED + JRST FINIS + PUSH TP,$TATOM + PUSH TP,MQUOTE EVLOUT + PUSH TP,A ;SAVE EVAL RESULTS + PUSH TP,B + PUSH TP,[TINFO,,2] ; FENCE POST + PUSHJ P,TBTOTP + PUSH TP,D + PUSHJ P,MAKINF ; MAKE ARG BLOCK INFO + PUSH TP,A + MOVEI B,-6(TP) + HRLI B,-4 ; AOBJN TO ARGS BLOCK + PUSH TP,B + MOVE PVP,PVSTOR+1 + PUSH TP,1STEPR(PVP) + PUSH TP,1STEPR+1(PVP) ; PROCESS DOING THE 1STEPPING + MCALL 2,RESUME + MOVE A,-3(TP) ; GET BACK EVAL VALUE + MOVE B,-2(TP) + JRST FINIS + +1STEPI: PUSH TP,$TATOM + PUSH TP,MQUOTE EVLIN + PUSH TP,$TAB ; PUSH EVALS ARGGS + PUSH TP,AB + PUSHJ P,MAKINF ; TURN INTO ARGS BLOCK + MOVEM A,-1(TP) ; AND CLOBBER + PUSH TP,[TINFO,,2] ; FENCE POST 2D TUPLE + PUSHJ P,TBTOTP + PUSH TP,D + PUSHJ P,MAKINF ; TURN IT INTO ARGS BLOCK + PUSH TP,A + MOVEI B,-6(TP) ; SETUP TUPLE + HRLI B,-4 + PUSH TP,B + MOVE PVP,PVSTOR+1 + PUSH TP,1STEPR(PVP) + PUSH TP,1STEPR+1(PVP) + MCALL 2,RESUME ; START UP 1STEPERR + SUB TP,[6,,6] ; REMOVE CRUD + GETYP A,A ; GET 1STEPPERS TYPE + CAIE A,TDISMI ; IF DISMISS, STOP 1 STEPPING + JRST EVALON + +; HERE TO PUSH DOWN THE 1 STEP STATE AND RUN + + MOVE D,PVP + ADD D,[1STEPR,,1STEPR] ; POINT TO 1 STEP SLOT + PUSH TP,$TSP ; SAVE CURRENT SP + PUSH TP,SPSTOR+1 + PUSH TP,BNDV + PUSH TP,D ; BIND IT + PUSH TP,$TPVP + PUSH TP,[0] ; NO 1 STEPPER UNTIL POPJ + PUSHJ P,SPECBIND + +; NOW PUSH THE ARGS UP TO RE-CALL EVAL + + MOVEI A,0 +EFARGL: JUMPGE AB,EFCALL + PUSH TP,(AB) + PUSH TP,1(AB) + ADD AB,[2,,2] + AOJA A,EFARGL + +EFCALL: ACALL A,EVAL ; NOW DO THE EVAL + MOVE C,(TP) ; PRE-UNBIND + MOVE PVP,PVSTOR+1 + MOVEM C,1STEPR+1(PVP) + MOVE SP,-4(TP) ; AVOID THE UNBIND + MOVEM SP,SPSTOR+1 + SUB TP,[6,,6] ; AND FLUSH LOSERS + JRST EFINIS ; AND TRY TO FINISH UP + +MAKINF: HLRZ A,OTBSAV(TB) ; TIME IT + HRLI A,TARGS + POPJ P, + + +TBTOTP: MOVEI D,(TB) ; COMPUTE REL DIST FROM TP TO TB + SUBI D,(TP) + POPJ P, +; ARRIVE HERE TO COMPLETE A COMPILER GENERATED TUPLE +; D/ LENGTH OF THE TUPLE IN WORDS + +MAKTU2: MOVE D,-1(P) ; GET LENGTH + ASH D,1 + PUSHJ P,MAKTUP + PUSH TP,A + PUSH TP,B + POPJ P, + +MAKTUP: HRLI D,TINFO ; FIRST WORD OF FENCE POST + PUSH TP,D + HRROI B,(TP) ; TOP OF TUPLE + SUBI B,(D) + TLC B,-1(D) ; AOBJN IT + PUSHJ P,TBTOTP + PUSH TP,D + HLRZ A,OTBSAV(TB) ; TIME IT + HRLI A,TARGS + POPJ P, + +; HERE TO ALLOCATE SLOTS FOR COMPILER (AMNT IN A) + +TPALOC: SUBM M,(P) + ;Once here ==>ADDI A,1 Bug??? + HRLI A,(A) + ADD TP,A + PUSH P,A + SKIPL TP + PUSHJ P,TPOVFL ; IN CASE IT LOST + INTGO ; TAKE THE GC IF NEC + HRRI A,2(TP) + SUB A,(P) + SETZM -1(A) + HRLI A,-1(A) + BLT A,(TP) + SUB P,[1,,1] + JRST POPJM + + +NTPALO: PUSH TP,[0] + SOJG 0,.-1 + POPJ P, + + ;EVALUATES A IDENTIFIER -- GETS LOCAL VALUE IF THERE IS ONE, OTHERWISE GLOBAL. + +IMFUNCTION VALUE,SUBR + JSP E,CHKAT + PUSHJ P,IDVAL + JRST FINIS + +IDVAL: PUSHJ P,IDVAL1 + CAMN A,$TUNBOU + JRST UNBOU + POPJ P, + +IDVAL1: PUSH TP,A + PUSH TP,B ;SAVE ARG IN CASE NEED TO CHECK GLOBAL VALUE + PUSHJ P,ILVAL ;LOCAL VALUE FINDER + CAME A,$TUNBOUND ;IF NOT UNBOUND OR UNASSIGNED + JRST RIDVAL ;DONE - CLEAN UP AND RETURN + POP TP,B ;GET ARG BACK + POP TP,A + JRST IGVAL +RIDVAL: SUB TP,[2,,2] + POPJ P, + +;GETS THE LOCAL VALUE OF AN IDENTIFIER + +IMFUNCTION LVAL,SUBR + JSP E,CHKAT + PUSHJ P,AILVAL + CAME A,$TUNBOUND + JRST FINIS + JUMPN B,UNAS + JRST UNBOU + +; MAKE AN ATOM UNASSIGNED + +MFUNCTION UNASSIGN,SUBR + JSP E,CHKAT ; GET ATOM ARG + PUSHJ P,AILOC +UNASIT: CAMN A,$TUNBOU ; IF UNBOUND + JRST RETATM + MOVSI A,TUNBOU + MOVEM A,(B) + SETOM 1(B) ; MAKE SURE +RETATM: MOVE B,1(AB) + MOVE A,(AB) + JRST FINIS + +; UNASSIGN GLOBALLY + +MFUNCTION GUNASSIGN,SUBR + JSP E,CHKAT2 + PUSHJ P,IGLOC + CAMN A,$TUNBOU + JRST RETATM + MOVE B,1(AB) ; ATOM BACK + MOVEI 0,(B) + CAIL 0,HIBOT ; SKIP IF IMPURE + PUSHJ P,IMPURIFY ; YES, MAKE IT IMPURE + PUSHJ P,IGLOC ; RESTORE LOCATIVE + HRRZ 0,-2(B) ; SEE IF MANIFEST + GETYP A,(B) ; AND CURRENT TYPE + CAIN 0,-1 + CAIN A,TUNBOU + JRST UNASIT + SKIPE IGDECL + JRST UNASIT + MOVE D,B + JRST MANILO + +; GETS A LOCATIVE TO THE LOCAL VALUE OF AN IDENTIFIER. + +MFUNCTION LLOC,SUBR + JSP E,CHKAT + PUSHJ P,AILOC + CAMN A,$TUNBOUND + JRST UNBOU + MOVSI A,TLOCD + HRR A,2(B) + JRST FINIS + +;TESTS TO SEE IF AN IDENTIFIER IS LOCALLY BOUND + +MFUNCTION BOUND,SUBR,[BOUND?] + JSP E,CHKAT + PUSHJ P,AILVAL + CAMN A,$TUNBOUND + JUMPE B,IFALSE + JRST TRUTH + +;TESTS TO SEE IF AN IDENTIFIER IS LOCALLY ASSIGNED + +MFUNCTION ASSIGP,SUBR,[ASSIGNED?] + JSP E,CHKAT + PUSHJ P,AILVAL + CAME A,$TUNBOUND + JRST TRUTH +; JUMPE B,UNBOU + JRST IFALSE + +;GETS THE GLOBAL VALUE OF AN IDENTIFIER + +IMFUNCTION GVAL,SUBR + JSP E,CHKAT2 + PUSHJ P,IGVAL + CAMN A,$TUNBOUND + JRST UNAS + JRST FINIS + +;GETS A LOCATIVE TO THE GLOBAL VALUE OF AN IDENTIFIER + +MFUNCTION RGLOC,SUBR + + JRST GLOC + +MFUNCTION GLOC,SUBR + + JUMPGE AB,TFA + CAMGE AB,[-5,,] + JRST TMA + JSP E,CHKAT1 + MOVEI E,IGLOC + CAML AB,[-2,,] + JRST .+4 + GETYP 0,2(AB) + CAIE 0,TFALSE + MOVEI E,IIGLOC + PUSHJ P,(E) + CAMN A,$TUNBOUND + JRST UNAS + MOVSI A,TLOCD + HRRZ 0,FSAV(TB) + CAIE 0,GLOC + MOVSI A,TLOCR + CAIE 0,GLOC + SUB B,GLOTOP+1 + MOVE C,1(AB) ; GE ATOM + MOVEI 0,(C) + CAIGE 0,HIBOT ; SKIP IF PURE ATOM + JRST FINIS + +; MAKE ATOM AND VALUE IMPURE IF GETTING GLOC TO IT + + MOVE B,C ; ATOM TO B + PUSHJ P,IMPURIFY + JRST GLOC ; AND TRY AGAIN + +;TESTS TO SEE IF AN IDENTIFIER IS GLOBALLY ASSIGNED + +MFUNCTION GASSIG,SUBR,[GASSIGNED?] + JSP E,CHKAT2 + PUSHJ P,IGVAL + CAMN A,$TUNBOUND + JRST IFALSE + JRST TRUTH + +; TEST FOR GLOBALLY BOUND + +MFUNCTION GBOUND,SUBR,[GBOUND?] + + JSP E,CHKAT2 + PUSHJ P,IGLOC + JUMPE B,IFALSE + JRST TRUTH + + + +CHKAT2: ENTRY 1 +CHKAT1: GETYP A,(AB) + MOVSI A,(A) + CAME A,$TATOM + JRST NONATM + MOVE B,1(AB) + JRST (E) + +CHKAT: HLRE A,AB ; - # OF ARGS + ASH A,-1 ; TO ACTUAL WORDS + JUMPGE AB,TFA + MOVE C,SPSTOR+1 ; FOR BINDING LOOKUPS + AOJE A,CHKAT1 ; ONLY ONE ARG, NO ENVIRONMENT + AOJL A,TMA ; TOO MANY + GETYP A,2(AB) ; MAKE SURE OF TENV OR TFRAME + CAIE A,TFRAME + CAIN A,TENV + JRST CHKAT3 + CAIN A,TACT ; FOR PFISTERS LOSSAGE + JRST CHKAT3 + CAIE A,TPVP ; OR PROCESS + JRST WTYP2 + MOVE B,3(AB) ; GET PROCESS + MOVE C,SPSTOR+1 ; IN CASE ITS ME + CAME B,PVSTOR+1 ; SKIP IF DIFFERENT + MOVE C,SPSTO+1(B) ; GET ITS SP + JRST CHKAT1 +CHKAT3: MOVEI B,2(AB) ; POINT TO FRAME POINTER + PUSHJ P,CHFRM ; VALIDITY CHECK + MOVE B,3(AB) ; GET TB FROM FRAME + MOVE C,SPSAV(B) ; GET ENVIRONMENT POINTER + JRST CHKAT1 + + +; SILOC--CALLS ILOC IGNORING SPECIAL CHECKING + +SILOC: JFCL + +;ILOC RETURNS IN A AND B A LOCATIVE TO THE LOCAL VALUE OF THE IDENTIFIER +; PASSED TO IT IN A AND B. IF THE IDENTIFIER IS LOCALLY UNBOUND IT RETURNS +; $TUNBOUND IN A AND 0 IN B, IT IS CALLED BY PUSHJ P,ILOC. + +ILOC: MOVE C,SPSTOR+1 ; SETUP SEARCH START +AILOC: SKIPN (B) ; ANY KIND OF VALUE AT ALL? + JUMPN B,FUNPJ + MOVSI A,TLOCI ;MAKE A LOCATIVE TYPE CELL + PUSH P,E + PUSH P,D + MOVEI E,0 ; FLAG TO CLOBBER ATOM + JUMPE B,SCHSP ; IF LOOKING FOR SLOT, SEARCH NOW + CAME C,SPSTOR+1 ; ENVIRONMENT CHANGE? + JRST SCHSP ; YES, MUST SEARCH + MOVE PVP,PVSTOR+1 + HRR A,BINDID+1(PVP) ;FOR THE CURRENT PROCESS + CAME A,(B) ;IS THERE ONE IN THE VALUE CELL? + JRST SCHLP ;NO -- SEARCH THE LOCAL BINDINGS + MOVE B,1(B) ;YES -- GET LOCATIVE POINTER + MOVE C,PVP +ILCPJ: MOVE E,SPCCHK + TRNN E,1 ; SKIP IF DOING SPEC UNSPEC CHECK + JRST ILOCPJ + HRRZ E,-2(P) ; IF IGNORING, IGNORE + HRRZ E,-1(E) + CAIN E,SILOC + JRST ILOCPJ + HLRZ E,-2(B) + CAIE E,TUBIND + JRST ILOCPJ + CAMGE B,CURFCN+1(PVP) + JRST SCHLPX + MOVEI D,-2(B) + HRRZ SP,SPSTOR+1 + CAIG D,(SP) + CAMGE B,SPBASE+1(PVP) + JRST SCHLPX + MOVE C,PVSTOR+1 +ILOCPJ: POP P,D + POP P,E + POPJ P, ;FROM THE VALUE CELL + +SCHLPX: MOVEI E,1 + MOVE C,SPSTOR+1 + MOVE B,-1(B) + JRST SCHLP + + +SCHLP5: SETOM (P) + JRST SCHLP2 + +SCHLP: MOVEI D,(B) + CAIL D,HIBOT ; SKIP IF IMPURE ATOM +SCHSP: MOVEI E,1 ; DONT STORE LOCATIVE + + PUSH P,E ; PUSH SWITCH + MOVE E,PVSTOR+1 ; GET PROC +SCHLP1: JUMPE C,UNPJ ;IF NO MORE -- LOSE + CAMN B,1(C) ;ARE WE POINTING AT THE WINNER? + JRST SCHFND ;YES + GETYP D,(C) ; CHECK SKIP + CAIE D,TSKIP + JRST SCHLP2 + PUSH P,B ; CHECK DETOUR + MOVEI B,2(C) + PUSHJ P,CHFRAM ; NON-FATAL FRAME CHECKER + HRRZ E,2(C) ; CONS UP PROCESS + SUBI E,PVLNT*2+1 + HRLI E,-2*PVLNT + JUMPE B,SCHLP3 ; LOSER, FIX IT + POP P,B + MOVEI C,1(C) ; FOLLOW LOOKUP CHAIN +SCHLP2: HRRZ C,(C) ;FOLLOW LINK + JRST SCHLP1 + +SCHLP3: POP P,B + HRRZ SP,SPSTOR+1 + MOVEI C,(SP) ; *** NDR'S BUG *** + CAME E,PVSTOR+1 ; USE IF CURRENT PROCESS + HRRZ C,SPSTO+1(E) ; USE CURRENT SP FOR PROC + JRST SCHLP1 + +SCHFND: MOVE D,SPCCHK + TRNN D,1 ; SKIP IF DOING SPEC UNSPEC CHECK + JRST SCHFN1 + HRRZ D,-2(P) ; IF IGNORING, IGNORE + HRRZ D,-1(D) + CAIN D,SILOC + JRST ILOCPJ + HLRZ D,(C) + CAIE D,TUBIND + JRST SCHFN1 + HRRZ D,CURFCN+1(PVP) + CAIL D,(C) + JRST SCHLP5 + HRRZ SP,SPSTOR+1 + HRRZ D,SPBASE+1(PVP) + CAIL SP,(C) + CAIL D,(C) + JRST SCHLP5 + +SCHFN1: EXCH B,C ;SAVE THE ATOM PTR IN C + MOVEI B,2(B) ;MAKE UP THE LOCATIVE + SUB B,TPBASE+1(E) + HRLI B,(B) + ADD B,TPBASE+1(E) + EXCH C,E ; RET PROCESS IN C + POP P,D ; RESTORE SWITCH + + JUMPN D,ILOCPJ ; DONT CLOBBER ATOM + MOVEM A,(E) ;CLOBBER IT AWAY INTO THE + MOVE D,1(E) ; GET OLD POINTER + MOVEM B,1(E) ;ATOM'S VALUE CELL + JUMPE D,ILOCPJ ; IF POINTS TO GLOBAL OR OTHER PROCES + ; MAKE SURE BINDING SO INDICATES + MOVE D,B ; POINT TO BINDING + SKIPL E,3(D) ; GO TO FIRST ONE, JUST IN CASE + JRST .+3 + MOVE D,E + JRST .-3 ; LOOP THROUGH + MOVEI E,1 + MOVEM E,3(D) ; MAGIC INDICATION + JRST ILOCPJ + +UNPJ: SUB P,[1,,1] ; FLUSH CRUFT +UNPJ1: MOVE C,E ; RET PROCESS ANYWAY +UNPJ11: POP P,D + POP P,E +UNPOPJ: MOVSI A,TUNBOUND + MOVEI B,0 + POPJ P, + +FUNPJ: MOVE C,PVSTOR+1 + JRST UNPOPJ + +;IGLOC RETURNS IN A AND B A LOCATIVE TO THE GLOBAL VALUE OF THE +;IDENTIFIER PASSED TO IT IN A AND B. IF THE IDENTIFIER IS GLOBALLY +;UNBPOUND IT RETURNS $TUNBOUND IN A AND 0 IN B. IT IS CALLED BY PUSHJ P,IGLOC. + +IGLOC: MOVSI A,TLOCI ;DO WE HAVE A LOCATIVE TO + CAME A,(B) ;A PROCESS #0 VALUE? + JRST SCHGSP ;NO -- SEARCH + MOVE B,1(B) ;YES -- GET VALUE CELL + POPJ P, + +SCHGSP: SKIPN (B) + JRST UNPOPJ + MOVE D,GLOBSP+1 ;GET GLOBAL SP PTR + +SCHG1: JUMPGE D,UNPOPJ ;IF NO MORE, LEAVE + CAMN B,1(D) ;ARE WE FOUND? + JRST GLOCFOUND ;YES + ADD D,[4,,4] ;NO -- TRY NEXT + JRST SCHG1 + +GLOCFOUND: + EXCH B,D ;SAVE ATOM PTR + ADD B,[2,,2] ;MAKE LOCATIVE + MOVEI 0,(D) + CAIL 0,HIBOT + POPJ P, + MOVEM A,(D) ;CLOBBER IT AWAY + MOVEM B,1(D) + POPJ P, + +IIGLOC: PUSH TP,$TATOM + PUSH TP,B + PUSHJ P,IGLOC + MOVE C,(TP) + SUB TP,[2,,2] + GETYP 0,A + CAIE 0,TUNBOU + POPJ P, + PUSH TP,$TATOM + PUSH TP,C + MOVEI 0,(C) + MOVE B,C + CAIL 0,$TLOSE + PUSHJ P,IMPURI ; IMPURIFY THE POOR ATOM + PUSHJ P,BSETG ; MAKE A SLOT + SETOM 1(B) ; UNBOUNDIFY IT + MOVSI A,TLOCD + MOVSI 0,TUNBOU + MOVEM 0,(B) + SUB TP,[2,,2] + POPJ P, + + + +;ILVAL RETURNS IN A AND B THE LOCAL VALUE OF THE IDENTIFIER PASSED TO IT IN A AND B +;IF THE IDENTIFIER IS UNBOUND ITS VALUE IS $TUNBOUND IN A AND 0 IN B. IF +;IT IS UNASSIGNED ITS VALUE IS $TUNBOUND IN A AND -1 IN B. CALL - PUSHJ P,IVAL + +AILVAL: + PUSHJ P,AILOC ; USE SUPPLIED SP + JRST CHVAL +ILVAL: + PUSHJ P,ILOC ;GET LOCATIVE TO VALUE +CHVAL: CAMN A,$TUNBOUND ;BOUND + POPJ P, ;NO -- RETURN + MOVSI A,TLOCD ; GET GOOD TYPE + HRR A,2(B) ; SHOULD BE TIME OR 0 + PUSH P,0 + PUSHJ P,RMONC0 ; CHECK READ MONITOR + POP P,0 + MOVE A,(B) ;GET THE TYPE OF THE VALUE + MOVE B,1(B) ;GET DATUM + POPJ P, + +;IGVAL -- LIKE ILVAL EXCEPT FOR GLOBAL VALUES + +IGVAL: PUSHJ P,IGLOC + JRST CHVAL + + + +; COMPILERS INTERFACE TO LVAL/GVAL/SETG/SET + +CILVAL: MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; CURRENT BIND + HRLI 0,TLOCI + CAME 0,(B) ; HURRAY FOR SPEED + JRST CILVA1 ; TOO BAD + MOVE C,1(B) ; POINTER + MOVE A,(C) ; VAL TYPE + TLNE A,.RDMON ; MONITORS? + JRST CILVA1 + GETYP 0,A + CAIN 0,TUNBOU + JRST CUNAS ; COMPILER ERROR + MOVE B,1(C) ; GOT VAL + MOVE 0,SPCCHK + TRNN 0,1 + POPJ P, + HLRZ 0,-2(C) ; SPECIAL CHECK + CAIE 0,TUBIND + POPJ P, ; RETURN + MOVE PVP,PVSTOR+1 + CAMGE C,CURFCN+1(PVP) + JRST CUNAS + POPJ P, + +CUNAS: +CILVA1: SUBM M,(P) ; FIX (P) + PUSH TP,$TATOM ; SAVE ATOM + PUSH TP,B + MCALL 1,LVAL ; GET ERROR/MONITOR + +POPJM: SUBM M,(P) ; REPAIR DAMAGE + POPJ P, + +; COMPILERS INTERFACE TO SET C/ ATOM A,B/ NEW VALUE + +CISET: MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; CURRENT BINDING ENVIRONMENT + HRLI 0,TLOCI + CAME 0,(C) ; CAN WE WIN? + JRST CISET1 ; NO, MORE HAIR + MOVE D,1(C) ; POINT TO SLOT +CISET3: HLLZ 0,(D) ; MON CHECK + TLNE 0,.WRMON + JRST CISET4 ; YES, LOSE + TLZ 0,TYPMSK + IOR A,0 ; LEAVE MONITOR ON + MOVE 0,SPCCHK + TRNE 0,1 + JRST CISET5 ; SPEC/UNSPEC CHECK +CISET6: MOVEM A,(D) ; STORE + MOVEM B,1(D) + POPJ P, + +CISET5: HLRZ 0,-2(D) + CAIE 0,TUBIND + JRST CISET6 + MOVE PVP,PVSTOR+1 + CAMGE D,CURFCN+1(PVP) + JRST CISET4 + JRST CISET6 + +CISET1: SUBM M,(P) ; FIX ADDR + PUSH TP,$TATOM ; SAVE ATOM + PUSH TP,C + PUSH TP,A + PUSH TP,B + MOVE B,C ; GET ATOM + PUSHJ P,ILOC ; SEARCH + MOVE D,B ; POSSIBLE POINTER + GETYP E,A + MOVE 0,A + MOVE A,-1(TP) ; VAL BACK + MOVE B,(TP) + CAIE E,TUNBOU ; SKIP IF WIN + JRST CISET2 ; GO CLOBBER IT IN + MCALL 2,SET + JRST POPJM + +CISET2: MOVE C,-2(TP) ; ATOM BACK + SUBM M,(P) ; RESET (P) + SUB TP,[4,,4] + JRST CISET3 + +; HERE TO DO A MONITORED SET + +CISET4: SUBM M,(P) ; AGAIN FIX (P) + PUSH TP,$TATOM + PUSH TP,C + PUSH TP,A + PUSH TP,B + MCALL 2,SET + JRST POPJM + +; COMPILER LLOC + +CLLOC: MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; GET CURRENT LOCATIVE + HRLI 0,TLOCI + CAME 0,(B) ; WIN? + JRST CLLOC1 + MOVE B,1(B) + MOVE 0,SPCCHK + TRNE 0,1 ; SKIP IF NOT CHECKING + JRST CLLOC9 +CLLOC3: MOVSI A,TLOCD + HRR A,2(B) ; GET BIND TIME + POPJ P, + +CLLOC1: SUBM M,(P) + PUSH TP,$TATOM + PUSH TP,B + PUSHJ P,ILOC ; LOOK IT UP + JUMPE B,CLLOC2 + SUB TP,[2,,2] +CLLOC4: SUBM M,(P) + JRST CLLOC3 + +CLLOC2: MCALL 1,LLOC + JRST CLLOC4 + +CLLOC9: HLRZ 0,-2(B) + CAIE 0,TUBIND + JRST CLLOC3 + MOVE PVP,PVSTOR+1 + CAMGE B,CURFCN+1(PVP) + JRST CLLOC2 + JRST CLLOC3 + +; COMPILER BOUND? + +CBOUND: SUBM M,(P) + PUSHJ P,ILOC + JUMPE B,PJFALS ; IF UNBOUND RET FALSE AND NO SSKIP +PJT1: SOS (P) + MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST POPJM + +PJFALS: MOVEI B,0 + MOVSI A,TFALSE + JRST POPJM + +; COMPILER ASSIGNED? + +CASSQ: SUBM M,(P) + PUSHJ P,ILOC + JUMPE B,PJFALS + GETYP 0,(B) + CAIE 0,TUNBOU + JRST PJT1 + JRST PJFALS + + +; COMPILER GVAL B/ ATOM + +CIGVAL: MOVE 0,(B) ; GLOBAL VAL HERE? + CAME 0,$TLOCI ; TIME=0 ,TYPE=TLOCI => GLOB VAL + JRST CIGVA1 ; NO, GO LOOK + MOVE C,1(B) ; POINT TO SLOT + MOVE A,(C) ; GET TYPE + TLNE A,.RDMON + JRST CIGVA1 + GETYP 0,A ; CHECK FOR UNBOUND + CAIN 0,TUNBOU ; SKIP IF WINNER + JRST CGUNAS + MOVE B,1(C) + POPJ P, + +CGUNAS: +CIGVA1: SUBM M,(P) + PUSH TP,$TATOM + PUSH TP,B + .MCALL 1,GVAL ; GET ERROR/MONITOR + JRST POPJM + +; COMPILER INTERFACET TO SETG + +CSETG: MOVE 0,(C) ; GET V CELL + CAME 0,$TLOCI ; SKIP IF FAST + JRST CSETG1 + HRRZ D,1(C) ; POINT TO SLOT + MOVE 0,(D) ; OLD VAL +CSETG3: CAIG D,HIBOT ; SKIP IF PURE ATOM + TLNE 0,.WRMON ; MONITOR + JRST CSETG2 + MOVEM A,(D) + MOVEM B,1(D) + POPJ P, + +CSETG1: SUBM M,(P) ; FIX UP P + PUSH TP,$TATOM + PUSH TP,C + PUSH TP,A + PUSH TP,B + MOVE B,C + PUSHJ P,IGLOC ; FIND GLOB LOCATIVE + GETYP E,A + MOVE 0,A + MOVEI D,(B) ; SETUP TO RESTORE NEW VAL + MOVE A,-1(TP) + MOVE B,(TP) + CAIE E,TUNBOU + JRST CSETG4 + MCALL 2,SETG + JRST POPJM + +CSETG4: MOVE C,-2(TP) ; ATOM BACK + SUBM M,(P) ; RESET (P) + SUB TP,[4,,4] + JRST CSETG3 + +CSETG2: SUBM M,(P) + PUSH TP,$TATOM ; CAUSE A SETG MONITOR + PUSH TP,C + PUSH TP,A + PUSH TP,B + MCALL 2,SETG + JRST POPJM + +; COMPILER GLOC + +CGLOC: MOVE 0,(B) ; GET CURRENT GUY + CAME 0,$TLOCI ; WIN? + JRST CGLOC1 ; NOPE + HRRZ D,1(B) ; POINT TO SLOT + CAILE D,HIBOT ; PURE? + JRST CGLOC1 + MOVE A,$TLOCD + MOVE B,1(B) + POPJ P, + +CGLOC1: SUBM M,(P) + PUSH TP,$TATOM + PUSH TP,B + MCALL 1,GLOC + JRST POPJM + +; COMPILERS GASSIGNED? + +CGASSQ: MOVE 0,(B) + SUBM M,(P) + CAMN 0,$TLOCD + JRST PJT1 + PUSHJ P,IGLOC + JUMPE B,PJFALS + GETYP 0,(B) + CAIE 0,TUNBOU + JRST PJT1 + JRST PJFALS + +; COMPILERS GBOUND? + +CGBOUN: MOVE 0,(B) + SUBM M,(P) + CAMN 0,$TLOCD + JRST PJT1 + PUSHJ P,IGLOC + JUMPE B,PJFALS + JRST PJT1 + + +IMFUNCTION REP,FSUBR,[REPEAT] + JRST PROG +MFUNCTION BIND,FSUBR + JRST PROG +IMFUNCTION PROG,FSUBR + ENTRY 1 + GETYP A,(AB) ;GET ARG TYPE + CAIE A,TLIST ;IS IT A LIST? + JRST WRONGT ;WRONG TYPE + SKIPN C,1(AB) ;GET AND CHECK ARGUMENT + JRST TFA ;TOO FEW ARGS + SETZB E,D ; INIT HEWITT ATOM AND DECL + PUSHJ P,CARATC ; IS 1ST THING AN ATOM + JFCL + PUSHJ P,RSATY1 ; CDR AND GET TYPE + CAIE 0,TLIST ; MUST BE LIST + JRST MPD.13 + MOVE B,1(C) ; GET ARG LIST + PUSH TP,$TLIST + PUSH TP,C + PUSHJ P,RSATYP + CAIE 0,TDECL + JRST NOP.DC ; JUMP IF NO DCL + MOVE D,1(C) + MOVEM C,(TP) + PUSHJ P,RSATYP ; CDR ON +NOP.DC: PUSH TP,$TLIST + PUSH TP,B ; AND ARG LIST + PUSHJ P,PRGBND ; BIND AUX VARS + HRRZ E,FSAV(TB) + CAIE E,BIND + SKIPA E,IMQUOTE LPROG,[LPROG ]INTRUP + JRST .+3 + PUSHJ P,MAKACT ; MAKE ACTIVATION + PUSHJ P,PSHBND ; BIND AND CHECK + PUSHJ P,SPECBI ; NAD BIND IT + +; HERE TO RUN PROGS FUNCTIONS ETC. + +DOPROG: MOVEI A,REPROG + HRLI A,TDCLI ; FLAG AS FUNNY + MOVEM A,(TB) ; WHERE TO AGAIN TO + MOVE C,1(TB) + MOVEM C,3(TB) ; RESTART POINTER + JRST .+2 ; START BY SKIPPING DECL + +DOPRG1: PUSHJ P,FASTEV + HRRZ C,@1(TB) ;GET THE REST OF THE BODY +DOPRG2: MOVEM C,1(TB) + JUMPN C,DOPRG1 +ENDPROG: + HRRZ C,FSAV(TB) + CAIN C,REP +REPROG: SKIPN C,@3(TB) + JRST PFINIS + HRRZM C,1(TB) + INTGO + MOVE C,1(TB) + JRST DOPRG1 + + +PFINIS: GETYP 0,(TB) + CAIE 0,TDCLI ; DECL'D ? + JRST PFINI1 + HRRZ 0,(TB) ; SEE IF RSUBR + JUMPE 0,RSBVCK ; CHECK RSUBR VALUE + HRRZ C,3(TB) ; GET START OF FCN + GETYP 0,(C) ; CHECK FOR DECL + CAIE 0,TDECL + JRST PFINI1 ; NO, JUST RETURN + MOVE E,IMQUOTE VALUE + PUSHJ P,PSHBND ; BUILD FAKE BINDING + MOVE C,1(C) ; GET DECL LIST + MOVE E,TP + PUSHJ P,CHKDCL ; AND CHECK IT + MOVE A,-3(TP) ; GET VAL BAKC + MOVE B,-2(TP) + SUB TP,[6,,6] + +PFINI1: HRRZ C,FSAV(TB) + CAIE C,EVAL + JRST FINIS + JRST EFINIS + +RSATYP: HRRZ C,(C) +RSATY1: JUMPE C,TFA + GETYP 0,(C) + POPJ P, + +; HERE TO CHECK RSUBR VALUE + +RSBVCK: PUSH TP,A + PUSH TP,B + MOVE C,A + MOVE D,B + MOVE A,1(TB) ; GET DECL + MOVE B,1(A) + HLLZ A,(A) + PUSHJ P,TMATCH + JRST RSBVC1 + POP TP,B + POP TP,A + POPJ P, + +RSBVC1: MOVE C,1(TB) + POP TP,B + POP TP,D + MOVE A,IMQUOTE VALUE + JRST TYPMIS + + +MFUNCTION MRETUR,SUBR,[RETURN] + ENTRY + HLRE A,AB ; GET # OF ARGS + ASH A,-1 ; TO NUMBER + AOJL A,RET2 ; 2 OR MORE ARGS + PUSHJ P,PROGCH ;CHECK IN A PROG + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) ; VERIFY IT +COMRET: PUSHJ P,CHFSWP + SKIPL C ; ARGS? + MOVEI C,0 ; REAL NONE + PUSHJ P,CHUNW + JUMPN A,CHFINI ; WINNER + MOVSI A,TATOM + MOVE B,IMQUOTE T + +; SEE IF MUST CHECK RETURNS TYPE + +CHFINI: GETYP 0,(TB) ; SPECIAL TYPE IF SO + CAIE 0,TDCLI + JRST FINIS ; NO, JUST FINIS + MOVEI 0,PFINIS ; CAUSE TO FALL INTO FUNCTION CODE + HRRM 0,PCSAV(TB) + JRST CONTIN + + +RET2: AOJL A,TMA + GETYP A,(AB)+2 + CAIE A,TACT ; AS FOR "EXIT" SHOULD BE ACTIVATION + JRST WTYP2 + MOVEI B,(AB)+2 ; ADDRESS OF FRAME POINTER + JRST COMRET + + + +MFUNCTION AGAIN,SUBR + ENTRY + HLRZ A,AB ;GET # OF ARGS + CAIN A,-2 ;1 ARG? + JRST NLCLA ;YES + JUMPN A,TMA ;0 ARGS? + PUSHJ P,PROGCH ;CHECK FOR IN A PROG + PUSH TP,A + PUSH TP,B + JRST AGAD +NLCLA: GETYP A,(AB) + CAIE A,TACT + JRST WTYP1 + PUSH TP,(AB) + PUSH TP,1(AB) +AGAD: MOVEI B,-1(TP) ; POINT TO FRAME + PUSHJ P,CHFSWP + HRRZ C,(B) ; GET RET POINT +GOJOIN: PUSH TP,$TFIX + PUSH TP,C + MOVEI C,-1(TP) + PUSHJ P,CHUNW ; RESTORE FRAME, UNWIND IF NEC. + HRRM B,PCSAV(TB) + HRRZ 0,FSAV(TB) ; CHECK FOR RSUBR + CAIGE 0,HIBOT + CAIGE 0,STOSTR + JRST CONTIN + HRRZ E,1(TB) + PUSH TP,$TFIX + PUSH TP,B + MOVEI C,-1(TP) + MOVEI B,(TB) + PUSHJ P,CHUNW1 + MOVE TP,1(TB) + MOVE SP,SPSTOR+1 + MOVEM SP,SPSAV(TB) + MOVEM TP,TPSAV(TB) + MOVE C,OTBSAV(TB) ; AND RESTORE P FROM FATHER + MOVE P,PSAV(C) + MOVEM P,PSAV(TB) + SKIPGE PCSAV(TB) + HRLI B,400000+M + MOVEM B,PCSAV(TB) + JRST CONTIN + +MFUNCTION GO,SUBR + ENTRY 1 + GETYP A,(AB) + CAIE A,TATOM + JRST NLCLGO + PUSHJ P,PROGCH ;CHECK FOR A PROG + PUSH TP,A ;SAVE + PUSH TP,B + MOVEI B,-1(TP) + PUSHJ P,CHFSWP + PUSH TP,$TATOM + PUSH TP,1(C) + PUSH TP,2(B) + PUSH TP,3(B) + MCALL 2,MEMQ ;DOES IT HAVE THIS TAG? + JUMPE B,NXTAG ;NO -- ERROR +FNDGO: EXCH B,(TP) ;SAVE PLACE TO GO + MOVSI D,TLIST + MOVEM D,-1(TP) + JRST GODON + +NLCLGO: CAIE A,TTAG ;CHECK TYPE + JRST WTYP1 + MOVE B,1(AB) + MOVEI B,2(B) ; POINT TO SLOT + PUSHJ P,CHFSWP + MOVE A,1(C) + GETYP 0,(A) ; SEE IF COMPILED + CAIE 0,TFIX + JRST GODON1 + MOVE C,1(A) + JRST GOJOIN + +GODON1: PUSH TP,(A) ;SAVE BODY + PUSH TP,1(A) +GODON: MOVEI C,0 + PUSHJ P,CHUNW ;GO BACK TO CORRECT FRAME + MOVE B,(TP) ;RESTORE ITERATION MARKER + MOVEM B,1(TB) + MOVSI A,TATOM + MOVE B,1(B) + JRST CONTIN + + + + +MFUNCTION TAG,SUBR + ENTRY + JUMPGE AB,TFA + HLRZ 0,AB + GETYP A,(AB) ;GET TYPE OF ARGUMENT + CAIE A,TFIX ; FIX ==> COMPILED + JRST ATOTAG + CAIE 0,-4 + JRST WNA + GETYP A,2(AB) + CAIE A,TACT + JRST WTYP2 + PUSH TP,(AB) + PUSH TP,1(AB) + PUSH TP,2(AB) + PUSH TP,3(AB) + JRST GENTV +ATOTAG: CAIE A,TATOM ;CHECK THAT IT IS AN ATOM + JRST WTYP1 + CAIE 0,-2 + JRST TMA + PUSHJ P,PROGCH ;CHECK PROG + PUSH TP,A ;SAVE VAL + PUSH TP,B + PUSH TP,$TATOM + PUSH TP,1(AB) + PUSH TP,2(B) + PUSH TP,3(B) + MCALL 2,MEMQ + JUMPE B,NXTAG ;IF NOT FOUND -- ERROR + EXCH A,-1(TP) ;SAVE PLACE + EXCH B,(TP) + HRLI A,TFRAME + PUSH TP,A + PUSH TP,B +GENTV: MOVEI A,2 + PUSHJ P,IEVECT + MOVSI A,TTAG + JRST FINIS + +PROGCH: MOVE B,IMQUOTE LPROG,[LPROG ]INTRUP + PUSHJ P,ILVAL ;GET VALUE + GETYP 0,A + CAIE 0,TACT + JRST NXPRG + POPJ P, + +; HERE TO UNASSIGN LPROG IF NEC + +UNPROG: MOVE B,IMQUOTE LPROG,[LPROG ]INTRUP + PUSHJ P,ILVAL + GETYP 0,A + CAIE 0,TACT ; SKIP IF MUST UNBIND + JRST UNMAP + MOVSI A,TUNBOU + MOVNI B,1 + MOVE E,IMQUOTE LPROG,[LPROG ]INTRUP + PUSHJ P,PSHBND +UNMAP: HRRZ 0,FSAV(TB) ; CHECK FOR FUNNY + CAIN 0,MAPPLY ; SKIP IF NOT + POPJ P, + MOVE B,IMQUOTE LMAP,[LMAP ]INTRUP + PUSHJ P,ILVAL + GETYP 0,A + CAIE 0,TFRAME + JRST UNSPEC + MOVSI A,TUNBOU + MOVNI B,1 + MOVE E,IMQUOTE LMAP,[LMAP ]INTRUP + PUSHJ P,PSHBND +UNSPEC: PUSH TP,BNDV + MOVE B,PVSTOR+1 + ADD B,[CURFCN,,CURFCN] + PUSH TP,B + PUSH TP,$TSP + MOVE E,SPSTOR+1 + ADD E,[3,,3] + PUSH TP,E + POPJ P, + +REPEAT 0,[ +MFUNCTION MEXIT,SUBR,[EXIT] + ENTRY 2 + GETYP A,(AB) + CAIE A,TACT + JRST WTYP1 + MOVEI B,(AB) + PUSHJ P,CHFSWP + ADD C,[2,,2] + PUSHJ P,CHUNW ;RESTORE FRAME + JRST CHFINI ; CHECK FOR WINNING VALUE +] + +MFUNCTION COND,FSUBR + ENTRY 1 + GETYP A,(AB) + CAIE A,TLIST + JRST WRONGT + PUSH TP,(AB) + PUSH TP,1(AB) ;CREATE UNNAMED TEMP + MOVEI B,0 ; SET TO FALSE IN CASE + +CLSLUP: SKIPN C,1(TB) ;IS THE CLAUSELIST NIL? + JRST IFALS1 ;YES -- RETURN NIL + GETYP A,(C) ;NO -- GET TYPE OF CAR + CAIE A,TLIST ;IS IT A LIST? + JRST BADCLS ; + MOVE A,1(C) ;YES -- GET CLAUSE + JUMPE A,BADCLS + GETYPF B,(A) + PUSH TP,B ; EVALUATION OF + HLLZS (TP) + PUSH TP,1(A) ;THE PREDICATE + JSP E,CHKARG + MCALL 1,EVAL + GETYP 0,A + CAIN 0,TFALSE + JRST NXTCLS ;FALSE TRY NEXT CLAUSE + MOVE C,1(TB) ;IF NOT, DO FIRST CLAUSE + MOVE C,1(C) + HRRZ C,(C) + JUMPE C,FINIS ;(UNLESS DONE WITH IT) + JRST DOPRG2 ;AS THOUGH IT WERE A PROG +NXTCLS: HRRZ C,@1(TB) ;SET THE CLAUSLIST + HRRZM C,1(TB) ;TO CDR OF THE CLAUSLIST + JRST CLSLUP + +IFALSE: + MOVEI B,0 +IFALS1: MOVSI A,TFALSE ;RETURN FALSE + JRST FINIS + + + +MFUNCTION UNWIND,FSUBR + + ENTRY 1 + + GETYP 0,(AB) ; CHECK THE ARGS FOR WINNAGE + SKIPN A,1(AB) ; NONE? + JRST TFA + HRRZ B,(A) ; CHECK FOR 2D + JUMPE B,TFA + HRRZ 0,(B) ; 3D? + JUMPN 0,TMA + +; Unbind LPROG and LMAPF so that nothing cute happens + + PUSHJ P,UNPROG + +; Push thing to do upon UNWINDing + + PUSH TP,$TLIST + PUSH TP,[0] + + MOVEI C,UNWIN1 + PUSHJ P,IUNWIN ; GOT TO INTERNAL SET UP + +; Now EVAL the first form + + MOVE A,1(AB) + HRRZ 0,(A) ; SAVE POINTER TO OTHER GUY + MOVEM 0,-12(TP) + MOVE B,1(A) + GETYP A,(A) + MOVSI A,(A) + JSP E,CHKAB ; DEFER? + PUSH TP,A + PUSH TP,B + MCALL 1,EVAL ; EVAL THE LOSER + + JRST FINIS + +; Now push slots to hold undo info on the way down + +IUNWIN: JUMPE M,NOUNRE + HLRE 0,M ; CHECK BOUNDS + SUBM M,0 + ANDI 0,-1 + CAIL C,(M) + CAML C,0 + JRST .+2 + SUBI C,(M) + +NOUNRE: PUSH TP,$TTB ; DESTINATION FRAME + PUSH TP,[0] + PUSH TP,[0] ; ARGS TO WHOEVER IS DOING IT + PUSH TP,[0] + +; Now bind UNWIND word + + PUSH TP,$TUNWIN ; FIRST WORD OF IT + MOVE SP,SPSTOR+1 + HRRM SP,(TP) ; CHAIN + MOVEM TP,SPSTOR+1 + PUSH TP,TB ; AND POINT TO HERE + PUSH TP,$TTP + PUSH TP,[0] + HRLI C,TPDL + PUSH TP,C + PUSH TP,P ; SAVE PDL ALSO + MOVEM TP,-2(TP) ; SAVE FOR LATER + POPJ P, + +; Do a non-local return with UNWIND checking + +CHUNW: HRRZ E,SPSAV(B) ; GET DESTINATION FRAME +CHUNW1: PUSH TP,(C) ; FINAL VAL + PUSH TP,1(C) + JUMPN C,.+3 ; WAS THERE REALLY ANYTHING + SETZM (TP) + SETZM -1(TP) + PUSHJ P,STLOOP ; UNBIND +CHUNPC: SKIPA ; WILL NOT SKIP UNLESS UNWIND FOUND + JRST GOTUND + MOVEI A,(TP) + SUBI A,(SP) + MOVSI A,(A) + HLL SP,TP + SUB SP,A + MOVEM SP,SPSTOR+1 + HRRI TB,(B) ; UPDATE TB + PUSHJ P,UNWFRMS + POP TP,B + POP TP,A + POPJ P, + +POPUNW: MOVE SP,SPSTOR+1 + HRRZ SP,(SP) + MOVEI E,(TP) + SUBI E,(SP) + MOVSI E,(E) + HLL SP,TP + SUB SP,E + MOVEM SP,SPSTOR+1 + POPJ P, + + +UNWFRM: JUMPE FRM,CPOPJ + MOVE B,FRM +UNWFR2: JUMPE B,UNWFR1 + CAMG B,TPSAV(TB) + JRST UNWFR1 + MOVE B,(B) + JRST UNWFR2 + +UNWFR1: MOVE FRM,B + POPJ P, + +; Here if an UNDO found + +GOTUND: MOVE TB,1(SP) ; GET FRAME OF UNDO + MOVE A,-1(TP) ; GET FUNNY ARG FOR PASS ON + MOVE C,(TP) + MOVE TP,3(SP) ; GET FUTURE TP + MOVEM C,-6(TP) ; SAVE ARG + MOVEM A,-7(TP) + MOVE C,(TP) ; SAVED P + SUB C,[1,,1] + MOVEM C,PSAV(TB) ; MAKE CONTIN WIN + MOVEM TP,TPSAV(TB) + MOVEM SP,SPSAV(TB) + HRRZ C,(P) ; PC OF CHUNW CALLER + HRRM C,-11(TP) ; SAVE ALSO AND GET WHERE TO GO PC + MOVEM B,-10(TP) ; AND DESTINATION FRAME + HRRZ C,-1(TP) ; WHERE TO UNWIND PC + HRRZ 0,FSAV(TB) ; RSUBR? + CAIGE 0,HIBOT + CAIGE 0,STOSTR + JRST .+3 + SKIPGE PCSAV(TB) + HRLI C,400000+M + MOVEM C,PCSAV(TB) + JRST CONTIN + +UNWIN1: MOVE B,-12(TP) ; POINT TO THING TO DO UNWINDING + GETYP A,(B) + MOVSI A,(A) + MOVE B,1(B) + JSP E,CHKAB + PUSH TP,A + PUSH TP,B + MCALL 1,EVAL +UNWIN2: MOVEI C,-7(TP) ; POINT TO SAVED RET VALS + MOVE B,-10(TP) + HRRZ E,-11(TP) + PUSH P,E + MOVE SP,SPSTOR+1 + HRRZ SP,(SP) ; UNBIND THIS GUY + MOVEI E,(TP) ; AND FIXUP SP + SUBI E,(SP) + MOVSI E,(E) + HLL SP,TP + SUB SP,E + MOVEM SP,SPSTOR+1 + JRST CHUNW ; ANY MORE TO UNWIND? + + +; CHFSWP - CHECK FRAMES VALIDITY AND SWAP PROCESS IF NECESSARY. +; CALLED BY ALL CONTROL FLOW +; ROUTINES (GO,RETURN,EXIT,AGAIN,ERRET...) + +CHFSWP: PUSHJ P,CHFRM ; CHECK FOR VALID FRAME + HRRZ D,(B) ; PROCESS VECTOR DOPE WD + HLRZ C,(D) ; LENGTH + SUBI D,-1(C) ; POINT TO TOP + MOVNS C ; NEGATE COUNT + HRLI D,2(C) ; BUILD PVP + MOVE E,PVSTOR+1 + MOVE C,AB + MOVE A,(B) ; GET FRAME + MOVE B,1(B) + CAMN E,D ; SKIP IF SWAP NEEDED + POPJ P, + PUSH TP,A ; SAVE FRAME + PUSH TP,B + MOVE B,D + PUSHJ P,PROCHK ; FIX UP PROCESS LISTS + MOVE A,PSTAT+1(B) ; GET STATE + CAIE A,RESMBL + JRST NOTRES + MOVE D,B ; PREPARE TO SWAP + POP P,0 ; RET ADDR + POP TP,B + POP TP,A + JSP C,SWAP ; SWAP IN + MOVE C,ABSTO+1(E) ; GET OLD ARRGS + MOVEI A,RUNING ; FIX STATES + MOVE PVP,PVSTOR+1 + MOVEM A,PSTAT+1(PVP) + MOVEI A,RESMBL + MOVEM A,PSTAT+1(E) + JRST @0 + +NOTRES: ERRUUO EQUOTE PROCESS-NOT-RESUMABLE + + +;SETG IS USED TO SET THE GLOBAL VALUE OF ITS FIRST ARGUMENT, +;AN IDENTIFIER, TO THE VALUE OF ITS SECOND ARGUMENT. ITS VALUE IS +; ITS SECOND ARGUMENT. + +IMFUNCTION SETG,SUBR + ENTRY 2 + GETYP A,(AB) ;GET TYPE OF FIRST ARGUMENT + CAIE A,TATOM ;CHECK THAT IT IS AN ATOM + JRST NONATM ;IF NOT -- ERROR + MOVE B,1(AB) ;GET POINTER TO ATOM + PUSH TP,$TATOM + PUSH TP,B + MOVEI 0,(B) + CAIL 0,HIBOT ; PURE ATOM? + PUSHJ P,IMPURIFY ; YES IMPURIFY + PUSHJ P,IGLOC ;GET LOCATIVE TO VALUE + CAME A,$TUNBOUND ;IF BOUND + JRST GOOST1 + SKIPN NOSETG ; ALLOWED? + JRST GOOSTG ; YES + PUSH TP,$TATOM + PUSH TP,EQUOTE CREATING-NEW-GVAL + PUSH TP,$TATOM + PUSH TP,1(AB) + PUSH TP,$TATOM + PUSH TP,EQUOTE NON-FALSE-TO-ALLOW + MCALL 3,ERROR + GETYP 0,A + CAIN 0,TFALSE + JRST FINIS +GOOSTG: PUSHJ P,BSETG ;IF NOT -- BIND IT +GOOST1: MOVE C,2(AB) ; GET PROPOSED VVAL + MOVE D,3(AB) + MOVSI A,TLOCD ; MAKE SURE MONCH WINS + PUSHJ P,MONCH0 ; WOULD YOU BELIEVE MONITORS!!!! + EXCH D,B ;SAVE PTR + MOVE A,C + HRRZ E,-2(D) ; POINT TO POSSIBLE GDECL (OR MAINIFEST) + JUMPE E,OKSETG ; NONE ,OK + CAIE E,-1 ; MANIFEST? + JRST SETGTY + GETYP 0,(D) ; IF UNBOUND, LET IT HAPPEN + SKIPN IGDECL + CAIN 0,TUNBOU + JRST OKSETG +MANILO: GETYP C,(D) + GETYP 0,2(AB) + CAIN 0,(C) + CAME B,1(D) + JRST .+2 + JRST OKSETG + PUSH TP,$TVEC + PUSH TP,D + MOVE B,IMQUOTE REDEFINE + PUSHJ P,ILVAL ; SEE IF REDEFINE OK + GETYP A,A + CAIE A,TUNBOU + CAIN A,TFALSE + JRST .+2 + JRST OKSTG + PUSH TP,$TATOM + PUSH TP,EQUOTE ATTEMPT-TO-CHANGE-MANIFEST-VARIABLE + PUSH TP,$TATOM + PUSH TP,1(AB) + MOVEI A,2 + JRST CALER + +SETGTY: PUSH TP,$TVEC + PUSH TP,D + MOVE C,A + MOVE D,B + GETYP A,(E) + MOVSI A,(A) + MOVE B,1(E) + JSP E,CHKAB + PUSHJ P,TMATCH + JRST TYPMI3 + +OKSTG: MOVE D,(TP) + MOVE A,2(AB) + MOVE B,3(AB) + +OKSETG: MOVEM A,(D) ;DEPOSIT INTO THE + MOVEM B,1(D) ;INDICATED VALUE CELL + JRST FINIS + +TYPMI3: MOVE C,(TP) + HRRZ C,-2(C) + MOVE D,2(AB) + MOVE B,3(AB) + MOVE 0,(AB) + MOVE A,1(AB) + JRST TYPMIS + +BSETG: HRRZ A,GLOBASE+1 + HRRZ B,GLOBSP+1 + SUB B,A + CAIL B,6 + JRST SETGIT + MOVEI B,0 ; MAKE SURE OF NO EMPTY SLOTS + PUSHJ P,IGLOC + CAMN A,$TUNBOU ; SKIP IF SLOT FOUND + JRST BSETG1 + MOVE C,(TP) ; GET ATOM + MOVEM C,-1(B) ; CLOBBER ATOM SLOT + HLLZS -2(B) ; CLOBBER OLD DECL + JRST BSETGX +; BSETG1: PUSH TP,GLOBASE ; MUST REALLY GROW STACK +; PUSH TP,GLOBASE+1 +; PUSH TP,$TFIX +; PUSH TP,[0] +; PUSH TP,$TFIX +; PUSH TP,[100] +; MCALL 3,GROW +BSETG1: PUSH P,0 + PUSH P,C + MOVE C,GLOBASE+1 + HLRE B,C + SUB C,B + MOVE B,GVLINC ; GROW BY INDICATED GVAL SLOTS + DPB B,[001100,,(C)] +; MOVEM A,GLOBASE + MOVE C,[6,,4] ; INDICATOR FOR AGC + PUSHJ P,AGC + MOVE B,GLOBASE+1 + MOVE 0,GVLINC ; ADJUST GLOBAL SPBASE + ASH 0,6 + SUB B,0 + HRLZS 0 + SUB B,0 + MOVEM B,GLOBASE+1 +; MOVEM B,GLOBASE+1 + POP P,0 + POP P,C +SETGIT: + MOVE B,GLOBSP+1 + SUB B,[4,,4] + MOVSI C,TGATOM + MOVEM C,(B) + MOVE C,(TP) + MOVEM C,1(B) + MOVEM B,GLOBSP+1 + ADD B,[2,,2] +BSETGX: MOVSI A,TLOCI + PUSHJ P,PATSCH ; FIXUP SCHLPAGE + MOVEM A,(C) + MOVEM B,1(C) + POPJ P, + +PATSCH: GETYP 0,(C) + CAIN 0,TLOCI + SKIPL D,1(C) + POPJ P, + +PATL: SKIPL E,3(D) ; SKIP IF NEXT EXISTS + JRST PATL1 + MOVE D,E + JRST PATL + +PATL1: MOVEI E,1 + MOVEM E,3(D) ; SAY GVAL ETC. EXISTS IF WE UNBIND + POPJ P, + + +IMFUNCTION DEFMAC,FSUBR + + ENTRY 1 + + PUSH P,. + JRST DFNE2 + +IMFUNCTION DFNE,FSUBR,[DEFINE] + + ENTRY 1 + + PUSH P,[0] +DFNE2: GETYP A,(AB) + CAIE A,TLIST + JRST WRONGT + SKIPN B,1(AB) ; GET ATOM + JRST TFA + GETYP A,(B) ; MAKE SURE ATOM + MOVSI A,(A) + PUSH TP,A + PUSH TP,1(B) + JSP E,CHKARG + MCALL 1,EVAL ; EVAL IT TO AN ATOM + CAME A,$TATOM + JRST NONATM + PUSH TP,A ; SAVE TWO COPIES + PUSH TP,B + PUSHJ P,IGVAL ; SEE IF A VALUE EXISTS + CAMN A,$TUNBOU ; SKIP IF A WINNER + JRST .+3 + PUSHJ P,ASKUSR ; CHECK WITH USER + JRST DFNE1 + PUSH TP,$TATOM + PUSH TP,-1(TP) + MOVE B,1(AB) + HRRZ B,(B) + MOVSI A,TEXPR + SKIPN (P) ; SKIP IF MACRO + JRST DFNE3 + MOVEI D,(B) ; READY TO CONS + MOVSI C,TEXPR + PUSHJ P,INCONS + MOVSI A,TMACRO +DFNE3: PUSH TP,A + PUSH TP,B + MCALL 2,SETG +DFNE1: POP TP,B ; RETURN ATOM + POP TP,A + JRST FINIS + + +ASKUSR: MOVE B,IMQUOTE REDEFINE + PUSHJ P,ILVAL ; SEE IF REDEFINE OK + GETYP A,A + CAIE A,TUNBOU + CAIN A,TFALSE + JRST ASKUS1 + JRST ASKUS2 +ASKUS1: PUSH TP,$TATOM + PUSH TP,-1(TP) + PUSH TP,$TATOM + PUSH TP,EQUOTE ALREADY-DEFINED-ERRET-NON-FALSE-TO-REDEFINE + MCALL 2,ERROR + GETYP 0,A + CAIE 0,TFALSE +ASKUS2: AOS (P) + MOVE B,1(AB) + POPJ P, + + + +;SET CLOBBERS THE LOCAL VALUE OF THE IDENTIFIER GIVEN BY ITS +;FIRST ARGUMENT TO THE SECOND ARG. ITS VALUE IS ITS SECOND ARGUMENT. + +IMFUNCTION SET,SUBR + HLRE D,AB ; 2 TIMES # OF ARGS TO D + ASH D,-1 ; - # OF ARGS + ADDI D,2 + JUMPG D,TFA ; NOT ENOUGH + MOVE B,PVSTOR+1 + MOVE C,SPSTOR+1 + JUMPE D,SET1 ; NO ENVIRONMENT + AOJL D,TMA ; TOO MANY + GETYP A,4(AB) ; CHECK ARG IS A FRAME OR PROCESS + CAIE A,TFRAME + CAIN A,TENV + JRST SET2 ; WINNING ENVIRONMENT/FRAME + CAIN A,TACT + JRST SET2 ; TO MAKE PFISTER HAPPY + CAIE A,TPVP + JRST WTYP2 + MOVE B,5(AB) ; GET PROCESS + MOVE C,SPSTO+1(B) + JRST SET1 +SET2: MOVEI B,4(AB) ; POINT TO FRAME + PUSHJ P,CHFRM ; CHECK IT OUT + MOVE B,5(AB) ; GET IT BACK + MOVE C,SPSAV(B) ; GET BINDING POINTER + HRRZ B,4(AB) ; POINT TO PROCESS + HLRZ A,(B) ; GET LENGTH + SUBI B,-1(A) ; POINT TO START THEREOF + HLL B,PVSTOR+1 ; GET -LNTRH, (ALL PROCESS VECS SAME LENGTH) +SET1: PUSH TP,$TPVP ; SAVE PROCESS + PUSH TP,B + PUSH TP,$TSP ; SAVE PATH POINTER + PUSH TP,C + GETYP A,(AB) ;GET TYPE OF FIRST + CAIE A,TATOM ;ARGUMENT -- + JRST WTYP1 ;BETTER BE AN ATOM + MOVE B,1(AB) ;GET PTR TO IT + MOVEI 0,(B) + CAIL 0,HIBOT + PUSHJ P,IMPURIFY + MOVE C,(TP) + PUSHJ P,AILOC ;GET LOCATIVE TO VALUE +GOTLOC: CAME A,$TUNBOUND ;IF BOUND + JRST GOOSE1 + SKIPN NOSET ; ALLOWED? + JRST GOOSET ; YES + PUSH TP,$TATOM + PUSH TP,EQUOTE CREATING-NEW-LVAL + PUSH TP,$TATOM + PUSH TP,1(AB) + PUSH TP,$TATOM + PUSH TP,EQUOTE NON-FALSE-TO-ALLOW + MCALL 3,ERROR + GETYP 0,A + CAIN 0,TFALSE + JRST FINIS +GOOSET: PUSHJ P,BSET ;IF NOT -- BIND IT +GOOSE1: MOVE C,2(AB) ; GET PROPOSED VVAL + MOVE C,2(AB) ; GET NEW VAL + MOVE D,3(AB) + MOVSI A,TLOCD ; FOR MONCH + HRR A,2(B) + PUSHJ P,MONCH0 ; HURRAY FOR MONITORS!!!!! + MOVE E,B + HLRZ A,2(E) ; GET DECLS + JUMPE A,SET3 ; NONE, GO + PUSH TP,$TSP + PUSH TP,E + MOVE B,1(A) + HLLZ A,(A) ; GET PATTERN + PUSHJ P,TMATCH ; MATCH TMEM + JRST TYPMI2 ; LOSES + MOVE E,(TP) + SUB TP,[2,,2] + MOVE C,2(AB) + MOVE D,3(AB) +SET3: MOVEM C,(E) ;CLOBBER IDENTIFIER + MOVEM D,1(E) + MOVE A,C + MOVE B,D + MOVE C,-2(TP) ; GET PROC + HRRZ C,BINDID+1(C) + HRLI C,TLOCI + +; HERE WE NOTE THAT EFFICIENCY CAN SOMETIMES GET IN THE WAY OF CORRECTNESS +; BY SETTING THE SHALLOW BINDING WE MANAGE TO CLOBBER THE TOP LEVEL LVAL +; EVEN IF WE ARE SETTING WITH RESPECT TO A DIFFERENT FRAME. TO CORRECT +; THIS GLITCH THIS ACTIVITY WILL ONLY TAKE PLACE IF THE ATOM ALREADY POINTS +; TO A BINDING + + MOVE D,1(AB) + SKIPE (D) + JRST NSHALL + MOVEM C,(D) + MOVEM E,1(D) +NSHALL: SUB TP,[4,,4] + JRST FINIS +BSET: + MOVE PVP,PVSTOR+1 + CAMN PVP,-2(TP) ; SKIP IF PROC DIFFERS + MOVEM C,-2(TP) ; ELSE USE RESULT FROM LOC SEARCH + MOVE B,-2(TP) ; GET PROCESS + HRRZ A,TPBASE+1(B) ;GET ACTUAL STACK BASE + HRRZ B,SPBASE+1(B) ;AND FIRST BINDING + SUB B,A ;ARE THERE 6 + CAIL B,6 ;CELLS AVAILABLE? + JRST SETIT ;YES + MOVE C,(TP) ; GET POINTER BACK + MOVEI B,0 ; LOOK FOR EMPTY SLOT + PUSHJ P,AILOC + CAMN A,$TUNBOUND ; SKIP IF FOUND + JRST BSET1 + MOVE E,1(AB) ; GET ATOM + MOVEM E,-1(B) ; AND STORE + JRST BSET2 +BSET1: MOVE B,-2(TP) ; GET PROCESS +; PUSH TP,TPBASE(B) ;NO -- GROW THE TP +; PUSH TP,TPBASE+1(B) ;AT THE BASE END +; PUSH TP,$TFIX +; PUSH TP,[0] +; PUSH TP,$TFIX +; PUSH TP,[100] +; MCALL 3,GROW +; MOVE C,-2(TP) ; GET PROCESS +; MOVEM A,TPBASE(C) ;SAVE RESULT + PUSH P,0 ; MANUALLY GROW VECTOR + PUSH P,C + MOVE C,TPBASE+1(B) + HLRE B,C + SUB C,B + MOVEI C,1(C) + CAME C,TPGROW + ADDI C,PDLBUF + MOVE D,LVLINC + DPB D,[001100,,-1(C)] + MOVE C,[5,,3] ; SET UP INDICATORS FOR AGC + PUSHJ P,AGC + MOVE PVP,PVSTOR+1 + MOVE B,TPBASE+1(PVP) ; MODIFY POINTER + MOVE 0,LVLINC ; ADJUST SPBASE POINTER + ASH 0,6 + SUB B,0 + HRLZS 0 + SUB B,0 + MOVEM B,TPBASE+1(PVP) + POP P,C + POP P,0 +; MOVEM B,TPBASE+1(C) +SETIT: MOVE C,-2(TP) ; GET PROCESS + MOVE B,SPBASE+1(C) + MOVEI A,-6(B) ;MAKE UP BINDING + HRRM A,(B) ;LINK PREVIOUS BIND BLOCK + MOVSI A,TBIND + MOVEM A,-6(B) + MOVE A,1(AB) + MOVEM A,-5(B) + SUB B,[6,,6] + MOVEM B,SPBASE+1(C) + ADD B,[2,,2] +BSET2: MOVE C,-2(TP) ; GET PROC + MOVSI A,TLOCI + HRR A,BINDID+1(C) + HLRZ D,OTBSAV(TB) ; TIME IT + MOVEM D,2(B) ; AND FIX IT + POPJ P, + +; HERE TO ELABORATE ON TYPE MISMATCH + +TYPMI2: MOVE C,(TP) ; FIND DECLS + HLRZ C,2(C) + MOVE D,2(AB) + MOVE B,3(AB) + MOVE 0,(AB) ; GET ATOM + MOVE A,1(AB) + JRST TYPMIS + + + +MFUNCTION NOT,SUBR + ENTRY 1 + GETYP A,(AB) ; GET TYPE + CAIE A,TFALSE ;IS IT FALSE? + JRST IFALSE ;NO -- RETURN FALSE + +TRUTH: + MOVSI A,TATOM ;RETURN T (VERITAS) + MOVE B,IMQUOTE T + JRST FINIS + +IMFUNCTION OR,FSUBR + + PUSH P,[0] + JRST ANDOR + +MFUNCTION ANDA,FSUBR,AND + + PUSH P,[1] +ANDOR: ENTRY 1 + GETYP A,(AB) + CAIE A,TLIST + JRST WRONGT ;IF ARG DOESN'T CHECK OUT + MOVE E,(P) + SKIPN C,1(AB) ;IF NIL + JRST TF(E) ;RETURN TRUTH + PUSH TP,$TLIST ;CREATE UNNAMED TEMP + PUSH TP,C +ANDLP: + MOVE E,(P) + JUMPE C,TFI(E) ;ANY MORE ARGS? + MOVEM C,1(TB) ;STORE CRUFT + GETYP A,(C) + MOVSI A,(A) + PUSH TP,A + PUSH TP,1(C) ;ARGUMENT + JSP E,CHKARG + MCALL 1,EVAL + GETYP 0,A + MOVE E,(P) + XCT TFSKP(E) + JRST FINIS ;IF FALSE -- RETURN + HRRZ C,@1(TB) ;GET CDR OF ARGLIST + JRST ANDLP + +TF: JRST IFALSE + JRST TRUTH + +TFI: JRST IFALS1 + JRST FINIS + +TFSKP: CAIE 0,TFALSE + CAIN 0,TFALSE + +IMFUNCTION FUNCTION,FSUBR + + ENTRY 1 + + MOVSI A,TEXPR + MOVE B,1(AB) + JRST FINIS + + ;SUBR VERSIONS OF AND/OR + +MFUNCTION ANDP,SUBR,[AND?] + JUMPGE AB,TRUTH + MOVE C,[CAIN 0,TFALSE] + JRST BOOL + +MFUNCTION ORP,SUBR,[OR?] + JUMPGE AB,IFALSE + MOVE C,[CAIE 0,TFALSE] +BOOL: HLRE A,AB ; GET ARG COUNTER + MOVMS A + ASH A,-1 ; DIVIDES BY 2 + MOVE D,AB + PUSHJ P,CBOOL + JRST FINIS + +CANDP: SKIPA C,[CAIN 0,TFALSE] +CORP: MOVE C,[CAIE 0,TFALSE] + JUMPE A,CNOARG + MOVEI D,(A) + ASH D,1 ; TIMES 2 + HRLI D,(D) + SUBB TP,D ; POINT TO ARGS & FIXUP TP PTR + AOBJP D,.+1 ; FIXUP ARG PTR AND FALL INTO CBOOL + +CBOOL: GETYP 0,(D) + XCT C ; WINNER ? + JRST CBOOL1 ; YES RETURN IT + ADD D,[2,,2] + SOJG A,CBOOL ; ANY MORE ? + SUB D,[2,,2] ; NO, USE LAST +CBOOL1: MOVE A,(D) + MOVE B,(D)+1 + POPJ P, + + +CNOARG: MOVSI 0,TFALSE + XCT C + JRST CNOAND + MOVSI A,TFALSE + MOVEI B,0 + POPJ P, +CNOAND: MOVSI A,TATOM + MOVE B,IMQUOTE T + POPJ P, + + +MFUNCTION CLOSURE,SUBR + ENTRY + SKIPL A,AB ;ANY ARGS + JRST TFA ;NO -- LOSE + ADD A,[2,,2] ;POINT AT IDS + PUSH TP,$TAB + PUSH TP,A + PUSH P,[0] ;MAKE COUNTER + +CLOLP: SKIPL A,1(TB) ;ANY MORE IDS? + JRST CLODON ;NO -- LOSE + PUSH TP,(A) ;SAVE ID + PUSH TP,1(A) + PUSH TP,(A) ;GET ITS VALUE + PUSH TP,1(A) + ADD A,[2,,2] ;BUMP POINTER + MOVEM A,1(TB) + AOS (P) + MCALL 1,VALUE + PUSH TP,A + PUSH TP,B + MCALL 2,LIST ;MAKE PAIR + PUSH TP,A + PUSH TP,B + JRST CLOLP + +CLODON: POP P,A + ACALL A,LIST ;MAKE UP LIST + PUSH TP,(AB) ;GET FUNCTION + PUSH TP,1(AB) + PUSH TP,A + PUSH TP,B + MCALL 2,LIST ;MAKE LIST + MOVSI A,TFUNARG + JRST FINIS + + + +;ERROR COMMENTS FOR EVAL + +BADNUM: ERRUUO EQUOTE NEGATIVE-ARGUMENT + +WTY1TP: ERRUUO EQUOTE FIRST-ARG-WRONG-TYPE + +UNBOU: PUSH TP,$TATOM + PUSH TP,EQUOTE UNBOUND-VARIABLE + JRST ER1ARG + +UNAS: PUSH TP,$TATOM + PUSH TP,EQUOTE UNASSIGNED-VARIABLE + JRST ER1ARG + +BADENV: + ERRUUO EQUOTE BAD-ENVIRONMENT + +FUNERR: + ERRUUO EQUOTE BAD-FUNARG + + +MPD.0: +MPD.1: +MPD.2: +MPD.3: +MPD.4: +MPD.5: +MPD.6: +MPD.7: +MPD.8: +MPD.9: +MPD.10: +MPD.11: +MPD.12: +MPD.13: +MPD: ERRUUO EQUOTE MEANINGLESS-PARAMETER-DECLARATION + +NOBODY: ERRUUO EQUOTE HAS-EMPTY-BODY + +BADCLS: ERRUUO EQUOTE BAD-CLAUSE + +NXTAG: ERRUUO EQUOTE NON-EXISTENT-TAG + +NXPRG: ERRUUO EQUOTE NOT-IN-PROG + +NAPTL: +NAPT: ERRUUO EQUOTE NON-APPLICABLE-TYPE + +NONEVT: ERRUUO EQUOTE NON-EVALUATEABLE-TYPE + + +NONATM: ERRUUO EQUOTE NON-ATOMIC-ARGUMENT + + +ILLFRA: ERRUUO EQUOTE FRAME-NO-LONGER-EXISTS + +ILLSEG: ERRUUO EQUOTE ILLEGAL-SEGMENT + +BADMAC: ERRUUO EQUOTE BAD-USE-OF-MACRO + +BADFSB: ERRUUO EQUOTE APPLY-OR-STACKFORM-OF-FSUBR + + +ER1ARG: PUSH TP,(AB) + PUSH TP,1(AB) + MOVEI A,2 + JRST CALER + +END + \ No newline at end of file diff --git a//eval.mid.125 b//eval.mid.125 new file mode 100644 index 0000000..9f2552b --- /dev/null +++ b//eval.mid.125 @@ -0,0 +1,4245 @@ +TITLE EVAL -- MUDDLE EVALUATOR + +RELOCATABLE + +; GERALD JAY SUSSMAN, 1971. REWRITTEN MANY TIMES SINCE C. REEVE (1972--1974) + + +.GLOBAL BINDID,LPROG,GLOBSP,GLOBASE,SPBASE,TPBASE,PTIME,SWAP,CHFRAM +.GLOBAL IGVAL,CHKARG,NXTDCL,TPOVFL,CHFRM,PROCHK,CHFSWP,VECBOT,TYPSGR +.GLOBAL ILVAL,ER1ARG,SPECBIND,MAKACT,SPECSTORE,MAKTUP,TPALOC,IBIND,SSPECS +.GLOBAL IDVAL,EVECTO,EUVECT,CHARGS,BCKTRK,CELL,ILOC,IGLOC,CHKDCL,SSPEC1 +.GLOBAL PDLBUF,MESS,FACTI,CHKARG,MAKENV,PSTAT,BNDV,UNBOU,UNAS,IGDECL +.GLOBAL 1STEPR,SEGMNT,SEGLST,NAPT,EVTYPE,EVATYP,APTYPE,APLTYP,APLQ,IDVAL1 +.GLOBAL TESTR,VALG,TYPG,INCR1,TMATCH,TYPMIS,SAT,MAKACT,NTPALO,SPECBND +.GLOBAL TPGROW,CHKAB,TYPSEG,NXTLM,MONCH0,CHFINI,RMONC0,IMPURIFY,ICONS,INCONS +.GLOBAL CILVAL,CISET,CIGVAL,CSETG,MAPPLY,CLLOC,CGLOC,CASSQ,CGASSQ,CBOUND +.GLOBAL IIGLOC,CHUNW,IUNWIN,UNWIN2,SPCCHK,CURFCN,TMPLNT,TD.LNT,TBINIT +.GLOBAL SPECBE,BSETG,GLOTOP,CANDP,CORP,TFA,TMA,DSTORE,PVSTOR,SPSTOR +.GLOBAL AGC,GVLINC,LVLINC,CGBOUN,IEVECT,MAKTU2,STOSTR,HIBOT,POPUNW,ISTRUC +.GLOBAL NOSET,NOSETG + +.INSRT MUDDLE > + +MONITOR + + +; ENTRY TO EXPAND A MACRO + +MFUNCTION EXPAND,SUBR + + ENTRY 1 + + MOVE PVP,PVSTOR+1 + MOVEI A,PVLNT*2+1(PVP) + HRLI A,TFRAME + MOVE B,TBINIT+1(PVP) + HLL B,OTBSAV(B) + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + JRST AEVAL2 + +; MAIN EVAL ENTRANCE + +IMFUNCTION EVAL,SUBR + + ENTRY + + MOVE PVP,PVSTOR+1 + SKIPE C,1STEPR+1(PVP) ; BEING 1 STEPPED? + JRST 1STEPI ; YES HANDLE +EVALON: HLRZ A,AB ;GET NUMBER OF ARGS + CAIE A,-2 ;EXACTLY 1? + JRST AEVAL ;EVAL WITH AN ALIST +SEVAL: GETYP A,(AB) ;GET TYPE OF ARG + SKIPE C,EVATYP+1 ; USER TYPE TABLE? + JRST EVDISP +SEVAL1: CAIG A,NUMPRI ;PRIMITIVE? + JRST SEVAL2 ;YES-DISPATCH + +SELF: MOVE A,(AB) ;TYPES WHICH EVALUATE + MOVE B,1(AB) + JRST EFINIS ;TO SELF-EG NUMBERS + +SEVAL2: HRRO A,EVTYPE(A) + JRST (A) + +; HERE FOR USER EVAL DISPATCH + +EVDISP: ADDI C,(A) ; POINT TO SLOT + ADDI C,(A) + SKIPE (C) ; SKIP EITHER A LOSER OR JRST DISP + JRST EVDIS1 ; APPLY EVALUATOR + SKIPN C,1(C) ; GET ADDR OR GO TO PURE DISP + JRST SEVAL1 + JRST (C) + +EVDIS1: PUSH TP,(C) + PUSH TP,1(C) + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,APPLY ; APPLY HACKER TO OBJECT + JRST EFINIS + + +; EVAL DISPATCH TABLE + +IF2,SELFS==400000,,SELF + +DISTBL EVTYPE,SELFS,[[TFORM,EVFORM],[TLIST,EVLIST],[TVEC,EVECT],[TUVEC,EUVEC] +[TSEG,ILLSEG]] + + +;WATCH FOR SUBTLE BUG 43 LERR,LPROG OR BINDID +AEVAL: + CAIE A,-4 ;EXACTLY 2 ARGS? + JRST WNA ;NO-ERROR + GETYP A,2(AB) ;CHECK THAT WE HAVE A FRAME + CAIE A,TACT + CAIN A,TFRAME + JRST .+3 + CAIE A,TENV + JRST TRYPRO ; COULD BE PROCESS + MOVEI B,2(AB) ; POINT TO FRAME +AEVAL2: PUSHJ P,CHENV ; HACK ENVIRONMENT CHANGE +AEVAL1: PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 1,EVAL +AEVAL3: HRRZ 0,FSAV(TB) + CAIN 0,EVAL + JRST EFINIS + JRST FINIS + +TRYPRO: CAIE A,TPVP ; SKIP IF IT IS A PROCESS + JRST WTYP2 + MOVE C,3(AB) ; GET PROCESS + CAMN C,PVSTOR ; DIFFERENT FROM ME? + JRST SEVAL ; NO, NORMAL EVAL WINS + MOVE B,SPSTO+1(C) ; GET SP FOR PROCESS + MOVE D,TBSTO+1(C) ; GET TOP FRAME + HLL D,OTBSAV(D) ; TIME IT + MOVEI C,PVLNT*2+1(C) ; CONS UP POINTER TO PROC DOPE WORD + HRLI C,TFRAME ; LOOK LIK E A FRAME + PUSHJ P,SWITSP ; SPLICE ENVIRONMENT + JRST AEVAL1 + +; ROUTINE TO CHANGE LOOK UP PATH FOR BINDINGS + +CHENV: PUSHJ P,CHFRM ; CHECK OUT FRAME + MOVE C,(B) ; POINT TO PROCESS + MOVE D,1(B) ; GET TB POINTER FROM FRAME + CAMN SP,SPSAV(D) ; CHANGE? + POPJ P, ; NO, JUST RET + MOVE B,SPSAV(D) ; GET SP OF INTEREST +SWITSP: MOVSI 0,TSKIP ; SET UP SKIP + HRRI 0,1(TP) ; POINT TO UNBIND PATH + MOVE A,PVSTOR+1 + ADD A,[BINDID,,BINDID] ; BIND THE BINDING ID + PUSH TP,BNDV + PUSH TP,A + PUSH TP,$TFIX + AOS A,PTIME ; NEW ID + PUSH TP,A + MOVE E,TP ; FOR SPECBIND + PUSH TP,0 + PUSH TP,B + PUSH TP,C ; SAVE PROCESS + PUSH TP,D + PUSHJ P,SPECBE ; BIND BINDID + MOVE SP,TP ; GET NEW SP + SUB SP,[3,,3] ; SET UP SP FORK + MOVEM SP,SPSTOR+1 + POPJ P, + + +; HERE TO EVALUATE A FORM (99% OF EVAL'S WORK) + +EVFORM: SKIPN C,1(AB) ; EMPTY FORM, RETURN FALSE + JRST EFALSE + GETYP A,(C) ; 1ST ELEMENT OF FORM + CAIE A,TATOM ; ATOM? + JRST EV0 ; NO, EVALUATE IT + MOVE B,1(C) ; GET ATOM + PUSHJ P,IGVAL ; GET ITS GLOBAL VALUE + +; SPECIAL HACK TO SPEED UP LVAL AND GVAL CALLS + + CAIE B,LVAL + CAIN B,GVAL + JRST ATMVAL ; FAST ATOM VALUE + + GETYP 0,A + CAIE 0,TUNBOU ; BOUND? + JRST IAPPLY ; YES APPLY IT + + MOVE C,1(AB) ; LOOK FOR LOCAL + MOVE B,1(C) + PUSHJ P,ILVAL + GETYP 0,A + CAIE 0,TUNBOU + JRST IAPPLY ; WIN, GO APPLY IT + + PUSH TP,$TATOM + PUSH TP,EQUOTE UNBOUND-VARIABLE + PUSH TP,$TATOM + MOVE C,1(AB) ; FORM BACK + PUSH TP,1(C) + PUSH TP,$TATOM + PUSH TP,IMQUOTE VALUE + MCALL 3,ERROR ; REPORT THE ERROR + JRST IAPPLY + +EFALSE: MOVSI A,TFALSE ; SPECIAL FALSE FOR EVAL OF EMPTY FORM + MOVEI B,0 + JRST EFINIS + +ATMVAL: HRRZ D,(C) ; CDR THE FORM + HRRZ 0,(D) ; AND AGAIN + JUMPN 0,IAPPLY + GETYP 0,(D) ; MAKE SURE APPLYING TO ATOM + CAIE 0,TATOM + JRST IAPPLY + MOVEI E,IGVAL ; ASSUME GLOBAAL + CAIE B,GVAL ; SKIP IF OK + MOVEI E,ILVAL ; ELSE USE LOCAL + PUSH P,B ; SAVE SUBR + MOVE B,(D)+1 ; CLR BUG #1637 (GET THE ATOM FOR THE SUBR) + PUSHJ P,(E) ; AND GET VALUE + CAME A,$TUNBOU + JRST EFINIS ; RETURN FROM EVAL + POP P,B + MOVSI A,TSUBR ; CAUSE REAL SUBR TO GET EROR + JRST IAPPLY + +; HERE FOR 1ST ELEMENT NOT A FORM + +EV0: PUSHJ P,FASTEV ; EVAL IT + +; HERE TO APPLY THINGS IN FORMS + +IAPPLY: PUSH TP,(AB) ; SAVE THE FORM + PUSH TP,1(AB) + PUSH TP,A + PUSH TP,B ; SAVE THE APPLIER + PUSH TP,$TFIX ; AND THE ARG GETTER + PUSH TP,[ARGCDR] + PUSHJ P,APLDIS ; GO TO INTERNAL APPLIER + JRST EFINIS ; LEAVE EVAL + +; HERE TO EVAL 1ST ELEMENT OF A FORM + +FASTEV: MOVE PVP,PVSTOR+1 + SKIPE 1STEPR+1(PVP) ; BEING 1 STEPPED? + JRST EV02 ; YES, LET LOSER SEE THIS EVAL + GETYP A,(C) ; GET TYPE + SKIPE D,EVATYP+1 ; USER TABLE? + JRST EV01 ; YES, HACK IT +EV03: CAIG A,NUMPRI ; SKIP IF SELF + SKIPA A,EVTYPE(A) ; GET DISPATCH + MOVEI A,SELF ; USE SLEF + +EV04: CAIE A,SELF ; IF EVAL'S TO SELF, JUST USE IT + JRST EV02 + MOVSI A,TLIST + MOVE PVP,PVSTOR+1 + MOVEM A,CSTO(PVP) + INTGO + SETZM CSTO(PVP) + HLLZ A,(C) ; GET IT + MOVE B,1(C) + JSP E,CHKAB ; CHECK DEFERS + POPJ P, ; AND RETURN + +EV01: ADDI D,(A) ; POINT TO SLOT OF USER EVAL TABLE + ADDI D,(A) + SKIPE (D) ; EITHER NOT GIVEN OR SIMPLE + JRST EV02 + SKIPN 1(D) ; SKIP IF SIMPLE + JRST EV03 ; NOT GIVEN + MOVE A,1(D) + JRST EV04 + +EV02: PUSH TP,(C) + HLLZS (TP) ; FIX UP LH + PUSH TP,1(C) + JSP E,CHKARG + MCALL 1,EVAL + POPJ P, + + +; MAPF/MAPR CALL TO APPLY + + IMQUOTE APPLY + +MAPPLY: JRST APPLY + +; APPLY, FALLS INTO EVAL'S APPLY CODE AT APLDIS + +IMFUNCTION APPLY,SUBR + + ENTRY + + JUMPGE AB,TFA ; MUST BE AT LEAST 1 ARGUMENT + MOVE A,AB + ADD A,[2,,2] + PUSH TP,$TAB + PUSH TP,A + PUSH TP,(AB) ; SAVE FCN + PUSH TP,1(AB) + PUSH TP,$TFIX ; AND ARG GETTER + PUSH TP,[SETZ APLARG] + PUSHJ P,APLDIS + JRST FINIS + +; STACKFROM, ALSO FALLS INTO EVAL'S APPLIER AT APLDIS + +IMFUNCTION STACKFORM,FSUBR + + ENTRY 1 + + GETYP A,(AB) + CAIE A,TLIST + JRST WTYP1 + MOVEI A,3 ; CHECK ALL GOODIES SUPPLIED + HRRZ B,1(AB) + + JUMPE B,TFA + HRRZ B,(B) ; CDR IT + SOJG A,.-2 + + HRRZ C,1(AB) ; GET LIST BACK + PUSHJ P,FASTEV ; DO A FAST EVALUATION + PUSH TP,(AB) + HRRZ C,@1(AB) ; POINT TO ARG GETTING FORMS + PUSH TP,C + PUSH TP,A ; AND FCN + PUSH TP,B + PUSH TP,$TFIX + PUSH TP,[SETZ EVALRG] + PUSHJ P,APLDIS + JRST FINIS + + +; OFFSETS FOR TEMPORARIES ETC. USED IN APPLYING STUFF + +E.FRM==0 ; POINTS TO FORM BEING EVALED (OR ARGS FOR APPLY STACKFORM) +E.FCN==2 ; FUNCTION/SUBR/RSUBR BEING APPLIED +E.ARG==4 ; POINTS TO ARG GETTING ROUTINE (<0 => MUST EVAL ARGS) +E.EXTR==6 ; CONTAINS 1ST ARG IN USER APPLY CASE +E.SEG==10 ; POINTS TO SEGMENT IN FORM BEING HACKED +E.CNT==12 ; COUNTER FOR TUPLES OF ARGS +E.DECL==14 ; POINTS TO DECLARATION LIST IN FUNCTIONS +E.ARGL==16 ; POINTS TO ARG LIST IN FUNCTIONS +E.HEW==20 ; POINTS TO HEWITT ATOM IF IT EXISTS + +E.VAL==E.ARGL ; VALUE TYPE FOR RSUBRS + +MINTM==E.EXTR+2 ; MIN # OF TEMPS EVER ALLOCATED +E.TSUB==E.CNT+2 ; # OF TEMPS FOR SUBR/NUMBER APPLICATION +XP.TMP==E.HEW-E.EXTR ; # EXTRA TEMPS FOR FUNCTION APPLICATION +R.TMP==4 ; TEMPS AFTER ARGS ARE BOUND +TM.OFF==E.HEW+2-R.TMP ; TEMPS TO FLUSH AFTER BIND OF ARGS + +RE.FCN==0 ; AFTER BINDING CONTAINS FCN BODY +RE.ARG==2 ; ARG LIST AFTER BINDING + +; GENERAL THING APPLYER + +APLDIS: PUSH TP,[0] ; SLOT USED FOR USER APPLYERS + PUSH TP,[0] +APLDIX: GETYP A,E.FCN(TB) ; GET TYPE + +APLDI: SKIPE D,APLTYP+1 ; USER TABLE EXISTS? + JRST APLDI1 ; YES, USE IT +APLDI2: CAILE A,NUMPRI ; SKIP IF NOT PRIM + JRST NAPT + HRRO A,APTYPE(A) + JRST (A) + +APLDI1: ADDI D,(A) ; POINT TO SLOT + ADDI D,(A) + SKIPE (D) ; SKIP IF NOT GIVEN OR STANDARD + JRST APLDI3 +APLDI4: SKIPE D,1(D) ; GET DISP + JRST (D) + JRST APLDI2 ; USE SYSTEM DISPATCH + +APLDI3: SKIPE E.EXTR+1(TB) ; SKIP IF HAVEN'T BEEN HERE BEFORE + JRST APLDI4 + MOVE A,(D) ; GET ITS HANDLER + EXCH A,E.FCN(TB) ; AND USE AS FCN + MOVEM A,E.EXTR(TB) ; SAVE + MOVE A,1(D) + EXCH A,E.FCN+1(TB) + MOVEM A,E.EXTR+1(TB) ; STASH OLD FCN AS EXTRG + GETYP A,(D) ; GET TYPE + JRST APLDI + + +; APPLY DISPATCH TABLE + +DISTBL APTYPE,,[[TSUBR,APSUBR],[TFSUBR,APFSUB],[TRSUBR,APRSUB],[TFIX,APNUM] +[TEXPR,APEXPR],[TFUNAR,APFUNARG],[TENTER,APENTR],[TMACRO,APMACR],[TOFFS,APNUM]] + +; SUBR TO SAY IF TYPE IS APPLICABLE + +MFUNCTION APPLIC,SUBR,[APPLICABLE?] + + ENTRY 1 + + GETYP A,(AB) + PUSHJ P,APLQ + JRST IFALSE + JRST TRUTH + +; HERE TO DETERMINE IF A TYPE IS APPLICABLE + +APLQ: PUSH P,B + SKIPN B,APLTYP+1 + JRST USEPUR ; USE PURE TABLE + ADDI B,(A) + ADDI B,(A) ; POINT TO SLOT + SKIPG 1(B) ; SKIP IF WINNER + SKIPE (B) ; SKIP IF POTENIAL LOSER + JRST CPPJ1B ; WIN + SKIPE 1(B) ; SKIP IF MUST USE PURE TABBLE + JRST CPOPJB +USEPUR: CAILE A,NUMPRI ; SKIP IF NOT PRIM + JRST CPOPJB + SKIPL APTYPE(A) ; SKIP IF APLLICABLE +CPPJ1B: AOS -1(P) +CPOPJB: POP P,B + POPJ P, + +; FSUBR APPLYER + +APFSUBR: + SKIPN E.EXTR(TB) ; IF EXTRA ARG + SKIPGE E.ARG+1(TB) ; OR APPLY/STACKFORM, LOSE + JRST BADFSB + MOVE A,E.FCN+1(TB) ; GET FCN + HRRZ C,@E.FRM+1(TB) ; GET ARG LIST + SUB TP,[MINTM,,MINTM] ; FLUSH UNWANTED TEMPS + PUSH TP,$TLIST + PUSH TP,C ; ARG TO STACK + .MCALL 1,(A) ; AND CALL + POPJ P, ; AND LEAVE + +; SUBR APPLYER + +APSUBR: + PUSHJ P,PSH4ZR ; SET UP ZEROED SLOTS + SKIPG E.ARG+1(TB) + AOS E.CNT(TB) ; INDICATES IF MUST EVAL ARGS + MOVSI A,400000 ; MAKE SURE OF GOOD INDIRECT + IORM A,E.ARG+1(TB) + SKIPN A,E.EXTR(TB) ; FUNNY ARGS + JRST APSUB1 ; NO, GO + MOVE B,E.EXTR+1(TB) ; YES , GET VAL + JRST APSUB2 ; AND FALL IN + +APSUB1: PUSHJ P,@E.ARG+1(TB) ; EAT AN ARG + JRST APSUBD ; DONE +APSUB2: PUSH TP,A + PUSH TP,B + AOS E.CNT+1(TB) ; COUNT IT + JRST APSUB1 + +APSUBD: MOVE A,E.CNT+1(TB) ; FINISHED, GET COUNT + MOVE B,E.FCN+1(TB) ; AND SUBR + GETYP 0,E.FCN(TB) + CAIN 0,TENTER + JRST APENDN + PUSHJ P,BLTDN ; FLUSH CRUFT + .ACALL A,(B) + POPJ P, + +BLTDN: MOVEI C,(TB) ; POINT TO DEST + HRLI C,E.TSUB(C) ; AND SOURCE + BLT C,-E.TSUB(TP) ;BL..............T + SUB TP,[E.TSUB,,E.TSUB] + POPJ P, + +APENDN: PUSHJ P,BLTDN +APNDN1: .ECALL A,(B) + POPJ P, + +; FLAGS FOR RSUBR HACKER + +F.STR==1 +F.OPT==2 +F.QUO==4 +F.NFST==10 + +; APPLY OBJECTS OF TYPE RSUBR + +APENTR: +APRSUBR: + MOVE C,E.FCN+1(TB) ; GET THE RSUBR + CAML C,[-5,,] ; IS IT LONG ENOUGH FOR DECLS + JRST APSUBR ; NO TREAT AS A SUBR + GETYP 0,4(C) ; GET TYPE OF 3D ELEMENT + CAIE 0,TDECL ; DECLARATION? + JRST APSUBR ; NO, TREAT AS SUBR + PUSHJ P,PSH4ZR ; ALLOCATE SOME EXTRA ROOM + PUSH TP,$TDECL ; PUSH UP THE DECLS + PUSH TP,5(C) + PUSH TP,$TLOSE ; SAVE ROOM FOR VAL DECL + PUSH TP,[0] + SKIPG E.ARG+1(TB) + AOS E.CNT(TB) ; INDICATES IF MUST EVAL ARGS + MOVSI A,400000 ; MAKE SURE OF GOOD INDIRECT + IORM A,E.ARG+1(TB) + + SKIPN E.EXTR(TB) ; "EXTRA" ARG? + JRST APRSU1 ; NO, + MOVE 0,[SETZ EXTRGT] ; CHANGE THE ACCESS FCN + EXCH 0,E.ARG+1(TB) + HRRM 0,E.ARG(TB) ; REMEMBER IT + +APRSU1: MOVEI 0,0 ; INIT FLAG REGISTER + PUSH P,0 ; SAVE + +APRSU2: HRRZ A,E.DECL+1(TB) ; GET DECL LIST + JUMPE A,APRSU3 ; DONE! + HRRZ B,(A) ; CDR IT + MOVEM B,E.DECL+1(TB) + PUSHJ P,NXTDCL ; IS NEXT THING A STRING? + JRST APRSU4 ; NO, BETTER BE A TYPE + CAMN B,[ASCII /VALUE/] + JRST RSBVAL ; SAVE VAL DECL + TRON 0,F.NFST ; IF NOT FIRST, LOSE + CAME B,[ASCII /CALL/] ; CALL DECL + JRST APRSU7 + SKIPE E.CNT(TB) ; LEGAL? + JRST MPD + MOVE C,E.FRM(TB) + MOVE D,E.FRM+1(TB) ; GET FORM + JRST APRS10 ; HACK IT + +APRSU5: TROE 0,F.STR ; STRING STRING? + JRST MPD ; LOSER + CAMN B,[] + JRST .+3 + CAME B,[+1] ; OPTIONA? + JRST APRSU8 + TROE 0,F.OPT ; CHECK AND SET + JRST MPD ; OPTINAL OPTIONAL LOSES + JRST APRSU2 ; TO MAIN LOOP + +APRSU7: CAME B,[ASCII /QUOTE/] + JRST APRSU5 + TRO 0,F.STR + TROE 0,F.QUO ; TURN ON AND CHECK QUOTE + JRST MPD ; QUOTE QUOTE LOSES + JRST APRSU2 ; GO TO END OF LOOP + + +APRSU8: CAME B,[ASCII /ARGS/] + JRST APRSU9 + SKIPE E.CNT(TB) ; SKIP IF LEGAL + JRST MPD + HRRZ D,@E.FRM+1(TB) ; GET ARG LIST + MOVSI C,TLIST + +APRS10: HRRZ A,(A) ; GET THE DECL + MOVEM A,E.DECL+1(TB) ; CLOBBER + HRRZ B,(A) ; CHECK FOR TOO MUCH + JUMPN B,MPD + MOVE B,1(A) ; GET DECL + HLLZ A,(A) ; GOT THE DECL + MOVEM 0,(P) ; SAVE FLAGS + JSP E,CHKAB ; CHECK DEFER + PUSH TP,C + PUSH TP,D ; SAVE + PUSHJ P,TMATCH + JRST WTYP + AOS E.CNT+1(TB) ; COUNT ARG + JRST APRDON ; GO CALL RSUBR + +RSBVAL: HRRZ A,E.DECL+1(TB) ; GET DECL + JUMPE A,MPD + HRRZ B,(A) ; POINT TO DECL + MOVEM B,E.DECL+1(TB) ; SAVE NEW DECL POINTER + PUSHJ P,NXTDCL + JRST .+2 + JRST MPD + MOVEM A,E.VAL+1(TB) ; SAVE VAL DECL + MOVSI A,TDCLI + MOVEM A,E.VAL(TB) ; SET ITS TYPE + JRST APRSU2 + + +APRSU9: CAME B,[ASCII /TUPLE/] + JRST MPD + MOVEM 0,(P) ; SAVE FLAGS + HRRZ A,(A) ; CDR DECLS + MOVEM A,E.DECL+1(TB) + HRRZ B,(A) + JUMPN B,MPD ; LOSER + PUSH P,[0] ; COUNT ELEMENTS IN TUPLE + +APRTUP: PUSHJ P,@E.ARG+1(TB) ; GOBBLE ARGS + JRST APRTPD ; DONE + PUSH TP,A + PUSH TP,B + AOS (P) ; COUNT IT + JRST APRTUP ; AND GO + +APRTPD: POP P,C ; GET COUNT + ADDM C,E.CNT+1(TB) ; UPDATE MAIN COUNT + ASH C,1 ; # OF WORDS + HRLI C,TINFO ; BUILD FENCE POST + PUSH TP,C + PUSHJ P,TBTOTP ; GEN REL OFFSET TO TOP + PUSH TP,D + HRROI D,-1(TP) ; POINT TO TOP + SUBI D,(C) ; TO BASE + TLC D,-1(C) + MOVSI C,TARGS ; BUILD TYPE WORD + HLR C,OTBSAV(TB) + MOVE A,E.DECL+1(TB) + MOVE B,1(A) + HLLZ A,(A) ; TYPE/VAL + JSP E,CHKAB ; CHECK + PUSHJ P,TMATCH ; GOTO TYPE CHECKER + JRST WTYP + + SUB TP,[2,,2] ; REMOVE FENCE POST + +APRDON: SUB P,[1,,1] ; FLUSH CRUFT + MOVE A,E.CNT+1(TB) ; GET # OF ARGS + MOVE B,E.FCN+1(TB) + GETYP 0,E.FCN(TB) ; COULD BE ENTRY + MOVEI C,(TB) ; PREPARE TO BLT DOWN + HRLI C,E.TSUB+2(C) + BLT C,-E.TSUB+2(TP) + SUB TP,[E.TSUB+2,,E.TSUB+2] + CAIE 0,TRSUBR + JRST APNDNX + .ACALL A,(B) ; CALL THE RSUBR + JRST PFINIS + +APNDNX: .ECALL A,(B) + JRST PFINIS + + + + +APRSU4: MOVEM 0,(P) ; SAVE FLAGS + MOVE B,1(A) ; GET DECL + HLLZ A,(A) + JSP E,CHKAB + MOVE 0,(P) ; RESTORE FLAGS + PUSH TP,A + PUSH TP,B ; AND SAVE + SKIPE E.CNT(TB) ; ALREADY EVAL'D + JRST APREV0 + TRZN 0,F.QUO + JRST APREVA ; MUST EVAL ARG + MOVEM 0,(P) + HRRZ C,@E.FRM+1(TB) ; GET ARG? + TRNE 0,F.OPT ; OPTIONAL + JUMPE C,APRDN + JUMPE C,TFA ; NO, TOO FEW ARGS + MOVEM C,E.FRM+1(TB) + HLLZ A,(C) ; GET ARG + MOVE B,1(C) + JSP E,CHKAB ; CHECK THEM + +APRTYC: MOVE C,A ; SET UP FOR TMATCH + MOVE D,B + EXCH B,(TP) + EXCH A,-1(TP) ; SAVE STUFF +APRS11: PUSHJ P,TMATCH ; CHECK TYPE + JRST WTYP + + MOVE 0,(P) ; RESTORE FLAGS + TRZ 0,F.STR + AOS E.CNT+1(TB) + JRST APRSU2 ; AND GO ON + +APREV0: TRNE 0,F.QUO ; ATTEMPT TO QUOTE ALREADY EVAL'D ARG ? + JRST MPD ; YES, LOSE +APREVA: PUSHJ P,@E.ARG+1(TB) ; EVAL ONE + TDZA C,C ; C=0 ==> NONE LEFT + MOVEI C,1 + MOVE 0,(P) ; FLAGS + JUMPN C,APRTYC ; GO CHECK TYPE +APRDN: SUB TP,[2,,2] ; FLUSH DECL + TRNE 0,F.OPT ; OPTIONAL? + JRST APRDON ; ALL DONE + JRST TFA + +APRSU3: TRNE 0,F.STR ; END IN STRING? + JRST MPD + PUSHJ P,@E.ARG+1(TB) ; SEE IF ANYMORE ARGS + JRST APRDON + JRST TMA + + +; STANDARD ARGUMENT GETTERS USED IN APPLYING THINGS + +ARGCDR: HRRZ C,@E.FRM+1(TB) ; POINT TO ARGLIST (NOTE: POINTS 1 BEFORE WHERE ARG IS) + JUMPE C,CPOPJ ; LEAVE IF DONE + MOVEM C,E.FRM+1(TB) + GETYP 0,(C) ; GET TYPE OF ARG + CAIN 0,TSEG + JRST ARGCD1 ; SEG MENT HACK + PUSHJ P,FASTEV + JRST CPOPJ1 + +ARGCD1: PUSH TP,$TFORM ; PRETEND WE ARE A FORM + PUSH TP,1(C) + MCALL 1,EVAL + MOVEM A,E.SEG(TB) + MOVEM B,E.SEG+1(TB) + PUSHJ P,TYPSEG ; GET SEG TYPE CODE + HRRM C,E.ARG(TB) ; SAVE IT IN OBSCCURE PLACE + MOVE C,DSTORE ; FIX FOR TEMPLATE + MOVEM C,E.SEG(TB) + MOVE C,[SETZ SGARG] + MOVEM C,E.ARG+1(TB) ; SET NEW ARG GETTER + +; FALL INTO SEGARG + +SGARG: INTGO + HRRZ C,E.ARG(TB) ; SEG CODE TO C + MOVE D,E.SEG+1(TB) + MOVE A,E.SEG(TB) + MOVEM A,DSTORE + PUSHJ P,NXTLM ; GET NEXT ELEMENT + JRST SEGRG1 ; DONE + MOVEM D,E.SEG+1(TB) + MOVE D,DSTORE ; KEEP TYPE WINNING + MOVEM D,E.SEG(TB) + SETZM DSTORE + JRST CPOPJ1 ; RETURN + +SEGRG1: SETZM DSTORE + MOVEI C,ARGCDR + HRRM C,E.ARG+1(TB) ; RESET ARG GETTER + JRST ARGCDR + +; ARGUMENT GETTER FOR APPLY + +APLARG: INTGO + SKIPL A,E.FRM+1(TB) ; ANY ARGS LEFT + POPJ P, ; NO, EXIT IMMEDIATELY + ADD A,[2,,2] + MOVEM A,E.FRM+1(TB) + MOVE B,-1(A) ; RET NEXT ARG + MOVE A,-2(A) + JRST CPOPJ1 + +; STACKFORM ARG GETTER + +EVALRG: SKIPN C,@E.FRM+1(TB) ; ANY FORM? + POPJ P, + PUSHJ P,FASTEV + GETYP A,A ; CHECK FOR FALSE + CAIN A,TFALSE + POPJ P, + MOVE C,E.FRM+1(TB) ; GET OTHER FORM + PUSHJ P,FASTEV + JRST CPOPJ1 + + +; HERE TO APPLY NUMBERS + +APNUM: PUSHJ P,PSH4ZR ; TP SLOTS + SKIPN A,E.EXTR(TB) ; FUNNY ARG? + JRST APNUM1 ; NOPE + MOVE B,E.EXTR+1(TB) ; GET ARG + JRST APNUM2 + +APNUM1: PUSHJ P,@E.ARG+1(TB) ; GET ARG + JRST TFA +APNUM2: PUSH TP,A + PUSH TP,B + PUSH TP,E.FCN(TB) + PUSH TP,E.FCN+1(TB) + PUSHJ P,@E.ARG+1(TB) + JRST .+2 + JRST APNUM3 + PUSHJ P,BLTDN ; FLUSH JUNK + MCALL 2,NTH + POPJ P, +; HACK FOR TURNING <3 .FOO .BAR> INTO +APNUM3: PUSH TP,A + PUSH TP,B + PUSHJ P,@E.ARG+1(TB) + JRST .+2 + JRST TMA + PUSHJ P,BLTDN + GETYP A,-5(TP) + PUSHJ P,ISTRUC ; STRUCTURED FIRST ARG? + JRST WTYP1 + MCALL 3,PUT + POPJ P, + +; HERE TO APPLY SUSSMAN FUNARGS + +APFUNARG: + + SKIPN C,E.FCN+1(TB) + JRST FUNERR + HRRZ D,(C) ; MUST BE AT LEAST 2 LONG + JUMPE D,FUNERR + GETYP 0,(D) ; CHECK FOR LIST + CAIE 0,TLIST + JRST FUNERR + HRRZ 0,(D) ; SHOULD BE END + JUMPN 0,FUNERR + GETYP 0,(C) ; 1ST MUST BE FCN + CAIE 0,TEXPR + JRST FUNERR + SKIPN C,1(C) + JRST NOBODY + PUSHJ P,APEXPF ; BIND THE ARGS AND AUX'S + HRRZ C,RE.FCN+1(TB) ; GET BODY OF FUNARG + MOVE B,1(C) ; GET FCN + MOVEM B,RE.FCN+1(TB) ; AND SAVE + HRRZ C,(C) ; CDR FUNARG BODY + MOVE C,1(C) + MOVSI 0,TLIST ; SET UP TYPE + MOVE PVP,PVSTOR+1 + MOVEM 0,CSTO(PVP) ; FOR INTS TO WIN + +FUNLP: INTGO + JUMPE C,DOF ; RUN IT + GETYP 0,(C) + CAIE 0,TLIST ; BETTER BE LIST + JRST FUNERR + PUSH TP,$TLIST + PUSH TP,C + PUSHJ P,NEXTDC ; GET POSSIBILITY + JRST FUNERR ; LOSER + CAIE A,2 + JRST FUNERR + HRRZ B,(B) ; GET TO VALUE + MOVE C,(TP) + SUB TP,[2,,2] + PUSH TP,BNDA + PUSH TP,E + HLLZ A,(B) ; GET VAL + MOVE B,1(B) + JSP E,CHKAB ; HACK DEFER + PUSHJ P,PSHAB4 ; PUT VAL IN + HRRZ C,(C) ; CDR + JUMPN C,FUNLP + +; HERE TO RUN FUNARG + +DOF: MOVE PVP,PVSTOR+1 + SETZM CSTO(PVP) ; DONT CONFUSE GC + PUSHJ P,SPECBIND ; BIND 'EM UP + JRST RUNFUN + + + +; HERE TO DO MACROS + +APMACR: HRRZ E,OTBSAV(TB) + HRRZ D,PCSAV(E) ; SEE WHERE FROM + CAIE D,EFCALL+1 ; 1STEP + JRST .+3 + HRRZ E,OTBSAV(E) + HRRZ D,PCSAV(E) + CAIN D,AEVAL3 ; SKIP IF NOT RIGHT + JRST APMAC1 + SKIPG E.ARG+1(TB) ; SKIP IF REAL FORM EXISTS + JRST BADMAC + MOVE A,E.FRM(TB) + MOVE B,E.FRM+1(TB) + SUB TP,[E.EXTR+2,,E.EXTR+2] ; FLUSH JUNK + PUSH TP,A + PUSH TP,B + MCALL 1,EXPAND ; EXPAND THE MACRO + PUSH TP,A + PUSH TP,B + MCALL 1,EVAL ; EVAL THE RESULT + POPJ P, + +APMAC1: MOVE C,E.FCN+1(TB) ; GET MACRO BODY + GETYP A,(C) + MOVE B,1(C) + MOVSI A,(A) + JSP E,CHKAB ; FIX DEFERS + MOVEM A,E.FCN(TB) + MOVEM B,E.FCN+1(TB) + JRST APLDIX + +; HERE TO APPLY EXPRS (FUNCTIONS) + +APEXPR: PUSHJ P,APEXP ; BIND ARGS AND AUX'S +RUNFUN: HRRZ A,RE.FCN(TB) ; AMOUNT OF FCN TO SKIP + MOVEI C,RE.FCN+1(TB) ; POINT TO FCN + HRRZ C,(C) ; SKIP SOMETHING + SOJGE A,.-1 ; UNTIL 1ST FORM + MOVEM C,RE.FCN+1(TB) ; AND STORE + JRST DOPROG ; GO RUN PROGRAM + +APEXP: SKIPN C,E.FCN+1(TB) ; CHECK FRO BODY + JRST NOBODY +APEXPF: PUSH P,[0] ; COUNT INIT CRAP + ADD TP,[XP.TMP,,XP.TMP] ; SLOTS FOR HACKING + SKIPL TP + PUSHJ P,TPOVFL + SETZM 1-XP.TMP(TP) ; ZERO OUT + MOVEI A,-XP.TMP+2(TP) + HRLI A,-1(A) + BLT A,(TP) ; ZERO SLOTS + SKIPG E.ARG+1(TB) + AOS E.CNT(TB) ; INDICATES IF MUST EVAL ARGS + MOVSI A,400000 ; MAKE E.ARG BE NEG FOR SAFE @ING + IORM A,E.ARG+1(TB) + PUSHJ P,CARATC ; SEE IF HEWITT ATOM EXISTS + JRST APEXP1 ; NO, GO LOOK FOR ARGLIST + MOVEM E,E.HEW+1(TB) ; SAVE ATOM + MOVSM 0,E.HEW(TB) ; AND TYPE + AOS (P) ; COUNT HEWITT ATOM +APEXP1: GETYP 0,(C) ; LOOK AT NEXT THING + CAIE 0,TLIST ; BETTER BE LIST!!! + JRST MPD.0 ; LOSE + MOVE B,1(C) ; GET LIST + MOVEM B,E.ARGL+1(TB) ; SAVE + MOVSM 0,E.ARGL(TB) ; WITH TYPE + HRRZ C,(C) ; CDR THE FCN + JUMPE C,NOBODY ; BODYLESS FCN + GETYP 0,(C) ; SEE IF DCL LIST SUPPLIED + CAIE 0,TDECL + JRST APEXP2 ; NO, START PROCESSING ARGS + AOS (P) ; COUNT DCL + MOVE B,1(C) + MOVEM B,E.DECL+1(TB) + MOVSM 0,E.DECL(TB) + HRRZ C,(C) ; CDR ON + JUMPE C,NOBODY + + ; CHECK FOR EXISTANCE OF EXTRA ARG + +APEXP2: POP P,A ; GET COUNT + HRRM A,E.FCN(TB) ; AND SAVE + SKIPN E.EXTR(TB) ; SKIP IF FUNNY EXTRA ARG EXISTS + JRST APEXP3 + MOVE 0,[SETZ EXTRGT] + EXCH 0,E.ARG+1(TB) + HRRM 0,E.ARG(TB) ; SAVE OLD GETTER AROUND + AOS E.CNT(TB) + +; FALL THROUGH + +; LOOK FOR "BIND" DECLARATION + +APEXP3: PUSHJ P,UNPROG ; UNASSIGN LPROG IF NEC +APXP3A: SKIPN A,E.ARGL+1(TB) ; GET ARGLIST + JRST APEXP4 ; NONE, VERIFY NONE WERE GIVEN + PUSHJ P,NXTDCL ; SEE IF A DECL IS THERE + JRST BNDRG ; NO, GO BIND NORMAL ARGS + HRRZ C,(A) ; CDR THE DCLS + CAME B,[ASCII /BIND/] + JRST CH.CAL ; GO LOOK FOR "CALL" + PUSHJ P,CARTMC ; MUST BE AN ATOM + MOVEM C,E.ARGL+1(TB) ; AND SAVE CDR'D ARGS + PUSHJ P,MAKENV ; GENERATE AN ENVIRONMENT + PUSHJ P,PSBND1 ; PUSH THE BINDING AND CHECK THE DCL + JRST APXP3A ; IN CASE <"BIND" B "BIND" C...... + + +; LOOK FOR "CALL" DCL + +CH.CAL: CAME B,[ASCII /CALL/] + JRST CHOPT ; TRY SOMETHING ELSE +; SKIPG E.ARG+1(TB) ; DONT SKIP IF CANT WIN + SKIPE E.CNT(TB) + JRST MPD.2 + PUSHJ P,CARTMC ; BETTER BE AN ATOM + MOVEM C,E.ARGL+1(TB) + MOVE A,E.FRM(TB) ; RETURN FORM + MOVE B,E.FRM+1(TB) + PUSHJ P,PSBND1 ; BIND AND CHECK + JRST APEXP5 + +; BIND NORMAL ARGS BY CALLING BNDEM1, RETURNS WHEN ALL DONE + +BNDRG: PUSHJ P,BNDEM1 ; GO BIND THEM UP + TRNN A,4 ; SKIP IF HIT A DCL + JRST APEXP4 ; NOT A DCL, MUST BE DONE + +; LOOK FOR "OPTIONAL" DECLARATION + +CHOPT: CAMN B,[] + JRST .+3 + CAME B,[+1] + JRST CHREST ; TRY TUPLE/ARGS + MOVEM C,E.ARGL+1(TB) ; SAVE RESTED ARGLIST + PUSHJ P,BNDEM2 ; DO ALL SUPPLIED OPTIONALS + TRNN A,4 ; SKIP IF NEW DCL READ + JRST APEXP4 + +; CHECK FOR "ARGS" DCL + +CHREST: CAME B,[ASCII /ARGS/] + JRST CHRST1 ; GO LOOK FOR "TUPLE" +; SKIPGE E.ARG+1(TB) ; SKIP IF LEGAL + SKIPE E.CNT(TB) + JRST MPD.3 + PUSHJ P,CARTMC ; GOBBLE ATOM + MOVEM C,E.ARGL+1(TB) ; SAVE CDR'D ARG + HRRZ B,@E.FRM+1(TB) ; GET ARG LIST + MOVSI A,TLIST ; GET TYPE + PUSHJ P,PSBND1 + JRST APEXP5 + +; HERE TO CHECK FOR "TUPLE" + +CHRST1: CAME B,[ASCII /TUPLE/] + JRST APXP10 + PUSHJ P,CARTMC ; GOBBLE ATOM + MOVEM C,E.ARGL+1(TB) + SETZB A,B + PUSHJ P,PSHBND ; SET UP BINDING + SETZM E.CNT+1(TB) ; ZERO ARG COUNTER + +TUPLP: PUSHJ P,@E.ARG+1(TB) ; GET AN ARG + JRST TUPDON ; FINIS + AOS E.CNT+1(TB) + PUSH TP,A + PUSH TP,B + JRST TUPLP + +TUPDON: PUSHJ P,MAKINF ; MAKE INFO CELL + PUSH TP,$TINFO ; FENCE POST TUPLE + PUSHJ P,TBTOTP + ADDI D,TM.OFF ; COMPENSATE FOR MOVEMENT + PUSH TP,D + MOVE C,E.CNT+1(TB) ; GET COUNT + ASH C,1 ; TO WORDS + HRRM C,-1(TP) ; INTO FENCE POST + MOVEI B,-TM.OFF-1(TP) ; SETUP ARG POINTER + SUBI B,(C) ; POINT TO BASE OF TUPLE + MOVNS C ; FOR AOBJN POINTER + HRLI B,(C) ; GOOD ARGS POINTER + MOVEM A,TM.OFF-4(B) ; STORE + MOVEM B,TM.OFF-3(B) + + +; CHECK FOR VALID ENDING TO ARGS + +APEXP5: PUSHJ P,NEXTD ; READ NEXT THING IN ARGLIST + JRST APEXP8 ; DONE + TRNN A,4 ; SKIP IF DCL + JRST MPD.4 ; LOSER +APEXP7: MOVSI A,-NWINS ; CHECK FOR A WINNER + CAME B,WINRS(A) + AOBJN A,.-1 + JUMPGE A,MPD.6 ; NOT A WINNER + +; HERE TO BLT THE WORLD DOWN ON TOP OF ALL THE USELESS TEMPS + +APEXP8: MOVE 0,E.HEW+1(TB) ; GET HEWITT ATOM + MOVE E,E.FCN(TB) ; SAVE COUNTER + MOVE C,E.FCN+1(TB) ; FCN + MOVE B,E.ARGL+1(TB) ; ARG LIST + MOVE D,E.DECL+1(TB) ; AND DCLS + MOVEI A,R.TMP(TB) ; SET UP BLT + HRLI A,TM.OFF(A) + BLT A,-TM.OFF(TP) ; BLLLLLLLLLLLLLT + SUB TP,[TM.OFF,,TM.OFF] ; FLUSH CRUFT + MOVEM E,RE.FCN(TB) + MOVEM C,RE.FCN+1(TB) + MOVEM B,RE.ARGL+1(TB) + MOVE E,TP + PUSH TP,$TATOM + PUSH TP,0 + PUSH TP,$TDECL + PUSH TP,D + GETYP A,-5(TP) ; TUPLE ON TOP? + CAIE A,TINFO ; SKIP IF YES + JRST APEXP9 + HRRZ A,-5(TP) ; GET SIZE + ADDI A,2 + HRLI A,(A) + SUB E,A ; POINT TO BINDINGS + SKIPE C,(TP) ; IF DCL + PUSHJ P,CHKDCL ; CHECK TYPE SPEC ON TUPLE +APEXP9: PUSHJ P,USPCBE ; DO ACTUAL BINDING + + MOVE E,-2(TP) ; RESTORE HEWITT ATOM + MOVE D,(TP) ; AND DCLS + SUB TP,[4,,4] + + JRST AUXBND ; GO BIND AUX'S + +; HERE TO VERIFY CHECK IF ANY ARGS LEFT + +APEXP4: PUSHJ P,@E.ARG+1(TB) + JRST APEXP8 ; WIN + JRST TMA ; TOO MANY ARGS + +APXP10: PUSH P,B + PUSHJ P,@E.ARG+1(TB) + JRST .+2 + JRST TMA + POP P,B + JRST APEXP7 + +; LIST OF POSSIBLE TERMINATING NAMES + +WINRS: +AS.ACT: ASCII /ACT/ +AS.NAM: ASCII /NAME/ +AS.AUX: ASCII /AUX/ +AS.EXT: ASCII /EXTRA/ +NWINS==.-WINRS + + +; HERE TO BIND AUX VARIABLES FOR PROGS AND FCNS + +AUXBND: PUSH P,E ; SAVE HEWITT ATOM ( WILL PUT ON MARKED STACK + ; WHEN NECESSARY) + PUSH P,D ; SAME WITH DCL LIST + PUSH P,[-1] ; FLAG SAYING WE ARE FCN + SKIPN C,RE.ARG+1(TB) ; GET ARG LIST + JRST AUXDON + GETYP 0,(C) ; GET TYPE + CAIE 0,TDEFER ; SKIP IF CHSTR + MOVMS (P) ; SAY WE ARE IN OPTIONALS + JRST AUXB1 + +PRGBND: PUSH P,E + PUSH P,D + PUSH P,[0] ; WE ARE IN AUXS + +AUXB1: HRRZ C,RE.ARG+1(TB) ; POINT TO ARGLIST + PUSHJ P,NEXTDC ; GET NEXT THING OFF OF ARG LIST + JRST AUXDON + TRNE A,4 ; SKIP IF SOME KIND OF ATOM + JRST TRYDCL ; COUDL BE DCL + TRNN A,1 ; SKIP IF QUOTED + JRST AUXB2 + SKIPN (P) ; SKIP IF QUOTED OK + JRST MPD.11 +AUXB2: PUSHJ P,PSHBND ; SET UP BINDING + PUSH TP,$TATOM ; SAVE HEWITT ATOM + PUSH TP,-1(P) + PUSH TP,$TDECL ; AND DECLS + PUSH TP,-2(P) + TRNN A,2 ; SKIP IF INIT VAL EXISTS + JRST AUXB3 ; NO, USE UNBOUND + +; EVALUATE EXPRESSION + + HRRZ C,(B) ; CDR ATOM OFF + +; CHECK FOR SPECIAL FORMS + + GETYP 0,(C) ; GET TYPE OF GOODIE + CAIE 0,TFORM ; SMELLS LIKE A FORM + JRST AUXB13 + HRRZ D,1(C) ; GET 1ST ELEMENT + GETYP 0,(D) ; AND ITS VAL + CAIE 0,TATOM ; FEELS LIKE THE RIGHT FORM + JRST AUXB13 + + MOVE 0,1(D) ; GET THE ATOM + CAME 0,IMQUOTE TUPLE + CAMN 0,MQUOTE ITUPLE + JRST DOTUPL ; SURE GLAD I DIDN'T STEP IN THAT FORM + + +AUXB13: PUSHJ P,FASTEV +AUXB14: MOVE E,TP +AUXB4: MOVEM A,-7(E) ; STORE VAL IN BINDING + MOVEM B,-6(E) + +; HERE TO CHECK AGAINST DECLARATIONS AND COMPLETE THE BINDING + +AUXB5: SUB E,[4,,4] ; POINT TO BINDING TOP + SKIPE C,-2(TP) ; POINT TO DECLARATINS + PUSHJ P,CHKDCL ; CHECK IT + PUSHJ P,USPCBE ; AND BIND UP + SKIPE C,RE.ARG+1(TB) ; CDR DCLS + HRRZ C,(C) ; IF ANY TO CDR + MOVEM C,RE.ARG+1(TB) + MOVE A,(TP) ; NOW PUT HEWITT ATOM AND DCL AWAY + MOVEM A,-2(P) + MOVE A,-2(TP) + MOVEM A,-1(P) + SUB TP,[4,,4] ; FLUSH SLOTS + JRST AUXB1 + + +AUXB3: MOVNI B,1 + MOVSI A,TUNBOU + JRST AUXB14 + + + +; HERE TO HANDLE "CALLS" TO TUPLE AND ITUPLE + +DOTUPL: SKIPE E,(P) ; SKIP IF IN AUX LIST + JRST TUPLE + PUSH TP,$TLIST ; SAVE THE MAGIC FORM + PUSH TP,D + CAME 0,IMQUOTE TUPLE + JRST DOITUP ; DO AN ITUPLE + +; FALL INTO A TUPLE PUSHING LOOP + +DOTUP1: HRRZ C,@(TP) ; CDR THE FORM + JUMPE C,ATUPDN ; FINISHED + MOVEM C,(TP) ; SAVE CDR'D RESULT + GETYP 0,(C) ; CHECK FOR SEGMENT + CAIN 0,TSEG + JRST DTPSEG ; GO PULL IT APART + PUSHJ P,FASTEV ; EVAL IT + PUSHJ P,CNTARG ; PUSH IT UP AND COUNT THEM + JRST DOTUP1 + +; HERE WHEN WE FINISH + +ATUPDN: SUB TP,[2,,2] ; FLUSH THE LIST + ASH E,1 ; E HAS # OF ARGS DOUBLE IT + MOVEI D,(TP) ; FIND BASE OF STACK AREA + SUBI D,(E) + MOVSI C,-3(D) ; PREPARE BLT POINTER + BLT C,C ; HEWITT ATOM AND DECL TO 0,A,B,C + +; NOW PREPEARE TO BLT TUPLE DOWN + + MOVEI D,-3(D) ; NEW DEST + HRLI D,4(D) ; SOURCE + BLT D,-4(TP) ; SLURP THEM DOWN + + HRLI E,TINFO ; SET UP FENCE POST + MOVEM E,-3(TP) ; AND STORE + PUSHJ P,TBTOTP ; GET OFFSET + ADDI D,3 ; FUDGE FOR NOT AT TOP OF STACK + MOVEM D,-2(TP) + MOVEM 0,-1(TP) ; RESTORE HEW ATOM AND DECLS + MOVEM A,(TP) + PUSH TP,B + PUSH TP,C + + PUSHJ P,MAKINF ; MAKE 1ST WORD OF FUNNYS + + HRRZ E,-5(TP) ; RESTORE WORDS OF TUPLE + HRROI B,-5(TP) ; POINT TO TOP OF TUPLE + SUBI B,(E) ; NOW BASE + TLC B,-1(E) ; FIX UP AOBJN PNTR + ADDI E,2 ; COPNESATE FOR FENCE PST + HRLI E,(E) + SUBM TP,E ; E POINT TO BINDING + JRST AUXB4 ; GO CLOBBER IT IN + + +; HERE TO HANDLE SEGMENTS IN THESE FUNNY FORMS + +DTPSEG: PUSH TP,$TFORM ; SAVE THE HACKER + PUSH TP,1(C) + MCALL 1,EVAL ; AND EVALUATE IT + MOVE D,B ; GET READY FOR A SEG LOOP + MOVEM A,DSTORE + PUSHJ P,TYPSEG ; TYPE AND CHECK IT + +DTPSG1: INTGO ; DONT BLOW YOUR STACK + PUSHJ P,NXTLM ; ELEMENT TO A AND B + JRST DTPSG2 ; DONE + PUSHJ P,CNTARG ; PUSH AND COUNT + JRST DTPSG1 + +DTPSG2: SETZM DSTORE + HRRZ E,-1(TP) ; GET COUNT IN CASE END + JRST DOTUP1 ; REST OF ARGS STILL TO DO + +; HERE TO HACK + +DOITUP: HRRZ C,@(TP) ; GET COUNT FILED + JUMPE C,TFA + MOVEM C,(TP) + PUSHJ P,FASTEV ; EVAL IT + GETYP 0,A + CAIE 0,TFIX + JRST WTY1TP + + JUMPL B,BADNUM + + HRRZ C,@(TP) ; GET EXP TO EVAL + MOVEI 0,0 ; DONT LOSE IN 1 ARG CASE + HRRZ 0,(C) ; VERIFY WINNAGE + JUMPN 0,TMA ; TOO MANY + + JUMPE B,DOIDON + PUSH P,B ; SAVE COUNT + PUSH P,B + JUMPE C,DOILOS + PUSHJ P,FASTEV ; EVAL IT ONCE + MOVEM A,-1(TP) + MOVEM B,(TP) + +DOILP: INTGO + PUSH TP,-1(TP) + PUSH TP,-1(TP) + MCALL 1,EVAL + PUSHJ P,CNTRG + SOSLE (P) + JRST DOILP + +DOIDO1: MOVE B,-1(P) ; RESTORE COUNT + SUB P,[2,,2] + +DOIDON: MOVEI E,(B) + JRST ATUPDN + +; FOR CASE OF NO EVALE + +DOILOS: SUB TP,[2,,2] +DOILLP: INTGO + PUSH TP,[0] + PUSH TP,[0] + SOSL (P) + JRST DOILLP + JRST DOIDO1 + +; ROUTINE TO PUSH NEXT TUPLE ELEMENT + +CNTARG: AOS E,-1(TP) ; KEEP ARG COUNT UP TO DATE IN E +CNTRG: EXCH A,-1(TP) ; STORE ELEM AND GET SAVED + EXCH B,(TP) + PUSH TP,A + PUSH TP,B + POPJ P, + + +; DUMMY TUPLE AND ITUPLE + +IMFUNCTION TUPLE,SUBR + + ENTRY + ERRUUO EQUOTE NOT-IN-AUX-LIST + +MFUNCTIO ITUPLE,SUBR + JRST TUPLE + + +; PROCESS A DCL IN THE AUX VAR LISTS + +TRYDCL: SKIPN (P) ; SKIP IF NOT IN AUX'S + JRST AUXB7 + CAME B,AS.AUX ; "AUX" ? + CAMN B,AS.EXT ; OR "EXTRA" + JRST AUXB9 ; YES + CAME B,[ASCII /TUPLE/] + JRST AUXB10 + PUSHJ P,MAKINF ; BUILD EMPTY TUPLE + MOVEI B,1(TP) + PUSH TP,$TINFO ; FENCE POST + PUSHJ P,TBTOTP + PUSH TP,D +AUXB6: HRRZ C,(C) ; CDR PAST DCL + MOVEM C,RE.ARG+1(TB) +AUXB8: PUSHJ P,CARTMC ; GET ATOM +AUXB12: PUSHJ P,PSHBND ; UP GOES THE BINDING + PUSH TP,$TATOM ; HIDE HEWITT ATOM AND DCL + PUSH TP,-1(P) + PUSH TP,$TDECL + PUSH TP,-2(P) + MOVE E,TP + JRST AUXB5 + +; CHECK FOR ARGS + +AUXB10: CAME B,[ASCII /ARGS/] + JRST AUXB7 + MOVEI B,0 ; NULL ARG LIST + MOVSI A,TLIST + JRST AUXB6 ; GO BIND + +AUXB9: SETZM (P) ; NOW READING AUX + HRRZ C,(C) + MOVEM C,RE.ARG+1(TB) + JRST AUXB1 + +; CHECK FOR NAME/ACT + +AUXB7: CAME B,AS.NAM + CAMN B,AS.ACT + JRST .+2 + JRST MPD.12 ; LOSER + HRRZ C,(C) ; CDR ON + HRRZ 0,(C) ; BETTER BE END + JUMPN 0,MPD.13 + PUSHJ P,CARTMC ; FORCE ATOM READ + SETZM RE.ARG+1(TB) +AUXB11: PUSHJ P,MAKACT ; MAKE ACTIVATION + JRST AUXB12 ; AND BIND IT + + +; DONE BIND HEWITT ATOM IF NECESARY + +AUXDON: SKIPN E,-2(P) + JRST AUXD1 + SETZM -2(P) + JRST AUXB11 + +; FINISHED, RETURN + +AUXD1: SUB P,[3,,3] + POPJ P, + + +; MAKE AN ACTIVATION OR ENVIRONMNENT + +MAKACT: MOVEI B,(TB) + MOVSI A,TACT +MAKAC1: MOVE PVP,PVSTOR+1 + HRRI A,PVLNT*2+1(PVP) ; POINT TO PROCESS + HLL B,OTBSAV(B) ; GET TIME + POPJ P, + +MAKENV: MOVSI A,TENV + HRRZ B,OTBSAV(TB) + JRST MAKAC1 + +; SEVERAL USEFUL LITTLE ROUTINES FOR HACKING THIS STUFF + +; CARAT/CARATC/CARATM/CARTMC ALL LOOK FOR THE NEXT ATOM + +CARAT: HRRZ C,E.ARGL+1(TB) ; PICK UP ARGLIST +CARATC: JUMPE C,CPOPJ ; FOUND + GETYP 0,(C) ; GET ITS TYPE + CAIE 0,TATOM +CPOPJ: POPJ P, ; RETURN, NOT ATOM + MOVE E,1(C) ; GET ATOM + HRRZ C,(C) ; CDR DCLS + JRST CPOPJ1 + +CARATM: HRRZ C,E.ARGL+1(TB) +CARTMC: PUSHJ P,CARATC + JRST MPD.7 ; REALLY LOSE + POPJ P, + + +; SUBROUTINES TO PUSH BINDINGS ETC. UP ON THE STACK + +PSBND1: PUSHJ P,PSHBND ; PUSH THEBINDING + JRST CHDCL ; NOW CHECK IT AGAINST DECLARATION + +PSHBND: SKIPGE SPCCHK ; SKIP IF NORMAL SPECIAL + PUSH TP,BNDA1 ; ATOM IN E + SKIPL SPCCHK ; SKIP IF NORMAL UNSPEC OR NO CHECK + PUSH TP,BNDA + PUSH TP,E ; PUSH IT +PSHAB4: PUSH TP,A + PUSH TP,B + PUSH TP,[0] + PUSH TP,[0] + POPJ P, + +; ROUTINE TO PUSH 4 0'S + +PSH4ZR: SETZB A,B + JRST PSHAB4 + + +; EXTRRA ARG GOBBLER + +EXTRGT: HRRZ A,E.ARG(TB) ; RESET SLOT + SETZM E.CNT(TB) + CAIE A,ARGCDR ; IF NOT ARGCDR + AOS E.CNT(TB) + TLO A,400000 ; SET FLAG + MOVEM A,E.ARG+1(TB) + MOVE A,E.EXTR(TB) ; RET ARG + MOVE B,E.EXTR+1(TB) + JRST CPOPJ1 + +; CHECK A/B FOR DEFER + +CHKAB: GETYP 0,A + CAIE 0,TDEFER ; SKIP IF DEFER + JRST (E) + MOVE A,(B) + MOVE B,1(B) ; GET REAL THING + JRST (E) +; IF DECLARATIONS EXIST, DO THEM + +CHDCL: MOVE E,TP +CHDCLE: SKIPN C,E.DECL+1(TB) + POPJ P, + JRST CHKDCL + +; ROUTINE TO READ NEXT THING FROM ARGLIST + +NEXTD: HRRZ C,E.ARGL+1(TB) ; GET ARG LIST +NEXTDC: MOVEI A,0 + JUMPE C,CPOPJ + PUSHJ P,CARATC ; TRY FOR AN ATOM + JRST NEXTD1 ; NO + JRST CPOPJ1 + +NEXTD1: CAIE 0,TFORM ; FORM? + JRST NXT.L ; COULD BE LIST + PUSHJ P,CHQT ; VERIFY 'ATOM + MOVEI A,1 + JRST CPOPJ1 + +NXT.L: CAIE 0,TLIST ; COULD BE (A ) OR ('A ) + JRST NXT.S ; BETTER BE A DCL + PUSHJ P,LNT.2 ; VERIFY LENGTH IS 2 + JRST MPD.8 + CAIE 0,TATOM ; TYPE OF 1ST RET IN 0 + JRST LST.QT ; MAY BE 'ATOM + MOVE E,1(B) ; GET ATOM + MOVEI A,2 + JRST CPOPJ1 +LST.QT: CAIE 0,TFORM ; FORM? + JRST MPD.9 ; LOSE + PUSH P,C + MOVEI C,(B) ; VERIFY 'ATOM + PUSHJ P,CHQT + MOVEI B,(C) ; POINT BACK TO LIST + POP P,C + MOVEI A,3 ; CODE + JRST CPOPJ1 + +NXT.S: MOVEI A,(C) ; LET NXTDCL FIND OUT + PUSHJ P,NXTDCL + JRST MPD.3 ; LOSER + MOVEI A,4 ; SET DCL READ FLAG + JRST CPOPJ1 + +; ROUTINE TO CHECK LENGTH OF LIST/FORM FOR BEING 2 + +LNT.2: HRRZ B,1(C) ; GET LIST/FORM + JUMPE B,CPOPJ + HRRZ B,(B) + JUMPE B,CPOPJ + HRRZ B,(B) ; BETTER END HERE + JUMPN B,CPOPJ + HRRZ B,1(C) ; LIST BACK + GETYP 0,(B) ; TYPE OF 1ST ELEMENT + JRST CPOPJ1 + +; ROUTINE TO VERIFY FORM IS 'ATOM AND RET ATOM + +CHQT: PUSHJ P,LNT.2 ; 1ST LENGTH CHECK + JRST MPD.5 + CAIE 0,TATOM + JRST MPD.5 + MOVE 0,1(B) + CAME 0,IMQUOTE QUOTE + JRST MPD.5 ; BETTER BE QUOTE + HRRZ E,(B) ; CDR + GETYP 0,(E) ; TYPE + CAIE 0,TATOM + JRST MPD.5 + MOVE E,1(E) ; GET QUOTED ATOM + POPJ P, + +; ARG BINDER FOR REGULAR ARGS AND OPTIONALS + +BNDEM1: PUSH P,[0] ; REGULAR FLAG + JRST .+2 +BNDEM2: PUSH P,[1] +BNDEM: PUSHJ P,NEXTD ; GET NEXT THING + JRST CCPOPJ ; END OF THINGS + TRNE A,4 ; CHECK FOR DCL + JRST BNDEM4 + TRNE A,2 ; SKIP IF NOT (ATM ..) OR ('ATM ...) + SKIPE (P) ; SKIP IF REG ARGS + JRST .+2 ; WINNER, GO ON + JRST MPD.6 ; LOSER + SKIPGE SPCCHK + PUSH TP,BNDA1 ; SAVE ATOM + SKIPL SPCCHK + PUSH TP,BNDA + PUSH TP,E +; SKIPGE E.ARG+1(TB) ; ALREADY EVAL'D ARG? + SKIPE E.CNT(TB) + JRST RGLAR0 + TRNN A,1 ; SKIP IF ARG QUOTED + JRST RGLARG + HRRZ D,@E.FRM+1(TB) ; GET AND CDR ARG + JUMPE D,TFACHK ; OH OH MAYBE TOO FEW ARGS + MOVEM D,E.FRM+1(TB) ; STORE WINNER + HLLZ A,(D) ; GET ARG + MOVE B,1(D) + JSP E,CHKAB ; HACK DEFER + JRST BNDEM3 ; AND GO ON + +RGLAR0: TRNE A,1 ; ATTEMPT TO QUOTE ALREADY EVAL'D ARG ? + JRST MPD ; YES, LOSE +RGLARG: PUSH P,A ; SAVE FLAGS + PUSHJ P,@E.ARG+1(TB) + JRST TFACH1 ; MAY GE TOO FEW + SUB P,[1,,1] +BNDEM3: HRRZ C,@E.ARGL+1(TB) ; CDR THHE ARGS + MOVEM C,E.ARGL+1(TB) + PUSHJ P,PSHAB4 ; PUSH VALUE AND SLOTS + PUSHJ P,CHDCL ; CHECK DCLS + JRST BNDEM ; AND BIND ON! + +; HERE WHEN ARGS RUN OUT, IF NOT OPTIONAL, GIVE TFA + +TFACH1: POP P,A +TFACHK: SUB TP,[2,,2] ; FLUSH ATOM + SKIPN (P) ; SKIP IF OPTIONALS + JRST TFA +CCPOPJ: SUB P,[1,,1] + POPJ P, + +BNDEM4: HRRZ C,@E.ARGL+1(TB) ; POINT TO REST OF ARGL + JRST CCPOPJ + + +; EVALUATE LISTS, VECTORS, UNIFROM VECTORS + +EVLIST: PUSH P,[-1] ;-1 -- THIS IS A LIST + JRST EVL1 ;GO TO HACKER + +EVECT: PUSH P,[0] ;0 -- THIS IS A GENERAL VECTOR + JRST EVL1 + +EUVEC: PUSH P,[1] ;1 -- THIS IS A UNIFORM VECTOR + +EVL1: PUSH P,[0] ;PUSH A COUNTER + GETYPF A,(AB) ;GET FULL TYPE + PUSH TP,A + PUSH TP,1(AB) ;AND VALUE + +EVL2: INTGO ;CHECK INTERRUPTS + SKIPN A,1(TB) ;ANYMORE + JRST EVL3 ;NO, QUIT + SKIPL -1(P) ;SKIP IF LIST + JUMPG A,EVL3 ;JUMP IF VECTOR EMPTY + GETYPF B,(A) ;GET FULL TYPE + SKIPGE C,-1(P) ;SKIP IF NOT LIST + HLLZS B ;CLOBBER CDR FIELD + JUMPG C,EVL7 ;HACK UNIFORM VECS +EVL8: PUSH P,B ;SAVE TYPE WORD ON P + CAMN B,$TSEG ;SEGMENT? + MOVSI B,TFORM ;FAKE OUT EVAL + PUSH TP,B ;PUSH TYPE + PUSH TP,1(A) ;AND VALUE + JSP E,CHKARG ; CHECK DEFER + MCALL 1,EVAL ;AND EVAL IT + POP P,C ;AND RESTORE REAL TYPE + CAMN C,$TSEG ;SEGMENT? + JRST DOSEG ;YES, HACK IT + AOS (P) ;COUNT ELEMENT + PUSH TP,A ;AND PUSH IT + PUSH TP,B +EVL6: SKIPGE A,-1(P) ;DONT SKIP IF LIST + HRRZ B,@1(TB) ;CDR IT + JUMPL A,ASTOTB ;AND STORE IT + MOVE B,1(TB) ;GET VECTOR POINTER + ADD B,AMNT(A) ;INCR BY APPROPRIATE AMOUNT +ASTOTB: MOVEM B,1(TB) ;AND STORE BACK + JRST EVL2 ;AND LOOP BACK + +AMNT: 2,,2 ;INCR FOR GENERAL VECTOR + 1,,1 ;SAME FOR UNIFORM VECTOR + +CHKARG: GETYP A,-1(TP) + CAIE A,TDEFER + JRST (E) + HRRZS (TP) ;MAKE SURE INDIRECT WINS + MOVE A,@(TP) + MOVEM A,-1(TP) ;CLOBBER IN TYPE SLOT + MOVE A,(TP) ;NOW GET POINTER + MOVE A,1(A) ;GET VALUE + MOVEM A,(TP) ;CLOBBER IN + JRST (E) + + + +EVL7: HLRE C,A ; FIND TYPE OF UVECTOR + SUBM A,C ;C POINTS TO DOPE WORD + GETYP B,(C) ;GET TYPE + MOVSI B,(B) ;TO LH NOW + SOJA A,EVL8 ;AND RETURN TO DO EVAL + +EVL3: SKIPL -1(P) ;SKIP IF LIST + JRST EVL4 ;EITHER VECTOR OR UVECTOR + + MOVEI B,0 ;GET A NIL +EVL9: MOVSI A,TLIST ;MAKE TYPE WIN +EVL5: SOSGE (P) ;COUNT DOWN + JRST EVL10 ;DONE, RETURN + PUSH TP,$TLIST ;SET TO CALL CONS + PUSH TP,B + MCALL 2,CONS + JRST EVL5 ;LOOP TIL DONE + + +EVL4: MOVEI B,EUVECT ;UNIFORM CASE + SKIPG -1(P) ;SKIP IF UNIFORM CASE + MOVEI B,EVECTO ;NO, GENERAL CASE + POP P,A ;GET COUNT + .ACALL A,(B) ;CALL CREATOR +EVL10: GETYPF A,(AB) ; USE SENT TYPE + JRST EFINIS + + +; PROCESS SEGMENTS FOR THESE HACKS + +DOSEG: PUSHJ P,TYPSEG ; FIND WHAT IS BEING SEGMENTED + JUMPE C,LSTSEG ; CHECK END SPLICE IF LIST + +SEG3: PUSHJ P,NXTELM ; GET THE NEXTE ELEMT + JRST SEG4 ; RETURN TO CALLER + AOS (P) ; COUNT + JRST SEG3 ; TRY AGAIN +SEG4: SETZM DSTORE + JRST EVL6 + +TYPSEG: PUSHJ P,TYPSGR + JRST ILLSEG + POPJ P, + +TYPSGR: MOVE E,A ; SAVE TYPE + GETYP A,A ; TYPE TO RH + PUSHJ P,SAT ;GET STORAGE TYPE + MOVE D,B ; GOODIE TO D + + MOVNI C,1 ; C <0 IF ILLEGAL + CAIN A,S2WORD ;LIST? + MOVEI C,0 + CAIN A,S2NWORD ;GENERAL VECTOR? + MOVEI C,1 + CAIN A,SNWORD ;UNIFORM VECTOR? + MOVEI C,2 + CAIN A,SCHSTR + MOVEI C,3 + CAIN A,SBYTE + MOVEI C,5 + CAIN A,SSTORE ;SPECIAL AFREE STORAGE ? + MOVEI C,4 ;TREAT LIKE A UVECTOR + CAIN A,SARGS ;ARGS TUPLE? + JRST SEGARG ;NO, ERROR + CAILE A,NUMSAT ; SKIP IF NOT TEMPLATE + JRST SEGTMP + MOVE A,PTYPS(C) + CAIN A,4 + MOVEI A,2 ; NOW TREAT LIKE A UVECTOR + HLL E,A +MSTOR1: JUMPL C,CPOPJ + +MDSTOR: MOVEM E,DSTORE + JRST CPOPJ1 + +SEGTMP: MOVEI C,4 + HRRI E,(A) + JRST MSTOR1 + +SEGARG: MOVSI A,TARGS + HRRI A,(E) + PUSH TP,A ;PREPARE TO CHECK ARGS + PUSH TP,D + MOVEI B,-1(TP) ;POINT TO SAVED COPY + PUSHJ P,CHARGS ;CHECK ARG POINTER + POP TP,D ;AND RESTORE WINNER + POP TP,E ;AND TYPE AND FALL INTO VECTOR CODE + MOVEI C,1 + JRST MSTOR1 + +LSTSEG: SKIPL -1(P) ;SKIP IF IN A LIST + JRST SEG3 ;ELSE JOIN COMMON CODE + HRRZ A,@1(TB) ;CHECK FOR END OF LIST + JUMPN A,SEG3 ;NO, JOIN COMMON CODE + SETZM DSTORE ;CLOBBER SAVED GOODIES + JRST EVL9 ;AND FINISH UP + +NXTELM: INTGO + PUSHJ P,NXTLM ; GOODIE TO A AND B + POPJ P, ; DONE + PUSH TP,A + PUSH TP,B + JRST CPOPJ1 +NXTLM: XCT TESTR(C) ; SKIP IF MORE IN SEGEMNT + POPJ P, + XCT TYPG(C) ; GET THE TYPE + XCT VALG(C) ; AND VALUE + JSP E,CHKAB ; CHECK DEFERRED + XCT INCR1(C) ; AND INCREMENT TO NEXT +CPOPJ1: AOS (P) ; SKIP RETURN + POPJ P, + +; TABLES FOR SEGMENT OPERATIONS (0->LIST, 1->VECTOR/ARGS, 2->UVEC, 3->STRING) + +PTYPS: TLIST,, + TVEC,, + TUVEC,, + TCHSTR,, + TSTORA,, + TBYTE,, + +TESTR: SKIPN D + SKIPL D + SKIPL D + PUSHJ P,CHRDON + PUSHJ P,TM1 + PUSHJ P,CHRDON + +TYPG: PUSHJ P,LISTYP + GETYPF A,(D) + PUSHJ P,UTYPE + MOVSI A,TCHRS + PUSHJ P,TM2 + MOVSI A,TFIX + +VALG: MOVE B,1(D) + MOVE B,1(D) + MOVE B,(D) + PUSHJ P,1CHGT + PUSHJ P,TM3 + PUSHJ P,1CHGT + +INCR1: HRRZ D,(D) + ADD D,[2,,2] + ADD D,[1,,1] + PUSHJ P,1CHINC + ADD D,[1,,] + PUSHJ P,1CHINC + +TM1: HRRZ A,DSTORE + SKIPE DSTORE + HRRZ A,DSTORE ; GET SAT + SUBI A,NUMSAT+1 + ADD A,TD.LNT+1 + EXCH C,D + XCT (A) + HLRZ 0,C ; GET AMNT RESTED + SUB B,0 + EXCH C,D + TRNE B,-1 + AOS (P) + POPJ P, + +TM3: +TM2: HRRZ 0,DSTORE + SKIPE DSTORE + HRRZ 0,DSTORE + PUSH P,C + PUSH P,D + PUSH P,E + MOVE B,D + MOVEI C,0 ; GET "1ST ELEMENT" + PUSHJ P,TMPLNT ; GET NTH IN A AND B + POP P,E + POP P,D + POP P,C + POPJ P, + +CHRDON: HRRZ B,DSTORE + SKIPE DSTORE + HRRZ B,DSTORE ; POIT TO DOPE WORD + JUMPE B,CHRFIN + AOS (P) +CHRFIN: POPJ P, + +LISTYP: GETYP A,(D) + MOVSI A,(A) + POPJ P, +1CHGT: MOVE B,D + ILDB B,B + POPJ P, + +1CHINC: IBP D + SKIPN DSTORE + JRST 1CHIN1 + SOS DSTORE + POPJ P, + +1CHIN1: SOS DSTORE + POPJ P, + +UTYPE: HLRE A,D + SUBM D,A + GETYP A,(A) + MOVSI A,(A) + POPJ P, + + +;COMPILER's CALL TO DOSEG +SEGMNT: PUSHJ P,TYPSEG +SEGLP1: SETZB A,B +SEGLOP: PUSHJ P,NXTELM + JRST SEGRET + AOS (P)-2 ; INCREMENT COMPILER'S COUNT + JRST SEGLOP + +SEGRET: SETZM DSTORE + POPJ P, + +SEGLST: PUSHJ P,TYPSEG + JUMPN C,SEGLS2 +SEGLS3: SETZM DSTORE + MOVSI A,TLIST +SEGLS1: SOSGE -2(P) ; START COUNT DOWN + POPJ P, + MOVEI E,(B) + POP TP,D + POP TP,C + PUSHJ P,ICONS + JRST SEGLS1 + +SEGLS2: PUSHJ P,NXTELM + JRST SEGLS4 + AOS -2(P) + JRST SEGLS2 + +SEGLS4: MOVEI B,0 + JRST SEGLS3 + + +;SPECBIND BINDS IDENTIFIERS. IT IS CALLED BY PUSHJ P,SPECBIND. +;SPECBIND IS PROVIDED WITH A CONTIGUOUS SET OF TRIPLETS ON TP. +;EACH TRIPLET IS AS FOLLOWS: +;THE FIRST ELEMENT IS THE IDENTIFIER TO BE BOUND, ITS TYPE WORD IS [TATOM,,-1], +;THE SECOND IS THE VALUE TO WHICH IT IS TO BE ASSIGNED, +;AND THE THIRD IS A PAIR OF ZEROES. + +BNDA1: TATOM,,-2 +BNDA: TATOM,,-1 +BNDV: TVEC,,-1 + +USPECBIND: + MOVE E,TP +USPCBE: PUSH P,$TUBIND + JRST .+3 + +SPECBIND: + MOVE E,TP ;GET THE POINTER TO TOP +SPECBE: PUSH P,$TBIND + ADD E,[1,,1] ;BUMP POINTER ONCE + SETZB 0,D ;CLEAR TEMPS + PUSH P,0 + MOVEI 0,(TB) ; FOR CHECKS + +BINDLP: MOVE A,-4(E) ; CHECK FOR VEC BIND + CAMN A,BNDV + JRST NONID + MOVE A,-6(E) ;GET TYPE + CAME A,BNDA1 ; FOR UNSPECIAL + CAMN A,BNDA ;NORMAL ID BIND? + CAILE 0,-6(E) ; MAKE SURE NOT GOING UNDER FRAME + JRST SPECBD + SUB E,[6,,6] ;MOVE PTR + SKIPE D ;LINK? + HRRM E,(D) ;YES -- LOBBER + SKIPN (P) ;UPDATED? + MOVEM E,(P) ;NO -- DO IT + + MOVE A,0(E) ;GET ATOM PTR + MOVE B,1(E) + PUSHJ P,SILOC ;GET LAST BINDING + MOVS A,OTBSAV (TB) ;GET TIME + HRL A,5(E) ; GET DECL POINTER + MOVEM A,4(E) ;CLOBBER IT AWAY + MOVE A,(E) ; SEE IF SPEC/UNSPEC + TRNN A,1 ; SKIP, ALWAYS SPEC + SKIPA A,-1(P) ; USE SUPPLIED + MOVSI A,TBIND + MOVEM A,(E) ;IDENTIFY AS BIND BLOCK + JUMPE B,SPEB10 + MOVE PVP,PVSTOR+1 + HRRZ C,SPBASE(PVP) ; CHECK FOR CROSS OF PROC + MOVEI A,(TP) + CAIL A,(B) ; LOSER + CAILE C,(B) ; SKIP IFF WINNER + MOVEI B,1 +SPEB10: MOVEM B,5(E) ;IN RESTORE CELLS + + MOVE C,1(E) ;GET ATOM PTR + SKIPE (C) + JUMPE B,.-4 + MOVEI A,(C) + MOVEI B,0 ; FOR SPCUNP + CAIL A,HIBOT ; SKIP IF IMPURE ATOM + PUSHJ P,SPCUNP + MOVE PVP,PVSTOR+1 + HRRZ A,BINDID+1(PVP) ;GET PROCESS NUMBER + HRLI A,TLOCI ;MAKE LOC PTR + MOVE B,E ;TO NEW VALUE + ADD B,[2,,2] + MOVEM A,(C) ;CLOBBER ITS VALUE + MOVEM B,1(C) ;CELL + MOVE D,E ;REMEMBER LINK + JRST BINDLP ;DO NEXT + +NONID: CAILE 0,-4(E) + JRST SPECBD + SUB E,[4,,4] + SKIPE D + HRRM E,(D) + SKIPN (P) + MOVEM E,(P) + + MOVE D,1(E) ;GET PTR TO VECTOR + MOVE C,(D) ;EXCHANGE TYPES + EXCH C,2(E) + MOVEM C,(D) + + MOVE C,1(D) ;EXCHANGE DATUMS + EXCH C,3(E) + MOVEM C,1(D) + + MOVEI A,TBVL + HRLM A,(E) ;IDENTIFY BIND BLOCK + MOVE D,E ;REMEMBER LINK + JRST BINDLP + +SPECBD: SKIPE D + MOVE SP,SPSTOR+1 + HRRM SP,(D) + SKIPE D,(P) + MOVEM D,SPSTOR+1 + SUB P,[2,,2] + POPJ P, + + +; HERE TO IMPURIFY THE ATOM + +SPCUNP: PUSH TP,$TSP + PUSH TP,E + PUSH TP,$TSP + PUSH TP,-1(P) ; LINK BACK IS AN SP + PUSH TP,$TSP + PUSH TP,B + CAIN B,1 + SETZM -1(TP) ; FIXUP SOME FUNNYNESS + MOVE B,C + PUSHJ P,IMPURIFY + MOVE 0,-2(TP) ; RESTORE LINK BACK POINTER + MOVEM 0,-1(P) + MOVE E,-4(TP) + MOVE C,B + MOVE B,(TP) + SUB TP,[6,,6] + MOVEI 0,(TB) + POPJ P, + +; ENTRY FROM COMPILER TO SET UP A BINDING + +IBIND: MOVE SP,SPSTOR+1 + SUBI E,-5(SP) ; CHANGE TO PDL POINTER + HRLI E,(E) + ADD E,SP + MOVEM C,-4(E) + MOVEM A,-3(E) + MOVEM B,-2(E) + HRLOI A,TATOM + MOVEM A,-5(E) + MOVSI A,TLIST + MOVEM A,-1(E) + MOVEM D,(E) + JRST SPECB1 ; NOW BIND IT + +; "FAST CALL TO SPECBIND" + + + +; Compiler's call to SPECBIND all atom bindings, no TBVLs etc. + +SPECBND: + MOVE E,TP ; POINT TO BINDING WITH E +SPECB1: PUSH P,[0] ; SLOTS OF INTEREST + PUSH P,[0] + SUBM M,-2(P) + +SPECB2: MOVEI 0,(TB) ; FOR FRAME CHECK + MOVE A,-5(E) ; LOOK AT FIRST THING + CAMN A,BNDA ; SKIP IF LOSER + CAILE 0,-5(E) ; SKIP IF REAL WINNER + JRST SPECB3 + + SUB E,[5,,5] ; POINT TO BINDING + SKIPE A,(P) ; LINK? + HRRM E,(A) ; YES DO IT + SKIPN -1(P) ; FIRST ONE? + MOVEM E,-1(P) ; THIS IS IT + + MOVE A,1(E) ; POINT TO ATOM + MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; QUICK CHECK + HRLI 0,TLOCI + CAMN 0,(A) ; WINNERE? + JRST SPECB4 ; YES, GO ON + + PUSH P,B ; SAVE REST OF ACS + PUSH P,C + PUSH P,D + MOVE B,A ; FOR ILOC TO WORK + PUSHJ P,SILOC ; GO LOOK IT UP + JUMPE B,SPECB9 + MOVE PVP,PVSTOR+1 + HRRZ C,SPBASE+1(PVP) + MOVEI A,(TP) + CAIL A,(B) ; SKIP IF LOSER + CAILE C,(B) ; SKIP IF WINNER + MOVEI B,1 ; SAY NO BACK POINTER +SPECB9: MOVE C,1(E) ; POINT TO ATOM + SKIPE (C) ; IF GLOBALLY BOUND, MAKE SURE OK + JUMPE B,.-3 + MOVEI A,(C) ; PURE ATOM? + CAIGE A,HIBOT ; SKIP IF OK + JRST .+4 + PUSH P,-4(P) ; MAKE HAPPINESS + PUSHJ P,SPCUNP ; IMPURIFY + POP P,-5(P) + MOVE PVP,PVSTOR+1 + MOVE A,BINDID+1(PVP) + HRLI A,TLOCI + MOVEM A,(C) ; STOR POINTER INDICATOR + MOVE A,B + POP P,D + POP P,C + POP P,B + JRST SPECB5 + +SPECB4: MOVE A,1(A) ; GET LOCATIVE +SPECB5: EXCH A,5(E) ; CLOBBER INTO REBIND SLOT (GET DECL) + HLL A,OTBSAV(TB) ; TIME IT + MOVSM A,4(E) ; SAVE DECL AND TIME + MOVEI A,TBIND + HRLM A,(E) ; CHANGE TO A BINDING + MOVE A,1(E) ; POINT TO ATOM + MOVEM E,(P) ; REMEMBER THIS GUY + ADD E,[2,,2] ; POINT TO VAL CELL + MOVEM E,1(A) ; INTO ATOM SLOT + SUB E,[3,,3] ; POINT TO NEXT ONE + JRST SPECB2 + +SPECB3: SKIPE A,(P) + MOVE SP,SPSTOR+1 + HRRM SP,(A) ; LINK OLD STUFF + SKIPE A,-1(P) ; NEW SP? + MOVEM A,SPSTOR+1 + SUB P,[2,,2] + INTGO ; IN CASE BLEW STACK + SUBM M,(P) + POPJ P, + + +;SPECSTORE RESTORES THE BINDINGS SP TO THE ENVIRONMENT POINTER IN +;SPSAV (TB). IT IS CALLED BY PUSHJ P,SPECSTORE. + +SPECSTORE: + PUSH P,E + HRRZ E,SPSAV (TB) ;GET TARGET POINTER + PUSHJ P,STLOOP + POP P,E + MOVE SP,SPSAV(TB) ; GET NEW SP + MOVEM SP,SPSTOR+1 + POPJ P, + +STLOOP: MOVE SP,SPSTOR+1 + PUSH P,D + PUSH P,C + +STLOO1: CAIL E,(SP) ;ARE WE DONE? + JRST STLOO2 + HLRZ C,(SP) ;GET TYPE OF BIND + CAIN C,TUBIND + JRST .+3 + CAIE C,TBIND ;NORMAL IDENTIFIER? + JRST ISTORE ;NO -- SPECIAL HACK + + + MOVE C,1(SP) ;GET TOP ATOM + MOVSI 0,TLOCI ; MAYBE LOCI OR UNBOUND + SKIPL D,5(SP) + MOVSI 0,TUNBOU + MOVE PVP,PVSTOR+1 + HRR 0,BINDID+1(PVP) ;STORE SIGNATURE + SKIPN 5(SP) + MOVEI 0,0 ; TOTALLY UNBOUND IN ALL CASES + MOVEM 0,(C) ;CLOBBER INTO ATOM + MOVEM D,1(C) + SETZM 4(SP) +SPLP: HRRZ SP,(SP) ;FOLOW LINK + JUMPN SP,STLOO1 ;IF MORE + SKIPE E ; OK IF E=0 + FATAL SP OVERPOP +STLOO2: MOVEM SP,SPSTOR+1 + POP P,C + POP P,D + POPJ P, + +ISTORE: CAIE C,TBVL + JRST CHSKIP + MOVE C,1(SP) + MOVE D,2(SP) + MOVEM D,(C) + MOVE D,3(SP) + MOVEM D,1(C) + JRST SPLP + +CHSKIP: CAIN C,TSKIP + JRST SPLP + CAIE C,TUNWIN ; UNWIND HACK + FATAL BAD SP + HRRZ C,-2(P) ; WHERE FROM? + CAIE C,CHUNPC + JRST SPLP ; IGNORE + MOVEI E,(TP) ; FIXUP SP + SUBI E,(SP) + MOVSI E,(E) + HLL SP,TP + SUB SP,E + POP P,C + POP P,D + AOS (P) + POPJ P, + +; ENTRY FOR FUNNY COMPILER UNBIND (1) + +SSPECS: PUSH P,E + PUSH P,PVP + PUSH P,SP + MOVEI E,(TP) + PUSHJ P,STLOOP +SSPEC2: SUBI E,(SP) ; MAKE SP BE AOBJN + MOVSI E,(E) + HLL SP,TP + SUB SP,E + MOVEM SP,SPSTOR+1 + POP P,SP + POP P,PVP + POP P,E + POPJ P, + +; ENTRY FOR FUNNY COMPILER UNBIND (2) + +SSPEC1: PUSH P,E + PUSH P,PVP + PUSH P,SP + SUBI E,1 ; MAKE SURE GET CURRENT BINDING + PUSHJ P,STLOOP ; UNBIND + MOVEI E,(TP) ; NOW RESET SP + JRST SSPEC2 + +EFINIS: MOVE PVP,PVSTOR+1 + SKIPN C,1STEPR+1(PVP) ; SKIP NIF BEING ONE PROCEEDED + JRST FINIS + PUSH TP,$TATOM + PUSH TP,MQUOTE EVLOUT + PUSH TP,A ;SAVE EVAL RESULTS + PUSH TP,B + PUSH TP,[TINFO,,2] ; FENCE POST + PUSHJ P,TBTOTP + PUSH TP,D + PUSHJ P,MAKINF ; MAKE ARG BLOCK INFO + PUSH TP,A + MOVEI B,-6(TP) + HRLI B,-4 ; AOBJN TO ARGS BLOCK + PUSH TP,B + MOVE PVP,PVSTOR+1 + PUSH TP,1STEPR(PVP) + PUSH TP,1STEPR+1(PVP) ; PROCESS DOING THE 1STEPPING + MCALL 2,RESUME + MOVE A,-3(TP) ; GET BACK EVAL VALUE + MOVE B,-2(TP) + JRST FINIS + +1STEPI: PUSH TP,$TATOM + PUSH TP,MQUOTE EVLIN + PUSH TP,$TAB ; PUSH EVALS ARGGS + PUSH TP,AB + PUSHJ P,MAKINF ; TURN INTO ARGS BLOCK + MOVEM A,-1(TP) ; AND CLOBBER + PUSH TP,[TINFO,,2] ; FENCE POST 2D TUPLE + PUSHJ P,TBTOTP + PUSH TP,D + PUSHJ P,MAKINF ; TURN IT INTO ARGS BLOCK + PUSH TP,A + MOVEI B,-6(TP) ; SETUP TUPLE + HRLI B,-4 + PUSH TP,B + MOVE PVP,PVSTOR+1 + PUSH TP,1STEPR(PVP) + PUSH TP,1STEPR+1(PVP) + MCALL 2,RESUME ; START UP 1STEPERR + SUB TP,[6,,6] ; REMOVE CRUD + GETYP A,A ; GET 1STEPPERS TYPE + CAIE A,TDISMI ; IF DISMISS, STOP 1 STEPPING + JRST EVALON + +; HERE TO PUSH DOWN THE 1 STEP STATE AND RUN + + MOVE D,PVP + ADD D,[1STEPR,,1STEPR] ; POINT TO 1 STEP SLOT + PUSH TP,$TSP ; SAVE CURRENT SP + PUSH TP,SPSTOR+1 + PUSH TP,BNDV + PUSH TP,D ; BIND IT + PUSH TP,$TPVP + PUSH TP,[0] ; NO 1 STEPPER UNTIL POPJ + PUSHJ P,SPECBIND + +; NOW PUSH THE ARGS UP TO RE-CALL EVAL + + MOVEI A,0 +EFARGL: JUMPGE AB,EFCALL + PUSH TP,(AB) + PUSH TP,1(AB) + ADD AB,[2,,2] + AOJA A,EFARGL + +EFCALL: ACALL A,EVAL ; NOW DO THE EVAL + MOVE C,(TP) ; PRE-UNBIND + MOVE PVP,PVSTOR+1 + MOVEM C,1STEPR+1(PVP) + MOVE SP,-4(TP) ; AVOID THE UNBIND + MOVEM SP,SPSTOR+1 + SUB TP,[6,,6] ; AND FLUSH LOSERS + JRST EFINIS ; AND TRY TO FINISH UP + +MAKINF: HLRZ A,OTBSAV(TB) ; TIME IT + HRLI A,TARGS + POPJ P, + + +TBTOTP: MOVEI D,(TB) ; COMPUTE REL DIST FROM TP TO TB + SUBI D,(TP) + POPJ P, +; ARRIVE HERE TO COMPLETE A COMPILER GENERATED TUPLE +; D/ LENGTH OF THE TUPLE IN WORDS + +MAKTU2: MOVE D,-1(P) ; GET LENGTH + ASH D,1 + PUSHJ P,MAKTUP + PUSH TP,A + PUSH TP,B + POPJ P, + +MAKTUP: HRLI D,TINFO ; FIRST WORD OF FENCE POST + PUSH TP,D + HRROI B,(TP) ; TOP OF TUPLE + SUBI B,(D) + TLC B,-1(D) ; AOBJN IT + PUSHJ P,TBTOTP + PUSH TP,D + HLRZ A,OTBSAV(TB) ; TIME IT + HRLI A,TARGS + POPJ P, + +; HERE TO ALLOCATE SLOTS FOR COMPILER (AMNT IN A) + +TPALOC: SUBM M,(P) + ;Once here ==>ADDI A,1 Bug??? + HRLI A,(A) + ADD TP,A + PUSH P,A + SKIPL TP + PUSHJ P,TPOVFL ; IN CASE IT LOST + INTGO ; TAKE THE GC IF NEC + HRRI A,2(TP) + SUB A,(P) + SETZM -1(A) + HRLI A,-1(A) + BLT A,(TP) + SUB P,[1,,1] + JRST POPJM + + +NTPALO: PUSH TP,[0] + SOJG 0,.-1 + POPJ P, + + ;EVALUATES A IDENTIFIER -- GETS LOCAL VALUE IF THERE IS ONE, OTHERWISE GLOBAL. + +IMFUNCTION VALUE,SUBR + JSP E,CHKAT + PUSHJ P,IDVAL + JRST FINIS + +IDVAL: PUSHJ P,IDVAL1 + CAMN A,$TUNBOU + JRST UNBOU + POPJ P, + +IDVAL1: PUSH TP,A + PUSH TP,B ;SAVE ARG IN CASE NEED TO CHECK GLOBAL VALUE + PUSHJ P,ILVAL ;LOCAL VALUE FINDER + CAME A,$TUNBOUND ;IF NOT UNBOUND OR UNASSIGNED + JRST RIDVAL ;DONE - CLEAN UP AND RETURN + POP TP,B ;GET ARG BACK + POP TP,A + JRST IGVAL +RIDVAL: SUB TP,[2,,2] + POPJ P, + +;GETS THE LOCAL VALUE OF AN IDENTIFIER + +IMFUNCTION LVAL,SUBR + JSP E,CHKAT + PUSHJ P,AILVAL + CAME A,$TUNBOUND + JRST FINIS + JUMPN B,UNAS + JRST UNBOU + +; MAKE AN ATOM UNASSIGNED + +MFUNCTION UNASSIGN,SUBR + JSP E,CHKAT ; GET ATOM ARG + PUSHJ P,AILOC +UNASIT: CAMN A,$TUNBOU ; IF UNBOUND + JRST RETATM + MOVSI A,TUNBOU + MOVEM A,(B) + SETOM 1(B) ; MAKE SURE +RETATM: MOVE B,1(AB) + MOVE A,(AB) + JRST FINIS + +; UNASSIGN GLOBALLY + +MFUNCTION GUNASSIGN,SUBR + JSP E,CHKAT2 + PUSHJ P,IGLOC + CAMN A,$TUNBOU + JRST RETATM + MOVE B,1(AB) ; ATOM BACK + MOVEI 0,(B) + CAIL 0,HIBOT ; SKIP IF IMPURE + PUSHJ P,IMPURIFY ; YES, MAKE IT IMPURE + PUSHJ P,IGLOC ; RESTORE LOCATIVE + HRRZ 0,-2(B) ; SEE IF MANIFEST + GETYP A,(B) ; AND CURRENT TYPE + CAIN 0,-1 + CAIN A,TUNBOU + JRST UNASIT + SKIPE IGDECL + JRST UNASIT + MOVE D,B + JRST MANILO + +; GETS A LOCATIVE TO THE LOCAL VALUE OF AN IDENTIFIER. + +MFUNCTION LLOC,SUBR + JSP E,CHKAT + PUSHJ P,AILOC + CAMN A,$TUNBOUND + JRST UNBOU + MOVSI A,TLOCD + HRR A,2(B) + JRST FINIS + +;TESTS TO SEE IF AN IDENTIFIER IS LOCALLY BOUND + +MFUNCTION BOUND,SUBR,[BOUND?] + JSP E,CHKAT + PUSHJ P,AILVAL + CAMN A,$TUNBOUND + JUMPE B,IFALSE + JRST TRUTH + +;TESTS TO SEE IF AN IDENTIFIER IS LOCALLY ASSIGNED + +MFUNCTION ASSIGP,SUBR,[ASSIGNED?] + JSP E,CHKAT + PUSHJ P,AILVAL + CAME A,$TUNBOUND + JRST TRUTH +; JUMPE B,UNBOU + JRST IFALSE + +;GETS THE GLOBAL VALUE OF AN IDENTIFIER + +IMFUNCTION GVAL,SUBR + JSP E,CHKAT2 + PUSHJ P,IGVAL + CAMN A,$TUNBOUND + JRST UNAS + JRST FINIS + +;GETS A LOCATIVE TO THE GLOBAL VALUE OF AN IDENTIFIER + +MFUNCTION RGLOC,SUBR + + JRST GLOC + +MFUNCTION GLOC,SUBR + + JUMPGE AB,TFA + CAMGE AB,[-5,,] + JRST TMA + JSP E,CHKAT1 + MOVEI E,IGLOC + CAML AB,[-2,,] + JRST .+4 + GETYP 0,2(AB) + CAIE 0,TFALSE + MOVEI E,IIGLOC + PUSHJ P,(E) + CAMN A,$TUNBOUND + JRST UNAS + MOVSI A,TLOCD + HRRZ 0,FSAV(TB) + CAIE 0,GLOC + MOVSI A,TLOCR + CAIE 0,GLOC + SUB B,GLOTOP+1 + MOVE C,1(AB) ; GE ATOM + MOVEI 0,(C) + CAIGE 0,HIBOT ; SKIP IF PURE ATOM + JRST FINIS + +; MAKE ATOM AND VALUE IMPURE IF GETTING GLOC TO IT + + MOVE B,C ; ATOM TO B + PUSHJ P,IMPURIFY + JRST GLOC ; AND TRY AGAIN + +;TESTS TO SEE IF AN IDENTIFIER IS GLOBALLY ASSIGNED + +MFUNCTION GASSIG,SUBR,[GASSIGNED?] + JSP E,CHKAT2 + PUSHJ P,IGVAL + CAMN A,$TUNBOUND + JRST IFALSE + JRST TRUTH + +; TEST FOR GLOBALLY BOUND + +MFUNCTION GBOUND,SUBR,[GBOUND?] + + JSP E,CHKAT2 + PUSHJ P,IGLOC + JUMPE B,IFALSE + JRST TRUTH + + + +CHKAT2: ENTRY 1 +CHKAT1: GETYP A,(AB) + MOVSI A,(A) + CAME A,$TATOM + JRST NONATM + MOVE B,1(AB) + JRST (E) + +CHKAT: HLRE A,AB ; - # OF ARGS + ASH A,-1 ; TO ACTUAL WORDS + JUMPGE AB,TFA + MOVE C,SPSTOR+1 ; FOR BINDING LOOKUPS + AOJE A,CHKAT1 ; ONLY ONE ARG, NO ENVIRONMENT + AOJL A,TMA ; TOO MANY + GETYP A,2(AB) ; MAKE SURE OF TENV OR TFRAME + CAIE A,TFRAME + CAIN A,TENV + JRST CHKAT3 + CAIN A,TACT ; FOR PFISTERS LOSSAGE + JRST CHKAT3 + CAIE A,TPVP ; OR PROCESS + JRST WTYP2 + MOVE B,3(AB) ; GET PROCESS + MOVE C,SPSTOR+1 ; IN CASE ITS ME + CAME B,PVSTOR+1 ; SKIP IF DIFFERENT + MOVE C,SPSTO+1(B) ; GET ITS SP + JRST CHKAT1 +CHKAT3: MOVEI B,2(AB) ; POINT TO FRAME POINTER + PUSHJ P,CHFRM ; VALIDITY CHECK + MOVE B,3(AB) ; GET TB FROM FRAME + MOVE C,SPSAV(B) ; GET ENVIRONMENT POINTER + JRST CHKAT1 + + +; SILOC--CALLS ILOC IGNORING SPECIAL CHECKING + +SILOC: JFCL + +;ILOC RETURNS IN A AND B A LOCATIVE TO THE LOCAL VALUE OF THE IDENTIFIER +; PASSED TO IT IN A AND B. IF THE IDENTIFIER IS LOCALLY UNBOUND IT RETURNS +; $TUNBOUND IN A AND 0 IN B, IT IS CALLED BY PUSHJ P,ILOC. + +ILOC: MOVE C,SPSTOR+1 ; SETUP SEARCH START +AILOC: SKIPN (B) ; ANY KIND OF VALUE AT ALL? + JUMPN B,FUNPJ + MOVSI A,TLOCI ;MAKE A LOCATIVE TYPE CELL + PUSH P,E + PUSH P,D + MOVEI E,0 ; FLAG TO CLOBBER ATOM + JUMPE B,SCHSP ; IF LOOKING FOR SLOT, SEARCH NOW + CAME C,SPSTOR+1 ; ENVIRONMENT CHANGE? + JRST SCHSP ; YES, MUST SEARCH + MOVE PVP,PVSTOR+1 + HRR A,BINDID+1(PVP) ;FOR THE CURRENT PROCESS + CAME A,(B) ;IS THERE ONE IN THE VALUE CELL? + JRST SCHLP ;NO -- SEARCH THE LOCAL BINDINGS + MOVE B,1(B) ;YES -- GET LOCATIVE POINTER + MOVE C,PVP +ILCPJ: MOVE E,SPCCHK + TRNN E,1 ; SKIP IF DOING SPEC UNSPEC CHECK + JRST ILOCPJ + HRRZ E,-2(P) ; IF IGNORING, IGNORE + HRRZ E,-1(E) + CAIN E,SILOC + JRST ILOCPJ + HLRZ E,-2(B) + CAIE E,TUBIND + JRST ILOCPJ + CAMGE B,CURFCN+1(PVP) + JRST SCHLPX + MOVEI D,-2(B) + HRRZ SP,SPSTOR+1 + CAIG D,(SP) + CAMGE B,SPBASE+1(PVP) + JRST SCHLPX + MOVE C,PVSTOR+1 +ILOCPJ: POP P,D + POP P,E + POPJ P, ;FROM THE VALUE CELL + +SCHLPX: MOVEI E,1 + MOVE C,SPSTOR+1 + MOVE B,-1(B) + JRST SCHLP + + +SCHLP5: SETOM (P) + JRST SCHLP2 + +SCHLP: MOVEI D,(B) + CAIL D,HIBOT ; SKIP IF IMPURE ATOM +SCHSP: MOVEI E,1 ; DONT STORE LOCATIVE + + PUSH P,E ; PUSH SWITCH + MOVE E,PVSTOR+1 ; GET PROC +SCHLP1: JUMPE C,UNPJ ;IF NO MORE -- LOSE + CAMN B,1(C) ;ARE WE POINTING AT THE WINNER? + JRST SCHFND ;YES + GETYP D,(C) ; CHECK SKIP + CAIE D,TSKIP + JRST SCHLP2 + PUSH P,B ; CHECK DETOUR + MOVEI B,2(C) + PUSHJ P,CHFRAM ; NON-FATAL FRAME CHECKER + HRRZ E,2(C) ; CONS UP PROCESS + SUBI E,PVLNT*2+1 + HRLI E,-2*PVLNT + JUMPE B,SCHLP3 ; LOSER, FIX IT + POP P,B + MOVEI C,1(C) ; FOLLOW LOOKUP CHAIN +SCHLP2: HRRZ C,(C) ;FOLLOW LINK + JRST SCHLP1 + +SCHLP3: POP P,B + HRRZ SP,SPSTOR+1 + MOVEI C,(SP) ; *** NDR'S BUG *** + CAME E,PVSTOR+1 ; USE IF CURRENT PROCESS + HRRZ C,SPSTO+1(E) ; USE CURRENT SP FOR PROC + JRST SCHLP1 + +SCHFND: MOVE D,SPCCHK + TRNN D,1 ; SKIP IF DOING SPEC UNSPEC CHECK + JRST SCHFN1 + HRRZ D,-2(P) ; IF IGNORING, IGNORE + HRRZ D,-1(D) + CAIN D,SILOC + JRST ILOCPJ + HLRZ D,(C) + CAIE D,TUBIND + JRST SCHFN1 + HRRZ D,CURFCN+1(PVP) + CAIL D,(C) + JRST SCHLP5 + HRRZ SP,SPSTOR+1 + HRRZ D,SPBASE+1(PVP) + CAIL SP,(C) + CAIL D,(C) + JRST SCHLP5 + +SCHFN1: EXCH B,C ;SAVE THE ATOM PTR IN C + MOVEI B,2(B) ;MAKE UP THE LOCATIVE + SUB B,TPBASE+1(E) + HRLI B,(B) + ADD B,TPBASE+1(E) + EXCH C,E ; RET PROCESS IN C + POP P,D ; RESTORE SWITCH + + JUMPN D,ILOCPJ ; DONT CLOBBER ATOM + MOVEM A,(E) ;CLOBBER IT AWAY INTO THE + MOVE D,1(E) ; GET OLD POINTER + MOVEM B,1(E) ;ATOM'S VALUE CELL + JUMPE D,ILOCPJ ; IF POINTS TO GLOBAL OR OTHER PROCES + ; MAKE SURE BINDING SO INDICATES + MOVE D,B ; POINT TO BINDING + SKIPL E,3(D) ; GO TO FIRST ONE, JUST IN CASE + JRST .+3 + MOVE D,E + JRST .-3 ; LOOP THROUGH + MOVEI E,1 + MOVEM E,3(D) ; MAGIC INDICATION + JRST ILOCPJ + +UNPJ: SUB P,[1,,1] ; FLUSH CRUFT +UNPJ1: MOVE C,E ; RET PROCESS ANYWAY +UNPJ11: POP P,D + POP P,E +UNPOPJ: MOVSI A,TUNBOUND + MOVEI B,0 + POPJ P, + +FUNPJ: MOVE C,PVSTOR+1 + JRST UNPOPJ + +;IGLOC RETURNS IN A AND B A LOCATIVE TO THE GLOBAL VALUE OF THE +;IDENTIFIER PASSED TO IT IN A AND B. IF THE IDENTIFIER IS GLOBALLY +;UNBPOUND IT RETURNS $TUNBOUND IN A AND 0 IN B. IT IS CALLED BY PUSHJ P,IGLOC. + +IGLOC: MOVSI A,TLOCI ;DO WE HAVE A LOCATIVE TO + CAME A,(B) ;A PROCESS #0 VALUE? + JRST SCHGSP ;NO -- SEARCH + MOVE B,1(B) ;YES -- GET VALUE CELL + POPJ P, + +SCHGSP: SKIPN (B) + JRST UNPOPJ + MOVE D,GLOBSP+1 ;GET GLOBAL SP PTR + +SCHG1: JUMPGE D,UNPOPJ ;IF NO MORE, LEAVE + CAMN B,1(D) ;ARE WE FOUND? + JRST GLOCFOUND ;YES + ADD D,[4,,4] ;NO -- TRY NEXT + JRST SCHG1 + +GLOCFOUND: + EXCH B,D ;SAVE ATOM PTR + ADD B,[2,,2] ;MAKE LOCATIVE + MOVEI 0,(D) + CAIL 0,HIBOT + POPJ P, + MOVEM A,(D) ;CLOBBER IT AWAY + MOVEM B,1(D) + POPJ P, + +IIGLOC: PUSH TP,$TATOM + PUSH TP,B + PUSHJ P,IGLOC + MOVE C,(TP) + SUB TP,[2,,2] + GETYP 0,A + CAIE 0,TUNBOU + POPJ P, + PUSH TP,$TATOM + PUSH TP,C + MOVEI 0,(C) + MOVE B,C + CAIL 0,$TLOSE + PUSHJ P,IMPURI ; IMPURIFY THE POOR ATOM + PUSHJ P,BSETG ; MAKE A SLOT + SETOM 1(B) ; UNBOUNDIFY IT + MOVSI A,TLOCD + MOVSI 0,TUNBOU + MOVEM 0,(B) + SUB TP,[2,,2] + POPJ P, + + + +;ILVAL RETURNS IN A AND B THE LOCAL VALUE OF THE IDENTIFIER PASSED TO IT IN A AND B +;IF THE IDENTIFIER IS UNBOUND ITS VALUE IS $TUNBOUND IN A AND 0 IN B. IF +;IT IS UNASSIGNED ITS VALUE IS $TUNBOUND IN A AND -1 IN B. CALL - PUSHJ P,IVAL + +AILVAL: + PUSHJ P,AILOC ; USE SUPPLIED SP + JRST CHVAL +ILVAL: + PUSHJ P,ILOC ;GET LOCATIVE TO VALUE +CHVAL: CAMN A,$TUNBOUND ;BOUND + POPJ P, ;NO -- RETURN + MOVSI A,TLOCD ; GET GOOD TYPE + HRR A,2(B) ; SHOULD BE TIME OR 0 + PUSH P,0 + PUSHJ P,RMONC0 ; CHECK READ MONITOR + POP P,0 + MOVE A,(B) ;GET THE TYPE OF THE VALUE + MOVE B,1(B) ;GET DATUM + POPJ P, + +;IGVAL -- LIKE ILVAL EXCEPT FOR GLOBAL VALUES + +IGVAL: PUSHJ P,IGLOC + JRST CHVAL + + + +; COMPILERS INTERFACE TO LVAL/GVAL/SETG/SET + +CILVAL: MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; CURRENT BIND + HRLI 0,TLOCI + CAME 0,(B) ; HURRAY FOR SPEED + JRST CILVA1 ; TOO BAD + MOVE C,1(B) ; POINTER + MOVE A,(C) ; VAL TYPE + TLNE A,.RDMON ; MONITORS? + JRST CILVA1 + GETYP 0,A + CAIN 0,TUNBOU + JRST CUNAS ; COMPILER ERROR + MOVE B,1(C) ; GOT VAL + MOVE 0,SPCCHK + TRNN 0,1 + POPJ P, + HLRZ 0,-2(C) ; SPECIAL CHECK + CAIE 0,TUBIND + POPJ P, ; RETURN + MOVE PVP,PVSTOR+1 + CAMGE C,CURFCN+1(PVP) + JRST CUNAS + POPJ P, + +CUNAS: +CILVA1: SUBM M,(P) ; FIX (P) + PUSH TP,$TATOM ; SAVE ATOM + PUSH TP,B + MCALL 1,LVAL ; GET ERROR/MONITOR + +POPJM: SUBM M,(P) ; REPAIR DAMAGE + POPJ P, + +; COMPILERS INTERFACE TO SET C/ ATOM A,B/ NEW VALUE + +CISET: MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; CURRENT BINDING ENVIRONMENT + HRLI 0,TLOCI + CAME 0,(C) ; CAN WE WIN? + JRST CISET1 ; NO, MORE HAIR + MOVE D,1(C) ; POINT TO SLOT +CISET3: HLLZ 0,(D) ; MON CHECK + TLNE 0,.WRMON + JRST CISET4 ; YES, LOSE + TLZ 0,TYPMSK + IOR A,0 ; LEAVE MONITOR ON + MOVE 0,SPCCHK + TRNE 0,1 + JRST CISET5 ; SPEC/UNSPEC CHECK +CISET6: MOVEM A,(D) ; STORE + MOVEM B,1(D) + POPJ P, + +CISET5: HLRZ 0,-2(D) + CAIE 0,TUBIND + JRST CISET6 + MOVE PVP,PVSTOR+1 + CAMGE D,CURFCN+1(PVP) + JRST CISET4 + JRST CISET6 + +CISET1: SUBM M,(P) ; FIX ADDR + PUSH TP,$TATOM ; SAVE ATOM + PUSH TP,C + PUSH TP,A + PUSH TP,B + MOVE B,C ; GET ATOM + PUSHJ P,ILOC ; SEARCH + MOVE D,B ; POSSIBLE POINTER + GETYP E,A + MOVE 0,A + MOVE A,-1(TP) ; VAL BACK + MOVE B,(TP) + CAIE E,TUNBOU ; SKIP IF WIN + JRST CISET2 ; GO CLOBBER IT IN + MCALL 2,SET + JRST POPJM + +CISET2: MOVE C,-2(TP) ; ATOM BACK + SUBM M,(P) ; RESET (P) + SUB TP,[4,,4] + JRST CISET3 + +; HERE TO DO A MONITORED SET + +CISET4: SUBM M,(P) ; AGAIN FIX (P) + PUSH TP,$TATOM + PUSH TP,C + PUSH TP,A + PUSH TP,B + MCALL 2,SET + JRST POPJM + +; COMPILER LLOC + +CLLOC: MOVE PVP,PVSTOR+1 + MOVE 0,BINDID+1(PVP) ; GET CURRENT LOCATIVE + HRLI 0,TLOCI + CAME 0,(B) ; WIN? + JRST CLLOC1 + MOVE B,1(B) + MOVE 0,SPCCHK + TRNE 0,1 ; SKIP IF NOT CHECKING + JRST CLLOC9 +CLLOC3: MOVSI A,TLOCD + HRR A,2(B) ; GET BIND TIME + POPJ P, + +CLLOC1: SUBM M,(P) + PUSH TP,$TATOM + PUSH TP,B + PUSHJ P,ILOC ; LOOK IT UP + JUMPE B,CLLOC2 + SUB TP,[2,,2] +CLLOC4: SUBM M,(P) + JRST CLLOC3 + +CLLOC2: MCALL 1,LLOC + JRST CLLOC4 + +CLLOC9: HLRZ 0,-2(B) + CAIE 0,TUBIND + JRST CLLOC3 + MOVE PVP,PVSTOR+1 + CAMGE B,CURFCN+1(PVP) + JRST CLLOC2 + JRST CLLOC3 + +; COMPILER BOUND? + +CBOUND: SUBM M,(P) + PUSHJ P,ILOC + JUMPE B,PJFALS ; IF UNBOUND RET FALSE AND NO SSKIP +PJT1: SOS (P) + MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST POPJM + +PJFALS: MOVEI B,0 + MOVSI A,TFALSE + JRST POPJM + +; COMPILER ASSIGNED? + +CASSQ: SUBM M,(P) + PUSHJ P,ILOC + JUMPE B,PJFALS + GETYP 0,(B) + CAIE 0,TUNBOU + JRST PJT1 + JRST PJFALS + + +; COMPILER GVAL B/ ATOM + +CIGVAL: MOVE 0,(B) ; GLOBAL VAL HERE? + CAME 0,$TLOCI ; TIME=0 ,TYPE=TLOCI => GLOB VAL + JRST CIGVA1 ; NO, GO LOOK + MOVE C,1(B) ; POINT TO SLOT + MOVE A,(C) ; GET TYPE + TLNE A,.RDMON + JRST CIGVA1 + GETYP 0,A ; CHECK FOR UNBOUND + CAIN 0,TUNBOU ; SKIP IF WINNER + JRST CGUNAS + MOVE B,1(C) + POPJ P, + +CGUNAS: +CIGVA1: SUBM M,(P) + PUSH TP,$TATOM + PUSH TP,B + .MCALL 1,GVAL ; GET ERROR/MONITOR + JRST POPJM + +; COMPILER INTERFACET TO SETG + +CSETG: MOVE 0,(C) ; GET V CELL + CAME 0,$TLOCI ; SKIP IF FAST + JRST CSETG1 + HRRZ D,1(C) ; POINT TO SLOT + MOVE 0,(D) ; OLD VAL +CSETG3: CAIG D,HIBOT ; SKIP IF PURE ATOM + TLNE 0,.WRMON ; MONITOR + JRST CSETG2 + MOVEM A,(D) + MOVEM B,1(D) + POPJ P, + +CSETG1: SUBM M,(P) ; FIX UP P + PUSH TP,$TATOM + PUSH TP,C + PUSH TP,A + PUSH TP,B + MOVE B,C + PUSHJ P,IGLOC ; FIND GLOB LOCATIVE + GETYP E,A + MOVE 0,A + MOVEI D,(B) ; SETUP TO RESTORE NEW VAL + MOVE A,-1(TP) + MOVE B,(TP) + CAIE E,TUNBOU + JRST CSETG4 + MCALL 2,SETG + JRST POPJM + +CSETG4: MOVE C,-2(TP) ; ATOM BACK + SUBM M,(P) ; RESET (P) + SUB TP,[4,,4] + JRST CSETG3 + +CSETG2: SUBM M,(P) + PUSH TP,$TATOM ; CAUSE A SETG MONITOR + PUSH TP,C + PUSH TP,A + PUSH TP,B + MCALL 2,SETG + JRST POPJM + +; COMPILER GLOC + +CGLOC: MOVE 0,(B) ; GET CURRENT GUY + CAME 0,$TLOCI ; WIN? + JRST CGLOC1 ; NOPE + HRRZ D,1(B) ; POINT TO SLOT + CAILE D,HIBOT ; PURE? + JRST CGLOC1 + MOVE A,$TLOCD + MOVE B,1(B) + POPJ P, + +CGLOC1: SUBM M,(P) + PUSH TP,$TATOM + PUSH TP,B + MCALL 1,GLOC + JRST POPJM + +; COMPILERS GASSIGNED? + +CGASSQ: MOVE 0,(B) + SUBM M,(P) + CAMN 0,$TLOCD + JRST PJT1 + PUSHJ P,IGLOC + JUMPE B,PJFALS + GETYP 0,(B) + CAIE 0,TUNBOU + JRST PJT1 + JRST PJFALS + +; COMPILERS GBOUND? + +CGBOUN: MOVE 0,(B) + SUBM M,(P) + CAMN 0,$TLOCD + JRST PJT1 + PUSHJ P,IGLOC + JUMPE B,PJFALS + JRST PJT1 + + +IMFUNCTION REP,FSUBR,[REPEAT] + JRST PROG +MFUNCTION BIND,FSUBR + JRST PROG +IMFUNCTION PROG,FSUBR + ENTRY 1 + GETYP A,(AB) ;GET ARG TYPE + CAIE A,TLIST ;IS IT A LIST? + JRST WRONGT ;WRONG TYPE + SKIPN C,1(AB) ;GET AND CHECK ARGUMENT + JRST TFA ;TOO FEW ARGS + SETZB E,D ; INIT HEWITT ATOM AND DECL + PUSHJ P,CARATC ; IS 1ST THING AN ATOM + JFCL + PUSHJ P,RSATY1 ; CDR AND GET TYPE + CAIE 0,TLIST ; MUST BE LIST + JRST MPD.13 + MOVE B,1(C) ; GET ARG LIST + PUSH TP,$TLIST + PUSH TP,C + PUSHJ P,RSATYP + CAIE 0,TDECL + JRST NOP.DC ; JUMP IF NO DCL + MOVE D,1(C) + MOVEM C,(TP) + PUSHJ P,RSATYP ; CDR ON +NOP.DC: PUSH TP,$TLIST + PUSH TP,B ; AND ARG LIST + PUSHJ P,PRGBND ; BIND AUX VARS + HRRZ E,FSAV(TB) + CAIE E,BIND + SKIPA E,IMQUOTE LPROG,[LPROG ]INTRUP + JRST .+3 + PUSHJ P,MAKACT ; MAKE ACTIVATION + PUSHJ P,PSHBND ; BIND AND CHECK + PUSHJ P,SPECBI ; NAD BIND IT + +; HERE TO RUN PROGS FUNCTIONS ETC. + +DOPROG: MOVEI A,REPROG + HRLI A,TDCLI ; FLAG AS FUNNY + MOVEM A,(TB) ; WHERE TO AGAIN TO + MOVE C,1(TB) + MOVEM C,3(TB) ; RESTART POINTER + JRST .+2 ; START BY SKIPPING DECL + +DOPRG1: PUSHJ P,FASTEV + HRRZ C,@1(TB) ;GET THE REST OF THE BODY +DOPRG2: MOVEM C,1(TB) + JUMPN C,DOPRG1 +ENDPROG: + HRRZ C,FSAV(TB) + CAIN C,REP +REPROG: SKIPN C,@3(TB) + JRST PFINIS + HRRZM C,1(TB) + INTGO + MOVE C,1(TB) + JRST DOPRG1 + + +PFINIS: GETYP 0,(TB) + CAIE 0,TDCLI ; DECL'D ? + JRST PFINI1 + HRRZ 0,(TB) ; SEE IF RSUBR + JUMPE 0,RSBVCK ; CHECK RSUBR VALUE + HRRZ C,3(TB) ; GET START OF FCN + GETYP 0,(C) ; CHECK FOR DECL + CAIE 0,TDECL + JRST PFINI1 ; NO, JUST RETURN + MOVE E,IMQUOTE VALUE + PUSHJ P,PSHBND ; BUILD FAKE BINDING + MOVE C,1(C) ; GET DECL LIST + MOVE E,TP + PUSHJ P,CHKDCL ; AND CHECK IT + MOVE A,-3(TP) ; GET VAL BAKC + MOVE B,-2(TP) + SUB TP,[6,,6] + +PFINI1: HRRZ C,FSAV(TB) + CAIE C,EVAL + JRST FINIS + JRST EFINIS + +RSATYP: HRRZ C,(C) +RSATY1: JUMPE C,TFA + GETYP 0,(C) + POPJ P, + +; HERE TO CHECK RSUBR VALUE + +RSBVCK: PUSH TP,A + PUSH TP,B + MOVE C,A + MOVE D,B + MOVE A,1(TB) ; GET DECL + MOVE B,1(A) + HLLZ A,(A) + PUSHJ P,TMATCH + JRST RSBVC1 + POP TP,B + POP TP,A + POPJ P, + +RSBVC1: MOVE C,1(TB) + POP TP,B + POP TP,D + MOVE A,IMQUOTE VALUE + JRST TYPMIS + + +MFUNCTION MRETUR,SUBR,[RETURN] + ENTRY + HLRE A,AB ; GET # OF ARGS + ASH A,-1 ; TO NUMBER + AOJL A,RET2 ; 2 OR MORE ARGS + PUSHJ P,PROGCH ;CHECK IN A PROG + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) ; VERIFY IT +COMRET: PUSHJ P,CHFSWP + SKIPL C ; ARGS? + MOVEI C,0 ; REAL NONE + PUSHJ P,CHUNW + JUMPN A,CHFINI ; WINNER + MOVSI A,TATOM + MOVE B,IMQUOTE T + +; SEE IF MUST CHECK RETURNS TYPE + +CHFINI: GETYP 0,(TB) ; SPECIAL TYPE IF SO + CAIE 0,TDCLI + JRST FINIS ; NO, JUST FINIS + MOVEI 0,PFINIS ; CAUSE TO FALL INTO FUNCTION CODE + HRRM 0,PCSAV(TB) + JRST CONTIN + + +RET2: AOJL A,TMA + GETYP A,(AB)+2 + CAIE A,TACT ; AS FOR "EXIT" SHOULD BE ACTIVATION + JRST WTYP2 + MOVEI B,(AB)+2 ; ADDRESS OF FRAME POINTER + JRST COMRET + + + +MFUNCTION AGAIN,SUBR + ENTRY + HLRZ A,AB ;GET # OF ARGS + CAIN A,-2 ;1 ARG? + JRST NLCLA ;YES + JUMPN A,TMA ;0 ARGS? + PUSHJ P,PROGCH ;CHECK FOR IN A PROG + PUSH TP,A + PUSH TP,B + JRST AGAD +NLCLA: GETYP A,(AB) + CAIE A,TACT + JRST WTYP1 + PUSH TP,(AB) + PUSH TP,1(AB) +AGAD: MOVEI B,-1(TP) ; POINT TO FRAME + PUSHJ P,CHFSWP + HRRZ C,(B) ; GET RET POINT +GOJOIN: PUSH TP,$TFIX + PUSH TP,C + MOVEI C,-1(TP) + PUSHJ P,CHUNW ; RESTORE FRAME, UNWIND IF NEC. + HRRM B,PCSAV(TB) + HRRZ 0,FSAV(TB) ; CHECK FOR RSUBR + CAIGE 0,HIBOT + CAIGE 0,STOSTR + JRST CONTIN + HRRZ E,1(TB) + PUSH TP,$TFIX + PUSH TP,B + MOVEI C,-1(TP) + MOVEI B,(TB) + PUSHJ P,CHUNW1 + MOVE TP,1(TB) + MOVE SP,SPSTOR+1 + MOVEM SP,SPSAV(TB) + MOVEM TP,TPSAV(TB) + MOVE C,OTBSAV(TB) ; AND RESTORE P FROM FATHER + MOVE P,PSAV(C) + MOVEM P,PSAV(TB) + SKIPGE PCSAV(TB) + HRLI B,400000+M + MOVEM B,PCSAV(TB) + JRST CONTIN + +MFUNCTION GO,SUBR + ENTRY 1 + GETYP A,(AB) + CAIE A,TATOM + JRST NLCLGO + PUSHJ P,PROGCH ;CHECK FOR A PROG + PUSH TP,A ;SAVE + PUSH TP,B + MOVEI B,-1(TP) + PUSHJ P,CHFSWP + PUSH TP,$TATOM + PUSH TP,1(C) + PUSH TP,2(B) + PUSH TP,3(B) + MCALL 2,MEMQ ;DOES IT HAVE THIS TAG? + JUMPE B,NXTAG ;NO -- ERROR +FNDGO: EXCH B,(TP) ;SAVE PLACE TO GO + MOVSI D,TLIST + MOVEM D,-1(TP) + JRST GODON + +NLCLGO: CAIE A,TTAG ;CHECK TYPE + JRST WTYP1 + MOVE B,1(AB) + MOVEI B,2(B) ; POINT TO SLOT + PUSHJ P,CHFSWP + MOVE A,1(C) + GETYP 0,(A) ; SEE IF COMPILED + CAIE 0,TFIX + JRST GODON1 + MOVE C,1(A) + JRST GOJOIN + +GODON1: PUSH TP,(A) ;SAVE BODY + PUSH TP,1(A) +GODON: MOVEI C,0 + PUSHJ P,CHUNW ;GO BACK TO CORRECT FRAME + MOVE B,(TP) ;RESTORE ITERATION MARKER + MOVEM B,1(TB) + MOVSI A,TATOM + MOVE B,1(B) + JRST CONTIN + + + + +MFUNCTION TAG,SUBR + ENTRY + JUMPGE AB,TFA + HLRZ 0,AB + GETYP A,(AB) ;GET TYPE OF ARGUMENT + CAIE A,TFIX ; FIX ==> COMPILED + JRST ATOTAG + CAIE 0,-4 + JRST WNA + GETYP A,2(AB) + CAIE A,TACT + JRST WTYP2 + PUSH TP,(AB) + PUSH TP,1(AB) + PUSH TP,2(AB) + PUSH TP,3(AB) + JRST GENTV +ATOTAG: CAIE A,TATOM ;CHECK THAT IT IS AN ATOM + JRST WTYP1 + CAIE 0,-2 + JRST TMA + PUSHJ P,PROGCH ;CHECK PROG + PUSH TP,A ;SAVE VAL + PUSH TP,B + PUSH TP,$TATOM + PUSH TP,1(AB) + PUSH TP,2(B) + PUSH TP,3(B) + MCALL 2,MEMQ + JUMPE B,NXTAG ;IF NOT FOUND -- ERROR + EXCH A,-1(TP) ;SAVE PLACE + EXCH B,(TP) + HRLI A,TFRAME + PUSH TP,A + PUSH TP,B +GENTV: MOVEI A,2 + PUSHJ P,IEVECT + MOVSI A,TTAG + JRST FINIS + +PROGCH: MOVE B,IMQUOTE LPROG,[LPROG ]INTRUP + PUSHJ P,ILVAL ;GET VALUE + GETYP 0,A + CAIE 0,TACT + JRST NXPRG + POPJ P, + +; HERE TO UNASSIGN LPROG IF NEC + +UNPROG: MOVE B,IMQUOTE LPROG,[LPROG ]INTRUP + PUSHJ P,ILVAL + GETYP 0,A + CAIE 0,TACT ; SKIP IF MUST UNBIND + JRST UNMAP + MOVSI A,TUNBOU + MOVNI B,1 + MOVE E,IMQUOTE LPROG,[LPROG ]INTRUP + PUSHJ P,PSHBND +UNMAP: HRRZ 0,FSAV(TB) ; CHECK FOR FUNNY + CAIN 0,MAPPLY ; SKIP IF NOT + POPJ P, + MOVE B,IMQUOTE LMAP,[LMAP ]INTRUP + PUSHJ P,ILVAL + GETYP 0,A + CAIE 0,TFRAME + JRST UNSPEC + MOVSI A,TUNBOU + MOVNI B,1 + MOVE E,IMQUOTE LMAP,[LMAP ]INTRUP + PUSHJ P,PSHBND +UNSPEC: PUSH TP,BNDV + MOVE B,PVSTOR+1 + ADD B,[CURFCN,,CURFCN] + PUSH TP,B + PUSH TP,$TSP + MOVE E,SPSTOR+1 + ADD E,[3,,3] + PUSH TP,E + POPJ P, + +REPEAT 0,[ +MFUNCTION MEXIT,SUBR,[EXIT] + ENTRY 2 + GETYP A,(AB) + CAIE A,TACT + JRST WTYP1 + MOVEI B,(AB) + PUSHJ P,CHFSWP + ADD C,[2,,2] + PUSHJ P,CHUNW ;RESTORE FRAME + JRST CHFINI ; CHECK FOR WINNING VALUE +] + +MFUNCTION COND,FSUBR + ENTRY 1 + GETYP A,(AB) + CAIE A,TLIST + JRST WRONGT + PUSH TP,(AB) + PUSH TP,1(AB) ;CREATE UNNAMED TEMP + MOVEI B,0 ; SET TO FALSE IN CASE + +CLSLUP: SKIPN C,1(TB) ;IS THE CLAUSELIST NIL? + JRST IFALS1 ;YES -- RETURN NIL + GETYP A,(C) ;NO -- GET TYPE OF CAR + CAIE A,TLIST ;IS IT A LIST? + JRST BADCLS ; + MOVE A,1(C) ;YES -- GET CLAUSE + JUMPE A,BADCLS + GETYPF B,(A) + PUSH TP,B ; EVALUATION OF + HLLZS (TP) + PUSH TP,1(A) ;THE PREDICATE + JSP E,CHKARG + MCALL 1,EVAL + GETYP 0,A + CAIN 0,TFALSE + JRST NXTCLS ;FALSE TRY NEXT CLAUSE + MOVE C,1(TB) ;IF NOT, DO FIRST CLAUSE + MOVE C,1(C) + HRRZ C,(C) + JUMPE C,FINIS ;(UNLESS DONE WITH IT) + JRST DOPRG2 ;AS THOUGH IT WERE A PROG +NXTCLS: HRRZ C,@1(TB) ;SET THE CLAUSLIST + HRRZM C,1(TB) ;TO CDR OF THE CLAUSLIST + JRST CLSLUP + +IFALSE: + MOVEI B,0 +IFALS1: MOVSI A,TFALSE ;RETURN FALSE + JRST FINIS + + + +MFUNCTION UNWIND,FSUBR + + ENTRY 1 + + GETYP 0,(AB) ; CHECK THE ARGS FOR WINNAGE + SKIPN A,1(AB) ; NONE? + JRST TFA + HRRZ B,(A) ; CHECK FOR 2D + JUMPE B,TFA + HRRZ 0,(B) ; 3D? + JUMPN 0,TMA + +; Unbind LPROG and LMAPF so that nothing cute happens + + PUSHJ P,UNPROG + +; Push thing to do upon UNWINDing + + PUSH TP,$TLIST + PUSH TP,[0] + + MOVEI C,UNWIN1 + PUSHJ P,IUNWIN ; GOT TO INTERNAL SET UP + +; Now EVAL the first form + + MOVE A,1(AB) + HRRZ 0,(A) ; SAVE POINTER TO OTHER GUY + MOVEM 0,-12(TP) + MOVE B,1(A) + GETYP A,(A) + MOVSI A,(A) + JSP E,CHKAB ; DEFER? + PUSH TP,A + PUSH TP,B + MCALL 1,EVAL ; EVAL THE LOSER + + JRST FINIS + +; Now push slots to hold undo info on the way down + +IUNWIN: JUMPE M,NOUNRE + HLRE 0,M ; CHECK BOUNDS + SUBM M,0 + ANDI 0,-1 + CAIL C,(M) + CAML C,0 + JRST .+2 + SUBI C,(M) + +NOUNRE: PUSH TP,$TTB ; DESTINATION FRAME + PUSH TP,[0] + PUSH TP,[0] ; ARGS TO WHOEVER IS DOING IT + PUSH TP,[0] + +; Now bind UNWIND word + + PUSH TP,$TUNWIN ; FIRST WORD OF IT + MOVE SP,SPSTOR+1 + HRRM SP,(TP) ; CHAIN + MOVEM TP,SPSTOR+1 + PUSH TP,TB ; AND POINT TO HERE + PUSH TP,$TTP + PUSH TP,[0] + HRLI C,TPDL + PUSH TP,C + PUSH TP,P ; SAVE PDL ALSO + MOVEM TP,-2(TP) ; SAVE FOR LATER + POPJ P, + +; Do a non-local return with UNWIND checking + +CHUNW: HRRZ E,SPSAV(B) ; GET DESTINATION FRAME +CHUNW1: PUSH TP,(C) ; FINAL VAL + PUSH TP,1(C) + JUMPN C,.+3 ; WAS THERE REALLY ANYTHING + SETZM (TP) + SETZM -1(TP) + PUSHJ P,STLOOP ; UNBIND +CHUNPC: SKIPA ; WILL NOT SKIP UNLESS UNWIND FOUND + JRST GOTUND + MOVEI A,(TP) + SUBI A,(SP) + MOVSI A,(A) + HLL SP,TP + SUB SP,A + MOVEM SP,SPSTOR+1 + HRRI TB,(B) ; UPDATE TB + PUSHJ P,UNWFRMS + POP TP,B + POP TP,A + POPJ P, + +POPUNW: MOVE SP,SPSTOR+1 + HRRZ SP,(SP) + MOVEI E,(TP) + SUBI E,(SP) + MOVSI E,(E) + HLL SP,TP + SUB SP,E + MOVEM SP,SPSTOR+1 + POPJ P, + + +UNWFRM: JUMPE FRM,CPOPJ + MOVE B,FRM +UNWFR2: JUMPE B,UNWFR1 + CAMG B,TPSAV(TB) + JRST UNWFR1 + MOVE B,(B) + JRST UNWFR2 + +UNWFR1: MOVE FRM,B + POPJ P, + +; Here if an UNDO found + +GOTUND: MOVE TB,1(SP) ; GET FRAME OF UNDO + MOVE A,-1(TP) ; GET FUNNY ARG FOR PASS ON + MOVE C,(TP) + MOVE TP,3(SP) ; GET FUTURE TP + MOVEM C,-6(TP) ; SAVE ARG + MOVEM A,-7(TP) + MOVE C,(TP) ; SAVED P + SUB C,[1,,1] + MOVEM C,PSAV(TB) ; MAKE CONTIN WIN + MOVEM TP,TPSAV(TB) + MOVEM SP,SPSAV(TB) + HRRZ C,(P) ; PC OF CHUNW CALLER + HRRM C,-11(TP) ; SAVE ALSO AND GET WHERE TO GO PC + MOVEM B,-10(TP) ; AND DESTINATION FRAME + HRRZ C,-1(TP) ; WHERE TO UNWIND PC + HRRZ 0,FSAV(TB) ; RSUBR? + CAIGE 0,HIBOT + CAIGE 0,STOSTR + JRST .+3 + SKIPGE PCSAV(TB) + HRLI C,400000+M + MOVEM C,PCSAV(TB) + JRST CONTIN + +UNWIN1: MOVE B,-12(TP) ; POINT TO THING TO DO UNWINDING + GETYP A,(B) + MOVSI A,(A) + MOVE B,1(B) + JSP E,CHKAB + PUSH TP,A + PUSH TP,B + MCALL 1,EVAL +UNWIN2: MOVEI C,-7(TP) ; POINT TO SAVED RET VALS + MOVE B,-10(TP) + HRRZ E,-11(TP) + PUSH P,E + MOVE SP,SPSTOR+1 + HRRZ SP,(SP) ; UNBIND THIS GUY + MOVEI E,(TP) ; AND FIXUP SP + SUBI E,(SP) + MOVSI E,(E) + HLL SP,TP + SUB SP,E + MOVEM SP,SPSTOR+1 + JRST CHUNW ; ANY MORE TO UNWIND? + + +; CHFSWP - CHECK FRAMES VALIDITY AND SWAP PROCESS IF NECESSARY. +; CALLED BY ALL CONTROL FLOW +; ROUTINES (GO,RETURN,EXIT,AGAIN,ERRET...) + +CHFSWP: PUSHJ P,CHFRM ; CHECK FOR VALID FRAME + HRRZ D,(B) ; PROCESS VECTOR DOPE WD + HLRZ C,(D) ; LENGTH + SUBI D,-1(C) ; POINT TO TOP + MOVNS C ; NEGATE COUNT + HRLI D,2(C) ; BUILD PVP + MOVE E,PVSTOR+1 + MOVE C,AB + MOVE A,(B) ; GET FRAME + MOVE B,1(B) + CAMN E,D ; SKIP IF SWAP NEEDED + POPJ P, + PUSH TP,A ; SAVE FRAME + PUSH TP,B + MOVE B,D + PUSHJ P,PROCHK ; FIX UP PROCESS LISTS + MOVE A,PSTAT+1(B) ; GET STATE + CAIE A,RESMBL + JRST NOTRES + MOVE D,B ; PREPARE TO SWAP + POP P,0 ; RET ADDR + POP TP,B + POP TP,A + JSP C,SWAP ; SWAP IN + MOVE C,ABSTO+1(E) ; GET OLD ARRGS + MOVEI A,RUNING ; FIX STATES + MOVE PVP,PVSTOR+1 + MOVEM A,PSTAT+1(PVP) + MOVEI A,RESMBL + MOVEM A,PSTAT+1(E) + JRST @0 + +NOTRES: ERRUUO EQUOTE PROCESS-NOT-RESUMABLE + + +;SETG IS USED TO SET THE GLOBAL VALUE OF ITS FIRST ARGUMENT, +;AN IDENTIFIER, TO THE VALUE OF ITS SECOND ARGUMENT. ITS VALUE IS +; ITS SECOND ARGUMENT. + +IMFUNCTION SETG,SUBR + ENTRY 2 + GETYP A,(AB) ;GET TYPE OF FIRST ARGUMENT + CAIE A,TATOM ;CHECK THAT IT IS AN ATOM + JRST NONATM ;IF NOT -- ERROR + MOVE B,1(AB) ;GET POINTER TO ATOM + PUSH TP,$TATOM + PUSH TP,B + MOVEI 0,(B) + CAIL 0,HIBOT ; PURE ATOM? + PUSHJ P,IMPURIFY ; YES IMPURIFY + PUSHJ P,IGLOC ;GET LOCATIVE TO VALUE + CAME A,$TUNBOUND ;IF BOUND + JRST GOOST1 + SKIPN NOSETG ; ALLOWED? + JRST GOOSTG ; YES + PUSH TP,$TATOM + PUSH TP,EQUOTE CREATING-NEW-GVAL + PUSH TP,$TATOM + PUSH TP,1(AB) + PUSH TP,$TATOM + PUSH TP,EQUOTE NON-FALSE-TO-ALLOW + MCALL 3,ERROR + GETYP 0,A + CAIN 0,TFALSE + JRST FINIS +GOOSTG: PUSHJ P,BSETG ;IF NOT -- BIND IT +GOOST1: MOVE C,2(AB) ; GET PROPOSED VVAL + MOVE D,3(AB) + MOVSI A,TLOCD ; MAKE SURE MONCH WINS + PUSHJ P,MONCH0 ; WOULD YOU BELIEVE MONITORS!!!! + EXCH D,B ;SAVE PTR + MOVE A,C + HRRZ E,-2(D) ; POINT TO POSSIBLE GDECL (OR MAINIFEST) + JUMPE E,OKSETG ; NONE ,OK + CAIE E,-1 ; MANIFEST? + JRST SETGTY + GETYP 0,(D) ; IF UNBOUND, LET IT HAPPEN + SKIPN IGDECL + CAIN 0,TUNBOU + JRST OKSETG +MANILO: GETYP C,(D) + GETYP 0,2(AB) + CAIN 0,(C) + CAME B,1(D) + JRST .+2 + JRST OKSETG + PUSH TP,$TVEC + PUSH TP,D + MOVE B,IMQUOTE REDEFINE + PUSHJ P,ILVAL ; SEE IF REDEFINE OK + GETYP A,A + CAIE A,TUNBOU + CAIN A,TFALSE + JRST .+2 + JRST OKSTG + PUSH TP,$TATOM + PUSH TP,EQUOTE ATTEMPT-TO-CHANGE-MANIFEST-VARIABLE + PUSH TP,$TATOM + PUSH TP,1(AB) + MOVEI A,2 + JRST CALER + +SETGTY: PUSH TP,$TVEC + PUSH TP,D + MOVE C,A + MOVE D,B + GETYP A,(E) + MOVSI A,(A) + MOVE B,1(E) + JSP E,CHKAB + PUSHJ P,TMATCH + JRST TYPMI3 + +OKSTG: MOVE D,(TP) + MOVE A,2(AB) + MOVE B,3(AB) + +OKSETG: MOVEM A,(D) ;DEPOSIT INTO THE + MOVEM B,1(D) ;INDICATED VALUE CELL + JRST FINIS + +TYPMI3: MOVE C,(TP) + HRRZ C,-2(C) + MOVE D,2(AB) + MOVE B,3(AB) + MOVE 0,(AB) + MOVE A,1(AB) + JRST TYPMIS + +BSETG: HRRZ A,GLOBASE+1 + HRRZ B,GLOBSP+1 + SUB B,A + CAIL B,6 + JRST SETGIT + MOVEI B,0 ; MAKE SURE OF NO EMPTY SLOTS + PUSHJ P,IGLOC + CAMN A,$TUNBOU ; SKIP IF SLOT FOUND + JRST BSETG1 + MOVE C,(TP) ; GET ATOM + MOVEM C,-1(B) ; CLOBBER ATOM SLOT + HLLZS -2(B) ; CLOBBER OLD DECL + JRST BSETGX +; BSETG1: PUSH TP,GLOBASE ; MUST REALLY GROW STACK +; PUSH TP,GLOBASE+1 +; PUSH TP,$TFIX +; PUSH TP,[0] +; PUSH TP,$TFIX +; PUSH TP,[100] +; MCALL 3,GROW +BSETG1: PUSH P,0 + PUSH P,C + MOVE C,GLOBASE+1 + HLRE B,C + SUB C,B + MOVE B,GVLINC ; GROW BY INDICATED GVAL SLOTS + DPB B,[001100,,(C)] +; MOVEM A,GLOBASE + MOVE C,[6,,4] ; INDICATOR FOR AGC + PUSHJ P,AGC + MOVE B,GLOBASE+1 + MOVE 0,GVLINC ; ADJUST GLOBAL SPBASE + ASH 0,6 + SUB B,0 + HRLZS 0 + SUB B,0 + MOVEM B,GLOBASE+1 +; MOVEM B,GLOBASE+1 + POP P,0 + POP P,C +SETGIT: + MOVE B,GLOBSP+1 + SUB B,[4,,4] + MOVSI C,TGATOM + MOVEM C,(B) + MOVE C,(TP) + MOVEM C,1(B) + MOVEM B,GLOBSP+1 + ADD B,[2,,2] +BSETGX: MOVSI A,TLOCI + PUSHJ P,PATSCH ; FIXUP SCHLPAGE + MOVEM A,(C) + MOVEM B,1(C) + POPJ P, + +PATSCH: GETYP 0,(C) + CAIN 0,TLOCI + SKIPL D,1(C) + POPJ P, + +PATL: SKIPL E,3(D) ; SKIP IF NEXT EXISTS + JRST PATL1 + MOVE D,E + JRST PATL + +PATL1: MOVEI E,1 + MOVEM E,3(D) ; SAY GVAL ETC. EXISTS IF WE UNBIND + POPJ P, + + +IMFUNCTION DEFMAC,FSUBR + + ENTRY 1 + + PUSH P,. + JRST DFNE2 + +IMFUNCTION DFNE,FSUBR,[DEFINE] + + ENTRY 1 + + PUSH P,[0] +DFNE2: GETYP A,(AB) + CAIE A,TLIST + JRST WRONGT + SKIPN B,1(AB) ; GET ATOM + JRST TFA + GETYP A,(B) ; MAKE SURE ATOM + MOVSI A,(A) + PUSH TP,A + PUSH TP,1(B) + JSP E,CHKARG + MCALL 1,EVAL ; EVAL IT TO AN ATOM + CAME A,$TATOM + JRST NONATM + PUSH TP,A ; SAVE TWO COPIES + PUSH TP,B + PUSHJ P,IGVAL ; SEE IF A VALUE EXISTS + CAMN A,$TUNBOU ; SKIP IF A WINNER + JRST .+3 + PUSHJ P,ASKUSR ; CHECK WITH USER + JRST DFNE1 + PUSH TP,$TATOM + PUSH TP,-1(TP) + MOVE B,1(AB) + HRRZ B,(B) + MOVSI A,TEXPR + SKIPN (P) ; SKIP IF MACRO + JRST DFNE3 + MOVEI D,(B) ; READY TO CONS + MOVSI C,TEXPR + PUSHJ P,INCONS + MOVSI A,TMACRO +DFNE3: PUSH TP,A + PUSH TP,B + MCALL 2,SETG +DFNE1: POP TP,B ; RETURN ATOM + POP TP,A + JRST FINIS + + +ASKUSR: MOVE B,IMQUOTE REDEFINE + PUSHJ P,ILVAL ; SEE IF REDEFINE OK + GETYP A,A + CAIE A,TUNBOU + CAIN A,TFALSE + JRST ASKUS1 + JRST ASKUS2 +ASKUS1: PUSH TP,$TATOM + PUSH TP,-1(TP) + PUSH TP,$TATOM + PUSH TP,EQUOTE ALREADY-DEFINED-ERRET-NON-FALSE-TO-REDEFINE + MCALL 2,ERROR + GETYP 0,A + CAIE 0,TFALSE +ASKUS2: AOS (P) + MOVE B,1(AB) + POPJ P, + + + +;SET CLOBBERS THE LOCAL VALUE OF THE IDENTIFIER GIVEN BY ITS +;FIRST ARGUMENT TO THE SECOND ARG. ITS VALUE IS ITS SECOND ARGUMENT. + +IMFUNCTION SET,SUBR + HLRE D,AB ; 2 TIMES # OF ARGS TO D + ASH D,-1 ; - # OF ARGS + ADDI D,2 + JUMPG D,TFA ; NOT ENOUGH + MOVE B,PVSTOR+1 + MOVE C,SPSTOR+1 + JUMPE D,SET1 ; NO ENVIRONMENT + AOJL D,TMA ; TOO MANY + GETYP A,4(AB) ; CHECK ARG IS A FRAME OR PROCESS + CAIE A,TFRAME + CAIN A,TENV + JRST SET2 ; WINNING ENVIRONMENT/FRAME + CAIN A,TACT + JRST SET2 ; TO MAKE PFISTER HAPPY + CAIE A,TPVP + JRST WTYP2 + MOVE B,5(AB) ; GET PROCESS + MOVE C,SPSTO+1(B) + JRST SET1 +SET2: MOVEI B,4(AB) ; POINT TO FRAME + PUSHJ P,CHFRM ; CHECK IT OUT + MOVE B,5(AB) ; GET IT BACK + MOVE C,SPSAV(B) ; GET BINDING POINTER + HRRZ B,4(AB) ; POINT TO PROCESS + HLRZ A,(B) ; GET LENGTH + SUBI B,-1(A) ; POINT TO START THEREOF + HLL B,PVSTOR+1 ; GET -LNTRH, (ALL PROCESS VECS SAME LENGTH) +SET1: PUSH TP,$TPVP ; SAVE PROCESS + PUSH TP,B + PUSH TP,$TSP ; SAVE PATH POINTER + PUSH TP,C + GETYP A,(AB) ;GET TYPE OF FIRST + CAIE A,TATOM ;ARGUMENT -- + JRST WTYP1 ;BETTER BE AN ATOM + MOVE B,1(AB) ;GET PTR TO IT + MOVEI 0,(B) + CAIL 0,HIBOT + PUSHJ P,IMPURIFY + MOVE C,(TP) + PUSHJ P,AILOC ;GET LOCATIVE TO VALUE +GOTLOC: CAME A,$TUNBOUND ;IF BOUND + JRST GOOSE1 + SKIPN NOSET ; ALLOWED? + JRST GOOSET ; YES + PUSH TP,$TATOM + PUSH TP,EQUOTE CREATING-NEW-LVAL + PUSH TP,$TATOM + PUSH TP,1(AB) + PUSH TP,$TATOM + PUSH TP,EQUOTE NON-FALSE-TO-ALLOW + MCALL 3,ERROR + GETYP 0,A + CAIN 0,TFALSE + JRST FINIS +GOOSET: PUSHJ P,BSET ;IF NOT -- BIND IT +GOOSE1: MOVE C,2(AB) ; GET PROPOSED VVAL + MOVE C,2(AB) ; GET NEW VAL + MOVE D,3(AB) + MOVSI A,TLOCD ; FOR MONCH + HRR A,2(B) + PUSHJ P,MONCH0 ; HURRAY FOR MONITORS!!!!! + MOVE E,B + HLRZ A,2(E) ; GET DECLS + JUMPE A,SET3 ; NONE, GO + PUSH TP,$TSP + PUSH TP,E + MOVE B,1(A) + HLLZ A,(A) ; GET PATTERN + PUSHJ P,TMATCH ; MATCH TMEM + JRST TYPMI2 ; LOSES + MOVE E,(TP) + SUB TP,[2,,2] + MOVE C,2(AB) + MOVE D,3(AB) +SET3: MOVEM C,(E) ;CLOBBER IDENTIFIER + MOVEM D,1(E) + MOVE A,C + MOVE B,D + MOVE C,-2(TP) ; GET PROC + HRRZ C,BINDID+1(C) + HRLI C,TLOCI + +; HERE WE NOTE THAT EFFICIENCY CAN SOMETIMES GET IN THE WAY OF CORRECTNESS +; BY SETTING THE SHALLOW BINDING WE MANAGE TO CLOBBER THE TOP LEVEL LVAL +; EVEN IF WE ARE SETTING WITH RESPECT TO A DIFFERENT FRAME. TO CORRECT +; THIS GLITCH THIS ACTIVITY WILL ONLY TAKE PLACE IF THE ATOM ALREADY POINTS +; TO A BINDING + + MOVE D,1(AB) + SKIPE (D) + JRST NSHALL + MOVEM C,(D) + MOVEM E,1(D) +NSHALL: SUB TP,[4,,4] + JRST FINIS +BSET: + MOVE PVP,PVSTOR+1 + CAMN PVP,-2(TP) ; SKIP IF PROC DIFFERS + MOVEM C,-2(TP) ; ELSE USE RESULT FROM LOC SEARCH + MOVE B,-2(TP) ; GET PROCESS + HRRZ A,TPBASE+1(B) ;GET ACTUAL STACK BASE + HRRZ B,SPBASE+1(B) ;AND FIRST BINDING + SUB B,A ;ARE THERE 6 + CAIL B,6 ;CELLS AVAILABLE? + JRST SETIT ;YES + MOVE C,(TP) ; GET POINTER BACK + MOVEI B,0 ; LOOK FOR EMPTY SLOT + PUSHJ P,AILOC + CAMN A,$TUNBOUND ; SKIP IF FOUND + JRST BSET1 + MOVE E,1(AB) ; GET ATOM + MOVEM E,-1(B) ; AND STORE + JRST BSET2 +BSET1: MOVE B,-2(TP) ; GET PROCESS +; PUSH TP,TPBASE(B) ;NO -- GROW THE TP +; PUSH TP,TPBASE+1(B) ;AT THE BASE END +; PUSH TP,$TFIX +; PUSH TP,[0] +; PUSH TP,$TFIX +; PUSH TP,[100] +; MCALL 3,GROW +; MOVE C,-2(TP) ; GET PROCESS +; MOVEM A,TPBASE(C) ;SAVE RESULT + PUSH P,0 ; MANUALLY GROW VECTOR + PUSH P,C + MOVE C,TPBASE+1(B) + HLRE B,C + SUB C,B + MOVEI C,1(C) + CAME C,TPGROW + ADDI C,PDLBUF + MOVE D,LVLINC + DPB D,[001100,,-1(C)] + MOVE C,[5,,3] ; SET UP INDICATORS FOR AGC + PUSHJ P,AGC + MOVE PVP,PVSTOR+1 + MOVE B,TPBASE+1(PVP) ; MODIFY POINTER + MOVE 0,LVLINC ; ADJUST SPBASE POINTER + ASH 0,6 + SUB B,0 + HRLZS 0 + SUB B,0 + MOVEM B,TPBASE+1(PVP) + POP P,C + POP P,0 +; MOVEM B,TPBASE+1(C) +SETIT: MOVE C,-2(TP) ; GET PROCESS + MOVE B,SPBASE+1(C) + MOVEI A,-6(B) ;MAKE UP BINDING + HRRM A,(B) ;LINK PREVIOUS BIND BLOCK + MOVSI A,TBIND + MOVEM A,-6(B) + MOVE A,1(AB) + MOVEM A,-5(B) + SUB B,[6,,6] + MOVEM B,SPBASE+1(C) + ADD B,[2,,2] +BSET2: MOVE C,-2(TP) ; GET PROC + MOVSI A,TLOCI + HRR A,BINDID+1(C) + HLRZ D,OTBSAV(TB) ; TIME IT + MOVEM D,2(B) ; AND FIX IT + POPJ P, + +; HERE TO ELABORATE ON TYPE MISMATCH + +TYPMI2: MOVE C,(TP) ; FIND DECLS + HLRZ C,2(C) + MOVE D,2(AB) + MOVE B,3(AB) + MOVE 0,(AB) ; GET ATOM + MOVE A,1(AB) + JRST TYPMIS + + + +MFUNCTION NOT,SUBR + ENTRY 1 + GETYP A,(AB) ; GET TYPE + CAIE A,TFALSE ;IS IT FALSE? + JRST IFALSE ;NO -- RETURN FALSE + +TRUTH: + MOVSI A,TATOM ;RETURN T (VERITAS) + MOVE B,IMQUOTE T + JRST FINIS + +IMFUNCTION OR,FSUBR + + PUSH P,[0] + JRST ANDOR + +MFUNCTION ANDA,FSUBR,AND + + PUSH P,[1] +ANDOR: ENTRY 1 + GETYP A,(AB) + CAIE A,TLIST + JRST WRONGT ;IF ARG DOESN'T CHECK OUT + MOVE E,(P) + SKIPN C,1(AB) ;IF NIL + JRST TF(E) ;RETURN TRUTH + PUSH TP,$TLIST ;CREATE UNNAMED TEMP + PUSH TP,C +ANDLP: + MOVE E,(P) + JUMPE C,TFI(E) ;ANY MORE ARGS? + MOVEM C,1(TB) ;STORE CRUFT + GETYP A,(C) + MOVSI A,(A) + PUSH TP,A + PUSH TP,1(C) ;ARGUMENT + JSP E,CHKARG + MCALL 1,EVAL + GETYP 0,A + MOVE E,(P) + XCT TFSKP(E) + JRST FINIS ;IF FALSE -- RETURN + HRRZ C,@1(TB) ;GET CDR OF ARGLIST + JRST ANDLP + +TF: JRST IFALSE + JRST TRUTH + +TFI: JRST IFALS1 + JRST FINIS + +TFSKP: CAIE 0,TFALSE + CAIN 0,TFALSE + +IMFUNCTION FUNCTION,FSUBR + + ENTRY 1 + + MOVSI A,TEXPR + MOVE B,1(AB) + JRST FINIS + + ;SUBR VERSIONS OF AND/OR + +MFUNCTION ANDP,SUBR,[AND?] + JUMPGE AB,TRUTH + MOVE C,[CAIN 0,TFALSE] + JRST BOOL + +MFUNCTION ORP,SUBR,[OR?] + JUMPGE AB,IFALSE + MOVE C,[CAIE 0,TFALSE] +BOOL: HLRE A,AB ; GET ARG COUNTER + MOVMS A + ASH A,-1 ; DIVIDES BY 2 + MOVE D,AB + PUSHJ P,CBOOL + JRST FINIS + +CANDP: SKIPA C,[CAIN 0,TFALSE] +CORP: MOVE C,[CAIE 0,TFALSE] + JUMPE A,CNOARG + MOVEI D,(A) + ASH D,1 ; TIMES 2 + HRLI D,(D) + SUBB TP,D ; POINT TO ARGS & FIXUP TP PTR + AOBJP D,.+1 ; FIXUP ARG PTR AND FALL INTO CBOOL + +CBOOL: GETYP 0,(D) + XCT C ; WINNER ? + JRST CBOOL1 ; YES RETURN IT + ADD D,[2,,2] + SOJG A,CBOOL ; ANY MORE ? + SUB D,[2,,2] ; NO, USE LAST +CBOOL1: MOVE A,(D) + MOVE B,(D)+1 + POPJ P, + + +CNOARG: MOVSI 0,TFALSE + XCT C + JRST CNOAND + MOVSI A,TFALSE + MOVEI B,0 + POPJ P, +CNOAND: MOVSI A,TATOM + MOVE B,IMQUOTE T + POPJ P, + + +MFUNCTION CLOSURE,SUBR + ENTRY + SKIPL A,AB ;ANY ARGS + JRST TFA ;NO -- LOSE + ADD A,[2,,2] ;POINT AT IDS + PUSH TP,$TAB + PUSH TP,A + PUSH P,[0] ;MAKE COUNTER + +CLOLP: SKIPL A,1(TB) ;ANY MORE IDS? + JRST CLODON ;NO -- LOSE + PUSH TP,(A) ;SAVE ID + PUSH TP,1(A) + PUSH TP,(A) ;GET ITS VALUE + PUSH TP,1(A) + ADD A,[2,,2] ;BUMP POINTER + MOVEM A,1(TB) + AOS (P) + MCALL 1,VALUE + PUSH TP,A + PUSH TP,B + MCALL 2,LIST ;MAKE PAIR + PUSH TP,A + PUSH TP,B + JRST CLOLP + +CLODON: POP P,A + ACALL A,LIST ;MAKE UP LIST + PUSH TP,(AB) ;GET FUNCTION + PUSH TP,1(AB) + PUSH TP,A + PUSH TP,B + MCALL 2,LIST ;MAKE LIST + MOVSI A,TFUNARG + JRST FINIS + + + +;ERROR COMMENTS FOR EVAL + +BADNUM: ERRUUO EQUOTE NEGATIVE-ARGUMENT + +WTY1TP: ERRUUO EQUOTE FIRST-ARG-WRONG-TYPE + +UNBOU: PUSH TP,$TATOM + PUSH TP,EQUOTE UNBOUND-VARIABLE + JRST ER1ARG + +UNAS: PUSH TP,$TATOM + PUSH TP,EQUOTE UNASSIGNED-VARIABLE + JRST ER1ARG + +BADENV: + ERRUUO EQUOTE BAD-ENVIRONMENT + +FUNERR: + ERRUUO EQUOTE BAD-FUNARG + + +MPD.0: +MPD.1: +MPD.2: +MPD.3: +MPD.4: +MPD.5: +MPD.6: +MPD.7: +MPD.8: +MPD.9: +MPD.10: +MPD.11: +MPD.12: +MPD.13: +MPD: ERRUUO EQUOTE MEANINGLESS-PARAMETER-DECLARATION + +NOBODY: ERRUUO EQUOTE HAS-EMPTY-BODY + +BADCLS: ERRUUO EQUOTE BAD-CLAUSE + +NXTAG: ERRUUO EQUOTE NON-EXISTENT-TAG + +NXPRG: ERRUUO EQUOTE NOT-IN-PROG + +NAPTL: +NAPT: ERRUUO EQUOTE NON-APPLICABLE-TYPE + +NONEVT: ERRUUO EQUOTE NON-EVALUATEABLE-TYPE + + +NONATM: ERRUUO EQUOTE NON-ATOMIC-ARGUMENT + + +ILLFRA: ERRUUO EQUOTE FRAME-NO-LONGER-EXISTS + +ILLSEG: ERRUUO EQUOTE ILLEGAL-SEGMENT + +BADMAC: ERRUUO EQUOTE BAD-USE-OF-MACRO + +BADFSB: ERRUUO EQUOTE APPLY-OR-STACKFORM-OF-FSUBR + + +ER1ARG: PUSH TP,(AB) + PUSH TP,1(AB) + MOVEI A,2 + JRST CALER + +END + \ No newline at end of file diff --git a//first.cmd.2 b//first.cmd.2 new file mode 100644 index 0000000..9dc3276 --- /dev/null +++ b//first.cmd.2 @@ -0,0 +1,84 @@ +CONN INT: +DEL MDLXXX.*.* +DELVER +YY*.*.* +EXP +DEL MDL:MDLXXX.*.* +DEL MDL:*.SAV00.* +EXP MDL: +STINK +MMUD105.STINK@MMDLXXX.EXEYRESET . + +NDDT +;YMDLXXX.EXE +;UMDLXXX.EXE +;OMDLXXX.SYMBOLS + +INTFCNK +NAME1K +BUFRINK +PROCIDK +IOIN2K +ITEMK +NILK +TYPVECK +INAMEK +ECHOK +CHANNOK +VALK +CHRCNTK +0STOK +TYPBOTK +ERASCHK +DIRECTK +INDICK +INTFCNK +KILLCHK +TTICHNK +ASTOK +BRKCHK +NODPNTK +ESCAPK +BSTOK +TTOCHNK +SYSCHRK +BRFCHRK +CSTOK +ROOTK +ASOLNTK +BRFCH2K +BYTPTRK +INITIAK +DSTOK +ESTOK +INTOBLK +PVPSTOK +ERROBLK +MUDOBLK +TVPSTOK +ABSTOK +INTNUMK +STATUSK +INTVECK +QUEUESK +TBSTOK +CHNL1K +.LIST.K +GCPDLK +CONADJK +T.CHANK +N.CHNSK +SLENGCK +LENGCK +SECLENK +;WMDLXXX.SYMBOLS +;H +RESET . +NDDT +;YMDLXXX.EXE +;OMDLXXX.SYMBOLS +NSEGS/3 +MASK1/700541,,2007 +;UMDLXXX.EXE +;H +LOGOUT diff --git a//fopen.bin.16 b//fopen.bin.16 new file mode 100644 index 0000000000000000000000000000000000000000..5daad105edab03d53e04c37c444a7fce7a6d0e34 GIT binary patch literal 60804 zcmdRXhg;jq6YWZ_m}X4x0t}&JI!S;C2ZQOI0O5j3=phM^Mk@dMJ7;7|m<#uE;m7yh z)0c?#?rL{-=FIGD(MpwGDE0l*!CY0=k2gv#Uv|rMGL+T%(h7OAmre}{y0cH}t&k`C z?Y1d#9w{J@e`@`7XO{T;B*B|~+PW(tS9Z=?G8D)fmnfwI;a^rr`+kZ*V5l?sGqAF6 zh4jPPA9a3Z6B+nWo=nJE`Pga&vriWK)(~{7%qNkN4n}rm=PVX6P8r#!4HC+-TABG~ zazU~f+5U-46FGF1t$kiTMyN;S6wQ2KD6Rqnp{W0oS0Enyc7iyiG!m(lU+y4x=jh-Q z!`kseX!wXkYE~9KlFX8|pt&WxuI#vf3Aqxg>ZUB&J&^^S#rkhdU460jjH!WZL}qUH z4U94&Gu|1`?<0|!+Nsa1a@vtqA80d}CCiBm#1E>XjLUZ7vbF732IF%6Uci`S&UG>e z3f6YJm^tXgWp|B6OvdG1BNEJ>^fDpTsP*>ckjRimOgc>s{ND8Vm?bN#rS?>Knw`_S z`n#QRIhn443JK)~cHaGpGcF{UMDu$F`BMeH_AA2*#rJ1GDdZNo9O`Y8P*&DL{|rNV zps%yY5}9B!Q{_w^GQpL-ez;mBp-)9mI-aW1Q6NSwD{pLDGoX!LtDmtK4#d228 zg~DZ=mru^VR{j#DAyuiWqS+3CnX1_-ogY;L2A(;}_*p5bxqXfE%%xOYV_VM~Np)4P z1QRCXoYdB{H`Ucnp_R+OTvnmAweNn7suCj!88^wuO3|YBUyQ%WWuaO&pSV_N?cnp) zQK!&+){9z|YF!I`tg>l2GZ~joOO7f5>-Y++pv1%K_anjc3h<~#;$><9tGM%9oiDG|UyJ8jT(E|kvWiJ;QK z5bH8Ne*1X&7pXV$5{P1xY6OJkMd1|_zf{eW)1OV7X%*cAgrB7>r_lsqrc>yxAas$8 z%oHu^=y}odrNzm+f$%e%Ae;;cCn1zP&);dO`k_joJbvY-3PF}mm3&@6n2x_ZkKixR z)Y9@ag}*#^3V(T?6#kgc!r!m=q=5Llk%DhmxbXn|S#nF_FV8L18y!`p&n>Rq34f#+ z7x4GtyKwE%@K;0pZK_hhEQBt|-HMK}5jSn9hYHx?SAo*X9{*y25ywx{G+-1Pa9iN5 z8Mgu=wpI{(ijXRUyKun3lQ-&n;~$5o_p+UNev@UT!M5tEpl-9BI?15xBDARE)#YHs z62P5co9Ab>B7mx3lvxj^UoqlPu=ydozbz1Z= zc?_sF$^-S{+KnxK2>zQqQvNRCXpMlW&eDUa+u- zPh4~&65NUomWEPVTl6lawM8c>tz|w-Yu^o!2h`f4UpG{a;!@i4Fy0TSF4pmmtf$r< zT7AXcI^iN~VhLJ%q?6po)7maVZ;D#m6-sGsd%D*4Qfnh3^K58smcyZ&WX?uknrw8s zRG~|${&!+_er36@w7R)P+IGtmC6~8p?PW@9ktLmew9;k_Xh<;)WY4U;SV4 zen9oH4%CZ_S{wd1-lwbupjX@=k3nk>(JbQ;wYHzo8>80t+gjU|uC>powLK}V{q)1( z&@Eb9JYbUibg7OzT065cikaz9i__N@KfU1zPzCkNFjy9KLuC0D%t4m{nZs)?855q8 z&reL|BI}Tf%;;+uWU@NMHI+!M zbx~_ww${G*X9@mmUt2t9lC*UBMsC&GrCCfUr)%w;NN|0`D6vPq#k027&e>Xve3sT8 z$$Y11?M;=pIW2k^?+4U#@?PetskH|(=)dEDw;1H&qSm5W#v^L&b3!jlt$l85ZGXDf z4pVEN+FE<)aOgIzePe?7Yf`OrwANti_QA(1TKmRiTsjUaZqwQ~w$@hITDv0!P;0H! zCV$(!H9hudT02bEy`a_(Q)@>YzB~*$5j9NY?2seW+Jl6&@{U@YqzX$Z!&s_NVQQ_1 zTI-PkuXW=vSH`-j8+zhe)Ygk$aZ02gF<}F-{-?WJNQR-uadYFw8IgSh%X!K$=auG! z+CwT(?v!E}c+A9qRoT}uRK>?+CR){3^nI=2QqPozD8tajdB?4CHSw)q^0jVZ4ditK zH^V!RJaOp)awVg)|lC2;O1RG7M(vcTImdds-tJ5 zWuc}KcO#5cHerV$SI|A8%k-!G^fX3&mzR<%PwYf>izN%v7_z;bY!^1|wp$%Hep-)7 zZAi_}ebe{3fb{JJ4Yv~U>t^VlP-18H3tI_Q4a9duog#0ensNmFVV5hN0_%Fq6EcPGjlf!ZMvf3 zDGDl?r7~!sfy`IXM{?x}A>4k<8apFFT}q*ysRni%Q9L2?wKH2TdrqQil}oi+iSG6X z-TlnRk}LUaB|}1=G{2kF3txmt%X{dkf_$YN0F-VxfHS<{fx%Xa85uOdPO@DiX`F!7 z!V*`MK(HP8G@*|P2D4O=f@=TX-1G_QgTo99BgHedSm=|VPUxu{&qCa|*9Mi|Pz#%b z_TsTEdD^e5g|Ny?2=8lxAx1iBCB;HYce%A`1$8gS@3wi)~zo%J;_Zy?7w?Uel%^HpY;%$H8knbXRL^_K%$x6r~W=xOa(Gh_eIUtSp>Rm$c9dRlM3 zJgTRq^}t>DGeKbX=xQPeYl}%}8vRNdHJ4-tc7%^DL=jqggPRzhny~Nk*Bl2Emd0MOyRk(WNN{cq{D$Qiv%p?owLEMbIuEfIptBJ;;?L2ZN$#Ft0ZoW=F>ay-T3x{g!QYt2LJLgVPeVs1oN-t< z^^5d@WaKg2h;#Zk!+Sx!oQKW!8yFOhfd}2VRga@&gQ{yJ;wY3iq$^#$uZ4LysYTzm z8AhHwMEYfE&tSS300X8#XFvEuXxWGY*(2yfFQtf@FnYJOFld#ES_(??!=!H$g{$xh zI%la3SzPQ%US0l@jRcgmLMnV0a95Lh+467b3j;Jpfzlu>YjQE7;qvm5SxN~N!*HXO zG@#`yMHqI#P>5M_TMXR8FpR=JxJF7ZkVZ4)c~;z5)l2%0kjr9(hABt|dxP4gfs%RM z461BnGN=M;X7S}^BMWP<#m#`@VEI>UK4x6Ojm=uH&hV;04JpVn$jJ`aPRojdQiS@D zBHkA*>!nnL7(50y>WV|P@Ok^Zg7kewxqkLrdWS)KYVjTr5E*4iD~(#9SQ07^JQodO zv-!j@D_WA`rAq1tC|yGnP=KE|FK<5HGDMaJb;h#%AY7wRd?A(~q8NIkbX|IgU_PfMV~78%+H3kU8-7@4pe zkp}+PH25xO2@8>BTWS5tQ90?W3}Reiu+X+NylCgw@X|kuj+FUi`@l~pGqz@-_*(Z! zVyzbJG#Zen7!|1=6P-AEV!fWNtR|5b^sJJly^NDfQpp^x-^8u;eOWWcoN+YQt&x9> zt3pm155L8*Klmv|!O-FO%9wa1{^$Io)0f@UW3vm)L>1S&z|X2A!dP4@vs1HkuV#(; z#kuHoY{rUJJ9j{o&{xk2gb?2=biE%*6&C3c4-kC z#Bp-Mn#22tejgs5C=T+cs48vLJA!J|f}`Q|mwQo5`ud0%nexWvU=d-asExe{`7aFv zV>5Wz+~jEjCHSf2=R$+Nb83tQRc0?T4|05&Z}gMh1AtWIe_g;^Xdx+d=@LbR=p84|*eqOh>135c-G=Nd^Q;iXJ&-*>WXCW~ zrCU4~Yhg5lSB}ij&T@ZuKUC&pCR>!Q_D^q}CXFpF&Ml@(8de;VJ{T&CLfNg21eGyc z(qp!ykuNFfX4_=kRC%A%qK8VFQ`D6hZQ!D$f#17J8sy@lq-6#5@g&W;@ZT@ld0BJe zmZafr`f3cNyoPDO_Zj64KRxU)GR1Dt9^}z0^@)E<&kfzOsSI`}wJkK)^be%7F;J-1 zjPlG1J|;eEern*ZPZ*6sRlU%N!6@?M2|CBDO^wq_8(zP}E+5c0&O~KIF}r2NadZ0k zO?1bYXApGaX3v6E8;vMn4Py=IlVcjK*#-v<5wt^-`Jomm6vOpbR%6iKOjcfyh$2NA zy=FeSyqrS<{3ph#d5bS035|TH@76E`)tCJ$5sHvup|bdP>GB4%Q(ZFAeEpdfH;On^ zsShG9V~@8}XNa8L+gkh1!QcI?=!S_Zu4z>LtyVO;z8q^?n%Ic7MX^l_{5ibR&2ETp z6}03GP1sg+-PWxQTepzU(ydk5G%8l~CNgTAwmnq0)~H+SY$J|r1`nq!a{pz(2k1@iz(za$$Pz*$sMNDf3NR7%QbU*Y1+d{W?_bp(eTlaG~ z;y2xBWBwvQWm=J5{dsj~8{3zH{tu3qct%K(Hu4c|R>ffkKO{LXpZL z0O&*NId4Bx^yve(io(_xnGJ~v8z5P;qyU5LtuYWw1Mh@<{FxyY2?d6ijmERhJM7_}m6m*X zLHf!tIAa#^vxWQC1c2GL15HbsCEr@e9O5A#Uzlsw_u126UPWOGb-I zGspy~jpeE5rqW#)J7aZ;6Vs-NsSJ)+F?)gk)=*ku;)DHV`IV7ZBT})c16jx+0Vd~i z^F(1eGgd;{R3kY)&ihb8xw-~FZx2UFU$5}Qndk2|RiIU#ZA8AO38w~jcz=Hi;?PtMc079>I9M7|PY!n!2%=&zsek-j;+ zdk{42XO)fdHUlGntr+!ckx?*%SyqXw8irP^ifB~XcVZq16R?bP3z2rdH76fKE~^RY zB?Dnri?-~?{#tKQOZ0|an=o0)RHt}`tVs?T8dWTffBB6V*LL|9R+1L1sG9QyZmV~`)5`>v?^&(%&Ut){8^$X?n2bvwCFD6T6UZJk zr%L8kv$5r+<&kB$-|0Th2eH)g+KxZN_ITm_6rXs@ifo?-`2cT>3|BizhDVIK^rpVqco{AVJTi?Oa9LF_4M zM)UP!{B<2hrixmY9thjILX(B2K_%=;P1i zN(j1`jj{f@_YQLI)v?qyqh;5%V#S$|q-C)B0HFY{EH0{aU1%0vXc}*Mwq)xpyS_3l<7-}`)7U;sw#gNi-3&)S^%C+C-n!+eh*1?kNut;Sn&@EX^H-456 zkN&t+3=uh0E7unbtOkCLb8_$6P8h;A#7WPPVitMKKmjsZ>|A`dH?U0lvQKpYu`I4G z8j#DK-LZjjlsM&SE4Ns+O+W+~CkDC=v63x<_AckT{Zxs?QaeN}JP(cTs~IZCL< z^X?iU!=fdO2pM$AP!Ow2?q;JIL*K~7NPZ9b7uLby@Io_qAX$VKlA*U7P!6eb=g@bG zI+VNVZ8Yd^!>%TGGjH{Lq6Z2jqat^U!7;4xPlmbH?GI8l)Oe{}yeSM?5tA!(1=SHl zsfdo>Dw4o(nssz`ATHQ2`mM4I8t?AZ-57L9T#umw1X(JKbvwl}z4BqK9P3-&*b=Z%zF+I^=%R~_c(a8bKQ_!tLW zb;Bm((*1)GRgw_r~0SO14lFbXY_?;XEMxlsg zDJyJh_;y8mP?Tj)nGYLJ8r|c(O*9`Xcfag$mCPyiQ@?2)J={v@{=C|{R;^0r-6L>f zu+@i~oMc|KrWXAsoo%r%dkk3{URXy0Y*XsZo1E<Qzp+yrVUxRI%(}7Dx%wb)B zf61|KQE-Zv9J5;O4t&AJ>7tEOv4#mH6^^ zg(%3yMTnwV#^d?1?ie9DfR`fNn0&z{9Di}p|MQu{i2I3l-(-2|7OC_fL<`+WH$nSJ z(LT>Au|>OQi+0}@E%I5S9i6mAdsF2_PK*90qTOTrxS;jwzwGp^1G%^;S~SaeMA42> zwEYzAm{e(t_R8z`_Y>_8lLe-W)^n?9|9+rA-478h4iw13Y-4f=`rQ`o4_mazmlSP| zE!vwZ*Z+5-9i!HM7lu)^VA|bBpCA_(MJto2>d`uuM-y#0$7B=IM4Nebt7!lJCR{j2 zM2k1!GO_R45^Xp;CE9RKO0>*piT34UO0+jt{^5Ts+Hf}8Ct547Sl`hglU!U7?Q7Xi z{&=Dtr`Gntb90Yld!d%#L3tRtM3iRVRJ=k3dU@-Un~3v{5JkQuL}g;1KEsVt4C$1V|K!{XbdH2w9byF{5xlfELlp;I7br#Po zoN#s@INop#*qtxiZ~Ma^8-6)BxR<^)^_i?F4ddR4TaE8BGpD&sO&AKGZR@%3z3~*X zn|f2oZt6=RoB1qccjE*?%NxG2@+*g!Jk(`MKzo{cNivP^!hi9GNiHscdKJww9ud?# z1U2@r1>HN~kGx{&Iv^Y|t%L|i@UrjU`AH~WpG*pZP?-$bkphUEx8j0*d6Ds@{-IEr zG*S9BsPx_nmA|`SO)!~&3S2O6j}4Ux8!D4FRFE$T6?to)MzHCo%CB@b4~5Dh>%h)> zT!hLjWq!wgn$5yRsGwQKBSM7>06z=qT^~x7ws&3pP|))Z8lCzq?>f03$>T z7Yvh=Nf)f?FI%)*wrG*h5^a|pz$2o)sq!kPMgJ4g{v`~fXk}sPuA-%mS)xU=j7Jph z5k*@-(H=>awrH=6An#}3&rKGXF52u{Mf>;Zj;3=FEv7rXS+;1;Y|)XdB2Y z5$#Qt2mW`WJ)+j03BxGb`v0P}AQu<47R@sLe-v%A*JKmYMC--@=`!}f_mmi;Ps)LN2@3!+^?vy4X+?J>0$ z2c*rrkAva3QkRz(0n2eY+_&a3fxw#i-m_~%pwxyynGFHtOG2RChQLjgKk)2S&R{wf-CyoFQYTH-r8?& zvyt6yBOCcFWJhG0g>UWONYJ#Ss}FQZJX~jQ#wK7~MD_w9dRJtFTwFx<{G%ei6iYb8Txi4omK5zD7(oCSCBuPNBEX_P9t!W|9^xXZF7v z#TzJO;+>W=o1qA}$iyLGBIOY^8JA8Aj;x(0j8ePwoGO_Yvpq{OpzF|iC8jwlsPlD= zFXF6wYc8^R#73QcZY}dAQP)Qb=q=qy!Id?U`=G8dxl7NITXLc&*?gld-v8F(+MTwK zl4e}w+MsalvF4gRI-&OyM%AP9pqcddV)PAr#{%a@^w(lp`CbfvdV;beiu)N1Zjd+f zbxq#F_HeJMC#UkGD_YPsigr|f%&jWuW{3$5Mi~2yWYx08Kpe6Jc)XD(toT#vuu>T} zz1*@jOZsxOpoT?E`(z$#<4Mk^lXptDACq|>OjAwEG*xRKD@xtOS26e#8(FZ4+rIf3 zl3NBtatktqn{wl5fjFqr=at5KKp#S+?@&&!S?}Gr)Jb2t3TmOSwb2VxUe>EZ&RasS z6BiI@`n(iZWQU4VE5Vr{wu*1DyY~&d8{>AYY~HYU3j~o(?D#x273WjCIAjGJ0+AlR zF0VAu3AK_9Iij$n*K_c-7NeatPXq9oWA!P*-F_3PGAAYF3ELS8C|Vz$s7}@OG(Y)m z?2R~v;$GILV}+HaYrML;7<=1h3Lb|)!n5fuGs5HWW!vfzH>Ipk$EwM= zH0z^qQ1Y6X6V5O|lbtG=SB}G<##V}J9bd<)JTueMds>zN(oT}!!iuwX< z5TZ$80dyCMI$u6v8$yCcGpWq(y1h?7=e(o#d4# z>vSyfF~yM482!{0ULG>|9uN!2V*xlmcN@I-!usq)Q67t*-TOcj5}#0S3w||nmzif)B*X%i#9QYLZZ}^bra%1}?`5hE)UEM=7rld}h9&_9Tj0PT*$fA_{a*+~TVav5^;XC`!fKYm)|O6Fk0PYhp54bKs{6cqW6 zmhDy6V3I+3j)aNU047xwEAkFmtowsZ@-iBGU4O97glMajCsVp!l7Vg+_P$&?Qv5vi z&5S+meW<-ZLN(WI?3MYo+r3Sak(s0g-sZ$bgIJ%t+IwqCk48%t^|*Pi6wnTbqww6H=@ZX&vIdrk7BZ)O^x3~5|kE%a-roaEQ_7Ic5 zO;(=ngXox(W-Kn*%RX4$-e!N^;l?L$)-y!bQ3P;fDkd<{?ffPQCEr|Z?i(yGIkdwJK9e3Frdrk%?ZRRYNK z3W>!dp_-e(@qIUX_5AUbBk;ws_TodamHP zW6=}A^wYez7)KwRs%zMllGkW4g%&|m#lS%C2Fmc3%^rLmdFatYkp>fGT|>#$eK)ra z58WgqD@hC9#ryiPKz51V(OrnZk;H|LZ*EOGKBDP~$+&dHu3Z}*I#n{S!i#vZr6q>a zwdaYL;n9M^XBd52GgOf$Q_T0471@e|d`ZReq|Rlqw>5}rH9@!70$pQL5FeX!7YC{Iy_5v8P550h%-{e zYSMy>-iXQsgMLjwTqg?EHwL|N6ou%v5;g+Rv>o*GZs+)y{)V{HOcv@G?~Q0#OMxSk z`x)=&R-yJcSX<9_F7Ywd1gnz1eLzCV+bmAeU7lEtwT&!}ugt_|F(q*gbk7BJ-D|~9 zaiX8~Zb#&~4Z7zx=#b9>U6pLR;kzA?L6g;_gYL@b7anS@>sbft#YJmf{cpYYRck#c zk5N^lj|;d40`3*9HLQb);UJ+-Fz7PwWJqjpgeUA|)4B#FmGEih?n9lU(x7#MD~aw* z_{HJE4cOJJEVTyAJu=I9Pp!d%OHt{AMemR#3s_kPr~kaeC7*qN;oa1@w;N|;a|$nM z{d?(dWHZb2)R@{c&+|&Og<6%Dpl>YBh`1%$J%`9=y3rxXv4d7u!ER;<2~W9zs)^^q zv%E0Tt2|MboZ*1Kv81Zv$_Kmd2mUz|EVu?Ze41m8v41~j(6X~_V#r+U*&jn$@ef-mZ z!Tr2EM%>G4u)57zf9N@bUVhWzJ5K=e4(s%O`)M61^OqZ02(@RyvNp65-u$`HN=Qv3 zWV9;HSYs$bB@z5#IHmKrW*`x|Af85Ei-AIAvZ9vVE=F&GVR|HmJq@YJ3jVYvCZH(H z0yr8t_IKENAu_n%^aURg@lGigP)ytpLzW>Tc1r4X(Anktar)3#03&Zrl93Jz9Nu~h zI%nr*+wfh!Hfz!J8am$!IzP9J{K5W;q*Z=vqw}q8m66XvXQiw;3OaXhAmhqDw1=W| zhUi4SxL}pzbN>aMyYd*(i3xDy@fQERvqWbHmPoy`&Jt;5R{r4@DDciMzb*)P9EH7? zG3xzlvNdVq{*mDndh4W>hh$_YX~EYc<_6kdT1>pt5^3*OR!c7wr<{|CkVo$~lX2;^ z_^)}PPL<57<`*Ysm!k}&8OGjk0=-yg_XXZ$vb@mVZz<^YeoH}*`7G$=*c;+|FHDw~ zPKNsmOCB(DWeG3og|c#7RZrV@{>#i&?}a=@*2#;1>d~xY3V(6$tO}1`b3?u5uxnl( zf8~Wg27j%x=c_LQ(!2``JI`J{^fcbSfXQa2N#XmKD^j>^c;q1&*-2WU-M>GbC4H_t z0kbc_Y6;AV&naN`Wtxmjrv*n$&l6;B+~rLTyGrK8+Wp9AG!2t|nSx1A;a^*rpt3O8 zmzlz3UuFuE%x7UTdz}=xpc;KyCJRlc;PeVN9)d|BJc&tGj;ks-9gSJ)e5bYhzASl+ zTss%8JsKt#XcKv6q<4W+`vyQ5D1D9E-JJ=Hk9hmlLSi^eARnXU!n}8tvjqHfgSS$8 z*ljOdL|w&$dPlefnK6Va7k4lBBi{T8SHLCEoe2N$BjA!%|pOKU`Cu%&&klrio%FTSnZ;*_yzl1t#LnF7Q=anT zeWz-HGfpULHMPjciiX6o#_-VeSkCd4l2K@F0-2>esZv*?BluJj68P*17ZmYX9=R#+ z;FX0qS!f_J*1DYbW!zN!N#94FJ)@7L%ksYQscjWQ-&5}wbPRs$Oa);MzW;+(qU*Cx z;HzxYN6B>WH*zw&(j3n=h31o56ivrJTgSwc+U3t4H2>#b6m2D?zaL1SMQztZE=f`(5SOn4!K20r1EEY2cS)ssvi z(udJIDrOe1NZ~n(%Eg3hP`-TR;bYl$mJA_?w_L_?dxS5Gi;>w}q;+vf=H@yinuCjj zmFy(-7{b4tS^mPWF!|7Ye=x{%E~PPf*V>Uzc*r6gQczXT=98RM6|irz2;j7+vQ1lL zt-b;|Zp2oIU|GwjNC7B?6Ai*GWRLJ?dF083B}NgM|6M;m2m|^`T!{?qHmO1uJm$`+ zdJ?coE|rpz;Ny~muY_&0CIV$b!>I^I44oyM+RD4z<5opNv+!OBk`|#1U$vk_LO9t` zWhw*Vew^3&$J&b6r@ZIAg|koil_*~g<^@eT-bW5MvGS3iR$(^2{~0g|6^}y@AS7oBCYu(O{Q|PVUp^Ic> zCTZc4=EQ3&~2@@1(7P^y!bSLZrt4+qGcY%p(-l0<^^U8T3FX!ghuX%@k)zTBc z+&}ljHAwcv)l+=pEi1BnV&qHq#FZpNdSb(5zH~A+udw6+J+URcR8Ne`aT$H_1Nk<< z9VaRK40(*K+j`WV*vGF=T;S^y^S%xpUnNr8sMy_&PIClG;$7-7l@CWIv1j6qio5$PaGwGE&*TgK>d-yxuE$bFA6poDSWY}Qn zw!zSCg8}(0Fl6o6U_c{rrBe`hn)Sd@s*j)F>O;M_FiMRkkJP!FN7f^c5eKq5pdQO3 z^K}yklbF2qfzmiWJ4fYBSwf`=EV`1g@C^_Q*q(?R5y9^k`?>@XKPGZlo;$3&A0psa z;7XSVjsm#_5pyfcNl2t40z(}?`mK}5-Uk~I<2EA3ZA2hn5)txhkeG+~4HWb^&3Y&z z28amMi;IYW%{TsW4LCKMhqXUyAub|9_5?p3BAyZvqwGVU!kxkqdFaZ!9Yk;o&>w4q zl>rViHEwMSk}o|Wj+?@KadfkRQhbRt4<-Yfh8#aaHi|jDeLpO78@9Wqz5T^`S(aS*7GTKq zI+^6)6MAhUm=kWq-BPOr;vBaEAAR%U$Y$lmcnGGia%gAvP>RRRw|cPX$**&ecs~W( zFj-)_f?eIfdF!a0v}D@^?VeP;k*VD~E?V|+-POWwSb8<8!E2Lo>9mBeIRs9X%qx6e zTE?6a3f9qg6o{U@{_4j|71m^W-$xswA8m*tUlO8n z&K4)r`%X=kmrhIO6}~*cXSF1lf+#A-RW&gABe{d|ZobN?JVuD-JT64}MU)GkA?sTY zh9|7qqi8xrUlN^bGKiB~F&^q7p24-R~6ubbJ!}ta@96-OB?&7@T6GM`PMeTN) z*4uTyqX=DL@!O``T*Tb-3z5~U>J$X>3N+3a#(6xD_bYJRR z+^FI8m6j`KT-?jb_q#yoHN0GKuMA`F>{$1^1hH_e6L=}!8fEpnQi$z$r4Y+}7GeYT z*Yx_`ChJN=?8U{y5Np_5=>~l7pcSka7u={3IqCn7_O#!cbpcr8KOPsX?+DfqmVbQj zgwmQ?z(+n?C6e~5j*BZRHTRPAV6n-f)A;=9@K#CR;xG>ui=^Q&Cvc*MCF#N9l%xlX zQ<7#rk#y0|Ub2qe=U~YV6zu-*Bz?j`g!t2nmd`L!4i24l75MAyBUwS(C2$k zN#jGor@r?%Rnz1omhY(;9@~tZ+GgZT%!uRlIlibknz|Ru)BTgFDL4b~iez?Arp+*? z*(<-sie4H4&M;#K1dI-v%{uZ~rMR#^HYa-qMpUWteaEDjyoHPzIZiX%S^lKHr{=q$ zhpZcuuolJ`ZZLv=y$dc4{bxUVHC)b`^|$%s*T;^y?}y?RtI(_4i9Rjgx)=22+{)~7 z+c-S!<=A4|GA0GutWH-xM3&a;a;LLge!OTg<=Ma|53E;x2U~1-x7hGTW((dwz7a3n z3p&_(18G1Pe4;sR80jxCynymX z05_ag?GF_L5Ly?g5P0)F7=J-=6f`RXH4H0|ks4L{1Ke{bWE9E512Y%5H=rMpsr#A+ z9rIz#BC8Mh0ky*5k+b&xGH&(=F0K_E@eKlh8JC2(9^h|g<{HP`NvKGhBVa9P{ z9~?$V^2u7l01j~uaNt>sk1S=Vjw%%xOVd7t(b1LIV<- zajP~O;C(GLa9dAm?!o%%BPA2!Hk_D*tTFo^JbkKAs!T=ThkqcQAiNHNCZq`R<0IRs zLk>7F3}lz@N#ZX)c_me{j+zD-+Owy{WlNaT_Ydo!OkfdWl@-!d$5@`7gwC$KQFK3J z`NAXx>0Q1l!)8QJ;{O2CQx|v5uP5yz;?k|-3$Oqh@MKf3NR3GbUrh1Qw=hdDY{Q6r zXxCI%ku`GVm}Jm2nJ=A;EAxL3G>m?eb)a5cG>mAKac9G5%40N)@;cMw8Ag+aafrY) zPu=*yo9s$N<$jZI0EO@dkbg~#rF5x%{IDDpB4ZP1_rEdt)lsbL`d8!~Q9P!r=vXd3 zbJ2izMvO5?MwWxQW@yN3iv~B-C!$HyvLf5moZ>~XQ$Ld@30AdEp0$&{87wBkGiZRt z#ENmi;L2@jaU((o&oUH+75$CCCc3D#%LWM08p1SCCPH|C+K8X+4NoqA%XF4JAzxnQ z8<2Pj5shAhR%Ankv}z{{H{yq+fMW86MB-y3$k(1<{LDrAHh`}nKe6uLT!VsU^V#Hk z-wf68Ra!3ek$?Vee3BJ&j8tdg^9J7`RACbbpny46X6D=K$JYsBXh&d-JxPfBN)>O_ z3n(ukLV?EnpNiTejSYkVpxqf*g~!j8hF1+<(s!s)Q)&}vKH97DD{~TgQ6q~_#3Q(| z4kM1AHAu}!#UTOhg|!8_x{(MO6sZ2(gvF%YtxtX9&;P+G&om?cBi`Pb$agF!x`=TL z87N*18KqUx+kiLkJK}xs`$^wtyvVQI3$-OFu7Slar%)2Et&K(erxGG}t&hk#90DY@ z1i7|Xw%7K8gCzeCi$f@i6T1HIB5q5nml@_~GjU{6$KnW7a58JWcd4Gn52ft~Z#7dS-btj+pfh3L^W{1JMF z0M4QmO|_r`N+AkJUz3sL z6DNkAW|Ug=t+Fw=$*u#P2Ut*7Q3@!v>VSr7hP=xx?;gwcZxIhNVB*78gH6C0WEiLj zh&4JI(cV52=0TLCou7y#RdUmN##BbLLSD6?gMyP<`aS^_823D%dbLIR8n7@JR2|La z+Dl+O@dlsFAZh4Z@Uw%!JglvjWpe-bO?}N$#4EcKEcl=udT(51Ot8vslI9ANv_^bp z<%3~@DtTkOwt;bD@MjJM@&p{H1643kFbc`yjh^NFfilv^Pkrd&o_&?k%Pv1CML805 z*Xq3?sx5K4J!DK^v@%Ny7TV}I~*d;@30XB#<4fcpU- z6JEN6T*wCcU^1|^9sJ{C8ME!5I%1@61izxH#lWB1Fm50Xud*Xh#<_yP2<;z#`t6FQ zSiI~dk(Wv}zhUZ9Xr`TImWIdW_&&QRz`{60n^7#N6C_Gwm?$TPTJKy5El;0xmYjHEtI(X@a=7ERb(_fu;6R*+aVW zzY<+#$@s)3E;4q~W~>%yTX~DqzXmc6U>tO}D58BsW|Sv4an#Eyjzhncj#5a5d~-*v z&qo7sFtnUl5Iv`oFeEpz2ii^EW?5H7MfF36=1V4_I=VNWL)sg8Hya9y0<~R~*WqMhO8%kf*Ucwn%LIbhWWH{5;MPJlQ|8HrE zS?G%{*}f?9fz$9szstK{l5g2$zH}n5u4>(5e%x>d=@}n|7FI!D^r@T)b=N^U_SWK} zFWUU5b5I$4P5mndnI##gv~|E0KM)TSE?s4^zZ@oLaJvFMWO4syK5KKIfDpq0T+~(~ z`$UEmWdotka>QhOjaE<9&Oa1a`zFe|CbCke&|7yV=_DhNq(!OYZ_g_ytg*qJb|ww( zvs#fyiO7SZJun%U4xf^13z1Hh%&Vd+W0*{3D1Af)JqLsKx-ye`XtKO?GOoO-cb^eeV{#$V5?*qZXAqU+s>zPvlc)b-Sam3m5z0l63+1nb zvQL#78DDYYf|h>bf_JVM^PTp0?|oacfptS+Y_MYj?anq`%NeUfq!{U%T1>wK&wljC zFk0oI_|p!wDC4(U3g@&s(7WHL{0FMJF1#x*cif6+7s<#>(gOPzoy)HIFL?gJY6Z`3 z8_z#Y#-#(veQoK|sgilEFKyHcS-vl)V-KPLt*l!Nn z?*w1so#2dbX`s&dE}$+Oe_F2HVrB086UcW2zf)b(hWWJA-p2a~{#AgJlIhG&)W>f< z6xbS#j7}`ZUdlM+#-n3Us7SxD?BZPZ5@Q7raY^YTl$5^Y6X}P7_(-p;6ut@!+(1y& zY32Vw`cf|%y&Ic*PQhSp{Veei?gQWiOzz<0IgWfdY}fy!eBv0|k!s_p+x0 zS6&3XpY*3pw&<#=CF*-_HSkGkTSo_trfK}E0K^LeU+`qggAsvfJmPGbPuVg@R8r(J)HwDO;ja}!mOKv9rF zz#v2)sHp|ZTHxIeJ1Ty#U;FvW_YiNA@4ubz|0=W8B$a7$3-90Bl}{`$rM&f}w%A&H zWMyeN#-WF!*l(**sK{3tQ#rD>&8|GNB&E}tr5|ZfAZg}7fR|vUy3_AT;-YT=eWwI!Te>Fdj6kvA6zq$u7O9;$8j8_9Cr<@L~ z7*S>DCsm-N0sChC{K;tkERP&Q=ar717y$OjEzU4@yM(QetmDV!#E3TI>-&+;mD zw8+CJ+}RD?!`1RE*7fo76)c8aE*YapaAt+j#`sy`m=>}I3qda~f0Cp_Y!E>5lJpKH zGs$Zx+yaQB(6@H?p{uZYsUsB?xN8cBLSd}0Xl1IWD?$2(m<{r{{IfLyRnYMTPlY#H z*BFZ(U*R6S3LEYLZLIVUZ*o}^E)4!6c_kbMvv;F@s0mF7bhDsY@*MT6t2aye7?N z0bv(d-%q&9%5aK6U@5n-AP~$g^lIOBvR97yK3Fo&_q~6e+x4^xJ7<+=JZogPV;&)2S#H;h zFIxz?Jz4836~CDJBxfKRVaT_eRnsv&hmik6)>%X28bfD+?I$y)B4Zm{63tRbggc%n<+JnT#xg>ljX-~%Mc=o~=A$pe zh*OK%gI_COGd0^+y`?m*nru~129YySSG{~tK?|F{9TBZtagMw8ut zxThZH-P=C(ojF9fqJIKrfh+x2JP+LyyIDBf=+p^+=eqp%5pg4@fMM_0`6>IY&`a(c z=H=37cT3QtVozzP!_C9~RmQK_>zqnS)m@#@4^2$nj4l^U8xmP~;2ma1ueXKb`>$Ri z7n>vJump|zU%e!8`&PxHoCaE zC_aTt-|m4m!m~XE?^=5eWYcB}_uYyPf$!8aUoapYcy8gl#nQ&hNUOEEVYoWu%Oz~(8`qDQ-BO2g+UqK4 zY2y=W+kHO0mmqyDuBNK(UB*2xIIDUSMnL}=+BwN3Cj*80c4#Ba)Q&5BSsjKKjAyq) z<4?J51&6U$ov!@;VDWFeeoVMgUhrziwTo2O{OD%R9xN6X$V2g|ST91_gxzvq!9YAy zaMWqHe3LDb<&MUJ^@*1v-%IyM&FLCxX^IYnD!IU@3`!8(z+3}cDSRo<57u4~hwcea ziqfrI<4gBm5`UTFf{3-kcMIS8kWXtWd^XeloKGBj`sX%JSVyNmyLOmGK2L>k=1(D_ zGM*EsO>DV86koT_nf{*NIg8`4&?T4!+xaoJLmQ1=n$Jplst|Ul(nlNmh4*^Fh{`KR znktGecl+2j6+Dgne9|QJdH;;Qm3EZ43fizW3>2(*mP>LIr0S(!U00f5+(Bs1?8ls{ z@)@MB2%(I)L!YNNJ}+{sFWh@_L|MA`T#ZYEA{n!=XZptg;?$Y9b@jW+lHZ0}KKT*| z1Pb(v{Cta2kGr7MVCrtBuO+|C;@`~A^9k}`RNvAqZk$}9)Xels9qk3{Gg;JR*Q%>? z_pd>gGK7{_5n(Fd(|Z_lGp^s$yIC;6P@QL?vLnb)3vuuY0lzk)m7g07DSf+sUP{h% zjm%a^+nxfa4HZb$W+vBP_3jFNuFeU+@NYhPIs5vshv}inMe!Q`diPz8%lbU)aJ#k_ z|6-IHr!IgSUe)Ze+vb_>|G3M138e0#OZKWrer~kg;G>Dcm8Jl9DEO<~jSFGnpYjZ! z8%NCdSL`Gd7X0PtM}h2P#A$hrMMX{DEczOktE82lg2f6KrQllk%+Ia-Vr`2~%UvyI zFL>ouB~FVxPY>p$wi3@_dtnnxE(;Ch{V_<(N};DYnqcU=tKex+csf(~+;}~PIDCp^ z=cGuu_S|hQ*1$M>)hDNIB|q5f(?07nYXfYD)=2v|$$a1Pi^40?o7TXt6{8L>~`o2?dzg% zTY9zoT&RDdSLc6Fq@V-5`j}w76NS^Q_~0YzZJ^xVGp^IsxjZMW^m|+1y%M{&={Y_* zm1kZ0&Q!8zdgYtij9BuuTke_po-Y_5AlASaV2xA>Us{WvWLiC4o_9Ww&GNJnci=oR z!F)em>WLER?-hL6njkj(VNXxHPmrC>o`ihXe?o#KUwSB+1q9R|{os9Kjd4w$ z#r`i+M}r=pD~&L&%xO`<((DE8q`Q1{;7vL8S7q5P`r+C-I6CDM&E&4s+o|sykBDS~ zzlx(Z{TBY#4^Jh|7utS06vqRasb3VIlRj18w32<}AX2^l(ScE^43i$Pi6w}0EqIo_ z-NO44eWK6WTpB5yFQ|d`DDA*$FD!7?1i3a2jGc&7-^7Mi{N2c>GF)q?qi)hX-5MzP zK48%|TsCMhZU{Z>08ximmsS&{n+W-xwl#wKBW@H>r9kHaQ`PB}c69EaOUVJ)wdyRE z=Pm5(-=tJMho0pppFT5g!J#iy*s{R#y!EsKB84tjaM!ZbeSs&JIqxm{rpjj$e0Bud z^DYwsHSFold}%VS0v?`jBA|57v)(17dbQ7b)qDjt9^W}w?%4M;RU^Wtne8%K*jv+> zXCO?uVS>b~x?tf9Xo^>zQ%2yQ(xL^U;WJ1T{WNWupuNvC^E=r~{#on!X6Y|__PJH{uQtN`8&c#)W?`w*qDC8z$Xev zN0+}|q7FOcOK@csm^yy_X+TOk%?pB8-`slFq3&FmmKH2&qhaB9WU4}IvAXi`=1cvgg#LAFimZPTH( zVtpE8&wA&xS&A3^$HoNfJ)w6<9B6w)>=PtvJ$8$p1J73fR_B>5OBk%fbk+Z~?0p2N zOWKnBP@)R+oXXY5maie?JNsU~xj82E**wT`2i{xS-D~rp!QlaWaX#xAWy>>2RY7#Q zf0J6_SECD>y8<@R-o*2c&U5b9OJ4XI;2`^A87RQPv=FNYC7Ytx$a zx%pC|c~2i7cx|$k2CbfOBjNCmek^PRjuj3Stk-c2fl=^`vZ(JaSYNJ3D^(ynx*UoT z*&4jk953n9=7}NFg74#1&6kU(um%gVVG5b{R!og=@rx7D-stW`q8c>}MH8~H^2T)3jB*3yryuO5-xPEYS z-pKM6U{$P%JFRf_yqq-ad2IPRKG8AN<{h)fAC&4YQoXrsx$wT9UK+8c9bx=ywX#d^ z%6gGt$$6gD8Os-K2<`Qa3;v$#qvoMVW(*XRhna7YIs>kGwcoK%72nWaw9*w^^o#Vf z^zli45WuUxQ|7{r;==Cd?exg>HBaT-Sh?_z*tkHPyPt>)3Y&-Y=Dm5H*WD5!|;}3qoj1b z;7gu2fq?5c^zCz<{A#g{_1P2_gyuG@Xec3^Z8+HO8a zKK~beJeIWR$X80NY5Qz1TIAINp4FJ;-v_(6666x<3W=H&6j6221A)Y|U zR|Z`z7I{=;7X?P#7XLaYtWxGZt8cR7Y{zSxLzO_?h}2d@ULBLZ6;IaAXT^L~Hm{y} z4kNAve4{YCnz^ zs^jfKpTigW2b85Ab9jK!*t|)q#`1&JviZv$<2Xg6KLD?2}vppQy{9?;LUE#sO2lj(rt&bL6dWb&P#JV;6`_^eC z`n(-dpbtWVZw;0bk9O@=%^?n_ON>8lLLJIm0{(4z5X#u41hZK3m+0H3*%P79Zf`k5 z81Z>kE&K!Vq}>If%FpN0udch=Ej02-9n$!a@h9gkQRVQ>{7nU9V(n2Z$OmyDb^gS z+)V7DEoMKh9dJ%Mz|e%9RlaXT*5d+IkA(2G5OOV-QTg=IbJ5QG?r4E~ zBfe1W>fIXH((8*gf@igTFPV*>psa!zr?Py;csMz9)Pa^g;U6uwd^?efj{k?0OrK2E ze#iXUDq6^|!4t}^k+z!iC6R7G9p2riCK_k{#6l}$tv>no@C?+gR570t_Vs0rFZt`@b1CkKPLEnY*W)5)E+H`@KGa4ASCAfN%5$Ue*_e{` zt!q-Gv6|bv(~tY1n$ez7RGCv%>Fsx?wlqJeWlMipdPiCw6%&uEr51 z>JaDQliJfbT1E$|G69^!zq+dpt5r>V^0-`hpz%%aTC$cdwFFpfBbF%)o(aoEW$L8C zOq+7d@~@P{QTcFlzD&KckKx;$9D9BAC9qZS(@bHq6303G8t@gCUjsUdNzw*2s_@dV zV`G>Zal5NDE&Kp-8|kaXgX!9D!KXU$)ecubMvd^$Km`yCfY0^cLyY~CtM7!|z0Dt= z**nd79LPNU#r2jgz>AhD=*9C;mlP}OXZ%J#j{4T4?rU-M*+F-IL$Z?o)o^2M$K&|d z(5rpghk2Tf%)NmY~BJ&mI@un>y=W3R; z8A{T~pc3-E3Z&O2+BN!9X8mZt*2nhDEwdKWmOSJIqxlQNi=*_2T*fZO`4^#`T1&>? x?*86>3K^py(41$dl{jwJQ}7#n2})jwP)ErP@8s*d8)rs^i_</fopen.bin.22 b//fopen.bin.22 new file mode 100644 index 0000000000000000000000000000000000000000..0b5b1e5cd7d8663b95b94c1c8a1c3bdad37c0a96 GIT binary patch literal 61564 zcmdSChhGz26E=Kyv#GQYy0ir%Mr!DYfJ>zJ4kBVuX^M*2u=20J*EO5$Cfsn}3J>4+ zzWdYVWcQRgGuO$_ZLboe_r!!DwNyt*be#fR!&R_8hOWe?T|O` z<#S7(c_o8T(TV-j$SDu>$_roKNy{q> zxRFD}o3A<l}?+d{%gYNHBZa#}|>9*3+9$A|o0x=~gxLYuoE*l-%6r`V--4 zUVh8^uQoo*&+!yjNvI&S`{w5)pG5?dsDAe#f2z=zK4sdW$^AJ{3b}>Ohk9Bil$*QM zH^-13>g_1CMJAZcQTfw{eBsG^a=2b9p^v5a+8?Nj6IH}ARH*k}x4bYI3Nnfj8rW}W zWXPN2>3uNIP(j|uJD*|<`S(h5Ewwv6_m;nu!p}*IKMQ#)!|kxoev`gy47fM7JB!~3 zyvcPiU9QyBJOF>Rg36bFs~CQ%$`4hgicUqURvwy4JuAb_LMHS7ym?OXOkdz_PpN*T zs#bIJ&lE26v~qfWUIogPhPO)9l+L#c%v9ZO#p0;yH<9Kj_@i3h7WBpz8B3|wSZntS zdF!cN3nwi;bKkancu`yHW?H@a(_?2^U;pOks46#8kTFO`ZkiUg|7hYx0W;O|nBqdF z^@9&vM%_${ST0Ics%10szQ&>DgT-grwB)ODunt0>#w$q3Es}B7!s6I`>-;i8mO51G zJ!|BpOPr+YER`>l#jk(Eyja?yt*r*v&<>dl6Xr}|3j-`r4 zqzEe=46!fs{nz*B&q%#ln8YJisZKyxSsGol@JrR*JNa>cJFB2;fbf&#&z4&Xe}#rnZ?@M|JhZv? zNBASnxPZTR--K(ohQB)EZ(CIWW)U<&MhhCo7;f5dHx;lwph7d%-GSv|a}qx-%Y;#E z#BGVUCftgN*m^#O0oEr36QZDD}LiU7Wd00^22i_fxY*>`QHMcBGUGOl_&IWj*##)c}(b{2x)D50<` zl;7@Px7@*Qg@awhOJP^27wld}#tWCvH?f_z@Y2|Y0mEhf{P`8)WwY~V*agkFh~2&0 z#qK>~cU_fR>R#Ank;HBtu$V(kHn#Ng8E*bms9&kEcK`1$F0U@bBqd#CA?XE4!=r#G zE(^CqZKdl@?>6?crNf zsr!MFXA{Eqt91WyRz0rK_B4@yE2OOH{NVh2&CTyR7y`{UVBqODNsU+`^=fSE-N1jr zC$mLNQ)Q_p-Gq{uO*BirDl|Lv8to&0s;1BxL_3UUrqQp|w$J}M&!zq{ss5*zR+zAm z@dXK@6`$nOyVPG4lbx8AyPe@E~|m5xBa2Qgrn05N2d|b*6APJopqnpX2U$s&mC>PhOvE_H+|B^@A-z6OF9x&BeS}=7L9B=FjwGoaBs=Qyd>4s&i zvnn$o!<*6}S=;(nldc~#zC#kw17atB#A%fdRS$r(MCn;|Ez z;!-1WgqnQ#{lActsmW=oOl6O2n2AMYn4`Q=YiqXs=i~n_!T;3S(qmzEwtUeUxI$~^ z=RiqTOI&&^65L4)Rz%WTTlyxgwWY^ttz|r0Yv1&f2h`fqpO+Ml?9$qEGv4>BPL}b8 ztf$r<+HJ+3HNvI#z!J3fNGG|sr?s7g-VC+2Gm_TYwrs8Kq1MJl=6O2{AD_4!x=L%$ zEmk^Ps?eo$`#UwixVG9`QQOokbt9WDNl|`&mDZl8wH8s*TKijyq}JkXj9QzwtjXJ3 z)7l=gZjxHtL#>^5`EoPl#8nSj@|!#qt(}#6{0nk2wKh$asd^*>YOPMK)g7(PHuZns z87;eOG3zY(mT&!w)?y?rOKZ!}Aj37-Nj${JMXIeWyPMY9vb$-mWjtGJU+0hq)Y`Jf zOA25AU-75_$=0?L$Xv z`?9rmm|FY5(b^uDLsx0-3k$?w(AsKOYfZj=e(*j+YhPG=maXSiS844FM{BDbt=*Lj zsI~Un`+?R)dwA^Dw04-Rdqk}rrq+(Qe7PBN;%b=4*(FD)wFgP5ZZ^UcG~pJ(4~$acnb#aIJO5qRh#JK@`X0`cz74z!8;qMacRI1De*2Tx6cJY1igyf!>qj&*6Dm7#& z^>))j3P~F)HXr4Zz7NV{ofsA(VZ;@zI5TD zhSnW6gAwVj+i+yLdo8^Lq1;g4V^;cHphxWf?lX~rkRiZirh-$SgHzwvl@A{ZNZ+rB zvciU>?MB*}0hLZ`4+H6_pu>pjG6+k>6X;`-w1Ndvs-gkiEKMTbFc}6~wA$`b5YBjI zjF;;|?~=D6WeR;rYmOrqrtp7y*gn$-`m~TTg38!3o}d422bWZPl($kUC$g_)F)ZNjQ3*CZk$60=m##&B!Iaq*;;)^^%s!><%+ z_efv4GDmbJZhRl3Fz0HfmC`C59(1z`!kqgo&2}N$YgA|fnx&#rBNuh14~#HbRk0<5 zCO}BuYs`am=xak{&f94wqtsN4&u!O|K03@{MS^N2dm%{Zlb>$rfq}G; zIqvmgr8m~Y@SwiDU|(pAw56yjOo{;N@V02Pz8v%g@S=O1^eNC>W+Bpe)lfQS z>P#SGb}sUjQ`o$;Vkt<%a+{i+9h(@LZCxFkAKPplpPC(OogbMSqX|cfw8LDDit%4r zNfib!mrc+Ix0W|+H2bw~p@l`z z-P&FGuSPSYlTn-!srGu@U`TCaxkyd%ATpXE&Z#vKnY3$*%;lTi zBQ^sQ>)u0uta?SXKCn-wvOWz67jK*fc|UF@l@kW#NYWwDA~< z@bpY7Ez$H!X(N0#Kg|rf@odgbp`u#Yh)pB1o#IewlZ-suafk&09WmgDKgYVKk<4NS z_wmfbXVcAESXHq?a5@$-+X9pJ)6`)vf`=tDUq~NFMjX??Gq;g5eP`55n8U4riJsxO z3N3Z zkDwtvmn`a{XyP`bpp^wJHy4*j*!pSP$XrE_(LzgUh~i;$vT^=XRufRt3U6Uxz+Fws zWzD~$K@2TR0~9tet#3C)jpyg*j8Z|Ute6IB*$x9b$6SPAhYUp+rJ&iwJqnvB?1O)# z^kS(rL*9Y1Se3LcM~G!JLc=(ug1tfMQbCFQ#0slCb2_X-n^xKRd5oF0)#GNud$64> zRv*Kz;Kp`6SZDe`8Y##%$;tK|WGYq^lp@rNH@sN63gH5HGvpbX>`T4hTT z06}`$mc9tbI-&GD$v|!-h?i~%>b4spP_Ry`ujdOvoeez`t*JCD-N+!aMRFy?3~B^_ zWeH@%(t=W2iLw4-i1ZZ#coAtsYn>=QiNdsH&NJ$kUS>DKsJZPtVd)BTRcB#?KB2N3 zVd#h|8^?39xLi1nC;A<*So>*<790{!;k_UNKgg08Y)%yHs%!M0&(~CVr{9sj8qUNS z#ES^Iotd_0AxAsCfSkTjG^vc&1e!GrM{B5{gSEPPV1&?f7| zhHjEb8-$WGV+gb5nSERD+A8~n33yf#&J%g1^;x({2)UphcouNI7BLT|4nJ7B$iH46 zoMcS1UDkH9G0Z`p7aPM*syxo8xYp)p<`*{R&Bf(~#O&CdIW=!iwR2FQ^Zn#^nZwnY z3)Z~hy4a**uuBh`e8bME({|^8Y#Ho|d|)HTA&}~j#aQSzSLY}Vh2Qsk$M)szRZZZC z+hSj<3Do0g0)NecGChuN^RERrzngggah(%O)lghq=r$+E{>uY^uLpA?SDLDdm>v(S zQQaiW>fDxdF98S;LkTfAm9f=uDPg9ljeQ6OJ7Hc`%!Jv@RmuWN@KedprAB@C#2gQ+ z99n^4b~lU6KtD7)y8XG+t^Q?D`ENI`6J=e50Jyu!r?UDE1-aMQ{AlaKxcGN`nC;x5 z69j-%6@6L4%8@pCzBSp=G^HIh-@sjjOh>TB55tmCh*FYIr^TzZY=Y0i}`1({evq< zO~;m(7nZXn4J!^w9}L||K-uHADHwAkJ?=;v@luj*a!kf$h4=pNB+XINYVkZBiD@ltSTlG@3ko1h1X}ySXk9A#n3H9e59b8 z%+k~Z{k7pI=ix5WH^rCe!eg+@oWzZ8h26$)qdCT~gP;>PXHcxxj3I+f^g6@{PH41d zTkJl>Q4dXqi(nm*DH_Npc4biC92Q=jOz;Il-c9S?`S}7~*aq2Di#A^(5*m4Tw-e3m zp}rna$w-_Gi`+THA;Avr#;wK_14lP&se)Zf7~Krv-f?XNLTGR&>ik z5f?P-?v++F@nm(Zb!BR6tTlmETj0-OMl-u5x>ekqKQ!f7(I<{>Z8^Gyc(!h>%NkO# zqL-0T=hp3}R&5Oc1!}6VFi@iJrwYFCPdX#XiU;dukvCy zQU4RR^9sY3SbL!g4l{v&Q4Pr8EoZ^gu{pq~}=qk!a`N`Sa56EpU3;hXHTG|vc(AGy z^qF9R%{3Z$U!94EY%tuApFe|k^?j^9a!Ky8vE%@({M=;}G2yW!U+`xxg)C0*<2tlL z@=P;*PHC7iu?INuRs|Q?>AR1N!ckJ+X@x3RvSBl6ZlUKbpZh@0t^duj}lk(;6gGql!Xu|b#p4>xvIzh$w~ zycaT=qNniA;Es}B7{MhQs>c}em_iU%=omlG0`u5+$PKV>|3{$*h zL5@>|c)&Bdmg^lPL&hjBBO_yJ_H~>h5I(}fZQ-RhC!}~#^WppPU-d6RGcI~YvIzRt zJR{EmJfokbs(jINP_6$*=VDt87WIgYRUF?rP@w~@KjAa{D+p~0VN_4&zmtB1H3@EcpVS9|2sy$GK;ei>Z ztDB%Z4P=`=mhyZvn^d59a~k$p1~kl3h?1H9aDIxjhmZa}Q_glhcw1n3#TNWF<+40OMm za0?ybh8|iks!~ug@w%Z>`(vchGjt?TEMli}c=Y?ZpokcfF@>KtfKB|I z;E3Ucg*Jq8gd?e#=|dDrW+E%;GIlKw?BR$B&{uMz1KD>b)mbBA871vo=v#@So;5KH zU?$7)0u!{aP1Fd}!O-8n1U!Ip10$(WNu#P_Xtt)*cBp)&`p^ayhdS4$`m0Tc$|#qf zgA6ONv}&m;LU#2vc2#w=37LAv8pf(gUv1dLT8OfGbji31iK80&c^oaA2g;5cxgk^y zHYwvCr!F;)esCngXy~@^EF4wh@ELtF9V{=LNn5>1M}3>=$q4mGZ`>C$Y+9mt5W#=D zQ-~=mqtk3ccQ}4FQplxJMvD#(N0*ww1L-#kEhIy4Goc((GTE;c{z=!@zWv5q4JDo{4{r)RS3D_@@q^m9iLqrJzg0Ymjy218 z(2i%}#?h~pSera)JkSkv#N=7GsX`Ns#|3bq2@!=j4wd11wOz==82r-BH7++B5pEc= zkkz` zK~r2^w@AiSvVv=Db82OE{n8%6*WQ2AanJN<@+kwec7Lo-bFlBGF@5%E%nQD~8P zm(enm!Iv924z>i-j)Tnzv!`-MR_y=b%J~M+jEnrUgnzeY9S3P0InHVfMzB)Hgfw!fm*UES#>u4o%TK&{7T1PKeDjJ{GTQ+o6zGz^bnT3@^Tr(kKrFHda zH|c9T`U#7p7SN13y8c4^^otkP2&*BLc1GaB$Yma!z1W14bf*H-aA^KC&cE{-?cdCjHGo`P6fLS{-lAydDcW|5c3z5fMBCvq;(DFs z?-n!67OnS6(f;$$f`;!RS{z!CixJ3_+x^WE?RQ7Ch?f#=z9ZVp3eT9_y{XpDQ)|Bo z!zfx=CGe*W3&_Pq(aON8y0wPo)qK)RI zMH|geiIi}upO-??D@Ux+rE$NF(@d!vEn{-J0|E-r}nsjODNJ<%>uYun(t z8Cc6Vr6qY7A9^lvr8ze>Sp|2Rw`1Pyae2iyxw@wyCJydOaAl!6W7zdtdLFH_Sm|sq z>}1H}s$-D6BqJ|H3z+?Dq+M*?9}bE|>sYKX`;LAbTXkodOrUg^<>-tzX&@p4bn zUan!eUaroiM{&#U^%~D4itFVzaV@({NjAgz#M_v0O5b+F)F<(R3o(#XDK~|wZ{iHi z!@&WZylEOq-I&A@g?h-G`^MfaClMl58T%VuS2w-c%lKs0AQxF!t}}Z^;UKi}-t~s- z!0sYh)7uw)AHC^mdG~uQ7LW|N~rwP1-m~jP=O2P!+B74JAHr3fy%T46~s$HMNS5w5xlhUjQ+w+p>o19rdU6L zihb_FzwB*Jci6B-oz=ocsK_x_>egJa6GA1A-t~zT>3G)#Hx=!U#SF8pK;4z1{ih3d zA7G>v7%?$8nHKFcN3=VRXc5mAZKoXaBci>m@EW&9{}a(Z6Nb?W$PE4;Hf^jHE{Yb_ zGH=lee4uD^DcTQGq$ApVml4;~+Ea@eW{VaWn&i{FH0JQ(-0Ppi9rsT~v>5L2&@r9V32{wLcu1qiJIN+wkNZTIahoja{b$4xo|e4EdlkN({!tU)~S{|==f{P610 zhVb`IRT1zaw-K;}jxBGPXGdvV{i*kiDsTGeSaeZ1?->ousYBY|xVifr z9_DH9@7@%}Z5DIRHe^dz9tr@@a_aF|>%wyD3On1aqf_JKW6LWSk=-T)SM|PKMH^=y z3eeQ*AiK>$HsaaHjtjzgC_vL?1kJj&yrFUPa-O}Zm30tx@{zkwcT#zn3T z-Y)b)gx*IORd0xg*<^3F(Vud~f}A$Pu@U{5v)P6}z2&k>it8Cnu97#4bWQehdkgut zwEDd#QQSF-dQ`tJs44DZh%egADApdytYx!_XNVFy;fof&^_8>KtRWZVbCRI4&f)zZs?(l_x{O#Z||7A)*`ZUKhm7Gy|nVTN$S zXGf$+Q(sgX%aP?>LOm8-ouMPvv-O+jDR>)HSi@!;S^R||FMI!yyY=X45|J;AOL0ba zxGX&roC9KOxEJ1dXFAQ8W#JeG-msnv1d&ZK-tJeO&b-1IF5nP|^rBj5Iwnb<%@-Sl ze1Gu8yn~TcFRa-}eyW{e>(yuBCSy{PpRk>wh@$o3sqIu(jiCpopT93a3UO1HS!CJDJ*#$QI5u3iie%yw$in&bBH~U&Bzyi}m=Kt7BWt- zpdpjxA-ckOG$!{3F@p-+u#%0ZcbPs|pIumau0!#zZh_h1Xd~X@%pdP+TO-)k&Ywab z-$wZ2DO0GI#Xs)}ed{72X7E(Jb>851b5}Ag(o<~qRP88R+C7v@hx(s3l{DoZEA6g;Vy3Ro|pkpzm-5*8SxhifFbX8YF8c}oITHZ*+%}o zR5$Dvv>BY>oCZm zydQ*#b_XV%6$|o>*{u7GNU}kVt!^OPV2Px?Mbh+=j9IbwmC}&n=b3+Qy#Lot?fnso zxoBfES7=;i?>!_VCq)aq&8f3Su|9ul?~hol7%iF92v3`O zyZUDD{L8f8e6@9M{^qhW6LBW`_&M=?2R(-ydUZsHiz^P4`y!kXuc zJIBkKROmE54ey9WmUSlZlOec>Fjunhz4o1V=HtI>4>9@6V&U1C#8N#W2`^+V`(SNb ztMdtoOH*jrj|#(KGA~u`c8%JxA2A>&{V0tB| z(4k;U2SmtCn#!tUE_nvFY^X>d=T$v^yGB}`#n>cR_#YQ%Le55`k8U?b%Skj|{25^= zyqrvJ&676Zkvpib&YGP2OLdw#6S0eN1wLvM$9A6Z=;n_FCMU0rAu zJJ-6p`lQwQs8p8Kix;Jm0Zng?@1HxvJMp5l>5CVoO&=qp`Y?U9vbT@JJMm(RIb;HT z_k7>gkL!53rh|iiUxa1YL}K7_O6I%&4F?&MiE;Lx#Of``P`kQH4Q{$S&KIE?@W2CK z#4_Mt*?WFsD7QS+83Pj3y5y%zz|MMz-KN2J^Eq3 zP#HRpAL(fFYyw{>ZrQ6WeCD0DvquT>ssya`nmq)t&8udVlY!^hJH_LLR>Q`GYSbH{J9cZ?urt1(am2ySd6;Fi1vjiWcn8`|`e6 zR*C+hyAX#Xi3<(i!lpEQMAJQs&$1D_d7*pg7Rk5@oAbt2Rv60Go_k`3M~h1a(EGGU zsN(l#81E$uauf&gQi|hE`wa1z#dz6dtlms?lzVqitjz|%!DGM%oBPtUP2Q&e3 zvnW*WIP}I<6r$UHu@!=*?V_DG+%skR8Yh)zF;mxgZzb+Dd0d%X&v-wyGtD@rclR7; zh$UH+wC(*8O5NshNbl;@`dI78^2FNQ*gS?LE`aW#fUaw^>;aAmwD)$zA3C6W=ztFK zY|z!nvK#L0h!0vUCL44apLn>bwdNDezzmp-cz5P7ZCXd!NEN=;)ZmvGm*((jpX)r=_hjb+wG=W{sj#6*J+#|B| z_tYjVxMY>xS@ey`YXK|E;P9Vsy!?}Y`>m>&^gYD!-W7c8*g0^qP;VUth)d3d31XIsZdre@cc$5ghl#e^%kkuw!Nl81A4~?z! zA&@xYrEo8+5hUKC#dz7c$8Nf`w{TP3j}iBr5Ek4|V$YTNr;||eMM*~7%WSZ^H7{kH zxaUZ=Z=7e_!Z%6bYGx}Jp|)HV`qbD$c=P8{3n4X&klCU%bCaPYl|=A|?v&2cpn*i_ zf_NH*%_cIH!HRk|yXd`zKG7p7>26F9R`6$z#Dk)wthb3%g+FsAqSg`Kk71m)-?yTe zK^bvB3|U5q*cB<)MQ5k~`}@zX1g~eBUs@>V0xa-Rk}J?TzcAm5Z~wL0lcpEY`BKpN zsd?mg*s;nl9dy2QtTN)+=&Y7GM?vSSOUTIhOyNz@xkhxNTwJiqllBKf|7<}XPsPGT zbYcM9yuHbP-#XEG4^yPRb$5!iI=AR>2j%!_{CPE%PUoAe%vPj*Y8`m$54lXI?hV`q~UoYoucaQFa9_P@@;Ol zEj{~>QK0`k{-8Hxv2t0w$6$)vC|%Vl@{)|a6fMx{Umriz{skO+LoAkXocff8V{eYd zXW6u1!NMY;W#G;^Gq*^_#f<&PXd(-Vy*YwJZ^^SA3`^Na?9E9du{S4;M8>m`nD>Mf zaJsBF*J7sG6r5ym<0eQHUZs%8!g1AvXA}QBa!qHit{_3wQ=b0inLMZgX?TGbED}O+y0z0wa zgHvO^kNmigZdyFD&9jeSx`fY+9?UM-0+8=6FF7ae#Qf z=2v$#CdE4BSD!?RuH44fO44_(q9C-6&z3=-91y{+;lYSYffUYh>96dkL>dtd{S*X+ zAk6q!Mg~=M#$;MZ3MXmbrTc(Ru;mpYXED~F7dBBixp5|}V~SJH$I>!Rhx&7s3GtA1 zx-jRTT=N&D7zVOfH%+LL$O5x4nkwNCxC_!q)kO|nU`{qS&P2Y#lCl_i(1;AmqWjI? zRK=N}D-**;<2YEdMgBE5nkl|WX<3Z$7jh05Uu%+^@{MxpQ=5!vf$)WeCiYM5^Ms{z z6hOQP&AP0}5GD#(yGQX>OX9|Y?Bf%wTlG=m-yeOw)8D#BBBKHN%7lDgwKb7vNe0LD z$eJCtyjKi$*DL?My#z4D((n-_BCH;j<4@#=LsX^jC*a!h!TaX7y6B4g+XwJ7%rBEH z3;;|L`X(Ja`z@b2L~63)u;yNlO=SG;`c{$)F8y&35ta{0`IxLzF#Zsa3TPC(%sG!C zdD|nj@Fs7$qQ(CJmDUYTBIj{(-NUZ5!TDo@{mZ-*;T&~I6Fz)_a6uyL;Zi^RD6!EL zBYne~!s#edL1v|D1{PDCB=2p=+h?}4YRh<_{3CKgj59P8wtR*sd8hefoR*M_W6~z5 zGJfxjYL8V+6rO|-#VD=07qYV&ldRH6^iQz9V?svH$l>5V>BAY?xthl*O}n(9uC__L zAfZ{LAhbwj@)ax%37-*^NC>BNs+>L?yZT$|2E_Vn1-4SSydW)4guB!&g^$68z7ZQ< zq2P!A#Uq^Bw&-8NS6u{L;1zJs8`=~fa;B;J&LcQ;T$;BGv6IS5Cm&?w@W%9*c0L~T|BcH;c%WKn{F9E$RBQ2Bw!@OV;K92^GOnE2@_1np-ek7l zR4abdmnX}r7$e* zH=%G`X7A*Id=%mj2asHic#D>GTgw03 zoeHGl?3y~}Lu3Q!WWhcrmmJ^wdg$!3Sl4V(%z_|3H5MWBeumQ5)I8_p_$wO>T>^%Z zk&)e?1BNaK3|$Tw5YGlfuI$DXFrbpSvMHE!t92bPnC@(x|2Z9Xl#2@^2_tf>{h#8X zTapn6GJ~UT%YXJKiGykku=|rrP2!tCRNl1JQ<}h{6R`L}2)rU9u!Iyh{yYF8{Lcju z-=_*zGCo~%Jw(8Vz?ChJ{woo&u(q0lL^dKO1QC_T@x6BrA|@O}OgM-@yc8ntQq=?z zlb2A?{l7!R9ua|ZaS;)J^G!a^%Htv;WZm}dA!3h+C}%sp2iHkXFZCx~L~xnbZ+j7( z2@bN6`(!WOl4Hg3j0^YtpU}*PX7NSZLX2%$|Zf0Vk9*p6gc7 z%{vXS(vm_v072)ITRRYeo+IzUbua2u;$ng6gPAvCwZrsLh)Nu%&T6~sGOZ0+6;1LC%?-chCgixwj~+WzW!Dnf`AUS|M~;gHlSlmAr4oh{@Pwa636&=;U;asHk5=b zQ_(tC=YAE427JN3K9zCQ^YzgA&SG7&MUk=5=Sp|gOEU6Ov|zw_?&R;#`OaZ6CL>H( zB0%cB#fRCnK&O*}w4iB^@Hs^?u5AEpc=Bg9MBhuojz0$s>9EPI46cjwwd{blh4C;L^D}TcieUmcfPv#I z7bj506j(!qD9kF{Vc9z%1Eq0<*g^y}8H8b-)fUf~ujd#>auj)vJ~>|F-ibhw;sLBY z%v4@z61p(Bm*qAq8h{wXS1SP1mswltC+4E-tuH*57on z`V2`1dpi03cEMUsuwqBFiEa|Fx_ZDzzE>ua4yg9886D4SNqVr%V$NB7{&;w$q_1$8 z2g^j#aF~-g^~9F+U|CwygJo$+GoDDg^hXa_$L4de{1OUY{qH1Q!7@-TE=c;}0?Ylw zmUGZ%J0$&h|8^x^K}o-&S*pOvrxr)8{ChMbvyK_5a?D7zm=V|ObA3^9G<6@A5cEx_ zhuci-=gH}s&KmJ|>=k?JfmRlDW`;QG%%Nvxf>$g<#_Gj}HEvILcVmcJ1sc(Tm!0CU zTpX|`RT8B+{UN=;U3$p6ISp%Jj^oBM+B##l{~Tyxf{Z0!Ul(6*Wi&U%*L}ROHow|B0Z)5%Y`Jw6g95E~qbpya%W8E8LA+crWZN^|EqtoN-i|%k?7+L( zfj1)C@c#alc;R~8!Bl;-NSpuP!MlZJ*hCWEf79v?V(keo!duQ1RJS!k5NIL1mk93` z?B_v|00=u%fi{^&ke?1FfAK}9K$&w-9%mNH4sl>L>JBTh0iQJ$226V_6_ppWY!g^YyEG%)hxwnnrgGFD&LsN<-1 zMv<8Y{D4}a^T_FjzyufMgqJsq_ZCSXVrlp!7wKcs9GK$>5_ICVdIB^vE%ch=+R3be7sZSN2H; zEsOE8$;kLF%}qVLW0rw(altSSV5N@v$L+o)$!Hj5%h~N2#yKL`kg2;~Fq!2*+?o5fso5Ia7FV5O_XcmY07(ujRM<~SrH z)7qRLG-Ye4$qf(5gl$@oj9_!K7sXEhOr7>v(=z=ohxC2J(pY!~jj)(pXt>PTuL@2P zub4bdfqpTk-lOGCyY-5Lp;w}SbY+VK+RQAb$+riVRE&LIT^zlu_?X31H!&1yf3cyp;ZEW3bxIK4Kyd%Zdlf zc&o516)c}v`E~Gs^wpvIaO_Y^d#qFp9;Ld_(}+_Pmg>vX>;&&UZlmzodf=ysk=qwF5Wdp?BcgqTD?b^f=X7x{ksFjv) zEJcke)ocNTOUObq^;Bt6q$cEwR9Ob|3wE%KuPnC-0FH>XWCf1wY2a5wLSq7f?t}^^ z1S(t|^MWac%ZR#R0xp>VB9LDO5A2VUoPMr675+T{SGfK}1^N`&a_!}IPLFjsK?`s^; zc@i8)z8FVmLHHbLz*Y@}pwoQDa#as_fNvo{MuOsu@8E$4xGcn5C-u0=+6A4bl!&q~ z24g$d9saodOHDpSYLa7 zP8r3v^-Wuog~c|XZTkoD=slAv_=9Eaoln-r21#F1=p$*KC`pUq(>m`=sEoZ!zrK;r zz-0fSXbQ`qt%H3@6=Z^idbE3A1rO;nge9#jL07(nU5Fpwi8~zggmr4*vWu&H0E&2 zRYEnJ_){On4WubAU)I8l6+YroO_fWGfK zKnK%;6s|Az3XyHd6LnL9Izggs=0JwM#ZIUKiMoF~dS=^Bt=CFbwM0BO(S18-NKoqm z*Y;#tJUO{1%duD(uaH;#>^c*l!`|~0VNRstB;*5qVUtrh9uqYP3K^n^0$?n?56RcZ zI9nC$6!VHz@*$ZQlKp*QO~Esl6v#!(*e@tr!NvbP(I8YN8xy$*@H-dyaP1(zo9zR9 z!YEj5lf1BP)9A;$qlKie2$j-JQ%5|B%%-w{UT#GEQ`(ojAzcOer9kPEz)1j4e>yyc zIgILD+XxeszCoFgf!xH?zf<)(@>3L*^vQ>n*i8%7o4}rJpKUz{i^Y)XGmWv4E^HwP znF@GGtqY=!xXgPUIKJ~fW0(H*y80^?%DLb+w&097K9#FK9pGOq;7)BHXx&&|n4f4} zeX=;#I<`JCyM|p~*k6ESu-0Z*mAJL^eVr+xL0BYYdNiEl@1$?*qd&Pa!zlD^R~+9K z@u1r9ZNJHWKZ&<$FkB%jkUF=J9-(a7g|^ZecK12zwvEXB^iC&rdu7;3UQy| zXY4a955eRsooz~}+=Zh9LV;rj5)sAgWjwq0DVRj}0vC)2U5F464k6#^k91VxN$7r} zcE-Hv;r)aA7V^3vGK_bnS0rCKb)=JwP>L3%UVnX9J!Q+|kM=5HIU6s^qg>=c(H>ZQ zmJOfs3lp1ek&LSnYvUN4WhlFcb|5Go)%#;O*)}yYd*Gn>z(FzMrBE!3v}I)W&|-es zWE5wxW z+U(f;#Ofq}W`p{Nfcp2l#s)FXGMwVuw!6ZSg-!7=*1U0|)2*5=H)}XTw{2cqhLrqzr4%yqd?@T0$LjoKJCQ9!Uq<{f?#EcacdI#1DzG)CNGO<;Lw%wmzQq~q%Y-!e{cy`H3L-Y-ge zTWlR32h9tktCaNA{NmbbD;jW|1kAKqwr;3F#61zKfQyqBcY`DD21ne8mlC%uK@o9B zE#{YP>o)$!;zqf+DDJ;GeP9TEJ6sgE95JJAYwjt;UD%)daIRBm`~!=W<`{oNR|UlyGZ#!vXftxX{8nL;8zvq_z69Ms6cy_t9E5!=J}*SJ^L0 zUp5kf;!Nr9<;`M_-0}3UC;b_VjL1~AD zc4V*N;F=k2`~=HDxwr@c*-!kZ5J*ZgLZIgVGYEh`95PcrzZn1o+Ml$)kGl$S83b6t zQ;W&6nTP|u;(Us0bZTXBcI1gUzp!eKtmE{Qk;Lp6UzBcaPKdj&GnbDRpJnF~;t_*7 z9RXbB&Uh1w6qz@C=)WuDIp~3Jgg#h|RYZc67Q+#P{@`m-cF$Gqzx9I+rP5IR7 zO4?grX&u{~99dgg9b?zSRqU6w$W-L3%$a(A=FTO=2_D_D-W1z{iEvGtq8v zSFZE(6aGaW(Qe$%&n^D6l(9QKci4y9+p@jV+(|qQ;}n2$OhrYaQx?7^8e=@UFrcP1 zWbq8WWp%KAQl2Dz>+)`XY;^!R<8XZ5{JaIR{~UxNu8N2Q%utje>HqdJ6z4Nu(Sb^H zd}MWG)*M@2URXAf-^Rl7jES~nY{gui95WLm6Ln@~p2UVicv^XDFU0R+c_tx{&8bUN zuy|(Zg+cmW%G(RsPtDHaB(zzln3Ywmj$`i9-)C0UI%@7^TEpT!ud!>mmI1IXiJf0C zFLHULLnFbtwNV&Lj+%o5=jV^ke~_BPRK(|ay&_GC#V1dSr(4%Z-w9Zn+7iR%h&Vcb z=hZ&+9QKk&a6%}SFg8M|YRK^S&J={IJ6W96qBt?rQWO05nj8!P%PhCP} z3FhOlBRAR&%1PI6-sFP2kiPi)CvU%AHtpsGNZ&7Dix=>Wqf<2#915bVh3WGPJY61N zTwR6`r)I}S(}I#HlH3*T!s6KcxXB}uR~YR=E-RPhA{of`Y}Nzl1YZ`a_o~{|WH=|M zprkm2UG_fh>u%oKA$JX?o>@%i>ZSR!;ZDX<+ghfOoXr=zzx`?v!#3yb;EUn`-tEkE zvHs=f_pT<_I?Ec(kw@*n|B(XuE!Kbdjbkg)y8kaJAi^xdKc0z`AochM;T>(6nUb^= z;VYlt{ez6#CA{K9skcvi-##tqd{A=+I=leJ40*djeMgwj8uMmKe@coM zp~-{k4Zi(S&}sUM5DHBcbarfzKL3)?SJ3(Rq!T}b$ZC7XK*;DS$onyH=F*qz1ZoHzKT`YGd;_-l8R z_Tu!T_81y^70`iGi?Ynp(7T!X_W!Gf!W&Wg?7Qkzx609de8no#@2dEn*>^uiSPgZz z=^I9H9lul3%8Q{p-(F;-h%i%m(c1LwMc==02nNMs#7qwTUt|jYkVBP^6DcPm+I{!s z`ZYL2;Qk~dh%5c)Wa0TQb|w^DcC_|X1ot}sim&;pkrTkMXZ-YptzYD^Z_$q6(dS>4 zqiw}X*GRj;&qSzD+t}0mYI&`DIuh^h^X+zGwRqN)hb0HTVY&f&dt`Ed<1s=;eevnw zTmm8OYw_s=gIyuL!@Hg=nq+BPo{rfkafT}N?Vry>$WN<^OfC$fRl$)-WRGsbvo#QVBxbBdu)k;&)PXva~Dl2$!&h>#x?JnMdhklOb=U40>KeCz1) z_A=ZKtmM$2cf&#KLk%GmsPZlr_nV}upybW+Q^T<||Z`(8YvOWy28fl-m z`NkhS68a(&54b)CNBir~?~V&MDvLLEJ+GMG=ID0*-Y`OXOJs6ptOp@&+Nrs}xPLN7 z5Y^$-Jir?Hn4+op$<$*?+Uqw)>Q3$9iC-zz8--lf%0z7R=HH^qm6ySd%bu> z6;|S%Ds62$>a^)gtakZXOBMG09(^hGDEAb%2AfF1ns>FlAW5no>$MFPNj^J>>{-~i z3M9^vzEXs+(#fIE+cUW+a=TlyckhU@G~Rk*D}y2#tE7AOdq1A355AW5Zx(ZY8EO9L zPa*)BpA{9^l4@UJJ-R8z|2BlVxPs(U3elnL!o%ZZ_ zI$k{+WZEIryoLxZz=#QFTw!)`u}#Lvn$@z?j!6I<06S%%?x zzWj`j)C6?_-0-O;w{G6qzW1*fFNwFW&`kSOyr>}2W-{qv$=dzUDnfx7BeoP3{^83* zr{)pkJsUfYL387Cv3gx}VTdfcj)JQG8#miM5O2M=1U0hiE$-7Y31I-wvzkI?@pw@@VAMiL9N8wlt?lZ^AtY_3s2`t9-2?b@eH4{ z**z{5u01rY z3V)yBk+<}DG%}oL^RKqS5Dx8lr@z(S zcVu$&OEI4LKQ;b(`}wEP$NJJ{>wQjrYsQveFT#SLB1Og48|s2Oc5CU@LtkopBKo$Y z*BYln{XM<5=$#@3?cmk>B+H#DnQeJ5ZO;m&^_I^%JRPeGQpt zN8M8*{k`JPJ5$6)VA0#%<`-n=u_X~?dtk51$u;d2Z3N}3trlUEPaRVD-!{#U=k^MH zqnmAAvVOzkGqvRyOPkkc>V3lTezfPsLe)v}#?C8R5Is--9ldi%4s}yTO9-gn`oY`e zCZFB+F86(w(i-*2g^D9}G<*o;ISNm7S7iRqWQBt>hqc36J)V zO0gIlft@VJGtZ`X)z>BRDA%WYb&+7aWU;so8l|*Dmj_;>xMqr+oOn0>EaJ80+jI9= zQoI-&S_^a`g$jB$Peu*aV>U9dUr7z{z4Q*>88rE92<>k_F^P>=>&c33gaR8*-D0T6 z(QiCc6~OKR->Q?08g=ZSO3oozz1m#n=PT*$+osIDC*IY2ALTgcrT*>NvmBw%r8!d4 zyu_S+tsYnlkx{27{K~fIz22G1xg_%&fkwT_K|l?o#eQt@Srt4%-9kX=-hrMKy!C0H z^qR#g+5>E$SZ&8KmAEwGZx#WMKT*TeaXX(V?T4L{{5)F{#59rh8E$i zc2?3;Sxrk5%t4Jrm(`UYY&&39$n2 z_*S^vf)t-nH=h>p&KKHkd{nP3p;hsz&#<;Bu6g?=OhxKT6RVvk?2Q?!WMFpqE<+pM zxz(Z|a~VzZK;5GiWjmvu=trZCqO143n*--kk0SCQ#1tjL&ZBsT&^J1|`sEz?p~9#+ zB?JFCO=%4NpNG;np6T(gHZ8@(0aFCqi%+{sS`pF{rODhJYGde;x8L^zyz;35)UrzK z%RVjt6TA(S8nL&fM|@l0eb8jv=OC$%@Yy}I&LO_lHjg^|3x$q+lYCp@?HNs3Ww##a z6_w&Gi1w~;=Y`3u39mkMLNuuwct$w50ci(WBPq94hyIF1ij58QEaow-5ADp>6w5uP z7fBpwdqnI#ywtj#8a)J_?RKzXy{zw1gV5)lzmqgsn&r9s!)_tsKwZkd6h)FX7%f$v zVe()Tp+L36gM1_O*4FMGhX;)=57^o>g?Ep~wqJZ&4%{54K}{qQ@Vuaf3LS}w5>B`y!V>tj#uqcruF{Qxc<(rU>A z!PUdZwd`l&^3d)wt@gnaGiLx#YM%@S=NZsZ!{3 z_|oR>dC?$ErO}zCNp|nczGB#mVb}c;9_q>}61p%fQV*7?i%9jU3aPUugM&OYprR~&s*>M9?x0wX{RoSio)g{JX6L(iS~JfR>1Dhh&+lsPvOk5 z9vw}^-{gp5bTflvi+Bz})$LF(L7?(O3d!^`Fo;pOzDOe)pU7#ox0xL2jsD!~x}Dbhy-`mfezbjY~ap=A@%fJA`~^ zC?nN#x47fHNa!ot`SpwF4AsC3xBI{SV;={`*((B0dR`dfSw`VYjg6AhC&ix&eMtm7 zrzJgi5+*}?kycZiLMW8uT}j$}DPfI7Zihz0s|TzH`ZJN|O;|L5xhH*MEM?mfuYw5E z_E}%l$ft$gKCJEV2z{`&cHbael3x@KF>N1OagX3&za%dn*kQT#=ygmc5%Nz!Ys*A3 zRp|fPX&1fgFY+cy{ZofS)j-{dlvYY!y(WEY-rU_!it%b3UJYQ}%#-9Z-`K~|M-~G3 zq)BAAw9BS%U~XD!`K4&*U8%HS!zH;jzeSIf!-H3#Am#ZMb*z4-EVb`0U+5`NmimOt z1N7e(EmAdJ6t0!!XT}_RHX{9g_A1)%-$_=~vBKjL2FvnXpW zwXF8eE!w@*QMcy6cz!=!c!QHpWS5Gjs7#r(-NPWIWlhB|Yu!*|W?2 z;cGuijj*7NpAha=aFi*BIq#wW`@RMt|L^wvrPER2pT1wVpG0=rJLvBYLI5;r#$V7J znW;M^U+|5;=gUVHpG`*c7Qay&jlPmMv!CFZE6)$MV0p~ti&M)ghTwHBKYm)P#zEm+M{?&8hnRY1H>D0FYR__J-#GZEa z>AIz~Wv7<3Vcn8TRYUQ}Zh`R6sb#%eH`?(ai%phvpB+D zkM!LgA`#<5?CtzyeLrT@{NNqiL7&!3i!SX#uV?CsJzo6Mt)(`!_wJ$4ht_YG6zIc{ z;7gPFO^&TUdX|f4DxBziRkOg523*}oxyomPlRI97LS>XH;`y}CPR%PBLNCjw>ftGf zcWqQfsz04d3%f;sV-jiog`U>)_o5YkQa{ZUN9X9{7tmkHa0I(yopnb z5pj%KOHI*UV@#`8>_Hy;AHt2#|EG#8e@Y{X!ox5<3ZiB~#0$YIXjoFZqQ-mV@WMrn zM|mP^VZ0&|;#HQ3|N4I48wA5Ibal@R@9yut*NocTtz={V-P02HH^&QgNr}7WkpG^A zG19t>ou76_u!MdS&cfzb*{m1;n#$xs$bz375Yo}1>?|v zRnFVghB^|CW`OVlk~;_0^rl@62pFlZlIT42P6kze5#^_$K^P~km^#-CuYYanBc{v+ zbS}CLF3vDMbMJPXv$E~xXr;9fjD8jRs+^CZN@DZd?tIMENp63xpL{ed(tJ+6374%L z!D~&ehjvSU0g%P5|WsGpmx{o+QS_A$nf4PmG#?_oFJaWlQsPs zwVO))D(%}EcU9z<{w5T>cwH)DA;wxbO z1fS1C{L@5Y4=zixLqu=S6kqEoUDsEozkRXW!s9cTT)!gM1*` znvPZ0^#7);8nCL8ST+7>iT0LU7@2YB;9e!llTxwlca#pyl@==WAtNA;HS?_3tzcBY z$v7!H$-GgX%87LA)otIY==aGPnXXj8)i=j6ehqyvwU-?hM0SB}$F`E@8l~yA;q`u= zSNZM3pSZX;x|3@C#lFt3ry`O!;@{+`0}G|M&yyF4Ly=$NWO5J@9n2ZmjWLnNO6s^P z2pJ&0RCx<1eWW0(LEp%hjTzdKxnFGWLkZ}>Sk#-EVz)|Ywus=xI`x+Q(fA-%-K(@U zP@w6zruotd#W<hg^iw)Idpp8cLZ6YG?Gm58ne_ruXpR9r^SLOTH*t^mV$OBUs+G=F4|;)oW2&b9O-9Cb?u}ZrH+b*s=4g|d z$PEUnjeQ6|MlKDWvL|`%LTc!KCT{C@JK~qBWcVFbZxn=qUKg{tSKkMY$XlejNV}p2 z9n189PZ*)R4_Yv%sYA74RQhz@*pVSxWzG}_Ev6PqZ1+3~@gxL$nAB1IHTi0e{UILoR+Nc98ZRZ~i>zYMgw07d~#Bi#v9G z!@0L!@d`xNTpriq_t5c_7!hQ4$Jma}*;rFu7;C1_ce)|fOXo&Qap=(E_3N;;Q+kU2 zn)FY8g+1fr_dGoq_*VC*N5sWm^2nXv_9#?;mwDL@aH7<-98P1vpR*%tG_v(*<1012 zQ>n(Q>8On-TY=!)Q{;RfJA{SmC29+lT9lN!l@&;dT;|!^7X2Qnc&38ylWj}3?9ult z_KU}7flKV}SD-4PZgLKeOl=6bT~0RCPt@e{J=E8S`aPVPxLDALQI(Ll#xH$_lGGCD zvHU22(z^X>_y3XAL3*-rS(SmIpM`9nCVr9XxibZuv~A;4?)q{TXYxRpr#yAUTO;@7 in_qy1 literal 0 HcmV?d00001 diff --git a//fopen.mid.35 b//fopen.mid.35 new file mode 100644 index 0000000..5c9c32a --- /dev/null +++ b//fopen.mid.35 @@ -0,0 +1,4538 @@ +TITLE OPEN - CHANNEL OPENER FOR MUDDLE + +RELOCATABLE + +;C. REEVE MARCH 1973 + +.INSRT MUDDLE > + +SYSQ + +FNAMS==1 +F==E+1 +G==F+1 + +IFE ITS,[ +IF1, .INSRT STENEX > +] +;THIS PROGRAM HAS ENTRIES: FOPEN, FCLOSE, RENAME, READB, PRINTB, FILECOPY, READSTRING, +; PRINTSTRING, NETSTATE, NETACC, NETS, ACCESS, AND FILE-EXISTS? + +;THESE SUBROUTINES HANDLE I/O STREAMS FOR THE MUDDLE SYSTEM. + +; FOPEN - OPENS A FILE FOR EITHER READING OR WRITING. IT TAKES +; FIVE OPTINAL ARGUMENTS AS FOLLOWS: + +; FOPEN (,,,,) +; +; - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ + +; - FIRST FILE NAME. DEFAULT INPUT OR OUTPUT. + +; - SECOND FILE NAME. DEFAULT MUDDLE. + +; - DEVICE FROM WHICH TO OPEN. DEFAULT IS DSK. + +; - SYSTEM (DIRECTORY) NAME. DEFAULT UNAME. + +; FOPEN RETURNS AN OBJECT OF TYPE CHANNEL IF IT SUCCEEDS OTHERWISE NIL + + +; FCLOSE - CLOSES A FILE. TAKES A CHANNEL OBJECT AS ITS ARGUMENT. IT ALSO TAKES +; ACCESS - DOES A .ACCESS ON A CHARACTER BASIS FOR CHARACTER FILES + + +; A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION + +; CHANNO ;ITS I/O CHANNEL NUMBER. 0 MEANS NOT A REAL CHANNEL. +; DIRECT ;DIRECTION (EITHER READ OR PRINT) +; NAME1 ;FIRST NAME OF FILE AS OPENED. +; NAME2 ;SECOND NAME OF FILE +; DEVICE ;DEVICE UPON WHICH THE CHANNEL IS OPEN +; SNAME ;DIRECTORY NAME +; RNAME1 ;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS) +; RNAME2 ;REAL SECOND NAME +; RDEVIC ;REAL DEVICE +; RSNAME ;SYSTEM OR DIRECTORY NAME +; STATUS ;VARIOUS STATUS BITS +; IOINS ;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER +; ACCESS ;ACCESS POINTER FOR RAND ACCESS (OR USED FOR DISPLAY INFO) +; RADX ;RADIX FOR CHANNELS NUMBER CONVERSION + +; *** THE FOLLOWING FIELDS FOR OUTPUT ONLY *** +; LINLN ;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE +; CHRPOS ;CURRENT POSITION ON CURRENT LINE +; PAGLN ;LENGTH OF A PAGE +; LINPOS ;CURRENT LINE BEING WRITTEN ON + +; *** THE FOLLOWING FILEDS FOR INPUT ONLY *** +; EOFCND ;GETS EVALUATED ON EOF +; LSTCH ;BACKUP CHARACTER +; WAITNS ;FOR TTY INPUT, BECOMES A .SLEEP WHEN WAITING +; EXBUFR ;FOR TTY INPUT, CONTAINS A WAITING BUFFER LIST +; BUFSTR ;A CHARACTER STRING USED AS BUFFER FOR NON-TTY DEVICES + +; THIS DEFINES THE LENGTH OF THE NON-TTY BUFFER +BUFLNT==100 + +;THIS DEFINES BLOCK MODE BIT FOR OPENING +BLOCKM==2 ;DEFINED IN THE LEFT HALF +IMAGEM==4 + + +;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME + + CHANLNT==4 ;INITIAL CHANNEL LENGTH + +; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS +BUFRIN==-1 ;SPECIAL HACK SO LOSERS WON'T SEE TTY BUFFER +SCRPTO==-3 ;SPECIAL HACK FOR SCRIPT CHANNELS +PROCHN: + +IRP A,,[[CHANNO,FIX],[DIRECT,CHSTR] +[NAME1,CHSTR],[NAME2,CHSTR],[DEVICE,CHSTR],[SNAME,CHSTR] +[RNAME1,CHSTR],[RNAME2,CHSTR],[RDEVIC,CHSTR],[RSNAME,CHSTR] +[STATUS,FIX],[IOINS,FIX],[LINLN,FIX],[CHRPOS,FIX],[PAGLN,FIX],[LINPOS,FIX] +[ACCESS,FIX],[RADX,FIX],[BUFSTR,CHSTR]] + + IRP B,C,[A] + B==CHANLNT-3 + T!C,,0 + 0 + .ISTOP + TERMIN + CHANLNT==CHANLNT+2 +TERMIN + + +; EQUIVALANCES FOR CHANNELS + +EOFCND==LINLN +LSTCH==CHRPOS +WAITNS==PAGLN +EXBUFR==LINPOS +DISINF==BUFSTR ;DISPLAY INFO +INTFCN==BUFSTR ;FUNCTION (OR SUBR, OR RSUBR) TO BE APPLIED FOR INTERNAL CHNLS + + +;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS + +IRP A,,[IOIN2,ECHO,CHRCNT,ERASCH,KILLCH,BRKCH,ESCAP,SYSCHR,BRFCHR,BRFCH2,BYTPTR] +A==.IRPCNT +TERMIN + +EXTBFR==BYTPTR+1+<100./5> ;LENGTH OF ADD'L BUFFER + + + + +.GLOBAL IPNAME,MOPEN,MCLOSE,MIOT,ILOOKU,6TOCHS,ICLOS,OCLOS,RGPARS,RGPRS +.GLOBAL OPNCHN,CHMAK,READC,TYO,SYSCHR,BRFCHR,LSTCH,BRFCH2,EXTBFR +.GLOBAL CHRWRD,STRTO6,TTYBLK,WAITNS,EXBUFR,TTICHN,TTOCHN,GETCHR,IILIST +.GLOBAL CHANNO,STATUS,LINPOS,PAGLN,CHRPOS,LINLN,IOINS,ACCESS,ADDNUL +.GLOBAL DIRECT,DISINF,RADX,EOFCND,BUFSTR,MODE1,MODE2,GCHACK,GMTYO,INMTYO +.GLOBAL T.CHAN,NAME1,BFCLOS,DOIOTI,DOIOTO,DOACCS,NOTTY,DEMFLG,BYTDOP,TNXIN +.GLOBAL DISOPN,DISROP,DISCLS,DCHAR,DISLNL,DISPGL,INSTAT,MTYO,CIREST +.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP,N.CHNS +.GLOBAL REOPN,QUITTE,CHNL0,CHNL1,BUFRIN,IOIN2,IFALSE,GFALS,IDVAL,PVSTOR,SPSTOR +.GLOBAL BADCHN,WRONGD,CHNCLS,GSNAME,GIBLOK,APLQ,NAPT,ICONS,INCONS,IBLOCK,IDVAL1 +.GLOBAL GRB,GWB,R1CHAR,W1CHAR,BFCLS1,TTYOP2,MPOPJ,COMPER,R1C,W1C,WXCT,RXCT +.GLOBAL TMTNXS,TNXSTR,RDEVIC,CPCH1,RCYCHN,CGFALS,CISTNG,CFILLE,FRSTCH +.GLOBAL TGFALS,ONINT + +.VECT.==40000 + +; PAIR MOVING MACRO + +DEFINE PMOVEM A,B + MOVE 0,A + MOVEM 0,B + MOVE 0,A+1 + MOVEM 0,B+1 + TERMIN + +; DEFINITIONS OF THE OFFSETS INTO THE TP STACK FOR OPEN + +T.SPDL==0 ; SAVES P STACK BASE +T.DIR==2 ; CONTAINS DIRECTION AND MODE +T.NM1==4 ; NAME 1 OF FILE +T.NM2==6 ; NAME 2 OF FILE +T.DEV==10 ; DEVICE NAME +T.SNM==12 ; SNAME +T.XT==14 ; EXTRA CRUFT IF NECESSARY +T.CHAN==16 ; CHANNEL AS GENERATED + +; OFFSETS FROM PSTACK BASE (USED FOR OPENS, .RCHST AND .FDELES) + +S.DIR==0 ; CODE FOR DIRECTION 0-IN, 1-OUT, 2-BIN, 3-BOUT,4-DISPLAY + ; S.DIR(P) = ,, +IFN ITS,[ +S.DEV==1 ; SIXBIT DEVICE RIGHT JUSTIFIED +S.NM1==2 ; SIXBIT NAME1 +S.NM2==3 ; SIXBIT NAME2 +S.SNM==4 ; SIXBIT SNAME +S.X1==5 ; TEMPS +S.X2==6 +S.X3==7 +] + +IFE ITS,[ +S.DEV==1 +S.X1==2 +S.X2==3 +S.X3==4 +] + + +; FLAGS SPECIFYING STATE OF THE WORLD AT VARIOUS TIMES + +NOSTOR==400000 ; ON MEANS DONT BUILD NEW STRINGS +MSTNET==200000 ; ON MEANS ONLY THE "NET" DEVICE CAN WIN +SNSET==100000 ; FLAG, SNAME SUPPLIED +DVSET==040000 ; FLAG, DEV SUPPLIED +N2SET==020000 ; FLAG, NAME2 SET +N1SET==010000 ; FLAG, NAME1 SET +4ARG==004000 ; FLAG, CONSIDER ARGS TO BE 4 STRINGS + +RMT [EXPUNGE N1SET,N2SET,DVSET,SNSET,MSTNET,NOSTOR +] + +; TABLE OF LEGAL MODES + +MODES: IRP A,,[READ,PRINT,READB,PRINTB,PRINTO,PRINAO] + SIXBIT /A/ + TERMIN +NMODES==.-MODES + +MODCOD: 0?1?2?3?3?1 +; TABLE OF KNOWN DEVICES AND A POINTER TO THEIR OPENERS + +IFN ITS,[ +DEVSTB: IRP A,,[DSK,TTY,USR,STY,ST,NET,INT,PTP,PTR,UT,T,NUL] + SIXBIT /A/ ; DEVICE NAMES + TERMIN + +DEVS: IRP B,,[ODSK,OTTY,OUSR,OSTY,OSTY,ONET,OINT,OPTP,OPTP,OUTN,OTTY,ONUL] + SETZ B ; POINTERS + TERMIN +] + +IFE ITS,[ +DEVSTB: IRP A,,[PS,SS,SRC,DSK,TTY,INT,NET] + SIXBIT /A/ + TERMIN + +DEVS: IRP B,,[ODSK,ODSK,ODSK,ODSK,OTTY,OINT,ONET] + SETZ B + TERMIN +] +NDEVS==.-DEVS + + + +;SUBROUTINE TO DO OPENING BEGINS HERE + +MFUNCTION NFOPEN,SUBR,[OPEN-NR] + + JRST FOPEN1 + +MFUNCTION FOPEN,SUBR,[OPEN] + +FOPEN1: ENTRY + PUSHJ P,MAKCHN ;MAKE THE CHANNEL + PUSHJ P,OPNCH ;NOW OPEN IT + JUMPL B,FINIS + SUB D,[4,,4] ; TOP THE CHANNEL + MOVEM D,RCYCHN+1 ; RECYCLE DEAD CHANNEL + SETZM (D) ; ZAP IT + MOVEI C,1(D) + HRLI C,(D) + BLT C,CHANLNT-1(D) + JRST FINIS + +; SUBR TO JUST CREATE A CHANNEL + +IMFUNCTION CHANNEL,SUBR + + ENTRY + PUSHJ P,MAKCHN + MOVSI A,TCHAN + JRST FINIS + + + + +; THIS ROUTINE PARSES ARGUMENTS TO FOPEN ETC. AND BUILDS A CHANNEL BUT DOESN'T OPEN IT + +MAKCHN: PUSH TP,$TPDL + PUSH TP,P ; POINT AT CURRENT STACK BASE + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE READ + MOVEI E,10 ; SLOTS OF TP NEEDED + PUSH TP,[0] + SOJG E,.-1 + MOVEI E,0 + EXCH E,(P) ; GET RET ADDR IN E +IFE ITS, PUSH P,[0] +IRP ATM,,[DEV,NM1,NM2,SNM]MDF,,[DSK,INPUT,>,[ ]]TMDF,,[DSK,INPUT,MUD,[ ]] + MOVE B,IMQUOTE ATM +IFN ITS, PUSH P,E + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TCHSTR + JRST MAK!ATM + + MOVE A,$TCHSTR +IFN ITS, MOVE B,CHQUOTE MDF +IFE ITS, MOVE B,CHQUOTE TMDF +MAK!ATM: + MOVEM A,T.!ATM(TB) + MOVEM B,T.!ATM+1(TB) +IFN ITS,[ + POP P,E + PUSHJ P,STRTO6 ; RESULT LEFT ON P STACK AS DESIRED +] + TERMIN + PUSH TP,[0] ; PUSH SLOTS + PUSH TP,[0] + + PUSH P,[0] ; EXT SLOTS + PUSH P,[0] + PUSH P,[0] + PUSH P,E ; PUSH RETURN ADDRESS + MOVEI A,0 + + JUMPGE AB,MAKCH0 ; NO ARGS, ALREADY DONE + GETYP 0,(AB) ; 1ST ARG MUST BE A STRING + CAIE 0,TCHSTR + JRST WTYP1 + MOVE A,(AB) ; GET ARG + MOVE B,1(AB) + PUSHJ P,CHMODE ; CHECK OUT OPEN MODE + + PMOVEM (AB),T.DIR(TB) ; SAVE MODE NAME IN TEMPS + ADD AB,[2,,2] ; BUMP PAST DIRECTION + MOVEI A,0 + JUMPGE AB,MAKCH0 ; CHECK NAME1 BASED ON JUST MODE + + MOVEI 0,0 ; FLAGS PRESET + PUSHJ P,RGPARS ; PARSE THE STRING(S) + JRST TMA + +; ARGUMENTS PARSED, DO FINAL CHECKS AND BUILD CHANNEL + +MAKCH0: +IFN ITS,[ + MOVE C,T.SPDL+1(TB) + MOVE D,S.DEV(C) ; GET DEV +] +IFE ITS,[ + MOVE A,T.DEV(TB) + MOVE B,T.DEV+1(TB) + PUSHJ P,STRTO6 + POP P,D + HLRZS D + MOVE C,T.SPDL+1(TB) + MOVEM D,S.DEV(C) +] +IFE ITS, CAIE D,(SIXBIT /INT/);INTERNAL? +IFN ITS, CAME D,[SIXBIT /INT /] + JRST CHNET ; NO, MAYBE NET + SKIPN T.XT+1(TB) ; WAS FCN SUPPLIED? + JRST TFA + +; FALLS TROUGH IF SKIP + + + +; NOW BUILD THE CHANNEL + +ARGSOK: MOVEI A,CHANLNT ; GET LENGTH + SKIPN B,RCYCHN+1 ; RECYCLE? + PUSHJ P,GIBLOK ; GET A BLOCK OF STUFF + SETZM RCYCHN+1 + ADD B,[4,,4] ; HIDE THE TTY BUFFER SLOT + PUSH TP,$TCHAN + PUSH TP,B + HRLI C,PROCHN ; POINT TO PROTOTYPE + HRRI C,(B) ; AND NEW ONE + BLT C,CHANLN-5(B) ; CLOBBER + MOVSI C,TLIST ; TO GIVE HIM A CLEAN LIST OF SCRIPT CHANS + MOVEM C,SCRPTO-1(B) + +; NOW BLT IN STUFF FROM THE STACK + + MOVSI C,T.DIR(TB) ; DIRECTION + HRRI C,DIRECT-1(B) + BLT C,SNAME(B) + MOVEI C,RNAME1-1(B) ; NOW "REAL" SLOTS + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + POPJ P, + +; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN + +CHNET: +IFN ITS,[ + CAME D,[SIXBIT /NET /] ; IS IT NET + JRST MAKCH1] +IFE ITS,[ + CAIE D,(SIXBIT /NET/) ; IS IT NET + JRST ARGSOK] + MOVSI D,TFIX ; FOR TYPES + MOVEI B,T.NM1(TB) ; MAKE SURE ALL ARE FIXED + PUSHJ P,CHFIX + MOVEI B,T.NM2(TB) + PUSHJ P,CHFIX + MOVEI B,T.SNM(TB) + LSH A,-1 ; SKIP DEV FLAG + PUSHJ P,CHFIX + JRST ARGSOK + +MAKCH1: TRNN A,MSTNET ; CANT HAVE SEEN A FIX + JRST ARGSOK + JRST WRONGT + +IFN ITS,[ +CHFIX: TRNE A,N1SET ; SKIP IF NOT SPECIFIED + JRST CHFIX1 + SETOM 1(B) ; SET TO -1 + SETOM S.NM1(C) + MOVEM D,(B) ; CORRECT TYPE +] +IFE ITS,CHFIX: + GETYP 0,(B) + CAIE 0,TFIX + JRST PARSQ +CHFIX1: ADDI C,1 ; POINT TO NEXT FIELD + LSH A,-1 ; AND NEXT FLAG + POPJ P, +PARSQ: CAIE 0,TCHSTR + JRST WRONGT +IFE ITS, POPJ P, +IFN ITS,[ + PUSH P,A + PUSH P,C + PUSH TP,(B) + PUSH TP,1(B) + SUBI B,(TB) + PUSH P,B + MCALL 1,PARSE + GETYP 0,A + CAIE 0,TFIX + JRST WRONGT + POP P,C + ADDI C,(TB) + MOVEM A,(C) + MOVEM B,1(C) + POP P,C + POP P,A + POPJ P, +] + + +; SUBROUTINE TO CHECK VALIDITY OF MODE AND SAVE A CODE + +CHMODE: PUSHJ P,CHMOD ; DO IT + MOVE C,T.SPDL+1(TB) + HRRZM A,S.DIR(C) + POPJ P, + +CHMOD: PUSHJ P,STRTO6 ; TO SIXBIT + POP P,B ; VALUE ENDSUP ON STACK, RESTORE IT + + MOVSI A,-NMODES ; SCAN TO SEE IF LEGAL MODE + CAME B,MODES(A) + AOBJN A,.-1 + JUMPGE A,WRONGD ; ILLEGAL MODE NAME + MOVE A,MODCOD(A) + POPJ P, + + +IFN ITS,[ +; RGPARS -- PARSE THE STRINGS COMPRISING FILE NAMES INTO STANDARD ITS GOODIES + +RGPRS: MOVEI 0,NOSTOR ; DONT STORE STRINGS IF ENTER HERE + +RGPARS: CAMGE AB,[-7,,] ; MULTI-STRING CASE POSSIBLE? + IORI 0,4ARG ; 4 STRING CASE + HRLM 0,(P) ; LH IS FLAGS FOR THIS PROG + MOVSI E,-4 ; FIELDS TO FILL + +RPARGL: GETYP 0,(AB) ; GET TYPE + CAIE 0,TCHSTR ; STRING? + JRST ARGCLB ; NO, JUST CLOBBER IT IN RAW + JUMPGE E,CPOPJ ; DON'T DO ANY MORE + PUSH TP,(AB) ; GET AN ARG + PUSH TP,1(AB) + +FPARS: PUSH TP,-1(TP) ; ANOTHER COPY + PUSH TP,-1(TP) + HLRZ 0,(P) + TRNN 0,4ARG + PUSHJ P,FLSSP ; NO LEADING SPACES + MOVEI A,0 ; WILL HOLD SIXBIT + MOVEI B,6 ; CHARS PER 6BIT WORD + MOVE C,[440600,,A] ; BYTE POINTER INTO A + +FPARSL: HRRZ 0,-1(TP) ; GET COUNT + JUMPE 0,PARSD ; DONE + SOS -1(TP) ; COUNT + ILDB 0,(TP) ; CHAR TO 0 + + CAIE 0," ; FILE NAME QUOTE? + JRST NOCNTQ + HRRZ 0,-1(TP) + JUMPE 0,PARSD + SOS -1(TP) + ILDB 0,(TP) ; USE THIS + JRST GOTCNQ + +NOCNTQ: HLL 0,(P) + TLNE 0,4ARG + JRST GOTCNQ + ANDI 0,177 + CAIG 0,40 ; SPACE? + JRST NDFLD ; YES, TERMINATE THIS FIELD + CAIN 0,": ; DEVICE ENDED? + JRST GOTDEV + CAIN 0,"; ; SNAME ENDED + JRST GOTSNM + +GOTCNQ: ANDI 0,177 + PUSHJ P,A0TO6 ; CONVERT TO 6BIT AND CHECK + + JUMPE B,FPARSL ; IGNORE IF AREADY HAVE 6 + IDPB 0,C + SOJA B,FPARSL + +; HERE IF SPACE ENCOUNTERED + +NDFLD: MOVEI D,(E) ; COPY GOODIE + PUSHJ P,FLSSP ; FLUSH REDUNDANT SPACES + JUMPE 0,PARSD ; NO CHARS LEFT + +NFL0: PUSH P,A ; SAVE SIXBIT WORD + SKIPGE -1(P) ; SKIP IF STRING TO BE STORED + JRST NFL1 + PUSH TP,$TAB ; PREVENT AB LOSSAGE + PUSH TP,AB + PUSHJ P,6TOCHS ; CONVERT TO STRING + MOVE AB,(TP) + SUB TP,[2,,2] +NFL1: HRRZ 0,-1(TP) ; RESTORE CHAR COUNT + +NFL2: MOVEI C,(D) ; COPY REL PNTR + SKIPGE -1(P) ; SKIP IF STRINGS TO BE STORED + JRST NFL3 + ASH D,1 ; TIMES 2 + ADDI D,T.NM1(TB) + MOVEM A,(D) ; STORE + MOVEM B,1(D) +NFL3: MOVSI A,N1SET ; FLAG IT + LSH A,(C) + IORM A,-1(P) ; AND CLOBBER + MOVE D,T.SPDL+1(TB) ; GET P BASE + POP P,@SIXTBL(C) ; AND STORE SIXBIT OF IT + + POP TP,-2(TP) ; MAKE NEW STRING POINTER + POP TP,-2(TP) + JUMPE 0,.+3 ; SKIP IF NO MORE CHARS + AOBJN E,FPARS ; MORE TO PARSE? +CPOPJ: POPJ P, ; RETURN, ALL DONE + + SUB TP,[2,,2] ; FLUSH OLD STRING + ADD E,[1,,1] + ADD AB,[2,,2] ; BUMP ARG + JUMPL AB,RPARGL ; AND GO ON +CPOPJ1: AOS A,(P) ; PREPARE TO WIN + HLRZS A + POPJ P, + + + +; HERE IF STRING HAS ENDED + +PARSD: PUSH P,A ; SAVE 6 BIT + MOVE A,-3(TP) ; CAN USE ARG STRING + MOVE B,-2(TP) + MOVEI D,(E) + JRST NFL2 ; AND CONTINUE + +; HERE IF JUST READ DEV + +GOTDEV: MOVEI D,2 ; CODE FOR DEVICE + JRST GOTFLD ; GOT A FIELD + +; HERE IF JUST READ SNAME + +GOTSNM: MOVEI D,3 +GOTFLD: PUSHJ P,FLSSP + SOJA E,NFL0 + + +; HERE FOR NON STRING ARG ENCOUNTERED + +ARGCLB: SKIPGE (P) ; IF NOT STORING, CONSIDER THIS THE END + + POPJ P, + MOVE C,T.SPDL+1(TB) ; GET P-BASE + MOVE A,S.DEV(C) ; GET DEVICE + CAME A,[SIXBIT /INT /]; IS IT THE INTERNAL DEVICE + JRST TRYNET ; NO, COUD BE NET + MOVE A,0 ; OFFNEDING TYPE TO A + PUSHJ P,APLQ ; IS IT APPLICABLE + JRST NAPT ; NO, LOSE + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] ; MUST BE LAST ARG + JUMPL AB,TMA + JRST CPOPJ1 ; ELSE SUCCESSFUL RETURN +TRYNET: CAIE 0,TFIX ; FOR NET DEV, ARGS MUST BE FIX + JRST WRONGT ; TREAT AS WRONG TYPE + MOVSI A,MSTNET ; BETTER BE NET EVENTUALLY + IORM A,(P) ; STORE FLAGS + MOVSI A,TFIX + MOVE B,1(AB) ; GET NUMBER + MOVEI 0,(E) ; MAKE SURE NOT DEVICE + CAIN 0,2 + JRST WRONGT + PUSH P,B ; SAVE NUMBER + MOVEI D,(E) ; SET FOR TABLE OFFSETS + MOVEI 0,0 + ADD TP,[4,,4] + JRST NFL2 ; GO CLOBBER IT AWAY +] + + +; ROUTINE TO FLUSH LEADING SPACES FROM A FIELD + +FLSSP: HRRZ 0,-1(TP) ; GET CHR COUNNT + JUMPE 0,CPOPJ ; FINISHED STRING +FLSS1: MOVE B,(TP) ; GET BYTR + ILDB C,B ; GETCHAR + CAIE C,^Q ; DONT FLUSH CNTL-Q + CAILE C,40 + JRST FLSS2 + MOVEM B,(TP) ; UPDATE BYTE POINTER + SOJN 0,FLSS1 + +FLSS2: HRRM 0,-1(TP) ; UPDATE STRING + POPJ P, + +IFN ITS,[ +;TABLE FOR STFUFFING SIXBITS AWAY + +SIXTBL: SETZ S.NM1(D) + SETZ S.NM2(D) + SETZ S.DEV(D) + SETZ S.SNM(D) + SETZ S.X1(D) +] + +RDTBL: SETZ RDEVIC(B) + SETZ RNAME1(B) + SETZ RNAME2(B) + SETZ RSNAME(B) + + + +IFE ITS,[ + +; TENEX VERSION OF FILE NAME PARSER (ONLY ACCEPT ARGS IN SINGLE STRING) + +RGPRS: MOVSI 0,NOSTOR + +RGPARS: IORM 0,(P) ; SAVE FOR STORE CHECKING + CAMGE AB,[-2,,] ; MULTI-STRING CASE POSSIBLE? + JRST TN.MLT ; YES, GO PROCESS +RGPRSS: GETYP 0,(AB) ; CHECK ARG TYPE + CAIE 0,TCHSTR + JRST WRONGT ; FOR NOW ONLY STRING ARGS WIN + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,FLSSP ; FLUSH LEADING SPACES + PUSHJ P,RGPRS1 + ADD AB,[2,,2] +CHKLST: JUMPGE AB,CPOPJ1 + SKIPGE (P) ; IF FROM OPEN, ALLOW ONE MORE + POPJ P, + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] + JUMPL AB,TMA +CPOPJ1: AOS (P) + POPJ P, + +RGPRS1: PUSH P,[0] ; ALLOW A DEVICE SPEC +TN.SNM: MOVE A,(TP) + HRRZ 0,-1(TP) + JUMPE 0,RPDONE + ILDB A,A + CAIE A,"< ; START "DIRECTORY" ? + JRST TN.N1 ; NO LOOK FOR NAME1 + SETOM (P) ; DEV NOT ALLOWED + IBP (TP) ; SKIP CHAR + SOS -1(TP) + PUSHJ P,TN.CNT ; COUNT CHARS TO ">" OR "." + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN3 + PUSH TP,0 + PUSH TP,C +TN.SN1: PUSHJ P,TN.CNT ; COUNT CHARS TO ">" + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN2 + MOVEM 0,-1(TP) + MOVEM C,(TP) + JRST TN.SN1 +TN.SN2: HRRZ B,-3(TP) + SUB B,0 + SUBI B,1 + SUB TP,[2,,2] +TN.SN3: CAIE A,"> ; SKIP IF WINS + JRST ILLNAM + PUSHJ P,TN.CPS ; COPY TO NEW STRING + MOVEM A,T.SNM(TB) + MOVEM B,T.SNM+1(TB) + +TN.N1: PUSHJ P,TN.CNT + JUMPE B,RPDONE + CAIE A,": ; GOT A DEVICE + JRST TN.N11 + SKIPE (P) + JRST ILLNAM + SETOM (P) + PUSHJ P,TN.CPS + MOVEM A,T.DEV(TB) + MOVEM B,T.DEV+1(TB) + JRST TN.SNM ; NOW LOOK FOR SNAME + +TN.N11: CAIE A,"> + CAIN A,"< + JRST ILLNAM + MOVEM A,(P) ; SAVE END CHAR + PUSHJ P,TN.CPS ; GEN STRING + MOVEM A,T.NM1(TB) + MOVEM B,T.NM1+1(TB) + +TN.N2: SKIPN A,(P) ; GET CHAR BACK + JRST RPDONE + CAIN A,"; ; START VERSION? + JRST .+3 + CAIE A,". ; START NAME2? + JRST ILLNAM ; I GIVE UP!!! + HRRZ B,-1(TP) ; GET RMAINS OF STRING + PUSHJ P,TN.CPS ; AND COPY IT + MOVEM A,T.NM2(TB) + MOVEM B,T.NM2+1(TB) +RPDONE: SUB P,[1,,1] ; FLUSH TEMP + SUB TP,[2,,2] +CPOPJ: POPJ P, + +TN.CNT: HRRZ 0,-1(TP) ; CHAR COUNT + MOVE C,(TP) ; BPTR + MOVEI B,0 ; INIT COUNT TO 0 + +TN.CN1: MOVEI A,0 ; IN CASE RUN OUT + SOJL 0,CPOPJ ; RUN OUT? + ILDB A,C ; TRY ONE + CAIE A," ; TNEX FILE QUOTE? + JRST TN.CN2 + SOJL 0,CPOPJ + IBP C ; SKIP QUOTED CHAT + ADDI B,2 + JRST TN.CN1 + +TN.CN2: CAIE A,"< + CAIN A,"> + POPJ P, + + CAIE A,". + CAIN A,"; + POPJ P, + CAIN A,": + POPJ P, + AOJA B,TN.CN1 + +TN.CPS: PUSH P,B ; # OF CHARS + MOVEI A,4(B) ; ADD 4 TO B IN A + IDIVI A,5 + PUSHJ P,IBLOCK ; GET BLOCK OF WORDS FOR STRING + + POP P,C ; CHAR COUNT BACK + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + HRRI A,(C) ; CHAR STRING + MOVE D,B ; COPY BYTER + + JUMPE C,CPOPJ + ILDB 0,(TP) ; GET CHAR + IDPB 0,D ; AND STROE + SOJG C,.-2 + + MOVNI C,(A) ; - LENGTH TO C + ADDB C,-1(TP) ; DECREMENT WORDS COUNT + TRNN C,-1 ; SKIP IF EMPTY + POPJ P, + IBP (TP) + SOS -1(TP) ; ELSE FLUSH TERMINATOR + POPJ P, + +ILLNAM: ERRUUO EQUOTE ILLEGAL-TENEX-FILE-NAME + +TN.MLT: MOVE A,AB ; AOBJN POINTER TO ARGS IN A + +TN.ML1: GETYP 0,(A) ; IS THIS ARG OF RIGHT TYPE + CAIE 0,TFIX + CAIN 0,TCHSTR + JRST .+2 + JRST RGPRSS ; ASSUME SINGLE STRING + ADD A,[2,,2] + JUMPL A,TN.ML1 ; TRY NEXT ARG IF ANY LEFT + + MOVEI 0,T.NM1(TB) ; 1ST WORD OF DESTINATION + HLRO A,AB ; MINUS NUMBER OF ARGS IN A + MOVN A,A ; NUMBER OF ARGS IN A + SUBI A,1 + CAMGE AB,[-10,,0] + MOVEI A,7 ; IF MORE THAN 10 ARGS, PUT 7 + ADD A,0 ; LAST WORD OF DESTINATION + HRLI 0,(AB) + BLT 0,(A) ; BLT 'EM IN + ADD AB,[10,,10] ; SKIP THESE GUYS + JRST CHKLST + +] + + +; ROUTINE TO OPEN A CHANNEL FOR ANY DEVICE. NAMES ARE ASSUMED TO ALREADY +; BE ON BOTH TP STACK AND P STACK + +OPNCH: MOVE C,T.SPDL+1(TB) ; GET PDL BASE + HRRZ A,S.DIR(C) + ANDI A,1 ; JUST WANT I AND O +IFE ITS,[ + HRLM A,S.DEV(C) +; .TRANS S.DEV(C) ; UNDO ANY TRANSLATIONS +; JRST TRLOST ; COMPLAIN +] +IFN ITS,[ + HRLM A,S.DIR(C) +] + +IFN ITS,[ + MOVE A,S.DEV(C) ; GET SIXBIT DEVICE CODE +] + +IFE ITS,[HRLZS A,S.DEV(C) +] + + MOVSI B,-NDEVS ; AOBJN COUNTER +DEVLP: SETO D, + MOVE 0,DEVSTB(B) ; GET ONE FROM TABLE + MOVE E,A +DEVLP1: AND E,D ; FLUSH POSSIBLE DIGITNESS + CAMN 0,E + JRST CHDIGS ; MAKE SURE REST IS DIGITS + LSH D,6 + JUMPN D,DEVLP1 ; KEEP TRUCKING UNTIL DONE + +; WASN'T THAT DEVICE, MOVE TO NEXT +NXTDEV: AOBJN B,DEVLP + JRST ODSK ; UNKNOWN DEVICE IS ASSUMED TO BE DISK + +IFN ITS,[ +OUSR: HRRZ A,S.DIR(C) ; BLOCK OR UNIT? + TRNE A,2 ; SKIP IF UNIT + JRST ODSK + PUSHJ P,OPEN1 ; OPEN IT + PUSHJ P,FIXREA ; AND READCHST IT + MOVE B,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVE 0,[PUSHJ P,DOIOT] ; GET AN IOINS + MOVEM 0,IOINS(B) + MOVE C,T.SPDL+1(TB) + HRRZ A,S.DIR(C) + TRNN A,1 + JRST EOFMAK + MOVEI 0,80. + MOVEM 0,LINLN(B) + JRST OPNWIN + +OSTY: HLRZ A,S.DIR(C) + IORI A,10 ; THE DONT LOSE BIT (DONT HANG ON INPUT DO ON OUTPUT) + HRLM A,S.DIR(C) + JRST OUSR +] + +; MAKE SURE DIGITS EXIST + +CHDIGS: SETCA D, + JUMPE D,DISPA ; NO DIGITS, WIN IMMEDIATE + MOVE E,A + AND E,D ; LEAVES ONLY DIGITS, IF WINNING + LSH E,6 + LSH D,6 + JUMPG D,.-2 ; KEEP GOING TIL DIGITS LEFT SHIFTED + JRST CHDIGN + +CHDIG1: CAIG D,'9 + CAIGE D,'0 + JRST NXTDEV ; NOT A DIGIT, LOSE + JUMPE E,DISPA ; IF THAT'S ALL THE CHARACTERS, WIN! +CHDIGN: SETZ D, + ROTC D,6 ; GET NEXT CHARACTER INTO D + JRST CHDIG1 ; GO TEST? + +; HERE TO DISPATCH IF SUCCESSFUL + +DISPA: JRST @DEVS(B) + + +IFN ITS,[ + +; DISK DEVICE OPNER COME HERE + +ODSK: MOVE A,S.SNM(C) ; GET SNAME + .SUSET [.SSNAM,,A] ; CLOBBER IT + PUSHJ P,OPEN0 ; DO REAL LIVE OPEN +] +IFE ITS,[ + +; TENEX DISK FILE OPENER + +ODSK: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + PUSHJ P,STSTK ; EXPAND STRING ONTO STACK (E POINTS TO OLD P) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; GET DIR NAME + MOVE C,(P) + MOVE D,T.SPDL+1(TB) + HRRZ D,S.DIR(D) + CAME C,[SIXBIT /PRINAO/] + CAMN C,[SIXBIT /PRINTO/] + IORI D,100 ; TURN ON BIT TO SAY USE OLD FILE + MOVSI A,101 ; START SETTING UP BITS EXTRA BIT FOR MSB + TRNE D,1 ; SKIP IF INPUT + TRNE D,100 ; WITE OVER? + TLOA A,100000 ; FORCE OLD VERSION + TLO A,600000 ; FORCE NEW VERSION + HRROI B,1(E) ; POINT TO STRING + GTJFN + TDZA 0,0 ; SAVE FACT OF NO SKIP + MOVEI 0,1 ; INDICATE SKIPPED + POP P,C ; RECOVER OPEN MODE SIXBIT + MOVE P,E ; RESTORE PSTACK + JUMPE 0,GTJLOS ; FIND OUT WHAT HAPPENED + + MOVE B,T.CHAN+1(TB) ; GET CHANNEL + HRRZM A,CHANNO(B) ; SAVE IT + ANDI A,-1 ; READ Y TO DO OPEN + MOVSI B,440000 ; USE 36. BIT BYES + HRRI B,200000 ; ASSUME READ + CAMN C,[SIXBIT /READB/] + TRO B,2000 ; TURN ON THAWED IF READB + TRNE D,1 ; SKIP IF READ + HRRI B,300000 ; WRITE BIT + HRRZ 0,FSAV(TB) ; SEE IF REF DATE HACK + CAIN 0,NFOPEN + TRO B,400 ; SET DON'T MUNG REF DATE BIT + MOVE E,B ; SAVE BITS FOR REOPENS + OPENF + JRST OPFLOS + MOVE B,[2,,11] ; GET LENGTH & BYTE SIZE + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + GTFDB + LDB 0,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + CAIN 0,7 + JRST SIZASC + CAIN 0,36. + SIZEF ; USE OPENED SIZE + JFCL + IMULI B,5 ; TO BYTES +SIZASC: MOVEI 0,C.OPN+C.READ+C.DISK + TRNE D,1 ; SKIP FOR READ + MOVEI 0,C.OPN+C.PRIN+C.DISK + TRNE D,2 ; SKIP IF NOT BINARY FILE + TRO 0,C.BIN + HRL 0,B + MOVE B,T.CHAN+1(TB) + TRNE D,1 + HLRM 0,LSTCH-1(B) ; SAVE CURRENT LENGTH + MOVEM E,STATUS(B) + HRRM 0,-2(B) ; MUNG THOSE BITS + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + PUSHJ P,TMTNXS ; GET STRING FROM TENEX + MOVE B,CHANNO(B) ; JFN TO A + HRROI A,1(E) ; BASE OF STRING + MOVE C,[111111,,140001] ; WEIRD CONTROL BITS + JFNS ; GET STRING + MOVEI B,1(E) ; POINT TO START OF STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; MAKE INTO A STRING + SUB P,E ; BACK TO NORMAL + PUSH TP,A + PUSH TP,B + PUSHJ P,RGPRS1 ; PARSE INTO FIELDS + MOVE B,T.CHAN+1(TB) + MOVEI C,RNAME1-1(B) + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + JRST OPBASC +OPFLOS: MOVEI C,(A) ; SAVE ERROR CODE + MOVE B,T.CHAN+1(TB) + HRRZ A,CHANNO(B) ; JFN BACK TO A + RLJFN ; TRY TO RELEASE IT + JFCL + MOVEI A,(C) ; ERROR CODE BACK TO A + +GTJLOS: MOVE B,T.CHAN+1(TB) + PUSHJ P,TGFALS ; GET A FALSE WITH REASON + JRST OPNRET + +STSTK: PUSH TP,$TCHAN + PUSH TP,B + MOVEI A,4+5 ; COUNT CHARS NEEDED (NEED LAST 0 BYTE) + MOVE B,(TP) + ADD A,RDEVIC-1(B) + ADD A,RNAME1-1(B) + ADD A,RNAME2-1(B) + ADD A,RSNAME-1(B) + ANDI A,-1 ; TO 18 BITS + MOVEI 0,A(A) + IDIVI A,5 ; TO WORDS NEEDED + POP P,C ; SAVE RET ADDR + MOVE E,P ; SAVE POINTER + PUSH P,[0] ; ALOCATE SLOTS + SOJG A,.-1 + PUSH P,C ; RET ADDR BACK + INTGO ; IN CASE OVERFLEW + PUSH P,0 + MOVE B,(TP) ; IN CASE GC'D + MOVE D,[440700,,1(E)] ; BYTE POINTER TO IT + MOVEI A,RDEVIC-1(B) + PUSHJ P,MOVSTR ; FLUSH IT ON + PUSH P,B + PUSH P,C + MOVEI A,0 ; HERE TO SEE IF THIS IS REALLY L.N. + HRROI B,1(E) + HRROI C,1(P) + LNMST ; LOOK UP LOGICAL NAME + MOVNI A,1 ; NOT A LOGICAL NAME + POP P,C + POP P,B + MOVEI 0,": + IDPB 0,D + JUMPE A,ST.NM1 ; LOGICAL NAME, FLUSH SNAME + HRRZ A,RSNAME-1(B) ; ANY SNAME AT ALL? + JUMPE A,ST.NM1 ; NOPE, CANT HACK WITH IT + MOVEI A,"< + IDPB A,D + MOVEI A,RSNAME-1(B) + PUSHJ P,MOVSTR ; SNAME UP + MOVEI A,"> + IDPB A,D +ST.NM1: MOVEI A,RNAME1-1(B) + PUSHJ P,MOVSTR + MOVEI A,". + IDPB A,D + MOVEI A,RNAME2-1(B) + PUSHJ P,MOVSTR + SUB TP,[2,,2] + POP P,A + POPJ P, + +MOVSTR: HRRZ 0,(A) ; CHAR COUNT + MOVE A,1(A) ; BYTE POINTER + SOJL 0,CPOPJ + ILDB C,A ; GET CHAR + IDPB C,D ; MUNG IT UP + JRST .-3 + +; MAKE A TENEX ERROR MESSAGE STRING + +TGFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; SAVE ERROR CODE + PUSHJ P,TMTNXS ; STRING ON STACK + HRROI A,1(E) ; POINT TO SPACE + MOVE B,(E) ; ERROR CODE + HRLI B,400000 ; FOR ME + MOVSI C,-100. ; MAX CHARS + ERSTR ; GET TENEX STRING + JRST TGFLS1 + JRST TGFLS1 + + MOVEI B,1(E) ; A AND B BOUND STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; BUILD STRING + SUB P,E ; P BACK TO NORMAL +TGFLS2: +IFE FNAMS, SUB P,[1,,1] ; FLUSH ERROR CODE SLOT +IFN FNAMS,[ + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST TGFLS3 + PUSHJ P,STSTK + MOVEI B,1(E) + SUBM P,E + MOVSI A,440700 + HRRI A,(P) + MOVEI C,5 + ILDB 0,A + JUMPE 0,.+2 + SOJG C,.-2 + + PUSHJ P,TNXSTR + PUSH TP,A + PUSH TP,B + SUB P,E +TGFLS3: POP P,A + PUSH TP,$TFIX + PUSH TP,A + MOVEI A,3 + SKIPN B + MOVEI A,2 +] +IFE FNAMS,[ + MOVEI A,1 +] + PUSHJ P,IILIST ; BUILD LIST + MOVSI A,TFALSE ; MAKE IT FALSE + SUB TP,[2,,2] + POPJ P, + +TGFLS1: MOVE P,E ; RESET STACK + MOVE A,$TCHSTR + MOVE B,CHQUOTE UNKNOWN PROBLEM IN I/O + JRST TGFLS2 + +] +; OTHER BUFFERED DEVICES JOIN HERE + +OPDSK1: +IFN ITS,[ + PUSHJ P,FIXREA ; STORE THE "REAL" NAMES INTO THE CHANNEL +] +OPBASC: MOVE C,T.SPDL+1(TB) ; C WAS CLOBBERED, GET IT BACK + HRRZ A,S.DIR(C) ; FIND OUT IF OPEN IS ASCII OR WORD + TRZN A,2 ; SKIP IF BINARY + PUSHJ P,OPASCI ; DO IT FOR ASCII + +; NOW SET UP IO INSTRUCTION FOR CHANNEL + +MAKION: MOVE B,T.CHAN+1(TB) + MOVEI C,GETCHR + JUMPE A,MAKIO1 ; JUMP IF INPUT + MOVEI C,PUTCHR ; ELSE GET INPUT + MOVEI 0,80. ; DEFAULT LINE LNTH + MOVEM 0,LINLN(B) + MOVSI 0,TFIX + MOVEM 0,LINLN-1(B) +MAKIO1: + HRLI C,(PUSHJ P,) + MOVEM C,IOINS(B) ; STORE IT + JUMPN A,OPNWIN ; GET AN EOF FORM FOR INPUT CHANNEL + +; HERE TO CONS UP + +EOFMAK: MOVSI C,TATOM + MOVE D,EQUOTE END-OF-FILE + PUSHJ P,INCONS + MOVEI E,(B) + MOVSI C,TATOM + MOVE D,IMQUOTE ERROR + PUSHJ P,ICONS + MOVE D,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVSI 0,TFORM + MOVEM 0,EOFCND-1(D) + MOVEM B,EOFCND(D) + +OPNWIN: MOVEI 0,10. ; SET UP RADIX + MOVSI A,TCHAN ; OPEN SUCCEEDED, RET CHANNEL + MOVE B,T.CHAN+1(TB) + MOVEM 0,RADX(B) + +OPNRET: MOVE D,T.CHAN+1(TB) ; IN CASE WE RECYCLE IT + MOVE C,(P) ; RET ADDR + SUB P,[S.X3+2,,S.X3+2] + SUB TP,[T.CHAN+2,,T.CHAN+2] + JRST (C) + + +; HERE TO CREATE CHARACTER BUFFERS FOR ASCII I/O + +OPASCI: PUSH P,A ; CONTAINS MODE, SAVE IT + MOVEI A,BUFLNT ; GET SIZE OF BUFFER + PUSHJ P,IBLOCK ; GET STORAGE + MOVSI 0,TWORD+.VECT. ; SET UTYPE + MOVEM 0,BUFLNT(B) ; AND STORE + MOVSI A,TCHSTR + SKIPE (P) ; SKIP IF INPUT + JRST OPASCO + MOVEI D,BUFLNT-1(B) ; REST BYTE POINTER +OPASCA: HRLI D,010700 + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEI 0,C.BUF + IORM 0,-2(B) ; TURN ON BUFFER BIT + MOVEM A,BUFSTR-1(B) + MOVEM D,BUFSTR(B) ; CLOBBER + POP P,A + POPJ P, + +OPASCO: HRROI C,777776 + MOVEM C,(B) ; -1 THE BUFFER (LEAVE OFF LOW BIT) + MOVSI C,(B) + HRRI C,1(B) ; BUILD BLT POINTER + BLT C,BUFLNT-1(B) ; ZAP + MOVEI D,-1(B) ; START MAKING STRING POINTER + HRRI A,BUFLNT*5 ; SET UP CHAR COUNT + JRST OPASCA + + +; OPEN NON FILE ORIENTED DEVICES (NUL, PTR, PTP ETC.) + +IFN ITS,[ +ONUL: +OPTP: +OPTR: PUSHJ P,OPEN0 ; SET UP MODE AND OPEN + SETZM S.NM1(C) ; CLOBBER UNINTERESTING FIELDS + SETZM S.NM2(C) + SETZM S.SNM(C) + JRST OPDSK1 + +; OPEN DEVICES THAT IGNORE SNAME + +OUTN: PUSHJ P,OPEN0 + SETZM S.SNM(C) + JRST OPDSK1 + +] + +; INTERNAL CHANNEL OPENER + +OINT: HRRZ A,S.DIR(C) ; CHECK DIR + CAIL A,2 ; READ/PRINT? + JRST WRONGD ; NO, LOSE + + MOVE 0,INTINS(A) ; GET INS + MOVE D,T.CHAN+1(TB) ; AND CHANNEL + MOVEM 0,IOINS(D) ; AND CLOBBER + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + HRRM 0,-2(D) + SETOM STATUS(D) ; MAKE SURE NOT AA TTY + PMOVEM T.XT(TB),INTFCN-1(D) + +; HERE TO SAVE PSEUDO CHANNELS + +SAVCHN: HRRZ E,CHNL0+1 ; POINT TO CURRENT LIST + MOVSI C,TCHAN + PUSHJ P,ICONS ; CONS IT ON + HRRZM B,CHNL0+1 + JRST OPNWIN + +; INT DEVICE I/O INS + +INTINS: PUSHJ P,GTINTC + PUSHJ P,PTINTC + + +; HERE TO OPEN THE NET DEVICE (I.E. THE ARPA NET) + +IFN ITS,[ +ONET: HRRZ A,S.DIR(C) ; DIRECTION CODE + CAILE A,1 ; ASCII ? + IORI A,4 ; TURN ON IMAGE BIT + SKIPGE S.NM1(C) ; NAME1 I.E. LOCAL HOST GIVEN + IORI A,10 ; NO, WE WILL LET ITS GIVE US ONE + SKIPGE S.NM2(C) ; NORMAL OR "LISTEN" + IORI A,20 ; TURN ON LISTEN BIT + MOVEI 0,7 ; DEFAULT BYTE SIZE + TRNE A,2 ; UNLESS + MOVEI 0,36. ; IMAGE WHICH IS 36 + SKIPN T.XT(TB) ; BYTE SIZE GIVEN? + MOVEM 0,S.X1(C) ; NO, STORE DEFAULT + SKIPG D,S.X1(C) ; BYTE SIZE REASONABLE? + JRST RBYTSZ ; NO <0, COMPLAIN + TRNE A,2 ; SKIP TO CHECK ASCII + JRST ONET2 ; CHECK IMAGE + CAIN D,7 ; 7-BIT WINS + JRST ONET1 + CAIE D,44 ; 36-BIT INDICATES BLOCK ASCII MODE + JRST .+3 + IORI A,2 ; SET BLOCK FLAG + JRST ONET1 + IORI A,40 ; USE 8-BIT MODE + CAIN D,10 ; IS IT RIGHT + JRST ONET1 ; YES +] + +RBYTSZ: ERRUUO EQUOTE BYTE-SIZE-BAD + +IFN ITS,[ +ONET2: CAILE D,36. ; IMAGE SIZE REASONABLE? + JRST RBYTSZ ; NO + CAIN D,36. ; NORMAL + JRST ONET1 ; YES, DONT SET FIELD + + ASH D,9. ; POSITION FOR FIELD + IORI A,40(D) ; SET IT AND ITS BIT + +ONET1: HRLM A,S.DIR(C) ; CLOBBER OPEN BLOCK + MOVE E,A ; SAVE BLOCK MODE INFO + PUSHJ P,OPEN1 ; DO THE OPEN + PUSH P,E + +; CLOBBER REAL SLOTS FOR THE OPEN + + MOVEI A,3 ; GET STATE VECTOR + PUSHJ P,IBLOCK + MOVSI A,TUVEC + MOVE D,T.CHAN+1(TB) + HLLM A,BUFRIN-1(D) + MOVEM B,BUFRIN(D) + MOVSI A,TFIX+.VECT. ; SET U TYPE + MOVEM A,3(B) + MOVE C,T.SPDL+1(TB) + MOVE B,T.CHAN+1(TB) + + PUSHJ P,INETST ; GET STATE + + POP P,A ; IS THIS BLOCK MODE + MOVEI 0,80. ; POSSIBLE LINE LENGTH + TRNE A,1 ; SKIP IF INPUT + MOVEM 0,LINLN(B) + TRNN A,2 ; BLOCK MODE? + JRST .+3 + TRNN A,4 ; ASCII MODE? + JRST OPBASC ; GO SETUP BLOCK ASCII + MOVE 0,[PUSHJ P,DOIOT] + MOVEM 0,IOINS(B) + + JRST OPNWIN + +; INTERNAL ROUTINE TO GET THE CURRENT STATE OF THE NETWROK CHANNEL + +INETST: MOVE A,S.NM1(C) + MOVEM A,RNAME1(B) + MOVE A,S.NM2(C) + MOVEM A,RNAME2(B) + LDB A,[1100,,S.SNM(C)] + MOVEM A,RSNAME(B) + + MOVE E,BUFRIN(B) ; GET STATE BLOCK +INTST1: HRRE 0,S.X1(C) + MOVEM 0,(E) + ADDI C,1 + AOBJN E,INTST1 + + POPJ P, + + +; ACCEPT A CONNECTION + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET ; CHECK THAT ARG IS AN OPEN NET CHANNEL + MOVE A,CHANNO(B) ; GET CHANNEL + LSH A,23. ; TO AC FIELD + IOR A,[.NETACC] + XCT A + JRST IFALSE ; RETURN FALSE +NETRET: MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +; FORCE SYSTEM NETWORK BUFFERS TO BE SENT + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 + CAMN A,MODES+3 + SKIPA A,CHANNO(B) ; GET CHANNEL + JRST WRONGD + LSH A,23. + IOR A,[.NETS] + XCT A + JRST NETRET + +; SUBR TO RETURN UPDATED NET STATE + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET ; IS IT A NET CHANNEL + PUSHJ P,INSTAT + JRST FINIS + +; INTERNAL NETSTATE ROUTINE + +INSTAT: MOVE C,P ; GET PDL BASE + MOVEI 0,S.X3 ; # OF SLOTS NEEDED + PUSH P,[0] + SOJN 0,.-1 +; RESTORED FROM MUDDLE 54. IT SEEMED TO WORK THERE, AND THE STUFF +; COMMENTED OUT HERE CERTAINLY DOESN'T. + MOVEI D,S.DEV(C) + HRL D,CHANNO(B) + .RCHST D, +; HRR D,CHANNO(B) ; SETUP FOR RFNAME CALL +; DOTCAL RFNAME,[D,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] +; .LOSE %LSFIL ; THIS MAY NOT BE DESIRABLE, BUT I ASSUME WE CARE IF + ; LOSSAGE + PUSHJ P,INETST ; INTO VECTOR + SUB P,[S.X3,,S.X3] + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + POPJ P, +] +; INTERNAL ROUTINE TO CHECK FOR CORRECT CHANNEL TYPE + +ARGNET: ENTRY 1 + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; OPEN? + JRST CHNCLS + MOVE A,RDEVIC-1(B) ; GET DEV NAME + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 + POP P,A + CAME A,[SIXBIT /NET /] + JRST NOTNET + MOVE B,1(AB) + MOVE A,DIRECT-1(B) ; CHECK FOR A READ SOCKET + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 + MOVE B,1(AB) ; RESTORE CHANNEL + POP P,A + POPJ P, + +IFE ITS,[ + +; TENEX NETWRK OPENING CODE + +ONET: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + MOVSI C,100700 + HRRI C,1(P) + MOVE E,P + PUSH P,[ASCII /NET:/] ; FOR STRINGS + GETYP 0,RNAME1-1(B) ; CHECK TYPE + CAIE 0,TFIX ; SKIP IF # SUPPLIED + JRST ONET1 + MOVE 0,RNAME1(B) ; GET IT + PUSHJ P,FIXSTK + JFCL + JRST ONET2 +ONET1: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME1-1(B) + MOVE B,RNAME1(B) + JUMPE 0,ONET2 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 +ONET2: MOVEI A,". + JSP D,ONETCH + MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIE 0,TFIX + JRST ONET3 + GETYP 0,RSNAME-1(B) + CAIE 0,TFIX + JRST WRONGT + MOVE 0,RSNAME(B) + PUSHJ P,FIXSTK + JRST ONET4 + MOVE B,T.CHAN+1(TB) + MOVEI A,"- + JSP D,ONETCH + MOVE 0,RNAME2(B) + PUSHJ P,FIXSTK + JRST WRONGT + JRST ONET4 +ONET3: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME2-1(B) + MOVE B,RNAME2(B) + JUMPE 0,ONET4 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 + +ONET4: +ONET5: MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIN 0,TCHSTR + JRST ONET6 + MOVEI A,"; + JSP D,ONETCH + MOVEI A,"T + JSP D,ONETCH +ONET6: MOVSI A,1 + HRROI B,1(E) ; STRING POINTER + GTJFN ; GET THE G.D JFN + TDZA 0,0 ; REMEMBER FAILURE + MOVEI 0,1 + MOVE P,E ; RESTORE P + JUMPE 0,GTJLOS ; CONS UP ERROR STRING + + MOVE B,T.CHAN+1(TB) + HRRZM A,CHANNO(B) ; SAVE THE JFN + + MOVE C,T.SPDL+1(TB) + MOVE D,S.DIR(C) + MOVEI B,10 + TRNE D,2 + MOVEI B,36. + SKIPE T.XT(TB) + MOVE B,T.XT+1(TB) + JUMPL B,RBYTSZ + CAILE B,36. + JRST RBYTSZ + ROT B,-6 + TLO B,3400 + HRRI B,200000 + TRNE D,1 ; SKIP FOR INPUT + HRRI B,100000 + ANDI A,-1 ; ISOLATE JFCN + OPENF + JRST OPFLOS ; REPORT ERROR + MOVE B,T.CHAN+1(TB) + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) + CVSKT ; GET ABS SOCKET # + FATAL NETWORK BITES THE BAG! + MOVE D,B + MOVE B,T.CHAN+1(TB) + MOVEM D,RNAME1(B) + MOVSI 0,TFIX + MOVEM 0,RNAME1-1(B) + + MOVSI 0,TFIX + MOVEM 0,RNAME2-1(B) + MOVEM 0,RSNAME-1(B) + MOVE C,T.SPDL+1(TB) + MOVE C,S.DIR(C) + MOVE 0,[PUSHJ P,DONETO] + TRNN C,1 ; SKIP FOR OUTPUT + MOVE 0,[PUSHJ P,DONETI] + MOVEM 0,IOINS(B) + MOVEI 0,80. ; LINELENGTH + TRNE C,1 ; SKIP FOR INPUT + MOVEM 0,LINLN(B) + MOVEI A,3 ; GET STATE UVECTOR + PUSHJ P,IBLOCK + MOVSI 0,TFIX+.VECT. + MOVEM 0,3(B) + MOVE C,B + MOVE B,T.CHAN+1(TB) + MOVEM C,BUFRIN(B) + MOVSI 0,TUVEC + HLLM 0,BUFRIN-1(B) + MOVE A,CHANNO(B) ; GET JFN + GDSTS ; GET STATE + MOVE E,T.CHAN+1(TB) + MOVEM D,RNAME2(E) + MOVEM C,RSNAME(E) + MOVE C,BUFRIN(E) + MOVEM B,(C) ; INITIAL STATE STORED + MOVE B,E + JRST OPNWIN + +; DOIOT FOR TENEX NETWRK + +DONETO: PUSH P,0 + MOVE 0,[BOUT] + JRST .+3 + +DONETI: PUSH P,0 + MOVE 0,[BIN] + PUSH P,0 + PUSH TP,$TCHAN + PUSH TP,B + MOVEI 0,(A) ; POSSIBLE OUTPUT CHAR TO 0 + MOVE A,CHANNO(B) + MOVE B,0 + ENABLE + XCT (P) + DISABLE + MOVEI A,(B) ; RET CHAR IN A + MOVE B,(TP) + MOVE 0,-1(P) + SUB P,[2,,2] + SUB TP,[2,,2] + POPJ P, + +NETPRS: MOVEI D,0 + HRRZ 0,(C) + MOVE C,1(C) + +ONETL: ILDB A,C + CAIN A,"# + POPJ P, + SUBI A,60 + ASH D,3 + IORI D,(A) + SOJG 0,ONETL + AOS (P) + POPJ P, + +FIXSTK: CAMN 0,[-1] + POPJ P, + JFFO 0,FIXS3 ; PUT OCTAL DIGITS INTO STIRNG + MOVEI A,"0 + POP P,D + AOJA D,ONETCH +FIXS3: IDIVI A,3 + MOVEI B,12. + SUBI B,(A) + HRLM B,(P) + IMULI A,3 + LSH 0,(A) + POP P,B +FIXS2: MOVEI A,0 + ROTC 0,3 ; NEXT DIGIT + ADDI A,60 + JSP D,ONETCH + SUB B,[1,,0] + TLNN B,-1 + JRST 1(B) + JRST FIXS2 + +ONETCH: IDPB A,C + TLNE C,760000 ; SKIP IF NEW WORD + JRST (D) + PUSH P,[0] + JRST (D) + +INSTAT: MOVE E,B + MOVE A,CHANNO(E) + GDSTS + LSH B,-32. + MOVEM D,RNAME2(E) ; UPDATE FOREIGN SOCHKET + MOVEM C,RSNAME(E) ; AND HOST + MOVE C,BUFRIN(E) + XCT ITSTRN(B) ; XLATE TO LOOK MORE LIKE ITS + MOVEM B,(C) ; STORE STATE + MOVE B,E + POPJ P, + +ITSTRN: MOVEI B,0 + JRST NLOSS + JRST NLOSS + MOVEI B,1 + MOVEI B,2 + JRST NLOSS + MOVEI B,4 + PUSHJ P,NOPND + MOVEI B,0 + JRST NLOSS + JRST NLOSS + PUSHJ P,NCLSD + MOVEI B,0 + JRST NLOSS + MOVEI B,0 + +NLOSS: FATAL ILLEGAL NETWORK STATE + +NOPND: MOVE B,DIRECT(E) ; SEE IF READ OR PRINT + ILDB B,B ; GET 1ST CHAR + CAIE B,"R ; SKIP FOR READ + JRST NOPNDW + SIBE ; SEE IF INPUT EXISTS + JRST .+3 + MOVEI B,5 + POPJ P, + MOVEM B,2(C) ; STORE BYTES IN STATE VECTOR + MOVEI B,11 ; RETURN DATA PRESENT STATE + POPJ P, + +NOPNDW: SOBE ; SEE IF OUTPUT PRESENT + JRST .+3 + MOVEI B,5 + POPJ P, + + MOVEI B,6 + POPJ P, + +NCLSD: MOVE B,DIRECT(E) + ILDB B,B + CAIE B,"R + JRST RET0 + SIBE + JRST .+2 + JRST RET0 + MOVEI B,10 + POPJ P, + +RET0: MOVEI B,0 + POPJ P, + + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET + PUSHJ P,INSTAT + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + JRST FINIS + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 ; PRINT OR PRINTB? + CAMN A,MODES+3 + SKIPA A,CHANNO(B) + JRST WRONGD + MOVEI B,21 + MTOPR +NETRET: MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET + MOVE A,CHANNO(B) + MOVEI B,20 + MTOPR + JRST NETRET + +] + +; HERE TO OPEN TELETYPE DEVICES + +OTTY: HRRZ A,S.DIR(C) ; GET DIR CODE + TRNE A,2 ; SKIP IF NOT READB/PRINTB + JRST WRONGD ; CANT DO THAT + +IFN ITS,[ + MOVE A,S.NM1(C) ; CHECK FOR A DIR + MOVE 0,S.NM2(C) + CAMN A,[SIXBIT /.FILE./] + CAME 0,[SIXBIT /(DIR)/] + SKIPA E,[-15.*2,,] + JRST OUTN ; DO IT THAT WAY + + HRRZ A,S.DIR(C) ; CHECK DIR + TRNE A,1 + JRST TTYLP2 + HRRI E,CHNL1 + PUSH P,S.DEV(C) ; SAVE THE SIXBIT DEV NAME + ; HRLZS (P) ; POSTITION DEVICE NAME + +TTYLP: SKIPN D,1(E) ; CHANNEL OPEN? + JRST TTYLP1 ; NO, GO TO NEXT + MOVE A,RDEVIC-1(D) ; GET DEV NAME + MOVE B,RDEVIC(D) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A ; GET RESULT + CAMN A,(P) ; SAME? + JRST SAMTYQ ; COULD BE THE SAME +TTYLP1: ADD E,[2,,2] + JUMPL E,TTYLP + SUB P,[1,,1] ; THIS ONE MUST BE UNIQUE +TTYLP2: MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; GET DIR OF OPEN + SKIPE A ; IF OUTPUT, + IORI A,20 ; THEN USE DISPLAY MODE + HRLM A,S.DIR(C) ; STORE IN OPEN BLOCK + PUSHJ P,OPEN2 ; OPEN THE TTY + MOVE A,S.DEV(C) ; GET DEVICE NAME + PUSHJ P,6TOCHS ; TO A STRING + MOVE D,T.CHAN+1(TB) ; POINT TO CHANNEL + MOVEM A,RDEVIC-1(D) + MOVEM B,RDEVIC(D) + MOVE C,T.SPDL+1(TB) ; RESTORE PDL BASE + MOVE B,D ; CHANNEL TO B + HRRZ 0,S.DIR(C) ; AND DIR + JUMPE 0,TTYSPC +TTY1: DOTCAL TTYGET,[CHANNO(B),[2000,,0],[2000,,A],[2000,,D]] + .LOSE %LSSYS + DOTCAL TTYSET,[CHANNO(B),MODE1,MODE2,D] + .LOSE %LSSYS + MOVE A,[PUSHJ P,GMTYO] + MOVEM A,IOINS(B) + DOTCAL RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]] + .LOSE %LSSYS + MOVEM D,LINLN(B) + MOVEM A,PAGLN(B) + JRST OPNWIN + +; MAKE AN IOT + +IOTMAK: HRLZ A,CHANNO(B) ; GET CHANNEL + ROT A,5 + IOR A,[.IOT A] ; BUILD IOT + MOVEM A,IOINS(B) ; AND STORE IT + POPJ P, + + +; HERE IF POSSIBLY OPENING AN ALREADY OPEN TTY + +SAMTYQ: MOVE D,1(E) ; RESTORE CURRENT CHANNEL + MOVE A,DIRECT-1(D) ; GET DIR + MOVE B,DIRECT(D) + PUSHJ P,STRTO6 + POP P,A ; GET SIXBIT + MOVE C,T.SPDL+1(TB) + HRRZ C,S.DIR(C) + CAME A,MODES(C) ; SKIP IF DIFFERENT DIRECTION + JRST TTYLP1 + +; HERE IF A RE-OPEN ON A TTY + + HRRZ 0,FSAV(TB) ; IS IT FROM A FOPEN + CAIN 0,FOPEN + JRST RETOLD ; RET OLD CHANNEL + + PUSH TP,$TCHAN + PUSH TP,1(E) ; PUSH OLD CHANNEL + PUSH TP,$TFIX + PUSH TP,T.CHAN+1(TB) + MOVE A,[PUSHJ P,CHNFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + SUB TP,[4,,4] + +RETOLD: MOVE B,1(E) ; GET CHANNEL + AOS CHANNO-1(B) ; AOS REF COUNT + MOVSI A,TCHAN + SUB P,[1,,1] ; CLEAN UP STACK + JRST OPNRET ; AND LEAVE + + +; ROUTINE TO PASS TO GCHACK TO FIX UP CHANNEL POINTER + +CHNFIX: CAIN C,TCHAN + CAME D,(TP) + POPJ P, + MOVE D,-2(TP) ; GET REPLACEMENT + SKIPE B + MOVEM D,1(B) ; CLOBBER IT AWAY + POPJ P, +] + +IFE ITS,[ + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ 0,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVE A,[PUSHJ P,INMTYO] + MOVE B,T.CHAN+1(TB) + MOVEM A,IOINS(B) + MOVEI A,100 ; PRIM INPUT JFN + JUMPN 0,TNXTY1 + MOVEI E,C.OPN+C.READ+C.TTY + HRRM E,-2(B) + MOVEM B,CHNL0+2*100+1 + JRST TNXTY2 +TNXTY1: MOVEM B,CHNL0+2*101+1 + MOVEI A,101 ; PRIM OUTPUT JFN + MOVEI E,C.OPN+C.PRIN+C.TTY + HRRM E,-2(B) +TNXTY2: MOVEM A,CHANNO(B) + JUMPN 0,OPNWIN +] +; SETUP FUNNY BUFFER FOR TTY INPUT DEVICES + +TTYSPC: MOVEI A,EXTBFR ; GET EXTRA BUFFER + PUSHJ P,IBLOCK ; GET BLOCK + MOVE D,T.CHAN+1(TB) ;RESTORE CHANNEL POINTER +IFN ITS,[ + MOVE A,CHANNO(D) + LSH A,23. + IOR A,[.IOT A] + MOVEM A,IOIN2(B) +] +IFE ITS,[ + MOVE A,[PBIN] + MOVEM A,IOIN2(B) +] + MOVSI A,TLIST + MOVEM A,EXBUFR-1(D) ; FOR WAITING TTY BUFFERS + SETZM EXBUFR(D) ; NIL LIST + MOVEM B,BUFRIN(D) ;STORE IN CHANNEL + MOVSI A,TUVEC ;MAKE SURE TYPE IS UNIFORM VECTOR + HLLM A,BUFRIN-1(D) + MOVEI A,177 ;SET ERASER TO RUBOUT + MOVEM A,ERASCH(B) + SETZM KILLCH(B) ;NO KILL CHARACTER NEEDED + MOVEI A,33 ;BREAKCHR TO C.R. + MOVEM A,BRKCH(B) + MOVEI A,"\ ;ESCAPER TO \ + MOVEM A,ESCAP(B) + MOVE A,[010700,,BYTPTR(E)] ;RELATIVE BYTE POINTER + MOVEM A,BYTPTR(B) + MOVEI A,14 ;BARF BACK CHARACTER FF + MOVEM A,BRFCHR(B) + MOVEI A,^D + MOVEM A,BRFCH2(B) + +; SETUP DEFAULT TTY INTERRUPT HANDLER + + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TFIX + PUSH TP,[10] ; PRIORITY OF CHAR INT + PUSH TP,$TCHAN + PUSH TP,D + MCALL 3,EVENT ; 1ST MAKE AN EVENT EXIST + PUSH TP,A + PUSH TP,B + PUSH TP,$TSUBR + PUSH TP,[QUITTER] ; DEFAULT HANDLER IS QUITTER + MCALL 2,HANDLER + +; BUILD A NULL STRING + + MOVEI A,0 + PUSHJ P,IBLOCK ; USE A BLOCK + MOVE D,T.CHAN+1(TB) + MOVEI 0,C.BUF + IORM 0,-2(D) + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + MOVEM A,BUFSTR-1(D) + MOVEM B,BUFSTR(D) + MOVEI A,0 + MOVE B,D ; CHANNEL TO B + JRST MAKION + + +; ROUTINE TO OPEN ITS CHANNEL WITHOUT .RCHST + +IFN ITS,[ +OPEN2: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN ; OPEN THE FILE + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; SAVE THE CHANNEL + JRST OPEN3 + +; FIX UP MODE AND FALL INTO OPEN + +OPEN0: HRRZ A,S.DIR(C) ; GET DIR + TRNE A,2 ; SKIP IF NOT BLOCK + IORI A,4 ; TURN ON IMAGE + IORI A,2 ; AND BLOCK + + PUSH P,A + PUSH TP,$TPDL + PUSH TP,C ; SAVE CRUFT TO CHECK FOR PRINTO, HA HA + MOVE B,T.CHAN+1(TB) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) ; THIS KLUDGE THE MESS OF NDR + PUSHJ P,STRTO6 + MOVE C,(TP) + POP P,D ; THE SIXBIT FOR KLUDGE + POP P,A ; GET BACK THE RANDOM BITS + SUB TP,[2,,2] + CAME D,[SIXBIT /PRINAO/] + CAMN D,[SIXBIT /PRINTO/] + IORI A,100000 ; WRITEOVER BIT + HRRZ 0,FSAV(TB) + CAIN 0,NFOPEN + IORI A,10 ; DON'T CHANGE REF DATE +OPEN9: HRLM A,S.DIR(C) ; AND STORE IT + +; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL + +OPEN1: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; CLOBBER INTO CHANNEL + DOTCAL RFNAME,[A,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] + JFCL + +; NOW CLOBBER THE TVP SLOT FOR THIS CHANNEL + +OPEN3: MOVE A,S.DIR(C) + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) ; GET CHANNEL # + ASH A,1 + ADDI A,CHNL0 ; POINT TO SLOT + MOVEM B,1(A) ; NOT: TYPE ALREADY SETUP + +; NOW GET STATUS WORD + +DOSTAT: HRRZ A,CHANNO(B) ; NOW GET STATUS WORD + DOTCAL STATUS,[A,[2002,,STATUS]] + JFCL + POPJ P, + + +; HERE IF OPEN FAILS (CHANNEL IS IN A) + +OPNLOS: JUMPL A,NOCHAN ; ALL CHANNELS ARE IN USE + LSH A,23. ; DO A .STATUS + IOR A,[.STATUS A] + XCT A ; STATUS TO A + MOVE B,T.CHAN+1(TB) + PUSHJ P,GFALS ; GET A FALSE WITH A MESSAGE + SUB P,[1,,1] ; EXTRA RET ADDR FLUSHED + JRST OPNRET ; AND RETURN +] + +CGFALS: SUBM M,(P) + MOVEI B,0 +IFN ITS, PUSHJ P,GFALS +IFE ITS, PUSHJ P,TGFALS + JRST MPOPJ + +; ROUTINE TO CONS UP FALSE WITH REASON +IFN ITS,[ +GFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,[SIXBIT / ERR/] ; SET UP OPEN TO ERR DEV + PUSH P,[3] ; SAY ITS FOR CHANNEL + PUSH P,A + .OPEN 0,-2(P) ; USE CHANNEL 0 FOR THIS + FATAL CAN'T OPEN ERROR DEVICE + SUB P,[3,,3] ; DONT WANT OPEN BLOCK NOW +IFN FNAMS, PUSH P,A + MOVEI A,0 ; PREPARE TO BUILD STRING ON STACK +EL1: PUSH P,[0] ; WHERE IT WILL GO + MOVSI B,(<440700,,(P)>) ; BYTE POINTER TO TOP OF STACK +EL2: .IOT 0,0 ; GET A CHAR + JUMPL 0,EL3 ; JUMP ON -1,,3 + CAIN 0,3 ; EOF? + JRST EL3 ; YES, MAKE STRING + CAIN 0,14 ; IGNORE FORM FEEDS + JRST EL2 ; IGNORE FF + CAIE 0,15 ; IGNORE CR & LF + CAIN 0,12 + JRST EL2 + IDPB 0,B ; STUFF IT + TLNE B,760000 ; SIP IF WORD FULL + AOJA A,EL2 + AOJA A,EL1 ; COUNT WORD AND GO + +EL3: +IFN FNAMS,[ + SKIPN (P) + SUB P,[1,,1] + PUSH P,A + .CLOSE 0, + PUSHJ P,CHMAK + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST EL4 + MOVEI A,0 + MOVSI B,(<440700,,(P)>) + PUSH P,[0] + IRP XX,,[RDEVIC,RSNAME,RNAME1,RNAME2]YY,,[0,72,73,40] +IFSN YY,0,[ + MOVEI 0,YY + JSP E,1PUSH +] + MOVE E,-2(TP) + MOVE C,XX(E) + HRRZ D,XX-1(E) + JSP E,PUSHIT + TERMIN +] + SKIPN (P) ; ANY CHARS AT END? + SUB P,[1,,1] ; FLUSH XTRA + PUSH P,A ; PUT UP COUNT + .CLOSE 0, ; CLOSE THE ERR DEVICE + PUSHJ P,CHMAK ; MAKE STRING + PUSH TP,A + PUSH TP,B +IFN FNAMS,[ +EL4: POP P,A + PUSH TP,$TFIX + PUSH TP,A] +IFE FNAMS, MOVEI A,1 +IFN FNAMS,[ + MOVEI A,3 + SKIPN B + MOVEI A,2 +] + PUSHJ P,IILIST + MOVSI A,TFALSE ; MAKEIT A FALSE +IFN FNAMS, SUB TP,[2,,2] + POPJ P, + +IFN FNAMS,[ +1PUSH: MOVEI D,0 + JRST PUSHI2 +PUSHI1: PUSH P,[0] + MOVSI B,(<440700,,(P)>) +PUSHIT: SOJL D,(E) + ILDB 0,C +PUSHI2: IDPB 0,B + TLNE B,760000 + AOJA A,PUSHIT + AOJA A,PUSHI1 +] +] + + +; ROUTINE TO FILL IN THE "REAL" SLOTS FOR THE CHANNEL + +FIXREA: +IFE ITS, HRLZS S.DEV(C) ; KILL MODE BITS + MOVE D,[-4,,S.DEV] + +FIXRE1: MOVEI A,(D) ; COPY REL POINTER + ADD A,T.SPDL+1(TB) ; POINT TO SLOT + SKIPN A,(A) ; SKIP IF GOODIE THERE + JRST FIXRE2 + PUSHJ P,6TOCHS ; MAKE INOT A STRING + MOVE C,RDTBL-S.DEV(D); GET OFFSET + ADD C,T.CHAN+1(TB) + MOVEM A,-1(C) + MOVEM B,(C) +FIXRE2: AOBJN D,FIXRE1 + POPJ P, + +IFN ITS,[ +DOOPN: HRLZ A,A + HRR A,CHANNO(B) ; GET CHANNEL + DOTCAL OPEN,[A,-3(P),-2(P),-1(P),(P)] + SKIPA + AOS -1(P) + POPJ P, +] + +;THIS ROUTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES +STRTO6: PUSH TP,A + PUSH TP,B + PUSH P,E ;SAVE USEFUL FROB + MOVEI E,(A) ; CHAR COUNT TO E + GETYP A,A + CAIE A,TCHSTR ; IS IT ONE WORD? + JRST WRONGT ;NO + CAILE E,6 ; SKIP IF L=? 6 CHARS + MOVEI E,6 +CHREAD: MOVEI A,0 ;INITIALIZE OUTPUT WORD + MOVE D,[440600,,A] ;AND BYTE POINTER TO IT +NEXCHR: SOJL E,SIXDON + ILDB 0,B ; GET NEXT CHAR + CAIN 0,^Q ; CNTL-Q, QUOTES NEXT CHAR + JRST NEXCHR + JUMPE 0,SIXDON ;IF NULL, WE ARE FINISHED + PUSHJ P,A0TO6 ; CONVERT TO SIXBIT + IDPB 0,D ;DEPOSIT INTO SIX BIT + JRST NEXCHR ; NO, GET NEXT +SIXDON: SUB TP,[2,,2] ;FIX UP TP + POP P,E + EXCH A,(P) ;LEAVE RESULT ON P-STACK + JRST (A) ;NOW RETURN + + +;SUBROUTINE TO CONVERT SIXBIT TO ATOM + +6TOCHS: PUSH P,E + PUSH P,D + MOVEI B,0 ;MAX NUMBER OF CHARACTERS + PUSH P,[0] ;STRING WILL GO ON P SATCK + JUMPE A,GETATM ; EMPTY, LEAVE + MOVEI E,-1(P) ;WILL BE BYTE POINTER + HRLI E,10700 ;SET IT UP + PUSH P,[0] ;SECOND POSSIBLE WORD + MOVE D,[440600,,A] ;INPUT BYTE POINTER +6LOOP: ILDB 0,D ;START CHAR GOBBLING + ADDI 0,40 ;CHANGET TOASCII + IDPB 0,E ;AND STORE IT + TLNN D,770000 ; SKIP IF NOT DONE + JRST 6LOOP1 + TDNN A,MSKS(B) ; CHECK IF JUST SPACES LEFT + AOJA B,GETATM ; YES, DONE + AOJA B,6LOOP ;KEEP LOOKING +6LOOP1: PUSH P,[6] ;IF ARRIVE HERE, STRING IS 2 WORDS + JRST .+2 +GETATM: MOVEM B,(P) ;SET STRING LENGTH=1 + PUSHJ P,CHMAK ;MAKE A MUDDLE STRING + POP P,D + POP P,E + POPJ P, + +MSKS: 7777,,-1 + 77,,-1 + ,,-1 + 7777 + 77 + + +; CONVERT ONE CHAR + +A0TO6: CAIL 0,141 ;IF IT IS GREATER OR EQUAL TO LOWER A + CAILE 0,172 ;BUT LESS THAN OR EQUAL TO LOWER Z + JRST .+2 ;THEN + SUBI 0,40 ;CONVERT TO UPPER CASE + SUBI 0,40 ;NOW TO SIX BIT + JUMPL 0,BAD6 ;CHECK FOR A WINNER + CAILE 0,77 + JRST BAD6 + POPJ P, + +; SUBR TO TEST THE EXISTENCE OF FILES + +MFUNCTION FEXIST,SUBR,[FILE-EXISTS?] + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + ADD TP,[2,,2] + MOVSI E,-4 ; 4 THINGS TO PUSH +EXIST: +IFN ITS, MOVE B,@RNMTBL(E) +IFE ITS, MOVE B,@FETBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST EXIST1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ + PUSH P,E + PUSHJ P,ADDNUL + POP P,E + PUSH TP,A ; DEFAULT TYPE AND VALUE GIVEN BY USER + PUSH TP,B ; IN VALUE OF DEV, SNM, NM1, NM2 + ] +IFN ITS, JRST .+2 +IFE ITS, JRST .+3 + +EXIST1: +IFN ITS, PUSH P,EXISTS(E) ; USE DEFAULT +IFE ITS,[ + PUSH TP,FETYP(E) ; DEFAULT TYPE AND VALUE IF NO + PUSH TP,FEVAL(E) ; DEFAULT GIVEN BY USER + ] + AOBJN E,EXIST + + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST TMA ; TOO MANY ARGUMENTS + +IFN ITS,[ + MOVE 0,-3(P) ; GET SIXBIT DEV NAME + MOVEI B,0 + CAMN 0,[SIXBITS /DSK /] + MOVSI B,10 ; DONT SET REF DATE IF DISK DEV + .IOPUSH + DOTCAL OPEN,[B,[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST .+3 + .IOPOP + JRST FDLWON ; WON!!! + .STATUS 0,A ; FIND THE STATUS OF CHANNEL BEFORE POPING + .IOPOP + JRST FDLST1] + +IFE ITS,[ + MOVE B,TB + SUBI B,10 ; GET B TO POINT CORRECTLY TO ARGS + PUSHJ P,STSTK ; GET FILE NAME IN A STRING + HRROI B,1(E) ; POINT B TO THE STRING + MOVSI A,100001 + GTJFN + JRST TDLLOS ; FILE DOES NOT EXIST + RLJFN ; FILE EXIST SO RETURN JFN + JFCL + JRST FDLWON ; SUCCESS + ] + +IFN ITS,[ +EXISTS: SIXBITS /DSK INPUT > / + ] +IFE ITS,[ +FETBL: SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + +FETYP: TCHSTR,,5 + TCHSTR,,3 + TCHSTR,,3 + TCHSTR,,0 + +FEVAL: 440700,,[ASCIZ /INPUT/] + 440700,,[ASCIZ /MUD/] + 440700,,[ASCIZ /DSK/] + 0 + ] + +; SUBR TO DELETE AND RENAME FILES + +MFUNCTION RENAME,SUBR + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + GETYP 0,(AB) ; GET 1ST ARG TYPE +IFN ITS,[ + CAIN 0,TCHAN ; CHANNEL? + JRST CHNRNM ; MUST BE RENAME WHILE OPEN FOR WRITING +] +IFE ITS,[ + PUSH P,[100000,,-2] + PUSH P,[377777,,377777] +] + MOVSI E,-4 ; 4 THINGS TO PUSH +RNMALP: MOVE B,@RNMTBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST RNMLP1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ + PUSH P,E + PUSHJ P,ADDNUL + EXCH B,(P) + MOVE E,B +] + JRST .+2 + +RNMLP1: PUSH P,RNSTBL(E) ; USE DEFAULT + AOBJN E,RNMALP + +IFN ITS,[ + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST RNM1 ; COULD BE A RENAME + +; HERE TO DELETE A FILE + +DELFIL: MOVE A,(P) ; AND GET SNAME + .SUSET [.SSNAM,,A] + DOTCAL DELETE,[[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST FDLST ; ANALYSE ERROR + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS +] +IFE ITS,[ + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; GET BASE OF PDL + MOVEI A,1(A) ; POINT TO CRAP + CAMGE AB,[-3,,] ; SKIP IF DELETE + HLLZS (A) ; RESET DEFAULT + PUSH P,[0] + PUSH P,[0] + PUSH P,[0] + GTJFN ; GET A JFN + JRST TDLLOS ; LOST + ADD AB,[2,,2] ; PAST ARG + JUMPL AB,RNM1 ; GO TRY FOR RENAME + MOVE P,(TP) ; RESTORE P STACK + MOVEI C,(A) ; FOR RELEASE + DELF ; ATTEMPT DELETE + JRST DELLOS ; LOSER + RLJFN ; MAKE SURE FLUSHED + JFCL + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +RNMLOS: PUSH P,A + MOVEI A,(B) + RLJFN + JFCL +DELLO1: MOVEI A,(C) + RLJFN + JFCL + POP P,A ; ERR NUMBER BACK +TDLLOS: MOVEI B,0 + PUSHJ P,TGFALS ; GET FALSE WITH REASON + JRST FINIS + +DELLOS: PUSH P,A ; SAVE ERROR + JRST DELLO1 +] + +;TABLE OF REANMAE DEFAULTS +IFN ITS,[ +RNMTBL: IMQUOTE DEV + IMQUOTE NM1 + IMQUOTE NM2 + IMQUOTE SNM + +RNSTBL: SIXBIT /DSK _MUDS_> / +] +IFE ITS,[ +RNMTBL: SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + +RNSTBL: -1,,[ASCIZ /DSK/] + 0 + -1,,[ASCIZ /_MUDS_/] + -1,,[ASCIZ /MUD/] +] +; HERE TO DO A RENAME + +RNM1: JUMPGE AB,TMA ; IF ARGS EXHAUSTED, MUST BE TOO MUCH STRING + GETYP 0,(AB) + MOVE C,1(AB) ; GET ARG + CAIN 0,TATOM ; IS IT "TO" + CAME C,IMQUOTE TO + JRST WRONGT ; NO, LOSE + ADD AB,[2,,2] ; BUMP PAST "TO" + JUMPGE AB,TFA +IFN ITS,[ + MOVEM P,T.SPDL+1(TB) ; SAVE NEW P-BASE + + MOVEI 0,4 ; FOUR DEFAULTS + PUSH P,-3(P) ; DEFAULT DEVICE IS CURRENT + SOJN 0,.-1 + + PUSHJ P,RGPRS ; PARSE THE NEXT STRING + JRST TMA + + MOVE A,-7(P) ; FIX AND GET DEV1 + MOVE B,-3(P) ; SAME FOR DEV2 + CAME A,B ; SAME? + JRST DEVDIF + + POP P,A ; GET SNAME 2 + CAME A,(P)-3 ; SNAME 1 + JRST DEVDIF + .SUSET [.SSNAM,,A] + POP P,-2(P) ; MOVE NAMES DOWN + POP P,-2(P) + DOTCAL RENAME,[[17,,-4],[17,,-3],[17,,-2],A,[17,,-1],(P)] + JRST FDLST + JRST FDLWON + +; HERE FOR RENAME WHILE OPEN FOR WRITING + +CHNRNM: ADD AB,[2,,2] ; NEXT ARG + JUMPGE AB,TFA + MOVE B,-1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; SKIP IF OPEN + JRST BADCHN + MOVE A,DIRECT-1(B) ; CHECK DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A + CAME A,[SIXBIT /PRINT/] + CAMN A,[SIXBIT /PRINTB/] + JRST CHNRN1 + CAMN A,[SIXBIT /PRINAO/] + JRST CHNRM1 + CAME A,[SIXBIT /PRINTO/] + JRST WRONGD + +; SET UP .FDELE BLOCK + +CHNRN1: PUSH P,[0] + PUSH P,[0] + MOVEM P,T.SPDL+1(TB) + PUSH P,[0] + PUSH P,[SIXBIT /_MUDL_/] + PUSH P,[SIXBIT />/] + PUSH P,[0] + + PUSHJ P,RGPRS ; PARSE THESE + JRST TMA + + SUB P,[1,,1] ; SNAME/DEV IGNORED + MOVE AB,ABSAV(TB) ; GET ORIG ARG POINTER + MOVE B,1(AB) + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RENMWO,[A,[17,,-1],(P)] + JRST FDLST + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RFNAME,[A,[2017,,-4],[2017,,-3],[2017,,-2],[2017,,-1]] + JFCL + MOVE A,-3(P) ; UPDATE CHANNEL + PUSHJ P,6TOCHS ; GET A STRING + MOVE C,1(AB) + MOVEM A,RNAME1-1(C) + MOVEM B,RNAME1(C) + MOVE A,-2(P) + PUSHJ P,6TOCHS + MOVE C,1(AB) + MOVEM A,RNAME2-1(C) + MOVEM B,RNAME2(C) + MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS +] +IFE ITS,[ + PUSH P,A + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; PBASE BACK + PUSH A,[400000,,0] + MOVEI A,(A) + GTJFN + JRST TDLLOS + POP P,B + EXCH A,B + MOVEI C,(A) ; FOR RELEASE ATTEMPT + RNAMF + JRST RNMLOS + MOVEI A,(B) + RLJFN ; FLUSH JFN + JFCL + MOVEI A,(C) ; MAKE SURR OTHER IS FLUSHED + RLJFN + JFCL + JRST FDLWON + + +ADDNUL: PUSH TP,A + PUSH TP,B + MOVEI A,(A) ; LNTH OF STRING + IDIVI A,5 + JUMPN B,NONUAD ; DONT NEED TO ADD ONE + + PUSH TP,$TCHRS + PUSH TP,[0] + MOVEI A,2 + PUSHJ P,CISTNG ; COPY OF STRING + POPJ P, + +NONUAD: POP TP,B + POP TP,A + POPJ P, +] +; HERE FOR LOSING .FDELE + +IFN ITS,[ +FDLST: .STATUS 0,A ; GET STATUS +FDLST1: MOVEI B,0 + PUSHJ P,GFALS ; ANALYZE IT + JRST FINIS +] + +; SOME .FDELE ERRORS + +DEVDIF: ERRUUO EQUOTE DEVICE-OR-SNAME-DIFFERS + + ; HERE TO RESET A READ CHANNEL + +MFUNCTION FRESET,SUBR,RESET + + ENTRY 1 + GETYP A,(AB) + CAIE A,TCHAN + JRST WTYP1 + MOVE B,1(AB) ;GET CHANNEL + SKIPN IOINS(B) ; OPEN? + JRST REOPE1 ; NO, IGNORE CHECKS +IFN ITS,[ + MOVE A,STATUS(B) ;GET STATUS + ANDI A,77 + JUMPE A,REOPE1 ;IF IT CLOSED, JUST REOPEN IT, MAYBE? + CAILE A,2 ;SKIPS IF TTY FLAVOR + JRST REOPEN +] +IFE ITS,[ + MOVE A,CHANNO(B) + CAIE A,100 ; TTY-IN + CAIN A,101 ; TTY-OUT + JRST .+2 + JRST REOPEN +] + CAME B,TTICHN+1 + CAMN B,TTOCHN+1 + JRST REATTY +REATT1: MOVEI B,DIRECT-1(B) ;POINT TO DIRECTION + PUSHJ P,CHRWRD ;CONVERT TO A WORD + JFCL + CAME B,[ASCII /READ/] + JRST TTYOPN + MOVE B,1(AB) ;RESTORE CHANNEL + PUSHJ P,RRESET" ;DO REAL RESET + JRST TTYOPN + +REOPEN: PUSH TP,(AB) ;FIRST CLOSE IT + PUSH TP,(AB)+1 + MCALL 1,FCLOSE + MOVE B,1(AB) ;RESTORE CHANNEL + +; SET UP TEMPS FOR OPNCH + +REOPE1: PUSH P,[0] ; WILL HOLD DIR CODE + PUSH TP,$TPDL + PUSH TP,P + IRP A,,[DIRECT,RNAME1,RNAME2,RDEVIC,RSNAME,ACCESS] + PUSH TP,A-1(B) + PUSH TP,A(B) + TERMIN + + PUSH TP,$TCHAN + PUSH TP,1(AB) + + MOVE A,T.DIR(TB) + MOVE B,T.DIR+1(TB) ; GET DIRECTION + PUSHJ P,CHMOD ; CHECK THE MODE + MOVEM A,(P) ; AND STORE IT + +; NOW SET UP OPEN BLOCK IN SIXBIT + +IFN ITS,[ + MOVSI E,-4 ; AOBN PNTR +FRESE2: MOVE B,T.CHAN+1(TB) + MOVEI A,@RDTBL(E) ; GET ITEM POINTER + GETYP 0,-1(A) ; GET ITS TYPE + CAIE 0,TCHSTR + JRST FRESE1 + MOVE B,(A) ; GET STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 +FRESE3: AOBJN E,FRESE2 +] +IFE ITS,[ + MOVE B,T.CHAN+1(TB) + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; RESULT ON STACK + HLRZS (P) +] + + PUSH P,[0] ; PUSH UP SOME DUMMIES + PUSH P,[0] + PUSH P,[0] + PUSHJ P,OPNCH ; ATTEMPT TO DO THEOPEN + GETYP 0,A + CAIE 0,TCHAN + JRST FINIS ; LEAVE IF FALSE OR WHATEVER + +DRESET: MOVE A,(AB) + MOVE B,1(AB) + SETZM CHRPOS(B) ;INITIALIZE THESE PARAMETERS + SETZM LINPOS(B) + SETZM ACCESS(B) + JRST FINIS + +TTYOPN: +IFN ITS,[ + MOVE B,1(AB) + CAME B,TTOCHN+1 + CAMN B,TTICHN+1 + PUSHJ P,TTYOP2 + PUSHJ P,DOSTAT + DOTCAL RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]] + .LOSE %LSSYS + MOVEM C,PAGLN(B) + MOVEM D,LINLN(B) +] + JRST DRESET + +IFN ITS,[ +FRESE1: CAIE 0,TFIX + JRST BADCHN + PUSH P,(A) + JRST FRESE3 +] + +; INTERFACE TO REOPEN CLOSED CHANNELS + +OPNCHN: PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FRESET + POPJ P, + +REATTY: PUSHJ P,TTYOP2 +IFE ITS, SKIPN DEMFLG ; SKIP IF DEMONFLAG IS ON + SKIPE NOTTY + JRST DRESET + MOVE B,1(AB) + JRST REATT1 + +; FUNCTION TO LIST ALL CHANNELS + +MFUNCTION CHANLIST,SUBR + + ENTRY 0 + + MOVEI A,N.CHNS-1 ;MAX # OF REAL CHANNELS + MOVEI C,0 + MOVEI B,CHNL1 ;POINT TO FIRST REAL CHANNEL + +CHNLP: SKIPN 1(B) ;OPEN? + JRST NXTCHN ;NO, SKIP + HRRE E,(B) ; ABOUT TO FLUSH? + JUMPL E,NXTCHN ; YES, FORGET IT + MOVE D,1(B) ; GET CHANNEL + HRRZ E,CHANNO-1(D) ; GET REF COUNT + PUSH TP,(B) + PUSH TP,1(B) + ADDI C,1 ;COUNT WINNERS + SOJGE E,.-3 ; COUNT THEM +NXTCHN: ADDI B,2 + SOJN A,CHNLP + + SKIPN B,CHNL0+1 ;NOW HACK LIST OF PSUEDO CHANNELS + JRST MAKLST +CHNLS: PUSH TP,(B) + PUSH TP,(B)+1 + ADDI C,1 + HRRZ B,(B) + JUMPN B,CHNLS + +MAKLST: ACALL C,LIST + JRST FINIS + + ; ROUTINE TO RESTORE A CLOSED CHANNEL TO ITS PREVIOUS STATE + + +REOPN: PUSH TP,$TCHAN + PUSH TP,B + SKIPN CHANNO(B) ; ONLY REAL CHANNELS + JRST PSUEDO + +IFN ITS,[ + MOVSI E,-4 ; SET UP POINTER FOR NAMES + +GETOPB: MOVE B,(TP) ; GET CHANNEL + MOVEI A,@RDTBL(E) ; GET POINTER + MOVE B,(A) ; NOW STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 ; LEAVES SIXBIT ON STACK + AOBJN E,GETOPB +] +IFE ITS,[ + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; GET DEV NAME IN SIXBIT +] + MOVE B,(TP) ; RESTORE CHANNEL + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,CHMOD ; CHECK FOR A VALID MODE + +IFN ITS, MOVE E,-3(P) ; GET DEVICE IN PROPER PLACE +IFE ITS, HLRZS E,(P) + MOVE B,(TP) ; RESTORE CHANNEL +IFN ITS, CAMN E,[SIXBIT /DSK /] +IFE ITS,[ + CAIE E,(SIXBIT /PS /) + CAIN E,(SIXBIT /DSK/) + JRST DISKH ; DISK WINS IMMEIDATELY + CAIE E,(SIXBIT /SS /) + CAIN E,(SIXBIT /SRC/) + JRST DISKH ; DISK WINS IMMEIDATELY +] +IFN ITS, CAMN E,[SIXBIT /TTY /] ; NO NEED TO RE-OPEN THE TTY +IFE ITS, CAIN E,(SIXBIT /TTY/) + JRST REOPD1 +IFN ITS,[ + AND E,[777700,,0] ; COULD BE "UTn" + MOVE D,CHANNO(B) ; GET CHANNEL + ASH D,1 + ADDI D,CHNL0 ; DON'T SEEM TO BE OPEN + SETZM 1(D) + SETZM CHANNO(B) + CAMN E,[SIXBIT /UT /] + JRST REOPD ; CURRENTLY, CANT RESTORE UTAPE CHANNLES + CAMN E,[SIXBIT /AI /] + JRST REOPD ; CURRENTLY CANT RESTORE AI CHANNELS + CAMN E,[SIXBIT /ML /] + JRST REOPD ; CURRENTLY CANT RESTORE ML CHANNELS + CAMN E,[SIXBIT /DM /] + JRST REOPD ; CURRENTLY CANT RESTORE DM CHANNELS +] + PUSH TP,$TCHAN ; TRY TO RESET IT + PUSH TP,B + MCALL 1,FRESET + +IFN ITS,[ +REOPD1: AOS -4(P) +REOPD: SUB P,[4,,4] +] +IFE ITS,[ +REOPD1: AOS -1(P) +REOPD: SUB P,[1,,1] +] +REOPD0: SUB TP,[2,,2] + POPJ P, + +IFN ITS,[ +DISKH: MOVE C,(P) ; SNAME + .SUSET [.SSNAM,,C] +] +IFE ITS,[ +DISKH: MOVEM A,(P) ; SAVE MODE WORD + PUSHJ P,STSTK ; STRING TO STACK + MOVE A,(E) ; RESTORE MODE WORD + PUSH TP,$TPDL + PUSH TP,E ; SAVE PDL BASE + MOVE B,-2(TP) ; CHANNEL BACK TO B +] + MOVE C,ACCESS(B) ; GET CHANNELS ACCESS + TRNN A,2 ; SKIP IF NOT ASCII CHANNEL + JRST DISKH1 + HRRZ D,ACCESS-1(B) ; IF PARTIAL WORD OUT + IMULI C,5 ; TO CHAR ACCESS + JUMPE D,DISKH1 ; NO SWEAT + ADDI C,(D) + SUBI C,5 +DISKH1: HRRZ D,BUFSTR-1(B) ; ANY CHARS IN MUDDLE BUFFER + JUMPE D,DISKH2 + TRNN A,1 ; SKIP IF OUTPUT CHANNEL + JRST DISKH2 + PUSH P,A + PUSH P,C + MOVEI C,BUFSTR-1(B) + PUSHJ P,BYTDOP ; FIND LENGTH OF WHOLE BUFFER + HLRZ D,(A) ; LENGTH + 2 TO D + SUBI D,2 + IMULI D,5 ; TO CHARS + SUB D,BUFSTR-1(B) + POP P,C + POP P,A +DISKH2: SUBI C,(D) ; UPDATE CHAR ACCESS + IDIVI C,5 ; BACK TO WORD ACCESS +IFN ITS,[ + IORI A,6 ; BLOCK IMAGE + TRNE A,1 + IORI A,100000 ; WRITE OVER BIT + PUSHJ P,DOOPN + JRST REOPD + MOVE A,C ; ACCESS TO A + PUSHJ P,GETFLN ; CHECK LENGTH + CAIGE 0,(A) ; CHECK BOUNDS + JRST .+3 ; COMPLAIN + PUSHJ P,DOACCS ; AND ACESS + JRST REOPD1 ; SUCCESS + + MOVE A,CHANNO(B) ; CLOSE THE G.D. CHANNEL + PUSHJ P,MCLOSE + JRST REOPD + +DOACCS: PUSH P,A + HRRZ A,CHANNO(B) + DOTCAL ACCESS,[A,(P)] + JFCL + POP P,A + POPJ P, + +DOIOTO: +DOIOTI: +DOIOT: + PUSH P,0 + MOVSI 0,TCHAN + MOVE PVP,PVSTOR+1 + MOVEM 0,BSTO(PVP) ; IN CASE OF INTERRUPT + ENABLE + HRRZ 0,CHANNO(B) + DOTCAL IOT,[0,A] + JFCL + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + POP P,0 + POPJ P, + +GETFLN: MOVE 0,CHANNO(B) ; GET CHANNEL + .CALL FILBLK ; READ LNTH + .VALUE + POPJ P, + +FILBLK: SETZ + SIXBIT /FILLEN/ + 0 + 402000,,0 ; STUFF RESULT IN 0 +] +IFE ITS,[ + MOVEI A,CHNL0 + ADD A,CHANNO(B) + ADD A,CHANNO(B) + SETZM 1(A) ; MAY GET A DIFFERENT JFN + HRROI B,1(E) ; TENEX STRING POINTER + MOVSI A,400001 ; MAKE SURE + GTJFN ; GO GET IT + JRST RGTJL ; COMPLAIN + MOVE D,-2(TP) + HRRZM A,CHANNO(D) ; COULD HAVE CHANGED + MOVE P,(TP) ; RESTORE P + MOVEI B,CHNL0 + ASH A,1 ; MUNG ITS SLOT + ADDI A,(B) + MOVEM D,1(A) + HLLOS (A) ; MARK CHANNEL NOT TO BE RELOOKED AT + MOVE A,(P) ; MODE WORD BACK + MOVE B,[440000,,200000] ; FLAG BITS + TRNE A,1 ; SKIP FOR INPUT + TRC B,300000 ; CHANGE TO WRITE + MOVE A,CHANNO(D) ; GET JFN + OPENF + JRST ROPFLS + MOVE E,C ; LENGTH TO E + SIZEF ; GET CURRENT LENGTH + JRST ROPFLS + CAMGE B,E ; STILL A WINNER + JRST ROPFLS + MOVE A,CHANNO(D) ; JFN + MOVE B,C + SFPTR + JRST ROPFLS + SUB TP,[2,,2] ; FLUSH PDL POINTER + JRST REOPD1 + +ROPFLS: MOVE A,-2(TP) + MOVE A,CHANNO(A) + CLOSF ; ATTEMPT TO CLOSE + JFCL ; IGNORE FAILURE + SKIPA + +RGTJL: MOVE P,(TP) + SUB TP,[2,,2] + JRST REOPD + +DOACCS: PUSH P,B + EXCH A,B + MOVE A,CHANNO(A) + SFPTR + JRST ACCFAI + POP P,B + POPJ P, +] +PSUEDO: AOS (P) ; ASSUME SUCCESS FOR NOW + MOVEI B,RDEVIC-1(B) ; SEE WHAT DEVICE IS + PUSHJ P,CHRWRD + JFCL + JRST REOPD0 ; NO, RETURN HAPPY +IFN 0,[ CAME B,[ASCII /E&S/] ; DISPLAY ? + CAMN B,[ASCII /DIS/] + SKIPA B,(TP) ; YES, REGOBBLE CHANNEL AND CONTINUE + JRST REOPD0 ; NO, RETURN HAPPY + PUSHJ P,DISROP + SOS (P) ; DISPLAY DID NOT REOPEN, UNDO ASSUMPTION OF SUCCESS + JRST REOPD0] + + ;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL + +MFUNCTION FCLOSE,SUBR,[CLOSE] + + ENTRY 1 ;ONLY ONE ARG + GETYP A,(AB) ;CHECK ARGS + CAIE A,TCHAN ;IS IT A CHANNEL + JRST WTYP1 + MOVE B,1(AB) ;PICK UP THE CHANNEL + HRRZ A,CHANNO-1(B) ; GET REF COUNT + SOJGE A,CFIN5 ; NOT READY TO REALLY CLOSE + CAME B,TTICHN+1 ; CHECK FOR TTY + CAMN B,TTOCHN+1 + JRST CLSTTY + MOVE A,[JRST CHNCLS] + MOVEM A,IOINS(B) ;CLOBBER THE IO INS + MOVE A,RDEVIC-1(B) ;GET THE NAME OF THE DEVICE + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 +IFN ITS, MOVE A,(P) +IFE ITS, HLRZS A,(P) + MOVE B,1(AB) ; RESTORE CHANNEL +IFN 0,[ + CAME A,[SIXBIT /E&S /] + CAMN A,[SIXBIT /DIS /] + PUSHJ P,DISCLS] + MOVE B,1(AB) ; IN CASE CLOBBERED BY DISCLS + SKIPN A,CHANNO(B) ;ANY REAL CHANNEL? + JRST REMOV ; NO, EITHER CLOSED OR PSEUDO CHANNEL + + MOVE A,DIRECT-1(B) ; POINT TO DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; CONVERT TO WORD + POP P,A +IFN ITS, LDB E,[360600,,(P)] ; FIRST CHAR OD DEV NAME +IFE ITS, LDB E,[140600,,(P)] ; FIRST CHAR OD DEV NAME + CAIE E,'T ; SKIP IF TTY + JRST CFIN4 + CAME A,[SIXBIT /READ/] ; SKIP IF WINNER + JRST CFIN1 +IFN ITS,[ + MOVE B,1(AB) ; IN ITS CHECK STATUS + LDB A,[600,,STATUS(B)] + CAILE A,2 + JRST CFIN1 +] + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE CHAR + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,OFF ; TURN OFF INTERRUPT +CFIN1: MOVE B,1(AB) + MOVE A,CHANNO(B) +IFN ITS,[ + PUSHJ P,MCLOSE +] +IFE ITS,[ + TLZ A,400000 ; FOR JFN RELEASE + CLOSF ; CLOSE THE FILE AND RELEASE THE JFN + JFCL + MOVE A,CHANNO(B) +] +CFIN: LSH A,1 + ADDI A,CHNL0+1 ;POINT TO THIS CHANNELS LSOT + SETZM CHANNO(B) + SETZM (A) ;AND CLOBBER IT + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) + HLLZS ACCESS-1(B) +CFIN2: HLLZS -2(B) + MOVSI A,TCHAN ;RETURN THE CHANNEL + JRST FINIS + +CLSTTY: ERRUUO EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL + + +REMOV: MOVEI D,CHNL0+1 ;ATTEMPT TO REMOVE FROM PSUEDO CHANNEL LIST +REMOV0: SKIPN C,D ;FOUND ON LIST ? + JRST CFIN2 ;NO, JUST IGNORE THIS CLOSED CHANNEL + HRRZ D,(C) ;GET POINTER TO NEXT + CAME B,(D)+1 ;FOUND ? + JRST REMOV0 + HRRZ D,(D) ;YES, SPLICE IT OUT + HRRM D,(C) + JRST CFIN2 + + +; CLOSE UP ANY LEFTOVER BUFFERS + +CFIN4: +; CAME A,[SIXBIT /PRINTO/] +; CAMN A,[SIXBIT /PRINTB/] +; JRST .+3 +; CAME A,[SIXBIT /PRINT/] +; JRST CFIN1 + MOVE B,1(AB) ; GET CHANNEL + HRRZ A,-2(B) ;GET MODE BITS + TRNN A,C.PRIN + JRST CFIN1 + GETYP 0,BUFSTR-1(B) ; IS THERE AN OUTPUT BUFFER + SKIPN BUFSTR(B) + JRST CFIN1 + CAIE 0,TCHSTR + JRST CFINX1 + PUSHJ P,BFCLOS +IFE ITS,[ + MOVE A,CHANNO(B) + MOVEI B,7 + SFBSZ + JFCL + CLOSF + JFCL +] + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) +CFINX1: HLLZS ACCESS-1(B) + JRST CFIN1 + +CFIN5: HRRM A,CHANNO-1(B) + JRST CFIN2 + ;SUBR TO DO .ACCESS ON A READ CHANNEL +;FORM: +;POSITIONS CHANNEL AT CHARACTER POSN FIX-NUMBER +;H. BRODIE 7/26/72 + +MFUNCTION MACCESS,SUBR,[ACCESS] + ENTRY 2 ;ARGS: CHANNEL AND FIX-NUMBER + +;CHECK ARGUMENT TYPES + GETYP A,(AB) + CAIE A,TCHAN ;FIRST ARG SHOULD BE CHANNEL + JRST WTYP1 + GETYP A,2(AB) ;TYPE OF SECOND + CAIE A,TFIX ;SHOULD BE FIX + JRST WTYP2 + +;CHECK DIRECTION OF CHANNEL + MOVE B,1(AB) ;B GETS PNTR TO CHANNEL +; MOVEI B,DIRECT-1(B) ;GET DIRECTION OF CHANNEL +; PUSHJ P,CHRWRD ;GRAB THE CHAR STRNG +; JFCL +; CAME B,[+1] + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.PRIN + JRST MACCA + MOVE B,1(AB) + SKIPE C,BUFSTR(B) ;SEE IF WE MUST FLUSH PART BUFFER + PUSHJ P,BFCLOS + JRST MACC +MACCA: +; CAMN B,[ASCIZ /READ/] +; JRST .+4 +; CAME B,[ASCIZ /READB/] ; READB CHANNEL? +; JRST WRONGD +; AOS (P) ; SET INDICATOR FOR BINARY MODE + +;CHECK THAT THE CHANNEL IS OPEN +MACC: MOVE B,1(AB) ;GET BACK PTR TO CHANNEL + HRRZ E,-2(B) + TRNN E,C.OPN + JRST CHNCLS ;IF CHNL CLOSED => ERROR + +;COMPUTE ACCESS PNTR TO ACCESS WORD CHAR IS IN +;REMAINDER IS NUMBER OF TIMES TO INCR BYTE POINTER +ADEVOK: SKIPGE C,3(AB) ;GET CHAR POSN + ERRUUO EQUOTE NEGATIVE-ARGUMENT +MACC1: MOVEI D,0 + TRNN E,C.BIN ; SKIP FOR BINARY FILE + IDIVI C,5 + +;SETUP THE .ACCESS + TRNN E,C.PRIN + JRST NLSTCH + HRRZ 0,LSTCH-1(B) + MOVE A,ACCESS(B) + TRNN E,C.BIN + JRST LSTCH1 + IMULI A,5 + ADD A,ACCESS-1(B) + ANDI A,-1 +LSTCH1: CAIG 0,(A) + MOVE 0,A + MOVE A,C + IMULI A,5 + ADDI A,(D) + CAML A,0 + MOVE 0,A + HRRM 0,LSTCH-1(B) ; UPDATE "LARGEST" +NLSTCH: MOVE A,CHANNO(B) ;A GETS REAL CHANNEL NUMBER +IFN ITS,[ + DOTCAL ACCESS,[A,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + +IFE ITS,[ + MOVE B,C + SFPTR ; DO IT IN TENEX + JRST ACCFAI + MOVE B,1(AB) ; RESTORE CHANNEL +] +; POP P,E ; CHECK FOR READB MODE + TRNN E,C.READ + JRST ACCOUT ; PRINT TYPE CHANNEL, GO DO IT + SKIPE BUFSTR(B) ; IS THERE A READ BUFFER TO FLUSH + JRST .+3 + SETZM LSTCH(B) ; CLEAR OUT POSSIBLE EOF INDICATOR + JRST DONADV + +;NOW FORCE GETCHR TO DO A .IOT FIRST THING + MOVEI C,BUFSTR-1(B) ; FIND END OF STRING + PUSHJ P,BYTDOP" + SUBI A,2 ; LAST REAL WORD + HRLI A,010700 + MOVEM A,BUFSTR(B) + HLLZS BUFSTR-1(B) ; CLOBBER CHAR COUNT + SETZM LSTCH(B) ;CLOBBER READ'S HIDDEN CHARACTER + +;NOW DO THE APPROPRIATE NUM OF BYTE ADVANCEMENTS + JUMPLE D,DONADV +ADVPTR: PUSHJ P,GETCHR + MOVE B,1(AB) ;RESTORE IN CASE CLOBBERED + SOJG D,ADVPTR + +DONADV: MOVE C,3(AB) ;FIXUP ACCESS SLOT IN CHNL + HLLZS ACCESS-1(B) + MOVEM C,ACCESS(B) + MOVE A,$TCHAN ;TYPE OF RESULT = "CHANNEL" + JRST FINIS ;DONE...B CONTAINS CHANNEL + +IFE ITS,[ +ACCFAI: ERRUUO EQUOTE ACCESS-FAILURE +] +ACCOUT: SKIPN C,BUFSTR(B) ; FIXUP BUFFER? + JRST ACCOU1 + HRRZ F,BUFSTR-1(B) + ADD F,[-BUFLNT*5-4] + IDIVI F,5 + ADD F,BUFSTR(B) + HRLI F,010700 + MOVEM F,BUFSTR(B) + MOVEI F,BUFLNT*5 + HRRM F,BUFSTR-1(B) +ACCOU1: TRNE E,C.BIN ; FINISHED FOR BINARY CHANNELS + JRST DONADV + + JUMPE D,DONADV ; THIS CASE OK +IFE ITS,[ + MOVE A,CHANNO(B) ; GET LAST WORD + RFPTR + JFCL + PUSH P,B + MOVNI C,1 + MOVE B,[444400,,E] ; READ THE WORD + SIN + JUMPL C,ACCFAI + POP P,B + SFPTR + JFCL + MOVE B,1(AB) ; CHANNEL BACK + MOVE C,[440700,,E] + ILDB 0,C + IDPB 0,BUFSTR(B) + SOS BUFSTR-1(B) + SOJG D,.-3 + JRST DONADV +] +IFN ITS, ERRUUO EQUOTE CANT-ACCESS-ASCII-ON-ITS + + +;WRONG TYPE OF DEVICE ERROR +WRDEV: ERRUUO EQUOTE NON-DSK-DEVICE + +; BINARY READ AND PRINT ROUTINES + +MFUNCTION PRINTB,SUBR + + ENTRY 2 + +PBFL: PUSH P,. ; PUSH NON-ZERONESS + JRST BINI1 + +MFUNCTION READB,SUBR + + ENTRY + + PUSH P,[0] + HLRZ 0,AB + CAIG 0,-3 + CAIG 0,-7 + JRST WNA + +BINI1: GETYP 0,(AB) ; SHOULD BE UVEC OR STORE + CAIN 0,TUVEC + JRST BINI2 + CAIE 0,TSTORAGE + JRST WTYP1 ; ELSE LOSE +BINI2: MOVE B,1(AB) ; GET IT + HLRE C,B + SUBI B,(C) ; POINT TO DOPE + GETYP A,(B) + PUSHJ P,SAT" ; GET ITS ST.ALOC.TYPE + CAIE A,S1WORD + JRST WTYP1 + GETYP 0,2(AB) + CAIE 0,TCHAN ; BETTER BE A CHANNEL + JRST WTYP2 + MOVE B,3(AB) ; GET IT +; MOVEI B,DIRECT-1(B) ; GET DIRECTION OF +; PUSHJ P,CHRWRD ; INTO 1 WORD +; JFCL +; MOVNI E,1 +; CAMN B,[ASCII /READB/] +; MOVEI E,0 +; CAMN B,[+1] + HRRZ A,-2(B) ; MODE BITS + TRNN A,C.BIN ; IF NOT BINARY + JRST WRONGD + MOVEI E,0 + TRNE A,C.PRIN + MOVE E,PBFL +; JUMPL E,WRONGD ; LOSER + CAME E,(P) ; CHECK WINNGE + JRST WRONGD + MOVE B,3(AB) ; GET CHANNEL BACK + SKIPN A,IOINS(B) ; OPEN? + PUSHJ P,OPENIT ; LOSE + CAMN A,[JRST CHNCLS] + JRST CHNCLS ; LOSE, CLOSED + JUMPN E,BUFOU1 ; JUMP FOR OUTPUT + CAML AB,[-5,,] ; SKIP IF EOF GIVEN + JRST BINI5 + MOVE 0,4(AB) + MOVEM 0,EOFCND-1(B) + MOVE 0,5(AB) + MOVEM 0,EOFCND(B) +BINI5: SKIPE LSTCH(B) ; INDICATES IF EOF HIT + JRST BINEOF + MOVE A,1(AB) ; GET VECTOR + PUSHJ P,PGBIOI ; READ IT + HLRE C,A ; GET COUNT DONE + HLRE D,1(AB) ; AND FULL COUNT + SUB C,D ; C=> TOTAL READ + ADDM C,ACCESS(B) + JUMPGE A,BINIOK ; NOT EOF YET + SETOM LSTCH(B) +BINIOK: MOVE B,C + MOVSI A,TFIX ; RETURN AMOUNT ACTUALLY READ + JRST FINIS + +BUFOU1: SKIPE BUFSTR(B) ; ANY BUFFERS AROUND? + PUSHJ P,BFCLS1 ; GET RID OF SAME + MOVE A,1(AB) + PUSHJ P,PGBIOO + HLRE C,1(AB) + MOVNS C + addm c,ACCESS(B) + MOVE A,(AB) ; RET VECTOR ETC. + MOVE B,1(AB) + JRST FINIS + + +BINEOF: PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOSER + MCALL 1,EVAL + JRST FINIS + +OPENIT: PUSH P,E + PUSHJ P,OPNCHN ;TRY TO OPEN THE LOSER + JUMPE B,CHNCLS ;FAIL + POP P,E + POPJ P, + ; THESE SUBROUTINES BY NDR 9/16/73 TO FACILITATE THE +; TYPES OF IO NECESSARY TO MAKE MORE EFFICIENT USE OF +; THE NETWORK AND DO RELATED FILE TRANSFER TYPE OF JOBS. + +R1CHAR: SKIPN A,LSTCH(B) ; CHAR READING ROUTINE FOR FCOPY + PUSHJ P,RXCT + TLO A,200000 ; ^@ BUG + MOVEM A,LSTCH(B) + TLZ A,200000 + JUMPL A,.+2 ; IN CASE OF -1 ON STY + TRZN A,400000 ; EXCL HACKER + JRST .+4 + MOVEM A,LSTCH(B) ; SAVE DE-EXCLED CHAR + MOVEI A,"! + JRST .+2 + SETZM LSTCH(B) + PUSH P,C + HRRZ C,DIRECT-1(B) + CAIE C,5 ; IF DIRECTION IS 5 LONG THEN READB + JRST R1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) ; EVERY FIFTY INCREMENT + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +R1CH1: AOS ACCESS(B) + POP P,C + POPJ P, + +W1CHAR: CAIE A,15 ; CHAR WRITING ROUTINE, TEST FOR CR + JRST .+3 + SETOM CHRPOS(B) + AOSA LINPOS(B) + CAIE A,12 ; TEST FOR LF + AOS CHRPOS(B) ; IF NOT LF AOS CHARACTE5R POSITION + CAIE A,14 ; TEST FOR FORM FEED + JRST .+3 + SETZM CHRPOS(B) ; IF FORM FEED ZERO CHARACTER POSITION + SETZM LINPOS(B) ; AND LINE POSITION + CAIE A,11 ; IS THIS A TAB? + JRST .+6 + MOVE C,CHRPOS(B) + ADDI C,7 + IDIVI C,8. + IMULI C,8. ; FIX UP CHAR POS FOR TAB + MOVEM C,CHRPOS(B) ; AND SAVE + PUSH P,C + HRRZ C,-2(B) ; GET BITS + TRNN C,C.BIN ; SIX LONG MUST BE PRINTB + JRST W1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +W1CH1: AOS ACCESS(B) + PUSH P,A + PUSHJ P,WXCT + POP P,A + POP P,C + POPJ P, + +R1C: SUBM M,(P) ;LITTLE ENTRY FOR COMPILED STUFF +; PUSH TP,$TCHAN ;SAVE THE CHANNEL TO BLESS IT +; PUSH TP,B +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JFCL +; CAME B,[ASCIZ /READ/] +; CAMN B,[ASCII /READB/] +; JRST .+2 +; JRST BADCHN + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.READ + JRST BADCHN + SKIPN IOINS(B) ; IS THE CHANNEL OPEN + PUSHJ P,OPENIT ; NO, GO DO IT + PUSHJ P,GRB ; MAKE SURE WE HAVE A READ BUFFER + PUSHJ P,R1CHAR ; AND GET HIM A CHARACTER + JRST MPOPJ ; THATS ALL FOLKS + +W1C: SUBM M,(P) + PUSHJ P,W1CI + JRST MPOPJ + +W1CI: +; PUSH TP,$TCHAN +; PUSH TP,B + PUSH P,A ; ASSEMBLER ENTRY TO OUTPUT 1 CHAR +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; INTERNAL CALL TO W1CHAR +; JFCL +; CAME B,[ASCII /PRINT/] +; CAMN B,[+1] +; JRST .+2 +; JRST BADCHN +; POP TP,B +; POP TP,(TP) + HRRZ A,-2(B) + TRNN A,C.PRIN + JRST BADCHN + SKIPN IOINS(B) ; MAKE SURE THAT IT IS OPEN + PUSHJ P,OPENIT + PUSHJ P,GWB + POP P,A ; GET THE CHAR TO DO + JRST W1CHAR + +; ROUTINES TO REPLACE XCT IOINS(B) FOR INPUT AND OUTPUT +; THEY DO THE XCT THEN CHECK OUT POSSIBLE SCRIPTAGE--BLECH. + + +WXCT: +RXCT: XCT IOINS(B) ; READ IT + SKIPN SCRPTO(B) + POPJ P, + +DOSCPT: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; AND SAVE THE CHAR AROUND + + SKIPN SCRPTO(B) ; IF ZERO FORGET IT + JRST SCPTDN ; THATS ALL THERE IS TO IT + PUSH P,C ; SAVE AN ACCUMULATOR FOR CLEANLINESS + GETYP C,SCRPTO-1(B) ; IS IT A LIST + CAIE C,TLIST + JRST BADCHN + PUSH TP,$TLIST + PUSH TP,[0] ; SAVE A SLOT FOR THE LIST + MOVE C,SCRPTO(B) ; GET THE LIST OF SCRIPT CHANNELS +SCPT1: GETYP B,(C) ; GET THE TYPE OF THIS SCRIPT CHAN + CAIE B,TCHAN + JRST BADCHN ; IF IT ISN'T A CHANNEL, COMPLAIN + HRRZ B,(C) ; GET THE REST OF THE LIST IN B + MOVEM B,(TP) ; AND STORE ON STACK + MOVE B,1(C) ; GET THE CHANNEL IN B + MOVE A,-1(P) ; AND THE CHARACTER IN A + PUSHJ P,W1CI ; GO TO INTERNAL W1C, IT BLESSES GOODIES + SKIPE C,(TP) ; GET THE REST OF LIST OF CHANS + JRST SCPT1 ; AND CYCLE THROUGH + SUB TP,[2,,2] ; CLEAN OFF THE LIST OF CHANS + POP P,C ; AND RESTORE ACCUMULATOR C +SCPTDN: POP P,A ; RESTORE THE CHARACTER + POP TP,B ; AND THE ORIGINAL CHANNEL + POP TP,(TP) + POPJ P, ; AND THATS ALL + + +; SUBROUTINE TO COPY FROM INCHAN TO OUTCHAN UNTIL EOF HIT +; ON THE INPUT CHANNEL +; CALL IS WHERE DEFAULTS ARE INCHAN AND OUTCHAN + + MFUNCTION FCOPY,SUBR,[FILECOPY] + + ENTRY + HLRE 0,AB + CAMGE 0,[-4] + JRST WNA ; TAKES FROM 0 TO 2 ARGS + + JUMPE 0,.+4 ; NO FIRST ARG? + PUSH TP,(AB) + PUSH TP,1(AB) ; SAVE IN CHAN + JRST .+6 + MOVE A,$TATOM + MOVE B,IMQUOTE INCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B + HLRE 0,AB ; CHECK FOR SECOND ARG + CAML 0,[-2] ; WAS THERE MORE THAN ONE ARG? + JRST .+4 + PUSH TP,2(AB) ; SAVE SECOND ARG + PUSH TP,3(AB) + JRST .+6 + MOVE A,$TATOM ; LOOK UP OUTCHAN AS DEFAULT + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B ; AND SAVE IT + + MOVE A,-3(TP) + MOVE B,-2(TP) ; INPUT CHANNEL + MOVEI 0,C.READ ; INDICATE INPUT + PUSHJ P,CHKCHN ; CHECK FOR GOOD CHANNEL + MOVE A,-1(TP) + MOVE B,(TP) ; GET OUT CHAN + MOVEI 0,C.PRIN ; INDICATE OUT CHAN + PUSHJ P,CHKCHN ; CHECK FOR GOOD OUT CHAN + + PUSH P,[0] ; COUNT OF CHARS OUTPUT + + MOVE B,-2(TP) + PUSHJ P,GRB ; MAKE SURE WE HAVE READ BUFF + MOVE B,(TP) + PUSHJ P,GWB ; MAKE SURE WE HAVE WRITE BUFF + +FCLOOP: INTGO + MOVE B,-2(TP) + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,FCDON ; IF A NEG NUMBER WE GOT EOF + MOVE B,(TP) ; GET OUT CHAN + PUSHJ P,W1CHAR ; SPIT IT OUT + AOS (P) ; INCREMENT COUNT + JRST FCLOOP + +FCDON: SUB TP,[2,,2] ; POP OFF OUTCHAN + MCALL 1,FCLOSE ; CLOSE INCHAN + MOVE A,$TFIX + POP P,B ; GET CHAR COUNT TO RETURN + JRST FINIS + +CHKCHN: PUSH P,0 ; CHECK FOR GOOD TASTING CHANNEL + PUSH TP,A + PUSH TP,B + GETYP C,A + CAIE C,TCHAN + JRST CHKBDC ; GO COMPLAIN IN RIGHT WAY +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JRST CHKBDC +; MOVE C,(P) ; GET CHAN DIRECT + HRRZ C,-2(B) ; MODE BITS + TDNN C,0 + JRST CHKBDC +; CAMN B,CHKT(C) +; JRST .+4 +; ADDI C,2 ; TEST FOR READB OR PRINTB ALSO +; CAME B,CHKT(C) ; TEST FOR CORRECT DIRECT +; JRST CHKBDC + MOVE B,(TP) + SKIPN IOINS(B) ; MAKE SURE IT IS OPEN + PUSHJ P,OPENIT ; IF ZERO IOINS GO OPEN IT + SUB TP,[2,,2] + POP P, ; CLEAN UP STACKS + POPJ P, + +CHKT: ASCIZ /READ/ + ASCII /PRINT/ + ASCII /READB/ + +1 + +CHKBDC: POP P,E + MOVNI D,2 + IMULI D,1(E) + HLRE 0,AB + CAMLE 0,D ; SEE IF THIS WAS HIS ARG OF DEFAULT + JRST BADCHN + JUMPE E,WTYP1 + JRST WTYP2 + + ; FUNCTIONS READSTRING AND PRINTSTRING WORK LIKE READB AND PRINTB, +; THAT IS THEY READ INTO AND OUT OF STRINGS. IN ADDITION BOTH ACCEPT +; AN ADDITIONAL ARGUMENT WHICH IS THE NUMBER OF CHARS TO READ OR PRINT, IF +; IT IS DESIRED FOR THIS TO BE DIFFERENT THAN THE LENGTH OF THE STRING. + +; FORMAT IS +; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN + +; FORMAT FOR PRINTSTRING IS + +; THESE WERE CODED 9/16/73 BY NEAL D. RYAN + + MFUNCTION RSTRNG,SUBR,READSTRING + + ENTRY + PUSH P,[0] ; FLAG TO INDICATE READING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-9] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 4 ARGS + JRST STRIO1 + + MFUNCTION PSTRNG,SUBR,PRINTSTRING + + ENTRY + PUSH P,[1] ; FLAG TO INDICATE WRITING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-7] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 3 ARGS + +STRIO1: PUSH TP,[0] ; SAVE SLOT ON STACK + PUSH TP,[0] + GETYP 0,(AB) + CAIE 0,TCHSTR ; MAKE SURE WE GOT STRING + JRST WTYP1 + HRRZ 0,(AB) ; CHECK FOR EMPTY STRING + SKIPN (P) + JUMPE 0,MTSTRN + HLRE 0,AB + CAML 0,[-2] ; WAS A CHANNEL GIVEN + JRST STRIO2 + GETYP 0,2(AB) + SKIPN (P) ; SKIP IF PRINT + JRST TESTIN + CAIN 0,TTP ; SEE IF FLATSIZE HACK + JRST STRIO9 +TESTIN: CAIE 0,TCHAN + JRST WTYP2 ; SECOND ARG NOT CHANNEL + MOVE B,3(AB) + HRRZ B,-2(B) + MOVNI E,1 ; CHECKING FOR GOOD DIRECTION + TRNE B,C.READ ; SKIP IF NOT READ + MOVEI E,0 + TRNE B,C.PRIN ; SKIP IF NOT PRINT + MOVEI E,1 + CAME E,(P) + JRST WRONGD ; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE +STRIO9: PUSH TP,2(AB) + PUSH TP,3(AB) ; PUSH ON CHANNEL + JRST STRIO3 +STRIO2: MOVE B,IMQUOTE INCHAN + MOVSI A,TCHAN + SKIPE (P) + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + GETYP 0,A + SKIPN (P) ; SKIP IF PRINTSTRING + JRST TESTI2 + CAIN 0,TTP ; SKIP IF NOT FLATSIZE HACK + JRST STRIO8 +TESTI2: CAIE 0,TCHAN + JRST BADCHN ; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL +STRIO8: PUSH TP,A + PUSH TP,B +STRIO3: MOVE B,(TP) ; GET CHANNEL + SKIPN E,IOINS(B) + PUSHJ P,OPENIT ; IF NOT GO OPEN + MOVE E,IOINS(B) + CAMN E,[JRST CHNCLS] + JRST CHNCLS ; CHECK TO SEE THAT CHANNEL ISNT ALREADY CLOSED +STRIO4: HLRE 0,AB + CAML 0,[-4] + JRST STRIO5 ; NO COUNT TO WORRY ABOUT + GETYP 0,4(AB) + MOVE E,4(AB) + MOVE C,5(AB) + CAIE 0,TCHSTR + CAIN 0,TFIX ; BETTER BE A FIXED NUMBER + JRST .+2 + JRST WTYP3 + HRRZ D,(AB) ; GET ACTUAL STRING LENGTH + CAIN 0,TFIX + JRST .+7 + SKIPE (P) ; TEST FOR WRITING + JRST .-7 ; IF WRITING WE GOT TROUBLE + PUSH P,D ; ACTUAL STRING LENGTH + MOVEM E,(TB) ; STUFF HIS FUNNY DELIM STRING + MOVEM C,1(TB) + JRST STRIO7 + CAML D,C ; MAKE SURE THE STRING IS LONG ENOUGH + JRST .+2 ; WIN + ERRUUO EQUOTE COUNT-GREATER-THAN-STRING-SIZE + PUSH P,C ; PUSH ON MAX COUNT + JRST STRIO7 +STRIO5: +STRIO6: HRRZ C,(AB) ; GET CHAR COUNT + PUSH P,C ; AND PUSH IT ON STACK AS NO MAX COUNT GIVEN +STRIO7: HLRE 0,AB + CAML 0,[-6] + JRST .+6 + MOVE B,(TP) ; GET THE CHANNEL + MOVE 0,6(AB) + MOVEM 0,EOFCND-1(B) ; STUFF IN SLOT IN CHAN + MOVE 0,7(AB) + MOVEM 0,EOFCND(B) + PUSH TP,(AB) ; PUSH ON STRING + PUSH TP,1(AB) + PUSH P,[0] ; PUSH ON CURRENT COUNT OF CHARS DONE + MOVE 0,-2(P) ; GET READ OR WRITE FLAG + JUMPN 0,OUTLOP ; GO WRITE STUFF + + MOVE B,-2(TP) ; GET CHANNEL + PUSHJ P,GRB ; MAKE SURE WE HAVE BUFF + SKIPGE A,LSTCH(B) ; CHECK FOR EOF ALREADY READ PREVIOUSLY + JRST SRDOEF ; GO DOES HIS EOF HACKING +INLOP: INTGO + MOVE B,-2(TP) ; GET CHANNEL + MOVE C,-1(P) ; MAX COUNT + CAMG C,(P) ; COMPARE WITH COUNT DONE + JRST STREOF ; WE HAVE FINISHED + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,INEOF ; EOF HIT + MOVE C,1(TB) + HRRZ E,(TB) ; DO WE HAVE A STRING TO WORRY US? + SOJL E,INLNT ; GO FINISH STUFFING + ILDB D,C + CAME D,A + JRST .-3 + JRST INEOF +INLNT: IDPB A,(TP) ; STUFF IN STRING + SOS -1(TP) ; DECREMENT STRING COUNT + AOS (P) ; INCREMENT CHAR COUNT + JRST INLOP + +INEOF: SKIPE C,LSTCH(B) ; IS THIS AN ! AND IS THERE A CHAR THERE + JRST .+3 ; YES + MOVEM A,LSTCH(B) ; NO SAVE THE CHAR + JRST .+3 + ADDI C,400000 + MOVEM C,LSTCH(B) + MOVSI C,200000 + IORM C,LSTCH(B) + HRRZ C,DIRECT-1(B) ; GET THE TYPE OF CHAN + CAIN C,5 ; IS IT READB? + JRST .+3 + SOS ACCESS(B) ; FIX UP ACCESS FOR READ CHANNEL + JRST STREOF ; AND THATS IT + HRRZ C,ACCESS-1(B) ; FOR A READB ITS WORSE + MOVEI D,5 + SKIPG C + HRRM D,ACCESS-1(B) ; CHANGE A 0 TO A FIVE + SOS C,ACCESS-1(B) + CAMN C,[TFIX,,0] + SOS ACCESS(B) ; AND SOS THE WORD COUNT MAYBE + JRST STREOF + +SRDOEF: SETZM LSTCH(B) ; IN CASE OF -1, FLUSH IT + AOJE A,INLOP ; SKIP OVER -1 ON PTY'S + SUB TP,[6,,6] + SUB P,[3,,3] ; POP JUNK OFF STACKS + PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) ; WHAT WE NEED TO EVAL + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOOSING CHANNEL + MCALL 1,EVAL ; EVAL HIS EOF JUNK + JRST FINIS + +OUTLOP: MOVE B,-2(TP) +OUTLP1: INTGO + MOVE A,-3(TP) ; GET CHANNEL + MOVE B,-2(TP) + MOVE C,-1(P) ; MAX COUNT TO DO + CAMG C,(P) ; HAVE WE DONE ENOUGH + JRST STREOF + ILDB D,(TP) ; GET THE CHAR + SOS -1(TP) ; SUBTRACT FROM STRING LENGTH + AOS (P) ; INC COUNT OF CHARS DONE + PUSHJ P,CPCH1 ; GO STUFF CHAR + JRST OUTLP1 + +STREOF: MOVE A,$TFIX + POP P,B ; RETURN THE LOOSER A COUNT OF WHAT WAS DONE + SUB P,[2,,2] + SUB TP,[6,,6] + JRST FINIS + + +GWB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A WRITE BUFFER ON PRINTB CHAN + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVSI A,TWORD+.VECT. + MOVEM A,BUFLNT(B) + SETOM (B) + MOVEI C,1(B) + HRLI C,(B) + BLT C,BUFLNT-1(B) + MOVEI C,-1(B) + HRLI C,010700 + MOVE B,(TP) + MOVEI 0,C.BUF + IORM 0,-2(B) + MOVEM C,BUFSTR(B) + MOVE C,[TCHSTR,,BUFLNT*5] + MOVEM C,BUFSTR-1(B) + SUB TP,[2,,2] + POPJ P, + + +GRB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A READ BUFFER + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVEI C,BUFLNT-1(B) + POP TP,B + MOVEI 0,C.BUF + IORM 0,-2(B) + HRLI C,010700 + MOVEM C,BUFSTR(B) + MOVSI C,TCHSTR + MOVEM C,BUFSTR-1(B) + SUB TP,[1,,1] + POPJ P, + +MTSTRN: ERRUUO EQUOTE EMPTY-STRING + + ; INPUT UNBUFFERING ROUTINE. THIS DOES THE CHARACTER UNBUFFERING +; FOR INPUT. THE OPEN ROUTINE SETUPS A PUSHJ P, TO +; THIS ROUTINE AS THE IOINS FOR A CHANNEL OPEN TO A NON-TTY DEVICE. + +; H. BRODIE 7/19/72 + +; CALLING SEQ: +; PUSHJ P,GETCHR +; B/ AOBJN PNTR TO CHANNEL VECTOR +; RETURNS NEXT CHARACTER IN AC A. +; ON ENCOUNTERING EITHER ^C OR NUL(^@) IT ASSUMES EOF AND +; TRANSMITS ONLY ^C ON SUCCESSIVE CALLS + + +GETCHR: +; FIRST GRAB THE BUFFER +; GETYP A,BUFSTR-1(B) ; GET TYPE WORD +; CAIN A,TCHSTR ; SKIPS IF NOT CHSTR (I.E. IF BAD BUFFER) +; JRST GTGBUF ; IS GOOD BUFFER...SKIP ERROR RETURN +GTGBUF: HRRZ A,BUFSTR-1(B) ; GET LENGTH OF STRING + SOJGE A,GTGCHR ; JUMP IF STILL MORE + +; HERE IF THE BUFFER WAS EXHAUSTED (BYTE PNTR POINTS INTO DOPE WDS) +; GENERATE AN .IOT POINTER +;FIRST SAVE C AND D AS I WILL CLOBBER THEM +NEWBUF: PUSH P,C + PUSH P,D +IFN ITS,[ + LDB C,[600,,STATUS(B)] ; GET TYPE + CAIG C,2 ; SKIP IF NOT TTY +] +IFE ITS,[ + SKIPE BUFRIN(B) +] + JRST GETTTY ; GET A TTY BUFFER + + PUSHJ P,PGBUFI ; RE-FILL BUFFER + +IFE ITS, MOVEI C,-1 + JUMPGE A,BUFGOO ;SKIPS IF IOT COMPLETED...FIX UP CHANNEL + MOVEI C,1 ; MAKE SURE LAST EOF REALLY ENDS IT + ANDCAM C,-1(A) + MOVSI C,014000 ; GET A ^C + MOVEM C,(A) ;FAKE AN EOF + +IFE ITS,[ + HLRE C,A ; HOW MUCH LEFT + ADDI C,BUFLNT ; # OF WORDS TO C + IMULI C,5 ; TO CHARS + MOVE A,-2(B) ; GET BITS + TRNE A,C.BIN ; CAN'T HELP A BINARY CHANNEL + JRST BUFGOO + MOVE A,CHANNO(B) + PUSH P,B + PUSH P,D + PUSH P,C + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + MOVE B,[2,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + POP P,C + CAIE D,7 ; SEVEN BIT BYTES? + JRST BUFGO1 ; NO, DONT HACK + MOVE D,C + IDIVI B,5 ; C IS NUMBER IN LAST WORD IF NOT EVEN + SKIPN C + MOVEI C,5 + ADDI C,-5(D) ; FIXUP C FOR WINNAGE +BUFGO1: POP P,D + POP P,B +] +; RESET THE BYTE POINTER IN THE CHANNEL. +; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D +BUFGOO: HRLI D,010700 ; GENERATE VIRGIN LH + SUBI D,1 + + MOVEM D,BUFSTR(B) ; STASH IN THE BUFFER BYTE PNTR SLOT +IFE ITS, HRRM C,LSTCH-1(B) ; SAVE IT + MOVEI A,BUFLNT*5-1 +BUFROK: POP P,D ;RESTORE D + POP P,C ;RESTORE C + + +; HERE IF THERE ARE CHARS IN BUFFER +GTGCHR: HRRM A,BUFSTR-1(B) + ILDB A,BUFSTR(B) ; GET A CHAR FROM BUFFER + +IFN ITS,[ + CAIE A,3 ; EOF? + POPJ P, ; AND RETURN + LDB A,[600,,STATUS(B)] ; CHECK FOR TTY + CAILE A,2 ; SKIP IF TTY +] +IFE ITS,[ + PUSH P,0 + HRRZ 0,LSTCH-1(B) + SOJL 0,.+4 + HRRM 0,LSTCH-1(B) + POP P,0 + POPJ P, + + POP P,0 + MOVSI A,-1 + SKIPN BUFRIN(B) +] + JRST .+3 +RETEO1: HRRI A,3 + POPJ P, + + HRRZ A,BUFSTR(B) ; SEE IF RSUBR START BIT IS ON + HRRZ A,(A) + TRNN A,1 + MOVSI A,-1 + JRST RETEO1 + +IFN ITS,[ +PGBUFO: +PGBUFI: +] +IFE ITS,[ +PGBUFO: SKIPA D,[SOUT] +PGBUFI: MOVE D,[SIN] +] + SKIPGE A,BUFSTR(B) ; POINT TO CURRENT BUFFER POSIT + SUBI A,1 ; FOR 440700 AND 010700 START + SUBI A,BUFLNT-1 ; CALCULATE PNTR TO BEG OF BUFFER + HRLI A,-BUFLNT ; IOT (AOBJN) PNTR IN A +IFN ITS,[ +PGBIOO: +PGBIOI: MOVE D,A ; COPY FOR LATER + MOVSI C,TUVEC ; PREPARE TO HANDDLE INTS + MOVE PVP,PVSTOR+1 + MOVEM C,DSTO(PVP) + MOVEM C,ASTO(PVP) + MOVSI C,TCHAN + MOVEM C,BSTO(PVP) + +; BUILD .IOT INSTR + MOVE C,CHANNO(B) ; CHANNEL NUMBER IN C + ROT C,23. ; MOVE INTO AC FIELD + IOR C,[.IOT 0,A] ; IOR IN SKELETON .IOT + +; DO THE .IOT + ENABLE ; ALLOW INTS + XCT C ; EXECUTE THE .IOT INSTR + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM ASTO(PVP) + SETZM DSTO(PVP) + POPJ P, +] + +IFE ITS,[ +PGBIOT: PUSH P,D + PUSH TP,$TCHAN + PUSH TP,B + MOVEI C,-1(A) ; POINT TO BUFFER + HRLI C,004400 + HLRE D,A ; XTRA POINTER + MOVNS D + HRLI D,TCHSTR + MOVE PVP,PVSTOR+1 + MOVEM D,BSTO(PVP) + MOVE D,[PUSHJ P,FIXACS] + MOVEM D,ONINT + MOVSI D,TUVEC + MOVEM D,DSTO(PVP) + MOVE D,A + MOVE A,CHANNO(B) ; FILE JFN + MOVE B,C + HLRE C,D ; - COUNT TO C + ENABLE + XCT (P) ; DO IT TO IT + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM DSTO(PVP) + SETZM ONINT + MOVEI A,1(B) + MOVE B,(TP) + SUB TP,[2,,2] + SUB P,[1,,1] + JUMPGE C,CPOPJ ; NO EOF YET + HRLI A,(C) ; LOOK LIKE AN AOBJN PNTR + POPJ P, + +FIXACS: PUSH P,PVP + MOVE PVP,PVSTOR+1 + MOVNS C + HRRM C,BSTO(PVP) + MOVNS C + POP P,PVP + POPJ P, + +PGBIOO: SKIPA D,[SOUT] +PGBIOI: MOVE D,[SIN] + JRST PGBIOT +DOIOTO: PUSH P,D + PUSH P,C + PUSHJ P,PGBIOO +DOIOTE: POP P,C + POP P,D + POPJ P, +DOIOTI: PUSH P,D + PUSH P,C + PUSHJ P,PGBIOI + JRST DOIOTE +] + +; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE + +PUTCHR: PUSH P,A + GETYP A,BUFSTR-1(B) ; CHECK TYPE OF ARG + CAIE A,TCHSTR ; MUST BE STRING + JRST BDCHAN + + HRRZ A,BUFSTR-1(B) ; GET CHAR COUNT + JUMPE A,REBUFF ; PREV RESET BUFF, UNDO SAME + +PUTCH1: POP P,A ; RESTORE CHAR + CAMN A,[-1] ; SPECIAL HACK? + JRST PUTCH2 ; YES GO HANDLE + IDPB A,BUFSTR(B) ; STUFF IT +PUTCH3: SOS A,BUFSTR-1(B) ; COUNT DOWN STRING + TRNE A,-1 ; SKIP IF FULL + POPJ P, + +; HERE TO FLUSH OUT A BUFFER + + PUSH P,C + PUSH P,D + PUSHJ P,PGBUFO ; SETUP AND DO IOT + HRLI D,010700 ; POINT INTO BUFFER + SUBI D,1 + MOVEM D,BUFSTR(B) ; STORE IT + MOVEI A,BUFLNT*5 ; RESET COUNT + HRRM A,BUFSTR-1(B) + POP P,D + POP P,C + POPJ P, + +;HERE TO DA ^C AND TURN ON MAGIC BIT + +PUTCH2: MOVEI A,3 + IDPB A,BUFSTR(B) ; ZAP OUT THE ^C + MOVEI A,1 ; GET BIT +IFE ITS,[ + PUSH P,C + HRRZ C,BUFSTR(B) + IORM A,(C) + POP P,C +] +IFN ITS,[ + IORM A,@BUFSTR(B) ; ON GOES THE BIT +] + JRST PUTCH3 + +; RESET A FUNNY BUF + +REBUFF: MOVEI A,BUFLNT*5 ; 1ST COUNT + HRRM A,BUFSTR-1(B) + HRRZ A,BUFSTR(B) ; NOW POINTER + SUBI A,BUFLNT+1 + HRLI A,010700 + MOVEM A,BUFSTR(B) ; STORE BACK + JRST PUTCH1 + + +; HERE TO FLUSH FINAL BUFFER + +BFCLOS: HRRZ C,-2(B) ; THIS BUFFER FLUSHER THE WORK OF NDR + MOVEI A,0 + TRNE C,C.TTY + POPJ P, + TRNE C,C.DISK + MOVEI A,1 + PUSH P,A ; SAVE THE RESULT OF OUR TEST + JUMPN A,BFCLNN ; DONT HAVE TO CHECK NET STATE + PUSH TP,$TCHAN + PUSH TP,B ; SAVE CHANNEL + PUSHJ P,INSTAT ; GET CURRENT NETWORK STATE + MOVE A,(B) ; GET FIRST ELEMENT OF STATE UVECTOR WHICH IS CUR STATE + POP TP,B ; RESTORE B + POP TP, + CAIE A,5 ; IS NET IN OPEN STATE? + CAIN A,6 ; OR ELSE IS IT IN RFNM WAIT STATE + JRST BFCLNN ; IF SO TO THE IOT + POP P, ; ELSE FLUSH CRUFT AND DONT IOT + POPJ P, ; RETURN DOING NO IOT +BFCLNN: MOVEI C,BUFLNT*5 ; NEW BUFFER FLUSHER BY NDR + HRRZ D,BUFSTR-1(B) ; SO THAT NET ALSO WORKS RIGHT + SUBI C,(D) ; GET NUMBER OF CHARS + IDIVI C,5 ; NUMBER OF FULL WORDS AND REST + PUSH P,D ; SAVE NUMBER OF ODD CHARS + SKIPGE A,BUFSTR(B) ; GET CURRENT BUF POSITION + SUBI A,1 ; FIX FOR 440700 BYTE POINTER +IFE ITS,[ + HRRO D,A + PUSH P,(D) +] +IFN ITS,[ + PUSH P,(A) ; SAVE THE ODD WORD OF BUFFER +] + MOVEI D,BUFLNT + SUBI D,(C) + SKIPE -1(P) + SUBI A,1 + ADDI D,1(A) ; FIX UP FOR POSSIBLE ODD CHARS + PUSH TP,$TUVEC + PUSH TP,D ; PUSH THE DOPE VECTOR ONTO THE STACK + JUMPE C,BFCLSR ; IN CASE THERE ARE NO FULL WORDS TO DO + HRL A,C + TLO A,400000 + MOVE E,[SETZ BUFLNT(A)] + SUBI E,(C) ; FIX UP FOR BACKWARDS BLT + POP A,@E ; AMAZING GRACE + TLNE A,377777 + JRST .-2 + HRRO A,D ; SET UP AOBJN POINTER + SUBI A,(C) + TLC A,-1(C) + PUSHJ P,PGBIOO ; DO THE IOT OF ALL THE FULL WORDS +BFCLSR: HRRO A,(TP) ; GET IOT PTR FOR REST OF JUNK + SUBI A,1 ; POINT TO WORD BEFORE DOPE WORDS + POP P,0 ; GET BACK ODD WORD + POP P,C ; GET BACK ODD CHAR COUNT + POP P,D ; FLAG FOR NET OR DSK + JUMPN D,BFCDSK ; GO FINISH OFF DSK + JUMPE C,BFCLSD ; IF NO ODD CHARS FINISH UP + MOVEI D,7 + IMULI D,(C) ; FIND NO OF BITS TO SHIFT + LSH 0,-43(D) ; SHIFT BITS TO RIGHT PLACE + MOVEM 0,(A) ; STORE IN STRING + SUBI C,5 ; HOW MANY CHAR POSITIONS TO SKIP + MOVNI C,(C) ; MAKE C POSITIVE + LSH C,17 + TLC A,(C) ; MUNG THE AOBJN POINTER TO KLUDGE + PUSHJ P,PGBIOO ; DO IOT OF ODD CHARS + MOVEI C,0 +BFCLSD: HRRZ A,(TP) ; GET PTR TO DOPE WORD + SUBI A,BUFLNT+1 + JUMPLE C,.+3 + SKIPE ACCESS(B) + MOVEM 0,1(A) ; LAST WORD BACK IN BFR + HRLI A,010700 ; AOBJN POINTER TO FIRST OF BUFFER + MOVEM A,BUFSTR(B) + MOVEI A,BUFLNT*5 + HRRM A,BUFSTR-1(B) + SKIPN ACCESS(B) + JRST BFCLSY + JUMPL C,BFCLSY + JUMPE C,BFCLSZ + IBP BUFSTR(B) + SOS BUFSTR-1(B) + SOJG C,.-2 +BFCLSY: MOVE A,CHANNO(B) + MOVE C,B +IFE ITS,[ + RFPTR + FATAL RFPTR FAILED + HRRZ F,LSTCH-1(C) ; PREVIOUS HIGH + MOVE G,C ; SAVE CHANNEL + MOVE C,B + CAML F,B + MOVE C,F + MOVE F,B + HRLI A,400000 + CLOSF + JFCL + MOVNI B,1 + HRLI A,12 + CHFDB + MOVE B,STATUS(G) + ANDI A,-1 + OPENF + FATAL OPENF LOSES + MOVE C,F + IDIVI C,5 + MOVE B,C + SFPTR + FATAL SFPTR FAILED + MOVE B,G +] +IFN ITS,[ + DOTCAL RFPNTR,[A,[2000,,B]] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + SUBI B,1 + DOTCAL ACCESS,[A,B] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + MOVE B,C +] +BFCLSZ: SUB TP,[2,,2] + POPJ P, + +BFCDSK: TRZ 0,1 + PUSH P,C +IFE ITS,[ + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,0 ; WORD OF CHARS + MOVE A,CHANNO(B) + MOVEI B,7 ; MAKE BYTE SIZE 7 + SFBSZ + JFCL + HRROI B,(P) + MOVNS C + SKIPE C + SOUT + MOVE B,(TP) + SUB P,[1,,1] + SUB TP,[2,,2] +] +IFN ITS,[ + MOVE D,[440700,,A] + DOTCAL SIOT,[CHANNO(B),D,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + POP P,C + JUMPN C,BFCLSD +BFCDS1: MOVNI C,1 ; INDICATE NOT TOHACK BUFFER + JRST BFCLSD + +BFCLS1: HRRZ C,DIRECT-1(B) + MOVSI 0,(JFCL) + CAIE C,6 + MOVE 0,[AOS ACCESS(B)] + PUSH P,0 + HRRZ C,BUFSTR-1(B) + IDIVI C,5 + JUMPE D,BCLS11 + MOVEI A,40 ; PAD WITH SPACES + PUSHJ P,PUTCHR + XCT (P) ; AOS ACCESS IF NECESSARY + SOJG D,.-3 ; TO END OF WORD +BCLS11: POP P,0 + HLLZS ACCESS-1(B) + HRRZ C,BUFSTR-1(B) + CAIE C,BUFLNT*5 + PUSHJ P,BFCLOS + POPJ P, + + +; HERE TO GET A TTY BUFFER + +GETTTY: SKIPN C,EXBUFR(B) ; SKIP IF BUFFERS BACKED UP + JRST TTYWAI + HRRZ D,(C) ; CDR THE LIST + GETYP A,(C) ; CHECK TYPE + CAIE A,TDEFER ; MUST BE DEFERRED + JRST BDCHAN + MOVE C,1(C) ; GET DEFERRED GOODIE + GETYP A,(C) ; BETTER BE CHSTR + CAIE A,TCHSTR + JRST BDCHAN + MOVE A,(C) ; GET FULL TYPE WORD + MOVE C,1(C) + MOVEM D,EXBUFR(B) ; STORE CDR'D LIST + MOVEM A,BUFSTR-1(B) ; MAKE CURRENT BUFFER + MOVEM C,BUFSTR(B) + HRRM A,LSTCH-1(B) + SOJA A,BUFROK + +TTYWAI: PUSHJ P,TTYBLK ; BLOCKED FOR TTY I/O + JRST GETTTY ; SHOULD ONLY RETURN HAPPILY + + ;INTERNAL DEVICE READ ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT, +;CHECKS THAT THE RETURNED VALUE IS OF TYPE CHARACTER, +;AND RETURNS THAT AS THE NEXT CHARACTER IN THE "FILE" + +;H. BRODIE 8/31/72 + +GTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,INTFCN-1(B) + PUSH TP,INTFCN(B) + MCALL 1,APPLY + GETYP A,A + CAIE A,TCHRS + JRST BADRET + MOVE A,B +INTRET: POP P,0 ;RESTORE THE ACS + POP P,E + POP P,D + POP P,C + POP TP,B ;RESTORE THE CHANNEL + SUB TP,[1,,1] ;FLUSH $TCHAN...WE DON'T NEED IT + POPJ P, + + +BADRET: ERRUUO EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT + +;INTERNAL DEVICE PRINT ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,(FUNCTION, SUBR, OR RSUBR) +;TO THE CURRENT CHARACTER BEING "PRINTED". + +PTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,INTFCN-1(B) ;PUSH TYPE OF GIVEN OBJ + PUSH TP,INTFCN(B) ;PUSH THE SUPPLIED FUNCTION (OR SUBR ETC.) + PUSH TP,$TCHRS ;PUSH THE TYPE "CHARACTER" + PUSH TP,A ;PUSH THE CHAR + MCALL 2,APPLY ;APPLY THE FUNCTION TO THE CHAR + JRST INTRET + + + +; ROUTINE TO FLUSH OUT A PRINT BUFFER + +MFUNCTION BUFOUT,SUBR + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + + MOVE B,1(AB) +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; GET DIR NAME +; JFCL +; CAMN B,[ASCII /PRINT/] +; JRST .+3 +; CAME B,[+1] +; JRST WRONGD +; TRNE B,1 ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN B,1 ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] + HRRZ 0,-2(B) + TRNN 0,C.PRIN + JRST WRONGD +; TRNE 0,C.BIN ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN 0,C.BIN ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] +; MOVE B,1(AB) +; GETYP 0,BUFSTR-1(B) +; CAIN 0,TCHSTR +; SKIPN A,BUFSTR(B) ; BYTE POINTER? +; JRST BFIN1 +; HRRZ C,BUFSTR-1(B) ; CHARS LEFT +; IDIVI C,5 ; MULTIPLE OF 5? +; JUMPE D,BFIN2 ; YUP NO EXTRAS + +; MOVEI A,40 ; PAD WITH SPACES +; PUSHJ P,PUTCHR ; OUT IT GOES +; XCT (P) ; MAYBE BUMP ACCESS +; SOJG D,.-3 ; FILL + +BFIN2: PUSHJ P,BFCLOS ; WRITE OUT BUFFER + +BFIN1: MOVSI A,TCHAN + JRST FINIS + + + +; FUNCTION TO GET THE FILE LENGTH OF A READ CHANNEL + +MFUNCTION FILLNT,SUBR,[FILE-LENGTH] + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) + PUSHJ P,CFILLE + JRST FINIS + +CFILLE: +IFN 0,[ + MOVEI B,DIRECT-1(B) ; GET CHANNEL TYPE + PUSHJ P,CHRWRD + JFCL + CAME B,[ASCIZ /READ/] + JRST .+3 + PUSH P,[5] ; MULTIPLICATIVE FACTOR FOR READ + JRST .+4 + CAME B,[ASCII /READB/] + JRST WRONGD + PUSH P,[1] ; MULTIPLICATIVE FACTOR FOR READ +] + MOVE C,-2(B) ; GET BITS + MOVEI D,5 ; ASSUME ASCII + TRNE C,C.BIN ; SKIP IF NOT BINARY + MOVEI D,1 + PUSH P,D + MOVE C,B +IFN ITS,[ + .CALL FILL1 + JRST FILLOS ; GIVE HIM A NICE FALSE +] +IFE ITS,[ + MOVE A,CHANNO(C) + PUSH P,[0] + MOVEI C,(P) + MOVE B,[1,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,(P)] ; GET BYTE SIZE + JUMPN D,.+2 + MOVEI D,36. ; HANDLE "0" BYTE SIZE + SUB P,[1,,1] + SIZEF + JRST FILLOS +] + POP P,C +IFN ITS, IMUL B,C +IFE ITS,[ + CAIN C,5 + CAIE D,7 + JRST NOTASC +] +YESASC: MOVE A,$TFIX + POPJ P, + +IFE ITS,[ +NOTASC: MOVEI 0,36. + IDIV 0,D ; BYTES PER WORD + IDIVM B,0 + IMUL C,0 + MOVE B,C + JRST YESASC +] + +IFN ITS,[ +FILL1: SETZ ; BLOCK FOR .CALL TO FILLEN + SIXBIT /FILLEN/ + CHANNO (C) + SETZM B + +FILLOS: MOVE A,CHANNO(C) + MOVE B,[.STATUS A] ;MAKE A CALL TO STATUS TO FIND REASON + LSH A,23. ;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE + IOR B,A ;FIX UP .STATUS + XCT B + MOVE B,C + PUSHJ P,GFALS + POP P, + POPJ P, +] +IFE ITS,[ +FILLOS: MOVE B,C + PUSHJ P,TGFALS + POP P, + POPJ P, +] + + + ; MCHAN LOW-LEVEL I/O GARBAGE (PDL)-ORIGINAL (LIM)-ADDITIONS + +;CALLING ROUTINE: AC-A contains pointer to block of SIXBIT data +; DIR ? DEV ? FNM1 ? FNM2 ? SNM +;RETURNED VALUE : AC-A = +IFN ITS,[ +MOPEN: PUSH P,B + PUSH P,C + MOVE C,FRSTCH ; skip gc and tty channels +CNLP: DOTCAL STATUS,[C,[2000,,B]] + .LOSE %LSFIL + ANDI B,77 + JUMPE B,CHNFND ; found unused channel ? + ADDI C,1 ; try another channel + CAIG C,17 ; are all the channels used ? + JRST CNLP + SETO C, ; all channels used so C = -1 + JRST CHNFUL +CHNFND: MOVEI B,(C) + HLL B,(A) ; M.DIR slot + DOTCAL OPEN,[B,1(A),2(A),3(A),4(A)] + SKIPA + AOS -2(P) ; successful skip when returning +CHNFUL: MOVE A,C + POP P,C + POP P,B + POPJ P, + +MIOT: DOTCAL IOT,[A,B] + JFCL + POPJ P, + +MCLOSE: DOTCAL CLOSE,[A] + JFCL + POPJ P, + +IMPURE + +FRSTCH: 1 + +PURE +] + ;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O + +NOTNET: +BADCHN: ERRUUO EQUOTE BAD-CHANNEL +BDCHAN: ERRUUO EQUOTE BAD-INPUT-BUFFER + +WRONGD: ERRUUO EQUOTE WRONG-DIRECTION-CHANNEL + +CHNCLS: ERRUUO EQUOTE CHANNEL-CLOSED + +BAD6: ERRUUO EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME + +DISLOS: MOVE C,$TCHSTR + MOVE D,CHQUOTE [DISPLAY NOT AVAILABLE] + PUSHJ P,INCONS + MOVSI A,TFALSE + JRST OPNRET + +NOCHAN: ERRUUO EQUOTE ITS-CHANNELS-EXHAUSTED + +MODE1: 232020,,202020 +MODE2: 232023,,330320 + +END + + \ No newline at end of file diff --git a//fopen.mid.54 b//fopen.mid.54 new file mode 100644 index 0000000..fcdfdf0 --- /dev/null +++ b//fopen.mid.54 @@ -0,0 +1,4686 @@ +TITLE OPEN - CHANNEL OPENER FOR MUDDLE + +RELOCATABLE + +;C. REEVE MARCH 1973 + +.INSRT MUDDLE > + +SYSQ + +FNAMS==1 +F==E+1 +G==F+1 + +IFE ITS,[ +IF1, .INSRT STENEX > +] +;THIS PROGRAM HAS ENTRIES: FOPEN, FCLOSE, RENAME, READB, PRINTB, FILECOPY, READSTRING, +; PRINTSTRING, NETSTATE, NETACC, NETS, ACCESS, AND FILE-EXISTS? + +;THESE SUBROUTINES HANDLE I/O STREAMS FOR THE MUDDLE SYSTEM. + +; FOPEN - OPENS A FILE FOR EITHER READING OR WRITING. IT TAKES +; FIVE OPTINAL ARGUMENTS AS FOLLOWS: + +; FOPEN (,,,,) +; +; - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ + +; - FIRST FILE NAME. DEFAULT INPUT OR OUTPUT. + +; - SECOND FILE NAME. DEFAULT MUDDLE. + +; - DEVICE FROM WHICH TO OPEN. DEFAULT IS DSK. + +; - SYSTEM (DIRECTORY) NAME. DEFAULT UNAME. + +; FOPEN RETURNS AN OBJECT OF TYPE CHANNEL IF IT SUCCEEDS OTHERWISE NIL + + +; FCLOSE - CLOSES A FILE. TAKES A CHANNEL OBJECT AS ITS ARGUMENT. IT ALSO TAKES +; ACCESS - DOES A .ACCESS ON A CHARACTER BASIS FOR CHARACTER FILES + + +; A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION + +; CHANNO ;ITS I/O CHANNEL NUMBER. 0 MEANS NOT A REAL CHANNEL. +; DIRECT ;DIRECTION (EITHER READ OR PRINT) +; NAME1 ;FIRST NAME OF FILE AS OPENED. +; NAME2 ;SECOND NAME OF FILE +; DEVICE ;DEVICE UPON WHICH THE CHANNEL IS OPEN +; SNAME ;DIRECTORY NAME +; RNAME1 ;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS) +; RNAME2 ;REAL SECOND NAME +; RDEVIC ;REAL DEVICE +; RSNAME ;SYSTEM OR DIRECTORY NAME +; STATUS ;VARIOUS STATUS BITS +; IOINS ;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER +; ACCESS ;ACCESS POINTER FOR RAND ACCESS (OR USED FOR DISPLAY INFO) +; RADX ;RADIX FOR CHANNELS NUMBER CONVERSION + +; *** THE FOLLOWING FIELDS FOR OUTPUT ONLY *** +; LINLN ;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE +; CHRPOS ;CURRENT POSITION ON CURRENT LINE +; PAGLN ;LENGTH OF A PAGE +; LINPOS ;CURRENT LINE BEING WRITTEN ON + +; *** THE FOLLOWING FILEDS FOR INPUT ONLY *** +; EOFCND ;GETS EVALUATED ON EOF +; LSTCH ;BACKUP CHARACTER +; WAITNS ;FOR TTY INPUT, BECOMES A .SLEEP WHEN WAITING +; EXBUFR ;FOR TTY INPUT, CONTAINS A WAITING BUFFER LIST +; BUFSTR ;A CHARACTER STRING USED AS BUFFER FOR NON-TTY DEVICES + +; THIS DEFINES THE LENGTH OF THE NON-TTY BUFFER +BUFLNT==100 + +;THIS DEFINES BLOCK MODE BIT FOR OPENING +BLOCKM==2 ;DEFINED IN THE LEFT HALF +IMAGEM==4 + + +;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME + + CHANLNT==4 ;INITIAL CHANNEL LENGTH + +; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS +BUFRIN==-1 ;SPECIAL HACK SO LOSERS WON'T SEE TTY BUFFER +SCRPTO==-3 ;SPECIAL HACK FOR SCRIPT CHANNELS +PROCHN: + +IRP A,,[[CHANNO,FIX],[DIRECT,CHSTR] +[NAME1,CHSTR],[NAME2,CHSTR],[DEVICE,CHSTR],[SNAME,CHSTR] +[RNAME1,CHSTR],[RNAME2,CHSTR],[RDEVIC,CHSTR],[RSNAME,CHSTR] +[STATUS,FIX],[IOINS,FIX],[LINLN,FIX],[CHRPOS,FIX],[PAGLN,FIX],[LINPOS,FIX] +[ACCESS,FIX],[RADX,FIX],[BUFSTR,CHSTR]] + + IRP B,C,[A] + B==CHANLNT-3 + T!C,,0 + 0 + .ISTOP + TERMIN + CHANLNT==CHANLNT+2 +TERMIN + + +; EQUIVALANCES FOR CHANNELS + +EOFCND==LINLN +LSTCH==CHRPOS +WAITNS==PAGLN +EXBUFR==LINPOS +DISINF==BUFSTR ;DISPLAY INFO +INTFCN==BUFSTR ;FUNCTION (OR SUBR, OR RSUBR) TO BE APPLIED FOR INTERNAL CHNLS + + +;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS + +IRP A,,[IOIN2,ECHO,CHRCNT,ERASCH,KILLCH,BRKCH,ESCAP,SYSCHR,BRFCHR,BRFCH2,BYTPTR] +A==.IRPCNT +TERMIN + +EXTBFR==BYTPTR+1+<100./5> ;LENGTH OF ADD'L BUFFER + + + + +.GLOBAL IPNAME,MOPEN,MCLOSE,MIOT,ILOOKU,6TOCHS,ICLOS,OCLOS,RGPARS,RGPRS +.GLOBAL OPNCHN,CHMAK,READC,TYO,SYSCHR,BRFCHR,LSTCH,BRFCH2,EXTBFR +.GLOBAL CHRWRD,STRTO6,TTYBLK,WAITNS,EXBUFR,TTICHN,TTOCHN,GETCHR,IILIST +.GLOBAL CHANNO,STATUS,LINPOS,PAGLN,CHRPOS,LINLN,IOINS,ACCESS,ADDNUL +.GLOBAL DIRECT,DISINF,RADX,EOFCND,BUFSTR,MODE1,MODE2,GCHACK,GMTYO,INMTYO +.GLOBAL T.CHAN,NAME1,BFCLOS,DOIOTI,DOIOTO,DOACCS,NOTTY,DEMFLG,BYTDOP,TNXIN +.GLOBAL DISOPN,DISROP,DISCLS,DCHAR,DISLNL,DISPGL,INSTAT,MTYO,CIREST +.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP,N.CHNS +.GLOBAL REOPN,QUITTE,CHNL0,CHNL1,BUFRIN,IOIN2,IFALSE,GFALS,IDVAL,PVSTOR,SPSTOR +.GLOBAL BADCHN,WRONGD,CHNCLS,GSNAME,GIBLOK,APLQ,NAPT,ICONS,INCONS,IBLOCK,IDVAL1 +.GLOBAL GRB,GWB,R1CHAR,W1CHAR,BFCLS1,TTYOP2,MPOPJ,COMPER,R1C,W1C,WXCT,RXCT +.GLOBAL TMTNXS,TNXSTR,RDEVIC,CPCH1,RCYCHN,CGFALS,CISTNG,CFILLE,FRSTCH +.GLOBAL TGFALS,ONINT + +.VECT.==40000 + +; PAIR MOVING MACRO + +DEFINE PMOVEM A,B + MOVE 0,A + MOVEM 0,B + MOVE 0,A+1 + MOVEM 0,B+1 + TERMIN + +; DEFINITIONS OF THE OFFSETS INTO THE TP STACK FOR OPEN + +T.SPDL==0 ; SAVES P STACK BASE +T.DIR==2 ; CONTAINS DIRECTION AND MODE +T.NM1==4 ; NAME 1 OF FILE +T.NM2==6 ; NAME 2 OF FILE +T.DEV==10 ; DEVICE NAME +T.SNM==12 ; SNAME +T.XT==14 ; EXTRA CRUFT IF NECESSARY +T.CHAN==16 ; CHANNEL AS GENERATED + +; OFFSETS FROM PSTACK BASE (USED FOR OPENS, .RCHST AND .FDELES) + +S.DIR==0 ; CODE FOR DIRECTION 0-IN, 1-OUT, 2-BIN, 3-BOUT,4-DISPLAY + ; S.DIR(P) = ,, +IFN ITS,[ +S.DEV==1 ; SIXBIT DEVICE RIGHT JUSTIFIED +S.NM1==2 ; SIXBIT NAME1 +S.NM2==3 ; SIXBIT NAME2 +S.SNM==4 ; SIXBIT SNAME +S.X1==5 ; TEMPS +S.X2==6 +S.X3==7 +] + +IFE ITS,[ +S.DEV==1 +S.X1==2 +S.X2==3 +S.X3==4 +] + + +; FLAGS SPECIFYING STATE OF THE WORLD AT VARIOUS TIMES + +NOSTOR==400000 ; ON MEANS DONT BUILD NEW STRINGS +MSTNET==200000 ; ON MEANS ONLY THE "NET" DEVICE CAN WIN +SNSET==100000 ; FLAG, SNAME SUPPLIED +DVSET==040000 ; FLAG, DEV SUPPLIED +N2SET==020000 ; FLAG, NAME2 SET +N1SET==010000 ; FLAG, NAME1 SET +4ARG==004000 ; FLAG, CONSIDER ARGS TO BE 4 STRINGS + +RMT [EXPUNGE N1SET,N2SET,DVSET,SNSET,MSTNET,NOSTOR +] + +; TABLE OF LEGAL MODES + +MODES: IRP A,,[READ,PRINT,READB,PRINTB,PRINTO,PRINAO] + SIXBIT /A/ + TERMIN +NMODES==.-MODES + +MODCOD: 0?1?2?3?3?1 +; TABLE OF KNOWN DEVICES AND A POINTER TO THEIR OPENERS + +IFN ITS,[ +DEVSTB: IRP A,,[DSK,TTY,USR,STY,ST,NET,INT,PTP,PTR,UT,T,NUL] + SIXBIT /A/ ; DEVICE NAMES + TERMIN + +DEVS: IRP B,,[ODSK,OTTY,OUSR,OSTY,OSTY,ONET,OINT,OPTP,OPTP,OUTN,OTTY,ONUL] + SETZ B ; POINTERS + TERMIN +] + +IFE ITS,[ +DEVSTB: IRP A,,[PS,SS,SRC,DSK,TTY,INT,NET] + SIXBIT /A/ + TERMIN + +DEVS: IRP B,,[ODSK,ODSK,ODSK,ODSK,OTTY,OINT,ONET] + SETZ B + TERMIN +] +NDEVS==.-DEVS + + + +;SUBROUTINE TO DO OPENING BEGINS HERE + +MFUNCTION NFOPEN,SUBR,[OPEN-NR] + + JRST FOPEN1 + +MFUNCTION FOPEN,SUBR,[OPEN] + +FOPEN1: ENTRY + PUSHJ P,MAKCHN ;MAKE THE CHANNEL + PUSHJ P,OPNCH ;NOW OPEN IT + JUMPL B,FINIS + SUB D,[4,,4] ; TOP THE CHANNEL + MOVEM D,RCYCHN+1 ; RECYCLE DEAD CHANNEL + SETZM (D) ; ZAP IT + MOVEI C,1(D) + HRLI C,(D) + BLT C,CHANLNT-1(D) + JRST FINIS + +; SUBR TO JUST CREATE A CHANNEL + +IMFUNCTION CHANNEL,SUBR + + ENTRY + PUSHJ P,MAKCHN + MOVSI A,TCHAN + JRST FINIS + + + + +; THIS ROUTINE PARSES ARGUMENTS TO FOPEN ETC. AND BUILDS A CHANNEL BUT DOESN'T OPEN IT + +MAKCHN: PUSH TP,$TPDL + PUSH TP,P ; POINT AT CURRENT STACK BASE + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE READ + MOVEI E,10 ; SLOTS OF TP NEEDED + PUSH TP,[0] + SOJG E,.-1 + MOVEI E,0 + EXCH E,(P) ; GET RET ADDR IN E +IFE ITS, PUSH P,[0] +IRP ATM,,[DEV,NM1,NM2,SNM]MDF,,[DSK,INPUT,>,[ ]]TMDF,,[DSK,INPUT,MUD,[ ]] + MOVE B,IMQUOTE ATM +IFN ITS, PUSH P,E + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TCHSTR + JRST MAK!ATM + + MOVE A,$TCHSTR +IFN ITS, MOVE B,CHQUOTE MDF +IFE ITS, MOVE B,CHQUOTE TMDF +MAK!ATM: + MOVEM A,T.!ATM(TB) + MOVEM B,T.!ATM+1(TB) +IFN ITS,[ + POP P,E + PUSHJ P,STRTO6 ; RESULT LEFT ON P STACK AS DESIRED +] + TERMIN + PUSH TP,[0] ; PUSH SLOTS + PUSH TP,[0] + + PUSH P,[0] ; EXT SLOTS + PUSH P,[0] + PUSH P,[0] + PUSH P,E ; PUSH RETURN ADDRESS + MOVEI A,0 + + JUMPGE AB,MAKCH0 ; NO ARGS, ALREADY DONE + GETYP 0,(AB) ; 1ST ARG MUST BE A STRING + CAIE 0,TCHSTR + JRST WTYP1 + MOVE A,(AB) ; GET ARG + MOVE B,1(AB) + PUSHJ P,CHMODE ; CHECK OUT OPEN MODE + + PMOVEM (AB),T.DIR(TB) ; SAVE MODE NAME IN TEMPS + ADD AB,[2,,2] ; BUMP PAST DIRECTION + MOVEI A,0 + JUMPGE AB,MAKCH0 ; CHECK NAME1 BASED ON JUST MODE + + MOVEI 0,0 ; FLAGS PRESET + PUSHJ P,RGPARS ; PARSE THE STRING(S) + JRST TMA + +; ARGUMENTS PARSED, DO FINAL CHECKS AND BUILD CHANNEL + +MAKCH0: +IFN ITS,[ + MOVE C,T.SPDL+1(TB) + MOVE D,S.DEV(C) ; GET DEV +] +IFE ITS,[ + MOVE A,T.DEV(TB) + MOVE B,T.DEV+1(TB) + PUSHJ P,STRTO6 + POP P,D + HLRZS D + MOVE C,T.SPDL+1(TB) + MOVEM D,S.DEV(C) +] +IFE ITS, CAIE D,(SIXBIT /INT/);INTERNAL? +IFN ITS, CAME D,[SIXBIT /INT /] + JRST CHNET ; NO, MAYBE NET + SKIPN T.XT+1(TB) ; WAS FCN SUPPLIED? + JRST TFA + +; FALLS TROUGH IF SKIP + + + +; NOW BUILD THE CHANNEL + +ARGSOK: MOVEI A,CHANLNT ; GET LENGTH + SKIPN B,RCYCHN+1 ; RECYCLE? + PUSHJ P,GIBLOK ; GET A BLOCK OF STUFF + SETZM RCYCHN+1 + ADD B,[4,,4] ; HIDE THE TTY BUFFER SLOT + PUSH TP,$TCHAN + PUSH TP,B + HRLI C,PROCHN ; POINT TO PROTOTYPE + HRRI C,(B) ; AND NEW ONE + BLT C,CHANLN-5(B) ; CLOBBER + MOVSI C,TLIST ; TO GIVE HIM A CLEAN LIST OF SCRIPT CHANS + HLLM C,SCRPTO-1(B) + +; NOW BLT IN STUFF FROM THE STACK + + MOVSI C,T.DIR(TB) ; DIRECTION + HRRI C,DIRECT-1(B) + BLT C,SNAME(B) + MOVEI C,RNAME1-1(B) ; NOW "REAL" SLOTS + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + MOVE B,IMQUOTE MODE + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TFIX + JRST .+3 + MOVE B,(TP) + POPJ P, + + MOVE C,(TP) +IFE ITS,[ + ANDI B,403776 ; ONLY ALLOW NON-CRITICAL BITSS +] + HRRM B,-4(C) ; HIDE BITS + MOVE B,C + POPJ P, + +; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN + +CHNET: +IFN ITS,[ + CAME D,[SIXBIT /NET /] ; IS IT NET + JRST MAKCH1] +IFE ITS,[ + CAIE D,(SIXBIT /NET/) ; IS IT NET + JRST ARGSOK] + MOVSI D,TFIX ; FOR TYPES + MOVEI B,T.NM1(TB) ; MAKE SURE ALL ARE FIXED + PUSHJ P,CHFIX + MOVEI B,T.NM2(TB) + PUSHJ P,CHFIX + MOVEI B,T.SNM(TB) + LSH A,-1 ; SKIP DEV FLAG + PUSHJ P,CHFIX + JRST ARGSOK + +MAKCH1: TRNN A,MSTNET ; CANT HAVE SEEN A FIX + JRST ARGSOK + JRST WRONGT + +IFN ITS,[ +CHFIX: TRNE A,N1SET ; SKIP IF NOT SPECIFIED + JRST CHFIX1 + SETOM 1(B) ; SET TO -1 + SETOM S.NM1(C) + MOVEM D,(B) ; CORRECT TYPE +] +IFE ITS,CHFIX: + GETYP 0,(B) + CAIE 0,TFIX + JRST PARSQ +CHFIX1: ADDI C,1 ; POINT TO NEXT FIELD + LSH A,-1 ; AND NEXT FLAG + POPJ P, +PARSQ: CAIE 0,TCHSTR + JRST WRONGT +IFE ITS, POPJ P, +IFN ITS,[ + PUSH P,A + PUSH P,C + PUSH TP,(B) + PUSH TP,1(B) + SUBI B,(TB) + PUSH P,B + MCALL 1,PARSE + GETYP 0,A + CAIE 0,TFIX + JRST WRONGT + POP P,C + ADDI C,(TB) + MOVEM A,(C) + MOVEM B,1(C) + POP P,C + POP P,A + POPJ P, +] + + +; SUBROUTINE TO CHECK VALIDITY OF MODE AND SAVE A CODE + +CHMODE: PUSHJ P,CHMOD ; DO IT + MOVE C,T.SPDL+1(TB) + HRRZM A,S.DIR(C) + POPJ P, + +CHMOD: PUSHJ P,STRTO6 ; TO SIXBIT + POP P,B ; VALUE ENDSUP ON STACK, RESTORE IT + + MOVSI A,-NMODES ; SCAN TO SEE IF LEGAL MODE + CAME B,MODES(A) + AOBJN A,.-1 + JUMPGE A,WRONGD ; ILLEGAL MODE NAME + MOVE A,MODCOD(A) + POPJ P, + + +IFN ITS,[ +; RGPARS -- PARSE THE STRINGS COMPRISING FILE NAMES INTO STANDARD ITS GOODIES + +RGPRS: MOVEI 0,NOSTOR ; DONT STORE STRINGS IF ENTER HERE + +RGPARS: CAMGE AB,[-7,,] ; MULTI-STRING CASE POSSIBLE? + IORI 0,4ARG ; 4 STRING CASE + HRLM 0,(P) ; LH IS FLAGS FOR THIS PROG + MOVSI E,-4 ; FIELDS TO FILL + +RPARGL: GETYP 0,(AB) ; GET TYPE + CAIE 0,TCHSTR ; STRING? + JRST ARGCLB ; NO, JUST CLOBBER IT IN RAW + JUMPGE E,CPOPJ ; DON'T DO ANY MORE + PUSH TP,(AB) ; GET AN ARG + PUSH TP,1(AB) + +FPARS: PUSH TP,-1(TP) ; ANOTHER COPY + PUSH TP,-1(TP) + HLRZ 0,(P) + TRNN 0,4ARG + PUSHJ P,FLSSP ; NO LEADING SPACES + MOVEI A,0 ; WILL HOLD SIXBIT + MOVEI B,6 ; CHARS PER 6BIT WORD + MOVE C,[440600,,A] ; BYTE POINTER INTO A + +FPARSL: HRRZ 0,-1(TP) ; GET COUNT + JUMPE 0,PARSD ; DONE + SOS -1(TP) ; COUNT + ILDB 0,(TP) ; CHAR TO 0 + + CAIE 0," ; FILE NAME QUOTE? + JRST NOCNTQ + HRRZ 0,-1(TP) + JUMPE 0,PARSD + SOS -1(TP) + ILDB 0,(TP) ; USE THIS + JRST GOTCNQ + +NOCNTQ: HLL 0,(P) + TLNE 0,4ARG + JRST GOTCNQ + ANDI 0,177 + CAIG 0,40 ; SPACE? + JRST NDFLD ; YES, TERMINATE THIS FIELD + CAIN 0,": ; DEVICE ENDED? + JRST GOTDEV + CAIN 0,"; ; SNAME ENDED + JRST GOTSNM + +GOTCNQ: ANDI 0,177 + PUSHJ P,A0TO6 ; CONVERT TO 6BIT AND CHECK + + JUMPE B,FPARSL ; IGNORE IF AREADY HAVE 6 + IDPB 0,C + SOJA B,FPARSL + +; HERE IF SPACE ENCOUNTERED + +NDFLD: MOVEI D,(E) ; COPY GOODIE + PUSHJ P,FLSSP ; FLUSH REDUNDANT SPACES + JUMPE 0,PARSD ; NO CHARS LEFT + +NFL0: PUSH P,A ; SAVE SIXBIT WORD + SKIPGE -1(P) ; SKIP IF STRING TO BE STORED + JRST NFL1 + PUSH TP,$TAB ; PREVENT AB LOSSAGE + PUSH TP,AB + PUSHJ P,6TOCHS ; CONVERT TO STRING + MOVE AB,(TP) + SUB TP,[2,,2] +NFL1: HRRZ 0,-1(TP) ; RESTORE CHAR COUNT + +NFL2: MOVEI C,(D) ; COPY REL PNTR + SKIPGE -1(P) ; SKIP IF STRINGS TO BE STORED + JRST NFL3 + ASH D,1 ; TIMES 2 + ADDI D,T.NM1(TB) + MOVEM A,(D) ; STORE + MOVEM B,1(D) +NFL3: MOVSI A,N1SET ; FLAG IT + LSH A,(C) + IORM A,-1(P) ; AND CLOBBER + MOVE D,T.SPDL+1(TB) ; GET P BASE + POP P,@SIXTBL(C) ; AND STORE SIXBIT OF IT + + POP TP,-2(TP) ; MAKE NEW STRING POINTER + POP TP,-2(TP) + JUMPE 0,.+3 ; SKIP IF NO MORE CHARS + AOBJN E,FPARS ; MORE TO PARSE? +CPOPJ: POPJ P, ; RETURN, ALL DONE + + SUB TP,[2,,2] ; FLUSH OLD STRING + ADD E,[1,,1] + ADD AB,[2,,2] ; BUMP ARG + JUMPL AB,RPARGL ; AND GO ON +CPOPJ1: AOS A,(P) ; PREPARE TO WIN + HLRZS A + POPJ P, + + + +; HERE IF STRING HAS ENDED + +PARSD: PUSH P,A ; SAVE 6 BIT + MOVE A,-3(TP) ; CAN USE ARG STRING + MOVE B,-2(TP) + MOVEI D,(E) + JRST NFL2 ; AND CONTINUE + +; HERE IF JUST READ DEV + +GOTDEV: MOVEI D,2 ; CODE FOR DEVICE + JRST GOTFLD ; GOT A FIELD + +; HERE IF JUST READ SNAME + +GOTSNM: MOVEI D,3 +GOTFLD: PUSHJ P,FLSSP + SOJA E,NFL0 + + +; HERE FOR NON STRING ARG ENCOUNTERED + +ARGCLB: SKIPGE (P) ; IF NOT STORING, CONSIDER THIS THE END + + POPJ P, + MOVE C,T.SPDL+1(TB) ; GET P-BASE + MOVE A,S.DEV(C) ; GET DEVICE + CAME A,[SIXBIT /INT /]; IS IT THE INTERNAL DEVICE + JRST TRYNET ; NO, COUD BE NET + MOVE A,0 ; OFFNEDING TYPE TO A + PUSHJ P,APLQ ; IS IT APPLICABLE + JRST NAPT ; NO, LOSE + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] ; MUST BE LAST ARG + JUMPL AB,TMA + JRST CPOPJ1 ; ELSE SUCCESSFUL RETURN +TRYNET: CAIE 0,TFIX ; FOR NET DEV, ARGS MUST BE FIX + JRST WRONGT ; TREAT AS WRONG TYPE + MOVSI A,MSTNET ; BETTER BE NET EVENTUALLY + IORM A,(P) ; STORE FLAGS + MOVSI A,TFIX + MOVE B,1(AB) ; GET NUMBER + MOVEI 0,(E) ; MAKE SURE NOT DEVICE + CAIN 0,2 + JRST WRONGT + PUSH P,B ; SAVE NUMBER + MOVEI D,(E) ; SET FOR TABLE OFFSETS + MOVEI 0,0 + ADD TP,[4,,4] + JRST NFL2 ; GO CLOBBER IT AWAY +] + + +; ROUTINE TO FLUSH LEADING SPACES FROM A FIELD + +FLSSP: HRRZ 0,-1(TP) ; GET CHR COUNNT + JUMPE 0,CPOPJ ; FINISHED STRING +FLSS1: MOVE B,(TP) ; GET BYTR + ILDB C,B ; GETCHAR + CAIE C,^Q ; DONT FLUSH CNTL-Q + CAILE C,40 + JRST FLSS2 + MOVEM B,(TP) ; UPDATE BYTE POINTER + SOJN 0,FLSS1 + +FLSS2: HRRM 0,-1(TP) ; UPDATE STRING + POPJ P, + +IFN ITS,[ +;TABLE FOR STFUFFING SIXBITS AWAY + +SIXTBL: SETZ S.NM1(D) + SETZ S.NM2(D) + SETZ S.DEV(D) + SETZ S.SNM(D) + SETZ S.X1(D) +] + +RDTBL: SETZ RDEVIC(B) + SETZ RNAME1(B) + SETZ RNAME2(B) + SETZ RSNAME(B) + + + +IFE ITS,[ + +; TENEX VERSION OF FILE NAME PARSER (ONLY ACCEPT ARGS IN SINGLE STRING) + + +RGPRS: MOVEI 0,NOSTOR + +RGPARS: HRLM 0,(P) ; SAVE FOR STORE CHECKING + CAMGE AB,[-2,,] ; MULTI-STRING CASE POSSIBLE? + JRST TN.MLT ; YES, GO PROCESS +RGPRSS: GETYP 0,(AB) ; CHECK ARG TYPE + CAIE 0,TCHSTR + JRST WRONGT ; FOR NOW ONLY STRING ARGS WIN + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,FLSSP ; FLUSH LEADING SPACES + PUSHJ P,RGPRS1 + ADD AB,[2,,2] +CHKLST: JUMPGE AB,CPOPJ1 + SKIPGE (P) ; IF FROM OPEN, ALLOW ONE MORE + POPJ P, + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] + JUMPL AB,TMA +CPOPJ1: AOS (P) + POPJ P, + +RGPRS1: PUSH P,[0] ; ALLOW A DEVICE SPEC +TN.SNM: MOVE A,(TP) + HRRZ 0,-1(TP) + JUMPE 0,RPDONE + ILDB A,A + CAIE A,"< ; START "DIRECTORY" ? + JRST TN.N1 ; NO LOOK FOR NAME1 + SETOM (P) ; DEV NOT ALLOWED + IBP (TP) ; SKIP CHAR + SOS -1(TP) + PUSHJ P,TN.CNT ; COUNT CHARS TO ">" OR "." + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN3 + PUSH TP,0 + PUSH TP,C +TN.SN1: PUSHJ P,TN.CNT ; COUNT CHARS TO ">" + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN2 + MOVEM 0,-1(TP) + MOVEM C,(TP) + JRST TN.SN1 +TN.SN2: HRRZ B,-3(TP) + SUB B,0 + SUBI B,1 + SUB TP,[2,,2] +TN.SN3: CAIE A,"> ; SKIP IF WINS + JRST ILLNAM + PUSHJ P,TN.CPS ; COPY TO NEW STRING + HLLOS T.SPDL(TB) + MOVEM A,T.SNM(TB) + MOVEM B,T.SNM+1(TB) + +TN.N1: PUSHJ P,TN.CNT + JUMPE B,RPDONE + CAIE A,": ; GOT A DEVICE + JRST TN.N11 + SKIPE (P) + JRST ILLNAM + SETOM (P) + PUSHJ P,TN.CPS + MOVEM A,T.DEV(TB) + MOVEM B,T.DEV+1(TB) + JRST TN.SNM ; NOW LOOK FOR SNAME + +TN.N11: CAIE A,"> + CAIN A,"< + JRST ILLNAM + MOVEM A,(P) ; SAVE END CHAR + PUSHJ P,TN.CPS ; GEN STRING + MOVEM A,T.NM1(TB) + MOVEM B,T.NM1+1(TB) + +TN.N2: SKIPN A,(P) ; GET CHAR BACK + JRST RPDONE + CAIN A,"; ; START VERSION? + JRST .+3 + CAIE A,". ; START NAME2? + JRST ILLNAM ; I GIVE UP!!! + HRRZ B,-1(TP) ; GET RMAINS OF STRING + PUSHJ P,TN.CPS ; AND COPY IT + MOVEM A,T.NM2(TB) + MOVEM B,T.NM2+1(TB) +RPDONE: SUB P,[1,,1] ; FLUSH TEMP + SUB TP,[2,,2] +CPOPJ: POPJ P, + +TN.CNT: HRRZ 0,-1(TP) ; CHAR COUNT + MOVE C,(TP) ; BPTR + MOVEI B,0 ; INIT COUNT TO 0 + +TN.CN1: MOVEI A,0 ; IN CASE RUN OUT + SOJL 0,CPOPJ ; RUN OUT? + ILDB A,C ; TRY ONE + CAIE A," ; TNEX FILE QUOTE? + JRST TN.CN2 + SOJL 0,CPOPJ + IBP C ; SKIP QUOTED CHAT + ADDI B,2 + JRST TN.CN1 + +TN.CN2: CAIE A,"< + CAIN A,"> + POPJ P, + + CAIE A,". + CAIN A,"; + POPJ P, + CAIN A,": + POPJ P, + AOJA B,TN.CN1 + +TN.CPS: PUSH P,B ; # OF CHARS + MOVEI A,4(B) ; ADD 4 TO B IN A + IDIVI A,5 + PUSHJ P,IBLOCK ; GET BLOCK OF WORDS FOR STRING + + POP P,C ; CHAR COUNT BACK + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + HRRI A,(C) ; CHAR STRING + MOVE D,B ; COPY BYTER + + JUMPE C,CPOPJ + ILDB 0,(TP) ; GET CHAR + IDPB 0,D ; AND STROE + SOJG C,.-2 + + MOVNI C,(A) ; - LENGTH TO C + ADDB C,-1(TP) ; DECREMENT WORDS COUNT + TRNN C,-1 ; SKIP IF EMPTY + POPJ P, + IBP (TP) + SOS -1(TP) ; ELSE FLUSH TERMINATOR + POPJ P, + +ILLNAM: ERRUUO EQUOTE ILLEGAL-TENEX-FILE-NAME + +TN.MLT: MOVE A,AB ; AOBJN POINTER TO ARGS IN A + +TN.ML1: GETYP 0,(A) ; IS THIS ARG OF RIGHT TYPE + CAIE 0,TFIX + CAIN 0,TCHSTR + JRST .+2 + JRST RGPRSS ; ASSUME SINGLE STRING + ADD A,[2,,2] + JUMPL A,TN.ML1 ; TRY NEXT ARG IF ANY LEFT + + MOVEI 0,T.NM1(TB) ; 1ST WORD OF DESTINATION + HLRO A,AB ; MINUS NUMBER OF ARGS IN A + MOVN A,A ; NUMBER OF ARGS IN A + SUBI A,1 + CAMGE AB,[-10,,0] + MOVEI A,7 ; IF MORE THAN 10 ARGS, PUT 7 + ADD A,0 ; LAST WORD OF DESTINATION + HRLI 0,(AB) + BLT 0,(A) ; BLT 'EM IN + ADD AB,[10,,10] ; SKIP THESE GUYS + JRST CHKLST + +] + + +; ROUTINE TO OPEN A CHANNEL FOR ANY DEVICE. NAMES ARE ASSUMED TO ALREADY +; BE ON BOTH TP STACK AND P STACK + +OPNCH: MOVE C,T.SPDL+1(TB) ; GET PDL BASE + HRRZ A,S.DIR(C) + ANDI A,1 ; JUST WANT I AND O +IFE ITS,[ + HRLM A,S.DEV(C) +; .TRANS S.DEV(C) ; UNDO ANY TRANSLATIONS +; JRST TRLOST ; COMPLAIN +] +IFN ITS,[ + HRLM A,S.DIR(C) +] + +IFN ITS,[ + MOVE A,S.DEV(C) ; GET SIXBIT DEVICE CODE +] + +IFE ITS,[HRLZS A,S.DEV(C) +] + + MOVSI B,-NDEVS ; AOBJN COUNTER +DEVLP: SETO D, + MOVE 0,DEVSTB(B) ; GET ONE FROM TABLE + MOVE E,A +DEVLP1: AND E,D ; FLUSH POSSIBLE DIGITNESS + CAMN 0,E + JRST CHDIGS ; MAKE SURE REST IS DIGITS + LSH D,6 + JUMPN D,DEVLP1 ; KEEP TRUCKING UNTIL DONE + +; WASN'T THAT DEVICE, MOVE TO NEXT +NXTDEV: AOBJN B,DEVLP + JRST ODSK ; UNKNOWN DEVICE IS ASSUMED TO BE DISK + +IFN ITS,[ +OUSR: HRRZ A,S.DIR(C) ; BLOCK OR UNIT? + TRNE A,2 ; SKIP IF UNIT + JRST ODSK + PUSHJ P,OPEN1 ; OPEN IT + PUSHJ P,FIXREA ; AND READCHST IT + MOVE B,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVE 0,[PUSHJ P,DOIOT] ; GET AN IOINS + MOVEM 0,IOINS(B) + MOVE C,T.SPDL+1(TB) + HRRZ A,S.DIR(C) + TRNN A,1 + JRST EOFMAK + MOVEI 0,80. + MOVEM 0,LINLN(B) + JRST OPNWIN + +OSTY: HLRZ A,S.DIR(C) + IORI A,10 ; THE DONT LOSE BIT (DONT HANG ON INPUT DO ON OUTPUT) + HRLM A,S.DIR(C) + JRST OUSR +] + +; MAKE SURE DIGITS EXIST + +CHDIGS: SETCA D, + JUMPE D,DISPA ; NO DIGITS, WIN IMMEDIATE + MOVE E,A + AND E,D ; LEAVES ONLY DIGITS, IF WINNING + LSH E,6 + LSH D,6 + JUMPG D,.-2 ; KEEP GOING TIL DIGITS LEFT SHIFTED + JRST CHDIGN + +CHDIG1: CAIG D,'9 + CAIGE D,'0 + JRST NXTDEV ; NOT A DIGIT, LOSE + JUMPE E,DISPA ; IF THAT'S ALL THE CHARACTERS, WIN! +CHDIGN: SETZ D, + ROTC D,6 ; GET NEXT CHARACTER INTO D + JRST CHDIG1 ; GO TEST? + +; HERE TO DISPATCH IF SUCCESSFUL + +DISPA: JRST @DEVS(B) + + +IFN ITS,[ + +; DISK DEVICE OPNER COME HERE + +ODSK: MOVE A,S.SNM(C) ; GET SNAME + .SUSET [.SSNAM,,A] ; CLOBBER IT + PUSHJ P,OPEN0 ; DO REAL LIVE OPEN +] +IFE ITS,[ + +; TENEX DISK FILE OPENER + +ODSK: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + PUSHJ P,STSTK ; EXPAND STRING ONTO STACK (E POINTS TO OLD P) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; GET DIR NAME + MOVE C,(P) + MOVE D,T.SPDL+1(TB) + HRRZ D,S.DIR(D) + CAME C,[SIXBIT /PRINAO/] + CAMN C,[SIXBIT /PRINTO/] + IORI D,100 ; TURN ON BIT TO SAY USE OLD FILE + MOVSI A,101 ; START SETTING UP BITS EXTRA BIT FOR MSB + TRNE D,1 ; SKIP IF INPUT + TRNE D,100 ; WITE OVER? + TLOA A,100000 ; FORCE OLD VERSION + TLO A,600000 ; FORCE NEW VERSION + HRROI B,1(E) ; POINT TO STRING + GTJFN + TDZA 0,0 ; SAVE FACT OF NO SKIP + MOVEI 0,1 ; INDICATE SKIPPED + POP P,C ; RECOVER OPEN MODE SIXBIT + MOVE P,E ; RESTORE PSTACK + JUMPE 0,GTJLOS ; FIND OUT WHAT HAPPENED + + MOVE B,T.CHAN+1(TB) ; GET CHANNEL + HRRZ 0,-4(B) ; FUNNY MODE BITS + HRRZM A,CHANNO(B) ; SAVE IT + ANDI A,-1 ; READ Y TO DO OPEN + MOVSI B,440000 ; USE 36. BIT BYES + HRRI B,200000 ; ASSUME READ +; CAMN C,[SIXBIT /READB/] +; TRO B,2000 ; TURN ON THAWED IF READB + IOR B,0 + TRNE D,1 ; SKIP IF READ + HRRI B,300000 ; WRITE BIT + HRRZ 0,FSAV(TB) ; SEE IF REF DATE HACK + CAIN 0,NFOPEN + TRO B,400 ; SET DON'T MUNG REF DATE BIT + MOVE E,B ; SAVE BITS FOR REOPENS + OPENF + JRST OPFLOS + MOVE B,[2,,11] ; GET LENGTH & BYTE SIZE + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + GTFDB + LDB 0,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + CAIN 0,7 + JRST SIZASC + CAIN 0,36. + SIZEF ; USE OPENED SIZE + JFCL + IMULI B,5 ; TO BYTES +SIZASC: MOVEI 0,C.OPN+C.READ+C.DISK + TRNE D,1 ; SKIP FOR READ + MOVEI 0,C.OPN+C.PRIN+C.DISK + TRNE D,2 ; SKIP IF NOT BINARY FILE + TRO 0,C.BIN + HRL 0,B + MOVE B,T.CHAN+1(TB) + TRNE D,1 + HLRM 0,LSTCH-1(B) ; SAVE CURRENT LENGTH + MOVEM E,STATUS(B) + HRRM 0,-2(B) ; MUNG THOSE BITS + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + PUSHJ P,TMTNXS ; GET STRING FROM TENEX + MOVE B,CHANNO(B) ; JFN TO A + HRROI A,1(E) ; BASE OF STRING + MOVE C,[111111,,140001] ; WEIRD CONTROL BITS + JFNS ; GET STRING + MOVEI B,1(E) ; POINT TO START OF STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; MAKE INTO A STRING + SUB P,E ; BACK TO NORMAL + PUSH TP,A + PUSH TP,B + PUSHJ P,RGPRS1 ; PARSE INTO FIELDS + MOVE B,T.CHAN+1(TB) + MOVEI C,RNAME1-1(B) + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + JRST OPBASC +OPFLOS: MOVEI C,(A) ; SAVE ERROR CODE + MOVE B,T.CHAN+1(TB) + HRRZ A,CHANNO(B) ; JFN BACK TO A + RLJFN ; TRY TO RELEASE IT + JFCL + MOVEI A,(C) ; ERROR CODE BACK TO A + +GTJLOS: MOVE B,T.CHAN+1(TB) + PUSHJ P,TGFALS ; GET A FALSE WITH REASON + JRST OPNRET + +STSTK: PUSH TP,$TCHAN + PUSH TP,B + MOVEI A,4+5 ; COUNT CHARS NEEDED (NEED LAST 0 BYTE) + MOVE B,(TP) + ADD A,RDEVIC-1(B) + ADD A,RNAME1-1(B) + ADD A,RNAME2-1(B) + ADD A,RSNAME-1(B) + ANDI A,-1 ; TO 18 BITS + MOVEI 0,A(A) + IDIVI A,5 ; TO WORDS NEEDED + POP P,C ; SAVE RET ADDR + MOVE E,P ; SAVE POINTER + PUSH P,[0] ; ALOCATE SLOTS + SOJG A,.-1 + PUSH P,C ; RET ADDR BACK + INTGO ; IN CASE OVERFLEW + PUSH P,0 + MOVE B,(TP) ; IN CASE GC'D + MOVE D,[440700,,1(E)] ; BYTE POINTER TO IT + MOVEI A,RDEVIC-1(B) + PUSHJ P,MOVSTR ; FLUSH IT ON + HRRZ A,T.SPDL(TB) + JUMPN A,NLNMS ; USER GAVE NAME, USE IT (CAREFUL, RELIES ON + ; A BEING NON ZERO) + PUSH P,B + PUSH P,C + MOVEI A,0 ; HERE TO SEE IF THIS IS REALLY L.N. + HRROI B,1(E) + HRROI C,1(P) + LNMST ; LOOK UP LOGICAL NAME + MOVNI A,1 ; NOT A LOGICAL NAME + POP P,C + POP P,B +NLNMS: MOVEI 0,": + IDPB 0,D + JUMPE A,ST.NM1 ; LOGICAL NAME, FLUSH SNAME + HRRZ A,RSNAME-1(B) ; ANY SNAME AT ALL? + JUMPE A,ST.NM1 ; NOPE, CANT HACK WITH IT + MOVEI A,"< + IDPB A,D + MOVEI A,RSNAME-1(B) + PUSHJ P,MOVSTR ; SNAME UP + MOVEI A,"> + IDPB A,D +ST.NM1: MOVEI A,RNAME1-1(B) + PUSHJ P,MOVSTR + MOVEI A,". + IDPB A,D + MOVEI A,RNAME2-1(B) + PUSHJ P,MOVSTR + SUB TP,[2,,2] + POP P,A + POPJ P, + +MOVSTR: HRRZ 0,(A) ; CHAR COUNT + MOVE A,1(A) ; BYTE POINTER + SOJL 0,CPOPJ + ILDB C,A ; GET CHAR + IDPB C,D ; MUNG IT UP + JRST .-3 + +; MAKE A TENEX ERROR MESSAGE STRING + +TGFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; SAVE ERROR CODE + PUSHJ P,TMTNXS ; STRING ON STACK + HRROI A,1(E) ; POINT TO SPACE + MOVE B,(E) ; ERROR CODE + HRLI B,400000 ; FOR ME + MOVSI C,-100. ; MAX CHARS + ERSTR ; GET TENEX STRING + JRST TGFLS1 + JRST TGFLS1 + + MOVEI B,1(E) ; A AND B BOUND STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; BUILD STRING + SUB P,E ; P BACK TO NORMAL +TGFLS2: +IFE FNAMS, SUB P,[1,,1] ; FLUSH ERROR CODE SLOT +IFN FNAMS,[ + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST TGFLS3 + PUSHJ P,STSTK + MOVEI B,1(E) + SUBM P,E + MOVSI A,440700 + HRRI A,(P) + MOVEI C,5 + ILDB 0,A + JUMPE 0,.+2 + SOJG C,.-2 + + PUSHJ P,TNXSTR + PUSH TP,A + PUSH TP,B + SUB P,E +TGFLS3: POP P,A + PUSH TP,$TFIX + PUSH TP,A + MOVEI A,3 + SKIPN B + MOVEI A,2 +] +IFE FNAMS,[ + MOVEI A,1 +] + PUSHJ P,IILIST ; BUILD LIST + MOVSI A,TFALSE ; MAKE IT FALSE + SUB TP,[2,,2] + POPJ P, + +TGFLS1: MOVE P,E ; RESET STACK + MOVE A,$TCHSTR + MOVE B,CHQUOTE UNKNOWN PROBLEM IN I/O + JRST TGFLS2 + +] +; OTHER BUFFERED DEVICES JOIN HERE + +OPDSK1: +IFN ITS,[ + PUSHJ P,FIXREA ; STORE THE "REAL" NAMES INTO THE CHANNEL +] +OPBASC: MOVE C,T.SPDL+1(TB) ; C WAS CLOBBERED, GET IT BACK + HRRZ A,S.DIR(C) ; FIND OUT IF OPEN IS ASCII OR WORD + TRZN A,2 ; SKIP IF BINARY + PUSHJ P,OPASCI ; DO IT FOR ASCII + +; NOW SET UP IO INSTRUCTION FOR CHANNEL + +MAKION: MOVE B,T.CHAN+1(TB) + MOVEI C,GETCHR + JUMPE A,MAKIO1 ; JUMP IF INPUT + MOVEI C,PUTCHR ; ELSE GET INPUT + MOVEI 0,80. ; DEFAULT LINE LNTH + MOVEM 0,LINLN(B) + MOVSI 0,TFIX + MOVEM 0,LINLN-1(B) +MAKIO1: + HRLI C,(PUSHJ P,) + MOVEM C,IOINS(B) ; STORE IT + JUMPN A,OPNWIN ; GET AN EOF FORM FOR INPUT CHANNEL + +; HERE TO CONS UP + +EOFMAK: MOVSI C,TATOM + MOVE D,EQUOTE END-OF-FILE + PUSHJ P,INCONS + MOVEI E,(B) + MOVSI C,TATOM + MOVE D,IMQUOTE ERROR + PUSHJ P,ICONS + MOVE D,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVSI 0,TFORM + MOVEM 0,EOFCND-1(D) + MOVEM B,EOFCND(D) + +OPNWIN: MOVEI 0,10. ; SET UP RADIX + MOVSI A,TCHAN ; OPEN SUCCEEDED, RET CHANNEL + MOVE B,T.CHAN+1(TB) + MOVEM 0,RADX(B) + +OPNRET: MOVE D,T.CHAN+1(TB) ; IN CASE WE RECYCLE IT + MOVE C,(P) ; RET ADDR + SUB P,[S.X3+2,,S.X3+2] + SUB TP,[T.CHAN+2,,T.CHAN+2] + JRST (C) + + +; HERE TO CREATE CHARACTER BUFFERS FOR ASCII I/O + +OPASCI: PUSH P,A ; CONTAINS MODE, SAVE IT + MOVEI A,BUFLNT ; GET SIZE OF BUFFER + PUSHJ P,IBLOCK ; GET STORAGE + MOVSI 0,TWORD+.VECT. ; SET UTYPE + MOVEM 0,BUFLNT(B) ; AND STORE + MOVSI A,TCHSTR + SKIPE (P) ; SKIP IF INPUT + JRST OPASCO + MOVEI D,BUFLNT-1(B) ; REST BYTE POINTER +OPASCA: HRLI D,010700 + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEI 0,C.BUF + IORM 0,-2(B) ; TURN ON BUFFER BIT + MOVEM A,BUFSTR-1(B) + MOVEM D,BUFSTR(B) ; CLOBBER + POP P,A + POPJ P, + +OPASCO: HRROI C,777776 + MOVEM C,(B) ; -1 THE BUFFER (LEAVE OFF LOW BIT) + MOVSI C,(B) + HRRI C,1(B) ; BUILD BLT POINTER + BLT C,BUFLNT-1(B) ; ZAP + MOVEI D,-1(B) ; START MAKING STRING POINTER + HRRI A,BUFLNT*5 ; SET UP CHAR COUNT + JRST OPASCA + + +; OPEN NON FILE ORIENTED DEVICES (NUL, PTR, PTP ETC.) + +IFN ITS,[ +ONUL: +OPTP: +OPTR: PUSHJ P,OPEN0 ; SET UP MODE AND OPEN + SETZM S.NM1(C) ; CLOBBER UNINTERESTING FIELDS + SETZM S.NM2(C) + SETZM S.SNM(C) + JRST OPDSK1 + +; OPEN DEVICES THAT IGNORE SNAME + +OUTN: PUSHJ P,OPEN0 + SETZM S.SNM(C) + JRST OPDSK1 + +] + +; INTERNAL CHANNEL OPENER + +OINT: HRRZ A,S.DIR(C) ; CHECK DIR + CAIL A,2 ; READ/PRINT? + JRST WRONGD ; NO, LOSE + + MOVE 0,INTINS(A) ; GET INS + MOVE D,T.CHAN+1(TB) ; AND CHANNEL + MOVEM 0,IOINS(D) ; AND CLOBBER + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + HRRM 0,-2(D) + SETOM STATUS(D) ; MAKE SURE NOT AA TTY + PMOVEM T.XT(TB),INTFCN-1(D) + +; HERE TO SAVE PSEUDO CHANNELS + +SAVCHN: HRRZ E,CHNL0+1 ; POINT TO CURRENT LIST + MOVSI C,TCHAN + PUSHJ P,ICONS ; CONS IT ON + HRRZM B,CHNL0+1 + JRST OPNWIN + +; INT DEVICE I/O INS + +INTINS: PUSHJ P,GTINTC + PUSHJ P,PTINTC + + +; HERE TO OPEN THE NET DEVICE (I.E. THE ARPA NET) + +IFN ITS,[ +ONET: HRRZ A,S.DIR(C) ; DIRECTION CODE + CAILE A,1 ; ASCII ? + IORI A,4 ; TURN ON IMAGE BIT + SKIPGE S.NM1(C) ; NAME1 I.E. LOCAL HOST GIVEN + IORI A,10 ; NO, WE WILL LET ITS GIVE US ONE + SKIPGE S.NM2(C) ; NORMAL OR "LISTEN" + IORI A,20 ; TURN ON LISTEN BIT + MOVEI 0,7 ; DEFAULT BYTE SIZE + TRNE A,2 ; UNLESS + MOVEI 0,36. ; IMAGE WHICH IS 36 + SKIPN T.XT(TB) ; BYTE SIZE GIVEN? + MOVEM 0,S.X1(C) ; NO, STORE DEFAULT + SKIPG D,S.X1(C) ; BYTE SIZE REASONABLE? + JRST RBYTSZ ; NO <0, COMPLAIN + TRNE A,2 ; SKIP TO CHECK ASCII + JRST ONET2 ; CHECK IMAGE + CAIN D,7 ; 7-BIT WINS + JRST ONET1 + CAIE D,44 ; 36-BIT INDICATES BLOCK ASCII MODE + JRST .+3 + IORI A,2 ; SET BLOCK FLAG + JRST ONET1 + IORI A,40 ; USE 8-BIT MODE + CAIN D,10 ; IS IT RIGHT + JRST ONET1 ; YES +] + +RBYTSZ: ERRUUO EQUOTE BYTE-SIZE-BAD + +IFN ITS,[ +ONET2: CAILE D,36. ; IMAGE SIZE REASONABLE? + JRST RBYTSZ ; NO + CAIN D,36. ; NORMAL + JRST ONET1 ; YES, DONT SET FIELD + + ASH D,9. ; POSITION FOR FIELD + IORI A,40(D) ; SET IT AND ITS BIT + +ONET1: HRLM A,S.DIR(C) ; CLOBBER OPEN BLOCK + MOVE E,A ; SAVE BLOCK MODE INFO + PUSHJ P,OPEN1 ; DO THE OPEN + PUSH P,E + +; CLOBBER REAL SLOTS FOR THE OPEN + + MOVEI A,3 ; GET STATE VECTOR + PUSHJ P,IBLOCK + MOVSI A,TUVEC + MOVE D,T.CHAN+1(TB) + HLLM A,BUFRIN-1(D) + MOVEM B,BUFRIN(D) + MOVSI A,TFIX+.VECT. ; SET U TYPE + MOVEM A,3(B) + MOVE C,T.SPDL+1(TB) + MOVE B,T.CHAN+1(TB) + + PUSHJ P,INETST ; GET STATE + + POP P,A ; IS THIS BLOCK MODE + MOVEI 0,80. ; POSSIBLE LINE LENGTH + TRNE A,1 ; SKIP IF INPUT + MOVEM 0,LINLN(B) + TRNN A,2 ; BLOCK MODE? + JRST .+3 + TRNN A,4 ; ASCII MODE? + JRST OPBASC ; GO SETUP BLOCK ASCII + MOVE 0,[PUSHJ P,DOIOT] + MOVEM 0,IOINS(B) + + JRST OPNWIN + +; INTERNAL ROUTINE TO GET THE CURRENT STATE OF THE NETWROK CHANNEL + +INETST: MOVE A,S.NM1(C) + MOVEM A,RNAME1(B) + MOVE A,S.NM2(C) + MOVEM A,RNAME2(B) + LDB A,[1100,,S.SNM(C)] + MOVEM A,RSNAME(B) + + MOVE E,BUFRIN(B) ; GET STATE BLOCK +INTST1: HRRE 0,S.X1(C) + MOVEM 0,(E) + ADDI C,1 + AOBJN E,INTST1 + + POPJ P, + + +; ACCEPT A CONNECTION + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET ; CHECK THAT ARG IS AN OPEN NET CHANNEL + MOVE A,CHANNO(B) ; GET CHANNEL + LSH A,23. ; TO AC FIELD + IOR A,[.NETACC] + XCT A + JRST IFALSE ; RETURN FALSE +NETRET: MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +; FORCE SYSTEM NETWORK BUFFERS TO BE SENT + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 + CAMN A,MODES+3 + SKIPA A,CHANNO(B) ; GET CHANNEL + JRST WRONGD + LSH A,23. + IOR A,[.NETS] + XCT A + JRST NETRET + +; SUBR TO RETURN UPDATED NET STATE + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET ; IS IT A NET CHANNEL + PUSHJ P,INSTAT + JRST FINIS + +; INTERNAL NETSTATE ROUTINE + +INSTAT: MOVE C,P ; GET PDL BASE + MOVEI 0,S.X3 ; # OF SLOTS NEEDED + PUSH P,[0] + SOJN 0,.-1 +; RESTORED FROM MUDDLE 54. IT SEEMED TO WORK THERE, AND THE STUFF +; COMMENTED OUT HERE CERTAINLY DOESN'T. + MOVEI D,S.DEV(C) + HRL D,CHANNO(B) + .RCHST D, +; HRR D,CHANNO(B) ; SETUP FOR RFNAME CALL +; DOTCAL RFNAME,[D,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] +; .LOSE %LSFIL ; THIS MAY NOT BE DESIRABLE, BUT I ASSUME WE CARE IF + ; LOSSAGE + PUSHJ P,INETST ; INTO VECTOR + SUB P,[S.X3,,S.X3] + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + POPJ P, +] +; INTERNAL ROUTINE TO CHECK FOR CORRECT CHANNEL TYPE + +ARGNET: ENTRY 1 + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; OPEN? + JRST CHNCLS + MOVE A,RDEVIC-1(B) ; GET DEV NAME + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 + POP P,A + CAME A,[SIXBIT /NET /] + JRST NOTNET + MOVE B,1(AB) + MOVE A,DIRECT-1(B) ; CHECK FOR A READ SOCKET + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 + MOVE B,1(AB) ; RESTORE CHANNEL + POP P,A + POPJ P, + +IFE ITS,[ + +; TENEX NETWRK OPENING CODE + +ONET: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + MOVSI C,100700 + HRRI C,1(P) + MOVE E,P + PUSH P,[ASCII /NET:/] ; FOR STRINGS + GETYP 0,RNAME1-1(B) ; CHECK TYPE + CAIE 0,TFIX ; SKIP IF # SUPPLIED + JRST ONET1 + MOVE 0,RNAME1(B) ; GET IT + PUSHJ P,FIXSTK + JFCL + JRST ONET2 +ONET1: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME1-1(B) + MOVE B,RNAME1(B) + JUMPE 0,ONET2 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 +ONET2: MOVEI A,". + JSP D,ONETCH + MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIE 0,TFIX + JRST ONET3 + GETYP 0,RSNAME-1(B) + CAIE 0,TFIX + JRST WRONGT + MOVE 0,RSNAME(B) + CAIG 0,377 ;NEW STYLE 32 BIT HOST NUMBER? + JRST ONET2A +;CONVERT HOSTS2 HOST NUMBERS TO INTERNET (TOPS-20) HOST NUMBERS + MOVEI A,0 + LDB B,[001100,,0] ;HOST NUMBER: 1.1-1.9 -> + DPB B,[201000,,A] ; 2.8-3.6 + LDB B,[111100,,0] ;IMP LOW BITS: 2.1-2.9 -> + DPB B,[001000,,A] ; 1.1-1.8 + LDB B,[221100,,0] ;IMP HIGH BITS: 3.1-3.9 -> + DPB B,[101000,,A] ; 1.9-2.7 + LDB B,[331100,,0] ;NETWORK: 4.1-4.9 -> + DPB B,[301000,,A] ; 3.7-4.5 + MOVE 0,A +ONET2A: PUSHJ P,FIXSTK + JRST ONET4 + MOVE B,T.CHAN+1(TB) + MOVEI A,"- + JSP D,ONETCH + MOVE 0,RNAME2(B) + PUSHJ P,FIXSTK + JRST WRONGT + JRST ONET4 +ONET3: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME2-1(B) + MOVE B,RNAME2(B) + JUMPE 0,ONET4 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 + +ONET4: +ONET5: MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIN 0,TCHSTR + JRST ONET6 + MOVEI A,"; + JSP D,ONETCH + MOVEI A,"T + JSP D,ONETCH +ONET6: MOVSI A,1 + HRROI B,1(E) ; STRING POINTER + GTJFN ; GET THE G.D JFN + TDZA 0,0 ; REMEMBER FAILURE + MOVEI 0,1 + MOVE P,E ; RESTORE P + JUMPE 0,GTJLOS ; CONS UP ERROR STRING + + MOVE B,T.CHAN+1(TB) + HRRZM A,CHANNO(B) ; SAVE THE JFN + + MOVE C,T.SPDL+1(TB) + MOVE D,S.DIR(C) + MOVEI B,10 + TRNE D,2 + MOVEI B,36. + SKIPE T.XT(TB) + MOVE B,T.XT+1(TB) + JUMPL B,RBYTSZ + CAILE B,36. + JRST RBYTSZ + ROT B,-6 + TLO B,3400 + HRRI B,200000 + TRNE D,1 ; SKIP FOR INPUT + HRRI B,100000 + ANDI A,-1 ; ISOLATE JFCN + OPENF + JRST OPFLOS ; REPORT ERROR + MOVE B,T.CHAN+1(TB) + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) + CVSKT ; GET ABS SOCKET # + FATAL NETWORK BITES THE BAG! + MOVE D,B + MOVE B,T.CHAN+1(TB) + MOVEM D,RNAME1(B) + MOVSI 0,TFIX + MOVEM 0,RNAME1-1(B) + + MOVSI 0,TFIX + MOVEM 0,RNAME2-1(B) + MOVEM 0,RSNAME-1(B) + MOVE C,T.SPDL+1(TB) + MOVE C,S.DIR(C) + MOVE 0,[PUSHJ P,DONETO] + TRNN C,1 ; SKIP FOR OUTPUT + MOVE 0,[PUSHJ P,DONETI] + MOVEM 0,IOINS(B) + MOVEI 0,80. ; LINELENGTH + TRNE C,1 ; SKIP FOR INPUT + MOVEM 0,LINLN(B) + MOVEI A,3 ; GET STATE UVECTOR + PUSHJ P,IBLOCK + MOVSI 0,TFIX+.VECT. + MOVEM 0,3(B) + MOVE C,B + MOVE B,T.CHAN+1(TB) + MOVEM C,BUFRIN(B) + MOVSI 0,TUVEC + HLLM 0,BUFRIN-1(B) + MOVE A,CHANNO(B) ; GET JFN + GDSTS ; GET STATE + MOVE E,T.CHAN+1(TB) + MOVEM D,RNAME2(E) + MOVEM C,RSNAME(E) + MOVE C,BUFRIN(E) + MOVEM B,(C) ; INITIAL STATE STORED + MOVE B,E + JRST OPNWIN + +; DOIOT FOR TENEX NETWRK + +DONETO: PUSH P,0 + MOVE 0,[BOUT] + JRST .+3 + +DONETI: PUSH P,0 + MOVE 0,[BIN] + PUSH P,0 + PUSH TP,$TCHAN + PUSH TP,B + MOVEI 0,(A) ; POSSIBLE OUTPUT CHAR TO 0 + MOVE A,CHANNO(B) + MOVE B,0 + ENABLE + XCT (P) + DISABLE + MOVEI A,(B) ; RET CHAR IN A + MOVE B,(TP) + MOVE 0,-1(P) + SUB P,[2,,2] + SUB TP,[2,,2] + POPJ P, + +NETPRS: MOVEI D,0 + HRRZ 0,(C) + MOVE C,1(C) + +ONETL: ILDB A,C + CAIN A,"# + POPJ P, + SUBI A,60 + ASH D,3 + IORI D,(A) + SOJG 0,ONETL + AOS (P) + POPJ P, + +FIXSTK: CAMN 0,[-1] + POPJ P, + JFFO 0,FIXS3 ; PUT OCTAL DIGITS INTO STIRNG + MOVEI A,"0 + POP P,D + AOJA D,ONETCH +FIXS3: IDIVI A,3 + MOVEI B,12. + SUBI B,(A) + HRLM B,(P) + IMULI A,3 + LSH 0,(A) + POP P,B +FIXS2: MOVEI A,0 + ROTC 0,3 ; NEXT DIGIT + ADDI A,60 + JSP D,ONETCH + SUB B,[1,,0] + TLNN B,-1 + JRST 1(B) + JRST FIXS2 + +ONETCH: IDPB A,C + TLNE C,760000 ; SKIP IF NEW WORD + JRST (D) + PUSH P,[0] + JRST (D) + +INSTAT: MOVE E,B + MOVE A,CHANNO(E) + GDSTS + LSH B,-32. + MOVEM D,RNAME2(E) ; UPDATE FOREIGN SOCHKET + MOVEM C,RSNAME(E) ; AND HOST + MOVE C,BUFRIN(E) + XCT ITSTRN(B) ; XLATE TO LOOK MORE LIKE ITS + MOVEM B,(C) ; STORE STATE + MOVE B,E + POPJ P, + +ITSTRN: MOVEI B,0 + JRST NLOSS + JRST NLOSS + MOVEI B,1 + MOVEI B,2 + JRST NLOSS + MOVEI B,4 + PUSHJ P,NOPND + MOVEI B,0 + JRST NLOSS + JRST NLOSS + PUSHJ P,NCLSD + MOVEI B,0 + JRST NLOSS + MOVEI B,0 + +NLOSS: FATAL ILLEGAL NETWORK STATE + +NOPND: MOVE B,DIRECT(E) ; SEE IF READ OR PRINT + ILDB B,B ; GET 1ST CHAR + CAIE B,"R ; SKIP FOR READ + JRST NOPNDW + SIBE ; SEE IF INPUT EXISTS + JRST .+3 + MOVEI B,5 + POPJ P, + MOVEM B,2(C) ; STORE BYTES IN STATE VECTOR + MOVEI B,11 ; RETURN DATA PRESENT STATE + POPJ P, + +NOPNDW: SOBE ; SEE IF OUTPUT PRESENT + JRST .+3 + MOVEI B,5 + POPJ P, + + MOVEI B,6 + POPJ P, + +NCLSD: MOVE B,DIRECT(E) + ILDB B,B + CAIE B,"R + JRST RET0 + SIBE + JRST .+2 + JRST RET0 + MOVEI B,10 + POPJ P, + +RET0: MOVEI B,0 + POPJ P, + + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET + PUSHJ P,INSTAT + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + JRST FINIS + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 ; PRINT OR PRINTB? + CAMN A,MODES+3 + SKIPA A,CHANNO(B) + JRST WRONGD + MOVEI B,21 + MTOPR +NETRET: MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET + MOVE A,CHANNO(B) + MOVEI B,20 + MTOPR + JRST NETRET + +] + +; HERE TO OPEN TELETYPE DEVICES + +OTTY: HRRZ A,S.DIR(C) ; GET DIR CODE + TRNE A,2 ; SKIP IF NOT READB/PRINTB + JRST WRONGD ; CANT DO THAT + +IFN ITS,[ + MOVE A,S.NM1(C) ; CHECK FOR A DIR + MOVE 0,S.NM2(C) + CAMN A,[SIXBIT /.FILE./] + CAME 0,[SIXBIT /(DIR)/] + SKIPA E,[-15.*2,,] + JRST OUTN ; DO IT THAT WAY + + HRRZ A,S.DIR(C) ; CHECK DIR + TRNE A,1 + JRST TTYLP2 + HRRI E,CHNL1 + PUSH P,S.DEV(C) ; SAVE THE SIXBIT DEV NAME + ; HRLZS (P) ; POSTITION DEVICE NAME + +TTYLP: SKIPN D,1(E) ; CHANNEL OPEN? + JRST TTYLP1 ; NO, GO TO NEXT + MOVE A,RDEVIC-1(D) ; GET DEV NAME + MOVE B,RDEVIC(D) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A ; GET RESULT + CAMN A,(P) ; SAME? + JRST SAMTYQ ; COULD BE THE SAME +TTYLP1: ADD E,[2,,2] + JUMPL E,TTYLP + SUB P,[1,,1] ; THIS ONE MUST BE UNIQUE +TTYLP2: MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; GET DIR OF OPEN + SKIPE A ; IF OUTPUT, + IORI A,20 ; THEN USE DISPLAY MODE + HRLM A,S.DIR(C) ; STORE IN OPEN BLOCK + PUSHJ P,OPEN2 ; OPEN THE TTY + MOVE A,S.DEV(C) ; GET DEVICE NAME + PUSHJ P,6TOCHS ; TO A STRING + MOVE D,T.CHAN+1(TB) ; POINT TO CHANNEL + MOVEM A,RDEVIC-1(D) + MOVEM B,RDEVIC(D) + MOVE C,T.SPDL+1(TB) ; RESTORE PDL BASE + MOVE B,D ; CHANNEL TO B + HRRZ 0,S.DIR(C) ; AND DIR + JUMPE 0,TTYSPC +TTY1: DOTCAL TTYGET,[CHANNO(B),[2000,,0],[2000,,A],[2000,,D]] + .LOSE %LSSYS + DOTCAL TTYSET,[CHANNO(B),MODE1,MODE2,D] + .LOSE %LSSYS + MOVE A,[PUSHJ P,GMTYO] + MOVEM A,IOINS(B) + DOTCAL RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]] + .LOSE %LSSYS + MOVEM D,LINLN(B) + MOVEM A,PAGLN(B) + JRST OPNWIN + +; MAKE AN IOT + +IOTMAK: HRLZ A,CHANNO(B) ; GET CHANNEL + ROT A,5 + IOR A,[.IOT A] ; BUILD IOT + MOVEM A,IOINS(B) ; AND STORE IT + POPJ P, + + +; HERE IF POSSIBLY OPENING AN ALREADY OPEN TTY + +SAMTYQ: MOVE D,1(E) ; RESTORE CURRENT CHANNEL + MOVE A,DIRECT-1(D) ; GET DIR + MOVE B,DIRECT(D) + PUSHJ P,STRTO6 + POP P,A ; GET SIXBIT + MOVE C,T.SPDL+1(TB) + HRRZ C,S.DIR(C) + CAME A,MODES(C) ; SKIP IF DIFFERENT DIRECTION + JRST TTYLP1 + +; HERE IF A RE-OPEN ON A TTY + + HRRZ 0,FSAV(TB) ; IS IT FROM A FOPEN + CAIN 0,FOPEN + JRST RETOLD ; RET OLD CHANNEL + + PUSH TP,$TCHAN + PUSH TP,1(E) ; PUSH OLD CHANNEL + PUSH TP,$TFIX + PUSH TP,T.CHAN+1(TB) + MOVE A,[PUSHJ P,CHNFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + SUB TP,[4,,4] + +RETOLD: MOVE B,1(E) ; GET CHANNEL + AOS CHANNO-1(B) ; AOS REF COUNT + MOVSI A,TCHAN + SUB P,[1,,1] ; CLEAN UP STACK + JRST OPNRET ; AND LEAVE + + +; ROUTINE TO PASS TO GCHACK TO FIX UP CHANNEL POINTER + +CHNFIX: CAIN C,TCHAN + CAME D,(TP) + POPJ P, + MOVE D,-2(TP) ; GET REPLACEMENT + SKIPE B + MOVEM D,1(B) ; CLOBBER IT AWAY + POPJ P, +] + +IFE ITS,[ + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ 0,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVE A,[PUSHJ P,INMTYO] + MOVE B,T.CHAN+1(TB) + MOVEM A,IOINS(B) + MOVEI A,100 ; PRIM INPUT JFN + JUMPN 0,TNXTY1 + MOVEI E,C.OPN+C.READ+C.TTY + HRRM E,-2(B) + MOVEM B,CHNL0+2*100+1 + JRST TNXTY2 +TNXTY1: MOVEM B,CHNL0+2*101+1 + MOVEI A,101 ; PRIM OUTPUT JFN + MOVEI E,C.OPN+C.PRIN+C.TTY + HRRM E,-2(B) +TNXTY2: MOVEM A,CHANNO(B) + JUMPN 0,OPNWIN +] +; SETUP FUNNY BUFFER FOR TTY INPUT DEVICES + +TTYSPC: MOVEI A,EXTBFR ; GET EXTRA BUFFER + PUSHJ P,IBLOCK ; GET BLOCK + MOVE D,T.CHAN+1(TB) ;RESTORE CHANNEL POINTER +IFN ITS,[ + MOVE A,CHANNO(D) + LSH A,23. + IOR A,[.IOT A] + MOVEM A,IOIN2(B) +] +IFE ITS,[ + MOVE A,[PBIN] + MOVEM A,IOIN2(B) +] + MOVSI A,TLIST + MOVEM A,EXBUFR-1(D) ; FOR WAITING TTY BUFFERS + SETZM EXBUFR(D) ; NIL LIST + MOVEM B,BUFRIN(D) ;STORE IN CHANNEL + MOVSI A,TUVEC ;MAKE SURE TYPE IS UNIFORM VECTOR + HLLM A,BUFRIN-1(D) + MOVEI A,177 ;SET ERASER TO RUBOUT + MOVEM A,ERASCH(B) +IFE ITS,[ + MOVEI A,25 + MOVEM A,KILLCH(B) +] +IFN ITS,[ + SETZM KILLCH(B) ;NO KILL CHARACTER NEEDED +] + MOVEI A,33 ;BREAKCHR TO C.R. + MOVEM A,BRKCH(B) + MOVEI A,"\ ;ESCAPER TO \ + MOVEM A,ESCAP(B) + MOVE A,[010700,,BYTPTR(E)] ;RELATIVE BYTE POINTER + MOVEM A,BYTPTR(B) + MOVEI A,14 ;BARF BACK CHARACTER FF + MOVEM A,BRFCHR(B) + MOVEI A,^D + MOVEM A,BRFCH2(B) + +; SETUP DEFAULT TTY INTERRUPT HANDLER + + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TFIX + PUSH TP,[10] ; PRIORITY OF CHAR INT + PUSH TP,$TCHAN + PUSH TP,D + MCALL 3,EVENT ; 1ST MAKE AN EVENT EXIST + PUSH TP,A + PUSH TP,B + PUSH TP,$TSUBR + PUSH TP,[QUITTER] ; DEFAULT HANDLER IS QUITTER + MCALL 2,HANDLER + +; BUILD A NULL STRING + + MOVEI A,0 + PUSHJ P,IBLOCK ; USE A BLOCK + MOVE D,T.CHAN+1(TB) + MOVEI 0,C.BUF + IORM 0,-2(D) + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + MOVEM A,BUFSTR-1(D) + MOVEM B,BUFSTR(D) + MOVEI A,0 + MOVE B,D ; CHANNEL TO B + JRST MAKION + + +; ROUTINE TO OPEN ITS CHANNEL WITHOUT .RCHST + +IFN ITS,[ +OPEN2: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN ; OPEN THE FILE + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; SAVE THE CHANNEL + JRST OPEN3 + +; FIX UP MODE AND FALL INTO OPEN + +OPEN0: HRRZ A,S.DIR(C) ; GET DIR + TRNE A,2 ; SKIP IF NOT BLOCK + IORI A,4 ; TURN ON IMAGE + IORI A,2 ; AND BLOCK + + PUSH P,A + PUSH TP,$TPDL + PUSH TP,C ; SAVE CRUFT TO CHECK FOR PRINTO, HA HA + MOVE B,T.CHAN+1(TB) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) ; THIS KLUDGE THE MESS OF NDR + PUSHJ P,STRTO6 + MOVE C,(TP) + POP P,D ; THE SIXBIT FOR KLUDGE + POP P,A ; GET BACK THE RANDOM BITS + SUB TP,[2,,2] + CAME D,[SIXBIT /PRINAO/] + CAMN D,[SIXBIT /PRINTO/] + IORI A,100000 ; WRITEOVER BIT + HRRZ 0,FSAV(TB) + CAIN 0,NFOPEN + IORI A,10 ; DON'T CHANGE REF DATE +OPEN9: HRLM A,S.DIR(C) ; AND STORE IT + +; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL + +OPEN1: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; CLOBBER INTO CHANNEL + DOTCAL RFNAME,[A,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] + JFCL + +; NOW CLOBBER THE TVP SLOT FOR THIS CHANNEL + +OPEN3: MOVE A,S.DIR(C) + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) ; GET CHANNEL # + ASH A,1 + ADDI A,CHNL0 ; POINT TO SLOT + MOVEM B,1(A) ; NOT: TYPE ALREADY SETUP + +; NOW GET STATUS WORD + +DOSTAT: HRRZ A,CHANNO(B) ; NOW GET STATUS WORD + DOTCAL STATUS,[A,[2002,,STATUS]] + JFCL + POPJ P, + + +; HERE IF OPEN FAILS (CHANNEL IS IN A) + +OPNLOS: JUMPL A,NOCHAN ; ALL CHANNELS ARE IN USE + LSH A,23. ; DO A .STATUS + IOR A,[.STATUS A] + XCT A ; STATUS TO A + MOVE B,T.CHAN+1(TB) + PUSHJ P,GFALS ; GET A FALSE WITH A MESSAGE + SUB P,[1,,1] ; EXTRA RET ADDR FLUSHED + JRST OPNRET ; AND RETURN +] + +CGFALS: SUBM M,(P) + MOVEI B,0 +IFN ITS, PUSHJ P,GFALS +IFE ITS, PUSHJ P,TGFALS + JRST MPOPJ + +; ROUTINE TO CONS UP FALSE WITH REASON +IFN ITS,[ +GFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,[SIXBIT / ERR/] ; SET UP OPEN TO ERR DEV + PUSH P,[3] ; SAY ITS FOR CHANNEL + PUSH P,A + .OPEN 0,-2(P) ; USE CHANNEL 0 FOR THIS + FATAL CAN'T OPEN ERROR DEVICE + SUB P,[3,,3] ; DONT WANT OPEN BLOCK NOW +IFN FNAMS, PUSH P,A + MOVEI A,0 ; PREPARE TO BUILD STRING ON STACK +EL1: PUSH P,[0] ; WHERE IT WILL GO + MOVSI B,(<440700,,(P)>) ; BYTE POINTER TO TOP OF STACK +EL2: .IOT 0,0 ; GET A CHAR + JUMPL 0,EL3 ; JUMP ON -1,,3 + CAIN 0,3 ; EOF? + JRST EL3 ; YES, MAKE STRING + CAIN 0,14 ; IGNORE FORM FEEDS + JRST EL2 ; IGNORE FF + CAIE 0,15 ; IGNORE CR & LF + CAIN 0,12 + JRST EL2 + IDPB 0,B ; STUFF IT + TLNE B,760000 ; SIP IF WORD FULL + AOJA A,EL2 + AOJA A,EL1 ; COUNT WORD AND GO + +EL3: +IFN FNAMS,[ + SKIPN (P) + SUB P,[1,,1] + PUSH P,A + .CLOSE 0, + PUSHJ P,CHMAK + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST EL4 + MOVEI A,0 + MOVSI B,(<440700,,(P)>) + PUSH P,[0] + IRP XX,,[RDEVIC,RSNAME,RNAME1,RNAME2]YY,,[0,72,73,40] +IFSN YY,0,[ + MOVEI 0,YY + JSP E,1PUSH +] + MOVE E,-2(TP) + MOVE C,XX(E) + HRRZ D,XX-1(E) + JSP E,PUSHIT + TERMIN +] + SKIPN (P) ; ANY CHARS AT END? + SUB P,[1,,1] ; FLUSH XTRA + PUSH P,A ; PUT UP COUNT + .CLOSE 0, ; CLOSE THE ERR DEVICE + PUSHJ P,CHMAK ; MAKE STRING + PUSH TP,A + PUSH TP,B +IFN FNAMS,[ +EL4: POP P,A + PUSH TP,$TFIX + PUSH TP,A] +IFE FNAMS, MOVEI A,1 +IFN FNAMS,[ + MOVEI A,3 + SKIPN B + MOVEI A,2 +] + PUSHJ P,IILIST + MOVSI A,TFALSE ; MAKEIT A FALSE +IFN FNAMS, SUB TP,[2,,2] + POPJ P, + +IFN FNAMS,[ +1PUSH: MOVEI D,0 + JRST PUSHI2 +PUSHI1: PUSH P,[0] + MOVSI B,(<440700,,(P)>) +PUSHIT: SOJL D,(E) + ILDB 0,C +PUSHI2: IDPB 0,B + TLNE B,760000 + AOJA A,PUSHIT + AOJA A,PUSHI1 +] +] + + +; ROUTINE TO FILL IN THE "REAL" SLOTS FOR THE CHANNEL + +FIXREA: +IFE ITS, HRLZS S.DEV(C) ; KILL MODE BITS + MOVE D,[-4,,S.DEV] + +FIXRE1: MOVEI A,(D) ; COPY REL POINTER + ADD A,T.SPDL+1(TB) ; POINT TO SLOT + SKIPN A,(A) ; SKIP IF GOODIE THERE + JRST FIXRE2 + PUSHJ P,6TOCHS ; MAKE INOT A STRING + MOVE C,RDTBL-S.DEV(D); GET OFFSET + ADD C,T.CHAN+1(TB) + MOVEM A,-1(C) + MOVEM B,(C) +FIXRE2: AOBJN D,FIXRE1 + POPJ P, + +IFN ITS,[ +DOOPN: HRLZ A,A + HRR A,CHANNO(B) ; GET CHANNEL + DOTCAL OPEN,[A,-3(P),-2(P),-1(P),(P)] + SKIPA + AOS -1(P) + POPJ P, +] + +;THIS ROUTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES +STRTO6: PUSH TP,A + PUSH TP,B + PUSH P,E ;SAVE USEFUL FROB + MOVEI E,(A) ; CHAR COUNT TO E + GETYP A,A + CAIE A,TCHSTR ; IS IT ONE WORD? + JRST WRONGT ;NO + CAILE E,6 ; SKIP IF L=? 6 CHARS + MOVEI E,6 +CHREAD: MOVEI A,0 ;INITIALIZE OUTPUT WORD + MOVE D,[440600,,A] ;AND BYTE POINTER TO IT +NEXCHR: SOJL E,SIXDON + ILDB 0,B ; GET NEXT CHAR + CAIN 0,^Q ; CNTL-Q, QUOTES NEXT CHAR + JRST NEXCHR + JUMPE 0,SIXDON ;IF NULL, WE ARE FINISHED + PUSHJ P,A0TO6 ; CONVERT TO SIXBIT + IDPB 0,D ;DEPOSIT INTO SIX BIT + JRST NEXCHR ; NO, GET NEXT +SIXDON: SUB TP,[2,,2] ;FIX UP TP + POP P,E + EXCH A,(P) ;LEAVE RESULT ON P-STACK + JRST (A) ;NOW RETURN + + +;SUBROUTINE TO CONVERT SIXBIT TO ATOM + +6TOCHS: PUSH P,E + PUSH P,D + MOVEI B,0 ;MAX NUMBER OF CHARACTERS + PUSH P,[0] ;STRING WILL GO ON P SATCK + JUMPE A,GETATM ; EMPTY, LEAVE + MOVEI E,-1(P) ;WILL BE BYTE POINTER + HRLI E,10700 ;SET IT UP + PUSH P,[0] ;SECOND POSSIBLE WORD + MOVE D,[440600,,A] ;INPUT BYTE POINTER +6LOOP: ILDB 0,D ;START CHAR GOBBLING + ADDI 0,40 ;CHANGET TOASCII + IDPB 0,E ;AND STORE IT + TLNN D,770000 ; SKIP IF NOT DONE + JRST 6LOOP1 + TDNN A,MSKS(B) ; CHECK IF JUST SPACES LEFT + AOJA B,GETATM ; YES, DONE + AOJA B,6LOOP ;KEEP LOOKING +6LOOP1: PUSH P,[6] ;IF ARRIVE HERE, STRING IS 2 WORDS + JRST .+2 +GETATM: MOVEM B,(P) ;SET STRING LENGTH=1 + PUSHJ P,CHMAK ;MAKE A MUDDLE STRING + POP P,D + POP P,E + POPJ P, + +MSKS: 7777,,-1 + 77,,-1 + ,,-1 + 7777 + 77 + + +; CONVERT ONE CHAR + +A0TO6: CAIL 0,141 ;IF IT IS GREATER OR EQUAL TO LOWER A + CAILE 0,172 ;BUT LESS THAN OR EQUAL TO LOWER Z + JRST .+2 ;THEN + SUBI 0,40 ;CONVERT TO UPPER CASE + SUBI 0,40 ;NOW TO SIX BIT + JUMPL 0,BAD6 ;CHECK FOR A WINNER + CAILE 0,77 + JRST BAD6 + POPJ P, + +; SUBR TO TEST THE EXISTENCE OF FILES + +MFUNCTION FEXIST,SUBR,[FILE-EXISTS?] + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + ADD TP,[2,,2] + MOVSI E,-4 ; 4 THINGS TO PUSH +EXIST: +IFN ITS, MOVE B,@RNMTBL(E) +IFE ITS, MOVE B,@FETBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST EXIST1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ + PUSH P,E + PUSHJ P,ADDNUL + POP P,E + PUSH TP,A ; DEFAULT TYPE AND VALUE GIVEN BY USER + PUSH TP,B ; IN VALUE OF DEV, SNM, NM1, NM2 + ] +IFN ITS, JRST .+2 +IFE ITS, JRST .+3 + +EXIST1: +IFN ITS, PUSH P,EXISTS(E) ; USE DEFAULT +IFE ITS,[ + PUSH TP,FETYP(E) ; DEFAULT TYPE AND VALUE IF NO + PUSH TP,FEVAL(E) ; DEFAULT GIVEN BY USER + ] + AOBJN E,EXIST + + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST TMA ; TOO MANY ARGUMENTS + +IFN ITS,[ + MOVE 0,-3(P) ; GET SIXBIT DEV NAME + MOVEI B,0 + CAMN 0,[SIXBITS /DSK /] + MOVSI B,10 ; DONT SET REF DATE IF DISK DEV + .IOPUSH + DOTCAL OPEN,[B,[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST .+3 + .IOPOP + JRST FDLWON ; WON!!! + .STATUS 0,A ; FIND THE STATUS OF CHANNEL BEFORE POPING + .IOPOP + JRST FDLST1] + +IFE ITS,[ + MOVE B,TB + SUBI B,10 ; GET B TO POINT CORRECTLY TO ARGS + PUSHJ P,STSTK ; GET FILE NAME IN A STRING + HRROI B,1(E) ; POINT B TO THE STRING + MOVSI A,100001 + GTJFN + JRST TDLLOS ; FILE DOES NOT EXIST + RLJFN ; FILE EXIST SO RETURN JFN + JFCL + JRST FDLWON ; SUCCESS + ] + +IFN ITS,[ +EXISTS: SIXBITS /DSK INPUT > / + ] +IFE ITS,[ +FETBL: SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + +FETYP: TCHSTR,,5 + TCHSTR,,3 + TCHSTR,,3 + TCHSTR,,0 + +FEVAL: 440700,,[ASCIZ /INPUT/] + 440700,,[ASCIZ /MUD/] + 440700,,[ASCIZ /DSK/] + 0 + ] + +; SUBR TO DELETE AND RENAME FILES + +MFUNCTION RENAME,SUBR + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + GETYP 0,(AB) ; GET 1ST ARG TYPE +IFN ITS,[ + CAIN 0,TCHAN ; CHANNEL? + JRST CHNRNM ; MUST BE RENAME WHILE OPEN FOR WRITING +] +IFE ITS,[ + PUSH P,[100000,,-2] + PUSH P,[377777,,377777] +] + MOVSI E,-4 ; 4 THINGS TO PUSH +RNMALP: MOVE B,@RNMTBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST RNMLP1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ + PUSH P,E + PUSHJ P,ADDNUL + EXCH B,(P) + MOVE E,B +] + JRST .+2 + +RNMLP1: PUSH P,RNSTBL(E) ; USE DEFAULT + AOBJN E,RNMALP + +IFN ITS,[ + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST RNM1 ; COULD BE A RENAME + +; HERE TO DELETE A FILE + +DELFIL: MOVE A,(P) ; AND GET SNAME + .SUSET [.SSNAM,,A] + DOTCAL DELETE,[[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST FDLST ; ANALYSE ERROR + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS +] +IFE ITS,[ + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; GET BASE OF PDL + MOVEI A,1(A) ; POINT TO CRAP + CAMGE AB,[-3,,] ; SKIP IF DELETE + HLLZS (A) ; RESET DEFAULT + PUSH P,[0] + PUSH P,[0] + PUSH P,[0] + GTJFN ; GET A JFN + JRST TDLLOS ; LOST + ADD AB,[2,,2] ; PAST ARG + JUMPL AB,RNM1 ; GO TRY FOR RENAME + MOVE P,(TP) ; RESTORE P STACK + MOVEI C,(A) ; FOR RELEASE + DELF ; ATTEMPT DELETE + JRST DELLOS ; LOSER + RLJFN ; MAKE SURE FLUSHED + JFCL + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +RNMLOS: PUSH P,A + MOVEI A,(B) + RLJFN + JFCL +DELLO1: MOVEI A,(C) + RLJFN + JFCL + POP P,A ; ERR NUMBER BACK +TDLLOS: MOVEI B,0 + PUSHJ P,TGFALS ; GET FALSE WITH REASON + JRST FINIS + +DELLOS: PUSH P,A ; SAVE ERROR + JRST DELLO1 +] + +;TABLE OF REANMAE DEFAULTS +IFN ITS,[ +RNMTBL: IMQUOTE DEV + IMQUOTE NM1 + IMQUOTE NM2 + IMQUOTE SNM + +RNSTBL: SIXBIT /DSK _MUDS_> / +] +IFE ITS,[ +RNMTBL: SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + +RNSTBL: -1,,[ASCIZ /DSK/] + 0 + -1,,[ASCIZ /_MUDS_/] + -1,,[ASCIZ /MUD/] +] +; HERE TO DO A RENAME + +RNM1: JUMPGE AB,TMA ; IF ARGS EXHAUSTED, MUST BE TOO MUCH STRING + GETYP 0,(AB) + MOVE C,1(AB) ; GET ARG + CAIN 0,TATOM ; IS IT "TO" + CAME C,IMQUOTE TO + JRST WRONGT ; NO, LOSE + ADD AB,[2,,2] ; BUMP PAST "TO" + JUMPGE AB,TFA +IFN ITS,[ + MOVEM P,T.SPDL+1(TB) ; SAVE NEW P-BASE + + MOVEI 0,4 ; FOUR DEFAULTS + PUSH P,-3(P) ; DEFAULT DEVICE IS CURRENT + SOJN 0,.-1 + + PUSHJ P,RGPRS ; PARSE THE NEXT STRING + JRST TMA + + MOVE A,-7(P) ; FIX AND GET DEV1 + MOVE B,-3(P) ; SAME FOR DEV2 + CAME A,B ; SAME? + JRST DEVDIF + + POP P,A ; GET SNAME 2 + CAME A,(P)-3 ; SNAME 1 + JRST DEVDIF + .SUSET [.SSNAM,,A] + POP P,-2(P) ; MOVE NAMES DOWN + POP P,-2(P) + DOTCAL RENAME,[[17,,-4],[17,,-3],[17,,-2],A,[17,,-1],(P)] + JRST FDLST + JRST FDLWON + +; HERE FOR RENAME WHILE OPEN FOR WRITING + +CHNRNM: ADD AB,[2,,2] ; NEXT ARG + JUMPGE AB,TFA + MOVE B,-1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; SKIP IF OPEN + JRST BADCHN + MOVE A,DIRECT-1(B) ; CHECK DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A + CAME A,[SIXBIT /PRINT/] + CAMN A,[SIXBIT /PRINTB/] + JRST CHNRN1 + CAMN A,[SIXBIT /PRINAO/] + JRST CHNRM1 + CAME A,[SIXBIT /PRINTO/] + JRST WRONGD + +; SET UP .FDELE BLOCK + +CHNRN1: PUSH P,[0] + PUSH P,[0] + MOVEM P,T.SPDL+1(TB) + PUSH P,[0] + PUSH P,[SIXBIT /_MUDL_/] + PUSH P,[SIXBIT />/] + PUSH P,[0] + + PUSHJ P,RGPRS ; PARSE THESE + JRST TMA + + SUB P,[1,,1] ; SNAME/DEV IGNORED + MOVE AB,ABSAV(TB) ; GET ORIG ARG POINTER + MOVE B,1(AB) + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RENMWO,[A,[17,,-1],(P)] + JRST FDLST + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RFNAME,[A,[2017,,-4],[2017,,-3],[2017,,-2],[2017,,-1]] + JFCL + MOVE A,-3(P) ; UPDATE CHANNEL + PUSHJ P,6TOCHS ; GET A STRING + MOVE C,1(AB) + MOVEM A,RNAME1-1(C) + MOVEM B,RNAME1(C) + MOVE A,-2(P) + PUSHJ P,6TOCHS + MOVE C,1(AB) + MOVEM A,RNAME2-1(C) + MOVEM B,RNAME2(C) + MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS +] +IFE ITS,[ + PUSH P,A + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; PBASE BACK + PUSH A,[400000,,0] + MOVEI A,(A) + GTJFN + JRST TDLLOS + POP P,B + EXCH A,B + MOVEI C,(A) ; FOR RELEASE ATTEMPT + RNAMF + JRST RNMLOS + MOVEI A,(B) + RLJFN ; FLUSH JFN + JFCL + MOVEI A,(C) ; MAKE SURR OTHER IS FLUSHED + RLJFN + JFCL + JRST FDLWON + + +ADDNUL: PUSH TP,A + PUSH TP,B + MOVEI A,(A) ; LNTH OF STRING + IDIVI A,5 + JUMPN B,NONUAD ; DONT NEED TO ADD ONE + + PUSH TP,$TCHRS + PUSH TP,[0] + MOVEI A,2 + PUSHJ P,CISTNG ; COPY OF STRING + POPJ P, + +NONUAD: POP TP,B + POP TP,A + POPJ P, +] +; HERE FOR LOSING .FDELE + +IFN ITS,[ +FDLST: .STATUS 0,A ; GET STATUS +FDLST1: MOVEI B,0 + PUSHJ P,GFALS ; ANALYZE IT + JRST FINIS +] + +; SOME .FDELE ERRORS + +DEVDIF: ERRUUO EQUOTE DEVICE-OR-SNAME-DIFFERS + + ; HERE TO RESET A READ CHANNEL + +MFUNCTION FRESET,SUBR,RESET + + ENTRY 1 + GETYP A,(AB) + CAIE A,TCHAN + JRST WTYP1 + MOVE B,1(AB) ;GET CHANNEL + SKIPN IOINS(B) ; OPEN? + JRST REOPE1 ; NO, IGNORE CHECKS +IFN ITS,[ + MOVE A,STATUS(B) ;GET STATUS + ANDI A,77 + JUMPE A,REOPE1 ;IF IT CLOSED, JUST REOPEN IT, MAYBE? + CAILE A,2 ;SKIPS IF TTY FLAVOR + JRST REOPEN +] +IFE ITS,[ + MOVE A,CHANNO(B) + CAIE A,100 ; TTY-IN + CAIN A,101 ; TTY-OUT + JRST .+2 + JRST REOPEN +] + CAME B,TTICHN+1 + CAMN B,TTOCHN+1 + JRST REATTY +REATT1: MOVEI B,DIRECT-1(B) ;POINT TO DIRECTION + PUSHJ P,CHRWRD ;CONVERT TO A WORD + JFCL + CAME B,[ASCII /READ/] + JRST TTYOPN + MOVE B,1(AB) ;RESTORE CHANNEL + PUSHJ P,RRESET" ;DO REAL RESET + JRST TTYOPN + +REOPEN: PUSH TP,(AB) ;FIRST CLOSE IT + PUSH TP,(AB)+1 + MCALL 1,FCLOSE + MOVE B,1(AB) ;RESTORE CHANNEL + +; SET UP TEMPS FOR OPNCH + +REOPE1: PUSH P,[0] ; WILL HOLD DIR CODE + PUSH TP,$TPDL + PUSH TP,P + IRP A,,[DIRECT,RNAME1,RNAME2,RDEVIC,RSNAME,ACCESS] + PUSH TP,A-1(B) + PUSH TP,A(B) + TERMIN + + PUSH TP,$TCHAN + PUSH TP,1(AB) + + MOVE A,T.DIR(TB) + MOVE B,T.DIR+1(TB) ; GET DIRECTION + PUSHJ P,CHMOD ; CHECK THE MODE + MOVEM A,(P) ; AND STORE IT + +; NOW SET UP OPEN BLOCK IN SIXBIT + +IFN ITS,[ + MOVSI E,-4 ; AOBN PNTR +FRESE2: MOVE B,T.CHAN+1(TB) + MOVEI A,@RDTBL(E) ; GET ITEM POINTER + GETYP 0,-1(A) ; GET ITS TYPE + CAIE 0,TCHSTR + JRST FRESE1 + MOVE B,(A) ; GET STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 +FRESE3: AOBJN E,FRESE2 +] +IFE ITS,[ + MOVE B,T.CHAN+1(TB) + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; RESULT ON STACK + HLRZS (P) +] + + PUSH P,[0] ; PUSH UP SOME DUMMIES + PUSH P,[0] + PUSH P,[0] + PUSHJ P,OPNCH ; ATTEMPT TO DO THEOPEN + GETYP 0,A + CAIE 0,TCHAN + JRST FINIS ; LEAVE IF FALSE OR WHATEVER + +DRESET: MOVE A,(AB) + MOVE B,1(AB) + SETZM CHRPOS(B) ;INITIALIZE THESE PARAMETERS + SETZM LINPOS(B) + SETZM ACCESS(B) + JRST FINIS + +TTYOPN: +IFN ITS,[ + MOVE B,1(AB) + CAME B,TTOCHN+1 + CAMN B,TTICHN+1 + PUSHJ P,TTYOP2 + PUSHJ P,DOSTAT + DOTCAL RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]] + .LOSE %LSSYS + MOVEM C,PAGLN(B) + MOVEM D,LINLN(B) +] + JRST DRESET + +IFN ITS,[ +FRESE1: CAIE 0,TFIX + JRST BADCHN + PUSH P,(A) + JRST FRESE3 +] + +; INTERFACE TO REOPEN CLOSED CHANNELS + +OPNCHN: PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FRESET + POPJ P, + +REATTY: PUSHJ P,TTYOP2 +IFE ITS, SKIPN DEMFLG ; SKIP IF DEMONFLAG IS ON + SKIPE NOTTY + JRST DRESET + MOVE B,1(AB) + JRST REATT1 + +; FUNCTION TO LIST ALL CHANNELS + +MFUNCTION CHANLIST,SUBR + + ENTRY 0 + + MOVEI A,N.CHNS-1 ;MAX # OF REAL CHANNELS + MOVEI C,0 + MOVEI B,CHNL1 ;POINT TO FIRST REAL CHANNEL + +CHNLP: SKIPN 1(B) ;OPEN? + JRST NXTCHN ;NO, SKIP + HRRE E,(B) ; ABOUT TO FLUSH? + JUMPL E,NXTCHN ; YES, FORGET IT + MOVE D,1(B) ; GET CHANNEL + HRRZ E,CHANNO-1(D) ; GET REF COUNT + PUSH TP,(B) + PUSH TP,1(B) + ADDI C,1 ;COUNT WINNERS + SOJGE E,.-3 ; COUNT THEM +NXTCHN: ADDI B,2 + SOJN A,CHNLP + + SKIPN B,CHNL0+1 ;NOW HACK LIST OF PSUEDO CHANNELS + JRST MAKLST +CHNLS: PUSH TP,(B) + PUSH TP,(B)+1 + ADDI C,1 + HRRZ B,(B) + JUMPN B,CHNLS + +MAKLST: ACALL C,LIST + JRST FINIS + + ; ROUTINE TO RESTORE A CLOSED CHANNEL TO ITS PREVIOUS STATE + + +REOPN: PUSH TP,$TCHAN + PUSH TP,B + SKIPN CHANNO(B) ; ONLY REAL CHANNELS + JRST PSUEDO + +IFN ITS,[ + MOVSI E,-4 ; SET UP POINTER FOR NAMES + +GETOPB: MOVE B,(TP) ; GET CHANNEL + MOVEI A,@RDTBL(E) ; GET POINTER + MOVE B,(A) ; NOW STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 ; LEAVES SIXBIT ON STACK + AOBJN E,GETOPB +] +IFE ITS,[ + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; GET DEV NAME IN SIXBIT +] + MOVE B,(TP) ; RESTORE CHANNEL + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,CHMOD ; CHECK FOR A VALID MODE + +IFN ITS, MOVE E,-3(P) ; GET DEVICE IN PROPER PLACE +IFE ITS, HLRZS E,(P) + MOVE B,(TP) ; RESTORE CHANNEL +IFN ITS, CAMN E,[SIXBIT /DSK /] +IFE ITS,[ + CAIE E,(SIXBIT /PS /) + CAIN E,(SIXBIT /DSK/) + JRST DISKH ; DISK WINS IMMEIDATELY + CAIE E,(SIXBIT /SS /) + CAIN E,(SIXBIT /SRC/) + JRST DISKH ; DISK WINS IMMEIDATELY +] +IFN ITS, CAMN E,[SIXBIT /TTY /] ; NO NEED TO RE-OPEN THE TTY +IFE ITS, CAIN E,(SIXBIT /TTY/) + JRST REOPD1 +IFN ITS,[ + AND E,[777700,,0] ; COULD BE "UTn" + MOVE D,CHANNO(B) ; GET CHANNEL + ASH D,1 + ADDI D,CHNL0 ; DON'T SEEM TO BE OPEN + SETZM 1(D) + SETZM CHANNO(B) + CAMN E,[SIXBIT /UT /] + JRST REOPD ; CURRENTLY, CANT RESTORE UTAPE CHANNLES + CAMN E,[SIXBIT /AI /] + JRST REOPD ; CURRENTLY CANT RESTORE AI CHANNELS + CAMN E,[SIXBIT /ML /] + JRST REOPD ; CURRENTLY CANT RESTORE ML CHANNELS + CAMN E,[SIXBIT /DM /] + JRST REOPD ; CURRENTLY CANT RESTORE DM CHANNELS +] + PUSH TP,$TCHAN ; TRY TO RESET IT + PUSH TP,B + MCALL 1,FRESET + +IFN ITS,[ +REOPD1: AOS -4(P) +REOPD: SUB P,[4,,4] +] +IFE ITS,[ +REOPD1: AOS -1(P) +REOPD: SUB P,[1,,1] +] +REOPD0: SUB TP,[2,,2] + POPJ P, + +IFN ITS,[ +DISKH: MOVE C,(P) ; SNAME + .SUSET [.SSNAM,,C] +] +IFE ITS,[ +DISKH: MOVEM A,(P) ; SAVE MODE WORD + PUSHJ P,STSTK ; STRING TO STACK + MOVE A,(E) ; RESTORE MODE WORD + PUSH TP,$TPDL + PUSH TP,E ; SAVE PDL BASE + MOVE B,-2(TP) ; CHANNEL BACK TO B +] + MOVE C,ACCESS(B) ; GET CHANNELS ACCESS + TRNN A,2 ; SKIP IF NOT ASCII CHANNEL + JRST DISKH1 + HRRZ D,ACCESS-1(B) ; IF PARTIAL WORD OUT + IMULI C,5 ; TO CHAR ACCESS + JUMPE D,DISKH1 ; NO SWEAT + ADDI C,(D) + SUBI C,5 +DISKH1: HRRZ D,BUFSTR-1(B) ; ANY CHARS IN MUDDLE BUFFER + JUMPE D,DISKH2 + TRNN A,1 ; SKIP IF OUTPUT CHANNEL + JRST DISKH2 + PUSH P,A + PUSH P,C + MOVEI C,BUFSTR-1(B) + PUSHJ P,BYTDOP ; FIND LENGTH OF WHOLE BUFFER + HLRZ D,(A) ; LENGTH + 2 TO D + SUBI D,2 + IMULI D,5 ; TO CHARS + SUB D,BUFSTR-1(B) + POP P,C + POP P,A +DISKH2: SUBI C,(D) ; UPDATE CHAR ACCESS + IDIVI C,5 ; BACK TO WORD ACCESS +IFN ITS,[ + IORI A,6 ; BLOCK IMAGE + TRNE A,1 + IORI A,100000 ; WRITE OVER BIT + PUSHJ P,DOOPN + JRST REOPD + MOVE A,C ; ACCESS TO A + PUSHJ P,GETFLN ; CHECK LENGTH + CAIGE 0,(A) ; CHECK BOUNDS + JRST .+3 ; COMPLAIN + PUSHJ P,DOACCS ; AND ACESS + JRST REOPD1 ; SUCCESS + + MOVE A,CHANNO(B) ; CLOSE THE G.D. CHANNEL + PUSHJ P,MCLOSE + JRST REOPD + +DOACCS: PUSH P,A + HRRZ A,CHANNO(B) + DOTCAL ACCESS,[A,(P)] + JFCL + POP P,A + POPJ P, + +DOIOTO: +DOIOTI: +DOIOT: + PUSH P,0 + MOVSI 0,TCHAN + MOVE PVP,PVSTOR+1 + MOVEM 0,BSTO(PVP) ; IN CASE OF INTERRUPT + ENABLE + HRRZ 0,CHANNO(B) + DOTCAL IOT,[0,A] + JFCL + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + POP P,0 + POPJ P, + +GETFLN: MOVE 0,CHANNO(B) ; GET CHANNEL + .CALL FILBLK ; READ LNTH + .VALUE + POPJ P, + +FILBLK: SETZ + SIXBIT /FILLEN/ + 0 + 402000,,0 ; STUFF RESULT IN 0 +] +IFE ITS,[ + MOVEI A,CHNL0 + ADD A,CHANNO(B) + ADD A,CHANNO(B) + SETZM 1(A) ; MAY GET A DIFFERENT JFN + HRROI B,1(E) ; TENEX STRING POINTER + MOVSI A,400001 ; MAKE SURE + GTJFN ; GO GET IT + JRST RGTJL ; COMPLAIN + MOVE D,-2(TP) + HRRZM A,CHANNO(D) ; COULD HAVE CHANGED + MOVE P,(TP) ; RESTORE P + MOVEI B,CHNL0 + ASH A,1 ; MUNG ITS SLOT + ADDI A,(B) + MOVEM D,1(A) + HLLOS (A) ; MARK CHANNEL NOT TO BE RELOOKED AT + MOVE A,(P) ; MODE WORD BACK + MOVE B,[440000,,200000] ; FLAG BITS + TRNE A,1 ; SKIP FOR INPUT + TRC B,300000 ; CHANGE TO WRITE + MOVE A,CHANNO(D) ; GET JFN + OPENF + JRST ROPFLS + MOVE E,C ; LENGTH TO E + SIZEF ; GET CURRENT LENGTH + JRST ROPFLS + CAMGE B,E ; STILL A WINNER + JRST ROPFLS + MOVE A,CHANNO(D) ; JFN + MOVE B,C + SFPTR + JRST ROPFLS + SUB TP,[2,,2] ; FLUSH PDL POINTER + JRST REOPD1 + +ROPFLS: MOVE A,-2(TP) + MOVE A,CHANNO(A) + CLOSF ; ATTEMPT TO CLOSE + JFCL ; IGNORE FAILURE + SKIPA + +RGTJL: MOVE P,(TP) + SUB TP,[2,,2] + JRST REOPD + +DOACCS: PUSH P,B + EXCH A,B + MOVE A,CHANNO(A) + SFPTR + JRST ACCFAI + POP P,B + POPJ P, +] +PSUEDO: AOS (P) ; ASSUME SUCCESS FOR NOW + MOVEI B,RDEVIC-1(B) ; SEE WHAT DEVICE IS + PUSHJ P,CHRWRD + JFCL + JRST REOPD0 ; NO, RETURN HAPPY +IFN 0,[ CAME B,[ASCII /E&S/] ; DISPLAY ? + CAMN B,[ASCII /DIS/] + SKIPA B,(TP) ; YES, REGOBBLE CHANNEL AND CONTINUE + JRST REOPD0 ; NO, RETURN HAPPY + PUSHJ P,DISROP + SOS (P) ; DISPLAY DID NOT REOPEN, UNDO ASSUMPTION OF SUCCESS + JRST REOPD0] + + ;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL + +MFUNCTION FCLOSE,SUBR,[CLOSE] + + ENTRY 1 ;ONLY ONE ARG + GETYP A,(AB) ;CHECK ARGS + CAIE A,TCHAN ;IS IT A CHANNEL + JRST WTYP1 + MOVE B,1(AB) ;PICK UP THE CHANNEL + HRRZ A,CHANNO-1(B) ; GET REF COUNT + SOJGE A,CFIN5 ; NOT READY TO REALLY CLOSE + CAME B,TTICHN+1 ; CHECK FOR TTY + CAMN B,TTOCHN+1 + JRST CLSTTY + MOVE A,[JRST CHNCLS] + MOVEM A,IOINS(B) ;CLOBBER THE IO INS + MOVE A,RDEVIC-1(B) ;GET THE NAME OF THE DEVICE + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 +IFN ITS, MOVE A,(P) +IFE ITS, HLRZS A,(P) + MOVE B,1(AB) ; RESTORE CHANNEL +IFN 0,[ + CAME A,[SIXBIT /E&S /] + CAMN A,[SIXBIT /DIS /] + PUSHJ P,DISCLS] + MOVE B,1(AB) ; IN CASE CLOBBERED BY DISCLS + SKIPN A,CHANNO(B) ;ANY REAL CHANNEL? + JRST REMOV ; NO, EITHER CLOSED OR PSEUDO CHANNEL + + MOVE A,DIRECT-1(B) ; POINT TO DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; CONVERT TO WORD + POP P,A +IFN ITS, LDB E,[360600,,(P)] ; FIRST CHAR OD DEV NAME +IFE ITS, LDB E,[140600,,(P)] ; FIRST CHAR OD DEV NAME + CAIE E,'T ; SKIP IF TTY + JRST CFIN4 + CAME A,[SIXBIT /READ/] ; SKIP IF WINNER + JRST CFIN1 +IFN ITS,[ + MOVE B,1(AB) ; IN ITS CHECK STATUS + LDB A,[600,,STATUS(B)] + CAILE A,2 + JRST CFIN1 +] + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE CHAR + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,OFF ; TURN OFF INTERRUPT +CFIN1: MOVE B,1(AB) + MOVE A,CHANNO(B) +IFN ITS,[ + PUSHJ P,MCLOSE +] +IFE ITS,[ + TLZ A,400000 ; FOR JFN RELEASE + CLOSF ; CLOSE THE FILE AND RELEASE THE JFN + JFCL + MOVE A,CHANNO(B) +] +CFIN: LSH A,1 + ADDI A,CHNL0+1 ;POINT TO THIS CHANNELS LSOT + SETZM CHANNO(B) + SETZM (A) ;AND CLOBBER IT + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) + HLLZS ACCESS-1(B) +CFIN2: HLLZS -2(B) + MOVSI A,TCHAN ;RETURN THE CHANNEL + JRST FINIS + +CLSTTY: ERRUUO EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL + + +REMOV: MOVEI D,CHNL0+1 ;ATTEMPT TO REMOVE FROM PSUEDO CHANNEL LIST +REMOV0: SKIPN C,D ;FOUND ON LIST ? + JRST CFIN2 ;NO, JUST IGNORE THIS CLOSED CHANNEL + HRRZ D,(C) ;GET POINTER TO NEXT + CAME B,(D)+1 ;FOUND ? + JRST REMOV0 + HRRZ D,(D) ;YES, SPLICE IT OUT + HRRM D,(C) + JRST CFIN2 + + +; CLOSE UP ANY LEFTOVER BUFFERS + +CFIN4: +; CAME A,[SIXBIT /PRINTO/] +; CAMN A,[SIXBIT /PRINTB/] +; JRST .+3 +; CAME A,[SIXBIT /PRINT/] +; JRST CFIN1 + MOVE B,1(AB) ; GET CHANNEL + HRRZ A,-2(B) ;GET MODE BITS + TRNN A,C.PRIN + JRST CFIN1 + GETYP 0,BUFSTR-1(B) ; IS THERE AN OUTPUT BUFFER + SKIPN BUFSTR(B) + JRST CFIN1 + CAIE 0,TCHSTR + JRST CFINX1 + PUSHJ P,BFCLOS +IFE ITS,[ + MOVE A,CHANNO(B) + MOVEI B,7 + SFBSZ + JFCL + CLOSF + JFCL +] + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) +CFINX1: HLLZS ACCESS-1(B) + JRST CFIN1 + +CFIN5: HRRM A,CHANNO-1(B) + JRST CFIN2 + ;SUBR TO DO .ACCESS ON A READ CHANNEL +;FORM: +;POSITIONS CHANNEL AT CHARACTER POSN FIX-NUMBER +;H. BRODIE 7/26/72 + +MFUNCTION MACCESS,SUBR,[ACCESS] + ENTRY 2 ;ARGS: CHANNEL AND FIX-NUMBER + +;CHECK ARGUMENT TYPES + GETYP A,(AB) + CAIE A,TCHAN ;FIRST ARG SHOULD BE CHANNEL + JRST WTYP1 + GETYP A,2(AB) ;TYPE OF SECOND + CAIE A,TFIX ;SHOULD BE FIX + JRST WTYP2 + +;CHECK DIRECTION OF CHANNEL + MOVE B,1(AB) ;B GETS PNTR TO CHANNEL +; MOVEI B,DIRECT-1(B) ;GET DIRECTION OF CHANNEL +; PUSHJ P,CHRWRD ;GRAB THE CHAR STRNG +; JFCL +; CAME B,[+1] + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.PRIN + JRST MACCA + MOVE B,1(AB) + SKIPE C,BUFSTR(B) ;SEE IF WE MUST FLUSH PART BUFFER + PUSHJ P,BFCLOS + JRST MACC +MACCA: +; CAMN B,[ASCIZ /READ/] +; JRST .+4 +; CAME B,[ASCIZ /READB/] ; READB CHANNEL? +; JRST WRONGD +; AOS (P) ; SET INDICATOR FOR BINARY MODE + +;CHECK THAT THE CHANNEL IS OPEN +MACC: MOVE B,1(AB) ;GET BACK PTR TO CHANNEL + HRRZ E,-2(B) + TRNN E,C.OPN + JRST CHNCLS ;IF CHNL CLOSED => ERROR + +;COMPUTE ACCESS PNTR TO ACCESS WORD CHAR IS IN +;REMAINDER IS NUMBER OF TIMES TO INCR BYTE POINTER +ADEVOK: SKIPGE C,3(AB) ;GET CHAR POSN + ERRUUO EQUOTE NEGATIVE-ARGUMENT +MACC1: MOVEI D,0 + TRNN E,C.BIN ; SKIP FOR BINARY FILE + IDIVI C,5 + +;SETUP THE .ACCESS + TRNN E,C.PRIN + JRST NLSTCH + HRRZ 0,LSTCH-1(B) + MOVE A,ACCESS(B) + TRNN E,C.BIN + JRST LSTCH1 + IMULI A,5 + ADD A,ACCESS-1(B) + ANDI A,-1 +LSTCH1: CAIG 0,(A) + MOVE 0,A + MOVE A,C + IMULI A,5 + ADDI A,(D) + CAML A,0 + MOVE 0,A + HRRM 0,LSTCH-1(B) ; UPDATE "LARGEST" +NLSTCH: MOVE A,CHANNO(B) ;A GETS REAL CHANNEL NUMBER +IFN ITS,[ + DOTCAL ACCESS,[A,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + +IFE ITS,[ + MOVE B,C + SFPTR ; DO IT IN TENEX + JRST ACCFAI + MOVE B,1(AB) ; RESTORE CHANNEL +] +; POP P,E ; CHECK FOR READB MODE + TRNN E,C.READ + JRST ACCOUT ; PRINT TYPE CHANNEL, GO DO IT + SKIPE BUFSTR(B) ; IS THERE A READ BUFFER TO FLUSH + JRST .+3 + SETZM LSTCH(B) ; CLEAR OUT POSSIBLE EOF INDICATOR + JRST DONADV + +;NOW FORCE GETCHR TO DO A .IOT FIRST THING + MOVEI C,BUFSTR-1(B) ; FIND END OF STRING + PUSHJ P,BYTDOP" + SUBI A,2 ; LAST REAL WORD + HRLI A,010700 + MOVEM A,BUFSTR(B) + HLLZS BUFSTR-1(B) ; CLOBBER CHAR COUNT + SETZM LSTCH(B) ;CLOBBER READ'S HIDDEN CHARACTER + +;NOW DO THE APPROPRIATE NUM OF BYTE ADVANCEMENTS + JUMPLE D,DONADV +ADVPTR: PUSHJ P,GETCHR + MOVE B,1(AB) ;RESTORE IN CASE CLOBBERED + SOJG D,ADVPTR + +DONADV: MOVE C,3(AB) ;FIXUP ACCESS SLOT IN CHNL + HLLZS ACCESS-1(B) + MOVEM C,ACCESS(B) + MOVE A,$TCHAN ;TYPE OF RESULT = "CHANNEL" + JRST FINIS ;DONE...B CONTAINS CHANNEL + +IFE ITS,[ +ACCFAI: ERRUUO EQUOTE ACCESS-FAILURE +] +ACCOUT: SKIPN C,BUFSTR(B) ; FIXUP BUFFER? + JRST ACCOU1 + HRRZ F,BUFSTR-1(B) + ADD F,[-BUFLNT*5-4] + IDIVI F,5 + ADD F,BUFSTR(B) + HRLI F,010700 + MOVEM F,BUFSTR(B) + MOVEI F,BUFLNT*5 + HRRM F,BUFSTR-1(B) +ACCOU1: TRNE E,C.BIN ; FINISHED FOR BINARY CHANNELS + JRST DONADV + + JUMPE D,DONADV ; THIS CASE OK +IFE ITS,[ + MOVE A,CHANNO(B) ; GET LAST WORD + RFPTR + JFCL + PUSH P,B + MOVNI C,1 + MOVE B,[444400,,E] ; READ THE WORD + SIN + JUMPL C,ACCFAI + POP P,B + SFPTR + JFCL + MOVE B,1(AB) ; CHANNEL BACK + MOVE C,[440700,,E] + ILDB 0,C + IDPB 0,BUFSTR(B) + SOS BUFSTR-1(B) + SOJG D,.-3 + JRST DONADV +] +IFN ITS, ERRUUO EQUOTE CANT-ACCESS-ASCII-ON-ITS + + +;WRONG TYPE OF DEVICE ERROR +WRDEV: ERRUUO EQUOTE NON-DSK-DEVICE + +; BINARY READ AND PRINT ROUTINES + +MFUNCTION PRINTB,SUBR + + ENTRY + +PBFL: PUSH P,. ; PUSH NON-ZERONESS + MOVEI A,-7 + JRST BINI1 + +MFUNCTION READB,SUBR + + ENTRY + + PUSH P,[0] + MOVEI A,-11 +BINI1: HLRZ 0,AB + CAILE 0,-3 + JRST TFA + CAIG 0,(A) + JRST TMA + + GETYP 0,(AB) ; SHOULD BE UVEC OR STORE + CAIE 0,TSTORAGE + CAIN 0,TUVEC + JRST BINI2 + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTOK + JRST WTYP1 ; ELSE LOSE +BINI2: MOVE B,1(AB) ; GET IT + HLRE C,B + SUBI B,(C) ; POINT TO DOPE + GETYP A,(B) + PUSHJ P,SAT" ; GET ITS ST.ALOC.TYPE + CAIE A,S1WORD + JRST WTYP1 +BYTOK: GETYP 0,2(AB) + CAIE 0,TCHAN ; BETTER BE A CHANNEL + JRST WTYP2 + MOVE B,3(AB) ; GET IT +; MOVEI B,DIRECT-1(B) ; GET DIRECTION OF +; PUSHJ P,CHRWRD ; INTO 1 WORD +; JFCL +; MOVNI E,1 +; CAMN B,[ASCII /READB/] +; MOVEI E,0 +; CAMN B,[+1] + HRRZ A,-2(B) ; MODE BITS + TRNN A,C.BIN ; IF NOT BINARY + JRST WRONGD + MOVEI E,0 + TRNE A,C.PRIN + MOVE E,PBFL +; JUMPL E,WRONGD ; LOSER + CAME E,(P) ; CHECK WINNGE + JRST WRONGD + MOVE B,3(AB) ; GET CHANNEL BACK + SKIPN A,IOINS(B) ; OPEN? + PUSHJ P,OPENIT ; LOSE + CAMN A,[JRST CHNCLS] + JRST CHNCLS ; LOSE, CLOSED + JUMPN E,BUFOU1 ; JUMP FOR OUTPUT + MOVEI C,0 + CAML AB,[-5,,] ; SKIP IF EOF GIVEN + JRST BINI5 + MOVE 0,4(AB) + MOVEM 0,EOFCND-1(B) + MOVE 0,5(AB) + MOVEM 0,EOFCND(B) + CAML AB,[-7,,] + JRST BINI5 + GETYP 0,6(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,7(AB) +BINI5: SKIPE LSTCH(B) ; INDICATES IF EOF HIT + JRST BINEOF + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTI + MOVE A,1(AB) ; GET VECTOR + PUSHJ P,PGBIOI ; READ IT + HLRE C,A ; GET COUNT DONE + HLRE D,1(AB) ; AND FULL COUNT + SUB C,D ; C=> TOTAL READ + ADDM C,ACCESS(B) + JUMPGE A,BINIOK ; NOT EOF YET + SETOM LSTCH(B) +BINIOK: MOVE B,C + MOVSI A,TFIX ; RETURN AMOUNT ACTUALLY READ + JRST FINIS + +BYTI: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-LOST + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-LOST + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE STRING LENGTH + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 + PUSH P,C + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SIN] + PUSHJ P,PGBIOT + HLRE C,A ; GET COUNT DONE + POP P,D + SKIPN D + HRRZ D,(AB) ; AND FULL COUNT + ADD D,C ; C=> TOTAL READ + LDB E,[300600,,1(AB)] + MOVEI A,36. + IDIVM A,E + IDIVM D,E + ADDM E,ACCESS(B) + SKIPGE C ; NOT EOF YET + SETOM LSTCH(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-LOST + MOVE C,D + JRST BINIOK +] +BUFOU1: SKIPE BUFSTR(B) ; ANY BUFFERS AROUND? + PUSHJ P,BFCLS1 ; GET RID OF SAME + MOVEI C,0 + CAML AB,[-5,,] + JRST BINO5 + GETYP 0,4(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,5(AB) +BINO5: MOVE A,1(AB) + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTO + PUSHJ P,PGBIOO + HLRE C,1(AB) + MOVNS C + ADDM C,ACCESS(B) +BYTO1: MOVE A,(AB) ; RET VECTOR ETC. + MOVE B,1(AB) + JRST FINIS + +BYTO: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-FAILURE + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-FAILURE + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE SIZE + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 ; COMPENSATE FOR PGBIOT DOING THE WRONG THING + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SOUT] + PUSHJ P,PGBIOT + LDB D,[300600,,1(AB)] + MOVEI C,36. + IDIVM C,D + HRRZ C,(AB) + IDIVI C,(D) + ADDM C,ACCESS(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-FAILURE + JRST BYTO1 +] + +BINEOF: PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOSER + MCALL 1,EVAL + JRST FINIS + +OPENIT: PUSH P,E + PUSHJ P,OPNCHN ;TRY TO OPEN THE LOSER + JUMPE B,CHNCLS ;FAIL + POP P,E + POPJ P, + ; THESE SUBROUTINES BY NDR 9/16/73 TO FACILITATE THE +; TYPES OF IO NECESSARY TO MAKE MORE EFFICIENT USE OF +; THE NETWORK AND DO RELATED FILE TRANSFER TYPE OF JOBS. + +R1CHAR: SKIPN A,LSTCH(B) ; CHAR READING ROUTINE FOR FCOPY + PUSHJ P,RXCT + TLO A,200000 ; ^@ BUG + MOVEM A,LSTCH(B) + TLZ A,200000 + JUMPL A,.+2 ; IN CASE OF -1 ON STY + TRZN A,400000 ; EXCL HACKER + JRST .+4 + MOVEM A,LSTCH(B) ; SAVE DE-EXCLED CHAR + MOVEI A,"! + JRST .+2 + SETZM LSTCH(B) + PUSH P,C + HRRZ C,DIRECT-1(B) + CAIE C,5 ; IF DIRECTION IS 5 LONG THEN READB + JRST R1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) ; EVERY FIFTY INCREMENT + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +R1CH1: AOS ACCESS(B) + POP P,C + POPJ P, + +W1CHAR: CAIE A,15 ; CHAR WRITING ROUTINE, TEST FOR CR + JRST .+3 + SETOM CHRPOS(B) + AOSA LINPOS(B) + CAIE A,12 ; TEST FOR LF + AOS CHRPOS(B) ; IF NOT LF AOS CHARACTE5R POSITION + CAIE A,14 ; TEST FOR FORM FEED + JRST .+3 + SETZM CHRPOS(B) ; IF FORM FEED ZERO CHARACTER POSITION + SETZM LINPOS(B) ; AND LINE POSITION + CAIE A,11 ; IS THIS A TAB? + JRST .+6 + MOVE C,CHRPOS(B) + ADDI C,7 + IDIVI C,8. + IMULI C,8. ; FIX UP CHAR POS FOR TAB + MOVEM C,CHRPOS(B) ; AND SAVE + PUSH P,C + HRRZ C,-2(B) ; GET BITS + TRNN C,C.BIN ; SIX LONG MUST BE PRINTB + JRST W1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +W1CH1: AOS ACCESS(B) + PUSH P,A + PUSHJ P,WXCT + POP P,A + POP P,C + POPJ P, + +R1C: SUBM M,(P) ;LITTLE ENTRY FOR COMPILED STUFF +; PUSH TP,$TCHAN ;SAVE THE CHANNEL TO BLESS IT +; PUSH TP,B +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JFCL +; CAME B,[ASCIZ /READ/] +; CAMN B,[ASCII /READB/] +; JRST .+2 +; JRST BADCHN + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.READ + JRST BADCHN + SKIPN IOINS(B) ; IS THE CHANNEL OPEN + PUSHJ P,OPENIT ; NO, GO DO IT + PUSHJ P,GRB ; MAKE SURE WE HAVE A READ BUFFER + PUSHJ P,R1CHAR ; AND GET HIM A CHARACTER + JRST MPOPJ ; THATS ALL FOLKS + +W1C: SUBM M,(P) + PUSHJ P,W1CI + JRST MPOPJ + +W1CI: +; PUSH TP,$TCHAN +; PUSH TP,B + PUSH P,A ; ASSEMBLER ENTRY TO OUTPUT 1 CHAR +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; INTERNAL CALL TO W1CHAR +; JFCL +; CAME B,[ASCII /PRINT/] +; CAMN B,[+1] +; JRST .+2 +; JRST BADCHN +; POP TP,B +; POP TP,(TP) + HRRZ A,-2(B) + TRNN A,C.PRIN + JRST BADCHN + SKIPN IOINS(B) ; MAKE SURE THAT IT IS OPEN + PUSHJ P,OPENIT + PUSHJ P,GWB + POP P,A ; GET THE CHAR TO DO + JRST W1CHAR + +; ROUTINES TO REPLACE XCT IOINS(B) FOR INPUT AND OUTPUT +; THEY DO THE XCT THEN CHECK OUT POSSIBLE SCRIPTAGE--BLECH. + + +WXCT: +RXCT: XCT IOINS(B) ; READ IT + SKIPN SCRPTO(B) + POPJ P, + +DOSCPT: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; AND SAVE THE CHAR AROUND + + SKIPN SCRPTO(B) ; IF ZERO FORGET IT + JRST SCPTDN ; THATS ALL THERE IS TO IT + PUSH P,C ; SAVE AN ACCUMULATOR FOR CLEANLINESS + GETYP C,SCRPTO-1(B) ; IS IT A LIST + CAIE C,TLIST + JRST BADCHN + PUSH TP,$TLIST + PUSH TP,[0] ; SAVE A SLOT FOR THE LIST + MOVE C,SCRPTO(B) ; GET THE LIST OF SCRIPT CHANNELS +SCPT1: GETYP B,(C) ; GET THE TYPE OF THIS SCRIPT CHAN + CAIE B,TCHAN + JRST BADCHN ; IF IT ISN'T A CHANNEL, COMPLAIN + HRRZ B,(C) ; GET THE REST OF THE LIST IN B + MOVEM B,(TP) ; AND STORE ON STACK + MOVE B,1(C) ; GET THE CHANNEL IN B + MOVE A,-1(P) ; AND THE CHARACTER IN A + PUSHJ P,W1CI ; GO TO INTERNAL W1C, IT BLESSES GOODIES + SKIPE C,(TP) ; GET THE REST OF LIST OF CHANS + JRST SCPT1 ; AND CYCLE THROUGH + SUB TP,[2,,2] ; CLEAN OFF THE LIST OF CHANS + POP P,C ; AND RESTORE ACCUMULATOR C +SCPTDN: POP P,A ; RESTORE THE CHARACTER + POP TP,B ; AND THE ORIGINAL CHANNEL + POP TP,(TP) + POPJ P, ; AND THATS ALL + + +; SUBROUTINE TO COPY FROM INCHAN TO OUTCHAN UNTIL EOF HIT +; ON THE INPUT CHANNEL +; CALL IS WHERE DEFAULTS ARE INCHAN AND OUTCHAN + + MFUNCTION FCOPY,SUBR,[FILECOPY] + + ENTRY + HLRE 0,AB + CAMGE 0,[-4] + JRST WNA ; TAKES FROM 0 TO 2 ARGS + + JUMPE 0,.+4 ; NO FIRST ARG? + PUSH TP,(AB) + PUSH TP,1(AB) ; SAVE IN CHAN + JRST .+6 + MOVE A,$TATOM + MOVE B,IMQUOTE INCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B + HLRE 0,AB ; CHECK FOR SECOND ARG + CAML 0,[-2] ; WAS THERE MORE THAN ONE ARG? + JRST .+4 + PUSH TP,2(AB) ; SAVE SECOND ARG + PUSH TP,3(AB) + JRST .+6 + MOVE A,$TATOM ; LOOK UP OUTCHAN AS DEFAULT + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B ; AND SAVE IT + + MOVE A,-3(TP) + MOVE B,-2(TP) ; INPUT CHANNEL + MOVEI 0,C.READ ; INDICATE INPUT + PUSHJ P,CHKCHN ; CHECK FOR GOOD CHANNEL + MOVE A,-1(TP) + MOVE B,(TP) ; GET OUT CHAN + MOVEI 0,C.PRIN ; INDICATE OUT CHAN + PUSHJ P,CHKCHN ; CHECK FOR GOOD OUT CHAN + + PUSH P,[0] ; COUNT OF CHARS OUTPUT + + MOVE B,-2(TP) + PUSHJ P,GRB ; MAKE SURE WE HAVE READ BUFF + MOVE B,(TP) + PUSHJ P,GWB ; MAKE SURE WE HAVE WRITE BUFF + +FCLOOP: INTGO + MOVE B,-2(TP) + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,FCDON ; IF A NEG NUMBER WE GOT EOF + MOVE B,(TP) ; GET OUT CHAN + PUSHJ P,W1CHAR ; SPIT IT OUT + AOS (P) ; INCREMENT COUNT + JRST FCLOOP + +FCDON: SUB TP,[2,,2] ; POP OFF OUTCHAN + MCALL 1,FCLOSE ; CLOSE INCHAN + MOVE A,$TFIX + POP P,B ; GET CHAR COUNT TO RETURN + JRST FINIS + +CHKCHN: PUSH P,0 ; CHECK FOR GOOD TASTING CHANNEL + PUSH TP,A + PUSH TP,B + GETYP C,A + CAIE C,TCHAN + JRST CHKBDC ; GO COMPLAIN IN RIGHT WAY +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JRST CHKBDC +; MOVE C,(P) ; GET CHAN DIRECT + HRRZ C,-2(B) ; MODE BITS + TDNN C,0 + JRST CHKBDC +; CAMN B,CHKT(C) +; JRST .+4 +; ADDI C,2 ; TEST FOR READB OR PRINTB ALSO +; CAME B,CHKT(C) ; TEST FOR CORRECT DIRECT +; JRST CHKBDC + MOVE B,(TP) + SKIPN IOINS(B) ; MAKE SURE IT IS OPEN + PUSHJ P,OPENIT ; IF ZERO IOINS GO OPEN IT + SUB TP,[2,,2] + POP P, ; CLEAN UP STACKS + POPJ P, + +CHKT: ASCIZ /READ/ + ASCII /PRINT/ + ASCII /READB/ + +1 + +CHKBDC: POP P,E + MOVNI D,2 + IMULI D,1(E) + HLRE 0,AB + CAMLE 0,D ; SEE IF THIS WAS HIS ARG OF DEFAULT + JRST BADCHN + JUMPE E,WTYP1 + JRST WTYP2 + + ; FUNCTIONS READSTRING AND PRINTSTRING WORK LIKE READB AND PRINTB, +; THAT IS THEY READ INTO AND OUT OF STRINGS. IN ADDITION BOTH ACCEPT +; AN ADDITIONAL ARGUMENT WHICH IS THE NUMBER OF CHARS TO READ OR PRINT, IF +; IT IS DESIRED FOR THIS TO BE DIFFERENT THAN THE LENGTH OF THE STRING. + +; FORMAT IS +; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN + +; FORMAT FOR PRINTSTRING IS + +; THESE WERE CODED 9/16/73 BY NEAL D. RYAN + + MFUNCTION RSTRNG,SUBR,READSTRING + + ENTRY + PUSH P,[0] ; FLAG TO INDICATE READING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-9] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 4 ARGS + JRST STRIO1 + + MFUNCTION PSTRNG,SUBR,PRINTSTRING + + ENTRY + PUSH P,[1] ; FLAG TO INDICATE WRITING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-7] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 3 ARGS + +STRIO1: PUSH TP,[0] ; SAVE SLOT ON STACK + PUSH TP,[0] + GETYP 0,(AB) + CAIE 0,TCHSTR ; MAKE SURE WE GOT STRING + JRST WTYP1 + HRRZ 0,(AB) ; CHECK FOR EMPTY STRING + SKIPN (P) + JUMPE 0,MTSTRN + HLRE 0,AB + CAML 0,[-2] ; WAS A CHANNEL GIVEN + JRST STRIO2 + GETYP 0,2(AB) + SKIPN (P) ; SKIP IF PRINT + JRST TESTIN + CAIN 0,TTP ; SEE IF FLATSIZE HACK + JRST STRIO9 +TESTIN: CAIE 0,TCHAN + JRST WTYP2 ; SECOND ARG NOT CHANNEL + MOVE B,3(AB) + HRRZ B,-2(B) + MOVNI E,1 ; CHECKING FOR GOOD DIRECTION + TRNE B,C.READ ; SKIP IF NOT READ + MOVEI E,0 + TRNE B,C.PRIN ; SKIP IF NOT PRINT + MOVEI E,1 + CAME E,(P) + JRST WRONGD ; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE +STRIO9: PUSH TP,2(AB) + PUSH TP,3(AB) ; PUSH ON CHANNEL + JRST STRIO3 +STRIO2: MOVE B,IMQUOTE INCHAN + MOVSI A,TCHAN + SKIPE (P) + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + GETYP 0,A + SKIPN (P) ; SKIP IF PRINTSTRING + JRST TESTI2 + CAIN 0,TTP ; SKIP IF NOT FLATSIZE HACK + JRST STRIO8 +TESTI2: CAIE 0,TCHAN + JRST BADCHN ; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL +STRIO8: PUSH TP,A + PUSH TP,B +STRIO3: MOVE B,(TP) ; GET CHANNEL + SKIPN E,IOINS(B) + PUSHJ P,OPENIT ; IF NOT GO OPEN + MOVE E,IOINS(B) + CAMN E,[JRST CHNCLS] + JRST CHNCLS ; CHECK TO SEE THAT CHANNEL ISNT ALREADY CLOSED +STRIO4: HLRE 0,AB + CAML 0,[-4] + JRST STRIO5 ; NO COUNT TO WORRY ABOUT + GETYP 0,4(AB) + MOVE E,4(AB) + MOVE C,5(AB) + CAIE 0,TCHSTR + CAIN 0,TFIX ; BETTER BE A FIXED NUMBER + JRST .+2 + JRST WTYP3 + HRRZ D,(AB) ; GET ACTUAL STRING LENGTH + CAIN 0,TFIX + JRST .+7 + SKIPE (P) ; TEST FOR WRITING + JRST .-7 ; IF WRITING WE GOT TROUBLE + PUSH P,D ; ACTUAL STRING LENGTH + MOVEM E,(TB) ; STUFF HIS FUNNY DELIM STRING + MOVEM C,1(TB) + JRST STRIO7 + CAML D,C ; MAKE SURE THE STRING IS LONG ENOUGH + JRST .+2 ; WIN + ERRUUO EQUOTE COUNT-GREATER-THAN-STRING-SIZE + PUSH P,C ; PUSH ON MAX COUNT + JRST STRIO7 +STRIO5: +STRIO6: HRRZ C,(AB) ; GET CHAR COUNT + PUSH P,C ; AND PUSH IT ON STACK AS NO MAX COUNT GIVEN +STRIO7: HLRE 0,AB + CAML 0,[-6] + JRST .+6 + MOVE B,(TP) ; GET THE CHANNEL + MOVE 0,6(AB) + MOVEM 0,EOFCND-1(B) ; STUFF IN SLOT IN CHAN + MOVE 0,7(AB) + MOVEM 0,EOFCND(B) + PUSH TP,(AB) ; PUSH ON STRING + PUSH TP,1(AB) + PUSH P,[0] ; PUSH ON CURRENT COUNT OF CHARS DONE + MOVE 0,-2(P) ; GET READ OR WRITE FLAG + JUMPN 0,OUTLOP ; GO WRITE STUFF + + MOVE B,-2(TP) ; GET CHANNEL + PUSHJ P,GRB ; MAKE SURE WE HAVE BUFF + SKIPGE A,LSTCH(B) ; CHECK FOR EOF ALREADY READ PREVIOUSLY + JRST SRDOEF ; GO DOES HIS EOF HACKING +INLOP: INTGO + MOVE B,-2(TP) ; GET CHANNEL + MOVE C,-1(P) ; MAX COUNT + CAMG C,(P) ; COMPARE WITH COUNT DONE + JRST STREOF ; WE HAVE FINISHED + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,INEOF ; EOF HIT + MOVE C,1(TB) + HRRZ E,(TB) ; DO WE HAVE A STRING TO WORRY US? + SOJL E,INLNT ; GO FINISH STUFFING + ILDB D,C + CAME D,A + JRST .-3 + JRST INEOF +INLNT: IDPB A,(TP) ; STUFF IN STRING + SOS -1(TP) ; DECREMENT STRING COUNT + AOS (P) ; INCREMENT CHAR COUNT + JRST INLOP + +INEOF: SKIPE C,LSTCH(B) ; IS THIS AN ! AND IS THERE A CHAR THERE + JRST .+3 ; YES + MOVEM A,LSTCH(B) ; NO SAVE THE CHAR + JRST .+3 + ADDI C,400000 + MOVEM C,LSTCH(B) + MOVSI C,200000 + IORM C,LSTCH(B) + HRRZ C,DIRECT-1(B) ; GET THE TYPE OF CHAN + CAIN C,5 ; IS IT READB? + JRST .+3 + SOS ACCESS(B) ; FIX UP ACCESS FOR READ CHANNEL + JRST STREOF ; AND THATS IT + HRRZ C,ACCESS-1(B) ; FOR A READB ITS WORSE + MOVEI D,5 + SKIPG C + HRRM D,ACCESS-1(B) ; CHANGE A 0 TO A FIVE + SOS C,ACCESS-1(B) + CAMN C,[TFIX,,0] + SOS ACCESS(B) ; AND SOS THE WORD COUNT MAYBE + JRST STREOF + +SRDOEF: SETZM LSTCH(B) ; IN CASE OF -1, FLUSH IT + AOJE A,INLOP ; SKIP OVER -1 ON PTY'S + SUB TP,[6,,6] + SUB P,[3,,3] ; POP JUNK OFF STACKS + PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) ; WHAT WE NEED TO EVAL + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOOSING CHANNEL + MCALL 1,EVAL ; EVAL HIS EOF JUNK + JRST FINIS + +OUTLOP: MOVE B,-2(TP) +OUTLP1: INTGO + MOVE A,-3(TP) ; GET CHANNEL + MOVE B,-2(TP) + MOVE C,-1(P) ; MAX COUNT TO DO + CAMG C,(P) ; HAVE WE DONE ENOUGH + JRST STREOF + ILDB D,(TP) ; GET THE CHAR + SOS -1(TP) ; SUBTRACT FROM STRING LENGTH + AOS (P) ; INC COUNT OF CHARS DONE + PUSHJ P,CPCH1 ; GO STUFF CHAR + JRST OUTLP1 + +STREOF: MOVE A,$TFIX + POP P,B ; RETURN THE LOOSER A COUNT OF WHAT WAS DONE + SUB P,[2,,2] + SUB TP,[6,,6] + JRST FINIS + + +GWB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A WRITE BUFFER ON PRINTB CHAN + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVSI A,TWORD+.VECT. + MOVEM A,BUFLNT(B) + SETOM (B) + MOVEI C,1(B) + HRLI C,(B) + BLT C,BUFLNT-1(B) + MOVEI C,-1(B) + HRLI C,010700 + MOVE B,(TP) + MOVEI 0,C.BUF + IORM 0,-2(B) + MOVEM C,BUFSTR(B) + MOVE C,[TCHSTR,,BUFLNT*5] + MOVEM C,BUFSTR-1(B) + SUB TP,[2,,2] + POPJ P, + + +GRB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A READ BUFFER + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVEI C,BUFLNT-1(B) + POP TP,B + MOVEI 0,C.BUF + IORM 0,-2(B) + HRLI C,010700 + MOVEM C,BUFSTR(B) + MOVSI C,TCHSTR + MOVEM C,BUFSTR-1(B) + SUB TP,[1,,1] + POPJ P, + +MTSTRN: ERRUUO EQUOTE EMPTY-STRING + + ; INPUT UNBUFFERING ROUTINE. THIS DOES THE CHARACTER UNBUFFERING +; FOR INPUT. THE OPEN ROUTINE SETUPS A PUSHJ P, TO +; THIS ROUTINE AS THE IOINS FOR A CHANNEL OPEN TO A NON-TTY DEVICE. + +; H. BRODIE 7/19/72 + +; CALLING SEQ: +; PUSHJ P,GETCHR +; B/ AOBJN PNTR TO CHANNEL VECTOR +; RETURNS NEXT CHARACTER IN AC A. +; ON ENCOUNTERING EITHER ^C OR NUL(^@) IT ASSUMES EOF AND +; TRANSMITS ONLY ^C ON SUCCESSIVE CALLS + + +GETCHR: +; FIRST GRAB THE BUFFER +; GETYP A,BUFSTR-1(B) ; GET TYPE WORD +; CAIN A,TCHSTR ; SKIPS IF NOT CHSTR (I.E. IF BAD BUFFER) +; JRST GTGBUF ; IS GOOD BUFFER...SKIP ERROR RETURN +GTGBUF: HRRZ A,BUFSTR-1(B) ; GET LENGTH OF STRING + SOJGE A,GTGCHR ; JUMP IF STILL MORE + +; HERE IF THE BUFFER WAS EXHAUSTED (BYTE PNTR POINTS INTO DOPE WDS) +; GENERATE AN .IOT POINTER +;FIRST SAVE C AND D AS I WILL CLOBBER THEM +NEWBUF: PUSH P,C + PUSH P,D +IFN ITS,[ + LDB C,[600,,STATUS(B)] ; GET TYPE + CAIG C,2 ; SKIP IF NOT TTY +] +IFE ITS,[ + SKIPE BUFRIN(B) +] + JRST GETTTY ; GET A TTY BUFFER + + PUSHJ P,PGBUFI ; RE-FILL BUFFER + +IFE ITS, MOVEI C,-1 + JUMPGE A,BUFGOO ;SKIPS IF IOT COMPLETED...FIX UP CHANNEL + MOVEI C,1 ; MAKE SURE LAST EOF REALLY ENDS IT + ANDCAM C,-1(A) + MOVSI C,014000 ; GET A ^C + MOVEM C,(A) ;FAKE AN EOF + +IFE ITS,[ + HLRE C,A ; HOW MUCH LEFT + ADDI C,BUFLNT ; # OF WORDS TO C + IMULI C,5 ; TO CHARS + MOVE A,-2(B) ; GET BITS + TRNE A,C.BIN ; CAN'T HELP A BINARY CHANNEL + JRST BUFGOO + MOVE A,CHANNO(B) + PUSH P,B + PUSH P,D + PUSH P,C + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + MOVE B,[2,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + POP P,C + CAIE D,7 ; SEVEN BIT BYTES? + JRST BUFGO1 ; NO, DONT HACK + MOVE D,C + IDIVI B,5 ; C IS NUMBER IN LAST WORD IF NOT EVEN + SKIPN C + MOVEI C,5 + ADDI C,-5(D) ; FIXUP C FOR WINNAGE +BUFGO1: POP P,D + POP P,B +] +; RESET THE BYTE POINTER IN THE CHANNEL. +; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D +BUFGOO: HRLI D,010700 ; GENERATE VIRGIN LH + SUBI D,1 + + MOVEM D,BUFSTR(B) ; STASH IN THE BUFFER BYTE PNTR SLOT +IFE ITS, HRRM C,LSTCH-1(B) ; SAVE IT + MOVEI A,BUFLNT*5-1 +BUFROK: POP P,D ;RESTORE D + POP P,C ;RESTORE C + + +; HERE IF THERE ARE CHARS IN BUFFER +GTGCHR: HRRM A,BUFSTR-1(B) + ILDB A,BUFSTR(B) ; GET A CHAR FROM BUFFER + +IFN ITS,[ + CAIE A,3 ; EOF? + POPJ P, ; AND RETURN + LDB A,[600,,STATUS(B)] ; CHECK FOR TTY + CAILE A,2 ; SKIP IF TTY +] +IFE ITS,[ + PUSH P,0 + HRRZ 0,LSTCH-1(B) + SOJL 0,.+4 + HRRM 0,LSTCH-1(B) + POP P,0 + POPJ P, + + POP P,0 + MOVSI A,-1 + SKIPN BUFRIN(B) +] + JRST .+3 +RETEO1: HRRI A,3 + POPJ P, + + HRRZ A,BUFSTR(B) ; SEE IF RSUBR START BIT IS ON + HRRZ A,(A) + TRNN A,1 + MOVSI A,-1 + JRST RETEO1 + +IFN ITS,[ +PGBUFO: +PGBUFI: +] +IFE ITS,[ +PGBUFO: SKIPA D,[SOUT] +PGBUFI: MOVE D,[SIN] +] + SKIPGE A,BUFSTR(B) ; POINT TO CURRENT BUFFER POSIT + SUBI A,1 ; FOR 440700 AND 010700 START + SUBI A,BUFLNT-1 ; CALCULATE PNTR TO BEG OF BUFFER + HRLI A,-BUFLNT ; IOT (AOBJN) PNTR IN A + MOVSI C,004400 +IFN ITS,[ +PGBIOO: +PGBIOI: MOVE D,A ; COPY FOR LATER + MOVSI C,TUVEC ; PREPARE TO HANDDLE INTS + MOVE PVP,PVSTOR+1 + MOVEM C,DSTO(PVP) + MOVEM C,ASTO(PVP) + MOVSI C,TCHAN + MOVEM C,BSTO(PVP) + +; BUILD .IOT INSTR + MOVE C,CHANNO(B) ; CHANNEL NUMBER IN C + ROT C,23. ; MOVE INTO AC FIELD + IOR C,[.IOT 0,A] ; IOR IN SKELETON .IOT + +; DO THE .IOT + ENABLE ; ALLOW INTS + XCT C ; EXECUTE THE .IOT INSTR + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM ASTO(PVP) + SETZM DSTO(PVP) + POPJ P, +] + +IFE ITS,[ +PGBIOT: PUSH P,D + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,C + HRRZS (P) + HRRI C,-1(A) ; POINT TO BUFFER + HLRE D,A ; XTRA POINTER + MOVNS D + HRLI D,TCHSTR + MOVE PVP,PVSTOR+1 + MOVEM D,BSTO(PVP) + MOVE D,[PUSHJ P,FIXACS] + MOVEM D,ONINT + MOVSI D,TUVEC + MOVEM D,DSTO(PVP) + MOVE D,A + MOVE A,CHANNO(B) ; FILE JFN + MOVE B,C + HLRE C,D ; - COUNT TO C + SKIPE (P) + MOVN C,(P) ; REAL DESIRED COUNT + SUB P,[1,,1] + ENABLE + XCT (P) ; DO IT TO IT + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM DSTO(PVP) + SETZM ONINT + MOVEI A,1(B) + MOVE B,(TP) + SUB TP,[2,,2] + SUB P,[1,,1] + JUMPGE C,CPOPJ ; NO EOF YET + HRLI A,(C) ; LOOK LIKE AN AOBJN PNTR + POPJ P, + +FIXACS: PUSH P,PVP + MOVE PVP,PVSTOR+1 + MOVNS C + HRRM C,BSTO(PVP) + MOVNS C + POP P,PVP + POPJ P, + +PGBIOO: SKIPA D,[SOUT] +PGBIOI: MOVE D,[SIN] + HRLI C,004400 + JRST PGBIOT +DOIOTO: PUSH P,[SOUT] +DOIOTC: PUSH P,B + PUSH P,C + EXCH A,B + MOVE A,CHANNO(A) + HLRE C,B + HRLI B,444400 + XCT -2(P) + HRL B,C + MOVE A,B +DOIOTE: POP P,C + POP P,B + SUB P,[1,,1] + POPJ P, +DOIOTI: PUSH P,[SIN] + JRST DOIOTC +] + +; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE + +PUTCHR: PUSH P,A + GETYP A,BUFSTR-1(B) ; CHECK TYPE OF ARG + CAIE A,TCHSTR ; MUST BE STRING + JRST BDCHAN + + HRRZ A,BUFSTR-1(B) ; GET CHAR COUNT + JUMPE A,REBUFF ; PREV RESET BUFF, UNDO SAME + +PUTCH1: POP P,A ; RESTORE CHAR + CAMN A,[-1] ; SPECIAL HACK? + JRST PUTCH2 ; YES GO HANDLE + IDPB A,BUFSTR(B) ; STUFF IT +PUTCH3: SOS A,BUFSTR-1(B) ; COUNT DOWN STRING + TRNE A,-1 ; SKIP IF FULL + POPJ P, + +; HERE TO FLUSH OUT A BUFFER + + PUSH P,C + PUSH P,D + PUSHJ P,PGBUFO ; SETUP AND DO IOT + HRLI D,010700 ; POINT INTO BUFFER + SUBI D,1 + MOVEM D,BUFSTR(B) ; STORE IT + MOVEI A,BUFLNT*5 ; RESET COUNT + HRRM A,BUFSTR-1(B) + POP P,D + POP P,C + POPJ P, + +;HERE TO DA ^C AND TURN ON MAGIC BIT + +PUTCH2: MOVEI A,3 + IDPB A,BUFSTR(B) ; ZAP OUT THE ^C + MOVEI A,1 ; GET BIT +IFE ITS,[ + PUSH P,C + HRRZ C,BUFSTR(B) + IORM A,(C) + POP P,C +] +IFN ITS,[ + IORM A,@BUFSTR(B) ; ON GOES THE BIT +] + JRST PUTCH3 + +; RESET A FUNNY BUF + +REBUFF: MOVEI A,BUFLNT*5 ; 1ST COUNT + HRRM A,BUFSTR-1(B) + HRRZ A,BUFSTR(B) ; NOW POINTER + SUBI A,BUFLNT+1 + HRLI A,010700 + MOVEM A,BUFSTR(B) ; STORE BACK + JRST PUTCH1 + + +; HERE TO FLUSH FINAL BUFFER + +BFCLOS: HRRZ C,-2(B) ; THIS BUFFER FLUSHER THE WORK OF NDR + MOVEI A,0 + TRNE C,C.TTY + POPJ P, + TRNE C,C.DISK + MOVEI A,1 + PUSH P,A ; SAVE THE RESULT OF OUR TEST + JUMPN A,BFCLNN ; DONT HAVE TO CHECK NET STATE + PUSH TP,$TCHAN + PUSH TP,B ; SAVE CHANNEL + PUSHJ P,INSTAT ; GET CURRENT NETWORK STATE + MOVE A,(B) ; GET FIRST ELEMENT OF STATE UVECTOR WHICH IS CUR STATE + POP TP,B ; RESTORE B + POP TP, + CAIE A,5 ; IS NET IN OPEN STATE? + CAIN A,6 ; OR ELSE IS IT IN RFNM WAIT STATE + JRST BFCLNN ; IF SO TO THE IOT + POP P, ; ELSE FLUSH CRUFT AND DONT IOT + POPJ P, ; RETURN DOING NO IOT +BFCLNN: MOVEI C,BUFLNT*5 ; NEW BUFFER FLUSHER BY NDR + HRRZ D,BUFSTR-1(B) ; SO THAT NET ALSO WORKS RIGHT + SUBI C,(D) ; GET NUMBER OF CHARS + IDIVI C,5 ; NUMBER OF FULL WORDS AND REST + PUSH P,D ; SAVE NUMBER OF ODD CHARS + SKIPGE A,BUFSTR(B) ; GET CURRENT BUF POSITION + SUBI A,1 ; FIX FOR 440700 BYTE POINTER +IFE ITS,[ + HRRO D,A + PUSH P,(D) +] +IFN ITS,[ + PUSH P,(A) ; SAVE THE ODD WORD OF BUFFER +] + MOVEI D,BUFLNT + SUBI D,(C) + SKIPE -1(P) + SUBI A,1 + ADDI D,1(A) ; FIX UP FOR POSSIBLE ODD CHARS + PUSH TP,$TUVEC + PUSH TP,D ; PUSH THE DOPE VECTOR ONTO THE STACK + JUMPE C,BFCLSR ; IN CASE THERE ARE NO FULL WORDS TO DO + HRL A,C + TLO A,400000 + MOVE E,[SETZ BUFLNT(A)] + SUBI E,(C) ; FIX UP FOR BACKWARDS BLT + POP A,@E ; AMAZING GRACE + TLNE A,377777 + JRST .-2 + HRRO A,D ; SET UP AOBJN POINTER + SUBI A,(C) + TLC A,-1(C) + PUSHJ P,PGBIOO ; DO THE IOT OF ALL THE FULL WORDS +BFCLSR: HRRO A,(TP) ; GET IOT PTR FOR REST OF JUNK + SUBI A,1 ; POINT TO WORD BEFORE DOPE WORDS + POP P,0 ; GET BACK ODD WORD + POP P,C ; GET BACK ODD CHAR COUNT + POP P,D ; FLAG FOR NET OR DSK + JUMPN D,BFCDSK ; GO FINISH OFF DSK + JUMPE C,BFCLSD ; IF NO ODD CHARS FINISH UP + MOVEI D,7 + IMULI D,(C) ; FIND NO OF BITS TO SHIFT + LSH 0,-43(D) ; SHIFT BITS TO RIGHT PLACE + MOVEM 0,(A) ; STORE IN STRING + SUBI C,5 ; HOW MANY CHAR POSITIONS TO SKIP + MOVNI C,(C) ; MAKE C POSITIVE + LSH C,17 + TLC A,(C) ; MUNG THE AOBJN POINTER TO KLUDGE + PUSHJ P,PGBIOO ; DO IOT OF ODD CHARS + MOVEI C,0 +BFCLSD: HRRZ A,(TP) ; GET PTR TO DOPE WORD + SUBI A,BUFLNT+1 + JUMPLE C,.+3 + SKIPE ACCESS(B) + MOVEM 0,1(A) ; LAST WORD BACK IN BFR + HRLI A,010700 ; AOBJN POINTER TO FIRST OF BUFFER + MOVEM A,BUFSTR(B) + MOVEI A,BUFLNT*5 + HRRM A,BUFSTR-1(B) + SKIPN ACCESS(B) + JRST BFCLSY + JUMPL C,BFCLSY + JUMPE C,BFCLSZ + IBP BUFSTR(B) + SOS BUFSTR-1(B) + SOJG C,.-2 +BFCLSY: MOVE A,CHANNO(B) + MOVE C,B +IFE ITS,[ + RFPTR + FATAL RFPTR FAILED + HRRZ F,LSTCH-1(C) ; PREVIOUS HIGH + MOVE G,C ; SAVE CHANNEL + MOVE C,B + CAML F,B + MOVE C,F + MOVE F,B + HRLI A,400000 + CLOSF + JFCL + MOVNI B,1 + HRLI A,12 + CHFDB + MOVE B,STATUS(G) + ANDI A,-1 + OPENF + FATAL OPENF LOSES + MOVE C,F + IDIVI C,5 + MOVE B,C + SFPTR + FATAL SFPTR FAILED + MOVE B,G +] +IFN ITS,[ + DOTCAL RFPNTR,[A,[2000,,B]] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + SUBI B,1 + DOTCAL ACCESS,[A,B] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + MOVE B,C +] +BFCLSZ: SUB TP,[2,,2] + POPJ P, + +BFCDSK: TRZ 0,1 + PUSH P,C +IFE ITS,[ + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,0 ; WORD OF CHARS + MOVE A,CHANNO(B) + MOVEI B,7 ; MAKE BYTE SIZE 7 + SFBSZ + JFCL + HRROI B,(P) + MOVNS C + SKIPE C + SOUT + MOVE B,(TP) + SUB P,[1,,1] + SUB TP,[2,,2] +] +IFN ITS,[ + MOVE D,[440700,,A] + DOTCAL SIOT,[CHANNO(B),D,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + POP P,C + JUMPN C,BFCLSD +BFCDS1: MOVNI C,1 ; INDICATE NOT TOHACK BUFFER + JRST BFCLSD + +BFCLS1: HRRZ C,DIRECT-1(B) + MOVSI 0,(JFCL) + CAIE C,6 + MOVE 0,[AOS ACCESS(B)] + PUSH P,0 + HRRZ C,BUFSTR-1(B) + IDIVI C,5 + JUMPE D,BCLS11 + MOVEI A,40 ; PAD WITH SPACES + PUSHJ P,PUTCHR + XCT (P) ; AOS ACCESS IF NECESSARY + SOJG D,.-3 ; TO END OF WORD +BCLS11: POP P,0 + HLLZS ACCESS-1(B) + HRRZ C,BUFSTR-1(B) + CAIE C,BUFLNT*5 + PUSHJ P,BFCLOS + POPJ P, + + +; HERE TO GET A TTY BUFFER + +GETTTY: SKIPN C,EXBUFR(B) ; SKIP IF BUFFERS BACKED UP + JRST TTYWAI + HRRZ D,(C) ; CDR THE LIST + GETYP A,(C) ; CHECK TYPE + CAIE A,TDEFER ; MUST BE DEFERRED + JRST BDCHAN + MOVE C,1(C) ; GET DEFERRED GOODIE + GETYP A,(C) ; BETTER BE CHSTR + CAIE A,TCHSTR + JRST BDCHAN + MOVE A,(C) ; GET FULL TYPE WORD + MOVE C,1(C) + MOVEM D,EXBUFR(B) ; STORE CDR'D LIST + MOVEM A,BUFSTR-1(B) ; MAKE CURRENT BUFFER + MOVEM C,BUFSTR(B) + HRRM A,LSTCH-1(B) + SOJA A,BUFROK + +TTYWAI: PUSHJ P,TTYBLK ; BLOCKED FOR TTY I/O + JRST GETTTY ; SHOULD ONLY RETURN HAPPILY + + ;INTERNAL DEVICE READ ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT, +;CHECKS THAT THE RETURNED VALUE IS OF TYPE CHARACTER, +;AND RETURNS THAT AS THE NEXT CHARACTER IN THE "FILE" + +;H. BRODIE 8/31/72 + +GTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,INTFCN-1(B) + PUSH TP,INTFCN(B) + MCALL 1,APPLY + GETYP A,A + CAIE A,TCHRS + JRST BADRET + MOVE A,B +INTRET: POP P,0 ;RESTORE THE ACS + POP P,E + POP P,D + POP P,C + POP TP,B ;RESTORE THE CHANNEL + SUB TP,[1,,1] ;FLUSH $TCHAN...WE DON'T NEED IT + POPJ P, + + +BADRET: ERRUUO EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT + +;INTERNAL DEVICE PRINT ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,(FUNCTION, SUBR, OR RSUBR) +;TO THE CURRENT CHARACTER BEING "PRINTED". + +PTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,INTFCN-1(B) ;PUSH TYPE OF GIVEN OBJ + PUSH TP,INTFCN(B) ;PUSH THE SUPPLIED FUNCTION (OR SUBR ETC.) + PUSH TP,$TCHRS ;PUSH THE TYPE "CHARACTER" + PUSH TP,A ;PUSH THE CHAR + MCALL 2,APPLY ;APPLY THE FUNCTION TO THE CHAR + JRST INTRET + + + +; ROUTINE TO FLUSH OUT A PRINT BUFFER + +MFUNCTION BUFOUT,SUBR + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + + MOVE B,1(AB) +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; GET DIR NAME +; JFCL +; CAMN B,[ASCII /PRINT/] +; JRST .+3 +; CAME B,[+1] +; JRST WRONGD +; TRNE B,1 ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN B,1 ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] + HRRZ 0,-2(B) + TRNN 0,C.PRIN + JRST WRONGD +; TRNE 0,C.BIN ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN 0,C.BIN ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] +; MOVE B,1(AB) +; GETYP 0,BUFSTR-1(B) +; CAIN 0,TCHSTR +; SKIPN A,BUFSTR(B) ; BYTE POINTER? +; JRST BFIN1 +; HRRZ C,BUFSTR-1(B) ; CHARS LEFT +; IDIVI C,5 ; MULTIPLE OF 5? +; JUMPE D,BFIN2 ; YUP NO EXTRAS + +; MOVEI A,40 ; PAD WITH SPACES +; PUSHJ P,PUTCHR ; OUT IT GOES +; XCT (P) ; MAYBE BUMP ACCESS +; SOJG D,.-3 ; FILL + +BFIN2: PUSHJ P,BFCLOS ; WRITE OUT BUFFER + +BFIN1: MOVSI A,TCHAN + JRST FINIS + + + +; FUNCTION TO GET THE FILE LENGTH OF A READ CHANNEL + +MFUNCTION FILLNT,SUBR,[FILE-LENGTH] + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) + PUSHJ P,CFILLE + JRST FINIS + +CFILLE: +IFN 0,[ + MOVEI B,DIRECT-1(B) ; GET CHANNEL TYPE + PUSHJ P,CHRWRD + JFCL + CAME B,[ASCIZ /READ/] + JRST .+3 + PUSH P,[5] ; MULTIPLICATIVE FACTOR FOR READ + JRST .+4 + CAME B,[ASCII /READB/] + JRST WRONGD + PUSH P,[1] ; MULTIPLICATIVE FACTOR FOR READ +] + MOVE C,-2(B) ; GET BITS + MOVEI D,5 ; ASSUME ASCII + TRNE C,C.BIN ; SKIP IF NOT BINARY + MOVEI D,1 + PUSH P,D + MOVE C,B +IFN ITS,[ + .CALL FILL1 + JRST FILLOS ; GIVE HIM A NICE FALSE +] +IFE ITS,[ + MOVE A,CHANNO(C) + PUSH P,[0] + MOVEI C,(P) + MOVE B,[1,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,(P)] ; GET BYTE SIZE + JUMPN D,.+2 + MOVEI D,36. ; HANDLE "0" BYTE SIZE + SUB P,[1,,1] + SIZEF + JRST FILLOS +] + POP P,C +IFN ITS, IMUL B,C +IFE ITS,[ + CAIN C,5 + CAIE D,7 + JRST NOTASC +] +YESASC: MOVE A,$TFIX + POPJ P, + +IFE ITS,[ +NOTASC: MOVEI 0,36. + IDIV 0,D ; BYTES PER WORD + IDIVM B,0 + IMUL C,0 + MOVE B,C + JRST YESASC +] + +IFN ITS,[ +FILL1: SETZ ; BLOCK FOR .CALL TO FILLEN + SIXBIT /FILLEN/ + CHANNO (C) + SETZM B + +FILLOS: MOVE A,CHANNO(C) + MOVE B,[.STATUS A] ;MAKE A CALL TO STATUS TO FIND REASON + LSH A,23. ;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE + IOR B,A ;FIX UP .STATUS + XCT B + MOVE B,C + PUSHJ P,GFALS + POP P, + POPJ P, +] +IFE ITS,[ +FILLOS: MOVE B,C + PUSHJ P,TGFALS + POP P, + POPJ P, +] + + + ; MCHAN LOW-LEVEL I/O GARBAGE (PDL)-ORIGINAL (LIM)-ADDITIONS + +;CALLING ROUTINE: AC-A contains pointer to block of SIXBIT data +; DIR ? DEV ? FNM1 ? FNM2 ? SNM +;RETURNED VALUE : AC-A = +IFN ITS,[ +MOPEN: PUSH P,B + PUSH P,C + MOVE C,FRSTCH ; skip gc and tty channels +CNLP: DOTCAL STATUS,[C,[2000,,B]] + .LOSE %LSFIL + ANDI B,77 + JUMPE B,CHNFND ; found unused channel ? + ADDI C,1 ; try another channel + CAIG C,17 ; are all the channels used ? + JRST CNLP + SETO C, ; all channels used so C = -1 + JRST CHNFUL +CHNFND: MOVEI B,(C) + HLL B,(A) ; M.DIR slot + DOTCAL OPEN,[B,1(A),2(A),3(A),4(A)] + SKIPA + AOS -2(P) ; successful skip when returning +CHNFUL: MOVE A,C + POP P,C + POP P,B + POPJ P, + +MIOT: DOTCAL IOT,[A,B] + JFCL + POPJ P, + +MCLOSE: DOTCAL CLOSE,[A] + JFCL + POPJ P, + +IMPURE + +FRSTCH: 1 + +PURE +] + ;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O + +NOTNET: +BADCHN: ERRUUO EQUOTE BAD-CHANNEL +BDCHAN: ERRUUO EQUOTE BAD-INPUT-BUFFER + +WRONGD: ERRUUO EQUOTE WRONG-DIRECTION-CHANNEL + +CHNCLS: ERRUUO EQUOTE CHANNEL-CLOSED + +BAD6: ERRUUO EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME + +DISLOS: MOVE C,$TCHSTR + MOVE D,CHQUOTE [DISPLAY NOT AVAILABLE] + PUSHJ P,INCONS + MOVSI A,TFALSE + JRST OPNRET + +NOCHAN: ERRUUO EQUOTE ITS-CHANNELS-EXHAUSTED + +MODE1: 232020,,202020 +MODE2: 232023,,330320 + +END + + \ No newline at end of file diff --git a//fopen.mid.56 b//fopen.mid.56 new file mode 100644 index 0000000..a7512e3 --- /dev/null +++ b//fopen.mid.56 @@ -0,0 +1,4686 @@ +TITLE OPEN - CHANNEL OPENER FOR MUDDLE + +RELOCATABLE + +;C. REEVE MARCH 1973 + +.INSRT MUDDLE > + +SYSQ + +FNAMS==1 +F==E+1 +G==F+1 + +IFE ITS,[ +IF1, .INSRT STENEX > +] +;THIS PROGRAM HAS ENTRIES: FOPEN, FCLOSE, RENAME, READB, PRINTB, FILECOPY, READSTRING, +; PRINTSTRING, NETSTATE, NETACC, NETS, ACCESS, AND FILE-EXISTS? + +;THESE SUBROUTINES HANDLE I/O STREAMS FOR THE MUDDLE SYSTEM. + +; FOPEN - OPENS A FILE FOR EITHER READING OR WRITING. IT TAKES +; FIVE OPTINAL ARGUMENTS AS FOLLOWS: + +; FOPEN (,,,,) +; +; - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ + +; - FIRST FILE NAME. DEFAULT INPUT OR OUTPUT. + +; - SECOND FILE NAME. DEFAULT MUDDLE. + +; - DEVICE FROM WHICH TO OPEN. DEFAULT IS DSK. + +; - SYSTEM (DIRECTORY) NAME. DEFAULT UNAME. + +; FOPEN RETURNS AN OBJECT OF TYPE CHANNEL IF IT SUCCEEDS OTHERWISE NIL + + +; FCLOSE - CLOSES A FILE. TAKES A CHANNEL OBJECT AS ITS ARGUMENT. IT ALSO TAKES +; ACCESS - DOES A .ACCESS ON A CHARACTER BASIS FOR CHARACTER FILES + + +; A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION + +; CHANNO ;ITS I/O CHANNEL NUMBER. 0 MEANS NOT A REAL CHANNEL. +; DIRECT ;DIRECTION (EITHER READ OR PRINT) +; NAME1 ;FIRST NAME OF FILE AS OPENED. +; NAME2 ;SECOND NAME OF FILE +; DEVICE ;DEVICE UPON WHICH THE CHANNEL IS OPEN +; SNAME ;DIRECTORY NAME +; RNAME1 ;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS) +; RNAME2 ;REAL SECOND NAME +; RDEVIC ;REAL DEVICE +; RSNAME ;SYSTEM OR DIRECTORY NAME +; STATUS ;VARIOUS STATUS BITS +; IOINS ;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER +; ACCESS ;ACCESS POINTER FOR RAND ACCESS (OR USED FOR DISPLAY INFO) +; RADX ;RADIX FOR CHANNELS NUMBER CONVERSION + +; *** THE FOLLOWING FIELDS FOR OUTPUT ONLY *** +; LINLN ;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE +; CHRPOS ;CURRENT POSITION ON CURRENT LINE +; PAGLN ;LENGTH OF A PAGE +; LINPOS ;CURRENT LINE BEING WRITTEN ON + +; *** THE FOLLOWING FILEDS FOR INPUT ONLY *** +; EOFCND ;GETS EVALUATED ON EOF +; LSTCH ;BACKUP CHARACTER +; WAITNS ;FOR TTY INPUT, BECOMES A .SLEEP WHEN WAITING +; EXBUFR ;FOR TTY INPUT, CONTAINS A WAITING BUFFER LIST +; BUFSTR ;A CHARACTER STRING USED AS BUFFER FOR NON-TTY DEVICES + +; THIS DEFINES THE LENGTH OF THE NON-TTY BUFFER +BUFLNT==100 + +;THIS DEFINES BLOCK MODE BIT FOR OPENING +BLOCKM==2 ;DEFINED IN THE LEFT HALF +IMAGEM==4 + + +;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME + + CHANLNT==4 ;INITIAL CHANNEL LENGTH + +; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS +BUFRIN==-1 ;SPECIAL HACK SO LOSERS WON'T SEE TTY BUFFER +SCRPTO==-3 ;SPECIAL HACK FOR SCRIPT CHANNELS +PROCHN: + +IRP A,,[[CHANNO,FIX],[DIRECT,CHSTR] +[NAME1,CHSTR],[NAME2,CHSTR],[DEVICE,CHSTR],[SNAME,CHSTR] +[RNAME1,CHSTR],[RNAME2,CHSTR],[RDEVIC,CHSTR],[RSNAME,CHSTR] +[STATUS,FIX],[IOINS,FIX],[LINLN,FIX],[CHRPOS,FIX],[PAGLN,FIX],[LINPOS,FIX] +[ACCESS,FIX],[RADX,FIX],[BUFSTR,CHSTR]] + + IRP B,C,[A] + B==CHANLNT-3 + T!C,,0 + 0 + .ISTOP + TERMIN + CHANLNT==CHANLNT+2 +TERMIN + + +; EQUIVALANCES FOR CHANNELS + +EOFCND==LINLN +LSTCH==CHRPOS +WAITNS==PAGLN +EXBUFR==LINPOS +DISINF==BUFSTR ;DISPLAY INFO +INTFCN==BUFSTR ;FUNCTION (OR SUBR, OR RSUBR) TO BE APPLIED FOR INTERNAL CHNLS + + +;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS + +IRP A,,[IOIN2,ECHO,CHRCNT,ERASCH,KILLCH,BRKCH,ESCAP,SYSCHR,BRFCHR,BRFCH2,BYTPTR] +A==.IRPCNT +TERMIN + +EXTBFR==BYTPTR+1+<100./5> ;LENGTH OF ADD'L BUFFER + + + + +.GLOBAL IPNAME,MOPEN,MCLOSE,MIOT,ILOOKU,6TOCHS,ICLOS,OCLOS,RGPARS,RGPRS +.GLOBAL OPNCHN,CHMAK,READC,TYO,SYSCHR,BRFCHR,LSTCH,BRFCH2,EXTBFR +.GLOBAL CHRWRD,STRTO6,TTYBLK,WAITNS,EXBUFR,TTICHN,TTOCHN,GETCHR,IILIST +.GLOBAL CHANNO,STATUS,LINPOS,PAGLN,CHRPOS,LINLN,IOINS,ACCESS,ADDNUL +.GLOBAL DIRECT,DISINF,RADX,EOFCND,BUFSTR,MODE1,MODE2,GCHACK,GMTYO,INMTYO +.GLOBAL T.CHAN,NAME1,BFCLOS,DOIOTI,DOIOTO,DOACCS,NOTTY,DEMFLG,BYTDOP,TNXIN +.GLOBAL DISOPN,DISROP,DISCLS,DCHAR,DISLNL,DISPGL,INSTAT,MTYO,CIREST +.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP,N.CHNS +.GLOBAL REOPN,QUITTE,CHNL0,CHNL1,BUFRIN,IOIN2,IFALSE,GFALS,IDVAL,PVSTOR,SPSTOR +.GLOBAL BADCHN,WRONGD,CHNCLS,GSNAME,GIBLOK,APLQ,NAPT,ICONS,INCONS,IBLOCK,IDVAL1 +.GLOBAL GRB,GWB,R1CHAR,W1CHAR,BFCLS1,TTYOP2,MPOPJ,COMPER,R1C,W1C,WXCT,RXCT +.GLOBAL TMTNXS,TNXSTR,RDEVIC,CPCH1,RCYCHN,CGFALS,CISTNG,CFILLE,FRSTCH +.GLOBAL TGFALS,ONINT + +.VECT.==40000 + +; PAIR MOVING MACRO + +DEFINE PMOVEM A,B + MOVE 0,A + MOVEM 0,B + MOVE 0,A+1 + MOVEM 0,B+1 + TERMIN + +; DEFINITIONS OF THE OFFSETS INTO THE TP STACK FOR OPEN + +T.SPDL==0 ; SAVES P STACK BASE +T.DIR==2 ; CONTAINS DIRECTION AND MODE +T.NM1==4 ; NAME 1 OF FILE +T.NM2==6 ; NAME 2 OF FILE +T.DEV==10 ; DEVICE NAME +T.SNM==12 ; SNAME +T.XT==14 ; EXTRA CRUFT IF NECESSARY +T.CHAN==16 ; CHANNEL AS GENERATED + +; OFFSETS FROM PSTACK BASE (USED FOR OPENS, .RCHST AND .FDELES) + +S.DIR==0 ; CODE FOR DIRECTION 0-IN, 1-OUT, 2-BIN, 3-BOUT,4-DISPLAY + ; S.DIR(P) = ,, +IFN ITS,[ +S.DEV==1 ; SIXBIT DEVICE RIGHT JUSTIFIED +S.NM1==2 ; SIXBIT NAME1 +S.NM2==3 ; SIXBIT NAME2 +S.SNM==4 ; SIXBIT SNAME +S.X1==5 ; TEMPS +S.X2==6 +S.X3==7 +] + +IFE ITS,[ +S.DEV==1 +S.X1==2 +S.X2==3 +S.X3==4 +] + + +; FLAGS SPECIFYING STATE OF THE WORLD AT VARIOUS TIMES + +NOSTOR==400000 ; ON MEANS DONT BUILD NEW STRINGS +MSTNET==200000 ; ON MEANS ONLY THE "NET" DEVICE CAN WIN +SNSET==100000 ; FLAG, SNAME SUPPLIED +DVSET==040000 ; FLAG, DEV SUPPLIED +N2SET==020000 ; FLAG, NAME2 SET +N1SET==010000 ; FLAG, NAME1 SET +4ARG==004000 ; FLAG, CONSIDER ARGS TO BE 4 STRINGS + +RMT [EXPUNGE N1SET,N2SET,DVSET,SNSET,MSTNET,NOSTOR +] + +; TABLE OF LEGAL MODES + +MODES: IRP A,,[READ,PRINT,READB,PRINTB,PRINTO,PRINAO] + SIXBIT /A/ + TERMIN +NMODES==.-MODES + +MODCOD: 0?1?2?3?3?1 +; TABLE OF KNOWN DEVICES AND A POINTER TO THEIR OPENERS + +IFN ITS,[ +DEVSTB: IRP A,,[DSK,TTY,USR,STY,ST,NET,INT,PTP,PTR,UT,T,NUL] + SIXBIT /A/ ; DEVICE NAMES + TERMIN + +DEVS: IRP B,,[ODSK,OTTY,OUSR,OSTY,OSTY,ONET,OINT,OPTP,OPTP,OUTN,OTTY,ONUL] + SETZ B ; POINTERS + TERMIN +] + +IFE ITS,[ +DEVSTB: IRP A,,[PS,SS,SRC,DSK,TTY,INT,NET] + SIXBIT /A/ + TERMIN + +DEVS: IRP B,,[ODSK,ODSK,ODSK,ODSK,OTTY,OINT,ONET] + SETZ B + TERMIN +] +NDEVS==.-DEVS + + + +;SUBROUTINE TO DO OPENING BEGINS HERE + +MFUNCTION NFOPEN,SUBR,[OPEN-NR] + + JRST FOPEN1 + +MFUNCTION FOPEN,SUBR,[OPEN] + +FOPEN1: ENTRY + PUSHJ P,MAKCHN ;MAKE THE CHANNEL + PUSHJ P,OPNCH ;NOW OPEN IT + JUMPL B,FINIS + SUB D,[4,,4] ; TOP THE CHANNEL + MOVEM D,RCYCHN+1 ; RECYCLE DEAD CHANNEL + SETZM (D) ; ZAP IT + MOVEI C,1(D) + HRLI C,(D) + BLT C,CHANLNT-1(D) + JRST FINIS + +; SUBR TO JUST CREATE A CHANNEL + +IMFUNCTION CHANNEL,SUBR + + ENTRY + PUSHJ P,MAKCHN + MOVSI A,TCHAN + JRST FINIS + + + + +; THIS ROUTINE PARSES ARGUMENTS TO FOPEN ETC. AND BUILDS A CHANNEL BUT DOESN'T OPEN IT + +MAKCHN: PUSH TP,$TPDL + PUSH TP,P ; POINT AT CURRENT STACK BASE + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE READ + MOVEI E,10 ; SLOTS OF TP NEEDED + PUSH TP,[0] + SOJG E,.-1 + MOVEI E,0 + EXCH E,(P) ; GET RET ADDR IN E +IFE ITS, PUSH P,[0] +IRP ATM,,[DEV,NM1,NM2,SNM]MDF,,[DSK,INPUT,>,[ ]]TMDF,,[DSK,INPUT,MUD,[ ]] + MOVE B,IMQUOTE ATM +IFN ITS, PUSH P,E + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TCHSTR + JRST MAK!ATM + + MOVE A,$TCHSTR +IFN ITS, MOVE B,CHQUOTE MDF +IFE ITS, MOVE B,CHQUOTE TMDF +MAK!ATM: + MOVEM A,T.!ATM(TB) + MOVEM B,T.!ATM+1(TB) +IFN ITS,[ + POP P,E + PUSHJ P,STRTO6 ; RESULT LEFT ON P STACK AS DESIRED +] + TERMIN + PUSH TP,[0] ; PUSH SLOTS + PUSH TP,[0] + + PUSH P,[0] ; EXT SLOTS + PUSH P,[0] + PUSH P,[0] + PUSH P,E ; PUSH RETURN ADDRESS + MOVEI A,0 + + JUMPGE AB,MAKCH0 ; NO ARGS, ALREADY DONE + GETYP 0,(AB) ; 1ST ARG MUST BE A STRING + CAIE 0,TCHSTR + JRST WTYP1 + MOVE A,(AB) ; GET ARG + MOVE B,1(AB) + PUSHJ P,CHMODE ; CHECK OUT OPEN MODE + + PMOVEM (AB),T.DIR(TB) ; SAVE MODE NAME IN TEMPS + ADD AB,[2,,2] ; BUMP PAST DIRECTION + MOVEI A,0 + JUMPGE AB,MAKCH0 ; CHECK NAME1 BASED ON JUST MODE + + MOVEI 0,0 ; FLAGS PRESET + PUSHJ P,RGPARS ; PARSE THE STRING(S) + JRST TMA + +; ARGUMENTS PARSED, DO FINAL CHECKS AND BUILD CHANNEL + +MAKCH0: +IFN ITS,[ + MOVE C,T.SPDL+1(TB) + MOVE D,S.DEV(C) ; GET DEV +] +IFE ITS,[ + MOVE A,T.DEV(TB) + MOVE B,T.DEV+1(TB) + PUSHJ P,STRTO6 + POP P,D + HLRZS D + MOVE C,T.SPDL+1(TB) + MOVEM D,S.DEV(C) +] +IFE ITS, CAIE D,(SIXBIT /INT/);INTERNAL? +IFN ITS, CAME D,[SIXBIT /INT /] + JRST CHNET ; NO, MAYBE NET + SKIPN T.XT+1(TB) ; WAS FCN SUPPLIED? + JRST TFA + +; FALLS TROUGH IF SKIP + + + +; NOW BUILD THE CHANNEL + +ARGSOK: MOVEI A,CHANLNT ; GET LENGTH + SKIPN B,RCYCHN+1 ; RECYCLE? + PUSHJ P,GIBLOK ; GET A BLOCK OF STUFF + SETZM RCYCHN+1 + ADD B,[4,,4] ; HIDE THE TTY BUFFER SLOT + PUSH TP,$TCHAN + PUSH TP,B + HRLI C,PROCHN ; POINT TO PROTOTYPE + HRRI C,(B) ; AND NEW ONE + BLT C,CHANLN-5(B) ; CLOBBER + MOVSI C,TLIST ; TO GIVE HIM A CLEAN LIST OF SCRIPT CHANS + HLLM C,SCRPTO-1(B) + +; NOW BLT IN STUFF FROM THE STACK + + MOVSI C,T.DIR(TB) ; DIRECTION + HRRI C,DIRECT-1(B) + BLT C,SNAME(B) + MOVEI C,RNAME1-1(B) ; NOW "REAL" SLOTS + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + MOVE B,IMQUOTE MODE + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TFIX + JRST .+3 + MOVE B,(TP) + POPJ P, + + MOVE C,(TP) +IFE ITS,[ + ANDI B,403776 ; ONLY ALLOW NON-CRITICAL BITSS +] + HRRM B,-4(C) ; HIDE BITS + MOVE B,C + POPJ P, + +; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN + +CHNET: +IFN ITS,[ + CAME D,[SIXBIT /NET /] ; IS IT NET + JRST MAKCH1] +IFE ITS,[ + CAIE D,(SIXBIT /NET/) ; IS IT NET + JRST ARGSOK] + MOVSI D,TFIX ; FOR TYPES + MOVEI B,T.NM1(TB) ; MAKE SURE ALL ARE FIXED + PUSHJ P,CHFIX + MOVEI B,T.NM2(TB) + PUSHJ P,CHFIX + MOVEI B,T.SNM(TB) + LSH A,-1 ; SKIP DEV FLAG + PUSHJ P,CHFIX + JRST ARGSOK + +MAKCH1: TRNN A,MSTNET ; CANT HAVE SEEN A FIX + JRST ARGSOK + JRST WRONGT + +IFN ITS,[ +CHFIX: TRNE A,N1SET ; SKIP IF NOT SPECIFIED + JRST CHFIX1 + SETOM 1(B) ; SET TO -1 + SETOM S.NM1(C) + MOVEM D,(B) ; CORRECT TYPE +] +IFE ITS,CHFIX: + GETYP 0,(B) + CAIE 0,TFIX + JRST PARSQ +CHFIX1: ADDI C,1 ; POINT TO NEXT FIELD + LSH A,-1 ; AND NEXT FLAG + POPJ P, +PARSQ: CAIE 0,TCHSTR + JRST WRONGT +IFE ITS, POPJ P, +IFN ITS,[ + PUSH P,A + PUSH P,C + PUSH TP,(B) + PUSH TP,1(B) + SUBI B,(TB) + PUSH P,B + MCALL 1,PARSE + GETYP 0,A + CAIE 0,TFIX + JRST WRONGT + POP P,C + ADDI C,(TB) + MOVEM A,(C) + MOVEM B,1(C) + POP P,C + POP P,A + POPJ P, +] + + +; SUBROUTINE TO CHECK VALIDITY OF MODE AND SAVE A CODE + +CHMODE: PUSHJ P,CHMOD ; DO IT + MOVE C,T.SPDL+1(TB) + HRRZM A,S.DIR(C) + POPJ P, + +CHMOD: PUSHJ P,STRTO6 ; TO SIXBIT + POP P,B ; VALUE ENDSUP ON STACK, RESTORE IT + + MOVSI A,-NMODES ; SCAN TO SEE IF LEGAL MODE + CAME B,MODES(A) + AOBJN A,.-1 + JUMPGE A,WRONGD ; ILLEGAL MODE NAME + MOVE A,MODCOD(A) + POPJ P, + + +IFN ITS,[ +; RGPARS -- PARSE THE STRINGS COMPRISING FILE NAMES INTO STANDARD ITS GOODIES + +RGPRS: MOVEI 0,NOSTOR ; DONT STORE STRINGS IF ENTER HERE + +RGPARS: CAMGE AB,[-7,,] ; MULTI-STRING CASE POSSIBLE? + IORI 0,4ARG ; 4 STRING CASE + HRLM 0,(P) ; LH IS FLAGS FOR THIS PROG + MOVSI E,-4 ; FIELDS TO FILL + +RPARGL: GETYP 0,(AB) ; GET TYPE + CAIE 0,TCHSTR ; STRING? + JRST ARGCLB ; NO, JUST CLOBBER IT IN RAW + JUMPGE E,CPOPJ ; DON'T DO ANY MORE + PUSH TP,(AB) ; GET AN ARG + PUSH TP,1(AB) + +FPARS: PUSH TP,-1(TP) ; ANOTHER COPY + PUSH TP,-1(TP) + HLRZ 0,(P) + TRNN 0,4ARG + PUSHJ P,FLSSP ; NO LEADING SPACES + MOVEI A,0 ; WILL HOLD SIXBIT + MOVEI B,6 ; CHARS PER 6BIT WORD + MOVE C,[440600,,A] ; BYTE POINTER INTO A + +FPARSL: HRRZ 0,-1(TP) ; GET COUNT + JUMPE 0,PARSD ; DONE + SOS -1(TP) ; COUNT + ILDB 0,(TP) ; CHAR TO 0 + + CAIE 0," ; FILE NAME QUOTE? + JRST NOCNTQ + HRRZ 0,-1(TP) + JUMPE 0,PARSD + SOS -1(TP) + ILDB 0,(TP) ; USE THIS + JRST GOTCNQ + +NOCNTQ: HLL 0,(P) + TLNE 0,4ARG + JRST GOTCNQ + ANDI 0,177 + CAIG 0,40 ; SPACE? + JRST NDFLD ; YES, TERMINATE THIS FIELD + CAIN 0,": ; DEVICE ENDED? + JRST GOTDEV + CAIN 0,"; ; SNAME ENDED + JRST GOTSNM + +GOTCNQ: ANDI 0,177 + PUSHJ P,A0TO6 ; CONVERT TO 6BIT AND CHECK + + JUMPE B,FPARSL ; IGNORE IF AREADY HAVE 6 + IDPB 0,C + SOJA B,FPARSL + +; HERE IF SPACE ENCOUNTERED + +NDFLD: MOVEI D,(E) ; COPY GOODIE + PUSHJ P,FLSSP ; FLUSH REDUNDANT SPACES + JUMPE 0,PARSD ; NO CHARS LEFT + +NFL0: PUSH P,A ; SAVE SIXBIT WORD + SKIPGE -1(P) ; SKIP IF STRING TO BE STORED + JRST NFL1 + PUSH TP,$TAB ; PREVENT AB LOSSAGE + PUSH TP,AB + PUSHJ P,6TOCHS ; CONVERT TO STRING + MOVE AB,(TP) + SUB TP,[2,,2] +NFL1: HRRZ 0,-1(TP) ; RESTORE CHAR COUNT + +NFL2: MOVEI C,(D) ; COPY REL PNTR + SKIPGE -1(P) ; SKIP IF STRINGS TO BE STORED + JRST NFL3 + ASH D,1 ; TIMES 2 + ADDI D,T.NM1(TB) + MOVEM A,(D) ; STORE + MOVEM B,1(D) +NFL3: MOVSI A,N1SET ; FLAG IT + LSH A,(C) + IORM A,-1(P) ; AND CLOBBER + MOVE D,T.SPDL+1(TB) ; GET P BASE + POP P,@SIXTBL(C) ; AND STORE SIXBIT OF IT + + POP TP,-2(TP) ; MAKE NEW STRING POINTER + POP TP,-2(TP) + JUMPE 0,.+3 ; SKIP IF NO MORE CHARS + AOBJN E,FPARS ; MORE TO PARSE? +CPOPJ: POPJ P, ; RETURN, ALL DONE + + SUB TP,[2,,2] ; FLUSH OLD STRING + ADD E,[1,,1] + ADD AB,[2,,2] ; BUMP ARG + JUMPL AB,RPARGL ; AND GO ON +CPOPJ1: AOS A,(P) ; PREPARE TO WIN + HLRZS A + POPJ P, + + + +; HERE IF STRING HAS ENDED + +PARSD: PUSH P,A ; SAVE 6 BIT + MOVE A,-3(TP) ; CAN USE ARG STRING + MOVE B,-2(TP) + MOVEI D,(E) + JRST NFL2 ; AND CONTINUE + +; HERE IF JUST READ DEV + +GOTDEV: MOVEI D,2 ; CODE FOR DEVICE + JRST GOTFLD ; GOT A FIELD + +; HERE IF JUST READ SNAME + +GOTSNM: MOVEI D,3 +GOTFLD: PUSHJ P,FLSSP + SOJA E,NFL0 + + +; HERE FOR NON STRING ARG ENCOUNTERED + +ARGCLB: SKIPGE (P) ; IF NOT STORING, CONSIDER THIS THE END + + POPJ P, + MOVE C,T.SPDL+1(TB) ; GET P-BASE + MOVE A,S.DEV(C) ; GET DEVICE + CAME A,[SIXBIT /INT /]; IS IT THE INTERNAL DEVICE + JRST TRYNET ; NO, COUD BE NET + MOVE A,0 ; OFFNEDING TYPE TO A + PUSHJ P,APLQ ; IS IT APPLICABLE + JRST NAPT ; NO, LOSE + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] ; MUST BE LAST ARG + JUMPL AB,TMA + JRST CPOPJ1 ; ELSE SUCCESSFUL RETURN +TRYNET: CAIE 0,TFIX ; FOR NET DEV, ARGS MUST BE FIX + JRST WRONGT ; TREAT AS WRONG TYPE + MOVSI A,MSTNET ; BETTER BE NET EVENTUALLY + IORM A,(P) ; STORE FLAGS + MOVSI A,TFIX + MOVE B,1(AB) ; GET NUMBER + MOVEI 0,(E) ; MAKE SURE NOT DEVICE + CAIN 0,2 + JRST WRONGT + PUSH P,B ; SAVE NUMBER + MOVEI D,(E) ; SET FOR TABLE OFFSETS + MOVEI 0,0 + ADD TP,[4,,4] + JRST NFL2 ; GO CLOBBER IT AWAY +] + + +; ROUTINE TO FLUSH LEADING SPACES FROM A FIELD + +FLSSP: HRRZ 0,-1(TP) ; GET CHR COUNNT + JUMPE 0,CPOPJ ; FINISHED STRING +FLSS1: MOVE B,(TP) ; GET BYTR + ILDB C,B ; GETCHAR + CAIE C,^Q ; DONT FLUSH CNTL-Q + CAILE C,40 + JRST FLSS2 + MOVEM B,(TP) ; UPDATE BYTE POINTER + SOJN 0,FLSS1 + +FLSS2: HRRM 0,-1(TP) ; UPDATE STRING + POPJ P, + +IFN ITS,[ +;TABLE FOR STFUFFING SIXBITS AWAY + +SIXTBL: SETZ S.NM1(D) + SETZ S.NM2(D) + SETZ S.DEV(D) + SETZ S.SNM(D) + SETZ S.X1(D) +] + +RDTBL: SETZ RDEVIC(B) + SETZ RNAME1(B) + SETZ RNAME2(B) + SETZ RSNAME(B) + + + +IFE ITS,[ + +; TENEX VERSION OF FILE NAME PARSER (ONLY ACCEPT ARGS IN SINGLE STRING) + + +RGPRS: MOVEI 0,NOSTOR + +RGPARS: HRLM 0,(P) ; SAVE FOR STORE CHECKING + CAMGE AB,[-2,,] ; MULTI-STRING CASE POSSIBLE? + JRST TN.MLT ; YES, GO PROCESS +RGPRSS: GETYP 0,(AB) ; CHECK ARG TYPE + CAIE 0,TCHSTR + JRST WRONGT ; FOR NOW ONLY STRING ARGS WIN + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,FLSSP ; FLUSH LEADING SPACES + PUSHJ P,RGPRS1 + ADD AB,[2,,2] +CHKLST: JUMPGE AB,CPOPJ1 + SKIPGE (P) ; IF FROM OPEN, ALLOW ONE MORE + POPJ P, + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] + JUMPL AB,TMA +CPOPJ1: AOS (P) + POPJ P, + +RGPRS1: PUSH P,[0] ; ALLOW A DEVICE SPEC +TN.SNM: MOVE A,(TP) + HRRZ 0,-1(TP) + JUMPE 0,RPDONE + ILDB A,A + CAIE A,"< ; START "DIRECTORY" ? + JRST TN.N1 ; NO LOOK FOR NAME1 + SETOM (P) ; DEV NOT ALLOWED + IBP (TP) ; SKIP CHAR + SOS -1(TP) + PUSHJ P,TN.CNT ; COUNT CHARS TO ">" OR "." + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN3 + PUSH TP,0 + PUSH TP,C +TN.SN1: PUSHJ P,TN.CNT ; COUNT CHARS TO ">" + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN2 + MOVEM 0,-1(TP) + MOVEM C,(TP) + JRST TN.SN1 +TN.SN2: HRRZ B,-3(TP) + SUB B,0 + SUBI B,1 + SUB TP,[2,,2] +TN.SN3: CAIE A,"> ; SKIP IF WINS + JRST ILLNAM + PUSHJ P,TN.CPS ; COPY TO NEW STRING + HLLOS T.SPDL(TB) + MOVEM A,T.SNM(TB) + MOVEM B,T.SNM+1(TB) + +TN.N1: PUSHJ P,TN.CNT + JUMPE B,RPDONE + CAIE A,": ; GOT A DEVICE + JRST TN.N11 + SKIPE (P) + JRST ILLNAM + SETOM (P) + PUSHJ P,TN.CPS + MOVEM A,T.DEV(TB) + MOVEM B,T.DEV+1(TB) + JRST TN.SNM ; NOW LOOK FOR SNAME + +TN.N11: CAIE A,"> + CAIN A,"< + JRST ILLNAM + MOVEM A,(P) ; SAVE END CHAR + PUSHJ P,TN.CPS ; GEN STRING + MOVEM A,T.NM1(TB) + MOVEM B,T.NM1+1(TB) + +TN.N2: SKIPN A,(P) ; GET CHAR BACK + JRST RPDONE + CAIN A,"; ; START VERSION? + JRST .+3 + CAIE A,". ; START NAME2? + JRST ILLNAM ; I GIVE UP!!! + HRRZ B,-1(TP) ; GET RMAINS OF STRING + PUSHJ P,TN.CPS ; AND COPY IT + MOVEM A,T.NM2(TB) + MOVEM B,T.NM2+1(TB) +RPDONE: SUB P,[1,,1] ; FLUSH TEMP + SUB TP,[2,,2] +CPOPJ: POPJ P, + +TN.CNT: HRRZ 0,-1(TP) ; CHAR COUNT + MOVE C,(TP) ; BPTR + MOVEI B,0 ; INIT COUNT TO 0 + +TN.CN1: MOVEI A,0 ; IN CASE RUN OUT + SOJL 0,CPOPJ ; RUN OUT? + ILDB A,C ; TRY ONE + CAIE A," ; TNEX FILE QUOTE? + JRST TN.CN2 + SOJL 0,CPOPJ + IBP C ; SKIP QUOTED CHAT + ADDI B,2 + JRST TN.CN1 + +TN.CN2: CAIE A,"< + CAIN A,"> + POPJ P, + + CAIE A,". + CAIN A,"; + POPJ P, + CAIN A,": + POPJ P, + AOJA B,TN.CN1 + +TN.CPS: PUSH P,B ; # OF CHARS + MOVEI A,4(B) ; ADD 4 TO B IN A + IDIVI A,5 + PUSHJ P,IBLOCK ; GET BLOCK OF WORDS FOR STRING + + POP P,C ; CHAR COUNT BACK + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + HRRI A,(C) ; CHAR STRING + MOVE D,B ; COPY BYTER + + JUMPE C,CPOPJ + ILDB 0,(TP) ; GET CHAR + IDPB 0,D ; AND STROE + SOJG C,.-2 + + MOVNI C,(A) ; - LENGTH TO C + ADDB C,-1(TP) ; DECREMENT WORDS COUNT + TRNN C,-1 ; SKIP IF EMPTY + POPJ P, + IBP (TP) + SOS -1(TP) ; ELSE FLUSH TERMINATOR + POPJ P, + +ILLNAM: ERRUUO EQUOTE ILLEGAL-TENEX-FILE-NAME + +TN.MLT: MOVE A,AB ; AOBJN POINTER TO ARGS IN A + +TN.ML1: GETYP 0,(A) ; IS THIS ARG OF RIGHT TYPE + CAIE 0,TFIX + CAIN 0,TCHSTR + JRST .+2 + JRST RGPRSS ; ASSUME SINGLE STRING + ADD A,[2,,2] + JUMPL A,TN.ML1 ; TRY NEXT ARG IF ANY LEFT + + MOVEI 0,T.NM1(TB) ; 1ST WORD OF DESTINATION + HLRO A,AB ; MINUS NUMBER OF ARGS IN A + MOVN A,A ; NUMBER OF ARGS IN A + SUBI A,1 + CAMGE AB,[-10,,0] + MOVEI A,7 ; IF MORE THAN 10 ARGS, PUT 7 + ADD A,0 ; LAST WORD OF DESTINATION + HRLI 0,(AB) + BLT 0,(A) ; BLT 'EM IN + ADD AB,[10,,10] ; SKIP THESE GUYS + JRST CHKLST + +] + + +; ROUTINE TO OPEN A CHANNEL FOR ANY DEVICE. NAMES ARE ASSUMED TO ALREADY +; BE ON BOTH TP STACK AND P STACK + +OPNCH: MOVE C,T.SPDL+1(TB) ; GET PDL BASE + HRRZ A,S.DIR(C) + ANDI A,1 ; JUST WANT I AND O +IFE ITS,[ + HRLM A,S.DEV(C) +; .TRANS S.DEV(C) ; UNDO ANY TRANSLATIONS +; JRST TRLOST ; COMPLAIN +] +IFN ITS,[ + HRLM A,S.DIR(C) +] + +IFN ITS,[ + MOVE A,S.DEV(C) ; GET SIXBIT DEVICE CODE +] + +IFE ITS,[HRLZS A,S.DEV(C) +] + + MOVSI B,-NDEVS ; AOBJN COUNTER +DEVLP: SETO D, + MOVE 0,DEVSTB(B) ; GET ONE FROM TABLE + MOVE E,A +DEVLP1: AND E,D ; FLUSH POSSIBLE DIGITNESS + CAMN 0,E + JRST CHDIGS ; MAKE SURE REST IS DIGITS + LSH D,6 + JUMPN D,DEVLP1 ; KEEP TRUCKING UNTIL DONE + +; WASN'T THAT DEVICE, MOVE TO NEXT +NXTDEV: AOBJN B,DEVLP + JRST ODSK ; UNKNOWN DEVICE IS ASSUMED TO BE DISK + +IFN ITS,[ +OUSR: HRRZ A,S.DIR(C) ; BLOCK OR UNIT? + TRNE A,2 ; SKIP IF UNIT + JRST ODSK + PUSHJ P,OPEN1 ; OPEN IT + PUSHJ P,FIXREA ; AND READCHST IT + MOVE B,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVE 0,[PUSHJ P,DOIOT] ; GET AN IOINS + MOVEM 0,IOINS(B) + MOVE C,T.SPDL+1(TB) + HRRZ A,S.DIR(C) + TRNN A,1 + JRST EOFMAK + MOVEI 0,80. + MOVEM 0,LINLN(B) + JRST OPNWIN + +OSTY: HLRZ A,S.DIR(C) + IORI A,10 ; THE DONT LOSE BIT (DONT HANG ON INPUT DO ON OUTPUT) + HRLM A,S.DIR(C) + JRST OUSR +] + +; MAKE SURE DIGITS EXIST + +CHDIGS: SETCA D, + JUMPE D,DISPA ; NO DIGITS, WIN IMMEDIATE + MOVE E,A + AND E,D ; LEAVES ONLY DIGITS, IF WINNING + LSH E,6 + LSH D,6 + JUMPG D,.-2 ; KEEP GOING TIL DIGITS LEFT SHIFTED + JRST CHDIGN + +CHDIG1: CAIG D,'9 + CAIGE D,'0 + JRST NXTDEV ; NOT A DIGIT, LOSE + JUMPE E,DISPA ; IF THAT'S ALL THE CHARACTERS, WIN! +CHDIGN: SETZ D, + ROTC D,6 ; GET NEXT CHARACTER INTO D + JRST CHDIG1 ; GO TEST? + +; HERE TO DISPATCH IF SUCCESSFUL + +DISPA: JRST @DEVS(B) + + +IFN ITS,[ + +; DISK DEVICE OPNER COME HERE + +ODSK: MOVE A,S.SNM(C) ; GET SNAME + .SUSET [.SSNAM,,A] ; CLOBBER IT + PUSHJ P,OPEN0 ; DO REAL LIVE OPEN +] +IFE ITS,[ + +; TENEX DISK FILE OPENER + +ODSK: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + PUSHJ P,STSTK ; EXPAND STRING ONTO STACK (E POINTS TO OLD P) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; GET DIR NAME + MOVE C,(P) + MOVE D,T.SPDL+1(TB) + HRRZ D,S.DIR(D) + CAME C,[SIXBIT /PRINAO/] + CAMN C,[SIXBIT /PRINTO/] + IORI D,100 ; TURN ON BIT TO SAY USE OLD FILE + MOVSI A,101 ; START SETTING UP BITS EXTRA BIT FOR MSB + TRNE D,1 ; SKIP IF INPUT + TRNE D,100 ; WITE OVER? + TLOA A,100000 ; FORCE OLD VERSION + TLO A,600000 ; FORCE NEW VERSION + HRROI B,1(E) ; POINT TO STRING + GTJFN + TDZA 0,0 ; SAVE FACT OF NO SKIP + MOVEI 0,1 ; INDICATE SKIPPED + POP P,C ; RECOVER OPEN MODE SIXBIT + MOVE P,E ; RESTORE PSTACK + JUMPE 0,GTJLOS ; FIND OUT WHAT HAPPENED + + MOVE B,T.CHAN+1(TB) ; GET CHANNEL + HRRZ 0,-4(B) ; FUNNY MODE BITS + HRRZM A,CHANNO(B) ; SAVE IT + ANDI A,-1 ; READ Y TO DO OPEN + MOVSI B,440000 ; USE 36. BIT BYES + HRRI B,200000 ; ASSUME READ +; CAMN C,[SIXBIT /READB/] +; TRO B,2000 ; TURN ON THAWED IF READB + IOR B,0 + TRNE D,1 ; SKIP IF READ + HRRI B,300000 ; WRITE BIT + HRRZ 0,FSAV(TB) ; SEE IF REF DATE HACK + CAIN 0,NFOPEN + TRO B,400 ; SET DON'T MUNG REF DATE BIT + MOVE E,B ; SAVE BITS FOR REOPENS + OPENF + JRST OPFLOS + MOVE B,[2,,11] ; GET LENGTH & BYTE SIZE + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + GTFDB + LDB 0,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + CAIN 0,7 + JRST SIZASC + CAIN 0,36. + SIZEF ; USE OPENED SIZE + JFCL + IMULI B,5 ; TO BYTES +SIZASC: MOVEI 0,C.OPN+C.READ+C.DISK + TRNE D,1 ; SKIP FOR READ + MOVEI 0,C.OPN+C.PRIN+C.DISK + TRNE D,2 ; SKIP IF NOT BINARY FILE + TRO 0,C.BIN + HRL 0,B + MOVE B,T.CHAN+1(TB) + TRNE D,1 + HLRM 0,LSTCH-1(B) ; SAVE CURRENT LENGTH + MOVEM E,STATUS(B) + HRRM 0,-2(B) ; MUNG THOSE BITS + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + PUSHJ P,TMTNXS ; GET STRING FROM TENEX + MOVE B,CHANNO(B) ; JFN TO A + HRROI A,1(E) ; BASE OF STRING + MOVE C,[111111,,140001] ; WEIRD CONTROL BITS + JFNS ; GET STRING + MOVEI B,1(E) ; POINT TO START OF STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; MAKE INTO A STRING + SUB P,E ; BACK TO NORMAL + PUSH TP,A + PUSH TP,B + PUSHJ P,RGPRS1 ; PARSE INTO FIELDS + MOVE B,T.CHAN+1(TB) + MOVEI C,RNAME1-1(B) + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + JRST OPBASC +OPFLOS: MOVEI C,(A) ; SAVE ERROR CODE + MOVE B,T.CHAN+1(TB) + HRRZ A,CHANNO(B) ; JFN BACK TO A + RLJFN ; TRY TO RELEASE IT + JFCL + MOVEI A,(C) ; ERROR CODE BACK TO A + +GTJLOS: MOVE B,T.CHAN+1(TB) + PUSHJ P,TGFALS ; GET A FALSE WITH REASON + JRST OPNRET + +STSTK: PUSH TP,$TCHAN + PUSH TP,B + MOVEI A,4+5 ; COUNT CHARS NEEDED (NEED LAST 0 BYTE) + MOVE B,(TP) + ADD A,RDEVIC-1(B) + ADD A,RNAME1-1(B) + ADD A,RNAME2-1(B) + ADD A,RSNAME-1(B) + ANDI A,-1 ; TO 18 BITS + MOVEI 0,A(A) + IDIVI A,5 ; TO WORDS NEEDED + POP P,C ; SAVE RET ADDR + MOVE E,P ; SAVE POINTER + PUSH P,[0] ; ALOCATE SLOTS + SOJG A,.-1 + PUSH P,C ; RET ADDR BACK + INTGO ; IN CASE OVERFLEW + PUSH P,0 + MOVE B,(TP) ; IN CASE GC'D + MOVE D,[440700,,1(E)] ; BYTE POINTER TO IT + MOVEI A,RDEVIC-1(B) + PUSHJ P,MOVSTR ; FLUSH IT ON + HRRZ A,T.SPDL(TB) + JUMPN A,NLNMS ; USER GAVE NAME, USE IT (CAREFUL, RELIES ON + ; A BEING NON ZERO) + PUSH P,B + PUSH P,C + MOVEI A,0 ; HERE TO SEE IF THIS IS REALLY L.N. + HRROI B,1(E) + HRROI C,1(P) + LNMST ; LOOK UP LOGICAL NAME + MOVNI A,1 ; NOT A LOGICAL NAME + POP P,C + POP P,B +NLNMS: MOVEI 0,": + IDPB 0,D + JUMPE A,ST.NM1 ; LOGICAL NAME, FLUSH SNAME + HRRZ A,RSNAME-1(B) ; ANY SNAME AT ALL? + JUMPE A,ST.NM1 ; NOPE, CANT HACK WITH IT + MOVEI A,"< + IDPB A,D + MOVEI A,RSNAME-1(B) + PUSHJ P,MOVSTR ; SNAME UP + MOVEI A,"> + IDPB A,D +ST.NM1: MOVEI A,RNAME1-1(B) + PUSHJ P,MOVSTR + MOVEI A,". + IDPB A,D + MOVEI A,RNAME2-1(B) + PUSHJ P,MOVSTR + SUB TP,[2,,2] + POP P,A + POPJ P, + +MOVSTR: HRRZ 0,(A) ; CHAR COUNT + MOVE A,1(A) ; BYTE POINTER + SOJL 0,CPOPJ + ILDB C,A ; GET CHAR + IDPB C,D ; MUNG IT UP + JRST .-3 + +; MAKE A TENEX ERROR MESSAGE STRING + +TGFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; SAVE ERROR CODE + PUSHJ P,TMTNXS ; STRING ON STACK + HRROI A,1(E) ; POINT TO SPACE + MOVE B,(E) ; ERROR CODE + HRLI B,400000 ; FOR ME + MOVSI C,-100. ; MAX CHARS + ERSTR ; GET TENEX STRING + JRST TGFLS1 + JRST TGFLS1 + + MOVEI B,1(E) ; A AND B BOUND STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; BUILD STRING + SUB P,E ; P BACK TO NORMAL +TGFLS2: +IFE FNAMS, SUB P,[1,,1] ; FLUSH ERROR CODE SLOT +IFN FNAMS,[ + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST TGFLS3 + PUSHJ P,STSTK + MOVEI B,1(E) + SUBM P,E + MOVSI A,440700 + HRRI A,(P) + MOVEI C,5 + ILDB 0,A + JUMPE 0,.+2 + SOJG C,.-2 + + PUSHJ P,TNXSTR + PUSH TP,A + PUSH TP,B + SUB P,E +TGFLS3: POP P,A + PUSH TP,$TFIX + PUSH TP,A + MOVEI A,3 + SKIPN B + MOVEI A,2 +] +IFE FNAMS,[ + MOVEI A,1 +] + PUSHJ P,IILIST ; BUILD LIST + MOVSI A,TFALSE ; MAKE IT FALSE + SUB TP,[2,,2] + POPJ P, + +TGFLS1: MOVE P,E ; RESET STACK + MOVE A,$TCHSTR + MOVE B,CHQUOTE UNKNOWN PROBLEM IN I/O + JRST TGFLS2 + +] +; OTHER BUFFERED DEVICES JOIN HERE + +OPDSK1: +IFN ITS,[ + PUSHJ P,FIXREA ; STORE THE "REAL" NAMES INTO THE CHANNEL +] +OPBASC: MOVE C,T.SPDL+1(TB) ; C WAS CLOBBERED, GET IT BACK + HRRZ A,S.DIR(C) ; FIND OUT IF OPEN IS ASCII OR WORD + TRZN A,2 ; SKIP IF BINARY + PUSHJ P,OPASCI ; DO IT FOR ASCII + +; NOW SET UP IO INSTRUCTION FOR CHANNEL + +MAKION: MOVE B,T.CHAN+1(TB) + MOVEI C,GETCHR + JUMPE A,MAKIO1 ; JUMP IF INPUT + MOVEI C,PUTCHR ; ELSE GET INPUT + MOVEI 0,80. ; DEFAULT LINE LNTH + MOVEM 0,LINLN(B) + MOVSI 0,TFIX + MOVEM 0,LINLN-1(B) +MAKIO1: + HRLI C,(PUSHJ P,) + MOVEM C,IOINS(B) ; STORE IT + JUMPN A,OPNWIN ; GET AN EOF FORM FOR INPUT CHANNEL + +; HERE TO CONS UP + +EOFMAK: MOVSI C,TATOM + MOVE D,EQUOTE END-OF-FILE + PUSHJ P,INCONS + MOVEI E,(B) + MOVSI C,TATOM + MOVE D,IMQUOTE ERROR + PUSHJ P,ICONS + MOVE D,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVSI 0,TFORM + MOVEM 0,EOFCND-1(D) + MOVEM B,EOFCND(D) + +OPNWIN: MOVEI 0,10. ; SET UP RADIX + MOVSI A,TCHAN ; OPEN SUCCEEDED, RET CHANNEL + MOVE B,T.CHAN+1(TB) + MOVEM 0,RADX(B) + +OPNRET: MOVE D,T.CHAN+1(TB) ; IN CASE WE RECYCLE IT + MOVE C,(P) ; RET ADDR + SUB P,[S.X3+2,,S.X3+2] + SUB TP,[T.CHAN+2,,T.CHAN+2] + JRST (C) + + +; HERE TO CREATE CHARACTER BUFFERS FOR ASCII I/O + +OPASCI: PUSH P,A ; CONTAINS MODE, SAVE IT + MOVEI A,BUFLNT ; GET SIZE OF BUFFER + PUSHJ P,IBLOCK ; GET STORAGE + MOVSI 0,TWORD+.VECT. ; SET UTYPE + MOVEM 0,BUFLNT(B) ; AND STORE + MOVSI A,TCHSTR + SKIPE (P) ; SKIP IF INPUT + JRST OPASCO + MOVEI D,BUFLNT-1(B) ; REST BYTE POINTER +OPASCA: HRLI D,010700 + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEI 0,C.BUF + IORM 0,-2(B) ; TURN ON BUFFER BIT + MOVEM A,BUFSTR-1(B) + MOVEM D,BUFSTR(B) ; CLOBBER + POP P,A + POPJ P, + +OPASCO: HRROI C,777776 + MOVEM C,(B) ; -1 THE BUFFER (LEAVE OFF LOW BIT) + MOVSI C,(B) + HRRI C,1(B) ; BUILD BLT POINTER + BLT C,BUFLNT-1(B) ; ZAP + MOVEI D,-1(B) ; START MAKING STRING POINTER + HRRI A,BUFLNT*5 ; SET UP CHAR COUNT + JRST OPASCA + + +; OPEN NON FILE ORIENTED DEVICES (NUL, PTR, PTP ETC.) + +IFN ITS,[ +ONUL: +OPTP: +OPTR: PUSHJ P,OPEN0 ; SET UP MODE AND OPEN + SETZM S.NM1(C) ; CLOBBER UNINTERESTING FIELDS + SETZM S.NM2(C) + SETZM S.SNM(C) + JRST OPDSK1 + +; OPEN DEVICES THAT IGNORE SNAME + +OUTN: PUSHJ P,OPEN0 + SETZM S.SNM(C) + JRST OPDSK1 + +] + +; INTERNAL CHANNEL OPENER + +OINT: HRRZ A,S.DIR(C) ; CHECK DIR + CAIL A,2 ; READ/PRINT? + JRST WRONGD ; NO, LOSE + + MOVE 0,INTINS(A) ; GET INS + MOVE D,T.CHAN+1(TB) ; AND CHANNEL + MOVEM 0,IOINS(D) ; AND CLOBBER + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + HRRM 0,-2(D) + SETOM STATUS(D) ; MAKE SURE NOT AA TTY + PMOVEM T.XT(TB),INTFCN-1(D) + +; HERE TO SAVE PSEUDO CHANNELS + +SAVCHN: HRRZ E,CHNL0+1 ; POINT TO CURRENT LIST + MOVSI C,TCHAN + PUSHJ P,ICONS ; CONS IT ON + HRRZM B,CHNL0+1 + JRST OPNWIN + +; INT DEVICE I/O INS + +INTINS: PUSHJ P,GTINTC + PUSHJ P,PTINTC + + +; HERE TO OPEN THE NET DEVICE (I.E. THE ARPA NET) + +IFN ITS,[ +ONET: HRRZ A,S.DIR(C) ; DIRECTION CODE + CAILE A,1 ; ASCII ? + IORI A,4 ; TURN ON IMAGE BIT + SKIPGE S.NM1(C) ; NAME1 I.E. LOCAL HOST GIVEN + IORI A,10 ; NO, WE WILL LET ITS GIVE US ONE + SKIPGE S.NM2(C) ; NORMAL OR "LISTEN" + IORI A,20 ; TURN ON LISTEN BIT + MOVEI 0,7 ; DEFAULT BYTE SIZE + TRNE A,2 ; UNLESS + MOVEI 0,36. ; IMAGE WHICH IS 36 + SKIPN T.XT(TB) ; BYTE SIZE GIVEN? + MOVEM 0,S.X1(C) ; NO, STORE DEFAULT + SKIPG D,S.X1(C) ; BYTE SIZE REASONABLE? + JRST RBYTSZ ; NO <0, COMPLAIN + TRNE A,2 ; SKIP TO CHECK ASCII + JRST ONET2 ; CHECK IMAGE + CAIN D,7 ; 7-BIT WINS + JRST ONET1 + CAIE D,44 ; 36-BIT INDICATES BLOCK ASCII MODE + JRST .+3 + IORI A,2 ; SET BLOCK FLAG + JRST ONET1 + IORI A,40 ; USE 8-BIT MODE + CAIN D,10 ; IS IT RIGHT + JRST ONET1 ; YES +] + +RBYTSZ: ERRUUO EQUOTE BYTE-SIZE-BAD + +IFN ITS,[ +ONET2: CAILE D,36. ; IMAGE SIZE REASONABLE? + JRST RBYTSZ ; NO + CAIN D,36. ; NORMAL + JRST ONET1 ; YES, DONT SET FIELD + + ASH D,9. ; POSITION FOR FIELD + IORI A,40(D) ; SET IT AND ITS BIT + +ONET1: HRLM A,S.DIR(C) ; CLOBBER OPEN BLOCK + MOVE E,A ; SAVE BLOCK MODE INFO + PUSHJ P,OPEN1 ; DO THE OPEN + PUSH P,E + +; CLOBBER REAL SLOTS FOR THE OPEN + + MOVEI A,3 ; GET STATE VECTOR + PUSHJ P,IBLOCK + MOVSI A,TUVEC + MOVE D,T.CHAN+1(TB) + HLLM A,BUFRIN-1(D) + MOVEM B,BUFRIN(D) + MOVSI A,TFIX+.VECT. ; SET U TYPE + MOVEM A,3(B) + MOVE C,T.SPDL+1(TB) + MOVE B,T.CHAN+1(TB) + + PUSHJ P,INETST ; GET STATE + + POP P,A ; IS THIS BLOCK MODE + MOVEI 0,80. ; POSSIBLE LINE LENGTH + TRNE A,1 ; SKIP IF INPUT + MOVEM 0,LINLN(B) + TRNN A,2 ; BLOCK MODE? + JRST .+3 + TRNN A,4 ; ASCII MODE? + JRST OPBASC ; GO SETUP BLOCK ASCII + MOVE 0,[PUSHJ P,DOIOT] + MOVEM 0,IOINS(B) + + JRST OPNWIN + +; INTERNAL ROUTINE TO GET THE CURRENT STATE OF THE NETWROK CHANNEL + +INETST: MOVE A,S.NM1(C) + MOVEM A,RNAME1(B) + MOVE A,S.NM2(C) + MOVEM A,RNAME2(B) + LDB A,[1100,,S.SNM(C)] + MOVEM A,RSNAME(B) + + MOVE E,BUFRIN(B) ; GET STATE BLOCK +INTST1: HRRE 0,S.X1(C) + MOVEM 0,(E) + ADDI C,1 + AOBJN E,INTST1 + + POPJ P, + + +; ACCEPT A CONNECTION + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET ; CHECK THAT ARG IS AN OPEN NET CHANNEL + MOVE A,CHANNO(B) ; GET CHANNEL + LSH A,23. ; TO AC FIELD + IOR A,[.NETACC] + XCT A + JRST IFALSE ; RETURN FALSE +NETRET: MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +; FORCE SYSTEM NETWORK BUFFERS TO BE SENT + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 + CAMN A,MODES+3 + SKIPA A,CHANNO(B) ; GET CHANNEL + JRST WRONGD + LSH A,23. + IOR A,[.NETS] + XCT A + JRST NETRET + +; SUBR TO RETURN UPDATED NET STATE + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET ; IS IT A NET CHANNEL + PUSHJ P,INSTAT + JRST FINIS + +; INTERNAL NETSTATE ROUTINE + +INSTAT: MOVE C,P ; GET PDL BASE + MOVEI 0,S.X3 ; # OF SLOTS NEEDED + PUSH P,[0] + SOJN 0,.-1 +; RESTORED FROM MUDDLE 54. IT SEEMED TO WORK THERE, AND THE STUFF +; COMMENTED OUT HERE CERTAINLY DOESN'T. + MOVEI D,S.DEV(C) + HRL D,CHANNO(B) + .RCHST D, +; HRR D,CHANNO(B) ; SETUP FOR RFNAME CALL +; DOTCAL RFNAME,[D,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] +; .LOSE %LSFIL ; THIS MAY NOT BE DESIRABLE, BUT I ASSUME WE CARE IF + ; LOSSAGE + PUSHJ P,INETST ; INTO VECTOR + SUB P,[S.X3,,S.X3] + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + POPJ P, +] +; INTERNAL ROUTINE TO CHECK FOR CORRECT CHANNEL TYPE + +ARGNET: ENTRY 1 + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; OPEN? + JRST CHNCLS + MOVE A,RDEVIC-1(B) ; GET DEV NAME + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 + POP P,A + CAME A,[SIXBIT /NET /] + JRST NOTNET + MOVE B,1(AB) + MOVE A,DIRECT-1(B) ; CHECK FOR A READ SOCKET + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 + MOVE B,1(AB) ; RESTORE CHANNEL + POP P,A + POPJ P, + +IFE ITS,[ + +; TENEX NETWRK OPENING CODE + +ONET: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + MOVSI C,100700 + HRRI C,1(P) + MOVE E,P + PUSH P,[ASCII /NET:/] ; FOR STRINGS + GETYP 0,RNAME1-1(B) ; CHECK TYPE + CAIE 0,TFIX ; SKIP IF # SUPPLIED + JRST ONET1 + MOVE 0,RNAME1(B) ; GET IT + PUSHJ P,FIXSTK + JFCL + JRST ONET2 +ONET1: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME1-1(B) + MOVE B,RNAME1(B) + JUMPE 0,ONET2 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 +ONET2: MOVEI A,". + JSP D,ONETCH + MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIE 0,TFIX + JRST ONET3 + GETYP 0,RSNAME-1(B) + CAIE 0,TFIX + JRST WRONGT + MOVE 0,RSNAME(B) + CAIG 0,377 ;NEW STYLE 32 BIT HOST NUMBER? + JRST ONET2A +;CONVERT HOSTS2 HOST NUMBERS TO INTERNET (TOPS-20) HOST NUMBERS + MOVEI A,0 + LDB B,[001100,,0] ;HOST NUMBER: 1.1-1.9 -> + DPB B,[201000,,A] ; 2.8-3.6 + LDB B,[111100,,0] ;IMP LOW BITS: 2.1-2.9 -> + DPB B,[001000,,A] ; 1.1-1.8 + LDB B,[221100,,0] ;IMP HIGH BITS: 3.1-3.9 -> + DPB B,[101000,,A] ; 1.9-2.7 + LDB B,[331100,,0] ;NETWORK: 4.1-4.9 -> + DPB B,[301000,,A] ; 3.7-4.5 + MOVE 0,A +ONET2A: PUSHJ P,FIXSTK + JRST ONET4 + MOVE B,T.CHAN+1(TB) + MOVEI A,"- + JSP D,ONETCH + MOVE 0,RNAME2(B) + PUSHJ P,FIXSTK + JRST WRONGT + JRST ONET4 +ONET3: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME2-1(B) + MOVE B,RNAME2(B) + JUMPE 0,ONET4 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 + +ONET4: +ONET5: MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIN 0,TCHSTR + JRST ONET6 + MOVEI A,"; + JSP D,ONETCH + MOVEI A,"T + JSP D,ONETCH +ONET6: MOVSI A,1 + HRROI B,1(E) ; STRING POINTER + GTJFN ; GET THE G.D JFN + TDZA 0,0 ; REMEMBER FAILURE + MOVEI 0,1 + MOVE P,E ; RESTORE P + JUMPE 0,GTJLOS ; CONS UP ERROR STRING + + MOVE B,T.CHAN+1(TB) + HRRZM A,CHANNO(B) ; SAVE THE JFN + + MOVE C,T.SPDL+1(TB) + MOVE D,S.DIR(C) + MOVEI B,10 + TRNE D,2 + MOVEI B,36. + SKIPE T.XT(TB) + MOVE B,T.XT+1(TB) + JUMPL B,RBYTSZ + CAILE B,36. + JRST RBYTSZ + ROT B,-6 + TLO B,3400 + HRRI B,200000 + TRNE D,1 ; SKIP FOR INPUT + HRRI B,100000 + ANDI A,-1 ; ISOLATE JFCN + OPENF + JRST OPFLOS ; REPORT ERROR + MOVE B,T.CHAN+1(TB) + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) + CVSKT ; GET ABS SOCKET # + FATAL NETWORK BITES THE BAG! + MOVE D,B + MOVE B,T.CHAN+1(TB) + MOVEM D,RNAME1(B) + MOVSI 0,TFIX + MOVEM 0,RNAME1-1(B) + + MOVSI 0,TFIX + MOVEM 0,RNAME2-1(B) + MOVEM 0,RSNAME-1(B) + MOVE C,T.SPDL+1(TB) + MOVE C,S.DIR(C) + MOVE 0,[PUSHJ P,DONETO] + TRNN C,1 ; SKIP FOR OUTPUT + MOVE 0,[PUSHJ P,DONETI] + MOVEM 0,IOINS(B) + MOVEI 0,80. ; LINELENGTH + TRNE C,1 ; SKIP FOR INPUT + MOVEM 0,LINLN(B) + MOVEI A,3 ; GET STATE UVECTOR + PUSHJ P,IBLOCK + MOVSI 0,TFIX+.VECT. + MOVEM 0,3(B) + MOVE C,B + MOVE B,T.CHAN+1(TB) + MOVEM C,BUFRIN(B) + MOVSI 0,TUVEC + HLLM 0,BUFRIN-1(B) + MOVE A,CHANNO(B) ; GET JFN + GDSTS ; GET STATE + MOVE E,T.CHAN+1(TB) + MOVEM D,RNAME2(E) + MOVEM C,RSNAME(E) + MOVE C,BUFRIN(E) + MOVEM B,(C) ; INITIAL STATE STORED + MOVE B,E + JRST OPNWIN + +; DOIOT FOR TENEX NETWRK + +DONETO: PUSH P,0 + MOVE 0,[BOUT] + JRST .+3 + +DONETI: PUSH P,0 + MOVE 0,[BIN] + PUSH P,0 + PUSH TP,$TCHAN + PUSH TP,B + MOVEI 0,(A) ; POSSIBLE OUTPUT CHAR TO 0 + MOVE A,CHANNO(B) + MOVE B,0 + ENABLE + XCT (P) + DISABLE + MOVEI A,(B) ; RET CHAR IN A + MOVE B,(TP) + MOVE 0,-1(P) + SUB P,[2,,2] + SUB TP,[2,,2] + POPJ P, + +NETPRS: MOVEI D,0 + HRRZ 0,(C) + MOVE C,1(C) + +ONETL: ILDB A,C + CAIN A,"# + POPJ P, + SUBI A,60 + ASH D,3 + IORI D,(A) + SOJG 0,ONETL + AOS (P) + POPJ P, + +FIXSTK: CAMN 0,[-1] + POPJ P, + JFFO 0,FIXS3 ; PUT OCTAL DIGITS INTO STIRNG + MOVEI A,"0 + POP P,D + AOJA D,ONETCH +FIXS3: IDIVI A,3 + MOVEI B,12. + SUBI B,(A) + HRLM B,(P) + IMULI A,3 + LSH 0,(A) + POP P,B +FIXS2: MOVEI A,0 + ROTC 0,3 ; NEXT DIGIT + ADDI A,60 + JSP D,ONETCH + SUB B,[1,,0] + TLNN B,-1 + JRST 1(B) + JRST FIXS2 + +ONETCH: IDPB A,C + TLNE C,760000 ; SKIP IF NEW WORD + JRST (D) + PUSH P,[0] + JRST (D) + +INSTAT: MOVE E,B + MOVE A,CHANNO(E) + GDSTS + LSH B,-32. + MOVEM D,RNAME2(E) ; UPDATE FOREIGN SOCHKET + MOVEM C,RSNAME(E) ; AND HOST + MOVE C,BUFRIN(E) + XCT ITSTRN(B) ; XLATE TO LOOK MORE LIKE ITS + MOVEM B,(C) ; STORE STATE + MOVE B,E + POPJ P, + +ITSTRN: MOVEI B,0 + JRST NLOSS + JRST NLOSS + MOVEI B,1 + MOVEI B,2 + JRST NLOSS + MOVEI B,4 + PUSHJ P,NOPND + MOVEI B,0 + JRST NLOSS + JRST NLOSS + PUSHJ P,NCLSD + MOVEI B,0 + JRST NLOSS + MOVEI B,0 + +NLOSS: FATAL ILLEGAL NETWORK STATE + +NOPND: MOVE B,DIRECT(E) ; SEE IF READ OR PRINT + ILDB B,B ; GET 1ST CHAR + CAIE B,"R ; SKIP FOR READ + JRST NOPNDW + SIBE ; SEE IF INPUT EXISTS + JRST .+3 + MOVEI B,5 + POPJ P, + MOVEM B,2(C) ; STORE BYTES IN STATE VECTOR + MOVEI B,11 ; RETURN DATA PRESENT STATE + POPJ P, + +NOPNDW: SOBE ; SEE IF OUTPUT PRESENT + JRST .+3 + MOVEI B,5 + POPJ P, + + MOVEI B,6 + POPJ P, + +NCLSD: MOVE B,DIRECT(E) + ILDB B,B + CAIE B,"R + JRST RET0 + SIBE + JRST .+2 + JRST RET0 + MOVEI B,10 + POPJ P, + +RET0: MOVEI B,0 + POPJ P, + + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET + PUSHJ P,INSTAT + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + JRST FINIS + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 ; PRINT OR PRINTB? + CAMN A,MODES+3 + SKIPA A,CHANNO(B) + JRST WRONGD + MOVEI B,21 + MTOPR +NETRET: MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET + MOVE A,CHANNO(B) + MOVEI B,20 + MTOPR + JRST NETRET + +] + +; HERE TO OPEN TELETYPE DEVICES + +OTTY: HRRZ A,S.DIR(C) ; GET DIR CODE + TRNE A,2 ; SKIP IF NOT READB/PRINTB + JRST WRONGD ; CANT DO THAT + +IFN ITS,[ + MOVE A,S.NM1(C) ; CHECK FOR A DIR + MOVE 0,S.NM2(C) + CAMN A,[SIXBIT /.FILE./] + CAME 0,[SIXBIT /(DIR)/] + SKIPA E,[-15.*2,,] + JRST OUTN ; DO IT THAT WAY + + HRRZ A,S.DIR(C) ; CHECK DIR + TRNE A,1 + JRST TTYLP2 + HRRI E,CHNL1 + PUSH P,S.DEV(C) ; SAVE THE SIXBIT DEV NAME + ; HRLZS (P) ; POSTITION DEVICE NAME + +TTYLP: SKIPN D,1(E) ; CHANNEL OPEN? + JRST TTYLP1 ; NO, GO TO NEXT + MOVE A,RDEVIC-1(D) ; GET DEV NAME + MOVE B,RDEVIC(D) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A ; GET RESULT + CAMN A,(P) ; SAME? + JRST SAMTYQ ; COULD BE THE SAME +TTYLP1: ADD E,[2,,2] + JUMPL E,TTYLP + SUB P,[1,,1] ; THIS ONE MUST BE UNIQUE +TTYLP2: MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; GET DIR OF OPEN + SKIPE A ; IF OUTPUT, + IORI A,20 ; THEN USE DISPLAY MODE + HRLM A,S.DIR(C) ; STORE IN OPEN BLOCK + PUSHJ P,OPEN2 ; OPEN THE TTY + MOVE A,S.DEV(C) ; GET DEVICE NAME + PUSHJ P,6TOCHS ; TO A STRING + MOVE D,T.CHAN+1(TB) ; POINT TO CHANNEL + MOVEM A,RDEVIC-1(D) + MOVEM B,RDEVIC(D) + MOVE C,T.SPDL+1(TB) ; RESTORE PDL BASE + MOVE B,D ; CHANNEL TO B + HRRZ 0,S.DIR(C) ; AND DIR + JUMPE 0,TTYSPC +TTY1: DOTCAL TTYGET,[CHANNO(B),[2000,,0],[2000,,A],[2000,,D]] + .LOSE %LSSYS + DOTCAL TTYSET,[CHANNO(B),MODE1,MODE2,D] + .LOSE %LSSYS + MOVE A,[PUSHJ P,GMTYO] + MOVEM A,IOINS(B) + DOTCAL RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]] + .LOSE %LSSYS + MOVEM D,LINLN(B) + MOVEM A,PAGLN(B) + JRST OPNWIN + +; MAKE AN IOT + +IOTMAK: HRLZ A,CHANNO(B) ; GET CHANNEL + ROT A,5 + IOR A,[.IOT A] ; BUILD IOT + MOVEM A,IOINS(B) ; AND STORE IT + POPJ P, + + +; HERE IF POSSIBLY OPENING AN ALREADY OPEN TTY + +SAMTYQ: MOVE D,1(E) ; RESTORE CURRENT CHANNEL + MOVE A,DIRECT-1(D) ; GET DIR + MOVE B,DIRECT(D) + PUSHJ P,STRTO6 + POP P,A ; GET SIXBIT + MOVE C,T.SPDL+1(TB) + HRRZ C,S.DIR(C) + CAME A,MODES(C) ; SKIP IF DIFFERENT DIRECTION + JRST TTYLP1 + +; HERE IF A RE-OPEN ON A TTY + + HRRZ 0,FSAV(TB) ; IS IT FROM A FOPEN + CAIN 0,FOPEN + JRST RETOLD ; RET OLD CHANNEL + + PUSH TP,$TCHAN + PUSH TP,1(E) ; PUSH OLD CHANNEL + PUSH TP,$TFIX + PUSH TP,T.CHAN+1(TB) + MOVE A,[PUSHJ P,CHNFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + SUB TP,[4,,4] + +RETOLD: MOVE B,1(E) ; GET CHANNEL + AOS CHANNO-1(B) ; AOS REF COUNT + MOVSI A,TCHAN + SUB P,[1,,1] ; CLEAN UP STACK + JRST OPNRET ; AND LEAVE + + +; ROUTINE TO PASS TO GCHACK TO FIX UP CHANNEL POINTER + +CHNFIX: CAIN C,TCHAN + CAME D,(TP) + POPJ P, + MOVE D,-2(TP) ; GET REPLACEMENT + SKIPE B + MOVEM D,1(B) ; CLOBBER IT AWAY + POPJ P, +] + +IFE ITS,[ + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ 0,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVE A,[PUSHJ P,INMTYO] + MOVE B,T.CHAN+1(TB) + MOVEM A,IOINS(B) + MOVEI A,100 ; PRIM INPUT JFN + JUMPN 0,TNXTY1 + MOVEI E,C.OPN+C.READ+C.TTY + HRRM E,-2(B) + MOVEM B,CHNL0+2*100+1 + JRST TNXTY2 +TNXTY1: MOVEM B,CHNL0+2*101+1 + MOVEI A,101 ; PRIM OUTPUT JFN + MOVEI E,C.OPN+C.PRIN+C.TTY + HRRM E,-2(B) +TNXTY2: MOVEM A,CHANNO(B) + JUMPN 0,OPNWIN +] +; SETUP FUNNY BUFFER FOR TTY INPUT DEVICES + +TTYSPC: MOVEI A,EXTBFR ; GET EXTRA BUFFER + PUSHJ P,IBLOCK ; GET BLOCK + MOVE D,T.CHAN+1(TB) ;RESTORE CHANNEL POINTER +IFN ITS,[ + MOVE A,CHANNO(D) + LSH A,23. + IOR A,[.IOT A] + MOVEM A,IOIN2(B) +] +IFE ITS,[ + MOVE A,[PBIN] + MOVEM A,IOIN2(B) +] + MOVSI A,TLIST + MOVEM A,EXBUFR-1(D) ; FOR WAITING TTY BUFFERS + SETZM EXBUFR(D) ; NIL LIST + MOVEM B,BUFRIN(D) ;STORE IN CHANNEL + MOVSI A,TUVEC ;MAKE SURE TYPE IS UNIFORM VECTOR + HLLM A,BUFRIN-1(D) + MOVEI A,177 ;SET ERASER TO RUBOUT + MOVEM A,ERASCH(B) +IFE ITS,[ + MOVEI A,25 + MOVEM A,KILLCH(B) +] +IFN ITS,[ + SETZM KILLCH(B) ;NO KILL CHARACTER NEEDED +] + MOVEI A,33 ;BREAKCHR TO C.R. + MOVEM A,BRKCH(B) + MOVEI A,"\ ;ESCAPER TO \ + MOVEM A,ESCAP(B) + MOVE A,[010700,,BYTPTR(E)] ;RELATIVE BYTE POINTER + MOVEM A,BYTPTR(B) + MOVEI A,14 ;BARF BACK CHARACTER FF + MOVEM A,BRFCHR(B) + MOVEI A,^D + MOVEM A,BRFCH2(B) + +; SETUP DEFAULT TTY INTERRUPT HANDLER + + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TFIX + PUSH TP,[10] ; PRIORITY OF CHAR INT + PUSH TP,$TCHAN + PUSH TP,D + MCALL 3,EVENT ; 1ST MAKE AN EVENT EXIST + PUSH TP,A + PUSH TP,B + PUSH TP,$TSUBR + PUSH TP,[QUITTER] ; DEFAULT HANDLER IS QUITTER + MCALL 2,HANDLER + +; BUILD A NULL STRING + + MOVEI A,0 + PUSHJ P,IBLOCK ; USE A BLOCK + MOVE D,T.CHAN+1(TB) + MOVEI 0,C.BUF + IORM 0,-2(D) + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + MOVEM A,BUFSTR-1(D) + MOVEM B,BUFSTR(D) + MOVEI A,0 + MOVE B,D ; CHANNEL TO B + JRST MAKION + + +; ROUTINE TO OPEN ITS CHANNEL WITHOUT .RCHST + +IFN ITS,[ +OPEN2: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN ; OPEN THE FILE + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; SAVE THE CHANNEL + JRST OPEN3 + +; FIX UP MODE AND FALL INTO OPEN + +OPEN0: HRRZ A,S.DIR(C) ; GET DIR + TRNE A,2 ; SKIP IF NOT BLOCK + IORI A,4 ; TURN ON IMAGE + IORI A,2 ; AND BLOCK + + PUSH P,A + PUSH TP,$TPDL + PUSH TP,C ; SAVE CRUFT TO CHECK FOR PRINTO, HA HA + MOVE B,T.CHAN+1(TB) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) ; THIS KLUDGE THE MESS OF NDR + PUSHJ P,STRTO6 + MOVE C,(TP) + POP P,D ; THE SIXBIT FOR KLUDGE + POP P,A ; GET BACK THE RANDOM BITS + SUB TP,[2,,2] + CAME D,[SIXBIT /PRINAO/] + CAMN D,[SIXBIT /PRINTO/] + IORI A,100000 ; WRITEOVER BIT + HRRZ 0,FSAV(TB) + CAIN 0,NFOPEN + IORI A,10 ; DON'T CHANGE REF DATE +OPEN9: HRLM A,S.DIR(C) ; AND STORE IT + +; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL + +OPEN1: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; CLOBBER INTO CHANNEL + DOTCAL RFNAME,[A,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] + JFCL + +; NOW CLOBBER THE TVP SLOT FOR THIS CHANNEL + +OPEN3: MOVE A,S.DIR(C) + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) ; GET CHANNEL # + ASH A,1 + ADDI A,CHNL0 ; POINT TO SLOT + MOVEM B,1(A) ; NOT: TYPE ALREADY SETUP + +; NOW GET STATUS WORD + +DOSTAT: HRRZ A,CHANNO(B) ; NOW GET STATUS WORD + DOTCAL STATUS,[A,[2002,,STATUS]] + JFCL + POPJ P, + + +; HERE IF OPEN FAILS (CHANNEL IS IN A) + +OPNLOS: JUMPL A,NOCHAN ; ALL CHANNELS ARE IN USE + LSH A,23. ; DO A .STATUS + IOR A,[.STATUS A] + XCT A ; STATUS TO A + MOVE B,T.CHAN+1(TB) + PUSHJ P,GFALS ; GET A FALSE WITH A MESSAGE + SUB P,[1,,1] ; EXTRA RET ADDR FLUSHED + JRST OPNRET ; AND RETURN +] + +CGFALS: SUBM M,(P) + MOVEI B,0 +IFN ITS, PUSHJ P,GFALS +IFE ITS, PUSHJ P,TGFALS + JRST MPOPJ + +; ROUTINE TO CONS UP FALSE WITH REASON +IFN ITS,[ +GFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,[SIXBIT / ERR/] ; SET UP OPEN TO ERR DEV + PUSH P,[3] ; SAY ITS FOR CHANNEL + PUSH P,A + .OPEN 0,-2(P) ; USE CHANNEL 0 FOR THIS + FATAL CAN'T OPEN ERROR DEVICE + SUB P,[3,,3] ; DONT WANT OPEN BLOCK NOW +IFN FNAMS, PUSH P,A + MOVEI A,0 ; PREPARE TO BUILD STRING ON STACK +EL1: PUSH P,[0] ; WHERE IT WILL GO + MOVSI B,(<440700,,(P)>) ; BYTE POINTER TO TOP OF STACK +EL2: .IOT 0,0 ; GET A CHAR + JUMPL 0,EL3 ; JUMP ON -1,,3 + CAIN 0,3 ; EOF? + JRST EL3 ; YES, MAKE STRING + CAIN 0,14 ; IGNORE FORM FEEDS + JRST EL2 ; IGNORE FF + CAIE 0,15 ; IGNORE CR & LF + CAIN 0,12 + JRST EL2 + IDPB 0,B ; STUFF IT + TLNE B,760000 ; SIP IF WORD FULL + AOJA A,EL2 + AOJA A,EL1 ; COUNT WORD AND GO + +EL3: +IFN FNAMS,[ + SKIPN (P) + SUB P,[1,,1] + PUSH P,A + .CLOSE 0, + PUSHJ P,CHMAK + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST EL4 + MOVEI A,0 + MOVSI B,(<440700,,(P)>) + PUSH P,[0] + IRP XX,,[RDEVIC,RSNAME,RNAME1,RNAME2]YY,,[0,72,73,40] +IFSN YY,0,[ + MOVEI 0,YY + JSP E,1PUSH +] + MOVE E,-2(TP) + MOVE C,XX(E) + HRRZ D,XX-1(E) + JSP E,PUSHIT + TERMIN +] + SKIPN (P) ; ANY CHARS AT END? + SUB P,[1,,1] ; FLUSH XTRA + PUSH P,A ; PUT UP COUNT + .CLOSE 0, ; CLOSE THE ERR DEVICE + PUSHJ P,CHMAK ; MAKE STRING + PUSH TP,A + PUSH TP,B +IFN FNAMS,[ +EL4: POP P,A + PUSH TP,$TFIX + PUSH TP,A] +IFE FNAMS, MOVEI A,1 +IFN FNAMS,[ + MOVEI A,3 + SKIPN B + MOVEI A,2 +] + PUSHJ P,IILIST + MOVSI A,TFALSE ; MAKEIT A FALSE +IFN FNAMS, SUB TP,[2,,2] + POPJ P, + +IFN FNAMS,[ +1PUSH: MOVEI D,0 + JRST PUSHI2 +PUSHI1: PUSH P,[0] + MOVSI B,(<440700,,(P)>) +PUSHIT: SOJL D,(E) + ILDB 0,C +PUSHI2: IDPB 0,B + TLNE B,760000 + AOJA A,PUSHIT + AOJA A,PUSHI1 +] +] + + +; ROUTINE TO FILL IN THE "REAL" SLOTS FOR THE CHANNEL + +FIXREA: +IFE ITS, HRLZS S.DEV(C) ; KILL MODE BITS + MOVE D,[-4,,S.DEV] + +FIXRE1: MOVEI A,(D) ; COPY REL POINTER + ADD A,T.SPDL+1(TB) ; POINT TO SLOT + SKIPN A,(A) ; SKIP IF GOODIE THERE + JRST FIXRE2 + PUSHJ P,6TOCHS ; MAKE INOT A STRING + MOVE C,RDTBL-S.DEV(D); GET OFFSET + ADD C,T.CHAN+1(TB) + MOVEM A,-1(C) + MOVEM B,(C) +FIXRE2: AOBJN D,FIXRE1 + POPJ P, + +IFN ITS,[ +DOOPN: HRLZ A,A + HRR A,CHANNO(B) ; GET CHANNEL + DOTCAL OPEN,[A,-3(P),-2(P),-1(P),(P)] + SKIPA + AOS -1(P) + POPJ P, +] + +;THIS ROUTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES +STRTO6: PUSH TP,A + PUSH TP,B + PUSH P,E ;SAVE USEFUL FROB + MOVEI E,(A) ; CHAR COUNT TO E + GETYP A,A + CAIE A,TCHSTR ; IS IT ONE WORD? + JRST WRONGT ;NO + CAILE E,6 ; SKIP IF L=? 6 CHARS + MOVEI E,6 +CHREAD: MOVEI A,0 ;INITIALIZE OUTPUT WORD + MOVE D,[440600,,A] ;AND BYTE POINTER TO IT +NEXCHR: SOJL E,SIXDON + ILDB 0,B ; GET NEXT CHAR + CAIN 0,^Q ; CNTL-Q, QUOTES NEXT CHAR + JRST NEXCHR + JUMPE 0,SIXDON ;IF NULL, WE ARE FINISHED + PUSHJ P,A0TO6 ; CONVERT TO SIXBIT + IDPB 0,D ;DEPOSIT INTO SIX BIT + JRST NEXCHR ; NO, GET NEXT +SIXDON: SUB TP,[2,,2] ;FIX UP TP + POP P,E + EXCH A,(P) ;LEAVE RESULT ON P-STACK + JRST (A) ;NOW RETURN + + +;SUBROUTINE TO CONVERT SIXBIT TO ATOM + +6TOCHS: PUSH P,E + PUSH P,D + MOVEI B,0 ;MAX NUMBER OF CHARACTERS + PUSH P,[0] ;STRING WILL GO ON P SATCK + JUMPE A,GETATM ; EMPTY, LEAVE + MOVEI E,-1(P) ;WILL BE BYTE POINTER + HRLI E,10700 ;SET IT UP + PUSH P,[0] ;SECOND POSSIBLE WORD + MOVE D,[440600,,A] ;INPUT BYTE POINTER +6LOOP: ILDB 0,D ;START CHAR GOBBLING + ADDI 0,40 ;CHANGET TOASCII + IDPB 0,E ;AND STORE IT + TLNN D,770000 ; SKIP IF NOT DONE + JRST 6LOOP1 + TDNN A,MSKS(B) ; CHECK IF JUST SPACES LEFT + AOJA B,GETATM ; YES, DONE + AOJA B,6LOOP ;KEEP LOOKING +6LOOP1: PUSH P,[6] ;IF ARRIVE HERE, STRING IS 2 WORDS + JRST .+2 +GETATM: MOVEM B,(P) ;SET STRING LENGTH=1 + PUSHJ P,CHMAK ;MAKE A MUDDLE STRING + POP P,D + POP P,E + POPJ P, + +MSKS: 7777,,-1 + 77,,-1 + ,,-1 + 7777 + 77 + + +; CONVERT ONE CHAR + +A0TO6: CAIL 0,141 ;IF IT IS GREATER OR EQUAL TO LOWER A + CAILE 0,172 ;BUT LESS THAN OR EQUAL TO LOWER Z + JRST .+2 ;THEN + SUBI 0,40 ;CONVERT TO UPPER CASE + SUBI 0,40 ;NOW TO SIX BIT + JUMPL 0,BAD6 ;CHECK FOR A WINNER + CAILE 0,77 + JRST BAD6 + POPJ P, + +; SUBR TO TEST THE EXISTENCE OF FILES + +MFUNCTION FEXIST,SUBR,[FILE-EXISTS?] + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + ADD TP,[2,,2] + MOVSI E,-4 ; 4 THINGS TO PUSH +EXIST: +IFN ITS, MOVE B,@RNMTBL(E) +IFE ITS, MOVE B,@FETBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST EXIST1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ +; PUSH P,E +; PUSHJ P,ADDNUL ; NOT NEEDED, SINCE CONSED INTO ONE STRING-TAA +; POP P,E + PUSH TP,A ; DEFAULT TYPE AND VALUE GIVEN BY USER + PUSH TP,B ; IN VALUE OF DEV, SNM, NM1, NM2 + ] +IFN ITS, JRST .+2 +IFE ITS, JRST .+3 + +EXIST1: +IFN ITS, PUSH P,EXISTS(E) ; USE DEFAULT +IFE ITS,[ + PUSH TP,FETYP(E) ; DEFAULT TYPE AND VALUE IF NO + PUSH TP,FEVAL(E) ; DEFAULT GIVEN BY USER + ] + AOBJN E,EXIST + + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST TMA ; TOO MANY ARGUMENTS + +IFN ITS,[ + MOVE 0,-3(P) ; GET SIXBIT DEV NAME + MOVEI B,0 + CAMN 0,[SIXBITS /DSK /] + MOVSI B,10 ; DONT SET REF DATE IF DISK DEV + .IOPUSH + DOTCAL OPEN,[B,[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST .+3 + .IOPOP + JRST FDLWON ; WON!!! + .STATUS 0,A ; FIND THE STATUS OF CHANNEL BEFORE POPING + .IOPOP + JRST FDLST1] + +IFE ITS,[ + MOVE B,TB + SUBI B,10 ; GET B TO POINT CORRECTLY TO ARGS + PUSHJ P,STSTK ; GET FILE NAME IN A STRING + HRROI B,1(E) ; POINT B TO THE STRING + MOVSI A,100001 + GTJFN + JRST TDLLOS ; FILE DOES NOT EXIST + RLJFN ; FILE EXIST SO RETURN JFN + JFCL + JRST FDLWON ; SUCCESS + ] + +IFN ITS,[ +EXISTS: SIXBITS /DSK INPUT > / + ] +IFE ITS,[ +FETBL: SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + +FETYP: TCHSTR,,5 + TCHSTR,,3 + TCHSTR,,3 + TCHSTR,,0 + +FEVAL: 440700,,[ASCIZ /INPUT/] + 440700,,[ASCIZ /MUD/] + 440700,,[ASCIZ /DSK/] + 0 + ] + +; SUBR TO DELETE AND RENAME FILES + +MFUNCTION RENAME,SUBR + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + GETYP 0,(AB) ; GET 1ST ARG TYPE +IFN ITS,[ + CAIN 0,TCHAN ; CHANNEL? + JRST CHNRNM ; MUST BE RENAME WHILE OPEN FOR WRITING +] +IFE ITS,[ + PUSH P,[100000,,-2] + PUSH P,[377777,,377777] +] + MOVSI E,-4 ; 4 THINGS TO PUSH +RNMALP: MOVE B,@RNMTBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST RNMLP1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ + PUSH P,E + PUSHJ P,ADDNUL + EXCH B,(P) + MOVE E,B +] + JRST .+2 + +RNMLP1: PUSH P,RNSTBL(E) ; USE DEFAULT + AOBJN E,RNMALP + +IFN ITS,[ + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST RNM1 ; COULD BE A RENAME + +; HERE TO DELETE A FILE + +DELFIL: MOVE A,(P) ; AND GET SNAME + .SUSET [.SSNAM,,A] + DOTCAL DELETE,[[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST FDLST ; ANALYSE ERROR + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS +] +IFE ITS,[ + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; GET BASE OF PDL + MOVEI A,1(A) ; POINT TO CRAP + CAMGE AB,[-3,,] ; SKIP IF DELETE + HLLZS (A) ; RESET DEFAULT + PUSH P,[0] + PUSH P,[0] + PUSH P,[0] + GTJFN ; GET A JFN + JRST TDLLOS ; LOST + ADD AB,[2,,2] ; PAST ARG + JUMPL AB,RNM1 ; GO TRY FOR RENAME + MOVE P,(TP) ; RESTORE P STACK + MOVEI C,(A) ; FOR RELEASE + DELF ; ATTEMPT DELETE + JRST DELLOS ; LOSER + RLJFN ; MAKE SURE FLUSHED + JFCL + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +RNMLOS: PUSH P,A + MOVEI A,(B) + RLJFN + JFCL +DELLO1: MOVEI A,(C) + RLJFN + JFCL + POP P,A ; ERR NUMBER BACK +TDLLOS: MOVEI B,0 + PUSHJ P,TGFALS ; GET FALSE WITH REASON + JRST FINIS + +DELLOS: PUSH P,A ; SAVE ERROR + JRST DELLO1 +] + +;TABLE OF REANMAE DEFAULTS +IFN ITS,[ +RNMTBL: IMQUOTE DEV + IMQUOTE NM1 + IMQUOTE NM2 + IMQUOTE SNM + +RNSTBL: SIXBIT /DSK _MUDS_> / +] +IFE ITS,[ +RNMTBL: SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + +RNSTBL: -1,,[ASCIZ /DSK/] + 0 + -1,,[ASCIZ /_MUDS_/] + -1,,[ASCIZ /MUD/] +] +; HERE TO DO A RENAME + +RNM1: JUMPGE AB,TMA ; IF ARGS EXHAUSTED, MUST BE TOO MUCH STRING + GETYP 0,(AB) + MOVE C,1(AB) ; GET ARG + CAIN 0,TATOM ; IS IT "TO" + CAME C,IMQUOTE TO + JRST WRONGT ; NO, LOSE + ADD AB,[2,,2] ; BUMP PAST "TO" + JUMPGE AB,TFA +IFN ITS,[ + MOVEM P,T.SPDL+1(TB) ; SAVE NEW P-BASE + + MOVEI 0,4 ; FOUR DEFAULTS + PUSH P,-3(P) ; DEFAULT DEVICE IS CURRENT + SOJN 0,.-1 + + PUSHJ P,RGPRS ; PARSE THE NEXT STRING + JRST TMA + + MOVE A,-7(P) ; FIX AND GET DEV1 + MOVE B,-3(P) ; SAME FOR DEV2 + CAME A,B ; SAME? + JRST DEVDIF + + POP P,A ; GET SNAME 2 + CAME A,(P)-3 ; SNAME 1 + JRST DEVDIF + .SUSET [.SSNAM,,A] + POP P,-2(P) ; MOVE NAMES DOWN + POP P,-2(P) + DOTCAL RENAME,[[17,,-4],[17,,-3],[17,,-2],A,[17,,-1],(P)] + JRST FDLST + JRST FDLWON + +; HERE FOR RENAME WHILE OPEN FOR WRITING + +CHNRNM: ADD AB,[2,,2] ; NEXT ARG + JUMPGE AB,TFA + MOVE B,-1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; SKIP IF OPEN + JRST BADCHN + MOVE A,DIRECT-1(B) ; CHECK DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A + CAME A,[SIXBIT /PRINT/] + CAMN A,[SIXBIT /PRINTB/] + JRST CHNRN1 + CAMN A,[SIXBIT /PRINAO/] + JRST CHNRM1 + CAME A,[SIXBIT /PRINTO/] + JRST WRONGD + +; SET UP .FDELE BLOCK + +CHNRN1: PUSH P,[0] + PUSH P,[0] + MOVEM P,T.SPDL+1(TB) + PUSH P,[0] + PUSH P,[SIXBIT /_MUDL_/] + PUSH P,[SIXBIT />/] + PUSH P,[0] + + PUSHJ P,RGPRS ; PARSE THESE + JRST TMA + + SUB P,[1,,1] ; SNAME/DEV IGNORED + MOVE AB,ABSAV(TB) ; GET ORIG ARG POINTER + MOVE B,1(AB) + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RENMWO,[A,[17,,-1],(P)] + JRST FDLST + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RFNAME,[A,[2017,,-4],[2017,,-3],[2017,,-2],[2017,,-1]] + JFCL + MOVE A,-3(P) ; UPDATE CHANNEL + PUSHJ P,6TOCHS ; GET A STRING + MOVE C,1(AB) + MOVEM A,RNAME1-1(C) + MOVEM B,RNAME1(C) + MOVE A,-2(P) + PUSHJ P,6TOCHS + MOVE C,1(AB) + MOVEM A,RNAME2-1(C) + MOVEM B,RNAME2(C) + MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS +] +IFE ITS,[ + PUSH P,A + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; PBASE BACK + PUSH A,[400000,,0] + MOVEI A,(A) + GTJFN + JRST TDLLOS + POP P,B + EXCH A,B + MOVEI C,(A) ; FOR RELEASE ATTEMPT + RNAMF + JRST RNMLOS + MOVEI A,(B) + RLJFN ; FLUSH JFN + JFCL + MOVEI A,(C) ; MAKE SURR OTHER IS FLUSHED + RLJFN + JFCL + JRST FDLWON + + +ADDNUL: PUSH TP,A + PUSH TP,B + MOVEI A,(A) ; LNTH OF STRING + IDIVI A,5 + JUMPN B,NONUAD ; DONT NEED TO ADD ONE + + PUSH TP,$TCHRS + PUSH TP,[0] + MOVEI A,2 + PUSHJ P,CISTNG ; COPY OF STRING + POPJ P, + +NONUAD: POP TP,B + POP TP,A + POPJ P, +] +; HERE FOR LOSING .FDELE + +IFN ITS,[ +FDLST: .STATUS 0,A ; GET STATUS +FDLST1: MOVEI B,0 + PUSHJ P,GFALS ; ANALYZE IT + JRST FINIS +] + +; SOME .FDELE ERRORS + +DEVDIF: ERRUUO EQUOTE DEVICE-OR-SNAME-DIFFERS + + ; HERE TO RESET A READ CHANNEL + +MFUNCTION FRESET,SUBR,RESET + + ENTRY 1 + GETYP A,(AB) + CAIE A,TCHAN + JRST WTYP1 + MOVE B,1(AB) ;GET CHANNEL + SKIPN IOINS(B) ; OPEN? + JRST REOPE1 ; NO, IGNORE CHECKS +IFN ITS,[ + MOVE A,STATUS(B) ;GET STATUS + ANDI A,77 + JUMPE A,REOPE1 ;IF IT CLOSED, JUST REOPEN IT, MAYBE? + CAILE A,2 ;SKIPS IF TTY FLAVOR + JRST REOPEN +] +IFE ITS,[ + MOVE A,CHANNO(B) + CAIE A,100 ; TTY-IN + CAIN A,101 ; TTY-OUT + JRST .+2 + JRST REOPEN +] + CAME B,TTICHN+1 + CAMN B,TTOCHN+1 + JRST REATTY +REATT1: MOVEI B,DIRECT-1(B) ;POINT TO DIRECTION + PUSHJ P,CHRWRD ;CONVERT TO A WORD + JFCL + CAME B,[ASCII /READ/] + JRST TTYOPN + MOVE B,1(AB) ;RESTORE CHANNEL + PUSHJ P,RRESET" ;DO REAL RESET + JRST TTYOPN + +REOPEN: PUSH TP,(AB) ;FIRST CLOSE IT + PUSH TP,(AB)+1 + MCALL 1,FCLOSE + MOVE B,1(AB) ;RESTORE CHANNEL + +; SET UP TEMPS FOR OPNCH + +REOPE1: PUSH P,[0] ; WILL HOLD DIR CODE + PUSH TP,$TPDL + PUSH TP,P + IRP A,,[DIRECT,RNAME1,RNAME2,RDEVIC,RSNAME,ACCESS] + PUSH TP,A-1(B) + PUSH TP,A(B) + TERMIN + + PUSH TP,$TCHAN + PUSH TP,1(AB) + + MOVE A,T.DIR(TB) + MOVE B,T.DIR+1(TB) ; GET DIRECTION + PUSHJ P,CHMOD ; CHECK THE MODE + MOVEM A,(P) ; AND STORE IT + +; NOW SET UP OPEN BLOCK IN SIXBIT + +IFN ITS,[ + MOVSI E,-4 ; AOBN PNTR +FRESE2: MOVE B,T.CHAN+1(TB) + MOVEI A,@RDTBL(E) ; GET ITEM POINTER + GETYP 0,-1(A) ; GET ITS TYPE + CAIE 0,TCHSTR + JRST FRESE1 + MOVE B,(A) ; GET STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 +FRESE3: AOBJN E,FRESE2 +] +IFE ITS,[ + MOVE B,T.CHAN+1(TB) + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; RESULT ON STACK + HLRZS (P) +] + + PUSH P,[0] ; PUSH UP SOME DUMMIES + PUSH P,[0] + PUSH P,[0] + PUSHJ P,OPNCH ; ATTEMPT TO DO THEOPEN + GETYP 0,A + CAIE 0,TCHAN + JRST FINIS ; LEAVE IF FALSE OR WHATEVER + +DRESET: MOVE A,(AB) + MOVE B,1(AB) + SETZM CHRPOS(B) ;INITIALIZE THESE PARAMETERS + SETZM LINPOS(B) + SETZM ACCESS(B) + JRST FINIS + +TTYOPN: +IFN ITS,[ + MOVE B,1(AB) + CAME B,TTOCHN+1 + CAMN B,TTICHN+1 + PUSHJ P,TTYOP2 + PUSHJ P,DOSTAT + DOTCAL RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]] + .LOSE %LSSYS + MOVEM C,PAGLN(B) + MOVEM D,LINLN(B) +] + JRST DRESET + +IFN ITS,[ +FRESE1: CAIE 0,TFIX + JRST BADCHN + PUSH P,(A) + JRST FRESE3 +] + +; INTERFACE TO REOPEN CLOSED CHANNELS + +OPNCHN: PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FRESET + POPJ P, + +REATTY: PUSHJ P,TTYOP2 +IFE ITS, SKIPN DEMFLG ; SKIP IF DEMONFLAG IS ON + SKIPE NOTTY + JRST DRESET + MOVE B,1(AB) + JRST REATT1 + +; FUNCTION TO LIST ALL CHANNELS + +MFUNCTION CHANLIST,SUBR + + ENTRY 0 + + MOVEI A,N.CHNS-1 ;MAX # OF REAL CHANNELS + MOVEI C,0 + MOVEI B,CHNL1 ;POINT TO FIRST REAL CHANNEL + +CHNLP: SKIPN 1(B) ;OPEN? + JRST NXTCHN ;NO, SKIP + HRRE E,(B) ; ABOUT TO FLUSH? + JUMPL E,NXTCHN ; YES, FORGET IT + MOVE D,1(B) ; GET CHANNEL + HRRZ E,CHANNO-1(D) ; GET REF COUNT + PUSH TP,(B) + PUSH TP,1(B) + ADDI C,1 ;COUNT WINNERS + SOJGE E,.-3 ; COUNT THEM +NXTCHN: ADDI B,2 + SOJN A,CHNLP + + SKIPN B,CHNL0+1 ;NOW HACK LIST OF PSUEDO CHANNELS + JRST MAKLST +CHNLS: PUSH TP,(B) + PUSH TP,(B)+1 + ADDI C,1 + HRRZ B,(B) + JUMPN B,CHNLS + +MAKLST: ACALL C,LIST + JRST FINIS + + ; ROUTINE TO RESTORE A CLOSED CHANNEL TO ITS PREVIOUS STATE + + +REOPN: PUSH TP,$TCHAN + PUSH TP,B + SKIPN CHANNO(B) ; ONLY REAL CHANNELS + JRST PSUEDO + +IFN ITS,[ + MOVSI E,-4 ; SET UP POINTER FOR NAMES + +GETOPB: MOVE B,(TP) ; GET CHANNEL + MOVEI A,@RDTBL(E) ; GET POINTER + MOVE B,(A) ; NOW STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 ; LEAVES SIXBIT ON STACK + AOBJN E,GETOPB +] +IFE ITS,[ + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; GET DEV NAME IN SIXBIT +] + MOVE B,(TP) ; RESTORE CHANNEL + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,CHMOD ; CHECK FOR A VALID MODE + +IFN ITS, MOVE E,-3(P) ; GET DEVICE IN PROPER PLACE +IFE ITS, HLRZS E,(P) + MOVE B,(TP) ; RESTORE CHANNEL +IFN ITS, CAMN E,[SIXBIT /DSK /] +IFE ITS,[ + CAIE E,(SIXBIT /PS /) + CAIN E,(SIXBIT /DSK/) + JRST DISKH ; DISK WINS IMMEIDATELY + CAIE E,(SIXBIT /SS /) + CAIN E,(SIXBIT /SRC/) + JRST DISKH ; DISK WINS IMMEIDATELY +] +IFN ITS, CAMN E,[SIXBIT /TTY /] ; NO NEED TO RE-OPEN THE TTY +IFE ITS, CAIN E,(SIXBIT /TTY/) + JRST REOPD1 +IFN ITS,[ + AND E,[777700,,0] ; COULD BE "UTn" + MOVE D,CHANNO(B) ; GET CHANNEL + ASH D,1 + ADDI D,CHNL0 ; DON'T SEEM TO BE OPEN + SETZM 1(D) + SETZM CHANNO(B) + CAMN E,[SIXBIT /UT /] + JRST REOPD ; CURRENTLY, CANT RESTORE UTAPE CHANNLES + CAMN E,[SIXBIT /AI /] + JRST REOPD ; CURRENTLY CANT RESTORE AI CHANNELS + CAMN E,[SIXBIT /ML /] + JRST REOPD ; CURRENTLY CANT RESTORE ML CHANNELS + CAMN E,[SIXBIT /DM /] + JRST REOPD ; CURRENTLY CANT RESTORE DM CHANNELS +] + PUSH TP,$TCHAN ; TRY TO RESET IT + PUSH TP,B + MCALL 1,FRESET + +IFN ITS,[ +REOPD1: AOS -4(P) +REOPD: SUB P,[4,,4] +] +IFE ITS,[ +REOPD1: AOS -1(P) +REOPD: SUB P,[1,,1] +] +REOPD0: SUB TP,[2,,2] + POPJ P, + +IFN ITS,[ +DISKH: MOVE C,(P) ; SNAME + .SUSET [.SSNAM,,C] +] +IFE ITS,[ +DISKH: MOVEM A,(P) ; SAVE MODE WORD + PUSHJ P,STSTK ; STRING TO STACK + MOVE A,(E) ; RESTORE MODE WORD + PUSH TP,$TPDL + PUSH TP,E ; SAVE PDL BASE + MOVE B,-2(TP) ; CHANNEL BACK TO B +] + MOVE C,ACCESS(B) ; GET CHANNELS ACCESS + TRNN A,2 ; SKIP IF NOT ASCII CHANNEL + JRST DISKH1 + HRRZ D,ACCESS-1(B) ; IF PARTIAL WORD OUT + IMULI C,5 ; TO CHAR ACCESS + JUMPE D,DISKH1 ; NO SWEAT + ADDI C,(D) + SUBI C,5 +DISKH1: HRRZ D,BUFSTR-1(B) ; ANY CHARS IN MUDDLE BUFFER + JUMPE D,DISKH2 + TRNN A,1 ; SKIP IF OUTPUT CHANNEL + JRST DISKH2 + PUSH P,A + PUSH P,C + MOVEI C,BUFSTR-1(B) + PUSHJ P,BYTDOP ; FIND LENGTH OF WHOLE BUFFER + HLRZ D,(A) ; LENGTH + 2 TO D + SUBI D,2 + IMULI D,5 ; TO CHARS + SUB D,BUFSTR-1(B) + POP P,C + POP P,A +DISKH2: SUBI C,(D) ; UPDATE CHAR ACCESS + IDIVI C,5 ; BACK TO WORD ACCESS +IFN ITS,[ + IORI A,6 ; BLOCK IMAGE + TRNE A,1 + IORI A,100000 ; WRITE OVER BIT + PUSHJ P,DOOPN + JRST REOPD + MOVE A,C ; ACCESS TO A + PUSHJ P,GETFLN ; CHECK LENGTH + CAIGE 0,(A) ; CHECK BOUNDS + JRST .+3 ; COMPLAIN + PUSHJ P,DOACCS ; AND ACESS + JRST REOPD1 ; SUCCESS + + MOVE A,CHANNO(B) ; CLOSE THE G.D. CHANNEL + PUSHJ P,MCLOSE + JRST REOPD + +DOACCS: PUSH P,A + HRRZ A,CHANNO(B) + DOTCAL ACCESS,[A,(P)] + JFCL + POP P,A + POPJ P, + +DOIOTO: +DOIOTI: +DOIOT: + PUSH P,0 + MOVSI 0,TCHAN + MOVE PVP,PVSTOR+1 + MOVEM 0,BSTO(PVP) ; IN CASE OF INTERRUPT + ENABLE + HRRZ 0,CHANNO(B) + DOTCAL IOT,[0,A] + JFCL + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + POP P,0 + POPJ P, + +GETFLN: MOVE 0,CHANNO(B) ; GET CHANNEL + .CALL FILBLK ; READ LNTH + .VALUE + POPJ P, + +FILBLK: SETZ + SIXBIT /FILLEN/ + 0 + 402000,,0 ; STUFF RESULT IN 0 +] +IFE ITS,[ + MOVEI A,CHNL0 + ADD A,CHANNO(B) + ADD A,CHANNO(B) + SETZM 1(A) ; MAY GET A DIFFERENT JFN + HRROI B,1(E) ; TENEX STRING POINTER + MOVSI A,400001 ; MAKE SURE + GTJFN ; GO GET IT + JRST RGTJL ; COMPLAIN + MOVE D,-2(TP) + HRRZM A,CHANNO(D) ; COULD HAVE CHANGED + MOVE P,(TP) ; RESTORE P + MOVEI B,CHNL0 + ASH A,1 ; MUNG ITS SLOT + ADDI A,(B) + MOVEM D,1(A) + HLLOS (A) ; MARK CHANNEL NOT TO BE RELOOKED AT + MOVE A,(P) ; MODE WORD BACK + MOVE B,[440000,,200000] ; FLAG BITS + TRNE A,1 ; SKIP FOR INPUT + TRC B,300000 ; CHANGE TO WRITE + MOVE A,CHANNO(D) ; GET JFN + OPENF + JRST ROPFLS + MOVE E,C ; LENGTH TO E + SIZEF ; GET CURRENT LENGTH + JRST ROPFLS + CAMGE B,E ; STILL A WINNER + JRST ROPFLS + MOVE A,CHANNO(D) ; JFN + MOVE B,C + SFPTR + JRST ROPFLS + SUB TP,[2,,2] ; FLUSH PDL POINTER + JRST REOPD1 + +ROPFLS: MOVE A,-2(TP) + MOVE A,CHANNO(A) + CLOSF ; ATTEMPT TO CLOSE + JFCL ; IGNORE FAILURE + SKIPA + +RGTJL: MOVE P,(TP) + SUB TP,[2,,2] + JRST REOPD + +DOACCS: PUSH P,B + EXCH A,B + MOVE A,CHANNO(A) + SFPTR + JRST ACCFAI + POP P,B + POPJ P, +] +PSUEDO: AOS (P) ; ASSUME SUCCESS FOR NOW + MOVEI B,RDEVIC-1(B) ; SEE WHAT DEVICE IS + PUSHJ P,CHRWRD + JFCL + JRST REOPD0 ; NO, RETURN HAPPY +IFN 0,[ CAME B,[ASCII /E&S/] ; DISPLAY ? + CAMN B,[ASCII /DIS/] + SKIPA B,(TP) ; YES, REGOBBLE CHANNEL AND CONTINUE + JRST REOPD0 ; NO, RETURN HAPPY + PUSHJ P,DISROP + SOS (P) ; DISPLAY DID NOT REOPEN, UNDO ASSUMPTION OF SUCCESS + JRST REOPD0] + + ;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL + +MFUNCTION FCLOSE,SUBR,[CLOSE] + + ENTRY 1 ;ONLY ONE ARG + GETYP A,(AB) ;CHECK ARGS + CAIE A,TCHAN ;IS IT A CHANNEL + JRST WTYP1 + MOVE B,1(AB) ;PICK UP THE CHANNEL + HRRZ A,CHANNO-1(B) ; GET REF COUNT + SOJGE A,CFIN5 ; NOT READY TO REALLY CLOSE + CAME B,TTICHN+1 ; CHECK FOR TTY + CAMN B,TTOCHN+1 + JRST CLSTTY + MOVE A,[JRST CHNCLS] + MOVEM A,IOINS(B) ;CLOBBER THE IO INS + MOVE A,RDEVIC-1(B) ;GET THE NAME OF THE DEVICE + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 +IFN ITS, MOVE A,(P) +IFE ITS, HLRZS A,(P) + MOVE B,1(AB) ; RESTORE CHANNEL +IFN 0,[ + CAME A,[SIXBIT /E&S /] + CAMN A,[SIXBIT /DIS /] + PUSHJ P,DISCLS] + MOVE B,1(AB) ; IN CASE CLOBBERED BY DISCLS + SKIPN A,CHANNO(B) ;ANY REAL CHANNEL? + JRST REMOV ; NO, EITHER CLOSED OR PSEUDO CHANNEL + + MOVE A,DIRECT-1(B) ; POINT TO DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; CONVERT TO WORD + POP P,A +IFN ITS, LDB E,[360600,,(P)] ; FIRST CHAR OD DEV NAME +IFE ITS, LDB E,[140600,,(P)] ; FIRST CHAR OD DEV NAME + CAIE E,'T ; SKIP IF TTY + JRST CFIN4 + CAME A,[SIXBIT /READ/] ; SKIP IF WINNER + JRST CFIN1 +IFN ITS,[ + MOVE B,1(AB) ; IN ITS CHECK STATUS + LDB A,[600,,STATUS(B)] + CAILE A,2 + JRST CFIN1 +] + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE CHAR + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,OFF ; TURN OFF INTERRUPT +CFIN1: MOVE B,1(AB) + MOVE A,CHANNO(B) +IFN ITS,[ + PUSHJ P,MCLOSE +] +IFE ITS,[ + TLZ A,400000 ; FOR JFN RELEASE + CLOSF ; CLOSE THE FILE AND RELEASE THE JFN + JFCL + MOVE A,CHANNO(B) +] +CFIN: LSH A,1 + ADDI A,CHNL0+1 ;POINT TO THIS CHANNELS LSOT + SETZM CHANNO(B) + SETZM (A) ;AND CLOBBER IT + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) + HLLZS ACCESS-1(B) +CFIN2: HLLZS -2(B) + MOVSI A,TCHAN ;RETURN THE CHANNEL + JRST FINIS + +CLSTTY: ERRUUO EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL + + +REMOV: MOVEI D,CHNL0+1 ;ATTEMPT TO REMOVE FROM PSUEDO CHANNEL LIST +REMOV0: SKIPN C,D ;FOUND ON LIST ? + JRST CFIN2 ;NO, JUST IGNORE THIS CLOSED CHANNEL + HRRZ D,(C) ;GET POINTER TO NEXT + CAME B,(D)+1 ;FOUND ? + JRST REMOV0 + HRRZ D,(D) ;YES, SPLICE IT OUT + HRRM D,(C) + JRST CFIN2 + + +; CLOSE UP ANY LEFTOVER BUFFERS + +CFIN4: +; CAME A,[SIXBIT /PRINTO/] +; CAMN A,[SIXBIT /PRINTB/] +; JRST .+3 +; CAME A,[SIXBIT /PRINT/] +; JRST CFIN1 + MOVE B,1(AB) ; GET CHANNEL + HRRZ A,-2(B) ;GET MODE BITS + TRNN A,C.PRIN + JRST CFIN1 + GETYP 0,BUFSTR-1(B) ; IS THERE AN OUTPUT BUFFER + SKIPN BUFSTR(B) + JRST CFIN1 + CAIE 0,TCHSTR + JRST CFINX1 + PUSHJ P,BFCLOS +IFE ITS,[ + MOVE A,CHANNO(B) + MOVEI B,7 + SFBSZ + JFCL + CLOSF + JFCL +] + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) +CFINX1: HLLZS ACCESS-1(B) + JRST CFIN1 + +CFIN5: HRRM A,CHANNO-1(B) + JRST CFIN2 + ;SUBR TO DO .ACCESS ON A READ CHANNEL +;FORM: +;POSITIONS CHANNEL AT CHARACTER POSN FIX-NUMBER +;H. BRODIE 7/26/72 + +MFUNCTION MACCESS,SUBR,[ACCESS] + ENTRY 2 ;ARGS: CHANNEL AND FIX-NUMBER + +;CHECK ARGUMENT TYPES + GETYP A,(AB) + CAIE A,TCHAN ;FIRST ARG SHOULD BE CHANNEL + JRST WTYP1 + GETYP A,2(AB) ;TYPE OF SECOND + CAIE A,TFIX ;SHOULD BE FIX + JRST WTYP2 + +;CHECK DIRECTION OF CHANNEL + MOVE B,1(AB) ;B GETS PNTR TO CHANNEL +; MOVEI B,DIRECT-1(B) ;GET DIRECTION OF CHANNEL +; PUSHJ P,CHRWRD ;GRAB THE CHAR STRNG +; JFCL +; CAME B,[+1] + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.PRIN + JRST MACCA + MOVE B,1(AB) + SKIPE C,BUFSTR(B) ;SEE IF WE MUST FLUSH PART BUFFER + PUSHJ P,BFCLOS + JRST MACC +MACCA: +; CAMN B,[ASCIZ /READ/] +; JRST .+4 +; CAME B,[ASCIZ /READB/] ; READB CHANNEL? +; JRST WRONGD +; AOS (P) ; SET INDICATOR FOR BINARY MODE + +;CHECK THAT THE CHANNEL IS OPEN +MACC: MOVE B,1(AB) ;GET BACK PTR TO CHANNEL + HRRZ E,-2(B) + TRNN E,C.OPN + JRST CHNCLS ;IF CHNL CLOSED => ERROR + +;COMPUTE ACCESS PNTR TO ACCESS WORD CHAR IS IN +;REMAINDER IS NUMBER OF TIMES TO INCR BYTE POINTER +ADEVOK: SKIPGE C,3(AB) ;GET CHAR POSN + ERRUUO EQUOTE NEGATIVE-ARGUMENT +MACC1: MOVEI D,0 + TRNN E,C.BIN ; SKIP FOR BINARY FILE + IDIVI C,5 + +;SETUP THE .ACCESS + TRNN E,C.PRIN + JRST NLSTCH + HRRZ 0,LSTCH-1(B) + MOVE A,ACCESS(B) + TRNN E,C.BIN + JRST LSTCH1 + IMULI A,5 + ADD A,ACCESS-1(B) + ANDI A,-1 +LSTCH1: CAIG 0,(A) + MOVE 0,A + MOVE A,C + IMULI A,5 + ADDI A,(D) + CAML A,0 + MOVE 0,A + HRRM 0,LSTCH-1(B) ; UPDATE "LARGEST" +NLSTCH: MOVE A,CHANNO(B) ;A GETS REAL CHANNEL NUMBER +IFN ITS,[ + DOTCAL ACCESS,[A,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + +IFE ITS,[ + MOVE B,C + SFPTR ; DO IT IN TENEX + JRST ACCFAI + MOVE B,1(AB) ; RESTORE CHANNEL +] +; POP P,E ; CHECK FOR READB MODE + TRNN E,C.READ + JRST ACCOUT ; PRINT TYPE CHANNEL, GO DO IT + SKIPE BUFSTR(B) ; IS THERE A READ BUFFER TO FLUSH + JRST .+3 + SETZM LSTCH(B) ; CLEAR OUT POSSIBLE EOF INDICATOR + JRST DONADV + +;NOW FORCE GETCHR TO DO A .IOT FIRST THING + MOVEI C,BUFSTR-1(B) ; FIND END OF STRING + PUSHJ P,BYTDOP" + SUBI A,2 ; LAST REAL WORD + HRLI A,010700 + MOVEM A,BUFSTR(B) + HLLZS BUFSTR-1(B) ; CLOBBER CHAR COUNT + SETZM LSTCH(B) ;CLOBBER READ'S HIDDEN CHARACTER + +;NOW DO THE APPROPRIATE NUM OF BYTE ADVANCEMENTS + JUMPLE D,DONADV +ADVPTR: PUSHJ P,GETCHR + MOVE B,1(AB) ;RESTORE IN CASE CLOBBERED + SOJG D,ADVPTR + +DONADV: MOVE C,3(AB) ;FIXUP ACCESS SLOT IN CHNL + HLLZS ACCESS-1(B) + MOVEM C,ACCESS(B) + MOVE A,$TCHAN ;TYPE OF RESULT = "CHANNEL" + JRST FINIS ;DONE...B CONTAINS CHANNEL + +IFE ITS,[ +ACCFAI: ERRUUO EQUOTE ACCESS-FAILURE +] +ACCOUT: SKIPN C,BUFSTR(B) ; FIXUP BUFFER? + JRST ACCOU1 + HRRZ F,BUFSTR-1(B) + ADD F,[-BUFLNT*5-4] + IDIVI F,5 + ADD F,BUFSTR(B) + HRLI F,010700 + MOVEM F,BUFSTR(B) + MOVEI F,BUFLNT*5 + HRRM F,BUFSTR-1(B) +ACCOU1: TRNE E,C.BIN ; FINISHED FOR BINARY CHANNELS + JRST DONADV + + JUMPE D,DONADV ; THIS CASE OK +IFE ITS,[ + MOVE A,CHANNO(B) ; GET LAST WORD + RFPTR + JFCL + PUSH P,B + MOVNI C,1 + MOVE B,[444400,,E] ; READ THE WORD + SIN + JUMPL C,ACCFAI + POP P,B + SFPTR + JFCL + MOVE B,1(AB) ; CHANNEL BACK + MOVE C,[440700,,E] + ILDB 0,C + IDPB 0,BUFSTR(B) + SOS BUFSTR-1(B) + SOJG D,.-3 + JRST DONADV +] +IFN ITS, ERRUUO EQUOTE CANT-ACCESS-ASCII-ON-ITS + + +;WRONG TYPE OF DEVICE ERROR +WRDEV: ERRUUO EQUOTE NON-DSK-DEVICE + +; BINARY READ AND PRINT ROUTINES + +MFUNCTION PRINTB,SUBR + + ENTRY + +PBFL: PUSH P,. ; PUSH NON-ZERONESS + MOVEI A,-7 + JRST BINI1 + +MFUNCTION READB,SUBR + + ENTRY + + PUSH P,[0] + MOVEI A,-11 +BINI1: HLRZ 0,AB + CAILE 0,-3 + JRST TFA + CAIG 0,(A) + JRST TMA + + GETYP 0,(AB) ; SHOULD BE UVEC OR STORE + CAIE 0,TSTORAGE + CAIN 0,TUVEC + JRST BINI2 + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTOK + JRST WTYP1 ; ELSE LOSE +BINI2: MOVE B,1(AB) ; GET IT + HLRE C,B + SUBI B,(C) ; POINT TO DOPE + GETYP A,(B) + PUSHJ P,SAT" ; GET ITS ST.ALOC.TYPE + CAIE A,S1WORD + JRST WTYP1 +BYTOK: GETYP 0,2(AB) + CAIE 0,TCHAN ; BETTER BE A CHANNEL + JRST WTYP2 + MOVE B,3(AB) ; GET IT +; MOVEI B,DIRECT-1(B) ; GET DIRECTION OF +; PUSHJ P,CHRWRD ; INTO 1 WORD +; JFCL +; MOVNI E,1 +; CAMN B,[ASCII /READB/] +; MOVEI E,0 +; CAMN B,[+1] + HRRZ A,-2(B) ; MODE BITS + TRNN A,C.BIN ; IF NOT BINARY + JRST WRONGD + MOVEI E,0 + TRNE A,C.PRIN + MOVE E,PBFL +; JUMPL E,WRONGD ; LOSER + CAME E,(P) ; CHECK WINNGE + JRST WRONGD + MOVE B,3(AB) ; GET CHANNEL BACK + SKIPN A,IOINS(B) ; OPEN? + PUSHJ P,OPENIT ; LOSE + CAMN A,[JRST CHNCLS] + JRST CHNCLS ; LOSE, CLOSED + JUMPN E,BUFOU1 ; JUMP FOR OUTPUT + MOVEI C,0 + CAML AB,[-5,,] ; SKIP IF EOF GIVEN + JRST BINI5 + MOVE 0,4(AB) + MOVEM 0,EOFCND-1(B) + MOVE 0,5(AB) + MOVEM 0,EOFCND(B) + CAML AB,[-7,,] + JRST BINI5 + GETYP 0,6(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,7(AB) +BINI5: SKIPE LSTCH(B) ; INDICATES IF EOF HIT + JRST BINEOF + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTI + MOVE A,1(AB) ; GET VECTOR + PUSHJ P,PGBIOI ; READ IT + HLRE C,A ; GET COUNT DONE + HLRE D,1(AB) ; AND FULL COUNT + SUB C,D ; C=> TOTAL READ + ADDM C,ACCESS(B) + JUMPGE A,BINIOK ; NOT EOF YET + SETOM LSTCH(B) +BINIOK: MOVE B,C + MOVSI A,TFIX ; RETURN AMOUNT ACTUALLY READ + JRST FINIS + +BYTI: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-LOST + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-LOST + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE STRING LENGTH + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 + PUSH P,C + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SIN] + PUSHJ P,PGBIOT + HLRE C,A ; GET COUNT DONE + POP P,D + SKIPN D + HRRZ D,(AB) ; AND FULL COUNT + ADD D,C ; C=> TOTAL READ + LDB E,[300600,,1(AB)] + MOVEI A,36. + IDIVM A,E + IDIVM D,E + ADDM E,ACCESS(B) + SKIPGE C ; NOT EOF YET + SETOM LSTCH(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-LOST + MOVE C,D + JRST BINIOK +] +BUFOU1: SKIPE BUFSTR(B) ; ANY BUFFERS AROUND? + PUSHJ P,BFCLS1 ; GET RID OF SAME + MOVEI C,0 + CAML AB,[-5,,] + JRST BINO5 + GETYP 0,4(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,5(AB) +BINO5: MOVE A,1(AB) + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTO + PUSHJ P,PGBIOO + HLRE C,1(AB) + MOVNS C + ADDM C,ACCESS(B) +BYTO1: MOVE A,(AB) ; RET VECTOR ETC. + MOVE B,1(AB) + JRST FINIS + +BYTO: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-FAILURE + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-FAILURE + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE SIZE + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 ; COMPENSATE FOR PGBIOT DOING THE WRONG THING + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SOUT] + PUSHJ P,PGBIOT + LDB D,[300600,,1(AB)] + MOVEI C,36. + IDIVM C,D + HRRZ C,(AB) + IDIVI C,(D) + ADDM C,ACCESS(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-FAILURE + JRST BYTO1 +] + +BINEOF: PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOSER + MCALL 1,EVAL + JRST FINIS + +OPENIT: PUSH P,E + PUSHJ P,OPNCHN ;TRY TO OPEN THE LOSER + JUMPE B,CHNCLS ;FAIL + POP P,E + POPJ P, + ; THESE SUBROUTINES BY NDR 9/16/73 TO FACILITATE THE +; TYPES OF IO NECESSARY TO MAKE MORE EFFICIENT USE OF +; THE NETWORK AND DO RELATED FILE TRANSFER TYPE OF JOBS. + +R1CHAR: SKIPN A,LSTCH(B) ; CHAR READING ROUTINE FOR FCOPY + PUSHJ P,RXCT + TLO A,200000 ; ^@ BUG + MOVEM A,LSTCH(B) + TLZ A,200000 + JUMPL A,.+2 ; IN CASE OF -1 ON STY + TRZN A,400000 ; EXCL HACKER + JRST .+4 + MOVEM A,LSTCH(B) ; SAVE DE-EXCLED CHAR + MOVEI A,"! + JRST .+2 + SETZM LSTCH(B) + PUSH P,C + HRRZ C,DIRECT-1(B) + CAIE C,5 ; IF DIRECTION IS 5 LONG THEN READB + JRST R1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) ; EVERY FIFTY INCREMENT + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +R1CH1: AOS ACCESS(B) + POP P,C + POPJ P, + +W1CHAR: CAIE A,15 ; CHAR WRITING ROUTINE, TEST FOR CR + JRST .+3 + SETOM CHRPOS(B) + AOSA LINPOS(B) + CAIE A,12 ; TEST FOR LF + AOS CHRPOS(B) ; IF NOT LF AOS CHARACTE5R POSITION + CAIE A,14 ; TEST FOR FORM FEED + JRST .+3 + SETZM CHRPOS(B) ; IF FORM FEED ZERO CHARACTER POSITION + SETZM LINPOS(B) ; AND LINE POSITION + CAIE A,11 ; IS THIS A TAB? + JRST .+6 + MOVE C,CHRPOS(B) + ADDI C,7 + IDIVI C,8. + IMULI C,8. ; FIX UP CHAR POS FOR TAB + MOVEM C,CHRPOS(B) ; AND SAVE + PUSH P,C + HRRZ C,-2(B) ; GET BITS + TRNN C,C.BIN ; SIX LONG MUST BE PRINTB + JRST W1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +W1CH1: AOS ACCESS(B) + PUSH P,A + PUSHJ P,WXCT + POP P,A + POP P,C + POPJ P, + +R1C: SUBM M,(P) ;LITTLE ENTRY FOR COMPILED STUFF +; PUSH TP,$TCHAN ;SAVE THE CHANNEL TO BLESS IT +; PUSH TP,B +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JFCL +; CAME B,[ASCIZ /READ/] +; CAMN B,[ASCII /READB/] +; JRST .+2 +; JRST BADCHN + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.READ + JRST BADCHN + SKIPN IOINS(B) ; IS THE CHANNEL OPEN + PUSHJ P,OPENIT ; NO, GO DO IT + PUSHJ P,GRB ; MAKE SURE WE HAVE A READ BUFFER + PUSHJ P,R1CHAR ; AND GET HIM A CHARACTER + JRST MPOPJ ; THATS ALL FOLKS + +W1C: SUBM M,(P) + PUSHJ P,W1CI + JRST MPOPJ + +W1CI: +; PUSH TP,$TCHAN +; PUSH TP,B + PUSH P,A ; ASSEMBLER ENTRY TO OUTPUT 1 CHAR +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; INTERNAL CALL TO W1CHAR +; JFCL +; CAME B,[ASCII /PRINT/] +; CAMN B,[+1] +; JRST .+2 +; JRST BADCHN +; POP TP,B +; POP TP,(TP) + HRRZ A,-2(B) + TRNN A,C.PRIN + JRST BADCHN + SKIPN IOINS(B) ; MAKE SURE THAT IT IS OPEN + PUSHJ P,OPENIT + PUSHJ P,GWB + POP P,A ; GET THE CHAR TO DO + JRST W1CHAR + +; ROUTINES TO REPLACE XCT IOINS(B) FOR INPUT AND OUTPUT +; THEY DO THE XCT THEN CHECK OUT POSSIBLE SCRIPTAGE--BLECH. + + +WXCT: +RXCT: XCT IOINS(B) ; READ IT + SKIPN SCRPTO(B) + POPJ P, + +DOSCPT: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; AND SAVE THE CHAR AROUND + + SKIPN SCRPTO(B) ; IF ZERO FORGET IT + JRST SCPTDN ; THATS ALL THERE IS TO IT + PUSH P,C ; SAVE AN ACCUMULATOR FOR CLEANLINESS + GETYP C,SCRPTO-1(B) ; IS IT A LIST + CAIE C,TLIST + JRST BADCHN + PUSH TP,$TLIST + PUSH TP,[0] ; SAVE A SLOT FOR THE LIST + MOVE C,SCRPTO(B) ; GET THE LIST OF SCRIPT CHANNELS +SCPT1: GETYP B,(C) ; GET THE TYPE OF THIS SCRIPT CHAN + CAIE B,TCHAN + JRST BADCHN ; IF IT ISN'T A CHANNEL, COMPLAIN + HRRZ B,(C) ; GET THE REST OF THE LIST IN B + MOVEM B,(TP) ; AND STORE ON STACK + MOVE B,1(C) ; GET THE CHANNEL IN B + MOVE A,-1(P) ; AND THE CHARACTER IN A + PUSHJ P,W1CI ; GO TO INTERNAL W1C, IT BLESSES GOODIES + SKIPE C,(TP) ; GET THE REST OF LIST OF CHANS + JRST SCPT1 ; AND CYCLE THROUGH + SUB TP,[2,,2] ; CLEAN OFF THE LIST OF CHANS + POP P,C ; AND RESTORE ACCUMULATOR C +SCPTDN: POP P,A ; RESTORE THE CHARACTER + POP TP,B ; AND THE ORIGINAL CHANNEL + POP TP,(TP) + POPJ P, ; AND THATS ALL + + +; SUBROUTINE TO COPY FROM INCHAN TO OUTCHAN UNTIL EOF HIT +; ON THE INPUT CHANNEL +; CALL IS WHERE DEFAULTS ARE INCHAN AND OUTCHAN + + MFUNCTION FCOPY,SUBR,[FILECOPY] + + ENTRY + HLRE 0,AB + CAMGE 0,[-4] + JRST WNA ; TAKES FROM 0 TO 2 ARGS + + JUMPE 0,.+4 ; NO FIRST ARG? + PUSH TP,(AB) + PUSH TP,1(AB) ; SAVE IN CHAN + JRST .+6 + MOVE A,$TATOM + MOVE B,IMQUOTE INCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B + HLRE 0,AB ; CHECK FOR SECOND ARG + CAML 0,[-2] ; WAS THERE MORE THAN ONE ARG? + JRST .+4 + PUSH TP,2(AB) ; SAVE SECOND ARG + PUSH TP,3(AB) + JRST .+6 + MOVE A,$TATOM ; LOOK UP OUTCHAN AS DEFAULT + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B ; AND SAVE IT + + MOVE A,-3(TP) + MOVE B,-2(TP) ; INPUT CHANNEL + MOVEI 0,C.READ ; INDICATE INPUT + PUSHJ P,CHKCHN ; CHECK FOR GOOD CHANNEL + MOVE A,-1(TP) + MOVE B,(TP) ; GET OUT CHAN + MOVEI 0,C.PRIN ; INDICATE OUT CHAN + PUSHJ P,CHKCHN ; CHECK FOR GOOD OUT CHAN + + PUSH P,[0] ; COUNT OF CHARS OUTPUT + + MOVE B,-2(TP) + PUSHJ P,GRB ; MAKE SURE WE HAVE READ BUFF + MOVE B,(TP) + PUSHJ P,GWB ; MAKE SURE WE HAVE WRITE BUFF + +FCLOOP: INTGO + MOVE B,-2(TP) + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,FCDON ; IF A NEG NUMBER WE GOT EOF + MOVE B,(TP) ; GET OUT CHAN + PUSHJ P,W1CHAR ; SPIT IT OUT + AOS (P) ; INCREMENT COUNT + JRST FCLOOP + +FCDON: SUB TP,[2,,2] ; POP OFF OUTCHAN + MCALL 1,FCLOSE ; CLOSE INCHAN + MOVE A,$TFIX + POP P,B ; GET CHAR COUNT TO RETURN + JRST FINIS + +CHKCHN: PUSH P,0 ; CHECK FOR GOOD TASTING CHANNEL + PUSH TP,A + PUSH TP,B + GETYP C,A + CAIE C,TCHAN + JRST CHKBDC ; GO COMPLAIN IN RIGHT WAY +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JRST CHKBDC +; MOVE C,(P) ; GET CHAN DIRECT + HRRZ C,-2(B) ; MODE BITS + TDNN C,0 + JRST CHKBDC +; CAMN B,CHKT(C) +; JRST .+4 +; ADDI C,2 ; TEST FOR READB OR PRINTB ALSO +; CAME B,CHKT(C) ; TEST FOR CORRECT DIRECT +; JRST CHKBDC + MOVE B,(TP) + SKIPN IOINS(B) ; MAKE SURE IT IS OPEN + PUSHJ P,OPENIT ; IF ZERO IOINS GO OPEN IT + SUB TP,[2,,2] + POP P, ; CLEAN UP STACKS + POPJ P, + +CHKT: ASCIZ /READ/ + ASCII /PRINT/ + ASCII /READB/ + +1 + +CHKBDC: POP P,E + MOVNI D,2 + IMULI D,1(E) + HLRE 0,AB + CAMLE 0,D ; SEE IF THIS WAS HIS ARG OF DEFAULT + JRST BADCHN + JUMPE E,WTYP1 + JRST WTYP2 + + ; FUNCTIONS READSTRING AND PRINTSTRING WORK LIKE READB AND PRINTB, +; THAT IS THEY READ INTO AND OUT OF STRINGS. IN ADDITION BOTH ACCEPT +; AN ADDITIONAL ARGUMENT WHICH IS THE NUMBER OF CHARS TO READ OR PRINT, IF +; IT IS DESIRED FOR THIS TO BE DIFFERENT THAN THE LENGTH OF THE STRING. + +; FORMAT IS +; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN + +; FORMAT FOR PRINTSTRING IS + +; THESE WERE CODED 9/16/73 BY NEAL D. RYAN + + MFUNCTION RSTRNG,SUBR,READSTRING + + ENTRY + PUSH P,[0] ; FLAG TO INDICATE READING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-9] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 4 ARGS + JRST STRIO1 + + MFUNCTION PSTRNG,SUBR,PRINTSTRING + + ENTRY + PUSH P,[1] ; FLAG TO INDICATE WRITING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-7] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 3 ARGS + +STRIO1: PUSH TP,[0] ; SAVE SLOT ON STACK + PUSH TP,[0] + GETYP 0,(AB) + CAIE 0,TCHSTR ; MAKE SURE WE GOT STRING + JRST WTYP1 + HRRZ 0,(AB) ; CHECK FOR EMPTY STRING + SKIPN (P) + JUMPE 0,MTSTRN + HLRE 0,AB + CAML 0,[-2] ; WAS A CHANNEL GIVEN + JRST STRIO2 + GETYP 0,2(AB) + SKIPN (P) ; SKIP IF PRINT + JRST TESTIN + CAIN 0,TTP ; SEE IF FLATSIZE HACK + JRST STRIO9 +TESTIN: CAIE 0,TCHAN + JRST WTYP2 ; SECOND ARG NOT CHANNEL + MOVE B,3(AB) + HRRZ B,-2(B) + MOVNI E,1 ; CHECKING FOR GOOD DIRECTION + TRNE B,C.READ ; SKIP IF NOT READ + MOVEI E,0 + TRNE B,C.PRIN ; SKIP IF NOT PRINT + MOVEI E,1 + CAME E,(P) + JRST WRONGD ; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE +STRIO9: PUSH TP,2(AB) + PUSH TP,3(AB) ; PUSH ON CHANNEL + JRST STRIO3 +STRIO2: MOVE B,IMQUOTE INCHAN + MOVSI A,TCHAN + SKIPE (P) + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + GETYP 0,A + SKIPN (P) ; SKIP IF PRINTSTRING + JRST TESTI2 + CAIN 0,TTP ; SKIP IF NOT FLATSIZE HACK + JRST STRIO8 +TESTI2: CAIE 0,TCHAN + JRST BADCHN ; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL +STRIO8: PUSH TP,A + PUSH TP,B +STRIO3: MOVE B,(TP) ; GET CHANNEL + SKIPN E,IOINS(B) + PUSHJ P,OPENIT ; IF NOT GO OPEN + MOVE E,IOINS(B) + CAMN E,[JRST CHNCLS] + JRST CHNCLS ; CHECK TO SEE THAT CHANNEL ISNT ALREADY CLOSED +STRIO4: HLRE 0,AB + CAML 0,[-4] + JRST STRIO5 ; NO COUNT TO WORRY ABOUT + GETYP 0,4(AB) + MOVE E,4(AB) + MOVE C,5(AB) + CAIE 0,TCHSTR + CAIN 0,TFIX ; BETTER BE A FIXED NUMBER + JRST .+2 + JRST WTYP3 + HRRZ D,(AB) ; GET ACTUAL STRING LENGTH + CAIN 0,TFIX + JRST .+7 + SKIPE (P) ; TEST FOR WRITING + JRST .-7 ; IF WRITING WE GOT TROUBLE + PUSH P,D ; ACTUAL STRING LENGTH + MOVEM E,(TB) ; STUFF HIS FUNNY DELIM STRING + MOVEM C,1(TB) + JRST STRIO7 + CAML D,C ; MAKE SURE THE STRING IS LONG ENOUGH + JRST .+2 ; WIN + ERRUUO EQUOTE COUNT-GREATER-THAN-STRING-SIZE + PUSH P,C ; PUSH ON MAX COUNT + JRST STRIO7 +STRIO5: +STRIO6: HRRZ C,(AB) ; GET CHAR COUNT + PUSH P,C ; AND PUSH IT ON STACK AS NO MAX COUNT GIVEN +STRIO7: HLRE 0,AB + CAML 0,[-6] + JRST .+6 + MOVE B,(TP) ; GET THE CHANNEL + MOVE 0,6(AB) + MOVEM 0,EOFCND-1(B) ; STUFF IN SLOT IN CHAN + MOVE 0,7(AB) + MOVEM 0,EOFCND(B) + PUSH TP,(AB) ; PUSH ON STRING + PUSH TP,1(AB) + PUSH P,[0] ; PUSH ON CURRENT COUNT OF CHARS DONE + MOVE 0,-2(P) ; GET READ OR WRITE FLAG + JUMPN 0,OUTLOP ; GO WRITE STUFF + + MOVE B,-2(TP) ; GET CHANNEL + PUSHJ P,GRB ; MAKE SURE WE HAVE BUFF + SKIPGE A,LSTCH(B) ; CHECK FOR EOF ALREADY READ PREVIOUSLY + JRST SRDOEF ; GO DOES HIS EOF HACKING +INLOP: INTGO + MOVE B,-2(TP) ; GET CHANNEL + MOVE C,-1(P) ; MAX COUNT + CAMG C,(P) ; COMPARE WITH COUNT DONE + JRST STREOF ; WE HAVE FINISHED + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,INEOF ; EOF HIT + MOVE C,1(TB) + HRRZ E,(TB) ; DO WE HAVE A STRING TO WORRY US? + SOJL E,INLNT ; GO FINISH STUFFING + ILDB D,C + CAME D,A + JRST .-3 + JRST INEOF +INLNT: IDPB A,(TP) ; STUFF IN STRING + SOS -1(TP) ; DECREMENT STRING COUNT + AOS (P) ; INCREMENT CHAR COUNT + JRST INLOP + +INEOF: SKIPE C,LSTCH(B) ; IS THIS AN ! AND IS THERE A CHAR THERE + JRST .+3 ; YES + MOVEM A,LSTCH(B) ; NO SAVE THE CHAR + JRST .+3 + ADDI C,400000 + MOVEM C,LSTCH(B) + MOVSI C,200000 + IORM C,LSTCH(B) + HRRZ C,DIRECT-1(B) ; GET THE TYPE OF CHAN + CAIN C,5 ; IS IT READB? + JRST .+3 + SOS ACCESS(B) ; FIX UP ACCESS FOR READ CHANNEL + JRST STREOF ; AND THATS IT + HRRZ C,ACCESS-1(B) ; FOR A READB ITS WORSE + MOVEI D,5 + SKIPG C + HRRM D,ACCESS-1(B) ; CHANGE A 0 TO A FIVE + SOS C,ACCESS-1(B) + CAMN C,[TFIX,,0] + SOS ACCESS(B) ; AND SOS THE WORD COUNT MAYBE + JRST STREOF + +SRDOEF: SETZM LSTCH(B) ; IN CASE OF -1, FLUSH IT + AOJE A,INLOP ; SKIP OVER -1 ON PTY'S + SUB TP,[6,,6] + SUB P,[3,,3] ; POP JUNK OFF STACKS + PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) ; WHAT WE NEED TO EVAL + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOOSING CHANNEL + MCALL 1,EVAL ; EVAL HIS EOF JUNK + JRST FINIS + +OUTLOP: MOVE B,-2(TP) +OUTLP1: INTGO + MOVE A,-3(TP) ; GET CHANNEL + MOVE B,-2(TP) + MOVE C,-1(P) ; MAX COUNT TO DO + CAMG C,(P) ; HAVE WE DONE ENOUGH + JRST STREOF + ILDB D,(TP) ; GET THE CHAR + SOS -1(TP) ; SUBTRACT FROM STRING LENGTH + AOS (P) ; INC COUNT OF CHARS DONE + PUSHJ P,CPCH1 ; GO STUFF CHAR + JRST OUTLP1 + +STREOF: MOVE A,$TFIX + POP P,B ; RETURN THE LOOSER A COUNT OF WHAT WAS DONE + SUB P,[2,,2] + SUB TP,[6,,6] + JRST FINIS + + +GWB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A WRITE BUFFER ON PRINTB CHAN + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVSI A,TWORD+.VECT. + MOVEM A,BUFLNT(B) + SETOM (B) + MOVEI C,1(B) + HRLI C,(B) + BLT C,BUFLNT-1(B) + MOVEI C,-1(B) + HRLI C,010700 + MOVE B,(TP) + MOVEI 0,C.BUF + IORM 0,-2(B) + MOVEM C,BUFSTR(B) + MOVE C,[TCHSTR,,BUFLNT*5] + MOVEM C,BUFSTR-1(B) + SUB TP,[2,,2] + POPJ P, + + +GRB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A READ BUFFER + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVEI C,BUFLNT-1(B) + POP TP,B + MOVEI 0,C.BUF + IORM 0,-2(B) + HRLI C,010700 + MOVEM C,BUFSTR(B) + MOVSI C,TCHSTR + MOVEM C,BUFSTR-1(B) + SUB TP,[1,,1] + POPJ P, + +MTSTRN: ERRUUO EQUOTE EMPTY-STRING + + ; INPUT UNBUFFERING ROUTINE. THIS DOES THE CHARACTER UNBUFFERING +; FOR INPUT. THE OPEN ROUTINE SETUPS A PUSHJ P, TO +; THIS ROUTINE AS THE IOINS FOR A CHANNEL OPEN TO A NON-TTY DEVICE. + +; H. BRODIE 7/19/72 + +; CALLING SEQ: +; PUSHJ P,GETCHR +; B/ AOBJN PNTR TO CHANNEL VECTOR +; RETURNS NEXT CHARACTER IN AC A. +; ON ENCOUNTERING EITHER ^C OR NUL(^@) IT ASSUMES EOF AND +; TRANSMITS ONLY ^C ON SUCCESSIVE CALLS + + +GETCHR: +; FIRST GRAB THE BUFFER +; GETYP A,BUFSTR-1(B) ; GET TYPE WORD +; CAIN A,TCHSTR ; SKIPS IF NOT CHSTR (I.E. IF BAD BUFFER) +; JRST GTGBUF ; IS GOOD BUFFER...SKIP ERROR RETURN +GTGBUF: HRRZ A,BUFSTR-1(B) ; GET LENGTH OF STRING + SOJGE A,GTGCHR ; JUMP IF STILL MORE + +; HERE IF THE BUFFER WAS EXHAUSTED (BYTE PNTR POINTS INTO DOPE WDS) +; GENERATE AN .IOT POINTER +;FIRST SAVE C AND D AS I WILL CLOBBER THEM +NEWBUF: PUSH P,C + PUSH P,D +IFN ITS,[ + LDB C,[600,,STATUS(B)] ; GET TYPE + CAIG C,2 ; SKIP IF NOT TTY +] +IFE ITS,[ + SKIPE BUFRIN(B) +] + JRST GETTTY ; GET A TTY BUFFER + + PUSHJ P,PGBUFI ; RE-FILL BUFFER + +IFE ITS, MOVEI C,-1 + JUMPGE A,BUFGOO ;SKIPS IF IOT COMPLETED...FIX UP CHANNEL + MOVEI C,1 ; MAKE SURE LAST EOF REALLY ENDS IT + ANDCAM C,-1(A) + MOVSI C,014000 ; GET A ^C + MOVEM C,(A) ;FAKE AN EOF + +IFE ITS,[ + HLRE C,A ; HOW MUCH LEFT + ADDI C,BUFLNT ; # OF WORDS TO C + IMULI C,5 ; TO CHARS + MOVE A,-2(B) ; GET BITS + TRNE A,C.BIN ; CAN'T HELP A BINARY CHANNEL + JRST BUFGOO + MOVE A,CHANNO(B) + PUSH P,B + PUSH P,D + PUSH P,C + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + MOVE B,[2,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + POP P,C + CAIE D,7 ; SEVEN BIT BYTES? + JRST BUFGO1 ; NO, DONT HACK + MOVE D,C + IDIVI B,5 ; C IS NUMBER IN LAST WORD IF NOT EVEN + SKIPN C + MOVEI C,5 + ADDI C,-5(D) ; FIXUP C FOR WINNAGE +BUFGO1: POP P,D + POP P,B +] +; RESET THE BYTE POINTER IN THE CHANNEL. +; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D +BUFGOO: HRLI D,010700 ; GENERATE VIRGIN LH + SUBI D,1 + + MOVEM D,BUFSTR(B) ; STASH IN THE BUFFER BYTE PNTR SLOT +IFE ITS, HRRM C,LSTCH-1(B) ; SAVE IT + MOVEI A,BUFLNT*5-1 +BUFROK: POP P,D ;RESTORE D + POP P,C ;RESTORE C + + +; HERE IF THERE ARE CHARS IN BUFFER +GTGCHR: HRRM A,BUFSTR-1(B) + ILDB A,BUFSTR(B) ; GET A CHAR FROM BUFFER + +IFN ITS,[ + CAIE A,3 ; EOF? + POPJ P, ; AND RETURN + LDB A,[600,,STATUS(B)] ; CHECK FOR TTY + CAILE A,2 ; SKIP IF TTY +] +IFE ITS,[ + PUSH P,0 + HRRZ 0,LSTCH-1(B) + SOJL 0,.+4 + HRRM 0,LSTCH-1(B) + POP P,0 + POPJ P, + + POP P,0 + MOVSI A,-1 + SKIPN BUFRIN(B) +] + JRST .+3 +RETEO1: HRRI A,3 + POPJ P, + + HRRZ A,BUFSTR(B) ; SEE IF RSUBR START BIT IS ON + HRRZ A,(A) + TRNN A,1 + MOVSI A,-1 + JRST RETEO1 + +IFN ITS,[ +PGBUFO: +PGBUFI: +] +IFE ITS,[ +PGBUFO: SKIPA D,[SOUT] +PGBUFI: MOVE D,[SIN] +] + SKIPGE A,BUFSTR(B) ; POINT TO CURRENT BUFFER POSIT + SUBI A,1 ; FOR 440700 AND 010700 START + SUBI A,BUFLNT-1 ; CALCULATE PNTR TO BEG OF BUFFER + HRLI A,-BUFLNT ; IOT (AOBJN) PNTR IN A + MOVSI C,004400 +IFN ITS,[ +PGBIOO: +PGBIOI: MOVE D,A ; COPY FOR LATER + MOVSI C,TUVEC ; PREPARE TO HANDDLE INTS + MOVE PVP,PVSTOR+1 + MOVEM C,DSTO(PVP) + MOVEM C,ASTO(PVP) + MOVSI C,TCHAN + MOVEM C,BSTO(PVP) + +; BUILD .IOT INSTR + MOVE C,CHANNO(B) ; CHANNEL NUMBER IN C + ROT C,23. ; MOVE INTO AC FIELD + IOR C,[.IOT 0,A] ; IOR IN SKELETON .IOT + +; DO THE .IOT + ENABLE ; ALLOW INTS + XCT C ; EXECUTE THE .IOT INSTR + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM ASTO(PVP) + SETZM DSTO(PVP) + POPJ P, +] + +IFE ITS,[ +PGBIOT: PUSH P,D + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,C + HRRZS (P) + HRRI C,-1(A) ; POINT TO BUFFER + HLRE D,A ; XTRA POINTER + MOVNS D + HRLI D,TCHSTR + MOVE PVP,PVSTOR+1 + MOVEM D,BSTO(PVP) + MOVE D,[PUSHJ P,FIXACS] + MOVEM D,ONINT + MOVSI D,TUVEC + MOVEM D,DSTO(PVP) + MOVE D,A + MOVE A,CHANNO(B) ; FILE JFN + MOVE B,C + HLRE C,D ; - COUNT TO C + SKIPE (P) + MOVN C,(P) ; REAL DESIRED COUNT + SUB P,[1,,1] + ENABLE + XCT (P) ; DO IT TO IT + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM DSTO(PVP) + SETZM ONINT + MOVEI A,1(B) + MOVE B,(TP) + SUB TP,[2,,2] + SUB P,[1,,1] + JUMPGE C,CPOPJ ; NO EOF YET + HRLI A,(C) ; LOOK LIKE AN AOBJN PNTR + POPJ P, + +FIXACS: PUSH P,PVP + MOVE PVP,PVSTOR+1 + MOVNS C + HRRM C,BSTO(PVP) + MOVNS C + POP P,PVP + POPJ P, + +PGBIOO: SKIPA D,[SOUT] +PGBIOI: MOVE D,[SIN] + HRLI C,004400 + JRST PGBIOT +DOIOTO: PUSH P,[SOUT] +DOIOTC: PUSH P,B + PUSH P,C + EXCH A,B + MOVE A,CHANNO(A) + HLRE C,B + HRLI B,444400 + XCT -2(P) + HRL B,C + MOVE A,B +DOIOTE: POP P,C + POP P,B + SUB P,[1,,1] + POPJ P, +DOIOTI: PUSH P,[SIN] + JRST DOIOTC +] + +; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE + +PUTCHR: PUSH P,A + GETYP A,BUFSTR-1(B) ; CHECK TYPE OF ARG + CAIE A,TCHSTR ; MUST BE STRING + JRST BDCHAN + + HRRZ A,BUFSTR-1(B) ; GET CHAR COUNT + JUMPE A,REBUFF ; PREV RESET BUFF, UNDO SAME + +PUTCH1: POP P,A ; RESTORE CHAR + CAMN A,[-1] ; SPECIAL HACK? + JRST PUTCH2 ; YES GO HANDLE + IDPB A,BUFSTR(B) ; STUFF IT +PUTCH3: SOS A,BUFSTR-1(B) ; COUNT DOWN STRING + TRNE A,-1 ; SKIP IF FULL + POPJ P, + +; HERE TO FLUSH OUT A BUFFER + + PUSH P,C + PUSH P,D + PUSHJ P,PGBUFO ; SETUP AND DO IOT + HRLI D,010700 ; POINT INTO BUFFER + SUBI D,1 + MOVEM D,BUFSTR(B) ; STORE IT + MOVEI A,BUFLNT*5 ; RESET COUNT + HRRM A,BUFSTR-1(B) + POP P,D + POP P,C + POPJ P, + +;HERE TO DA ^C AND TURN ON MAGIC BIT + +PUTCH2: MOVEI A,3 + IDPB A,BUFSTR(B) ; ZAP OUT THE ^C + MOVEI A,1 ; GET BIT +IFE ITS,[ + PUSH P,C + HRRZ C,BUFSTR(B) + IORM A,(C) + POP P,C +] +IFN ITS,[ + IORM A,@BUFSTR(B) ; ON GOES THE BIT +] + JRST PUTCH3 + +; RESET A FUNNY BUF + +REBUFF: MOVEI A,BUFLNT*5 ; 1ST COUNT + HRRM A,BUFSTR-1(B) + HRRZ A,BUFSTR(B) ; NOW POINTER + SUBI A,BUFLNT+1 + HRLI A,010700 + MOVEM A,BUFSTR(B) ; STORE BACK + JRST PUTCH1 + + +; HERE TO FLUSH FINAL BUFFER + +BFCLOS: HRRZ C,-2(B) ; THIS BUFFER FLUSHER THE WORK OF NDR + MOVEI A,0 + TRNE C,C.TTY + POPJ P, + TRNE C,C.DISK + MOVEI A,1 + PUSH P,A ; SAVE THE RESULT OF OUR TEST + JUMPN A,BFCLNN ; DONT HAVE TO CHECK NET STATE + PUSH TP,$TCHAN + PUSH TP,B ; SAVE CHANNEL + PUSHJ P,INSTAT ; GET CURRENT NETWORK STATE + MOVE A,(B) ; GET FIRST ELEMENT OF STATE UVECTOR WHICH IS CUR STATE + POP TP,B ; RESTORE B + POP TP, + CAIE A,5 ; IS NET IN OPEN STATE? + CAIN A,6 ; OR ELSE IS IT IN RFNM WAIT STATE + JRST BFCLNN ; IF SO TO THE IOT + POP P, ; ELSE FLUSH CRUFT AND DONT IOT + POPJ P, ; RETURN DOING NO IOT +BFCLNN: MOVEI C,BUFLNT*5 ; NEW BUFFER FLUSHER BY NDR + HRRZ D,BUFSTR-1(B) ; SO THAT NET ALSO WORKS RIGHT + SUBI C,(D) ; GET NUMBER OF CHARS + IDIVI C,5 ; NUMBER OF FULL WORDS AND REST + PUSH P,D ; SAVE NUMBER OF ODD CHARS + SKIPGE A,BUFSTR(B) ; GET CURRENT BUF POSITION + SUBI A,1 ; FIX FOR 440700 BYTE POINTER +IFE ITS,[ + HRRO D,A + PUSH P,(D) +] +IFN ITS,[ + PUSH P,(A) ; SAVE THE ODD WORD OF BUFFER +] + MOVEI D,BUFLNT + SUBI D,(C) + SKIPE -1(P) + SUBI A,1 + ADDI D,1(A) ; FIX UP FOR POSSIBLE ODD CHARS + PUSH TP,$TUVEC + PUSH TP,D ; PUSH THE DOPE VECTOR ONTO THE STACK + JUMPE C,BFCLSR ; IN CASE THERE ARE NO FULL WORDS TO DO + HRL A,C + TLO A,400000 + MOVE E,[SETZ BUFLNT(A)] + SUBI E,(C) ; FIX UP FOR BACKWARDS BLT + POP A,@E ; AMAZING GRACE + TLNE A,377777 + JRST .-2 + HRRO A,D ; SET UP AOBJN POINTER + SUBI A,(C) + TLC A,-1(C) + PUSHJ P,PGBIOO ; DO THE IOT OF ALL THE FULL WORDS +BFCLSR: HRRO A,(TP) ; GET IOT PTR FOR REST OF JUNK + SUBI A,1 ; POINT TO WORD BEFORE DOPE WORDS + POP P,0 ; GET BACK ODD WORD + POP P,C ; GET BACK ODD CHAR COUNT + POP P,D ; FLAG FOR NET OR DSK + JUMPN D,BFCDSK ; GO FINISH OFF DSK + JUMPE C,BFCLSD ; IF NO ODD CHARS FINISH UP + MOVEI D,7 + IMULI D,(C) ; FIND NO OF BITS TO SHIFT + LSH 0,-43(D) ; SHIFT BITS TO RIGHT PLACE + MOVEM 0,(A) ; STORE IN STRING + SUBI C,5 ; HOW MANY CHAR POSITIONS TO SKIP + MOVNI C,(C) ; MAKE C POSITIVE + LSH C,17 + TLC A,(C) ; MUNG THE AOBJN POINTER TO KLUDGE + PUSHJ P,PGBIOO ; DO IOT OF ODD CHARS + MOVEI C,0 +BFCLSD: HRRZ A,(TP) ; GET PTR TO DOPE WORD + SUBI A,BUFLNT+1 + JUMPLE C,.+3 + SKIPE ACCESS(B) + MOVEM 0,1(A) ; LAST WORD BACK IN BFR + HRLI A,010700 ; AOBJN POINTER TO FIRST OF BUFFER + MOVEM A,BUFSTR(B) + MOVEI A,BUFLNT*5 + HRRM A,BUFSTR-1(B) + SKIPN ACCESS(B) + JRST BFCLSY + JUMPL C,BFCLSY + JUMPE C,BFCLSZ + IBP BUFSTR(B) + SOS BUFSTR-1(B) + SOJG C,.-2 +BFCLSY: MOVE A,CHANNO(B) + MOVE C,B +IFE ITS,[ + RFPTR + FATAL RFPTR FAILED + HRRZ F,LSTCH-1(C) ; PREVIOUS HIGH + MOVE G,C ; SAVE CHANNEL + MOVE C,B + CAML F,B + MOVE C,F + MOVE F,B + HRLI A,400000 + CLOSF + JFCL + MOVNI B,1 + HRLI A,12 + CHFDB + MOVE B,STATUS(G) + ANDI A,-1 + OPENF + FATAL OPENF LOSES + MOVE C,F + IDIVI C,5 + MOVE B,C + SFPTR + FATAL SFPTR FAILED + MOVE B,G +] +IFN ITS,[ + DOTCAL RFPNTR,[A,[2000,,B]] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + SUBI B,1 + DOTCAL ACCESS,[A,B] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + MOVE B,C +] +BFCLSZ: SUB TP,[2,,2] + POPJ P, + +BFCDSK: TRZ 0,1 + PUSH P,C +IFE ITS,[ + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,0 ; WORD OF CHARS + MOVE A,CHANNO(B) + MOVEI B,7 ; MAKE BYTE SIZE 7 + SFBSZ + JFCL + HRROI B,(P) + MOVNS C + SKIPE C + SOUT + MOVE B,(TP) + SUB P,[1,,1] + SUB TP,[2,,2] +] +IFN ITS,[ + MOVE D,[440700,,A] + DOTCAL SIOT,[CHANNO(B),D,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + POP P,C + JUMPN C,BFCLSD +BFCDS1: MOVNI C,1 ; INDICATE NOT TOHACK BUFFER + JRST BFCLSD + +BFCLS1: HRRZ C,DIRECT-1(B) + MOVSI 0,(JFCL) + CAIE C,6 + MOVE 0,[AOS ACCESS(B)] + PUSH P,0 + HRRZ C,BUFSTR-1(B) + IDIVI C,5 + JUMPE D,BCLS11 + MOVEI A,40 ; PAD WITH SPACES + PUSHJ P,PUTCHR + XCT (P) ; AOS ACCESS IF NECESSARY + SOJG D,.-3 ; TO END OF WORD +BCLS11: POP P,0 + HLLZS ACCESS-1(B) + HRRZ C,BUFSTR-1(B) + CAIE C,BUFLNT*5 + PUSHJ P,BFCLOS + POPJ P, + + +; HERE TO GET A TTY BUFFER + +GETTTY: SKIPN C,EXBUFR(B) ; SKIP IF BUFFERS BACKED UP + JRST TTYWAI + HRRZ D,(C) ; CDR THE LIST + GETYP A,(C) ; CHECK TYPE + CAIE A,TDEFER ; MUST BE DEFERRED + JRST BDCHAN + MOVE C,1(C) ; GET DEFERRED GOODIE + GETYP A,(C) ; BETTER BE CHSTR + CAIE A,TCHSTR + JRST BDCHAN + MOVE A,(C) ; GET FULL TYPE WORD + MOVE C,1(C) + MOVEM D,EXBUFR(B) ; STORE CDR'D LIST + MOVEM A,BUFSTR-1(B) ; MAKE CURRENT BUFFER + MOVEM C,BUFSTR(B) + HRRM A,LSTCH-1(B) + SOJA A,BUFROK + +TTYWAI: PUSHJ P,TTYBLK ; BLOCKED FOR TTY I/O + JRST GETTTY ; SHOULD ONLY RETURN HAPPILY + + ;INTERNAL DEVICE READ ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT, +;CHECKS THAT THE RETURNED VALUE IS OF TYPE CHARACTER, +;AND RETURNS THAT AS THE NEXT CHARACTER IN THE "FILE" + +;H. BRODIE 8/31/72 + +GTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,INTFCN-1(B) + PUSH TP,INTFCN(B) + MCALL 1,APPLY + GETYP A,A + CAIE A,TCHRS + JRST BADRET + MOVE A,B +INTRET: POP P,0 ;RESTORE THE ACS + POP P,E + POP P,D + POP P,C + POP TP,B ;RESTORE THE CHANNEL + SUB TP,[1,,1] ;FLUSH $TCHAN...WE DON'T NEED IT + POPJ P, + + +BADRET: ERRUUO EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT + +;INTERNAL DEVICE PRINT ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,(FUNCTION, SUBR, OR RSUBR) +;TO THE CURRENT CHARACTER BEING "PRINTED". + +PTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,INTFCN-1(B) ;PUSH TYPE OF GIVEN OBJ + PUSH TP,INTFCN(B) ;PUSH THE SUPPLIED FUNCTION (OR SUBR ETC.) + PUSH TP,$TCHRS ;PUSH THE TYPE "CHARACTER" + PUSH TP,A ;PUSH THE CHAR + MCALL 2,APPLY ;APPLY THE FUNCTION TO THE CHAR + JRST INTRET + + + +; ROUTINE TO FLUSH OUT A PRINT BUFFER + +MFUNCTION BUFOUT,SUBR + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + + MOVE B,1(AB) +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; GET DIR NAME +; JFCL +; CAMN B,[ASCII /PRINT/] +; JRST .+3 +; CAME B,[+1] +; JRST WRONGD +; TRNE B,1 ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN B,1 ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] + HRRZ 0,-2(B) + TRNN 0,C.PRIN + JRST WRONGD +; TRNE 0,C.BIN ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN 0,C.BIN ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] +; MOVE B,1(AB) +; GETYP 0,BUFSTR-1(B) +; CAIN 0,TCHSTR +; SKIPN A,BUFSTR(B) ; BYTE POINTER? +; JRST BFIN1 +; HRRZ C,BUFSTR-1(B) ; CHARS LEFT +; IDIVI C,5 ; MULTIPLE OF 5? +; JUMPE D,BFIN2 ; YUP NO EXTRAS + +; MOVEI A,40 ; PAD WITH SPACES +; PUSHJ P,PUTCHR ; OUT IT GOES +; XCT (P) ; MAYBE BUMP ACCESS +; SOJG D,.-3 ; FILL + +BFIN2: PUSHJ P,BFCLOS ; WRITE OUT BUFFER + +BFIN1: MOVSI A,TCHAN + JRST FINIS + + + +; FUNCTION TO GET THE FILE LENGTH OF A READ CHANNEL + +MFUNCTION FILLNT,SUBR,[FILE-LENGTH] + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) + PUSHJ P,CFILLE + JRST FINIS + +CFILLE: +IFN 0,[ + MOVEI B,DIRECT-1(B) ; GET CHANNEL TYPE + PUSHJ P,CHRWRD + JFCL + CAME B,[ASCIZ /READ/] + JRST .+3 + PUSH P,[5] ; MULTIPLICATIVE FACTOR FOR READ + JRST .+4 + CAME B,[ASCII /READB/] + JRST WRONGD + PUSH P,[1] ; MULTIPLICATIVE FACTOR FOR READ +] + MOVE C,-2(B) ; GET BITS + MOVEI D,5 ; ASSUME ASCII + TRNE C,C.BIN ; SKIP IF NOT BINARY + MOVEI D,1 + PUSH P,D + MOVE C,B +IFN ITS,[ + .CALL FILL1 + JRST FILLOS ; GIVE HIM A NICE FALSE +] +IFE ITS,[ + MOVE A,CHANNO(C) + PUSH P,[0] + MOVEI C,(P) + MOVE B,[1,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,(P)] ; GET BYTE SIZE + JUMPN D,.+2 + MOVEI D,36. ; HANDLE "0" BYTE SIZE + SUB P,[1,,1] + SIZEF + JRST FILLOS +] + POP P,C +IFN ITS, IMUL B,C +IFE ITS,[ + CAIN C,5 + CAIE D,7 + JRST NOTASC +] +YESASC: MOVE A,$TFIX + POPJ P, + +IFE ITS,[ +NOTASC: MOVEI 0,36. + IDIV 0,D ; BYTES PER WORD + IDIVM B,0 + IMUL C,0 + MOVE B,C + JRST YESASC +] + +IFN ITS,[ +FILL1: SETZ ; BLOCK FOR .CALL TO FILLEN + SIXBIT /FILLEN/ + CHANNO (C) + SETZM B + +FILLOS: MOVE A,CHANNO(C) + MOVE B,[.STATUS A] ;MAKE A CALL TO STATUS TO FIND REASON + LSH A,23. ;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE + IOR B,A ;FIX UP .STATUS + XCT B + MOVE B,C + PUSHJ P,GFALS + POP P, + POPJ P, +] +IFE ITS,[ +FILLOS: MOVE B,C + PUSHJ P,TGFALS + POP P, + POPJ P, +] + + + ; MCHAN LOW-LEVEL I/O GARBAGE (PDL)-ORIGINAL (LIM)-ADDITIONS + +;CALLING ROUTINE: AC-A contains pointer to block of SIXBIT data +; DIR ? DEV ? FNM1 ? FNM2 ? SNM +;RETURNED VALUE : AC-A = +IFN ITS,[ +MOPEN: PUSH P,B + PUSH P,C + MOVE C,FRSTCH ; skip gc and tty channels +CNLP: DOTCAL STATUS,[C,[2000,,B]] + .LOSE %LSFIL + ANDI B,77 + JUMPE B,CHNFND ; found unused channel ? + ADDI C,1 ; try another channel + CAIG C,17 ; are all the channels used ? + JRST CNLP + SETO C, ; all channels used so C = -1 + JRST CHNFUL +CHNFND: MOVEI B,(C) + HLL B,(A) ; M.DIR slot + DOTCAL OPEN,[B,1(A),2(A),3(A),4(A)] + SKIPA + AOS -2(P) ; successful skip when returning +CHNFUL: MOVE A,C + POP P,C + POP P,B + POPJ P, + +MIOT: DOTCAL IOT,[A,B] + JFCL + POPJ P, + +MCLOSE: DOTCAL CLOSE,[A] + JFCL + POPJ P, + +IMPURE + +FRSTCH: 1 + +PURE +] + ;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O + +NOTNET: +BADCHN: ERRUUO EQUOTE BAD-CHANNEL +BDCHAN: ERRUUO EQUOTE BAD-INPUT-BUFFER + +WRONGD: ERRUUO EQUOTE WRONG-DIRECTION-CHANNEL + +CHNCLS: ERRUUO EQUOTE CHANNEL-CLOSED + +BAD6: ERRUUO EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME + +DISLOS: MOVE C,$TCHSTR + MOVE D,CHQUOTE [DISPLAY NOT AVAILABLE] + PUSHJ P,INCONS + MOVSI A,TFALSE + JRST OPNRET + +NOCHAN: ERRUUO EQUOTE ITS-CHANNELS-EXHAUSTED + +MODE1: 232020,,202020 +MODE2: 232023,,330320 + +END + + \ No newline at end of file diff --git a//fopen.mid.57 b//fopen.mid.57 new file mode 100644 index 0000000..e42534b --- /dev/null +++ b//fopen.mid.57 @@ -0,0 +1,4703 @@ +TITLE OPEN - CHANNEL OPENER FOR MUDDLE + +RELOCATABLE + +;C. REEVE MARCH 1973 + +.INSRT MUDDLE > + +SYSQ + +FNAMS==1 +F==E+1 +G==F+1 + +IFE ITS,[ +IF1, .INSRT STENEX > +] +;THIS PROGRAM HAS ENTRIES: FOPEN, FCLOSE, RENAME, READB, PRINTB, FILECOPY, READSTRING, +; PRINTSTRING, NETSTATE, NETACC, NETS, ACCESS, AND FILE-EXISTS? + +;THESE SUBROUTINES HANDLE I/O STREAMS FOR THE MUDDLE SYSTEM. + +; FOPEN - OPENS A FILE FOR EITHER READING OR WRITING. IT TAKES +; FIVE OPTINAL ARGUMENTS AS FOLLOWS: + +; FOPEN (,,,,) +; +; - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ + +; - FIRST FILE NAME. DEFAULT INPUT OR OUTPUT. + +; - SECOND FILE NAME. DEFAULT MUDDLE. + +; - DEVICE FROM WHICH TO OPEN. DEFAULT IS DSK. + +; - SYSTEM (DIRECTORY) NAME. DEFAULT UNAME. + +; FOPEN RETURNS AN OBJECT OF TYPE CHANNEL IF IT SUCCEEDS OTHERWISE NIL + + +; FCLOSE - CLOSES A FILE. TAKES A CHANNEL OBJECT AS ITS ARGUMENT. IT ALSO TAKES +; ACCESS - DOES A .ACCESS ON A CHARACTER BASIS FOR CHARACTER FILES + + +; A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION + +; CHANNO ;ITS I/O CHANNEL NUMBER. 0 MEANS NOT A REAL CHANNEL. +; DIRECT ;DIRECTION (EITHER READ OR PRINT) +; NAME1 ;FIRST NAME OF FILE AS OPENED. +; NAME2 ;SECOND NAME OF FILE +; DEVICE ;DEVICE UPON WHICH THE CHANNEL IS OPEN +; SNAME ;DIRECTORY NAME +; RNAME1 ;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS) +; RNAME2 ;REAL SECOND NAME +; RDEVIC ;REAL DEVICE +; RSNAME ;SYSTEM OR DIRECTORY NAME +; STATUS ;VARIOUS STATUS BITS +; IOINS ;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER +; ACCESS ;ACCESS POINTER FOR RAND ACCESS (OR USED FOR DISPLAY INFO) +; RADX ;RADIX FOR CHANNELS NUMBER CONVERSION + +; *** THE FOLLOWING FIELDS FOR OUTPUT ONLY *** +; LINLN ;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE +; CHRPOS ;CURRENT POSITION ON CURRENT LINE +; PAGLN ;LENGTH OF A PAGE +; LINPOS ;CURRENT LINE BEING WRITTEN ON + +; *** THE FOLLOWING FILEDS FOR INPUT ONLY *** +; EOFCND ;GETS EVALUATED ON EOF +; LSTCH ;BACKUP CHARACTER +; WAITNS ;FOR TTY INPUT, BECOMES A .SLEEP WHEN WAITING +; EXBUFR ;FOR TTY INPUT, CONTAINS A WAITING BUFFER LIST +; BUFSTR ;A CHARACTER STRING USED AS BUFFER FOR NON-TTY DEVICES + +; THIS DEFINES THE LENGTH OF THE NON-TTY BUFFER +BUFLNT==100 + +;THIS DEFINES BLOCK MODE BIT FOR OPENING +BLOCKM==2 ;DEFINED IN THE LEFT HALF +IMAGEM==4 + + +;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME + + CHANLNT==4 ;INITIAL CHANNEL LENGTH + +; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS +BUFRIN==-1 ;SPECIAL HACK SO LOSERS WON'T SEE TTY BUFFER +SCRPTO==-3 ;SPECIAL HACK FOR SCRIPT CHANNELS +PROCHN: + +IRP A,,[[CHANNO,FIX],[DIRECT,CHSTR] +[NAME1,CHSTR],[NAME2,CHSTR],[DEVICE,CHSTR],[SNAME,CHSTR] +[RNAME1,CHSTR],[RNAME2,CHSTR],[RDEVIC,CHSTR],[RSNAME,CHSTR] +[STATUS,FIX],[IOINS,FIX],[LINLN,FIX],[CHRPOS,FIX],[PAGLN,FIX],[LINPOS,FIX] +[ACCESS,FIX],[RADX,FIX],[BUFSTR,CHSTR]] + + IRP B,C,[A] + B==CHANLNT-3 + T!C,,0 + 0 + .ISTOP + TERMIN + CHANLNT==CHANLNT+2 +TERMIN + + +; EQUIVALANCES FOR CHANNELS + +EOFCND==LINLN +LSTCH==CHRPOS +WAITNS==PAGLN +EXBUFR==LINPOS +DISINF==BUFSTR ;DISPLAY INFO +INTFCN==BUFSTR ;FUNCTION (OR SUBR, OR RSUBR) TO BE APPLIED FOR INTERNAL CHNLS + + +;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS + +IRP A,,[IOIN2,ECHO,CHRCNT,ERASCH,KILLCH,BRKCH,ESCAP,SYSCHR,BRFCHR,BRFCH2,BYTPTR] +A==.IRPCNT +TERMIN + +EXTBFR==BYTPTR+1+<100./5> ;LENGTH OF ADD'L BUFFER + + + + +.GLOBAL IPNAME,MOPEN,MCLOSE,MIOT,ILOOKU,6TOCHS,ICLOS,OCLOS,RGPARS,RGPRS +.GLOBAL OPNCHN,CHMAK,READC,TYO,SYSCHR,BRFCHR,LSTCH,BRFCH2,EXTBFR +.GLOBAL CHRWRD,STRTO6,TTYBLK,WAITNS,EXBUFR,TTICHN,TTOCHN,GETCHR,IILIST +.GLOBAL CHANNO,STATUS,LINPOS,PAGLN,CHRPOS,LINLN,IOINS,ACCESS,ADDNUL +.GLOBAL DIRECT,DISINF,RADX,EOFCND,BUFSTR,MODE1,MODE2,GCHACK,GMTYO,INMTYO +.GLOBAL T.CHAN,NAME1,BFCLOS,DOIOTI,DOIOTO,DOACCS,NOTTY,DEMFLG,BYTDOP,TNXIN +.GLOBAL DISOPN,DISROP,DISCLS,DCHAR,DISLNL,DISPGL,INSTAT,MTYO,CIREST +.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP,N.CHNS +.GLOBAL REOPN,QUITTE,CHNL0,CHNL1,BUFRIN,IOIN2,IFALSE,GFALS,IDVAL,PVSTOR,SPSTOR +.GLOBAL BADCHN,WRONGD,CHNCLS,GSNAME,GIBLOK,APLQ,NAPT,ICONS,INCONS,IBLOCK,IDVAL1 +.GLOBAL GRB,GWB,R1CHAR,W1CHAR,BFCLS1,TTYOP2,MPOPJ,COMPER,R1C,W1C,WXCT,RXCT +.GLOBAL TMTNXS,TNXSTR,RDEVIC,CPCH1,RCYCHN,CGFALS,CISTNG,CFILLE,FRSTCH +.GLOBAL TGFALS,ONINT + +.VECT.==40000 + +; PAIR MOVING MACRO + +DEFINE PMOVEM A,B + MOVE 0,A + MOVEM 0,B + MOVE 0,A+1 + MOVEM 0,B+1 + TERMIN + +; DEFINITIONS OF THE OFFSETS INTO THE TP STACK FOR OPEN + +T.SPDL==0 ; SAVES P STACK BASE +T.DIR==2 ; CONTAINS DIRECTION AND MODE +T.NM1==4 ; NAME 1 OF FILE +T.NM2==6 ; NAME 2 OF FILE +T.DEV==10 ; DEVICE NAME +T.SNM==12 ; SNAME +T.XT==14 ; EXTRA CRUFT IF NECESSARY +T.CHAN==16 ; CHANNEL AS GENERATED + +; OFFSETS FROM PSTACK BASE (USED FOR OPENS, .RCHST AND .FDELES) + +S.DIR==0 ; CODE FOR DIRECTION 0-IN, 1-OUT, 2-BIN, 3-BOUT,4-DISPLAY + ; S.DIR(P) = ,, +IFN ITS,[ +S.DEV==1 ; SIXBIT DEVICE RIGHT JUSTIFIED +S.NM1==2 ; SIXBIT NAME1 +S.NM2==3 ; SIXBIT NAME2 +S.SNM==4 ; SIXBIT SNAME +S.X1==5 ; TEMPS +S.X2==6 +S.X3==7 +] + +IFE ITS,[ +S.DEV==1 +S.X1==2 +S.X2==3 +S.X3==4 +] + + +; FLAGS SPECIFYING STATE OF THE WORLD AT VARIOUS TIMES + +NOSTOR==400000 ; ON MEANS DONT BUILD NEW STRINGS +MSTNET==200000 ; ON MEANS ONLY THE "NET" DEVICE CAN WIN +SNSET==100000 ; FLAG, SNAME SUPPLIED +DVSET==040000 ; FLAG, DEV SUPPLIED +N2SET==020000 ; FLAG, NAME2 SET +N1SET==010000 ; FLAG, NAME1 SET +4ARG==004000 ; FLAG, CONSIDER ARGS TO BE 4 STRINGS + +RMT [EXPUNGE N1SET,N2SET,DVSET,SNSET,MSTNET,NOSTOR +] + +; TABLE OF LEGAL MODES + +MODES: IRP A,,[READ,PRINT,READB,PRINTB,PRINTO,PRINAO] + SIXBIT /A/ + TERMIN +NMODES==.-MODES + +MODCOD: 0?1?2?3?3?1 +; TABLE OF KNOWN DEVICES AND A POINTER TO THEIR OPENERS + +IFN ITS,[ +DEVSTB: IRP A,,[DSK,TTY,USR,STY,ST,NET,INT,PTP,PTR,UT,T,NUL] + SIXBIT /A/ ; DEVICE NAMES + TERMIN + +DEVS: IRP B,,[ODSK,OTTY,OUSR,OSTY,OSTY,ONET,OINT,OPTP,OPTP,OUTN,OTTY,ONUL] + SETZ B ; POINTERS + TERMIN +] + +IFE ITS,[ +DEVSTB: IRP A,,[PS,SS,SRC,DSK,TTY,INT,NET] + SIXBIT /A/ + TERMIN + +DEVS: IRP B,,[ODSK,ODSK,ODSK,ODSK,OTTY,OINT,ONET] + SETZ B + TERMIN +] +NDEVS==.-DEVS + + + +;SUBROUTINE TO DO OPENING BEGINS HERE + +MFUNCTION NFOPEN,SUBR,[OPEN-NR] + + JRST FOPEN1 + +MFUNCTION FOPEN,SUBR,[OPEN] + +FOPEN1: ENTRY + PUSHJ P,MAKCHN ;MAKE THE CHANNEL + PUSHJ P,OPNCH ;NOW OPEN IT + JUMPL B,FINIS + SUB D,[4,,4] ; TOP THE CHANNEL + MOVEM D,RCYCHN+1 ; RECYCLE DEAD CHANNEL + SETZM (D) ; ZAP IT + MOVEI C,1(D) + HRLI C,(D) + BLT C,CHANLNT-1(D) + JRST FINIS + +; SUBR TO JUST CREATE A CHANNEL + +IMFUNCTION CHANNEL,SUBR + + ENTRY + PUSHJ P,MAKCHN + MOVSI A,TCHAN + JRST FINIS + + + + +; THIS ROUTINE PARSES ARGUMENTS TO FOPEN ETC. AND BUILDS A CHANNEL BUT DOESN'T OPEN IT + +MAKCHN: PUSH TP,$TPDL + PUSH TP,P ; POINT AT CURRENT STACK BASE + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE READ + MOVEI E,10 ; SLOTS OF TP NEEDED + PUSH TP,[0] + SOJG E,.-1 + MOVEI E,0 + EXCH E,(P) ; GET RET ADDR IN E +IFE ITS, PUSH P,[0] +IRP ATM,,[DEV,NM1,NM2,SNM]MDF,,[DSK,INPUT,>,[ ]]TMDF,,[DSK,INPUT,MUD,[ ]] + MOVE B,IMQUOTE ATM +IFN ITS, PUSH P,E + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TCHSTR + JRST MAK!ATM + + MOVE A,$TCHSTR +IFN ITS, MOVE B,CHQUOTE MDF +IFE ITS, MOVE B,CHQUOTE TMDF +MAK!ATM: + MOVEM A,T.!ATM(TB) + MOVEM B,T.!ATM+1(TB) +IFN ITS,[ + POP P,E + PUSHJ P,STRTO6 ; RESULT LEFT ON P STACK AS DESIRED +] + TERMIN + PUSH TP,[0] ; PUSH SLOTS + PUSH TP,[0] + + PUSH P,[0] ; EXT SLOTS + PUSH P,[0] + PUSH P,[0] + PUSH P,E ; PUSH RETURN ADDRESS + MOVEI A,0 + + JUMPGE AB,MAKCH0 ; NO ARGS, ALREADY DONE + GETYP 0,(AB) ; 1ST ARG MUST BE A STRING + CAIE 0,TCHSTR + JRST WTYP1 + MOVE A,(AB) ; GET ARG + MOVE B,1(AB) + PUSHJ P,CHMODE ; CHECK OUT OPEN MODE + + PMOVEM (AB),T.DIR(TB) ; SAVE MODE NAME IN TEMPS + ADD AB,[2,,2] ; BUMP PAST DIRECTION + MOVEI A,0 + JUMPGE AB,MAKCH0 ; CHECK NAME1 BASED ON JUST MODE + + MOVEI 0,0 ; FLAGS PRESET + PUSHJ P,RGPARS ; PARSE THE STRING(S) + JRST TMA + +; ARGUMENTS PARSED, DO FINAL CHECKS AND BUILD CHANNEL + +MAKCH0: +IFN ITS,[ + MOVE C,T.SPDL+1(TB) + MOVE D,S.DEV(C) ; GET DEV +] +IFE ITS,[ + MOVE A,T.DEV(TB) + MOVE B,T.DEV+1(TB) + PUSHJ P,STRTO6 + POP P,D + HLRZS D + MOVE C,T.SPDL+1(TB) + MOVEM D,S.DEV(C) +] +IFE ITS, CAIE D,(SIXBIT /INT/);INTERNAL? +IFN ITS, CAME D,[SIXBIT /INT /] + JRST CHNET ; NO, MAYBE NET + SKIPN T.XT+1(TB) ; WAS FCN SUPPLIED? + JRST TFA + +; FALLS TROUGH IF SKIP + + + +; NOW BUILD THE CHANNEL + +ARGSOK: MOVEI A,CHANLNT ; GET LENGTH + SKIPN B,RCYCHN+1 ; RECYCLE? + PUSHJ P,GIBLOK ; GET A BLOCK OF STUFF + SETZM RCYCHN+1 + ADD B,[4,,4] ; HIDE THE TTY BUFFER SLOT + PUSH TP,$TCHAN + PUSH TP,B + HRLI C,PROCHN ; POINT TO PROTOTYPE + HRRI C,(B) ; AND NEW ONE + BLT C,CHANLN-5(B) ; CLOBBER + MOVSI C,TLIST ; TO GIVE HIM A CLEAN LIST OF SCRIPT CHANS + HLLM C,SCRPTO-1(B) + +; NOW BLT IN STUFF FROM THE STACK + + MOVSI C,T.DIR(TB) ; DIRECTION + HRRI C,DIRECT-1(B) + BLT C,SNAME(B) + MOVEI C,RNAME1-1(B) ; NOW "REAL" SLOTS + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + MOVE B,IMQUOTE MODE + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TFIX + JRST .+3 + MOVE B,(TP) + POPJ P, + + MOVE C,(TP) +IFE ITS,[ + ANDI B,403776 ; ONLY ALLOW NON-CRITICAL BITSS +] + HRRM B,-4(C) ; HIDE BITS + MOVE B,C + POPJ P, + +; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN + +CHNET: +IFN ITS,[ + CAME D,[SIXBIT /NET /] ; IS IT NET + JRST MAKCH1] +IFE ITS,[ + CAIE D,(SIXBIT /NET/) ; IS IT NET + JRST ARGSOK] + MOVSI D,TFIX ; FOR TYPES + MOVEI B,T.NM1(TB) ; MAKE SURE ALL ARE FIXED + PUSHJ P,CHFIX + MOVEI B,T.NM2(TB) + PUSHJ P,CHFIX + MOVEI B,T.SNM(TB) + LSH A,-1 ; SKIP DEV FLAG + PUSHJ P,CHFIX + JRST ARGSOK + +MAKCH1: TRNN A,MSTNET ; CANT HAVE SEEN A FIX + JRST ARGSOK + JRST WRONGT + +IFN ITS,[ +CHFIX: TRNE A,N1SET ; SKIP IF NOT SPECIFIED + JRST CHFIX1 + SETOM 1(B) ; SET TO -1 + SETOM S.NM1(C) + MOVEM D,(B) ; CORRECT TYPE +] +IFE ITS,CHFIX: + GETYP 0,(B) + CAIE 0,TFIX + JRST PARSQ +CHFIX1: ADDI C,1 ; POINT TO NEXT FIELD + LSH A,-1 ; AND NEXT FLAG + POPJ P, +PARSQ: CAIE 0,TCHSTR + JRST WRONGT +IFE ITS, POPJ P, +IFN ITS,[ + PUSH P,A + PUSH P,C + PUSH TP,(B) + PUSH TP,1(B) + SUBI B,(TB) + PUSH P,B + MCALL 1,PARSE + GETYP 0,A + CAIE 0,TFIX + JRST WRONGT + POP P,C + ADDI C,(TB) + MOVEM A,(C) + MOVEM B,1(C) + POP P,C + POP P,A + POPJ P, +] + + +; SUBROUTINE TO CHECK VALIDITY OF MODE AND SAVE A CODE + +CHMODE: PUSHJ P,CHMOD ; DO IT + MOVE C,T.SPDL+1(TB) + HRRZM A,S.DIR(C) + POPJ P, + +CHMOD: PUSHJ P,STRTO6 ; TO SIXBIT + POP P,B ; VALUE ENDSUP ON STACK, RESTORE IT + + MOVSI A,-NMODES ; SCAN TO SEE IF LEGAL MODE + CAME B,MODES(A) + AOBJN A,.-1 + JUMPGE A,WRONGD ; ILLEGAL MODE NAME + MOVE A,MODCOD(A) + POPJ P, + + +IFN ITS,[ +; RGPARS -- PARSE THE STRINGS COMPRISING FILE NAMES INTO STANDARD ITS GOODIES + +RGPRS: MOVEI 0,NOSTOR ; DONT STORE STRINGS IF ENTER HERE + +RGPARS: CAMGE AB,[-7,,] ; MULTI-STRING CASE POSSIBLE? + IORI 0,4ARG ; 4 STRING CASE + HRLM 0,(P) ; LH IS FLAGS FOR THIS PROG + MOVSI E,-4 ; FIELDS TO FILL + +RPARGL: GETYP 0,(AB) ; GET TYPE + CAIE 0,TCHSTR ; STRING? + JRST ARGCLB ; NO, JUST CLOBBER IT IN RAW + JUMPGE E,CPOPJ ; DON'T DO ANY MORE + PUSH TP,(AB) ; GET AN ARG + PUSH TP,1(AB) + +FPARS: PUSH TP,-1(TP) ; ANOTHER COPY + PUSH TP,-1(TP) + HLRZ 0,(P) + TRNN 0,4ARG + PUSHJ P,FLSSP ; NO LEADING SPACES + MOVEI A,0 ; WILL HOLD SIXBIT + MOVEI B,6 ; CHARS PER 6BIT WORD + MOVE C,[440600,,A] ; BYTE POINTER INTO A + +FPARSL: HRRZ 0,-1(TP) ; GET COUNT + JUMPE 0,PARSD ; DONE + SOS -1(TP) ; COUNT + ILDB 0,(TP) ; CHAR TO 0 + + CAIE 0," ; FILE NAME QUOTE? + JRST NOCNTQ + HRRZ 0,-1(TP) + JUMPE 0,PARSD + SOS -1(TP) + ILDB 0,(TP) ; USE THIS + JRST GOTCNQ + +NOCNTQ: HLL 0,(P) + TLNE 0,4ARG + JRST GOTCNQ + ANDI 0,177 + CAIG 0,40 ; SPACE? + JRST NDFLD ; YES, TERMINATE THIS FIELD + CAIN 0,": ; DEVICE ENDED? + JRST GOTDEV + CAIN 0,"; ; SNAME ENDED + JRST GOTSNM + +GOTCNQ: ANDI 0,177 + PUSHJ P,A0TO6 ; CONVERT TO 6BIT AND CHECK + + JUMPE B,FPARSL ; IGNORE IF AREADY HAVE 6 + IDPB 0,C + SOJA B,FPARSL + +; HERE IF SPACE ENCOUNTERED + +NDFLD: MOVEI D,(E) ; COPY GOODIE + PUSHJ P,FLSSP ; FLUSH REDUNDANT SPACES + JUMPE 0,PARSD ; NO CHARS LEFT + +NFL0: PUSH P,A ; SAVE SIXBIT WORD + SKIPGE -1(P) ; SKIP IF STRING TO BE STORED + JRST NFL1 + PUSH TP,$TAB ; PREVENT AB LOSSAGE + PUSH TP,AB + PUSHJ P,6TOCHS ; CONVERT TO STRING + MOVE AB,(TP) + SUB TP,[2,,2] +NFL1: HRRZ 0,-1(TP) ; RESTORE CHAR COUNT + +NFL2: MOVEI C,(D) ; COPY REL PNTR + SKIPGE -1(P) ; SKIP IF STRINGS TO BE STORED + JRST NFL3 + ASH D,1 ; TIMES 2 + ADDI D,T.NM1(TB) + MOVEM A,(D) ; STORE + MOVEM B,1(D) +NFL3: MOVSI A,N1SET ; FLAG IT + LSH A,(C) + IORM A,-1(P) ; AND CLOBBER + MOVE D,T.SPDL+1(TB) ; GET P BASE + POP P,@SIXTBL(C) ; AND STORE SIXBIT OF IT + + POP TP,-2(TP) ; MAKE NEW STRING POINTER + POP TP,-2(TP) + JUMPE 0,.+3 ; SKIP IF NO MORE CHARS + AOBJN E,FPARS ; MORE TO PARSE? +CPOPJ: POPJ P, ; RETURN, ALL DONE + + SUB TP,[2,,2] ; FLUSH OLD STRING + ADD E,[1,,1] + ADD AB,[2,,2] ; BUMP ARG + JUMPL AB,RPARGL ; AND GO ON +CPOPJ1: AOS A,(P) ; PREPARE TO WIN + HLRZS A + POPJ P, + + + +; HERE IF STRING HAS ENDED + +PARSD: PUSH P,A ; SAVE 6 BIT + MOVE A,-3(TP) ; CAN USE ARG STRING + MOVE B,-2(TP) + MOVEI D,(E) + JRST NFL2 ; AND CONTINUE + +; HERE IF JUST READ DEV + +GOTDEV: MOVEI D,2 ; CODE FOR DEVICE + JRST GOTFLD ; GOT A FIELD + +; HERE IF JUST READ SNAME + +GOTSNM: MOVEI D,3 +GOTFLD: PUSHJ P,FLSSP + SOJA E,NFL0 + + +; HERE FOR NON STRING ARG ENCOUNTERED + +ARGCLB: SKIPGE (P) ; IF NOT STORING, CONSIDER THIS THE END + + POPJ P, + MOVE C,T.SPDL+1(TB) ; GET P-BASE + MOVE A,S.DEV(C) ; GET DEVICE + CAME A,[SIXBIT /INT /]; IS IT THE INTERNAL DEVICE + JRST TRYNET ; NO, COUD BE NET + MOVE A,0 ; OFFNEDING TYPE TO A + PUSHJ P,APLQ ; IS IT APPLICABLE + JRST NAPT ; NO, LOSE + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] ; MUST BE LAST ARG + JUMPL AB,TMA + JRST CPOPJ1 ; ELSE SUCCESSFUL RETURN +TRYNET: CAIE 0,TFIX ; FOR NET DEV, ARGS MUST BE FIX + JRST WRONGT ; TREAT AS WRONG TYPE + MOVSI A,MSTNET ; BETTER BE NET EVENTUALLY + IORM A,(P) ; STORE FLAGS + MOVSI A,TFIX + MOVE B,1(AB) ; GET NUMBER + MOVEI 0,(E) ; MAKE SURE NOT DEVICE + CAIN 0,2 + JRST WRONGT + PUSH P,B ; SAVE NUMBER + MOVEI D,(E) ; SET FOR TABLE OFFSETS + MOVEI 0,0 + ADD TP,[4,,4] + JRST NFL2 ; GO CLOBBER IT AWAY +] + + +; ROUTINE TO FLUSH LEADING SPACES FROM A FIELD + +FLSSP: HRRZ 0,-1(TP) ; GET CHR COUNNT + JUMPE 0,CPOPJ ; FINISHED STRING +FLSS1: MOVE B,(TP) ; GET BYTR + ILDB C,B ; GETCHAR + CAIE C,^Q ; DONT FLUSH CNTL-Q + CAILE C,40 + JRST FLSS2 + MOVEM B,(TP) ; UPDATE BYTE POINTER + SOJN 0,FLSS1 + +FLSS2: HRRM 0,-1(TP) ; UPDATE STRING + POPJ P, + +IFN ITS,[ +;TABLE FOR STFUFFING SIXBITS AWAY + +SIXTBL: SETZ S.NM1(D) + SETZ S.NM2(D) + SETZ S.DEV(D) + SETZ S.SNM(D) + SETZ S.X1(D) +] + +RDTBL: SETZ RDEVIC(B) + SETZ RNAME1(B) + SETZ RNAME2(B) + SETZ RSNAME(B) + + + +IFE ITS,[ + +; TENEX VERSION OF FILE NAME PARSER (ONLY ACCEPT ARGS IN SINGLE STRING) + + +RGPRS: MOVEI 0,NOSTOR + +RGPARS: HRLM 0,(P) ; SAVE FOR STORE CHECKING + CAMGE AB,[-2,,] ; MULTI-STRING CASE POSSIBLE? + JRST TN.MLT ; YES, GO PROCESS +RGPRSS: GETYP 0,(AB) ; CHECK ARG TYPE + CAIE 0,TCHSTR + JRST WRONGT ; FOR NOW ONLY STRING ARGS WIN + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,FLSSP ; FLUSH LEADING SPACES + PUSHJ P,RGPRS1 + ADD AB,[2,,2] +CHKLST: JUMPGE AB,CPOPJ1 + SKIPGE (P) ; IF FROM OPEN, ALLOW ONE MORE + POPJ P, + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] + JUMPL AB,TMA +CPOPJ1: AOS (P) + POPJ P, + +RGPRS1: PUSH P,[0] ; ALLOW A DEVICE SPEC +TN.SNM: MOVE A,(TP) + HRRZ 0,-1(TP) + JUMPE 0,RPDONE + ILDB A,A + CAIE A,"< ; START "DIRECTORY" ? + JRST TN.N1 ; NO LOOK FOR NAME1 + SETOM (P) ; DEV NOT ALLOWED + IBP (TP) ; SKIP CHAR + SOS -1(TP) + PUSHJ P,TN.CNT ; COUNT CHARS TO ">" OR "." + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN3 + PUSH TP,0 + PUSH TP,C +TN.SN1: PUSHJ P,TN.CNT ; COUNT CHARS TO ">" + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN2 + MOVEM 0,-1(TP) + MOVEM C,(TP) + JRST TN.SN1 +TN.SN2: HRRZ B,-3(TP) + SUB B,0 + SUBI B,1 + SUB TP,[2,,2] +TN.SN3: CAIE A,"> ; SKIP IF WINS + JRST ILLNAM + PUSHJ P,TN.CPS ; COPY TO NEW STRING + HLLOS T.SPDL(TB) + MOVEM A,T.SNM(TB) + MOVEM B,T.SNM+1(TB) + +TN.N1: PUSHJ P,TN.CNT + JUMPE B,RPDONE + CAIE A,": ; GOT A DEVICE + JRST TN.N11 + SKIPE (P) + JRST ILLNAM + SETOM (P) + PUSHJ P,TN.CPS + MOVEM A,T.DEV(TB) + MOVEM B,T.DEV+1(TB) + JRST TN.SNM ; NOW LOOK FOR SNAME + +TN.N11: CAIE A,"> + CAIN A,"< + JRST ILLNAM + MOVEM A,(P) ; SAVE END CHAR + PUSHJ P,TN.CPS ; GEN STRING + MOVEM A,T.NM1(TB) + MOVEM B,T.NM1+1(TB) + +TN.N2: SKIPN A,(P) ; GET CHAR BACK + JRST RPDONE + CAIN A,"; ; START VERSION? + JRST .+3 + CAIE A,". ; START NAME2? + JRST ILLNAM ; I GIVE UP!!! + HRRZ B,-1(TP) ; GET RMAINS OF STRING + PUSHJ P,TN.CPS ; AND COPY IT + MOVEM A,T.NM2(TB) + MOVEM B,T.NM2+1(TB) +RPDONE: SUB P,[1,,1] ; FLUSH TEMP + SUB TP,[2,,2] +CPOPJ: POPJ P, + +TN.CNT: HRRZ 0,-1(TP) ; CHAR COUNT + MOVE C,(TP) ; BPTR + MOVEI B,0 ; INIT COUNT TO 0 + +TN.CN1: MOVEI A,0 ; IN CASE RUN OUT + SOJL 0,CPOPJ ; RUN OUT? + ILDB A,C ; TRY ONE + CAIE A," ; TNEX FILE QUOTE? + JRST TN.CN2 + SOJL 0,CPOPJ + IBP C ; SKIP QUOTED CHAT + ADDI B,2 + JRST TN.CN1 + +TN.CN2: CAIE A,"< + CAIN A,"> + POPJ P, + + CAIE A,". + CAIN A,"; + POPJ P, + CAIN A,": + POPJ P, + AOJA B,TN.CN1 + +TN.CPS: PUSH P,B ; # OF CHARS + MOVEI A,4(B) ; ADD 4 TO B IN A + IDIVI A,5 + PUSHJ P,IBLOCK ; GET BLOCK OF WORDS FOR STRING + + POP P,C ; CHAR COUNT BACK + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + HRRI A,(C) ; CHAR STRING + MOVE D,B ; COPY BYTER + + JUMPE C,CPOPJ + ILDB 0,(TP) ; GET CHAR + IDPB 0,D ; AND STROE + SOJG C,.-2 + + MOVNI C,(A) ; - LENGTH TO C + ADDB C,-1(TP) ; DECREMENT WORDS COUNT + TRNN C,-1 ; SKIP IF EMPTY + POPJ P, + IBP (TP) + SOS -1(TP) ; ELSE FLUSH TERMINATOR + POPJ P, + +ILLNAM: ERRUUO EQUOTE ILLEGAL-TENEX-FILE-NAME + +TN.MLT: MOVE A,AB ; AOBJN POINTER TO ARGS IN A + +TN.ML1: GETYP 0,(A) ; IS THIS ARG OF RIGHT TYPE + CAIE 0,TFIX + CAIN 0,TCHSTR + JRST .+2 + JRST RGPRSS ; ASSUME SINGLE STRING + ADD A,[2,,2] + JUMPL A,TN.ML1 ; TRY NEXT ARG IF ANY LEFT + + MOVEI 0,T.NM1(TB) ; 1ST WORD OF DESTINATION + HLRO A,AB ; MINUS NUMBER OF ARGS IN A + MOVN A,A ; NUMBER OF ARGS IN A + SUBI A,1 + CAMGE AB,[-10,,0] + MOVEI A,7 ; IF MORE THAN 10 ARGS, PUT 7 + ADD A,0 ; LAST WORD OF DESTINATION + HRLI 0,(AB) + BLT 0,(A) ; BLT 'EM IN + ADD AB,[10,,10] ; SKIP THESE GUYS + JRST CHKLST + +] + + +; ROUTINE TO OPEN A CHANNEL FOR ANY DEVICE. NAMES ARE ASSUMED TO ALREADY +; BE ON BOTH TP STACK AND P STACK + +OPNCH: MOVE C,T.SPDL+1(TB) ; GET PDL BASE + HRRZ A,S.DIR(C) + ANDI A,1 ; JUST WANT I AND O +IFE ITS,[ + HRLM A,S.DEV(C) +; .TRANS S.DEV(C) ; UNDO ANY TRANSLATIONS +; JRST TRLOST ; COMPLAIN +] +IFN ITS,[ + HRLM A,S.DIR(C) +] + +IFN ITS,[ + MOVE A,S.DEV(C) ; GET SIXBIT DEVICE CODE +] + +IFE ITS,[HRLZS A,S.DEV(C) +] + + MOVSI B,-NDEVS ; AOBJN COUNTER +DEVLP: SETO D, + MOVE 0,DEVSTB(B) ; GET ONE FROM TABLE + MOVE E,A +DEVLP1: AND E,D ; FLUSH POSSIBLE DIGITNESS + CAMN 0,E + JRST CHDIGS ; MAKE SURE REST IS DIGITS + LSH D,6 + JUMPN D,DEVLP1 ; KEEP TRUCKING UNTIL DONE + +; WASN'T THAT DEVICE, MOVE TO NEXT +NXTDEV: AOBJN B,DEVLP + JRST ODSK ; UNKNOWN DEVICE IS ASSUMED TO BE DISK + +IFN ITS,[ +OUSR: HRRZ A,S.DIR(C) ; BLOCK OR UNIT? + TRNE A,2 ; SKIP IF UNIT + JRST ODSK + PUSHJ P,OPEN1 ; OPEN IT + PUSHJ P,FIXREA ; AND READCHST IT + MOVE B,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVE 0,[PUSHJ P,DOIOT] ; GET AN IOINS + MOVEM 0,IOINS(B) + MOVE C,T.SPDL+1(TB) + HRRZ A,S.DIR(C) + TRNN A,1 + JRST EOFMAK + MOVEI 0,80. + MOVEM 0,LINLN(B) + JRST OPNWIN + +OSTY: HLRZ A,S.DIR(C) + IORI A,10 ; THE DONT LOSE BIT (DONT HANG ON INPUT DO ON OUTPUT) + HRLM A,S.DIR(C) + JRST OUSR +] + +; MAKE SURE DIGITS EXIST + +CHDIGS: SETCA D, + JUMPE D,DISPA ; NO DIGITS, WIN IMMEDIATE + MOVE E,A + AND E,D ; LEAVES ONLY DIGITS, IF WINNING + LSH E,6 + LSH D,6 + JUMPG D,.-2 ; KEEP GOING TIL DIGITS LEFT SHIFTED + JRST CHDIGN + +CHDIG1: CAIG D,'9 + CAIGE D,'0 + JRST NXTDEV ; NOT A DIGIT, LOSE + JUMPE E,DISPA ; IF THAT'S ALL THE CHARACTERS, WIN! +CHDIGN: SETZ D, + ROTC D,6 ; GET NEXT CHARACTER INTO D + JRST CHDIG1 ; GO TEST? + +; HERE TO DISPATCH IF SUCCESSFUL + +DISPA: JRST @DEVS(B) + + +IFN ITS,[ + +; DISK DEVICE OPNER COME HERE + +ODSK: MOVE A,S.SNM(C) ; GET SNAME + .SUSET [.SSNAM,,A] ; CLOBBER IT + PUSHJ P,OPEN0 ; DO REAL LIVE OPEN +] +IFE ITS,[ + +; TENEX DISK FILE OPENER + +ODSK: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + PUSHJ P,STSTK ; EXPAND STRING ONTO STACK (E POINTS TO OLD P) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; GET DIR NAME + MOVE C,(P) + MOVE D,T.SPDL+1(TB) + HRRZ D,S.DIR(D) + CAME C,[SIXBIT /PRINAO/] + CAMN C,[SIXBIT /PRINTO/] + IORI D,100 ; TURN ON BIT TO SAY USE OLD FILE + MOVSI A,101 ; START SETTING UP BITS EXTRA BIT FOR MSB + TRNE D,1 ; SKIP IF INPUT + TRNE D,100 ; WITE OVER? + TLOA A,100000 ; FORCE OLD VERSION + TLO A,600000 ; FORCE NEW VERSION + HRROI B,1(E) ; POINT TO STRING + GTJFN + TDZA 0,0 ; SAVE FACT OF NO SKIP + MOVEI 0,1 ; INDICATE SKIPPED + POP P,C ; RECOVER OPEN MODE SIXBIT + MOVE P,E ; RESTORE PSTACK + JUMPE 0,GTJLOS ; FIND OUT WHAT HAPPENED + + MOVE B,T.CHAN+1(TB) ; GET CHANNEL + HRRZ 0,-4(B) ; FUNNY MODE BITS + HRRZM A,CHANNO(B) ; SAVE IT + ANDI A,-1 ; READ Y TO DO OPEN + MOVSI B,440000 ; USE 36. BIT BYES + HRRI B,200000 ; ASSUME READ +; CAMN C,[SIXBIT /READB/] +; TRO B,2000 ; TURN ON THAWED IF READB + IOR B,0 + TRNE D,1 ; SKIP IF READ + HRRI B,300000 ; WRITE BIT + HRRZ 0,FSAV(TB) ; SEE IF REF DATE HACK + CAIN 0,NFOPEN + TRO B,400 ; SET DON'T MUNG REF DATE BIT + MOVE E,B ; SAVE BITS FOR REOPENS + OPENF + JRST OPFLOS + MOVE B,[2,,11] ; GET LENGTH & BYTE SIZE + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + GTFDB + LDB 0,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + CAIN 0,7 + JRST SIZASC + CAIN 0,36. + SIZEF ; USE OPENED SIZE + JFCL + IMULI B,5 ; TO BYTES +SIZASC: MOVEI 0,C.OPN+C.READ+C.DISK + TRNE D,1 ; SKIP FOR READ + MOVEI 0,C.OPN+C.PRIN+C.DISK + TRNE D,2 ; SKIP IF NOT BINARY FILE + TRO 0,C.BIN + HRL 0,B + MOVE B,T.CHAN+1(TB) + TRNE D,1 + HLRM 0,LSTCH-1(B) ; SAVE CURRENT LENGTH + MOVEM E,STATUS(B) + HRRM 0,-2(B) ; MUNG THOSE BITS + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + PUSHJ P,TMTNXS ; GET STRING FROM TENEX + MOVE B,CHANNO(B) ; JFN TO A + HRROI A,1(E) ; BASE OF STRING + MOVE C,[111111,,140001] ; WEIRD CONTROL BITS + JFNS ; GET STRING + MOVEI B,1(E) ; POINT TO START OF STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; MAKE INTO A STRING + SUB P,E ; BACK TO NORMAL + PUSH TP,A + PUSH TP,B + PUSHJ P,RGPRS1 ; PARSE INTO FIELDS + MOVE B,T.CHAN+1(TB) + MOVEI C,RNAME1-1(B) + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + JRST OPBASC +OPFLOS: MOVEI C,(A) ; SAVE ERROR CODE + MOVE B,T.CHAN+1(TB) + HRRZ A,CHANNO(B) ; JFN BACK TO A + RLJFN ; TRY TO RELEASE IT + JFCL + MOVEI A,(C) ; ERROR CODE BACK TO A + +GTJLOS: MOVE B,T.CHAN+1(TB) + PUSHJ P,TGFALS ; GET A FALSE WITH REASON + JRST OPNRET + +STSTK: PUSH TP,$TCHAN + PUSH TP,B + MOVEI A,4+5 ; COUNT CHARS NEEDED (NEED LAST 0 BYTE) + MOVE B,(TP) + ADD A,RDEVIC-1(B) + ADD A,RNAME1-1(B) + ADD A,RNAME2-1(B) + ADD A,RSNAME-1(B) + ANDI A,-1 ; TO 18 BITS + MOVEI 0,A(A) + IDIVI A,5 ; TO WORDS NEEDED + POP P,C ; SAVE RET ADDR + MOVE E,P ; SAVE POINTER + PUSH P,[0] ; ALOCATE SLOTS + SOJG A,.-1 + PUSH P,C ; RET ADDR BACK + INTGO ; IN CASE OVERFLEW + PUSH P,0 + MOVE B,(TP) ; IN CASE GC'D + MOVE D,[440700,,1(E)] ; BYTE POINTER TO IT + MOVEI A,RDEVIC-1(B) + PUSHJ P,MOVSTR ; FLUSH IT ON + HRRZ A,T.SPDL(TB) + JUMPN A,NLNMS ; USER GAVE NAME, USE IT (CAREFUL, RELIES ON + ; A BEING NON ZERO) + PUSH P,B + PUSH P,C + MOVEI A,0 ; HERE TO SEE IF THIS IS REALLY L.N. + HRROI B,1(E) + HRROI C,1(P) + LNMST ; LOOK UP LOGICAL NAME + MOVNI A,1 ; NOT A LOGICAL NAME + POP P,C + POP P,B +NLNMS: MOVEI 0,": + IDPB 0,D + JUMPE A,ST.NM1 ; LOGICAL NAME, FLUSH SNAME + HRRZ A,RSNAME-1(B) ; ANY SNAME AT ALL? + JUMPE A,ST.NM1 ; NOPE, CANT HACK WITH IT + MOVEI A,"< + IDPB A,D + MOVEI A,RSNAME-1(B) + PUSHJ P,MOVSTR ; SNAME UP + MOVEI A,"> + IDPB A,D +ST.NM1: MOVEI A,RNAME1-1(B) + PUSHJ P,MOVSTR + MOVEI A,". + IDPB A,D + MOVEI A,RNAME2-1(B) + PUSHJ P,MOVSTR + SUB TP,[2,,2] + POP P,A + POPJ P, + +MOVSTR: HRRZ 0,(A) ; CHAR COUNT + MOVE A,1(A) ; BYTE POINTER + SOJL 0,CPOPJ + ILDB C,A ; GET CHAR + IDPB C,D ; MUNG IT UP + JRST .-3 + +; MAKE A TENEX ERROR MESSAGE STRING + +TGFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; SAVE ERROR CODE + PUSHJ P,TMTNXS ; STRING ON STACK + HRROI A,1(E) ; POINT TO SPACE + MOVE B,(E) ; ERROR CODE + HRLI B,400000 ; FOR ME + MOVSI C,-100. ; MAX CHARS + ERSTR ; GET TENEX STRING + JRST TGFLS1 + JRST TGFLS1 + + MOVEI B,1(E) ; A AND B BOUND STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; BUILD STRING + SUB P,E ; P BACK TO NORMAL +TGFLS2: +IFE FNAMS, SUB P,[1,,1] ; FLUSH ERROR CODE SLOT +IFN FNAMS,[ + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST TGFLS3 + PUSHJ P,STSTK + MOVEI B,1(E) + SUBM P,E + MOVSI A,440700 + HRRI A,(P) + MOVEI C,5 + ILDB 0,A + JUMPE 0,.+2 + SOJG C,.-2 + + PUSHJ P,TNXSTR + PUSH TP,A + PUSH TP,B + SUB P,E +TGFLS3: POP P,A + PUSH TP,$TFIX + PUSH TP,A + MOVEI A,3 + SKIPN B + MOVEI A,2 +] +IFE FNAMS,[ + MOVEI A,1 +] + PUSHJ P,IILIST ; BUILD LIST + MOVSI A,TFALSE ; MAKE IT FALSE + SUB TP,[2,,2] + POPJ P, + +TGFLS1: MOVE P,E ; RESET STACK + MOVE A,$TCHSTR + MOVE B,CHQUOTE UNKNOWN PROBLEM IN I/O + JRST TGFLS2 + +] +; OTHER BUFFERED DEVICES JOIN HERE + +OPDSK1: +IFN ITS,[ + PUSHJ P,FIXREA ; STORE THE "REAL" NAMES INTO THE CHANNEL +] +OPBASC: MOVE C,T.SPDL+1(TB) ; C WAS CLOBBERED, GET IT BACK + HRRZ A,S.DIR(C) ; FIND OUT IF OPEN IS ASCII OR WORD + TRZN A,2 ; SKIP IF BINARY + PUSHJ P,OPASCI ; DO IT FOR ASCII + +; NOW SET UP IO INSTRUCTION FOR CHANNEL + +MAKION: MOVE B,T.CHAN+1(TB) + MOVEI C,GETCHR + JUMPE A,MAKIO1 ; JUMP IF INPUT + MOVEI C,PUTCHR ; ELSE GET INPUT + MOVEI 0,80. ; DEFAULT LINE LNTH + MOVEM 0,LINLN(B) + MOVSI 0,TFIX + MOVEM 0,LINLN-1(B) +MAKIO1: + HRLI C,(PUSHJ P,) + MOVEM C,IOINS(B) ; STORE IT + JUMPN A,OPNWIN ; GET AN EOF FORM FOR INPUT CHANNEL + +; HERE TO CONS UP + +EOFMAK: MOVSI C,TATOM + MOVE D,EQUOTE END-OF-FILE + PUSHJ P,INCONS + MOVEI E,(B) + MOVSI C,TATOM + MOVE D,IMQUOTE ERROR + PUSHJ P,ICONS + MOVE D,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVSI 0,TFORM + MOVEM 0,EOFCND-1(D) + MOVEM B,EOFCND(D) + +OPNWIN: MOVEI 0,10. ; SET UP RADIX + MOVSI A,TCHAN ; OPEN SUCCEEDED, RET CHANNEL + MOVE B,T.CHAN+1(TB) + MOVEM 0,RADX(B) + +OPNRET: MOVE D,T.CHAN+1(TB) ; IN CASE WE RECYCLE IT + MOVE C,(P) ; RET ADDR + SUB P,[S.X3+2,,S.X3+2] + SUB TP,[T.CHAN+2,,T.CHAN+2] + JRST (C) + + +; HERE TO CREATE CHARACTER BUFFERS FOR ASCII I/O + +OPASCI: PUSH P,A ; CONTAINS MODE, SAVE IT + MOVEI A,BUFLNT ; GET SIZE OF BUFFER + PUSHJ P,IBLOCK ; GET STORAGE + MOVSI 0,TWORD+.VECT. ; SET UTYPE + MOVEM 0,BUFLNT(B) ; AND STORE + MOVSI A,TCHSTR + SKIPE (P) ; SKIP IF INPUT + JRST OPASCO + MOVEI D,BUFLNT-1(B) ; REST BYTE POINTER +OPASCA: HRLI D,010700 + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEI 0,C.BUF + IORM 0,-2(B) ; TURN ON BUFFER BIT + MOVEM A,BUFSTR-1(B) + MOVEM D,BUFSTR(B) ; CLOBBER + POP P,A + POPJ P, + +OPASCO: HRROI C,777776 + MOVEM C,(B) ; -1 THE BUFFER (LEAVE OFF LOW BIT) + MOVSI C,(B) + HRRI C,1(B) ; BUILD BLT POINTER + BLT C,BUFLNT-1(B) ; ZAP + MOVEI D,-1(B) ; START MAKING STRING POINTER + HRRI A,BUFLNT*5 ; SET UP CHAR COUNT + JRST OPASCA + + +; OPEN NON FILE ORIENTED DEVICES (NUL, PTR, PTP ETC.) + +IFN ITS,[ +ONUL: +OPTP: +OPTR: PUSHJ P,OPEN0 ; SET UP MODE AND OPEN + SETZM S.NM1(C) ; CLOBBER UNINTERESTING FIELDS + SETZM S.NM2(C) + SETZM S.SNM(C) + JRST OPDSK1 + +; OPEN DEVICES THAT IGNORE SNAME + +OUTN: PUSHJ P,OPEN0 + SETZM S.SNM(C) + JRST OPDSK1 + +] + +; INTERNAL CHANNEL OPENER + +OINT: HRRZ A,S.DIR(C) ; CHECK DIR + CAIL A,2 ; READ/PRINT? + JRST WRONGD ; NO, LOSE + + MOVE 0,INTINS(A) ; GET INS + MOVE D,T.CHAN+1(TB) ; AND CHANNEL + MOVEM 0,IOINS(D) ; AND CLOBBER + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + HRRM 0,-2(D) + SETOM STATUS(D) ; MAKE SURE NOT AA TTY + PMOVEM T.XT(TB),INTFCN-1(D) + +; HERE TO SAVE PSEUDO CHANNELS + +SAVCHN: HRRZ E,CHNL0+1 ; POINT TO CURRENT LIST + MOVSI C,TCHAN + PUSHJ P,ICONS ; CONS IT ON + HRRZM B,CHNL0+1 + JRST OPNWIN + +; INT DEVICE I/O INS + +INTINS: PUSHJ P,GTINTC + PUSHJ P,PTINTC + + +; HERE TO OPEN THE NET DEVICE (I.E. THE ARPA NET) + +IFN ITS,[ +ONET: HRRZ A,S.DIR(C) ; DIRECTION CODE + CAILE A,1 ; ASCII ? + IORI A,4 ; TURN ON IMAGE BIT + SKIPGE S.NM1(C) ; NAME1 I.E. LOCAL HOST GIVEN + IORI A,10 ; NO, WE WILL LET ITS GIVE US ONE + SKIPGE S.NM2(C) ; NORMAL OR "LISTEN" + IORI A,20 ; TURN ON LISTEN BIT + MOVEI 0,7 ; DEFAULT BYTE SIZE + TRNE A,2 ; UNLESS + MOVEI 0,36. ; IMAGE WHICH IS 36 + SKIPN T.XT(TB) ; BYTE SIZE GIVEN? + MOVEM 0,S.X1(C) ; NO, STORE DEFAULT + SKIPG D,S.X1(C) ; BYTE SIZE REASONABLE? + JRST RBYTSZ ; NO <0, COMPLAIN + TRNE A,2 ; SKIP TO CHECK ASCII + JRST ONET2 ; CHECK IMAGE + CAIN D,7 ; 7-BIT WINS + JRST ONET1 + CAIE D,44 ; 36-BIT INDICATES BLOCK ASCII MODE + JRST .+3 + IORI A,2 ; SET BLOCK FLAG + JRST ONET1 + IORI A,40 ; USE 8-BIT MODE + CAIN D,10 ; IS IT RIGHT + JRST ONET1 ; YES +] + +RBYTSZ: ERRUUO EQUOTE BYTE-SIZE-BAD + +IFN ITS,[ +ONET2: CAILE D,36. ; IMAGE SIZE REASONABLE? + JRST RBYTSZ ; NO + CAIN D,36. ; NORMAL + JRST ONET1 ; YES, DONT SET FIELD + + ASH D,9. ; POSITION FOR FIELD + IORI A,40(D) ; SET IT AND ITS BIT + +ONET1: HRLM A,S.DIR(C) ; CLOBBER OPEN BLOCK + MOVE E,A ; SAVE BLOCK MODE INFO + PUSHJ P,OPEN1 ; DO THE OPEN + PUSH P,E + +; CLOBBER REAL SLOTS FOR THE OPEN + + MOVEI A,3 ; GET STATE VECTOR + PUSHJ P,IBLOCK + MOVSI A,TUVEC + MOVE D,T.CHAN+1(TB) + HLLM A,BUFRIN-1(D) + MOVEM B,BUFRIN(D) + MOVSI A,TFIX+.VECT. ; SET U TYPE + MOVEM A,3(B) + MOVE C,T.SPDL+1(TB) + MOVE B,T.CHAN+1(TB) + + PUSHJ P,INETST ; GET STATE + + POP P,A ; IS THIS BLOCK MODE + MOVEI 0,80. ; POSSIBLE LINE LENGTH + TRNE A,1 ; SKIP IF INPUT + MOVEM 0,LINLN(B) + TRNN A,2 ; BLOCK MODE? + JRST .+3 + TRNN A,4 ; ASCII MODE? + JRST OPBASC ; GO SETUP BLOCK ASCII + MOVE 0,[PUSHJ P,DOIOT] + MOVEM 0,IOINS(B) + + JRST OPNWIN + +; INTERNAL ROUTINE TO GET THE CURRENT STATE OF THE NETWROK CHANNEL + +INETST: MOVE A,S.NM1(C) + MOVEM A,RNAME1(B) + MOVE A,S.NM2(C) + MOVEM A,RNAME2(B) + LDB A,[1100,,S.SNM(C)] + MOVEM A,RSNAME(B) + + MOVE E,BUFRIN(B) ; GET STATE BLOCK +INTST1: HRRE 0,S.X1(C) + MOVEM 0,(E) + ADDI C,1 + AOBJN E,INTST1 + + POPJ P, + + +; ACCEPT A CONNECTION + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET ; CHECK THAT ARG IS AN OPEN NET CHANNEL + MOVE A,CHANNO(B) ; GET CHANNEL + LSH A,23. ; TO AC FIELD + IOR A,[.NETACC] + XCT A + JRST IFALSE ; RETURN FALSE +NETRET: MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +; FORCE SYSTEM NETWORK BUFFERS TO BE SENT + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 + CAMN A,MODES+3 + SKIPA A,CHANNO(B) ; GET CHANNEL + JRST WRONGD + LSH A,23. + IOR A,[.NETS] + XCT A + JRST NETRET + +; SUBR TO RETURN UPDATED NET STATE + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET ; IS IT A NET CHANNEL + PUSHJ P,INSTAT + JRST FINIS + +; INTERNAL NETSTATE ROUTINE + +INSTAT: MOVE C,P ; GET PDL BASE + MOVEI 0,S.X3 ; # OF SLOTS NEEDED + PUSH P,[0] + SOJN 0,.-1 +; RESTORED FROM MUDDLE 54. IT SEEMED TO WORK THERE, AND THE STUFF +; COMMENTED OUT HERE CERTAINLY DOESN'T. + MOVEI D,S.DEV(C) + HRL D,CHANNO(B) + .RCHST D, +; HRR D,CHANNO(B) ; SETUP FOR RFNAME CALL +; DOTCAL RFNAME,[D,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] +; .LOSE %LSFIL ; THIS MAY NOT BE DESIRABLE, BUT I ASSUME WE CARE IF + ; LOSSAGE + PUSHJ P,INETST ; INTO VECTOR + SUB P,[S.X3,,S.X3] + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + POPJ P, +] +; INTERNAL ROUTINE TO CHECK FOR CORRECT CHANNEL TYPE + +ARGNET: ENTRY 1 + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; OPEN? + JRST CHNCLS + MOVE A,RDEVIC-1(B) ; GET DEV NAME + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 + POP P,A + CAME A,[SIXBIT /NET /] + JRST NOTNET + MOVE B,1(AB) + MOVE A,DIRECT-1(B) ; CHECK FOR A READ SOCKET + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 + MOVE B,1(AB) ; RESTORE CHANNEL + POP P,A + POPJ P, + +IFE ITS,[ + +; TENEX NETWRK OPENING CODE + +ONET: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + MOVSI C,100700 + HRRI C,1(P) + MOVE E,P + PUSH P,[ASCII /NET:/] ; FOR STRINGS + GETYP 0,RNAME1-1(B) ; CHECK TYPE + CAIE 0,TFIX ; SKIP IF # SUPPLIED + JRST ONET1 + MOVE 0,RNAME1(B) ; GET IT + PUSHJ P,FIXSTK + JFCL + JRST ONET2 +ONET1: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME1-1(B) + MOVE B,RNAME1(B) + JUMPE 0,ONET2 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 +ONET2: MOVEI A,". + JSP D,ONETCH + MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIE 0,TFIX + JRST ONET3 + GETYP 0,RSNAME-1(B) + CAIE 0,TFIX + JRST WRONGT + MOVE 0,RSNAME(B) + CAIG 0,377 ;NEW STYLE 32 BIT HOST NUMBER? + JRST ONET2A +;CONVERT HOSTS2 HOST NUMBERS TO INTERNET (TOPS-20) HOST NUMBERS + MOVEI A,0 + LDB B,[001100,,0] ;HOST NUMBER: 1.1-1.9 -> + DPB B,[201000,,A] ; 2.8-3.6 + LDB B,[111100,,0] ;IMP LOW BITS: 2.1-2.9 -> + DPB B,[001000,,A] ; 1.1-1.8 + LDB B,[221100,,0] ;IMP HIGH BITS: 3.1-3.9 -> + DPB B,[101000,,A] ; 1.9-2.7 + LDB B,[331100,,0] ;NETWORK: 4.1-4.9 -> + DPB B,[301000,,A] ; 3.7-4.5 + MOVE 0,A +ONET2A: PUSHJ P,FIXSTK + JRST ONET4 + MOVE B,T.CHAN+1(TB) + MOVEI A,"- + JSP D,ONETCH + MOVE 0,RNAME2(B) + PUSHJ P,FIXSTK + JRST WRONGT + JRST ONET4 +ONET3: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME2-1(B) + MOVE B,RNAME2(B) + JUMPE 0,ONET4 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 + +ONET4: +ONET5: MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIN 0,TCHSTR + JRST ONET6 + MOVEI A,"; + JSP D,ONETCH + MOVEI A,"T + JSP D,ONETCH +ONET6: MOVSI A,1 + HRROI B,1(E) ; STRING POINTER + GTJFN ; GET THE G.D JFN + TDZA 0,0 ; REMEMBER FAILURE + MOVEI 0,1 + MOVE P,E ; RESTORE P + JUMPE 0,GTJLOS ; CONS UP ERROR STRING + + MOVE B,T.CHAN+1(TB) + HRRZM A,CHANNO(B) ; SAVE THE JFN + + MOVE C,T.SPDL+1(TB) + MOVE D,S.DIR(C) + MOVEI B,10 + TRNE D,2 + MOVEI B,36. + SKIPE T.XT(TB) + MOVE B,T.XT+1(TB) + JUMPL B,RBYTSZ + CAILE B,36. + JRST RBYTSZ + ROT B,-6 + TLO B,3400 + HRRI B,200000 + TRNE D,1 ; SKIP FOR INPUT + HRRI B,100000 + ANDI A,-1 ; ISOLATE JFCN + OPENF + JRST OPFLOS ; REPORT ERROR + MOVE B,T.CHAN+1(TB) + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) + CVSKT ; GET ABS SOCKET # + FATAL NETWORK BITES THE BAG! + MOVE D,B + MOVE B,T.CHAN+1(TB) + MOVEM D,RNAME1(B) + MOVSI 0,TFIX + MOVEM 0,RNAME1-1(B) + + MOVSI 0,TFIX + MOVEM 0,RNAME2-1(B) + MOVEM 0,RSNAME-1(B) + MOVE C,T.SPDL+1(TB) + MOVE C,S.DIR(C) + MOVE 0,[PUSHJ P,DONETO] + TRNN C,1 ; SKIP FOR OUTPUT + MOVE 0,[PUSHJ P,DONETI] + MOVEM 0,IOINS(B) + MOVEI 0,80. ; LINELENGTH + TRNE C,1 ; SKIP FOR INPUT + MOVEM 0,LINLN(B) + MOVEI A,3 ; GET STATE UVECTOR + PUSHJ P,IBLOCK + MOVSI 0,TFIX+.VECT. + MOVEM 0,3(B) + MOVE C,B + MOVE B,T.CHAN+1(TB) + MOVEM C,BUFRIN(B) + MOVSI 0,TUVEC + HLLM 0,BUFRIN-1(B) + MOVE B,CHANNO(B) ; GET JFN + MOVEI A,4 ; CODE FOR GTNCP + MOVEI C,1(P) + ADJSP P,4 ; ROOM FOR DATA + MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC + GTNCP + FATAL NET LOSSAGE ; GET STATE + MOVE B,(P) + MOVE D,-1(P) + MOVE C,-3(P) + ADJSP P,-4 + MOVE E,T.CHAN+1(TB) + MOVEM D,RNAME2(E) + MOVEM C,RSNAME(E) + MOVE C,BUFRIN(E) + MOVEM B,(C) ; INITIAL STATE STORED + MOVE B,E + JRST OPNWIN + +; DOIOT FOR TENEX NETWRK + +DONETO: PUSH P,0 + MOVE 0,[BOUT] + JRST .+3 + +DONETI: PUSH P,0 + MOVE 0,[BIN] + PUSH P,0 + PUSH TP,$TCHAN + PUSH TP,B + MOVEI 0,(A) ; POSSIBLE OUTPUT CHAR TO 0 + MOVE A,CHANNO(B) + MOVE B,0 + ENABLE + XCT (P) + DISABLE + MOVEI A,(B) ; RET CHAR IN A + MOVE B,(TP) + MOVE 0,-1(P) + SUB P,[2,,2] + SUB TP,[2,,2] + POPJ P, + +NETPRS: MOVEI D,0 + HRRZ 0,(C) + MOVE C,1(C) + +ONETL: ILDB A,C + CAIN A,"# + POPJ P, + SUBI A,60 + ASH D,3 + IORI D,(A) + SOJG 0,ONETL + AOS (P) + POPJ P, + +FIXSTK: CAMN 0,[-1] + POPJ P, + JFFO 0,FIXS3 ; PUT OCTAL DIGITS INTO STIRNG + MOVEI A,"0 + POP P,D + AOJA D,ONETCH +FIXS3: IDIVI A,3 + MOVEI B,12. + SUBI B,(A) + HRLM B,(P) + IMULI A,3 + LSH 0,(A) + POP P,B +FIXS2: MOVEI A,0 + ROTC 0,3 ; NEXT DIGIT + ADDI A,60 + JSP D,ONETCH + SUB B,[1,,0] + TLNN B,-1 + JRST 1(B) + JRST FIXS2 + +ONETCH: IDPB A,C + TLNE C,760000 ; SKIP IF NEW WORD + JRST (D) + PUSH P,[0] + JRST (D) + +INSTAT: MOVE E,B + MOVE B,CHANNO(B) ; GET JFN + MOVEI A,4 ; CODE FOR GTNCP + MOVEI C,1(P) + ADJSP P,4 ; ROOM FOR DATA + MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC + GTNCP + FATAL NET LOSSAGE ; GET STATE + MOVE B,(P) + MOVE D,-1(P) + MOVE C,-3(P) + ADJSP P,-4 + MOVEM D,RNAME2(E) ; UPDATE FOREIGN SOCHKET + MOVEM C,RSNAME(E) ; AND HOST + MOVE C,BUFRIN(E) + XCT ITSTRN(B) ; XLATE TO LOOK MORE LIKE ITS + MOVEM B,(C) ; STORE STATE + MOVE B,E + POPJ P, + +ITSTRN: MOVEI B,0 + JRST NLOSS + JRST NLOSS + MOVEI B,1 + MOVEI B,2 + JRST NLOSS + MOVEI B,4 + PUSHJ P,NOPND + MOVEI B,0 + JRST NLOSS + JRST NLOSS + PUSHJ P,NCLSD + MOVEI B,0 + JRST NLOSS + MOVEI B,0 + +NLOSS: FATAL ILLEGAL NETWORK STATE + +NOPND: MOVE B,DIRECT(E) ; SEE IF READ OR PRINT + ILDB B,B ; GET 1ST CHAR + CAIE B,"R ; SKIP FOR READ + JRST NOPNDW + SIBE ; SEE IF INPUT EXISTS + JRST .+3 + MOVEI B,5 + POPJ P, + MOVEM B,2(C) ; STORE BYTES IN STATE VECTOR + MOVEI B,11 ; RETURN DATA PRESENT STATE + POPJ P, + +NOPNDW: SOBE ; SEE IF OUTPUT PRESENT + JRST .+3 + MOVEI B,5 + POPJ P, + + MOVEI B,6 + POPJ P, + +NCLSD: MOVE B,DIRECT(E) + ILDB B,B + CAIE B,"R + JRST RET0 + SIBE + JRST .+2 + JRST RET0 + MOVEI B,10 + POPJ P, + +RET0: MOVEI B,0 + POPJ P, + + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET + PUSHJ P,INSTAT + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + JRST FINIS + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 ; PRINT OR PRINTB? + CAMN A,MODES+3 + SKIPA A,CHANNO(B) + JRST WRONGD + MOVEI B,21 + MTOPR +NETRET: MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET + MOVE A,CHANNO(B) + MOVEI B,20 + MTOPR + JRST NETRET + +] + +; HERE TO OPEN TELETYPE DEVICES + +OTTY: HRRZ A,S.DIR(C) ; GET DIR CODE + TRNE A,2 ; SKIP IF NOT READB/PRINTB + JRST WRONGD ; CANT DO THAT + +IFN ITS,[ + MOVE A,S.NM1(C) ; CHECK FOR A DIR + MOVE 0,S.NM2(C) + CAMN A,[SIXBIT /.FILE./] + CAME 0,[SIXBIT /(DIR)/] + SKIPA E,[-15.*2,,] + JRST OUTN ; DO IT THAT WAY + + HRRZ A,S.DIR(C) ; CHECK DIR + TRNE A,1 + JRST TTYLP2 + HRRI E,CHNL1 + PUSH P,S.DEV(C) ; SAVE THE SIXBIT DEV NAME + ; HRLZS (P) ; POSTITION DEVICE NAME + +TTYLP: SKIPN D,1(E) ; CHANNEL OPEN? + JRST TTYLP1 ; NO, GO TO NEXT + MOVE A,RDEVIC-1(D) ; GET DEV NAME + MOVE B,RDEVIC(D) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A ; GET RESULT + CAMN A,(P) ; SAME? + JRST SAMTYQ ; COULD BE THE SAME +TTYLP1: ADD E,[2,,2] + JUMPL E,TTYLP + SUB P,[1,,1] ; THIS ONE MUST BE UNIQUE +TTYLP2: MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; GET DIR OF OPEN + SKIPE A ; IF OUTPUT, + IORI A,20 ; THEN USE DISPLAY MODE + HRLM A,S.DIR(C) ; STORE IN OPEN BLOCK + PUSHJ P,OPEN2 ; OPEN THE TTY + MOVE A,S.DEV(C) ; GET DEVICE NAME + PUSHJ P,6TOCHS ; TO A STRING + MOVE D,T.CHAN+1(TB) ; POINT TO CHANNEL + MOVEM A,RDEVIC-1(D) + MOVEM B,RDEVIC(D) + MOVE C,T.SPDL+1(TB) ; RESTORE PDL BASE + MOVE B,D ; CHANNEL TO B + HRRZ 0,S.DIR(C) ; AND DIR + JUMPE 0,TTYSPC +TTY1: DOTCAL TTYGET,[CHANNO(B),[2000,,0],[2000,,A],[2000,,D]] + .LOSE %LSSYS + DOTCAL TTYSET,[CHANNO(B),MODE1,MODE2,D] + .LOSE %LSSYS + MOVE A,[PUSHJ P,GMTYO] + MOVEM A,IOINS(B) + DOTCAL RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]] + .LOSE %LSSYS + MOVEM D,LINLN(B) + MOVEM A,PAGLN(B) + JRST OPNWIN + +; MAKE AN IOT + +IOTMAK: HRLZ A,CHANNO(B) ; GET CHANNEL + ROT A,5 + IOR A,[.IOT A] ; BUILD IOT + MOVEM A,IOINS(B) ; AND STORE IT + POPJ P, + + +; HERE IF POSSIBLY OPENING AN ALREADY OPEN TTY + +SAMTYQ: MOVE D,1(E) ; RESTORE CURRENT CHANNEL + MOVE A,DIRECT-1(D) ; GET DIR + MOVE B,DIRECT(D) + PUSHJ P,STRTO6 + POP P,A ; GET SIXBIT + MOVE C,T.SPDL+1(TB) + HRRZ C,S.DIR(C) + CAME A,MODES(C) ; SKIP IF DIFFERENT DIRECTION + JRST TTYLP1 + +; HERE IF A RE-OPEN ON A TTY + + HRRZ 0,FSAV(TB) ; IS IT FROM A FOPEN + CAIN 0,FOPEN + JRST RETOLD ; RET OLD CHANNEL + + PUSH TP,$TCHAN + PUSH TP,1(E) ; PUSH OLD CHANNEL + PUSH TP,$TFIX + PUSH TP,T.CHAN+1(TB) + MOVE A,[PUSHJ P,CHNFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + SUB TP,[4,,4] + +RETOLD: MOVE B,1(E) ; GET CHANNEL + AOS CHANNO-1(B) ; AOS REF COUNT + MOVSI A,TCHAN + SUB P,[1,,1] ; CLEAN UP STACK + JRST OPNRET ; AND LEAVE + + +; ROUTINE TO PASS TO GCHACK TO FIX UP CHANNEL POINTER + +CHNFIX: CAIN C,TCHAN + CAME D,(TP) + POPJ P, + MOVE D,-2(TP) ; GET REPLACEMENT + SKIPE B + MOVEM D,1(B) ; CLOBBER IT AWAY + POPJ P, +] + +IFE ITS,[ + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ 0,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVE A,[PUSHJ P,INMTYO] + MOVE B,T.CHAN+1(TB) + MOVEM A,IOINS(B) + MOVEI A,100 ; PRIM INPUT JFN + JUMPN 0,TNXTY1 + MOVEI E,C.OPN+C.READ+C.TTY + HRRM E,-2(B) + MOVEM B,CHNL0+2*100+1 + JRST TNXTY2 +TNXTY1: MOVEM B,CHNL0+2*101+1 + MOVEI A,101 ; PRIM OUTPUT JFN + MOVEI E,C.OPN+C.PRIN+C.TTY + HRRM E,-2(B) +TNXTY2: MOVEM A,CHANNO(B) + JUMPN 0,OPNWIN +] +; SETUP FUNNY BUFFER FOR TTY INPUT DEVICES + +TTYSPC: MOVEI A,EXTBFR ; GET EXTRA BUFFER + PUSHJ P,IBLOCK ; GET BLOCK + MOVE D,T.CHAN+1(TB) ;RESTORE CHANNEL POINTER +IFN ITS,[ + MOVE A,CHANNO(D) + LSH A,23. + IOR A,[.IOT A] + MOVEM A,IOIN2(B) +] +IFE ITS,[ + MOVE A,[PBIN] + MOVEM A,IOIN2(B) +] + MOVSI A,TLIST + MOVEM A,EXBUFR-1(D) ; FOR WAITING TTY BUFFERS + SETZM EXBUFR(D) ; NIL LIST + MOVEM B,BUFRIN(D) ;STORE IN CHANNEL + MOVSI A,TUVEC ;MAKE SURE TYPE IS UNIFORM VECTOR + HLLM A,BUFRIN-1(D) + MOVEI A,177 ;SET ERASER TO RUBOUT + MOVEM A,ERASCH(B) +IFE ITS,[ + MOVEI A,25 + MOVEM A,KILLCH(B) +] +IFN ITS,[ + SETZM KILLCH(B) ;NO KILL CHARACTER NEEDED +] + MOVEI A,33 ;BREAKCHR TO C.R. + MOVEM A,BRKCH(B) + MOVEI A,"\ ;ESCAPER TO \ + MOVEM A,ESCAP(B) + MOVE A,[010700,,BYTPTR(E)] ;RELATIVE BYTE POINTER + MOVEM A,BYTPTR(B) + MOVEI A,14 ;BARF BACK CHARACTER FF + MOVEM A,BRFCHR(B) + MOVEI A,^D + MOVEM A,BRFCH2(B) + +; SETUP DEFAULT TTY INTERRUPT HANDLER + + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TFIX + PUSH TP,[10] ; PRIORITY OF CHAR INT + PUSH TP,$TCHAN + PUSH TP,D + MCALL 3,EVENT ; 1ST MAKE AN EVENT EXIST + PUSH TP,A + PUSH TP,B + PUSH TP,$TSUBR + PUSH TP,[QUITTER] ; DEFAULT HANDLER IS QUITTER + MCALL 2,HANDLER + +; BUILD A NULL STRING + + MOVEI A,0 + PUSHJ P,IBLOCK ; USE A BLOCK + MOVE D,T.CHAN+1(TB) + MOVEI 0,C.BUF + IORM 0,-2(D) + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + MOVEM A,BUFSTR-1(D) + MOVEM B,BUFSTR(D) + MOVEI A,0 + MOVE B,D ; CHANNEL TO B + JRST MAKION + + +; ROUTINE TO OPEN ITS CHANNEL WITHOUT .RCHST + +IFN ITS,[ +OPEN2: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN ; OPEN THE FILE + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; SAVE THE CHANNEL + JRST OPEN3 + +; FIX UP MODE AND FALL INTO OPEN + +OPEN0: HRRZ A,S.DIR(C) ; GET DIR + TRNE A,2 ; SKIP IF NOT BLOCK + IORI A,4 ; TURN ON IMAGE + IORI A,2 ; AND BLOCK + + PUSH P,A + PUSH TP,$TPDL + PUSH TP,C ; SAVE CRUFT TO CHECK FOR PRINTO, HA HA + MOVE B,T.CHAN+1(TB) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) ; THIS KLUDGE THE MESS OF NDR + PUSHJ P,STRTO6 + MOVE C,(TP) + POP P,D ; THE SIXBIT FOR KLUDGE + POP P,A ; GET BACK THE RANDOM BITS + SUB TP,[2,,2] + CAME D,[SIXBIT /PRINAO/] + CAMN D,[SIXBIT /PRINTO/] + IORI A,100000 ; WRITEOVER BIT + HRRZ 0,FSAV(TB) + CAIN 0,NFOPEN + IORI A,10 ; DON'T CHANGE REF DATE +OPEN9: HRLM A,S.DIR(C) ; AND STORE IT + +; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL + +OPEN1: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; CLOBBER INTO CHANNEL + DOTCAL RFNAME,[A,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] + JFCL + +; NOW CLOBBER THE TVP SLOT FOR THIS CHANNEL + +OPEN3: MOVE A,S.DIR(C) + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) ; GET CHANNEL # + ASH A,1 + ADDI A,CHNL0 ; POINT TO SLOT + MOVEM B,1(A) ; NOT: TYPE ALREADY SETUP + +; NOW GET STATUS WORD + +DOSTAT: HRRZ A,CHANNO(B) ; NOW GET STATUS WORD + DOTCAL STATUS,[A,[2002,,STATUS]] + JFCL + POPJ P, + + +; HERE IF OPEN FAILS (CHANNEL IS IN A) + +OPNLOS: JUMPL A,NOCHAN ; ALL CHANNELS ARE IN USE + LSH A,23. ; DO A .STATUS + IOR A,[.STATUS A] + XCT A ; STATUS TO A + MOVE B,T.CHAN+1(TB) + PUSHJ P,GFALS ; GET A FALSE WITH A MESSAGE + SUB P,[1,,1] ; EXTRA RET ADDR FLUSHED + JRST OPNRET ; AND RETURN +] + +CGFALS: SUBM M,(P) + MOVEI B,0 +IFN ITS, PUSHJ P,GFALS +IFE ITS, PUSHJ P,TGFALS + JRST MPOPJ + +; ROUTINE TO CONS UP FALSE WITH REASON +IFN ITS,[ +GFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,[SIXBIT / ERR/] ; SET UP OPEN TO ERR DEV + PUSH P,[3] ; SAY ITS FOR CHANNEL + PUSH P,A + .OPEN 0,-2(P) ; USE CHANNEL 0 FOR THIS + FATAL CAN'T OPEN ERROR DEVICE + SUB P,[3,,3] ; DONT WANT OPEN BLOCK NOW +IFN FNAMS, PUSH P,A + MOVEI A,0 ; PREPARE TO BUILD STRING ON STACK +EL1: PUSH P,[0] ; WHERE IT WILL GO + MOVSI B,(<440700,,(P)>) ; BYTE POINTER TO TOP OF STACK +EL2: .IOT 0,0 ; GET A CHAR + JUMPL 0,EL3 ; JUMP ON -1,,3 + CAIN 0,3 ; EOF? + JRST EL3 ; YES, MAKE STRING + CAIN 0,14 ; IGNORE FORM FEEDS + JRST EL2 ; IGNORE FF + CAIE 0,15 ; IGNORE CR & LF + CAIN 0,12 + JRST EL2 + IDPB 0,B ; STUFF IT + TLNE B,760000 ; SIP IF WORD FULL + AOJA A,EL2 + AOJA A,EL1 ; COUNT WORD AND GO + +EL3: +IFN FNAMS,[ + SKIPN (P) + SUB P,[1,,1] + PUSH P,A + .CLOSE 0, + PUSHJ P,CHMAK + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST EL4 + MOVEI A,0 + MOVSI B,(<440700,,(P)>) + PUSH P,[0] + IRP XX,,[RDEVIC,RSNAME,RNAME1,RNAME2]YY,,[0,72,73,40] +IFSN YY,0,[ + MOVEI 0,YY + JSP E,1PUSH +] + MOVE E,-2(TP) + MOVE C,XX(E) + HRRZ D,XX-1(E) + JSP E,PUSHIT + TERMIN +] + SKIPN (P) ; ANY CHARS AT END? + SUB P,[1,,1] ; FLUSH XTRA + PUSH P,A ; PUT UP COUNT + .CLOSE 0, ; CLOSE THE ERR DEVICE + PUSHJ P,CHMAK ; MAKE STRING + PUSH TP,A + PUSH TP,B +IFN FNAMS,[ +EL4: POP P,A + PUSH TP,$TFIX + PUSH TP,A] +IFE FNAMS, MOVEI A,1 +IFN FNAMS,[ + MOVEI A,3 + SKIPN B + MOVEI A,2 +] + PUSHJ P,IILIST + MOVSI A,TFALSE ; MAKEIT A FALSE +IFN FNAMS, SUB TP,[2,,2] + POPJ P, + +IFN FNAMS,[ +1PUSH: MOVEI D,0 + JRST PUSHI2 +PUSHI1: PUSH P,[0] + MOVSI B,(<440700,,(P)>) +PUSHIT: SOJL D,(E) + ILDB 0,C +PUSHI2: IDPB 0,B + TLNE B,760000 + AOJA A,PUSHIT + AOJA A,PUSHI1 +] +] + + +; ROUTINE TO FILL IN THE "REAL" SLOTS FOR THE CHANNEL + +FIXREA: +IFE ITS, HRLZS S.DEV(C) ; KILL MODE BITS + MOVE D,[-4,,S.DEV] + +FIXRE1: MOVEI A,(D) ; COPY REL POINTER + ADD A,T.SPDL+1(TB) ; POINT TO SLOT + SKIPN A,(A) ; SKIP IF GOODIE THERE + JRST FIXRE2 + PUSHJ P,6TOCHS ; MAKE INOT A STRING + MOVE C,RDTBL-S.DEV(D); GET OFFSET + ADD C,T.CHAN+1(TB) + MOVEM A,-1(C) + MOVEM B,(C) +FIXRE2: AOBJN D,FIXRE1 + POPJ P, + +IFN ITS,[ +DOOPN: HRLZ A,A + HRR A,CHANNO(B) ; GET CHANNEL + DOTCAL OPEN,[A,-3(P),-2(P),-1(P),(P)] + SKIPA + AOS -1(P) + POPJ P, +] + +;THIS ROUTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES +STRTO6: PUSH TP,A + PUSH TP,B + PUSH P,E ;SAVE USEFUL FROB + MOVEI E,(A) ; CHAR COUNT TO E + GETYP A,A + CAIE A,TCHSTR ; IS IT ONE WORD? + JRST WRONGT ;NO + CAILE E,6 ; SKIP IF L=? 6 CHARS + MOVEI E,6 +CHREAD: MOVEI A,0 ;INITIALIZE OUTPUT WORD + MOVE D,[440600,,A] ;AND BYTE POINTER TO IT +NEXCHR: SOJL E,SIXDON + ILDB 0,B ; GET NEXT CHAR + CAIN 0,^Q ; CNTL-Q, QUOTES NEXT CHAR + JRST NEXCHR + JUMPE 0,SIXDON ;IF NULL, WE ARE FINISHED + PUSHJ P,A0TO6 ; CONVERT TO SIXBIT + IDPB 0,D ;DEPOSIT INTO SIX BIT + JRST NEXCHR ; NO, GET NEXT +SIXDON: SUB TP,[2,,2] ;FIX UP TP + POP P,E + EXCH A,(P) ;LEAVE RESULT ON P-STACK + JRST (A) ;NOW RETURN + + +;SUBROUTINE TO CONVERT SIXBIT TO ATOM + +6TOCHS: PUSH P,E + PUSH P,D + MOVEI B,0 ;MAX NUMBER OF CHARACTERS + PUSH P,[0] ;STRING WILL GO ON P SATCK + JUMPE A,GETATM ; EMPTY, LEAVE + MOVEI E,-1(P) ;WILL BE BYTE POINTER + HRLI E,10700 ;SET IT UP + PUSH P,[0] ;SECOND POSSIBLE WORD + MOVE D,[440600,,A] ;INPUT BYTE POINTER +6LOOP: ILDB 0,D ;START CHAR GOBBLING + ADDI 0,40 ;CHANGET TOASCII + IDPB 0,E ;AND STORE IT + TLNN D,770000 ; SKIP IF NOT DONE + JRST 6LOOP1 + TDNN A,MSKS(B) ; CHECK IF JUST SPACES LEFT + AOJA B,GETATM ; YES, DONE + AOJA B,6LOOP ;KEEP LOOKING +6LOOP1: PUSH P,[6] ;IF ARRIVE HERE, STRING IS 2 WORDS + JRST .+2 +GETATM: MOVEM B,(P) ;SET STRING LENGTH=1 + PUSHJ P,CHMAK ;MAKE A MUDDLE STRING + POP P,D + POP P,E + POPJ P, + +MSKS: 7777,,-1 + 77,,-1 + ,,-1 + 7777 + 77 + + +; CONVERT ONE CHAR + +A0TO6: CAIL 0,141 ;IF IT IS GREATER OR EQUAL TO LOWER A + CAILE 0,172 ;BUT LESS THAN OR EQUAL TO LOWER Z + JRST .+2 ;THEN + SUBI 0,40 ;CONVERT TO UPPER CASE + SUBI 0,40 ;NOW TO SIX BIT + JUMPL 0,BAD6 ;CHECK FOR A WINNER + CAILE 0,77 + JRST BAD6 + POPJ P, + +; SUBR TO TEST THE EXISTENCE OF FILES + +MFUNCTION FEXIST,SUBR,[FILE-EXISTS?] + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + ADD TP,[2,,2] + MOVSI E,-4 ; 4 THINGS TO PUSH +EXIST: +IFN ITS, MOVE B,@RNMTBL(E) +IFE ITS, MOVE B,@FETBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST EXIST1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ +; PUSH P,E +; PUSHJ P,ADDNUL ; NOT NEEDED, SINCE CONSED INTO ONE STRING-TAA +; POP P,E + PUSH TP,A ; DEFAULT TYPE AND VALUE GIVEN BY USER + PUSH TP,B ; IN VALUE OF DEV, SNM, NM1, NM2 + ] +IFN ITS, JRST .+2 +IFE ITS, JRST .+3 + +EXIST1: +IFN ITS, PUSH P,EXISTS(E) ; USE DEFAULT +IFE ITS,[ + PUSH TP,FETYP(E) ; DEFAULT TYPE AND VALUE IF NO + PUSH TP,FEVAL(E) ; DEFAULT GIVEN BY USER + ] + AOBJN E,EXIST + + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST TMA ; TOO MANY ARGUMENTS + +IFN ITS,[ + MOVE 0,-3(P) ; GET SIXBIT DEV NAME + MOVEI B,0 + CAMN 0,[SIXBITS /DSK /] + MOVSI B,10 ; DONT SET REF DATE IF DISK DEV + .IOPUSH + DOTCAL OPEN,[B,[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST .+3 + .IOPOP + JRST FDLWON ; WON!!! + .STATUS 0,A ; FIND THE STATUS OF CHANNEL BEFORE POPING + .IOPOP + JRST FDLST1] + +IFE ITS,[ + MOVE B,TB + SUBI B,10 ; GET B TO POINT CORRECTLY TO ARGS + PUSHJ P,STSTK ; GET FILE NAME IN A STRING + HRROI B,1(E) ; POINT B TO THE STRING + MOVSI A,100001 + GTJFN + JRST TDLLOS ; FILE DOES NOT EXIST + RLJFN ; FILE EXIST SO RETURN JFN + JFCL + JRST FDLWON ; SUCCESS + ] + +IFN ITS,[ +EXISTS: SIXBITS /DSK INPUT > / + ] +IFE ITS,[ +FETBL: SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + +FETYP: TCHSTR,,5 + TCHSTR,,3 + TCHSTR,,3 + TCHSTR,,0 + +FEVAL: 440700,,[ASCIZ /INPUT/] + 440700,,[ASCIZ /MUD/] + 440700,,[ASCIZ /DSK/] + 0 + ] + +; SUBR TO DELETE AND RENAME FILES + +MFUNCTION RENAME,SUBR + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + GETYP 0,(AB) ; GET 1ST ARG TYPE +IFN ITS,[ + CAIN 0,TCHAN ; CHANNEL? + JRST CHNRNM ; MUST BE RENAME WHILE OPEN FOR WRITING +] +IFE ITS,[ + PUSH P,[100000,,-2] + PUSH P,[377777,,377777] +] + MOVSI E,-4 ; 4 THINGS TO PUSH +RNMALP: MOVE B,@RNMTBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST RNMLP1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ + PUSH P,E + PUSHJ P,ADDNUL + EXCH B,(P) + MOVE E,B +] + JRST .+2 + +RNMLP1: PUSH P,RNSTBL(E) ; USE DEFAULT + AOBJN E,RNMALP + +IFN ITS,[ + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST RNM1 ; COULD BE A RENAME + +; HERE TO DELETE A FILE + +DELFIL: MOVE A,(P) ; AND GET SNAME + .SUSET [.SSNAM,,A] + DOTCAL DELETE,[[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST FDLST ; ANALYSE ERROR + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS +] +IFE ITS,[ + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; GET BASE OF PDL + MOVEI A,1(A) ; POINT TO CRAP + CAMGE AB,[-3,,] ; SKIP IF DELETE + HLLZS (A) ; RESET DEFAULT + PUSH P,[0] + PUSH P,[0] + PUSH P,[0] + GTJFN ; GET A JFN + JRST TDLLOS ; LOST + ADD AB,[2,,2] ; PAST ARG + JUMPL AB,RNM1 ; GO TRY FOR RENAME + MOVE P,(TP) ; RESTORE P STACK + MOVEI C,(A) ; FOR RELEASE + DELF ; ATTEMPT DELETE + JRST DELLOS ; LOSER + RLJFN ; MAKE SURE FLUSHED + JFCL + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +RNMLOS: PUSH P,A + MOVEI A,(B) + RLJFN + JFCL +DELLO1: MOVEI A,(C) + RLJFN + JFCL + POP P,A ; ERR NUMBER BACK +TDLLOS: MOVEI B,0 + PUSHJ P,TGFALS ; GET FALSE WITH REASON + JRST FINIS + +DELLOS: PUSH P,A ; SAVE ERROR + JRST DELLO1 +] + +;TABLE OF REANMAE DEFAULTS +IFN ITS,[ +RNMTBL: IMQUOTE DEV + IMQUOTE NM1 + IMQUOTE NM2 + IMQUOTE SNM + +RNSTBL: SIXBIT /DSK _MUDS_> / +] +IFE ITS,[ +RNMTBL: SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + +RNSTBL: -1,,[ASCIZ /DSK/] + 0 + -1,,[ASCIZ /_MUDS_/] + -1,,[ASCIZ /MUD/] +] +; HERE TO DO A RENAME + +RNM1: JUMPGE AB,TMA ; IF ARGS EXHAUSTED, MUST BE TOO MUCH STRING + GETYP 0,(AB) + MOVE C,1(AB) ; GET ARG + CAIN 0,TATOM ; IS IT "TO" + CAME C,IMQUOTE TO + JRST WRONGT ; NO, LOSE + ADD AB,[2,,2] ; BUMP PAST "TO" + JUMPGE AB,TFA +IFN ITS,[ + MOVEM P,T.SPDL+1(TB) ; SAVE NEW P-BASE + + MOVEI 0,4 ; FOUR DEFAULTS + PUSH P,-3(P) ; DEFAULT DEVICE IS CURRENT + SOJN 0,.-1 + + PUSHJ P,RGPRS ; PARSE THE NEXT STRING + JRST TMA + + MOVE A,-7(P) ; FIX AND GET DEV1 + MOVE B,-3(P) ; SAME FOR DEV2 + CAME A,B ; SAME? + JRST DEVDIF + + POP P,A ; GET SNAME 2 + CAME A,(P)-3 ; SNAME 1 + JRST DEVDIF + .SUSET [.SSNAM,,A] + POP P,-2(P) ; MOVE NAMES DOWN + POP P,-2(P) + DOTCAL RENAME,[[17,,-4],[17,,-3],[17,,-2],A,[17,,-1],(P)] + JRST FDLST + JRST FDLWON + +; HERE FOR RENAME WHILE OPEN FOR WRITING + +CHNRNM: ADD AB,[2,,2] ; NEXT ARG + JUMPGE AB,TFA + MOVE B,-1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; SKIP IF OPEN + JRST BADCHN + MOVE A,DIRECT-1(B) ; CHECK DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A + CAME A,[SIXBIT /PRINT/] + CAMN A,[SIXBIT /PRINTB/] + JRST CHNRN1 + CAMN A,[SIXBIT /PRINAO/] + JRST CHNRM1 + CAME A,[SIXBIT /PRINTO/] + JRST WRONGD + +; SET UP .FDELE BLOCK + +CHNRN1: PUSH P,[0] + PUSH P,[0] + MOVEM P,T.SPDL+1(TB) + PUSH P,[0] + PUSH P,[SIXBIT /_MUDL_/] + PUSH P,[SIXBIT />/] + PUSH P,[0] + + PUSHJ P,RGPRS ; PARSE THESE + JRST TMA + + SUB P,[1,,1] ; SNAME/DEV IGNORED + MOVE AB,ABSAV(TB) ; GET ORIG ARG POINTER + MOVE B,1(AB) + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RENMWO,[A,[17,,-1],(P)] + JRST FDLST + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RFNAME,[A,[2017,,-4],[2017,,-3],[2017,,-2],[2017,,-1]] + JFCL + MOVE A,-3(P) ; UPDATE CHANNEL + PUSHJ P,6TOCHS ; GET A STRING + MOVE C,1(AB) + MOVEM A,RNAME1-1(C) + MOVEM B,RNAME1(C) + MOVE A,-2(P) + PUSHJ P,6TOCHS + MOVE C,1(AB) + MOVEM A,RNAME2-1(C) + MOVEM B,RNAME2(C) + MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS +] +IFE ITS,[ + PUSH P,A + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; PBASE BACK + PUSH A,[400000,,0] + MOVEI A,(A) + GTJFN + JRST TDLLOS + POP P,B + EXCH A,B + MOVEI C,(A) ; FOR RELEASE ATTEMPT + RNAMF + JRST RNMLOS + MOVEI A,(B) + RLJFN ; FLUSH JFN + JFCL + MOVEI A,(C) ; MAKE SURR OTHER IS FLUSHED + RLJFN + JFCL + JRST FDLWON + + +ADDNUL: PUSH TP,A + PUSH TP,B + MOVEI A,(A) ; LNTH OF STRING + IDIVI A,5 + JUMPN B,NONUAD ; DONT NEED TO ADD ONE + + PUSH TP,$TCHRS + PUSH TP,[0] + MOVEI A,2 + PUSHJ P,CISTNG ; COPY OF STRING + POPJ P, + +NONUAD: POP TP,B + POP TP,A + POPJ P, +] +; HERE FOR LOSING .FDELE + +IFN ITS,[ +FDLST: .STATUS 0,A ; GET STATUS +FDLST1: MOVEI B,0 + PUSHJ P,GFALS ; ANALYZE IT + JRST FINIS +] + +; SOME .FDELE ERRORS + +DEVDIF: ERRUUO EQUOTE DEVICE-OR-SNAME-DIFFERS + + ; HERE TO RESET A READ CHANNEL + +MFUNCTION FRESET,SUBR,RESET + + ENTRY 1 + GETYP A,(AB) + CAIE A,TCHAN + JRST WTYP1 + MOVE B,1(AB) ;GET CHANNEL + SKIPN IOINS(B) ; OPEN? + JRST REOPE1 ; NO, IGNORE CHECKS +IFN ITS,[ + MOVE A,STATUS(B) ;GET STATUS + ANDI A,77 + JUMPE A,REOPE1 ;IF IT CLOSED, JUST REOPEN IT, MAYBE? + CAILE A,2 ;SKIPS IF TTY FLAVOR + JRST REOPEN +] +IFE ITS,[ + MOVE A,CHANNO(B) + CAIE A,100 ; TTY-IN + CAIN A,101 ; TTY-OUT + JRST .+2 + JRST REOPEN +] + CAME B,TTICHN+1 + CAMN B,TTOCHN+1 + JRST REATTY +REATT1: MOVEI B,DIRECT-1(B) ;POINT TO DIRECTION + PUSHJ P,CHRWRD ;CONVERT TO A WORD + JFCL + CAME B,[ASCII /READ/] + JRST TTYOPN + MOVE B,1(AB) ;RESTORE CHANNEL + PUSHJ P,RRESET" ;DO REAL RESET + JRST TTYOPN + +REOPEN: PUSH TP,(AB) ;FIRST CLOSE IT + PUSH TP,(AB)+1 + MCALL 1,FCLOSE + MOVE B,1(AB) ;RESTORE CHANNEL + +; SET UP TEMPS FOR OPNCH + +REOPE1: PUSH P,[0] ; WILL HOLD DIR CODE + PUSH TP,$TPDL + PUSH TP,P + IRP A,,[DIRECT,RNAME1,RNAME2,RDEVIC,RSNAME,ACCESS] + PUSH TP,A-1(B) + PUSH TP,A(B) + TERMIN + + PUSH TP,$TCHAN + PUSH TP,1(AB) + + MOVE A,T.DIR(TB) + MOVE B,T.DIR+1(TB) ; GET DIRECTION + PUSHJ P,CHMOD ; CHECK THE MODE + MOVEM A,(P) ; AND STORE IT + +; NOW SET UP OPEN BLOCK IN SIXBIT + +IFN ITS,[ + MOVSI E,-4 ; AOBN PNTR +FRESE2: MOVE B,T.CHAN+1(TB) + MOVEI A,@RDTBL(E) ; GET ITEM POINTER + GETYP 0,-1(A) ; GET ITS TYPE + CAIE 0,TCHSTR + JRST FRESE1 + MOVE B,(A) ; GET STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 +FRESE3: AOBJN E,FRESE2 +] +IFE ITS,[ + MOVE B,T.CHAN+1(TB) + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; RESULT ON STACK + HLRZS (P) +] + + PUSH P,[0] ; PUSH UP SOME DUMMIES + PUSH P,[0] + PUSH P,[0] + PUSHJ P,OPNCH ; ATTEMPT TO DO THEOPEN + GETYP 0,A + CAIE 0,TCHAN + JRST FINIS ; LEAVE IF FALSE OR WHATEVER + +DRESET: MOVE A,(AB) + MOVE B,1(AB) + SETZM CHRPOS(B) ;INITIALIZE THESE PARAMETERS + SETZM LINPOS(B) + SETZM ACCESS(B) + JRST FINIS + +TTYOPN: +IFN ITS,[ + MOVE B,1(AB) + CAME B,TTOCHN+1 + CAMN B,TTICHN+1 + PUSHJ P,TTYOP2 + PUSHJ P,DOSTAT + DOTCAL RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]] + .LOSE %LSSYS + MOVEM C,PAGLN(B) + MOVEM D,LINLN(B) +] + JRST DRESET + +IFN ITS,[ +FRESE1: CAIE 0,TFIX + JRST BADCHN + PUSH P,(A) + JRST FRESE3 +] + +; INTERFACE TO REOPEN CLOSED CHANNELS + +OPNCHN: PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FRESET + POPJ P, + +REATTY: PUSHJ P,TTYOP2 +IFE ITS, SKIPN DEMFLG ; SKIP IF DEMONFLAG IS ON + SKIPE NOTTY + JRST DRESET + MOVE B,1(AB) + JRST REATT1 + +; FUNCTION TO LIST ALL CHANNELS + +MFUNCTION CHANLIST,SUBR + + ENTRY 0 + + MOVEI A,N.CHNS-1 ;MAX # OF REAL CHANNELS + MOVEI C,0 + MOVEI B,CHNL1 ;POINT TO FIRST REAL CHANNEL + +CHNLP: SKIPN 1(B) ;OPEN? + JRST NXTCHN ;NO, SKIP + HRRE E,(B) ; ABOUT TO FLUSH? + JUMPL E,NXTCHN ; YES, FORGET IT + MOVE D,1(B) ; GET CHANNEL + HRRZ E,CHANNO-1(D) ; GET REF COUNT + PUSH TP,(B) + PUSH TP,1(B) + ADDI C,1 ;COUNT WINNERS + SOJGE E,.-3 ; COUNT THEM +NXTCHN: ADDI B,2 + SOJN A,CHNLP + + SKIPN B,CHNL0+1 ;NOW HACK LIST OF PSUEDO CHANNELS + JRST MAKLST +CHNLS: PUSH TP,(B) + PUSH TP,(B)+1 + ADDI C,1 + HRRZ B,(B) + JUMPN B,CHNLS + +MAKLST: ACALL C,LIST + JRST FINIS + + ; ROUTINE TO RESTORE A CLOSED CHANNEL TO ITS PREVIOUS STATE + + +REOPN: PUSH TP,$TCHAN + PUSH TP,B + SKIPN CHANNO(B) ; ONLY REAL CHANNELS + JRST PSUEDO + +IFN ITS,[ + MOVSI E,-4 ; SET UP POINTER FOR NAMES + +GETOPB: MOVE B,(TP) ; GET CHANNEL + MOVEI A,@RDTBL(E) ; GET POINTER + MOVE B,(A) ; NOW STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 ; LEAVES SIXBIT ON STACK + AOBJN E,GETOPB +] +IFE ITS,[ + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; GET DEV NAME IN SIXBIT +] + MOVE B,(TP) ; RESTORE CHANNEL + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,CHMOD ; CHECK FOR A VALID MODE + +IFN ITS, MOVE E,-3(P) ; GET DEVICE IN PROPER PLACE +IFE ITS, HLRZS E,(P) + MOVE B,(TP) ; RESTORE CHANNEL +IFN ITS, CAMN E,[SIXBIT /DSK /] +IFE ITS,[ + CAIE E,(SIXBIT /PS /) + CAIN E,(SIXBIT /DSK/) + JRST DISKH ; DISK WINS IMMEIDATELY + CAIE E,(SIXBIT /SS /) + CAIN E,(SIXBIT /SRC/) + JRST DISKH ; DISK WINS IMMEIDATELY +] +IFN ITS, CAMN E,[SIXBIT /TTY /] ; NO NEED TO RE-OPEN THE TTY +IFE ITS, CAIN E,(SIXBIT /TTY/) + JRST REOPD1 +IFN ITS,[ + AND E,[777700,,0] ; COULD BE "UTn" + MOVE D,CHANNO(B) ; GET CHANNEL + ASH D,1 + ADDI D,CHNL0 ; DON'T SEEM TO BE OPEN + SETZM 1(D) + SETZM CHANNO(B) + CAMN E,[SIXBIT /UT /] + JRST REOPD ; CURRENTLY, CANT RESTORE UTAPE CHANNLES + CAMN E,[SIXBIT /AI /] + JRST REOPD ; CURRENTLY CANT RESTORE AI CHANNELS + CAMN E,[SIXBIT /ML /] + JRST REOPD ; CURRENTLY CANT RESTORE ML CHANNELS + CAMN E,[SIXBIT /DM /] + JRST REOPD ; CURRENTLY CANT RESTORE DM CHANNELS +] + PUSH TP,$TCHAN ; TRY TO RESET IT + PUSH TP,B + MCALL 1,FRESET + +IFN ITS,[ +REOPD1: AOS -4(P) +REOPD: SUB P,[4,,4] +] +IFE ITS,[ +REOPD1: AOS -1(P) +REOPD: SUB P,[1,,1] +] +REOPD0: SUB TP,[2,,2] + POPJ P, + +IFN ITS,[ +DISKH: MOVE C,(P) ; SNAME + .SUSET [.SSNAM,,C] +] +IFE ITS,[ +DISKH: MOVEM A,(P) ; SAVE MODE WORD + PUSHJ P,STSTK ; STRING TO STACK + MOVE A,(E) ; RESTORE MODE WORD + PUSH TP,$TPDL + PUSH TP,E ; SAVE PDL BASE + MOVE B,-2(TP) ; CHANNEL BACK TO B +] + MOVE C,ACCESS(B) ; GET CHANNELS ACCESS + TRNN A,2 ; SKIP IF NOT ASCII CHANNEL + JRST DISKH1 + HRRZ D,ACCESS-1(B) ; IF PARTIAL WORD OUT + IMULI C,5 ; TO CHAR ACCESS + JUMPE D,DISKH1 ; NO SWEAT + ADDI C,(D) + SUBI C,5 +DISKH1: HRRZ D,BUFSTR-1(B) ; ANY CHARS IN MUDDLE BUFFER + JUMPE D,DISKH2 + TRNN A,1 ; SKIP IF OUTPUT CHANNEL + JRST DISKH2 + PUSH P,A + PUSH P,C + MOVEI C,BUFSTR-1(B) + PUSHJ P,BYTDOP ; FIND LENGTH OF WHOLE BUFFER + HLRZ D,(A) ; LENGTH + 2 TO D + SUBI D,2 + IMULI D,5 ; TO CHARS + SUB D,BUFSTR-1(B) + POP P,C + POP P,A +DISKH2: SUBI C,(D) ; UPDATE CHAR ACCESS + IDIVI C,5 ; BACK TO WORD ACCESS +IFN ITS,[ + IORI A,6 ; BLOCK IMAGE + TRNE A,1 + IORI A,100000 ; WRITE OVER BIT + PUSHJ P,DOOPN + JRST REOPD + MOVE A,C ; ACCESS TO A + PUSHJ P,GETFLN ; CHECK LENGTH + CAIGE 0,(A) ; CHECK BOUNDS + JRST .+3 ; COMPLAIN + PUSHJ P,DOACCS ; AND ACESS + JRST REOPD1 ; SUCCESS + + MOVE A,CHANNO(B) ; CLOSE THE G.D. CHANNEL + PUSHJ P,MCLOSE + JRST REOPD + +DOACCS: PUSH P,A + HRRZ A,CHANNO(B) + DOTCAL ACCESS,[A,(P)] + JFCL + POP P,A + POPJ P, + +DOIOTO: +DOIOTI: +DOIOT: + PUSH P,0 + MOVSI 0,TCHAN + MOVE PVP,PVSTOR+1 + MOVEM 0,BSTO(PVP) ; IN CASE OF INTERRUPT + ENABLE + HRRZ 0,CHANNO(B) + DOTCAL IOT,[0,A] + JFCL + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + POP P,0 + POPJ P, + +GETFLN: MOVE 0,CHANNO(B) ; GET CHANNEL + .CALL FILBLK ; READ LNTH + .VALUE + POPJ P, + +FILBLK: SETZ + SIXBIT /FILLEN/ + 0 + 402000,,0 ; STUFF RESULT IN 0 +] +IFE ITS,[ + MOVEI A,CHNL0 + ADD A,CHANNO(B) + ADD A,CHANNO(B) + SETZM 1(A) ; MAY GET A DIFFERENT JFN + HRROI B,1(E) ; TENEX STRING POINTER + MOVSI A,400001 ; MAKE SURE + GTJFN ; GO GET IT + JRST RGTJL ; COMPLAIN + MOVE D,-2(TP) + HRRZM A,CHANNO(D) ; COULD HAVE CHANGED + MOVE P,(TP) ; RESTORE P + MOVEI B,CHNL0 + ASH A,1 ; MUNG ITS SLOT + ADDI A,(B) + MOVEM D,1(A) + HLLOS (A) ; MARK CHANNEL NOT TO BE RELOOKED AT + MOVE A,(P) ; MODE WORD BACK + MOVE B,[440000,,200000] ; FLAG BITS + TRNE A,1 ; SKIP FOR INPUT + TRC B,300000 ; CHANGE TO WRITE + MOVE A,CHANNO(D) ; GET JFN + OPENF + JRST ROPFLS + MOVE E,C ; LENGTH TO E + SIZEF ; GET CURRENT LENGTH + JRST ROPFLS + CAMGE B,E ; STILL A WINNER + JRST ROPFLS + MOVE A,CHANNO(D) ; JFN + MOVE B,C + SFPTR + JRST ROPFLS + SUB TP,[2,,2] ; FLUSH PDL POINTER + JRST REOPD1 + +ROPFLS: MOVE A,-2(TP) + MOVE A,CHANNO(A) + CLOSF ; ATTEMPT TO CLOSE + JFCL ; IGNORE FAILURE + SKIPA + +RGTJL: MOVE P,(TP) + SUB TP,[2,,2] + JRST REOPD + +DOACCS: PUSH P,B + EXCH A,B + MOVE A,CHANNO(A) + SFPTR + JRST ACCFAI + POP P,B + POPJ P, +] +PSUEDO: AOS (P) ; ASSUME SUCCESS FOR NOW + MOVEI B,RDEVIC-1(B) ; SEE WHAT DEVICE IS + PUSHJ P,CHRWRD + JFCL + JRST REOPD0 ; NO, RETURN HAPPY +IFN 0,[ CAME B,[ASCII /E&S/] ; DISPLAY ? + CAMN B,[ASCII /DIS/] + SKIPA B,(TP) ; YES, REGOBBLE CHANNEL AND CONTINUE + JRST REOPD0 ; NO, RETURN HAPPY + PUSHJ P,DISROP + SOS (P) ; DISPLAY DID NOT REOPEN, UNDO ASSUMPTION OF SUCCESS + JRST REOPD0] + + ;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL + +MFUNCTION FCLOSE,SUBR,[CLOSE] + + ENTRY 1 ;ONLY ONE ARG + GETYP A,(AB) ;CHECK ARGS + CAIE A,TCHAN ;IS IT A CHANNEL + JRST WTYP1 + MOVE B,1(AB) ;PICK UP THE CHANNEL + HRRZ A,CHANNO-1(B) ; GET REF COUNT + SOJGE A,CFIN5 ; NOT READY TO REALLY CLOSE + CAME B,TTICHN+1 ; CHECK FOR TTY + CAMN B,TTOCHN+1 + JRST CLSTTY + MOVE A,[JRST CHNCLS] + MOVEM A,IOINS(B) ;CLOBBER THE IO INS + MOVE A,RDEVIC-1(B) ;GET THE NAME OF THE DEVICE + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 +IFN ITS, MOVE A,(P) +IFE ITS, HLRZS A,(P) + MOVE B,1(AB) ; RESTORE CHANNEL +IFN 0,[ + CAME A,[SIXBIT /E&S /] + CAMN A,[SIXBIT /DIS /] + PUSHJ P,DISCLS] + MOVE B,1(AB) ; IN CASE CLOBBERED BY DISCLS + SKIPN A,CHANNO(B) ;ANY REAL CHANNEL? + JRST REMOV ; NO, EITHER CLOSED OR PSEUDO CHANNEL + + MOVE A,DIRECT-1(B) ; POINT TO DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; CONVERT TO WORD + POP P,A +IFN ITS, LDB E,[360600,,(P)] ; FIRST CHAR OD DEV NAME +IFE ITS, LDB E,[140600,,(P)] ; FIRST CHAR OD DEV NAME + CAIE E,'T ; SKIP IF TTY + JRST CFIN4 + CAME A,[SIXBIT /READ/] ; SKIP IF WINNER + JRST CFIN1 +IFN ITS,[ + MOVE B,1(AB) ; IN ITS CHECK STATUS + LDB A,[600,,STATUS(B)] + CAILE A,2 + JRST CFIN1 +] + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE CHAR + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,OFF ; TURN OFF INTERRUPT +CFIN1: MOVE B,1(AB) + MOVE A,CHANNO(B) +IFN ITS,[ + PUSHJ P,MCLOSE +] +IFE ITS,[ + TLZ A,400000 ; FOR JFN RELEASE + CLOSF ; CLOSE THE FILE AND RELEASE THE JFN + JFCL + MOVE A,CHANNO(B) +] +CFIN: LSH A,1 + ADDI A,CHNL0+1 ;POINT TO THIS CHANNELS LSOT + SETZM CHANNO(B) + SETZM (A) ;AND CLOBBER IT + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) + HLLZS ACCESS-1(B) +CFIN2: HLLZS -2(B) + MOVSI A,TCHAN ;RETURN THE CHANNEL + JRST FINIS + +CLSTTY: ERRUUO EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL + + +REMOV: MOVEI D,CHNL0+1 ;ATTEMPT TO REMOVE FROM PSUEDO CHANNEL LIST +REMOV0: SKIPN C,D ;FOUND ON LIST ? + JRST CFIN2 ;NO, JUST IGNORE THIS CLOSED CHANNEL + HRRZ D,(C) ;GET POINTER TO NEXT + CAME B,(D)+1 ;FOUND ? + JRST REMOV0 + HRRZ D,(D) ;YES, SPLICE IT OUT + HRRM D,(C) + JRST CFIN2 + + +; CLOSE UP ANY LEFTOVER BUFFERS + +CFIN4: +; CAME A,[SIXBIT /PRINTO/] +; CAMN A,[SIXBIT /PRINTB/] +; JRST .+3 +; CAME A,[SIXBIT /PRINT/] +; JRST CFIN1 + MOVE B,1(AB) ; GET CHANNEL + HRRZ A,-2(B) ;GET MODE BITS + TRNN A,C.PRIN + JRST CFIN1 + GETYP 0,BUFSTR-1(B) ; IS THERE AN OUTPUT BUFFER + SKIPN BUFSTR(B) + JRST CFIN1 + CAIE 0,TCHSTR + JRST CFINX1 + PUSHJ P,BFCLOS +IFE ITS,[ + MOVE A,CHANNO(B) + MOVEI B,7 + SFBSZ + JFCL + CLOSF + JFCL +] + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) +CFINX1: HLLZS ACCESS-1(B) + JRST CFIN1 + +CFIN5: HRRM A,CHANNO-1(B) + JRST CFIN2 + ;SUBR TO DO .ACCESS ON A READ CHANNEL +;FORM: +;POSITIONS CHANNEL AT CHARACTER POSN FIX-NUMBER +;H. BRODIE 7/26/72 + +MFUNCTION MACCESS,SUBR,[ACCESS] + ENTRY 2 ;ARGS: CHANNEL AND FIX-NUMBER + +;CHECK ARGUMENT TYPES + GETYP A,(AB) + CAIE A,TCHAN ;FIRST ARG SHOULD BE CHANNEL + JRST WTYP1 + GETYP A,2(AB) ;TYPE OF SECOND + CAIE A,TFIX ;SHOULD BE FIX + JRST WTYP2 + +;CHECK DIRECTION OF CHANNEL + MOVE B,1(AB) ;B GETS PNTR TO CHANNEL +; MOVEI B,DIRECT-1(B) ;GET DIRECTION OF CHANNEL +; PUSHJ P,CHRWRD ;GRAB THE CHAR STRNG +; JFCL +; CAME B,[+1] + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.PRIN + JRST MACCA + MOVE B,1(AB) + SKIPE C,BUFSTR(B) ;SEE IF WE MUST FLUSH PART BUFFER + PUSHJ P,BFCLOS + JRST MACC +MACCA: +; CAMN B,[ASCIZ /READ/] +; JRST .+4 +; CAME B,[ASCIZ /READB/] ; READB CHANNEL? +; JRST WRONGD +; AOS (P) ; SET INDICATOR FOR BINARY MODE + +;CHECK THAT THE CHANNEL IS OPEN +MACC: MOVE B,1(AB) ;GET BACK PTR TO CHANNEL + HRRZ E,-2(B) + TRNN E,C.OPN + JRST CHNCLS ;IF CHNL CLOSED => ERROR + +;COMPUTE ACCESS PNTR TO ACCESS WORD CHAR IS IN +;REMAINDER IS NUMBER OF TIMES TO INCR BYTE POINTER +ADEVOK: SKIPGE C,3(AB) ;GET CHAR POSN + ERRUUO EQUOTE NEGATIVE-ARGUMENT +MACC1: MOVEI D,0 + TRNN E,C.BIN ; SKIP FOR BINARY FILE + IDIVI C,5 + +;SETUP THE .ACCESS + TRNN E,C.PRIN + JRST NLSTCH + HRRZ 0,LSTCH-1(B) + MOVE A,ACCESS(B) + TRNN E,C.BIN + JRST LSTCH1 + IMULI A,5 + ADD A,ACCESS-1(B) + ANDI A,-1 +LSTCH1: CAIG 0,(A) + MOVE 0,A + MOVE A,C + IMULI A,5 + ADDI A,(D) + CAML A,0 + MOVE 0,A + HRRM 0,LSTCH-1(B) ; UPDATE "LARGEST" +NLSTCH: MOVE A,CHANNO(B) ;A GETS REAL CHANNEL NUMBER +IFN ITS,[ + DOTCAL ACCESS,[A,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + +IFE ITS,[ + MOVE B,C + SFPTR ; DO IT IN TENEX + JRST ACCFAI + MOVE B,1(AB) ; RESTORE CHANNEL +] +; POP P,E ; CHECK FOR READB MODE + TRNN E,C.READ + JRST ACCOUT ; PRINT TYPE CHANNEL, GO DO IT + SKIPE BUFSTR(B) ; IS THERE A READ BUFFER TO FLUSH + JRST .+3 + SETZM LSTCH(B) ; CLEAR OUT POSSIBLE EOF INDICATOR + JRST DONADV + +;NOW FORCE GETCHR TO DO A .IOT FIRST THING + MOVEI C,BUFSTR-1(B) ; FIND END OF STRING + PUSHJ P,BYTDOP" + SUBI A,2 ; LAST REAL WORD + HRLI A,010700 + MOVEM A,BUFSTR(B) + HLLZS BUFSTR-1(B) ; CLOBBER CHAR COUNT + SETZM LSTCH(B) ;CLOBBER READ'S HIDDEN CHARACTER + +;NOW DO THE APPROPRIATE NUM OF BYTE ADVANCEMENTS + JUMPLE D,DONADV +ADVPTR: PUSHJ P,GETCHR + MOVE B,1(AB) ;RESTORE IN CASE CLOBBERED + SOJG D,ADVPTR + +DONADV: MOVE C,3(AB) ;FIXUP ACCESS SLOT IN CHNL + HLLZS ACCESS-1(B) + MOVEM C,ACCESS(B) + MOVE A,$TCHAN ;TYPE OF RESULT = "CHANNEL" + JRST FINIS ;DONE...B CONTAINS CHANNEL + +IFE ITS,[ +ACCFAI: ERRUUO EQUOTE ACCESS-FAILURE +] +ACCOUT: SKIPN C,BUFSTR(B) ; FIXUP BUFFER? + JRST ACCOU1 + HRRZ F,BUFSTR-1(B) + ADD F,[-BUFLNT*5-4] + IDIVI F,5 + ADD F,BUFSTR(B) + HRLI F,010700 + MOVEM F,BUFSTR(B) + MOVEI F,BUFLNT*5 + HRRM F,BUFSTR-1(B) +ACCOU1: TRNE E,C.BIN ; FINISHED FOR BINARY CHANNELS + JRST DONADV + + JUMPE D,DONADV ; THIS CASE OK +IFE ITS,[ + MOVE A,CHANNO(B) ; GET LAST WORD + RFPTR + JFCL + PUSH P,B + MOVNI C,1 + MOVE B,[444400,,E] ; READ THE WORD + SIN + JUMPL C,ACCFAI + POP P,B + SFPTR + JFCL + MOVE B,1(AB) ; CHANNEL BACK + MOVE C,[440700,,E] + ILDB 0,C + IDPB 0,BUFSTR(B) + SOS BUFSTR-1(B) + SOJG D,.-3 + JRST DONADV +] +IFN ITS, ERRUUO EQUOTE CANT-ACCESS-ASCII-ON-ITS + + +;WRONG TYPE OF DEVICE ERROR +WRDEV: ERRUUO EQUOTE NON-DSK-DEVICE + +; BINARY READ AND PRINT ROUTINES + +MFUNCTION PRINTB,SUBR + + ENTRY + +PBFL: PUSH P,. ; PUSH NON-ZERONESS + MOVEI A,-7 + JRST BINI1 + +MFUNCTION READB,SUBR + + ENTRY + + PUSH P,[0] + MOVEI A,-11 +BINI1: HLRZ 0,AB + CAILE 0,-3 + JRST TFA + CAIG 0,(A) + JRST TMA + + GETYP 0,(AB) ; SHOULD BE UVEC OR STORE + CAIE 0,TSTORAGE + CAIN 0,TUVEC + JRST BINI2 + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTOK + JRST WTYP1 ; ELSE LOSE +BINI2: MOVE B,1(AB) ; GET IT + HLRE C,B + SUBI B,(C) ; POINT TO DOPE + GETYP A,(B) + PUSHJ P,SAT" ; GET ITS ST.ALOC.TYPE + CAIE A,S1WORD + JRST WTYP1 +BYTOK: GETYP 0,2(AB) + CAIE 0,TCHAN ; BETTER BE A CHANNEL + JRST WTYP2 + MOVE B,3(AB) ; GET IT +; MOVEI B,DIRECT-1(B) ; GET DIRECTION OF +; PUSHJ P,CHRWRD ; INTO 1 WORD +; JFCL +; MOVNI E,1 +; CAMN B,[ASCII /READB/] +; MOVEI E,0 +; CAMN B,[+1] + HRRZ A,-2(B) ; MODE BITS + TRNN A,C.BIN ; IF NOT BINARY + JRST WRONGD + MOVEI E,0 + TRNE A,C.PRIN + MOVE E,PBFL +; JUMPL E,WRONGD ; LOSER + CAME E,(P) ; CHECK WINNGE + JRST WRONGD + MOVE B,3(AB) ; GET CHANNEL BACK + SKIPN A,IOINS(B) ; OPEN? + PUSHJ P,OPENIT ; LOSE + CAMN A,[JRST CHNCLS] + JRST CHNCLS ; LOSE, CLOSED + JUMPN E,BUFOU1 ; JUMP FOR OUTPUT + MOVEI C,0 + CAML AB,[-5,,] ; SKIP IF EOF GIVEN + JRST BINI5 + MOVE 0,4(AB) + MOVEM 0,EOFCND-1(B) + MOVE 0,5(AB) + MOVEM 0,EOFCND(B) + CAML AB,[-7,,] + JRST BINI5 + GETYP 0,6(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,7(AB) +BINI5: SKIPE LSTCH(B) ; INDICATES IF EOF HIT + JRST BINEOF + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTI + MOVE A,1(AB) ; GET VECTOR + PUSHJ P,PGBIOI ; READ IT + HLRE C,A ; GET COUNT DONE + HLRE D,1(AB) ; AND FULL COUNT + SUB C,D ; C=> TOTAL READ + ADDM C,ACCESS(B) + JUMPGE A,BINIOK ; NOT EOF YET + SETOM LSTCH(B) +BINIOK: MOVE B,C + MOVSI A,TFIX ; RETURN AMOUNT ACTUALLY READ + JRST FINIS + +BYTI: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-LOST + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-LOST + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE STRING LENGTH + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 + PUSH P,C + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SIN] + PUSHJ P,PGBIOT + HLRE C,A ; GET COUNT DONE + POP P,D + SKIPN D + HRRZ D,(AB) ; AND FULL COUNT + ADD D,C ; C=> TOTAL READ + LDB E,[300600,,1(AB)] + MOVEI A,36. + IDIVM A,E + IDIVM D,E + ADDM E,ACCESS(B) + SKIPGE C ; NOT EOF YET + SETOM LSTCH(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-LOST + MOVE C,D + JRST BINIOK +] +BUFOU1: SKIPE BUFSTR(B) ; ANY BUFFERS AROUND? + PUSHJ P,BFCLS1 ; GET RID OF SAME + MOVEI C,0 + CAML AB,[-5,,] + JRST BINO5 + GETYP 0,4(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,5(AB) +BINO5: MOVE A,1(AB) + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTO + PUSHJ P,PGBIOO + HLRE C,1(AB) + MOVNS C + ADDM C,ACCESS(B) +BYTO1: MOVE A,(AB) ; RET VECTOR ETC. + MOVE B,1(AB) + JRST FINIS + +BYTO: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-FAILURE + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-FAILURE + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE SIZE + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 ; COMPENSATE FOR PGBIOT DOING THE WRONG THING + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SOUT] + PUSHJ P,PGBIOT + LDB D,[300600,,1(AB)] + MOVEI C,36. + IDIVM C,D + HRRZ C,(AB) + IDIVI C,(D) + ADDM C,ACCESS(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-FAILURE + JRST BYTO1 +] + +BINEOF: PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOSER + MCALL 1,EVAL + JRST FINIS + +OPENIT: PUSH P,E + PUSHJ P,OPNCHN ;TRY TO OPEN THE LOSER + JUMPE B,CHNCLS ;FAIL + POP P,E + POPJ P, + ; THESE SUBROUTINES BY NDR 9/16/73 TO FACILITATE THE +; TYPES OF IO NECESSARY TO MAKE MORE EFFICIENT USE OF +; THE NETWORK AND DO RELATED FILE TRANSFER TYPE OF JOBS. + +R1CHAR: SKIPN A,LSTCH(B) ; CHAR READING ROUTINE FOR FCOPY + PUSHJ P,RXCT + TLO A,200000 ; ^@ BUG + MOVEM A,LSTCH(B) + TLZ A,200000 + JUMPL A,.+2 ; IN CASE OF -1 ON STY + TRZN A,400000 ; EXCL HACKER + JRST .+4 + MOVEM A,LSTCH(B) ; SAVE DE-EXCLED CHAR + MOVEI A,"! + JRST .+2 + SETZM LSTCH(B) + PUSH P,C + HRRZ C,DIRECT-1(B) + CAIE C,5 ; IF DIRECTION IS 5 LONG THEN READB + JRST R1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) ; EVERY FIFTY INCREMENT + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +R1CH1: AOS ACCESS(B) + POP P,C + POPJ P, + +W1CHAR: CAIE A,15 ; CHAR WRITING ROUTINE, TEST FOR CR + JRST .+3 + SETOM CHRPOS(B) + AOSA LINPOS(B) + CAIE A,12 ; TEST FOR LF + AOS CHRPOS(B) ; IF NOT LF AOS CHARACTE5R POSITION + CAIE A,14 ; TEST FOR FORM FEED + JRST .+3 + SETZM CHRPOS(B) ; IF FORM FEED ZERO CHARACTER POSITION + SETZM LINPOS(B) ; AND LINE POSITION + CAIE A,11 ; IS THIS A TAB? + JRST .+6 + MOVE C,CHRPOS(B) + ADDI C,7 + IDIVI C,8. + IMULI C,8. ; FIX UP CHAR POS FOR TAB + MOVEM C,CHRPOS(B) ; AND SAVE + PUSH P,C + HRRZ C,-2(B) ; GET BITS + TRNN C,C.BIN ; SIX LONG MUST BE PRINTB + JRST W1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +W1CH1: AOS ACCESS(B) + PUSH P,A + PUSHJ P,WXCT + POP P,A + POP P,C + POPJ P, + +R1C: SUBM M,(P) ;LITTLE ENTRY FOR COMPILED STUFF +; PUSH TP,$TCHAN ;SAVE THE CHANNEL TO BLESS IT +; PUSH TP,B +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JFCL +; CAME B,[ASCIZ /READ/] +; CAMN B,[ASCII /READB/] +; JRST .+2 +; JRST BADCHN + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.READ + JRST BADCHN + SKIPN IOINS(B) ; IS THE CHANNEL OPEN + PUSHJ P,OPENIT ; NO, GO DO IT + PUSHJ P,GRB ; MAKE SURE WE HAVE A READ BUFFER + PUSHJ P,R1CHAR ; AND GET HIM A CHARACTER + JRST MPOPJ ; THATS ALL FOLKS + +W1C: SUBM M,(P) + PUSHJ P,W1CI + JRST MPOPJ + +W1CI: +; PUSH TP,$TCHAN +; PUSH TP,B + PUSH P,A ; ASSEMBLER ENTRY TO OUTPUT 1 CHAR +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; INTERNAL CALL TO W1CHAR +; JFCL +; CAME B,[ASCII /PRINT/] +; CAMN B,[+1] +; JRST .+2 +; JRST BADCHN +; POP TP,B +; POP TP,(TP) + HRRZ A,-2(B) + TRNN A,C.PRIN + JRST BADCHN + SKIPN IOINS(B) ; MAKE SURE THAT IT IS OPEN + PUSHJ P,OPENIT + PUSHJ P,GWB + POP P,A ; GET THE CHAR TO DO + JRST W1CHAR + +; ROUTINES TO REPLACE XCT IOINS(B) FOR INPUT AND OUTPUT +; THEY DO THE XCT THEN CHECK OUT POSSIBLE SCRIPTAGE--BLECH. + + +WXCT: +RXCT: XCT IOINS(B) ; READ IT + SKIPN SCRPTO(B) + POPJ P, + +DOSCPT: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; AND SAVE THE CHAR AROUND + + SKIPN SCRPTO(B) ; IF ZERO FORGET IT + JRST SCPTDN ; THATS ALL THERE IS TO IT + PUSH P,C ; SAVE AN ACCUMULATOR FOR CLEANLINESS + GETYP C,SCRPTO-1(B) ; IS IT A LIST + CAIE C,TLIST + JRST BADCHN + PUSH TP,$TLIST + PUSH TP,[0] ; SAVE A SLOT FOR THE LIST + MOVE C,SCRPTO(B) ; GET THE LIST OF SCRIPT CHANNELS +SCPT1: GETYP B,(C) ; GET THE TYPE OF THIS SCRIPT CHAN + CAIE B,TCHAN + JRST BADCHN ; IF IT ISN'T A CHANNEL, COMPLAIN + HRRZ B,(C) ; GET THE REST OF THE LIST IN B + MOVEM B,(TP) ; AND STORE ON STACK + MOVE B,1(C) ; GET THE CHANNEL IN B + MOVE A,-1(P) ; AND THE CHARACTER IN A + PUSHJ P,W1CI ; GO TO INTERNAL W1C, IT BLESSES GOODIES + SKIPE C,(TP) ; GET THE REST OF LIST OF CHANS + JRST SCPT1 ; AND CYCLE THROUGH + SUB TP,[2,,2] ; CLEAN OFF THE LIST OF CHANS + POP P,C ; AND RESTORE ACCUMULATOR C +SCPTDN: POP P,A ; RESTORE THE CHARACTER + POP TP,B ; AND THE ORIGINAL CHANNEL + POP TP,(TP) + POPJ P, ; AND THATS ALL + + +; SUBROUTINE TO COPY FROM INCHAN TO OUTCHAN UNTIL EOF HIT +; ON THE INPUT CHANNEL +; CALL IS WHERE DEFAULTS ARE INCHAN AND OUTCHAN + + MFUNCTION FCOPY,SUBR,[FILECOPY] + + ENTRY + HLRE 0,AB + CAMGE 0,[-4] + JRST WNA ; TAKES FROM 0 TO 2 ARGS + + JUMPE 0,.+4 ; NO FIRST ARG? + PUSH TP,(AB) + PUSH TP,1(AB) ; SAVE IN CHAN + JRST .+6 + MOVE A,$TATOM + MOVE B,IMQUOTE INCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B + HLRE 0,AB ; CHECK FOR SECOND ARG + CAML 0,[-2] ; WAS THERE MORE THAN ONE ARG? + JRST .+4 + PUSH TP,2(AB) ; SAVE SECOND ARG + PUSH TP,3(AB) + JRST .+6 + MOVE A,$TATOM ; LOOK UP OUTCHAN AS DEFAULT + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B ; AND SAVE IT + + MOVE A,-3(TP) + MOVE B,-2(TP) ; INPUT CHANNEL + MOVEI 0,C.READ ; INDICATE INPUT + PUSHJ P,CHKCHN ; CHECK FOR GOOD CHANNEL + MOVE A,-1(TP) + MOVE B,(TP) ; GET OUT CHAN + MOVEI 0,C.PRIN ; INDICATE OUT CHAN + PUSHJ P,CHKCHN ; CHECK FOR GOOD OUT CHAN + + PUSH P,[0] ; COUNT OF CHARS OUTPUT + + MOVE B,-2(TP) + PUSHJ P,GRB ; MAKE SURE WE HAVE READ BUFF + MOVE B,(TP) + PUSHJ P,GWB ; MAKE SURE WE HAVE WRITE BUFF + +FCLOOP: INTGO + MOVE B,-2(TP) + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,FCDON ; IF A NEG NUMBER WE GOT EOF + MOVE B,(TP) ; GET OUT CHAN + PUSHJ P,W1CHAR ; SPIT IT OUT + AOS (P) ; INCREMENT COUNT + JRST FCLOOP + +FCDON: SUB TP,[2,,2] ; POP OFF OUTCHAN + MCALL 1,FCLOSE ; CLOSE INCHAN + MOVE A,$TFIX + POP P,B ; GET CHAR COUNT TO RETURN + JRST FINIS + +CHKCHN: PUSH P,0 ; CHECK FOR GOOD TASTING CHANNEL + PUSH TP,A + PUSH TP,B + GETYP C,A + CAIE C,TCHAN + JRST CHKBDC ; GO COMPLAIN IN RIGHT WAY +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JRST CHKBDC +; MOVE C,(P) ; GET CHAN DIRECT + HRRZ C,-2(B) ; MODE BITS + TDNN C,0 + JRST CHKBDC +; CAMN B,CHKT(C) +; JRST .+4 +; ADDI C,2 ; TEST FOR READB OR PRINTB ALSO +; CAME B,CHKT(C) ; TEST FOR CORRECT DIRECT +; JRST CHKBDC + MOVE B,(TP) + SKIPN IOINS(B) ; MAKE SURE IT IS OPEN + PUSHJ P,OPENIT ; IF ZERO IOINS GO OPEN IT + SUB TP,[2,,2] + POP P, ; CLEAN UP STACKS + POPJ P, + +CHKT: ASCIZ /READ/ + ASCII /PRINT/ + ASCII /READB/ + +1 + +CHKBDC: POP P,E + MOVNI D,2 + IMULI D,1(E) + HLRE 0,AB + CAMLE 0,D ; SEE IF THIS WAS HIS ARG OF DEFAULT + JRST BADCHN + JUMPE E,WTYP1 + JRST WTYP2 + + ; FUNCTIONS READSTRING AND PRINTSTRING WORK LIKE READB AND PRINTB, +; THAT IS THEY READ INTO AND OUT OF STRINGS. IN ADDITION BOTH ACCEPT +; AN ADDITIONAL ARGUMENT WHICH IS THE NUMBER OF CHARS TO READ OR PRINT, IF +; IT IS DESIRED FOR THIS TO BE DIFFERENT THAN THE LENGTH OF THE STRING. + +; FORMAT IS +; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN + +; FORMAT FOR PRINTSTRING IS + +; THESE WERE CODED 9/16/73 BY NEAL D. RYAN + + MFUNCTION RSTRNG,SUBR,READSTRING + + ENTRY + PUSH P,[0] ; FLAG TO INDICATE READING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-9] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 4 ARGS + JRST STRIO1 + + MFUNCTION PSTRNG,SUBR,PRINTSTRING + + ENTRY + PUSH P,[1] ; FLAG TO INDICATE WRITING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-7] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 3 ARGS + +STRIO1: PUSH TP,[0] ; SAVE SLOT ON STACK + PUSH TP,[0] + GETYP 0,(AB) + CAIE 0,TCHSTR ; MAKE SURE WE GOT STRING + JRST WTYP1 + HRRZ 0,(AB) ; CHECK FOR EMPTY STRING + SKIPN (P) + JUMPE 0,MTSTRN + HLRE 0,AB + CAML 0,[-2] ; WAS A CHANNEL GIVEN + JRST STRIO2 + GETYP 0,2(AB) + SKIPN (P) ; SKIP IF PRINT + JRST TESTIN + CAIN 0,TTP ; SEE IF FLATSIZE HACK + JRST STRIO9 +TESTIN: CAIE 0,TCHAN + JRST WTYP2 ; SECOND ARG NOT CHANNEL + MOVE B,3(AB) + HRRZ B,-2(B) + MOVNI E,1 ; CHECKING FOR GOOD DIRECTION + TRNE B,C.READ ; SKIP IF NOT READ + MOVEI E,0 + TRNE B,C.PRIN ; SKIP IF NOT PRINT + MOVEI E,1 + CAME E,(P) + JRST WRONGD ; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE +STRIO9: PUSH TP,2(AB) + PUSH TP,3(AB) ; PUSH ON CHANNEL + JRST STRIO3 +STRIO2: MOVE B,IMQUOTE INCHAN + MOVSI A,TCHAN + SKIPE (P) + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + GETYP 0,A + SKIPN (P) ; SKIP IF PRINTSTRING + JRST TESTI2 + CAIN 0,TTP ; SKIP IF NOT FLATSIZE HACK + JRST STRIO8 +TESTI2: CAIE 0,TCHAN + JRST BADCHN ; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL +STRIO8: PUSH TP,A + PUSH TP,B +STRIO3: MOVE B,(TP) ; GET CHANNEL + SKIPN E,IOINS(B) + PUSHJ P,OPENIT ; IF NOT GO OPEN + MOVE E,IOINS(B) + CAMN E,[JRST CHNCLS] + JRST CHNCLS ; CHECK TO SEE THAT CHANNEL ISNT ALREADY CLOSED +STRIO4: HLRE 0,AB + CAML 0,[-4] + JRST STRIO5 ; NO COUNT TO WORRY ABOUT + GETYP 0,4(AB) + MOVE E,4(AB) + MOVE C,5(AB) + CAIE 0,TCHSTR + CAIN 0,TFIX ; BETTER BE A FIXED NUMBER + JRST .+2 + JRST WTYP3 + HRRZ D,(AB) ; GET ACTUAL STRING LENGTH + CAIN 0,TFIX + JRST .+7 + SKIPE (P) ; TEST FOR WRITING + JRST .-7 ; IF WRITING WE GOT TROUBLE + PUSH P,D ; ACTUAL STRING LENGTH + MOVEM E,(TB) ; STUFF HIS FUNNY DELIM STRING + MOVEM C,1(TB) + JRST STRIO7 + CAML D,C ; MAKE SURE THE STRING IS LONG ENOUGH + JRST .+2 ; WIN + ERRUUO EQUOTE COUNT-GREATER-THAN-STRING-SIZE + PUSH P,C ; PUSH ON MAX COUNT + JRST STRIO7 +STRIO5: +STRIO6: HRRZ C,(AB) ; GET CHAR COUNT + PUSH P,C ; AND PUSH IT ON STACK AS NO MAX COUNT GIVEN +STRIO7: HLRE 0,AB + CAML 0,[-6] + JRST .+6 + MOVE B,(TP) ; GET THE CHANNEL + MOVE 0,6(AB) + MOVEM 0,EOFCND-1(B) ; STUFF IN SLOT IN CHAN + MOVE 0,7(AB) + MOVEM 0,EOFCND(B) + PUSH TP,(AB) ; PUSH ON STRING + PUSH TP,1(AB) + PUSH P,[0] ; PUSH ON CURRENT COUNT OF CHARS DONE + MOVE 0,-2(P) ; GET READ OR WRITE FLAG + JUMPN 0,OUTLOP ; GO WRITE STUFF + + MOVE B,-2(TP) ; GET CHANNEL + PUSHJ P,GRB ; MAKE SURE WE HAVE BUFF + SKIPGE A,LSTCH(B) ; CHECK FOR EOF ALREADY READ PREVIOUSLY + JRST SRDOEF ; GO DOES HIS EOF HACKING +INLOP: INTGO + MOVE B,-2(TP) ; GET CHANNEL + MOVE C,-1(P) ; MAX COUNT + CAMG C,(P) ; COMPARE WITH COUNT DONE + JRST STREOF ; WE HAVE FINISHED + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,INEOF ; EOF HIT + MOVE C,1(TB) + HRRZ E,(TB) ; DO WE HAVE A STRING TO WORRY US? + SOJL E,INLNT ; GO FINISH STUFFING + ILDB D,C + CAME D,A + JRST .-3 + JRST INEOF +INLNT: IDPB A,(TP) ; STUFF IN STRING + SOS -1(TP) ; DECREMENT STRING COUNT + AOS (P) ; INCREMENT CHAR COUNT + JRST INLOP + +INEOF: SKIPE C,LSTCH(B) ; IS THIS AN ! AND IS THERE A CHAR THERE + JRST .+3 ; YES + MOVEM A,LSTCH(B) ; NO SAVE THE CHAR + JRST .+3 + ADDI C,400000 + MOVEM C,LSTCH(B) + MOVSI C,200000 + IORM C,LSTCH(B) + HRRZ C,DIRECT-1(B) ; GET THE TYPE OF CHAN + CAIN C,5 ; IS IT READB? + JRST .+3 + SOS ACCESS(B) ; FIX UP ACCESS FOR READ CHANNEL + JRST STREOF ; AND THATS IT + HRRZ C,ACCESS-1(B) ; FOR A READB ITS WORSE + MOVEI D,5 + SKIPG C + HRRM D,ACCESS-1(B) ; CHANGE A 0 TO A FIVE + SOS C,ACCESS-1(B) + CAMN C,[TFIX,,0] + SOS ACCESS(B) ; AND SOS THE WORD COUNT MAYBE + JRST STREOF + +SRDOEF: SETZM LSTCH(B) ; IN CASE OF -1, FLUSH IT + AOJE A,INLOP ; SKIP OVER -1 ON PTY'S + SUB TP,[6,,6] + SUB P,[3,,3] ; POP JUNK OFF STACKS + PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) ; WHAT WE NEED TO EVAL + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOOSING CHANNEL + MCALL 1,EVAL ; EVAL HIS EOF JUNK + JRST FINIS + +OUTLOP: MOVE B,-2(TP) +OUTLP1: INTGO + MOVE A,-3(TP) ; GET CHANNEL + MOVE B,-2(TP) + MOVE C,-1(P) ; MAX COUNT TO DO + CAMG C,(P) ; HAVE WE DONE ENOUGH + JRST STREOF + ILDB D,(TP) ; GET THE CHAR + SOS -1(TP) ; SUBTRACT FROM STRING LENGTH + AOS (P) ; INC COUNT OF CHARS DONE + PUSHJ P,CPCH1 ; GO STUFF CHAR + JRST OUTLP1 + +STREOF: MOVE A,$TFIX + POP P,B ; RETURN THE LOOSER A COUNT OF WHAT WAS DONE + SUB P,[2,,2] + SUB TP,[6,,6] + JRST FINIS + + +GWB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A WRITE BUFFER ON PRINTB CHAN + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVSI A,TWORD+.VECT. + MOVEM A,BUFLNT(B) + SETOM (B) + MOVEI C,1(B) + HRLI C,(B) + BLT C,BUFLNT-1(B) + MOVEI C,-1(B) + HRLI C,010700 + MOVE B,(TP) + MOVEI 0,C.BUF + IORM 0,-2(B) + MOVEM C,BUFSTR(B) + MOVE C,[TCHSTR,,BUFLNT*5] + MOVEM C,BUFSTR-1(B) + SUB TP,[2,,2] + POPJ P, + + +GRB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A READ BUFFER + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVEI C,BUFLNT-1(B) + POP TP,B + MOVEI 0,C.BUF + IORM 0,-2(B) + HRLI C,010700 + MOVEM C,BUFSTR(B) + MOVSI C,TCHSTR + MOVEM C,BUFSTR-1(B) + SUB TP,[1,,1] + POPJ P, + +MTSTRN: ERRUUO EQUOTE EMPTY-STRING + + ; INPUT UNBUFFERING ROUTINE. THIS DOES THE CHARACTER UNBUFFERING +; FOR INPUT. THE OPEN ROUTINE SETUPS A PUSHJ P, TO +; THIS ROUTINE AS THE IOINS FOR A CHANNEL OPEN TO A NON-TTY DEVICE. + +; H. BRODIE 7/19/72 + +; CALLING SEQ: +; PUSHJ P,GETCHR +; B/ AOBJN PNTR TO CHANNEL VECTOR +; RETURNS NEXT CHARACTER IN AC A. +; ON ENCOUNTERING EITHER ^C OR NUL(^@) IT ASSUMES EOF AND +; TRANSMITS ONLY ^C ON SUCCESSIVE CALLS + + +GETCHR: +; FIRST GRAB THE BUFFER +; GETYP A,BUFSTR-1(B) ; GET TYPE WORD +; CAIN A,TCHSTR ; SKIPS IF NOT CHSTR (I.E. IF BAD BUFFER) +; JRST GTGBUF ; IS GOOD BUFFER...SKIP ERROR RETURN +GTGBUF: HRRZ A,BUFSTR-1(B) ; GET LENGTH OF STRING + SOJGE A,GTGCHR ; JUMP IF STILL MORE + +; HERE IF THE BUFFER WAS EXHAUSTED (BYTE PNTR POINTS INTO DOPE WDS) +; GENERATE AN .IOT POINTER +;FIRST SAVE C AND D AS I WILL CLOBBER THEM +NEWBUF: PUSH P,C + PUSH P,D +IFN ITS,[ + LDB C,[600,,STATUS(B)] ; GET TYPE + CAIG C,2 ; SKIP IF NOT TTY +] +IFE ITS,[ + SKIPE BUFRIN(B) +] + JRST GETTTY ; GET A TTY BUFFER + + PUSHJ P,PGBUFI ; RE-FILL BUFFER + +IFE ITS, MOVEI C,-1 + JUMPGE A,BUFGOO ;SKIPS IF IOT COMPLETED...FIX UP CHANNEL + MOVEI C,1 ; MAKE SURE LAST EOF REALLY ENDS IT + ANDCAM C,-1(A) + MOVSI C,014000 ; GET A ^C + MOVEM C,(A) ;FAKE AN EOF + +IFE ITS,[ + HLRE C,A ; HOW MUCH LEFT + ADDI C,BUFLNT ; # OF WORDS TO C + IMULI C,5 ; TO CHARS + MOVE A,-2(B) ; GET BITS + TRNE A,C.BIN ; CAN'T HELP A BINARY CHANNEL + JRST BUFGOO + MOVE A,CHANNO(B) + PUSH P,B + PUSH P,D + PUSH P,C + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + MOVE B,[2,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + POP P,C + CAIE D,7 ; SEVEN BIT BYTES? + JRST BUFGO1 ; NO, DONT HACK + MOVE D,C + IDIVI B,5 ; C IS NUMBER IN LAST WORD IF NOT EVEN + SKIPN C + MOVEI C,5 + ADDI C,-5(D) ; FIXUP C FOR WINNAGE +BUFGO1: POP P,D + POP P,B +] +; RESET THE BYTE POINTER IN THE CHANNEL. +; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D +BUFGOO: HRLI D,010700 ; GENERATE VIRGIN LH + SUBI D,1 + + MOVEM D,BUFSTR(B) ; STASH IN THE BUFFER BYTE PNTR SLOT +IFE ITS, HRRM C,LSTCH-1(B) ; SAVE IT + MOVEI A,BUFLNT*5-1 +BUFROK: POP P,D ;RESTORE D + POP P,C ;RESTORE C + + +; HERE IF THERE ARE CHARS IN BUFFER +GTGCHR: HRRM A,BUFSTR-1(B) + ILDB A,BUFSTR(B) ; GET A CHAR FROM BUFFER + +IFN ITS,[ + CAIE A,3 ; EOF? + POPJ P, ; AND RETURN + LDB A,[600,,STATUS(B)] ; CHECK FOR TTY + CAILE A,2 ; SKIP IF TTY +] +IFE ITS,[ + PUSH P,0 + HRRZ 0,LSTCH-1(B) + SOJL 0,.+4 + HRRM 0,LSTCH-1(B) + POP P,0 + POPJ P, + + POP P,0 + MOVSI A,-1 + SKIPN BUFRIN(B) +] + JRST .+3 +RETEO1: HRRI A,3 + POPJ P, + + HRRZ A,BUFSTR(B) ; SEE IF RSUBR START BIT IS ON + HRRZ A,(A) + TRNN A,1 + MOVSI A,-1 + JRST RETEO1 + +IFN ITS,[ +PGBUFO: +PGBUFI: +] +IFE ITS,[ +PGBUFO: SKIPA D,[SOUT] +PGBUFI: MOVE D,[SIN] +] + SKIPGE A,BUFSTR(B) ; POINT TO CURRENT BUFFER POSIT + SUBI A,1 ; FOR 440700 AND 010700 START + SUBI A,BUFLNT-1 ; CALCULATE PNTR TO BEG OF BUFFER + HRLI A,-BUFLNT ; IOT (AOBJN) PNTR IN A + MOVSI C,004400 +IFN ITS,[ +PGBIOO: +PGBIOI: MOVE D,A ; COPY FOR LATER + MOVSI C,TUVEC ; PREPARE TO HANDDLE INTS + MOVE PVP,PVSTOR+1 + MOVEM C,DSTO(PVP) + MOVEM C,ASTO(PVP) + MOVSI C,TCHAN + MOVEM C,BSTO(PVP) + +; BUILD .IOT INSTR + MOVE C,CHANNO(B) ; CHANNEL NUMBER IN C + ROT C,23. ; MOVE INTO AC FIELD + IOR C,[.IOT 0,A] ; IOR IN SKELETON .IOT + +; DO THE .IOT + ENABLE ; ALLOW INTS + XCT C ; EXECUTE THE .IOT INSTR + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM ASTO(PVP) + SETZM DSTO(PVP) + POPJ P, +] + +IFE ITS,[ +PGBIOT: PUSH P,D + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,C + HRRZS (P) + HRRI C,-1(A) ; POINT TO BUFFER + HLRE D,A ; XTRA POINTER + MOVNS D + HRLI D,TCHSTR + MOVE PVP,PVSTOR+1 + MOVEM D,BSTO(PVP) + MOVE D,[PUSHJ P,FIXACS] + MOVEM D,ONINT + MOVSI D,TUVEC + MOVEM D,DSTO(PVP) + MOVE D,A + MOVE A,CHANNO(B) ; FILE JFN + MOVE B,C + HLRE C,D ; - COUNT TO C + SKIPE (P) + MOVN C,(P) ; REAL DESIRED COUNT + SUB P,[1,,1] + ENABLE + XCT (P) ; DO IT TO IT + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM DSTO(PVP) + SETZM ONINT + MOVEI A,1(B) + MOVE B,(TP) + SUB TP,[2,,2] + SUB P,[1,,1] + JUMPGE C,CPOPJ ; NO EOF YET + HRLI A,(C) ; LOOK LIKE AN AOBJN PNTR + POPJ P, + +FIXACS: PUSH P,PVP + MOVE PVP,PVSTOR+1 + MOVNS C + HRRM C,BSTO(PVP) + MOVNS C + POP P,PVP + POPJ P, + +PGBIOO: SKIPA D,[SOUT] +PGBIOI: MOVE D,[SIN] + HRLI C,004400 + JRST PGBIOT +DOIOTO: PUSH P,[SOUT] +DOIOTC: PUSH P,B + PUSH P,C + EXCH A,B + MOVE A,CHANNO(A) + HLRE C,B + HRLI B,444400 + XCT -2(P) + HRL B,C + MOVE A,B +DOIOTE: POP P,C + POP P,B + SUB P,[1,,1] + POPJ P, +DOIOTI: PUSH P,[SIN] + JRST DOIOTC +] + +; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE + +PUTCHR: PUSH P,A + GETYP A,BUFSTR-1(B) ; CHECK TYPE OF ARG + CAIE A,TCHSTR ; MUST BE STRING + JRST BDCHAN + + HRRZ A,BUFSTR-1(B) ; GET CHAR COUNT + JUMPE A,REBUFF ; PREV RESET BUFF, UNDO SAME + +PUTCH1: POP P,A ; RESTORE CHAR + CAMN A,[-1] ; SPECIAL HACK? + JRST PUTCH2 ; YES GO HANDLE + IDPB A,BUFSTR(B) ; STUFF IT +PUTCH3: SOS A,BUFSTR-1(B) ; COUNT DOWN STRING + TRNE A,-1 ; SKIP IF FULL + POPJ P, + +; HERE TO FLUSH OUT A BUFFER + + PUSH P,C + PUSH P,D + PUSHJ P,PGBUFO ; SETUP AND DO IOT + HRLI D,010700 ; POINT INTO BUFFER + SUBI D,1 + MOVEM D,BUFSTR(B) ; STORE IT + MOVEI A,BUFLNT*5 ; RESET COUNT + HRRM A,BUFSTR-1(B) + POP P,D + POP P,C + POPJ P, + +;HERE TO DA ^C AND TURN ON MAGIC BIT + +PUTCH2: MOVEI A,3 + IDPB A,BUFSTR(B) ; ZAP OUT THE ^C + MOVEI A,1 ; GET BIT +IFE ITS,[ + PUSH P,C + HRRZ C,BUFSTR(B) + IORM A,(C) + POP P,C +] +IFN ITS,[ + IORM A,@BUFSTR(B) ; ON GOES THE BIT +] + JRST PUTCH3 + +; RESET A FUNNY BUF + +REBUFF: MOVEI A,BUFLNT*5 ; 1ST COUNT + HRRM A,BUFSTR-1(B) + HRRZ A,BUFSTR(B) ; NOW POINTER + SUBI A,BUFLNT+1 + HRLI A,010700 + MOVEM A,BUFSTR(B) ; STORE BACK + JRST PUTCH1 + + +; HERE TO FLUSH FINAL BUFFER + +BFCLOS: HRRZ C,-2(B) ; THIS BUFFER FLUSHER THE WORK OF NDR + MOVEI A,0 + TRNE C,C.TTY + POPJ P, + TRNE C,C.DISK + MOVEI A,1 + PUSH P,A ; SAVE THE RESULT OF OUR TEST + JUMPN A,BFCLNN ; DONT HAVE TO CHECK NET STATE + PUSH TP,$TCHAN + PUSH TP,B ; SAVE CHANNEL + PUSHJ P,INSTAT ; GET CURRENT NETWORK STATE + MOVE A,(B) ; GET FIRST ELEMENT OF STATE UVECTOR WHICH IS CUR STATE + POP TP,B ; RESTORE B + POP TP, + CAIE A,5 ; IS NET IN OPEN STATE? + CAIN A,6 ; OR ELSE IS IT IN RFNM WAIT STATE + JRST BFCLNN ; IF SO TO THE IOT + POP P, ; ELSE FLUSH CRUFT AND DONT IOT + POPJ P, ; RETURN DOING NO IOT +BFCLNN: MOVEI C,BUFLNT*5 ; NEW BUFFER FLUSHER BY NDR + HRRZ D,BUFSTR-1(B) ; SO THAT NET ALSO WORKS RIGHT + SUBI C,(D) ; GET NUMBER OF CHARS + IDIVI C,5 ; NUMBER OF FULL WORDS AND REST + PUSH P,D ; SAVE NUMBER OF ODD CHARS + SKIPGE A,BUFSTR(B) ; GET CURRENT BUF POSITION + SUBI A,1 ; FIX FOR 440700 BYTE POINTER +IFE ITS,[ + HRRO D,A + PUSH P,(D) +] +IFN ITS,[ + PUSH P,(A) ; SAVE THE ODD WORD OF BUFFER +] + MOVEI D,BUFLNT + SUBI D,(C) + SKIPE -1(P) + SUBI A,1 + ADDI D,1(A) ; FIX UP FOR POSSIBLE ODD CHARS + PUSH TP,$TUVEC + PUSH TP,D ; PUSH THE DOPE VECTOR ONTO THE STACK + JUMPE C,BFCLSR ; IN CASE THERE ARE NO FULL WORDS TO DO + HRL A,C + TLO A,400000 + MOVE E,[SETZ BUFLNT(A)] + SUBI E,(C) ; FIX UP FOR BACKWARDS BLT + POP A,@E ; AMAZING GRACE + TLNE A,377777 + JRST .-2 + HRRO A,D ; SET UP AOBJN POINTER + SUBI A,(C) + TLC A,-1(C) + PUSHJ P,PGBIOO ; DO THE IOT OF ALL THE FULL WORDS +BFCLSR: HRRO A,(TP) ; GET IOT PTR FOR REST OF JUNK + SUBI A,1 ; POINT TO WORD BEFORE DOPE WORDS + POP P,0 ; GET BACK ODD WORD + POP P,C ; GET BACK ODD CHAR COUNT + POP P,D ; FLAG FOR NET OR DSK + JUMPN D,BFCDSK ; GO FINISH OFF DSK + JUMPE C,BFCLSD ; IF NO ODD CHARS FINISH UP + MOVEI D,7 + IMULI D,(C) ; FIND NO OF BITS TO SHIFT + LSH 0,-43(D) ; SHIFT BITS TO RIGHT PLACE + MOVEM 0,(A) ; STORE IN STRING + SUBI C,5 ; HOW MANY CHAR POSITIONS TO SKIP + MOVNI C,(C) ; MAKE C POSITIVE + LSH C,17 + TLC A,(C) ; MUNG THE AOBJN POINTER TO KLUDGE + PUSHJ P,PGBIOO ; DO IOT OF ODD CHARS + MOVEI C,0 +BFCLSD: HRRZ A,(TP) ; GET PTR TO DOPE WORD + SUBI A,BUFLNT+1 + JUMPLE C,.+3 + SKIPE ACCESS(B) + MOVEM 0,1(A) ; LAST WORD BACK IN BFR + HRLI A,010700 ; AOBJN POINTER TO FIRST OF BUFFER + MOVEM A,BUFSTR(B) + MOVEI A,BUFLNT*5 + HRRM A,BUFSTR-1(B) + SKIPN ACCESS(B) + JRST BFCLSY + JUMPL C,BFCLSY + JUMPE C,BFCLSZ + IBP BUFSTR(B) + SOS BUFSTR-1(B) + SOJG C,.-2 +BFCLSY: MOVE A,CHANNO(B) + MOVE C,B +IFE ITS,[ + RFPTR + FATAL RFPTR FAILED + HRRZ F,LSTCH-1(C) ; PREVIOUS HIGH + MOVE G,C ; SAVE CHANNEL + MOVE C,B + CAML F,B + MOVE C,F + MOVE F,B + HRLI A,400000 + CLOSF + JFCL + MOVNI B,1 + HRLI A,12 + CHFDB + MOVE B,STATUS(G) + ANDI A,-1 + OPENF + FATAL OPENF LOSES + MOVE C,F + IDIVI C,5 + MOVE B,C + SFPTR + FATAL SFPTR FAILED + MOVE B,G +] +IFN ITS,[ + DOTCAL RFPNTR,[A,[2000,,B]] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + SUBI B,1 + DOTCAL ACCESS,[A,B] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + MOVE B,C +] +BFCLSZ: SUB TP,[2,,2] + POPJ P, + +BFCDSK: TRZ 0,1 + PUSH P,C +IFE ITS,[ + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,0 ; WORD OF CHARS + MOVE A,CHANNO(B) + MOVEI B,7 ; MAKE BYTE SIZE 7 + SFBSZ + JFCL + HRROI B,(P) + MOVNS C + SKIPE C + SOUT + MOVE B,(TP) + SUB P,[1,,1] + SUB TP,[2,,2] +] +IFN ITS,[ + MOVE D,[440700,,A] + DOTCAL SIOT,[CHANNO(B),D,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + POP P,C + JUMPN C,BFCLSD +BFCDS1: MOVNI C,1 ; INDICATE NOT TOHACK BUFFER + JRST BFCLSD + +BFCLS1: HRRZ C,DIRECT-1(B) + MOVSI 0,(JFCL) + CAIE C,6 + MOVE 0,[AOS ACCESS(B)] + PUSH P,0 + HRRZ C,BUFSTR-1(B) + IDIVI C,5 + JUMPE D,BCLS11 + MOVEI A,40 ; PAD WITH SPACES + PUSHJ P,PUTCHR + XCT (P) ; AOS ACCESS IF NECESSARY + SOJG D,.-3 ; TO END OF WORD +BCLS11: POP P,0 + HLLZS ACCESS-1(B) + HRRZ C,BUFSTR-1(B) + CAIE C,BUFLNT*5 + PUSHJ P,BFCLOS + POPJ P, + + +; HERE TO GET A TTY BUFFER + +GETTTY: SKIPN C,EXBUFR(B) ; SKIP IF BUFFERS BACKED UP + JRST TTYWAI + HRRZ D,(C) ; CDR THE LIST + GETYP A,(C) ; CHECK TYPE + CAIE A,TDEFER ; MUST BE DEFERRED + JRST BDCHAN + MOVE C,1(C) ; GET DEFERRED GOODIE + GETYP A,(C) ; BETTER BE CHSTR + CAIE A,TCHSTR + JRST BDCHAN + MOVE A,(C) ; GET FULL TYPE WORD + MOVE C,1(C) + MOVEM D,EXBUFR(B) ; STORE CDR'D LIST + MOVEM A,BUFSTR-1(B) ; MAKE CURRENT BUFFER + MOVEM C,BUFSTR(B) + HRRM A,LSTCH-1(B) + SOJA A,BUFROK + +TTYWAI: PUSHJ P,TTYBLK ; BLOCKED FOR TTY I/O + JRST GETTTY ; SHOULD ONLY RETURN HAPPILY + + ;INTERNAL DEVICE READ ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT, +;CHECKS THAT THE RETURNED VALUE IS OF TYPE CHARACTER, +;AND RETURNS THAT AS THE NEXT CHARACTER IN THE "FILE" + +;H. BRODIE 8/31/72 + +GTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,INTFCN-1(B) + PUSH TP,INTFCN(B) + MCALL 1,APPLY + GETYP A,A + CAIE A,TCHRS + JRST BADRET + MOVE A,B +INTRET: POP P,0 ;RESTORE THE ACS + POP P,E + POP P,D + POP P,C + POP TP,B ;RESTORE THE CHANNEL + SUB TP,[1,,1] ;FLUSH $TCHAN...WE DON'T NEED IT + POPJ P, + + +BADRET: ERRUUO EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT + +;INTERNAL DEVICE PRINT ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,(FUNCTION, SUBR, OR RSUBR) +;TO THE CURRENT CHARACTER BEING "PRINTED". + +PTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,INTFCN-1(B) ;PUSH TYPE OF GIVEN OBJ + PUSH TP,INTFCN(B) ;PUSH THE SUPPLIED FUNCTION (OR SUBR ETC.) + PUSH TP,$TCHRS ;PUSH THE TYPE "CHARACTER" + PUSH TP,A ;PUSH THE CHAR + MCALL 2,APPLY ;APPLY THE FUNCTION TO THE CHAR + JRST INTRET + + + +; ROUTINE TO FLUSH OUT A PRINT BUFFER + +MFUNCTION BUFOUT,SUBR + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + + MOVE B,1(AB) +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; GET DIR NAME +; JFCL +; CAMN B,[ASCII /PRINT/] +; JRST .+3 +; CAME B,[+1] +; JRST WRONGD +; TRNE B,1 ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN B,1 ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] + HRRZ 0,-2(B) + TRNN 0,C.PRIN + JRST WRONGD +; TRNE 0,C.BIN ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN 0,C.BIN ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] +; MOVE B,1(AB) +; GETYP 0,BUFSTR-1(B) +; CAIN 0,TCHSTR +; SKIPN A,BUFSTR(B) ; BYTE POINTER? +; JRST BFIN1 +; HRRZ C,BUFSTR-1(B) ; CHARS LEFT +; IDIVI C,5 ; MULTIPLE OF 5? +; JUMPE D,BFIN2 ; YUP NO EXTRAS + +; MOVEI A,40 ; PAD WITH SPACES +; PUSHJ P,PUTCHR ; OUT IT GOES +; XCT (P) ; MAYBE BUMP ACCESS +; SOJG D,.-3 ; FILL + +BFIN2: PUSHJ P,BFCLOS ; WRITE OUT BUFFER + +BFIN1: MOVSI A,TCHAN + JRST FINIS + + + +; FUNCTION TO GET THE FILE LENGTH OF A READ CHANNEL + +MFUNCTION FILLNT,SUBR,[FILE-LENGTH] + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) + PUSHJ P,CFILLE + JRST FINIS + +CFILLE: +IFN 0,[ + MOVEI B,DIRECT-1(B) ; GET CHANNEL TYPE + PUSHJ P,CHRWRD + JFCL + CAME B,[ASCIZ /READ/] + JRST .+3 + PUSH P,[5] ; MULTIPLICATIVE FACTOR FOR READ + JRST .+4 + CAME B,[ASCII /READB/] + JRST WRONGD + PUSH P,[1] ; MULTIPLICATIVE FACTOR FOR READ +] + MOVE C,-2(B) ; GET BITS + MOVEI D,5 ; ASSUME ASCII + TRNE C,C.BIN ; SKIP IF NOT BINARY + MOVEI D,1 + PUSH P,D + MOVE C,B +IFN ITS,[ + .CALL FILL1 + JRST FILLOS ; GIVE HIM A NICE FALSE +] +IFE ITS,[ + MOVE A,CHANNO(C) + PUSH P,[0] + MOVEI C,(P) + MOVE B,[1,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,(P)] ; GET BYTE SIZE + JUMPN D,.+2 + MOVEI D,36. ; HANDLE "0" BYTE SIZE + SUB P,[1,,1] + SIZEF + JRST FILLOS +] + POP P,C +IFN ITS, IMUL B,C +IFE ITS,[ + CAIN C,5 + CAIE D,7 + JRST NOTASC +] +YESASC: MOVE A,$TFIX + POPJ P, + +IFE ITS,[ +NOTASC: MOVEI 0,36. + IDIV 0,D ; BYTES PER WORD + IDIVM B,0 + IMUL C,0 + MOVE B,C + JRST YESASC +] + +IFN ITS,[ +FILL1: SETZ ; BLOCK FOR .CALL TO FILLEN + SIXBIT /FILLEN/ + CHANNO (C) + SETZM B + +FILLOS: MOVE A,CHANNO(C) + MOVE B,[.STATUS A] ;MAKE A CALL TO STATUS TO FIND REASON + LSH A,23. ;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE + IOR B,A ;FIX UP .STATUS + XCT B + MOVE B,C + PUSHJ P,GFALS + POP P, + POPJ P, +] +IFE ITS,[ +FILLOS: MOVE B,C + PUSHJ P,TGFALS + POP P, + POPJ P, +] + + + ; MCHAN LOW-LEVEL I/O GARBAGE (PDL)-ORIGINAL (LIM)-ADDITIONS + +;CALLING ROUTINE: AC-A contains pointer to block of SIXBIT data +; DIR ? DEV ? FNM1 ? FNM2 ? SNM +;RETURNED VALUE : AC-A = +IFN ITS,[ +MOPEN: PUSH P,B + PUSH P,C + MOVE C,FRSTCH ; skip gc and tty channels +CNLP: DOTCAL STATUS,[C,[2000,,B]] + .LOSE %LSFIL + ANDI B,77 + JUMPE B,CHNFND ; found unused channel ? + ADDI C,1 ; try another channel + CAIG C,17 ; are all the channels used ? + JRST CNLP + SETO C, ; all channels used so C = -1 + JRST CHNFUL +CHNFND: MOVEI B,(C) + HLL B,(A) ; M.DIR slot + DOTCAL OPEN,[B,1(A),2(A),3(A),4(A)] + SKIPA + AOS -2(P) ; successful skip when returning +CHNFUL: MOVE A,C + POP P,C + POP P,B + POPJ P, + +MIOT: DOTCAL IOT,[A,B] + JFCL + POPJ P, + +MCLOSE: DOTCAL CLOSE,[A] + JFCL + POPJ P, + +IMPURE + +FRSTCH: 1 + +PURE +] + ;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O + +NOTNET: +BADCHN: ERRUUO EQUOTE BAD-CHANNEL +BDCHAN: ERRUUO EQUOTE BAD-INPUT-BUFFER + +WRONGD: ERRUUO EQUOTE WRONG-DIRECTION-CHANNEL + +CHNCLS: ERRUUO EQUOTE CHANNEL-CLOSED + +BAD6: ERRUUO EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME + +DISLOS: MOVE C,$TCHSTR + MOVE D,CHQUOTE [DISPLAY NOT AVAILABLE] + PUSHJ P,INCONS + MOVSI A,TFALSE + JRST OPNRET + +NOCHAN: ERRUUO EQUOTE ITS-CHANNELS-EXHAUSTED + +MODE1: 232020,,202020 +MODE2: 232023,,330320 + +END + + \ No newline at end of file diff --git a//fopen.mid.58 b//fopen.mid.58 new file mode 100644 index 0000000..302ae73 --- /dev/null +++ b//fopen.mid.58 @@ -0,0 +1,4703 @@ +TITLE OPEN - CHANNEL OPENER FOR MUDDLE + +RELOCATABLE + +;C. REEVE MARCH 1973 + +.INSRT MUDDLE > + +SYSQ + +FNAMS==1 +F==E+1 +G==F+1 + +IFE ITS,[ +IF1, .INSRT STENEX > +] +;THIS PROGRAM HAS ENTRIES: FOPEN, FCLOSE, RENAME, READB, PRINTB, FILECOPY, READSTRING, +; PRINTSTRING, NETSTATE, NETACC, NETS, ACCESS, AND FILE-EXISTS? + +;THESE SUBROUTINES HANDLE I/O STREAMS FOR THE MUDDLE SYSTEM. + +; FOPEN - OPENS A FILE FOR EITHER READING OR WRITING. IT TAKES +; FIVE OPTINAL ARGUMENTS AS FOLLOWS: + +; FOPEN (,,,,) +; +; - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ + +; - FIRST FILE NAME. DEFAULT INPUT OR OUTPUT. + +; - SECOND FILE NAME. DEFAULT MUDDLE. + +; - DEVICE FROM WHICH TO OPEN. DEFAULT IS DSK. + +; - SYSTEM (DIRECTORY) NAME. DEFAULT UNAME. + +; FOPEN RETURNS AN OBJECT OF TYPE CHANNEL IF IT SUCCEEDS OTHERWISE NIL + + +; FCLOSE - CLOSES A FILE. TAKES A CHANNEL OBJECT AS ITS ARGUMENT. IT ALSO TAKES +; ACCESS - DOES A .ACCESS ON A CHARACTER BASIS FOR CHARACTER FILES + + +; A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION + +; CHANNO ;ITS I/O CHANNEL NUMBER. 0 MEANS NOT A REAL CHANNEL. +; DIRECT ;DIRECTION (EITHER READ OR PRINT) +; NAME1 ;FIRST NAME OF FILE AS OPENED. +; NAME2 ;SECOND NAME OF FILE +; DEVICE ;DEVICE UPON WHICH THE CHANNEL IS OPEN +; SNAME ;DIRECTORY NAME +; RNAME1 ;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS) +; RNAME2 ;REAL SECOND NAME +; RDEVIC ;REAL DEVICE +; RSNAME ;SYSTEM OR DIRECTORY NAME +; STATUS ;VARIOUS STATUS BITS +; IOINS ;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER +; ACCESS ;ACCESS POINTER FOR RAND ACCESS (OR USED FOR DISPLAY INFO) +; RADX ;RADIX FOR CHANNELS NUMBER CONVERSION + +; *** THE FOLLOWING FIELDS FOR OUTPUT ONLY *** +; LINLN ;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE +; CHRPOS ;CURRENT POSITION ON CURRENT LINE +; PAGLN ;LENGTH OF A PAGE +; LINPOS ;CURRENT LINE BEING WRITTEN ON + +; *** THE FOLLOWING FILEDS FOR INPUT ONLY *** +; EOFCND ;GETS EVALUATED ON EOF +; LSTCH ;BACKUP CHARACTER +; WAITNS ;FOR TTY INPUT, BECOMES A .SLEEP WHEN WAITING +; EXBUFR ;FOR TTY INPUT, CONTAINS A WAITING BUFFER LIST +; BUFSTR ;A CHARACTER STRING USED AS BUFFER FOR NON-TTY DEVICES + +; THIS DEFINES THE LENGTH OF THE NON-TTY BUFFER +BUFLNT==100 + +;THIS DEFINES BLOCK MODE BIT FOR OPENING +BLOCKM==2 ;DEFINED IN THE LEFT HALF +IMAGEM==4 + + +;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME + + CHANLNT==4 ;INITIAL CHANNEL LENGTH + +; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS +BUFRIN==-1 ;SPECIAL HACK SO LOSERS WON'T SEE TTY BUFFER +SCRPTO==-3 ;SPECIAL HACK FOR SCRIPT CHANNELS +PROCHN: + +IRP A,,[[CHANNO,FIX],[DIRECT,CHSTR] +[NAME1,CHSTR],[NAME2,CHSTR],[DEVICE,CHSTR],[SNAME,CHSTR] +[RNAME1,CHSTR],[RNAME2,CHSTR],[RDEVIC,CHSTR],[RSNAME,CHSTR] +[STATUS,FIX],[IOINS,FIX],[LINLN,FIX],[CHRPOS,FIX],[PAGLN,FIX],[LINPOS,FIX] +[ACCESS,FIX],[RADX,FIX],[BUFSTR,CHSTR]] + + IRP B,C,[A] + B==CHANLNT-3 + T!C,,0 + 0 + .ISTOP + TERMIN + CHANLNT==CHANLNT+2 +TERMIN + + +; EQUIVALANCES FOR CHANNELS + +EOFCND==LINLN +LSTCH==CHRPOS +WAITNS==PAGLN +EXBUFR==LINPOS +DISINF==BUFSTR ;DISPLAY INFO +INTFCN==BUFSTR ;FUNCTION (OR SUBR, OR RSUBR) TO BE APPLIED FOR INTERNAL CHNLS + + +;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS + +IRP A,,[IOIN2,ECHO,CHRCNT,ERASCH,KILLCH,BRKCH,ESCAP,SYSCHR,BRFCHR,BRFCH2,BYTPTR] +A==.IRPCNT +TERMIN + +EXTBFR==BYTPTR+1+<100./5> ;LENGTH OF ADD'L BUFFER + + + + +.GLOBAL IPNAME,MOPEN,MCLOSE,MIOT,ILOOKU,6TOCHS,ICLOS,OCLOS,RGPARS,RGPRS +.GLOBAL OPNCHN,CHMAK,READC,TYO,SYSCHR,BRFCHR,LSTCH,BRFCH2,EXTBFR +.GLOBAL CHRWRD,STRTO6,TTYBLK,WAITNS,EXBUFR,TTICHN,TTOCHN,GETCHR,IILIST +.GLOBAL CHANNO,STATUS,LINPOS,PAGLN,CHRPOS,LINLN,IOINS,ACCESS,ADDNUL +.GLOBAL DIRECT,DISINF,RADX,EOFCND,BUFSTR,MODE1,MODE2,GCHACK,GMTYO,INMTYO +.GLOBAL T.CHAN,NAME1,BFCLOS,DOIOTI,DOIOTO,DOACCS,NOTTY,DEMFLG,BYTDOP,TNXIN +.GLOBAL DISOPN,DISROP,DISCLS,DCHAR,DISLNL,DISPGL,INSTAT,MTYO,CIREST +.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP,N.CHNS +.GLOBAL REOPN,QUITTE,CHNL0,CHNL1,BUFRIN,IOIN2,IFALSE,GFALS,IDVAL,PVSTOR,SPSTOR +.GLOBAL BADCHN,WRONGD,CHNCLS,GSNAME,GIBLOK,APLQ,NAPT,ICONS,INCONS,IBLOCK,IDVAL1 +.GLOBAL GRB,GWB,R1CHAR,W1CHAR,BFCLS1,TTYOP2,MPOPJ,COMPER,R1C,W1C,WXCT,RXCT +.GLOBAL TMTNXS,TNXSTR,RDEVIC,CPCH1,RCYCHN,CGFALS,CISTNG,CFILLE,FRSTCH +.GLOBAL TGFALS,ONINT + +.VECT.==40000 + +; PAIR MOVING MACRO + +DEFINE PMOVEM A,B + MOVE 0,A + MOVEM 0,B + MOVE 0,A+1 + MOVEM 0,B+1 + TERMIN + +; DEFINITIONS OF THE OFFSETS INTO THE TP STACK FOR OPEN + +T.SPDL==0 ; SAVES P STACK BASE +T.DIR==2 ; CONTAINS DIRECTION AND MODE +T.NM1==4 ; NAME 1 OF FILE +T.NM2==6 ; NAME 2 OF FILE +T.DEV==10 ; DEVICE NAME +T.SNM==12 ; SNAME +T.XT==14 ; EXTRA CRUFT IF NECESSARY +T.CHAN==16 ; CHANNEL AS GENERATED + +; OFFSETS FROM PSTACK BASE (USED FOR OPENS, .RCHST AND .FDELES) + +S.DIR==0 ; CODE FOR DIRECTION 0-IN, 1-OUT, 2-BIN, 3-BOUT,4-DISPLAY + ; S.DIR(P) = ,, +IFN ITS,[ +S.DEV==1 ; SIXBIT DEVICE RIGHT JUSTIFIED +S.NM1==2 ; SIXBIT NAME1 +S.NM2==3 ; SIXBIT NAME2 +S.SNM==4 ; SIXBIT SNAME +S.X1==5 ; TEMPS +S.X2==6 +S.X3==7 +] + +IFE ITS,[ +S.DEV==1 +S.X1==2 +S.X2==3 +S.X3==4 +] + + +; FLAGS SPECIFYING STATE OF THE WORLD AT VARIOUS TIMES + +NOSTOR==400000 ; ON MEANS DONT BUILD NEW STRINGS +MSTNET==200000 ; ON MEANS ONLY THE "NET" DEVICE CAN WIN +SNSET==100000 ; FLAG, SNAME SUPPLIED +DVSET==040000 ; FLAG, DEV SUPPLIED +N2SET==020000 ; FLAG, NAME2 SET +N1SET==010000 ; FLAG, NAME1 SET +4ARG==004000 ; FLAG, CONSIDER ARGS TO BE 4 STRINGS + +RMT [EXPUNGE N1SET,N2SET,DVSET,SNSET,MSTNET,NOSTOR +] + +; TABLE OF LEGAL MODES + +MODES: IRP A,,[READ,PRINT,READB,PRINTB,PRINTO,PRINAO] + SIXBIT /A/ + TERMIN +NMODES==.-MODES + +MODCOD: 0?1?2?3?3?1 +; TABLE OF KNOWN DEVICES AND A POINTER TO THEIR OPENERS + +IFN ITS,[ +DEVSTB: IRP A,,[DSK,TTY,USR,STY,ST,NET,INT,PTP,PTR,UT,T,NUL] + SIXBIT /A/ ; DEVICE NAMES + TERMIN + +DEVS: IRP B,,[ODSK,OTTY,OUSR,OSTY,OSTY,ONET,OINT,OPTP,OPTP,OUTN,OTTY,ONUL] + SETZ B ; POINTERS + TERMIN +] + +IFE ITS,[ +DEVSTB: IRP A,,[PS,SS,SRC,DSK,TTY,INT,NET] + SIXBIT /A/ + TERMIN + +DEVS: IRP B,,[ODSK,ODSK,ODSK,ODSK,OTTY,OINT,ONET] + SETZ B + TERMIN +] +NDEVS==.-DEVS + + + +;SUBROUTINE TO DO OPENING BEGINS HERE + +MFUNCTION NFOPEN,SUBR,[OPEN-NR] + + JRST FOPEN1 + +MFUNCTION FOPEN,SUBR,[OPEN] + +FOPEN1: ENTRY + PUSHJ P,MAKCHN ;MAKE THE CHANNEL + PUSHJ P,OPNCH ;NOW OPEN IT + JUMPL B,FINIS + SUB D,[4,,4] ; TOP THE CHANNEL + MOVEM D,RCYCHN+1 ; RECYCLE DEAD CHANNEL + SETZM (D) ; ZAP IT + MOVEI C,1(D) + HRLI C,(D) + BLT C,CHANLNT-1(D) + JRST FINIS + +; SUBR TO JUST CREATE A CHANNEL + +IMFUNCTION CHANNEL,SUBR + + ENTRY + PUSHJ P,MAKCHN + MOVSI A,TCHAN + JRST FINIS + + + + +; THIS ROUTINE PARSES ARGUMENTS TO FOPEN ETC. AND BUILDS A CHANNEL BUT DOESN'T OPEN IT + +MAKCHN: PUSH TP,$TPDL + PUSH TP,P ; POINT AT CURRENT STACK BASE + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE READ + MOVEI E,10 ; SLOTS OF TP NEEDED + PUSH TP,[0] + SOJG E,.-1 + MOVEI E,0 + EXCH E,(P) ; GET RET ADDR IN E +IFE ITS, PUSH P,[0] +IRP ATM,,[DEV,NM1,NM2,SNM]MDF,,[DSK,INPUT,>,[ ]]TMDF,,[DSK,INPUT,MUD,[ ]] + MOVE B,IMQUOTE ATM +IFN ITS, PUSH P,E + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TCHSTR + JRST MAK!ATM + + MOVE A,$TCHSTR +IFN ITS, MOVE B,CHQUOTE MDF +IFE ITS, MOVE B,CHQUOTE TMDF +MAK!ATM: + MOVEM A,T.!ATM(TB) + MOVEM B,T.!ATM+1(TB) +IFN ITS,[ + POP P,E + PUSHJ P,STRTO6 ; RESULT LEFT ON P STACK AS DESIRED +] + TERMIN + PUSH TP,[0] ; PUSH SLOTS + PUSH TP,[0] + + PUSH P,[0] ; EXT SLOTS + PUSH P,[0] + PUSH P,[0] + PUSH P,E ; PUSH RETURN ADDRESS + MOVEI A,0 + + JUMPGE AB,MAKCH0 ; NO ARGS, ALREADY DONE + GETYP 0,(AB) ; 1ST ARG MUST BE A STRING + CAIE 0,TCHSTR + JRST WTYP1 + MOVE A,(AB) ; GET ARG + MOVE B,1(AB) + PUSHJ P,CHMODE ; CHECK OUT OPEN MODE + + PMOVEM (AB),T.DIR(TB) ; SAVE MODE NAME IN TEMPS + ADD AB,[2,,2] ; BUMP PAST DIRECTION + MOVEI A,0 + JUMPGE AB,MAKCH0 ; CHECK NAME1 BASED ON JUST MODE + + MOVEI 0,0 ; FLAGS PRESET + PUSHJ P,RGPARS ; PARSE THE STRING(S) + JRST TMA + +; ARGUMENTS PARSED, DO FINAL CHECKS AND BUILD CHANNEL + +MAKCH0: +IFN ITS,[ + MOVE C,T.SPDL+1(TB) + MOVE D,S.DEV(C) ; GET DEV +] +IFE ITS,[ + MOVE A,T.DEV(TB) + MOVE B,T.DEV+1(TB) + PUSHJ P,STRTO6 + POP P,D + HLRZS D + MOVE C,T.SPDL+1(TB) + MOVEM D,S.DEV(C) +] +IFE ITS, CAIE D,(SIXBIT /INT/);INTERNAL? +IFN ITS, CAME D,[SIXBIT /INT /] + JRST CHNET ; NO, MAYBE NET + SKIPN T.XT+1(TB) ; WAS FCN SUPPLIED? + JRST TFA + +; FALLS TROUGH IF SKIP + + + +; NOW BUILD THE CHANNEL + +ARGSOK: MOVEI A,CHANLNT ; GET LENGTH + SKIPN B,RCYCHN+1 ; RECYCLE? + PUSHJ P,GIBLOK ; GET A BLOCK OF STUFF + SETZM RCYCHN+1 + ADD B,[4,,4] ; HIDE THE TTY BUFFER SLOT + PUSH TP,$TCHAN + PUSH TP,B + HRLI C,PROCHN ; POINT TO PROTOTYPE + HRRI C,(B) ; AND NEW ONE + BLT C,CHANLN-5(B) ; CLOBBER + MOVSI C,TLIST ; TO GIVE HIM A CLEAN LIST OF SCRIPT CHANS + HLLM C,SCRPTO-1(B) + +; NOW BLT IN STUFF FROM THE STACK + + MOVSI C,T.DIR(TB) ; DIRECTION + HRRI C,DIRECT-1(B) + BLT C,SNAME(B) + MOVEI C,RNAME1-1(B) ; NOW "REAL" SLOTS + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + MOVE B,IMQUOTE MODE + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TFIX + JRST .+3 + MOVE B,(TP) + POPJ P, + + MOVE C,(TP) +IFE ITS,[ + ANDI B,403776 ; ONLY ALLOW NON-CRITICAL BITSS +] + HRRM B,-4(C) ; HIDE BITS + MOVE B,C + POPJ P, + +; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN + +CHNET: +IFN ITS,[ + CAME D,[SIXBIT /NET /] ; IS IT NET + JRST MAKCH1] +IFE ITS,[ + CAIE D,(SIXBIT /NET/) ; IS IT NET + JRST ARGSOK] + MOVSI D,TFIX ; FOR TYPES + MOVEI B,T.NM1(TB) ; MAKE SURE ALL ARE FIXED + PUSHJ P,CHFIX + MOVEI B,T.NM2(TB) + PUSHJ P,CHFIX + MOVEI B,T.SNM(TB) + LSH A,-1 ; SKIP DEV FLAG + PUSHJ P,CHFIX + JRST ARGSOK + +MAKCH1: TRNN A,MSTNET ; CANT HAVE SEEN A FIX + JRST ARGSOK + JRST WRONGT + +IFN ITS,[ +CHFIX: TRNE A,N1SET ; SKIP IF NOT SPECIFIED + JRST CHFIX1 + SETOM 1(B) ; SET TO -1 + SETOM S.NM1(C) + MOVEM D,(B) ; CORRECT TYPE +] +IFE ITS,CHFIX: + GETYP 0,(B) + CAIE 0,TFIX + JRST PARSQ +CHFIX1: ADDI C,1 ; POINT TO NEXT FIELD + LSH A,-1 ; AND NEXT FLAG + POPJ P, +PARSQ: CAIE 0,TCHSTR + JRST WRONGT +IFE ITS, POPJ P, +IFN ITS,[ + PUSH P,A + PUSH P,C + PUSH TP,(B) + PUSH TP,1(B) + SUBI B,(TB) + PUSH P,B + MCALL 1,PARSE + GETYP 0,A + CAIE 0,TFIX + JRST WRONGT + POP P,C + ADDI C,(TB) + MOVEM A,(C) + MOVEM B,1(C) + POP P,C + POP P,A + POPJ P, +] + + +; SUBROUTINE TO CHECK VALIDITY OF MODE AND SAVE A CODE + +CHMODE: PUSHJ P,CHMOD ; DO IT + MOVE C,T.SPDL+1(TB) + HRRZM A,S.DIR(C) + POPJ P, + +CHMOD: PUSHJ P,STRTO6 ; TO SIXBIT + POP P,B ; VALUE ENDSUP ON STACK, RESTORE IT + + MOVSI A,-NMODES ; SCAN TO SEE IF LEGAL MODE + CAME B,MODES(A) + AOBJN A,.-1 + JUMPGE A,WRONGD ; ILLEGAL MODE NAME + MOVE A,MODCOD(A) + POPJ P, + + +IFN ITS,[ +; RGPARS -- PARSE THE STRINGS COMPRISING FILE NAMES INTO STANDARD ITS GOODIES + +RGPRS: MOVEI 0,NOSTOR ; DONT STORE STRINGS IF ENTER HERE + +RGPARS: CAMGE AB,[-7,,] ; MULTI-STRING CASE POSSIBLE? + IORI 0,4ARG ; 4 STRING CASE + HRLM 0,(P) ; LH IS FLAGS FOR THIS PROG + MOVSI E,-4 ; FIELDS TO FILL + +RPARGL: GETYP 0,(AB) ; GET TYPE + CAIE 0,TCHSTR ; STRING? + JRST ARGCLB ; NO, JUST CLOBBER IT IN RAW + JUMPGE E,CPOPJ ; DON'T DO ANY MORE + PUSH TP,(AB) ; GET AN ARG + PUSH TP,1(AB) + +FPARS: PUSH TP,-1(TP) ; ANOTHER COPY + PUSH TP,-1(TP) + HLRZ 0,(P) + TRNN 0,4ARG + PUSHJ P,FLSSP ; NO LEADING SPACES + MOVEI A,0 ; WILL HOLD SIXBIT + MOVEI B,6 ; CHARS PER 6BIT WORD + MOVE C,[440600,,A] ; BYTE POINTER INTO A + +FPARSL: HRRZ 0,-1(TP) ; GET COUNT + JUMPE 0,PARSD ; DONE + SOS -1(TP) ; COUNT + ILDB 0,(TP) ; CHAR TO 0 + + CAIE 0," ; FILE NAME QUOTE? + JRST NOCNTQ + HRRZ 0,-1(TP) + JUMPE 0,PARSD + SOS -1(TP) + ILDB 0,(TP) ; USE THIS + JRST GOTCNQ + +NOCNTQ: HLL 0,(P) + TLNE 0,4ARG + JRST GOTCNQ + ANDI 0,177 + CAIG 0,40 ; SPACE? + JRST NDFLD ; YES, TERMINATE THIS FIELD + CAIN 0,": ; DEVICE ENDED? + JRST GOTDEV + CAIN 0,"; ; SNAME ENDED + JRST GOTSNM + +GOTCNQ: ANDI 0,177 + PUSHJ P,A0TO6 ; CONVERT TO 6BIT AND CHECK + + JUMPE B,FPARSL ; IGNORE IF AREADY HAVE 6 + IDPB 0,C + SOJA B,FPARSL + +; HERE IF SPACE ENCOUNTERED + +NDFLD: MOVEI D,(E) ; COPY GOODIE + PUSHJ P,FLSSP ; FLUSH REDUNDANT SPACES + JUMPE 0,PARSD ; NO CHARS LEFT + +NFL0: PUSH P,A ; SAVE SIXBIT WORD + SKIPGE -1(P) ; SKIP IF STRING TO BE STORED + JRST NFL1 + PUSH TP,$TAB ; PREVENT AB LOSSAGE + PUSH TP,AB + PUSHJ P,6TOCHS ; CONVERT TO STRING + MOVE AB,(TP) + SUB TP,[2,,2] +NFL1: HRRZ 0,-1(TP) ; RESTORE CHAR COUNT + +NFL2: MOVEI C,(D) ; COPY REL PNTR + SKIPGE -1(P) ; SKIP IF STRINGS TO BE STORED + JRST NFL3 + ASH D,1 ; TIMES 2 + ADDI D,T.NM1(TB) + MOVEM A,(D) ; STORE + MOVEM B,1(D) +NFL3: MOVSI A,N1SET ; FLAG IT + LSH A,(C) + IORM A,-1(P) ; AND CLOBBER + MOVE D,T.SPDL+1(TB) ; GET P BASE + POP P,@SIXTBL(C) ; AND STORE SIXBIT OF IT + + POP TP,-2(TP) ; MAKE NEW STRING POINTER + POP TP,-2(TP) + JUMPE 0,.+3 ; SKIP IF NO MORE CHARS + AOBJN E,FPARS ; MORE TO PARSE? +CPOPJ: POPJ P, ; RETURN, ALL DONE + + SUB TP,[2,,2] ; FLUSH OLD STRING + ADD E,[1,,1] + ADD AB,[2,,2] ; BUMP ARG + JUMPL AB,RPARGL ; AND GO ON +CPOPJ1: AOS A,(P) ; PREPARE TO WIN + HLRZS A + POPJ P, + + + +; HERE IF STRING HAS ENDED + +PARSD: PUSH P,A ; SAVE 6 BIT + MOVE A,-3(TP) ; CAN USE ARG STRING + MOVE B,-2(TP) + MOVEI D,(E) + JRST NFL2 ; AND CONTINUE + +; HERE IF JUST READ DEV + +GOTDEV: MOVEI D,2 ; CODE FOR DEVICE + JRST GOTFLD ; GOT A FIELD + +; HERE IF JUST READ SNAME + +GOTSNM: MOVEI D,3 +GOTFLD: PUSHJ P,FLSSP + SOJA E,NFL0 + + +; HERE FOR NON STRING ARG ENCOUNTERED + +ARGCLB: SKIPGE (P) ; IF NOT STORING, CONSIDER THIS THE END + + POPJ P, + MOVE C,T.SPDL+1(TB) ; GET P-BASE + MOVE A,S.DEV(C) ; GET DEVICE + CAME A,[SIXBIT /INT /]; IS IT THE INTERNAL DEVICE + JRST TRYNET ; NO, COUD BE NET + MOVE A,0 ; OFFNEDING TYPE TO A + PUSHJ P,APLQ ; IS IT APPLICABLE + JRST NAPT ; NO, LOSE + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] ; MUST BE LAST ARG + JUMPL AB,TMA + JRST CPOPJ1 ; ELSE SUCCESSFUL RETURN +TRYNET: CAIE 0,TFIX ; FOR NET DEV, ARGS MUST BE FIX + JRST WRONGT ; TREAT AS WRONG TYPE + MOVSI A,MSTNET ; BETTER BE NET EVENTUALLY + IORM A,(P) ; STORE FLAGS + MOVSI A,TFIX + MOVE B,1(AB) ; GET NUMBER + MOVEI 0,(E) ; MAKE SURE NOT DEVICE + CAIN 0,2 + JRST WRONGT + PUSH P,B ; SAVE NUMBER + MOVEI D,(E) ; SET FOR TABLE OFFSETS + MOVEI 0,0 + ADD TP,[4,,4] + JRST NFL2 ; GO CLOBBER IT AWAY +] + + +; ROUTINE TO FLUSH LEADING SPACES FROM A FIELD + +FLSSP: HRRZ 0,-1(TP) ; GET CHR COUNNT + JUMPE 0,CPOPJ ; FINISHED STRING +FLSS1: MOVE B,(TP) ; GET BYTR + ILDB C,B ; GETCHAR + CAIE C,^Q ; DONT FLUSH CNTL-Q + CAILE C,40 + JRST FLSS2 + MOVEM B,(TP) ; UPDATE BYTE POINTER + SOJN 0,FLSS1 + +FLSS2: HRRM 0,-1(TP) ; UPDATE STRING + POPJ P, + +IFN ITS,[ +;TABLE FOR STFUFFING SIXBITS AWAY + +SIXTBL: SETZ S.NM1(D) + SETZ S.NM2(D) + SETZ S.DEV(D) + SETZ S.SNM(D) + SETZ S.X1(D) +] + +RDTBL: SETZ RDEVIC(B) + SETZ RNAME1(B) + SETZ RNAME2(B) + SETZ RSNAME(B) + + + +IFE ITS,[ + +; TENEX VERSION OF FILE NAME PARSER (ONLY ACCEPT ARGS IN SINGLE STRING) + + +RGPRS: MOVEI 0,NOSTOR + +RGPARS: HRLM 0,(P) ; SAVE FOR STORE CHECKING + CAMGE AB,[-2,,] ; MULTI-STRING CASE POSSIBLE? + JRST TN.MLT ; YES, GO PROCESS +RGPRSS: GETYP 0,(AB) ; CHECK ARG TYPE + CAIE 0,TCHSTR + JRST WRONGT ; FOR NOW ONLY STRING ARGS WIN + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,FLSSP ; FLUSH LEADING SPACES + PUSHJ P,RGPRS1 + ADD AB,[2,,2] +CHKLST: JUMPGE AB,CPOPJ1 + SKIPGE (P) ; IF FROM OPEN, ALLOW ONE MORE + POPJ P, + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] + JUMPL AB,TMA +CPOPJ1: AOS (P) + POPJ P, + +RGPRS1: PUSH P,[0] ; ALLOW A DEVICE SPEC +TN.SNM: MOVE A,(TP) + HRRZ 0,-1(TP) + JUMPE 0,RPDONE + ILDB A,A + CAIE A,"< ; START "DIRECTORY" ? + JRST TN.N1 ; NO LOOK FOR NAME1 + SETOM (P) ; DEV NOT ALLOWED + IBP (TP) ; SKIP CHAR + SOS -1(TP) + PUSHJ P,TN.CNT ; COUNT CHARS TO ">" OR "." + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN3 + PUSH TP,0 + PUSH TP,C +TN.SN1: PUSHJ P,TN.CNT ; COUNT CHARS TO ">" + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN2 + MOVEM 0,-1(TP) + MOVEM C,(TP) + JRST TN.SN1 +TN.SN2: HRRZ B,-3(TP) + SUB B,0 + SUBI B,1 + SUB TP,[2,,2] +TN.SN3: CAIE A,"> ; SKIP IF WINS + JRST ILLNAM + PUSHJ P,TN.CPS ; COPY TO NEW STRING + HLLOS T.SPDL(TB) + MOVEM A,T.SNM(TB) + MOVEM B,T.SNM+1(TB) + +TN.N1: PUSHJ P,TN.CNT + JUMPE B,RPDONE + CAIE A,": ; GOT A DEVICE + JRST TN.N11 + SKIPE (P) + JRST ILLNAM + SETOM (P) + PUSHJ P,TN.CPS + MOVEM A,T.DEV(TB) + MOVEM B,T.DEV+1(TB) + JRST TN.SNM ; NOW LOOK FOR SNAME + +TN.N11: CAIE A,"> + CAIN A,"< + JRST ILLNAM + MOVEM A,(P) ; SAVE END CHAR + PUSHJ P,TN.CPS ; GEN STRING + MOVEM A,T.NM1(TB) + MOVEM B,T.NM1+1(TB) + +TN.N2: SKIPN A,(P) ; GET CHAR BACK + JRST RPDONE + CAIN A,"; ; START VERSION? + JRST .+3 + CAIE A,". ; START NAME2? + JRST ILLNAM ; I GIVE UP!!! + HRRZ B,-1(TP) ; GET RMAINS OF STRING + PUSHJ P,TN.CPS ; AND COPY IT + MOVEM A,T.NM2(TB) + MOVEM B,T.NM2+1(TB) +RPDONE: SUB P,[1,,1] ; FLUSH TEMP + SUB TP,[2,,2] +CPOPJ: POPJ P, + +TN.CNT: HRRZ 0,-1(TP) ; CHAR COUNT + MOVE C,(TP) ; BPTR + MOVEI B,0 ; INIT COUNT TO 0 + +TN.CN1: MOVEI A,0 ; IN CASE RUN OUT + SOJL 0,CPOPJ ; RUN OUT? + ILDB A,C ; TRY ONE + CAIE A," ; TNEX FILE QUOTE? + JRST TN.CN2 + SOJL 0,CPOPJ + IBP C ; SKIP QUOTED CHAT + ADDI B,2 + JRST TN.CN1 + +TN.CN2: CAIE A,"< + CAIN A,"> + POPJ P, + + CAIE A,". + CAIN A,"; + POPJ P, + CAIN A,": + POPJ P, + AOJA B,TN.CN1 + +TN.CPS: PUSH P,B ; # OF CHARS + MOVEI A,4(B) ; ADD 4 TO B IN A + IDIVI A,5 + PUSHJ P,IBLOCK ; GET BLOCK OF WORDS FOR STRING + + POP P,C ; CHAR COUNT BACK + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + HRRI A,(C) ; CHAR STRING + MOVE D,B ; COPY BYTER + + JUMPE C,CPOPJ + ILDB 0,(TP) ; GET CHAR + IDPB 0,D ; AND STROE + SOJG C,.-2 + + MOVNI C,(A) ; - LENGTH TO C + ADDB C,-1(TP) ; DECREMENT WORDS COUNT + TRNN C,-1 ; SKIP IF EMPTY + POPJ P, + IBP (TP) + SOS -1(TP) ; ELSE FLUSH TERMINATOR + POPJ P, + +ILLNAM: ERRUUO EQUOTE ILLEGAL-TENEX-FILE-NAME + +TN.MLT: MOVE A,AB ; AOBJN POINTER TO ARGS IN A + +TN.ML1: GETYP 0,(A) ; IS THIS ARG OF RIGHT TYPE + CAIE 0,TFIX + CAIN 0,TCHSTR + JRST .+2 + JRST RGPRSS ; ASSUME SINGLE STRING + ADD A,[2,,2] + JUMPL A,TN.ML1 ; TRY NEXT ARG IF ANY LEFT + + MOVEI 0,T.NM1(TB) ; 1ST WORD OF DESTINATION + HLRO A,AB ; MINUS NUMBER OF ARGS IN A + MOVN A,A ; NUMBER OF ARGS IN A + SUBI A,1 + CAMGE AB,[-10,,0] + MOVEI A,7 ; IF MORE THAN 10 ARGS, PUT 7 + ADD A,0 ; LAST WORD OF DESTINATION + HRLI 0,(AB) + BLT 0,(A) ; BLT 'EM IN + ADD AB,[10,,10] ; SKIP THESE GUYS + JRST CHKLST + +] + + +; ROUTINE TO OPEN A CHANNEL FOR ANY DEVICE. NAMES ARE ASSUMED TO ALREADY +; BE ON BOTH TP STACK AND P STACK + +OPNCH: MOVE C,T.SPDL+1(TB) ; GET PDL BASE + HRRZ A,S.DIR(C) + ANDI A,1 ; JUST WANT I AND O +IFE ITS,[ + HRLM A,S.DEV(C) +; .TRANS S.DEV(C) ; UNDO ANY TRANSLATIONS +; JRST TRLOST ; COMPLAIN +] +IFN ITS,[ + HRLM A,S.DIR(C) +] + +IFN ITS,[ + MOVE A,S.DEV(C) ; GET SIXBIT DEVICE CODE +] + +IFE ITS,[HRLZS A,S.DEV(C) +] + + MOVSI B,-NDEVS ; AOBJN COUNTER +DEVLP: SETO D, + MOVE 0,DEVSTB(B) ; GET ONE FROM TABLE + MOVE E,A +DEVLP1: AND E,D ; FLUSH POSSIBLE DIGITNESS + CAMN 0,E + JRST CHDIGS ; MAKE SURE REST IS DIGITS + LSH D,6 + JUMPN D,DEVLP1 ; KEEP TRUCKING UNTIL DONE + +; WASN'T THAT DEVICE, MOVE TO NEXT +NXTDEV: AOBJN B,DEVLP + JRST ODSK ; UNKNOWN DEVICE IS ASSUMED TO BE DISK + +IFN ITS,[ +OUSR: HRRZ A,S.DIR(C) ; BLOCK OR UNIT? + TRNE A,2 ; SKIP IF UNIT + JRST ODSK + PUSHJ P,OPEN1 ; OPEN IT + PUSHJ P,FIXREA ; AND READCHST IT + MOVE B,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVE 0,[PUSHJ P,DOIOT] ; GET AN IOINS + MOVEM 0,IOINS(B) + MOVE C,T.SPDL+1(TB) + HRRZ A,S.DIR(C) + TRNN A,1 + JRST EOFMAK + MOVEI 0,80. + MOVEM 0,LINLN(B) + JRST OPNWIN + +OSTY: HLRZ A,S.DIR(C) + IORI A,10 ; THE DONT LOSE BIT (DONT HANG ON INPUT DO ON OUTPUT) + HRLM A,S.DIR(C) + JRST OUSR +] + +; MAKE SURE DIGITS EXIST + +CHDIGS: SETCA D, + JUMPE D,DISPA ; NO DIGITS, WIN IMMEDIATE + MOVE E,A + AND E,D ; LEAVES ONLY DIGITS, IF WINNING + LSH E,6 + LSH D,6 + JUMPG D,.-2 ; KEEP GOING TIL DIGITS LEFT SHIFTED + JRST CHDIGN + +CHDIG1: CAIG D,'9 + CAIGE D,'0 + JRST NXTDEV ; NOT A DIGIT, LOSE + JUMPE E,DISPA ; IF THAT'S ALL THE CHARACTERS, WIN! +CHDIGN: SETZ D, + ROTC D,6 ; GET NEXT CHARACTER INTO D + JRST CHDIG1 ; GO TEST? + +; HERE TO DISPATCH IF SUCCESSFUL + +DISPA: JRST @DEVS(B) + + +IFN ITS,[ + +; DISK DEVICE OPNER COME HERE + +ODSK: MOVE A,S.SNM(C) ; GET SNAME + .SUSET [.SSNAM,,A] ; CLOBBER IT + PUSHJ P,OPEN0 ; DO REAL LIVE OPEN +] +IFE ITS,[ + +; TENEX DISK FILE OPENER + +ODSK: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + PUSHJ P,STSTK ; EXPAND STRING ONTO STACK (E POINTS TO OLD P) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; GET DIR NAME + MOVE C,(P) + MOVE D,T.SPDL+1(TB) + HRRZ D,S.DIR(D) + CAME C,[SIXBIT /PRINAO/] + CAMN C,[SIXBIT /PRINTO/] + IORI D,100 ; TURN ON BIT TO SAY USE OLD FILE + MOVSI A,101 ; START SETTING UP BITS EXTRA BIT FOR MSB + TRNE D,1 ; SKIP IF INPUT + TRNE D,100 ; WITE OVER? + TLOA A,100000 ; FORCE OLD VERSION + TLO A,600000 ; FORCE NEW VERSION + HRROI B,1(E) ; POINT TO STRING + GTJFN + TDZA 0,0 ; SAVE FACT OF NO SKIP + MOVEI 0,1 ; INDICATE SKIPPED + POP P,C ; RECOVER OPEN MODE SIXBIT + MOVE P,E ; RESTORE PSTACK + JUMPE 0,GTJLOS ; FIND OUT WHAT HAPPENED + + MOVE B,T.CHAN+1(TB) ; GET CHANNEL + HRRZ 0,-4(B) ; FUNNY MODE BITS + HRRZM A,CHANNO(B) ; SAVE IT + ANDI A,-1 ; READ Y TO DO OPEN + MOVSI B,440000 ; USE 36. BIT BYES + HRRI B,200000 ; ASSUME READ +; CAMN C,[SIXBIT /READB/] +; TRO B,2000 ; TURN ON THAWED IF READB + IOR B,0 + TRNE D,1 ; SKIP IF READ + HRRI B,300000 ; WRITE BIT + HRRZ 0,FSAV(TB) ; SEE IF REF DATE HACK + CAIN 0,NFOPEN + TRO B,400 ; SET DON'T MUNG REF DATE BIT + MOVE E,B ; SAVE BITS FOR REOPENS + OPENF + JRST OPFLOS + MOVE B,[2,,11] ; GET LENGTH & BYTE SIZE + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + GTFDB + LDB 0,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + CAIN 0,7 + JRST SIZASC + CAIN 0,36. + SIZEF ; USE OPENED SIZE + JFCL + IMULI B,5 ; TO BYTES +SIZASC: MOVEI 0,C.OPN+C.READ+C.DISK + TRNE D,1 ; SKIP FOR READ + MOVEI 0,C.OPN+C.PRIN+C.DISK + TRNE D,2 ; SKIP IF NOT BINARY FILE + TRO 0,C.BIN + HRL 0,B + MOVE B,T.CHAN+1(TB) + TRNE D,1 + HLRM 0,LSTCH-1(B) ; SAVE CURRENT LENGTH + MOVEM E,STATUS(B) + HRRM 0,-2(B) ; MUNG THOSE BITS + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + PUSHJ P,TMTNXS ; GET STRING FROM TENEX + MOVE B,CHANNO(B) ; JFN TO A + HRROI A,1(E) ; BASE OF STRING + MOVE C,[111111,,140001] ; WEIRD CONTROL BITS + JFNS ; GET STRING + MOVEI B,1(E) ; POINT TO START OF STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; MAKE INTO A STRING + SUB P,E ; BACK TO NORMAL + PUSH TP,A + PUSH TP,B + PUSHJ P,RGPRS1 ; PARSE INTO FIELDS + MOVE B,T.CHAN+1(TB) + MOVEI C,RNAME1-1(B) + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + JRST OPBASC +OPFLOS: MOVEI C,(A) ; SAVE ERROR CODE + MOVE B,T.CHAN+1(TB) + HRRZ A,CHANNO(B) ; JFN BACK TO A + RLJFN ; TRY TO RELEASE IT + JFCL + MOVEI A,(C) ; ERROR CODE BACK TO A + +GTJLOS: MOVE B,T.CHAN+1(TB) + PUSHJ P,TGFALS ; GET A FALSE WITH REASON + JRST OPNRET + +STSTK: PUSH TP,$TCHAN + PUSH TP,B + MOVEI A,4+5 ; COUNT CHARS NEEDED (NEED LAST 0 BYTE) + MOVE B,(TP) + ADD A,RDEVIC-1(B) + ADD A,RNAME1-1(B) + ADD A,RNAME2-1(B) + ADD A,RSNAME-1(B) + ANDI A,-1 ; TO 18 BITS + MOVEI 0,A(A) + IDIVI A,5 ; TO WORDS NEEDED + POP P,C ; SAVE RET ADDR + MOVE E,P ; SAVE POINTER + PUSH P,[0] ; ALOCATE SLOTS + SOJG A,.-1 + PUSH P,C ; RET ADDR BACK + INTGO ; IN CASE OVERFLEW + PUSH P,0 + MOVE B,(TP) ; IN CASE GC'D + MOVE D,[440700,,1(E)] ; BYTE POINTER TO IT + MOVEI A,RDEVIC-1(B) + PUSHJ P,MOVSTR ; FLUSH IT ON + HRRZ A,T.SPDL(TB) + JUMPN A,NLNMS ; USER GAVE NAME, USE IT (CAREFUL, RELIES ON + ; A BEING NON ZERO) + PUSH P,B + PUSH P,C + MOVEI A,0 ; HERE TO SEE IF THIS IS REALLY L.N. + HRROI B,1(E) + HRROI C,1(P) + LNMST ; LOOK UP LOGICAL NAME + MOVNI A,1 ; NOT A LOGICAL NAME + POP P,C + POP P,B +NLNMS: MOVEI 0,": + IDPB 0,D + JUMPE A,ST.NM1 ; LOGICAL NAME, FLUSH SNAME + HRRZ A,RSNAME-1(B) ; ANY SNAME AT ALL? + JUMPE A,ST.NM1 ; NOPE, CANT HACK WITH IT + MOVEI A,"< + IDPB A,D + MOVEI A,RSNAME-1(B) + PUSHJ P,MOVSTR ; SNAME UP + MOVEI A,"> + IDPB A,D +ST.NM1: MOVEI A,RNAME1-1(B) + PUSHJ P,MOVSTR + MOVEI A,". + IDPB A,D + MOVEI A,RNAME2-1(B) + PUSHJ P,MOVSTR + SUB TP,[2,,2] + POP P,A + POPJ P, + +MOVSTR: HRRZ 0,(A) ; CHAR COUNT + MOVE A,1(A) ; BYTE POINTER + SOJL 0,CPOPJ + ILDB C,A ; GET CHAR + IDPB C,D ; MUNG IT UP + JRST .-3 + +; MAKE A TENEX ERROR MESSAGE STRING + +TGFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; SAVE ERROR CODE + PUSHJ P,TMTNXS ; STRING ON STACK + HRROI A,1(E) ; POINT TO SPACE + MOVE B,(E) ; ERROR CODE + HRLI B,400000 ; FOR ME + MOVSI C,-100. ; MAX CHARS + ERSTR ; GET TENEX STRING + JRST TGFLS1 + JRST TGFLS1 + + MOVEI B,1(E) ; A AND B BOUND STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; BUILD STRING + SUB P,E ; P BACK TO NORMAL +TGFLS2: +IFE FNAMS, SUB P,[1,,1] ; FLUSH ERROR CODE SLOT +IFN FNAMS,[ + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST TGFLS3 + PUSHJ P,STSTK + MOVEI B,1(E) + SUBM P,E + MOVSI A,440700 + HRRI A,(P) + MOVEI C,5 + ILDB 0,A + JUMPE 0,.+2 + SOJG C,.-2 + + PUSHJ P,TNXSTR + PUSH TP,A + PUSH TP,B + SUB P,E +TGFLS3: POP P,A + PUSH TP,$TFIX + PUSH TP,A + MOVEI A,3 + SKIPN B + MOVEI A,2 +] +IFE FNAMS,[ + MOVEI A,1 +] + PUSHJ P,IILIST ; BUILD LIST + MOVSI A,TFALSE ; MAKE IT FALSE + SUB TP,[2,,2] + POPJ P, + +TGFLS1: MOVE P,E ; RESET STACK + MOVE A,$TCHSTR + MOVE B,CHQUOTE UNKNOWN PROBLEM IN I/O + JRST TGFLS2 + +] +; OTHER BUFFERED DEVICES JOIN HERE + +OPDSK1: +IFN ITS,[ + PUSHJ P,FIXREA ; STORE THE "REAL" NAMES INTO THE CHANNEL +] +OPBASC: MOVE C,T.SPDL+1(TB) ; C WAS CLOBBERED, GET IT BACK + HRRZ A,S.DIR(C) ; FIND OUT IF OPEN IS ASCII OR WORD + TRZN A,2 ; SKIP IF BINARY + PUSHJ P,OPASCI ; DO IT FOR ASCII + +; NOW SET UP IO INSTRUCTION FOR CHANNEL + +MAKION: MOVE B,T.CHAN+1(TB) + MOVEI C,GETCHR + JUMPE A,MAKIO1 ; JUMP IF INPUT + MOVEI C,PUTCHR ; ELSE GET INPUT + MOVEI 0,80. ; DEFAULT LINE LNTH + MOVEM 0,LINLN(B) + MOVSI 0,TFIX + MOVEM 0,LINLN-1(B) +MAKIO1: + HRLI C,(PUSHJ P,) + MOVEM C,IOINS(B) ; STORE IT + JUMPN A,OPNWIN ; GET AN EOF FORM FOR INPUT CHANNEL + +; HERE TO CONS UP + +EOFMAK: MOVSI C,TATOM + MOVE D,EQUOTE END-OF-FILE + PUSHJ P,INCONS + MOVEI E,(B) + MOVSI C,TATOM + MOVE D,IMQUOTE ERROR + PUSHJ P,ICONS + MOVE D,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVSI 0,TFORM + MOVEM 0,EOFCND-1(D) + MOVEM B,EOFCND(D) + +OPNWIN: MOVEI 0,10. ; SET UP RADIX + MOVSI A,TCHAN ; OPEN SUCCEEDED, RET CHANNEL + MOVE B,T.CHAN+1(TB) + MOVEM 0,RADX(B) + +OPNRET: MOVE D,T.CHAN+1(TB) ; IN CASE WE RECYCLE IT + MOVE C,(P) ; RET ADDR + SUB P,[S.X3+2,,S.X3+2] + SUB TP,[T.CHAN+2,,T.CHAN+2] + JRST (C) + + +; HERE TO CREATE CHARACTER BUFFERS FOR ASCII I/O + +OPASCI: PUSH P,A ; CONTAINS MODE, SAVE IT + MOVEI A,BUFLNT ; GET SIZE OF BUFFER + PUSHJ P,IBLOCK ; GET STORAGE + MOVSI 0,TWORD+.VECT. ; SET UTYPE + MOVEM 0,BUFLNT(B) ; AND STORE + MOVSI A,TCHSTR + SKIPE (P) ; SKIP IF INPUT + JRST OPASCO + MOVEI D,BUFLNT-1(B) ; REST BYTE POINTER +OPASCA: HRLI D,010700 + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEI 0,C.BUF + IORM 0,-2(B) ; TURN ON BUFFER BIT + MOVEM A,BUFSTR-1(B) + MOVEM D,BUFSTR(B) ; CLOBBER + POP P,A + POPJ P, + +OPASCO: HRROI C,777776 + MOVEM C,(B) ; -1 THE BUFFER (LEAVE OFF LOW BIT) + MOVSI C,(B) + HRRI C,1(B) ; BUILD BLT POINTER + BLT C,BUFLNT-1(B) ; ZAP + MOVEI D,-1(B) ; START MAKING STRING POINTER + HRRI A,BUFLNT*5 ; SET UP CHAR COUNT + JRST OPASCA + + +; OPEN NON FILE ORIENTED DEVICES (NUL, PTR, PTP ETC.) + +IFN ITS,[ +ONUL: +OPTP: +OPTR: PUSHJ P,OPEN0 ; SET UP MODE AND OPEN + SETZM S.NM1(C) ; CLOBBER UNINTERESTING FIELDS + SETZM S.NM2(C) + SETZM S.SNM(C) + JRST OPDSK1 + +; OPEN DEVICES THAT IGNORE SNAME + +OUTN: PUSHJ P,OPEN0 + SETZM S.SNM(C) + JRST OPDSK1 + +] + +; INTERNAL CHANNEL OPENER + +OINT: HRRZ A,S.DIR(C) ; CHECK DIR + CAIL A,2 ; READ/PRINT? + JRST WRONGD ; NO, LOSE + + MOVE 0,INTINS(A) ; GET INS + MOVE D,T.CHAN+1(TB) ; AND CHANNEL + MOVEM 0,IOINS(D) ; AND CLOBBER + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + HRRM 0,-2(D) + SETOM STATUS(D) ; MAKE SURE NOT AA TTY + PMOVEM T.XT(TB),INTFCN-1(D) + +; HERE TO SAVE PSEUDO CHANNELS + +SAVCHN: HRRZ E,CHNL0+1 ; POINT TO CURRENT LIST + MOVSI C,TCHAN + PUSHJ P,ICONS ; CONS IT ON + HRRZM B,CHNL0+1 + JRST OPNWIN + +; INT DEVICE I/O INS + +INTINS: PUSHJ P,GTINTC + PUSHJ P,PTINTC + + +; HERE TO OPEN THE NET DEVICE (I.E. THE ARPA NET) + +IFN ITS,[ +ONET: HRRZ A,S.DIR(C) ; DIRECTION CODE + CAILE A,1 ; ASCII ? + IORI A,4 ; TURN ON IMAGE BIT + SKIPGE S.NM1(C) ; NAME1 I.E. LOCAL HOST GIVEN + IORI A,10 ; NO, WE WILL LET ITS GIVE US ONE + SKIPGE S.NM2(C) ; NORMAL OR "LISTEN" + IORI A,20 ; TURN ON LISTEN BIT + MOVEI 0,7 ; DEFAULT BYTE SIZE + TRNE A,2 ; UNLESS + MOVEI 0,36. ; IMAGE WHICH IS 36 + SKIPN T.XT(TB) ; BYTE SIZE GIVEN? + MOVEM 0,S.X1(C) ; NO, STORE DEFAULT + SKIPG D,S.X1(C) ; BYTE SIZE REASONABLE? + JRST RBYTSZ ; NO <0, COMPLAIN + TRNE A,2 ; SKIP TO CHECK ASCII + JRST ONET2 ; CHECK IMAGE + CAIN D,7 ; 7-BIT WINS + JRST ONET1 + CAIE D,44 ; 36-BIT INDICATES BLOCK ASCII MODE + JRST .+3 + IORI A,2 ; SET BLOCK FLAG + JRST ONET1 + IORI A,40 ; USE 8-BIT MODE + CAIN D,10 ; IS IT RIGHT + JRST ONET1 ; YES +] + +RBYTSZ: ERRUUO EQUOTE BYTE-SIZE-BAD + +IFN ITS,[ +ONET2: CAILE D,36. ; IMAGE SIZE REASONABLE? + JRST RBYTSZ ; NO + CAIN D,36. ; NORMAL + JRST ONET1 ; YES, DONT SET FIELD + + ASH D,9. ; POSITION FOR FIELD + IORI A,40(D) ; SET IT AND ITS BIT + +ONET1: HRLM A,S.DIR(C) ; CLOBBER OPEN BLOCK + MOVE E,A ; SAVE BLOCK MODE INFO + PUSHJ P,OPEN1 ; DO THE OPEN + PUSH P,E + +; CLOBBER REAL SLOTS FOR THE OPEN + + MOVEI A,3 ; GET STATE VECTOR + PUSHJ P,IBLOCK + MOVSI A,TUVEC + MOVE D,T.CHAN+1(TB) + HLLM A,BUFRIN-1(D) + MOVEM B,BUFRIN(D) + MOVSI A,TFIX+.VECT. ; SET U TYPE + MOVEM A,3(B) + MOVE C,T.SPDL+1(TB) + MOVE B,T.CHAN+1(TB) + + PUSHJ P,INETST ; GET STATE + + POP P,A ; IS THIS BLOCK MODE + MOVEI 0,80. ; POSSIBLE LINE LENGTH + TRNE A,1 ; SKIP IF INPUT + MOVEM 0,LINLN(B) + TRNN A,2 ; BLOCK MODE? + JRST .+3 + TRNN A,4 ; ASCII MODE? + JRST OPBASC ; GO SETUP BLOCK ASCII + MOVE 0,[PUSHJ P,DOIOT] + MOVEM 0,IOINS(B) + + JRST OPNWIN + +; INTERNAL ROUTINE TO GET THE CURRENT STATE OF THE NETWROK CHANNEL + +INETST: MOVE A,S.NM1(C) + MOVEM A,RNAME1(B) + MOVE A,S.NM2(C) + MOVEM A,RNAME2(B) + LDB A,[1100,,S.SNM(C)] + MOVEM A,RSNAME(B) + + MOVE E,BUFRIN(B) ; GET STATE BLOCK +INTST1: HRRE 0,S.X1(C) + MOVEM 0,(E) + ADDI C,1 + AOBJN E,INTST1 + + POPJ P, + + +; ACCEPT A CONNECTION + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET ; CHECK THAT ARG IS AN OPEN NET CHANNEL + MOVE A,CHANNO(B) ; GET CHANNEL + LSH A,23. ; TO AC FIELD + IOR A,[.NETACC] + XCT A + JRST IFALSE ; RETURN FALSE +NETRET: MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +; FORCE SYSTEM NETWORK BUFFERS TO BE SENT + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 + CAMN A,MODES+3 + SKIPA A,CHANNO(B) ; GET CHANNEL + JRST WRONGD + LSH A,23. + IOR A,[.NETS] + XCT A + JRST NETRET + +; SUBR TO RETURN UPDATED NET STATE + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET ; IS IT A NET CHANNEL + PUSHJ P,INSTAT + JRST FINIS + +; INTERNAL NETSTATE ROUTINE + +INSTAT: MOVE C,P ; GET PDL BASE + MOVEI 0,S.X3 ; # OF SLOTS NEEDED + PUSH P,[0] + SOJN 0,.-1 +; RESTORED FROM MUDDLE 54. IT SEEMED TO WORK THERE, AND THE STUFF +; COMMENTED OUT HERE CERTAINLY DOESN'T. + MOVEI D,S.DEV(C) + HRL D,CHANNO(B) + .RCHST D, +; HRR D,CHANNO(B) ; SETUP FOR RFNAME CALL +; DOTCAL RFNAME,[D,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] +; .LOSE %LSFIL ; THIS MAY NOT BE DESIRABLE, BUT I ASSUME WE CARE IF + ; LOSSAGE + PUSHJ P,INETST ; INTO VECTOR + SUB P,[S.X3,,S.X3] + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + POPJ P, +] +; INTERNAL ROUTINE TO CHECK FOR CORRECT CHANNEL TYPE + +ARGNET: ENTRY 1 + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; OPEN? + JRST CHNCLS + MOVE A,RDEVIC-1(B) ; GET DEV NAME + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 + POP P,A + CAME A,[SIXBIT /NET /] + JRST NOTNET + MOVE B,1(AB) + MOVE A,DIRECT-1(B) ; CHECK FOR A READ SOCKET + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 + MOVE B,1(AB) ; RESTORE CHANNEL + POP P,A + POPJ P, + +IFE ITS,[ + +; TENEX NETWRK OPENING CODE + +ONET: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + MOVSI C,100700 + HRRI C,1(P) + MOVE E,P + PUSH P,[ASCII /NET:/] ; FOR STRINGS + GETYP 0,RNAME1-1(B) ; CHECK TYPE + CAIE 0,TFIX ; SKIP IF # SUPPLIED + JRST ONET1 + MOVE 0,RNAME1(B) ; GET IT + PUSHJ P,FIXSTK + JFCL + JRST ONET2 +ONET1: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME1-1(B) + MOVE B,RNAME1(B) + JUMPE 0,ONET2 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 +ONET2: MOVEI A,". + JSP D,ONETCH + MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIE 0,TFIX + JRST ONET3 + GETYP 0,RSNAME-1(B) + CAIE 0,TFIX + JRST WRONGT + MOVE 0,RSNAME(B) + CAIG 0,377 ;NEW STYLE 32 BIT HOST NUMBER? + JRST ONET2A +;CONVERT HOSTS2 HOST NUMBERS TO INTERNET (TOPS-20) HOST NUMBERS + MOVEI A,0 + LDB B,[001100,,0] ;HOST NUMBER: 1.1-1.9 -> + DPB B,[201000,,A] ; 2.8-3.6 + LDB B,[111100,,0] ;IMP LOW BITS: 2.1-2.9 -> + DPB B,[001000,,A] ; 1.1-1.8 + LDB B,[221100,,0] ;IMP HIGH BITS: 3.1-3.9 -> + DPB B,[101000,,A] ; 1.9-2.7 + LDB B,[331100,,0] ;NETWORK: 4.1-4.9 -> + DPB B,[301000,,A] ; 3.7-4.5 + MOVE 0,A +ONET2A: PUSHJ P,FIXSTK + JRST ONET4 + MOVE B,T.CHAN+1(TB) + MOVEI A,"- + JSP D,ONETCH + MOVE 0,RNAME2(B) + PUSHJ P,FIXSTK + JRST WRONGT + JRST ONET4 +ONET3: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME2-1(B) + MOVE B,RNAME2(B) + JUMPE 0,ONET4 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 + +ONET4: +ONET5: MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIN 0,TCHSTR + JRST ONET6 + MOVEI A,"; + JSP D,ONETCH + MOVEI A,"T + JSP D,ONETCH +ONET6: MOVSI A,1 + HRROI B,1(E) ; STRING POINTER + GTJFN ; GET THE G.D JFN + TDZA 0,0 ; REMEMBER FAILURE + MOVEI 0,1 + MOVE P,E ; RESTORE P + JUMPE 0,GTJLOS ; CONS UP ERROR STRING + + MOVE B,T.CHAN+1(TB) + HRRZM A,CHANNO(B) ; SAVE THE JFN + + MOVE C,T.SPDL+1(TB) + MOVE D,S.DIR(C) + MOVEI B,10 + TRNE D,2 + MOVEI B,36. + SKIPE T.XT(TB) + MOVE B,T.XT+1(TB) + JUMPL B,RBYTSZ + CAILE B,36. + JRST RBYTSZ + ROT B,-6 + TLO B,3400 + HRRI B,200000 + TRNE D,1 ; SKIP FOR INPUT + HRRI B,100000 + ANDI A,-1 ; ISOLATE JFCN + OPENF + JRST OPFLOS ; REPORT ERROR + MOVE B,T.CHAN+1(TB) + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) + CVSKT ; GET ABS SOCKET # + FATAL NETWORK BITES THE BAG! + MOVE D,B + MOVE B,T.CHAN+1(TB) + MOVEM D,RNAME1(B) + MOVSI 0,TFIX + MOVEM 0,RNAME1-1(B) + + MOVSI 0,TFIX + MOVEM 0,RNAME2-1(B) + MOVEM 0,RSNAME-1(B) + MOVE C,T.SPDL+1(TB) + MOVE C,S.DIR(C) + MOVE 0,[PUSHJ P,DONETO] + TRNN C,1 ; SKIP FOR OUTPUT + MOVE 0,[PUSHJ P,DONETI] + MOVEM 0,IOINS(B) + MOVEI 0,80. ; LINELENGTH + TRNE C,1 ; SKIP FOR INPUT + MOVEM 0,LINLN(B) + MOVEI A,3 ; GET STATE UVECTOR + PUSHJ P,IBLOCK + MOVSI 0,TFIX+.VECT. + MOVEM 0,3(B) + MOVE C,B + MOVE B,T.CHAN+1(TB) + MOVEM C,BUFRIN(B) + MOVSI 0,TUVEC + HLLM 0,BUFRIN-1(B) + MOVE B,CHANNO(B) ; GET JFN + MOVEI A,4 ; CODE FOR GTNCP + MOVEI C,1(P) + ADJSP P,4 ; ROOM FOR DATA + MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC + GTNCP + FATAL NET LOSSAGE ; GET STATE + MOVE B,(P) + MOVE D,-1(P) + MOVE C,-3(P) + ADJSP P,-4 + MOVE E,T.CHAN+1(TB) + MOVEM D,RNAME2(E) + MOVEM C,RSNAME(E) + MOVE C,BUFRIN(E) + MOVEM B,(C) ; INITIAL STATE STORED + MOVE B,E + JRST OPNWIN + +; DOIOT FOR TENEX NETWRK + +DONETO: PUSH P,0 + MOVE 0,[BOUT] + JRST .+3 + +DONETI: PUSH P,0 + MOVE 0,[BIN] + PUSH P,0 + PUSH TP,$TCHAN + PUSH TP,B + MOVEI 0,(A) ; POSSIBLE OUTPUT CHAR TO 0 + MOVE A,CHANNO(B) + MOVE B,0 + ENABLE + XCT (P) + DISABLE + MOVEI A,(B) ; RET CHAR IN A + MOVE B,(TP) + MOVE 0,-1(P) + SUB P,[2,,2] + SUB TP,[2,,2] + POPJ P, + +NETPRS: MOVEI D,0 + HRRZ 0,(C) + MOVE C,1(C) + +ONETL: ILDB A,C + CAIN A,"# + POPJ P, + SUBI A,60 + ASH D,3 + IORI D,(A) + SOJG 0,ONETL + AOS (P) + POPJ P, + +FIXSTK: CAMN 0,[-1] + POPJ P, + JFFO 0,FIXS3 ; PUT OCTAL DIGITS INTO STIRNG + MOVEI A,"0 + POP P,D + AOJA D,ONETCH +FIXS3: IDIVI A,3 + MOVEI B,12. + SUBI B,(A) + HRLM B,(P) + IMULI A,3 + LSH 0,(A) + POP P,B +FIXS2: MOVEI A,0 + ROTC 0,3 ; NEXT DIGIT + ADDI A,60 + JSP D,ONETCH + SUB B,[1,,0] + TLNN B,-1 + JRST 1(B) + JRST FIXS2 + +ONETCH: IDPB A,C + TLNE C,760000 ; SKIP IF NEW WORD + JRST (D) + PUSH P,[0] + JRST (D) + +INSTAT: MOVE E,B + MOVE B,CHANNO(B) ; GET JFN + MOVEI A,4 ; CODE FOR GTNCP + MOVEI C,1(P) + ADJSP P,4 ; ROOM FOR DATA + MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC + GTNCP + FATAL NET LOSSAGE ; GET STATE + MOVE B,(P) + MOVE D,-1(P) + MOVE C,-3(P) + ADJSP P,-4 + MOVEM D,RNAME2(E) ; UPDATE FOREIGN SOCHKET + MOVEM C,RSNAME(E) ; AND HOST + MOVE C,BUFRIN(E) + XCT ITSTRN(B) ; XLATE TO LOOK MORE LIKE ITS + MOVEM B,(C) ; STORE STATE + MOVE B,E + POPJ P, + +ITSTRN: MOVEI B,0 + JRST NLOSS + JRST NLOSS + MOVEI B,1 + MOVEI B,2 + JRST NLOSS + MOVEI B,4 + PUSHJ P,NOPND + MOVEI B,0 + JRST NLOSS + JRST NLOSS + PUSHJ P,NCLSD + MOVEI B,0 + JRST NLOSS + MOVEI B,0 + +NLOSS: FATAL ILLEGAL NETWORK STATE + +NOPND: MOVE B,DIRECT(E) ; SEE IF READ OR PRINT + ILDB B,B ; GET 1ST CHAR + CAIE B,"R ; SKIP FOR READ + JRST NOPNDW + SIBE ; SEE IF INPUT EXISTS + JRST .+3 + MOVEI B,5 + POPJ P, + MOVEM B,2(C) ; STORE BYTES IN STATE VECTOR + MOVEI B,11 ; RETURN DATA PRESENT STATE + POPJ P, + +NOPNDW: SOBE ; SEE IF OUTPUT PRESENT + JRST .+3 + MOVEI B,5 + POPJ P, + + MOVEI B,6 + POPJ P, + +NCLSD: MOVE B,DIRECT(E) + ILDB B,B + CAIE B,"R + JRST RET0 + SIBE + JRST .+2 + JRST RET0 + MOVEI B,10 + POPJ P, + +RET0: MOVEI B,0 + POPJ P, + + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET + PUSHJ P,INSTAT + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + JRST FINIS + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 ; PRINT OR PRINTB? + CAMN A,MODES+3 + SKIPA A,CHANNO(B) + JRST WRONGD + MOVEI B,21 + MTOPR +NETRET: MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET + MOVE A,CHANNO(B) + MOVEI B,20 + MTOPR + JRST NETRET + +] + +; HERE TO OPEN TELETYPE DEVICES + +OTTY: HRRZ A,S.DIR(C) ; GET DIR CODE + TRNE A,2 ; SKIP IF NOT READB/PRINTB + JRST WRONGD ; CANT DO THAT + +IFN ITS,[ + MOVE A,S.NM1(C) ; CHECK FOR A DIR + MOVE 0,S.NM2(C) + CAMN A,[SIXBIT /.FILE./] + CAME 0,[SIXBIT /(DIR)/] + SKIPA E,[-15.*2,,] + JRST OUTN ; DO IT THAT WAY + + HRRZ A,S.DIR(C) ; CHECK DIR + TRNE A,1 + JRST TTYLP2 + HRRI E,CHNL1 + PUSH P,S.DEV(C) ; SAVE THE SIXBIT DEV NAME + ; HRLZS (P) ; POSTITION DEVICE NAME + +TTYLP: SKIPN D,1(E) ; CHANNEL OPEN? + JRST TTYLP1 ; NO, GO TO NEXT + MOVE A,RDEVIC-1(D) ; GET DEV NAME + MOVE B,RDEVIC(D) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A ; GET RESULT + CAMN A,(P) ; SAME? + JRST SAMTYQ ; COULD BE THE SAME +TTYLP1: ADD E,[2,,2] + JUMPL E,TTYLP + SUB P,[1,,1] ; THIS ONE MUST BE UNIQUE +TTYLP2: MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; GET DIR OF OPEN + SKIPE A ; IF OUTPUT, + IORI A,20 ; THEN USE DISPLAY MODE + HRLM A,S.DIR(C) ; STORE IN OPEN BLOCK + PUSHJ P,OPEN2 ; OPEN THE TTY + MOVE A,S.DEV(C) ; GET DEVICE NAME + PUSHJ P,6TOCHS ; TO A STRING + MOVE D,T.CHAN+1(TB) ; POINT TO CHANNEL + MOVEM A,RDEVIC-1(D) + MOVEM B,RDEVIC(D) + MOVE C,T.SPDL+1(TB) ; RESTORE PDL BASE + MOVE B,D ; CHANNEL TO B + HRRZ 0,S.DIR(C) ; AND DIR + JUMPE 0,TTYSPC +TTY1: DOTCAL TTYGET,[CHANNO(B),[2000,,0],[2000,,A],[2000,,D]] + .LOSE %LSSYS + DOTCAL TTYSET,[CHANNO(B),MODE1,MODE2,D] + .LOSE %LSSYS + MOVE A,[PUSHJ P,GMTYO] + MOVEM A,IOINS(B) + DOTCAL RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]] + .LOSE %LSSYS + MOVEM D,LINLN(B) + MOVEM A,PAGLN(B) + JRST OPNWIN + +; MAKE AN IOT + +IOTMAK: HRLZ A,CHANNO(B) ; GET CHANNEL + ROT A,5 + IOR A,[.IOT A] ; BUILD IOT + MOVEM A,IOINS(B) ; AND STORE IT + POPJ P, + + +; HERE IF POSSIBLY OPENING AN ALREADY OPEN TTY + +SAMTYQ: MOVE D,1(E) ; RESTORE CURRENT CHANNEL + MOVE A,DIRECT-1(D) ; GET DIR + MOVE B,DIRECT(D) + PUSHJ P,STRTO6 + POP P,A ; GET SIXBIT + MOVE C,T.SPDL+1(TB) + HRRZ C,S.DIR(C) + CAME A,MODES(C) ; SKIP IF DIFFERENT DIRECTION + JRST TTYLP1 + +; HERE IF A RE-OPEN ON A TTY + + HRRZ 0,FSAV(TB) ; IS IT FROM A FOPEN + CAIN 0,FOPEN + JRST RETOLD ; RET OLD CHANNEL + + PUSH TP,$TCHAN + PUSH TP,1(E) ; PUSH OLD CHANNEL + PUSH TP,$TFIX + PUSH TP,T.CHAN+1(TB) + MOVE A,[PUSHJ P,CHNFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + SUB TP,[4,,4] + +RETOLD: MOVE B,1(E) ; GET CHANNEL + AOS CHANNO-1(B) ; AOS REF COUNT + MOVSI A,TCHAN + SUB P,[1,,1] ; CLEAN UP STACK + JRST OPNRET ; AND LEAVE + + +; ROUTINE TO PASS TO GCHACK TO FIX UP CHANNEL POINTER + +CHNFIX: CAIN C,TCHAN + CAME D,(TP) + POPJ P, + MOVE D,-2(TP) ; GET REPLACEMENT + SKIPE B + MOVEM D,1(B) ; CLOBBER IT AWAY + POPJ P, +] + +IFE ITS,[ + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ 0,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVE A,[PUSHJ P,INMTYO] + MOVE B,T.CHAN+1(TB) + MOVEM A,IOINS(B) + MOVEI A,100 ; PRIM INPUT JFN + JUMPN 0,TNXTY1 + MOVEI E,C.OPN+C.READ+C.TTY + HRRM E,-2(B) + MOVEM B,CHNL0+2*100+1 + JRST TNXTY2 +TNXTY1: MOVEM B,CHNL0+2*101+1 + MOVEI A,101 ; PRIM OUTPUT JFN + MOVEI E,C.OPN+C.PRIN+C.TTY + HRRM E,-2(B) +TNXTY2: MOVEM A,CHANNO(B) + JUMPN 0,OPNWIN +] +; SETUP FUNNY BUFFER FOR TTY INPUT DEVICES + +TTYSPC: MOVEI A,EXTBFR ; GET EXTRA BUFFER + PUSHJ P,IBLOCK ; GET BLOCK + MOVE D,T.CHAN+1(TB) ;RESTORE CHANNEL POINTER +IFN ITS,[ + MOVE A,CHANNO(D) + LSH A,23. + IOR A,[.IOT A] + MOVEM A,IOIN2(B) +] +IFE ITS,[ + MOVE A,[PBIN] + MOVEM A,IOIN2(B) +] + MOVSI A,TLIST + MOVEM A,EXBUFR-1(D) ; FOR WAITING TTY BUFFERS + SETZM EXBUFR(D) ; NIL LIST + MOVEM B,BUFRIN(D) ;STORE IN CHANNEL + MOVSI A,TUVEC ;MAKE SURE TYPE IS UNIFORM VECTOR + HLLM A,BUFRIN-1(D) + MOVEI A,177 ;SET ERASER TO RUBOUT + MOVEM A,ERASCH(B) +IFE ITS,[ + MOVEI A,25 + MOVEM A,KILLCH(B) +] +IFN ITS,[ + SETZM KILLCH(B) ;NO KILL CHARACTER NEEDED +] + MOVEI A,33 ;BREAKCHR TO C.R. + MOVEM A,BRKCH(B) + MOVEI A,"\ ;ESCAPER TO \ + MOVEM A,ESCAP(B) + MOVE A,[010700,,BYTPTR(E)] ;RELATIVE BYTE POINTER + MOVEM A,BYTPTR(B) + MOVEI A,14 ;BARF BACK CHARACTER FF + MOVEM A,BRFCHR(B) + MOVEI A,^D + MOVEM A,BRFCH2(B) + +; SETUP DEFAULT TTY INTERRUPT HANDLER + + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TFIX + PUSH TP,[10] ; PRIORITY OF CHAR INT + PUSH TP,$TCHAN + PUSH TP,D + MCALL 3,EVENT ; 1ST MAKE AN EVENT EXIST + PUSH TP,A + PUSH TP,B + PUSH TP,$TSUBR + PUSH TP,[QUITTER] ; DEFAULT HANDLER IS QUITTER + MCALL 2,HANDLER + +; BUILD A NULL STRING + + MOVEI A,0 + PUSHJ P,IBLOCK ; USE A BLOCK + MOVE D,T.CHAN+1(TB) + MOVEI 0,C.BUF + IORM 0,-2(D) + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + MOVEM A,BUFSTR-1(D) + MOVEM B,BUFSTR(D) + MOVEI A,0 + MOVE B,D ; CHANNEL TO B + JRST MAKION + + +; ROUTINE TO OPEN ITS CHANNEL WITHOUT .RCHST + +IFN ITS,[ +OPEN2: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN ; OPEN THE FILE + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; SAVE THE CHANNEL + JRST OPEN3 + +; FIX UP MODE AND FALL INTO OPEN + +OPEN0: HRRZ A,S.DIR(C) ; GET DIR + TRNE A,2 ; SKIP IF NOT BLOCK + IORI A,4 ; TURN ON IMAGE + IORI A,2 ; AND BLOCK + + PUSH P,A + PUSH TP,$TPDL + PUSH TP,C ; SAVE CRUFT TO CHECK FOR PRINTO, HA HA + MOVE B,T.CHAN+1(TB) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) ; THIS KLUDGE THE MESS OF NDR + PUSHJ P,STRTO6 + MOVE C,(TP) + POP P,D ; THE SIXBIT FOR KLUDGE + POP P,A ; GET BACK THE RANDOM BITS + SUB TP,[2,,2] + CAME D,[SIXBIT /PRINAO/] + CAMN D,[SIXBIT /PRINTO/] + IORI A,100000 ; WRITEOVER BIT + HRRZ 0,FSAV(TB) + CAIN 0,NFOPEN + IORI A,10 ; DON'T CHANGE REF DATE +OPEN9: HRLM A,S.DIR(C) ; AND STORE IT + +; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL + +OPEN1: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; CLOBBER INTO CHANNEL + DOTCAL RFNAME,[A,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] + JFCL + +; NOW CLOBBER THE TVP SLOT FOR THIS CHANNEL + +OPEN3: MOVE A,S.DIR(C) + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) ; GET CHANNEL # + ASH A,1 + ADDI A,CHNL0 ; POINT TO SLOT + MOVEM B,1(A) ; NOT: TYPE ALREADY SETUP + +; NOW GET STATUS WORD + +DOSTAT: HRRZ A,CHANNO(B) ; NOW GET STATUS WORD + DOTCAL STATUS,[A,[2002,,STATUS]] + JFCL + POPJ P, + + +; HERE IF OPEN FAILS (CHANNEL IS IN A) + +OPNLOS: JUMPL A,NOCHAN ; ALL CHANNELS ARE IN USE + LSH A,23. ; DO A .STATUS + IOR A,[.STATUS A] + XCT A ; STATUS TO A + MOVE B,T.CHAN+1(TB) + PUSHJ P,GFALS ; GET A FALSE WITH A MESSAGE + SUB P,[1,,1] ; EXTRA RET ADDR FLUSHED + JRST OPNRET ; AND RETURN +] + +CGFALS: SUBM M,(P) + MOVEI B,0 +IFN ITS, PUSHJ P,GFALS +IFE ITS, PUSHJ P,TGFALS + JRST MPOPJ + +; ROUTINE TO CONS UP FALSE WITH REASON +IFN ITS,[ +GFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,[SIXBIT / ERR/] ; SET UP OPEN TO ERR DEV + PUSH P,[3] ; SAY ITS FOR CHANNEL + PUSH P,A + .OPEN 0,-2(P) ; USE CHANNEL 0 FOR THIS + FATAL CAN'T OPEN ERROR DEVICE + SUB P,[3,,3] ; DONT WANT OPEN BLOCK NOW +IFN FNAMS, PUSH P,A + MOVEI A,0 ; PREPARE TO BUILD STRING ON STACK +EL1: PUSH P,[0] ; WHERE IT WILL GO + MOVSI B,(<440700,,(P)>) ; BYTE POINTER TO TOP OF STACK +EL2: .IOT 0,0 ; GET A CHAR + JUMPL 0,EL3 ; JUMP ON -1,,3 + CAIN 0,3 ; EOF? + JRST EL3 ; YES, MAKE STRING + CAIN 0,14 ; IGNORE FORM FEEDS + JRST EL2 ; IGNORE FF + CAIE 0,15 ; IGNORE CR & LF + CAIN 0,12 + JRST EL2 + IDPB 0,B ; STUFF IT + TLNE B,760000 ; SIP IF WORD FULL + AOJA A,EL2 + AOJA A,EL1 ; COUNT WORD AND GO + +EL3: +IFN FNAMS,[ + SKIPN (P) + SUB P,[1,,1] + PUSH P,A + .CLOSE 0, + PUSHJ P,CHMAK + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST EL4 + MOVEI A,0 + MOVSI B,(<440700,,(P)>) + PUSH P,[0] + IRP XX,,[RDEVIC,RSNAME,RNAME1,RNAME2]YY,,[0,72,73,40] +IFSN YY,0,[ + MOVEI 0,YY + JSP E,1PUSH +] + MOVE E,-2(TP) + MOVE C,XX(E) + HRRZ D,XX-1(E) + JSP E,PUSHIT + TERMIN +] + SKIPN (P) ; ANY CHARS AT END? + SUB P,[1,,1] ; FLUSH XTRA + PUSH P,A ; PUT UP COUNT + .CLOSE 0, ; CLOSE THE ERR DEVICE + PUSHJ P,CHMAK ; MAKE STRING + PUSH TP,A + PUSH TP,B +IFN FNAMS,[ +EL4: POP P,A + PUSH TP,$TFIX + PUSH TP,A] +IFE FNAMS, MOVEI A,1 +IFN FNAMS,[ + MOVEI A,3 + SKIPN B + MOVEI A,2 +] + PUSHJ P,IILIST + MOVSI A,TFALSE ; MAKEIT A FALSE +IFN FNAMS, SUB TP,[2,,2] + POPJ P, + +IFN FNAMS,[ +1PUSH: MOVEI D,0 + JRST PUSHI2 +PUSHI1: PUSH P,[0] + MOVSI B,(<440700,,(P)>) +PUSHIT: SOJL D,(E) + ILDB 0,C +PUSHI2: IDPB 0,B + TLNE B,760000 + AOJA A,PUSHIT + AOJA A,PUSHI1 +] +] + + +; ROUTINE TO FILL IN THE "REAL" SLOTS FOR THE CHANNEL + +FIXREA: +IFE ITS, HRLZS S.DEV(C) ; KILL MODE BITS + MOVE D,[-4,,S.DEV] + +FIXRE1: MOVEI A,(D) ; COPY REL POINTER + ADD A,T.SPDL+1(TB) ; POINT TO SLOT + SKIPN A,(A) ; SKIP IF GOODIE THERE + JRST FIXRE2 + PUSHJ P,6TOCHS ; MAKE INOT A STRING + MOVE C,RDTBL-S.DEV(D); GET OFFSET + ADD C,T.CHAN+1(TB) + MOVEM A,-1(C) + MOVEM B,(C) +FIXRE2: AOBJN D,FIXRE1 + POPJ P, + +IFN ITS,[ +DOOPN: HRLZ A,A + HRR A,CHANNO(B) ; GET CHANNEL + DOTCAL OPEN,[A,-3(P),-2(P),-1(P),(P)] + SKIPA + AOS -1(P) + POPJ P, +] + +;THIS ROUTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES +STRTO6: PUSH TP,A + PUSH TP,B + PUSH P,E ;SAVE USEFUL FROB + MOVEI E,(A) ; CHAR COUNT TO E + GETYP A,A + CAIE A,TCHSTR ; IS IT ONE WORD? + JRST WRONGT ;NO + CAILE E,6 ; SKIP IF L=? 6 CHARS + MOVEI E,6 +CHREAD: MOVEI A,0 ;INITIALIZE OUTPUT WORD + MOVE D,[440600,,A] ;AND BYTE POINTER TO IT +NEXCHR: SOJL E,SIXDON + ILDB 0,B ; GET NEXT CHAR + CAIN 0,^Q ; CNTL-Q, QUOTES NEXT CHAR + JRST NEXCHR + JUMPE 0,SIXDON ;IF NULL, WE ARE FINISHED + PUSHJ P,A0TO6 ; CONVERT TO SIXBIT + IDPB 0,D ;DEPOSIT INTO SIX BIT + JRST NEXCHR ; NO, GET NEXT +SIXDON: SUB TP,[2,,2] ;FIX UP TP + POP P,E + EXCH A,(P) ;LEAVE RESULT ON P-STACK + JRST (A) ;NOW RETURN + + +;SUBROUTINE TO CONVERT SIXBIT TO ATOM + +6TOCHS: PUSH P,E + PUSH P,D + MOVEI B,0 ;MAX NUMBER OF CHARACTERS + PUSH P,[0] ;STRING WILL GO ON P SATCK + JUMPE A,GETATM ; EMPTY, LEAVE + MOVEI E,-1(P) ;WILL BE BYTE POINTER + HRLI E,10700 ;SET IT UP + PUSH P,[0] ;SECOND POSSIBLE WORD + MOVE D,[440600,,A] ;INPUT BYTE POINTER +6LOOP: ILDB 0,D ;START CHAR GOBBLING + ADDI 0,40 ;CHANGET TOASCII + IDPB 0,E ;AND STORE IT + TLNN D,770000 ; SKIP IF NOT DONE + JRST 6LOOP1 + TDNN A,MSKS(B) ; CHECK IF JUST SPACES LEFT + AOJA B,GETATM ; YES, DONE + AOJA B,6LOOP ;KEEP LOOKING +6LOOP1: PUSH P,[6] ;IF ARRIVE HERE, STRING IS 2 WORDS + JRST .+2 +GETATM: MOVEM B,(P) ;SET STRING LENGTH=1 + PUSHJ P,CHMAK ;MAKE A MUDDLE STRING + POP P,D + POP P,E + POPJ P, + +MSKS: 7777,,-1 + 77,,-1 + ,,-1 + 7777 + 77 + + +; CONVERT ONE CHAR + +A0TO6: CAIL 0,141 ;IF IT IS GREATER OR EQUAL TO LOWER A + CAILE 0,172 ;BUT LESS THAN OR EQUAL TO LOWER Z + JRST .+2 ;THEN + SUBI 0,40 ;CONVERT TO UPPER CASE + SUBI 0,40 ;NOW TO SIX BIT + JUMPL 0,BAD6 ;CHECK FOR A WINNER + CAILE 0,77 + JRST BAD6 + POPJ P, + +; SUBR TO TEST THE EXISTENCE OF FILES + +MFUNCTION FEXIST,SUBR,[FILE-EXISTS?] + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + ADD TP,[2,,2] + MOVSI E,-4 ; 4 THINGS TO PUSH +EXIST: +IFN ITS, MOVE B,@RNMTBL(E) +IFE ITS, MOVE B,@FETBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST EXIST1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ +; PUSH P,E +; PUSHJ P,ADDNUL ; NOT NEEDED, SINCE CONSED INTO ONE STRING-TAA +; POP P,E + PUSH TP,A ; DEFAULT TYPE AND VALUE GIVEN BY USER + PUSH TP,B ; IN VALUE OF DEV, SNM, NM1, NM2 + ] +IFN ITS, JRST .+2 +IFE ITS, JRST .+3 + +EXIST1: +IFN ITS, PUSH P,EXISTS(E) ; USE DEFAULT +IFE ITS,[ + PUSH TP,FETYP(E) ; DEFAULT TYPE AND VALUE IF NO + PUSH TP,FEVAL(E) ; DEFAULT GIVEN BY USER + ] + AOBJN E,EXIST + + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST TMA ; TOO MANY ARGUMENTS + +IFN ITS,[ + MOVE 0,-3(P) ; GET SIXBIT DEV NAME + MOVEI B,0 + CAMN 0,[SIXBITS /DSK /] + MOVSI B,10 ; DONT SET REF DATE IF DISK DEV + .IOPUSH + DOTCAL OPEN,[B,[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST .+3 + .IOPOP + JRST FDLWON ; WON!!! + .STATUS 0,A ; FIND THE STATUS OF CHANNEL BEFORE POPING + .IOPOP + JRST FDLST1] + +IFE ITS,[ + MOVE B,TB + SUBI B,10 ; GET B TO POINT CORRECTLY TO ARGS + PUSHJ P,STSTK ; GET FILE NAME IN A STRING + HRROI B,1(E) ; POINT B TO THE STRING + MOVSI A,100001 + GTJFN + JRST TDLLOS ; FILE DOES NOT EXIST + RLJFN ; FILE EXIST SO RETURN JFN + JFCL + JRST FDLWON ; SUCCESS + ] + +IFN ITS,[ +EXISTS: SIXBITS /DSK INPUT > / + ] +IFE ITS,[ +FETBL: SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + +FETYP: TCHSTR,,5 + TCHSTR,,3 + TCHSTR,,3 + TCHSTR,,0 + +FEVAL: 440700,,[ASCIZ /INPUT/] + 440700,,[ASCIZ /MUD/] + 440700,,[ASCIZ /DSK/] + 0 + ] + +; SUBR TO DELETE AND RENAME FILES + +MFUNCTION RENAME,SUBR + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + GETYP 0,(AB) ; GET 1ST ARG TYPE +IFN ITS,[ + CAIN 0,TCHAN ; CHANNEL? + JRST CHNRNM ; MUST BE RENAME WHILE OPEN FOR WRITING +] +IFE ITS,[ + PUSH P,[100000,,-2] + PUSH P,[377777,,377777] +] + MOVSI E,-4 ; 4 THINGS TO PUSH +RNMALP: MOVE B,@RNMTBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST RNMLP1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ + PUSH P,E + PUSHJ P,ADDNUL + EXCH B,(P) + MOVE E,B +] + JRST .+2 + +RNMLP1: PUSH P,RNSTBL(E) ; USE DEFAULT + AOBJN E,RNMALP + +IFN ITS,[ + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST RNM1 ; COULD BE A RENAME + +; HERE TO DELETE A FILE + +DELFIL: MOVE A,(P) ; AND GET SNAME + .SUSET [.SSNAM,,A] + DOTCAL DELETE,[[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST FDLST ; ANALYSE ERROR + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS +] +IFE ITS,[ + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; GET BASE OF PDL + MOVEI A,1(A) ; POINT TO CRAP + CAMGE AB,[-3,,] ; SKIP IF DELETE + HLLZS (A) ; RESET DEFAULT + PUSH P,[0] + PUSH P,[0] + PUSH P,[0] + GTJFN ; GET A JFN + JRST TDLLOS ; LOST + ADD AB,[2,,2] ; PAST ARG + JUMPL AB,RNM1 ; GO TRY FOR RENAME + MOVE P,(TP) ; RESTORE P STACK + MOVEI C,(A) ; FOR RELEASE + DELF ; ATTEMPT DELETE + JRST DELLOS ; LOSER + RLJFN ; MAKE SURE FLUSHED + JFCL + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +RNMLOS: PUSH P,A + MOVEI A,(B) + RLJFN + JFCL +DELLO1: MOVEI A,(C) + RLJFN + JFCL + POP P,A ; ERR NUMBER BACK +TDLLOS: MOVEI B,0 + PUSHJ P,TGFALS ; GET FALSE WITH REASON + JRST FINIS + +DELLOS: PUSH P,A ; SAVE ERROR + JRST DELLO1 +] + +;TABLE OF REANMAE DEFAULTS +IFN ITS,[ +RNMTBL: IMQUOTE DEV + IMQUOTE NM1 + IMQUOTE NM2 + IMQUOTE SNM + +RNSTBL: SIXBIT /DSK _MUDS_> / +] +IFE ITS,[ +RNMTBL: SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + +RNSTBL: -1,,[ASCIZ /DSK/] + 0 + -1,,[ASCIZ /_MUDS_/] + -1,,[ASCIZ /MUD/] +] +; HERE TO DO A RENAME + +RNM1: JUMPGE AB,TMA ; IF ARGS EXHAUSTED, MUST BE TOO MUCH STRING + GETYP 0,(AB) + MOVE C,1(AB) ; GET ARG + CAIN 0,TATOM ; IS IT "TO" + CAME C,IMQUOTE TO + JRST WRONGT ; NO, LOSE + ADD AB,[2,,2] ; BUMP PAST "TO" + JUMPGE AB,TFA +IFN ITS,[ + MOVEM P,T.SPDL+1(TB) ; SAVE NEW P-BASE + + MOVEI 0,4 ; FOUR DEFAULTS + PUSH P,-3(P) ; DEFAULT DEVICE IS CURRENT + SOJN 0,.-1 + + PUSHJ P,RGPRS ; PARSE THE NEXT STRING + JRST TMA + + MOVE A,-7(P) ; FIX AND GET DEV1 + MOVE B,-3(P) ; SAME FOR DEV2 + CAME A,B ; SAME? + JRST DEVDIF + + POP P,A ; GET SNAME 2 + CAME A,(P)-3 ; SNAME 1 + JRST DEVDIF + .SUSET [.SSNAM,,A] + POP P,-2(P) ; MOVE NAMES DOWN + POP P,-2(P) + DOTCAL RENAME,[[17,,-4],[17,,-3],[17,,-2],A,[17,,-1],(P)] + JRST FDLST + JRST FDLWON + +; HERE FOR RENAME WHILE OPEN FOR WRITING + +CHNRNM: ADD AB,[2,,2] ; NEXT ARG + JUMPGE AB,TFA + MOVE B,-1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; SKIP IF OPEN + JRST BADCHN + MOVE A,DIRECT-1(B) ; CHECK DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A + CAME A,[SIXBIT /PRINT/] + CAMN A,[SIXBIT /PRINTB/] + JRST CHNRN1 + CAMN A,[SIXBIT /PRINAO/] + JRST CHNRM1 + CAME A,[SIXBIT /PRINTO/] + JRST WRONGD + +; SET UP .FDELE BLOCK + +CHNRN1: PUSH P,[0] + PUSH P,[0] + MOVEM P,T.SPDL+1(TB) + PUSH P,[0] + PUSH P,[SIXBIT /_MUDL_/] + PUSH P,[SIXBIT />/] + PUSH P,[0] + + PUSHJ P,RGPRS ; PARSE THESE + JRST TMA + + SUB P,[1,,1] ; SNAME/DEV IGNORED + MOVE AB,ABSAV(TB) ; GET ORIG ARG POINTER + MOVE B,1(AB) + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RENMWO,[A,[17,,-1],(P)] + JRST FDLST + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RFNAME,[A,[2017,,-4],[2017,,-3],[2017,,-2],[2017,,-1]] + JFCL + MOVE A,-3(P) ; UPDATE CHANNEL + PUSHJ P,6TOCHS ; GET A STRING + MOVE C,1(AB) + MOVEM A,RNAME1-1(C) + MOVEM B,RNAME1(C) + MOVE A,-2(P) + PUSHJ P,6TOCHS + MOVE C,1(AB) + MOVEM A,RNAME2-1(C) + MOVEM B,RNAME2(C) + MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS +] +IFE ITS,[ + PUSH P,A + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; PBASE BACK + PUSH A,[400000,,0] + MOVEI A,(A) + GTJFN + JRST TDLLOS + POP P,B + EXCH A,B + MOVEI C,(A) ; FOR RELEASE ATTEMPT + RNAMF + JRST RNMLOS + MOVEI A,(B) + RLJFN ; FLUSH JFN + JFCL + MOVEI A,(C) ; MAKE SURR OTHER IS FLUSHED + RLJFN + JFCL + JRST FDLWON + + +ADDNUL: PUSH TP,A + PUSH TP,B + MOVEI A,(A) ; LNTH OF STRING + IDIVI A,5 + JUMPN B,NONUAD ; DONT NEED TO ADD ONE + + PUSH TP,$TCHRS + PUSH TP,[0] + MOVEI A,2 + PUSHJ P,CISTNG ; COPY OF STRING + POPJ P, + +NONUAD: POP TP,B + POP TP,A + POPJ P, +] +; HERE FOR LOSING .FDELE + +IFN ITS,[ +FDLST: .STATUS 0,A ; GET STATUS +FDLST1: MOVEI B,0 + PUSHJ P,GFALS ; ANALYZE IT + JRST FINIS +] + +; SOME .FDELE ERRORS + +DEVDIF: ERRUUO EQUOTE DEVICE-OR-SNAME-DIFFERS + + ; HERE TO RESET A READ CHANNEL + +MFUNCTION FRESET,SUBR,RESET + + ENTRY 1 + GETYP A,(AB) + CAIE A,TCHAN + JRST WTYP1 + MOVE B,1(AB) ;GET CHANNEL + SKIPN IOINS(B) ; OPEN? + JRST REOPE1 ; NO, IGNORE CHECKS +IFN ITS,[ + MOVE A,STATUS(B) ;GET STATUS + ANDI A,77 + JUMPE A,REOPE1 ;IF IT CLOSED, JUST REOPEN IT, MAYBE? + CAILE A,2 ;SKIPS IF TTY FLAVOR + JRST REOPEN +] +IFE ITS,[ + MOVE A,CHANNO(B) + CAIE A,100 ; TTY-IN + CAIN A,101 ; TTY-OUT + JRST .+2 + JRST REOPEN +] + CAME B,TTICHN+1 + CAMN B,TTOCHN+1 + JRST REATTY +REATT1: MOVEI B,DIRECT-1(B) ;POINT TO DIRECTION + PUSHJ P,CHRWRD ;CONVERT TO A WORD + JFCL + CAME B,[ASCII /READ/] + JRST TTYOPN + MOVE B,1(AB) ;RESTORE CHANNEL + PUSHJ P,RRESET" ;DO REAL RESET + JRST TTYOPN + +REOPEN: PUSH TP,(AB) ;FIRST CLOSE IT + PUSH TP,(AB)+1 + MCALL 1,FCLOSE + MOVE B,1(AB) ;RESTORE CHANNEL + +; SET UP TEMPS FOR OPNCH + +REOPE1: PUSH P,[0] ; WILL HOLD DIR CODE + PUSH TP,$TPDL + PUSH TP,P + IRP A,,[DIRECT,RNAME1,RNAME2,RDEVIC,RSNAME,ACCESS] + PUSH TP,A-1(B) + PUSH TP,A(B) + TERMIN + + PUSH TP,$TCHAN + PUSH TP,1(AB) + + MOVE A,T.DIR(TB) + MOVE B,T.DIR+1(TB) ; GET DIRECTION + PUSHJ P,CHMOD ; CHECK THE MODE + MOVEM A,(P) ; AND STORE IT + +; NOW SET UP OPEN BLOCK IN SIXBIT + +IFN ITS,[ + MOVSI E,-4 ; AOBN PNTR +FRESE2: MOVE B,T.CHAN+1(TB) + MOVEI A,@RDTBL(E) ; GET ITEM POINTER + GETYP 0,-1(A) ; GET ITS TYPE + CAIE 0,TCHSTR + JRST FRESE1 + MOVE B,(A) ; GET STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 +FRESE3: AOBJN E,FRESE2 +] +IFE ITS,[ + MOVE B,T.CHAN+1(TB) + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; RESULT ON STACK + HLRZS (P) +] + + PUSH P,[0] ; PUSH UP SOME DUMMIES + PUSH P,[0] + PUSH P,[0] + PUSHJ P,OPNCH ; ATTEMPT TO DO THEOPEN + GETYP 0,A + CAIE 0,TCHAN + JRST FINIS ; LEAVE IF FALSE OR WHATEVER + +DRESET: MOVE A,(AB) + MOVE B,1(AB) + SETZM CHRPOS(B) ;INITIALIZE THESE PARAMETERS + SETZM LINPOS(B) + SETZM ACCESS(B) + JRST FINIS + +TTYOPN: +IFN ITS,[ + MOVE B,1(AB) + CAME B,TTOCHN+1 + CAMN B,TTICHN+1 + PUSHJ P,TTYOP2 + PUSHJ P,DOSTAT + DOTCAL RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]] + .LOSE %LSSYS + MOVEM C,PAGLN(B) + MOVEM D,LINLN(B) +] + JRST DRESET + +IFN ITS,[ +FRESE1: CAIE 0,TFIX + JRST BADCHN + PUSH P,(A) + JRST FRESE3 +] + +; INTERFACE TO REOPEN CLOSED CHANNELS + +OPNCHN: PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FRESET + POPJ P, + +REATTY: PUSHJ P,TTYOP2 +IFE ITS, SKIPN DEMFLG ; SKIP IF DEMONFLAG IS ON + SKIPE NOTTY + JRST DRESET + MOVE B,1(AB) + JRST REATT1 + +; FUNCTION TO LIST ALL CHANNELS + +MFUNCTION CHANLIST,SUBR + + ENTRY 0 + + MOVEI A,N.CHNS-1 ;MAX # OF REAL CHANNELS + MOVEI C,0 + MOVEI B,CHNL1 ;POINT TO FIRST REAL CHANNEL + +CHNLP: SKIPN 1(B) ;OPEN? + JRST NXTCHN ;NO, SKIP + HRRE E,(B) ; ABOUT TO FLUSH? + JUMPL E,NXTCHN ; YES, FORGET IT + MOVE D,1(B) ; GET CHANNEL + HRRZ E,CHANNO-1(D) ; GET REF COUNT + PUSH TP,(B) + PUSH TP,1(B) + ADDI C,1 ;COUNT WINNERS + SOJGE E,.-3 ; COUNT THEM +NXTCHN: ADDI B,2 + SOJN A,CHNLP + + SKIPN B,CHNL0+1 ;NOW HACK LIST OF PSUEDO CHANNELS + JRST MAKLST +CHNLS: PUSH TP,(B) + PUSH TP,(B)+1 + ADDI C,1 + HRRZ B,(B) + JUMPN B,CHNLS + +MAKLST: ACALL C,LIST + JRST FINIS + + ; ROUTINE TO RESTORE A CLOSED CHANNEL TO ITS PREVIOUS STATE + + +REOPN: PUSH TP,$TCHAN + PUSH TP,B + SKIPN CHANNO(B) ; ONLY REAL CHANNELS + JRST PSUEDO + +IFN ITS,[ + MOVSI E,-4 ; SET UP POINTER FOR NAMES + +GETOPB: MOVE B,(TP) ; GET CHANNEL + MOVEI A,@RDTBL(E) ; GET POINTER + MOVE B,(A) ; NOW STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 ; LEAVES SIXBIT ON STACK + AOBJN E,GETOPB +] +IFE ITS,[ + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; GET DEV NAME IN SIXBIT +] + MOVE B,(TP) ; RESTORE CHANNEL + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,CHMOD ; CHECK FOR A VALID MODE + +IFN ITS, MOVE E,-3(P) ; GET DEVICE IN PROPER PLACE +IFE ITS, HLRZS E,(P) + MOVE B,(TP) ; RESTORE CHANNEL +IFN ITS, CAMN E,[SIXBIT /DSK /] +IFE ITS,[ + CAIE E,(SIXBIT /PS /) + CAIN E,(SIXBIT /DSK/) + JRST DISKH ; DISK WINS IMMEIDATELY + CAIE E,(SIXBIT /SS /) + CAIN E,(SIXBIT /SRC/) + JRST DISKH ; DISK WINS IMMEIDATELY +] +IFN ITS, CAMN E,[SIXBIT /TTY /] ; NO NEED TO RE-OPEN THE TTY +IFE ITS, CAIN E,(SIXBIT /TTY/) + JRST REOPD1 +IFN ITS,[ + AND E,[777700,,0] ; COULD BE "UTn" + MOVE D,CHANNO(B) ; GET CHANNEL + ASH D,1 + ADDI D,CHNL0 ; DON'T SEEM TO BE OPEN + SETZM 1(D) + SETZM CHANNO(B) + CAMN E,[SIXBIT /UT /] + JRST REOPD ; CURRENTLY, CANT RESTORE UTAPE CHANNLES + CAMN E,[SIXBIT /AI /] + JRST REOPD ; CURRENTLY CANT RESTORE AI CHANNELS + CAMN E,[SIXBIT /ML /] + JRST REOPD ; CURRENTLY CANT RESTORE ML CHANNELS + CAMN E,[SIXBIT /DM /] + JRST REOPD ; CURRENTLY CANT RESTORE DM CHANNELS +] + PUSH TP,$TCHAN ; TRY TO RESET IT + PUSH TP,B + MCALL 1,FRESET + +IFN ITS,[ +REOPD1: AOS -4(P) +REOPD: SUB P,[4,,4] +] +IFE ITS,[ +REOPD1: AOS -1(P) +REOPD: SUB P,[1,,1] +] +REOPD0: SUB TP,[2,,2] + POPJ P, + +IFN ITS,[ +DISKH: MOVE C,(P) ; SNAME + .SUSET [.SSNAM,,C] +] +IFE ITS,[ +DISKH: MOVEM A,(P) ; SAVE MODE WORD + PUSHJ P,STSTK ; STRING TO STACK + MOVE A,(E) ; RESTORE MODE WORD + PUSH TP,$TPDL + PUSH TP,E ; SAVE PDL BASE + MOVE B,-2(TP) ; CHANNEL BACK TO B +] + MOVE C,ACCESS(B) ; GET CHANNELS ACCESS + TRNN A,2 ; SKIP IF NOT ASCII CHANNEL + JRST DISKH1 + HRRZ D,ACCESS-1(B) ; IF PARTIAL WORD OUT + IMULI C,5 ; TO CHAR ACCESS + JUMPE D,DISKH1 ; NO SWEAT + ADDI C,(D) + SUBI C,5 +DISKH1: HRRZ D,BUFSTR-1(B) ; ANY CHARS IN MUDDLE BUFFER + JUMPE D,DISKH2 + TRNN A,1 ; SKIP IF OUTPUT CHANNEL + JRST DISKH2 + PUSH P,A + PUSH P,C + MOVEI C,BUFSTR-1(B) + PUSHJ P,BYTDOP ; FIND LENGTH OF WHOLE BUFFER + HLRZ D,(A) ; LENGTH + 2 TO D + SUBI D,2 + IMULI D,5 ; TO CHARS + SUB D,BUFSTR-1(B) + POP P,C + POP P,A +DISKH2: SUBI C,(D) ; UPDATE CHAR ACCESS + IDIVI C,5 ; BACK TO WORD ACCESS +IFN ITS,[ + IORI A,6 ; BLOCK IMAGE + TRNE A,1 + IORI A,100000 ; WRITE OVER BIT + PUSHJ P,DOOPN + JRST REOPD + MOVE A,C ; ACCESS TO A + PUSHJ P,GETFLN ; CHECK LENGTH + CAIGE 0,(A) ; CHECK BOUNDS + JRST .+3 ; COMPLAIN + PUSHJ P,DOACCS ; AND ACESS + JRST REOPD1 ; SUCCESS + + MOVE A,CHANNO(B) ; CLOSE THE G.D. CHANNEL + PUSHJ P,MCLOSE + JRST REOPD + +DOACCS: PUSH P,A + HRRZ A,CHANNO(B) + DOTCAL ACCESS,[A,(P)] + JFCL + POP P,A + POPJ P, + +DOIOTO: +DOIOTI: +DOIOT: + PUSH P,0 + MOVSI 0,TCHAN + MOVE PVP,PVSTOR+1 + MOVEM 0,BSTO(PVP) ; IN CASE OF INTERRUPT + ENABLE + HRRZ 0,CHANNO(B) + DOTCAL IOT,[0,A] + JFCL + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + POP P,0 + POPJ P, + +GETFLN: MOVE 0,CHANNO(B) ; GET CHANNEL + .CALL FILBLK ; READ LNTH + .VALUE + POPJ P, + +FILBLK: SETZ + SIXBIT /FILLEN/ + 0 + 402000,,0 ; STUFF RESULT IN 0 +] +IFE ITS,[ + MOVEI A,CHNL0 + ADD A,CHANNO(B) + ADD A,CHANNO(B) + SETZM 1(A) ; MAY GET A DIFFERENT JFN + HRROI B,1(E) ; TENEX STRING POINTER + MOVSI A,400001 ; MAKE SURE + GTJFN ; GO GET IT + JRST RGTJL ; COMPLAIN + MOVE D,-2(TP) + HRRZM A,CHANNO(D) ; COULD HAVE CHANGED + MOVE P,(TP) ; RESTORE P + MOVEI B,CHNL0 + ASH A,1 ; MUNG ITS SLOT + ADDI A,(B) + MOVEM D,1(A) + HLLOS (A) ; MARK CHANNEL NOT TO BE RELOOKED AT + MOVE A,(P) ; MODE WORD BACK + MOVE B,[440000,,200000] ; FLAG BITS + TRNE A,1 ; SKIP FOR INPUT + TRC B,300000 ; CHANGE TO WRITE + MOVE A,CHANNO(D) ; GET JFN + OPENF + JRST ROPFLS + MOVE E,C ; LENGTH TO E + SIZEF ; GET CURRENT LENGTH + JRST ROPFLS + CAMGE B,E ; STILL A WINNER + JRST ROPFLS + MOVE A,CHANNO(D) ; JFN + MOVE B,C + SFPTR + JRST ROPFLS + SUB TP,[2,,2] ; FLUSH PDL POINTER + JRST REOPD1 + +ROPFLS: MOVE A,-2(TP) + MOVE A,CHANNO(A) + CLOSF ; ATTEMPT TO CLOSE + JFCL ; IGNORE FAILURE + SKIPA + +RGTJL: MOVE P,(TP) + SUB TP,[2,,2] + JRST REOPD + +DOACCS: PUSH P,B + EXCH A,B + MOVE A,CHANNO(A) + SFPTR + JRST ACCFAI + POP P,B + POPJ P, +] +PSUEDO: AOS (P) ; ASSUME SUCCESS FOR NOW + MOVEI B,RDEVIC-1(B) ; SEE WHAT DEVICE IS + PUSHJ P,CHRWRD + JFCL + JRST REOPD0 ; NO, RETURN HAPPY +IFN 0,[ CAME B,[ASCII /E&S/] ; DISPLAY ? + CAMN B,[ASCII /DIS/] + SKIPA B,(TP) ; YES, REGOBBLE CHANNEL AND CONTINUE + JRST REOPD0 ; NO, RETURN HAPPY + PUSHJ P,DISROP + SOS (P) ; DISPLAY DID NOT REOPEN, UNDO ASSUMPTION OF SUCCESS + JRST REOPD0] + + ;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL + +MFUNCTION FCLOSE,SUBR,[CLOSE] + + ENTRY 1 ;ONLY ONE ARG + GETYP A,(AB) ;CHECK ARGS + CAIE A,TCHAN ;IS IT A CHANNEL + JRST WTYP1 + MOVE B,1(AB) ;PICK UP THE CHANNEL + HRRZ A,CHANNO-1(B) ; GET REF COUNT + SOJGE A,CFIN5 ; NOT READY TO REALLY CLOSE + CAME B,TTICHN+1 ; CHECK FOR TTY + CAMN B,TTOCHN+1 + JRST CLSTTY + MOVE A,[JRST CHNCLS] + MOVEM A,IOINS(B) ;CLOBBER THE IO INS + MOVE A,RDEVIC-1(B) ;GET THE NAME OF THE DEVICE + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 +IFN ITS, MOVE A,(P) +IFE ITS, HLRZS A,(P) + MOVE B,1(AB) ; RESTORE CHANNEL +IFN 0,[ + CAME A,[SIXBIT /E&S /] + CAMN A,[SIXBIT /DIS /] + PUSHJ P,DISCLS] + MOVE B,1(AB) ; IN CASE CLOBBERED BY DISCLS + SKIPN A,CHANNO(B) ;ANY REAL CHANNEL? + JRST REMOV ; NO, EITHER CLOSED OR PSEUDO CHANNEL + + MOVE A,DIRECT-1(B) ; POINT TO DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; CONVERT TO WORD + POP P,A +IFN ITS, LDB E,[360600,,(P)] ; FIRST CHAR OD DEV NAME +IFE ITS, LDB E,[140600,,(P)] ; FIRST CHAR OD DEV NAME + CAIE E,'T ; SKIP IF TTY + JRST CFIN4 + CAME A,[SIXBIT /READ/] ; SKIP IF WINNER + JRST CFIN1 +IFN ITS,[ + MOVE B,1(AB) ; IN ITS CHECK STATUS + LDB A,[600,,STATUS(B)] + CAILE A,2 + JRST CFIN1 +] + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE CHAR + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,OFF ; TURN OFF INTERRUPT +CFIN1: MOVE B,1(AB) + MOVE A,CHANNO(B) +IFN ITS,[ + PUSHJ P,MCLOSE +] +IFE ITS,[ + TLZ A,400000 ; FOR JFN RELEASE + CLOSF ; CLOSE THE FILE AND RELEASE THE JFN + JFCL + MOVE A,CHANNO(B) +] +CFIN: LSH A,1 + ADDI A,CHNL0+1 ;POINT TO THIS CHANNELS LSOT + SETZM CHANNO(B) + SETZM (A) ;AND CLOBBER IT + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) + HLLZS ACCESS-1(B) +CFIN2: HLLZS -2(B) + MOVSI A,TCHAN ;RETURN THE CHANNEL + JRST FINIS + +CLSTTY: ERRUUO EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL + + +REMOV: MOVEI D,CHNL0+1 ;ATTEMPT TO REMOVE FROM PSUEDO CHANNEL LIST +REMOV0: SKIPN C,D ;FOUND ON LIST ? + JRST CFIN2 ;NO, JUST IGNORE THIS CLOSED CHANNEL + HRRZ D,(C) ;GET POINTER TO NEXT + CAME B,(D)+1 ;FOUND ? + JRST REMOV0 + HRRZ D,(D) ;YES, SPLICE IT OUT + HRRM D,(C) + JRST CFIN2 + + +; CLOSE UP ANY LEFTOVER BUFFERS + +CFIN4: +; CAME A,[SIXBIT /PRINTO/] +; CAMN A,[SIXBIT /PRINTB/] +; JRST .+3 +; CAME A,[SIXBIT /PRINT/] +; JRST CFIN1 + MOVE B,1(AB) ; GET CHANNEL + HRRZ A,-2(B) ;GET MODE BITS + TRNN A,C.PRIN + JRST CFIN1 + GETYP 0,BUFSTR-1(B) ; IS THERE AN OUTPUT BUFFER + SKIPN BUFSTR(B) + JRST CFIN1 + CAIE 0,TCHSTR + JRST CFINX1 + PUSHJ P,BFCLOS +IFE ITS,[ + MOVE A,CHANNO(B) + MOVEI B,7 + SFBSZ + JFCL + CLOSF + JFCL +] + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) +CFINX1: HLLZS ACCESS-1(B) + JRST CFIN1 + +CFIN5: HRRM A,CHANNO-1(B) + JRST CFIN2 + ;SUBR TO DO .ACCESS ON A READ CHANNEL +;FORM: +;POSITIONS CHANNEL AT CHARACTER POSN FIX-NUMBER +;H. BRODIE 7/26/72 + +MFUNCTION MACCESS,SUBR,[ACCESS] + ENTRY 2 ;ARGS: CHANNEL AND FIX-NUMBER + +;CHECK ARGUMENT TYPES + GETYP A,(AB) + CAIE A,TCHAN ;FIRST ARG SHOULD BE CHANNEL + JRST WTYP1 + GETYP A,2(AB) ;TYPE OF SECOND + CAIE A,TFIX ;SHOULD BE FIX + JRST WTYP2 + +;CHECK DIRECTION OF CHANNEL + MOVE B,1(AB) ;B GETS PNTR TO CHANNEL +; MOVEI B,DIRECT-1(B) ;GET DIRECTION OF CHANNEL +; PUSHJ P,CHRWRD ;GRAB THE CHAR STRNG +; JFCL +; CAME B,[+1] + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.PRIN + JRST MACCA + MOVE B,1(AB) + SKIPE C,BUFSTR(B) ;SEE IF WE MUST FLUSH PART BUFFER + PUSHJ P,BFCLOS + JRST MACC +MACCA: +; CAMN B,[ASCIZ /READ/] +; JRST .+4 +; CAME B,[ASCIZ /READB/] ; READB CHANNEL? +; JRST WRONGD +; AOS (P) ; SET INDICATOR FOR BINARY MODE + +;CHECK THAT THE CHANNEL IS OPEN +MACC: MOVE B,1(AB) ;GET BACK PTR TO CHANNEL + HRRZ E,-2(B) + TRNN E,C.OPN + JRST CHNCLS ;IF CHNL CLOSED => ERROR + +;COMPUTE ACCESS PNTR TO ACCESS WORD CHAR IS IN +;REMAINDER IS NUMBER OF TIMES TO INCR BYTE POINTER +ADEVOK: SKIPGE C,3(AB) ;GET CHAR POSN + ERRUUO EQUOTE NEGATIVE-ARGUMENT +MACC1: MOVEI D,0 + TRNN E,C.BIN ; SKIP FOR BINARY FILE + IDIVI C,5 + +;SETUP THE .ACCESS + TRNN E,C.PRIN + JRST NLSTCH + HRRZ 0,LSTCH-1(B) + MOVE A,ACCESS(B) + TRNN E,C.BIN + JRST LSTCH1 + IMULI A,5 + ADD A,ACCESS-1(B) + ANDI A,-1 +LSTCH1: CAIG 0,(A) + MOVE 0,A + MOVE A,C + IMULI A,5 + ADDI A,(D) + CAML A,0 + MOVE 0,A + HRRM 0,LSTCH-1(B) ; UPDATE "LARGEST" +NLSTCH: MOVE A,CHANNO(B) ;A GETS REAL CHANNEL NUMBER +IFN ITS,[ + DOTCAL ACCESS,[A,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + +IFE ITS,[ + MOVE B,C + SFPTR ; DO IT IN TENEX + JRST ACCFAI + MOVE B,1(AB) ; RESTORE CHANNEL +] +; POP P,E ; CHECK FOR READB MODE + TRNN E,C.READ + JRST ACCOUT ; PRINT TYPE CHANNEL, GO DO IT + SKIPE BUFSTR(B) ; IS THERE A READ BUFFER TO FLUSH + JRST .+3 + SETZM LSTCH(B) ; CLEAR OUT POSSIBLE EOF INDICATOR + JRST DONADV + +;NOW FORCE GETCHR TO DO A .IOT FIRST THING + MOVEI C,BUFSTR-1(B) ; FIND END OF STRING + PUSHJ P,BYTDOP" + SUBI A,2 ; LAST REAL WORD + HRLI A,010700 + MOVEM A,BUFSTR(B) + HLLZS BUFSTR-1(B) ; CLOBBER CHAR COUNT + SETZM LSTCH(B) ;CLOBBER READ'S HIDDEN CHARACTER + +;NOW DO THE APPROPRIATE NUM OF BYTE ADVANCEMENTS + JUMPLE D,DONADV +ADVPTR: PUSHJ P,GETCHR + MOVE B,1(AB) ;RESTORE IN CASE CLOBBERED + SOJG D,ADVPTR + +DONADV: MOVE C,3(AB) ;FIXUP ACCESS SLOT IN CHNL + HLLZS ACCESS-1(B) + MOVEM C,ACCESS(B) + MOVE A,$TCHAN ;TYPE OF RESULT = "CHANNEL" + JRST FINIS ;DONE...B CONTAINS CHANNEL + +IFE ITS,[ +ACCFAI: ERRUUO EQUOTE ACCESS-FAILURE +] +ACCOUT: SKIPN C,BUFSTR(B) ; FIXUP BUFFER? + JRST ACCOU1 + HRRZ F,BUFSTR-1(B) + ADD F,[-BUFLNT*5-4] + IDIVI F,5 + ADD F,BUFSTR(B) + HRLI F,010700 + MOVEM F,BUFSTR(B) + MOVEI F,BUFLNT*5 + HRRM F,BUFSTR-1(B) +ACCOU1: TRNE E,C.BIN ; FINISHED FOR BINARY CHANNELS + JRST DONADV + + JUMPE D,DONADV ; THIS CASE OK +IFE ITS,[ + MOVE A,CHANNO(B) ; GET LAST WORD + RFPTR + JFCL + PUSH P,B + MOVNI C,1 + MOVE B,[444400,,E] ; READ THE WORD + SIN + JUMPL C,ACCFAI + POP P,B + SFPTR + JFCL + MOVE B,1(AB) ; CHANNEL BACK + MOVE C,[440700,,E] + ILDB 0,C + IDPB 0,BUFSTR(B) + SOS BUFSTR-1(B) + SOJG D,.-3 + JRST DONADV +] +IFN ITS, ERRUUO EQUOTE CANT-ACCESS-ASCII-ON-ITS + + +;WRONG TYPE OF DEVICE ERROR +WRDEV: ERRUUO EQUOTE NON-DSK-DEVICE + +; BINARY READ AND PRINT ROUTINES + +MFUNCTION PRINTB,SUBR + + ENTRY + +PBFL: PUSH P,. ; PUSH NON-ZERONESS + MOVEI A,-7 + JRST BINI1 + +MFUNCTION READB,SUBR + + ENTRY + + PUSH P,[0] + MOVEI A,-11 +BINI1: HLRZ 0,AB + CAILE 0,-3 + JRST TFA + CAIG 0,(A) + JRST TMA + + GETYP 0,(AB) ; SHOULD BE UVEC OR STORE + CAIE 0,TSTORAGE + CAIN 0,TUVEC + JRST BINI2 + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTOK + JRST WTYP1 ; ELSE LOSE +BINI2: MOVE B,1(AB) ; GET IT + HLRE C,B + SUBI B,(C) ; POINT TO DOPE + GETYP A,(B) + PUSHJ P,SAT" ; GET ITS ST.ALOC.TYPE + CAIE A,S1WORD + JRST WTYP1 +BYTOK: GETYP 0,2(AB) + CAIE 0,TCHAN ; BETTER BE A CHANNEL + JRST WTYP2 + MOVE B,3(AB) ; GET IT +; MOVEI B,DIRECT-1(B) ; GET DIRECTION OF +; PUSHJ P,CHRWRD ; INTO 1 WORD +; JFCL +; MOVNI E,1 +; CAMN B,[ASCII /READB/] +; MOVEI E,0 +; CAMN B,[+1] + HRRZ A,-2(B) ; MODE BITS + TRNN A,C.BIN ; IF NOT BINARY + JRST WRONGD + MOVEI E,0 + TRNE A,C.PRIN + MOVE E,PBFL +; JUMPL E,WRONGD ; LOSER + CAME E,(P) ; CHECK WINNGE + JRST WRONGD + MOVE B,3(AB) ; GET CHANNEL BACK + SKIPN A,IOINS(B) ; OPEN? + PUSHJ P,OPENIT ; LOSE + CAMN A,[JRST CHNCLS] + JRST CHNCLS ; LOSE, CLOSED + JUMPN E,BUFOU1 ; JUMP FOR OUTPUT + MOVEI C,0 + CAML AB,[-5,,] ; SKIP IF EOF GIVEN + JRST BINI5 + MOVE 0,4(AB) + MOVEM 0,EOFCND-1(B) + MOVE 0,5(AB) + MOVEM 0,EOFCND(B) + CAML AB,[-7,,] + JRST BINI5 + GETYP 0,6(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,7(AB) +BINI5: SKIPE LSTCH(B) ; INDICATES IF EOF HIT + JRST BINEOF + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTI + MOVE A,1(AB) ; GET VECTOR + PUSHJ P,PGBIOI ; READ IT + HLRE C,A ; GET COUNT DONE + HLRE D,1(AB) ; AND FULL COUNT + SUB C,D ; C=> TOTAL READ + ADDM C,ACCESS(B) + JUMPGE A,BINIOK ; NOT EOF YET + SETOM LSTCH(B) +BINIOK: MOVE B,C + MOVSI A,TFIX ; RETURN AMOUNT ACTUALLY READ + JRST FINIS + +BYTI: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-LOST + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-LOST + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE STRING LENGTH + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 + PUSH P,C + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SIN] + PUSHJ P,PGBIOT + HLRE C,A ; GET COUNT DONE + POP P,D + SKIPN D + HRRZ D,(AB) ; AND FULL COUNT + ADD D,C ; C=> TOTAL READ + LDB E,[300600,,1(AB)] + MOVEI A,36. + IDIVM A,E + IDIVM D,E + ADDM E,ACCESS(B) + SKIPGE C ; NOT EOF YET + SETOM LSTCH(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-LOST + MOVE C,D + JRST BINIOK +] +BUFOU1: SKIPE BUFSTR(B) ; ANY BUFFERS AROUND? + PUSHJ P,BFCLS1 ; GET RID OF SAME + MOVEI C,0 + CAML AB,[-5,,] + JRST BINO5 + GETYP 0,4(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,5(AB) +BINO5: MOVE A,1(AB) + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTO + PUSHJ P,PGBIOO + HLRE C,1(AB) + MOVNS C + ADDM C,ACCESS(B) +BYTO1: MOVE A,(AB) ; RET VECTOR ETC. + MOVE B,1(AB) + JRST FINIS + +BYTO: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-FAILURE + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-FAILURE + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE SIZE + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 ; COMPENSATE FOR PGBIOT DOING THE WRONG THING + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SOUT] + PUSHJ P,PGBIOT + LDB D,[300600,,1(AB)] + MOVEI C,36. + IDIVM C,D + HRRZ C,(AB) + IDIVI C,(D) + ADDM C,ACCESS(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-FAILURE + JRST BYTO1 +] + +BINEOF: PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOSER + MCALL 1,EVAL + JRST FINIS + +OPENIT: PUSH P,E + PUSHJ P,OPNCHN ;TRY TO OPEN THE LOSER + JUMPE B,CHNCLS ;FAIL + POP P,E + POPJ P, + ; THESE SUBROUTINES BY NDR 9/16/73 TO FACILITATE THE +; TYPES OF IO NECESSARY TO MAKE MORE EFFICIENT USE OF +; THE NETWORK AND DO RELATED FILE TRANSFER TYPE OF JOBS. + +R1CHAR: SKIPN A,LSTCH(B) ; CHAR READING ROUTINE FOR FCOPY + PUSHJ P,RXCT + TLO A,200000 ; ^@ BUG + MOVEM A,LSTCH(B) + TLZ A,200000 + JUMPL A,.+2 ; IN CASE OF -1 ON STY + TRZN A,400000 ; EXCL HACKER + JRST .+4 + MOVEM A,LSTCH(B) ; SAVE DE-EXCLED CHAR + MOVEI A,"! + JRST .+2 + SETZM LSTCH(B) + PUSH P,C + HRRZ C,DIRECT-1(B) + CAIE C,5 ; IF DIRECTION IS 5 LONG THEN READB + JRST R1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) ; EVERY FIFTY INCREMENT + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +R1CH1: AOS ACCESS(B) + POP P,C + POPJ P, + +W1CHAR: CAIE A,15 ; CHAR WRITING ROUTINE, TEST FOR CR + JRST .+3 + SETOM CHRPOS(B) + AOSA LINPOS(B) + CAIE A,12 ; TEST FOR LF + AOS CHRPOS(B) ; IF NOT LF AOS CHARACTE5R POSITION + CAIE A,14 ; TEST FOR FORM FEED + JRST .+3 + SETZM CHRPOS(B) ; IF FORM FEED ZERO CHARACTER POSITION + SETZM LINPOS(B) ; AND LINE POSITION + CAIE A,11 ; IS THIS A TAB? + JRST .+6 + MOVE C,CHRPOS(B) + ADDI C,7 + IDIVI C,8. + IMULI C,8. ; FIX UP CHAR POS FOR TAB + MOVEM C,CHRPOS(B) ; AND SAVE + PUSH P,C + HRRZ C,-2(B) ; GET BITS + TRNN C,C.BIN ; SIX LONG MUST BE PRINTB + JRST W1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +W1CH1: AOS ACCESS(B) + PUSH P,A + PUSHJ P,WXCT + POP P,A + POP P,C + POPJ P, + +R1C: SUBM M,(P) ;LITTLE ENTRY FOR COMPILED STUFF +; PUSH TP,$TCHAN ;SAVE THE CHANNEL TO BLESS IT +; PUSH TP,B +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JFCL +; CAME B,[ASCIZ /READ/] +; CAMN B,[ASCII /READB/] +; JRST .+2 +; JRST BADCHN + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.READ + JRST BADCHN + SKIPN IOINS(B) ; IS THE CHANNEL OPEN + PUSHJ P,OPENIT ; NO, GO DO IT + PUSHJ P,GRB ; MAKE SURE WE HAVE A READ BUFFER + PUSHJ P,R1CHAR ; AND GET HIM A CHARACTER + JRST MPOPJ ; THATS ALL FOLKS + +W1C: SUBM M,(P) + PUSHJ P,W1CI + JRST MPOPJ + +W1CI: +; PUSH TP,$TCHAN +; PUSH TP,B + PUSH P,A ; ASSEMBLER ENTRY TO OUTPUT 1 CHAR +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; INTERNAL CALL TO W1CHAR +; JFCL +; CAME B,[ASCII /PRINT/] +; CAMN B,[+1] +; JRST .+2 +; JRST BADCHN +; POP TP,B +; POP TP,(TP) + HRRZ A,-2(B) + TRNN A,C.PRIN + JRST BADCHN + SKIPN IOINS(B) ; MAKE SURE THAT IT IS OPEN + PUSHJ P,OPENIT + PUSHJ P,GWB + POP P,A ; GET THE CHAR TO DO + JRST W1CHAR + +; ROUTINES TO REPLACE XCT IOINS(B) FOR INPUT AND OUTPUT +; THEY DO THE XCT THEN CHECK OUT POSSIBLE SCRIPTAGE--BLECH. + + +WXCT: +RXCT: XCT IOINS(B) ; READ IT + SKIPN SCRPTO(B) + POPJ P, + +DOSCPT: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; AND SAVE THE CHAR AROUND + + SKIPN SCRPTO(B) ; IF ZERO FORGET IT + JRST SCPTDN ; THATS ALL THERE IS TO IT + PUSH P,C ; SAVE AN ACCUMULATOR FOR CLEANLINESS + GETYP C,SCRPTO-1(B) ; IS IT A LIST + CAIE C,TLIST + JRST BADCHN + PUSH TP,$TLIST + PUSH TP,[0] ; SAVE A SLOT FOR THE LIST + MOVE C,SCRPTO(B) ; GET THE LIST OF SCRIPT CHANNELS +SCPT1: GETYP B,(C) ; GET THE TYPE OF THIS SCRIPT CHAN + CAIE B,TCHAN + JRST BADCHN ; IF IT ISN'T A CHANNEL, COMPLAIN + HRRZ B,(C) ; GET THE REST OF THE LIST IN B + MOVEM B,(TP) ; AND STORE ON STACK + MOVE B,1(C) ; GET THE CHANNEL IN B + MOVE A,-1(P) ; AND THE CHARACTER IN A + PUSHJ P,W1CI ; GO TO INTERNAL W1C, IT BLESSES GOODIES + SKIPE C,(TP) ; GET THE REST OF LIST OF CHANS + JRST SCPT1 ; AND CYCLE THROUGH + SUB TP,[2,,2] ; CLEAN OFF THE LIST OF CHANS + POP P,C ; AND RESTORE ACCUMULATOR C +SCPTDN: POP P,A ; RESTORE THE CHARACTER + POP TP,B ; AND THE ORIGINAL CHANNEL + POP TP,(TP) + POPJ P, ; AND THATS ALL + + +; SUBROUTINE TO COPY FROM INCHAN TO OUTCHAN UNTIL EOF HIT +; ON THE INPUT CHANNEL +; CALL IS WHERE DEFAULTS ARE INCHAN AND OUTCHAN + + MFUNCTION FCOPY,SUBR,[FILECOPY] + + ENTRY + HLRE 0,AB + CAMGE 0,[-4] + JRST WNA ; TAKES FROM 0 TO 2 ARGS + + JUMPE 0,.+4 ; NO FIRST ARG? + PUSH TP,(AB) + PUSH TP,1(AB) ; SAVE IN CHAN + JRST .+6 + MOVE A,$TATOM + MOVE B,IMQUOTE INCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B + HLRE 0,AB ; CHECK FOR SECOND ARG + CAML 0,[-2] ; WAS THERE MORE THAN ONE ARG? + JRST .+4 + PUSH TP,2(AB) ; SAVE SECOND ARG + PUSH TP,3(AB) + JRST .+6 + MOVE A,$TATOM ; LOOK UP OUTCHAN AS DEFAULT + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B ; AND SAVE IT + + MOVE A,-3(TP) + MOVE B,-2(TP) ; INPUT CHANNEL + MOVEI 0,C.READ ; INDICATE INPUT + PUSHJ P,CHKCHN ; CHECK FOR GOOD CHANNEL + MOVE A,-1(TP) + MOVE B,(TP) ; GET OUT CHAN + MOVEI 0,C.PRIN ; INDICATE OUT CHAN + PUSHJ P,CHKCHN ; CHECK FOR GOOD OUT CHAN + + PUSH P,[0] ; COUNT OF CHARS OUTPUT + + MOVE B,-2(TP) + PUSHJ P,GRB ; MAKE SURE WE HAVE READ BUFF + MOVE B,(TP) + PUSHJ P,GWB ; MAKE SURE WE HAVE WRITE BUFF + +FCLOOP: INTGO + MOVE B,-2(TP) + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,FCDON ; IF A NEG NUMBER WE GOT EOF + MOVE B,(TP) ; GET OUT CHAN + PUSHJ P,W1CHAR ; SPIT IT OUT + AOS (P) ; INCREMENT COUNT + JRST FCLOOP + +FCDON: SUB TP,[2,,2] ; POP OFF OUTCHAN + MCALL 1,FCLOSE ; CLOSE INCHAN + MOVE A,$TFIX + POP P,B ; GET CHAR COUNT TO RETURN + JRST FINIS + +CHKCHN: PUSH P,0 ; CHECK FOR GOOD TASTING CHANNEL + PUSH TP,A + PUSH TP,B + GETYP C,A + CAIE C,TCHAN + JRST CHKBDC ; GO COMPLAIN IN RIGHT WAY +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JRST CHKBDC +; MOVE C,(P) ; GET CHAN DIRECT + HRRZ C,-2(B) ; MODE BITS + TDNN C,0 + JRST CHKBDC +; CAMN B,CHKT(C) +; JRST .+4 +; ADDI C,2 ; TEST FOR READB OR PRINTB ALSO +; CAME B,CHKT(C) ; TEST FOR CORRECT DIRECT +; JRST CHKBDC + MOVE B,(TP) + SKIPN IOINS(B) ; MAKE SURE IT IS OPEN + PUSHJ P,OPENIT ; IF ZERO IOINS GO OPEN IT + SUB TP,[2,,2] + POP P, ; CLEAN UP STACKS + POPJ P, + +CHKT: ASCIZ /READ/ + ASCII /PRINT/ + ASCII /READB/ + +1 + +CHKBDC: POP P,E + MOVNI D,2 + IMULI D,1(E) + HLRE 0,AB + CAMLE 0,D ; SEE IF THIS WAS HIS ARG OF DEFAULT + JRST BADCHN + JUMPE E,WTYP1 + JRST WTYP2 + + ; FUNCTIONS READSTRING AND PRINTSTRING WORK LIKE READB AND PRINTB, +; THAT IS THEY READ INTO AND OUT OF STRINGS. IN ADDITION BOTH ACCEPT +; AN ADDITIONAL ARGUMENT WHICH IS THE NUMBER OF CHARS TO READ OR PRINT, IF +; IT IS DESIRED FOR THIS TO BE DIFFERENT THAN THE LENGTH OF THE STRING. + +; FORMAT IS +; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN + +; FORMAT FOR PRINTSTRING IS + +; THESE WERE CODED 9/16/73 BY NEAL D. RYAN + + MFUNCTION RSTRNG,SUBR,READSTRING + + ENTRY + PUSH P,[0] ; FLAG TO INDICATE READING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-9] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 4 ARGS + JRST STRIO1 + + MFUNCTION PSTRNG,SUBR,PRINTSTRING + + ENTRY + PUSH P,[1] ; FLAG TO INDICATE WRITING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-7] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 3 ARGS + +STRIO1: PUSH TP,[0] ; SAVE SLOT ON STACK + PUSH TP,[0] + GETYP 0,(AB) + CAIE 0,TCHSTR ; MAKE SURE WE GOT STRING + JRST WTYP1 + HRRZ 0,(AB) ; CHECK FOR EMPTY STRING + SKIPN (P) + JUMPE 0,MTSTRN + HLRE 0,AB + CAML 0,[-2] ; WAS A CHANNEL GIVEN + JRST STRIO2 + GETYP 0,2(AB) + SKIPN (P) ; SKIP IF PRINT + JRST TESTIN + CAIN 0,TTP ; SEE IF FLATSIZE HACK + JRST STRIO9 +TESTIN: CAIE 0,TCHAN + JRST WTYP2 ; SECOND ARG NOT CHANNEL + MOVE B,3(AB) + HRRZ B,-2(B) + MOVNI E,1 ; CHECKING FOR GOOD DIRECTION + TRNE B,C.READ ; SKIP IF NOT READ + MOVEI E,0 + TRNE B,C.PRIN ; SKIP IF NOT PRINT + MOVEI E,1 + CAME E,(P) + JRST WRONGD ; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE +STRIO9: PUSH TP,2(AB) + PUSH TP,3(AB) ; PUSH ON CHANNEL + JRST STRIO3 +STRIO2: MOVE B,IMQUOTE INCHAN + MOVSI A,TCHAN + SKIPE (P) + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + GETYP 0,A + SKIPN (P) ; SKIP IF PRINTSTRING + JRST TESTI2 + CAIN 0,TTP ; SKIP IF NOT FLATSIZE HACK + JRST STRIO8 +TESTI2: CAIE 0,TCHAN + JRST BADCHN ; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL +STRIO8: PUSH TP,A + PUSH TP,B +STRIO3: MOVE B,(TP) ; GET CHANNEL + SKIPN E,IOINS(B) + PUSHJ P,OPENIT ; IF NOT GO OPEN + MOVE E,IOINS(B) + CAMN E,[JRST CHNCLS] + JRST CHNCLS ; CHECK TO SEE THAT CHANNEL ISNT ALREADY CLOSED +STRIO4: HLRE 0,AB + CAML 0,[-4] + JRST STRIO5 ; NO COUNT TO WORRY ABOUT + GETYP 0,4(AB) + MOVE E,4(AB) + MOVE C,5(AB) + CAIE 0,TCHSTR + CAIN 0,TFIX ; BETTER BE A FIXED NUMBER + JRST .+2 + JRST WTYP3 + HRRZ D,(AB) ; GET ACTUAL STRING LENGTH + CAIN 0,TFIX + JRST .+7 + SKIPE (P) ; TEST FOR WRITING + JRST .-7 ; IF WRITING WE GOT TROUBLE + PUSH P,D ; ACTUAL STRING LENGTH + MOVEM E,(TB) ; STUFF HIS FUNNY DELIM STRING + MOVEM C,1(TB) + JRST STRIO7 + CAML D,C ; MAKE SURE THE STRING IS LONG ENOUGH + JRST .+2 ; WIN + ERRUUO EQUOTE COUNT-GREATER-THAN-STRING-SIZE + PUSH P,C ; PUSH ON MAX COUNT + JRST STRIO7 +STRIO5: +STRIO6: HRRZ C,(AB) ; GET CHAR COUNT + PUSH P,C ; AND PUSH IT ON STACK AS NO MAX COUNT GIVEN +STRIO7: HLRE 0,AB + CAML 0,[-6] + JRST .+6 + MOVE B,(TP) ; GET THE CHANNEL + MOVE 0,6(AB) + MOVEM 0,EOFCND-1(B) ; STUFF IN SLOT IN CHAN + MOVE 0,7(AB) + MOVEM 0,EOFCND(B) + PUSH TP,(AB) ; PUSH ON STRING + PUSH TP,1(AB) + PUSH P,[0] ; PUSH ON CURRENT COUNT OF CHARS DONE + MOVE 0,-2(P) ; GET READ OR WRITE FLAG + JUMPN 0,OUTLOP ; GO WRITE STUFF + + MOVE B,-2(TP) ; GET CHANNEL + PUSHJ P,GRB ; MAKE SURE WE HAVE BUFF + SKIPGE A,LSTCH(B) ; CHECK FOR EOF ALREADY READ PREVIOUSLY + JRST SRDOEF ; GO DOES HIS EOF HACKING +INLOP: INTGO + MOVE B,-2(TP) ; GET CHANNEL + MOVE C,-1(P) ; MAX COUNT + CAMG C,(P) ; COMPARE WITH COUNT DONE + JRST STREOF ; WE HAVE FINISHED + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,INEOF ; EOF HIT + MOVE C,1(TB) + HRRZ E,(TB) ; DO WE HAVE A STRING TO WORRY US? + SOJL E,INLNT ; GO FINISH STUFFING + ILDB D,C + CAME D,A + JRST .-3 + JRST INEOF +INLNT: IDPB A,(TP) ; STUFF IN STRING + SOS -1(TP) ; DECREMENT STRING COUNT + AOS (P) ; INCREMENT CHAR COUNT + JRST INLOP + +INEOF: SKIPE C,LSTCH(B) ; IS THIS AN ! AND IS THERE A CHAR THERE + JRST .+3 ; YES + MOVEM A,LSTCH(B) ; NO SAVE THE CHAR + JRST .+3 + ADDI C,400000 + MOVEM C,LSTCH(B) + MOVSI C,200000 + IORM C,LSTCH(B) + HRRZ C,DIRECT-1(B) ; GET THE TYPE OF CHAN + CAIN C,5 ; IS IT READB? + JRST .+3 + SOS ACCESS(B) ; FIX UP ACCESS FOR READ CHANNEL + JRST STREOF ; AND THATS IT + HRRZ C,ACCESS-1(B) ; FOR A READB ITS WORSE + MOVEI D,5 + SKIPG C + HRRM D,ACCESS-1(B) ; CHANGE A 0 TO A FIVE + SOS C,ACCESS-1(B) + CAMN C,[TFIX,,0] + SOS ACCESS(B) ; AND SOS THE WORD COUNT MAYBE + JRST STREOF + +SRDOEF: SETZM LSTCH(B) ; IN CASE OF -1, FLUSH IT + AOJE A,INLOP ; SKIP OVER -1 ON PTY'S + SUB TP,[6,,6] + SUB P,[3,,3] ; POP JUNK OFF STACKS + PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) ; WHAT WE NEED TO EVAL + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOOSING CHANNEL + MCALL 1,EVAL ; EVAL HIS EOF JUNK + JRST FINIS + +OUTLOP: MOVE B,-2(TP) +OUTLP1: INTGO + MOVE A,-3(TP) ; GET CHANNEL + MOVE B,-2(TP) + MOVE C,-1(P) ; MAX COUNT TO DO + CAMG C,(P) ; HAVE WE DONE ENOUGH + JRST STREOF + ILDB D,(TP) ; GET THE CHAR + SOS -1(TP) ; SUBTRACT FROM STRING LENGTH + AOS (P) ; INC COUNT OF CHARS DONE + PUSHJ P,CPCH1 ; GO STUFF CHAR + JRST OUTLP1 + +STREOF: MOVE A,$TFIX + POP P,B ; RETURN THE LOOSER A COUNT OF WHAT WAS DONE + SUB P,[2,,2] + SUB TP,[6,,6] + JRST FINIS + + +GWB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A WRITE BUFFER ON PRINTB CHAN + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVSI A,TWORD+.VECT. + MOVEM A,BUFLNT(B) + SETOM (B) + MOVEI C,1(B) + HRLI C,(B) + BLT C,BUFLNT-1(B) + MOVEI C,-1(B) + HRLI C,010700 + MOVE B,(TP) + MOVEI 0,C.BUF + IORM 0,-2(B) + MOVEM C,BUFSTR(B) + MOVE C,[TCHSTR,,BUFLNT*5] + MOVEM C,BUFSTR-1(B) + SUB TP,[2,,2] + POPJ P, + + +GRB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A READ BUFFER + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVEI C,BUFLNT-1(B) + POP TP,B + MOVEI 0,C.BUF + IORM 0,-2(B) + HRLI C,010700 + MOVEM C,BUFSTR(B) + MOVSI C,TCHSTR + MOVEM C,BUFSTR-1(B) + SUB TP,[1,,1] + POPJ P, + +MTSTRN: ERRUUO EQUOTE EMPTY-STRING + + ; INPUT UNBUFFERING ROUTINE. THIS DOES THE CHARACTER UNBUFFERING +; FOR INPUT. THE OPEN ROUTINE SETUPS A PUSHJ P, TO +; THIS ROUTINE AS THE IOINS FOR A CHANNEL OPEN TO A NON-TTY DEVICE. + +; H. BRODIE 7/19/72 + +; CALLING SEQ: +; PUSHJ P,GETCHR +; B/ AOBJN PNTR TO CHANNEL VECTOR +; RETURNS NEXT CHARACTER IN AC A. +; ON ENCOUNTERING EITHER ^C OR NUL(^@) IT ASSUMES EOF AND +; TRANSMITS ONLY ^C ON SUCCESSIVE CALLS + + +GETCHR: +; FIRST GRAB THE BUFFER +; GETYP A,BUFSTR-1(B) ; GET TYPE WORD +; CAIN A,TCHSTR ; SKIPS IF NOT CHSTR (I.E. IF BAD BUFFER) +; JRST GTGBUF ; IS GOOD BUFFER...SKIP ERROR RETURN +GTGBUF: HRRZ A,BUFSTR-1(B) ; GET LENGTH OF STRING + SOJGE A,GTGCHR ; JUMP IF STILL MORE + +; HERE IF THE BUFFER WAS EXHAUSTED (BYTE PNTR POINTS INTO DOPE WDS) +; GENERATE AN .IOT POINTER +;FIRST SAVE C AND D AS I WILL CLOBBER THEM +NEWBUF: PUSH P,C + PUSH P,D +IFN ITS,[ + LDB C,[600,,STATUS(B)] ; GET TYPE + CAIG C,2 ; SKIP IF NOT TTY +] +IFE ITS,[ + SKIPE BUFRIN(B) +] + JRST GETTTY ; GET A TTY BUFFER + + PUSHJ P,PGBUFI ; RE-FILL BUFFER + +IFE ITS, MOVEI C,-1 + JUMPGE A,BUFGOO ;SKIPS IF IOT COMPLETED...FIX UP CHANNEL + MOVEI C,1 ; MAKE SURE LAST EOF REALLY ENDS IT + ANDCAM C,-1(A) + MOVSI C,014000 ; GET A ^C + MOVEM C,(A) ;FAKE AN EOF + +IFE ITS,[ + HLRE C,A ; HOW MUCH LEFT + ADDI C,BUFLNT ; # OF WORDS TO C + IMULI C,5 ; TO CHARS + MOVE A,-2(B) ; GET BITS + TRNE A,C.BIN ; CAN'T HELP A BINARY CHANNEL + JRST BUFGOO + MOVE A,CHANNO(B) + PUSH P,B + PUSH P,D + PUSH P,C + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + MOVE B,[2,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + POP P,C + CAIE D,7 ; SEVEN BIT BYTES? + JRST BUFGO1 ; NO, DONT HACK + MOVE D,C + IDIVI B,5 ; C IS NUMBER IN LAST WORD IF NOT EVEN + SKIPN C + MOVEI C,5 + ADDI C,-5(D) ; FIXUP C FOR WINNAGE +BUFGO1: POP P,D + POP P,B +] +; RESET THE BYTE POINTER IN THE CHANNEL. +; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D +BUFGOO: HRLI D,010700 ; GENERATE VIRGIN LH + SUBI D,1 + + MOVEM D,BUFSTR(B) ; STASH IN THE BUFFER BYTE PNTR SLOT +IFE ITS, HRRM C,LSTCH-1(B) ; SAVE IT + MOVEI A,BUFLNT*5-1 +BUFROK: POP P,D ;RESTORE D + POP P,C ;RESTORE C + + +; HERE IF THERE ARE CHARS IN BUFFER +GTGCHR: HRRM A,BUFSTR-1(B) + ILDB A,BUFSTR(B) ; GET A CHAR FROM BUFFER + +IFN ITS,[ + CAIE A,3 ; EOF? + POPJ P, ; AND RETURN + LDB A,[600,,STATUS(B)] ; CHECK FOR TTY + CAILE A,2 ; SKIP IF TTY +] +IFE ITS,[ + PUSH P,0 + HRRZ 0,LSTCH-1(B) + SOJL 0,.+4 + HRRM 0,LSTCH-1(B) + POP P,0 + POPJ P, + + POP P,0 + MOVSI A,-1 + SKIPN BUFRIN(B) +] + JRST .+3 +RETEO1: HRRI A,3 + POPJ P, + + HRRZ A,BUFSTR(B) ; SEE IF RSUBR START BIT IS ON + HRRZ A,(A) + TRNN A,1 + MOVSI A,-1 + JRST RETEO1 + +IFN ITS,[ +PGBUFO: +PGBUFI: +] +IFE ITS,[ +PGBUFO: SKIPA D,[SOUT] +PGBUFI: MOVE D,[SIN] +] + SKIPGE A,BUFSTR(B) ; POINT TO CURRENT BUFFER POSIT + SUBI A,1 ; FOR 440700 AND 010700 START + SUBI A,BUFLNT-1 ; CALCULATE PNTR TO BEG OF BUFFER + HRLI A,-BUFLNT ; IOT (AOBJN) PNTR IN A + MOVSI C,004400 +IFN ITS,[ +PGBIOO: +PGBIOI: MOVE D,A ; COPY FOR LATER + MOVSI C,TUVEC ; PREPARE TO HANDDLE INTS + MOVE PVP,PVSTOR+1 + MOVEM C,DSTO(PVP) + MOVEM C,ASTO(PVP) + MOVSI C,TCHAN + MOVEM C,BSTO(PVP) + +; BUILD .IOT INSTR + MOVE C,CHANNO(B) ; CHANNEL NUMBER IN C + ROT C,23. ; MOVE INTO AC FIELD + IOR C,[.IOT 0,A] ; IOR IN SKELETON .IOT + +; DO THE .IOT + ENABLE ; ALLOW INTS + XCT C ; EXECUTE THE .IOT INSTR + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM ASTO(PVP) + SETZM DSTO(PVP) + POPJ P, +] + +IFE ITS,[ +PGBIOT: PUSH P,D + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,C + HRRZS (P) + HRRI C,-1(A) ; POINT TO BUFFER + HLRE D,A ; XTRA POINTER + MOVNS D + HRLI D,TCHSTR + MOVE PVP,PVSTOR+1 + MOVEM D,BSTO(PVP) + MOVE D,[PUSHJ P,FIXACS] + MOVEM D,ONINT + MOVSI D,TUVEC + MOVEM D,DSTO(PVP) + MOVE D,A + MOVE A,CHANNO(B) ; FILE JFN + MOVE B,C + HLRE C,D ; - COUNT TO C + SKIPE (P) + MOVN C,(P) ; REAL DESIRED COUNT + SUB P,[1,,1] + ENABLE + XCT (P) ; DO IT TO IT + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM DSTO(PVP) + SETZM ONINT + MOVEI A,1(B) + MOVE B,(TP) + SUB TP,[2,,2] + SUB P,[1,,1] + JUMPGE C,CPOPJ ; NO EOF YET + HRLI A,(C) ; LOOK LIKE AN AOBJN PNTR + POPJ P, + +FIXACS: PUSH P,PVP + MOVE PVP,PVSTOR+1 + MOVNS C + HRRM C,BSTO(PVP) + MOVNS C + POP P,PVP + POPJ P, + +PGBIOO: SKIPA D,[SOUT] +PGBIOI: MOVE D,[SIN] + HRLI C,004400 + JRST PGBIOT +DOIOTO: PUSH P,[SOUT] +DOIOTC: PUSH P,B + PUSH P,C + EXCH A,B + MOVE A,CHANNO(A) + HLRE C,B + HRLI B,444400 + XCT -2(P) + HRL B,C + MOVE A,B +DOIOTE: POP P,C + POP P,B + SUB P,[1,,1] + POPJ P, +DOIOTI: PUSH P,[SIN] + JRST DOIOTC +] + +; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE + +PUTCHR: PUSH P,A + GETYP A,BUFSTR-1(B) ; CHECK TYPE OF ARG + CAIE A,TCHSTR ; MUST BE STRING + JRST BDCHAN + + HRRZ A,BUFSTR-1(B) ; GET CHAR COUNT + JUMPE A,REBUFF ; PREV RESET BUFF, UNDO SAME + +PUTCH1: POP P,A ; RESTORE CHAR + CAMN A,[-1] ; SPECIAL HACK? + JRST PUTCH2 ; YES GO HANDLE + IDPB A,BUFSTR(B) ; STUFF IT +PUTCH3: SOS A,BUFSTR-1(B) ; COUNT DOWN STRING + TRNE A,-1 ; SKIP IF FULL + POPJ P, + +; HERE TO FLUSH OUT A BUFFER + + PUSH P,C + PUSH P,D + PUSHJ P,PGBUFO ; SETUP AND DO IOT + HRLI D,010700 ; POINT INTO BUFFER + SUBI D,1 + MOVEM D,BUFSTR(B) ; STORE IT + MOVEI A,BUFLNT*5 ; RESET COUNT + HRRM A,BUFSTR-1(B) + POP P,D + POP P,C + POPJ P, + +;HERE TO DA ^C AND TURN ON MAGIC BIT + +PUTCH2: MOVEI A,3 + IDPB A,BUFSTR(B) ; ZAP OUT THE ^C + MOVEI A,1 ; GET BIT +IFE ITS,[ + PUSH P,C + HRRZ C,BUFSTR(B) + IORM A,(C) + POP P,C +] +IFN ITS,[ + IORM A,@BUFSTR(B) ; ON GOES THE BIT +] + JRST PUTCH3 + +; RESET A FUNNY BUF + +REBUFF: MOVEI A,BUFLNT*5 ; 1ST COUNT + HRRM A,BUFSTR-1(B) + HRRZ A,BUFSTR(B) ; NOW POINTER + SUBI A,BUFLNT+1 + HRLI A,010700 + MOVEM A,BUFSTR(B) ; STORE BACK + JRST PUTCH1 + + +; HERE TO FLUSH FINAL BUFFER + +BFCLOS: HRRZ C,-2(B) ; THIS BUFFER FLUSHER THE WORK OF NDR + MOVEI A,0 + TRNE C,C.TTY + POPJ P, + TRNE C,C.DISK + MOVEI A,1 + PUSH P,A ; SAVE THE RESULT OF OUR TEST + JUMPN A,BFCLNN ; DONT HAVE TO CHECK NET STATE + PUSH TP,$TCHAN + PUSH TP,B ; SAVE CHANNEL + PUSHJ P,INSTAT ; GET CURRENT NETWORK STATE + MOVE A,(B) ; GET FIRST ELEMENT OF STATE UVECTOR WHICH IS CUR STATE + POP TP,B ; RESTORE B + POP TP, + CAIE A,5 ; IS NET IN OPEN STATE? + CAIN A,6 ; OR ELSE IS IT IN RFNM WAIT STATE + JRST BFCLNN ; IF SO TO THE IOT + POP P, ; ELSE FLUSH CRUFT AND DONT IOT + POPJ P, ; RETURN DOING NO IOT +BFCLNN: MOVEI C,BUFLNT*5 ; NEW BUFFER FLUSHER BY NDR + HRRZ D,BUFSTR-1(B) ; SO THAT NET ALSO WORKS RIGHT + SUBI C,(D) ; GET NUMBER OF CHARS + IDIVI C,5 ; NUMBER OF FULL WORDS AND REST + PUSH P,D ; SAVE NUMBER OF ODD CHARS + SKIPGE A,BUFSTR(B) ; GET CURRENT BUF POSITION + SUBI A,1 ; FIX FOR 440700 BYTE POINTER +IFE ITS,[ + HRRO D,A + PUSH P,(D) +] +IFN ITS,[ + PUSH P,(A) ; SAVE THE ODD WORD OF BUFFER +] + MOVEI D,BUFLNT + SUBI D,(C) + SKIPE -1(P) + SUBI A,1 + ADDI D,1(A) ; FIX UP FOR POSSIBLE ODD CHARS + PUSH TP,$TUVEC + PUSH TP,D ; PUSH THE DOPE VECTOR ONTO THE STACK + JUMPE C,BFCLSR ; IN CASE THERE ARE NO FULL WORDS TO DO + HRL A,C + TLO A,400000 + MOVE E,[SETZ BUFLNT(A)] + SUBI E,(C) ; FIX UP FOR BACKWARDS BLT + POP A,@E ; AMAZING GRACE + TLNE A,377777 + JRST .-2 + HRRO A,D ; SET UP AOBJN POINTER + SUBI A,(C) + TLC A,-1(C) + PUSHJ P,PGBIOO ; DO THE IOT OF ALL THE FULL WORDS +BFCLSR: HRRO A,(TP) ; GET IOT PTR FOR REST OF JUNK + SUBI A,1 ; POINT TO WORD BEFORE DOPE WORDS + POP P,0 ; GET BACK ODD WORD + POP P,C ; GET BACK ODD CHAR COUNT + POP P,D ; FLAG FOR NET OR DSK + JUMPN D,BFCDSK ; GO FINISH OFF DSK + JUMPE C,BFCLSD ; IF NO ODD CHARS FINISH UP + MOVEI D,7 + IMULI D,(C) ; FIND NO OF BITS TO SHIFT + LSH 0,-43(D) ; SHIFT BITS TO RIGHT PLACE + MOVEM 0,(A) ; STORE IN STRING + SUBI C,5 ; HOW MANY CHAR POSITIONS TO SKIP + MOVNI C,(C) ; MAKE C POSITIVE + LSH C,17 + TLC A,(C) ; MUNG THE AOBJN POINTER TO KLUDGE + PUSHJ P,PGBIOO ; DO IOT OF ODD CHARS + MOVEI C,0 +BFCLSD: HRRZ A,(TP) ; GET PTR TO DOPE WORD + SUBI A,BUFLNT+1 + JUMPLE C,.+3 + SKIPE ACCESS(B) + MOVEM 0,1(A) ; LAST WORD BACK IN BFR + HRLI A,010700 ; AOBJN POINTER TO FIRST OF BUFFER + MOVEM A,BUFSTR(B) + MOVEI A,BUFLNT*5 + HRRM A,BUFSTR-1(B) + SKIPN ACCESS(B) + JRST BFCLSY + JUMPL C,BFCLSY + JUMPE C,BFCLSZ + IBP BUFSTR(B) + SOS BUFSTR-1(B) + SOJG C,.-2 +BFCLSY: MOVE A,CHANNO(B) + MOVE C,B +IFE ITS,[ + RFPTR + FATAL RFPTR FAILED + HRRZ F,LSTCH-1(C) ; PREVIOUS HIGH + MOVE G,C ; SAVE CHANNEL + MOVE C,B + CAML F,B + MOVE C,F + MOVE F,B + HRLI A,400000 + CLOSF + JFCL + MOVNI B,1 + HRLI A,12 + CHFDB + MOVE B,STATUS(G) + ANDI A,-1 + OPENF + FATAL OPENF LOSES + MOVE C,F + IDIVI C,5 + MOVE B,C + SFPTR + FATAL SFPTR FAILED + MOVE B,G +] +IFN ITS,[ + DOTCAL RFPNTR,[A,[2000,,B]] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + SUBI B,1 + DOTCAL ACCESS,[A,B] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + MOVE B,C +] +BFCLSZ: SUB TP,[2,,2] + POPJ P, + +BFCDSK: TRZ 0,1 + PUSH P,C +IFE ITS,[ + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,0 ; WORD OF CHARS + MOVE A,CHANNO(B) + MOVEI B,7 ; MAKE BYTE SIZE 7 + SFBSZ + JFCL + HRROI B,(P) + MOVNS C + SKIPE C + SOUT + MOVE B,(TP) + SUB P,[1,,1] + SUB TP,[2,,2] +] +IFN ITS,[ + MOVE D,[440700,,A] + DOTCAL SIOT,[CHANNO(B),D,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + POP P,C + JUMPN C,BFCLSD +BFCDS1: MOVNI C,1 ; INDICATE NOT TOHACK BUFFER + JRST BFCLSD + +BFCLS1: HRRZ C,DIRECT-1(B) + MOVSI 0,(JFCL) + CAIE C,6 + MOVE 0,[AOS ACCESS(B)] + PUSH P,0 + HRRZ C,BUFSTR-1(B) + IDIVI C,5 + JUMPE D,BCLS11 + MOVEI A,40 ; PAD WITH SPACES + PUSHJ P,PUTCHR + XCT (P) ; AOS ACCESS IF NECESSARY + SOJG D,.-3 ; TO END OF WORD +BCLS11: POP P,0 + HLLZS ACCESS-1(B) + HRRZ C,BUFSTR-1(B) + CAIE C,BUFLNT*5 + PUSHJ P,BFCLOS + POPJ P, + + +; HERE TO GET A TTY BUFFER + +GETTTY: SKIPN C,EXBUFR(B) ; SKIP IF BUFFERS BACKED UP + JRST TTYWAI + HRRZ D,(C) ; CDR THE LIST + GETYP A,(C) ; CHECK TYPE + CAIE A,TDEFER ; MUST BE DEFERRED + JRST BDCHAN + MOVE C,1(C) ; GET DEFERRED GOODIE + GETYP A,(C) ; BETTER BE CHSTR + CAIE A,TCHSTR + JRST BDCHAN + MOVE A,(C) ; GET FULL TYPE WORD + MOVE C,1(C) + MOVEM D,EXBUFR(B) ; STORE CDR'D LIST + MOVEM A,BUFSTR-1(B) ; MAKE CURRENT BUFFER + MOVEM C,BUFSTR(B) + HRRM A,LSTCH-1(B) + SOJA A,BUFROK + +TTYWAI: PUSHJ P,TTYBLK ; BLOCKED FOR TTY I/O + JRST GETTTY ; SHOULD ONLY RETURN HAPPILY + + ;INTERNAL DEVICE READ ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT, +;CHECKS THAT THE RETURNED VALUE IS OF TYPE CHARACTER, +;AND RETURNS THAT AS THE NEXT CHARACTER IN THE "FILE" + +;H. BRODIE 8/31/72 + +GTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,INTFCN-1(B) + PUSH TP,INTFCN(B) + MCALL 1,APPLY + GETYP A,A + CAIE A,TCHRS + JRST BADRET + MOVE A,B +INTRET: POP P,0 ;RESTORE THE ACS + POP P,E + POP P,D + POP P,C + POP TP,B ;RESTORE THE CHANNEL + SUB TP,[1,,1] ;FLUSH $TCHAN...WE DON'T NEED IT + POPJ P, + + +BADRET: ERRUUO EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT + +;INTERNAL DEVICE PRINT ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,(FUNCTION, SUBR, OR RSUBR) +;TO THE CURRENT CHARACTER BEING "PRINTED". + +PTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,$TCHRS ;PUSH THE TYPE "CHARACTER" + PUSH TP,A ;PUSH THE CHAR + PUSH TP,$TCHAN ;PUSH THE CHANNEL + PUSH TP,B + MCALL 2,INTFCN-1(B) ;APPLY THE FUNCTION TO THE CHAR + JRST INTRET + + + +; ROUTINE TO FLUSH OUT A PRINT BUFFER + +MFUNCTION BUFOUT,SUBR + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + + MOVE B,1(AB) +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; GET DIR NAME +; JFCL +; CAMN B,[ASCII /PRINT/] +; JRST .+3 +; CAME B,[+1] +; JRST WRONGD +; TRNE B,1 ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN B,1 ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] + HRRZ 0,-2(B) + TRNN 0,C.PRIN + JRST WRONGD +; TRNE 0,C.BIN ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN 0,C.BIN ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] +; MOVE B,1(AB) +; GETYP 0,BUFSTR-1(B) +; CAIN 0,TCHSTR +; SKIPN A,BUFSTR(B) ; BYTE POINTER? +; JRST BFIN1 +; HRRZ C,BUFSTR-1(B) ; CHARS LEFT +; IDIVI C,5 ; MULTIPLE OF 5? +; JUMPE D,BFIN2 ; YUP NO EXTRAS + +; MOVEI A,40 ; PAD WITH SPACES +; PUSHJ P,PUTCHR ; OUT IT GOES +; XCT (P) ; MAYBE BUMP ACCESS +; SOJG D,.-3 ; FILL + +BFIN2: PUSHJ P,BFCLOS ; WRITE OUT BUFFER + +BFIN1: MOVSI A,TCHAN + JRST FINIS + + + +; FUNCTION TO GET THE FILE LENGTH OF A READ CHANNEL + +MFUNCTION FILLNT,SUBR,[FILE-LENGTH] + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) + PUSHJ P,CFILLE + JRST FINIS + +CFILLE: +IFN 0,[ + MOVEI B,DIRECT-1(B) ; GET CHANNEL TYPE + PUSHJ P,CHRWRD + JFCL + CAME B,[ASCIZ /READ/] + JRST .+3 + PUSH P,[5] ; MULTIPLICATIVE FACTOR FOR READ + JRST .+4 + CAME B,[ASCII /READB/] + JRST WRONGD + PUSH P,[1] ; MULTIPLICATIVE FACTOR FOR READ +] + MOVE C,-2(B) ; GET BITS + MOVEI D,5 ; ASSUME ASCII + TRNE C,C.BIN ; SKIP IF NOT BINARY + MOVEI D,1 + PUSH P,D + MOVE C,B +IFN ITS,[ + .CALL FILL1 + JRST FILLOS ; GIVE HIM A NICE FALSE +] +IFE ITS,[ + MOVE A,CHANNO(C) + PUSH P,[0] + MOVEI C,(P) + MOVE B,[1,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,(P)] ; GET BYTE SIZE + JUMPN D,.+2 + MOVEI D,36. ; HANDLE "0" BYTE SIZE + SUB P,[1,,1] + SIZEF + JRST FILLOS +] + POP P,C +IFN ITS, IMUL B,C +IFE ITS,[ + CAIN C,5 + CAIE D,7 + JRST NOTASC +] +YESASC: MOVE A,$TFIX + POPJ P, + +IFE ITS,[ +NOTASC: MOVEI 0,36. + IDIV 0,D ; BYTES PER WORD + IDIVM B,0 + IMUL C,0 + MOVE B,C + JRST YESASC +] + +IFN ITS,[ +FILL1: SETZ ; BLOCK FOR .CALL TO FILLEN + SIXBIT /FILLEN/ + CHANNO (C) + SETZM B + +FILLOS: MOVE A,CHANNO(C) + MOVE B,[.STATUS A] ;MAKE A CALL TO STATUS TO FIND REASON + LSH A,23. ;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE + IOR B,A ;FIX UP .STATUS + XCT B + MOVE B,C + PUSHJ P,GFALS + POP P, + POPJ P, +] +IFE ITS,[ +FILLOS: MOVE B,C + PUSHJ P,TGFALS + POP P, + POPJ P, +] + + + ; MCHAN LOW-LEVEL I/O GARBAGE (PDL)-ORIGINAL (LIM)-ADDITIONS + +;CALLING ROUTINE: AC-A contains pointer to block of SIXBIT data +; DIR ? DEV ? FNM1 ? FNM2 ? SNM +;RETURNED VALUE : AC-A = +IFN ITS,[ +MOPEN: PUSH P,B + PUSH P,C + MOVE C,FRSTCH ; skip gc and tty channels +CNLP: DOTCAL STATUS,[C,[2000,,B]] + .LOSE %LSFIL + ANDI B,77 + JUMPE B,CHNFND ; found unused channel ? + ADDI C,1 ; try another channel + CAIG C,17 ; are all the channels used ? + JRST CNLP + SETO C, ; all channels used so C = -1 + JRST CHNFUL +CHNFND: MOVEI B,(C) + HLL B,(A) ; M.DIR slot + DOTCAL OPEN,[B,1(A),2(A),3(A),4(A)] + SKIPA + AOS -2(P) ; successful skip when returning +CHNFUL: MOVE A,C + POP P,C + POP P,B + POPJ P, + +MIOT: DOTCAL IOT,[A,B] + JFCL + POPJ P, + +MCLOSE: DOTCAL CLOSE,[A] + JFCL + POPJ P, + +IMPURE + +FRSTCH: 1 + +PURE +] + ;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O + +NOTNET: +BADCHN: ERRUUO EQUOTE BAD-CHANNEL +BDCHAN: ERRUUO EQUOTE BAD-INPUT-BUFFER + +WRONGD: ERRUUO EQUOTE WRONG-DIRECTION-CHANNEL + +CHNCLS: ERRUUO EQUOTE CHANNEL-CLOSED + +BAD6: ERRUUO EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME + +DISLOS: MOVE C,$TCHSTR + MOVE D,CHQUOTE [DISPLAY NOT AVAILABLE] + PUSHJ P,INCONS + MOVSI A,TFALSE + JRST OPNRET + +NOCHAN: ERRUUO EQUOTE ITS-CHANNELS-EXHAUSTED + +MODE1: 232020,,202020 +MODE2: 232023,,330320 + +END + + \ No newline at end of file diff --git a//fopen.mid.59 b//fopen.mid.59 new file mode 100644 index 0000000..c2d1c0c --- /dev/null +++ b//fopen.mid.59 @@ -0,0 +1,4703 @@ +TITLE OPEN - CHANNEL OPENER FOR MUDDLE + +RELOCATABLE + +;C. REEVE MARCH 1973 + +.INSRT MUDDLE > + +SYSQ + +FNAMS==1 +F==E+1 +G==F+1 + +IFE ITS,[ +IF1, .INSRT STENEX > +] +;THIS PROGRAM HAS ENTRIES: FOPEN, FCLOSE, RENAME, READB, PRINTB, FILECOPY, READSTRING, +; PRINTSTRING, NETSTATE, NETACC, NETS, ACCESS, AND FILE-EXISTS? + +;THESE SUBROUTINES HANDLE I/O STREAMS FOR THE MUDDLE SYSTEM. + +; FOPEN - OPENS A FILE FOR EITHER READING OR WRITING. IT TAKES +; FIVE OPTINAL ARGUMENTS AS FOLLOWS: + +; FOPEN (,,,,) +; +; - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ + +; - FIRST FILE NAME. DEFAULT INPUT OR OUTPUT. + +; - SECOND FILE NAME. DEFAULT MUDDLE. + +; - DEVICE FROM WHICH TO OPEN. DEFAULT IS DSK. + +; - SYSTEM (DIRECTORY) NAME. DEFAULT UNAME. + +; FOPEN RETURNS AN OBJECT OF TYPE CHANNEL IF IT SUCCEEDS OTHERWISE NIL + + +; FCLOSE - CLOSES A FILE. TAKES A CHANNEL OBJECT AS ITS ARGUMENT. IT ALSO TAKES +; ACCESS - DOES A .ACCESS ON A CHARACTER BASIS FOR CHARACTER FILES + + +; A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION + +; CHANNO ;ITS I/O CHANNEL NUMBER. 0 MEANS NOT A REAL CHANNEL. +; DIRECT ;DIRECTION (EITHER READ OR PRINT) +; NAME1 ;FIRST NAME OF FILE AS OPENED. +; NAME2 ;SECOND NAME OF FILE +; DEVICE ;DEVICE UPON WHICH THE CHANNEL IS OPEN +; SNAME ;DIRECTORY NAME +; RNAME1 ;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS) +; RNAME2 ;REAL SECOND NAME +; RDEVIC ;REAL DEVICE +; RSNAME ;SYSTEM OR DIRECTORY NAME +; STATUS ;VARIOUS STATUS BITS +; IOINS ;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER +; ACCESS ;ACCESS POINTER FOR RAND ACCESS (OR USED FOR DISPLAY INFO) +; RADX ;RADIX FOR CHANNELS NUMBER CONVERSION + +; *** THE FOLLOWING FIELDS FOR OUTPUT ONLY *** +; LINLN ;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE +; CHRPOS ;CURRENT POSITION ON CURRENT LINE +; PAGLN ;LENGTH OF A PAGE +; LINPOS ;CURRENT LINE BEING WRITTEN ON + +; *** THE FOLLOWING FILEDS FOR INPUT ONLY *** +; EOFCND ;GETS EVALUATED ON EOF +; LSTCH ;BACKUP CHARACTER +; WAITNS ;FOR TTY INPUT, BECOMES A .SLEEP WHEN WAITING +; EXBUFR ;FOR TTY INPUT, CONTAINS A WAITING BUFFER LIST +; BUFSTR ;A CHARACTER STRING USED AS BUFFER FOR NON-TTY DEVICES + +; THIS DEFINES THE LENGTH OF THE NON-TTY BUFFER +BUFLNT==100 + +;THIS DEFINES BLOCK MODE BIT FOR OPENING +BLOCKM==2 ;DEFINED IN THE LEFT HALF +IMAGEM==4 + + +;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME + + CHANLNT==4 ;INITIAL CHANNEL LENGTH + +; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS +BUFRIN==-1 ;SPECIAL HACK SO LOSERS WON'T SEE TTY BUFFER +SCRPTO==-3 ;SPECIAL HACK FOR SCRIPT CHANNELS +PROCHN: + +IRP A,,[[CHANNO,FIX],[DIRECT,CHSTR] +[NAME1,CHSTR],[NAME2,CHSTR],[DEVICE,CHSTR],[SNAME,CHSTR] +[RNAME1,CHSTR],[RNAME2,CHSTR],[RDEVIC,CHSTR],[RSNAME,CHSTR] +[STATUS,FIX],[IOINS,FIX],[LINLN,FIX],[CHRPOS,FIX],[PAGLN,FIX],[LINPOS,FIX] +[ACCESS,FIX],[RADX,FIX],[BUFSTR,CHSTR]] + + IRP B,C,[A] + B==CHANLNT-3 + T!C,,0 + 0 + .ISTOP + TERMIN + CHANLNT==CHANLNT+2 +TERMIN + + +; EQUIVALANCES FOR CHANNELS + +EOFCND==LINLN +LSTCH==CHRPOS +WAITNS==PAGLN +EXBUFR==LINPOS +DISINF==BUFSTR ;DISPLAY INFO +INTFCN==BUFSTR ;FUNCTION (OR SUBR, OR RSUBR) TO BE APPLIED FOR INTERNAL CHNLS + + +;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS + +IRP A,,[IOIN2,ECHO,CHRCNT,ERASCH,KILLCH,BRKCH,ESCAP,SYSCHR,BRFCHR,BRFCH2,BYTPTR] +A==.IRPCNT +TERMIN + +EXTBFR==BYTPTR+1+<100./5> ;LENGTH OF ADD'L BUFFER + + + + +.GLOBAL IPNAME,MOPEN,MCLOSE,MIOT,ILOOKU,6TOCHS,ICLOS,OCLOS,RGPARS,RGPRS +.GLOBAL OPNCHN,CHMAK,READC,TYO,SYSCHR,BRFCHR,LSTCH,BRFCH2,EXTBFR +.GLOBAL CHRWRD,STRTO6,TTYBLK,WAITNS,EXBUFR,TTICHN,TTOCHN,GETCHR,IILIST +.GLOBAL CHANNO,STATUS,LINPOS,PAGLN,CHRPOS,LINLN,IOINS,ACCESS,ADDNUL +.GLOBAL DIRECT,DISINF,RADX,EOFCND,BUFSTR,MODE1,MODE2,GCHACK,GMTYO,INMTYO +.GLOBAL T.CHAN,NAME1,BFCLOS,DOIOTI,DOIOTO,DOACCS,NOTTY,DEMFLG,BYTDOP,TNXIN +.GLOBAL DISOPN,DISROP,DISCLS,DCHAR,DISLNL,DISPGL,INSTAT,MTYO,CIREST +.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP,N.CHNS +.GLOBAL REOPN,QUITTE,CHNL0,CHNL1,BUFRIN,IOIN2,IFALSE,GFALS,IDVAL,PVSTOR,SPSTOR +.GLOBAL BADCHN,WRONGD,CHNCLS,GSNAME,GIBLOK,APLQ,NAPT,ICONS,INCONS,IBLOCK,IDVAL1 +.GLOBAL GRB,GWB,R1CHAR,W1CHAR,BFCLS1,TTYOP2,MPOPJ,COMPER,R1C,W1C,WXCT,RXCT +.GLOBAL TMTNXS,TNXSTR,RDEVIC,CPCH1,RCYCHN,CGFALS,CISTNG,CFILLE,FRSTCH +.GLOBAL TGFALS,ONINT + +.VECT.==40000 + +; PAIR MOVING MACRO + +DEFINE PMOVEM A,B + MOVE 0,A + MOVEM 0,B + MOVE 0,A+1 + MOVEM 0,B+1 + TERMIN + +; DEFINITIONS OF THE OFFSETS INTO THE TP STACK FOR OPEN + +T.SPDL==0 ; SAVES P STACK BASE +T.DIR==2 ; CONTAINS DIRECTION AND MODE +T.NM1==4 ; NAME 1 OF FILE +T.NM2==6 ; NAME 2 OF FILE +T.DEV==10 ; DEVICE NAME +T.SNM==12 ; SNAME +T.XT==14 ; EXTRA CRUFT IF NECESSARY +T.CHAN==16 ; CHANNEL AS GENERATED + +; OFFSETS FROM PSTACK BASE (USED FOR OPENS, .RCHST AND .FDELES) + +S.DIR==0 ; CODE FOR DIRECTION 0-IN, 1-OUT, 2-BIN, 3-BOUT,4-DISPLAY + ; S.DIR(P) = ,, +IFN ITS,[ +S.DEV==1 ; SIXBIT DEVICE RIGHT JUSTIFIED +S.NM1==2 ; SIXBIT NAME1 +S.NM2==3 ; SIXBIT NAME2 +S.SNM==4 ; SIXBIT SNAME +S.X1==5 ; TEMPS +S.X2==6 +S.X3==7 +] + +IFE ITS,[ +S.DEV==1 +S.X1==2 +S.X2==3 +S.X3==4 +] + + +; FLAGS SPECIFYING STATE OF THE WORLD AT VARIOUS TIMES + +NOSTOR==400000 ; ON MEANS DONT BUILD NEW STRINGS +MSTNET==200000 ; ON MEANS ONLY THE "NET" DEVICE CAN WIN +SNSET==100000 ; FLAG, SNAME SUPPLIED +DVSET==040000 ; FLAG, DEV SUPPLIED +N2SET==020000 ; FLAG, NAME2 SET +N1SET==010000 ; FLAG, NAME1 SET +4ARG==004000 ; FLAG, CONSIDER ARGS TO BE 4 STRINGS + +RMT [EXPUNGE N1SET,N2SET,DVSET,SNSET,MSTNET,NOSTOR +] + +; TABLE OF LEGAL MODES + +MODES: IRP A,,[READ,PRINT,READB,PRINTB,PRINTO,PRINAO] + SIXBIT /A/ + TERMIN +NMODES==.-MODES + +MODCOD: 0?1?2?3?3?1 +; TABLE OF KNOWN DEVICES AND A POINTER TO THEIR OPENERS + +IFN ITS,[ +DEVSTB: IRP A,,[DSK,TTY,USR,STY,ST,NET,INT,PTP,PTR,UT,T,NUL] + SIXBIT /A/ ; DEVICE NAMES + TERMIN + +DEVS: IRP B,,[ODSK,OTTY,OUSR,OSTY,OSTY,ONET,OINT,OPTP,OPTP,OUTN,OTTY,ONUL] + SETZ B ; POINTERS + TERMIN +] + +IFE ITS,[ +DEVSTB: IRP A,,[PS,SS,SRC,DSK,TTY,INT,NET] + SIXBIT /A/ + TERMIN + +DEVS: IRP B,,[ODSK,ODSK,ODSK,ODSK,OTTY,OINT,ONET] + SETZ B + TERMIN +] +NDEVS==.-DEVS + + + +;SUBROUTINE TO DO OPENING BEGINS HERE + +MFUNCTION NFOPEN,SUBR,[OPEN-NR] + + JRST FOPEN1 + +MFUNCTION FOPEN,SUBR,[OPEN] + +FOPEN1: ENTRY + PUSHJ P,MAKCHN ;MAKE THE CHANNEL + PUSHJ P,OPNCH ;NOW OPEN IT + JUMPL B,FINIS + SUB D,[4,,4] ; TOP THE CHANNEL + MOVEM D,RCYCHN+1 ; RECYCLE DEAD CHANNEL + SETZM (D) ; ZAP IT + MOVEI C,1(D) + HRLI C,(D) + BLT C,CHANLNT-1(D) + JRST FINIS + +; SUBR TO JUST CREATE A CHANNEL + +IMFUNCTION CHANNEL,SUBR + + ENTRY + PUSHJ P,MAKCHN + MOVSI A,TCHAN + JRST FINIS + + + + +; THIS ROUTINE PARSES ARGUMENTS TO FOPEN ETC. AND BUILDS A CHANNEL BUT DOESN'T OPEN IT + +MAKCHN: PUSH TP,$TPDL + PUSH TP,P ; POINT AT CURRENT STACK BASE + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE READ + MOVEI E,10 ; SLOTS OF TP NEEDED + PUSH TP,[0] + SOJG E,.-1 + MOVEI E,0 + EXCH E,(P) ; GET RET ADDR IN E +IFE ITS, PUSH P,[0] +IRP ATM,,[DEV,NM1,NM2,SNM]MDF,,[DSK,INPUT,>,[ ]]TMDF,,[DSK,INPUT,MUD,[ ]] + MOVE B,IMQUOTE ATM +IFN ITS, PUSH P,E + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TCHSTR + JRST MAK!ATM + + MOVE A,$TCHSTR +IFN ITS, MOVE B,CHQUOTE MDF +IFE ITS, MOVE B,CHQUOTE TMDF +MAK!ATM: + MOVEM A,T.!ATM(TB) + MOVEM B,T.!ATM+1(TB) +IFN ITS,[ + POP P,E + PUSHJ P,STRTO6 ; RESULT LEFT ON P STACK AS DESIRED +] + TERMIN + PUSH TP,[0] ; PUSH SLOTS + PUSH TP,[0] + + PUSH P,[0] ; EXT SLOTS + PUSH P,[0] + PUSH P,[0] + PUSH P,E ; PUSH RETURN ADDRESS + MOVEI A,0 + + JUMPGE AB,MAKCH0 ; NO ARGS, ALREADY DONE + GETYP 0,(AB) ; 1ST ARG MUST BE A STRING + CAIE 0,TCHSTR + JRST WTYP1 + MOVE A,(AB) ; GET ARG + MOVE B,1(AB) + PUSHJ P,CHMODE ; CHECK OUT OPEN MODE + + PMOVEM (AB),T.DIR(TB) ; SAVE MODE NAME IN TEMPS + ADD AB,[2,,2] ; BUMP PAST DIRECTION + MOVEI A,0 + JUMPGE AB,MAKCH0 ; CHECK NAME1 BASED ON JUST MODE + + MOVEI 0,0 ; FLAGS PRESET + PUSHJ P,RGPARS ; PARSE THE STRING(S) + JRST TMA + +; ARGUMENTS PARSED, DO FINAL CHECKS AND BUILD CHANNEL + +MAKCH0: +IFN ITS,[ + MOVE C,T.SPDL+1(TB) + MOVE D,S.DEV(C) ; GET DEV +] +IFE ITS,[ + MOVE A,T.DEV(TB) + MOVE B,T.DEV+1(TB) + PUSHJ P,STRTO6 + POP P,D + HLRZS D + MOVE C,T.SPDL+1(TB) + MOVEM D,S.DEV(C) +] +IFE ITS, CAIE D,(SIXBIT /INT/);INTERNAL? +IFN ITS, CAME D,[SIXBIT /INT /] + JRST CHNET ; NO, MAYBE NET + SKIPN T.XT+1(TB) ; WAS FCN SUPPLIED? + JRST TFA + +; FALLS TROUGH IF SKIP + + + +; NOW BUILD THE CHANNEL + +ARGSOK: MOVEI A,CHANLNT ; GET LENGTH + SKIPN B,RCYCHN+1 ; RECYCLE? + PUSHJ P,GIBLOK ; GET A BLOCK OF STUFF + SETZM RCYCHN+1 + ADD B,[4,,4] ; HIDE THE TTY BUFFER SLOT + PUSH TP,$TCHAN + PUSH TP,B + HRLI C,PROCHN ; POINT TO PROTOTYPE + HRRI C,(B) ; AND NEW ONE + BLT C,CHANLN-5(B) ; CLOBBER + MOVSI C,TLIST ; TO GIVE HIM A CLEAN LIST OF SCRIPT CHANS + HLLM C,SCRPTO-1(B) + +; NOW BLT IN STUFF FROM THE STACK + + MOVSI C,T.DIR(TB) ; DIRECTION + HRRI C,DIRECT-1(B) + BLT C,SNAME(B) + MOVEI C,RNAME1-1(B) ; NOW "REAL" SLOTS + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + MOVE B,IMQUOTE MODE + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TFIX + JRST .+3 + MOVE B,(TP) + POPJ P, + + MOVE C,(TP) +IFE ITS,[ + ANDI B,403776 ; ONLY ALLOW NON-CRITICAL BITSS +] + HRRM B,-4(C) ; HIDE BITS + MOVE B,C + POPJ P, + +; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN + +CHNET: +IFN ITS,[ + CAME D,[SIXBIT /NET /] ; IS IT NET + JRST MAKCH1] +IFE ITS,[ + CAIE D,(SIXBIT /NET/) ; IS IT NET + JRST ARGSOK] + MOVSI D,TFIX ; FOR TYPES + MOVEI B,T.NM1(TB) ; MAKE SURE ALL ARE FIXED + PUSHJ P,CHFIX + MOVEI B,T.NM2(TB) + PUSHJ P,CHFIX + MOVEI B,T.SNM(TB) + LSH A,-1 ; SKIP DEV FLAG + PUSHJ P,CHFIX + JRST ARGSOK + +MAKCH1: TRNN A,MSTNET ; CANT HAVE SEEN A FIX + JRST ARGSOK + JRST WRONGT + +IFN ITS,[ +CHFIX: TRNE A,N1SET ; SKIP IF NOT SPECIFIED + JRST CHFIX1 + SETOM 1(B) ; SET TO -1 + SETOM S.NM1(C) + MOVEM D,(B) ; CORRECT TYPE +] +IFE ITS,CHFIX: + GETYP 0,(B) + CAIE 0,TFIX + JRST PARSQ +CHFIX1: ADDI C,1 ; POINT TO NEXT FIELD + LSH A,-1 ; AND NEXT FLAG + POPJ P, +PARSQ: CAIE 0,TCHSTR + JRST WRONGT +IFE ITS, POPJ P, +IFN ITS,[ + PUSH P,A + PUSH P,C + PUSH TP,(B) + PUSH TP,1(B) + SUBI B,(TB) + PUSH P,B + MCALL 1,PARSE + GETYP 0,A + CAIE 0,TFIX + JRST WRONGT + POP P,C + ADDI C,(TB) + MOVEM A,(C) + MOVEM B,1(C) + POP P,C + POP P,A + POPJ P, +] + + +; SUBROUTINE TO CHECK VALIDITY OF MODE AND SAVE A CODE + +CHMODE: PUSHJ P,CHMOD ; DO IT + MOVE C,T.SPDL+1(TB) + HRRZM A,S.DIR(C) + POPJ P, + +CHMOD: PUSHJ P,STRTO6 ; TO SIXBIT + POP P,B ; VALUE ENDSUP ON STACK, RESTORE IT + + MOVSI A,-NMODES ; SCAN TO SEE IF LEGAL MODE + CAME B,MODES(A) + AOBJN A,.-1 + JUMPGE A,WRONGD ; ILLEGAL MODE NAME + MOVE A,MODCOD(A) + POPJ P, + + +IFN ITS,[ +; RGPARS -- PARSE THE STRINGS COMPRISING FILE NAMES INTO STANDARD ITS GOODIES + +RGPRS: MOVEI 0,NOSTOR ; DONT STORE STRINGS IF ENTER HERE + +RGPARS: CAMGE AB,[-7,,] ; MULTI-STRING CASE POSSIBLE? + IORI 0,4ARG ; 4 STRING CASE + HRLM 0,(P) ; LH IS FLAGS FOR THIS PROG + MOVSI E,-4 ; FIELDS TO FILL + +RPARGL: GETYP 0,(AB) ; GET TYPE + CAIE 0,TCHSTR ; STRING? + JRST ARGCLB ; NO, JUST CLOBBER IT IN RAW + JUMPGE E,CPOPJ ; DON'T DO ANY MORE + PUSH TP,(AB) ; GET AN ARG + PUSH TP,1(AB) + +FPARS: PUSH TP,-1(TP) ; ANOTHER COPY + PUSH TP,-1(TP) + HLRZ 0,(P) + TRNN 0,4ARG + PUSHJ P,FLSSP ; NO LEADING SPACES + MOVEI A,0 ; WILL HOLD SIXBIT + MOVEI B,6 ; CHARS PER 6BIT WORD + MOVE C,[440600,,A] ; BYTE POINTER INTO A + +FPARSL: HRRZ 0,-1(TP) ; GET COUNT + JUMPE 0,PARSD ; DONE + SOS -1(TP) ; COUNT + ILDB 0,(TP) ; CHAR TO 0 + + CAIE 0," ; FILE NAME QUOTE? + JRST NOCNTQ + HRRZ 0,-1(TP) + JUMPE 0,PARSD + SOS -1(TP) + ILDB 0,(TP) ; USE THIS + JRST GOTCNQ + +NOCNTQ: HLL 0,(P) + TLNE 0,4ARG + JRST GOTCNQ + ANDI 0,177 + CAIG 0,40 ; SPACE? + JRST NDFLD ; YES, TERMINATE THIS FIELD + CAIN 0,": ; DEVICE ENDED? + JRST GOTDEV + CAIN 0,"; ; SNAME ENDED + JRST GOTSNM + +GOTCNQ: ANDI 0,177 + PUSHJ P,A0TO6 ; CONVERT TO 6BIT AND CHECK + + JUMPE B,FPARSL ; IGNORE IF AREADY HAVE 6 + IDPB 0,C + SOJA B,FPARSL + +; HERE IF SPACE ENCOUNTERED + +NDFLD: MOVEI D,(E) ; COPY GOODIE + PUSHJ P,FLSSP ; FLUSH REDUNDANT SPACES + JUMPE 0,PARSD ; NO CHARS LEFT + +NFL0: PUSH P,A ; SAVE SIXBIT WORD + SKIPGE -1(P) ; SKIP IF STRING TO BE STORED + JRST NFL1 + PUSH TP,$TAB ; PREVENT AB LOSSAGE + PUSH TP,AB + PUSHJ P,6TOCHS ; CONVERT TO STRING + MOVE AB,(TP) + SUB TP,[2,,2] +NFL1: HRRZ 0,-1(TP) ; RESTORE CHAR COUNT + +NFL2: MOVEI C,(D) ; COPY REL PNTR + SKIPGE -1(P) ; SKIP IF STRINGS TO BE STORED + JRST NFL3 + ASH D,1 ; TIMES 2 + ADDI D,T.NM1(TB) + MOVEM A,(D) ; STORE + MOVEM B,1(D) +NFL3: MOVSI A,N1SET ; FLAG IT + LSH A,(C) + IORM A,-1(P) ; AND CLOBBER + MOVE D,T.SPDL+1(TB) ; GET P BASE + POP P,@SIXTBL(C) ; AND STORE SIXBIT OF IT + + POP TP,-2(TP) ; MAKE NEW STRING POINTER + POP TP,-2(TP) + JUMPE 0,.+3 ; SKIP IF NO MORE CHARS + AOBJN E,FPARS ; MORE TO PARSE? +CPOPJ: POPJ P, ; RETURN, ALL DONE + + SUB TP,[2,,2] ; FLUSH OLD STRING + ADD E,[1,,1] + ADD AB,[2,,2] ; BUMP ARG + JUMPL AB,RPARGL ; AND GO ON +CPOPJ1: AOS A,(P) ; PREPARE TO WIN + HLRZS A + POPJ P, + + + +; HERE IF STRING HAS ENDED + +PARSD: PUSH P,A ; SAVE 6 BIT + MOVE A,-3(TP) ; CAN USE ARG STRING + MOVE B,-2(TP) + MOVEI D,(E) + JRST NFL2 ; AND CONTINUE + +; HERE IF JUST READ DEV + +GOTDEV: MOVEI D,2 ; CODE FOR DEVICE + JRST GOTFLD ; GOT A FIELD + +; HERE IF JUST READ SNAME + +GOTSNM: MOVEI D,3 +GOTFLD: PUSHJ P,FLSSP + SOJA E,NFL0 + + +; HERE FOR NON STRING ARG ENCOUNTERED + +ARGCLB: SKIPGE (P) ; IF NOT STORING, CONSIDER THIS THE END + + POPJ P, + MOVE C,T.SPDL+1(TB) ; GET P-BASE + MOVE A,S.DEV(C) ; GET DEVICE + CAME A,[SIXBIT /INT /]; IS IT THE INTERNAL DEVICE + JRST TRYNET ; NO, COUD BE NET + MOVE A,0 ; OFFNEDING TYPE TO A + PUSHJ P,APLQ ; IS IT APPLICABLE + JRST NAPT ; NO, LOSE + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] ; MUST BE LAST ARG + JUMPL AB,TMA + JRST CPOPJ1 ; ELSE SUCCESSFUL RETURN +TRYNET: CAIE 0,TFIX ; FOR NET DEV, ARGS MUST BE FIX + JRST WRONGT ; TREAT AS WRONG TYPE + MOVSI A,MSTNET ; BETTER BE NET EVENTUALLY + IORM A,(P) ; STORE FLAGS + MOVSI A,TFIX + MOVE B,1(AB) ; GET NUMBER + MOVEI 0,(E) ; MAKE SURE NOT DEVICE + CAIN 0,2 + JRST WRONGT + PUSH P,B ; SAVE NUMBER + MOVEI D,(E) ; SET FOR TABLE OFFSETS + MOVEI 0,0 + ADD TP,[4,,4] + JRST NFL2 ; GO CLOBBER IT AWAY +] + + +; ROUTINE TO FLUSH LEADING SPACES FROM A FIELD + +FLSSP: HRRZ 0,-1(TP) ; GET CHR COUNNT + JUMPE 0,CPOPJ ; FINISHED STRING +FLSS1: MOVE B,(TP) ; GET BYTR + ILDB C,B ; GETCHAR + CAIE C,^Q ; DONT FLUSH CNTL-Q + CAILE C,40 + JRST FLSS2 + MOVEM B,(TP) ; UPDATE BYTE POINTER + SOJN 0,FLSS1 + +FLSS2: HRRM 0,-1(TP) ; UPDATE STRING + POPJ P, + +IFN ITS,[ +;TABLE FOR STFUFFING SIXBITS AWAY + +SIXTBL: SETZ S.NM1(D) + SETZ S.NM2(D) + SETZ S.DEV(D) + SETZ S.SNM(D) + SETZ S.X1(D) +] + +RDTBL: SETZ RDEVIC(B) + SETZ RNAME1(B) + SETZ RNAME2(B) + SETZ RSNAME(B) + + + +IFE ITS,[ + +; TENEX VERSION OF FILE NAME PARSER (ONLY ACCEPT ARGS IN SINGLE STRING) + + +RGPRS: MOVEI 0,NOSTOR + +RGPARS: HRLM 0,(P) ; SAVE FOR STORE CHECKING + CAMGE AB,[-2,,] ; MULTI-STRING CASE POSSIBLE? + JRST TN.MLT ; YES, GO PROCESS +RGPRSS: GETYP 0,(AB) ; CHECK ARG TYPE + CAIE 0,TCHSTR + JRST WRONGT ; FOR NOW ONLY STRING ARGS WIN + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,FLSSP ; FLUSH LEADING SPACES + PUSHJ P,RGPRS1 + ADD AB,[2,,2] +CHKLST: JUMPGE AB,CPOPJ1 + SKIPGE (P) ; IF FROM OPEN, ALLOW ONE MORE + POPJ P, + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] + JUMPL AB,TMA +CPOPJ1: AOS (P) + POPJ P, + +RGPRS1: PUSH P,[0] ; ALLOW A DEVICE SPEC +TN.SNM: MOVE A,(TP) + HRRZ 0,-1(TP) + JUMPE 0,RPDONE + ILDB A,A + CAIE A,"< ; START "DIRECTORY" ? + JRST TN.N1 ; NO LOOK FOR NAME1 + SETOM (P) ; DEV NOT ALLOWED + IBP (TP) ; SKIP CHAR + SOS -1(TP) + PUSHJ P,TN.CNT ; COUNT CHARS TO ">" OR "." + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN3 + PUSH TP,0 + PUSH TP,C +TN.SN1: PUSHJ P,TN.CNT ; COUNT CHARS TO ">" + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN2 + MOVEM 0,-1(TP) + MOVEM C,(TP) + JRST TN.SN1 +TN.SN2: HRRZ B,-3(TP) + SUB B,0 + SUBI B,1 + SUB TP,[2,,2] +TN.SN3: CAIE A,"> ; SKIP IF WINS + JRST ILLNAM + PUSHJ P,TN.CPS ; COPY TO NEW STRING + HLLOS T.SPDL(TB) + MOVEM A,T.SNM(TB) + MOVEM B,T.SNM+1(TB) + +TN.N1: PUSHJ P,TN.CNT + JUMPE B,RPDONE + CAIE A,": ; GOT A DEVICE + JRST TN.N11 + SKIPE (P) + JRST ILLNAM + SETOM (P) + PUSHJ P,TN.CPS + MOVEM A,T.DEV(TB) + MOVEM B,T.DEV+1(TB) + JRST TN.SNM ; NOW LOOK FOR SNAME + +TN.N11: CAIE A,"> + CAIN A,"< + JRST ILLNAM + MOVEM A,(P) ; SAVE END CHAR + PUSHJ P,TN.CPS ; GEN STRING + MOVEM A,T.NM1(TB) + MOVEM B,T.NM1+1(TB) + +TN.N2: SKIPN A,(P) ; GET CHAR BACK + JRST RPDONE + CAIN A,"; ; START VERSION? + JRST .+3 + CAIE A,". ; START NAME2? + JRST ILLNAM ; I GIVE UP!!! + HRRZ B,-1(TP) ; GET RMAINS OF STRING + PUSHJ P,TN.CPS ; AND COPY IT + MOVEM A,T.NM2(TB) + MOVEM B,T.NM2+1(TB) +RPDONE: SUB P,[1,,1] ; FLUSH TEMP + SUB TP,[2,,2] +CPOPJ: POPJ P, + +TN.CNT: HRRZ 0,-1(TP) ; CHAR COUNT + MOVE C,(TP) ; BPTR + MOVEI B,0 ; INIT COUNT TO 0 + +TN.CN1: MOVEI A,0 ; IN CASE RUN OUT + SOJL 0,CPOPJ ; RUN OUT? + ILDB A,C ; TRY ONE + CAIE A," ; TNEX FILE QUOTE? + JRST TN.CN2 + SOJL 0,CPOPJ + IBP C ; SKIP QUOTED CHAT + ADDI B,2 + JRST TN.CN1 + +TN.CN2: CAIE A,"< + CAIN A,"> + POPJ P, + + CAIE A,". + CAIN A,"; + POPJ P, + CAIN A,": + POPJ P, + AOJA B,TN.CN1 + +TN.CPS: PUSH P,B ; # OF CHARS + MOVEI A,4(B) ; ADD 4 TO B IN A + IDIVI A,5 + PUSHJ P,IBLOCK ; GET BLOCK OF WORDS FOR STRING + + POP P,C ; CHAR COUNT BACK + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + HRRI A,(C) ; CHAR STRING + MOVE D,B ; COPY BYTER + + JUMPE C,CPOPJ + ILDB 0,(TP) ; GET CHAR + IDPB 0,D ; AND STROE + SOJG C,.-2 + + MOVNI C,(A) ; - LENGTH TO C + ADDB C,-1(TP) ; DECREMENT WORDS COUNT + TRNN C,-1 ; SKIP IF EMPTY + POPJ P, + IBP (TP) + SOS -1(TP) ; ELSE FLUSH TERMINATOR + POPJ P, + +ILLNAM: ERRUUO EQUOTE ILLEGAL-TENEX-FILE-NAME + +TN.MLT: MOVE A,AB ; AOBJN POINTER TO ARGS IN A + +TN.ML1: GETYP 0,(A) ; IS THIS ARG OF RIGHT TYPE + CAIE 0,TFIX + CAIN 0,TCHSTR + JRST .+2 + JRST RGPRSS ; ASSUME SINGLE STRING + ADD A,[2,,2] + JUMPL A,TN.ML1 ; TRY NEXT ARG IF ANY LEFT + + MOVEI 0,T.NM1(TB) ; 1ST WORD OF DESTINATION + HLRO A,AB ; MINUS NUMBER OF ARGS IN A + MOVN A,A ; NUMBER OF ARGS IN A + SUBI A,1 + CAMGE AB,[-10,,0] + MOVEI A,7 ; IF MORE THAN 10 ARGS, PUT 7 + ADD A,0 ; LAST WORD OF DESTINATION + HRLI 0,(AB) + BLT 0,(A) ; BLT 'EM IN + ADD AB,[10,,10] ; SKIP THESE GUYS + JRST CHKLST + +] + + +; ROUTINE TO OPEN A CHANNEL FOR ANY DEVICE. NAMES ARE ASSUMED TO ALREADY +; BE ON BOTH TP STACK AND P STACK + +OPNCH: MOVE C,T.SPDL+1(TB) ; GET PDL BASE + HRRZ A,S.DIR(C) + ANDI A,1 ; JUST WANT I AND O +IFE ITS,[ + HRLM A,S.DEV(C) +; .TRANS S.DEV(C) ; UNDO ANY TRANSLATIONS +; JRST TRLOST ; COMPLAIN +] +IFN ITS,[ + HRLM A,S.DIR(C) +] + +IFN ITS,[ + MOVE A,S.DEV(C) ; GET SIXBIT DEVICE CODE +] + +IFE ITS,[HRLZS A,S.DEV(C) +] + + MOVSI B,-NDEVS ; AOBJN COUNTER +DEVLP: SETO D, + MOVE 0,DEVSTB(B) ; GET ONE FROM TABLE + MOVE E,A +DEVLP1: AND E,D ; FLUSH POSSIBLE DIGITNESS + CAMN 0,E + JRST CHDIGS ; MAKE SURE REST IS DIGITS + LSH D,6 + JUMPN D,DEVLP1 ; KEEP TRUCKING UNTIL DONE + +; WASN'T THAT DEVICE, MOVE TO NEXT +NXTDEV: AOBJN B,DEVLP + JRST ODSK ; UNKNOWN DEVICE IS ASSUMED TO BE DISK + +IFN ITS,[ +OUSR: HRRZ A,S.DIR(C) ; BLOCK OR UNIT? + TRNE A,2 ; SKIP IF UNIT + JRST ODSK + PUSHJ P,OPEN1 ; OPEN IT + PUSHJ P,FIXREA ; AND READCHST IT + MOVE B,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVE 0,[PUSHJ P,DOIOT] ; GET AN IOINS + MOVEM 0,IOINS(B) + MOVE C,T.SPDL+1(TB) + HRRZ A,S.DIR(C) + TRNN A,1 + JRST EOFMAK + MOVEI 0,80. + MOVEM 0,LINLN(B) + JRST OPNWIN + +OSTY: HLRZ A,S.DIR(C) + IORI A,10 ; THE DONT LOSE BIT (DONT HANG ON INPUT DO ON OUTPUT) + HRLM A,S.DIR(C) + JRST OUSR +] + +; MAKE SURE DIGITS EXIST + +CHDIGS: SETCA D, + JUMPE D,DISPA ; NO DIGITS, WIN IMMEDIATE + MOVE E,A + AND E,D ; LEAVES ONLY DIGITS, IF WINNING + LSH E,6 + LSH D,6 + JUMPG D,.-2 ; KEEP GOING TIL DIGITS LEFT SHIFTED + JRST CHDIGN + +CHDIG1: CAIG D,'9 + CAIGE D,'0 + JRST NXTDEV ; NOT A DIGIT, LOSE + JUMPE E,DISPA ; IF THAT'S ALL THE CHARACTERS, WIN! +CHDIGN: SETZ D, + ROTC D,6 ; GET NEXT CHARACTER INTO D + JRST CHDIG1 ; GO TEST? + +; HERE TO DISPATCH IF SUCCESSFUL + +DISPA: JRST @DEVS(B) + + +IFN ITS,[ + +; DISK DEVICE OPNER COME HERE + +ODSK: MOVE A,S.SNM(C) ; GET SNAME + .SUSET [.SSNAM,,A] ; CLOBBER IT + PUSHJ P,OPEN0 ; DO REAL LIVE OPEN +] +IFE ITS,[ + +; TENEX DISK FILE OPENER + +ODSK: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + PUSHJ P,STSTK ; EXPAND STRING ONTO STACK (E POINTS TO OLD P) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; GET DIR NAME + MOVE C,(P) + MOVE D,T.SPDL+1(TB) + HRRZ D,S.DIR(D) + CAME C,[SIXBIT /PRINAO/] + CAMN C,[SIXBIT /PRINTO/] + IORI D,100 ; TURN ON BIT TO SAY USE OLD FILE + MOVSI A,101 ; START SETTING UP BITS EXTRA BIT FOR MSB + TRNE D,1 ; SKIP IF INPUT + TRNE D,100 ; WITE OVER? + TLOA A,100000 ; FORCE OLD VERSION + TLO A,600000 ; FORCE NEW VERSION + HRROI B,1(E) ; POINT TO STRING + GTJFN + TDZA 0,0 ; SAVE FACT OF NO SKIP + MOVEI 0,1 ; INDICATE SKIPPED + POP P,C ; RECOVER OPEN MODE SIXBIT + MOVE P,E ; RESTORE PSTACK + JUMPE 0,GTJLOS ; FIND OUT WHAT HAPPENED + + MOVE B,T.CHAN+1(TB) ; GET CHANNEL + HRRZ 0,-4(B) ; FUNNY MODE BITS + HRRZM A,CHANNO(B) ; SAVE IT + ANDI A,-1 ; READ Y TO DO OPEN + MOVSI B,440000 ; USE 36. BIT BYES + HRRI B,200000 ; ASSUME READ +; CAMN C,[SIXBIT /READB/] +; TRO B,2000 ; TURN ON THAWED IF READB + IOR B,0 + TRNE D,1 ; SKIP IF READ + HRRI B,300000 ; WRITE BIT + HRRZ 0,FSAV(TB) ; SEE IF REF DATE HACK + CAIN 0,NFOPEN + TRO B,400 ; SET DON'T MUNG REF DATE BIT + MOVE E,B ; SAVE BITS FOR REOPENS + OPENF + JRST OPFLOS + MOVE B,[2,,11] ; GET LENGTH & BYTE SIZE + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + GTFDB + LDB 0,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + CAIN 0,7 + JRST SIZASC + CAIN 0,36. + SIZEF ; USE OPENED SIZE + JFCL + IMULI B,5 ; TO BYTES +SIZASC: MOVEI 0,C.OPN+C.READ+C.DISK + TRNE D,1 ; SKIP FOR READ + MOVEI 0,C.OPN+C.PRIN+C.DISK + TRNE D,2 ; SKIP IF NOT BINARY FILE + TRO 0,C.BIN + HRL 0,B + MOVE B,T.CHAN+1(TB) + TRNE D,1 + HLRM 0,LSTCH-1(B) ; SAVE CURRENT LENGTH + MOVEM E,STATUS(B) + HRRM 0,-2(B) ; MUNG THOSE BITS + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + PUSHJ P,TMTNXS ; GET STRING FROM TENEX + MOVE B,CHANNO(B) ; JFN TO A + HRROI A,1(E) ; BASE OF STRING + MOVE C,[111111,,140001] ; WEIRD CONTROL BITS + JFNS ; GET STRING + MOVEI B,1(E) ; POINT TO START OF STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; MAKE INTO A STRING + SUB P,E ; BACK TO NORMAL + PUSH TP,A + PUSH TP,B + PUSHJ P,RGPRS1 ; PARSE INTO FIELDS + MOVE B,T.CHAN+1(TB) + MOVEI C,RNAME1-1(B) + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + JRST OPBASC +OPFLOS: MOVEI C,(A) ; SAVE ERROR CODE + MOVE B,T.CHAN+1(TB) + HRRZ A,CHANNO(B) ; JFN BACK TO A + RLJFN ; TRY TO RELEASE IT + JFCL + MOVEI A,(C) ; ERROR CODE BACK TO A + +GTJLOS: MOVE B,T.CHAN+1(TB) + PUSHJ P,TGFALS ; GET A FALSE WITH REASON + JRST OPNRET + +STSTK: PUSH TP,$TCHAN + PUSH TP,B + MOVEI A,4+5 ; COUNT CHARS NEEDED (NEED LAST 0 BYTE) + MOVE B,(TP) + ADD A,RDEVIC-1(B) + ADD A,RNAME1-1(B) + ADD A,RNAME2-1(B) + ADD A,RSNAME-1(B) + ANDI A,-1 ; TO 18 BITS + MOVEI 0,A(A) + IDIVI A,5 ; TO WORDS NEEDED + POP P,C ; SAVE RET ADDR + MOVE E,P ; SAVE POINTER + PUSH P,[0] ; ALOCATE SLOTS + SOJG A,.-1 + PUSH P,C ; RET ADDR BACK + INTGO ; IN CASE OVERFLEW + PUSH P,0 + MOVE B,(TP) ; IN CASE GC'D + MOVE D,[440700,,1(E)] ; BYTE POINTER TO IT + MOVEI A,RDEVIC-1(B) + PUSHJ P,MOVSTR ; FLUSH IT ON + HRRZ A,T.SPDL(TB) + JUMPN A,NLNMS ; USER GAVE NAME, USE IT (CAREFUL, RELIES ON + ; A BEING NON ZERO) + PUSH P,B + PUSH P,C + MOVEI A,0 ; HERE TO SEE IF THIS IS REALLY L.N. + HRROI B,1(E) + HRROI C,1(P) + LNMST ; LOOK UP LOGICAL NAME + MOVNI A,1 ; NOT A LOGICAL NAME + POP P,C + POP P,B +NLNMS: MOVEI 0,": + IDPB 0,D + JUMPE A,ST.NM1 ; LOGICAL NAME, FLUSH SNAME + HRRZ A,RSNAME-1(B) ; ANY SNAME AT ALL? + JUMPE A,ST.NM1 ; NOPE, CANT HACK WITH IT + MOVEI A,"< + IDPB A,D + MOVEI A,RSNAME-1(B) + PUSHJ P,MOVSTR ; SNAME UP + MOVEI A,"> + IDPB A,D +ST.NM1: MOVEI A,RNAME1-1(B) + PUSHJ P,MOVSTR + MOVEI A,". + IDPB A,D + MOVEI A,RNAME2-1(B) + PUSHJ P,MOVSTR + SUB TP,[2,,2] + POP P,A + POPJ P, + +MOVSTR: HRRZ 0,(A) ; CHAR COUNT + MOVE A,1(A) ; BYTE POINTER + SOJL 0,CPOPJ + ILDB C,A ; GET CHAR + IDPB C,D ; MUNG IT UP + JRST .-3 + +; MAKE A TENEX ERROR MESSAGE STRING + +TGFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; SAVE ERROR CODE + PUSHJ P,TMTNXS ; STRING ON STACK + HRROI A,1(E) ; POINT TO SPACE + MOVE B,(E) ; ERROR CODE + HRLI B,400000 ; FOR ME + MOVSI C,-100. ; MAX CHARS + ERSTR ; GET TENEX STRING + JRST TGFLS1 + JRST TGFLS1 + + MOVEI B,1(E) ; A AND B BOUND STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; BUILD STRING + SUB P,E ; P BACK TO NORMAL +TGFLS2: +IFE FNAMS, SUB P,[1,,1] ; FLUSH ERROR CODE SLOT +IFN FNAMS,[ + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST TGFLS3 + PUSHJ P,STSTK + MOVEI B,1(E) + SUBM P,E + MOVSI A,440700 + HRRI A,(P) + MOVEI C,5 + ILDB 0,A + JUMPE 0,.+2 + SOJG C,.-2 + + PUSHJ P,TNXSTR + PUSH TP,A + PUSH TP,B + SUB P,E +TGFLS3: POP P,A + PUSH TP,$TFIX + PUSH TP,A + MOVEI A,3 + SKIPN B + MOVEI A,2 +] +IFE FNAMS,[ + MOVEI A,1 +] + PUSHJ P,IILIST ; BUILD LIST + MOVSI A,TFALSE ; MAKE IT FALSE + SUB TP,[2,,2] + POPJ P, + +TGFLS1: MOVE P,E ; RESET STACK + MOVE A,$TCHSTR + MOVE B,CHQUOTE UNKNOWN PROBLEM IN I/O + JRST TGFLS2 + +] +; OTHER BUFFERED DEVICES JOIN HERE + +OPDSK1: +IFN ITS,[ + PUSHJ P,FIXREA ; STORE THE "REAL" NAMES INTO THE CHANNEL +] +OPBASC: MOVE C,T.SPDL+1(TB) ; C WAS CLOBBERED, GET IT BACK + HRRZ A,S.DIR(C) ; FIND OUT IF OPEN IS ASCII OR WORD + TRZN A,2 ; SKIP IF BINARY + PUSHJ P,OPASCI ; DO IT FOR ASCII + +; NOW SET UP IO INSTRUCTION FOR CHANNEL + +MAKION: MOVE B,T.CHAN+1(TB) + MOVEI C,GETCHR + JUMPE A,MAKIO1 ; JUMP IF INPUT + MOVEI C,PUTCHR ; ELSE GET INPUT + MOVEI 0,80. ; DEFAULT LINE LNTH + MOVEM 0,LINLN(B) + MOVSI 0,TFIX + MOVEM 0,LINLN-1(B) +MAKIO1: + HRLI C,(PUSHJ P,) + MOVEM C,IOINS(B) ; STORE IT + JUMPN A,OPNWIN ; GET AN EOF FORM FOR INPUT CHANNEL + +; HERE TO CONS UP + +EOFMAK: MOVSI C,TATOM + MOVE D,EQUOTE END-OF-FILE + PUSHJ P,INCONS + MOVEI E,(B) + MOVSI C,TATOM + MOVE D,IMQUOTE ERROR + PUSHJ P,ICONS + MOVE D,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVSI 0,TFORM + MOVEM 0,EOFCND-1(D) + MOVEM B,EOFCND(D) + +OPNWIN: MOVEI 0,10. ; SET UP RADIX + MOVSI A,TCHAN ; OPEN SUCCEEDED, RET CHANNEL + MOVE B,T.CHAN+1(TB) + MOVEM 0,RADX(B) + +OPNRET: MOVE D,T.CHAN+1(TB) ; IN CASE WE RECYCLE IT + MOVE C,(P) ; RET ADDR + SUB P,[S.X3+2,,S.X3+2] + SUB TP,[T.CHAN+2,,T.CHAN+2] + JRST (C) + + +; HERE TO CREATE CHARACTER BUFFERS FOR ASCII I/O + +OPASCI: PUSH P,A ; CONTAINS MODE, SAVE IT + MOVEI A,BUFLNT ; GET SIZE OF BUFFER + PUSHJ P,IBLOCK ; GET STORAGE + MOVSI 0,TWORD+.VECT. ; SET UTYPE + MOVEM 0,BUFLNT(B) ; AND STORE + MOVSI A,TCHSTR + SKIPE (P) ; SKIP IF INPUT + JRST OPASCO + MOVEI D,BUFLNT-1(B) ; REST BYTE POINTER +OPASCA: HRLI D,010700 + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEI 0,C.BUF + IORM 0,-2(B) ; TURN ON BUFFER BIT + MOVEM A,BUFSTR-1(B) + MOVEM D,BUFSTR(B) ; CLOBBER + POP P,A + POPJ P, + +OPASCO: HRROI C,777776 + MOVEM C,(B) ; -1 THE BUFFER (LEAVE OFF LOW BIT) + MOVSI C,(B) + HRRI C,1(B) ; BUILD BLT POINTER + BLT C,BUFLNT-1(B) ; ZAP + MOVEI D,-1(B) ; START MAKING STRING POINTER + HRRI A,BUFLNT*5 ; SET UP CHAR COUNT + JRST OPASCA + + +; OPEN NON FILE ORIENTED DEVICES (NUL, PTR, PTP ETC.) + +IFN ITS,[ +ONUL: +OPTP: +OPTR: PUSHJ P,OPEN0 ; SET UP MODE AND OPEN + SETZM S.NM1(C) ; CLOBBER UNINTERESTING FIELDS + SETZM S.NM2(C) + SETZM S.SNM(C) + JRST OPDSK1 + +; OPEN DEVICES THAT IGNORE SNAME + +OUTN: PUSHJ P,OPEN0 + SETZM S.SNM(C) + JRST OPDSK1 + +] + +; INTERNAL CHANNEL OPENER + +OINT: HRRZ A,S.DIR(C) ; CHECK DIR + CAIL A,2 ; READ/PRINT? + JRST WRONGD ; NO, LOSE + + MOVE 0,INTINS(A) ; GET INS + MOVE D,T.CHAN+1(TB) ; AND CHANNEL + MOVEM 0,IOINS(D) ; AND CLOBBER + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + HRRM 0,-2(D) + SETOM STATUS(D) ; MAKE SURE NOT AA TTY + PMOVEM T.XT(TB),INTFCN-1(D) + +; HERE TO SAVE PSEUDO CHANNELS + +SAVCHN: HRRZ E,CHNL0+1 ; POINT TO CURRENT LIST + MOVSI C,TCHAN + PUSHJ P,ICONS ; CONS IT ON + HRRZM B,CHNL0+1 + JRST OPNWIN + +; INT DEVICE I/O INS + +INTINS: PUSHJ P,GTINTC + PUSHJ P,PTINTC + + +; HERE TO OPEN THE NET DEVICE (I.E. THE ARPA NET) + +IFN ITS,[ +ONET: HRRZ A,S.DIR(C) ; DIRECTION CODE + CAILE A,1 ; ASCII ? + IORI A,4 ; TURN ON IMAGE BIT + SKIPGE S.NM1(C) ; NAME1 I.E. LOCAL HOST GIVEN + IORI A,10 ; NO, WE WILL LET ITS GIVE US ONE + SKIPGE S.NM2(C) ; NORMAL OR "LISTEN" + IORI A,20 ; TURN ON LISTEN BIT + MOVEI 0,7 ; DEFAULT BYTE SIZE + TRNE A,2 ; UNLESS + MOVEI 0,36. ; IMAGE WHICH IS 36 + SKIPN T.XT(TB) ; BYTE SIZE GIVEN? + MOVEM 0,S.X1(C) ; NO, STORE DEFAULT + SKIPG D,S.X1(C) ; BYTE SIZE REASONABLE? + JRST RBYTSZ ; NO <0, COMPLAIN + TRNE A,2 ; SKIP TO CHECK ASCII + JRST ONET2 ; CHECK IMAGE + CAIN D,7 ; 7-BIT WINS + JRST ONET1 + CAIE D,44 ; 36-BIT INDICATES BLOCK ASCII MODE + JRST .+3 + IORI A,2 ; SET BLOCK FLAG + JRST ONET1 + IORI A,40 ; USE 8-BIT MODE + CAIN D,10 ; IS IT RIGHT + JRST ONET1 ; YES +] + +RBYTSZ: ERRUUO EQUOTE BYTE-SIZE-BAD + +IFN ITS,[ +ONET2: CAILE D,36. ; IMAGE SIZE REASONABLE? + JRST RBYTSZ ; NO + CAIN D,36. ; NORMAL + JRST ONET1 ; YES, DONT SET FIELD + + ASH D,9. ; POSITION FOR FIELD + IORI A,40(D) ; SET IT AND ITS BIT + +ONET1: HRLM A,S.DIR(C) ; CLOBBER OPEN BLOCK + MOVE E,A ; SAVE BLOCK MODE INFO + PUSHJ P,OPEN1 ; DO THE OPEN + PUSH P,E + +; CLOBBER REAL SLOTS FOR THE OPEN + + MOVEI A,3 ; GET STATE VECTOR + PUSHJ P,IBLOCK + MOVSI A,TUVEC + MOVE D,T.CHAN+1(TB) + HLLM A,BUFRIN-1(D) + MOVEM B,BUFRIN(D) + MOVSI A,TFIX+.VECT. ; SET U TYPE + MOVEM A,3(B) + MOVE C,T.SPDL+1(TB) + MOVE B,T.CHAN+1(TB) + + PUSHJ P,INETST ; GET STATE + + POP P,A ; IS THIS BLOCK MODE + MOVEI 0,80. ; POSSIBLE LINE LENGTH + TRNE A,1 ; SKIP IF INPUT + MOVEM 0,LINLN(B) + TRNN A,2 ; BLOCK MODE? + JRST .+3 + TRNN A,4 ; ASCII MODE? + JRST OPBASC ; GO SETUP BLOCK ASCII + MOVE 0,[PUSHJ P,DOIOT] + MOVEM 0,IOINS(B) + + JRST OPNWIN + +; INTERNAL ROUTINE TO GET THE CURRENT STATE OF THE NETWROK CHANNEL + +INETST: MOVE A,S.NM1(C) + MOVEM A,RNAME1(B) + MOVE A,S.NM2(C) + MOVEM A,RNAME2(B) + LDB A,[1100,,S.SNM(C)] + MOVEM A,RSNAME(B) + + MOVE E,BUFRIN(B) ; GET STATE BLOCK +INTST1: HRRE 0,S.X1(C) + MOVEM 0,(E) + ADDI C,1 + AOBJN E,INTST1 + + POPJ P, + + +; ACCEPT A CONNECTION + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET ; CHECK THAT ARG IS AN OPEN NET CHANNEL + MOVE A,CHANNO(B) ; GET CHANNEL + LSH A,23. ; TO AC FIELD + IOR A,[.NETACC] + XCT A + JRST IFALSE ; RETURN FALSE +NETRET: MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +; FORCE SYSTEM NETWORK BUFFERS TO BE SENT + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 + CAMN A,MODES+3 + SKIPA A,CHANNO(B) ; GET CHANNEL + JRST WRONGD + LSH A,23. + IOR A,[.NETS] + XCT A + JRST NETRET + +; SUBR TO RETURN UPDATED NET STATE + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET ; IS IT A NET CHANNEL + PUSHJ P,INSTAT + JRST FINIS + +; INTERNAL NETSTATE ROUTINE + +INSTAT: MOVE C,P ; GET PDL BASE + MOVEI 0,S.X3 ; # OF SLOTS NEEDED + PUSH P,[0] + SOJN 0,.-1 +; RESTORED FROM MUDDLE 54. IT SEEMED TO WORK THERE, AND THE STUFF +; COMMENTED OUT HERE CERTAINLY DOESN'T. + MOVEI D,S.DEV(C) + HRL D,CHANNO(B) + .RCHST D, +; HRR D,CHANNO(B) ; SETUP FOR RFNAME CALL +; DOTCAL RFNAME,[D,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] +; .LOSE %LSFIL ; THIS MAY NOT BE DESIRABLE, BUT I ASSUME WE CARE IF + ; LOSSAGE + PUSHJ P,INETST ; INTO VECTOR + SUB P,[S.X3,,S.X3] + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + POPJ P, +] +; INTERNAL ROUTINE TO CHECK FOR CORRECT CHANNEL TYPE + +ARGNET: ENTRY 1 + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; OPEN? + JRST CHNCLS + MOVE A,RDEVIC-1(B) ; GET DEV NAME + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 + POP P,A + CAME A,[SIXBIT /NET /] + JRST NOTNET + MOVE B,1(AB) + MOVE A,DIRECT-1(B) ; CHECK FOR A READ SOCKET + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 + MOVE B,1(AB) ; RESTORE CHANNEL + POP P,A + POPJ P, + +IFE ITS,[ + +; TENEX NETWRK OPENING CODE + +ONET: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + MOVSI C,100700 + HRRI C,1(P) + MOVE E,P + PUSH P,[ASCII /NET:/] ; FOR STRINGS + GETYP 0,RNAME1-1(B) ; CHECK TYPE + CAIE 0,TFIX ; SKIP IF # SUPPLIED + JRST ONET1 + MOVE 0,RNAME1(B) ; GET IT + PUSHJ P,FIXSTK + JFCL + JRST ONET2 +ONET1: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME1-1(B) + MOVE B,RNAME1(B) + JUMPE 0,ONET2 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 +ONET2: MOVEI A,". + JSP D,ONETCH + MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIE 0,TFIX + JRST ONET3 + GETYP 0,RSNAME-1(B) + CAIE 0,TFIX + JRST WRONGT + MOVE 0,RSNAME(B) + CAIG 0,377 ;NEW STYLE 32 BIT HOST NUMBER? + JRST ONET2A +;CONVERT HOSTS2 HOST NUMBERS TO INTERNET (TOPS-20) HOST NUMBERS + MOVEI A,0 + LDB B,[001100,,0] ;HOST NUMBER: 1.1-1.9 -> + DPB B,[201000,,A] ; 2.8-3.6 + LDB B,[111100,,0] ;IMP LOW BITS: 2.1-2.9 -> + DPB B,[001000,,A] ; 1.1-1.8 + LDB B,[221100,,0] ;IMP HIGH BITS: 3.1-3.9 -> + DPB B,[101000,,A] ; 1.9-2.7 + LDB B,[331100,,0] ;NETWORK: 4.1-4.9 -> + DPB B,[301000,,A] ; 3.7-4.5 + MOVE 0,A +ONET2A: PUSHJ P,FIXSTK + JRST ONET4 + MOVE B,T.CHAN+1(TB) + MOVEI A,"- + JSP D,ONETCH + MOVE 0,RNAME2(B) + PUSHJ P,FIXSTK + JRST WRONGT + JRST ONET4 +ONET3: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME2-1(B) + MOVE B,RNAME2(B) + JUMPE 0,ONET4 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 + +ONET4: +ONET5: MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIN 0,TCHSTR + JRST ONET6 + MOVEI A,"; + JSP D,ONETCH + MOVEI A,"T + JSP D,ONETCH +ONET6: MOVSI A,1 + HRROI B,1(E) ; STRING POINTER + GTJFN ; GET THE G.D JFN + TDZA 0,0 ; REMEMBER FAILURE + MOVEI 0,1 + MOVE P,E ; RESTORE P + JUMPE 0,GTJLOS ; CONS UP ERROR STRING + + MOVE B,T.CHAN+1(TB) + HRRZM A,CHANNO(B) ; SAVE THE JFN + + MOVE C,T.SPDL+1(TB) + MOVE D,S.DIR(C) + MOVEI B,10 + TRNE D,2 + MOVEI B,36. + SKIPE T.XT(TB) + MOVE B,T.XT+1(TB) + JUMPL B,RBYTSZ + CAILE B,36. + JRST RBYTSZ + ROT B,-6 + TLO B,3400 + HRRI B,200000 + TRNE D,1 ; SKIP FOR INPUT + HRRI B,100000 + ANDI A,-1 ; ISOLATE JFCN + OPENF + JRST OPFLOS ; REPORT ERROR + MOVE B,T.CHAN+1(TB) + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) + CVSKT ; GET ABS SOCKET # + FATAL NETWORK BITES THE BAG! + MOVE D,B + MOVE B,T.CHAN+1(TB) + MOVEM D,RNAME1(B) + MOVSI 0,TFIX + MOVEM 0,RNAME1-1(B) + + MOVSI 0,TFIX + MOVEM 0,RNAME2-1(B) + MOVEM 0,RSNAME-1(B) + MOVE C,T.SPDL+1(TB) + MOVE C,S.DIR(C) + MOVE 0,[PUSHJ P,DONETO] + TRNN C,1 ; SKIP FOR OUTPUT + MOVE 0,[PUSHJ P,DONETI] + MOVEM 0,IOINS(B) + MOVEI 0,80. ; LINELENGTH + TRNE C,1 ; SKIP FOR INPUT + MOVEM 0,LINLN(B) + MOVEI A,3 ; GET STATE UVECTOR + PUSHJ P,IBLOCK + MOVSI 0,TFIX+.VECT. + MOVEM 0,3(B) + MOVE C,B + MOVE B,T.CHAN+1(TB) + MOVEM C,BUFRIN(B) + MOVSI 0,TUVEC + HLLM 0,BUFRIN-1(B) + MOVE B,CHANNO(B) ; GET JFN + MOVEI A,4 ; CODE FOR GTNCP + MOVEI C,1(P) + ADJSP P,4 ; ROOM FOR DATA + MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC + GTNCP + FATAL NET LOSSAGE ; GET STATE + MOVE B,(P) + MOVE D,-1(P) + MOVE C,-3(P) + ADJSP P,-4 + MOVE E,T.CHAN+1(TB) + MOVEM D,RNAME2(E) + MOVEM C,RSNAME(E) + MOVE C,BUFRIN(E) + MOVEM B,(C) ; INITIAL STATE STORED + MOVE B,E + JRST OPNWIN + +; DOIOT FOR TENEX NETWRK + +DONETO: PUSH P,0 + MOVE 0,[BOUT] + JRST .+3 + +DONETI: PUSH P,0 + MOVE 0,[BIN] + PUSH P,0 + PUSH TP,$TCHAN + PUSH TP,B + MOVEI 0,(A) ; POSSIBLE OUTPUT CHAR TO 0 + MOVE A,CHANNO(B) + MOVE B,0 + ENABLE + XCT (P) + DISABLE + MOVEI A,(B) ; RET CHAR IN A + MOVE B,(TP) + MOVE 0,-1(P) + SUB P,[2,,2] + SUB TP,[2,,2] + POPJ P, + +NETPRS: MOVEI D,0 + HRRZ 0,(C) + MOVE C,1(C) + +ONETL: ILDB A,C + CAIN A,"# + POPJ P, + SUBI A,60 + ASH D,3 + IORI D,(A) + SOJG 0,ONETL + AOS (P) + POPJ P, + +FIXSTK: CAMN 0,[-1] + POPJ P, + JFFO 0,FIXS3 ; PUT OCTAL DIGITS INTO STIRNG + MOVEI A,"0 + POP P,D + AOJA D,ONETCH +FIXS3: IDIVI A,3 + MOVEI B,12. + SUBI B,(A) + HRLM B,(P) + IMULI A,3 + LSH 0,(A) + POP P,B +FIXS2: MOVEI A,0 + ROTC 0,3 ; NEXT DIGIT + ADDI A,60 + JSP D,ONETCH + SUB B,[1,,0] + TLNN B,-1 + JRST 1(B) + JRST FIXS2 + +ONETCH: IDPB A,C + TLNE C,760000 ; SKIP IF NEW WORD + JRST (D) + PUSH P,[0] + JRST (D) + +INSTAT: MOVE E,B + MOVE B,CHANNO(B) ; GET JFN + MOVEI A,4 ; CODE FOR GTNCP + MOVEI C,1(P) + ADJSP P,4 ; ROOM FOR DATA + MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC + GTNCP + FATAL NET LOSSAGE ; GET STATE + MOVE B,(P) + MOVE D,-1(P) + MOVE C,-3(P) + ADJSP P,-4 + MOVEM D,RNAME2(E) ; UPDATE FOREIGN SOCHKET + MOVEM C,RSNAME(E) ; AND HOST + MOVE C,BUFRIN(E) + XCT ITSTRN(B) ; XLATE TO LOOK MORE LIKE ITS + MOVEM B,(C) ; STORE STATE + MOVE B,E + POPJ P, + +ITSTRN: MOVEI B,0 + JRST NLOSS + JRST NLOSS + MOVEI B,1 + MOVEI B,2 + JRST NLOSS + MOVEI B,4 + PUSHJ P,NOPND + MOVEI B,0 + JRST NLOSS + JRST NLOSS + PUSHJ P,NCLSD + MOVEI B,0 + JRST NLOSS + MOVEI B,0 + +NLOSS: FATAL ILLEGAL NETWORK STATE + +NOPND: MOVE B,DIRECT(E) ; SEE IF READ OR PRINT + ILDB B,B ; GET 1ST CHAR + CAIE B,"R ; SKIP FOR READ + JRST NOPNDW + SIBE ; SEE IF INPUT EXISTS + JRST .+3 + MOVEI B,5 + POPJ P, + MOVEM B,2(C) ; STORE BYTES IN STATE VECTOR + MOVEI B,11 ; RETURN DATA PRESENT STATE + POPJ P, + +NOPNDW: SOBE ; SEE IF OUTPUT PRESENT + JRST .+3 + MOVEI B,5 + POPJ P, + + MOVEI B,6 + POPJ P, + +NCLSD: MOVE B,DIRECT(E) + ILDB B,B + CAIE B,"R + JRST RET0 + SIBE + JRST .+2 + JRST RET0 + MOVEI B,10 + POPJ P, + +RET0: MOVEI B,0 + POPJ P, + + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET + PUSHJ P,INSTAT + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + JRST FINIS + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 ; PRINT OR PRINTB? + CAMN A,MODES+3 + SKIPA A,CHANNO(B) + JRST WRONGD + MOVEI B,21 + MTOPR +NETRET: MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET + MOVE A,CHANNO(B) + MOVEI B,20 + MTOPR + JRST NETRET + +] + +; HERE TO OPEN TELETYPE DEVICES + +OTTY: HRRZ A,S.DIR(C) ; GET DIR CODE + TRNE A,2 ; SKIP IF NOT READB/PRINTB + JRST WRONGD ; CANT DO THAT + +IFN ITS,[ + MOVE A,S.NM1(C) ; CHECK FOR A DIR + MOVE 0,S.NM2(C) + CAMN A,[SIXBIT /.FILE./] + CAME 0,[SIXBIT /(DIR)/] + SKIPA E,[-15.*2,,] + JRST OUTN ; DO IT THAT WAY + + HRRZ A,S.DIR(C) ; CHECK DIR + TRNE A,1 + JRST TTYLP2 + HRRI E,CHNL1 + PUSH P,S.DEV(C) ; SAVE THE SIXBIT DEV NAME + ; HRLZS (P) ; POSTITION DEVICE NAME + +TTYLP: SKIPN D,1(E) ; CHANNEL OPEN? + JRST TTYLP1 ; NO, GO TO NEXT + MOVE A,RDEVIC-1(D) ; GET DEV NAME + MOVE B,RDEVIC(D) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A ; GET RESULT + CAMN A,(P) ; SAME? + JRST SAMTYQ ; COULD BE THE SAME +TTYLP1: ADD E,[2,,2] + JUMPL E,TTYLP + SUB P,[1,,1] ; THIS ONE MUST BE UNIQUE +TTYLP2: MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; GET DIR OF OPEN + SKIPE A ; IF OUTPUT, + IORI A,20 ; THEN USE DISPLAY MODE + HRLM A,S.DIR(C) ; STORE IN OPEN BLOCK + PUSHJ P,OPEN2 ; OPEN THE TTY + MOVE A,S.DEV(C) ; GET DEVICE NAME + PUSHJ P,6TOCHS ; TO A STRING + MOVE D,T.CHAN+1(TB) ; POINT TO CHANNEL + MOVEM A,RDEVIC-1(D) + MOVEM B,RDEVIC(D) + MOVE C,T.SPDL+1(TB) ; RESTORE PDL BASE + MOVE B,D ; CHANNEL TO B + HRRZ 0,S.DIR(C) ; AND DIR + JUMPE 0,TTYSPC +TTY1: DOTCAL TTYGET,[CHANNO(B),[2000,,0],[2000,,A],[2000,,D]] + .LOSE %LSSYS + DOTCAL TTYSET,[CHANNO(B),MODE1,MODE2,D] + .LOSE %LSSYS + MOVE A,[PUSHJ P,GMTYO] + MOVEM A,IOINS(B) + DOTCAL RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]] + .LOSE %LSSYS + MOVEM D,LINLN(B) + MOVEM A,PAGLN(B) + JRST OPNWIN + +; MAKE AN IOT + +IOTMAK: HRLZ A,CHANNO(B) ; GET CHANNEL + ROT A,5 + IOR A,[.IOT A] ; BUILD IOT + MOVEM A,IOINS(B) ; AND STORE IT + POPJ P, + + +; HERE IF POSSIBLY OPENING AN ALREADY OPEN TTY + +SAMTYQ: MOVE D,1(E) ; RESTORE CURRENT CHANNEL + MOVE A,DIRECT-1(D) ; GET DIR + MOVE B,DIRECT(D) + PUSHJ P,STRTO6 + POP P,A ; GET SIXBIT + MOVE C,T.SPDL+1(TB) + HRRZ C,S.DIR(C) + CAME A,MODES(C) ; SKIP IF DIFFERENT DIRECTION + JRST TTYLP1 + +; HERE IF A RE-OPEN ON A TTY + + HRRZ 0,FSAV(TB) ; IS IT FROM A FOPEN + CAIN 0,FOPEN + JRST RETOLD ; RET OLD CHANNEL + + PUSH TP,$TCHAN + PUSH TP,1(E) ; PUSH OLD CHANNEL + PUSH TP,$TFIX + PUSH TP,T.CHAN+1(TB) + MOVE A,[PUSHJ P,CHNFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + SUB TP,[4,,4] + +RETOLD: MOVE B,1(E) ; GET CHANNEL + AOS CHANNO-1(B) ; AOS REF COUNT + MOVSI A,TCHAN + SUB P,[1,,1] ; CLEAN UP STACK + JRST OPNRET ; AND LEAVE + + +; ROUTINE TO PASS TO GCHACK TO FIX UP CHANNEL POINTER + +CHNFIX: CAIN C,TCHAN + CAME D,(TP) + POPJ P, + MOVE D,-2(TP) ; GET REPLACEMENT + SKIPE B + MOVEM D,1(B) ; CLOBBER IT AWAY + POPJ P, +] + +IFE ITS,[ + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ 0,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVE A,[PUSHJ P,INMTYO] + MOVE B,T.CHAN+1(TB) + MOVEM A,IOINS(B) + MOVEI A,100 ; PRIM INPUT JFN + JUMPN 0,TNXTY1 + MOVEI E,C.OPN+C.READ+C.TTY + HRRM E,-2(B) + MOVEM B,CHNL0+2*100+1 + JRST TNXTY2 +TNXTY1: MOVEM B,CHNL0+2*101+1 + MOVEI A,101 ; PRIM OUTPUT JFN + MOVEI E,C.OPN+C.PRIN+C.TTY + HRRM E,-2(B) +TNXTY2: MOVEM A,CHANNO(B) + JUMPN 0,OPNWIN +] +; SETUP FUNNY BUFFER FOR TTY INPUT DEVICES + +TTYSPC: MOVEI A,EXTBFR ; GET EXTRA BUFFER + PUSHJ P,IBLOCK ; GET BLOCK + MOVE D,T.CHAN+1(TB) ;RESTORE CHANNEL POINTER +IFN ITS,[ + MOVE A,CHANNO(D) + LSH A,23. + IOR A,[.IOT A] + MOVEM A,IOIN2(B) +] +IFE ITS,[ + MOVE A,[PBIN] + MOVEM A,IOIN2(B) +] + MOVSI A,TLIST + MOVEM A,EXBUFR-1(D) ; FOR WAITING TTY BUFFERS + SETZM EXBUFR(D) ; NIL LIST + MOVEM B,BUFRIN(D) ;STORE IN CHANNEL + MOVSI A,TUVEC ;MAKE SURE TYPE IS UNIFORM VECTOR + HLLM A,BUFRIN-1(D) + MOVEI A,177 ;SET ERASER TO RUBOUT + MOVEM A,ERASCH(B) +IFE ITS,[ + MOVEI A,25 + MOVEM A,KILLCH(B) +] +IFN ITS,[ + SETZM KILLCH(B) ;NO KILL CHARACTER NEEDED +] + MOVEI A,33 ;BREAKCHR TO C.R. + MOVEM A,BRKCH(B) + MOVEI A,"\ ;ESCAPER TO \ + MOVEM A,ESCAP(B) + MOVE A,[010700,,BYTPTR(E)] ;RELATIVE BYTE POINTER + MOVEM A,BYTPTR(B) + MOVEI A,14 ;BARF BACK CHARACTER FF + MOVEM A,BRFCHR(B) + MOVEI A,^D + MOVEM A,BRFCH2(B) + +; SETUP DEFAULT TTY INTERRUPT HANDLER + + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TFIX + PUSH TP,[10] ; PRIORITY OF CHAR INT + PUSH TP,$TCHAN + PUSH TP,D + MCALL 3,EVENT ; 1ST MAKE AN EVENT EXIST + PUSH TP,A + PUSH TP,B + PUSH TP,$TSUBR + PUSH TP,[QUITTER] ; DEFAULT HANDLER IS QUITTER + MCALL 2,HANDLER + +; BUILD A NULL STRING + + MOVEI A,0 + PUSHJ P,IBLOCK ; USE A BLOCK + MOVE D,T.CHAN+1(TB) + MOVEI 0,C.BUF + IORM 0,-2(D) + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + MOVEM A,BUFSTR-1(D) + MOVEM B,BUFSTR(D) + MOVEI A,0 + MOVE B,D ; CHANNEL TO B + JRST MAKION + + +; ROUTINE TO OPEN ITS CHANNEL WITHOUT .RCHST + +IFN ITS,[ +OPEN2: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN ; OPEN THE FILE + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; SAVE THE CHANNEL + JRST OPEN3 + +; FIX UP MODE AND FALL INTO OPEN + +OPEN0: HRRZ A,S.DIR(C) ; GET DIR + TRNE A,2 ; SKIP IF NOT BLOCK + IORI A,4 ; TURN ON IMAGE + IORI A,2 ; AND BLOCK + + PUSH P,A + PUSH TP,$TPDL + PUSH TP,C ; SAVE CRUFT TO CHECK FOR PRINTO, HA HA + MOVE B,T.CHAN+1(TB) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) ; THIS KLUDGE THE MESS OF NDR + PUSHJ P,STRTO6 + MOVE C,(TP) + POP P,D ; THE SIXBIT FOR KLUDGE + POP P,A ; GET BACK THE RANDOM BITS + SUB TP,[2,,2] + CAME D,[SIXBIT /PRINAO/] + CAMN D,[SIXBIT /PRINTO/] + IORI A,100000 ; WRITEOVER BIT + HRRZ 0,FSAV(TB) + CAIN 0,NFOPEN + IORI A,10 ; DON'T CHANGE REF DATE +OPEN9: HRLM A,S.DIR(C) ; AND STORE IT + +; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL + +OPEN1: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; CLOBBER INTO CHANNEL + DOTCAL RFNAME,[A,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] + JFCL + +; NOW CLOBBER THE TVP SLOT FOR THIS CHANNEL + +OPEN3: MOVE A,S.DIR(C) + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) ; GET CHANNEL # + ASH A,1 + ADDI A,CHNL0 ; POINT TO SLOT + MOVEM B,1(A) ; NOT: TYPE ALREADY SETUP + +; NOW GET STATUS WORD + +DOSTAT: HRRZ A,CHANNO(B) ; NOW GET STATUS WORD + DOTCAL STATUS,[A,[2002,,STATUS]] + JFCL + POPJ P, + + +; HERE IF OPEN FAILS (CHANNEL IS IN A) + +OPNLOS: JUMPL A,NOCHAN ; ALL CHANNELS ARE IN USE + LSH A,23. ; DO A .STATUS + IOR A,[.STATUS A] + XCT A ; STATUS TO A + MOVE B,T.CHAN+1(TB) + PUSHJ P,GFALS ; GET A FALSE WITH A MESSAGE + SUB P,[1,,1] ; EXTRA RET ADDR FLUSHED + JRST OPNRET ; AND RETURN +] + +CGFALS: SUBM M,(P) + MOVEI B,0 +IFN ITS, PUSHJ P,GFALS +IFE ITS, PUSHJ P,TGFALS + JRST MPOPJ + +; ROUTINE TO CONS UP FALSE WITH REASON +IFN ITS,[ +GFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,[SIXBIT / ERR/] ; SET UP OPEN TO ERR DEV + PUSH P,[3] ; SAY ITS FOR CHANNEL + PUSH P,A + .OPEN 0,-2(P) ; USE CHANNEL 0 FOR THIS + FATAL CAN'T OPEN ERROR DEVICE + SUB P,[3,,3] ; DONT WANT OPEN BLOCK NOW +IFN FNAMS, PUSH P,A + MOVEI A,0 ; PREPARE TO BUILD STRING ON STACK +EL1: PUSH P,[0] ; WHERE IT WILL GO + MOVSI B,(<440700,,(P)>) ; BYTE POINTER TO TOP OF STACK +EL2: .IOT 0,0 ; GET A CHAR + JUMPL 0,EL3 ; JUMP ON -1,,3 + CAIN 0,3 ; EOF? + JRST EL3 ; YES, MAKE STRING + CAIN 0,14 ; IGNORE FORM FEEDS + JRST EL2 ; IGNORE FF + CAIE 0,15 ; IGNORE CR & LF + CAIN 0,12 + JRST EL2 + IDPB 0,B ; STUFF IT + TLNE B,760000 ; SIP IF WORD FULL + AOJA A,EL2 + AOJA A,EL1 ; COUNT WORD AND GO + +EL3: +IFN FNAMS,[ + SKIPN (P) + SUB P,[1,,1] + PUSH P,A + .CLOSE 0, + PUSHJ P,CHMAK + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST EL4 + MOVEI A,0 + MOVSI B,(<440700,,(P)>) + PUSH P,[0] + IRP XX,,[RDEVIC,RSNAME,RNAME1,RNAME2]YY,,[0,72,73,40] +IFSN YY,0,[ + MOVEI 0,YY + JSP E,1PUSH +] + MOVE E,-2(TP) + MOVE C,XX(E) + HRRZ D,XX-1(E) + JSP E,PUSHIT + TERMIN +] + SKIPN (P) ; ANY CHARS AT END? + SUB P,[1,,1] ; FLUSH XTRA + PUSH P,A ; PUT UP COUNT + .CLOSE 0, ; CLOSE THE ERR DEVICE + PUSHJ P,CHMAK ; MAKE STRING + PUSH TP,A + PUSH TP,B +IFN FNAMS,[ +EL4: POP P,A + PUSH TP,$TFIX + PUSH TP,A] +IFE FNAMS, MOVEI A,1 +IFN FNAMS,[ + MOVEI A,3 + SKIPN B + MOVEI A,2 +] + PUSHJ P,IILIST + MOVSI A,TFALSE ; MAKEIT A FALSE +IFN FNAMS, SUB TP,[2,,2] + POPJ P, + +IFN FNAMS,[ +1PUSH: MOVEI D,0 + JRST PUSHI2 +PUSHI1: PUSH P,[0] + MOVSI B,(<440700,,(P)>) +PUSHIT: SOJL D,(E) + ILDB 0,C +PUSHI2: IDPB 0,B + TLNE B,760000 + AOJA A,PUSHIT + AOJA A,PUSHI1 +] +] + + +; ROUTINE TO FILL IN THE "REAL" SLOTS FOR THE CHANNEL + +FIXREA: +IFE ITS, HRLZS S.DEV(C) ; KILL MODE BITS + MOVE D,[-4,,S.DEV] + +FIXRE1: MOVEI A,(D) ; COPY REL POINTER + ADD A,T.SPDL+1(TB) ; POINT TO SLOT + SKIPN A,(A) ; SKIP IF GOODIE THERE + JRST FIXRE2 + PUSHJ P,6TOCHS ; MAKE INOT A STRING + MOVE C,RDTBL-S.DEV(D); GET OFFSET + ADD C,T.CHAN+1(TB) + MOVEM A,-1(C) + MOVEM B,(C) +FIXRE2: AOBJN D,FIXRE1 + POPJ P, + +IFN ITS,[ +DOOPN: HRLZ A,A + HRR A,CHANNO(B) ; GET CHANNEL + DOTCAL OPEN,[A,-3(P),-2(P),-1(P),(P)] + SKIPA + AOS -1(P) + POPJ P, +] + +;THIS ROUTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES +STRTO6: PUSH TP,A + PUSH TP,B + PUSH P,E ;SAVE USEFUL FROB + MOVEI E,(A) ; CHAR COUNT TO E + GETYP A,A + CAIE A,TCHSTR ; IS IT ONE WORD? + JRST WRONGT ;NO + CAILE E,6 ; SKIP IF L=? 6 CHARS + MOVEI E,6 +CHREAD: MOVEI A,0 ;INITIALIZE OUTPUT WORD + MOVE D,[440600,,A] ;AND BYTE POINTER TO IT +NEXCHR: SOJL E,SIXDON + ILDB 0,B ; GET NEXT CHAR + CAIN 0,^Q ; CNTL-Q, QUOTES NEXT CHAR + JRST NEXCHR + JUMPE 0,SIXDON ;IF NULL, WE ARE FINISHED + PUSHJ P,A0TO6 ; CONVERT TO SIXBIT + IDPB 0,D ;DEPOSIT INTO SIX BIT + JRST NEXCHR ; NO, GET NEXT +SIXDON: SUB TP,[2,,2] ;FIX UP TP + POP P,E + EXCH A,(P) ;LEAVE RESULT ON P-STACK + JRST (A) ;NOW RETURN + + +;SUBROUTINE TO CONVERT SIXBIT TO ATOM + +6TOCHS: PUSH P,E + PUSH P,D + MOVEI B,0 ;MAX NUMBER OF CHARACTERS + PUSH P,[0] ;STRING WILL GO ON P SATCK + JUMPE A,GETATM ; EMPTY, LEAVE + MOVEI E,-1(P) ;WILL BE BYTE POINTER + HRLI E,10700 ;SET IT UP + PUSH P,[0] ;SECOND POSSIBLE WORD + MOVE D,[440600,,A] ;INPUT BYTE POINTER +6LOOP: ILDB 0,D ;START CHAR GOBBLING + ADDI 0,40 ;CHANGET TOASCII + IDPB 0,E ;AND STORE IT + TLNN D,770000 ; SKIP IF NOT DONE + JRST 6LOOP1 + TDNN A,MSKS(B) ; CHECK IF JUST SPACES LEFT + AOJA B,GETATM ; YES, DONE + AOJA B,6LOOP ;KEEP LOOKING +6LOOP1: PUSH P,[6] ;IF ARRIVE HERE, STRING IS 2 WORDS + JRST .+2 +GETATM: MOVEM B,(P) ;SET STRING LENGTH=1 + PUSHJ P,CHMAK ;MAKE A MUDDLE STRING + POP P,D + POP P,E + POPJ P, + +MSKS: 7777,,-1 + 77,,-1 + ,,-1 + 7777 + 77 + + +; CONVERT ONE CHAR + +A0TO6: CAIL 0,141 ;IF IT IS GREATER OR EQUAL TO LOWER A + CAILE 0,172 ;BUT LESS THAN OR EQUAL TO LOWER Z + JRST .+2 ;THEN + SUBI 0,40 ;CONVERT TO UPPER CASE + SUBI 0,40 ;NOW TO SIX BIT + JUMPL 0,BAD6 ;CHECK FOR A WINNER + CAILE 0,77 + JRST BAD6 + POPJ P, + +; SUBR TO TEST THE EXISTENCE OF FILES + +MFUNCTION FEXIST,SUBR,[FILE-EXISTS?] + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + ADD TP,[2,,2] + MOVSI E,-4 ; 4 THINGS TO PUSH +EXIST: +IFN ITS, MOVE B,@RNMTBL(E) +IFE ITS, MOVE B,@FETBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST EXIST1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ +; PUSH P,E +; PUSHJ P,ADDNUL ; NOT NEEDED, SINCE CONSED INTO ONE STRING-TAA +; POP P,E + PUSH TP,A ; DEFAULT TYPE AND VALUE GIVEN BY USER + PUSH TP,B ; IN VALUE OF DEV, SNM, NM1, NM2 + ] +IFN ITS, JRST .+2 +IFE ITS, JRST .+3 + +EXIST1: +IFN ITS, PUSH P,EXISTS(E) ; USE DEFAULT +IFE ITS,[ + PUSH TP,FETYP(E) ; DEFAULT TYPE AND VALUE IF NO + PUSH TP,FEVAL(E) ; DEFAULT GIVEN BY USER + ] + AOBJN E,EXIST + + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST TMA ; TOO MANY ARGUMENTS + +IFN ITS,[ + MOVE 0,-3(P) ; GET SIXBIT DEV NAME + MOVEI B,0 + CAMN 0,[SIXBITS /DSK /] + MOVSI B,10 ; DONT SET REF DATE IF DISK DEV + .IOPUSH + DOTCAL OPEN,[B,[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST .+3 + .IOPOP + JRST FDLWON ; WON!!! + .STATUS 0,A ; FIND THE STATUS OF CHANNEL BEFORE POPING + .IOPOP + JRST FDLST1] + +IFE ITS,[ + MOVE B,TB + SUBI B,10 ; GET B TO POINT CORRECTLY TO ARGS + PUSHJ P,STSTK ; GET FILE NAME IN A STRING + HRROI B,1(E) ; POINT B TO THE STRING + MOVSI A,100001 + GTJFN + JRST TDLLOS ; FILE DOES NOT EXIST + RLJFN ; FILE EXIST SO RETURN JFN + JFCL + JRST FDLWON ; SUCCESS + ] + +IFN ITS,[ +EXISTS: SIXBITS /DSK INPUT > / + ] +IFE ITS,[ +FETBL: SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + +FETYP: TCHSTR,,5 + TCHSTR,,3 + TCHSTR,,3 + TCHSTR,,0 + +FEVAL: 440700,,[ASCIZ /INPUT/] + 440700,,[ASCIZ /MUD/] + 440700,,[ASCIZ /DSK/] + 0 + ] + +; SUBR TO DELETE AND RENAME FILES + +MFUNCTION RENAME,SUBR + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + GETYP 0,(AB) ; GET 1ST ARG TYPE +IFN ITS,[ + CAIN 0,TCHAN ; CHANNEL? + JRST CHNRNM ; MUST BE RENAME WHILE OPEN FOR WRITING +] +IFE ITS,[ + PUSH P,[100000,,-2] + PUSH P,[377777,,377777] +] + MOVSI E,-4 ; 4 THINGS TO PUSH +RNMALP: MOVE B,@RNMTBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST RNMLP1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ + PUSH P,E + PUSHJ P,ADDNUL + EXCH B,(P) + MOVE E,B +] + JRST .+2 + +RNMLP1: PUSH P,RNSTBL(E) ; USE DEFAULT + AOBJN E,RNMALP + +IFN ITS,[ + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST RNM1 ; COULD BE A RENAME + +; HERE TO DELETE A FILE + +DELFIL: MOVE A,(P) ; AND GET SNAME + .SUSET [.SSNAM,,A] + DOTCAL DELETE,[[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST FDLST ; ANALYSE ERROR + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS +] +IFE ITS,[ + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; GET BASE OF PDL + MOVEI A,1(A) ; POINT TO CRAP + CAMGE AB,[-3,,] ; SKIP IF DELETE + HLLZS (A) ; RESET DEFAULT + PUSH P,[0] + PUSH P,[0] + PUSH P,[0] + GTJFN ; GET A JFN + JRST TDLLOS ; LOST + ADD AB,[2,,2] ; PAST ARG + JUMPL AB,RNM1 ; GO TRY FOR RENAME + MOVE P,(TP) ; RESTORE P STACK + MOVEI C,(A) ; FOR RELEASE + DELF ; ATTEMPT DELETE + JRST DELLOS ; LOSER + RLJFN ; MAKE SURE FLUSHED + JFCL + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +RNMLOS: PUSH P,A + MOVEI A,(B) + RLJFN + JFCL +DELLO1: MOVEI A,(C) + RLJFN + JFCL + POP P,A ; ERR NUMBER BACK +TDLLOS: MOVEI B,0 + PUSHJ P,TGFALS ; GET FALSE WITH REASON + JRST FINIS + +DELLOS: PUSH P,A ; SAVE ERROR + JRST DELLO1 +] + +;TABLE OF REANMAE DEFAULTS +IFN ITS,[ +RNMTBL: IMQUOTE DEV + IMQUOTE NM1 + IMQUOTE NM2 + IMQUOTE SNM + +RNSTBL: SIXBIT /DSK _MUDS_> / +] +IFE ITS,[ +RNMTBL: SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + +RNSTBL: -1,,[ASCIZ /DSK/] + 0 + -1,,[ASCIZ /_MUDS_/] + -1,,[ASCIZ /MUD/] +] +; HERE TO DO A RENAME + +RNM1: JUMPGE AB,TMA ; IF ARGS EXHAUSTED, MUST BE TOO MUCH STRING + GETYP 0,(AB) + MOVE C,1(AB) ; GET ARG + CAIN 0,TATOM ; IS IT "TO" + CAME C,IMQUOTE TO + JRST WRONGT ; NO, LOSE + ADD AB,[2,,2] ; BUMP PAST "TO" + JUMPGE AB,TFA +IFN ITS,[ + MOVEM P,T.SPDL+1(TB) ; SAVE NEW P-BASE + + MOVEI 0,4 ; FOUR DEFAULTS + PUSH P,-3(P) ; DEFAULT DEVICE IS CURRENT + SOJN 0,.-1 + + PUSHJ P,RGPRS ; PARSE THE NEXT STRING + JRST TMA + + MOVE A,-7(P) ; FIX AND GET DEV1 + MOVE B,-3(P) ; SAME FOR DEV2 + CAME A,B ; SAME? + JRST DEVDIF + + POP P,A ; GET SNAME 2 + CAME A,(P)-3 ; SNAME 1 + JRST DEVDIF + .SUSET [.SSNAM,,A] + POP P,-2(P) ; MOVE NAMES DOWN + POP P,-2(P) + DOTCAL RENAME,[[17,,-4],[17,,-3],[17,,-2],A,[17,,-1],(P)] + JRST FDLST + JRST FDLWON + +; HERE FOR RENAME WHILE OPEN FOR WRITING + +CHNRNM: ADD AB,[2,,2] ; NEXT ARG + JUMPGE AB,TFA + MOVE B,-1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; SKIP IF OPEN + JRST BADCHN + MOVE A,DIRECT-1(B) ; CHECK DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A + CAME A,[SIXBIT /PRINT/] + CAMN A,[SIXBIT /PRINTB/] + JRST CHNRN1 + CAMN A,[SIXBIT /PRINAO/] + JRST CHNRM1 + CAME A,[SIXBIT /PRINTO/] + JRST WRONGD + +; SET UP .FDELE BLOCK + +CHNRN1: PUSH P,[0] + PUSH P,[0] + MOVEM P,T.SPDL+1(TB) + PUSH P,[0] + PUSH P,[SIXBIT /_MUDL_/] + PUSH P,[SIXBIT />/] + PUSH P,[0] + + PUSHJ P,RGPRS ; PARSE THESE + JRST TMA + + SUB P,[1,,1] ; SNAME/DEV IGNORED + MOVE AB,ABSAV(TB) ; GET ORIG ARG POINTER + MOVE B,1(AB) + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RENMWO,[A,[17,,-1],(P)] + JRST FDLST + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RFNAME,[A,[2017,,-4],[2017,,-3],[2017,,-2],[2017,,-1]] + JFCL + MOVE A,-3(P) ; UPDATE CHANNEL + PUSHJ P,6TOCHS ; GET A STRING + MOVE C,1(AB) + MOVEM A,RNAME1-1(C) + MOVEM B,RNAME1(C) + MOVE A,-2(P) + PUSHJ P,6TOCHS + MOVE C,1(AB) + MOVEM A,RNAME2-1(C) + MOVEM B,RNAME2(C) + MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS +] +IFE ITS,[ + PUSH P,A + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; PBASE BACK + PUSH A,[400000,,0] + MOVEI A,(A) + GTJFN + JRST TDLLOS + POP P,B + EXCH A,B + MOVEI C,(A) ; FOR RELEASE ATTEMPT + RNAMF + JRST RNMLOS + MOVEI A,(B) + RLJFN ; FLUSH JFN + JFCL + MOVEI A,(C) ; MAKE SURR OTHER IS FLUSHED + RLJFN + JFCL + JRST FDLWON + + +ADDNUL: PUSH TP,A + PUSH TP,B + MOVEI A,(A) ; LNTH OF STRING + IDIVI A,5 + JUMPN B,NONUAD ; DONT NEED TO ADD ONE + + PUSH TP,$TCHRS + PUSH TP,[0] + MOVEI A,2 + PUSHJ P,CISTNG ; COPY OF STRING + POPJ P, + +NONUAD: POP TP,B + POP TP,A + POPJ P, +] +; HERE FOR LOSING .FDELE + +IFN ITS,[ +FDLST: .STATUS 0,A ; GET STATUS +FDLST1: MOVEI B,0 + PUSHJ P,GFALS ; ANALYZE IT + JRST FINIS +] + +; SOME .FDELE ERRORS + +DEVDIF: ERRUUO EQUOTE DEVICE-OR-SNAME-DIFFERS + + ; HERE TO RESET A READ CHANNEL + +MFUNCTION FRESET,SUBR,RESET + + ENTRY 1 + GETYP A,(AB) + CAIE A,TCHAN + JRST WTYP1 + MOVE B,1(AB) ;GET CHANNEL + SKIPN IOINS(B) ; OPEN? + JRST REOPE1 ; NO, IGNORE CHECKS +IFN ITS,[ + MOVE A,STATUS(B) ;GET STATUS + ANDI A,77 + JUMPE A,REOPE1 ;IF IT CLOSED, JUST REOPEN IT, MAYBE? + CAILE A,2 ;SKIPS IF TTY FLAVOR + JRST REOPEN +] +IFE ITS,[ + MOVE A,CHANNO(B) + CAIE A,100 ; TTY-IN + CAIN A,101 ; TTY-OUT + JRST .+2 + JRST REOPEN +] + CAME B,TTICHN+1 + CAMN B,TTOCHN+1 + JRST REATTY +REATT1: MOVEI B,DIRECT-1(B) ;POINT TO DIRECTION + PUSHJ P,CHRWRD ;CONVERT TO A WORD + JFCL + CAME B,[ASCII /READ/] + JRST TTYOPN + MOVE B,1(AB) ;RESTORE CHANNEL + PUSHJ P,RRESET" ;DO REAL RESET + JRST TTYOPN + +REOPEN: PUSH TP,(AB) ;FIRST CLOSE IT + PUSH TP,(AB)+1 + MCALL 1,FCLOSE + MOVE B,1(AB) ;RESTORE CHANNEL + +; SET UP TEMPS FOR OPNCH + +REOPE1: PUSH P,[0] ; WILL HOLD DIR CODE + PUSH TP,$TPDL + PUSH TP,P + IRP A,,[DIRECT,RNAME1,RNAME2,RDEVIC,RSNAME,ACCESS] + PUSH TP,A-1(B) + PUSH TP,A(B) + TERMIN + + PUSH TP,$TCHAN + PUSH TP,1(AB) + + MOVE A,T.DIR(TB) + MOVE B,T.DIR+1(TB) ; GET DIRECTION + PUSHJ P,CHMOD ; CHECK THE MODE + MOVEM A,(P) ; AND STORE IT + +; NOW SET UP OPEN BLOCK IN SIXBIT + +IFN ITS,[ + MOVSI E,-4 ; AOBN PNTR +FRESE2: MOVE B,T.CHAN+1(TB) + MOVEI A,@RDTBL(E) ; GET ITEM POINTER + GETYP 0,-1(A) ; GET ITS TYPE + CAIE 0,TCHSTR + JRST FRESE1 + MOVE B,(A) ; GET STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 +FRESE3: AOBJN E,FRESE2 +] +IFE ITS,[ + MOVE B,T.CHAN+1(TB) + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; RESULT ON STACK + HLRZS (P) +] + + PUSH P,[0] ; PUSH UP SOME DUMMIES + PUSH P,[0] + PUSH P,[0] + PUSHJ P,OPNCH ; ATTEMPT TO DO THEOPEN + GETYP 0,A + CAIE 0,TCHAN + JRST FINIS ; LEAVE IF FALSE OR WHATEVER + +DRESET: MOVE A,(AB) + MOVE B,1(AB) + SETZM CHRPOS(B) ;INITIALIZE THESE PARAMETERS + SETZM LINPOS(B) + SETZM ACCESS(B) + JRST FINIS + +TTYOPN: +IFN ITS,[ + MOVE B,1(AB) + CAME B,TTOCHN+1 + CAMN B,TTICHN+1 + PUSHJ P,TTYOP2 + PUSHJ P,DOSTAT + DOTCAL RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]] + .LOSE %LSSYS + MOVEM C,PAGLN(B) + MOVEM D,LINLN(B) +] + JRST DRESET + +IFN ITS,[ +FRESE1: CAIE 0,TFIX + JRST BADCHN + PUSH P,(A) + JRST FRESE3 +] + +; INTERFACE TO REOPEN CLOSED CHANNELS + +OPNCHN: PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FRESET + POPJ P, + +REATTY: PUSHJ P,TTYOP2 +IFE ITS, SKIPN DEMFLG ; SKIP IF DEMONFLAG IS ON + SKIPE NOTTY + JRST DRESET + MOVE B,1(AB) + JRST REATT1 + +; FUNCTION TO LIST ALL CHANNELS + +MFUNCTION CHANLIST,SUBR + + ENTRY 0 + + MOVEI A,N.CHNS-1 ;MAX # OF REAL CHANNELS + MOVEI C,0 + MOVEI B,CHNL1 ;POINT TO FIRST REAL CHANNEL + +CHNLP: SKIPN 1(B) ;OPEN? + JRST NXTCHN ;NO, SKIP + HRRE E,(B) ; ABOUT TO FLUSH? + JUMPL E,NXTCHN ; YES, FORGET IT + MOVE D,1(B) ; GET CHANNEL + HRRZ E,CHANNO-1(D) ; GET REF COUNT + PUSH TP,(B) + PUSH TP,1(B) + ADDI C,1 ;COUNT WINNERS + SOJGE E,.-3 ; COUNT THEM +NXTCHN: ADDI B,2 + SOJN A,CHNLP + + SKIPN B,CHNL0+1 ;NOW HACK LIST OF PSUEDO CHANNELS + JRST MAKLST +CHNLS: PUSH TP,(B) + PUSH TP,(B)+1 + ADDI C,1 + HRRZ B,(B) + JUMPN B,CHNLS + +MAKLST: ACALL C,LIST + JRST FINIS + + ; ROUTINE TO RESTORE A CLOSED CHANNEL TO ITS PREVIOUS STATE + + +REOPN: PUSH TP,$TCHAN + PUSH TP,B + SKIPN CHANNO(B) ; ONLY REAL CHANNELS + JRST PSUEDO + +IFN ITS,[ + MOVSI E,-4 ; SET UP POINTER FOR NAMES + +GETOPB: MOVE B,(TP) ; GET CHANNEL + MOVEI A,@RDTBL(E) ; GET POINTER + MOVE B,(A) ; NOW STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 ; LEAVES SIXBIT ON STACK + AOBJN E,GETOPB +] +IFE ITS,[ + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; GET DEV NAME IN SIXBIT +] + MOVE B,(TP) ; RESTORE CHANNEL + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,CHMOD ; CHECK FOR A VALID MODE + +IFN ITS, MOVE E,-3(P) ; GET DEVICE IN PROPER PLACE +IFE ITS, HLRZS E,(P) + MOVE B,(TP) ; RESTORE CHANNEL +IFN ITS, CAMN E,[SIXBIT /DSK /] +IFE ITS,[ + CAIE E,(SIXBIT /PS /) + CAIN E,(SIXBIT /DSK/) + JRST DISKH ; DISK WINS IMMEIDATELY + CAIE E,(SIXBIT /SS /) + CAIN E,(SIXBIT /SRC/) + JRST DISKH ; DISK WINS IMMEIDATELY +] +IFN ITS, CAMN E,[SIXBIT /TTY /] ; NO NEED TO RE-OPEN THE TTY +IFE ITS, CAIN E,(SIXBIT /TTY/) + JRST REOPD1 +IFN ITS,[ + AND E,[777700,,0] ; COULD BE "UTn" + MOVE D,CHANNO(B) ; GET CHANNEL + ASH D,1 + ADDI D,CHNL0 ; DON'T SEEM TO BE OPEN + SETZM 1(D) + SETZM CHANNO(B) + CAMN E,[SIXBIT /UT /] + JRST REOPD ; CURRENTLY, CANT RESTORE UTAPE CHANNLES + CAMN E,[SIXBIT /AI /] + JRST REOPD ; CURRENTLY CANT RESTORE AI CHANNELS + CAMN E,[SIXBIT /ML /] + JRST REOPD ; CURRENTLY CANT RESTORE ML CHANNELS + CAMN E,[SIXBIT /DM /] + JRST REOPD ; CURRENTLY CANT RESTORE DM CHANNELS +] + PUSH TP,$TCHAN ; TRY TO RESET IT + PUSH TP,B + MCALL 1,FRESET + +IFN ITS,[ +REOPD1: AOS -4(P) +REOPD: SUB P,[4,,4] +] +IFE ITS,[ +REOPD1: AOS -1(P) +REOPD: SUB P,[1,,1] +] +REOPD0: SUB TP,[2,,2] + POPJ P, + +IFN ITS,[ +DISKH: MOVE C,(P) ; SNAME + .SUSET [.SSNAM,,C] +] +IFE ITS,[ +DISKH: MOVEM A,(P) ; SAVE MODE WORD + PUSHJ P,STSTK ; STRING TO STACK + MOVE A,(E) ; RESTORE MODE WORD + PUSH TP,$TPDL + PUSH TP,E ; SAVE PDL BASE + MOVE B,-2(TP) ; CHANNEL BACK TO B +] + MOVE C,ACCESS(B) ; GET CHANNELS ACCESS + TRNN A,2 ; SKIP IF NOT ASCII CHANNEL + JRST DISKH1 + HRRZ D,ACCESS-1(B) ; IF PARTIAL WORD OUT + IMULI C,5 ; TO CHAR ACCESS + JUMPE D,DISKH1 ; NO SWEAT + ADDI C,(D) + SUBI C,5 +DISKH1: HRRZ D,BUFSTR-1(B) ; ANY CHARS IN MUDDLE BUFFER + JUMPE D,DISKH2 + TRNN A,1 ; SKIP IF OUTPUT CHANNEL + JRST DISKH2 + PUSH P,A + PUSH P,C + MOVEI C,BUFSTR-1(B) + PUSHJ P,BYTDOP ; FIND LENGTH OF WHOLE BUFFER + HLRZ D,(A) ; LENGTH + 2 TO D + SUBI D,2 + IMULI D,5 ; TO CHARS + SUB D,BUFSTR-1(B) + POP P,C + POP P,A +DISKH2: SUBI C,(D) ; UPDATE CHAR ACCESS + IDIVI C,5 ; BACK TO WORD ACCESS +IFN ITS,[ + IORI A,6 ; BLOCK IMAGE + TRNE A,1 + IORI A,100000 ; WRITE OVER BIT + PUSHJ P,DOOPN + JRST REOPD + MOVE A,C ; ACCESS TO A + PUSHJ P,GETFLN ; CHECK LENGTH + CAIGE 0,(A) ; CHECK BOUNDS + JRST .+3 ; COMPLAIN + PUSHJ P,DOACCS ; AND ACESS + JRST REOPD1 ; SUCCESS + + MOVE A,CHANNO(B) ; CLOSE THE G.D. CHANNEL + PUSHJ P,MCLOSE + JRST REOPD + +DOACCS: PUSH P,A + HRRZ A,CHANNO(B) + DOTCAL ACCESS,[A,(P)] + JFCL + POP P,A + POPJ P, + +DOIOTO: +DOIOTI: +DOIOT: + PUSH P,0 + MOVSI 0,TCHAN + MOVE PVP,PVSTOR+1 + MOVEM 0,BSTO(PVP) ; IN CASE OF INTERRUPT + ENABLE + HRRZ 0,CHANNO(B) + DOTCAL IOT,[0,A] + JFCL + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + POP P,0 + POPJ P, + +GETFLN: MOVE 0,CHANNO(B) ; GET CHANNEL + .CALL FILBLK ; READ LNTH + .VALUE + POPJ P, + +FILBLK: SETZ + SIXBIT /FILLEN/ + 0 + 402000,,0 ; STUFF RESULT IN 0 +] +IFE ITS,[ + MOVEI A,CHNL0 + ADD A,CHANNO(B) + ADD A,CHANNO(B) + SETZM 1(A) ; MAY GET A DIFFERENT JFN + HRROI B,1(E) ; TENEX STRING POINTER + MOVSI A,400001 ; MAKE SURE + GTJFN ; GO GET IT + JRST RGTJL ; COMPLAIN + MOVE D,-2(TP) + HRRZM A,CHANNO(D) ; COULD HAVE CHANGED + MOVE P,(TP) ; RESTORE P + MOVEI B,CHNL0 + ASH A,1 ; MUNG ITS SLOT + ADDI A,(B) + MOVEM D,1(A) + HLLOS (A) ; MARK CHANNEL NOT TO BE RELOOKED AT + MOVE A,(P) ; MODE WORD BACK + MOVE B,[440000,,200000] ; FLAG BITS + TRNE A,1 ; SKIP FOR INPUT + TRC B,300000 ; CHANGE TO WRITE + MOVE A,CHANNO(D) ; GET JFN + OPENF + JRST ROPFLS + MOVE E,C ; LENGTH TO E + SIZEF ; GET CURRENT LENGTH + JRST ROPFLS + CAMGE B,E ; STILL A WINNER + JRST ROPFLS + MOVE A,CHANNO(D) ; JFN + MOVE B,C + SFPTR + JRST ROPFLS + SUB TP,[2,,2] ; FLUSH PDL POINTER + JRST REOPD1 + +ROPFLS: MOVE A,-2(TP) + MOVE A,CHANNO(A) + CLOSF ; ATTEMPT TO CLOSE + JFCL ; IGNORE FAILURE + SKIPA + +RGTJL: MOVE P,(TP) + SUB TP,[2,,2] + JRST REOPD + +DOACCS: PUSH P,B + EXCH A,B + MOVE A,CHANNO(A) + SFPTR + JRST ACCFAI + POP P,B + POPJ P, +] +PSUEDO: AOS (P) ; ASSUME SUCCESS FOR NOW + MOVEI B,RDEVIC-1(B) ; SEE WHAT DEVICE IS + PUSHJ P,CHRWRD + JFCL + JRST REOPD0 ; NO, RETURN HAPPY +IFN 0,[ CAME B,[ASCII /E&S/] ; DISPLAY ? + CAMN B,[ASCII /DIS/] + SKIPA B,(TP) ; YES, REGOBBLE CHANNEL AND CONTINUE + JRST REOPD0 ; NO, RETURN HAPPY + PUSHJ P,DISROP + SOS (P) ; DISPLAY DID NOT REOPEN, UNDO ASSUMPTION OF SUCCESS + JRST REOPD0] + + ;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL + +MFUNCTION FCLOSE,SUBR,[CLOSE] + + ENTRY 1 ;ONLY ONE ARG + GETYP A,(AB) ;CHECK ARGS + CAIE A,TCHAN ;IS IT A CHANNEL + JRST WTYP1 + MOVE B,1(AB) ;PICK UP THE CHANNEL + HRRZ A,CHANNO-1(B) ; GET REF COUNT + SOJGE A,CFIN5 ; NOT READY TO REALLY CLOSE + CAME B,TTICHN+1 ; CHECK FOR TTY + CAMN B,TTOCHN+1 + JRST CLSTTY + MOVE A,[JRST CHNCLS] + MOVEM A,IOINS(B) ;CLOBBER THE IO INS + MOVE A,RDEVIC-1(B) ;GET THE NAME OF THE DEVICE + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 +IFN ITS, MOVE A,(P) +IFE ITS, HLRZS A,(P) + MOVE B,1(AB) ; RESTORE CHANNEL +IFN 0,[ + CAME A,[SIXBIT /E&S /] + CAMN A,[SIXBIT /DIS /] + PUSHJ P,DISCLS] + MOVE B,1(AB) ; IN CASE CLOBBERED BY DISCLS + SKIPN A,CHANNO(B) ;ANY REAL CHANNEL? + JRST REMOV ; NO, EITHER CLOSED OR PSEUDO CHANNEL + + MOVE A,DIRECT-1(B) ; POINT TO DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; CONVERT TO WORD + POP P,A +IFN ITS, LDB E,[360600,,(P)] ; FIRST CHAR OD DEV NAME +IFE ITS, LDB E,[140600,,(P)] ; FIRST CHAR OD DEV NAME + CAIE E,'T ; SKIP IF TTY + JRST CFIN4 + CAME A,[SIXBIT /READ/] ; SKIP IF WINNER + JRST CFIN1 +IFN ITS,[ + MOVE B,1(AB) ; IN ITS CHECK STATUS + LDB A,[600,,STATUS(B)] + CAILE A,2 + JRST CFIN1 +] + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE CHAR + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,OFF ; TURN OFF INTERRUPT +CFIN1: MOVE B,1(AB) + MOVE A,CHANNO(B) +IFN ITS,[ + PUSHJ P,MCLOSE +] +IFE ITS,[ + TLZ A,400000 ; FOR JFN RELEASE + CLOSF ; CLOSE THE FILE AND RELEASE THE JFN + JFCL + MOVE A,CHANNO(B) +] +CFIN: LSH A,1 + ADDI A,CHNL0+1 ;POINT TO THIS CHANNELS LSOT + SETZM CHANNO(B) + SETZM (A) ;AND CLOBBER IT + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) + HLLZS ACCESS-1(B) +CFIN2: HLLZS -2(B) + MOVSI A,TCHAN ;RETURN THE CHANNEL + JRST FINIS + +CLSTTY: ERRUUO EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL + + +REMOV: MOVEI D,CHNL0+1 ;ATTEMPT TO REMOVE FROM PSUEDO CHANNEL LIST +REMOV0: SKIPN C,D ;FOUND ON LIST ? + JRST CFIN2 ;NO, JUST IGNORE THIS CLOSED CHANNEL + HRRZ D,(C) ;GET POINTER TO NEXT + CAME B,(D)+1 ;FOUND ? + JRST REMOV0 + HRRZ D,(D) ;YES, SPLICE IT OUT + HRRM D,(C) + JRST CFIN2 + + +; CLOSE UP ANY LEFTOVER BUFFERS + +CFIN4: +; CAME A,[SIXBIT /PRINTO/] +; CAMN A,[SIXBIT /PRINTB/] +; JRST .+3 +; CAME A,[SIXBIT /PRINT/] +; JRST CFIN1 + MOVE B,1(AB) ; GET CHANNEL + HRRZ A,-2(B) ;GET MODE BITS + TRNN A,C.PRIN + JRST CFIN1 + GETYP 0,BUFSTR-1(B) ; IS THERE AN OUTPUT BUFFER + SKIPN BUFSTR(B) + JRST CFIN1 + CAIE 0,TCHSTR + JRST CFINX1 + PUSHJ P,BFCLOS +IFE ITS,[ + MOVE A,CHANNO(B) + MOVEI B,7 + SFBSZ + JFCL + CLOSF + JFCL +] + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) +CFINX1: HLLZS ACCESS-1(B) + JRST CFIN1 + +CFIN5: HRRM A,CHANNO-1(B) + JRST CFIN2 + ;SUBR TO DO .ACCESS ON A READ CHANNEL +;FORM: +;POSITIONS CHANNEL AT CHARACTER POSN FIX-NUMBER +;H. BRODIE 7/26/72 + +MFUNCTION MACCESS,SUBR,[ACCESS] + ENTRY 2 ;ARGS: CHANNEL AND FIX-NUMBER + +;CHECK ARGUMENT TYPES + GETYP A,(AB) + CAIE A,TCHAN ;FIRST ARG SHOULD BE CHANNEL + JRST WTYP1 + GETYP A,2(AB) ;TYPE OF SECOND + CAIE A,TFIX ;SHOULD BE FIX + JRST WTYP2 + +;CHECK DIRECTION OF CHANNEL + MOVE B,1(AB) ;B GETS PNTR TO CHANNEL +; MOVEI B,DIRECT-1(B) ;GET DIRECTION OF CHANNEL +; PUSHJ P,CHRWRD ;GRAB THE CHAR STRNG +; JFCL +; CAME B,[+1] + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.PRIN + JRST MACCA + MOVE B,1(AB) + SKIPE C,BUFSTR(B) ;SEE IF WE MUST FLUSH PART BUFFER + PUSHJ P,BFCLOS + JRST MACC +MACCA: +; CAMN B,[ASCIZ /READ/] +; JRST .+4 +; CAME B,[ASCIZ /READB/] ; READB CHANNEL? +; JRST WRONGD +; AOS (P) ; SET INDICATOR FOR BINARY MODE + +;CHECK THAT THE CHANNEL IS OPEN +MACC: MOVE B,1(AB) ;GET BACK PTR TO CHANNEL + HRRZ E,-2(B) + TRNN E,C.OPN + JRST CHNCLS ;IF CHNL CLOSED => ERROR + +;COMPUTE ACCESS PNTR TO ACCESS WORD CHAR IS IN +;REMAINDER IS NUMBER OF TIMES TO INCR BYTE POINTER +ADEVOK: SKIPGE C,3(AB) ;GET CHAR POSN + ERRUUO EQUOTE NEGATIVE-ARGUMENT +MACC1: MOVEI D,0 + TRNN E,C.BIN ; SKIP FOR BINARY FILE + IDIVI C,5 + +;SETUP THE .ACCESS + TRNN E,C.PRIN + JRST NLSTCH + HRRZ 0,LSTCH-1(B) + MOVE A,ACCESS(B) + TRNN E,C.BIN + JRST LSTCH1 + IMULI A,5 + ADD A,ACCESS-1(B) + ANDI A,-1 +LSTCH1: CAIG 0,(A) + MOVE 0,A + MOVE A,C + IMULI A,5 + ADDI A,(D) + CAML A,0 + MOVE 0,A + HRRM 0,LSTCH-1(B) ; UPDATE "LARGEST" +NLSTCH: MOVE A,CHANNO(B) ;A GETS REAL CHANNEL NUMBER +IFN ITS,[ + DOTCAL ACCESS,[A,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + +IFE ITS,[ + MOVE B,C + SFPTR ; DO IT IN TENEX + JRST ACCFAI + MOVE B,1(AB) ; RESTORE CHANNEL +] +; POP P,E ; CHECK FOR READB MODE + TRNN E,C.READ + JRST ACCOUT ; PRINT TYPE CHANNEL, GO DO IT + SKIPE BUFSTR(B) ; IS THERE A READ BUFFER TO FLUSH + JRST .+3 + SETZM LSTCH(B) ; CLEAR OUT POSSIBLE EOF INDICATOR + JRST DONADV + +;NOW FORCE GETCHR TO DO A .IOT FIRST THING + MOVEI C,BUFSTR-1(B) ; FIND END OF STRING + PUSHJ P,BYTDOP" + SUBI A,2 ; LAST REAL WORD + HRLI A,010700 + MOVEM A,BUFSTR(B) + HLLZS BUFSTR-1(B) ; CLOBBER CHAR COUNT + SETZM LSTCH(B) ;CLOBBER READ'S HIDDEN CHARACTER + +;NOW DO THE APPROPRIATE NUM OF BYTE ADVANCEMENTS + JUMPLE D,DONADV +ADVPTR: PUSHJ P,GETCHR + MOVE B,1(AB) ;RESTORE IN CASE CLOBBERED + SOJG D,ADVPTR + +DONADV: MOVE C,3(AB) ;FIXUP ACCESS SLOT IN CHNL + HLLZS ACCESS-1(B) + MOVEM C,ACCESS(B) + MOVE A,$TCHAN ;TYPE OF RESULT = "CHANNEL" + JRST FINIS ;DONE...B CONTAINS CHANNEL + +IFE ITS,[ +ACCFAI: ERRUUO EQUOTE ACCESS-FAILURE +] +ACCOUT: SKIPN C,BUFSTR(B) ; FIXUP BUFFER? + JRST ACCOU1 + HRRZ F,BUFSTR-1(B) + ADD F,[-BUFLNT*5-4] + IDIVI F,5 + ADD F,BUFSTR(B) + HRLI F,010700 + MOVEM F,BUFSTR(B) + MOVEI F,BUFLNT*5 + HRRM F,BUFSTR-1(B) +ACCOU1: TRNE E,C.BIN ; FINISHED FOR BINARY CHANNELS + JRST DONADV + + JUMPE D,DONADV ; THIS CASE OK +IFE ITS,[ + MOVE A,CHANNO(B) ; GET LAST WORD + RFPTR + JFCL + PUSH P,B + MOVNI C,1 + MOVE B,[444400,,E] ; READ THE WORD + SIN + JUMPL C,ACCFAI + POP P,B + SFPTR + JFCL + MOVE B,1(AB) ; CHANNEL BACK + MOVE C,[440700,,E] + ILDB 0,C + IDPB 0,BUFSTR(B) + SOS BUFSTR-1(B) + SOJG D,.-3 + JRST DONADV +] +IFN ITS, ERRUUO EQUOTE CANT-ACCESS-ASCII-ON-ITS + + +;WRONG TYPE OF DEVICE ERROR +WRDEV: ERRUUO EQUOTE NON-DSK-DEVICE + +; BINARY READ AND PRINT ROUTINES + +MFUNCTION PRINTB,SUBR + + ENTRY + +PBFL: PUSH P,. ; PUSH NON-ZERONESS + MOVEI A,-7 + JRST BINI1 + +MFUNCTION READB,SUBR + + ENTRY + + PUSH P,[0] + MOVEI A,-11 +BINI1: HLRZ 0,AB + CAILE 0,-3 + JRST TFA + CAIG 0,(A) + JRST TMA + + GETYP 0,(AB) ; SHOULD BE UVEC OR STORE + CAIE 0,TSTORAGE + CAIN 0,TUVEC + JRST BINI2 + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTOK + JRST WTYP1 ; ELSE LOSE +BINI2: MOVE B,1(AB) ; GET IT + HLRE C,B + SUBI B,(C) ; POINT TO DOPE + GETYP A,(B) + PUSHJ P,SAT" ; GET ITS ST.ALOC.TYPE + CAIE A,S1WORD + JRST WTYP1 +BYTOK: GETYP 0,2(AB) + CAIE 0,TCHAN ; BETTER BE A CHANNEL + JRST WTYP2 + MOVE B,3(AB) ; GET IT +; MOVEI B,DIRECT-1(B) ; GET DIRECTION OF +; PUSHJ P,CHRWRD ; INTO 1 WORD +; JFCL +; MOVNI E,1 +; CAMN B,[ASCII /READB/] +; MOVEI E,0 +; CAMN B,[+1] + HRRZ A,-2(B) ; MODE BITS + TRNN A,C.BIN ; IF NOT BINARY + JRST WRONGD + MOVEI E,0 + TRNE A,C.PRIN + MOVE E,PBFL +; JUMPL E,WRONGD ; LOSER + CAME E,(P) ; CHECK WINNGE + JRST WRONGD + MOVE B,3(AB) ; GET CHANNEL BACK + SKIPN A,IOINS(B) ; OPEN? + PUSHJ P,OPENIT ; LOSE + CAMN A,[JRST CHNCLS] + JRST CHNCLS ; LOSE, CLOSED + JUMPN E,BUFOU1 ; JUMP FOR OUTPUT + MOVEI C,0 + CAML AB,[-5,,] ; SKIP IF EOF GIVEN + JRST BINI5 + MOVE 0,4(AB) + MOVEM 0,EOFCND-1(B) + MOVE 0,5(AB) + MOVEM 0,EOFCND(B) + CAML AB,[-7,,] + JRST BINI5 + GETYP 0,6(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,7(AB) +BINI5: SKIPE LSTCH(B) ; INDICATES IF EOF HIT + JRST BINEOF + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTI + MOVE A,1(AB) ; GET VECTOR + PUSHJ P,PGBIOI ; READ IT + HLRE C,A ; GET COUNT DONE + HLRE D,1(AB) ; AND FULL COUNT + SUB C,D ; C=> TOTAL READ + ADDM C,ACCESS(B) + JUMPGE A,BINIOK ; NOT EOF YET + SETOM LSTCH(B) +BINIOK: MOVE B,C + MOVSI A,TFIX ; RETURN AMOUNT ACTUALLY READ + JRST FINIS + +BYTI: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-LOST + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-LOST + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE STRING LENGTH + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 + PUSH P,C + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SIN] + PUSHJ P,PGBIOT + HLRE C,A ; GET COUNT DONE + POP P,D + SKIPN D + HRRZ D,(AB) ; AND FULL COUNT + ADD D,C ; C=> TOTAL READ + LDB E,[300600,,1(AB)] + MOVEI A,36. + IDIVM A,E + IDIVM D,E + ADDM E,ACCESS(B) + SKIPGE C ; NOT EOF YET + SETOM LSTCH(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-LOST + MOVE C,D + JRST BINIOK +] +BUFOU1: SKIPE BUFSTR(B) ; ANY BUFFERS AROUND? + PUSHJ P,BFCLS1 ; GET RID OF SAME + MOVEI C,0 + CAML AB,[-5,,] + JRST BINO5 + GETYP 0,4(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,5(AB) +BINO5: MOVE A,1(AB) + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTO + PUSHJ P,PGBIOO + HLRE C,1(AB) + MOVNS C + ADDM C,ACCESS(B) +BYTO1: MOVE A,(AB) ; RET VECTOR ETC. + MOVE B,1(AB) + JRST FINIS + +BYTO: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-FAILURE + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-FAILURE + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE SIZE + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 ; COMPENSATE FOR PGBIOT DOING THE WRONG THING + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SOUT] + PUSHJ P,PGBIOT + LDB D,[300600,,1(AB)] + MOVEI C,36. + IDIVM C,D + HRRZ C,(AB) + IDIVI C,(D) + ADDM C,ACCESS(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-FAILURE + JRST BYTO1 +] + +BINEOF: PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOSER + MCALL 1,EVAL + JRST FINIS + +OPENIT: PUSH P,E + PUSHJ P,OPNCHN ;TRY TO OPEN THE LOSER + JUMPE B,CHNCLS ;FAIL + POP P,E + POPJ P, + ; THESE SUBROUTINES BY NDR 9/16/73 TO FACILITATE THE +; TYPES OF IO NECESSARY TO MAKE MORE EFFICIENT USE OF +; THE NETWORK AND DO RELATED FILE TRANSFER TYPE OF JOBS. + +R1CHAR: SKIPN A,LSTCH(B) ; CHAR READING ROUTINE FOR FCOPY + PUSHJ P,RXCT + TLO A,200000 ; ^@ BUG + MOVEM A,LSTCH(B) + TLZ A,200000 + JUMPL A,.+2 ; IN CASE OF -1 ON STY + TRZN A,400000 ; EXCL HACKER + JRST .+4 + MOVEM A,LSTCH(B) ; SAVE DE-EXCLED CHAR + MOVEI A,"! + JRST .+2 + SETZM LSTCH(B) + PUSH P,C + HRRZ C,DIRECT-1(B) + CAIE C,5 ; IF DIRECTION IS 5 LONG THEN READB + JRST R1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) ; EVERY FIFTY INCREMENT + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +R1CH1: AOS ACCESS(B) + POP P,C + POPJ P, + +W1CHAR: CAIE A,15 ; CHAR WRITING ROUTINE, TEST FOR CR + JRST .+3 + SETOM CHRPOS(B) + AOSA LINPOS(B) + CAIE A,12 ; TEST FOR LF + AOS CHRPOS(B) ; IF NOT LF AOS CHARACTE5R POSITION + CAIE A,14 ; TEST FOR FORM FEED + JRST .+3 + SETZM CHRPOS(B) ; IF FORM FEED ZERO CHARACTER POSITION + SETZM LINPOS(B) ; AND LINE POSITION + CAIE A,11 ; IS THIS A TAB? + JRST .+6 + MOVE C,CHRPOS(B) + ADDI C,7 + IDIVI C,8. + IMULI C,8. ; FIX UP CHAR POS FOR TAB + MOVEM C,CHRPOS(B) ; AND SAVE + PUSH P,C + HRRZ C,-2(B) ; GET BITS + TRNN C,C.BIN ; SIX LONG MUST BE PRINTB + JRST W1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +W1CH1: AOS ACCESS(B) + PUSH P,A + PUSHJ P,WXCT + POP P,A + POP P,C + POPJ P, + +R1C: SUBM M,(P) ;LITTLE ENTRY FOR COMPILED STUFF +; PUSH TP,$TCHAN ;SAVE THE CHANNEL TO BLESS IT +; PUSH TP,B +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JFCL +; CAME B,[ASCIZ /READ/] +; CAMN B,[ASCII /READB/] +; JRST .+2 +; JRST BADCHN + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.READ + JRST BADCHN + SKIPN IOINS(B) ; IS THE CHANNEL OPEN + PUSHJ P,OPENIT ; NO, GO DO IT + PUSHJ P,GRB ; MAKE SURE WE HAVE A READ BUFFER + PUSHJ P,R1CHAR ; AND GET HIM A CHARACTER + JRST MPOPJ ; THATS ALL FOLKS + +W1C: SUBM M,(P) + PUSHJ P,W1CI + JRST MPOPJ + +W1CI: +; PUSH TP,$TCHAN +; PUSH TP,B + PUSH P,A ; ASSEMBLER ENTRY TO OUTPUT 1 CHAR +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; INTERNAL CALL TO W1CHAR +; JFCL +; CAME B,[ASCII /PRINT/] +; CAMN B,[+1] +; JRST .+2 +; JRST BADCHN +; POP TP,B +; POP TP,(TP) + HRRZ A,-2(B) + TRNN A,C.PRIN + JRST BADCHN + SKIPN IOINS(B) ; MAKE SURE THAT IT IS OPEN + PUSHJ P,OPENIT + PUSHJ P,GWB + POP P,A ; GET THE CHAR TO DO + JRST W1CHAR + +; ROUTINES TO REPLACE XCT IOINS(B) FOR INPUT AND OUTPUT +; THEY DO THE XCT THEN CHECK OUT POSSIBLE SCRIPTAGE--BLECH. + + +WXCT: +RXCT: XCT IOINS(B) ; READ IT + SKIPN SCRPTO(B) + POPJ P, + +DOSCPT: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; AND SAVE THE CHAR AROUND + + SKIPN SCRPTO(B) ; IF ZERO FORGET IT + JRST SCPTDN ; THATS ALL THERE IS TO IT + PUSH P,C ; SAVE AN ACCUMULATOR FOR CLEANLINESS + GETYP C,SCRPTO-1(B) ; IS IT A LIST + CAIE C,TLIST + JRST BADCHN + PUSH TP,$TLIST + PUSH TP,[0] ; SAVE A SLOT FOR THE LIST + MOVE C,SCRPTO(B) ; GET THE LIST OF SCRIPT CHANNELS +SCPT1: GETYP B,(C) ; GET THE TYPE OF THIS SCRIPT CHAN + CAIE B,TCHAN + JRST BADCHN ; IF IT ISN'T A CHANNEL, COMPLAIN + HRRZ B,(C) ; GET THE REST OF THE LIST IN B + MOVEM B,(TP) ; AND STORE ON STACK + MOVE B,1(C) ; GET THE CHANNEL IN B + MOVE A,-1(P) ; AND THE CHARACTER IN A + PUSHJ P,W1CI ; GO TO INTERNAL W1C, IT BLESSES GOODIES + SKIPE C,(TP) ; GET THE REST OF LIST OF CHANS + JRST SCPT1 ; AND CYCLE THROUGH + SUB TP,[2,,2] ; CLEAN OFF THE LIST OF CHANS + POP P,C ; AND RESTORE ACCUMULATOR C +SCPTDN: POP P,A ; RESTORE THE CHARACTER + POP TP,B ; AND THE ORIGINAL CHANNEL + POP TP,(TP) + POPJ P, ; AND THATS ALL + + +; SUBROUTINE TO COPY FROM INCHAN TO OUTCHAN UNTIL EOF HIT +; ON THE INPUT CHANNEL +; CALL IS WHERE DEFAULTS ARE INCHAN AND OUTCHAN + + MFUNCTION FCOPY,SUBR,[FILECOPY] + + ENTRY + HLRE 0,AB + CAMGE 0,[-4] + JRST WNA ; TAKES FROM 0 TO 2 ARGS + + JUMPE 0,.+4 ; NO FIRST ARG? + PUSH TP,(AB) + PUSH TP,1(AB) ; SAVE IN CHAN + JRST .+6 + MOVE A,$TATOM + MOVE B,IMQUOTE INCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B + HLRE 0,AB ; CHECK FOR SECOND ARG + CAML 0,[-2] ; WAS THERE MORE THAN ONE ARG? + JRST .+4 + PUSH TP,2(AB) ; SAVE SECOND ARG + PUSH TP,3(AB) + JRST .+6 + MOVE A,$TATOM ; LOOK UP OUTCHAN AS DEFAULT + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B ; AND SAVE IT + + MOVE A,-3(TP) + MOVE B,-2(TP) ; INPUT CHANNEL + MOVEI 0,C.READ ; INDICATE INPUT + PUSHJ P,CHKCHN ; CHECK FOR GOOD CHANNEL + MOVE A,-1(TP) + MOVE B,(TP) ; GET OUT CHAN + MOVEI 0,C.PRIN ; INDICATE OUT CHAN + PUSHJ P,CHKCHN ; CHECK FOR GOOD OUT CHAN + + PUSH P,[0] ; COUNT OF CHARS OUTPUT + + MOVE B,-2(TP) + PUSHJ P,GRB ; MAKE SURE WE HAVE READ BUFF + MOVE B,(TP) + PUSHJ P,GWB ; MAKE SURE WE HAVE WRITE BUFF + +FCLOOP: INTGO + MOVE B,-2(TP) + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,FCDON ; IF A NEG NUMBER WE GOT EOF + MOVE B,(TP) ; GET OUT CHAN + PUSHJ P,W1CHAR ; SPIT IT OUT + AOS (P) ; INCREMENT COUNT + JRST FCLOOP + +FCDON: SUB TP,[2,,2] ; POP OFF OUTCHAN + MCALL 1,FCLOSE ; CLOSE INCHAN + MOVE A,$TFIX + POP P,B ; GET CHAR COUNT TO RETURN + JRST FINIS + +CHKCHN: PUSH P,0 ; CHECK FOR GOOD TASTING CHANNEL + PUSH TP,A + PUSH TP,B + GETYP C,A + CAIE C,TCHAN + JRST CHKBDC ; GO COMPLAIN IN RIGHT WAY +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JRST CHKBDC +; MOVE C,(P) ; GET CHAN DIRECT + HRRZ C,-2(B) ; MODE BITS + TDNN C,0 + JRST CHKBDC +; CAMN B,CHKT(C) +; JRST .+4 +; ADDI C,2 ; TEST FOR READB OR PRINTB ALSO +; CAME B,CHKT(C) ; TEST FOR CORRECT DIRECT +; JRST CHKBDC + MOVE B,(TP) + SKIPN IOINS(B) ; MAKE SURE IT IS OPEN + PUSHJ P,OPENIT ; IF ZERO IOINS GO OPEN IT + SUB TP,[2,,2] + POP P, ; CLEAN UP STACKS + POPJ P, + +CHKT: ASCIZ /READ/ + ASCII /PRINT/ + ASCII /READB/ + +1 + +CHKBDC: POP P,E + MOVNI D,2 + IMULI D,1(E) + HLRE 0,AB + CAMLE 0,D ; SEE IF THIS WAS HIS ARG OF DEFAULT + JRST BADCHN + JUMPE E,WTYP1 + JRST WTYP2 + + ; FUNCTIONS READSTRING AND PRINTSTRING WORK LIKE READB AND PRINTB, +; THAT IS THEY READ INTO AND OUT OF STRINGS. IN ADDITION BOTH ACCEPT +; AN ADDITIONAL ARGUMENT WHICH IS THE NUMBER OF CHARS TO READ OR PRINT, IF +; IT IS DESIRED FOR THIS TO BE DIFFERENT THAN THE LENGTH OF THE STRING. + +; FORMAT IS +; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN + +; FORMAT FOR PRINTSTRING IS + +; THESE WERE CODED 9/16/73 BY NEAL D. RYAN + + MFUNCTION RSTRNG,SUBR,READSTRING + + ENTRY + PUSH P,[0] ; FLAG TO INDICATE READING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-9] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 4 ARGS + JRST STRIO1 + + MFUNCTION PSTRNG,SUBR,PRINTSTRING + + ENTRY + PUSH P,[1] ; FLAG TO INDICATE WRITING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-7] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 3 ARGS + +STRIO1: PUSH TP,[0] ; SAVE SLOT ON STACK + PUSH TP,[0] + GETYP 0,(AB) + CAIE 0,TCHSTR ; MAKE SURE WE GOT STRING + JRST WTYP1 + HRRZ 0,(AB) ; CHECK FOR EMPTY STRING + SKIPN (P) + JUMPE 0,MTSTRN + HLRE 0,AB + CAML 0,[-2] ; WAS A CHANNEL GIVEN + JRST STRIO2 + GETYP 0,2(AB) + SKIPN (P) ; SKIP IF PRINT + JRST TESTIN + CAIN 0,TTP ; SEE IF FLATSIZE HACK + JRST STRIO9 +TESTIN: CAIE 0,TCHAN + JRST WTYP2 ; SECOND ARG NOT CHANNEL + MOVE B,3(AB) + HRRZ B,-2(B) + MOVNI E,1 ; CHECKING FOR GOOD DIRECTION + TRNE B,C.READ ; SKIP IF NOT READ + MOVEI E,0 + TRNE B,C.PRIN ; SKIP IF NOT PRINT + MOVEI E,1 + CAME E,(P) + JRST WRONGD ; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE +STRIO9: PUSH TP,2(AB) + PUSH TP,3(AB) ; PUSH ON CHANNEL + JRST STRIO3 +STRIO2: MOVE B,IMQUOTE INCHAN + MOVSI A,TCHAN + SKIPE (P) + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + GETYP 0,A + SKIPN (P) ; SKIP IF PRINTSTRING + JRST TESTI2 + CAIN 0,TTP ; SKIP IF NOT FLATSIZE HACK + JRST STRIO8 +TESTI2: CAIE 0,TCHAN + JRST BADCHN ; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL +STRIO8: PUSH TP,A + PUSH TP,B +STRIO3: MOVE B,(TP) ; GET CHANNEL + SKIPN E,IOINS(B) + PUSHJ P,OPENIT ; IF NOT GO OPEN + MOVE E,IOINS(B) + CAMN E,[JRST CHNCLS] + JRST CHNCLS ; CHECK TO SEE THAT CHANNEL ISNT ALREADY CLOSED +STRIO4: HLRE 0,AB + CAML 0,[-4] + JRST STRIO5 ; NO COUNT TO WORRY ABOUT + GETYP 0,4(AB) + MOVE E,4(AB) + MOVE C,5(AB) + CAIE 0,TCHSTR + CAIN 0,TFIX ; BETTER BE A FIXED NUMBER + JRST .+2 + JRST WTYP3 + HRRZ D,(AB) ; GET ACTUAL STRING LENGTH + CAIN 0,TFIX + JRST .+7 + SKIPE (P) ; TEST FOR WRITING + JRST .-7 ; IF WRITING WE GOT TROUBLE + PUSH P,D ; ACTUAL STRING LENGTH + MOVEM E,(TB) ; STUFF HIS FUNNY DELIM STRING + MOVEM C,1(TB) + JRST STRIO7 + CAML D,C ; MAKE SURE THE STRING IS LONG ENOUGH + JRST .+2 ; WIN + ERRUUO EQUOTE COUNT-GREATER-THAN-STRING-SIZE + PUSH P,C ; PUSH ON MAX COUNT + JRST STRIO7 +STRIO5: +STRIO6: HRRZ C,(AB) ; GET CHAR COUNT + PUSH P,C ; AND PUSH IT ON STACK AS NO MAX COUNT GIVEN +STRIO7: HLRE 0,AB + CAML 0,[-6] + JRST .+6 + MOVE B,(TP) ; GET THE CHANNEL + MOVE 0,6(AB) + MOVEM 0,EOFCND-1(B) ; STUFF IN SLOT IN CHAN + MOVE 0,7(AB) + MOVEM 0,EOFCND(B) + PUSH TP,(AB) ; PUSH ON STRING + PUSH TP,1(AB) + PUSH P,[0] ; PUSH ON CURRENT COUNT OF CHARS DONE + MOVE 0,-2(P) ; GET READ OR WRITE FLAG + JUMPN 0,OUTLOP ; GO WRITE STUFF + + MOVE B,-2(TP) ; GET CHANNEL + PUSHJ P,GRB ; MAKE SURE WE HAVE BUFF + SKIPGE A,LSTCH(B) ; CHECK FOR EOF ALREADY READ PREVIOUSLY + JRST SRDOEF ; GO DOES HIS EOF HACKING +INLOP: INTGO + MOVE B,-2(TP) ; GET CHANNEL + MOVE C,-1(P) ; MAX COUNT + CAMG C,(P) ; COMPARE WITH COUNT DONE + JRST STREOF ; WE HAVE FINISHED + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,INEOF ; EOF HIT + MOVE C,1(TB) + HRRZ E,(TB) ; DO WE HAVE A STRING TO WORRY US? + SOJL E,INLNT ; GO FINISH STUFFING + ILDB D,C + CAME D,A + JRST .-3 + JRST INEOF +INLNT: IDPB A,(TP) ; STUFF IN STRING + SOS -1(TP) ; DECREMENT STRING COUNT + AOS (P) ; INCREMENT CHAR COUNT + JRST INLOP + +INEOF: SKIPE C,LSTCH(B) ; IS THIS AN ! AND IS THERE A CHAR THERE + JRST .+3 ; YES + MOVEM A,LSTCH(B) ; NO SAVE THE CHAR + JRST .+3 + ADDI C,400000 + MOVEM C,LSTCH(B) + MOVSI C,200000 + IORM C,LSTCH(B) + HRRZ C,DIRECT-1(B) ; GET THE TYPE OF CHAN + CAIN C,5 ; IS IT READB? + JRST .+3 + SOS ACCESS(B) ; FIX UP ACCESS FOR READ CHANNEL + JRST STREOF ; AND THATS IT + HRRZ C,ACCESS-1(B) ; FOR A READB ITS WORSE + MOVEI D,5 + SKIPG C + HRRM D,ACCESS-1(B) ; CHANGE A 0 TO A FIVE + SOS C,ACCESS-1(B) + CAMN C,[TFIX,,0] + SOS ACCESS(B) ; AND SOS THE WORD COUNT MAYBE + JRST STREOF + +SRDOEF: SETZM LSTCH(B) ; IN CASE OF -1, FLUSH IT + AOJE A,INLOP ; SKIP OVER -1 ON PTY'S + SUB TP,[6,,6] + SUB P,[3,,3] ; POP JUNK OFF STACKS + PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) ; WHAT WE NEED TO EVAL + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOOSING CHANNEL + MCALL 1,EVAL ; EVAL HIS EOF JUNK + JRST FINIS + +OUTLOP: MOVE B,-2(TP) +OUTLP1: INTGO + MOVE A,-3(TP) ; GET CHANNEL + MOVE B,-2(TP) + MOVE C,-1(P) ; MAX COUNT TO DO + CAMG C,(P) ; HAVE WE DONE ENOUGH + JRST STREOF + ILDB D,(TP) ; GET THE CHAR + SOS -1(TP) ; SUBTRACT FROM STRING LENGTH + AOS (P) ; INC COUNT OF CHARS DONE + PUSHJ P,CPCH1 ; GO STUFF CHAR + JRST OUTLP1 + +STREOF: MOVE A,$TFIX + POP P,B ; RETURN THE LOOSER A COUNT OF WHAT WAS DONE + SUB P,[2,,2] + SUB TP,[6,,6] + JRST FINIS + + +GWB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A WRITE BUFFER ON PRINTB CHAN + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVSI A,TWORD+.VECT. + MOVEM A,BUFLNT(B) + SETOM (B) + MOVEI C,1(B) + HRLI C,(B) + BLT C,BUFLNT-1(B) + MOVEI C,-1(B) + HRLI C,010700 + MOVE B,(TP) + MOVEI 0,C.BUF + IORM 0,-2(B) + MOVEM C,BUFSTR(B) + MOVE C,[TCHSTR,,BUFLNT*5] + MOVEM C,BUFSTR-1(B) + SUB TP,[2,,2] + POPJ P, + + +GRB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A READ BUFFER + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVEI C,BUFLNT-1(B) + POP TP,B + MOVEI 0,C.BUF + IORM 0,-2(B) + HRLI C,010700 + MOVEM C,BUFSTR(B) + MOVSI C,TCHSTR + MOVEM C,BUFSTR-1(B) + SUB TP,[1,,1] + POPJ P, + +MTSTRN: ERRUUO EQUOTE EMPTY-STRING + + ; INPUT UNBUFFERING ROUTINE. THIS DOES THE CHARACTER UNBUFFERING +; FOR INPUT. THE OPEN ROUTINE SETUPS A PUSHJ P, TO +; THIS ROUTINE AS THE IOINS FOR A CHANNEL OPEN TO A NON-TTY DEVICE. + +; H. BRODIE 7/19/72 + +; CALLING SEQ: +; PUSHJ P,GETCHR +; B/ AOBJN PNTR TO CHANNEL VECTOR +; RETURNS NEXT CHARACTER IN AC A. +; ON ENCOUNTERING EITHER ^C OR NUL(^@) IT ASSUMES EOF AND +; TRANSMITS ONLY ^C ON SUCCESSIVE CALLS + + +GETCHR: +; FIRST GRAB THE BUFFER +; GETYP A,BUFSTR-1(B) ; GET TYPE WORD +; CAIN A,TCHSTR ; SKIPS IF NOT CHSTR (I.E. IF BAD BUFFER) +; JRST GTGBUF ; IS GOOD BUFFER...SKIP ERROR RETURN +GTGBUF: HRRZ A,BUFSTR-1(B) ; GET LENGTH OF STRING + SOJGE A,GTGCHR ; JUMP IF STILL MORE + +; HERE IF THE BUFFER WAS EXHAUSTED (BYTE PNTR POINTS INTO DOPE WDS) +; GENERATE AN .IOT POINTER +;FIRST SAVE C AND D AS I WILL CLOBBER THEM +NEWBUF: PUSH P,C + PUSH P,D +IFN ITS,[ + LDB C,[600,,STATUS(B)] ; GET TYPE + CAIG C,2 ; SKIP IF NOT TTY +] +IFE ITS,[ + SKIPE BUFRIN(B) +] + JRST GETTTY ; GET A TTY BUFFER + + PUSHJ P,PGBUFI ; RE-FILL BUFFER + +IFE ITS, MOVEI C,-1 + JUMPGE A,BUFGOO ;SKIPS IF IOT COMPLETED...FIX UP CHANNEL + MOVEI C,1 ; MAKE SURE LAST EOF REALLY ENDS IT + ANDCAM C,-1(A) + MOVSI C,014000 ; GET A ^C + MOVEM C,(A) ;FAKE AN EOF + +IFE ITS,[ + HLRE C,A ; HOW MUCH LEFT + ADDI C,BUFLNT ; # OF WORDS TO C + IMULI C,5 ; TO CHARS + MOVE A,-2(B) ; GET BITS + TRNE A,C.BIN ; CAN'T HELP A BINARY CHANNEL + JRST BUFGOO + MOVE A,CHANNO(B) + PUSH P,B + PUSH P,D + PUSH P,C + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + MOVE B,[2,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + POP P,C + CAIE D,7 ; SEVEN BIT BYTES? + JRST BUFGO1 ; NO, DONT HACK + MOVE D,C + IDIVI B,5 ; C IS NUMBER IN LAST WORD IF NOT EVEN + SKIPN C + MOVEI C,5 + ADDI C,-5(D) ; FIXUP C FOR WINNAGE +BUFGO1: POP P,D + POP P,B +] +; RESET THE BYTE POINTER IN THE CHANNEL. +; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D +BUFGOO: HRLI D,010700 ; GENERATE VIRGIN LH + SUBI D,1 + + MOVEM D,BUFSTR(B) ; STASH IN THE BUFFER BYTE PNTR SLOT +IFE ITS, HRRM C,LSTCH-1(B) ; SAVE IT + MOVEI A,BUFLNT*5-1 +BUFROK: POP P,D ;RESTORE D + POP P,C ;RESTORE C + + +; HERE IF THERE ARE CHARS IN BUFFER +GTGCHR: HRRM A,BUFSTR-1(B) + ILDB A,BUFSTR(B) ; GET A CHAR FROM BUFFER + +IFN ITS,[ + CAIE A,3 ; EOF? + POPJ P, ; AND RETURN + LDB A,[600,,STATUS(B)] ; CHECK FOR TTY + CAILE A,2 ; SKIP IF TTY +] +IFE ITS,[ + PUSH P,0 + HRRZ 0,LSTCH-1(B) + SOJL 0,.+4 + HRRM 0,LSTCH-1(B) + POP P,0 + POPJ P, + + POP P,0 + MOVSI A,-1 + SKIPN BUFRIN(B) +] + JRST .+3 +RETEO1: HRRI A,3 + POPJ P, + + HRRZ A,BUFSTR(B) ; SEE IF RSUBR START BIT IS ON + HRRZ A,(A) + TRNN A,1 + MOVSI A,-1 + JRST RETEO1 + +IFN ITS,[ +PGBUFO: +PGBUFI: +] +IFE ITS,[ +PGBUFO: SKIPA D,[SOUT] +PGBUFI: MOVE D,[SIN] +] + SKIPGE A,BUFSTR(B) ; POINT TO CURRENT BUFFER POSIT + SUBI A,1 ; FOR 440700 AND 010700 START + SUBI A,BUFLNT-1 ; CALCULATE PNTR TO BEG OF BUFFER + HRLI A,-BUFLNT ; IOT (AOBJN) PNTR IN A + MOVSI C,004400 +IFN ITS,[ +PGBIOO: +PGBIOI: MOVE D,A ; COPY FOR LATER + MOVSI C,TUVEC ; PREPARE TO HANDDLE INTS + MOVE PVP,PVSTOR+1 + MOVEM C,DSTO(PVP) + MOVEM C,ASTO(PVP) + MOVSI C,TCHAN + MOVEM C,BSTO(PVP) + +; BUILD .IOT INSTR + MOVE C,CHANNO(B) ; CHANNEL NUMBER IN C + ROT C,23. ; MOVE INTO AC FIELD + IOR C,[.IOT 0,A] ; IOR IN SKELETON .IOT + +; DO THE .IOT + ENABLE ; ALLOW INTS + XCT C ; EXECUTE THE .IOT INSTR + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM ASTO(PVP) + SETZM DSTO(PVP) + POPJ P, +] + +IFE ITS,[ +PGBIOT: PUSH P,D + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,C + HRRZS (P) + HRRI C,-1(A) ; POINT TO BUFFER + HLRE D,A ; XTRA POINTER + MOVNS D + HRLI D,TCHSTR + MOVE PVP,PVSTOR+1 + MOVEM D,BSTO(PVP) + MOVE D,[PUSHJ P,FIXACS] + MOVEM D,ONINT + MOVSI D,TUVEC + MOVEM D,DSTO(PVP) + MOVE D,A + MOVE A,CHANNO(B) ; FILE JFN + MOVE B,C + HLRE C,D ; - COUNT TO C + SKIPE (P) + MOVN C,(P) ; REAL DESIRED COUNT + SUB P,[1,,1] + ENABLE + XCT (P) ; DO IT TO IT + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM DSTO(PVP) + SETZM ONINT + MOVEI A,1(B) + MOVE B,(TP) + SUB TP,[2,,2] + SUB P,[1,,1] + JUMPGE C,CPOPJ ; NO EOF YET + HRLI A,(C) ; LOOK LIKE AN AOBJN PNTR + POPJ P, + +FIXACS: PUSH P,PVP + MOVE PVP,PVSTOR+1 + MOVNS C + HRRM C,BSTO(PVP) + MOVNS C + POP P,PVP + POPJ P, + +PGBIOO: SKIPA D,[SOUT] +PGBIOI: MOVE D,[SIN] + HRLI C,004400 + JRST PGBIOT +DOIOTO: PUSH P,[SOUT] +DOIOTC: PUSH P,B + PUSH P,C + EXCH A,B + MOVE A,CHANNO(A) + HLRE C,B + HRLI B,444400 + XCT -2(P) + HRL B,C + MOVE A,B +DOIOTE: POP P,C + POP P,B + SUB P,[1,,1] + POPJ P, +DOIOTI: PUSH P,[SIN] + JRST DOIOTC +] + +; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE + +PUTCHR: PUSH P,A + GETYP A,BUFSTR-1(B) ; CHECK TYPE OF ARG + CAIE A,TCHSTR ; MUST BE STRING + JRST BDCHAN + + HRRZ A,BUFSTR-1(B) ; GET CHAR COUNT + JUMPE A,REBUFF ; PREV RESET BUFF, UNDO SAME + +PUTCH1: POP P,A ; RESTORE CHAR + CAMN A,[-1] ; SPECIAL HACK? + JRST PUTCH2 ; YES GO HANDLE + IDPB A,BUFSTR(B) ; STUFF IT +PUTCH3: SOS A,BUFSTR-1(B) ; COUNT DOWN STRING + TRNE A,-1 ; SKIP IF FULL + POPJ P, + +; HERE TO FLUSH OUT A BUFFER + + PUSH P,C + PUSH P,D + PUSHJ P,PGBUFO ; SETUP AND DO IOT + HRLI D,010700 ; POINT INTO BUFFER + SUBI D,1 + MOVEM D,BUFSTR(B) ; STORE IT + MOVEI A,BUFLNT*5 ; RESET COUNT + HRRM A,BUFSTR-1(B) + POP P,D + POP P,C + POPJ P, + +;HERE TO DA ^C AND TURN ON MAGIC BIT + +PUTCH2: MOVEI A,3 + IDPB A,BUFSTR(B) ; ZAP OUT THE ^C + MOVEI A,1 ; GET BIT +IFE ITS,[ + PUSH P,C + HRRZ C,BUFSTR(B) + IORM A,(C) + POP P,C +] +IFN ITS,[ + IORM A,@BUFSTR(B) ; ON GOES THE BIT +] + JRST PUTCH3 + +; RESET A FUNNY BUF + +REBUFF: MOVEI A,BUFLNT*5 ; 1ST COUNT + HRRM A,BUFSTR-1(B) + HRRZ A,BUFSTR(B) ; NOW POINTER + SUBI A,BUFLNT+1 + HRLI A,010700 + MOVEM A,BUFSTR(B) ; STORE BACK + JRST PUTCH1 + + +; HERE TO FLUSH FINAL BUFFER + +BFCLOS: HRRZ C,-2(B) ; THIS BUFFER FLUSHER THE WORK OF NDR + MOVEI A,0 + TRNE C,C.TTY + POPJ P, + TRNE C,C.DISK + MOVEI A,1 + PUSH P,A ; SAVE THE RESULT OF OUR TEST + JUMPN A,BFCLNN ; DONT HAVE TO CHECK NET STATE + PUSH TP,$TCHAN + PUSH TP,B ; SAVE CHANNEL + PUSHJ P,INSTAT ; GET CURRENT NETWORK STATE + MOVE A,(B) ; GET FIRST ELEMENT OF STATE UVECTOR WHICH IS CUR STATE + POP TP,B ; RESTORE B + POP TP, + CAIE A,5 ; IS NET IN OPEN STATE? + CAIN A,6 ; OR ELSE IS IT IN RFNM WAIT STATE + JRST BFCLNN ; IF SO TO THE IOT + POP P, ; ELSE FLUSH CRUFT AND DONT IOT + POPJ P, ; RETURN DOING NO IOT +BFCLNN: MOVEI C,BUFLNT*5 ; NEW BUFFER FLUSHER BY NDR + HRRZ D,BUFSTR-1(B) ; SO THAT NET ALSO WORKS RIGHT + SUBI C,(D) ; GET NUMBER OF CHARS + IDIVI C,5 ; NUMBER OF FULL WORDS AND REST + PUSH P,D ; SAVE NUMBER OF ODD CHARS + SKIPGE A,BUFSTR(B) ; GET CURRENT BUF POSITION + SUBI A,1 ; FIX FOR 440700 BYTE POINTER +IFE ITS,[ + HRRO D,A + PUSH P,(D) +] +IFN ITS,[ + PUSH P,(A) ; SAVE THE ODD WORD OF BUFFER +] + MOVEI D,BUFLNT + SUBI D,(C) + SKIPE -1(P) + SUBI A,1 + ADDI D,1(A) ; FIX UP FOR POSSIBLE ODD CHARS + PUSH TP,$TUVEC + PUSH TP,D ; PUSH THE DOPE VECTOR ONTO THE STACK + JUMPE C,BFCLSR ; IN CASE THERE ARE NO FULL WORDS TO DO + HRL A,C + TLO A,400000 + MOVE E,[SETZ BUFLNT(A)] + SUBI E,(C) ; FIX UP FOR BACKWARDS BLT + POP A,@E ; AMAZING GRACE + TLNE A,377777 + JRST .-2 + HRRO A,D ; SET UP AOBJN POINTER + SUBI A,(C) + TLC A,-1(C) + PUSHJ P,PGBIOO ; DO THE IOT OF ALL THE FULL WORDS +BFCLSR: HRRO A,(TP) ; GET IOT PTR FOR REST OF JUNK + SUBI A,1 ; POINT TO WORD BEFORE DOPE WORDS + POP P,0 ; GET BACK ODD WORD + POP P,C ; GET BACK ODD CHAR COUNT + POP P,D ; FLAG FOR NET OR DSK + JUMPN D,BFCDSK ; GO FINISH OFF DSK + JUMPE C,BFCLSD ; IF NO ODD CHARS FINISH UP + MOVEI D,7 + IMULI D,(C) ; FIND NO OF BITS TO SHIFT + LSH 0,-43(D) ; SHIFT BITS TO RIGHT PLACE + MOVEM 0,(A) ; STORE IN STRING + SUBI C,5 ; HOW MANY CHAR POSITIONS TO SKIP + MOVNI C,(C) ; MAKE C POSITIVE + LSH C,17 + TLC A,(C) ; MUNG THE AOBJN POINTER TO KLUDGE + PUSHJ P,PGBIOO ; DO IOT OF ODD CHARS + MOVEI C,0 +BFCLSD: HRRZ A,(TP) ; GET PTR TO DOPE WORD + SUBI A,BUFLNT+1 + JUMPLE C,.+3 + SKIPE ACCESS(B) + MOVEM 0,1(A) ; LAST WORD BACK IN BFR + HRLI A,010700 ; AOBJN POINTER TO FIRST OF BUFFER + MOVEM A,BUFSTR(B) + MOVEI A,BUFLNT*5 + HRRM A,BUFSTR-1(B) + SKIPN ACCESS(B) + JRST BFCLSY + JUMPL C,BFCLSY + JUMPE C,BFCLSZ + IBP BUFSTR(B) + SOS BUFSTR-1(B) + SOJG C,.-2 +BFCLSY: MOVE A,CHANNO(B) + MOVE C,B +IFE ITS,[ + RFPTR + FATAL RFPTR FAILED + HRRZ F,LSTCH-1(C) ; PREVIOUS HIGH + MOVE G,C ; SAVE CHANNEL + MOVE C,B + CAML F,B + MOVE C,F + MOVE F,B + HRLI A,400000 + CLOSF + JFCL + MOVNI B,1 + HRLI A,12 + CHFDB + MOVE B,STATUS(G) + ANDI A,-1 + OPENF + FATAL OPENF LOSES + MOVE C,F + IDIVI C,5 + MOVE B,C + SFPTR + FATAL SFPTR FAILED + MOVE B,G +] +IFN ITS,[ + DOTCAL RFPNTR,[A,[2000,,B]] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + SUBI B,1 + DOTCAL ACCESS,[A,B] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + MOVE B,C +] +BFCLSZ: SUB TP,[2,,2] + POPJ P, + +BFCDSK: TRZ 0,1 + PUSH P,C +IFE ITS,[ + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,0 ; WORD OF CHARS + MOVE A,CHANNO(B) + MOVEI B,7 ; MAKE BYTE SIZE 7 + SFBSZ + JFCL + HRROI B,(P) + MOVNS C + SKIPE C + SOUT + MOVE B,(TP) + SUB P,[1,,1] + SUB TP,[2,,2] +] +IFN ITS,[ + MOVE D,[440700,,A] + DOTCAL SIOT,[CHANNO(B),D,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + POP P,C + JUMPN C,BFCLSD +BFCDS1: MOVNI C,1 ; INDICATE NOT TOHACK BUFFER + JRST BFCLSD + +BFCLS1: HRRZ C,DIRECT-1(B) + MOVSI 0,(JFCL) + CAIE C,6 + MOVE 0,[AOS ACCESS(B)] + PUSH P,0 + HRRZ C,BUFSTR-1(B) + IDIVI C,5 + JUMPE D,BCLS11 + MOVEI A,40 ; PAD WITH SPACES + PUSHJ P,PUTCHR + XCT (P) ; AOS ACCESS IF NECESSARY + SOJG D,.-3 ; TO END OF WORD +BCLS11: POP P,0 + HLLZS ACCESS-1(B) + HRRZ C,BUFSTR-1(B) + CAIE C,BUFLNT*5 + PUSHJ P,BFCLOS + POPJ P, + + +; HERE TO GET A TTY BUFFER + +GETTTY: SKIPN C,EXBUFR(B) ; SKIP IF BUFFERS BACKED UP + JRST TTYWAI + HRRZ D,(C) ; CDR THE LIST + GETYP A,(C) ; CHECK TYPE + CAIE A,TDEFER ; MUST BE DEFERRED + JRST BDCHAN + MOVE C,1(C) ; GET DEFERRED GOODIE + GETYP A,(C) ; BETTER BE CHSTR + CAIE A,TCHSTR + JRST BDCHAN + MOVE A,(C) ; GET FULL TYPE WORD + MOVE C,1(C) + MOVEM D,EXBUFR(B) ; STORE CDR'D LIST + MOVEM A,BUFSTR-1(B) ; MAKE CURRENT BUFFER + MOVEM C,BUFSTR(B) + HRRM A,LSTCH-1(B) + SOJA A,BUFROK + +TTYWAI: PUSHJ P,TTYBLK ; BLOCKED FOR TTY I/O + JRST GETTTY ; SHOULD ONLY RETURN HAPPILY + + ;INTERNAL DEVICE READ ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT, +;CHECKS THAT THE RETURNED VALUE IS OF TYPE CHARACTER, +;AND RETURNS THAT AS THE NEXT CHARACTER IN THE "FILE" + +;H. BRODIE 8/31/72 + +GTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,INTFCN-1(B) + GETYP A,A + CAIE A,TCHRS + JRST BADRET + MOVE A,B +INTRET: POP P,0 ;RESTORE THE ACS + POP P,E + POP P,D + POP P,C + POP TP,B ;RESTORE THE CHANNEL + SUB TP,[1,,1] ;FLUSH $TCHAN...WE DON'T NEED IT + POPJ P, + + +BADRET: ERRUUO EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT + +;INTERNAL DEVICE PRINT ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,(FUNCTION, SUBR, OR RSUBR) +;TO THE CURRENT CHARACTER BEING "PRINTED". + +PTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,$TCHRS ;PUSH THE TYPE "CHARACTER" + PUSH TP,A ;PUSH THE CHAR + PUSH TP,$TCHAN ;PUSH THE CHANNEL + PUSH TP,B + MCALL 2,INTFCN-1(B) ;APPLY THE FUNCTION TO THE CHAR + JRST INTRET + + + +; ROUTINE TO FLUSH OUT A PRINT BUFFER + +MFUNCTION BUFOUT,SUBR + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + + MOVE B,1(AB) +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; GET DIR NAME +; JFCL +; CAMN B,[ASCII /PRINT/] +; JRST .+3 +; CAME B,[+1] +; JRST WRONGD +; TRNE B,1 ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN B,1 ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] + HRRZ 0,-2(B) + TRNN 0,C.PRIN + JRST WRONGD +; TRNE 0,C.BIN ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN 0,C.BIN ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] +; MOVE B,1(AB) +; GETYP 0,BUFSTR-1(B) +; CAIN 0,TCHSTR +; SKIPN A,BUFSTR(B) ; BYTE POINTER? +; JRST BFIN1 +; HRRZ C,BUFSTR-1(B) ; CHARS LEFT +; IDIVI C,5 ; MULTIPLE OF 5? +; JUMPE D,BFIN2 ; YUP NO EXTRAS + +; MOVEI A,40 ; PAD WITH SPACES +; PUSHJ P,PUTCHR ; OUT IT GOES +; XCT (P) ; MAYBE BUMP ACCESS +; SOJG D,.-3 ; FILL + +BFIN2: PUSHJ P,BFCLOS ; WRITE OUT BUFFER + +BFIN1: MOVSI A,TCHAN + JRST FINIS + + + +; FUNCTION TO GET THE FILE LENGTH OF A READ CHANNEL + +MFUNCTION FILLNT,SUBR,[FILE-LENGTH] + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) + PUSHJ P,CFILLE + JRST FINIS + +CFILLE: +IFN 0,[ + MOVEI B,DIRECT-1(B) ; GET CHANNEL TYPE + PUSHJ P,CHRWRD + JFCL + CAME B,[ASCIZ /READ/] + JRST .+3 + PUSH P,[5] ; MULTIPLICATIVE FACTOR FOR READ + JRST .+4 + CAME B,[ASCII /READB/] + JRST WRONGD + PUSH P,[1] ; MULTIPLICATIVE FACTOR FOR READ +] + MOVE C,-2(B) ; GET BITS + MOVEI D,5 ; ASSUME ASCII + TRNE C,C.BIN ; SKIP IF NOT BINARY + MOVEI D,1 + PUSH P,D + MOVE C,B +IFN ITS,[ + .CALL FILL1 + JRST FILLOS ; GIVE HIM A NICE FALSE +] +IFE ITS,[ + MOVE A,CHANNO(C) + PUSH P,[0] + MOVEI C,(P) + MOVE B,[1,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,(P)] ; GET BYTE SIZE + JUMPN D,.+2 + MOVEI D,36. ; HANDLE "0" BYTE SIZE + SUB P,[1,,1] + SIZEF + JRST FILLOS +] + POP P,C +IFN ITS, IMUL B,C +IFE ITS,[ + CAIN C,5 + CAIE D,7 + JRST NOTASC +] +YESASC: MOVE A,$TFIX + POPJ P, + +IFE ITS,[ +NOTASC: MOVEI 0,36. + IDIV 0,D ; BYTES PER WORD + IDIVM B,0 + IMUL C,0 + MOVE B,C + JRST YESASC +] + +IFN ITS,[ +FILL1: SETZ ; BLOCK FOR .CALL TO FILLEN + SIXBIT /FILLEN/ + CHANNO (C) + SETZM B + +FILLOS: MOVE A,CHANNO(C) + MOVE B,[.STATUS A] ;MAKE A CALL TO STATUS TO FIND REASON + LSH A,23. ;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE + IOR B,A ;FIX UP .STATUS + XCT B + MOVE B,C + PUSHJ P,GFALS + POP P, + POPJ P, +] +IFE ITS,[ +FILLOS: MOVE B,C + PUSHJ P,TGFALS + POP P, + POPJ P, +] + + + ; MCHAN LOW-LEVEL I/O GARBAGE (PDL)-ORIGINAL (LIM)-ADDITIONS + +;CALLING ROUTINE: AC-A contains pointer to block of SIXBIT data +; DIR ? DEV ? FNM1 ? FNM2 ? SNM +;RETURNED VALUE : AC-A = +IFN ITS,[ +MOPEN: PUSH P,B + PUSH P,C + MOVE C,FRSTCH ; skip gc and tty channels +CNLP: DOTCAL STATUS,[C,[2000,,B]] + .LOSE %LSFIL + ANDI B,77 + JUMPE B,CHNFND ; found unused channel ? + ADDI C,1 ; try another channel + CAIG C,17 ; are all the channels used ? + JRST CNLP + SETO C, ; all channels used so C = -1 + JRST CHNFUL +CHNFND: MOVEI B,(C) + HLL B,(A) ; M.DIR slot + DOTCAL OPEN,[B,1(A),2(A),3(A),4(A)] + SKIPA + AOS -2(P) ; successful skip when returning +CHNFUL: MOVE A,C + POP P,C + POP P,B + POPJ P, + +MIOT: DOTCAL IOT,[A,B] + JFCL + POPJ P, + +MCLOSE: DOTCAL CLOSE,[A] + JFCL + POPJ P, + +IMPURE + +FRSTCH: 1 + +PURE +] + ;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O + +NOTNET: +BADCHN: ERRUUO EQUOTE BAD-CHANNEL +BDCHAN: ERRUUO EQUOTE BAD-INPUT-BUFFER + +WRONGD: ERRUUO EQUOTE WRONG-DIRECTION-CHANNEL + +CHNCLS: ERRUUO EQUOTE CHANNEL-CLOSED + +BAD6: ERRUUO EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME + +DISLOS: MOVE C,$TCHSTR + MOVE D,CHQUOTE [DISPLAY NOT AVAILABLE] + PUSHJ P,INCONS + MOVSI A,TFALSE + JRST OPNRET + +NOCHAN: ERRUUO EQUOTE ITS-CHANNELS-EXHAUSTED + +MODE1: 232020,,202020 +MODE2: 232023,,330320 + +END + + \ No newline at end of file diff --git a//fopen.mid.60 b//fopen.mid.60 new file mode 100644 index 0000000..afe3199 --- /dev/null +++ b//fopen.mid.60 @@ -0,0 +1,4712 @@ +TITLE OPEN - CHANNEL OPENER FOR MUDDLE + +RELOCATABLE + +;C. REEVE MARCH 1973 + +.INSRT MUDDLE > + +SYSQ + +FNAMS==1 +F==E+1 +G==F+1 + +IFE ITS,[ +IF1, .INSRT STENEX > +] +;THIS PROGRAM HAS ENTRIES: FOPEN, FCLOSE, RENAME, READB, PRINTB, FILECOPY, READSTRING, +; PRINTSTRING, NETSTATE, NETACC, NETS, ACCESS, AND FILE-EXISTS? + +;THESE SUBROUTINES HANDLE I/O STREAMS FOR THE MUDDLE SYSTEM. + +; FOPEN - OPENS A FILE FOR EITHER READING OR WRITING. IT TAKES +; FIVE OPTINAL ARGUMENTS AS FOLLOWS: + +; FOPEN (,,,,) +; +; - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ + +; - FIRST FILE NAME. DEFAULT INPUT OR OUTPUT. + +; - SECOND FILE NAME. DEFAULT MUDDLE. + +; - DEVICE FROM WHICH TO OPEN. DEFAULT IS DSK. + +; - SYSTEM (DIRECTORY) NAME. DEFAULT UNAME. + +; FOPEN RETURNS AN OBJECT OF TYPE CHANNEL IF IT SUCCEEDS OTHERWISE NIL + + +; FCLOSE - CLOSES A FILE. TAKES A CHANNEL OBJECT AS ITS ARGUMENT. IT ALSO TAKES +; ACCESS - DOES A .ACCESS ON A CHARACTER BASIS FOR CHARACTER FILES + + +; A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION + +; CHANNO ;ITS I/O CHANNEL NUMBER. 0 MEANS NOT A REAL CHANNEL. +; DIRECT ;DIRECTION (EITHER READ OR PRINT) +; NAME1 ;FIRST NAME OF FILE AS OPENED. +; NAME2 ;SECOND NAME OF FILE +; DEVICE ;DEVICE UPON WHICH THE CHANNEL IS OPEN +; SNAME ;DIRECTORY NAME +; RNAME1 ;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS) +; RNAME2 ;REAL SECOND NAME +; RDEVIC ;REAL DEVICE +; RSNAME ;SYSTEM OR DIRECTORY NAME +; STATUS ;VARIOUS STATUS BITS +; IOINS ;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER +; ACCESS ;ACCESS POINTER FOR RAND ACCESS (OR USED FOR DISPLAY INFO) +; RADX ;RADIX FOR CHANNELS NUMBER CONVERSION + +; *** THE FOLLOWING FIELDS FOR OUTPUT ONLY *** +; LINLN ;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE +; CHRPOS ;CURRENT POSITION ON CURRENT LINE +; PAGLN ;LENGTH OF A PAGE +; LINPOS ;CURRENT LINE BEING WRITTEN ON + +; *** THE FOLLOWING FILEDS FOR INPUT ONLY *** +; EOFCND ;GETS EVALUATED ON EOF +; LSTCH ;BACKUP CHARACTER +; WAITNS ;FOR TTY INPUT, BECOMES A .SLEEP WHEN WAITING +; EXBUFR ;FOR TTY INPUT, CONTAINS A WAITING BUFFER LIST +; BUFSTR ;A CHARACTER STRING USED AS BUFFER FOR NON-TTY DEVICES + +; THIS DEFINES THE LENGTH OF THE NON-TTY BUFFER +BUFLNT==100 + +;THIS DEFINES BLOCK MODE BIT FOR OPENING +BLOCKM==2 ;DEFINED IN THE LEFT HALF +IMAGEM==4 + + +;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME + + CHANLNT==4 ;INITIAL CHANNEL LENGTH + +; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS +BUFRIN==-1 ;SPECIAL HACK SO LOSERS WON'T SEE TTY BUFFER +SCRPTO==-3 ;SPECIAL HACK FOR SCRIPT CHANNELS +PROCHN: + +IRP A,,[[CHANNO,FIX],[DIRECT,CHSTR] +[NAME1,CHSTR],[NAME2,CHSTR],[DEVICE,CHSTR],[SNAME,CHSTR] +[RNAME1,CHSTR],[RNAME2,CHSTR],[RDEVIC,CHSTR],[RSNAME,CHSTR] +[STATUS,FIX],[IOINS,FIX],[LINLN,FIX],[CHRPOS,FIX],[PAGLN,FIX],[LINPOS,FIX] +[ACCESS,FIX],[RADX,FIX],[BUFSTR,CHSTR]] + + IRP B,C,[A] + B==CHANLNT-3 + T!C,,0 + 0 + .ISTOP + TERMIN + CHANLNT==CHANLNT+2 +TERMIN + + +; EQUIVALANCES FOR CHANNELS + +EOFCND==LINLN +LSTCH==CHRPOS +WAITNS==PAGLN +EXBUFR==LINPOS +DISINF==BUFSTR ;DISPLAY INFO +INTFCN==BUFSTR ;FUNCTION (OR SUBR, OR RSUBR) TO BE APPLIED FOR INTERNAL CHNLS + + +;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS + +IRP A,,[IOIN2,ECHO,CHRCNT,ERASCH,KILLCH,BRKCH,ESCAP,SYSCHR,BRFCHR,BRFCH2,BYTPTR] +A==.IRPCNT +TERMIN + +EXTBFR==BYTPTR+1+<100./5> ;LENGTH OF ADD'L BUFFER + + + + +.GLOBAL IPNAME,MOPEN,MCLOSE,MIOT,ILOOKU,6TOCHS,ICLOS,OCLOS,RGPARS,RGPRS +.GLOBAL OPNCHN,CHMAK,READC,TYO,SYSCHR,BRFCHR,LSTCH,BRFCH2,EXTBFR +.GLOBAL CHRWRD,STRTO6,TTYBLK,WAITNS,EXBUFR,TTICHN,TTOCHN,GETCHR,IILIST +.GLOBAL CHANNO,STATUS,LINPOS,PAGLN,CHRPOS,LINLN,IOINS,ACCESS,ADDNUL +.GLOBAL DIRECT,DISINF,RADX,EOFCND,BUFSTR,MODE1,MODE2,GCHACK,GMTYO,INMTYO +.GLOBAL T.CHAN,NAME1,BFCLOS,DOIOTI,DOIOTO,DOACCS,NOTTY,DEMFLG,BYTDOP,TNXIN +.GLOBAL DISOPN,DISROP,DISCLS,DCHAR,DISLNL,DISPGL,INSTAT,MTYO,CIREST +.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP,N.CHNS +.GLOBAL REOPN,QUITTE,CHNL0,CHNL1,BUFRIN,IOIN2,IFALSE,GFALS,IDVAL,PVSTOR,SPSTOR +.GLOBAL BADCHN,WRONGD,CHNCLS,GSNAME,GIBLOK,APLQ,NAPT,ICONS,INCONS,IBLOCK,IDVAL1 +.GLOBAL GRB,GWB,R1CHAR,W1CHAR,BFCLS1,TTYOP2,MPOPJ,COMPER,R1C,W1C,WXCT,RXCT +.GLOBAL TMTNXS,TNXSTR,RDEVIC,CPCH1,RCYCHN,CGFALS,CISTNG,CFILLE,FRSTCH +.GLOBAL TGFALS,ONINT + +.VECT.==40000 + +; PAIR MOVING MACRO + +DEFINE PMOVEM A,B + MOVE 0,A + MOVEM 0,B + MOVE 0,A+1 + MOVEM 0,B+1 + TERMIN + +; DEFINITIONS OF THE OFFSETS INTO THE TP STACK FOR OPEN + +T.SPDL==0 ; SAVES P STACK BASE +T.DIR==2 ; CONTAINS DIRECTION AND MODE +T.NM1==4 ; NAME 1 OF FILE +T.NM2==6 ; NAME 2 OF FILE +T.DEV==10 ; DEVICE NAME +T.SNM==12 ; SNAME +T.XT==14 ; EXTRA CRUFT IF NECESSARY +T.CHAN==16 ; CHANNEL AS GENERATED + +; OFFSETS FROM PSTACK BASE (USED FOR OPENS, .RCHST AND .FDELES) + +S.DIR==0 ; CODE FOR DIRECTION 0-IN, 1-OUT, 2-BIN, 3-BOUT,4-DISPLAY + ; S.DIR(P) = ,, +IFN ITS,[ +S.DEV==1 ; SIXBIT DEVICE RIGHT JUSTIFIED +S.NM1==2 ; SIXBIT NAME1 +S.NM2==3 ; SIXBIT NAME2 +S.SNM==4 ; SIXBIT SNAME +S.X1==5 ; TEMPS +S.X2==6 +S.X3==7 +] + +IFE ITS,[ +S.DEV==1 +S.X1==2 +S.X2==3 +S.X3==4 +] + + +; FLAGS SPECIFYING STATE OF THE WORLD AT VARIOUS TIMES + +NOSTOR==400000 ; ON MEANS DONT BUILD NEW STRINGS +MSTNET==200000 ; ON MEANS ONLY THE "NET" DEVICE CAN WIN +SNSET==100000 ; FLAG, SNAME SUPPLIED +DVSET==040000 ; FLAG, DEV SUPPLIED +N2SET==020000 ; FLAG, NAME2 SET +N1SET==010000 ; FLAG, NAME1 SET +4ARG==004000 ; FLAG, CONSIDER ARGS TO BE 4 STRINGS + +RMT [EXPUNGE N1SET,N2SET,DVSET,SNSET,MSTNET,NOSTOR +] + +; TABLE OF LEGAL MODES + +MODES: IRP A,,[READ,PRINT,READB,PRINTB,PRINTO,PRINAO] + SIXBIT /A/ + TERMIN +NMODES==.-MODES + +MODCOD: 0?1?2?3?3?1 +; TABLE OF KNOWN DEVICES AND A POINTER TO THEIR OPENERS + +IFN ITS,[ +DEVSTB: IRP A,,[DSK,TTY,USR,STY,ST,NET,INT,PTP,PTR,UT,T,NUL] + SIXBIT /A/ ; DEVICE NAMES + TERMIN + +DEVS: IRP B,,[ODSK,OTTY,OUSR,OSTY,OSTY,ONET,OINT,OPTP,OPTP,OUTN,OTTY,ONUL] + SETZ B ; POINTERS + TERMIN +] + +IFE ITS,[ +DEVSTB: IRP A,,[PS,SS,SRC,DSK,TTY,INT,NET] + SIXBIT /A/ + TERMIN + +DEVS: IRP B,,[ODSK,ODSK,ODSK,ODSK,OTTY,OINT,ONET] + SETZ B + TERMIN +] +NDEVS==.-DEVS + + + +;SUBROUTINE TO DO OPENING BEGINS HERE + +MFUNCTION NFOPEN,SUBR,[OPEN-NR] + + JRST FOPEN1 + +MFUNCTION FOPEN,SUBR,[OPEN] + +FOPEN1: ENTRY + PUSHJ P,MAKCHN ;MAKE THE CHANNEL + PUSHJ P,OPNCH ;NOW OPEN IT + JUMPL B,FINIS + SUB D,[4,,4] ; TOP THE CHANNEL + MOVEM D,RCYCHN+1 ; RECYCLE DEAD CHANNEL + SETZM (D) ; ZAP IT + MOVEI C,1(D) + HRLI C,(D) + BLT C,CHANLNT-1(D) + JRST FINIS + +; SUBR TO JUST CREATE A CHANNEL + +IMFUNCTION CHANNEL,SUBR + + ENTRY + PUSHJ P,MAKCHN + MOVSI A,TCHAN + JRST FINIS + + + + +; THIS ROUTINE PARSES ARGUMENTS TO FOPEN ETC. AND BUILDS A CHANNEL BUT DOESN'T OPEN IT + +MAKCHN: PUSH TP,$TPDL + PUSH TP,P ; POINT AT CURRENT STACK BASE + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE READ + MOVEI E,10 ; SLOTS OF TP NEEDED + PUSH TP,[0] + SOJG E,.-1 + MOVEI E,0 + EXCH E,(P) ; GET RET ADDR IN E +IFE ITS, PUSH P,[0] +IRP ATM,,[DEV,NM1,NM2,SNM]MDF,,[DSK,INPUT,>,[ ]]TMDF,,[DSK,INPUT,MUD,[ ]] + MOVE B,IMQUOTE ATM +IFN ITS, PUSH P,E + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TCHSTR + JRST MAK!ATM + + MOVE A,$TCHSTR +IFN ITS, MOVE B,CHQUOTE MDF +IFE ITS, MOVE B,CHQUOTE TMDF +MAK!ATM: + MOVEM A,T.!ATM(TB) + MOVEM B,T.!ATM+1(TB) +IFN ITS,[ + POP P,E + PUSHJ P,STRTO6 ; RESULT LEFT ON P STACK AS DESIRED +] + TERMIN + PUSH TP,[0] ; PUSH SLOTS + PUSH TP,[0] + + PUSH P,[0] ; EXT SLOTS + PUSH P,[0] + PUSH P,[0] + PUSH P,E ; PUSH RETURN ADDRESS + MOVEI A,0 + + JUMPGE AB,MAKCH0 ; NO ARGS, ALREADY DONE + GETYP 0,(AB) ; 1ST ARG MUST BE A STRING + CAIE 0,TCHSTR + JRST WTYP1 + MOVE A,(AB) ; GET ARG + MOVE B,1(AB) + PUSHJ P,CHMODE ; CHECK OUT OPEN MODE + + PMOVEM (AB),T.DIR(TB) ; SAVE MODE NAME IN TEMPS + ADD AB,[2,,2] ; BUMP PAST DIRECTION + MOVEM AB,ABSAV(TB) + MOVEI A,0 + JUMPGE AB,MAKCH0 ; CHECK NAME1 BASED ON JUST MODE + + MOVEI 0,0 ; FLAGS PRESET + PUSHJ P,RGPARS ; PARSE THE STRING(S) + JRST TMA + +; ARGUMENTS PARSED, DO FINAL CHECKS AND BUILD CHANNEL + +MAKCH0: +IFN ITS,[ + MOVE C,T.SPDL+1(TB) + MOVE D,S.DEV(C) ; GET DEV +] +IFE ITS,[ + MOVE A,T.DEV(TB) + MOVE B,T.DEV+1(TB) + PUSHJ P,STRTO6 + POP P,D + HLRZS D + MOVE C,T.SPDL+1(TB) + MOVEM D,S.DEV(C) +] +IFE ITS, CAIE D,(SIXBIT /INT/);INTERNAL? +IFN ITS, CAME D,[SIXBIT /INT /] + JRST CHNET ; NO, MAYBE NET + SKIPN T.XT+1(TB) ; WAS FCN SUPPLIED? + JRST TFA + +; FALLS TROUGH IF SKIP + + + +; NOW BUILD THE CHANNEL + +ARGSOK: MOVEI A,CHANLNT ; GET LENGTH + SKIPN B,RCYCHN+1 ; RECYCLE? + PUSHJ P,GIBLOK ; GET A BLOCK OF STUFF + SETZM RCYCHN+1 + ADD B,[4,,4] ; HIDE THE TTY BUFFER SLOT + PUSH TP,$TCHAN + PUSH TP,B + HRLI C,PROCHN ; POINT TO PROTOTYPE + HRRI C,(B) ; AND NEW ONE + BLT C,CHANLN-5(B) ; CLOBBER + MOVSI C,TLIST ; TO GIVE HIM A CLEAN LIST OF SCRIPT CHANS + HLLM C,SCRPTO-1(B) + +; NOW BLT IN STUFF FROM THE STACK + + MOVSI C,T.DIR(TB) ; DIRECTION + HRRI C,DIRECT-1(B) + BLT C,SNAME(B) + MOVEI C,RNAME1-1(B) ; NOW "REAL" SLOTS + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + MOVE B,IMQUOTE MODE + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TFIX + JRST .+3 + MOVE B,(TP) + POPJ P, + + MOVE C,(TP) +IFE ITS,[ + ANDI B,403776 ; ONLY ALLOW NON-CRITICAL BITSS +] + HRRM B,-4(C) ; HIDE BITS + MOVE B,C + POPJ P, + +; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN + +CHNET: +IFN ITS,[ + CAME D,[SIXBIT /NET /] ; IS IT NET + JRST MAKCH1] +IFE ITS,[ + CAIE D,(SIXBIT /NET/) ; IS IT NET + JRST ARGSOK] + MOVSI D,TFIX ; FOR TYPES + MOVEI B,T.NM1(TB) ; MAKE SURE ALL ARE FIXED + PUSHJ P,CHFIX + MOVEI B,T.NM2(TB) + PUSHJ P,CHFIX + MOVEI B,T.SNM(TB) + LSH A,-1 ; SKIP DEV FLAG + PUSHJ P,CHFIX + JRST ARGSOK + +MAKCH1: TRNN A,MSTNET ; CANT HAVE SEEN A FIX + JRST ARGSOK + JRST WRONGT + +IFN ITS,[ +CHFIX: TRNE A,N1SET ; SKIP IF NOT SPECIFIED + JRST CHFIX1 + SETOM 1(B) ; SET TO -1 + SETOM S.NM1(C) + MOVEM D,(B) ; CORRECT TYPE +] +IFE ITS,CHFIX: + GETYP 0,(B) + CAIE 0,TFIX + JRST PARSQ +CHFIX1: ADDI C,1 ; POINT TO NEXT FIELD + LSH A,-1 ; AND NEXT FLAG + POPJ P, +PARSQ: CAIE 0,TCHSTR + JRST WRONGT +IFE ITS, POPJ P, +IFN ITS,[ + PUSH P,A + PUSH P,C + PUSH TP,(B) + PUSH TP,1(B) + SUBI B,(TB) + PUSH P,B + MCALL 1,PARSE + GETYP 0,A + CAIE 0,TFIX + JRST WRONGT + POP P,C + ADDI C,(TB) + MOVEM A,(C) + MOVEM B,1(C) + POP P,C + POP P,A + POPJ P, +] + + +; SUBROUTINE TO CHECK VALIDITY OF MODE AND SAVE A CODE + +CHMODE: PUSHJ P,CHMOD ; DO IT + MOVE C,T.SPDL+1(TB) + HRRZM A,S.DIR(C) + POPJ P, + +CHMOD: PUSHJ P,STRTO6 ; TO SIXBIT + POP P,B ; VALUE ENDSUP ON STACK, RESTORE IT + + MOVSI A,-NMODES ; SCAN TO SEE IF LEGAL MODE + CAME B,MODES(A) + AOBJN A,.-1 + JUMPGE A,WRONGD ; ILLEGAL MODE NAME + MOVE A,MODCOD(A) + POPJ P, + + +IFN ITS,[ +; RGPARS -- PARSE THE STRINGS COMPRISING FILE NAMES INTO STANDARD ITS GOODIES + +RGPRS: MOVEI 0,NOSTOR ; DONT STORE STRINGS IF ENTER HERE + +RGPARS: CAMGE AB,[-7,,] ; MULTI-STRING CASE POSSIBLE? + IORI 0,4ARG ; 4 STRING CASE + HRLM 0,(P) ; LH IS FLAGS FOR THIS PROG + MOVSI E,-4 ; FIELDS TO FILL + +RPARGL: GETYP 0,(AB) ; GET TYPE + CAIE 0,TCHSTR ; STRING? + JRST ARGCLB ; NO, JUST CLOBBER IT IN RAW + JUMPGE E,CPOPJ ; DON'T DO ANY MORE + PUSH TP,(AB) ; GET AN ARG + PUSH TP,1(AB) + +FPARS: PUSH TP,-1(TP) ; ANOTHER COPY + PUSH TP,-1(TP) + HLRZ 0,(P) + TRNN 0,4ARG + PUSHJ P,FLSSP ; NO LEADING SPACES + MOVEI A,0 ; WILL HOLD SIXBIT + MOVEI B,6 ; CHARS PER 6BIT WORD + MOVE C,[440600,,A] ; BYTE POINTER INTO A + +FPARSL: HRRZ 0,-1(TP) ; GET COUNT + JUMPE 0,PARSD ; DONE + SOS -1(TP) ; COUNT + ILDB 0,(TP) ; CHAR TO 0 + + CAIE 0," ; FILE NAME QUOTE? + JRST NOCNTQ + HRRZ 0,-1(TP) + JUMPE 0,PARSD + SOS -1(TP) + ILDB 0,(TP) ; USE THIS + JRST GOTCNQ + +NOCNTQ: HLL 0,(P) + TLNE 0,4ARG + JRST GOTCNQ + ANDI 0,177 + CAIG 0,40 ; SPACE? + JRST NDFLD ; YES, TERMINATE THIS FIELD + CAIN 0,": ; DEVICE ENDED? + JRST GOTDEV + CAIN 0,"; ; SNAME ENDED + JRST GOTSNM + +GOTCNQ: ANDI 0,177 + PUSHJ P,A0TO6 ; CONVERT TO 6BIT AND CHECK + + JUMPE B,FPARSL ; IGNORE IF AREADY HAVE 6 + IDPB 0,C + SOJA B,FPARSL + +; HERE IF SPACE ENCOUNTERED + +NDFLD: MOVEI D,(E) ; COPY GOODIE + PUSHJ P,FLSSP ; FLUSH REDUNDANT SPACES + JUMPE 0,PARSD ; NO CHARS LEFT + +NFL0: PUSH P,A ; SAVE SIXBIT WORD + SKIPGE -1(P) ; SKIP IF STRING TO BE STORED + JRST NFL1 + PUSH TP,$TAB ; PREVENT AB LOSSAGE + PUSH TP,AB + PUSHJ P,6TOCHS ; CONVERT TO STRING + MOVE AB,(TP) + SUB TP,[2,,2] +NFL1: HRRZ 0,-1(TP) ; RESTORE CHAR COUNT + +NFL2: MOVEI C,(D) ; COPY REL PNTR + SKIPGE -1(P) ; SKIP IF STRINGS TO BE STORED + JRST NFL3 + ASH D,1 ; TIMES 2 + ADDI D,T.NM1(TB) + MOVEM A,(D) ; STORE + MOVEM B,1(D) +NFL3: MOVSI A,N1SET ; FLAG IT + LSH A,(C) + IORM A,-1(P) ; AND CLOBBER + MOVE D,T.SPDL+1(TB) ; GET P BASE + POP P,@SIXTBL(C) ; AND STORE SIXBIT OF IT + + POP TP,-2(TP) ; MAKE NEW STRING POINTER + POP TP,-2(TP) + JUMPE 0,.+3 ; SKIP IF NO MORE CHARS + AOBJN E,FPARS ; MORE TO PARSE? +CPOPJ: POPJ P, ; RETURN, ALL DONE + + SUB TP,[2,,2] ; FLUSH OLD STRING + ADD E,[1,,1] + ADD AB,[2,,2] ; BUMP ARG + MOVEM AB,ABSAV(TB) + JUMPL AB,RPARGL ; AND GO ON +CPOPJ1: AOS A,(P) ; PREPARE TO WIN + HLRZS A + POPJ P, + + + +; HERE IF STRING HAS ENDED + +PARSD: PUSH P,A ; SAVE 6 BIT + MOVE A,-3(TP) ; CAN USE ARG STRING + MOVE B,-2(TP) + MOVEI D,(E) + JRST NFL2 ; AND CONTINUE + +; HERE IF JUST READ DEV + +GOTDEV: MOVEI D,2 ; CODE FOR DEVICE + JRST GOTFLD ; GOT A FIELD + +; HERE IF JUST READ SNAME + +GOTSNM: MOVEI D,3 +GOTFLD: PUSHJ P,FLSSP + SOJA E,NFL0 + + +; HERE FOR NON STRING ARG ENCOUNTERED + +ARGCLB: SKIPGE (P) ; IF NOT STORING, CONSIDER THIS THE END + + POPJ P, + MOVE C,T.SPDL+1(TB) ; GET P-BASE + MOVE A,S.DEV(C) ; GET DEVICE + CAME A,[SIXBIT /INT /]; IS IT THE INTERNAL DEVICE + JRST TRYNET ; NO, COUD BE NET + MOVE A,0 ; OFFNEDING TYPE TO A + PUSHJ P,APLQ ; IS IT APPLICABLE + JRST NAPT ; NO, LOSE + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] ; MUST BE LAST ARG + MOVEM AB,ABSAV(TB) + JUMPL AB,TMA + JRST CPOPJ1 ; ELSE SUCCESSFUL RETURN +TRYNET: CAIE 0,TFIX ; FOR NET DEV, ARGS MUST BE FIX + JRST WRONGT ; TREAT AS WRONG TYPE + MOVSI A,MSTNET ; BETTER BE NET EVENTUALLY + IORM A,(P) ; STORE FLAGS + MOVSI A,TFIX + MOVE B,1(AB) ; GET NUMBER + MOVEI 0,(E) ; MAKE SURE NOT DEVICE + CAIN 0,2 + JRST WRONGT + PUSH P,B ; SAVE NUMBER + MOVEI D,(E) ; SET FOR TABLE OFFSETS + MOVEI 0,0 + ADD TP,[4,,4] + JRST NFL2 ; GO CLOBBER IT AWAY +] + + +; ROUTINE TO FLUSH LEADING SPACES FROM A FIELD + +FLSSP: HRRZ 0,-1(TP) ; GET CHR COUNNT + JUMPE 0,CPOPJ ; FINISHED STRING +FLSS1: MOVE B,(TP) ; GET BYTR + ILDB C,B ; GETCHAR + CAIE C,^Q ; DONT FLUSH CNTL-Q + CAILE C,40 + JRST FLSS2 + MOVEM B,(TP) ; UPDATE BYTE POINTER + SOJN 0,FLSS1 + +FLSS2: HRRM 0,-1(TP) ; UPDATE STRING + POPJ P, + +IFN ITS,[ +;TABLE FOR STFUFFING SIXBITS AWAY + +SIXTBL: SETZ S.NM1(D) + SETZ S.NM2(D) + SETZ S.DEV(D) + SETZ S.SNM(D) + SETZ S.X1(D) +] + +RDTBL: SETZ RDEVIC(B) + SETZ RNAME1(B) + SETZ RNAME2(B) + SETZ RSNAME(B) + + + +IFE ITS,[ + +; TENEX VERSION OF FILE NAME PARSER (ONLY ACCEPT ARGS IN SINGLE STRING) + + +RGPRS: MOVEI 0,NOSTOR + +RGPARS: HRLM 0,(P) ; SAVE FOR STORE CHECKING + CAMGE AB,[-2,,] ; MULTI-STRING CASE POSSIBLE? + JRST TN.MLT ; YES, GO PROCESS +RGPRSS: GETYP 0,(AB) ; CHECK ARG TYPE + CAIE 0,TCHSTR + JRST WRONGT ; FOR NOW ONLY STRING ARGS WIN + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,FLSSP ; FLUSH LEADING SPACES + PUSHJ P,RGPRS1 + ADD AB,[2,,2] + MOVEM AB,ABSAV(TB) +CHKLST: JUMPGE AB,CPOPJ1 + SKIPGE (P) ; IF FROM OPEN, ALLOW ONE MORE + POPJ P, + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] + MOVEM AB,ABSAV(TB) + JUMPL AB,TMA +CPOPJ1: AOS (P) + POPJ P, + +RGPRS1: PUSH P,[0] ; ALLOW A DEVICE SPEC +TN.SNM: MOVE A,(TP) + HRRZ 0,-1(TP) + JUMPE 0,RPDONE + ILDB A,A + CAIE A,"< ; START "DIRECTORY" ? + JRST TN.N1 ; NO LOOK FOR NAME1 + SETOM (P) ; DEV NOT ALLOWED + IBP (TP) ; SKIP CHAR + SOS -1(TP) + PUSHJ P,TN.CNT ; COUNT CHARS TO ">" OR "." + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN3 + PUSH TP,0 + PUSH TP,C +TN.SN1: PUSHJ P,TN.CNT ; COUNT CHARS TO ">" + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN2 + MOVEM 0,-1(TP) + MOVEM C,(TP) + JRST TN.SN1 +TN.SN2: HRRZ B,-3(TP) + SUB B,0 + SUBI B,1 + SUB TP,[2,,2] +TN.SN3: CAIE A,"> ; SKIP IF WINS + JRST ILLNAM + PUSHJ P,TN.CPS ; COPY TO NEW STRING + HLLOS T.SPDL(TB) + MOVEM A,T.SNM(TB) + MOVEM B,T.SNM+1(TB) + +TN.N1: PUSHJ P,TN.CNT + JUMPE B,RPDONE + CAIE A,": ; GOT A DEVICE + JRST TN.N11 + SKIPE (P) + JRST ILLNAM + SETOM (P) + PUSHJ P,TN.CPS + MOVEM A,T.DEV(TB) + MOVEM B,T.DEV+1(TB) + JRST TN.SNM ; NOW LOOK FOR SNAME + +TN.N11: CAIE A,"> + CAIN A,"< + JRST ILLNAM + MOVEM A,(P) ; SAVE END CHAR + PUSHJ P,TN.CPS ; GEN STRING + MOVEM A,T.NM1(TB) + MOVEM B,T.NM1+1(TB) + +TN.N2: SKIPN A,(P) ; GET CHAR BACK + JRST RPDONE + CAIN A,"; ; START VERSION? + JRST .+3 + CAIE A,". ; START NAME2? + JRST ILLNAM ; I GIVE UP!!! + HRRZ B,-1(TP) ; GET RMAINS OF STRING + PUSHJ P,TN.CPS ; AND COPY IT + MOVEM A,T.NM2(TB) + MOVEM B,T.NM2+1(TB) +RPDONE: SUB P,[1,,1] ; FLUSH TEMP + SUB TP,[2,,2] +CPOPJ: POPJ P, + +TN.CNT: HRRZ 0,-1(TP) ; CHAR COUNT + MOVE C,(TP) ; BPTR + MOVEI B,0 ; INIT COUNT TO 0 + +TN.CN1: MOVEI A,0 ; IN CASE RUN OUT + SOJL 0,CPOPJ ; RUN OUT? + ILDB A,C ; TRY ONE + CAIE A," ; TNEX FILE QUOTE? + JRST TN.CN2 + SOJL 0,CPOPJ + IBP C ; SKIP QUOTED CHAT + ADDI B,2 + JRST TN.CN1 + +TN.CN2: CAIE A,"< + CAIN A,"> + POPJ P, + + CAIE A,". + CAIN A,"; + POPJ P, + CAIN A,": + POPJ P, + AOJA B,TN.CN1 + +TN.CPS: PUSH P,B ; # OF CHARS + MOVEI A,4(B) ; ADD 4 TO B IN A + IDIVI A,5 + PUSHJ P,IBLOCK ; GET BLOCK OF WORDS FOR STRING + + POP P,C ; CHAR COUNT BACK + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + HRRI A,(C) ; CHAR STRING + MOVE D,B ; COPY BYTER + + JUMPE C,CPOPJ + ILDB 0,(TP) ; GET CHAR + IDPB 0,D ; AND STROE + SOJG C,.-2 + + MOVNI C,(A) ; - LENGTH TO C + ADDB C,-1(TP) ; DECREMENT WORDS COUNT + TRNN C,-1 ; SKIP IF EMPTY + POPJ P, + IBP (TP) + SOS -1(TP) ; ELSE FLUSH TERMINATOR + POPJ P, + +ILLNAM: ERRUUO EQUOTE ILLEGAL-TENEX-FILE-NAME + +TN.MLT: MOVE A,AB ; AOBJN POINTER TO ARGS IN A + +TN.ML1: GETYP 0,(A) ; IS THIS ARG OF RIGHT TYPE + CAIE 0,TFIX + CAIN 0,TCHSTR + JRST .+2 + JRST RGPRSS ; ASSUME SINGLE STRING + ADD A,[2,,2] + JUMPL A,TN.ML1 ; TRY NEXT ARG IF ANY LEFT + + MOVEI 0,T.NM1(TB) ; 1ST WORD OF DESTINATION + HLRO A,AB ; MINUS NUMBER OF ARGS IN A + MOVN A,A ; NUMBER OF ARGS IN A + SUBI A,1 + CAMGE AB,[-10,,0] + MOVEI A,7 ; IF MORE THAN 10 ARGS, PUT 7 + ADD A,0 ; LAST WORD OF DESTINATION + HRLI 0,(AB) + BLT 0,(A) ; BLT 'EM IN + ADD AB,[10,,10] ; SKIP THESE GUYS + MOVEM AB,ABSAV(TB) + JRST CHKLST + +] + + +; ROUTINE TO OPEN A CHANNEL FOR ANY DEVICE. NAMES ARE ASSUMED TO ALREADY +; BE ON BOTH TP STACK AND P STACK + +OPNCH: MOVE C,T.SPDL+1(TB) ; GET PDL BASE + HRRZ A,S.DIR(C) + ANDI A,1 ; JUST WANT I AND O +IFE ITS,[ + HRLM A,S.DEV(C) +; .TRANS S.DEV(C) ; UNDO ANY TRANSLATIONS +; JRST TRLOST ; COMPLAIN +] +IFN ITS,[ + HRLM A,S.DIR(C) +] + +IFN ITS,[ + MOVE A,S.DEV(C) ; GET SIXBIT DEVICE CODE +] + +IFE ITS,[HRLZS A,S.DEV(C) +] + + MOVSI B,-NDEVS ; AOBJN COUNTER +DEVLP: SETO D, + MOVE 0,DEVSTB(B) ; GET ONE FROM TABLE + MOVE E,A +DEVLP1: AND E,D ; FLUSH POSSIBLE DIGITNESS + CAMN 0,E + JRST CHDIGS ; MAKE SURE REST IS DIGITS + LSH D,6 + JUMPN D,DEVLP1 ; KEEP TRUCKING UNTIL DONE + +; WASN'T THAT DEVICE, MOVE TO NEXT +NXTDEV: AOBJN B,DEVLP + JRST ODSK ; UNKNOWN DEVICE IS ASSUMED TO BE DISK + +IFN ITS,[ +OUSR: HRRZ A,S.DIR(C) ; BLOCK OR UNIT? + TRNE A,2 ; SKIP IF UNIT + JRST ODSK + PUSHJ P,OPEN1 ; OPEN IT + PUSHJ P,FIXREA ; AND READCHST IT + MOVE B,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVE 0,[PUSHJ P,DOIOT] ; GET AN IOINS + MOVEM 0,IOINS(B) + MOVE C,T.SPDL+1(TB) + HRRZ A,S.DIR(C) + TRNN A,1 + JRST EOFMAK + MOVEI 0,80. + MOVEM 0,LINLN(B) + JRST OPNWIN + +OSTY: HLRZ A,S.DIR(C) + IORI A,10 ; THE DONT LOSE BIT (DONT HANG ON INPUT DO ON OUTPUT) + HRLM A,S.DIR(C) + JRST OUSR +] + +; MAKE SURE DIGITS EXIST + +CHDIGS: SETCA D, + JUMPE D,DISPA ; NO DIGITS, WIN IMMEDIATE + MOVE E,A + AND E,D ; LEAVES ONLY DIGITS, IF WINNING + LSH E,6 + LSH D,6 + JUMPG D,.-2 ; KEEP GOING TIL DIGITS LEFT SHIFTED + JRST CHDIGN + +CHDIG1: CAIG D,'9 + CAIGE D,'0 + JRST NXTDEV ; NOT A DIGIT, LOSE + JUMPE E,DISPA ; IF THAT'S ALL THE CHARACTERS, WIN! +CHDIGN: SETZ D, + ROTC D,6 ; GET NEXT CHARACTER INTO D + JRST CHDIG1 ; GO TEST? + +; HERE TO DISPATCH IF SUCCESSFUL + +DISPA: JRST @DEVS(B) + + +IFN ITS,[ + +; DISK DEVICE OPNER COME HERE + +ODSK: MOVE A,S.SNM(C) ; GET SNAME + .SUSET [.SSNAM,,A] ; CLOBBER IT + PUSHJ P,OPEN0 ; DO REAL LIVE OPEN +] +IFE ITS,[ + +; TENEX DISK FILE OPENER + +ODSK: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + PUSHJ P,STSTK ; EXPAND STRING ONTO STACK (E POINTS TO OLD P) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; GET DIR NAME + MOVE C,(P) + MOVE D,T.SPDL+1(TB) + HRRZ D,S.DIR(D) + CAME C,[SIXBIT /PRINAO/] + CAMN C,[SIXBIT /PRINTO/] + IORI D,100 ; TURN ON BIT TO SAY USE OLD FILE + MOVSI A,101 ; START SETTING UP BITS EXTRA BIT FOR MSB + TRNE D,1 ; SKIP IF INPUT + TRNE D,100 ; WITE OVER? + TLOA A,100000 ; FORCE OLD VERSION + TLO A,600000 ; FORCE NEW VERSION + HRROI B,1(E) ; POINT TO STRING + GTJFN + TDZA 0,0 ; SAVE FACT OF NO SKIP + MOVEI 0,1 ; INDICATE SKIPPED + POP P,C ; RECOVER OPEN MODE SIXBIT + MOVE P,E ; RESTORE PSTACK + JUMPE 0,GTJLOS ; FIND OUT WHAT HAPPENED + + MOVE B,T.CHAN+1(TB) ; GET CHANNEL + HRRZ 0,-4(B) ; FUNNY MODE BITS + HRRZM A,CHANNO(B) ; SAVE IT + ANDI A,-1 ; READ Y TO DO OPEN + MOVSI B,440000 ; USE 36. BIT BYES + HRRI B,200000 ; ASSUME READ +; CAMN C,[SIXBIT /READB/] +; TRO B,2000 ; TURN ON THAWED IF READB + IOR B,0 + TRNE D,1 ; SKIP IF READ + HRRI B,300000 ; WRITE BIT + HRRZ 0,FSAV(TB) ; SEE IF REF DATE HACK + CAIN 0,NFOPEN + TRO B,400 ; SET DON'T MUNG REF DATE BIT + MOVE E,B ; SAVE BITS FOR REOPENS + OPENF + JRST OPFLOS + MOVE B,[2,,11] ; GET LENGTH & BYTE SIZE + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + GTFDB + LDB 0,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + CAIN 0,7 + JRST SIZASC + CAIN 0,36. + SIZEF ; USE OPENED SIZE + JFCL + IMULI B,5 ; TO BYTES +SIZASC: MOVEI 0,C.OPN+C.READ+C.DISK + TRNE D,1 ; SKIP FOR READ + MOVEI 0,C.OPN+C.PRIN+C.DISK + TRNE D,2 ; SKIP IF NOT BINARY FILE + TRO 0,C.BIN + HRL 0,B + MOVE B,T.CHAN+1(TB) + TRNE D,1 + HLRM 0,LSTCH-1(B) ; SAVE CURRENT LENGTH + MOVEM E,STATUS(B) + HRRM 0,-2(B) ; MUNG THOSE BITS + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + PUSHJ P,TMTNXS ; GET STRING FROM TENEX + MOVE B,CHANNO(B) ; JFN TO A + HRROI A,1(E) ; BASE OF STRING + MOVE C,[111111,,140001] ; WEIRD CONTROL BITS + JFNS ; GET STRING + MOVEI B,1(E) ; POINT TO START OF STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; MAKE INTO A STRING + SUB P,E ; BACK TO NORMAL + PUSH TP,A + PUSH TP,B + PUSHJ P,RGPRS1 ; PARSE INTO FIELDS + MOVE B,T.CHAN+1(TB) + MOVEI C,RNAME1-1(B) + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + JRST OPBASC +OPFLOS: MOVEI C,(A) ; SAVE ERROR CODE + MOVE B,T.CHAN+1(TB) + HRRZ A,CHANNO(B) ; JFN BACK TO A + RLJFN ; TRY TO RELEASE IT + JFCL + MOVEI A,(C) ; ERROR CODE BACK TO A + +GTJLOS: MOVE B,T.CHAN+1(TB) + PUSHJ P,TGFALS ; GET A FALSE WITH REASON + JRST OPNRET + +STSTK: PUSH TP,$TCHAN + PUSH TP,B + MOVEI A,4+5 ; COUNT CHARS NEEDED (NEED LAST 0 BYTE) + MOVE B,(TP) + ADD A,RDEVIC-1(B) + ADD A,RNAME1-1(B) + ADD A,RNAME2-1(B) + ADD A,RSNAME-1(B) + ANDI A,-1 ; TO 18 BITS + MOVEI 0,A(A) + IDIVI A,5 ; TO WORDS NEEDED + POP P,C ; SAVE RET ADDR + MOVE E,P ; SAVE POINTER + PUSH P,[0] ; ALOCATE SLOTS + SOJG A,.-1 + PUSH P,C ; RET ADDR BACK + INTGO ; IN CASE OVERFLEW + PUSH P,0 + MOVE B,(TP) ; IN CASE GC'D + MOVE D,[440700,,1(E)] ; BYTE POINTER TO IT + MOVEI A,RDEVIC-1(B) + PUSHJ P,MOVSTR ; FLUSH IT ON + HRRZ A,T.SPDL(TB) + JUMPN A,NLNMS ; USER GAVE NAME, USE IT (CAREFUL, RELIES ON + ; A BEING NON ZERO) + PUSH P,B + PUSH P,C + MOVEI A,0 ; HERE TO SEE IF THIS IS REALLY L.N. + HRROI B,1(E) + HRROI C,1(P) + LNMST ; LOOK UP LOGICAL NAME + MOVNI A,1 ; NOT A LOGICAL NAME + POP P,C + POP P,B +NLNMS: MOVEI 0,": + IDPB 0,D + JUMPE A,ST.NM1 ; LOGICAL NAME, FLUSH SNAME + HRRZ A,RSNAME-1(B) ; ANY SNAME AT ALL? + JUMPE A,ST.NM1 ; NOPE, CANT HACK WITH IT + MOVEI A,"< + IDPB A,D + MOVEI A,RSNAME-1(B) + PUSHJ P,MOVSTR ; SNAME UP + MOVEI A,"> + IDPB A,D +ST.NM1: MOVEI A,RNAME1-1(B) + PUSHJ P,MOVSTR + MOVEI A,". + IDPB A,D + MOVEI A,RNAME2-1(B) + PUSHJ P,MOVSTR + SUB TP,[2,,2] + POP P,A + POPJ P, + +MOVSTR: HRRZ 0,(A) ; CHAR COUNT + MOVE A,1(A) ; BYTE POINTER + SOJL 0,CPOPJ + ILDB C,A ; GET CHAR + IDPB C,D ; MUNG IT UP + JRST .-3 + +; MAKE A TENEX ERROR MESSAGE STRING + +TGFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; SAVE ERROR CODE + PUSHJ P,TMTNXS ; STRING ON STACK + HRROI A,1(E) ; POINT TO SPACE + MOVE B,(E) ; ERROR CODE + HRLI B,400000 ; FOR ME + MOVSI C,-100. ; MAX CHARS + ERSTR ; GET TENEX STRING + JRST TGFLS1 + JRST TGFLS1 + + MOVEI B,1(E) ; A AND B BOUND STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; BUILD STRING + SUB P,E ; P BACK TO NORMAL +TGFLS2: +IFE FNAMS, SUB P,[1,,1] ; FLUSH ERROR CODE SLOT +IFN FNAMS,[ + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST TGFLS3 + PUSHJ P,STSTK + MOVEI B,1(E) + SUBM P,E + MOVSI A,440700 + HRRI A,(P) + MOVEI C,5 + ILDB 0,A + JUMPE 0,.+2 + SOJG C,.-2 + + PUSHJ P,TNXSTR + PUSH TP,A + PUSH TP,B + SUB P,E +TGFLS3: POP P,A + PUSH TP,$TFIX + PUSH TP,A + MOVEI A,3 + SKIPN B + MOVEI A,2 +] +IFE FNAMS,[ + MOVEI A,1 +] + PUSHJ P,IILIST ; BUILD LIST + MOVSI A,TFALSE ; MAKE IT FALSE + SUB TP,[2,,2] + POPJ P, + +TGFLS1: MOVE P,E ; RESET STACK + MOVE A,$TCHSTR + MOVE B,CHQUOTE UNKNOWN PROBLEM IN I/O + JRST TGFLS2 + +] +; OTHER BUFFERED DEVICES JOIN HERE + +OPDSK1: +IFN ITS,[ + PUSHJ P,FIXREA ; STORE THE "REAL" NAMES INTO THE CHANNEL +] +OPBASC: MOVE C,T.SPDL+1(TB) ; C WAS CLOBBERED, GET IT BACK + HRRZ A,S.DIR(C) ; FIND OUT IF OPEN IS ASCII OR WORD + TRZN A,2 ; SKIP IF BINARY + PUSHJ P,OPASCI ; DO IT FOR ASCII + +; NOW SET UP IO INSTRUCTION FOR CHANNEL + +MAKION: MOVE B,T.CHAN+1(TB) + MOVEI C,GETCHR + JUMPE A,MAKIO1 ; JUMP IF INPUT + MOVEI C,PUTCHR ; ELSE GET INPUT + MOVEI 0,80. ; DEFAULT LINE LNTH + MOVEM 0,LINLN(B) + MOVSI 0,TFIX + MOVEM 0,LINLN-1(B) +MAKIO1: + HRLI C,(PUSHJ P,) + MOVEM C,IOINS(B) ; STORE IT + JUMPN A,OPNWIN ; GET AN EOF FORM FOR INPUT CHANNEL + +; HERE TO CONS UP + +EOFMAK: MOVSI C,TATOM + MOVE D,EQUOTE END-OF-FILE + PUSHJ P,INCONS + MOVEI E,(B) + MOVSI C,TATOM + MOVE D,IMQUOTE ERROR + PUSHJ P,ICONS + MOVE D,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVSI 0,TFORM + MOVEM 0,EOFCND-1(D) + MOVEM B,EOFCND(D) + +OPNWIN: MOVEI 0,10. ; SET UP RADIX + MOVSI A,TCHAN ; OPEN SUCCEEDED, RET CHANNEL + MOVE B,T.CHAN+1(TB) + MOVEM 0,RADX(B) + +OPNRET: MOVE D,T.CHAN+1(TB) ; IN CASE WE RECYCLE IT + MOVE C,(P) ; RET ADDR + SUB P,[S.X3+2,,S.X3+2] + SUB TP,[T.CHAN+2,,T.CHAN+2] + JRST (C) + + +; HERE TO CREATE CHARACTER BUFFERS FOR ASCII I/O + +OPASCI: PUSH P,A ; CONTAINS MODE, SAVE IT + MOVEI A,BUFLNT ; GET SIZE OF BUFFER + PUSHJ P,IBLOCK ; GET STORAGE + MOVSI 0,TWORD+.VECT. ; SET UTYPE + MOVEM 0,BUFLNT(B) ; AND STORE + MOVSI A,TCHSTR + SKIPE (P) ; SKIP IF INPUT + JRST OPASCO + MOVEI D,BUFLNT-1(B) ; REST BYTE POINTER +OPASCA: HRLI D,010700 + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEI 0,C.BUF + IORM 0,-2(B) ; TURN ON BUFFER BIT + MOVEM A,BUFSTR-1(B) + MOVEM D,BUFSTR(B) ; CLOBBER + POP P,A + POPJ P, + +OPASCO: HRROI C,777776 + MOVEM C,(B) ; -1 THE BUFFER (LEAVE OFF LOW BIT) + MOVSI C,(B) + HRRI C,1(B) ; BUILD BLT POINTER + BLT C,BUFLNT-1(B) ; ZAP + MOVEI D,-1(B) ; START MAKING STRING POINTER + HRRI A,BUFLNT*5 ; SET UP CHAR COUNT + JRST OPASCA + + +; OPEN NON FILE ORIENTED DEVICES (NUL, PTR, PTP ETC.) + +IFN ITS,[ +ONUL: +OPTP: +OPTR: PUSHJ P,OPEN0 ; SET UP MODE AND OPEN + SETZM S.NM1(C) ; CLOBBER UNINTERESTING FIELDS + SETZM S.NM2(C) + SETZM S.SNM(C) + JRST OPDSK1 + +; OPEN DEVICES THAT IGNORE SNAME + +OUTN: PUSHJ P,OPEN0 + SETZM S.SNM(C) + JRST OPDSK1 + +] + +; INTERNAL CHANNEL OPENER + +OINT: HRRZ A,S.DIR(C) ; CHECK DIR + CAIL A,2 ; READ/PRINT? + JRST WRONGD ; NO, LOSE + + MOVE 0,INTINS(A) ; GET INS + MOVE D,T.CHAN+1(TB) ; AND CHANNEL + MOVEM 0,IOINS(D) ; AND CLOBBER + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + HRRM 0,-2(D) + SETOM STATUS(D) ; MAKE SURE NOT AA TTY + PMOVEM T.XT(TB),INTFCN-1(D) + +; HERE TO SAVE PSEUDO CHANNELS + +SAVCHN: HRRZ E,CHNL0+1 ; POINT TO CURRENT LIST + MOVSI C,TCHAN + PUSHJ P,ICONS ; CONS IT ON + HRRZM B,CHNL0+1 + JRST OPNWIN + +; INT DEVICE I/O INS + +INTINS: PUSHJ P,GTINTC + PUSHJ P,PTINTC + + +; HERE TO OPEN THE NET DEVICE (I.E. THE ARPA NET) + +IFN ITS,[ +ONET: HRRZ A,S.DIR(C) ; DIRECTION CODE + CAILE A,1 ; ASCII ? + IORI A,4 ; TURN ON IMAGE BIT + SKIPGE S.NM1(C) ; NAME1 I.E. LOCAL HOST GIVEN + IORI A,10 ; NO, WE WILL LET ITS GIVE US ONE + SKIPGE S.NM2(C) ; NORMAL OR "LISTEN" + IORI A,20 ; TURN ON LISTEN BIT + MOVEI 0,7 ; DEFAULT BYTE SIZE + TRNE A,2 ; UNLESS + MOVEI 0,36. ; IMAGE WHICH IS 36 + SKIPN T.XT(TB) ; BYTE SIZE GIVEN? + MOVEM 0,S.X1(C) ; NO, STORE DEFAULT + SKIPG D,S.X1(C) ; BYTE SIZE REASONABLE? + JRST RBYTSZ ; NO <0, COMPLAIN + TRNE A,2 ; SKIP TO CHECK ASCII + JRST ONET2 ; CHECK IMAGE + CAIN D,7 ; 7-BIT WINS + JRST ONET1 + CAIE D,44 ; 36-BIT INDICATES BLOCK ASCII MODE + JRST .+3 + IORI A,2 ; SET BLOCK FLAG + JRST ONET1 + IORI A,40 ; USE 8-BIT MODE + CAIN D,10 ; IS IT RIGHT + JRST ONET1 ; YES +] + +RBYTSZ: ERRUUO EQUOTE BYTE-SIZE-BAD + +IFN ITS,[ +ONET2: CAILE D,36. ; IMAGE SIZE REASONABLE? + JRST RBYTSZ ; NO + CAIN D,36. ; NORMAL + JRST ONET1 ; YES, DONT SET FIELD + + ASH D,9. ; POSITION FOR FIELD + IORI A,40(D) ; SET IT AND ITS BIT + +ONET1: HRLM A,S.DIR(C) ; CLOBBER OPEN BLOCK + MOVE E,A ; SAVE BLOCK MODE INFO + PUSHJ P,OPEN1 ; DO THE OPEN + PUSH P,E + +; CLOBBER REAL SLOTS FOR THE OPEN + + MOVEI A,3 ; GET STATE VECTOR + PUSHJ P,IBLOCK + MOVSI A,TUVEC + MOVE D,T.CHAN+1(TB) + HLLM A,BUFRIN-1(D) + MOVEM B,BUFRIN(D) + MOVSI A,TFIX+.VECT. ; SET U TYPE + MOVEM A,3(B) + MOVE C,T.SPDL+1(TB) + MOVE B,T.CHAN+1(TB) + + PUSHJ P,INETST ; GET STATE + + POP P,A ; IS THIS BLOCK MODE + MOVEI 0,80. ; POSSIBLE LINE LENGTH + TRNE A,1 ; SKIP IF INPUT + MOVEM 0,LINLN(B) + TRNN A,2 ; BLOCK MODE? + JRST .+3 + TRNN A,4 ; ASCII MODE? + JRST OPBASC ; GO SETUP BLOCK ASCII + MOVE 0,[PUSHJ P,DOIOT] + MOVEM 0,IOINS(B) + + JRST OPNWIN + +; INTERNAL ROUTINE TO GET THE CURRENT STATE OF THE NETWROK CHANNEL + +INETST: MOVE A,S.NM1(C) + MOVEM A,RNAME1(B) + MOVE A,S.NM2(C) + MOVEM A,RNAME2(B) + LDB A,[1100,,S.SNM(C)] + MOVEM A,RSNAME(B) + + MOVE E,BUFRIN(B) ; GET STATE BLOCK +INTST1: HRRE 0,S.X1(C) + MOVEM 0,(E) + ADDI C,1 + AOBJN E,INTST1 + + POPJ P, + + +; ACCEPT A CONNECTION + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET ; CHECK THAT ARG IS AN OPEN NET CHANNEL + MOVE A,CHANNO(B) ; GET CHANNEL + LSH A,23. ; TO AC FIELD + IOR A,[.NETACC] + XCT A + JRST IFALSE ; RETURN FALSE +NETRET: MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +; FORCE SYSTEM NETWORK BUFFERS TO BE SENT + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 + CAMN A,MODES+3 + SKIPA A,CHANNO(B) ; GET CHANNEL + JRST WRONGD + LSH A,23. + IOR A,[.NETS] + XCT A + JRST NETRET + +; SUBR TO RETURN UPDATED NET STATE + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET ; IS IT A NET CHANNEL + PUSHJ P,INSTAT + JRST FINIS + +; INTERNAL NETSTATE ROUTINE + +INSTAT: MOVE C,P ; GET PDL BASE + MOVEI 0,S.X3 ; # OF SLOTS NEEDED + PUSH P,[0] + SOJN 0,.-1 +; RESTORED FROM MUDDLE 54. IT SEEMED TO WORK THERE, AND THE STUFF +; COMMENTED OUT HERE CERTAINLY DOESN'T. + MOVEI D,S.DEV(C) + HRL D,CHANNO(B) + .RCHST D, +; HRR D,CHANNO(B) ; SETUP FOR RFNAME CALL +; DOTCAL RFNAME,[D,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] +; .LOSE %LSFIL ; THIS MAY NOT BE DESIRABLE, BUT I ASSUME WE CARE IF + ; LOSSAGE + PUSHJ P,INETST ; INTO VECTOR + SUB P,[S.X3,,S.X3] + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + POPJ P, +] +; INTERNAL ROUTINE TO CHECK FOR CORRECT CHANNEL TYPE + +ARGNET: ENTRY 1 + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; OPEN? + JRST CHNCLS + MOVE A,RDEVIC-1(B) ; GET DEV NAME + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 + POP P,A + CAME A,[SIXBIT /NET /] + JRST NOTNET + MOVE B,1(AB) + MOVE A,DIRECT-1(B) ; CHECK FOR A READ SOCKET + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 + MOVE B,1(AB) ; RESTORE CHANNEL + POP P,A + POPJ P, + +IFE ITS,[ + +; TENEX NETWRK OPENING CODE + +ONET: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + MOVSI C,100700 + HRRI C,1(P) + MOVE E,P + PUSH P,[ASCII /NET:/] ; FOR STRINGS + GETYP 0,RNAME1-1(B) ; CHECK TYPE + CAIE 0,TFIX ; SKIP IF # SUPPLIED + JRST ONET1 + MOVE 0,RNAME1(B) ; GET IT + PUSHJ P,FIXSTK + JFCL + JRST ONET2 +ONET1: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME1-1(B) + MOVE B,RNAME1(B) + JUMPE 0,ONET2 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 +ONET2: MOVEI A,". + JSP D,ONETCH + MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIE 0,TFIX + JRST ONET3 + GETYP 0,RSNAME-1(B) + CAIE 0,TFIX + JRST WRONGT + MOVE 0,RSNAME(B) + CAIG 0,377 ;NEW STYLE 32 BIT HOST NUMBER? + JRST ONET2A +;CONVERT HOSTS2 HOST NUMBERS TO INTERNET (TOPS-20) HOST NUMBERS + MOVEI A,0 + LDB B,[001100,,0] ;HOST NUMBER: 1.1-1.9 -> + DPB B,[201000,,A] ; 2.8-3.6 + LDB B,[111100,,0] ;IMP LOW BITS: 2.1-2.9 -> + DPB B,[001000,,A] ; 1.1-1.8 + LDB B,[221100,,0] ;IMP HIGH BITS: 3.1-3.9 -> + DPB B,[101000,,A] ; 1.9-2.7 + LDB B,[331100,,0] ;NETWORK: 4.1-4.9 -> + DPB B,[301000,,A] ; 3.7-4.5 + MOVE 0,A +ONET2A: PUSHJ P,FIXSTK + JRST ONET4 + MOVE B,T.CHAN+1(TB) + MOVEI A,"- + JSP D,ONETCH + MOVE 0,RNAME2(B) + PUSHJ P,FIXSTK + JRST WRONGT + JRST ONET4 +ONET3: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME2-1(B) + MOVE B,RNAME2(B) + JUMPE 0,ONET4 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 + +ONET4: +ONET5: MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIN 0,TCHSTR + JRST ONET6 + MOVEI A,"; + JSP D,ONETCH + MOVEI A,"T + JSP D,ONETCH +ONET6: MOVSI A,1 + HRROI B,1(E) ; STRING POINTER + GTJFN ; GET THE G.D JFN + TDZA 0,0 ; REMEMBER FAILURE + MOVEI 0,1 + MOVE P,E ; RESTORE P + JUMPE 0,GTJLOS ; CONS UP ERROR STRING + + MOVE B,T.CHAN+1(TB) + HRRZM A,CHANNO(B) ; SAVE THE JFN + + MOVE C,T.SPDL+1(TB) + MOVE D,S.DIR(C) + MOVEI B,10 + TRNE D,2 + MOVEI B,36. + SKIPE T.XT(TB) + MOVE B,T.XT+1(TB) + JUMPL B,RBYTSZ + CAILE B,36. + JRST RBYTSZ + ROT B,-6 + TLO B,3400 + HRRI B,200000 + TRNE D,1 ; SKIP FOR INPUT + HRRI B,100000 + ANDI A,-1 ; ISOLATE JFCN + OPENF + JRST OPFLOS ; REPORT ERROR + MOVE B,T.CHAN+1(TB) + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) + CVSKT ; GET ABS SOCKET # + FATAL NETWORK BITES THE BAG! + MOVE D,B + MOVE B,T.CHAN+1(TB) + MOVEM D,RNAME1(B) + MOVSI 0,TFIX + MOVEM 0,RNAME1-1(B) + + MOVSI 0,TFIX + MOVEM 0,RNAME2-1(B) + MOVEM 0,RSNAME-1(B) + MOVE C,T.SPDL+1(TB) + MOVE C,S.DIR(C) + MOVE 0,[PUSHJ P,DONETO] + TRNN C,1 ; SKIP FOR OUTPUT + MOVE 0,[PUSHJ P,DONETI] + MOVEM 0,IOINS(B) + MOVEI 0,80. ; LINELENGTH + TRNE C,1 ; SKIP FOR INPUT + MOVEM 0,LINLN(B) + MOVEI A,3 ; GET STATE UVECTOR + PUSHJ P,IBLOCK + MOVSI 0,TFIX+.VECT. + MOVEM 0,3(B) + MOVE C,B + MOVE B,T.CHAN+1(TB) + MOVEM C,BUFRIN(B) + MOVSI 0,TUVEC + HLLM 0,BUFRIN-1(B) + MOVE B,CHANNO(B) ; GET JFN + MOVEI A,4 ; CODE FOR GTNCP + MOVEI C,1(P) + ADJSP P,4 ; ROOM FOR DATA + MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC + GTNCP + FATAL NET LOSSAGE ; GET STATE + MOVE B,(P) + MOVE D,-1(P) + MOVE C,-3(P) + ADJSP P,-4 + MOVE E,T.CHAN+1(TB) + MOVEM D,RNAME2(E) + MOVEM C,RSNAME(E) + MOVE C,BUFRIN(E) + MOVEM B,(C) ; INITIAL STATE STORED + MOVE B,E + JRST OPNWIN + +; DOIOT FOR TENEX NETWRK + +DONETO: PUSH P,0 + MOVE 0,[BOUT] + JRST .+3 + +DONETI: PUSH P,0 + MOVE 0,[BIN] + PUSH P,0 + PUSH TP,$TCHAN + PUSH TP,B + MOVEI 0,(A) ; POSSIBLE OUTPUT CHAR TO 0 + MOVE A,CHANNO(B) + MOVE B,0 + ENABLE + XCT (P) + DISABLE + MOVEI A,(B) ; RET CHAR IN A + MOVE B,(TP) + MOVE 0,-1(P) + SUB P,[2,,2] + SUB TP,[2,,2] + POPJ P, + +NETPRS: MOVEI D,0 + HRRZ 0,(C) + MOVE C,1(C) + +ONETL: ILDB A,C + CAIN A,"# + POPJ P, + SUBI A,60 + ASH D,3 + IORI D,(A) + SOJG 0,ONETL + AOS (P) + POPJ P, + +FIXSTK: CAMN 0,[-1] + POPJ P, + JFFO 0,FIXS3 ; PUT OCTAL DIGITS INTO STIRNG + MOVEI A,"0 + POP P,D + AOJA D,ONETCH +FIXS3: IDIVI A,3 + MOVEI B,12. + SUBI B,(A) + HRLM B,(P) + IMULI A,3 + LSH 0,(A) + POP P,B +FIXS2: MOVEI A,0 + ROTC 0,3 ; NEXT DIGIT + ADDI A,60 + JSP D,ONETCH + SUB B,[1,,0] + TLNN B,-1 + JRST 1(B) + JRST FIXS2 + +ONETCH: IDPB A,C + TLNE C,760000 ; SKIP IF NEW WORD + JRST (D) + PUSH P,[0] + JRST (D) + +INSTAT: MOVE E,B + MOVE B,CHANNO(B) ; GET JFN + MOVEI A,4 ; CODE FOR GTNCP + MOVEI C,1(P) + ADJSP P,4 ; ROOM FOR DATA + MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC + GTNCP + FATAL NET LOSSAGE ; GET STATE + MOVE B,(P) + MOVE D,-1(P) + MOVE C,-3(P) + ADJSP P,-4 + MOVEM D,RNAME2(E) ; UPDATE FOREIGN SOCHKET + MOVEM C,RSNAME(E) ; AND HOST + MOVE C,BUFRIN(E) + XCT ITSTRN(B) ; XLATE TO LOOK MORE LIKE ITS + MOVEM B,(C) ; STORE STATE + MOVE B,E + POPJ P, + +ITSTRN: MOVEI B,0 + JRST NLOSS + JRST NLOSS + MOVEI B,1 + MOVEI B,2 + JRST NLOSS + MOVEI B,4 + PUSHJ P,NOPND + MOVEI B,0 + JRST NLOSS + JRST NLOSS + PUSHJ P,NCLSD + MOVEI B,0 + JRST NLOSS + MOVEI B,0 + +NLOSS: FATAL ILLEGAL NETWORK STATE + +NOPND: MOVE B,DIRECT(E) ; SEE IF READ OR PRINT + ILDB B,B ; GET 1ST CHAR + CAIE B,"R ; SKIP FOR READ + JRST NOPNDW + SIBE ; SEE IF INPUT EXISTS + JRST .+3 + MOVEI B,5 + POPJ P, + MOVEM B,2(C) ; STORE BYTES IN STATE VECTOR + MOVEI B,11 ; RETURN DATA PRESENT STATE + POPJ P, + +NOPNDW: SOBE ; SEE IF OUTPUT PRESENT + JRST .+3 + MOVEI B,5 + POPJ P, + + MOVEI B,6 + POPJ P, + +NCLSD: MOVE B,DIRECT(E) + ILDB B,B + CAIE B,"R + JRST RET0 + SIBE + JRST .+2 + JRST RET0 + MOVEI B,10 + POPJ P, + +RET0: MOVEI B,0 + POPJ P, + + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET + PUSHJ P,INSTAT + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + JRST FINIS + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 ; PRINT OR PRINTB? + CAMN A,MODES+3 + SKIPA A,CHANNO(B) + JRST WRONGD + MOVEI B,21 + MTOPR +NETRET: MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET + MOVE A,CHANNO(B) + MOVEI B,20 + MTOPR + JRST NETRET + +] + +; HERE TO OPEN TELETYPE DEVICES + +OTTY: HRRZ A,S.DIR(C) ; GET DIR CODE + TRNE A,2 ; SKIP IF NOT READB/PRINTB + JRST WRONGD ; CANT DO THAT + +IFN ITS,[ + MOVE A,S.NM1(C) ; CHECK FOR A DIR + MOVE 0,S.NM2(C) + CAMN A,[SIXBIT /.FILE./] + CAME 0,[SIXBIT /(DIR)/] + SKIPA E,[-15.*2,,] + JRST OUTN ; DO IT THAT WAY + + HRRZ A,S.DIR(C) ; CHECK DIR + TRNE A,1 + JRST TTYLP2 + HRRI E,CHNL1 + PUSH P,S.DEV(C) ; SAVE THE SIXBIT DEV NAME + ; HRLZS (P) ; POSTITION DEVICE NAME + +TTYLP: SKIPN D,1(E) ; CHANNEL OPEN? + JRST TTYLP1 ; NO, GO TO NEXT + MOVE A,RDEVIC-1(D) ; GET DEV NAME + MOVE B,RDEVIC(D) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A ; GET RESULT + CAMN A,(P) ; SAME? + JRST SAMTYQ ; COULD BE THE SAME +TTYLP1: ADD E,[2,,2] + JUMPL E,TTYLP + SUB P,[1,,1] ; THIS ONE MUST BE UNIQUE +TTYLP2: MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; GET DIR OF OPEN + SKIPE A ; IF OUTPUT, + IORI A,20 ; THEN USE DISPLAY MODE + HRLM A,S.DIR(C) ; STORE IN OPEN BLOCK + PUSHJ P,OPEN2 ; OPEN THE TTY + MOVE A,S.DEV(C) ; GET DEVICE NAME + PUSHJ P,6TOCHS ; TO A STRING + MOVE D,T.CHAN+1(TB) ; POINT TO CHANNEL + MOVEM A,RDEVIC-1(D) + MOVEM B,RDEVIC(D) + MOVE C,T.SPDL+1(TB) ; RESTORE PDL BASE + MOVE B,D ; CHANNEL TO B + HRRZ 0,S.DIR(C) ; AND DIR + JUMPE 0,TTYSPC +TTY1: DOTCAL TTYGET,[CHANNO(B),[2000,,0],[2000,,A],[2000,,D]] + .LOSE %LSSYS + DOTCAL TTYSET,[CHANNO(B),MODE1,MODE2,D] + .LOSE %LSSYS + MOVE A,[PUSHJ P,GMTYO] + MOVEM A,IOINS(B) + DOTCAL RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]] + .LOSE %LSSYS + MOVEM D,LINLN(B) + MOVEM A,PAGLN(B) + JRST OPNWIN + +; MAKE AN IOT + +IOTMAK: HRLZ A,CHANNO(B) ; GET CHANNEL + ROT A,5 + IOR A,[.IOT A] ; BUILD IOT + MOVEM A,IOINS(B) ; AND STORE IT + POPJ P, + + +; HERE IF POSSIBLY OPENING AN ALREADY OPEN TTY + +SAMTYQ: MOVE D,1(E) ; RESTORE CURRENT CHANNEL + MOVE A,DIRECT-1(D) ; GET DIR + MOVE B,DIRECT(D) + PUSHJ P,STRTO6 + POP P,A ; GET SIXBIT + MOVE C,T.SPDL+1(TB) + HRRZ C,S.DIR(C) + CAME A,MODES(C) ; SKIP IF DIFFERENT DIRECTION + JRST TTYLP1 + +; HERE IF A RE-OPEN ON A TTY + + HRRZ 0,FSAV(TB) ; IS IT FROM A FOPEN + CAIN 0,FOPEN + JRST RETOLD ; RET OLD CHANNEL + + PUSH TP,$TCHAN + PUSH TP,1(E) ; PUSH OLD CHANNEL + PUSH TP,$TFIX + PUSH TP,T.CHAN+1(TB) + MOVE A,[PUSHJ P,CHNFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + SUB TP,[4,,4] + +RETOLD: MOVE B,1(E) ; GET CHANNEL + AOS CHANNO-1(B) ; AOS REF COUNT + MOVSI A,TCHAN + SUB P,[1,,1] ; CLEAN UP STACK + JRST OPNRET ; AND LEAVE + + +; ROUTINE TO PASS TO GCHACK TO FIX UP CHANNEL POINTER + +CHNFIX: CAIN C,TCHAN + CAME D,(TP) + POPJ P, + MOVE D,-2(TP) ; GET REPLACEMENT + SKIPE B + MOVEM D,1(B) ; CLOBBER IT AWAY + POPJ P, +] + +IFE ITS,[ + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ 0,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVE A,[PUSHJ P,INMTYO] + MOVE B,T.CHAN+1(TB) + MOVEM A,IOINS(B) + MOVEI A,100 ; PRIM INPUT JFN + JUMPN 0,TNXTY1 + MOVEI E,C.OPN+C.READ+C.TTY + HRRM E,-2(B) + MOVEM B,CHNL0+2*100+1 + JRST TNXTY2 +TNXTY1: MOVEM B,CHNL0+2*101+1 + MOVEI A,101 ; PRIM OUTPUT JFN + MOVEI E,C.OPN+C.PRIN+C.TTY + HRRM E,-2(B) +TNXTY2: MOVEM A,CHANNO(B) + JUMPN 0,OPNWIN +] +; SETUP FUNNY BUFFER FOR TTY INPUT DEVICES + +TTYSPC: MOVEI A,EXTBFR ; GET EXTRA BUFFER + PUSHJ P,IBLOCK ; GET BLOCK + MOVE D,T.CHAN+1(TB) ;RESTORE CHANNEL POINTER +IFN ITS,[ + MOVE A,CHANNO(D) + LSH A,23. + IOR A,[.IOT A] + MOVEM A,IOIN2(B) +] +IFE ITS,[ + MOVE A,[PBIN] + MOVEM A,IOIN2(B) +] + MOVSI A,TLIST + MOVEM A,EXBUFR-1(D) ; FOR WAITING TTY BUFFERS + SETZM EXBUFR(D) ; NIL LIST + MOVEM B,BUFRIN(D) ;STORE IN CHANNEL + MOVSI A,TUVEC ;MAKE SURE TYPE IS UNIFORM VECTOR + HLLM A,BUFRIN-1(D) + MOVEI A,177 ;SET ERASER TO RUBOUT + MOVEM A,ERASCH(B) +IFE ITS,[ + MOVEI A,25 + MOVEM A,KILLCH(B) +] +IFN ITS,[ + SETZM KILLCH(B) ;NO KILL CHARACTER NEEDED +] + MOVEI A,33 ;BREAKCHR TO C.R. + MOVEM A,BRKCH(B) + MOVEI A,"\ ;ESCAPER TO \ + MOVEM A,ESCAP(B) + MOVE A,[010700,,BYTPTR(E)] ;RELATIVE BYTE POINTER + MOVEM A,BYTPTR(B) + MOVEI A,14 ;BARF BACK CHARACTER FF + MOVEM A,BRFCHR(B) + MOVEI A,^D + MOVEM A,BRFCH2(B) + +; SETUP DEFAULT TTY INTERRUPT HANDLER + + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TFIX + PUSH TP,[10] ; PRIORITY OF CHAR INT + PUSH TP,$TCHAN + PUSH TP,D + MCALL 3,EVENT ; 1ST MAKE AN EVENT EXIST + PUSH TP,A + PUSH TP,B + PUSH TP,$TSUBR + PUSH TP,[QUITTER] ; DEFAULT HANDLER IS QUITTER + MCALL 2,HANDLER + +; BUILD A NULL STRING + + MOVEI A,0 + PUSHJ P,IBLOCK ; USE A BLOCK + MOVE D,T.CHAN+1(TB) + MOVEI 0,C.BUF + IORM 0,-2(D) + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + MOVEM A,BUFSTR-1(D) + MOVEM B,BUFSTR(D) + MOVEI A,0 + MOVE B,D ; CHANNEL TO B + JRST MAKION + + +; ROUTINE TO OPEN ITS CHANNEL WITHOUT .RCHST + +IFN ITS,[ +OPEN2: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN ; OPEN THE FILE + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; SAVE THE CHANNEL + JRST OPEN3 + +; FIX UP MODE AND FALL INTO OPEN + +OPEN0: HRRZ A,S.DIR(C) ; GET DIR + TRNE A,2 ; SKIP IF NOT BLOCK + IORI A,4 ; TURN ON IMAGE + IORI A,2 ; AND BLOCK + + PUSH P,A + PUSH TP,$TPDL + PUSH TP,C ; SAVE CRUFT TO CHECK FOR PRINTO, HA HA + MOVE B,T.CHAN+1(TB) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) ; THIS KLUDGE THE MESS OF NDR + PUSHJ P,STRTO6 + MOVE C,(TP) + POP P,D ; THE SIXBIT FOR KLUDGE + POP P,A ; GET BACK THE RANDOM BITS + SUB TP,[2,,2] + CAME D,[SIXBIT /PRINAO/] + CAMN D,[SIXBIT /PRINTO/] + IORI A,100000 ; WRITEOVER BIT + HRRZ 0,FSAV(TB) + CAIN 0,NFOPEN + IORI A,10 ; DON'T CHANGE REF DATE +OPEN9: HRLM A,S.DIR(C) ; AND STORE IT + +; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL + +OPEN1: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; CLOBBER INTO CHANNEL + DOTCAL RFNAME,[A,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] + JFCL + +; NOW CLOBBER THE TVP SLOT FOR THIS CHANNEL + +OPEN3: MOVE A,S.DIR(C) + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) ; GET CHANNEL # + ASH A,1 + ADDI A,CHNL0 ; POINT TO SLOT + MOVEM B,1(A) ; NOT: TYPE ALREADY SETUP + +; NOW GET STATUS WORD + +DOSTAT: HRRZ A,CHANNO(B) ; NOW GET STATUS WORD + DOTCAL STATUS,[A,[2002,,STATUS]] + JFCL + POPJ P, + + +; HERE IF OPEN FAILS (CHANNEL IS IN A) + +OPNLOS: JUMPL A,NOCHAN ; ALL CHANNELS ARE IN USE + LSH A,23. ; DO A .STATUS + IOR A,[.STATUS A] + XCT A ; STATUS TO A + MOVE B,T.CHAN+1(TB) + PUSHJ P,GFALS ; GET A FALSE WITH A MESSAGE + SUB P,[1,,1] ; EXTRA RET ADDR FLUSHED + JRST OPNRET ; AND RETURN +] + +CGFALS: SUBM M,(P) + MOVEI B,0 +IFN ITS, PUSHJ P,GFALS +IFE ITS, PUSHJ P,TGFALS + JRST MPOPJ + +; ROUTINE TO CONS UP FALSE WITH REASON +IFN ITS,[ +GFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,[SIXBIT / ERR/] ; SET UP OPEN TO ERR DEV + PUSH P,[3] ; SAY ITS FOR CHANNEL + PUSH P,A + .OPEN 0,-2(P) ; USE CHANNEL 0 FOR THIS + FATAL CAN'T OPEN ERROR DEVICE + SUB P,[3,,3] ; DONT WANT OPEN BLOCK NOW +IFN FNAMS, PUSH P,A + MOVEI A,0 ; PREPARE TO BUILD STRING ON STACK +EL1: PUSH P,[0] ; WHERE IT WILL GO + MOVSI B,(<440700,,(P)>) ; BYTE POINTER TO TOP OF STACK +EL2: .IOT 0,0 ; GET A CHAR + JUMPL 0,EL3 ; JUMP ON -1,,3 + CAIN 0,3 ; EOF? + JRST EL3 ; YES, MAKE STRING + CAIN 0,14 ; IGNORE FORM FEEDS + JRST EL2 ; IGNORE FF + CAIE 0,15 ; IGNORE CR & LF + CAIN 0,12 + JRST EL2 + IDPB 0,B ; STUFF IT + TLNE B,760000 ; SIP IF WORD FULL + AOJA A,EL2 + AOJA A,EL1 ; COUNT WORD AND GO + +EL3: +IFN FNAMS,[ + SKIPN (P) + SUB P,[1,,1] + PUSH P,A + .CLOSE 0, + PUSHJ P,CHMAK + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST EL4 + MOVEI A,0 + MOVSI B,(<440700,,(P)>) + PUSH P,[0] + IRP XX,,[RDEVIC,RSNAME,RNAME1,RNAME2]YY,,[0,72,73,40] +IFSN YY,0,[ + MOVEI 0,YY + JSP E,1PUSH +] + MOVE E,-2(TP) + MOVE C,XX(E) + HRRZ D,XX-1(E) + JSP E,PUSHIT + TERMIN +] + SKIPN (P) ; ANY CHARS AT END? + SUB P,[1,,1] ; FLUSH XTRA + PUSH P,A ; PUT UP COUNT + .CLOSE 0, ; CLOSE THE ERR DEVICE + PUSHJ P,CHMAK ; MAKE STRING + PUSH TP,A + PUSH TP,B +IFN FNAMS,[ +EL4: POP P,A + PUSH TP,$TFIX + PUSH TP,A] +IFE FNAMS, MOVEI A,1 +IFN FNAMS,[ + MOVEI A,3 + SKIPN B + MOVEI A,2 +] + PUSHJ P,IILIST + MOVSI A,TFALSE ; MAKEIT A FALSE +IFN FNAMS, SUB TP,[2,,2] + POPJ P, + +IFN FNAMS,[ +1PUSH: MOVEI D,0 + JRST PUSHI2 +PUSHI1: PUSH P,[0] + MOVSI B,(<440700,,(P)>) +PUSHIT: SOJL D,(E) + ILDB 0,C +PUSHI2: IDPB 0,B + TLNE B,760000 + AOJA A,PUSHIT + AOJA A,PUSHI1 +] +] + + +; ROUTINE TO FILL IN THE "REAL" SLOTS FOR THE CHANNEL + +FIXREA: +IFE ITS, HRLZS S.DEV(C) ; KILL MODE BITS + MOVE D,[-4,,S.DEV] + +FIXRE1: MOVEI A,(D) ; COPY REL POINTER + ADD A,T.SPDL+1(TB) ; POINT TO SLOT + SKIPN A,(A) ; SKIP IF GOODIE THERE + JRST FIXRE2 + PUSHJ P,6TOCHS ; MAKE INOT A STRING + MOVE C,RDTBL-S.DEV(D); GET OFFSET + ADD C,T.CHAN+1(TB) + MOVEM A,-1(C) + MOVEM B,(C) +FIXRE2: AOBJN D,FIXRE1 + POPJ P, + +IFN ITS,[ +DOOPN: HRLZ A,A + HRR A,CHANNO(B) ; GET CHANNEL + DOTCAL OPEN,[A,-3(P),-2(P),-1(P),(P)] + SKIPA + AOS -1(P) + POPJ P, +] + +;THIS ROUTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES +STRTO6: PUSH TP,A + PUSH TP,B + PUSH P,E ;SAVE USEFUL FROB + MOVEI E,(A) ; CHAR COUNT TO E + GETYP A,A + CAIE A,TCHSTR ; IS IT ONE WORD? + JRST WRONGT ;NO + CAILE E,6 ; SKIP IF L=? 6 CHARS + MOVEI E,6 +CHREAD: MOVEI A,0 ;INITIALIZE OUTPUT WORD + MOVE D,[440600,,A] ;AND BYTE POINTER TO IT +NEXCHR: SOJL E,SIXDON + ILDB 0,B ; GET NEXT CHAR + CAIN 0,^Q ; CNTL-Q, QUOTES NEXT CHAR + JRST NEXCHR + JUMPE 0,SIXDON ;IF NULL, WE ARE FINISHED + PUSHJ P,A0TO6 ; CONVERT TO SIXBIT + IDPB 0,D ;DEPOSIT INTO SIX BIT + JRST NEXCHR ; NO, GET NEXT +SIXDON: SUB TP,[2,,2] ;FIX UP TP + POP P,E + EXCH A,(P) ;LEAVE RESULT ON P-STACK + JRST (A) ;NOW RETURN + + +;SUBROUTINE TO CONVERT SIXBIT TO ATOM + +6TOCHS: PUSH P,E + PUSH P,D + MOVEI B,0 ;MAX NUMBER OF CHARACTERS + PUSH P,[0] ;STRING WILL GO ON P SATCK + JUMPE A,GETATM ; EMPTY, LEAVE + MOVEI E,-1(P) ;WILL BE BYTE POINTER + HRLI E,10700 ;SET IT UP + PUSH P,[0] ;SECOND POSSIBLE WORD + MOVE D,[440600,,A] ;INPUT BYTE POINTER +6LOOP: ILDB 0,D ;START CHAR GOBBLING + ADDI 0,40 ;CHANGET TOASCII + IDPB 0,E ;AND STORE IT + TLNN D,770000 ; SKIP IF NOT DONE + JRST 6LOOP1 + TDNN A,MSKS(B) ; CHECK IF JUST SPACES LEFT + AOJA B,GETATM ; YES, DONE + AOJA B,6LOOP ;KEEP LOOKING +6LOOP1: PUSH P,[6] ;IF ARRIVE HERE, STRING IS 2 WORDS + JRST .+2 +GETATM: MOVEM B,(P) ;SET STRING LENGTH=1 + PUSHJ P,CHMAK ;MAKE A MUDDLE STRING + POP P,D + POP P,E + POPJ P, + +MSKS: 7777,,-1 + 77,,-1 + ,,-1 + 7777 + 77 + + +; CONVERT ONE CHAR + +A0TO6: CAIL 0,141 ;IF IT IS GREATER OR EQUAL TO LOWER A + CAILE 0,172 ;BUT LESS THAN OR EQUAL TO LOWER Z + JRST .+2 ;THEN + SUBI 0,40 ;CONVERT TO UPPER CASE + SUBI 0,40 ;NOW TO SIX BIT + JUMPL 0,BAD6 ;CHECK FOR A WINNER + CAILE 0,77 + JRST BAD6 + POPJ P, + +; SUBR TO TEST THE EXISTENCE OF FILES + +MFUNCTION FEXIST,SUBR,[FILE-EXISTS?] + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + ADD TP,[2,,2] + MOVSI E,-4 ; 4 THINGS TO PUSH +EXIST: +IFN ITS, MOVE B,@RNMTBL(E) +IFE ITS, MOVE B,@FETBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST EXIST1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ +; PUSH P,E +; PUSHJ P,ADDNUL ; NOT NEEDED, SINCE CONSED INTO ONE STRING-TAA +; POP P,E + PUSH TP,A ; DEFAULT TYPE AND VALUE GIVEN BY USER + PUSH TP,B ; IN VALUE OF DEV, SNM, NM1, NM2 + ] +IFN ITS, JRST .+2 +IFE ITS, JRST .+3 + +EXIST1: +IFN ITS, PUSH P,EXISTS(E) ; USE DEFAULT +IFE ITS,[ + PUSH TP,FETYP(E) ; DEFAULT TYPE AND VALUE IF NO + PUSH TP,FEVAL(E) ; DEFAULT GIVEN BY USER + ] + AOBJN E,EXIST + + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST TMA ; TOO MANY ARGUMENTS + +IFN ITS,[ + MOVE 0,-3(P) ; GET SIXBIT DEV NAME + MOVEI B,0 + CAMN 0,[SIXBITS /DSK /] + MOVSI B,10 ; DONT SET REF DATE IF DISK DEV + .IOPUSH + DOTCAL OPEN,[B,[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST .+3 + .IOPOP + JRST FDLWON ; WON!!! + .STATUS 0,A ; FIND THE STATUS OF CHANNEL BEFORE POPING + .IOPOP + JRST FDLST1] + +IFE ITS,[ + MOVE B,TB + SUBI B,10 ; GET B TO POINT CORRECTLY TO ARGS + PUSHJ P,STSTK ; GET FILE NAME IN A STRING + HRROI B,1(E) ; POINT B TO THE STRING + MOVSI A,100001 + GTJFN + JRST TDLLOS ; FILE DOES NOT EXIST + RLJFN ; FILE EXIST SO RETURN JFN + JFCL + JRST FDLWON ; SUCCESS + ] + +IFN ITS,[ +EXISTS: SIXBITS /DSK INPUT > / + ] +IFE ITS,[ +FETBL: SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + +FETYP: TCHSTR,,5 + TCHSTR,,3 + TCHSTR,,3 + TCHSTR,,0 + +FEVAL: 440700,,[ASCIZ /INPUT/] + 440700,,[ASCIZ /MUD/] + 440700,,[ASCIZ /DSK/] + 0 + ] + +; SUBR TO DELETE AND RENAME FILES + +MFUNCTION RENAME,SUBR + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + GETYP 0,(AB) ; GET 1ST ARG TYPE +IFN ITS,[ + CAIN 0,TCHAN ; CHANNEL? + JRST CHNRNM ; MUST BE RENAME WHILE OPEN FOR WRITING +] +IFE ITS,[ + PUSH P,[100000,,-2] + PUSH P,[377777,,377777] +] + MOVSI E,-4 ; 4 THINGS TO PUSH +RNMALP: MOVE B,@RNMTBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST RNMLP1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ + PUSH P,E + PUSHJ P,ADDNUL + EXCH B,(P) + MOVE E,B +] + JRST .+2 + +RNMLP1: PUSH P,RNSTBL(E) ; USE DEFAULT + AOBJN E,RNMALP + +IFN ITS,[ + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST RNM1 ; COULD BE A RENAME + +; HERE TO DELETE A FILE + +DELFIL: MOVE A,(P) ; AND GET SNAME + .SUSET [.SSNAM,,A] + DOTCAL DELETE,[[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST FDLST ; ANALYSE ERROR + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS +] +IFE ITS,[ + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; GET BASE OF PDL + MOVEI A,1(A) ; POINT TO CRAP + CAMGE AB,[-3,,] ; SKIP IF DELETE + HLLZS (A) ; RESET DEFAULT + PUSH P,[0] + PUSH P,[0] + PUSH P,[0] + GTJFN ; GET A JFN + JRST TDLLOS ; LOST + ADD AB,[2,,2] ; PAST ARG + MOVEM AB,ABSAV(TB) + JUMPL AB,RNM1 ; GO TRY FOR RENAME + MOVE P,(TP) ; RESTORE P STACK + MOVEI C,(A) ; FOR RELEASE + DELF ; ATTEMPT DELETE + JRST DELLOS ; LOSER + RLJFN ; MAKE SURE FLUSHED + JFCL + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +RNMLOS: PUSH P,A + MOVEI A,(B) + RLJFN + JFCL +DELLO1: MOVEI A,(C) + RLJFN + JFCL + POP P,A ; ERR NUMBER BACK +TDLLOS: MOVEI B,0 + PUSHJ P,TGFALS ; GET FALSE WITH REASON + JRST FINIS + +DELLOS: PUSH P,A ; SAVE ERROR + JRST DELLO1 +] + +;TABLE OF REANMAE DEFAULTS +IFN ITS,[ +RNMTBL: IMQUOTE DEV + IMQUOTE NM1 + IMQUOTE NM2 + IMQUOTE SNM + +RNSTBL: SIXBIT /DSK _MUDS_> / +] +IFE ITS,[ +RNMTBL: SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + +RNSTBL: -1,,[ASCIZ /DSK/] + 0 + -1,,[ASCIZ /_MUDS_/] + -1,,[ASCIZ /MUD/] +] +; HERE TO DO A RENAME + +RNM1: JUMPGE AB,TMA ; IF ARGS EXHAUSTED, MUST BE TOO MUCH STRING + GETYP 0,(AB) + MOVE C,1(AB) ; GET ARG + CAIN 0,TATOM ; IS IT "TO" + CAME C,IMQUOTE TO + JRST WRONGT ; NO, LOSE + ADD AB,[2,,2] ; BUMP PAST "TO" + MOVEM AB,ABSAV(TB) + JUMPGE AB,TFA +IFN ITS,[ + MOVEM P,T.SPDL+1(TB) ; SAVE NEW P-BASE + + MOVEI 0,4 ; FOUR DEFAULTS + PUSH P,-3(P) ; DEFAULT DEVICE IS CURRENT + SOJN 0,.-1 + + PUSHJ P,RGPRS ; PARSE THE NEXT STRING + JRST TMA + + MOVE A,-7(P) ; FIX AND GET DEV1 + MOVE B,-3(P) ; SAME FOR DEV2 + CAME A,B ; SAME? + JRST DEVDIF + + POP P,A ; GET SNAME 2 + CAME A,(P)-3 ; SNAME 1 + JRST DEVDIF + .SUSET [.SSNAM,,A] + POP P,-2(P) ; MOVE NAMES DOWN + POP P,-2(P) + DOTCAL RENAME,[[17,,-4],[17,,-3],[17,,-2],A,[17,,-1],(P)] + JRST FDLST + JRST FDLWON + +; HERE FOR RENAME WHILE OPEN FOR WRITING + +CHNRNM: ADD AB,[2,,2] ; NEXT ARG + MOVEM AB,ABSAV(TB) + JUMPGE AB,TFA + MOVE B,-1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; SKIP IF OPEN + JRST BADCHN + MOVE A,DIRECT-1(B) ; CHECK DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A + CAME A,[SIXBIT /PRINT/] + CAMN A,[SIXBIT /PRINTB/] + JRST CHNRN1 + CAMN A,[SIXBIT /PRINAO/] + JRST CHNRM1 + CAME A,[SIXBIT /PRINTO/] + JRST WRONGD + +; SET UP .FDELE BLOCK + +CHNRN1: PUSH P,[0] + PUSH P,[0] + MOVEM P,T.SPDL+1(TB) + PUSH P,[0] + PUSH P,[SIXBIT /_MUDL_/] + PUSH P,[SIXBIT />/] + PUSH P,[0] + + PUSHJ P,RGPRS ; PARSE THESE + JRST TMA + + SUB P,[1,,1] ; SNAME/DEV IGNORED + MOVE AB,ABSAV(TB) ; GET ORIG ARG POINTER + MOVE B,1(AB) + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RENMWO,[A,[17,,-1],(P)] + JRST FDLST + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RFNAME,[A,[2017,,-4],[2017,,-3],[2017,,-2],[2017,,-1]] + JFCL + MOVE A,-3(P) ; UPDATE CHANNEL + PUSHJ P,6TOCHS ; GET A STRING + MOVE C,1(AB) + MOVEM A,RNAME1-1(C) + MOVEM B,RNAME1(C) + MOVE A,-2(P) + PUSHJ P,6TOCHS + MOVE C,1(AB) + MOVEM A,RNAME2-1(C) + MOVEM B,RNAME2(C) + MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS +] +IFE ITS,[ + PUSH P,A + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; PBASE BACK + PUSH A,[400000,,0] + MOVEI A,(A) + GTJFN + JRST TDLLOS + POP P,B + EXCH A,B + MOVEI C,(A) ; FOR RELEASE ATTEMPT + RNAMF + JRST RNMLOS + MOVEI A,(B) + RLJFN ; FLUSH JFN + JFCL + MOVEI A,(C) ; MAKE SURR OTHER IS FLUSHED + RLJFN + JFCL + JRST FDLWON + + +ADDNUL: PUSH TP,A + PUSH TP,B + MOVEI A,(A) ; LNTH OF STRING + IDIVI A,5 + JUMPN B,NONUAD ; DONT NEED TO ADD ONE + + PUSH TP,$TCHRS + PUSH TP,[0] + MOVEI A,2 + PUSHJ P,CISTNG ; COPY OF STRING + POPJ P, + +NONUAD: POP TP,B + POP TP,A + POPJ P, +] +; HERE FOR LOSING .FDELE + +IFN ITS,[ +FDLST: .STATUS 0,A ; GET STATUS +FDLST1: MOVEI B,0 + PUSHJ P,GFALS ; ANALYZE IT + JRST FINIS +] + +; SOME .FDELE ERRORS + +DEVDIF: ERRUUO EQUOTE DEVICE-OR-SNAME-DIFFERS + + ; HERE TO RESET A READ CHANNEL + +MFUNCTION FRESET,SUBR,RESET + + ENTRY 1 + GETYP A,(AB) + CAIE A,TCHAN + JRST WTYP1 + MOVE B,1(AB) ;GET CHANNEL + SKIPN IOINS(B) ; OPEN? + JRST REOPE1 ; NO, IGNORE CHECKS +IFN ITS,[ + MOVE A,STATUS(B) ;GET STATUS + ANDI A,77 + JUMPE A,REOPE1 ;IF IT CLOSED, JUST REOPEN IT, MAYBE? + CAILE A,2 ;SKIPS IF TTY FLAVOR + JRST REOPEN +] +IFE ITS,[ + MOVE A,CHANNO(B) + CAIE A,100 ; TTY-IN + CAIN A,101 ; TTY-OUT + JRST .+2 + JRST REOPEN +] + CAME B,TTICHN+1 + CAMN B,TTOCHN+1 + JRST REATTY +REATT1: MOVEI B,DIRECT-1(B) ;POINT TO DIRECTION + PUSHJ P,CHRWRD ;CONVERT TO A WORD + JFCL + CAME B,[ASCII /READ/] + JRST TTYOPN + MOVE B,1(AB) ;RESTORE CHANNEL + PUSHJ P,RRESET" ;DO REAL RESET + JRST TTYOPN + +REOPEN: PUSH TP,(AB) ;FIRST CLOSE IT + PUSH TP,(AB)+1 + MCALL 1,FCLOSE + MOVE B,1(AB) ;RESTORE CHANNEL + +; SET UP TEMPS FOR OPNCH + +REOPE1: PUSH P,[0] ; WILL HOLD DIR CODE + PUSH TP,$TPDL + PUSH TP,P + IRP A,,[DIRECT,RNAME1,RNAME2,RDEVIC,RSNAME,ACCESS] + PUSH TP,A-1(B) + PUSH TP,A(B) + TERMIN + + PUSH TP,$TCHAN + PUSH TP,1(AB) + + MOVE A,T.DIR(TB) + MOVE B,T.DIR+1(TB) ; GET DIRECTION + PUSHJ P,CHMOD ; CHECK THE MODE + MOVEM A,(P) ; AND STORE IT + +; NOW SET UP OPEN BLOCK IN SIXBIT + +IFN ITS,[ + MOVSI E,-4 ; AOBN PNTR +FRESE2: MOVE B,T.CHAN+1(TB) + MOVEI A,@RDTBL(E) ; GET ITEM POINTER + GETYP 0,-1(A) ; GET ITS TYPE + CAIE 0,TCHSTR + JRST FRESE1 + MOVE B,(A) ; GET STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 +FRESE3: AOBJN E,FRESE2 +] +IFE ITS,[ + MOVE B,T.CHAN+1(TB) + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; RESULT ON STACK + HLRZS (P) +] + + PUSH P,[0] ; PUSH UP SOME DUMMIES + PUSH P,[0] + PUSH P,[0] + PUSHJ P,OPNCH ; ATTEMPT TO DO THEOPEN + GETYP 0,A + CAIE 0,TCHAN + JRST FINIS ; LEAVE IF FALSE OR WHATEVER + +DRESET: MOVE A,(AB) + MOVE B,1(AB) + SETZM CHRPOS(B) ;INITIALIZE THESE PARAMETERS + SETZM LINPOS(B) + SETZM ACCESS(B) + JRST FINIS + +TTYOPN: +IFN ITS,[ + MOVE B,1(AB) + CAME B,TTOCHN+1 + CAMN B,TTICHN+1 + PUSHJ P,TTYOP2 + PUSHJ P,DOSTAT + DOTCAL RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]] + .LOSE %LSSYS + MOVEM C,PAGLN(B) + MOVEM D,LINLN(B) +] + JRST DRESET + +IFN ITS,[ +FRESE1: CAIE 0,TFIX + JRST BADCHN + PUSH P,(A) + JRST FRESE3 +] + +; INTERFACE TO REOPEN CLOSED CHANNELS + +OPNCHN: PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FRESET + POPJ P, + +REATTY: PUSHJ P,TTYOP2 +IFE ITS, SKIPN DEMFLG ; SKIP IF DEMONFLAG IS ON + SKIPE NOTTY + JRST DRESET + MOVE B,1(AB) + JRST REATT1 + +; FUNCTION TO LIST ALL CHANNELS + +MFUNCTION CHANLIST,SUBR + + ENTRY 0 + + MOVEI A,N.CHNS-1 ;MAX # OF REAL CHANNELS + MOVEI C,0 + MOVEI B,CHNL1 ;POINT TO FIRST REAL CHANNEL + +CHNLP: SKIPN 1(B) ;OPEN? + JRST NXTCHN ;NO, SKIP + HRRE E,(B) ; ABOUT TO FLUSH? + JUMPL E,NXTCHN ; YES, FORGET IT + MOVE D,1(B) ; GET CHANNEL + HRRZ E,CHANNO-1(D) ; GET REF COUNT + PUSH TP,(B) + PUSH TP,1(B) + ADDI C,1 ;COUNT WINNERS + SOJGE E,.-3 ; COUNT THEM +NXTCHN: ADDI B,2 + SOJN A,CHNLP + + SKIPN B,CHNL0+1 ;NOW HACK LIST OF PSUEDO CHANNELS + JRST MAKLST +CHNLS: PUSH TP,(B) + PUSH TP,(B)+1 + ADDI C,1 + HRRZ B,(B) + JUMPN B,CHNLS + +MAKLST: ACALL C,LIST + JRST FINIS + + ; ROUTINE TO RESTORE A CLOSED CHANNEL TO ITS PREVIOUS STATE + + +REOPN: PUSH TP,$TCHAN + PUSH TP,B + SKIPN CHANNO(B) ; ONLY REAL CHANNELS + JRST PSUEDO + +IFN ITS,[ + MOVSI E,-4 ; SET UP POINTER FOR NAMES + +GETOPB: MOVE B,(TP) ; GET CHANNEL + MOVEI A,@RDTBL(E) ; GET POINTER + MOVE B,(A) ; NOW STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 ; LEAVES SIXBIT ON STACK + AOBJN E,GETOPB +] +IFE ITS,[ + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; GET DEV NAME IN SIXBIT +] + MOVE B,(TP) ; RESTORE CHANNEL + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,CHMOD ; CHECK FOR A VALID MODE + +IFN ITS, MOVE E,-3(P) ; GET DEVICE IN PROPER PLACE +IFE ITS, HLRZS E,(P) + MOVE B,(TP) ; RESTORE CHANNEL +IFN ITS, CAMN E,[SIXBIT /DSK /] +IFE ITS,[ + CAIE E,(SIXBIT /PS /) + CAIN E,(SIXBIT /DSK/) + JRST DISKH ; DISK WINS IMMEIDATELY + CAIE E,(SIXBIT /SS /) + CAIN E,(SIXBIT /SRC/) + JRST DISKH ; DISK WINS IMMEIDATELY +] +IFN ITS, CAMN E,[SIXBIT /TTY /] ; NO NEED TO RE-OPEN THE TTY +IFE ITS, CAIN E,(SIXBIT /TTY/) + JRST REOPD1 +IFN ITS,[ + AND E,[777700,,0] ; COULD BE "UTn" + MOVE D,CHANNO(B) ; GET CHANNEL + ASH D,1 + ADDI D,CHNL0 ; DON'T SEEM TO BE OPEN + SETZM 1(D) + SETZM CHANNO(B) + CAMN E,[SIXBIT /UT /] + JRST REOPD ; CURRENTLY, CANT RESTORE UTAPE CHANNLES + CAMN E,[SIXBIT /AI /] + JRST REOPD ; CURRENTLY CANT RESTORE AI CHANNELS + CAMN E,[SIXBIT /ML /] + JRST REOPD ; CURRENTLY CANT RESTORE ML CHANNELS + CAMN E,[SIXBIT /DM /] + JRST REOPD ; CURRENTLY CANT RESTORE DM CHANNELS +] + PUSH TP,$TCHAN ; TRY TO RESET IT + PUSH TP,B + MCALL 1,FRESET + +IFN ITS,[ +REOPD1: AOS -4(P) +REOPD: SUB P,[4,,4] +] +IFE ITS,[ +REOPD1: AOS -1(P) +REOPD: SUB P,[1,,1] +] +REOPD0: SUB TP,[2,,2] + POPJ P, + +IFN ITS,[ +DISKH: MOVE C,(P) ; SNAME + .SUSET [.SSNAM,,C] +] +IFE ITS,[ +DISKH: MOVEM A,(P) ; SAVE MODE WORD + PUSHJ P,STSTK ; STRING TO STACK + MOVE A,(E) ; RESTORE MODE WORD + PUSH TP,$TPDL + PUSH TP,E ; SAVE PDL BASE + MOVE B,-2(TP) ; CHANNEL BACK TO B +] + MOVE C,ACCESS(B) ; GET CHANNELS ACCESS + TRNN A,2 ; SKIP IF NOT ASCII CHANNEL + JRST DISKH1 + HRRZ D,ACCESS-1(B) ; IF PARTIAL WORD OUT + IMULI C,5 ; TO CHAR ACCESS + JUMPE D,DISKH1 ; NO SWEAT + ADDI C,(D) + SUBI C,5 +DISKH1: HRRZ D,BUFSTR-1(B) ; ANY CHARS IN MUDDLE BUFFER + JUMPE D,DISKH2 + TRNN A,1 ; SKIP IF OUTPUT CHANNEL + JRST DISKH2 + PUSH P,A + PUSH P,C + MOVEI C,BUFSTR-1(B) + PUSHJ P,BYTDOP ; FIND LENGTH OF WHOLE BUFFER + HLRZ D,(A) ; LENGTH + 2 TO D + SUBI D,2 + IMULI D,5 ; TO CHARS + SUB D,BUFSTR-1(B) + POP P,C + POP P,A +DISKH2: SUBI C,(D) ; UPDATE CHAR ACCESS + IDIVI C,5 ; BACK TO WORD ACCESS +IFN ITS,[ + IORI A,6 ; BLOCK IMAGE + TRNE A,1 + IORI A,100000 ; WRITE OVER BIT + PUSHJ P,DOOPN + JRST REOPD + MOVE A,C ; ACCESS TO A + PUSHJ P,GETFLN ; CHECK LENGTH + CAIGE 0,(A) ; CHECK BOUNDS + JRST .+3 ; COMPLAIN + PUSHJ P,DOACCS ; AND ACESS + JRST REOPD1 ; SUCCESS + + MOVE A,CHANNO(B) ; CLOSE THE G.D. CHANNEL + PUSHJ P,MCLOSE + JRST REOPD + +DOACCS: PUSH P,A + HRRZ A,CHANNO(B) + DOTCAL ACCESS,[A,(P)] + JFCL + POP P,A + POPJ P, + +DOIOTO: +DOIOTI: +DOIOT: + PUSH P,0 + MOVSI 0,TCHAN + MOVE PVP,PVSTOR+1 + MOVEM 0,BSTO(PVP) ; IN CASE OF INTERRUPT + ENABLE + HRRZ 0,CHANNO(B) + DOTCAL IOT,[0,A] + JFCL + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + POP P,0 + POPJ P, + +GETFLN: MOVE 0,CHANNO(B) ; GET CHANNEL + .CALL FILBLK ; READ LNTH + .VALUE + POPJ P, + +FILBLK: SETZ + SIXBIT /FILLEN/ + 0 + 402000,,0 ; STUFF RESULT IN 0 +] +IFE ITS,[ + MOVEI A,CHNL0 + ADD A,CHANNO(B) + ADD A,CHANNO(B) + SETZM 1(A) ; MAY GET A DIFFERENT JFN + HRROI B,1(E) ; TENEX STRING POINTER + MOVSI A,400001 ; MAKE SURE + GTJFN ; GO GET IT + JRST RGTJL ; COMPLAIN + MOVE D,-2(TP) + HRRZM A,CHANNO(D) ; COULD HAVE CHANGED + MOVE P,(TP) ; RESTORE P + MOVEI B,CHNL0 + ASH A,1 ; MUNG ITS SLOT + ADDI A,(B) + MOVEM D,1(A) + HLLOS (A) ; MARK CHANNEL NOT TO BE RELOOKED AT + MOVE A,(P) ; MODE WORD BACK + MOVE B,[440000,,200000] ; FLAG BITS + TRNE A,1 ; SKIP FOR INPUT + TRC B,300000 ; CHANGE TO WRITE + MOVE A,CHANNO(D) ; GET JFN + OPENF + JRST ROPFLS + MOVE E,C ; LENGTH TO E + SIZEF ; GET CURRENT LENGTH + JRST ROPFLS + CAMGE B,E ; STILL A WINNER + JRST ROPFLS + MOVE A,CHANNO(D) ; JFN + MOVE B,C + SFPTR + JRST ROPFLS + SUB TP,[2,,2] ; FLUSH PDL POINTER + JRST REOPD1 + +ROPFLS: MOVE A,-2(TP) + MOVE A,CHANNO(A) + CLOSF ; ATTEMPT TO CLOSE + JFCL ; IGNORE FAILURE + SKIPA + +RGTJL: MOVE P,(TP) + SUB TP,[2,,2] + JRST REOPD + +DOACCS: PUSH P,B + EXCH A,B + MOVE A,CHANNO(A) + SFPTR + JRST ACCFAI + POP P,B + POPJ P, +] +PSUEDO: AOS (P) ; ASSUME SUCCESS FOR NOW + MOVEI B,RDEVIC-1(B) ; SEE WHAT DEVICE IS + PUSHJ P,CHRWRD + JFCL + JRST REOPD0 ; NO, RETURN HAPPY +IFN 0,[ CAME B,[ASCII /E&S/] ; DISPLAY ? + CAMN B,[ASCII /DIS/] + SKIPA B,(TP) ; YES, REGOBBLE CHANNEL AND CONTINUE + JRST REOPD0 ; NO, RETURN HAPPY + PUSHJ P,DISROP + SOS (P) ; DISPLAY DID NOT REOPEN, UNDO ASSUMPTION OF SUCCESS + JRST REOPD0] + + ;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL + +MFUNCTION FCLOSE,SUBR,[CLOSE] + + ENTRY 1 ;ONLY ONE ARG + GETYP A,(AB) ;CHECK ARGS + CAIE A,TCHAN ;IS IT A CHANNEL + JRST WTYP1 + MOVE B,1(AB) ;PICK UP THE CHANNEL + HRRZ A,CHANNO-1(B) ; GET REF COUNT + SOJGE A,CFIN5 ; NOT READY TO REALLY CLOSE + CAME B,TTICHN+1 ; CHECK FOR TTY + CAMN B,TTOCHN+1 + JRST CLSTTY + MOVE A,[JRST CHNCLS] + MOVEM A,IOINS(B) ;CLOBBER THE IO INS + MOVE A,RDEVIC-1(B) ;GET THE NAME OF THE DEVICE + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 +IFN ITS, MOVE A,(P) +IFE ITS, HLRZS A,(P) + MOVE B,1(AB) ; RESTORE CHANNEL +IFN 0,[ + CAME A,[SIXBIT /E&S /] + CAMN A,[SIXBIT /DIS /] + PUSHJ P,DISCLS] + MOVE B,1(AB) ; IN CASE CLOBBERED BY DISCLS + SKIPN A,CHANNO(B) ;ANY REAL CHANNEL? + JRST REMOV ; NO, EITHER CLOSED OR PSEUDO CHANNEL + + MOVE A,DIRECT-1(B) ; POINT TO DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; CONVERT TO WORD + POP P,A +IFN ITS, LDB E,[360600,,(P)] ; FIRST CHAR OD DEV NAME +IFE ITS, LDB E,[140600,,(P)] ; FIRST CHAR OD DEV NAME + CAIE E,'T ; SKIP IF TTY + JRST CFIN4 + CAME A,[SIXBIT /READ/] ; SKIP IF WINNER + JRST CFIN1 +IFN ITS,[ + MOVE B,1(AB) ; IN ITS CHECK STATUS + LDB A,[600,,STATUS(B)] + CAILE A,2 + JRST CFIN1 +] + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE CHAR + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,OFF ; TURN OFF INTERRUPT +CFIN1: MOVE B,1(AB) + MOVE A,CHANNO(B) +IFN ITS,[ + PUSHJ P,MCLOSE +] +IFE ITS,[ + TLZ A,400000 ; FOR JFN RELEASE + CLOSF ; CLOSE THE FILE AND RELEASE THE JFN + JFCL + MOVE A,CHANNO(B) +] +CFIN: LSH A,1 + ADDI A,CHNL0+1 ;POINT TO THIS CHANNELS LSOT + SETZM CHANNO(B) + SETZM (A) ;AND CLOBBER IT + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) + HLLZS ACCESS-1(B) +CFIN2: HLLZS -2(B) + MOVSI A,TCHAN ;RETURN THE CHANNEL + JRST FINIS + +CLSTTY: ERRUUO EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL + + +REMOV: MOVEI D,CHNL0+1 ;ATTEMPT TO REMOVE FROM PSUEDO CHANNEL LIST +REMOV0: SKIPN C,D ;FOUND ON LIST ? + JRST CFIN2 ;NO, JUST IGNORE THIS CLOSED CHANNEL + HRRZ D,(C) ;GET POINTER TO NEXT + CAME B,(D)+1 ;FOUND ? + JRST REMOV0 + HRRZ D,(D) ;YES, SPLICE IT OUT + HRRM D,(C) + JRST CFIN2 + + +; CLOSE UP ANY LEFTOVER BUFFERS + +CFIN4: +; CAME A,[SIXBIT /PRINTO/] +; CAMN A,[SIXBIT /PRINTB/] +; JRST .+3 +; CAME A,[SIXBIT /PRINT/] +; JRST CFIN1 + MOVE B,1(AB) ; GET CHANNEL + HRRZ A,-2(B) ;GET MODE BITS + TRNN A,C.PRIN + JRST CFIN1 + GETYP 0,BUFSTR-1(B) ; IS THERE AN OUTPUT BUFFER + SKIPN BUFSTR(B) + JRST CFIN1 + CAIE 0,TCHSTR + JRST CFINX1 + PUSHJ P,BFCLOS +IFE ITS,[ + MOVE A,CHANNO(B) + MOVEI B,7 + SFBSZ + JFCL + CLOSF + JFCL +] + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) +CFINX1: HLLZS ACCESS-1(B) + JRST CFIN1 + +CFIN5: HRRM A,CHANNO-1(B) + JRST CFIN2 + ;SUBR TO DO .ACCESS ON A READ CHANNEL +;FORM: +;POSITIONS CHANNEL AT CHARACTER POSN FIX-NUMBER +;H. BRODIE 7/26/72 + +MFUNCTION MACCESS,SUBR,[ACCESS] + ENTRY 2 ;ARGS: CHANNEL AND FIX-NUMBER + +;CHECK ARGUMENT TYPES + GETYP A,(AB) + CAIE A,TCHAN ;FIRST ARG SHOULD BE CHANNEL + JRST WTYP1 + GETYP A,2(AB) ;TYPE OF SECOND + CAIE A,TFIX ;SHOULD BE FIX + JRST WTYP2 + +;CHECK DIRECTION OF CHANNEL + MOVE B,1(AB) ;B GETS PNTR TO CHANNEL +; MOVEI B,DIRECT-1(B) ;GET DIRECTION OF CHANNEL +; PUSHJ P,CHRWRD ;GRAB THE CHAR STRNG +; JFCL +; CAME B,[+1] + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.PRIN + JRST MACCA + MOVE B,1(AB) + SKIPE C,BUFSTR(B) ;SEE IF WE MUST FLUSH PART BUFFER + PUSHJ P,BFCLOS + JRST MACC +MACCA: +; CAMN B,[ASCIZ /READ/] +; JRST .+4 +; CAME B,[ASCIZ /READB/] ; READB CHANNEL? +; JRST WRONGD +; AOS (P) ; SET INDICATOR FOR BINARY MODE + +;CHECK THAT THE CHANNEL IS OPEN +MACC: MOVE B,1(AB) ;GET BACK PTR TO CHANNEL + HRRZ E,-2(B) + TRNN E,C.OPN + JRST CHNCLS ;IF CHNL CLOSED => ERROR + +;COMPUTE ACCESS PNTR TO ACCESS WORD CHAR IS IN +;REMAINDER IS NUMBER OF TIMES TO INCR BYTE POINTER +ADEVOK: SKIPGE C,3(AB) ;GET CHAR POSN + ERRUUO EQUOTE NEGATIVE-ARGUMENT +MACC1: MOVEI D,0 + TRNN E,C.BIN ; SKIP FOR BINARY FILE + IDIVI C,5 + +;SETUP THE .ACCESS + TRNN E,C.PRIN + JRST NLSTCH + HRRZ 0,LSTCH-1(B) + MOVE A,ACCESS(B) + TRNN E,C.BIN + JRST LSTCH1 + IMULI A,5 + ADD A,ACCESS-1(B) + ANDI A,-1 +LSTCH1: CAIG 0,(A) + MOVE 0,A + MOVE A,C + IMULI A,5 + ADDI A,(D) + CAML A,0 + MOVE 0,A + HRRM 0,LSTCH-1(B) ; UPDATE "LARGEST" +NLSTCH: MOVE A,CHANNO(B) ;A GETS REAL CHANNEL NUMBER +IFN ITS,[ + DOTCAL ACCESS,[A,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + +IFE ITS,[ + MOVE B,C + SFPTR ; DO IT IN TENEX + JRST ACCFAI + MOVE B,1(AB) ; RESTORE CHANNEL +] +; POP P,E ; CHECK FOR READB MODE + TRNN E,C.READ + JRST ACCOUT ; PRINT TYPE CHANNEL, GO DO IT + SKIPE BUFSTR(B) ; IS THERE A READ BUFFER TO FLUSH + JRST .+3 + SETZM LSTCH(B) ; CLEAR OUT POSSIBLE EOF INDICATOR + JRST DONADV + +;NOW FORCE GETCHR TO DO A .IOT FIRST THING + MOVEI C,BUFSTR-1(B) ; FIND END OF STRING + PUSHJ P,BYTDOP" + SUBI A,2 ; LAST REAL WORD + HRLI A,010700 + MOVEM A,BUFSTR(B) + HLLZS BUFSTR-1(B) ; CLOBBER CHAR COUNT + SETZM LSTCH(B) ;CLOBBER READ'S HIDDEN CHARACTER + +;NOW DO THE APPROPRIATE NUM OF BYTE ADVANCEMENTS + JUMPLE D,DONADV +ADVPTR: PUSHJ P,GETCHR + MOVE B,1(AB) ;RESTORE IN CASE CLOBBERED + SOJG D,ADVPTR + +DONADV: MOVE C,3(AB) ;FIXUP ACCESS SLOT IN CHNL + HLLZS ACCESS-1(B) + MOVEM C,ACCESS(B) + MOVE A,$TCHAN ;TYPE OF RESULT = "CHANNEL" + JRST FINIS ;DONE...B CONTAINS CHANNEL + +IFE ITS,[ +ACCFAI: ERRUUO EQUOTE ACCESS-FAILURE +] +ACCOUT: SKIPN C,BUFSTR(B) ; FIXUP BUFFER? + JRST ACCOU1 + HRRZ F,BUFSTR-1(B) + ADD F,[-BUFLNT*5-4] + IDIVI F,5 + ADD F,BUFSTR(B) + HRLI F,010700 + MOVEM F,BUFSTR(B) + MOVEI F,BUFLNT*5 + HRRM F,BUFSTR-1(B) +ACCOU1: TRNE E,C.BIN ; FINISHED FOR BINARY CHANNELS + JRST DONADV + + JUMPE D,DONADV ; THIS CASE OK +IFE ITS,[ + MOVE A,CHANNO(B) ; GET LAST WORD + RFPTR + JFCL + PUSH P,B + MOVNI C,1 + MOVE B,[444400,,E] ; READ THE WORD + SIN + JUMPL C,ACCFAI + POP P,B + SFPTR + JFCL + MOVE B,1(AB) ; CHANNEL BACK + MOVE C,[440700,,E] + ILDB 0,C + IDPB 0,BUFSTR(B) + SOS BUFSTR-1(B) + SOJG D,.-3 + JRST DONADV +] +IFN ITS, ERRUUO EQUOTE CANT-ACCESS-ASCII-ON-ITS + + +;WRONG TYPE OF DEVICE ERROR +WRDEV: ERRUUO EQUOTE NON-DSK-DEVICE + +; BINARY READ AND PRINT ROUTINES + +MFUNCTION PRINTB,SUBR + + ENTRY + +PBFL: PUSH P,. ; PUSH NON-ZERONESS + MOVEI A,-7 + JRST BINI1 + +MFUNCTION READB,SUBR + + ENTRY + + PUSH P,[0] + MOVEI A,-11 +BINI1: HLRZ 0,AB + CAILE 0,-3 + JRST TFA + CAIG 0,(A) + JRST TMA + + GETYP 0,(AB) ; SHOULD BE UVEC OR STORE + CAIE 0,TSTORAGE + CAIN 0,TUVEC + JRST BINI2 + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTOK + JRST WTYP1 ; ELSE LOSE +BINI2: MOVE B,1(AB) ; GET IT + HLRE C,B + SUBI B,(C) ; POINT TO DOPE + GETYP A,(B) + PUSHJ P,SAT" ; GET ITS ST.ALOC.TYPE + CAIE A,S1WORD + JRST WTYP1 +BYTOK: GETYP 0,2(AB) + CAIE 0,TCHAN ; BETTER BE A CHANNEL + JRST WTYP2 + MOVE B,3(AB) ; GET IT +; MOVEI B,DIRECT-1(B) ; GET DIRECTION OF +; PUSHJ P,CHRWRD ; INTO 1 WORD +; JFCL +; MOVNI E,1 +; CAMN B,[ASCII /READB/] +; MOVEI E,0 +; CAMN B,[+1] + HRRZ A,-2(B) ; MODE BITS + TRNN A,C.BIN ; IF NOT BINARY + JRST WRONGD + MOVEI E,0 + TRNE A,C.PRIN + MOVE E,PBFL +; JUMPL E,WRONGD ; LOSER + CAME E,(P) ; CHECK WINNGE + JRST WRONGD + MOVE B,3(AB) ; GET CHANNEL BACK + SKIPN A,IOINS(B) ; OPEN? + PUSHJ P,OPENIT ; LOSE + CAMN A,[JRST CHNCLS] + JRST CHNCLS ; LOSE, CLOSED + JUMPN E,BUFOU1 ; JUMP FOR OUTPUT + MOVEI C,0 + CAML AB,[-5,,] ; SKIP IF EOF GIVEN + JRST BINI5 + MOVE 0,4(AB) + MOVEM 0,EOFCND-1(B) + MOVE 0,5(AB) + MOVEM 0,EOFCND(B) + CAML AB,[-7,,] + JRST BINI5 + GETYP 0,6(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,7(AB) +BINI5: SKIPE LSTCH(B) ; INDICATES IF EOF HIT + JRST BINEOF + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTI + MOVE A,1(AB) ; GET VECTOR + PUSHJ P,PGBIOI ; READ IT + HLRE C,A ; GET COUNT DONE + HLRE D,1(AB) ; AND FULL COUNT + SUB C,D ; C=> TOTAL READ + ADDM C,ACCESS(B) + JUMPGE A,BINIOK ; NOT EOF YET + SETOM LSTCH(B) +BINIOK: MOVE B,C + MOVSI A,TFIX ; RETURN AMOUNT ACTUALLY READ + JRST FINIS + +BYTI: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-LOST + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-LOST + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE STRING LENGTH + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 + PUSH P,C + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SIN] + PUSHJ P,PGBIOT + HLRE C,A ; GET COUNT DONE + POP P,D + SKIPN D + HRRZ D,(AB) ; AND FULL COUNT + ADD D,C ; C=> TOTAL READ + LDB E,[300600,,1(AB)] + MOVEI A,36. + IDIVM A,E + IDIVM D,E + ADDM E,ACCESS(B) + SKIPGE C ; NOT EOF YET + SETOM LSTCH(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-LOST + MOVE C,D + JRST BINIOK +] +BUFOU1: SKIPE BUFSTR(B) ; ANY BUFFERS AROUND? + PUSHJ P,BFCLS1 ; GET RID OF SAME + MOVEI C,0 + CAML AB,[-5,,] + JRST BINO5 + GETYP 0,4(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,5(AB) +BINO5: MOVE A,1(AB) + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTO + PUSHJ P,PGBIOO + HLRE C,1(AB) + MOVNS C + ADDM C,ACCESS(B) +BYTO1: MOVE A,(AB) ; RET VECTOR ETC. + MOVE B,1(AB) + JRST FINIS + +BYTO: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-FAILURE + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-FAILURE + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE SIZE + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 ; COMPENSATE FOR PGBIOT DOING THE WRONG THING + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SOUT] + PUSHJ P,PGBIOT + LDB D,[300600,,1(AB)] + MOVEI C,36. + IDIVM C,D + HRRZ C,(AB) + IDIVI C,(D) + ADDM C,ACCESS(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-FAILURE + JRST BYTO1 +] + +BINEOF: PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOSER + MCALL 1,EVAL + JRST FINIS + +OPENIT: PUSH P,E + PUSHJ P,OPNCHN ;TRY TO OPEN THE LOSER + JUMPE B,CHNCLS ;FAIL + POP P,E + POPJ P, + ; THESE SUBROUTINES BY NDR 9/16/73 TO FACILITATE THE +; TYPES OF IO NECESSARY TO MAKE MORE EFFICIENT USE OF +; THE NETWORK AND DO RELATED FILE TRANSFER TYPE OF JOBS. + +R1CHAR: SKIPN A,LSTCH(B) ; CHAR READING ROUTINE FOR FCOPY + PUSHJ P,RXCT + TLO A,200000 ; ^@ BUG + MOVEM A,LSTCH(B) + TLZ A,200000 + JUMPL A,.+2 ; IN CASE OF -1 ON STY + TRZN A,400000 ; EXCL HACKER + JRST .+4 + MOVEM A,LSTCH(B) ; SAVE DE-EXCLED CHAR + MOVEI A,"! + JRST .+2 + SETZM LSTCH(B) + PUSH P,C + HRRZ C,DIRECT-1(B) + CAIE C,5 ; IF DIRECTION IS 5 LONG THEN READB + JRST R1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) ; EVERY FIFTY INCREMENT + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +R1CH1: AOS ACCESS(B) + POP P,C + POPJ P, + +W1CHAR: CAIE A,15 ; CHAR WRITING ROUTINE, TEST FOR CR + JRST .+3 + SETOM CHRPOS(B) + AOSA LINPOS(B) + CAIE A,12 ; TEST FOR LF + AOS CHRPOS(B) ; IF NOT LF AOS CHARACTE5R POSITION + CAIE A,14 ; TEST FOR FORM FEED + JRST .+3 + SETZM CHRPOS(B) ; IF FORM FEED ZERO CHARACTER POSITION + SETZM LINPOS(B) ; AND LINE POSITION + CAIE A,11 ; IS THIS A TAB? + JRST .+6 + MOVE C,CHRPOS(B) + ADDI C,7 + IDIVI C,8. + IMULI C,8. ; FIX UP CHAR POS FOR TAB + MOVEM C,CHRPOS(B) ; AND SAVE + PUSH P,C + HRRZ C,-2(B) ; GET BITS + TRNN C,C.BIN ; SIX LONG MUST BE PRINTB + JRST W1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +W1CH1: AOS ACCESS(B) + PUSH P,A + PUSHJ P,WXCT + POP P,A + POP P,C + POPJ P, + +R1C: SUBM M,(P) ;LITTLE ENTRY FOR COMPILED STUFF +; PUSH TP,$TCHAN ;SAVE THE CHANNEL TO BLESS IT +; PUSH TP,B +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JFCL +; CAME B,[ASCIZ /READ/] +; CAMN B,[ASCII /READB/] +; JRST .+2 +; JRST BADCHN + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.READ + JRST BADCHN + SKIPN IOINS(B) ; IS THE CHANNEL OPEN + PUSHJ P,OPENIT ; NO, GO DO IT + PUSHJ P,GRB ; MAKE SURE WE HAVE A READ BUFFER + PUSHJ P,R1CHAR ; AND GET HIM A CHARACTER + JRST MPOPJ ; THATS ALL FOLKS + +W1C: SUBM M,(P) + PUSHJ P,W1CI + JRST MPOPJ + +W1CI: +; PUSH TP,$TCHAN +; PUSH TP,B + PUSH P,A ; ASSEMBLER ENTRY TO OUTPUT 1 CHAR +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; INTERNAL CALL TO W1CHAR +; JFCL +; CAME B,[ASCII /PRINT/] +; CAMN B,[+1] +; JRST .+2 +; JRST BADCHN +; POP TP,B +; POP TP,(TP) + HRRZ A,-2(B) + TRNN A,C.PRIN + JRST BADCHN + SKIPN IOINS(B) ; MAKE SURE THAT IT IS OPEN + PUSHJ P,OPENIT + PUSHJ P,GWB + POP P,A ; GET THE CHAR TO DO + JRST W1CHAR + +; ROUTINES TO REPLACE XCT IOINS(B) FOR INPUT AND OUTPUT +; THEY DO THE XCT THEN CHECK OUT POSSIBLE SCRIPTAGE--BLECH. + + +WXCT: +RXCT: XCT IOINS(B) ; READ IT + SKIPN SCRPTO(B) + POPJ P, + +DOSCPT: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; AND SAVE THE CHAR AROUND + + SKIPN SCRPTO(B) ; IF ZERO FORGET IT + JRST SCPTDN ; THATS ALL THERE IS TO IT + PUSH P,C ; SAVE AN ACCUMULATOR FOR CLEANLINESS + GETYP C,SCRPTO-1(B) ; IS IT A LIST + CAIE C,TLIST + JRST BADCHN + PUSH TP,$TLIST + PUSH TP,[0] ; SAVE A SLOT FOR THE LIST + MOVE C,SCRPTO(B) ; GET THE LIST OF SCRIPT CHANNELS +SCPT1: GETYP B,(C) ; GET THE TYPE OF THIS SCRIPT CHAN + CAIE B,TCHAN + JRST BADCHN ; IF IT ISN'T A CHANNEL, COMPLAIN + HRRZ B,(C) ; GET THE REST OF THE LIST IN B + MOVEM B,(TP) ; AND STORE ON STACK + MOVE B,1(C) ; GET THE CHANNEL IN B + MOVE A,-1(P) ; AND THE CHARACTER IN A + PUSHJ P,W1CI ; GO TO INTERNAL W1C, IT BLESSES GOODIES + SKIPE C,(TP) ; GET THE REST OF LIST OF CHANS + JRST SCPT1 ; AND CYCLE THROUGH + SUB TP,[2,,2] ; CLEAN OFF THE LIST OF CHANS + POP P,C ; AND RESTORE ACCUMULATOR C +SCPTDN: POP P,A ; RESTORE THE CHARACTER + POP TP,B ; AND THE ORIGINAL CHANNEL + POP TP,(TP) + POPJ P, ; AND THATS ALL + + +; SUBROUTINE TO COPY FROM INCHAN TO OUTCHAN UNTIL EOF HIT +; ON THE INPUT CHANNEL +; CALL IS WHERE DEFAULTS ARE INCHAN AND OUTCHAN + + MFUNCTION FCOPY,SUBR,[FILECOPY] + + ENTRY + HLRE 0,AB + CAMGE 0,[-4] + JRST WNA ; TAKES FROM 0 TO 2 ARGS + + JUMPE 0,.+4 ; NO FIRST ARG? + PUSH TP,(AB) + PUSH TP,1(AB) ; SAVE IN CHAN + JRST .+6 + MOVE A,$TATOM + MOVE B,IMQUOTE INCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B + HLRE 0,AB ; CHECK FOR SECOND ARG + CAML 0,[-2] ; WAS THERE MORE THAN ONE ARG? + JRST .+4 + PUSH TP,2(AB) ; SAVE SECOND ARG + PUSH TP,3(AB) + JRST .+6 + MOVE A,$TATOM ; LOOK UP OUTCHAN AS DEFAULT + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B ; AND SAVE IT + + MOVE A,-3(TP) + MOVE B,-2(TP) ; INPUT CHANNEL + MOVEI 0,C.READ ; INDICATE INPUT + PUSHJ P,CHKCHN ; CHECK FOR GOOD CHANNEL + MOVE A,-1(TP) + MOVE B,(TP) ; GET OUT CHAN + MOVEI 0,C.PRIN ; INDICATE OUT CHAN + PUSHJ P,CHKCHN ; CHECK FOR GOOD OUT CHAN + + PUSH P,[0] ; COUNT OF CHARS OUTPUT + + MOVE B,-2(TP) + PUSHJ P,GRB ; MAKE SURE WE HAVE READ BUFF + MOVE B,(TP) + PUSHJ P,GWB ; MAKE SURE WE HAVE WRITE BUFF + +FCLOOP: INTGO + MOVE B,-2(TP) + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,FCDON ; IF A NEG NUMBER WE GOT EOF + MOVE B,(TP) ; GET OUT CHAN + PUSHJ P,W1CHAR ; SPIT IT OUT + AOS (P) ; INCREMENT COUNT + JRST FCLOOP + +FCDON: SUB TP,[2,,2] ; POP OFF OUTCHAN + MCALL 1,FCLOSE ; CLOSE INCHAN + MOVE A,$TFIX + POP P,B ; GET CHAR COUNT TO RETURN + JRST FINIS + +CHKCHN: PUSH P,0 ; CHECK FOR GOOD TASTING CHANNEL + PUSH TP,A + PUSH TP,B + GETYP C,A + CAIE C,TCHAN + JRST CHKBDC ; GO COMPLAIN IN RIGHT WAY +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JRST CHKBDC +; MOVE C,(P) ; GET CHAN DIRECT + HRRZ C,-2(B) ; MODE BITS + TDNN C,0 + JRST CHKBDC +; CAMN B,CHKT(C) +; JRST .+4 +; ADDI C,2 ; TEST FOR READB OR PRINTB ALSO +; CAME B,CHKT(C) ; TEST FOR CORRECT DIRECT +; JRST CHKBDC + MOVE B,(TP) + SKIPN IOINS(B) ; MAKE SURE IT IS OPEN + PUSHJ P,OPENIT ; IF ZERO IOINS GO OPEN IT + SUB TP,[2,,2] + POP P, ; CLEAN UP STACKS + POPJ P, + +CHKT: ASCIZ /READ/ + ASCII /PRINT/ + ASCII /READB/ + +1 + +CHKBDC: POP P,E + MOVNI D,2 + IMULI D,1(E) + HLRE 0,AB + CAMLE 0,D ; SEE IF THIS WAS HIS ARG OF DEFAULT + JRST BADCHN + JUMPE E,WTYP1 + JRST WTYP2 + + ; FUNCTIONS READSTRING AND PRINTSTRING WORK LIKE READB AND PRINTB, +; THAT IS THEY READ INTO AND OUT OF STRINGS. IN ADDITION BOTH ACCEPT +; AN ADDITIONAL ARGUMENT WHICH IS THE NUMBER OF CHARS TO READ OR PRINT, IF +; IT IS DESIRED FOR THIS TO BE DIFFERENT THAN THE LENGTH OF THE STRING. + +; FORMAT IS +; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN + +; FORMAT FOR PRINTSTRING IS + +; THESE WERE CODED 9/16/73 BY NEAL D. RYAN + + MFUNCTION RSTRNG,SUBR,READSTRING + + ENTRY + PUSH P,[0] ; FLAG TO INDICATE READING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-9] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 4 ARGS + JRST STRIO1 + + MFUNCTION PSTRNG,SUBR,PRINTSTRING + + ENTRY + PUSH P,[1] ; FLAG TO INDICATE WRITING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-7] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 3 ARGS + +STRIO1: PUSH TP,[0] ; SAVE SLOT ON STACK + PUSH TP,[0] + GETYP 0,(AB) + CAIE 0,TCHSTR ; MAKE SURE WE GOT STRING + JRST WTYP1 + HRRZ 0,(AB) ; CHECK FOR EMPTY STRING + SKIPN (P) + JUMPE 0,MTSTRN + HLRE 0,AB + CAML 0,[-2] ; WAS A CHANNEL GIVEN + JRST STRIO2 + GETYP 0,2(AB) + SKIPN (P) ; SKIP IF PRINT + JRST TESTIN + CAIN 0,TTP ; SEE IF FLATSIZE HACK + JRST STRIO9 +TESTIN: CAIE 0,TCHAN + JRST WTYP2 ; SECOND ARG NOT CHANNEL + MOVE B,3(AB) + HRRZ B,-2(B) + MOVNI E,1 ; CHECKING FOR GOOD DIRECTION + TRNE B,C.READ ; SKIP IF NOT READ + MOVEI E,0 + TRNE B,C.PRIN ; SKIP IF NOT PRINT + MOVEI E,1 + CAME E,(P) + JRST WRONGD ; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE +STRIO9: PUSH TP,2(AB) + PUSH TP,3(AB) ; PUSH ON CHANNEL + JRST STRIO3 +STRIO2: MOVE B,IMQUOTE INCHAN + MOVSI A,TCHAN + SKIPE (P) + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + GETYP 0,A + SKIPN (P) ; SKIP IF PRINTSTRING + JRST TESTI2 + CAIN 0,TTP ; SKIP IF NOT FLATSIZE HACK + JRST STRIO8 +TESTI2: CAIE 0,TCHAN + JRST BADCHN ; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL +STRIO8: PUSH TP,A + PUSH TP,B +STRIO3: MOVE B,(TP) ; GET CHANNEL + SKIPN E,IOINS(B) + PUSHJ P,OPENIT ; IF NOT GO OPEN + MOVE E,IOINS(B) + CAMN E,[JRST CHNCLS] + JRST CHNCLS ; CHECK TO SEE THAT CHANNEL ISNT ALREADY CLOSED +STRIO4: HLRE 0,AB + CAML 0,[-4] + JRST STRIO5 ; NO COUNT TO WORRY ABOUT + GETYP 0,4(AB) + MOVE E,4(AB) + MOVE C,5(AB) + CAIE 0,TCHSTR + CAIN 0,TFIX ; BETTER BE A FIXED NUMBER + JRST .+2 + JRST WTYP3 + HRRZ D,(AB) ; GET ACTUAL STRING LENGTH + CAIN 0,TFIX + JRST .+7 + SKIPE (P) ; TEST FOR WRITING + JRST .-7 ; IF WRITING WE GOT TROUBLE + PUSH P,D ; ACTUAL STRING LENGTH + MOVEM E,(TB) ; STUFF HIS FUNNY DELIM STRING + MOVEM C,1(TB) + JRST STRIO7 + CAML D,C ; MAKE SURE THE STRING IS LONG ENOUGH + JRST .+2 ; WIN + ERRUUO EQUOTE COUNT-GREATER-THAN-STRING-SIZE + PUSH P,C ; PUSH ON MAX COUNT + JRST STRIO7 +STRIO5: +STRIO6: HRRZ C,(AB) ; GET CHAR COUNT + PUSH P,C ; AND PUSH IT ON STACK AS NO MAX COUNT GIVEN +STRIO7: HLRE 0,AB + CAML 0,[-6] + JRST .+6 + MOVE B,(TP) ; GET THE CHANNEL + MOVE 0,6(AB) + MOVEM 0,EOFCND-1(B) ; STUFF IN SLOT IN CHAN + MOVE 0,7(AB) + MOVEM 0,EOFCND(B) + PUSH TP,(AB) ; PUSH ON STRING + PUSH TP,1(AB) + PUSH P,[0] ; PUSH ON CURRENT COUNT OF CHARS DONE + MOVE 0,-2(P) ; GET READ OR WRITE FLAG + JUMPN 0,OUTLOP ; GO WRITE STUFF + + MOVE B,-2(TP) ; GET CHANNEL + PUSHJ P,GRB ; MAKE SURE WE HAVE BUFF + SKIPGE A,LSTCH(B) ; CHECK FOR EOF ALREADY READ PREVIOUSLY + JRST SRDOEF ; GO DOES HIS EOF HACKING +INLOP: INTGO + MOVE B,-2(TP) ; GET CHANNEL + MOVE C,-1(P) ; MAX COUNT + CAMG C,(P) ; COMPARE WITH COUNT DONE + JRST STREOF ; WE HAVE FINISHED + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,INEOF ; EOF HIT + MOVE C,1(TB) + HRRZ E,(TB) ; DO WE HAVE A STRING TO WORRY US? + SOJL E,INLNT ; GO FINISH STUFFING + ILDB D,C + CAME D,A + JRST .-3 + JRST INEOF +INLNT: IDPB A,(TP) ; STUFF IN STRING + SOS -1(TP) ; DECREMENT STRING COUNT + AOS (P) ; INCREMENT CHAR COUNT + JRST INLOP + +INEOF: SKIPE C,LSTCH(B) ; IS THIS AN ! AND IS THERE A CHAR THERE + JRST .+3 ; YES + MOVEM A,LSTCH(B) ; NO SAVE THE CHAR + JRST .+3 + ADDI C,400000 + MOVEM C,LSTCH(B) + MOVSI C,200000 + IORM C,LSTCH(B) + HRRZ C,DIRECT-1(B) ; GET THE TYPE OF CHAN + CAIN C,5 ; IS IT READB? + JRST .+3 + SOS ACCESS(B) ; FIX UP ACCESS FOR READ CHANNEL + JRST STREOF ; AND THATS IT + HRRZ C,ACCESS-1(B) ; FOR A READB ITS WORSE + MOVEI D,5 + SKIPG C + HRRM D,ACCESS-1(B) ; CHANGE A 0 TO A FIVE + SOS C,ACCESS-1(B) + CAMN C,[TFIX,,0] + SOS ACCESS(B) ; AND SOS THE WORD COUNT MAYBE + JRST STREOF + +SRDOEF: SETZM LSTCH(B) ; IN CASE OF -1, FLUSH IT + AOJE A,INLOP ; SKIP OVER -1 ON PTY'S + SUB TP,[6,,6] + SUB P,[3,,3] ; POP JUNK OFF STACKS + PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) ; WHAT WE NEED TO EVAL + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOOSING CHANNEL + MCALL 1,EVAL ; EVAL HIS EOF JUNK + JRST FINIS + +OUTLOP: MOVE B,-2(TP) +OUTLP1: INTGO + MOVE A,-3(TP) ; GET CHANNEL + MOVE B,-2(TP) + MOVE C,-1(P) ; MAX COUNT TO DO + CAMG C,(P) ; HAVE WE DONE ENOUGH + JRST STREOF + ILDB D,(TP) ; GET THE CHAR + SOS -1(TP) ; SUBTRACT FROM STRING LENGTH + AOS (P) ; INC COUNT OF CHARS DONE + PUSHJ P,CPCH1 ; GO STUFF CHAR + JRST OUTLP1 + +STREOF: MOVE A,$TFIX + POP P,B ; RETURN THE LOOSER A COUNT OF WHAT WAS DONE + SUB P,[2,,2] + SUB TP,[6,,6] + JRST FINIS + + +GWB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A WRITE BUFFER ON PRINTB CHAN + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVSI A,TWORD+.VECT. + MOVEM A,BUFLNT(B) + SETOM (B) + MOVEI C,1(B) + HRLI C,(B) + BLT C,BUFLNT-1(B) + MOVEI C,-1(B) + HRLI C,010700 + MOVE B,(TP) + MOVEI 0,C.BUF + IORM 0,-2(B) + MOVEM C,BUFSTR(B) + MOVE C,[TCHSTR,,BUFLNT*5] + MOVEM C,BUFSTR-1(B) + SUB TP,[2,,2] + POPJ P, + + +GRB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A READ BUFFER + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVEI C,BUFLNT-1(B) + POP TP,B + MOVEI 0,C.BUF + IORM 0,-2(B) + HRLI C,010700 + MOVEM C,BUFSTR(B) + MOVSI C,TCHSTR + MOVEM C,BUFSTR-1(B) + SUB TP,[1,,1] + POPJ P, + +MTSTRN: ERRUUO EQUOTE EMPTY-STRING + + ; INPUT UNBUFFERING ROUTINE. THIS DOES THE CHARACTER UNBUFFERING +; FOR INPUT. THE OPEN ROUTINE SETUPS A PUSHJ P, TO +; THIS ROUTINE AS THE IOINS FOR A CHANNEL OPEN TO A NON-TTY DEVICE. + +; H. BRODIE 7/19/72 + +; CALLING SEQ: +; PUSHJ P,GETCHR +; B/ AOBJN PNTR TO CHANNEL VECTOR +; RETURNS NEXT CHARACTER IN AC A. +; ON ENCOUNTERING EITHER ^C OR NUL(^@) IT ASSUMES EOF AND +; TRANSMITS ONLY ^C ON SUCCESSIVE CALLS + + +GETCHR: +; FIRST GRAB THE BUFFER +; GETYP A,BUFSTR-1(B) ; GET TYPE WORD +; CAIN A,TCHSTR ; SKIPS IF NOT CHSTR (I.E. IF BAD BUFFER) +; JRST GTGBUF ; IS GOOD BUFFER...SKIP ERROR RETURN +GTGBUF: HRRZ A,BUFSTR-1(B) ; GET LENGTH OF STRING + SOJGE A,GTGCHR ; JUMP IF STILL MORE + +; HERE IF THE BUFFER WAS EXHAUSTED (BYTE PNTR POINTS INTO DOPE WDS) +; GENERATE AN .IOT POINTER +;FIRST SAVE C AND D AS I WILL CLOBBER THEM +NEWBUF: PUSH P,C + PUSH P,D +IFN ITS,[ + LDB C,[600,,STATUS(B)] ; GET TYPE + CAIG C,2 ; SKIP IF NOT TTY +] +IFE ITS,[ + SKIPE BUFRIN(B) +] + JRST GETTTY ; GET A TTY BUFFER + + PUSHJ P,PGBUFI ; RE-FILL BUFFER + +IFE ITS, MOVEI C,-1 + JUMPGE A,BUFGOO ;SKIPS IF IOT COMPLETED...FIX UP CHANNEL + MOVEI C,1 ; MAKE SURE LAST EOF REALLY ENDS IT + ANDCAM C,-1(A) + MOVSI C,014000 ; GET A ^C + MOVEM C,(A) ;FAKE AN EOF + +IFE ITS,[ + HLRE C,A ; HOW MUCH LEFT + ADDI C,BUFLNT ; # OF WORDS TO C + IMULI C,5 ; TO CHARS + MOVE A,-2(B) ; GET BITS + TRNE A,C.BIN ; CAN'T HELP A BINARY CHANNEL + JRST BUFGOO + MOVE A,CHANNO(B) + PUSH P,B + PUSH P,D + PUSH P,C + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + MOVE B,[2,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + POP P,C + CAIE D,7 ; SEVEN BIT BYTES? + JRST BUFGO1 ; NO, DONT HACK + MOVE D,C + IDIVI B,5 ; C IS NUMBER IN LAST WORD IF NOT EVEN + SKIPN C + MOVEI C,5 + ADDI C,-5(D) ; FIXUP C FOR WINNAGE +BUFGO1: POP P,D + POP P,B +] +; RESET THE BYTE POINTER IN THE CHANNEL. +; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D +BUFGOO: HRLI D,010700 ; GENERATE VIRGIN LH + SUBI D,1 + + MOVEM D,BUFSTR(B) ; STASH IN THE BUFFER BYTE PNTR SLOT +IFE ITS, HRRM C,LSTCH-1(B) ; SAVE IT + MOVEI A,BUFLNT*5-1 +BUFROK: POP P,D ;RESTORE D + POP P,C ;RESTORE C + + +; HERE IF THERE ARE CHARS IN BUFFER +GTGCHR: HRRM A,BUFSTR-1(B) + ILDB A,BUFSTR(B) ; GET A CHAR FROM BUFFER + +IFN ITS,[ + CAIE A,3 ; EOF? + POPJ P, ; AND RETURN + LDB A,[600,,STATUS(B)] ; CHECK FOR TTY + CAILE A,2 ; SKIP IF TTY +] +IFE ITS,[ + PUSH P,0 + HRRZ 0,LSTCH-1(B) + SOJL 0,.+4 + HRRM 0,LSTCH-1(B) + POP P,0 + POPJ P, + + POP P,0 + MOVSI A,-1 + SKIPN BUFRIN(B) +] + JRST .+3 +RETEO1: HRRI A,3 + POPJ P, + + HRRZ A,BUFSTR(B) ; SEE IF RSUBR START BIT IS ON + HRRZ A,(A) + TRNN A,1 + MOVSI A,-1 + JRST RETEO1 + +IFN ITS,[ +PGBUFO: +PGBUFI: +] +IFE ITS,[ +PGBUFO: SKIPA D,[SOUT] +PGBUFI: MOVE D,[SIN] +] + SKIPGE A,BUFSTR(B) ; POINT TO CURRENT BUFFER POSIT + SUBI A,1 ; FOR 440700 AND 010700 START + SUBI A,BUFLNT-1 ; CALCULATE PNTR TO BEG OF BUFFER + HRLI A,-BUFLNT ; IOT (AOBJN) PNTR IN A + MOVSI C,004400 +IFN ITS,[ +PGBIOO: +PGBIOI: MOVE D,A ; COPY FOR LATER + MOVSI C,TUVEC ; PREPARE TO HANDDLE INTS + MOVE PVP,PVSTOR+1 + MOVEM C,DSTO(PVP) + MOVEM C,ASTO(PVP) + MOVSI C,TCHAN + MOVEM C,BSTO(PVP) + +; BUILD .IOT INSTR + MOVE C,CHANNO(B) ; CHANNEL NUMBER IN C + ROT C,23. ; MOVE INTO AC FIELD + IOR C,[.IOT 0,A] ; IOR IN SKELETON .IOT + +; DO THE .IOT + ENABLE ; ALLOW INTS + XCT C ; EXECUTE THE .IOT INSTR + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM ASTO(PVP) + SETZM DSTO(PVP) + POPJ P, +] + +IFE ITS,[ +PGBIOT: PUSH P,D + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,C + HRRZS (P) + HRRI C,-1(A) ; POINT TO BUFFER + HLRE D,A ; XTRA POINTER + MOVNS D + HRLI D,TCHSTR + MOVE PVP,PVSTOR+1 + MOVEM D,BSTO(PVP) + MOVE D,[PUSHJ P,FIXACS] + MOVEM D,ONINT + MOVSI D,TUVEC + MOVEM D,DSTO(PVP) + MOVE D,A + MOVE A,CHANNO(B) ; FILE JFN + MOVE B,C + HLRE C,D ; - COUNT TO C + SKIPE (P) + MOVN C,(P) ; REAL DESIRED COUNT + SUB P,[1,,1] + ENABLE + XCT (P) ; DO IT TO IT + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM DSTO(PVP) + SETZM ONINT + MOVEI A,1(B) + MOVE B,(TP) + SUB TP,[2,,2] + SUB P,[1,,1] + JUMPGE C,CPOPJ ; NO EOF YET + HRLI A,(C) ; LOOK LIKE AN AOBJN PNTR + POPJ P, + +FIXACS: PUSH P,PVP + MOVE PVP,PVSTOR+1 + MOVNS C + HRRM C,BSTO(PVP) + MOVNS C + POP P,PVP + POPJ P, + +PGBIOO: SKIPA D,[SOUT] +PGBIOI: MOVE D,[SIN] + HRLI C,004400 + JRST PGBIOT +DOIOTO: PUSH P,[SOUT] +DOIOTC: PUSH P,B + PUSH P,C + EXCH A,B + MOVE A,CHANNO(A) + HLRE C,B + HRLI B,444400 + XCT -2(P) + HRL B,C + MOVE A,B +DOIOTE: POP P,C + POP P,B + SUB P,[1,,1] + POPJ P, +DOIOTI: PUSH P,[SIN] + JRST DOIOTC +] + +; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE + +PUTCHR: PUSH P,A + GETYP A,BUFSTR-1(B) ; CHECK TYPE OF ARG + CAIE A,TCHSTR ; MUST BE STRING + JRST BDCHAN + + HRRZ A,BUFSTR-1(B) ; GET CHAR COUNT + JUMPE A,REBUFF ; PREV RESET BUFF, UNDO SAME + +PUTCH1: POP P,A ; RESTORE CHAR + CAMN A,[-1] ; SPECIAL HACK? + JRST PUTCH2 ; YES GO HANDLE + IDPB A,BUFSTR(B) ; STUFF IT +PUTCH3: SOS A,BUFSTR-1(B) ; COUNT DOWN STRING + TRNE A,-1 ; SKIP IF FULL + POPJ P, + +; HERE TO FLUSH OUT A BUFFER + + PUSH P,C + PUSH P,D + PUSHJ P,PGBUFO ; SETUP AND DO IOT + HRLI D,010700 ; POINT INTO BUFFER + SUBI D,1 + MOVEM D,BUFSTR(B) ; STORE IT + MOVEI A,BUFLNT*5 ; RESET COUNT + HRRM A,BUFSTR-1(B) + POP P,D + POP P,C + POPJ P, + +;HERE TO DA ^C AND TURN ON MAGIC BIT + +PUTCH2: MOVEI A,3 + IDPB A,BUFSTR(B) ; ZAP OUT THE ^C + MOVEI A,1 ; GET BIT +IFE ITS,[ + PUSH P,C + HRRZ C,BUFSTR(B) + IORM A,(C) + POP P,C +] +IFN ITS,[ + IORM A,@BUFSTR(B) ; ON GOES THE BIT +] + JRST PUTCH3 + +; RESET A FUNNY BUF + +REBUFF: MOVEI A,BUFLNT*5 ; 1ST COUNT + HRRM A,BUFSTR-1(B) + HRRZ A,BUFSTR(B) ; NOW POINTER + SUBI A,BUFLNT+1 + HRLI A,010700 + MOVEM A,BUFSTR(B) ; STORE BACK + JRST PUTCH1 + + +; HERE TO FLUSH FINAL BUFFER + +BFCLOS: HRRZ C,-2(B) ; THIS BUFFER FLUSHER THE WORK OF NDR + MOVEI A,0 + TRNE C,C.TTY + POPJ P, + TRNE C,C.DISK + MOVEI A,1 + PUSH P,A ; SAVE THE RESULT OF OUR TEST + JUMPN A,BFCLNN ; DONT HAVE TO CHECK NET STATE + PUSH TP,$TCHAN + PUSH TP,B ; SAVE CHANNEL + PUSHJ P,INSTAT ; GET CURRENT NETWORK STATE + MOVE A,(B) ; GET FIRST ELEMENT OF STATE UVECTOR WHICH IS CUR STATE + POP TP,B ; RESTORE B + POP TP, + CAIE A,5 ; IS NET IN OPEN STATE? + CAIN A,6 ; OR ELSE IS IT IN RFNM WAIT STATE + JRST BFCLNN ; IF SO TO THE IOT + POP P, ; ELSE FLUSH CRUFT AND DONT IOT + POPJ P, ; RETURN DOING NO IOT +BFCLNN: MOVEI C,BUFLNT*5 ; NEW BUFFER FLUSHER BY NDR + HRRZ D,BUFSTR-1(B) ; SO THAT NET ALSO WORKS RIGHT + SUBI C,(D) ; GET NUMBER OF CHARS + IDIVI C,5 ; NUMBER OF FULL WORDS AND REST + PUSH P,D ; SAVE NUMBER OF ODD CHARS + SKIPGE A,BUFSTR(B) ; GET CURRENT BUF POSITION + SUBI A,1 ; FIX FOR 440700 BYTE POINTER +IFE ITS,[ + HRRO D,A + PUSH P,(D) +] +IFN ITS,[ + PUSH P,(A) ; SAVE THE ODD WORD OF BUFFER +] + MOVEI D,BUFLNT + SUBI D,(C) + SKIPE -1(P) + SUBI A,1 + ADDI D,1(A) ; FIX UP FOR POSSIBLE ODD CHARS + PUSH TP,$TUVEC + PUSH TP,D ; PUSH THE DOPE VECTOR ONTO THE STACK + JUMPE C,BFCLSR ; IN CASE THERE ARE NO FULL WORDS TO DO + HRL A,C + TLO A,400000 + MOVE E,[SETZ BUFLNT(A)] + SUBI E,(C) ; FIX UP FOR BACKWARDS BLT + POP A,@E ; AMAZING GRACE + TLNE A,377777 + JRST .-2 + HRRO A,D ; SET UP AOBJN POINTER + SUBI A,(C) + TLC A,-1(C) + PUSHJ P,PGBIOO ; DO THE IOT OF ALL THE FULL WORDS +BFCLSR: HRRO A,(TP) ; GET IOT PTR FOR REST OF JUNK + SUBI A,1 ; POINT TO WORD BEFORE DOPE WORDS + POP P,0 ; GET BACK ODD WORD + POP P,C ; GET BACK ODD CHAR COUNT + POP P,D ; FLAG FOR NET OR DSK + JUMPN D,BFCDSK ; GO FINISH OFF DSK + JUMPE C,BFCLSD ; IF NO ODD CHARS FINISH UP + MOVEI D,7 + IMULI D,(C) ; FIND NO OF BITS TO SHIFT + LSH 0,-43(D) ; SHIFT BITS TO RIGHT PLACE + MOVEM 0,(A) ; STORE IN STRING + SUBI C,5 ; HOW MANY CHAR POSITIONS TO SKIP + MOVNI C,(C) ; MAKE C POSITIVE + LSH C,17 + TLC A,(C) ; MUNG THE AOBJN POINTER TO KLUDGE + PUSHJ P,PGBIOO ; DO IOT OF ODD CHARS + MOVEI C,0 +BFCLSD: HRRZ A,(TP) ; GET PTR TO DOPE WORD + SUBI A,BUFLNT+1 + JUMPLE C,.+3 + SKIPE ACCESS(B) + MOVEM 0,1(A) ; LAST WORD BACK IN BFR + HRLI A,010700 ; AOBJN POINTER TO FIRST OF BUFFER + MOVEM A,BUFSTR(B) + MOVEI A,BUFLNT*5 + HRRM A,BUFSTR-1(B) + SKIPN ACCESS(B) + JRST BFCLSY + JUMPL C,BFCLSY + JUMPE C,BFCLSZ + IBP BUFSTR(B) + SOS BUFSTR-1(B) + SOJG C,.-2 +BFCLSY: MOVE A,CHANNO(B) + MOVE C,B +IFE ITS,[ + RFPTR + FATAL RFPTR FAILED + HRRZ F,LSTCH-1(C) ; PREVIOUS HIGH + MOVE G,C ; SAVE CHANNEL + MOVE C,B + CAML F,B + MOVE C,F + MOVE F,B + HRLI A,400000 + CLOSF + JFCL + MOVNI B,1 + HRLI A,12 + CHFDB + MOVE B,STATUS(G) + ANDI A,-1 + OPENF + FATAL OPENF LOSES + MOVE C,F + IDIVI C,5 + MOVE B,C + SFPTR + FATAL SFPTR FAILED + MOVE B,G +] +IFN ITS,[ + DOTCAL RFPNTR,[A,[2000,,B]] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + SUBI B,1 + DOTCAL ACCESS,[A,B] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + MOVE B,C +] +BFCLSZ: SUB TP,[2,,2] + POPJ P, + +BFCDSK: TRZ 0,1 + PUSH P,C +IFE ITS,[ + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,0 ; WORD OF CHARS + MOVE A,CHANNO(B) + MOVEI B,7 ; MAKE BYTE SIZE 7 + SFBSZ + JFCL + HRROI B,(P) + MOVNS C + SKIPE C + SOUT + MOVE B,(TP) + SUB P,[1,,1] + SUB TP,[2,,2] +] +IFN ITS,[ + MOVE D,[440700,,A] + DOTCAL SIOT,[CHANNO(B),D,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + POP P,C + JUMPN C,BFCLSD +BFCDS1: MOVNI C,1 ; INDICATE NOT TOHACK BUFFER + JRST BFCLSD + +BFCLS1: HRRZ C,DIRECT-1(B) + MOVSI 0,(JFCL) + CAIE C,6 + MOVE 0,[AOS ACCESS(B)] + PUSH P,0 + HRRZ C,BUFSTR-1(B) + IDIVI C,5 + JUMPE D,BCLS11 + MOVEI A,40 ; PAD WITH SPACES + PUSHJ P,PUTCHR + XCT (P) ; AOS ACCESS IF NECESSARY + SOJG D,.-3 ; TO END OF WORD +BCLS11: POP P,0 + HLLZS ACCESS-1(B) + HRRZ C,BUFSTR-1(B) + CAIE C,BUFLNT*5 + PUSHJ P,BFCLOS + POPJ P, + + +; HERE TO GET A TTY BUFFER + +GETTTY: SKIPN C,EXBUFR(B) ; SKIP IF BUFFERS BACKED UP + JRST TTYWAI + HRRZ D,(C) ; CDR THE LIST + GETYP A,(C) ; CHECK TYPE + CAIE A,TDEFER ; MUST BE DEFERRED + JRST BDCHAN + MOVE C,1(C) ; GET DEFERRED GOODIE + GETYP A,(C) ; BETTER BE CHSTR + CAIE A,TCHSTR + JRST BDCHAN + MOVE A,(C) ; GET FULL TYPE WORD + MOVE C,1(C) + MOVEM D,EXBUFR(B) ; STORE CDR'D LIST + MOVEM A,BUFSTR-1(B) ; MAKE CURRENT BUFFER + MOVEM C,BUFSTR(B) + HRRM A,LSTCH-1(B) + SOJA A,BUFROK + +TTYWAI: PUSHJ P,TTYBLK ; BLOCKED FOR TTY I/O + JRST GETTTY ; SHOULD ONLY RETURN HAPPILY + + ;INTERNAL DEVICE READ ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT, +;CHECKS THAT THE RETURNED VALUE IS OF TYPE CHARACTER, +;AND RETURNS THAT AS THE NEXT CHARACTER IN THE "FILE" + +;H. BRODIE 8/31/72 + +GTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,INTFCN-1(B) + GETYP A,A + CAIE A,TCHRS + JRST BADRET + MOVE A,B +INTRET: POP P,0 ;RESTORE THE ACS + POP P,E + POP P,D + POP P,C + POP TP,B ;RESTORE THE CHANNEL + SUB TP,[1,,1] ;FLUSH $TCHAN...WE DON'T NEED IT + POPJ P, + + +BADRET: ERRUUO EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT + +;INTERNAL DEVICE PRINT ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,(FUNCTION, SUBR, OR RSUBR) +;TO THE CURRENT CHARACTER BEING "PRINTED". + +PTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,$TCHRS ;PUSH THE TYPE "CHARACTER" + PUSH TP,A ;PUSH THE CHAR + PUSH TP,$TCHAN ;PUSH THE CHANNEL + PUSH TP,B + MCALL 2,INTFCN-1(B) ;APPLY THE FUNCTION TO THE CHAR + JRST INTRET + + + +; ROUTINE TO FLUSH OUT A PRINT BUFFER + +MFUNCTION BUFOUT,SUBR + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + + MOVE B,1(AB) +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; GET DIR NAME +; JFCL +; CAMN B,[ASCII /PRINT/] +; JRST .+3 +; CAME B,[+1] +; JRST WRONGD +; TRNE B,1 ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN B,1 ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] + HRRZ 0,-2(B) + TRNN 0,C.PRIN + JRST WRONGD +; TRNE 0,C.BIN ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN 0,C.BIN ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] +; MOVE B,1(AB) +; GETYP 0,BUFSTR-1(B) +; CAIN 0,TCHSTR +; SKIPN A,BUFSTR(B) ; BYTE POINTER? +; JRST BFIN1 +; HRRZ C,BUFSTR-1(B) ; CHARS LEFT +; IDIVI C,5 ; MULTIPLE OF 5? +; JUMPE D,BFIN2 ; YUP NO EXTRAS + +; MOVEI A,40 ; PAD WITH SPACES +; PUSHJ P,PUTCHR ; OUT IT GOES +; XCT (P) ; MAYBE BUMP ACCESS +; SOJG D,.-3 ; FILL + +BFIN2: PUSHJ P,BFCLOS ; WRITE OUT BUFFER + +BFIN1: MOVSI A,TCHAN + JRST FINIS + + + +; FUNCTION TO GET THE FILE LENGTH OF A READ CHANNEL + +MFUNCTION FILLNT,SUBR,[FILE-LENGTH] + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) + PUSHJ P,CFILLE + JRST FINIS + +CFILLE: +IFN 0,[ + MOVEI B,DIRECT-1(B) ; GET CHANNEL TYPE + PUSHJ P,CHRWRD + JFCL + CAME B,[ASCIZ /READ/] + JRST .+3 + PUSH P,[5] ; MULTIPLICATIVE FACTOR FOR READ + JRST .+4 + CAME B,[ASCII /READB/] + JRST WRONGD + PUSH P,[1] ; MULTIPLICATIVE FACTOR FOR READ +] + MOVE C,-2(B) ; GET BITS + MOVEI D,5 ; ASSUME ASCII + TRNE C,C.BIN ; SKIP IF NOT BINARY + MOVEI D,1 + PUSH P,D + MOVE C,B +IFN ITS,[ + .CALL FILL1 + JRST FILLOS ; GIVE HIM A NICE FALSE +] +IFE ITS,[ + MOVE A,CHANNO(C) + PUSH P,[0] + MOVEI C,(P) + MOVE B,[1,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,(P)] ; GET BYTE SIZE + JUMPN D,.+2 + MOVEI D,36. ; HANDLE "0" BYTE SIZE + SUB P,[1,,1] + SIZEF + JRST FILLOS +] + POP P,C +IFN ITS, IMUL B,C +IFE ITS,[ + CAIN C,5 + CAIE D,7 + JRST NOTASC +] +YESASC: MOVE A,$TFIX + POPJ P, + +IFE ITS,[ +NOTASC: MOVEI 0,36. + IDIV 0,D ; BYTES PER WORD + IDIVM B,0 + IMUL C,0 + MOVE B,C + JRST YESASC +] + +IFN ITS,[ +FILL1: SETZ ; BLOCK FOR .CALL TO FILLEN + SIXBIT /FILLEN/ + CHANNO (C) + SETZM B + +FILLOS: MOVE A,CHANNO(C) + MOVE B,[.STATUS A] ;MAKE A CALL TO STATUS TO FIND REASON + LSH A,23. ;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE + IOR B,A ;FIX UP .STATUS + XCT B + MOVE B,C + PUSHJ P,GFALS + POP P, + POPJ P, +] +IFE ITS,[ +FILLOS: MOVE B,C + PUSHJ P,TGFALS + POP P, + POPJ P, +] + + + ; MCHAN LOW-LEVEL I/O GARBAGE (PDL)-ORIGINAL (LIM)-ADDITIONS + +;CALLING ROUTINE: AC-A contains pointer to block of SIXBIT data +; DIR ? DEV ? FNM1 ? FNM2 ? SNM +;RETURNED VALUE : AC-A = +IFN ITS,[ +MOPEN: PUSH P,B + PUSH P,C + MOVE C,FRSTCH ; skip gc and tty channels +CNLP: DOTCAL STATUS,[C,[2000,,B]] + .LOSE %LSFIL + ANDI B,77 + JUMPE B,CHNFND ; found unused channel ? + ADDI C,1 ; try another channel + CAIG C,17 ; are all the channels used ? + JRST CNLP + SETO C, ; all channels used so C = -1 + JRST CHNFUL +CHNFND: MOVEI B,(C) + HLL B,(A) ; M.DIR slot + DOTCAL OPEN,[B,1(A),2(A),3(A),4(A)] + SKIPA + AOS -2(P) ; successful skip when returning +CHNFUL: MOVE A,C + POP P,C + POP P,B + POPJ P, + +MIOT: DOTCAL IOT,[A,B] + JFCL + POPJ P, + +MCLOSE: DOTCAL CLOSE,[A] + JFCL + POPJ P, + +IMPURE + +FRSTCH: 1 + +PURE +] + ;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O + +NOTNET: +BADCHN: ERRUUO EQUOTE BAD-CHANNEL +BDCHAN: ERRUUO EQUOTE BAD-INPUT-BUFFER + +WRONGD: ERRUUO EQUOTE WRONG-DIRECTION-CHANNEL + +CHNCLS: ERRUUO EQUOTE CHANNEL-CLOSED + +BAD6: ERRUUO EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME + +DISLOS: MOVE C,$TCHSTR + MOVE D,CHQUOTE [DISPLAY NOT AVAILABLE] + PUSHJ P,INCONS + MOVSI A,TFALSE + JRST OPNRET + +NOCHAN: ERRUUO EQUOTE ITS-CHANNELS-EXHAUSTED + +MODE1: 232020,,202020 +MODE2: 232023,,330320 + +END + + \ No newline at end of file diff --git a//fopen.mid.61 b//fopen.mid.61 new file mode 100644 index 0000000..eb1619b --- /dev/null +++ b//fopen.mid.61 @@ -0,0 +1,4715 @@ +TITLE OPEN - CHANNEL OPENER FOR MUDDLE + +RELOCATABLE + +;C. REEVE MARCH 1973 + +.INSRT MUDDLE > + +SYSQ + +FNAMS==1 +F==E+1 +G==F+1 + +IFE ITS,[ +IF1, .INSRT STENEX > +] +;THIS PROGRAM HAS ENTRIES: FOPEN, FCLOSE, RENAME, READB, PRINTB, FILECOPY, READSTRING, +; PRINTSTRING, NETSTATE, NETACC, NETS, ACCESS, AND FILE-EXISTS? + +;THESE SUBROUTINES HANDLE I/O STREAMS FOR THE MUDDLE SYSTEM. + +; FOPEN - OPENS A FILE FOR EITHER READING OR WRITING. IT TAKES +; FIVE OPTINAL ARGUMENTS AS FOLLOWS: + +; FOPEN (,,,,) +; +; - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ + +; - FIRST FILE NAME. DEFAULT INPUT OR OUTPUT. + +; - SECOND FILE NAME. DEFAULT MUDDLE. + +; - DEVICE FROM WHICH TO OPEN. DEFAULT IS DSK. + +; - SYSTEM (DIRECTORY) NAME. DEFAULT UNAME. + +; FOPEN RETURNS AN OBJECT OF TYPE CHANNEL IF IT SUCCEEDS OTHERWISE NIL + + +; FCLOSE - CLOSES A FILE. TAKES A CHANNEL OBJECT AS ITS ARGUMENT. IT ALSO TAKES +; ACCESS - DOES A .ACCESS ON A CHARACTER BASIS FOR CHARACTER FILES + + +; A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION + +; CHANNO ;ITS I/O CHANNEL NUMBER. 0 MEANS NOT A REAL CHANNEL. +; DIRECT ;DIRECTION (EITHER READ OR PRINT) +; NAME1 ;FIRST NAME OF FILE AS OPENED. +; NAME2 ;SECOND NAME OF FILE +; DEVICE ;DEVICE UPON WHICH THE CHANNEL IS OPEN +; SNAME ;DIRECTORY NAME +; RNAME1 ;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS) +; RNAME2 ;REAL SECOND NAME +; RDEVIC ;REAL DEVICE +; RSNAME ;SYSTEM OR DIRECTORY NAME +; STATUS ;VARIOUS STATUS BITS +; IOINS ;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER +; ACCESS ;ACCESS POINTER FOR RAND ACCESS (OR USED FOR DISPLAY INFO) +; RADX ;RADIX FOR CHANNELS NUMBER CONVERSION + +; *** THE FOLLOWING FIELDS FOR OUTPUT ONLY *** +; LINLN ;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE +; CHRPOS ;CURRENT POSITION ON CURRENT LINE +; PAGLN ;LENGTH OF A PAGE +; LINPOS ;CURRENT LINE BEING WRITTEN ON + +; *** THE FOLLOWING FILEDS FOR INPUT ONLY *** +; EOFCND ;GETS EVALUATED ON EOF +; LSTCH ;BACKUP CHARACTER +; WAITNS ;FOR TTY INPUT, BECOMES A .SLEEP WHEN WAITING +; EXBUFR ;FOR TTY INPUT, CONTAINS A WAITING BUFFER LIST +; BUFSTR ;A CHARACTER STRING USED AS BUFFER FOR NON-TTY DEVICES + +; THIS DEFINES THE LENGTH OF THE NON-TTY BUFFER +BUFLNT==100 + +;THIS DEFINES BLOCK MODE BIT FOR OPENING +BLOCKM==2 ;DEFINED IN THE LEFT HALF +IMAGEM==4 + + +;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME + + CHANLNT==4 ;INITIAL CHANNEL LENGTH + +; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS +BUFRIN==-1 ;SPECIAL HACK SO LOSERS WON'T SEE TTY BUFFER +SCRPTO==-3 ;SPECIAL HACK FOR SCRIPT CHANNELS +PROCHN: + +IRP A,,[[CHANNO,FIX],[DIRECT,CHSTR] +[NAME1,CHSTR],[NAME2,CHSTR],[DEVICE,CHSTR],[SNAME,CHSTR] +[RNAME1,CHSTR],[RNAME2,CHSTR],[RDEVIC,CHSTR],[RSNAME,CHSTR] +[STATUS,FIX],[IOINS,FIX],[LINLN,FIX],[CHRPOS,FIX],[PAGLN,FIX],[LINPOS,FIX] +[ACCESS,FIX],[RADX,FIX],[BUFSTR,CHSTR]] + + IRP B,C,[A] + B==CHANLNT-3 + T!C,,0 + 0 + .ISTOP + TERMIN + CHANLNT==CHANLNT+2 +TERMIN + + +; EQUIVALANCES FOR CHANNELS + +EOFCND==LINLN +LSTCH==CHRPOS +WAITNS==PAGLN +EXBUFR==LINPOS +DISINF==BUFSTR ;DISPLAY INFO +INTFCN==BUFSTR ;FUNCTION (OR SUBR, OR RSUBR) TO BE APPLIED FOR INTERNAL CHNLS + + +;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS + +IRP A,,[IOIN2,ECHO,CHRCNT,ERASCH,KILLCH,BRKCH,ESCAP,SYSCHR,BRFCHR,BRFCH2,BYTPTR] +A==.IRPCNT +TERMIN + +EXTBFR==BYTPTR+1+<100./5> ;LENGTH OF ADD'L BUFFER + + + + +.GLOBAL IPNAME,MOPEN,MCLOSE,MIOT,ILOOKU,6TOCHS,ICLOS,OCLOS,RGPARS,RGPRS +.GLOBAL OPNCHN,CHMAK,READC,TYO,SYSCHR,BRFCHR,LSTCH,BRFCH2,EXTBFR +.GLOBAL CHRWRD,STRTO6,TTYBLK,WAITNS,EXBUFR,TTICHN,TTOCHN,GETCHR,IILIST +.GLOBAL CHANNO,STATUS,LINPOS,PAGLN,CHRPOS,LINLN,IOINS,ACCESS,ADDNUL +.GLOBAL DIRECT,DISINF,RADX,EOFCND,BUFSTR,MODE1,MODE2,GCHACK,GMTYO,INMTYO +.GLOBAL T.CHAN,NAME1,BFCLOS,DOIOTI,DOIOTO,DOACCS,NOTTY,DEMFLG,BYTDOP,TNXIN +.GLOBAL DISOPN,DISROP,DISCLS,DCHAR,DISLNL,DISPGL,INSTAT,MTYO,CIREST +.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP,N.CHNS +.GLOBAL REOPN,QUITTE,CHNL0,CHNL1,BUFRIN,IOIN2,IFALSE,GFALS,IDVAL,PVSTOR,SPSTOR +.GLOBAL BADCHN,WRONGD,CHNCLS,GSNAME,GIBLOK,APLQ,NAPT,ICONS,INCONS,IBLOCK,IDVAL1 +.GLOBAL GRB,GWB,R1CHAR,W1CHAR,BFCLS1,TTYOP2,MPOPJ,COMPER,R1C,W1C,WXCT,RXCT +.GLOBAL TMTNXS,TNXSTR,RDEVIC,CPCH1,RCYCHN,CGFALS,CISTNG,CFILLE,FRSTCH +.GLOBAL TGFALS,ONINT + +.VECT.==40000 + +; PAIR MOVING MACRO + +DEFINE PMOVEM A,B + MOVE 0,A + MOVEM 0,B + MOVE 0,A+1 + MOVEM 0,B+1 + TERMIN + +; DEFINITIONS OF THE OFFSETS INTO THE TP STACK FOR OPEN + +T.SPDL==0 ; SAVES P STACK BASE +T.DIR==2 ; CONTAINS DIRECTION AND MODE +T.NM1==4 ; NAME 1 OF FILE +T.NM2==6 ; NAME 2 OF FILE +T.DEV==10 ; DEVICE NAME +T.SNM==12 ; SNAME +T.XT==14 ; EXTRA CRUFT IF NECESSARY +T.CHAN==16 ; CHANNEL AS GENERATED + +; OFFSETS FROM PSTACK BASE (USED FOR OPENS, .RCHST AND .FDELES) + +S.DIR==0 ; CODE FOR DIRECTION 0-IN, 1-OUT, 2-BIN, 3-BOUT,4-DISPLAY + ; S.DIR(P) = ,, +IFN ITS,[ +S.DEV==1 ; SIXBIT DEVICE RIGHT JUSTIFIED +S.NM1==2 ; SIXBIT NAME1 +S.NM2==3 ; SIXBIT NAME2 +S.SNM==4 ; SIXBIT SNAME +S.X1==5 ; TEMPS +S.X2==6 +S.X3==7 +] + +IFE ITS,[ +S.DEV==1 +S.X1==2 +S.X2==3 +S.X3==4 +] + + +; FLAGS SPECIFYING STATE OF THE WORLD AT VARIOUS TIMES + +NOSTOR==400000 ; ON MEANS DONT BUILD NEW STRINGS +MSTNET==200000 ; ON MEANS ONLY THE "NET" DEVICE CAN WIN +SNSET==100000 ; FLAG, SNAME SUPPLIED +DVSET==040000 ; FLAG, DEV SUPPLIED +N2SET==020000 ; FLAG, NAME2 SET +N1SET==010000 ; FLAG, NAME1 SET +4ARG==004000 ; FLAG, CONSIDER ARGS TO BE 4 STRINGS + +RMT [EXPUNGE N1SET,N2SET,DVSET,SNSET,MSTNET,NOSTOR +] + +; TABLE OF LEGAL MODES + +MODES: IRP A,,[READ,PRINT,READB,PRINTB,PRINTO,PRINAO] + SIXBIT /A/ + TERMIN +NMODES==.-MODES + +MODCOD: 0?1?2?3?3?1 +; TABLE OF KNOWN DEVICES AND A POINTER TO THEIR OPENERS + +IFN ITS,[ +DEVSTB: IRP A,,[DSK,TTY,USR,STY,ST,NET,INT,PTP,PTR,UT,T,NUL] + SIXBIT /A/ ; DEVICE NAMES + TERMIN + +DEVS: IRP B,,[ODSK,OTTY,OUSR,OSTY,OSTY,ONET,OINT,OPTP,OPTP,OUTN,OTTY,ONUL] + SETZ B ; POINTERS + TERMIN +] + +IFE ITS,[ +DEVSTB: IRP A,,[PS,SS,SRC,DSK,TTY,INT,NET] + SIXBIT /A/ + TERMIN + +DEVS: IRP B,,[ODSK,ODSK,ODSK,ODSK,OTTY,OINT,ONET] + SETZ B + TERMIN +] +NDEVS==.-DEVS + + + +;SUBROUTINE TO DO OPENING BEGINS HERE + +MFUNCTION NFOPEN,SUBR,[OPEN-NR] + + JRST FOPEN1 + +MFUNCTION FOPEN,SUBR,[OPEN] + +FOPEN1: ENTRY + PUSHJ P,MAKCHN ;MAKE THE CHANNEL + PUSHJ P,OPNCH ;NOW OPEN IT + JUMPL B,FINIS + SUB D,[4,,4] ; TOP THE CHANNEL + MOVEM D,RCYCHN+1 ; RECYCLE DEAD CHANNEL + SETZM (D) ; ZAP IT + MOVEI C,1(D) + HRLI C,(D) + BLT C,CHANLNT-1(D) + JRST FINIS + +; SUBR TO JUST CREATE A CHANNEL + +IMFUNCTION CHANNEL,SUBR + + ENTRY + PUSHJ P,MAKCHN + MOVSI A,TCHAN + JRST FINIS + + + + +; THIS ROUTINE PARSES ARGUMENTS TO FOPEN ETC. AND BUILDS A CHANNEL BUT DOESN'T OPEN IT + +MAKCHN: PUSH TP,$TPDL + PUSH TP,P ; POINT AT CURRENT STACK BASE + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE READ + MOVEI E,10 ; SLOTS OF TP NEEDED + PUSH TP,[0] + SOJG E,.-1 + MOVEI E,0 + EXCH E,(P) ; GET RET ADDR IN E +IFE ITS, PUSH P,[0] +IRP ATM,,[DEV,NM1,NM2,SNM]MDF,,[DSK,INPUT,>,[ ]]TMDF,,[DSK,INPUT,MUD,[ ]] + MOVE B,IMQUOTE ATM +IFN ITS, PUSH P,E + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TCHSTR + JRST MAK!ATM + + MOVE A,$TCHSTR +IFN ITS, MOVE B,CHQUOTE MDF +IFE ITS, MOVE B,CHQUOTE TMDF +MAK!ATM: + MOVEM A,T.!ATM(TB) + MOVEM B,T.!ATM+1(TB) +IFN ITS,[ + POP P,E + PUSHJ P,STRTO6 ; RESULT LEFT ON P STACK AS DESIRED +] + TERMIN + PUSH TP,[0] ; PUSH SLOTS + PUSH TP,[0] + + PUSH P,[0] ; EXT SLOTS + PUSH P,[0] + PUSH P,[0] + PUSH P,E ; PUSH RETURN ADDRESS + MOVEI A,0 + + JUMPGE AB,MAKCH0 ; NO ARGS, ALREADY DONE + GETYP 0,(AB) ; 1ST ARG MUST BE A STRING + CAIE 0,TCHSTR + JRST WTYP1 + MOVE A,(AB) ; GET ARG + MOVE B,1(AB) + PUSHJ P,CHMODE ; CHECK OUT OPEN MODE + + PMOVEM (AB),T.DIR(TB) ; SAVE MODE NAME IN TEMPS + ADD AB,[2,,2] ; BUMP PAST DIRECTION + MOVEM AB,ABSAV(TB) + MOVEI A,0 + JUMPGE AB,MAKCH0 ; CHECK NAME1 BASED ON JUST MODE + + MOVEI 0,0 ; FLAGS PRESET + PUSHJ P,RGPARS ; PARSE THE STRING(S) + JRST TMA + +; ARGUMENTS PARSED, DO FINAL CHECKS AND BUILD CHANNEL + +MAKCH0: +IFN ITS,[ + MOVE C,T.SPDL+1(TB) + MOVE D,S.DEV(C) ; GET DEV +] +IFE ITS,[ + MOVE A,T.DEV(TB) + MOVE B,T.DEV+1(TB) + PUSHJ P,STRTO6 + POP P,D + HLRZS D + MOVE C,T.SPDL+1(TB) + MOVEM D,S.DEV(C) +] +IFE ITS, CAIE D,(SIXBIT /INT/);INTERNAL? +IFN ITS, CAME D,[SIXBIT /INT /] + JRST CHNET ; NO, MAYBE NET + SKIPN T.XT+1(TB) ; WAS FCN SUPPLIED? + JRST TFA + +; FALLS TROUGH IF SKIP + + + +; NOW BUILD THE CHANNEL + +ARGSOK: MOVEI A,CHANLNT ; GET LENGTH + SKIPN B,RCYCHN+1 ; RECYCLE? + PUSHJ P,GIBLOK ; GET A BLOCK OF STUFF + SETZM RCYCHN+1 + ADD B,[4,,4] ; HIDE THE TTY BUFFER SLOT + PUSH TP,$TCHAN + PUSH TP,B + HRLI C,PROCHN ; POINT TO PROTOTYPE + HRRI C,(B) ; AND NEW ONE + BLT C,CHANLN-5(B) ; CLOBBER + MOVSI C,TLIST ; TO GIVE HIM A CLEAN LIST OF SCRIPT CHANS + HLLM C,SCRPTO-1(B) + +; NOW BLT IN STUFF FROM THE STACK + + MOVSI C,T.DIR(TB) ; DIRECTION + HRRI C,DIRECT-1(B) + BLT C,SNAME(B) + MOVEI C,RNAME1-1(B) ; NOW "REAL" SLOTS + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + MOVE B,IMQUOTE MODE + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TFIX + JRST .+3 + MOVE B,(TP) + POPJ P, + + MOVE C,(TP) +IFE ITS,[ + ANDI B,403776 ; ONLY ALLOW NON-CRITICAL BITSS +] + HRRM B,-4(C) ; HIDE BITS + MOVE B,C + POPJ P, + +; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN + +CHNET: +IFN ITS,[ + CAME D,[SIXBIT /NET /] ; IS IT NET + JRST MAKCH1] +IFE ITS,[ + CAIE D,(SIXBIT /NET/) ; IS IT NET + JRST ARGSOK] + MOVSI D,TFIX ; FOR TYPES + MOVEI B,T.NM1(TB) ; MAKE SURE ALL ARE FIXED + PUSHJ P,CHFIX + MOVEI B,T.NM2(TB) + PUSHJ P,CHFIX + MOVEI B,T.SNM(TB) + LSH A,-1 ; SKIP DEV FLAG + PUSHJ P,CHFIX + JRST ARGSOK + +MAKCH1: TRNN A,MSTNET ; CANT HAVE SEEN A FIX + JRST ARGSOK + JRST WRONGT + +IFN ITS,[ +CHFIX: TRNE A,N1SET ; SKIP IF NOT SPECIFIED + JRST CHFIX1 + SETOM 1(B) ; SET TO -1 + SETOM S.NM1(C) + MOVEM D,(B) ; CORRECT TYPE +] +IFE ITS,CHFIX: + GETYP 0,(B) + CAIE 0,TFIX + JRST PARSQ +CHFIX1: ADDI C,1 ; POINT TO NEXT FIELD + LSH A,-1 ; AND NEXT FLAG + POPJ P, +PARSQ: CAIE 0,TCHSTR + JRST WRONGT +IFE ITS, POPJ P, +IFN ITS,[ + PUSH P,A + PUSH P,C + PUSH TP,(B) + PUSH TP,1(B) + SUBI B,(TB) + PUSH P,B + MCALL 1,PARSE + GETYP 0,A + CAIE 0,TFIX + JRST WRONGT + POP P,C + ADDI C,(TB) + MOVEM A,(C) + MOVEM B,1(C) + POP P,C + POP P,A + POPJ P, +] + + +; SUBROUTINE TO CHECK VALIDITY OF MODE AND SAVE A CODE + +CHMODE: PUSHJ P,CHMOD ; DO IT + MOVE C,T.SPDL+1(TB) + HRRZM A,S.DIR(C) + POPJ P, + +CHMOD: PUSHJ P,STRTO6 ; TO SIXBIT + POP P,B ; VALUE ENDSUP ON STACK, RESTORE IT + + MOVSI A,-NMODES ; SCAN TO SEE IF LEGAL MODE + CAME B,MODES(A) + AOBJN A,.-1 + JUMPGE A,WRONGD ; ILLEGAL MODE NAME + MOVE A,MODCOD(A) + POPJ P, + + +IFN ITS,[ +; RGPARS -- PARSE THE STRINGS COMPRISING FILE NAMES INTO STANDARD ITS GOODIES + +RGPRS: MOVEI 0,NOSTOR ; DONT STORE STRINGS IF ENTER HERE + +RGPARS: CAMGE AB,[-7,,] ; MULTI-STRING CASE POSSIBLE? + IORI 0,4ARG ; 4 STRING CASE + HRLM 0,(P) ; LH IS FLAGS FOR THIS PROG + MOVSI E,-4 ; FIELDS TO FILL + +RPARGL: GETYP 0,(AB) ; GET TYPE + CAIE 0,TCHSTR ; STRING? + JRST ARGCLB ; NO, JUST CLOBBER IT IN RAW + JUMPGE E,CPOPJ ; DON'T DO ANY MORE + PUSH TP,(AB) ; GET AN ARG + PUSH TP,1(AB) + +FPARS: PUSH TP,-1(TP) ; ANOTHER COPY + PUSH TP,-1(TP) + HLRZ 0,(P) + TRNN 0,4ARG + PUSHJ P,FLSSP ; NO LEADING SPACES + MOVEI A,0 ; WILL HOLD SIXBIT + MOVEI B,6 ; CHARS PER 6BIT WORD + MOVE C,[440600,,A] ; BYTE POINTER INTO A + +FPARSL: HRRZ 0,-1(TP) ; GET COUNT + JUMPE 0,PARSD ; DONE + SOS -1(TP) ; COUNT + ILDB 0,(TP) ; CHAR TO 0 + + CAIE 0," ; FILE NAME QUOTE? + JRST NOCNTQ + HRRZ 0,-1(TP) + JUMPE 0,PARSD + SOS -1(TP) + ILDB 0,(TP) ; USE THIS + JRST GOTCNQ + +NOCNTQ: HLL 0,(P) + TLNE 0,4ARG + JRST GOTCNQ + ANDI 0,177 + CAIG 0,40 ; SPACE? + JRST NDFLD ; YES, TERMINATE THIS FIELD + CAIN 0,": ; DEVICE ENDED? + JRST GOTDEV + CAIN 0,"; ; SNAME ENDED + JRST GOTSNM + +GOTCNQ: ANDI 0,177 + PUSHJ P,A0TO6 ; CONVERT TO 6BIT AND CHECK + + JUMPE B,FPARSL ; IGNORE IF AREADY HAVE 6 + IDPB 0,C + SOJA B,FPARSL + +; HERE IF SPACE ENCOUNTERED + +NDFLD: MOVEI D,(E) ; COPY GOODIE + PUSHJ P,FLSSP ; FLUSH REDUNDANT SPACES + JUMPE 0,PARSD ; NO CHARS LEFT + +NFL0: PUSH P,A ; SAVE SIXBIT WORD + SKIPGE -1(P) ; SKIP IF STRING TO BE STORED + JRST NFL1 + PUSH TP,$TAB ; PREVENT AB LOSSAGE + PUSH TP,AB + PUSHJ P,6TOCHS ; CONVERT TO STRING + MOVE AB,(TP) + SUB TP,[2,,2] +NFL1: HRRZ 0,-1(TP) ; RESTORE CHAR COUNT + +NFL2: MOVEI C,(D) ; COPY REL PNTR + SKIPGE -1(P) ; SKIP IF STRINGS TO BE STORED + JRST NFL3 + ASH D,1 ; TIMES 2 + ADDI D,T.NM1(TB) + MOVEM A,(D) ; STORE + MOVEM B,1(D) +NFL3: MOVSI A,N1SET ; FLAG IT + LSH A,(C) + IORM A,-1(P) ; AND CLOBBER + MOVE D,T.SPDL+1(TB) ; GET P BASE + POP P,@SIXTBL(C) ; AND STORE SIXBIT OF IT + + POP TP,-2(TP) ; MAKE NEW STRING POINTER + POP TP,-2(TP) + JUMPE 0,.+3 ; SKIP IF NO MORE CHARS + AOBJN E,FPARS ; MORE TO PARSE? +CPOPJ: POPJ P, ; RETURN, ALL DONE + + SUB TP,[2,,2] ; FLUSH OLD STRING + ADD E,[1,,1] + ADD AB,[2,,2] ; BUMP ARG + MOVEM AB,ABSAV(TB) + JUMPL AB,RPARGL ; AND GO ON +CPOPJ1: AOS A,(P) ; PREPARE TO WIN + HLRZS A + POPJ P, + + + +; HERE IF STRING HAS ENDED + +PARSD: PUSH P,A ; SAVE 6 BIT + MOVE A,-3(TP) ; CAN USE ARG STRING + MOVE B,-2(TP) + MOVEI D,(E) + JRST NFL2 ; AND CONTINUE + +; HERE IF JUST READ DEV + +GOTDEV: MOVEI D,2 ; CODE FOR DEVICE + JRST GOTFLD ; GOT A FIELD + +; HERE IF JUST READ SNAME + +GOTSNM: MOVEI D,3 +GOTFLD: PUSHJ P,FLSSP + SOJA E,NFL0 + + +; HERE FOR NON STRING ARG ENCOUNTERED + +ARGCLB: SKIPGE (P) ; IF NOT STORING, CONSIDER THIS THE END + + POPJ P, + MOVE C,T.SPDL+1(TB) ; GET P-BASE + MOVE A,S.DEV(C) ; GET DEVICE + CAME A,[SIXBIT /INT /]; IS IT THE INTERNAL DEVICE + JRST TRYNET ; NO, COUD BE NET + MOVE A,0 ; OFFNEDING TYPE TO A + PUSHJ P,APLQ ; IS IT APPLICABLE + JRST NAPT ; NO, LOSE + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] ; MUST BE LAST ARG + MOVEM AB,ABSAV(TB) + JUMPL AB,TMA + JRST CPOPJ1 ; ELSE SUCCESSFUL RETURN +TRYNET: CAIE 0,TFIX ; FOR NET DEV, ARGS MUST BE FIX + JRST WRONGT ; TREAT AS WRONG TYPE + MOVSI A,MSTNET ; BETTER BE NET EVENTUALLY + IORM A,(P) ; STORE FLAGS + MOVSI A,TFIX + MOVE B,1(AB) ; GET NUMBER + MOVEI 0,(E) ; MAKE SURE NOT DEVICE + CAIN 0,2 + JRST WRONGT + PUSH P,B ; SAVE NUMBER + MOVEI D,(E) ; SET FOR TABLE OFFSETS + MOVEI 0,0 + ADD TP,[4,,4] + JRST NFL2 ; GO CLOBBER IT AWAY +] + + +; ROUTINE TO FLUSH LEADING SPACES FROM A FIELD + +FLSSP: HRRZ 0,-1(TP) ; GET CHR COUNNT + JUMPE 0,CPOPJ ; FINISHED STRING +FLSS1: MOVE B,(TP) ; GET BYTR + ILDB C,B ; GETCHAR + CAIE C,^Q ; DONT FLUSH CNTL-Q + CAILE C,40 + JRST FLSS2 + MOVEM B,(TP) ; UPDATE BYTE POINTER + SOJN 0,FLSS1 + +FLSS2: HRRM 0,-1(TP) ; UPDATE STRING + POPJ P, + +IFN ITS,[ +;TABLE FOR STFUFFING SIXBITS AWAY + +SIXTBL: SETZ S.NM1(D) + SETZ S.NM2(D) + SETZ S.DEV(D) + SETZ S.SNM(D) + SETZ S.X1(D) +] + +RDTBL: SETZ RDEVIC(B) + SETZ RNAME1(B) + SETZ RNAME2(B) + SETZ RSNAME(B) + + + +IFE ITS,[ + +; TENEX VERSION OF FILE NAME PARSER (ONLY ACCEPT ARGS IN SINGLE STRING) + + +RGPRS: MOVEI 0,NOSTOR + +RGPARS: HRLM 0,(P) ; SAVE FOR STORE CHECKING + CAMGE AB,[-2,,] ; MULTI-STRING CASE POSSIBLE? + JRST TN.MLT ; YES, GO PROCESS +RGPRSS: GETYP 0,(AB) ; CHECK ARG TYPE + CAIE 0,TCHSTR + JRST WRONGT ; FOR NOW ONLY STRING ARGS WIN + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,FLSSP ; FLUSH LEADING SPACES + PUSHJ P,RGPRS1 + ADD AB,[2,,2] + MOVEM AB,ABSAV(TB) +CHKLST: JUMPGE AB,CPOPJ1 + SKIPGE (P) ; IF FROM OPEN, ALLOW ONE MORE + POPJ P, + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] + MOVEM AB,ABSAV(TB) + JUMPL AB,TMA +CPOPJ1: AOS (P) + POPJ P, + +RGPRS1: PUSH P,[0] ; ALLOW A DEVICE SPEC +TN.SNM: MOVE A,(TP) + HRRZ 0,-1(TP) + JUMPE 0,RPDONE + ILDB A,A + CAIE A,"< ; START "DIRECTORY" ? + JRST TN.N1 ; NO LOOK FOR NAME1 + SETOM (P) ; DEV NOT ALLOWED + IBP (TP) ; SKIP CHAR + SOS -1(TP) + PUSHJ P,TN.CNT ; COUNT CHARS TO ">" OR "." + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN3 + PUSH TP,0 + PUSH TP,C +TN.SN1: PUSHJ P,TN.CNT ; COUNT CHARS TO ">" + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN2 + MOVEM 0,-1(TP) + MOVEM C,(TP) + JRST TN.SN1 +TN.SN2: HRRZ B,-3(TP) + SUB B,0 + SUBI B,1 + SUB TP,[2,,2] +TN.SN3: CAIE A,"> ; SKIP IF WINS + JRST ILLNAM + PUSHJ P,TN.CPS ; COPY TO NEW STRING + HLLOS T.SPDL(TB) + MOVEM A,T.SNM(TB) + MOVEM B,T.SNM+1(TB) + +TN.N1: PUSHJ P,TN.CNT + JUMPE B,RPDONE + CAIE A,": ; GOT A DEVICE + JRST TN.N11 + SKIPE (P) + JRST ILLNAM + SETOM (P) + PUSHJ P,TN.CPS + MOVEM A,T.DEV(TB) + MOVEM B,T.DEV+1(TB) + JRST TN.SNM ; NOW LOOK FOR SNAME + +TN.N11: CAIE A,"> + CAIN A,"< + JRST ILLNAM + MOVEM A,(P) ; SAVE END CHAR + PUSHJ P,TN.CPS ; GEN STRING + MOVEM A,T.NM1(TB) + MOVEM B,T.NM1+1(TB) + +TN.N2: SKIPN A,(P) ; GET CHAR BACK + JRST RPDONE + CAIN A,"; ; START VERSION? + JRST .+3 + CAIE A,". ; START NAME2? + JRST ILLNAM ; I GIVE UP!!! + HRRZ B,-1(TP) ; GET RMAINS OF STRING + PUSHJ P,TN.CPS ; AND COPY IT + MOVEM A,T.NM2(TB) + MOVEM B,T.NM2+1(TB) +RPDONE: SUB P,[1,,1] ; FLUSH TEMP + SUB TP,[2,,2] +CPOPJ: POPJ P, + +TN.CNT: HRRZ 0,-1(TP) ; CHAR COUNT + MOVE C,(TP) ; BPTR + MOVEI B,0 ; INIT COUNT TO 0 + +TN.CN1: MOVEI A,0 ; IN CASE RUN OUT + SOJL 0,CPOPJ ; RUN OUT? + ILDB A,C ; TRY ONE + CAIE A," ; TNEX FILE QUOTE? + JRST TN.CN2 + SOJL 0,CPOPJ + IBP C ; SKIP QUOTED CHAT + ADDI B,2 + JRST TN.CN1 + +TN.CN2: CAIE A,"< + CAIN A,"> + POPJ P, + + CAIE A,". + CAIN A,"; + POPJ P, + CAIN A,": + POPJ P, + AOJA B,TN.CN1 + +TN.CPS: PUSH P,B ; # OF CHARS + MOVEI A,4(B) ; ADD 4 TO B IN A + IDIVI A,5 + PUSHJ P,IBLOCK ; GET BLOCK OF WORDS FOR STRING + + POP P,C ; CHAR COUNT BACK + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + HRRI A,(C) ; CHAR STRING + MOVE D,B ; COPY BYTER + + JUMPE C,CPOPJ + ILDB 0,(TP) ; GET CHAR + IDPB 0,D ; AND STROE + SOJG C,.-2 + + MOVNI C,(A) ; - LENGTH TO C + ADDB C,-1(TP) ; DECREMENT WORDS COUNT + TRNN C,-1 ; SKIP IF EMPTY + POPJ P, + IBP (TP) + SOS -1(TP) ; ELSE FLUSH TERMINATOR + POPJ P, + +ILLNAM: ERRUUO EQUOTE ILLEGAL-TENEX-FILE-NAME + +TN.MLT: MOVE A,AB ; AOBJN POINTER TO ARGS IN A + +TN.ML1: GETYP 0,(A) ; IS THIS ARG OF RIGHT TYPE + CAIE 0,TFIX + CAIN 0,TCHSTR + JRST .+2 + JRST RGPRSS ; ASSUME SINGLE STRING + ADD A,[2,,2] + JUMPL A,TN.ML1 ; TRY NEXT ARG IF ANY LEFT + + MOVEI 0,T.NM1(TB) ; 1ST WORD OF DESTINATION + HLRO A,AB ; MINUS NUMBER OF ARGS IN A + MOVN A,A ; NUMBER OF ARGS IN A + SUBI A,1 + CAMGE AB,[-10,,0] + MOVEI A,7 ; IF MORE THAN 10 ARGS, PUT 7 + ADD A,0 ; LAST WORD OF DESTINATION + HRLI 0,(AB) + BLT 0,(A) ; BLT 'EM IN + ADD AB,[10,,10] ; SKIP THESE GUYS + MOVEM AB,ABSAV(TB) + JRST CHKLST + +] + + +; ROUTINE TO OPEN A CHANNEL FOR ANY DEVICE. NAMES ARE ASSUMED TO ALREADY +; BE ON BOTH TP STACK AND P STACK + +OPNCH: MOVE C,T.SPDL+1(TB) ; GET PDL BASE + HRRZ A,S.DIR(C) + ANDI A,1 ; JUST WANT I AND O +IFE ITS,[ + HRLM A,S.DEV(C) +; .TRANS S.DEV(C) ; UNDO ANY TRANSLATIONS +; JRST TRLOST ; COMPLAIN +] +IFN ITS,[ + HRLM A,S.DIR(C) +] + +IFN ITS,[ + MOVE A,S.DEV(C) ; GET SIXBIT DEVICE CODE +] + +IFE ITS,[HRLZS A,S.DEV(C) +] + + MOVSI B,-NDEVS ; AOBJN COUNTER +DEVLP: SETO D, + MOVE 0,DEVSTB(B) ; GET ONE FROM TABLE + MOVE E,A +DEVLP1: AND E,D ; FLUSH POSSIBLE DIGITNESS + CAMN 0,E + JRST CHDIGS ; MAKE SURE REST IS DIGITS + LSH D,6 + JUMPN D,DEVLP1 ; KEEP TRUCKING UNTIL DONE + +; WASN'T THAT DEVICE, MOVE TO NEXT +NXTDEV: AOBJN B,DEVLP + JRST ODSK ; UNKNOWN DEVICE IS ASSUMED TO BE DISK + +IFN ITS,[ +OUSR: HRRZ A,S.DIR(C) ; BLOCK OR UNIT? + TRNE A,2 ; SKIP IF UNIT + JRST ODSK + PUSHJ P,OPEN1 ; OPEN IT + PUSHJ P,FIXREA ; AND READCHST IT + MOVE B,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVE 0,[PUSHJ P,DOIOT] ; GET AN IOINS + MOVEM 0,IOINS(B) + MOVE C,T.SPDL+1(TB) + HRRZ A,S.DIR(C) + TRNN A,1 + JRST EOFMAK + MOVEI 0,80. + MOVEM 0,LINLN(B) + JRST OPNWIN + +OSTY: HLRZ A,S.DIR(C) + IORI A,10 ; THE DONT LOSE BIT (DONT HANG ON INPUT DO ON OUTPUT) + HRLM A,S.DIR(C) + JRST OUSR +] + +; MAKE SURE DIGITS EXIST + +CHDIGS: SETCA D, + JUMPE D,DISPA ; NO DIGITS, WIN IMMEDIATE + MOVE E,A + AND E,D ; LEAVES ONLY DIGITS, IF WINNING + LSH E,6 + LSH D,6 + JUMPG D,.-2 ; KEEP GOING TIL DIGITS LEFT SHIFTED + JRST CHDIGN + +CHDIG1: CAIG D,'9 + CAIGE D,'0 + JRST NXTDEV ; NOT A DIGIT, LOSE + JUMPE E,DISPA ; IF THAT'S ALL THE CHARACTERS, WIN! +CHDIGN: SETZ D, + ROTC D,6 ; GET NEXT CHARACTER INTO D + JRST CHDIG1 ; GO TEST? + +; HERE TO DISPATCH IF SUCCESSFUL + +DISPA: JRST @DEVS(B) + + +IFN ITS,[ + +; DISK DEVICE OPNER COME HERE + +ODSK: MOVE A,S.SNM(C) ; GET SNAME + .SUSET [.SSNAM,,A] ; CLOBBER IT + PUSHJ P,OPEN0 ; DO REAL LIVE OPEN +] +IFE ITS,[ + +; TENEX DISK FILE OPENER + +ODSK: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + PUSHJ P,STSTK ; EXPAND STRING ONTO STACK (E POINTS TO OLD P) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; GET DIR NAME + MOVE C,(P) + MOVE D,T.SPDL+1(TB) + HRRZ D,S.DIR(D) + CAME C,[SIXBIT /PRINAO/] + CAMN C,[SIXBIT /PRINTO/] + IORI D,100 ; TURN ON BIT TO SAY USE OLD FILE + MOVSI A,101 ; START SETTING UP BITS EXTRA BIT FOR MSB + TRNE D,1 ; SKIP IF INPUT + TRNE D,100 ; WITE OVER? + TLOA A,100000 ; FORCE OLD VERSION + TLO A,600000 ; FORCE NEW VERSION + HRROI B,1(E) ; POINT TO STRING + GTJFN + TDZA 0,0 ; SAVE FACT OF NO SKIP + MOVEI 0,1 ; INDICATE SKIPPED + POP P,C ; RECOVER OPEN MODE SIXBIT + MOVE P,E ; RESTORE PSTACK + JUMPE 0,GTJLOS ; FIND OUT WHAT HAPPENED + + MOVE B,T.CHAN+1(TB) ; GET CHANNEL + HRRZ 0,-4(B) ; FUNNY MODE BITS + HRRZM A,CHANNO(B) ; SAVE IT + ANDI A,-1 ; READ Y TO DO OPEN + MOVSI B,440000 ; USE 36. BIT BYES + HRRI B,200000 ; ASSUME READ +; CAMN C,[SIXBIT /READB/] +; TRO B,2000 ; TURN ON THAWED IF READB + IOR B,0 + TRNE D,1 ; SKIP IF READ + HRRI B,300000 ; WRITE BIT + HRRZ 0,FSAV(TB) ; SEE IF REF DATE HACK + CAIN 0,NFOPEN + TRO B,400 ; SET DON'T MUNG REF DATE BIT + MOVE E,B ; SAVE BITS FOR REOPENS + OPENF + JRST OPFLOS + MOVE B,[2,,11] ; GET LENGTH & BYTE SIZE + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + GTFDB + LDB 0,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + CAIN 0,7 + JRST SIZASC + CAIN 0,36. + SIZEF ; USE OPENED SIZE + JFCL + IMULI B,5 ; TO BYTES +SIZASC: MOVEI 0,C.OPN+C.READ+C.DISK + TRNE D,1 ; SKIP FOR READ + MOVEI 0,C.OPN+C.PRIN+C.DISK + TRNE D,2 ; SKIP IF NOT BINARY FILE + TRO 0,C.BIN + HRL 0,B + MOVE B,T.CHAN+1(TB) + TRNE D,1 + HLRM 0,LSTCH-1(B) ; SAVE CURRENT LENGTH + MOVEM E,STATUS(B) + HRRM 0,-2(B) ; MUNG THOSE BITS + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + PUSHJ P,TMTNXS ; GET STRING FROM TENEX + MOVE B,CHANNO(B) ; JFN TO A + HRROI A,1(E) ; BASE OF STRING + MOVE C,[111111,,140001] ; WEIRD CONTROL BITS + JFNS ; GET STRING + MOVEI B,1(E) ; POINT TO START OF STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; MAKE INTO A STRING + SUB P,E ; BACK TO NORMAL + PUSH TP,A + PUSH TP,B + PUSHJ P,RGPRS1 ; PARSE INTO FIELDS + MOVE B,T.CHAN+1(TB) + MOVEI C,RNAME1-1(B) + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + JRST OPBASC +OPFLOS: MOVEI C,(A) ; SAVE ERROR CODE + MOVE B,T.CHAN+1(TB) + HRRZ A,CHANNO(B) ; JFN BACK TO A + RLJFN ; TRY TO RELEASE IT + JFCL + MOVEI A,(C) ; ERROR CODE BACK TO A + +GTJLOS: MOVE B,T.CHAN+1(TB) + PUSHJ P,TGFALS ; GET A FALSE WITH REASON + JRST OPNRET + +STSTK: PUSH TP,$TCHAN + PUSH TP,B + MOVEI A,4+5 ; COUNT CHARS NEEDED (NEED LAST 0 BYTE) + MOVE B,(TP) + ADD A,RDEVIC-1(B) + ADD A,RNAME1-1(B) + ADD A,RNAME2-1(B) + ADD A,RSNAME-1(B) + ANDI A,-1 ; TO 18 BITS + MOVEI 0,A(A) + IDIVI A,5 ; TO WORDS NEEDED + POP P,C ; SAVE RET ADDR + MOVE E,P ; SAVE POINTER + PUSH P,[0] ; ALOCATE SLOTS + SOJG A,.-1 + PUSH P,C ; RET ADDR BACK + INTGO ; IN CASE OVERFLEW + PUSH P,0 + MOVE B,(TP) ; IN CASE GC'D + MOVE D,[440700,,1(E)] ; BYTE POINTER TO IT + MOVEI A,RDEVIC-1(B) + PUSHJ P,MOVSTR ; FLUSH IT ON + HRRZ A,T.SPDL(TB) + JUMPN A,NLNMS ; USER GAVE NAME, USE IT (CAREFUL, RELIES ON + ; A BEING NON ZERO) + PUSH P,B + PUSH P,C + MOVEI A,0 ; HERE TO SEE IF THIS IS REALLY L.N. + HRROI B,1(E) + HRROI C,1(P) + LNMST ; LOOK UP LOGICAL NAME + MOVNI A,1 ; NOT A LOGICAL NAME + POP P,C + POP P,B +NLNMS: MOVEI 0,": + IDPB 0,D + JUMPE A,ST.NM1 ; LOGICAL NAME, FLUSH SNAME + HRRZ A,RSNAME-1(B) ; ANY SNAME AT ALL? + JUMPE A,ST.NM1 ; NOPE, CANT HACK WITH IT + MOVEI A,"< + IDPB A,D + MOVEI A,RSNAME-1(B) + PUSHJ P,MOVSTR ; SNAME UP + MOVEI A,"> + IDPB A,D +ST.NM1: MOVEI A,RNAME1-1(B) + PUSHJ P,MOVSTR + MOVEI A,". + IDPB A,D + MOVEI A,RNAME2-1(B) + PUSHJ P,MOVSTR + SUB TP,[2,,2] + POP P,A + POPJ P, + +MOVSTR: HRRZ 0,(A) ; CHAR COUNT + MOVE A,1(A) ; BYTE POINTER + SOJL 0,CPOPJ + ILDB C,A ; GET CHAR + IDPB C,D ; MUNG IT UP + JRST .-3 + +; MAKE A TENEX ERROR MESSAGE STRING + +TGFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; SAVE ERROR CODE + PUSHJ P,TMTNXS ; STRING ON STACK + HRROI A,1(E) ; POINT TO SPACE + MOVE B,(E) ; ERROR CODE + HRLI B,400000 ; FOR ME + MOVSI C,-100. ; MAX CHARS + ERSTR ; GET TENEX STRING + JRST TGFLS1 + JRST TGFLS1 + + MOVEI B,1(E) ; A AND B BOUND STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; BUILD STRING + SUB P,E ; P BACK TO NORMAL +TGFLS2: +IFE FNAMS, SUB P,[1,,1] ; FLUSH ERROR CODE SLOT +IFN FNAMS,[ + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST TGFLS3 + PUSHJ P,STSTK + MOVEI B,1(E) + SUBM P,E + MOVSI A,440700 + HRRI A,(P) + MOVEI C,5 + ILDB 0,A + JUMPE 0,.+2 + SOJG C,.-2 + + PUSHJ P,TNXSTR + PUSH TP,A + PUSH TP,B + SUB P,E +TGFLS3: POP P,A + PUSH TP,$TFIX + PUSH TP,A + MOVEI A,3 + SKIPN B + MOVEI A,2 +] +IFE FNAMS,[ + MOVEI A,1 +] + PUSHJ P,IILIST ; BUILD LIST + MOVSI A,TFALSE ; MAKE IT FALSE + SUB TP,[2,,2] + POPJ P, + +TGFLS1: MOVE P,E ; RESET STACK + MOVE A,$TCHSTR + MOVE B,CHQUOTE UNKNOWN PROBLEM IN I/O + JRST TGFLS2 + +] +; OTHER BUFFERED DEVICES JOIN HERE + +OPDSK1: +IFN ITS,[ + PUSHJ P,FIXREA ; STORE THE "REAL" NAMES INTO THE CHANNEL +] +OPBASC: MOVE C,T.SPDL+1(TB) ; C WAS CLOBBERED, GET IT BACK + HRRZ A,S.DIR(C) ; FIND OUT IF OPEN IS ASCII OR WORD + TRZN A,2 ; SKIP IF BINARY + PUSHJ P,OPASCI ; DO IT FOR ASCII + +; NOW SET UP IO INSTRUCTION FOR CHANNEL + +MAKION: MOVE B,T.CHAN+1(TB) + MOVEI C,GETCHR + JUMPE A,MAKIO1 ; JUMP IF INPUT + MOVEI C,PUTCHR ; ELSE GET INPUT + MOVEI 0,80. ; DEFAULT LINE LNTH + MOVEM 0,LINLN(B) + MOVSI 0,TFIX + MOVEM 0,LINLN-1(B) +MAKIO1: + HRLI C,(PUSHJ P,) + MOVEM C,IOINS(B) ; STORE IT + JUMPN A,OPNWIN ; GET AN EOF FORM FOR INPUT CHANNEL + +; HERE TO CONS UP + +EOFMAK: MOVSI C,TATOM + MOVE D,EQUOTE END-OF-FILE + PUSHJ P,INCONS + MOVEI E,(B) + MOVSI C,TATOM + MOVE D,IMQUOTE ERROR + PUSHJ P,ICONS + MOVE D,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVSI 0,TFORM + MOVEM 0,EOFCND-1(D) + MOVEM B,EOFCND(D) + +OPNWIN: MOVEI 0,10. ; SET UP RADIX + MOVSI A,TCHAN ; OPEN SUCCEEDED, RET CHANNEL + MOVE B,T.CHAN+1(TB) + MOVEM 0,RADX(B) + +OPNRET: MOVE D,T.CHAN+1(TB) ; IN CASE WE RECYCLE IT + MOVE C,(P) ; RET ADDR + SUB P,[S.X3+2,,S.X3+2] + SUB TP,[T.CHAN+2,,T.CHAN+2] + JRST (C) + + +; HERE TO CREATE CHARACTER BUFFERS FOR ASCII I/O + +OPASCI: PUSH P,A ; CONTAINS MODE, SAVE IT + MOVEI A,BUFLNT ; GET SIZE OF BUFFER + PUSHJ P,IBLOCK ; GET STORAGE + MOVSI 0,TWORD+.VECT. ; SET UTYPE + MOVEM 0,BUFLNT(B) ; AND STORE + MOVSI A,TCHSTR + SKIPE (P) ; SKIP IF INPUT + JRST OPASCO + MOVEI D,BUFLNT-1(B) ; REST BYTE POINTER +OPASCA: HRLI D,010700 + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEI 0,C.BUF + IORM 0,-2(B) ; TURN ON BUFFER BIT + MOVEM A,BUFSTR-1(B) + MOVEM D,BUFSTR(B) ; CLOBBER + POP P,A + POPJ P, + +OPASCO: HRROI C,777776 + MOVEM C,(B) ; -1 THE BUFFER (LEAVE OFF LOW BIT) + MOVSI C,(B) + HRRI C,1(B) ; BUILD BLT POINTER + BLT C,BUFLNT-1(B) ; ZAP + MOVEI D,-1(B) ; START MAKING STRING POINTER + HRRI A,BUFLNT*5 ; SET UP CHAR COUNT + JRST OPASCA + + +; OPEN NON FILE ORIENTED DEVICES (NUL, PTR, PTP ETC.) + +IFN ITS,[ +ONUL: +OPTP: +OPTR: PUSHJ P,OPEN0 ; SET UP MODE AND OPEN + SETZM S.NM1(C) ; CLOBBER UNINTERESTING FIELDS + SETZM S.NM2(C) + SETZM S.SNM(C) + JRST OPDSK1 + +; OPEN DEVICES THAT IGNORE SNAME + +OUTN: PUSHJ P,OPEN0 + SETZM S.SNM(C) + JRST OPDSK1 + +] + +; INTERNAL CHANNEL OPENER + +OINT: HRRZ A,S.DIR(C) ; CHECK DIR + CAIL A,2 ; READ/PRINT? + JRST WRONGD ; NO, LOSE + + MOVE 0,INTINS(A) ; GET INS + MOVE D,T.CHAN+1(TB) ; AND CHANNEL + MOVEM 0,IOINS(D) ; AND CLOBBER + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + HRRM 0,-2(D) + SETOM STATUS(D) ; MAKE SURE NOT AA TTY + PMOVEM T.XT(TB),INTFCN-1(D) + +; HERE TO SAVE PSEUDO CHANNELS + +SAVCHN: HRRZ E,CHNL0+1 ; POINT TO CURRENT LIST + MOVSI C,TCHAN + PUSHJ P,ICONS ; CONS IT ON + HRRZM B,CHNL0+1 + JRST OPNWIN + +; INT DEVICE I/O INS + +INTINS: PUSHJ P,GTINTC + PUSHJ P,PTINTC + + +; HERE TO OPEN THE NET DEVICE (I.E. THE ARPA NET) + +IFN ITS,[ +ONET: HRRZ A,S.DIR(C) ; DIRECTION CODE + CAILE A,1 ; ASCII ? + IORI A,4 ; TURN ON IMAGE BIT + SKIPGE S.NM1(C) ; NAME1 I.E. LOCAL HOST GIVEN + IORI A,10 ; NO, WE WILL LET ITS GIVE US ONE + SKIPGE S.NM2(C) ; NORMAL OR "LISTEN" + IORI A,20 ; TURN ON LISTEN BIT + MOVEI 0,7 ; DEFAULT BYTE SIZE + TRNE A,2 ; UNLESS + MOVEI 0,36. ; IMAGE WHICH IS 36 + SKIPN T.XT(TB) ; BYTE SIZE GIVEN? + MOVEM 0,S.X1(C) ; NO, STORE DEFAULT + SKIPG D,S.X1(C) ; BYTE SIZE REASONABLE? + JRST RBYTSZ ; NO <0, COMPLAIN + TRNE A,2 ; SKIP TO CHECK ASCII + JRST ONET2 ; CHECK IMAGE + CAIN D,7 ; 7-BIT WINS + JRST ONET1 + CAIE D,44 ; 36-BIT INDICATES BLOCK ASCII MODE + JRST .+3 + IORI A,2 ; SET BLOCK FLAG + JRST ONET1 + IORI A,40 ; USE 8-BIT MODE + CAIN D,10 ; IS IT RIGHT + JRST ONET1 ; YES +] + +RBYTSZ: ERRUUO EQUOTE BYTE-SIZE-BAD + +IFN ITS,[ +ONET2: CAILE D,36. ; IMAGE SIZE REASONABLE? + JRST RBYTSZ ; NO + CAIN D,36. ; NORMAL + JRST ONET1 ; YES, DONT SET FIELD + + ASH D,9. ; POSITION FOR FIELD + IORI A,40(D) ; SET IT AND ITS BIT + +ONET1: HRLM A,S.DIR(C) ; CLOBBER OPEN BLOCK + MOVE E,A ; SAVE BLOCK MODE INFO + PUSHJ P,OPEN1 ; DO THE OPEN + PUSH P,E + +; CLOBBER REAL SLOTS FOR THE OPEN + + MOVEI A,3 ; GET STATE VECTOR + PUSHJ P,IBLOCK + MOVSI A,TUVEC + MOVE D,T.CHAN+1(TB) + HLLM A,BUFRIN-1(D) + MOVEM B,BUFRIN(D) + MOVSI A,TFIX+.VECT. ; SET U TYPE + MOVEM A,3(B) + MOVE C,T.SPDL+1(TB) + MOVE B,T.CHAN+1(TB) + + PUSHJ P,INETST ; GET STATE + + POP P,A ; IS THIS BLOCK MODE + MOVEI 0,80. ; POSSIBLE LINE LENGTH + TRNE A,1 ; SKIP IF INPUT + MOVEM 0,LINLN(B) + TRNN A,2 ; BLOCK MODE? + JRST .+3 + TRNN A,4 ; ASCII MODE? + JRST OPBASC ; GO SETUP BLOCK ASCII + MOVE 0,[PUSHJ P,DOIOT] + MOVEM 0,IOINS(B) + + JRST OPNWIN + +; INTERNAL ROUTINE TO GET THE CURRENT STATE OF THE NETWROK CHANNEL + +INETST: MOVE A,S.NM1(C) + MOVEM A,RNAME1(B) + MOVE A,S.NM2(C) + MOVEM A,RNAME2(B) + LDB A,[1100,,S.SNM(C)] + MOVEM A,RSNAME(B) + + MOVE E,BUFRIN(B) ; GET STATE BLOCK +INTST1: HRRE 0,S.X1(C) + MOVEM 0,(E) + ADDI C,1 + AOBJN E,INTST1 + + POPJ P, + + +; ACCEPT A CONNECTION + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET ; CHECK THAT ARG IS AN OPEN NET CHANNEL + MOVE A,CHANNO(B) ; GET CHANNEL + LSH A,23. ; TO AC FIELD + IOR A,[.NETACC] + XCT A + JRST IFALSE ; RETURN FALSE +NETRET: MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +; FORCE SYSTEM NETWORK BUFFERS TO BE SENT + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 + CAMN A,MODES+3 + SKIPA A,CHANNO(B) ; GET CHANNEL + JRST WRONGD + LSH A,23. + IOR A,[.NETS] + XCT A + JRST NETRET + +; SUBR TO RETURN UPDATED NET STATE + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET ; IS IT A NET CHANNEL + PUSHJ P,INSTAT + JRST FINIS + +; INTERNAL NETSTATE ROUTINE + +INSTAT: MOVE C,P ; GET PDL BASE + MOVEI 0,S.X3 ; # OF SLOTS NEEDED + PUSH P,[0] + SOJN 0,.-1 +; RESTORED FROM MUDDLE 54. IT SEEMED TO WORK THERE, AND THE STUFF +; COMMENTED OUT HERE CERTAINLY DOESN'T. + MOVEI D,S.DEV(C) + HRL D,CHANNO(B) + .RCHST D, +; HRR D,CHANNO(B) ; SETUP FOR RFNAME CALL +; DOTCAL RFNAME,[D,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] +; .LOSE %LSFIL ; THIS MAY NOT BE DESIRABLE, BUT I ASSUME WE CARE IF + ; LOSSAGE + PUSHJ P,INETST ; INTO VECTOR + SUB P,[S.X3,,S.X3] + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + POPJ P, +] +; INTERNAL ROUTINE TO CHECK FOR CORRECT CHANNEL TYPE + +ARGNET: ENTRY 1 + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; OPEN? + JRST CHNCLS + MOVE A,RDEVIC-1(B) ; GET DEV NAME + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 + POP P,A + CAME A,[SIXBIT /NET /] + JRST NOTNET + MOVE B,1(AB) + MOVE A,DIRECT-1(B) ; CHECK FOR A READ SOCKET + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 + MOVE B,1(AB) ; RESTORE CHANNEL + POP P,A + POPJ P, + +IFE ITS,[ + +; TENEX NETWRK OPENING CODE + +ONET: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + MOVSI C,100700 + HRRI C,1(P) + MOVE E,P + PUSH P,[ASCII /NET:/] ; FOR STRINGS + GETYP 0,RNAME1-1(B) ; CHECK TYPE + CAIE 0,TFIX ; SKIP IF # SUPPLIED + JRST ONET1 + MOVE 0,RNAME1(B) ; GET IT + PUSHJ P,FIXSTK + JFCL + JRST ONET2 +ONET1: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME1-1(B) + MOVE B,RNAME1(B) + JUMPE 0,ONET2 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 +ONET2: MOVEI A,". + JSP D,ONETCH + MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIE 0,TFIX + JRST ONET3 + GETYP 0,RSNAME-1(B) + CAIE 0,TFIX + JRST WRONGT + MOVE 0,RSNAME(B) + CAIG 0,377 ;NEW STYLE 32 BIT HOST NUMBER? + JRST ONET2A +;CONVERT HOSTS2 HOST NUMBERS TO INTERNET (TOPS-20) HOST NUMBERS + MOVEI A,0 + LDB B,[001100,,0] ;HOST NUMBER: 1.1-1.9 -> + DPB B,[201000,,A] ; 2.8-3.6 + LDB B,[111100,,0] ;IMP LOW BITS: 2.1-2.9 -> + DPB B,[001000,,A] ; 1.1-1.8 + LDB B,[221100,,0] ;IMP HIGH BITS: 3.1-3.9 -> + DPB B,[101000,,A] ; 1.9-2.7 + LDB B,[331100,,0] ;NETWORK: 4.1-4.9 -> + DPB B,[301000,,A] ; 3.7-4.5 + MOVE 0,A +ONET2A: PUSHJ P,FIXSTK + JRST ONET4 + MOVE B,T.CHAN+1(TB) + MOVEI A,"- + JSP D,ONETCH + MOVE 0,RNAME2(B) + PUSHJ P,FIXSTK + JRST WRONGT + JRST ONET4 +ONET3: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME2-1(B) + MOVE B,RNAME2(B) + JUMPE 0,ONET4 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 + +ONET4: +ONET5: MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIN 0,TCHSTR + JRST ONET6 + MOVEI A,"; + JSP D,ONETCH + MOVEI A,"T + JSP D,ONETCH +ONET6: MOVSI A,1 + HRROI B,1(E) ; STRING POINTER + GTJFN ; GET THE G.D JFN + TDZA 0,0 ; REMEMBER FAILURE + MOVEI 0,1 + MOVE P,E ; RESTORE P + JUMPE 0,GTJLOS ; CONS UP ERROR STRING + + MOVE B,T.CHAN+1(TB) + HRRZM A,CHANNO(B) ; SAVE THE JFN + + MOVE C,T.SPDL+1(TB) + MOVE D,S.DIR(C) + MOVEI B,10 + TRNE D,2 + MOVEI B,36. + SKIPE T.XT(TB) + MOVE B,T.XT+1(TB) + JUMPL B,RBYTSZ + CAILE B,36. + JRST RBYTSZ + ROT B,-6 + TLO B,3400 + HRRI B,200000 + TRNE D,1 ; SKIP FOR INPUT + HRRI B,100000 + ANDI A,-1 ; ISOLATE JFCN + OPENF + JRST OPFLOS ; REPORT ERROR + MOVE B,T.CHAN+1(TB) + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) + CVSKT ; GET ABS SOCKET # + FATAL NETWORK BITES THE BAG! + MOVE D,B + MOVE B,T.CHAN+1(TB) + MOVEM D,RNAME1(B) + MOVSI 0,TFIX + MOVEM 0,RNAME1-1(B) + + MOVSI 0,TFIX + MOVEM 0,RNAME2-1(B) + MOVEM 0,RSNAME-1(B) + MOVE C,T.SPDL+1(TB) + MOVE C,S.DIR(C) + MOVE 0,[PUSHJ P,DONETO] + TRNN C,1 ; SKIP FOR OUTPUT + MOVE 0,[PUSHJ P,DONETI] + MOVEM 0,IOINS(B) + MOVEI 0,80. ; LINELENGTH + TRNE C,1 ; SKIP FOR INPUT + MOVEM 0,LINLN(B) + MOVEI A,3 ; GET STATE UVECTOR + PUSHJ P,IBLOCK + MOVSI 0,TFIX+.VECT. + MOVEM 0,3(B) + MOVE C,B + MOVE B,T.CHAN+1(TB) + MOVEM C,BUFRIN(B) + MOVSI 0,TUVEC + HLLM 0,BUFRIN-1(B) + MOVE B,CHANNO(B) ; GET JFN + MOVEI A,4 ; CODE FOR GTNCP + MOVEI C,1(P) + ADJSP P,4 ; ROOM FOR DATA + MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC + GTNCP + FATAL NET LOSSAGE ; GET STATE + MOVE B,(P) + MOVE D,-1(P) + MOVE C,-3(P) + ADJSP P,-4 + MOVE E,T.CHAN+1(TB) + MOVEM D,RNAME2(E) + MOVEM C,RSNAME(E) + MOVE C,BUFRIN(E) + MOVEM B,(C) ; INITIAL STATE STORED + MOVE B,E + JRST OPNWIN + +; DOIOT FOR TENEX NETWRK + +DONETO: PUSH P,0 + MOVE 0,[BOUT] + JRST .+3 + +DONETI: PUSH P,0 + MOVE 0,[BIN] + PUSH P,0 + PUSH TP,$TCHAN + PUSH TP,B + MOVEI 0,(A) ; POSSIBLE OUTPUT CHAR TO 0 + MOVE A,CHANNO(B) + MOVE B,0 + ENABLE + XCT (P) + DISABLE + MOVEI A,(B) ; RET CHAR IN A + MOVE B,(TP) + MOVE 0,-1(P) + SUB P,[2,,2] + SUB TP,[2,,2] + POPJ P, + +NETPRS: MOVEI D,0 + HRRZ 0,(C) + MOVE C,1(C) + +ONETL: ILDB A,C + CAIN A,"# + POPJ P, + SUBI A,60 + ASH D,3 + IORI D,(A) + SOJG 0,ONETL + AOS (P) + POPJ P, + +FIXSTK: CAMN 0,[-1] + POPJ P, + JFFO 0,FIXS3 ; PUT OCTAL DIGITS INTO STIRNG + MOVEI A,"0 + POP P,D + AOJA D,ONETCH +FIXS3: IDIVI A,3 + MOVEI B,12. + SUBI B,(A) + HRLM B,(P) + IMULI A,3 + LSH 0,(A) + POP P,B +FIXS2: MOVEI A,0 + ROTC 0,3 ; NEXT DIGIT + ADDI A,60 + JSP D,ONETCH + SUB B,[1,,0] + TLNN B,-1 + JRST 1(B) + JRST FIXS2 + +ONETCH: IDPB A,C + TLNE C,760000 ; SKIP IF NEW WORD + JRST (D) + PUSH P,[0] + JRST (D) + +INSTAT: MOVE E,B + MOVE B,CHANNO(B) ; GET JFN + MOVEI A,4 ; CODE FOR GTNCP + MOVEI C,1(P) + ADJSP P,4 ; ROOM FOR DATA + MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC + GTNCP + FATAL NET LOSSAGE ; GET STATE + MOVE B,(P) + MOVE D,-1(P) + MOVE C,-3(P) + ADJSP P,-4 + MOVEM D,RNAME2(E) ; UPDATE FOREIGN SOCHKET + MOVEM C,RSNAME(E) ; AND HOST + MOVE C,BUFRIN(E) + XCT ITSTRN(B) ; XLATE TO LOOK MORE LIKE ITS + MOVEM B,(C) ; STORE STATE + MOVE B,E + POPJ P, + +ITSTRN: MOVEI B,0 + JRST NLOSS + JRST NLOSS + MOVEI B,1 + MOVEI B,2 + JRST NLOSS + MOVEI B,4 + PUSHJ P,NOPND + MOVEI B,0 + JRST NLOSS + JRST NLOSS + PUSHJ P,NCLSD + MOVEI B,0 + JRST NLOSS + MOVEI B,0 + +NLOSS: FATAL ILLEGAL NETWORK STATE + +NOPND: MOVE B,DIRECT(E) ; SEE IF READ OR PRINT + ILDB B,B ; GET 1ST CHAR + CAIE B,"R ; SKIP FOR READ + JRST NOPNDW + SIBE ; SEE IF INPUT EXISTS + JRST .+3 + MOVEI B,5 + POPJ P, + MOVEM B,2(C) ; STORE BYTES IN STATE VECTOR + MOVEI B,11 ; RETURN DATA PRESENT STATE + POPJ P, + +NOPNDW: SOBE ; SEE IF OUTPUT PRESENT + JRST .+3 + MOVEI B,5 + POPJ P, + + MOVEI B,6 + POPJ P, + +NCLSD: MOVE B,DIRECT(E) + ILDB B,B + CAIE B,"R + JRST RET0 + SIBE + JRST .+2 + JRST RET0 + MOVEI B,10 + POPJ P, + +RET0: MOVEI B,0 + POPJ P, + + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET + PUSHJ P,INSTAT + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + JRST FINIS + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 ; PRINT OR PRINTB? + CAMN A,MODES+3 + SKIPA A,CHANNO(B) + JRST WRONGD + MOVEI B,21 + MTOPR +NETRET: MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET + MOVE A,CHANNO(B) + MOVEI B,20 + MTOPR + JRST NETRET + +] + +; HERE TO OPEN TELETYPE DEVICES + +OTTY: HRRZ A,S.DIR(C) ; GET DIR CODE + TRNE A,2 ; SKIP IF NOT READB/PRINTB + JRST WRONGD ; CANT DO THAT + +IFN ITS,[ + MOVE A,S.NM1(C) ; CHECK FOR A DIR + MOVE 0,S.NM2(C) + CAMN A,[SIXBIT /.FILE./] + CAME 0,[SIXBIT /(DIR)/] + SKIPA E,[-15.*2,,] + JRST OUTN ; DO IT THAT WAY + + HRRZ A,S.DIR(C) ; CHECK DIR + TRNE A,1 + JRST TTYLP2 + HRRI E,CHNL1 + PUSH P,S.DEV(C) ; SAVE THE SIXBIT DEV NAME + ; HRLZS (P) ; POSTITION DEVICE NAME + +TTYLP: SKIPN D,1(E) ; CHANNEL OPEN? + JRST TTYLP1 ; NO, GO TO NEXT + MOVE A,RDEVIC-1(D) ; GET DEV NAME + MOVE B,RDEVIC(D) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A ; GET RESULT + CAMN A,(P) ; SAME? + JRST SAMTYQ ; COULD BE THE SAME +TTYLP1: ADD E,[2,,2] + JUMPL E,TTYLP + SUB P,[1,,1] ; THIS ONE MUST BE UNIQUE +TTYLP2: MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; GET DIR OF OPEN + SKIPE A ; IF OUTPUT, + IORI A,20 ; THEN USE DISPLAY MODE + HRLM A,S.DIR(C) ; STORE IN OPEN BLOCK + PUSHJ P,OPEN2 ; OPEN THE TTY + MOVE A,S.DEV(C) ; GET DEVICE NAME + PUSHJ P,6TOCHS ; TO A STRING + MOVE D,T.CHAN+1(TB) ; POINT TO CHANNEL + MOVEM A,RDEVIC-1(D) + MOVEM B,RDEVIC(D) + MOVE C,T.SPDL+1(TB) ; RESTORE PDL BASE + MOVE B,D ; CHANNEL TO B + HRRZ 0,S.DIR(C) ; AND DIR + JUMPE 0,TTYSPC +TTY1: DOTCAL TTYGET,[CHANNO(B),[2000,,0],[2000,,A],[2000,,D]] + .LOSE %LSSYS + DOTCAL TTYSET,[CHANNO(B),MODE1,MODE2,D] + .LOSE %LSSYS + MOVE A,[PUSHJ P,GMTYO] + MOVEM A,IOINS(B) + DOTCAL RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]] + .LOSE %LSSYS + MOVEM D,LINLN(B) + MOVEM A,PAGLN(B) + JRST OPNWIN + +; MAKE AN IOT + +IOTMAK: HRLZ A,CHANNO(B) ; GET CHANNEL + ROT A,5 + IOR A,[.IOT A] ; BUILD IOT + MOVEM A,IOINS(B) ; AND STORE IT + POPJ P, + + +; HERE IF POSSIBLY OPENING AN ALREADY OPEN TTY + +SAMTYQ: MOVE D,1(E) ; RESTORE CURRENT CHANNEL + MOVE A,DIRECT-1(D) ; GET DIR + MOVE B,DIRECT(D) + PUSHJ P,STRTO6 + POP P,A ; GET SIXBIT + MOVE C,T.SPDL+1(TB) + HRRZ C,S.DIR(C) + CAME A,MODES(C) ; SKIP IF DIFFERENT DIRECTION + JRST TTYLP1 + +; HERE IF A RE-OPEN ON A TTY + + HRRZ 0,FSAV(TB) ; IS IT FROM A FOPEN + CAIN 0,FOPEN + JRST RETOLD ; RET OLD CHANNEL + + PUSH TP,$TCHAN + PUSH TP,1(E) ; PUSH OLD CHANNEL + PUSH TP,$TFIX + PUSH TP,T.CHAN+1(TB) + MOVE A,[PUSHJ P,CHNFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + SUB TP,[4,,4] + +RETOLD: MOVE B,1(E) ; GET CHANNEL + AOS CHANNO-1(B) ; AOS REF COUNT + MOVSI A,TCHAN + SUB P,[1,,1] ; CLEAN UP STACK + JRST OPNRET ; AND LEAVE + + +; ROUTINE TO PASS TO GCHACK TO FIX UP CHANNEL POINTER + +CHNFIX: CAIN C,TCHAN + CAME D,(TP) + POPJ P, + MOVE D,-2(TP) ; GET REPLACEMENT + SKIPE B + MOVEM D,1(B) ; CLOBBER IT AWAY + POPJ P, +] + +IFE ITS,[ + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ 0,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVE A,[PUSHJ P,INMTYO] + MOVE B,T.CHAN+1(TB) + MOVEM A,IOINS(B) + MOVEI A,100 ; PRIM INPUT JFN + JUMPN 0,TNXTY1 + MOVEI E,C.OPN+C.READ+C.TTY + HRRM E,-2(B) + MOVEM B,CHNL0+2*100+1 + JRST TNXTY2 +TNXTY1: MOVEM B,CHNL0+2*101+1 + MOVEI A,101 ; PRIM OUTPUT JFN + MOVEI E,C.OPN+C.PRIN+C.TTY + HRRM E,-2(B) +TNXTY2: MOVEM A,CHANNO(B) + JUMPN 0,OPNWIN +] +; SETUP FUNNY BUFFER FOR TTY INPUT DEVICES + +TTYSPC: MOVEI A,EXTBFR ; GET EXTRA BUFFER + PUSHJ P,IBLOCK ; GET BLOCK + MOVE D,T.CHAN+1(TB) ;RESTORE CHANNEL POINTER +IFN ITS,[ + MOVE A,CHANNO(D) + LSH A,23. + IOR A,[.IOT A] + MOVEM A,IOIN2(B) +] +IFE ITS,[ + MOVE A,[PBIN] + MOVEM A,IOIN2(B) +] + MOVSI A,TLIST + MOVEM A,EXBUFR-1(D) ; FOR WAITING TTY BUFFERS + SETZM EXBUFR(D) ; NIL LIST + MOVEM B,BUFRIN(D) ;STORE IN CHANNEL + MOVSI A,TUVEC ;MAKE SURE TYPE IS UNIFORM VECTOR + HLLM A,BUFRIN-1(D) + MOVEI A,177 ;SET ERASER TO RUBOUT + MOVEM A,ERASCH(B) +IFE ITS,[ + MOVEI A,25 + MOVEM A,KILLCH(B) +] +IFN ITS,[ + SETZM KILLCH(B) ;NO KILL CHARACTER NEEDED +] + MOVEI A,33 ;BREAKCHR TO C.R. + MOVEM A,BRKCH(B) + MOVEI A,"\ ;ESCAPER TO \ + MOVEM A,ESCAP(B) + MOVE A,[010700,,BYTPTR(E)] ;RELATIVE BYTE POINTER + MOVEM A,BYTPTR(B) + MOVEI A,14 ;BARF BACK CHARACTER FF + MOVEM A,BRFCHR(B) + MOVEI A,^D + MOVEM A,BRFCH2(B) + +; SETUP DEFAULT TTY INTERRUPT HANDLER + + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TFIX + PUSH TP,[10] ; PRIORITY OF CHAR INT + PUSH TP,$TCHAN + PUSH TP,D + MCALL 3,EVENT ; 1ST MAKE AN EVENT EXIST + PUSH TP,A + PUSH TP,B + PUSH TP,$TSUBR + PUSH TP,[QUITTER] ; DEFAULT HANDLER IS QUITTER + MCALL 2,HANDLER + +; BUILD A NULL STRING + + MOVEI A,0 + PUSHJ P,IBLOCK ; USE A BLOCK + MOVE D,T.CHAN+1(TB) + MOVEI 0,C.BUF + IORM 0,-2(D) + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + MOVEM A,BUFSTR-1(D) + MOVEM B,BUFSTR(D) + MOVEI A,0 + MOVE B,D ; CHANNEL TO B + JRST MAKION + + +; ROUTINE TO OPEN ITS CHANNEL WITHOUT .RCHST + +IFN ITS,[ +OPEN2: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN ; OPEN THE FILE + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; SAVE THE CHANNEL + JRST OPEN3 + +; FIX UP MODE AND FALL INTO OPEN + +OPEN0: HRRZ A,S.DIR(C) ; GET DIR + TRNE A,2 ; SKIP IF NOT BLOCK + IORI A,4 ; TURN ON IMAGE + IORI A,2 ; AND BLOCK + + PUSH P,A + PUSH TP,$TPDL + PUSH TP,C ; SAVE CRUFT TO CHECK FOR PRINTO, HA HA + MOVE B,T.CHAN+1(TB) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) ; THIS KLUDGE THE MESS OF NDR + PUSHJ P,STRTO6 + MOVE C,(TP) + POP P,D ; THE SIXBIT FOR KLUDGE + POP P,A ; GET BACK THE RANDOM BITS + SUB TP,[2,,2] + CAME D,[SIXBIT /PRINAO/] + CAMN D,[SIXBIT /PRINTO/] + IORI A,100000 ; WRITEOVER BIT + HRRZ 0,FSAV(TB) + CAIN 0,NFOPEN + IORI A,10 ; DON'T CHANGE REF DATE +OPEN9: HRLM A,S.DIR(C) ; AND STORE IT + +; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL + +OPEN1: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; CLOBBER INTO CHANNEL + DOTCAL RFNAME,[A,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] + JFCL + +; NOW CLOBBER THE TVP SLOT FOR THIS CHANNEL + +OPEN3: MOVE A,S.DIR(C) + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) ; GET CHANNEL # + ASH A,1 + ADDI A,CHNL0 ; POINT TO SLOT + MOVEM B,1(A) ; NOT: TYPE ALREADY SETUP + +; NOW GET STATUS WORD + +DOSTAT: HRRZ A,CHANNO(B) ; NOW GET STATUS WORD + DOTCAL STATUS,[A,[2002,,STATUS]] + JFCL + POPJ P, + + +; HERE IF OPEN FAILS (CHANNEL IS IN A) + +OPNLOS: JUMPL A,NOCHAN ; ALL CHANNELS ARE IN USE + LSH A,23. ; DO A .STATUS + IOR A,[.STATUS A] + XCT A ; STATUS TO A + MOVE B,T.CHAN+1(TB) + PUSHJ P,GFALS ; GET A FALSE WITH A MESSAGE + SUB P,[1,,1] ; EXTRA RET ADDR FLUSHED + JRST OPNRET ; AND RETURN +] + +CGFALS: SUBM M,(P) + MOVEI B,0 +IFN ITS, PUSHJ P,GFALS +IFE ITS, PUSHJ P,TGFALS + JRST MPOPJ + +; ROUTINE TO CONS UP FALSE WITH REASON +IFN ITS,[ +GFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,[SIXBIT / ERR/] ; SET UP OPEN TO ERR DEV + PUSH P,[3] ; SAY ITS FOR CHANNEL + PUSH P,A + .OPEN 0,-2(P) ; USE CHANNEL 0 FOR THIS + FATAL CAN'T OPEN ERROR DEVICE + SUB P,[3,,3] ; DONT WANT OPEN BLOCK NOW +IFN FNAMS, PUSH P,A + MOVEI A,0 ; PREPARE TO BUILD STRING ON STACK +EL1: PUSH P,[0] ; WHERE IT WILL GO + MOVSI B,(<440700,,(P)>) ; BYTE POINTER TO TOP OF STACK +EL2: .IOT 0,0 ; GET A CHAR + JUMPL 0,EL3 ; JUMP ON -1,,3 + CAIN 0,3 ; EOF? + JRST EL3 ; YES, MAKE STRING + CAIN 0,14 ; IGNORE FORM FEEDS + JRST EL2 ; IGNORE FF + CAIE 0,15 ; IGNORE CR & LF + CAIN 0,12 + JRST EL2 + IDPB 0,B ; STUFF IT + TLNE B,760000 ; SIP IF WORD FULL + AOJA A,EL2 + AOJA A,EL1 ; COUNT WORD AND GO + +EL3: +IFN FNAMS,[ + SKIPN (P) + SUB P,[1,,1] + PUSH P,A + .CLOSE 0, + PUSHJ P,CHMAK + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST EL4 + MOVEI A,0 + MOVSI B,(<440700,,(P)>) + PUSH P,[0] + IRP XX,,[RDEVIC,RSNAME,RNAME1,RNAME2]YY,,[0,72,73,40] +IFSN YY,0,[ + MOVEI 0,YY + JSP E,1PUSH +] + MOVE E,-2(TP) + MOVE C,XX(E) + HRRZ D,XX-1(E) + JSP E,PUSHIT + TERMIN +] + SKIPN (P) ; ANY CHARS AT END? + SUB P,[1,,1] ; FLUSH XTRA + PUSH P,A ; PUT UP COUNT + .CLOSE 0, ; CLOSE THE ERR DEVICE + PUSHJ P,CHMAK ; MAKE STRING + PUSH TP,A + PUSH TP,B +IFN FNAMS,[ +EL4: POP P,A + PUSH TP,$TFIX + PUSH TP,A] +IFE FNAMS, MOVEI A,1 +IFN FNAMS,[ + MOVEI A,3 + SKIPN B + MOVEI A,2 +] + PUSHJ P,IILIST + MOVSI A,TFALSE ; MAKEIT A FALSE +IFN FNAMS, SUB TP,[2,,2] + POPJ P, + +IFN FNAMS,[ +1PUSH: MOVEI D,0 + JRST PUSHI2 +PUSHI1: PUSH P,[0] + MOVSI B,(<440700,,(P)>) +PUSHIT: SOJL D,(E) + ILDB 0,C +PUSHI2: IDPB 0,B + TLNE B,760000 + AOJA A,PUSHIT + AOJA A,PUSHI1 +] +] + + +; ROUTINE TO FILL IN THE "REAL" SLOTS FOR THE CHANNEL + +FIXREA: +IFE ITS, HRLZS S.DEV(C) ; KILL MODE BITS + MOVE D,[-4,,S.DEV] + +FIXRE1: MOVEI A,(D) ; COPY REL POINTER + ADD A,T.SPDL+1(TB) ; POINT TO SLOT + SKIPN A,(A) ; SKIP IF GOODIE THERE + JRST FIXRE2 + PUSHJ P,6TOCHS ; MAKE INOT A STRING + MOVE C,RDTBL-S.DEV(D); GET OFFSET + ADD C,T.CHAN+1(TB) + MOVEM A,-1(C) + MOVEM B,(C) +FIXRE2: AOBJN D,FIXRE1 + POPJ P, + +IFN ITS,[ +DOOPN: HRLZ A,A + HRR A,CHANNO(B) ; GET CHANNEL + DOTCAL OPEN,[A,-3(P),-2(P),-1(P),(P)] + SKIPA + AOS -1(P) + POPJ P, +] + +;THIS ROUTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES +STRTO6: PUSH TP,A + PUSH TP,B + PUSH P,E ;SAVE USEFUL FROB + MOVEI E,(A) ; CHAR COUNT TO E + GETYP A,A + CAIE A,TCHSTR ; IS IT ONE WORD? + JRST WRONGT ;NO + CAILE E,6 ; SKIP IF L=? 6 CHARS + MOVEI E,6 +CHREAD: MOVEI A,0 ;INITIALIZE OUTPUT WORD + MOVE D,[440600,,A] ;AND BYTE POINTER TO IT +NEXCHR: SOJL E,SIXDON + ILDB 0,B ; GET NEXT CHAR + CAIN 0,^Q ; CNTL-Q, QUOTES NEXT CHAR + JRST NEXCHR + JUMPE 0,SIXDON ;IF NULL, WE ARE FINISHED + PUSHJ P,A0TO6 ; CONVERT TO SIXBIT + IDPB 0,D ;DEPOSIT INTO SIX BIT + JRST NEXCHR ; NO, GET NEXT +SIXDON: SUB TP,[2,,2] ;FIX UP TP + POP P,E + EXCH A,(P) ;LEAVE RESULT ON P-STACK + JRST (A) ;NOW RETURN + + +;SUBROUTINE TO CONVERT SIXBIT TO ATOM + +6TOCHS: PUSH P,E + PUSH P,D + MOVEI B,0 ;MAX NUMBER OF CHARACTERS + PUSH P,[0] ;STRING WILL GO ON P SATCK + JUMPE A,GETATM ; EMPTY, LEAVE + MOVEI E,-1(P) ;WILL BE BYTE POINTER + HRLI E,10700 ;SET IT UP + PUSH P,[0] ;SECOND POSSIBLE WORD + MOVE D,[440600,,A] ;INPUT BYTE POINTER +6LOOP: ILDB 0,D ;START CHAR GOBBLING + ADDI 0,40 ;CHANGET TOASCII + IDPB 0,E ;AND STORE IT + TLNN D,770000 ; SKIP IF NOT DONE + JRST 6LOOP1 + TDNN A,MSKS(B) ; CHECK IF JUST SPACES LEFT + AOJA B,GETATM ; YES, DONE + AOJA B,6LOOP ;KEEP LOOKING +6LOOP1: PUSH P,[6] ;IF ARRIVE HERE, STRING IS 2 WORDS + JRST .+2 +GETATM: MOVEM B,(P) ;SET STRING LENGTH=1 + PUSHJ P,CHMAK ;MAKE A MUDDLE STRING + POP P,D + POP P,E + POPJ P, + +MSKS: 7777,,-1 + 77,,-1 + ,,-1 + 7777 + 77 + + +; CONVERT ONE CHAR + +A0TO6: CAIL 0,141 ;IF IT IS GREATER OR EQUAL TO LOWER A + CAILE 0,172 ;BUT LESS THAN OR EQUAL TO LOWER Z + JRST .+2 ;THEN + SUBI 0,40 ;CONVERT TO UPPER CASE + SUBI 0,40 ;NOW TO SIX BIT + JUMPL 0,BAD6 ;CHECK FOR A WINNER + CAILE 0,77 + JRST BAD6 + POPJ P, + +; SUBR TO TEST THE EXISTENCE OF FILES + +MFUNCTION FEXIST,SUBR,[FILE-EXISTS?] + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + ADD TP,[2,,2] + MOVSI E,-4 ; 4 THINGS TO PUSH +EXIST: +IFN ITS, MOVE B,@RNMTBL(E) +IFE ITS, MOVE B,@FETBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST EXIST1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ +; PUSH P,E +; PUSHJ P,ADDNUL ; NOT NEEDED, SINCE CONSED INTO ONE STRING-TAA +; POP P,E + PUSH TP,A ; DEFAULT TYPE AND VALUE GIVEN BY USER + PUSH TP,B ; IN VALUE OF DEV, SNM, NM1, NM2 + ] +IFN ITS, JRST .+2 +IFE ITS, JRST .+3 + +EXIST1: +IFN ITS, PUSH P,EXISTS(E) ; USE DEFAULT +IFE ITS,[ + PUSH TP,FETYP(E) ; DEFAULT TYPE AND VALUE IF NO + PUSH TP,FEVAL(E) ; DEFAULT GIVEN BY USER + ] + AOBJN E,EXIST + + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST TMA ; TOO MANY ARGUMENTS + +IFN ITS,[ + MOVE 0,-3(P) ; GET SIXBIT DEV NAME + MOVEI B,0 + CAMN 0,[SIXBITS /DSK /] + MOVSI B,10 ; DONT SET REF DATE IF DISK DEV + .IOPUSH + DOTCAL OPEN,[B,[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST .+3 + .IOPOP + JRST FDLWON ; WON!!! + .STATUS 0,A ; FIND THE STATUS OF CHANNEL BEFORE POPING + .IOPOP + JRST FDLST1] + +IFE ITS,[ + MOVE B,TB + SUBI B,10 ; GET B TO POINT CORRECTLY TO ARGS + PUSHJ P,STSTK ; GET FILE NAME IN A STRING + HRROI B,1(E) ; POINT B TO THE STRING + MOVSI A,100001 + GTJFN + JRST TDLLOS ; FILE DOES NOT EXIST + RLJFN ; FILE EXIST SO RETURN JFN + JFCL + JRST FDLWON ; SUCCESS + ] + +IFN ITS,[ +EXISTS: SIXBITS /DSK INPUT > / + ] +IFE ITS,[ +FETBL: SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + +FETYP: TCHSTR,,5 + TCHSTR,,3 + TCHSTR,,3 + TCHSTR,,0 + +FEVAL: 440700,,[ASCIZ /INPUT/] + 440700,,[ASCIZ /MUD/] + 440700,,[ASCIZ /DSK/] + 0 + ] + +; SUBR TO DELETE AND RENAME FILES + +MFUNCTION RENAME,SUBR + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + GETYP 0,(AB) ; GET 1ST ARG TYPE +IFN ITS,[ + CAIN 0,TCHAN ; CHANNEL? + JRST CHNRNM ; MUST BE RENAME WHILE OPEN FOR WRITING +] +IFE ITS,[ + PUSH P,[100000,,-2] + PUSH P,[377777,,377777] +] + MOVSI E,-4 ; 4 THINGS TO PUSH +RNMALP: MOVE B,@RNMTBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST RNMLP1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ + PUSH P,E + PUSHJ P,ADDNUL + EXCH B,(P) + MOVE E,B +] + JRST .+2 + +RNMLP1: PUSH P,RNSTBL(E) ; USE DEFAULT + AOBJN E,RNMALP + +IFN ITS,[ + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST RNM1 ; COULD BE A RENAME + +; HERE TO DELETE A FILE + +DELFIL: MOVE A,(P) ; AND GET SNAME + .SUSET [.SSNAM,,A] + DOTCAL DELETE,[[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST FDLST ; ANALYSE ERROR + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS +] +IFE ITS,[ + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; GET BASE OF PDL + MOVEI A,1(A) ; POINT TO CRAP + CAMGE AB,[-3,,] ; SKIP IF DELETE + HLLZS (A) ; RESET DEFAULT + PUSH P,[0] + PUSH P,[0] + PUSH P,[0] + GTJFN ; GET A JFN + JRST TDLLOS ; LOST + ADD AB,[2,,2] ; PAST ARG + MOVEM AB,ABSAV(TB) + JUMPL AB,RNM1 ; GO TRY FOR RENAME + MOVE P,(TP) ; RESTORE P STACK + MOVEI C,(A) ; FOR RELEASE + DELF ; ATTEMPT DELETE + JRST DELLOS ; LOSER + RLJFN ; MAKE SURE FLUSHED + JFCL + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +RNMLOS: PUSH P,A + MOVEI A,(B) + RLJFN + JFCL +DELLO1: MOVEI A,(C) + RLJFN + JFCL + POP P,A ; ERR NUMBER BACK +TDLLOS: MOVEI B,0 + PUSHJ P,TGFALS ; GET FALSE WITH REASON + JRST FINIS + +DELLOS: PUSH P,A ; SAVE ERROR + JRST DELLO1 +] + +;TABLE OF REANMAE DEFAULTS +IFN ITS,[ +RNMTBL: IMQUOTE DEV + IMQUOTE NM1 + IMQUOTE NM2 + IMQUOTE SNM + +RNSTBL: SIXBIT /DSK _MUDS_> / +] +IFE ITS,[ +RNMTBL: SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + +RNSTBL: -1,,[ASCIZ /DSK/] + 0 + -1,,[ASCIZ /_MUDS_/] + -1,,[ASCIZ /MUD/] +] +; HERE TO DO A RENAME + +RNM1: JUMPGE AB,TMA ; IF ARGS EXHAUSTED, MUST BE TOO MUCH STRING + GETYP 0,(AB) + MOVE C,1(AB) ; GET ARG + CAIN 0,TATOM ; IS IT "TO" + CAME C,IMQUOTE TO + JRST WRONGT ; NO, LOSE + ADD AB,[2,,2] ; BUMP PAST "TO" + MOVEM AB,ABSAV(TB) + JUMPGE AB,TFA +IFN ITS,[ + MOVEM P,T.SPDL+1(TB) ; SAVE NEW P-BASE + + MOVEI 0,4 ; FOUR DEFAULTS + PUSH P,-3(P) ; DEFAULT DEVICE IS CURRENT + SOJN 0,.-1 + + PUSHJ P,RGPRS ; PARSE THE NEXT STRING + JRST TMA + + MOVE A,-7(P) ; FIX AND GET DEV1 + MOVE B,-3(P) ; SAME FOR DEV2 + CAME A,B ; SAME? + JRST DEVDIF + + POP P,A ; GET SNAME 2 + CAME A,(P)-3 ; SNAME 1 + JRST DEVDIF + .SUSET [.SSNAM,,A] + POP P,-2(P) ; MOVE NAMES DOWN + POP P,-2(P) + DOTCAL RENAME,[[17,,-4],[17,,-3],[17,,-2],A,[17,,-1],(P)] + JRST FDLST + JRST FDLWON + +; HERE FOR RENAME WHILE OPEN FOR WRITING + +CHNRNM: ADD AB,[2,,2] ; NEXT ARG + MOVEM AB,ABSAV(TB) + JUMPGE AB,TFA + MOVE B,-1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; SKIP IF OPEN + JRST BADCHN + MOVE A,DIRECT-1(B) ; CHECK DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A + CAME A,[SIXBIT /PRINT/] + CAMN A,[SIXBIT /PRINTB/] + JRST CHNRN1 + CAMN A,[SIXBIT /PRINAO/] + JRST CHNRM1 + CAME A,[SIXBIT /PRINTO/] + JRST WRONGD + +; SET UP .FDELE BLOCK + +CHNRN1: PUSH P,[0] + PUSH P,[0] + MOVEM P,T.SPDL+1(TB) + PUSH P,[0] + PUSH P,[SIXBIT /_MUDL_/] + PUSH P,[SIXBIT />/] + PUSH P,[0] + + PUSHJ P,RGPRS ; PARSE THESE + JRST TMA + + SUB P,[1,,1] ; SNAME/DEV IGNORED + MOVE AB,ABSAV(TB) ; GET ORIG ARG POINTER + MOVE B,1(AB) + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RENMWO,[A,[17,,-1],(P)] + JRST FDLST + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RFNAME,[A,[2017,,-4],[2017,,-3],[2017,,-2],[2017,,-1]] + JFCL + MOVE A,-3(P) ; UPDATE CHANNEL + PUSHJ P,6TOCHS ; GET A STRING + MOVE C,1(AB) + MOVEM A,RNAME1-1(C) + MOVEM B,RNAME1(C) + MOVE A,-2(P) + PUSHJ P,6TOCHS + MOVE C,1(AB) + MOVEM A,RNAME2-1(C) + MOVEM B,RNAME2(C) + MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS +] +IFE ITS,[ + PUSH P,A + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; PBASE BACK + PUSH A,[400000,,0] + MOVEI A,(A) + GTJFN + JRST TDLLOS + POP P,B + EXCH A,B + MOVEI C,(A) ; FOR RELEASE ATTEMPT + RNAMF + JRST RNMLOS + MOVEI A,(B) + RLJFN ; FLUSH JFN + JFCL + MOVEI A,(C) ; MAKE SURR OTHER IS FLUSHED + RLJFN + JFCL + JRST FDLWON + + +ADDNUL: PUSH TP,A + PUSH TP,B + MOVEI A,(A) ; LNTH OF STRING + IDIVI A,5 + JUMPN B,NONUAD ; DONT NEED TO ADD ONE + + PUSH TP,$TCHRS + PUSH TP,[0] + MOVEI A,2 + PUSHJ P,CISTNG ; COPY OF STRING + POPJ P, + +NONUAD: POP TP,B + POP TP,A + POPJ P, +] +; HERE FOR LOSING .FDELE + +IFN ITS,[ +FDLST: .STATUS 0,A ; GET STATUS +FDLST1: MOVEI B,0 + PUSHJ P,GFALS ; ANALYZE IT + JRST FINIS +] + +; SOME .FDELE ERRORS + +DEVDIF: ERRUUO EQUOTE DEVICE-OR-SNAME-DIFFERS + + ; HERE TO RESET A READ CHANNEL + +MFUNCTION FRESET,SUBR,RESET + + ENTRY 1 + GETYP A,(AB) + CAIE A,TCHAN + JRST WTYP1 + MOVE B,1(AB) ;GET CHANNEL + SKIPN IOINS(B) ; OPEN? + JRST REOPE1 ; NO, IGNORE CHECKS +IFN ITS,[ + MOVE A,STATUS(B) ;GET STATUS + ANDI A,77 + JUMPE A,REOPE1 ;IF IT CLOSED, JUST REOPEN IT, MAYBE? + CAILE A,2 ;SKIPS IF TTY FLAVOR + JRST REOPEN +] +IFE ITS,[ + MOVE A,CHANNO(B) + CAIE A,100 ; TTY-IN + CAIN A,101 ; TTY-OUT + JRST .+2 + JRST REOPEN +] + CAME B,TTICHN+1 + CAMN B,TTOCHN+1 + JRST REATTY +REATT1: MOVEI B,DIRECT-1(B) ;POINT TO DIRECTION + PUSHJ P,CHRWRD ;CONVERT TO A WORD + JFCL + CAME B,[ASCII /READ/] + JRST TTYOPN + MOVE B,1(AB) ;RESTORE CHANNEL + PUSHJ P,RRESET" ;DO REAL RESET + JRST TTYOPN + +REOPEN: PUSH TP,(AB) ;FIRST CLOSE IT + PUSH TP,(AB)+1 + MCALL 1,FCLOSE + MOVE B,1(AB) ;RESTORE CHANNEL + +; SET UP TEMPS FOR OPNCH + +REOPE1: PUSH P,[0] ; WILL HOLD DIR CODE + PUSH TP,$TPDL + PUSH TP,P + IRP A,,[DIRECT,RNAME1,RNAME2,RDEVIC,RSNAME,ACCESS] + PUSH TP,A-1(B) + PUSH TP,A(B) + TERMIN + + PUSH TP,$TCHAN + PUSH TP,1(AB) + + MOVE A,T.DIR(TB) + MOVE B,T.DIR+1(TB) ; GET DIRECTION + PUSHJ P,CHMOD ; CHECK THE MODE + MOVEM A,(P) ; AND STORE IT + +; NOW SET UP OPEN BLOCK IN SIXBIT + +IFN ITS,[ + MOVSI E,-4 ; AOBN PNTR +FRESE2: MOVE B,T.CHAN+1(TB) + MOVEI A,@RDTBL(E) ; GET ITEM POINTER + GETYP 0,-1(A) ; GET ITS TYPE + CAIE 0,TCHSTR + JRST FRESE1 + MOVE B,(A) ; GET STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 +FRESE3: AOBJN E,FRESE2 +] +IFE ITS,[ + MOVE B,T.CHAN+1(TB) + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; RESULT ON STACK + HLRZS (P) +] + + PUSH P,[0] ; PUSH UP SOME DUMMIES + PUSH P,[0] + PUSH P,[0] + PUSHJ P,OPNCH ; ATTEMPT TO DO THEOPEN + GETYP 0,A + CAIE 0,TCHAN + JRST FINIS ; LEAVE IF FALSE OR WHATEVER + +DRESET: MOVE A,(AB) + MOVE B,1(AB) + SETZM CHRPOS(B) ;INITIALIZE THESE PARAMETERS + SETZM LINPOS(B) + SETZM ACCESS(B) + JRST FINIS + +TTYOPN: +IFN ITS,[ + MOVE B,1(AB) + CAME B,TTOCHN+1 + CAMN B,TTICHN+1 + PUSHJ P,TTYOP2 + PUSHJ P,DOSTAT + DOTCAL RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]] + .LOSE %LSSYS + MOVEM C,PAGLN(B) + MOVEM D,LINLN(B) +] + JRST DRESET + +IFN ITS,[ +FRESE1: CAIE 0,TFIX + JRST BADCHN + PUSH P,(A) + JRST FRESE3 +] + +; INTERFACE TO REOPEN CLOSED CHANNELS + +OPNCHN: PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FRESET + POPJ P, + +REATTY: PUSHJ P,TTYOP2 +IFE ITS, SKIPN DEMFLG ; SKIP IF DEMONFLAG IS ON + SKIPE NOTTY + JRST DRESET + MOVE B,1(AB) + JRST REATT1 + +; FUNCTION TO LIST ALL CHANNELS + +MFUNCTION CHANLIST,SUBR + + ENTRY 0 + + MOVEI A,N.CHNS-1 ;MAX # OF REAL CHANNELS + MOVEI C,0 + MOVEI B,CHNL1 ;POINT TO FIRST REAL CHANNEL + +CHNLP: SKIPN 1(B) ;OPEN? + JRST NXTCHN ;NO, SKIP + HRRE E,(B) ; ABOUT TO FLUSH? + JUMPL E,NXTCHN ; YES, FORGET IT + MOVE D,1(B) ; GET CHANNEL + HRRZ E,CHANNO-1(D) ; GET REF COUNT + PUSH TP,(B) + PUSH TP,1(B) + ADDI C,1 ;COUNT WINNERS + SOJGE E,.-3 ; COUNT THEM +NXTCHN: ADDI B,2 + SOJN A,CHNLP + + SKIPN B,CHNL0+1 ;NOW HACK LIST OF PSUEDO CHANNELS + JRST MAKLST +CHNLS: PUSH TP,(B) + PUSH TP,(B)+1 + ADDI C,1 + HRRZ B,(B) + JUMPN B,CHNLS + +MAKLST: ACALL C,LIST + JRST FINIS + + ; ROUTINE TO RESTORE A CLOSED CHANNEL TO ITS PREVIOUS STATE + + +REOPN: PUSH TP,$TCHAN + PUSH TP,B + SKIPN CHANNO(B) ; ONLY REAL CHANNELS + JRST PSUEDO + +IFN ITS,[ + MOVSI E,-4 ; SET UP POINTER FOR NAMES + +GETOPB: MOVE B,(TP) ; GET CHANNEL + MOVEI A,@RDTBL(E) ; GET POINTER + MOVE B,(A) ; NOW STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 ; LEAVES SIXBIT ON STACK + AOBJN E,GETOPB +] +IFE ITS,[ + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; GET DEV NAME IN SIXBIT +] + MOVE B,(TP) ; RESTORE CHANNEL + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,CHMOD ; CHECK FOR A VALID MODE + +IFN ITS, MOVE E,-3(P) ; GET DEVICE IN PROPER PLACE +IFE ITS, HLRZS E,(P) + MOVE B,(TP) ; RESTORE CHANNEL +IFN ITS, CAMN E,[SIXBIT /DSK /] +IFE ITS,[ + CAIE E,(SIXBIT /PS /) + CAIN E,(SIXBIT /DSK/) + JRST DISKH ; DISK WINS IMMEIDATELY + CAIE E,(SIXBIT /SS /) + CAIN E,(SIXBIT /SRC/) + JRST DISKH ; DISK WINS IMMEIDATELY +] +IFN ITS, CAMN E,[SIXBIT /TTY /] ; NO NEED TO RE-OPEN THE TTY +IFE ITS, CAIN E,(SIXBIT /TTY/) + JRST REOPD1 +IFN ITS,[ + AND E,[777700,,0] ; COULD BE "UTn" + MOVE D,CHANNO(B) ; GET CHANNEL + ASH D,1 + ADDI D,CHNL0 ; DON'T SEEM TO BE OPEN + SETZM 1(D) + SETZM CHANNO(B) + CAMN E,[SIXBIT /UT /] + JRST REOPD ; CURRENTLY, CANT RESTORE UTAPE CHANNLES + CAMN E,[SIXBIT /AI /] + JRST REOPD ; CURRENTLY CANT RESTORE AI CHANNELS + CAMN E,[SIXBIT /ML /] + JRST REOPD ; CURRENTLY CANT RESTORE ML CHANNELS + CAMN E,[SIXBIT /DM /] + JRST REOPD ; CURRENTLY CANT RESTORE DM CHANNELS +] + PUSH TP,$TCHAN ; TRY TO RESET IT + PUSH TP,B + MCALL 1,FRESET + +IFN ITS,[ +REOPD1: AOS -4(P) +REOPD: SUB P,[4,,4] +] +IFE ITS,[ +REOPD1: AOS -1(P) +REOPD: SUB P,[1,,1] +] +REOPD0: SUB TP,[2,,2] + POPJ P, + +IFN ITS,[ +DISKH: MOVE C,(P) ; SNAME + .SUSET [.SSNAM,,C] +] +IFE ITS,[ +DISKH: MOVEM A,(P) ; SAVE MODE WORD + PUSHJ P,STSTK ; STRING TO STACK + MOVE A,(E) ; RESTORE MODE WORD + PUSH TP,$TPDL + PUSH TP,E ; SAVE PDL BASE + MOVE B,-2(TP) ; CHANNEL BACK TO B +] + MOVE C,ACCESS(B) ; GET CHANNELS ACCESS + TRNN A,2 ; SKIP IF NOT ASCII CHANNEL + JRST DISKH1 + HRRZ D,ACCESS-1(B) ; IF PARTIAL WORD OUT + IMULI C,5 ; TO CHAR ACCESS + JUMPE D,DISKH1 ; NO SWEAT + ADDI C,(D) + SUBI C,5 +DISKH1: HRRZ D,BUFSTR-1(B) ; ANY CHARS IN MUDDLE BUFFER + JUMPE D,DISKH2 + TRNN A,1 ; SKIP IF OUTPUT CHANNEL + JRST DISKH2 + PUSH P,A + PUSH P,C + MOVEI C,BUFSTR-1(B) + PUSHJ P,BYTDOP ; FIND LENGTH OF WHOLE BUFFER + HLRZ D,(A) ; LENGTH + 2 TO D + SUBI D,2 + IMULI D,5 ; TO CHARS + SUB D,BUFSTR-1(B) + POP P,C + POP P,A +DISKH2: SUBI C,(D) ; UPDATE CHAR ACCESS + IDIVI C,5 ; BACK TO WORD ACCESS +IFN ITS,[ + IORI A,6 ; BLOCK IMAGE + TRNE A,1 + IORI A,100000 ; WRITE OVER BIT + PUSHJ P,DOOPN + JRST REOPD + MOVE A,C ; ACCESS TO A + PUSHJ P,GETFLN ; CHECK LENGTH + CAIGE 0,(A) ; CHECK BOUNDS + JRST .+3 ; COMPLAIN + PUSHJ P,DOACCS ; AND ACESS + JRST REOPD1 ; SUCCESS + + MOVE A,CHANNO(B) ; CLOSE THE G.D. CHANNEL + PUSHJ P,MCLOSE + JRST REOPD + +DOACCS: PUSH P,A + HRRZ A,CHANNO(B) + DOTCAL ACCESS,[A,(P)] + JFCL + POP P,A + POPJ P, + +DOIOTO: +DOIOTI: +DOIOT: + PUSH P,0 + MOVSI 0,TCHAN + MOVE PVP,PVSTOR+1 + MOVEM 0,BSTO(PVP) ; IN CASE OF INTERRUPT + ENABLE + HRRZ 0,CHANNO(B) + DOTCAL IOT,[0,A] + JFCL + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + POP P,0 + POPJ P, + +GETFLN: MOVE 0,CHANNO(B) ; GET CHANNEL + .CALL FILBLK ; READ LNTH + .VALUE + POPJ P, + +FILBLK: SETZ + SIXBIT /FILLEN/ + 0 + 402000,,0 ; STUFF RESULT IN 0 +] +IFE ITS,[ + MOVEI A,CHNL0 + ADD A,CHANNO(B) + ADD A,CHANNO(B) + SETZM 1(A) ; MAY GET A DIFFERENT JFN + HRROI B,1(E) ; TENEX STRING POINTER + MOVSI A,400001 ; MAKE SURE + GTJFN ; GO GET IT + JRST RGTJL ; COMPLAIN + MOVE D,-2(TP) + HRRZM A,CHANNO(D) ; COULD HAVE CHANGED + MOVE P,(TP) ; RESTORE P + MOVEI B,CHNL0 + ASH A,1 ; MUNG ITS SLOT + ADDI A,(B) + MOVEM D,1(A) + HLLOS (A) ; MARK CHANNEL NOT TO BE RELOOKED AT + MOVE A,(P) ; MODE WORD BACK + MOVE B,[440000,,200000] ; FLAG BITS + TRNE A,1 ; SKIP FOR INPUT + TRC B,300000 ; CHANGE TO WRITE + MOVE A,CHANNO(D) ; GET JFN + OPENF + JRST ROPFLS + MOVE E,C ; LENGTH TO E + SIZEF ; GET CURRENT LENGTH + JRST ROPFLS + CAMGE B,E ; STILL A WINNER + JRST ROPFLS + MOVE A,CHANNO(D) ; JFN + MOVE B,C + SFPTR + JRST ROPFLS + SUB TP,[2,,2] ; FLUSH PDL POINTER + JRST REOPD1 + +ROPFLS: MOVE A,-2(TP) + MOVE A,CHANNO(A) + CLOSF ; ATTEMPT TO CLOSE + JFCL ; IGNORE FAILURE + SKIPA + +RGTJL: MOVE P,(TP) + SUB TP,[2,,2] + JRST REOPD + +DOACCS: PUSH P,B + EXCH A,B + MOVE A,CHANNO(A) + SFPTR + JRST ACCFAI + POP P,B + POPJ P, +] +PSUEDO: AOS (P) ; ASSUME SUCCESS FOR NOW + MOVEI B,RDEVIC-1(B) ; SEE WHAT DEVICE IS + PUSHJ P,CHRWRD + JFCL + JRST REOPD0 ; NO, RETURN HAPPY +IFN 0,[ CAME B,[ASCII /E&S/] ; DISPLAY ? + CAMN B,[ASCII /DIS/] + SKIPA B,(TP) ; YES, REGOBBLE CHANNEL AND CONTINUE + JRST REOPD0 ; NO, RETURN HAPPY + PUSHJ P,DISROP + SOS (P) ; DISPLAY DID NOT REOPEN, UNDO ASSUMPTION OF SUCCESS + JRST REOPD0] + + ;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL + +MFUNCTION FCLOSE,SUBR,[CLOSE] + + ENTRY 1 ;ONLY ONE ARG + GETYP A,(AB) ;CHECK ARGS + CAIE A,TCHAN ;IS IT A CHANNEL + JRST WTYP1 + MOVE B,1(AB) ;PICK UP THE CHANNEL + HRRZ A,CHANNO-1(B) ; GET REF COUNT + SOJGE A,CFIN5 ; NOT READY TO REALLY CLOSE + CAME B,TTICHN+1 ; CHECK FOR TTY + CAMN B,TTOCHN+1 + JRST CLSTTY + MOVE A,[JRST CHNCLS] + MOVEM A,IOINS(B) ;CLOBBER THE IO INS + MOVE A,RDEVIC-1(B) ;GET THE NAME OF THE DEVICE + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 +IFN ITS, MOVE A,(P) +IFE ITS, HLRZS A,(P) + MOVE B,1(AB) ; RESTORE CHANNEL +IFN 0,[ + CAME A,[SIXBIT /E&S /] + CAMN A,[SIXBIT /DIS /] + PUSHJ P,DISCLS] + MOVE B,1(AB) ; IN CASE CLOBBERED BY DISCLS + SKIPN A,CHANNO(B) ;ANY REAL CHANNEL? + JRST REMOV ; NO, EITHER CLOSED OR PSEUDO CHANNEL + + MOVE A,DIRECT-1(B) ; POINT TO DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; CONVERT TO WORD + POP P,A +IFN ITS, LDB E,[360600,,(P)] ; FIRST CHAR OD DEV NAME +IFE ITS, LDB E,[140600,,(P)] ; FIRST CHAR OD DEV NAME + CAIE E,'T ; SKIP IF TTY + JRST CFIN4 + CAME A,[SIXBIT /READ/] ; SKIP IF WINNER + JRST CFIN1 +IFN ITS,[ + MOVE B,1(AB) ; IN ITS CHECK STATUS + LDB A,[600,,STATUS(B)] + CAILE A,2 + JRST CFIN1 +] + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE CHAR + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,OFF ; TURN OFF INTERRUPT +CFIN1: MOVE B,1(AB) + MOVE A,CHANNO(B) +IFN ITS,[ + PUSHJ P,MCLOSE +] +IFE ITS,[ + TLZ A,400000 ; FOR JFN RELEASE + CLOSF ; CLOSE THE FILE AND RELEASE THE JFN + JFCL + MOVE A,CHANNO(B) +] +CFIN: LSH A,1 + ADDI A,CHNL0+1 ;POINT TO THIS CHANNELS LSOT + SETZM CHANNO(B) + SETZM (A) ;AND CLOBBER IT + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) + HLLZS ACCESS-1(B) +CFIN2: HLLZS -2(B) + MOVSI A,TCHAN ;RETURN THE CHANNEL + JRST FINIS + +CLSTTY: ERRUUO EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL + + +REMOV: MOVEI D,CHNL0+1 ;ATTEMPT TO REMOVE FROM PSUEDO CHANNEL LIST +REMOV0: SKIPN C,D ;FOUND ON LIST ? + JRST CFIN2 ;NO, JUST IGNORE THIS CLOSED CHANNEL + HRRZ D,(C) ;GET POINTER TO NEXT + CAME B,(D)+1 ;FOUND ? + JRST REMOV0 + HRRZ D,(D) ;YES, SPLICE IT OUT + HRRM D,(C) + JRST CFIN2 + + +; CLOSE UP ANY LEFTOVER BUFFERS + +CFIN4: +; CAME A,[SIXBIT /PRINTO/] +; CAMN A,[SIXBIT /PRINTB/] +; JRST .+3 +; CAME A,[SIXBIT /PRINT/] +; JRST CFIN1 + MOVE B,1(AB) ; GET CHANNEL + HRRZ A,-2(B) ;GET MODE BITS + TRNN A,C.PRIN + JRST CFIN1 + GETYP 0,BUFSTR-1(B) ; IS THERE AN OUTPUT BUFFER + SKIPN BUFSTR(B) + JRST CFIN1 + CAIE 0,TCHSTR + JRST CFINX1 + PUSHJ P,BFCLOS +IFE ITS,[ + MOVE A,CHANNO(B) + MOVEI B,7 + SFBSZ + JFCL + CLOSF + JFCL +] + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) +CFINX1: HLLZS ACCESS-1(B) + JRST CFIN1 + +CFIN5: HRRM A,CHANNO-1(B) + JRST CFIN2 + ;SUBR TO DO .ACCESS ON A READ CHANNEL +;FORM: +;POSITIONS CHANNEL AT CHARACTER POSN FIX-NUMBER +;H. BRODIE 7/26/72 + +MFUNCTION MACCESS,SUBR,[ACCESS] + ENTRY 2 ;ARGS: CHANNEL AND FIX-NUMBER + +;CHECK ARGUMENT TYPES + GETYP A,(AB) + CAIE A,TCHAN ;FIRST ARG SHOULD BE CHANNEL + JRST WTYP1 + GETYP A,2(AB) ;TYPE OF SECOND + CAIE A,TFIX ;SHOULD BE FIX + JRST WTYP2 + +;CHECK DIRECTION OF CHANNEL + MOVE B,1(AB) ;B GETS PNTR TO CHANNEL +; MOVEI B,DIRECT-1(B) ;GET DIRECTION OF CHANNEL +; PUSHJ P,CHRWRD ;GRAB THE CHAR STRNG +; JFCL +; CAME B,[+1] + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.PRIN + JRST MACCA + MOVE B,1(AB) + SKIPE C,BUFSTR(B) ;SEE IF WE MUST FLUSH PART BUFFER + PUSHJ P,BFCLOS + JRST MACC +MACCA: +; CAMN B,[ASCIZ /READ/] +; JRST .+4 +; CAME B,[ASCIZ /READB/] ; READB CHANNEL? +; JRST WRONGD +; AOS (P) ; SET INDICATOR FOR BINARY MODE + +;CHECK THAT THE CHANNEL IS OPEN +MACC: MOVE B,1(AB) ;GET BACK PTR TO CHANNEL + HRRZ E,-2(B) + TRNN E,C.OPN + JRST CHNCLS ;IF CHNL CLOSED => ERROR + +;COMPUTE ACCESS PNTR TO ACCESS WORD CHAR IS IN +;REMAINDER IS NUMBER OF TIMES TO INCR BYTE POINTER +ADEVOK: SKIPGE C,3(AB) ;GET CHAR POSN + ERRUUO EQUOTE NEGATIVE-ARGUMENT +MACC1: MOVEI D,0 + TRNN E,C.BIN ; SKIP FOR BINARY FILE + IDIVI C,5 + +;SETUP THE .ACCESS + TRNN E,C.PRIN + JRST NLSTCH + HRRZ 0,LSTCH-1(B) + MOVE A,ACCESS(B) + TRNN E,C.BIN + JRST LSTCH1 + IMULI A,5 + ADD A,ACCESS-1(B) + ANDI A,-1 +LSTCH1: CAIG 0,(A) + MOVE 0,A + MOVE A,C + IMULI A,5 + ADDI A,(D) + CAML A,0 + MOVE 0,A + HRRM 0,LSTCH-1(B) ; UPDATE "LARGEST" +NLSTCH: MOVE A,CHANNO(B) ;A GETS REAL CHANNEL NUMBER +IFN ITS,[ + DOTCAL ACCESS,[A,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + +IFE ITS,[ + MOVE B,C + SFPTR ; DO IT IN TENEX + JRST ACCFAI + MOVE B,1(AB) ; RESTORE CHANNEL +] +; POP P,E ; CHECK FOR READB MODE + TRNN E,C.READ + JRST ACCOUT ; PRINT TYPE CHANNEL, GO DO IT + SKIPE BUFSTR(B) ; IS THERE A READ BUFFER TO FLUSH + JRST .+3 + SETZM LSTCH(B) ; CLEAR OUT POSSIBLE EOF INDICATOR + JRST DONADV + +;NOW FORCE GETCHR TO DO A .IOT FIRST THING + MOVEI C,BUFSTR-1(B) ; FIND END OF STRING + PUSHJ P,BYTDOP" + SUBI A,2 ; LAST REAL WORD + HRLI A,010700 + MOVEM A,BUFSTR(B) + HLLZS BUFSTR-1(B) ; CLOBBER CHAR COUNT + SETZM LSTCH(B) ;CLOBBER READ'S HIDDEN CHARACTER + +;NOW DO THE APPROPRIATE NUM OF BYTE ADVANCEMENTS + JUMPLE D,DONADV +ADVPTR: PUSHJ P,GETCHR + MOVE B,1(AB) ;RESTORE IN CASE CLOBBERED + SOJG D,ADVPTR + +DONADV: MOVE C,3(AB) ;FIXUP ACCESS SLOT IN CHNL + HLLZS ACCESS-1(B) + MOVEM C,ACCESS(B) + MOVE A,$TCHAN ;TYPE OF RESULT = "CHANNEL" + JRST FINIS ;DONE...B CONTAINS CHANNEL + +IFE ITS,[ +ACCFAI: ERRUUO EQUOTE ACCESS-FAILURE +] +ACCOUT: SKIPN C,BUFSTR(B) ; FIXUP BUFFER? + JRST ACCOU1 + HRRZ F,BUFSTR-1(B) + ADD F,[-BUFLNT*5-4] + IDIVI F,5 + ADD F,BUFSTR(B) + HRLI F,010700 + MOVEM F,BUFSTR(B) + MOVEI F,BUFLNT*5 + HRRM F,BUFSTR-1(B) +ACCOU1: TRNE E,C.BIN ; FINISHED FOR BINARY CHANNELS + JRST DONADV + + JUMPE D,DONADV ; THIS CASE OK +IFE ITS,[ + MOVE A,CHANNO(B) ; GET LAST WORD + RFPTR + JFCL + PUSH P,B + MOVNI C,1 + MOVE B,[444400,,E] ; READ THE WORD + SIN + JUMPL C,ACCFAI + POP P,B + SFPTR + JFCL + MOVE B,1(AB) ; CHANNEL BACK + MOVE C,[440700,,E] + ILDB 0,C + IDPB 0,BUFSTR(B) + SOS BUFSTR-1(B) + SOJG D,.-3 + JRST DONADV +] +IFN ITS, ERRUUO EQUOTE CANT-ACCESS-ASCII-ON-ITS + + +;WRONG TYPE OF DEVICE ERROR +WRDEV: ERRUUO EQUOTE NON-DSK-DEVICE + +; BINARY READ AND PRINT ROUTINES + +MFUNCTION PRINTB,SUBR + + ENTRY + +PBFL: PUSH P,. ; PUSH NON-ZERONESS + MOVEI A,-7 + JRST BINI1 + +MFUNCTION READB,SUBR + + ENTRY + + PUSH P,[0] + MOVEI A,-11 +BINI1: HLRZ 0,AB + CAILE 0,-3 + JRST TFA + CAIG 0,(A) + JRST TMA + + GETYP 0,(AB) ; SHOULD BE UVEC OR STORE + CAIE 0,TSTORAGE + CAIN 0,TUVEC + JRST BINI2 + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTOK + JRST WTYP1 ; ELSE LOSE +BINI2: MOVE B,1(AB) ; GET IT + HLRE C,B + SUBI B,(C) ; POINT TO DOPE + GETYP A,(B) + PUSHJ P,SAT" ; GET ITS ST.ALOC.TYPE + CAIE A,S1WORD + JRST WTYP1 +BYTOK: GETYP 0,2(AB) + CAIE 0,TCHAN ; BETTER BE A CHANNEL + JRST WTYP2 + MOVE B,3(AB) ; GET IT +; MOVEI B,DIRECT-1(B) ; GET DIRECTION OF +; PUSHJ P,CHRWRD ; INTO 1 WORD +; JFCL +; MOVNI E,1 +; CAMN B,[ASCII /READB/] +; MOVEI E,0 +; CAMN B,[+1] + HRRZ A,-2(B) ; MODE BITS + TRNN A,C.BIN ; IF NOT BINARY + JRST WRONGD + MOVEI E,0 + TRNE A,C.PRIN + MOVE E,PBFL +; JUMPL E,WRONGD ; LOSER + CAME E,(P) ; CHECK WINNGE + JRST WRONGD + MOVE B,3(AB) ; GET CHANNEL BACK + SKIPN A,IOINS(B) ; OPEN? + PUSHJ P,OPENIT ; LOSE + CAMN A,[JRST CHNCLS] + JRST CHNCLS ; LOSE, CLOSED + JUMPN E,BUFOU1 ; JUMP FOR OUTPUT + MOVEI C,0 + CAML AB,[-5,,] ; SKIP IF EOF GIVEN + JRST BINI5 + MOVE 0,4(AB) + MOVEM 0,EOFCND-1(B) + MOVE 0,5(AB) + MOVEM 0,EOFCND(B) + CAML AB,[-7,,] + JRST BINI5 + GETYP 0,6(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,7(AB) +BINI5: SKIPE LSTCH(B) ; INDICATES IF EOF HIT + JRST BINEOF + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTI + MOVE A,1(AB) ; GET VECTOR + PUSHJ P,PGBIOI ; READ IT + HLRE C,A ; GET COUNT DONE + HLRE D,1(AB) ; AND FULL COUNT + SUB C,D ; C=> TOTAL READ + ADDM C,ACCESS(B) + JUMPGE A,BINIOK ; NOT EOF YET + SETOM LSTCH(B) +BINIOK: MOVE B,C + MOVSI A,TFIX ; RETURN AMOUNT ACTUALLY READ + JRST FINIS + +BYTI: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-LOST + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-LOST + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE STRING LENGTH + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 + PUSH P,C + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SIN] + PUSHJ P,PGBIOT + HLRE C,A ; GET COUNT DONE + POP P,D + SKIPN D + HRRZ D,(AB) ; AND FULL COUNT + ADD D,C ; C=> TOTAL READ + LDB E,[300600,,1(AB)] + MOVEI A,36. + IDIVM A,E + IDIVM D,E + ADDM E,ACCESS(B) + SKIPGE C ; NOT EOF YET + SETOM LSTCH(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-LOST + MOVE C,D + JRST BINIOK +] +BUFOU1: SKIPE BUFSTR(B) ; ANY BUFFERS AROUND? + PUSHJ P,BFCLS1 ; GET RID OF SAME + MOVEI C,0 + CAML AB,[-5,,] + JRST BINO5 + GETYP 0,4(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,5(AB) +BINO5: MOVE A,1(AB) + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTO + PUSH P,C + PUSHJ P,PGBIOO + POP P,C + JUMPE C,.+3 + HLRE C,1(AB) + MOVNS C + ADDM C,ACCESS(B) +BYTO1: MOVE A,(AB) ; RET VECTOR ETC. + MOVE B,1(AB) + JRST FINIS + +BYTO: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-FAILURE + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-FAILURE + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE SIZE + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 ; COMPENSATE FOR PGBIOT DOING THE WRONG THING + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SOUT] + PUSHJ P,PGBIOT + LDB D,[300600,,1(AB)] + MOVEI C,36. + IDIVM C,D + HRRZ C,(AB) + IDIVI C,(D) + ADDM C,ACCESS(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-FAILURE + JRST BYTO1 +] + +BINEOF: PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOSER + MCALL 1,EVAL + JRST FINIS + +OPENIT: PUSH P,E + PUSHJ P,OPNCHN ;TRY TO OPEN THE LOSER + JUMPE B,CHNCLS ;FAIL + POP P,E + POPJ P, + ; THESE SUBROUTINES BY NDR 9/16/73 TO FACILITATE THE +; TYPES OF IO NECESSARY TO MAKE MORE EFFICIENT USE OF +; THE NETWORK AND DO RELATED FILE TRANSFER TYPE OF JOBS. + +R1CHAR: SKIPN A,LSTCH(B) ; CHAR READING ROUTINE FOR FCOPY + PUSHJ P,RXCT + TLO A,200000 ; ^@ BUG + MOVEM A,LSTCH(B) + TLZ A,200000 + JUMPL A,.+2 ; IN CASE OF -1 ON STY + TRZN A,400000 ; EXCL HACKER + JRST .+4 + MOVEM A,LSTCH(B) ; SAVE DE-EXCLED CHAR + MOVEI A,"! + JRST .+2 + SETZM LSTCH(B) + PUSH P,C + HRRZ C,DIRECT-1(B) + CAIE C,5 ; IF DIRECTION IS 5 LONG THEN READB + JRST R1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) ; EVERY FIFTY INCREMENT + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +R1CH1: AOS ACCESS(B) + POP P,C + POPJ P, + +W1CHAR: CAIE A,15 ; CHAR WRITING ROUTINE, TEST FOR CR + JRST .+3 + SETOM CHRPOS(B) + AOSA LINPOS(B) + CAIE A,12 ; TEST FOR LF + AOS CHRPOS(B) ; IF NOT LF AOS CHARACTE5R POSITION + CAIE A,14 ; TEST FOR FORM FEED + JRST .+3 + SETZM CHRPOS(B) ; IF FORM FEED ZERO CHARACTER POSITION + SETZM LINPOS(B) ; AND LINE POSITION + CAIE A,11 ; IS THIS A TAB? + JRST .+6 + MOVE C,CHRPOS(B) + ADDI C,7 + IDIVI C,8. + IMULI C,8. ; FIX UP CHAR POS FOR TAB + MOVEM C,CHRPOS(B) ; AND SAVE + PUSH P,C + HRRZ C,-2(B) ; GET BITS + TRNN C,C.BIN ; SIX LONG MUST BE PRINTB + JRST W1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +W1CH1: AOS ACCESS(B) + PUSH P,A + PUSHJ P,WXCT + POP P,A + POP P,C + POPJ P, + +R1C: SUBM M,(P) ;LITTLE ENTRY FOR COMPILED STUFF +; PUSH TP,$TCHAN ;SAVE THE CHANNEL TO BLESS IT +; PUSH TP,B +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JFCL +; CAME B,[ASCIZ /READ/] +; CAMN B,[ASCII /READB/] +; JRST .+2 +; JRST BADCHN + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.READ + JRST BADCHN + SKIPN IOINS(B) ; IS THE CHANNEL OPEN + PUSHJ P,OPENIT ; NO, GO DO IT + PUSHJ P,GRB ; MAKE SURE WE HAVE A READ BUFFER + PUSHJ P,R1CHAR ; AND GET HIM A CHARACTER + JRST MPOPJ ; THATS ALL FOLKS + +W1C: SUBM M,(P) + PUSHJ P,W1CI + JRST MPOPJ + +W1CI: +; PUSH TP,$TCHAN +; PUSH TP,B + PUSH P,A ; ASSEMBLER ENTRY TO OUTPUT 1 CHAR +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; INTERNAL CALL TO W1CHAR +; JFCL +; CAME B,[ASCII /PRINT/] +; CAMN B,[+1] +; JRST .+2 +; JRST BADCHN +; POP TP,B +; POP TP,(TP) + HRRZ A,-2(B) + TRNN A,C.PRIN + JRST BADCHN + SKIPN IOINS(B) ; MAKE SURE THAT IT IS OPEN + PUSHJ P,OPENIT + PUSHJ P,GWB + POP P,A ; GET THE CHAR TO DO + JRST W1CHAR + +; ROUTINES TO REPLACE XCT IOINS(B) FOR INPUT AND OUTPUT +; THEY DO THE XCT THEN CHECK OUT POSSIBLE SCRIPTAGE--BLECH. + + +WXCT: +RXCT: XCT IOINS(B) ; READ IT + SKIPN SCRPTO(B) + POPJ P, + +DOSCPT: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; AND SAVE THE CHAR AROUND + + SKIPN SCRPTO(B) ; IF ZERO FORGET IT + JRST SCPTDN ; THATS ALL THERE IS TO IT + PUSH P,C ; SAVE AN ACCUMULATOR FOR CLEANLINESS + GETYP C,SCRPTO-1(B) ; IS IT A LIST + CAIE C,TLIST + JRST BADCHN + PUSH TP,$TLIST + PUSH TP,[0] ; SAVE A SLOT FOR THE LIST + MOVE C,SCRPTO(B) ; GET THE LIST OF SCRIPT CHANNELS +SCPT1: GETYP B,(C) ; GET THE TYPE OF THIS SCRIPT CHAN + CAIE B,TCHAN + JRST BADCHN ; IF IT ISN'T A CHANNEL, COMPLAIN + HRRZ B,(C) ; GET THE REST OF THE LIST IN B + MOVEM B,(TP) ; AND STORE ON STACK + MOVE B,1(C) ; GET THE CHANNEL IN B + MOVE A,-1(P) ; AND THE CHARACTER IN A + PUSHJ P,W1CI ; GO TO INTERNAL W1C, IT BLESSES GOODIES + SKIPE C,(TP) ; GET THE REST OF LIST OF CHANS + JRST SCPT1 ; AND CYCLE THROUGH + SUB TP,[2,,2] ; CLEAN OFF THE LIST OF CHANS + POP P,C ; AND RESTORE ACCUMULATOR C +SCPTDN: POP P,A ; RESTORE THE CHARACTER + POP TP,B ; AND THE ORIGINAL CHANNEL + POP TP,(TP) + POPJ P, ; AND THATS ALL + + +; SUBROUTINE TO COPY FROM INCHAN TO OUTCHAN UNTIL EOF HIT +; ON THE INPUT CHANNEL +; CALL IS WHERE DEFAULTS ARE INCHAN AND OUTCHAN + + MFUNCTION FCOPY,SUBR,[FILECOPY] + + ENTRY + HLRE 0,AB + CAMGE 0,[-4] + JRST WNA ; TAKES FROM 0 TO 2 ARGS + + JUMPE 0,.+4 ; NO FIRST ARG? + PUSH TP,(AB) + PUSH TP,1(AB) ; SAVE IN CHAN + JRST .+6 + MOVE A,$TATOM + MOVE B,IMQUOTE INCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B + HLRE 0,AB ; CHECK FOR SECOND ARG + CAML 0,[-2] ; WAS THERE MORE THAN ONE ARG? + JRST .+4 + PUSH TP,2(AB) ; SAVE SECOND ARG + PUSH TP,3(AB) + JRST .+6 + MOVE A,$TATOM ; LOOK UP OUTCHAN AS DEFAULT + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B ; AND SAVE IT + + MOVE A,-3(TP) + MOVE B,-2(TP) ; INPUT CHANNEL + MOVEI 0,C.READ ; INDICATE INPUT + PUSHJ P,CHKCHN ; CHECK FOR GOOD CHANNEL + MOVE A,-1(TP) + MOVE B,(TP) ; GET OUT CHAN + MOVEI 0,C.PRIN ; INDICATE OUT CHAN + PUSHJ P,CHKCHN ; CHECK FOR GOOD OUT CHAN + + PUSH P,[0] ; COUNT OF CHARS OUTPUT + + MOVE B,-2(TP) + PUSHJ P,GRB ; MAKE SURE WE HAVE READ BUFF + MOVE B,(TP) + PUSHJ P,GWB ; MAKE SURE WE HAVE WRITE BUFF + +FCLOOP: INTGO + MOVE B,-2(TP) + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,FCDON ; IF A NEG NUMBER WE GOT EOF + MOVE B,(TP) ; GET OUT CHAN + PUSHJ P,W1CHAR ; SPIT IT OUT + AOS (P) ; INCREMENT COUNT + JRST FCLOOP + +FCDON: SUB TP,[2,,2] ; POP OFF OUTCHAN + MCALL 1,FCLOSE ; CLOSE INCHAN + MOVE A,$TFIX + POP P,B ; GET CHAR COUNT TO RETURN + JRST FINIS + +CHKCHN: PUSH P,0 ; CHECK FOR GOOD TASTING CHANNEL + PUSH TP,A + PUSH TP,B + GETYP C,A + CAIE C,TCHAN + JRST CHKBDC ; GO COMPLAIN IN RIGHT WAY +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JRST CHKBDC +; MOVE C,(P) ; GET CHAN DIRECT + HRRZ C,-2(B) ; MODE BITS + TDNN C,0 + JRST CHKBDC +; CAMN B,CHKT(C) +; JRST .+4 +; ADDI C,2 ; TEST FOR READB OR PRINTB ALSO +; CAME B,CHKT(C) ; TEST FOR CORRECT DIRECT +; JRST CHKBDC + MOVE B,(TP) + SKIPN IOINS(B) ; MAKE SURE IT IS OPEN + PUSHJ P,OPENIT ; IF ZERO IOINS GO OPEN IT + SUB TP,[2,,2] + POP P, ; CLEAN UP STACKS + POPJ P, + +CHKT: ASCIZ /READ/ + ASCII /PRINT/ + ASCII /READB/ + +1 + +CHKBDC: POP P,E + MOVNI D,2 + IMULI D,1(E) + HLRE 0,AB + CAMLE 0,D ; SEE IF THIS WAS HIS ARG OF DEFAULT + JRST BADCHN + JUMPE E,WTYP1 + JRST WTYP2 + + ; FUNCTIONS READSTRING AND PRINTSTRING WORK LIKE READB AND PRINTB, +; THAT IS THEY READ INTO AND OUT OF STRINGS. IN ADDITION BOTH ACCEPT +; AN ADDITIONAL ARGUMENT WHICH IS THE NUMBER OF CHARS TO READ OR PRINT, IF +; IT IS DESIRED FOR THIS TO BE DIFFERENT THAN THE LENGTH OF THE STRING. + +; FORMAT IS +; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN + +; FORMAT FOR PRINTSTRING IS + +; THESE WERE CODED 9/16/73 BY NEAL D. RYAN + + MFUNCTION RSTRNG,SUBR,READSTRING + + ENTRY + PUSH P,[0] ; FLAG TO INDICATE READING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-9] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 4 ARGS + JRST STRIO1 + + MFUNCTION PSTRNG,SUBR,PRINTSTRING + + ENTRY + PUSH P,[1] ; FLAG TO INDICATE WRITING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-7] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 3 ARGS + +STRIO1: PUSH TP,[0] ; SAVE SLOT ON STACK + PUSH TP,[0] + GETYP 0,(AB) + CAIE 0,TCHSTR ; MAKE SURE WE GOT STRING + JRST WTYP1 + HRRZ 0,(AB) ; CHECK FOR EMPTY STRING + SKIPN (P) + JUMPE 0,MTSTRN + HLRE 0,AB + CAML 0,[-2] ; WAS A CHANNEL GIVEN + JRST STRIO2 + GETYP 0,2(AB) + SKIPN (P) ; SKIP IF PRINT + JRST TESTIN + CAIN 0,TTP ; SEE IF FLATSIZE HACK + JRST STRIO9 +TESTIN: CAIE 0,TCHAN + JRST WTYP2 ; SECOND ARG NOT CHANNEL + MOVE B,3(AB) + HRRZ B,-2(B) + MOVNI E,1 ; CHECKING FOR GOOD DIRECTION + TRNE B,C.READ ; SKIP IF NOT READ + MOVEI E,0 + TRNE B,C.PRIN ; SKIP IF NOT PRINT + MOVEI E,1 + CAME E,(P) + JRST WRONGD ; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE +STRIO9: PUSH TP,2(AB) + PUSH TP,3(AB) ; PUSH ON CHANNEL + JRST STRIO3 +STRIO2: MOVE B,IMQUOTE INCHAN + MOVSI A,TCHAN + SKIPE (P) + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + GETYP 0,A + SKIPN (P) ; SKIP IF PRINTSTRING + JRST TESTI2 + CAIN 0,TTP ; SKIP IF NOT FLATSIZE HACK + JRST STRIO8 +TESTI2: CAIE 0,TCHAN + JRST BADCHN ; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL +STRIO8: PUSH TP,A + PUSH TP,B +STRIO3: MOVE B,(TP) ; GET CHANNEL + SKIPN E,IOINS(B) + PUSHJ P,OPENIT ; IF NOT GO OPEN + MOVE E,IOINS(B) + CAMN E,[JRST CHNCLS] + JRST CHNCLS ; CHECK TO SEE THAT CHANNEL ISNT ALREADY CLOSED +STRIO4: HLRE 0,AB + CAML 0,[-4] + JRST STRIO5 ; NO COUNT TO WORRY ABOUT + GETYP 0,4(AB) + MOVE E,4(AB) + MOVE C,5(AB) + CAIE 0,TCHSTR + CAIN 0,TFIX ; BETTER BE A FIXED NUMBER + JRST .+2 + JRST WTYP3 + HRRZ D,(AB) ; GET ACTUAL STRING LENGTH + CAIN 0,TFIX + JRST .+7 + SKIPE (P) ; TEST FOR WRITING + JRST .-7 ; IF WRITING WE GOT TROUBLE + PUSH P,D ; ACTUAL STRING LENGTH + MOVEM E,(TB) ; STUFF HIS FUNNY DELIM STRING + MOVEM C,1(TB) + JRST STRIO7 + CAML D,C ; MAKE SURE THE STRING IS LONG ENOUGH + JRST .+2 ; WIN + ERRUUO EQUOTE COUNT-GREATER-THAN-STRING-SIZE + PUSH P,C ; PUSH ON MAX COUNT + JRST STRIO7 +STRIO5: +STRIO6: HRRZ C,(AB) ; GET CHAR COUNT + PUSH P,C ; AND PUSH IT ON STACK AS NO MAX COUNT GIVEN +STRIO7: HLRE 0,AB + CAML 0,[-6] + JRST .+6 + MOVE B,(TP) ; GET THE CHANNEL + MOVE 0,6(AB) + MOVEM 0,EOFCND-1(B) ; STUFF IN SLOT IN CHAN + MOVE 0,7(AB) + MOVEM 0,EOFCND(B) + PUSH TP,(AB) ; PUSH ON STRING + PUSH TP,1(AB) + PUSH P,[0] ; PUSH ON CURRENT COUNT OF CHARS DONE + MOVE 0,-2(P) ; GET READ OR WRITE FLAG + JUMPN 0,OUTLOP ; GO WRITE STUFF + + MOVE B,-2(TP) ; GET CHANNEL + PUSHJ P,GRB ; MAKE SURE WE HAVE BUFF + SKIPGE A,LSTCH(B) ; CHECK FOR EOF ALREADY READ PREVIOUSLY + JRST SRDOEF ; GO DOES HIS EOF HACKING +INLOP: INTGO + MOVE B,-2(TP) ; GET CHANNEL + MOVE C,-1(P) ; MAX COUNT + CAMG C,(P) ; COMPARE WITH COUNT DONE + JRST STREOF ; WE HAVE FINISHED + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,INEOF ; EOF HIT + MOVE C,1(TB) + HRRZ E,(TB) ; DO WE HAVE A STRING TO WORRY US? + SOJL E,INLNT ; GO FINISH STUFFING + ILDB D,C + CAME D,A + JRST .-3 + JRST INEOF +INLNT: IDPB A,(TP) ; STUFF IN STRING + SOS -1(TP) ; DECREMENT STRING COUNT + AOS (P) ; INCREMENT CHAR COUNT + JRST INLOP + +INEOF: SKIPE C,LSTCH(B) ; IS THIS AN ! AND IS THERE A CHAR THERE + JRST .+3 ; YES + MOVEM A,LSTCH(B) ; NO SAVE THE CHAR + JRST .+3 + ADDI C,400000 + MOVEM C,LSTCH(B) + MOVSI C,200000 + IORM C,LSTCH(B) + HRRZ C,DIRECT-1(B) ; GET THE TYPE OF CHAN + CAIN C,5 ; IS IT READB? + JRST .+3 + SOS ACCESS(B) ; FIX UP ACCESS FOR READ CHANNEL + JRST STREOF ; AND THATS IT + HRRZ C,ACCESS-1(B) ; FOR A READB ITS WORSE + MOVEI D,5 + SKIPG C + HRRM D,ACCESS-1(B) ; CHANGE A 0 TO A FIVE + SOS C,ACCESS-1(B) + CAMN C,[TFIX,,0] + SOS ACCESS(B) ; AND SOS THE WORD COUNT MAYBE + JRST STREOF + +SRDOEF: SETZM LSTCH(B) ; IN CASE OF -1, FLUSH IT + AOJE A,INLOP ; SKIP OVER -1 ON PTY'S + SUB TP,[6,,6] + SUB P,[3,,3] ; POP JUNK OFF STACKS + PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) ; WHAT WE NEED TO EVAL + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOOSING CHANNEL + MCALL 1,EVAL ; EVAL HIS EOF JUNK + JRST FINIS + +OUTLOP: MOVE B,-2(TP) +OUTLP1: INTGO + MOVE A,-3(TP) ; GET CHANNEL + MOVE B,-2(TP) + MOVE C,-1(P) ; MAX COUNT TO DO + CAMG C,(P) ; HAVE WE DONE ENOUGH + JRST STREOF + ILDB D,(TP) ; GET THE CHAR + SOS -1(TP) ; SUBTRACT FROM STRING LENGTH + AOS (P) ; INC COUNT OF CHARS DONE + PUSHJ P,CPCH1 ; GO STUFF CHAR + JRST OUTLP1 + +STREOF: MOVE A,$TFIX + POP P,B ; RETURN THE LOOSER A COUNT OF WHAT WAS DONE + SUB P,[2,,2] + SUB TP,[6,,6] + JRST FINIS + + +GWB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A WRITE BUFFER ON PRINTB CHAN + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVSI A,TWORD+.VECT. + MOVEM A,BUFLNT(B) + SETOM (B) + MOVEI C,1(B) + HRLI C,(B) + BLT C,BUFLNT-1(B) + MOVEI C,-1(B) + HRLI C,010700 + MOVE B,(TP) + MOVEI 0,C.BUF + IORM 0,-2(B) + MOVEM C,BUFSTR(B) + MOVE C,[TCHSTR,,BUFLNT*5] + MOVEM C,BUFSTR-1(B) + SUB TP,[2,,2] + POPJ P, + + +GRB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A READ BUFFER + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVEI C,BUFLNT-1(B) + POP TP,B + MOVEI 0,C.BUF + IORM 0,-2(B) + HRLI C,010700 + MOVEM C,BUFSTR(B) + MOVSI C,TCHSTR + MOVEM C,BUFSTR-1(B) + SUB TP,[1,,1] + POPJ P, + +MTSTRN: ERRUUO EQUOTE EMPTY-STRING + + ; INPUT UNBUFFERING ROUTINE. THIS DOES THE CHARACTER UNBUFFERING +; FOR INPUT. THE OPEN ROUTINE SETUPS A PUSHJ P, TO +; THIS ROUTINE AS THE IOINS FOR A CHANNEL OPEN TO A NON-TTY DEVICE. + +; H. BRODIE 7/19/72 + +; CALLING SEQ: +; PUSHJ P,GETCHR +; B/ AOBJN PNTR TO CHANNEL VECTOR +; RETURNS NEXT CHARACTER IN AC A. +; ON ENCOUNTERING EITHER ^C OR NUL(^@) IT ASSUMES EOF AND +; TRANSMITS ONLY ^C ON SUCCESSIVE CALLS + + +GETCHR: +; FIRST GRAB THE BUFFER +; GETYP A,BUFSTR-1(B) ; GET TYPE WORD +; CAIN A,TCHSTR ; SKIPS IF NOT CHSTR (I.E. IF BAD BUFFER) +; JRST GTGBUF ; IS GOOD BUFFER...SKIP ERROR RETURN +GTGBUF: HRRZ A,BUFSTR-1(B) ; GET LENGTH OF STRING + SOJGE A,GTGCHR ; JUMP IF STILL MORE + +; HERE IF THE BUFFER WAS EXHAUSTED (BYTE PNTR POINTS INTO DOPE WDS) +; GENERATE AN .IOT POINTER +;FIRST SAVE C AND D AS I WILL CLOBBER THEM +NEWBUF: PUSH P,C + PUSH P,D +IFN ITS,[ + LDB C,[600,,STATUS(B)] ; GET TYPE + CAIG C,2 ; SKIP IF NOT TTY +] +IFE ITS,[ + SKIPE BUFRIN(B) +] + JRST GETTTY ; GET A TTY BUFFER + + PUSHJ P,PGBUFI ; RE-FILL BUFFER + +IFE ITS, MOVEI C,-1 + JUMPGE A,BUFGOO ;SKIPS IF IOT COMPLETED...FIX UP CHANNEL + MOVEI C,1 ; MAKE SURE LAST EOF REALLY ENDS IT + ANDCAM C,-1(A) + MOVSI C,014000 ; GET A ^C + MOVEM C,(A) ;FAKE AN EOF + +IFE ITS,[ + HLRE C,A ; HOW MUCH LEFT + ADDI C,BUFLNT ; # OF WORDS TO C + IMULI C,5 ; TO CHARS + MOVE A,-2(B) ; GET BITS + TRNE A,C.BIN ; CAN'T HELP A BINARY CHANNEL + JRST BUFGOO + MOVE A,CHANNO(B) + PUSH P,B + PUSH P,D + PUSH P,C + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + MOVE B,[2,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + POP P,C + CAIE D,7 ; SEVEN BIT BYTES? + JRST BUFGO1 ; NO, DONT HACK + MOVE D,C + IDIVI B,5 ; C IS NUMBER IN LAST WORD IF NOT EVEN + SKIPN C + MOVEI C,5 + ADDI C,-5(D) ; FIXUP C FOR WINNAGE +BUFGO1: POP P,D + POP P,B +] +; RESET THE BYTE POINTER IN THE CHANNEL. +; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D +BUFGOO: HRLI D,010700 ; GENERATE VIRGIN LH + SUBI D,1 + + MOVEM D,BUFSTR(B) ; STASH IN THE BUFFER BYTE PNTR SLOT +IFE ITS, HRRM C,LSTCH-1(B) ; SAVE IT + MOVEI A,BUFLNT*5-1 +BUFROK: POP P,D ;RESTORE D + POP P,C ;RESTORE C + + +; HERE IF THERE ARE CHARS IN BUFFER +GTGCHR: HRRM A,BUFSTR-1(B) + ILDB A,BUFSTR(B) ; GET A CHAR FROM BUFFER + +IFN ITS,[ + CAIE A,3 ; EOF? + POPJ P, ; AND RETURN + LDB A,[600,,STATUS(B)] ; CHECK FOR TTY + CAILE A,2 ; SKIP IF TTY +] +IFE ITS,[ + PUSH P,0 + HRRZ 0,LSTCH-1(B) + SOJL 0,.+4 + HRRM 0,LSTCH-1(B) + POP P,0 + POPJ P, + + POP P,0 + MOVSI A,-1 + SKIPN BUFRIN(B) +] + JRST .+3 +RETEO1: HRRI A,3 + POPJ P, + + HRRZ A,BUFSTR(B) ; SEE IF RSUBR START BIT IS ON + HRRZ A,(A) + TRNN A,1 + MOVSI A,-1 + JRST RETEO1 + +IFN ITS,[ +PGBUFO: +PGBUFI: +] +IFE ITS,[ +PGBUFO: SKIPA D,[SOUT] +PGBUFI: MOVE D,[SIN] +] + SKIPGE A,BUFSTR(B) ; POINT TO CURRENT BUFFER POSIT + SUBI A,1 ; FOR 440700 AND 010700 START + SUBI A,BUFLNT-1 ; CALCULATE PNTR TO BEG OF BUFFER + HRLI A,-BUFLNT ; IOT (AOBJN) PNTR IN A + MOVSI C,004400 +IFN ITS,[ +PGBIOO: +PGBIOI: MOVE D,A ; COPY FOR LATER + MOVSI C,TUVEC ; PREPARE TO HANDDLE INTS + MOVE PVP,PVSTOR+1 + MOVEM C,DSTO(PVP) + MOVEM C,ASTO(PVP) + MOVSI C,TCHAN + MOVEM C,BSTO(PVP) + +; BUILD .IOT INSTR + MOVE C,CHANNO(B) ; CHANNEL NUMBER IN C + ROT C,23. ; MOVE INTO AC FIELD + IOR C,[.IOT 0,A] ; IOR IN SKELETON .IOT + +; DO THE .IOT + ENABLE ; ALLOW INTS + XCT C ; EXECUTE THE .IOT INSTR + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM ASTO(PVP) + SETZM DSTO(PVP) + POPJ P, +] + +IFE ITS,[ +PGBIOT: PUSH P,D + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,C + HRRZS (P) + HRRI C,-1(A) ; POINT TO BUFFER + HLRE D,A ; XTRA POINTER + MOVNS D + HRLI D,TCHSTR + MOVE PVP,PVSTOR+1 + MOVEM D,BSTO(PVP) + MOVE D,[PUSHJ P,FIXACS] + MOVEM D,ONINT + MOVSI D,TUVEC + MOVEM D,DSTO(PVP) + MOVE D,A + MOVE A,CHANNO(B) ; FILE JFN + MOVE B,C + HLRE C,D ; - COUNT TO C + SKIPE (P) + MOVN C,(P) ; REAL DESIRED COUNT + SUB P,[1,,1] + ENABLE + XCT (P) ; DO IT TO IT + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM DSTO(PVP) + SETZM ONINT + MOVEI A,1(B) + MOVE B,(TP) + SUB TP,[2,,2] + SUB P,[1,,1] + JUMPGE C,CPOPJ ; NO EOF YET + HRLI A,(C) ; LOOK LIKE AN AOBJN PNTR + POPJ P, + +FIXACS: PUSH P,PVP + MOVE PVP,PVSTOR+1 + MOVNS C + HRRM C,BSTO(PVP) + MOVNS C + POP P,PVP + POPJ P, + +PGBIOO: SKIPA D,[SOUT] +PGBIOI: MOVE D,[SIN] + HRLI C,004400 + JRST PGBIOT +DOIOTO: PUSH P,[SOUT] +DOIOTC: PUSH P,B + PUSH P,C + EXCH A,B + MOVE A,CHANNO(A) + HLRE C,B + HRLI B,444400 + XCT -2(P) + HRL B,C + MOVE A,B +DOIOTE: POP P,C + POP P,B + SUB P,[1,,1] + POPJ P, +DOIOTI: PUSH P,[SIN] + JRST DOIOTC +] + +; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE + +PUTCHR: PUSH P,A + GETYP A,BUFSTR-1(B) ; CHECK TYPE OF ARG + CAIE A,TCHSTR ; MUST BE STRING + JRST BDCHAN + + HRRZ A,BUFSTR-1(B) ; GET CHAR COUNT + JUMPE A,REBUFF ; PREV RESET BUFF, UNDO SAME + +PUTCH1: POP P,A ; RESTORE CHAR + CAMN A,[-1] ; SPECIAL HACK? + JRST PUTCH2 ; YES GO HANDLE + IDPB A,BUFSTR(B) ; STUFF IT +PUTCH3: SOS A,BUFSTR-1(B) ; COUNT DOWN STRING + TRNE A,-1 ; SKIP IF FULL + POPJ P, + +; HERE TO FLUSH OUT A BUFFER + + PUSH P,C + PUSH P,D + PUSHJ P,PGBUFO ; SETUP AND DO IOT + HRLI D,010700 ; POINT INTO BUFFER + SUBI D,1 + MOVEM D,BUFSTR(B) ; STORE IT + MOVEI A,BUFLNT*5 ; RESET COUNT + HRRM A,BUFSTR-1(B) + POP P,D + POP P,C + POPJ P, + +;HERE TO DA ^C AND TURN ON MAGIC BIT + +PUTCH2: MOVEI A,3 + IDPB A,BUFSTR(B) ; ZAP OUT THE ^C + MOVEI A,1 ; GET BIT +IFE ITS,[ + PUSH P,C + HRRZ C,BUFSTR(B) + IORM A,(C) + POP P,C +] +IFN ITS,[ + IORM A,@BUFSTR(B) ; ON GOES THE BIT +] + JRST PUTCH3 + +; RESET A FUNNY BUF + +REBUFF: MOVEI A,BUFLNT*5 ; 1ST COUNT + HRRM A,BUFSTR-1(B) + HRRZ A,BUFSTR(B) ; NOW POINTER + SUBI A,BUFLNT+1 + HRLI A,010700 + MOVEM A,BUFSTR(B) ; STORE BACK + JRST PUTCH1 + + +; HERE TO FLUSH FINAL BUFFER + +BFCLOS: HRRZ C,-2(B) ; THIS BUFFER FLUSHER THE WORK OF NDR + MOVEI A,0 + TRNE C,C.TTY + POPJ P, + TRNE C,C.DISK + MOVEI A,1 + PUSH P,A ; SAVE THE RESULT OF OUR TEST + JUMPN A,BFCLNN ; DONT HAVE TO CHECK NET STATE + PUSH TP,$TCHAN + PUSH TP,B ; SAVE CHANNEL + PUSHJ P,INSTAT ; GET CURRENT NETWORK STATE + MOVE A,(B) ; GET FIRST ELEMENT OF STATE UVECTOR WHICH IS CUR STATE + POP TP,B ; RESTORE B + POP TP, + CAIE A,5 ; IS NET IN OPEN STATE? + CAIN A,6 ; OR ELSE IS IT IN RFNM WAIT STATE + JRST BFCLNN ; IF SO TO THE IOT + POP P, ; ELSE FLUSH CRUFT AND DONT IOT + POPJ P, ; RETURN DOING NO IOT +BFCLNN: MOVEI C,BUFLNT*5 ; NEW BUFFER FLUSHER BY NDR + HRRZ D,BUFSTR-1(B) ; SO THAT NET ALSO WORKS RIGHT + SUBI C,(D) ; GET NUMBER OF CHARS + IDIVI C,5 ; NUMBER OF FULL WORDS AND REST + PUSH P,D ; SAVE NUMBER OF ODD CHARS + SKIPGE A,BUFSTR(B) ; GET CURRENT BUF POSITION + SUBI A,1 ; FIX FOR 440700 BYTE POINTER +IFE ITS,[ + HRRO D,A + PUSH P,(D) +] +IFN ITS,[ + PUSH P,(A) ; SAVE THE ODD WORD OF BUFFER +] + MOVEI D,BUFLNT + SUBI D,(C) + SKIPE -1(P) + SUBI A,1 + ADDI D,1(A) ; FIX UP FOR POSSIBLE ODD CHARS + PUSH TP,$TUVEC + PUSH TP,D ; PUSH THE DOPE VECTOR ONTO THE STACK + JUMPE C,BFCLSR ; IN CASE THERE ARE NO FULL WORDS TO DO + HRL A,C + TLO A,400000 + MOVE E,[SETZ BUFLNT(A)] + SUBI E,(C) ; FIX UP FOR BACKWARDS BLT + POP A,@E ; AMAZING GRACE + TLNE A,377777 + JRST .-2 + HRRO A,D ; SET UP AOBJN POINTER + SUBI A,(C) + TLC A,-1(C) + PUSHJ P,PGBIOO ; DO THE IOT OF ALL THE FULL WORDS +BFCLSR: HRRO A,(TP) ; GET IOT PTR FOR REST OF JUNK + SUBI A,1 ; POINT TO WORD BEFORE DOPE WORDS + POP P,0 ; GET BACK ODD WORD + POP P,C ; GET BACK ODD CHAR COUNT + POP P,D ; FLAG FOR NET OR DSK + JUMPN D,BFCDSK ; GO FINISH OFF DSK + JUMPE C,BFCLSD ; IF NO ODD CHARS FINISH UP + MOVEI D,7 + IMULI D,(C) ; FIND NO OF BITS TO SHIFT + LSH 0,-43(D) ; SHIFT BITS TO RIGHT PLACE + MOVEM 0,(A) ; STORE IN STRING + SUBI C,5 ; HOW MANY CHAR POSITIONS TO SKIP + MOVNI C,(C) ; MAKE C POSITIVE + LSH C,17 + TLC A,(C) ; MUNG THE AOBJN POINTER TO KLUDGE + PUSHJ P,PGBIOO ; DO IOT OF ODD CHARS + MOVEI C,0 +BFCLSD: HRRZ A,(TP) ; GET PTR TO DOPE WORD + SUBI A,BUFLNT+1 + JUMPLE C,.+3 + SKIPE ACCESS(B) + MOVEM 0,1(A) ; LAST WORD BACK IN BFR + HRLI A,010700 ; AOBJN POINTER TO FIRST OF BUFFER + MOVEM A,BUFSTR(B) + MOVEI A,BUFLNT*5 + HRRM A,BUFSTR-1(B) + SKIPN ACCESS(B) + JRST BFCLSY + JUMPL C,BFCLSY + JUMPE C,BFCLSZ + IBP BUFSTR(B) + SOS BUFSTR-1(B) + SOJG C,.-2 +BFCLSY: MOVE A,CHANNO(B) + MOVE C,B +IFE ITS,[ + RFPTR + FATAL RFPTR FAILED + HRRZ F,LSTCH-1(C) ; PREVIOUS HIGH + MOVE G,C ; SAVE CHANNEL + MOVE C,B + CAML F,B + MOVE C,F + MOVE F,B + HRLI A,400000 + CLOSF + JFCL + MOVNI B,1 + HRLI A,12 + CHFDB + MOVE B,STATUS(G) + ANDI A,-1 + OPENF + FATAL OPENF LOSES + MOVE C,F + IDIVI C,5 + MOVE B,C + SFPTR + FATAL SFPTR FAILED + MOVE B,G +] +IFN ITS,[ + DOTCAL RFPNTR,[A,[2000,,B]] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + SUBI B,1 + DOTCAL ACCESS,[A,B] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + MOVE B,C +] +BFCLSZ: SUB TP,[2,,2] + POPJ P, + +BFCDSK: TRZ 0,1 + PUSH P,C +IFE ITS,[ + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,0 ; WORD OF CHARS + MOVE A,CHANNO(B) + MOVEI B,7 ; MAKE BYTE SIZE 7 + SFBSZ + JFCL + HRROI B,(P) + MOVNS C + SKIPE C + SOUT + MOVE B,(TP) + SUB P,[1,,1] + SUB TP,[2,,2] +] +IFN ITS,[ + MOVE D,[440700,,A] + DOTCAL SIOT,[CHANNO(B),D,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + POP P,C + JUMPN C,BFCLSD +BFCDS1: MOVNI C,1 ; INDICATE NOT TOHACK BUFFER + JRST BFCLSD + +BFCLS1: HRRZ C,DIRECT-1(B) + MOVSI 0,(JFCL) + CAIE C,6 + MOVE 0,[AOS ACCESS(B)] + PUSH P,0 + HRRZ C,BUFSTR-1(B) + IDIVI C,5 + JUMPE D,BCLS11 + MOVEI A,40 ; PAD WITH SPACES + PUSHJ P,PUTCHR + XCT (P) ; AOS ACCESS IF NECESSARY + SOJG D,.-3 ; TO END OF WORD +BCLS11: POP P,0 + HLLZS ACCESS-1(B) + HRRZ C,BUFSTR-1(B) + CAIE C,BUFLNT*5 + PUSHJ P,BFCLOS + POPJ P, + + +; HERE TO GET A TTY BUFFER + +GETTTY: SKIPN C,EXBUFR(B) ; SKIP IF BUFFERS BACKED UP + JRST TTYWAI + HRRZ D,(C) ; CDR THE LIST + GETYP A,(C) ; CHECK TYPE + CAIE A,TDEFER ; MUST BE DEFERRED + JRST BDCHAN + MOVE C,1(C) ; GET DEFERRED GOODIE + GETYP A,(C) ; BETTER BE CHSTR + CAIE A,TCHSTR + JRST BDCHAN + MOVE A,(C) ; GET FULL TYPE WORD + MOVE C,1(C) + MOVEM D,EXBUFR(B) ; STORE CDR'D LIST + MOVEM A,BUFSTR-1(B) ; MAKE CURRENT BUFFER + MOVEM C,BUFSTR(B) + HRRM A,LSTCH-1(B) + SOJA A,BUFROK + +TTYWAI: PUSHJ P,TTYBLK ; BLOCKED FOR TTY I/O + JRST GETTTY ; SHOULD ONLY RETURN HAPPILY + + ;INTERNAL DEVICE READ ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT, +;CHECKS THAT THE RETURNED VALUE IS OF TYPE CHARACTER, +;AND RETURNS THAT AS THE NEXT CHARACTER IN THE "FILE" + +;H. BRODIE 8/31/72 + +GTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,INTFCN-1(B) + GETYP A,A + CAIE A,TCHRS + JRST BADRET + MOVE A,B +INTRET: POP P,0 ;RESTORE THE ACS + POP P,E + POP P,D + POP P,C + POP TP,B ;RESTORE THE CHANNEL + SUB TP,[1,,1] ;FLUSH $TCHAN...WE DON'T NEED IT + POPJ P, + + +BADRET: ERRUUO EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT + +;INTERNAL DEVICE PRINT ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,(FUNCTION, SUBR, OR RSUBR) +;TO THE CURRENT CHARACTER BEING "PRINTED". + +PTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,$TCHRS ;PUSH THE TYPE "CHARACTER" + PUSH TP,A ;PUSH THE CHAR + PUSH TP,$TCHAN ;PUSH THE CHANNEL + PUSH TP,B + MCALL 2,INTFCN-1(B) ;APPLY THE FUNCTION TO THE CHAR + JRST INTRET + + + +; ROUTINE TO FLUSH OUT A PRINT BUFFER + +MFUNCTION BUFOUT,SUBR + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + + MOVE B,1(AB) +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; GET DIR NAME +; JFCL +; CAMN B,[ASCII /PRINT/] +; JRST .+3 +; CAME B,[+1] +; JRST WRONGD +; TRNE B,1 ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN B,1 ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] + HRRZ 0,-2(B) + TRNN 0,C.PRIN + JRST WRONGD +; TRNE 0,C.BIN ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN 0,C.BIN ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] +; MOVE B,1(AB) +; GETYP 0,BUFSTR-1(B) +; CAIN 0,TCHSTR +; SKIPN A,BUFSTR(B) ; BYTE POINTER? +; JRST BFIN1 +; HRRZ C,BUFSTR-1(B) ; CHARS LEFT +; IDIVI C,5 ; MULTIPLE OF 5? +; JUMPE D,BFIN2 ; YUP NO EXTRAS + +; MOVEI A,40 ; PAD WITH SPACES +; PUSHJ P,PUTCHR ; OUT IT GOES +; XCT (P) ; MAYBE BUMP ACCESS +; SOJG D,.-3 ; FILL + +BFIN2: PUSHJ P,BFCLOS ; WRITE OUT BUFFER + +BFIN1: MOVSI A,TCHAN + JRST FINIS + + + +; FUNCTION TO GET THE FILE LENGTH OF A READ CHANNEL + +MFUNCTION FILLNT,SUBR,[FILE-LENGTH] + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) + PUSHJ P,CFILLE + JRST FINIS + +CFILLE: +IFN 0,[ + MOVEI B,DIRECT-1(B) ; GET CHANNEL TYPE + PUSHJ P,CHRWRD + JFCL + CAME B,[ASCIZ /READ/] + JRST .+3 + PUSH P,[5] ; MULTIPLICATIVE FACTOR FOR READ + JRST .+4 + CAME B,[ASCII /READB/] + JRST WRONGD + PUSH P,[1] ; MULTIPLICATIVE FACTOR FOR READ +] + MOVE C,-2(B) ; GET BITS + MOVEI D,5 ; ASSUME ASCII + TRNE C,C.BIN ; SKIP IF NOT BINARY + MOVEI D,1 + PUSH P,D + MOVE C,B +IFN ITS,[ + .CALL FILL1 + JRST FILLOS ; GIVE HIM A NICE FALSE +] +IFE ITS,[ + MOVE A,CHANNO(C) + PUSH P,[0] + MOVEI C,(P) + MOVE B,[1,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,(P)] ; GET BYTE SIZE + JUMPN D,.+2 + MOVEI D,36. ; HANDLE "0" BYTE SIZE + SUB P,[1,,1] + SIZEF + JRST FILLOS +] + POP P,C +IFN ITS, IMUL B,C +IFE ITS,[ + CAIN C,5 + CAIE D,7 + JRST NOTASC +] +YESASC: MOVE A,$TFIX + POPJ P, + +IFE ITS,[ +NOTASC: MOVEI 0,36. + IDIV 0,D ; BYTES PER WORD + IDIVM B,0 + IMUL C,0 + MOVE B,C + JRST YESASC +] + +IFN ITS,[ +FILL1: SETZ ; BLOCK FOR .CALL TO FILLEN + SIXBIT /FILLEN/ + CHANNO (C) + SETZM B + +FILLOS: MOVE A,CHANNO(C) + MOVE B,[.STATUS A] ;MAKE A CALL TO STATUS TO FIND REASON + LSH A,23. ;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE + IOR B,A ;FIX UP .STATUS + XCT B + MOVE B,C + PUSHJ P,GFALS + POP P, + POPJ P, +] +IFE ITS,[ +FILLOS: MOVE B,C + PUSHJ P,TGFALS + POP P, + POPJ P, +] + + + ; MCHAN LOW-LEVEL I/O GARBAGE (PDL)-ORIGINAL (LIM)-ADDITIONS + +;CALLING ROUTINE: AC-A contains pointer to block of SIXBIT data +; DIR ? DEV ? FNM1 ? FNM2 ? SNM +;RETURNED VALUE : AC-A = +IFN ITS,[ +MOPEN: PUSH P,B + PUSH P,C + MOVE C,FRSTCH ; skip gc and tty channels +CNLP: DOTCAL STATUS,[C,[2000,,B]] + .LOSE %LSFIL + ANDI B,77 + JUMPE B,CHNFND ; found unused channel ? + ADDI C,1 ; try another channel + CAIG C,17 ; are all the channels used ? + JRST CNLP + SETO C, ; all channels used so C = -1 + JRST CHNFUL +CHNFND: MOVEI B,(C) + HLL B,(A) ; M.DIR slot + DOTCAL OPEN,[B,1(A),2(A),3(A),4(A)] + SKIPA + AOS -2(P) ; successful skip when returning +CHNFUL: MOVE A,C + POP P,C + POP P,B + POPJ P, + +MIOT: DOTCAL IOT,[A,B] + JFCL + POPJ P, + +MCLOSE: DOTCAL CLOSE,[A] + JFCL + POPJ P, + +IMPURE + +FRSTCH: 1 + +PURE +] + ;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O + +NOTNET: +BADCHN: ERRUUO EQUOTE BAD-CHANNEL +BDCHAN: ERRUUO EQUOTE BAD-INPUT-BUFFER + +WRONGD: ERRUUO EQUOTE WRONG-DIRECTION-CHANNEL + +CHNCLS: ERRUUO EQUOTE CHANNEL-CLOSED + +BAD6: ERRUUO EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME + +DISLOS: MOVE C,$TCHSTR + MOVE D,CHQUOTE [DISPLAY NOT AVAILABLE] + PUSHJ P,INCONS + MOVSI A,TFALSE + JRST OPNRET + +NOCHAN: ERRUUO EQUOTE ITS-CHANNELS-EXHAUSTED + +MODE1: 232020,,202020 +MODE2: 232023,,330320 + +END + + \ No newline at end of file diff --git a//fopen.mid.62 b//fopen.mid.62 new file mode 100644 index 0000000..6268b96 --- /dev/null +++ b//fopen.mid.62 @@ -0,0 +1,4722 @@ +TITLE OPEN - CHANNEL OPENER FOR MUDDLE + +RELOCATABLE + +;C. REEVE MARCH 1973 + +.INSRT MUDDLE > + +SYSQ + +FNAMS==1 +F==E+1 +G==F+1 + +IFE ITS,[ +IF1, .INSRT STENEX > +] +;THIS PROGRAM HAS ENTRIES: FOPEN, FCLOSE, RENAME, READB, PRINTB, FILECOPY, READSTRING, +; PRINTSTRING, NETSTATE, NETACC, NETS, ACCESS, AND FILE-EXISTS? + +;THESE SUBROUTINES HANDLE I/O STREAMS FOR THE MUDDLE SYSTEM. + +; FOPEN - OPENS A FILE FOR EITHER READING OR WRITING. IT TAKES +; FIVE OPTINAL ARGUMENTS AS FOLLOWS: + +; FOPEN (,,,,) +; +; - DIRECTION EITHER READ (INPUT) OR PRINT (OUPUT). DEFAULT IS READ + +; - FIRST FILE NAME. DEFAULT INPUT OR OUTPUT. + +; - SECOND FILE NAME. DEFAULT MUDDLE. + +; - DEVICE FROM WHICH TO OPEN. DEFAULT IS DSK. + +; - SYSTEM (DIRECTORY) NAME. DEFAULT UNAME. + +; FOPEN RETURNS AN OBJECT OF TYPE CHANNEL IF IT SUCCEEDS OTHERWISE NIL + + +; FCLOSE - CLOSES A FILE. TAKES A CHANNEL OBJECT AS ITS ARGUMENT. IT ALSO TAKES +; ACCESS - DOES A .ACCESS ON A CHARACTER BASIS FOR CHARACTER FILES + + +; A CHANNEL OBJECT IS A VECTOR CONTAINIG THE FOLLOWING INFORMATION + +; CHANNO ;ITS I/O CHANNEL NUMBER. 0 MEANS NOT A REAL CHANNEL. +; DIRECT ;DIRECTION (EITHER READ OR PRINT) +; NAME1 ;FIRST NAME OF FILE AS OPENED. +; NAME2 ;SECOND NAME OF FILE +; DEVICE ;DEVICE UPON WHICH THE CHANNEL IS OPEN +; SNAME ;DIRECTORY NAME +; RNAME1 ;REAL FIRST NAME (AS RETURNED BY READING CHANNEL STATUS) +; RNAME2 ;REAL SECOND NAME +; RDEVIC ;REAL DEVICE +; RSNAME ;SYSTEM OR DIRECTORY NAME +; STATUS ;VARIOUS STATUS BITS +; IOINS ;INSTRUCTION EXECUTED TO INPUT OR OUTPUT ONE CHARACTER +; ACCESS ;ACCESS POINTER FOR RAND ACCESS (OR USED FOR DISPLAY INFO) +; RADX ;RADIX FOR CHANNELS NUMBER CONVERSION + +; *** THE FOLLOWING FIELDS FOR OUTPUT ONLY *** +; LINLN ;LENGTH OF A LINE IN CHARACTERS FOR THIS DEVICE +; CHRPOS ;CURRENT POSITION ON CURRENT LINE +; PAGLN ;LENGTH OF A PAGE +; LINPOS ;CURRENT LINE BEING WRITTEN ON + +; *** THE FOLLOWING FILEDS FOR INPUT ONLY *** +; EOFCND ;GETS EVALUATED ON EOF +; LSTCH ;BACKUP CHARACTER +; WAITNS ;FOR TTY INPUT, BECOMES A .SLEEP WHEN WAITING +; EXBUFR ;FOR TTY INPUT, CONTAINS A WAITING BUFFER LIST +; BUFSTR ;A CHARACTER STRING USED AS BUFFER FOR NON-TTY DEVICES + +; THIS DEFINES THE LENGTH OF THE NON-TTY BUFFER +BUFLNT==100 + +;THIS DEFINES BLOCK MODE BIT FOR OPENING +BLOCKM==2 ;DEFINED IN THE LEFT HALF +IMAGEM==4 + + +;THIS IRP DEFINES THE FIELDS AT ASSEMBLY TIME + + CHANLNT==4 ;INITIAL CHANNEL LENGTH + +; BUILD A PROTOTYPE CHANNEL AND DEFINE FILEDS +BUFRIN==-1 ;SPECIAL HACK SO LOSERS WON'T SEE TTY BUFFER +SCRPTO==-3 ;SPECIAL HACK FOR SCRIPT CHANNELS +PROCHN: + +IRP A,,[[CHANNO,FIX],[DIRECT,CHSTR] +[NAME1,CHSTR],[NAME2,CHSTR],[DEVICE,CHSTR],[SNAME,CHSTR] +[RNAME1,CHSTR],[RNAME2,CHSTR],[RDEVIC,CHSTR],[RSNAME,CHSTR] +[STATUS,FIX],[IOINS,FIX],[LINLN,FIX],[CHRPOS,FIX],[PAGLN,FIX],[LINPOS,FIX] +[ACCESS,FIX],[RADX,FIX],[BUFSTR,CHSTR]] + + IRP B,C,[A] + B==CHANLNT-3 + T!C,,0 + 0 + .ISTOP + TERMIN + CHANLNT==CHANLNT+2 +TERMIN + + +; EQUIVALANCES FOR CHANNELS + +EOFCND==LINLN +LSTCH==CHRPOS +WAITNS==PAGLN +EXBUFR==LINPOS +DISINF==BUFSTR ;DISPLAY INFO +INTFCN==BUFSTR ;FUNCTION (OR SUBR, OR RSUBR) TO BE APPLIED FOR INTERNAL CHNLS + + +;DEFINE VARIABLES ASSOCIATED WITH TTY BUFFERS + +IRP A,,[IOIN2,ECHO,CHRCNT,ERASCH,KILLCH,BRKCH,ESCAP,SYSCHR,BRFCHR,BRFCH2,BYTPTR] +A==.IRPCNT +TERMIN + +EXTBFR==BYTPTR+1+<100./5> ;LENGTH OF ADD'L BUFFER + + + + +.GLOBAL IPNAME,MOPEN,MCLOSE,MIOT,ILOOKU,6TOCHS,ICLOS,OCLOS,RGPARS,RGPRS +.GLOBAL OPNCHN,CHMAK,READC,TYO,SYSCHR,BRFCHR,LSTCH,BRFCH2,EXTBFR +.GLOBAL CHRWRD,STRTO6,TTYBLK,WAITNS,EXBUFR,TTICHN,TTOCHN,GETCHR,IILIST +.GLOBAL CHANNO,STATUS,LINPOS,PAGLN,CHRPOS,LINLN,IOINS,ACCESS,ADDNUL +.GLOBAL DIRECT,DISINF,RADX,EOFCND,BUFSTR,MODE1,MODE2,GCHACK,GMTYO,INMTYO +.GLOBAL T.CHAN,NAME1,BFCLOS,DOIOTI,DOIOTO,DOACCS,NOTTY,DEMFLG,BYTDOP,TNXIN +.GLOBAL DISOPN,DISROP,DISCLS,DCHAR,DISLNL,DISPGL,INSTAT,MTYO,CIREST +.GLOBAL ECHO,ERASCH,KILLCH,BRKCH,BYTPTR,SYSCHR,CHRCNT,ESCAP,N.CHNS +.GLOBAL REOPN,QUITTE,CHNL0,CHNL1,BUFRIN,IOIN2,IFALSE,GFALS,IDVAL,PVSTOR,SPSTOR +.GLOBAL BADCHN,WRONGD,CHNCLS,GSNAME,GIBLOK,APLQ,NAPT,ICONS,INCONS,IBLOCK,IDVAL1 +.GLOBAL GRB,GWB,R1CHAR,W1CHAR,BFCLS1,TTYOP2,MPOPJ,COMPER,R1C,W1C,WXCT,RXCT +.GLOBAL TMTNXS,TNXSTR,RDEVIC,CPCH1,RCYCHN,CGFALS,CISTNG,CFILLE,FRSTCH +.GLOBAL TGFALS,ONINT + +.VECT.==40000 + +; PAIR MOVING MACRO + +DEFINE PMOVEM A,B + MOVE 0,A + MOVEM 0,B + MOVE 0,A+1 + MOVEM 0,B+1 + TERMIN + +; DEFINITIONS OF THE OFFSETS INTO THE TP STACK FOR OPEN + +T.SPDL==0 ; SAVES P STACK BASE +T.DIR==2 ; CONTAINS DIRECTION AND MODE +T.NM1==4 ; NAME 1 OF FILE +T.NM2==6 ; NAME 2 OF FILE +T.DEV==10 ; DEVICE NAME +T.SNM==12 ; SNAME +T.XT==14 ; EXTRA CRUFT IF NECESSARY +T.CHAN==16 ; CHANNEL AS GENERATED + +; OFFSETS FROM PSTACK BASE (USED FOR OPENS, .RCHST AND .FDELES) + +S.DIR==0 ; CODE FOR DIRECTION 0-IN, 1-OUT, 2-BIN, 3-BOUT,4-DISPLAY + ; S.DIR(P) = ,, +IFN ITS,[ +S.DEV==1 ; SIXBIT DEVICE RIGHT JUSTIFIED +S.NM1==2 ; SIXBIT NAME1 +S.NM2==3 ; SIXBIT NAME2 +S.SNM==4 ; SIXBIT SNAME +S.X1==5 ; TEMPS +S.X2==6 +S.X3==7 +] + +IFE ITS,[ +S.DEV==1 +S.X1==2 +S.X2==3 +S.X3==4 +] + + +; FLAGS SPECIFYING STATE OF THE WORLD AT VARIOUS TIMES + +NOSTOR==400000 ; ON MEANS DONT BUILD NEW STRINGS +MSTNET==200000 ; ON MEANS ONLY THE "NET" DEVICE CAN WIN +SNSET==100000 ; FLAG, SNAME SUPPLIED +DVSET==040000 ; FLAG, DEV SUPPLIED +N2SET==020000 ; FLAG, NAME2 SET +N1SET==010000 ; FLAG, NAME1 SET +4ARG==004000 ; FLAG, CONSIDER ARGS TO BE 4 STRINGS + +RMT [EXPUNGE N1SET,N2SET,DVSET,SNSET,MSTNET,NOSTOR +] + +; TABLE OF LEGAL MODES + +MODES: IRP A,,[READ,PRINT,READB,PRINTB,PRINTO,PRINAO] + SIXBIT /A/ + TERMIN +NMODES==.-MODES + +MODCOD: 0?1?2?3?3?1 +; TABLE OF KNOWN DEVICES AND A POINTER TO THEIR OPENERS + +IFN ITS,[ +DEVSTB: IRP A,,[DSK,TTY,USR,STY,ST,NET,INT,PTP,PTR,UT,T,NUL] + SIXBIT /A/ ; DEVICE NAMES + TERMIN + +DEVS: IRP B,,[ODSK,OTTY,OUSR,OSTY,OSTY,ONET,OINT,OPTP,OPTP,OUTN,OTTY,ONUL] + SETZ B ; POINTERS + TERMIN +] + +IFE ITS,[ +DEVSTB: IRP A,,[PS,SS,SRC,DSK,TTY,INT,NET] + SIXBIT /A/ + TERMIN + +DEVS: IRP B,,[ODSK,ODSK,ODSK,ODSK,OTTY,OINT,ONET] + SETZ B + TERMIN +] +NDEVS==.-DEVS + + + +;SUBROUTINE TO DO OPENING BEGINS HERE + +MFUNCTION NFOPEN,SUBR,[OPEN-NR] + + JRST FOPEN1 + +MFUNCTION FOPEN,SUBR,[OPEN] + +FOPEN1: ENTRY + PUSHJ P,MAKCHN ;MAKE THE CHANNEL + PUSHJ P,OPNCH ;NOW OPEN IT + JUMPL B,FINIS + SUB D,[4,,4] ; TOP THE CHANNEL + MOVEM D,RCYCHN+1 ; RECYCLE DEAD CHANNEL + SETZM (D) ; ZAP IT + MOVEI C,1(D) + HRLI C,(D) + BLT C,CHANLNT-1(D) + JRST FINIS + +; SUBR TO JUST CREATE A CHANNEL + +IMFUNCTION CHANNEL,SUBR + + ENTRY + PUSHJ P,MAKCHN + MOVSI A,TCHAN + JRST FINIS + + + + +; THIS ROUTINE PARSES ARGUMENTS TO FOPEN ETC. AND BUILDS A CHANNEL BUT DOESN'T OPEN IT + +MAKCHN: PUSH TP,$TPDL + PUSH TP,P ; POINT AT CURRENT STACK BASE + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE READ + MOVEI E,10 ; SLOTS OF TP NEEDED + PUSH TP,[0] + SOJG E,.-1 + MOVEI E,0 + EXCH E,(P) ; GET RET ADDR IN E +IFE ITS, PUSH P,[0] +IRP ATM,,[DEV,NM1,NM2,SNM]MDF,,[DSK,INPUT,>,[ ]]TMDF,,[DSK,INPUT,MUD,[ ]] + MOVE B,IMQUOTE ATM +IFN ITS, PUSH P,E + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TCHSTR + JRST MAK!ATM + + MOVE A,$TCHSTR +IFN ITS, MOVE B,CHQUOTE MDF +IFE ITS, MOVE B,CHQUOTE TMDF +MAK!ATM: + MOVEM A,T.!ATM(TB) + MOVEM B,T.!ATM+1(TB) +IFN ITS,[ + POP P,E + PUSHJ P,STRTO6 ; RESULT LEFT ON P STACK AS DESIRED +] + TERMIN + PUSH TP,[0] ; PUSH SLOTS + PUSH TP,[0] + + PUSH P,[0] ; EXT SLOTS + PUSH P,[0] + PUSH P,[0] + PUSH P,E ; PUSH RETURN ADDRESS + MOVEI A,0 + + JUMPGE AB,MAKCH0 ; NO ARGS, ALREADY DONE + GETYP 0,(AB) ; 1ST ARG MUST BE A STRING + CAIE 0,TCHSTR + JRST WTYP1 + MOVE A,(AB) ; GET ARG + MOVE B,1(AB) + PUSHJ P,CHMODE ; CHECK OUT OPEN MODE + + PMOVEM (AB),T.DIR(TB) ; SAVE MODE NAME IN TEMPS + ADD AB,[2,,2] ; BUMP PAST DIRECTION + MOVEM AB,ABSAV(TB) + MOVEI A,0 + JUMPGE AB,MAKCH0 ; CHECK NAME1 BASED ON JUST MODE + + MOVEI 0,0 ; FLAGS PRESET + PUSHJ P,RGPARS ; PARSE THE STRING(S) + JRST TMA + +; ARGUMENTS PARSED, DO FINAL CHECKS AND BUILD CHANNEL + +MAKCH0: +IFN ITS,[ + MOVE C,T.SPDL+1(TB) + MOVE D,S.DEV(C) ; GET DEV +] +IFE ITS,[ + MOVE A,T.DEV(TB) + MOVE B,T.DEV+1(TB) + PUSHJ P,STRTO6 + POP P,D + HLRZS D + MOVE C,T.SPDL+1(TB) + MOVEM D,S.DEV(C) +] +IFE ITS, CAIE D,(SIXBIT /INT/);INTERNAL? +IFN ITS, CAME D,[SIXBIT /INT /] + JRST CHNET ; NO, MAYBE NET + SKIPN T.XT+1(TB) ; WAS FCN SUPPLIED? + JRST TFA + +; FALLS TROUGH IF SKIP + + + +; NOW BUILD THE CHANNEL + +ARGSOK: MOVEI A,CHANLNT ; GET LENGTH + SKIPN B,RCYCHN+1 ; RECYCLE? + PUSHJ P,GIBLOK ; GET A BLOCK OF STUFF + SETZM RCYCHN+1 + ADD B,[4,,4] ; HIDE THE TTY BUFFER SLOT + PUSH TP,$TCHAN + PUSH TP,B + HRLI C,PROCHN ; POINT TO PROTOTYPE + HRRI C,(B) ; AND NEW ONE + BLT C,CHANLN-5(B) ; CLOBBER + MOVSI C,TLIST ; TO GIVE HIM A CLEAN LIST OF SCRIPT CHANS + HLLM C,SCRPTO-1(B) + +; NOW BLT IN STUFF FROM THE STACK + + MOVSI C,T.DIR(TB) ; DIRECTION + HRRI C,DIRECT-1(B) + BLT C,SNAME(B) + MOVEI C,RNAME1-1(B) ; NOW "REAL" SLOTS + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + MOVE B,IMQUOTE MODE + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TFIX + JRST .+3 + MOVE B,(TP) + POPJ P, + + MOVE C,(TP) +IFE ITS,[ + ANDI B,403776 ; ONLY ALLOW NON-CRITICAL BITSS +] + HRRM B,-4(C) ; HIDE BITS + MOVE B,C + POPJ P, + +; HERE TO VALIDIFY ARGUMENTS FOR A NET OPEN + +CHNET: +IFN ITS,[ + CAME D,[SIXBIT /NET /] ; IS IT NET + JRST MAKCH1] +IFE ITS,[ + CAIE D,(SIXBIT /NET/) ; IS IT NET + JRST ARGSOK] + MOVSI D,TFIX ; FOR TYPES + MOVEI B,T.NM1(TB) ; MAKE SURE ALL ARE FIXED + PUSHJ P,CHFIX + MOVEI B,T.NM2(TB) + PUSHJ P,CHFIX + MOVEI B,T.SNM(TB) + LSH A,-1 ; SKIP DEV FLAG + PUSHJ P,CHFIX + JRST ARGSOK + +MAKCH1: TRNN A,MSTNET ; CANT HAVE SEEN A FIX + JRST ARGSOK + JRST WRONGT + +IFN ITS,[ +CHFIX: TRNE A,N1SET ; SKIP IF NOT SPECIFIED + JRST CHFIX1 + SETOM 1(B) ; SET TO -1 + SETOM S.NM1(C) + MOVEM D,(B) ; CORRECT TYPE +] +IFE ITS,CHFIX: + GETYP 0,(B) + CAIE 0,TFIX + JRST PARSQ +CHFIX1: ADDI C,1 ; POINT TO NEXT FIELD + LSH A,-1 ; AND NEXT FLAG + POPJ P, +PARSQ: CAIE 0,TCHSTR + JRST WRONGT +IFE ITS, POPJ P, +IFN ITS,[ + PUSH P,A + PUSH P,C + PUSH TP,(B) + PUSH TP,1(B) + SUBI B,(TB) + PUSH P,B + MCALL 1,PARSE + GETYP 0,A + CAIE 0,TFIX + JRST WRONGT + POP P,C + ADDI C,(TB) + MOVEM A,(C) + MOVEM B,1(C) + POP P,C + POP P,A + POPJ P, +] + + +; SUBROUTINE TO CHECK VALIDITY OF MODE AND SAVE A CODE + +CHMODE: PUSHJ P,CHMOD ; DO IT + MOVE C,T.SPDL+1(TB) + HRRZM A,S.DIR(C) + POPJ P, + +CHMOD: PUSHJ P,STRTO6 ; TO SIXBIT + POP P,B ; VALUE ENDSUP ON STACK, RESTORE IT + + MOVSI A,-NMODES ; SCAN TO SEE IF LEGAL MODE + CAME B,MODES(A) + AOBJN A,.-1 + JUMPGE A,WRONGD ; ILLEGAL MODE NAME + MOVE A,MODCOD(A) + POPJ P, + + +IFN ITS,[ +; RGPARS -- PARSE THE STRINGS COMPRISING FILE NAMES INTO STANDARD ITS GOODIES + +RGPRS: MOVEI 0,NOSTOR ; DONT STORE STRINGS IF ENTER HERE + +RGPARS: CAMGE AB,[-7,,] ; MULTI-STRING CASE POSSIBLE? + IORI 0,4ARG ; 4 STRING CASE + HRLM 0,(P) ; LH IS FLAGS FOR THIS PROG + MOVSI E,-4 ; FIELDS TO FILL + +RPARGL: GETYP 0,(AB) ; GET TYPE + CAIE 0,TCHSTR ; STRING? + JRST ARGCLB ; NO, JUST CLOBBER IT IN RAW + JUMPGE E,CPOPJ ; DON'T DO ANY MORE + PUSH TP,(AB) ; GET AN ARG + PUSH TP,1(AB) + +FPARS: PUSH TP,-1(TP) ; ANOTHER COPY + PUSH TP,-1(TP) + HLRZ 0,(P) + TRNN 0,4ARG + PUSHJ P,FLSSP ; NO LEADING SPACES + MOVEI A,0 ; WILL HOLD SIXBIT + MOVEI B,6 ; CHARS PER 6BIT WORD + MOVE C,[440600,,A] ; BYTE POINTER INTO A + +FPARSL: HRRZ 0,-1(TP) ; GET COUNT + JUMPE 0,PARSD ; DONE + SOS -1(TP) ; COUNT + ILDB 0,(TP) ; CHAR TO 0 + + CAIE 0," ; FILE NAME QUOTE? + JRST NOCNTQ + HRRZ 0,-1(TP) + JUMPE 0,PARSD + SOS -1(TP) + ILDB 0,(TP) ; USE THIS + JRST GOTCNQ + +NOCNTQ: HLL 0,(P) + TLNE 0,4ARG + JRST GOTCNQ + ANDI 0,177 + CAIG 0,40 ; SPACE? + JRST NDFLD ; YES, TERMINATE THIS FIELD + CAIN 0,": ; DEVICE ENDED? + JRST GOTDEV + CAIN 0,"; ; SNAME ENDED + JRST GOTSNM + +GOTCNQ: ANDI 0,177 + PUSHJ P,A0TO6 ; CONVERT TO 6BIT AND CHECK + + JUMPE B,FPARSL ; IGNORE IF AREADY HAVE 6 + IDPB 0,C + SOJA B,FPARSL + +; HERE IF SPACE ENCOUNTERED + +NDFLD: MOVEI D,(E) ; COPY GOODIE + PUSHJ P,FLSSP ; FLUSH REDUNDANT SPACES + JUMPE 0,PARSD ; NO CHARS LEFT + +NFL0: PUSH P,A ; SAVE SIXBIT WORD + SKIPGE -1(P) ; SKIP IF STRING TO BE STORED + JRST NFL1 + PUSH TP,$TAB ; PREVENT AB LOSSAGE + PUSH TP,AB + PUSHJ P,6TOCHS ; CONVERT TO STRING + MOVE AB,(TP) + SUB TP,[2,,2] +NFL1: HRRZ 0,-1(TP) ; RESTORE CHAR COUNT + +NFL2: MOVEI C,(D) ; COPY REL PNTR + SKIPGE -1(P) ; SKIP IF STRINGS TO BE STORED + JRST NFL3 + ASH D,1 ; TIMES 2 + ADDI D,T.NM1(TB) + MOVEM A,(D) ; STORE + MOVEM B,1(D) +NFL3: MOVSI A,N1SET ; FLAG IT + LSH A,(C) + IORM A,-1(P) ; AND CLOBBER + MOVE D,T.SPDL+1(TB) ; GET P BASE + POP P,@SIXTBL(C) ; AND STORE SIXBIT OF IT + + POP TP,-2(TP) ; MAKE NEW STRING POINTER + POP TP,-2(TP) + JUMPE 0,.+3 ; SKIP IF NO MORE CHARS + AOBJN E,FPARS ; MORE TO PARSE? +CPOPJ: POPJ P, ; RETURN, ALL DONE + + SUB TP,[2,,2] ; FLUSH OLD STRING + ADD E,[1,,1] + ADD AB,[2,,2] ; BUMP ARG + MOVEM AB,ABSAV(TB) + JUMPL AB,RPARGL ; AND GO ON +CPOPJ1: AOS A,(P) ; PREPARE TO WIN + HLRZS A + POPJ P, + + + +; HERE IF STRING HAS ENDED + +PARSD: PUSH P,A ; SAVE 6 BIT + MOVE A,-3(TP) ; CAN USE ARG STRING + MOVE B,-2(TP) + MOVEI D,(E) + JRST NFL2 ; AND CONTINUE + +; HERE IF JUST READ DEV + +GOTDEV: MOVEI D,2 ; CODE FOR DEVICE + JRST GOTFLD ; GOT A FIELD + +; HERE IF JUST READ SNAME + +GOTSNM: MOVEI D,3 +GOTFLD: PUSHJ P,FLSSP + SOJA E,NFL0 + + +; HERE FOR NON STRING ARG ENCOUNTERED + +ARGCLB: SKIPGE (P) ; IF NOT STORING, CONSIDER THIS THE END + + POPJ P, + MOVE C,T.SPDL+1(TB) ; GET P-BASE + MOVE A,S.DEV(C) ; GET DEVICE + CAME A,[SIXBIT /INT /]; IS IT THE INTERNAL DEVICE + JRST TRYNET ; NO, COUD BE NET + MOVE A,0 ; OFFNEDING TYPE TO A + PUSHJ P,APLQ ; IS IT APPLICABLE + JRST NAPT ; NO, LOSE + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] ; MUST BE LAST ARG + MOVEM AB,ABSAV(TB) + JUMPL AB,TMA + JRST CPOPJ1 ; ELSE SUCCESSFUL RETURN +TRYNET: CAIE 0,TFIX ; FOR NET DEV, ARGS MUST BE FIX + JRST WRONGT ; TREAT AS WRONG TYPE + MOVSI A,MSTNET ; BETTER BE NET EVENTUALLY + IORM A,(P) ; STORE FLAGS + MOVSI A,TFIX + MOVE B,1(AB) ; GET NUMBER + MOVEI 0,(E) ; MAKE SURE NOT DEVICE + CAIN 0,2 + JRST WRONGT + PUSH P,B ; SAVE NUMBER + MOVEI D,(E) ; SET FOR TABLE OFFSETS + MOVEI 0,0 + ADD TP,[4,,4] + JRST NFL2 ; GO CLOBBER IT AWAY +] + + +; ROUTINE TO FLUSH LEADING SPACES FROM A FIELD + +FLSSP: HRRZ 0,-1(TP) ; GET CHR COUNNT + JUMPE 0,CPOPJ ; FINISHED STRING +FLSS1: MOVE B,(TP) ; GET BYTR + ILDB C,B ; GETCHAR + CAIE C,^Q ; DONT FLUSH CNTL-Q + CAILE C,40 + JRST FLSS2 + MOVEM B,(TP) ; UPDATE BYTE POINTER + SOJN 0,FLSS1 + +FLSS2: HRRM 0,-1(TP) ; UPDATE STRING + POPJ P, + +IFN ITS,[ +;TABLE FOR STFUFFING SIXBITS AWAY + +SIXTBL: SETZ S.NM1(D) + SETZ S.NM2(D) + SETZ S.DEV(D) + SETZ S.SNM(D) + SETZ S.X1(D) +] + +RDTBL: SETZ RDEVIC(B) + SETZ RNAME1(B) + SETZ RNAME2(B) + SETZ RSNAME(B) + + + +IFE ITS,[ + +; TENEX VERSION OF FILE NAME PARSER (ONLY ACCEPT ARGS IN SINGLE STRING) + + +RGPRS: MOVEI 0,NOSTOR + +RGPARS: HRLM 0,(P) ; SAVE FOR STORE CHECKING + CAMGE AB,[-2,,] ; MULTI-STRING CASE POSSIBLE? + JRST TN.MLT ; YES, GO PROCESS +RGPRSS: GETYP 0,(AB) ; CHECK ARG TYPE + CAIE 0,TCHSTR + JRST WRONGT ; FOR NOW ONLY STRING ARGS WIN + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,FLSSP ; FLUSH LEADING SPACES + PUSHJ P,RGPRS1 + ADD AB,[2,,2] + MOVEM AB,ABSAV(TB) +CHKLST: JUMPGE AB,CPOPJ1 + SKIPGE (P) ; IF FROM OPEN, ALLOW ONE MORE + POPJ P, + PMOVEM (AB),T.XT(TB) + ADD AB,[2,,2] + MOVEM AB,ABSAV(TB) + JUMPL AB,TMA +CPOPJ1: AOS (P) + POPJ P, + +RGPRS1: PUSH P,[0] ; ALLOW A DEVICE SPEC +TN.SNM: MOVE A,(TP) + HRRZ 0,-1(TP) + JUMPE 0,RPDONE + ILDB A,A + CAIE A,"< ; START "DIRECTORY" ? + JRST TN.N1 ; NO LOOK FOR NAME1 + SETOM (P) ; DEV NOT ALLOWED + IBP (TP) ; SKIP CHAR + SOS -1(TP) + PUSHJ P,TN.CNT ; COUNT CHARS TO ">" OR "." + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN3 + PUSH TP,0 + PUSH TP,C +TN.SN1: PUSHJ P,TN.CNT ; COUNT CHARS TO ">" + JUMPE B,ILLNAM ; RAN OUT + CAIE A,". + JRST TN.SN2 + MOVEM 0,-1(TP) + MOVEM C,(TP) + JRST TN.SN1 +TN.SN2: HRRZ B,-3(TP) + SUB B,0 + SUBI B,1 + SUB TP,[2,,2] +TN.SN3: CAIE A,"> ; SKIP IF WINS + JRST ILLNAM + PUSHJ P,TN.CPS ; COPY TO NEW STRING + HLLOS T.SPDL(TB) + MOVEM A,T.SNM(TB) + MOVEM B,T.SNM+1(TB) + +TN.N1: PUSHJ P,TN.CNT + JUMPE B,RPDONE + CAIE A,": ; GOT A DEVICE + JRST TN.N11 + SKIPE (P) + JRST ILLNAM + SETOM (P) + PUSHJ P,TN.CPS + MOVEM A,T.DEV(TB) + MOVEM B,T.DEV+1(TB) + JRST TN.SNM ; NOW LOOK FOR SNAME + +TN.N11: CAIE A,"> + CAIN A,"< + JRST ILLNAM + MOVEM A,(P) ; SAVE END CHAR + PUSHJ P,TN.CPS ; GEN STRING + MOVEM A,T.NM1(TB) + MOVEM B,T.NM1+1(TB) + +TN.N2: SKIPN A,(P) ; GET CHAR BACK + JRST RPDONE + CAIN A,"; ; START VERSION? + JRST .+3 + CAIE A,". ; START NAME2? + JRST ILLNAM ; I GIVE UP!!! + HRRZ B,-1(TP) ; GET RMAINS OF STRING + PUSHJ P,TN.CPS ; AND COPY IT + MOVEM A,T.NM2(TB) + MOVEM B,T.NM2+1(TB) +RPDONE: SUB P,[1,,1] ; FLUSH TEMP + SUB TP,[2,,2] +CPOPJ: POPJ P, + +TN.CNT: HRRZ 0,-1(TP) ; CHAR COUNT + MOVE C,(TP) ; BPTR + MOVEI B,0 ; INIT COUNT TO 0 + +TN.CN1: MOVEI A,0 ; IN CASE RUN OUT + SOJL 0,CPOPJ ; RUN OUT? + ILDB A,C ; TRY ONE + CAIE A," ; TNEX FILE QUOTE? + JRST TN.CN2 + SOJL 0,CPOPJ + IBP C ; SKIP QUOTED CHAT + ADDI B,2 + JRST TN.CN1 + +TN.CN2: CAIE A,"< + CAIN A,"> + POPJ P, + + CAIE A,". + CAIN A,"; + POPJ P, + CAIN A,": + POPJ P, + AOJA B,TN.CN1 + +TN.CPS: PUSH P,B ; # OF CHARS + MOVEI A,4(B) ; ADD 4 TO B IN A + IDIVI A,5 + PUSHJ P,IBLOCK ; GET BLOCK OF WORDS FOR STRING + + POP P,C ; CHAR COUNT BACK + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + HRRI A,(C) ; CHAR STRING + MOVE D,B ; COPY BYTER + + JUMPE C,CPOPJ + ILDB 0,(TP) ; GET CHAR + IDPB 0,D ; AND STROE + SOJG C,.-2 + + MOVNI C,(A) ; - LENGTH TO C + ADDB C,-1(TP) ; DECREMENT WORDS COUNT + TRNN C,-1 ; SKIP IF EMPTY + POPJ P, + IBP (TP) + SOS -1(TP) ; ELSE FLUSH TERMINATOR + POPJ P, + +ILLNAM: ERRUUO EQUOTE ILLEGAL-TENEX-FILE-NAME + +TN.MLT: MOVE A,AB ; AOBJN POINTER TO ARGS IN A + +TN.ML1: GETYP 0,(A) ; IS THIS ARG OF RIGHT TYPE + CAIE 0,TFIX + CAIN 0,TCHSTR + JRST .+2 + JRST RGPRSS ; ASSUME SINGLE STRING + ADD A,[2,,2] + JUMPL A,TN.ML1 ; TRY NEXT ARG IF ANY LEFT + + MOVEI 0,T.NM1(TB) ; 1ST WORD OF DESTINATION + HLRO A,AB ; MINUS NUMBER OF ARGS IN A + MOVN A,A ; NUMBER OF ARGS IN A + SUBI A,1 + CAMGE AB,[-10,,0] + MOVEI A,7 ; IF MORE THAN 10 ARGS, PUT 7 + ADD A,0 ; LAST WORD OF DESTINATION + HRLI 0,(AB) + BLT 0,(A) ; BLT 'EM IN + ADD AB,[10,,10] ; SKIP THESE GUYS + MOVEM AB,ABSAV(TB) + JRST CHKLST + +] + + +; ROUTINE TO OPEN A CHANNEL FOR ANY DEVICE. NAMES ARE ASSUMED TO ALREADY +; BE ON BOTH TP STACK AND P STACK + +OPNCH: MOVE C,T.SPDL+1(TB) ; GET PDL BASE + HRRZ A,S.DIR(C) + ANDI A,1 ; JUST WANT I AND O +IFE ITS,[ + HRLM A,S.DEV(C) +; .TRANS S.DEV(C) ; UNDO ANY TRANSLATIONS +; JRST TRLOST ; COMPLAIN +] +IFN ITS,[ + HRLM A,S.DIR(C) +] + +IFN ITS,[ + MOVE A,S.DEV(C) ; GET SIXBIT DEVICE CODE +] + +IFE ITS,[HRLZS A,S.DEV(C) +] + + MOVSI B,-NDEVS ; AOBJN COUNTER +DEVLP: SETO D, + MOVE 0,DEVSTB(B) ; GET ONE FROM TABLE + MOVE E,A +DEVLP1: AND E,D ; FLUSH POSSIBLE DIGITNESS + CAMN 0,E + JRST CHDIGS ; MAKE SURE REST IS DIGITS + LSH D,6 + JUMPN D,DEVLP1 ; KEEP TRUCKING UNTIL DONE + +; WASN'T THAT DEVICE, MOVE TO NEXT +NXTDEV: AOBJN B,DEVLP + JRST ODSK ; UNKNOWN DEVICE IS ASSUMED TO BE DISK + +IFN ITS,[ +OUSR: HRRZ A,S.DIR(C) ; BLOCK OR UNIT? + TRNE A,2 ; SKIP IF UNIT + JRST ODSK + PUSHJ P,OPEN1 ; OPEN IT + PUSHJ P,FIXREA ; AND READCHST IT + MOVE B,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVE 0,[PUSHJ P,DOIOT] ; GET AN IOINS + MOVEM 0,IOINS(B) + MOVE C,T.SPDL+1(TB) + HRRZ A,S.DIR(C) + TRNN A,1 + JRST EOFMAK + MOVEI 0,80. + MOVEM 0,LINLN(B) + JRST OPNWIN + +OSTY: HLRZ A,S.DIR(C) + IORI A,10 ; THE DONT LOSE BIT (DONT HANG ON INPUT DO ON OUTPUT) + HRLM A,S.DIR(C) + JRST OUSR +] + +; MAKE SURE DIGITS EXIST + +CHDIGS: SETCA D, + JUMPE D,DISPA ; NO DIGITS, WIN IMMEDIATE + MOVE E,A + AND E,D ; LEAVES ONLY DIGITS, IF WINNING + LSH E,6 + LSH D,6 + JUMPG D,.-2 ; KEEP GOING TIL DIGITS LEFT SHIFTED + JRST CHDIGN + +CHDIG1: CAIG D,'9 + CAIGE D,'0 + JRST NXTDEV ; NOT A DIGIT, LOSE + JUMPE E,DISPA ; IF THAT'S ALL THE CHARACTERS, WIN! +CHDIGN: SETZ D, + ROTC D,6 ; GET NEXT CHARACTER INTO D + JRST CHDIG1 ; GO TEST? + +; HERE TO DISPATCH IF SUCCESSFUL + +DISPA: JRST @DEVS(B) + + +IFN ITS,[ + +; DISK DEVICE OPNER COME HERE + +ODSK: MOVE A,S.SNM(C) ; GET SNAME + .SUSET [.SSNAM,,A] ; CLOBBER IT + PUSHJ P,OPEN0 ; DO REAL LIVE OPEN +] +IFE ITS,[ + +; TENEX DISK FILE OPENER + +ODSK: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + PUSHJ P,STSTK ; EXPAND STRING ONTO STACK (E POINTS TO OLD P) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; GET DIR NAME + MOVE C,(P) + MOVE D,T.SPDL+1(TB) + HRRZ D,S.DIR(D) + CAME C,[SIXBIT /PRINAO/] + CAMN C,[SIXBIT /PRINTO/] + IORI D,100 ; TURN ON BIT TO SAY USE OLD FILE + MOVSI A,101 ; START SETTING UP BITS EXTRA BIT FOR MSB + TRNE D,1 ; SKIP IF INPUT + TRNE D,100 ; WITE OVER? + TLOA A,100000 ; FORCE OLD VERSION + TLO A,600000 ; FORCE NEW VERSION + HRROI B,1(E) ; POINT TO STRING + GTJFN + TDZA 0,0 ; SAVE FACT OF NO SKIP + MOVEI 0,1 ; INDICATE SKIPPED + POP P,C ; RECOVER OPEN MODE SIXBIT + MOVE P,E ; RESTORE PSTACK + JUMPE 0,GTJLOS ; FIND OUT WHAT HAPPENED + + MOVE B,T.CHAN+1(TB) ; GET CHANNEL + HRRZ 0,-4(B) ; FUNNY MODE BITS + HRRZM A,CHANNO(B) ; SAVE IT + ANDI A,-1 ; READ Y TO DO OPEN + MOVSI B,440000 ; USE 36. BIT BYES + HRRI B,200000 ; ASSUME READ +; CAMN C,[SIXBIT /READB/] +; TRO B,2000 ; TURN ON THAWED IF READB + IOR B,0 + TRNE D,1 ; SKIP IF READ + HRRI B,300000 ; WRITE BIT + HRRZ 0,FSAV(TB) ; SEE IF REF DATE HACK + CAIN 0,NFOPEN + TRO B,400 ; SET DON'T MUNG REF DATE BIT + MOVE E,B ; SAVE BITS FOR REOPENS + OPENF + JRST OPFLOS + MOVE B,[2,,11] ; GET LENGTH & BYTE SIZE + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + GTFDB + LDB 0,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + CAIN 0,7 + JRST SIZASC + CAIN 0,36. + SIZEF ; USE OPENED SIZE + JFCL + IMULI B,5 ; TO BYTES +SIZASC: MOVEI 0,C.OPN+C.READ+C.DISK + TRNE D,1 ; SKIP FOR READ + MOVEI 0,C.OPN+C.PRIN+C.DISK + TRNE D,2 ; SKIP IF NOT BINARY FILE + TRO 0,C.BIN + HRL 0,B + MOVE B,T.CHAN+1(TB) + TRNE D,1 + HLRM 0,LSTCH-1(B) ; SAVE CURRENT LENGTH + MOVEM E,STATUS(B) + HRRM 0,-2(B) ; MUNG THOSE BITS + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + PUSHJ P,TMTNXS ; GET STRING FROM TENEX + MOVE B,CHANNO(B) ; JFN TO A + HRROI A,1(E) ; BASE OF STRING + MOVE C,[111111,,140001] ; WEIRD CONTROL BITS + JFNS ; GET STRING + MOVEI B,1(E) ; POINT TO START OF STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; MAKE INTO A STRING + SUB P,E ; BACK TO NORMAL + PUSH TP,A + PUSH TP,B + PUSHJ P,RGPRS1 ; PARSE INTO FIELDS + MOVE B,T.CHAN+1(TB) + MOVEI C,RNAME1-1(B) + HRLI C,T.NM1(TB) + BLT C,RSNAME(B) + JRST OPBASC +OPFLOS: MOVEI C,(A) ; SAVE ERROR CODE + MOVE B,T.CHAN+1(TB) + HRRZ A,CHANNO(B) ; JFN BACK TO A + RLJFN ; TRY TO RELEASE IT + JFCL + MOVEI A,(C) ; ERROR CODE BACK TO A + +GTJLOS: MOVE B,T.CHAN+1(TB) + PUSHJ P,TGFALS ; GET A FALSE WITH REASON + JRST OPNRET + +STSTK: PUSH TP,$TCHAN + PUSH TP,B + MOVEI A,4+5 ; COUNT CHARS NEEDED (NEED LAST 0 BYTE) + MOVE B,(TP) + ADD A,RDEVIC-1(B) + ADD A,RNAME1-1(B) + ADD A,RNAME2-1(B) + ADD A,RSNAME-1(B) + ANDI A,-1 ; TO 18 BITS + MOVEI 0,A(A) + IDIVI A,5 ; TO WORDS NEEDED + POP P,C ; SAVE RET ADDR + MOVE E,P ; SAVE POINTER + PUSH P,[0] ; ALOCATE SLOTS + SOJG A,.-1 + PUSH P,C ; RET ADDR BACK + INTGO ; IN CASE OVERFLEW + PUSH P,0 + MOVE B,(TP) ; IN CASE GC'D + MOVE D,[440700,,1(E)] ; BYTE POINTER TO IT + MOVEI A,RDEVIC-1(B) + PUSHJ P,MOVSTR ; FLUSH IT ON + HRRZ A,T.SPDL(TB) + JUMPN A,NLNMS ; USER GAVE NAME, USE IT (CAREFUL, RELIES ON + ; A BEING NON ZERO) + PUSH P,B + PUSH P,C + MOVEI A,0 ; HERE TO SEE IF THIS IS REALLY L.N. + HRROI B,1(E) + HRROI C,1(P) + LNMST ; LOOK UP LOGICAL NAME + MOVNI A,1 ; NOT A LOGICAL NAME + POP P,C + POP P,B +NLNMS: MOVEI 0,": + IDPB 0,D + JUMPE A,ST.NM1 ; LOGICAL NAME, FLUSH SNAME + HRRZ A,RSNAME-1(B) ; ANY SNAME AT ALL? + JUMPE A,ST.NM1 ; NOPE, CANT HACK WITH IT + MOVEI A,"< + IDPB A,D + MOVEI A,RSNAME-1(B) + PUSHJ P,MOVSTR ; SNAME UP + MOVEI A,"> + IDPB A,D +ST.NM1: MOVEI A,RNAME1-1(B) + PUSHJ P,MOVSTR + MOVEI A,". + IDPB A,D + MOVEI A,RNAME2-1(B) + PUSHJ P,MOVSTR + SUB TP,[2,,2] + POP P,A + POPJ P, + +MOVSTR: HRRZ 0,(A) ; CHAR COUNT + MOVE A,1(A) ; BYTE POINTER + SOJL 0,CPOPJ + ILDB C,A ; GET CHAR + IDPB C,D ; MUNG IT UP + JRST .-3 + +; MAKE A TENEX ERROR MESSAGE STRING + +TGFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; SAVE ERROR CODE + PUSHJ P,TMTNXS ; STRING ON STACK + HRROI A,1(E) ; POINT TO SPACE + MOVE B,(E) ; ERROR CODE + HRLI B,400000 ; FOR ME + MOVSI C,-100. ; MAX CHARS + ERSTR ; GET TENEX STRING + JRST TGFLS1 + JRST TGFLS1 + + MOVEI B,1(E) ; A AND B BOUND STRING + SUBM P,E ; RELATIVIZE E + PUSHJ P,TNXSTR ; BUILD STRING + SUB P,E ; P BACK TO NORMAL +TGFLS2: +IFE FNAMS, SUB P,[1,,1] ; FLUSH ERROR CODE SLOT +IFN FNAMS,[ + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST TGFLS3 + PUSHJ P,STSTK + MOVEI B,1(E) + SUBM P,E + MOVSI A,440700 + HRRI A,(P) + MOVEI C,5 + ILDB 0,A + JUMPE 0,.+2 + SOJG C,.-2 + + PUSHJ P,TNXSTR + PUSH TP,A + PUSH TP,B + SUB P,E +TGFLS3: POP P,A + PUSH TP,$TFIX + PUSH TP,A + MOVEI A,3 + SKIPN B + MOVEI A,2 +] +IFE FNAMS,[ + MOVEI A,1 +] + PUSHJ P,IILIST ; BUILD LIST + MOVSI A,TFALSE ; MAKE IT FALSE + SUB TP,[2,,2] + POPJ P, + +TGFLS1: MOVE P,E ; RESET STACK + MOVE A,$TCHSTR + MOVE B,CHQUOTE UNKNOWN PROBLEM IN I/O + JRST TGFLS2 + +] +; OTHER BUFFERED DEVICES JOIN HERE + +OPDSK1: +IFN ITS,[ + PUSHJ P,FIXREA ; STORE THE "REAL" NAMES INTO THE CHANNEL +] +OPBASC: MOVE C,T.SPDL+1(TB) ; C WAS CLOBBERED, GET IT BACK + HRRZ A,S.DIR(C) ; FIND OUT IF OPEN IS ASCII OR WORD + TRZN A,2 ; SKIP IF BINARY + PUSHJ P,OPASCI ; DO IT FOR ASCII + +; NOW SET UP IO INSTRUCTION FOR CHANNEL + +MAKION: MOVE B,T.CHAN+1(TB) + MOVEI C,GETCHR + JUMPE A,MAKIO1 ; JUMP IF INPUT + MOVEI C,PUTCHR ; ELSE GET INPUT + MOVEI 0,80. ; DEFAULT LINE LNTH + MOVEM 0,LINLN(B) + MOVSI 0,TFIX + MOVEM 0,LINLN-1(B) +MAKIO1: + HRLI C,(PUSHJ P,) + MOVEM C,IOINS(B) ; STORE IT + JUMPN A,OPNWIN ; GET AN EOF FORM FOR INPUT CHANNEL + +; HERE TO CONS UP + +EOFMAK: MOVSI C,TATOM + MOVE D,EQUOTE END-OF-FILE + PUSHJ P,INCONS + MOVEI E,(B) + MOVSI C,TATOM + MOVE D,IMQUOTE ERROR + PUSHJ P,ICONS + MOVE D,T.CHAN+1(TB) ; RESTORE CHANNEL + MOVSI 0,TFORM + MOVEM 0,EOFCND-1(D) + MOVEM B,EOFCND(D) + +OPNWIN: MOVEI 0,10. ; SET UP RADIX + MOVSI A,TCHAN ; OPEN SUCCEEDED, RET CHANNEL + MOVE B,T.CHAN+1(TB) + MOVEM 0,RADX(B) + +OPNRET: MOVE D,T.CHAN+1(TB) ; IN CASE WE RECYCLE IT + MOVE C,(P) ; RET ADDR + SUB P,[S.X3+2,,S.X3+2] + SUB TP,[T.CHAN+2,,T.CHAN+2] + JRST (C) + + +; HERE TO CREATE CHARACTER BUFFERS FOR ASCII I/O + +OPASCI: PUSH P,A ; CONTAINS MODE, SAVE IT + MOVEI A,BUFLNT ; GET SIZE OF BUFFER + PUSHJ P,IBLOCK ; GET STORAGE + MOVSI 0,TWORD+.VECT. ; SET UTYPE + MOVEM 0,BUFLNT(B) ; AND STORE + MOVSI A,TCHSTR + SKIPE (P) ; SKIP IF INPUT + JRST OPASCO + MOVEI D,BUFLNT-1(B) ; REST BYTE POINTER +OPASCA: HRLI D,010700 + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEI 0,C.BUF + IORM 0,-2(B) ; TURN ON BUFFER BIT + MOVEM A,BUFSTR-1(B) + MOVEM D,BUFSTR(B) ; CLOBBER + POP P,A + POPJ P, + +OPASCO: HRROI C,777776 + MOVEM C,(B) ; -1 THE BUFFER (LEAVE OFF LOW BIT) + MOVSI C,(B) + HRRI C,1(B) ; BUILD BLT POINTER + BLT C,BUFLNT-1(B) ; ZAP + MOVEI D,-1(B) ; START MAKING STRING POINTER + HRRI A,BUFLNT*5 ; SET UP CHAR COUNT + JRST OPASCA + + +; OPEN NON FILE ORIENTED DEVICES (NUL, PTR, PTP ETC.) + +IFN ITS,[ +ONUL: +OPTP: +OPTR: PUSHJ P,OPEN0 ; SET UP MODE AND OPEN + SETZM S.NM1(C) ; CLOBBER UNINTERESTING FIELDS + SETZM S.NM2(C) + SETZM S.SNM(C) + JRST OPDSK1 + +; OPEN DEVICES THAT IGNORE SNAME + +OUTN: PUSHJ P,OPEN0 + SETZM S.SNM(C) + JRST OPDSK1 + +] + +; INTERNAL CHANNEL OPENER + +OINT: HRRZ A,S.DIR(C) ; CHECK DIR + CAIL A,2 ; READ/PRINT? + JRST WRONGD ; NO, LOSE + + MOVE 0,INTINS(A) ; GET INS + MOVE D,T.CHAN+1(TB) ; AND CHANNEL + MOVEM 0,IOINS(D) ; AND CLOBBER + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + HRRM 0,-2(D) + SETOM STATUS(D) ; MAKE SURE NOT AA TTY + PMOVEM T.XT(TB),INTFCN-1(D) + +; HERE TO SAVE PSEUDO CHANNELS + +SAVCHN: HRRZ E,CHNL0+1 ; POINT TO CURRENT LIST + MOVSI C,TCHAN + PUSHJ P,ICONS ; CONS IT ON + HRRZM B,CHNL0+1 + JRST OPNWIN + +; INT DEVICE I/O INS + +INTINS: PUSHJ P,GTINTC + PUSHJ P,PTINTC + + +; HERE TO OPEN THE NET DEVICE (I.E. THE ARPA NET) + +IFN ITS,[ +ONET: HRRZ A,S.DIR(C) ; DIRECTION CODE + CAILE A,1 ; ASCII ? + IORI A,4 ; TURN ON IMAGE BIT + SKIPGE S.NM1(C) ; NAME1 I.E. LOCAL HOST GIVEN + IORI A,10 ; NO, WE WILL LET ITS GIVE US ONE + SKIPGE S.NM2(C) ; NORMAL OR "LISTEN" + IORI A,20 ; TURN ON LISTEN BIT + MOVEI 0,7 ; DEFAULT BYTE SIZE + TRNE A,2 ; UNLESS + MOVEI 0,36. ; IMAGE WHICH IS 36 + SKIPN T.XT(TB) ; BYTE SIZE GIVEN? + MOVEM 0,S.X1(C) ; NO, STORE DEFAULT + SKIPG D,S.X1(C) ; BYTE SIZE REASONABLE? + JRST RBYTSZ ; NO <0, COMPLAIN + TRNE A,2 ; SKIP TO CHECK ASCII + JRST ONET2 ; CHECK IMAGE + CAIN D,7 ; 7-BIT WINS + JRST ONET1 + CAIE D,44 ; 36-BIT INDICATES BLOCK ASCII MODE + JRST .+3 + IORI A,2 ; SET BLOCK FLAG + JRST ONET1 + IORI A,40 ; USE 8-BIT MODE + CAIN D,10 ; IS IT RIGHT + JRST ONET1 ; YES +] + +RBYTSZ: ERRUUO EQUOTE BYTE-SIZE-BAD + +IFN ITS,[ +ONET2: CAILE D,36. ; IMAGE SIZE REASONABLE? + JRST RBYTSZ ; NO + CAIN D,36. ; NORMAL + JRST ONET1 ; YES, DONT SET FIELD + + ASH D,9. ; POSITION FOR FIELD + IORI A,40(D) ; SET IT AND ITS BIT + +ONET1: HRLM A,S.DIR(C) ; CLOBBER OPEN BLOCK + MOVE E,A ; SAVE BLOCK MODE INFO + PUSHJ P,OPEN1 ; DO THE OPEN + PUSH P,E + +; CLOBBER REAL SLOTS FOR THE OPEN + + MOVEI A,3 ; GET STATE VECTOR + PUSHJ P,IBLOCK + MOVSI A,TUVEC + MOVE D,T.CHAN+1(TB) + HLLM A,BUFRIN-1(D) + MOVEM B,BUFRIN(D) + MOVSI A,TFIX+.VECT. ; SET U TYPE + MOVEM A,3(B) + MOVE C,T.SPDL+1(TB) + MOVE B,T.CHAN+1(TB) + + PUSHJ P,INETST ; GET STATE + + POP P,A ; IS THIS BLOCK MODE + MOVEI 0,80. ; POSSIBLE LINE LENGTH + TRNE A,1 ; SKIP IF INPUT + MOVEM 0,LINLN(B) + TRNN A,2 ; BLOCK MODE? + JRST .+3 + TRNN A,4 ; ASCII MODE? + JRST OPBASC ; GO SETUP BLOCK ASCII + MOVE 0,[PUSHJ P,DOIOT] + MOVEM 0,IOINS(B) + + JRST OPNWIN + +; INTERNAL ROUTINE TO GET THE CURRENT STATE OF THE NETWROK CHANNEL + +INETST: MOVE A,S.NM1(C) + MOVEM A,RNAME1(B) + MOVE A,S.NM2(C) + MOVEM A,RNAME2(B) + LDB A,[1100,,S.SNM(C)] + MOVEM A,RSNAME(B) + + MOVE E,BUFRIN(B) ; GET STATE BLOCK +INTST1: HRRE 0,S.X1(C) + MOVEM 0,(E) + ADDI C,1 + AOBJN E,INTST1 + + POPJ P, + + +; ACCEPT A CONNECTION + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET ; CHECK THAT ARG IS AN OPEN NET CHANNEL + MOVE A,CHANNO(B) ; GET CHANNEL + LSH A,23. ; TO AC FIELD + IOR A,[.NETACC] + XCT A + JRST IFALSE ; RETURN FALSE +NETRET: MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +; FORCE SYSTEM NETWORK BUFFERS TO BE SENT + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 + CAMN A,MODES+3 + SKIPA A,CHANNO(B) ; GET CHANNEL + JRST WRONGD + LSH A,23. + IOR A,[.NETS] + XCT A + JRST NETRET + +; SUBR TO RETURN UPDATED NET STATE + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET ; IS IT A NET CHANNEL + PUSHJ P,INSTAT + JRST FINIS + +; INTERNAL NETSTATE ROUTINE + +INSTAT: MOVE C,P ; GET PDL BASE + MOVEI 0,S.X3 ; # OF SLOTS NEEDED + PUSH P,[0] + SOJN 0,.-1 +; RESTORED FROM MUDDLE 54. IT SEEMED TO WORK THERE, AND THE STUFF +; COMMENTED OUT HERE CERTAINLY DOESN'T. + MOVEI D,S.DEV(C) + HRL D,CHANNO(B) + .RCHST D, +; HRR D,CHANNO(B) ; SETUP FOR RFNAME CALL +; DOTCAL RFNAME,[D,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] +; .LOSE %LSFIL ; THIS MAY NOT BE DESIRABLE, BUT I ASSUME WE CARE IF + ; LOSSAGE + PUSHJ P,INETST ; INTO VECTOR + SUB P,[S.X3,,S.X3] + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + POPJ P, +] +; INTERNAL ROUTINE TO CHECK FOR CORRECT CHANNEL TYPE + +ARGNET: ENTRY 1 + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; OPEN? + JRST CHNCLS + MOVE A,RDEVIC-1(B) ; GET DEV NAME + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 + POP P,A + CAME A,[SIXBIT /NET /] + JRST NOTNET + MOVE B,1(AB) + MOVE A,DIRECT-1(B) ; CHECK FOR A READ SOCKET + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 + MOVE B,1(AB) ; RESTORE CHANNEL + POP P,A + POPJ P, + +IFE ITS,[ + +; TENEX NETWRK OPENING CODE + +ONET: MOVE B,T.CHAN+1(TB) ; GET CHANNEL + MOVSI C,100700 + HRRI C,1(P) + MOVE E,P + PUSH P,[ASCII /NET:/] ; FOR STRINGS + GETYP 0,RNAME1-1(B) ; CHECK TYPE + CAIE 0,TFIX ; SKIP IF # SUPPLIED + JRST ONET1 + MOVE 0,RNAME1(B) ; GET IT + PUSHJ P,FIXSTK + JFCL + JRST ONET2 +ONET1: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME1-1(B) + MOVE B,RNAME1(B) + JUMPE 0,ONET2 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 +ONET2: MOVEI A,". + JSP D,ONETCH + MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIE 0,TFIX + JRST ONET3 + GETYP 0,RSNAME-1(B) + CAIE 0,TFIX + JRST WRONGT + MOVE 0,RSNAME(B) + CAIG 0,377 ;NEW STYLE 32 BIT HOST NUMBER? + JRST ONET2A +;CONVERT HOSTS2 HOST NUMBERS TO INTERNET (TOPS-20) HOST NUMBERS + MOVEI A,0 + LDB B,[001100,,0] ;HOST NUMBER: 1.1-1.9 -> + DPB B,[201000,,A] ; 2.8-3.6 + LDB B,[111100,,0] ;IMP LOW BITS: 2.1-2.9 -> + DPB B,[001000,,A] ; 1.1-1.8 + LDB B,[221100,,0] ;IMP HIGH BITS: 3.1-3.9 -> + DPB B,[101000,,A] ; 1.9-2.7 + LDB B,[331100,,0] ;NETWORK: 4.1-4.9 -> + DPB B,[301000,,A] ; 3.7-4.5 + MOVE 0,A +ONET2A: PUSHJ P,FIXSTK + JRST ONET4 + MOVE B,T.CHAN+1(TB) + MOVEI A,"- + JSP D,ONETCH + MOVE 0,RNAME2(B) + PUSHJ P,FIXSTK + JRST WRONGT + JRST ONET4 +ONET3: CAIE 0,TCHSTR + JRST WRONGT + HRRZ 0,RNAME2-1(B) + MOVE B,RNAME2(B) + JUMPE 0,ONET4 + ILDB A,B + JSP D,ONETCH + SOJA 0,.-3 + +ONET4: +ONET5: MOVE B,T.CHAN+1(TB) + GETYP 0,RNAME2-1(B) + CAIN 0,TCHSTR + JRST ONET6 + MOVEI A,"; + JSP D,ONETCH + MOVEI A,"T + JSP D,ONETCH +ONET6: MOVSI A,1 + HRROI B,1(E) ; STRING POINTER + GTJFN ; GET THE G.D JFN + TDZA 0,0 ; REMEMBER FAILURE + MOVEI 0,1 + MOVE P,E ; RESTORE P + JUMPE 0,GTJLOS ; CONS UP ERROR STRING + + MOVE B,T.CHAN+1(TB) + HRRZM A,CHANNO(B) ; SAVE THE JFN + + MOVE C,T.SPDL+1(TB) + MOVE D,S.DIR(C) + MOVEI B,10 + TRNE D,2 + MOVEI B,36. + SKIPE T.XT(TB) + MOVE B,T.XT+1(TB) + JUMPL B,RBYTSZ + CAILE B,36. + JRST RBYTSZ + ROT B,-6 + TLO B,3400 + HRRI B,200000 + TRNE D,1 ; SKIP FOR INPUT + HRRI B,100000 + ANDI A,-1 ; ISOLATE JFCN + OPENF + JRST OPFLOS ; REPORT ERROR + MOVE B,T.CHAN+1(TB) + ASH A,1 ; POINT TO SLOT + ADDI A,CHNL0 ; TO REAL SLOT + MOVEM B,1(A) ; SAVE CHANNEL + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) + CVSKT ; GET ABS SOCKET # + FATAL NETWORK BITES THE BAG! + MOVE D,B + MOVE B,T.CHAN+1(TB) + MOVEM D,RNAME1(B) + MOVSI 0,TFIX + MOVEM 0,RNAME1-1(B) + + MOVSI 0,TFIX + MOVEM 0,RNAME2-1(B) + MOVEM 0,RSNAME-1(B) + MOVE C,T.SPDL+1(TB) + MOVE C,S.DIR(C) + MOVE 0,[PUSHJ P,DONETO] + TRNN C,1 ; SKIP FOR OUTPUT + MOVE 0,[PUSHJ P,DONETI] + MOVEM 0,IOINS(B) + MOVEI 0,80. ; LINELENGTH + TRNE C,1 ; SKIP FOR INPUT + MOVEM 0,LINLN(B) + MOVEI A,3 ; GET STATE UVECTOR + PUSHJ P,IBLOCK + MOVSI 0,TFIX+.VECT. + MOVEM 0,3(B) + MOVE C,B + MOVE B,T.CHAN+1(TB) + MOVEM C,BUFRIN(B) + MOVSI 0,TUVEC + HLLM 0,BUFRIN-1(B) + MOVE B,CHANNO(B) ; GET JFN + MOVEI A,4 ; CODE FOR GTNCP + MOVEI C,1(P) + ADJSP P,4 ; ROOM FOR DATA + MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC + GTNCP + FATAL NET LOSSAGE ; GET STATE + MOVE B,(P) + MOVE D,-1(P) + MOVE C,-3(P) + ADJSP P,-4 + MOVE E,T.CHAN+1(TB) + MOVEM D,RNAME2(E) + MOVEM C,RSNAME(E) + MOVE C,BUFRIN(E) + MOVEM B,(C) ; INITIAL STATE STORED + MOVE B,E + JRST OPNWIN + +; DOIOT FOR TENEX NETWRK + +DONETO: PUSH P,0 + MOVE 0,[BOUT] + JRST .+3 + +DONETI: PUSH P,0 + MOVE 0,[BIN] + PUSH P,0 + PUSH TP,$TCHAN + PUSH TP,B + MOVEI 0,(A) ; POSSIBLE OUTPUT CHAR TO 0 + MOVE A,CHANNO(B) + MOVE B,0 + ENABLE + XCT (P) + DISABLE + MOVEI A,(B) ; RET CHAR IN A + MOVE B,(TP) + MOVE 0,-1(P) + SUB P,[2,,2] + SUB TP,[2,,2] + POPJ P, + +NETPRS: MOVEI D,0 + HRRZ 0,(C) + MOVE C,1(C) + +ONETL: ILDB A,C + CAIN A,"# + POPJ P, + SUBI A,60 + ASH D,3 + IORI D,(A) + SOJG 0,ONETL + AOS (P) + POPJ P, + +FIXSTK: CAMN 0,[-1] + POPJ P, + JFFO 0,FIXS3 ; PUT OCTAL DIGITS INTO STIRNG + MOVEI A,"0 + POP P,D + AOJA D,ONETCH +FIXS3: IDIVI A,3 + MOVEI B,12. + SUBI B,(A) + HRLM B,(P) + IMULI A,3 + LSH 0,(A) + POP P,B +FIXS2: MOVEI A,0 + ROTC 0,3 ; NEXT DIGIT + ADDI A,60 + JSP D,ONETCH + SUB B,[1,,0] + TLNN B,-1 + JRST 1(B) + JRST FIXS2 + +ONETCH: IDPB A,C + TLNE C,760000 ; SKIP IF NEW WORD + JRST (D) + PUSH P,[0] + JRST (D) + +INSTAT: MOVE E,B + MOVE B,CHANNO(B) ; GET JFN + MOVEI A,4 ; CODE FOR GTNCP + MOVEI C,1(P) + ADJSP P,4 ; ROOM FOR DATA + MOVE D,[-4,,1] ; GET FHOST, LOC SOC, F SOC + GTNCP + FATAL NET LOSSAGE ; GET STATE + MOVE B,(P) + MOVE D,-1(P) + MOVE C,-3(P) + ADJSP P,-4 + MOVEM D,RNAME2(E) ; UPDATE FOREIGN SOCHKET + MOVEM C,RSNAME(E) ; AND HOST + MOVE C,BUFRIN(E) + XCT ITSTRN(B) ; XLATE TO LOOK MORE LIKE ITS + MOVEM B,(C) ; STORE STATE + MOVE B,E + POPJ P, + +ITSTRN: MOVEI B,0 + JRST NLOSS + JRST NLOSS + MOVEI B,1 + MOVEI B,2 + JRST NLOSS + MOVEI B,4 + PUSHJ P,NOPND + MOVEI B,0 + JRST NLOSS + JRST NLOSS + PUSHJ P,NCLSD + MOVEI B,0 + JRST NLOSS + MOVEI B,0 + +NLOSS: FATAL ILLEGAL NETWORK STATE + +NOPND: MOVE B,DIRECT(E) ; SEE IF READ OR PRINT + ILDB B,B ; GET 1ST CHAR + CAIE B,"R ; SKIP FOR READ + JRST NOPNDW + SIBE ; SEE IF INPUT EXISTS + JRST .+3 + MOVEI B,5 + POPJ P, + MOVEM B,2(C) ; STORE BYTES IN STATE VECTOR + MOVEI B,11 ; RETURN DATA PRESENT STATE + POPJ P, + +NOPNDW: SOBE ; SEE IF OUTPUT PRESENT + JRST .+3 + MOVEI B,5 + POPJ P, + + MOVEI B,6 + POPJ P, + +NCLSD: MOVE B,DIRECT(E) + ILDB B,B + CAIE B,"R + JRST RET0 + SIBE + JRST .+2 + JRST RET0 + MOVEI B,10 + POPJ P, + +RET0: MOVEI B,0 + POPJ P, + + +MFUNCTION NETSTATE,SUBR + + PUSHJ P,ARGNET + PUSHJ P,INSTAT + MOVE B,BUFRIN(B) + MOVSI A,TUVEC + JRST FINIS + +MFUNCTION NETS,SUBR + + PUSHJ P,ARGNET + CAME A,MODES+1 ; PRINT OR PRINTB? + CAMN A,MODES+3 + SKIPA A,CHANNO(B) + JRST WRONGD + MOVEI B,21 + MTOPR +NETRET: MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS + +MFUNCTION NETACC,SUBR + + PUSHJ P,ARGNET + MOVE A,CHANNO(B) + MOVEI B,20 + MTOPR + JRST NETRET + +] + +; HERE TO OPEN TELETYPE DEVICES + +OTTY: HRRZ A,S.DIR(C) ; GET DIR CODE + TRNE A,2 ; SKIP IF NOT READB/PRINTB + JRST WRONGD ; CANT DO THAT + +IFN ITS,[ + MOVE A,S.NM1(C) ; CHECK FOR A DIR + MOVE 0,S.NM2(C) + CAMN A,[SIXBIT /.FILE./] + CAME 0,[SIXBIT /(DIR)/] + SKIPA E,[-15.*2,,] + JRST OUTN ; DO IT THAT WAY + + HRRZ A,S.DIR(C) ; CHECK DIR + TRNE A,1 + JRST TTYLP2 + HRRI E,CHNL1 + PUSH P,S.DEV(C) ; SAVE THE SIXBIT DEV NAME + ; HRLZS (P) ; POSTITION DEVICE NAME + +TTYLP: SKIPN D,1(E) ; CHANNEL OPEN? + JRST TTYLP1 ; NO, GO TO NEXT + MOVE A,RDEVIC-1(D) ; GET DEV NAME + MOVE B,RDEVIC(D) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A ; GET RESULT + CAMN A,(P) ; SAME? + JRST SAMTYQ ; COULD BE THE SAME +TTYLP1: ADD E,[2,,2] + JUMPL E,TTYLP + SUB P,[1,,1] ; THIS ONE MUST BE UNIQUE +TTYLP2: MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ A,S.DIR(C) ; GET DIR OF OPEN + SKIPE A ; IF OUTPUT, + IORI A,20 ; THEN USE DISPLAY MODE + HRLM A,S.DIR(C) ; STORE IN OPEN BLOCK + PUSHJ P,OPEN2 ; OPEN THE TTY + MOVE A,S.DEV(C) ; GET DEVICE NAME + PUSHJ P,6TOCHS ; TO A STRING + MOVE D,T.CHAN+1(TB) ; POINT TO CHANNEL + MOVEM A,RDEVIC-1(D) + MOVEM B,RDEVIC(D) + MOVE C,T.SPDL+1(TB) ; RESTORE PDL BASE + MOVE B,D ; CHANNEL TO B + HRRZ 0,S.DIR(C) ; AND DIR + JUMPE 0,TTYSPC +TTY1: DOTCAL TTYGET,[CHANNO(B),[2000,,0],[2000,,A],[2000,,D]] + .LOSE %LSSYS + DOTCAL TTYSET,[CHANNO(B),MODE1,MODE2,D] + .LOSE %LSSYS + MOVE A,[PUSHJ P,GMTYO] + MOVEM A,IOINS(B) + DOTCAL RSSIZE,[CHANNO(B),[2000,,A],[2000,,D]] + .LOSE %LSSYS + MOVEM D,LINLN(B) + MOVEM A,PAGLN(B) + JRST OPNWIN + +; MAKE AN IOT + +IOTMAK: HRLZ A,CHANNO(B) ; GET CHANNEL + ROT A,5 + IOR A,[.IOT A] ; BUILD IOT + MOVEM A,IOINS(B) ; AND STORE IT + POPJ P, + + +; HERE IF POSSIBLY OPENING AN ALREADY OPEN TTY + +SAMTYQ: MOVE D,1(E) ; RESTORE CURRENT CHANNEL + MOVE A,DIRECT-1(D) ; GET DIR + MOVE B,DIRECT(D) + PUSHJ P,STRTO6 + POP P,A ; GET SIXBIT + MOVE C,T.SPDL+1(TB) + HRRZ C,S.DIR(C) + CAME A,MODES(C) ; SKIP IF DIFFERENT DIRECTION + JRST TTYLP1 + +; HERE IF A RE-OPEN ON A TTY + + HRRZ 0,FSAV(TB) ; IS IT FROM A FOPEN + CAIN 0,FOPEN + JRST RETOLD ; RET OLD CHANNEL + + PUSH TP,$TCHAN + PUSH TP,1(E) ; PUSH OLD CHANNEL + PUSH TP,$TFIX + PUSH TP,T.CHAN+1(TB) + MOVE A,[PUSHJ P,CHNFIX] + MOVEI PVP,0 ; SAY MIGHT BE NON-ATOMS + PUSHJ P,GCHACK + SUB TP,[4,,4] + +RETOLD: MOVE B,1(E) ; GET CHANNEL + AOS CHANNO-1(B) ; AOS REF COUNT + MOVSI A,TCHAN + SUB P,[1,,1] ; CLEAN UP STACK + JRST OPNRET ; AND LEAVE + + +; ROUTINE TO PASS TO GCHACK TO FIX UP CHANNEL POINTER + +CHNFIX: CAIN C,TCHAN + CAME D,(TP) + POPJ P, + MOVE D,-2(TP) ; GET REPLACEMENT + SKIPE B + MOVEM D,1(B) ; CLOBBER IT AWAY + POPJ P, +] + +IFE ITS,[ + MOVE C,T.SPDL+1(TB) ; POINT TO P BASE + HRRZ 0,S.DIR(C) ; 0/ 0 FOR READ 0/ 1 FOR PRINT + MOVE A,[PUSHJ P,INMTYO] + MOVE B,T.CHAN+1(TB) + MOVEM A,IOINS(B) + MOVEI A,100 ; PRIM INPUT JFN + JUMPN 0,TNXTY1 + MOVEI E,C.OPN+C.READ+C.TTY + HRRM E,-2(B) + MOVEM B,CHNL0+2*100+1 + JRST TNXTY2 +TNXTY1: MOVEM B,CHNL0+2*101+1 + MOVEI A,101 ; PRIM OUTPUT JFN + MOVEI E,C.OPN+C.PRIN+C.TTY + HRRM E,-2(B) +TNXTY2: MOVEM A,CHANNO(B) + JUMPN 0,OPNWIN +] +; SETUP FUNNY BUFFER FOR TTY INPUT DEVICES + +TTYSPC: MOVEI A,EXTBFR ; GET EXTRA BUFFER + PUSHJ P,IBLOCK ; GET BLOCK + MOVE D,T.CHAN+1(TB) ;RESTORE CHANNEL POINTER +IFN ITS,[ + MOVE A,CHANNO(D) + LSH A,23. + IOR A,[.IOT A] + MOVEM A,IOIN2(B) +] +IFE ITS,[ + MOVE A,[PBIN] + MOVEM A,IOIN2(B) +] + MOVSI A,TLIST + MOVEM A,EXBUFR-1(D) ; FOR WAITING TTY BUFFERS + SETZM EXBUFR(D) ; NIL LIST + MOVEM B,BUFRIN(D) ;STORE IN CHANNEL + MOVSI A,TUVEC ;MAKE SURE TYPE IS UNIFORM VECTOR + HLLM A,BUFRIN-1(D) + MOVEI A,177 ;SET ERASER TO RUBOUT + MOVEM A,ERASCH(B) +IFE ITS,[ + MOVEI A,25 + MOVEM A,KILLCH(B) +] +IFN ITS,[ + SETZM KILLCH(B) ;NO KILL CHARACTER NEEDED +] + MOVEI A,33 ;BREAKCHR TO C.R. + MOVEM A,BRKCH(B) + MOVEI A,"\ ;ESCAPER TO \ + MOVEM A,ESCAP(B) + MOVE A,[010700,,BYTPTR(E)] ;RELATIVE BYTE POINTER + MOVEM A,BYTPTR(B) + MOVEI A,14 ;BARF BACK CHARACTER FF + MOVEM A,BRFCHR(B) + MOVEI A,^D + MOVEM A,BRFCH2(B) + +; SETUP DEFAULT TTY INTERRUPT HANDLER + + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TFIX + PUSH TP,[10] ; PRIORITY OF CHAR INT + PUSH TP,$TCHAN + PUSH TP,D + MCALL 3,EVENT ; 1ST MAKE AN EVENT EXIST + PUSH TP,A + PUSH TP,B + PUSH TP,$TSUBR + PUSH TP,[QUITTER] ; DEFAULT HANDLER IS QUITTER + MCALL 2,HANDLER + +; BUILD A NULL STRING + + MOVEI A,0 + PUSHJ P,IBLOCK ; USE A BLOCK + MOVE D,T.CHAN+1(TB) + MOVEI 0,C.BUF + IORM 0,-2(D) + HRLI B,010700 + SUBI B,1 + MOVSI A,TCHSTR + MOVEM A,BUFSTR-1(D) + MOVEM B,BUFSTR(D) + MOVEI A,0 + MOVE B,D ; CHANNEL TO B + JRST MAKION + + +; ROUTINE TO OPEN ITS CHANNEL WITHOUT .RCHST + +IFN ITS,[ +OPEN2: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN ; OPEN THE FILE + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; SAVE THE CHANNEL + JRST OPEN3 + +; FIX UP MODE AND FALL INTO OPEN + +OPEN0: HRRZ A,S.DIR(C) ; GET DIR + TRNE A,2 ; SKIP IF NOT BLOCK + IORI A,4 ; TURN ON IMAGE + IORI A,2 ; AND BLOCK + + PUSH P,A + PUSH TP,$TPDL + PUSH TP,C ; SAVE CRUFT TO CHECK FOR PRINTO, HA HA + MOVE B,T.CHAN+1(TB) + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) ; THIS KLUDGE THE MESS OF NDR + PUSHJ P,STRTO6 + MOVE C,(TP) + POP P,D ; THE SIXBIT FOR KLUDGE + POP P,A ; GET BACK THE RANDOM BITS + SUB TP,[2,,2] + CAME D,[SIXBIT /PRINAO/] + CAMN D,[SIXBIT /PRINTO/] + IORI A,100000 ; WRITEOVER BIT + HRRZ 0,FSAV(TB) + CAIN 0,NFOPEN + IORI A,10 ; DON'T CHANGE REF DATE +OPEN9: HRLM A,S.DIR(C) ; AND STORE IT + +; ROUTINE TO ATTEMPT TO OPEN A REAL ITS CHANNEL + +OPEN1: MOVEI A,S.DIR(C) ; POINT TO OPEN BLOCK + PUSHJ P,MOPEN + JRST OPNLOS + MOVE B,T.CHAN+1(TB) ; GET CHANNEL BACK + MOVEM A,CHANNO(B) ; CLOBBER INTO CHANNEL + DOTCAL RFNAME,[A,[2003,,S.DEV],[2003,,S.NM1],[2003,,S.NM2],[2003,,S.SNM]] + JFCL + +; NOW CLOBBER THE TVP SLOT FOR THIS CHANNEL + +OPEN3: MOVE A,S.DIR(C) + MOVEI 0,C.OPN+C.READ + TRNE A,1 + MOVEI 0,C.OPN+C.PRIN + TRNE A,2 + TRO 0,C.BIN + HRRM 0,-2(B) + MOVE A,CHANNO(B) ; GET CHANNEL # + ASH A,1 + ADDI A,CHNL0 ; POINT TO SLOT + MOVEM B,1(A) ; NOT: TYPE ALREADY SETUP + +; NOW GET STATUS WORD + +DOSTAT: HRRZ A,CHANNO(B) ; NOW GET STATUS WORD + DOTCAL STATUS,[A,[2002,,STATUS]] + JFCL + POPJ P, + + +; HERE IF OPEN FAILS (CHANNEL IS IN A) + +OPNLOS: JUMPL A,NOCHAN ; ALL CHANNELS ARE IN USE + LSH A,23. ; DO A .STATUS + IOR A,[.STATUS A] + XCT A ; STATUS TO A + MOVE B,T.CHAN+1(TB) + PUSHJ P,GFALS ; GET A FALSE WITH A MESSAGE + SUB P,[1,,1] ; EXTRA RET ADDR FLUSHED + JRST OPNRET ; AND RETURN +] + +CGFALS: SUBM M,(P) + MOVEI B,0 +IFN ITS, PUSHJ P,GFALS +IFE ITS, PUSHJ P,TGFALS + JRST MPOPJ + +; ROUTINE TO CONS UP FALSE WITH REASON +IFN ITS,[ +GFALS: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,[SIXBIT / ERR/] ; SET UP OPEN TO ERR DEV + PUSH P,[3] ; SAY ITS FOR CHANNEL + PUSH P,A + .OPEN 0,-2(P) ; USE CHANNEL 0 FOR THIS + FATAL CAN'T OPEN ERROR DEVICE + SUB P,[3,,3] ; DONT WANT OPEN BLOCK NOW +IFN FNAMS, PUSH P,A + MOVEI A,0 ; PREPARE TO BUILD STRING ON STACK +EL1: PUSH P,[0] ; WHERE IT WILL GO + MOVSI B,(<440700,,(P)>) ; BYTE POINTER TO TOP OF STACK +EL2: .IOT 0,0 ; GET A CHAR + JUMPL 0,EL3 ; JUMP ON -1,,3 + CAIN 0,3 ; EOF? + JRST EL3 ; YES, MAKE STRING + CAIN 0,14 ; IGNORE FORM FEEDS + JRST EL2 ; IGNORE FF + CAIE 0,15 ; IGNORE CR & LF + CAIN 0,12 + JRST EL2 + IDPB 0,B ; STUFF IT + TLNE B,760000 ; SIP IF WORD FULL + AOJA A,EL2 + AOJA A,EL1 ; COUNT WORD AND GO + +EL3: +IFN FNAMS,[ + SKIPN (P) + SUB P,[1,,1] + PUSH P,A + .CLOSE 0, + PUSHJ P,CHMAK + PUSH TP,A + PUSH TP,B + SKIPN B,-2(TP) + JRST EL4 + MOVEI A,0 + MOVSI B,(<440700,,(P)>) + PUSH P,[0] + IRP XX,,[RDEVIC,RSNAME,RNAME1,RNAME2]YY,,[0,72,73,40] +IFSN YY,0,[ + MOVEI 0,YY + JSP E,1PUSH +] + MOVE E,-2(TP) + MOVE C,XX(E) + HRRZ D,XX-1(E) + JSP E,PUSHIT + TERMIN +] + SKIPN (P) ; ANY CHARS AT END? + SUB P,[1,,1] ; FLUSH XTRA + PUSH P,A ; PUT UP COUNT + .CLOSE 0, ; CLOSE THE ERR DEVICE + PUSHJ P,CHMAK ; MAKE STRING + PUSH TP,A + PUSH TP,B +IFN FNAMS,[ +EL4: POP P,A + PUSH TP,$TFIX + PUSH TP,A] +IFE FNAMS, MOVEI A,1 +IFN FNAMS,[ + MOVEI A,3 + SKIPN B + MOVEI A,2 +] + PUSHJ P,IILIST + MOVSI A,TFALSE ; MAKEIT A FALSE +IFN FNAMS, SUB TP,[2,,2] + POPJ P, + +IFN FNAMS,[ +1PUSH: MOVEI D,0 + JRST PUSHI2 +PUSHI1: PUSH P,[0] + MOVSI B,(<440700,,(P)>) +PUSHIT: SOJL D,(E) + ILDB 0,C +PUSHI2: IDPB 0,B + TLNE B,760000 + AOJA A,PUSHIT + AOJA A,PUSHI1 +] +] + + +; ROUTINE TO FILL IN THE "REAL" SLOTS FOR THE CHANNEL + +FIXREA: +IFE ITS, HRLZS S.DEV(C) ; KILL MODE BITS + MOVE D,[-4,,S.DEV] + +FIXRE1: MOVEI A,(D) ; COPY REL POINTER + ADD A,T.SPDL+1(TB) ; POINT TO SLOT + SKIPN A,(A) ; SKIP IF GOODIE THERE + JRST FIXRE2 + PUSHJ P,6TOCHS ; MAKE INOT A STRING + MOVE C,RDTBL-S.DEV(D); GET OFFSET + ADD C,T.CHAN+1(TB) + MOVEM A,-1(C) + MOVEM B,(C) +FIXRE2: AOBJN D,FIXRE1 + POPJ P, + +IFN ITS,[ +DOOPN: HRLZ A,A + HRR A,CHANNO(B) ; GET CHANNEL + DOTCAL OPEN,[A,-3(P),-2(P),-1(P),(P)] + SKIPA + AOS -1(P) + POPJ P, +] + +;THIS ROUTINE CONVERTS MUDDLE CHARACTER STRINGS TO SIXBIT FILE NAMES +STRTO6: PUSH TP,A + PUSH TP,B + PUSH P,E ;SAVE USEFUL FROB + MOVEI E,(A) ; CHAR COUNT TO E + GETYP A,A + CAIE A,TCHSTR ; IS IT ONE WORD? + JRST WRONGT ;NO + CAILE E,6 ; SKIP IF L=? 6 CHARS + MOVEI E,6 +CHREAD: MOVEI A,0 ;INITIALIZE OUTPUT WORD + MOVE D,[440600,,A] ;AND BYTE POINTER TO IT +NEXCHR: SOJL E,SIXDON + ILDB 0,B ; GET NEXT CHAR + CAIN 0,^Q ; CNTL-Q, QUOTES NEXT CHAR + JRST NEXCHR + JUMPE 0,SIXDON ;IF NULL, WE ARE FINISHED + PUSHJ P,A0TO6 ; CONVERT TO SIXBIT + IDPB 0,D ;DEPOSIT INTO SIX BIT + JRST NEXCHR ; NO, GET NEXT +SIXDON: SUB TP,[2,,2] ;FIX UP TP + POP P,E + EXCH A,(P) ;LEAVE RESULT ON P-STACK + JRST (A) ;NOW RETURN + + +;SUBROUTINE TO CONVERT SIXBIT TO ATOM + +6TOCHS: PUSH P,E + PUSH P,D + MOVEI B,0 ;MAX NUMBER OF CHARACTERS + PUSH P,[0] ;STRING WILL GO ON P SATCK + JUMPE A,GETATM ; EMPTY, LEAVE + MOVEI E,-1(P) ;WILL BE BYTE POINTER + HRLI E,10700 ;SET IT UP + PUSH P,[0] ;SECOND POSSIBLE WORD + MOVE D,[440600,,A] ;INPUT BYTE POINTER +6LOOP: ILDB 0,D ;START CHAR GOBBLING + ADDI 0,40 ;CHANGET TOASCII + IDPB 0,E ;AND STORE IT + TLNN D,770000 ; SKIP IF NOT DONE + JRST 6LOOP1 + TDNN A,MSKS(B) ; CHECK IF JUST SPACES LEFT + AOJA B,GETATM ; YES, DONE + AOJA B,6LOOP ;KEEP LOOKING +6LOOP1: PUSH P,[6] ;IF ARRIVE HERE, STRING IS 2 WORDS + JRST .+2 +GETATM: MOVEM B,(P) ;SET STRING LENGTH=1 + PUSHJ P,CHMAK ;MAKE A MUDDLE STRING + POP P,D + POP P,E + POPJ P, + +MSKS: 7777,,-1 + 77,,-1 + ,,-1 + 7777 + 77 + + +; CONVERT ONE CHAR + +A0TO6: CAIL 0,141 ;IF IT IS GREATER OR EQUAL TO LOWER A + CAILE 0,172 ;BUT LESS THAN OR EQUAL TO LOWER Z + JRST .+2 ;THEN + SUBI 0,40 ;CONVERT TO UPPER CASE + SUBI 0,40 ;NOW TO SIX BIT + JUMPL 0,BAD6 ;CHECK FOR A WINNER + CAILE 0,77 + JRST BAD6 + POPJ P, + +; SUBR TO TEST THE EXISTENCE OF FILES + +MFUNCTION FEXIST,SUBR,[FILE-EXISTS?] + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + ADD TP,[2,,2] + MOVSI E,-4 ; 4 THINGS TO PUSH +EXIST: +IFN ITS, MOVE B,@RNMTBL(E) +IFE ITS, MOVE B,@FETBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST EXIST1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ +; PUSH P,E +; PUSHJ P,ADDNUL ; NOT NEEDED, SINCE CONSED INTO ONE STRING-TAA +; POP P,E + PUSH TP,A ; DEFAULT TYPE AND VALUE GIVEN BY USER + PUSH TP,B ; IN VALUE OF DEV, SNM, NM1, NM2 + ] +IFN ITS, JRST .+2 +IFE ITS, JRST .+3 + +EXIST1: +IFN ITS, PUSH P,EXISTS(E) ; USE DEFAULT +IFE ITS,[ + PUSH TP,FETYP(E) ; DEFAULT TYPE AND VALUE IF NO + PUSH TP,FEVAL(E) ; DEFAULT GIVEN BY USER + ] + AOBJN E,EXIST + + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST TMA ; TOO MANY ARGUMENTS + +IFN ITS,[ + MOVE 0,-3(P) ; GET SIXBIT DEV NAME + MOVEI B,0 + CAMN 0,[SIXBITS /DSK /] + MOVSI B,10 ; DONT SET REF DATE IF DISK DEV + .IOPUSH + DOTCAL OPEN,[B,[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST .+3 + .IOPOP + JRST FDLWON ; WON!!! + .STATUS 0,A ; FIND THE STATUS OF CHANNEL BEFORE POPING + .IOPOP + JRST FDLST1] + +IFE ITS,[ + MOVE B,TB + SUBI B,10 ; GET B TO POINT CORRECTLY TO ARGS + PUSHJ P,STSTK ; GET FILE NAME IN A STRING + HRROI B,1(E) ; POINT B TO THE STRING + MOVSI A,100001 + GTJFN + JRST TDLLOS ; FILE DOES NOT EXIST + RLJFN ; FILE EXIST SO RETURN JFN + JFCL + JRST FDLWON ; SUCCESS + ] + +IFN ITS,[ +EXISTS: SIXBITS /DSK INPUT > / + ] +IFE ITS,[ +FETBL: SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + +FETYP: TCHSTR,,5 + TCHSTR,,3 + TCHSTR,,3 + TCHSTR,,0 + +FEVAL: 440700,,[ASCIZ /INPUT/] + 440700,,[ASCIZ /MUD/] + 440700,,[ASCIZ /DSK/] + 0 + ] + +; SUBR TO DELETE AND RENAME FILES + +MFUNCTION RENAME,SUBR + + ENTRY + + JUMPGE AB,TFA + PUSH TP,$TPDL + PUSH TP,P ; SAVE P-STACK BASE + GETYP 0,(AB) ; GET 1ST ARG TYPE +IFN ITS,[ + CAIN 0,TCHAN ; CHANNEL? + JRST CHNRNM ; MUST BE RENAME WHILE OPEN FOR WRITING +] +IFE ITS,[ + PUSH P,[100000,,-2] + PUSH P,[377777,,377777] +] + MOVSI E,-4 ; 4 THINGS TO PUSH +RNMALP: MOVE B,@RNMTBL(E) + PUSH P,E + PUSHJ P,IDVAL1 + POP P,E + GETYP 0,A + CAIE 0,TCHSTR ; SKIP IF WINS + JRST RNMLP1 + +IFN ITS, PUSHJ P,STRTO6 ; CONVERT TO SIXBIT +IFE ITS,[ + PUSH P,E + PUSHJ P,ADDNUL + EXCH B,(P) + MOVE E,B +] + JRST .+2 + +RNMLP1: PUSH P,RNSTBL(E) ; USE DEFAULT + AOBJN E,RNMALP + +IFN ITS,[ + PUSHJ P,RGPRS ; PARSE THE ARGS + JRST RNM1 ; COULD BE A RENAME + +; HERE TO DELETE A FILE + +DELFIL: MOVE A,(P) ; AND GET SNAME + .SUSET [.SSNAM,,A] + DOTCAL DELETE,[[17,,-3],[17,,-2],[17,,-1],[17,,0]] + JRST FDLST ; ANALYSE ERROR + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS +] +IFE ITS,[ + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; GET BASE OF PDL + MOVEI A,1(A) ; POINT TO CRAP + CAMGE AB,[-3,,] ; SKIP IF DELETE + HLLZS (A) ; RESET DEFAULT + PUSH P,[0] + PUSH P,[0] + PUSH P,[0] + GTJFN ; GET A JFN + JRST TDLLOS ; LOST + ADD AB,[2,,2] ; PAST ARG + MOVEM AB,ABSAV(TB) + JUMPL AB,RNM1 ; GO TRY FOR RENAME + MOVE P,(TP) ; RESTORE P STACK + MOVEI C,(A) ; FOR RELEASE + DELF ; ATTEMPT DELETE + JRST DELLOS ; LOSER + RLJFN ; MAKE SURE FLUSHED + JFCL + +FDLWON: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +RNMLOS: PUSH P,A + MOVEI A,(B) + RLJFN + JFCL +DELLO1: MOVEI A,(C) + RLJFN + JFCL + POP P,A ; ERR NUMBER BACK +TDLLOS: MOVEI B,0 + PUSHJ P,TGFALS ; GET FALSE WITH REASON + JRST FINIS + +DELLOS: PUSH P,A ; SAVE ERROR + JRST DELLO1 +] + +;TABLE OF REANMAE DEFAULTS +IFN ITS,[ +RNMTBL: IMQUOTE DEV + IMQUOTE NM1 + IMQUOTE NM2 + IMQUOTE SNM + +RNSTBL: SIXBIT /DSK _MUDS_> / +] +IFE ITS,[ +RNMTBL: SETZ IMQUOTE DEV + SETZ IMQUOTE SNM + SETZ IMQUOTE NM1 + SETZ IMQUOTE NM2 + +RNSTBL: -1,,[ASCIZ /DSK/] + 0 + -1,,[ASCIZ /_MUDS_/] + -1,,[ASCIZ /MUD/] +] +; HERE TO DO A RENAME + +RNM1: JUMPGE AB,TMA ; IF ARGS EXHAUSTED, MUST BE TOO MUCH STRING + GETYP 0,(AB) + MOVE C,1(AB) ; GET ARG + CAIN 0,TATOM ; IS IT "TO" + CAME C,IMQUOTE TO + JRST WRONGT ; NO, LOSE + ADD AB,[2,,2] ; BUMP PAST "TO" + MOVEM AB,ABSAV(TB) + JUMPGE AB,TFA +IFN ITS,[ + MOVEM P,T.SPDL+1(TB) ; SAVE NEW P-BASE + + MOVEI 0,4 ; FOUR DEFAULTS + PUSH P,-3(P) ; DEFAULT DEVICE IS CURRENT + SOJN 0,.-1 + + PUSHJ P,RGPRS ; PARSE THE NEXT STRING + JRST TMA + + MOVE A,-7(P) ; FIX AND GET DEV1 + MOVE B,-3(P) ; SAME FOR DEV2 + CAME A,B ; SAME? + JRST DEVDIF + + POP P,A ; GET SNAME 2 + CAME A,(P)-3 ; SNAME 1 + JRST DEVDIF + .SUSET [.SSNAM,,A] + POP P,-2(P) ; MOVE NAMES DOWN + POP P,-2(P) + DOTCAL RENAME,[[17,,-4],[17,,-3],[17,,-2],A,[17,,-1],(P)] + JRST FDLST + JRST FDLWON + +; HERE FOR RENAME WHILE OPEN FOR WRITING + +CHNRNM: ADD AB,[2,,2] ; NEXT ARG + MOVEM AB,ABSAV(TB) + JUMPGE AB,TFA + MOVE B,-1(AB) ; GET CHANNEL + SKIPN CHANNO(B) ; SKIP IF OPEN + JRST BADCHN + MOVE A,DIRECT-1(B) ; CHECK DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; TO 6 BIT + POP P,A + CAME A,[SIXBIT /PRINT/] + CAMN A,[SIXBIT /PRINTB/] + JRST CHNRN1 + CAMN A,[SIXBIT /PRINAO/] + JRST CHNRM1 + CAME A,[SIXBIT /PRINTO/] + JRST WRONGD + +; SET UP .FDELE BLOCK + +CHNRN1: PUSH P,[0] + PUSH P,[0] + MOVEM P,T.SPDL+1(TB) + PUSH P,[0] + PUSH P,[SIXBIT /_MUDL_/] + PUSH P,[SIXBIT />/] + PUSH P,[0] + + PUSHJ P,RGPRS ; PARSE THESE + JRST TMA + + SUB P,[1,,1] ; SNAME/DEV IGNORED + MOVE AB,ABSAV(TB) ; GET ORIG ARG POINTER + MOVE B,1(AB) + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RENMWO,[A,[17,,-1],(P)] + JRST FDLST + MOVE A,CHANNO(B) ; ITS CHANNEL # + DOTCAL RFNAME,[A,[2017,,-4],[2017,,-3],[2017,,-2],[2017,,-1]] + JFCL + MOVE A,-3(P) ; UPDATE CHANNEL + PUSHJ P,6TOCHS ; GET A STRING + MOVE C,1(AB) + MOVEM A,RNAME1-1(C) + MOVEM B,RNAME1(C) + MOVE A,-2(P) + PUSHJ P,6TOCHS + MOVE C,1(AB) + MOVEM A,RNAME2-1(C) + MOVEM B,RNAME2(C) + MOVE B,1(AB) + MOVSI A,TCHAN + JRST FINIS +] +IFE ITS,[ + PUSH P,A + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,ADDNUL + MOVE A,(TP) ; PBASE BACK + PUSH A,[400000,,0] + MOVEI A,(A) + GTJFN + JRST TDLLOS + POP P,B + EXCH A,B + MOVEI C,(A) ; FOR RELEASE ATTEMPT + RNAMF + JRST RNMLOS + MOVEI A,(B) + RLJFN ; FLUSH JFN + JFCL + MOVEI A,(C) ; MAKE SURR OTHER IS FLUSHED + RLJFN + JFCL + JRST FDLWON + + +ADDNUL: PUSH TP,A + PUSH TP,B + MOVEI A,(A) ; LNTH OF STRING + IDIVI A,5 + JUMPN B,NONUAD ; DONT NEED TO ADD ONE + + PUSH TP,$TCHRS + PUSH TP,[0] + MOVEI A,2 + PUSHJ P,CISTNG ; COPY OF STRING + POPJ P, + +NONUAD: POP TP,B + POP TP,A + POPJ P, +] +; HERE FOR LOSING .FDELE + +IFN ITS,[ +FDLST: .STATUS 0,A ; GET STATUS +FDLST1: MOVEI B,0 + PUSHJ P,GFALS ; ANALYZE IT + JRST FINIS +] + +; SOME .FDELE ERRORS + +DEVDIF: ERRUUO EQUOTE DEVICE-OR-SNAME-DIFFERS + + ; HERE TO RESET A READ CHANNEL + +MFUNCTION FRESET,SUBR,RESET + + ENTRY 1 + GETYP A,(AB) + CAIE A,TCHAN + JRST WTYP1 + MOVE B,1(AB) ;GET CHANNEL + SKIPN IOINS(B) ; OPEN? + JRST REOPE1 ; NO, IGNORE CHECKS +IFN ITS,[ + MOVE A,STATUS(B) ;GET STATUS + ANDI A,77 + JUMPE A,REOPE1 ;IF IT CLOSED, JUST REOPEN IT, MAYBE? + CAILE A,2 ;SKIPS IF TTY FLAVOR + JRST REOPEN +] +IFE ITS,[ + MOVE A,CHANNO(B) + CAIE A,100 ; TTY-IN + CAIN A,101 ; TTY-OUT + JRST .+2 + JRST REOPEN +] + CAME B,TTICHN+1 + CAMN B,TTOCHN+1 + JRST REATTY +REATT1: MOVEI B,DIRECT-1(B) ;POINT TO DIRECTION + PUSHJ P,CHRWRD ;CONVERT TO A WORD + JFCL + CAME B,[ASCII /READ/] + JRST TTYOPN + MOVE B,1(AB) ;RESTORE CHANNEL + PUSHJ P,RRESET" ;DO REAL RESET + JRST TTYOPN + +REOPEN: PUSH TP,(AB) ;FIRST CLOSE IT + PUSH TP,(AB)+1 + MCALL 1,FCLOSE + MOVE B,1(AB) ;RESTORE CHANNEL + +; SET UP TEMPS FOR OPNCH + +REOPE1: PUSH P,[0] ; WILL HOLD DIR CODE + PUSH TP,$TPDL + PUSH TP,P + IRP A,,[DIRECT,RNAME1,RNAME2,RDEVIC,RSNAME,ACCESS] + PUSH TP,A-1(B) + PUSH TP,A(B) + TERMIN + + PUSH TP,$TCHAN + PUSH TP,1(AB) + + MOVE A,T.DIR(TB) + MOVE B,T.DIR+1(TB) ; GET DIRECTION + PUSHJ P,CHMOD ; CHECK THE MODE + MOVEM A,(P) ; AND STORE IT + +; NOW SET UP OPEN BLOCK IN SIXBIT + +IFN ITS,[ + MOVSI E,-4 ; AOBN PNTR +FRESE2: MOVE B,T.CHAN+1(TB) + MOVEI A,@RDTBL(E) ; GET ITEM POINTER + GETYP 0,-1(A) ; GET ITS TYPE + CAIE 0,TCHSTR + JRST FRESE1 + MOVE B,(A) ; GET STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 +FRESE3: AOBJN E,FRESE2 +] +IFE ITS,[ + MOVE B,T.CHAN+1(TB) + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; RESULT ON STACK + HLRZS (P) +] + + PUSH P,[0] ; PUSH UP SOME DUMMIES + PUSH P,[0] + PUSH P,[0] + PUSHJ P,OPNCH ; ATTEMPT TO DO THEOPEN + GETYP 0,A + CAIE 0,TCHAN + JRST FINIS ; LEAVE IF FALSE OR WHATEVER + +DRESET: MOVE A,(AB) + MOVE B,1(AB) + SETZM CHRPOS(B) ;INITIALIZE THESE PARAMETERS + SETZM LINPOS(B) + SETZM ACCESS(B) + JRST FINIS + +TTYOPN: +IFN ITS,[ + MOVE B,1(AB) + CAME B,TTOCHN+1 + CAMN B,TTICHN+1 + PUSHJ P,TTYOP2 + PUSHJ P,DOSTAT + DOTCAL RSSIZE,[CHANNO(B),[2000,,C],[2000,,D]] + .LOSE %LSSYS + MOVEM C,PAGLN(B) + MOVEM D,LINLN(B) +] + JRST DRESET + +IFN ITS,[ +FRESE1: CAIE 0,TFIX + JRST BADCHN + PUSH P,(A) + JRST FRESE3 +] + +; INTERFACE TO REOPEN CLOSED CHANNELS + +OPNCHN: PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FRESET + POPJ P, + +REATTY: PUSHJ P,TTYOP2 +IFE ITS, SKIPN DEMFLG ; SKIP IF DEMONFLAG IS ON + SKIPE NOTTY + JRST DRESET + MOVE B,1(AB) + JRST REATT1 + +; FUNCTION TO LIST ALL CHANNELS + +MFUNCTION CHANLIST,SUBR + + ENTRY 0 + + MOVEI A,N.CHNS-1 ;MAX # OF REAL CHANNELS + MOVEI C,0 + MOVEI B,CHNL1 ;POINT TO FIRST REAL CHANNEL + +CHNLP: SKIPN 1(B) ;OPEN? + JRST NXTCHN ;NO, SKIP + HRRE E,(B) ; ABOUT TO FLUSH? + JUMPL E,NXTCHN ; YES, FORGET IT + MOVE D,1(B) ; GET CHANNEL + HRRZ E,CHANNO-1(D) ; GET REF COUNT + PUSH TP,(B) + PUSH TP,1(B) + ADDI C,1 ;COUNT WINNERS + SOJGE E,.-3 ; COUNT THEM +NXTCHN: ADDI B,2 + SOJN A,CHNLP + + SKIPN B,CHNL0+1 ;NOW HACK LIST OF PSUEDO CHANNELS + JRST MAKLST +CHNLS: PUSH TP,(B) + PUSH TP,(B)+1 + ADDI C,1 + HRRZ B,(B) + JUMPN B,CHNLS + +MAKLST: ACALL C,LIST + JRST FINIS + + ; ROUTINE TO RESTORE A CLOSED CHANNEL TO ITS PREVIOUS STATE + + +REOPN: PUSH TP,$TCHAN + PUSH TP,B + SKIPN CHANNO(B) ; ONLY REAL CHANNELS + JRST PSUEDO + +IFN ITS,[ + MOVSI E,-4 ; SET UP POINTER FOR NAMES + +GETOPB: MOVE B,(TP) ; GET CHANNEL + MOVEI A,@RDTBL(E) ; GET POINTER + MOVE B,(A) ; NOW STRING + MOVE A,-1(A) + PUSHJ P,STRTO6 ; LEAVES SIXBIT ON STACK + AOBJN E,GETOPB +] +IFE ITS,[ + MOVE A,RDEVIC-1(B) + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 ; GET DEV NAME IN SIXBIT +] + MOVE B,(TP) ; RESTORE CHANNEL + MOVE A,DIRECT-1(B) + MOVE B,DIRECT(B) + PUSHJ P,CHMOD ; CHECK FOR A VALID MODE + +IFN ITS, MOVE E,-3(P) ; GET DEVICE IN PROPER PLACE +IFE ITS, HLRZS E,(P) + MOVE B,(TP) ; RESTORE CHANNEL +IFN ITS, CAMN E,[SIXBIT /DSK /] +IFE ITS,[ + CAIE E,(SIXBIT /PS /) + CAIN E,(SIXBIT /DSK/) + JRST DISKH ; DISK WINS IMMEIDATELY + CAIE E,(SIXBIT /SS /) + CAIN E,(SIXBIT /SRC/) + JRST DISKH ; DISK WINS IMMEIDATELY +] +IFN ITS, CAMN E,[SIXBIT /TTY /] ; NO NEED TO RE-OPEN THE TTY +IFE ITS, CAIN E,(SIXBIT /TTY/) + JRST REOPD1 +IFN ITS,[ + AND E,[777700,,0] ; COULD BE "UTn" + MOVE D,CHANNO(B) ; GET CHANNEL + ASH D,1 + ADDI D,CHNL0 ; DON'T SEEM TO BE OPEN + SETZM 1(D) + SETZM CHANNO(B) + CAMN E,[SIXBIT /UT /] + JRST REOPD ; CURRENTLY, CANT RESTORE UTAPE CHANNLES + CAMN E,[SIXBIT /AI /] + JRST REOPD ; CURRENTLY CANT RESTORE AI CHANNELS + CAMN E,[SIXBIT /ML /] + JRST REOPD ; CURRENTLY CANT RESTORE ML CHANNELS + CAMN E,[SIXBIT /DM /] + JRST REOPD ; CURRENTLY CANT RESTORE DM CHANNELS +] + PUSH TP,$TCHAN ; TRY TO RESET IT + PUSH TP,B + MCALL 1,FRESET + +IFN ITS,[ +REOPD1: AOS -4(P) +REOPD: SUB P,[4,,4] +] +IFE ITS,[ +REOPD1: AOS -1(P) +REOPD: SUB P,[1,,1] +] +REOPD0: SUB TP,[2,,2] + POPJ P, + +IFN ITS,[ +DISKH: MOVE C,(P) ; SNAME + .SUSET [.SSNAM,,C] +] +IFE ITS,[ +DISKH: MOVEM A,(P) ; SAVE MODE WORD + PUSHJ P,STSTK ; STRING TO STACK + MOVE A,(E) ; RESTORE MODE WORD + PUSH TP,$TPDL + PUSH TP,E ; SAVE PDL BASE + MOVE B,-2(TP) ; CHANNEL BACK TO B +] + MOVE C,ACCESS(B) ; GET CHANNELS ACCESS + TRNN A,2 ; SKIP IF NOT ASCII CHANNEL + JRST DISKH1 + HRRZ D,ACCESS-1(B) ; IF PARTIAL WORD OUT + IMULI C,5 ; TO CHAR ACCESS + JUMPE D,DISKH1 ; NO SWEAT + ADDI C,(D) + SUBI C,5 +DISKH1: HRRZ D,BUFSTR-1(B) ; ANY CHARS IN MUDDLE BUFFER + JUMPE D,DISKH2 + TRNN A,1 ; SKIP IF OUTPUT CHANNEL + JRST DISKH2 + PUSH P,A + PUSH P,C + MOVEI C,BUFSTR-1(B) + PUSHJ P,BYTDOP ; FIND LENGTH OF WHOLE BUFFER + HLRZ D,(A) ; LENGTH + 2 TO D + SUBI D,2 + IMULI D,5 ; TO CHARS + SUB D,BUFSTR-1(B) + POP P,C + POP P,A +DISKH2: SUBI C,(D) ; UPDATE CHAR ACCESS + IDIVI C,5 ; BACK TO WORD ACCESS +IFN ITS,[ + IORI A,6 ; BLOCK IMAGE + TRNE A,1 + IORI A,100000 ; WRITE OVER BIT + PUSHJ P,DOOPN + JRST REOPD + MOVE A,C ; ACCESS TO A + PUSHJ P,GETFLN ; CHECK LENGTH + CAIGE 0,(A) ; CHECK BOUNDS + JRST .+3 ; COMPLAIN + PUSHJ P,DOACCS ; AND ACESS + JRST REOPD1 ; SUCCESS + + MOVE A,CHANNO(B) ; CLOSE THE G.D. CHANNEL + PUSHJ P,MCLOSE + JRST REOPD + +DOACCS: PUSH P,A + HRRZ A,CHANNO(B) + DOTCAL ACCESS,[A,(P)] + JFCL + POP P,A + POPJ P, + +DOIOTO: +DOIOTI: +DOIOT: + PUSH P,0 + MOVSI 0,TCHAN + MOVE PVP,PVSTOR+1 + MOVEM 0,BSTO(PVP) ; IN CASE OF INTERRUPT + ENABLE + HRRZ 0,CHANNO(B) + DOTCAL IOT,[0,A] + JFCL + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + POP P,0 + POPJ P, + +GETFLN: MOVE 0,CHANNO(B) ; GET CHANNEL + .CALL FILBLK ; READ LNTH + .VALUE + POPJ P, + +FILBLK: SETZ + SIXBIT /FILLEN/ + 0 + 402000,,0 ; STUFF RESULT IN 0 +] +IFE ITS,[ + MOVEI A,CHNL0 + ADD A,CHANNO(B) + ADD A,CHANNO(B) + SETZM 1(A) ; MAY GET A DIFFERENT JFN + HRROI B,1(E) ; TENEX STRING POINTER + MOVSI A,400001 ; MAKE SURE + GTJFN ; GO GET IT + JRST RGTJL ; COMPLAIN + MOVE D,-2(TP) + HRRZM A,CHANNO(D) ; COULD HAVE CHANGED + MOVE P,(TP) ; RESTORE P + MOVEI B,CHNL0 + ASH A,1 ; MUNG ITS SLOT + ADDI A,(B) + MOVEM D,1(A) + HLLOS (A) ; MARK CHANNEL NOT TO BE RELOOKED AT + MOVE A,(P) ; MODE WORD BACK + MOVE B,[440000,,200000] ; FLAG BITS + TRNE A,1 ; SKIP FOR INPUT + TRC B,300000 ; CHANGE TO WRITE + MOVE A,CHANNO(D) ; GET JFN + OPENF + JRST ROPFLS + MOVE E,C ; LENGTH TO E + SIZEF ; GET CURRENT LENGTH + JRST ROPFLS + CAMGE B,E ; STILL A WINNER + JRST ROPFLS + MOVE A,CHANNO(D) ; JFN + MOVE B,C + SFPTR + JRST ROPFLS + SUB TP,[2,,2] ; FLUSH PDL POINTER + JRST REOPD1 + +ROPFLS: MOVE A,-2(TP) + MOVE A,CHANNO(A) + CLOSF ; ATTEMPT TO CLOSE + JFCL ; IGNORE FAILURE + SKIPA + +RGTJL: MOVE P,(TP) + SUB TP,[2,,2] + JRST REOPD + +DOACCS: PUSH P,B + EXCH A,B + MOVE A,CHANNO(A) + SFPTR + JRST ACCFAI + POP P,B + POPJ P, +] +PSUEDO: AOS (P) ; ASSUME SUCCESS FOR NOW + MOVEI B,RDEVIC-1(B) ; SEE WHAT DEVICE IS + PUSHJ P,CHRWRD + JFCL + JRST REOPD0 ; NO, RETURN HAPPY +IFN 0,[ CAME B,[ASCII /E&S/] ; DISPLAY ? + CAMN B,[ASCII /DIS/] + SKIPA B,(TP) ; YES, REGOBBLE CHANNEL AND CONTINUE + JRST REOPD0 ; NO, RETURN HAPPY + PUSHJ P,DISROP + SOS (P) ; DISPLAY DID NOT REOPEN, UNDO ASSUMPTION OF SUCCESS + JRST REOPD0] + + ;THIS PROGRAM CLOSES THE SPECIFIED CHANNEL + +MFUNCTION FCLOSE,SUBR,[CLOSE] + + ENTRY 1 ;ONLY ONE ARG + GETYP A,(AB) ;CHECK ARGS + CAIE A,TCHAN ;IS IT A CHANNEL + JRST WTYP1 + MOVE B,1(AB) ;PICK UP THE CHANNEL + HRRZ A,CHANNO-1(B) ; GET REF COUNT + SOJGE A,CFIN5 ; NOT READY TO REALLY CLOSE + CAME B,TTICHN+1 ; CHECK FOR TTY + CAMN B,TTOCHN+1 + JRST CLSTTY + MOVE A,[JRST CHNCLS] + MOVEM A,IOINS(B) ;CLOBBER THE IO INS + MOVE A,RDEVIC-1(B) ;GET THE NAME OF THE DEVICE + MOVE B,RDEVIC(B) + PUSHJ P,STRTO6 +IFN ITS, MOVE A,(P) +IFE ITS, HLRZS A,(P) + MOVE B,1(AB) ; RESTORE CHANNEL +IFN 0,[ + CAME A,[SIXBIT /E&S /] + CAMN A,[SIXBIT /DIS /] + PUSHJ P,DISCLS] + MOVE B,1(AB) ; IN CASE CLOBBERED BY DISCLS + SKIPN A,CHANNO(B) ;ANY REAL CHANNEL? + JRST REMOV ; NO, EITHER CLOSED OR PSEUDO CHANNEL + + MOVE A,DIRECT-1(B) ; POINT TO DIRECTION + MOVE B,DIRECT(B) + PUSHJ P,STRTO6 ; CONVERT TO WORD + POP P,A +IFN ITS, LDB E,[360600,,(P)] ; FIRST CHAR OD DEV NAME +IFE ITS, LDB E,[140600,,(P)] ; FIRST CHAR OD DEV NAME + CAIE E,'T ; SKIP IF TTY + JRST CFIN4 + CAME A,[SIXBIT /READ/] ; SKIP IF WINNER + JRST CFIN1 +IFN ITS,[ + MOVE B,1(AB) ; IN ITS CHECK STATUS + LDB A,[600,,STATUS(B)] + CAILE A,2 + JRST CFIN1 +] + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE CHAR + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,OFF ; TURN OFF INTERRUPT +CFIN1: MOVE B,1(AB) + MOVE A,CHANNO(B) +IFN ITS,[ + PUSHJ P,MCLOSE +] +IFE ITS,[ + TLZ A,400000 ; FOR JFN RELEASE + CLOSF ; CLOSE THE FILE AND RELEASE THE JFN + JFCL + MOVE A,CHANNO(B) +] +CFIN: LSH A,1 + ADDI A,CHNL0+1 ;POINT TO THIS CHANNELS LSOT + SETZM CHANNO(B) + SETZM (A) ;AND CLOBBER IT + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) + HLLZS ACCESS-1(B) +CFIN2: HLLZS -2(B) + MOVSI A,TCHAN ;RETURN THE CHANNEL + JRST FINIS + +CLSTTY: ERRUUO EQUOTE ATTEMPT-TO-CLOSE-TTY-CHANNEL + + +REMOV: MOVEI D,CHNL0+1 ;ATTEMPT TO REMOVE FROM PSUEDO CHANNEL LIST +REMOV0: SKIPN C,D ;FOUND ON LIST ? + JRST CFIN2 ;NO, JUST IGNORE THIS CLOSED CHANNEL + HRRZ D,(C) ;GET POINTER TO NEXT + CAME B,(D)+1 ;FOUND ? + JRST REMOV0 + HRRZ D,(D) ;YES, SPLICE IT OUT + HRRM D,(C) + JRST CFIN2 + + +; CLOSE UP ANY LEFTOVER BUFFERS + +CFIN4: +; CAME A,[SIXBIT /PRINTO/] +; CAMN A,[SIXBIT /PRINTB/] +; JRST .+3 +; CAME A,[SIXBIT /PRINT/] +; JRST CFIN1 + MOVE B,1(AB) ; GET CHANNEL + HRRZ A,-2(B) ;GET MODE BITS + TRNN A,C.PRIN + JRST CFIN1 + GETYP 0,BUFSTR-1(B) ; IS THERE AN OUTPUT BUFFER + SKIPN BUFSTR(B) + JRST CFIN1 + CAIE 0,TCHSTR + JRST CFINX1 + PUSHJ P,BFCLOS +IFE ITS,[ + MOVE A,CHANNO(B) + MOVEI B,7 + SFBSZ + JFCL + CLOSF + JFCL +] + HLLZS BUFSTR-1(B) + SETZM BUFSTR(B) +CFINX1: HLLZS ACCESS-1(B) + JRST CFIN1 + +CFIN5: HRRM A,CHANNO-1(B) + JRST CFIN2 + ;SUBR TO DO .ACCESS ON A READ CHANNEL +;FORM: +;POSITIONS CHANNEL AT CHARACTER POSN FIX-NUMBER +;H. BRODIE 7/26/72 + +MFUNCTION MACCESS,SUBR,[ACCESS] + ENTRY 2 ;ARGS: CHANNEL AND FIX-NUMBER + +;CHECK ARGUMENT TYPES + GETYP A,(AB) + CAIE A,TCHAN ;FIRST ARG SHOULD BE CHANNEL + JRST WTYP1 + GETYP A,2(AB) ;TYPE OF SECOND + CAIE A,TFIX ;SHOULD BE FIX + JRST WTYP2 + +;CHECK DIRECTION OF CHANNEL + MOVE B,1(AB) ;B GETS PNTR TO CHANNEL +; MOVEI B,DIRECT-1(B) ;GET DIRECTION OF CHANNEL +; PUSHJ P,CHRWRD ;GRAB THE CHAR STRNG +; JFCL +; CAME B,[+1] + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.PRIN + JRST MACCA + MOVE B,1(AB) + SKIPE C,BUFSTR(B) ;SEE IF WE MUST FLUSH PART BUFFER + PUSHJ P,BFCLOS + JRST MACC +MACCA: +; CAMN B,[ASCIZ /READ/] +; JRST .+4 +; CAME B,[ASCIZ /READB/] ; READB CHANNEL? +; JRST WRONGD +; AOS (P) ; SET INDICATOR FOR BINARY MODE + +;CHECK THAT THE CHANNEL IS OPEN +MACC: MOVE B,1(AB) ;GET BACK PTR TO CHANNEL + HRRZ E,-2(B) + TRNN E,C.OPN + JRST CHNCLS ;IF CHNL CLOSED => ERROR + +;COMPUTE ACCESS PNTR TO ACCESS WORD CHAR IS IN +;REMAINDER IS NUMBER OF TIMES TO INCR BYTE POINTER +ADEVOK: SKIPGE C,3(AB) ;GET CHAR POSN + ERRUUO EQUOTE NEGATIVE-ARGUMENT +MACC1: MOVEI D,0 + TRNN E,C.BIN ; SKIP FOR BINARY FILE + IDIVI C,5 + +;SETUP THE .ACCESS + TRNN E,C.PRIN + JRST NLSTCH + HRRZ 0,LSTCH-1(B) + MOVE A,ACCESS(B) + TRNN E,C.BIN + JRST LSTCH1 + IMULI A,5 + ADD A,ACCESS-1(B) + ANDI A,-1 +LSTCH1: CAIG 0,(A) + MOVE 0,A + MOVE A,C + IMULI A,5 + ADDI A,(D) + CAML A,0 + MOVE 0,A + HRRM 0,LSTCH-1(B) ; UPDATE "LARGEST" +NLSTCH: MOVE A,CHANNO(B) ;A GETS REAL CHANNEL NUMBER +IFN ITS,[ + DOTCAL ACCESS,[A,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + +IFE ITS,[ + MOVE B,C + SFPTR ; DO IT IN TENEX + JRST ACCFAI + MOVE B,1(AB) ; RESTORE CHANNEL +] +; POP P,E ; CHECK FOR READB MODE + TRNN E,C.READ + JRST ACCOUT ; PRINT TYPE CHANNEL, GO DO IT + SKIPE BUFSTR(B) ; IS THERE A READ BUFFER TO FLUSH + JRST .+3 + SETZM LSTCH(B) ; CLEAR OUT POSSIBLE EOF INDICATOR + JRST DONADV + +;NOW FORCE GETCHR TO DO A .IOT FIRST THING + MOVEI C,BUFSTR-1(B) ; FIND END OF STRING + PUSHJ P,BYTDOP" + SUBI A,2 ; LAST REAL WORD + HRLI A,010700 + MOVEM A,BUFSTR(B) + HLLZS BUFSTR-1(B) ; CLOBBER CHAR COUNT + SETZM LSTCH(B) ;CLOBBER READ'S HIDDEN CHARACTER + +;NOW DO THE APPROPRIATE NUM OF BYTE ADVANCEMENTS + JUMPLE D,DONADV +ADVPTR: PUSHJ P,GETCHR + MOVE B,1(AB) ;RESTORE IN CASE CLOBBERED + SOJG D,ADVPTR + +DONADV: MOVE C,3(AB) ;FIXUP ACCESS SLOT IN CHNL + HLLZS ACCESS-1(B) + MOVEM C,ACCESS(B) + MOVE A,$TCHAN ;TYPE OF RESULT = "CHANNEL" + JRST FINIS ;DONE...B CONTAINS CHANNEL + +IFE ITS,[ +ACCFAI: ERRUUO EQUOTE ACCESS-FAILURE +] +ACCOUT: SKIPN C,BUFSTR(B) ; FIXUP BUFFER? + JRST ACCOU1 + HRRZ F,BUFSTR-1(B) + ADD F,[-BUFLNT*5-4] + IDIVI F,5 + ADD F,BUFSTR(B) + HRLI F,010700 + MOVEM F,BUFSTR(B) + MOVEI F,BUFLNT*5 + HRRM F,BUFSTR-1(B) +ACCOU1: TRNE E,C.BIN ; FINISHED FOR BINARY CHANNELS + JRST DONADV + + JUMPE D,DONADV ; THIS CASE OK +IFE ITS,[ + MOVE A,CHANNO(B) ; GET LAST WORD + RFPTR + JFCL + PUSH P,B + MOVNI C,1 + MOVE B,[444400,,E] ; READ THE WORD + SIN + JUMPL C,ACCFAI + POP P,B + SFPTR + JFCL + MOVE B,1(AB) ; CHANNEL BACK + MOVE C,[440700,,E] + ILDB 0,C + IDPB 0,BUFSTR(B) + SOS BUFSTR-1(B) + SOJG D,.-3 + JRST DONADV +] +IFN ITS, ERRUUO EQUOTE CANT-ACCESS-ASCII-ON-ITS + + +;WRONG TYPE OF DEVICE ERROR +WRDEV: ERRUUO EQUOTE NON-DSK-DEVICE + +; BINARY READ AND PRINT ROUTINES + +MFUNCTION PRINTB,SUBR + + ENTRY + +PBFL: PUSH P,. ; PUSH NON-ZERONESS + MOVEI A,-7 + JRST BINI1 + +MFUNCTION READB,SUBR + + ENTRY + + PUSH P,[0] + MOVEI A,-11 +BINI1: HLRZ 0,AB + CAILE 0,-3 + JRST TFA + CAIG 0,(A) + JRST TMA + + GETYP 0,(AB) ; SHOULD BE UVEC OR STORE + CAIE 0,TSTORAGE + CAIN 0,TUVEC + JRST BINI2 + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTOK + JRST WTYP1 ; ELSE LOSE +BINI2: MOVE B,1(AB) ; GET IT + HLRE C,B + SUBI B,(C) ; POINT TO DOPE + GETYP A,(B) + PUSHJ P,SAT" ; GET ITS ST.ALOC.TYPE + CAIE A,S1WORD + JRST WTYP1 +BYTOK: GETYP 0,2(AB) + CAIE 0,TCHAN ; BETTER BE A CHANNEL + JRST WTYP2 + MOVE B,3(AB) ; GET IT +; MOVEI B,DIRECT-1(B) ; GET DIRECTION OF +; PUSHJ P,CHRWRD ; INTO 1 WORD +; JFCL +; MOVNI E,1 +; CAMN B,[ASCII /READB/] +; MOVEI E,0 +; CAMN B,[+1] + HRRZ A,-2(B) ; MODE BITS + TRNN A,C.BIN ; IF NOT BINARY + JRST WRONGD + MOVEI E,0 + TRNE A,C.PRIN + MOVE E,PBFL +; JUMPL E,WRONGD ; LOSER + CAME E,(P) ; CHECK WINNGE + JRST WRONGD + MOVE B,3(AB) ; GET CHANNEL BACK + SKIPN A,IOINS(B) ; OPEN? + PUSHJ P,OPENIT ; LOSE + CAMN A,[JRST CHNCLS] + JRST CHNCLS ; LOSE, CLOSED + JUMPN E,BUFOU1 ; JUMP FOR OUTPUT + MOVEI C,0 + CAML AB,[-5,,] ; SKIP IF EOF GIVEN + JRST BINI5 + MOVE 0,4(AB) + MOVEM 0,EOFCND-1(B) + MOVE 0,5(AB) + MOVEM 0,EOFCND(B) + CAML AB,[-7,,] + JRST BINI5 + GETYP 0,6(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,7(AB) +BINI5: SKIPE LSTCH(B) ; INDICATES IF EOF HIT + JRST BINEOF + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTI + MOVE A,1(AB) ; GET VECTOR + PUSHJ P,PGBIOI ; READ IT + HLRE C,A ; GET COUNT DONE + HLRE D,1(AB) ; AND FULL COUNT + SUB C,D ; C=> TOTAL READ + ADDM C,ACCESS(B) + JUMPGE A,BINIOK ; NOT EOF YET + SETOM LSTCH(B) +BINIOK: MOVE B,C + MOVSI A,TFIX ; RETURN AMOUNT ACTUALLY READ + JRST FINIS + +BYTI: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-LOST + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-LOST + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE STRING LENGTH + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 + PUSH P,C + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SIN] + PUSHJ P,PGBIOT + HLRE C,A ; GET COUNT DONE + POP P,D + SKIPN D + HRRZ D,(AB) ; AND FULL COUNT + ADD D,C ; C=> TOTAL READ + LDB E,[300600,,1(AB)] + MOVEI A,36. + IDIVM A,E + IDIVM D,E + ADDM E,ACCESS(B) + SKIPGE C ; NOT EOF YET + SETOM LSTCH(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-LOST + MOVE C,D + JRST BINIOK +] +BUFOU1: SKIPE BUFSTR(B) ; ANY BUFFERS AROUND? + PUSHJ P,BFCLS1 ; GET RID OF SAME + MOVEI C,0 + CAML AB,[-5,,] + JRST BINO5 + GETYP 0,4(AB) + CAIE 0,TFIX + JRST WTYP + MOVE C,5(AB) +BINO5: MOVE A,1(AB) + GETYP 0,(AB) ; BRANCH BASED ON BYTE SIZE + CAIE 0,TCHSTR + CAIN 0,TBYTE + JRST BYTO + PUSH P,C + PUSHJ P,PGBIOO + POP P,C + JUMPE C,.+3 + HLRE C,1(AB) + MOVNS C + ADDM C,ACCESS(B) +BYTO1: MOVE A,(AB) ; RET VECTOR ETC. + MOVE B,1(AB) + JRST FINIS + +BYTO: +IFE ITS,[ + MOVE A,1(B) + RFBSZ + FATAL RFBSZ-FAILURE + PUSH P,B + LDB B,[300600,,1(AB)] + SFBSZ + FATAL SFBSZ-FAILURE + MOVE B,3(AB) + HRRZ A,(AB) ; GET BYTE SIZE + MOVNS A + MOVSS A ; MAKE FUNNY BYTE POINTER + HRR A,1(AB) + ADDI A,1 ; COMPENSATE FOR PGBIOT DOING THE WRONG THING + HLL C,1(AB) ; GET START OF BPTR + MOVE D,[SOUT] + PUSHJ P,PGBIOT + LDB D,[300600,,1(AB)] + MOVEI C,36. + IDIVM C,D + HRRZ C,(AB) + IDIVI C,(D) + ADDM C,ACCESS(B) + MOVE A,1(B) + POP P,B + SFBSZ + FATAL SFBSZ-FAILURE + JRST BYTO1 +] + +BINEOF: PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOSER + MCALL 1,EVAL + JRST FINIS + +OPENIT: PUSH P,E + PUSHJ P,OPNCHN ;TRY TO OPEN THE LOSER + JUMPE B,CHNCLS ;FAIL + POP P,E + POPJ P, + ; THESE SUBROUTINES BY NDR 9/16/73 TO FACILITATE THE +; TYPES OF IO NECESSARY TO MAKE MORE EFFICIENT USE OF +; THE NETWORK AND DO RELATED FILE TRANSFER TYPE OF JOBS. + +R1CHAR: SKIPN A,LSTCH(B) ; CHAR READING ROUTINE FOR FCOPY + PUSHJ P,RXCT + TLO A,200000 ; ^@ BUG + MOVEM A,LSTCH(B) + TLZ A,200000 + JUMPL A,.+2 ; IN CASE OF -1 ON STY + TRZN A,400000 ; EXCL HACKER + JRST .+4 + MOVEM A,LSTCH(B) ; SAVE DE-EXCLED CHAR + MOVEI A,"! + JRST .+2 + SETZM LSTCH(B) + PUSH P,C + HRRZ C,DIRECT-1(B) + CAIE C,5 ; IF DIRECTION IS 5 LONG THEN READB + JRST R1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) ; EVERY FIFTY INCREMENT + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +R1CH1: AOS ACCESS(B) + POP P,C + POPJ P, + +W1CHAR: CAIE A,15 ; CHAR WRITING ROUTINE, TEST FOR CR + JRST .+3 + SETOM CHRPOS(B) + AOSA LINPOS(B) + CAIE A,12 ; TEST FOR LF + AOS CHRPOS(B) ; IF NOT LF AOS CHARACTE5R POSITION + CAIE A,14 ; TEST FOR FORM FEED + JRST .+3 + SETZM CHRPOS(B) ; IF FORM FEED ZERO CHARACTER POSITION + SETZM LINPOS(B) ; AND LINE POSITION + CAIE A,11 ; IS THIS A TAB? + JRST .+6 + MOVE C,CHRPOS(B) + ADDI C,7 + IDIVI C,8. + IMULI C,8. ; FIX UP CHAR POS FOR TAB + MOVEM C,CHRPOS(B) ; AND SAVE + PUSH P,C + HRRZ C,-2(B) ; GET BITS + TRNN C,C.BIN ; SIX LONG MUST BE PRINTB + JRST W1CH1 + AOS C,ACCESS-1(B) + CAMN C,[TFIX,,1] + AOS ACCESS(B) + CAMN C,[TFIX,,5] + HLLZS ACCESS-1(B) + JRST .+2 +W1CH1: AOS ACCESS(B) + PUSH P,A + PUSHJ P,WXCT + POP P,A + POP P,C + POPJ P, + +R1C: SUBM M,(P) ;LITTLE ENTRY FOR COMPILED STUFF +; PUSH TP,$TCHAN ;SAVE THE CHANNEL TO BLESS IT +; PUSH TP,B +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JFCL +; CAME B,[ASCIZ /READ/] +; CAMN B,[ASCII /READB/] +; JRST .+2 +; JRST BADCHN + HRRZ A,-2(B) ; GET MODE BITS + TRNN A,C.READ + JRST BADCHN + SKIPN IOINS(B) ; IS THE CHANNEL OPEN + PUSHJ P,OPENIT ; NO, GO DO IT + PUSHJ P,GRB ; MAKE SURE WE HAVE A READ BUFFER + PUSHJ P,R1CHAR ; AND GET HIM A CHARACTER + JRST MPOPJ ; THATS ALL FOLKS + +W1C: SUBM M,(P) + PUSHJ P,W1CI + JRST MPOPJ + +W1CI: +; PUSH TP,$TCHAN +; PUSH TP,B + PUSH P,A ; ASSEMBLER ENTRY TO OUTPUT 1 CHAR +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; INTERNAL CALL TO W1CHAR +; JFCL +; CAME B,[ASCII /PRINT/] +; CAMN B,[+1] +; JRST .+2 +; JRST BADCHN +; POP TP,B +; POP TP,(TP) + HRRZ A,-2(B) + TRNN A,C.PRIN + JRST BADCHN + SKIPN IOINS(B) ; MAKE SURE THAT IT IS OPEN + PUSHJ P,OPENIT + PUSHJ P,GWB + POP P,A ; GET THE CHAR TO DO + JRST W1CHAR + +; ROUTINES TO REPLACE XCT IOINS(B) FOR INPUT AND OUTPUT +; THEY DO THE XCT THEN CHECK OUT POSSIBLE SCRIPTAGE--BLECH. + + +WXCT: +RXCT: XCT IOINS(B) ; READ IT + SKIPN SCRPTO(B) + POPJ P, + +DOSCPT: PUSH TP,$TCHAN + PUSH TP,B + PUSH P,A ; AND SAVE THE CHAR AROUND + + SKIPN SCRPTO(B) ; IF ZERO FORGET IT + JRST SCPTDN ; THATS ALL THERE IS TO IT + PUSH P,C ; SAVE AN ACCUMULATOR FOR CLEANLINESS + GETYP C,SCRPTO-1(B) ; IS IT A LIST + CAIE C,TLIST + JRST BADCHN + PUSH TP,$TLIST + PUSH TP,[0] ; SAVE A SLOT FOR THE LIST + MOVE C,SCRPTO(B) ; GET THE LIST OF SCRIPT CHANNELS +SCPT1: GETYP B,(C) ; GET THE TYPE OF THIS SCRIPT CHAN + CAIE B,TCHAN + JRST BADCHN ; IF IT ISN'T A CHANNEL, COMPLAIN + HRRZ B,(C) ; GET THE REST OF THE LIST IN B + MOVEM B,(TP) ; AND STORE ON STACK + MOVE B,1(C) ; GET THE CHANNEL IN B + MOVE A,-1(P) ; AND THE CHARACTER IN A + PUSHJ P,W1CI ; GO TO INTERNAL W1C, IT BLESSES GOODIES + SKIPE C,(TP) ; GET THE REST OF LIST OF CHANS + JRST SCPT1 ; AND CYCLE THROUGH + SUB TP,[2,,2] ; CLEAN OFF THE LIST OF CHANS + POP P,C ; AND RESTORE ACCUMULATOR C +SCPTDN: POP P,A ; RESTORE THE CHARACTER + POP TP,B ; AND THE ORIGINAL CHANNEL + POP TP,(TP) + POPJ P, ; AND THATS ALL + + +; SUBROUTINE TO COPY FROM INCHAN TO OUTCHAN UNTIL EOF HIT +; ON THE INPUT CHANNEL +; CALL IS WHERE DEFAULTS ARE INCHAN AND OUTCHAN + + MFUNCTION FCOPY,SUBR,[FILECOPY] + + ENTRY + HLRE 0,AB + CAMGE 0,[-4] + JRST WNA ; TAKES FROM 0 TO 2 ARGS + + JUMPE 0,.+4 ; NO FIRST ARG? + PUSH TP,(AB) + PUSH TP,1(AB) ; SAVE IN CHAN + JRST .+6 + MOVE A,$TATOM + MOVE B,IMQUOTE INCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B + HLRE 0,AB ; CHECK FOR SECOND ARG + CAML 0,[-2] ; WAS THERE MORE THAN ONE ARG? + JRST .+4 + PUSH TP,2(AB) ; SAVE SECOND ARG + PUSH TP,3(AB) + JRST .+6 + MOVE A,$TATOM ; LOOK UP OUTCHAN AS DEFAULT + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + PUSH TP,A + PUSH TP,B ; AND SAVE IT + + MOVE A,-3(TP) + MOVE B,-2(TP) ; INPUT CHANNEL + MOVEI 0,C.READ ; INDICATE INPUT + PUSHJ P,CHKCHN ; CHECK FOR GOOD CHANNEL + MOVE A,-1(TP) + MOVE B,(TP) ; GET OUT CHAN + MOVEI 0,C.PRIN ; INDICATE OUT CHAN + PUSHJ P,CHKCHN ; CHECK FOR GOOD OUT CHAN + + PUSH P,[0] ; COUNT OF CHARS OUTPUT + + MOVE B,-2(TP) + PUSHJ P,GRB ; MAKE SURE WE HAVE READ BUFF + MOVE B,(TP) + PUSHJ P,GWB ; MAKE SURE WE HAVE WRITE BUFF + +FCLOOP: INTGO + MOVE B,-2(TP) + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,FCDON ; IF A NEG NUMBER WE GOT EOF + MOVE B,(TP) ; GET OUT CHAN + PUSHJ P,W1CHAR ; SPIT IT OUT + AOS (P) ; INCREMENT COUNT + JRST FCLOOP + +FCDON: SUB TP,[2,,2] ; POP OFF OUTCHAN + MCALL 1,FCLOSE ; CLOSE INCHAN + MOVE A,$TFIX + POP P,B ; GET CHAR COUNT TO RETURN + JRST FINIS + +CHKCHN: PUSH P,0 ; CHECK FOR GOOD TASTING CHANNEL + PUSH TP,A + PUSH TP,B + GETYP C,A + CAIE C,TCHAN + JRST CHKBDC ; GO COMPLAIN IN RIGHT WAY +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD +; JRST CHKBDC +; MOVE C,(P) ; GET CHAN DIRECT + HRRZ C,-2(B) ; MODE BITS + TDNN C,0 + JRST CHKBDC +; CAMN B,CHKT(C) +; JRST .+4 +; ADDI C,2 ; TEST FOR READB OR PRINTB ALSO +; CAME B,CHKT(C) ; TEST FOR CORRECT DIRECT +; JRST CHKBDC + MOVE B,(TP) + SKIPN IOINS(B) ; MAKE SURE IT IS OPEN + PUSHJ P,OPENIT ; IF ZERO IOINS GO OPEN IT + SUB TP,[2,,2] + POP P, ; CLEAN UP STACKS + POPJ P, + +CHKT: ASCIZ /READ/ + ASCII /PRINT/ + ASCII /READB/ + +1 + +CHKBDC: POP P,E + MOVNI D,2 + IMULI D,1(E) + HLRE 0,AB + CAMLE 0,D ; SEE IF THIS WAS HIS ARG OF DEFAULT + JRST BADCHN + JUMPE E,WTYP1 + JRST WTYP2 + + ; FUNCTIONS READSTRING AND PRINTSTRING WORK LIKE READB AND PRINTB, +; THAT IS THEY READ INTO AND OUT OF STRINGS. IN ADDITION BOTH ACCEPT +; AN ADDITIONAL ARGUMENT WHICH IS THE NUMBER OF CHARS TO READ OR PRINT, IF +; IT IS DESIRED FOR THIS TO BE DIFFERENT THAN THE LENGTH OF THE STRING. + +; FORMAT IS +; AND BOTH SUBRS RETURN THE NUMBER OF CHARS READ OR WRITTEN + +; FORMAT FOR PRINTSTRING IS + +; THESE WERE CODED 9/16/73 BY NEAL D. RYAN + + MFUNCTION RSTRNG,SUBR,READSTRING + + ENTRY + PUSH P,[0] ; FLAG TO INDICATE READING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-9] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 4 ARGS + JRST STRIO1 + + MFUNCTION PSTRNG,SUBR,PRINTSTRING + + ENTRY + PUSH P,[1] ; FLAG TO INDICATE WRITING + HLRE 0,AB + CAMG 0,[-1] + CAMG 0,[-7] + JRST WNA ; CHECK THAT IT HAS FROM 1 TO 3 ARGS + +STRIO1: PUSH TP,[0] ; SAVE SLOT ON STACK + PUSH TP,[0] + GETYP 0,(AB) + CAIE 0,TCHSTR ; MAKE SURE WE GOT STRING + JRST WTYP1 + HRRZ 0,(AB) ; CHECK FOR EMPTY STRING + SKIPN (P) + JUMPE 0,MTSTRN + HLRE 0,AB + CAML 0,[-2] ; WAS A CHANNEL GIVEN + JRST STRIO2 + GETYP 0,2(AB) + SKIPN (P) ; SKIP IF PRINT + JRST TESTIN + CAIN 0,TTP ; SEE IF FLATSIZE HACK + JRST STRIO9 +TESTIN: CAIE 0,TCHAN + JRST WTYP2 ; SECOND ARG NOT CHANNEL + MOVE B,3(AB) + HRRZ B,-2(B) + MOVNI E,1 ; CHECKING FOR GOOD DIRECTION + TRNE B,C.READ ; SKIP IF NOT READ + MOVEI E,0 + TRNE B,C.PRIN ; SKIP IF NOT PRINT + MOVEI E,1 + CAME E,(P) + JRST WRONGD ; MAKE SURE CHANNEL IS OPEN IN RIGHT MODE +STRIO9: PUSH TP,2(AB) + PUSH TP,3(AB) ; PUSH ON CHANNEL + JRST STRIO3 +STRIO2: MOVE B,IMQUOTE INCHAN + MOVSI A,TCHAN + SKIPE (P) + MOVE B,IMQUOTE OUTCHAN + PUSHJ P,IDVAL + GETYP 0,A + SKIPN (P) ; SKIP IF PRINTSTRING + JRST TESTI2 + CAIN 0,TTP ; SKIP IF NOT FLATSIZE HACK + JRST STRIO8 +TESTI2: CAIE 0,TCHAN + JRST BADCHN ; MAKE SURE WE GOT A GOOD DEFAULT CHANNEL +STRIO8: PUSH TP,A + PUSH TP,B +STRIO3: MOVE B,(TP) ; GET CHANNEL + SKIPN E,IOINS(B) + PUSHJ P,OPENIT ; IF NOT GO OPEN + MOVE E,IOINS(B) + CAMN E,[JRST CHNCLS] + JRST CHNCLS ; CHECK TO SEE THAT CHANNEL ISNT ALREADY CLOSED +STRIO4: HLRE 0,AB + CAML 0,[-4] + JRST STRIO5 ; NO COUNT TO WORRY ABOUT + GETYP 0,4(AB) + MOVE E,4(AB) + MOVE C,5(AB) + CAIE 0,TCHSTR + CAIN 0,TFIX ; BETTER BE A FIXED NUMBER + JRST .+2 + JRST WTYP3 + HRRZ D,(AB) ; GET ACTUAL STRING LENGTH + CAIN 0,TFIX + JRST .+7 + SKIPE (P) ; TEST FOR WRITING + JRST .-7 ; IF WRITING WE GOT TROUBLE + PUSH P,D ; ACTUAL STRING LENGTH + MOVEM E,(TB) ; STUFF HIS FUNNY DELIM STRING + MOVEM C,1(TB) + JRST STRIO7 + CAML D,C ; MAKE SURE THE STRING IS LONG ENOUGH + JRST .+2 ; WIN + ERRUUO EQUOTE COUNT-GREATER-THAN-STRING-SIZE + PUSH P,C ; PUSH ON MAX COUNT + JRST STRIO7 +STRIO5: +STRIO6: HRRZ C,(AB) ; GET CHAR COUNT + PUSH P,C ; AND PUSH IT ON STACK AS NO MAX COUNT GIVEN +STRIO7: HLRE 0,AB + CAML 0,[-6] + JRST .+6 + MOVE B,(TP) ; GET THE CHANNEL + MOVE 0,6(AB) + MOVEM 0,EOFCND-1(B) ; STUFF IN SLOT IN CHAN + MOVE 0,7(AB) + MOVEM 0,EOFCND(B) + PUSH TP,(AB) ; PUSH ON STRING + PUSH TP,1(AB) + PUSH P,[0] ; PUSH ON CURRENT COUNT OF CHARS DONE + MOVE 0,-2(P) ; GET READ OR WRITE FLAG + JUMPN 0,OUTLOP ; GO WRITE STUFF + + MOVE B,-2(TP) ; GET CHANNEL + PUSHJ P,GRB ; MAKE SURE WE HAVE BUFF + SKIPGE A,LSTCH(B) ; CHECK FOR EOF ALREADY READ PREVIOUSLY + JRST SRDOEF ; GO DOES HIS EOF HACKING +INLOP: INTGO + MOVE B,-2(TP) ; GET CHANNEL + MOVE C,-1(P) ; MAX COUNT + CAMG C,(P) ; COMPARE WITH COUNT DONE + JRST STREOF ; WE HAVE FINISHED + PUSHJ P,R1CHAR ; GET A CHAR + JUMPL A,INEOF ; EOF HIT + MOVE C,1(TB) + HRRZ E,(TB) ; DO WE HAVE A STRING TO WORRY US? + SOJL E,INLNT ; GO FINISH STUFFING + ILDB D,C + CAME D,A + JRST .-3 + JRST INEOF +INLNT: IDPB A,(TP) ; STUFF IN STRING + SOS -1(TP) ; DECREMENT STRING COUNT + AOS (P) ; INCREMENT CHAR COUNT + JRST INLOP + +INEOF: SKIPE C,LSTCH(B) ; IS THIS AN ! AND IS THERE A CHAR THERE + JRST .+3 ; YES + MOVEM A,LSTCH(B) ; NO SAVE THE CHAR + JRST .+3 + ADDI C,400000 + MOVEM C,LSTCH(B) + MOVSI C,200000 + IORM C,LSTCH(B) + HRRZ C,DIRECT-1(B) ; GET THE TYPE OF CHAN + CAIN C,5 ; IS IT READB? + JRST .+3 + SOS ACCESS(B) ; FIX UP ACCESS FOR READ CHANNEL + JRST STREOF ; AND THATS IT + HRRZ C,ACCESS-1(B) ; FOR A READB ITS WORSE + MOVEI D,5 + SKIPG C + HRRM D,ACCESS-1(B) ; CHANGE A 0 TO A FIVE + SOS C,ACCESS-1(B) + CAMN C,[TFIX,,0] + SOS ACCESS(B) ; AND SOS THE WORD COUNT MAYBE + JRST STREOF + +SRDOEF: SETZM LSTCH(B) ; IN CASE OF -1, FLUSH IT + AOJE A,INLOP ; SKIP OVER -1 ON PTY'S + SUB TP,[6,,6] + SUB P,[3,,3] ; POP JUNK OFF STACKS + PUSH TP,EOFCND-1(B) + PUSH TP,EOFCND(B) ; WHAT WE NEED TO EVAL + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE ; CLOSE THE LOOSING CHANNEL + MCALL 1,EVAL ; EVAL HIS EOF JUNK + JRST FINIS + +OUTLOP: MOVE B,-2(TP) +OUTLP1: INTGO + MOVE A,-3(TP) ; GET CHANNEL + MOVE B,-2(TP) + MOVE C,-1(P) ; MAX COUNT TO DO + CAMG C,(P) ; HAVE WE DONE ENOUGH + JRST STREOF + ILDB D,(TP) ; GET THE CHAR + SOS -1(TP) ; SUBTRACT FROM STRING LENGTH + AOS (P) ; INC COUNT OF CHARS DONE + PUSHJ P,CPCH1 ; GO STUFF CHAR + JRST OUTLP1 + +STREOF: MOVE A,$TFIX + POP P,B ; RETURN THE LOOSER A COUNT OF WHAT WAS DONE + SUB P,[2,,2] + SUB TP,[6,,6] + JRST FINIS + + +GWB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A WRITE BUFFER ON PRINTB CHAN + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVSI A,TWORD+.VECT. + MOVEM A,BUFLNT(B) + SETOM (B) + MOVEI C,1(B) + HRLI C,(B) + BLT C,BUFLNT-1(B) + MOVEI C,-1(B) + HRLI C,010700 + MOVE B,(TP) + MOVEI 0,C.BUF + IORM 0,-2(B) + MOVEM C,BUFSTR(B) + MOVE C,[TCHSTR,,BUFLNT*5] + MOVEM C,BUFSTR-1(B) + SUB TP,[2,,2] + POPJ P, + + +GRB: SKIPE BUFSTR(B) + POPJ P, + PUSH TP,$TCHAN + PUSH TP,B ; GET US A READ BUFFER + MOVEI A,BUFLNT + PUSHJ P,IBLOCK + MOVEI C,BUFLNT-1(B) + POP TP,B + MOVEI 0,C.BUF + IORM 0,-2(B) + HRLI C,010700 + MOVEM C,BUFSTR(B) + MOVSI C,TCHSTR + MOVEM C,BUFSTR-1(B) + SUB TP,[1,,1] + POPJ P, + +MTSTRN: ERRUUO EQUOTE EMPTY-STRING + + ; INPUT UNBUFFERING ROUTINE. THIS DOES THE CHARACTER UNBUFFERING +; FOR INPUT. THE OPEN ROUTINE SETUPS A PUSHJ P, TO +; THIS ROUTINE AS THE IOINS FOR A CHANNEL OPEN TO A NON-TTY DEVICE. + +; H. BRODIE 7/19/72 + +; CALLING SEQ: +; PUSHJ P,GETCHR +; B/ AOBJN PNTR TO CHANNEL VECTOR +; RETURNS NEXT CHARACTER IN AC A. +; ON ENCOUNTERING EITHER ^C OR NUL(^@) IT ASSUMES EOF AND +; TRANSMITS ONLY ^C ON SUCCESSIVE CALLS + + +GETCHR: +; FIRST GRAB THE BUFFER +; GETYP A,BUFSTR-1(B) ; GET TYPE WORD +; CAIN A,TCHSTR ; SKIPS IF NOT CHSTR (I.E. IF BAD BUFFER) +; JRST GTGBUF ; IS GOOD BUFFER...SKIP ERROR RETURN +GTGBUF: HRRZ A,BUFSTR-1(B) ; GET LENGTH OF STRING + SOJGE A,GTGCHR ; JUMP IF STILL MORE + +; HERE IF THE BUFFER WAS EXHAUSTED (BYTE PNTR POINTS INTO DOPE WDS) +; GENERATE AN .IOT POINTER +;FIRST SAVE C AND D AS I WILL CLOBBER THEM +NEWBUF: PUSH P,C + PUSH P,D +IFN ITS,[ + LDB C,[600,,STATUS(B)] ; GET TYPE + CAIG C,2 ; SKIP IF NOT TTY +] +IFE ITS,[ + SKIPE BUFRIN(B) +] + JRST GETTTY ; GET A TTY BUFFER + + PUSHJ P,PGBUFI ; RE-FILL BUFFER + +IFE ITS, MOVEI C,-1 + JUMPGE A,BUFGOO ;SKIPS IF IOT COMPLETED...FIX UP CHANNEL +IFN ITS,[ + MOVEI C,1 ; MAKE SURE LAST EOF REALLY ENDS IT + ANDCAM C,-1(A) +] + MOVSI C,014000 ; GET A ^C + MOVEM C,(A) ;FAKE AN EOF + +IFE ITS,[ + HLRE C,A ; HOW MUCH LEFT + ADDI C,BUFLNT ; # OF WORDS TO C + IMULI C,5 ; TO CHARS + PUSH P,0 + MOVEI 0,1 + SKIPE C + ANDCAM 0,-1(1) + POP P,0 + MOVE A,-2(B) ; GET BITS + TRNE A,C.BIN ; CAN'T HELP A BINARY CHANNEL + JRST BUFGOO + MOVE A,CHANNO(B) + PUSH P,B + PUSH P,D + PUSH P,C + PUSH P,[0] + PUSH P,[0] + MOVEI C,-1(P) + MOVE B,[2,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,-1(P)] ; GET BYTE SIZE + MOVE B,(P) + SUB P,[2,,2] + POP P,C + CAIE D,7 ; SEVEN BIT BYTES? + JRST BUFGO1 ; NO, DONT HACK + MOVE D,C + IDIVI B,5 ; C IS NUMBER IN LAST WORD IF NOT EVEN + SKIPN C + MOVEI C,5 + ADDI C,-5(D) ; FIXUP C FOR WINNAGE +BUFGO1: POP P,D + POP P,B +] +; RESET THE BYTE POINTER IN THE CHANNEL. +; BUILD ONE USING THE PTR TO BEG OF BUFFER SAVED IN D +BUFGOO: HRLI D,010700 ; GENERATE VIRGIN LH + SUBI D,1 + + MOVEM D,BUFSTR(B) ; STASH IN THE BUFFER BYTE PNTR SLOT +IFE ITS, HRRM C,LSTCH-1(B) ; SAVE IT + MOVEI A,BUFLNT*5-1 +BUFROK: POP P,D ;RESTORE D + POP P,C ;RESTORE C + + +; HERE IF THERE ARE CHARS IN BUFFER +GTGCHR: HRRM A,BUFSTR-1(B) + ILDB A,BUFSTR(B) ; GET A CHAR FROM BUFFER + +IFN ITS,[ + CAIE A,3 ; EOF? + POPJ P, ; AND RETURN + LDB A,[600,,STATUS(B)] ; CHECK FOR TTY + CAILE A,2 ; SKIP IF TTY +] +IFE ITS,[ + PUSH P,0 + HRRZ 0,LSTCH-1(B) + SOJL 0,.+4 + HRRM 0,LSTCH-1(B) + POP P,0 + POPJ P, + + POP P,0 + MOVSI A,-1 + SKIPN BUFRIN(B) +] + JRST .+3 +RETEO1: HRRI A,3 + POPJ P, + + HRRZ A,BUFSTR(B) ; SEE IF RSUBR START BIT IS ON + HRRZ A,(A) + TRNN A,1 + MOVSI A,-1 + JRST RETEO1 + +IFN ITS,[ +PGBUFO: +PGBUFI: +] +IFE ITS,[ +PGBUFO: SKIPA D,[SOUT] +PGBUFI: MOVE D,[SIN] +] + SKIPGE A,BUFSTR(B) ; POINT TO CURRENT BUFFER POSIT + SUBI A,1 ; FOR 440700 AND 010700 START + SUBI A,BUFLNT-1 ; CALCULATE PNTR TO BEG OF BUFFER + HRLI A,-BUFLNT ; IOT (AOBJN) PNTR IN A + MOVSI C,004400 +IFN ITS,[ +PGBIOO: +PGBIOI: MOVE D,A ; COPY FOR LATER + MOVSI C,TUVEC ; PREPARE TO HANDDLE INTS + MOVE PVP,PVSTOR+1 + MOVEM C,DSTO(PVP) + MOVEM C,ASTO(PVP) + MOVSI C,TCHAN + MOVEM C,BSTO(PVP) + +; BUILD .IOT INSTR + MOVE C,CHANNO(B) ; CHANNEL NUMBER IN C + ROT C,23. ; MOVE INTO AC FIELD + IOR C,[.IOT 0,A] ; IOR IN SKELETON .IOT + +; DO THE .IOT + ENABLE ; ALLOW INTS + XCT C ; EXECUTE THE .IOT INSTR + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM ASTO(PVP) + SETZM DSTO(PVP) + POPJ P, +] + +IFE ITS,[ +PGBIOT: PUSH P,D + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,C + HRRZS (P) + HRRI C,-1(A) ; POINT TO BUFFER + HLRE D,A ; XTRA POINTER + MOVNS D + HRLI D,TCHSTR + MOVE PVP,PVSTOR+1 + MOVEM D,BSTO(PVP) + MOVE D,[PUSHJ P,FIXACS] + MOVEM D,ONINT + MOVSI D,TUVEC + MOVEM D,DSTO(PVP) + MOVE D,A + MOVE A,CHANNO(B) ; FILE JFN + MOVE B,C + HLRE C,D ; - COUNT TO C + SKIPE (P) + MOVN C,(P) ; REAL DESIRED COUNT + SUB P,[1,,1] + ENABLE + XCT (P) ; DO IT TO IT + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) + SETZM DSTO(PVP) + SETZM ONINT + MOVEI A,1(B) + MOVE B,(TP) + SUB TP,[2,,2] + SUB P,[1,,1] + JUMPGE C,CPOPJ ; NO EOF YET + HRLI A,(C) ; LOOK LIKE AN AOBJN PNTR + POPJ P, + +FIXACS: PUSH P,PVP + MOVE PVP,PVSTOR+1 + MOVNS C + HRRM C,BSTO(PVP) + MOVNS C + POP P,PVP + POPJ P, + +PGBIOO: SKIPA D,[SOUT] +PGBIOI: MOVE D,[SIN] + HRLI C,004400 + JRST PGBIOT +DOIOTO: PUSH P,[SOUT] +DOIOTC: PUSH P,B + PUSH P,C + EXCH A,B + MOVE A,CHANNO(A) + HLRE C,B + HRLI B,444400 + XCT -2(P) + HRL B,C + MOVE A,B +DOIOTE: POP P,C + POP P,B + SUB P,[1,,1] + POPJ P, +DOIOTI: PUSH P,[SIN] + JRST DOIOTC +] + +; OUTPUT BUFFERING ROUTINES SIMILAR TO INPUT BUFFERING ROUTINES OF PREV PAGE + +PUTCHR: PUSH P,A + GETYP A,BUFSTR-1(B) ; CHECK TYPE OF ARG + CAIE A,TCHSTR ; MUST BE STRING + JRST BDCHAN + + HRRZ A,BUFSTR-1(B) ; GET CHAR COUNT + JUMPE A,REBUFF ; PREV RESET BUFF, UNDO SAME + +PUTCH1: POP P,A ; RESTORE CHAR + CAMN A,[-1] ; SPECIAL HACK? + JRST PUTCH2 ; YES GO HANDLE + IDPB A,BUFSTR(B) ; STUFF IT +PUTCH3: SOS A,BUFSTR-1(B) ; COUNT DOWN STRING + TRNE A,-1 ; SKIP IF FULL + POPJ P, + +; HERE TO FLUSH OUT A BUFFER + + PUSH P,C + PUSH P,D + PUSHJ P,PGBUFO ; SETUP AND DO IOT + HRLI D,010700 ; POINT INTO BUFFER + SUBI D,1 + MOVEM D,BUFSTR(B) ; STORE IT + MOVEI A,BUFLNT*5 ; RESET COUNT + HRRM A,BUFSTR-1(B) + POP P,D + POP P,C + POPJ P, + +;HERE TO DA ^C AND TURN ON MAGIC BIT + +PUTCH2: MOVEI A,3 + IDPB A,BUFSTR(B) ; ZAP OUT THE ^C + MOVEI A,1 ; GET BIT +IFE ITS,[ + PUSH P,C + HRRZ C,BUFSTR(B) + IORM A,(C) + POP P,C +] +IFN ITS,[ + IORM A,@BUFSTR(B) ; ON GOES THE BIT +] + JRST PUTCH3 + +; RESET A FUNNY BUF + +REBUFF: MOVEI A,BUFLNT*5 ; 1ST COUNT + HRRM A,BUFSTR-1(B) + HRRZ A,BUFSTR(B) ; NOW POINTER + SUBI A,BUFLNT+1 + HRLI A,010700 + MOVEM A,BUFSTR(B) ; STORE BACK + JRST PUTCH1 + + +; HERE TO FLUSH FINAL BUFFER + +BFCLOS: HRRZ C,-2(B) ; THIS BUFFER FLUSHER THE WORK OF NDR + MOVEI A,0 + TRNE C,C.TTY + POPJ P, + TRNE C,C.DISK + MOVEI A,1 + PUSH P,A ; SAVE THE RESULT OF OUR TEST + JUMPN A,BFCLNN ; DONT HAVE TO CHECK NET STATE + PUSH TP,$TCHAN + PUSH TP,B ; SAVE CHANNEL + PUSHJ P,INSTAT ; GET CURRENT NETWORK STATE + MOVE A,(B) ; GET FIRST ELEMENT OF STATE UVECTOR WHICH IS CUR STATE + POP TP,B ; RESTORE B + POP TP, + CAIE A,5 ; IS NET IN OPEN STATE? + CAIN A,6 ; OR ELSE IS IT IN RFNM WAIT STATE + JRST BFCLNN ; IF SO TO THE IOT + POP P, ; ELSE FLUSH CRUFT AND DONT IOT + POPJ P, ; RETURN DOING NO IOT +BFCLNN: MOVEI C,BUFLNT*5 ; NEW BUFFER FLUSHER BY NDR + HRRZ D,BUFSTR-1(B) ; SO THAT NET ALSO WORKS RIGHT + SUBI C,(D) ; GET NUMBER OF CHARS + IDIVI C,5 ; NUMBER OF FULL WORDS AND REST + PUSH P,D ; SAVE NUMBER OF ODD CHARS + SKIPGE A,BUFSTR(B) ; GET CURRENT BUF POSITION + SUBI A,1 ; FIX FOR 440700 BYTE POINTER +IFE ITS,[ + HRRO D,A + PUSH P,(D) +] +IFN ITS,[ + PUSH P,(A) ; SAVE THE ODD WORD OF BUFFER +] + MOVEI D,BUFLNT + SUBI D,(C) + SKIPE -1(P) + SUBI A,1 + ADDI D,1(A) ; FIX UP FOR POSSIBLE ODD CHARS + PUSH TP,$TUVEC + PUSH TP,D ; PUSH THE DOPE VECTOR ONTO THE STACK + JUMPE C,BFCLSR ; IN CASE THERE ARE NO FULL WORDS TO DO + HRL A,C + TLO A,400000 + MOVE E,[SETZ BUFLNT(A)] + SUBI E,(C) ; FIX UP FOR BACKWARDS BLT + POP A,@E ; AMAZING GRACE + TLNE A,377777 + JRST .-2 + HRRO A,D ; SET UP AOBJN POINTER + SUBI A,(C) + TLC A,-1(C) + PUSHJ P,PGBIOO ; DO THE IOT OF ALL THE FULL WORDS +BFCLSR: HRRO A,(TP) ; GET IOT PTR FOR REST OF JUNK + SUBI A,1 ; POINT TO WORD BEFORE DOPE WORDS + POP P,0 ; GET BACK ODD WORD + POP P,C ; GET BACK ODD CHAR COUNT + POP P,D ; FLAG FOR NET OR DSK + JUMPN D,BFCDSK ; GO FINISH OFF DSK + JUMPE C,BFCLSD ; IF NO ODD CHARS FINISH UP + MOVEI D,7 + IMULI D,(C) ; FIND NO OF BITS TO SHIFT + LSH 0,-43(D) ; SHIFT BITS TO RIGHT PLACE + MOVEM 0,(A) ; STORE IN STRING + SUBI C,5 ; HOW MANY CHAR POSITIONS TO SKIP + MOVNI C,(C) ; MAKE C POSITIVE + LSH C,17 + TLC A,(C) ; MUNG THE AOBJN POINTER TO KLUDGE + PUSHJ P,PGBIOO ; DO IOT OF ODD CHARS + MOVEI C,0 +BFCLSD: HRRZ A,(TP) ; GET PTR TO DOPE WORD + SUBI A,BUFLNT+1 + JUMPLE C,.+3 + SKIPE ACCESS(B) + MOVEM 0,1(A) ; LAST WORD BACK IN BFR + HRLI A,010700 ; AOBJN POINTER TO FIRST OF BUFFER + MOVEM A,BUFSTR(B) + MOVEI A,BUFLNT*5 + HRRM A,BUFSTR-1(B) + SKIPN ACCESS(B) + JRST BFCLSY + JUMPL C,BFCLSY + JUMPE C,BFCLSZ + IBP BUFSTR(B) + SOS BUFSTR-1(B) + SOJG C,.-2 +BFCLSY: MOVE A,CHANNO(B) + MOVE C,B +IFE ITS,[ + RFPTR + FATAL RFPTR FAILED + HRRZ F,LSTCH-1(C) ; PREVIOUS HIGH + MOVE G,C ; SAVE CHANNEL + MOVE C,B + CAML F,B + MOVE C,F + MOVE F,B + HRLI A,400000 + CLOSF + JFCL + MOVNI B,1 + HRLI A,12 + CHFDB + MOVE B,STATUS(G) + ANDI A,-1 + OPENF + FATAL OPENF LOSES + MOVE C,F + IDIVI C,5 + MOVE B,C + SFPTR + FATAL SFPTR FAILED + MOVE B,G +] +IFN ITS,[ + DOTCAL RFPNTR,[A,[2000,,B]] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + SUBI B,1 + DOTCAL ACCESS,[A,B] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS + MOVE B,C +] +BFCLSZ: SUB TP,[2,,2] + POPJ P, + +BFCDSK: TRZ 0,1 + PUSH P,C +IFE ITS,[ + PUSH TP,$TCHAN + PUSH TP,B + PUSH P,0 ; WORD OF CHARS + MOVE A,CHANNO(B) + MOVEI B,7 ; MAKE BYTE SIZE 7 + SFBSZ + JFCL + HRROI B,(P) + MOVNS C + SKIPE C + SOUT + MOVE B,(TP) + SUB P,[1,,1] + SUB TP,[2,,2] +] +IFN ITS,[ + MOVE D,[440700,,A] + DOTCAL SIOT,[CHANNO(B),D,C] + .LOSE %LSFIL ;PRESUMABLY LOSSAGE MATTERS +] + POP P,C + JUMPN C,BFCLSD +BFCDS1: MOVNI C,1 ; INDICATE NOT TOHACK BUFFER + JRST BFCLSD + +BFCLS1: HRRZ C,DIRECT-1(B) + MOVSI 0,(JFCL) + CAIE C,6 + MOVE 0,[AOS ACCESS(B)] + PUSH P,0 + HRRZ C,BUFSTR-1(B) + IDIVI C,5 + JUMPE D,BCLS11 + MOVEI A,40 ; PAD WITH SPACES + PUSHJ P,PUTCHR + XCT (P) ; AOS ACCESS IF NECESSARY + SOJG D,.-3 ; TO END OF WORD +BCLS11: POP P,0 + HLLZS ACCESS-1(B) + HRRZ C,BUFSTR-1(B) + CAIE C,BUFLNT*5 + PUSHJ P,BFCLOS + POPJ P, + + +; HERE TO GET A TTY BUFFER + +GETTTY: SKIPN C,EXBUFR(B) ; SKIP IF BUFFERS BACKED UP + JRST TTYWAI + HRRZ D,(C) ; CDR THE LIST + GETYP A,(C) ; CHECK TYPE + CAIE A,TDEFER ; MUST BE DEFERRED + JRST BDCHAN + MOVE C,1(C) ; GET DEFERRED GOODIE + GETYP A,(C) ; BETTER BE CHSTR + CAIE A,TCHSTR + JRST BDCHAN + MOVE A,(C) ; GET FULL TYPE WORD + MOVE C,1(C) + MOVEM D,EXBUFR(B) ; STORE CDR'D LIST + MOVEM A,BUFSTR-1(B) ; MAKE CURRENT BUFFER + MOVEM C,BUFSTR(B) + HRRM A,LSTCH-1(B) + SOJA A,BUFROK + +TTYWAI: PUSHJ P,TTYBLK ; BLOCKED FOR TTY I/O + JRST GETTTY ; SHOULD ONLY RETURN HAPPILY + + ;INTERNAL DEVICE READ ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT, +;CHECKS THAT THE RETURNED VALUE IS OF TYPE CHARACTER, +;AND RETURNS THAT AS THE NEXT CHARACTER IN THE "FILE" + +;H. BRODIE 8/31/72 + +GTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,INTFCN-1(B) + GETYP A,A + CAIE A,TCHRS + JRST BADRET + MOVE A,B +INTRET: POP P,0 ;RESTORE THE ACS + POP P,E + POP P,D + POP P,C + POP TP,B ;RESTORE THE CHANNEL + SUB TP,[1,,1] ;FLUSH $TCHAN...WE DON'T NEED IT + POPJ P, + + +BADRET: ERRUUO EQUOTE INT-DEVICE-WRONG-TYPE-EVALUATION-RESULT + +;INTERNAL DEVICE PRINT ROUTINE. + +;FOR INTERNAL DEVICES THIS ROUTINE APPLIES THE GIVEN OBJECT,(FUNCTION, SUBR, OR RSUBR) +;TO THE CURRENT CHARACTER BEING "PRINTED". + +PTINTC: PUSH TP,$TCHAN ;SAVE THE CHANNEL...WE'LL CLOBBER B + PUSH TP,B + PUSH P,C ;AND SAVE THE OTHER ACS + PUSH P,D + PUSH P,E + PUSH P,0 + PUSH TP,$TCHRS ;PUSH THE TYPE "CHARACTER" + PUSH TP,A ;PUSH THE CHAR + PUSH TP,$TCHAN ;PUSH THE CHANNEL + PUSH TP,B + MCALL 2,INTFCN-1(B) ;APPLY THE FUNCTION TO THE CHAR + JRST INTRET + + + +; ROUTINE TO FLUSH OUT A PRINT BUFFER + +MFUNCTION BUFOUT,SUBR + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + + MOVE B,1(AB) +; MOVEI B,DIRECT-1(B) +; PUSHJ P,CHRWRD ; GET DIR NAME +; JFCL +; CAMN B,[ASCII /PRINT/] +; JRST .+3 +; CAME B,[+1] +; JRST WRONGD +; TRNE B,1 ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN B,1 ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] + HRRZ 0,-2(B) + TRNN 0,C.PRIN + JRST WRONGD +; TRNE 0,C.BIN ; SKIP IF PRINT +; PUSH P,[JFCL] +; TRNN 0,C.BIN ; SKIP IF PRINTB +; PUSH P,[AOS ACCESS(B)] +; MOVE B,1(AB) +; GETYP 0,BUFSTR-1(B) +; CAIN 0,TCHSTR +; SKIPN A,BUFSTR(B) ; BYTE POINTER? +; JRST BFIN1 +; HRRZ C,BUFSTR-1(B) ; CHARS LEFT +; IDIVI C,5 ; MULTIPLE OF 5? +; JUMPE D,BFIN2 ; YUP NO EXTRAS + +; MOVEI A,40 ; PAD WITH SPACES +; PUSHJ P,PUTCHR ; OUT IT GOES +; XCT (P) ; MAYBE BUMP ACCESS +; SOJG D,.-3 ; FILL + +BFIN2: PUSHJ P,BFCLOS ; WRITE OUT BUFFER + +BFIN1: MOVSI A,TCHAN + JRST FINIS + + + +; FUNCTION TO GET THE FILE LENGTH OF A READ CHANNEL + +MFUNCTION FILLNT,SUBR,[FILE-LENGTH] + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TCHAN + JRST WTYP1 + MOVE B,1(AB) + PUSHJ P,CFILLE + JRST FINIS + +CFILLE: +IFN 0,[ + MOVEI B,DIRECT-1(B) ; GET CHANNEL TYPE + PUSHJ P,CHRWRD + JFCL + CAME B,[ASCIZ /READ/] + JRST .+3 + PUSH P,[5] ; MULTIPLICATIVE FACTOR FOR READ + JRST .+4 + CAME B,[ASCII /READB/] + JRST WRONGD + PUSH P,[1] ; MULTIPLICATIVE FACTOR FOR READ +] + MOVE C,-2(B) ; GET BITS + MOVEI D,5 ; ASSUME ASCII + TRNE C,C.BIN ; SKIP IF NOT BINARY + MOVEI D,1 + PUSH P,D + MOVE C,B +IFN ITS,[ + .CALL FILL1 + JRST FILLOS ; GIVE HIM A NICE FALSE +] +IFE ITS,[ + MOVE A,CHANNO(C) + PUSH P,[0] + MOVEI C,(P) + MOVE B,[1,,11] ; READ WORD CONTAINING BYTE SIZE + GTFDB + LDB D,[300600,,(P)] ; GET BYTE SIZE + JUMPN D,.+2 + MOVEI D,36. ; HANDLE "0" BYTE SIZE + SUB P,[1,,1] + SIZEF + JRST FILLOS +] + POP P,C +IFN ITS, IMUL B,C +IFE ITS,[ + CAIN C,5 + CAIE D,7 + JRST NOTASC +] +YESASC: MOVE A,$TFIX + POPJ P, + +IFE ITS,[ +NOTASC: MOVEI 0,36. + IDIV 0,D ; BYTES PER WORD + IDIVM B,0 + IMUL C,0 + MOVE B,C + JRST YESASC +] + +IFN ITS,[ +FILL1: SETZ ; BLOCK FOR .CALL TO FILLEN + SIXBIT /FILLEN/ + CHANNO (C) + SETZM B + +FILLOS: MOVE A,CHANNO(C) + MOVE B,[.STATUS A] ;MAKE A CALL TO STATUS TO FIND REASON + LSH A,23. ;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE + IOR B,A ;FIX UP .STATUS + XCT B + MOVE B,C + PUSHJ P,GFALS + POP P, + POPJ P, +] +IFE ITS,[ +FILLOS: MOVE B,C + PUSHJ P,TGFALS + POP P, + POPJ P, +] + + + ; MCHAN LOW-LEVEL I/O GARBAGE (PDL)-ORIGINAL (LIM)-ADDITIONS + +;CALLING ROUTINE: AC-A contains pointer to block of SIXBIT data +; DIR ? DEV ? FNM1 ? FNM2 ? SNM +;RETURNED VALUE : AC-A = +IFN ITS,[ +MOPEN: PUSH P,B + PUSH P,C + MOVE C,FRSTCH ; skip gc and tty channels +CNLP: DOTCAL STATUS,[C,[2000,,B]] + .LOSE %LSFIL + ANDI B,77 + JUMPE B,CHNFND ; found unused channel ? + ADDI C,1 ; try another channel + CAIG C,17 ; are all the channels used ? + JRST CNLP + SETO C, ; all channels used so C = -1 + JRST CHNFUL +CHNFND: MOVEI B,(C) + HLL B,(A) ; M.DIR slot + DOTCAL OPEN,[B,1(A),2(A),3(A),4(A)] + SKIPA + AOS -2(P) ; successful skip when returning +CHNFUL: MOVE A,C + POP P,C + POP P,B + POPJ P, + +MIOT: DOTCAL IOT,[A,B] + JFCL + POPJ P, + +MCLOSE: DOTCAL CLOSE,[A] + JFCL + POPJ P, + +IMPURE + +FRSTCH: 1 + +PURE +] + ;THREE GENERALLY USEFUL ERROR ROUTINES FOR I/O + +NOTNET: +BADCHN: ERRUUO EQUOTE BAD-CHANNEL +BDCHAN: ERRUUO EQUOTE BAD-INPUT-BUFFER + +WRONGD: ERRUUO EQUOTE WRONG-DIRECTION-CHANNEL + +CHNCLS: ERRUUO EQUOTE CHANNEL-CLOSED + +BAD6: ERRUUO EQUOTE NON-6-BIT-CHARACTER-IN-FILE-NAME + +DISLOS: MOVE C,$TCHSTR + MOVE D,CHQUOTE [DISPLAY NOT AVAILABLE] + PUSHJ P,INCONS + MOVSI A,TFALSE + JRST OPNRET + +NOCHAN: ERRUUO EQUOTE ITS-CHANNELS-EXHAUSTED + +MODE1: 232020,,202020 +MODE2: 232023,,330320 + +END + + \ No newline at end of file diff --git a//gcgdgl.mud.1 b//gcgdgl.mud.1 new file mode 100644 index 0000000..8578f76 --- /dev/null +++ b//gcgdgl.mud.1 @@ -0,0 +1,186 @@ + + + + + + + + ) + (ELSE ">)> + +> + )>> + +) FSP (REDEFINE T)) + #DECL ((REDEFINE) ) + > )> + > + > + <7 .CHN>>>>)> + ;"To hack ugly file names. (TT, 75/10/07)" + <8 .CHN> <9 .CHN> <10 .CHN>>>> + > + + .NAM>> + +) + (NAM + .NM) + (ELSE >)>) + (OC + <10 .CHN>>) + (FIXERS ()) FUNC BKS TEM TT HOLDANY GRP FIXES) + #DECL ((CHN) CHANNEL (NAM) ATOM (OC) (FIXERS) LIST) + )> + > >> + + )> + + >>> + !.FIXERS)> + + )) + COMMENT>> + COMMENT .TEM> !.FIXERS)>)> + > + + BLOCK + >> + !.FIXERS)>)> + >> + > DEFINE> <==? .TEM DEFMAC>> + 1> + VALUE '<2 + .OB>>>> + > + BREAKS>>> + BREAKS> + )> + >> BREAK> + <2 .HOLDANY>>)> + >>)> + > + > + 1>> .FIXERS> + )>) + ( + <==? 3> + VALUE '<2 .OB>>> ATOM> + > RSUBR> + RSUBR>>> + <==? .NM <2 .TEM>>> + CODE> >> + .FIXES> !.FIXERS)>) + ( CODE> + + + + )> + >>> + 1>> .FIXERS> + )> + > PCODE> + + 1 + >>> + !.FIXERS)>)>)>)>> + .GRP> + + + >> + .FIXERS) + .OC> + + + .NAM>> + +> + + > + COMMENT .TEM> + !.L)>)> + >>>> + 1>> .L> + )>> + > + COMMENT>> + > COMMENT .TEM> !.L)>)> + COMMENT>> + > COMMENT>>> + COMMENT .TEM> !.L)>)>) + (> )> + .L> + + (L) LIST) + + )) + + 1> + > ATOM> + > >> + CODE> + >> + .TEM> !.L)>) + ( CODE> + + > + )>)> + PCODE>> + + 1 + >>>> + !.L)>)> + + + 1 + >>> + !.L)> + + )>)>> + .R> + .L> + +> .O>> + + + \ No newline at end of file diff --git a//gcgdgl.nbin.1 b//gcgdgl.nbin.1 new file mode 100644 index 0000000000000000000000000000000000000000..ab3a95a17cc2c1feaa3e160e9938cf8532e9dcde GIT binary patch literal 11173 zcmcgyiB}WJ_P!mEu*u+tD2gRA5*(IJ(&tL=XW5^RK_} ztL}6syy(oC`JI<@D7w0;Zr!?d>n>k)?_4>PdyrWysIkS|^y1pmY9>E6uX=mu3M-Yh z$4b9k-6&79A*kgymdm==#yUn8@}-J9D7U(jSCP5JpVidzMn1n(P*KyIS99xy%A%^Q zEJx9~vRp=I|5Z$lp)1Busz_l8e{mMrq|Ca zKm8PN;WjTm%q%IFuX%8wyA{^fR@c(K_g@DC0SB!zn&?pY34Ti|B+@x$7e#b2bFnHpD^?ZR+D3CE6t352#;S5| z>Q=YN4-)Q*h*TxaqHD?yOUIOr5wlN@NT4eDDO;pV4GTutHMZ(vr+zwR@6^9YKK$D* zyP&g(;f<(~gPJ=+4+G^I$d879`Q#{(iD?XY%Fcx|#Z`rO(X>e44`66Wg|Qo?wg$}6nwsflEHuxJ2 zmtNbdUa$X|T$#QXF7;ug*s32RRN4WlqA8LF8@67I0j?G)I=y^6 zp|_TXf@qDIBG^c$IR_|T*Tbfsv&(2WcXf8CD#h7R6u~gbhHqC@7SdJu9n2QuQzxIg zY7$o6EWit9Gr4lF2=hr7-F(tT51)Eemg~)v`vn$Qd6yc4T);tQHkg;f?xal5sV)}X z=!Y&pzMrzUxgtyn)_$r4BT&sxx3vB~8nDZ?mDCW_2UH%+QP=7sgJM7y^|}~U>5$OR zc;au|!W`okRf=7tQ@<6NajODl<@Q0j2eF5!cJ)o%y4m6N!icA4U@5fSxRWpBmQ-X6 z=WnAhrZOv!_21ZPxq{=BS<#2bit>}LW=qj0$-|jp@hCstnTQ`|OnWs%ljK=rn4_w`-6u zf4S$sy@(v&5xJ$Sg}vbimE)U98P(OrSY{<%!{&h<{PMSFmsX`ODHn7#_xv=Tmd+Y> zsk1Cns0>`YaXcGAmA~B3_(uBka!vYlbukt_d0oR}mq6&E(6m( zmswvgEv^*uKdVJ-<-D5VKQ&k0sHmw{JE$9OKaIz2I~upGq?)#3saVp9M(wzY#q6kK zMy+_lR;VW}6^&YE(srVWn6hK3sFkoyWh%TdlS$jcVtd^ZFlD2l9sUp;Oc=^g zhGtY7%0bn+RX?Qpxu`lfd6a1_S!h#3({+hsVNn{C6}GT@rc*k8Vn00scDN=z|MhOG ze!?!WH(mjwGblas%NfTIraJ&v+GKk6zwwS7G+MXnr{r`@g+Q5%vl^P`(+QTpyusGH ze)T$+n&nc@v0;+Z07EFSHd>>a^pf%3Rw~!I)IP7+s(<1L6gBDhi}QRsud-Y94=N84 zlc7V-dqg|jPdnUC^Z18@oySqEip7Zr$Rx<)otCL&wZm*wX?P8E$wY%LzA=ufF7#7S z2Sf23qhI5DPt&P1X$5`FLQWjDq7JE=7GsF~@wIfR@zMlDC7o_)<+SkjkaT(J(soST~fRy)|z$;+J2SVewF;L6&ShOkb#kbw0b52n zPlkebs77W~FO5D3jObuTbx|j&7HCaB<)$1_1z_NLl3DOToMXd#HsIt{Lt*N3La8v- z0%NUWHH72}&UG%025w`hjo$0Sj>$nPF^==wYGdD1efGE&Iqu-NR)(+nnQv_cGAITK z3zXzL&bCW4!hATgpcsG5DNMeJfIx<}sbRip@ghbv@SX9Gohy>W&|*4$ zKOr*?6}iA0UJ-;nHMz-mx)|ltXrNaCyKK1S6@H+EcY(&9)yZINJ9>YzUhF=ybjD3k zt}i-VpgpS%rfg_;EiSF*TyU>4-&~I=)bHq7ko&Lfeo!ye#}{v2{Y&la?H<(B zyBBX?j!i1&j#-d+;LW(2T`H|t)UO+>l|o~BT$s+e zb;ZH+N<)Jh)l&h{={SwQ{88lL&HbdPq zR^+fLC5Kbp#%-_P{`tv|pTroIp@=5>DtfY4G)COklInSQ@_ySGa;wGj_r{N(7mdq^ z8PR$1DE$6-D`{Mk>n1pOdF{=QVhqZuTu}ITMHyMSCdP_KYWjKP@ZOO;kjsO{T^SiP zp2;YuYydC|0?e@_<2Yr72BuQbV|`4;t@@Y>;3WLA^E-P3N4-ZtfBLHOQErw)BXZXa zxnjyaeOh~ZG&CrVgomXpecke#oKMQ045W#}n4$0F&R}RlzAuMnTVJASe$cQk)K z$TKQEW#fi^=OaBgrKi|<*T8pN+2^L-^<=~;%M}ULjL&+Q4`p4Hu^J{S77lkluN0-< zo#?mq{_*3VMS6AB2Z+Lgko|^qRDnr_w`EHPs>WLx8-$p~lOY{@{zLdk8?9#e$O87G zEHh@?X4Hu#l@*Ht6S9a4#q3lf5qDxK0!YzhB5FDbH61nWRML!DN%U2gorqe=csvDU z3Aj>1ISDHnHB(XabD~ZvX{Vw9pa@T4NQx8SJ%%J4%fXmb$|OAHB%_!xs;syji^pQo zq^T^+GR-7jfwe>eZ%ySmNz0BUW0*PSm~qQgahtp)oMZ}DA$T;McoNh>8DJNN5&JSz zW+HAU%%qB&(G-9#pkPrm238#aU}#0}q?N#Q=$y1Df@lhG7-|k)I8MSzp=-kBB#tfw z&!TZm2A;qb#g%d)G=Oh}(3}~aqR zPT3c`!#O@NPWc=xpIy%6f-ZSVL+660t-0VQ22-EO%LxU0ijYT+{E+dyS9L>1Id-|n zysjPuJbz8>r=}=Z&d|NZ{Of8vpt0X2JU^H(18i2j7Kymt`1kRR6kl zblha@&VprWdrw5ZV2r4)FG;lN1rK0LfRGkft?&^;*H=8!2o|*FJ^)-*Htgx zlBio`q{iiuck$#_{U8Z}3x17g5urj? zQecksyB`){Epb<&tA3o)rK^63(j_7E_oIn(VqkLrx+$bP|F!F;rfu|s1^7|hgpY)) zgELRWqqumA!ui65!VSiG|I`Q@95_L^Ox!-fA3KN~5MjVeCsXkhJu>126CT@+$8=m^ zr4pu%t189_mYqyG@YGTMi@`DLm+SzitAhvxAxX=D+ohwmk}Zxl$e~<6iyNeG_*q={ zR;8uz{OtQCKMRw7LbH6Dh*Sl6YFK*zYnY-hN1^W!v~T0n2`%k=nj~Ubl2ZNHn%GoT z_JXP!FvU<^EC7{#QVX76+~crIZa*9}0$&<5lVR;+Sba?L`*9}SdJf+grL+svpo;Fo zRzhGhtwLeB5m>=i6B0P(ecyykf6exN%P9jjqIowqY$Gp(EV zYa5vol#*X5AzV;-h5iNv1@z?`VT%h&$p`M`smo~yN8i0`_#eSjXNB#r_cC|?8rQZ# z&H0|y?{$?0ZfM%C_ghz0{(4)S^8W&aYg%QnK)nu)TO}ey9tF3(Dy`_*{3k?8I{Z4| z9(`fw`V79cIj~>_y0tRUYkuU3!gZ|1ql69<{px^8wd?Hg@F;Ap=Q{b|B2LLnFBnuOjt%eEaWPyYxuaU8H{nUo&QHjh8Pkcq`Zr}=#M1= z_xxTn?q|Ct>4%GI04=g0ePvc%C`B4DOmyMJ!FdyTK7S1;rQy6AxwaKjH3t_e>3ed$iajrVQKzcrPt2i(YzTlH`f zxvZ;S_p@wn_OsnGBIkxBF5MAXk-mt$lmQ6hZ~5L}_s_UqJE7q7oCLCRCyFFCi7c4; zH#1+GzSguICb!CRlBVTYR@7EWGv(Nh6^p|eGwZhDI-?HK-9##8nn<(ZbW=8Rd>hGl zGHxRUcaW4vQy|pV$-2m;_aO)|=VJR*HgKYiuO4tS;eG$Wr-qGWQg)pouAdyW%|D0Q zeyWE1Y<#5#tKXW0jz_BtpJP`IPo(LAWte6 zwRO**R@C79UDqW2@c5Ef^^SnHJppdlPlWrb+okd0lnY4tA5OVnEcqW!dDRBU=fYJ! z$k(Gu`SGh>ad0dUxs-t_^5-8Ujep?FtJAptda8q8$Njxi;>yoIAr5dN(`M+XV@@bN WwHL>M5KU{WSXjw>-{m3}?)VSD;mn=@ literal 0 HcmV?d00001 diff --git a//gcgld.mud.1 b//gcgld.mud.1 new file mode 100644 index 0000000..e69de29 diff --git a//gchack.bin.2 b//gchack.bin.2 new file mode 100644 index 0000000000000000000000000000000000000000..eec5c55b7e4a9af17afbaac3499247a6d663df32 GIT binary patch literal 7139 zcmd5>3s)0a60UASh>_c;SD1q9Y`Q3BSC^NFe?F3amIn@sw0Z#ukZI& zXJ~MoJv+N+ceanGt$XYB-Kx5EZwE5mqF|IeXWSxkEpsvpsQv zfF(v5YQXedtJRDjf+i2{04cr#hdt03r+Ell?S@t=&jA-wuD8}}$tNP$`Y=2#pA0y} z*DP`+DkcEoS2QqXKn*$&AySKe1Lx2Jdz3p2z^Dsy2^v^nl=!UXY)`UQ8@dNF3m?`5 zURyexSQ0BdnHEV^iVd|Ijb^6R5yZlDCLXkrC6W02tDmpW5nrb*IRp%I_8gpTliSas zk5*og>LXRvB`EM=0>398MDA7avPS}~;(4QRLcNVIfW*)Wn?8eFqr}r`KjymL#Gi}} zliKk!cwkDdPplf9`&HxRa-iuB@%4jeiyClO4(DS0@cXI@34g1hX#xx zWP;JP!jv(&G~zOfqM~{EFaoN9!zK8@Z2ePqyw4BHSMPJuEDqy}1QHR`Sm4;U^QMqi~6 z7jnN~9&#{W)3tGbSWhz(cXPz|04)52jAeQtY+(6J%gp#O#PV;?D%^Vk7`TAhr+%?l z#TO|0sP@HRuBOhp)Up~NH9zg(9f~}E|4doO;8QGg?6y0eQQ6$jWQ6Rpp z1onq+zwl)Pe%A93+zYx>5xVYtrpU}?5(u;`%r7-K+nfm))aCCJf= zbf=qYpLhI54&4Hwy>qy7S_{Rv z2&heWkK=P}*U<$ZXt^!yyDgM!nNCB~#f-VA*6D75eUi@gp!u_Rcd|_Xs26a{E25e3A zI)J(j$pDn)3d0J*gGWK>$)SwXOxsKo@L2&I9|5mi>@ir8R|Ci|joM66bnXa^OKV@P zu!w_txD0)PWvt$|^`O(C=jcM~6kwib|3o0IHtp}8Fd~F@0HYyt!xIA-4!$0#c1b*K zwObVoRaj&O9dfJXfbq6E#>b+aWeLQ^axj*gS085YkdW^EL@6&b2Dn~c`PAibu4O7+ z;{Q0e(wT_^

}Z+e#v!{XV2Ga3W!tEbvzzvc0)(Y z4(GfWq`F%>c0A{G%n)JdA{x48CjKk6?vF2};HjZD_7wnYixmLH zqGBT;`dA$&zn*+K;wI^ksAb763e`8V&{X@9VTrnho~X`& zjiO7ljn_r?V9LtoA-7`(aC2FxGi1+SXIOf3nZ&(oi5u4KtlW(W?n|K~>3wX!UnRa2 z*ntbW+Y4BrhmVIJZ?I4c;&sjl>wT0)du(xV_XHpwTh{GSCX>MRdR1V%5#C{NPr_>m zUjkN^F(75@kbCmNP3Y*ie8b>bt{Sa0-VqeFstrvsV6<1Kz$WE_Gze38jHn!B z#i&uvi5bF6FYE5I>^&aNdu~IQv7$>^vtvtpIP774RQ{%n8CagMT2@CT zswtx-`u5W&wV)kt{pFgyeyMid(w?1pi;mJuGLuUXs~b zDHk&v57!)hw!}&(4+$#Oxb^yaFF}cK zul;t4j4Mic45eBe%JA_RlYyP74TMDOOCkCDd!`X{z~@lIyI`2JQT$Ng!R4YUfskyx zJO14Q|H~n%ik#uBktY7m(=!1iJe?il!4R)Ion|Rl&aIllqep9xOu6uVX*E|anANq7 zjoh-z6-;LYgd@JMgqIi1Mk%*gFe?vD&Mf5eW}{496^90Yr=oM+(>?gSvG`I1Q*#Yt z3w{PRayhU+GqCQQL(PkUz14egF|dDSt?{GgGH{$xhI8Mph>HdM*H#4j^DnzozwF|s zx}RfZHihC>K5;$PO62jbk3SNM9g3}X^7kHVD*WW`U_Yt8;Og-w)vzLy4c})t*B*}Jk%ehx8amAb7Q-LJ z6q|%vUlqf}Hu9G?9wy#iJ?>im3S=g~5}WZV_B!LoWk~P9sqex^gX$_{?)vG$1&tVu zDkC#+dNBP@BJ_V=b^l_7Iu{piq;&iYWw$?uDt*!Q= zhTq)+tibc9_Uj4ea#eg)CS!MwIsc(O{j!^FQ5qM@?W=~AT#ZlglL2BKxQK6(O6PxU ze#T?e9?I{Y93FBmyigu*(m#bn+xObGzr&Q(Qg{{PFZLqW+tW{nwHey6oB1JL0xf@A z|8cQEZnACYU3H99BtMfclfd`U-)>C>6<^1L!xBHBtf>zCp1VM18Tf36lzq;17RuS@ zIA|dl8+_Y!g~SpxmQOf0RR|{&{LB%_=gaSFB&@6PnN35g6>=LI`;GSWep0anXql_D zZg*hE^A9gpJMF!s#-{(aeWy$DEqD0SxMN^>=iGTxKT)pOKG?HQ!kR5iyl?tQQrZUQ z#xz1pZNL5Lq>0{G?N))*9I0#P)U7tzaj)Nph@bvV#q!5y!s!^z)euQHgVoq+*3Hom zzm$TUwqheuHrw#IJqV^K3;J+*S1jZ{_vD@$V{eUNcm_*b@wLA z8~4}5sUT{wr/gchack.bin.3 b//gchack.bin.3 new file mode 100644 index 0000000000000000000000000000000000000000..b2b099a5392a84fcd56319653836f261b3055af3 GIT binary patch literal 7210 zcmd5>3s)M+60R8$2sjG(2xyd+pb`S&Tk|j(5JaPisG~8u8}XHB;wom7Y)p*&^;=&J zVKke2&+gu{cki6zSkv|Tx~jUmXQ0R@qVr#0FZDEi-X*y_#@)pl)igX~Q*L9mqJ(rA z$9*={XzXp9GS(;te61Dx(d7?&CxqcPDye;;8jR+R8s%#$$`Fw+eqmGEd4&nz^l#fiY4>rC+EfndL42 z?vrH^QHFQkZ?c3=hW6fi!_*ixcRW1-HAlw9gB#$Q)HR@9&oM>RTIO4-hqU5dCOphY zo-je$Pn+cigCZ5u0+bEeBFe>_Oq_4Sn73%WqyW*lB5GtS6vCLk<>s+{H%n*YVPXM| zlrY4Air=hOm74`sp1Da-xOw;EtT77nEUdLFSSi0^xGZIR3*L;rB)ZwpkLT8D@)7Vg z6Ws`q^0M$T3`{7d?wTwDq#FEs>(IR0klXjNQ5)neYw!dEz^Aoj;?Zg~^@zy~`_RVt zwjqyWv!og038GkeuAy3m(ZNY^#9{`VkppdLmMHxA_-*GD@O9~w<$&>+KF!WvfIEOk z7pxqD>IZcuQxM>T0RD(R5j`sNO&{_G$?*o^h#G0Bgbq52i)noImn!p&pd@4_!f z20?AQ5jU6YSevDXvqwESq@p)_-^`u%Q_ioH0a|XDj%yU5y`XMG~1h3s39akWt6hl(M)fdr_c`ujMAXa!h6s#8;}tEo8T*z$!GoO1IcPyfyXf&0kI z1{}-2=Yo zG{OnW^l-|16I@d)ry17`xKY`gSQWBnBAZymLx(k^+q{6um3qYYWu!;-bK4akBRPne ze3R-d&9VrrP;bIh{krK^bRe1Lh_D)rI%5PY#IjYbnpDX$`07#=!L0^fz##f)W+cvYh7G%d%`bszTnb>tWyxwha4J`7RA zO-B`1Wm7B%wAESYy(A%Wd0|Gf3FzU~Z-#ZFX zcuH#vG?)^0%@|95lOvkqF8{n`7gN(Z3j1bffxKbTSd^%z<5}iD2!~BhYwPD$7n13LV{8oq0^o^mNOG$jvBBuQEa`a>mHff4cHCFDHOdzz;8nCmm?+C2#_udn@6;c)89@nUt_s+P=MFd7D|37=c!(%QImF|$GB{Va@^)n*>UCK z#fpQM!)+37fOCjGUK817Q(7j^a+|uB+eog)plx@Jp~)d;oR45dtWdkPVl{SRT@oBo z-@5*B7Wi&6+j~WKBgYeT@F{kI!z`=$_*Q2$$`}nlL$4~~O17va-$pmoOnP$;$ z2!|Nyf0W{v0xg3WfYRj=Yx2sY`1m^2{q834;h?VBYOvCHAIBe2OHCkPuvep)4ax?o zI803=KxJ}Plo-VrDZDbsx!sn!nydB zM;r|_M_4S2qY~7F(Gqz7<%?L54!3-?q?eqM|4V%>*vM|Lt|RUxJ)bGUWl_7Pz7hC8 zlYM5TonDfDK5xyXSFM%#XT|i=O4?d0Ef&(*XZiG!HCNEuSYrih*LqH{QF_kF!tI$) z=s6x<;z8E}`$~Cz~zhE&B^)S+ir?zHxt~Ow4w=@wX)zu4Xr=Wr=4j0wTg(?M(g_^D&iG|58;aU zWGOwN<#weQtQVz1dKP8C#CJK5NY0~`vQa?J8xiMlJ?D{n&RMRO^9+J0az6sJ|!> z#pm>Zw$Rev<_om6yS3kTjJ0eiVsxEHF<4%a9(0~M~-JMGhu?wx5;TIj6 z^YW1nMoY2152sf&>gA)dk29CQ(_nk0*x9A`k7yvsr=`imXyXQjN?ab~6RPp~S!W+W zk!!o{P7I72LOBefT1?2`av0;@&52bG3F+5D^6N*Wk;fRH2@U6fp)Q8`n?d~)8O5X_ z!68}waPqqe{>>q&5MA(ILmqtciH|W7?9TSlB|gTC`(0`_Yh@QzVP$1$MOlTXrNyjO zP>V~etJxxOQ$ckZ{LduUcf!RPwOY!~6x94Pl~uWHUaeZt6>-+UCo4FYH66!m2X2C3 za=Kw8=R#nO>w$fXz}jObG_MBscHi#R!2Xl9hL@V_z#wj#Jc|FSjl z%NCzhce1EVk3W3l3+AIeG1j+S_+Ci5KeX6|Z#~*%)60i<2S5$@7Eiv227knBc$&so zyMJK(tN|K+|4h{T3DlPVWuh|zZm&PF*4zl{rhg#3XM($SYVw^wr`l>?P?%b}p-bgZ z4F4vkyhxz+T`^p3BmZdQLE`nrlkVC!TW@LU{CsH2sn|}$57VH&8KL-NxB>Po+u3s%3% zsjd3DTCL)3?8;UB?Ucu|6@IIXhVGw$bKaIX>P1_m#+=o*s6bIicnq%$EY{8k@ikC) z@;@~nU>ns_IcwA-zl8+awp%yu@t77U9Eb49o~Sct-TZA3a@3aC8%hre0dmp&)NYprs;M>gp)vx>7~TK*#cRQrpUMl9sC{9-gjXqTvYo%><{-DmNOcpG zUgu_WR^}CNxhxpE`@Z`Ih$3qgPcb%GXo^Pg!b6m^Mk=T<7v=NT$0~-jj_}l)0u^M9 zRmq3dme`33DldFs=2|j2VR=^tU(TBR2~qb_J9ma*aNFVSh$&jnS)oE2V^nN+C-^MF zVW@LWP;VeN-*z{?144UP82jk?43b)t(<2hoV(YhGTRcDj%-SrdX;9%h6>p_Y` z*qV&k+z4tHa+)y{F50?;I-SQ@VD<2R|2QdL6@L3CE7!n>_fre$TeQJrvgqVX%*QwD P!B14azIvj(dgS^Sa;J9s literal 0 HcmV?d00001 diff --git a//gchack.mid.45 b//gchack.mid.45 new file mode 100644 index 0000000..804b865 --- /dev/null +++ b//gchack.mid.45 @@ -0,0 +1,538 @@ + +TITLE GCHACK + +RELOCATABLE + +.INSRT MUDDLE > + +.GLOBAL FRMUNG,PARBOT,TYPVEC,GCHACK,REHASH,IMPURI,NWORDT,GCDFLG +.GLOBAL TD.LNT,TD.GET,TD.PUT,GCSTOP,GCSBOT,GCHK10,STOSTR,UBIT,PVSTOR,SPSTOR + +UBIT==40000 ; BIT INDICATING VECTOR +.LIST.==400000 + +; THIS IS AN INTERNAL MUDDLE SUBROUTINE TO RUN AROUND GC SPACE DOING +; SOMETHING ARBITRARY TO EVERY ENTITY THEREIN + +; CALL -- +; A/ INSTRUCTION TO BE EXECUTED +; PVP/ NON-ZERO OPTIMIZE--ONLY LOOK AT ATOMS +; PUSHJ P,GCHACK + +; HERE FOR SPECIAL HACKS WHICH DON'T TOUCH STOAGE + +GCHK10: PUSHJ P,GHSTUP + JRST GCHK1 + +GCHACK: PUSHJ P,GHSTUP ; SETUP + MOVE B,CODTOP ; START OFF WITH IMPURE STORAGE + SUBI B,1 ; START AT FIRST WORD +LOPSTO: CAIG B,STOSTR + JRST GCHK1 + HRRE 0,1(B) ; GET INDICATOR OF MODIFICATION + JUMPGE 0,LOSTO ; JUMP IF GARBAGE + PUSHJ P,VHACK ; VHACK + JRST LOPSTO +LOSTO: HLRZ C,1(B) ; BACK OF VECTOR + TRZ C,400000 + SUBI B,(C) ; SKIP OVER VECTOR + JRST LOPSTO + +GCHK1: MOVE B,VECTOP ; NO LOOP THRU GCS + MOVEI B,-2(B) + + +LOOPHK: MOVE C,SVTAB + MOVEM B,(C) + EXCH C,NXTTAB ; SWAP LOCATIONS + EXCH C,SVTAB + TLZ B,.LIST. ; TURN OFF LIST BIT + CAMGE B,GCSBOT ; SEE IF DONE + JRST REHASQ ; SEE IF ASSOCIATIONS ARE GOOD + MOVE C,(B) ; GET ELEMENT + TLNE C,.VECT. ; SEE IF IT IS A VECTOR + JRST VHCK ; JUMP IF IT IS +GLSTHK: GETYP C,(B) ; TYPE OF CURRENT PAIR + MOVE D,1(B) ; AND ITS DATUM + TLO B,.LIST. ; INDICATE A LIST + SKIPL (B) ; SKIP IF MARKED + XCT A ; APPLY INS + SUBI B,2 + JRST LOOPHK +VHCK: PUSHJ P,VHACK ; TO VHACK + JRST LOOPHK + +; NOW DO THE SAME THING TO VECTOR SPACE +VHACK: HLRE D,(B) ; GET TYPE FROM D.W. + TRZ D,.VECT. ; GET RID OF VECTOR INDICATION BIT + HLRZ C,1(B) ; AND TOTAL LENGTH + TRZE C,400000 ; GET RID OF POSSIBLE MARK BIT + JRST MKHAK ; JUMP IF MARKED + SUBI B,(C)-2 ; POINT TO START OF VECTOR + PUSH P,B + SUBI C,2 ; CHECK WINNAGE + JUMPL C,BADV ; FATAL LOSSAGE + PUSH P,C ; SAVE COUNT + JUMPE C,VHACK1 ; EMPTY VECTOR, FINISHED + +; DECIDE BASED ON TYPE WHETHER GENERAL,UNIFORM OR SPECIAL + + JUMPGE D,UHACK ; UNIFORM + TRNE D,377777 ; SKIP IF GENERAL + JRST SHACK ; SPECIAL + +; FALL THROUGH TO GENERAL + +GHACK1: SKIPGE (B) ; CHECK FOR FENCE POST + JRST VHACK1 + GETYP C,(B) ; LOOK A T 1ST ELEMENT + CAIE C,TCBLK + CAIN C,TENTRY ; FRAME ON STACK + SOJA B,EHACK + CAIE C,TUBIND + CAIN C,TBIND ; BINDING BLOCK + JRST BHACK + CAIN C,TGATOM ; ATOM WITH GDECL? + JRST GDHACK + MOVE D,1(B) ; GET DATUM + XCT A ; USER INS +GDHCK1: ADDI B,2 ; NEXT ELEMENT + SOS (P) + SOSLE (P) ; COUNT ELEMENTS + SKIPGE (B) ; OR FENCE POST HIT + JRST VHACK1 + JRST GHACK1 + +; HERE TO GO OVER UVECTORS + +UHACK: CAMN A,[PUSHJ P,SBSTIS] + JRST VHACK1 ; IF THIS SUBSTITUTE, DONT DO UVEC + MOVEI C,(D) ; COPY UNIFORM TYPE + JUMPE PVP,UHACKX ; JUMP IF NOT ONLY ATOMS + ASH C,1 ; COMPUTE SAT + ADD C,TYPVEC+1 + HRRZ C,(C) + ANDI C,SATMSK ; GOT ITS SAT + CAIE C,SATOM ; DON'T BOTHER IF NOT ALL ATOMS + JRST VHACK1 + MOVEI C,(D) +UHACKX: PUSH P,C ; ATFIX CLOBBERS C + SUBI B,1 ; BACK OFF + +UHACK1: MOVE C,(P) + TLO B,UBIT ; TURN ON BIT INDICATING UVECTOR + MOVE D,1(B) ; DATUM + XCT A + SOSLE -1(P) ; COUNT DOEN + AOJA B,UHACK1 + TLZ UBIT + POP P,C + JRST VHACK1 + +; HERE TO HACK VARIOUS FLAVORS OF SPECIAL GOODIES + +SHACK: ANDI D,377777 ; KILL EXTRA CRUFT + CAIN D,SATOM + JRST ATHACK + CAIE D,STPSTK ; STACK OR + CAIN D,SPVP ; PROCESS + JRST GHACK1 ; TREAT LIKE GENERAL + CAIN D,SASOC ; ASSOCATION + JRST ASHACK + CAIG D,NUMSAT ; TEMPLATE MAYBE? + JRST BADV ; NO CHANCE + ADDI C,(B) ; POINT TO DOPE WORDS + SUBI D,NUMSAT+1 + HRLI D,(D) + ADD D,TD.LNT+1 + JUMPGE D,BADV ; JUMP IF INVALID TEMPLATE HACKER + + CAMN A,[PUSHJ P,SBSTIS] + JRST VHACK1 + +TD.UPD: PUSH P,A ; INS TO EXECUTE + XCT (D) + HLRZ E,B ; POSSIBLE BASIC LENGTH + PUSH P,[0] + PUSH P,E + MOVEI B,(B) ; ISOLATE LENGTH + PUSH P,C ; SAVE POINTER TO OBJECT + + PUSH P,[0] ; HOME FOR VALUES + PUSH P,[0] ; SLOT FOR TEMP + PUSH P,B ; SAVE + SUB D,TD.LNT+1 + PUSH P,D ; SAVE FOR FINDING OTHER TABLES + JUMPE E,TD.UP2 ; NO REPEATING SEQ + ADD D,TD.GET+1 ; COMP LNTH OF REPEATING SEQ + HLRE D,(D) ; D ==> - LNTH OF TEMPLATE + ADDI D,(E) ; D ==> -LENGTH OF REP SEQ + MOVNS D + HRLM D,-5(P) ; SAVE IT AND BASIC + +TD.UP2: SKIPG D,-1(P) ; ANY LEFT? + JRST TD.UP1 + + MOVE E,TD.GET+1 + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + MOVEM D,-6(P) ; SAVE ELMENT # + SKIPN B,-5(P) ; SKIP IF "RESTS" EXIST + SOJA D,TD.UP3 + + MOVEI 0,(B) ; BASIC LNT TO 0 + SUBI 0,(D) ; SEE IF PAST BASIC + JUMPGE 0,.-3 ; JUMP IF O.K. + MOVSS B ; REP LNT TO RH, BASIC TO LH + IDIVI 0,(B) ; A==> -WHICH REPEATER + MOVNS A + ADD A,-5(P) ; PLUS BASIC + ADDI A,1 ; AND FUDGE + MOVEM A,-6(P) ; SAVE FOR PUTTER + ADDI E,-1(A) ; POINT + SOJA D,.+2 + +TD.UP3: ADDI E,(D) ; POINT TO SLOT + XCT (E) ; GET THIS ELEMENT INTO A AND B + TLO A,UBIT ; INDICATE ITS A ANY + MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT + MOVEM B,-2(P) + GETYP C,A ; TYPE TO C + MOVE D,B ; DATUME + MOVEI B,-3(P) ; POINTER TO HOME + MOVE A,-7(P) ; GET INS + XCT A ; AND DO IT + MOVE C,-4(P) ; GET POINTER FOR UPDATE OF ELEMENT + MOVE E,TD.PUT+1 + SOS D,-1(P) ; RESTORE COUNT + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + MOVE B,-6(P) ; SAVED OFFSET + ADDI E,(B)-1 ; POINT TO SLOT + MOVE A,-3(P) ; RESTORE TYPE WORD + MOVE B,-2(P) + XCT (E) ; SMASH IT BACK + JRST TD.LOS +TD.WIN: MOVE C,-4(P) + JRST TD.UP2 + +TD.LOS: SKIPN GCDFLG + FATAL TEMPLATE LOSSAGE + JRST TD.WIN + +TD.UP1: MOVE A,-7(P) ; RESTORE INS + SUB P,[10,,10] + MOVSI D,400000 ; RESTORE MARK/UNMARK BIT + JRST VHACK1 + +; FATAL LOSSAGE ARRIVES HERE + +BADV: FATAL GC SPACE IN A BAD STATE + +; HERE TO HACK SPECIAL CRUFT IN GENERAL VECTORS (STACKS) + +EHACK: JUMPE PVP,EHACKX + ADDI B,FRAMLN+1 ; SKIP THE FRAME + JRST GHACK1 + +EHACKX: HRRZ D,1(B) + CAILE D,HIBOT + JRST EHCK10 + PUSH P,1(B) + HRL D,(D) + MOVEI C,TVEC + CAME A,[PUSHJ P,SBSTIS] + XCT A ; XCT SUBSTITUTE + POP P,C ; RESTORE TYPE + HLLM C,1(B) ; SMASH BACK +EHCK10: ADDI B,1 + MOVSI D,-FRAMLN+1 ; SET UP AOBJN PNTR + +EHACK1: HRRZ C,ETB(D) ; GET 1ST TYPE + PUSH P,D ; SAVE AOBJN + MOVE D,1(B) ; GET ITEM + CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT + XCT A ; USER GOODIE + POP P,D ; RESTORE AOBJN + ADDI B,1 ; MOVE ON + SOSLE (P) ; ALSO COUNT IN TOTAL VECTOR + AOBJN D,EHACK1 + AOJA B,GHACK1 ; AND GO ON + +; TABLE OF ENTRY BLOCK TYPES + +ETB: TTB + TAB + TSP + TPDL + TTP + TWORD + +; HERE TO GROVEL OVER BINDING BLOCKS + +BHACK: MOVEI C,TATOM ; ALSO TREEAT AS ATOM + MOVE D,1(B) + CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT + XCT A + PUSHJ P,NXTGDY ; NEXT GOODIE + PUSHJ P,NXTGDY ; AND NEXT + MOVEI C,TSP ; TYPE THE BACK LOCATIVE + SKIPGE D,1(B) + XCT A + PUSHJ P,BMP ; AND NEXT + PUSH P,B + HLRZ D,-2(B) ; DECL POINTER + MOVEI B,0 ; MAKE SURE NO CLOBBER + MOVEI C,TDECL + XCT A ; DO THE THING BEING DONE + POP P,B + HRLM D,-2(B) ; FIX UP IN CASE CHANGED + JRST GHACK1 + +; HERE TO HACK ATOMS WITH GDECLS + +GDHACK: CAMN A,[PUSHJ P,SBSTIS] + JRST GDHCK1 + + MOVEI C,TATOM ; TREAT LIKE ATOM + MOVE D,1(B) + XCT A + HRRZ D,(B) ; GET DECL + JUMPE D,GDHCK1 + CAIN D,-1 ; WATCH OUT FOR MAINFEST + JRST GDHCK1 + PUSH P,B ; SAVE POINTER + MOVEI B,0 + MOVEI C,TLIST + XCT A + POP P,B + HRRM D,(B) ; RESET + JRST GDHCK1 + + +; HERE TO HACK ATOMS + +ATHACK: JUMPN PVP,BUCKHK ; IF ONLY CHANGING ATOMS, IGNROE OBLIST + MOVEI C,TOBLS ; GET TYPE + HRRZ D,2(B) ; AND DATUM + JUMPE D,BUCKHK ; NOT ON OBLIST, SO FLUSH + CAMGE D,VECBOT + MOVE D,(D) ; GET REAL OBLIST POINTER + HRLI D,-1 + CAMN A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT + JRST VHACK1 + PUSH P,B + MOVEI B,0 + XCT A + POP P,B + HRRM D,2(B) +BUCKHK: CAMN A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT + JRST VHACK1 + HLRZ D,2(B) + JUMPE D,VHACK1 + PUSH P,B + PUSH P,D + MOVEI B,-1(P) ; FAKE OUT TO MUNG STACK +; HLRZ B,1(D) +; ANDI B,377777 +; SUBI B,2 +; HRLI B,(B) +; SUB D,B ; D NOW ATOM PNTR + MOVEI C,TATOM + XCT A +; HLRE B,D +; SUB D,B + POP P,D + POP P,B + HRLM D,2(B) + JRST VHACK1 + +; HERE TO HACK ASSOCIATION BLOCKS + +ASHACK: MOVEI D,3 ; COUNT GOODIES TO MARK + +ASHAK1: PUSH P,D + MOVE D,1(B) + GETYP C,(B) + PUSH P,D ; SAVE POINTER + XCT A + POP P,D ; GET OLD BACK + CAME D,1(B) ; CHANGED? + TLO E,400000 ; SET NON-VIRGIN FLAG + POP P,D + PUSHJ P,BMP ; TO NEXT + SOJG D,ASHAK1 + +; HERE TO GOT TO NEXT VECTOR + +VHACK1: MOVE B,-1(P) ; GET POINTER + SUB P,[2,,2] ; FLUSH CRUFT + SUBI B,2 ; FIX UP PTR + POPJ P, + +; HERE TO SKIP OVER MARKED VECTOR + +MKHAK: SUBI B,(C) ; POINT BELOW VECTOR + POPJ P, + +; ROUTINE TO GET A GOODIE + +NXTGDY: GETYP C,(B) +NXTGD1: MOVE D,1(B) + XCT A ; DO IT TO IT +BMP: SOS -1(P) + SOSG -1(P) + JRST BMP1 + ADDI B,2 + POPJ P, +BMP1: SUB P,[1,,1] + JRST VHACK1 + +REHASQ: JUMPL E,REHASH ; HASH TABLE RAPED, FIX IT + POPJ P, + + +MFUNCTION SUBSTI,SUBR,[SUBSTITUTE] + +;THIS FUNCTION CODED BY NDR IS AN INCREDIBLE WAY TO +;KILL YOURSELF, EVEN IF YOU THINK YOU REALLY KNOW WHAT +;YOU ARE DOING. +;IT DOES A MINI-GC CHANGING EACH REFERENCE OF THE +;SECOND ITEM TO A REFERENCE OF THE FIRST ITEM, HA HA HA. +;BOTH ITEMS MUST BE OF THE SAME TYPE OR +;IF NOT, NEITHER CAN BE A TYPE REQUIRING TWO WORDS +; OF STORAGE, AND SUBSTITUTION CANT BE DONE IN +; UVECTORS WHEN THEY ARE DIFFERENT, AS WELL AS IN +; A FEW OTHER YUCKY PLACES. +;RETURNS ITEM TWO--THE ONLY WAY TO GET YOUR HANDS BACK ON IT + + ENTRY 2 + + +SBSTI1: GETYP A,2(AB) + CAIE A,TATOM + JRST SBSTI2 + MOVE B,3(AB) ; IMPURIFY HASH BUCKET MAYBE? + PUSHJ P,IMPURI + GETYP A,(AB) ; ATOM FOR ATOM SUBS? + CAIE A,TATOM + JRST SBSTI2 ; NO + MOVE B,3(AB) ; SEE IF OLD GUY + HLRE A,B + SUBM B,A ; POINT TO DOPE + HRRZ A,(A) ; POSSIBLE TYPE CODE + JUMPE A,SBSTI2 ; NOT A TYPE, GO + MOVE B,1(AB) + HLRE C,B + SUBM B,C + HRRZ C,(C) ; GET OTHER POSSIBLE CODE + JUMPN C,BADTYP + PUSH P,A + PUSHJ P,IMPURI ; IMPURIFY FOR SMASH + POP P,A + MOVE B,1(AB) + HLRE C,B + SUBM B,C + HRRM A,(C) + +SBSTI2: GETYP A,2(AB) ; GET TYPE OF SECOND ARG + MOVE D,A + PUSHJ P,NWORDT ; AND STORAGE ALLOCATION + MOVE E,A + GETYP A,(AB) ; GET TYPE OF FIRST ARG + MOVE B,A + PUSHJ P,NWORDT + CAMN B,D ; IF TYPES SAME, DONT CHECK FOR ALLOCATION + JRST SBSTI3 + CAIN E,1 + CAIE A,1 + JRST SBSTIL ; LOOSE, NOT BOTH ONE WORD GOODIES + +SBSTI3: MOVEI C,0 + CAIN D,0 ; IF GOODIE IS OF TYPE ZERO + MOVEI C,1 ; USE TYPE 1 TO KEEP INFO FROM CLOBBERAGE + PUSH TP,C + SUBI E,1 + PUSH TP,E ; 1=DEFERRED TYPE ITEM, 0=ELSE + PUSH TP,C + PUSH TP,D ; TYPE OF GOODIE + PUSH TP,C + PUSH TP,[0] + CAIN D,TLIST + AOS (TP) ; 1=TYPE LIST, 0=ELSE + PUSH TP,C + PUSH TP,2(AB) ; TYPE-WORD + PUSH TP,C + PUSH TP,3(AB) ; VALUE-WORD + PUSH TP,(AB) + PUSH TP,1(AB) ; TYPE-VALUE OF THINGS TO CHANGE INTO + MOVE A,[PUSHJ P,SBSTIR] + CAME B,D ; IF NOT SAME TYPE, USE DIFF MUNGER + MOVE A,[PUSHJ P,SBSTIS] + MOVEI PVP,0 ; INDICATE NOT SPECIAL ATOM THING + PUSHJ P,GCHACK ; DO-IT + MOVE A,-4(TP) + MOVE B,-2(TP) + JRST FINIS ; GIVE THE LOOSER A HANDLE ON HIS GOODIE + +SBSTIR: CAME D,-2(TP) + JRST LSUB ; THIS IS IT + CAME C,-10(TP) + JRST LSUB ; IF ITEM CANT BE SAME CHECK FOR LISTAGE + JUMPE B,LSUB+1 ; WE GOT HOLD OF A FUNNY GOODIE, JUST IGNORE IT + MOVE 0,(TP) + MOVEM 0,1(B) ; SMASH IT + MOVE 0,-1(TP) ; GET TYPE WORD + SKIPE -12(TP) ; IF THIS IS A DEFFERABLE ITEM THEN WE MUST + MOVEM 0,(B) ; ALSO SMASH THE TYPE WORD SLOT + +LSUB: SKIPN -6(TP) ; IF WE ARE LOOKING FOR LISTS, LOOK ON + POPJ P, ; ELSE THATS ALL + TLNN B,.LIST. ; SEE IF A LIST + POPJ P, ; WELL NO LIST SMASHING THIS TIME + HRRZ 0,(B) ; GET ITS LIST POINTER + CAME 0,-2(TP) + POPJ P, ; THIS ONE DIDNT MATCH + MOVE 0,(TP) ; GET THE NEW REST OF THE LIST + HRRM 0,(B) ; AND SMASH INTO THE REST OF THE LIST + POPJ P, + +SBSTIS: CAMN D,-2(TP) + CAME C,-10(TP) + POPJ P, + SKIPN B ; SEE IF THIS IS A FUNNY GOODIE WE NO TOUCHIE + POPJ P, + MOVE 0,(TP) + MOVEM 0,1(B) ; KLOBBER VALUE CELL + MOVE 0,-1(TP) + HLLM 0,(B) ; KLOBBER TYPE CELL, WHICH WE KNOW IS THERE + POPJ P, + +SBSTIL: ERRUUO EQUOTE CANT-SUBSTITUTE-WITH-STRING-OR-TUPLE-AND-OTHER +BADTYP: ERRUUO EQUOTE SUBSTITUTE-TYPE-FOR-TYPE + +GHSTUP: HRRZ E,TYPVEC+1 ; SET UP TYPE POINTER + HRLI E,C ; WILL HAVE TYPE CODE IN C + SETOM 1(TP) ; FENCE POST PDL + PUSH P,A + MOVEI A,(TB) + PUSHJ P,FRMUNG ; MUNG CURRENT FRAME + POP P,A + POPJ P, + + +IMPURE + +; LOCATION TO REMEMBER PREVIOUS VALUES + +SVTAB: SVLOC1 +NXTTAB: SVLOC2 + +SVLOC1: 0 +SVLOC2: 0 + +PURE + +END + +  \ No newline at end of file diff --git a//gchack.mid.46 b//gchack.mid.46 new file mode 100644 index 0000000..b2b86f6 --- /dev/null +++ b//gchack.mid.46 @@ -0,0 +1,540 @@ + +TITLE GCHACK + +RELOCATABLE + +.INSRT MUDDLE > + +.GLOBAL FRMUNG,PARBOT,TYPVEC,GCHACK,REHASH,IMPURI,NWORDT,GCDFLG +.GLOBAL TD.LNT,TD.GET,TD.PUT,GCSTOP,GCSBOT,GCHK10,STOSTR,UBIT,PVSTOR,SPSTOR + +UBIT==40000 ; BIT INDICATING VECTOR +.LIST.==400000 + +; THIS IS AN INTERNAL MUDDLE SUBROUTINE TO RUN AROUND GC SPACE DOING +; SOMETHING ARBITRARY TO EVERY ENTITY THEREIN + +; CALL -- +; A/ INSTRUCTION TO BE EXECUTED +; PVP/ NON-ZERO OPTIMIZE--ONLY LOOK AT ATOMS +; PUSHJ P,GCHACK + +; HERE FOR SPECIAL HACKS WHICH DON'T TOUCH STOAGE + +GCHK10: PUSHJ P,GHSTUP + JRST GCHK1 + +GCHACK: PUSHJ P,GHSTUP ; SETUP + MOVE B,CODTOP ; START OFF WITH IMPURE STORAGE + SUBI B,1 ; START AT FIRST WORD +LOPSTO: CAIG B,STOSTR + JRST GCHK1 + HRRE 0,1(B) ; GET INDICATOR OF MODIFICATION + JUMPGE 0,LOSTO ; JUMP IF GARBAGE + PUSHJ P,VHACK ; VHACK + JRST LOPSTO +LOSTO: HLRZ C,1(B) ; BACK OF VECTOR + TRZ C,400000 + SUBI B,(C) ; SKIP OVER VECTOR + JRST LOPSTO + +GCHK1: MOVE B,VECTOP ; NO LOOP THRU GCS + MOVEI B,-2(B) + + +LOOPHK: MOVE C,SVTAB + MOVEM B,(C) + EXCH C,NXTTAB ; SWAP LOCATIONS + EXCH C,SVTAB + TLZ B,.LIST. ; TURN OFF LIST BIT + CAMGE B,GCSBOT ; SEE IF DONE + JRST REHASQ ; SEE IF ASSOCIATIONS ARE GOOD + MOVE C,(B) ; GET ELEMENT + TLNE C,.VECT. ; SEE IF IT IS A VECTOR + JRST VHCK ; JUMP IF IT IS +GLSTHK: GETYP C,(B) ; TYPE OF CURRENT PAIR + MOVE D,1(B) ; AND ITS DATUM + TLO B,.LIST. ; INDICATE A LIST + SKIPL (B) ; SKIP IF MARKED + XCT A ; APPLY INS + SUBI B,2 + JRST LOOPHK +VHCK: PUSHJ P,VHACK ; TO VHACK + JRST LOOPHK + +; NOW DO THE SAME THING TO VECTOR SPACE +VHACK: HLRE D,(B) ; GET TYPE FROM D.W. + TRZ D,.VECT. ; GET RID OF VECTOR INDICATION BIT + HLRZ C,1(B) ; AND TOTAL LENGTH + TRZE C,400000 ; GET RID OF POSSIBLE MARK BIT + JRST MKHAK ; JUMP IF MARKED + SUBI B,(C)-2 ; POINT TO START OF VECTOR + PUSH P,B + SUBI C,2 ; CHECK WINNAGE + JUMPL C,BADV ; FATAL LOSSAGE + PUSH P,C ; SAVE COUNT + JUMPE C,VHACK1 ; EMPTY VECTOR, FINISHED + +; DECIDE BASED ON TYPE WHETHER GENERAL,UNIFORM OR SPECIAL + + JUMPGE D,UHACK ; UNIFORM + TRNE D,377777 ; SKIP IF GENERAL + JRST SHACK ; SPECIAL + +; FALL THROUGH TO GENERAL + +GHACK1: SKIPGE (B) ; CHECK FOR FENCE POST + JRST VHACK1 + GETYP C,(B) ; LOOK A T 1ST ELEMENT + CAIE C,TCBLK + CAIN C,TENTRY ; FRAME ON STACK + SOJA B,EHACK + CAIE C,TUBIND + CAIN C,TBIND ; BINDING BLOCK + JRST BHACK + CAIN C,TGATOM ; ATOM WITH GDECL? + JRST GDHACK + MOVE D,1(B) ; GET DATUM + XCT A ; USER INS +GDHCK1: ADDI B,2 ; NEXT ELEMENT + SOS (P) + SOSLE (P) ; COUNT ELEMENTS + SKIPGE (B) ; OR FENCE POST HIT + JRST VHACK1 + JRST GHACK1 + +; HERE TO GO OVER UVECTORS + +UHACK: CAMN A,[PUSHJ P,SBSTIS] + JRST VHACK1 ; IF THIS SUBSTITUTE, DONT DO UVEC + MOVEI C,(D) ; COPY UNIFORM TYPE + JUMPE PVP,UHACKX ; JUMP IF NOT ONLY ATOMS + ASH C,1 ; COMPUTE SAT + ADD C,TYPVEC+1 + HRRZ C,(C) + ANDI C,SATMSK ; GOT ITS SAT + CAIE C,SCHSTR ; COULD BE SPNAME + JRST .+3 + CAIE C,SATOM ; DON'T BOTHER IF NOT ALL ATOMS + JRST VHACK1 + MOVEI C,(D) +UHACKX: PUSH P,C ; ATFIX CLOBBERS C + SUBI B,1 ; BACK OFF + +UHACK1: MOVE C,(P) + TLO B,UBIT ; TURN ON BIT INDICATING UVECTOR + MOVE D,1(B) ; DATUM + XCT A + SOSLE -1(P) ; COUNT DOEN + AOJA B,UHACK1 + TLZ UBIT + POP P,C + JRST VHACK1 + +; HERE TO HACK VARIOUS FLAVORS OF SPECIAL GOODIES + +SHACK: ANDI D,377777 ; KILL EXTRA CRUFT + CAIN D,SATOM + JRST ATHACK + CAIE D,STPSTK ; STACK OR + CAIN D,SPVP ; PROCESS + JRST GHACK1 ; TREAT LIKE GENERAL + CAIN D,SASOC ; ASSOCATION + JRST ASHACK + CAIG D,NUMSAT ; TEMPLATE MAYBE? + JRST BADV ; NO CHANCE + ADDI C,(B) ; POINT TO DOPE WORDS + SUBI D,NUMSAT+1 + HRLI D,(D) + ADD D,TD.LNT+1 + JUMPGE D,BADV ; JUMP IF INVALID TEMPLATE HACKER + + CAMN A,[PUSHJ P,SBSTIS] + JRST VHACK1 + +TD.UPD: PUSH P,A ; INS TO EXECUTE + XCT (D) + HLRZ E,B ; POSSIBLE BASIC LENGTH + PUSH P,[0] + PUSH P,E + MOVEI B,(B) ; ISOLATE LENGTH + PUSH P,C ; SAVE POINTER TO OBJECT + + PUSH P,[0] ; HOME FOR VALUES + PUSH P,[0] ; SLOT FOR TEMP + PUSH P,B ; SAVE + SUB D,TD.LNT+1 + PUSH P,D ; SAVE FOR FINDING OTHER TABLES + JUMPE E,TD.UP2 ; NO REPEATING SEQ + ADD D,TD.GET+1 ; COMP LNTH OF REPEATING SEQ + HLRE D,(D) ; D ==> - LNTH OF TEMPLATE + ADDI D,(E) ; D ==> -LENGTH OF REP SEQ + MOVNS D + HRLM D,-5(P) ; SAVE IT AND BASIC + +TD.UP2: SKIPG D,-1(P) ; ANY LEFT? + JRST TD.UP1 + + MOVE E,TD.GET+1 + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + MOVEM D,-6(P) ; SAVE ELMENT # + SKIPN B,-5(P) ; SKIP IF "RESTS" EXIST + SOJA D,TD.UP3 + + MOVEI 0,(B) ; BASIC LNT TO 0 + SUBI 0,(D) ; SEE IF PAST BASIC + JUMPGE 0,.-3 ; JUMP IF O.K. + MOVSS B ; REP LNT TO RH, BASIC TO LH + IDIVI 0,(B) ; A==> -WHICH REPEATER + MOVNS A + ADD A,-5(P) ; PLUS BASIC + ADDI A,1 ; AND FUDGE + MOVEM A,-6(P) ; SAVE FOR PUTTER + ADDI E,-1(A) ; POINT + SOJA D,.+2 + +TD.UP3: ADDI E,(D) ; POINT TO SLOT + XCT (E) ; GET THIS ELEMENT INTO A AND B + TLO A,UBIT ; INDICATE ITS A ANY + MOVEM A,-3(P) ; SAVE TYPE FOR LATER PUT + MOVEM B,-2(P) + GETYP C,A ; TYPE TO C + MOVE D,B ; DATUME + MOVEI B,-3(P) ; POINTER TO HOME + MOVE A,-7(P) ; GET INS + XCT A ; AND DO IT + MOVE C,-4(P) ; GET POINTER FOR UPDATE OF ELEMENT + MOVE E,TD.PUT+1 + SOS D,-1(P) ; RESTORE COUNT + ADD E,(P) + MOVE E,(E) ; POINTER TO VECTOR IN E + MOVE B,-6(P) ; SAVED OFFSET + ADDI E,(B)-1 ; POINT TO SLOT + MOVE A,-3(P) ; RESTORE TYPE WORD + MOVE B,-2(P) + XCT (E) ; SMASH IT BACK + JRST TD.LOS +TD.WIN: MOVE C,-4(P) + JRST TD.UP2 + +TD.LOS: SKIPN GCDFLG + FATAL TEMPLATE LOSSAGE + JRST TD.WIN + +TD.UP1: MOVE A,-7(P) ; RESTORE INS + SUB P,[10,,10] + MOVSI D,400000 ; RESTORE MARK/UNMARK BIT + JRST VHACK1 + +; FATAL LOSSAGE ARRIVES HERE + +BADV: FATAL GC SPACE IN A BAD STATE + +; HERE TO HACK SPECIAL CRUFT IN GENERAL VECTORS (STACKS) + +EHACK: JUMPE PVP,EHACKX + ADDI B,FRAMLN+1 ; SKIP THE FRAME + JRST GHACK1 + +EHACKX: HRRZ D,1(B) + CAILE D,HIBOT + JRST EHCK10 + PUSH P,1(B) + HRL D,(D) + MOVEI C,TVEC + CAME A,[PUSHJ P,SBSTIS] + XCT A ; XCT SUBSTITUTE + POP P,C ; RESTORE TYPE + HLLM C,1(B) ; SMASH BACK +EHCK10: ADDI B,1 + MOVSI D,-FRAMLN+1 ; SET UP AOBJN PNTR + +EHACK1: HRRZ C,ETB(D) ; GET 1ST TYPE + PUSH P,D ; SAVE AOBJN + MOVE D,1(B) ; GET ITEM + CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT + XCT A ; USER GOODIE + POP P,D ; RESTORE AOBJN + ADDI B,1 ; MOVE ON + SOSLE (P) ; ALSO COUNT IN TOTAL VECTOR + AOBJN D,EHACK1 + AOJA B,GHACK1 ; AND GO ON + +; TABLE OF ENTRY BLOCK TYPES + +ETB: TTB + TAB + TSP + TPDL + TTP + TWORD + +; HERE TO GROVEL OVER BINDING BLOCKS + +BHACK: MOVEI C,TATOM ; ALSO TREEAT AS ATOM + MOVE D,1(B) + CAME A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT + XCT A + PUSHJ P,NXTGDY ; NEXT GOODIE + PUSHJ P,NXTGDY ; AND NEXT + MOVEI C,TSP ; TYPE THE BACK LOCATIVE + SKIPGE D,1(B) + XCT A + PUSHJ P,BMP ; AND NEXT + PUSH P,B + HLRZ D,-2(B) ; DECL POINTER + MOVEI B,0 ; MAKE SURE NO CLOBBER + MOVEI C,TDECL + XCT A ; DO THE THING BEING DONE + POP P,B + HRLM D,-2(B) ; FIX UP IN CASE CHANGED + JRST GHACK1 + +; HERE TO HACK ATOMS WITH GDECLS + +GDHACK: CAMN A,[PUSHJ P,SBSTIS] + JRST GDHCK1 + + MOVEI C,TATOM ; TREAT LIKE ATOM + MOVE D,1(B) + XCT A + HRRZ D,(B) ; GET DECL + JUMPE D,GDHCK1 + CAIN D,-1 ; WATCH OUT FOR MAINFEST + JRST GDHCK1 + PUSH P,B ; SAVE POINTER + MOVEI B,0 + MOVEI C,TLIST + XCT A + POP P,B + HRRM D,(B) ; RESET + JRST GDHCK1 + + +; HERE TO HACK ATOMS + +ATHACK: JUMPN PVP,BUCKHK ; IF ONLY CHANGING ATOMS, IGNROE OBLIST + MOVEI C,TOBLS ; GET TYPE + HRRZ D,2(B) ; AND DATUM + JUMPE D,BUCKHK ; NOT ON OBLIST, SO FLUSH + CAMGE D,VECBOT + MOVE D,(D) ; GET REAL OBLIST POINTER + HRLI D,-1 + CAMN A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT + JRST VHACK1 + PUSH P,B + MOVEI B,0 + XCT A + POP P,B + HRRM D,2(B) +BUCKHK: CAMN A,[PUSHJ P,SBSTIS] ; DONT IF SUBSTITUTE DIFFERENT + JRST VHACK1 + HLRZ D,2(B) + JUMPE D,VHACK1 + PUSH P,B + PUSH P,D + MOVEI B,-1(P) ; FAKE OUT TO MUNG STACK +; HLRZ B,1(D) +; ANDI B,377777 +; SUBI B,2 +; HRLI B,(B) +; SUB D,B ; D NOW ATOM PNTR + MOVEI C,TATOM + XCT A +; HLRE B,D +; SUB D,B + POP P,D + POP P,B + HRLM D,2(B) + JRST VHACK1 + +; HERE TO HACK ASSOCIATION BLOCKS + +ASHACK: MOVEI D,3 ; COUNT GOODIES TO MARK + +ASHAK1: PUSH P,D + MOVE D,1(B) + GETYP C,(B) + PUSH P,D ; SAVE POINTER + XCT A + POP P,D ; GET OLD BACK + CAME D,1(B) ; CHANGED? + TLO E,400000 ; SET NON-VIRGIN FLAG + POP P,D + PUSHJ P,BMP ; TO NEXT + SOJG D,ASHAK1 + +; HERE TO GOT TO NEXT VECTOR + +VHACK1: MOVE B,-1(P) ; GET POINTER + SUB P,[2,,2] ; FLUSH CRUFT + SUBI B,2 ; FIX UP PTR + POPJ P, + +; HERE TO SKIP OVER MARKED VECTOR + +MKHAK: SUBI B,(C) ; POINT BELOW VECTOR + POPJ P, + +; ROUTINE TO GET A GOODIE + +NXTGDY: GETYP C,(B) +NXTGD1: MOVE D,1(B) + XCT A ; DO IT TO IT +BMP: SOS -1(P) + SOSG -1(P) + JRST BMP1 + ADDI B,2 + POPJ P, +BMP1: SUB P,[1,,1] + JRST VHACK1 + +REHASQ: JUMPL E,REHASH ; HASH TABLE RAPED, FIX IT + POPJ P, + + +MFUNCTION SUBSTI,SUBR,[SUBSTITUTE] + +;THIS FUNCTION CODED BY NDR IS AN INCREDIBLE WAY TO +;KILL YOURSELF, EVEN IF YOU THINK YOU REALLY KNOW WHAT +;YOU ARE DOING. +;IT DOES A MINI-GC CHANGING EACH REFERENCE OF THE +;SECOND ITEM TO A REFERENCE OF THE FIRST ITEM, HA HA HA. +;BOTH ITEMS MUST BE OF THE SAME TYPE OR +;IF NOT, NEITHER CAN BE A TYPE REQUIRING TWO WORDS +; OF STORAGE, AND SUBSTITUTION CANT BE DONE IN +; UVECTORS WHEN THEY ARE DIFFERENT, AS WELL AS IN +; A FEW OTHER YUCKY PLACES. +;RETURNS ITEM TWO--THE ONLY WAY TO GET YOUR HANDS BACK ON IT + + ENTRY 2 + + +SBSTI1: GETYP A,2(AB) + CAIE A,TATOM + JRST SBSTI2 + MOVE B,3(AB) ; IMPURIFY HASH BUCKET MAYBE? + PUSHJ P,IMPURI + GETYP A,(AB) ; ATOM FOR ATOM SUBS? + CAIE A,TATOM + JRST SBSTI2 ; NO + MOVE B,3(AB) ; SEE IF OLD GUY + HLRE A,B + SUBM B,A ; POINT TO DOPE + HRRZ A,(A) ; POSSIBLE TYPE CODE + JUMPE A,SBSTI2 ; NOT A TYPE, GO + MOVE B,1(AB) + HLRE C,B + SUBM B,C + HRRZ C,(C) ; GET OTHER POSSIBLE CODE + JUMPN C,BADTYP + PUSH P,A + PUSHJ P,IMPURI ; IMPURIFY FOR SMASH + POP P,A + MOVE B,1(AB) + HLRE C,B + SUBM B,C + HRRM A,(C) + +SBSTI2: GETYP A,2(AB) ; GET TYPE OF SECOND ARG + MOVE D,A + PUSHJ P,NWORDT ; AND STORAGE ALLOCATION + MOVE E,A + GETYP A,(AB) ; GET TYPE OF FIRST ARG + MOVE B,A + PUSHJ P,NWORDT + CAMN B,D ; IF TYPES SAME, DONT CHECK FOR ALLOCATION + JRST SBSTI3 + CAIN E,1 + CAIE A,1 + JRST SBSTIL ; LOOSE, NOT BOTH ONE WORD GOODIES + +SBSTI3: MOVEI C,0 + CAIN D,0 ; IF GOODIE IS OF TYPE ZERO + MOVEI C,1 ; USE TYPE 1 TO KEEP INFO FROM CLOBBERAGE + PUSH TP,C + SUBI E,1 + PUSH TP,E ; 1=DEFERRED TYPE ITEM, 0=ELSE + PUSH TP,C + PUSH TP,D ; TYPE OF GOODIE + PUSH TP,C + PUSH TP,[0] + CAIN D,TLIST + AOS (TP) ; 1=TYPE LIST, 0=ELSE + PUSH TP,C + PUSH TP,2(AB) ; TYPE-WORD + PUSH TP,C + PUSH TP,3(AB) ; VALUE-WORD + PUSH TP,(AB) + PUSH TP,1(AB) ; TYPE-VALUE OF THINGS TO CHANGE INTO + MOVE A,[PUSHJ P,SBSTIR] + CAME B,D ; IF NOT SAME TYPE, USE DIFF MUNGER + MOVE A,[PUSHJ P,SBSTIS] + MOVEI PVP,0 ; INDICATE NOT SPECIAL ATOM THING + PUSHJ P,GCHACK ; DO-IT + MOVE A,-4(TP) + MOVE B,-2(TP) + JRST FINIS ; GIVE THE LOOSER A HANDLE ON HIS GOODIE + +SBSTIR: CAME D,-2(TP) + JRST LSUB ; THIS IS IT + CAME C,-10(TP) + JRST LSUB ; IF ITEM CANT BE SAME CHECK FOR LISTAGE + JUMPE B,LSUB+1 ; WE GOT HOLD OF A FUNNY GOODIE, JUST IGNORE IT + MOVE 0,(TP) + MOVEM 0,1(B) ; SMASH IT + MOVE 0,-1(TP) ; GET TYPE WORD + SKIPE -12(TP) ; IF THIS IS A DEFFERABLE ITEM THEN WE MUST + MOVEM 0,(B) ; ALSO SMASH THE TYPE WORD SLOT + +LSUB: SKIPN -6(TP) ; IF WE ARE LOOKING FOR LISTS, LOOK ON + POPJ P, ; ELSE THATS ALL + TLNN B,.LIST. ; SEE IF A LIST + POPJ P, ; WELL NO LIST SMASHING THIS TIME + HRRZ 0,(B) ; GET ITS LIST POINTER + CAME 0,-2(TP) + POPJ P, ; THIS ONE DIDNT MATCH + MOVE 0,(TP) ; GET THE NEW REST OF THE LIST + HRRM 0,(B) ; AND SMASH INTO THE REST OF THE LIST + POPJ P, + +SBSTIS: CAMN D,-2(TP) + CAME C,-10(TP) + POPJ P, + SKIPN B ; SEE IF THIS IS A FUNNY GOODIE WE NO TOUCHIE + POPJ P, + MOVE 0,(TP) + MOVEM 0,1(B) ; KLOBBER VALUE CELL + MOVE 0,-1(TP) + HLLM 0,(B) ; KLOBBER TYPE CELL, WHICH WE KNOW IS THERE + POPJ P, + +SBSTIL: ERRUUO EQUOTE CANT-SUBSTITUTE-WITH-STRING-OR-TUPLE-AND-OTHER +BADTYP: ERRUUO EQUOTE SUBSTITUTE-TYPE-FOR-TYPE + +GHSTUP: HRRZ E,TYPVEC+1 ; SET UP TYPE POINTER + HRLI E,C ; WILL HAVE TYPE CODE IN C + SETOM 1(TP) ; FENCE POST PDL + PUSH P,A + MOVEI A,(TB) + PUSHJ P,FRMUNG ; MUNG CURRENT FRAME + POP P,A + POPJ P, + + +IMPURE + +; LOCATION TO REMEMBER PREVIOUS VALUES + +SVTAB: SVLOC1 +NXTTAB: SVLOC2 + +SVLOC1: 0 +SVLOC2: 0 + +PURE + +END + + \ No newline at end of file diff --git a//initm.bin.17 b//initm.bin.17 new file mode 100644 index 0000000000000000000000000000000000000000..a0e2df9669f08958c165b2ed3b54a303d2a8fbd9 GIT binary patch literal 57661 zcmeIbd0QIG^FG`Ri-@4OiX$RaN7RcqaMI z;OAV=AJ5^sQfa%ps_(wLdYv9%4fl-w{BjX*u|FI$`jj|&SMwqJ&;k!x9GkZy1x=2t zP98ElP7WoCGm`;Z^)3I?ROYgdQG&&B+jmMKqoX{P583QX6vdd$^TEl8Bhh}#f1yw=@InKaq`J7ph6O@oqj#EM=InG2N zq!X_pi1hu`|6T`C|Q zauy|2F2^aM3OTN#5TsL1a5}Em$5PM~CRWxx81Q4G3_Hp<>M)Lpj@vE@*%^T>J6>L= zETY32Et4RJzz(}2$9v4>1)oHZa2UQOv+(~2E3b=PV<^J1hc%LqO^A$@InKYYNf5~@ zD%*Z_V}Nyfcgk%n;)J-`8k@7C)?)Z^2VH8Sico66Pfkz0f9%;zUSgP4y3*0Y8Qq)Rg(# zp*CKjB=>7Q4S!O;^&fS8{fN&B?iOIX5YN1j?U!GKP)fE!_6FL)mAQE=l0pZVB^@;8 zasg&C2(^a8o#042#5FAho4wC!#$2eK8FRH`x1Rzc>WYv>a$C&5jev@=>V?*l5d06m zjj3(zP>~d7*=hgUcZc|@ehVh6(}?*vP2dTJ=7ss*QevZV_4-$UN^7Z$eKroG(W*n| zRZlM(1>KZjjwK!?u4`w^=q^uJ21Oj&DMXCB(ak7MY#+pgIYX}j4XmR*AH>ab19i}; z#S!So?>fF5P9i>+70O`iBc^;a`Y8)mx@jl0J3t_t=GK0+yeJ53d?-LY{Gi1QLdlT; zyhzpSL1->2s1F>(+?*A*Qy5~ViAeSCoB*C(lXZS!q5w2eYAGZ#BDSJ-DcjL3JtnE& zFzd;HZxiu}67ttNJnmZT!`TRhLFA??cPGR!n5seZqd`dJMS?fxeGXfH@WMLfj(64M2c1J^*fEsYNyFOcKPi)?u-vI^TE`P};1IC2@qCHnwg#4=4)_ zJm4O=T;J#8mUB7vvyzII7^ZG2<5f%DntzHC+Kw6$AsRN(Xj;O^=h2MRT3cz@q|Awp z=vvZW+cnfHYw$Hsp+-54ouwk_Kd`VwGlYbHk}d|=(0W56tY~0CpDCd)RdwT_(0}4T z2L5B2yZINQIpCw#wRFrSLpv$O4P)%W7inPpkSD zYjkJ|{j2&qAT(c49qun-dkyX<@%r(sVdBG9w0Iiz3Ha8^4b; zk>VnF2t(UzcP!B*!chq9+SW)|7I489%Y1a|YZf5{d4lZ)ils zcEeC`V=VW*3GtO!op5|2N|29lDB0k1NP^6`p)|Pd-_IsQ`qPSkrh0Cre%u5%PlQr+ zRwt7LI=mqCSXHYWDizxgVN-}Ze=1idqC|vUubJ{0Ad%trx)f6l6!+eJelD^GF93Ez z$(UeE;lT%zem=XlF&Nb z{9!&12%Kwc{NpC=YwOU>t|Z9IUFvyX>-vqJL#dBSDrUodt?QHGaK&}v+&_&r!1*6k z8a~VHRVPkHqMQARjrc-%a}&}Fdomm#LQ9RbWhU&{lTBEoC%Gr*Zc zlureQ>rtuOTYK`A+>@WEV%U>w_4H)G3?Jyp8Gg?Cuk~d9R0M|%fw?50xC+W`9iDPp zWiK}VqhEp}J@k(r4q}Z2puHYi20k=46*>~7I+aw+_CIl?`f3%USIiZ`0y@!E0HpFs zVz9t{>Z{3p-dB8beSDq>>Z_jJr@s2xeK23%eHO63I1#88e)&IhpL*!pfF29N)__Cf z&Ts3Vbhr;uzK~)MCc}DsoWP-F znG1(V{L_uPVh|oYyc!s-LqA&0WFFyqB+Ojs&+p~bP9+tykw3pz3NLD4tnXGankrn~ z&>TV~vgCF$zPO0tLZ^l&Q!pl0O%DF7ke#|)cIs}~sUct9sj1TB)LsJB>Ji?cxNdq?_&--S^CQk(p7x_bncDI6g4>>SF>%sq5zg@4T4XwY?AS-)#;`LTuk5+Lg3Ft)(xR1rKi+n z&G&tM;}tJ^4q65iMqw;T zU;+Q!AjE^KQCJJXr?3l66Wyh;iKiR63r)*iXj<+L}t*oL8zZ0HT3Kts{MOiXi_c+9`Jzo1_bft1G1WI zWTs*F!$INj0f$SR z>Tx*gdo+{|{JRbpBYf!DLo{aR9qxJalOMUjkzP66SP&ep28X#`w7|#278oxK##;j) z32}VRZ(6}c%Pe&tw<7gm$uN|GJ=c&Iwl8&cAKSi?0YCmp6SW72^#K^_1xVeB%pQZ4 z@go5yFSv7J{f(u8skX1LoZ2+(f~Riawx#IQX$kWcIyG%1DD_B5#cbr%wMy$3=hP=E zMw|cW)UmBlXf=$57mlJQfge=`Oet!U^2e80t6l(=wn9 zR~c}`V1;WR5RxPiJ_s4f+tEeK+-KnmzZimSuXIHbjx5$e!z4i>bDxE-_b4A3C41iu zqho2rR|-ujy)gerQ&3vZ^eZcb%76zy1nn=nq3D#FE~!zsGCLMN=iGD~2#8=G92?tZ zh_4!tff!u0fqEFe?ilIzj@$4}gmWo~qxBk5A_59~B}4`3Ph1Mw#da7dXr(2`IaEUB za-0&XkmD)>V3dy~Xw*pwxi8;-Zy>%Vs}rs)_PS?Gf=C4)9$nQ@mUriUC$osJ-DS};{eq7QUa%TP@bisaPQXW`Nnnc{UL z7=Vv2lLG?eqdQpxHVDy8taqTn5N_p|D{316`J1qCfs1J<-18KJIgRU!jV2<(m03UKdLZDVK_BzAu5=613`I_EZCSp(o%M}s? z@EDOuJf8*lJxC9&wIaSb)+&Mnpa$k;67~ZDuNWySGHOsd8fqO5kfyzjr%FsolBZxT_L|1{jvG|9T(r<`wHvk=xk2&?nU{CR9EOKEN z>vm`Z(Vhlgu+tfo{sxX>bz-CBhy$$o#E1mucY$oaOZ7)UZI6jC3P9=%r8X_JTJMLz z9$l2>_h_j`5X0P*@5DR)+mHB8DkSKB)Cve_V%G+4fgI#^!6=bEJF*OVm^!m(g|-#F z-MO4WfYq8G5`;at)M}t22Q!dQfx$z7kKv#t(4TTaGiiutWDl2b1~P>g)(n1N(%?N@ z`$+h%m=n6lo(;-aUv`36gb&if!jI~Cw+>?s2=Bw2xpgV{-ruMJ18pafZh5@E!UKwd_J2XbIgdaV)%*ElPJwdFG_cIwWiD}UpX z(utADHtLc>qd)6?hYVHK?fI8r+{iaFAHE=;<=r{>X%*(%dYG(RLVVTMRVT4J z#JN#Uc&8-5&2JzJ2hcri(7_;FB*m+-Mr@v0DzbWI=v@Tyb>Q-iHT8XJSQljyaS=EQ zadlZ-zp&b5dvb-;cs?)%Jpe49c7aR5$I3R~HmQN)@Ls8*t&6cPx?w8f86N&wE-r!w z!KJ&VB96s0MbqOJggZ;?U5a}*yj&S$4HJfb;2 zomWvC%I5D9nkq0_U8)$RBYDih@@M~IzQY=;R+~I!C@A$ZxD*}d+cZrN0Ghv(8f?=} zth7zT3jUBVvJlIQwj-Sqq z^pMct(8h}zmU{_p74lM|p^Yr#Rl$>T6dcRXsfS5Dyxfx-@?v@B#ch=^vH(lf4-HsK zhKC+MR-hoGN5Z4Us{@OhW(hp2I{q$WDOJJpT>};&G*Mn@LqS-w2RA1l^kAWP4hYM) zH)Ao|#wQc_kD#1we6}CF6^c!TmTwwpf%h7k#4;3wCDS()<@e9Exvm@5Zt%e-`YO{> zG?v{JpQj83$1)u4)ib=PVkwi*R-x;D)xt~aOU6}(f@2xI_s8|LQ5mTrFJEL{ipKKc z6tJM+So-STj>RsatwLVDXyIk|z~w4K!LbZ?#C7q4H-osp+{wH&OBh#(dTy>B(A7q2SXv~sRmjVc243)8AjyFO_1US>KclOSU^fIGb%Nm!rsI8IE1(;YB1h zOzAOMiyd;YrtZDx7&E{KtV>&SnqO$9xQ{ThFIWXiwN5S=+3x3c#UOE3zpcp zJMKV%`s{S|b4b_FGDK>KCHB9-;;IHLE`Fa0u*CT-9F5BbH7vst0xWE!*k5>g?#`wU z&Gw(D+Vjh{a;IxCH;igDs?eT+nny1TF~2D?;ZeOE1sOdThCk?9wWwj?Gg=`ftAC;7 z8H;(ly!y<6g0P%UFQi8Gxa~VqLswamU8PtoLX7zyY$(WRHg@PMdn*3l*0gK?T72nxVkkOB&qw_93ywGE2>PNK4EDFnWcQ)TRdDY5)-tSC*ek+Vc z6-p-mLWvCH`Wp{c{k*@s$lvkQwn$i%TZXPx5gU48i1|^aWH_)URiGfFN5cMbP7ft& zSeD3Ep~p`Ag%Sme^n+ClgUDk!fUk;xSxu|QE|D6JDl{+>FU4Yk?*zD;gx+&ENk-v2 zK$__8&0DZUB(zn?%ZsaTe?Ee`n*KQDKtWhe%QHPTJ-kFn4S5+uHR2^DVPqkeZVhc@ z+?hLfm7zd=mYFzyr)$lhA~nR)C1ZInVPqkeE)7_47P`Y(=#GryEJW8bw6@WEQbR1A zZ^j}-d%j)RP>|8=mc3?3PaCOW*_F^%AupX8coCvwrxP|5982k)tb`9iyD?a32hbf;?crOyl14whJs^>I_h`yw9y`^Auk;=FU4Xp?u7Qj zWhlsKW@0-+=Y3jzR}IU)gtiKK>CnInVA&l2EV~2GSXSEg@Ul;8$P1~_`10ZfBcA&C zxT;zM7Gb6O!DB-~YT5OPGF_|OD;Z0b+(w@yj4b4(N(+{V!{@P~Afwrxu)cG`Po##t zRK6WcXmNVRhJs@`*es>z30nO{4a>EJwhDQv)WXZseaUAV3XWyx=C)anzg&|V^5T?v zDH=<(XE6oi?joO9VBEdaH6N*AxsecHAulgq_QX{hRpHfRE0_Zon-NPhr2>{OOL};@ zAvNTMhHL6aZ@^*?02X^7kHvBR_*N{p651-{r9z9pEPiqH*idjR?|+{4>A`YKYRF6Z zv%j=32_p-zz+zE;&-jmPDIwZyT(_YhquH(Q`+Xf)`1u^}M2_fq5!Cd(6E8JAk}V1X z^;vdnyid3j=QQ@j1rnE#PaeL z)IX0eeIm0(LC`0=RWh%O7bB@5FTdn|R6LfUU07p+;8>E6D|*(LEoxXy651-{<(DRZ zY3&0nAUKw-wr*Wmc+(;;56`@G)cg~R{co==iuwJt05BF1%fd63uAe&kQ3qd|0+#)( zjHOluOI8yvy^G*4Ao5tOU-bA(M=hx#mdpPEmhnK&76rkvByS&?9$wV2)JbToz+dby z-^KlNKk6-+1YSxeIhL)`&-5~p#y;IqM{39mJx{^$rQ`7FyxFoby z$jgNWUf|i{N)nzet|SS|sd0e6hpN?IT%?A)&{qc%FJ1{F3$g5Iz#`0D+?Cr1B^+!h7Fv26K&>B7R7gNS8I9$$*bGA%(r z0>QB)GdVqHK^^c7+Hwr#aDX%8Oy=`k+%#5>a&cmYgX4Bz>g;oOHjr#E1{`EEI|$Z$b47-Bsx%_ zKHTXTG|ubs-C0sYEP*#;ft$N^VmS&jdNNfvRM)Q}hWt`w2`i(V{zPJ@>XzkZ6_;XQ-g?}xjGK|Nce4mB9_5@IW)MAATs5S`q; zfu+kXKSRkTua@y{v(`sP9rIW$ZtM4{RcXjA8q3l$JnTe4Mzg6ET@O1|u}BiyD&%Ee z3ooIC@255t9LqtfO4n3G#S$-bva2L0vJi`33zntCLA4D9$C8>`c(138_;YM*BO0lx zjn-ALym-0)kHeghIBC4Gq2O2+8}#`LKRrS${W32_V~OoA-`G%aEUR5vUB0V^WkZFR zel2a3Xc_)#L&32ubu{XE?AftFYRC(n@KGE653%Ulrm11sRN>|2w*0m(sL)^duWjIV3*8?gUi4ylUb>i1ycsfA`Cyu_zkVx>3l&OUes{&6hL)1y zrc1c>0)jqAMsI&k4;KDl9bKg!)rgW}u^3aXWT*@UVabdSZ2x#GmW+h93YQD@8eBz) zFHVRy6sXU#k@|R+<2(i^;j|~N3$*wL= z>snr_VR?|yRv|BDP5zQ&jkY)lj%Dd6N0%tI`pW~UAulG`U*3Ynj#%t67Cl$YJJhiJ zlF(KmFD5O#EV?I+HWVDoUZ+FX6Nz7>hP)VMUW&%DvhRAZq2O2&-D`SovUR9od6dvr zAumQPysR|OF&hf{WY@cOy-e8w&oAJEya>;{cc`u{I-+FA)%>4EO%OXiPT;*8w&blcSbt&%tsyvsUa4+TZ`jM@mQ8}2WcCM zJeG7&7cXj9$|bZ_$jfIfysR{gh&B|c4{g+6uL}!5Bu8FuWq&CeOMLJvv!UQvB2V?Y z+DHvcg@m>Wd4V4=d;ZC~Kh8%&c=txMp+J3>-S@TW;-!Mrke3^om!h$RmO_#Z1sTmA zB);q7MGcFSY!&kI;)nVE%u8H4O4(3wERlnmI95>OeB^PG8uCI*Q|d=5uRN6M9B9Ha-&kf_0+GjZv_g-Uwer#?W1&}Zh?nBA zSQmj85FE?HQfm!h#m`-L*N z4J72-Xv_Rd&#QwTH7p$}yzFb>1;2oy8NYy`nJS21z@X<=ou@X`$2Mo0~?Y}1k*eYa;+1$V)^6FP3iG1}jHFpOc1VeOSgx4SAtqiFhd%3w(LV zR1bW4$W#v*g)a{&qjPkPeY!^t%Y=ls3VB)5z>5G+0q*coz#Yc|j{@}EsOXs>HRNSc z9$z97Miyex@&*)Qc|qnWl*x1L)Js#sQ3cp1^ai^Z5536!HCEGLIYb#yIR ztM9JJyu6eBrC2Pc_ZvGSb`)gvd}L~!4vpV}WmScjcN%yxPq&Ur4itpt^mAK{t~r3u zW9TpR#EJX`E;PWWaD37729%IH7;CbjAS{=ej%u3xweqr0YKWy>ZlezpMiyde*T9SM z;CHqOzHKJUv1EEqdv#&?AY*BJGZrD*zq1SbfSp}3n%y!b=!Jc)yr^M0kkD2kFKrrl z5u&5bX&VaEXW8Vp#d$sB%K@oj8`0Bs@|U8qtTbG1!dcKIf0mkE@9Rsw70aQ701J5$ zweS*(G+o(HPzAFG@kqBGEQh3qytK;xQZ$z6P%pgg34&uu{`TtGAN8nVNlR#}ke5~s zycmy7v5GPjgeB9leU{e4OPbV>mlm0qTL~izv1ob&DmroCwxJ-S+2r*?SPzz4QbR1| zGM3L0Miycz*T4%rCSSBd8{sdb!v`Ldf1!gnt$q44sUa4+8AAQ&Em)2a%h5BIyIDQF zsA0L2&{iQY4voB=BNqOQ8F;zVbCscoFO!iMx}`$A6pbaq?z?O#I4?T~6>rA!MTHl; z7GB^Rf$TOE9LwtG@P(c>`a){R3w9V2VyzE@{>v=Ze<7$XSegn$apn~OG124wC4?9z3CsLDIUvo^Ao&{)tnz+l9!9R#uqg#O)9*cYT(7Z0_QCb6!bY= zA1={z&fw$QaP*fGd2TEk%X$ACbD-c@n#{WHoTy@Hme5wgde?lSffvg}a8N2of%@$D z`(BGKUYbb_c{!GO>60+B5Q~;KpiJu}amkJX_1Sqik=BK!kJJ#$hK!|O!pK4_8ya{q zJL1Dv4isecY&FoRXFu)ZLjhu0e=`=L`8brep&%?D2O7W6qfxDWS`Ev9gtiKKS=Yi# zc}2a^fr7A{tpwKf+#~Z1kQ(xmka;NRIX7=|~M4~EGoys5mP=b4R94GSM13VDfZ z;DrUBet);3AS~BM$EIpMzB?%MvL^eBBw=JB7A>zqnR+{7Q+5<&^rF&rrfbbW#o}GR zE%`MlUw|SDvCL`U#q@r(#bZZ7Sk6bjE$F#3>*H>QSm>yP{H16t6QNX{9RRMw7qR zu}%$3NJ3kMyi9B1CF-hyZwUf{`tU75{%u`rh7hSCFH_IF_>&Sw7GQy&*U@kXa`Ewp z*M@?OX5XJz>UrMiPm&s7N%&+eTM|YVV)1FjGJ{xV$S7jb^L*OBMQVtp=YN7FfmjmH zSe%DwRHMJBV%e6^Rv|AvT6hUf|BBd9a4ZKItDbXj|2C;1FJ76KqOrtmHaH6c!Lh_v zvU+@170V9UD&z%zZutMczZ;jn&cZ#_ud^IW!!uZHEL3NJOZccBo=DPlQ& z#*)$VPNAQltsxdV=A$|xeE8Ov56$i}gyDprL^-DOVy%>@!N^Hyt8nQ8->3M0yUJuX+u=Zg`t0qd+L^{9U{B^hPX$jBLH+8_$oE)~J;8^_0 z9X-<`KY799jyP2Tc^P!7VA1j#lqp$m8n&b0Smqag=)&S8HN+yn1~pizg5_ERFYp7z z&8KjL+02JIIKo`ibM!J;DP#Hc>@P)QG1fnH2Fg&7(aZ6VBYKVvRk2j5@bXC$FV3oA zM>z<>a<($Rr{~ykuuA5Iz7&Q0rD!avo-d6K6lC;t+}^OPqaUeasaE0TN&_#Z{e9bw z9R*=IAL!2NIg%QzmU;Oo`%AG{gq7Aiiwy-C&8~}0dX9nqfu+1|%|G>um$rvX7FKwH zAN@Vz-r084&@#*Lw-`x-bP2}LdPCxcMm7GDFeN~TJ+Z-0FEjR=%^8?E`Qvnn|Fkh| z8zw~&GMSU17Wh44D`W3Y;n$RFlR;1Zw~R5BvAKZYgH-qhW5`1Jlt0awS^1geS~NA% z4obCHP(?yyY(#=T&D+O^tGrwjlv^WB3|;iKKtlAO^k4$Gm$LfEu-8yO)Pbdqw!0 zGJ{>HAn>vPnVbD$5dQ4+x6k8GYcprX!Ywn>MGf=V?I+$IrmT}+t6D)-@(2o{FtnJm zmAjJ}rx-9Q*Q=Gw&C1ncduVHlKiw=l$gDnFuH2ot9PDI_;vBall{v?4m7y04Vx&QF zhcgTAb=Kfyb%8ols!GX1=3l8%;jiKd8pQ?f!Lnk&lr`V?!4ieByI`z^Uh`Lpv7>L(dvJMkkQuQuUDRBZO8KDUU_K{fE5r4zRB6hmhT!E_ZQgb@ zqSL}JXqN=ecG(0tm-)6gAuVGZv7r!KHTW66dd&q{sHw5Y8YVy$2oNeTZ|Aqx{KZtX zEMc6&X?t5`?XEIB?PB(mq0%5B`q{9l9#9VUyyd-wZ^_V0+f<|Tj`$%e*T_;Lm#Y^A(OI92$B_T1mxh_m>gN%O1nxKO; zbn0*r#0(#BkY##Y^RGF`sJzix&Tn)ClhsLUZ)G|Ca*6%?MxU}2SC;2^Q0O$_?u2h2 z1XzF9V?Bl>#^!1Dj~fJo9M{*1%gbKKVX#6I!TtzDKCUG9q*xgnzx#B|aH9hmehXxv zUV1k5Dntbdm$tG-c^9)ldnPOM7#MAwn!3H6Q-9qlh17OR5d>Mdqlz@QudjNnUv^It zh|g&NP)^z@d0|ImmJzJVd#2aBCo(`ngjFrpFd)FsL@?$a`99Ss;+oNGD#`s?_W(P% z{i+|pIHGAbQk%+DeSqvL)NoXhwXE2B*p3{L}U@rdH{~`mRgBL6v)b zyJc6UmRor-7 z&iYfZhh0sm$0A3A`NH>QS2NdJ*AnX6Ou4Mv2$V(7$gg~v{S4;IlT zsS5k~p9v!aBwl$5xdr%6K+xkGnP&XC@i7UY5mI1}k2D#DgVaLvmp#N6GTZ}eZCxc# zaE1aX&C`hk-s#e(FpC_WG6NeY18HcZfi7mq4PevOVm?-7VpYC#_>(*v`)X-n@40OH z5ZHZoOmHR4^5TdFV)*B3Hwyu|wLVX{nl9j=;+CzIg8vDx)KKS6_P?4v_|q^bF=GzK zUEz5=g*d_j9ZXW(8ypkb>=0|(o`x(#9-yZX^8=nGF)}ZDQV_%s3`S8x52G2x#TI`| zv?IQh)#P2y$x1l3D?Xlc8xDO_Bp}PPdkf&+koh)EnID~EsQ|QRB_ftM;QgZ& z7_RrgUU>ji4KGZI@HhP#fB+8-oroB$$x#vWNh|0&)yI%X32+Of-%w&W~y@#(Q)wMn`7+DD3t;ak&pz z4E=|d3qy!61BFWPU4s^8p`ic`cu9js5GrVRkwHP|)O5&3rb=+|2;ki9h>!blZ(taL zklBu*4#&oXhrBl6*!nr%gmDH(yf=}+(3m6jlm8HM4?O`b!?`gQT1}-=1A(Ol$O031 z_Gsh=@xc#X&9PPoPAvH>oB1pb9CDxI!d$Hky`8nP3MrouPSK$Ob7Th0)6ba$+f;@P z$Dw>&D7;V+6e${pO>B7jxbYzGlYEfJPa#A&vRb$QuA=$lfx+-9;0acAH;|0R*9L5? zse6c7b4b1WYPQXja z$tTz=8(I@FGueB7*yrF07!T(TQncb*G6(b-jFJFi&o_T`ru6cpucG{=x-WY zchvbDY&E{Q8CVMU_b=L&|! zU_2QS2@mOGZ8<(HVaqU86+mz}b3YpaV)8Xuh(k5PsbqL9vR zQb8et>Qzxp5*N2tSJ627mLS(*X*C`M$~F_gb9iHMHNInGbTa=5kLTAhJB09OU4dbG z7!a%)9jifbLzu|W=U!945Lio!vA{}LT#Tl+5+GNJU=~65RN4vJv9t!a>LO{x6XCVj z8iXZ^4xpgQ1A;gS{y|@a!9{^FGqZfZjre9Tktq&AW$bK3lVLHwl@ym2u+8zK0D6T5 zIzD5NPsR_KX$8#z;fSS_t5y(NXRk_YTJGNejrgLFRx13l@Ym(y`t?QOI5d*^zaw~6 z_^Z;$fWkc$d6oM0u!;D#4DegfEZ=gFla@;E+4cU20%Hv4_A!qO4rp!x7?3Q_rO$-8lBYDqJad0lYmdZYH-D7qQ6|4itP#fsG)HJ>o)q zbv3+@1dohvim~YCW^`>S?vDCv|315A7z>U;4m0j;RU6OK2(UBh4v%Ugdg_rxNA)Q_o&_LFZfE=K$qgHLjV)ob^Xga{On{h?^pgu+JS>h-Sx=3t$^pQaZNr%9I*W*dJV zztE^cqmRI3xb^@b|cel9wsS?&sU9cvzFq?5Gc-@1c{a~_YRU{4b zcDg!(`F4#%tMBPnOM|fgcnDLt#n8O4+}7`hL<@L?2v;>B5HM$(Q!uAk*jM9T@|c!b z{lei0zTazMBj!ZSgoySkEQ6numk?)Il*`?_P8;WHIljzbX(^_>KZ4^LNNKRgmxBA%Twrt*W6gsU+P0ETjr#zB8`?8 zgw~FRG{#*hmd&G)1l6r`dcOYYi0~P`n=@1+$mu5EAG>8~?YL5N7 ziz2>|a3FA`S1-zy$}D7Mz&LdJVFop3&7+wr+BA-vNB3(cFs{SA?)Ez|)C)`|NTbXc zSZgL!lg6Q_m1>kQ`K~qsgfEy|+slmLqRr?{3JKIT84ou;!2cGuge^FMA)kWJygGh! ziuuxzdU}PagC_5~hw8@6b9dq;#(fB1RpCN_34S;zbz~vVPzhzU5I(ax5#M@5D;vgM zX%zMf7Uoj$jh0lLo%8mcyhxB`mpL;~+k;jbjWv@_s&7mPH1~#@yW65|o)+r)p z`}NOXtN&!qLj}xFI7o$9`5*>rY_2 zk#D#V3)Q2~lCU{Y*AOt-?$S{#{ zNLob0h8L}@2`lXus`&(re>GIbt?=Y&%%Hsy;o?&|g`pnv#`rhV?GhsKhCz&LR8WN` zj+<%uzX~mhX7plqw9qX+U?O9|r2ib&Y0xym+R-*|r3gX943A|j zY#92WNPXt6FCcY6+sBQF^<$A0HWNAvdFH!63lOq~%v zj3dl_knbybqSd@s$;VTV&{`X$)Njx)pD~Xwi3}0c1(UFU9)x+c^^#$+p4>j1cBH~eqk%Z3 z_T@+iTDInw2p`Oshe<4V2746wbFG5eyd8eugS>n~%+y+dIbDPK44;i&6YqJ$u#UJO zh7!gPt5!H*v=||G1!fl$f{A z@D$l%xO;&V)-S|CwQ=v;BbH%UeSr!_0qWDE!qKIb5cHWhr}`)~XX?0>$mYWT+6x2E4jR$@@v*(xIS2^W`lUes7e1RpWZkMlm& zV;ua{h3pzGVV%ga3=6~d`7~-&nzv(ozU&f0Qif`|2=xIH;YIuMdVohHMARr(>S62=9({Zp^T~HbP^FTv#=D-_g@?j zussath_44jHt27B1>l6y(MX)0gAdgc2hFhlkIMs#56_nyQ) zeDwg1&oZiJ48c5OVI7Ey{9qdyx#z=WfVLO0e8zjJw1Y1(jwMmIinab)YAr eml(3JI~gO7bqN1`{$t=j2L5B/initm.mid.371 b//initm.mid.371 new file mode 100644 index 0000000..1134e59 --- /dev/null +++ b//initm.mid.371 @@ -0,0 +1,1360 @@ +TITLE INITIALIZATION FOR MUDDLE + +RELOCATABLE + +HTVLNT==3000 ; GUESS OF TVP LENGTH + +LAST==1 ;POSSIBLE CHECKS DONE LATER + +.INSRT MUDDLE > + +SYSQ +XBLT==123000,, +GCHN==0 +IFE ITS,[ +FATINS==.FATAL" +SEVEC==104000,,204 +.INSRT STENEX > +] + +IMPURE + +OBSIZE==151. ;DEFAULT OBLIST SIZE + +.LIFG +.LOP .VALUE +.ELDC + +.GLOBAL SHRRM,SHRLM,SMOVEM,SSETZM,SXBLT,SHLRZ +.GLOBAL SETUP,TPBAS,GCPDL,GCPVP,PVBASE,PVLNT,PARNEW,AAGC,ICR,SWAP,OBLNT,MSGTYP,POPUNW +.GLOBAL ICLOS,OCLOS,GLOBASE,GLOBSP,PARBOT,PARTOP,CODTOP,START,BEGIN,VECBOT,VECTOP,TPBASE +.GLOBAL LISTEN,ROOT,INITIAL,TBINIT,TOPLEV,INTOBL,ERROBL,MUDOBL,TTYOPE,RESFUN,QUITTER +.GLOBAL IOINS,BUFRIN,IOIN2,ECHO,MTYI,MTYO,IMTYO,MUDSTR,P.TOP,TTICHN,TTOCHN,TYPVEC,SQDIR +.GLOBAL PDLBUF,PHIBOT,%UNAM,PURVEC,STOSTR,ISTOST,TD.LNT,TD.PUT,TD.GET,CAFRE1 +.GLOBAL FRETOP,LPUR,SQBLK,REALGC,INTDIR,AGCLD,PAGEGC,TD.AGC,TVSTRT,REALTV,PVSTOR +.GLOBAL GCSTOP,SPSTOR,DSTORE,SQBYTE,INBYTE,GCBYTE,FRSTCH,OPSYS,IJFNS,GETJS +.GLOBAL HASHTB,ILOOKC + +LPUR==.LPUR ; SET UP SO LPUR WORKS + +; INIITAL AMOUNT OF AFREE SPACE + +STOSTR: +LOC TVSTRT-1 +ISTOST: TVSTRT-STOSTR,,0 + + BLOCK HTVLNT ; TVP + +SETUP: MOVEI 0,0 ; ZERO ACS + MOVEI 17,1 + BLT 17,17 + +IFN ITS, .SUSET [.RUNAM,,%UNAM] ; FOR AGC'S BENFIT + MOVE P,GCPDL ;GET A PUSH DOWN STACK +IFN ITS, .SUSET [.SMASK,,[200000]] ; ENABLE PDL OVFL + MOVE 0,[TVBASE,,TVSTRT] + BLT 0,TVSTRT+HTVLNT-3 ; BLT OVER TVP +IFE ITS, PUSHJ P,TWENTY ; FIND OUT WHETHER IT IS TOPS20 OR NOT + PUSHJ P,TTYOPE ;OPEN THE TTY + AOS A,20 ; TOP OF LOW SEGG + HRRZM A,P.TOP + SOSN A ; IF NOTHING YET +IFN ITS, .SUSET [.RMEMT,,P.TOP] +IFE ITS, JRST 4, + MOVE A,P.TOP + SUB A,FRETOP ; SETUP FOR GETTING NEEDED CORE + SUBI A,3777 + ASH A,-10. ; TO PAGES + HRLS A ; SET UP AOBJN + HRRZ 0,P.TOP + ASH 0,-10. + SUBI 0,1 + HRR A,0 +IFN ITS,[ + .CALL HIGET ; GET THEM + FATAL INITM--CORE NOT AVAILABLE FOR INITIALIZATION + ASH A,10. ; TO WORDS + MOVEM A,P.TOP + SUBI A,2000 ; WHERE FRETOP IS + MOVEM A,FRETOP + +] +IFE ITS,[ + MOVE A,FRETOP + ADDI A,2000 + MOVEM A,P.TOP +] + HRRE A,P.TOP ; CHECK TOP + TRNE A,377777 ; SKIP IF ALL LOW SEG + JUMPL A,PAGLOS ; COMPLAIN + MOVE A,HITOP ; FIND HI SEG TOP + ADDI A,1777 + ANDCMI A,1777 + MOVEM A,RHITOP ; SAVE IT + MOVEI A,200 + SUBI A,PHIBOT + JUMPE A,HIBOK + MOVSI A,(A) + HRRI A,200 +IFN ITS,[ + .CALL GIVCOR + .VALUE +] +HIBOK: MOVEI B,[ASCIZ /MUDDLE INITIALIZATION. +/] + PUSHJ P,MSGTYP ;PRINT IT + MOVE A,CODTOP ;CHECK FOR A WINNING LOAD + CAML A,VECBOT ;IT BETTER BE LESS + JRST DEATH1 ;LOSE COMPLETELY +SETTV: MOVE PVP,[-PVLNT*2,,GCPVP] ;AND A PROCESS VECTOR + MOVEM PVP,PVSTOR+1 + MOVEM PVP,PVSTOR+1-TVSTRT+TVBASE + MOVEI A,(PVP) ;SET UP A BLT + HRLI A,PVBASE ;FROM PROTOTYPE + BLT A,PVLNT*2-1(PVP) ;INITIALIZE + MOVE TP,[-ITPLNT,,TPBAS] ;GET A STACK FOR THIS PROCCESS + MOVEI TB,(TP) ;AND A BASE +IFN ITS, HRLI TB,1 +IFE ITS, HRLI TB,400001 ; FOR MULTI SEG HACKING + SUB TP,[1,,1] ;POP ONCE + +; FIRST BUILD MOBY HASH TABLE + + MOVEI A,1023. ; TRY THIS OUT FOR SIZE + PUSHJ P,IBLOCK + MOVEM B,HASHTB+1-TVSTRT+TVBASE ; STORE IN TVP POINTER + HLRE A,B + SUB B,A + MOVEI A,TATOM+.VECT. + HRLM A,(B) + +; ALLOCATE SOME OBLISTS FOR INITIAL ATOMS + + PUSH P,[5] ;COUNT INITIAL OBLISTS + + PUSH P,OBLNT ;SAVE CURRENT OBLIST DEFAULT SIZE + +MAKEOB: SOS A,-1(P) + MOVE A,OBSZ(A) + MOVEM A,OBLNT + MCALL 0,MOBLIST ;GOBBLE AN OBLIST + PUSH TP,$TOBLS ;AND SAVE THEM + PUSH TP,B + MOVE A,(P)-1 ;COUNT DOWN + MOVEM B,@OBTBL(A) ;STORE + JUMPN A,MAKEOB + + POP P,OBLNT ;RESTORE DEFAULT OBLIST SIZE + + MOVE C,[-TVLNT+2,,TVBASE] + MOVE D,[-HTVLNT+2,,TVSTRT] + +;MAIN INITIALIZE LOOP - SCAN XFER VECTOR FOR ATOMS, UPDATE +;OFFSETS IN CODE, UNIQUIFY ATOMS AND COMPACT XFER VECTOR + +ILOOP: HLRZ A,(C) ;FIRST TYPE + JUMPE A,TVEXAU ;USEFUL STUFF EXHAUSTED + CAIN A,TCHSTR ;CHARACTER STRING? + JRST CHACK ;YES, GO HACK IT + CAIN A,TATOM ;ATOM? + JRST ATOMHK ;YES, CHECK IT OUT + MOVE A,(C) ;MOVE TO NEW HOME (MAY BE SAME) + MOVEM A,(D) + MOVE A,1(C) + MOVEM A,1(D) +SETLP: AOS (P) ;COUNT NUMBER OF PAIRS IN XFER VECTOR + ADD D,[2,,2] ;OUT COUNTER +SETLP1: ADD C,[2,,2] ;AND IN COUNTER + JUMPL C,ILOOP ;JUMP IF MORE TO DO + +;NEW XFER VECTOR FINISHED, NOW GIVE AWAY THE REST + +TVEXAU: HLRE B,D ; LEFT HALF OF AOBJN + MOVNI TVP,HTVLNT-2 ; CALCULATE LENGTH OF TVP + SUB TVP,B ; GET -LENGTH OF TVP IN TVP + HRLS TVP + HRRI TVP,TVSTRT ; BUILD A TASTEFUL TVP POINTER + MOVNI C,TVLNT-HTVLNT+2(B) ; SMASH IN LENGTH INTO END DOPE WORDS + HRLM C,TVSTRT+HTVLNT-1 + MOVSI E,400000 + MOVEM E,TVSTRT+HTVLNT-2 + HLRE C,TVP + MOVNI C,-2(C) ; CLOBBER LENGTH INTO REAL TVP + HLRE B,TVP + SUBM TVP,B + MOVEM E,(B) + HRLM C,1(B) ; PUT IN LENGTH + MOVE PVP,PVSTOR+1 + MOVEM TVP,REALTV+1(PVP) + + +; FIX UP TYPE VECTOR + + MOVE A,TYPVEC+1 ;GET POINTER + MOVEI 0,0 ;FOR POSSIBLE NULL SLOTS + MOVSI B,TATOM ;SET TYPE TO ATOM + MOVEI D,400000 ; TYPE CODE HACKS + +TYPLP: HLLM B,(A) ;CHANGE TYPE TO ATOM + MOVE C,@1(A) ;GET ATOM + HLRE E,C ; FIND DOPE WORD + SUBM C,E + HRRM D,(E) ; STUFF INTO ATOM + MOVEM C,1(A) + ADDI D,1 + ADD A,[2,,2] ;BUMP + JUMPL A,TYPLP + + ; CLOSE TTY CHANNELS +IFN ITS,[ + + .CLOSE 1, + .CLOSE 2, +] + +;GENERAT THE LOGICAL TTY IN AND OUT CHANNELS + +;SETUP CALL TO OPEN OUTPUT TTY CHANNNEL + + IRP A,,[[PRINT,TCHSTR],[TTY:,TCHSTR]] + IRP B,C,[A] + PUSH TP,$!C + PUSH TP,CHQUOTE B + .ISTOP + TERMIN + TERMIN + + MCALL 2,FOPEN ;OPEN THE OUT PUT CHANNEL + MOVEM B,TTOCHN+1 ;SAVE IT + +;ASSIGN AS GLOBAL VALUE + + PUSH TP,$TATOM + PUSH TP,IMQUOTE OUTCHAN + PUSH TP,A + PUSH TP,B + MOVE A,[PUSHJ P,MTYO] ;MORE WINNING INS + MOVEM A,IOINS(B) ;CLOBBER + MCALL 2,SETG + +;SETUP A CALL TO OPEN THE TTY CHANNEL + + IRP A,,[[READ,TCHSTR],[TTY:,TCHSTR]] + IRP B,C,[A] + PUSH TP,$!C + PUSH TP,CHQUOTE B + .ISTOP + TERMIN + TERMIN + + MCALL 2,FOPEN ;OPEN INPUTCHANNEL + MOVEM B,TTICHN+1 ;SAVE IT + PUSH TP,$TATOM ;ASSIGN AS A GLOBAL VALUE + PUSH TP,IMQUOTE INCHAN + PUSH TP,A + PUSH TP,B + MOVE C,BUFRIN(B) ;GET AUX BUFFER PTR + MOVE A,[PUSHJ P,MTYI] + MOVEM A,IOIN2(C) ;MORE OF A WINNER + MOVE A,[PUSHJ P,IMTYO] + MOVEM A,ECHO(C) ;ECHO INS + MCALL 2,SETG + MOVEI A,3 ;FIRST CHANNEL AFTER INIT HAPPENS + MOVEM A,FRSTCH + +;GENERATE AN INITIAL PROCESS AND SWAP IT IN + + MOVEI A,TPLNT ;STACK PARAMETERS + MOVEI B,PLNT + PUSHJ P,ICR ;CREATE IT + MOVE PVP,PVSTOR+1 + MOVE 0,SPSTO+1(B) + MOVEM 0,SPSTOR+1 + MOVE 0,REALTV+1(PVP) + MOVEM 0,REALTV+1(B) ; STUFF IN TRANSFER VECTOR POINTER + MOVEI 0,RUNING + MOVEM 0,PSTAT"+1(B) + MOVE D,B ;SET UP TO CALL SWAP + JSP C,SWAP ;AND SWAP IN + MOVEM PVP,MAINPR" ;SAVE AS THE MAIN PROCESS + PUSH TP,[TENTRY,,TOPLEV] ;BUILD DUMMY FRAME + PUSH TP,[1,,0] + MOVEI A,-1(TP) + PUSH TP,A + PUSH TP,SPSTOR+1 + PUSH TP,P + MOVE C,TP ;COPY TP + ADD C,[3,,3] ;FUDGE + PUSH TP,C ;TPSAV PUSHED + PUSH TP,[TOPLEV] + HRRI TB,(TP) ;SETUP TB +IFN ITS, HRLI TB,2 +IFE ITS, HRLI TB,400002 + ADD TB,[1,,1] + MOVE PVP,PVSTOR+1 + MOVEM TB,TBINIT+1(PVP) + MOVSI A,TSUBR + MOVEM A,RESFUN(PVP) + MOVEI A,LISTEN" + MOVEM A,RESFUN+1(PVP) + PUSH TP,$TATOM + PUSH TP,IMQUOTE THIS-PROCESS + PUSH TP,$TPVP + PUSH TP,PVP + MCALL 2,SETG + +; FIND TVP OFFSET FOR THE ATOM 'T' FOR TEMPLATE + + MOVEI A,IMQUOTE T + SUBI A, +TVTOFF==0 + ADDSQU TVTOFF + + MOVEM A,SQULOC-1 + + PUSH TP,$TATOM + PUSH TP,IMQUOTE TVTOFF,,MUDDLE + PUSH TP,$TFIX + PUSH TP,A + MCALL 2,SETG + +; HERE TO SETUP SQUOZE TABLE IN PURE CORE + + PUSHJ P,SQSETU ; GO TO ROUTINE + + PUSHJ P,DUMPGC + MOVEI A,400000 ; FENCE POST PURE SR VECTOR + HRRM A,PURVEC + MOVE A,TP + HLRE B,A + SUBI A,-PDLBUF(B) ;POINT TO DOPE WORDS + MOVEI B,12 ;GROWTH SPEC + IORM B,(A) + MOVE PVP,PVSTOR+1 + MOVE 0,REALTV+1(PVP) + HLRE E,0 + SUBI 0,-1(E) + HRRZM 0,CODTOP +IFE ITS, PUSHJ P,GETJS + PUSHJ P,AAGC ;DO IT + AOJL A,.-1 + MOVE PVP,PVSTOR+1 + MOVE A,TPBASE+1(PVP) + SUB A,[640.,,640.] + MOVEM A,TPBASE+1(PVP) + +; CREATE LIST OF ROOT AND NEW OBLIST + + MOVEI A,5 + PUSH P,A + +NAMOBL: PUSH TP,$TATOM + PUSH TP,@OBNAM-1(A) ; NAME + PUSH TP,$TATOM + PUSH TP,IMQUOTE OBLIST + PUSH TP,$TOBLS + PUSH TP,@OBTBL1-1(A) + MCALL 3,PUT ; NAME IT + SOS A,(P) + PUSH TP,$TOBLS + PUSH TP,@OBTBL1(A) + PUSH TP,$TATOM + PUSH TP,IMQUOTE OBLIST + PUSH TP,$TATOM + PUSH TP,@OBNAM(A) + MCALL 3,PUT + SKIPE A,(P) + JRST NAMOBL + SUB P,[1,,1] + +;Define MUDDLE version number + MOVEI A,5 + MOVEI B,0 ;Initialize result + MOVE C,[440700,,MUDSTR+2] +VERLP: ILDB D,C ;Get next charcter digit + CAIG D,"9 ;Non-digit ? + CAIGE D,"0 + JRST VERDEF + SUBI D,"0 ;Convert to number + IMULI B,10. + ADD B,D ;Include number into result + SOJG A,VERLP ;Finished ? +VERDEF: + PUSH TP,$TATOM + PUSH TP,IMQUOTE MUDDLE + PUSH TP,$TFIX + PUSH TP,B + MCALL 2,SETG ;Make definition +OPIPC: +IFN ITS,[ + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE IPC + PUSH TP,$TATOM + PUSH TP,MQUOTE IPC-HANDLER + MCALL 1,GVAL + PUSH TP,A + PUSH TP,B + PUSH TP,$TFIX + PUSH TP,[1] + MCALL 3,ON + MCALL 0,IPCON +] + +; Allocate inital template tables + + MOVEI A,10 + PUSHJ P,CAFRE1 + MOVSI A,(B) + HRRI A,1(B) + SETZM (B) + BLT A,7(B) + ADD B,[10,,10] ; REST IT OFF + MOVEM B,TD.LNT+1 + MOVEI A,10 + PUSHJ P,CAFRE1 + MOVEI 0,TUVEC ; SETUP UTYPE + HRLM 0,10(B) + MOVEM B,TD.GET+1 + MOVSI A,(B) + HRRI A,1(B) + SETZM (B) + BLT A,7(B) + MOVEI A,10 + PUSHJ P,CAFRE1 + MOVEI 0,TUVEC ; SETUP UTYPE + HRLM 0,10(B) + MOVEM B,TD.PUT+1 + MOVSI A,(B) + HRRI A,1(B) + SETZM (B) + BLT A,7(B) + MOVEI A,10 + PUSHJ P,CAFRE1 + MOVEI 0,TUVEC ; SETUP UTYPE + HRLM 0,10(B) + MOVEM B,TD.AGC+1 + MOVSI A,(B) + HRRI A,1(B) + SETZM (B) + BLT A,7(B) + +PTSTRT: MOVEI A,SETUP + ADDI A,1 + SUB A,PARBOT ;FIND WHERE PAIRS SHOULD GO + MOVEM A,PARNEW + +; PURIFY/IMPURIFY THE WORLD (PDL) + +IFN ITS,[ +PURIMP: MOVE A,FRETOP + SUBI A,1 + LSH A,-12 + MOVE B,A + MOVNI A,1(A) + HRLZ A,A + DOTCAL CORBLK,[[1000,,310000],[1000,,-1],A] + FATAL INITM -- CAN'T IMPURIFY LOW CORE + MOVEI A,PHIBOT + ADDI B,1 + SUB A,B + MOVNS A + HRL B,A + DOTCAL CORBLK,[[1000,,0],[1000,,-1],B] + FATAL INITM -- CAN'T FLUSH MIDDLE CORE + MOVE A,[-<400-PHIBOT>,,PHIBOT] + DOTCAL CORBLK,[[1000,,210000],[1000,,-1],A] + FATAL INITM -- CAN'T PURIFY HIGH CORE +] + +IFE ITS,[ + MOVEI A,400000 + MOVE B,[1,,START] + SEVEC +] + PUSH P,[15.,,15.] ;PUSH A SMALL PRGRM ONTO P + MOVEI A,1(P) ;POINT TO ITS START + PUSH P,[JRST AAGC] ;GO TO AGC + PUSH P,[MOVE PVP,PVSTOR+1] + PUSH P,[MOVE B,PSTO+1(PVP)] ;GET SAVED P + PUSH P,[SUB B,-14.(P)] ;FUDGE TO POP OFF PROGRAM + PUSH P,[MOVEM B,PSAV(TB)] ;INTO FRAME + PUSH P,[MOVE B,TPSTO+1(PVP)] ;GET TP + PUSH P,[MOVEM B,TPSAV(TB)] ;STORE IT + PUSH P,[MOVE B,SPSTOR+1] ;SP + PUSH P,[MOVEM B,SPSAV(TB)] + PUSH P,[MOVEI B,TOPLEV] ;WHERE TO GO + PUSH P,[MOVEM B,PCSAV(TB)] +IFN ITS, PUSH P,[MOVSI B,(.VALUE )] +IFE ITS, PUSH P,[MOVSI B,(JRST)] + PUSH P,[HRRI B,C] + PUSH P,[JRST B] ;GO DO VALRET + PUSH P,[B] + PUSH P,A ; PUSH START ADDR + MOVE B,[JRST -12.(P)] + MOVE 0,[JUMPA START] +IFE ITS, MOVE C,[HALTF] +IFE ITS, SKIPE OPSYS + MOVE C,[ASCII \0/9\] + MOVE D,[ASCII \B/1Q\] + MOVE E,[ASCIZ \ * \] ;TERMINATE + POPJ P, ; GO + +; CHECK PAIR SPACE + +PAIRCH: CAMG A,B + JRST SETTV ;O.K. + +DEATH1: MOVEI B,[ASCIZ /LOSSAGE--CODE AND DATA OVERLAP +/] + PUSHJ P,MSGTYP + .VALUE + +;CHARACTER STRING HACKER + +CHACK: MOVE A,(C) ;GET TYPE + HLLZM A,(D) ;STORE IN NEW HOME + MOVE B,1(C) ;GET POINTER + HLRZ E,B ;-LENGHT + HRRM E,(D) + PUSH P,E+1 ; IDIVI WILL CLOBBER + ADDI E,4+5*2 ; ROUND AND ACCOUNT FOR DOPE WORDS + IDIVI E,5 ; E/ WORDS LONG + PUSHJ P,EBPUR ; MAKE A PURIFIED COPY + POP P,E+1 + HRLI B,010700 ;MAKE POINT BYTER + SUBI B,1 + MOVEM B,1(D) ;AND STORE IT + ANDI A,-1 ;CLEAR LH OF A + JUMPE A,SETLP ;JUMP IF NO REF + HRRZ B,-1(A) ;SEE IF PREVIOUS INSTRUCTION REFERS TO $TCHSTR + CAIE B,$TCHSTR ;SKIP IF IT DOES + JRST CHACK1 ;NO, JUST DO CHQUOTE PART + HRRM D,-1(A) ;CLOBBER +CHACK1: MOVEI E,1(D) + HRRM E,(A) ;STORE INTO REFERENCE + MOVEI E,0 + DPB E,[220400,,(A)] + JRST SETLP + +; SUBROUTINE TO COPY A HUNK OF STRUCTURE TO THE HIGH SEGMENT + +EBPUR: PUSH P,E + PUSH P,A + ADD E,HITOP ; GET NEW TOP + CAMG E,RHITOP ; SKIP IF TOO BIG + JRST EBPUR1 + +; CODE TO GROW HI SEG + + MOVEI A,2000 + ADDB A,RHITOP ; NEW TOP + TLNE A,777776 + JRST HIFUL +IFN ITS,[ + ASH A,-10. ; NUM OF BLOCKS + SUBI A,1 ; BLOCK TO GET + .CALL HIGET + .VALUE +] + +EBPUR1: MOVEI A,-1(E) ; NEEDED TO TERMINATE BLT + EXCH E,HITOP + HRLI E,(B) + MOVEI B,(E) + BLT E,(A) + POP P,A + POP P,E + POPJ P, + +GIVCOR: SETZ + SIXBIT /CORBLK/ + 1000,,0 + 1000,,-1 + SETZ A + +HIGET: SETZ + SIXBIT /CORBLK/ + 1000,,100000 + 1000,,-1 + A + 401000,,400001 + + +; PROCESS AN ATOM AND ADD IT TO AN APPROPRIATE OBLIST IF IT ISN'T +; ALREADY THERE + +ATOMHK: PUSH TP,$TOBLS ; SAVE OBLIST + PUSH TP,[0] ; FILLED IN LATER + PUSH TP,$TVEC ;SAVE TV POINTERS + PUSH TP,C + PUSH TP,$TVEC + PUSH TP,D + MOVE C,1(C) ;GET THE ATOM + PUSH TP,$TATOM ;AND SAVE + PUSH TP,C + PUSH TP,$TATOM + PUSH TP,[0] + HRRZ B,(C) ;GET OBLIST SPEC FROM ATOM + LSH B,1 + ADDI B,1(TB) ;POINT TO ITS HOME + HRRM B,-9(TP) + MOVE B,(B) + MOVEM B,-10(TP) ; CLOBBER + + SETZM 2(C) ; FLUSH CURRENT OBLIST SPEC + MOVEI E,0 + MOVE D,C + PUSH P,[LOOKCR] + ADD D,[3,,3] + JUMPGE D,.+4 + PUSH P,(D) + ADDI E,1 + AOBJN D,.-2 + PUSH P,E + MOVSI A,TOBLS + JRST ILOOKC +LOOKCR: + MOVEM B,(TP) + JUMPN B,CHCKD + +;HERE IF THIS ATOM MUST BE PUT ON OBLIST + +USEATM: MOVE B,-2(TP) ; GET ATOM + HLRZ E,(B) ; SEE IF PURE OR NOT + TRNN E,400000 ; SKIP IF IMPURE + JRST PURATM + PUSH TP,$TATOM + PUSH TP,B + PUSH TP,$TOBLS + PUSH TP,-13(TP) + MCALL 2,INSERT + + PUSHJ P,VALMAK ;MAKE A GLOBAL VALUE FOR THIS LOSER +PURAT2: MOVE C,-6(TP) ;RESET POINTERS + MOVE D,-4(TP) + SUB TP,[12,,12] + MOVE B,(C) ;MOVE THE ENTRY + HLLZM B,(D) ;DON'T WANT REF POINTER STORED + MOVE A,1(C) ;AND MOVE ATOM + MOVEM A,1(D) + MOVEI A,1(D) + ANDI B,-1 ;CHECK FOR REAL REF + JUMPE B,SETLP1 ;DON'T SAVE THIS ATOM ON TVP + HRRM A,(B) ;CLOBBER CODE + MOVEI A,0 + DPB A,[220400,,(B)] ; CLOBBER TVP PORTION + JRST SETLP + + +; HERE TO MAKE A PURE ATOM + +PURATM: HRRZ B,-2(TP) ; POINT TO IT + HLRE E,-2(TP) ; - LNTH + MOVNS E + ADDI E,2 + PUSHJ P,EBPUR ; PURE COPY + HRRM B,-2(TP) ; AND STORE BACK + MOVE B,-2(TP) + JUMPE 0,PURAT0 + HRRZ D,0 + HLRE E,0 + SUBM D,E + HLRZ 0,2(D) + JUMPE 0,PURAT8 + CAIG 0,HIBOT + FATAL INITM--PURE IMPURE LOSSAGE + JRST PURAT8 + +PURAT0: HRRZ E,(C) + MOVE D,-2(TP) ; GET ATOM BACK + HRRZ 0,(D) ; GET OBLIST CODE + JUMPE E,PURAT9 +PURAT7: HLRZ D,1(E) + MOVEI D,-2(D) + SUBM E,D + HLRZ D,2(D) + CAILE D,HIBOT ; IF NEXT PURE & I AM ROOT + JUMPE 0,PURAT8 ; TAKES ADVANTAGE OF SYSTEM=0 + JUMPE D,PURAT8 + MOVE E,D + JRST PURAT7 + +PURAT8: HLRZ D,1(E) + SUBI D,2 + SUBM E,D + HLRE C,B + SUBM B,C + HLRZ E,2(D) + HRLM E,2(B) + HRLM C,2(D) + JRST PURAT6 + +PURAT9: HLRE A,-2(TP) + SUBM B,A + HRRZM A,(C) + +PURAT6: MOVE B,-10(TP) ; GET BUCKET BACK + MOVE C,-2(TP) + HRRZ 0,-9(TP) + HRRM 0,2(C) ; STORE OBLIST IN ATOM +PURAT1: HRRZ C,(B) ; GET CONTENTS + JUMPE C,HICONS ; AT END, OK + CAIL C,HIBOT ; SKIP IF IMPURE + JRST HICONS ; CONS IT ON + MOVEI B,(C) + JRST PURAT1 + +HICONS: HRLI C,TATOM + PUSH P,C + PUSH P,-2(TP) + PUSH P,B + MOVEI B,-2(P) + MOVEI E,2 + PUSHJ P,EBPUR ; MAKE PURE LIST CELL + + MOVE C,(P) + SUB P,[3,,3] + HRRM B,(C) ; STORE IT + MOVE B,1(B) ; ATOM BACK + MOVE C,-6(TP) ; GET TVP SLOT + HRRM B,1(C) ; AND STORE + HLRZ 0,(B) ; TYPE OF VAL + MOVE C,B + CAIN 0,TUNBOU ; NOT UNBOUND? + JRST PURAT3 ; UNBOUND, NO VAL + MOVEI E,2 ; COUNT AGAIN + PUSHJ P,EBPUR ; VALUE CELL + MOVE C,-2(TP) ; ATOM BACK + HLLZS (B) ; CLEAR LH + MOVSI 0,TLOCI + MOVEM B,1(C) + SKIPA +PURAT3: MOVEI 0,0 + HRRZ A,(C) ; GET OBLIST CODE + MOVE A,OBTBL2(A) + HRRM A,2(C) ; STORE OBLIST SLOT + MOVEM 0,(C) + JRST PURAT2 + +; A POSSIBLE MATCH ARRIVES HERE + +CHCKD: MOVE D,(TP) ;THEY MATCH!, GET EXISTING ATOM + MOVEI A,(D) ;GET TYPE OF IT + MOVE B,-2(TP) ;GET NEW ATOM + HLRZ 0,(B) + TRZ A,377777 ; SAVE ONLY 400000 BIT + TRZ 0,377777 + CAIN 0,(A) ; SKIP IF WIN + JRST IM.PUR + MOVSI 0,400000 + ANDCAM 0,(B) + ANDCAM 0,(D) + HLRZ A,(D) + JUMPN A,A1VAL + MOVE A,(B) ;MOVE VALUE + MOVEM A,(D) + MOVE A,1(B) + MOVEM A,1(D) + MOVE B,D ;EXISTING ATOM TO B + MOVEI 0,(B) + CAIL 0,HIBOT + JRST .+3 + PUSHJ P,VALMAK ;MAKE A VALUE + JRST .+2 + PUSHJ P,PVALM + +;NOW FIND ATOMS OCCURENCE IN XFER VECTOR + +OFFIND: MOVE D,-4(TP) ;GET CURRENT POINTER INTO TP + MOVE C,[-TVLNT,,TVSTRT] ;AND A COPY OF TVP + MOVEI A,0 ;INITIALIZE COUNTER +ALOOP: CAMN B,1(C) ;IS THIS IT? + JRST AFOUND + ADD C,[2,,2] ;BUMP COUNTER + CAMG C,D + AOJA A,ALOOP ;NO, KEEP LOOKING + + MOVEI B,[ASCIZ /LOSSAGE--ATOM DISAPPEARED +/] +TYPIT: PUSHJ P,MSGTYP + .VALUE + +AFOUND: LSH A,1 ;FOUND ATOM, GET REAL OFFSET + ADDI A,1 + ADDI A,TVSTRT + MOVE C,-6(TP) ;GET TV POINTER TO NEW ATOM + HRRZ B,(C) ;POINT TO REFERENCE + SKIPE B ;ANY THERE? + HRRM A,(B) ;YES, CLOBBER AWAY + SUB TP,[12,,12] + MOVEI A,0 + DPB A,[220400,,(B)] ; KILL TVP POINTER + JRST SETLP1 ;AND GO ON + +A1VAL: HLRZ C,(B) ;GET VALUE'S TYPE + MOVE B,D ;NOW PUT EXISTING ATOM IN B + CAIN C,TUNBOU ;UNBOUND? + JRST OFFIND ;YES, WINNER + + MOVEI B,[ASCIZ /LOSSAGE--ATOM TRIES TO HAVE 2 VALUES +/] + JRST TYPIT + + +IM.PUR: MOVEI B,[ASCIZ /LOSSAG--ATOM TRIES TO BE BOTH PURE AND IMPURE +/] + JRST TYPIT + +PAGLOS: MOVEI B,[ASCIZ /LOSSAGE--IMPURE CORE EXTENDS INTO HIGH SEGMENT +/] + JRST TYPIT + +HIFUL: MOVEI B,[ASCIZ /LOSSAGE--HI SEG FULL +/] + JRST TYPIT + + +;MAKE A VALUE IN SLOT ON GLOBAL SP + +VALMAK: HLRZ A,(B) ;TYPE OF VALUE + CAIE A,400000+TUNBOU + CAIN A,TUNBOU ;VALUE? + JRST VALMA1 + MOVE A,GLOBSP+1 ;GET POINTER TO GLOBAL SP + SUB A,[4,,4] ;ALLOCATE SPACE + CAMG A,GLOBAS+1 ;CHECK FOR OVERFLOW + JRST SPOVFL + MOVEM A,GLOBSP+1 ;STORE IT BACK + MOVE C,(B) ;GET TYPE CELL + TLZ C,400000 + HLLZM C,2(A) ;INTO TYPE CELL + MOVE C,1(B) ;GET VALUE + MOVEM C,3(A) ;INTO VALUE SLOT + MOVSI C,TGATOM ;GET TATOM,,0 + MOVEM C,(A) + MOVEM B,1(A) ;AND POINTER TO ATOM + MOVSI C,TLOCI ;NOW CLOBBER THE ATOM + MOVEM C,(B) ;INTO TYPE CELL + ADD A,[2,,2] ;POINT TO VALUE + MOVEM A,1(B) + POPJ P, + +VALMA1: SETZM (B) + POPJ P, + +SPOVFL: MOVEI B,[ASCIZ /LOSSAGE--GLOBAL SP OVERFLOW +/] + JRST TYPIT + + +PVALM: HLRZ 0,(B) + CAIE 0,400000+TUNBOU + CAIN 0,TUNBOU + JRST VALMA1 + MOVEI E,2 + PUSH P,B + PUSHJ P,EBPUR + POP P,C + MOVEM B,1(C) + MOVSI 0,TLOCI + MOVEM 0,(C) + MOVE B,C + POPJ P, + ;SET UP LIST OF INTERNAL NAMES AND ADDRESS NEEDED BY COMPILER + +VECTGO DUMMY1 + +IRP A,,[FINIS,SPECBIND,WNA,WRONGT,$TLOSE,CALER1,POPUNW +ILOC,IGLOC,IDVAL,ILVAL,IGVAL,INTFLG,LCKINT,ONINT,TYPLOO,TDEFER +IFALSE,UNAS,UNBOU,RCALL,SEGMNT,SEGLST,NUMPRI,OPSYS,SSPEC1,COMPERR +MAKACT,MAKENV,BFRAME,TTP,TTB,$TTP,$TTB,MAKTUP,TPALOC,IBIND,SSPECS +CILVAL,CISET,CIGVAL,CSETG,IBLOK1,IBLOCK,CLLOC,CGLOC,CASSQ,CGASSQ +CILNT,CILNQ,CILEGQ,CEMPTY,CIEQUA,CIREST,CINTH,CIAT,CSETLO,CIN +CIPUT,CIGET,CIGETL,CIMON,CISTRU,CIMEMQ,CIMEMB,CITOP,CIBACK,TYPSEG +C1CONS,CICONS,CIUVEC,CIVEC,IIFORM,IILIST,CISTNG,HITOP,INCR1,TYPG,VALG,TESTR +OTBSAV,CITYPE,CFRAME,CARGS,CFUNCT,CUTYPE,CPTYPE,CTYPEP,CTYPEQ,CCHUTY +CIREMA,RTFALS,CIPUTP,CIGETP,CIGTPR,MPOPJ,TAB,$TAB,ICONS,CSTO,DSTO,NTPALO +CPLUS,CTIMES,CTIME,CDIVID,CMINUS,CLQ,CLEQ,CGQ,CGEQ,CLOG,CSIN,CCOS,CATAN,CSQRT +CFIX,CFLOAT,CEXP,CRAND,CINEQU,SPECBND,PGGIVE,PGFIND,MTYO,CMIN,CMAX,RCL,R1C,W1C +CALLTY,CTYPEC,CTYPEW,NOTTY,CHKAB,CTMPLT,IUNWIN,UNWIN2,NOSHUF,ROOT,ERROBL,INTOBL +CINSER,CIRMV,CLOOKU,CATOM,CIPNAM,ISTRCM,CITERP,CIPRIN,CIPRN1,CIPRNC,CGFALS +CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR,CPCH,CREADC,CNXTCH,CREDC1,CNXTC1 +CGBOUN,IIGLOC,MAKTU2,CIFLTZ,CIUPRS,SAT,TFA,WTYP,NAPT,PTYPE,APLQ,PURBOT,GCSBOT +GLOTOP,TYPVEC,1STEPR,LSTRES,NODES,MAINPR,CVTYPE,CSPNAM,CSBSTR,INTBCK,CICRLF +CERR1,CERR2,CERR3,CANDP,CORP,CSQUTA,CIMAGE,ATOSQ,CFILLE,CPRTYC,FMPOPJ +TD.PUT,TD.GET,TD.LNT,CBYTES,MARK,MARK2G,TD.AGC,DSTORE,RCLV,NUMSAT,RMCALL,NPRFLG +NSPOPJ,NFPOPJ,PURCLN,FRETOP,PURVEC,SWAPGC,NTTYPE,CLRSTR] + .GLOBAL A + ADDSQU A +TERMIN + +VECRET + +; ROUTINE TO SORT AND PURIFY SQUOZE TABLE + +SQSETU: MOVE A,[SQUTBL-SQULOC+2,,SQUTBL] + MOVEI 0,1 +SQ2: MOVE B,(A) + CAMG B,2(A) + JRST SQ1 + MOVEI 0,0 + EXCH B,2(A) + MOVEM B,(A) + MOVE B,1(A) + EXCH B,3(A) + MOVEM B,1(A) +SQ1: ADD A,[2,,2] + JUMPL A,SQ2 + JUMPE 0,SQSETU +IFE ITS,[ +STSQU: MOVE B,[440700,,SQBLK] + PUSHJ P,MNGNAM + HRROI B,SQBLK + MOVSI A,600001 + GTJFN + FATAL CANT MAKE FIXUP FILE + MOVEI E,(A) + MOVE B,[440000,,100000] + OPENF + FATAL CANT OPEN FIXUP FILE + MOVE B,[444400,,SQUTBL] + MOVNI C,SQULOC-SQUTBL + SOUT + MOVEI A,(E) + CLOSF + JFCL + MOVE A,[SQUTBL-SQULOC,,SQUTBL] + MOVEM A,SQUPNT" +] +IFN ITS,[ +.GLOBAL CSIXBT +STSQU: MOVE C,MUDSTR+2 ; CALCULATE SECOND FILE NAME FOR SQUOZE TABLE + PUSHJ P,CSIXBT + HRRI C,(SIXBIT/TAB/) ; TABxxx IS SECOND NAME OF FILE + MOVSS C + MOVEM C,SQBLK+2 ; STORE IN APPROPRIATE BLOCKS + MOVEM C,SQWBLK+2 + .SUSET [.SSNAM,,SQDIR] + .OPEN GCHN,SQWBLK ; OPEN FILE + FATAL CAN'T CREATE SQUOZE FILE + MOVE A,[SQUTBL-SQULOC,,SQUTBL] + MOVEM A,SQUPNT" + .IOT GCHN,A + .CLOSE GCHN ; CLOSE THE CHANNEL +] + POPJ P, + +RHITOP: 0 + +OBSZ: 151. + 13. + 151. + 151. + 317. + +OBTBL2: ROOT+1 + ERROBL+1 + INTOBL+1 + MUDOBL+1 + INITIAL+1 + +OBTBL: INITIAL+1-TVSTRT+TVBASE + MUDOBL+1-TVSTRT+TVBASE + INTOBL+1-TVSTRT+TVBASE + ERROBL+1-TVSTRT+TVBASE + ROOT+1-TVSTRT+TVBASE +OBNAM: MQUOTE INITIAL + IMQUOTE MUDDLE + MQUOTE INTERRUPTS + MQUOTE ERRORS + MQUOTE ROOT + +OBTBL1: INITIAL+1 + MUDOBL+1 + INTOBL+1 + ERROBL+1 + ROOT+1 + + +IFN ITS,[ +SQWBLK: SIXBIT / 'DSK/ + SIXBIT /SQUOZE/ + SIXBIT /TABLE/ +] +IFE ITS,[ +MNGNAM: MOVE A,[440700,,MUDSTR+2] ; FOR NAME HACKING + ILDB 0,A ; SEE IF IT IS A VERSION + CAIN 0,177 + POPJ P, + MOVE A,B + ILDB 0,A + CAIN 0,"X ; LOOK FOR X'S + JRST .+3 + MOVE B,A + JRST .-4 + + MOVE A,[440700,,MUDSTR+2] + ILDB 0,A + IDPB 0,B + ILDB 0,A + IDPB 0,B + ILDB 0,A + IDPB 0,B + POPJ P, +] + +IFN ITS,[ +.GLOBAL VCREATE,MUDSTR + +DEBUG: MOVE E,[440600,,[SIXBIT /EXPERIMENTAL/]] + MOVEI 0,12. + JRST STUFF + +VCREATE: .SUSET [.SSNAM,,[SIXBIT /MUDSYS/]] + .OPEN 0,OP% + .VALUE + MOVEI 0,0 ; SET 0 TO DO THE .RCHST + .RCHST 0 + .CLOSE 0 + .FDELE DB% + .VALUE + MOVE E,[440600,,B] + MOVEI 0,6 +STUFF: MOVE D,[440700,,MUDSTR+2] +STUFF1: ILDB A,E ; GET A CHAR + CAIN A,0 ;SUPRESS SPACES + MOVEI A,137 ;RUBOUT'S DON'T TYPE OUT + ADDI A,40 ; TO ASCII + IDPB A,D ; STORE + SOJN 0,STUFF1 + SETZM 34 + SETZM 35 + SETZM 36 + .VALUE + +OP%: 1,,(SIXBIT /DSK/) + SIXBIT /MUD%/ + SIXBIT />/ + +DB%: (SIXBIT /DSK/) + SIXBIT /MUD%/ + SIXBIT /_<-9.>> + HLLZS (A) + LDB B,[331100,,(C)] + DPB B,[331100,,(A)] + MOVE A,D + JUMPN A,%DBG1 +%DBG2: + MOVE B,[440700,,DECBLK] + PUSHJ P,MNGNAM ; VERSION TO NAME IF NECESSARY + HRROI B,DECBLK + MOVSI A,600001 + GTJFN + FATAL CANT WRITE OUT GC + MOVEI E,(A) + MOVE B,[440000,,100000] + OPENF + FATAL CANT OPEN GC FILE + MOVNI C,SECLEN + ASH C,10. + MOVE B,[444400,,REALGC+RLENGC+RSLENG] + MOVEI A,(E) + SOUT + MOVEI A,(E) + CLOSF + JFCL + MOVEI D,SECLEN+SECLEN + MOVNI A,1 + MOVEI B,REALGC+RLENGC + ASH B,-9. + HRLI B,400000 + + PMAP + ADDI B,1 + SOJG D,.-2 + + MOVE B,[440700,,ILDBLK] + SKIPE OPSYS + MOVE B,[440700,,TILDBL] + PUSHJ P,MNGNAM + MOVSI C,-1000 + MOVSI A,400000 +RPA: RPACS + TLNE B,10000 + TLNN B,400 ; SKIP IF NOT PRIVATE + SKIPA + MOVES (C) + ADDI C,777 + ADDI A,1 + AOBJN C,RPA + + MOVNI A,1 + CLOSF + FATAL CANT CLOSE STUFF + HRROI B,ILDBLK + MOVSI A,100001 + GTJFN ; GET A JFN + FATAL GARBAGE COLLECTOR IS MISSING + HRRZS E,A ; SAVE JFN + MOVE B,[440000,,300000] + OPENF + FATAL CANT OPEN GC FILE + MOVEI A,(E) ; FIND OUT LENGTH OF MAP + BIN ; GET LENGTH WORD + HLRZ 0,B + CAIE 0,1776 ; TOPS20 SSAVE FILE FORMAT + CAIN 0,1000 ; TENEX SSAVE FILE FORMAT + JRST .+2 + FATAL NOT AN SSAVE FILE + MOVEI A,(B) ; ISOLATE SIZE OF MAP + HLRE B,TP ; MUST BE SPACE FOR CRUFT + MOVNS B + CAIGE B,(A) ; ROOM? + FATAL NO ROOM FOR PAGE MAP (GULP) + MOVN C,A + MOVEI A,(E) ; READY TO READ IN MAP + MOVEI B,1(TP) ; ONTO TP STACK + HRLI B,444400 + SIN ; SNARF IT IN + + MOVEI A,1(TP) ; POINT TO MAP + CAIE 0,1000 + JRST RPA1 ; GO TO THE TOPS20 CODE + LDB 0,[221100,,(A)] ; GET FORK PAGE + CAIE 0,PAGEGC+PAGEGC ; GOT IT? + AOJA A,.-2 + JRST RPA2 + +RPA1: ADDI A,1 ; POINT TO PROCESS PAGE NUMBER + LDB 0,[331100,,(A)] ; REPEAT COUNT IN 0 + LDB B,[3300,,(A)] ; FIRST PAGE NUMBER IN B + ADD 0,B ; LARGEST PAGE NUMBER + CAIL 0,PAGEGC+PAGEGC + CAILE B,PAGEGC+PAGEGC + AOJA A,RPA1 ; NEXT PAIR OF WORDS PLEASE + SUBI A,1 ; POINT TO FILE PAGE NUMBER + SUBI B,PAGEGC+PAGEGC + MOVN B,B + ADDM B,(A) ; SET UP THE PAGE + +RPA2: HRRZ B,(A) ; GET PAGE + MOVEI A,(E) ; GET JFN + ASH B,9. + SFPTR + FATAL ACCESS OF FILE FAILED + MOVEI A,(E) + MOVE B,[444400,,AGCLD] + MOVNI C,LENGC + ASH C,10. + SOUT + MOVEI A,(E) + CLOSF + JFCL + POPJ P, + +; CODE TO DISTINGUISH BETWEEN TOPS20 AND TENEX AT SETUP TIME + +TWENTY: HRROI A,C ; RESULTS KEPT HERE + HRLOI B,600015 + MOVEI C,0 ; CLEAN C UP + DEVST + JFCL + MOVEI A,1 ; TENEX HAS OPSYS = 1 + CAME C,[ASCII/NUL/] ; TOPS20 GIVES "NUL" + MOVEM A,OPSYS ; TENEX GIVES "NIL" + POPJ P, +%TBL: IRP A,,[HRRM,HRLM,MOVEM,SETZM,HLRZ,XBLT] + S!A <<(A)>_<-9.>> + TERMIN + +GCLDBK: ASCIZ /MDLXXX.AGC/ +SGCLBK: ASCIZ /MDLXXX.SGC/ +SECBLK: ASCIZ /MDLXXX.SEC/ +ILDBLK: ASCIZ /MDLXXX.EXE/ +TILDBL: ASCIZ /MDLXXX.SAV/ +DECBLK: ASCIZ /MDLXXX.DEC/ +] + + + +END SETUP + \ No newline at end of file diff --git a//initm.mid.373 b//initm.mid.373 new file mode 100644 index 0000000..bbd8fe6 --- /dev/null +++ b//initm.mid.373 @@ -0,0 +1,1360 @@ +TITLE INITIALIZATION FOR MUDDLE + +RELOCATABLE + +HTVLNT==3000 ; GUESS OF TVP LENGTH + +LAST==1 ;POSSIBLE CHECKS DONE LATER + +.INSRT MUDDLE > + +SYSQ +XBLT==123000,, +GCHN==0 +IFE ITS,[ +FATINS==.FATAL" +SEVEC==104000,,204 +.INSRT STENEX > +] + +IMPURE + +OBSIZE==151. ;DEFAULT OBLIST SIZE + +.LIFG +.LOP .VALUE +.ELDC + +.GLOBAL SHRRM,SHRLM,SMOVEM,SSETZM,SXBLT,SHLRZ +.GLOBAL SETUP,TPBAS,GCPDL,GCPVP,PVBASE,PVLNT,PARNEW,AAGC,ICR,SWAP,OBLNT,MSGTYP,POPUNW +.GLOBAL ICLOS,OCLOS,GLOBASE,GLOBSP,PARBOT,PARTOP,CODTOP,START,BEGIN,VECBOT,VECTOP,TPBASE +.GLOBAL LISTEN,ROOT,INITIAL,TBINIT,TOPLEV,INTOBL,ERROBL,MUDOBL,TTYOPE,RESFUN,QUITTER +.GLOBAL IOINS,BUFRIN,IOIN2,ECHO,MTYI,MTYO,IMTYO,MUDSTR,P.TOP,TTICHN,TTOCHN,TYPVEC,SQDIR +.GLOBAL PDLBUF,PHIBOT,%UNAM,PURVEC,STOSTR,ISTOST,TD.LNT,TD.PUT,TD.GET,CAFRE1 +.GLOBAL FRETOP,LPUR,SQBLK,REALGC,INTDIR,AGCLD,PAGEGC,TD.AGC,TVSTRT,REALTV,PVSTOR +.GLOBAL GCSTOP,SPSTOR,DSTORE,SQBYTE,INBYTE,GCBYTE,FRSTCH,OPSYS,IJFNS,GETJS +.GLOBAL HASHTB,ILOOKC + +LPUR==.LPUR ; SET UP SO LPUR WORKS + +; INIITAL AMOUNT OF AFREE SPACE + +STOSTR: +LOC TVSTRT-1 +ISTOST: TVSTRT-STOSTR,,0 + + BLOCK HTVLNT ; TVP + +SETUP: MOVEI 0,0 ; ZERO ACS + MOVEI 17,1 + BLT 17,17 + +IFN ITS, .SUSET [.RUNAM,,%UNAM] ; FOR AGC'S BENFIT + MOVE P,GCPDL ;GET A PUSH DOWN STACK +IFN ITS, .SUSET [.SMASK,,[200000]] ; ENABLE PDL OVFL + MOVE 0,[TVBASE,,TVSTRT] + BLT 0,TVSTRT+HTVLNT-3 ; BLT OVER TVP +IFE ITS, PUSHJ P,TWENTY ; FIND OUT WHETHER IT IS TOPS20 OR NOT + PUSHJ P,TTYOPE ;OPEN THE TTY + AOS A,20 ; TOP OF LOW SEGG + HRRZM A,P.TOP + SOSN A ; IF NOTHING YET +IFN ITS, .SUSET [.RMEMT,,P.TOP] +IFE ITS, JRST 4, + MOVE A,P.TOP + SUB A,FRETOP ; SETUP FOR GETTING NEEDED CORE + SUBI A,3777 + ASH A,-10. ; TO PAGES + HRLS A ; SET UP AOBJN + HRRZ 0,P.TOP + ASH 0,-10. + SUBI 0,1 + HRR A,0 +IFN ITS,[ + .CALL HIGET ; GET THEM + FATAL INITM--CORE NOT AVAILABLE FOR INITIALIZATION + ASH A,10. ; TO WORDS + MOVEM A,P.TOP + SUBI A,2000 ; WHERE FRETOP IS + MOVEM A,FRETOP + +] +IFE ITS,[ + MOVE A,FRETOP + ADDI A,2000 + MOVEM A,P.TOP +] + HRRE A,P.TOP ; CHECK TOP + TRNE A,377777 ; SKIP IF ALL LOW SEG + JUMPL A,PAGLOS ; COMPLAIN + MOVE A,HITOP ; FIND HI SEG TOP + ADDI A,1777 + ANDCMI A,1777 + MOVEM A,RHITOP ; SAVE IT + MOVEI A,200 + SUBI A,PHIBOT + JUMPE A,HIBOK + MOVSI A,(A) + HRRI A,200 +IFN ITS,[ + .CALL GIVCOR + .VALUE +] +HIBOK: MOVEI B,[ASCIZ /MUDDLE INITIALIZATION. +/] + PUSHJ P,MSGTYP ;PRINT IT + MOVE A,CODTOP ;CHECK FOR A WINNING LOAD + CAML A,VECBOT ;IT BETTER BE LESS + JRST DEATH1 ;LOSE COMPLETELY +SETTV: MOVE PVP,[-PVLNT*2,,GCPVP] ;AND A PROCESS VECTOR + MOVEM PVP,PVSTOR+1 + MOVEM PVP,PVSTOR+1-TVSTRT+TVBASE + MOVEI A,(PVP) ;SET UP A BLT + HRLI A,PVBASE ;FROM PROTOTYPE + BLT A,PVLNT*2-1(PVP) ;INITIALIZE + MOVE TP,[-ITPLNT,,TPBAS] ;GET A STACK FOR THIS PROCCESS + MOVEI TB,(TP) ;AND A BASE +IFN ITS, HRLI TB,1 +IFE ITS, HRLI TB,400001 ; FOR MULTI SEG HACKING + SUB TP,[1,,1] ;POP ONCE + +; FIRST BUILD MOBY HASH TABLE + + MOVEI A,1023. ; TRY THIS OUT FOR SIZE + PUSHJ P,IBLOCK + MOVEM B,HASHTB+1-TVSTRT+TVBASE ; STORE IN TVP POINTER + HLRE A,B + SUB B,A + MOVEI A,TATOM+.VECT. + HRLM A,(B) + +; ALLOCATE SOME OBLISTS FOR INITIAL ATOMS + + PUSH P,[5] ;COUNT INITIAL OBLISTS + + PUSH P,OBLNT ;SAVE CURRENT OBLIST DEFAULT SIZE + +MAKEOB: SOS A,-1(P) + MOVE A,OBSZ(A) + MOVEM A,OBLNT + MCALL 0,MOBLIST ;GOBBLE AN OBLIST + PUSH TP,$TOBLS ;AND SAVE THEM + PUSH TP,B + MOVE A,(P)-1 ;COUNT DOWN + MOVEM B,@OBTBL(A) ;STORE + JUMPN A,MAKEOB + + POP P,OBLNT ;RESTORE DEFAULT OBLIST SIZE + + MOVE C,[-TVLNT+2,,TVBASE] + MOVE D,[-HTVLNT+2,,TVSTRT] + +;MAIN INITIALIZE LOOP - SCAN XFER VECTOR FOR ATOMS, UPDATE +;OFFSETS IN CODE, UNIQUIFY ATOMS AND COMPACT XFER VECTOR + +ILOOP: HLRZ A,(C) ;FIRST TYPE + JUMPE A,TVEXAU ;USEFUL STUFF EXHAUSTED + CAIN A,TCHSTR ;CHARACTER STRING? + JRST CHACK ;YES, GO HACK IT + CAIN A,TATOM ;ATOM? + JRST ATOMHK ;YES, CHECK IT OUT + MOVE A,(C) ;MOVE TO NEW HOME (MAY BE SAME) + MOVEM A,(D) + MOVE A,1(C) + MOVEM A,1(D) +SETLP: AOS (P) ;COUNT NUMBER OF PAIRS IN XFER VECTOR + ADD D,[2,,2] ;OUT COUNTER +SETLP1: ADD C,[2,,2] ;AND IN COUNTER + JUMPL C,ILOOP ;JUMP IF MORE TO DO + +;NEW XFER VECTOR FINISHED, NOW GIVE AWAY THE REST + +TVEXAU: HLRE B,D ; LEFT HALF OF AOBJN + MOVNI TVP,HTVLNT-2 ; CALCULATE LENGTH OF TVP + SUB TVP,B ; GET -LENGTH OF TVP IN TVP + HRLS TVP + HRRI TVP,TVSTRT ; BUILD A TASTEFUL TVP POINTER + MOVNI C,TVLNT-HTVLNT+2(B) ; SMASH IN LENGTH INTO END DOPE WORDS + HRLM C,TVSTRT+HTVLNT-1 + MOVSI E,400000 + MOVEM E,TVSTRT+HTVLNT-2 + HLRE C,TVP + MOVNI C,-2(C) ; CLOBBER LENGTH INTO REAL TVP + HLRE B,TVP + SUBM TVP,B + MOVEM E,(B) + HRLM C,1(B) ; PUT IN LENGTH + MOVE PVP,PVSTOR+1 + MOVEM TVP,REALTV+1(PVP) + + +; FIX UP TYPE VECTOR + + MOVE A,TYPVEC+1 ;GET POINTER + MOVEI 0,0 ;FOR POSSIBLE NULL SLOTS + MOVSI B,TATOM ;SET TYPE TO ATOM + MOVEI D,400000 ; TYPE CODE HACKS + +TYPLP: HLLM B,(A) ;CHANGE TYPE TO ATOM + MOVE C,@1(A) ;GET ATOM + HLRE E,C ; FIND DOPE WORD + SUBM C,E + HRRM D,(E) ; STUFF INTO ATOM + MOVEM C,1(A) + ADDI D,1 + ADD A,[2,,2] ;BUMP + JUMPL A,TYPLP + + ; CLOSE TTY CHANNELS +IFN ITS,[ + + .CLOSE 1, + .CLOSE 2, +] + +;GENERAT THE LOGICAL TTY IN AND OUT CHANNELS + +;SETUP CALL TO OPEN OUTPUT TTY CHANNNEL + + IRP A,,[[PRINT,TCHSTR],[TTY:,TCHSTR]] + IRP B,C,[A] + PUSH TP,$!C + PUSH TP,CHQUOTE B + .ISTOP + TERMIN + TERMIN + + MCALL 2,FOPEN ;OPEN THE OUT PUT CHANNEL + MOVEM B,TTOCHN+1 ;SAVE IT + +;ASSIGN AS GLOBAL VALUE + + PUSH TP,$TATOM + PUSH TP,IMQUOTE OUTCHAN + PUSH TP,A + PUSH TP,B + MOVE A,[PUSHJ P,MTYO] ;MORE WINNING INS + MOVEM A,IOINS(B) ;CLOBBER + MCALL 2,SETG + +;SETUP A CALL TO OPEN THE TTY CHANNEL + + IRP A,,[[READ,TCHSTR],[TTY:,TCHSTR]] + IRP B,C,[A] + PUSH TP,$!C + PUSH TP,CHQUOTE B + .ISTOP + TERMIN + TERMIN + + MCALL 2,FOPEN ;OPEN INPUTCHANNEL + MOVEM B,TTICHN+1 ;SAVE IT + PUSH TP,$TATOM ;ASSIGN AS A GLOBAL VALUE + PUSH TP,IMQUOTE INCHAN + PUSH TP,A + PUSH TP,B + MOVE C,BUFRIN(B) ;GET AUX BUFFER PTR + MOVE A,[PUSHJ P,MTYI] + MOVEM A,IOIN2(C) ;MORE OF A WINNER + MOVE A,[PUSHJ P,IMTYO] + MOVEM A,ECHO(C) ;ECHO INS + MCALL 2,SETG + MOVEI A,3 ;FIRST CHANNEL AFTER INIT HAPPENS + MOVEM A,FRSTCH + +;GENERATE AN INITIAL PROCESS AND SWAP IT IN + + MOVEI A,TPLNT ;STACK PARAMETERS + MOVEI B,PLNT + PUSHJ P,ICR ;CREATE IT + MOVE PVP,PVSTOR+1 + MOVE 0,SPSTO+1(B) + MOVEM 0,SPSTOR+1 + MOVE 0,REALTV+1(PVP) + MOVEM 0,REALTV+1(B) ; STUFF IN TRANSFER VECTOR POINTER + MOVEI 0,RUNING + MOVEM 0,PSTAT"+1(B) + MOVE D,B ;SET UP TO CALL SWAP + JSP C,SWAP ;AND SWAP IN + MOVEM PVP,MAINPR" ;SAVE AS THE MAIN PROCESS + PUSH TP,[TENTRY,,TOPLEV] ;BUILD DUMMY FRAME + PUSH TP,[1,,0] + MOVEI A,-1(TP) + PUSH TP,A + PUSH TP,SPSTOR+1 + PUSH TP,P + MOVE C,TP ;COPY TP + ADD C,[3,,3] ;FUDGE + PUSH TP,C ;TPSAV PUSHED + PUSH TP,[TOPLEV] + HRRI TB,(TP) ;SETUP TB +IFN ITS, HRLI TB,2 +IFE ITS, HRLI TB,400002 + ADD TB,[1,,1] + MOVE PVP,PVSTOR+1 + MOVEM TB,TBINIT+1(PVP) + MOVSI A,TSUBR + MOVEM A,RESFUN(PVP) + MOVEI A,LISTEN" + MOVEM A,RESFUN+1(PVP) + PUSH TP,$TATOM + PUSH TP,IMQUOTE THIS-PROCESS + PUSH TP,$TPVP + PUSH TP,PVP + MCALL 2,SETG + +; FIND TVP OFFSET FOR THE ATOM 'T' FOR TEMPLATE + + MOVEI A,IMQUOTE T + SUBI A, +TVTOFF==0 + ADDSQU TVTOFF + + MOVEM A,SQULOC-1 + + PUSH TP,$TATOM + PUSH TP,IMQUOTE TVTOFF,,MUDDLE + PUSH TP,$TFIX + PUSH TP,A + MCALL 2,SETG + +; HERE TO SETUP SQUOZE TABLE IN PURE CORE + + PUSHJ P,SQSETU ; GO TO ROUTINE + + PUSHJ P,DUMPGC + MOVEI A,400000 ; FENCE POST PURE SR VECTOR + HRRM A,PURVEC + MOVE A,TP + HLRE B,A + SUBI A,-PDLBUF(B) ;POINT TO DOPE WORDS + MOVEI B,12 ;GROWTH SPEC + IORM B,(A) + MOVE PVP,PVSTOR+1 + MOVE 0,REALTV+1(PVP) + HLRE E,0 + SUBI 0,-1(E) + HRRZM 0,CODTOP +IFE ITS, PUSHJ P,GETJS + PUSHJ P,AAGC ;DO IT + AOJL A,.-1 + MOVE PVP,PVSTOR+1 + MOVE A,TPBASE+1(PVP) + SUB A,[640.,,640.] + MOVEM A,TPBASE+1(PVP) + +; CREATE LIST OF ROOT AND NEW OBLIST + + MOVEI A,5 + PUSH P,A + +NAMOBL: PUSH TP,$TATOM + PUSH TP,@OBNAM-1(A) ; NAME + PUSH TP,$TATOM + PUSH TP,IMQUOTE OBLIST + PUSH TP,$TOBLS + PUSH TP,@OBTBL1-1(A) + MCALL 3,PUT ; NAME IT + SOS A,(P) + PUSH TP,$TOBLS + PUSH TP,@OBTBL1(A) + PUSH TP,$TATOM + PUSH TP,IMQUOTE OBLIST + PUSH TP,$TATOM + PUSH TP,@OBNAM(A) + MCALL 3,PUT + SKIPE A,(P) + JRST NAMOBL + SUB P,[1,,1] + +;Define MUDDLE version number + MOVEI A,5 + MOVEI B,0 ;Initialize result + MOVE C,[440700,,MUDSTR+2] +VERLP: ILDB D,C ;Get next charcter digit + CAIG D,"9 ;Non-digit ? + CAIGE D,"0 + JRST VERDEF + SUBI D,"0 ;Convert to number + IMULI B,10. + ADD B,D ;Include number into result + SOJG A,VERLP ;Finished ? +VERDEF: + PUSH TP,$TATOM + PUSH TP,IMQUOTE MUDDLE + PUSH TP,$TFIX + PUSH TP,B + MCALL 2,SETG ;Make definition +OPIPC: +IFN ITS,[ + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE IPC + PUSH TP,$TATOM + PUSH TP,MQUOTE IPC-HANDLER + MCALL 1,GVAL + PUSH TP,A + PUSH TP,B + PUSH TP,$TFIX + PUSH TP,[1] + MCALL 3,ON + MCALL 0,IPCON +] + +; Allocate inital template tables + + MOVEI A,10 + PUSHJ P,CAFRE1 + MOVSI A,(B) + HRRI A,1(B) + SETZM (B) + BLT A,7(B) + ADD B,[10,,10] ; REST IT OFF + MOVEM B,TD.LNT+1 + MOVEI A,10 + PUSHJ P,CAFRE1 + MOVEI 0,TUVEC ; SETUP UTYPE + HRLM 0,10(B) + MOVEM B,TD.GET+1 + MOVSI A,(B) + HRRI A,1(B) + SETZM (B) + BLT A,7(B) + MOVEI A,10 + PUSHJ P,CAFRE1 + MOVEI 0,TUVEC ; SETUP UTYPE + HRLM 0,10(B) + MOVEM B,TD.PUT+1 + MOVSI A,(B) + HRRI A,1(B) + SETZM (B) + BLT A,7(B) + MOVEI A,10 + PUSHJ P,CAFRE1 + MOVEI 0,TUVEC ; SETUP UTYPE + HRLM 0,10(B) + MOVEM B,TD.AGC+1 + MOVSI A,(B) + HRRI A,1(B) + SETZM (B) + BLT A,7(B) + +PTSTRT: MOVEI A,SETUP + ADDI A,1 + SUB A,PARBOT ;FIND WHERE PAIRS SHOULD GO + MOVEM A,PARNEW + +; PURIFY/IMPURIFY THE WORLD (PDL) + +IFN ITS,[ +PURIMP: MOVE A,FRETOP + SUBI A,1 + LSH A,-12 + MOVE B,A + MOVNI A,1(A) + HRLZ A,A + DOTCAL CORBLK,[[1000,,310000],[1000,,-1],A] + FATAL INITM -- CAN'T IMPURIFY LOW CORE + MOVEI A,PHIBOT + ADDI B,1 + SUB A,B + MOVNS A + HRL B,A + DOTCAL CORBLK,[[1000,,0],[1000,,-1],B] + FATAL INITM -- CAN'T FLUSH MIDDLE CORE + MOVE A,[-<400-PHIBOT>,,PHIBOT] + DOTCAL CORBLK,[[1000,,210000],[1000,,-1],A] + FATAL INITM -- CAN'T PURIFY HIGH CORE +] + +IFE ITS,[ + MOVEI A,400000 + MOVE B,[1,,START] + SEVEC +] + PUSH P,[15.,,15.] ;PUSH A SMALL PRGRM ONTO P + MOVEI A,1(P) ;POINT TO ITS START + PUSH P,[JRST AAGC] ;GO TO AGC + PUSH P,[MOVE PVP,PVSTOR+1] + PUSH P,[MOVE B,PSTO+1(PVP)] ;GET SAVED P + PUSH P,[SUB B,-14.(P)] ;FUDGE TO POP OFF PROGRAM + PUSH P,[MOVEM B,PSAV(TB)] ;INTO FRAME + PUSH P,[MOVE B,TPSTO+1(PVP)] ;GET TP + PUSH P,[MOVEM B,TPSAV(TB)] ;STORE IT + PUSH P,[MOVE B,SPSTOR+1] ;SP + PUSH P,[MOVEM B,SPSAV(TB)] + PUSH P,[MOVEI B,TOPLEV] ;WHERE TO GO + PUSH P,[MOVEM B,PCSAV(TB)] +IFN ITS, PUSH P,[MOVSI B,(.VALUE )] +IFE ITS, PUSH P,[MOVSI B,(JRST)] + PUSH P,[HRRI B,C] + PUSH P,[JRST B] ;GO DO VALRET + PUSH P,[B] + PUSH P,A ; PUSH START ADDR + MOVE B,[JRST -12.(P)] + MOVE 0,[JUMPA START] +IFE ITS, MOVE C,[HALTF] +IFE ITS, SKIPE OPSYS + MOVE C,[ASCII \0/9\] + MOVE D,[ASCII \B/1Q\] + MOVE E,[ASCIZ \ * \] ;TERMINATE + POPJ P, ; GO + +; CHECK PAIR SPACE + +PAIRCH: CAMG A,B + JRST SETTV ;O.K. + +DEATH1: MOVEI B,[ASCIZ /LOSSAGE--CODE AND DATA OVERLAP +/] + PUSHJ P,MSGTYP + .VALUE + +;CHARACTER STRING HACKER + +CHACK: MOVE A,(C) ;GET TYPE + HLLZM A,(D) ;STORE IN NEW HOME + MOVE B,1(C) ;GET POINTER + HLRZ E,B ;-LENGHT + HRRM E,(D) + PUSH P,E+1 ; IDIVI WILL CLOBBER + ADDI E,4+5*2 ; ROUND AND ACCOUNT FOR DOPE WORDS + IDIVI E,5 ; E/ WORDS LONG + PUSHJ P,EBPUR ; MAKE A PURIFIED COPY + POP P,E+1 + HRLI B,010700 ;MAKE POINT BYTER + SUBI B,1 + MOVEM B,1(D) ;AND STORE IT + ANDI A,-1 ;CLEAR LH OF A + JUMPE A,SETLP ;JUMP IF NO REF + HRRZ B,-1(A) ;SEE IF PREVIOUS INSTRUCTION REFERS TO $TCHSTR + CAIE B,$TCHSTR ;SKIP IF IT DOES + JRST CHACK1 ;NO, JUST DO CHQUOTE PART + HRRM D,-1(A) ;CLOBBER +CHACK1: MOVEI E,1(D) + HRRM E,(A) ;STORE INTO REFERENCE + MOVEI E,0 + DPB E,[220400,,(A)] + JRST SETLP + +; SUBROUTINE TO COPY A HUNK OF STRUCTURE TO THE HIGH SEGMENT + +EBPUR: PUSH P,E + PUSH P,A + ADD E,HITOP ; GET NEW TOP + CAMG E,RHITOP ; SKIP IF TOO BIG + JRST EBPUR1 + +; CODE TO GROW HI SEG + + MOVEI A,2000 + ADDB A,RHITOP ; NEW TOP + TLNE A,777776 + JRST HIFUL +IFN ITS,[ + ASH A,-10. ; NUM OF BLOCKS + SUBI A,1 ; BLOCK TO GET + .CALL HIGET + .VALUE +] + +EBPUR1: MOVEI A,-1(E) ; NEEDED TO TERMINATE BLT + EXCH E,HITOP + HRLI E,(B) + MOVEI B,(E) + BLT E,(A) + POP P,A + POP P,E + POPJ P, + +GIVCOR: SETZ + SIXBIT /CORBLK/ + 1000,,0 + 1000,,-1 + SETZ A + +HIGET: SETZ + SIXBIT /CORBLK/ + 1000,,100000 + 1000,,-1 + A + 401000,,400001 + + +; PROCESS AN ATOM AND ADD IT TO AN APPROPRIATE OBLIST IF IT ISN'T +; ALREADY THERE + +ATOMHK: PUSH TP,$TOBLS ; SAVE OBLIST + PUSH TP,[0] ; FILLED IN LATER + PUSH TP,$TVEC ;SAVE TV POINTERS + PUSH TP,C + PUSH TP,$TVEC + PUSH TP,D + MOVE C,1(C) ;GET THE ATOM + PUSH TP,$TATOM ;AND SAVE + PUSH TP,C + PUSH TP,$TATOM + PUSH TP,[0] + HRRZ B,(C) ;GET OBLIST SPEC FROM ATOM + LSH B,1 + ADDI B,1(TB) ;POINT TO ITS HOME + HRRM B,-9(TP) + MOVE B,(B) + MOVEM B,-10(TP) ; CLOBBER + + SETZM 2(C) ; FLUSH CURRENT OBLIST SPEC + MOVEI E,0 + MOVE D,C + PUSH P,[LOOKCR] + ADD D,[3,,3] + JUMPGE D,.+4 + PUSH P,(D) + ADDI E,1 + AOBJN D,.-2 + PUSH P,E + MOVSI A,TOBLS + JRST ILOOKC +LOOKCR: + MOVEM B,(TP) + JUMPN B,CHCKD + +;HERE IF THIS ATOM MUST BE PUT ON OBLIST + +USEATM: MOVE B,-2(TP) ; GET ATOM + HLRZ E,(B) ; SEE IF PURE OR NOT + TRNN E,400000 ; SKIP IF IMPURE + JRST PURATM + PUSH TP,$TATOM + PUSH TP,B + PUSH TP,$TOBLS + PUSH TP,-13(TP) + MCALL 2,INSERT + + PUSHJ P,VALMAK ;MAKE A GLOBAL VALUE FOR THIS LOSER +PURAT2: MOVE C,-6(TP) ;RESET POINTERS + MOVE D,-4(TP) + SUB TP,[12,,12] + MOVE B,(C) ;MOVE THE ENTRY + HLLZM B,(D) ;DON'T WANT REF POINTER STORED + MOVE A,1(C) ;AND MOVE ATOM + MOVEM A,1(D) + MOVEI A,1(D) + ANDI B,-1 ;CHECK FOR REAL REF + JUMPE B,SETLP1 ;DON'T SAVE THIS ATOM ON TVP + HRRM A,(B) ;CLOBBER CODE + MOVEI A,0 + DPB A,[220400,,(B)] ; CLOBBER TVP PORTION + JRST SETLP + + +; HERE TO MAKE A PURE ATOM + +PURATM: HRRZ B,-2(TP) ; POINT TO IT + HLRE E,-2(TP) ; - LNTH + MOVNS E + ADDI E,2 + PUSHJ P,EBPUR ; PURE COPY + HRRM B,-2(TP) ; AND STORE BACK + MOVE B,-2(TP) + JUMPE 0,PURAT0 + HRRZ D,0 + HLRE E,0 + SUBM D,E + HLRZ 0,2(D) + JUMPE 0,PURAT8 + CAIG 0,HIBOT + FATAL INITM--PURE IMPURE LOSSAGE + JRST PURAT8 + +PURAT0: HRRZ E,(C) + MOVE D,-2(TP) ; GET ATOM BACK + HRRZ 0,(D) ; GET OBLIST CODE + JUMPE E,PURAT9 +PURAT7: HLRZ D,1(E) + MOVEI D,-2(D) + SUBM E,D + HLRZ D,2(D) + CAILE D,HIBOT ; IF NEXT PURE & I AM ROOT + JUMPE 0,PURAT8 ; TAKES ADVANTAGE OF SYSTEM=0 + JUMPE D,PURAT8 + MOVE E,D + JRST PURAT7 + +PURAT8: HLRZ D,1(E) + SUBI D,2 + SUBM E,D + HLRE C,B + SUBM B,C + HLRZ E,2(D) + HRLM E,2(B) + HRLM C,2(D) + JRST PURAT6 + +PURAT9: HLRE A,-2(TP) + SUBM B,A + HRRZM A,(C) + +PURAT6: MOVE B,-10(TP) ; GET BUCKET BACK + MOVE C,-2(TP) + HRRZ 0,-9(TP) + HRRM 0,2(C) ; STORE OBLIST IN ATOM +PURAT1: HRRZ C,(B) ; GET CONTENTS + JUMPE C,HICONS ; AT END, OK + CAIL C,HIBOT ; SKIP IF IMPURE + JRST HICONS ; CONS IT ON + MOVEI B,(C) + JRST PURAT1 + +HICONS: HRLI C,TATOM + PUSH P,C + PUSH P,-2(TP) + PUSH P,B + MOVEI B,-2(P) + MOVEI E,2 + PUSHJ P,EBPUR ; MAKE PURE LIST CELL + + MOVE C,(P) + SUB P,[3,,3] + HRRM B,(C) ; STORE IT + MOVE B,1(B) ; ATOM BACK + MOVE C,-6(TP) ; GET TVP SLOT + HRRM B,1(C) ; AND STORE + HLRZ 0,(B) ; TYPE OF VAL + MOVE C,B + CAIN 0,TUNBOU ; NOT UNBOUND? + JRST PURAT3 ; UNBOUND, NO VAL + MOVEI E,2 ; COUNT AGAIN + PUSHJ P,EBPUR ; VALUE CELL + MOVE C,-2(TP) ; ATOM BACK + HLLZS (B) ; CLEAR LH + MOVSI 0,TLOCI + MOVEM B,1(C) + SKIPA +PURAT3: MOVEI 0,0 + HRRZ A,(C) ; GET OBLIST CODE + MOVE A,OBTBL2(A) + HRRM A,2(C) ; STORE OBLIST SLOT + MOVEM 0,(C) + JRST PURAT2 + +; A POSSIBLE MATCH ARRIVES HERE + +CHCKD: MOVE D,(TP) ;THEY MATCH!, GET EXISTING ATOM + MOVEI A,(D) ;GET TYPE OF IT + MOVE B,-2(TP) ;GET NEW ATOM + HLRZ 0,(B) + TRZ A,377777 ; SAVE ONLY 400000 BIT + TRZ 0,377777 + CAIN 0,(A) ; SKIP IF WIN + JRST IM.PUR + MOVSI 0,400000 + ANDCAM 0,(B) + ANDCAM 0,(D) + HLRZ A,(D) + JUMPN A,A1VAL + MOVE A,(B) ;MOVE VALUE + MOVEM A,(D) + MOVE A,1(B) + MOVEM A,1(D) + MOVE B,D ;EXISTING ATOM TO B + MOVEI 0,(B) + CAIL 0,HIBOT + JRST .+3 + PUSHJ P,VALMAK ;MAKE A VALUE + JRST .+2 + PUSHJ P,PVALM + +;NOW FIND ATOMS OCCURENCE IN XFER VECTOR + +OFFIND: MOVE D,-4(TP) ;GET CURRENT POINTER INTO TP + MOVE C,[-TVLNT,,TVSTRT] ;AND A COPY OF TVP + MOVEI A,0 ;INITIALIZE COUNTER +ALOOP: CAMN B,1(C) ;IS THIS IT? + JRST AFOUND + ADD C,[2,,2] ;BUMP COUNTER + CAMG C,D + AOJA A,ALOOP ;NO, KEEP LOOKING + + MOVEI B,[ASCIZ /LOSSAGE--ATOM DISAPPEARED +/] +TYPIT: PUSHJ P,MSGTYP + .VALUE + +AFOUND: LSH A,1 ;FOUND ATOM, GET REAL OFFSET + ADDI A,1 + ADDI A,TVSTRT + MOVE C,-6(TP) ;GET TV POINTER TO NEW ATOM + HRRZ B,(C) ;POINT TO REFERENCE + SKIPE B ;ANY THERE? + HRRM A,(B) ;YES, CLOBBER AWAY + SUB TP,[12,,12] + MOVEI A,0 + DPB A,[220400,,(B)] ; KILL TVP POINTER + JRST SETLP1 ;AND GO ON + +A1VAL: HLRZ C,(B) ;GET VALUE'S TYPE + MOVE B,D ;NOW PUT EXISTING ATOM IN B + CAIN C,TUNBOU ;UNBOUND? + JRST OFFIND ;YES, WINNER + + MOVEI B,[ASCIZ /LOSSAGE--ATOM TRIES TO HAVE 2 VALUES +/] + JRST TYPIT + + +IM.PUR: MOVEI B,[ASCIZ /LOSSAG--ATOM TRIES TO BE BOTH PURE AND IMPURE +/] + JRST TYPIT + +PAGLOS: MOVEI B,[ASCIZ /LOSSAGE--IMPURE CORE EXTENDS INTO HIGH SEGMENT +/] + JRST TYPIT + +HIFUL: MOVEI B,[ASCIZ /LOSSAGE--HI SEG FULL +/] + JRST TYPIT + + +;MAKE A VALUE IN SLOT ON GLOBAL SP + +VALMAK: HLRZ A,(B) ;TYPE OF VALUE + CAIE A,400000+TUNBOU + CAIN A,TUNBOU ;VALUE? + JRST VALMA1 + MOVE A,GLOBSP+1 ;GET POINTER TO GLOBAL SP + SUB A,[4,,4] ;ALLOCATE SPACE + CAMG A,GLOBAS+1 ;CHECK FOR OVERFLOW + JRST SPOVFL + MOVEM A,GLOBSP+1 ;STORE IT BACK + MOVE C,(B) ;GET TYPE CELL + TLZ C,400000 + HLLZM C,2(A) ;INTO TYPE CELL + MOVE C,1(B) ;GET VALUE + MOVEM C,3(A) ;INTO VALUE SLOT + MOVSI C,TGATOM ;GET TATOM,,0 + MOVEM C,(A) + MOVEM B,1(A) ;AND POINTER TO ATOM + MOVSI C,TLOCI ;NOW CLOBBER THE ATOM + MOVEM C,(B) ;INTO TYPE CELL + ADD A,[2,,2] ;POINT TO VALUE + MOVEM A,1(B) + POPJ P, + +VALMA1: SETZM (B) + POPJ P, + +SPOVFL: MOVEI B,[ASCIZ /LOSSAGE--GLOBAL SP OVERFLOW +/] + JRST TYPIT + + +PVALM: HLRZ 0,(B) + CAIE 0,400000+TUNBOU + CAIN 0,TUNBOU + JRST VALMA1 + MOVEI E,2 + PUSH P,B + PUSHJ P,EBPUR + POP P,C + MOVEM B,1(C) + MOVSI 0,TLOCI + MOVEM 0,(C) + MOVE B,C + POPJ P, + ;SET UP LIST OF INTERNAL NAMES AND ADDRESS NEEDED BY COMPILER + +VECTGO DUMMY1 + +IRP A,,[FINIS,SPECBIND,WNA,WRONGT,$TLOSE,CALER1,POPUNW +ILOC,IGLOC,IDVAL,IDVAL1,ILVAL,IGVAL,INTFLG,LCKINT,ONINT,TYPLOO,TDEFER +IFALSE,UNAS,UNBOU,RCALL,SEGMNT,SEGLST,NUMPRI,OPSYS,SSPEC1,COMPERR +MAKACT,MAKENV,BFRAME,TTP,TTB,$TTP,$TTB,MAKTUP,TPALOC,IBIND,SSPECS +CILVAL,CISET,CIGVAL,CSETG,IBLOK1,IBLOCK,CLLOC,CGLOC,CASSQ,CGASSQ +CILNT,CILNQ,CILEGQ,CEMPTY,CIEQUA,CIREST,CINTH,CIAT,CSETLO,CIN +CIPUT,CIGET,CIGETL,CIMON,CISTRU,CIMEMQ,CIMEMB,CITOP,CIBACK,TYPSEG +C1CONS,CICONS,CIUVEC,CIVEC,IIFORM,IILIST,CISTNG,HITOP,INCR1,TYPG,VALG,TESTR +OTBSAV,CITYPE,CFRAME,CARGS,CFUNCT,CUTYPE,CPTYPE,CTYPEP,CTYPEQ,CCHUTY +CIREMA,RTFALS,CIPUTP,CIGETP,CIGTPR,MPOPJ,TAB,$TAB,ICONS,CSTO,DSTO,NTPALO +CPLUS,CTIMES,CTIME,CDIVID,CMINUS,CLQ,CLEQ,CGQ,CGEQ,CLOG,CSIN,CCOS,CATAN,CSQRT +CFIX,CFLOAT,CEXP,CRAND,CINEQU,SPECBND,PGGIVE,PGFIND,MTYO,CMIN,CMAX,RCL,R1C,W1C +CALLTY,CTYPEC,CTYPEW,NOTTY,CHKAB,CTMPLT,IUNWIN,UNWIN2,NOSHUF,ROOT,ERROBL,INTOBL +CINSER,CIRMV,CLOOKU,CATOM,CIPNAM,ISTRCM,CITERP,CIPRIN,CIPRN1,CIPRNC,CGFALS +CPATM,CP1ATM,CPCATM,CPSTR,CP1STR,CPCSTR,CPCH,CREADC,CNXTCH,CREDC1,CNXTC1 +CGBOUN,IIGLOC,MAKTU2,CIFLTZ,CIUPRS,SAT,TFA,WTYP,NAPT,PTYPE,APLQ,PURBOT,GCSBOT +GLOTOP,TYPVEC,1STEPR,LSTRES,NODES,MAINPR,CVTYPE,CSPNAM,CSBSTR,INTBCK,CICRLF +CERR1,CERR2,CERR3,CANDP,CORP,CSQUTA,CIMAGE,ATOSQ,CFILLE,CPRTYC,FMPOPJ +TD.PUT,TD.GET,TD.LNT,CBYTES,MARK,MARK2G,TD.AGC,DSTORE,RCLV,NUMSAT,RMCALL,NPRFLG +NSPOPJ,NFPOPJ,PURCLN,FRETOP,PURVEC,SWAPGC,NTTYPE,CLRSTR,VECBOT] + .GLOBAL A + ADDSQU A +TERMIN + +VECRET + +; ROUTINE TO SORT AND PURIFY SQUOZE TABLE + +SQSETU: MOVE A,[SQUTBL-SQULOC+2,,SQUTBL] + MOVEI 0,1 +SQ2: MOVE B,(A) + CAMG B,2(A) + JRST SQ1 + MOVEI 0,0 + EXCH B,2(A) + MOVEM B,(A) + MOVE B,1(A) + EXCH B,3(A) + MOVEM B,1(A) +SQ1: ADD A,[2,,2] + JUMPL A,SQ2 + JUMPE 0,SQSETU +IFE ITS,[ +STSQU: MOVE B,[440700,,SQBLK] + PUSHJ P,MNGNAM + HRROI B,SQBLK + MOVSI A,600001 + GTJFN + FATAL CANT MAKE FIXUP FILE + MOVEI E,(A) + MOVE B,[440000,,100000] + OPENF + FATAL CANT OPEN FIXUP FILE + MOVE B,[444400,,SQUTBL] + MOVNI C,SQULOC-SQUTBL + SOUT + MOVEI A,(E) + CLOSF + JFCL + MOVE A,[SQUTBL-SQULOC,,SQUTBL] + MOVEM A,SQUPNT" +] +IFN ITS,[ +.GLOBAL CSIXBT +STSQU: MOVE C,MUDSTR+2 ; CALCULATE SECOND FILE NAME FOR SQUOZE TABLE + PUSHJ P,CSIXBT + HRRI C,(SIXBIT/TAB/) ; TABxxx IS SECOND NAME OF FILE + MOVSS C + MOVEM C,SQBLK+2 ; STORE IN APPROPRIATE BLOCKS + MOVEM C,SQWBLK+2 + .SUSET [.SSNAM,,SQDIR] + .OPEN GCHN,SQWBLK ; OPEN FILE + FATAL CAN'T CREATE SQUOZE FILE + MOVE A,[SQUTBL-SQULOC,,SQUTBL] + MOVEM A,SQUPNT" + .IOT GCHN,A + .CLOSE GCHN ; CLOSE THE CHANNEL +] + POPJ P, + +RHITOP: 0 + +OBSZ: 151. + 13. + 151. + 151. + 317. + +OBTBL2: ROOT+1 + ERROBL+1 + INTOBL+1 + MUDOBL+1 + INITIAL+1 + +OBTBL: INITIAL+1-TVSTRT+TVBASE + MUDOBL+1-TVSTRT+TVBASE + INTOBL+1-TVSTRT+TVBASE + ERROBL+1-TVSTRT+TVBASE + ROOT+1-TVSTRT+TVBASE +OBNAM: MQUOTE INITIAL + IMQUOTE MUDDLE + MQUOTE INTERRUPTS + MQUOTE ERRORS + MQUOTE ROOT + +OBTBL1: INITIAL+1 + MUDOBL+1 + INTOBL+1 + ERROBL+1 + ROOT+1 + + +IFN ITS,[ +SQWBLK: SIXBIT / 'DSK/ + SIXBIT /SQUOZE/ + SIXBIT /TABLE/ +] +IFE ITS,[ +MNGNAM: MOVE A,[440700,,MUDSTR+2] ; FOR NAME HACKING + ILDB 0,A ; SEE IF IT IS A VERSION + CAIN 0,177 + POPJ P, + MOVE A,B + ILDB 0,A + CAIN 0,"X ; LOOK FOR X'S + JRST .+3 + MOVE B,A + JRST .-4 + + MOVE A,[440700,,MUDSTR+2] + ILDB 0,A + IDPB 0,B + ILDB 0,A + IDPB 0,B + ILDB 0,A + IDPB 0,B + POPJ P, +] + +IFN ITS,[ +.GLOBAL VCREATE,MUDSTR + +DEBUG: MOVE E,[440600,,[SIXBIT /EXPERIMENTAL/]] + MOVEI 0,12. + JRST STUFF + +VCREATE: .SUSET [.SSNAM,,[SIXBIT /MUDSYS/]] + .OPEN 0,OP% + .VALUE + MOVEI 0,0 ; SET 0 TO DO THE .RCHST + .RCHST 0 + .CLOSE 0 + .FDELE DB% + .VALUE + MOVE E,[440600,,B] + MOVEI 0,6 +STUFF: MOVE D,[440700,,MUDSTR+2] +STUFF1: ILDB A,E ; GET A CHAR + CAIN A,0 ;SUPRESS SPACES + MOVEI A,137 ;RUBOUT'S DON'T TYPE OUT + ADDI A,40 ; TO ASCII + IDPB A,D ; STORE + SOJN 0,STUFF1 + SETZM 34 + SETZM 35 + SETZM 36 + .VALUE + +OP%: 1,,(SIXBIT /DSK/) + SIXBIT /MUD%/ + SIXBIT />/ + +DB%: (SIXBIT /DSK/) + SIXBIT /MUD%/ + SIXBIT /_<-9.>> + HLLZS (A) + LDB B,[331100,,(C)] + DPB B,[331100,,(A)] + MOVE A,D + JUMPN A,%DBG1 +%DBG2: + MOVE B,[440700,,DECBLK] + PUSHJ P,MNGNAM ; VERSION TO NAME IF NECESSARY + HRROI B,DECBLK + MOVSI A,600001 + GTJFN + FATAL CANT WRITE OUT GC + MOVEI E,(A) + MOVE B,[440000,,100000] + OPENF + FATAL CANT OPEN GC FILE + MOVNI C,SECLEN + ASH C,10. + MOVE B,[444400,,REALGC+RLENGC+RSLENG] + MOVEI A,(E) + SOUT + MOVEI A,(E) + CLOSF + JFCL + MOVEI D,SECLEN+SECLEN + MOVNI A,1 + MOVEI B,REALGC+RLENGC + ASH B,-9. + HRLI B,400000 + + PMAP + ADDI B,1 + SOJG D,.-2 + + MOVE B,[440700,,ILDBLK] + SKIPE OPSYS + MOVE B,[440700,,TILDBL] + PUSHJ P,MNGNAM + MOVSI C,-1000 + MOVSI A,400000 +RPA: RPACS + TLNE B,10000 + TLNN B,400 ; SKIP IF NOT PRIVATE + SKIPA + MOVES (C) + ADDI C,777 + ADDI A,1 + AOBJN C,RPA + + MOVNI A,1 + CLOSF + FATAL CANT CLOSE STUFF + HRROI B,ILDBLK + MOVSI A,100001 + GTJFN ; GET A JFN + FATAL GARBAGE COLLECTOR IS MISSING + HRRZS E,A ; SAVE JFN + MOVE B,[440000,,300000] + OPENF + FATAL CANT OPEN GC FILE + MOVEI A,(E) ; FIND OUT LENGTH OF MAP + BIN ; GET LENGTH WORD + HLRZ 0,B + CAIE 0,1776 ; TOPS20 SSAVE FILE FORMAT + CAIN 0,1000 ; TENEX SSAVE FILE FORMAT + JRST .+2 + FATAL NOT AN SSAVE FILE + MOVEI A,(B) ; ISOLATE SIZE OF MAP + HLRE B,TP ; MUST BE SPACE FOR CRUFT + MOVNS B + CAIGE B,(A) ; ROOM? + FATAL NO ROOM FOR PAGE MAP (GULP) + MOVN C,A + MOVEI A,(E) ; READY TO READ IN MAP + MOVEI B,1(TP) ; ONTO TP STACK + HRLI B,444400 + SIN ; SNARF IT IN + + MOVEI A,1(TP) ; POINT TO MAP + CAIE 0,1000 + JRST RPA1 ; GO TO THE TOPS20 CODE + LDB 0,[221100,,(A)] ; GET FORK PAGE + CAIE 0,PAGEGC+PAGEGC ; GOT IT? + AOJA A,.-2 + JRST RPA2 + +RPA1: ADDI A,1 ; POINT TO PROCESS PAGE NUMBER + LDB 0,[331100,,(A)] ; REPEAT COUNT IN 0 + LDB B,[3300,,(A)] ; FIRST PAGE NUMBER IN B + ADD 0,B ; LARGEST PAGE NUMBER + CAIL 0,PAGEGC+PAGEGC + CAILE B,PAGEGC+PAGEGC + AOJA A,RPA1 ; NEXT PAIR OF WORDS PLEASE + SUBI A,1 ; POINT TO FILE PAGE NUMBER + SUBI B,PAGEGC+PAGEGC + MOVN B,B + ADDM B,(A) ; SET UP THE PAGE + +RPA2: HRRZ B,(A) ; GET PAGE + MOVEI A,(E) ; GET JFN + ASH B,9. + SFPTR + FATAL ACCESS OF FILE FAILED + MOVEI A,(E) + MOVE B,[444400,,AGCLD] + MOVNI C,LENGC + ASH C,10. + SOUT + MOVEI A,(E) + CLOSF + JFCL + POPJ P, + +; CODE TO DISTINGUISH BETWEEN TOPS20 AND TENEX AT SETUP TIME + +TWENTY: HRROI A,C ; RESULTS KEPT HERE + HRLOI B,600015 + MOVEI C,0 ; CLEAN C UP + DEVST + JFCL + MOVEI A,1 ; TENEX HAS OPSYS = 1 + CAME C,[ASCII/NUL/] ; TOPS20 GIVES "NUL" + MOVEM A,OPSYS ; TENEX GIVES "NIL" + POPJ P, +%TBL: IRP A,,[HRRM,HRLM,MOVEM,SETZM,HLRZ,XBLT] + S!A <<(A)>_<-9.>> + TERMIN + +GCLDBK: ASCIZ /MDLXXX.AGC/ +SGCLBK: ASCIZ /MDLXXX.SGC/ +SECBLK: ASCIZ /MDLXXX.SEC/ +ILDBLK: ASCIZ /MDLXXX.EXE/ +TILDBL: ASCIZ /MDLXXX.SAV/ +DECBLK: ASCIZ /MDLXXX.DEC/ +] + + + +END SETUP + \ No newline at end of file diff --git a//interr.bin.28 b//interr.bin.28 new file mode 100644 index 0000000000000000000000000000000000000000..46090ddb985b6d799d2e4f2b040ef563534f8ed3 GIT binary patch literal 65510 zcmeFahgTCp_dY&b5+XH(j+CVrDG_NZ$Ob}h5orQS5Tqyyc2SUj{r5a~lidXIeG%mQ zIqx~YJsM`G-kJN{J9p};vhPZreA=6@%Kq_6$&-#?%F#YAzJaS-VLe!8pVtc8V3yvqvD@@iCh+*n>O1=nUoUazVCW~F?` z_hR-GJ%#3+^ki@fcOE*#~tTn+3guea&xRl2q&zi7=X zH$g6J;~a9Gs)U~Uy`+q=dkwlU6Qqz z7XHm^tAD}Td{f#KtbPCEFIY=*@qo4OPi~jB8d-Zv)+R*=n55MH@*3h=Qk!39vkK{~ z-TfnLXJgAmVv5w}mkDdDhf1n;T-KJltSxg{i+Bmv-gjAhS>fAWjc&?X4N{vA(ZNI3 z?*0vHK`tJ$_VxcNYujyBA)U1ge`M|C%zSJiowe=4+Paa-*PKR+l2(zV^&(i0esh#Ab%+tbOuF z)~+l}E{>+N7QGAl+M>a_$!{)eZI`tXm$itOVC_SfwU-tC*sIY^rB*tec=Rq)1n4PrZh?medv>*vv3Z zYRiiM$lA&Ikqdoo@qwd|?bfnFm$myYYY$x3B3^>E5tp@>6<*-g=%!LjE4&zX0Uojz z^j)2`AQul=Tf}7li>y7fS%q}g>VITyY-wTig4CV~Ybzd=Lp&0LpW;)OwP!AC5ih}7 zpUc`y3NK9=&ixbCI-^~%cK`fuSPOFTkhR+Fveu;3o=|EXTi%u0pB~1qCAB3^UzEn$ z()X$~#)_HzO&ixfd;TmszcL5!v<|lrIFlD8mr=0%kNNA&evrS*f5Tspi--Ju&Sba8 zUmxZ7JLT6IRJ-!~!)u7^$?rp(RY>RW*dJB%!qVL01<`#dtSx_36~$DTGcQ%r@3Qux z%UZ;9SbHGj3igO4mlZzZ)##?8>th+13cy3w4*v~nK`tJ$cJzOhwX-&>kj`4nZBEcv zkejBOVJpuprfcO{hqY7prZ-&H&bX|dby#c+Pw$2UKJrr@**-3%D(+&enW zpBYRG?*J8VUj8Y9gQhwwVatj0t2cXW#sNazSc z{WW}@070fyaFMT5q|bYu=BupSEC!L4RBM)gICVjDBGW$7(ni9(VVtfs_ zuTS|JbY4N^=@LU9GVQaH>X#@|$Ge-s$|ZiQ;-@1QiR_Te4Ay2o zZr|S|eH(V8R%*Iwy(sIhpHm|ydvS^1%k&Hkm!P;C+4I|S{k(?Qwn^WGfEn%Q=qJ** zTWUsv^(=hHjpB35*tKfW2z-6VD0?-vO4;t~0bi|nIV(|%RK9AC!IJ`SpLGcSPf;5SjHg|U0Y6X2-0PNAj zDA%7eJPg7+>XizSsw~&<7yatOQAb>iXnQLbL8Yo}NwmIYTYX5Ydile&dG}N^{E^HO z(3I?8-PM5)37b8_yrMs1@6K!%P;|ird(~xUZ%1sw+Eax_)K!)7;m)>8}-h)!oo4dDW4pmuWTq zjMk&3;SSPQ!%)jjQNvJ_CMg(##y7}DqpjCsE^zfuD6P(#*gXHiYBi|f9ouaC#T3ho zccE^}VXYnkTBEdIXEEB3@ys>^)JO`^e|)w0s?$|9x7%E6lfHJ{3BlQ=_W#@3M5ja6Wo>S-LV4z!Me zzsR6B`D5v;O6@KlmBdt;tv%FD)7JZQ|4wZUcB_^%sdDl=`CmxhDT7gZXgFD4Le z?!fV$$oNS6*i2+xAz!2 zWtPo&=@fkMs&zBg_G^=1Ez8A&q3TxKe`77sWiv96U71A(hcd4|F`4=kvTwROMw=qC zAE?sr+LWqS!Ju?8UF1I1%@)9*jZt}s22owLiGVd1W=_AwR|i0Cz2Muk;SX5rxY^FB z$|@U$U0~1FUjqdC4TKRO7)v^1-O4H#AXP3v5HA4`%LPdFB^12ys&!L<%o89e7Y_jv z`Wt{$OELmv^L7CeBS6|!>8chh4FV3}v^L^&a^$(|y5qS7LyQ*@FuX15Imz`}?J{k_ zhPZFDO6k%#Cwsi4s?o{i(S^l!=z-ni`Hyd;t(dIql4LXNPP99gBuwc}D(?#z(4B;4 zm;u++E5nijg$|+6J}nuqNAF7LpM>tl-N`eyDORtQ_Ke+0o7XrugH%|1CN+|JqdSS8 zN;6%tJ4sLlqv%=4j7EghF|u)b-TxiR2(D;bU#WIvv&B++64HKoyLl#E&-K13Pvz1TPK?v<-Ac+M=X5nQ1llXtW`8 zLYK5_wym_6w7xXy%a~#lS!pjiYL#&w<&Sh;UKD6EZ6<_0f)=!yHcJX*aHg8|jPsv@ zUGbw0r(po3t#{U=3uMmwwhbNev>re5(C}BS^?4Zbkb)0+88dHGsjVFbgU~r7{J^2g zkHL@A5U8}D*{{i*U~r-4$AriI%S7Y9ccc?GiAfinK2J|dL5$%%=tpIDgi`4p>4b>J zPGE(bWD|OFe41&tAsQ2|o z_E3_MwbFCm9&3-uTFyXf$5N!r+Ps^x_Sj~I>8+cWzEYDYk$=V)=2tFAEeL|9X&9`0 zoa?go$Yt%Z%UZ-suvW}aN^KRg!jo2be#&N^o3i$pQtQY9rPlfj)uk5J!U*vC_%{p9c-9L%$ zv(d$itZft4KA$SfUT|4^&t+|!%UZ;9SUdXNW$nNvh1>s_wf9&*VXd4~y5f z*2<2G+hgrVif$G~_oEc)itbG(o$4@Lz?06}p+9P6uy#DX!>vPlNbU2f($Oa_YlmFc z+AeDmFTvUYm$fl?UM&2djs5zykCfUW79p&Kt#@^)jY%@Hwu8z37g-CV7f(8C?|E8T zFvJ+nGqx}~x;9F8nyp+1Sq6W%28X`JT>d_D`Mc=y7x5haMrCH3236f9bK%(~|4wv; zzt4nxYGpZja8=R8OgSF%SLV@gkH4QNx|q%nYM-P?S9G(zhPc)+sBYh8hUxq*;dTT* zcdQHiOA)B7%`5ih}M(Rvc^yUjw= zY0rNIkz~x&;3226Y}6uoPQtpNPywXGDtAIL(I;U2^*Qf1Qd=nYF67BpHNw z{pJ5Er|WIjA)V9ff9#IuMpqV}9RbpK9)fBfG`vhcT#l@$K&{e>jAbW1YucUj=5Zfy|!g_0bgB!7`2T}jUL8sb`# z+|q9|!!-V)b=~FL3rZT@@#NTZrbv_DmVV*y$fK@zNZ|0dr7y|fmi{Dv8PDPGgJ*1K z;qN8$-u?$(wQefEUx=YTl1%)Uj8foM5QVKa)C zY3;z{wy2jWmg8Ck2DD_BW#WUIM_OhsB*T>p;5ktja84aHrxwW~)chQN(or`fs0%zT z>g{q-H|?Ts#zh_CB~VxDqVAH}c)#TlejU_-<_IZu_@)n?pR=k?^{W<#m;Yu~yaki^ zc-U&Sw+p?mR4o|_%W+>d(C^aubD%RQ`gomkjfY+_waKkcya-V;Ye z*$4G7uCz0Wj6HJL3fGA3yWuh1&w^xnuBA^nyS==%#VoGLsr$p&Bf%(&D~fc{jfVws ztBRpnDX&_Ax@D+R2@N)+l zm{?H+Vsoon>+Wi2_NtVLMNwve6pZKmNCth}W`#}0dX7Y422zmWWbh>Va2y z2CJVXZNLl;ws(Hb6Khu$Y$64%0f<%$M2YseO}}(nsxJt(S0v-A(dE&(#dN`rqa~Fp z>|1Drg`DV4Hm4bRn`O9yjd+e=ce%TPT8?eTOQ#@Z(0UWWPT(aW*iQAWkM+{b$bIlJqW=*dq=?uDl4ujF3*|wZ3s5tsMm(ETlg1T+KI>!*Zi|7hz?j? zzbp~cpk?daO0Ab9WffA349@6Rem|aZehQZ(y1M8HPlze7IXXjSDZYD5>CX1drB&l~ znDkX56q|FG83kgWS7X6t*+FGkIF_M_OIGIl5TG&pBbIyDArgLBy25YRMk)q`EED>G zi~O3sj}&fYvRRp|4Jat}EECzs-(d9v`I-Geq*vXIN^iAHK#F8!X79vy2QXgMTLg}h zXF{@ukydONj+Gq(h@ z?3wI-x}pfRVyO%dL}*FwGg7x@cI)jFA?)9^^mgEhj3<+MCsh(9U^n1hW9i_GMaB@t z*qcn8q9>8Qf@s3SIcE!!eOIJKPKfSm}!^`2}?|G99(-k>!D#a!gucQ4b*KlTPB zBP&6RQu}X~GeMqp)!v{rgT)F{WSxm-UTeUn-$e|St_m!t5Y!BDbcB-g#Tj9CL+R}acDy>io61V&$z||g^;ohm|?UQruOV56rt!S+ftYtOrW@iv< zJcitQ*Tq_ei#5bcU`;k9NxU|jC8ZNI=hgB$=7;57)u#^$Ei8hg*=O~C12ZgB;-T8a za;9~QmWNH44YFsqb;2xZALu-(qGt=Fs7mjI0Vy#dMje=es2uj<9611h==^nT*@Fva zx}!xUfW32r#Z8`K8q`=wk!~(PwI&P)9mx@oz_c;}Oe>0?y1XA ztn?*UtgPb6kiJ@v9krk7T8Dt>K?aDX?ys!Xi+(g^RQYA^V{x&J+yJO{dnA`%9{1fpu({<25hY|0}BRowij8ba_ymo zT1F9Ti78(7)hqoajPt~pq_G|}Q}V=k+7aDe9a(PVz((KeYmBs~Ebv@U=tgYhbpc@m zR}i`kl9897MXC7CgRaE()+^1CwT`e@LC#}A4z+yLrr$-hrwg4|B;%^lxybMg`!kg; zbWul8&rcQ#T%jA8X1r|{7jr40Xdx(~?5xFfS=|P8(DhhaFpg zA#|OKB#%uOgJEdhqR{P8=y0J~zrGi&vjwO6TN|B&2+pnpNBg`%2RZsdf4x2b+(XW_ z;Mlo>VlK9QvzO@~`+y9Rk(ZzaaD2Vh^V4b5E5WgIg~dvnHYMTMxoXqzA`ULV(Jhj3 zRdn)M0*`5M>~#8#sQqOART7S!D@izZt|sBgcn%z`Pb5R&xNkG(bTV#u(VGiLp*{h} zL>p9?BlpC(yW-fibD!i%(-q$?91jRbo(Ur(QS1!!Ye}jyZX* z!%~=;wV{QnUROQkt3zMta>QZ7U#fCsrl_r|RLmYDlct&seKi^3T4V}MA!W7Vr|{YM zW13Mo`q7$k{+V5Z9Er}X$tdoTKI$td38bL{bJBA*Dm+FpU%7+1&GEL=GTIP7X>7Cre^RFpay;Gk|q_8r|UiFQ?xiLb%ne7Bgk!Ii_uZNeWY^6@UT~nDIDzhRi_r+K7_k zM>N$mW}Khk@)w*$8imZX?kXdzr%@R>y;G$;B}7TFR?g4E9K}%bo{6aSj430OoF-+D zjR$9V-`o}Og92=bSZ{dy6|266AQYpRex)`y`*3~u&CXxm-YJ$I+_XN@v@fQZI zc!0loNv3XVdeI0Ge;9`z8zC$LQ9+?x0T*3&%3hGeRR@dT|oYs18{O1$GVg zGe#X6WbHRfs(Al&4?cnDvs3 zz+Ags#aK&VVwX?Q0Aul39D{9c_noGkn!X-un{DQou6S0`_XKK;;XIeH7RnT?Z31fz zm$gkUYnxrxB3^>ErpwxXo7tupp0ZitpRl$`C?{)s{zm7ZeesaBW4FuNIz^2TRQfl^ zKx2ygi4;bY1>R|13cR7x>_a7TUnVWZPZ>M!NnZzEG*#28ClsS-!snQqGpu@)wx+L~ zpH>`VF9Pj9Rnu%1#$cX^-3hE^ zldKA|Mnh}}wWgYlmhi9H$hj&jH6GihcE=&y0^xZNXc9BB-A5Oi2CIp0l<|1$6|C^A zoZYW;QcGl{@>o?tC^Rx0j-|?m@aD(2v!0x!>|?y1ybajM^8(~Ya7_e#aRZVJS{*lk z-F3wFrMbv*WO9bXxAytD_Qlb;Q49e0y&F5i1Bqk-wAzci{c`Uwt-kQ%X@+dWHQ-7k zA_qm$R>^Ig5^u(4ymV=7|96U(H?o8uvj|bN&=yy>0G#m*r4bv8tXs4|Ba}w0F~^Mv z1~M4rpfH1o@QGA-VC}=ibdh%%)jfrX9#nE3&&;JLvg<)5W-C1D{OFWPUU*O8zoVlV z3D0mO+K#Ur&CQKUW2IvQf(2LQ48a^CYT ziG!Z+NgObqgM-`<8g#*jtL(vRe3A9LaI~woQA;ow6_{@WR)A zbiL2iYKGU6*MdrKw$1#~pmKuyUZt1@2BqnU-@oS3n=RO=vs+Hwi%5F2lGy0YPGW=c z9BkxZLD10=y%jb~NH09@)##?!m?QqOScG8XZ_Z`)V$B~9v4Od3>lRIed13>1FNTeI z4ExKlsg>p82eSd2=cn=`dZYaG$@sb=Ua%F(c;@(>zwD2RpXibR=1*ywChTlZXBBu# zh8I{eXJby_b9}PWFzq$=_26UKEG?abo9PowDP7DTK0DBB35K43INX7K;Pf-S)h>oC z7ek1bz>wVd#0jQe8t@k>NU7FMF|@=os#%0!=x^>$;5D9jh@rXL#n2Kl)C?QWSjrDt zxn#2TOfZzvboE0~>i=0K<%z>7SReNJd_Q7A#{O z%oik%Z(L~^tM>tmm3E$%b|%ZZZTh7Hb6UDUX#G2uY)SKqWLy;)S)5#sERNFNU3iw> z1@?9eMDKhnJi^?jW9s%ka3R|5LKN{Fh-S-HN9h8iHnUHsr7xvjZm=)S;b3AdE71@Y z{znCJj^&E;O}$Z)C++v>c5%8&obn!AW3|+e+Y7OQ!T2VFnmk!g!g44UKwkaWw8%MHwGXWuS%dcweW7D zjF*FPWyBSq8mwiVtm)0p0#x|bTF;Yl(zjCp(-`;kHXGX<+i!d2_E{*>X1Of#wUvo7 zI5}$6a6Z2qM*%+9B5#n0C^gL%$e`XWfrma0GE_4*L!EC7TgFZe;;GeI3%51aLRWAJ ztW)kNyN?tGECFYp;gc-A_1Y!pXZl2Y3qHnsY#d`b+73Q6m2qt0?)5vhxk(C|ZI}j~ zZOF8BUm0(l1-CI|CChBysvCL@-C1?BbX39Jobkq~Dkv?G$&kJY5Q09%Kv#rZBF(r* zoGu*|BH{SqO2~K4zo@=n`*&+_k-c$RipG#+-$E06?be!Ja!!lKSd_l!TU+UP$^!TG z`ko0JMf@gKe==Qu|5Pvc?Se=6RBsdJ@Dkn5xGU4{9cql1kZIY6C*98P%j8=pDZ3nR z+U@+J4jX6v*zJspTwYb2S0x#{9a+&)Z{@3~ELWQ*uJ2QKBue)%A`^ON%>b{S&uIJTK#dIyes-(vLTjClGW30sX9FvAM(v{7{L zu>fRZe`wkL0#mPh`CG4h`5WT}WfB#$?}?F8AF{%eM#1-#Z^GSB-I!Sf$PtSWb>m~X zR|H6(q@wjO@#|Kt2Q!NR`3Ni5%t~6h#*)AyMZd7y@$`#Wxw3cwZ!+{NkOs^?v>Ehi;6+UU=WLvQu+K>LgMIGRb&Tf#GxInJ%z?t+DfqPSHSu+T z*$gX#q&j>{*tUu4S3NIm{+p{A1`4IpXtfcU0#>)x8Jf97=Mm0an7R219~t20T+zAC z*HC!wE=!Cou3K5?)yyzmG;qxVS%s&oQ4a0}tw@j^pIOW;_1rmcJm(G)ITLr9+)H9; zJ@v}hAlsN~8j+Q^dFe_1(OAkL_*zfrret+vL&r6Kkk}RI=BX4Jpx?Vyp-vF z?RB7Jnn|{+mj>K>^B7OSRs2(qkF)z6Xto(I4c?#r-Mx8c8OxBRKx)0A#G%+Lo#hz- zNbwL?%eSlb%808S*!*T0I>4Z1VL2BD5PqaH?6u)5+W}?Y689sWu5oi;a$ld>V4?jr z3}r+qVC~7>&F5_7vrrEiv3MKwhLLH?cwvT0m7|k(l!_%GTj9em@RR)@*1fIHGMt?| zHXDLg+(C9l^7xRk#iJiQbz~Mg13L>l38e~sSn^078iI?{I5jwa>SWMn4FeBM)=rlW zOVI4FCIU*c#_%IsUutTRf>9dWGMYjP58B0ifa9lTiC7PNkq@)^SjaWIpg}{9MZshx z4nfEzTQ;{)8l5wv$Ux_jS#!XuM~!P>ea6_>js_MX=Gjtx>y3^NZ_p(>wgOA9U-&%L zcRitNLp%Hq`9BS6e*Y%=K%2-LzKLF)omA!n?q!Ap?q!CIhq_I77616|D)WI$3b(x) zT}PQ)DQ4&+${X4h59O`g>HV%IZ&+EzLwOs%U3q&%dBf6qsrg8X6ebIQ&%U((yy@!e zfNe9^bd{EJqu~WpQm+0^>#WHl$TQaDItN|;4ox#t>Qnouw>id7QZQbEzj7={^l1#9 z7YqM)HyWCc$=@LsA^iOtD>Au>1N`l{UH(2Me}}Qz&3vp=ugL;DPJ|noNu^5HL?S>s zIitMuONS>0*AwhTo9&X$_&?uw_@~|!qY7{zz3CnISk=HYm;3I0hXaV`aQ{SXOyT~{ zB^3O-`wq<~Yl2N)vDcqiwHbm|}!LZ&OIu7F~v$LoIRX+qX z${fPBsE#T}Lt#wEZMq%M`bZ=%HK)eJdg?ho{B`ejRjFcw1!PL0Jyu|P!(FWDKqlFmbSXUj~4t$rI z6PW(nRZBce`x9qrElfINyPY#=plN>xJ%*-ZG-2k7T5_!xxv@hA64UNLVoU}S!Fo^) z6q}9iP@xLP9`x51n5ty|?%@36_)V|FA2_wyI_Vg?aPgzY7|!$il-aCr8)nvIc`TGfm^~N8J86LEqo^2K;WT41%bD z*eV_94IIrd=wA0Y=wA28cn*KR%XfaL83rwz#iSRWQlp#lmtXrD%wrMKTgmyiEB01{ zmLwy8U*0Z%xo_kr_KgJ1Nhwl9cc!lIXYWl}TW>SN^wz~j@ISEj_hH5$R18>)VMdiZ ztRJjPD*ZwCrbot0uvYF)1#4F_yMHS@-Z0_S=%28*j`b7P%Cz;>SPRl5S=(yx%hc_% zmLGD%Ob3R|Qz0v=^Q?#OC4LM8n%W%iwVlziInBYcQ678w{-o;_h@)D6+soU^;PSOt z!*JpAMY^App<>w);T6oIQET`4Aeu?K)8fjC`qC6i9 zysRL7%K;U^cf?*IQf1@4wQ@POBs~eHpUm|KJc~lAcDia4u5}C0&}dF;-H5V^VZ9wj zX(kr`Fj%H5i!M@NuG1x_v7E(SzLE^{rI04CItgU8cwozXCI_~v`m4HM;OM#e$_}GA zi7e;0aQ%q6<4_t!G9it(LEuIQ9*J3IF8FcQ5-k5J^TyMQbxvay@st&XtIx)?16|Ic z7daWxdeU2x<>B-?N_8c(-)3p4k{55lMVw&IWgi-W9iKj1iws2ap69)7z!3sbswfMmnFt@Cf0sb3Gx3eIyGa5S8mYH7QTv9HS3qRH!5zN3MSygQfbj?d&Q?L9h&uTZx%3J62|eCNW**4F0ZT_b zd{9B4y;(33qCu0Wh{vWwrnHh-?+M4#gIBf8AiihacCEJG&6B&&?@yY>wt`zvlT zjPSc;NFm8gvavg4;j}6c%VlFFj2%l*!7aTfC5|HHJ*BAfiMNH<2s`m(*izWZ`+aD*Ns$H+0j` zW$P(h%`dq;pvbvhbdl%B(yA*DH}7{_f#yUM?qUshqJBkAz(g{DYiM^k)~$8e!!6Ri zQBclT=hLPvw@8blG|_)aHHWGqN?l`9mA&qX-}O51->+efH&|Y#|7jMd@DtRW&?2)q z%lO3Y)z#c4s(@-iR;xu;spjG~{nCvIT*G=%%_WLtT(z(?=WI?;>1r-6YOZU21cyJ9 zYHo9yDQH&2T{VYzXz}T;P~JMp5H)vfGhR9wDTdMw)f}i#syU|(pyuNEd^DTxYHIG7 z~jT<)lad}Ts^@n>NUakki&o*sY;9lJFBeThKkr`Zsm-s>hv}npHzm?3-!u{~t;1X8XWqa#N<|mi?$s0r^ zUV{6wi3rVf3eTH}D@@Ph zAv`B4-& zAvP9n7aOg_#xv@JRykZw^*@gvnd$Jg2qFfLs*i7Y@OwqBdAf)QT-g|7Jri3K=}bHx z)6-Q!SlAtV`|^>fe|G9w$=e!HhRbfmbJ(5pmhC6;Y@3;F$ zFW919k&*!}j+>o)#x>(~IHI$HN*m6f|Bh8RXULs3;`U6*dkj&e3&-R=hAY9v-^r-{ zNB0;y%uCp!i8ipd7dJ(hToIF)jN=1L9!ZPeo=MU{OwM!2*rA&kk#hexcO{yU`)jYRqp<32(TPSv!<(;3)FfvTz zf*2pNGV{*QEDOxTY^`rcRg!sCGxk1u|^5pf`LnPVQpQY~#OjhQt15P#UN{ zKmWWkQ9nfbVgcDWhg)7!#@J4N$i*3LOD;|ZW5|GAk$2P-%^x>-d_!rLetv#_Sqn+y z^x2p~XWdpWR9}oP228s3D5|RNs=;z_sqZ<7S2bWjt<0l8iFE!jZ>ai$t2Q%DQ+<&0 ztIwkcS4GKS9=*CTsbqr5+bLIq$=fO6N+_B9v(L#sFSvh6;e}p}ZaU<74t*M2Vg1NpL`2Qbb)M7YRizv*i4o zILMOO87B%}vqLIFi&GkVfFZq*3Is?L*{8hyLY*oi1&i=jzE=yhLA=);OI4pEKq)z1 z=S@H>hkX{BN12g;~Gw*JMw z&fyNzn|0Q~LmNe0Kx~1BSlR~~V>r)mYpyH7LqTlOV9gYk$(?R7n7juPp-C%^@x)5Y zKa7kG z@WX!x$FGE=qZA0oOqP2^1)2|9@c@qR-`_4A`9-!LFo5E|uOWW33<&eRAsm0C!|@m4 z`0G*-qI(zoX}}^BD4{2yk;r)QoeFH9);b5{5DGQt=u^>zjDqYHml5$e(^N%2ie7uH zxE{C)ZRVHG-?x9fk1S=PVs>e6yj{Kq{cLezX=D-Kg-#nA7*@r^}VSk#K!P?-1~t+mwK(e1h4xcn41RW`jCmWcGJuKV zOAP1O4&$#BkrZ-;aD}t3YU>s3CMyaT$nfV=9EY9zTJTyfE{hG(tY@766sjZ_a-kf3 zS)y8ejas#cxH0~2mWOiub)iPhw#IROrk*)htf5&V$UrlS-uHap71H|R%Afcs5D-|} zYbk#Ni_EaNqbGoi0?g)Nlp&mHB`a`Wf!5`{uInKDK3XjU$^4CUX>^6?q6DH1lCKE( zj=p8%%ejaILP*MEH@p|tw!YcU>C{w^M%!lty9-^)?(b_G#ygtvI|K!ZDrjb zLpgZW3h2tEs}OfF_+wTrvg)%fWIBwWF8(mTr_4pS{3y*m})X ztPccqU5aG;-9uXSu<~$aaT*T)Ao#244&iKew6ni%6AoYJGQum3XZJqq^>F~!Aw&6l z*AT_-!cRoVaED7}0tUe;3mOpq(iKH^AgBsIQn<_`Mc!{b!p6W-|M)RO?>3e#v(NUA ze~!#m-0fN}1+{r;QvJ$l5OOtooo^?B2@0F&N@-dH&hx%_t^dD7e zvrWHrT2@s05m&EB##NDLBa@Tqy+*Ti7^TI%9kSLzlQ_SLEEHQMd7Ugub2|)^6iB>F zc5GFpoCCT}hk;@uEZpH+Vn!)ZeXF{uR5r3))nMsoPSR@F5N6%p&M7~yvpea&Ochx zvFJ?u{4y>=oS9!~A6^>cs^949L}UrKJ4P>H7i}a@0JVH%=QX+cxsLAQcr} zrhnWY<|7$730jnTU4CNN6tydEgUu(n95djq=xj>Qj!nOG3B7w^P0lNlan;kMNo*Tf zfGfSH+mW8m9u7s^>GJ&TX{Oj_K}U&gu=$7wY)p6MW9=znK^1?t883~DvXq-kucIiy z!U!{Un3uGmoHnSc&gsOI6r1i!+M@U~bD{<1%oN?8w)jD9VW_fx{||nc)pRYWU+6mg z6At8SF+Wa2Nvxn5*H6CM&3Sa+rdU;&G74gM>Vz|P&frk%4ni|bF2@-Zx_Jy5GPvuM zb3CvT&F%1yl)G831@GeTHrwhVFaNaRU}S!7abbR@eS9blO~u~@P0v4Pw81WMrm~BZ zHwv#5CvOynD~YDJ1xYlO1b(NW^izs}-E4nJ25tW0Z>%IIa9;hzDfX2TQNRS!{#TK~ z+v;{Q3;^l-4@?zj7!xKaO)SUpHdts;+SD0XHwDj!$3M)ch}yMyUXpDi&vc%n#oei5 zs41$_I|d57@nR^cQ-g1iPg0kln9tm)$bYmrm=X7IlDqJLnZN^J4{NHVC z%P0_9ScD*P_HU3FmSjYtEEcO+RaHYD^3_Bzqb#qeFf*7}MUoxgrdf&5~%AASX{ zlA`Qbsncqe7t8+8*t{y4VtapCu9N-p3bwhtTsi-R<4tA#u+|^gm{@X2;I^3Zq0 z#UhoDv&r!DuZhe2`3vUP_l!6V>%?Q8&V-Y0{58+Y?UdI{9&ye2-WPZLeD51qHkjW_ zafv5gxcD~VcYO48s1g%6-<1!^wltke4)n%92SOeR@bubzE*{~N;oA7GND zXH>t$FHHmXyrRq?C3M;NFTFMKb}@#cr^SF!J+@h4q(?V$$c}G(?KtPdyfitHk$6Rf z`ff%;)>5Eiz*#--Lgo)bp%k*-`|eB-P3Yq-`k|2+fc-}M4pDl2H%gN$Vb9Nz?9p9o zEV3AxvE-u^*4(@`JHIe$&5f#{X{*JR`GslgE?3VnE;Zzq;q!Co9OkUaF{pi>gw&eoov#S<>2_d_RA1@WdpHB+)b zu|hF@lrE;S&)4y@5iLzj>l%7e#q|HO>j2>}*;D$wPv5Cu;CH!xN$rpRPxZ^62}flv zY4Oyq_y4rB=7E*d`bnJmB(A8^VDtslEPv+s1Jx5yPx?|ff3V3mpkD9?>NlX`{Mq6UW+nn^hd;aTBEMdzn2iE-g~x2~40PcP z5wL-Od;)6xXm9Vl-=oEi9AMvx4K<2vKcv+9(jt9Q{>W(e20;7f+98NJw{HsG0Tk{V&p06ga2Qw z{-4^wr541BoqjgWRbrN=y*ip14tLq)2lh#)s=046sQHtcOPQ$nKQ^Pj)6R~+ThFM< z99jda{NKdI`iXf^kWeFd&u%Cj`i>|Wnb}`nzTbz-_aG;CtqRwlD6J){sd$hrtxFmO5?{P`KL{?VM(mSdZ)oSfXebz<0Git*bPBm2WS`Qx=KaA|vaQ~A9a z^s@%1@4k6OTR?la-urGn>&42!6atKfyspNahm1U&dq4I~GOf(*9}b@~*)PyCRmae1 z&eX5F7F}zB)~SBF{4JUN`KR@Cm1e!z*{9rP`0~2i0$XtTT626;cWAQt*E1_#MdNVk zqlavc%&&bo6^_WonbH2-AfssIb1h@s-I1U#^TFHC3IV>H?B`24j~L}nW`Afnz+^=j zGd-~Bx06}5A+%`s^SbUHFok)DCMhxC(q3nEc9l#sUN9>(bC;B66l9hJhZ#>R$a=Z4 zkPDZ&o7+9|lPUbwLSI%>#c3g5YceNBza7G5JgRAZx6j=%3How&+n)%19XW4e9pdWD z{9TB9JZtK!8Fl4aBx0$8F4h8LbT^7geN?XW&n!y`` zl|Gi&b${gnT;^t8SM+>`u5Wo=Bgb8I`5pRZGn2FLQo$$E2$+=P>h}NX*E|YF=Fa#&}yOZIFK2RMtp! zfO6z7$()$~!6Gv{^tj^%` zC|v$1>&9|3va_BK=P|9hmDLo^l{Q_?EuQ@#QgNTPBpJRghrY)r#cWuAab{n>(lW3z}k$kQ`Xc zIUIjS?)w*V2EJCV!{)E;jbC-$DF8!KDSc}L&mQ%jr+szTj<&tUM!rkB;2mIrf-~XVg&2gDhfi2G6$sv^cky}ek$U7Q?WWp*JopW@fBC4RlB~~ zU5py|Rrj*WTB;KI3Kw=7zaY>z>x&ik%lv7cKm1|wfH{wa%EK`mp~h#IzIESz_zvd( z{938moY(msIcv2eFV8-nARczI-Je)2WofU5CpPOlj;k_F!}u}sKyp?d%|_w9cBWOE z=Es@WaZ+{9XsO!Vq2J@#+}W8Ep|5D|_2)`>8AJMJXwBIUaZboX3R~fH`^hw?B zj%@mlY@X?GRe9;JG;u}@l3A6|TrF@i7^oU6%t*(mh+e?_+)ZW)E`cUqbAl5epzFV50N zit_GlKZL_ysaMyP#TmL+c-R?Qg`XKNY(6Lw#BO@D_u%qoVo*zxL7Pn!GT<Wbd`mpBcl=lY&jb_VHpuXk>@u-u_3ED#GPmOyvZdpVbNb%$gF=SX? zEsKq{nGE=uC!y$9yO5!yzK44;p|7-HeQ$<{H0pf&9Yrmqr98CK8!Zv~jKYUOY3ErS z1}~QOdu-YZH9?m4$!i0BcD0|i)S9WerWpDS`l=*O7r0ecFS$I>-TE5AqfWu|gTm&? z4$O!sqgCI0WbQM?`_SuHV-x&*1>ncB}{}E^X#3R)A+W~=Uc4sk!H0D2{5Hy zUizlK)k>ST4=p%isK{ve&Fzutl58cJoAlezw*+H$W-uRZI@8b+@E(lHUJ!0r) zXxcYt!>T7oOwsr{i5}pO86Dgg$@U+ZEAp8$kLpW|ljrPuKdT?fcPB7YcpH z`mg%(eNxa}_#p#8M2djE_b$FlzZTy@-xtZbv9D`>@qx6TJ~3YwW@vdzEqm_1r){Qh zMf+dfU4%$7dfA=zrvUzJDx!8T$8i$|zOlm>Br{Pd=@XA;{j+&%?#`mOrz@lrgsHge!794u( zc-c2q0vCGSw=+c>bR4*~Y=%tNvQd52JN?UjYYu&0-R|#xl$r(CeE$OZ2s{D82|S)8xVg%P`ST2iY2CiSJ3xXX0L)_i6;LzWISrtvfVv zFnk9tzXt6nV@Gv#^0gNy07bt*-f)b}uYE7LzxsnX@VzX`-fS;r&QC!pYvfmL=G%_O zHnzruS9A0()x>E=9^$asS3qOpo*zEIz5cT#GOHjtXPA@s9I zUcfh(@AS#_<=^9HF^9j^MZ*&B%P9Kz9cJe*JnYzg4To6_?U-m6U*EW;NMG^rV%IUL zGF51^>?3<7UyE;cu>fu0*P_%ftgmV+xF37Qp3a=6o@7s=p6dtEMv<*1-|C}tsYe0p zo5{3A(dgn=tV^O%v$esp35UNcd3)4rzFO8zC~Yn>o}G#eKGnnD9I6Uw>)A{@?Cbac zB7)VxAuf7fh&SA0OfJm14sN5|eFr6Kw?p%2YusJ2SKIQ`0eJ<){5^yu>~Z{!5o z2IKv|Mn60J_34Ah#D=PZHM}I{4vDl?1zigV6C*D zTl3ta_Zb07ihtV7eCJ4GkJ|=~UK^k#E!zBQnl-;estSh}`!;|ftYqlZ<(lwKu;$dV z7~jgJg=ZeY65L!QRRh$CBDFa{-JziyLyEC1fYUBi(NXdkI%+-nWAP=5oWX@jAOrze~!HwS#P z%AxeZ@M37RouRNSbN!@BixCmh8Xf+rji=waX<0$9-Ibnw)wepI7ht?Wa9T9K(O9%@ zWKhbC5m-j?N!H`kcoKP|NZ)|nt;QVtl>Po7yfOkQ?GildV17!Z5e~mYeJ|#gb}1u%PzeudnnGF^U+s~ ziN;juIp2yMd*oZ5b!@#xJ!yCkzyY)=5;I_~@xrKdue(fw&l3#?L4wLwWhdnZ0 zFdKG_ty;eYS6dKBPrN*TCJd|;I1EG+L3;5 z;|TZ3A0ytQo|wg4a=lhFTJ+Oa)-7vf-S}F^>~vbvqP@?6?8k9 z)pg|o=CTjV(iso-M^_Jao#voTbI6QqA^WCSRrRnaMx&(V`MZy$ZP`xyb)K)vsBI^@ zP*@U0AO=^<^~InMdHbHloi->cn!el1K1C~HJ%n%jX5G$1)IkLZNH$){{_0vv4(@_{S4v$ZjrITsUYlUzh}O9?8rw^QU*NjXC48s8_cxJ>wJ?Py>I^S35ESUnzLC&`9m$KP~{zMW)va;uR%r^m~O_ zh={6ZRzNFa6qAx0V%j!S?a1 zI@VHTVVQbulPNxsGY3rZ%{Nz4PnUY4?{_~XqR$Wxw!vI z->-AVp^aWGKiBnta>j4yKgQX!`%LJ+V&PVI(b~y78-7M)C?(ppE#dL={9;(TBE7!Bia;)ko3Lx<%03v zf{E=8TH(eRH9uuq^%|4Uote~aufE{mw#884V1T&{d@$$Bo$&{GnN145xV5}X*Dt21 zHQLXQ1os)Vk?ta?c|@wF7`;SHWh>FdhD_!k4Er zYy)4wT>9i#(m;DWIaW)n8!1&@-D-^c2bufSAX~neZ$s)a09&d=#)Fl<$4{NHZiyMK zI2Nu}do|zN_@RCZeO`TuPV!QrMs;QEiM2h>)@IT*i5^zIU#g-Q$2*jk8Q)%J$T)Nl zqrhESOKPg{`M@Eq0$)SXYRji-xcmWqv(dCk=^iw{?>ij0Hvv478Wm$+l=D~0_(VS$ zH`eIiGuj3m{4H-(iw0ivEzdjS=_jlQa`t0hYOcs>t3Ko2=&qFEORood16cK5J!msP z_E}!D*(d$Nm~U`sifJ_q6!ZuZ%UoJ4-_nP5!MKf?r>{0sj@+qjkH2x~o4eZ}t#*!C z`zEoLLfB8U)y#MbvjNFb<%8ofK~4v0$s$!#oOOnF^eb3U_Y4`UwHeK;3GGM<1Xn2( zQ2P*xYRLTf=%v&*;5({&B`x{gXnLHOdmWq{-ALGfyV?t&80#dy)w!@(E&H(B9S-J! z(lBQh^;3^3-~6c)S_G~J3K6Q_>Cq+`Ze4N*l-!AZ*w0$eed88D>_1-UHEi-S7ag2??0`TQOwTBdc|8>JWAKc zqkU3ed`O_X1abt+cl>VVDbT5GHTvfL<`7&a)}vl0<}pX&MQd^RDGfGoL!9`laqCe4 z{ajPaz@0I*7e|MOGPufvx`Dvw^^;%k3Vp;gk?pHT+dE^NEYz|$Knlt+qnRZ$@8#ym zV6C9(HCJz(8Wp^3u3&clSClfM1ikol$9t(q?#L_SHEG74mZo04o36Z~p0abHstKrD zm2p(0*wi-S2sD2VFE$lDU_9%nFbA5S`h~5=Ue{O5QTc1Q{L5ZxsO8vG`W>Q|jN7E( zeQ07X{|J7%UHHL(n8Ot)80mX!!DUPk2c%wuYp1joE_KHjGZU*fp&8prvRH)i8|NPM zZSwpb<5dqY)_kWHRra@mPqUAOzVWiJ=b{;Om(p^V(x=b|^{Y&QS)m_c8J)~g`}C87 z-QmUdxW!O2g{mJ_&N$#+3VqqQVv78&hIG$HB}L)$$1liLe~k1U3VlUuyLnIGXGCVF z8XtcZ`i#~21d6%hByw5FQ4AUeD|VrY?>}W+VHM5BUY#JV`4%JGZsBDd&j7N=ly>bZj+H;tgnvm%o^^Z;ds&$8s~Pp5$-U z34No+v#AY)29?h)iApVpxK=5g*+Bc%-A5>Af2R|c>PYFh(`riJd|xjzIEUWUSaVLE zdHesS1WY-Q*wV7nbQb0TuW$k`LD2)I92WJ`5{5j@9EJ#>Bfv`lSPQfR9Llo71S=R4 OfMN(xFAtn;1_J;gRj%g% literal 0 HcmV?d00001 diff --git a//interr.bin.30 b//interr.bin.30 new file mode 100644 index 0000000000000000000000000000000000000000..492b9023d915aa9b64766f3ba533accfe224dc5b GIT binary patch literal 65699 zcmeIbiCYsvvpw9iBt+H__I=m`f&^q!Q3nY7D!ZT(1Q8Sw6%`cZU;oajNoEp+`?ARI ze(&?#d35OMwYuw6b@duma-`JpxA!xZnZMpDdD61(PsUxD?SqcXpEZAAiPOy5t9M+! ztj%>>{Ctu@dftKaX=W4$x+TD$b@CGJYk91$<2((6tfmv(#rNBYzD_-Fd! zw&T)wYJSxQR7oUGWcq$tJRo!NbBp85+I!Kx0;j1m8YBH}^z6vWo-3rEva${u#Ffcf z+A8Di_zQ_*Wd+7EY{bx2mUg)C0j^G!T{yK**Qm;@tNZ*#^;$}0HQZk9)sosOpW9*{Ect@80`eVbd?CJ3Pz3 zO0|YtJKsvEQMDNSV$;tHZTa%HDq9tg(zl+kUZwGm^9+vm&na8&DD|27Z88I;0!lTF z+@H!+y%A+F(}M{{mr#k9=fnf`6CFjTO)OmET~v66SEGu9hSEAIxF)Ut-Ky#hE9E=5 zKWmTEQ)tdQ2x<2vN+|N>O`a;Ylq!~Q9W5lZ$k*1;+~*vYtARbGbv8Y{O4n597OZ;Z z#>qvLmX*-wENQE3w(hxP)xUPtke3V$*yv}*WI*LpRSZHTg`|~$_7^3yND)-J$H~t> zKcAi60c&%8Qn*)3u(tBo<*c2Y8JtLAZLZH@?O?@PYl5}8W`ec3z65I-&tdJ!rvz&+ zEc~a}R{w&vxu&!!SiAr08muL`c);5Iqua7pgVg3ibnuY1 z+t*<&$i+j}zWZ-wZL7^Hq_TGIQr3=5&dkoGvbI%NTRT`W^~Ysxi_6+pm$iuJu=e+N zm$eraKJ$-R>vW=I?ThQM7Ubd~YbBYwGli^EYJXE|bt%&AYfrs~xS7=U+srVPwa+eP z?eg5%!cZz}(Yv6pEqGcx_S0pp?XtGtWi8^xS^LOk?L~z@@oIEisnsd9Qa_Q}r`KVv z(`k~mlI*{bwS|j+v$mx9Qr6B5^+!_`a^a$|wsiddVmQIt!i5BD3l|ftWju$qA5Rmk zy|D1cf6Lm!1wxms-35JDHls)`9B6p@3Quy!t=Zu-BxO8g%`puz(dx8 zzN@nqF3t^|liE{ZZTaI;h(~B6( zb6I;q;l)YAxqrf1XS55}?wnnRwICM{S*zVGYfVb+F{ReAmZ~wD7`D;RSi%=*Y^7rF4_)Bu}fWJF3V7oify*vKa+pIz=e^)Q%@7VP4(A?O}+@>uKfP;8scX1`^aV$Qu#Z4scN2EoL)F5x{rjlrH?D4m#!E&;vs8?{##i)WwQ#Yti{~sD18OF zDXJN^^5jCQR-STLJAQxSmCM>mm$g$aYY{KbTCq@swHFoM_K#WXOlFg{m^Zt!K~)5D z@sPDL*K&7K>!;NIq}2MQNLOl)y@t4%)Na_!FqO5HmultNehhJ6GDRwXH-x`~(;a`% zo5n>q=JI#L+l!k;vs)wOjviQmE-&^ zIZ*x}Ru=de&GIMZWjtU2U;o3S*NugoUI>wlM|?$7UtFLt+W8tv4H%ZsJiPfB&ZqhN zkEIreR3YZ+BPtJ5;qk{jnT$A2^R(1?tlIJPcV%iZn1QuHvuOk@dq}3QmjA&497C_n%MF>DT7^ zEyM5ku>u1g9UlaAGvm$5Y$kH!iq2_=MALgLeBQ_Z0ZYfb+m3(seR>O2KZV~jaoG_o zPZjKU9c@2D3}p={^;kY7S$TEa9?ih7|9z94 zaYp*!9SGG)Ru)ZgT83>*<`U%Js3!kO?tlf>50mCc&+$3TtVTk0_jHRCNa!F!{q_7D z1wp1%aDkuWq|f`D;HRwIECi92RBMWUIulO^&OZsMmiR`BtYDy^co8@P~{d~dC zpz{eL$3_rEk;u_d;?DYkHZ&EWbT!Lb5WY2HI_468H(cCpzX ztYhI@ZWNze#-Ryh!O#7StnDAuk}1BFWIDhU zLAL!Op|Y^5E47FJ4u7Sfr~rNO;NIE`()ZPFFatqB@qG>P$fz&G=~DTZhVY6+7T0|Q zC~+~=aoP04|DY)uh>F{?(#{SfN;C z%jai)W+mEBGm(|1GnZbz?n@ahz-7Fabn)|46e!F6%Cx^EUM#Tv_7L=GX}TZFiPCiU z)0GxLB0d4_o=5Xm%v9nx)cfre-Mx#(!pQ43VLhsDOr)fMn!fkcfg`rZRw6Mazra_=}!JElTRI9UX%*@ zX-!S~i&oNCsVh5Zx*1eTsQYR0Q+GeBQ$K6@X)t@li&IcXKjbGxG6Wnk$VQ{3+aeio zb&o2o!5UpZ`^9QCAr=Du@U_HvtXpjB^SdU}*J3xQpp{hBrHB?rJgr&UudNW<1(?ii zK|sBe0bI3o>GZ47AzyXwr$v{>fGXEjK^F>-XyvY}l&olFo3>Ld1&M|bDdo1rGWyuR zX}!{cljbas$coM%ePJsbO+u}#+G;S?c@cx_0U8Sp!Tk8L^c7HPnzr5(MLQ8W{ckuR z@3P=><7qhsBOhwZvcK(pRMOf^HWx!Yp#>Q^IcHk~2zX{6DfOeKtgu!U+u9)dWhdu8 zr@<;gsoQkf@iKa$Z+=dkBrRfIWd73h+p<|&s)1X^&fj@PF!`%`>po*&1}!|KC_l6r zl#(J3=0aGhdx(Lj*xO7&!9cZYzdSB370Z%EZrY56JqZj&K}~`B*&YeKYzZuBsET@A ze@}uogaN{zUQnhDoxMN%^Y~xc&k=1%YQze`eqP;PmU{dTTQZV%N+hT%K`ubbXcCZI zs3dTO>|1&Q+E)iTZ%!XnvRxf1D|>UAhkY{qMmFP?Kx%-YK(PkIn$$kpPIV1h-7+od%2=rR=x_w2u5MJf~ zUEprXs7Rk+y3MM^iuAefd|c?bW8hT9%6kL*I?- zEE82^NHPqK-hLyw>M~^CcDIc-MPx@*@sT#A>Qpc&{Y(eBPwle>Flgh{QlhFB7 zwTm#HqyM13vJpl_2ENS?e8B|!?RH{SRNBlhl|38R1_<;UkWGMKZ0d}iD=J-pRJs5` zyf{EC7a&y^Q1IHT)-A`*+B^Y*a`6x#+5buQp?-uQsJ@CSNk)LI-z`Aq2@tH@u4wbc zLBIiw*M?o5=eVv6&m|aQyr_WTV?o!^k=JS$X$v+)yVNa}-P5vXOsX0kTN;{MXoViw zKA8FXLE4JRIxa{y$?inEXGy}O?xX^va)1HdNobN8aE-nqA{nqv5en_ol=g0@OhPXc zx?6WA%WTsIb|=g1PQqT}+zwI^ZAoe*^+tCRJCbI)Vs{d!3P#Lw$c*+2r{~GWnKl0r z1zTw&Ej`8BSDP)C)RVwwbu5n}sE3@@^!2mTfLM{lw!ngBSuiqy)~8lkw9KIY2#fmYd1si;wV9jSp#S$NpU>cY;@7cdK*%sG@_OE+P0OpL3>gYV~i;_k(IXb zphg*IQNE<}@}fYSX)_@V5-eylZI-!wK^aPg^|Z6!f?e@*dOs87w$-5vWX^lG4IS~K z4lj8)4p7Z?IT-wqf-gB~lQxa4gJ2LaBjKMMs{9xWISqkIXEA%khn@`1RsZVoxPOso z{O68z)Fv^hg45&aNhydioCp1=?6y!UwIdxB(bx(sbJJ~HPmWA5%_c-+)YX%Shw7sv zU9Kg#ILBDAVl!SU1+`waZU^dK?JLVb&yNRsGA8r7Cb>&AY z>AXhfW|q%M?SZhi{%OS%SPyZj{p_;#z-2As#aY{uU~MI`!jn>XZqnwUf5O_&LOG?j zoaJ7TwNR3Lz}gLL*|hFZY7Z&3_b9c8Qlu-jNxSZEB(;^M%?wjp7n>-dK4nqQP95G% zj?JH2udOtNwXxxnr`XKxu(r}ju(r}nu$J*0)-E0-SX-NKvzU~^Gk5--)E+`=D-9MQ zQX9AiYisi*8Cd&DY&dn9k#*~l&7HBfw%BGJQd{@E*WsRH?b6WT0ykQm>u_sfm%>Oe z$NP7R68x<#O7OR~IKf}WbND;_(B*H~W`3y@%>P^d))uh{@^@8+pjQ;#+OQ-ee`SZp z-SPK3MK?gv{VqkiqMPnD#EnF^w#8@q9(v}o_PNVi+hr}{#aY|uO6@E>&lleEk6HViMF?xhucMV`B^g=! zfXVKTwLd7eX_VR@Qlu-j_q>L8bn3h{53wI?oX5iibKF<~jhb(wz`o^jyS z=(a-qlQ8?u`Uz{ZuEE+mF71jCuYLV5Wo=#1W))IcoALQlAs(Av7@C_~oLy)g?VpZL ziWH}Cnlo`w*8?m5I^i^hvo0sW>AGNo(~ReEdQiGWiDz9vOVXj|f5GXx99EZ{e)%7# zVv}a~>nuqIAzpiPx12tr5c?>^j^1#EIL(9njfA+a&So7_IlXpicRW3`yzmky!OwNa zb(mlUf2Vz|?{Vq_tN^(=@-xT;qylUN+zemJcEh{Pf#j)Wl z&u=t!N;2?wN#LmNY!G~B{B7#BS%(z5=>#|u9iPqMrwxsfC{al7YvPIr2lRxF$tkEOtxnvW+@xp4wAi>VEg zkr}52n+AOA&Mpuwiz#eI@!(U__oOB2Ws2pvCV>HM)+L$v;O3F0$#cnYg#&m_)CHVV zOyT4rS%jLI#w!(dlY+Xyi-PVB7j+XZ>Ly*(AzmDH#V+bDn2q;a9^p69DxkTalsbIV zpP!wvs!sJQ7Y3F(uLC_y;^Sef)iBweLl4Vw#~SGOucKHqtgy#WR=PTDG~Ruzbe&k( zs%&Ci&A^^Je0RkVQT9PSiYYz5Wy!Lz6|Mo>Z6m|Z0-2s`>7&l(FK=xzmuqsWeE|DV zkh5-bMUgJJ`C>ubs$%%K9H;Uko%_?Oc;f($2v zXVG70wLKl%TfnXkj0FyyI!I-D22gW01eZAF#p*$@opKQ~|MzOs=xvYRH?7;u-jhKJ zQ!bG`)~2 z*fF%EQu#e|4X}{o-O2g{BX6<{SFjP!5$q0kH&D}o&3LI4B(2@uMzG^}i3_$a@AAQOxH=FDE%8F@<%X4PC4Z#K+_4)|55&wZpI~6(NntzCb z=z!Jr%M~#VTDH!u*?MV0R&|3JoYJqNJ(hNM0+%DY-1}=J2{8pWm&kWEqIC`{y;}BY zF0L5wG}31w6nk}-7zJtbsx7!IJE#l`$2>G~$;x~W0yIR?zp>m(he-G#d%PnyQZb;= zGNBK+$gkNuNa0o{#L8s6f`U@>>Bv6z0jnR#&+H2#z3OaGdaGpuQY0fgb8B`xALCWM zRp2O@wsbR8UeIA$HL}X%j*1oTVb-kxq`NCW=l6!!liaMcK16osQJf)i1SZZR2nBhM zJHS$@a&#z!&wh-R_quZQZG!12M~AK)As(uQ%>W%D$u!HFO`Gvj~SUq$;uWcHoJOCzGk@6DR?@0q=TC2Tv?AhA74c zW#SY)iS!jj6CTbvTj&fC4=>^rqYm~4>_iZ*KgzW9-$};PjgZrvhGNe1Eos}XI3P z=76M`czSx$oPct3S^~<=fdrHp&w+CLCdm*e7u(D^m5fbKLT}Y22=#GWFWv^0|8({E zI(RN7dD3*-(sXwT&538eBb@OD!*|wAA$rvFrH5fNElQ z5Jv!l5kgt(p`xYVv=soddqyoe?W7Mr#FqptS^*1^0;{Y)CwTZ9^Jc*Pkgdf7TQ-MTpc*K9>|xnM1$aXT}OSmUwg<}w#+ z+XgW z`XFKUm_7TTPM9U^1HBvyR8QJ#8Udulgcx(X@;vt9+*$_!qVw0WWe+Zx>5dka0QSyJ zmZHi9^o(i?DN@Y^-8CF^Bu6{~(@F<0ttei#Ilnq^Oe>%x3$U=-LLf8HtWmzk!BzTI zTQ*Z5Ky{8QebKV99o35BRb3MogNNR5ou@;pl~Vdr>w}VT>gLkxUtrnXW+Sh2K$=Yg z(q&e?k7Q)UX#q-3zop62X z#qwCI!;acR2$Q}J0nvkGuxRQh6*YRnuX^mLRUd$H6*hCu9$1K@b@G#$uFEc45m*M~ zL)PSct=7c+wtHX?#XfI78J<-oVf}4T;T#$R-mNeL3kGv0#_{pUR*F5eSi>k{Ejd}$ zDgCYDNfmtJuGl)zOv#ffycgYG)xXrhfsOvLr=h=f!IO`hbti*1@;ZmGJ}=Wtji)q{ zkrSsyso2)Tjxh&0S2LalS*#%Ei6DnU7q#hk9_^_@=M~AgYG}HDV3PfrN)@`OBdBM` zb9t`N4NfrLCJSvp*5IUy~%8k7T8`luJwgr;M zrkjOfXx*XEeWcKZaB5%w7_7Agr~1B)&Orp{g9AtVtX>B>`lsGHduGBz&W+&Mwv1xV zw|(*{gUkAWG?I}Mrv-3)x6$?c8gOh|X0g(yjR`omt=RNCkArh?bc{6a&w-;QTh|1RJ2rDpCF7PC$GLD6>f>;Xw?Vl%cwdaW zD{ii8+aY<6P48syo&8AN)Ovm6u5Hg|k>^o-*{a(m(>rZ@qSi6J zQ)s(#^wE{0Jy(tpFD^%NzE=>8H;3U!zWTtr=80ua)N{vs-YKgM(LS0%j=<3)ltd{ZP~Rf~&o0E51M_Qx6kv2@74-xWCZ5w-2$_Lz+9%{ z!Egm#JYlxe%Hf%G$RK*`^krG~a$(ozp zx-4B0WjdciobGi%5OFXbejL3UC62je!QP_*Ddv{0c)^yX&k`VbVIElj!N_Bhsh6TX zk>b7uvDCa2_(G-Ghf3t0bXtnv(zeE_6Fcyssp@7ut{6oVzQo*|Vb!6uRekyFq5dftSrzbKKl>}50$0i={k$nuoP*flWIj0j~K_GTW|iLjOQC~VTGsODpkO$ z3PPcg;czTfHiS1nzM1jt__ni%kvbUuK4b9fY>Hekuu}Kc! zT4$zP7lx*XFaX@~u5^j?#gl=DMX$?xB7KiXuH7vAIe@8~E-!ZXkxZN;x9 zO-~O=W2IsPf(2LPC3{f@RVKFTX5k}lyuuc16SN1un@lvnZWhi2QxZprwr zBbzl$Vf-%~;)>B%-LuY#`0yB%KW>m;7@BGoOAL`xr2&nJ+ly71o(vkD7p9vgv z9VKwUcn%J-Lu^>ed3V4@cB!-+fAuPOTO3THj4tOy3)KH`d@LYQyhD()>u9qzE0zr%di!obP1DC~-9LI0(X%D%>Lql2} zpS{qr^J+P1r_POZM0ci*+|RM++ogv3-@gvhohjI;wVRIJi%7aN64>a@OkjiY9BgD^ zLD10=-Q^b)9{YFLm?Qo&SU>8BVcB4NMIF(NHGe$B2Ij7J`DM%LuUYiva_mK?vcH@&msC%Pnn`BR#vaXXvSStXv5;RTk= z*?1xFIXGUfPg+&I8GJ08rKM<^9>;tEt>8^4yWVskZ zyf}u+Tny2GKTko@g3N98%L*}6#Ucbl*eG)4!5;6_#6t{C-z|n-5<_*c;f$BLK`Wa~ z)|LfBNj;7UT0AgFA5ir?&<%_zW6k%XX!q7&cxWT9b6}WE66Z^ou}DTvoE9u&?at)M zv5_loW$1p$Vx^rYq@BsKPMdzIz?_gS5L%yIU>Kopk&LVQ2N%Yc`WJ?1@6OGqc7ffU z0?~Uv^FL#5)9C`cAG#3jbRmj(4n#B8NsDxWQJdMP(vozI)J-4?>ie0g!@>AkR=gp~ z{g3nH9LrU8U6eUV`#ru}oURe4H5~M>75i~}AvQ1=zhz3`VTZG+!3a6i3Frc4bDA6+ z__8Y7de}iqsHI~VuCQOn?6$$pHU>1mRYokbBNOq;cw<=>`_NIW_t?sKSLBC2jchwR zj*PcYW6FTdil-WDS;wn7nv)Aqk+-W|&k9N3`#hy7T-zHqwmG)n_R8(CP^8UrS>&#j zjxsnoYE*MRzY|9Re%8b=B_MdI4qG6j4p|q$LmvSdDvZrgXRih<<9#*asg)WFw>8#4 zSCE1>xudKdDGXQw&OF0US$gZXi_T8<(bn(>(szjEXgm1GRK_<8ce&rI!TuzNg0KzK zpsfX&Ht#57-&t@QMpm-S=B>J+*U+6+H%mtq+|8={PE|o^iA;v{jDisKDY%%e8@cp{ zaW6StIx0lM@#0Fz3Flu_&!3$#oH35zh!Yw^lKl#ezHhZw^`f(VBr{f|@A=tMJaXIN zP4}pcBK{Jq%Z4|9|MV~S?FMjx;K=>PF1Onmab?=QLyhs`GF?ac;Pi3#-^=71$8|}% z?sh-@Yw|}#yGK|*b~{7Y66Y03#%@PewAEeBF`E3PNo?{g88xx9s4l>xGsdZ)gs!QI z&&EK$d?ximlmM?6a*+MD=xifbMP<3#OvCkk>YhaD96)41&%|ASOeSVB0cT;InVp;o z8wqI7?|C@A=(YXLESXm}GCqeUtcig47tL5-fTmY2nq-h9C~>cC>we|-5QyiXDZ{ zwA_}=Ga=xST&FFUBB!E>$O$pB9N$7RU?aS_SCe$g^k&#Nu-OQy9XRfNo2763ltz-3 zi>=0Um|;a&$|$<~Kmanj^L)wuMW^o1uDWqAe`7pU8mm>9eUGb~9%O|lg@U8s9^`Lg zLRj81zL`ycd}a}%ZZwvAMS%23Dq0Vtf9}+JFmnhH{082NnUk<`jhECf@e9@k5$tw6 z{UTPbEFQqy%nj6j`A?Um|Hu0~dkmX3PGv>X{`O1v4w_uU$mC0&?HuEIe6spVdk1?A zNyc`T)pc&z?J;e7rqY62>j2E8^R;e~lEKXI@Ht@ipv|C91Fx$CIA`Mwzj}-WFnipq z>ln`gX1aTIU0?p+6nxvc9WcXj+t%S*+_sHZzw%{%_~aVs?8}!*qtymwZ-Bb9&M=qg z+{2j*GdEXhy2;JCk7b9IXVHq0#dRx-z1l;%XyBTKiPLswlN{U&TKz%k_)55?o;&A_ zSKL8D{g-m&u1@)yWE)d;1G4fqFFnisjOmWsO&|9aU%=X=d-KlCBD!lzsamfO)+4}$ z%_HgVugCTkCBW6^-kZmG0bgU2gsy*_{x z4{^10w_2})xQfB%$4_`FEofO-&V>Plmvn~RXd+Fv1IoT7>_;-yDmV8f_Vt-z3+=CA zC?iS%YftWOK4&AJg?h+{#oM4afJ~Fd3zJl;9G$eHR4fVEO3UP6NA`nQ_cz)~21s91 z(26<8wi3sOjCVZx!Baq~VFQZP!BTgLs6!h?1(dvN^J#P6qo;P?GsCO5E0 z49VseN~3dTlv2iDJu;tLb;zI^*5@o6+tI)x#5`N7Z+y^|5|`}Q3M{^RmGpZAH!?N) zTF?&XH2SysOU=-~e`CF`MdS^?v0jCr`gD|epL>~MpL>}hhBaQk}QHeV@vR{Jq;74bA7|?=!5)na_3VHCceiiEtw;p;V1*5pfBS zPR=N8!}hpa_NEIq+a;Cpm*01IS#OF_1-Osi^qzaHs&C%q{({SW#B;cREH7^qFgH+*{7avqIz1nGdS3BtF&MS=^ z`f!8_4_g;k7hCAZz^EOYeyOzJdd3yO*EoV;E_g*UuD5GQrD~)dN%J&we*^PP@gC>B zi%Iup#y-T0V^XLWOkS{3{mn>fk{e8;f$)Bk>o6}qe2BL})%H+6#yHkh2e*Ak%t@Ng zf4ALEl)!w1Iaf1kW4oR6lZ-U&GtgsbevBr}Tv1D|)gm``$UtJo9Y~DHKq6QNnt@`o zIkD~BsK&7eeaAxEDA~XJbmqx=(l+dy^<^hEvO9;Na~D4*O^f_JW!85h$iW0`HTsG; za@>m_`%YYKhIn!0xEDV@y%Y7B(VU=={AT?`oAq7;G*7YAjR*2J@bzv%!+iz6 zv9F-moJ9Me$V%mV)4~1OxxTjVx1ADw8nl^dijMe-+aE{idlg&dDToS)t@7Ygg1=95 z5}M(ud)*`BIs846-}#|tcxu@!CbjTax6=$((u^1PjXcd^5yIcv>+l!(;30qS_PR%t zzxMSTzxEY0r=&;`-O1XX-yL2<+(>kv*4fN3wRLgb<0Y*9dzkSQDh8~@Fr(5P)<3Ov zS?k{P$arzq2HC`5?Q(kOUxml&N4*-|c396Ja(i0K`Uz`uuFhJJCdpb>g5SsQR&?X6 z#jtrQWJPtJ_3*vrz|#*+ZH{-_&gj^j=3v<E~QLXQH^R_a$e67|1T=@AS z-H(Y-qfll;W!X-;i3b=DXS3_TW&p5OUXO6q!U9LLoL1MKNIa*~m`P1Ki}G?f@cI*n z^)CaeAHO5^29YWn?yr_|B0{!tv}>h6jHU*Q4@EqTY!c}b6V>}lr;?N?FdRE z85lOxl|vUPFxTml(^$^pE2?+bwuWX8R<9#@(g0AZ!SAxz zsqSo|cArW$hsfT?_FCN{Kpu*K@dyIWRzaeOI(dm)-gCC?1A1Q>`I8(Ruyn-3@5|~c zRX9%tdfkMcD-frg?2;L!KdTrmkF}054S#K};2hZ!)fhg}e;YO8Hb?Z(DA?hl86T zd%{Lu=a8KYuFJOnV0g29g0Y6s!r{%ej@{Nda%WDtE+PZY3toxRxEP5Lr|ep7Bj_0?Mpu;K?P{oXI9CjE9M?>TX_ zMa4pM`+#KMj|pn!{F-zCp;F5Sa3y}-+vx)JsMo*oT#-)*l9z3{$#iz$HOg0byz*l6 zg!C1th!sR1iVWrT$gh0)-fveI5Bxd((Ss(ERx6RkA*Z)T2d>F&rkKO*=jb^98}JSO&S(MBZ}x-`B9l>MbwR|7jK{{~OdCnw<}3ahC8Cx3EjD zbnza_m1LCFDv?#HxtLAQRAZv*Z#5S$QZkrZoOU)Rs8lr<6E)YdHhA*dRdeeTOhU6F z=BhcwLyJ#zgmTtMhN!s%oAFY~$Vh6E+s)#D`h=Qu+5l=UhM$jS(_Lkw|1y@V`LOBk z_AXXmBh}mze$Lj{s9Pu!z{H-wVXo4`qQ(8i=#Ga9s=icvjdQcU_Rwa|=Ue=;6CN^~ zJl#Kui}2#V&;Tu(bjoiz{ZP0cS$(>Q)pgn4x}2W4K@_1b_Yp77eK{J1?XAlh=HIl` z{qQPylTOa^M(VyWf$qo*jLOfO*I;}Gy8&VRq0IWJyD}<$O=LW-a0vUF6o`jv9(7;J z7Z%1(?dNH{ zK6yTei=uoGa~mVb0rapk_~x!y-WEj&C||R1|Ht9X_Xe+pZpQs`6my>Yo4DYRzVf7S zzkdNoy6|f(3p1_Jq2Zx9oc5K!a@zO2Dj;^0$T{?VM!8^Pt1r6-Q(O_{CqEKbVSP(ovGzs{b~jMRF#)t?Q@) z+aU<-es;I2AVPLeVNux^8Rd{$wy0Kg75!9VVnY@9AfpH<-Pp_j0IGcLLlFaKGH+*# zW(-OVQ``P3_ZaFVBRx)wQXlHlmYSW0z0#07W6*8bC(^LwQS<^@u+q9B(4uw;;@ZD4IKtcxzWqAiNaI6hE8pQXj`P6hE&^Iy2s{J__)n;4PGUPMj?54Bs)rb4r` z20X!Sq0XnT#~F}YnC}#|B0X477`O8Vb?h4>iVdpz9_Fegjo!C%H2N{vFcyOjDXNt!Nd}ay%_$$cZ4U z0h=CW2;Ui2z5z>b!(B+DC|8EGEHYv>qck1;gMU>=;avmD*DFOjn>e6yseF~zgFcy4 zaK5pNrVfw?=o`RG3h(GZ8+3F>cQM0!;2R5u;?g?=rc@#gm1^VU# zvT+VGD@kK)CqLxkjJ72gCxc;Rz$WpInxgq*hWzr0X6a{VXBV}QG)|9=DRkED)w$}U zXr~RP+yQPrZ4UA#I4H7!Kk5=*B&3g6X3^OhagZUiGfotI zhC(V$ivjoMBgQMD0s#_5_9<_FP^a?#yajkG-@7^T!~NXevQ*U>0+f>DbJq^E|}TKF}D$dHz~+T@LO+Xt?HDJ&t8^r&|mr?tw(8i&(^qBUUDZ1+gbK zvrQG3BpJLdV!84Y{3w(Yv2va4ReQt}Nk+u#cWb5bD%D@SO4au%gt~_SI3pd)t-i0x z++RP#8Mc&HS@FFCuC~POy2PF_Ek<@E{}RX&?R&hGKvaO~V3G){c&vYAPvQF^p$Bk^ zUl#p-Zp6U*#qt$Q_7+F*11x;b0n>wH?@Uqh9U3=+W3IAUMhYS-&n|`IUprBkxgi|& zFCA}MJ$2!DHo;6cs}P!iBjY)6Jdu+dgkx^dX1vtG_dEf+EgX*tM@K0Tj<6!Ft4u0$neSuFDsxU)XK!mNx`Kp%R;L7C!9hbUrq)! zF}SLEsdSioQ($!JmXymCch!woRQ4#OUe#CLT!~Oxxd&DhGhuREo{^nL@}ny269c1b z_r=33(pLiOAG>2vBdxy%M_oG5eky{&&yJKaW8+f>Fj4#x!x^^2_^YKS5psoag|n_| z<1OqaD+(9L@E4$U)qrzf3qC8vWw9Z`dfM4Lq;* zp$5&iMsR+nkvUtdXqJ9tp!o~-yN+(L=bP(Q-R!c)Ne=}VgU4?W}0?`KeEQkjj!PI$myx&CnI&jz<9Ax`B zmYa^~Rs-^TxQ%3d9kE&qYt(gZH5m6eO@|b^>_XB_TUqVHC(qvi7e5a%Tt~9Nb+sI<2>s@9t?&Qb~+w@DN1vkmgvImd} z&M<}(Zjp?u`sWA7#!`C?L;?MGcpNNT?6{?>09IWbaCmr2|dz-Gp!j4WxVy?ZZT zmRBv@_pHO4fx6E|+2??SD^hpptN!{4vHrP{#VPz?Y3s}){tvg#^-qrsF=i^R`UF=M zBU>lHi~NMxa_$osSBZ;Jmva#hT4kam_qXs!43P`=C{;f2YIze}S>8H{f1c9wge21t zd5_!KtSj5Vlah>(>bP4-%@b11RJ8M>m}IL914PwnzuUWvA&CcK7E0LW5DAjE0*io20{`F$kno+{iH?A;) z!sy{E49RBwuS0%JqO!Z*Ls^$`}zPAN%i~yby5((g$>i{?=$p~QCr=adkCvFhHSr%z-iO&Z{`W*; z#0C;=a1zIrYp~AZZ1)_%XII{0@ek6s+pq4~5eY!#`1Uw)iK$Cuzoszl37%W3lzPTb zN3GLNe5N8w)m2+aJ8K7FsctF%CyC6^=Om-KI*hdhn&&~8$?w56SD%^7q0ECI2I!07 zCAVIQ2yLwThA|SE^&c8KEHb$r3pZE!zevtSXtL+trBy;HleM_6`_jY`S%Hjlp|sk9 zx^;;>rZLL{>{`EAeJ{fJypNHMCbm>X!^3B&t@59~{Sw4%%9G6_ML|oe@X%(w6f#PZ);@2dD8RygX6i66 zVL>@_?uU)o1n?^?4~sCVJUPbVA1Woy~Zi_s;tHUIl%n*pSkYi95_v5VUjc2Fr zoCPByLR_*xQC7dMBEv|_sS+pP0#}+92FsW%(=CXLAZZTBW%IRHTJ=QfI4+ z^7EfEpFKcp#5q0n`Lya=(i-WFv`-Omg(pS(6t8=W7U(b;o_H4MNJXOMD4v{;#j>%D z-BVH31mkVOWhJ_?BE)kP&xdjsi4mLeQVaig8{5(fg%%dU0oz9WhefZn!?`FT$%w?e zy=pkEh)CSVusN+LsQNVlh#X9hpQkgqXzLG}={>{64t&ZurEJk?vt(a^{T5E(%KTbc z`TXEajRw=oa|-g)gE<9$?dL|;;vP4a$Ng-?O=@xLq_#5Y0;npcU<_rw-T0HHfOzc; z+e`i^Tot6+nCWcI=J(H@wy1KqsagHc+y4BO0{P9>eEE~~Lj{+oC^=B-q)O$?W`1c1 zuLv2~-d~dK5VW+6Z7y$?&;Hr%hh+Pq4;h}9yf^r=D@OeFxKi!BAW%wRF+ss5B`i{6*uJUm<8GimZ;xd2# zff_wZi_x%-Kjz6~B;m$i^R(1X`b_5$*Q}$SnB(W$Z&-fC{5HfTo^&11@2$8#zj$8J z#gVWN$u`!VDE{q8j8O)BbS3=S%i*VG!>`@Z*~WVF4Ar7BDK3d8uZH}Mhz?Auv=mH! zlj#%q0U$Oby3M4lllBLi*Vt7=on&Rbo&Uc77sCD@V3MV$RlUKRrU83iQD%@5x@`QH z-kNwjAA?>_w8v%EaQ{O8q$NKIVPUJ@gf+Z4IcbeeTU?*BhR0SGXIm^7me3<)WyW6pcyPvt1Zr~3Lq6*|CAFg>%oy%Zqc8SbKbfNEDn(ErZ<22IO zA)yyhAh3~rE%AKLWpPRM$3WHyfH*UYn~?h##!%h=iE8CP>L&@I(e0S@vV(1=w*zfYA1fjaIP#q&L^R>d)Dqq;N8&I$Lf;tbV7+)KFVWuOXw)ooq z)c@yQk{K$v2UL~W+7{?ok=`Eg;1f_IpWnYf>-A`HBL^6nzd;-CDiGP9hseiCyK>yf zK1RkOTvBAU%bW`@$oZnk9~imdg2;a6j01GZIqxxY-UX2}8F@A}@;D=RT@d*mBjYB; z3BwdVBdAJn)^vL z2fvHWvZOi2|7El6h<1DI(^^_(`twzw%KuATte;p5d2uy@@67uA=SPT=mYwg?Wu$O-(?G*C5O%h1uR@jqo2U2g)-qr%>GeLn@|BRHb>?)G?J|M+8EsQ! zz@_bEv~?6sFkW6pXtIoirWK_Z1qT>UE6jNFYAzctb63dA?i~EhWd53r#`2SVy6USR z{GQ=Kfq3(!j}HCZLxAxtYrFNCkk^s*VfKNz9%g=BdLfNbl+#iE`Z?mI`P1>s24uAM zDC6b($qcy6nJik3aQPo+9XxQD-sy#LBB}_!(6~UrtB=G(WW$ z>F9ErBn06`iMH;Un2Jdn@+Ls@~Wp3tlM9;S9!sXa_ zaykYNI{2BMK9$}`NNT$ozlO1)!lf_Ao-_ru)u^v;7g3CYjKWsY5>Gvdk zW@yW#t1)XY{Y-!u%m^F$j$knuhtflO{cW`NIr7!l*cy~pDzhgc9Y%Aj|qv%(?RN)|xjb?Y+ zr5o*HGM<@1LD^xb$|yQMqD!02>3AFrz~zT1)Su90#xfeK(=CR+%;~UyD!9@@8R5lj zALIRT@YfR>*ucqkP4n#s3E`Q_t)j zIr>Jwvz(5mz7e|aW$_9Ky0Yn_FlrAn+JY~maQR1BHx`+elksvOhiT2NjK)Z|wCP%Q z;nWuqh)#z-RF#GMy0e}f7qVgfr8(I#yGNB+PWv6D_vAV)^f05bVNbaA4tP2Fh{#$) zMq{^VDs4TZdH4G>_!&(ZjaCa~K{HsR61o<%_C`LD`~Ib@z8@89aHSP<(5t0y&Oh*9 z&{fEcywiQyf<$jB=%luO-!mEhcTIWpXG)*kuNXN;WNUORlw`P-PVVC}Vm|fF$L3RP z1#`y0PFe|gT6+98DMg5xNN@K;VN+hah1gTcJQ;DN zpN!^03m_A9_8yZGiX!VhXFor~um1qZ?;8Gk!0FCV-ukbXQ8@hdgZ^13s-aJB6~m(O zt8}A%09zp8dNr_+KWRz0Zz+~H%CxJY%^3|N0L*_G?UOGf^efR{ovdTk+OL)8g%)IT zOUuwFtuXymzwbl&${1aT#@fPLE_bU|eZ8{~HSnv>C6%$5FZAWlZ8dyHpl{YUo8K!F zvpN3AmxW#CJRB;G%-RSwe!BFn`F0}rFtO;@ip_9N+YxfsY6jn&emzD!Ebz9EE)=u0 zw*#Z=bq@|I(@n$pHTY0+Rvyhp{{2>_RqN*0$#*eQb>C>JT;HPKld0^f$*)3R!Rot1 zTy>8h)q*g zp)b04xMnk2UH*E0$s`=+noG+YUsuM6aBwArv#y+j^Y!Fms|H4g*jfQsV>Miw?(3O( zwMPot_34$JOay8Z#6}Zq6ew88F2V$sGO`EG?8n8Om2i8M>d}TCX-R!x;bGb!!c=e? zon?X0=l>Jkbhu^Yx87@J&WpZ<;+z;u8!X7VzxfCbf3;p!TM}dF`~1DO&ACym{$!Ont-A4+Z`nq;PCS5(gu2=cJbk!E@`xiMqr|0@!RI~-@ zcfWgjJO7?T-+KM5l#yXzFRj%4kEtA`5nj+|nbtJc=P*P^Ek}rK zQ0iCBUd?@zJ)gH2FNV-9bdr7*$$R;;fttnqM3lUO%hzj$U(`vPD&MoO)-L0{9@-1l zu}0?mqTY_(Er-6{^sEmE)pGN~3yYX=P-b6fqTVJ=X=Ql@&+$W!c>JKRQtIaO&CV>I zkb=3q{((kl3#Bg__ibF?h%$=v3Z8u@hKxF|mW9UZWE%X;(@^w>ozKuQ-=p`lLSJ#- z+WSc&(rEPUJSb=)Ev2F5?!iAopOOD4DD6CjQ|5)zeost$t~$ulzIkn+Pp$N_mRgva zYn-7!p|6T!bb(tXb&|_N-L0K!Gc@6ww&6-EB3B6s-&8?nES;S82l5&t z{UTcQCrh z#ba;~<0k08kF*7hs8=_yM*52fFGWJ%=vC%dsZpa|mA9{$a~s;~bBy_oku#s@YA;yJ zs(_y|I*j&(8L4H!sv0S)6#D!vAD2bLy`o&Q=Kcz|zJtCGdk2!U0Zly$u41gGZ%icm zBe&+hspCA6ie4g7WTqIsnk>&~7!v-hkrrwxz^OSOa`FA~&!%TFXRY5%{~8-3rN0e@ zlZLFvJKyN;uA~2kmg?${;H7-N&If5C0a@@XA*Hw?bv)bYIdj1MVz#8VMNLCQXbWzQ zD)ZVWUVKIZecx|sb77V{txweWrR{ssPv;AL2l}77(j8LJng1mXKtzg6{r#ud3jLaV zb3NZB=Z2n+nT2|3KYetjB*M_rq*`{B?b9~X-$i@hmMy@gGTmDKGTyx3Jz$Dv@<=FX z$B&Qn3s-{$_YO|KBGCWT_j2bz{L=KJqOYV+<$HCD_C_URtjD82s%MHXz6Jk7;X?7_ znuo`O4t-kW>6D=4b<{c?&`hMe+i^>0GBzt}8u?oenwpt11|fc;AQ6$8Rw^ zfBxQs?RRjPC9q24?c(bhu@vbm99ZZ$AXTOct(Sad&*W?MO)cc14g6X(QD4=V*FHPX zp3a=1o@7s=Uh2Ei29d2s-^$}NsYf2`o6fWa(dfbttWBa(GqtBBPaXa)=e(z0^VPF% zLTR|bm_HF2T+|~!9jfwa>)A{@;Oq7OChF8<)Vy3|f7=XyD%_=Cj_*;kqhs%p(h&U` z(TAopR9m56jD97)u4r6idi430US$Q@1|z+Hh7KM2eEQP^VnbEJ8eWug`$(yjh7rM| zUC|L?@N#Gp(TwW6;rkmlT&53w#p)Q#-J^9#{%Y^?ahxB% zzUk7K#d2+<{}l)|^@v8izHs@XT+p1lJcxRUdVtNNs^vOW)Ga%O>Qf zK2@zw-zyRRvX+94CxcZ!B*bG->oKkN#R!{@&gp>N{$ARC)_6S`7-Hy&S94$2+gia@ zu94H-E^;))x`7nGlDbKLFGKHo+Iv{W2}W4~=BG93GqWW^)jNHpcg-gCR_^_|GN`Bn z$QHDZ)H3F^23n}M9?`V^(CCX}&X}9eeN)Pz^x?olXsDH;uq?Cvq)MA5BBV7Q_{U$p zIO1+-=3FK{`-*R6CMUpnPr+%?{6=%Znvq5+GlpRq#l~2V6XRL`2Sxh&>`pcO+K~_R z`%mGOmYLKp!OstvpAu<=!>{Vu8i#b18ZUpom)1!0ExqHlgnsR-S4+2UeYB~iP4kSk z?iH_q$)iO#7l>FCd#X{qv;$BSYIx)+&~!g}zWh(<92Ixx*Ss3-!=eAi1vm|8n^IxNFv8F4RSZ**mM+i4EkG<(dr9mhvGF>ALTu^!5&j|{~%CN(t?rfsv9O?0Ifto}Jg+XKa+clK+#{72Arjx`)a?`H`2 zw+oCpP6grA(tY#wlTx9tpyB=sYKeRHA%jK2k8+F*owT#QrMFq5tkGKj%c%x(MjvzA zssc#t7YYjVab3$jg!;a+{XUT9#k>b^v)(dAg)ejCP%)RvyyuJZtAeJ2{xf3q^M^J* zw37m3$@h3_Tx$L!D^{KscIY$a_G1Xuf^NHPfvUJA=(Uj78W`iu+N5BZ7CiG)y+&Jk zj+8bC?tc;#M~U4rh6;8yy6U1&mdk-ou$Z-!dQ|wPW}R_a)T>*Eo`#{M$j6)0Eg69? z=e?b4p!V?}=7HxT)9ZP$@}d^{ZDST97KY1gf~}Gxcp1=lIviPzupakG0c@YPQc#5- zKr~-2JJ=Zab-i;a{q1ktjn7e_uN{%LFVVM)wqr=E?Stkn7N+V-e)l}z7y8f|yEgqs z^PhL+kVonndlK}Qe(i@_%W}G4`}kEYYbmm@M7_4o6yIp&exhriJlbX2pT6m$I=a*| zeW%m0;eOdI^_R^VC-Sp}U zUT#_p9sLrmU9p6|p{3`qGnrqI{0-36NB+XkuYGsxTSnI(rmZnr&pwMRU<>kL4a^LT zS4iJDLw9Md3sr#-wy|v@)IYC}JaF`B7UyH{!Ou9MG*Uja5185M7U|BSWr?)POew`)>LUwaNzOyI)B?`e0ub$r!Q1_vD2${w>-bZ)<(x;4fN!ApEUL fY6G{v=Knqa*8>070{_/interr.mid.419 b//interr.mid.419 new file mode 100644 index 0000000..5473cab --- /dev/null +++ b//interr.mid.419 @@ -0,0 +1,2890 @@ + +TITLE INTERRUPT HANDLER FOR MUDDLE + +RELOCATABLE + +;C. REEVE APRIL 1971 + +.INSRT MUDDLE > + +SYSQ +XJRST=JRST 5, + +F==PVP +G==TVP + +IF1,[ +IFE ITS,.INSRT STENEX > +] + +PDLGRO==10000 ;AMOUNT TO GROW A PDL THAT LOSES +NINT==72. ;MAXIMUM NUMBER OF INTERRUPTS POSSIBLE + +IFN ITS,[ +;SET UP LOCATION 42 TO POINT TO TSINT + +RMT [ + +ZZZ==$. ;SAVE CURRENT LOCATION + +LOC 42 + + JSR MTSINT ;GO TO HANDLER + +LOC ZZZ +] +] + +; GLOBALS NEEDED BY INTERRUPT HANDLER + +.GLOBAL ONINT ; FUDGE INS EXECUTED IF NON ZERO AT START OF INTERRUPT +.GLOBAL INTBCK ; "PC-LOSER HACK " +.GLOBA GCFLG ;TELLS WHETHER OR NOT GARBAGE COLLECTOR IS RUNNING +.GLOBAL GCFLCH ; FLUSH CHARS IMMEDIATE SO GC CAN SEE THEM +.GLOBAL CORTOP ; TOP OF CORE +.GLOBA GCINT ;TELLS GARBAGE COLLECTOR TO SIMULATE AN INTERRUPT +.GLOBAL INTNUM,INTVEC ;TV ENTRIES CONCERNING INTERRUPTS +.GLOBAL AGC ;CALL THE GARBAGE COLLECTOR +.GLOBAL VECNEW,PARNEW,GETNUM ;GC PSEUDO ARGS +.GLOBAL GCPDL ;GARBAGE COLLECTORS PDL +.GLOBAL VECTOP,VECBOT ;DELIMIT VECTOR SPACE +.GLOBAL PURTOP,CISTNG,SAGC +.GLOBAL PDLBUF ;AMOUNT OF PDL GROWTH +.GLOBAL PGROW ;POINTS TO DOPE WORD OF NEXT PDL TO GROW +.GLOBAL TPGROW ;POINTS TO NEXT MUDDLE PDL TO GROW +.GLOBAL TOPLEV,ERROR%,N.CHNS,CHNL1 +.GLOBAL BUFRIN,CHNL0,SYSCHR ;CHANNEL GLOBALS +.GLOBAL IFALSE,TPOVFL,1STEPR,INTOBL,INCHAR,CURPRI,RDEVIC,RDIREC,GFALS,STATUS +.GLOBAL PSTAT,NOTRES,IOIN2,INAME,INTFCN,CHNCNT,CHANNO,GIBLOK,ICONS,INCONS +.GLOBAL IEVECT,INSRTX,ILOOKC,IPUT,IREMAS,IGET,CSTAK,EMERGE,CHFSWP +.GLOBAL MTSINT ;BEGINNING OF INTERRUPT HANDLER +.GLOBAL INTINT ;CALLED BY INITIALIZER TO TAKE CARE OF INT PCS +.GLOBAL FRMSTK,APPLY,CHUNW,TGFALS +.GLOBAL IPCGOT,DIRQ ;HANDLE BRANCHING OFF TO IPC KLUDGERY +.GLOBAL MULTSG + +; GLOBALS FOR GC +.GLOBAL GCTIM,GCCAUS,GCCALL,GPDLOV + +; GLOBALS FOR MONITOR ROUTINES + +.GLOBAL MONCH,MONCH0,RMONCH,RMONC0,LOCQ,SMON,BAPT,APLQ,MAKACT,NAPT +.GLOBAL PURERR,BUFRIN,INSTAT,REALTV,DSTORE + +MONITOR + +.GLOBAL MSGTYP,MTYI,UPLO,IFLUSH,OCLOS,ERRET,MASK1,MASK2 ;SUBROUTINES USED +.GLOBAL ERROR,LISTEN,ECHO,RRESET,MTYO,GCHAPN,P.CORE,P.TOP,QUEUES,NOTTY,TTYOP2,TTICHN +.GLOBAL INTHLD,BNDV,SPECBE,DEMFLG + +; GLOBALS FOR PRE-AGC INTERRUPT + +.GLOBAL FRETOP,GCSTOP,FREMIN,CORTOP,P.CORE,PURBOT,GETNUM,GCKNUM,GCHPN,INTAGC +.GLOBAL SPECBIND,SSPEC1,ILVAL + + +; GLOBALS FOR COPY/WRITE HACK FOR GCDUMP AND PURIFY + +.GLOBAL GCDFLG,%CWINF,BUFGC,WNDBOT,WIND,WNDP,%SHWND,GPURFL,%FDBUF,PURMNG,RPURBT +.GLOBAL NPWRIT,PVSTOR,SPSTOR,OPSYS + + + +;BEGINNING OF ACTUAL INTERRUPT HANDLER (MUST BE IMPURE) + + +;***** TEMP FUDGE ******* + +QUEUES==INTVEC + + +; DECLARATIONS ASSOCIATED WITH INTERRUPT HANDERS AND HEADERS + +; SPECIAL TABLES + +SPECIN: IRP A,,[CHAR,CLOCK,MPV,ILOPR,WRITE,READ,IOC,PURE,SYSDOWN,INFERIOR,RUNT,REALT +PARITY] + MQUOTE A,[A]INTRUP + TERMIN +SPECLN==.-SPECIN + +; TABLE OF SPECIAL FINDING ROUTINES + +FNDTBL: IRP A,,[GETCHN,0,0,0,LOCGET,LOCGET,0,0,0,0,0,0,0] + A + TERMIN + +; TABLE OF SPECIAL SETUP ROUTINES + +INTBL: IRP A,,[S.CHAR,S.CLOK,S.MPV,S.ILOP,S.WMON,S.RMON,S.IOC,S.PURE,S.DOWN,S.INF +S.RUNT,S.REAL,S.PAR] + A + S!A==.IRPCNT + TERMIN + +IFN ITS,[ + +; EXTERNAL INTERRUPT TABLE + +EXTINT: REPEAT NINT-36.,0 + REPEAT 16.,HCHAR + 0 + 0 + REPEAT 8.,HINF + REPEAT NINT-62.,0 +EXTIND: + +IRP A,,[[HCLOCK,13.],[HMPV,14.],[HILOPR,6],[HIOC,9],[HPURE,26.],[HDOWN,7],[HREAL,35.] +[HRUNT,34.],[HPAR,28.]] + IRP B,C,[A] + LOC EXTINT+C + B + .ISTOP + TERMIN +TERMIN + + +LOC EXTIND +] + +IFE ITS,[ + +; TABLES FOR TENEX INTERRUPT SYSTEM + +LEVTAB: P1 ; POINTS TO INT PC HOLDERS FOR LEVS 1,2 AND 3 + P2 + P3 + +CHNMSK==700000,,7 ; WILL BE MASK WORD FOR INT SET UP +MFORK==400000 +NNETS==7 ; ALLOW 7 NETWRK INTERRUPTS +UINTS==4 +NETCHN==36.-NNETS-UINTS-1 +NCHRS==6 +RLCHN==36.-NNETS-UINTS + +RMT [ +IMPURE ; IMPURE BECAUSE IT CHANGES IN MULTI-SECTION MODE +CHNTAB: ; LOCATION OF INT ROUTINES FOR VARIOUS "CHANNELS" + +REPEAT NCHRS, 1,,INTCHR+3*.RPCNT + BLOCK 36.-NNETS-NCHRS-UINTS-1 ; THERE ARE 36. TENEX INT CHANNELS + +REPEAT NNETS+UINTS, 1,,INTNET+3*.RPCNT + +IRP A,,[[9.,TNXPDL],[17.,PWRIT],[10.,TNXEOF],[11.,TNXIOC],[12.,TNXFUL] +[RLCHN,TNXRLT],[19.,TNXINF]] + IRP B,C,[A] + LOC CHNTAB+B + 1,,C + CHNMSK==CHNMSK+<1_<35.-B>> + .ISTOP + TERMIN +TERMIN +LOC CHNTAB+36. +PURE +] +EXTINT: +BLOCK 36. +REPEAT NCHRS,SETZ HCHAR +BLOCK NINT-NNETS-NCHRS-UINTS-36.-1 +REPEAT NNETS,SETZ HNET +REPEAT UINTS,SETZ USRINT +LOC EXTINT+NINT-12. +REPEAT 3,SETZ HIOC +LOC EXTINT+NINT-RLCHN-1 +SETZ HREAL +LOC EXTINT+NINT-19.-1 +SETZ HINF +LOC EXTINT+NINT +] + + +; HANDLER/HEADER PARAMETERS + +; HEADER BLOCKS + +IHDRLN==4 ; LENGTH OF HEADER BLOCK + +INAME==0 ; NAME OF INTERRUPT +ISTATE==2 ; CURRENT STATE +IHNDLR==4 ; POINTS TO LIST OF HANDLERS +INTPRI==6 ; CONTAINS PRIORITY OF INTERRUPT + +IHANDL==4 ; LENGTH OF A HANDLER BLOCK + +INXT==0 ; POINTS TO NEXTIN CHAIN +IPREV==2 ; POINTS TO PREV IN CHAIN +INTFCN==4 ; FUNCTION ASSOCIATED WITH THIS HANDLER +INTPRO==6 ; PROCESS TO RUN INT IN + +IFN ITS,[ +RMT [ +IMPURE +TSINT: +MTSINT: 0 ;INTERRUPT BITS GET STORED HERE +TSINTR: 0 ;INTERRUPT PC WORD STORED HERE + JRST TSINTP ;GO TO PURE CODE + +; SOFTWARE INTERNAL INTERRUPTS JSR TO HERE + +LCKINT: 0 + JRST DOINT + +PURE +] +] +IFE ITS,[ +RMT [ +; JSR HERE FOR SOFTWARE INTERNAL INTERRUPTS + +IMPURE +LCKINT: 0 + JRST DOINT +PURE +] +] + + +IFN ITS,[ + +;THE REST OF THIS CODE IS PURE + +TSINTP: SOSGE INTFLG ; SKIP IF ENABLED + SETOM INTFLG ;DONT GET LESS THAN -1 + + SKIPE INTBCK ; ANY INT HACKS? + JRST PCLOSR ; DO A PC-LOSR ON THE PROGRAM + MOVEM A,TSAVA ;SAVE TWO ACS + MOVEM B,TSAVB + MOVE A,TSINT ;PICK UP INT BIT PATTERN + JUMPL A,2NDWORD ;DONT CHECK FOR PDL OVERFLOW ETC. IF SIGN BIT ON + + TRZE A,200000 ;IS THIS A PDL OVERFLOW? + JRST IPDLOV ;YES, GO HANDLE IT FIRST + +IMPCH: MOVEI B,0 + TRNE A,20000 ;IS IT A MEMORY PROTECTION VIOLATION? + MOVEI B,1 ; FLAG SAME + + TRNE A,40 ;ILLEGAL OP CODE? + MOVEI B,2 ; ALSO FLAG + TRNN A,400 ; IOC? + JRST .+3 + SOS TSINTR + MOVEI B,3 + TLNE A,200 ; PURE? + JRST GCPWRT ; CHECK FOR PURE WRITE FOR POSSIBLE C/W +NOPUGC: SOJGE B,DO.NOW ; CANT WAIT AROUND + +;DECODE THE REST OF THE INTERRUPTS USING A TABLE + +2NDWORD: + JUMPL A,GC2 ;2ND WORD? + IORM A,PIRQ ;NO, INTO WORD 1 + JRST GCQUIT ;AND DISMISS INT + +GC2: TLZ A,400000 ;TURN OFF SIGN BIT + IORM A,PIRQ2 + TRNE A,177777 ;CHECK FOR CHANNELS + JRST CHNACT ;GO IF CHANNEL ACTIVITY +] +GCQUIT: SKIPGE INTFLG ;SKIP IF INTERRUPTS ENABLED + JRST INTDON ;NO, DEFER REAL HANDLING UNTIL LATER + + MOVE A,TSINTR ;PICKUP RETURN WORD +IFE ITS,[ + SKIPE MULTSG + JRST MLTEX + TLON A,10000 ; EXEC PC? + SOJA A,MLTEX1 ; YES FIXUP PC +MLTEX: TLON A,10000 + SOS TSINTR+1 + MOVEM A,TSINTR + MOVE A,TSINTR+1 +] +MLTEX1: MOVEM A,LCKINT ;STORE ELSEWHERE + MOVEI A,DOINTE ;CAUSE DISMISS TO HANDLER +IFN ITS, HRRM A,TSINTR ;STORE IN INT RETURN +IFE ITS,[ + SKIPE MULTSG + HRRM A,TSINTR+1 + SKIPN MULTSG + HRRM A,TSINTR +] + PUSH P,INTFLG ;SAVE INT FLAG + SETOM INTFLG ;AND DISABLE + + +INTDON: MOVE A,TSAVA ;RESTORE ACS + MOVE B,TSAVB +IFN ITS, .DISMISS TSINTR ;AND DISMISS THE INTERRUPT +IFE ITS, DEBRK + +IFN ITS,[ +PCLOSR: MOVEM A,TSAVA + HRRZ A,TSINTR ; WHERE FROM + CAIG A,INTBCK + CAILE A,INTBEN ; AVOID TIMING ERRORS + JRST .+2 + JRST INTDON + + SOS A,INTBCK + MOVEM A,TSINTR + SETZM INTBCK + SETZM INTFLG + AOS INTFLG + MOVE TP,TPSAV(TB) + MOVE P,PSAV(TB) + MOVE A,TSAVA + JRST TSINTP +] +DO.NOW: SKIPN GPURFL + SKIPE GCFLG + JRST DLOSER ; HANDLE FATAL GC ERRORS + MOVSI B,1 + SKIPGE INTFLG ; IF NOT ENABLED + MOVEM B,INTFLG ; PRETEND IT IS +IFN ITS, JRST 2NDWORD +IFE ITS, JRST GCQUIT + +IFE ITS,[ + +; HERE FOR TENEX PDL OVER FLOW INTERRUPT + +TNXPDL: SOSGE INTFLG + SETOM INTFLG + MOVEM A,TSAVA + MOVEM B,TSAVB + JRST IPDLOV ; GO TO COMMON HANDLER + +; HERE FOR REAL TIMER + +TNXRLT: MOVEM A,TSAVA +IFG , MOVEI A,<1_<35.->> +IFLE MOVSI A,(<1_<35.->>) + + JRST CNTSG + +; HERE FOR TENEX ^G AND ^S INTERRUPTS + +INTCHR: +REPEAT NCHRS,[ + MOVEM A,TSAVA + MOVEI A,<1_<.RPCNT>> + JRST CNTSG +] +CNTSG: MOVEM B,TSAVB + IORM A,PIRQ2 ; SAY FOR MUDDLE LEVEL + SOSGE INTFLG + SETOM INTFLG + JRST GCQUIT +INTNET: +REPEAT NNETS+UINTS,[ + MOVEM A,TSAVA + MOVE A,[1_<.RPCNT+NETCHN>] + JRST CNTSG +] +TNXINF: MOVEM A,TSAVA + MOVEI A,<1_<35.-19.>> + JRST TNXCHN + +; LOW LEVEL HANDLERS FOR 10X IOC INTERRUPTS + +TNXEOF: MOVEM A,TSAVA + MOVSI A,(1_<35.-10.>) + JRST TNXCHN + +TNXIOC: MOVEM A,TSAVA + MOVSI A,(1_<35.-11.>) + JRST TNXCHN + +TNXFUL: MOVEM A,TSAVA + MOVSI A,(1_<35.-12.>) + +TNXCHN: IORM A,PIRQ2 + MOVEM B,TSAVB + HRRZ A,TSAVA ; ASSUME JFN IS IN A (PRETTY FLAKEY BUT ...) + MOVEM A,IOCLOS + JRST DO.NOW +] + +; HERE TO PROCESS INTERRUPTS + +DOINT: SKIPE INTHLD ; GLOBAL LOCK ON INTS + JRST @LCKINT + SETOM INTHLD ; DONT LET IT HAPPEN AGAIN + PUSH P,INTFLG +DOINTE: SKIPE ONINT ; ANY FUDGE? + XCT ONINT ; YEAH, TRY ONE + EXCH 0,LCKINT ; RELATIVIZE PC IF FROM RSUBR +IFE ITS, TLZ 0,777740 ; KILL EXCESS BITS + PUSH P,0 ; AND SAVE + ANDI 0,-1 + CAMG 0,PURTOP + CAMGE 0,VECBOT + JRST DONREL + SUBI 0,(M) ; M IS BASE REG +IFN ITS, TLO 0,400000+M ; INDEX IT OFF M +IFE ITS,[ + TLO 0,400000+M + SKIPN MULTSG + JRST .+3 + HLL 0,(P) + TLO 0,400000 +] + EXCH 0,(P) ; AND RESTORE TO STACK +DONREL: EXCH 0,LCKINT ; GET BACK SAVED 0 + SETZM INTFLG ;DISABLE + AOS -1(P) ;INCR SAVED FLAG + +;NOW SAVE WORKING ACS + + PUSHJ P,SAVACS + HLRZ A,-1(P) ; HACK FUNNYNESS FOR MPV/ILOPR + SKIPE A + SETZM -1(P) ; REALLY DISABLED + +DIRQ: MOVE A,PIRQ ;NOW SATRT PROCESSING + JFFO A,FIRQ ;COUNT BITS AND GO + MOVE A,PIRQ2 ;1ST DONE, LOOK AT 2ND + JFFO A,FIRQ2 + +INTDN1: SKIPN GCHAPN ; SKIP IF MUST DO GC INT + JRST .+3 + SETZM GCHAPN + PUSHJ P,INTOGC ; AND INTERRUPT + + PUSHJ P,RESTAC + +IFN ITS,[ + .SUSET [.SPICLR,,[0]] ; DISABLE INTS +] + POP P,LCKINT + POP P,INTFLG + SETZM INTHLD ; RE-ENABLE THE WORLD +IFN ITS,[ + EXCH 0,LCKINT + HRRI 0,@0 ; EFFECTIVIZE THE ADDRESS + TLZ 0,37 ; KILL IND AND INDEX + EXCH 0,LCKINT + .DISMIS LCKINT +] +IFE ITS,[ + SKIPN MULTSG + JRST @LCKINT + XJRST .+1 ; MAKE SURE OUT OF SECTION 0 + 0 + FSEG,,.+1 + EXCH 0,LCKINT + TLZE 0,400000 + ADDI 0,(M) + EXCH 0,LCKINT + JRST @LCKINT +] +FIRQ: PUSHJ P,GETBIT ;SET UP THE BIT TO CLOBBER IN PIRQ + ANDCAM A,PIRQ ;CLOBBER IT + ADDI B,36. ;OFSET INTO TABLE + JRST XIRQ ;GO EXECUTE + +FIRQ2: PUSHJ P,GETBIT ;PREPARE TO CLOBBER BIT + ANDCAM A,PIRQ2 ;CLOBBER IT + ADDI B,71. ;AGAIN OFFSET INTO TABLE +XIRQ: + CAIE B,21 ;PDL OVERFLOW? + JRST FHAND ;YES, HACK APPROPRIATELY + +PDL2: JSP E,PDL3 + JRST DIRQ + +PDL3: SKIPN A,PGROW + SKIPE A,TPGROW + JRST .+2 + JRST (E) ; NOTHING GROWING, FALSE ALARM + MOVEI B,PDLGRO_-6 ;GET GROWTH SPEC + DPB B,[111100,,-1(A)] ;STORE GROWTH SPEC +REAGC: MOVE C,[10.,,1] ; INDICATOR FOR AGC + SKIPE PGROW ; P IS GROWING + ADDI C,6 + SKIPE TPGROW ; TP IS GROWING + ADDI C,1 + PUSHJ P,AGC ;COLLECT GARBAGE + SETZM PGROW + SETZM TPGROW + AOJL A,REAGC ; IF NO CORE, RETRY + JRST (E) + +SAVACS: + PUSH P,PVP + MOVE PVP,PVSTOR+1 +IRP A,,[0,A,B,C,D,E,TVP,SP] + PUSH TP,A!STO(PVP) + SETZM A!STO(PVP) ;NOW ZERO TYPE + PUSH TP,A + TERMIN + PUSH TP,$TLOSE + PUSH TP,DSTORE + MOVE D,PVP + POP P,PVP + PUSH TP,PVPSTO(D) + PUSH TP,PVP + SKIPE D,DSTORE + MOVEM D,-13(TP) ; USE AS DSTO + SETZM DSTORE + POPJ P, + +RESTAC: POP TP,PVP + PUSH P,PVP + MOVE PVP,PVSTOR+1 + POP TP,PVPSTO(PVP) + POP TP,DSTORE + SUB TP,[1,,1] +IRP A,,[SP,TVP,E,D,C,B,A,0] + POP TP,A + POP TP,A!STO(PVP) + TERMIN + SKIPE DSTORE + SETZM DSTO(PVP) + POP P,PVP + POPJ P, + +; HERE TO DO GC INTERRUPT AND CLOSE ANY DEAD CHANNELS + +INTOGC: PUSH P,[N.CHNS-1] + MOVE PVP,PVSTOR+1 + MOVE TVP,REALTV+1(PVP) + MOVEI A,CHNL1 + SUBI A,(TVP) + HRLS A + ADD A,TVP + PUSH TP,$TVEC + PUSH TP,A + +INTGC1: MOVE A,(TP) ; GET POINTER + SKIPN B,1(A) ; ANY CHANNEL? + JRST INTGC2 + HRRE 0,(A) ; INDICATOR + JUMPGE 0,INTGC2 + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE + + MOVE A,(TP) + +INTGC2: HLLZS (A) + ADD A,[2,,2] + MOVEM A,(TP) + SOSE (P) + JRST INTGC1 + + SUB P,[1,,1] + SUB TP,[2,,2] + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE GC + PUSH TP,$TFLOAT ; PUSH ON TIME ARGUMENT + PUSH TP,GCTIM + PUSH TP,$TFIX ; PUSH ON THE CAUSE ARGUMENT + PUSH TP,GCCAUS + PUSH TP,$TATOM ; PUSH ON THE CALL ARGUMENT + MOVE A,GCCALL + PUSH TP,@GCALLR(A) + MCALL 4,INTERR + POPJ P, + +; PRE AGC INTERRUPT. CAUSED WHEN FREE STORAGE REQUEST CAN BE SATISFIED BY +; EXTENDING CORE. IT IS CALLED "AGC" AND THE HANDLER IS PASSED THE CALLER, +; AND THE PENDING REQUEST. + + +INTAGC: MOVE A,GETNUM + MOVEM A,GCKNUM ; SET UP TO CAUSE INTERRUPT + PUSH P,C ; SAVE ARGS TO GC + MOVEI A,2000 ; GET WORKING SPACE + PUSHJ P,INTCOR ; GET IT + MOVSI A,TATOM ; EXAMINE BINDING OF FLAG + MOVE B,IMQUOTE AGC-FLAG + PUSHJ P,ILVAL + CAME A,$TUNBOUND + JRST INAGCO ; JUMP TO GET CORE FOR INTERRUPT + MOVE A,GETNUM + ADD A,P.TOP ; SEE IF WE CAN POSSIBLY WIN + ADD A,FREMIN + CAML A,PURBOT + JRST AGCCAU ; WORLD IS IN BAD SHAPE, CALL AGC + PUSH TP,$TTP ; BIND FLAG + PUSH TP,TP ; FOR UNBINDING PURPOSES + PUSH TP,[TATOM,,-1] ; SPECBINDS ARGS + PUSH TP,IMQUOTE AGC-FLAG + PUSH TP,$TFIX + PUSH TP,[-1] + PUSH TP,[0] + PUSH TP,[0] + PUSHJ P,SPECBIND + +; SET UP CALL TO HANDLER + + PUSH TP,$TCHSTR ; STRING INDICATING INTERRUPT + PUSH TP,CHQUOTE DIVERT-AGC + PUSH TP,$TFIX ; PENDING REQUEST + PUSH TP,GETNUM + HLRZ C,(P) + PUSH TP,$TATOM + PUSH TP,@GCALLR(C) + SETZM GCHPN + MCALL 3,INTERR ; ENABLE INTERRUPT + GETYP A,A ; CHECK TO SEE IF INTERRUPT WAS ENABLED + HRRZ E,-6(TP) ; GET ARG FOR UNBINDING + PUSHJ P,SSPEC1 + SUB TP,[8,,8] ; CLEAN OFF STACK + CAIE A,TFALSE ; SKIP IF NOT + JRST CHKWIN + +; CAUSE AN AGC TO HAPPEN + +AGCCAU: MOVE C,(P) ; INDICATOR + PUSHJ P,SAGC ; CALL AGC + JRST FINAGC + +; SEE WHETHER ENOUGH CORE WAS ALLOCATED +CHKWIN: MOVE A,FRETOP + SUB A,GCSTOP + SUB A,GCKNUM ; AMOUNT NEEDED OR IN EXCESS + JUMPGE A,FINAGC ; JUMP IF DONE + MOVE A,GCKNUM + MOVEM A,GETNUM ; SET UP REQUEST + MOVE C,(P) + JRST AGCCAU +FINAGC: SETZM GETNUM + POP P,C ; RESTORE C + POPJ P, ; EXIT + +; ROUTINE TO HANDLE INTERRUPT WHILE INTERRUPT IS RUNNING +; IT TRIES TO ALLOCATE FOR REQUEST+ AT LEAST ONE CORE BLOCK + +INAGCO: MOVE A,GETNUM ; GET REQUEST + SUB A,GCKNUM ; CALCULATE REAL CURRENT REQUEST + ADDI A,1777 + ANDCMI A,1777 ; AMOUNT WANTED + PUSHJ P,INTCOR ; GET IT + POP P,C ; RESTORE C + POPJ P, ; EXIT + +; ROUTINE TO GET CORE FOR PRE-AGC INTERRUPT. REQUEST IN A + + +INTCOR: ADD A,P.TOP ; ADD TOP TO REQUEST + CAML A,PURBOT ; SKIP IF BELOW PURE + JRST AGCCA1 ; LOSE + MOVEM A,CORTOP ; STORE POSSIBLE CORE TOP + ASH A,-10. ; TO PAGES + PUSHJ P,P.CORE ; GET THE CORE + JRST AGCCA1 ; LOSE,LOSE,LOSE + PUSH P,B + MOVE B,FRETOP + SUBI B,2000 + MOVE A,FRETOP + SETZM (B) + HRLI B,(B) + ADDI B,1 + BLT B,-1(A) + POP P,B + MOVEM A,FRETOP + POPJ P, ; EXIT +AGCCA1: MOVE C,-1(P) ; GET ARGS FOR AGC + SUB P,[1,,1] ; FLUSH RETURN ADDRESS + JRST AGCCAU+1 + + + +GCALLR: MQUOTE GC-READ + MQUOTE BLOAT + MQUOTE GROW + IMQUOTE LIST + IMQUOTE VECTOR + IMQUOTE SET + IMQUOTE SETG + MQUOTE FREEZE + MQUOTE PURE-PAGE-LOADER + MQUOTE GC + MQUOTE INTERRUPT-HANDLER + MQUOTE NEWTYPE + MQUOTE PURIFY + + ; OLD "ON" SETS UP EVENT AND HANDLER + +MFUNCTION ON,SUBR + + ENTRY + + HLRE 0,AB ; 0=> -2*NUM OF ARGS + ASH 0,-1 ; TO -NUM + CAME 0,[-5] + JRST .+3 + MOVEI B,10(AB) ; LAST MUST BE CHAN OR LOC + PUSHJ P,CHNORL + ADDI 0,3 + JUMPG 0,TFA ; AT LEAST 3 + MOVEI A,0 ; SET UP IN CASE NO PROC + AOJG 0,ONPROC ; JUMP IF NONE + GETYP C,6(AB) ; CHECK IT + CAIE C,TPVP + JRST TRYFIX + MOVE A,7(AB) ; GET IT +ONPROC: PUSH P,A ; SAVE AS A FLAG + GETYP A,(AB) ; CHECK PREV EXISTANCE + PUSH P,0 + CAIN A,TATOM + JRST .+3 + CAIE A,TCHSTR + JRST WTYP1 + MOVEI B,(AB) ; FIND IT + PUSHJ P,FNDINT + POP P,0 ; REST NUM OF ARGS + JUMPN B,ON3 ; ALREADY THERE + SKIPE C ; SKIP IF NOTHING TO FLUSH + SUB TP,[2,,2] + PUSH TP,(AB) ; GET NAME + PUSH TP,1(AB) + PUSH TP,4(AB) + PUSH TP,5(AB) + MOVEI A,2 ; # OF ARGS TO EVENT + AOJG 0,ON1 ; JUMP IF NO LAST ARG + PUSH TP,10(AB) + PUSH TP,11(AB) + ADDI A,1 +ON1: ACALL A,EVENT + +ON3: PUSH TP,A + PUSH TP,B + PUSH TP,2(AB) ; NOW FCN + PUSH TP,3(AB) + MOVEI A,3 ; NUM OF ARGS + SKIPN (P) + SOJA A,ON2 ; NO PROC + PUSH TP,$TPVP + PUSH TP,7(AB) +ON2: ACALL A,HANDLER + JRST FINIS + + +TRYFIX: SKIPN A,7(AB) + CAIE C,TFIX + JRST WRONGT + JRST ONPROC + +; ROUTINE TO BUILD AN EVENT + +MFUNCTION EVENT,SUBR + + ENTRY + + HLRZ 0,AB + CAIN 0,-2 ; IF JUST 1 + JRST RE.EVN ; COULD BE EVENT + CAIL 0,-3 ; MUST BE AT LEAST 2 ARGS + JRST TFA + GETYP A,2(AB) ; 2ND ARG MUST BE FIXED POINT PRIORITY + CAIE A,TFIX + JRST WTYP2 + GETYP A,(AB) ; FIRST ARG SHOULD BE CHSTR + CAIN A,TATOM ; ALLOW ACTUAL ATOM + JRST .+3 + CAIE A,TCHSTR + JRST WTYP1 + CAIL 0,-5 + JRST GOTRGS + CAIG 0,-7 + JRST TMA + MOVEI B,4(AB) + PUSHJ P,CHNORL ; CHANNEL OR LOCATIVE (PUT ON STACK) + +GOTRGS: MOVEI B,(AB) ; NOW TRY TO FIND HEADER FOR THIS INTERRUPT + PUSHJ P,FNDINT ; CALL INTERNAL HACKER + JUMPN B,FINIS ; ALREADY ONE OF THIS NAME + PUSH P,C + JUMPE C,.+3 ; GET IT OFF STACK + POP TP,B + POP TP,A + PUSHJ P,MAKINT ; MAKE ONE FOR ME + MOVSI 0,TFIX + MOVEM 0,INTPRI(B) ; SET UP PRIORITY + MOVE 0,3(AB) + MOVEM 0,INTPRI+1(B) +CH.SPC: POP P,C ; GET CODE BACK + SKIPGE C + PUSHJ P,DO.SPC ; DO ANY SPECIAL HACKS + JRST FINIS + +RE.EVN: GETYP 0,(AB) + CAIE 0,TINTH + JRST TFA ; ELSE SAY NOT ENOUGH + MOVE B,1(AB) ; GET IT + SETZM ISTATE+1(B) ; MAKE SURE ENABLED + SETZB D,C + GETYP A,INAME(B) ; CHECK FOR CHANNEL + CAIN A,TCHAN ; SKIP IF NOT + HRROI C,SS.CHA ; SET UP CHANNEL HACK + HRLZ E,INTPRI(B) ; GET POSSIBLE READ/WRITE BITS + TLNE E,.WRMON+.RDMON ; SKIP IF NOT MONITORS + PUSHJ P,GETNM1 + JUMPL C,RE.EV1 + MOVE B,INAME+1(B) ; CHECK FOR SPEC + PUSHJ P,SPEC1 + MOVE B,1(AB) ; RESTORE IHEADER +RE.EV1: PUSH TP,INAME(B) + PUSH TP,INAME+1(B) + PUSH P,C + MOVSI C,TATOM + PUSH TP,$TATOM + SKIPN D + MOVE D,MQUOTE INTERRUPT + PUSH TP,D + MOVE A,INAME(B) + MOVE B,INAME+1(B) ; GET IT + PUSHJ P,IGET ; LOOK FOR IT + JUMPN B,FINIS ; RETURN IT + MOVE A,(TB) + MOVE B,1(TB) + POP TP,D + POP TP,C + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,IPUT ; REESTABLISH IT + MOVE A,(AB) + MOVE B,1(AB) + JRST CH.SPC + + +; FUNCTION TO GENERATE A HANDLER FOR A GIVEN INTERRUPT + +MFUNCTION HANDLER,SUBR + + ENTRY + + HLRZ 0,AB + CAIL 0,-2 ; MUST BE 2 OR MORE ARGS + JRST TFA + GETYP A,(AB) + CAIE A,TINTH ; EVENT? + JRST WTYP1 + GETYP A,2(AB) + CAIN 0,-4 ; IF EXACTLY 2 + CAIE A,THAND ; COULD BE HANDLER + JRST CHEVNT + + MOVE B,3(AB) ; GET IT + SKIPN IPREV+1(B) ; SKIP IF ALREADY IN USE + JRST HNDOK + MOVE D,1(AB) ; GET EVENT + SKIPN D,IHNDLR+1(D) ; GET FIRST HANDLER + JRST BADHND + CAMN D,B ; IS THIS IT? + JRST HFINIS ; YES, ALREADY "HANDLED" + MOVE D,INXT+1(D) ; GO TO NEXT HANDLER + JUMPN D,.-3 +BADHND: ERRUUO EQUOTE HANDLER-ALREADY-IN-USE + +CHEVNT: CAIG 0,-7 ; SKIP IF LESS THAN 4 + JRST TMA + PUSH TP,$TPVP ; SLOT FOR PROCESS + PUSH TP,[0] + CAIE 0,-6 ; IF 3, LOOK FOR PROC + JRST NOPROC + GETYP 0,4(AB) + CAIE 0,TPVP + JRST WTYP3 + MOVE 0,5(AB) + MOVEM 0,(TP) + +NOPROC: PUSHJ P,APLQ + JRST NAPT + PUSHJ P,MHAND ; MAKE THE HANDLER + MOVE 0,1(TB) ; GET PROCESS + MOVEM 0,INTPRO+1(B) ; AND PUT IT INTO HANDLER + MOVSI 0,TPVP ; SET UP TYPE + MOVEM 0,INTPRO(B) + MOVE 0,2(AB) ; SET UP FUNCTION + MOVEM 0,INTFCN(B) + MOVE 0,3(AB) + MOVEM 0,INTFCN+1(B) + +HNDOK: MOVE D,1(AB) ; PICK UP EVEENT + MOVE E,IHNDLR+1(D) ; GET POINTER TO HANDLERS + MOVEM B,IHNDLR+1(D) ; PUT NEW ONE IN + MOVSI 0,TINTH ; GET INT HDR TYPE + MOVEM 0,IPREV(B) ; INTO BACK POINTER + MOVEM D,IPREV+1(B) ; AND POINTER ITSELF + MOVEM E,INXT+1(B) ; NOW NEXT POINTER + MOVSI 0,THAND ; NOW HANDLER TYPE + MOVEM 0,IHNDLR(D) ; SET TYPE IN HEADER + MOVEM 0,INXT(B) + JUMPE E,HFINIS ; JUMP IF HEADER WAS EMPTY + MOVEM 0,IPREV(E) ; FIX UP ITS PREV + MOVEM B,IPREV+1(E) +HFINIS: MOVSI A,THAND + JRST FINIS + + + +; FUNCTIONS TO SET TIME LIMITS FOR REALTIME AND RUNTIME INTS + +IFN ITS,[ + +MFUNCTION RUNTIMER,SUBR + + ENTRY + + CAMG AB,[-3,,0] + JRST TMA + JUMPGE AB,RNTLFT + GETYP 0,(AB) + JFCL 10,.+1 + MOVE A,1(AB) + CAIE 0,TFIX + JRST RUNT1 + IMUL A,[245761.] + JRST RUNT2 + +RUNT1: CAIE 0,TFLOAT + JRST WTYP1 + FMPR A,[245760.62] + MULI A,400 ; FIX IT + TSC A,A + ASH B,(A)-243 + MOVE A,B +RUNT2: JUMPL A,OUTRNG ; NOT FOR NEG # + JFCL 10,OUTRNG + .SUSET [.SRTMR,,A] + MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS +RNTLFT: .SUSET [.RRTMR,,B] + JUMPL B,IFALSE ; RETURN FALSE IF NONE SET + IDIV B,[245761.] ; TO SECONDS + MOVSI A,TFIX + JRST FINIS + +] +.TIMAL==5 +.TIMEL==1 + +MFUNCTION REALTIMER,SUBR + + ENTRY + + CAMG AB,[-3,,0] + JRST TMA + JUMPGE AB,RLTPER + JFCL 10,.+1 + GETYP 0,(AB) + MOVE A,1(AB) + CAIE 0,TFIX + JRST REALT1 +IFN ITS, IMULI A,60. ; TO 60THS OF SEC +IFE ITS, IMULI A,1000. ; TO MILLI + JRST REALT2 + +REALT1: CAIE 0,TFLOAT + JRST WTYP1 +IFN ITS, FMPRI A,(60.0) +IFE ITS, FMPRI A,(1000.0) + MULI A,400 + TSC A,A + ASH B,(A)-243 + MOVE A,B + +REALT2: JUMPL A,OUTRNG + JFCL 10,OUTRNG + MOVEM A,RLTSAV +IFN ITS,[ + MOVE B,[200000,,A] + SKIPN A + MOVSI B,400000 + .REALT B, + JFCL +] +IFE ITS,[ + MOVE A,[MFORK,,.TIMAL] ; FLUSH CURRENT FIRST + TIMER + JRST TIMERR + SKIPN B,RLTSAV + JRST RETRLT + HRRI A,.TIMEL + MOVEI C,RLCHN + TIMER + JRST TIMERR +RETRLT: MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +TIMERR: MOVNI A,1 + PUSHJ P,TGFALS + JRST FINIS + +RLTPER: SKIPGE B,RLTSAV + JRST IFALSE +IFN ITS, IDIVI B,60. ; BACK TO SECONDS +IFE ITS, IDIVI B,1000. + MOVSI A,TFIX + JRST FINIS + + +; FUNCTIONS TO ENABLE AND DISABLE INTERRUPTS + +MFUNCTION %ENABL,SUBR,ENABLE + + PUSHJ P,GTEVNT + SETZM ISTATE+1(B) + JRST FINIS + +MFUNCTION %DISABL,SUBR,DISABLE + + + PUSHJ P,GTEVNT + SETOM ISTATE+1(B) + JRST FINIS + +GTEVNT: ENTRY 1 + GETYP 0,(AB) + CAIE 0,TINTH + JRST WTYP1 + MOVE A,(AB) + MOVE B,1(AB) + POPJ P, + +DO.SPC: HRRO C,INTBL(C) ; POINT TO SPECIAL CODE + HLRZ 0,AB ; - TWO TIMES NUM ARGS + PUSHJ P,(C) ; CALL ROUTINE + JUMPE E,CPOPJ ; NO BITS TO ENABLE, LEAVE +IFE ITS,[ + PUSH TP,A + PUSH TP,B + MOVE B,1(TB) ; CHANNEL + MOVE 0,CHANNO(B) + MOVEM 0,(E) ; SAVE IN TABLE + MOVEI E,(E) + SUBI E,NETJFN-NETCHN + MOVE A,0 ; SETUP FOR MTOPR + MOVEI B,24 + MOVSI C,(E) + TLO C,770000 ; DONT SETUP INR/INS + MTOPR + MOVEI 0,1 + MOVNS E + LSH 0,35.(E) + IORM 0,MASK1 + MOVE B,MASK1 + MOVEI A,MFORK + AIC + + POP TP,B + POP TP,A + POPJ P, ; ***** TEMP ****** +] +IFN ITS,[ + CAILE E,35. ; SKIP IF 1ST WORD BIT + JRST SETW2 + LSH 0,-1(E) + + IORM 0,MASK1 ; STORE IN PROTOTYPE MASK + .SUSET [.SMASK,,MASK1] + POPJ P, + +SETW2: LSH 0,-36.(E) + IORM 0,MASK2 ; SET UP PROTO MASK2 + .SUSET [.SMSK2,,MASK2] + POPJ P, +] + +; ROUTINE TO CHECK FOR CHANNEL OR LOCATIVE + +CHNORL: GETYP A,(B) ; GET TYPE + CAIN A,TCHAN ; IF CHANNEL + JRST CHNWIN + PUSH P,0 + PUSHJ P,LOCQ ; ELSE LOOCATIVE + JRST WRONGT + POP P,0 +CHNWIN: PUSH TP,(B) + PUSH TP,1(B) + POPJ P, + +; SUBROUTINE TO FIND A HANDLER OF A GIVEN NAME + +FNDINT: PUSHJ P,FNDNM + JUMPE B,CPOPJ + PUSHJ P,SPEC1 ; COULD BE FUNNY + +INTASO: PUSH P,C ; C<0 IF SPECIAL + PUSH TP,A + PUSH TP,B + MOVSI C,TATOM + SKIPN D ; COULD BE CHANGED FOR MONITOR + MOVE D,MQUOTE INTERRUPT + PUSH TP,C + PUSH TP,D + PUSHJ P,IGET + MOVE D,(TP) + SUB TP,[2,,2] + POP P,C ; AND RESTOR SPECIAL INDICATOR + SKIPE B ; IF FOUND + SUB TP,[2,,2] ; REMOVE CRUFT +CPOPJ: POPJ P, ; AND RETURN + +; CHECK FOR SPECIAL INTERNAL INTERRUPT HACK + +SPEC1: MOVSI C,-SPECLN ; BUILD AOBJN PNTR +SPCLOP: CAME B,@SPECIN(C) ; SKIP IF SPECIAL + AOBJN C,.-1 ; UNTIL EXHAUSTED + JUMPGE C,.+3 + SKIPE E,FNDTBL(C) + JRST (E) + MOVEI 0,-1(TB) ; SEE IF OK + CAIE 0,(TP) + JRST TMA + POPJ P, + +; ROUTINE TO CREATE A NEW INTERRUPT (INTERNAL ONLY--NOT ITS FLAVOR) + +MAKINT: JUMPN C,GOTATM ; ALREADY HAVE NAME, GET THING + MOVEI B,(AB) ; POINT TO STRING + PUSHJ P,CSTAK ; CHARS TO STAKC + MOVE B,INTOBL+1 + PUSHJ P,INSRTX + MOVE D,MQUOTE INTERRUPT +GOTATM: PUSH TP,$TINTH ; MAKE SLOT FOR HEADER BLOCK + PUSH TP,[0] + PUSH TP,A + PUSH TP,B ; SAVE ATOM + PUSH TP,$TATOM + PUSH TP,D + MOVEI A,IHDRLN*2 + PUSHJ P,GIBLOK + MOVE A,-3(TP) ; GET NAME AND STORE SAME + MOVEM A,INAME(B) + MOVE A,-2(TP) + MOVEM A,INAME+1(B) + SETZM ISTATE+1(B) + MOVEM B,-4(TP) ; STASH HEADER + POP TP,D + POP TP,C + EXCH B,(TP) + MOVSI A,TINTH + EXCH A,-1(TP) ; INTERNAL PUT CALL + PUSHJ P,IPUT + POP TP,B + POP TP,A + POPJ P, + +; FIND NAME OF INTERRUPT + +FNDNM: GETYP A,(B) ; TYPE + CAIE A,TCHSTR ; IF STRING + JRST FNDATM ; DONT HAVE ATOM, OTHERWISE DO + PUSHJ P,IILOOK + JRST .+2 +FNDATM: MOVE B,1(B) + SETZB C,D ; PREVENT LOSSAGE LATER + MOVSI A,TATOM + +; THE NEXT 2 INSTRUCTIONS ARE A KLUDGE TO GET THE RIGHT ERROR ATOM + + CAMN B,IMQUOTE ERROR + MOVE B,MQUOTE ERROR,ERROR,INTRUP + POPJ P, + +IILOOK: PUSHJ P,CSTAK ; PUT CHRS ON STACK + MOVSI A,TOBLS + MOVE B,INTOBL+1 + JRST ILOOKC ; LOOK IT UP + +; ROUTINE TO MAKE A HANDLER BLOCK + +MHAND: MOVEI A,IHANDL*2 + JRST GIBLOK ; GET BLOCK + +; HERE TO GET CHANNEL FOR "CHAR" INTERRUPT + +GETCHN: GETYP 0,(TB) ; GET TYPE + CAIE 0,TCHAN ; CHANNL IS WINNER + JRST WRONGT + MOVE A,(TB) ; USE THE CHANNEL TO NAME THE INTERRUPT + MOVE B,1(TB) + SKIPN CHANNO(B) ; SKIP IF WINNING CHANNEL + JRST CBDCHN ; LOSER + POPJ P, + +LOCGET: GETYP 0,(TB) ; TYPE + CAIN 0,TCHAN ; SKIP IF LOCATIVE + JRST WRONGT + MOVE D,B + MOVE A,(TB) + MOVE B,1(TB) ; GET LOCATIVE + POPJ P, + +; FINAL MONITOR SETUP ROUTINES + +S.RMON: SKIPA E,[.RDMON,,] +S.WMON: MOVSI E,.WRMON + PUSH TP,A + PUSH TP,B + HLRM E,INTPRI(B) ; SAVE BITS + MOVEI B,(TB) ; POINT TO LOCATIVE + HRRZ A,FSAV(TB) + CAIN A,OFF + MOVSI D,(ANDCAM E,) ; KILL INST + CAIN A,EVENT + MOVSI D,(IORM E,) + PUSHJ P,SMON ; GO DO IT + POP TP,B + POP TP,A + MOVEI E,0 + POPJ P, + + +; SPECIAL SETUP ROUTINES FOR INITIAL INTERRUPTS + +IFN ITS,[ +S.CHAR: MOVE E,1(TB) ; GET CHANNEL + MOVE 0,RDEVIC(E) + ILDB 0,0 ; 1ST CHAR TO 0 + CAIE 0,"T ; TTY + JRST .+3 ; NO + MOVEI 0,C.INTL + XORM 0,-2(E) ; IN CASE OUTPUT + MOVE E,CHANNO(E) + ADDI E,36. ; GET CORRECT MASK BIT +ONEBIT: MOVEI 0,1 ; BIT FOR INT TO RET + POPJ P, +] +IFE ITS,[ +S.CHAR: MOVE E,1(TB) + MOVEI 0,C.INTL + XORM 0,-2(E) ; IN CASE OUTPUT + MOVE 0,RDEVIC(E) + ILDB 0,0 ; 1ST CHAR + PUSH P,A + CAIE 0,"N ; NET ? + JRST S.CHA1 + + MOVEI A,0 + HRRZ 0,CHANNO(E) + MOVE E,[-NNETS,,NETJFN] + CAMN 0,(E) + JRST S.CHA2 + SKIPN (E) + MOVE A,E ; REMEMBER WHERE + AOBJN E,.-4 + TLNN A,-1 + FATAL NO MORE NETWORK + SKIPA E,A +S.CHA1: MOVEI E,0 +S.CHA2: POP P,A + POPJ P, +] + + +; SPECIAL FOR CLOCK +IFN ITS,[ +S.DOWN: SKIPA E,[7] +S.CLOK: MOVEI E,13. ; FOR NOW JUST GET BIT # + JRST ONEBIT + +S.PAR: MOVEI E,28. + JRST ONEBIT + +; RUNTIME AND REALTIME INTERRUPTS + +S.RUNT: SKIPA E,[34.] +S.REAL: MOVEI E,35. + JRST ONEBIT + +S.IOC: SKIPA E,[9.] ; IO CHANNEL ERROR +S.PURE: MOVEI E,26. + JRST ONEBIT + +; MPV AND ILOPR + +S.MPV: SKIPA E,[14.] ; BIT POS +S.ILOP: MOVEI E,6 + JRST ONEBIT + +; HERE TO TURN ALL INFERIOR INTS + +S.INF: MOVEI E,36.+16.+2 ; START OF BITS + MOVEI 0,37 ; 8 BITS WORTH + POPJ P, +] +IFE ITS,[ +S.PURE: +S.MPV: +S.ILOP: +S.DOWN: +S.CLOK: +S.PAR: + + +S.RUNT: ERRUUO EQUOTE INTERRUPT-UNAVAILABLE-ON-TENEX +S.IOC: MOVEI 0,7 ; 3 BITS FOR EOF/FULL/ERROR + MOVEI E,10. + POPJ P, + +S.INF: +S.REAL: MOVEI E,0 + POPJ P, +] + + +; HERE TO HANDLE ITS INTERRUPTS + +FHAND: SKIPN D,EXTINT(B) ; SKIP IF HANDLERS ARE POSSIBLE + JRST DIRQ + JRST (D) + +IFN ITS,[ +; SPECIAL CHARACTER HANDLERS + +HCHAR: MOVEI D,CHNL0+1 + ADDI D,(B) ; POINT TO CHANNEL SLOT + ADDI D,(B) + SKIPN D,-72.(D) ; PICK UP CHANNEL + JRST IPCGOT ;WELL, IT GOTTA BEE THE THE IPC THEN + PUSH TP,$TCHAN + PUSH TP,D + LDB 0,[600,,STATUS(D)] ; GET DEVICE CODE + CAILE 0,2 ; SKIP IF A TTY + JRST HNET ; MAYBE NETWORK CHANNEL + HRRZ 0,-2(D) + TRNN 0,C.READ + JRST HMORE + CAMN D,TTICHN+1 + SKIPE DEMFLG ; SKIP IF NOT DEMON + JRST .+3 + SKIPN NOTTY + JRST HCHR11 + MOVE B,D ; CHAN TO B + PUSH P,A + PUSHJ P,TTYOP2 ; RE-GOBBLE TTY + POP P,A + MOVE D,(TP) +HCHR11: MOVE D,CHANNO(D) ; GET ITS CHANNEL + PUSH P,D ; AND SAVE IT + .CALL HOWMNY ; GET # OF CHARS + MOVEI B,0 ; IF TTY GONE, NO CHARS +RECHR: ADDI B,1 ; BUMP BY ONE FOR SOSG + MOVEM B,CHNCNT(D) ; AND SAVE + IORM A,PIRQ2 ; LEAVE THE INT ON + +CHRLOO: MOVE D,(P) ; GET CHNNAEL NO. + SOSG CHNCNT(D) ; GET COUNT + JRST CHRDON + + MOVE B,(TP) + MOVE D,BUFRIN(B) ; GET EXTRA BUFFER + XCT IOIN2(D) ; READ CHAR + JUMPL A,CHRDON ; NO CHAR THERE, FORGET IT + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE CHAR + PUSH TP,$TCHRS ; SAVE CHAR FOR CALL + PUSH TP,A + PUSH TP,$TCHAN ; SAVE CHANNEL + PUSH TP,B + PUSHJ P,INCHAR ; PUT CHAR IN USERS BUFFER + MCALL 3,INTERRUPT ; RUN THE HANDLERS + JRST CHRLOO ; AND LOOP + +CHRDON: .CALL HOWMNY + MOVEI B,0 + MOVEI A,1 ; SET FOR PI WORD CLOBBER + LSH A,(D) + JUMPG B,RECHR ; ANY MORE? + ANDCAM A,PIRQ2 + SUB P,[1,,1] + SUB TP,[2,,2] + JRST DIRQ + + + +; HERE FOR NET CHANNEL INTERRUPT + +HNET: CAIE 0,26 ; NETWORK? + JRST HSTYET ; HANDLE PSEUDO TTY ETC. + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TUVEC + PUSH TP,BUFRIN(D) + PUSH TP,$TCHAN + PUSH TP,D + MOVE B,D ; CHAN TO B + PUSHJ P,INSTAT ; UPDATE THE NETWRK STATE + MCALL 3,INTERRUPT + SUB TP,[2,,2] + JRST DIRQ + +HMORE: +HSTYET: PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TCHAN + PUSH TP,D + MCALL 2,INTERRUPT + SUB TP,[2,,2] + JRST DIRQ + +] +CBDCHN: ERRUUO EQUOTE BAD-CHANNEL + +IFN ITS,[ + +HCLOCK: PUSH TP,$TCHSTR + PUSH TP,CHQUOTE CLOCK + MCALL 1,INTERRUPT + JRST DIRQ + +HRUNT: PUSH TP,$TATOM + PUSH TP,MQUOTE RUNT,RUNT,INTRUP + MCALL 1,INTERRUPT + JRST DIRQ +] +HREAL: PUSH TP,$TATOM + PUSH TP,MQUOTE REALT,REALT,INTRUP + MCALL 1,INTERRUPT + JRST DIRQ +IFN ITS,[ +HPAR: MOVE A,MQUOTE PARITY,PARITY,INTRUP + JRST HMPV1 + +HMPV: MOVE A,MQUOTE MPV,MPV,INTRUP + JRST HMPV1 + +HILOPR: MOVE A,MQUOTE ILOPR,ILOPR,INTRUP + JRST HMPV1 + +HPURE: MOVE A,MQUOTE PURE,PURE,INTRUP +HMPV1: PUSH TP,$TATOM + PUSH TP,A + PUSH P,LCKINT ; SAVE LOCN + PUSH TP,$TATOM + PUSH TP,A + PUSH TP,$TWORD + PUSH TP,LCKINT + MCALL 2,EMERGENCY + POP P,A + MOVE C,(TP) + SUB TP,[2,,2] + JUMPN B,DIRQ + + PUSH TP,$TATOM + PUSH TP,EQUOTE DANGEROUS-INTERRUPT-NOT-HANDLED + PUSH TP,$TATOM + PUSH TP,C + PUSH TP,$TWORD + PUSH TP,A + MCALL 3,ERROR + JRST DIRQ + + + +; HERE TO HANDLE SYS DOWN INTERRUPT + +HDOWN: PUSH TP,$TATOM + PUSH TP,MQUOTE SYSDOWN,SYSDOWN,INTRUP + .DIETI A, ; HOW LONG? + PUSH TP,$TFIX + PUSH TP,A + PUSH P,A ; FOR MESSAGE + MCALL 2,INTERRUPT + POP P,A + JUMPN B,DIRQ + .SUSET [.RTTY,,B] ; DO WE NOW HAVE A TTY AT ALL? + JUMPL B,DIRQ ; DONT HANG AROUND + PUSH P,A + MOVEI B,[ASCIZ / +Excuse me, SYSTEM going down in /] + SKIPG (P) ; SKIP IF REALLY GOING DOWN + MOVEI B,[ASCIZ / +Excuse me, SYSTEM has been REVIVED! +/] + PUSHJ P,MSGTYP + POP P,B + JUMPE B,DIRQ + IDIVI B,30. ; TO SECONDS + IDIVI B,60. ; A/ SECONDS B/ MINUTES + JUMPE B,NOMIN + PUSH P,C + PUSHJ P,DECOUT + MOVEI B,[ASCIZ / minutes /] + PUSHJ P,MSGTYP + POP P,B + JRST .+2 +NOMIN: MOVEI B,(C) + PUSHJ P,DECOUT + MOVEI B,[ASCIZ / seconds. +/] + PUSHJ P,MSGTYP + JRST DIRQ + +; TWO DIGIT DEC OUT FROM B/ + +DECOUT: IDIVI B,10. + JUMPE B,DECOU1 ; NO TEN + MOVEI A,60(B) + PUSHJ P,MTYO +DECOU1: MOVEI A,60(C) + JRST MTYO +] + +; HERE TO HANDLE I/O CHANNEL ERRORS + +HIOC: +IFN ITS,[ + .SUSET [.RAPRC,,A] ; CONTAINS CHANNEL OF MOST RECENT LOSSAGE + LDB A,[330400,,A] ; GET CHAN # + MOVEI C,(A) ; COPY +] + PUSH TP,$TATOM ; PUSH ERROR + PUSH TP,EQUOTE FILE-SYSTEM-ERROR +IFE ITS, MOVE C,IOCLOS ; GET JFN + PUSH TP,$TCHAN + ASH C,1 ; GET CHANNEL + ADDI C,CHNL0+1 ; GET CHANNEL VECTOR + PUSH TP,(C) +IFN ITS,[ + LSH A,23. ; DO A .STATUS + IOR A,[.STATUS A] + XCT A +] +IFE ITS,[ + MOVNI A,1 ; GET "MOST RECENT ERROR" +] + MOVE B,(TP) +IFN ITS, PUSHJ P,GFALS ; GEN NAMED FALSE +IFE ITS, PUSHJ P,TGFALS + PUSH TP,A + PUSH TP,B + PUSH TP,$TATOM + PUSH TP,MQUOTE IOC,IOC,INTRUP + + PUSH TP,A + PUSH TP,B + PUSH TP,-7(TP) + PUSH TP,-7(TP) + MCALL 3,EMERGENCY + JUMPN B,DIRQ1 ; JUMP IF HANDLED + MCALL 3,ERROR + JRST DIRQ + +DIRQ1: SUB TP,[6,,6] + JRST DIRQ +] +; HANDLE INFERIOR KNOCKING AT THE DOOR + +HINF: +IFN ITS, SUBI B,36.+16.+2 ; CONVERT TO INF # +IFE ITS, MOVEI B,0 + PUSH TP,$TATOM + PUSH TP,MQUOTE INFERIOR,INFERIOR,INTRUP + PUSH TP,$TFIX + PUSH TP,B + MCALL 2,INTERRUPT + JRST DIRQ + +IFE ITS,[ + +; HERE FOR TENEX INTS (FIRST CUT) + +MFUNCTION %ACCHRS,SUBR,[ACTIVATE-CHARS] + + ENTRY + + JUMPGE AB,RETCHR + CAMGE AB,[-3,,] + JRST TMA + + GETYP A,(AB) + CAIE A,TCHSTR + JRST WTYP1 + HRRZ D,(AB) ; CHECK LENGTH + MOVEI C,0 ; SEE IF ANY NET CHANS IN USE + MOVE A,[-NNETS,,NETJFN] + SKIPE (A) + SUBI C,1 + AOBJN A,.-2 + + CAILE D,NCHRS+NNETS(C) + JRST WTYP1 + + MOVEI 0,(D) ; CHECK THEM + MOVE B,1(AB) + + JUMPE 0,.+4 + ILDB C,B + CAILE C,32 + JRST WTYP1 + SOJG 0,.-3 + + MOVSI E,- ; ZAP CURRENT + HRRZ A,CHRS(E) + DTI + SETZM CHRS(E) + AOBJN E,.-3 + + MOVE A,[-NNETS,,NETJFN] ; IN CASE USED NET INTS FOR CHARS + + SKIPGE (A) + SETZM (A) + AOBJN A,.-2 + + MOVE E,1(AB) + SETZB C,F ; C WILL BE MASK, F OFFSET INTO TABLE + MOVSI 0,400000 ; 0 WILL BE THE BIT FOR INT MASK OR'ING + JUMPE D,ALP1 ; JUMP IF NONE + MOVNS D ; BUILD AOBJN POINTER TO CHRS TABLE + MOVSI D,(D) + MOVEI B,0 ; B COUNTS NUMBER DONE + +ALP: ILDB A,E ; GET CHR + IOR C,0 + LSH 0,-1 + HRROM A,CHRS(D) + MOVSS A + HRRI A,(D) + ADDI A,(F) ; POSSIBLE OFFSET FOR MORE CHANS + ATI + ADDI B,1 + CAIGE B,NCHRS + JRST ALP2 + + SKIPE NETJFN-NCHRS(B) + AOJA B,.-1 + + MOVEI F,36.-NNETS-UINTS-NCHRS(B) + MOVN G,F + MOVSI 0,400000 + LSH 0,(G) ;NEW MASK FOR INT MASKS + SUBI F,1(D) + +ALP2: AOBJN D,ALP + +ALP1: IORM C,MASK1 + MOVEI A,MFORK + MOVE B,MASK1 ; SET UP FOR INT BITS + AIC ; TURN THEM ON + MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +RETCHR: MOVE C,[-NCHRS-NNETS,,CHRS] + MOVEI A,0 + +RETCH1: SKIPN D,(C) + JRST RETDON + PUSH TP,$TCHRS + ANDI D,177 + PUSH TP,D + ADDI A,1 + AOBJN C,RETCH1 + +RETDON: PUSHJ P,CISTNG + JRST FINIS + +HCHAR: HRRZ A,CHRS-36.(B) + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TCHRS + PUSH TP,A + PUSH TP,$TCHAN + PUSH TP,TTICHN+1 + MCALL 3,INTERRUPT + JRST DIRQ + +HNET: SKIPLE A,NETJFN-NINT+NNETS+UINTS(B) + JRST HNET1 + SUBI B,36.-NNETS-UINTS-NCHRS + JUMPE A,DIRQ + JRST HCHAR +HNET1: ASH A,1 + ADDI A,CHNL0+1 + MOVE B,(A) + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TUVEC + PUSH TP,BUFRIN(B) + PUSH TP,$TCHAN + PUSH TP,B + PUSHJ P,INSTAT + MCALL 3,INTERRUPT + JRST DIRQ + +USRINT: SUBI B,36. + PUSH TP,$TATOM + PUSH TP,MQUOTE USERINT,USERINT,INTRUP + PUSH TP,$TFIX + PUSH TP,B + MCALL 2,INTERRUPT + JRST DIRQ +] + + +MFUNCTION OFF,SUBR + ENTRY + + JUMPGE AB,TFA + HLRZ 0,AB + GETYP A,(AB) ; ARG TYPE + MOVE B,1(AB) ; AND VALUE + CAIN A,TINTH ; HEADER, GO HACK + JRST OFFHD ; QUEEN OF HEARTS + CAIN A,TATOM + JRST .+3 + CAIE A,TCHSTR + JRST TRYHAN ; MAYBE INDIVIDUAL HANDLER + CAIN 0,-2 ; MORE THAN 1 ARG? + JRST OFFAC1 ; NO, GO ON + CAIG 0,-5 ; CANT BE MORE THAN 2 + JRST TMA + MOVEI B,2(AB) ; POINT TO 2D + PUSHJ P,CHNORL +OFFAC1: MOVEI B,(AB) + PUSHJ P,FNDINT + JUMPGE B,NOHAN1 ; NOT HANDLED + +OFFH1: PUSH P,C ; SAVE C FOR BIT CLOBBER + MOVSI C,TATOM + SKIPN D + MOVE D,MQUOTE INTERRUPT + MOVE A,INAME(B) + MOVE B,INAME+1(B) + PUSHJ P,IREMAS + SKIPE B ; IF NO ASSOC, DONT SMASH + SETOM ISTATE+1(B) ; DISABLE IN CASE QUEUED + POP P,C ; SPECIAL? + JUMPGE C,FINIS ; NO, DONE + + HRRZ C,INTBL(C) ; POINT TO SPECIAL CODE + PUSHJ P,(C) ; GO TO SAME + JUMPE E,OFINIS ; DONE +IFN ITS,[ + CAILE E,35. ; SKIP IF 1ST WORD + JRST CLRW2 ; CLOBBER 2D WORD BIT + LSH 0,-1(E) ; POSITION BIT + ANDCAM 0,MASK1 ; KILL BIT + .SUSET [.SMASK,,MASK1] +] +IFE ITS,[ + MOVE D,B + SETZM (E) + MOVEI E,(E) + SUBI E,NETJFN-NETCHN + MOVEI 0,1 + MOVNS E + LSH 0,35.(E) + ANDCAM 0,MASK1 + MOVEI A,MFORK + SETCM B,MASK1 + DIC + ANDCAM 0,PIRQ ; JUST IN CASE + MOVE B,D +] +OFINIS: MOVSI A,TINTH + JRST FINIS + +IFN ITS,[ +CLRW2: LSH 0,-36.(E) ; POS BIT FOR 2D WORD + ANDCAM 0,MASK2 + .SUSET [.SMSK2,,MASK2] + JRST OFINIS +] + +TRYHAN: CAIE A,THAND ; HANDLER? + JRST WTYP1 + CAIE 0,-2 + JRST TMA + GETYP 0,IPREV(B) ; GET TYPE OF PREV + MOVE A,INXT+1(B) + SKIPN C,IPREV+1(B) ; dont act silly if already off! (TT) + JRST HFINIS + MOVE D,IPREV(B) + CAIE 0,THAND + JRST DOHEAD ; PREV HUST BE HDR + MOVEM A,INXT+1(C) + JRST .+2 +DOHEAD: MOVEM A,IHNDLR+1(C) ; INTO HDR + JUMPE A,OFFINI + MOVEM D,IPREV(A) + MOVEM C,IPREV+1(A) +OFFINI: SETZM IPREV+1(B) ; Leave NXT slot intact for RUNINT (BKD) + MOVSI A,THAND + JRST FINIS + +OFFHD: CAIE 0,-2 + JRST TMA + PUSHJ P,GETNMS ; GET INFOR ABOUT INT + JUMPE C,OFFH1 + PUSH TP,INAME(B) + PUSH TP,INAME+1(B) + JRST OFFH1 + +GETNMS: GETYP A,INAME(B) ; CHECK FOR SPECIAL + SETZB C,D + CAIN A,TCHAN + HRROI C,SS.CHA + PUSHJ P,LOCQ ; LOCATIVE? + JRST CHGTNM + + MOVEI B,INAME(B) ; POINT TO LOCATIVE + MOVSI D,(MOVE E,) + PUSHJ P,SMON ; GET MONITOR + MOVE B,1(AB) +GETNM1: HRROI C,SS.WMO ; ASSUME WRITE + TLNN E,.WRMON + HRROI C,SS.RMO + MOVE D,MQUOTE WRITE,WRITE,INTRUP + TLNN E,.WRMON + MOVE D,MQUOTE READ,READ,INTRUP + POPJ P, + +CHGTNM: JUMPL C,CPOPJ + MOVE B,INAME+1(B) + PUSHJ P,SPEC1 + MOVE B,1(AB) ; RESTORE IHEADER + POPJ P, + +; EMERGENCY, CANT DEFER ME!! + +MQUOTE INTERRUPT + +EMERGENCY: + PUSH P,. + JRST INTERR+1 + +MFUNCTION INTERRUPT,SUBR + + PUSH P,[0] + + ENTRY + + SETZM INTHLD ; RE-ENABLE THE WORLD + JUMPGE AB,TFA + MOVE B,1(AB) ; GET HANDLER/NAME + GETYP A,(AB) ; CAN BE HEADER OR NAME + CAIN A,TINTH ; SKIP IF NOT HEADER + JRST GTHEAD + CAIN A,TATOM + JRST .+3 + CAIE A,TCHSTR ; SKIP IF CHAR STRING + JRST WTYP1 + MOVEI B,(AB) ; LOOK UP NAME + PUSHJ P,FNDNM ; GET NAME + JUMPE B,IFALSE + MOVEI D,0 + CAMN B,MQUOTE CHAR,CHAR,INTRUP + PUSHJ P,CHNGT1 + CAME B,MQUOTE READ,READ,INTRUP + CAMN B,MQUOTE WRITE,WRITE,INTRUP + PUSHJ P,GTLOC1 + PUSHJ P,INTASO + JUMPE B,IFALSE + +GTHEAD: SKIPE ISTATE+1(B) ; ENABLED? + JRST IFALSE ; IGNORE COMPLETELY + MOVE A,INTPRI+1(B) ; GET PRIORITY OF INTERRUPT + CAMLE A,CURPRI ; SEE IF MUST QUEU + JRST SETPRI ; MAY RUN NOW + SKIPE (P) ; SKIP IF DEFER OK + JRST DEFERR + MOVEM A,(P) + PUSH TP,$TINTH ; SAVE HEADER + PUSH TP,B + MOVEI A,1 ; SAVE OTHER ARGS +PSHARG: ADD AB,[2,,2] + JUMPGE AB,QUEU1 ; GO MAKE QUEU ENTRY + PUSH TP,(AB) + PUSH TP,1(AB) + AOJA A,PSHARG +QUEU1: PUSHJ P,IEVECT ; GET VECTOR + PUSH TP,$TVEC + PUSH TP,[0] ; WILL HOLD QUEUE HEADER + PUSH TP,A + PUSH TP,B + + POP P,A ; RESTORE PRIORITY + + MOVE B,QUEUES+1 ; GET INTERRUPT QUEUES + MOVEI D,0 + JUMPGE B,GQUEU ; MAKE A QUEUE HDR + +NXTQU: CAMN A,1(B) ; GOT PRIORITY? + JRST ADDQU ; YES, ADD TO THE QUEU + CAML A,1(B) ; SKIP IF SPOT NOT FOUND + JRST GQUEU + MOVE D,B + MOVE B,3(B) ; GO TO NXT QUEUE + JUMPL B,NXTQU + +GQUEU: PUSH TP,$TVEC ; SAVE NEXT POINTER + PUSH TP,D + PUSH TP,$TFIX + PUSH TP,A ; SAVE PRIORITY + PUSH TP,$TVEC + PUSH TP,B + PUSH TP,$TLIST + PUSH TP,[0] + PUSH TP,$TLIST + PUSH TP,[0] + MOVEI A,4 + PUSHJ P,IEVECT + MOVE D,(TP) ; NOW SPLICE + SUB TP,[2,,2] + JUMPN D,GQUEU1 + MOVEM B,QUEUES+1 + JRST .+2 +GQUEU1: MOVEM B,3(D) + +ADDQU: MOVEM B,-2(TP) ; SAVE QUEU HDR + POP TP,D + POP TP,C + PUSHJ P,INCONS ; CONS IT + MOVE C,(TP) ;GET QUEUE HEADER + SKIPE D,7(C) ; IF END EXISTS + HRRM B,(D) ; SPLICE + MOVEM B,7(C) + SKIPN 5(C) ; SKIP IF START EXISTS + MOVEM B,5(C) + +IFINI: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +SETPRI: EXCH A,CURPRI + MOVEM A,(P) + + PUSH TP,$TAB ; PASS AB TO HANDLERS + PUSH TP,AB + + PUSHJ P,RUNINT ; RUN THE HANDLERS + POP P,A ; UNQUEU ANY WAITERS + PUSHJ P,UNQUEU + + JRST IFINI + +; HERE TO UNQUEUE WAITING INTERRUPTS + +UNQUEU: PUSH P,A ; SAVE NEW LEVEL + +UNQUE1: MOVE A,(P) ; TARGET LEVEL + CAMLE A,CURPRI ; CHECK RUG NOT PULLED OUT + JRST UNDONE + SKIPE B,QUEUES+1 + CAML A,1(B) ; RIGHT LEVEL? + JRST UNDONE ; FINISHED + + SKIPN C,5(B) ; ON QUEUEU? + JRST UNXQ + HRRZ D,(C) ; CDR THE LIST + MOVEM D,5(B) + SKIPN D ; SKIP IF NOT LAST + SETZM 7(B) ; CLOBBER END POINTER + MOVE A,1(B) ; GET THIS PRIORITY LEVEL + MOVEM A,CURPRI ; MAKE IT THE CURRENT ONE + MOVE D,1(C) ; GET SAVED VECTOR OF INF + + MOVE B,1(D) ; INT HEADER + PUSH TP,$TVEC + PUSH TP,D ; AND ARGS + + PUSHJ P,RUNINT ; RUN THEM + JRST UNQUE1 + +UNDONE: POP P,CURPRI ; SET CURRENT LEVEL + MOVE A,CURPRI + POPJ P, + +UNXQ: MOVE B,3(B) ; GO TO NEXT QUEUE + MOVEM B,QUEUES+1 + JRST UNQUE1 + + + +; SUBR TO CHANGE INTERRUPT LEVEL + +MFUNCTION INTLEV,SUBR,[INT-LEVEL] + ENTRY + JUMPGE AB,RETLEV ; JUST RETURN CURRENT + GETYP A,(AB) + CAIE A,TFIX + JRST WTYP1 ; LEVEL IS FIXED + SKIPGE A,1(AB) + JRST OUTRNG" + CAMN A,CURPRI ; DIFFERENT? + JRST RETLEV ; NO RETURN + PUSH P,CURPRI + CAMG A,CURPRI ; SKIP IF NO UNQUEUE NEEDED + PUSHJ P,UNQUEU + MOVEM A,CURPRI ; SAVE + POP P,A + SKIPA B,A +RETLEV: MOVE B,CURPRI + MOVSI A,TFIX + JRST FINIS + +RUNINT: PUSH TP,$THAND ; SAVE HANDLERS LIST + PUSH TP,IHNDLR+1(B) + + SKIPN ISTATE+1(B) ; SKIP IF DISABLED + SKIPN B,(TP) + JRST SUBTP4 +NXHND: MOVEM B,(TP) ; SAVE CURRENT HDR + MOVE A,-2(TP) ; SAVE ARG POINTER + PUSHJ P,CHSWAP ; SEE IF MUST SWAP + PUSH TP,[0] + PUSH TP,[0] + MOVEI C,1 ; COUNT ARGS + PUSH TP,SPSTOR ; SAVE INITIAL BINDING POINTER + PUSH TP,SPSTOR+1 + MOVE D,PVSTOR+1 + ADD D,[1STEPR,,1STEPR] + PUSH TP,BNDV + PUSH TP,D + PUSH TP,$TPVP + PUSH TP,[0] + MOVE E,TP +NBIND: PUSH TP,INTFCN(B) + PUSH TP,INTFCN+1(B) + ADD A,[2,,2] + JUMPGE A,DO.HND + PUSH TP,(A) + PUSH TP,1(A) + AOJA C,.-4 +DO.HND: MOVE PVP,PVSTOR+1 + SKIPN 1STEPR+1(PVP) ; NECESSARY TO DO 1STEP BINDING ? + JRST NBIND1 ; NO, DON'T BOTHER + PUSH P,C + PUSHJ P,SPECBE ; BIND 1 STEP FLAG + POP P,C +NBIND1: ACALL C,INTAPL ; RUN HAND WITH POSSIBLY BOUND 1STEP FLAG + MOVE SP,SPSTOR+1 ; GET CURRENT BINDING POINTER + CAMN SP,-4(TP) ; SAME AS SAVED BINDING POINTER ? + JRST NBIND2 ; YES, 1STEP FLAG NOT BOUND + MOVE C,(TP) ; RESET 1 STEP + MOVE PVP,PVSTOR+1 + MOVEM C,1STEPR+1(PVP) + MOVE SP,-4(TP) ; RESTORE SAVED BINDING POINTER + MOVEM SP,SPSTOR+1 +NBIND2: SUB TP,[6,,6] + PUSHJ P,CHUNSW + CAMN E,PVSTOR+1 + SUB TP,[4,,4] ; NO PROCESS CHANGE, POP JUNK + CAMN E,PVSTOR+1 + JRST .+4 + MOVE D,TPSTO+1(E) + SUB D,[4,,4] + MOVEM D,TPSTO+1(E) ; FIXUP HIS STACK +DO.H1: GETYP A,A ; CHECK FOR A DISMISS + CAIN A,TDISMI + JRST SUBTP4 + MOVE B,(TP) ; TRY FOR NEXT HANDLER + SKIPE B,INXT+1(B) + JRST NXHND +SUBTP4: SUB TP,[4,,4] + POPJ P, + +MFUNCTION INTAPL,SUBR,[RUNINT] + JRST APPLY + + +NOHAND: JUMPE C,NOHAN1 + PUSH TP,$TATOM + PUSH TP,EQUOTE INTERNAL-INTERRUPT +NOHAN1: PUSH TP,(AB) + PUSH TP,1(AB) + PUSH TP,$TATOM + PUSH TP,EQUOTE NOT-HANDLED + SKIPE A,C + MOVEI A,1 + ADDI A,2 + JRST CALER + +DEFERR: PUSH TP,$TATOM + PUSH TP,EQUOTE ATTEMPT-TO-DEFER-UNDEFERABLE-INTERRUPT + PUSH TP,$TINTH + PUSH TP,B + PUSH TP,$TATOM + PUSH TP,MQUOTE INTERRUPT + MCALL 3,RERR ; FORCE REAL ERROR + JRST FINIS + +; FUNCTION TO DISMISS AN INTERRUPT TO AN ARBITRARY ACTIVATION + +MFUNCTION DISMISS,SUBR + + HLRZ 0,AB + JUMPGE AB,TFA + CAIGE 0,-6 + JRST TMA + MOVNI D,1 + CAIE 0,-6 + JRST DISMI3 + GETYP 0,4(AB) + CAIE 0,TFIX + JRST WTYP + SKIPGE D,5(AB) + JRST OUTRNG + +DISMI3: MOVEI A,(TB) + +DISMI0: HRRZ B,FSAV(A) + HRRZ C,PCSAV(A) + CAIE B,INTAPL + JRST DISMI1 + + MOVE E,OTBSAV(A) + MOVEI 0,(A) ; SAVE FRAME + MOVEI A,DISMI2 + HRRM A,PCSAV(E) ; GET IT BACK HERE + MOVE A,(AB) + MOVE B,1(AB) + MOVE C,TPSAV(E) + MOVEM A,-7(C) + MOVEM B,-6(C) + MOVEI C,0 + CAMGE AB,[-3,,] + MOVEI C,2(AB) + MOVE B,0 ; DEST FRAME + JUMPL D,.+3 + MOVE A,PSAV(E) ; NOW MUNG SAVED INT LEVEL + MOVEM D,-1(A) ; ZAP YOUR MUNGED + PUSHJ P,CHUNW ; CHECK ON UNWINDERS + JRST FINIS ; FALL DOWN + +DISMI1: MOVEI E,(A) + HRRZ A,OTBSAV(A) + JUMPN A,DISMI0 + + MOVE A,(AB) + MOVE B,1(AB) + + PUSH TP,A + PUSH TP,B + SKIPGE A,D + JRST .+4 + CAMG A,CURPRI + PUSHJ P,UNQUEU + MOVEM A,CURPRI + CAML AB,[-3,,] + JRST .+5 + PUSH TP,2(AB) + PUSH TP,3(AB) + MCALL 2,ERRET + JRST FINIS + + POP TP,B + POP TP,A + JRST FINIS + +DISMI2: CAMN SP,-4(TP) ; 1STEP FLAG BEEN BOUND ? + JRST NDISMI ; NO + MOVE C,(TP) + MOVE PVP,PVSTOR+1 + MOVEM C,1STEPR+1(PVP) + MOVE SP,-4(TP) +NDISMI: SUB TP,[6,,6] + PUSHJ P,CHUNSW ; UNDO ANY PROCESS HACKING + MOVE C,TP + CAME E,PVSTOR+1 ; SWAPED? + MOVE C,TPSTO+1(E) + MOVE D,-1(C) + MOVE 0,(C) + SUB TP,[4,,4] + SUB C,[4,,4] ; MAYBE FIXUP OTHER STACK + CAME E,PVSTOR+1 + MOVEM C,TPSTO+1(E) + PUSH TP,D + PUSH TP,0 + PUSH TP,A + PUSH TP,B + MOVE A,-1(P) ; SAVED PRIORITY + CAMG A,CURPRI + PUSHJ P,UNQUEU + MOVEM A,CURPRI + SKIPN -1(TP) + JRST .+3 + MCALL 2,ERRET + JRST FINIS + + SUB TP,[4,,4] + MOVSI A,TDISMI + MOVE B,IMQUOTE T + JRST DO.H1 + +CHNGT1: HLRE B,AB + SUBM AB,B + GETYP 0,-2(B) + CAIE 0,TCHAN + JRST WTYP3 + MOVE B,-1(B) + MOVSI A,TCHAN + POPJ P, + +GTLOC1: GETYP A,2(AB) + PUSHJ P,LOCQ + JRST WTYP2 + MOVE D,B ; RET ATOM FOR ASSOC + MOVE A,2(AB) + MOVE B,3(AB) + POPJ P, + ; MONITOR CHECKERS + +MONCH0: HLLZ 0,(B) ; POTENTIAL MONITORS +MONCH: TLZ 0,TYPMSK ; KILL TYPE + IOR C,0 ; IN NEW TYPE + PUSH P,0 + MOVEI 0,(B) + CAIL 0,HIBOT + JRST PURERR + POP P,0 + TLNN 0,.WRMON ; SKIP IF WRITE MONIT + POPJ P, + +; MONITOR IS ON, INVOKE HANDLER + + PUSH TP,A ; SAVE OBJ + PUSH TP,B + PUSH TP,C + PUSH TP,D ; SAVE DATUM + MOVSI C,TATOM ; PREPARE TO FIND IT + MOVE D,MQUOTE WRITE,WRITE,INTRUP + PUSHJ P,IGET + JUMPE B,MONCH1 ; NOT FOUND IGNORE FOR NOW + PUSH TP,A ; START SETTING UP CALL + PUSH TP,B + PUSH TP,-5(TP) + PUSH TP,-5(TP) + PUSH TP,-5(TP) + PUSH TP,-5(TP) + PUSHJ P,FRMSTK ; PUT FRAME ON STAKC + MCALL 4,EMERGE ; DO IT +MONCH1: POP TP,D + POP TP,C + POP TP,B + POP TP,A + HLLZ 0,(B) ; UPDATE MONITORS + TLZ 0,TYPMSK + IOR C,0 + POPJ P, + +; NOW FOR READ MONITORS + +RMONC0: HLLZ 0,(B) +RMONCH: TLNN 0,.RDMON + POPJ P, + PUSH TP,A + PUSH TP,B + MOVSI C,TATOM + MOVE D,MQUOTE READ,READ,INTRUP + PUSHJ P,IGET + JUMPE B,RMONC1 + PUSH TP,A + PUSH TP,B + PUSH TP,-3(TP) + PUSH TP,-3(TP) + PUSHJ P,FRMSTK ; PUT FRAME ON STACK + MCALL 3,EMERGE +RMONC1: POP TP,B + POP TP,A + POPJ P, + +; PUT THE CURRENT FRAME ON THE STACK + +FRMSTK: PUSHJ P,MAKACT + HRLI A,TFRAME + PUSH TP,A + PUSH TP,B + POPJ P, + +; HERE TO COMPLAIN ABOUT ATTEMPTS TO MUNG PURE CODE + +PURERR: PUSH TP,$TATOM + PUSH TP,EQUOTE ATTEMPT-TO-MUNG-PURE-STRUCTURE + PUSH TP,A + PUSH TP,B + MOVEI A,2 + JRST CALER + +; PROCESS SWAPPING CODE + +CHSWAP: MOVE E,PVSTOR+1 ; GET CURRENT + POP P,0 + SKIPE D,INTPRO+1(B) ; SKIP IF NO PROCESS GIVEN + CAMN D,PVSTOR+1 ; SKIP IF DIFFERENT + JRST PSHPRO + + PUSHJ P,SWAPIT ; DO SWAP + +PSHPRO: PUSH TP,$TPVP + PUSH TP,E + JRST @0 + +CHUNSW: MOVE E,PVSTOR+1 ; RET OLD PROC + MOVE D,-2(TP) ; GET SAVED PROC + CAMN D,PVSTOR+1 ; SWAPPED? + POPJ P, + +SWAPIT: PUSH P,0 + MOVE 0,PSTAT+1(D) ; CHECK STATE + CAIE 0,RESMBL + JRST NOTRES + MOVE PVP,PVSTOR+1 + MOVEM 0,PSTAT+1(PVP) + MOVEI 0,RUNING + MOVEM 0,PSTAT+1(D) ; SAVE NEW STATE + POP P,0 + POP P,C + JRST SWAP" + + +;SUBROUTINE TO GET BIT FOR CLOBBERAGE + +GETBIT: MOVNS B ;NEGATE + MOVSI A,400000 ;GET THE BIT + LSH A,(B) ;SHIFT TO POSITION + POPJ P, ;AND RETURN + +; HERE TO HANDLE PURE WRITE AND CHECK FOR POSSIBLE C/W + +IFN ITS,[ +GCPWRT: SKIPN GCDFLG ; SEE IF IN DUMPER OR PURIFYER + SKIPE NPWRIT + JRST .+3 + MOVEI B,4 ; INDICATE PURE WRITE + JRST NOPUGC ; CONTINUE + TLZ A,200 + MOVEM A,TSINT ; SVE A + MOVE A,TSAVA + SOS TSINTR + .SUSET [.RMPVA,,A] + CAML A,RPURBT ; SKIP IF NOT PURE + CAIL A,HIBOT ; DONT MARK IF TOUCHING INTERPRETER + SKIPA + SETOM PURMNG ; MUNGING PURENESS INDICATE + MOVE B,BUFGC ; GET BUFFER + JUMPL B,GCPW1 ; JUMP IF WINDOW IS BUFFER + EXCH P,GCPDL + PUSHJ P,%CWINF ; GO DO COPY/WRITE +GCPW2: EXCH P,GCPDL + MOVE A,TSINT ; RESTORE A + JRST 2NDWORD ; CONTINUE +GCPW1: EXCH P,GCPDL + MOVEI B,WIND ; START OF BUFFER + PUSHJ P,%CWINF ; C/W + MOVEI B,WNDP ; RESTORE WINDOW + MOVE A,WNDBOT ; BOTTOM OF WINDOW + ASH A,-10. ; TO PAGES + SKIPE A + PUSHJ P,%SHWND ; SHARE IT + JRST GCPW2 +] +IFE ITS,[ + +; HERE TO HANDLE BUFFERING FOR GC-DUMP AND PURIFY FOR TENEX + +PWRIT: SKIPN GCDFLG ; SEE IF IN DUMPER OR PURIFYER + SKIPE GPURFL + SKIPA + FATAL IMW + EXCH P,GCPDL ; GET A GOOD PDL + MOVEM A,TSAVA ; SAVE AC'S + MOVEM B,TSAVB + MOVEI A,MFORK ; FOR TWENEX THIS IS A MOVEI + SKIPE OPSYS ; SKIP IF TOPS20 + MOVSI A,MFORK ; FOR A TENEX IT SHOULD BE A MOVSI + GTRPW ; GET TRAP WORDS + PUSH P,A ; SAVE ADDRESS AND WORD + PUSH P,B + ANDI A,-1 + CAML A,RPURBT ; SKIP IF NOT PURE + CAIL A,HIBOT ; DONT MARK IF TOUCHING INTERPRETER + SKIPA + SETOM PURMNG ; MUNGING PURENESS INDICATE + MOVE B,BUFGC ; GET BUFFER + ANDCMI A,1777 ; TO PAGE BOUNDRY + JUMPL B,PWRIT2 ; USE WINDOW AS BUFFER +PWRIT3: PUSHJ P,%CWINF ; FIX UP +PWRIT4: POP P,B ; RESTORE AC'S + POP P,A + TLNN A,10 ; SEE IF R/W CYCLE + MOVEM B,(A) ; FINISH WRITE + EXCH P,GCPDL + JRST INTDON +PWRIT2: MOVEI B,WIND + PUSHJ P,%CWINF ; GO TRY TO WIN + MOVEI B,WNDP + MOVE A,WNDBOT ; BOTTOM OF WINDOW + ASH A,-10. ; TO PAGES + SKIPE A + PUSHJ P,%SHWND ; SHARE IT + JRST PWRIT4 +] + +;HERE TO HANDLE PDL OVERFLOW. ASK FOR A GC + +IPDLOV: +IFN ITS,[ + MOVEM A,TSINT ;SAVE INT WORD +] + + SKIPE GCFLG ;IS GC RUNNING? + JRST GCPLOV ;YES, COMPLAIN GROSSLY + + MOVEI A,200000 ;GET BIT TO CLOBBER + IORM A,PIRQ ;LEAVE A MESSAGE FOR HIGHER LEVEL + + EXCH P,GCPDL ;GET A WINNING PDL + HRRZ B,TSINTR ;GET POINTER TO LOSING INSTRUCTION +IFE ITS,[ + SKIPE MULTSG + MOVE B,TSINTR+1 +] + SKIPG GCPDL ; SKIP IF NOT P + LDB B,[270400,,-1(B)] ;GET AC FIELD + SKIPL GCPDL ; SKIP IF P + MOVEI B,P + MOVEI A,(B) ;COPY IT + LSH A,1 ;TIMES 2 + EXCH PVP,PVSTOR+1 + ADDI A,0STO(PVP) ;POINT TO THIS ACS CURRENT TYPE + EXCH PVP,PVSTOR+1 + HLRZ A,(A) ;GET THAT TYPE INTO A + CAIN B,P ;IS IT P + MOVEI B,GCPDL ;POINT TO SAVED P + + CAIN B,B ;OR IS IT B ITSELF + MOVEI B,TSAVB + CAIN B,A ;OR A + MOVEI B,TSAVA + + CAIN B,C ;OR C + MOVEI B,1(P) ;C WILL BE ON THE STACK + + PUSH P,C + PUSH P,A + + MOVE A,(B) ;GET THE LOSING POINTER + MOVEI C,(A) ;AND ISOLATE RH + + CAMG C,VECTOP ;CHECK IF IN GC SPACE + CAMG C,VECBOT + JRST NOGROW ;NO, COMPLAIN + +; FALL THROUGH + + + HLRZ C,A ;GET -LENGTH + SUBI A,-1(C) ;POINT TO A DOPE WORD + POP P,C ;RESTORE TYPE INTO C + PUSH P,D ; SAVE FOR GROWTH HACKER + MOVEI D,0 + CAIN C,TPDL ; POINT TD TO APPROPRIATE DOPE WORD + MOVEI D,PGROW + CAIN C,TTP + MOVEI D,TPGROW + JUMPE D,BADPDL ; IF D STILL 0, THIS PDL IS WEIRD + MOVEI A,PDLBUF(A) ; POINT TO ALLEGED REAL DOPE WORD + SKIPN (D) ; SKIP IF PREVIOUSLY BLOWN + MOVEM A,(D) ; CLOBBER IN + CAME A,(D) ; MAKE SURE IT IS THE SAME + JRST PDLOSS + POP P,D ; RESTORE D + + +PNTRHK: MOVE C,(B) ;RESTORE PDL POINTER + SUB C,[PDLBUF,,0] ;FUDGE THE POINTER + MOVEM C,(B) ;AND STORE IT + + POP P,C ;RESTORE THE WORLD + EXCH P,GCPDL ;GET BACK ORIG PDL +IFN ITS,[ + MOVE A,TSINT ;RESTORE INT WORD + + JRST IMPCH ;LOOK FOR MORE INTERRUPTS +] +IFE ITS, JRST GCQUIT + +TPOVFL: SETOM INTFLG ;SIMULATE PDL OVFL + PUSH P,A + MOVEI A,200000 ;TURN ON THE BIT + IORM A,PIRQ + HLRE A,TP ;FIND DOPEW + SUBM TP,A ;POINT TO DOPE WORD + MOVEI A,PDLBUF+1(A) ; ZERO LH AND POINT TO DOPEWD + SKIPN TPGROW + HRRZM A,TPGROW + CAME A,TPGROW ; MAKE SURE WINNAGE + JRST PDLOS1 + SUB TP,[PDLBUF,,0] ; HACK STACK POINTER + POP P,A + POPJ P, + + +; GROW CORE IF PDL OVERFLOW DURING GC + +GCPLOV: EXCH P,GCPDL ; NEED A PDL TO CALL P.CORE + PUSHJ P,GPDLOV ; HANDLE PDL OVERFLOW + EXCH P,GCPDL + PUSHJ P,%FDBUF +IFE ITS,[ + JRST GCQUIT +] +IFN ITS,[ + MOVE A,TSINT + JRST IMPCH + +] + +IFN ITS,[ + +;HERE TO HANDLE LOW-LEVEL CHANNELS + + +CHNACT: SKIPN GCFLG ;GET A WINNING PDL + EXCH P,GCPDL + ANDI A,177777 ;ISOLATE CHANNEL BITS + PUSH P,0 ;SAVE + +CHNA1: MOVEI B,0 ;BIT COUNTER + JFFO A,.+2 ;COUNT + JRST CHNA2 + SUBI B,35. ;NOW HAVE CHANNEL + MOVMS B ;PLUS IT + MOVEI 0,1 + LSH 0,(B) + ANDCM A,0 + MOVEI 0,(B) ; COPY TO 0 + LSH 0,23. ;POSITION FOR A .STATUS + IOR 0,[.STATUS 0] + XCT 0 ;DO IT + ANDI 0,77 ;ISOLATE DEVICE + CAILE 0,2 + JRST CHNA1 + +PMIN4: MOVE 0,B ; CHAN TO 0 + .ITYIC 0, ; INTO 0 + JRST .+2 ; DONE, GO ON + JRST PMIN4 + SETZM GCFLCH ; LEAVE GC MODE + JRST CHNA1 + +CHNA2: POP P,0 + SKIPN GCFLG + EXCH P,GCPDL + JRST GCQUIT + +HOWMNY: SETZ + SIXBIT /LISTEN/ + D + 402000,,B +] + +MFUNCTION GASCII,SUBR,ASCII + ENTRY 1 + + GETYP A,(AB) + CAIE A,TCHRS + JRST TRYNUM + + MOVE B,1(AB) + MOVSI A,TFIX + JRST FINIS + +TRYNUM: CAIE A,TFIX + JRST WTYP1 + SKIPGE B,1(AB) ;GET NUMBER + JRST TOOBIG + CAILE B,177 ;CHECK RANGE + JRST TOOBIG + MOVSI A,TCHRS + JRST FINIS + +TOOBIG: ERRUUO EQUOTE ARGUMENT-OUT-OF-RANGE + + +;HERE IF PDL OVERFLOW DURING GARBAGE COLLECTION + +BADPDL: FATAL NON PDL OVERFLOW + +NOGROW: FATAL PDL OVERFLOW ON NON EXPANDABLE PDL + +PDLOS1: MOVEI D,TPGROW +PDLOSS: MOVSI A,(GENERAL) ; FIX UP TP DOPE WORD JUST IN CASE + HRRZ D,(D) ; POINT TO POSSIBLE LOSING D.W. + SKIPN TPGROW + JRST PDLOS2 + MOVEM A,-1(D) + MOVEI A,(TP) ; SEE IF REL STACK SIZE WINS + SUBI A,(TB) + TRNN A,1 + SUB TP,[1,,1] +PDLOS2: MOVSI A,.VECT. + SKIPE PGROW + MOVEM A,-1(D) + SUB P,[2,,2] ; TRY TO RECOVER GRACEFULLY + EXCH P,GCPDL + MOVEI A,DOAGC ; SET UP TO IMMEDIATE GC +IFN ITS,[ + HRRM A,TSINTR +] +IFE ITS,[ + SKIPE MULTSG + HRRM A,TSINTR+1 + SKIPN MULTSG + HRRM A,TSINTR +] +IFN ITS, .DISMIS TSINTR +IFE ITS, DEBRK + +DOAGC: SKIPE PGROW + SUB P,[2,,2] ; ALLOW ROOM FOR CALL + JSP E,PDL3 ; CLEANUP + ERRUUO EQUOTE PDL-OVERFLOW-BUFFER-EXHAUSTED + + +DLOSER: PUSH P,LOSRS(B) + MOVE A,TSAVA + MOVE B,TSAVB + POPJ P, + +LOSRS: IMPV + ILOPR + IOC + IPURE + + +;MEMORY PROTECTION INTERRUPT + +IOC: FATAL IO CHANNEL ERROR IN GARBAGE COLLECTOR +IMPV: FATAL MPV IN GARBAGE COLLECTOR + +IPURE: FATAL PURE WRITE IN GARBAGE COLLECTOR +ILOPR: FATAL ILLEGAL OPEREATION IN GARBAGE COLLECTOR + +IFN ITS,[ + +;SUBROUTINE TO BE CALLED AT INITIALIZE TIME TO SETUP INTS + +INTINT: SETZM CHNCNT + MOVE A,[CHNCNT,,CHNCNT+1] + BLT A,CHNCNT+16. + SETZM INTFLG + .SUSET [.SPICLR,,[-1]] + MOVE A,MASK1 ;SET MASKS + MOVE B,MASK2 + .SETM2 A, ;SET BOTH MASKS + MOVSI A,TVEC + MOVEM A,QUEUES + SETZM QUEUES+1 ;UNQUEUE ANY OLD INTERRUPTS + SETZM CURPRI + POPJ P, +] +IFE ITS,[ + +; INITIALIZE TENEX INTERRUPT SYSTEM + +INTINT: CIS ; CLEAR THE INT WORLD + SETZM INTFLG ; IN CASE RESTART + MOVSI A,TVEC ; FIXUP QUEUES + MOVEM A,QUEUES + SETZM QUEUES+1 + SETZM CURPRI ; AND PRIORITY LEVEL + MOVEI A,MFORK ; TURN ON MY INTERRUPTS + SKIPN MULTSG + JRST INTINM + PUSHJ P,@[DOSIR] ; HACK TO TEMP GET TO SEGMENT 0 + JRST INTINX + +INTINM: MOVE B,[-36.,,CHNTAB] + MOVSI 0,1 + HLLM 0,(B) + AOBJN B,.-1 + + MOVE B,[LEVTAB,,CHNTAB] ; POINT TO TABLES + SIR ; TELL SYSTEM ABOUT THEM + +INTINX: MOVSI D,-NCHRS + MOVEI 0,40 + MOVEI C,0 + +INTILP: SKIPN A,CHRS(D) + JRST ITTIL1 + IOR C,0 + MOVSS A + HRRI A,(D) + ATI +ITTIL1: LSH 0,-1 + AOBJN D,INTILP + + DPB C,[360600,,MASK1] + MOVE B,MASK1 ; SET UP FOR INT BITS + MOVEI A,MFORK + AIC ; TURN THEM ON + MOVEI A,MFORK ; DO THE ENABLE + EIR + POPJ P, + + +DOSIR: MOVE B,[-36.,,CHNTAB] + MOVSI 0,1_12. + HLLM 0,(B) + AOBJN B,.-1 + + MOVEI B,..ARGB ; WILL RUN IN SEGMENT 0 +RMT [ +..ARGB: 3 + LEVTAB + CHNTAB +] + XSIR + POP P,D + HRLI D,FSEG + XJRST C ; GET BACK TO CALLING SEGMENT +] + + +; CNTL-G HANDLER + +MFUNCTION QUITTER,SUBR + + ENTRY 2 + GETYP A,(AB) + CAIE A,TCHRS + JRST WTYP1 + GETYP A,2(AB) + CAIE A,TCHAN + JRST WTYP2 + MOVE B,1(AB) + MOVE A,(AB) +IFE ITS, CAIE ^O + CAIN B,^S ; HANDLE CNTL-S + JRST RETLIS + CAIE B,7 + JRST FINIS + + PUSHJ P,CLEAN ; CLEAN UP I/O CHANNELS + PUSH TP,$TATOM + PUSH TP,EQUOTE CONTROL-G? + MCALL 1,ERROR + JRST FINIS + +RETLIS: MOVE B,IMQUOTE LER,[LERR ]INTRUP + PUSHJ P,ILVAL ; GET CURRENT VALUE + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + PUSHJ P,CHFSWP + SUB TP,[2,,2] + MOVEI D,(TB) ; FIND A LISTEN OR ERROR TO RET TO + +RETLI1: HRRZ A,OTBSAV(D) + CAIN A,(B) ; CHECK FOR WINNER + JRST FNDHIM + HRRZ C,FSAV(A) ; CHECK FUNCTION + CAIE C,LISTEN + CAIN C,ERROR ; FOUND? + JRST FNDHIM ; YES, GO TO SAME + CAIN C,ERROR% ; FUNNY ERROR + JRST FNDHIM + CAIN C,TOPLEV ; NO ERROR/LISTEN + JRST FINIS + MOVEI D,(A) + JRST RETLI1 + +FNDHIM: PUSH TP,$TTB + PUSH TP,D + PUSHJ P,CLEAN + MOVE B,(TP) ; NEW FRAME + SUB TP,[2,,2] + MOVEI C,0 + PUSHJ P,CHUNW ; UNWIND? + MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +CLEAN: MOVE B,3(AB) ; GET IN CHAN + PUSHJ P,RRESET + MOVE B,3(AB) ; CHANNEL BAKC + MOVE C,BUFRIN(B) + SKIPN C,ECHO(C) ; GET ECHO + JRST CLUNQ +IFN ITS,[ + MOVEI A,2 + CAMN C,[PUSHJ P,MTYO] + JRST TYONUM + LDB A,[270400,,C] +TYONUM: LSH A,23. + IOR A,[.RESET] + XCT A +] +IFE ITS,[ + MOVEI A,101 ; OUTPUT JFN + CFOBF +] + +CLUNQ: SETZB A,CURPRI + JRST UNQUEU + + +IMPURE +ONINT: 0 ; INT FUDGER +INTBCK: 0 ; GO BACK TO THIS PC AFTER INTERRUPT + MOVEM TP,TPSAV(TB) ; SAVE STUFF + MOVEM P,PSAV(TB) +INTBEN: SKIPL INTFLG ; PENDING INTS? + JRST @INTBCK + PUSH P,A + SOS A,INTBCK + SETZM INTBCK + MOVEM A,LCKINT + POP P,A + JRST LCKINT+1 + + +IFN ITS,[ +;RANDOM IMPURE CRUFT NEEDED +CHNCNT: BLOCK 16. ; # OF CHARS IN EACH CHANNEL + +TSAVA: 0 +TSAVB: 0 +PIRQ: 0 ;HOLDS REQUEST BITS FOR 1ST WORD +PIRQ2: 0 ;SAME FOR WORD 2 +PCOFF: 0 +MASK1: 200,,200100 ;FIRST MASK +MASK2: 0 ;SECOND THEREOF +CURPRI: 0 ; CURRENT PRIORITY +RLTSAV: 0 +] +IFE ITS,[ +CHRS: 7 ; CNTL-G + 23 ; CNTL-O + 17 ; CNTL-S + BLOCK NCHRS-3 + +NETJFN: BLOCK NNETS +MASK1: CHNMSK +RLTSAV: 0 +TSINTR: +P1: 0 + 0 ; PC INT LEVEL 1 (1ST WORD IN 1 SEG MODE, 2D + ; IN MULTI SEG MODE) +P2: 0 + 0 ; PC INT LEVEL 2 +P3: 0 + 0 ; PC INT LEVEL 3 +CURPRI: 0 +TSAVA: 0 +TSAVB: 0 +PIRQ: 0 +PIRQ2: 0 +IOCLOS: 0 ; HOLDS LOSING JFN IN TNX IOC +] +PURE + +END + \ No newline at end of file diff --git a//interr.mid.425 b//interr.mid.425 new file mode 100644 index 0000000..8e73375 --- /dev/null +++ b//interr.mid.425 @@ -0,0 +1,2898 @@ + +TITLE INTERRUPT HANDLER FOR MUDDLE + +RELOCATABLE + +;C. REEVE APRIL 1971 + +.INSRT MUDDLE > + +SYSQ +XJRST=JRST 5, + +F==PVP +G==TVP + +IF1,[ +IFE ITS,.INSRT STENEX > +] + +PDLGRO==10000 ;AMOUNT TO GROW A PDL THAT LOSES +NINT==72. ;MAXIMUM NUMBER OF INTERRUPTS POSSIBLE + +IFN ITS,[ +;SET UP LOCATION 42 TO POINT TO TSINT + +RMT [ + +ZZZ==$. ;SAVE CURRENT LOCATION + +LOC 42 + + JSR MTSINT ;GO TO HANDLER + +LOC ZZZ +] +] + +; GLOBALS NEEDED BY INTERRUPT HANDLER + +.GLOBAL ONINT ; FUDGE INS EXECUTED IF NON ZERO AT START OF INTERRUPT +.GLOBAL INTBCK ; "PC-LOSER HACK " +.GLOBA GCFLG ;TELLS WHETHER OR NOT GARBAGE COLLECTOR IS RUNNING +.GLOBAL GCFLCH ; FLUSH CHARS IMMEDIATE SO GC CAN SEE THEM +.GLOBAL CORTOP ; TOP OF CORE +.GLOBA GCINT ;TELLS GARBAGE COLLECTOR TO SIMULATE AN INTERRUPT +.GLOBAL INTNUM,INTVEC ;TV ENTRIES CONCERNING INTERRUPTS +.GLOBAL AGC ;CALL THE GARBAGE COLLECTOR +.GLOBAL VECNEW,PARNEW,GETNUM ;GC PSEUDO ARGS +.GLOBAL GCPDL ;GARBAGE COLLECTORS PDL +.GLOBAL VECTOP,VECBOT ;DELIMIT VECTOR SPACE +.GLOBAL PURTOP,CISTNG,SAGC +.GLOBAL PDLBUF ;AMOUNT OF PDL GROWTH +.GLOBAL PGROW ;POINTS TO DOPE WORD OF NEXT PDL TO GROW +.GLOBAL TPGROW ;POINTS TO NEXT MUDDLE PDL TO GROW +.GLOBAL TOPLEV,ERROR%,N.CHNS,CHNL1 +.GLOBAL BUFRIN,CHNL0,SYSCHR ;CHANNEL GLOBALS +.GLOBAL IFALSE,TPOVFL,1STEPR,INTOBL,INCHAR,CURPRI,RDEVIC,RDIREC,GFALS,STATUS +.GLOBAL PSTAT,NOTRES,IOIN2,INAME,INTFCN,CHNCNT,CHANNO,GIBLOK,ICONS,INCONS +.GLOBAL IEVECT,INSRTX,ILOOKC,IPUT,IREMAS,IGET,CSTAK,EMERGE,CHFSWP +.GLOBAL MTSINT ;BEGINNING OF INTERRUPT HANDLER +.GLOBAL INTINT ;CALLED BY INITIALIZER TO TAKE CARE OF INT PCS +.GLOBAL FRMSTK,APPLY,CHUNW,TGFALS +.GLOBAL IPCGOT,DIRQ ;HANDLE BRANCHING OFF TO IPC KLUDGERY +.GLOBAL MULTSG + +; GLOBALS FOR GC +.GLOBAL GCTIM,GCCAUS,GCCALL,GPDLOV + +; GLOBALS FOR MONITOR ROUTINES + +.GLOBAL MONCH,MONCH0,RMONCH,RMONC0,LOCQ,SMON,BAPT,APLQ,MAKACT,NAPT +.GLOBAL PURERR,BUFRIN,INSTAT,REALTV,DSTORE + +MONITOR + +.GLOBAL MSGTYP,MTYI,UPLO,IFLUSH,OCLOS,ERRET,MASK1,MASK2 ;SUBROUTINES USED +.GLOBAL ERROR,LISTEN,ECHO,RRESET,MTYO,GCHAPN,P.CORE,P.TOP,QUEUES,NOTTY,TTYOP2,TTICHN +.GLOBAL INTHLD,BNDV,SPECBE,DEMFLG,PLODR + +; GLOBALS FOR PRE-AGC INTERRUPT + +.GLOBAL FRETOP,GCSTOP,FREMIN,CORTOP,P.CORE,PURBOT,GETNUM,GCKNUM,GCHPN,INTAGC +.GLOBAL SPECBIND,SSPEC1,ILVAL + + +; GLOBALS FOR COPY/WRITE HACK FOR GCDUMP AND PURIFY + +.GLOBAL GCDFLG,%CWINF,BUFGC,WNDBOT,WIND,WNDP,%SHWND,GPURFL,%FDBUF,PURMNG,RPURBT +.GLOBAL NPWRIT,PVSTOR,SPSTOR,OPSYS + + + +;BEGINNING OF ACTUAL INTERRUPT HANDLER (MUST BE IMPURE) + + +;***** TEMP FUDGE ******* + +QUEUES==INTVEC + + +; DECLARATIONS ASSOCIATED WITH INTERRUPT HANDERS AND HEADERS + +; SPECIAL TABLES + +SPECIN: IRP A,,[CHAR,CLOCK,MPV,ILOPR,WRITE,READ,IOC,PURE,SYSDOWN,INFERIOR,RUNT,REALT +PARITY] + MQUOTE A,[A]INTRUP + TERMIN +SPECLN==.-SPECIN + +; TABLE OF SPECIAL FINDING ROUTINES + +FNDTBL: IRP A,,[GETCHN,0,0,0,LOCGET,LOCGET,0,0,0,0,0,0,0] + A + TERMIN + +; TABLE OF SPECIAL SETUP ROUTINES + +INTBL: IRP A,,[S.CHAR,S.CLOK,S.MPV,S.ILOP,S.WMON,S.RMON,S.IOC,S.PURE,S.DOWN,S.INF +S.RUNT,S.REAL,S.PAR] + A + S!A==.IRPCNT + TERMIN + +IFN ITS,[ + +; EXTERNAL INTERRUPT TABLE + +EXTINT: REPEAT NINT-36.,0 + REPEAT 16.,HCHAR + 0 + 0 + REPEAT 8.,HINF + REPEAT NINT-62.,0 +EXTIND: + +IRP A,,[[HCLOCK,13.],[HMPV,14.],[HILOPR,6],[HIOC,9],[HPURE,26.],[HDOWN,7],[HREAL,35.] +[HRUNT,34.],[HPAR,28.]] + IRP B,C,[A] + LOC EXTINT+C + B + .ISTOP + TERMIN +TERMIN + + +LOC EXTIND +] + +IFE ITS,[ + +; TABLES FOR TENEX INTERRUPT SYSTEM + +LEVTAB: P1 ; POINTS TO INT PC HOLDERS FOR LEVS 1,2 AND 3 + P2 + P3 + +CHNMSK==700000,,7 ; WILL BE MASK WORD FOR INT SET UP +MFORK==400000 +NNETS==7 ; ALLOW 7 NETWRK INTERRUPTS +UINTS==4 +NETCHN==36.-NNETS-UINTS-1 +NCHRS==6 +RLCHN==36.-NNETS-UINTS + +RMT [ +IMPURE ; IMPURE BECAUSE IT CHANGES IN MULTI-SECTION MODE +CHNTAB: ; LOCATION OF INT ROUTINES FOR VARIOUS "CHANNELS" + +REPEAT NCHRS, 1,,INTCHR+3*.RPCNT + BLOCK 36.-NNETS-NCHRS-UINTS-1 ; THERE ARE 36. TENEX INT CHANNELS + +REPEAT NNETS+UINTS, 1,,INTNET+3*.RPCNT + +IRP A,,[[9.,TNXPDL],[17.,PWRIT],[10.,TNXEOF],[11.,TNXIOC],[12.,TNXFUL] +[RLCHN,TNXRLT],[19.,TNXINF]] + IRP B,C,[A] + LOC CHNTAB+B + 1,,C + CHNMSK==CHNMSK+<1_<35.-B>> + .ISTOP + TERMIN +TERMIN +LOC CHNTAB+36. +PURE +] +EXTINT: +BLOCK 36. +REPEAT NCHRS,SETZ HCHAR +BLOCK NINT-NNETS-NCHRS-UINTS-36.-1 +REPEAT NNETS,SETZ HNET +REPEAT UINTS,SETZ USRINT +LOC EXTINT+NINT-11. +REPEAT 3,SETZ HIOC +LOC EXTINT+NINT-RLCHN-1 +SETZ HREAL +LOC EXTINT+NINT-19.-1 +SETZ HINF +LOC EXTINT+NINT +] + + +; HANDLER/HEADER PARAMETERS + +; HEADER BLOCKS + +IHDRLN==4 ; LENGTH OF HEADER BLOCK + +INAME==0 ; NAME OF INTERRUPT +ISTATE==2 ; CURRENT STATE +IHNDLR==4 ; POINTS TO LIST OF HANDLERS +INTPRI==6 ; CONTAINS PRIORITY OF INTERRUPT + +IHANDL==4 ; LENGTH OF A HANDLER BLOCK + +INXT==0 ; POINTS TO NEXTIN CHAIN +IPREV==2 ; POINTS TO PREV IN CHAIN +INTFCN==4 ; FUNCTION ASSOCIATED WITH THIS HANDLER +INTPRO==6 ; PROCESS TO RUN INT IN + +IFN ITS,[ +RMT [ +IMPURE +TSINT: +MTSINT: 0 ;INTERRUPT BITS GET STORED HERE +TSINTR: 0 ;INTERRUPT PC WORD STORED HERE + JRST TSINTP ;GO TO PURE CODE + +; SOFTWARE INTERNAL INTERRUPTS JSR TO HERE + +LCKINT: 0 + JRST DOINT + +PURE +] +] +IFE ITS,[ +RMT [ +; JSR HERE FOR SOFTWARE INTERNAL INTERRUPTS + +IMPURE +LCKINT: 0 + JRST DOINT +PURE +] +] + + +IFN ITS,[ + +;THE REST OF THIS CODE IS PURE + +TSINTP: SOSGE INTFLG ; SKIP IF ENABLED + SETOM INTFLG ;DONT GET LESS THAN -1 + + SKIPE INTBCK ; ANY INT HACKS? + JRST PCLOSR ; DO A PC-LOSR ON THE PROGRAM + MOVEM A,TSAVA ;SAVE TWO ACS + MOVEM B,TSAVB + MOVE A,TSINT ;PICK UP INT BIT PATTERN + JUMPL A,2NDWORD ;DONT CHECK FOR PDL OVERFLOW ETC. IF SIGN BIT ON + + TRZE A,200000 ;IS THIS A PDL OVERFLOW? + JRST IPDLOV ;YES, GO HANDLE IT FIRST + +IMPCH: MOVEI B,0 + TRNE A,20000 ;IS IT A MEMORY PROTECTION VIOLATION? + MOVEI B,1 ; FLAG SAME + + TRNE A,40 ;ILLEGAL OP CODE? + MOVEI B,2 ; ALSO FLAG + TRNN A,400 ; IOC? + JRST .+3 + SOS TSINTR + MOVEI B,3 + TLNE A,200 ; PURE? + JRST GCPWRT ; CHECK FOR PURE WRITE FOR POSSIBLE C/W +NOPUGC: SOJGE B,DO.NOW ; CANT WAIT AROUND + +;DECODE THE REST OF THE INTERRUPTS USING A TABLE + +2NDWORD: + JUMPL A,GC2 ;2ND WORD? + IORM A,PIRQ ;NO, INTO WORD 1 + JRST GCQUIT ;AND DISMISS INT + +GC2: TLZ A,400000 ;TURN OFF SIGN BIT + IORM A,PIRQ2 + TRNE A,177777 ;CHECK FOR CHANNELS + JRST CHNACT ;GO IF CHANNEL ACTIVITY +] +GCQUIT: SKIPGE INTFLG ;SKIP IF INTERRUPTS ENABLED + JRST INTDON ;NO, DEFER REAL HANDLING UNTIL LATER + + MOVE A,TSINTR ;PICKUP RETURN WORD +IFE ITS,[ + SKIPE MULTSG + JRST MLTEX + TLON A,10000 ; EXEC PC? + SOJA A,MLTEX1 ; YES FIXUP PC +MLTEX: TLON A,10000 + SOS TSINTR+1 + MOVEM A,TSINTR + MOVE A,TSINTR+1 +] +MLTEX1: MOVEM A,LCKINT ;STORE ELSEWHERE + MOVEI A,DOINTE ;CAUSE DISMISS TO HANDLER +IFN ITS, HRRM A,TSINTR ;STORE IN INT RETURN +IFE ITS,[ + SKIPE MULTSG + HRRM A,TSINTR+1 + SKIPN MULTSG + HRRM A,TSINTR +] + PUSH P,INTFLG ;SAVE INT FLAG + SETOM INTFLG ;AND DISABLE + + +INTDON: MOVE A,TSAVA ;RESTORE ACS + MOVE B,TSAVB +IFN ITS, .DISMISS TSINTR ;AND DISMISS THE INTERRUPT +IFE ITS, DEBRK + +IFN ITS,[ +PCLOSR: MOVEM A,TSAVA + HRRZ A,TSINTR ; WHERE FROM + CAIG A,INTBCK + CAILE A,INTBEN ; AVOID TIMING ERRORS + JRST .+2 + JRST INTDON + + SOS A,INTBCK + MOVEM A,TSINTR + SETZM INTBCK + SETZM INTFLG + AOS INTFLG + MOVE TP,TPSAV(TB) + MOVE P,PSAV(TB) + MOVE A,TSAVA + JRST TSINTP +] +DO.NOW: SKIPN GPURFL + SKIPE GCFLG + JRST DLOSER ; HANDLE FATAL GC ERRORS + MOVSI B,1 + SKIPGE INTFLG ; IF NOT ENABLED + MOVEM B,INTFLG ; PRETEND IT IS +IFN ITS, JRST 2NDWORD +IFE ITS, JRST GCQUIT + +IFE ITS,[ + +; HERE FOR TENEX PDL OVER FLOW INTERRUPT + +TNXPDL: SOSGE INTFLG + SETOM INTFLG + MOVEM A,TSAVA + MOVEM B,TSAVB + JRST IPDLOV ; GO TO COMMON HANDLER + +; HERE FOR REAL TIMER + +TNXRLT: MOVEM A,TSAVA +IFG , MOVEI A,<1_<35.->> +IFLE MOVSI A,(<1_<35.->>) + + JRST CNTSG + +; HERE FOR TENEX ^G AND ^S INTERRUPTS + +INTCHR: +REPEAT NCHRS,[ + MOVEM A,TSAVA + MOVEI A,<1_<.RPCNT>> + JRST CNTSG +] +CNTSG: MOVEM B,TSAVB + IORM A,PIRQ2 ; SAY FOR MUDDLE LEVEL + SOSGE INTFLG + SETOM INTFLG + JRST GCQUIT +INTNET: +REPEAT NNETS+UINTS,[ + MOVEM A,TSAVA + MOVE A,[1_<.RPCNT+NETCHN>] + JRST CNTSG +] +TNXINF: MOVEM A,TSAVA + MOVEI A,<1_<35.-19.>> + JRST TNXCHN + +; LOW LEVEL HANDLERS FOR 10X IOC INTERRUPTS + +TNXEOF: MOVEM A,TSAVA + MOVSI A,(1_<35.-10.>) + JRST TNXCHN + +TNXIOC: MOVEM A,TSAVA + MOVSI A,(1_<35.-11.>) + JRST TNXCHN + +TNXFUL: MOVEM A,TSAVA + SKIPN PLODR + JRST TNXFU1 + FATAL DISK FULL IN PURE FIXUP, CONTINUE TO RETRY + JRST INTDON + +TNXFU1: MOVSI A,(1_<35.-12.>) + +TNXCHN: IORM A,PIRQ2 + MOVEM B,TSAVB + HRRZ A,TSAVA ; ASSUME JFN IS IN A (PRETTY FLAKEY BUT ...) + MOVEM A,IOCLOS + JRST DO.NOW +] + +; HERE TO PROCESS INTERRUPTS + +DOINT: SKIPE INTHLD ; GLOBAL LOCK ON INTS + JRST @LCKINT + SETOM INTHLD ; DONT LET IT HAPPEN AGAIN + PUSH P,INTFLG +DOINTE: SKIPE ONINT ; ANY FUDGE? + XCT ONINT ; YEAH, TRY ONE + PUSH P,ONINT + SETZM ONINT + EXCH 0,LCKINT ; RELATIVIZE PC IF FROM RSUBR +IFE ITS, TLZ 0,777740 ; KILL EXCESS BITS + PUSH P,0 ; AND SAVE + ANDI 0,-1 + CAMG 0,PURTOP + CAMGE 0,VECBOT + JRST DONREL + SUBI 0,(M) ; M IS BASE REG +IFN ITS, TLO 0,400000+M ; INDEX IT OFF M +IFE ITS,[ + TLO 0,400000+M + SKIPN MULTSG + JRST .+3 + HLL 0,(P) + TLO 0,400000 +] + EXCH 0,(P) ; AND RESTORE TO STACK +DONREL: EXCH 0,LCKINT ; GET BACK SAVED 0 + SETZM INTFLG ;DISABLE + AOS -2(P) ;INCR SAVED FLAG + +;NOW SAVE WORKING ACS + + PUSHJ P,SAVACS + HLRZ A,-2(P) ; HACK FUNNYNESS FOR MPV/ILOPR + SKIPE A + SETZM -2(P) ; REALLY DISABLED + +DIRQ: MOVE A,PIRQ ;NOW SATRT PROCESSING + JFFO A,FIRQ ;COUNT BITS AND GO + MOVE A,PIRQ2 ;1ST DONE, LOOK AT 2ND + JFFO A,FIRQ2 + +INTDN1: SKIPN GCHAPN ; SKIP IF MUST DO GC INT + JRST .+3 + SETZM GCHAPN + PUSHJ P,INTOGC ; AND INTERRUPT + + PUSHJ P,RESTAC + +IFN ITS,[ + .SUSET [.SPICLR,,[0]] ; DISABLE INTS +] + POP P,LCKINT + POP P,ONINT + POP P,INTFLG + SETZM INTHLD ; RE-ENABLE THE WORLD +IFN ITS,[ + EXCH 0,LCKINT + HRRI 0,@0 ; EFFECTIVIZE THE ADDRESS + TLZ 0,37 ; KILL IND AND INDEX + EXCH 0,LCKINT + .DISMIS LCKINT +] +IFE ITS,[ + SKIPN MULTSG + JRST @LCKINT + XJRST .+1 ; MAKE SURE OUT OF SECTION 0 + 0 + FSEG,,.+1 + EXCH 0,LCKINT + TLZE 0,400000 + ADDI 0,(M) + EXCH 0,LCKINT + JRST @LCKINT +] +FIRQ: PUSHJ P,GETBIT ;SET UP THE BIT TO CLOBBER IN PIRQ + ANDCAM A,PIRQ ;CLOBBER IT + ADDI B,36. ;OFSET INTO TABLE + JRST XIRQ ;GO EXECUTE + +FIRQ2: PUSHJ P,GETBIT ;PREPARE TO CLOBBER BIT + ANDCAM A,PIRQ2 ;CLOBBER IT + ADDI B,71. ;AGAIN OFFSET INTO TABLE +XIRQ: + CAIE B,21 ;PDL OVERFLOW? + JRST FHAND ;YES, HACK APPROPRIATELY + +PDL2: JSP E,PDL3 + JRST DIRQ + +PDL3: SKIPN A,PGROW + SKIPE A,TPGROW + JRST .+2 + JRST (E) ; NOTHING GROWING, FALSE ALARM + MOVEI B,PDLGRO_-6 ;GET GROWTH SPEC + DPB B,[111100,,-1(A)] ;STORE GROWTH SPEC +REAGC: MOVE C,[10.,,1] ; INDICATOR FOR AGC + SKIPE PGROW ; P IS GROWING + ADDI C,6 + SKIPE TPGROW ; TP IS GROWING + ADDI C,1 + PUSHJ P,AGC ;COLLECT GARBAGE + SETZM PGROW + SETZM TPGROW + AOJL A,REAGC ; IF NO CORE, RETRY + JRST (E) + +SAVACS: + PUSH P,PVP + MOVE PVP,PVSTOR+1 +IRP A,,[0,A,B,C,D,E,TVP,SP] + PUSH TP,A!STO(PVP) + SETZM A!STO(PVP) ;NOW ZERO TYPE + PUSH TP,A + TERMIN + PUSH TP,$TLOSE + PUSH TP,DSTORE + MOVE D,PVP + POP P,PVP + PUSH TP,PVPSTO(D) + PUSH TP,PVP + SKIPE D,DSTORE + MOVEM D,-13(TP) ; USE AS DSTO + SETZM DSTORE + POPJ P, + +RESTAC: POP TP,PVP + PUSH P,PVP + MOVE PVP,PVSTOR+1 + POP TP,PVPSTO(PVP) + POP TP,DSTORE + SUB TP,[1,,1] +IRP A,,[SP,TVP,E,D,C,B,A,0] + POP TP,A + POP TP,A!STO(PVP) + TERMIN + SKIPE DSTORE + SETZM DSTO(PVP) + POP P,PVP + POPJ P, + +; HERE TO DO GC INTERRUPT AND CLOSE ANY DEAD CHANNELS + +INTOGC: PUSH P,[N.CHNS-1] + MOVE PVP,PVSTOR+1 + MOVE TVP,REALTV+1(PVP) + MOVEI A,CHNL1 + SUBI A,(TVP) + HRLS A + ADD A,TVP + PUSH TP,$TVEC + PUSH TP,A + +INTGC1: MOVE A,(TP) ; GET POINTER + SKIPN B,1(A) ; ANY CHANNEL? + JRST INTGC2 + HRRE 0,(A) ; INDICATOR + JUMPGE 0,INTGC2 + PUSH TP,$TCHAN + PUSH TP,B + MCALL 1,FCLOSE + + MOVE A,(TP) + +INTGC2: HLLZS (A) + ADD A,[2,,2] + MOVEM A,(TP) + SOSE (P) + JRST INTGC1 + + SUB P,[1,,1] + SUB TP,[2,,2] + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE GC + PUSH TP,$TFLOAT ; PUSH ON TIME ARGUMENT + PUSH TP,GCTIM + PUSH TP,$TFIX ; PUSH ON THE CAUSE ARGUMENT + PUSH TP,GCCAUS + PUSH TP,$TATOM ; PUSH ON THE CALL ARGUMENT + MOVE A,GCCALL + PUSH TP,@GCALLR(A) + MCALL 4,INTERR + POPJ P, + +; PRE AGC INTERRUPT. CAUSED WHEN FREE STORAGE REQUEST CAN BE SATISFIED BY +; EXTENDING CORE. IT IS CALLED "AGC" AND THE HANDLER IS PASSED THE CALLER, +; AND THE PENDING REQUEST. + + +INTAGC: MOVE A,GETNUM + MOVEM A,GCKNUM ; SET UP TO CAUSE INTERRUPT + PUSH P,C ; SAVE ARGS TO GC + MOVEI A,2000 ; GET WORKING SPACE + PUSHJ P,INTCOR ; GET IT + MOVSI A,TATOM ; EXAMINE BINDING OF FLAG + MOVE B,IMQUOTE AGC-FLAG + PUSHJ P,ILVAL + CAME A,$TUNBOUND + JRST INAGCO ; JUMP TO GET CORE FOR INTERRUPT + MOVE A,GETNUM + ADD A,P.TOP ; SEE IF WE CAN POSSIBLY WIN + ADD A,FREMIN + CAML A,PURBOT + JRST AGCCAU ; WORLD IS IN BAD SHAPE, CALL AGC + PUSH TP,$TTP ; BIND FLAG + PUSH TP,TP ; FOR UNBINDING PURPOSES + PUSH TP,[TATOM,,-1] ; SPECBINDS ARGS + PUSH TP,IMQUOTE AGC-FLAG + PUSH TP,$TFIX + PUSH TP,[-1] + PUSH TP,[0] + PUSH TP,[0] + PUSHJ P,SPECBIND + +; SET UP CALL TO HANDLER + + PUSH TP,$TCHSTR ; STRING INDICATING INTERRUPT + PUSH TP,CHQUOTE DIVERT-AGC + PUSH TP,$TFIX ; PENDING REQUEST + PUSH TP,GETNUM + HLRZ C,(P) + PUSH TP,$TATOM + PUSH TP,@GCALLR(C) + SETZM GCHPN + MCALL 3,INTERR ; ENABLE INTERRUPT + GETYP A,A ; CHECK TO SEE IF INTERRUPT WAS ENABLED + HRRZ E,-6(TP) ; GET ARG FOR UNBINDING + PUSHJ P,SSPEC1 + SUB TP,[8,,8] ; CLEAN OFF STACK + CAIE A,TFALSE ; SKIP IF NOT + JRST CHKWIN + +; CAUSE AN AGC TO HAPPEN + +AGCCAU: MOVE C,(P) ; INDICATOR + PUSHJ P,SAGC ; CALL AGC + JRST FINAGC + +; SEE WHETHER ENOUGH CORE WAS ALLOCATED +CHKWIN: MOVE A,FRETOP + SUB A,GCSTOP + SUB A,GCKNUM ; AMOUNT NEEDED OR IN EXCESS + JUMPGE A,FINAGC ; JUMP IF DONE + MOVE A,GCKNUM + MOVEM A,GETNUM ; SET UP REQUEST + MOVE C,(P) + JRST AGCCAU +FINAGC: SETZM GETNUM + POP P,C ; RESTORE C + POPJ P, ; EXIT + +; ROUTINE TO HANDLE INTERRUPT WHILE INTERRUPT IS RUNNING +; IT TRIES TO ALLOCATE FOR REQUEST+ AT LEAST ONE CORE BLOCK + +INAGCO: MOVE A,GETNUM ; GET REQUEST + SUB A,GCKNUM ; CALCULATE REAL CURRENT REQUEST + ADDI A,1777 + ANDCMI A,1777 ; AMOUNT WANTED + PUSHJ P,INTCOR ; GET IT + POP P,C ; RESTORE C + POPJ P, ; EXIT + +; ROUTINE TO GET CORE FOR PRE-AGC INTERRUPT. REQUEST IN A + + +INTCOR: ADD A,P.TOP ; ADD TOP TO REQUEST + CAML A,PURBOT ; SKIP IF BELOW PURE + JRST AGCCA1 ; LOSE + MOVEM A,CORTOP ; STORE POSSIBLE CORE TOP + ASH A,-10. ; TO PAGES + PUSHJ P,P.CORE ; GET THE CORE + JRST AGCCA1 ; LOSE,LOSE,LOSE + PUSH P,B + MOVE B,FRETOP + SUBI B,2000 + MOVE A,FRETOP + SETZM (B) + HRLI B,(B) + ADDI B,1 + BLT B,-1(A) + POP P,B + MOVEM A,FRETOP + POPJ P, ; EXIT +AGCCA1: MOVE C,-1(P) ; GET ARGS FOR AGC + SUB P,[1,,1] ; FLUSH RETURN ADDRESS + JRST AGCCAU+1 + + + +GCALLR: MQUOTE GC-READ + MQUOTE BLOAT + MQUOTE GROW + IMQUOTE LIST + IMQUOTE VECTOR + IMQUOTE SET + IMQUOTE SETG + MQUOTE FREEZE + MQUOTE PURE-PAGE-LOADER + MQUOTE GC + MQUOTE INTERRUPT-HANDLER + MQUOTE NEWTYPE + MQUOTE PURIFY + + ; OLD "ON" SETS UP EVENT AND HANDLER + +MFUNCTION ON,SUBR + + ENTRY + + HLRE 0,AB ; 0=> -2*NUM OF ARGS + ASH 0,-1 ; TO -NUM + CAME 0,[-5] + JRST .+3 + MOVEI B,10(AB) ; LAST MUST BE CHAN OR LOC + PUSHJ P,CHNORL + ADDI 0,3 + JUMPG 0,TFA ; AT LEAST 3 + MOVEI A,0 ; SET UP IN CASE NO PROC + AOJG 0,ONPROC ; JUMP IF NONE + GETYP C,6(AB) ; CHECK IT + CAIE C,TPVP + JRST TRYFIX + MOVE A,7(AB) ; GET IT +ONPROC: PUSH P,A ; SAVE AS A FLAG + GETYP A,(AB) ; CHECK PREV EXISTANCE + PUSH P,0 + CAIN A,TATOM + JRST .+3 + CAIE A,TCHSTR + JRST WTYP1 + MOVEI B,(AB) ; FIND IT + PUSHJ P,FNDINT + POP P,0 ; REST NUM OF ARGS + JUMPN B,ON3 ; ALREADY THERE + SKIPE C ; SKIP IF NOTHING TO FLUSH + SUB TP,[2,,2] + PUSH TP,(AB) ; GET NAME + PUSH TP,1(AB) + PUSH TP,4(AB) + PUSH TP,5(AB) + MOVEI A,2 ; # OF ARGS TO EVENT + AOJG 0,ON1 ; JUMP IF NO LAST ARG + PUSH TP,10(AB) + PUSH TP,11(AB) + ADDI A,1 +ON1: ACALL A,EVENT + +ON3: PUSH TP,A + PUSH TP,B + PUSH TP,2(AB) ; NOW FCN + PUSH TP,3(AB) + MOVEI A,3 ; NUM OF ARGS + SKIPN (P) + SOJA A,ON2 ; NO PROC + PUSH TP,$TPVP + PUSH TP,7(AB) +ON2: ACALL A,HANDLER + JRST FINIS + + +TRYFIX: SKIPN A,7(AB) + CAIE C,TFIX + JRST WRONGT + JRST ONPROC + +; ROUTINE TO BUILD AN EVENT + +MFUNCTION EVENT,SUBR + + ENTRY + + HLRZ 0,AB + CAIN 0,-2 ; IF JUST 1 + JRST RE.EVN ; COULD BE EVENT + CAIL 0,-3 ; MUST BE AT LEAST 2 ARGS + JRST TFA + GETYP A,2(AB) ; 2ND ARG MUST BE FIXED POINT PRIORITY + CAIE A,TFIX + JRST WTYP2 + GETYP A,(AB) ; FIRST ARG SHOULD BE CHSTR + CAIN A,TATOM ; ALLOW ACTUAL ATOM + JRST .+3 + CAIE A,TCHSTR + JRST WTYP1 + CAIL 0,-5 + JRST GOTRGS + CAIG 0,-7 + JRST TMA + MOVEI B,4(AB) + PUSHJ P,CHNORL ; CHANNEL OR LOCATIVE (PUT ON STACK) + +GOTRGS: MOVEI B,(AB) ; NOW TRY TO FIND HEADER FOR THIS INTERRUPT + PUSHJ P,FNDINT ; CALL INTERNAL HACKER + JUMPN B,FINIS ; ALREADY ONE OF THIS NAME + PUSH P,C + JUMPE C,.+3 ; GET IT OFF STACK + POP TP,B + POP TP,A + PUSHJ P,MAKINT ; MAKE ONE FOR ME + MOVSI 0,TFIX + MOVEM 0,INTPRI(B) ; SET UP PRIORITY + MOVE 0,3(AB) + MOVEM 0,INTPRI+1(B) +CH.SPC: POP P,C ; GET CODE BACK + SKIPGE C + PUSHJ P,DO.SPC ; DO ANY SPECIAL HACKS + JRST FINIS + +RE.EVN: GETYP 0,(AB) + CAIE 0,TINTH + JRST TFA ; ELSE SAY NOT ENOUGH + MOVE B,1(AB) ; GET IT + SETZM ISTATE+1(B) ; MAKE SURE ENABLED + SETZB D,C + GETYP A,INAME(B) ; CHECK FOR CHANNEL + CAIN A,TCHAN ; SKIP IF NOT + HRROI C,SS.CHA ; SET UP CHANNEL HACK + HRLZ E,INTPRI(B) ; GET POSSIBLE READ/WRITE BITS + TLNE E,.WRMON+.RDMON ; SKIP IF NOT MONITORS + PUSHJ P,GETNM1 + JUMPL C,RE.EV1 + MOVE B,INAME+1(B) ; CHECK FOR SPEC + PUSHJ P,SPEC1 + MOVE B,1(AB) ; RESTORE IHEADER +RE.EV1: PUSH TP,INAME(B) + PUSH TP,INAME+1(B) + PUSH P,C + MOVSI C,TATOM + PUSH TP,$TATOM + SKIPN D + MOVE D,MQUOTE INTERRUPT + PUSH TP,D + MOVE A,INAME(B) + MOVE B,INAME+1(B) ; GET IT + PUSHJ P,IGET ; LOOK FOR IT + JUMPN B,FINIS ; RETURN IT + MOVE A,(TB) + MOVE B,1(TB) + POP TP,D + POP TP,C + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,IPUT ; REESTABLISH IT + MOVE A,(AB) + MOVE B,1(AB) + JRST CH.SPC + + +; FUNCTION TO GENERATE A HANDLER FOR A GIVEN INTERRUPT + +MFUNCTION HANDLER,SUBR + + ENTRY + + HLRZ 0,AB + CAIL 0,-2 ; MUST BE 2 OR MORE ARGS + JRST TFA + GETYP A,(AB) + CAIE A,TINTH ; EVENT? + JRST WTYP1 + GETYP A,2(AB) + CAIN 0,-4 ; IF EXACTLY 2 + CAIE A,THAND ; COULD BE HANDLER + JRST CHEVNT + + MOVE B,3(AB) ; GET IT + SKIPN IPREV+1(B) ; SKIP IF ALREADY IN USE + JRST HNDOK + MOVE D,1(AB) ; GET EVENT + SKIPN D,IHNDLR+1(D) ; GET FIRST HANDLER + JRST BADHND + CAMN D,B ; IS THIS IT? + JRST HFINIS ; YES, ALREADY "HANDLED" + MOVE D,INXT+1(D) ; GO TO NEXT HANDLER + JUMPN D,.-3 +BADHND: ERRUUO EQUOTE HANDLER-ALREADY-IN-USE + +CHEVNT: CAIG 0,-7 ; SKIP IF LESS THAN 4 + JRST TMA + PUSH TP,$TPVP ; SLOT FOR PROCESS + PUSH TP,[0] + CAIE 0,-6 ; IF 3, LOOK FOR PROC + JRST NOPROC + GETYP 0,4(AB) + CAIE 0,TPVP + JRST WTYP3 + MOVE 0,5(AB) + MOVEM 0,(TP) + +NOPROC: PUSHJ P,APLQ + JRST NAPT + PUSHJ P,MHAND ; MAKE THE HANDLER + MOVE 0,1(TB) ; GET PROCESS + MOVEM 0,INTPRO+1(B) ; AND PUT IT INTO HANDLER + MOVSI 0,TPVP ; SET UP TYPE + MOVEM 0,INTPRO(B) + MOVE 0,2(AB) ; SET UP FUNCTION + MOVEM 0,INTFCN(B) + MOVE 0,3(AB) + MOVEM 0,INTFCN+1(B) + +HNDOK: MOVE D,1(AB) ; PICK UP EVEENT + MOVE E,IHNDLR+1(D) ; GET POINTER TO HANDLERS + MOVEM B,IHNDLR+1(D) ; PUT NEW ONE IN + MOVSI 0,TINTH ; GET INT HDR TYPE + MOVEM 0,IPREV(B) ; INTO BACK POINTER + MOVEM D,IPREV+1(B) ; AND POINTER ITSELF + MOVEM E,INXT+1(B) ; NOW NEXT POINTER + MOVSI 0,THAND ; NOW HANDLER TYPE + MOVEM 0,IHNDLR(D) ; SET TYPE IN HEADER + MOVEM 0,INXT(B) + JUMPE E,HFINIS ; JUMP IF HEADER WAS EMPTY + MOVEM 0,IPREV(E) ; FIX UP ITS PREV + MOVEM B,IPREV+1(E) +HFINIS: MOVSI A,THAND + JRST FINIS + + + +; FUNCTIONS TO SET TIME LIMITS FOR REALTIME AND RUNTIME INTS + +IFN ITS,[ + +MFUNCTION RUNTIMER,SUBR + + ENTRY + + CAMG AB,[-3,,0] + JRST TMA + JUMPGE AB,RNTLFT + GETYP 0,(AB) + JFCL 10,.+1 + MOVE A,1(AB) + CAIE 0,TFIX + JRST RUNT1 + IMUL A,[245761.] + JRST RUNT2 + +RUNT1: CAIE 0,TFLOAT + JRST WTYP1 + FMPR A,[245760.62] + MULI A,400 ; FIX IT + TSC A,A + ASH B,(A)-243 + MOVE A,B +RUNT2: JUMPL A,OUTRNG ; NOT FOR NEG # + JFCL 10,OUTRNG + .SUSET [.SRTMR,,A] + MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS +RNTLFT: .SUSET [.RRTMR,,B] + JUMPL B,IFALSE ; RETURN FALSE IF NONE SET + IDIV B,[245761.] ; TO SECONDS + MOVSI A,TFIX + JRST FINIS + +] +.TIMAL==5 +.TIMEL==1 + +MFUNCTION REALTIMER,SUBR + + ENTRY + + CAMG AB,[-3,,0] + JRST TMA + JUMPGE AB,RLTPER + JFCL 10,.+1 + GETYP 0,(AB) + MOVE A,1(AB) + CAIE 0,TFIX + JRST REALT1 +IFN ITS, IMULI A,60. ; TO 60THS OF SEC +IFE ITS, IMULI A,1000. ; TO MILLI + JRST REALT2 + +REALT1: CAIE 0,TFLOAT + JRST WTYP1 +IFN ITS, FMPRI A,(60.0) +IFE ITS, FMPRI A,(1000.0) + MULI A,400 + TSC A,A + ASH B,(A)-243 + MOVE A,B + +REALT2: JUMPL A,OUTRNG + JFCL 10,OUTRNG + MOVEM A,RLTSAV +IFN ITS,[ + MOVE B,[200000,,A] + SKIPN A + MOVSI B,400000 + .REALT B, + JFCL +] +IFE ITS,[ + MOVE A,[MFORK,,.TIMAL] ; FLUSH CURRENT FIRST + TIMER + JRST TIMERR + SKIPN B,RLTSAV + JRST RETRLT + HRRI A,.TIMEL + MOVEI C,RLCHN + TIMER + JRST TIMERR +RETRLT: MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +TIMERR: MOVNI A,1 + PUSHJ P,TGFALS + JRST FINIS + +RLTPER: SKIPGE B,RLTSAV + JRST IFALSE +IFN ITS, IDIVI B,60. ; BACK TO SECONDS +IFE ITS, IDIVI B,1000. + MOVSI A,TFIX + JRST FINIS + + +; FUNCTIONS TO ENABLE AND DISABLE INTERRUPTS + +MFUNCTION %ENABL,SUBR,ENABLE + + PUSHJ P,GTEVNT + SETZM ISTATE+1(B) + JRST FINIS + +MFUNCTION %DISABL,SUBR,DISABLE + + + PUSHJ P,GTEVNT + SETOM ISTATE+1(B) + JRST FINIS + +GTEVNT: ENTRY 1 + GETYP 0,(AB) + CAIE 0,TINTH + JRST WTYP1 + MOVE A,(AB) + MOVE B,1(AB) + POPJ P, + +DO.SPC: HRRO C,INTBL(C) ; POINT TO SPECIAL CODE + HLRZ 0,AB ; - TWO TIMES NUM ARGS + PUSHJ P,(C) ; CALL ROUTINE + JUMPE E,CPOPJ ; NO BITS TO ENABLE, LEAVE +IFE ITS,[ + PUSH TP,A + PUSH TP,B + MOVE B,1(TB) ; CHANNEL + MOVE 0,CHANNO(B) + MOVEM 0,(E) ; SAVE IN TABLE + MOVEI E,(E) + SUBI E,NETJFN-NETCHN + MOVE A,0 ; SETUP FOR MTOPR + MOVEI B,24 + MOVSI C,(E) + TLO C,770000 ; DONT SETUP INR/INS + MTOPR + MOVEI 0,1 + MOVNS E + LSH 0,35.(E) + IORM 0,MASK1 + MOVE B,MASK1 + MOVEI A,MFORK + AIC + + POP TP,B + POP TP,A + POPJ P, ; ***** TEMP ****** +] +IFN ITS,[ + CAILE E,35. ; SKIP IF 1ST WORD BIT + JRST SETW2 + LSH 0,-1(E) + + IORM 0,MASK1 ; STORE IN PROTOTYPE MASK + .SUSET [.SMASK,,MASK1] + POPJ P, + +SETW2: LSH 0,-36.(E) + IORM 0,MASK2 ; SET UP PROTO MASK2 + .SUSET [.SMSK2,,MASK2] + POPJ P, +] + +; ROUTINE TO CHECK FOR CHANNEL OR LOCATIVE + +CHNORL: GETYP A,(B) ; GET TYPE + CAIN A,TCHAN ; IF CHANNEL + JRST CHNWIN + PUSH P,0 + PUSHJ P,LOCQ ; ELSE LOOCATIVE + JRST WRONGT + POP P,0 +CHNWIN: PUSH TP,(B) + PUSH TP,1(B) + POPJ P, + +; SUBROUTINE TO FIND A HANDLER OF A GIVEN NAME + +FNDINT: PUSHJ P,FNDNM + JUMPE B,CPOPJ + PUSHJ P,SPEC1 ; COULD BE FUNNY + +INTASO: PUSH P,C ; C<0 IF SPECIAL + PUSH TP,A + PUSH TP,B + MOVSI C,TATOM + SKIPN D ; COULD BE CHANGED FOR MONITOR + MOVE D,MQUOTE INTERRUPT + PUSH TP,C + PUSH TP,D + PUSHJ P,IGET + MOVE D,(TP) + SUB TP,[2,,2] + POP P,C ; AND RESTOR SPECIAL INDICATOR + SKIPE B ; IF FOUND + SUB TP,[2,,2] ; REMOVE CRUFT +CPOPJ: POPJ P, ; AND RETURN + +; CHECK FOR SPECIAL INTERNAL INTERRUPT HACK + +SPEC1: MOVSI C,-SPECLN ; BUILD AOBJN PNTR +SPCLOP: CAME B,@SPECIN(C) ; SKIP IF SPECIAL + AOBJN C,.-1 ; UNTIL EXHAUSTED + JUMPGE C,.+3 + SKIPE E,FNDTBL(C) + JRST (E) + MOVEI 0,-1(TB) ; SEE IF OK + CAIE 0,(TP) + JRST TMA + POPJ P, + +; ROUTINE TO CREATE A NEW INTERRUPT (INTERNAL ONLY--NOT ITS FLAVOR) + +MAKINT: JUMPN C,GOTATM ; ALREADY HAVE NAME, GET THING + MOVEI B,(AB) ; POINT TO STRING + PUSHJ P,CSTAK ; CHARS TO STAKC + MOVE B,INTOBL+1 + PUSHJ P,INSRTX + MOVE D,MQUOTE INTERRUPT +GOTATM: PUSH TP,$TINTH ; MAKE SLOT FOR HEADER BLOCK + PUSH TP,[0] + PUSH TP,A + PUSH TP,B ; SAVE ATOM + PUSH TP,$TATOM + PUSH TP,D + MOVEI A,IHDRLN*2 + PUSHJ P,GIBLOK + MOVE A,-3(TP) ; GET NAME AND STORE SAME + MOVEM A,INAME(B) + MOVE A,-2(TP) + MOVEM A,INAME+1(B) + SETZM ISTATE+1(B) + MOVEM B,-4(TP) ; STASH HEADER + POP TP,D + POP TP,C + EXCH B,(TP) + MOVSI A,TINTH + EXCH A,-1(TP) ; INTERNAL PUT CALL + PUSHJ P,IPUT + POP TP,B + POP TP,A + POPJ P, + +; FIND NAME OF INTERRUPT + +FNDNM: GETYP A,(B) ; TYPE + CAIE A,TCHSTR ; IF STRING + JRST FNDATM ; DONT HAVE ATOM, OTHERWISE DO + PUSHJ P,IILOOK + JRST .+2 +FNDATM: MOVE B,1(B) + SETZB C,D ; PREVENT LOSSAGE LATER + MOVSI A,TATOM + +; THE NEXT 2 INSTRUCTIONS ARE A KLUDGE TO GET THE RIGHT ERROR ATOM + + CAMN B,IMQUOTE ERROR + MOVE B,MQUOTE ERROR,ERROR,INTRUP + POPJ P, + +IILOOK: PUSHJ P,CSTAK ; PUT CHRS ON STACK + MOVSI A,TOBLS + MOVE B,INTOBL+1 + JRST ILOOKC ; LOOK IT UP + +; ROUTINE TO MAKE A HANDLER BLOCK + +MHAND: MOVEI A,IHANDL*2 + JRST GIBLOK ; GET BLOCK + +; HERE TO GET CHANNEL FOR "CHAR" INTERRUPT + +GETCHN: GETYP 0,(TB) ; GET TYPE + CAIE 0,TCHAN ; CHANNL IS WINNER + JRST WRONGT + MOVE A,(TB) ; USE THE CHANNEL TO NAME THE INTERRUPT + MOVE B,1(TB) + SKIPN CHANNO(B) ; SKIP IF WINNING CHANNEL + JRST CBDCHN ; LOSER + POPJ P, + +LOCGET: GETYP 0,(TB) ; TYPE + CAIN 0,TCHAN ; SKIP IF LOCATIVE + JRST WRONGT + MOVE D,B + MOVE A,(TB) + MOVE B,1(TB) ; GET LOCATIVE + POPJ P, + +; FINAL MONITOR SETUP ROUTINES + +S.RMON: SKIPA E,[.RDMON,,] +S.WMON: MOVSI E,.WRMON + PUSH TP,A + PUSH TP,B + HLRM E,INTPRI(B) ; SAVE BITS + MOVEI B,(TB) ; POINT TO LOCATIVE + HRRZ A,FSAV(TB) + CAIN A,OFF + MOVSI D,(ANDCAM E,) ; KILL INST + CAIN A,EVENT + MOVSI D,(IORM E,) + PUSHJ P,SMON ; GO DO IT + POP TP,B + POP TP,A + MOVEI E,0 + POPJ P, + + +; SPECIAL SETUP ROUTINES FOR INITIAL INTERRUPTS + +IFN ITS,[ +S.CHAR: MOVE E,1(TB) ; GET CHANNEL + MOVE 0,RDEVIC(E) + ILDB 0,0 ; 1ST CHAR TO 0 + CAIE 0,"T ; TTY + JRST .+3 ; NO + MOVEI 0,C.INTL + XORM 0,-2(E) ; IN CASE OUTPUT + MOVE E,CHANNO(E) + ADDI E,36. ; GET CORRECT MASK BIT +ONEBIT: MOVEI 0,1 ; BIT FOR INT TO RET + POPJ P, +] +IFE ITS,[ +S.CHAR: MOVE E,1(TB) + MOVEI 0,C.INTL + XORM 0,-2(E) ; IN CASE OUTPUT + MOVE 0,RDEVIC(E) + ILDB 0,0 ; 1ST CHAR + PUSH P,A + CAIE 0,"N ; NET ? + JRST S.CHA1 + + MOVEI A,0 + HRRZ 0,CHANNO(E) + MOVE E,[-NNETS,,NETJFN] + CAMN 0,(E) + JRST S.CHA2 + SKIPN (E) + MOVE A,E ; REMEMBER WHERE + AOBJN E,.-4 + TLNN A,-1 + FATAL NO MORE NETWORK + SKIPA E,A +S.CHA1: MOVEI E,0 +S.CHA2: POP P,A + POPJ P, +] + + +; SPECIAL FOR CLOCK +IFN ITS,[ +S.DOWN: SKIPA E,[7] +S.CLOK: MOVEI E,13. ; FOR NOW JUST GET BIT # + JRST ONEBIT + +S.PAR: MOVEI E,28. + JRST ONEBIT + +; RUNTIME AND REALTIME INTERRUPTS + +S.RUNT: SKIPA E,[34.] +S.REAL: MOVEI E,35. + JRST ONEBIT + +S.IOC: SKIPA E,[9.] ; IO CHANNEL ERROR +S.PURE: MOVEI E,26. + JRST ONEBIT + +; MPV AND ILOPR + +S.MPV: SKIPA E,[14.] ; BIT POS +S.ILOP: MOVEI E,6 + JRST ONEBIT + +; HERE TO TURN ALL INFERIOR INTS + +S.INF: MOVEI E,36.+16.+2 ; START OF BITS + MOVEI 0,37 ; 8 BITS WORTH + POPJ P, +] +IFE ITS,[ +S.PURE: +S.MPV: +S.ILOP: +S.DOWN: +S.CLOK: +S.PAR: + + +S.RUNT: ERRUUO EQUOTE INTERRUPT-UNAVAILABLE-ON-TENEX +S.IOC: MOVEI 0,7 ; 3 BITS FOR EOF/FULL/ERROR + MOVEI E,10. + POPJ P, + +S.INF: +S.REAL: MOVEI E,0 + POPJ P, +] + + +; HERE TO HANDLE ITS INTERRUPTS + +FHAND: SKIPN D,EXTINT(B) ; SKIP IF HANDLERS ARE POSSIBLE + JRST DIRQ + JRST (D) + +IFN ITS,[ +; SPECIAL CHARACTER HANDLERS + +HCHAR: MOVEI D,CHNL0+1 + ADDI D,(B) ; POINT TO CHANNEL SLOT + ADDI D,(B) + SKIPN D,-72.(D) ; PICK UP CHANNEL + JRST IPCGOT ;WELL, IT GOTTA BEE THE THE IPC THEN + PUSH TP,$TCHAN + PUSH TP,D + LDB 0,[600,,STATUS(D)] ; GET DEVICE CODE + CAILE 0,2 ; SKIP IF A TTY + JRST HNET ; MAYBE NETWORK CHANNEL + HRRZ 0,-2(D) + TRNN 0,C.READ + JRST HMORE + CAMN D,TTICHN+1 + SKIPE DEMFLG ; SKIP IF NOT DEMON + JRST .+3 + SKIPN NOTTY + JRST HCHR11 + MOVE B,D ; CHAN TO B + PUSH P,A + PUSHJ P,TTYOP2 ; RE-GOBBLE TTY + POP P,A + MOVE D,(TP) +HCHR11: MOVE D,CHANNO(D) ; GET ITS CHANNEL + PUSH P,D ; AND SAVE IT + .CALL HOWMNY ; GET # OF CHARS + MOVEI B,0 ; IF TTY GONE, NO CHARS +RECHR: ADDI B,1 ; BUMP BY ONE FOR SOSG + MOVEM B,CHNCNT(D) ; AND SAVE + IORM A,PIRQ2 ; LEAVE THE INT ON + +CHRLOO: MOVE D,(P) ; GET CHNNAEL NO. + SOSG CHNCNT(D) ; GET COUNT + JRST CHRDON + + MOVE B,(TP) + MOVE D,BUFRIN(B) ; GET EXTRA BUFFER + XCT IOIN2(D) ; READ CHAR + JUMPL A,CHRDON ; NO CHAR THERE, FORGET IT + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE CHAR + PUSH TP,$TCHRS ; SAVE CHAR FOR CALL + PUSH TP,A + PUSH TP,$TCHAN ; SAVE CHANNEL + PUSH TP,B + PUSHJ P,INCHAR ; PUT CHAR IN USERS BUFFER + MCALL 3,INTERRUPT ; RUN THE HANDLERS + JRST CHRLOO ; AND LOOP + +CHRDON: .CALL HOWMNY + MOVEI B,0 + MOVEI A,1 ; SET FOR PI WORD CLOBBER + LSH A,(D) + JUMPG B,RECHR ; ANY MORE? + ANDCAM A,PIRQ2 + SUB P,[1,,1] + SUB TP,[2,,2] + JRST DIRQ + + + +; HERE FOR NET CHANNEL INTERRUPT + +HNET: CAIE 0,26 ; NETWORK? + JRST HSTYET ; HANDLE PSEUDO TTY ETC. + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TUVEC + PUSH TP,BUFRIN(D) + PUSH TP,$TCHAN + PUSH TP,D + MOVE B,D ; CHAN TO B + PUSHJ P,INSTAT ; UPDATE THE NETWRK STATE + MCALL 3,INTERRUPT + SUB TP,[2,,2] + JRST DIRQ + +HMORE: +HSTYET: PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TCHAN + PUSH TP,D + MCALL 2,INTERRUPT + SUB TP,[2,,2] + JRST DIRQ + +] +CBDCHN: ERRUUO EQUOTE BAD-CHANNEL + +IFN ITS,[ + +HCLOCK: PUSH TP,$TCHSTR + PUSH TP,CHQUOTE CLOCK + MCALL 1,INTERRUPT + JRST DIRQ + +HRUNT: PUSH TP,$TATOM + PUSH TP,MQUOTE RUNT,RUNT,INTRUP + MCALL 1,INTERRUPT + JRST DIRQ +] +HREAL: PUSH TP,$TATOM + PUSH TP,MQUOTE REALT,REALT,INTRUP + MCALL 1,INTERRUPT + JRST DIRQ +IFN ITS,[ +HPAR: MOVE A,MQUOTE PARITY,PARITY,INTRUP + JRST HMPV1 + +HMPV: MOVE A,MQUOTE MPV,MPV,INTRUP + JRST HMPV1 + +HILOPR: MOVE A,MQUOTE ILOPR,ILOPR,INTRUP + JRST HMPV1 + +HPURE: MOVE A,MQUOTE PURE,PURE,INTRUP +HMPV1: PUSH TP,$TATOM + PUSH TP,A + PUSH P,LCKINT ; SAVE LOCN + PUSH TP,$TATOM + PUSH TP,A + PUSH TP,$TWORD + PUSH TP,LCKINT + MCALL 2,EMERGENCY + POP P,A + MOVE C,(TP) + SUB TP,[2,,2] + JUMPN B,DIRQ + + PUSH TP,$TATOM + PUSH TP,EQUOTE DANGEROUS-INTERRUPT-NOT-HANDLED + PUSH TP,$TATOM + PUSH TP,C + PUSH TP,$TWORD + PUSH TP,A + MCALL 3,ERROR + JRST DIRQ + + + +; HERE TO HANDLE SYS DOWN INTERRUPT + +HDOWN: PUSH TP,$TATOM + PUSH TP,MQUOTE SYSDOWN,SYSDOWN,INTRUP + .DIETI A, ; HOW LONG? + PUSH TP,$TFIX + PUSH TP,A + PUSH P,A ; FOR MESSAGE + MCALL 2,INTERRUPT + POP P,A + JUMPN B,DIRQ + .SUSET [.RTTY,,B] ; DO WE NOW HAVE A TTY AT ALL? + JUMPL B,DIRQ ; DONT HANG AROUND + PUSH P,A + MOVEI B,[ASCIZ / +Excuse me, SYSTEM going down in /] + SKIPG (P) ; SKIP IF REALLY GOING DOWN + MOVEI B,[ASCIZ / +Excuse me, SYSTEM has been REVIVED! +/] + PUSHJ P,MSGTYP + POP P,B + JUMPE B,DIRQ + IDIVI B,30. ; TO SECONDS + IDIVI B,60. ; A/ SECONDS B/ MINUTES + JUMPE B,NOMIN + PUSH P,C + PUSHJ P,DECOUT + MOVEI B,[ASCIZ / minutes /] + PUSHJ P,MSGTYP + POP P,B + JRST .+2 +NOMIN: MOVEI B,(C) + PUSHJ P,DECOUT + MOVEI B,[ASCIZ / seconds. +/] + PUSHJ P,MSGTYP + JRST DIRQ + +; TWO DIGIT DEC OUT FROM B/ + +DECOUT: IDIVI B,10. + JUMPE B,DECOU1 ; NO TEN + MOVEI A,60(B) + PUSHJ P,MTYO +DECOU1: MOVEI A,60(C) + JRST MTYO +] + +; HERE TO HANDLE I/O CHANNEL ERRORS + +HIOC: +IFN ITS,[ + .SUSET [.RAPRC,,A] ; CONTAINS CHANNEL OF MOST RECENT LOSSAGE + LDB A,[330400,,A] ; GET CHAN # + MOVEI C,(A) ; COPY +] + PUSH TP,$TATOM ; PUSH ERROR + PUSH TP,EQUOTE FILE-SYSTEM-ERROR +IFE ITS, MOVE C,IOCLOS ; GET JFN + PUSH TP,$TCHAN + ASH C,1 ; GET CHANNEL + ADDI C,CHNL0+1 ; GET CHANNEL VECTOR + PUSH TP,(C) +IFN ITS,[ + LSH A,23. ; DO A .STATUS + IOR A,[.STATUS A] + XCT A +] +IFE ITS,[ + MOVNI A,1 ; GET "MOST RECENT ERROR" +] + MOVE B,(TP) +IFN ITS, PUSHJ P,GFALS ; GEN NAMED FALSE +IFE ITS, PUSHJ P,TGFALS + PUSH TP,A + PUSH TP,B + PUSH TP,$TATOM + PUSH TP,MQUOTE IOC,IOC,INTRUP + + PUSH TP,A + PUSH TP,B + PUSH TP,-7(TP) + PUSH TP,-7(TP) + MCALL 3,EMERGENCY + JUMPN B,DIRQ1 ; JUMP IF HANDLED + MCALL 3,ERROR + JRST DIRQ + +DIRQ1: SUB TP,[6,,6] + JRST DIRQ +] +; HANDLE INFERIOR KNOCKING AT THE DOOR + +HINF: +IFN ITS, SUBI B,36.+16.+2 ; CONVERT TO INF # +IFE ITS, MOVEI B,0 + PUSH TP,$TATOM + PUSH TP,MQUOTE INFERIOR,INFERIOR,INTRUP + PUSH TP,$TFIX + PUSH TP,B + MCALL 2,INTERRUPT + JRST DIRQ + +IFE ITS,[ + +; HERE FOR TENEX INTS (FIRST CUT) + +MFUNCTION %ACCHRS,SUBR,[ACTIVATE-CHARS] + + ENTRY + + JUMPGE AB,RETCHR + CAMGE AB,[-3,,] + JRST TMA + + GETYP A,(AB) + CAIE A,TCHSTR + JRST WTYP1 + HRRZ D,(AB) ; CHECK LENGTH + MOVEI C,0 ; SEE IF ANY NET CHANS IN USE + MOVE A,[-NNETS,,NETJFN] + SKIPE (A) + SUBI C,1 + AOBJN A,.-2 + + CAILE D,NCHRS+NNETS(C) + JRST WTYP1 + + MOVEI 0,(D) ; CHECK THEM + MOVE B,1(AB) + + JUMPE 0,.+4 + ILDB C,B + CAILE C,32 + JRST WTYP1 + SOJG 0,.-3 + + MOVSI E,- ; ZAP CURRENT + HRRZ A,CHRS(E) + DTI + SETZM CHRS(E) + AOBJN E,.-3 + + MOVE A,[-NNETS,,NETJFN] ; IN CASE USED NET INTS FOR CHARS + + SKIPGE (A) + SETZM (A) + AOBJN A,.-2 + + MOVE E,1(AB) + SETZB C,F ; C WILL BE MASK, F OFFSET INTO TABLE + MOVSI 0,400000 ; 0 WILL BE THE BIT FOR INT MASK OR'ING + JUMPE D,ALP1 ; JUMP IF NONE + MOVNS D ; BUILD AOBJN POINTER TO CHRS TABLE + MOVSI D,(D) + MOVEI B,0 ; B COUNTS NUMBER DONE + +ALP: ILDB A,E ; GET CHR + IOR C,0 + LSH 0,-1 + HRROM A,CHRS(D) + MOVSS A + HRRI A,(D) + ADDI A,(F) ; POSSIBLE OFFSET FOR MORE CHANS + ATI + ADDI B,1 + CAIGE B,NCHRS + JRST ALP2 + + SKIPE NETJFN-NCHRS(B) + AOJA B,.-1 + + MOVEI F,36.-NNETS-UINTS-NCHRS(B) + MOVN G,F + MOVSI 0,400000 + LSH 0,(G) ;NEW MASK FOR INT MASKS + SUBI F,1(D) + +ALP2: AOBJN D,ALP + +ALP1: IORM C,MASK1 + MOVEI A,MFORK + MOVE B,MASK1 ; SET UP FOR INT BITS + AIC ; TURN THEM ON + MOVE A,(AB) + MOVE B,1(AB) + JRST FINIS + +RETCHR: MOVE C,[-NCHRS-NNETS,,CHRS] + MOVEI A,0 + +RETCH1: SKIPN D,(C) + JRST RETDON + PUSH TP,$TCHRS + ANDI D,177 + PUSH TP,D + ADDI A,1 + AOBJN C,RETCH1 + +RETDON: PUSHJ P,CISTNG + JRST FINIS + +HCHAR: HRRZ A,CHRS-36.(B) + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TCHRS + PUSH TP,A + PUSH TP,$TCHAN + PUSH TP,TTICHN+1 + MCALL 3,INTERRUPT + JRST DIRQ + +HNET: SKIPLE A,NETJFN-NINT+NNETS+UINTS+1(B) + JRST HNET1 + SUBI B,36.-NNETS-UINTS-NCHRS + JUMPE A,DIRQ + JRST HCHAR +HNET1: ASH A,1 + ADDI A,CHNL0+1 + MOVE B,(A) + PUSH TP,$TATOM + PUSH TP,MQUOTE CHAR,CHAR,INTRUP + PUSH TP,$TUVEC + PUSH TP,BUFRIN(B) + PUSH TP,$TCHAN + PUSH TP,B + PUSHJ P,INSTAT + MCALL 3,INTERRUPT + JRST DIRQ + +USRINT: SUBI B,36. + PUSH TP,$TATOM + PUSH TP,MQUOTE USERINT,USERINT,INTRUP + PUSH TP,$TFIX + PUSH TP,B + MCALL 2,INTERRUPT + JRST DIRQ +] + + +MFUNCTION OFF,SUBR + ENTRY + + JUMPGE AB,TFA + HLRZ 0,AB + GETYP A,(AB) ; ARG TYPE + MOVE B,1(AB) ; AND VALUE + CAIN A,TINTH ; HEADER, GO HACK + JRST OFFHD ; QUEEN OF HEARTS + CAIN A,TATOM + JRST .+3 + CAIE A,TCHSTR + JRST TRYHAN ; MAYBE INDIVIDUAL HANDLER + CAIN 0,-2 ; MORE THAN 1 ARG? + JRST OFFAC1 ; NO, GO ON + CAIG 0,-5 ; CANT BE MORE THAN 2 + JRST TMA + MOVEI B,2(AB) ; POINT TO 2D + PUSHJ P,CHNORL +OFFAC1: MOVEI B,(AB) + PUSHJ P,FNDINT + JUMPGE B,NOHAN1 ; NOT HANDLED + +OFFH1: PUSH P,C ; SAVE C FOR BIT CLOBBER + MOVSI C,TATOM + SKIPN D + MOVE D,MQUOTE INTERRUPT + MOVE A,INAME(B) + MOVE B,INAME+1(B) + PUSHJ P,IREMAS + SKIPE B ; IF NO ASSOC, DONT SMASH + SETOM ISTATE+1(B) ; DISABLE IN CASE QUEUED + POP P,C ; SPECIAL? + JUMPGE C,FINIS ; NO, DONE + + HRRZ C,INTBL(C) ; POINT TO SPECIAL CODE + PUSHJ P,(C) ; GO TO SAME + JUMPE E,OFINIS ; DONE +IFN ITS,[ + CAILE E,35. ; SKIP IF 1ST WORD + JRST CLRW2 ; CLOBBER 2D WORD BIT + LSH 0,-1(E) ; POSITION BIT + ANDCAM 0,MASK1 ; KILL BIT + .SUSET [.SMASK,,MASK1] +] +IFE ITS,[ + MOVE D,B + SETZM (E) + MOVEI E,(E) + SUBI E,NETJFN-NETCHN + MOVEI 0,1 + MOVNS E + LSH 0,35.(E) + ANDCAM 0,MASK1 + MOVEI A,MFORK + SETCM B,MASK1 + DIC + ANDCAM 0,PIRQ ; JUST IN CASE + MOVE B,D +] +OFINIS: MOVSI A,TINTH + JRST FINIS + +IFN ITS,[ +CLRW2: LSH 0,-36.(E) ; POS BIT FOR 2D WORD + ANDCAM 0,MASK2 + .SUSET [.SMSK2,,MASK2] + JRST OFINIS +] + +TRYHAN: CAIE A,THAND ; HANDLER? + JRST WTYP1 + CAIE 0,-2 + JRST TMA + GETYP 0,IPREV(B) ; GET TYPE OF PREV + MOVE A,INXT+1(B) + SKIPN C,IPREV+1(B) ; dont act silly if already off! (TT) + JRST HFINIS + MOVE D,IPREV(B) + CAIE 0,THAND + JRST DOHEAD ; PREV HUST BE HDR + MOVEM A,INXT+1(C) + JRST .+2 +DOHEAD: MOVEM A,IHNDLR+1(C) ; INTO HDR + JUMPE A,OFFINI + MOVEM D,IPREV(A) + MOVEM C,IPREV+1(A) +OFFINI: SETZM IPREV+1(B) ; Leave NXT slot intact for RUNINT (BKD) + MOVSI A,THAND + JRST FINIS + +OFFHD: CAIE 0,-2 + JRST TMA + PUSHJ P,GETNMS ; GET INFOR ABOUT INT + JUMPE C,OFFH1 + PUSH TP,INAME(B) + PUSH TP,INAME+1(B) + JRST OFFH1 + +GETNMS: GETYP A,INAME(B) ; CHECK FOR SPECIAL + SETZB C,D + CAIN A,TCHAN + HRROI C,SS.CHA + PUSHJ P,LOCQ ; LOCATIVE? + JRST CHGTNM + + MOVEI B,INAME(B) ; POINT TO LOCATIVE + MOVSI D,(MOVE E,) + PUSHJ P,SMON ; GET MONITOR + MOVE B,1(AB) +GETNM1: HRROI C,SS.WMO ; ASSUME WRITE + TLNN E,.WRMON + HRROI C,SS.RMO + MOVE D,MQUOTE WRITE,WRITE,INTRUP + TLNN E,.WRMON + MOVE D,MQUOTE READ,READ,INTRUP + POPJ P, + +CHGTNM: JUMPL C,CPOPJ + MOVE B,INAME+1(B) + PUSHJ P,SPEC1 + MOVE B,1(AB) ; RESTORE IHEADER + POPJ P, + +; EMERGENCY, CANT DEFER ME!! + +MQUOTE INTERRUPT + +EMERGENCY: + PUSH P,. + JRST INTERR+1 + +MFUNCTION INTERRUPT,SUBR + + PUSH P,[0] + + ENTRY + + SETZM INTHLD ; RE-ENABLE THE WORLD + JUMPGE AB,TFA + MOVE B,1(AB) ; GET HANDLER/NAME + GETYP A,(AB) ; CAN BE HEADER OR NAME + CAIN A,TINTH ; SKIP IF NOT HEADER + JRST GTHEAD + CAIN A,TATOM + JRST .+3 + CAIE A,TCHSTR ; SKIP IF CHAR STRING + JRST WTYP1 + MOVEI B,(AB) ; LOOK UP NAME + PUSHJ P,FNDNM ; GET NAME + JUMPE B,IFALSE + MOVEI D,0 + CAMN B,MQUOTE CHAR,CHAR,INTRUP + PUSHJ P,CHNGT1 + CAME B,MQUOTE READ,READ,INTRUP + CAMN B,MQUOTE WRITE,WRITE,INTRUP + PUSHJ P,GTLOC1 + PUSHJ P,INTASO + JUMPE B,IFALSE + +GTHEAD: SKIPE ISTATE+1(B) ; ENABLED? + JRST IFALSE ; IGNORE COMPLETELY + MOVE A,INTPRI+1(B) ; GET PRIORITY OF INTERRUPT + CAMLE A,CURPRI ; SEE IF MUST QUEU + JRST SETPRI ; MAY RUN NOW + SKIPE (P) ; SKIP IF DEFER OK + JRST DEFERR + MOVEM A,(P) + PUSH TP,$TINTH ; SAVE HEADER + PUSH TP,B + MOVEI A,1 ; SAVE OTHER ARGS +PSHARG: ADD AB,[2,,2] + JUMPGE AB,QUEU1 ; GO MAKE QUEU ENTRY + PUSH TP,(AB) + PUSH TP,1(AB) + AOJA A,PSHARG +QUEU1: PUSHJ P,IEVECT ; GET VECTOR + PUSH TP,$TVEC + PUSH TP,[0] ; WILL HOLD QUEUE HEADER + PUSH TP,A + PUSH TP,B + + POP P,A ; RESTORE PRIORITY + + MOVE B,QUEUES+1 ; GET INTERRUPT QUEUES + MOVEI D,0 + JUMPGE B,GQUEU ; MAKE A QUEUE HDR + +NXTQU: CAMN A,1(B) ; GOT PRIORITY? + JRST ADDQU ; YES, ADD TO THE QUEU + CAML A,1(B) ; SKIP IF SPOT NOT FOUND + JRST GQUEU + MOVE D,B + MOVE B,3(B) ; GO TO NXT QUEUE + JUMPL B,NXTQU + +GQUEU: PUSH TP,$TVEC ; SAVE NEXT POINTER + PUSH TP,D + PUSH TP,$TFIX + PUSH TP,A ; SAVE PRIORITY + PUSH TP,$TVEC + PUSH TP,B + PUSH TP,$TLIST + PUSH TP,[0] + PUSH TP,$TLIST + PUSH TP,[0] + MOVEI A,4 + PUSHJ P,IEVECT + MOVE D,(TP) ; NOW SPLICE + SUB TP,[2,,2] + JUMPN D,GQUEU1 + MOVEM B,QUEUES+1 + JRST .+2 +GQUEU1: MOVEM B,3(D) + +ADDQU: MOVEM B,-2(TP) ; SAVE QUEU HDR + POP TP,D + POP TP,C + PUSHJ P,INCONS ; CONS IT + MOVE C,(TP) ;GET QUEUE HEADER + SKIPE D,7(C) ; IF END EXISTS + HRRM B,(D) ; SPLICE + MOVEM B,7(C) + SKIPN 5(C) ; SKIP IF START EXISTS + MOVEM B,5(C) + +IFINI: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +SETPRI: EXCH A,CURPRI + MOVEM A,(P) + + PUSH TP,$TAB ; PASS AB TO HANDLERS + PUSH TP,AB + + PUSHJ P,RUNINT ; RUN THE HANDLERS + POP P,A ; UNQUEU ANY WAITERS + PUSHJ P,UNQUEU + + JRST IFINI + +; HERE TO UNQUEUE WAITING INTERRUPTS + +UNQUEU: PUSH P,A ; SAVE NEW LEVEL + +UNQUE1: MOVE A,(P) ; TARGET LEVEL + CAMLE A,CURPRI ; CHECK RUG NOT PULLED OUT + JRST UNDONE + SKIPE B,QUEUES+1 + CAML A,1(B) ; RIGHT LEVEL? + JRST UNDONE ; FINISHED + + SKIPN C,5(B) ; ON QUEUEU? + JRST UNXQ + HRRZ D,(C) ; CDR THE LIST + MOVEM D,5(B) + SKIPN D ; SKIP IF NOT LAST + SETZM 7(B) ; CLOBBER END POINTER + MOVE A,1(B) ; GET THIS PRIORITY LEVEL + MOVEM A,CURPRI ; MAKE IT THE CURRENT ONE + MOVE D,1(C) ; GET SAVED VECTOR OF INF + + MOVE B,1(D) ; INT HEADER + PUSH TP,$TVEC + PUSH TP,D ; AND ARGS + + PUSHJ P,RUNINT ; RUN THEM + JRST UNQUE1 + +UNDONE: POP P,CURPRI ; SET CURRENT LEVEL + MOVE A,CURPRI + POPJ P, + +UNXQ: MOVE B,3(B) ; GO TO NEXT QUEUE + MOVEM B,QUEUES+1 + JRST UNQUE1 + + + +; SUBR TO CHANGE INTERRUPT LEVEL + +MFUNCTION INTLEV,SUBR,[INT-LEVEL] + ENTRY + JUMPGE AB,RETLEV ; JUST RETURN CURRENT + GETYP A,(AB) + CAIE A,TFIX + JRST WTYP1 ; LEVEL IS FIXED + SKIPGE A,1(AB) + JRST OUTRNG" + CAMN A,CURPRI ; DIFFERENT? + JRST RETLEV ; NO RETURN + PUSH P,CURPRI + CAMG A,CURPRI ; SKIP IF NO UNQUEUE NEEDED + PUSHJ P,UNQUEU + MOVEM A,CURPRI ; SAVE + POP P,A + SKIPA B,A +RETLEV: MOVE B,CURPRI + MOVSI A,TFIX + JRST FINIS + +RUNINT: PUSH TP,$THAND ; SAVE HANDLERS LIST + PUSH TP,IHNDLR+1(B) + + SKIPN ISTATE+1(B) ; SKIP IF DISABLED + SKIPN B,(TP) + JRST SUBTP4 +NXHND: MOVEM B,(TP) ; SAVE CURRENT HDR + MOVE A,-2(TP) ; SAVE ARG POINTER + PUSHJ P,CHSWAP ; SEE IF MUST SWAP + PUSH TP,[0] + PUSH TP,[0] + MOVEI C,1 ; COUNT ARGS + PUSH TP,SPSTOR ; SAVE INITIAL BINDING POINTER + PUSH TP,SPSTOR+1 + MOVE D,PVSTOR+1 + ADD D,[1STEPR,,1STEPR] + PUSH TP,BNDV + PUSH TP,D + PUSH TP,$TPVP + PUSH TP,[0] + MOVE E,TP +NBIND: PUSH TP,INTFCN(B) + PUSH TP,INTFCN+1(B) + ADD A,[2,,2] + JUMPGE A,DO.HND + PUSH TP,(A) + PUSH TP,1(A) + AOJA C,.-4 +DO.HND: MOVE PVP,PVSTOR+1 + SKIPN 1STEPR+1(PVP) ; NECESSARY TO DO 1STEP BINDING ? + JRST NBIND1 ; NO, DON'T BOTHER + PUSH P,C + PUSHJ P,SPECBE ; BIND 1 STEP FLAG + POP P,C +NBIND1: ACALL C,INTAPL ; RUN HAND WITH POSSIBLY BOUND 1STEP FLAG + MOVE SP,SPSTOR+1 ; GET CURRENT BINDING POINTER + CAMN SP,-4(TP) ; SAME AS SAVED BINDING POINTER ? + JRST NBIND2 ; YES, 1STEP FLAG NOT BOUND + MOVE C,(TP) ; RESET 1 STEP + MOVE PVP,PVSTOR+1 + MOVEM C,1STEPR+1(PVP) + MOVE SP,-4(TP) ; RESTORE SAVED BINDING POINTER + MOVEM SP,SPSTOR+1 +NBIND2: SUB TP,[6,,6] + PUSHJ P,CHUNSW + CAMN E,PVSTOR+1 + SUB TP,[4,,4] ; NO PROCESS CHANGE, POP JUNK + CAMN E,PVSTOR+1 + JRST .+4 + MOVE D,TPSTO+1(E) + SUB D,[4,,4] + MOVEM D,TPSTO+1(E) ; FIXUP HIS STACK +DO.H1: GETYP A,A ; CHECK FOR A DISMISS + CAIN A,TDISMI + JRST SUBTP4 + MOVE B,(TP) ; TRY FOR NEXT HANDLER + SKIPE B,INXT+1(B) + JRST NXHND +SUBTP4: SUB TP,[4,,4] + POPJ P, + +MFUNCTION INTAPL,SUBR,[RUNINT] + JRST APPLY + + +NOHAND: JUMPE C,NOHAN1 + PUSH TP,$TATOM + PUSH TP,EQUOTE INTERNAL-INTERRUPT +NOHAN1: PUSH TP,(AB) + PUSH TP,1(AB) + PUSH TP,$TATOM + PUSH TP,EQUOTE NOT-HANDLED + SKIPE A,C + MOVEI A,1 + ADDI A,2 + JRST CALER + +DEFERR: PUSH TP,$TATOM + PUSH TP,EQUOTE ATTEMPT-TO-DEFER-UNDEFERABLE-INTERRUPT + PUSH TP,$TINTH + PUSH TP,B + PUSH TP,$TATOM + PUSH TP,MQUOTE INTERRUPT + MCALL 3,RERR ; FORCE REAL ERROR + JRST FINIS + +; FUNCTION TO DISMISS AN INTERRUPT TO AN ARBITRARY ACTIVATION + +MFUNCTION DISMISS,SUBR + + HLRZ 0,AB + JUMPGE AB,TFA + CAIGE 0,-6 + JRST TMA + MOVNI D,1 + CAIE 0,-6 + JRST DISMI3 + GETYP 0,4(AB) + CAIE 0,TFIX + JRST WTYP + SKIPGE D,5(AB) + JRST OUTRNG + +DISMI3: MOVEI A,(TB) + +DISMI0: HRRZ B,FSAV(A) + HRRZ C,PCSAV(A) + CAIE B,INTAPL + JRST DISMI1 + + MOVE E,OTBSAV(A) + MOVEI 0,(A) ; SAVE FRAME + MOVEI A,DISMI2 + HRRM A,PCSAV(E) ; GET IT BACK HERE + MOVE A,(AB) + MOVE B,1(AB) + MOVE C,TPSAV(E) + MOVEM A,-7(C) + MOVEM B,-6(C) + MOVEI C,0 + CAMGE AB,[-3,,] + MOVEI C,2(AB) + MOVE B,0 ; DEST FRAME + JUMPL D,.+3 + MOVE A,PSAV(E) ; NOW MUNG SAVED INT LEVEL + MOVEM D,-1(A) ; ZAP YOUR MUNGED + PUSHJ P,CHUNW ; CHECK ON UNWINDERS + JRST FINIS ; FALL DOWN + +DISMI1: MOVEI E,(A) + HRRZ A,OTBSAV(A) + JUMPN A,DISMI0 + + MOVE A,(AB) + MOVE B,1(AB) + + PUSH TP,A + PUSH TP,B + SKIPGE A,D + JRST .+4 + CAMG A,CURPRI + PUSHJ P,UNQUEU + MOVEM A,CURPRI + CAML AB,[-3,,] + JRST .+5 + PUSH TP,2(AB) + PUSH TP,3(AB) + MCALL 2,ERRET + JRST FINIS + + POP TP,B + POP TP,A + JRST FINIS + +DISMI2: CAMN SP,-4(TP) ; 1STEP FLAG BEEN BOUND ? + JRST NDISMI ; NO + MOVE C,(TP) + MOVE PVP,PVSTOR+1 + MOVEM C,1STEPR+1(PVP) + MOVE SP,-4(TP) +NDISMI: SUB TP,[6,,6] + PUSHJ P,CHUNSW ; UNDO ANY PROCESS HACKING + MOVE C,TP + CAME E,PVSTOR+1 ; SWAPED? + MOVE C,TPSTO+1(E) + MOVE D,-1(C) + MOVE 0,(C) + SUB TP,[4,,4] + SUB C,[4,,4] ; MAYBE FIXUP OTHER STACK + CAME E,PVSTOR+1 + MOVEM C,TPSTO+1(E) + PUSH TP,D + PUSH TP,0 + PUSH TP,A + PUSH TP,B + MOVE A,-1(P) ; SAVED PRIORITY + CAMG A,CURPRI + PUSHJ P,UNQUEU + MOVEM A,CURPRI + SKIPN -1(TP) + JRST .+3 + MCALL 2,ERRET + JRST FINIS + + SUB TP,[4,,4] + MOVSI A,TDISMI + MOVE B,IMQUOTE T + JRST DO.H1 + +CHNGT1: HLRE B,AB + SUBM AB,B + GETYP 0,-2(B) + CAIE 0,TCHAN + JRST WTYP3 + MOVE B,-1(B) + MOVSI A,TCHAN + POPJ P, + +GTLOC1: GETYP A,2(AB) + PUSHJ P,LOCQ + JRST WTYP2 + MOVE D,B ; RET ATOM FOR ASSOC + MOVE A,2(AB) + MOVE B,3(AB) + POPJ P, + ; MONITOR CHECKERS + +MONCH0: HLLZ 0,(B) ; POTENTIAL MONITORS +MONCH: TLZ 0,TYPMSK ; KILL TYPE + IOR C,0 ; IN NEW TYPE + PUSH P,0 + MOVEI 0,(B) + CAIL 0,HIBOT + JRST PURERR + POP P,0 + TLNN 0,.WRMON ; SKIP IF WRITE MONIT + POPJ P, + +; MONITOR IS ON, INVOKE HANDLER + + PUSH TP,A ; SAVE OBJ + PUSH TP,B + PUSH TP,C + PUSH TP,D ; SAVE DATUM + MOVSI C,TATOM ; PREPARE TO FIND IT + MOVE D,MQUOTE WRITE,WRITE,INTRUP + PUSHJ P,IGET + JUMPE B,MONCH1 ; NOT FOUND IGNORE FOR NOW + PUSH TP,A ; START SETTING UP CALL + PUSH TP,B + PUSH TP,-5(TP) + PUSH TP,-5(TP) + PUSH TP,-5(TP) + PUSH TP,-5(TP) + PUSHJ P,FRMSTK ; PUT FRAME ON STAKC + MCALL 4,EMERGE ; DO IT +MONCH1: POP TP,D + POP TP,C + POP TP,B + POP TP,A + HLLZ 0,(B) ; UPDATE MONITORS + TLZ 0,TYPMSK + IOR C,0 + POPJ P, + +; NOW FOR READ MONITORS + +RMONC0: HLLZ 0,(B) +RMONCH: TLNN 0,.RDMON + POPJ P, + PUSH TP,A + PUSH TP,B + MOVSI C,TATOM + MOVE D,MQUOTE READ,READ,INTRUP + PUSHJ P,IGET + JUMPE B,RMONC1 + PUSH TP,A + PUSH TP,B + PUSH TP,-3(TP) + PUSH TP,-3(TP) + PUSHJ P,FRMSTK ; PUT FRAME ON STACK + MCALL 3,EMERGE +RMONC1: POP TP,B + POP TP,A + POPJ P, + +; PUT THE CURRENT FRAME ON THE STACK + +FRMSTK: PUSHJ P,MAKACT + HRLI A,TFRAME + PUSH TP,A + PUSH TP,B + POPJ P, + +; HERE TO COMPLAIN ABOUT ATTEMPTS TO MUNG PURE CODE + +PURERR: PUSH TP,$TATOM + PUSH TP,EQUOTE ATTEMPT-TO-MUNG-PURE-STRUCTURE + PUSH TP,A + PUSH TP,B + MOVEI A,2 + JRST CALER + +; PROCESS SWAPPING CODE + +CHSWAP: MOVE E,PVSTOR+1 ; GET CURRENT + POP P,0 + SKIPE D,INTPRO+1(B) ; SKIP IF NO PROCESS GIVEN + CAMN D,PVSTOR+1 ; SKIP IF DIFFERENT + JRST PSHPRO + + PUSHJ P,SWAPIT ; DO SWAP + +PSHPRO: PUSH TP,$TPVP + PUSH TP,E + JRST @0 + +CHUNSW: MOVE E,PVSTOR+1 ; RET OLD PROC + MOVE D,-2(TP) ; GET SAVED PROC + CAMN D,PVSTOR+1 ; SWAPPED? + POPJ P, + +SWAPIT: PUSH P,0 + MOVE 0,PSTAT+1(D) ; CHECK STATE + CAIE 0,RESMBL + JRST NOTRES + MOVE PVP,PVSTOR+1 + MOVEM 0,PSTAT+1(PVP) + MOVEI 0,RUNING + MOVEM 0,PSTAT+1(D) ; SAVE NEW STATE + POP P,0 + POP P,C + JRST SWAP" + + +;SUBROUTINE TO GET BIT FOR CLOBBERAGE + +GETBIT: MOVNS B ;NEGATE + MOVSI A,400000 ;GET THE BIT + LSH A,(B) ;SHIFT TO POSITION + POPJ P, ;AND RETURN + +; HERE TO HANDLE PURE WRITE AND CHECK FOR POSSIBLE C/W + +IFN ITS,[ +GCPWRT: SKIPN GCDFLG ; SEE IF IN DUMPER OR PURIFYER + SKIPE NPWRIT + JRST .+3 + MOVEI B,4 ; INDICATE PURE WRITE + JRST NOPUGC ; CONTINUE + TLZ A,200 + MOVEM A,TSINT ; SVE A + MOVE A,TSAVA + SOS TSINTR + .SUSET [.RMPVA,,A] + CAML A,RPURBT ; SKIP IF NOT PURE + CAIL A,HIBOT ; DONT MARK IF TOUCHING INTERPRETER + SKIPA + SETOM PURMNG ; MUNGING PURENESS INDICATE + MOVE B,BUFGC ; GET BUFFER + JUMPL B,GCPW1 ; JUMP IF WINDOW IS BUFFER + EXCH P,GCPDL + PUSHJ P,%CWINF ; GO DO COPY/WRITE +GCPW2: EXCH P,GCPDL + MOVE A,TSINT ; RESTORE A + JRST 2NDWORD ; CONTINUE +GCPW1: EXCH P,GCPDL + MOVEI B,WIND ; START OF BUFFER + PUSHJ P,%CWINF ; C/W + MOVEI B,WNDP ; RESTORE WINDOW + MOVE A,WNDBOT ; BOTTOM OF WINDOW + ASH A,-10. ; TO PAGES + SKIPE A + PUSHJ P,%SHWND ; SHARE IT + JRST GCPW2 +] +IFE ITS,[ + +; HERE TO HANDLE BUFFERING FOR GC-DUMP AND PURIFY FOR TENEX + +PWRIT: SKIPN GCDFLG ; SEE IF IN DUMPER OR PURIFYER + SKIPE GPURFL + SKIPA + FATAL IMW + EXCH P,GCPDL ; GET A GOOD PDL + MOVEM A,TSAVA ; SAVE AC'S + MOVEM B,TSAVB + MOVEI A,MFORK ; FOR TWENEX THIS IS A MOVEI + SKIPE OPSYS ; SKIP IF TOPS20 + MOVSI A,MFORK ; FOR A TENEX IT SHOULD BE A MOVSI + GTRPW ; GET TRAP WORDS + PUSH P,A ; SAVE ADDRESS AND WORD + PUSH P,B + ANDI A,-1 + CAML A,RPURBT ; SKIP IF NOT PURE + CAIL A,HIBOT ; DONT MARK IF TOUCHING INTERPRETER + SKIPA + SETOM PURMNG ; MUNGING PURENESS INDICATE + MOVE B,BUFGC ; GET BUFFER + ANDCMI A,1777 ; TO PAGE BOUNDRY + JUMPL B,PWRIT2 ; USE WINDOW AS BUFFER +PWRIT3: PUSHJ P,%CWINF ; FIX UP +PWRIT4: POP P,B ; RESTORE AC'S + POP P,A + TLNN A,10 ; SEE IF R/W CYCLE + MOVEM B,(A) ; FINISH WRITE + EXCH P,GCPDL + JRST INTDON +PWRIT2: MOVEI B,WIND + PUSHJ P,%CWINF ; GO TRY TO WIN + MOVEI B,WNDP + MOVE A,WNDBOT ; BOTTOM OF WINDOW + ASH A,-10. ; TO PAGES + SKIPE A + PUSHJ P,%SHWND ; SHARE IT + JRST PWRIT4 +] + +;HERE TO HANDLE PDL OVERFLOW. ASK FOR A GC + +IPDLOV: +IFN ITS,[ + MOVEM A,TSINT ;SAVE INT WORD +] + + SKIPE GCFLG ;IS GC RUNNING? + JRST GCPLOV ;YES, COMPLAIN GROSSLY + + MOVEI A,200000 ;GET BIT TO CLOBBER + IORM A,PIRQ ;LEAVE A MESSAGE FOR HIGHER LEVEL + + EXCH P,GCPDL ;GET A WINNING PDL + HRRZ B,TSINTR ;GET POINTER TO LOSING INSTRUCTION +IFE ITS,[ + SKIPE MULTSG + MOVE B,TSINTR+1 +] + SKIPG GCPDL ; SKIP IF NOT P + LDB B,[270400,,-1(B)] ;GET AC FIELD + SKIPL GCPDL ; SKIP IF P + MOVEI B,P + MOVEI A,(B) ;COPY IT + LSH A,1 ;TIMES 2 + EXCH PVP,PVSTOR+1 + ADDI A,0STO(PVP) ;POINT TO THIS ACS CURRENT TYPE + EXCH PVP,PVSTOR+1 + HLRZ A,(A) ;GET THAT TYPE INTO A + CAIN B,P ;IS IT P + MOVEI B,GCPDL ;POINT TO SAVED P + + CAIN B,B ;OR IS IT B ITSELF + MOVEI B,TSAVB + CAIN B,A ;OR A + MOVEI B,TSAVA + + CAIN B,C ;OR C + MOVEI B,1(P) ;C WILL BE ON THE STACK + + PUSH P,C + PUSH P,A + + MOVE A,(B) ;GET THE LOSING POINTER + MOVEI C,(A) ;AND ISOLATE RH + + CAMG C,VECTOP ;CHECK IF IN GC SPACE + CAMG C,VECBOT + JRST NOGROW ;NO, COMPLAIN + +; FALL THROUGH + + + HLRZ C,A ;GET -LENGTH + SUBI A,-1(C) ;POINT TO A DOPE WORD + POP P,C ;RESTORE TYPE INTO C + PUSH P,D ; SAVE FOR GROWTH HACKER + MOVEI D,0 + CAIN C,TPDL ; POINT TD TO APPROPRIATE DOPE WORD + MOVEI D,PGROW + CAIN C,TTP + MOVEI D,TPGROW + JUMPE D,BADPDL ; IF D STILL 0, THIS PDL IS WEIRD + MOVEI A,PDLBUF(A) ; POINT TO ALLEGED REAL DOPE WORD + SKIPN (D) ; SKIP IF PREVIOUSLY BLOWN + MOVEM A,(D) ; CLOBBER IN + CAME A,(D) ; MAKE SURE IT IS THE SAME + JRST PDLOSS + POP P,D ; RESTORE D + + +PNTRHK: MOVE C,(B) ;RESTORE PDL POINTER + SUB C,[PDLBUF,,0] ;FUDGE THE POINTER + MOVEM C,(B) ;AND STORE IT + + POP P,C ;RESTORE THE WORLD + EXCH P,GCPDL ;GET BACK ORIG PDL +IFN ITS,[ + MOVE A,TSINT ;RESTORE INT WORD + + JRST IMPCH ;LOOK FOR MORE INTERRUPTS +] +IFE ITS, JRST GCQUIT + +TPOVFL: SETOM INTFLG ;SIMULATE PDL OVFL + PUSH P,A + MOVEI A,200000 ;TURN ON THE BIT + IORM A,PIRQ + HLRE A,TP ;FIND DOPEW + SUBM TP,A ;POINT TO DOPE WORD + MOVEI A,PDLBUF+1(A) ; ZERO LH AND POINT TO DOPEWD + SKIPN TPGROW + HRRZM A,TPGROW + CAME A,TPGROW ; MAKE SURE WINNAGE + JRST PDLOS1 + SUB TP,[PDLBUF,,0] ; HACK STACK POINTER + POP P,A + POPJ P, + + +; GROW CORE IF PDL OVERFLOW DURING GC + +GCPLOV: EXCH P,GCPDL ; NEED A PDL TO CALL P.CORE + PUSHJ P,GPDLOV ; HANDLE PDL OVERFLOW + EXCH P,GCPDL + PUSHJ P,%FDBUF +IFE ITS,[ + JRST GCQUIT +] +IFN ITS,[ + MOVE A,TSINT + JRST IMPCH + +] + +IFN ITS,[ + +;HERE TO HANDLE LOW-LEVEL CHANNELS + + +CHNACT: SKIPN GCFLG ;GET A WINNING PDL + EXCH P,GCPDL + ANDI A,177777 ;ISOLATE CHANNEL BITS + PUSH P,0 ;SAVE + +CHNA1: MOVEI B,0 ;BIT COUNTER + JFFO A,.+2 ;COUNT + JRST CHNA2 + SUBI B,35. ;NOW HAVE CHANNEL + MOVMS B ;PLUS IT + MOVEI 0,1 + LSH 0,(B) + ANDCM A,0 + MOVEI 0,(B) ; COPY TO 0 + LSH 0,23. ;POSITION FOR A .STATUS + IOR 0,[.STATUS 0] + XCT 0 ;DO IT + ANDI 0,77 ;ISOLATE DEVICE + CAILE 0,2 + JRST CHNA1 + +PMIN4: MOVE 0,B ; CHAN TO 0 + .ITYIC 0, ; INTO 0 + JRST .+2 ; DONE, GO ON + JRST PMIN4 + SETZM GCFLCH ; LEAVE GC MODE + JRST CHNA1 + +CHNA2: POP P,0 + SKIPN GCFLG + EXCH P,GCPDL + JRST GCQUIT + +HOWMNY: SETZ + SIXBIT /LISTEN/ + D + 402000,,B +] + +MFUNCTION GASCII,SUBR,ASCII + ENTRY 1 + + GETYP A,(AB) + CAIE A,TCHRS + JRST TRYNUM + + MOVE B,1(AB) + MOVSI A,TFIX + JRST FINIS + +TRYNUM: CAIE A,TFIX + JRST WTYP1 + SKIPGE B,1(AB) ;GET NUMBER + JRST TOOBIG + CAILE B,177 ;CHECK RANGE + JRST TOOBIG + MOVSI A,TCHRS + JRST FINIS + +TOOBIG: ERRUUO EQUOTE ARGUMENT-OUT-OF-RANGE + + +;HERE IF PDL OVERFLOW DURING GARBAGE COLLECTION + +BADPDL: FATAL NON PDL OVERFLOW + +NOGROW: FATAL PDL OVERFLOW ON NON EXPANDABLE PDL + +PDLOS1: MOVEI D,TPGROW +PDLOSS: MOVSI A,(GENERAL) ; FIX UP TP DOPE WORD JUST IN CASE + HRRZ D,(D) ; POINT TO POSSIBLE LOSING D.W. + SKIPN TPGROW + JRST PDLOS2 + MOVEM A,-1(D) + MOVEI A,(TP) ; SEE IF REL STACK SIZE WINS + SUBI A,(TB) + TRNN A,1 + SUB TP,[1,,1] +PDLOS2: MOVSI A,.VECT. + SKIPE PGROW + MOVEM A,-1(D) + SUB P,[2,,2] ; TRY TO RECOVER GRACEFULLY + EXCH P,GCPDL + MOVEI A,DOAGC ; SET UP TO IMMEDIATE GC +IFN ITS,[ + HRRM A,TSINTR +] +IFE ITS,[ + SKIPE MULTSG + HRRM A,TSINTR+1 + SKIPN MULTSG + HRRM A,TSINTR +] +IFN ITS, .DISMIS TSINTR +IFE ITS, DEBRK + +DOAGC: SKIPE PGROW + SUB P,[2,,2] ; ALLOW ROOM FOR CALL + JSP E,PDL3 ; CLEANUP + ERRUUO EQUOTE PDL-OVERFLOW-BUFFER-EXHAUSTED + + +DLOSER: PUSH P,LOSRS(B) + MOVE A,TSAVA + MOVE B,TSAVB + POPJ P, + +LOSRS: IMPV + ILOPR + IOC + IPURE + + +;MEMORY PROTECTION INTERRUPT + +IOC: FATAL IO CHANNEL ERROR IN GARBAGE COLLECTOR +IMPV: FATAL MPV IN GARBAGE COLLECTOR + +IPURE: FATAL PURE WRITE IN GARBAGE COLLECTOR +ILOPR: FATAL ILLEGAL OPEREATION IN GARBAGE COLLECTOR + +IFN ITS,[ + +;SUBROUTINE TO BE CALLED AT INITIALIZE TIME TO SETUP INTS + +INTINT: SETZM CHNCNT + MOVE A,[CHNCNT,,CHNCNT+1] + BLT A,CHNCNT+16. + SETZM INTFLG + .SUSET [.SPICLR,,[-1]] + MOVE A,MASK1 ;SET MASKS + MOVE B,MASK2 + .SETM2 A, ;SET BOTH MASKS + MOVSI A,TVEC + MOVEM A,QUEUES + SETZM QUEUES+1 ;UNQUEUE ANY OLD INTERRUPTS + SETZM CURPRI + POPJ P, +] +IFE ITS,[ + +; INITIALIZE TENEX INTERRUPT SYSTEM + +INTINT: CIS ; CLEAR THE INT WORLD + SETZM INTFLG ; IN CASE RESTART + MOVSI A,TVEC ; FIXUP QUEUES + MOVEM A,QUEUES + SETZM QUEUES+1 + SETZM CURPRI ; AND PRIORITY LEVEL + MOVEI A,MFORK ; TURN ON MY INTERRUPTS + SKIPN MULTSG + JRST INTINM + PUSHJ P,@[DOSIR] ; HACK TO TEMP GET TO SEGMENT 0 + JRST INTINX + +INTINM: MOVE B,[-36.,,CHNTAB] + MOVSI 0,1 + HLLM 0,(B) + AOBJN B,.-1 + + MOVE B,[LEVTAB,,CHNTAB] ; POINT TO TABLES + SIR ; TELL SYSTEM ABOUT THEM + +INTINX: MOVSI D,-NCHRS + MOVEI 0,40 + MOVEI C,0 + +INTILP: SKIPN A,CHRS(D) + JRST ITTIL1 + IOR C,0 + MOVSS A + HRRI A,(D) + ATI +ITTIL1: LSH 0,-1 + AOBJN D,INTILP + + DPB C,[360600,,MASK1] + MOVE B,MASK1 ; SET UP FOR INT BITS + MOVEI A,MFORK + AIC ; TURN THEM ON + MOVEI A,MFORK ; DO THE ENABLE + EIR + POPJ P, + + +DOSIR: MOVE B,[-36.,,CHNTAB] + MOVSI 0,<1_12.>+FSEG + HLLM 0,(B) + AOBJN B,.-1 + + MOVEI B,..ARGB ; WILL RUN IN SEGMENT 0 +RMT [ +..ARGB: 3 + LEVTAB + CHNTAB +] + XSIR + POP P,D + HRLI D,FSEG + XJRST C ; GET BACK TO CALLING SEGMENT +] + + +; CNTL-G HANDLER + +MFUNCTION QUITTER,SUBR + + ENTRY 2 + GETYP A,(AB) + CAIE A,TCHRS + JRST WTYP1 + GETYP A,2(AB) + CAIE A,TCHAN + JRST WTYP2 + MOVE B,1(AB) + MOVE A,(AB) +IFE ITS, CAIE ^O + CAIN B,^S ; HANDLE CNTL-S + JRST RETLIS + CAIE B,7 + JRST FINIS + + PUSHJ P,CLEAN ; CLEAN UP I/O CHANNELS + PUSH TP,$TATOM + PUSH TP,EQUOTE CONTROL-G? + MCALL 1,ERROR + JRST FINIS + +RETLIS: MOVE B,IMQUOTE LER,[LERR ]INTRUP + PUSHJ P,ILVAL ; GET CURRENT VALUE + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + PUSHJ P,CHFSWP + SUB TP,[2,,2] + MOVEI D,(TB) ; FIND A LISTEN OR ERROR TO RET TO + +RETLI1: HRRZ A,OTBSAV(D) + CAIN A,(B) ; CHECK FOR WINNER + JRST FNDHIM + HRRZ C,FSAV(A) ; CHECK FUNCTION + CAIE C,LISTEN + CAIN C,ERROR ; FOUND? + JRST FNDHIM ; YES, GO TO SAME + CAIN C,ERROR% ; FUNNY ERROR + JRST FNDHIM + CAIN C,TOPLEV ; NO ERROR/LISTEN + JRST FINIS + MOVEI D,(A) + JRST RETLI1 + +FNDHIM: PUSH TP,$TTB + PUSH TP,D + PUSHJ P,CLEAN + MOVE B,(TP) ; NEW FRAME + SUB TP,[2,,2] + MOVEI C,0 + PUSHJ P,CHUNW ; UNWIND? + MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +CLEAN: MOVE B,3(AB) ; GET IN CHAN + PUSHJ P,RRESET + MOVE B,3(AB) ; CHANNEL BAKC + MOVE C,BUFRIN(B) + SKIPN C,ECHO(C) ; GET ECHO + JRST CLUNQ +IFN ITS,[ + MOVEI A,2 + CAMN C,[PUSHJ P,MTYO] + JRST TYONUM + LDB A,[270400,,C] +TYONUM: LSH A,23. + IOR A,[.RESET] + XCT A +] +IFE ITS,[ + MOVEI A,101 ; OUTPUT JFN + CFOBF +] + +CLUNQ: SETZB A,CURPRI + JRST UNQUEU + + +IMPURE +ONINT: 0 ; INT FUDGER +INTBCK: 0 ; GO BACK TO THIS PC AFTER INTERRUPT + MOVEM TP,TPSAV(TB) ; SAVE STUFF + MOVEM P,PSAV(TB) +INTBEN: SKIPL INTFLG ; PENDING INTS? + JRST @INTBCK + PUSH P,A + SOS A,INTBCK + SETZM INTBCK + MOVEM A,LCKINT + POP P,A + JRST LCKINT+1 + + +IFN ITS,[ +;RANDOM IMPURE CRUFT NEEDED +CHNCNT: BLOCK 16. ; # OF CHARS IN EACH CHANNEL + +TSAVA: 0 +TSAVB: 0 +PIRQ: 0 ;HOLDS REQUEST BITS FOR 1ST WORD +PIRQ2: 0 ;SAME FOR WORD 2 +PCOFF: 0 +MASK1: 200,,200100 ;FIRST MASK +MASK2: 0 ;SECOND THEREOF +CURPRI: 0 ; CURRENT PRIORITY +RLTSAV: 0 +] +IFE ITS,[ +CHRS: 7 ; CNTL-G + 23 ; CNTL-O + 17 ; CNTL-S + BLOCK NCHRS-3 + +NETJFN: BLOCK NNETS +MASK1: CHNMSK +RLTSAV: 0 +TSINTR: +P1: 0 + 0 ; PC INT LEVEL 1 (1ST WORD IN 1 SEG MODE, 2D + ; IN MULTI SEG MODE) +P2: 0 + 0 ; PC INT LEVEL 2 +P3: 0 + 0 ; PC INT LEVEL 3 +CURPRI: 0 +TSAVA: 0 +TSAVB: 0 +PIRQ: 0 +PIRQ2: 0 +IOCLOS: 0 ; HOLDS LOSING JFN IN TNX IOC +] +PURE + +END + \ No newline at end of file diff --git a//ipc.bin.2 b//ipc.bin.2 new file mode 100644 index 0000000000000000000000000000000000000000..f5a7413324e6e7e2d52ab21249182d56be6fe356 GIT binary patch literal 16110 zcmdU030o6OuZrcTP=`Nx0xu ze17kHb1!XmcU5(DRdscB&qP(7Ds}etpV_*C^GzjBZsDV;1XS>N*oJZn7mu`nuEM?h zHk4hswQfmUwlMIN9@$k_ex6;(_h5W;Y(SE-uy(;*9>Qb)sYAI&Lur81;m zS25GkCmjtNRdZq0tHI}E-j9Iv7I!z#NvCRSZtL2V-mLm1Z|quc>*vk-dWUHsdXZ%_ zZEW1V2&+mkb(2pP#mG;|veR^M9w$?ykQCRLHokb?8g`hLa$GV|tt-C6x|A%REw(w5 zQkEiB8IvLNv{KDVIYSaxjn56YjSbF(ry>iiT53nBLr!%IV|*6Ei;}$8^{O|dT%7OG zB=MwI@F)xLyh=@W`Y)R)i{RZPi^rKl;OIehkepOw?%?}X)eF(Gj~>lg6KsyMl*wmFJuY$z#Tbp}t!3>50GQ1n+s z>t7>lIRB_34jCL|Lj+K8kh*?VSxJTA5n2N3@qE=BD7?yqLK4s6$zl9bRberB^`O$N zFO@mBjy_js43Nyw-=fU<$C!F4tJxtyd3Hx5IzmHel&aU2=L`DLw!k()R+-h@PMu&{ z)M+Vmkz^)O7KOrxs<6sqTU6RcOCs|}s&Y;hm6+P@EokLZ4;&WPl?hZ_KKkii;Dd2+ zhLr`avA4Awi)pkz?tYS?p?@tQ+UVE!3F1GAST}C_v!AK zkP5-Kq|&EMO*>4V zVYPnPZa!os{Is@Do!Xw`70(&-?VX)FD!D26((qNFzi#*s5=GgrG@r;yWOykWK{fL5 zyw)SyAZ@ip6ekM6>*}`YG{(Q3rlczAG(bsuU8OL9)37&2r&)S8DZPKqX=>;+n{=8Q zI?cADp+9w+YN`Z$@z80ee#dE&QZ=g@p9TZ5IYUc5-KSa%+TUM)^}`YOHiLFpAiHLi zISHj~w+$M7Jr~iQ{gdi}lr3)}o4w7J$OW*(5di9BOOOcCZjn80iQYNd^8GvgQ(F#a zOy&*&AV6EjXv+X?x#{rxQ(M;3mhGI7*z)P`*fJ^AoC;t&@!GcJayIOO%h}$ZEbJOI z@_ib)R*d|xaBcU!Gml%0ToJV>TE@z&dUV~$vl`jqY18_8(#RD{H;_HN#mE)Wq>-y0 ziW#YrVPOCxvlsBg+;7Y8|E`f6Xymsvas!RL<|yY+joctJQhc~zWi$NMD4&oDNk@a% zWqEUC!P34iyT}OU*=);Bp-9k2fqhH%g*@fXld7`QfP&JU71*{c@+29u6QSxh=o$Pcb>MX98tp%KehyLy%KZ^d(W96jIU zg#VehSL|9C^_q*8sY=WP4o~O7K+XeqV%v_BWmN2n|Gh5WuPSA7%q*kg(0PRXP zLQe!9azP}=yU*!~f_Ky4CC-fg%yW8GyU0RO;5iFB|HuOSNq&$#0VTu*8S>(fn3hiD zwicSwboIZI7q@faAcSkxZjwDCjd+QcNOSh1DIRiEa+8rc%PWgynUTg&mC(36n&tXG zhjBSusoN-!TQwu)7HlqMF&@o$l?pOAJ0i&I%Gzi5QEIl;(xhHdMcTeYDI;RN*0OnTCcBPCzXV@@L*X5ro%lJ z;m&inHF4}r<|ZTm=SudM3a<f8Qe4Ol>TuY2y#h-L~Bl=Wc(QNFO-4dffV7PLmd2{D`f1sI}LkwcFOr zAD_EBxn?F+Wk_}UYB?m&-3&5aNhf?EQN8PQU~#~5G;}v7Y_h=ln%Y+!rayDS7g2bG zEeoA6XW3TgFI@xqn>ehfQ^*+M{Jj?2GF@O)Rj!Cv@pxuCVPZ()Dmr1?^5A&%nkQnl z!V_Dccb(xr%--bu%_&dpO?e{lY)||sH)G<7&n$Az6eBGX-X(HDaJhhiCqnw9C!!S( zJh9dFJD&JV$mofYzw3!z^u%%A0Cjm0AYAmssHE6WV#-{4f^)Lu+4pE8Dx~QLR!oXb5LAuoutVFhii=HLn$J-v7$=+*U zFln>T_T_!?!yd{v=nW3q@?E>38j-;{n(Wg>8n>xgn)#nS4@;S^IC!@&Xn9?nku0?d zS#+tDH_aKjI3pJYdd6xttCD<9a*S6dxF`-J6P#N$*W>ZC=*-e7<(pL+6KHS5<=F!i zCWo9~H&<|rNIDDz+D$d%Wyc;MwWWc#MG8}NfOh7fkBMIopD_<&1S!p*cryv)Hn(jxF3Ha?BKkW7`?t9BV#Uq}r(^*<}W6KSS} zjFAS@(tk0h-eaUGVNSg#g44+D#opr|KV;8qd-cTp=&0mwMvhsWO{SjfWp_a{cb8uF zC!fT%Zd-JAwryy9G~)>6kBPb6%l&UhXl}kY@Xw{p9ZQ)Tc(%EBK2m>zw_$OJOfjmR zx!q-V(P`%16InO}k5K;%|BksggpB46{9SYJ)7)MLo_$0E+@0A`AWNws27qVAMjdRJ98o65J#*q&AkbMfZCAYK1Xp)q|qF#UGD%$H1zk8Igxf zjCpcy4+F3DN@k2=Q5y;Ng7Woh<*b47ohxN26-2^n+A$H!+>mJY6zr}v3dCKsHG0T& z0$~%;Y%sRM!Mi>v!&E_V_A89$2Pd;1ZK`XBp-+R>ZbLOoWLa&@t}W3n#6&xoyD>{2 z(A3ir-2Oksj_TfPg!2Wn_pA0))v4h&T@bLxipMXY7sJC|?k+|?Ay=P5M}x*T8z_pE z4Cw-}(pCtQvViv-1vUZ5*G52|K9nYUjY5aQvO-1yPd=ujFb$R1yM0Lv5RI}YOQ?Fi zxsH8C*;AE$lJ@58ZmV|700AF9Vsej|+3eiJf;ku7Q&`yMYwcoz1Y=c%t#Bxhl)X=_}_RjTAZX0l0~qk#cb^VhHnJqN|noM6Vn3Izvdg&^o=c5X&KdC z-o4V&rL?qLA{VRG60h)5{tKsK1YW#Y&P%(@yqn?kEi%hAeA-RXt>{n4NY!s-q*p?{^RFV;|oFR!TpHEQAnU3 zSzwyXRSX~Ht4*9M&?^DJyIK7s?Z)eF%RXe0Tc(fW9YKt(DoZ0{GFxtSjf24rvL6z>*rFlaG*5$i)2im?hq}Gc2F~3zRK+=NXsJc zX7eW&IcM5@DoxL~rKSk=M>~kSB8!Cjx(-{3zm%E=o^V(R_3}*zQ`11$Vq2yx&;K3j z6GIZ$4)r4=fHGY#EUq_RwbWv!LVZ`t^};FF175=QUQ&7q_3&amnPT*$spJn*Q`>mS zP~XLI80tUES1&(%y^JHHMP$7A3PcEq>Yn{w|9eUQ8(=7Xsrd0+A~nU}NKK7$3BwxU z@U0z?d9kWZ#KfL3f+eHWxP`!t>=i0ztiwgwDXMlnMRXjRPzDzh;;9pS!BEK_AY=%P z22(8aEt+{F2ljn#aCwY1kb8XZ!QL0jH(9!gUJg0Pq6&Jp?xDq)vSV>GX`3O26g^{2 z@i)MO5^-mVFE0ox9N`I>+N0UgtPJg8feU*h7DF5+=R=An7pAt_%uSv0eVuDS=K(-Syz<#75MiR;*M3!FZa5ZSa8vg+W z9?JrooCs;yLVh4h9=QmGp~HaWA!Mw3Aae&i-^}#|s^3w*_h6zDoGnOzshUz1F2cZA zhYZGiP?f|wf?y_0gE)@7(=N)VDPImcI#3v050tSV`T#cA%WzE$ic+Bv&h}KPwbdL9 z+=Y7qTZ7tF3C`eTc2bOITk-kll@va_H3!Vlk>U7GK% z*5aFoln?hn%BMNdjOLyBe~+<3jZLxxsxUOnY{WL9MNX># z4vQ6lKVxIlNN;1i-9bZ{_vkT$6XWk*LO!!ldP6Zzm7orG#N+K^8Cc6~h=E_r159FG zdgamy21pJLUOr{nqm@yNx{L(Kc(Urjq*vWA*~%EWtb_s4EifAOtVz#j4#vZLIZJeI zf4t~F$)|kP_>|PA^caS;Xm}}vBBkt&lzBvTaT(GX1ITVI1KDHPnxygI5n!sx6oot~ zrtif7!dVo`q93g6PBi0)S6OK`L2LvCEOvZ=*{f8=kB-ZS&X#b~*2@j;wMDYb zo#cV@eFVO|#Y-E1tMh%tjTHB9`931>S~fX+Y3I8yTQ7$klOefHptlkqVYvh0chY;? zDK+h_Am;J=U)q_?*d{KQFqqkl?;|e%@O`%yv7t6IWH!l+05eNljd^7rKlzj%^^s+QbRNPSouV ztQoe&(Pp+MkkQsNgf?>SVMjl$fS3! z6c^RC+^bo;Y_C%uNF{3!|C)20$476cVeqY+*hLE_ zpJC_JBdC}IWldkFaXouv4xoxJ6&ZQ#{Zckf6j&*V!rs(L_DQyPtpWEi3Q(#ERFroC z_EW3O1vH18GYRGJG{#UMZ_}K(OA3`*rk|wR4s96i8t~&7Hvg)|)BOnLn*t+ypm6IN zAQon-FbGMZTCa%62NsH71iQv?U_)U@8zGZL7JJVLxmaYUC@zCt7>d0=f?ezJIEzcX z^Hf=aqTpAUnO3I7de*A{e1q~~A#Na3tvKj|v0!}}Z*d5VlW=60r$s;}f&sKa_LqG% zdSoy`;+cHM2b6q?Ee;p1dF*SPiVFpVPhDTCVrjdm&R?q^)@WO$brSH&qj4$BX>s z@M=4u*ZFI27m5Ixrf#z2jMds=P(S2vxNIrhETQLGMcTTXwuD z?$o)Zgqn&wA1^-vWXu+KhU43Wj*B~ok2(o8i=_!&QTpeE#v$JT6H@azxVU)gQ6bJ~ zhmc&Z@Iwo;wz%{Dg_}?tUV7P1BOUjOy82&IQlnmXb=T&qs*o+;dcm^~d%Nry&Fi14 zt03*u{N|;iY_<*LH(yRMyc;h(8=pck_P#896+7u+TO%c))>PQjQ_`#1=FM;U_zfE` zGWdK3K|to)-1;?Td^>zn^bo;A6=kl$Pjnx<&7#bXxe+|>Z=|om|I6UPHE2#91V*n3 z*%lu6^*TaUPaXUi=t zZI<~4yY6qja(?vp%NpXx$QR^5zcMezO0Z*d=jE5YasE~??TO=seq0S6;btOQHl?Mf z{AqX!`5!KIOIHWxs{xrkWsAoT*lYBM-xj@p$+p(g)n}XeY&$J~^;!}h)e(MkxV?=w zRWKBNl8fyfvCtPDsg|9;s}w&!-CL$X`EM kAZ63Hukqs?k6J;SEHL>^@b^!zN=_BSx%0&9u~OvuAMfvp^Z)<= literal 0 HcmV?d00001 diff --git a//ipc.mid.19 b//ipc.mid.19 new file mode 100644 index 0000000..f171574 --- /dev/null +++ b//ipc.mid.19 @@ -0,0 +1,815 @@ +TITLE IPC -- IPC COMMUNICATIONS HANDLER FOR MUDDLE + +RELOCATABLE + +; N. RYAN October 1973 + +.INSRT MUDDLE > + +;THIS PROGRAM HAS ENTRIES SEND, SEND-WAIT, IPC-OFF, +; AND IPC-HANDLER. + +;THESE HANDLE THE IPC DEVICE. + +;SEND AND SEND-WAIT SEND OUT A MESSAGE ON THE IPC DEVICE. +;THEY TAKE 6 ARGUMENTS, THE FIRST THREE OF WHICH ARE NECESSARY + +; SEND ( ) + +; -- STRING USED AS SIXBIT FOR NAME 1 +; -- STRING USED AS SIXBIT FOR NAME 2 +; -- THE MESSAGE TO SEND, EITHER A STRING OR A UVECTOR OF TYPE WORD +; -- THE TYPECODE TO SEND, A FIXED NUMBER, DEFAULT 0 +; -- STRING USED AS SIXBIT FOR MY NAME 1 +; -- STRING USED AS SIXBIT FOR MY NAME 2 + +; SEND -- TRIES TO SEND IMMEDIATELY, ELSE RETURNS FALSE WITH MESSAGE +; SEND-WAIT -- HANGS UNTIL MESSAGE CAN BE SENT + +; IPC-OFF -- NO ARGUMENTS, CLOSES ALL IPC-RECEIVE CHANNELS + +; IPC-ON -- OPENS AN IPC RECEIVE CHANNEL +; IT TAKES 2 OPTIONAL ARGS WHICH ARE THE NAMES TO LISTEN ON, +; THE DEFAULT IS UNAME, JNAME + + + + ; DEFINITIONS FOR STRUCTURE OF IPC BUFFER + +BUFL==200. ;LENGTH OF IPC BUFFER +BUFHED==3 ;LENGTH OF BUFFER HEADER +CONT==400000 ;LEFT HALF BIT INDICATING THIS IS CONTINUATION +INCOMP==200000 ;LEFT HALF BIT INDICATING MESSAGE COMPLETE +ASCIMS==100000 ;LEFT HALF BIT INDICATING THIS IS PACKED ASCII MESSAGE +MESHED==2 ;LENGTH OF CRUFT AT FRONT OF FIRST MESSAGE +MAXMES==20000. ;MAXIMUM LENGTH IN WORDS OF MESSAGES MUDDLE WILL LIKE + + +.GLOBAL STRTO6,SAT,IBLOCK,MOPEN,MCLOSE,GFALS,TTOCHN,INCONS,MASK2,INTHLD +.GLOBAL IPCS1,IBLOCK,IPCGOT,DIRQ,GIBLOK,6TOCHS,CAFRE,CAFRET,IPCBLS,PVSTOR,SPSTOR + +; DEFINITIONS OF BITS IN THE OPEN BLOCK FOR IPC DEVICE + +RFROMA==1 ;READ FROM ANY +RFROMS==2 ;READ FROM SPECIFIC +SANDH==4 ;SEND AND HANG +SIMM==10 ;SEND IMMEDIATE +USEUJ==20 ;USE MY UNAME, JNAME + + +;BUFFERFORMAT: HISNAME1 +; HISNAME2 +; COUNT +; BITS,,LENGTH +; TYPE + +;WHERE ASCII MESSAGES CONSIST OF A COUNT FOLLOWED BY CHARS +;THE LENGTH IS THE LENGTH OF THE TYPE WORD PLUS ALL THE BODIES + + + +; THE FOLLOWING IS THE HANDLER WHICH WILL NORMALLY BE PUT ON THE +; IPC INTERRUPT AND SO SERVE AS THE DEFAULT HANDLER FOR IPC RECEIVES +; WHICH ARE NOT CAUGHT BY THE USER AND SERVICED IN SOME OTHER MANNER + +; NOTE THAT AS AN EXPERIMENT, MESSAGE WHICH ARE ASCII STRINGS WITH TYPE-CODE 1 +; ARE CONSIDERED AS EXECUTE COMMANDS. THEY ARE FIRST PRINTED OUT, +; THEN THEY ARE PARSED AND THAT RESULT IS EVALED. +; ALL MESSAGES OF OTHER TYPES ARE CONSIDERED MERELY AS MESSAGES TO BE +; PRINTED OUT WITH AN INDICATING OF WHO THEY ARE FROM + +; THE ARGS WHICH THIS SUBROUTINE IS CALLED WITH BY INTERRUPT ARE +; +; WHERE THE LAST TWO ARE OPTIONAL AND ONLY GIVEN IF THE SOCKET WAS NOT +; LISTENING ON THE DEFAULT UNAME,JNAME COMBINATION. + + +MFUNCTION IPCH,SUBR,[IPC-HANDLER] + + ENTRY + + PUSH P,[0] ;SAVE A SLOT FOR LATTER USE + HLRE 0,AB ;CHECK THE NUMBER OF ARGS WE GOT + CAMLE 0,[-8.] ;NEED AT LEAST 4 ARGS + JRST WNA + GETYP E,(AB) ;CHECK TYPE OF FIRST ARG + CAIN E,TCHSTR ;IS IT A CHARACTER STRING + JRST .+3 + CAIE E,TUVEC ;IF NOT IT MUST BE A UVECTOR + JRST WTYP1 ;IF NEITHER THEN WE HAVE A LOOSER + GETYP A,2(AB) ;GET TYPE OF MESSAGE TYPE, SHOULD BE A FIX + CAIE A,TFIX + JRST WTYP2 ;IF NOT FIX COMPLAIN + GETYP A,4(AB) + CAIE A,TCHSTR ;HIS NAME 1 SHOULD BE CHAR STRING + JRST WTYP + GETYP A,6(AB) + CAIE A,TCHSTR + JRST WTYP ;HIS NAME 2 SHOULD BE CHAR STRING + CAML 0,[-8.] ;SEE IF WE HAVE 4 OR 6 ARGS + JRST IPCH1 ;WE ONLY HAD 4 ARGS + CAME 0,[-12.] ;THEN WE MUST HAVE EXACTLY 6 ARGS + JRST WNA + GETYP A,(AB)8. + CAIE A,TCHSTR + JRST WTYP ;CHECK TO SEE THE MY NAME 1 IS STRING + GETYP A,10.(AB) + CAIE A,TCHSTR + JRST WTYP ;CHECK TO SEE THAT MY NAME 2 IS STRING + +IPCH1: PUSH TP,$TCHAN + PUSH TP,TTOCHN+1 ;PUSH ON TTY OUTPUT CHANNEL TO CALL TERPRI + MCALL 1,TERPRI + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE [IPC MESSAGE FROM ] + PUSH TP,$TCHAN + PUSH TP,TTOCHN+1 + MCALL 2,PRINC ;PRINT OUT BLURB TO TELL LOOSER WHATS HAPPENING + PUSH TP,4(AB) + PUSH TP,5(AB) ;OUTPUT HIS NAME 1 + PUSHJ P,TO ;JUMP OUT OUTPUTTER OVER TTY OUTPUT CHANNEL + PUSHJ P,STO ;JUMP TO SPACE OUTPUTTER OVER TTY OUTPUT CHANNEL + PUSH TP,6(AB) + PUSH TP,7(AB) ;OUTPUT NAME 2 + PUSHJ P,TO + MOVE E,3(AB) ;MESSAGE TYPE + JUMPE E,IPCH3 ;IF MESSAGE TYPE 0 DO NOTHING ABOUT IT + CAIE E,1 ;IF 1 SEE IF THIS IS EXECUTE MESSAGE + JRST IPCH2 ;IF NOT TELL LOOSER ABOUT THIS MESSAGE TYPE + GETYP 0,(AB) + CAIE 0,TCHSTR ;SEE IF WE HAVE STRING + JRST IPCH2 ;IF NOT THIS CANT BE EXECUTE MESSAGE + AOS (P) ;SET FLAG TO INDICATE EXECUTE MESSAGE + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE [ EXECUTE] + PUSHJ P,TO ;TELL THE LOOSER HE IS GETTING WHAT HE DESERVES + JRST IPCH3 +IPCH2: PUSH TP,$TCHSTR + PUSH TP,CHQUOTE [ TYPE ] + PUSHJ P,TO + PUSH TP,2(AB) + PUSH TP,3(AB) ;PUSH ON THE MESSAGE TYPE + PUSHJ P,TO +IPCH3: HLRE 0,AB + CAME 0,[-12.] ;SEE IF WE HAVE 6 ARGS AND SO MUST TELL HIM WHO MESS IS FOR + JRST IPCH4 ;IF NOT DONT WORRY + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE [ TO ] + PUSHJ P,TO + PUSH TP,8.(AB) + PUSH TP,9.(AB) ;PUSH ON MY NAME 1 + PUSHJ P,TO + PUSHJ P,STO ;LEAVE SPACE BETWEEN NAMES + PUSH TP,10.(AB) ;PUSH ON MY NAME 2 + PUSH TP,11.(AB) + PUSHJ P,TO +IPCH4: PUSH TP,(AB) ;PUSH ON THE ACTUAL GOODIE + PUSH TP,1(AB) + PUSH TP,$TCHAN + PUSH TP,TTOCHN+1 + MCALL 2,PRINT ;AND PRINT IT OUT + SKIPN (P) ;TEST TO SEE IF WE MUST EXECUTE THIS BAG BITTER + JRST IPCHND + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 1,PARSE ;PARSE HIS CRUFT + PUSH TP,A + PUSH TP,B + MCALL 1,EVAL ;THEN EVAL THE RESULT +IPCHND: PUSH TP,$TCHAN + PUSH TP,TTOCHN+1 + MCALL 1,TERPRI + MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS ;TO RETURN WITH SOMETHING NICE + +STO: PUSH TP,$TCHSTR ;CROCK TO OUTPUT A SPACE ON THE TTY OUTPUT CHANNEL + PUSH TP,CHQUOTE [ ] +TO: PUSH TP,$TCHAN + PUSH TP,TTOCHN+1 + + MCALL 2,PRINC + POPJ P, ;GO BACK TO WHAT WE WERE DOING + + +;THESE ARE THE FUNCTIONS TO ACTUALLY STUFF GOODIES OUT +;OVER THE IPC DEVICE +;DESCRIPTION OF CALLING ARGS TO THEM IS AT THE +;FIRST OF THE FILE + +MFUNCTION SEND,SUBR + + ENTRY + + PUSH P,[0] ;FLAG TO INDICATE DONT WAIT + JRST CASND + +MFUNCTION SENDW,SUBR,[SEND-WAIT] + + ENTRY + + PUSH P,[1] ;FLAG TO INDICATE WAITING + +CASND: HLRE 0,AB + CAMG 0,[-6] ;NEED AT LEAST 3 ARGS + CAMGE 0,[-12.] ;AND NOT MORE THAN 6 ARGS + JRST WNA + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,STRTO6 ;POOF FIRST ARG TO SIXBIT + MOVE A,2(AB) + MOVE B,3(AB) + PUSHJ P,STRTO6 ;POOF SECOND ARG TO SIXBIT + GETYP 0,4(AB) + CAIN 0,TCHSTR + JRST CASND1 ;IF FIRST ARG IS STRING, NO PROBLEMS + CAIE 0,TSTORAGE + CAIN 0,TUVEC + JRST .+2 + JRST WTYP3 ;ELSE MUST BE OF TYPE STORAGE OR UVEC + MOVE B,5(AB) + HLRE C,B ;GET COUNT FIELD + SUBI B,(C) ;AND ADD THAT AMOUNT TO FIND DOPE WORD + GETYP A,(B) ;GET TYPE WORD OUT OF DOPE + PUSHJ P,SAT ;GET ITS STORAGE TYPE + CAIE A,S1WORD + JRST WTYP3 ;CRUFT MUST BE OF TYPE WORD +CASND1: PUSH TP,4(AB) + PUSH TP,5(AB) ;SAVE THE STRUCTURE AROUND TO REST OFF AS WE SEND + PUSH P,[0] ;SLOT FOR THIS MESSAGE TYPE, DEFAULT 0 + HLRE 0,AB + CAMLE 0,[-8.] ;IF 4 OR MORE ARGS GET THE MESS TYPE + JRST CASND2 + GETYP 0,6(AB) ;CHECK TO SEE THAT TYPE IS A FIX + CAIE 0,TFIX + JRST WTYP + MOVE 0,7(AB) + MOVEM 0,(P) ;SMASH IN THE SLOT RESERVED FOR TYPE +CASND2: HLRE 0,AB + CAMN 0,[-10.] ;IF WE HAVE FIVE ARGS WE ARE A GLOBAL LOOSER NEED 4 OR 6 + JRST WNA + CAMGE 0,[-8.] ;IF WE HAVE 4 OR LESS DONT WORRY + JRST .+4 ;GO GET LAST TO ARGS + PUSH P,[0] ;NO SIXBIT OF FROM + PUSH P,[0] ;SO SAVE SLOTS ANYWAY + JRST CASND3 ;GO WORRY ABOUT SENDING NOW + MOVE A,8.(AB) + MOVE B,9.(AB) + PUSHJ P,STRTO6 ;CONVERT MY NAME1 TO SIXBIT + MOVE A,10.(AB) + MOVE B,11.(AB) ;CONVERT MY NAME 2 TO SIXBIT + PUSHJ P,STRTO6 + +CASND3: GETYP 0,-1(TP) + CAIE 0,TCHSTR ;IS THIS A CHAR STRING + JRST .+5 + HRRZ A,-1(TP) ;IF SO GET COUNT + ADDI A,9. + IDIVI A,5 ;IF SO ROUND UP AND ADD ONE + JRST .+3 + HLRE A,(TP) + MOVN A,A ;IF A VECTOR GET THE WORD COUNT + PUSH P,A ;SAVE COUNT OF WORDS + CAILE A,MAXMES + JRST TOBIGR ;MESS OVER SIZE LIKED BY MUDDLE + CAILE A,BUFL-MESHED ;HOW BIG A BUFFER DO WE NEED? + MOVEI A,BUFL-MESHED ;IF TOO BIG WE USE DEFAULT MAX SIZE, ELSE LESS + ADDI A,MESHED+BUFHED ;PLUS ROOM FOR MESSAGE AND SYSTEM HEADERS + PUSHJ P,IBLOCK + PUSH TP,A + PUSH TP,B ;GET BUFFER OF RIGHT SIZE AND SAVE ON STACK + PUSH TP,A + PUSH TP,B ;SAVE ANOTHER COPY WHICH WILL BE RESTED AT TIMES + MOVE C,-5(P) ;GET HIS NAME 1 + MOVEM C,(B) ;AND STUFF IN RIGHT PLACE + MOVE C,-4(P) + MOVEM C,1(B) ;STUFF HIS NAME 2 + MOVE C,-3(P) + MOVEM C,4(B) ;STUFF MESSAGE TYPE CODE WORD + GETYP 0,-5(TP) ;IS THIS STRING OR UVECTOR? + CAIE 0,TCHSTR + JRST CASND4 + MOVE C,(P) ;GET LENGTH OF CHAR STRING TO SEND + ADDI C,1 + MOVEM C,3(B) ;STORE IN LENGTH FIELD IN MESS HEADER + SOS (P) ;DECREMENT FOR COUNT WORD + HRRZ C,-5(TP) ;GET THE CHARACTER COUNT + MOVEM C,5(B) ;STORE IN CORRECT SLOT IN MESSAGE + MOVE D,[6,,6] ;OFFSET FOR INITIAL HEADER ON ASCII MESSAGES + ADDM D,(TP) ;OFFSET BUF PTR 2 BY THIS AMOUNT + JRST CASND5 +CASND4: MOVE C,(P) ;GET COUNT OF MESSAGE + ADDI C,1 ;EXTRA FOR TYPE WORD + MOVEM C,3(B) ;STORE IN SLOT FOR COUNT OF WHOLE MESSAGE + MOVE D,[5,,5] ;OFFSET FOR INITIAL HEADER ON UVECTOR MESSAGES + ADDM D,(TP) ;OFFSET BUF PTR 2 BY THIS AMOUNT +CASND5: PUSHJ P,STUFBF ;GO FILL UP THE BUFFER WITH GARBAGE + MOVN 0,A ;GET NEGATIVE THE COUNT OF WORDS STUFFED + ADDM 0,(P) ;THAT MANY LESS WORDS REMAINING TO BE DONE + HRRZ C,-2(TP) ;GET A POINTER TO THE "UNRESTED" BUFFER + HRRZ D,(TP) ;GET A POINTER TO THE "RESTED" BUFFER + SUB D,C ;FIND OUT HOW MUCH WAS RESTED OFF + ADD D,A ;ADD TO THAT THE COUNT OF WORDS STUFFED THIS TIME + SUBI D,BUFHED ;LESS THE SYSTEM CONSTANT HEADER THAT DOENT COUNT + MOVEM D,2(C) ;STORE IN THE BUFFER IN CORRECT SLOT + PUSHJ P,CASIOT ;GO DO THE "IOT"--ACTUALLY AN OPEN + MOVE C,-2(TP) + HRLZI E,CONT ;THE "THIS IS A CONTINUATION" BIT + IORM E,3(C) ;TURN BIT ON IN FUTURE MESSAGES + ADD C,[4,,4] ;REST OFF THE SHORTER HEADER FOR THE REST OF MESSAGES + MOVEM C,(TP) ;STORE THIS IN THE "RESTED" BUFFER SLOT + SKIPLE (P) ;IS THERE MORE TO DO? + JRST CASND5 + MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS ;RETURN HIM SOMETHING NICE + +TOBIGR: ERRUUO EQUOTE MESSAGE-TOO-BIG + + +STUFBF: MOVE C,-2(TP) ;ROUTINE TO FILL UP BUFFER WITH GOODIES + HRLZI E,INCOMP+ASCIMS + ANDCAM E,3(C) ;CLEAR THE INCOMPLETE AND ASCII FLAGS IF SET + HLRE B,(TP) ;GET THE BUFFER LENGTH + MOVN B,B ;MAKE IT A POSITIVE NUMBER + CAML B,-1(P) ;SEE IF THE WHOLE MESSAGE WILL FIT + JRST .+4 ;IT WILL ALL FIT + HRLZI 0,INCOMP ;THE INCOMPLETE FLAG + IORM 0,3(C) ;SET IT + JRST .+2 + MOVE B,-1(P) ;ELSE THE WHOLE MESSAGE FITS + GETYP 0,-5(TP) + CAIN 0,TCHSTR + JRST STUFAS + HRLZ D,-4(TP) ;SET UP TO BLT UVECTOR + HRR D,(TP) + HRRZ E,(TP) + ADDI E,(B)-1 ;SET UP BLT POINTERS + SKIPLE B ;IN CASE ZERO LENGTH UVECTOR + BLT D,(E) ;BBBBLLLLLLLLLLLLLLLLLLTTTT? + MOVE A,B ;MOVE COUNT OF WORDS DONE INTO A + HRL B,B + ADDM B,-4(TP) ;REST OFF THIS MUCH OF GOODIE FOR NEXT TIME + POPJ P, +STUFAS: HRLZI 0,ASCIMS + IORM 0,3(C) ;TURN ON THE ASCII BIT IN THE MESSAGE + MOVE A,B ;MOVE COUNT OF NUMBER OF WORDS INTO A + IMULI B,5 ;GET CHAR COUNT IN B + HRRZ C,-5(TP) ;COMPARE THIS WITH COUNT FIELD IN STRING + MOVE D,B + SUB D,C ;SEE HOW MANY EXTRA BLANKS AT END OF MESS + JUMPGE D,.+3 + MOVEI D,0 ;NO EXTRA SPACES TO PAD + MOVE C,B ;NOT EXTRA SPACES, DO 5*WORD CHARS + MOVN E,C + ADDM E,-5(TP) ;FIX UP COUNT IN ASCII + HRLZI E,440700 ;GET A IDPB PTR INTO THE BUFFER + HRR E,(TP) ;POINT TO RIGHT PLACE IN BUFFER + JUMPLE C,.+4 ;ARE WE DONE MOVING CHARS? + ILDB 0,-4(TP) ;LOAD A BYTE FROM STRING + IDPB 0,E ;STUFF IN BUFFER + SOJG C,.-2 ;REPEAT THE LOOP + JUMPLE D,.+4 ;SEE IF WE NEED TO FILL OUT WITH NULLS + MOVEI 0,0 + IDPB 0,E ;STUFF A NULL IN RIGHT SPOT IN BUFFER + SOJG D,.-1 + POPJ P, + +CASIOT: HRRZI A,(SIXBIT /IPC/) ;FIX UP OPEN BLOCK IN THE AC'S + MOVE B,-2(TP) ;HOWS THAT FOR SNAZZY? + MOVE C,-3(P) ;MY NAME 1 + MOVE D,-2(P) ;MY NAME 2 + JUMPN C,.+3 + JUMPN D,.+2 + TLO A,USEUJ ;IF BOTH ARE ZERO THEN USE DEFAULT UNAME,JNAME + SKIPN -7(P) ;SEE IF SEND AND HANG FLAG IS SET + JRST .+3 + TLO A,SANDH ;SET SEND AND HANG FLAG + JRST .+3 + TLO A,SIMM ;ELSE WE MUST BE SENDING IMMEDIATE + AOS -7(P) ;IF THERE IS MORE TO DO, IT MUST BE IN HANG MODE + MOVSI 0,TUVEC + MOVE PVP,PVSTOR+1 + MOVEM 0,BSTO(PVP) ;IN CASE WE ARE INTERRUPTED OUT WE WANT TO WIN + SETZM E ;FLAG USED TO INDICATE NO SKIPPAGE + ENABLE + .OPEN 0,A ;WELL, THATS ALL THERE IS TO IT. + AOS E ;IF WE DONT SKIP WE HAVE PROBLEMS + DISABLE + MOVE PVP,PVSTOR+1 + SETZM BSTO(PVP) ;FIX UP THE SLOT IN PVP + SKIPN E ;SEE IF WE LOST + POPJ P, ;IF NOT WE ARE THROUGH WITH THIS PART + .STATUS 0,A ;FIND OUT REASON FOR LOSSAGE + MOVEI B,0 + PUSHJ P,GFALS ;MAKE A FALSE WITH THAT REASON + JRST FINIS ;GIVE THE MAGIC FALSE BACK TO THE LOOSER + + +MFUNCTION DEMSIG,SUBR + + ENTRY 1 + + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,STRTO6 ;GET THE SIXBIT REPRESENTATION + MOVE A,[SETZ] ;FIX UP THE BLOCK IN THE AC'S + MOVE B,[SIXBIT /DEMSIG/] + MOVE C,[SETZ (P)] ;THE SIXBIT IS ON TOP OF P STACK + .CALL A + JRST RFALS ;DIDNT WIN WITH DEMON SIGNAL +RTRUE: MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +RFALS: MOVSI A,TFALSE + MOVEI B,0 + JRST FINIS ;FALSE INDICATING LACK OF WINNAGE + + +MFUNCTION IPCON,SUBR,[IPC-ON] + + ENTRY + + PUSH P,[USEUJ,,0] ;FLAG FOR WHETHER OR NOT TO USE DEFAULT + HLRZ 0,AB + JUMPE 0,IPCON1 ;NO ARGS ARE FINE + CAIE 0,-4 ;ELSE MUST HAVE 2 ARGS + JRST WNA + SETZM (P) ;CLEAR OUR FLAG + MOVE A,(AB) + MOVE B,1(AB) + PUSHJ P,STRTO6 ;GET SIXBIT OF OUR FIRST ARG + MOVE A,2(AB) + MOVE B,3(AB) + PUSHJ P,STRTO6 ;GET SIXBIT OF OUR SECOND ARG + JRST IPCON2 +IPCON1: PUSH P,[0] ;SAVE SLOT ON STACK FOR EVENNESS + PUSH P,[0] +IPCON2: MOVEI A,BUFL+BUFHED + PUSHJ P,CAFRE ;GET A BUFFER OF RIGHT LENGTH TO READ INTO + PUSH P,A ;AND SAVE IT AROUND SO WE DONT LOOSE + MOVEI 0,BUFL + MOVEM 0,2(A) ;FILL COUNT IN THE BUFFER SLOT + MOVEI A,5 + PUSHJ P,IBLOCK ;GET A BLOCK OF STORE FOR THE OPEN BLOCK + PUSH TP,$TUVEC + PUSH TP,B ;SAVE CRUFT ON TP + TLO 0,RFROMA ;SET THE READ FROM ANY FLAG + IOR 0,-3(P) ;FIX FOR DEFAULT UNAME,JNAME IF FLAG INDICATES + MOVEM 0,(B) ;MAKE OPEN BLOCK + MOVE 0,[SIXBIT /IPC/] + MOVEM 0,1(B) + MOVE 0,-2(P) + MOVEM 0,3(B) ;MY NAME 1 + MOVE 0,-1(P) + MOVEM 0,4(B) ;MY NAME 2 IF NOT USING DEFAULT + MOVE 0,(P) + MOVEM 0,2(B) ;PTR TO THE WIRED BUFFER FOR STUFFING CRUFT + MOVE A,B + PUSHJ P,MOPEN ;GO DO THE OPEN + JRST IPCON3 ;OPEN FAILED, FIND OUT WHY + PUSH P,A ;SAVE THE CHANNEL NUMBER + MOVEI E,1 + LSH E,(A) ;SET INTERRUPT BITS RIGHT + IORM E,MASK2 + .SUSET [.SMSK2,,MASK2] + MOVE C,-1(TP) + MOVE D,(TP) ;GET THE OPEN BLOCK UVECTOR + PUSHJ P,INCONS ;THROW INTO PAIR SPACE + POP P,C ;GET THE CHANNEL # + SUBI C,1 + IMULI C,2 + MOVEM B,IPCS1+1(C) ;STUFF PTR TO OPEN BLOCK INTO SLOT IN TVP + JRST RTRUE ;WE WON, GO LET LUSER KNOW IT. +IPCON3: PUSH P,A ;WE LOST, LETS FIND OUT WHY + MOVE A,BUFL+BUFHED + MOVE B,-1(P) ;LETS FREE UP OUR WIRED DOWN BUFFER TO BE CLEAN + PUSHJ P,CAFRET + POP P,A ;GET THE CHANNEL # BACK + JUMPL A,NFCHN ;NO FREE CHANNELS? + MOVE B,[.STATUS A] ;MAKE A CALL TO STATUS TO FIND REASON + LSH A,23. ;SHIFT THE CHANNEL NUMBER INTO RIGHT PLACE + IOR B,A ;FIX UP .STATUS + XCT B + MOVEI B,0 + PUSHJ P,GFALS + JRST FINIS ;RETURN A LOOSE WITH REASON FOR LOOSAGE + +NFCHN: ERRUUO EQUOTE NO-ITS-CHANNELS-FREE + + +MFUNCTION IPCOFF,SUBR,[IPC-OFF] + + ENTRY 0 + + PUSH TP,$TVEC + MOVE 0,[IPCS1,,IPCS1] + PUSH TP,0 ;SAVE OUR PLACE IN RUNNING THROUGH SLOTS + PUSH P,[1] ;COUNTER OF CHANNEL NUMBER + +IPCOF1: MOVE A,(TP) ;GET FIRST GOODIE + SKIPN B,1(A) ;GET THE POINTER TO LIST + JRST IPCOF2 + SETZM 1(A) ;ZERO OUT SLOT TO BE CLEAN + MOVE B,1(B) ;GET CAR OF LIST, PTR TO OPEN BLOCK + MOVE C,(P) ;GET THE ACTUAL CHANNEL NUMBER + MOVEI E,1 ;TURN OFF INTERRUPT + LSH E,(C) + ANDCAM E,MASK2 + .SUSET [.SMSK2,,MASK2] + MOVE A,C + PUSHJ P,MCLOSE ;CLOSE THIS CHANNEL + JFCL + MOVEI A,BUFL+BUFHED ;LENGTH OF WIRED STORE TO FREE UP + MOVE B,1(B) ;GET THE POINTER TO WIRED STORE + PUSHJ P,CAFRET ;FREE ALREADY +IPCOF2: MOVE 0,[2,,2] + ADDM 0,(TP) ;REST TO NEXT SLOT + AOS D,(P) ;NEXT CHANNEL + CAIG D,15. ;ARE WE THROUGH + JRST IPCOF1 + JRST RTRUE ;RETURN HIM A TRUE FOR NICENESS + + +IPCGOT: MOVEI D,IPCS1+1 + ADDI D,(B) + ADDI D,(B) + SKIPN D,-74.(D) ;GET THE GOODIE LIST FOR CHANNEL WE INTERRUPTED ON + JRST DIRQ ;MIX UP MAYBE, LET HIM WORRY ABOUT IT + PUSH P,B ;SAVE THE CHAN # + PUSH TP,$TLIST + PUSH TP,D ;SAVE GOODIE LIST + MOVE E,1(D) ;GET PTR TO OPEN BLOCK + PUSH P,2(E) ;SAVE PTR TO WIRED BUFFER + MOVE E,2(E) + MOVE 0,3(E) ;GET THE MAGIC BITS FOR THIS MESSAGE + TLNE 0,CONT ;IS THIS MESSAGE A CONTINUATION? + JRST IGCON ;YES + MOVEI A,10. ;NO + PUSHJ P,GIBLOK ;GET A BLOCK FOR FUNNY MESSAGE VECTOR + PUSH TP,$TVEC + PUSH TP,B ;SAVE THE BLOCK FOR FUNNY MESSAGE VECTOR + MOVE E,(P) ;GET PTR TO WIRED BUFFER + MOVE 0,3(E) ;GET THE MAGIC BITS AGAIN + HRRZ A,0 ;GET THE LENGTH IN WORDS OF THIS THE WHOLE MESSAGE HE HAS + SUBI A,1 ;MINUS ONE FOR THE TYPE WORD WHICH IS COUNTED + TLNE 0,ASCIMS ;IS THIS ASCII? + SUBI A,1 ;IF YES THEN MUST SUB 1 MORE FOR ASCII CHAR COUNT + CAILE A,MAXMES ;IS THIS BIGGER THAN MUDDLE BLESSES? + JRST TBGMS ;IF SO THEN CLEAN UP AND FORGET ABOUT THE LOOSER + PUSHJ P,IBLOCK + MOVE E,(P) + MOVE D,(TP) + MOVE 0,(E) ;GET HIS NAME 1 OUT OF MESSAGE + MOVEM 0,5(D) ;STORE INTO SLOT IN FUNNY MESSAGE VECTOR + MOVE 0,1(E) ;GET HIS NAME 2 OUT OF MESSAGE + MOVEM 0,7(D) + MOVE 0,4(E) ;GET THE MESSAGE TYPE WORD + MOVEM 0,9(D) ;STORE INTO SLOT IN MESSAGE VECTOR + MOVSI 0,TFIX + MOVE 0,4(D) + MOVE 0,6(D) + MOVE 0,8(D) + MOVE 0,3(E) ;GET THE MESSAGE BITS + TLNE 0,ASCIMS ;IS IT ASCII? + JRST IG1 ;YES + MOVSI 0,TUVEC + MOVEM 0,(D) + MOVEM 0,2(D) + MOVEM B,1(D) + MOVEM B,3(D) ;STORE MESSAGE BLANK TWICE, THE SECOND TO REST THROUGH + HLRE E,B + SUBM B,E + MOVSI 0,TFIX + MOVEM 0,(E) ;SET NICE TYPE TO PRINT GOODER + JRST IGBLT +IG1: MOVSI 0,TUVEC + MOVEM 0,2(D) + MOVEM B,3(D) ;STORE MESSAGE BLANK AS UVECTOR TO REST THROUGH + HLRE A,B + HRLI B,010700 ;MAKE THE ILDB PTR + SUBI B,1 + MOVEM B,1(D) ;AND STORE IN THE SLOT + IMUL A,[-5] ;MAX CHAR COUNT FOR STRING + MOVE B,5(E) ;GET THE ACTUAL CHARACTER COUNT HE CLAIMED + MOVE C,A + SUB C,B ;FIND DIFFERENCE BETWEEN MAX AND CLAIMED + JUMPL C,.+2 ;IF COUNT TOO BIG, MUST DO BEST POSSIBLE AND USE MAX COUNT + CAILE C,4 ;NO MORE THAN FOUR EXTRA CHARS IMPLIES GOODNESS + MOVE B,A ;IF LOSSAGE, THEN USE MAX COUNT INSTEAD OF HIS CLAIM + HRLI B,TCHSTR ;MAKE THIS A CHAR STRING TYPE WORD + MOVEM B,(D) ;AND FIX MESSAGE BLANK # 1 TO BE THE BLESSED STRING + JRST IGBLT ;BLT THE MESSAGE INTO THE BLANK + +IGCON: MOVE D,(TP) ;GET THE IPC SLOT LIST + MOVE E,(P) ;GET A PTR TO THE MESSAGE BUFFER + HRRZ C,(D) ;CDR THE IPC SLOT LIST TO POINT TO FIRST MESSAGE VECTOR +IGCON1: JUMPE C,IGCONL ;IF NIL, THEN ABANDON ALL HOPE + MOVE B,1(C) ;LOOK AT THE VECTOR + MOVE 0,5(B) ;HIS NAME 1 FOR THIS BLOCK + CAME 0,(E) ;COMPARE WITH HIS NAME 1 IN THIS MESSAGE + JRST IGCON2 ;IMMEDIATE FAILURE, TRY THE NEXT IN THE LIST + MOVE 0,7(B) ;SEE IF HIS NAME 2 ALSO MATCHES + CAME 0,1(E) ;WELL, DOES IT MATCH? + JRST IGCON2 ;NO, TRY THE NEXT ONE + PUSH TP,$TVEC ;WE GOT IT + PUSH TP,1(C) ;SAVE THIS MESSAGE BLOCK ON TP FOR LATER BLTING + HRRZ C,(C) ;CDR TO REST OF LIST + HRRM C,(D) ;AND SPLICE IT RIGHT OUT OF THE LIST, NEAT HUH? + JRST IGBLT ;GO BLT TO OUR HEART'S CONTENT +IGCON2: HRRZ D,(D) ;REST OUR FOLLOW UP POINTER + HRRZ C,(C) ;REST OUR ACTUAL TEST POINTER + JRST IGCON1 ;TRY AGAIN + +IGCONL: MOVE A,(TP) + MOVE A,1(A) ;GET PTR TO OPEN BLOCK + MOVE B,-1(P) + SUBI B,36. ;GET CHANNEL NUMBER + HLL B,(A) + MOVE C,(P) ;GET THE WIRED BUFFER + SUB P,[2,,2] ;WE LOST SO CLEAN UP STACKS + SUB TP,[2,,2] +ROPNL: SETZM (C) ;REOPEN CHANNEL SO NOT PERMANENTLY CROGGLED + SETZM 1(C) ;ZERO OUT THE HIS NAME SLOTS + MOVEI 0,BUFL + MOVEM 0,2(C) ;RESET THE LENGTH FIELD IN WIRED BUF + DOTCAL OPEN,[B,1(A),2(A),3(A),4(A)] + FATAL CANT REOPEN IPC CHN + JRST DIRQ ;LEFT IN NICE STATE AFTER LOOSAGE + +TBGMS: MOVE A,-2(TP) + MOVE A,1(A) ;GET OPEN BLOCK + MOVE B,-1(P) + SUBI B,36. ;CHANNEL # + HLL B,(A) + MOVE C,(P) ;WIRED BUFFER + SUB P,[2,,2] ;CLEAN UP STACKS + SUB TP,[4,,4] + JRST ROPNL ;REOPEN SO NEXT GUY CAN WIN + + + +IGBLT: MOVE E,(TP) ;POINTER TO MESSAGE VECTOR + MOVE E,3(E) ;GET VECTOR (MAYBE STRING IN DISGUISE) TO BLT IN + MOVE D,(P) ;GET THE WIRED BUFFER + MOVEI C,4(D) ;GET A POINTER TO THE REST OF THE WIRED BUF + MOVEI 0,BUFL-1 ;KLUDGE TO IGNORE ONE EXTRA WORD OF BITS + SUB 0,2(D) ;GET LENGTH OF GOODIE GOT + MOVE A,3(D) ;GET THE RANDOM MESSAGE BITS + TLNE A,CONT ;TEST FOR CONTINUED MESSAGE + JRST .+7 ;IF SO THEN NO NEED TO WORRY + SOS 0 + AOS C ;FIX UP FOR ONE LESS WORD TO WORRY WITH + TLNN A,ASCIMS ;TEST FOR ASCII MESSAGE + JRST .+3 ;IF NOT THEN NO WORRY + SOS 0 + AOS C ;FIX UP FOR YET 1 FEWER WORD + HLRE A,E + MOVM A,A ;GET LENGTH OF VECTOR TO BLT INTO + CAILE 0,(A) ;CHECK TO SEE WE DONT HAVE TOO MUCH + MOVE 0,A ;IF WE HAVE TOO MUCH, CHOP OFF--HA, HA, HA + MOVEI B,-1(E) + ADD B,0 ;B POINTS TO LAST WORD TO BLT INTO + HRL C,E ;BLT POINTER + MOVSS C ;NDR CANT REMEMBER HOW TO BLT POINTER + BLT C,(B) ;VIOLA + HRL 0,0 + MOVE E,(TP) ;GET BACK POINTER TO MESSAGE VECTOR + ADDM 0,3(E) ;REST OFF TO KEEP TRACK OF INCOMPLETE MESSAGE + MOVE A,3(D) ;GET THE RANDOM MESSAGE BITS BACK + TLNE A,INCOMP ;MESSAGE COMPLETE? + JRST IGHALF ;INCOMPLETE + JRST IGMES ;COMPLETE + +IGHALF: MOVE C,-1(TP) ;GOT TO SPLICE MESSAGE VECTOR BACK IN + MOVE D,(TP) + PUSHJ P,INCONS ;STICK INTO PAIR SPACE + HRRZ E,-2(TP) ;PTR TO LIST + HRRZ D,(E) ;CDR OF LIST + HRRM D,(B) ;MAKE SPLICE + HRRM B,(E) ;THAT IT + MOVE B,1(E) ;POINT TO OPEN BLOCK + MOVE 0,-1(P) ;GET CHAN # + SUBI 0,36. + HLL 0,(B) + MOVE E,(P) ;GET THE WIRED BUF + MOVEI D,BUFL + MOVEM D,2(E) ;REFIX THE WIRED BUF + SETZM (E) + SETZM 1(E) + DOTCAL OPEN,[0,1(B),2(B),3(B),4(B)] + FATAL CANT REOPEN IPC CHN + SUB P,[2,,2] + SUB TP,[4,,4] ;CLEAN OURSELVES + JRST DIRQ ;THATS ALL THERE IS TO IT + +IGMES: HRRZ E,-2(TP) ;PTR TO OUR KLUDGE LIST + MOVE B,1(E) ;PTR TO OPEN BLOCK + MOVE 0,-1(P) ;CHANNEL # + SUBI 0,36. + HLL 0.(B) + MOVE D,(P) ;GET THE WIRED BUF + MOVEI C,BUFL + MOVEM C,2(D) + SETZM (D) + SETZM 1(D) ;BLESS WIRED BUF FOR REOPENING + DOTCAL OPEN,[0,1(B),2(B),3(B),4(B)] + FATAL CANT REOPEN IPC CHN + MOVE E,(TP) ;GET THE MESSAGE VECTOR (ALIAS GOODIE BLOCK) + SUB P,[2,,2] ;BLESS OUR P STACK + PUSH P,5(E) ;SAVE SIXBIT HIS NAME 1 + PUSH P,7(E) ;SAVE SIXBIT HIS NAME 2 + SUB TP,[4,,4] ;BLESS THE TP STACK + PUSH TP,$TCHSTR + PUSH TP,CHQUOTE IPC + PUSH TP,(E) ;STUFF STUFF ON TO CALL INTERRUPT + PUSH TP,1(E) ;THAT IS THE ACTUAL MESSAGE + MOVE 0,9(E) + CAMN 0,[400000,,0] + JRST IGUG +IGUGN: PUSH P,3(B) ;GET MY NAME 1 OUT OF OPEN BLOCK + PUSH P,4(B) ;GET MY NAME 2 OUT OF OPEN BLOCK + MOVE 0,(B) ;GET SOME OF THE RANDOM OPEN FLAGS + TLNE 0,USEUJ + SETZ -1(P) ;MAKE SURE WE HAVE INDICATOR IF THIS IS TO UNAME,JNAME + PUSH TP,$TFIX + PUSH TP,9(E) ;SAVE THE MESSAGE TYPE + MOVE A,-3(P) ;HIS NAME 1 + PUSHJ P,6TOCHS + PUSH TP,A + PUSH TP,B ;GIVE HIM NICE CHAR STRING OF ALL THE NAMES + MOVE A,-2(P) + PUSHJ P,6TOCHS + PUSH TP,A + PUSH TP,B ;NICE CHAR STRING OF HIS NAME 2 + SKIPN A,-1(P) ;ISE THIS DEFAULT UNAME, JNAME + JRST IGFOUR ;ONLY FOUR ARGS TO THE IPC INTERRUPT + PUSHJ P,6TOCHS + PUSH TP,A + PUSH TP,B + MOVE A,(P) + PUSHJ P,6TOCHS + PUSH TP,A + PUSH TP,B ;GIVE HIM CHAR STRINGS OF MY NAME 1 AND 2 IF NOT DEFAULT + MOVEI E,7 ;FOR ACALL INDICATING 6 ARGS TO THE IPC INTERRUPT HANDLER + JRST .+2 ;SKIP OVER FIX FOR ONLY 4 ARGS TO IPC INTERRUPT +IGFOUR: MOVEI E,5 + SUB P,[4,,4] ;CLEAN UP OUR WHOLE WORLD + ACALL E,INTERR ;THATS IT FOLKS, THE REAL THING + JRST DIRQ + +IGUG: .SUSET [.RMARPC,,0] + CAMN 0,[-1] + JRST IGUGN ; DISABLED, SO GO AWAY + SETZM INTHLD ; RE-ENABLEE INTERRUPTS + SUB P,[2,,2] + MCALL 1,PARSE + SUB TP,[2,,2] ;FLUSH OFF STRING "IPC" + PUSH TP,A + PUSH TP,B + MCALL 1,EVAL + JRST DIRQ + + +IPCBLS: PUSH P,A + PUSH P,B + PUSH P,C + PUSH P,D + PUSH P,E ;PARANOIA STRIKES AGAIN + PUSH P,0 + MOVEI E,0 ;CRETIN ASSEMBLER + .SUSET [.SMARPC,,E] + MOVEI E,IPCS1 ;BLESSES ALL CURRENTLY OPEN IPC CHANNELS + MOVEI 0,1 +IPCBL1: SKIPN B,1(E) + JRST IPCBL2 + HLLZS (B) ;CLEAR OUT ANY PARTIAL BUFFER WE MAY HAVE + HRRZ B,1(B) ;GET A POINTER TO THE OPEN BLOCK + MOVE A,0 ;GET THE CHANNEL NUMBER + HLL A,(B) + MOVE C,2(B) ;GET A POINTER TO THE BUFFER + MOVEI D,BUFL ;TO FIX UP THE BUFFER + MOVEM D,2(C) ;FIX LENGTH UP RIGHT + SETZM (C) + SETZM 1(C) ;FIX UP THE READ FROM FIELDS + DOTCAL OPEN,[A,1(B),2(B),3(B),4(B)] + FATAL IPC DEVICE LOST +IPCBL2: ADDI E,2 + ADDI 0,1 + CAIG 0,15. + JRST IPCBL1 ;IF ANY MORE GO BLESS THEM + + POP P,0 + POP P,E + POP P,D + POP P,C + POP P,B + POP P,A + POPJ P, + + + + +END +  \ No newline at end of file diff --git a//ldgc.bin.11 b//ldgc.bin.11 new file mode 100644 index 0000000000000000000000000000000000000000..cb46aeb0d1f66b77ea0849dfdbd62f524b036385 GIT binary patch literal 9880 zcmd5?hf^ERlAfL26+!`Ik_ZA8Awc9D3k=Z0_|dgGtSO-eys{ zdp~RPn9c$ml~>lQ=B%}k@r2EN)pNj<>MqOVDTiy0hlFqho-ImwyduIeJ(z!WY#dpX zJn=uZ+C?2rTRJWp@)NF&%N~n#pRbN(h}49$V<6Oz!6A3qS`Eg8;l65T$^`){!nwDw z%1aElJ?=DVg%ob(CUr*Ch$yRBz5q2Zd=qJ>g?Ai_y6KN7!-FYba4{Ibn=&CIy+^>O z2rVw;XGw$1u?1?(qz5QvG%Q37W~HIgSWgo@3_HDU`-4Jwn|J8lQyP+njfi*j$Hf#+ z7^F&pPzmME;#fmR?N*kx@t8`p0*fW|sytRT-M+UDd@do(QfqcKpoMZ?TB~?zofxHu zdpkfdTKtNo-0pNA-L0?yS|C*Da8?B3W(5#btdcP*s46Hb&Cu&REa3^w!beuxVaFR$ zB;5Ly8f3m~T<-6Em<@+AG2p8)hm?71%m|jeyg**1&%e49;0MNjL7S&>HQn@?9|l1t z%;d#9QoA(ZU3W{nVz3jveSTWfM=lZ5CqmR4?L>i%E%HKMEnXEr)(M0D0JFEi(YzS+ zcvRqPF^!z*W6TB?179OkkkVuU!bGFqvz;-*MD_f}>*~hw9sMl=!q7}HBdFeZ;2^2I0uZh9KnDG`=#P>mD|LU4sMvvi*9LsurI;NI*eOzf1h1lJ1_mOp z^4h2{CwrmRP%AR1bnJ|7W8VZBlO-r z0%ZAbFh?AN0eWEZu>10H@)Ph`8$$m)4YH^{5-L_L^Jy^wqF5qsJyZ%ZNYej~;JZD; z{D3e{vHyIo)mlA((RBVBJSNM3D6AT!a0*jO|~Biu@0dMrz0#6GmN~mlRs~OmVckdX*SIhcN-O#$H12{HQ}-Fb(0~! zfdDN9mLoQrm`HpG?T|i6vL33>Cp<6_l2>TrVyX-*urAoO2r7-whxZdZiAkf z-DPKUiJ&f97#hax)2YMFZs0ov>2p6qCQ)3&KiH9R0Yo_Orik1lJm6aEB1?QyPrK4 z^B!?mUR~wzlvmr7`(5|O4@FEE`7!W|^08nNe-q~C*1)5%*9yhNYcn`N2xD*ecZr}? z%1i&t%WpAH{_Ka)q<{bR@(o8(ROn;>?|*QRyrlp8Z_3buj(^KhM`3<$xVnruar!X~ zIZ-j*PQ&7usn@ZlT8tghSW_*Jxv@3xJ|L6u(-(c6PNrPfBL@deEtl*zF2FhJpU%03 zb7+i^nppVOIfH%r8{jaXMHzeRw-^5~_5av8SL7UMFX4^?l;5C7UuZ5O`l2yDHci5RD9i7j<2uBSLTccH)K+SB+b7C zL_#YmgXV-tBx5TqZ#KRZ%d;GXN2||Kh;Ed=DDK%NUjM>EqE-?qV=cBGOBpOAnTW5X zVr#GZ|G}}6FxC=@Wn-4$CV_rAlr(~K8%xQ~SDpaQ#xXqj_m@iTUJdPE(yXdW>a zOOY6I5Lpn-OK42zwgdby^D@NdUs4zbPv)`AMUv5_R|NW6eC;Qa%lI?7J|VfRF_!!` zxmw#2Z^nTaJb0Cl9J~)?MZ)34xk-bxu{& z$tA>@yR6)+T4U7xpMg@`!!2GHsI()wbD@EXyEC0X>OuKk(Ze2|J#g;aexJfv)EP|W z0-%=N>0HSTsEu=a2xp|({(#p_r}wFim51t&O9EraIzjj@O?PtYDT*cg?z6j3W1w_5 zx*JfZE<&{nN;tPWpJJeHT6u?%xEDb|jMo{IR9A zw!PiG|D*doGE6RAG|v46vNsy9m?)M;{nEwH5X=y5U60zdsHH8RIhdCxrt2T~-f&bv zC{OfuJ?@SFHy-+bp5FgM4>d%>z98Eh7-`#2|1Ug*^R#ff$mjWYFTd#4AjHe@%gc+f zBMl3`m-|Z^3tdqLkIr6Sp$DmuD+jgIW7&j59SmP|g4zzJs+J7q($l%hd93@a4lZpD zfU1+*&spl$Y>H1V89`7Yq@VdRaZoqvR%(xX$6lEosUc)GF`_4{CJgYF+XlX;PQg1{ z(6*(Y43yGE$)?oygf5O-8J`v`?|&c;#jg&|r)t5wr#?l7SqfdyUlFKP-Mv^RvfB01 zVGi25)y}5u0mi0ew&HUDRR0^K>6s@W5LuaRn`NX8(e1KBG$694vda8Ob_nrB3$iA&aXsgf1cRtCMx2eJP4{W6wPTX%_6N4daJ?Tdi^7dgbpZ)9dp|aA#qH9%k24)Yc zLOU}i5n@VT{&^jT9Z|U>EsM^pT3&whZ2cRgrqjmS`qaULFCQRfS|2^B&_IpP+v1_~ zJihI!35>PstBw60P~8-dB=b7e(29@IzgGw2cJ@Xx{IarjGUB6!YA_{};Lz0U8eCu# zbBO)~sIDSXeQEsi0PAuzdqCU0O$=zk)c{*A^qFhp6k}gv=M@3&MV+2+zN-$#Cr=&j zGn!T2k+vqrr|ZeY#xvxtsomx%U8QWIwun!Ef1G5=wfae4btibqFYi5U<+9v8uVIU( zG;^(miqa;26j90L%mlC~LDbO#X78zbyg5+g`eFMgf@F5Sj36vO)UcOLe z3%cm3p38pDoMD-r)J`Dff_#-`d2{OZSepSmTzbl<1F6VRUTJLGj=pg3XUluTDerwB zEt7&OYKK1@P3r0BMGm|{c!)83h;of!tRc7h>D>h5qw4+^#h9P`x3L83qZ-`sJVV>> zi1)GQ0fI#lK~b+y=NHS6t=&6O7dQu@h`%N(S{;lFR72Gzk-f>GIRJzqa@ zHE!!?=U2?3%H75Mj`a1uW^TUVKMTFS{8-6ZGJ&Xa4%Gq+&-U1o4mYGIAZ0U8j;7} zav4ya3xV^yFyqtL#&20lyPQwd4Pdsuh$=d<*N~zi;VPhdQg@C|uduEwoUC8M6^cGi zkcU|BpxiwRu}?kv=E)UPCGx?04J@Lnh&ehDWxHk zZdu2oKGSl8+)xrld{l!vSNx^VILKP{i(IP&f(Oz8y*AOKeeG-S0n+&*zRE~*50Ho> zT6f5MPG_X9Vfu!KG@&OBV{Bzh%+*}igLOhyFWo|$Qu+ox*}>?0X!eHl)UL0*vv%Ns zY_1OT?Cq~r**eAkqxyZdXnf8PKvfe?4PBu(BfZP1%2McvR&5TsTA()iYLVzbO=I^F zoANZ;&NH+5R?P=mbNN=!uAvK6_bS7#}#lC@8~Z1 z!uYh{x0+MTmh11ktlBRHf(ndv(7x-ytdhZ44r6utXf$8vMFe_!+wFmEbGn?qLfk|X zokAO|_XAL|4(epypK{Fvapn1 zGo8QL6tsOnZE=oQHyjS^-!r}!u@~4i%r3Oq^=DIPg8IGodp91Rvhm=DF+xhn3kx*hJg+k^8e%t3Jp!szIBmS2ypE z*|rireJGH{%Jm!c)HktTD%GvqXXsFtib%1S@XjzQcTeq%phsVy>|ts~YrQf#Cl$H7 zVAVPMlsVd{>pOxcg(7Qvtn;ns2(kst3dD-WBowD zc8uc$gU6Lq>SHY|LvqOVF$a!!dV1M9f7@l$JYg$mNnS$$vup6$EO>vZo;5pr%_Zj+ zatqM$h&*7--c!XE_yvEvWYOOxbkxpUf;yNmoBU|rGNUqY?eB4zjKVu_zB~LU& zCsR7|CgzqMlqE?69A!m2)K2-_1yoLS9=yN&LbURFyUh{iZ7L!Noit8gSoP7|T5kvM z37zp)2RcDHuJMT&pfe>Fg|^Lb(&MGRoq8^PJ!fIA1_JibiPn1X9teak=VJMq#%_Ul zC`Z883Cck=X!Q{u+B;SD=@I3Smwn))9@Cml{&KGjzTQ9f-19)NMc%dSXryR`SY8b* zLQaYe-L-oou&#+JPtAd{>66O~jPI_1^gvJVgF1QSJ<1V>azT1WNiJcjPu4aM zTKKYSrzXbutaW4ET>+mD6rD^q(F%N=C24r=6zlHw6>k8Pn2{$V*2zhp)Na@ZC-S7# z>RH>1n5oKY*lQz^y~Ge&jdAYMSaq0@-d6VQDOGSEb<*j4r=@NDuzH4t`=N40v+#}P@;xEWk0L6LLJ?Jq zI(X_hK~?PPNqw8Ke4vxb%iU(9KDBD~z+NrtyJGJ)zd>KXj7Y<$^sj+b-Pli+V|)W} zfQnP!ZsDuj*>iN)Sn<8zDdFDsSZ3Qb69|ssE5=s?iu=wM>QI`w&Ohtvgw-|A0Kp=( zo#`vpmX+glU&!Bf)b7|3%hUfvg&kNq3@3i%3{s|uB0f6f$9d10{rzp>YyN&d{c!ZNvj4Q}$sM-Ru3xt9vDY5dj;Z{8Uq4d5 zltRaio>>{-^XPJ8Z_SN0X=;P5ZzD7b%UuOzP zy}BGc;MqoeTVicy>7sk*kn!1U&wlQ{4&+>PoRJ!+D4cI%bgseiOu0clNbKw)i+=;B zo_h4~^^Uzh*_J~_v=mTP##S-}3P19O)oD2i%a|SV>gfjVy%qU8soi%5YUgZLw zgyr;~L@26Vz*4Fwwft8w_=@l6&EZtb!#<>#GW#^ZJXU+=kqSiMfZ^4cxAmwg}zdKs!i zy*B8+KTFg9kf6@@u-VEXKgGlHU)P4?!|J-Ae@7FpU@TZqN!M}vW4yhe{+|G)5r2|@ U-YTW9@i|&j{Jk{OM`Ql|7d@B$3;+NC literal 0 HcmV?d00001 diff --git a//ldgc.mid.100 b//ldgc.mid.100 new file mode 100644 index 0000000..d2f1c6a --- /dev/null +++ b//ldgc.mid.100 @@ -0,0 +1,504 @@ +TITLE LOADGC MODULE TO LOAD THE GARBAGE COLLECTOR + +RELOCA + +.INSRT MUDDLE > +SYSQ +IFE ITS,[ +.INSRT STENEX > +XJRST==JRST 5, +] +IFN ITS, PGSZ==10. +IFE ITS, PGSZ==9. + +; ROUTINES TO GET THE GC DO PDL OVERFLOWS IN GC AND ALLOCATE SPECIAL +; BUFFERS. + +; IMPORTANT VARAIBLES + +.GLOBAL PAGEGC ; STARTING PAGE OF GARBAGE COLLECTOR (PAGES) +.GLOBAL LENGC ; LENGTH OF GARBAGE COLLECTOR (PAGES) +.GLOBAL SLENGC ; LENGTH OF MARK/SWEEP GARBAGE COLLECTOR +.GLOBAL MRKPDL ; STARTING LOCATION OF MARK PDL (WORDS) +.GLOBAL STRBUF ; START OF BUFFER LOCATIONS (WORDS) +.GLOBAL SWAPGC ; WHICH GARBAGE COLLECTOR TO LOAD + +.GLOBAL MARK2G ; GENERAL MARKING ROUTINE FOR TEMPLATE STUFF +.GLOBAL MARK2A,MARK2S ; SPECIFIC MARKERS IN SGC/AGC +.GLOBAL SECLEN ; LENGTH OF SECTION GC GUY +.GLOBAL MULTSG +.GLOBAL SECBLK,DECBLK,GCDEBU,DEBUGC,NDEBUG +.GLOBAL FRETOP,PURBOT,PURTOP,GCPDL,LPUR,STRPAG,CKPUR,INPLOD,GETPAG,CURPLN,SGCLBK,PGCNT +.GLOBAL LODGC,CKFILE,SLEEPR,KILGC,GETBUF,KILBUF,GPDLOV,GCDIR,INTDIR,GCLDBK +.GLOBAL OPBLK,SJFNS,IJFNS,OPSYS,IJFNS1,RBLDM,ILDBLK,TILDBL +.GLOBAL TMTNXS,C%1 + +IFN ITS,[ +IMAPCH==0 ; INTERNAL MAPPING CHANNEL +MAPCHN==1000,,IMAPCH ; CORBLK CHANNEL +FME==1000,,-1 ; BITS FOR CURRENT JOB +FLS==1000,,0 ; BITS TO FLUSH A PAGE +RDTP==1000,,200000 ; BITS TO MAP IN IN READ-ONLY +WRTP==1000,,100000 +CRJB==1000,,400001 ; BITS TO ALLOCATE CORE +CWRITE==1000,,4000 +] +IFE ITS,[ +MFORK==400000 +CTREAD==100000 ; READ BIT +CTEXEC==20000 ; EXECUTE BIT +CTWRIT==40000 ; WRITE BIT +CTCW==400 ; COPY ON WRITE +SGJF==1 ; USE SHORT JFN (LH FLAG) +OLDF==100000 ; REQUIRE OLD (EXISTING FILE) (LH FLAG) +FREAD==200000 ; READ BIT FOR OPENF +FEXEC==40000 ; EXEC BIT FOR OPENF +FTHAW==2000 +] +; GENERAL MARK ROUTINE FOR TEMPLATE STUFF. GOES TO RIGHT PLACE IN +; WHICHEVER GC'ER WE'RE USING AT THE MOMENT +MARK2G: SKIPN SWAPGC + JRST MARK2A ; INTO AGC + JRST MARK2S ; INTO SGC + +; ROUTINE TO LOAD THE GARBAGE COLLECTOR + +LODGC: +IFN ITS,[ + MOVEI 0,GCLDBK + SKIPE SWAPGC ; SKIP IF SWAPPED GARBAGE COLLECTOR + MOVEI 0,SGCLBK + MOVEM 0,OPBLK + + + .SUSET [.RSNAM,,SAVSNM] ; SAVE OLD SNAME + .SUSET [.SSNAM,,GCDIR] ; SET SNAME TO APP DIR + .OPEN IMAPCH,@OPBLK ; OPEN CHANNEL TO FILE + PUSHJ P,CKFILE ; SEE IF REALLY LOSING + HRLZI A,-LENGC+3 + SKIPE SWAPGC + HRLZI A,-SLENGC + MOVE B,A ; B WILL CONTAIN PTR TO CORE + HRRI B,PAGEGC + DOTCAL CORBLK,[[RDTP],[FME],B,[MAPCHN],A] + PUSHJ P,SLEEPR + HRLI B,-1 + SKIPN SWAPGC ; IF SWAP 1 PAGE FOR CORBLK ELSE 3 + HRLI B,-3 +GETIT: DOTCAL CORBLK,[[WRTP],[FME],B,[CRJB]] + PUSHJ P,SLEEPR + .CLOSE IMAPCH, + MOVEI A,LENGC ; SMASH PAGECOUNT + SKIPE SWAPGC + MOVEI A,SLENGC+1 ; PSTACK + MOVEM A,PGCNT + POPJ P, + +; SEE WHY OPEN FAILED + +CKFILE: .STATUS IMAPCH,0 ; GET STATUS BITS INTO 0 + HRLZS 0 + ANDI 0,77 ; AND OF EXTRANEOUS BITS + CAIN 0,4 ; SKIP IF NOT FNF + FATAL CANT OPEN AGC FILE + +SLEEPR: MOVEI 0,1 ; SLEEP FOR A WHILE + .SLEEP + SOS (P) ; TRY AGAIN + SOS (P) + POPJ P, ; BYE +] + +IFE ITS,[ + HRRZ A,IJFNS1 + SKIPN MULTSG + HLRZ A,IJFNS + SKIPE SWAPGC + HLRZ A,IJFNS1 + JUMPN A,GOTJFN + +; HERE TO GET GC JFNS +; GET STRING NAME OF MDL INTERPRETER FILE + HRRZ A,IJFNS ; INTERPRETER JFN + MOVE B,A ; SET UP FOR JFNS + PUSHJ P,TMTNXS ; MAKES A STRING ON P STACK + MOVE D,E ; SAVED VALUE OF P STACK + HRROI A,1(E) ; STRING FOR RESULT + MOVE C,[211000,,1] ; GET "DEV:

NM1" FROM JFNS + JFNS + MOVE C,A ; SAVE TO REUSE FOR ".SGC" +; GET JFN TO AGC FILE + MOVEI B,[ASCIZ /.AGC/] + SKIPN MULTSG + JRST .+4 + MOVEI B,[ASCIZ /.DEC/] + SKIPN GCDEBU + MOVEI B,[ASCIZ /.SEC/] + SKIPE SWAPGC + MOVEI B,[ASCIZ /.SGC/] + HRLI B,440700 + ILDB B + IDPB A + JUMPN .-2 ; COPY ".AGC" INTO STRING + HRROI B,1(E) ; GTJFN STRING + MOVSI A,SGJF+OLDF ; GTJFN CONTROL BITSS + GTJFN + FATAL AGC GARBAGE COLLECTOR IS MISSING + SKIPN SWAPGC + JRST .+3 + HRLM A,IJFNS1 + JRST JFNIN + SKIPE MULTSG + HRRM A,IJFNS1 + SKIPN MULTSG + HRLM A,IJFNS +JFNIN: MOVE B,[440000,,FREAD+FEXEC] + OPENF + FATAL CANT OPEN AGC FILE + MOVE P,E +GOTJFN: + MOVEI D,SECLEN+SECLEN-2 + SKIPN MULTSG + MOVEI D,LENGC+LENGC-6 ; # OF TENEX PAGES TO GET IT + SKIPE SWAPGC + MOVEI D,SLENGC+SLENGC + MOVSI A,(A) ; JFN TO LH + MOVE B,[MFORK,,PAGEGC+PAGEGC] + MOVSI C,CTREAD+CTEXEC + +LDLP: PMAP + ADDI A,1 + ADDI B,1 + SOJG D,LDLP + + MOVEI C,0 + MOVEI D,6 ; THESE PAGES WILL BE THE GC PDL + SKIPN MULTSG + SKIPE SWAPGC + MOVEI D,2 ; PDL BUT NO FRONT OR WINDOW + MOVNI A,1 + +LDLP1: PMAP + ADDI B,1 + SOJG D,LDLP1 + + MOVEI A,SECLEN+1 + SKIPN MULTSG + MOVEI A,LENGC ; SMASH PAGECOUNT + SKIPE SWAPGC + MOVEI A,SLENGC+1 + MOVEM A,PGCNT + POPJ P, + +;ROUTINE TO "SLEEP" FOR A WHILE ON 10X/20X HA HA +SLEEPR: SOS (P) + POPJ P, +] + +; ROUTINE TO LOAD THE INTERPRETER +; C=>LENGTH OF PAGES +; D=>START OF PAGES + +LODINT: +IFN ITS,[ + .SUSET [.RSNAME,,SAVSNM] +LODIN1: .IOPUS IMAPCH, + .SUSET [.SSNAM,,INTDIR] + .OPEN IMAPCH,ILDBLK ; OPEN FILE TO INTERPRETER BLOCK + PUSHJ P,CKFILE + HLRE B,TP ; MAKE SURE BIG ENOUGJ + MOVNS B ; SEE IF WE WIN + CAIGE B,400 ; SKIP IF WINNING + FATAL NO ROOM FOR PAGE MAP + MOVSI A,-400 + HRRI A,1(TP) + .ACCES IMAPCH,C%1 + .IOT IMAPCH,A ; GET IN PAGE MAP + MOVEI A,1 ; INITIALIZE FILE PAGE COUNT + MOVEI B,0 ; CORE PAGE COUNT + MOVEI E,1(TP) +LOPFND: HRRZ 0,(E) + JUMPE 0,NOPAG ; IF 0 FORGET IT + ADDI A,1 ; AOS FILE MAP +NOPAG: ADDI B,1 ; AOS PAGE MAP + CAIE B,(D) ; SKIP IF DONE + AOJA E,LOPFND + MOVNI 0,(C) ; GET PAGE-COUNT + HRL A,0 ; BUILD FILE PAGE POINTER + HRL B,0 ; BUILD CORE PAGE POINTER + DOTCAL CORBLK,[[RDTP],[FME],B,[MAPCHN],A] + PUSHJ P,SLEEPR ; GO TO SLEEP FOR A WHILE + .CLOSE IMAPCH, + .IOPOP IMAPCH, + .SUSET [.SSNAM,,SAVSNM] + POPJ P, ; DONE +] +IFE ITS,[ + HRRZ E,IJFNS + MOVEI A,(E) ; FIND OUT LENGTH OF MAP + MOVEI B,0 + SFPTR + FATAL CANNOT RESET FILE POINTER + MOVEI A,(E) + BIN ; GET LENGTH WORD + MOVEI A,(B) ; ISOLATE SIZE OF MAP + HLRZ 0,B + HLRE B,TP ; MUST BE SPACE FOR CRUFT + MOVNS B + CAIGE B,(A) ; ROOM? + FATAL NO ROOM FOR PAGE MAP (GULP) + PUSH P,C ; SAVE # PAGES WANTED + MOVN C,A + MOVEI A,(E) ; READY TO READ IN MAP + MOVEI B,1(TP) ; ONTO TP STACK + HRLI B,444400 + SIN ; SNARF IT IN + + MOVEI A,1(TP) + CAIE 0,1000 ; CHECK FOR TENEX + JRST TOPS20 + LDB 0,[221100,,(A)] ; GET FORK PAGE + CAIE 0,(D) ; GOT IT? + AOJA A,.-2 + HRRZ A,(A) + JRST GOTPG + +TOPS21: ADDI A,2 +TOPS20: HRRZ 0,1(A) ; GET PAGE IN PROCESS + LDB B,[331100,,1(A)] ; GET REPT COUNT + ADD B,0 ; LAST PAGE IN BLOCK + CAIG 0,(D) + CAIGE B,(D) ; WITHIN RANGE? + JRST TOPS21 + SUBM D,0 + HRRZ A,(A) + ADD A,0 + +GOTPG: HRLI A,(E) + MOVEI B,(D) + HRLI B,MFORK + MOVSI C,CTREAD+CTEXEC ; BITS + POP P,D ; PAGES + ASH D,1 ; FOR TENEX + +MPLP: PMAP + ADDI A,1 + ADDI B,1 + SOJG D,MPLP ; MAP-EM IN + + POPJ P, +] + +; ROUTINE TO MAP IN OVER GARBAGE COLLECTOR EXPLICITLY + +KILGC: +IFN ITS,[ + MOVEI D,PAGEGC + MOVE C,PGCNT + JRST LODIN1 +] +IFE ITS,[ + MOVEI D,PAGEGC+PAGEGC + MOVE C,PGCNT + JRST LODINT +] + +; ROUTINE TO TRY TO ALLOCATE A BUFFER +; 1) IT FIRSTS LOOKS BETWEEN FRETOP AND PURBOT +; 2) LOOKS AT THE INTERPRETER +; A=>NUMBER OF BUFFER PAGES (CURRENTLY ALWAYS 1) +; B=>BUFFER +; BUFFER SAVED IN BUFPTR + +GETBUF: ASH A,10. ; CONVERT TO WORDS + MOVE B,PURBOT ; LOOK FOR ROOM IN GCS + SUB B,FRETOP + CAMGE B,A ; SKIP IF WINNING + JRST NOBUF1 + MOVE B,FRETOP ; BUFFER IN B + MOVEM B,BUFPTR ; SAVE BUFFER + ASH A,-10. ; TO PAGES + MOVEM A,BUFLT ; LENGTH OF BUFFER + POPJ P, +NOBUF1: ASH A,-10. ; BACK TO WORDS + SKIPE INPLOD ; SKIP IF NOT IN MAPPUR + JRST INTBUF + PUSH P,A + PUSH P,E + JSP E,CKPUR + POP P,E + POP P,A + MOVE B,PURTOP + SUB B,PURBOT + SUB B,CURPLN + ASH B,-10. ; CALCULATE AVAILABLE ROOM + CAIGE B,(A) ; SEE IF ENOUGH + JRST INTBUF ; LOSE LOSE GET BUFFER FROM INTERPRETER +IFE ITS, ASH A,1 ; TENEX PAGES + PUSH P,C + PUSH P,D + PUSH P,E + PUSHJ P,GETPAG ; GET THOSE PAGES + FATAL GETPAG FAILED + POP P,E + POP P,D + POP P,C +IFE ITS, ASH A,-1 + JRST GETBUF ; TRY AGAIN +INTBUF: MOVEM A,BUFLT +IFN ITS,[ + MOVNS A ; NEGATE + HRLZS A ; SWAP + HRRI A,STRPAG ; AOBJN TO PAGE + MOVE B,A + DOTCAL CORBLK,[[FLS],[FME],A] + FATAL CANT FLUSH PAGE + DOTCAL CORBLK,[[WRTP],[FME],B,[CRJB]] + PUSHJ P,SLEEPR +] + +IFE ITS,[ + PUSH P,C + MOVEI C,(A) ; PAGES TO FLUSH + ASH C,1 + MOVNI A,1 ; FLUSH PAGES + MOVE B,[MFORK,,STRPAG+STRPAG] ; WHICH ONES +FLSLP: PMAP + ADDI B,1 + SOJG C,FLSLP + POP P,C +] + MOVEI B,STRBUF ; START OF BUFFER + MOVEM B,BUFPTR ; SAVE IN BUFPTR + PUSHJ P,RBLDM + POPJ P, + +; ROUTINE TO FLUSH A BUFFER WHEN DONE WITH IT + +KILBUF: SKIPN B,BUFPTR ; SEE IF BUFPTR EXISTS + POPJ P, +IFE ITS, JRST @[.+1] ; RUN IN SECTION 0 + CAIL B,HIBOT ; SKIP IF NOT PART OF INTERPRETER + JRST HIBUF ; INTERPRETER +IFN ITS,[ + ASH B,-10. + MOVN A,BUFLT ; GET LENGTH + HRLI B,(A) ; BUILD PAGE AOBJN + DOTCAL CORBLK,[[FLS],[FME],B] + FATAL CANT FLUSH PAGES +] +IFE ITS,[ + ASH B,-9. ; TO PAGES + HRLI B,MFORK + MOVNI A,1 + MOVE D,BUFLT + LSH D,1 ; TO TENEX PAGES + PUSH P,C ; SAVE C + MOVEI C,0 ; C CONTAINS SOME FLAGS + +FLSLP1: PMAP + ADDI B,1 + SOJG D,FLSLP1 + + POP P,C ; RESTORE C +] + +FLEXIT: SETZM BUFPTR + SETZM BUFLT +IFE ITS,[ + PUSH P,A + HLRZ A,SJFNS + JUMPE A,.+3 + CLOSF + JFCL + SETZM SJFNS + POP P,A + SKIPN MULTSG + POPJ P, + POP P,21 + SETZM 20 + XJRST 20 +] +IFN ITS,[ + POPJ P, +] +HIBUF: MOVE C,BUFLT + MOVE D,BUFPTR +IFN ITS, ASH D,-10. +IFE ITS, ASH D,-9. + PUSHJ P,LODINT + JRST FLEXIT + +; HERE TO HANDLE GC PDL OVERFLOW. ROUTINE USES A,B AND ASSUMES GCPDL IS THE PDL + +GPDLOV: HRRZ A,PGCNT ; # OF PAGES TO A + ADDI A,PAGEGC ; SEE IF ROOM + ASH A,10. ; TO WORDS + CAIL A,LPUR ; HAVE WE LOST + FATAL NO ROOM FOR GCPDL +IFN ITS,[ + ASH A,-10. ; GET PAGE NUMBER + AOS PGCNT ; AOS + DOTCAL CORBLK,[[FLS],[FME],A] + FATAL CANT FLUSH PAGE + DOTCAL CORBLK,[[WRTP],[FME],A,[CRJB]] + PUSHJ P,SLEEPR +] +IFE ITS,[ + ASH A,-9. + AOS PGCNT + MOVE B,A + MOVNI A,1 + HRLI B,MFORK + PUSH P,C ; BETTER HAVE A PDL HERE + MOVEI C,0 + PMAP + ADDI B,1 + PMAP + POP P,C + +] + HRRI A,-2000 ; SMASH PDL + HRLM A,GCPDL + POPJ P, ; EXIT + +IFN ITS,[ + + +GCDIR: SIXBIT /MUDSAV/ +INTDIR: SIXBIT /MUDSAV/ +GCLDBK: SIXBIT / &DSK/ + SIXBIT /AGC/ + 0 ; FILLED IN BY INITM + +SGCLBK: SIXBIT / &DSK/ + SIXBIT /SGC/ + 0 + +ILDBLK: SIXBIT / &DSK/ + SIXBIT /TS/ + 0 ; FILLED IN BY INITM +] + + +NDEBUG: SETZM GCDEBU + CAIA +DEBUGC: SETOM GCDEBU + HRRZ A,IJFNS1 ; GET GC JFN + SKIPE A + CLOSF + JFCL + POPJ P, + +IMPURE +GCDEBU: 0 +BUFPTR: 0 ; POINTER TO CURRENTLY ACTIVE BUFFER (WORD) +BUFLT: 0 ; LENGTH OF CURRENTLY ACTIVE BUFFER (PAGES) +PGCNT: 0 ; # OF PAGES OF MAPPED OUT INTERPRETER +SAVSNM: 0 +OPBLK: 0 ; BLOCK USED FOR OPEN + +PURE + +END + \ No newline at end of file diff --git a//main.bin.9 b//main.bin.9 new file mode 100644 index 0000000000000000000000000000000000000000..d6543632946f641944f7ca1418594ae52c33ee16 GIT binary patch literal 97590 zcmdRXiCYsr_jWpMk(~l6ixh@M1r#W#fD1YxASkjUi^}4PE8xB${nx+yKAFjMpuE4* z()YXGT+f5knM`t$`#vYh$ug?$mr}pKzMW|-{qsUeI8%0I%DpP>y|1qd$`*EQxr~&3 zyr{3DWiK}zxfhiLimP|^&qzsaVZS^mDBHdIO0L3XXDBI>EN2zES z7ix3!Ofq=|7tsrs6Xm~lUVjRmqkI+w2w8R`p4hlnSMTxkqD0E_WV*)=vZuDNa&*Ms>Ac8u>H=+ZGd`2QmJpPROkr_`p zsL}$-_lk|5@%eknN0hH5WQ8nOAWGFRy7Z*LZo`#G)$ibnLdN_nCa>SP!YgG(LMcBb z5Bn1C$ICY>N2EmYSJAg6b_9aU)A+~Y7i_D{&*U%3(%+Se%)i8hbJZ-aBersU0TzlBtN;p+E1e2{o8d zVWzzMi0{c$iC3-T#gux~SM#r(5=gvs5)}Kzitk>kXZ0)9a%TATni^~en7dbIork<9 zf|u=9g@ib&DzUd-t!izhYWY-IgX+A>vtQx@t%hnk(A zJIObyc16|f#q4r08;szinu>D|-nTYfJbUk##FPiRtVG5Kdc$n((++{RO(sS8lilpM##7E0ac;vnQt6QwB^q2tD}CRtmkjcR_eJ} z>KTw#Mi0FPSsMSahNvJ9QK#U6pQR))HMy`jHqFZbJ1e8|&OvjBbK7HQWyE7=Wz=IQ z<7sy8f20^>XIe3S_|j*?P6#dx(coG4l1XM1ks>tN-92Glbs15VG9!SZpMOi$<&C1X zr08o^+pcOI8(G#g!Cs5?CLLkCK*!m4!^zuzEe(~kx_+P(DvIDuxVS)im(>Q+;kh?sPr;`Tc zs|MsQ12W=ikpF%+Ag9ZG#xGH>AlDOQ-RUC8H%|gG#6=*;bN>~P>t==H6&4ucfYLF{Qpc_v^-F$i-Ni|iJ zH+HtxH@vUfm#z(yLI9D-tCzfPU6}k;Sm6VZ9i2FW+S&pnbza-@kAYIq#8!{3-B>BppqadGO5|A$s)lWY0Kt8|dfqZ_+1DWwO z$RGZ(!U%HO%rE;T$_8XRrL}5f9*ZJ44B0!7FypQ>#YKQ2d)JX)eA|fcs;VngZ7LE8 z$Mkp$T-8?U224=9*rr1U>Lyg{lD19zcON_z+vHH@_>G#MdK@ZNYO(xg)i=LRv$9R+ z-$}|rmYnxl@_+Ve&cE}TyUF{8CEJE2?+i;2&t=K5VM)5otNjw?%90MUWScdoz>@7x zCt(T1MIcMg<(DO$WXXc6O{h+cRb7yI(P{dzA?e+e&9)SF_?43#-2WUV9faFDc2GSz zeSc#3=&JeX0no2omEuC6W4I5rap0=&(UH+^{Jbm>))5!d~$ zF0at@MR(!y@`c+ejcay{xQHwcGXkBH3En+AxRtgyFu1KjBs5&B6`yKX4H?=D87>+! zAf8JGab2;yP?Ik6<HRjRAk_Z{Z!$L$_ z^e{Kj1`Nb^DjNMZ;HL24Tv_LAxnE(~@!+w;qE;C9JN%fneJAF@W5a`Yh6huI2agR8 z5YOeoS;K>L5_J2;%C!v`AP+DjfB+u6{d*D~KwJd!KwNP7Q~N>kV2nPkL5o@XZGa$M z*>w3}(yx;2klu2bauDgp1SkP%>P#_c}EMF1mSh&Mie_I{X*xWjJVFmTpLALyYzI`o!w z=pPLY9}M~Rk{#TKXV=lZSG@>!=u`ZEQ*Z#<0ec^h3(}hp>m4)7k2e^k;|6KObCJGi zkWQERhF_vwkscw^4Xi#vy7?qXLtF$Ry~Wq^hx7=MzOCv8)d*Hz6l(w9T#Hgw{vgf( z@6K9sB15mnuy7?$yK#m8AgOr`h9Uv)0Fu)8;-!rT7z*N^OnXWr(qI1NZKq%3*>Q;W z>9EO|KGtN+j}4D@Ee?-NjRlF+D?}{p)N6=@c$!Gd+lEN#BzWi-D_0^t zB#}^W2s9bdlMo5wB9KTjTbe&2JtUE?(PTU{CZpak$C!*{jbAU>!42FHDpE%TRkuzI z_n3kEfq{F}z&&Q*Mm!g8c#pJKD4tG&e!p0`!u^PFkFt=2du!(;a6?=K!Yy-I`Gb3k zaQCXZb~WWhLWMCwTIN0z!@7wZZZB%vZ?(?`SXPlnlu=Q8^m87A@4$x?QD%-#}Nq+m3R;`7MR zLmG#;2xN98#myhHUy#`sRP8VIVnW$Php8+CUbB9=2CoMrYmgA4d6a+EE|ljzchFDo zd09crlX1T$vod{+AqV*csZx1xtm(67=V$JZEi4=&NF(~=7`_yI*qFcNnZ8El5u`EX z5rpwHL6&6EC_OA`CHUhPE7z9uHS=H@wdt!nf$5{T2q4IoED*>aLEexcHL9*wy_txW z9wCUo%$a@V2Y#>l5J3je%&ICn-C=G*#pKHi{t-647W)!iEgNm~Yd0&>w4QU2MUXV5 z?`0t=ZgUYa*y#s*a@yDx+zptP)^oy~P4%oDeHv|ATF-jSX+7sLhw(IX#_xEhC9N25 z{IccBoDX15>scuWOv^Kr%Fc9|GsQ&!bDqJuZ0FImd?0hG*l2#3s0uj|j}dMw>HTyq zh|oeBr5Xq&UL1DIA{$)k6}2p^2**!&_t4ec5fdczkvH@R&4wi!uo0z;@$NWE{alNn zXCYCPjeBf$BW!i0!}ojX?CW!7s!plzss+qkivUJ@6mQ%>9$#)Lbm`<>wwG?p33ZKJ zJwQ?e&M!TwEDiWi+`+qC;@vj_hJ8P%`4{ow&W_3*4il|N9XXUfIoAG-j*Sm5P0__1 zWO0YE`00&o-Vl;K=mGdq@T@b9TKi#Hsi}@!?inxYeR->h^M(WCL33TYw0Aodum(@Mai{0ERJyP z?nx{r#6=+2WXVI`+S*VQTs!y$e_|*airE@uL0Wg?dULxDL%0mO4DP)I0*0_h}3aku4YZbD~B0b#UI;POc* z0C5pWfv&uon@}Ms@Ez42D#YG2EMtP6YYG_5Q+yA!Im5Q4LJ{##UVCusQ_5U#c073P zAkjlSs1N$M8Nm(nW2n(!i}PA2u=X%siXN>?fmenCuMGtdPg7u2e0@TJbeX5P;Buuv z2`TVOL}!Z=I|&6KE&?ea9rgTKff7>S3pU<_N^0q9qJ!zCpl=*jGQSlg@WlfBUjNp9 z%G7Um!2fnwz@PyrI0^8-4e;>!y1@T3!2dSDBc2Pq3~mMZbeV^Jla?#+q_^~B~wA9(K45a7?tevSBz>i!rvZODkK3Z@`* z-nSM`fn8gm-)%wvS)7!NqPH084I1oC@LsVtEqC3Y&GHjJwBgZBOi}6GjypacSuw1w z%weJdhLwQm;CQstxc7RKx<-MVP>(auE8RZ0^>=FEXt zp)%=h{ylf&13<`W8**E-!}11suzsu)aC&CCYj}2cYVtm(!Mf7WqFHEh^X78ghh%wund zE}-9OVRzR?@~`}np@-fQ$Wez7gu`KXGd+w)mAF*I7$HKa$r;~nKIhk8c7~$OL0X3h zf=wG9>yF);9HmVx;~&1SUj4gSy`dE`qupI?ZSopx9KBZ?=C*06TFx74B2U*b%@JzaRrW-c&$_2*%fz#z zx;Xo#4H+7=0_|lovl;s5^&e4(BJ1Ecn$nkQ?P=_<^lLXO0(VS0Ogl)L{$pFZsjkWC zg+M2|V^a9C`J#0Ir#I-nRL6wj%cS88;<f(Z+$bgcxGtv+|UB?G%fmG zv7Ut%=_F`8Jz88ME#Qhq04)~xPhvqJE&^#GELM55AeTuCI8oa}mvxrt-K31M#Q?0W zHX({>Y_c-|dk)hN8i3)#j8B2+vu!j}*5V6C7K6BOerG-$WO=WE+I6=|&i zSG;$fuc|dn@~fdu73!17*52s3ADCPVq3Mkjs`*VkO-$g875Ouc9BrH(gT@Z`w0!M| zsjs%tL1}J*A+rlMl1at2dv@W96oy$1vU$I-OQ&b(cDU?n|-r6e#vwm82UP_WLZ zC|LAd+ZWhL-OP4IJO%4Chs7`+P{2_}y`MaLnpT3Jeidh-iH~LiQo>25!ACBgNl6c$&S;M8=*pqCzqqqnp!)uD0KQi1S8Sc{L-osQy z>fvf@swVmGx)WHdYe#U;z6A3HYpbgJW|xx(yi#@}uJEt2>?%ar0Iwn~EfvZAxt2ma zEx=J}T)d=g3`RrtS^QbUz5T=`+`Gc_z=VJJfh!w!k`}$1y}pLB%fJ7Aq-$GAK5CzdvkoFfmcs$KBXNG_21gnj9uuyw5`B^kfn38+wrq`69bNTd913h zyB-hwZ{Z#jc+!2#)>rdSEhNC{YD?C0p;Y+E@-p6*G%O##ls*53m5QNNWvg0?_beOf zaaCeyevZwF-pnWs`RvmCSl84H z7POBKPfpgIO?Ui2!wkmzi@Lk-vL(h*`XKZk|&j}KKc9)buaYd$=iok%A`tmn2$P4IoQIc z?4Lf?H)m0dVpkT0lb6~`PI7EuCucfzC1N3;4U^uq)U)L9UO*NcP8ame`B^e9PhJ{Z z46v?eNmz%Imv-Y`li#!Gv98A)%ENe?b@o3>z)@CO2~y4t$i~RDyPZIdo7)NOSrqAU z^3sx6xD2UBnGry}*^d7T_3A(~E3#Rsq{Y6`g4Vv>!Z2uXM1{5oTU6+dG*sPHZo74W zR?Tg#dfa;!*J0@v@tt%G-&}8fnX;uVE86zFbC_t5D(8b9xe#OMaI|CC^UmuSb{W@8 z&$eNSIh2R-T$adc5n)NX%unx7p3pX#xGj>SV>sPIq%$Q5#6=)M&gGXN+q6yR=#kq- z$1B#rUQ0)c@3l>L0z;11Pm~GJ(0w6@v?Ld5zQj1g7Wx!#y}oqAx9!<6;-kZo2N{tH z%5g`?g(*gfD+>(Sz~7Cxy2dja&Gvj`wo>C&QsV^gpTm1WS*$~b%+Hc>)%g7IC&?g)qns?&=}!7gRDh8G1zm(|m=7>K{C`ubFOq zxBP^#p*=BVH(>g{>Je^F$*$wqX;!pNR64APRH|$xam>&J?_OkwYEb=0LzbvChHT1X zNh0=$ufJ?sN|+Od7*DgLNv3tklC+tB@Jp0Ub7!ZFaKA7QsWgsoA4@Zvp&_HV2q4Ie zxM)<~e8^u&kP=l_82VCWqprz=ZSvq3uB^yWljaV|>_}7cpKwTqWLu+X7SZHMOJ~_w za~#?imOQKoeNA!HX2+6?4pR=Y1k)iH86xmN<-llcabj|z%iTbM=K-sd0IAR^zuvr! zgL&Ofd7{nm#T-J!crIT`siEwYC(?9R`2ukf$d}dp8kFDU zON1VW-*AsP!j~_4xZVN@dPmTg)!QiO=(Ag5%5jg3M|IB9L83P}(;WgJu)R?Ia=T1) zZJeQ`uO(>8~<8G6SYgBLf<@ON9A@0X&s_+ z>Ooe=wbK^GD0XF0>cf@qTdw~!qjoyc&TNGsIIGi^0Y~Dd!+Sxs(&s$MVgT_v`&lxs z8lHc!a7d$W3J!HmD~~T43vAALN|!yU4{Zs>P$qcuZAD~+ZUQZ;J9cB|ShfHCJ)Y}LY*sMR3@f35$@ zIu4_1x6Xz(k)LRk?#I@BzX4TL*0~!yony~))sH(6>M$o$8F8F`gegXeD+~Iu*S?=U z$$&h;i6xEnh|!P74(|o^qtEZhihlT6GOik5n!X<#kS89CepK6YH{h(+voZ;D{#C-9 zf5mvNe#qEG^dp@FJ$@DEq8}Het~~vi66x(LkLymdScWnqP(NheK;^5OVx6OYY^%C$ z>)cWOu!=qXuuAG5%&u2^`eBvIPl#yMrRql^`Z@G9d-`Ejh<>br{QC(E>mLq8E0ReY zbC@COOts(75#BpUFvad}#$*nGqkU*gIf$dy1mO}+Rs$uIHJ2~?LG^=!X$ zY&D526osARDV&6FXFAHKxCmq&TwHekrhhD(ta}cJvt>KXGT?9yz4B`#E6i_v*NLWL z{s$*;tuU*j+dJ_A8@+41>*!$l#&VHm&-9+5-*(? zr*{mOWs59QCLsOb!wHb4xClV{VbOmFY1_glY$Tw^aN+J)v5g;A^ON=$dnv1nvV;4V z!-NCP$)7VmhmQ3%hbcyhD~nRw@0UKDr0XZGv#!JfsYKw>UvyNK-#-pFZ6-^~t#Huu zgP?usFA~;O#zHGtnXa3*esk1Uzd7oQ@ignowkQFcwzLv_O{tAsTr?uM+qCsdZwB*- z|L%!#%Wy=1!}W1%%M`Me8G^yoPfs*<=J-sgv}A zC@uo2BJ|E*FQ}bVSz<4|y>b&-UV&|@m0oy!Zs{%i3RcI(8xJdU-8R>6J4h>Ns(zUE^qrwzItfygDVJWj#?3QT36Vbj_2ZW7gQpR6c++n+ zj(+QnG9!?GkMnD)xB~GXS0Gv)g$1FIf~j(SH+`JycK=DS(!ocioCnh%#d>F6pZT-G=65BauY^Pa0+dpauYz|H9M?9CnU53Ev zG9U0;gKP+Fr}X7{xNiR_%O|!|rZh5bW+5&Dxr<`idF;#IB6shTySHL(MX?yk)h_Fn zaGI5Mk3Wa}pDQ590Ld^Y%b0v0;{b?M5{pEJd61QLL*C#YX>|v$_Rpd){39#z{iXMY z{NmQ+B3Ny`Z!vl8O*y!>{pu!GJ6L0W547>@<>$8%!5Uv!Q1O%nAlZ>{!a-VxNSMll zqk7T8YSjHxU^!VtR%`tH6Zvfh1B4AwjBjS zi1*fi_(-B>svnRUf%+j`A(b}|%Q*F8K-D?cxJqCpV88=uo!10zfrp+helgsSy(8bO zgcwjc6|OV#ivowr;rqvtGd(RedNm~9fIX#mUm{cA;5~wQZD^l+bOFz-nV#|==catK zlpV*PIm{?%Xj}b6j~!)2C`PF(i&AgT-+3o9g_&~v8M76jTEvi%`9a!yNx493QOtb+*~`Up_wK8!wsB4xI@29%(<~xg5W4%zrvDQa%ol3&%Bh z9>?`!fTo7se{$?trW}XN2;_KWe%pWuJ9RVXei!t^NnKKCiMP>#oC+2MLmLD&etYEua|Xt}HlwY%J7MtF20A26>m+ zN{yF$WE}`Oycdw=7fz@P8f23t=ZAXZ?L}KztI!lQ8L=*Gj!Y?tKPcMFWT9o4E%ZiwHY8@6e zNQP7>j_t=%jB-~Nn9cdYij$a4ZmB?E70V7m_G9mKIJ_5>1$#1sX47QJxN7BLTC;hl zLz~S%pLZ4wJKGIA&FOZG=du%(>#{SQ7&)G9XUwKZ@39ki5gPt{e$;jnc0y(ZRvlc$ zb{@xhPsvW~MV_#pD*FMBBet;FhCNj=n=8KA6k=ZZS*9)K`ojGyZF{~tXGhGd4)Qrf zh6O*-V=ZQwVwAYDp!4~A^h6f(&Q)eBwTp>9TM03T9Nr5O6Z_f%7Sqp?ah32gXfcO` zljRS`qZl*kru@zw!%1@r-W|l#ocuFpIGIj@dnvV%gT>Uid7RXf_f6B+zse4Z4Evpw z8G)P}&Mzm|$;l>ia$U6@;p8)Nvg8Uarf@Po|6X%)YwqQATdtq^z2i76WsnD{C>&=j zqZFgel?9%ik>ZnaQnHoWmGcROlXGcgL4Q2JNk2=DJLN_0y!z}JC(QYB{x(3 z!)B@#YYWp(RrKXrZ)KE!?F;Icbo9SAC;MEhd2bR6C#;)tdeUmwwawRl)n#WfUpp*s zke&6%`b8I};WG%5;kA%qb-3wkogu@kM@$q0<2&YnzB`Dg$?#j8R!K(XvRwwJHTgIXNWXT1)^pjQ6eqCQN-9Mehk*Tf;- zb+G(y->;_ZfdB2VfI;93P6GUI1ANo~Zw~0YV-D!MgLp3R;$0Bn(`6p^OOz|{ZwdS_ zmQR4UPhtQdE&_o^vFtno|CYdG(~x7m#h1sBC0Zf(R0d=#hsub?zp*X+6yVj!yFYQi zn$iK!lJ7fs;SjW8RSOjSkbJv?9T_Yj-WV!%_#{AvFE~pNea#}oKtRuXhc2#{OkRL* z-MjhKl8R-Pe;vkx1B_1*Itp(T=u;VvGoZoI@s@aORr6L|;}F*S(8wUjySz}nb9J+0 z3VwT@iY>u<&-$x|WY+uS+vLBLW5RNyPr`aHC6ZiTjjcKL{}+AINi}G_kFi@st$k-Y zz3=1G?|;9=ZR?`|+HmIM^CC&@gh{9#b;ljB~c(if}$aLb*Jw{Z` zmm?f z4@8;Pan*2t1!}d%dqZ2edWNeDwMDxTdj(fB4vJtu!Qmvx5Sr)U5EJt!d8xd#q@D6r zhr**cf3+Abxee#Dr6rxh8z{_IwgTa^zVuqYDrPBrZ_eV1^2Kx!VtgRgex6q%X(O(* zr1iWfk~ZKXC&uhv-i<9>b z!#ss{AB!Vr!xvPd$no5edP9%3A(nw(aN#UtxC#3utq=a{^2=wd2Xb_hFBh*nENT#n zX1}o!U0@6y$b+t>X?%EPavC492r^<_81cLAV(Arj(4-MrH;h;}j6giihzgmxka!yo zGYE>&;MZ<8jIjMNcDRwOL%s-XY{DmLY&PUIs!&sY8=FRwVMEmwh8y=(#8UN>H`jKM zdAQN=K(&wH#@r_U#J|+8_wl2y3MWp48@UZd&GV!^X(9Z@K~0ZT-*3bUxBgrB8`<>h zG&@7K=OC>^K&7q{IL=RahGJB>vfwj;a~t)tWj3>g6U)VW%vMyg%owsS4(|m?Q+CLZ z`B^fq7_xgo+R~4OCm%+hEx6-~<>D`fwqFcw5znQqOlgQA`|2>!paeyJ6=y?R&yZ={ zJVS=e5ib03Mr2TvsUiC+uaUbrCEU*6;3CYkXZP3G(6<(%Z(d-dO5N`*;wp3lpUms9 ztqClX#Nu_Ubrbj63t;AG*V?Z@G7dq*aUnWBN*tE&R&j6H-?)lsJK4>Qn2Mf6l66MSu$_gX5Z%8nZ$Q38xO>+I-u1JMS}VHmj39Zt9WV2L zHP?<*$Qdxv2+rf!EUYVyY)D38F$o?a3->#3Ztv%K zY{zm*)InN7nzf~_cKA<9_k|ju=|iP+-2{B&P@*k&ZeLC5-&Z#wUuH|C`}W&Yx{`uJ zuU*~SZ2Ns^CezPS5|CEoJ}(2BR{|=aPKQ3+eX-(cUP-|t#(Rm(3p~wZJgs@<+Z2PE zS8~Q-ynyDleLp?T`=VUUW9A6dJnbne%Vf1R5@~P8Ncgs#_55Y!^6r*jby>9wCH2VXFdq2o!UXRgb?*#MuO21? zj{5@{J`7j2y)qE;!64NQRUWWn+fzl->hYE-#lLUj+0X_9Wj7 zEpQ3fENT@(vFtorV6I%=$I9gd6gyF>Y+5+I-G?^uvKTV6;QocNr)3^NLT~H>tiNaE zTf21eO9GHRd{%h-@@u?OZ`}UGS@~2mHN?i#u74iY|u;M_^*({1Q8 zW9ZXu=+kZJgLs-gW!~!EkUlcMkSTq7ek6g{eh{HsK8VVQsEbm5U(Jp{UepnoPJUcbKICj`Zj0ni* zzwd>249Ft}c^G9$_VELdFb|PU zyAW%(9hB4-GtvX2fKBo?9J(zq_RCs^E_?io zJ@NP#d*bnr@q~YsdWADPEV1P@nP2ovlq>&cm|PGf7g~{UOf+6P7@z4e`BBH9zCfe#FU5zi$s zD%X~wR!mHNP>jZZxe>VC_10?e+@ThQM8Ht%jx1`(l*M}D0WAKkmkQ*q`FuhaU#9tb zf*Dje-Z0eaH$7=H)Cv#SD4#Z8+Xe67Hca&r_uOJ3xrSg?bQKft|9R?sxw6XP8v!0P zema5qs)VgAl(AJK&ehQ9S5|rGS5|rGGoD6&UqoZORau=T^LKuUa&5O(nFrefZN5(8 z-KwmX*9g2E7oze8{3?NOW4~z?JDTyGN$y29BPy%a5e+QJ6gAF z$V&3#v!PBbEDvxe{2}O``0Niy5IM4O$Qc}eGTiLoH3{Jzhy94Ly|YWf`MfMF^(}`< z29X|<78|!8;(ui1hso(h99=y;C7e4$oJk3 z?5FIU%+AbBJ4`TGyS>?gjA5<|GS;5EAWs{Rrwz!6=Ym{eK%Pk>#?{jUd6yvTVK_mS zy$>1o$SP-8K>~8m|0>8Y92Ox6ay&bbUw9yIem5Y$Fd)A$AS0dz`41){T}^(OMvRpG z#JTpq1Z3okK#*lKL8c(Tl-Jm5T*xoTd(`AoYOo3;~eqin0Rv z{0|T0r&}J#=YM!0pa0>3%y=5)4>cah=YOUVBXWA0ya!EYz6b#MwY!%wqprdEpYj?& zeka`-l{a&pH;`+J9hM;ga_#r5K&~k^AY*rkHrF+JvCzw=<(gs-WX97Vzn3+=Y?EtB z(ulEpx*#)O1cDqPxiZw`ni6>pAa8%ouO{;t`TY`V@)ya{XmXif5m{++O{2pEgCK8Z z2QtQ2x=nt1(}3LQX>v`Y0U7aJkY!zvfZUWujFhc;xteQyD`2@s#(xC)6(&J42f2wA z#5Q?*<9`+8zBIM_I6IL049FJ^$bAOnJ_9o1X^`K^^sRt=EsYoxK7mgKWaNuLki~*z zs>#>nHG(XIf&7{4uhe9mLK_R~B}PV*OZ|$-PLszSmLaIgIPhvkN_L_lRL!^n8FQ|# zxgIwlj~kE?&jnfLKLq3lX~ekhmn~P2zfzNtF9JaxKZzzkkk<(EKz=nje;}_pEJG0F zi`jv^=7GG1lU7`i*9^#O24uw3Aa9GaP(Xf~MhyFuK}Nm^1i9}dAU~DY2y$zFLH=rvbUsfQ)z= z@CQucOAd$ zuna+vhqD9ut^pZmPq-l8H6Y(LAS0d&GG@-STQhzyjTm=M59A-zWaNuLkYy~Cp}CIB z+#kouFGSq`MUdyy)NWUHAkQ0+<@gNI(0K#$ya5^UT#&;ClMuMm!hf5(DzzG-4n*v#=wJ1q^n|e6oOyd=Ut;95$ON$baQEf-Ht7e<1&& zCZq0S;a`%a(d3km^JLW~H*4rc}ra0|BE2EI4naDWUO@0qIcccVnD{8er>KB zTMWqFK{(5d=Ym{qKyFPV#>y#!jC>IY@@wXsDaftz8bKD9cm6=;$7ykZ3^e(-WN9=x z<#T3PX>x17!vq5$mriB{a%;Z_@=UV_a;rJHrPZ9=!gw0wv1JeB)`2u)r0nd>b)1YZ z5HB-d1c1CUdjgPK2jn$?{7kwK|BE0$bXbNU$T&VD3r%jtbcUX4oWZ7ct;wwqJxy*k zXJ{~<3-Sd6@}o3jr0kG66_AlH0zsDT3>j*2tCWC4sAtzGZvH_2LrvzHabewiFq$0o zO7UMrHnIWjFjPFu9_?$BVPo9EPa7YLDrMI1X%_H`P1aT)MSgAtUL5ZlT+3~Wu?h& z1xIVQM4wlH3Za1;#Q!GzCrxfEFd)x)Ah((G3fjzh1&pUbzAw&Tg4}k-VIBdlm3;H9 zRIVWZWgf^E0U$3QoS;o^J0q_FO>=J~bKnA`oOug=Rd2 zYU`2L2(k?8^JlK}2l9x+G6ZXPC_9ix49MpU$mXn!BYkq z`63YHlPs=pyDzU1|j+ z59AKBCBMUL$!9zba-TGE1i525jTmjG2l7AWfqW4F^887Tjp6GVBlk*4i zdxvERf{ab~S(xjN_a4X-pA5)m`+bMme$RL=$f6noa+>Y;1+h~G8Tld*|5M(s|*?L4)qs59b-X&v7WEFq z(;)XIY5xS|vFo1G&@eMDH{^(HYML`Mw8oXLTAewoeyi=8FK3=cL1zA;_K8@)|+@kl!{rNlnK0 z7Gq(}E2GJ%S8qBlD^2c9vtc@l4bxd@a_1!ja<2i|?3L~`d!-rA1^J8tIn7?_XpVcO z?Ubp;Bs7`%A`s-09Fx;&wn;CEt37|3oIj9nIV^d=Tt~;U1NoK#8B1QZ$E(xqPwq7P zlRFVlgPeF|K)#(u496#MuI5@mM!pCH`6P?$J8#Qt)MPO{c>_73sL5CJJak> zj$(iE1WR_2+sp^0jP9T1nfXHpId@JAv`bFya1Wv7F(930S8}J>mCSf9v@t>}@zU%{ zj&_|MwA`@Dd=UukNd``xW>@kOie=|-&pTf@DEJ}$jUNl`)a1e<;NCW0#aZrr zA<%A)*Ysj0$%WSJMea0vkr_`z+p}n(O|us{T6fCOB3}eTi8sDa8p8h6E(nyeUaBHska&s#4 zMIgQ>86+i2qePRuMto&%JAeA? zukAVIeW{5)hh+%ji_OQ!^r{w@W~au2(Dn(mE4S*e;b1^*niG8nTC?Rifp{9)##aW~ zqg#$Ql9Q(gEq9|bUj#yXl2K9On!HA6rGKA4X#G8G-z7_KE>qxXw})@(FRn2pAa=R(_Vpnc%5G(ldad@vwatIYi_%ol;s%DH}- zYV8AgjnEF{*DCuv*L45DK%47+m&BUGG6ZY);<3;UFU~wZWRTYc+7Guc^tBpj&GzDi z*6^d+{9;rcGJ0hyTU+gHWeq#reel(p-mWQk8Ud7NTwWOlB?DVw8$5M(8{1D zQ)tbm;u#bxpU~!Q+e5GApx{BRJ%FoZmUoYig%%d)C#S_$1sdF5OYp6_op>#~5IM%_ zHT#Ks&35e&XrB`Nh}lc!-Fg zFpO{<;RHR*B<1F7?mxPpc;h$r6MOiopoeN^e0*VSkun7E?LRO0PEOu=f^9*%L)CA# z68D>}#Ehr$EgSUox4*_=dVzM~_iMjcIqGkO$2T)y1mHV{LklwYW%Sp`YcS1|vU*JA z>&UGX52PMmd-!4xd5-vYIxIu5cCnTC7<^~vXYP+JEZ~hGzMX>a#QSS+up`LD*X$zh zH@k@Y5l`b=Dqmfo{`Ox^HrK^mlk+=KdjQ?+Ub6?p)}HP%gB0y|GZg**n~icrLVvr#;O5_tIoO zbb8QopAz#$Ahg&=mAUHPlh+9Cz5GIJO!H}PVd-h z7ur(Rl|cJ9P39>Ji*jvixwM`6A`sf*lR&FC6A)T)N2`4GrNViGcHrpl;Ei9{9eg~r zPlC`6lzY&&?0C=)m_5M*W=}BVX=saOM<1abIJzfz;xV_JQv!tp4JW=-3h$$ zYxVS?)~Lc1D4zZN0YAg^D+PT=FUb{Ku1Z8K4i1YBq@ zzJpUj3^MMy-6&k`^taEd>L!UN(3ZBWxX`Xf2GV4n@@a!y4KkpWd{MwxW79t$XAUhy zW3^y4Wcl9*`GwYB*L)yZn!!&>%aqMRxz)%+hY1Fu#r|Ip+CzgM_#K05Fpz*iYdaU0 z(F1j%eQ2QdcKu2`7up5`?V~iA_nw~CVxg<#ivki_ar*OrsLYx$Oa`7Xr*JV^45*=p*`K@t*enQ4vP@1-7+8Aqgp$12-+{6 z*1ki}*M;_rf!5pMi;Ud1wzOHQ7~QDV$k#NPr%Y|-YLKzsQSwCr3GE5a&w*&H7J;@T zzgp`rYCYZQ+tp}+!y*Kr?Zgh>V+``h>f%_it&J84w4MEDUtjc~je7ffk^GL^)-s;f zTHE^$`D*k`n#^985wqvd z%0*d4O=}VLb{pf$P!I83>d7`TiFYB57+Wb-lEtZ95PX>OYVh=D#Y9NnTeuwAJwdAx zy}*=cTK>GuEB_)PE~VaAb%T)*KPz_TsRi04M$ROYU7afYR)1EkMX5815v8iHC{=Jt ze^v~i?E7s#+4q4T%=-2Yxf3TJ@l(R zt4?LK%VDNLO3nL;9{cIMD8(pqWl`$&)LM~s5_)$rTfqoN8rb-d8u)i~pY?jD-e;Xc zZF4wDX6$>WqN$%Wn` zy+?0kj?jpCP1iDHG7q~N?UC0=@0tA4yO8w$uIijf;Zb@=tfTY}zti-7ymC{2ew(z7 z*7GM26cZgO_33RRT{YYWdN)H!;`04&&GFLe7n3Muq++l6>uQR(Ham_FJFKxFpm$RM zJ=TO%j51diaC~O)maMVK?9;ldQL$*kah&L2YmSdN5ap08L$VP@IPR!+m~fLN<0_Bi zhfO$a3f}p&`61z(aBrLWYSi0ijw{1)nRpP6LtPMpRg&XJ=^?l_;Uc}qab%9rc=JjP z+zAtbJSG`s33qEAAFQahPZTsEgRKKFhmDSEMYCJ)WH!Uc~a= zfH^FFB2+p5eJA4i>sE`s&FZ+?aXXrfr_Eu-FIGFLQoQUiub>1M{bJ=fhKQVH9>^B~ zV~9PRn2<3`ikIazu;lyY{IcXMS%QTk6Oprp3fuEy3Y+NS z_YUs`Wx?Kh(6La{5mvy@l5y4i!qUimkdE(#j-v;wU6o$zT>SnKBfn%GhK`8m(ov3q z6FPoy7%wP6j$gHh%-V8EUAdO47?~q9o_SXB<|Lf_Ag{63q)}J-a#=)b$jLXVu02w7 z^qaPkn6XXL`7CBjT zwO#81Dd$)D({JT$CBwn?{^n$YFc-(+z z;WUD-g`QvTt%1 zhxgw%`C5@x7oy~n!{mdM!Wj#*yo+AsA(J~YJnCB6AgM12sb3dwFZX!OcFCnjOoNp7 zj#t2yF{*_m2%GJa%MRlOC0O!{m8((hWgf^Efkst!xnyWmOD@Z6Me&igRCt zN4>HsL%rJ$Qx1wToKht@_;VVh!aRG5%n_PeJ}!oN9`e~(n% zcBBvXR0Z9Y5!+ZPv8S!HLoH%E*I>v(><)^B>x|#6p17pKj))x@;DbUNMpelOD1L3N z{uh2k27A`+^T?0P5$yeij**j) ze@0$o)uBzX^EY`PxlQtqD0C)n2Zu}2nYgCO4=R@hef1&VUAabg<>sieR4is!MW7!A zt@s&Hb8YbWO9I0ndxc5r3>yDPwK#+lFMtg-Y9cX$UIG5o%CytZ5ul3u-i1O58-E%&`R_Kyka|R($cXBsnAx3tJ^TI)nhggE+J=inI z+{;vgGNOjyWeUSF?eg@+Bc{Rrfp^9St~{QWE*hS`bQmwl)6+ZSBl3{_1LTW<{=v?| zNhtbKUL!>>q4NYOrwIwFr^5l0hbeCs{PC8Qw_Hu-1#YClA}+7Cw1_*Ro8p=R`c zs_jBBLVZhqN?E^=6(eFlkpCe(nu`3nZ6~->YIN*=aEah*?1zwH`{Bg}oSdP_5c3WM z!P6br<;Zx@hDUuR|Kwl}b{1nl(`0^n2ZBUqnFsPk02$ujJOLSEddCvTu!CaRd9+uv zBtw^~+hqSd@Dx7EsGhp7dWy%9%}Kp+IR zjbyP29FE8w-!%5WA8H#bi-l$tiSFN+N0igRko+UQ3!78volAl%k7oO_w37qv$`Xh1 zf@19YWy^I;vc^1+F9K;M#v{W%VP%QD2AX~TnqQi&k!G!`t~Rn(u0qPveK?{I2_jE7 zED)(@6xZv8g=myOrJdn+)s(c^Znfj7nrp!WFlW6_nze4;yQO}CTyU-_e;~X4d^4Fc z>z0*Ssyuqw$$BFWJK01|N)_3MnByLHBJ5e{8l4;;ADa(!ttz2ZkbdCZ`d``VC$wlZ z^zn{8S!FzJrS`>zF7cWiW*Vf=v(ux`Ch0?^*Yv?D!*-@aic0pk0RZT;kze|3kv%@f5kH^NMB1M#)MzCTn)t*kw(4$?g~|o z8zbYL(t<1v^~8V0u2AIzhbafED}=gGe>CL+Y8GWHq(acfxJfk$(n7I zH|NC*TAB+Szr9fQrlX!B<49ujO!D9g2Ha12?K8=LyxR1KU-}CD;xf*3Rr53&y$A~k z7DlAkoHDvIYpv#55bx?;q%XrSzbk~~BRh6mA=*iXHNLUNmQIFbQ}?P4V4D(=Pbz_@ z!?4!LUI$V5+MaJ1=f~@RrOcmarzvX=vN%Kw951uUyGPqW={*fk&5sR_u6B*B;B>~| z4$IZbHKFLlo!LFiw7T6W@3a{_-En*CjHlbdKjQlr>-f}Rra_9@xlz>iSE5FCs0PRv zf!4AAB<&zcqT9jN{94Byva?*(Zbx=h0+?T2N4`QIcCr5o6Z>G|i%5nawhgbr1E&VP zaBISi=a1joXNo=^`1O|^L5?0$v)*|8AvH(GZkU=YsX={AS25B66M-nej_80F9I2X)lZrCjOcCDj6kvMJdWRZwA9~1+AAzOFD;be zy2UZOUK!^DPev>WK?W?;rCiy(+JG}D)Kh>zpooK&qY%926{SDmA2Sq$fqEIX5l{ER zufgEa=0qc;-meRx@5!PtZmE9QKN<1;s&9DlylBWe2(?hYWLRy6E&pk}G`?5l|I`8@ z`AQiN4z{Ssfxd_2DkbwmdaPviri=qb7KtL#>wC;xmk3v(xl0&9c3!GU9$b9_HGsxI zG+s&M4dkXC44(Ua5AsFP!6;I(mQB3YUI1rE&m}yy3#mO&B-OjAEY96UW3<^JR+Fw` zUlzmUtgd!u^usAB zze4%W4Fjx5{PkEx57Sd}wMMjh_~$970lQlu?u{2J+Tr7dt7t8MS}|o06VPa#{IpwQ zDl83<)VS1SHDEa%GR=YUPp$hpX-gnj+TeU)#b}^ybxPeU#6xjTP3$kW{oG z{(AKDQ#S!zNdkOuOWxp>jg&iXdwF!+mMF0VPHPRuYe7-9sF4_$2AvF&lh6SLmk0=(V+ z0Sc(aMTy`l_M9f9$z)Q4hvbVS(V7>mL;$)E z=`hgdmE$z&c*)}Sr})TAZF}@yXcJF`wu+t;X#7+M?nIsbGo9_rzTM5LC8>h%2_az2 z<0;M4v7PcT#VB!QQR>~xZ*Q+^OP$fAN>zy2vQz#^mgcZiUS&DF7nB9(a{&cl?{>=l zEE!jgJsFTmBPI;B}h;N{MtFm_79uMPzdhk#FmIbVA->Sk6 z;|0aY@sO@|cMX~b&+U{ma|HYTWV3k6GwhUCiMf}m``-A1nvr#9eCU(U} zOxi7!xs!iv{Gr`g1JNUJor0b94ezTBUsKImD$;=U&+ZUI_ z%akEIYii^*R^8kDvhzOKc?**k(fculfhw7Jn4Pr1BSOr0X*C4G&++=%i=iAp8n{~1 z;joxN6rQA@K$HrgBzv(w?dpe#5REkH~^ zOUC7C$}_y){ojdwO0t~_GCleKv?n>AM)#tVv(TG&@GfRjP8}St0*WJ%&{?To$*4zqhn%(K z3|2_qFoT+q^nvjwT*xaOC}~Ja)IUo8CF;ho?`}7`j{4K1o!52*9nAp;eayrt3eBQ& zRxA2LhA4iwvE9N`DLJGHBQaaq(k-(Kpb)Yck3TJuN{b6a7vl7p%%Q0pBP#m7cf!r% zy$G1tR;r_=(?+k9f2JBP{^+HA?^VQ6k#3B3R5v^7=Cxl;Ww*PHZ}86mmj(2r6;%U; z_(Q?J_Bwa~)EwJ+K`dpl-~^Jgjn{zjMx?iR>ZY!|lcRCb4%hABt2T+LQT z&)=tfKhSfoRKx>gE5sWrRt1m+dGtH@GZ4Wa=8=TBk!O;TEdRmk1f{NxB9B-CqA|)p z_KQO|i&gZmjJ$O38fzv(HXLOk!M8{1;0+ef4s7CGy^_dAQb+*BYC+#tk{THM@nl8S z&K6j^F}17eM+a}wt`%6eg@5$Gjza}WRCg=tJL5%+5}6JCov82)ZFb#?AqQz4GF2mf zqQ`eDC`Pd>3%V88O2$s&iLM!9wqkf8}G@Cf|a0SdTonAjn##O^p(&t@J zD%h=n7U7+Vm-nANH`e>^BfdfF?HzxJD`UMK8c?y`_Z-Fxijm{-hoFG4vtBC9v);%Y zq4~<$M<_p}W@u4@ch?)BxYoLkwXsy7`f~c5(?*5U*Y4^FJFP>lO^M-`xC-)Tm^}a1`uX={N}^?8;0m_j2ZUMvs|q~yqNeN zwkIft5dE#gl!IcV?2yjJx9$;LgXa+)nIqWybHkMq8x6tD`*|&ZubEjsLIa`b~)GR zChaMPS{eDcXtbc2Lh9wCP&^cpT|~SV+3aoyq2?xlo4=^b>pw@Uul7R`2cHZM*ZQqN zc1_G5hs6qV4X1l<@~$efMdRgK{@fqN20guoxeJ3wS=k%p{U71|+)7auD5Yl^YrMlg zS8Ke(K5=DuUqTLXma*oq!%Tv*AUSU#S~k45{aMC>Hs*nR5iqB;b%J99A)35K+YV=q zok!c=M#^K~&R_w$-wx2nbP|S3_`{xg2;AU3&`c;`eYp2E*CiRX<;dnxwb$$&OM&T` z=`McDWb%I3@ce@%ZrOyK+y3!_wOBg>{g{3?h=V0u3e=WAVjk#$)_RA6;>x4ITdXD4 z6sWCm7%xD9nvbVPfyDo;PQWbRG?JB*NvIQtBQ{bAoVBN2$)cvvUEQ(R)$^v&*{qNGG zuGoy+S+&ikVliT|#hq2#;_zlrmgk3hn|_vztLBy_4>J+f1tu1pJ$tLcYlLfC3=>;+ z+zEhM#M6!N+q0B_jc{$N!$gA;A_D(S{&*)peNtGq@!%4*mA z(Xo?sTwo*IiAH$OavNb}&)#Nb{iFI2+gk9He_)`j1-XYG1zq(M8+D8H6oumDo0TJQ z5)@i?DIUeI|G3j`mnYCHwt?ewn~1^*&@hZ!=owpG-Bi+xbJmWmxc&{i32zGGh3rw> zo8QEo>(!D048I`XwXhWm#RkT44`LJy#CO6YXW`^RZaWo?XQ3gwO&++~&)4{;;@pGx ztryC_e*B;;JPlh&`tIg09Z&BbmDSeLY}1DlkrEAzBC^{YgE{k?kmYJWu0S{T4{)VR z&Ul4ezyDy#e|y2u1X5RrvZSOpUko)|_@gFb1$QgXoh^=4oGS?Z+$vl8bPJ4d?>Tri zg^u=qYg5XekS4yt7|MRJb#O+_qK1+^$>f2WfJi+|bhhQ?_Z?rIo6L$!d-z_@!I3wR z-fYX>LCWE3$G=gVP-?%)Mzh!(L4TK_vDn3i&E3_G+x?x(E5pgLT+A+hkWak z>-`s!NmQ2B=K_+)aMS53)%m^tfKGP!~! z@Z+Da|HAeSRcs|}xU=peGN0bTzgCM>STgxDnbcK>n@GUsKj_giQOJyxc}3gfSQH5N zeua`%Z4g(CXg*FSHAPS*9Z!iTY6xC*V5-EO)8 zeN~}w+55Q-rYG09fSeKD3;!~%1bg(>ztAdW=YahNTT&Z!9uWYBayN5qZ%NENo ze8p90wD$7Z4=cWW#T%C&v#wO4Wc}YYURlEx4{NX1@oJ!=@4`DtZ>eN`duo^oSS3|c z7g#R^HDzCFOIeeVKgBh%5yp#JB^$q{SS6~mthD3(4(~lEd((ASo=%p%pY4{bhaz7^ zU&Hfzh*EH=^h)cdjjPbD%3H(NANcZBJo@yIrL?9i`WmYq@G4od`gW>>uU)OUfBDBE z?_I2T_;EMNtGVLI{#S#z3SBN^mjqX;yW-)cn{WB_OYvjtE?KY6SBy1(2;-{YDyC}R zM0jrvfPR@`ybB^93(btwX31tlvxBS1kK(^C%gcQE%F6GCuJDcTWslD9vup)TWn~Ff zimPz6xZ%q~se{pqvA=_@j5lAhHnb;6&6d;_?OM2}+A1cW#YMi=iplW}x!S1cv(HrX zjd!KAL%51AmvJc}uO7JdH<}~>1&NBj`@4O-sx275I(*5OujKji1se}S_bMh|+#JJ| zwN&<`y!s38#qrvZaB`;Pep4Z}Ct89!_#;Ta$J&Z2K8=nQ&y2nJ%y%D_4vwyz$CWw* zcVLLM8~RwXwq8pXN3NEvx7U+7(K1&)JJQa`y`((VwBYRdp|izfzI+vZw_=5O5VkmB zPG(0ZiXX1tALVOdaQuOke7K_T;y&X=pO)UgcZGGJDk}P%p9)u@VQ9*8sh82Bp{Yj7 zXMHGXUn(af3a*q7RE@mERd}n64Hd4`Tagc0zWRU7U0YikNf7P1fJRZVnb9CoNL)bi zl9+%JFAE|>+`tBPz!-?!Gzu|@vf*Mh{PjK6d?ESrkS}k$^K`84>aIRrHC^2^gTlTH z0^6XDl;QCMOE}By&wBBjhyT59p+HVpg1c=BAr?WTyrNiT))B+E;s;Xfh=mg|0p{Vi zjSCSymm`@%YmIcTEF0F2@G$GJ?C=SX*hWa&sh%`NE38yuf$gbZvD|^9+Vt*EM&c_m9{j%CO(kkydKrq_*HM4SP=qdxk8MqLN~`8uVw zUoiAP&t89%A;(VS5%LUNfB4;HoJ=4&3Dcjy%@Bp6c*BwWO1_Jackht|A*(t^%EBm! zzF*ze6=d6WWPH(`CLPnuR-T#(q=A%t#LyBhQQ20?iDzw!lXrc+G|<68dFWMdsM#4Z+op%>|8Pl>JaMVsob}*rN^T$APQqP3;3E{cB@nT?ykX65# zY>+L=dejylTNd^~b~8w_Y2JN*`w~dHu$_FlL~4i^Kec1y)&az}(MO365KUd4vdoHB zl4R)-WXehGvX|{WSm~F>^@D0^1f}x1p2^Z45@hh`=KCaod6sN00ZIGR3SL@ZN;YCl zwrEH)yICK_Z;caw6Dui?3o`TLzD7!`%DIn_u@=}6=eJUu`lUw!$|2P&14)N^&Adwd znT~9K#ztxO$*QerAEMJ$X@Vm)pht*mUR#*W(tc1P4eVxt zipfoPW=_}_4VD}RWY|0fqXJ-_B9r~BtFNR+*Z@w`s=2$gBUIAv-` zQ=(C$DQuR&q?@MI?6H+oU)rQGh?Y&`K&Bg@5*<>S?rram9uOO9J7TQmD1rvrSn}p> zwda2r8-45`y#WV}ENQ&cu2yHs|D>QC$hzq*0Nh^+C-@{+VR?u z2E_b2wm}q?(qpujjRBdeG&bViyrLZ@FR-CPzM)ko{|N)J79yZV<4`dR7Viv@=}fnj zc8kJ3ZDYWBO{EKbIqVX;E3k@BQN1?&FJ1tW8ek(sXEW?s%-D9OPjXkqqK;@`I$|R^RUMsTKdBXZZij+;N_msG50?B@wEenu(&Ci?}50Gh{FEpYQjk43`kqZF$ z%mdL)KRbf0Bs3~w99PlzkEW?#X65nYc!x^YdHn51@(t6TCuASX3;T8*Lw9(lg|$Gd z)X(TH%5GxST0R7zGH_p~cU`0qyrfCKq0E5imY{c*$J-U*FO9zLr@lsb$Ga-~p@9P+ z^<6?G-P(k?>=wFCEf_r_@05nLtNgt1`#OAgj+4y#yffzxv+Xcr==U?lj4~fFy!s0u z=CZ96>1z|FY($L5ZMxU7FpcsnfV@fekiyjCdetFD$)s2`P4$ITxLM7Nw^@M#vVV1* ISpCHHFM@*SqW}N^ literal 0 HcmV?d00001 diff --git a//main.mid.350 b//main.mid.350 new file mode 100644 index 0000000..16369e5 --- /dev/null +++ b//main.mid.350 @@ -0,0 +1,2056 @@ +TITLE MAIN LOOP AND GLOBALLY REFERENCED SUBROUTINES + +RELOCA + +.GLOBAL TBINIT,PIDSTO,PROCID,PTIME,GCPDL,PBASE,TYPTOP,RERR,FRMSTK,EMERGE +.GLOBAL PDLBUF,INTINT,START,SWAP,ICR,SPBASE,TPBASE,TPBAS,CURPRI,CHFINI,MKTBS +.GLOBAL TOPLEVEL,INTOBL,INITIA,ERROBL,MAINPR,RESFUN,STATUS,TYPVEC,ROOT,TTICHN,TTOCHN +.GLOBAL TTYOPE,MOPEN,MCLOSE,MIOT,ILVAL,MESS,ERROR,CHFRM,IGVAL,TYPBOT,ASOVEC +.GLOBAL PRINT,PRIN1,PRINC,MUDSTR,VECBOT,CSTACK,IFALSE,TYPLOO,RCALL,SWAPIN,CTMPLT +.GLOBAL IDPROC,CHFSWP,ILOC,MAKACT,BNDV,SPECSTORE,BINDID,IGLOC,MTYO,MSGTYP,CAFRE1,CPOPJ +.GLOBAL EVATYP,EVTYPE,APLTYP,APTYPE,PRNTYP,PRTYPE,AGC,SGSNAM,NAPT,APLQ,STRTO6 +.GLOBAL 6TOCHS,TYPFND,STBL,CHNL0,N.CHNS,CLOSAL,%LOGOUT,%SSNAM,%RSNAM,%KILLM,SAT +.GLOBAL MAKINF,%VALRET,COMPERR,IPUT,IGET,TMATCH,INITIZ,IPCINI,%UNAM,%JNAM,%RUNAM,%RJNAM,%RXUNA,%RXJNA,%VALFI +.GLOBAL NOTTY,DEMFLG,CFRAME,CARGS,CFUNCT,CITYPE,CTYPEQ,CPTYPE,CTYPEP,CUTYPE, +.GLOBAL CCHUTY,RTFALS,PGINT,PURCLN,CTYPEC,CTYPEW,IDVAL1,CALLTY,MESSAG,INITFL,WHOAMI +.GLOBAL %SLEEP,%HANG,%TOPLQ,ONINT,CHUNW,CURFCN,BUFRIN,TD.LNT,TD.GET,TD.AGC,TD.PUT,MPOPJ +.GLOBAL PURVEC,PLOAD,SSPECS,OUTRNG,CVTYPE,FSTART,CKVRS,CPRTYC,PVSTOR,SPSTOR +.GLOBAL TYPIC,CISET,LSTUF,IMPURI,REALTV +.INSRT MUDDLE > + +;MAIN LOOP AND STARTUP + +START: MOVEI 0,0 ; SET NO HACKS + JUMPE 0,START1 + TLNE 0,-1 ; SEE IF CHANNEL + JRST START1 + MOVE P,GCPDL + MOVE A,0 + PUSH P,A + PUSHJ P,CKVRS ; CHECK VERSION NUMBERS + POP P,A + JRST FSTART ; GO RESTORE +START1: MOVEM 0,WHOAMI ; HACK FOR TS FOO linked to TS MUDDLE + MOVE PVP,MAINPR ; MAKE SURE WE START IN THE MAIN PROCESS + JUMPE 0,INITIZ ; MIGHT BE RESTART + MOVE P,PSTO+1(PVP) ; SET UP FOR BOOTSTRAP HACK + MOVE TP,TPSTO+1(PVP) +INITIZ: MOVE PVP,MAINPR + SKIPN P ; IF NO CURRENT P + MOVE P,PSTO+1(PVP) ; PDL TO GET OFF THE GROUND + SKIPN TP ; SAME FOR TP + MOVE TP,TPSTO+1(PVP) ; GET A TP TO WORK WITH + SETZB R,M ; RESET RSUBR AC'S + PUSHJ P,%RUNAM + JFCL + PUSHJ P,%RJNAM + PUSHJ P,TTYOPE ;OPEN THE TTY + MOVEI B,MUDSTR + SKIPE WHOAMI ; SKIP IF THIS IS MUDDLE + JRST NODEMT ; ELSE NO MESSAGE + SKIPE DEMFLG ; SKIP IF NOT DEMON + JRST NODEMT + SKIPN NOTTY ; IF NO TTY, IGNORE + PUSHJ P,MSGTYP ;TYPE OUT TO USER + +NODEMT: XCT MESSAG ;MAYBE PRINT A MESSAGE + PUSHJ P,INTINT ;INITIALIZE INTERRUPT HANDLER + XCT IPCINI + PUSHJ P,PURCLN ; CLEAN UP PURE SHARED AREA +RESTART: ;RESTART A PROCESS +STP: MOVEI C,0 + MOVE PVP,PVSTOR+1 + MOVE B,TBINIT+1(PVP) ;POINT INTO STACK AT START + PUSHJ P,CHUNW ; LEAVE WHILE DOING UNWIND CHECK + MOVEI E,TOPLEV + MOVEI A,TFALSE ; IN CASE FALLS OFF PROCESS + MOVEI B,0 + HRRM E,-1(TB) + JRST CONTIN + + IMQUOTE TOPLEVEL +TOPLEVEL: + MCALL 0,LISTEN + JRST TOPLEVEL + + +IMFUNCTION LISTEN,SUBR + + ENTRY + PUSH P,[0] ;FLAG: DON'T PRINT ERROR MSG + JRST ER1 + +; USER SUPPLIED ERROR HANDLER, TEMPORARY KLUDGE + IMQUOTE ERROR + +ERROR: MOVE B,IMQUOTE ERROR + PUSHJ P,IGVAL ; GET VALUE + GETYP C,A + CAIN C,TSUBR ; CHECK FOR NO CHANGE + CAIE B,RERR1 ; SKIP IF NOT CHANGED + JRST .+2 + JRST RERR1 ; GO TO THE DEFAULT + PUSH TP,A ; SAVE VALUE + PUSH TP,B + MOVE C,AB ; SAVE AB + MOVEI D,1 ; AND COUNTER +USER1: PUSH TP,(C) ; PUSH THEM + PUSH TP,1(C) + ADD C,[2,,2] ; BUMP + ADDI D,1 + JUMPL C,USER1 + ACALL D,APPLY ; EVAL USERS ERROR + JRST FINIS + + + +IMFUNCTION ERROR%,SUBR,ERROR + +RERR1: ENTRY + PUSH TP,$TATOM + PUSH TP,MQUOTE ERROR,ERROR,INTRUP + PUSHJ P,FRMSTK ; PUT ERROR'S FRAME ON STACK + MOVEI D,2 + MOVE C,AB +RERR2: JUMPGE C,RERR22 + PUSH TP,(C) + PUSH TP,1(C) + ADD C,[2,,2] + AOJA D,RERR2 +RERR22: ACALL D,EMERGENCY + JRST RERR + +IMQUOTE ERROR +RERR: ENTRY + PUSH P,[-1] ;PRINT ERROR FLAG + +ER1: MOVE B,IMQUOTE INCHAN + PUSHJ P,ILVAL ; CHECK INPUT CHANNEL IS SOME KIND OF TTY + GETYP A,A + CAIE A,TCHAN ; SKIP IF IT IS A CHANNEL + JRST ER2 ; NO, MUST REBIND + CAMN B,TTICHN+1 + JRST NOTINC +ER2: MOVE B,IMQUOTE INCHAN + MOVEI C,TTICHN ; POINT TO VALU + PUSHJ P,PUSH6 ; PUSH THE BINDING + MOVE B,TTICHN+1 ; GET IN CHAN +NOTINC: SKIPN DEMFLG ; SKIP IF DEMON + SKIPE NOTTY + JRST NOECHO + PUSH TP,$TCHAN + PUSH TP,B + PUSH TP,$TATOM + PUSH TP,IMQUOTE T + MCALL 2,TTYECH ; ECHO INPUT +NOECHO: MOVE B,IMQUOTE OUTCHAN + PUSHJ P,ILVAL ; GET THE VALUE + GETYP A,A + CAIE A,TCHAN ; SKIP IF OK CHANNEL + JRST ER3 ; NOT CHANNEL, MUST REBIND + CAMN B,TTOCHN+1 + JRST NOTOUT +ER3: MOVE B,IMQUOTE OUTCHAN + MOVEI C,TTOCHN + PUSHJ P,PUSH6 ; PUSH THE BINDINGS +NOTOUT: MOVE B,IMQUOTE OBLIST + PUSHJ P,ILVAL ; GET THE VALUE OF OBLIST + PUSHJ P,OBCHK ; IS IT A WINNER ? + SKIPA A,$TATOM ; NO, SKIP AND CONTINUE + JRST NOTOBL ; YES, DO NOT DO REBINDING + MOVE B,IMQUOTE OBLIST + PUSHJ P,IGLOC + GETYP 0,A + CAIN 0,TUNBOU + JRST MAKOB ; NO GLOBAL OBLIST, MAKE ONE + MOVEI C,(B) ; COPY ADDRESS + MOVE A,(C) ; GET THE GVAL + MOVE B,(C)+1 + PUSHJ P,OBCHK ; IS IT A WINNER ? + JRST MAKOB ; NO, GO MAKE A NEW ONE + MOVE B,IMQUOTE OBLIST + PUSHJ P,PUSH6 + +NOTOBL: PUSH TP,[TATOM,,-1] ;FOR BINDING + PUSH TP,IMQUOTE LER,[LERR ]INTRUP + PUSHJ P,MAKACT + HRLI A,TFRAME ; CORRCT TYPE + PUSH TP,A + PUSH TP,B + PUSH TP,[0] + PUSH TP,[0] + MOVE A,PVSTOR+1 ; GET PROCESS + ADD A,[PROCID,,PROCID] ; POINT TO ID (ALSO LEVEL) + PUSH TP,BNDV + PUSH TP,A + MOVE A,PROCID(PVP) + ADDI A,1 ; BUMP ERROR LEVEL + PUSH TP,A + PUSH TP,PROCID+1(PVP) + PUSH P,A + + MOVE B,IMQUOTE READ-TABLE + PUSHJ P,IGVAL + PUSH TP,[TATOM,,-1] + PUSH TP,IMQUOTE READ-TABLE + GETYP C,A ; TO GVAL OF READ-TABLE ON ERROR AND + CAIE C,TVEC ; TOP ERRET'S + JRST .+4 + PUSH TP,A + PUSH TP,B + JRST .+3 + PUSH TP,$TUNBOUND + PUSH TP,[-1] + PUSH TP,[0] + PUSH TP,[0] + + PUSHJ P,SPECBIND ;BIND THE CRETANS + MOVE A,-1(P) ;RESTORE SWITHC + JUMPE A,NOERR ;IF 0, DONT PRINT ERROR MESS + PUSH TP,$TATOM + PUSH TP,EQUOTE *ERROR* + MCALL 0,TERPRI + MCALL 1,PRINC ;PRINT THE MESSAGE +NOERR: MOVE C,AB ;GET A COPY OF AB + +ERRLP: JUMPGE C,LEVPRT ;IF NONE, RE-ENTER READ-EVAL-PRINT LOOP + PUSH TP,$TAB + PUSH TP,C + MOVEI B,PRIN1 + GETYP A,(C) ; GET ARGS TYPE + CAIE A,TATOM + JRST ERROK + MOVE A,1(C) ; GET ATOM + HRRO A,2(A) + CAME A,[-1,,ERROBL+1] + CAMN A,ERROBL+1 ; DONT SKIP IF IN ERROR OBLIST + MOVEI B,PRINC ; DONT PRINT TRAILER +ERROK: PUSH P,B ; SAVE ROUTINE POINTER + PUSH TP,(C) + PUSH TP,1(C) + MCALL 0,TERPRI ; CRLF + POP P,B ; GET ROUTINE BACK + .MCALL 1,(B) + POP TP,C + SUB TP,[1,,1] + ADD C,[2,,2] ;BUMP SAVED AB + JRST ERRLP ;AND CONTINUE + + +LEVPRT: XCT INITFL ;LOAD MUDDLE INIT FILE IF FIRST TIME + MCALL 0,TERPRI + PUSH TP,$TATOM + PUSH TP,EQUOTE [LISTENING-AT-LEVEL ] + MCALL 1,PRINC ;PRINT LEVEL + PUSH TP,$TFIX ;READY TO PRINT LEVEL + HRRZ A,(P) ;GET LEVEL + SUB P,[2,,2] ;AND POP STACK + PUSH TP,A + MCALL 1,PRIN1 ;PRINT WITHOUT SPACES ETC. + PUSH TP,$TATOM ;NOW PROCESS + PUSH TP,EQUOTE [ PROCESS ] + MCALL 1,PRINC ;DONT SLASHIFY SPACES + MOVE PVP,PVSTOR+1 + PUSH TP,PROCID(PVP) ;NOW ID + PUSH TP,PROCID+1(PVP) + MCALL 1,PRIN1 + SKIPN C,CURPRI + JRST MAINLP + PUSH TP,$TFIX + PUSH TP,C + PUSH TP,$TATOM + PUSH TP,EQUOTE [ INT-LEVEL ] + MCALL 1,PRINC + MCALL 1,PRIN1 + JRST MAINLP ; FALL INTO MAIN LOOP + + ;ROUTINES FOR ERROR-LISTEN + +OBCHK: GETYP 0,A + CAIN 0,TOBLS + JRST CPOPJ1 ; WIN FOR SINGLE OBLIST + CAIE 0,TLIST ; IF LIST, MAKE SURE EACH IS AN OBLIST + JRST CPOPJ ; ELSE, LOSE + + JUMPE B,CPOPJ ; NIL ,LOSE + PUSH TP,A + PUSH TP,B + PUSH P,[0] ;FLAG FOR DEFAULT CHECKING + MOVEI 0,1000 ; VERY BIG NUMBER FOR CIRCULARITY TEST + +OBCHK0: INTGO + SOJE 0,OBLOSE ; CIRCULARITY TEST + HRRZ B,(TP) ; GET LIST POINTER + GETYP A,(B) + CAIE A,TOBLS ; SKIP IF WINNER + JRST DEFCHK ; CHECK FOR SPECIAL ATOM DEFAULT + HRRZ B,(B) + MOVEM B,(TP) + JUMPN B,OBCHK0 +OBWIN: AOS (P)-1 +OBLOSE: SUB TP,[2,,2] + SUB P,[1,,1] + POPJ P, + +DEFCHK: SKIPN (P) ; BEEN HERE BEFORE ? + CAIE A,TATOM ; OR, NOT AN ATOM ? + JRST OBLOSE ; YES, LOSE + MOVE A,(B)+1 + CAME A,MQUOTE DEFAULT + JRST OBLOSE ; LOSE + SETOM (P) ; SET FLAG + HRRZ B,(B) ; CHECK FOR END OF LIST + MOVEM B,(TP) + JUMPN B,OBCHK0 ; NOT THE END, CONTINUE LOOKING + JRST OBLOSE ; LOSE FOR DEFAULT AT THE END + + + +PUSH6: PUSH TP,[TATOM,,-1] + PUSH TP,B + PUSH TP,(C) + PUSH TP,1(C) + PUSH TP,[0] + PUSH TP,[0] + POPJ P, + + +MAKOB: PUSH TP,INITIAL + PUSH TP,INITIAL+1 + PUSH TP,ROOT + PUSH TP,ROOT+1 + MCALL 2,LIST + PUSH TP,$TATOM + PUSH TP,IMQUOTE OBLIST + PUSH TP,A + PUSH TP,B + MCALL 2,SETG + PUSH TP,[TATOM,,-1] + PUSH TP,IMQUOTE OBLIST + PUSH TP,A + PUSH TP,B + PUSH TP,[0] + PUSH TP,[0] + JRST NOTOBL + + +;THIS IS IT FOLKS...THE MAIN LOOP. READ, EVAL, PRINT + +MAINLP: MOVE A,$TATOM ;KLUDGE BY NDR LIKE ERROR TO LET LOOSER REDEFINE + MOVE B,IMQUOTE REP + PUSHJ P,ILVAL ;GET ITS LVAL TO SEE IF REDEFINED + GETYP C,A + CAIE C,TUNBOUND + JRST REPCHK + MOVE A,$TATOM ;SEE IF IT HAS GVAL SINCE NO LVAL + MOVE B,IMQUOTE REP + PUSHJ P,IGVAL + GETYP C,A + CAIN C,TUNBOUN + JRST IREPER +REPCHK: CAIN C,TSUBR + CAIE B,REPER + JRST .+2 + JRST IREPER +REREPE: PUSH TP,A + PUSH TP,B + GETYP A,-1(TP) + PUSHJ P,APLQ + JRST ERRREP + MCALL 1,APPLY ;LOOSER HAS REDEFINED SO CALL HIS + JRST MAINLP +IREPER: PUSH P,[0] ;INDICATE FALL THROUGH + JRST REPERF + +ERRREP: PUSH TP,[TATOM,,-1] + PUSH TP,IMQUOTE REP + PUSH TP,$TSUBR + PUSH TP,[REPER] + PUSH TP,[0] + PUSH TP,[0] + PUSHJ P,SPECBIN + PUSH TP,$TATOM + PUSH TP,EQUOTE NON-APPLICABLE-REP + PUSH TP,-11(TP) + PUSH TP,-11(TP) + MCALL 2,ERROR + SUB TP,[6,,6] + PUSHJ P,SSPECS + JRST REREPE + + +IMFUNCTION REPER,SUBR,REP +REPER: ENTRY 0 + PUSH P,[1] ;INDICATE DIRECT CALL +REPERF: MCALL 0,TERPRI + MCALL 0,READ + PUSH TP,A + PUSH TP,B + MOVE B,IMQUOTE L-INS + PUSHJ P,ILVAL ; ASSIGNED? + GETYP 0,A + CAIN 0,TLIST + + PUSHJ P,LSTTOF ; PUT LAST AS FIRST + MCALL 0,TERPRI + MCALL 1,EVAL + MOVE C,IMQUOTE LAST-OUT + PUSHJ P,CISET + PUSH TP,A + PUSH TP,B + MOVE B,IMQUOTE L-OUTS + PUSHJ P,ILVAL ; ASSIGNED? + GETYP 0,A + CAIN 0,TLIST + + CAME B,(TP) ; DONT STUFF IT INTO ITSELF + JRST STUFIT ; STUFF IT IN + GETYP 0,-1(TP) + CAIE 0,TLIST ; IF A LIST THE L-OUTS +STUFIT: PUSHJ P,LSTTOF ; PUT LAST AS FIRST + MCALL 1,PRIN1 + POP P,C ;FLAG FOR FALL THROUGH OR CALL + JUMPN C,FINIS ;IN CASE LOOSER CALLED REP + JRST MAINLP + +LSTTOF: SKIPN A,B + POPJ P, + + HRRZ C,(A) + JUMPE C,LSTTO2 + MOVEI D,(C) ; SAVE PTR TO 2ND ELEMENT + MOVEI 0,-1 ; LET THE LOSER LOSE (HA HA HA) + +LSTTO1: HRRZ C,(C) ; START SCAN + JUMPE C,GOTIT + HRRZ A,(A) + SOJG 0,LSTTO1 + +GOTIT: HRRZ C,(A) + HLLZS (A) + CAIE D,(C) ; AVOID CIRCULARITY + HRRM D,(C) + HRRM C,(B) + MOVE D,1(B) + MOVEM D,1(C) + GETYP D,(B) + PUTYP D,(C) + +LSTTO2: MOVSI A,TLIST + MOVE C,-1(TP) + MOVE D,(TP) + JRST LSTUF + +;FUNCTION TO RETRY A PREVIOUS FUNCTION CALL + +MFUNCTION RETRY,SUBR + + ENTRY + JUMPGE AB,RETRY1 ; USE MOST RECENT + CAMGE AB,[-2,,0] + JRST TMA + GETYP A,(AB) ; CHECK TYPE + CAIE A,TFRAME + JRST WTYP1 + MOVEI B,(AB) ; POINT TO ARG + JRST RETRY2 +RETRY1: MOVE B,IMQUOTE LER,[LERR ]INTRUP + PUSHJ P,ILOC ; LOCATIVE TO FRAME +RETRY2: PUSHJ P,CHFSWP ; CHECK VALIDITY AND SWAP IF NECESSARY + HRRZ 0,OTBSAV(B) ; CHECK FOR TOP + JUMPE 0,RESTAR ; YES RE-ENTER TOP LEVEL + PUSH TP,$TTB + PUSH TP,B ; SAVE FRAME + MOVE B,OTBSAV(B) ; GET PRVIOUS FOR UNBIND HACK + MOVEI C,-1(TP) + PUSHJ P,CHUNW ; CHECK ANY UNWINDING + CAME SP,SPSAV(TB) ; UNBINDING NEEDED? + PUSHJ P,SPECSTORE + MOVE P,PSAV(TB) ; GET OTHER STUFF + MOVE AB,ABSAV(B) + HLRE A,AB ; COMPUTE # OF ARGS + MOVNI A,-FRAMLN(A) ; MAKE TP POINT PAST FRAME + HRLI A,(A) + MOVE C,TPSAV(TB) ; COMPUTE TP + ADD C,A + MOVE TP,C + MOVE TB,B ; FIX UP TB + HRRZ C,FSAV(TB) ; GET FUNCTION + CAIL C,HIBOT + JRST (C) ; GO + GETYP 0,(C) ; RSUBR OR ENTRY? + CAIE 0,TATOM + CAIN 0,TRSUBR + JRST RETRNT + MOVS R,(C) ; SET UP R + HRRI R,(C) + MOVEI C,0 + JRST RETRN3 + +RETRNT: CAIE 0,TRSUBR + JRST RETRN1 + MOVE R,1(C) +RETRN4: HRRZ C,2(C) ; OFFSET +RETRN3: SKIPL M,1(R) + JRST RETRN5 +RETRN7: ADDI C,(M) + JRST (C) + +RETRN5: MOVEI D,(M) ; TOTAL OFFSET + MOVSS M + ADD M,PURVEC+1 + SKIPL M,1(M) + JRST RETRN6 + ADDI M,(D) + JRST RETRN7 + +RETRN6: HLRZ A,1(R) + PUSH P,D + PUSH P,C + PUSHJ P,PLOAD + JRST RETRER ; LOSER + POP P,C + POP P,D + MOVE M,B + JRST RETRN7 + +RETRN1: HRL C,(C) ; FIX LH + MOVE B,1(C) + PUSH TP,$TVEC + PUSH TP,C + PUSHJ P,IGVAL + GETYP 0,A + MOVE C,(TP) + SUB TP,[2,,2] + CAIE 0,TRSUBR + JRST RETRN2 + MOVE R,B + JRST RETRN4 + +RETRN2: ERRUUO EQUOTE CANT-RETRY-ENTRY-GONE + +RETRER: ERRUUO EQUOTE PURE-LOAD-FAILURE + + +;FUNCTION TO DO ERROR RETURN + +IMFUNCTION ERRET,SUBR + + ENTRY + HLRE A,AB ; -2*# OF ARGS + JUMPGE A,STP ; RESTART PROCESS + ASH A,-1 ; -# OF ARGS + AOJE A,ERRET2 ; NO FRAME SUPPLIED + AOJL A,TMA + ADD AB,[2,,2] + PUSHJ P,OKFRT + JRST WTYP2 + SUB AB,[2,,2] + PUSHJ P,CHPROC ; POINT TO FRAME SLOT + JRST ERRET3 +ERRET2: MOVE B,IMQUOTE LER,[LERR ]INTRUP + PUSHJ P,ILVAL ; GET ITS VALUE +ERRET3: PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + PUSHJ P,CHFSWP ; CHECK VALIDITY AND SWAP IF NECESSARY + HRRZ 0,OTBSAV(B) ; TOP LEVEL? + JUMPE 0,TOPLOS + PUSHJ P,CHUNW ; ANY UNWINDING + JRST CHFINIS + + +; FUNCTION TO RETURN LAST ERROR FRAME OR PREVIOUS FRAME + +IMFUNCTION FRAME,SUBR + ENTRY + SETZB A,B + JUMPGE AB,FRM1 ; DEFAULT CASE + CAMG AB,[-3,,0] ; SKIP IF OK ARGS + JRST TMA + PUSHJ P,OKFRT ; A FRAME OR SIMILAR THING? + JRST WTYP1 + +FRM1: PUSHJ P,CFRAME ; GO TO INTERNAL + JRST FINIS + +CFRAME: JUMPN A,FRM2 ; ARG SUPPLIED? + MOVE B,IMQUOTE LER,[LERR ]INTRUP + PUSHJ P,ILVAL + JRST FRM3 +FRM2: PUSHJ P,CHPROC ; CHECK FOR PROCESS + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) ; POINT TO SLOT + PUSHJ P,CHFRM ; CHECK IT + MOVE C,(TP) ; GET FRAME BACK + MOVE B,OTBSAV(C) ;GET PREVIOUS FRAME + SUB TP,[2,,2] + TRNN B,-1 ; SKIP IF OK + JRST TOPLOSE + +FRM3: JUMPN B,FRM4 ; JUMP IF WINNER + MOVE B,IMQUOTE THIS-PROCESS + PUSHJ P,ILVAL ; GET PROCESS OF INTEREST + GETYP A,A ; CHECK IT + CAIN A,TUNBOU + MOVE B,PVSTOR+1 ; USE CURRENT + MOVEI A,PVLNT*2+1(B) ; POINT TO DOPE WORDS + MOVE B,TBINIT+1(B) ; AND BASE FRAME +FRM4: HLL B,OTBSAV(B) ;TIME + HRLI A,TFRAME + POPJ P, + +OKFRT: AOS (P) ;ASSUME WINNAGE + GETYP 0,(AB) + MOVE A,(AB) + MOVE B,1(AB) + CAIE 0,TFRAME + CAIN 0,TENV + POPJ P, + CAIE 0,TPVP + CAIN 0,TACT + POPJ P, + SOS (P) + POPJ P, + +CHPROC: GETYP 0,A ; TYPE + CAIE 0,TPVP + POPJ P, ; OK + MOVEI A,PVLNT*2+1(B) + CAMN B,PVSTOR+1 ; THIS PROCESS? + JRST CHPRO1 + MOVE B,TBSTO+1(B) + JRST FRM4 + +CHPRO1: MOVE B,OTBSAV(TB) + JRST FRM4 + +; FUNCTION TO RETURN ARGS TUPLE FOR A FRAME + +MFUNCTION ARGS,SUBR + ENTRY 1 + PUSHJ P,OKFRT ; CHECK FRAME TYPE + JRST WTYP1 + PUSHJ P,CARGS + JRST FINIS + +CARGS: PUSHJ P,CHPROC + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) ; POINT TO FRAME SLOT + PUSHJ P,CHFRM ; AND CHECK FOR VALIDITY + MOVE C,(TP) ; FRAME BACK + MOVSI A,TARGS +CARGS1: GETYP 0,FSAV(C) ; IS THIS A FUNNY ONE + CAIE 0,TCBLK ; SKIP IF FUNNY + JRST .+3 ; NO NORMAL + MOVE C,OTBSAV(C) ; ASSOCIATE WITH PREVIOUS FRAME + JRST CARGS1 + HLR A,OTBSAV(C) ; TIME IT AND + MOVE B,ABSAV(C) ; GET POINTER + SUB TP,[2,,2] ; FLUSH CRAP + POPJ P, + +; FUNCTION TO RETURN FUNCTION ASSOCIATED WITH A FRAME + +MFUNCTION FUNCT,SUBR + ENTRY 1 ; FRAME ARGUMENT + PUSHJ P,OKFRT ; CHECK TYPE + JRST WTYP1 + PUSHJ P,CFUNCT + JRST FINIS + +CFUNCT: PUSHJ P,CHPROC + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + PUSHJ P,CHFRM ; CHECK IT + MOVE C,(TP) ; RESTORE FRAME + HRRZ A,FSAV(C) ;FUNCTION POINTER + CAIL A,HIBOT + SKIPA B,@-1(A) ;NO, GET SUBR'S NAME POINTER + MOVE B,(A)+3 ;YES, GET RSUBR'S NAME ENTRY + MOVSI A,TATOM + SUB TP,[2,,2] + POPJ P, + +BADFRAME: + ERRUUO EQUOTE FRAME-NO-LONGER-EXISTS + + +TOPLOSE: + ERRUUO EQUOTE TOP-LEVEL-FRAME + + + + +; ROUTINE TO HANG INDEFINITELY WITH INTERRUPTS ENABLED + +MFUNCTION HANG,SUBR + + ENTRY + + JUMPGE AB,HANG1 ; NO PREDICATE + CAMGE AB,[-3,,] + JRST TMA +REHANG: MOVE A,[PUSHJ P,CHKPRH] + MOVEM A,ONINT ; CHECK PREDICATE AFTER ANY INTERRUPT + PUSH TP,(AB) + PUSH TP,1(AB) +HANG1: ENABLE ;LET OURSELVES BE INTERRUPTED OUT + PUSHJ P,%HANG + DISABLE ;PREVENT INTERRUPTS AT RANDOM TIMES + SETZM ONINT + MOVE A,$TATOM + MOVE B,IMQUOTE T + JRST FINIS + + +; ROUTINE TO SLEEP FOR POSITIVE NUMBER OF SECONDS WITH INTERRUPTS ENABLED +; ARGUMENT SHOULD BE OF TYPE FIX OR FLOAT AND NON-NEGATIVE + +MFUNCTION SLEEP,SUBR + + ENTRY + + JUMPGE AB,TFA + CAML AB,[-3,,] + JRST SLEEP1 + CAMGE AB,[-5,,] + JRST TMA + PUSH TP,2(AB) + PUSH TP,3(AB) +SLEEP1: GETYP 0,(AB) + CAIE 0,TFIX + JRST .+5 + MOVE B,1(AB) + JUMPL B,OUTRNG ;ARG SHOULDNT BE NEGATIVE + IMULI B,30. ;CONVERT TO # OF THIRTIETHS OF A SECOND + JRST SLEEPR ;GO SLEEP + CAIE 0,TFLOAT ;IF IT WASNT FIX MAKE SURE IT IS FLOAT + JRST WTYP1 ;WRONG TYPE ARG + MOVE B,1(AB) + FMPR B,[30.0] ;CONVERT TO FLOATING # OF THIRTIETHS OF A SECOND + MULI B,400 ;KLUDGE TO FIX IT + TSC B,B + ASH C,(B)-243 + MOVE B,C ;MOVE THE FIXED NUMBER INTO B + JUMPL B,OUTRNG ;CHECK TO SEE THAT WE HAVE POSITIVE NUMBER +SLEEPR: MOVE A,B +RESLEE: MOVE B,[PUSHJ P,CHKPRS] + CAMGE AB,[-3,,] + MOVEM B,ONINT + ENABLE + PUSHJ P,%SLEEP + DISABLE + SETZM ONINT + MOVE A,$TATOM + MOVE B,IMQUOTE T + JRST FINIS + +CHKPRH: PUSH P,B + MOVEI B,HANGP + JRST .+3 + +CHKPRS: PUSH P,B + MOVEI B,SLEEPP + HRRM B,LCKINT + SETZM ONINT ; TURN OFF FEATURE FOR NOW + POP P,B + POPJ P, + +HANGP: SKIPA B,[REHANG] +SLEEPP: MOVEI B,RESLEE + PUSH P,B + PUSH P,A + DISABLE + PUSH TP,(TB) + PUSH TP,1(TB) + MCALL 1,EVAL + GETYP 0,A + CAIE 0,TFALSE + JRST FINIS + POP P,A + POPJ P, + +MFUNCTION VALRET,SUBR +; SUBR TO VALRET A STRING TO SUPERIOR ITS PROCESS + + ENTRY 1 + GETYP A,(AB) ; GET TYPE OF ARGUMENT + CAIN A,TFIX ; FIX? + JRST VALRT1 + CAIE A,TCHSTR ; IS IT A CHR STRING? + JRST WTYP1 ; NO...ERROR WRONG TYPE + PUSHJ P,CSTACK ; COPY THE CHR STRING TO THE STACK + ; CSTACK IS IN ATOMHK + MOVEI B,0 ; ASCIZ TERMINATOR + EXCH B,(P) ; STORE AND RETRIEVE COUNT + +; CALCULATE THE BEGINNING ADDR OF THE STRING + MOVEI A,-1(P) ; GET ADDR OF TOP OF STACK + SUBI A,-1(B) ; GET STARTING ADDR + PUSHJ P,%VALRE ; PASS UP TO MONITOR + JRST IFALSE ; IF HE RETURNS, RETURN FALSE + +VALRT1: MOVE A,1(AB) + PUSHJ P,%VALFI + JRST IFALSE + +MFUNCTION LOGOUT,SUBR + +; SUBR TO DO A .LOGOUT (VALID ONLY AT TOP LEVEL) + ENTRY 0 + PUSHJ P,%TOPLQ ; SKIP IF AT TOP LEVEL + JRST IFALSE + PUSHJ P,CLOSAL + PUSHJ P,%LOGOUT ; TRY TO FLUSH + JRST IFALSE ; COULDN'T DO IT...RETURN FALSE + +; FUNCTS TO GET UNAME AND JNAME + +; GET XUNAME (REAL UNAME) +MFUNCTION XUNAME,SUBR + + ENTRY 0 + + PUSHJ P,%RXUNA + JRST RSUJNM + JRST FINIS ; 10X ROUTINES SKIP + +MFUNCTION UNAME,SUBR + + ENTRY 0 + + PUSHJ P,%RUNAM + JRST RSUJNM + JRST FINIS + +; REAL JNAME +MFUNCTION XJNAME,SUBR + + ENTRY 0 + + PUSHJ P,%RXJNA + JRST RSUJNM + +MFUNCTION JNAME,SUBR + + ENTRY 0 + + PUSHJ P,%RJNAM + JRST RSUJNM + +; FUNCTION TO SET AND READ GLOBAL SNAME + +MFUNCTION SNAME,SUBR + + ENTRY + + JUMPGE AB,SNAME1 + CAMG AB,[-3,,] + JRST TMA + GETYP A,(AB) ; ARG MUST BE STRING + CAIE A,TCHSTR + JRST WTYP1 + PUSH TP,$TATOM + PUSH TP,IMQUOTE SNM + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,SETG + JRST FINIS + +SNAME1: MOVE B,IMQUOTE SNM + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TCHSTR + JRST FINIS + MOVE A,$TCHSTR + MOVE B,CHQUOTE + JRST FINIS + +RSUJNM: PUSHJ P,6TOCHS ; CONVERT IT + JRST FINIS + + +SGSNAM: MOVE B,IMQUOTE SNM + PUSHJ P,IDVAL1 + GETYP 0,A + CAIE 0,TCHSTR + JRST SGSN1 + + PUSH TP,A + PUSH TP,B + PUSHJ P,STRTO6 + POP P,A + SUB TP,[2,,2] + JRST .+2 + +SGSN1: MOVEI A,0 + PUSHJ P,%SSNAM ; SET SNAME IN SYSTEM + POPJ P, + + + +;THIS SUBROUTINE ALLOCATES A NEW PROCESS +;TAKES TP-STACK SIZE (2*WORDS) IN A AND P-STACK SIZE (WORDS) IN B +;IS CALLED BY PUSHJ P,. RETURNS IN A AND B A NEW PROCESS. + +ICR: PUSH P,A + PUSH P,B + MOVEI A,PVLNT ;SETUP CALL TO VECTOR FOR PVP + PUSHJ P,IVECT ;GOBBLE A VECTOR + HRLI C,PVBASE ;SETUP A BLT POINTER + HRRI C,(B) ;GET INTO ADDRESS + BLT C,PVLNT*2-1(B) ;COPY A PROTOTYPE INTO NEW PVP + MOVSI C,400000+SPVP+.VECT. ;SET SPECIAL TYPE + MOVEM C,PVLNT*2(B) ;CLOBBER IT IN + PUSH TP,A ;SAVE THE RESULTS OF VECTOR + PUSH TP,B + + PUSH TP,$TFIX ;GET A UNIFORM VECTOR + POP P,B + PUSH TP,B + MCALL 1,UVECTOR + ADD B,[PDLBUF-2,,-1] ;FUDGE WITH BUFFER + MOVE C,(TP) ;REGOBBLE PROCESS POINTER + MOVEM B,PSTO+1(C) ;STORE IN ALL HOMES + MOVEM B,PBASE+1(C) + + + POP P,A ;PREPARE TO CREATE A TEMPORARY PDL + PUSHJ P,IVECT ;GET THE TEMP PDL + ADD B,[PDLBUF,,0] ;PDL GROWTH HACK + MOVE C,(TP) ;RE-GOBBLE NEW PVP + SUB B,[1,,1] ;FIX FOR STACK + MOVEM B,TPBASE+1(C) + +;SETUP INITIAL BINDING + + PUSH B,$TBIND + MOVEM B,SPBASE+1(C) ;SAVE AS BASE OF SP + MOVEM B,SPSTO+1(C) ;AND CURRENT THEREOF + MOVEM B,CURFCN+1(C) ; AND AS CURRENT FCN FOR SPEC/UNSPEC LOGIC + PUSH B,IMQUOTE THIS-PROCESS + PUSH B,$TPVP ;GIVE IT PROCESS AS VALUE + PUSH B,C + ADD B,[2,,2] ;FINISH FRAME + MOVEM B,TPSTO+1(C) ;MAKE THIS THE CURRENT STACK POINTER + MOVEM C,PVPSTO+1(C) ;SAVE THE NEW PVP ITSELF + AOS A,IDPROC ;GOBBLE A UNIQUE PROCESS I.D. + MOVEM A,PROCID+1(C) ;SAVE THAT ALSO + AOS A,PTIME ; GET A UNIQUE BINDING ID + MOVEM A,BINDID+1(C) + + MOVSI A,TPVP ;CLOBBER THE TYPE + MOVE B,(TP) ;AND POINTER TO PROCESS + SUB TP,[2,,2] + POPJ P, + +;MINI ROUTINE TO CALL VECTOR WITH COUNT IN A + +IVECT: PUSH TP,$TFIX + PUSH TP,A + MCALL 1,VECTOR ;GOBBLE THE VECTOR + POPJ P, + + +;SUBROUTINE TO SWAP A PROCESS IN +;CALLED WITH JSP A,SWAP AND NEW PVP IN B + +SWAP: ;FIRST STORE ALL THE ACS + + MOVE PVP,PVSTOR+1 + MOVE SP,$TSP ; STORE SPSAVE + MOVEM SP,SPSTO(PVP) + MOVE SP,SPSTOR+1 + IRP A,,[SP,AB,TB,TP,P,M,R,FRM] + MOVEM A,A!STO+1(PVP) + TERMIN + + SETOM 1(TP) ; FENCE POST MAIN STACK + MOVEM TP,TPSAV(TB) ; CORRECT FRAME + SETZM PSAV(TB) ; CLEAN UP CURRENT FRAME + SETZM SPSAV(TB) + SETZM PCSAV(TB) + + MOVE E,PVP ;RETURN OLD PROCESS IN E + MOVE PVP,D ;AND MAKE NEW ONE BE D + MOVEM PVP,PVSTOR+1 + +SWAPIN: + ;NOW RESTORE NEW PROCESSES AC'S + + MOVE PVP,PVSTOR+1 + IRP A,,[AB,TB,SP,TP,P,M,R,FRM] + MOVE A,A!STO+1(PVP) + TERMIN + + SETZM SPSTO(PVP) + MOVEM SP,SPSTOR+1 + JRST (C) ;AND RETURN + + + + +;SUBRS ASSOCIATED WITH TYPES + +;TYPE (ITYPE) ARE FUNCTIONS TO RETURN THE ATOMIC NAME OF THE +;TYPE OF A GOODIE. TYPE TAKES ITS ARGS ON AP AND RETURNS IN A AND B. +;ITYPE TAKES ITS ARGS IN A AND B AND RETURNS IN SAME (B=0) FOR INVALID +;TYPECODE. +MFUNCTION TYPE,SUBR + + ENTRY 1 + GETYP A,(AB) ;TYPE INTO A +TYPE1: PUSHJ P,ITYPE ;GO TO INTERNAL + JUMPN B,FINIS ;GOOD RETURN +TYPERR: ERRUUO EQUOTE TYPE-UNDEFINED + +CITYPE: GETYP A,A ; GET TYPE FOR COMPILER CALL +ITYPE: LSH A,1 ;TIMES 2 + HRLS A ;TO BOTH SIDES + ADD A,TYPVEC+1 ;GET ACTUAL LOCATION + JUMPGE A,TYPERR ;LOST, TYPE OUT OF BOUNDS + MOVE B,1(A) ;PICKUP TYPE + HLLZ A,(A) + POPJ P, + +; PREDICATE -- IS OBJECT OF TYPE SPECIFIED + +MFUNCTION %TYPEQ,SUBR,[TYPE?] + + ENTRY + + MOVE D,AB ; GET ARGS + ADD D,[2,,2] + JUMPGE D,TFA + MOVE A,(AB) + HLRE C,D + MOVMS C + ASH C,-1 ; FUDGE + PUSHJ P,ITYPQ ; GO INTERNAL + JFCL + JRST FINIS + +ITYPQ: GETYP A,A ; OBJECT + PUSHJ P,ITYPE +TYPEQ0: SOJL C,CIFALS + GETYP 0,(D) + CAIE 0,TATOM ; Type name must be an atom + JRST WRONGT + CAMN B,1(D) ; Same as the OBJECT? + JRST CPOPJ1 ; Yes, return type name + ADD D,[2,,2] + JRST TYPEQ0 ; No, continue comparing + +CIFALS: MOVEI B,0 + MOVSI A,TFALSE + POPJ P, + +CTYPEQ: SOJE A,CIFALS ; TREAT NO ARGS AS FALSE + MOVEI D,1(A) ; FIND BASE OF ARGS + ASH D,1 + HRLI D,(D) + SUBM TP,D ; D POINTS TO BASE + MOVE E,D ; SAVE FOR TP RESTORE + ADD D,[3,,3] ; FUDGE + MOVEI C,(A) ; NUMBER OF TYPES + MOVE A,-2(D) + PUSHJ P,ITYPQ + JFCL ; IGNORE SKIP FOR NOW + MOVE TP,E ; SET TP BACK + JUMPL B,CPOPJ1 ; SKIP + POPJ P, + +; Entries to get type codes for types for fixing up RSUBRs and assembling + +MFUNCTION %TYPEC,SUBR,[TYPE-C] + + ENTRY + + JUMPGE AB,TFA + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP1 + MOVE B,1(AB) + CAMGE AB,[-3,,0] ; skip if only type name given + JRST GTPTYP + MOVE C,IMQUOTE ANY + +TYPEC1: PUSHJ P,CTYPEC ; go to internal + JRST FINIS + +GTPTYP: CAMGE AB,[-5,,0] + JRST TMA + GETYP 0,2(AB) + CAIE 0,TATOM + JRST WTYP2 + MOVE C,3(AB) + JRST TYPEC1 + +CTYPEC: PUSH P,C ; save primtype checker + PUSHJ P,TYPFND ; search type vector + JRST CTPEC2 ; create the poor loser + POP P,B + CAMN B,IMQUOTE ANY + JRST CTPEC1 + CAMN B,IMQUOTE TEMPLATE + JRST TCHK + PUSH P,D + HRRZ A,(A) + ANDI A,SATMSK + PUSH P,A + PUSHJ P,TYPLOO + HRRZ 0,(A) + ANDI 0,SATMSK + CAME 0,(P) + JRST TYPDIF + MOVE D,-1(P) + SUB P,[2,,2] +CTPEC1: MOVEI B,(D) + MOVSI A,TTYPEC + POPJ P, +TCHK: PUSH P,D ; SAVE TYPE + MOVE A,D ; GO TO SAT + PUSHJ P,SAT + CAIG A,NUMSAT ; SKIP IF A TEMPLATE + JRST TYPDIF + POP P,D ; RESTORE TYPE + JRST CTPEC1 + +CTPEC2: POP P,C ; GET BACK PRIMTYPE + SUBM M,(P) + PUSH TP,$TATOM + PUSH TP,B + CAMN C,IMQUOTE ANY + JRST CTPEC3 + PUSH TP,$TATOM + PUSH TP,C + MCALL 2,NEWTYPE ; CREATE THE POOR GUY + MOVE C,IMQUOTE ANY + SUBM M,(P) ; UNRELATIVIZE + JRST CTYPEC + +CTPEC3: HRRZ 0,FSAV(TB) + CAIE 0,%TYPEC + CAIN 0,%TYPEW + JRST TYPERR + + MCALL 1,%TYPEC + JRST MPOPJ + +MFUNCTION %TYPEW,SUBR,[TYPE-W] + + ENTRY + + JUMPGE AB,TFA + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP1 + MOVEI D,0 + MOVE C,IMQUOTE ANY + MOVE B,1(AB) + CAMGE AB,[-3,,0] + JRST CTYPW1 + +CTYPW3: PUSHJ P,CTYPEW + JRST FINIS + +CTYPW1: GETYP 0,2(AB) + CAIE 0,TATOM + JRST WTYP2 + CAMGE AB,[-5,,0] ; JUMP IF RH IS GIVEN + JRST CTYPW2 +CTYPW5: MOVE C,3(AB) + JRST CTYPW3 + +CTYPW2: CAMGE AB,[-7,,0] + JRST TMA + GETYP 0,4(AB) + CAIE 0,TFIX + JRST WRONGT + MOVE D,5(AB) + JRST CTYPW5 + +CTYPEW: PUSH P,D + PUSHJ P,CTYPEC ; GET CODE IN B + POP P,B + HRLI B,(D) + MOVSI A,TTYPEW + POPJ P, + +MFUNCTION %VTYPE,SUBR,[VALID-TYPE?] + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP1 + MOVE B,1(AB) + + PUSHJ P,CVTYPE + JFCL + JRST FINIS + +CVTYPE: PUSHJ P,TYPFND ; LOOK IT UP + JRST PFALS + + MOVEI B,(D) + MOVSI A,TTYPEC + JRST CPOPJ1 + +PFALS: MOVEI B,0 + MOVSI A,TFALSE + POPJ P, + +;PRIMTTYPE RETURNS THE TYPE ATOM OF A PRIMITIVE TYPE IN A CLASS + +STBL: REPEAT NUMSAT,SETZ MQUOTE INTERNAL-TYPE + +LOC STBL + +IRP A,,[[1WORD,WORD],[2WORD,LIST],[NWORD,UVECTOR],[2NWORD,VECTOR],[STORE,STORAGE] +[ARGS,TUPLE],[FRAME,FRAME],[ATOM,ATOM],[LOCID,LOCD],[CHSTR,STRING],[OFFS,OFFSET,1] +[PVP,PROCESS,1],[ASOC,ASOC,1],[LOCA,LOCA],[LOCS,LOCS],[LOCU,LOCU],[LOCV,LOCV] +[LOCL,LOCL],[LOCN,LOCAS],[LOCT,LOCT,1],[LOCR,LOCR],[LOCB,LOCB,1],[BYTE,BYTES,1]] +IRP B,C,[A] +LOC STBL+S!B +IRP X,Y,[C] +IFSE [Y],SETZ IMQUOTE X +IFSN [Y],SETZ MQUOTE X +.ISTOP +TERMIN +.ISTOP + +TERMIN +TERMIN + +LOC STBL+NUMSAT+1 + + +MFUNCTION TYPEPRIM,SUBR + + ENTRY 1 + GETYP A,(AB) + CAIE A,TATOM + JRST NOTATOM + MOVE B,1(AB) + PUSHJ P,CTYPEP + JRST FINIS + +CTYPEP: PUSHJ P,TYPLOO ; CONVERT ATOM TO CODE + HRRZ A,(A) ; SAT TO A + ANDI A,SATMSK + JRST PTYP1 + +MFUNCTION PTSATC,SUBR,[PRIMTYPE-C] + + ENTRY 1 + + GETYP A,(AB) + CAIE A,TATOM + JRST WTYP1 + MOVE B,1(AB) + PUSHJ P,CPRTYC + JRST FINIS + +CPRTYC: PUSHJ P,TYPLOO + MOVE B,(A) + ANDI B,SATMSK + MOVSI A,TSATC + POPJ P, + + +IMFUNCTION PRIMTYPE,SUBR + + ENTRY 1 + + MOVE A,(AB) ;GET TYPE + PUSHJ P,CPTYPE + JRST FINIS + +CPTYPE: GETYP A,A + PUSHJ P,SAT ;GET SAT +PTYP1: JUMPE A,TYPERR + MOVE B,IMQUOTE TEMPLATE + CAIG A,NUMSAT ; IF BIG SAT, THEN TEMPLATE + MOVE B,@STBL(A) + MOVSI A,TATOM + POPJ P, + + +; RSUBR MAKES A VECTOR INTO AN OBJECT OF TYPE RSUBR, ALSO SLIGHTLY MUNGING IT + +IMFUNCTION RSUBR,SUBR + ENTRY 1 + + GETYP A,(AB) + CAIE A,TVEC ; MUST BE VECTOR + JRST WTYP1 + MOVE B,1(AB) ; GET IT + GETYP A,(B) ; CHECK 1ST ELEMENTS TYPE + CAIN A,TPCODE ; PURE CODE + JRST .+3 + CAIE A,TCODE + JRST NRSUBR + HLRM B,(B) ; CLOBEER SPECIAL COUNT FIELD + MOVSI A,TRSUBR + JRST FINIS + +NRSUBR: ERRUUO EQUOTE FIRST-ELEMENT-OF-VECTOR-NOT-CODE + +; ROUTINE TO GENERATE ENTRYY OTHER THAN FIRST TO RSUBRR + +IMFUNCTION MENTRY,SUBR,[RSUBR-ENTRY] + + ENTRY 2 + + GETYP 0,(AB) ; TYPE OF ARG + CAIE 0,TVEC ; BETTER BE VECTOR + JRST WTYP1 + GETYP 0,2(AB) + CAIE 0,TFIX + JRST WTYP2 + MOVE B,1(AB) ; GET VECTOR + CAML B,[-3,,0] + JRST BENTRY + GETYP 0,(B) ; FIRST ELEMENT + CAIE 0,TRSUBR + JRST MENTR1 +MENTR2: GETYP 0,2(B) + CAIE 0,TATOM + JRST BENTRY + MOVE C,3(AB) + HRRM C,2(B) ; OFFSET INTO VECTOR + HLRM B,(B) + MOVSI A,TENTER + JRST FINIS + +MENTR1: CAIE 0,TATOM + JRST BENTRY + MOVE B,1(B) ; GET ATOM + PUSHJ P,IGVAL ; GET VAL + GETYP 0,A + CAIE 0,TRSUBR + JRST BENTRY + MOVE C,1(AB) ; RESTORE B + MOVEM A,(C) + MOVEM B,1(C) + MOVE B,C + JRST MENTR2 + +BENTRY: ERRUUO EQUOTE BAD-VECTOR + +; SUBR TO GET ENTRIES OFFSET + +MFUNCTION LENTRY,SUBR,[ENTRY-LOC] + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TENTER + JRST WTYP1 + MOVE B,1(AB) + HRRZ B,2(B) + MOVSI A,TFIX + JRST FINIS + +; RETURN FALSE + +RTFALS: MOVSI A,TFALSE + MOVEI B,0 + POPJ P, + +;SUBROUTINE CALL FOR RSUBRs +RCALL: SUBM M,(P) ;CALCULATE PC's OFFSET IN THE RSUBR + HRLI 0,400000 ; DONT LOSE IN MULTI SEG MODE + + PUSHJ P,@0 ;GO TO THE PROPER SUBROUTINE + SUBM M,(P) ;RECONSTITUTE THE RSUBR's PC + POPJ P, + + + +;CHTYPE TAKES TWO ARGUMENTS. ANY GOODIE AND A AN ATOMIC TYPE NAME +;IT CHECKS THE STORAGE ALLOCATION TYPES OF THE TWO ARE THE SAME AND +;IF THEY ARE CHANGES THE TYPE OF THE FIRST TO THAT NAME D IN THE SECOND + +MFUNCTION CHTYPE,SUBR + + ENTRY 2 + GETYP A,2(AB) ;FIRST CHECK THAT ARG 2 IS AN ATOM + CAIE A,TATOM + JRST NOTATOM + MOVE B,3(AB) ;AND TYPE NAME + PUSHJ P,TYPLOO ;GO LOOKUP TYPE +TFOUND: HRRZ B,(A) ;GOBBLE THE SAT + TRNE B,CHBIT ; SKIP IF CHTYPABLE + JRST CANTCH + TRNE B,TMPLBT ; TEMPLAT + HRLI B,-1 + AND B,[-1,,SATMSK] + GETYP A,(AB) ;NOW GET TYPE TO HACK + PUSHJ P,SAT ;FIND OUT ITS SAT + JUMPE A,TYPERR ;COMPLAIN + CAILE A,NUMSAT + JRST CHTMPL ; JUMP IF TEMPLATE DATA + CAIE A,(B) ;DO THEY AGREE? + JRST TYPDIF ;NO, COMPLAIN +CHTMP1: MOVSI A,(D) ;GET NEW TYPE + HRR A,(AB) ; FOR DEFERRED GOODIES + JUMPL B,CHMATC ; CHECK IT + MOVE B,1(AB) ;AND VALUE + JRST FINIS + +CHTMPL: MOVE E,1(AB) ; GET ARG + HLRZ A,(E) + ANDI A,SATMSK + MOVE 0,3(AB) ; SEE IF TO "TEMPLATE" + CAMN 0,IMQUOTE TEMPLATE + JRST CHTMP1 + TLNN E,-1 ; SKIP IF RESTED + CAIE A,(B) + JRST TYPDIF + JRST CHTMP1 + +CHMATC: PUSH TP,A + PUSH TP,1(AB) ; SAVE GOODIE + MOVSI A,TATOM + MOVE B,3(AB) + MOVSI C,TATOM + MOVE D,IMQUOTE DECL + PUSHJ P,IGET ; FIND THE DECL + PUSH TP,A + PUSH TP,B + MOVE C,(AB) + MOVE D,1(AB) ; NOW GGO TO MATCH + PUSHJ P,TMATCH + JRST CHMAT1 + SUB TP,[2,,2] +CHMAT2: POP TP,B + POP TP,A + JRST FINIS + +CHMAT1: POP TP,B + POP TP,A + MOVE C,-1(TP) + MOVE D,(TP) + PUSHJ P,TMATCH + JRST TMPLVI + JRST CHMAT2 + +TYPLOO: PUSHJ P,TYPFND + ERRUUO EQUOTE BAD-TYPE-NAME + POPJ P, + +TYPFND: HLRE A,B ; FIND DOPE WORDS + SUBM B,A ; A POINTS TO IT + HRRE D,(A) ; TYPE-CODE TO D + JUMPE D,CPOPJ + ANDI D,TYPMSK ; FLUSH FUNNY BITS + MOVEI A,(D) + ASH A,1 + HRLI A,(A) + ADD A,TYPVEC+1 +CPOPJ1: AOS (P) + POPJ P, + + +REPEAT 0,[ + MOVE A,TYPVEC+1 ;GOBBLE DOWN TYPE VECTOR + MOVEI D,0 ;INITIALIZE TYPE COUNTER +TLOOK: CAMN B,1(A) ;CHECK THIS ONE + JRST CPOPJ1 + ADDI D,1 ;BUMP COUNTER + AOBJP A,.+2 ;COUTN DOWN ON VECTOR + AOBJN A,TLOOK + POPJ P, +CPOPJ1: AOS (P) + POPJ P, +] + +TYPDIF: ERRUUO EQUOTE STORAGE-TYPES-DIFFER + + +TMPLVI: ERRUUO EQUOTE DECL-VIOLATION + + +; FUNCTION TO ADD A NEW TYPE TO THE WORLD WITH GIVEN PRIMITIVE TYPE + +MFUNCTION NEWTYPE,SUBR + + ENTRY + + HLRZ 0,AB ; CHEC # OF ARGS + CAILE 0,-4 ; AT LEAST 2 + JRST TFA + CAIGE 0,-6 + JRST TMA ; NOT MORE THAN 3 + GETYP A,(AB) ; GET 1ST ARGS TYPE (SHOULD BE ATOM) + GETYP C,2(AB) ; SAME WITH SECOND + CAIN A,TATOM ; CHECK + CAIE C,TATOM + JRST NOTATOM + + MOVE B,3(AB) ; GET PRIM TYPE NAME + PUSHJ P,TYPLOO ; LOOK IT UP + HRRZ A,(A) ; GOBBLE SAT + ANDI A,SATMSK + HRLI A,TATOM ; MAKE NEW TYPE + PUSH P,A ; AND SAVE + MOVE B,1(AB) ; SEE IF PREV EXISTED + PUSHJ P,TYPFND + JRST NEWTOK ; DID NOT EXIST BEFORE + MOVEI B,2(A) ; FOR POSSIBLE TMPLAT BIT + HRRZ A,(A) ; GET SAT + HRRZ 0,(P) ; AND PROPOSED + ANDI A,SATMSK + ANDI 0,SATMSK + CAIN 0,(A) ; SKIP IF LOSER + JRST NEWTFN ; O.K. + + ERRUUO EQUOTE TYPE-ALREADY-EXISTS + +NEWTOK: POP P,A + MOVE B,1(AB) ; NEWTYPE NAME + PUSHJ P,INSNT ; MUNG IN NEW TYPE + +NEWTFN: CAML AB,[-5,,] ; SKIP IF TEMPLAT SUPPLIED + JRST NEWTF1 + MOVEI 0,TMPLBT ; GET THE BIT + IORM 0,-2(B) ; INTO WORD + MOVE A,(AB) ; GET TYPE NAME + MOVE B,1(AB) + MOVSI C,TATOM + MOVE D,IMQUOTE DECL + PUSH TP,4(AB) ; GET TEMLAT + PUSH TP,5(AB) + PUSHJ P,IPUT +NEWTF1: MOVE A,(AB) + MOVE B,1(AB) ; RETURN NAME + JRST FINIS + +; SET UP GROWTH FIELDS + +IGROWT: SKIPA A,[111100,,(C)] +IGROWB: MOVE A,[001100,,(C)] + HLRE B,C + SUB C,B ; POINT TO DOPE WORD + MOVE B,TYPIC ; INDICATED GROW BLOCK + DPB B,A + POPJ P, + +INSNT: PUSH TP,A + PUSH TP,B ; SAVE NAME OF NEWTYPE + MOVE C,TYPBOT+1 ; CHECK GROWTH NEED + CAMGE C,TYPVEC+1 + JRST ADDIT ; STILL ROOM +GAGN: PUSHJ P,IGROWB ; SETUP BOTTOM GROWTH + SKIPE C,EVATYP+1 + PUSHJ P,IGROWT ; SET UP TOP GROWTH + SKIPE C,APLTYP+1 + PUSHJ P,IGROWT + SKIPE C,PRNTYP+1 + PUSHJ P,IGROWT + MOVE C,[11.,,5] ; SET UP INDICATOR FOR AGC + PUSHJ P,AGC ; GROW THE WORLD + AOJL A,GAGN ; BAD AGC LOSSAGE + MOVE 0,[-101,,-100] + ADDM 0,TYPBOT+1 ; FIX UP POINTER + +ADDIT: MOVE C,TYPVEC+1 + SUB C,[2,,2] ; ALLOCATE ROOM + MOVEM C,TYPVEC+1 + HLRE B,C ; PREPARE TO BLT + SUBM C,B ; C POINTS DOPE WORD END + HRLI C,2(C) ; GET BLT AC READY + BLT C,-3(B) + POP TP,-1(B) ; CLOBBER IT IN + POP TP,-2(B) + HLRE C,TYPVEC+1 ; GET CODE + MOVNS C + ASH C,-1 + SUBI C,1 + MOVE D,-1(B) ; B HAS POINTER TO TYPE VECTOR DOPE WORDS + MOVEI 0,(D) + CAIG 0,HIBOT ; IS ATOM PURE? + JRST ADDNOI ; NO, SO NO HACKING REQUIRED + PUSH P,C + MOVE B,D + PUSHJ P,IMPURIF ; DO IMPURE OF ATOM + MOVE C,TYPVEC+1 + HLRE B,C + SUBM C,B ; RESTORE B + POP P,C + MOVE D,-1(B) ; RESTORE D +ADDNOI: HLRE A,D + SUBM D,A + TLO C,400000 + HRRM C,(A) ; INTO "GROWTH" FIELD + POPJ P, + + +; Interface to interpreter for setting up tables associated with +; template data structures. +; A/ <-name of type>- +; B/ <-length ins>- +; C/ <-uvector of garbage collector code or 0> +; D/ <-uvector of GETTERs>- +; E/ <-uvector of PUTTERs>- + +CTMPLT: SUBM M,(P) ; could possibly gc during this stuff + PUSH TP,$TATOM ; save name of type + PUSH TP,A + PUSH P,B ; save length instr + HLRE A,TD.LNT+1 ; check for template slots left? + HRRZ B,TD.LNT+1 + SUB B,A ; point to dope words + HLRZ B,1(B) ; get real length + ADDI A,-2(B) + JUMPG A,GOODRM ; jump if ok + + PUSH TP,$TUVEC ; save getters and putters + PUSH TP,C + PUSH TP,$TUVEC ; save getters and putters + PUSH TP,D + PUSH TP,$TUVEC + PUSH TP,E + MOVEI A,10-2(B) ; grow it 10 by copying remember d.w. length + PUSH P,A ; save new length + PUSHJ P,CAFRE1 ; get frozen uvector + ADD B,[10,,10] ; rest it down some + HRL C,TD.LNT+1 ; prepare to BLT in + MOVEM B,TD.LNT+1 ; and save as new length vector + HRRI C,(B) ; destination + ADD B,(P) ; final destination address + BLT C,-12(B) + MOVE A,(P) ; length for new getters + PUSHJ P,CAFRE1 + HRL C,TD.GET+1 ; get old for copy + MOVEM B,TD.GET+1 + PUSHJ P,DOBLTS ; go fixup new uvector + MOVE A,(P) ; finally putters + PUSHJ P,CAFRE1 + HRL C,TD.PUT+1 + MOVEM B,TD.PUT+1 + PUSHJ P,DOBLTS ; go fixup new uvector + MOVE A,(P) ; finally putters + PUSHJ P,CAFRE1 + HRL C,TD.AGC+1 + MOVEM B,TD.AGC+1 + PUSHJ P,DOBLTS ; go fixup new uvector + SUB P,[1,,1] ; flush stack craft + MOVE E,(TP) + MOVE D,-2(TP) + MOVE C,-4(TP) ;GET TD.AGC + SUB TP,[6,,6] + +GOODRM: MOVE B,TD.LNT+1 ; move down to fit new guy + SUB B,[1,,1] ; will always win due to prev checks + MOVEM B,TD.LNT+1 + HRLI B,1(B) + HLRE A,TD.LNT+1 + MOVNS A + ADDI A,-1(B) ; A/ final destination + BLT B,-1(A) + POP P,(A) ; new length ins munged in + HLRE A,TD.LNT+1 + MOVNS A ; A/ offset for other guys + PUSH P,A ; save it + ADD A,TD.GET+1 ; point for storing uvs of ins + MOVEM D,-1(A) + MOVE A,(P) + ADD A,TD.PUT+1 + MOVEM E,-1(A) ; store putter also + MOVE A,(P) + ADD A,TD.AGC+1 + MOVEM C,-1(A) ; store putter also + POP P,A ; compute primtype + ADDI A,NUMSAT + PUSH P,A + MOVE B,(TP) ; ready to mung type vector + SUB TP,[2,,2] + PUSHJ P,TYPFND ; CHECK TO SEE WHETHER TEMPLATE EXISTS + JRST NOTEM + POP P,C ; GET SAT + HRRM C,(A) + JRST MPOPJ +NOTEM: POP P,A ; RESTORE SAT + HRLI A,TATOM ; GET TYPE + PUSHJ P,INSNT ; INSERT INTO VECTOR + JRST MPOPJ + +; this routine copies GET and PUT vectors into new ones + +DOBLTS: HRRI C,(B) + ADD B,-1(P) + BLT C,-11(B) ; zap those guys in + MOVEI A,TUVEC ; mung in uniform type + PUTYP A,(B) + MOVEI C,-7(B) ; zero out remainder of uvector + HRLI C,-10(B) + SETZM -1(C) + BLT C,-1(B) + POPJ P, + + +; FUNCTIONS TO SET UP EVALUATION AND APPLICATION RULES FOR DATA TYPES + +MFUNCTION EVALTYPE,SUBR + + ENTRY + + PUSHJ P,CHKARG ; VERIFY WINNAGE IN ARGS + MOVEI A,EVATYP ; POINT TO TABLE + MOVEI E,EVTYPE ; POINT TO PURE VERSION + MOVEI 0,EVAL +TBLCAL: PUSHJ P,TBLSET ; SETUP TABLE ENTRY + JRST FINIS + +MFUNCTION APPLYTYPE,SUBR + + ENTRY + + PUSHJ P,CHKARG + MOVEI A,APLTYP ; POINT TO APPLY TABLE + MOVEI E,APTYPE ; PURE TABLE + MOVEI 0,APPLY + JRST TBLCAL + + +MFUNCTION PRINTTYPE,SUBR + + ENTRY + + PUSHJ P,CHKARG + MOVEI A,PRNTYP ; POINT TO APPLY TABLE + MOVEI E,PRTYPE ; PURE TABLE + MOVEI 0,PRINT + JRST TBLCAL + +; CHECK ARGS AND SETUP FOR TABLE HACKER + +CHKARG: JUMPGE AB,TFA + CAMGE AB,[-5,,] + JRST TMA + GETYP A,(AB) ; 1ST MUST BE TYPE NAME + CAIE A,TATOM + JRST WTYP1 + MOVE B,1(AB) ; GET ATOM + PUSHJ P,TYPLOO ; VERIFY THAT IT IS A TYPE + PUSH P,D ; SAVE TYPE NO. + MOVEI D,-1 ; INDICATE FUNNYNESS + CAML AB,[-3,,] ; SKIP IF 2 OR MORE + JRST TY1AR + HRRZ A,(A) ; GET SAT + ANDI A,SATMSK + PUSH P,A + GETYP A,2(AB) ; GET 2D TYPE + CAIE A,TATOM ; EITHER TYPE OR APPLICABLE + JRST TRYAPL ; TRY APPLICABLE + MOVE B,3(AB) ; VERIFY IT IS A TYPE + PUSHJ P,TYPLOO + HRRZ A,(A) ; GET SAT + ANDI A,SATMSK + POP P,C ; RESTORE SAVED SAT + CAIE A,(C) ; SKIP IF A WINNER + JRST TYPDIF ; REPORT ERROR +TY1AR: POP P,C ; GET SAVED TYPE + MOVEI B,0 ; TELL THAT WE ARE A TYPE + POPJ P, + +TRYAPL: PUSHJ P,APLQ ; IS THIS APPLICABLE + JRST NAPT + SUB P,[1,,1] + MOVE B,2(AB) ; RETURN SAME + MOVE D,3(AB) + POP P,C + POPJ P, + + +; HERE TO PUT ENTRY IN APPROPRIATE TABLE + +TBLSET: PUSH TP,B + PUSH TP,D ; SAVE VALUE + PUSH TP,$TFIX + PUSH TP,A + PUSH P,C ; SAVE TYPE BEING HACKED + PUSH P,E + SKIPE B,1(A) ; SKIP IF VECTOR DOESN'T EXIST YET + JRST TBL.OK + MOVE B,-2(TP) ; CHECK FOR RETURN IT HACK + SKIPN -3(TP) + CAIE B,-1 + JRST .+2 + JRST RETPM2 + HLRE A,TYPBOT+1 ; GET CURRENT TABLE LNTH + MOVNS A + ASH A,-1 + PUSH P,0 + PUSHJ P,IVECT ; GET VECTOR + POP P,0 + MOVE C,(TP) ; POINT TO RETURN POINT + MOVEM B,1(C) ; SAVE VECTOR + +TBL.OK: POP P,E + POP P,C ; RESTORE TYPE + SUB TP,[2,,2] + POP TP,D + POP TP,A + JUMPN A,TBLOK1 ; JUMP IF FUNCTION ETC. SUPPLIED + CAIN D,-1 + JRST TBLOK1 + CAILE D,NUMPRI ; SKIP IF ORIGINAL TYPE + MOVNI E,(D) ; CAUSE E TO ENDUP 0 + ADDI E,(D) ; POINT TO PURE SLOT +TBLOK1: ADDI C,(C) ; POINT TO VECTOR SLOT + ADDI C,(B) + CAIN D,-1 + JRST RETCUR + JUMPN A,OK.SET ; OK TO CLOBBER + ADDI B,(D) ; POINT TO TARGET TYPE'S SLOT + ADDI B,(D) ; POINT TO TARGET TYPE'S SLOT + SKIPN A,(B) ; SKIP IF WINNER + SKIPE 1(B) ; SKIP IF LOSER + SKIPA D,1(B) ; SETUP D + JRST CH.PTB ; CHECK PURE TABLE + +OK.SET: CAIN 0,(D) ; SKIP ON RESET + SETZB A,D + MOVEM A,(C) ; STORE + MOVEM D,1(C) +RETAR1: MOVE A,(AB) ; RET TYPE + MOVE B,1(AB) + JRST FINIS + +CH.PTB: MOVEI A,0 + MOVE D,[SETZ NAPT] + JUMPE E,OK.SET + MOVE D,(E) + JRST OK.SET + +RETPM2: SUB TP,[4,,4] + SUB P,[2,,2] + ASH C,1 + SOJA E,RETPM4 + +RETCUR: SKIPN A,(C) + SKIPE 1(C) + SKIPA B,1(C) + JRST RETPRM + + JUMPN A,CPOPJ +RETPM1: MOVEI A,0 + JUMPL B,RTFALS + CAMN B,1(E) + JRST .+3 + ADDI A,2 + AOJA E,.-3 + +RETPM3: ADD A,TYPVEC+1 + MOVE B,3(A) + MOVE A,2(A) + POPJ P, + +RETPRM: SUBI C,(B) ; UNDO BADNESS +RETPM4: CAIG C,NUMPRI*2 + SKIPG 1(E) + JRST RTFALS + + MOVEI A,-2(C) + JRST RETPM3 + +CALLTY: MOVE A,TYPVEC + MOVE B,TYPVEC+1 + POPJ P, + +MFUNCTION ALLTYPES,SUBR + + ENTRY 0 + + MOVE A,TYPVEC + MOVE B,TYPVEC+1 + JRST FINIS + +; + +;FUNCTION TO RETURN TYPE OF ELEMENTS IN A UVECTOR + +MFUNCTION UTYPE,SUBR + + ENTRY 1 + + GETYP A,(AB) ;GET U VECTOR + PUSHJ P,SAT + CAIE A,SNWORD + JRST WTYP1 + MOVE B,1(AB) ; GET UVECTOR + PUSHJ P,CUTYPE + JRST FINIS + +CUTYPE: HLRE A,B ;GET -LENGTH + HRRZS B + SUB B,A ;POINT TO TYPE WORD + GETYP A,(B) + JRST ITYPE ; GET NAME OF TYPE + +; FUNCTION TO CHANGE UNIFORM TYPE OF A VECTOR + +MFUNCTION CHUTYPE,SUBR + + ENTRY 2 + + GETYP A,2(AB) ;GET 2D TYPE + CAIE A,TATOM + JRST NOTATO + GETYP A,(AB) ; CALL WITH UVECTOR? + PUSHJ P,SAT + CAIE A,SNWORD + JRST WTYP1 + MOVE A,1(AB) ; GET UV POINTER + MOVE B,3(AB) ;GET ATOM + PUSHJ P,CCHUTY + MOVE A,(AB) ; RETURN UVECTOR + MOVE B,1(AB) + JRST FINIS + +CCHUTY: PUSH TP,$TUVEC + PUSH TP,A + PUSHJ P,TYPLOO ;LOOK IT UP + HRRZ B,(A) ;GET SAT + TRNE B,CHBIT + JRST CANTCH + ANDI B,SATMSK + SKIPGE MKTBS(B) + JRST CANTCH + HLRE C,(TP) ;-LENGTH + HRRZ E,(TP) + SUB E,C ;POINT TO TYPE + GETYP A,(E) ;GET TYPE + JUMPE A,WIN0 ;ALLOW TYPE "LOSE" TO CHANGE TO ANYTHING + PUSHJ P,SAT ;GET SAT + JUMPE A,TYPERR + CAIE A,(B) ;COMPARE + JRST TYPDIF +WIN0: ADDI D,.VECT. + HRLM D,(E) ;CLOBBER NEW ONE + POP TP,B + POP TP,A + POPJ P, + +CANTCH: PUSH TP,$TATOM + PUSH TP,EQUOTE CANT-CHTYPE-INTO + PUSH TP,2(AB) + PUSH TP,3(AB) + MOVEI A,2 + JRST CALER + +NOTATOM: + PUSH TP,$TATOM + PUSH TP,EQUOTE NON-ATOMIC-ARGUMENT + PUSH TP,(AB) + PUSH TP,1(AB) + MOVEI A,2 + JRST CALER + + + +; SUBROUTINE TO LEAVE MUDDLE CLOSING ALL CHANNELS ON THE WAY + +MFUNCTION QUIT,SUBR + + ENTRY 0 + + + PUSHJ P,CLOSAL ; DO THE CLOSES + PUSHJ P,%KILLM + JRST IFALSE ; JUST IN CASE + +CLOSAL: MOVEI B,CHNL0+2 ; POINT TO 1ST (NOT INCLUDING TTY I/O) + MOVE PVP,PVSTOR+1 + MOVE TVP,REALTV+1(PVP) + SUBI B,(TVP) + HRLS B + ADD B,TVP + PUSH TP,$TVEC + PUSH TP,B + PUSH P,[N.CHNS-1] ; MAX NO. OF CHANS + +CLOSA1: MOVE B,(TP) + ADD B,[2,,2] + MOVEM B,(TP) + HLLZS -2(B) + SKIPN C,-1(B) ; THIS ONE OPEN? + JRST CLOSA4 ; NO + CAME C,TTICHN+1 + CAMN C,TTOCHN+1 + JRST CLOSA4 + PUSH TP,-2(B) ; PUSH IT + PUSH TP,-1(B) + MCALL 1,FCLOSE ; CLOSE IT +CLOSA4: SOSLE (P) ; COUNT DOWN + JRST CLOSA1 + + + SUB TP,[2,,2] + SUB P,[1,,1] + +CLOSA3: SKIPN B,CHNL0+1 + POPJ P, + PUSH TP,(B) + HLLZS (TP) + PUSH TP,1(B) + HRRZ B,(B) + MOVEM B,CHNL0+1 + MCALL 1,FCLOSE + JRST CLOSA3 + + +IMPURE + +WHOAMI: 0 ; SYAYS WHETHER I AM REALLY A MUDDLE OR SOME HACK + + +;GARBAGE COLLECTORS PDLS + + +GCPDL: -GCPLNT,,GCPDL + + BLOCK GCPLNT + + +PURE + +MUDSTR: ASCII /MUDDLE / +STRNG: -1 + -1 + -1 + ASCIZ / IN OPERATION./ + +;MARKED PDLS FOR GC PROCESS + +VECTGO +; DUMMY FRAME FOR INITIALIZER CALLS + + TENTRY,,LISTEN + 0 + .-3 + 0 + 0 + -ITPLNT,,TPBAS-1 + 0 + +TPBAS: BLOCK ITPLNT+PDLBUF + GENERAL + ITPLNT+2+PDLBUF+7,,0 + + +VECRET + + +$TMATO: TATOM,,-1 + +END + \ No newline at end of file diff --git a//main.mid.351 b//main.mid.351 new file mode 100644 index 0000000..6b7ae6e --- /dev/null +++ b//main.mid.351 @@ -0,0 +1,2058 @@ +TITLE MAIN LOOP AND GLOBALLY REFERENCED SUBROUTINES + +RELOCA + +.GLOBAL TBINIT,PIDSTO,PROCID,PTIME,GCPDL,PBASE,TYPTOP,RERR,FRMSTK,EMERGE +.GLOBAL PDLBUF,INTINT,START,SWAP,ICR,SPBASE,TPBASE,TPBAS,CURPRI,CHFINI,MKTBS +.GLOBAL TOPLEVEL,INTOBL,INITIA,ERROBL,MAINPR,RESFUN,STATUS,TYPVEC,ROOT,TTICHN,TTOCHN +.GLOBAL TTYOPE,MOPEN,MCLOSE,MIOT,ILVAL,MESS,ERROR,CHFRM,IGVAL,TYPBOT,ASOVEC +.GLOBAL PRINT,PRIN1,PRINC,MUDSTR,VECBOT,CSTACK,IFALSE,TYPLOO,RCALL,SWAPIN,CTMPLT +.GLOBAL IDPROC,CHFSWP,ILOC,MAKACT,BNDV,SPECSTORE,BINDID,IGLOC,MTYO,MSGTYP,CAFRE1,CPOPJ +.GLOBAL EVATYP,EVTYPE,APLTYP,APTYPE,PRNTYP,PRTYPE,AGC,SGSNAM,NAPT,APLQ,STRTO6 +.GLOBAL 6TOCHS,TYPFND,STBL,CHNL0,N.CHNS,CLOSAL,%LOGOUT,%SSNAM,%RSNAM,%KILLM,SAT +.GLOBAL MAKINF,%VALRET,COMPERR,IPUT,IGET,TMATCH,INITIZ,IPCINI,%UNAM,%JNAM,%RUNAM,%RJNAM,%RXUNA,%RXJNA,%VALFI +.GLOBAL NOTTY,DEMFLG,CFRAME,CARGS,CFUNCT,CITYPE,CTYPEQ,CPTYPE,CTYPEP,CUTYPE, +.GLOBAL CCHUTY,RTFALS,PGINT,PURCLN,CTYPEC,CTYPEW,IDVAL1,CALLTY,MESSAG,INITFL,WHOAMI +.GLOBAL %SLEEP,%HANG,%TOPLQ,ONINT,CHUNW,CURFCN,BUFRIN,TD.LNT,TD.GET,TD.AGC,TD.PUT,MPOPJ +.GLOBAL PURVEC,PLOAD,SSPECS,OUTRNG,CVTYPE,FSTART,CKVRS,CPRTYC,PVSTOR,SPSTOR +.GLOBAL TYPIC,CISET,LSTUF,IMPURI,REALTV +.INSRT MUDDLE > + +;MAIN LOOP AND STARTUP + +START: MOVEI 0,0 ; SET NO HACKS + JUMPE 0,START1 + TLNE 0,-1 ; SEE IF CHANNEL + JRST START1 + MOVE P,GCPDL + MOVE A,0 + PUSH P,A + PUSHJ P,CKVRS ; CHECK VERSION NUMBERS + POP P,A + JRST FSTART ; GO RESTORE +START1: MOVEM 0,WHOAMI ; HACK FOR TS FOO linked to TS MUDDLE + MOVE PVP,MAINPR ; MAKE SURE WE START IN THE MAIN PROCESS + JUMPE 0,INITIZ ; MIGHT BE RESTART + MOVE P,PSTO+1(PVP) ; SET UP FOR BOOTSTRAP HACK + MOVE TP,TPSTO+1(PVP) +INITIZ: MOVE PVP,MAINPR + SKIPN P ; IF NO CURRENT P + MOVE P,PSTO+1(PVP) ; PDL TO GET OFF THE GROUND + SKIPN TP ; SAME FOR TP + MOVE TP,TPSTO+1(PVP) ; GET A TP TO WORK WITH + SETZB R,M ; RESET RSUBR AC'S + PUSHJ P,%RUNAM + JFCL + PUSHJ P,%RJNAM + PUSHJ P,TTYOPE ;OPEN THE TTY + MOVEI B,MUDSTR + SKIPE WHOAMI ; SKIP IF THIS IS MUDDLE + JRST NODEMT ; ELSE NO MESSAGE + SKIPE DEMFLG ; SKIP IF NOT DEMON + JRST NODEMT + SKIPN NOTTY ; IF NO TTY, IGNORE + PUSHJ P,MSGTYP ;TYPE OUT TO USER + +NODEMT: XCT MESSAG ;MAYBE PRINT A MESSAGE + PUSHJ P,INTINT ;INITIALIZE INTERRUPT HANDLER + XCT IPCINI + PUSHJ P,PURCLN ; CLEAN UP PURE SHARED AREA +RESTART: ;RESTART A PROCESS +STP: MOVEI C,0 + MOVE PVP,PVSTOR+1 + MOVE B,TBINIT+1(PVP) ;POINT INTO STACK AT START + PUSHJ P,CHUNW ; LEAVE WHILE DOING UNWIND CHECK + MOVEI E,TOPLEV + MOVEI A,TFALSE ; IN CASE FALLS OFF PROCESS + MOVEI B,0 + HRRM E,-1(TB) + JRST CONTIN + + IMQUOTE TOPLEVEL +TOPLEVEL: + MCALL 0,LISTEN + JRST TOPLEVEL + + +IMFUNCTION LISTEN,SUBR + + ENTRY + PUSH P,[0] ;FLAG: DON'T PRINT ERROR MSG + JRST ER1 + +; USER SUPPLIED ERROR HANDLER, TEMPORARY KLUDGE + IMQUOTE ERROR + +ERROR: MOVE B,IMQUOTE ERROR + PUSHJ P,IGVAL ; GET VALUE + GETYP C,A + CAIN C,TSUBR ; CHECK FOR NO CHANGE + CAIE B,RERR1 ; SKIP IF NOT CHANGED + JRST .+2 + JRST RERR1 ; GO TO THE DEFAULT + PUSH TP,A ; SAVE VALUE + PUSH TP,B + MOVE C,AB ; SAVE AB + MOVEI D,1 ; AND COUNTER +USER1: PUSH TP,(C) ; PUSH THEM + PUSH TP,1(C) + ADD C,[2,,2] ; BUMP + ADDI D,1 + JUMPL C,USER1 + ACALL D,APPLY ; EVAL USERS ERROR + JRST FINIS + + + +IMFUNCTION ERROR%,SUBR,ERROR + +RERR1: ENTRY + PUSH TP,$TATOM + PUSH TP,MQUOTE ERROR,ERROR,INTRUP + PUSHJ P,FRMSTK ; PUT ERROR'S FRAME ON STACK + MOVEI D,2 + MOVE C,AB +RERR2: JUMPGE C,RERR22 + PUSH TP,(C) + PUSH TP,1(C) + ADD C,[2,,2] + AOJA D,RERR2 +RERR22: ACALL D,EMERGENCY + JRST RERR + +IMQUOTE ERROR +RERR: ENTRY + PUSH P,[-1] ;PRINT ERROR FLAG + +ER1: MOVE B,IMQUOTE INCHAN + PUSHJ P,ILVAL ; CHECK INPUT CHANNEL IS SOME KIND OF TTY + GETYP A,A + CAIE A,TCHAN ; SKIP IF IT IS A CHANNEL + JRST ER2 ; NO, MUST REBIND + CAMN B,TTICHN+1 + JRST NOTINC +ER2: MOVE B,IMQUOTE INCHAN + MOVEI C,TTICHN ; POINT TO VALU + PUSHJ P,PUSH6 ; PUSH THE BINDING + MOVE B,TTICHN+1 ; GET IN CHAN +NOTINC: SKIPN DEMFLG ; SKIP IF DEMON + SKIPE NOTTY + JRST NOECHO + PUSH TP,$TCHAN + PUSH TP,B + PUSH TP,$TATOM + PUSH TP,IMQUOTE T + MCALL 2,TTYECH ; ECHO INPUT +NOECHO: MOVE B,IMQUOTE OUTCHAN + PUSHJ P,ILVAL ; GET THE VALUE + GETYP A,A + CAIE A,TCHAN ; SKIP IF OK CHANNEL + JRST ER3 ; NOT CHANNEL, MUST REBIND + CAMN B,TTOCHN+1 + JRST NOTOUT +ER3: MOVE B,IMQUOTE OUTCHAN + MOVEI C,TTOCHN + PUSHJ P,PUSH6 ; PUSH THE BINDINGS +NOTOUT: MOVE B,IMQUOTE OBLIST + PUSHJ P,ILVAL ; GET THE VALUE OF OBLIST + PUSHJ P,OBCHK ; IS IT A WINNER ? + SKIPA A,$TATOM ; NO, SKIP AND CONTINUE + JRST NOTOBL ; YES, DO NOT DO REBINDING + MOVE B,IMQUOTE OBLIST + PUSHJ P,IGLOC + GETYP 0,A + CAIN 0,TUNBOU + JRST MAKOB ; NO GLOBAL OBLIST, MAKE ONE + MOVEI C,(B) ; COPY ADDRESS + MOVE A,(C) ; GET THE GVAL + MOVE B,(C)+1 + PUSHJ P,OBCHK ; IS IT A WINNER ? + JRST MAKOB ; NO, GO MAKE A NEW ONE + MOVE B,IMQUOTE OBLIST + PUSHJ P,PUSH6 + +NOTOBL: PUSH TP,[TATOM,,-1] ;FOR BINDING + PUSH TP,IMQUOTE LER,[LERR ]INTRUP + PUSHJ P,MAKACT + HRLI A,TFRAME ; CORRCT TYPE + PUSH TP,A + PUSH TP,B + PUSH TP,[0] + PUSH TP,[0] + MOVE A,PVSTOR+1 ; GET PROCESS + ADD A,[PROCID,,PROCID] ; POINT TO ID (ALSO LEVEL) + PUSH TP,BNDV + PUSH TP,A + MOVE A,PROCID(PVP) + ADDI A,1 ; BUMP ERROR LEVEL + PUSH TP,A + PUSH TP,PROCID+1(PVP) + PUSH P,A + + MOVE B,IMQUOTE READ-TABLE + PUSHJ P,IGVAL + PUSH TP,[TATOM,,-1] + PUSH TP,IMQUOTE READ-TABLE + GETYP C,A ; TO GVAL OF READ-TABLE ON ERROR AND + CAIE C,TVEC ; TOP ERRET'S + JRST .+4 + PUSH TP,A + PUSH TP,B + JRST .+3 + PUSH TP,$TUNBOUND + PUSH TP,[-1] + PUSH TP,[0] + PUSH TP,[0] + + PUSHJ P,SPECBIND ;BIND THE CRETANS + MOVE A,-1(P) ;RESTORE SWITHC + JUMPE A,NOERR ;IF 0, DONT PRINT ERROR MESS + PUSH TP,$TATOM + PUSH TP,EQUOTE *ERROR* + MCALL 0,TERPRI + MCALL 1,PRINC ;PRINT THE MESSAGE +NOERR: MOVE C,AB ;GET A COPY OF AB + +ERRLP: JUMPGE C,LEVPRT ;IF NONE, RE-ENTER READ-EVAL-PRINT LOOP + PUSH TP,$TAB + PUSH TP,C + MOVEI B,PRIN1 + GETYP A,(C) ; GET ARGS TYPE + CAIE A,TATOM + JRST ERROK + MOVE A,1(C) ; GET ATOM + HRRO A,2(A) + CAME A,[-1,,ERROBL+1] + CAMN A,ERROBL+1 ; DONT SKIP IF IN ERROR OBLIST + MOVEI B,PRINC ; DONT PRINT TRAILER +ERROK: PUSH P,B ; SAVE ROUTINE POINTER + PUSH TP,(C) + PUSH TP,1(C) + MCALL 0,TERPRI ; CRLF + POP P,B ; GET ROUTINE BACK + .MCALL 1,(B) + POP TP,C + SUB TP,[1,,1] + ADD C,[2,,2] ;BUMP SAVED AB + JRST ERRLP ;AND CONTINUE + + +LEVPRT: XCT INITFL ;LOAD MUDDLE INIT FILE IF FIRST TIME + MCALL 0,TERPRI + PUSH TP,$TATOM + PUSH TP,EQUOTE [LISTENING-AT-LEVEL ] + MCALL 1,PRINC ;PRINT LEVEL + PUSH TP,$TFIX ;READY TO PRINT LEVEL + HRRZ A,(P) ;GET LEVEL + SUB P,[2,,2] ;AND POP STACK + PUSH TP,A + MCALL 1,PRIN1 ;PRINT WITHOUT SPACES ETC. + PUSH TP,$TATOM ;NOW PROCESS + PUSH TP,EQUOTE [ PROCESS ] + MCALL 1,PRINC ;DONT SLASHIFY SPACES + MOVE PVP,PVSTOR+1 + PUSH TP,PROCID(PVP) ;NOW ID + PUSH TP,PROCID+1(PVP) + MCALL 1,PRIN1 + SKIPN C,CURPRI + JRST MAINLP + PUSH TP,$TFIX + PUSH TP,C + PUSH TP,$TATOM + PUSH TP,EQUOTE [ INT-LEVEL ] + MCALL 1,PRINC + MCALL 1,PRIN1 + JRST MAINLP ; FALL INTO MAIN LOOP + + ;ROUTINES FOR ERROR-LISTEN + +OBCHK: GETYP 0,A + CAIN 0,TOBLS + JRST CPOPJ1 ; WIN FOR SINGLE OBLIST + CAIE 0,TLIST ; IF LIST, MAKE SURE EACH IS AN OBLIST + JRST CPOPJ ; ELSE, LOSE + + JUMPE B,CPOPJ ; NIL ,LOSE + PUSH TP,A + PUSH TP,B + PUSH P,[0] ;FLAG FOR DEFAULT CHECKING + MOVEI 0,1000 ; VERY BIG NUMBER FOR CIRCULARITY TEST + +OBCHK0: INTGO + SOJE 0,OBLOSE ; CIRCULARITY TEST + HRRZ B,(TP) ; GET LIST POINTER + GETYP A,(B) + CAIE A,TOBLS ; SKIP IF WINNER + JRST DEFCHK ; CHECK FOR SPECIAL ATOM DEFAULT + HRRZ B,(B) + MOVEM B,(TP) + JUMPN B,OBCHK0 +OBWIN: AOS (P)-1 +OBLOSE: SUB TP,[2,,2] + SUB P,[1,,1] + POPJ P, + +DEFCHK: SKIPN (P) ; BEEN HERE BEFORE ? + CAIE A,TATOM ; OR, NOT AN ATOM ? + JRST OBLOSE ; YES, LOSE + MOVE A,(B)+1 + CAME A,MQUOTE DEFAULT + JRST OBLOSE ; LOSE + SETOM (P) ; SET FLAG + HRRZ B,(B) ; CHECK FOR END OF LIST + MOVEM B,(TP) + JUMPN B,OBCHK0 ; NOT THE END, CONTINUE LOOKING + JRST OBLOSE ; LOSE FOR DEFAULT AT THE END + + + +PUSH6: PUSH TP,[TATOM,,-1] + PUSH TP,B + PUSH TP,(C) + PUSH TP,1(C) + PUSH TP,[0] + PUSH TP,[0] + POPJ P, + + +MAKOB: PUSH TP,INITIAL + PUSH TP,INITIAL+1 + PUSH TP,ROOT + PUSH TP,ROOT+1 + MCALL 2,LIST + PUSH TP,$TATOM + PUSH TP,IMQUOTE OBLIST + PUSH TP,A + PUSH TP,B + MCALL 2,SETG + PUSH TP,[TATOM,,-1] + PUSH TP,IMQUOTE OBLIST + PUSH TP,A + PUSH TP,B + PUSH TP,[0] + PUSH TP,[0] + JRST NOTOBL + + +;THIS IS IT FOLKS...THE MAIN LOOP. READ, EVAL, PRINT + +MAINLP: MOVE A,$TATOM ;KLUDGE BY NDR LIKE ERROR TO LET LOOSER REDEFINE + MOVE B,IMQUOTE REP + PUSHJ P,ILVAL ;GET ITS LVAL TO SEE IF REDEFINED + GETYP C,A + CAIE C,TUNBOUND + JRST REPCHK + MOVE A,$TATOM ;SEE IF IT HAS GVAL SINCE NO LVAL + MOVE B,IMQUOTE REP + PUSHJ P,IGVAL + GETYP C,A + CAIN C,TUNBOUN + JRST IREPER +REPCHK: CAIN C,TSUBR + CAIE B,REPER + JRST .+2 + JRST IREPER +REREPE: PUSH TP,A + PUSH TP,B + GETYP A,-1(TP) + PUSHJ P,APLQ + JRST ERRREP + MCALL 1,APPLY ;LOOSER HAS REDEFINED SO CALL HIS + JRST MAINLP +IREPER: PUSH P,[0] ;INDICATE FALL THROUGH + JRST REPERF + +ERRREP: PUSH TP,[TATOM,,-1] + PUSH TP,IMQUOTE REP + PUSH TP,$TSUBR + PUSH TP,[REPER] + PUSH TP,[0] + PUSH TP,[0] + PUSHJ P,SPECBIN + PUSH TP,$TATOM + PUSH TP,EQUOTE NON-APPLICABLE-REP + PUSH TP,-11(TP) + PUSH TP,-11(TP) + MCALL 2,ERROR + SUB TP,[6,,6] + PUSHJ P,SSPECS + JRST REREPE + + +IMFUNCTION REPER,SUBR,REP +REPER: ENTRY 0 + PUSH P,[1] ;INDICATE DIRECT CALL +REPERF: MCALL 0,TERPRI + MCALL 0,READ + PUSH TP,A + PUSH TP,B + MOVE B,IMQUOTE L-INS + PUSHJ P,ILVAL ; ASSIGNED? + GETYP 0,A + CAIN 0,TLIST + + PUSHJ P,LSTTOF ; PUT LAST AS FIRST + MCALL 0,TERPRI + MCALL 1,EVAL + MOVE C,IMQUOTE LAST-OUT + PUSHJ P,CISET + PUSH TP,A + PUSH TP,B + MOVE B,IMQUOTE L-OUTS + PUSHJ P,ILVAL ; ASSIGNED? + GETYP 0,A + CAIN 0,TLIST + + CAME B,(TP) ; DONT STUFF IT INTO ITSELF + JRST STUFIT ; STUFF IT IN + GETYP 0,-1(TP) + CAIE 0,TLIST ; IF A LIST THE L-OUTS +STUFIT: PUSHJ P,LSTTOF ; PUT LAST AS FIRST + MCALL 1,PRIN1 + POP P,C ;FLAG FOR FALL THROUGH OR CALL + JUMPN C,FINIS ;IN CASE LOOSER CALLED REP + JRST MAINLP + +LSTTOF: SKIPN A,B + POPJ P, + + HRRZ C,(A) + JUMPE C,LSTTO2 + MOVEI D,(C) ; SAVE PTR TO 2ND ELEMENT + MOVEI 0,-1 ; LET THE LOSER LOSE (HA HA HA) + +LSTTO1: HRRZ C,(C) ; START SCAN + JUMPE C,GOTIT + HRRZ A,(A) + SOJG 0,LSTTO1 + +GOTIT: HRRZ C,(A) + HLLZS (A) + CAIE D,(C) ; AVOID CIRCULARITY + HRRM D,(C) + HRRM C,(B) + MOVE D,1(B) + MOVEM D,1(C) + GETYP D,(B) + PUTYP D,(C) + +LSTTO2: MOVSI A,TLIST + MOVE C,-1(TP) + MOVE D,(TP) + JRST LSTUF + +;FUNCTION TO RETRY A PREVIOUS FUNCTION CALL + +MFUNCTION RETRY,SUBR + + ENTRY + JUMPGE AB,RETRY1 ; USE MOST RECENT + CAMGE AB,[-2,,0] + JRST TMA + GETYP A,(AB) ; CHECK TYPE + CAIE A,TFRAME + JRST WTYP1 + MOVEI B,(AB) ; POINT TO ARG + JRST RETRY2 +RETRY1: MOVE B,IMQUOTE LER,[LERR ]INTRUP + PUSHJ P,ILOC ; LOCATIVE TO FRAME +RETRY2: PUSHJ P,CHFSWP ; CHECK VALIDITY AND SWAP IF NECESSARY + HRRZ 0,OTBSAV(B) ; CHECK FOR TOP + JUMPE 0,RESTAR ; YES RE-ENTER TOP LEVEL + PUSH TP,$TTB + PUSH TP,B ; SAVE FRAME + MOVE B,OTBSAV(B) ; GET PRVIOUS FOR UNBIND HACK + MOVEI C,-1(TP) + PUSHJ P,CHUNW ; CHECK ANY UNWINDING + CAME SP,SPSAV(TB) ; UNBINDING NEEDED? + PUSHJ P,SPECSTORE + MOVE P,PSAV(TB) ; GET OTHER STUFF + MOVE AB,ABSAV(B) + HLRE A,AB ; COMPUTE # OF ARGS + MOVNI A,-FRAMLN(A) ; MAKE TP POINT PAST FRAME + HRLI A,(A) + MOVE C,TPSAV(TB) ; COMPUTE TP + ADD C,A + MOVE TP,C + MOVE TB,B ; FIX UP TB + HRRZ C,FSAV(TB) ; GET FUNCTION + CAIL C,HIBOT + JRST (C) ; GO + GETYP 0,(C) ; RSUBR OR ENTRY? + CAIE 0,TATOM + CAIN 0,TRSUBR + JRST RETRNT + MOVS R,(C) ; SET UP R + HRRI R,(C) + MOVEI C,0 + JRST RETRN3 + +RETRNT: CAIE 0,TRSUBR + JRST RETRN1 + MOVE R,1(C) +RETRN4: HRRZ C,2(C) ; OFFSET +RETRN3: SKIPL M,1(R) + JRST RETRN5 +RETRN7: ADDI C,(M) + JRST (C) + +RETRN5: MOVEI D,(M) ; TOTAL OFFSET + MOVSS M + ADD M,PURVEC+1 + SKIPL M,1(M) + JRST RETRN6 + ADDI M,(D) + JRST RETRN7 + +RETRN6: HLRZ A,1(R) + PUSH P,D + PUSH P,C + PUSHJ P,PLOAD + JRST RETRER ; LOSER + POP P,C + POP P,D + MOVE M,B + JRST RETRN7 + +RETRN1: HRL C,(C) ; FIX LH + MOVE B,1(C) + PUSH TP,$TVEC + PUSH TP,C + PUSHJ P,IGVAL + GETYP 0,A + MOVE C,(TP) + SUB TP,[2,,2] + CAIE 0,TRSUBR + JRST RETRN2 + MOVE R,B + JRST RETRN4 + +RETRN2: ERRUUO EQUOTE CANT-RETRY-ENTRY-GONE + +RETRER: ERRUUO EQUOTE PURE-LOAD-FAILURE + + +;FUNCTION TO DO ERROR RETURN + +IMFUNCTION ERRET,SUBR + + ENTRY + HLRE A,AB ; -2*# OF ARGS + JUMPGE A,STP ; RESTART PROCESS + ASH A,-1 ; -# OF ARGS + AOJE A,ERRET2 ; NO FRAME SUPPLIED + AOJL A,TMA + ADD AB,[2,,2] + PUSHJ P,OKFRT + JRST WTYP2 + SUB AB,[2,,2] + PUSHJ P,CHPROC ; POINT TO FRAME SLOT + JRST ERRET3 +ERRET2: MOVE B,IMQUOTE LER,[LERR ]INTRUP + PUSHJ P,ILVAL ; GET ITS VALUE +ERRET3: PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + PUSHJ P,CHFSWP ; CHECK VALIDITY AND SWAP IF NECESSARY + HRRZ 0,OTBSAV(B) ; TOP LEVEL? + JUMPE 0,TOPLOS + PUSHJ P,CHUNW ; ANY UNWINDING + JRST CHFINIS + + +; FUNCTION TO RETURN LAST ERROR FRAME OR PREVIOUS FRAME + +IMFUNCTION FRAME,SUBR + ENTRY + SETZB A,B + JUMPGE AB,FRM1 ; DEFAULT CASE + CAMG AB,[-3,,0] ; SKIP IF OK ARGS + JRST TMA + PUSHJ P,OKFRT ; A FRAME OR SIMILAR THING? + JRST WTYP1 + +FRM1: PUSHJ P,CFRAME ; GO TO INTERNAL + JRST FINIS + +CFRAME: JUMPN A,FRM2 ; ARG SUPPLIED? + MOVE B,IMQUOTE LER,[LERR ]INTRUP + PUSHJ P,ILVAL + JRST FRM3 +FRM2: PUSHJ P,CHPROC ; CHECK FOR PROCESS + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) ; POINT TO SLOT + PUSHJ P,CHFRM ; CHECK IT + MOVE C,(TP) ; GET FRAME BACK + MOVE B,OTBSAV(C) ;GET PREVIOUS FRAME + SUB TP,[2,,2] + TRNN B,-1 ; SKIP IF OK + JRST TOPLOSE + +FRM3: JUMPN B,FRM4 ; JUMP IF WINNER + MOVE B,IMQUOTE THIS-PROCESS + PUSHJ P,ILVAL ; GET PROCESS OF INTEREST + GETYP A,A ; CHECK IT + CAIN A,TUNBOU + MOVE B,PVSTOR+1 ; USE CURRENT + MOVEI A,PVLNT*2+1(B) ; POINT TO DOPE WORDS + MOVE B,TBINIT+1(B) ; AND BASE FRAME +FRM4: HLL B,OTBSAV(B) ;TIME + HRLI A,TFRAME + POPJ P, + +OKFRT: AOS (P) ;ASSUME WINNAGE + GETYP 0,(AB) + MOVE A,(AB) + MOVE B,1(AB) + CAIE 0,TFRAME + CAIN 0,TENV + POPJ P, + CAIE 0,TPVP + CAIN 0,TACT + POPJ P, + SOS (P) + POPJ P, + +CHPROC: GETYP 0,A ; TYPE + CAIE 0,TPVP + POPJ P, ; OK + MOVEI A,PVLNT*2+1(B) + CAMN B,PVSTOR+1 ; THIS PROCESS? + JRST CHPRO1 + MOVE B,TBSTO+1(B) + JRST FRM4 + +CHPRO1: MOVE B,OTBSAV(TB) + JRST FRM4 + +; FUNCTION TO RETURN ARGS TUPLE FOR A FRAME + +MFUNCTION ARGS,SUBR + ENTRY 1 + PUSHJ P,OKFRT ; CHECK FRAME TYPE + JRST WTYP1 + PUSHJ P,CARGS + JRST FINIS + +CARGS: PUSHJ P,CHPROC + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) ; POINT TO FRAME SLOT + PUSHJ P,CHFRM ; AND CHECK FOR VALIDITY + MOVE C,(TP) ; FRAME BACK + MOVSI A,TARGS +CARGS1: GETYP 0,FSAV(C) ; IS THIS A FUNNY ONE + CAIE 0,TCBLK ; SKIP IF FUNNY + JRST .+3 ; NO NORMAL + MOVE C,OTBSAV(C) ; ASSOCIATE WITH PREVIOUS FRAME + JRST CARGS1 + HLR A,OTBSAV(C) ; TIME IT AND + MOVE B,ABSAV(C) ; GET POINTER + SUB TP,[2,,2] ; FLUSH CRAP + POPJ P, + +; FUNCTION TO RETURN FUNCTION ASSOCIATED WITH A FRAME + +MFUNCTION FUNCT,SUBR + ENTRY 1 ; FRAME ARGUMENT + PUSHJ P,OKFRT ; CHECK TYPE + JRST WTYP1 + PUSHJ P,CFUNCT + JRST FINIS + +CFUNCT: PUSHJ P,CHPROC + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + PUSHJ P,CHFRM ; CHECK IT + MOVE C,(TP) ; RESTORE FRAME + HRRZ A,FSAV(C) ;FUNCTION POINTER + CAIL A,HIBOT + SKIPA B,@-1(A) ;NO, GET SUBR'S NAME POINTER + MOVE B,(A)+3 ;YES, GET RSUBR'S NAME ENTRY + MOVSI A,TATOM + SUB TP,[2,,2] + POPJ P, + +BADFRAME: + ERRUUO EQUOTE FRAME-NO-LONGER-EXISTS + + +TOPLOSE: + ERRUUO EQUOTE TOP-LEVEL-FRAME + + + + +; ROUTINE TO HANG INDEFINITELY WITH INTERRUPTS ENABLED + +MFUNCTION HANG,SUBR + + ENTRY + + JUMPGE AB,HANG1 ; NO PREDICATE + CAMGE AB,[-3,,] + JRST TMA + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,CHKPRD +REHANG: MOVE A,[PUSHJ P,CHKPRH] + MOVEM A,ONINT ; CHECK PREDICATE AFTER ANY INTERRUPT +HANG1: ENABLE ;LET OURSELVES BE INTERRUPTED OUT + PUSHJ P,%HANG + DISABLE ;PREVENT INTERRUPTS AT RANDOM TIMES + SETZM ONINT + MOVE A,$TATOM + MOVE B,IMQUOTE T + JRST FINIS + + +; ROUTINE TO SLEEP FOR POSITIVE NUMBER OF SECONDS WITH INTERRUPTS ENABLED +; ARGUMENT SHOULD BE OF TYPE FIX OR FLOAT AND NON-NEGATIVE + +MFUNCTION SLEEP,SUBR + + ENTRY + + JUMPGE AB,TFA + CAML AB,[-3,,] + JRST SLEEP1 + CAMGE AB,[-5,,] + JRST TMA + PUSH TP,2(AB) + PUSH TP,3(AB) + PUSHJ P,CHKPRD +SLEEP1: GETYP 0,(AB) + CAIE 0,TFIX + JRST .+5 + MOVE B,1(AB) + JUMPL B,OUTRNG ;ARG SHOULDNT BE NEGATIVE + IMULI B,30. ;CONVERT TO # OF THIRTIETHS OF A SECOND + JRST SLEEPR ;GO SLEEP + CAIE 0,TFLOAT ;IF IT WASNT FIX MAKE SURE IT IS FLOAT + JRST WTYP1 ;WRONG TYPE ARG + MOVE B,1(AB) + FMPR B,[30.0] ;CONVERT TO FLOATING # OF THIRTIETHS OF A SECOND + MULI B,400 ;KLUDGE TO FIX IT + TSC B,B + ASH C,(B)-243 + MOVE B,C ;MOVE THE FIXED NUMBER INTO B + JUMPL B,OUTRNG ;CHECK TO SEE THAT WE HAVE POSITIVE NUMBER +SLEEPR: MOVE A,B +RESLEE: MOVE B,[PUSHJ P,CHKPRS] + CAMGE AB,[-3,,] + MOVEM B,ONINT + ENABLE + PUSHJ P,%SLEEP + DISABLE + SETZM ONINT + MOVE A,$TATOM + MOVE B,IMQUOTE T + JRST FINIS + +CHKPRH: PUSH P,B + MOVEI B,HANGP + JRST .+3 + +CHKPRS: PUSH P,B + MOVEI B,SLEEPP + HRRM B,LCKINT + SETZM ONINT ; TURN OFF FEATURE FOR NOW + POP P,B + POPJ P, + +HANGP: SKIPA B,[REHANG] +SLEEPP: MOVEI B,RESLEE + PUSH P,B +CHKPRD: PUSH P,A + DISABLE + PUSH TP,(TB) + PUSH TP,1(TB) + MCALL 1,EVAL + GETYP 0,A + CAIE 0,TFALSE + JRST FINIS + POP P,A + POPJ P, + +MFUNCTION VALRET,SUBR +; SUBR TO VALRET A STRING TO SUPERIOR ITS PROCESS + + ENTRY 1 + GETYP A,(AB) ; GET TYPE OF ARGUMENT + CAIN A,TFIX ; FIX? + JRST VALRT1 + CAIE A,TCHSTR ; IS IT A CHR STRING? + JRST WTYP1 ; NO...ERROR WRONG TYPE + PUSHJ P,CSTACK ; COPY THE CHR STRING TO THE STACK + ; CSTACK IS IN ATOMHK + MOVEI B,0 ; ASCIZ TERMINATOR + EXCH B,(P) ; STORE AND RETRIEVE COUNT + +; CALCULATE THE BEGINNING ADDR OF THE STRING + MOVEI A,-1(P) ; GET ADDR OF TOP OF STACK + SUBI A,-1(B) ; GET STARTING ADDR + PUSHJ P,%VALRE ; PASS UP TO MONITOR + JRST IFALSE ; IF HE RETURNS, RETURN FALSE + +VALRT1: MOVE A,1(AB) + PUSHJ P,%VALFI + JRST IFALSE + +MFUNCTION LOGOUT,SUBR + +; SUBR TO DO A .LOGOUT (VALID ONLY AT TOP LEVEL) + ENTRY 0 + PUSHJ P,%TOPLQ ; SKIP IF AT TOP LEVEL + JRST IFALSE + PUSHJ P,CLOSAL + PUSHJ P,%LOGOUT ; TRY TO FLUSH + JRST IFALSE ; COULDN'T DO IT...RETURN FALSE + +; FUNCTS TO GET UNAME AND JNAME + +; GET XUNAME (REAL UNAME) +MFUNCTION XUNAME,SUBR + + ENTRY 0 + + PUSHJ P,%RXUNA + JRST RSUJNM + JRST FINIS ; 10X ROUTINES SKIP + +MFUNCTION UNAME,SUBR + + ENTRY 0 + + PUSHJ P,%RUNAM + JRST RSUJNM + JRST FINIS + +; REAL JNAME +MFUNCTION XJNAME,SUBR + + ENTRY 0 + + PUSHJ P,%RXJNA + JRST RSUJNM + +MFUNCTION JNAME,SUBR + + ENTRY 0 + + PUSHJ P,%RJNAM + JRST RSUJNM + +; FUNCTION TO SET AND READ GLOBAL SNAME + +MFUNCTION SNAME,SUBR + + ENTRY + + JUMPGE AB,SNAME1 + CAMG AB,[-3,,] + JRST TMA + GETYP A,(AB) ; ARG MUST BE STRING + CAIE A,TCHSTR + JRST WTYP1 + PUSH TP,$TATOM + PUSH TP,IMQUOTE SNM + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,SETG + JRST FINIS + +SNAME1: MOVE B,IMQUOTE SNM + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TCHSTR + JRST FINIS + MOVE A,$TCHSTR + MOVE B,CHQUOTE + JRST FINIS + +RSUJNM: PUSHJ P,6TOCHS ; CONVERT IT + JRST FINIS + + +SGSNAM: MOVE B,IMQUOTE SNM + PUSHJ P,IDVAL1 + GETYP 0,A + CAIE 0,TCHSTR + JRST SGSN1 + + PUSH TP,A + PUSH TP,B + PUSHJ P,STRTO6 + POP P,A + SUB TP,[2,,2] + JRST .+2 + +SGSN1: MOVEI A,0 + PUSHJ P,%SSNAM ; SET SNAME IN SYSTEM + POPJ P, + + + +;THIS SUBROUTINE ALLOCATES A NEW PROCESS +;TAKES TP-STACK SIZE (2*WORDS) IN A AND P-STACK SIZE (WORDS) IN B +;IS CALLED BY PUSHJ P,. RETURNS IN A AND B A NEW PROCESS. + +ICR: PUSH P,A + PUSH P,B + MOVEI A,PVLNT ;SETUP CALL TO VECTOR FOR PVP + PUSHJ P,IVECT ;GOBBLE A VECTOR + HRLI C,PVBASE ;SETUP A BLT POINTER + HRRI C,(B) ;GET INTO ADDRESS + BLT C,PVLNT*2-1(B) ;COPY A PROTOTYPE INTO NEW PVP + MOVSI C,400000+SPVP+.VECT. ;SET SPECIAL TYPE + MOVEM C,PVLNT*2(B) ;CLOBBER IT IN + PUSH TP,A ;SAVE THE RESULTS OF VECTOR + PUSH TP,B + + PUSH TP,$TFIX ;GET A UNIFORM VECTOR + POP P,B + PUSH TP,B + MCALL 1,UVECTOR + ADD B,[PDLBUF-2,,-1] ;FUDGE WITH BUFFER + MOVE C,(TP) ;REGOBBLE PROCESS POINTER + MOVEM B,PSTO+1(C) ;STORE IN ALL HOMES + MOVEM B,PBASE+1(C) + + + POP P,A ;PREPARE TO CREATE A TEMPORARY PDL + PUSHJ P,IVECT ;GET THE TEMP PDL + ADD B,[PDLBUF,,0] ;PDL GROWTH HACK + MOVE C,(TP) ;RE-GOBBLE NEW PVP + SUB B,[1,,1] ;FIX FOR STACK + MOVEM B,TPBASE+1(C) + +;SETUP INITIAL BINDING + + PUSH B,$TBIND + MOVEM B,SPBASE+1(C) ;SAVE AS BASE OF SP + MOVEM B,SPSTO+1(C) ;AND CURRENT THEREOF + MOVEM B,CURFCN+1(C) ; AND AS CURRENT FCN FOR SPEC/UNSPEC LOGIC + PUSH B,IMQUOTE THIS-PROCESS + PUSH B,$TPVP ;GIVE IT PROCESS AS VALUE + PUSH B,C + ADD B,[2,,2] ;FINISH FRAME + MOVEM B,TPSTO+1(C) ;MAKE THIS THE CURRENT STACK POINTER + MOVEM C,PVPSTO+1(C) ;SAVE THE NEW PVP ITSELF + AOS A,IDPROC ;GOBBLE A UNIQUE PROCESS I.D. + MOVEM A,PROCID+1(C) ;SAVE THAT ALSO + AOS A,PTIME ; GET A UNIQUE BINDING ID + MOVEM A,BINDID+1(C) + + MOVSI A,TPVP ;CLOBBER THE TYPE + MOVE B,(TP) ;AND POINTER TO PROCESS + SUB TP,[2,,2] + POPJ P, + +;MINI ROUTINE TO CALL VECTOR WITH COUNT IN A + +IVECT: PUSH TP,$TFIX + PUSH TP,A + MCALL 1,VECTOR ;GOBBLE THE VECTOR + POPJ P, + + +;SUBROUTINE TO SWAP A PROCESS IN +;CALLED WITH JSP A,SWAP AND NEW PVP IN B + +SWAP: ;FIRST STORE ALL THE ACS + + MOVE PVP,PVSTOR+1 + MOVE SP,$TSP ; STORE SPSAVE + MOVEM SP,SPSTO(PVP) + MOVE SP,SPSTOR+1 + IRP A,,[SP,AB,TB,TP,P,M,R,FRM] + MOVEM A,A!STO+1(PVP) + TERMIN + + SETOM 1(TP) ; FENCE POST MAIN STACK + MOVEM TP,TPSAV(TB) ; CORRECT FRAME + SETZM PSAV(TB) ; CLEAN UP CURRENT FRAME + SETZM SPSAV(TB) + SETZM PCSAV(TB) + + MOVE E,PVP ;RETURN OLD PROCESS IN E + MOVE PVP,D ;AND MAKE NEW ONE BE D + MOVEM PVP,PVSTOR+1 + +SWAPIN: + ;NOW RESTORE NEW PROCESSES AC'S + + MOVE PVP,PVSTOR+1 + IRP A,,[AB,TB,SP,TP,P,M,R,FRM] + MOVE A,A!STO+1(PVP) + TERMIN + + SETZM SPSTO(PVP) + MOVEM SP,SPSTOR+1 + JRST (C) ;AND RETURN + + + + +;SUBRS ASSOCIATED WITH TYPES + +;TYPE (ITYPE) ARE FUNCTIONS TO RETURN THE ATOMIC NAME OF THE +;TYPE OF A GOODIE. TYPE TAKES ITS ARGS ON AP AND RETURNS IN A AND B. +;ITYPE TAKES ITS ARGS IN A AND B AND RETURNS IN SAME (B=0) FOR INVALID +;TYPECODE. +MFUNCTION TYPE,SUBR + + ENTRY 1 + GETYP A,(AB) ;TYPE INTO A +TYPE1: PUSHJ P,ITYPE ;GO TO INTERNAL + JUMPN B,FINIS ;GOOD RETURN +TYPERR: ERRUUO EQUOTE TYPE-UNDEFINED + +CITYPE: GETYP A,A ; GET TYPE FOR COMPILER CALL +ITYPE: LSH A,1 ;TIMES 2 + HRLS A ;TO BOTH SIDES + ADD A,TYPVEC+1 ;GET ACTUAL LOCATION + JUMPGE A,TYPERR ;LOST, TYPE OUT OF BOUNDS + MOVE B,1(A) ;PICKUP TYPE + HLLZ A,(A) + POPJ P, + +; PREDICATE -- IS OBJECT OF TYPE SPECIFIED + +MFUNCTION %TYPEQ,SUBR,[TYPE?] + + ENTRY + + MOVE D,AB ; GET ARGS + ADD D,[2,,2] + JUMPGE D,TFA + MOVE A,(AB) + HLRE C,D + MOVMS C + ASH C,-1 ; FUDGE + PUSHJ P,ITYPQ ; GO INTERNAL + JFCL + JRST FINIS + +ITYPQ: GETYP A,A ; OBJECT + PUSHJ P,ITYPE +TYPEQ0: SOJL C,CIFALS + GETYP 0,(D) + CAIE 0,TATOM ; Type name must be an atom + JRST WRONGT + CAMN B,1(D) ; Same as the OBJECT? + JRST CPOPJ1 ; Yes, return type name + ADD D,[2,,2] + JRST TYPEQ0 ; No, continue comparing + +CIFALS: MOVEI B,0 + MOVSI A,TFALSE + POPJ P, + +CTYPEQ: SOJE A,CIFALS ; TREAT NO ARGS AS FALSE + MOVEI D,1(A) ; FIND BASE OF ARGS + ASH D,1 + HRLI D,(D) + SUBM TP,D ; D POINTS TO BASE + MOVE E,D ; SAVE FOR TP RESTORE + ADD D,[3,,3] ; FUDGE + MOVEI C,(A) ; NUMBER OF TYPES + MOVE A,-2(D) + PUSHJ P,ITYPQ + JFCL ; IGNORE SKIP FOR NOW + MOVE TP,E ; SET TP BACK + JUMPL B,CPOPJ1 ; SKIP + POPJ P, + +; Entries to get type codes for types for fixing up RSUBRs and assembling + +MFUNCTION %TYPEC,SUBR,[TYPE-C] + + ENTRY + + JUMPGE AB,TFA + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP1 + MOVE B,1(AB) + CAMGE AB,[-3,,0] ; skip if only type name given + JRST GTPTYP + MOVE C,IMQUOTE ANY + +TYPEC1: PUSHJ P,CTYPEC ; go to internal + JRST FINIS + +GTPTYP: CAMGE AB,[-5,,0] + JRST TMA + GETYP 0,2(AB) + CAIE 0,TATOM + JRST WTYP2 + MOVE C,3(AB) + JRST TYPEC1 + +CTYPEC: PUSH P,C ; save primtype checker + PUSHJ P,TYPFND ; search type vector + JRST CTPEC2 ; create the poor loser + POP P,B + CAMN B,IMQUOTE ANY + JRST CTPEC1 + CAMN B,IMQUOTE TEMPLATE + JRST TCHK + PUSH P,D + HRRZ A,(A) + ANDI A,SATMSK + PUSH P,A + PUSHJ P,TYPLOO + HRRZ 0,(A) + ANDI 0,SATMSK + CAME 0,(P) + JRST TYPDIF + MOVE D,-1(P) + SUB P,[2,,2] +CTPEC1: MOVEI B,(D) + MOVSI A,TTYPEC + POPJ P, +TCHK: PUSH P,D ; SAVE TYPE + MOVE A,D ; GO TO SAT + PUSHJ P,SAT + CAIG A,NUMSAT ; SKIP IF A TEMPLATE + JRST TYPDIF + POP P,D ; RESTORE TYPE + JRST CTPEC1 + +CTPEC2: POP P,C ; GET BACK PRIMTYPE + SUBM M,(P) + PUSH TP,$TATOM + PUSH TP,B + CAMN C,IMQUOTE ANY + JRST CTPEC3 + PUSH TP,$TATOM + PUSH TP,C + MCALL 2,NEWTYPE ; CREATE THE POOR GUY + MOVE C,IMQUOTE ANY + SUBM M,(P) ; UNRELATIVIZE + JRST CTYPEC + +CTPEC3: HRRZ 0,FSAV(TB) + CAIE 0,%TYPEC + CAIN 0,%TYPEW + JRST TYPERR + + MCALL 1,%TYPEC + JRST MPOPJ + +MFUNCTION %TYPEW,SUBR,[TYPE-W] + + ENTRY + + JUMPGE AB,TFA + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP1 + MOVEI D,0 + MOVE C,IMQUOTE ANY + MOVE B,1(AB) + CAMGE AB,[-3,,0] + JRST CTYPW1 + +CTYPW3: PUSHJ P,CTYPEW + JRST FINIS + +CTYPW1: GETYP 0,2(AB) + CAIE 0,TATOM + JRST WTYP2 + CAMGE AB,[-5,,0] ; JUMP IF RH IS GIVEN + JRST CTYPW2 +CTYPW5: MOVE C,3(AB) + JRST CTYPW3 + +CTYPW2: CAMGE AB,[-7,,0] + JRST TMA + GETYP 0,4(AB) + CAIE 0,TFIX + JRST WRONGT + MOVE D,5(AB) + JRST CTYPW5 + +CTYPEW: PUSH P,D + PUSHJ P,CTYPEC ; GET CODE IN B + POP P,B + HRLI B,(D) + MOVSI A,TTYPEW + POPJ P, + +MFUNCTION %VTYPE,SUBR,[VALID-TYPE?] + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP1 + MOVE B,1(AB) + + PUSHJ P,CVTYPE + JFCL + JRST FINIS + +CVTYPE: PUSHJ P,TYPFND ; LOOK IT UP + JRST PFALS + + MOVEI B,(D) + MOVSI A,TTYPEC + JRST CPOPJ1 + +PFALS: MOVEI B,0 + MOVSI A,TFALSE + POPJ P, + +;PRIMTTYPE RETURNS THE TYPE ATOM OF A PRIMITIVE TYPE IN A CLASS + +STBL: REPEAT NUMSAT,SETZ MQUOTE INTERNAL-TYPE + +LOC STBL + +IRP A,,[[1WORD,WORD],[2WORD,LIST],[NWORD,UVECTOR],[2NWORD,VECTOR],[STORE,STORAGE] +[ARGS,TUPLE],[FRAME,FRAME],[ATOM,ATOM],[LOCID,LOCD],[CHSTR,STRING],[OFFS,OFFSET,1] +[PVP,PROCESS,1],[ASOC,ASOC,1],[LOCA,LOCA],[LOCS,LOCS],[LOCU,LOCU],[LOCV,LOCV] +[LOCL,LOCL],[LOCN,LOCAS],[LOCT,LOCT,1],[LOCR,LOCR],[LOCB,LOCB,1],[BYTE,BYTES,1]] +IRP B,C,[A] +LOC STBL+S!B +IRP X,Y,[C] +IFSE [Y],SETZ IMQUOTE X +IFSN [Y],SETZ MQUOTE X +.ISTOP +TERMIN +.ISTOP + +TERMIN +TERMIN + +LOC STBL+NUMSAT+1 + + +MFUNCTION TYPEPRIM,SUBR + + ENTRY 1 + GETYP A,(AB) + CAIE A,TATOM + JRST NOTATOM + MOVE B,1(AB) + PUSHJ P,CTYPEP + JRST FINIS + +CTYPEP: PUSHJ P,TYPLOO ; CONVERT ATOM TO CODE + HRRZ A,(A) ; SAT TO A + ANDI A,SATMSK + JRST PTYP1 + +MFUNCTION PTSATC,SUBR,[PRIMTYPE-C] + + ENTRY 1 + + GETYP A,(AB) + CAIE A,TATOM + JRST WTYP1 + MOVE B,1(AB) + PUSHJ P,CPRTYC + JRST FINIS + +CPRTYC: PUSHJ P,TYPLOO + MOVE B,(A) + ANDI B,SATMSK + MOVSI A,TSATC + POPJ P, + + +IMFUNCTION PRIMTYPE,SUBR + + ENTRY 1 + + MOVE A,(AB) ;GET TYPE + PUSHJ P,CPTYPE + JRST FINIS + +CPTYPE: GETYP A,A + PUSHJ P,SAT ;GET SAT +PTYP1: JUMPE A,TYPERR + MOVE B,IMQUOTE TEMPLATE + CAIG A,NUMSAT ; IF BIG SAT, THEN TEMPLATE + MOVE B,@STBL(A) + MOVSI A,TATOM + POPJ P, + + +; RSUBR MAKES A VECTOR INTO AN OBJECT OF TYPE RSUBR, ALSO SLIGHTLY MUNGING IT + +IMFUNCTION RSUBR,SUBR + ENTRY 1 + + GETYP A,(AB) + CAIE A,TVEC ; MUST BE VECTOR + JRST WTYP1 + MOVE B,1(AB) ; GET IT + GETYP A,(B) ; CHECK 1ST ELEMENTS TYPE + CAIN A,TPCODE ; PURE CODE + JRST .+3 + CAIE A,TCODE + JRST NRSUBR + HLRM B,(B) ; CLOBEER SPECIAL COUNT FIELD + MOVSI A,TRSUBR + JRST FINIS + +NRSUBR: ERRUUO EQUOTE FIRST-ELEMENT-OF-VECTOR-NOT-CODE + +; ROUTINE TO GENERATE ENTRYY OTHER THAN FIRST TO RSUBRR + +IMFUNCTION MENTRY,SUBR,[RSUBR-ENTRY] + + ENTRY 2 + + GETYP 0,(AB) ; TYPE OF ARG + CAIE 0,TVEC ; BETTER BE VECTOR + JRST WTYP1 + GETYP 0,2(AB) + CAIE 0,TFIX + JRST WTYP2 + MOVE B,1(AB) ; GET VECTOR + CAML B,[-3,,0] + JRST BENTRY + GETYP 0,(B) ; FIRST ELEMENT + CAIE 0,TRSUBR + JRST MENTR1 +MENTR2: GETYP 0,2(B) + CAIE 0,TATOM + JRST BENTRY + MOVE C,3(AB) + HRRM C,2(B) ; OFFSET INTO VECTOR + HLRM B,(B) + MOVSI A,TENTER + JRST FINIS + +MENTR1: CAIE 0,TATOM + JRST BENTRY + MOVE B,1(B) ; GET ATOM + PUSHJ P,IGVAL ; GET VAL + GETYP 0,A + CAIE 0,TRSUBR + JRST BENTRY + MOVE C,1(AB) ; RESTORE B + MOVEM A,(C) + MOVEM B,1(C) + MOVE B,C + JRST MENTR2 + +BENTRY: ERRUUO EQUOTE BAD-VECTOR + +; SUBR TO GET ENTRIES OFFSET + +MFUNCTION LENTRY,SUBR,[ENTRY-LOC] + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TENTER + JRST WTYP1 + MOVE B,1(AB) + HRRZ B,2(B) + MOVSI A,TFIX + JRST FINIS + +; RETURN FALSE + +RTFALS: MOVSI A,TFALSE + MOVEI B,0 + POPJ P, + +;SUBROUTINE CALL FOR RSUBRs +RCALL: SUBM M,(P) ;CALCULATE PC's OFFSET IN THE RSUBR + HRLI 0,400000 ; DONT LOSE IN MULTI SEG MODE + + PUSHJ P,@0 ;GO TO THE PROPER SUBROUTINE + SUBM M,(P) ;RECONSTITUTE THE RSUBR's PC + POPJ P, + + + +;CHTYPE TAKES TWO ARGUMENTS. ANY GOODIE AND A AN ATOMIC TYPE NAME +;IT CHECKS THE STORAGE ALLOCATION TYPES OF THE TWO ARE THE SAME AND +;IF THEY ARE CHANGES THE TYPE OF THE FIRST TO THAT NAME D IN THE SECOND + +MFUNCTION CHTYPE,SUBR + + ENTRY 2 + GETYP A,2(AB) ;FIRST CHECK THAT ARG 2 IS AN ATOM + CAIE A,TATOM + JRST NOTATOM + MOVE B,3(AB) ;AND TYPE NAME + PUSHJ P,TYPLOO ;GO LOOKUP TYPE +TFOUND: HRRZ B,(A) ;GOBBLE THE SAT + TRNE B,CHBIT ; SKIP IF CHTYPABLE + JRST CANTCH + TRNE B,TMPLBT ; TEMPLAT + HRLI B,-1 + AND B,[-1,,SATMSK] + GETYP A,(AB) ;NOW GET TYPE TO HACK + PUSHJ P,SAT ;FIND OUT ITS SAT + JUMPE A,TYPERR ;COMPLAIN + CAILE A,NUMSAT + JRST CHTMPL ; JUMP IF TEMPLATE DATA + CAIE A,(B) ;DO THEY AGREE? + JRST TYPDIF ;NO, COMPLAIN +CHTMP1: MOVSI A,(D) ;GET NEW TYPE + HRR A,(AB) ; FOR DEFERRED GOODIES + JUMPL B,CHMATC ; CHECK IT + MOVE B,1(AB) ;AND VALUE + JRST FINIS + +CHTMPL: MOVE E,1(AB) ; GET ARG + HLRZ A,(E) + ANDI A,SATMSK + MOVE 0,3(AB) ; SEE IF TO "TEMPLATE" + CAMN 0,IMQUOTE TEMPLATE + JRST CHTMP1 + TLNN E,-1 ; SKIP IF RESTED + CAIE A,(B) + JRST TYPDIF + JRST CHTMP1 + +CHMATC: PUSH TP,A + PUSH TP,1(AB) ; SAVE GOODIE + MOVSI A,TATOM + MOVE B,3(AB) + MOVSI C,TATOM + MOVE D,IMQUOTE DECL + PUSHJ P,IGET ; FIND THE DECL + PUSH TP,A + PUSH TP,B + MOVE C,(AB) + MOVE D,1(AB) ; NOW GGO TO MATCH + PUSHJ P,TMATCH + JRST CHMAT1 + SUB TP,[2,,2] +CHMAT2: POP TP,B + POP TP,A + JRST FINIS + +CHMAT1: POP TP,B + POP TP,A + MOVE C,-1(TP) + MOVE D,(TP) + PUSHJ P,TMATCH + JRST TMPLVI + JRST CHMAT2 + +TYPLOO: PUSHJ P,TYPFND + ERRUUO EQUOTE BAD-TYPE-NAME + POPJ P, + +TYPFND: HLRE A,B ; FIND DOPE WORDS + SUBM B,A ; A POINTS TO IT + HRRE D,(A) ; TYPE-CODE TO D + JUMPE D,CPOPJ + ANDI D,TYPMSK ; FLUSH FUNNY BITS + MOVEI A,(D) + ASH A,1 + HRLI A,(A) + ADD A,TYPVEC+1 +CPOPJ1: AOS (P) + POPJ P, + + +REPEAT 0,[ + MOVE A,TYPVEC+1 ;GOBBLE DOWN TYPE VECTOR + MOVEI D,0 ;INITIALIZE TYPE COUNTER +TLOOK: CAMN B,1(A) ;CHECK THIS ONE + JRST CPOPJ1 + ADDI D,1 ;BUMP COUNTER + AOBJP A,.+2 ;COUTN DOWN ON VECTOR + AOBJN A,TLOOK + POPJ P, +CPOPJ1: AOS (P) + POPJ P, +] + +TYPDIF: ERRUUO EQUOTE STORAGE-TYPES-DIFFER + + +TMPLVI: ERRUUO EQUOTE DECL-VIOLATION + + +; FUNCTION TO ADD A NEW TYPE TO THE WORLD WITH GIVEN PRIMITIVE TYPE + +MFUNCTION NEWTYPE,SUBR + + ENTRY + + HLRZ 0,AB ; CHEC # OF ARGS + CAILE 0,-4 ; AT LEAST 2 + JRST TFA + CAIGE 0,-6 + JRST TMA ; NOT MORE THAN 3 + GETYP A,(AB) ; GET 1ST ARGS TYPE (SHOULD BE ATOM) + GETYP C,2(AB) ; SAME WITH SECOND + CAIN A,TATOM ; CHECK + CAIE C,TATOM + JRST NOTATOM + + MOVE B,3(AB) ; GET PRIM TYPE NAME + PUSHJ P,TYPLOO ; LOOK IT UP + HRRZ A,(A) ; GOBBLE SAT + ANDI A,SATMSK + HRLI A,TATOM ; MAKE NEW TYPE + PUSH P,A ; AND SAVE + MOVE B,1(AB) ; SEE IF PREV EXISTED + PUSHJ P,TYPFND + JRST NEWTOK ; DID NOT EXIST BEFORE + MOVEI B,2(A) ; FOR POSSIBLE TMPLAT BIT + HRRZ A,(A) ; GET SAT + HRRZ 0,(P) ; AND PROPOSED + ANDI A,SATMSK + ANDI 0,SATMSK + CAIN 0,(A) ; SKIP IF LOSER + JRST NEWTFN ; O.K. + + ERRUUO EQUOTE TYPE-ALREADY-EXISTS + +NEWTOK: POP P,A + MOVE B,1(AB) ; NEWTYPE NAME + PUSHJ P,INSNT ; MUNG IN NEW TYPE + +NEWTFN: CAML AB,[-5,,] ; SKIP IF TEMPLAT SUPPLIED + JRST NEWTF1 + MOVEI 0,TMPLBT ; GET THE BIT + IORM 0,-2(B) ; INTO WORD + MOVE A,(AB) ; GET TYPE NAME + MOVE B,1(AB) + MOVSI C,TATOM + MOVE D,IMQUOTE DECL + PUSH TP,4(AB) ; GET TEMLAT + PUSH TP,5(AB) + PUSHJ P,IPUT +NEWTF1: MOVE A,(AB) + MOVE B,1(AB) ; RETURN NAME + JRST FINIS + +; SET UP GROWTH FIELDS + +IGROWT: SKIPA A,[111100,,(C)] +IGROWB: MOVE A,[001100,,(C)] + HLRE B,C + SUB C,B ; POINT TO DOPE WORD + MOVE B,TYPIC ; INDICATED GROW BLOCK + DPB B,A + POPJ P, + +INSNT: PUSH TP,A + PUSH TP,B ; SAVE NAME OF NEWTYPE + MOVE C,TYPBOT+1 ; CHECK GROWTH NEED + CAMGE C,TYPVEC+1 + JRST ADDIT ; STILL ROOM +GAGN: PUSHJ P,IGROWB ; SETUP BOTTOM GROWTH + SKIPE C,EVATYP+1 + PUSHJ P,IGROWT ; SET UP TOP GROWTH + SKIPE C,APLTYP+1 + PUSHJ P,IGROWT + SKIPE C,PRNTYP+1 + PUSHJ P,IGROWT + MOVE C,[11.,,5] ; SET UP INDICATOR FOR AGC + PUSHJ P,AGC ; GROW THE WORLD + AOJL A,GAGN ; BAD AGC LOSSAGE + MOVE 0,[-101,,-100] + ADDM 0,TYPBOT+1 ; FIX UP POINTER + +ADDIT: MOVE C,TYPVEC+1 + SUB C,[2,,2] ; ALLOCATE ROOM + MOVEM C,TYPVEC+1 + HLRE B,C ; PREPARE TO BLT + SUBM C,B ; C POINTS DOPE WORD END + HRLI C,2(C) ; GET BLT AC READY + BLT C,-3(B) + POP TP,-1(B) ; CLOBBER IT IN + POP TP,-2(B) + HLRE C,TYPVEC+1 ; GET CODE + MOVNS C + ASH C,-1 + SUBI C,1 + MOVE D,-1(B) ; B HAS POINTER TO TYPE VECTOR DOPE WORDS + MOVEI 0,(D) + CAIG 0,HIBOT ; IS ATOM PURE? + JRST ADDNOI ; NO, SO NO HACKING REQUIRED + PUSH P,C + MOVE B,D + PUSHJ P,IMPURIF ; DO IMPURE OF ATOM + MOVE C,TYPVEC+1 + HLRE B,C + SUBM C,B ; RESTORE B + POP P,C + MOVE D,-1(B) ; RESTORE D +ADDNOI: HLRE A,D + SUBM D,A + TLO C,400000 + HRRM C,(A) ; INTO "GROWTH" FIELD + POPJ P, + + +; Interface to interpreter for setting up tables associated with +; template data structures. +; A/ <-name of type>- +; B/ <-length ins>- +; C/ <-uvector of garbage collector code or 0> +; D/ <-uvector of GETTERs>- +; E/ <-uvector of PUTTERs>- + +CTMPLT: SUBM M,(P) ; could possibly gc during this stuff + PUSH TP,$TATOM ; save name of type + PUSH TP,A + PUSH P,B ; save length instr + HLRE A,TD.LNT+1 ; check for template slots left? + HRRZ B,TD.LNT+1 + SUB B,A ; point to dope words + HLRZ B,1(B) ; get real length + ADDI A,-2(B) + JUMPG A,GOODRM ; jump if ok + + PUSH TP,$TUVEC ; save getters and putters + PUSH TP,C + PUSH TP,$TUVEC ; save getters and putters + PUSH TP,D + PUSH TP,$TUVEC + PUSH TP,E + MOVEI A,10-2(B) ; grow it 10 by copying remember d.w. length + PUSH P,A ; save new length + PUSHJ P,CAFRE1 ; get frozen uvector + ADD B,[10,,10] ; rest it down some + HRL C,TD.LNT+1 ; prepare to BLT in + MOVEM B,TD.LNT+1 ; and save as new length vector + HRRI C,(B) ; destination + ADD B,(P) ; final destination address + BLT C,-12(B) + MOVE A,(P) ; length for new getters + PUSHJ P,CAFRE1 + HRL C,TD.GET+1 ; get old for copy + MOVEM B,TD.GET+1 + PUSHJ P,DOBLTS ; go fixup new uvector + MOVE A,(P) ; finally putters + PUSHJ P,CAFRE1 + HRL C,TD.PUT+1 + MOVEM B,TD.PUT+1 + PUSHJ P,DOBLTS ; go fixup new uvector + MOVE A,(P) ; finally putters + PUSHJ P,CAFRE1 + HRL C,TD.AGC+1 + MOVEM B,TD.AGC+1 + PUSHJ P,DOBLTS ; go fixup new uvector + SUB P,[1,,1] ; flush stack craft + MOVE E,(TP) + MOVE D,-2(TP) + MOVE C,-4(TP) ;GET TD.AGC + SUB TP,[6,,6] + +GOODRM: MOVE B,TD.LNT+1 ; move down to fit new guy + SUB B,[1,,1] ; will always win due to prev checks + MOVEM B,TD.LNT+1 + HRLI B,1(B) + HLRE A,TD.LNT+1 + MOVNS A + ADDI A,-1(B) ; A/ final destination + BLT B,-1(A) + POP P,(A) ; new length ins munged in + HLRE A,TD.LNT+1 + MOVNS A ; A/ offset for other guys + PUSH P,A ; save it + ADD A,TD.GET+1 ; point for storing uvs of ins + MOVEM D,-1(A) + MOVE A,(P) + ADD A,TD.PUT+1 + MOVEM E,-1(A) ; store putter also + MOVE A,(P) + ADD A,TD.AGC+1 + MOVEM C,-1(A) ; store putter also + POP P,A ; compute primtype + ADDI A,NUMSAT + PUSH P,A + MOVE B,(TP) ; ready to mung type vector + SUB TP,[2,,2] + PUSHJ P,TYPFND ; CHECK TO SEE WHETHER TEMPLATE EXISTS + JRST NOTEM + POP P,C ; GET SAT + HRRM C,(A) + JRST MPOPJ +NOTEM: POP P,A ; RESTORE SAT + HRLI A,TATOM ; GET TYPE + PUSHJ P,INSNT ; INSERT INTO VECTOR + JRST MPOPJ + +; this routine copies GET and PUT vectors into new ones + +DOBLTS: HRRI C,(B) + ADD B,-1(P) + BLT C,-11(B) ; zap those guys in + MOVEI A,TUVEC ; mung in uniform type + PUTYP A,(B) + MOVEI C,-7(B) ; zero out remainder of uvector + HRLI C,-10(B) + SETZM -1(C) + BLT C,-1(B) + POPJ P, + + +; FUNCTIONS TO SET UP EVALUATION AND APPLICATION RULES FOR DATA TYPES + +MFUNCTION EVALTYPE,SUBR + + ENTRY + + PUSHJ P,CHKARG ; VERIFY WINNAGE IN ARGS + MOVEI A,EVATYP ; POINT TO TABLE + MOVEI E,EVTYPE ; POINT TO PURE VERSION + MOVEI 0,EVAL +TBLCAL: PUSHJ P,TBLSET ; SETUP TABLE ENTRY + JRST FINIS + +MFUNCTION APPLYTYPE,SUBR + + ENTRY + + PUSHJ P,CHKARG + MOVEI A,APLTYP ; POINT TO APPLY TABLE + MOVEI E,APTYPE ; PURE TABLE + MOVEI 0,APPLY + JRST TBLCAL + + +MFUNCTION PRINTTYPE,SUBR + + ENTRY + + PUSHJ P,CHKARG + MOVEI A,PRNTYP ; POINT TO APPLY TABLE + MOVEI E,PRTYPE ; PURE TABLE + MOVEI 0,PRINT + JRST TBLCAL + +; CHECK ARGS AND SETUP FOR TABLE HACKER + +CHKARG: JUMPGE AB,TFA + CAMGE AB,[-5,,] + JRST TMA + GETYP A,(AB) ; 1ST MUST BE TYPE NAME + CAIE A,TATOM + JRST WTYP1 + MOVE B,1(AB) ; GET ATOM + PUSHJ P,TYPLOO ; VERIFY THAT IT IS A TYPE + PUSH P,D ; SAVE TYPE NO. + MOVEI D,-1 ; INDICATE FUNNYNESS + CAML AB,[-3,,] ; SKIP IF 2 OR MORE + JRST TY1AR + HRRZ A,(A) ; GET SAT + ANDI A,SATMSK + PUSH P,A + GETYP A,2(AB) ; GET 2D TYPE + CAIE A,TATOM ; EITHER TYPE OR APPLICABLE + JRST TRYAPL ; TRY APPLICABLE + MOVE B,3(AB) ; VERIFY IT IS A TYPE + PUSHJ P,TYPLOO + HRRZ A,(A) ; GET SAT + ANDI A,SATMSK + POP P,C ; RESTORE SAVED SAT + CAIE A,(C) ; SKIP IF A WINNER + JRST TYPDIF ; REPORT ERROR +TY1AR: POP P,C ; GET SAVED TYPE + MOVEI B,0 ; TELL THAT WE ARE A TYPE + POPJ P, + +TRYAPL: PUSHJ P,APLQ ; IS THIS APPLICABLE + JRST NAPT + SUB P,[1,,1] + MOVE B,2(AB) ; RETURN SAME + MOVE D,3(AB) + POP P,C + POPJ P, + + +; HERE TO PUT ENTRY IN APPROPRIATE TABLE + +TBLSET: PUSH TP,B + PUSH TP,D ; SAVE VALUE + PUSH TP,$TFIX + PUSH TP,A + PUSH P,C ; SAVE TYPE BEING HACKED + PUSH P,E + SKIPE B,1(A) ; SKIP IF VECTOR DOESN'T EXIST YET + JRST TBL.OK + MOVE B,-2(TP) ; CHECK FOR RETURN IT HACK + SKIPN -3(TP) + CAIE B,-1 + JRST .+2 + JRST RETPM2 + HLRE A,TYPBOT+1 ; GET CURRENT TABLE LNTH + MOVNS A + ASH A,-1 + PUSH P,0 + PUSHJ P,IVECT ; GET VECTOR + POP P,0 + MOVE C,(TP) ; POINT TO RETURN POINT + MOVEM B,1(C) ; SAVE VECTOR + +TBL.OK: POP P,E + POP P,C ; RESTORE TYPE + SUB TP,[2,,2] + POP TP,D + POP TP,A + JUMPN A,TBLOK1 ; JUMP IF FUNCTION ETC. SUPPLIED + CAIN D,-1 + JRST TBLOK1 + CAILE D,NUMPRI ; SKIP IF ORIGINAL TYPE + MOVNI E,(D) ; CAUSE E TO ENDUP 0 + ADDI E,(D) ; POINT TO PURE SLOT +TBLOK1: ADDI C,(C) ; POINT TO VECTOR SLOT + ADDI C,(B) + CAIN D,-1 + JRST RETCUR + JUMPN A,OK.SET ; OK TO CLOBBER + ADDI B,(D) ; POINT TO TARGET TYPE'S SLOT + ADDI B,(D) ; POINT TO TARGET TYPE'S SLOT + SKIPN A,(B) ; SKIP IF WINNER + SKIPE 1(B) ; SKIP IF LOSER + SKIPA D,1(B) ; SETUP D + JRST CH.PTB ; CHECK PURE TABLE + +OK.SET: CAIN 0,(D) ; SKIP ON RESET + SETZB A,D + MOVEM A,(C) ; STORE + MOVEM D,1(C) +RETAR1: MOVE A,(AB) ; RET TYPE + MOVE B,1(AB) + JRST FINIS + +CH.PTB: MOVEI A,0 + MOVE D,[SETZ NAPT] + JUMPE E,OK.SET + MOVE D,(E) + JRST OK.SET + +RETPM2: SUB TP,[4,,4] + SUB P,[2,,2] + ASH C,1 + SOJA E,RETPM4 + +RETCUR: SKIPN A,(C) + SKIPE 1(C) + SKIPA B,1(C) + JRST RETPRM + + JUMPN A,CPOPJ +RETPM1: MOVEI A,0 + JUMPL B,RTFALS + CAMN B,1(E) + JRST .+3 + ADDI A,2 + AOJA E,.-3 + +RETPM3: ADD A,TYPVEC+1 + MOVE B,3(A) + MOVE A,2(A) + POPJ P, + +RETPRM: SUBI C,(B) ; UNDO BADNESS +RETPM4: CAIG C,NUMPRI*2 + SKIPG 1(E) + JRST RTFALS + + MOVEI A,-2(C) + JRST RETPM3 + +CALLTY: MOVE A,TYPVEC + MOVE B,TYPVEC+1 + POPJ P, + +MFUNCTION ALLTYPES,SUBR + + ENTRY 0 + + MOVE A,TYPVEC + MOVE B,TYPVEC+1 + JRST FINIS + +; + +;FUNCTION TO RETURN TYPE OF ELEMENTS IN A UVECTOR + +MFUNCTION UTYPE,SUBR + + ENTRY 1 + + GETYP A,(AB) ;GET U VECTOR + PUSHJ P,SAT + CAIE A,SNWORD + JRST WTYP1 + MOVE B,1(AB) ; GET UVECTOR + PUSHJ P,CUTYPE + JRST FINIS + +CUTYPE: HLRE A,B ;GET -LENGTH + HRRZS B + SUB B,A ;POINT TO TYPE WORD + GETYP A,(B) + JRST ITYPE ; GET NAME OF TYPE + +; FUNCTION TO CHANGE UNIFORM TYPE OF A VECTOR + +MFUNCTION CHUTYPE,SUBR + + ENTRY 2 + + GETYP A,2(AB) ;GET 2D TYPE + CAIE A,TATOM + JRST NOTATO + GETYP A,(AB) ; CALL WITH UVECTOR? + PUSHJ P,SAT + CAIE A,SNWORD + JRST WTYP1 + MOVE A,1(AB) ; GET UV POINTER + MOVE B,3(AB) ;GET ATOM + PUSHJ P,CCHUTY + MOVE A,(AB) ; RETURN UVECTOR + MOVE B,1(AB) + JRST FINIS + +CCHUTY: PUSH TP,$TUVEC + PUSH TP,A + PUSHJ P,TYPLOO ;LOOK IT UP + HRRZ B,(A) ;GET SAT + TRNE B,CHBIT + JRST CANTCH + ANDI B,SATMSK + SKIPGE MKTBS(B) + JRST CANTCH + HLRE C,(TP) ;-LENGTH + HRRZ E,(TP) + SUB E,C ;POINT TO TYPE + GETYP A,(E) ;GET TYPE + JUMPE A,WIN0 ;ALLOW TYPE "LOSE" TO CHANGE TO ANYTHING + PUSHJ P,SAT ;GET SAT + JUMPE A,TYPERR + CAIE A,(B) ;COMPARE + JRST TYPDIF +WIN0: ADDI D,.VECT. + HRLM D,(E) ;CLOBBER NEW ONE + POP TP,B + POP TP,A + POPJ P, + +CANTCH: PUSH TP,$TATOM + PUSH TP,EQUOTE CANT-CHTYPE-INTO + PUSH TP,2(AB) + PUSH TP,3(AB) + MOVEI A,2 + JRST CALER + +NOTATOM: + PUSH TP,$TATOM + PUSH TP,EQUOTE NON-ATOMIC-ARGUMENT + PUSH TP,(AB) + PUSH TP,1(AB) + MOVEI A,2 + JRST CALER + + + +; SUBROUTINE TO LEAVE MUDDLE CLOSING ALL CHANNELS ON THE WAY + +MFUNCTION QUIT,SUBR + + ENTRY 0 + + + PUSHJ P,CLOSAL ; DO THE CLOSES + PUSHJ P,%KILLM + JRST IFALSE ; JUST IN CASE + +CLOSAL: MOVEI B,CHNL0+2 ; POINT TO 1ST (NOT INCLUDING TTY I/O) + MOVE PVP,PVSTOR+1 + MOVE TVP,REALTV+1(PVP) + SUBI B,(TVP) + HRLS B + ADD B,TVP + PUSH TP,$TVEC + PUSH TP,B + PUSH P,[N.CHNS-1] ; MAX NO. OF CHANS + +CLOSA1: MOVE B,(TP) + ADD B,[2,,2] + MOVEM B,(TP) + HLLZS -2(B) + SKIPN C,-1(B) ; THIS ONE OPEN? + JRST CLOSA4 ; NO + CAME C,TTICHN+1 + CAMN C,TTOCHN+1 + JRST CLOSA4 + PUSH TP,-2(B) ; PUSH IT + PUSH TP,-1(B) + MCALL 1,FCLOSE ; CLOSE IT +CLOSA4: SOSLE (P) ; COUNT DOWN + JRST CLOSA1 + + + SUB TP,[2,,2] + SUB P,[1,,1] + +CLOSA3: SKIPN B,CHNL0+1 + POPJ P, + PUSH TP,(B) + HLLZS (TP) + PUSH TP,1(B) + HRRZ B,(B) + MOVEM B,CHNL0+1 + MCALL 1,FCLOSE + JRST CLOSA3 + + +IMPURE + +WHOAMI: 0 ; SYAYS WHETHER I AM REALLY A MUDDLE OR SOME HACK + + +;GARBAGE COLLECTORS PDLS + + +GCPDL: -GCPLNT,,GCPDL + + BLOCK GCPLNT + + +PURE + +MUDSTR: ASCII /MUDDLE / +STRNG: -1 + -1 + -1 + ASCIZ / IN OPERATION./ + +;MARKED PDLS FOR GC PROCESS + +VECTGO +; DUMMY FRAME FOR INITIALIZER CALLS + + TENTRY,,LISTEN + 0 + .-3 + 0 + 0 + -ITPLNT,,TPBAS-1 + 0 + +TPBAS: BLOCK ITPLNT+PDLBUF + GENERAL + ITPLNT+2+PDLBUF+7,,0 + + +VECRET + + +$TMATO: TATOM,,-1 + +END + \ No newline at end of file diff --git a//main.mid.352 b//main.mid.352 new file mode 100644 index 0000000..2be87b5 --- /dev/null +++ b//main.mid.352 @@ -0,0 +1,2058 @@ +TITLE MAIN LOOP AND GLOBALLY REFERENCED SUBROUTINES + +RELOCA + +.GLOBAL TBINIT,PIDSTO,PROCID,PTIME,GCPDL,PBASE,TYPTOP,RERR,FRMSTK,EMERGE +.GLOBAL PDLBUF,INTINT,START,SWAP,ICR,SPBASE,TPBASE,TPBAS,CURPRI,CHFINI,MKTBS +.GLOBAL TOPLEVEL,INTOBL,INITIA,ERROBL,MAINPR,RESFUN,STATUS,TYPVEC,ROOT,TTICHN,TTOCHN +.GLOBAL TTYOPE,MOPEN,MCLOSE,MIOT,ILVAL,MESS,ERROR,CHFRM,IGVAL,TYPBOT,ASOVEC +.GLOBAL PRINT,PRIN1,PRINC,MUDSTR,VECBOT,CSTACK,IFALSE,TYPLOO,RCALL,SWAPIN,CTMPLT +.GLOBAL IDPROC,CHFSWP,ILOC,MAKACT,BNDV,SPECSTORE,BINDID,IGLOC,MTYO,MSGTYP,CAFRE1,CPOPJ +.GLOBAL EVATYP,EVTYPE,APLTYP,APTYPE,PRNTYP,PRTYPE,AGC,SGSNAM,NAPT,APLQ,STRTO6 +.GLOBAL 6TOCHS,TYPFND,STBL,CHNL0,N.CHNS,CLOSAL,%LOGOUT,%SSNAM,%RSNAM,%KILLM,SAT +.GLOBAL MAKINF,%VALRET,COMPERR,IPUT,IGET,TMATCH,INITIZ,IPCINI,%UNAM,%JNAM,%RUNAM,%RJNAM,%RXUNA,%RXJNA,%VALFI +.GLOBAL NOTTY,DEMFLG,CFRAME,CARGS,CFUNCT,CITYPE,CTYPEQ,CPTYPE,CTYPEP,CUTYPE, +.GLOBAL CCHUTY,RTFALS,PGINT,PURCLN,CTYPEC,CTYPEW,IDVAL1,CALLTY,MESSAG,INITFL,WHOAMI +.GLOBAL %SLEEP,%HANG,%TOPLQ,ONINT,CHUNW,CURFCN,BUFRIN,TD.LNT,TD.GET,TD.AGC,TD.PUT,MPOPJ +.GLOBAL PURVEC,PLOAD,SSPECS,OUTRNG,CVTYPE,FSTART,CKVRS,CPRTYC,PVSTOR,SPSTOR +.GLOBAL TYPIC,CISET,LSTUF,IMPURI,REALTV +.INSRT MUDDLE > + +;MAIN LOOP AND STARTUP + +START: MOVEI 0,0 ; SET NO HACKS + JUMPE 0,START1 + TLNE 0,-1 ; SEE IF CHANNEL + JRST START1 + MOVE P,GCPDL + MOVE A,0 + PUSH P,A + PUSHJ P,CKVRS ; CHECK VERSION NUMBERS + POP P,A + JRST FSTART ; GO RESTORE +START1: MOVEM 0,WHOAMI ; HACK FOR TS FOO linked to TS MUDDLE + MOVE PVP,MAINPR ; MAKE SURE WE START IN THE MAIN PROCESS + JUMPE 0,INITIZ ; MIGHT BE RESTART + MOVE P,PSTO+1(PVP) ; SET UP FOR BOOTSTRAP HACK + MOVE TP,TPSTO+1(PVP) +INITIZ: MOVE PVP,MAINPR + SKIPN P ; IF NO CURRENT P + MOVE P,PSTO+1(PVP) ; PDL TO GET OFF THE GROUND + SKIPN TP ; SAME FOR TP + MOVE TP,TPSTO+1(PVP) ; GET A TP TO WORK WITH + SETZB R,M ; RESET RSUBR AC'S + PUSHJ P,%RUNAM + JFCL + PUSHJ P,%RJNAM + PUSHJ P,TTYOPE ;OPEN THE TTY + MOVEI B,MUDSTR + SKIPE WHOAMI ; SKIP IF THIS IS MUDDLE + JRST NODEMT ; ELSE NO MESSAGE + SKIPE DEMFLG ; SKIP IF NOT DEMON + JRST NODEMT + SKIPN NOTTY ; IF NO TTY, IGNORE + PUSHJ P,MSGTYP ;TYPE OUT TO USER + +NODEMT: XCT MESSAG ;MAYBE PRINT A MESSAGE + PUSHJ P,INTINT ;INITIALIZE INTERRUPT HANDLER + XCT IPCINI + PUSHJ P,PURCLN ; CLEAN UP PURE SHARED AREA +RESTART: ;RESTART A PROCESS +STP: MOVEI C,0 + MOVE PVP,PVSTOR+1 + MOVE B,TBINIT+1(PVP) ;POINT INTO STACK AT START + PUSHJ P,CHUNW ; LEAVE WHILE DOING UNWIND CHECK + XMOVEI E,TOPLEV + MOVEI A,TFALSE ; IN CASE FALLS OFF PROCESS + MOVEI B,0 + MOVEM E,-1(TB) + JRST CONTIN + + IMQUOTE TOPLEVEL +TOPLEVEL: + MCALL 0,LISTEN + JRST TOPLEVEL + + +IMFUNCTION LISTEN,SUBR + + ENTRY + PUSH P,[0] ;FLAG: DON'T PRINT ERROR MSG + JRST ER1 + +; USER SUPPLIED ERROR HANDLER, TEMPORARY KLUDGE + IMQUOTE ERROR + +ERROR: MOVE B,IMQUOTE ERROR + PUSHJ P,IGVAL ; GET VALUE + GETYP C,A + CAIN C,TSUBR ; CHECK FOR NO CHANGE + CAIE B,RERR1 ; SKIP IF NOT CHANGED + JRST .+2 + JRST RERR1 ; GO TO THE DEFAULT + PUSH TP,A ; SAVE VALUE + PUSH TP,B + MOVE C,AB ; SAVE AB + MOVEI D,1 ; AND COUNTER +USER1: PUSH TP,(C) ; PUSH THEM + PUSH TP,1(C) + ADD C,[2,,2] ; BUMP + ADDI D,1 + JUMPL C,USER1 + ACALL D,APPLY ; EVAL USERS ERROR + JRST FINIS + + + +IMFUNCTION ERROR%,SUBR,ERROR + +RERR1: ENTRY + PUSH TP,$TATOM + PUSH TP,MQUOTE ERROR,ERROR,INTRUP + PUSHJ P,FRMSTK ; PUT ERROR'S FRAME ON STACK + MOVEI D,2 + MOVE C,AB +RERR2: JUMPGE C,RERR22 + PUSH TP,(C) + PUSH TP,1(C) + ADD C,[2,,2] + AOJA D,RERR2 +RERR22: ACALL D,EMERGENCY + JRST RERR + +IMQUOTE ERROR +RERR: ENTRY + PUSH P,[-1] ;PRINT ERROR FLAG + +ER1: MOVE B,IMQUOTE INCHAN + PUSHJ P,ILVAL ; CHECK INPUT CHANNEL IS SOME KIND OF TTY + GETYP A,A + CAIE A,TCHAN ; SKIP IF IT IS A CHANNEL + JRST ER2 ; NO, MUST REBIND + CAMN B,TTICHN+1 + JRST NOTINC +ER2: MOVE B,IMQUOTE INCHAN + MOVEI C,TTICHN ; POINT TO VALU + PUSHJ P,PUSH6 ; PUSH THE BINDING + MOVE B,TTICHN+1 ; GET IN CHAN +NOTINC: SKIPN DEMFLG ; SKIP IF DEMON + SKIPE NOTTY + JRST NOECHO + PUSH TP,$TCHAN + PUSH TP,B + PUSH TP,$TATOM + PUSH TP,IMQUOTE T + MCALL 2,TTYECH ; ECHO INPUT +NOECHO: MOVE B,IMQUOTE OUTCHAN + PUSHJ P,ILVAL ; GET THE VALUE + GETYP A,A + CAIE A,TCHAN ; SKIP IF OK CHANNEL + JRST ER3 ; NOT CHANNEL, MUST REBIND + CAMN B,TTOCHN+1 + JRST NOTOUT +ER3: MOVE B,IMQUOTE OUTCHAN + MOVEI C,TTOCHN + PUSHJ P,PUSH6 ; PUSH THE BINDINGS +NOTOUT: MOVE B,IMQUOTE OBLIST + PUSHJ P,ILVAL ; GET THE VALUE OF OBLIST + PUSHJ P,OBCHK ; IS IT A WINNER ? + SKIPA A,$TATOM ; NO, SKIP AND CONTINUE + JRST NOTOBL ; YES, DO NOT DO REBINDING + MOVE B,IMQUOTE OBLIST + PUSHJ P,IGLOC + GETYP 0,A + CAIN 0,TUNBOU + JRST MAKOB ; NO GLOBAL OBLIST, MAKE ONE + MOVEI C,(B) ; COPY ADDRESS + MOVE A,(C) ; GET THE GVAL + MOVE B,(C)+1 + PUSHJ P,OBCHK ; IS IT A WINNER ? + JRST MAKOB ; NO, GO MAKE A NEW ONE + MOVE B,IMQUOTE OBLIST + PUSHJ P,PUSH6 + +NOTOBL: PUSH TP,[TATOM,,-1] ;FOR BINDING + PUSH TP,IMQUOTE LER,[LERR ]INTRUP + PUSHJ P,MAKACT + HRLI A,TFRAME ; CORRCT TYPE + PUSH TP,A + PUSH TP,B + PUSH TP,[0] + PUSH TP,[0] + MOVE A,PVSTOR+1 ; GET PROCESS + ADD A,[PROCID,,PROCID] ; POINT TO ID (ALSO LEVEL) + PUSH TP,BNDV + PUSH TP,A + MOVE A,PROCID(PVP) + ADDI A,1 ; BUMP ERROR LEVEL + PUSH TP,A + PUSH TP,PROCID+1(PVP) + PUSH P,A + + MOVE B,IMQUOTE READ-TABLE + PUSHJ P,IGVAL + PUSH TP,[TATOM,,-1] + PUSH TP,IMQUOTE READ-TABLE + GETYP C,A ; TO GVAL OF READ-TABLE ON ERROR AND + CAIE C,TVEC ; TOP ERRET'S + JRST .+4 + PUSH TP,A + PUSH TP,B + JRST .+3 + PUSH TP,$TUNBOUND + PUSH TP,[-1] + PUSH TP,[0] + PUSH TP,[0] + + PUSHJ P,SPECBIND ;BIND THE CRETANS + MOVE A,-1(P) ;RESTORE SWITHC + JUMPE A,NOERR ;IF 0, DONT PRINT ERROR MESS + PUSH TP,$TATOM + PUSH TP,EQUOTE *ERROR* + MCALL 0,TERPRI + MCALL 1,PRINC ;PRINT THE MESSAGE +NOERR: MOVE C,AB ;GET A COPY OF AB + +ERRLP: JUMPGE C,LEVPRT ;IF NONE, RE-ENTER READ-EVAL-PRINT LOOP + PUSH TP,$TAB + PUSH TP,C + MOVEI B,PRIN1 + GETYP A,(C) ; GET ARGS TYPE + CAIE A,TATOM + JRST ERROK + MOVE A,1(C) ; GET ATOM + HRRO A,2(A) + CAME A,[-1,,ERROBL+1] + CAMN A,ERROBL+1 ; DONT SKIP IF IN ERROR OBLIST + MOVEI B,PRINC ; DONT PRINT TRAILER +ERROK: PUSH P,B ; SAVE ROUTINE POINTER + PUSH TP,(C) + PUSH TP,1(C) + MCALL 0,TERPRI ; CRLF + POP P,B ; GET ROUTINE BACK + .MCALL 1,(B) + POP TP,C + SUB TP,[1,,1] + ADD C,[2,,2] ;BUMP SAVED AB + JRST ERRLP ;AND CONTINUE + + +LEVPRT: XCT INITFL ;LOAD MUDDLE INIT FILE IF FIRST TIME + MCALL 0,TERPRI + PUSH TP,$TATOM + PUSH TP,EQUOTE [LISTENING-AT-LEVEL ] + MCALL 1,PRINC ;PRINT LEVEL + PUSH TP,$TFIX ;READY TO PRINT LEVEL + HRRZ A,(P) ;GET LEVEL + SUB P,[2,,2] ;AND POP STACK + PUSH TP,A + MCALL 1,PRIN1 ;PRINT WITHOUT SPACES ETC. + PUSH TP,$TATOM ;NOW PROCESS + PUSH TP,EQUOTE [ PROCESS ] + MCALL 1,PRINC ;DONT SLASHIFY SPACES + MOVE PVP,PVSTOR+1 + PUSH TP,PROCID(PVP) ;NOW ID + PUSH TP,PROCID+1(PVP) + MCALL 1,PRIN1 + SKIPN C,CURPRI + JRST MAINLP + PUSH TP,$TFIX + PUSH TP,C + PUSH TP,$TATOM + PUSH TP,EQUOTE [ INT-LEVEL ] + MCALL 1,PRINC + MCALL 1,PRIN1 + JRST MAINLP ; FALL INTO MAIN LOOP + + ;ROUTINES FOR ERROR-LISTEN + +OBCHK: GETYP 0,A + CAIN 0,TOBLS + JRST CPOPJ1 ; WIN FOR SINGLE OBLIST + CAIE 0,TLIST ; IF LIST, MAKE SURE EACH IS AN OBLIST + JRST CPOPJ ; ELSE, LOSE + + JUMPE B,CPOPJ ; NIL ,LOSE + PUSH TP,A + PUSH TP,B + PUSH P,[0] ;FLAG FOR DEFAULT CHECKING + MOVEI 0,1000 ; VERY BIG NUMBER FOR CIRCULARITY TEST + +OBCHK0: INTGO + SOJE 0,OBLOSE ; CIRCULARITY TEST + HRRZ B,(TP) ; GET LIST POINTER + GETYP A,(B) + CAIE A,TOBLS ; SKIP IF WINNER + JRST DEFCHK ; CHECK FOR SPECIAL ATOM DEFAULT + HRRZ B,(B) + MOVEM B,(TP) + JUMPN B,OBCHK0 +OBWIN: AOS (P)-1 +OBLOSE: SUB TP,[2,,2] + SUB P,[1,,1] + POPJ P, + +DEFCHK: SKIPN (P) ; BEEN HERE BEFORE ? + CAIE A,TATOM ; OR, NOT AN ATOM ? + JRST OBLOSE ; YES, LOSE + MOVE A,(B)+1 + CAME A,MQUOTE DEFAULT + JRST OBLOSE ; LOSE + SETOM (P) ; SET FLAG + HRRZ B,(B) ; CHECK FOR END OF LIST + MOVEM B,(TP) + JUMPN B,OBCHK0 ; NOT THE END, CONTINUE LOOKING + JRST OBLOSE ; LOSE FOR DEFAULT AT THE END + + + +PUSH6: PUSH TP,[TATOM,,-1] + PUSH TP,B + PUSH TP,(C) + PUSH TP,1(C) + PUSH TP,[0] + PUSH TP,[0] + POPJ P, + + +MAKOB: PUSH TP,INITIAL + PUSH TP,INITIAL+1 + PUSH TP,ROOT + PUSH TP,ROOT+1 + MCALL 2,LIST + PUSH TP,$TATOM + PUSH TP,IMQUOTE OBLIST + PUSH TP,A + PUSH TP,B + MCALL 2,SETG + PUSH TP,[TATOM,,-1] + PUSH TP,IMQUOTE OBLIST + PUSH TP,A + PUSH TP,B + PUSH TP,[0] + PUSH TP,[0] + JRST NOTOBL + + +;THIS IS IT FOLKS...THE MAIN LOOP. READ, EVAL, PRINT + +MAINLP: MOVE A,$TATOM ;KLUDGE BY NDR LIKE ERROR TO LET LOOSER REDEFINE + MOVE B,IMQUOTE REP + PUSHJ P,ILVAL ;GET ITS LVAL TO SEE IF REDEFINED + GETYP C,A + CAIE C,TUNBOUND + JRST REPCHK + MOVE A,$TATOM ;SEE IF IT HAS GVAL SINCE NO LVAL + MOVE B,IMQUOTE REP + PUSHJ P,IGVAL + GETYP C,A + CAIN C,TUNBOUN + JRST IREPER +REPCHK: CAIN C,TSUBR + CAIE B,REPER + JRST .+2 + JRST IREPER +REREPE: PUSH TP,A + PUSH TP,B + GETYP A,-1(TP) + PUSHJ P,APLQ + JRST ERRREP + MCALL 1,APPLY ;LOOSER HAS REDEFINED SO CALL HIS + JRST MAINLP +IREPER: PUSH P,[0] ;INDICATE FALL THROUGH + JRST REPERF + +ERRREP: PUSH TP,[TATOM,,-1] + PUSH TP,IMQUOTE REP + PUSH TP,$TSUBR + PUSH TP,[REPER] + PUSH TP,[0] + PUSH TP,[0] + PUSHJ P,SPECBIN + PUSH TP,$TATOM + PUSH TP,EQUOTE NON-APPLICABLE-REP + PUSH TP,-11(TP) + PUSH TP,-11(TP) + MCALL 2,ERROR + SUB TP,[6,,6] + PUSHJ P,SSPECS + JRST REREPE + + +IMFUNCTION REPER,SUBR,REP +REPER: ENTRY 0 + PUSH P,[1] ;INDICATE DIRECT CALL +REPERF: MCALL 0,TERPRI + MCALL 0,READ + PUSH TP,A + PUSH TP,B + MOVE B,IMQUOTE L-INS + PUSHJ P,ILVAL ; ASSIGNED? + GETYP 0,A + CAIN 0,TLIST + + PUSHJ P,LSTTOF ; PUT LAST AS FIRST + MCALL 0,TERPRI + MCALL 1,EVAL + MOVE C,IMQUOTE LAST-OUT + PUSHJ P,CISET + PUSH TP,A + PUSH TP,B + MOVE B,IMQUOTE L-OUTS + PUSHJ P,ILVAL ; ASSIGNED? + GETYP 0,A + CAIN 0,TLIST + + CAME B,(TP) ; DONT STUFF IT INTO ITSELF + JRST STUFIT ; STUFF IT IN + GETYP 0,-1(TP) + CAIE 0,TLIST ; IF A LIST THE L-OUTS +STUFIT: PUSHJ P,LSTTOF ; PUT LAST AS FIRST + MCALL 1,PRIN1 + POP P,C ;FLAG FOR FALL THROUGH OR CALL + JUMPN C,FINIS ;IN CASE LOOSER CALLED REP + JRST MAINLP + +LSTTOF: SKIPN A,B + POPJ P, + + HRRZ C,(A) + JUMPE C,LSTTO2 + MOVEI D,(C) ; SAVE PTR TO 2ND ELEMENT + MOVEI 0,-1 ; LET THE LOSER LOSE (HA HA HA) + +LSTTO1: HRRZ C,(C) ; START SCAN + JUMPE C,GOTIT + HRRZ A,(A) + SOJG 0,LSTTO1 + +GOTIT: HRRZ C,(A) + HLLZS (A) + CAIE D,(C) ; AVOID CIRCULARITY + HRRM D,(C) + HRRM C,(B) + MOVE D,1(B) + MOVEM D,1(C) + GETYP D,(B) + PUTYP D,(C) + +LSTTO2: MOVSI A,TLIST + MOVE C,-1(TP) + MOVE D,(TP) + JRST LSTUF + +;FUNCTION TO RETRY A PREVIOUS FUNCTION CALL + +MFUNCTION RETRY,SUBR + + ENTRY + JUMPGE AB,RETRY1 ; USE MOST RECENT + CAMGE AB,[-2,,0] + JRST TMA + GETYP A,(AB) ; CHECK TYPE + CAIE A,TFRAME + JRST WTYP1 + MOVEI B,(AB) ; POINT TO ARG + JRST RETRY2 +RETRY1: MOVE B,IMQUOTE LER,[LERR ]INTRUP + PUSHJ P,ILOC ; LOCATIVE TO FRAME +RETRY2: PUSHJ P,CHFSWP ; CHECK VALIDITY AND SWAP IF NECESSARY + HRRZ 0,OTBSAV(B) ; CHECK FOR TOP + JUMPE 0,RESTAR ; YES RE-ENTER TOP LEVEL + PUSH TP,$TTB + PUSH TP,B ; SAVE FRAME + MOVE B,OTBSAV(B) ; GET PRVIOUS FOR UNBIND HACK + MOVEI C,-1(TP) + PUSHJ P,CHUNW ; CHECK ANY UNWINDING + CAME SP,SPSAV(TB) ; UNBINDING NEEDED? + PUSHJ P,SPECSTORE + MOVE P,PSAV(TB) ; GET OTHER STUFF + MOVE AB,ABSAV(B) + HLRE A,AB ; COMPUTE # OF ARGS + MOVNI A,-FRAMLN(A) ; MAKE TP POINT PAST FRAME + HRLI A,(A) + MOVE C,TPSAV(TB) ; COMPUTE TP + ADD C,A + MOVE TP,C + MOVE TB,B ; FIX UP TB + HRRZ C,FSAV(TB) ; GET FUNCTION + CAIL C,HIBOT + JRST (C) ; GO + GETYP 0,(C) ; RSUBR OR ENTRY? + CAIE 0,TATOM + CAIN 0,TRSUBR + JRST RETRNT + MOVS R,(C) ; SET UP R + HRRI R,(C) + MOVEI C,0 + JRST RETRN3 + +RETRNT: CAIE 0,TRSUBR + JRST RETRN1 + MOVE R,1(C) +RETRN4: HRRZ C,2(C) ; OFFSET +RETRN3: SKIPL M,1(R) + JRST RETRN5 +RETRN7: ADDI C,(M) + JRST (C) + +RETRN5: MOVEI D,(M) ; TOTAL OFFSET + MOVSS M + ADD M,PURVEC+1 + SKIPL M,1(M) + JRST RETRN6 + ADDI M,(D) + JRST RETRN7 + +RETRN6: HLRZ A,1(R) + PUSH P,D + PUSH P,C + PUSHJ P,PLOAD + JRST RETRER ; LOSER + POP P,C + POP P,D + MOVE M,B + JRST RETRN7 + +RETRN1: HRL C,(C) ; FIX LH + MOVE B,1(C) + PUSH TP,$TVEC + PUSH TP,C + PUSHJ P,IGVAL + GETYP 0,A + MOVE C,(TP) + SUB TP,[2,,2] + CAIE 0,TRSUBR + JRST RETRN2 + MOVE R,B + JRST RETRN4 + +RETRN2: ERRUUO EQUOTE CANT-RETRY-ENTRY-GONE + +RETRER: ERRUUO EQUOTE PURE-LOAD-FAILURE + + +;FUNCTION TO DO ERROR RETURN + +IMFUNCTION ERRET,SUBR + + ENTRY + HLRE A,AB ; -2*# OF ARGS + JUMPGE A,STP ; RESTART PROCESS + ASH A,-1 ; -# OF ARGS + AOJE A,ERRET2 ; NO FRAME SUPPLIED + AOJL A,TMA + ADD AB,[2,,2] + PUSHJ P,OKFRT + JRST WTYP2 + SUB AB,[2,,2] + PUSHJ P,CHPROC ; POINT TO FRAME SLOT + JRST ERRET3 +ERRET2: MOVE B,IMQUOTE LER,[LERR ]INTRUP + PUSHJ P,ILVAL ; GET ITS VALUE +ERRET3: PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + PUSHJ P,CHFSWP ; CHECK VALIDITY AND SWAP IF NECESSARY + HRRZ 0,OTBSAV(B) ; TOP LEVEL? + JUMPE 0,TOPLOS + PUSHJ P,CHUNW ; ANY UNWINDING + JRST CHFINIS + + +; FUNCTION TO RETURN LAST ERROR FRAME OR PREVIOUS FRAME + +IMFUNCTION FRAME,SUBR + ENTRY + SETZB A,B + JUMPGE AB,FRM1 ; DEFAULT CASE + CAMG AB,[-3,,0] ; SKIP IF OK ARGS + JRST TMA + PUSHJ P,OKFRT ; A FRAME OR SIMILAR THING? + JRST WTYP1 + +FRM1: PUSHJ P,CFRAME ; GO TO INTERNAL + JRST FINIS + +CFRAME: JUMPN A,FRM2 ; ARG SUPPLIED? + MOVE B,IMQUOTE LER,[LERR ]INTRUP + PUSHJ P,ILVAL + JRST FRM3 +FRM2: PUSHJ P,CHPROC ; CHECK FOR PROCESS + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) ; POINT TO SLOT + PUSHJ P,CHFRM ; CHECK IT + MOVE C,(TP) ; GET FRAME BACK + MOVE B,OTBSAV(C) ;GET PREVIOUS FRAME + SUB TP,[2,,2] + TRNN B,-1 ; SKIP IF OK + JRST TOPLOSE + +FRM3: JUMPN B,FRM4 ; JUMP IF WINNER + MOVE B,IMQUOTE THIS-PROCESS + PUSHJ P,ILVAL ; GET PROCESS OF INTEREST + GETYP A,A ; CHECK IT + CAIN A,TUNBOU + MOVE B,PVSTOR+1 ; USE CURRENT + MOVEI A,PVLNT*2+1(B) ; POINT TO DOPE WORDS + MOVE B,TBINIT+1(B) ; AND BASE FRAME +FRM4: HLL B,OTBSAV(B) ;TIME + HRLI A,TFRAME + POPJ P, + +OKFRT: AOS (P) ;ASSUME WINNAGE + GETYP 0,(AB) + MOVE A,(AB) + MOVE B,1(AB) + CAIE 0,TFRAME + CAIN 0,TENV + POPJ P, + CAIE 0,TPVP + CAIN 0,TACT + POPJ P, + SOS (P) + POPJ P, + +CHPROC: GETYP 0,A ; TYPE + CAIE 0,TPVP + POPJ P, ; OK + MOVEI A,PVLNT*2+1(B) + CAMN B,PVSTOR+1 ; THIS PROCESS? + JRST CHPRO1 + MOVE B,TBSTO+1(B) + JRST FRM4 + +CHPRO1: MOVE B,OTBSAV(TB) + JRST FRM4 + +; FUNCTION TO RETURN ARGS TUPLE FOR A FRAME + +MFUNCTION ARGS,SUBR + ENTRY 1 + PUSHJ P,OKFRT ; CHECK FRAME TYPE + JRST WTYP1 + PUSHJ P,CARGS + JRST FINIS + +CARGS: PUSHJ P,CHPROC + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) ; POINT TO FRAME SLOT + PUSHJ P,CHFRM ; AND CHECK FOR VALIDITY + MOVE C,(TP) ; FRAME BACK + MOVSI A,TARGS +CARGS1: GETYP 0,FSAV(C) ; IS THIS A FUNNY ONE + CAIE 0,TCBLK ; SKIP IF FUNNY + JRST .+3 ; NO NORMAL + MOVE C,OTBSAV(C) ; ASSOCIATE WITH PREVIOUS FRAME + JRST CARGS1 + HLR A,OTBSAV(C) ; TIME IT AND + MOVE B,ABSAV(C) ; GET POINTER + SUB TP,[2,,2] ; FLUSH CRAP + POPJ P, + +; FUNCTION TO RETURN FUNCTION ASSOCIATED WITH A FRAME + +MFUNCTION FUNCT,SUBR + ENTRY 1 ; FRAME ARGUMENT + PUSHJ P,OKFRT ; CHECK TYPE + JRST WTYP1 + PUSHJ P,CFUNCT + JRST FINIS + +CFUNCT: PUSHJ P,CHPROC + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + PUSHJ P,CHFRM ; CHECK IT + MOVE C,(TP) ; RESTORE FRAME + HRRZ A,FSAV(C) ;FUNCTION POINTER + CAIL A,HIBOT + SKIPA B,@-1(A) ;NO, GET SUBR'S NAME POINTER + MOVE B,(A)+3 ;YES, GET RSUBR'S NAME ENTRY + MOVSI A,TATOM + SUB TP,[2,,2] + POPJ P, + +BADFRAME: + ERRUUO EQUOTE FRAME-NO-LONGER-EXISTS + + +TOPLOSE: + ERRUUO EQUOTE TOP-LEVEL-FRAME + + + + +; ROUTINE TO HANG INDEFINITELY WITH INTERRUPTS ENABLED + +MFUNCTION HANG,SUBR + + ENTRY + + JUMPGE AB,HANG1 ; NO PREDICATE + CAMGE AB,[-3,,] + JRST TMA + PUSH TP,(AB) + PUSH TP,1(AB) + PUSHJ P,CHKPRD +REHANG: MOVE A,[PUSHJ P,CHKPRH] + MOVEM A,ONINT ; CHECK PREDICATE AFTER ANY INTERRUPT +HANG1: ENABLE ;LET OURSELVES BE INTERRUPTED OUT + PUSHJ P,%HANG + DISABLE ;PREVENT INTERRUPTS AT RANDOM TIMES + SETZM ONINT + MOVE A,$TATOM + MOVE B,IMQUOTE T + JRST FINIS + + +; ROUTINE TO SLEEP FOR POSITIVE NUMBER OF SECONDS WITH INTERRUPTS ENABLED +; ARGUMENT SHOULD BE OF TYPE FIX OR FLOAT AND NON-NEGATIVE + +MFUNCTION SLEEP,SUBR + + ENTRY + + JUMPGE AB,TFA + CAML AB,[-3,,] + JRST SLEEP1 + CAMGE AB,[-5,,] + JRST TMA + PUSH TP,2(AB) + PUSH TP,3(AB) + PUSHJ P,CHKPRD +SLEEP1: GETYP 0,(AB) + CAIE 0,TFIX + JRST .+5 + MOVE B,1(AB) + JUMPL B,OUTRNG ;ARG SHOULDNT BE NEGATIVE + IMULI B,30. ;CONVERT TO # OF THIRTIETHS OF A SECOND + JRST SLEEPR ;GO SLEEP + CAIE 0,TFLOAT ;IF IT WASNT FIX MAKE SURE IT IS FLOAT + JRST WTYP1 ;WRONG TYPE ARG + MOVE B,1(AB) + FMPR B,[30.0] ;CONVERT TO FLOATING # OF THIRTIETHS OF A SECOND + MULI B,400 ;KLUDGE TO FIX IT + TSC B,B + ASH C,(B)-243 + MOVE B,C ;MOVE THE FIXED NUMBER INTO B + JUMPL B,OUTRNG ;CHECK TO SEE THAT WE HAVE POSITIVE NUMBER +SLEEPR: MOVE A,B +RESLEE: MOVE B,[PUSHJ P,CHKPRS] + CAMGE AB,[-3,,] + MOVEM B,ONINT + ENABLE + PUSHJ P,%SLEEP + DISABLE + SETZM ONINT + MOVE A,$TATOM + MOVE B,IMQUOTE T + JRST FINIS + +CHKPRH: PUSH P,B + MOVEI B,HANGP + JRST .+3 + +CHKPRS: PUSH P,B + MOVEI B,SLEEPP + HRRM B,LCKINT + SETZM ONINT ; TURN OFF FEATURE FOR NOW + POP P,B + POPJ P, + +HANGP: SKIPA B,[REHANG] +SLEEPP: MOVEI B,RESLEE + PUSH P,B +CHKPRD: PUSH P,A + DISABLE + PUSH TP,(TB) + PUSH TP,1(TB) + MCALL 1,EVAL + GETYP 0,A + CAIE 0,TFALSE + JRST FINIS + POP P,A + POPJ P, + +MFUNCTION VALRET,SUBR +; SUBR TO VALRET A STRING TO SUPERIOR ITS PROCESS + + ENTRY 1 + GETYP A,(AB) ; GET TYPE OF ARGUMENT + CAIN A,TFIX ; FIX? + JRST VALRT1 + CAIE A,TCHSTR ; IS IT A CHR STRING? + JRST WTYP1 ; NO...ERROR WRONG TYPE + PUSHJ P,CSTACK ; COPY THE CHR STRING TO THE STACK + ; CSTACK IS IN ATOMHK + MOVEI B,0 ; ASCIZ TERMINATOR + EXCH B,(P) ; STORE AND RETRIEVE COUNT + +; CALCULATE THE BEGINNING ADDR OF THE STRING + MOVEI A,-1(P) ; GET ADDR OF TOP OF STACK + SUBI A,-1(B) ; GET STARTING ADDR + PUSHJ P,%VALRE ; PASS UP TO MONITOR + JRST IFALSE ; IF HE RETURNS, RETURN FALSE + +VALRT1: MOVE A,1(AB) + PUSHJ P,%VALFI + JRST IFALSE + +MFUNCTION LOGOUT,SUBR + +; SUBR TO DO A .LOGOUT (VALID ONLY AT TOP LEVEL) + ENTRY 0 + PUSHJ P,%TOPLQ ; SKIP IF AT TOP LEVEL + JRST IFALSE + PUSHJ P,CLOSAL + PUSHJ P,%LOGOUT ; TRY TO FLUSH + JRST IFALSE ; COULDN'T DO IT...RETURN FALSE + +; FUNCTS TO GET UNAME AND JNAME + +; GET XUNAME (REAL UNAME) +MFUNCTION XUNAME,SUBR + + ENTRY 0 + + PUSHJ P,%RXUNA + JRST RSUJNM + JRST FINIS ; 10X ROUTINES SKIP + +MFUNCTION UNAME,SUBR + + ENTRY 0 + + PUSHJ P,%RUNAM + JRST RSUJNM + JRST FINIS + +; REAL JNAME +MFUNCTION XJNAME,SUBR + + ENTRY 0 + + PUSHJ P,%RXJNA + JRST RSUJNM + +MFUNCTION JNAME,SUBR + + ENTRY 0 + + PUSHJ P,%RJNAM + JRST RSUJNM + +; FUNCTION TO SET AND READ GLOBAL SNAME + +MFUNCTION SNAME,SUBR + + ENTRY + + JUMPGE AB,SNAME1 + CAMG AB,[-3,,] + JRST TMA + GETYP A,(AB) ; ARG MUST BE STRING + CAIE A,TCHSTR + JRST WTYP1 + PUSH TP,$TATOM + PUSH TP,IMQUOTE SNM + PUSH TP,(AB) + PUSH TP,1(AB) + MCALL 2,SETG + JRST FINIS + +SNAME1: MOVE B,IMQUOTE SNM + PUSHJ P,IDVAL1 + GETYP 0,A + CAIN 0,TCHSTR + JRST FINIS + MOVE A,$TCHSTR + MOVE B,CHQUOTE + JRST FINIS + +RSUJNM: PUSHJ P,6TOCHS ; CONVERT IT + JRST FINIS + + +SGSNAM: MOVE B,IMQUOTE SNM + PUSHJ P,IDVAL1 + GETYP 0,A + CAIE 0,TCHSTR + JRST SGSN1 + + PUSH TP,A + PUSH TP,B + PUSHJ P,STRTO6 + POP P,A + SUB TP,[2,,2] + JRST .+2 + +SGSN1: MOVEI A,0 + PUSHJ P,%SSNAM ; SET SNAME IN SYSTEM + POPJ P, + + + +;THIS SUBROUTINE ALLOCATES A NEW PROCESS +;TAKES TP-STACK SIZE (2*WORDS) IN A AND P-STACK SIZE (WORDS) IN B +;IS CALLED BY PUSHJ P,. RETURNS IN A AND B A NEW PROCESS. + +ICR: PUSH P,A + PUSH P,B + MOVEI A,PVLNT ;SETUP CALL TO VECTOR FOR PVP + PUSHJ P,IVECT ;GOBBLE A VECTOR + HRLI C,PVBASE ;SETUP A BLT POINTER + HRRI C,(B) ;GET INTO ADDRESS + BLT C,PVLNT*2-1(B) ;COPY A PROTOTYPE INTO NEW PVP + MOVSI C,400000+SPVP+.VECT. ;SET SPECIAL TYPE + MOVEM C,PVLNT*2(B) ;CLOBBER IT IN + PUSH TP,A ;SAVE THE RESULTS OF VECTOR + PUSH TP,B + + PUSH TP,$TFIX ;GET A UNIFORM VECTOR + POP P,B + PUSH TP,B + MCALL 1,UVECTOR + ADD B,[PDLBUF-2,,-1] ;FUDGE WITH BUFFER + MOVE C,(TP) ;REGOBBLE PROCESS POINTER + MOVEM B,PSTO+1(C) ;STORE IN ALL HOMES + MOVEM B,PBASE+1(C) + + + POP P,A ;PREPARE TO CREATE A TEMPORARY PDL + PUSHJ P,IVECT ;GET THE TEMP PDL + ADD B,[PDLBUF,,0] ;PDL GROWTH HACK + MOVE C,(TP) ;RE-GOBBLE NEW PVP + SUB B,[1,,1] ;FIX FOR STACK + MOVEM B,TPBASE+1(C) + +;SETUP INITIAL BINDING + + PUSH B,$TBIND + MOVEM B,SPBASE+1(C) ;SAVE AS BASE OF SP + MOVEM B,SPSTO+1(C) ;AND CURRENT THEREOF + MOVEM B,CURFCN+1(C) ; AND AS CURRENT FCN FOR SPEC/UNSPEC LOGIC + PUSH B,IMQUOTE THIS-PROCESS + PUSH B,$TPVP ;GIVE IT PROCESS AS VALUE + PUSH B,C + ADD B,[2,,2] ;FINISH FRAME + MOVEM B,TPSTO+1(C) ;MAKE THIS THE CURRENT STACK POINTER + MOVEM C,PVPSTO+1(C) ;SAVE THE NEW PVP ITSELF + AOS A,IDPROC ;GOBBLE A UNIQUE PROCESS I.D. + MOVEM A,PROCID+1(C) ;SAVE THAT ALSO + AOS A,PTIME ; GET A UNIQUE BINDING ID + MOVEM A,BINDID+1(C) + + MOVSI A,TPVP ;CLOBBER THE TYPE + MOVE B,(TP) ;AND POINTER TO PROCESS + SUB TP,[2,,2] + POPJ P, + +;MINI ROUTINE TO CALL VECTOR WITH COUNT IN A + +IVECT: PUSH TP,$TFIX + PUSH TP,A + MCALL 1,VECTOR ;GOBBLE THE VECTOR + POPJ P, + + +;SUBROUTINE TO SWAP A PROCESS IN +;CALLED WITH JSP A,SWAP AND NEW PVP IN B + +SWAP: ;FIRST STORE ALL THE ACS + + MOVE PVP,PVSTOR+1 + MOVE SP,$TSP ; STORE SPSAVE + MOVEM SP,SPSTO(PVP) + MOVE SP,SPSTOR+1 + IRP A,,[SP,AB,TB,TP,P,M,R,FRM] + MOVEM A,A!STO+1(PVP) + TERMIN + + SETOM 1(TP) ; FENCE POST MAIN STACK + MOVEM TP,TPSAV(TB) ; CORRECT FRAME + SETZM PSAV(TB) ; CLEAN UP CURRENT FRAME + SETZM SPSAV(TB) + SETZM PCSAV(TB) + + MOVE E,PVP ;RETURN OLD PROCESS IN E + MOVE PVP,D ;AND MAKE NEW ONE BE D + MOVEM PVP,PVSTOR+1 + +SWAPIN: + ;NOW RESTORE NEW PROCESSES AC'S + + MOVE PVP,PVSTOR+1 + IRP A,,[AB,TB,SP,TP,P,M,R,FRM] + MOVE A,A!STO+1(PVP) + TERMIN + + SETZM SPSTO(PVP) + MOVEM SP,SPSTOR+1 + JRST (C) ;AND RETURN + + + + +;SUBRS ASSOCIATED WITH TYPES + +;TYPE (ITYPE) ARE FUNCTIONS TO RETURN THE ATOMIC NAME OF THE +;TYPE OF A GOODIE. TYPE TAKES ITS ARGS ON AP AND RETURNS IN A AND B. +;ITYPE TAKES ITS ARGS IN A AND B AND RETURNS IN SAME (B=0) FOR INVALID +;TYPECODE. +MFUNCTION TYPE,SUBR + + ENTRY 1 + GETYP A,(AB) ;TYPE INTO A +TYPE1: PUSHJ P,ITYPE ;GO TO INTERNAL + JUMPN B,FINIS ;GOOD RETURN +TYPERR: ERRUUO EQUOTE TYPE-UNDEFINED + +CITYPE: GETYP A,A ; GET TYPE FOR COMPILER CALL +ITYPE: LSH A,1 ;TIMES 2 + HRLS A ;TO BOTH SIDES + ADD A,TYPVEC+1 ;GET ACTUAL LOCATION + JUMPGE A,TYPERR ;LOST, TYPE OUT OF BOUNDS + MOVE B,1(A) ;PICKUP TYPE + HLLZ A,(A) + POPJ P, + +; PREDICATE -- IS OBJECT OF TYPE SPECIFIED + +MFUNCTION %TYPEQ,SUBR,[TYPE?] + + ENTRY + + MOVE D,AB ; GET ARGS + ADD D,[2,,2] + JUMPGE D,TFA + MOVE A,(AB) + HLRE C,D + MOVMS C + ASH C,-1 ; FUDGE + PUSHJ P,ITYPQ ; GO INTERNAL + JFCL + JRST FINIS + +ITYPQ: GETYP A,A ; OBJECT + PUSHJ P,ITYPE +TYPEQ0: SOJL C,CIFALS + GETYP 0,(D) + CAIE 0,TATOM ; Type name must be an atom + JRST WRONGT + CAMN B,1(D) ; Same as the OBJECT? + JRST CPOPJ1 ; Yes, return type name + ADD D,[2,,2] + JRST TYPEQ0 ; No, continue comparing + +CIFALS: MOVEI B,0 + MOVSI A,TFALSE + POPJ P, + +CTYPEQ: SOJE A,CIFALS ; TREAT NO ARGS AS FALSE + MOVEI D,1(A) ; FIND BASE OF ARGS + ASH D,1 + HRLI D,(D) + SUBM TP,D ; D POINTS TO BASE + MOVE E,D ; SAVE FOR TP RESTORE + ADD D,[3,,3] ; FUDGE + MOVEI C,(A) ; NUMBER OF TYPES + MOVE A,-2(D) + PUSHJ P,ITYPQ + JFCL ; IGNORE SKIP FOR NOW + MOVE TP,E ; SET TP BACK + JUMPL B,CPOPJ1 ; SKIP + POPJ P, + +; Entries to get type codes for types for fixing up RSUBRs and assembling + +MFUNCTION %TYPEC,SUBR,[TYPE-C] + + ENTRY + + JUMPGE AB,TFA + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP1 + MOVE B,1(AB) + CAMGE AB,[-3,,0] ; skip if only type name given + JRST GTPTYP + MOVE C,IMQUOTE ANY + +TYPEC1: PUSHJ P,CTYPEC ; go to internal + JRST FINIS + +GTPTYP: CAMGE AB,[-5,,0] + JRST TMA + GETYP 0,2(AB) + CAIE 0,TATOM + JRST WTYP2 + MOVE C,3(AB) + JRST TYPEC1 + +CTYPEC: PUSH P,C ; save primtype checker + PUSHJ P,TYPFND ; search type vector + JRST CTPEC2 ; create the poor loser + POP P,B + CAMN B,IMQUOTE ANY + JRST CTPEC1 + CAMN B,IMQUOTE TEMPLATE + JRST TCHK + PUSH P,D + HRRZ A,(A) + ANDI A,SATMSK + PUSH P,A + PUSHJ P,TYPLOO + HRRZ 0,(A) + ANDI 0,SATMSK + CAME 0,(P) + JRST TYPDIF + MOVE D,-1(P) + SUB P,[2,,2] +CTPEC1: MOVEI B,(D) + MOVSI A,TTYPEC + POPJ P, +TCHK: PUSH P,D ; SAVE TYPE + MOVE A,D ; GO TO SAT + PUSHJ P,SAT + CAIG A,NUMSAT ; SKIP IF A TEMPLATE + JRST TYPDIF + POP P,D ; RESTORE TYPE + JRST CTPEC1 + +CTPEC2: POP P,C ; GET BACK PRIMTYPE + SUBM M,(P) + PUSH TP,$TATOM + PUSH TP,B + CAMN C,IMQUOTE ANY + JRST CTPEC3 + PUSH TP,$TATOM + PUSH TP,C + MCALL 2,NEWTYPE ; CREATE THE POOR GUY + MOVE C,IMQUOTE ANY + SUBM M,(P) ; UNRELATIVIZE + JRST CTYPEC + +CTPEC3: HRRZ 0,FSAV(TB) + CAIE 0,%TYPEC + CAIN 0,%TYPEW + JRST TYPERR + + MCALL 1,%TYPEC + JRST MPOPJ + +MFUNCTION %TYPEW,SUBR,[TYPE-W] + + ENTRY + + JUMPGE AB,TFA + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP1 + MOVEI D,0 + MOVE C,IMQUOTE ANY + MOVE B,1(AB) + CAMGE AB,[-3,,0] + JRST CTYPW1 + +CTYPW3: PUSHJ P,CTYPEW + JRST FINIS + +CTYPW1: GETYP 0,2(AB) + CAIE 0,TATOM + JRST WTYP2 + CAMGE AB,[-5,,0] ; JUMP IF RH IS GIVEN + JRST CTYPW2 +CTYPW5: MOVE C,3(AB) + JRST CTYPW3 + +CTYPW2: CAMGE AB,[-7,,0] + JRST TMA + GETYP 0,4(AB) + CAIE 0,TFIX + JRST WRONGT + MOVE D,5(AB) + JRST CTYPW5 + +CTYPEW: PUSH P,D + PUSHJ P,CTYPEC ; GET CODE IN B + POP P,B + HRLI B,(D) + MOVSI A,TTYPEW + POPJ P, + +MFUNCTION %VTYPE,SUBR,[VALID-TYPE?] + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TATOM + JRST WTYP1 + MOVE B,1(AB) + + PUSHJ P,CVTYPE + JFCL + JRST FINIS + +CVTYPE: PUSHJ P,TYPFND ; LOOK IT UP + JRST PFALS + + MOVEI B,(D) + MOVSI A,TTYPEC + JRST CPOPJ1 + +PFALS: MOVEI B,0 + MOVSI A,TFALSE + POPJ P, + +;PRIMTTYPE RETURNS THE TYPE ATOM OF A PRIMITIVE TYPE IN A CLASS + +STBL: REPEAT NUMSAT,SETZ MQUOTE INTERNAL-TYPE + +LOC STBL + +IRP A,,[[1WORD,WORD],[2WORD,LIST],[NWORD,UVECTOR],[2NWORD,VECTOR],[STORE,STORAGE] +[ARGS,TUPLE],[FRAME,FRAME],[ATOM,ATOM],[LOCID,LOCD],[CHSTR,STRING],[OFFS,OFFSET,1] +[PVP,PROCESS,1],[ASOC,ASOC,1],[LOCA,LOCA],[LOCS,LOCS],[LOCU,LOCU],[LOCV,LOCV] +[LOCL,LOCL],[LOCN,LOCAS],[LOCT,LOCT,1],[LOCR,LOCR],[LOCB,LOCB,1],[BYTE,BYTES,1]] +IRP B,C,[A] +LOC STBL+S!B +IRP X,Y,[C] +IFSE [Y],SETZ IMQUOTE X +IFSN [Y],SETZ MQUOTE X +.ISTOP +TERMIN +.ISTOP + +TERMIN +TERMIN + +LOC STBL+NUMSAT+1 + + +MFUNCTION TYPEPRIM,SUBR + + ENTRY 1 + GETYP A,(AB) + CAIE A,TATOM + JRST NOTATOM + MOVE B,1(AB) + PUSHJ P,CTYPEP + JRST FINIS + +CTYPEP: PUSHJ P,TYPLOO ; CONVERT ATOM TO CODE + HRRZ A,(A) ; SAT TO A + ANDI A,SATMSK + JRST PTYP1 + +MFUNCTION PTSATC,SUBR,[PRIMTYPE-C] + + ENTRY 1 + + GETYP A,(AB) + CAIE A,TATOM + JRST WTYP1 + MOVE B,1(AB) + PUSHJ P,CPRTYC + JRST FINIS + +CPRTYC: PUSHJ P,TYPLOO + MOVE B,(A) + ANDI B,SATMSK + MOVSI A,TSATC + POPJ P, + + +IMFUNCTION PRIMTYPE,SUBR + + ENTRY 1 + + MOVE A,(AB) ;GET TYPE + PUSHJ P,CPTYPE + JRST FINIS + +CPTYPE: GETYP A,A + PUSHJ P,SAT ;GET SAT +PTYP1: JUMPE A,TYPERR + MOVE B,IMQUOTE TEMPLATE + CAIG A,NUMSAT ; IF BIG SAT, THEN TEMPLATE + MOVE B,@STBL(A) + MOVSI A,TATOM + POPJ P, + + +; RSUBR MAKES A VECTOR INTO AN OBJECT OF TYPE RSUBR, ALSO SLIGHTLY MUNGING IT + +IMFUNCTION RSUBR,SUBR + ENTRY 1 + + GETYP A,(AB) + CAIE A,TVEC ; MUST BE VECTOR + JRST WTYP1 + MOVE B,1(AB) ; GET IT + GETYP A,(B) ; CHECK 1ST ELEMENTS TYPE + CAIN A,TPCODE ; PURE CODE + JRST .+3 + CAIE A,TCODE + JRST NRSUBR + HLRM B,(B) ; CLOBEER SPECIAL COUNT FIELD + MOVSI A,TRSUBR + JRST FINIS + +NRSUBR: ERRUUO EQUOTE FIRST-ELEMENT-OF-VECTOR-NOT-CODE + +; ROUTINE TO GENERATE ENTRYY OTHER THAN FIRST TO RSUBRR + +IMFUNCTION MENTRY,SUBR,[RSUBR-ENTRY] + + ENTRY 2 + + GETYP 0,(AB) ; TYPE OF ARG + CAIE 0,TVEC ; BETTER BE VECTOR + JRST WTYP1 + GETYP 0,2(AB) + CAIE 0,TFIX + JRST WTYP2 + MOVE B,1(AB) ; GET VECTOR + CAML B,[-3,,0] + JRST BENTRY + GETYP 0,(B) ; FIRST ELEMENT + CAIE 0,TRSUBR + JRST MENTR1 +MENTR2: GETYP 0,2(B) + CAIE 0,TATOM + JRST BENTRY + MOVE C,3(AB) + HRRM C,2(B) ; OFFSET INTO VECTOR + HLRM B,(B) + MOVSI A,TENTER + JRST FINIS + +MENTR1: CAIE 0,TATOM + JRST BENTRY + MOVE B,1(B) ; GET ATOM + PUSHJ P,IGVAL ; GET VAL + GETYP 0,A + CAIE 0,TRSUBR + JRST BENTRY + MOVE C,1(AB) ; RESTORE B + MOVEM A,(C) + MOVEM B,1(C) + MOVE B,C + JRST MENTR2 + +BENTRY: ERRUUO EQUOTE BAD-VECTOR + +; SUBR TO GET ENTRIES OFFSET + +MFUNCTION LENTRY,SUBR,[ENTRY-LOC] + + ENTRY 1 + + GETYP 0,(AB) + CAIE 0,TENTER + JRST WTYP1 + MOVE B,1(AB) + HRRZ B,2(B) + MOVSI A,TFIX + JRST FINIS + +; RETURN FALSE + +RTFALS: MOVSI A,TFALSE + MOVEI B,0 + POPJ P, + +;SUBROUTINE CALL FOR RSUBRs +RCALL: SUBM M,(P) ;CALCULATE PC's OFFSET IN THE RSUBR + HRLI 0,400000 ; DONT LOSE IN MULTI SEG MODE + + PUSHJ P,@0 ;GO TO THE PROPER SUBROUTINE + SUBM M,(P) ;RECONSTITUTE THE RSUBR's PC + POPJ P, + + + +;CHTYPE TAKES TWO ARGUMENTS. ANY GOODIE AND A AN ATOMIC TYPE NAME +;IT CHECKS THE STORAGE ALLOCATION TYPES OF THE TWO ARE THE SAME AND +;IF THEY ARE CHANGES THE TYPE OF THE FIRST TO THAT NAME D IN THE SECOND + +MFUNCTION CHTYPE,SUBR + + ENTRY 2 + GETYP A,2(AB) ;FIRST CHECK THAT ARG 2 IS AN ATOM + CAIE A,TATOM + JRST NOTATOM + MOVE B,3(AB) ;AND TYPE NAME + PUSHJ P,TYPLOO ;GO LOOKUP TYPE +TFOUND: HRRZ B,(A) ;GOBBLE THE SAT + TRNE B,CHBIT ; SKIP IF CHTYPABLE + JRST CANTCH + TRNE B,TMPLBT ; TEMPLAT + HRLI B,-1 + AND B,[-1,,SATMSK] + GETYP A,(AB) ;NOW GET TYPE TO HACK + PUSHJ P,SAT ;FIND OUT ITS SAT + JUMPE A,TYPERR ;COMPLAIN + CAILE A,NUMSAT + JRST CHTMPL ; JUMP IF TEMPLATE DATA + CAIE A,(B) ;DO THEY AGREE? + JRST TYPDIF ;NO, COMPLAIN +CHTMP1: MOVSI A,(D) ;GET NEW TYPE + HRR A,(AB) ; FOR DEFERRED GOODIES + JUMPL B,CHMATC ; CHECK IT + MOVE B,1(AB) ;AND VALUE + JRST FINIS + +CHTMPL: MOVE E,1(AB) ; GET ARG + HLRZ A,(E) + ANDI A,SATMSK + MOVE 0,3(AB) ; SEE IF TO "TEMPLATE" + CAMN 0,IMQUOTE TEMPLATE + JRST CHTMP1 + TLNN E,-1 ; SKIP IF RESTED + CAIE A,(B) + JRST TYPDIF + JRST CHTMP1 + +CHMATC: PUSH TP,A + PUSH TP,1(AB) ; SAVE GOODIE + MOVSI A,TATOM + MOVE B,3(AB) + MOVSI C,TATOM + MOVE D,IMQUOTE DECL + PUSHJ P,IGET ; FIND THE DECL + PUSH TP,A + PUSH TP,B + MOVE C,(AB) + MOVE D,1(AB) ; NOW GGO TO MATCH + PUSHJ P,TMATCH + JRST CHMAT1 + SUB TP,[2,,2] +CHMAT2: POP TP,B + POP TP,A + JRST FINIS + +CHMAT1: POP TP,B + POP TP,A + MOVE C,-1(TP) + MOVE D,(TP) + PUSHJ P,TMATCH + JRST TMPLVI + JRST CHMAT2 + +TYPLOO: PUSHJ P,TYPFND + ERRUUO EQUOTE BAD-TYPE-NAME + POPJ P, + +TYPFND: HLRE A,B ; FIND DOPE WORDS + SUBM B,A ; A POINTS TO IT + HRRE D,(A) ; TYPE-CODE TO D + JUMPE D,CPOPJ + ANDI D,TYPMSK ; FLUSH FUNNY BITS + MOVEI A,(D) + ASH A,1 + HRLI A,(A) + ADD A,TYPVEC+1 +CPOPJ1: AOS (P) + POPJ P, + + +REPEAT 0,[ + MOVE A,TYPVEC+1 ;GOBBLE DOWN TYPE VECTOR + MOVEI D,0 ;INITIALIZE TYPE COUNTER +TLOOK: CAMN B,1(A) ;CHECK THIS ONE + JRST CPOPJ1 + ADDI D,1 ;BUMP COUNTER + AOBJP A,.+2 ;COUTN DOWN ON VECTOR + AOBJN A,TLOOK + POPJ P, +CPOPJ1: AOS (P) + POPJ P, +] + +TYPDIF: ERRUUO EQUOTE STORAGE-TYPES-DIFFER + + +TMPLVI: ERRUUO EQUOTE DECL-VIOLATION + + +; FUNCTION TO ADD A NEW TYPE TO THE WORLD WITH GIVEN PRIMITIVE TYPE + +MFUNCTION NEWTYPE,SUBR + + ENTRY + + HLRZ 0,AB ; CHEC # OF ARGS + CAILE 0,-4 ; AT LEAST 2 + JRST TFA + CAIGE 0,-6 + JRST TMA ; NOT MORE THAN 3 + GETYP A,(AB) ; GET 1ST ARGS TYPE (SHOULD BE ATOM) + GETYP C,2(AB) ; SAME WITH SECOND + CAIN A,TATOM ; CHECK + CAIE C,TATOM + JRST NOTATOM + + MOVE B,3(AB) ; GET PRIM TYPE NAME + PUSHJ P,TYPLOO ; LOOK IT UP + HRRZ A,(A) ; GOBBLE SAT + ANDI A,SATMSK + HRLI A,TATOM ; MAKE NEW TYPE + PUSH P,A ; AND SAVE + MOVE B,1(AB) ; SEE IF PREV EXISTED + PUSHJ P,TYPFND + JRST NEWTOK ; DID NOT EXIST BEFORE + MOVEI B,2(A) ; FOR POSSIBLE TMPLAT BIT + HRRZ A,(A) ; GET SAT + HRRZ 0,(P) ; AND PROPOSED + ANDI A,SATMSK + ANDI 0,SATMSK + CAIN 0,(A) ; SKIP IF LOSER + JRST NEWTFN ; O.K. + + ERRUUO EQUOTE TYPE-ALREADY-EXISTS + +NEWTOK: POP P,A + MOVE B,1(AB) ; NEWTYPE NAME + PUSHJ P,INSNT ; MUNG IN NEW TYPE + +NEWTFN: CAML AB,[-5,,] ; SKIP IF TEMPLAT SUPPLIED + JRST NEWTF1 + MOVEI 0,TMPLBT ; GET THE BIT + IORM 0,-2(B) ; INTO WORD + MOVE A,(AB) ; GET TYPE NAME + MOVE B,1(AB) + MOVSI C,TATOM + MOVE D,IMQUOTE DECL + PUSH TP,4(AB) ; GET TEMLAT + PUSH TP,5(AB) + PUSHJ P,IPUT +NEWTF1: MOVE A,(AB) + MOVE B,1(AB) ; RETURN NAME + JRST FINIS + +; SET UP GROWTH FIELDS + +IGROWT: SKIPA A,[111100,,(C)] +IGROWB: MOVE A,[001100,,(C)] + HLRE B,C + SUB C,B ; POINT TO DOPE WORD + MOVE B,TYPIC ; INDICATED GROW BLOCK + DPB B,A + POPJ P, + +INSNT: PUSH TP,A + PUSH TP,B ; SAVE NAME OF NEWTYPE + MOVE C,TYPBOT+1 ; CHECK GROWTH NEED + CAMGE C,TYPVEC+1 + JRST ADDIT ; STILL ROOM +GAGN: PUSHJ P,IGROWB ; SETUP BOTTOM GROWTH + SKIPE C,EVATYP+1 + PUSHJ P,IGROWT ; SET UP TOP GROWTH + SKIPE C,APLTYP+1 + PUSHJ P,IGROWT + SKIPE C,PRNTYP+1 + PUSHJ P,IGROWT + MOVE C,[11.,,5] ; SET UP INDICATOR FOR AGC + PUSHJ P,AGC ; GROW THE WORLD + AOJL A,GAGN ; BAD AGC LOSSAGE + MOVE 0,[-101,,-100] + ADDM 0,TYPBOT+1 ; FIX UP POINTER + +ADDIT: MOVE C,TYPVEC+1 + SUB C,[2,,2] ; ALLOCATE ROOM + MOVEM C,TYPVEC+1 + HLRE B,C ; PREPARE TO BLT + SUBM C,B ; C POINTS DOPE WORD END + HRLI C,2(C) ; GET BLT AC READY + BLT C,-3(B) + POP TP,-1(B) ; CLOBBER IT IN + POP TP,-2(B) + HLRE C,TYPVEC+1 ; GET CODE + MOVNS C + ASH C,-1 + SUBI C,1 + MOVE D,-1(B) ; B HAS POINTER TO TYPE VECTOR DOPE WORDS + MOVEI 0,(D) + CAIG 0,HIBOT ; IS ATOM PURE? + JRST ADDNOI ; NO, SO NO HACKING REQUIRED + PUSH P,C + MOVE B,D + PUSHJ P,IMPURIF ; DO IMPURE OF ATOM + MOVE C,TYPVEC+1 + HLRE B,C + SUBM C,B ; RESTORE B + POP P,C + MOVE D,-1(B) ; RESTORE D +ADDNOI: HLRE A,D + SUBM D,A + TLO C,400000 + HRRM C,(A) ; INTO "GROWTH" FIELD + POPJ P, + + +; Interface to interpreter for setting up tables associated with +; template data structures. +; A/ <-name of type>- +; B/ <-length ins>- +; C/ <-uvector of garbage collector code or 0> +; D/ <-uvector of GETTERs>- +; E/ <-uvector of PUTTERs>- + +CTMPLT: SUBM M,(P) ; could possibly gc during this stuff + PUSH TP,$TATOM ; save name of type + PUSH TP,A + PUSH P,B ; save length instr + HLRE A,TD.LNT+1 ; check for template slots left? + HRRZ B,TD.LNT+1 + SUB B,A ; point to dope words + HLRZ B,1(B) ; get real length + ADDI A,-2(B) + JUMPG A,GOODRM ; jump if ok + + PUSH TP,$TUVEC ; save getters and putters + PUSH TP,C + PUSH TP,$TUVEC ; save getters and putters + PUSH TP,D + PUSH TP,$TUVEC + PUSH TP,E + MOVEI A,10-2(B) ; grow it 10 by copying remember d.w. length + PUSH P,A ; save new length + PUSHJ P,CAFRE1 ; get frozen uvector + ADD B,[10,,10] ; rest it down some + HRL C,TD.LNT+1 ; prepare to BLT in + MOVEM B,TD.LNT+1 ; and save as new length vector + HRRI C,(B) ; destination + ADD B,(P) ; final destination address + BLT C,-12(B) + MOVE A,(P) ; length for new getters + PUSHJ P,CAFRE1 + HRL C,TD.GET+1 ; get old for copy + MOVEM B,TD.GET+1 + PUSHJ P,DOBLTS ; go fixup new uvector + MOVE A,(P) ; finally putters + PUSHJ P,CAFRE1 + HRL C,TD.PUT+1 + MOVEM B,TD.PUT+1 + PUSHJ P,DOBLTS ; go fixup new uvector + MOVE A,(P) ; finally putters + PUSHJ P,CAFRE1 + HRL C,TD.AGC+1 + MOVEM B,TD.AGC+1 + PUSHJ P,DOBLTS ; go fixup new uvector + SUB P,[1,,1] ; flush stack craft + MOVE E,(TP) + MOVE D,-2(TP) + MOVE C,-4(TP) ;GET TD.AGC + SUB TP,[6,,6] + +GOODRM: MOVE B,TD.LNT+1 ; move down to fit new guy + SUB B,[1,,1] ; will always win due to prev checks + MOVEM B,TD.LNT+1 + HRLI B,1(B) + HLRE A,TD.LNT+1 + MOVNS A + ADDI A,-1(B) ; A/ final destination + BLT B,-1(A) + POP P,(A) ; new length ins munged in + HLRE A,TD.LNT+1 + MOVNS A ; A/ offset for other guys + PUSH P,A ; save it + ADD A,TD.GET+1 ; point for storing uvs of ins + MOVEM D,-1(A) + MOVE A,(P) + ADD A,TD.PUT+1 + MOVEM E,-1(A) ; store putter also + MOVE A,(P) + ADD A,TD.AGC+1 + MOVEM C,-1(A) ; store putter also + POP P,A ; compute primtype + ADDI A,NUMSAT + PUSH P,A + MOVE B,(TP) ; ready to mung type vector + SUB TP,[2,,2] + PUSHJ P,TYPFND ; CHECK TO SEE WHETHER TEMPLATE EXISTS + JRST NOTEM + POP P,C ; GET SAT + HRRM C,(A) + JRST MPOPJ +NOTEM: POP P,A ; RESTORE SAT + HRLI A,TATOM ; GET TYPE + PUSHJ P,INSNT ; INSERT INTO VECTOR + JRST MPOPJ + +; this routine copies GET and PUT vectors into new ones + +DOBLTS: HRRI C,(B) + ADD B,-1(P) + BLT C,-11(B) ; zap those guys in + MOVEI A,TUVEC ; mung in uniform type + PUTYP A,(B) + MOVEI C,-7(B) ; zero out remainder of uvector + HRLI C,-10(B) + SETZM -1(C) + BLT C,-1(B) + POPJ P, + + +; FUNCTIONS TO SET UP EVALUATION AND APPLICATION RULES FOR DATA TYPES + +MFUNCTION EVALTYPE,SUBR + + ENTRY + + PUSHJ P,CHKARG ; VERIFY WINNAGE IN ARGS + MOVEI A,EVATYP ; POINT TO TABLE + MOVEI E,EVTYPE ; POINT TO PURE VERSION + MOVEI 0,EVAL +TBLCAL: PUSHJ P,TBLSET ; SETUP TABLE ENTRY + JRST FINIS + +MFUNCTION APPLYTYPE,SUBR + + ENTRY + + PUSHJ P,CHKARG + MOVEI A,APLTYP ; POINT TO APPLY TABLE + MOVEI E,APTYPE ; PURE TABLE + MOVEI 0,APPLY + JRST TBLCAL + + +MFUNCTION PRINTTYPE,SUBR + + ENTRY + + PUSHJ P,CHKARG + MOVEI A,PRNTYP ; POINT TO APPLY TABLE + MOVEI E,PRTYPE ; PURE TABLE + MOVEI 0,PRINT + JRST TBLCAL + +; CHECK ARGS AND SETUP FOR TABLE HACKER + +CHKARG: JUMPGE AB,TFA + CAMGE AB,[-5,,] + JRST TMA + GETYP A,(AB) ; 1ST MUST BE TYPE NAME + CAIE A,TATOM + JRST WTYP1 + MOVE B,1(AB) ; GET ATOM + PUSHJ P,TYPLOO ; VERIFY THAT IT IS A TYPE + PUSH P,D ; SAVE TYPE NO. + MOVEI D,-1 ; INDICATE FUNNYNESS + CAML AB,[-3,,] ; SKIP IF 2 OR MORE + JRST TY1AR + HRRZ A,(A) ; GET SAT + ANDI A,SATMSK + PUSH P,A + GETYP A,2(AB) ; GET 2D TYPE + CAIE A,TATOM ; EITHER TYPE OR APPLICABLE + JRST TRYAPL ; TRY APPLICABLE + MOVE B,3(AB) ; VERIFY IT IS A TYPE + PUSHJ P,TYPLOO + HRRZ A,(A) ; GET SAT + ANDI A,SATMSK + POP P,C ; RESTORE SAVED SAT + CAIE A,(C) ; SKIP IF A WINNER + JRST TYPDIF ; REPORT ERROR +TY1AR: POP P,C ; GET SAVED TYPE + MOVEI B,0 ; TELL THAT WE ARE A TYPE + POPJ P, + +TRYAPL: PUSHJ P,APLQ ; IS THIS APPLICABLE + JRST NAPT + SUB P,[1,,1] + MOVE B,2(AB) ; RETURN SAME + MOVE D,3(AB) + POP P,C + POPJ P, + + +; HERE TO PUT ENTRY IN APPROPRIATE TABLE + +TBLSET: PUSH TP,B + PUSH TP,D ; SAVE VALUE + PUSH TP,$TFIX + PUSH TP,A + PUSH P,C ; SAVE TYPE BEING HACKED + PUSH P,E + SKIPE B,1(A) ; SKIP IF VECTOR DOESN'T EXIST YET + JRST TBL.OK + MOVE B,-2(TP) ; CHECK FOR RETURN IT HACK + SKIPN -3(TP) + CAIE B,-1 + JRST .+2 + JRST RETPM2 + HLRE A,TYPBOT+1 ; GET CURRENT TABLE LNTH + MOVNS A + ASH A,-1 + PUSH P,0 + PUSHJ P,IVECT ; GET VECTOR + POP P,0 + MOVE C,(TP) ; POINT TO RETURN POINT + MOVEM B,1(C) ; SAVE VECTOR + +TBL.OK: POP P,E + POP P,C ; RESTORE TYPE + SUB TP,[2,,2] + POP TP,D + POP TP,A + JUMPN A,TBLOK1 ; JUMP IF FUNCTION ETC. SUPPLIED + CAIN D,-1 + JRST TBLOK1 + CAILE D,NUMPRI ; SKIP IF ORIGINAL TYPE + MOVNI E,(D) ; CAUSE E TO ENDUP 0 + ADDI E,(D) ; POINT TO PURE SLOT +TBLOK1: ADDI C,(C) ; POINT TO VECTOR SLOT + ADDI C,(B) + CAIN D,-1 + JRST RETCUR + JUMPN A,OK.SET ; OK TO CLOBBER + ADDI B,(D) ; POINT TO TARGET TYPE'S SLOT + ADDI B,(D) ; POINT TO TARGET TYPE'S SLOT + SKIPN A,(B) ; SKIP IF WINNER + SKIPE 1(B) ; SKIP IF LOSER + SKIPA D,1(B) ; SETUP D + JRST CH.PTB ; CHECK PURE TABLE + +OK.SET: CAIN 0,(D) ; SKIP ON RESET + SETZB A,D + MOVEM A,(C) ; STORE + MOVEM D,1(C) +RETAR1: MOVE A,(AB) ; RET TYPE + MOVE B,1(AB) + JRST FINIS + +CH.PTB: MOVEI A,0 + MOVE D,[SETZ NAPT] + JUMPE E,OK.SET + MOVE D,(E) + JRST OK.SET + +RETPM2: SUB TP,[4,,4] + SUB P,[2,,2] + ASH C,1 + SOJA E,RETPM4 + +RETCUR: SKIPN A,(C) + SKIPE 1(C) + SKIPA B,1(C) + JRST RETPRM + + JUMPN A,CPOPJ +RETPM1: MOVEI A,0 + JUMPL B,RTFALS + CAMN B,1(E) + JRST .+3 + ADDI A,2 + AOJA E,.-3 + +RETPM3: ADD A,TYPVEC+1 + MOVE B,3(A) + MOVE A,2(A) + POPJ P, + +RETPRM: SUBI C,(B) ; UNDO BADNESS +RETPM4: CAIG C,NUMPRI*2 + SKIPG 1(E) + JRST RTFALS + + MOVEI A,-2(C) + JRST RETPM3 + +CALLTY: MOVE A,TYPVEC + MOVE B,TYPVEC+1 + POPJ P, + +MFUNCTION ALLTYPES,SUBR + + ENTRY 0 + + MOVE A,TYPVEC + MOVE B,TYPVEC+1 + JRST FINIS + +; + +;FUNCTION TO RETURN TYPE OF ELEMENTS IN A UVECTOR + +MFUNCTION UTYPE,SUBR + + ENTRY 1 + + GETYP A,(AB) ;GET U VECTOR + PUSHJ P,SAT + CAIE A,SNWORD + JRST WTYP1 + MOVE B,1(AB) ; GET UVECTOR + PUSHJ P,CUTYPE + JRST FINIS + +CUTYPE: HLRE A,B ;GET -LENGTH + HRRZS B + SUB B,A ;POINT TO TYPE WORD + GETYP A,(B) + JRST ITYPE ; GET NAME OF TYPE + +; FUNCTION TO CHANGE UNIFORM TYPE OF A VECTOR + +MFUNCTION CHUTYPE,SUBR + + ENTRY 2 + + GETYP A,2(AB) ;GET 2D TYPE + CAIE A,TATOM + JRST NOTATO + GETYP A,(AB) ; CALL WITH UVECTOR? + PUSHJ P,SAT + CAIE A,SNWORD + JRST WTYP1 + MOVE A,1(AB) ; GET UV POINTER + MOVE B,3(AB) ;GET ATOM + PUSHJ P,CCHUTY + MOVE A,(AB) ; RETURN UVECTOR + MOVE B,1(AB) + JRST FINIS + +CCHUTY: PUSH TP,$TUVEC + PUSH TP,A + PUSHJ P,TYPLOO ;LOOK IT UP + HRRZ B,(A) ;GET SAT + TRNE B,CHBIT + JRST CANTCH + ANDI B,SATMSK + SKIPGE MKTBS(B) + JRST CANTCH + HLRE C,(TP) ;-LENGTH + HRRZ E,(TP) + SUB E,C ;POINT TO TYPE + GETYP A,(E) ;GET TYPE + JUMPE A,WIN0 ;ALLOW TYPE "LOSE" TO CHANGE TO ANYTHING + PUSHJ P,SAT ;GET SAT + JUMPE A,TYPERR + CAIE A,(B) ;COMPARE + JRST TYPDIF +WIN0: ADDI D,.VECT. + HRLM D,(E) ;CLOBBER NEW ONE + POP TP,B + POP TP,A + POPJ P, + +CANTCH: PUSH TP,$TATOM + PUSH TP,EQUOTE CANT-CHTYPE-INTO + PUSH TP,2(AB) + PUSH TP,3(AB) + MOVEI A,2 + JRST CALER + +NOTATOM: + PUSH TP,$TATOM + PUSH TP,EQUOTE NON-ATOMIC-ARGUMENT + PUSH TP,(AB) + PUSH TP,1(AB) + MOVEI A,2 + JRST CALER + + + +; SUBROUTINE TO LEAVE MUDDLE CLOSING ALL CHANNELS ON THE WAY + +MFUNCTION QUIT,SUBR + + ENTRY 0 + + + PUSHJ P,CLOSAL ; DO THE CLOSES + PUSHJ P,%KILLM + JRST IFALSE ; JUST IN CASE + +CLOSAL: MOVEI B,CHNL0+2 ; POINT TO 1ST (NOT INCLUDING TTY I/O) + MOVE PVP,PVSTOR+1 + MOVE TVP,REALTV+1(PVP) + SUBI B,(TVP) + HRLS B + ADD B,TVP + PUSH TP,$TVEC + PUSH TP,B + PUSH P,[N.CHNS-1] ; MAX NO. OF CHANS + +CLOSA1: MOVE B,(TP) + ADD B,[2,,2] + MOVEM B,(TP) + HLLZS -2(B) + SKIPN C,-1(B) ; THIS ONE OPEN? + JRST CLOSA4 ; NO + CAME C,TTICHN+1 + CAMN C,TTOCHN+1 + JRST CLOSA4 + PUSH TP,-2(B) ; PUSH IT + PUSH TP,-1(B) + MCALL 1,FCLOSE ; CLOSE IT +CLOSA4: SOSLE (P) ; COUNT DOWN + JRST CLOSA1 + + + SUB TP,[2,,2] + SUB P,[1,,1] + +CLOSA3: SKIPN B,CHNL0+1 + POPJ P, + PUSH TP,(B) + HLLZS (TP) + PUSH TP,1(B) + HRRZ B,(B) + MOVEM B,CHNL0+1 + MCALL 1,FCLOSE + JRST CLOSA3 + + +IMPURE + +WHOAMI: 0 ; SYAYS WHETHER I AM REALLY A MUDDLE OR SOME HACK + + +;GARBAGE COLLECTORS PDLS + + +GCPDL: -GCPLNT,,GCPDL + + BLOCK GCPLNT + + +PURE + +MUDSTR: ASCII /MUDDLE / +STRNG: -1 + -1 + -1 + ASCIZ / IN OPERATION./ + +;MARKED PDLS FOR GC PROCESS + +VECTGO +; DUMMY FRAME FOR INITIALIZER CALLS + + TENTRY,,LISTEN + 0 + .-3 + 0 + 0 + -ITPLNT,,TPBAS-1 + 0 + +TPBAS: BLOCK ITPLNT+PDLBUF + GENERAL + ITPLNT+2+PDLBUF+7,,0 + + +VECRET + + +$TMATO: TATOM,,-1 + +END + \ No newline at end of file diff --git a//mappur.bin.34 b//mappur.bin.34 new file mode 100644 index 0000000000000000000000000000000000000000..754519931c05570f14e49e5869ab442912d7d4e8 GIT binary patch literal 21455 zcmd6Phf^EN^7U*ILL?zXPKyv&CW#CN+pL7hNr1pIU=SEEIADwuHemhh-#NWP!uR^U zdZAwZK2_cI?1Y}vVS0LcmaFQomHP4d&00(8&m$$jqO$JgT&Z+m+AVp?HZN@{nq}`h z+>%xH`oNJoO9=R?F5OqNq|Q4k4W6>go?|H)W##Ey$yYijRZ987w{A)MafyQO*+A~q zw{_~4^s~^tl~wEPKB`nnux7C6D@JQC1F?m2cFrPT6Ibol+_l z0!<}Hi|f+GF7qywIOw6PGVM$1ElR_xyk_NsrFrE$Jol`m6-9P8=TgL{`Ax4^bt`3jv*X$9T@NL|hd$=8)S`@TJb*|?Yje3jFxaQ#bu{5s z8iz%c^7>8N^rA~5oBd^@QL{s6$v8^2qKooHoTBXAvm^A3*{HJ}^c!157q-^mKa9nz zvb{n8j~7)h7ORP`+;3}sKVkUoMX-gEerfwqaytWy#=2`E6$=%i!OSByK~z&-uesv^ zzVxhLX(EW)PBg6ZmBY+GF(?!5fTO#BjXroahS>QjN}8^U(}N!3Yw#;aQGRODMU{Zi z?GU804rrz8VL)i>)NJAHcCX8?)LGY~Y*wVpVeJZ{^H-u&+ZV#KFO0{tGZ3*cRA-lt zbf>M<`%b(|KWPwE*qFopMbK#49>DGE1glTteM?V??-BKH+le}*j>ARS%N;bT%shIN za&(>J`hZs18fH7T(Ph{{!(axIdxFmW%8V&9DqSG_*p5uuF6hvbEFWy|QDrs~erupbM+FB7?Qz%91;*z4nM!@5Fi&!?l-a#fdRt)gjSqQY-=t#>oF-8;LmJi|&yohkK^lwXq+%p9g&RW_DY zoXc9lDqUD*Y0}vS@W2IqWy*`N%ex*Ye?(fOR?;o=X z0)HaF#moxo?%f_Ts(zc}-&c2~<#4V7zfgC}&wr-w*@g60GNH~YEjzI}hM?mxo#R^aWwRrdtcU5Vw1AJrZEH`GnI_(9zlKmNDso}jv? zsqTq?r0zgLB>&OsuB>;+%8p-t+J19B}cY&QJcgI-jJ@!-;z z2VL^TA-_+`BcQz3bp$SL4@NkCz#P=30P5@Eb zf;vF(bVKb|zYoE%SSs$e@f0-{4DJs$37i-vlp|(Q_T~U=Xm02iLQ&#B4to&cJpuby zO^K~-kKhwYLJ*qT;d^h@C(kkQeGMq5UJb{U`aX!qd;!%)MyanNwRPw3OoN81C%@<5 z52`U?T&@Dbn1ob)UeTtEj>ZejA+)b}nx&uc+O( zRWzH80PRiG2GM)Cnx8~#BAC{cemf5ODH9=W#D}`MFq(*pLAh2d{f2C%RoI|hJBUf# z&@^f*Bb(rZ4Rz$%Z6Jbx5U8C=E zA!n^YL`+s238T|*FZk_|1WNZJ);z9=O{KL!#G04=Iw;-tymZ?|x@>qP>lZQrN3>lL z_Qxknw-)6G59ug1)QQR2xhG1MiHM1yRe+O}*FiTgU65C7k}jMh^bTFc0%03(3g=f1 z2P4b@spVRuaa2++UBg{U8>VU#d>x>5%9KqG`ntZ83|3G0px@Q@{+%@Ojrh${(V*5Q z2d6=ZiSe%%XJ?H9>l9r^J=8g^v(EzpqZzcyYzE2i@Ibi(8H~A#XXhxr&pMQ%+abtE zgcH$0V4dzkR=3dOc(vYXW!%FVrJ?=wtiAb0d@(;xZ6*N?%K?VG4GM3fX*58$JXDJj z+Bkk?M{Uf;5la+tyiPfOG0b^)|A5)G^v~ldU3L*VYlCN?BCj@tq1n`cbnXMt7SZo; zSZOl{W`B;4)>8fbPvToq_JZ>Fk=0NJts|#UfEW^YoW32%uaB5#*E=z#@aw$4$J~c5 z&=Q_woRSERMC^R%J04qUaOPSjgpzU`JcNMj9eJ9yu{Jc&aD7f4WuWZ>i;AqpU$+zA zjzXOo3gx=gijr~c(RO5P!Ar@q64~!~Iq$O44%72WTf_QrL;=@=fFNI`=lfkNxu%H4 zOP#pVMQ*0Ge-VOUzdO6f#>D&`m^OlFV5zV{UiCgZ>m4D!H((465gePNkOQ`8n)f_P zB=Ad&#c%J0T6xwA3k^{a_LD(6D&4 zk;jv_^Em!r>zW>3P{w8kgP~AuZRp6aaW~LSTlecaf-LQ(>saZ!sJ1YrgzU{mNfnJz zetJ<;-R`TBLL~j49Tl1!Qv3a=@VY>>IdyBe*@aN(-L0HbY5#~riKQ$L=;UxA{m6~I zIl^I=0@2XZ$(}@kD2~^aP3$4DcRndm+3T>bFpQ_v4ON$flT{|3Dxy?jO7>OB>9xen z?}wFMc2`9U6W?qeRtz2xdY0JvHA=nt!wUNOB_DC~mB6LnpAf7Sfd40l6=05Wa#wl! zR5mMsSfyIxV>@sDof8W%ybyg3u(_EX)vdtGnX2(a?j3@X;{*tRwjY86dsY zLDhrwUH|r^c2Y2@|7_L9T%!5p9#_iqe|W%8Zf(r;F0aKBy|Xys;{||zUo)^!@IQLo z^!!8qfbT33IM+-pzh=-cw`Rs@f6U=k{t3&I0)zj_nz0KxJiV23IE2Cj{(G!x8&U7S zl*6k8T>Q9Pp8ao^ODmVlKFty8wl&wX4`3>C2vJOQGpC<3`7Z3Mimh5(7~&L5OtX%$ zC=3-Ax6Z_VSGYn>i+UMC5_gO4!VV#R5Xo=Wb&-l}xNCfsbt&e^BZ@6kIw1GBW#`9K zr>Yy*yLp6>ZBgrDh7(xCUtL}HCy-A$$qYNzPr7*&OgHFEb#WN02=a2ul*4azzOwu}gFA*`r^;I+-V`{w@cBR+Lp~mLLO*#SRSn$dY-7p`T zJjA&4@Vq~q_r+0!u(}z=Lx-8EZ^H?tPl{2)p7lWq2Qi2CgMM;S0%7v(o+c#9l~m5* z=|$%q@r|o6$Vm8hANlIzoMX@iFgomnXNVC&E)KtRuv z($&tQtsA&!(x-6srcVf|rda!TMmKt#g6NeT3g*9GM<}#0Wu`V>d_Acnz61=+36F7^ z3IRz!xdP*28g=ThQSt6cWW{4f%W$XCXR#Xf=Mp0N!wU$1fixzeb0656=VJjojy^&$ zt%iX9`DO;iJ}06(U2m1XGB9iBri4mxY&lZ;L3AGMw{>B*!EfWGjl`Ga<&{czp|c!T zY{d7>Oz2CboRZf*Sio|m6x*I%j!GK@^)?>y(!9mPPq*hn{SS^P*cQ<$Nu7K{t=x1G z+7`)gh%}--khuH?Sdu#K;zsRG^TIgs?W0}TmouWiC1;2>!cCJ83Je#AU@H%Nm%xwn zz~LM4`-kZB_~dNm0-p@ zpJ6dOL*W=DLq}*}$-Bl8%r1=cwHPprB1Bb&PhjLHH={^~#FeQ9`b91RP4ZkE_Lt5E zsd%xrj528zewjFWB>I&d(LIA<*EI(c6{DlXhhP!fvjN;P+?2ROI;8 z$x}xkmxj$0It;|mt8ODGUP^AhLq4=_W+10Dvw3oK_#04xGBfa zzKJ+**Ns;A+5nD%kirhG$>ETh?hT{kx|Enl$EI%dlj%;D_9Y{HU#Fe~aJ&xl^&DN) z8oy$=MS9V&`8vV-{p>Ctw-U$FPY%Hy8ZB(CZwoVGU$B&Yq0c;jMtr@+ zDpM>@^)I&%5yU0NV|OjkILX^zy7Y)NpdP*7<{bPg;)Z+-t+6zQDr`0=(Pb3bW)zw2 z=a4BL#;{8n>XEaBYk#!t0WLb@^6~EXEb)!$Dx)b`dBct}p7dcNf2{+`SZ~IdO9gKO zyU2Lmg2CJg!$#ep*bAm$DhI6;Vv2Q|9fs7_!}?)nFM{dp5G=dRhOEZyX!fQpzZ!)+ zwB|0(!TfAPqeZH0p7`R(jym)&Mo+$VSmu@2JsYllGy|fAS83%#Qp#GuMuruy#t0vC z@(=^Dy%C(8FgMem#wPXA<<0?pSb|hu0UIo!ZnU7Ifs2LOD&kvlxIUyGyN%f`xp_tB z6||DEQ8H~KH*)JRUo2g6YnARvQT@O0uRE3{qIZ)aEa@&P%rjw!>d>zft(_q#0BL{Y zC0@AR;3sS2=q$O&tuM9TR)|kpZFaT_T^K3U)h38^KljjN>E62$W09-|X)pNvrx+Wb zj)fz2Twu2do%Jp|)arh1)8;@uhix{7*vU=+gW&!Ct0BNp zMx6TnEcvkX{S{8F_?!^74EIYdrg7bgcJPVO&EdlMXU12?XJuyG+rtM}GtcHhk3>I- zW}+<|3*(w+-M58Ru#a`8)b4iY_$13LEsZBPC!Ve(mY>U~0)6hcA@_CoS|nGaRAO`K zVMie#z4Hy5AFlVNkAM%T?IP?@`N7%jnS0;S$YJsrmb)>$na1ySrM2OEpI?YisV&%5 zO!u3{i;S9eycm= z&8_ME6BWO$WM4JCxW>W(kQ2p={VO8BdS%CyEtCi1`rQkm(vQhKQkr9E%2GXLbt?u( z0&RJLtp>tKQ4T_Ci|p4%sc~~KJ7k39Za88vKVplW*V$!|oww{(Qk1i$2Q34qhMl+a&SwP=m=8!v4KLe$70 zKdm$S+Cusc&ctK&$UQ87c-&3^JnH%KI4(r>Vb;`g7GuknT7I6-p=taq1cQ#Dqn&U3|!Qvo* z7_@)gpU~6XE6iL!5SZzYBRr8hL4S;~UP@B!n60?NHm^az#(%py`W5Wz*V0MrIq@w> zs~ytQo^_H!>fW4_l`_ng!lCX%>fBd8vl&p92VRsd3o-YQ2CPeYEs*L%Kf{*ZU}5>5 zp1Hy*H`iAnTJ@#68rR>-WO|Mh-P8Ni9BJIxWit*QT@EnsW_}yN@j1A_bUodEa1&MY ze)CmDb=N~M)G-UJ0qG}^PVRBYLv+1Oayuw}2qb9u&I zT}#=sYg?-cyRnQT@S9h<^G`-h$5vBze8yf&&aBS3!wTd%UdbG>RBC1=nX*%BcIstv zrg`rQM;zdDXCVZe30-&E0s$Etk0o4;o6`K3R+(cZmdvrSytcWCblW}tzjXeG{e()P z^Rs8)TZf3R0hXI%K{$P}v5=a1h(-qDjy_BSf|`{c4%$kEhv(e~MkCmPw^C+-ys#zo zR@Sy>T+TO>vFRB*w((H<@@WYPsQD%?q3ri;HXNzL`>WN@&BW(k{G-C~|B3wU0#u2( z1&ED!dvJ}>aLCi5cT-C5ls;wz_gkzP2_(ndy~x~*db^5iC1QTF_dIB<6GtO z9nS{x)zO32VZ>HS;jz3B=P(3me=|oSn1z7?@x2*Be(X#c6o40mI1Q!el#*wZm;Bkr zz;YvY0Q}(oaX1Krhdw_ZL*D*|DD$>4(NCeFrDo-mF_b~)KIjvTxNmz#~io zmvh_YL-Y)@zk7y3dIq=7LEqmzLwm>Lho0g8(nSKe`W^T+furuvF72V;{XchUA9hDS z?E1EvFEil6DEDnOUOFh5eP!kTq8Lj0V(IS3<71Xymw6XEF4^y>d_3NN%es=%(&Wt- zl+gHCK(1~xW?URi$iW$`f5S+%dy6{vefO!6O`0;#o+YiAnRV2rOtZlSgIsPXDI2#Wy#5(3D&(Ad=-No z^ZZc2OqE2o$}M*B`VXEq<4f`k@!?DcSp`T>@2eObtK&_jxmmWI`98+F(vnB@&6KJB zsN~V;A!VxR+(htAOvy$S?fxH_4>mLhaQ|ZW4>$V%)6jr6t}kCS&;12tZ(<=ZURazB z%NI8>vY|St9Zc+3OW7ERUp!{(UOW|CwxzBLpXK$Uq%~RFnJW1TbH^B1e%ViY_4?i| zFU~z$Q+2uD8bFn<>&rGj8uX}`^|mR!z|xoC%l`5ew3>a!Zt6(#CB1=4U(c-I(+`Gg zz?DZ0Tgl+KBuy$j{hw0jq&%BPwQHUA7b7R)(dx`dMf4g7v{2&xUTU0_l`$}%l1%E6 z@pF1esHi{SGmT((FUR7`rmN+X4Cn1O9=9AEvu;v92<(JeivINaYkOUM1&+3#;}1PB z;vjJuIKo&=99Z%qr3WlK`a#F6@YWc7x$^WWTVEvh%1_`qkdX>rZB1rSGP=!J+hv+_ zJg&x{s!5(IQeufEgD>9=G~G?TW* z*7n|$@_@dYK0|Kbqb&v7YmUxHWtiH3O!VIB)7=Xm4vo7R%XywaNz2ZpJo7fpD4VV7 ziLIgv-_6Cd&P3gC3(5t2dZKeo>Zrc_ZevmK8NuG-E@IiT zQgsy>;+xi6+v_u|dlOjdK66l|-4yV}>tg!}Ig(i;^GVT1hY{I)D$;eJ^Ep^O0vu1z z_78{jUhCIYRW2&a4A$GMJFW_3s>!)J3dR&?Q^vKma&xsn86^73GSio?e)n}(F7Fe& zcONJhWl`cEP|$-9&^sj_LC_a;24x2{u3-o6LNbhj<5y2P?=!5KF>26=SR-cvlXYX( z$X;-qrFLt*IVykk)(v|}3cV5|w%R0IKB+NxZ1loKi)Sj34!ZIiSn!HWlkx28?%6Ox zI?zt(NzyZogN;}C*Q4fW&zRSvx(Zxc%VQsp*)N0EV{CLD)t~3BJos{=_z9`CR0R&c zKSD{R%*c9JWU8#^SN1tayrMlHvvq&weSiTWqQT&D?fiu+zjI&NTlCW^XNre*D}V`q zFRWn;ZSPPZl5~HmrZ<2zb&N}O>eoV>@ zM(~MWZ>LPx( z#o!#ALm%52*3B7Lqa8N+Ee#B2TEr6DtyGgmj#RoTefguwm0xSSDRSAj7Qcr?lD+X% z?RRE2@Ws>tzFou5_zo|%?8U{0n+UU}YnkWZk51uh-rXe9%mrpszO~TYmA>zoyIM zU86i*WeXe?&{scunudOnNY>Z;Udp=M*IUgiLH|f^g)<|9C}j09Luo8fgII4KHDC;+ z)`TOkr{~=Z@oRg*So`;0qFS}yzQ2^Q#`#dub)Db~G(<1xqqL&HlolRD$?)liOSyff zAPsBfN0qFFaoV4(l)B*K)@kyl4HLact%rNr6lYVOq_2##X))7xm02LZ8v{3sVmT+) za9@#Fc3C_T8M~zGyn$b?&@E~QkYU)Np{l@kBwqECz`WD2;)lxIjJ zS*I_Iy5Cmx7x<{^nQ~W30=~Fqft=6jBOUKWZ%0P@GGP+cvh}>-sm;=}JgP`x-kU@3 zr%$f@22QVJgbyC6wUi?~R_f8`FD$LkSn(zs1tcwtht9qD*H(pjxmE@Jpy5Auee9^U z)VPx2*jS)tv3>#ty`w6ye}@8g5^JPn+F@%GZ3D7`ZNzVxg~AVeUQlZsaF5ea^*xP(@iJaL(iW+-Q6|5b&Z7q5!LWbY5iy(A+Ts4MGFN`E z_A0b$*9p6QiWk4xUqC>79@S&M>+6(T+W7(>iTArdh{Yk&6YVD{8AIo*KO5X~I<2N~)@u^b%a> zu%cR(c{U995BXA4gOt5~*(zk!j1bGr?_T7Ia@2NCta?0EN-eium70WZ-A|juuJ;bPfL^Y4D0Hx zkwnhx6}Ysv_saZ~+MK07yQDR#7I^d@Z%}~r4?4C4%TsbB^Y-coPtL_NMBveP7C6Uy z#&EO^?Ie$W5_anDGwr>L7Sh{t{#b3u*qp;LI&NGa+YhVDd4b^NJ6A5Nc`nOM-v@WC zj*t)Gt+T*e;MY^xqqIg~ek>_!jl2~TOE8`q+v5uG;#;Q%P4rt_;Dh?G(P}QP4ZI7j zyYd@2K1dPYQ+l7blv;Ix%j#5l<1t5+TH7-(MJ^u#b5Bk!*3FS~v8&1HR@UHWRQ3D{ zvY^e=Cz77_DLB5tFRO47Vnj^Wn++mHe)*& zMh9fA&QLCZ>`@{Ynd2o;9XXi7bZ}Dgk}~#>wPd|uKGEmKcO7zR(@ULmY^ESJoMPG< z(Wqst73Ja^il+iI+;ufXg5@3}(2|s-NT@G+^LBP#@XapntzYvmppe^1Hp-5jw$f`A zUXFN%y{CgQrrC!0C9}YJZv!)%`x#RHYCMm)B6YdGXQQ= z_KH!n$hpec{d!AO+H!&4>XA=BKn33m1QtKeqoA}ydTQ~zBf;spA{%x3*XkGD9bCUg z30HCwCH0cp7wed`HYa+7-{*U6;~nn$HQO&8S%aE>xaj&=(XUYMz^Ukzx`bfrdfb?% z2N8uSR931Q-ws@IwjV%xvP>CtP4D;4*mCEkzd65(aO^tyc*oXg0K5G6%Cf^bBmcpV);S63756hn;`HQb=H_zXNo%s=wT<(hj%L-&JnaWn&fPt z-6R4HO+BLDnc;6mKhcP|WPAF7ox1$O#*;S3mKV5$t$h?*D>EMJw_Tj0gt09-Qg;O` z)k{tCZM1O%q{Bk5N7 zw_2MSm!s<7)nYr34#s9+5y?>ev?C%F>7JSG$4`h)S^C^e&L`6EQq$Tg(LZL%2jAqz zqW<9C^tPM>YOv=SqM1|JeXYo^3Fj@hU$S(u&THh>$5Gil@$KfhY=+KbLb-=gBhto-nbrkms*-f_?KZ~};jc8MaAef#mpDqfaA65!1Y=QK| z!Zen`h(;cPNq+UXB|0lk=}Ts=eZmJ z_QpApeZ78Kdy3gS+68hMt>70sHZYIiUvLDeojWW^As{!JTrGX`zy?VMx3TdTEUmeh0oY}k#tz9ClmmcexD6z8`uBGa?#jj4rW zRGB{gtld4+br$%ASE&)r3{M}e4RR>t=e^q!%1M2_ensMl1M_ZVxL)wVTeNWnsIkDw z_}n@Qrg(G|fO&STu~g!#8=N|Z1p)I1!$Pkq&s(U#o1V?Aiyt>}TFjl9{=nswez;%# zn4C8-3P;R0GdyE9rn*d_1z zZDi>e$A)@?kFnY5eWd#%w{UTe>;XA(wQm;PO=X$s@u1i|G_7+)^QCYvJtH$95 zBfeVO+qrW^u*0`y6TwS!>$4ljE?Og*`_t2Js6^8RRBgt3`Sm1z?)qoSRQRZ2NzP?$$fk@P zh_1%dTDAAX`gDe$onedaB9*Kfoe6F)x7T&@FZ=1`*ZGhHG~j2U`*Wv$bCHnm8~ znhieicfdeZpXbQ7wm$8OwL8epY)3G{_?%c*owBxmRYexMGpN%qt<^?)YLCk1Ich;p z|B=KX0i51*r^TLd@46fRSwokzVoiO_Co*C*?CCL{tMN0*Q3-il3|<{f7NN@MXQsD@ zbCe|B_u200$%v$LK9-opCLds?Z=&t0Df4P#U*zYtKDKkEc+|D=Xfl`Ov`)2G#jN}C zGI;$tcmI)I?U%^oERU}fakgt46$O0O+O1nxttTGIIR!T+$nXi4kCd|w^je4cuB=!1 zT}ZrYY6fpyzspVCz`~r?J^ETpA2^nN&F}|D88qsXyd4pI&PV(6CH@xya4a6rZAi`^ z$XFj3Hu|ZZc<@D+g8`qEK9?91er@_3#zSgkuF-c3Ygdk%d3$j%g_5bNdZy=5z+cZ} zPs!y85p8y4Xzguzj;iu}v?r#zN*oT+Azk-`Q9|2ziYnuC=Jd0W*yKrpBYGNIj#jEK^<4<&a^z5W$BOUy1B>7LIhpo7uz17ZOKB&J7};ui zryq^#!>p`8Z1!o3t+g28b6C2oX$s!3q2(lX+z zfF*dfa3@wbgxxfQR_vzLsgQeu?4tIm4{e?{*+njk^9X9Jq?x-j+_ks)L`c1 z+UrR6gPQ)p5v}o5+x2U-DhDUhu?l>%1qZX=S=S)=7;*D^Ge+D$`z6v}rRQRfM>~zD zdd05Xm6F5qv&D_Vy9=nS(hE25*cw>;6z62x^-S^b7<`ikT)^^Puo&sJoOSYc=?6P@ z@b*U5AoG7G67zSbheE4Wu6`>l3uKm()2Gti_1Fo2Yz&#jm5Jto?$GA23g&o(8X8#Y8iMmQ$M$xlHl4 zPqeV-TUsA45q#G0QZ7E7uA6gZg&YMAi=1s0JFI(KP)i*#sxpf6(rB3uUezdkOPtM; zbJ&_kJuXNC=jj~hv|>s~#q+n8-}9WC`bn$1jzX{qS2JC&x=&8Wlns)l;~P7OxXnjj jKR>Fw`>fKalPg{MKh%ADyIpy$GBor2FWZW{S^51xgJiOy literal 0 HcmV?d00001 diff --git a//mappur.bin.37 b//mappur.bin.37 new file mode 100644 index 0000000000000000000000000000000000000000..126d514cfd2e11605643a1bba90bc0f9f34bd443 GIT binary patch literal 21600 zcmd6P_g5Q1vUN`qLL?zXPJ<92lYQ$Nnn9xz#uSSaKIQRY{2^0zk6$hguUK9 zZ}*)&@6!+Co(|QwLRVK;4_5WpO8xl!X1%5K=aG_MQCZJQu2ecS%xH`oNJoO9=R?F5OqNq|Q4g4W6>g-eV~lW##Ey$yYirRZ987w{A)MafyO&dMNkm z+d6ei`dR2_yI0kt*`4E}G1pMK^|9A2mc8E?OQUG2lCHtn04s;f$~S9Rr|h!JPAQcN zfu@q9r48v~mw6XU9Q4ptnf4|17Nw{vuUWldX+il8&%G+kU$b|~4;kU-@KM{kuT*~v zN@KQCMUma-^C{xf{2onHJxUqZc08NC>!k$v(3>VUt5(JxzP2c%4-df7(WSZE9~kb} z@j909f`HO=odmjV(~B;NZ1$IpM$HbPGUF)KidN-|I7QjJ=_94QF&lNZgMKoHfmSuX zga`Z8G#sAq1vdgOc29|~RDo#NW~=QL%6Je^z+M8EDCt+W4<)x1s5I976jHHJQ8w!Z zYTY*Tz)g_a@c?Oh4$ws|wVkNj;46ojf3OOg5FMW~+YT7Kd(!uK<%sy|0%7Hdghn~` z3A$*MhMICwC7=U46j91$i&QqkfY8>d*}~B+48U*ib^Db%>+Z^CMdBpTUWrF-e+bY1 zFdoxqpk!mHknc!$+Dg6e#Jh$@C7q?!RZle7Fh+bGXwxA9{1ZW6)Aj&;f2Sy_PO0N? zQTB2NZz{8ZX3jgX!H)fatZb0hbyEe*V;lXV4qAsZnDH@23=T*a$o?+9P^YvsbQB?h zahn8K>a%?^JBsOIl=5?ozWO?TUaji=YMA!vFU%$r{W%9L`Ys&<0hwqLuRld^1GGtD zf1n1X-d}iB_`lrTC^ezfmsZPYQC>iEP_J5Q)&?e7P;H0x$%LA)LGZlzrrBX##aJZC ze*rqu7d?_zqjk&w$zffgwfECeYq_dRvsTe6F;U^Sw%+$Vw%s?kxH8L1N1ZA4k(6JP z6igp0qN;2>t0o4ON%EJ=>?f_#ugdKQV^|)py^9cr^!pnOUxByg%g%-{DXCCV>|{qx zKsDB7PtqYm7k$}fK&)G-z~HC-DphAI1p~lOpHPnli@Y7rZeDD2UJWj&A?&cSz<#K$ zvU;a5Zw@ZH^rizJ%S3ABl=C0M+J2s^*}^cW;t=Y@52|RHR&@X(BV?>J3~kgWF~YBO z$in?S{`mc4HbLNz1-RH+LEU}ZBSzJ4bNu`2uCyG^Rp1xuZu$AI)IGPD-b&^a{+qfh zEm8Mv%hSyHy}B#Sdv#Y@_v&UpSKYVo@74WR7~cxK{cqJh33XRujp9dj$Nmj<6E1#G z_r;I@uDU0w?is3k@}H?YP!P#~w7M(n9WwK~x=&SIhPA5L{>Rn5xxT*I7u$|4uEgT9 z#(&p&z3ALI-hB2duk*UR&g=6!N57oT2l6`q80)?YeXHa3x59Ko>SK4vg%i5Yfucxu^LB04wCFkXdx&DD2vn)qgwnQ=@Tt+Mr& z^w=mdaHzq<$Vgx#tp!wtDR&q~0UQFGhm)&GcXA(QbK??n&amwEKG;$7B>&FV(>agX zxc~Lj)VhOy5;&}eYS%U5+whyJST^Alw|6aqhnbEjm9iP^^k8GwBp?{;M$7M#^c{B> zIT-EaLZRPV%e&)Bo$h)uY$t==V*q=MzOjT?FobB-QR+xae!fcQ1BP4CIc#*(Pg)Wk z#J8uD{5ZPEu5{4fi3QQW(3;KCt?z^~Xpp*HAL{xSWRCk*A+Lu(VV{&oL3ywHh`f0) zta+{Y$e}7kA4(+TIHa0^*cqSRpjE$;xHHXYjxvo3m;IT{+jqow7Q+Bn3oKN+YSd9= zD0zbzZc!Z|mb#&FRlg6xo3d0ab|7kW0(ciSGA#R>5mpPSh*^}qIRG1)8yJRAl;{w{ zU7`^7A44uzO^K~-&%GoywL_56xKiK62!~O60Btj))K`(8LH%qv zzpX#HMuKao8D4&72RTmZ<2`v|8yx`%ojc z(kg6_uN}rr>dWQh{xtE`;oPHTB%&R#;qVfCuwR|j5l}$r$?F?PO>2y#GL(weEW&Zj zV!tg4?SUqmL)~bCu(bw}GZ}0omd?=x9{1AKJg#(2rL_bIX!zKxdD*XnB5p6b82Nfg zd|};maIUzQc)LiP{kk9xFi4{ov5$0u3LAO{s4bBxCvQcS?uP6f>vbGF=$5=T=cTLX zFrCL796Qh(rzjAGz;X>bO9OGVP#WFQZly(g`p4eQ5#Mki4EIab&a!og7E4c~H3_RC z7nZ6geN-|qx5+7M7-EusakvNnAiHRkTBj&4uVlN5luZO2?55q#`;V8}uOJ0EGNTr{Ycnh@3g{+3|*wvF2!J*su2SHK-&@xD{bz;9OThbM1n4%3|>c1A$A=HV^f694XA$y zLhL8-`HfCYDO@`5LEb&Dq6-d=AkW!ei`W(36ifP!$5tA=ymol860z%vZyRm!2WU`^ zgNM*_y(rJb(7o%b>L?9umrf=W!h?RORx}OK1Z*6XwB3AX*FjOlx`=(p%XwFnc9dRF zT9VLy$ZRa_i~Xe+23__1poll_%AX%p65ny1a$IIkU5O*>(>k~W;c)CPyVr(yH1RkF zz6u)?spAOF*aHv*HfxAe)HAYxSB}Vvh+T6GAx$9mLT2i^y|Bdo1zK?!8)PB7ApQlY z)HDfv7S5MTy<3yS_eq5@cz_}qV2Ogbd<+BrCOL&r1~M23W1<1hCdmdNU~``q31OvH zsew84lh~pkf>1kNNaHY&m*?E(4YPDn^JEp=jCA`&bfZS;8t9idAtITG?~VI*eCDQw-cb-!-d zaUkeER=OdoElepvezQ?hMPt;x?|*!m|5OOO|Fd&NlLK0RoGV@zh&HEg4L21L3cb6P zBP~+{h!O~+EQdv@lf%Vymm8>agu^a{!%FDMRBxg{6ld|uCiaj(J)gm->~mOG7{(** zrm9Oqf6ByDMU*N`$-XK%v!0m!{bbX}?y6{U@|(?*jlt7I?=m~TMyW4jGUYF6!&%S$MuRRy4bx}qZOCLR|P`KZ_h!_j+1+6vTB8Z zZKHXN4N@Wujm}q>$qz6G81rh1-b~*>prqR1X~J{`eZs=1qx8mnu34iXG|5;CGw1?z z7^QmQ=QTcrkH+Y9NAfGuMY`>v>Orn=aC=HSE|}DRwrXQ8(R?P5E9L1w%?2d5HfQ@* z)?(?7r@1j%Vqk%yIgE8msd1LsN2?D%RYdq$ZOma{2-3{tm`Hf*;v;3D(h0r zk%tvqrgT8AyJhFcvvyUtp!cdl#7DBRbTib5b}GGJ!ZJjq?i@{pOy%3f?&gz%F8?EA zt=S^7-`#qB_rJG`AouAL6hPI;=-2QCpO!wFV29b;;J z02Zb7ANx=DqR|qF3D-z{8NkJgg4Jl~DS$*f`8v zk4j+3z?yen`ZPLV8Nlzj=>!RSPc~nNcpIcoDsC8(0g`A=0%3%H`Xncc+Mqlpa1UU` zIRY7!gvtg3>wqe*%-CLB3t=PBpMZd#kEwOFvt;WgE~@kxZtV0YLaHg&{++>&o}e@a zFu(dE-_({&^&R#Q-z=zkP3GLxI9II@kTjJmHLk5Orw;LM0uK>bKk8bz-WISpbw@WB z{b30a335gv>3*=a#K$r=Abp%-N``>md7eSB--+n)?zc)`ADXlAuJDt2M~{?#NW9v@ zN^-1)_%?CJ>Q`;um^|H$&i#-x90DGsyh_U3^4bqGSc||Xn07fTZ75oALzF7NaGDo_ z^PxfaI3h4eyidNNR<6Ye?FGrF1eH)2=mpLpKBTT@`qxx1@g2}hg}Fr=U|%tP zqQ8(MMH}I!37i7M%_G>#1AoPSr}7G*=mPXxe?$LIfzOA*%pX~+0k}R*E(s@+a~scy z?*q;xx}O}qAxFo8{tsq;NB>5;h^Fa$JAqDDHpHh(lA{*y+K{8vGwBx&BZfx4MAdN# z@yb;HEDdrP&mGCpfWx{xvMgn@2RFm#3&i&mZC>?(XU1bbW7*M`p^7Y@@#cs_!h4Qn{!mh`(#k{Vzu6>t|tyj%vw zV1$i_kgp9X)%EsS&la<~hDSGx18O9G?UE`RIm(rM>m0^p!vyCj0Rp2KL6%V}F!Gao z5OxMS2apzti(CYnWV|@+kIojU_^`H&3TYKUoJTRE)Fm6FNGNhp7ab(ND!-!C5RjU@ z{dYrCx!V>mB{nXZ#WpbQ+Kc!hIgNGlBm%<9?C1KhnS+e*jiFAt*8>cb1xwe9 z9V}Jg>($ML1wVYJ=vURZg&+@Jc-+y!e?-ZY1neJI9}$;c9K)D(w%z4IO_0GqI`_JY zx6#6HFmA}!=sHW|sB(V}U%3#AY;z!ccY3uK{z!adRl0)Dc?#L%VT`#GK|ObDU!)H4!#jC3Y z+~}Z-J2`Y@3Ecea*k4pOZnxy-h46CZxg^#27+JNEQn_`QYnFaC`e>48bu}$xf1x+g zD=_GmB*4{W-o-E1Pg;rZg;EX#i&Zdbhp<;jq|h0H=y0K6>@wo6tBnJTBs1Ay73vsF zaEzvE6NI~;duXz{1HAwFH?x_i(83Y0za`dPFRp=oEJHr<+uiP*n8IUuBKdss z$!g_ES({CK?ssd6m8bIALcjZ+igZC8zFf)GD3y4=jB&qrlsfqLOT~ru{sf*JfJ|V+Awk+whn8F>3*{`dz#KJ1E1+d(hhebalcvKqxnrg@^xlW z_bDFY*f+ znureyl!xN_-3w_Q#N-|+%`>)TsgYv36{&GVyATc7z(=Vihao10oM!tA@8=!f%9x>m ziUn*+&1OTF5RlXm2}JV}PjhUFU83w97Qw=YY0(&#lV7A!dkmqur4UN=aOe4km|Hpm zlu0gnd8NmVJAmiD)}l3TgBdMd60o@cntk#~*$!l?kza!d2HQgV4vyS)SeS7%Fz6^f z3wwepg|T{D*zl@uvrZW#WjKHrmf09&@k+z=33@4!-(Puw75LpJzk9;3pZLi1n9DTv z>zv=NiGC*?zX|unZzajh45!R71NLL|b-6DFkFiF67fFIF@MoyA5DvSG?noV~wQFmuB|Z+0*a zo`ikT?=eVuDM__sw&LpCyaqiTU5<4Ven~lS6Y+anvqO5?vq1vL{hN!jT%ueqHetv^ z>fBd(qF!Y)Aewt%`9)tDm7j@k6K%TbE=jiw7bjO}fpS0k7&aaxZ?4^wH`i^cWWyii zbM%Ci%zIBXtx(E1cyv3!yqn=*{{9$I+B|+~sye@U;I`6VWZ!(e>B4Ew%v4kdeg2AS zkM{krZ0jRZAa<_KVedlX+`esZt0<&4S~)`K*++-Jic}J|k;NYTOD%X2ij!zE^!n?^ z2P5*CMLYIv;MYHl0KH`B(=YG;WJKM9Qn#%|hu79})1wlBQNm9_q*TgJccp~yf%k$^ z+BJ@oWALurSqQ;qZrGi+KtRUEV+j}I zb7}sgRpwZYC39@7tUrH_eBC|%KRW-@enO?td3ySL>j?2Rz(AD}7{cj`&BfI0Lo_lF z7ysd)=ow}a4%$kEqp&qTFq#eo9>gq=FVI_E-=1|jf1ZrZ%-XTdhtij?RAhz)+)`-> z>ay8zqz*N&);>2AUzclL@D72$k)KVg97jZ<{2nGr<6RS{6HYv7+7h9x5p2z9$Bz3cUwT3SSHAFV>;Jh+`>;FqVb{0Se3=0khTpfC3NE3YWu{DqZuoSq)OOo z1WR9TzKC)}q70ug87!^5r&dd7SA1esn!IxH)%tO;MwgzFuBKZ$ z2fefOYI}pjjLWjhvnLUhwEoh>NpC6ZnmNZl`>p%7>fds#ab1?W9es?F+O8O$xg2KQ zNm=Tw7vHhqqj++3hLY|pOHTbvux%K3Fk4UdKyMbGvLi^L?CkWhGtp&6KGgDd`$Jq)auPn~3()Q?gk`yZU?|3Lu z**AzZ`9};7ep!6soK>+)q)tZXt}dB&2(_^p)?{sGsuoCP#~509ImlAIzIV$zc#qapUGBGrP^BCCip?((Jt}6s zZAve)^dM!^#BiPf&vG^+LYUL!u zd3%gUEeFS}o6-*gJ7JavetP}2y)M22N83;F2PPPCkhlySVJs#NEPKlkx8Uz-3y)zjqI%DJWZgaWoJ{K1si6R%~tis)=-6S?&4WzvM$G9M^(F{BK^Z3d=zY?!q9o3iLZ6*Yt5$r4OCYCKLRacQAz8Sr>y*|UbH-Y7zGY3`L zZ2@1rF1DYLvz0ZvkQ9A%7?I~sM7j=iJ`bx$faB@i{^5|`YyG;a%0*?F!Fro@$5nw$ zH91#D!I^jAz$&&!PzFlo3hkNm4P5gUwg?*Q4fX&zRSv zx(i%dE8`!J*)N0EV{CLDHJInEBKUH$_%W&3Re^)=T_~xP8QBPnOqKQY%0B0aSG4D2 zw(ifq4=^A^G#Ff|U3llp@7!1R7X7r!+2WC1+)N?#t6A&Vfa}3EC6KlVzm}C;-?}B1 zO{2#dMOf%jbw-{ytc6N&iP6^MH%UQIXPxy|KO*G@Bly@a@>|sp-`9w&rc7tE%}*+y z3%u#8=?P-iB0l7uz6n11p(XbF4o_2?VF~)E4-37KYFwhf#I*VgJUp2+V4zY;NzkueX|4g1$>{g)<|90m$lOhSFH12C?2eYRDK$tqVt9Pw%@I;@9?qvG(tMM3uDO zzQ2^Q#`#Fmbx`mH8U`-tqqL&HGc7!fl2NK3F6Z`{f;6nvA62pzCTM@MQtE<_T4%_c z7A1O-S}*sqXPiy*BzAMJQAdOI@GmkE=oR;;HDPi&T^^Qa<)d2bHApDtbb4V_-e2p>FBYbi%~tW?+M zFDz}$TJa_u1tchoNAO4KO4+I~FW0I_ZP@T1yFPZzT5ep;aBM8lvQ$5bg5Fsb*uO&o zJBc+~GUKqdiM9b*;fvq+EwfPgVb2Tdj+A=p?e;6dXHAYiM`p~UebHNzO;F__O$ys!lz%wgCF97#iKsLa~%=0S+st*k7Oa^KU#YgTD9wh-TsWX#Mxg!Kztt6 zYrgC6lq2}O@r5?2d8^AyUU7u}##*a%_sg)}S{;`W zU%Aek(W({0o83!eeBM^nR!uxLe96;ZN|3=#*8_Wu+&x z!ci4D_i;pZB9Zzg5t+6!Hyca|zM64g(-J5fH?t|<)Hq5ArJ+^s8pf-+nzsugjXQEF zNF(~-cNbMKc=2d!5Be71rZ!*E<$BRi4+M=Jgw3YZrD&ANy%(a-Lyby)~N1dA$Oc*7jbRpHiE*^yy1l zlWKuS|M3O|NdKT?ORzj4M>21pe(?BQJVOK?eP@w#yk`tY+t5z(=%-+(?mpArw`8^9 zmI(T_)*3Q4=WvXU8`sAU!s>EfAb9!Cl}j?uWx475;I7qC@*%u+7I+K%dLnz2)(Fgx zBonQXw_;)m##7^aTmfFCFE?nS-{Jxv)Q62$b9H^_U1-IX-_Y?viuj(;`@E&psta6J zr^*|TIilR!o_#5D`4E_Yd}^_7k(`TNP0h5j20x>!_g9bwZIM2a^t4aGiB0#btj9*g zbiLUyV)Qqng{1Ln#XHM>w*?6W;>&fNuKY%i+Qnikjf$}$S*x>@3m|)x$VKLO2~DsCVbt3cIp^M}?K5f?Iae9GUvG&@TPg5cJ^JYf zs3;>7So*ktg3^xYsp;#~XmDn}$VQ$1z4}E@2iLDr#+95zNxh`@#X6>}=aap{@6)}u ziH>Joyf>vdzAUhK)HP+6^Nd^?0C2HymvCo9C# zJ+t38Ys=M^{^tBD!m%6V;~iTE0@&?0P^JGQdXd^VqZV3(c8(LIS11pE-Kd&g6MXt` z>9Y)}R9f4sZsgXfC!8~p=^W;046}8UQ8P7Y`ttlvQkQe2d}sJKy`sTVeSRskL@Yn3 zH{r6DdJ_a5qs|%^>r8Pc0X^&_dUUta;T%D0vq{bd+D#(R(9|vXW~1MVexebcW_#v= zox1$O#*;S3mKV5$t$h?*D>EMHx80nhgt09-Qg;O`)yqxtnYD2Tq*0;Q@&I3JdxMu_ z&kzZ^C$tG`^vIORC_GSfa(V9B-)PBff(TyX|z&wh7!4af(?yw}08+@1t{`8)srsk)MMO7j{)*+_xsCM!uR=hp4f71rujA5I4 zJLlN%)>>_tCG}K4i@Gt_H^eI6GMG-C;{5hSWO`P;`E2nRRc5Jv*6yC^It%>5tJH{Q zqBBS9!yF3vdGEG_a#G)@UzIrGz`Prcy60bbi#DzRH6A#bnBPFb?8z zx7RjjTbSK`_No;9kU_iX+~FmlsWF15rp+Sm&S>>$U-SGnvh<5%Lw&)>=Y3bdec6w) z0*Z)!iLK|1sRgN5pYL})Tp8CTtzCPIEXkOxU({9OaDx$Ft?ljHxgyx%+p>vZ&)oX# z#<5G*Xy*R(^cyPCbOBYHF?8-bqdz!IJ^3-YDfq0UwI^7fAkR?hpb_5}uP1Be{MKwu zZMbL2S~JmfDSB%y@PU)a)d)u5k2Ldq(AKCoWzrLJ2h-j#-|1s%5v#ifGQj07PRB0# zdgJ?kk(?Xf=m(vqLws+3J&vEd`!8iGeAKWc=dw0rQ^pTOTh$xswmKphMbz9Xesag! zUUyHfPl*)%%A?-G!-X&wUpiT9)vm0@;gO0vIacBHp37SpJ+r5R!1|pJKhd8Q_*fj6 z_LjQ(jhN%&$LE;KbwJG=O>};yON5CrLr<@)bz0NUmPlE%!3X}D7^v#=9NE^^r(Lmj z2ickJ2u2uR6C3!@UCx75k;R@2>hvpXt&yJEqq2F9Y~=L2BnAoK^qxB{_J;d599O?1 zmvdrG{mdsaVl+ZC<2+a6XOg25^0pMbI+!X#m4V3jxUQFTlqBBcyImrrM|eP|1`$!>C4oJUY&CC%J@O7)A1cI0I6X9}|?*ItJfdrM7!;E2|Es_ptUT9tzn z>39V`&4Pp3@2sm9e2loaQNxJ)=b%LTYxG>q@o1;WM`!QP_9fxnyfD2gO3l<~2p0iHgF8yG~4&L6#8f@k%L1O-%^hjvU@9MW= zEGl}-Q2QKUytB4Xa(*1~i{u_O!|bTucm0qxwUx_MT2no4bW?*Evpzvvdr6&B!CH*y zdx**xSo%6f%32mSe!x79dJ?>P6%)-wEvGgia(TwvKGDLSZ+T/mappur.mid.146 b//mappur.mid.146 new file mode 100644 index 0000000..3d0015e --- /dev/null +++ b//mappur.mid.146 @@ -0,0 +1,1928 @@ + +TITLE MAPURE-PAGE LOADER + +RELOCATABLE + +MAPCH==0 ; channel for MAPing +XJRST==JRST 5, + +.GLOBAL PURVEC,PURTOP,PURBOT,P.TOP,GCSTOP,FRETOP,MUDSTR,STRTO6,PLOAD,AGC,GCDOWN +.GLOBAL SQUTOA,IGVAL,IBLOCK,PURCLN,MOVPUR,GETPAG,GCFLG,NOSHUF,DIR,NDIRS,SQUPNT +.GLOBAL PLODR,SQUKIL,GETBUF,KILBUF,INPLOD,SQKIL,PVSTOR,TVSTOR,DSTOREM,SLEEPR +.GLOBAL OPSYS,SJFNS,MULTSG,PURBTB,SFIX,NSEGS +.GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10 +.GLOBAL C%M20,C%M30,C%M40,C%M60 + +.INSRT MUDDLE > +SPCFXU==1 +SYSQ + +IFE ITS,[ +IF1, .INSRT STENEX > +] + +F==PVP +G==TVP +H==SP +RDTP==1000,,200000 +FME==1000,,-1 + + +IFN ITS,[ +PGMSK==1777 +PGSHFT==10. +] + +IFE ITS,[ +FLUSHP==0 +PGMSK==777 +PGSHFT==9. +] + +LNTBYT==340700 +ELN==4 ; LENGTH OF SLOT +FB.NAM==0 ; NAME SLOT IN TABLE +FB.PTR==1 ; Pointer to core pages +FB.AGE==2 ; age,,chain +FB.PGS==3 ; PTR AND LENGTH OF PAGE IN FILE +FB.AMK==37777777 ; extended address mask +FB.CNT==<-1># ; page count mask +EOC==400000 ; END OF PURVEC CHAIN + +IFE ITS,[ +.FHSLF==400000 ; THIS FORK +%GJSHT==000001 ; SHORT FORM GTJFN +%GJOLD==100000 + ;PMAP BITS +PM%CNT==400000 ; PMAP WITH REPEAT COUNT +PM%RD==100000 ; PMAP WITH READ ACCESS +PM%EX==20000 ; PMAP WITH EXECUTE ACCESS (NO-OP ON 20X) +PM%CPY==400 ; PMAP WITH COPY-ON-WRITE ACCESS +PM%WR==40000 ; PMAP WITH WRITE ACCESS + + ;OPENF BITS +OF%RD==200000 ; OPEN IN READ MODE +OF%WR==100000 ; OPEN IN WRITE MODE +OF%EX==040000 ; OPEN IN EXECUTE MODE (TENEX CARES) +OF%THW==02000 ; OPEN IN THAWED MODE +OF%DUD==00020 ; DON'T UPDATE THAWED PAGES +] +; THIS ROUTINE TAKES A SLOT OFFSET IN REGISTER A AND MAPS IN THE ASSOCIATED +; FILE. IT CLOBBERS ALL ACs AND SKIP RETURNS IF IT WINS. + +OFF==-5 ; OFFSET INTO PURVEC OF SLOT +NAM==-4 ; SIXBIT NAME OF THING BEING LOADED +LASTC==-3 ; LAST CHARACTER OF THE NAME +DIR==-2 ; SAVED POINTER TO DIRECTORY +SPAG==-1 ; FIRST PAGE IN FILE +PGNO==0 ; FIRST PAGE IN CORE +VER==-6 ; VERSION NUMBER OF MUDDLE TO USE IN OPENING FILES +FLEN==-7 ; LENGTH OF THE FILE +TEMP==-10 ; GENERAL TEMPORARY SLOT +WRT==-11 ; INDICATION IF OPEN IS FOR WRITING OR READING +CADDR==-12 ; ADDRESS OF CORE IMAGE LOCATION OF FILE +NSLOTS==13 + +; IT FIRST LOOKS TO SEE IF IT HAS THE PAGE NUMBER OF THE FILE + +PLOAD: ADD P,[NSLOTS,,NSLOTS] + SKIPL P + JRST PDLOV + MOVEM A,OFF(P) + PUSH TP,C%0 ; [0] + PUSH TP,C%0 ; [0] +IFE ITS,[ + SKIPN MAPJFN + PUSHJ P,OPSAV +] + +PLOADX: PUSHJ P,SQKIL + MOVE A,OFF(P) + ADD A,PURVEC+1 ; GET TO SLOT + SKIPE B,FB.PGS(A) ; SKIP IF PAGE NUMBER + JRST GETIT + MOVE B,FB.NAM(A) + MOVEM B,NAM(P) + MOVE 0,B + MOVEI A,6 ; FIND LAST CHARACTER + TRNE 0,77 ; SKIP IF NOT DONE + JRST .+3 + LSH 0,-6 ; BACK A CHAR + SOJG A,.-3 ; NOW CHAR IS BACKED OUT + ANDI 0,77 ; LASTCHR + MOVEM 0,LASTC(P) + +; NOT TO TRY TO FIND FILE IN MAIN DATA BASE. +; THE GC'S WINDOW IS USED IN THIS CASE. + +IFN ITS,[ + .CALL MNBLK ; OPEN CHANNEL TO MAIN FILE + JRST NTHERE + PUSHJ P,TRAGN ; TRY OPENING UP CHANNEL AGAIN IF POSSIBLE +] +IFE ITS,[ + SKIPN E,MAPJFN + JRST NTHERE ;who cares if no SAV.FILE? + MOVEM E,DIRCHN +] + MOVE D,NAM(P) + MOVE 0,LASTC(P) + PUSHJ P,GETDIR + MOVEM E,DIR(P) + PUSHJ P,GENVN ; GET VERSION # AS FIX + MOVE E,DIR(P) + MOVE D,NAM(P) + MOVE A,B + PUSHJ P,DIRSRC ; SEARCH DIRECTORY + JRST NTHERE ; GO TRY FIXING UP ITS NOT THERE + ANDI A,-1 ; WIN IN MULT SEG CASE + MOVE B,OFF(P) ; GET SLOT NUMBER + ADD B,PURVEC+1 ; POINT TO SLOT + HRRZ C,1(A) ; GET BLOCK NUMBER + HRRM C,FB.PGS(B) ; SMASH INTO SLOT + LDB C,[LNTBYT,,1(A)] ; SMASH IN LENGTH + HRLM C,FB.PGS(B) ; SMASH IN LENGTH + JRST PLOADX + +; NOW TRY TO FIND FILE IN WORKING DIRECTORY + +NTHERE: PUSHJ P,KILBUF + MOVE A,OFF(P) ; GET POINTER TO PURVEC SLOT + ADD A,PURVEC+1 + PUSHJ P,GENVN ; GET VERSION NUMBER + HRRZM B,VER(P) + PUSHJ P,OPMFIL ; OPEN FILE + JRST FIXITU + +; NUMBER OF PAGES ARE IN A +; STARTING PAGE NUMBER IN SPAG(P) + +PLOD1: PUSHJ P,ALOPAG ; get the necessary pages + JRST MAPLS2 + MOVE E,SPAG(P) ; E starting page in file + MOVEM B,PGNO(P) +IFN ITS,[ + MOVN A,FLEN(P) ; get neg count + MOVSI A,(A) ; build aobjn pointer + HRR A,PGNO(P) ; get page to start + MOVE B,A ; save for later + HRRI 0,(E) ; page pointer for file + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, ; no need to have file open anymore +] +IFE ITS,[ + MOVEI A,(E) ; First page on rh of A + HRL A,DIRCHN ; JFN to lh of A + HRLI B,.FHSLF ; specify this fork + MOVSI C,PM%RD+PM%EX ; bits for read/execute + MOVE D,FLEN(P) ; # of pages to D + HRROI E,(B) ; build page aobjn for later + TLC E,-1(D) ; sexy way of doing lh + + SKIPN OPSYS + JRST BLMAP ; if tops-20 can block PMAP + PMAP + ADDI A,1 + ADDI B,1 + SOJG D,.-3 ; map 'em all + MOVE B,E + JRST PLOAD1 + +BLMAP: HRRI C,(D) + TLO C,PM%CNT ; say it is counted + PMAP ; one PMAP does the trick + MOVE B,E +] +; now try to smash slot in PURVEC + +PLOAD1: MOVE A,PURVEC+1 ; get pointer to it + ASH B,PGSHFT ; convert to aobjn pointer to words + MOVE C,OFF(P) ; get slot offset + ADDI C,(A) ; point to slot + MOVEM B,FB.PTR(C) ; clobber it in + TLZ B,(FB.CNT) ; isolate address of page + HRRZ D,PURVEC ; get offset into vector for start of chain + TRNE D,EOC ; skip if not end marker + JRST SCHAIN + HRLI D,400000+A ; set up indexed pointer + ADDI D,1 +IFN ITS, HRRZ 0,@D ; get its address +IFE ITS,[ + MOVE 0,@D + TLZ 0,(FB.CNT) +] + JUMPE 0,SCHAIN ; no chain exists, start one + CAMLE 0,B ; skip if new one should be first + AOJA D,INLOOP ; jump into the loop + + SUBI D,1 ; undo ADDI +FCLOB: MOVE E,OFF(P) ; get offset for this guy + HRRM D,FB.AGE(C) ; link up + HRRM E,PURVEC ; store him away + JRST PLOADD + +SCHAIN: MOVEI D,EOC ; get end of chain indicator + JRST FCLOB ; and clobber it in + +INLOOP: MOVE E,D ; save in case of later link up + HRR D,@D ; point to next table entry + TRNE D,EOC ; 400000 is the end of chain bit + JRST SLFOUN ; found a slot, leave loop + ADDI D,1 ; point to address of progs +IFN ITS, HRRZ 0,@D ; get address of block +IFE ITS,[ + MOVE 0,@D + TLZ 0,(FB.CNT) +] + CAMLE 0,B ; skip if still haven't fit it in + AOJA D,INLOOP ; back to loop start and point to chain link + SUBI D,1 ; point back to start of slot + +SLFOUN: MOVE 0,OFF(P) ; get offset into vector of this guy + HRRM 0,@E ; make previous point to us + HRRM D,FB.AGE(C) ; link it in + + +PLOADD: AOS -NSLOTS(P) ; skip return + +MAPLOS: SUB P,[NSLOTS,,NSLOTS] ; flush stack crap + SUB TP,C%22 + POPJ P, + + +MAPLS0: ERRUUO EQUOTE NO-SAV-FILE + JRST MAPLOS + +MAPLS1: ERRUUO EQUOTE NO-FIXUP-FILE + JRST MAPLOS + +MAPLS2: ERRUUO EQUOTE NO-ROOM-AVAILABLE + JRST MAPLOS + +FIXITU: + +;OPEN FIXUP FILE ON MUDSAV + +IFN ITS,[ + .CALL FIXBLK ; OPEN UP FIXUP FILE + PUSHJ P,TRAGN ; SEE IF TOTALLY LOSING +] +IFE ITS,[ + MOVSI A,%GJSHT ; GTJFN BITS + HRROI B,FXSTR + SKIPE OPSYS + HRROI B,TFXSTR + GTJFN + FATAL FIXUP FILE NOT FOUND + MOVEM A,DIRCHN + MOVE B,[440000,,OF%RD+OF%EX] + OPENF + FATAL FIXUP FILE CANT BE OPENED +] + + MOVE 0,LASTC(P) ; GET DIRECTORY + PUSHJ P,GETDIR + MOVE D,NAM(P) + PUSHJ P,DIRSR1 ; SEARCH DIRECTORY FOR FIXUP + JRST NOFXUP ; NO FIXUP IN MAIN DIRECTORY + ANDI A,-1 ; WIN IN MULTI SEGS + HRRZ A,1(A) ; GET BLOCK NUMBER OF START + ASH A,8. ; CONVERT TO WORDS +IFN ITS,[ + .ACCES MAPCH,A ; ACCESS FILE +] + +IFE ITS,[ + MOVEI B,(A) + MOVE A,DIRCHN + SFPTR + JFCL +] + PUSHJ P,KILBUF +FIXT1: PUSHJ P,RFXUP ; READ IN THE FIXUP FILE + +IFN ITS,[ + .CALL MNBLK ; REOPEN SAV FILE + PUSHJ P,TRAGN +] + +IFE ITS,[ + MOVE A,MAPJFN ; SET UP DIRCHAN AGAIN + MOVEM A,DIRCHN +] + +; NOW TRY TO LOCATE SAV FILE + + MOVE 0,LASTC(P) ; GET LASTCHR + PUSHJ P,GETDIR ; GET DIRECTORY + HRRZ A,VER(P) ; GET VERSION # + MOVE D,NAM(P) ; GET NAME OF FILE + PUSHJ P,DIRSRC ; SEARCH DIRECTORY + JRST MAPLS1 ; NO SAV FILE THERE + ANDI A,-1 + HRRZ E,1(A) ; GET STARTING BLOCK # + LDB A,[LNTBYT,,1(A)] ; GET LENGTH INTO A + MOVEM A,FLEN(P) ; SAVE LENGTH + MOVEM E,SPAG(P) ; SAVE STARTING BLOCK NUMBER + PUSHJ P,KILBUF + PUSHJ P,RSAV ; READ IN CODE +; now to do fixups + +FXUPGO: MOVE A,(TP) ; pointer to them + SETOM INPLOD ; ABSOLUTE CLUDGE TO PREVENT BUFFER FROM + ; SCREWING US +IFE ITS,[ + SKIPN MULTSG + JRST FIXMLT + HRRZ D,B ; this codes gets us running in the correct + ; segment + ASH D,PGSHFT + HRRI D,FIXMLT + MOVEI C,0 + XJRST C ; good bye cruel segment (will work if we fell + ; into segment 0) +FIXMLT: ASH B,PGSHFT ; aobjn to program + +FIX1: SKIPL E,(A) ; read one hopefully squoze + FATAL ATTEMPT TO TYPE FIX PURE + TLZ E,740000 + +NOPV1: PUSHJ P,SQUTOA ; look it up + FATAL BAD FIXUPS + +; N.B. THE VALUE IN THE FIXUPS FOR AN ADDRESS CAN BE NEGATIVE. IF THIS HAPPENS +; IT MEANS THAT THE LEFT HALF CONTAINS THE VALUE INSTEAD OF THE RIGHT HALF +NOPV2: AOBJP A,FIX2 + HLRZ D,(A) ; get old value + HRRZS E + SUBM E,D ; D is diff between old and new + HRLM E,(A) ; fixup the fixups +NOPV3: MOVEI 0,0 ; flag for which half +FIX4: JUMPE 0,FIXRH ; jump if getting rh + MOVEI 0,0 ; next time will get rh + AOBJP A,FIX2 ; done? + HLRE C,(A) ; get lh + JUMPE C,FIX3 ; 0 terminates +FIX5: SKIPGE C ; If C is negative then left half garbage + JRST FIX6 + ADDI C,(B) ; access the code + +NOPV4: ADDM D,-1(C) ; and fix it up + JRST FIX4 + +; FOR LEFT HALF CASE + +FIX6: MOVNS C ; GET TO ADRESS + ADDI C,(B) ; ACCESS TO CODE + HLRZ E,-1(C) ; GET OUT WORD + ADDM D,E ; FIX IT UP + HRLM E,-1(C) + JRST FIX4 + +FIXRH: MOVEI 0,1 ; change flag + HRRE C,(A) ; get it and + JUMPN C,FIX5 + +FIX3: AOBJN A,FIX1 ; do next one + +IFN SPCFXU,[ + MOVE C,B + PUSHJ P,SFIX +] + PUSHJ P,SQUKIL ; KILL SQUOZE TABLE + SETZM INPLOD +FIX2: + HRRZS VER(P) ; INDICATE SAV FILE + MOVEM B,CADDR(P) + PUSHJ P,GENVN + HRRM B,VER(P) + PUSHJ P,OPWFIL + FATAL MAP FIXUP LOSSAGE +IFN ITS,[ + MOVE B,CADDR(P) + .IOT MAPCH,B ; write out the goodie + .CLOSE MAPCH, + PUSHJ P,OPMFIL + FATAL WHERE DID THE FILE GO? + MOVE E,CADDR(P) + ASH E,-PGSHFT ; to page AOBJN + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, +] + + +IFE ITS,[ + MOVE A,DIRCHN ; GET JFN + MOVE B,CADDR(P) ; ready to write it out + HRLI B,444400 + HLRE C,CADDR(P) + SOUT ; zap it out + TLO A,400000 ; dont recycle the JFN + CLOSF + JFCL + ANDI A,-1 ; kill sign bit + MOVE B,[440000,,240000] + OPENF + FATAL MAP FIXUP LOSSAGE + MOVE B,CADDR(P) + ASH B,-PGSHFT ; aobjn to pages + HLRE D,B ; -count + HRLI B,.FHSLF + MOVSI A,(A) + MOVSI C,PM%RD+PM%EX + PMAP + ADDI A,1 + ADDI B,1 + AOJN D,.-3 +] + + SKIPGE MUDSTR+2 + JRST EFIX2 ; exp vers, dont write out +IFE ITS,[ + HRRZ A,SJFNS ; get last jfn from savxxx file + JUMPE A,.+4 ; oop + CAME A,MAPJFN + CLOSF ; close it + JFCL + HLLZS SJFNS ; zero the slot +] + MOVEI 0,1 ; INDICATE FIXUP + HRLM 0,VER(P) + PUSHJ P,OPWFIL + FATAL CANT WRITE FIXUPS + +IFN ITS,[ + MOVE E,(TP) + HLRE A,E ; get length + MOVNS A + ADDI A,2 ; account for these 2 words + MOVE 0,[-2,,A] ; write version and length + .IOT MAPCH,0 + .IOT MAPCH,E ; out go the fixups + SETZB 0,A + MOVEI B,MAPCH + .CLOSE MAPCH, +] + +IFE ITS,[ + MOVE A,DIRCHN + HLRE B,(TP) ; length of fixup vector + MOVNS B + ADDI B,2 ; for length and version words + BOUT + PUSHJ P,GENVN + BOUT + MOVSI B,444400 ; byte pointer to fixups + HRR B,(TP) + HLRE C,(TP) + SOUT + CLOSF + JFCL +] + +EFIX2: MOVE B,CADDR(P) + ASH B,-PGSHFT + JRST PLOAD1 + +; Here to try to get a free page block for new thing +; A/ # of pages to get + +ALOPAG: MOVE C,GCSTOP ; FOOL GETPAG + ADDI C,3777 + ASH C,-PGSHFT + MOVE B,PURBOT +IFE ITS,[ + SKIPN MULTSG ; skip if multi-segments + JRST ALOPA1 +; Compute the "highest" PURBOT (i.e. find the least busy segment) + + PUSH P,E + PUSH P,A + MOVN A,NSEGS ; aobjn pntr to table + HRLZS A + MOVEI B,0 +ALOPA3: CAML B,PURBTB(A) ; if this one is larger + JRST ALOPA2 + MOVE B,PURBTB(A) ; use it + MOVEI E,FSEG(A) ; and the segment # +ALOPA2: AOBJN A,ALOPA3 + POP P,A +] + +ALOPA1: ASH B,-PGSHFT + SUBM B,C ; SEE IF ROOM + CAIL C,(A) + JRST ALOPGW + PUSHJ P,GETPAX ; try to get enough pages +IFE ITS, JRST EPOPJ +IFN ITS, POPJ P, + +ALOPGW: +IFN ITS, AOS (P) ; won skip return +IFE ITS,[ + SKIPE MULTSG + AOS -1(P) ; ret addr + SKIPN MULTSG + AOS (P) +] + MOVE 0,PURBOT +IFE ITS,[ + SKIPE MULTSG + MOVE 0,PURBTB-FSEG(E) +] + ASH 0,-PGSHFT + SUBI 0,(A) + MOVE B,0 +IFE ITS,[ + SKIPN MULTSG + JRST ALOPW1 + ASH 0,PGSHFT + HRRZM 0,PURBTB-FSEG(E) + ASH E,PGSHFT ; INTO POSITION + IORI B,(E) ; include segment in address + POP P,E + JRST ALOPW2 +] +ALOPW1: ASH 0,PGSHFT +ALOPW2: CAMGE 0,PURBOT + MOVEM 0,PURBOT + CAML 0,P.TOP + POPJ P, +IFE ITS,[ + SUBI 0,1777 + ANDCMI 0,1777 +] + MOVEM 0,P.TOP + POPJ P, + +EPOPJ: SKIPE MULTSG + POP P,E + POPJ P, +IFE ITS,[ +GETPAX: TDZA B,B ; here if other segs ok +GETPAG: MOVEI B,1 ; here for only main segment + JRST @[.+1] ; run in sect 0 + MOVNI E,1 +] +IFN ITS,[ +GETPAX: +GETPAG: +] + MOVE C,P.TOP ; top of GC space + ASH C,-PGSHFT ; to page number +IFE ITS,[ + SKIPN MULTSG + JRST GETPA9 + JUMPN B,GETPA9 ; if really wan all segments, + ; must force all to be free + PUSH P,A + MOVN A,NSEGS ; aobjn pntr to table + HRLZS A + MOVE B,P.TOP +GETPA8: CAML B,PURBTB(A) ; if this one is larger + JRST GETPA7 + MOVE B,PURBTB(A) ; use it + MOVEI E,FSEG(A) ; and the segment # +GETPA7: AOBJN A,GETPA8 + POP P,A + JRST .+2 +] +GETPA9: MOVE B,PURBOT + ASH B,-PGSHFT ; also to pages + SUBM B,C ; pages available ==> C + CAMGE C,A ; skip if have enough already + JRST GETPG1 ; no, try to shuffle around + SUBI B,(A) ; B/ first new page +CPOPJ1: AOS (P) +IFN ITS, POPJ P, +IFE ITS,[ +SPOPJ: SKIPN MULTSG + POPJ P, ; return with new free page in B + ; (and seg# in E?) + POP P,21 + SETZM 20 + XJRST 20 +] +; Here if shuffle must occur or gc must be done to make room + +GETPG1: MOVEI 0,0 + SKIPE NOSHUF ; if can't shuffle, then ask gc + JRST ASKAGC + MOVE 0,PURTOP ; get top of mapped pure area + SUB 0,P.TOP + ASH 0,-PGSHFT ; to pages + CAMGE 0,A ; skip if winnage possible + JRST ASKAGC ; please AGC give me some room!! + SUBM A,C ; C/ amount we must flush to make room + +IFE ITS,[ + SKIPE MULTSG ; if multi and getting in all segs + JUMPL E,LPGL1 ; check out each and every segment + + PUSHJ P,GL1 + + SKIPE MULTSG + PUSHJ P,PURTBU ; update PURBOT in multi case + + JRST GETPAX + +LPGL1: PUSH P,[FSEG-1] + +LPGL2: AOS E,(P) ; count segments + MOVE B,NSEGS + ADDI B,FSEG + CAML E,B + JRST LPGL3 + PUSH P,C + MOVE C,PURBOT ; fudge so look for appropriate amt + SUB C,PURBTB-FSEG(E) + ASH C,-PGSHFT ; to pages + ADD C,(P) + SKIPLE C ; none to flush + PUSHJ P,GL1 + HRRZ E,-1(P) ; fet section again + HRRZ B,PURBOT + HRRZ C,PURBTB-FSEG(E) ; lets share with 0 again + SUB C,B + HRL B,E ; get segment + MOVEI A,(B) + ASH B,-PGSHFT + ASH A,-PGSHFT + HRLI A,.FHSLF + HRLI B,.FHSLF + ASH C,-PGSHFT + HRLI C,PM%CNT+PM%RD+PM%WR+PM%EX + PMAP +LPGL4: POP P,C + JRST LPGL2 + +LPGL3: SUB P,C%11 + + SKIPE MULTSG + PUSHJ P,PURTBU ; update PURBOT in multi case + + JRST GETPAG +] +; Here to find pages for flush using LRU algorithm (in multi seg mode, only +; care about the segment in E) + +GL1: MOVE B,PURVEC+1 ; get pointer to pure sr vector + MOVEI 0,-1 ; get very large age + +GL2: SKIPL FB.PTR(B) ; skip if not already flushed + JRST GL3 +IFE ITS,[ + SKIPN MULTSG + JRST GLX + LDB D,[220500,,FB.PTR(B)] ; get segment # + CAIE D,(E) + JRST GL3 ; wrong swegment, ignore +] +GLX: HLRZ D,FB.AGE(B) ; get this ones age + CAMLE D,0 ; skip if this is a candidate + JRST GL3 + MOVE F,B ; point to table entry with E + MOVEI 0,(D) ; and use as current best +GL3: ADD B,[ELN,,ELN] ; look at next + JUMPL B,GL2 + + HLRE B,FB.PTR(F) ; get length of flushee + ASH B,-PGSHFT ; to negative # of pages + ADD C,B ; update amount needed +IFN ITS,SETZM FB.PTR(F) ; indicate it will be gone +IFE ITS,MOVNS FB.PTR(F) ; save page info for flushing pages + JUMPG C,GL1 ; jump if more to get + +; Now compact pure space + + PUSH P,A ; need all acs + HRRZ D,PURVEC ; point to first in core addr order + HRRZ C,PURTOP +IFE ITS,[ + SKIPE MULTSG + HRLI C,(E) ; adjust for segment +] + ASH C,-PGSHFT ; to page number + SETZB F,A + +CL1: ADD D,PURVEC+1 ; to real pointer + SKIPGE FB.PTR(D) ; skip if this one is a flushee + JRST CL2 ; this one stays + +IFE ITS,[ + PUSH P,C + PUSH P,D + HRRZ C,FB.PGS(D) ; is this from SAV FILE? + JUMPN C,CLFOUT ; yes. don't bother flushing pages + MOVN C,FB.PTR(D) ; get aobjn pointer to code in C + SETZM FB.PTR(D) ; and flush this because it works (sorry) + ASH C,-PGSHFT ; pages speak louder than words + HLRE D,C ; # of pages saved here for unmap + HRLI C,.FHSLF ; C now contains myfork,,lowpage + MOVE A,C ; put that in A for RMAP + RMAP ; A now contains JFN in left half + MOVE B,C ; ac roulette: get fork,,page into B for PMAP + HLRZ C,A ; hold JFN in C for future CLOSF + MOVNI A,1 ; say this page to be unmapped +CLFLP: PMAP ; do the unmapping + ADDI B,1 ; next page + AOJL D,CLFLP ; continue for all pages + MOVE A,C ; restore JFN + CLOSF ; and close it, throwing away the JFN + JFCL ; should work in 95/100 cases +CLFOU1: POP P,D ; fatal error if can't close + POP P,C +] + HRRZ D,FB.AGE(D) ; point to next one in chain + JUMPN F,CL3 ; jump if not first one + HRRM D,PURVEC ; and use its next as first + JRST CL4 + +IFE ITS,[ +CLFOUT: SETZM FB.PTR(D) ; zero the code pointer + JRST CLFOU1 +] + +CL3: HRRM D,FB.AGE(F) ; link up + JRST CL4 + +; Found a stayer, move it if necessary + +CL2: +IFE ITS,[ + SKIPN MULTSG + JRST CL9 + LDB F,[220500,,FB.PTR(D)] ; check segment + CAIE E,(F) + JRST CL6X ; no other segs move at all +] +CL9: MOVEI F,(D) ; another pointer to slot + HLRE B,FB.PTR(D) ; - length of block +IFE ITS,[ + TRZ B,<-1>#<(FB.CNT)> + MOVE D,FB.PTR(D) ; pointer to block + TLZ D,(FB.CNT) ; kill count bits +] +IFN ITS, HRRZ D,FB.PTR(D) + SUB D,B ; point to top of block + ASH D,-PGSHFT ; to page number + CAMN D,C ; if not moving, jump + JRST CL6 + + ASH B,-PGSHFT ; to pages +IFN ITS,[ +CL5: SUBI C,1 ; move to pointer and from pointer + SUBI D,1 + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],C,[1000,,-1],D] + .LOSE %LSSYS + AOJL B,CL5 ; count down +] +IFE ITS,[ + PUSH P,B ; save # of pages + MOVEI A,-1(D) ; copy from pointer + HRLI A,.FHSLF ; get this fork code + RMAP ; get a JFN (hopefully) + EXCH D,(P) ; D # of pages (save from) + ADDM D,(P) ; update from + MOVEI B,-1(C) ; to pointer in B + HRLI B,.FHSLF + MOVSI C,PM%RD+PM%EX ; read/execute modes + + SKIPN OPSYS + JRST CCL1 + PMAP ; move a page + SUBI A,1 + SUBI B,1 + AOJL D,.-3 ; move them all + AOJA B,CCL2 + +CCL1: TLO C,PM%CNT + MOVNS D + SUBI B,-1(D) + SUBI A,-1(D) + HRRI C,(D) + PMAP + +CCL2: MOVEI C,(B) + POP P,D +] +; Update the table address for this loser + + SUBM C,D ; compute offset (in pages) + ASH D,PGSHFT ; to words + ADDM D,FB.PTR(F) ; update it +CL7: HRRZ D,FB.AGE(F) ; chain on +CL4: TRNN D,EOC ; skip if end of chain + JRST CL1 + + ASH C,PGSHFT ; to words +IFN ITS, MOVEM C,PURBOT ; reset pur bottom +IFE ITS,[ + SKIPN MULTSG + JRST CLXX + + HRRZM C,PURBTB-FSEG(E) + CAIA +CLXX: MOVEM C,PURBOT ; reset pur bottom +] + POP P,A + POPJ P, + +IFE ITS,[ +CL6X: MOVEI F,(D) ; chain on + JRST CL7 +] +CL6: +IFN ITS, HRRZ C,FB.PTR(F) ; get new top of world +IFE ITS,[ + MOVE C,FB.PTR(F) + TLZ C,(FB.CNT) +] + ASH C,-PGSHFT ; to page # + JRST CL7 + +IFE ITS,[ +PURTBU: PUSH P,A + PUSH P,B + + MOVN B,NSEGS + HRLZS B + MOVE A,PURTOP + +PURTB2: CAMG A,PURBTB(B) + JRST PURTB1 + MOVE A,PURBTB(B) + MOVEM A,PURBOT +PURTB1: AOBJN B,PURTB2 + + POP P,B + POP P,A + POPJ P, +] + + ; SUBR to create an entry in the vector for one of these guys + +MFUNCTION PCODE,SUBR + + ENTRY 2 + + GETYP 0,(AB) ; check 1st arg is string + CAIE 0,TCHSTR + JRST WTYP1 + GETYP 0,2(AB) ; second must be fix + CAIE 0,TFIX + JRST WTYP2 + + MOVE A,(AB) ; convert name of program to sixbit + MOVE B,1(AB) + PUSHJ P,STRTO6 +PCODE4: MOVE C,(P) ; get name in sixbit + +; Now look for either this one or an empty slot + + MOVEI E,0 + MOVE B,PURVEC+1 + +PCODE2: CAMN C,FB.NAM(B) ; skip if this is not it + JRST PCODE1 ; found it, drop out of loop + JUMPN E,.+3 ; dont record another empty if have one + SKIPN FB.NAM(B) ; skip if slot filled + MOVE E,B ; remember pointer + ADD B,[ELN,,ELN] + JUMPL B,PCODE2 ; jump if more to look at + + JUMPE E,PCODE3 ; if E=0, error no room + MOVEM C,FB.NAM(E) ; else stash away name and zero rest + SETZM FB.PTR(E) + SETZM FB.AGE(E) + CAIA +PCODE1: MOVE E,B ; build ,, + MOVEI 0,0 ; flag whether new slot + SKIPE FB.PTR(E) ; skip if mapped already + MOVEI 0,1 + MOVE B,3(AB) + HLRE D,E + HLRE E,PURVEC+1 + SUB D,E + HRLI B,(D) + MOVSI A,TPCODE + SKIPN NOSHUF ; skip if not shuffling + JRST FINIS + JUMPN 0,FINIS ; jump if winner + PUSH TP,A + PUSH TP,B + HLRZ A,B + PUSHJ P,PLOAD + JRST PCOERR + POP TP,B + POP TP,A + JRST FINIS + +PCOERR: ERRUUO EQUOTE PURE-LOAD-FAILURE + +PCODE3: HLRE A,PURVEC+1 ; get current length + MOVNS A + ADDI A,10*ELN ; add 10(8) more entry slots + PUSHJ P,IBLOCK + EXCH B,PURVEC+1 ; store new one and get old + HLRE A,B ; -old length to A + MOVSI B,(B) ; start making BLT pointer + HRR B,PURVEC+1 + SUBM B,A ; final dest to A +IFE ITS, HRLI A,-1 ; force local index + BLT B,-1(A) + JRST PCODE4 + +; Here if must try to GC for some more core + +ASKAGC: SKIPE GCFLG ; if already in GC, lose +IFN ITS, POPJ P, +IFE ITS, JRST SPOPJ + MOVEM A,0 ; amount required to 0 + ASH 0,PGSHFT ; TO WORDS + MOVEM 0,GCDOWN ; pass as funny arg to AGC + EXCH A,C ; save A from gc's destruction +IFN ITS,.IOPUSH MAPCH, ; gc uses same channel + PUSH P,C + SETOM PLODR + MOVE C,[8,,9.] ; SET UP INDICATORS FOR GC + PUSHJ P,AGC + SETZM PLODR + POP P,C +IFN ITS,.IOPOP MAPCH, + EXCH C,A + JUMPGE C,GETPAG + ERRUUO EQUOTE NO-MORE-PAGES + +; Here to clean up pure space by flushing all shared stuff + +PURCLN: SKIPE NOSHUF + POPJ P, + MOVEI B,EOC + HRRM B,PURVEC ; flush chain pointer + MOVE B,PURVEC+1 ; get pointer to table +CLN1: SETZM FB.PTR(B) ; zero pointer entry + SETZM FB.AGE(B) ; zero link and age slots + SETZM FB.PGS(B) + ADD B,[ELN,,ELN] ; go to next slot + JUMPL B,CLN1 ; do til exhausted + MOVE B,PURBOT ; now return pages + SUB B,PURTOP ; compute page AOBJN pointer +IFE ITS, SETZM MAPJFN ; make sure zero mapjfn + JUMPE B,CPOPJ ; no pure pages? + MOVSI B,(B) + HRR B,PURBOT + ASH B,-PGSHFT +IFN ITS,[ + DOTCAL CORBLK,[[1000,,0],[1000,,-1],B] + .LOSE %LSSYS +] +IFE ITS,[ + + SKIPE MULTSG + JRST CLN2 + HLRE D,B ; - # of pges to flush + HRLI B,.FHSLF ; specify hacking hom fork + MOVNI A,1 + MOVEI C,0 + + PMAP + ADDI B,1 + AOJL D,.-2 +] + + MOVE B,PURTOP ; now fix up pointers + MOVEM B,PURBOT ; to indicate no pure +CPOPJ: POPJ P, + +IFE ITS,[ +CLN2: HLRE C,B ; compute pos no. pages + HRLI B,.FHSLF + MOVNS C + MOVNI A,1 ; flushing pages + HRLI C,PM%CNT + MOVE D,NSEGS + MOVE E,PURTOP ; for munging table + ADDI B,_9. ; do it to the correct segment + PMAP + ADDI B,1_9. ; cycle through segments + HRRZM E,PURBTB(D) ; mung table + SOJG D,.-3 + + MOVEM E,PURBOT + POPJ P, +] + +; Here to move the entire pure space. +; A/ # and direction of pages to move (+ ==> up) + +MOVPUR: SKIPE NOSHUF + FATAL CANT MOVE PURE SPACE AROUND +IFE ITS,ASH A,1 + SKIPN B,A ; zero movement, ignore call + POPJ P, + + ASH B,PGSHFT ; convert to words for pointer update + MOVE C,PURVEC+1 ; loop through updating non-zero entries + SKIPE 1(C) + ADDM B,1(C) + ADD C,[ELN,,ELN] + JUMPL C,.-3 + + MOVE C,PURTOP ; found pages at top and bottom of pure + ASH C,-PGSHFT + MOVE D,PURBOT + ASH D,-PGSHFT + ADDM B,PURTOP ; update to new boundaries + ADDM B,PURBOT +IFE ITS,[ + SKIPN MULTSG ; in multi-seg mode, must mung whole table + JRST MOVPU1 + MOVN E,NSEGS + HRLZS E + ADDM PURBTB(E) + AOBJN E,.-1 +] +MOVPU1: CAIN C,(D) ; differ? + POPJ P, + JUMPG A,PUP ; if moving up, go do separate CORBLKs + +IFN ITS,[ + SUBM D,C ; -size of area to C (in pages) + MOVEI E,(D) ; build pointer to bottom of destination + ADD E,A + HRLI E,(C) + HRLI D,(C) + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,-1],D] + .LOSE %LSSYS + POPJ P, + +PUP: SUBM C,D ; pages to move to D + ADDI A,(C) ; point to new top + +PUPL: SUBI C,1 + SUBI A,1 + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,-1],C] + .LOSE %LSSYS + SOJG D,PUPL + POPJ P, +] +IFE ITS,[ + SUBM D,C ; pages to move to D + MOVSI E,(C) ; build aobjn pointer + HRRI E,(D) ; point to lowest + ADD D,A ; D==> new lowest page + MOVEI F,0 ; seg info + SKIPN MULTSG + JRST XPLS3 + MOVEI F,FSEG + ADD F,NSEGS + ASH F,9. +XPLS3: MOVE G,E + MOVE H,D ; save for outer loop + +PURCL1: MOVSI A,.FHSLF ; specify here + HRRI A,(E) ; get a page + IORI A,(F) ; hack seg i + RMAP ; get a real handle on it + MOVE B,D ; where to go + HRLI B,.FHSLF + MOVSI C,PM%RD+PM%EX + IORI A,(F) + PMAP + ADDI D,1 + AOBJN E,PURCL1 + SKIPN MULTSG + POPJ P, + SUBI F,1_9. + CAIGE F,FSEG_9. + POPJ P, + MOVE E,G + MOVE D,H + JRST PURCL1 + +PUP: SUB D,C ; - count to D + MOVSI E,(D) ; start building AOBJN + HRRI E,(C) ; aobjn to top + ADD C,A ; C==> new top + MOVE D,C + MOVEI F,0 ; seg info + SKIPN MULTSG + JRST XPLS31 + MOVEI F,FSEG + ADD F,NSEGS + ASH F,9. +XPLS31: MOVE G,E + MOVE H,D ; save for outer loop + +PUPL: MOVSI A,.FHSLF + HRRI A,(E) + IORI A,(F) ; segment + RMAP ; get real handle + MOVE B,D + HRLI B,.FHSLF + IORI B,(F) + MOVSI C,PM%RD+PM%EX + PMAP + SUBI E,2 + SUBI D,1 + AOBJN E,PUPL + SKIPN MULTSG + POPJ P, + SUBI F,1_9. + CAIGE F,FSEG_9. + POPJ P, + MOVE E,G + MOVE D,H + JRST PUPL + + POPJ P, +] +IFN ITS,[ +.GLOBAL CSIXBT +CSIXBT: MOVEI 0,5 + PUSH P,[440700,,C] + PUSH P,[440600,,D] + MOVEI D,0 +CSXB2: ILDB E,-1(P) + CAIN E,177 + JRST CSXB1 + SUBI E,40 + IDPB E,(P) + SOJG 0,CSXB2 +CSXB1: SUB P,C%22 + MOVE C,D + POPJ P, +] +GENVN: MOVE C,[440700,,MUDSTR+2] + MOVEI D,5 + MOVEI B,0 +VNGEN: ILDB 0,C + CAIN 0,177 + POPJ P, + IMULI B,10. + SUBI 0,60 + ADD B,0 + SOJG D,VNGEN + POPJ P, + +IFE ITS,[ +MSKS: 774000,,0 + 777760,,0 + 777777,,700000 + 777777,,777400 + 777777,,777776 +] + + ; THESE ARE DIRECTORY SEARCH ROUTINES + + +; THIS ROUTINE DOES A BINARY SEARCH ON A DIRECTORY AND RETURNS A POINTER +; RESTED DOWN TO THE APPROPRIATE SLOT IN THE DIRECTORY. +; ARGS: E==DIR POINTER D==FILE-NAME 1 A==VERSION # +; RETS: A==RESTED DOWN DIRECTORY + +DIRSR1: TLOA 0,400000 ; INDICATION OF ONE ARGUMENT SEARCH +DIRSRC: TLZ 0,400000 ; INDICATOR OF 2 ARGUMENT SEARCH + PUSH P,A ; SAVE VERSION # + HLRE B,E ; GET LENGTH INTO B + MOVNS B + MOVE A,E + HRLS B ; GET BOTH SIDES +UP: ASH B,-1 ; HALVE TABLE + AND B,[-2,,-2] ; FORCE DIVIS BY 2 + MOVE C,A ; COPY POINTER + JUMPLE B,LSTHLV ; CANT GET SMALLER + ADD C,B +IFE ITS, HRRZ F,C ; avoid lossage in multi-sections +IFN ITS, CAMLE D,(C) ; SKIP IF EITHER FOUND OR IN TOP +IFE ITS, CAMLE D,(F) ; SKIP IF EITHER FOUND OR IN TOP + MOVE A,C ; POINT TO SECOND HALF +IFN ITS, CAMN D,(C) ; SKIP IF NOT FOUND +IFE ITS, CAMN D,(F) ; SKIP IF NOT FOUND + JRST WON +IFN ITS, CAML D,(C) ; SKIP IF IN TOP HALF +IFE ITS, CAML D,(F) ; SKIP IF IN TOP HALF + JRST UP + HLLZS C ; FIX UP POINTER + SUB A,C + JRST UP + +WON: JUMPL 0,SUPWIN + MOVEI 0,0 ; DOWN FLAG +WON1: LDB A,[221200,,1(C)] ; GET VERSION NUMBER + CAMN A,(P) ; SKIP IF NOT EQUAL + JRST SUPWIN + CAMG A,(P) ; SKIP IF LT + JRST SUBIT + SETO 0, + SUB C,C%22 ; GET NEW C + JRST SUBIT1 + +SUBIT: ADD C,C%22 ; SUBTRACT + JUMPN 0,C1POPJ +SUBIT1: +IFN ITS, CAMN D,(C) ; SEE WHETHER WERE STILL WINNING +IFE ITS,[ + HRRZ F,C + CAMN D,(F) +] + JRST WON1 +C1POPJ: SUB P,C%11 ; GET RID OF VERSION # + POPJ P, ; LOSE LOSE LOSE +SUPWIN: MOVE A,C ; RETURN ARGUMENT IN A + AOS -1(P) ; SKIP RETURN INDICATES IT WAS FOUND + JRST C1POPJ + +LSTHLV: +IFN ITS, CAMN D,(C) ; LINEAR SEARCH REST +IFE ITS,[ + HRRZ F,C + CAMN D,(F) ; LINEAR SEARCH REST +] + JRST WON + ADD C,C%22 + JUMPL C,LSTHLV + JRST C1POPJ + + ; ROUTINE TO GET A DIRECTORY. ASSUMES MAPCH IS OPEN TO FIXUP OR SAV FILE AND 0 IS THE +; LAST CHAR TO BE HASHED. RETURNS POINTER TO DIRECTORY IN E + +IFN ITS,[ +GETDIR: PUSH P,C + PUSH P,0 + PUSHJ P,SQKIL + MOVEI A,1 ; GET A BUFFER + PUSHJ P,GETBUF + MOVEI C,(B) + ASH C,-10. + DOTCAL CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],[1000,,0]] + PUSHJ P,SLEEPR + POP P,0 + IDIV 0,(B) ; A NOW CONTAINS THE DIRECTORY NUMBER + ADDI A,1(B) + DOTCAL CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],(A)] + PUSHJ P,SLEEPR + MOVN E,(B) ; GET -LENGTH OF DIRECTORY + HRLZS E ; BUILD AOBJN PTR TO DIR + HRRI E,1(B) + POP P,C + POPJ P, +] +; IN WONDERFUL TOPS20 VERSION DIRCHN CONTAINS THE JFN + +IFE ITS,[ +GETDIR: JRST @[.+1] + PUSH P,C + PUSH P,0 + PUSHJ P,SQKIL + MOVEI A,1 ; GET A BUFFER + PUSHJ P,GETBUF + HRROI E,(B) + ASH B,-9. + HRLI B,.FHSLF ; SET UP DESTINATION (CORE) + MOVS A,DIRCHN ; SET UP SOURCE (FILE) + MOVSI C,PM%RD+PM%EX ; READ+EXEC ACCESS + PMAP + POP P,0 + IDIV 0,(E) ; A NOW CONTAINS THE DIRECTORY NUMBER + ADDI A,1(E) ; POINT TO THE DIRECTORY ENTRY + MOVE A,(A) ; GET THE PAGE NUMBER + HRL A,DIRCHN ; SET UP SOURCE (FILE) + PMAP ; AGAIN READ IN DIRECTORY + MOVEI A,(E) + MOVN E,(E) ; GET -LENGTH OF DIRECTORY + HRLZS E ; BUILD AOBJN PTR TO DIR + HRRI E,1(A) + POP P,C + SKIPN MULTSG + POPJ P, + POP P,21 + SETZM 20 + XJRST 20 +] +; HERE IF CAN'T FIND FIXUP FILE IN MAIN DIRECTORY + +NOFXUP: +IFE ITS,[ + MOVE A,DIRCHN ; JFN FOR FIXUP FILE + CLOSF ; CLOSE IT + JFCL +] + MOVE A,FXTBL ; GET AOBJN POINTER TO FIXUP TABLE +NOFXU1: HRRZ B,(A) ; GET VERSION TO TRY + HRRM B,VER(P) ; STUFF IN VERSION + MOVEI B,1 ; DUMP IN FIXUP INDICATOR + HRLM B,VER(P) + MOVEM A,TEMP(P) ; SAVE POINTER TO FXTBL + PUSHJ P,OPXFIL ; LOOK FOR FIXUP FILE + JRST NOFXU2 + PUSHJ P,RFXUP ; READ IN THE FIXUP FILE + HRRZS VER(P) ; INDICATE SAV FILE + PUSHJ P,OPXFIL ; TRY OPENING IT + JRST MAPLS0 ; GIVE UP NO SAV FILE TO BE HAD + PUSHJ P,RSAV + JRST FXUPGO ; GO FIXUP THE WORLD +NOFXU2: MOVE A,TEMP(P) ; GET BACK POINTER + AOBJN A,NOFXU1 ; TRY NEXT + JRST MAPLS1 ; NO FILE TO BE HAD + +GETIT: HRRZM B,SPAG(P) ; GET BLOCK OF START + HLRZM B,FLEN(P) ; DAMMIT SAVE THIS! + HLRZ A,B ; GET LENGTH +IFN ITS,[ + .CALL MNBLK + PUSHJ P,TRAGN +] +IFE ITS,[ + MOVE E,MAPJFN + MOVEM E,DIRCHN +] + + JRST PLOD1 + +; ROUTINE TO SEE IF FILE IS NOT OPEN BECAUSE OF FNF AND FATAL IF SO + +IFN ITS,[ +TRAGN: PUSH P,0 ; SAVE 0 + .STATUS MAPCH,0 ; GET STATUS BITS + LDB 0,[220600,,0] + CAIN 0,4 ; SKIP IF NOT FNF + FATAL MAJOR FILE NOT FOUND + POP P,0 + SOS (P) + SOS (P) ; RETRY OPEN + POPJ P, +] +IFE ITS,[ +OPSAV: MOVSI A,%GJSHT+%GJOLD ; BITS FOR GTJFN + HRROI B,SAVSTR ; STRING POINTER + SKIPE OPSYS + HRROI B,TSAVST + GTJFN + FATAL CANT FIND SAV FILE + MOVEM A,MAPJFN ; STORE THE JFN + MOVE B,[440000,,OF%RD+OF%EX+OF%THW+OF%DUD] + OPENF + FATAL CANT OPEN SAV FILE + POPJ P, +] + +; OPMFIL IS USED TO OPEN A FILE ON MUDTMP. IT CAN OPEN EITHER A SAV OR FIXUP FILE +; AND THE VERSION NUMBER IS SPECIFIED. THE ARGUMENTS ARE +; NAM-1(P) HAS SIXBIT OF FILE NAME +; VER-1(P) HAS 0,,VERSION # FOR SAV FILE AND 1,,VERSION# FOR FIXUP FILE +; RETURNS LENGTH OF FILE IN SLEN AND + +; OPXFIL IS A KLUDGE FOR GETTING SAV AND FIXUP FILES OFF OF THE MDLLIB +; DIRECTORY DURING THE CHANGEOVER TO PRE- AND POST- MUDSAV WORLDS + +OPXFIL: MOVEI 0,1 + MOVEM 0,WRT-1(P) + JRST OPMFIL+1 + +OPWFIL: SETOM WRT-1(P) + SKIPA +OPMFIL: SETZM WRT-1(P) + +IFN ITS,[ + HRRZ C,VER-1(P) ; GET VERSION NUMBER + PUSHJ P,NTOSIX ; CONVERT TO SIXBIT + HRLI C,(SIXBIT /SAV/) ; BUILD SECOND FILE NAME + HLRZ 0,VER-1(P) + SKIPE 0 ; SKIP IF SAV + HRLI C,(SIXBIT/FIX/) + MOVE B,NAM-1(P) ; GET NAME + MOVSI A,7 ; WRITE MODE + SKIPL WRT-1(P) + MOVSI A,6 ; READ MODE +RETOPN: .CALL FOPBLK + JRST OPCHK ; SEE IF FIXUP IS NECESSARY OR JUST REOPENING + DOTCAL FILLEN,[[1000,,MAPCH],[2000,,A]] + .LOSE 1000 + ADDI A,PGMSK ; ROUND + ASH A,-PGSHFT ; TO PAGES + MOVEM A,FLEN-1(P) + SETZM SPAG-1(P) + AOS (P) ; SKIP RETURN TO SHOW SUCCESS + POPJ P, + +OPCHK: .STATUS MAPCH,0 ; GET STATUS BITS + LDB 0,[220600,,0] + CAIE 0,4 ; SKIP IF FNF + JRST OPCHK1 ; RETRY + POPJ P, + +OPCHK1: MOVEI 0,1 ; SLEEP FOR A WHILE + .SLEEP + JRST OPCHK + +; NTOSIX GETS NUMBER IN C AND CONVERTS IT TO SIXBIT AND RETURNS RESULT IN C + +NTOSIX: PUSH P,A ; SAVE A AND B + PUSH P,B + PUSH P,D + MOVE D,[220600,,C] + MOVEI A,(C) ; GET NUMBER + MOVEI C,0 + IDIVI A,100. ; GET RESULT OF DIVISION + SKIPN A + JRST ALADD + ADDI A,20 ; CONVERT TO DIGIT + IDPB A,D +ALADD: MOVEI A,(B) + IDIVI A,10. ; GET TENS DIGIT + SKIPN C + SKIPE A ; IF BOTH 0 BLANK DIGIT + ADDI A,20 + IDPB A,D + SKIPN C + SKIPE B + ADDI B,20 + IDPB B,D + POP P,D + POP P,B + POP P,A + POPJ P, + +] + +IFE ITS,[ + MOVE E,P ; save pdl base + MOVE B,NAM-1(E) ; GET FIRST NAME + PUSH P,C%0 ; [0]; slots for building strings + PUSH P,C%0 ; [0] + MOVE A,[440700,,1(E)] + MOVE C,[440600,,B] + +; DUMP OUT SIXBIT NAME + + MOVEI D,6 + ILDB 0,C + JUMPE 0,.+4 ; violate cardinal ".+ rule" + ADDI 0,40 ; to ASCII + IDPB 0,A + SOJG D,.-4 + + MOVE 0,[ASCII / SAV/] + HLRZ C,VER-1(E) ; GET SAV/FIXUP FLAG + SKIPE C + MOVE 0,[ASCII / FIX/] + PUSH P,0 + HRRZ C,VER-1(E) ; get ascii of vers no. + PUSHJ P,NTOSEV ; CONVERT TO STRING LEFT JUSTIFIED + PUSH P,C + MOVEI B,-1(P) ; point to it + HRLI B,260700 + HRROI D,1(E) ; point to name + MOVEI A,1(P) + MOVSI 0,100000 ; INPUT FILE (GJ%OLD) + SKIPGE WRT-1(E) + MOVSI 0,400000 ; OUTPUT FILE (GJ%FOU) + PUSH P,0 + PUSH P,[377777,,377777] + MOVE 0,[-1,,[ASCIZ /DSK/]] + SKIPN OPSYS + MOVE 0,[-1,,[ASCIZ /PS/]] + PUSH P,0 + HRROI 0,[ASCIZ /MDL/] + SKIPLE WRT-1(E) + HRROI 0,[ASCIZ /MDLLIB/] ; USE MDLLIB FOR SPECIAL CASE + PUSH P,0 + PUSH P,D + PUSH P,B + PUSH P,C%0 ; [0] + PUSH P,C%0 ; [0] + PUSH P,C%0 ; [0] + MOVEI B,0 + MOVE D,4(E) ; save final version string + GTJFN + JRST OPMLOS ; FAILURE + MOVEM A,DIRCHN + MOVE B,[440000,,OF%RD+OF%EX] + SKIPGE WRT-1(E) + MOVE B,[440000,,OF%RD+OF%WR] + OPENF + FATAL OPENF FAILED + MOVE P,E ; flush crap + PUSH P,A + SIZEF ; get length + JRST MAPLOS + SKIPL WRT-1(E) + MOVEM C,FLEN-1(E) ; ONLY SAVE LENGTH FOR READ JFNS + SETZM SPAG-1(E) + +; RESTORE STACK AND LEAVE + + MOVE P,E + MOVE A,C ; NUMBER OF PAGES IN A, DAMN! + AOS (P) + POPJ P, + +OPMLOS: MOVE P,E + POPJ P, + +; CONVERT A NUMBER IN C TO AN ASCII STRING LEFT JUSTIFIED IN C + +NTOSEV: PUSH P,A ; SAVE A AND B + PUSH P,B + PUSH P,D + MOVE D,[440700,,C] + MOVEI A,(C) ; GET NUMBER + MOVEI C,0 + IDIVI A,100. ; GET RESULT OF DIVISION + JUMPE A,ALADD + ADDI A,60 ; CONVERT TO DIGIT + IDPB A,D +ALADD: MOVEI A,(B) + IDIVI A,10. ; GET TENS DIGIT + ADDI A,60 + IDPB A,D +ALADD1: ADDI B,60 + IDPB B,D + POP P,D + POP P,B + POP P,A + POPJ P, + +] + +; ROUTINE TO READ IN THE FIXUPS FROM DIRCHN OR MAPCH WORKS +; FOR FIXUP FILE OR FIXUPS IN A SEPERATE FILE AS LONG AS THE +; CHANNEL IS OPENED AND ACCESSED TO THE RIGHT PLACE + +RFXUP: +IFN ITS,[ + MOVE 0,[-2,,A] ; PREPARE TO READ VERSION AND LENGTH + .IOT MAPCH,0 ; READ IT IN + SKIPGE 0 ; SKIP IF NOT HIT EOF + FATAL BAD FIXUP FILE + MOVEI A,-2(A) ; COUNT FOR FIRST 2 WORDS + HRRM B,VER-1(P) ; SAVE VERSION # + .IOPUS MAPCH, ; PUSH THE MAPPING CHANNEL + SETOM PLODR + PUSHJ P,IBLOCK ; GET A UVECTOR OF APPROPRIATE SIZE + SETZM PLODR + .IOPOP MAPCH, + MOVE 0,$TUVEC + MOVEM 0,-1(TP) ; SAVE UVECTOR + MOVEM B,(TP) + MOVE A,B ; GET AOBJN POINTER TO UVECTOR FOR IOT + .IOT MAPCH,A ; GET FIXUPS + .CLOSE MAPCH, + POPJ P, +] + +IFE ITS,[ + MOVE A,DIRCHN + BIN ; GET LENGTH OF FIXUP + MOVE C,B + MOVE A,DIRCHN + BIN ; GET VERSION NUMBER + HRRM B,VER-1(P) + SETOM PLODR + MOVEI A,-2(C) + PUSHJ P,IBLOCK + SETZM PLODR + MOVSI 0,$TUVEC + MOVEM 0,-1(TP) + MOVEM B,(TP) + MOVE A,DIRCHN + HLRE C,B +; SKIPE OPSYS ; SKIP IF TOPS20 SINCE C MUST BE NEGETIVE +; MOVNS C ; C IS POSITIVE FOR TENEX ????? + HRLI B,444400 + SIN + MOVE A,DIRCHN + CLOSF + FATAL CANT CLOSE FIXUP FILE + RLJFN + JFCL + POPJ P, +] + +; ROUTINE TO READ IN THE CODE + +RSAV: MOVE A,FLEN-1(P) + PUSHJ P,ALOPAG ; GET PAGES + JRST MAPLS2 + MOVE E,SPAG-1(P) + +IFN ITS,[ + MOVN A,FLEN-1(P) ; build aobjn pointer + MOVSI A,(A) + HRRI A,(B) + MOVE B,A + HRRI 0,(E) + DOTCAL CORBLK,[[1000,,104000],[1000,,-1],A,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, + POPJ P, +] +IFE ITS,[ + PUSH P,B ; SAVE PAGE # + MOVS A,DIRCHN ; SOURCE (MUDSAV) + HLRM A,SJFNS ; SAVE POINTER FOR FUTURE CLOSING + HRR A,E + HRLI B,.FHSLF ; DESTINATION (FORK) + MOVSI C,PM%RD+PM%CPY ; MAKE COPY ON WRITE + SKIPE OPSYS + JRST RSAV1 ; HANDLE TENEX + TLO C,PM%CNT ; REPEAT COUNT BIT FOR TOPS20 + HRR C,FLEN-2(P) ; PAGE (FOR PUSHJ AND PUSHED B) + PMAP +RSAVDN: POP P,B + MOVN 0,FLEN-1(P) + HRL B,0 + POPJ P, + +RSAV1: HRRZ D,FLEN-2(P) ; GET IN PAGE COUNT +RSAV2: PMAP + ADDI A,1 ; NEXT PAGE + ADDI B,1 + SOJN D,RSAV2 ; LOOP + JRST RSAVDN +] + +PDLOV: SUB P,[NSLOTS,,NSLOTS] + PUSH P,C%0 ; [0]; CAUSE A PDL OVERFLOW + JRST .-1 + +; CONSTANTS RELATED TO DATA BASE +DEV: SIXBIT /DSK/ +MODE: 6,,0 +MNDIR: SIXBIT /MUDSAV/ ; DIR OF MAIN DATA BASE FILES +WRKDIR: SIXBIT /MUDTMP/ ; DIRECTORY OF UPDATE FILES + +IFN ITS,[ +MNBLK: SETZ + SIXBIT /OPEN/ + MODE + DEV + [SIXBIT /SAV/] + [SIXBIT /FILE/] + SETZ MNDIR + + +FIXBLK: SETZ + SIXBIT /OPEN/ + MODE + DEV + [SIXBIT /FIXUP/] + [SIXBIT /FILE/] + SETZ MNDIR + +FOPBLK: SETZ + SIXBIT /OPEN/ + A + DEV + B + C + SETZ WRKDIR + +FXTBL: -2,,.+1 + 55. + 54. +] +IFE ITS,[ + +FXSTR: ASCIZ /PS:FIXUP.FILE/ +SAVSTR: ASCIZ /PS:SAV.FILE/ +TFXSTR: ASCIZ /DSK:FIXUP.FILE/ +TSAVST: ASCIZ /DSK:SAV.FILE/ + +FXTBL: -3,,.+1 + 55. + 54. + 104. +] +IFN SPCFXU,[ + +;This code does two things to code for FBIN; +; 1) Makes dispatches win in multi seg mode +; 2) Makes OBLIST? work with "new" atom format +; 3) Makes LENGTH win in multi seg mode +; 4) Gets AOBJN pointer to code vector in C + +SFIX: PUSH P,A + PUSH P,B + PUSH P,C ; for referring back + +SFIX1: MOVSI B,-MLNT ; for looping through tables + +SFIX2: MOVE A,(C) ; get code word + + AND A,SMSKS(B) + CAMN A,SPECS(B) ; do we match + JRST @SFIXR(B) + + AOBJN B,SFIX2 + +SFIX3: AOBJN C,SFIX1 ; do all of code +SFIX4: POP P,C + POP P,B + POP P,A + POPJ P, + +SMSKS: -1 + 777000,,-1 + -1,,0 + 777037,,0 +MLNT==.-SMSKS + +SPECS: HLRES A ; begin of arg diaptch table + SKIPN 2 ; old compiled OBLIST? + JRST (M) ; compiled LENGTH + ADDI (M) ; begin a case dispatch + +SFIXR: SETZ DFIX + SETZ OBLFIX + SETZ LFIX + SETZ CFIX + +DFIX: AOBJP C,SFIX4 ; make sure dont run out + MOVE A,(C) ; next ins + CAME A,[ASH A,-1] ; still winning? + JRST SFIX3 ; false alarm + AOBJP C,SFIX4 ; make sure dont run out + HLRZ A,(C) ; next ins + CAIE A,(ADDI A,(M)) ; still winning? + JRST SFIX3 ; false alarm + AOBJP C,SFIX4 + HLRZ A,(C) + CAIE A,(PUSHJ P,@(A)) ; last one to check + JRST SFIX3 + AOBJP C,SFIX4 + MOVE A,(C) + CAME A,[JRST FINIS] ; extra check + JRST SFIX3 + + MOVSI B,(SETZ) +SFIX5: AOBJP C,SFIX4 + HLRZ A,(C) + CAIN A,(SUBM M,(P)) + JRST SFIX3 + CAIE A,M ; dispatch entry? + JRST SFIX3 ; maybe already fixed + IORM B,(C) ; fix it + JRST SFIX5 + +OBLFIX: MOVSI B,-OLN ; for checking more ins + PUSH P,C + +OBLFI1: AOBJP C,OBLFXX + MOVE A,(C) + AND A,OMSK(B) + CAME A,OINS(B) + JRST OBLFXX + AOBJN B,OBLFI1 + JRST DOOBFX + +OBLFXX: MOVSI B,-OLN2 ; for checking more ins + MOVE C,(P) + +OBLFX1: AOBJP C,OBLFI2 + MOVE A,(C) + AND A,OMSK2(B) + CAME A,OINS2(B) + JRST OBLFI2 + AOBJN B,OBLFX1 + +INSBP==331100 ; byte pointer for ins field +ACBP==270400 ; also for ac +INDXBP==220400 + +DOOBFX: POP P,C + MOVEI B,<<(HRRZ)>_<-9>> ; change em + DPB B,[INSBP,,(C)] ; SKIPN==>HRRZ + LDB A,[ACBP,,(C)] ; get AC field + MOVEI B,<<(JUMPE)>_<-9>> + DPB B,[INSBP,,1(C)] + DPB A,[ACBP,,1(C)] + AOS 1(C) ; JRST FOO==>JUMPE ac,FOO+1 + MOVE B,[CAMG VECBOT] + DPB A,[ACBP,,B] + MOVEM B,2(C) ; JUMPL ==> CAMG ac,VECBOT + HRRZ A,3(C) ; get indicator of existence of ADD AC,TVP + CAIE A,TVP ; skip if extra ins exists + JRST NOATVP + MOVSI A,(JFCL) + EXCH A,4(C) + MOVEM A,3(C) + ADD C,C%11 +NOATVP: TLC B,(CAMG#HRLI) ; change CAMG to HRLI (preserving AC) + HLLOM B,5(C) ; in goes HRLI -1 + MOVSI B,(CAIA) ; skipper + EXCH B,6(C) + MOVEM B,7(C) + ADD C,[7,,7] + JRST SFIX3 + +OBLFI2: POP P,C + JRST SFIX3 + +; Here to fixup compiled LENGTH + +LFIX: MOVSI B,-LLN ; for checking other LENGTH ins + PUSH P,C + +LFIX1: AOBJP C,OBLFI2 + MOVE A,(C) + AND A,LMSK(B) + CAME A,LINS(B) + JRST OBLFI2 + AOBJN B,LFIX1 + + POP P,C ; restore code pointer + MOVE A,(C) ; save jump for its addr + MOVE B,[MOVSI 400000] + MOVEM B,(C) ; JRST .+2 ==> MOVSI 0,400000 + LDB B,[ACBP,,1(C)] ; B==> AC of interest + ADDI A,2 + DPB B,[ACBP,,A] + MOVEI B,<<(JUMPE)>_<-9.>> + DPB B,[INSBP,,A] + EXCH A,1(C) + TLC A,(HRR#HRRZ) ; HRR==>HRRZ + HLLZM A,2(C) ; TRNN AC,-1 ==> HRRZ AC,(AC) + MOVEI B,(AOBJN (M)) + HRLM B,3(C) ; AOBJP AC,.-2 ==> AOBJN 0,.-2 + MOVE B,2(C) ; get HRRZ AC,(AC) + TLZ B,17 ; kill (AC) part + MOVEM B,4(C) ; HLRZS AC ==> HRRZ AC,0 + ADD C,C%44 + JRST SFIX3 + +; Fixup a CASE dispatch + + CFIX: LDB A,[ACBP,,(C)] + AOBJP C,SFIX4 + HLRZ B,(C) ; Next ins + ANDI B,777760 + CAIE B,(JRST @) + JRST SFIX3 + LDB B,[INDXBP,,(C)] + CAIE A,(B) + JRST SFIX3 + MOVE A,(C) ; ok, fix it up + TLZ A,20 ; kill indirection + MOVEM A,(C) + HRRZ B,-1(C) ; point to table + ADD B,(P) ; point to code to change + +CFIXLP: HLRZ A,(B) ; check one out + CAIE A,M ; check for just index + JRST SFIX3 + MOVEI A,(JRST (M)) + HRLM A,(B) + AOJA B,CFIXLP + +DEFINE FOO LBL,LNT,LBL2,L +LBL: + IRP A,,[L] + IRP B,C,[A] + B + .ISTOP + TERMIN + TERMIN +LNT==.-LBL +LBL2: + IRP A,,[L] + IRP B,C,[A] + C + .ISTOP + TERMIN + TERMIN +TERMIN + +IMSK==777017,,0 +AIMSK==777000,,-1 + +FOO OINS,OLN,OMSK,[[,IMSK],[,IMSK],[MOVE,AIMSK] + [,AIMSK],[,IMSK] + [,AIMSK],[MOVEI,AIMSK]] + +FOO OINS2,OLN2,OMSK2,[[,IMSK],[,IMSK],[,AIMSK] + [MOVE,AIMSK],[,AIMSK],[,IMSK] + [,AIMSK],[MOVEI,AIMSK]] + +FOO LINS,LLN,LMSK,[[,AIMSK],[,AIMSK],[,IMSK] + [,<-1,,777760>]] + +] +IMPURE + +SAVSNM: 0 ; SAVED SNAME +INPLOD: 0 ; FLAG SAYING WE ARE IN MAPPUR + +IFE ITS,[ +MAPJFN: 0 ; JFN OF SAV FILE +DIRCHN: 0 ; JFN USED BY GETDIR +] + +PURE + +END + diff --git a//mappur.mid.159 b//mappur.mid.159 new file mode 100644 index 0000000..4f64307 --- /dev/null +++ b//mappur.mid.159 @@ -0,0 +1,1972 @@ + +TITLE MAPURE-PAGE LOADER + +RELOCATABLE + +MAPCH==0 ; channel for MAPing +XJRST==JRST 5, + +.GLOBAL PURVEC,PURTOP,PURBOT,P.TOP,GCSTOP,FRETOP,MUDSTR,STRTO6,PLOAD,AGC,GCDOWN +.GLOBAL SQUTOA,IGVAL,IBLOCK,PURCLN,MOVPUR,GETPAG,GCFLG,NOSHUF,DIR,NDIRS,SQUPNT +.GLOBAL PLODR,SQUKIL,GETBUF,KILBUF,INPLOD,SQKIL,PVSTOR,TVSTOR,DSTOREM,SLEEPR +.GLOBAL OPSYS,SJFNS,MULTSG,PURBTB,SFIX,NSEGS +.GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10 +.GLOBAL C%M20,C%M30,C%M40,C%M60 +.GLOBAL MAPJFN,DIRCHN + +.INSRT MUDDLE > +SPCFXU==1 +SYSQ + +IFE ITS,[ +IF1, .INSRT STENEX > +] + +F==PVP +G==TVP +H==SP +RDTP==1000,,200000 +FME==1000,,-1 + + +IFN ITS,[ +PGMSK==1777 +PGSHFT==10. +] + +IFE ITS,[ +FLUSHP==0 +PGMSK==777 +PGSHFT==9. +] + +LNTBYT==340700 +ELN==4 ; LENGTH OF SLOT +FB.NAM==0 ; NAME SLOT IN TABLE +FB.PTR==1 ; Pointer to core pages +FB.AGE==2 ; age,,chain +FB.PGS==3 ; PTR AND LENGTH OF PAGE IN FILE +FB.AMK==37777777 ; extended address mask +FB.CNT==<-1># ; page count mask +EOC==400000 ; END OF PURVEC CHAIN + +IFE ITS,[ +.FHSLF==400000 ; THIS FORK +%GJSHT==000001 ; SHORT FORM GTJFN +%GJOLD==100000 + ;PMAP BITS +PM%CNT==400000 ; PMAP WITH REPEAT COUNT +PM%RD==100000 ; PMAP WITH READ ACCESS +PM%EX==20000 ; PMAP WITH EXECUTE ACCESS (NO-OP ON 20X) +PM%CPY==400 ; PMAP WITH COPY-ON-WRITE ACCESS +PM%WR==40000 ; PMAP WITH WRITE ACCESS + + ;OPENF BITS +OF%RD==200000 ; OPEN IN READ MODE +OF%WR==100000 ; OPEN IN WRITE MODE +OF%EX==040000 ; OPEN IN EXECUTE MODE (TENEX CARES) +OF%THW==02000 ; OPEN IN THAWED MODE +OF%DUD==00020 ; DON'T UPDATE THAWED PAGES +] +; THIS ROUTINE TAKES A SLOT OFFSET IN REGISTER A AND MAPS IN THE ASSOCIATED +; FILE. IT CLOBBERS ALL ACs AND SKIP RETURNS IF IT WINS. + +OFF==-5 ; OFFSET INTO PURVEC OF SLOT +NAM==-4 ; SIXBIT NAME OF THING BEING LOADED +LASTC==-3 ; LAST CHARACTER OF THE NAME +DIR==-2 ; SAVED POINTER TO DIRECTORY +SPAG==-1 ; FIRST PAGE IN FILE +PGNO==0 ; FIRST PAGE IN CORE +VER==-6 ; VERSION NUMBER OF MUDDLE TO USE IN OPENING FILES +FLEN==-7 ; LENGTH OF THE FILE +TEMP==-10 ; GENERAL TEMPORARY SLOT +WRT==-11 ; INDICATION IF OPEN IS FOR WRITING OR READING +CADDR==-12 ; ADDRESS OF CORE IMAGE LOCATION OF FILE +NSLOTS==13 + +; IT FIRST LOOKS TO SEE IF IT HAS THE PAGE NUMBER OF THE FILE + +PLOAD: ADD P,[NSLOTS,,NSLOTS] + SKIPL P + JRST PDLOV + MOVEM A,OFF(P) + PUSH TP,C%0 ; [0] + PUSH TP,C%0 ; [0] +IFE ITS,[ + SKIPN MAPJFN + PUSHJ P,OPSAV +] + +PLOADX: PUSHJ P,SQKIL + MOVE A,OFF(P) + ADD A,PURVEC+1 ; GET TO SLOT + SKIPE B,FB.PGS(A) ; SKIP IF PAGE NUMBER + JRST GETIT + MOVE B,FB.NAM(A) + MOVEM B,NAM(P) + MOVE 0,B + MOVEI A,6 ; FIND LAST CHARACTER + TRNE 0,77 ; SKIP IF NOT DONE + JRST .+3 + LSH 0,-6 ; BACK A CHAR + SOJG A,.-3 ; NOW CHAR IS BACKED OUT + ANDI 0,77 ; LASTCHR + MOVEM 0,LASTC(P) + +; NOT TO TRY TO FIND FILE IN MAIN DATA BASE. +; THE GC'S WINDOW IS USED IN THIS CASE. + +IFN ITS,[ + .CALL MNBLK ; OPEN CHANNEL TO MAIN FILE + JRST NTHERE + PUSHJ P,TRAGN ; TRY OPENING UP CHANNEL AGAIN IF POSSIBLE +] +IFE ITS,[ + SKIPN E,MAPJFN + JRST NTHERE ;who cares if no SAV.FILE? + MOVEM E,DIRCHN +] + MOVE D,NAM(P) + MOVE 0,LASTC(P) + PUSHJ P,GETDIR + MOVEM E,DIR(P) + PUSHJ P,GENVN ; GET VERSION # AS FIX + MOVE E,DIR(P) + MOVE D,NAM(P) + MOVE A,B + PUSHJ P,DIRSRC ; SEARCH DIRECTORY + JRST NTHERE ; GO TRY FIXING UP ITS NOT THERE + ANDI A,-1 ; WIN IN MULT SEG CASE + MOVE B,OFF(P) ; GET SLOT NUMBER + ADD B,PURVEC+1 ; POINT TO SLOT + HRRZ C,1(A) ; GET BLOCK NUMBER + HRRM C,FB.PGS(B) ; SMASH INTO SLOT + LDB C,[LNTBYT,,1(A)] ; SMASH IN LENGTH + HRLM C,FB.PGS(B) ; SMASH IN LENGTH + JRST PLOADX + +; NOW TRY TO FIND FILE IN WORKING DIRECTORY + +NTHERE: PUSHJ P,KILBUF + MOVE A,OFF(P) ; GET POINTER TO PURVEC SLOT + ADD A,PURVEC+1 + PUSHJ P,GENVN ; GET VERSION NUMBER + HRRZM B,VER(P) + PUSHJ P,OPMFIL ; OPEN FILE + JRST FIXITU + +; NUMBER OF PAGES ARE IN A +; STARTING PAGE NUMBER IN SPAG(P) + +PLOD1: PUSHJ P,ALOPAG ; get the necessary pages + JRST MAPLS2 + MOVE E,SPAG(P) ; E starting page in file + MOVEM B,PGNO(P) +IFN ITS,[ + MOVN A,FLEN(P) ; get neg count + MOVSI A,(A) ; build aobjn pointer + HRR A,PGNO(P) ; get page to start + MOVE B,A ; save for later + HRRI 0,(E) ; page pointer for file + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, ; no need to have file open anymore +] +IFE ITS,[ + MOVEI A,(E) ; First page on rh of A + HRL A,DIRCHN ; JFN to lh of A + HRLI B,.FHSLF ; specify this fork + MOVSI C,PM%RD+PM%EX ; bits for read/execute + MOVE D,FLEN(P) ; # of pages to D + HRROI E,(B) ; build page aobjn for later + TLC E,-1(D) ; sexy way of doing lh + + SKIPN OPSYS + JRST BLMAP ; if tops-20 can block PMAP + PMAP + ADDI A,1 + ADDI B,1 + SOJG D,.-3 ; map 'em all + MOVE B,E + JRST PLOAD1 + +BLMAP: HRRI C,(D) + TLO C,PM%CNT ; say it is counted + PMAP ; one PMAP does the trick + MOVE B,E +] +; now try to smash slot in PURVEC + +PLOAD1: MOVE A,PURVEC+1 ; get pointer to it + ASH B,PGSHFT ; convert to aobjn pointer to words + MOVE C,OFF(P) ; get slot offset + ADDI C,(A) ; point to slot + MOVEM B,FB.PTR(C) ; clobber it in + TLZ B,(FB.CNT) ; isolate address of page + HRRZ D,PURVEC ; get offset into vector for start of chain + TRNE D,EOC ; skip if not end marker + JRST SCHAIN + HRLI D,400000+A ; set up indexed pointer + ADDI D,1 +IFN ITS, HRRZ 0,@D ; get its address +IFE ITS,[ + MOVE 0,@D + TLZ 0,(FB.CNT) +] + JUMPE 0,SCHAIN ; no chain exists, start one + CAMLE 0,B ; skip if new one should be first + AOJA D,INLOOP ; jump into the loop + + SUBI D,1 ; undo ADDI +FCLOB: MOVE E,OFF(P) ; get offset for this guy + HRRM D,FB.AGE(C) ; link up + HRRM E,PURVEC ; store him away + JRST PLOADD + +SCHAIN: MOVEI D,EOC ; get end of chain indicator + JRST FCLOB ; and clobber it in + +INLOOP: MOVE E,D ; save in case of later link up + HRR D,@D ; point to next table entry + TRNE D,EOC ; 400000 is the end of chain bit + JRST SLFOUN ; found a slot, leave loop + ADDI D,1 ; point to address of progs +IFN ITS, HRRZ 0,@D ; get address of block +IFE ITS,[ + MOVE 0,@D + TLZ 0,(FB.CNT) +] + CAMLE 0,B ; skip if still haven't fit it in + AOJA D,INLOOP ; back to loop start and point to chain link + SUBI D,1 ; point back to start of slot + +SLFOUN: MOVE 0,OFF(P) ; get offset into vector of this guy + HRRM 0,@E ; make previous point to us + HRRM D,FB.AGE(C) ; link it in + + +PLOADD: AOS -NSLOTS(P) ; skip return + +MAPLOS: SUB P,[NSLOTS,,NSLOTS] ; flush stack crap + SUB TP,C%22 + POPJ P, + + +MAPLS0: ERRUUO EQUOTE NO-SAV-FILE + JRST MAPLOS + +MAPLS1: ERRUUO EQUOTE NO-FIXUP-FILE + JRST MAPLOS + +MAPLS2: ERRUUO EQUOTE NO-ROOM-AVAILABLE + JRST MAPLOS + +FIXITU: + +;OPEN FIXUP FILE ON MUDSAV + +IFN ITS,[ + .CALL FIXBLK ; OPEN UP FIXUP FILE + PUSHJ P,TRAGN ; SEE IF TOTALLY LOSING +] +IFE ITS,[ + MOVSI A,%GJSHT ; GTJFN BITS + HRROI B,FXSTR + SKIPE OPSYS + HRROI B,TFXSTR + GTJFN + FATAL FIXUP FILE NOT FOUND + MOVEM A,DIRCHN + MOVE B,[440000,,OF%RD+OF%EX] + OPENF + FATAL FIXUP FILE CANT BE OPENED +] + + MOVE 0,LASTC(P) ; GET DIRECTORY + PUSHJ P,GETDIR + MOVE D,NAM(P) + PUSHJ P,DIRSR1 ; SEARCH DIRECTORY FOR FIXUP + JRST NOFXUP ; NO FIXUP IN MAIN DIRECTORY + ANDI A,-1 ; WIN IN MULTI SEGS + HRRZ A,1(A) ; GET BLOCK NUMBER OF START + ASH A,8. ; CONVERT TO WORDS +IFN ITS,[ + .ACCES MAPCH,A ; ACCESS FILE +] + +IFE ITS,[ + MOVEI B,(A) + MOVE A,DIRCHN + SFPTR + JFCL +] + PUSHJ P,KILBUF +FIXT1: PUSHJ P,RFXUP ; READ IN THE FIXUP FILE + +IFN ITS,[ + .CALL MNBLK ; REOPEN SAV FILE + PUSHJ P,TRAGN +] + +IFE ITS,[ + MOVE A,MAPJFN ; SET UP DIRCHAN AGAIN + MOVEM A,DIRCHN +] + +; NOW TRY TO LOCATE SAV FILE + + MOVE 0,LASTC(P) ; GET LASTCHR + PUSHJ P,GETDIR ; GET DIRECTORY + HRRZ A,VER(P) ; GET VERSION # + MOVE D,NAM(P) ; GET NAME OF FILE + PUSHJ P,DIRSRC ; SEARCH DIRECTORY + JRST MAPLS1 ; NO SAV FILE THERE + ANDI A,-1 + HRRZ E,1(A) ; GET STARTING BLOCK # + LDB A,[LNTBYT,,1(A)] ; GET LENGTH INTO A + MOVEM A,FLEN(P) ; SAVE LENGTH + MOVEM E,SPAG(P) ; SAVE STARTING BLOCK NUMBER + PUSHJ P,KILBUF + PUSHJ P,RSAV ; READ IN CODE +; now to do fixups + +FXUPGO: MOVE A,(TP) ; pointer to them + SETOM INPLOD ; ABSOLUTE CLUDGE TO PREVENT BUFFER FROM + ; SCREWING US +IFE ITS,[ + SKIPN MULTSG + JRST FIXMLT + HRRZ D,B ; this codes gets us running in the correct + ; segment + ASH D,PGSHFT + HRRI D,FIXMLT + MOVEI C,0 + XJRST C ; good bye cruel segment (will work if we fell + ; into segment 0) +FIXMLT: ASH B,PGSHFT ; aobjn to program + +FIX1: SKIPL E,(A) ; read one hopefully squoze + FATAL ATTEMPT TO TYPE FIX PURE + TLZ E,740000 + +NOPV1: PUSHJ P,SQUTOA ; look it up + FATAL BAD FIXUPS + +; N.B. THE VALUE IN THE FIXUPS FOR AN ADDRESS CAN BE NEGATIVE. IF THIS HAPPENS +; IT MEANS THAT THE LEFT HALF CONTAINS THE VALUE INSTEAD OF THE RIGHT HALF +NOPV2: AOBJP A,FIX2 + HLRZ D,(A) ; get old value + HRRZS E + SUBM E,D ; D is diff between old and new + HRLM E,(A) ; fixup the fixups +NOPV3: MOVEI 0,0 ; flag for which half +FIX4: JUMPE 0,FIXRH ; jump if getting rh + MOVEI 0,0 ; next time will get rh + AOBJP A,FIX2 ; done? + HLRE C,(A) ; get lh + JUMPE C,FIX3 ; 0 terminates +FIX5: SKIPGE C ; If C is negative then left half garbage + JRST FIX6 + ADDI C,(B) ; access the code + +NOPV4: ADDM D,-1(C) ; and fix it up + JRST FIX4 + +; FOR LEFT HALF CASE + +FIX6: MOVNS C ; GET TO ADRESS + ADDI C,(B) ; ACCESS TO CODE + HLRZ E,-1(C) ; GET OUT WORD + ADDM D,E ; FIX IT UP + HRLM E,-1(C) + JRST FIX4 + +FIXRH: MOVEI 0,1 ; change flag + HRRE C,(A) ; get it and + JUMPN C,FIX5 + +FIX3: AOBJN A,FIX1 ; do next one + +IFN SPCFXU,[ + MOVE C,B + PUSHJ P,SFIX +] + PUSHJ P,SQUKIL ; KILL SQUOZE TABLE + SETZM INPLOD +FIX2: + HRRZS VER(P) ; INDICATE SAV FILE + MOVEM B,CADDR(P) + PUSHJ P,GENVN + HRRM B,VER(P) + PUSHJ P,OPWFIL + FATAL MAP FIXUP LOSSAGE +IFN ITS,[ + MOVE B,CADDR(P) + .IOT MAPCH,B ; write out the goodie + .CLOSE MAPCH, + PUSHJ P,OPMFIL + FATAL WHERE DID THE FILE GO? + MOVE E,CADDR(P) + ASH E,-PGSHFT ; to page AOBJN + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, +] + + +IFE ITS,[ + MOVE A,DIRCHN ; GET JFN + MOVE B,CADDR(P) ; ready to write it out + HRLI B,444400 + HLRE C,CADDR(P) + SOUT ; zap it out + TLO A,400000 ; dont recycle the JFN + CLOSF + JFCL + ANDI A,-1 ; kill sign bit + MOVE B,[440000,,240000] + OPENF + FATAL MAP FIXUP LOSSAGE + MOVE B,CADDR(P) + ASH B,-PGSHFT ; aobjn to pages + HLRE D,B ; -count + HRLI B,.FHSLF + MOVSI A,(A) + MOVSI C,PM%RD+PM%EX + PMAP + ADDI A,1 + ADDI B,1 + AOJN D,.-3 +] + + SKIPGE MUDSTR+2 + JRST EFIX2 ; exp vers, dont write out +IFE ITS,[ + HRRZ A,SJFNS ; get last jfn from savxxx file + JUMPE A,.+4 ; oop + CAME A,MAPJFN + CLOSF ; close it + JFCL + HLLZS SJFNS ; zero the slot +] + MOVEI 0,1 ; INDICATE FIXUP + HRLM 0,VER(P) + PUSHJ P,OPWFIL + FATAL CANT WRITE FIXUPS + +IFN ITS,[ + MOVE E,(TP) + HLRE A,E ; get length + MOVNS A + ADDI A,2 ; account for these 2 words + MOVE 0,[-2,,A] ; write version and length + .IOT MAPCH,0 + .IOT MAPCH,E ; out go the fixups + SETZB 0,A + MOVEI B,MAPCH + .CLOSE MAPCH, +] + +IFE ITS,[ + MOVE A,DIRCHN + HLRE B,(TP) ; length of fixup vector + MOVNS B + ADDI B,2 ; for length and version words + BOUT + PUSHJ P,GENVN + BOUT + MOVSI B,444400 ; byte pointer to fixups + HRR B,(TP) + HLRE C,(TP) + SOUT + CLOSF + JFCL +] + +EFIX2: MOVE B,CADDR(P) + ASH B,-PGSHFT + JRST PLOAD1 + +; Here to try to get a free page block for new thing +; A/ # of pages to get + +ALOPAG: MOVE C,GCSTOP ; FOOL GETPAG + ADDI C,3777 + ASH C,-PGSHFT + MOVE B,PURBOT +IFE ITS,[ + SKIPN MULTSG ; skip if multi-segments + JRST ALOPA1 +; Compute the "highest" PURBOT (i.e. find the least busy segment) + + PUSH P,E + PUSH P,A + MOVN A,NSEGS ; aobjn pntr to table + HRLZS A + MOVEI B,0 +ALOPA3: CAML B,PURBTB(A) ; if this one is larger + JRST ALOPA2 + MOVE B,PURBTB(A) ; use it + MOVEI E,FSEG(A) ; and the segment # +ALOPA2: AOBJN A,ALOPA3 + POP P,A +] + +ALOPA1: ASH B,-PGSHFT + SUBM B,C ; SEE IF ROOM + CAIL C,(A) + JRST ALOPGW + PUSHJ P,GETPAX ; try to get enough pages +IFE ITS, JRST EPOPJ +IFN ITS, POPJ P, + +ALOPGW: +IFN ITS, AOS (P) ; won skip return +IFE ITS,[ + SKIPE MULTSG + AOS -1(P) ; ret addr + SKIPN MULTSG + AOS (P) +] + MOVE 0,PURBOT +IFE ITS,[ + SKIPE MULTSG + MOVE 0,PURBTB-FSEG(E) +] + ASH 0,-PGSHFT + SUBI 0,(A) + MOVE B,0 +IFE ITS,[ + SKIPN MULTSG + JRST ALOPW1 + ASH 0,PGSHFT + HRRZM 0,PURBTB-FSEG(E) + ASH E,PGSHFT ; INTO POSITION + IORI B,(E) ; include segment in address + POP P,E + JRST ALOPW2 +] +ALOPW1: ASH 0,PGSHFT +ALOPW2: CAMGE 0,PURBOT + MOVEM 0,PURBOT + CAML 0,P.TOP + POPJ P, +IFE ITS,[ + SUBI 0,1777 + ANDCMI 0,1777 +] + MOVEM 0,P.TOP + POPJ P, + +EPOPJ: SKIPE MULTSG + POP P,E + POPJ P, +IFE ITS,[ +GETPAX: TDZA B,B ; here if other segs ok +GETPAG: MOVEI B,1 ; here for only main segment + JRST @[.+1] ; run in sect 0 + MOVNI E,1 +] +IFN ITS,[ +GETPAX: +GETPAG: +] + MOVE C,P.TOP ; top of GC space + ASH C,-PGSHFT ; to page number +IFE ITS,[ + SKIPN MULTSG + JRST GETPA9 + JUMPN B,GETPA9 ; if really wan all segments, + ; must force all to be free + PUSH P,A + MOVN A,NSEGS ; aobjn pntr to table + HRLZS A + MOVE B,P.TOP +GETPA8: CAMLE B,PURBTB(A) ; if this one is larger (or the same) + JRST GETPA7 + MOVE B,PURBTB(A) ; use it + MOVEI E,FSEG(A) ; and the segment # +GETPA7: AOBJN A,GETPA8 + POP P,A + JRST .+2 +] +GETPA9: MOVE B,PURBOT + ASH B,-PGSHFT ; also to pages + SUBM B,C ; pages available ==> C + CAMGE C,A ; skip if have enough already + JRST GETPG1 ; no, try to shuffle around + SUBI B,(A) ; B/ first new page +CPOPJ1: AOS (P) +IFN ITS, POPJ P, +IFE ITS,[ +SPOPJ: SKIPN MULTSG + POPJ P, ; return with new free page in B + ; (and seg# in E?) + POP P,21 + SETZM 20 + XJRST 20 +] +; Here if shuffle must occur or gc must be done to make room + +GETPG1: MOVEI 0,0 + SKIPE NOSHUF ; if can't shuffle, then ask gc + JRST ASKAGC + MOVE 0,PURTOP ; get top of mapped pure area + SUB 0,P.TOP + ASH 0,-PGSHFT ; to pages + CAMGE 0,A ; skip if winnage possible + JRST ASKAGC ; please AGC give me some room!! + SUBM A,C ; C/ amount we must flush to make room + +IFE ITS,[ + SKIPE MULTSG ; if multi and getting in all segs + JUMPL E,LPGL1 ; check out each and every segment + + PUSHJ P,GL1 + + SKIPE MULTSG + PUSHJ P,PURTBU ; update PURBOT in multi case + + JRST GETPAX + +LPGL1: PUSH P,A + PUSH P,[FSEG-1] + +LPGL2: AOS E,(P) ; count segments + MOVE B,NSEGS + ADDI B,FSEG + CAML E,B + JRST LPGL3 + PUSH P,C + MOVE C,PURBOT ; fudge so look for appropriate amt + SUB C,PURBTB-FSEG(E) + ASH C,-PGSHFT ; to pages + ADD C,(P) + SKIPLE C ; none to flush + PUSHJ P,GL1 + HRRZ E,-1(P) ; fet section again + HRRZ B,PURBOT + HRRZ C,PURBTB-FSEG(E) ; lets share with 0 again + SUB C,B + HRL B,E ; get segment + MOVEI A,(B) + ASH B,-PGSHFT + ASH A,-PGSHFT + HRLI A,.FHSLF + HRLI B,.FHSLF + ASH C,-PGSHFT + HRLI C,PM%CNT+PM%RD+PM%WR+PM%EX + PMAP +LPGL4: POP P,C + JRST LPGL2 + +LPGL3: SUB P,C%11 + POP P,A + + SKIPE MULTSG + PUSHJ P,PURTBU ; update PURBOT in multi case + + JRST GETPAG +] +; Here to find pages for flush using LRU algorithm (in multi seg mode, only +; care about the segment in E) + +GL1: MOVE B,PURVEC+1 ; get pointer to pure sr vector + MOVEI 0,-1 ; get very large age + +GL2: SKIPL FB.PTR(B) ; skip if not already flushed + JRST GL3 +IFE ITS,[ + SKIPN MULTSG + JRST GLX + LDB D,[220500,,FB.PTR(B)] ; get segment # + CAIE D,(E) + JRST GL3 ; wrong swegment, ignore +] +GLX: HLRZ D,FB.AGE(B) ; get this ones age + CAMLE D,0 ; skip if this is a candidate + JRST GL3 + MOVE F,B ; point to table entry with E + MOVEI 0,(D) ; and use as current best +GL3: ADD B,[ELN,,ELN] ; look at next + JUMPL B,GL2 + + HLRE B,FB.PTR(F) ; get length of flushee + ASH B,-PGSHFT ; to negative # of pages + ADD C,B ; update amount needed +IFN ITS,SETZM FB.PTR(F) ; indicate it will be gone +IFE ITS,MOVNS FB.PTR(F) ; save page info for flushing pages + JUMPG C,GL1 ; jump if more to get + +; Now compact pure space + + PUSH P,A ; need all acs + HRRZ D,PURVEC ; point to first in core addr order + HRRZ C,PURTOP +IFE ITS,[ + SKIPE MULTSG + HRLI C,(E) ; adjust for segment +] + ASH C,-PGSHFT ; to page number + SETZB F,A + +CL1: ADD D,PURVEC+1 ; to real pointer + SKIPGE FB.PTR(D) ; skip if this one is a flushee + JRST CL2 ; this one stays + +IFE ITS,[ + PUSH P,C + PUSH P,D + HRRZ C,FB.PGS(D) ; is this from SAV FILE? + JUMPN C,CLFOUT ; yes. don't bother flushing pages + MOVN C,FB.PTR(D) ; get aobjn pointer to code in C + SETZM FB.PTR(D) ; and flush this because it works (sorry) + ASH C,-PGSHFT ; pages speak louder than words + HLRE D,C ; # of pages saved here for unmap + HRLI C,.FHSLF ; C now contains myfork,,lowpage + MOVE A,C ; put that in A for RMAP + RMAP ; A now contains JFN in left half + MOVE B,C ; ac roulette: get fork,,page into B for PMAP + HLRZ C,A ; hold JFN in C for future CLOSF + MOVNI A,1 ; say this page to be unmapped +CLFLP: PMAP ; do the unmapping + ADDI B,1 ; next page + AOJL D,CLFLP ; continue for all pages + MOVE A,C ; restore JFN + CLOSF ; and close it, throwing away the JFN + JFCL ; should work in 95/100 cases +CLFOU1: POP P,D ; fatal error if can't close + POP P,C +] + HRRZ D,FB.AGE(D) ; point to next one in chain + JUMPN F,CL3 ; jump if not first one + HRRM D,PURVEC ; and use its next as first + JRST CL4 + +IFE ITS,[ +CLFOUT: SETZM FB.PTR(D) ; zero the code pointer + JRST CLFOU1 +] + +CL3: HRRM D,FB.AGE(F) ; link up + JRST CL4 + +; Found a stayer, move it if necessary + +CL2: +IFE ITS,[ + SKIPN MULTSG + JRST CL9 + LDB F,[220500,,FB.PTR(D)] ; check segment + CAIE E,(F) + JRST CL6X ; no other segs move at all +] +CL9: MOVEI F,(D) ; another pointer to slot + HLRE B,FB.PTR(D) ; - length of block +IFE ITS,[ + TRZ B,<-1>#<(FB.CNT)> + MOVE D,FB.PTR(D) ; pointer to block + TLZ D,(FB.CNT) ; kill count bits +] +IFN ITS, HRRZ D,FB.PTR(D) + SUB D,B ; point to top of block + ASH D,-PGSHFT ; to page number + CAMN D,C ; if not moving, jump + JRST CL6 + + ASH B,-PGSHFT ; to pages +IFN ITS,[ +CL5: SUBI C,1 ; move to pointer and from pointer + SUBI D,1 + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],C,[1000,,-1],D] + .LOSE %LSSYS + AOJL B,CL5 ; count down +] +IFE ITS,[ + PUSH P,B ; save # of pages + MOVEI A,-1(D) ; copy from pointer + HRLI A,.FHSLF ; get this fork code + RMAP ; get a JFN (hopefully) + EXCH D,(P) ; D # of pages (save from) + ADDM D,(P) ; update from + MOVEI B,-1(C) ; to pointer in B + HRLI B,.FHSLF + MOVSI C,PM%RD+PM%EX ; read/execute modes + + SKIPN OPSYS + JRST CCL1 + PMAP ; move a page + SUBI A,1 + SUBI B,1 + AOJL D,.-3 ; move them all + AOJA B,CCL2 + +CCL1: TLO C,PM%CNT + MOVNS D + SUBI B,-1(D) + SUBI A,-1(D) + HRRI C,(D) + PMAP + +CCL2: MOVEI C,(B) + POP P,D +] +; Update the table address for this loser + + SUBM C,D ; compute offset (in pages) + ASH D,PGSHFT ; to words + ADDM D,FB.PTR(F) ; update it +CL7: HRRZ D,FB.AGE(F) ; chain on +CL4: TRNN D,EOC ; skip if end of chain + JRST CL1 + + ASH C,PGSHFT ; to words +IFN ITS, MOVEM C,PURBOT ; reset pur bottom +IFE ITS,[ + SKIPN MULTSG + JRST CLXX + + HRRZM C,PURBTB-FSEG(E) + CAIA +CLXX: MOVEM C,PURBOT ; reset pur bottom +] + POP P,A + POPJ P, + +IFE ITS,[ +CL6X: MOVEI F,(D) ; chain on + JRST CL7 +] +CL6: +IFN ITS, HRRZ C,FB.PTR(F) ; get new top of world +IFE ITS,[ + MOVE C,FB.PTR(F) + TLZ C,(FB.CNT) +] + ASH C,-PGSHFT ; to page # + JRST CL7 + +IFE ITS,[ +PURTBU: PUSH P,A + PUSH P,B + + MOVN B,NSEGS + HRLZS B + MOVE A,PURTOP + +PURTB2: CAMGE A,PURBTB(B) + JRST PURTB1 + MOVE A,PURBTB(B) + MOVEM A,PURBOT +PURTB1: AOBJN B,PURTB2 + + POP P,B + POP P,A + POPJ P, +] + + ; SUBR to create an entry in the vector for one of these guys + +MFUNCTION PCODE,SUBR + + ENTRY 2 + + GETYP 0,(AB) ; check 1st arg is string + CAIE 0,TCHSTR + JRST WTYP1 + GETYP 0,2(AB) ; second must be fix + CAIE 0,TFIX + JRST WTYP2 + + MOVE A,(AB) ; convert name of program to sixbit + MOVE B,1(AB) + PUSHJ P,STRTO6 +PCODE4: MOVE C,(P) ; get name in sixbit + +; Now look for either this one or an empty slot + + MOVEI E,0 + MOVE B,PURVEC+1 + +PCODE2: CAMN C,FB.NAM(B) ; skip if this is not it + JRST PCODE1 ; found it, drop out of loop + JUMPN E,.+3 ; dont record another empty if have one + SKIPN FB.NAM(B) ; skip if slot filled + MOVE E,B ; remember pointer + ADD B,[ELN,,ELN] + JUMPL B,PCODE2 ; jump if more to look at + + JUMPE E,PCODE3 ; if E=0, error no room + MOVEM C,FB.NAM(E) ; else stash away name and zero rest + SETZM FB.PTR(E) + SETZM FB.AGE(E) + CAIA +PCODE1: MOVE E,B ; build ,, + MOVEI 0,0 ; flag whether new slot + SKIPE FB.PTR(E) ; skip if mapped already + MOVEI 0,1 + MOVE B,3(AB) + HLRE D,E + HLRE E,PURVEC+1 + SUB D,E + HRLI B,(D) + MOVSI A,TPCODE + SKIPN NOSHUF ; skip if not shuffling + JRST FINIS + JUMPN 0,FINIS ; jump if winner + PUSH TP,A + PUSH TP,B + HLRZ A,B + PUSHJ P,PLOAD + JRST PCOERR + POP TP,B + POP TP,A + JRST FINIS + +PCOERR: ERRUUO EQUOTE PURE-LOAD-FAILURE + +PCODE3: HLRE A,PURVEC+1 ; get current length + MOVNS A + ADDI A,10*ELN ; add 10(8) more entry slots + PUSHJ P,IBLOCK + EXCH B,PURVEC+1 ; store new one and get old + HLRE A,B ; -old length to A + MOVSI B,(B) ; start making BLT pointer + HRR B,PURVEC+1 + SUBM B,A ; final dest to A +IFE ITS, HRLI A,-1 ; force local index + BLT B,-1(A) + JRST PCODE4 + +; Here if must try to GC for some more core + +ASKAGC: SKIPE GCFLG ; if already in GC, lose +IFN ITS, POPJ P, +IFE ITS, JRST SPOPJ + MOVEM A,0 ; amount required to 0 + ASH 0,PGSHFT ; TO WORDS + MOVEM 0,GCDOWN ; pass as funny arg to AGC + EXCH A,C ; save A from gc's destruction +IFN ITS,.IOPUSH MAPCH, ; gc uses same channel + PUSH P,C + SETOM PLODR + MOVE C,[8,,9.] ; SET UP INDICATORS FOR GC + PUSHJ P,AGC + SETZM PLODR + POP P,C +IFN ITS,.IOPOP MAPCH, + EXCH C,A +IFE ITS,[ + JUMPL C,.+3 + JUMPL E,GETPAG + JRST GETPAX +] +IFN ITS, JUMPGE C,GETPAG + ERRUUO EQUOTE NO-MORE-PAGES + +; Here to clean up pure space by flushing all shared stuff + +PURCLN: SKIPE NOSHUF + POPJ P, + MOVEI B,EOC + HRRM B,PURVEC ; flush chain pointer + MOVE B,PURVEC+1 ; get pointer to table +CLN1: SETZM FB.PTR(B) ; zero pointer entry + SETZM FB.AGE(B) ; zero link and age slots + SETZM FB.PGS(B) + ADD B,[ELN,,ELN] ; go to next slot + JUMPL B,CLN1 ; do til exhausted + MOVE B,PURBOT ; now return pages + SUB B,PURTOP ; compute page AOBJN pointer +IFE ITS, SETZM MAPJFN ; make sure zero mapjfn + JUMPE B,CPOPJ ; no pure pages? + MOVSI B,(B) + HRR B,PURBOT + ASH B,-PGSHFT +IFN ITS,[ + DOTCAL CORBLK,[[1000,,0],[1000,,-1],B] + .LOSE %LSSYS +] +IFE ITS,[ + + SKIPE MULTSG + JRST CLN2 + HLRE D,B ; - # of pges to flush + HRLI B,.FHSLF ; specify hacking hom fork + MOVNI A,1 + MOVEI C,0 + + PMAP + ADDI B,1 + AOJL D,.-2 +] + + MOVE B,PURTOP ; now fix up pointers + MOVEM B,PURBOT ; to indicate no pure +CPOPJ: POPJ P, + +IFE ITS,[ +CLN2: HLRE C,B ; compute pos no. pages + HRLI B,.FHSLF + MOVNS C + MOVNI A,1 ; flushing pages + HRLI C,PM%CNT + MOVE D,NSEGS + MOVE E,PURTOP ; for munging table + ADDI B,_9. ; do it to the correct segment + PMAP + ADDI B,1_9. ; cycle through segments + HRRZM E,PURBTB(D) ; mung table + SOJG D,.-3 + + MOVEM E,PURBOT + POPJ P, +] + +; Here to move the entire pure space. +; A/ # and direction of pages to move (+ ==> up) + +MOVPUR: SKIPE NOSHUF + FATAL CANT MOVE PURE SPACE AROUND +IFE ITS,ASH A,1 + SKIPN B,A ; zero movement, ignore call + POPJ P, + + ASH B,PGSHFT ; convert to words for pointer update + MOVE C,PURVEC+1 ; loop through updating non-zero entries + SKIPE 1(C) + ADDM B,1(C) + ADD C,[ELN,,ELN] + JUMPL C,.-3 + + MOVE C,PURTOP ; found pages at top and bottom of pure + ASH C,-PGSHFT + MOVE D,PURBOT + ASH D,-PGSHFT + ADDM B,PURTOP ; update to new boundaries + ADDM B,PURBOT +IFE ITS,[ + SKIPN MULTSG ; in multi-seg mode, must mung whole table + JRST MOVPU1 + MOVN E,NSEGS + HRLZS E + ADDM PURBTB(E) + AOBJN E,.-1 +] +MOVPU1: CAIN C,(D) ; differ? + POPJ P, + JUMPG A,PUP ; if moving up, go do separate CORBLKs + +IFN ITS,[ + SUBM D,C ; -size of area to C (in pages) + MOVEI E,(D) ; build pointer to bottom of destination + ADD E,A + HRLI E,(C) + HRLI D,(C) + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,-1],D] + .LOSE %LSSYS + POPJ P, + +PUP: SUBM C,D ; pages to move to D + ADDI A,(C) ; point to new top + +PUPL: SUBI C,1 + SUBI A,1 + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,-1],C] + .LOSE %LSSYS + SOJG D,PUPL + POPJ P, +] +IFE ITS,[ + SUBM D,C ; pages to move to D + MOVSI E,(C) ; build aobjn pointer + HRRI E,(D) ; point to lowest + ADD D,A ; D==> new lowest page + MOVEI F,0 ; seg info + SKIPN MULTSG + JRST XPLS3 + MOVEI F,FSEG-1 + ADD F,NSEGS + ASH F,9. +XPLS3: MOVE G,E + MOVE H,D ; save for outer loop + +PURCL1: MOVSI A,.FHSLF ; specify here + HRRI A,(E) ; get a page + IORI A,(F) ; hack seg i + RMAP ; get a real handle on it + MOVE B,D ; where to go + HRLI B,.FHSLF + MOVSI C,PM%RD+PM%EX + IORI A,(F) + PMAP + ADDI D,1 + AOBJN E,PURCL1 + SKIPN MULTSG + POPJ P, + SUBI F,1_9. + CAIGE F,FSEG_9. + POPJ P, + MOVE E,G + MOVE D,H + JRST PURCL1 + +PUP: SUB D,C ; - count to D + MOVSI E,(D) ; start building AOBJN + HRRI E,(C) ; aobjn to top + ADD C,A ; C==> new top + MOVE D,C + MOVEI F,0 ; seg info + SKIPN MULTSG + JRST XPLS31 + MOVEI F,FSEG + ADD F,NSEGS + ASH F,9. +XPLS31: MOVE G,E + MOVE H,D ; save for outer loop + +PUPL: MOVSI A,.FHSLF + HRRI A,(E) + IORI A,(F) ; segment + RMAP ; get real handle + MOVE B,D + HRLI B,.FHSLF + IORI B,(F) + MOVSI C,PM%RD+PM%EX + PMAP + SUBI E,2 + SUBI D,1 + AOBJN E,PUPL + SKIPN MULTSG + POPJ P, + SUBI F,1_9. + CAIGE F,FSEG_9. + POPJ P, + MOVE E,G + MOVE D,H + JRST PUPL + + POPJ P, +] +IFN ITS,[ +.GLOBAL CSIXBT +CSIXBT: MOVEI 0,5 + PUSH P,[440700,,C] + PUSH P,[440600,,D] + MOVEI D,0 +CSXB2: ILDB E,-1(P) + CAIN E,177 + JRST CSXB1 + SUBI E,40 + IDPB E,(P) + SOJG 0,CSXB2 +CSXB1: SUB P,C%22 + MOVE C,D + POPJ P, +] +GENVN: MOVE C,[440700,,MUDSTR+2] + MOVEI D,5 + MOVEI B,0 +VNGEN: ILDB 0,C + CAIN 0,177 + POPJ P, + IMULI B,10. + SUBI 0,60 + ADD B,0 + SOJG D,VNGEN + POPJ P, + +IFE ITS,[ +MSKS: 774000,,0 + 777760,,0 + 777777,,700000 + 777777,,777400 + 777777,,777776 +] + + ; THESE ARE DIRECTORY SEARCH ROUTINES + + +; THIS ROUTINE DOES A BINARY SEARCH ON A DIRECTORY AND RETURNS A POINTER +; RESTED DOWN TO THE APPROPRIATE SLOT IN THE DIRECTORY. +; ARGS: E==DIR POINTER D==FILE-NAME 1 A==VERSION # +; RETS: A==RESTED DOWN DIRECTORY + +DIRSR1: TLOA 0,400000 ; INDICATION OF ONE ARGUMENT SEARCH +DIRSRC: TLZ 0,400000 ; INDICATOR OF 2 ARGUMENT SEARCH + PUSH P,A ; SAVE VERSION # + HLRE B,E ; GET LENGTH INTO B + MOVNS B + MOVE A,E + HRLS B ; GET BOTH SIDES +UP: ASH B,-1 ; HALVE TABLE + AND B,[-2,,-2] ; FORCE DIVIS BY 2 + MOVE C,A ; COPY POINTER + JUMPLE B,LSTHLV ; CANT GET SMALLER + ADD C,B +IFE ITS, HRRZ F,C ; avoid lossage in multi-sections +IFN ITS, CAMLE D,(C) ; SKIP IF EITHER FOUND OR IN TOP +IFE ITS, CAMLE D,(F) ; SKIP IF EITHER FOUND OR IN TOP + MOVE A,C ; POINT TO SECOND HALF +IFN ITS, CAMN D,(C) ; SKIP IF NOT FOUND +IFE ITS, CAMN D,(F) ; SKIP IF NOT FOUND + JRST WON +IFN ITS, CAML D,(C) ; SKIP IF IN TOP HALF +IFE ITS, CAML D,(F) ; SKIP IF IN TOP HALF + JRST UP + HLLZS C ; FIX UP POINTER + SUB A,C + JRST UP + +WON: JUMPL 0,SUPWIN + MOVEI 0,0 ; DOWN FLAG +WON1: LDB A,[221200,,1(C)] ; GET VERSION NUMBER + CAMN A,(P) ; SKIP IF NOT EQUAL + JRST SUPWIN + CAMG A,(P) ; SKIP IF LT + JRST SUBIT + SETO 0, + SUB C,C%22 ; GET NEW C + JRST SUBIT1 + +SUBIT: ADD C,C%22 ; SUBTRACT + JUMPN 0,C1POPJ +SUBIT1: +IFN ITS, CAMN D,(C) ; SEE WHETHER WERE STILL WINNING +IFE ITS,[ + HRRZ F,C + CAMN D,(F) +] + JRST WON1 +C1POPJ: SUB P,C%11 ; GET RID OF VERSION # + POPJ P, ; LOSE LOSE LOSE +SUPWIN: MOVE A,C ; RETURN ARGUMENT IN A + AOS -1(P) ; SKIP RETURN INDICATES IT WAS FOUND + JRST C1POPJ + +LSTHLV: +IFN ITS, CAMN D,(C) ; LINEAR SEARCH REST +IFE ITS,[ + HRRZ F,C + CAMN D,(F) ; LINEAR SEARCH REST +] + JRST WON + ADD C,C%22 + JUMPL C,LSTHLV + JRST C1POPJ + + ; ROUTINE TO GET A DIRECTORY. ASSUMES MAPCH IS OPEN TO FIXUP OR SAV FILE AND 0 IS THE +; LAST CHAR TO BE HASHED. RETURNS POINTER TO DIRECTORY IN E + +IFN ITS,[ +GETDIR: PUSH P,C + PUSH P,0 + PUSHJ P,SQKIL + MOVEI A,1 ; GET A BUFFER + PUSHJ P,GETBUF + MOVEI C,(B) + ASH C,-10. + DOTCAL CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],[1000,,0]] + PUSHJ P,SLEEPR + POP P,0 + IDIV 0,(B) ; A NOW CONTAINS THE DIRECTORY NUMBER + ADDI A,1(B) + DOTCAL CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],(A)] + PUSHJ P,SLEEPR + MOVN E,(B) ; GET -LENGTH OF DIRECTORY + HRLZS E ; BUILD AOBJN PTR TO DIR + HRRI E,1(B) + POP P,C + POPJ P, +] +; IN WONDERFUL TOPS20 VERSION DIRCHN CONTAINS THE JFN + +IFE ITS,[ +GETDIR: JRST @[.+1] + PUSH P,C + PUSH P,0 + PUSHJ P,SQKIL + MOVEI A,1 ; GET A BUFFER + PUSHJ P,GETBUF + HRROI E,(B) + ASH B,-9. + HRLI B,.FHSLF ; SET UP DESTINATION (CORE) + MOVS A,DIRCHN ; SET UP SOURCE (FILE) + MOVSI C,PM%RD+PM%EX ; READ+EXEC ACCESS + PMAP + POP P,0 + IDIV 0,(E) ; A NOW CONTAINS THE DIRECTORY NUMBER + ADDI A,1(E) ; POINT TO THE DIRECTORY ENTRY + MOVE A,(A) ; GET THE PAGE NUMBER + HRL A,DIRCHN ; SET UP SOURCE (FILE) + PMAP ; AGAIN READ IN DIRECTORY + MOVEI A,(E) + MOVN E,(E) ; GET -LENGTH OF DIRECTORY + HRLZS E ; BUILD AOBJN PTR TO DIR + HRRI E,1(A) + POP P,C + SKIPN MULTSG + POPJ P, + POP P,21 + SETZM 20 + XJRST 20 +] +; HERE IF CAN'T FIND FIXUP FILE IN MAIN DIRECTORY + +NOFXUP: +IFE ITS,[ + MOVE A,DIRCHN ; JFN FOR FIXUP FILE + CLOSF ; CLOSE IT + JFCL +] + MOVE A,FXTBL ; GET AOBJN POINTER TO FIXUP TABLE +NOFXU1: HRRZ B,(A) ; GET VERSION TO TRY + HRRM B,VER(P) ; STUFF IN VERSION + MOVEI B,1 ; DUMP IN FIXUP INDICATOR + HRLM B,VER(P) + MOVEM A,TEMP(P) ; SAVE POINTER TO FXTBL + PUSHJ P,OPXFIL ; LOOK FOR FIXUP FILE + JRST NOFXU2 + PUSHJ P,RFXUP ; READ IN THE FIXUP FILE + HRRZS VER(P) ; INDICATE SAV FILE + PUSHJ P,OPXFIL ; TRY OPENING IT + JRST MAPLS0 ; GIVE UP NO SAV FILE TO BE HAD + PUSHJ P,RSAV + JRST FXUPGO ; GO FIXUP THE WORLD +NOFXU2: MOVE A,TEMP(P) ; GET BACK POINTER + AOBJN A,NOFXU1 ; TRY NEXT + JRST MAPLS1 ; NO FILE TO BE HAD + +GETIT: HRRZM B,SPAG(P) ; GET BLOCK OF START + HLRZM B,FLEN(P) ; DAMMIT SAVE THIS! + HLRZ A,B ; GET LENGTH +IFN ITS,[ + .CALL MNBLK + PUSHJ P,TRAGN +] +IFE ITS,[ + MOVE E,MAPJFN + MOVEM E,DIRCHN +] + + JRST PLOD1 + +; ROUTINE TO SEE IF FILE IS NOT OPEN BECAUSE OF FNF AND FATAL IF SO + +IFN ITS,[ +TRAGN: PUSH P,0 ; SAVE 0 + .STATUS MAPCH,0 ; GET STATUS BITS + LDB 0,[220600,,0] + CAIN 0,4 ; SKIP IF NOT FNF + FATAL MAJOR FILE NOT FOUND + POP P,0 + SOS (P) + SOS (P) ; RETRY OPEN + POPJ P, +] +IFE ITS,[ +OPSAV: MOVSI A,%GJSHT+%GJOLD ; BITS FOR GTJFN + HRROI B,SAVSTR ; STRING POINTER + SKIPE OPSYS + HRROI B,TSAVST + GTJFN + FATAL CANT FIND SAV FILE + MOVEM A,MAPJFN ; STORE THE JFN + MOVE B,[440000,,OF%RD+OF%EX+OF%THW+OF%DUD] + OPENF + FATAL CANT OPEN SAV FILE + POPJ P, +] + +; OPMFIL IS USED TO OPEN A FILE ON MUDTMP. IT CAN OPEN EITHER A SAV OR FIXUP FILE +; AND THE VERSION NUMBER IS SPECIFIED. THE ARGUMENTS ARE +; NAM-1(P) HAS SIXBIT OF FILE NAME +; VER-1(P) HAS 0,,VERSION # FOR SAV FILE AND 1,,VERSION# FOR FIXUP FILE +; RETURNS LENGTH OF FILE IN SLEN AND + +; OPXFIL IS A KLUDGE FOR GETTING SAV AND FIXUP FILES OFF OF THE MDLLIB +; DIRECTORY DURING THE CHANGEOVER TO PRE- AND POST- MUDSAV WORLDS + +OPXFIL: MOVEI 0,1 + MOVEM 0,WRT-1(P) + JRST OPMFIL+1 + +OPWFIL: SETOM WRT-1(P) + SKIPA +OPMFIL: SETZM WRT-1(P) + +IFN ITS,[ + HRRZ C,VER-1(P) ; GET VERSION NUMBER + PUSHJ P,NTOSIX ; CONVERT TO SIXBIT + HRLI C,(SIXBIT /SAV/) ; BUILD SECOND FILE NAME + HLRZ 0,VER-1(P) + SKIPE 0 ; SKIP IF SAV + HRLI C,(SIXBIT/FIX/) + MOVE B,NAM-1(P) ; GET NAME + MOVSI A,7 ; WRITE MODE + SKIPL WRT-1(P) + MOVSI A,6 ; READ MODE +RETOPN: .CALL FOPBLK + JRST OPCHK ; SEE IF FIXUP IS NECESSARY OR JUST REOPENING + DOTCAL FILLEN,[[1000,,MAPCH],[2000,,A]] + .LOSE 1000 + ADDI A,PGMSK ; ROUND + ASH A,-PGSHFT ; TO PAGES + MOVEM A,FLEN-1(P) + SETZM SPAG-1(P) + AOS (P) ; SKIP RETURN TO SHOW SUCCESS + POPJ P, + +OPCHK: .STATUS MAPCH,0 ; GET STATUS BITS + LDB 0,[220600,,0] + CAIE 0,4 ; SKIP IF FNF + JRST OPCHK1 ; RETRY + POPJ P, + +OPCHK1: MOVEI 0,1 ; SLEEP FOR A WHILE + .SLEEP + JRST OPCHK + +; NTOSIX GETS NUMBER IN C AND CONVERTS IT TO SIXBIT AND RETURNS RESULT IN C + +NTOSIX: PUSH P,A ; SAVE A AND B + PUSH P,B + PUSH P,D + MOVE D,[220600,,C] + MOVEI A,(C) ; GET NUMBER + MOVEI C,0 + IDIVI A,100. ; GET RESULT OF DIVISION + SKIPN A + JRST ALADD + ADDI A,20 ; CONVERT TO DIGIT + IDPB A,D +ALADD: MOVEI A,(B) + IDIVI A,10. ; GET TENS DIGIT + SKIPN C + SKIPE A ; IF BOTH 0 BLANK DIGIT + ADDI A,20 + IDPB A,D + SKIPN C + SKIPE B + ADDI B,20 + IDPB B,D + POP P,D + POP P,B + POP P,A + POPJ P, + +] + +IFE ITS,[ + MOVE E,P ; save pdl base + MOVE B,NAM-1(E) ; GET FIRST NAME + PUSH P,C%0 ; [0]; slots for building strings + PUSH P,C%0 ; [0] + MOVE A,[440700,,1(E)] + MOVE C,[440600,,B] + +; DUMP OUT SIXBIT NAME + + MOVEI D,6 + ILDB 0,C + JUMPE 0,.+4 ; violate cardinal ".+ rule" + ADDI 0,40 ; to ASCII + IDPB 0,A + SOJG D,.-4 + + MOVE 0,[ASCII / SAV/] + HLRZ C,VER-1(E) ; GET SAV/FIXUP FLAG + SKIPE C + MOVE 0,[ASCII / FIX/] + PUSH P,0 + HRRZ C,VER-1(E) ; get ascii of vers no. + PUSHJ P,NTOSEV ; CONVERT TO STRING LEFT JUSTIFIED + PUSH P,C + MOVEI B,-1(P) ; point to it + HRLI B,260700 + HRROI D,1(E) ; point to name + MOVEI A,1(P) + MOVSI 0,100000 ; INPUT FILE (GJ%OLD) + SKIPGE WRT-1(E) + MOVSI 0,400000 ; OUTPUT FILE (GJ%FOU) + PUSH P,0 + PUSH P,[377777,,377777] + MOVE 0,[-1,,[ASCIZ /DSK/]] + SKIPN OPSYS + MOVE 0,[-1,,[ASCIZ /PS/]] + PUSH P,0 + HRROI 0,[ASCIZ /MDL/] + SKIPLE WRT-1(E) + HRROI 0,[ASCIZ /MDLLIB/] ; USE MDLLIB FOR SPECIAL CASE + PUSH P,0 + PUSH P,D + PUSH P,B + PUSH P,C%0 ; [0] + PUSH P,C%0 ; [0] + PUSH P,C%0 ; [0] + MOVEI B,0 + MOVE D,4(E) ; save final version string + GTJFN + JRST OPMLOS ; FAILURE + MOVEM A,DIRCHN + MOVE B,[440000,,OF%RD+OF%EX] + SKIPGE WRT-1(E) + MOVE B,[440000,,OF%RD+OF%WR] + OPENF + FATAL OPENF FAILED + MOVE P,E ; flush crap + PUSH P,A + SIZEF ; get length + JRST MAPLOS + SKIPL WRT-1(E) + MOVEM C,FLEN-1(E) ; ONLY SAVE LENGTH FOR READ JFNS + SETZM SPAG-1(E) + +; RESTORE STACK AND LEAVE + + MOVE P,E + MOVE A,C ; NUMBER OF PAGES IN A, DAMN! + AOS (P) + POPJ P, + +OPMLOS: MOVE P,E + POPJ P, + +; CONVERT A NUMBER IN C TO AN ASCII STRING LEFT JUSTIFIED IN C + +NTOSEV: PUSH P,A ; SAVE A AND B + PUSH P,B + PUSH P,D + MOVE D,[440700,,C] + MOVEI A,(C) ; GET NUMBER + MOVEI C,0 + IDIVI A,100. ; GET RESULT OF DIVISION + JUMPE A,ALADD + ADDI A,60 ; CONVERT TO DIGIT + IDPB A,D +ALADD: MOVEI A,(B) + IDIVI A,10. ; GET TENS DIGIT + ADDI A,60 + IDPB A,D +ALADD1: ADDI B,60 + IDPB B,D + POP P,D + POP P,B + POP P,A + POPJ P, + +] + +; ROUTINE TO READ IN THE FIXUPS FROM DIRCHN OR MAPCH WORKS +; FOR FIXUP FILE OR FIXUPS IN A SEPERATE FILE AS LONG AS THE +; CHANNEL IS OPENED AND ACCESSED TO THE RIGHT PLACE + +RFXUP: +IFN ITS,[ + MOVE 0,[-2,,A] ; PREPARE TO READ VERSION AND LENGTH + .IOT MAPCH,0 ; READ IT IN + SKIPGE 0 ; SKIP IF NOT HIT EOF + FATAL BAD FIXUP FILE + MOVEI A,-2(A) ; COUNT FOR FIRST 2 WORDS + HRRM B,VER-1(P) ; SAVE VERSION # + .IOPUS MAPCH, ; PUSH THE MAPPING CHANNEL + SETOM PLODR + PUSHJ P,IBLOCK ; GET A UVECTOR OF APPROPRIATE SIZE + SETZM PLODR + .IOPOP MAPCH, + MOVE 0,$TUVEC + MOVEM 0,-1(TP) ; SAVE UVECTOR + MOVEM B,(TP) + MOVE A,B ; GET AOBJN POINTER TO UVECTOR FOR IOT + .IOT MAPCH,A ; GET FIXUPS + .CLOSE MAPCH, + POPJ P, +] + +IFE ITS,[ + MOVE A,DIRCHN + BIN ; GET LENGTH OF FIXUP + MOVE C,B + MOVE A,DIRCHN + BIN ; GET VERSION NUMBER + HRRM B,VER-1(P) + SETOM PLODR + MOVEI A,-2(C) + PUSHJ P,IBLOCK + SETZM PLODR + MOVSI 0,$TUVEC + MOVEM 0,-1(TP) + MOVEM B,(TP) + MOVE A,DIRCHN + HLRE C,B +; SKIPE OPSYS ; SKIP IF TOPS20 SINCE C MUST BE NEGETIVE +; MOVNS C ; C IS POSITIVE FOR TENEX ????? + HRLI B,444400 + SIN + MOVE A,DIRCHN + CLOSF + FATAL CANT CLOSE FIXUP FILE + RLJFN + JFCL + POPJ P, +] + +; ROUTINE TO READ IN THE CODE + +RSAV: MOVE A,FLEN-1(P) + PUSHJ P,ALOPAG ; GET PAGES + JRST MAPLS2 + MOVE E,SPAG-1(P) + +IFN ITS,[ + MOVN A,FLEN-1(P) ; build aobjn pointer + MOVSI A,(A) + HRRI A,(B) + MOVE B,A + HRRI 0,(E) + DOTCAL CORBLK,[[1000,,104000],[1000,,-1],A,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, + POPJ P, +] +IFE ITS,[ + PUSH P,B ; SAVE PAGE # + MOVS A,DIRCHN ; SOURCE (MUDSAV) + HLRM A,SJFNS ; SAVE POINTER FOR FUTURE CLOSING + HRR A,E + HRLI B,.FHSLF ; DESTINATION (FORK) + MOVSI C,PM%RD+PM%CPY ; MAKE COPY ON WRITE + SKIPE OPSYS + JRST RSAV1 ; HANDLE TENEX + TLO C,PM%CNT ; REPEAT COUNT BIT FOR TOPS20 + HRR C,FLEN-2(P) ; PAGE (FOR PUSHJ AND PUSHED B) + PMAP +RSAVDN: POP P,B + MOVN 0,FLEN-1(P) + HRL B,0 + POPJ P, + +RSAV1: HRRZ D,FLEN-2(P) ; GET IN PAGE COUNT +RSAV2: PMAP + ADDI A,1 ; NEXT PAGE + ADDI B,1 + SOJN D,RSAV2 ; LOOP + JRST RSAVDN +] + +PDLOV: SUB P,[NSLOTS,,NSLOTS] + PUSH P,C%0 ; [0]; CAUSE A PDL OVERFLOW + JRST .-1 + +; CONSTANTS RELATED TO DATA BASE +DEV: SIXBIT /DSK/ +MODE: 6,,0 +MNDIR: SIXBIT /MUDSAV/ ; DIR OF MAIN DATA BASE FILES +WRKDIR: SIXBIT /MUDTMP/ ; DIRECTORY OF UPDATE FILES + +IFN ITS,[ +MNBLK: SETZ + SIXBIT /OPEN/ + MODE + DEV + [SIXBIT /SAV/] + [SIXBIT /FILE/] + SETZ MNDIR + + +FIXBLK: SETZ + SIXBIT /OPEN/ + MODE + DEV + [SIXBIT /FIXUP/] + [SIXBIT /FILE/] + SETZ MNDIR + +FOPBLK: SETZ + SIXBIT /OPEN/ + A + DEV + B + C + SETZ WRKDIR + +FXTBL: -2,,.+1 + 55. + 54. +] +IFE ITS,[ + +FXSTR: ASCIZ /PS:FIXUP.FILE/ +SAVSTR: ASCIZ /PS:SAV.FILE/ +TFXSTR: ASCIZ /DSK:FIXUP.FILE/ +TSAVST: ASCIZ /DSK:SAV.FILE/ + +FXTBL: -3,,.+1 + 55. + 54. + 104. +] +IFN SPCFXU,[ + +;This code does two things to code for FBIN; +; 1) Makes dispatches win in multi seg mode +; 2) Makes OBLIST? work with "new" atom format +; 3) Makes LENGTH win in multi seg mode +; 4) Gets AOBJN pointer to code vector in C + +SFIX: PUSH P,A + PUSH P,B + PUSH P,C ; for referring back + +SFIX1: MOVSI B,-MLNT ; for looping through tables + +SFIX2: MOVE A,(C) ; get code word + + AND A,SMSKS(B) + CAMN A,SPECS(B) ; do we match + JRST @SFIXR(B) + + AOBJN B,SFIX2 + +SFIX3: AOBJN C,SFIX1 ; do all of code +SFIX4: POP P,C + POP P,B + POP P,A + POPJ P, + +SMSKS: -1 + 777000,,-1 + -1,,0 + 777037,,0 +MLNT==.-SMSKS + +SPECS: HLRES A ; begin of arg diaptch table + SKIPN 2 ; old compiled OBLIST? + JRST (M) ; compiled LENGTH + ADDI (M) ; begin a case dispatch + +SFIXR: SETZ DFIX + SETZ OBLFIX + SETZ LFIX + SETZ CFIX + +DFIX: AOBJP C,SFIX4 ; make sure dont run out + MOVE A,(C) ; next ins + CAME A,[ASH A,-1] ; still winning? + JRST SFIX3 ; false alarm + AOBJP C,SFIX4 ; make sure dont run out + HLRZ A,(C) ; next ins + CAIE A,(ADDI A,(M)) ; still winning? + JRST SFIX3 ; false alarm + AOBJP C,SFIX4 + HLRZ A,(C) + CAIE A,(PUSHJ P,@(A)) ; last one to check + JRST SFIX3 + AOBJP C,SFIX4 + MOVE A,(C) + CAME A,[JRST FINIS] ; extra check + JRST SFIX3 + + MOVSI B,(SETZ) +SFIX5: AOBJP C,SFIX4 + HLRZ A,(C) + CAIN A,(SUBM M,(P)) + JRST SFIX3 + CAIE A,M ; dispatch entry? + JRST SFIX3 ; maybe already fixed + IORM B,(C) ; fix it + JRST SFIX5 + +OBLFIX: PUSH P,[-TLN,,TPTR] + PUSH P,C + MOVE B,-1(P) + +OBLFXY: PUSH P,1(B) + PUSH P,(B) + +OBLFI1: AOBJP C,OBLFXX + MOVE A,(C) + AOS B,(P) + AND A,(B) + MOVE B,-1(P) + CAME A,(B) + JRST OBLFXX + AOBJP B,DOOBFX + MOVEM B,-1(P) + JRST OBLFI1 + +OBLFXX: SUB P,C%22 ; for checking more ins + MOVE B,-1(P) + ADD B,C%22 + JUMPGE B,OBLFX1 + MOVEM B,-1(P) + MOVE C,(P) + JRST OBLFXY + + +INSBP==331100 ; byte pointer for ins field +ACBP==270400 ; also for ac +INDXBP==220400 + +DOOBFX: MOVE C,-2(P) + SUB P,C%44 + MOVEI B,<<(HRRZ)>_<-9>> ; change em + DPB B,[INSBP,,(C)] ; SKIPN==>HRRZ + LDB A,[ACBP,,(C)] ; get AC field + MOVEI B,<<(JUMPE)>_<-9>> + DPB B,[INSBP,,1(C)] + DPB A,[ACBP,,1(C)] + AOS 1(C) ; JRST FOO==>JUMPE ac,FOO+1 + MOVE B,[CAMG VECBOT] + DPB A,[ACBP,,B] + MOVEM B,2(C) ; JUMPL ==> CAMG ac,VECBOT + HRRZ A,3(C) ; get indicator of existence of ADD AC,TVP + CAIE A,TVP ; skip if extra ins exists + JRST NOATVP + MOVSI A,(JFCL) + EXCH A,4(C) + MOVEM A,3(C) + ADD C,C%11 +NOATVP: TLC B,(CAMG#HRLI) ; change CAMG to HRLI (preserving AC) + HRRZ A,4(C) ; see if moves in type + CAIE A,$TOBLS + SUB C,[1,,1] ; fudge it + HLLOM B,5(C) ; in goes HRLI -1 + CAIE A,$TOBLS ; do we need a skip? + JRST NOOB$ + MOVSI B,(CAIA) ; skipper + EXCH B,6(C) + MOVEM B,7(C) + ADD C,[7,,7] + JRST SFIX3 + +NOOB$: MOVSI B,(JFCL) + MOVEM B,6(C) + ADD C,C%66 + JRST SFIX3 + +OBLFX1: MOVE C,(P) + SUB P,C%22 + JRST SFIX3 + +; Here to fixup compiled LENGTH + +LFIX: MOVSI B,-LLN ; for checking other LENGTH ins + PUSH P,C + +LFIX1: AOBJP C,LFIXX + MOVE A,(C) + AND A,LMSK(B) + CAME A,LINS(B) +LFIXX: PUSHJ P,OBLFI2 ; never POPJs, just to make P stack in good + ; state + AOBJN B,LFIX1 + + POP P,C ; restore code pointer + MOVE A,(C) ; save jump for its addr + MOVE B,[MOVSI 400000] + MOVEM B,(C) ; JRST .+2 ==> MOVSI 0,400000 + LDB B,[ACBP,,1(C)] ; B==> AC of interest + ADDI A,2 + DPB B,[ACBP,,A] + MOVEI B,<<(JUMPE)>_<-9.>> + DPB B,[INSBP,,A] + EXCH A,1(C) + TLC A,(HRR#HRRZ) ; HRR==>HRRZ + HLLZM A,2(C) ; TRNN AC,-1 ==> HRRZ AC,(AC) + MOVEI B,(AOBJN (M)) + HRLM B,3(C) ; AOBJP AC,.-2 ==> AOBJN 0,.-2 + MOVE B,2(C) ; get HRRZ AC,(AC) + TLZ B,17 ; kill (AC) part + MOVEM B,4(C) ; HLRZS AC ==> HRRZ AC,0 + ADD C,C%44 + JRST SFIX3 + +; Fixup a CASE dispatch + + CFIX: LDB A,[ACBP,,(C)] + AOBJP C,SFIX4 + HLRZ B,(C) ; Next ins + ANDI B,777760 + CAIE B,(JRST @) + JRST SFIX3 + LDB B,[INDXBP,,(C)] + CAIE A,(B) + JRST SFIX3 + MOVE A,(C) ; ok, fix it up + TLZ A,20 ; kill indirection + MOVEM A,(C) + HRRZ B,-1(C) ; point to table + ADD B,(P) ; point to code to change + +CFIXLP: HLRZ A,(B) ; check one out + TRZ A,400000 ; kill bit + CAIE A,M ; check for just index (or index with SETZ) + JRST SFIX3 + MOVEI A,(JRST (M)) + HRLM A,(B) + AOJA B,CFIXLP + +DEFINE FOO LBL,LNT,LBL2,L +LBL: + IRP A,,[L] + IRP B,C,[A] + B + .ISTOP + TERMIN + TERMIN +LNT==.-LBL +LBL2: + IRP A,,[L] + IRP B,C,[A] + C + .ISTOP + TERMIN + TERMIN +TERMIN + +IMSK==777017,,0 +AIMSK==777000,,-1 + +FOO OINS,OLN,OMSK,[[,IMSK],[,IMSK],[MOVE,AIMSK] + [,AIMSK],[,IMSK] + [,AIMSK],[MOVEI,AIMSK]] + +FOO OINS3,OLN3,OMSK3,[[,IMSK],[,IMSK],[MOVE,AIMSK] + [,IMSK],[MOVEI,AIMSK]] + +FOO OINS2,OLN2,OMSK2,[[,IMSK],[,IMSK],[,AIMSK] + [MOVE,AIMSK],[,AIMSK],[,IMSK] + [,AIMSK],[MOVEI,AIMSK]] + +FOO OINS4,OLN4,OMSK4,[[,IMSK],[,IMSK],[,AIMSK] + [MOVE,AIMSK],[,IMSK],[MOVEI,AIMSK]] + +TPTR: -OLN,,OINS + OMSK-1 + -OLN2,,OINS2 + OMSK2-1 + -OLN3,,OINS3 + OMSK3-1 + -OLN4,,OINS4 + OMSK4-1 +TLN==.-TPTR + +FOO LINS,LLN,LMSK,[[,AIMSK],[,AIMSK],[,IMSK] + [,<-1,,777760>]] + +] +IMPURE + +SAVSNM: 0 ; SAVED SNAME +INPLOD: 0 ; FLAG SAYING WE ARE IN MAPPUR + +IFE ITS,[ +MAPJFN: 0 ; JFN OF SAV FILE +DIRCHN: 0 ; JFN USED BY GETDIR +] + +PURE + +END + diff --git a//mappur.mid.160 b//mappur.mid.160 new file mode 100644 index 0000000..ceabb2c --- /dev/null +++ b//mappur.mid.160 @@ -0,0 +1,1974 @@ + +TITLE MAPURE-PAGE LOADER + +RELOCATABLE + +MAPCH==0 ; channel for MAPing +XJRST==JRST 5, + +.GLOBAL PURVEC,PURTOP,PURBOT,P.TOP,GCSTOP,FRETOP,MUDSTR,STRTO6,PLOAD,AGC,GCDOWN +.GLOBAL SQUTOA,IGVAL,IBLOCK,PURCLN,MOVPUR,GETPAG,GCFLG,NOSHUF,DIR,NDIRS,SQUPNT +.GLOBAL PLODR,SQUKIL,GETBUF,KILBUF,INPLOD,SQKIL,PVSTOR,TVSTOR,DSTOREM,SLEEPR +.GLOBAL OPSYS,SJFNS,MULTSG,PURBTB,SFIX,NSEGS +.GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10 +.GLOBAL C%M20,C%M30,C%M40,C%M60 +.GLOBAL MAPJFN,DIRCHN + +.INSRT MUDDLE > +SPCFXU==1 +SYSQ + +IFE ITS,[ +IF1, .INSRT STENEX > +] + +F==PVP +G==TVP +H==SP +RDTP==1000,,200000 +FME==1000,,-1 + + +IFN ITS,[ +PGMSK==1777 +PGSHFT==10. +] + +IFE ITS,[ +FLUSHP==0 +PGMSK==777 +PGSHFT==9. +] + +LNTBYT==340700 +ELN==4 ; LENGTH OF SLOT +FB.NAM==0 ; NAME SLOT IN TABLE +FB.PTR==1 ; Pointer to core pages +FB.AGE==2 ; age,,chain +FB.PGS==3 ; PTR AND LENGTH OF PAGE IN FILE +FB.AMK==37777777 ; extended address mask +FB.CNT==<-1># ; page count mask +EOC==400000 ; END OF PURVEC CHAIN + +IFE ITS,[ +.FHSLF==400000 ; THIS FORK +%GJSHT==000001 ; SHORT FORM GTJFN +%GJOLD==100000 + ;PMAP BITS +PM%CNT==400000 ; PMAP WITH REPEAT COUNT +PM%RD==100000 ; PMAP WITH READ ACCESS +PM%EX==20000 ; PMAP WITH EXECUTE ACCESS (NO-OP ON 20X) +PM%CPY==400 ; PMAP WITH COPY-ON-WRITE ACCESS +PM%WR==40000 ; PMAP WITH WRITE ACCESS + + ;OPENF BITS +OF%RD==200000 ; OPEN IN READ MODE +OF%WR==100000 ; OPEN IN WRITE MODE +OF%EX==040000 ; OPEN IN EXECUTE MODE (TENEX CARES) +OF%THW==02000 ; OPEN IN THAWED MODE +OF%DUD==00020 ; DON'T UPDATE THAWED PAGES +] +; THIS ROUTINE TAKES A SLOT OFFSET IN REGISTER A AND MAPS IN THE ASSOCIATED +; FILE. IT CLOBBERS ALL ACs AND SKIP RETURNS IF IT WINS. + +OFF==-5 ; OFFSET INTO PURVEC OF SLOT +NAM==-4 ; SIXBIT NAME OF THING BEING LOADED +LASTC==-3 ; LAST CHARACTER OF THE NAME +DIR==-2 ; SAVED POINTER TO DIRECTORY +SPAG==-1 ; FIRST PAGE IN FILE +PGNO==0 ; FIRST PAGE IN CORE +VER==-6 ; VERSION NUMBER OF MUDDLE TO USE IN OPENING FILES +FLEN==-7 ; LENGTH OF THE FILE +TEMP==-10 ; GENERAL TEMPORARY SLOT +WRT==-11 ; INDICATION IF OPEN IS FOR WRITING OR READING +CADDR==-12 ; ADDRESS OF CORE IMAGE LOCATION OF FILE +NSLOTS==13 + +; IT FIRST LOOKS TO SEE IF IT HAS THE PAGE NUMBER OF THE FILE + +PLOAD: ADD P,[NSLOTS,,NSLOTS] + SKIPL P + JRST PDLOV + MOVEM A,OFF(P) + PUSH TP,C%0 ; [0] + PUSH TP,C%0 ; [0] +IFE ITS,[ + SKIPN MAPJFN + PUSHJ P,OPSAV +] + +PLOADX: PUSHJ P,SQKIL + MOVE A,OFF(P) + ADD A,PURVEC+1 ; GET TO SLOT + SKIPE B,FB.PGS(A) ; SKIP IF PAGE NUMBER + JRST GETIT + MOVE B,FB.NAM(A) + MOVEM B,NAM(P) + MOVE 0,B + MOVEI A,6 ; FIND LAST CHARACTER + TRNE 0,77 ; SKIP IF NOT DONE + JRST .+3 + LSH 0,-6 ; BACK A CHAR + SOJG A,.-3 ; NOW CHAR IS BACKED OUT + ANDI 0,77 ; LASTCHR + MOVEM 0,LASTC(P) + +; NOT TO TRY TO FIND FILE IN MAIN DATA BASE. +; THE GC'S WINDOW IS USED IN THIS CASE. + +IFN ITS,[ + .CALL MNBLK ; OPEN CHANNEL TO MAIN FILE + JRST NTHERE + PUSHJ P,TRAGN ; TRY OPENING UP CHANNEL AGAIN IF POSSIBLE +] +IFE ITS,[ + SKIPN E,MAPJFN + JRST NTHERE ;who cares if no SAV.FILE? + MOVEM E,DIRCHN +] + MOVE D,NAM(P) + MOVE 0,LASTC(P) + PUSHJ P,GETDIR + MOVEM E,DIR(P) + PUSHJ P,GENVN ; GET VERSION # AS FIX + MOVE E,DIR(P) + MOVE D,NAM(P) + MOVE A,B + PUSHJ P,DIRSRC ; SEARCH DIRECTORY + JRST NTHERE ; GO TRY FIXING UP ITS NOT THERE + ANDI A,-1 ; WIN IN MULT SEG CASE + MOVE B,OFF(P) ; GET SLOT NUMBER + ADD B,PURVEC+1 ; POINT TO SLOT + HRRZ C,1(A) ; GET BLOCK NUMBER + HRRM C,FB.PGS(B) ; SMASH INTO SLOT + LDB C,[LNTBYT,,1(A)] ; SMASH IN LENGTH + HRLM C,FB.PGS(B) ; SMASH IN LENGTH + JRST PLOADX + +; NOW TRY TO FIND FILE IN WORKING DIRECTORY + +NTHERE: PUSHJ P,KILBUF + MOVE A,OFF(P) ; GET POINTER TO PURVEC SLOT + ADD A,PURVEC+1 + PUSHJ P,GENVN ; GET VERSION NUMBER + HRRZM B,VER(P) + PUSHJ P,OPMFIL ; OPEN FILE + JRST FIXITU + +; NUMBER OF PAGES ARE IN A +; STARTING PAGE NUMBER IN SPAG(P) + +PLOD1: PUSHJ P,ALOPAG ; get the necessary pages + JRST MAPLS2 + MOVE E,SPAG(P) ; E starting page in file + MOVEM B,PGNO(P) +IFN ITS,[ + MOVN A,FLEN(P) ; get neg count + MOVSI A,(A) ; build aobjn pointer + HRR A,PGNO(P) ; get page to start + MOVE B,A ; save for later + HRRI 0,(E) ; page pointer for file + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, ; no need to have file open anymore +] +IFE ITS,[ + MOVEI A,(E) ; First page on rh of A + HRL A,DIRCHN ; JFN to lh of A + HRLI B,.FHSLF ; specify this fork + MOVSI C,PM%RD+PM%EX ; bits for read/execute + MOVE D,FLEN(P) ; # of pages to D + HRROI E,(B) ; build page aobjn for later + TLC E,-1(D) ; sexy way of doing lh + + SKIPN OPSYS + JRST BLMAP ; if tops-20 can block PMAP + PMAP + ADDI A,1 + ADDI B,1 + SOJG D,.-3 ; map 'em all + MOVE B,E + JRST PLOAD1 + +BLMAP: HRRI C,(D) + TLO C,PM%CNT ; say it is counted + PMAP ; one PMAP does the trick + MOVE B,E +] +; now try to smash slot in PURVEC + +PLOAD1: MOVE A,PURVEC+1 ; get pointer to it + ASH B,PGSHFT ; convert to aobjn pointer to words + MOVE C,OFF(P) ; get slot offset + ADDI C,(A) ; point to slot + MOVEM B,FB.PTR(C) ; clobber it in + TLZ B,(FB.CNT) ; isolate address of page + HRRZ D,PURVEC ; get offset into vector for start of chain + TRNE D,EOC ; skip if not end marker + JRST SCHAIN + HRLI D,400000+A ; set up indexed pointer + ADDI D,1 +IFN ITS, HRRZ 0,@D ; get its address +IFE ITS,[ + MOVE 0,@D + TLZ 0,(FB.CNT) +] + JUMPE 0,SCHAIN ; no chain exists, start one + CAMLE 0,B ; skip if new one should be first + AOJA D,INLOOP ; jump into the loop + + SUBI D,1 ; undo ADDI +FCLOB: MOVE E,OFF(P) ; get offset for this guy + HRRM D,FB.AGE(C) ; link up + HRRM E,PURVEC ; store him away + JRST PLOADD + +SCHAIN: MOVEI D,EOC ; get end of chain indicator + JRST FCLOB ; and clobber it in + +INLOOP: MOVE E,D ; save in case of later link up + HRR D,@D ; point to next table entry + TRNE D,EOC ; 400000 is the end of chain bit + JRST SLFOUN ; found a slot, leave loop + ADDI D,1 ; point to address of progs +IFN ITS, HRRZ 0,@D ; get address of block +IFE ITS,[ + MOVE 0,@D + TLZ 0,(FB.CNT) +] + CAMLE 0,B ; skip if still haven't fit it in + AOJA D,INLOOP ; back to loop start and point to chain link + SUBI D,1 ; point back to start of slot + +SLFOUN: MOVE 0,OFF(P) ; get offset into vector of this guy + HRRM 0,@E ; make previous point to us + HRRM D,FB.AGE(C) ; link it in + + +PLOADD: AOS -NSLOTS(P) ; skip return + +MAPLOS: SUB P,[NSLOTS,,NSLOTS] ; flush stack crap + SUB TP,C%22 + POPJ P, + + +MAPLS0: ERRUUO EQUOTE NO-SAV-FILE + JRST MAPLOS + +MAPLS1: ERRUUO EQUOTE NO-FIXUP-FILE + JRST MAPLOS + +MAPLS2: ERRUUO EQUOTE NO-ROOM-AVAILABLE + JRST MAPLOS + +FIXITU: + +;OPEN FIXUP FILE ON MUDSAV + +IFN ITS,[ + .CALL FIXBLK ; OPEN UP FIXUP FILE + PUSHJ P,TRAGN ; SEE IF TOTALLY LOSING +] +IFE ITS,[ + MOVSI A,%GJSHT ; GTJFN BITS + HRROI B,FXSTR + SKIPE OPSYS + HRROI B,TFXSTR + GTJFN + FATAL FIXUP FILE NOT FOUND + MOVEM A,DIRCHN + MOVE B,[440000,,OF%RD+OF%EX] + OPENF + FATAL FIXUP FILE CANT BE OPENED +] + + MOVE 0,LASTC(P) ; GET DIRECTORY + PUSHJ P,GETDIR + MOVE D,NAM(P) + PUSHJ P,DIRSR1 ; SEARCH DIRECTORY FOR FIXUP + JRST NOFXUP ; NO FIXUP IN MAIN DIRECTORY + ANDI A,-1 ; WIN IN MULTI SEGS + HRRZ A,1(A) ; GET BLOCK NUMBER OF START + ASH A,8. ; CONVERT TO WORDS +IFN ITS,[ + .ACCES MAPCH,A ; ACCESS FILE +] + +IFE ITS,[ + MOVEI B,(A) + MOVE A,DIRCHN + SFPTR + JFCL +] + PUSHJ P,KILBUF +FIXT1: PUSHJ P,RFXUP ; READ IN THE FIXUP FILE + +IFN ITS,[ + .CALL MNBLK ; REOPEN SAV FILE + PUSHJ P,TRAGN +] + +IFE ITS,[ + MOVE A,MAPJFN ; SET UP DIRCHAN AGAIN + MOVEM A,DIRCHN +] + +; NOW TRY TO LOCATE SAV FILE + + MOVE 0,LASTC(P) ; GET LASTCHR + PUSHJ P,GETDIR ; GET DIRECTORY + HRRZ A,VER(P) ; GET VERSION # + MOVE D,NAM(P) ; GET NAME OF FILE + PUSHJ P,DIRSRC ; SEARCH DIRECTORY + JRST MAPLS1 ; NO SAV FILE THERE + ANDI A,-1 + HRRZ E,1(A) ; GET STARTING BLOCK # + LDB A,[LNTBYT,,1(A)] ; GET LENGTH INTO A + MOVEM A,FLEN(P) ; SAVE LENGTH + MOVEM E,SPAG(P) ; SAVE STARTING BLOCK NUMBER + PUSHJ P,KILBUF + PUSHJ P,RSAV ; READ IN CODE +; now to do fixups + +FXUPGO: MOVE A,(TP) ; pointer to them + SETOM INPLOD ; ABSOLUTE CLUDGE TO PREVENT BUFFER FROM + ; SCREWING US +IFE ITS,[ + SKIPN MULTSG + JRST FIXMLT + HRRZ D,B ; this codes gets us running in the correct + ; segment + ASH D,PGSHFT + HRRI D,FIXMLT + MOVEI C,0 + XJRST C ; good bye cruel segment (will work if we fell + ; into segment 0) +FIXMLT: ASH B,PGSHFT ; aobjn to program + +FIX1: SKIPL E,(A) ; read one hopefully squoze + FATAL ATTEMPT TO TYPE FIX PURE + TLZ E,740000 + +NOPV1: PUSHJ P,SQUTOA ; look it up + FATAL BAD FIXUPS + +; N.B. THE VALUE IN THE FIXUPS FOR AN ADDRESS CAN BE NEGATIVE. IF THIS HAPPENS +; IT MEANS THAT THE LEFT HALF CONTAINS THE VALUE INSTEAD OF THE RIGHT HALF +NOPV2: AOBJP A,FIX2 + HLRZ D,(A) ; get old value + HRRZS E + SUBM E,D ; D is diff between old and new + HRLM E,(A) ; fixup the fixups +NOPV3: MOVEI 0,0 ; flag for which half +FIX4: JUMPE 0,FIXRH ; jump if getting rh + MOVEI 0,0 ; next time will get rh + AOBJP A,FIX2 ; done? + HLRE C,(A) ; get lh + JUMPE C,FIX3 ; 0 terminates +FIX5: SKIPGE C ; If C is negative then left half garbage + JRST FIX6 + ADDI C,(B) ; access the code + +NOPV4: ADDM D,-1(C) ; and fix it up + JRST FIX4 + +; FOR LEFT HALF CASE + +FIX6: MOVNS C ; GET TO ADRESS + ADDI C,(B) ; ACCESS TO CODE + HLRZ E,-1(C) ; GET OUT WORD + ADDM D,E ; FIX IT UP + HRLM E,-1(C) + JRST FIX4 + +FIXRH: MOVEI 0,1 ; change flag + HRRE C,(A) ; get it and + JUMPN C,FIX5 + +FIX3: AOBJN A,FIX1 ; do next one + +IFN SPCFXU,[ + MOVE C,B + PUSHJ P,SFIX +] + PUSHJ P,SQUKIL ; KILL SQUOZE TABLE + SETZM INPLOD +FIX2: + HRRZS VER(P) ; INDICATE SAV FILE + MOVEM B,CADDR(P) + PUSHJ P,GENVN + HRRM B,VER(P) + PUSHJ P,OPWFIL + FATAL MAP FIXUP LOSSAGE +IFN ITS,[ + MOVE B,CADDR(P) + .IOT MAPCH,B ; write out the goodie + .CLOSE MAPCH, + PUSHJ P,OPMFIL + FATAL WHERE DID THE FILE GO? + MOVE E,CADDR(P) + ASH E,-PGSHFT ; to page AOBJN + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, +] + + +IFE ITS,[ + MOVE A,DIRCHN ; GET JFN + MOVE B,CADDR(P) ; ready to write it out + HRLI B,444400 + HLRE C,CADDR(P) + SOUT ; zap it out + TLO A,400000 ; dont recycle the JFN + CLOSF + JFCL + ANDI A,-1 ; kill sign bit + MOVE B,[440000,,240000] + OPENF + FATAL MAP FIXUP LOSSAGE + MOVE B,CADDR(P) + ASH B,-PGSHFT ; aobjn to pages + HLRE D,B ; -count + HRLI B,.FHSLF + MOVSI A,(A) + MOVSI C,PM%RD+PM%EX + PMAP + ADDI A,1 + ADDI B,1 + AOJN D,.-3 +] + + SKIPGE MUDSTR+2 + JRST EFIX2 ; exp vers, dont write out +IFE ITS,[ + HRRZ A,SJFNS ; get last jfn from savxxx file + JUMPE A,.+4 ; oop + CAME A,MAPJFN + CLOSF ; close it + JFCL + HLLZS SJFNS ; zero the slot +] + MOVEI 0,1 ; INDICATE FIXUP + HRLM 0,VER(P) + PUSHJ P,OPWFIL + FATAL CANT WRITE FIXUPS + +IFN ITS,[ + MOVE E,(TP) + HLRE A,E ; get length + MOVNS A + ADDI A,2 ; account for these 2 words + MOVE 0,[-2,,A] ; write version and length + .IOT MAPCH,0 + .IOT MAPCH,E ; out go the fixups + SETZB 0,A + MOVEI B,MAPCH + .CLOSE MAPCH, +] + +IFE ITS,[ + MOVE A,DIRCHN + HLRE B,(TP) ; length of fixup vector + MOVNS B + ADDI B,2 ; for length and version words + BOUT + PUSHJ P,GENVN + BOUT + MOVSI B,444400 ; byte pointer to fixups + HRR B,(TP) + HLRE C,(TP) + SOUT + CLOSF + JFCL +] + +EFIX2: MOVE B,CADDR(P) + ASH B,-PGSHFT + JRST PLOAD1 + +; Here to try to get a free page block for new thing +; A/ # of pages to get + +ALOPAG: MOVE C,GCSTOP ; FOOL GETPAG + ADDI C,3777 + ASH C,-PGSHFT + MOVE B,PURBOT +IFE ITS,[ + SKIPN MULTSG ; skip if multi-segments + JRST ALOPA1 +; Compute the "highest" PURBOT (i.e. find the least busy segment) + + PUSH P,E + PUSH P,A + MOVN A,NSEGS ; aobjn pntr to table + HRLZS A + MOVEI B,0 +ALOPA3: CAML B,PURBTB(A) ; if this one is larger + JRST ALOPA2 + MOVE B,PURBTB(A) ; use it + MOVEI E,FSEG(A) ; and the segment # +ALOPA2: AOBJN A,ALOPA3 + POP P,A +] + +ALOPA1: ASH B,-PGSHFT + SUBM B,C ; SEE IF ROOM + CAIL C,(A) + JRST ALOPGW + PUSHJ P,GETPAX ; try to get enough pages +IFE ITS, JRST EPOPJ +IFN ITS, POPJ P, + +ALOPGW: +IFN ITS, AOS (P) ; won skip return +IFE ITS,[ + SKIPE MULTSG + AOS -1(P) ; ret addr + SKIPN MULTSG + AOS (P) +] + MOVE 0,PURBOT +IFE ITS,[ + SKIPE MULTSG + MOVE 0,PURBTB-FSEG(E) +] + ASH 0,-PGSHFT + SUBI 0,(A) + MOVE B,0 +IFE ITS,[ + SKIPN MULTSG + JRST ALOPW1 + ASH 0,PGSHFT + HRRZM 0,PURBTB-FSEG(E) + ASH E,PGSHFT ; INTO POSITION + IORI B,(E) ; include segment in address + POP P,E + JRST ALOPW2 +] +ALOPW1: ASH 0,PGSHFT +ALOPW2: CAMGE 0,PURBOT + MOVEM 0,PURBOT + CAML 0,P.TOP + POPJ P, +IFE ITS,[ + SUBI 0,1777 + ANDCMI 0,1777 +] + MOVEM 0,P.TOP + POPJ P, + +EPOPJ: SKIPE MULTSG + POP P,E + POPJ P, +IFE ITS,[ +GETPAX: TDZA B,B ; here if other segs ok +GETPAG: MOVEI B,1 ; here for only main segment + JRST @[.+1] ; run in sect 0 + MOVNI E,1 +] +IFN ITS,[ +GETPAX: +GETPAG: +] + MOVE C,P.TOP ; top of GC space + ASH C,-PGSHFT ; to page number +IFE ITS,[ + SKIPN MULTSG + JRST GETPA9 + JUMPN B,GETPA9 ; if really wan all segments, + ; must force all to be free + PUSH P,A + MOVN A,NSEGS ; aobjn pntr to table + HRLZS A + MOVE B,P.TOP +GETPA8: CAMLE B,PURBTB(A) ; if this one is larger (or the same) + JRST GETPA7 + MOVE B,PURBTB(A) ; use it + MOVEI E,FSEG(A) ; and the segment # +GETPA7: AOBJN A,GETPA8 + POP P,A + JRST .+2 +] +GETPA9: MOVE B,PURBOT + ASH B,-PGSHFT ; also to pages + SUBM B,C ; pages available ==> C + CAMGE C,A ; skip if have enough already + JRST GETPG1 ; no, try to shuffle around + SUBI B,(A) ; B/ first new page +CPOPJ1: AOS (P) +IFN ITS, POPJ P, +IFE ITS,[ +SPOPJ: SKIPN MULTSG + POPJ P, ; return with new free page in B + ; (and seg# in E?) + POP P,21 + SETZM 20 + XJRST 20 +] +; Here if shuffle must occur or gc must be done to make room + +GETPG1: MOVEI 0,0 + SKIPE NOSHUF ; if can't shuffle, then ask gc + JRST ASKAGC + MOVE 0,PURTOP ; get top of mapped pure area + SUB 0,P.TOP + ASH 0,-PGSHFT ; to pages + CAMGE 0,A ; skip if winnage possible + JRST ASKAGC ; please AGC give me some room!! + SUBM A,C ; C/ amount we must flush to make room + +IFE ITS,[ + SKIPE MULTSG ; if multi and getting in all segs + JUMPL E,LPGL1 ; check out each and every segment + + PUSHJ P,GL1 + + SKIPE MULTSG + PUSHJ P,PURTBU ; update PURBOT in multi case + + JRST GETPAX + +LPGL1: PUSH P,A + PUSH P,[FSEG-1] + +LPGL2: AOS E,(P) ; count segments + MOVE B,NSEGS + ADDI B,FSEG + CAML E,B + JRST LPGL3 + PUSH P,C + MOVE C,PURBOT ; fudge so look for appropriate amt + SUB C,PURBTB-FSEG(E) + ASH C,-PGSHFT ; to pages + ADD C,(P) + SKIPLE C ; none to flush + PUSHJ P,GL1 + HRRZ E,-1(P) ; fet section again + HRRZ B,PURBOT + HRRZ C,PURBTB-FSEG(E) ; lets share with 0 again + SUB C,B + HRL B,E ; get segment + MOVEI A,(B) + ASH B,-PGSHFT + ASH A,-PGSHFT + HRLI A,.FHSLF + HRLI B,.FHSLF + ASH C,-PGSHFT + HRLI C,PM%CNT+PM%RD+PM%WR+PM%EX + PMAP +LPGL4: POP P,C + JRST LPGL2 + +LPGL3: SUB P,C%11 + POP P,A + + SKIPE MULTSG + PUSHJ P,PURTBU ; update PURBOT in multi case + + JRST GETPAG +] +; Here to find pages for flush using LRU algorithm (in multi seg mode, only +; care about the segment in E) + +GL1: MOVE B,PURVEC+1 ; get pointer to pure sr vector + MOVEI 0,-1 ; get very large age + +GL2: SKIPL FB.PTR(B) ; skip if not already flushed + JRST GL3 +IFE ITS,[ + SKIPN MULTSG + JRST GLX + LDB D,[220500,,FB.PTR(B)] ; get segment # + CAIE D,(E) + JRST GL3 ; wrong swegment, ignore +] +GLX: HLRZ D,FB.AGE(B) ; get this ones age + CAMLE D,0 ; skip if this is a candidate + JRST GL3 + MOVE F,B ; point to table entry with E + MOVEI 0,(D) ; and use as current best +GL3: ADD B,[ELN,,ELN] ; look at next + JUMPL B,GL2 + + HLRE B,FB.PTR(F) ; get length of flushee + ASH B,-PGSHFT ; to negative # of pages + ADD C,B ; update amount needed +IFN ITS,SETZM FB.PTR(F) ; indicate it will be gone +IFE ITS,MOVNS FB.PTR(F) ; save page info for flushing pages + JUMPG C,GL1 ; jump if more to get + +; Now compact pure space + + PUSH P,A ; need all acs + HRRZ D,PURVEC ; point to first in core addr order + HRRZ C,PURTOP +IFE ITS,[ + SKIPE MULTSG + HRLI C,(E) ; adjust for segment +] + ASH C,-PGSHFT ; to page number + SETZB F,A + +CL1: ADD D,PURVEC+1 ; to real pointer + SKIPGE FB.PTR(D) ; skip if this one is a flushee + JRST CL2 ; this one stays + +IFE ITS,[ + PUSH P,C + PUSH P,D + HRRZ C,FB.PGS(D) ; is this from SAV FILE? + JUMPN C,CLFOUT ; yes. don't bother flushing pages + MOVN C,FB.PTR(D) ; get aobjn pointer to code in C + SETZM FB.PTR(D) ; and flush this because it works (sorry) + ASH C,-PGSHFT ; pages speak louder than words + HLRE D,C ; # of pages saved here for unmap + HRLI C,.FHSLF ; C now contains myfork,,lowpage + MOVE A,C ; put that in A for RMAP + RMAP ; A now contains JFN in left half + MOVE B,C ; ac roulette: get fork,,page into B for PMAP + HLRZ C,A ; hold JFN in C for future CLOSF + MOVNI A,1 ; say this page to be unmapped +CLFLP: PMAP ; do the unmapping + ADDI B,1 ; next page + AOJL D,CLFLP ; continue for all pages + MOVE A,C ; restore JFN + CLOSF ; and close it, throwing away the JFN + JFCL ; should work in 95/100 cases +CLFOU1: POP P,D ; fatal error if can't close + POP P,C +] + HRRZ D,FB.AGE(D) ; point to next one in chain + JUMPN F,CL3 ; jump if not first one + HRRM D,PURVEC ; and use its next as first + JRST CL4 + +IFE ITS,[ +CLFOUT: SETZM FB.PTR(D) ; zero the code pointer + JRST CLFOU1 +] + +CL3: HRRM D,FB.AGE(F) ; link up + JRST CL4 + +; Found a stayer, move it if necessary + +CL2: +IFE ITS,[ + SKIPN MULTSG + JRST CL9 + LDB F,[220500,,FB.PTR(D)] ; check segment + CAIE E,(F) + JRST CL6X ; no other segs move at all +] +CL9: MOVEI F,(D) ; another pointer to slot + HLRE B,FB.PTR(D) ; - length of block +IFE ITS,[ + TRZ B,<-1>#<(FB.CNT)> + MOVE D,FB.PTR(D) ; pointer to block + TLZ D,(FB.CNT) ; kill count bits +] +IFN ITS, HRRZ D,FB.PTR(D) + SUB D,B ; point to top of block + ASH D,-PGSHFT ; to page number + CAMN D,C ; if not moving, jump + JRST CL6 + + ASH B,-PGSHFT ; to pages +IFN ITS,[ +CL5: SUBI C,1 ; move to pointer and from pointer + SUBI D,1 + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],C,[1000,,-1],D] + .LOSE %LSSYS + AOJL B,CL5 ; count down +] +IFE ITS,[ + PUSH P,B ; save # of pages + MOVEI A,-1(D) ; copy from pointer + HRLI A,.FHSLF ; get this fork code + RMAP ; get a JFN (hopefully) + EXCH D,(P) ; D # of pages (save from) + ADDM D,(P) ; update from + MOVEI B,-1(C) ; to pointer in B + HRLI B,.FHSLF + MOVSI C,PM%RD+PM%EX ; read/execute modes + + SKIPN OPSYS + JRST CCL1 + PMAP ; move a page + SUBI A,1 + SUBI B,1 + AOJL D,.-3 ; move them all + AOJA B,CCL2 + +CCL1: TLO C,PM%CNT + MOVNS D + SUBI B,-1(D) + SUBI A,-1(D) + HRRI C,(D) + PMAP + +CCL2: MOVEI C,(B) + POP P,D +] +; Update the table address for this loser + + SUBM C,D ; compute offset (in pages) + ASH D,PGSHFT ; to words + ADDM D,FB.PTR(F) ; update it +CL7: HRRZ D,FB.AGE(F) ; chain on +CL4: TRNN D,EOC ; skip if end of chain + JRST CL1 + + ASH C,PGSHFT ; to words +IFN ITS, MOVEM C,PURBOT ; reset pur bottom +IFE ITS,[ + SKIPN MULTSG + JRST CLXX + + HRRZM C,PURBTB-FSEG(E) + CAIA +CLXX: MOVEM C,PURBOT ; reset pur bottom +] + POP P,A + POPJ P, + +IFE ITS,[ +CL6X: MOVEI F,(D) ; chain on + JRST CL7 +] +CL6: +IFN ITS, HRRZ C,FB.PTR(F) ; get new top of world +IFE ITS,[ + MOVE C,FB.PTR(F) + TLZ C,(FB.CNT) +] + ASH C,-PGSHFT ; to page # + JRST CL7 + +IFE ITS,[ +PURTBU: PUSH P,A + PUSH P,B + + MOVN B,NSEGS + HRLZS B + MOVE A,PURTOP + +PURTB2: CAMGE A,PURBTB(B) + JRST PURTB1 + MOVE A,PURBTB(B) + MOVEM A,PURBOT +PURTB1: AOBJN B,PURTB2 + + POP P,B + POP P,A + POPJ P, +] + + ; SUBR to create an entry in the vector for one of these guys + +MFUNCTION PCODE,SUBR + + ENTRY 2 + + GETYP 0,(AB) ; check 1st arg is string + CAIE 0,TCHSTR + JRST WTYP1 + GETYP 0,2(AB) ; second must be fix + CAIE 0,TFIX + JRST WTYP2 + + MOVE A,(AB) ; convert name of program to sixbit + MOVE B,1(AB) + PUSHJ P,STRTO6 +PCODE4: MOVE C,(P) ; get name in sixbit + +; Now look for either this one or an empty slot + + MOVEI E,0 + MOVE B,PURVEC+1 + +PCODE2: CAMN C,FB.NAM(B) ; skip if this is not it + JRST PCODE1 ; found it, drop out of loop + JUMPN E,.+3 ; dont record another empty if have one + SKIPN FB.NAM(B) ; skip if slot filled + MOVE E,B ; remember pointer + ADD B,[ELN,,ELN] + JUMPL B,PCODE2 ; jump if more to look at + + JUMPE E,PCODE3 ; if E=0, error no room + MOVEM C,FB.NAM(E) ; else stash away name and zero rest + SETZM FB.PTR(E) + SETZM FB.AGE(E) + CAIA +PCODE1: MOVE E,B ; build ,, + MOVEI 0,0 ; flag whether new slot + SKIPE FB.PTR(E) ; skip if mapped already + MOVEI 0,1 + MOVE B,3(AB) + HLRE D,E + HLRE E,PURVEC+1 + SUB D,E + HRLI B,(D) + MOVSI A,TPCODE + SKIPN NOSHUF ; skip if not shuffling + JRST FINIS + JUMPN 0,FINIS ; jump if winner + PUSH TP,A + PUSH TP,B + HLRZ A,B + PUSHJ P,PLOAD + JRST PCOERR + POP TP,B + POP TP,A + JRST FINIS + +PCOERR: ERRUUO EQUOTE PURE-LOAD-FAILURE + +PCODE3: HLRE A,PURVEC+1 ; get current length + MOVNS A + ADDI A,10*ELN ; add 10(8) more entry slots + PUSHJ P,IBLOCK + EXCH B,PURVEC+1 ; store new one and get old + HLRE A,B ; -old length to A + MOVSI B,(B) ; start making BLT pointer + HRR B,PURVEC+1 + SUBM B,A ; final dest to A +IFE ITS, HRLI A,-1 ; force local index + BLT B,-1(A) + JRST PCODE4 + +; Here if must try to GC for some more core + +ASKAGC: SKIPE GCFLG ; if already in GC, lose +IFN ITS, POPJ P, +IFE ITS, JRST SPOPJ + MOVEM A,0 ; amount required to 0 + ASH 0,PGSHFT ; TO WORDS + MOVEM 0,GCDOWN ; pass as funny arg to AGC + EXCH A,C ; save A from gc's destruction +IFN ITS,.IOPUSH MAPCH, ; gc uses same channel + PUSH P,C + SETOM PLODR + MOVE C,[8,,9.] ; SET UP INDICATORS FOR GC + PUSHJ P,AGC + SETZM PLODR + POP P,C +IFN ITS,.IOPOP MAPCH, + EXCH C,A +IFE ITS,[ + JUMPL C,.+3 + JUMPL E,GETPAG + JRST GETPAX +] +IFN ITS, JUMPGE C,GETPAG + ERRUUO EQUOTE NO-MORE-PAGES + +; Here to clean up pure space by flushing all shared stuff + +PURCLN: SKIPE NOSHUF + POPJ P, + MOVEI B,EOC + HRRM B,PURVEC ; flush chain pointer + MOVE B,PURVEC+1 ; get pointer to table +CLN1: SETZM FB.PTR(B) ; zero pointer entry + SETZM FB.AGE(B) ; zero link and age slots + SETZM FB.PGS(B) + ADD B,[ELN,,ELN] ; go to next slot + JUMPL B,CLN1 ; do til exhausted + MOVE B,PURBOT ; now return pages + SUB B,PURTOP ; compute page AOBJN pointer +IFE ITS, SETZM MAPJFN ; make sure zero mapjfn + JUMPE B,CPOPJ ; no pure pages? + MOVSI B,(B) + HRR B,PURBOT + ASH B,-PGSHFT +IFN ITS,[ + DOTCAL CORBLK,[[1000,,0],[1000,,-1],B] + .LOSE %LSSYS +] +IFE ITS,[ + + SKIPE MULTSG + JRST CLN2 + HLRE D,B ; - # of pges to flush + HRLI B,.FHSLF ; specify hacking hom fork + MOVNI A,1 + MOVEI C,0 + + PMAP + ADDI B,1 + AOJL D,.-2 +] + + MOVE B,PURTOP ; now fix up pointers + MOVEM B,PURBOT ; to indicate no pure +CPOPJ: POPJ P, + +IFE ITS,[ +CLN2: HLRE C,B ; compute pos no. pages + HRLI B,.FHSLF + MOVNS C + MOVNI A,1 ; flushing pages + HRLI C,PM%CNT + MOVE D,NSEGS + MOVE E,PURTOP ; for munging table + ADDI B,_9. ; do it to the correct segment + PMAP + ADDI B,1_9. ; cycle through segments + HRRZM E,PURBTB(D) ; mung table + SOJG D,.-3 + + MOVEM E,PURBOT + POPJ P, +] + +; Here to move the entire pure space. +; A/ # and direction of pages to move (+ ==> up) + +MOVPUR: SKIPE NOSHUF + FATAL CANT MOVE PURE SPACE AROUND +IFE ITS,ASH A,1 + SKIPN B,A ; zero movement, ignore call + POPJ P, + + ASH B,PGSHFT ; convert to words for pointer update + MOVE C,PURVEC+1 ; loop through updating non-zero entries + SKIPE 1(C) + ADDM B,1(C) + ADD C,[ELN,,ELN] + JUMPL C,.-3 + + MOVE C,PURTOP ; found pages at top and bottom of pure + ASH C,-PGSHFT + MOVE D,PURBOT + ASH D,-PGSHFT + ADDM B,PURTOP ; update to new boundaries + ADDM B,PURBOT +IFE ITS,[ + SKIPN MULTSG ; in multi-seg mode, must mung whole table + JRST MOVPU1 + MOVN E,NSEGS + HRLZS E + ADDM PURBTB(E) + AOBJN E,.-1 +] +MOVPU1: CAIN C,(D) ; differ? + POPJ P, + JUMPG A,PUP ; if moving up, go do separate CORBLKs + +IFN ITS,[ + SUBM D,C ; -size of area to C (in pages) + MOVEI E,(D) ; build pointer to bottom of destination + ADD E,A + HRLI E,(C) + HRLI D,(C) + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,-1],D] + .LOSE %LSSYS + POPJ P, + +PUP: SUBM C,D ; pages to move to D + ADDI A,(C) ; point to new top + +PUPL: SUBI C,1 + SUBI A,1 + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,-1],C] + .LOSE %LSSYS + SOJG D,PUPL + POPJ P, +] +IFE ITS,[ + SUBM D,C ; pages to move to D + MOVSI E,(C) ; build aobjn pointer + HRRI E,(D) ; point to lowest + ADD D,A ; D==> new lowest page + MOVEI F,0 ; seg info + SKIPN MULTSG + JRST XPLS3 + MOVEI F,FSEG-1 + ADD F,NSEGS + ASH F,9. +XPLS3: MOVE G,E + MOVE H,D ; save for outer loop + +PURCL1: MOVSI A,.FHSLF ; specify here + HRRI A,(E) ; get a page + IORI A,(F) ; hack seg i + RMAP ; get a real handle on it + MOVE B,D ; where to go + HRLI B,.FHSLF + MOVSI C,PM%RD+PM%EX + IORI A,(F) + PMAP + ADDI D,1 + AOBJN E,PURCL1 + SKIPN MULTSG + POPJ P, + SUBI F,1_9. + CAIGE F,FSEG_9. + POPJ P, + MOVE E,G + MOVE D,H + JRST PURCL1 + +PUP: SUB D,C ; - count to D + MOVSI E,(D) ; start building AOBJN + HRRI E,(C) ; aobjn to top + ADD C,A ; C==> new top + MOVE D,C + MOVEI F,0 ; seg info + SKIPN MULTSG + JRST XPLS31 + MOVEI F,FSEG + ADD F,NSEGS + ASH F,9. +XPLS31: MOVE G,E + MOVE H,D ; save for outer loop + +PUPL: MOVSI A,.FHSLF + HRRI A,(E) + IORI A,(F) ; segment + RMAP ; get real handle + MOVE B,D + HRLI B,.FHSLF + IORI B,(F) + MOVSI C,PM%RD+PM%EX + PMAP + SUBI E,2 + SUBI D,1 + AOBJN E,PUPL + SKIPN MULTSG + POPJ P, + SUBI F,1_9. + CAIGE F,FSEG_9. + POPJ P, + MOVE E,G + MOVE D,H + JRST PUPL + + POPJ P, +] +IFN ITS,[ +.GLOBAL CSIXBT +CSIXBT: MOVEI 0,5 + PUSH P,[440700,,C] + PUSH P,[440600,,D] + MOVEI D,0 +CSXB2: ILDB E,-1(P) + CAIN E,177 + JRST CSXB1 + SUBI E,40 + IDPB E,(P) + SOJG 0,CSXB2 +CSXB1: SUB P,C%22 + MOVE C,D + POPJ P, +] +GENVN: MOVE C,[440700,,MUDSTR+2] + MOVEI D,5 + MOVEI B,0 +VNGEN: ILDB 0,C + CAIN 0,177 + POPJ P, + IMULI B,10. + SUBI 0,60 + ADD B,0 + SOJG D,VNGEN + POPJ P, + +IFE ITS,[ +MSKS: 774000,,0 + 777760,,0 + 777777,,700000 + 777777,,777400 + 777777,,777776 +] + + ; THESE ARE DIRECTORY SEARCH ROUTINES + + +; THIS ROUTINE DOES A BINARY SEARCH ON A DIRECTORY AND RETURNS A POINTER +; RESTED DOWN TO THE APPROPRIATE SLOT IN THE DIRECTORY. +; ARGS: E==DIR POINTER D==FILE-NAME 1 A==VERSION # +; RETS: A==RESTED DOWN DIRECTORY + +DIRSR1: TLOA 0,400000 ; INDICATION OF ONE ARGUMENT SEARCH +DIRSRC: TLZ 0,400000 ; INDICATOR OF 2 ARGUMENT SEARCH + PUSH P,A ; SAVE VERSION # + HLRE B,E ; GET LENGTH INTO B + MOVNS B + MOVE A,E + HRLS B ; GET BOTH SIDES +UP: ASH B,-1 ; HALVE TABLE + AND B,[-2,,-2] ; FORCE DIVIS BY 2 + MOVE C,A ; COPY POINTER + JUMPLE B,LSTHLV ; CANT GET SMALLER + ADD C,B +IFE ITS, HRRZ F,C ; avoid lossage in multi-sections +IFN ITS, CAMLE D,(C) ; SKIP IF EITHER FOUND OR IN TOP +IFE ITS, CAMLE D,(F) ; SKIP IF EITHER FOUND OR IN TOP + MOVE A,C ; POINT TO SECOND HALF +IFN ITS, CAMN D,(C) ; SKIP IF NOT FOUND +IFE ITS, CAMN D,(F) ; SKIP IF NOT FOUND + JRST WON +IFN ITS, CAML D,(C) ; SKIP IF IN TOP HALF +IFE ITS, CAML D,(F) ; SKIP IF IN TOP HALF + JRST UP + HLLZS C ; FIX UP POINTER + SUB A,C + JRST UP + +WON: JUMPL 0,SUPWIN + MOVEI 0,0 ; DOWN FLAG +WON1: LDB A,[221200,,1(C)] ; GET VERSION NUMBER + CAMN A,(P) ; SKIP IF NOT EQUAL + JRST SUPWIN + CAMG A,(P) ; SKIP IF LT + JRST SUBIT + SETO 0, + SUB C,C%22 ; GET NEW C + JRST SUBIT1 + +SUBIT: ADD C,C%22 ; SUBTRACT + JUMPN 0,C1POPJ +SUBIT1: +IFN ITS, CAMN D,(C) ; SEE WHETHER WERE STILL WINNING +IFE ITS,[ + HRRZ F,C + CAMN D,(F) +] + JRST WON1 +C1POPJ: SUB P,C%11 ; GET RID OF VERSION # + POPJ P, ; LOSE LOSE LOSE +SUPWIN: MOVE A,C ; RETURN ARGUMENT IN A + AOS -1(P) ; SKIP RETURN INDICATES IT WAS FOUND + JRST C1POPJ + +LSTHLV: +IFN ITS, CAMN D,(C) ; LINEAR SEARCH REST +IFE ITS,[ + HRRZ F,C + CAMN D,(F) ; LINEAR SEARCH REST +] + JRST WON + ADD C,C%22 + JUMPL C,LSTHLV + JRST C1POPJ + + ; ROUTINE TO GET A DIRECTORY. ASSUMES MAPCH IS OPEN TO FIXUP OR SAV FILE AND 0 IS THE +; LAST CHAR TO BE HASHED. RETURNS POINTER TO DIRECTORY IN E + +IFN ITS,[ +GETDIR: PUSH P,C + PUSH P,0 + PUSHJ P,SQKIL + MOVEI A,1 ; GET A BUFFER + PUSHJ P,GETBUF + MOVEI C,(B) + ASH C,-10. + DOTCAL CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],[1000,,0]] + PUSHJ P,SLEEPR + POP P,0 + IDIV 0,(B) ; A NOW CONTAINS THE DIRECTORY NUMBER + ADDI A,1(B) + DOTCAL CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],(A)] + PUSHJ P,SLEEPR + MOVN E,(B) ; GET -LENGTH OF DIRECTORY + HRLZS E ; BUILD AOBJN PTR TO DIR + HRRI E,1(B) + POP P,C + POPJ P, +] +; IN WONDERFUL TOPS20 VERSION DIRCHN CONTAINS THE JFN + +IFE ITS,[ +GETDIR: JRST @[.+1] + PUSH P,C + PUSH P,0 + PUSHJ P,SQKIL + MOVEI A,1 ; GET A BUFFER + PUSHJ P,GETBUF + HRROI E,(B) + ASH B,-9. + HRLI B,.FHSLF ; SET UP DESTINATION (CORE) + MOVS A,DIRCHN ; SET UP SOURCE (FILE) + MOVSI C,PM%RD+PM%EX ; READ+EXEC ACCESS + PMAP + POP P,0 + IDIV 0,(E) ; A NOW CONTAINS THE DIRECTORY NUMBER + ADDI A,1(E) ; POINT TO THE DIRECTORY ENTRY + MOVE A,(A) ; GET THE PAGE NUMBER + HRL A,DIRCHN ; SET UP SOURCE (FILE) + PMAP ; AGAIN READ IN DIRECTORY + MOVEI A,(E) + MOVN E,(E) ; GET -LENGTH OF DIRECTORY + HRLZS E ; BUILD AOBJN PTR TO DIR + HRRI E,1(A) + POP P,C + SKIPN MULTSG + POPJ P, + POP P,21 + SETZM 20 + XJRST 20 +] +; HERE IF CAN'T FIND FIXUP FILE IN MAIN DIRECTORY + +NOFXUP: +IFE ITS,[ + MOVE A,DIRCHN ; JFN FOR FIXUP FILE + CLOSF ; CLOSE IT + JFCL +] + MOVE A,FXTBL ; GET AOBJN POINTER TO FIXUP TABLE +NOFXU1: HRRZ B,(A) ; GET VERSION TO TRY + HRRM B,VER(P) ; STUFF IN VERSION + MOVEI B,1 ; DUMP IN FIXUP INDICATOR + HRLM B,VER(P) + MOVEM A,TEMP(P) ; SAVE POINTER TO FXTBL + PUSHJ P,OPXFIL ; LOOK FOR FIXUP FILE + JRST NOFXU2 + PUSHJ P,RFXUP ; READ IN THE FIXUP FILE + HRRZS VER(P) ; INDICATE SAV FILE + PUSHJ P,OPXFIL ; TRY OPENING IT + JRST MAPLS0 ; GIVE UP NO SAV FILE TO BE HAD + PUSHJ P,RSAV + JRST FXUPGO ; GO FIXUP THE WORLD +NOFXU2: MOVE A,TEMP(P) ; GET BACK POINTER + AOBJN A,NOFXU1 ; TRY NEXT + JRST MAPLS1 ; NO FILE TO BE HAD + +GETIT: HRRZM B,SPAG(P) ; GET BLOCK OF START + HLRZM B,FLEN(P) ; DAMMIT SAVE THIS! + HLRZ A,B ; GET LENGTH +IFN ITS,[ + .CALL MNBLK + PUSHJ P,TRAGN +] +IFE ITS,[ + MOVE E,MAPJFN + MOVEM E,DIRCHN +] + + JRST PLOD1 + +; ROUTINE TO SEE IF FILE IS NOT OPEN BECAUSE OF FNF AND FATAL IF SO + +IFN ITS,[ +TRAGN: PUSH P,0 ; SAVE 0 + .STATUS MAPCH,0 ; GET STATUS BITS + LDB 0,[220600,,0] + CAIN 0,4 ; SKIP IF NOT FNF + FATAL MAJOR FILE NOT FOUND + POP P,0 + SOS (P) + SOS (P) ; RETRY OPEN + POPJ P, +] +IFE ITS,[ +OPSAV: MOVSI A,%GJSHT+%GJOLD ; BITS FOR GTJFN + HRROI B,SAVSTR ; STRING POINTER + SKIPE OPSYS + HRROI B,TSAVST + GTJFN + FATAL CANT FIND SAV FILE + MOVEM A,MAPJFN ; STORE THE JFN + MOVE B,[440000,,OF%RD+OF%EX+OF%THW+OF%DUD] + OPENF + FATAL CANT OPEN SAV FILE + POPJ P, +] + +; OPMFIL IS USED TO OPEN A FILE ON MUDTMP. IT CAN OPEN EITHER A SAV OR FIXUP FILE +; AND THE VERSION NUMBER IS SPECIFIED. THE ARGUMENTS ARE +; NAM-1(P) HAS SIXBIT OF FILE NAME +; VER-1(P) HAS 0,,VERSION # FOR SAV FILE AND 1,,VERSION# FOR FIXUP FILE +; RETURNS LENGTH OF FILE IN SLEN AND + +; OPXFIL IS A KLUDGE FOR GETTING SAV AND FIXUP FILES OFF OF THE MDLLIB +; DIRECTORY DURING THE CHANGEOVER TO PRE- AND POST- MUDSAV WORLDS + +OPXFIL: MOVEI 0,1 + MOVEM 0,WRT-1(P) + JRST OPMFIL+1 + +OPWFIL: SETOM WRT-1(P) + SKIPA +OPMFIL: SETZM WRT-1(P) + +IFN ITS,[ + HRRZ C,VER-1(P) ; GET VERSION NUMBER + PUSHJ P,NTOSIX ; CONVERT TO SIXBIT + HRLI C,(SIXBIT /SAV/) ; BUILD SECOND FILE NAME + HLRZ 0,VER-1(P) + SKIPE 0 ; SKIP IF SAV + HRLI C,(SIXBIT/FIX/) + MOVE B,NAM-1(P) ; GET NAME + MOVSI A,7 ; WRITE MODE + SKIPL WRT-1(P) + MOVSI A,6 ; READ MODE +RETOPN: .CALL FOPBLK + JRST OPCHK ; SEE IF FIXUP IS NECESSARY OR JUST REOPENING + DOTCAL FILLEN,[[1000,,MAPCH],[2000,,A]] + .LOSE 1000 + ADDI A,PGMSK ; ROUND + ASH A,-PGSHFT ; TO PAGES + MOVEM A,FLEN-1(P) + SETZM SPAG-1(P) + AOS (P) ; SKIP RETURN TO SHOW SUCCESS + POPJ P, + +OPCHK: .STATUS MAPCH,0 ; GET STATUS BITS + LDB 0,[220600,,0] + CAIE 0,4 ; SKIP IF FNF + JRST OPCHK1 ; RETRY + POPJ P, + +OPCHK1: MOVEI 0,1 ; SLEEP FOR A WHILE + .SLEEP + JRST OPCHK + +; NTOSIX GETS NUMBER IN C AND CONVERTS IT TO SIXBIT AND RETURNS RESULT IN C + +NTOSIX: PUSH P,A ; SAVE A AND B + PUSH P,B + PUSH P,D + MOVE D,[220600,,C] + MOVEI A,(C) ; GET NUMBER + MOVEI C,0 + IDIVI A,100. ; GET RESULT OF DIVISION + SKIPN A + JRST ALADD + ADDI A,20 ; CONVERT TO DIGIT + IDPB A,D +ALADD: MOVEI A,(B) + IDIVI A,10. ; GET TENS DIGIT + SKIPN C + SKIPE A ; IF BOTH 0 BLANK DIGIT + ADDI A,20 + IDPB A,D + SKIPN C + SKIPE B + ADDI B,20 + IDPB B,D + POP P,D + POP P,B + POP P,A + POPJ P, + +] + +IFE ITS,[ + MOVE E,P ; save pdl base + MOVE B,NAM-1(E) ; GET FIRST NAME + PUSH P,C%0 ; [0]; slots for building strings + PUSH P,C%0 ; [0] + MOVE A,[440700,,1(E)] + MOVE C,[440600,,B] + +; DUMP OUT SIXBIT NAME + + MOVEI D,6 + ILDB 0,C + JUMPE 0,.+4 ; violate cardinal ".+ rule" + ADDI 0,40 ; to ASCII + IDPB 0,A + SOJG D,.-4 + + MOVE 0,[ASCII / SAV/] + HLRZ C,VER-1(E) ; GET SAV/FIXUP FLAG + SKIPE C + MOVE 0,[ASCII / FIX/] + PUSH P,0 + HRRZ C,VER-1(E) ; get ascii of vers no. + PUSHJ P,NTOSEV ; CONVERT TO STRING LEFT JUSTIFIED + PUSH P,C + MOVEI B,-1(P) ; point to it + HRLI B,260700 + HRROI D,1(E) ; point to name + MOVEI A,1(P) + MOVSI 0,100000 ; INPUT FILE (GJ%OLD) + SKIPGE WRT-1(E) + MOVSI 0,400000 ; OUTPUT FILE (GJ%FOU) + PUSH P,0 + PUSH P,[377777,,377777] + MOVE 0,[-1,,[ASCIZ /DSK/]] + SKIPN OPSYS + MOVE 0,[-1,,[ASCIZ /PS/]] + PUSH P,0 + HRROI 0,[ASCIZ /MDL/] + SKIPLE WRT-1(E) + HRROI 0,[ASCIZ /MDLLIB/] ; USE MDLLIB FOR SPECIAL CASE + PUSH P,0 + PUSH P,D + PUSH P,B + PUSH P,C%0 ; [0] + PUSH P,C%0 ; [0] + PUSH P,C%0 ; [0] + MOVEI B,0 + MOVE D,4(E) ; save final version string + GTJFN + JRST OPMLOS ; FAILURE + MOVEM A,DIRCHN + MOVE B,[440000,,OF%RD+OF%EX] + SKIPGE WRT-1(E) + MOVE B,[440000,,OF%RD+OF%WR] + OPENF + FATAL OPENF FAILED + MOVE P,E ; flush crap + PUSH P,A + SIZEF ; get length + JRST MAPLOS + SKIPL WRT-1(E) + MOVEM C,FLEN-1(E) ; ONLY SAVE LENGTH FOR READ JFNS + SETZM SPAG-1(E) + +; RESTORE STACK AND LEAVE + + MOVE P,E + MOVE A,C ; NUMBER OF PAGES IN A, DAMN! + AOS (P) + POPJ P, + +OPMLOS: MOVE P,E + POPJ P, + +; CONVERT A NUMBER IN C TO AN ASCII STRING LEFT JUSTIFIED IN C + +NTOSEV: PUSH P,A ; SAVE A AND B + PUSH P,B + PUSH P,D + MOVE D,[440700,,C] + MOVEI A,(C) ; GET NUMBER + MOVEI C,0 + IDIVI A,100. ; GET RESULT OF DIVISION + JUMPE A,ALADD + ADDI A,60 ; CONVERT TO DIGIT + IDPB A,D +ALADD: MOVEI A,(B) + IDIVI A,10. ; GET TENS DIGIT + ADDI A,60 + IDPB A,D +ALADD1: ADDI B,60 + IDPB B,D + POP P,D + POP P,B + POP P,A + POPJ P, + +] + +; ROUTINE TO READ IN THE FIXUPS FROM DIRCHN OR MAPCH WORKS +; FOR FIXUP FILE OR FIXUPS IN A SEPERATE FILE AS LONG AS THE +; CHANNEL IS OPENED AND ACCESSED TO THE RIGHT PLACE + +RFXUP: +IFN ITS,[ + MOVE 0,[-2,,A] ; PREPARE TO READ VERSION AND LENGTH + .IOT MAPCH,0 ; READ IT IN + SKIPGE 0 ; SKIP IF NOT HIT EOF + FATAL BAD FIXUP FILE + MOVEI A,-2(A) ; COUNT FOR FIRST 2 WORDS + HRRM B,VER-1(P) ; SAVE VERSION # + .IOPUS MAPCH, ; PUSH THE MAPPING CHANNEL + SETOM PLODR + PUSHJ P,IBLOCK ; GET A UVECTOR OF APPROPRIATE SIZE + SETZM PLODR + .IOPOP MAPCH, + MOVE 0,$TUVEC + MOVEM 0,-1(TP) ; SAVE UVECTOR + MOVEM B,(TP) + MOVE A,B ; GET AOBJN POINTER TO UVECTOR FOR IOT + .IOT MAPCH,A ; GET FIXUPS + .CLOSE MAPCH, + POPJ P, +] + +IFE ITS,[ + MOVE A,DIRCHN + BIN ; GET LENGTH OF FIXUP + MOVE C,B + MOVE A,DIRCHN + BIN ; GET VERSION NUMBER + HRRM B,VER-1(P) + SETOM PLODR + MOVEI A,-2(C) + PUSHJ P,IBLOCK + SETZM PLODR + MOVSI 0,$TUVEC + MOVEM 0,-1(TP) + MOVEM B,(TP) + MOVE A,DIRCHN + HLRE C,B +; SKIPE OPSYS ; SKIP IF TOPS20 SINCE C MUST BE NEGETIVE +; MOVNS C ; C IS POSITIVE FOR TENEX ????? + HRLI B,444400 + SIN + MOVE A,DIRCHN + CLOSF + FATAL CANT CLOSE FIXUP FILE + RLJFN + JFCL + POPJ P, +] + +; ROUTINE TO READ IN THE CODE + +RSAV: MOVE A,FLEN-1(P) + PUSHJ P,ALOPAG ; GET PAGES + JRST MAPLS2 + MOVE E,SPAG-1(P) + +IFN ITS,[ + MOVN A,FLEN-1(P) ; build aobjn pointer + MOVSI A,(A) + HRRI A,(B) + MOVE B,A + HRRI 0,(E) + DOTCAL CORBLK,[[1000,,104000],[1000,,-1],A,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, + POPJ P, +] +IFE ITS,[ + PUSH P,B ; SAVE PAGE # + MOVS A,DIRCHN ; SOURCE (MUDSAV) + HLRM A,SJFNS ; SAVE POINTER FOR FUTURE CLOSING + HRR A,E + HRLI B,.FHSLF ; DESTINATION (FORK) + MOVSI C,PM%RD+PM%CPY ; MAKE COPY ON WRITE + SKIPE OPSYS + JRST RSAV1 ; HANDLE TENEX + TLO C,PM%CNT ; REPEAT COUNT BIT FOR TOPS20 + HRR C,FLEN-2(P) ; PAGE (FOR PUSHJ AND PUSHED B) + PMAP +RSAVDN: POP P,B + MOVN 0,FLEN-1(P) + HRL B,0 + POPJ P, + +RSAV1: HRRZ D,FLEN-2(P) ; GET IN PAGE COUNT +RSAV2: PMAP + ADDI A,1 ; NEXT PAGE + ADDI B,1 + SOJN D,RSAV2 ; LOOP + JRST RSAVDN +] + +PDLOV: SUB P,[NSLOTS,,NSLOTS] + PUSH P,C%0 ; [0]; CAUSE A PDL OVERFLOW + JRST .-1 + +; CONSTANTS RELATED TO DATA BASE +DEV: SIXBIT /DSK/ +MODE: 6,,0 +MNDIR: SIXBIT /MUDSAV/ ; DIR OF MAIN DATA BASE FILES +WRKDIR: SIXBIT /MUDTMP/ ; DIRECTORY OF UPDATE FILES + +IFN ITS,[ +MNBLK: SETZ + SIXBIT /OPEN/ + MODE + DEV + [SIXBIT /SAV/] + [SIXBIT /FILE/] + SETZ MNDIR + + +FIXBLK: SETZ + SIXBIT /OPEN/ + MODE + DEV + [SIXBIT /FIXUP/] + [SIXBIT /FILE/] + SETZ MNDIR + +FOPBLK: SETZ + SIXBIT /OPEN/ + A + DEV + B + C + SETZ WRKDIR + +FXTBL: -2,,.+1 + 55. + 54. +] +IFE ITS,[ + +FXSTR: ASCIZ /PS:FIXUP.FILE/ +SAVSTR: ASCIZ /PS:SAV.FILE/ +TFXSTR: ASCIZ /DSK:FIXUP.FILE/ +TSAVST: ASCIZ /DSK:SAV.FILE/ + +FXTBL: -3,,.+1 + 55. + 54. + 104. +] +IFN SPCFXU,[ + +;This code does two things to code for FBIN; +; 1) Makes dispatches win in multi seg mode +; 2) Makes OBLIST? work with "new" atom format +; 3) Makes LENGTH win in multi seg mode +; 4) Gets AOBJN pointer to code vector in C + +SFIX: PUSH P,A + PUSH P,B + PUSH P,C ; for referring back + +SFIX1: MOVSI B,-MLNT ; for looping through tables + +SFIX2: MOVE A,(C) ; get code word + + AND A,SMSKS(B) + CAMN A,SPECS(B) ; do we match + JRST @SFIXR(B) + + AOBJN B,SFIX2 + +SFIX3: AOBJN C,SFIX1 ; do all of code +SFIX4: POP P,C + POP P,B + POP P,A + POPJ P, + +SMSKS: -1 + 777000,,-1 + -1,,0 + 777037,,0 +MLNT==.-SMSKS + +SPECS: HLRES A ; begin of arg diaptch table + SKIPN 2 ; old compiled OBLIST? + JRST (M) ; compiled LENGTH + ADDI (M) ; begin a case dispatch + +SFIXR: SETZ DFIX + SETZ OBLFIX + SETZ LFIX + SETZ CFIX + +DFIX: AOBJP C,SFIX4 ; make sure dont run out + MOVE A,(C) ; next ins + CAME A,[ASH A,-1] ; still winning? + JRST SFIX3 ; false alarm + AOBJP C,SFIX4 ; make sure dont run out + HLRZ A,(C) ; next ins + CAIE A,(ADDI A,(M)) ; still winning? + JRST SFIX3 ; false alarm + AOBJP C,SFIX4 + HLRZ A,(C) + CAIE A,(PUSHJ P,@(A)) ; last one to check + JRST SFIX3 + AOBJP C,SFIX4 + MOVE A,(C) + CAME A,[JRST FINIS] ; extra check + JRST SFIX3 + + MOVSI B,(SETZ) +SFIX5: AOBJP C,SFIX4 + HLRZ A,(C) + CAIN A,(SUBM M,(P)) + JRST SFIX3 + CAIE A,M ; dispatch entry? + JRST SFIX3 ; maybe already fixed + IORM B,(C) ; fix it + JRST SFIX5 + +OBLFIX: PUSH P,[-TLN,,TPTR] + PUSH P,C + MOVE B,-1(P) + +OBLFXY: PUSH P,1(B) + PUSH P,(B) + +OBLFI1: AOBJP C,OBLFXX + MOVE A,(C) + AOS B,(P) + AND A,(B) + MOVE B,-1(P) + CAME A,(B) + JRST OBLFXX + AOBJP B,DOOBFX + MOVEM B,-1(P) + JRST OBLFI1 + +OBLFXX: SUB P,C%22 ; for checking more ins + MOVE B,-1(P) + ADD B,C%22 + JUMPGE B,OBLFX1 + MOVEM B,-1(P) + MOVE C,(P) + JRST OBLFXY + + +INSBP==331100 ; byte pointer for ins field +ACBP==270400 ; also for ac +INDXBP==220400 + +DOOBFX: MOVE C,-2(P) + SUB P,C%44 + MOVEI B,<<(HRRZ)>_<-9>> ; change em + DPB B,[INSBP,,(C)] ; SKIPN==>HRRZ + LDB A,[ACBP,,(C)] ; get AC field + MOVEI B,<<(JUMPE)>_<-9>> + DPB B,[INSBP,,1(C)] + DPB A,[ACBP,,1(C)] + AOS 1(C) ; JRST FOO==>JUMPE ac,FOO+1 + MOVE B,[CAMG VECBOT] + DPB A,[ACBP,,B] + MOVEM B,2(C) ; JUMPL ==> CAMG ac,VECBOT + HRRZ A,3(C) ; get indicator of existence of ADD AC,TVP + CAIE A,TVP ; skip if extra ins exists + JRST NOATVP + MOVSI A,(JFCL) + EXCH A,4(C) + MOVEM A,3(C) + ADD C,C%11 +NOATVP: TLC B,(CAMG#HRLI) ; change CAMG to HRLI (preserving AC) + HRRZ A,4(C) ; see if moves in type + CAIE A,$TOBLS + SUB C,[1,,1] ; fudge it + HLLOM B,5(C) ; in goes HRLI -1 + CAIE A,$TOBLS ; do we need a skip? + JRST NOOB$ + MOVSI B,(CAIA) ; skipper + EXCH B,6(C) + MOVEM B,7(C) + ADD C,[7,,7] + JRST SFIX3 + +NOOB$: MOVSI B,(JFCL) + MOVEM B,6(C) + ADD C,C%66 + JRST SFIX3 + +OBLFX1: MOVE C,(P) + SUB P,C%22 + JRST SFIX3 + +; Here to fixup compiled LENGTH + +LFIX: MOVSI B,-LLN ; for checking other LENGTH ins + PUSH P,C + +LFIX1: AOBJP C,LFIXY + MOVE A,(C) + AND A,LMSK(B) + CAME A,LINS(B) + JRST LFIXY + AOBJN B,LFIX1 + + POP P,C ; restore code pointer + MOVE A,(C) ; save jump for its addr + MOVE B,[MOVSI 400000] + MOVEM B,(C) ; JRST .+2 ==> MOVSI 0,400000 + LDB B,[ACBP,,1(C)] ; B==> AC of interest + ADDI A,2 + DPB B,[ACBP,,A] + MOVEI B,<<(JUMPE)>_<-9.>> + DPB B,[INSBP,,A] + EXCH A,1(C) + TLC A,(HRR#HRRZ) ; HRR==>HRRZ + HLLZM A,2(C) ; TRNN AC,-1 ==> HRRZ AC,(AC) + MOVEI B,(AOBJN (M)) + HRLM B,3(C) ; AOBJP AC,.-2 ==> AOBJN 0,.-2 + MOVE B,2(C) ; get HRRZ AC,(AC) + TLZ B,17 ; kill (AC) part + MOVEM B,4(C) ; HLRZS AC ==> HRRZ AC,0 + ADD C,C%44 + JRST SFIX3 + +LFIXY: POP P,C + JRST SFIX3 + +; Fixup a CASE dispatch + + CFIX: LDB A,[ACBP,,(C)] + AOBJP C,SFIX4 + HLRZ B,(C) ; Next ins + ANDI B,777760 + CAIE B,(JRST @) + JRST SFIX3 + LDB B,[INDXBP,,(C)] + CAIE A,(B) + JRST SFIX3 + MOVE A,(C) ; ok, fix it up + TLZ A,20 ; kill indirection + MOVEM A,(C) + HRRZ B,-1(C) ; point to table + ADD B,(P) ; point to code to change + +CFIXLP: HLRZ A,(B) ; check one out + TRZ A,400000 ; kill bit + CAIE A,M ; check for just index (or index with SETZ) + JRST SFIX3 + MOVEI A,(JRST (M)) + HRLM A,(B) + AOJA B,CFIXLP + +DEFINE FOO LBL,LNT,LBL2,L +LBL: + IRP A,,[L] + IRP B,C,[A] + B + .ISTOP + TERMIN + TERMIN +LNT==.-LBL +LBL2: + IRP A,,[L] + IRP B,C,[A] + C + .ISTOP + TERMIN + TERMIN +TERMIN + +IMSK==777017,,0 +AIMSK==777000,,-1 + +FOO OINS,OLN,OMSK,[[,IMSK],[,IMSK],[MOVE,AIMSK] + [,AIMSK],[,IMSK] + [,AIMSK],[MOVEI,AIMSK]] + +FOO OINS3,OLN3,OMSK3,[[,IMSK],[,IMSK],[MOVE,AIMSK] + [,IMSK],[MOVEI,AIMSK]] + +FOO OINS2,OLN2,OMSK2,[[,IMSK],[,IMSK],[,AIMSK] + [MOVE,AIMSK],[,AIMSK],[,IMSK] + [,AIMSK],[MOVEI,AIMSK]] + +FOO OINS4,OLN4,OMSK4,[[,IMSK],[,IMSK],[,AIMSK] + [MOVE,AIMSK],[,IMSK],[MOVEI,AIMSK]] + +TPTR: -OLN,,OINS + OMSK-1 + -OLN2,,OINS2 + OMSK2-1 + -OLN3,,OINS3 + OMSK3-1 + -OLN4,,OINS4 + OMSK4-1 +TLN==.-TPTR + +FOO LINS,LLN,LMSK,[[,AIMSK],[,AIMSK],[,IMSK] + [,<-1,,777760>]] + +] +IMPURE + +SAVSNM: 0 ; SAVED SNAME +INPLOD: 0 ; FLAG SAYING WE ARE IN MAPPUR + +IFE ITS,[ +MAPJFN: 0 ; JFN OF SAV FILE +DIRCHN: 0 ; JFN USED BY GETDIR +] + +PURE + +END + diff --git a//mappur.mid.161 b//mappur.mid.161 new file mode 100644 index 0000000..b261d53 --- /dev/null +++ b//mappur.mid.161 @@ -0,0 +1,1975 @@ + +TITLE MAPURE-PAGE LOADER + +RELOCATABLE + +MAPCH==0 ; channel for MAPing +XJRST==JRST 5, + +.GLOBAL PURVEC,PURTOP,PURBOT,P.TOP,GCSTOP,FRETOP,MUDSTR,STRTO6,PLOAD,AGC,GCDOWN +.GLOBAL SQUTOA,IGVAL,IBLOCK,PURCLN,MOVPUR,GETPAG,GCFLG,NOSHUF,DIR,NDIRS,SQUPNT +.GLOBAL PLODR,SQUKIL,GETBUF,KILBUF,INPLOD,SQKIL,PVSTOR,TVSTOR,DSTOREM,SLEEPR +.GLOBAL OPSYS,SJFNS,MULTSG,PURBTB,SFIX,NSEGS +.GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10 +.GLOBAL C%M20,C%M30,C%M40,C%M60 +.GLOBAL MAPJFN,DIRCHN + +.INSRT MUDDLE > +SPCFXU==1 +SYSQ + +IFE ITS,[ +IF1, .INSRT STENEX > +] + +F==PVP +G==TVP +H==SP +RDTP==1000,,200000 +FME==1000,,-1 + + +IFN ITS,[ +PGMSK==1777 +PGSHFT==10. +] + +IFE ITS,[ +FLUSHP==0 +PGMSK==777 +PGSHFT==9. +] + +LNTBYT==340700 +ELN==4 ; LENGTH OF SLOT +FB.NAM==0 ; NAME SLOT IN TABLE +FB.PTR==1 ; Pointer to core pages +FB.AGE==2 ; age,,chain +FB.PGS==3 ; PTR AND LENGTH OF PAGE IN FILE +FB.AMK==37777777 ; extended address mask +FB.CNT==<-1># ; page count mask +EOC==400000 ; END OF PURVEC CHAIN + +IFE ITS,[ +.FHSLF==400000 ; THIS FORK +%GJSHT==000001 ; SHORT FORM GTJFN +%GJOLD==100000 + ;PMAP BITS +PM%CNT==400000 ; PMAP WITH REPEAT COUNT +PM%RD==100000 ; PMAP WITH READ ACCESS +PM%EX==20000 ; PMAP WITH EXECUTE ACCESS (NO-OP ON 20X) +PM%CPY==400 ; PMAP WITH COPY-ON-WRITE ACCESS +PM%WR==40000 ; PMAP WITH WRITE ACCESS + + ;OPENF BITS +OF%RD==200000 ; OPEN IN READ MODE +OF%WR==100000 ; OPEN IN WRITE MODE +OF%EX==040000 ; OPEN IN EXECUTE MODE (TENEX CARES) +OF%THW==02000 ; OPEN IN THAWED MODE +OF%DUD==00020 ; DON'T UPDATE THAWED PAGES +] +; THIS ROUTINE TAKES A SLOT OFFSET IN REGISTER A AND MAPS IN THE ASSOCIATED +; FILE. IT CLOBBERS ALL ACs AND SKIP RETURNS IF IT WINS. + +OFF==-5 ; OFFSET INTO PURVEC OF SLOT +NAM==-4 ; SIXBIT NAME OF THING BEING LOADED +LASTC==-3 ; LAST CHARACTER OF THE NAME +DIR==-2 ; SAVED POINTER TO DIRECTORY +SPAG==-1 ; FIRST PAGE IN FILE +PGNO==0 ; FIRST PAGE IN CORE +VER==-6 ; VERSION NUMBER OF MUDDLE TO USE IN OPENING FILES +FLEN==-7 ; LENGTH OF THE FILE +TEMP==-10 ; GENERAL TEMPORARY SLOT +WRT==-11 ; INDICATION IF OPEN IS FOR WRITING OR READING +CADDR==-12 ; ADDRESS OF CORE IMAGE LOCATION OF FILE +NSLOTS==13 + +; IT FIRST LOOKS TO SEE IF IT HAS THE PAGE NUMBER OF THE FILE + +PLOAD: ADD P,[NSLOTS,,NSLOTS] + SKIPL P + JRST PDLOV + MOVEM A,OFF(P) + PUSH TP,C%0 ; [0] + PUSH TP,C%0 ; [0] +IFE ITS,[ + SKIPN MAPJFN + PUSHJ P,OPSAV +] + +PLOADX: PUSHJ P,SQKIL + MOVE A,OFF(P) + ADD A,PURVEC+1 ; GET TO SLOT + SKIPE B,FB.PGS(A) ; SKIP IF PAGE NUMBER + JRST GETIT + MOVE B,FB.NAM(A) + MOVEM B,NAM(P) + MOVE 0,B + MOVEI A,6 ; FIND LAST CHARACTER + TRNE 0,77 ; SKIP IF NOT DONE + JRST .+3 + LSH 0,-6 ; BACK A CHAR + SOJG A,.-3 ; NOW CHAR IS BACKED OUT + ANDI 0,77 ; LASTCHR + MOVEM 0,LASTC(P) + +; NOT TO TRY TO FIND FILE IN MAIN DATA BASE. +; THE GC'S WINDOW IS USED IN THIS CASE. + +IFN ITS,[ + .CALL MNBLK ; OPEN CHANNEL TO MAIN FILE + JRST NTHERE + PUSHJ P,TRAGN ; TRY OPENING UP CHANNEL AGAIN IF POSSIBLE +] +IFE ITS,[ + SKIPN E,MAPJFN + JRST NTHERE ;who cares if no SAV.FILE? + MOVEM E,DIRCHN +] + MOVE D,NAM(P) + MOVE 0,LASTC(P) + PUSHJ P,GETDIR + MOVEM E,DIR(P) + PUSHJ P,GENVN ; GET VERSION # AS FIX + MOVE E,DIR(P) + MOVE D,NAM(P) + MOVE A,B + PUSHJ P,DIRSRC ; SEARCH DIRECTORY + JRST NTHERE ; GO TRY FIXING UP ITS NOT THERE + ANDI A,-1 ; WIN IN MULT SEG CASE + MOVE B,OFF(P) ; GET SLOT NUMBER + ADD B,PURVEC+1 ; POINT TO SLOT + HRRZ C,1(A) ; GET BLOCK NUMBER + HRRM C,FB.PGS(B) ; SMASH INTO SLOT + LDB C,[LNTBYT,,1(A)] ; SMASH IN LENGTH + HRLM C,FB.PGS(B) ; SMASH IN LENGTH + JRST PLOADX + +; NOW TRY TO FIND FILE IN WORKING DIRECTORY + +NTHERE: PUSHJ P,KILBUF + MOVE A,OFF(P) ; GET POINTER TO PURVEC SLOT + ADD A,PURVEC+1 + PUSHJ P,GENVN ; GET VERSION NUMBER + HRRZM B,VER(P) + PUSHJ P,OPMFIL ; OPEN FILE + JRST FIXITU + +; NUMBER OF PAGES ARE IN A +; STARTING PAGE NUMBER IN SPAG(P) + +PLOD1: PUSHJ P,ALOPAG ; get the necessary pages + JRST MAPLS2 + MOVE E,SPAG(P) ; E starting page in file + MOVEM B,PGNO(P) +IFN ITS,[ + MOVN A,FLEN(P) ; get neg count + MOVSI A,(A) ; build aobjn pointer + HRR A,PGNO(P) ; get page to start + MOVE B,A ; save for later + HRRI 0,(E) ; page pointer for file + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, ; no need to have file open anymore +] +IFE ITS,[ + MOVEI A,(E) ; First page on rh of A + HRL A,DIRCHN ; JFN to lh of A + HRLI B,.FHSLF ; specify this fork + MOVSI C,PM%RD+PM%EX ; bits for read/execute + MOVE D,FLEN(P) ; # of pages to D + HRROI E,(B) ; build page aobjn for later + TLC E,-1(D) ; sexy way of doing lh + + SKIPN OPSYS + JRST BLMAP ; if tops-20 can block PMAP + PMAP + ADDI A,1 + ADDI B,1 + SOJG D,.-3 ; map 'em all + MOVE B,E + JRST PLOAD1 + +BLMAP: HRRI C,(D) + TLO C,PM%CNT ; say it is counted + PMAP ; one PMAP does the trick + MOVE B,E +] +; now try to smash slot in PURVEC + +PLOAD1: MOVE A,PURVEC+1 ; get pointer to it + ASH B,PGSHFT ; convert to aobjn pointer to words + MOVE C,OFF(P) ; get slot offset + ADDI C,(A) ; point to slot + MOVEM B,FB.PTR(C) ; clobber it in + TLZ B,(FB.CNT) ; isolate address of page + HRRZ D,PURVEC ; get offset into vector for start of chain + TRNE D,EOC ; skip if not end marker + JRST SCHAIN + HRLI D,400000+A ; set up indexed pointer + ADDI D,1 +IFN ITS, HRRZ 0,@D ; get its address +IFE ITS,[ + MOVE 0,@D + TLZ 0,(FB.CNT) +] + JUMPE 0,SCHAIN ; no chain exists, start one + CAMLE 0,B ; skip if new one should be first + AOJA D,INLOOP ; jump into the loop + + SUBI D,1 ; undo ADDI +FCLOB: MOVE E,OFF(P) ; get offset for this guy + HRRM D,FB.AGE(C) ; link up + HRRM E,PURVEC ; store him away + JRST PLOADD + +SCHAIN: MOVEI D,EOC ; get end of chain indicator + JRST FCLOB ; and clobber it in + +INLOOP: MOVE E,D ; save in case of later link up + HRR D,@D ; point to next table entry + TRNE D,EOC ; 400000 is the end of chain bit + JRST SLFOUN ; found a slot, leave loop + ADDI D,1 ; point to address of progs +IFN ITS, HRRZ 0,@D ; get address of block +IFE ITS,[ + MOVE 0,@D + TLZ 0,(FB.CNT) +] + CAMLE 0,B ; skip if still haven't fit it in + AOJA D,INLOOP ; back to loop start and point to chain link + SUBI D,1 ; point back to start of slot + +SLFOUN: MOVE 0,OFF(P) ; get offset into vector of this guy + HRRM 0,@E ; make previous point to us + HRRM D,FB.AGE(C) ; link it in + + +PLOADD: AOS -NSLOTS(P) ; skip return + MOVE B,FB.PTR(C) + +MAPLOS: SUB P,[NSLOTS,,NSLOTS] ; flush stack crap + SUB TP,C%22 + POPJ P, + + +MAPLS0: ERRUUO EQUOTE NO-SAV-FILE + JRST MAPLOS + +MAPLS1: ERRUUO EQUOTE NO-FIXUP-FILE + JRST MAPLOS + +MAPLS2: ERRUUO EQUOTE NO-ROOM-AVAILABLE + JRST MAPLOS + +FIXITU: + +;OPEN FIXUP FILE ON MUDSAV + +IFN ITS,[ + .CALL FIXBLK ; OPEN UP FIXUP FILE + PUSHJ P,TRAGN ; SEE IF TOTALLY LOSING +] +IFE ITS,[ + MOVSI A,%GJSHT ; GTJFN BITS + HRROI B,FXSTR + SKIPE OPSYS + HRROI B,TFXSTR + GTJFN + FATAL FIXUP FILE NOT FOUND + MOVEM A,DIRCHN + MOVE B,[440000,,OF%RD+OF%EX] + OPENF + FATAL FIXUP FILE CANT BE OPENED +] + + MOVE 0,LASTC(P) ; GET DIRECTORY + PUSHJ P,GETDIR + MOVE D,NAM(P) + PUSHJ P,DIRSR1 ; SEARCH DIRECTORY FOR FIXUP + JRST NOFXUP ; NO FIXUP IN MAIN DIRECTORY + ANDI A,-1 ; WIN IN MULTI SEGS + HRRZ A,1(A) ; GET BLOCK NUMBER OF START + ASH A,8. ; CONVERT TO WORDS +IFN ITS,[ + .ACCES MAPCH,A ; ACCESS FILE +] + +IFE ITS,[ + MOVEI B,(A) + MOVE A,DIRCHN + SFPTR + JFCL +] + PUSHJ P,KILBUF +FIXT1: PUSHJ P,RFXUP ; READ IN THE FIXUP FILE + +IFN ITS,[ + .CALL MNBLK ; REOPEN SAV FILE + PUSHJ P,TRAGN +] + +IFE ITS,[ + MOVE A,MAPJFN ; SET UP DIRCHAN AGAIN + MOVEM A,DIRCHN +] + +; NOW TRY TO LOCATE SAV FILE + + MOVE 0,LASTC(P) ; GET LASTCHR + PUSHJ P,GETDIR ; GET DIRECTORY + HRRZ A,VER(P) ; GET VERSION # + MOVE D,NAM(P) ; GET NAME OF FILE + PUSHJ P,DIRSRC ; SEARCH DIRECTORY + JRST MAPLS1 ; NO SAV FILE THERE + ANDI A,-1 + HRRZ E,1(A) ; GET STARTING BLOCK # + LDB A,[LNTBYT,,1(A)] ; GET LENGTH INTO A + MOVEM A,FLEN(P) ; SAVE LENGTH + MOVEM E,SPAG(P) ; SAVE STARTING BLOCK NUMBER + PUSHJ P,KILBUF + PUSHJ P,RSAV ; READ IN CODE +; now to do fixups + +FXUPGO: MOVE A,(TP) ; pointer to them + SETOM INPLOD ; ABSOLUTE CLUDGE TO PREVENT BUFFER FROM + ; SCREWING US +IFE ITS,[ + SKIPN MULTSG + JRST FIXMLT + HRRZ D,B ; this codes gets us running in the correct + ; segment + ASH D,PGSHFT + HRRI D,FIXMLT + MOVEI C,0 + XJRST C ; good bye cruel segment (will work if we fell + ; into segment 0) +FIXMLT: ASH B,PGSHFT ; aobjn to program + +FIX1: SKIPL E,(A) ; read one hopefully squoze + FATAL ATTEMPT TO TYPE FIX PURE + TLZ E,740000 + +NOPV1: PUSHJ P,SQUTOA ; look it up + FATAL BAD FIXUPS + +; N.B. THE VALUE IN THE FIXUPS FOR AN ADDRESS CAN BE NEGATIVE. IF THIS HAPPENS +; IT MEANS THAT THE LEFT HALF CONTAINS THE VALUE INSTEAD OF THE RIGHT HALF +NOPV2: AOBJP A,FIX2 + HLRZ D,(A) ; get old value + HRRZS E + SUBM E,D ; D is diff between old and new + HRLM E,(A) ; fixup the fixups +NOPV3: MOVEI 0,0 ; flag for which half +FIX4: JUMPE 0,FIXRH ; jump if getting rh + MOVEI 0,0 ; next time will get rh + AOBJP A,FIX2 ; done? + HLRE C,(A) ; get lh + JUMPE C,FIX3 ; 0 terminates +FIX5: SKIPGE C ; If C is negative then left half garbage + JRST FIX6 + ADDI C,(B) ; access the code + +NOPV4: ADDM D,-1(C) ; and fix it up + JRST FIX4 + +; FOR LEFT HALF CASE + +FIX6: MOVNS C ; GET TO ADRESS + ADDI C,(B) ; ACCESS TO CODE + HLRZ E,-1(C) ; GET OUT WORD + ADDM D,E ; FIX IT UP + HRLM E,-1(C) + JRST FIX4 + +FIXRH: MOVEI 0,1 ; change flag + HRRE C,(A) ; get it and + JUMPN C,FIX5 + +FIX3: AOBJN A,FIX1 ; do next one + +IFN SPCFXU,[ + MOVE C,B + PUSHJ P,SFIX +] + PUSHJ P,SQUKIL ; KILL SQUOZE TABLE + SETZM INPLOD +FIX2: + HRRZS VER(P) ; INDICATE SAV FILE + MOVEM B,CADDR(P) + PUSHJ P,GENVN + HRRM B,VER(P) + PUSHJ P,OPWFIL + FATAL MAP FIXUP LOSSAGE +IFN ITS,[ + MOVE B,CADDR(P) + .IOT MAPCH,B ; write out the goodie + .CLOSE MAPCH, + PUSHJ P,OPMFIL + FATAL WHERE DID THE FILE GO? + MOVE E,CADDR(P) + ASH E,-PGSHFT ; to page AOBJN + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, +] + + +IFE ITS,[ + MOVE A,DIRCHN ; GET JFN + MOVE B,CADDR(P) ; ready to write it out + HRLI B,444400 + HLRE C,CADDR(P) + SOUT ; zap it out + TLO A,400000 ; dont recycle the JFN + CLOSF + JFCL + ANDI A,-1 ; kill sign bit + MOVE B,[440000,,240000] + OPENF + FATAL MAP FIXUP LOSSAGE + MOVE B,CADDR(P) + ASH B,-PGSHFT ; aobjn to pages + HLRE D,B ; -count + HRLI B,.FHSLF + MOVSI A,(A) + MOVSI C,PM%RD+PM%EX + PMAP + ADDI A,1 + ADDI B,1 + AOJN D,.-3 +] + + SKIPGE MUDSTR+2 + JRST EFIX2 ; exp vers, dont write out +IFE ITS,[ + HRRZ A,SJFNS ; get last jfn from savxxx file + JUMPE A,.+4 ; oop + CAME A,MAPJFN + CLOSF ; close it + JFCL + HLLZS SJFNS ; zero the slot +] + MOVEI 0,1 ; INDICATE FIXUP + HRLM 0,VER(P) + PUSHJ P,OPWFIL + FATAL CANT WRITE FIXUPS + +IFN ITS,[ + MOVE E,(TP) + HLRE A,E ; get length + MOVNS A + ADDI A,2 ; account for these 2 words + MOVE 0,[-2,,A] ; write version and length + .IOT MAPCH,0 + .IOT MAPCH,E ; out go the fixups + SETZB 0,A + MOVEI B,MAPCH + .CLOSE MAPCH, +] + +IFE ITS,[ + MOVE A,DIRCHN + HLRE B,(TP) ; length of fixup vector + MOVNS B + ADDI B,2 ; for length and version words + BOUT + PUSHJ P,GENVN + BOUT + MOVSI B,444400 ; byte pointer to fixups + HRR B,(TP) + HLRE C,(TP) + SOUT + CLOSF + JFCL +] + +EFIX2: MOVE B,CADDR(P) + ASH B,-PGSHFT + JRST PLOAD1 + +; Here to try to get a free page block for new thing +; A/ # of pages to get + +ALOPAG: MOVE C,GCSTOP ; FOOL GETPAG + ADDI C,3777 + ASH C,-PGSHFT + MOVE B,PURBOT +IFE ITS,[ + SKIPN MULTSG ; skip if multi-segments + JRST ALOPA1 +; Compute the "highest" PURBOT (i.e. find the least busy segment) + + PUSH P,E + PUSH P,A + MOVN A,NSEGS ; aobjn pntr to table + HRLZS A + MOVEI B,0 +ALOPA3: CAML B,PURBTB(A) ; if this one is larger + JRST ALOPA2 + MOVE B,PURBTB(A) ; use it + MOVEI E,FSEG(A) ; and the segment # +ALOPA2: AOBJN A,ALOPA3 + POP P,A +] + +ALOPA1: ASH B,-PGSHFT + SUBM B,C ; SEE IF ROOM + CAIL C,(A) + JRST ALOPGW + PUSHJ P,GETPAX ; try to get enough pages +IFE ITS, JRST EPOPJ +IFN ITS, POPJ P, + +ALOPGW: +IFN ITS, AOS (P) ; won skip return +IFE ITS,[ + SKIPE MULTSG + AOS -1(P) ; ret addr + SKIPN MULTSG + AOS (P) +] + MOVE 0,PURBOT +IFE ITS,[ + SKIPE MULTSG + MOVE 0,PURBTB-FSEG(E) +] + ASH 0,-PGSHFT + SUBI 0,(A) + MOVE B,0 +IFE ITS,[ + SKIPN MULTSG + JRST ALOPW1 + ASH 0,PGSHFT + HRRZM 0,PURBTB-FSEG(E) + ASH E,PGSHFT ; INTO POSITION + IORI B,(E) ; include segment in address + POP P,E + JRST ALOPW2 +] +ALOPW1: ASH 0,PGSHFT +ALOPW2: CAMGE 0,PURBOT + MOVEM 0,PURBOT + CAML 0,P.TOP + POPJ P, +IFE ITS,[ + SUBI 0,1777 + ANDCMI 0,1777 +] + MOVEM 0,P.TOP + POPJ P, + +EPOPJ: SKIPE MULTSG + POP P,E + POPJ P, +IFE ITS,[ +GETPAX: TDZA B,B ; here if other segs ok +GETPAG: MOVEI B,1 ; here for only main segment + JRST @[.+1] ; run in sect 0 + MOVNI E,1 +] +IFN ITS,[ +GETPAX: +GETPAG: +] + MOVE C,P.TOP ; top of GC space + ASH C,-PGSHFT ; to page number +IFE ITS,[ + SKIPN MULTSG + JRST GETPA9 + JUMPN B,GETPA9 ; if really wan all segments, + ; must force all to be free + PUSH P,A + MOVN A,NSEGS ; aobjn pntr to table + HRLZS A + MOVE B,P.TOP +GETPA8: CAMLE B,PURBTB(A) ; if this one is larger (or the same) + JRST GETPA7 + MOVE B,PURBTB(A) ; use it + MOVEI E,FSEG(A) ; and the segment # +GETPA7: AOBJN A,GETPA8 + POP P,A + JRST .+2 +] +GETPA9: MOVE B,PURBOT + ASH B,-PGSHFT ; also to pages + SUBM B,C ; pages available ==> C + CAMGE C,A ; skip if have enough already + JRST GETPG1 ; no, try to shuffle around + SUBI B,(A) ; B/ first new page +CPOPJ1: AOS (P) +IFN ITS, POPJ P, +IFE ITS,[ +SPOPJ: SKIPN MULTSG + POPJ P, ; return with new free page in B + ; (and seg# in E?) + POP P,21 + SETZM 20 + XJRST 20 +] +; Here if shuffle must occur or gc must be done to make room + +GETPG1: MOVEI 0,0 + SKIPE NOSHUF ; if can't shuffle, then ask gc + JRST ASKAGC + MOVE 0,PURTOP ; get top of mapped pure area + SUB 0,P.TOP + ASH 0,-PGSHFT ; to pages + CAMGE 0,A ; skip if winnage possible + JRST ASKAGC ; please AGC give me some room!! + SUBM A,C ; C/ amount we must flush to make room + +IFE ITS,[ + SKIPE MULTSG ; if multi and getting in all segs + JUMPL E,LPGL1 ; check out each and every segment + + PUSHJ P,GL1 + + SKIPE MULTSG + PUSHJ P,PURTBU ; update PURBOT in multi case + + JRST GETPAX + +LPGL1: PUSH P,A + PUSH P,[FSEG-1] + +LPGL2: AOS E,(P) ; count segments + MOVE B,NSEGS + ADDI B,FSEG + CAML E,B + JRST LPGL3 + PUSH P,C + MOVE C,PURBOT ; fudge so look for appropriate amt + SUB C,PURBTB-FSEG(E) + ASH C,-PGSHFT ; to pages + ADD C,(P) + SKIPLE C ; none to flush + PUSHJ P,GL1 + HRRZ E,-1(P) ; fet section again + HRRZ B,PURBOT + HRRZ C,PURBTB-FSEG(E) ; lets share with 0 again + SUB C,B + HRL B,E ; get segment + MOVEI A,(B) + ASH B,-PGSHFT + ASH A,-PGSHFT + HRLI A,.FHSLF + HRLI B,.FHSLF + ASH C,-PGSHFT + HRLI C,PM%CNT+PM%RD+PM%WR+PM%EX + PMAP +LPGL4: POP P,C + JRST LPGL2 + +LPGL3: SUB P,C%11 + POP P,A + + SKIPE MULTSG + PUSHJ P,PURTBU ; update PURBOT in multi case + + JRST GETPAG +] +; Here to find pages for flush using LRU algorithm (in multi seg mode, only +; care about the segment in E) + +GL1: MOVE B,PURVEC+1 ; get pointer to pure sr vector + MOVEI 0,-1 ; get very large age + +GL2: SKIPL FB.PTR(B) ; skip if not already flushed + JRST GL3 +IFE ITS,[ + SKIPN MULTSG + JRST GLX + LDB D,[220500,,FB.PTR(B)] ; get segment # + CAIE D,(E) + JRST GL3 ; wrong swegment, ignore +] +GLX: HLRZ D,FB.AGE(B) ; get this ones age + CAMLE D,0 ; skip if this is a candidate + JRST GL3 + MOVE F,B ; point to table entry with E + MOVEI 0,(D) ; and use as current best +GL3: ADD B,[ELN,,ELN] ; look at next + JUMPL B,GL2 + + HLRE B,FB.PTR(F) ; get length of flushee + ASH B,-PGSHFT ; to negative # of pages + ADD C,B ; update amount needed +IFN ITS,SETZM FB.PTR(F) ; indicate it will be gone +IFE ITS,MOVNS FB.PTR(F) ; save page info for flushing pages + JUMPG C,GL1 ; jump if more to get + +; Now compact pure space + + PUSH P,A ; need all acs + HRRZ D,PURVEC ; point to first in core addr order + HRRZ C,PURTOP +IFE ITS,[ + SKIPE MULTSG + HRLI C,(E) ; adjust for segment +] + ASH C,-PGSHFT ; to page number + SETZB F,A + +CL1: ADD D,PURVEC+1 ; to real pointer + SKIPGE FB.PTR(D) ; skip if this one is a flushee + JRST CL2 ; this one stays + +IFE ITS,[ + PUSH P,C + PUSH P,D + HRRZ C,FB.PGS(D) ; is this from SAV FILE? + JUMPN C,CLFOUT ; yes. don't bother flushing pages + MOVN C,FB.PTR(D) ; get aobjn pointer to code in C + SETZM FB.PTR(D) ; and flush this because it works (sorry) + ASH C,-PGSHFT ; pages speak louder than words + HLRE D,C ; # of pages saved here for unmap + HRLI C,.FHSLF ; C now contains myfork,,lowpage + MOVE A,C ; put that in A for RMAP + RMAP ; A now contains JFN in left half + MOVE B,C ; ac roulette: get fork,,page into B for PMAP + HLRZ C,A ; hold JFN in C for future CLOSF + MOVNI A,1 ; say this page to be unmapped +CLFLP: PMAP ; do the unmapping + ADDI B,1 ; next page + AOJL D,CLFLP ; continue for all pages + MOVE A,C ; restore JFN + CLOSF ; and close it, throwing away the JFN + JFCL ; should work in 95/100 cases +CLFOU1: POP P,D ; fatal error if can't close + POP P,C +] + HRRZ D,FB.AGE(D) ; point to next one in chain + JUMPN F,CL3 ; jump if not first one + HRRM D,PURVEC ; and use its next as first + JRST CL4 + +IFE ITS,[ +CLFOUT: SETZM FB.PTR(D) ; zero the code pointer + JRST CLFOU1 +] + +CL3: HRRM D,FB.AGE(F) ; link up + JRST CL4 + +; Found a stayer, move it if necessary + +CL2: +IFE ITS,[ + SKIPN MULTSG + JRST CL9 + LDB F,[220500,,FB.PTR(D)] ; check segment + CAIE E,(F) + JRST CL6X ; no other segs move at all +] +CL9: MOVEI F,(D) ; another pointer to slot + HLRE B,FB.PTR(D) ; - length of block +IFE ITS,[ + TRZ B,<-1>#<(FB.CNT)> + MOVE D,FB.PTR(D) ; pointer to block + TLZ D,(FB.CNT) ; kill count bits +] +IFN ITS, HRRZ D,FB.PTR(D) + SUB D,B ; point to top of block + ASH D,-PGSHFT ; to page number + CAMN D,C ; if not moving, jump + JRST CL6 + + ASH B,-PGSHFT ; to pages +IFN ITS,[ +CL5: SUBI C,1 ; move to pointer and from pointer + SUBI D,1 + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],C,[1000,,-1],D] + .LOSE %LSSYS + AOJL B,CL5 ; count down +] +IFE ITS,[ + PUSH P,B ; save # of pages + MOVEI A,-1(D) ; copy from pointer + HRLI A,.FHSLF ; get this fork code + RMAP ; get a JFN (hopefully) + EXCH D,(P) ; D # of pages (save from) + ADDM D,(P) ; update from + MOVEI B,-1(C) ; to pointer in B + HRLI B,.FHSLF + MOVSI C,PM%RD+PM%EX ; read/execute modes + + SKIPN OPSYS + JRST CCL1 + PMAP ; move a page + SUBI A,1 + SUBI B,1 + AOJL D,.-3 ; move them all + AOJA B,CCL2 + +CCL1: TLO C,PM%CNT + MOVNS D + SUBI B,-1(D) + SUBI A,-1(D) + HRRI C,(D) + PMAP + +CCL2: MOVEI C,(B) + POP P,D +] +; Update the table address for this loser + + SUBM C,D ; compute offset (in pages) + ASH D,PGSHFT ; to words + ADDM D,FB.PTR(F) ; update it +CL7: HRRZ D,FB.AGE(F) ; chain on +CL4: TRNN D,EOC ; skip if end of chain + JRST CL1 + + ASH C,PGSHFT ; to words +IFN ITS, MOVEM C,PURBOT ; reset pur bottom +IFE ITS,[ + SKIPN MULTSG + JRST CLXX + + HRRZM C,PURBTB-FSEG(E) + CAIA +CLXX: MOVEM C,PURBOT ; reset pur bottom +] + POP P,A + POPJ P, + +IFE ITS,[ +CL6X: MOVEI F,(D) ; chain on + JRST CL7 +] +CL6: +IFN ITS, HRRZ C,FB.PTR(F) ; get new top of world +IFE ITS,[ + MOVE C,FB.PTR(F) + TLZ C,(FB.CNT) +] + ASH C,-PGSHFT ; to page # + JRST CL7 + +IFE ITS,[ +PURTBU: PUSH P,A + PUSH P,B + + MOVN B,NSEGS + HRLZS B + MOVE A,PURTOP + +PURTB2: CAMGE A,PURBTB(B) + JRST PURTB1 + MOVE A,PURBTB(B) + MOVEM A,PURBOT +PURTB1: AOBJN B,PURTB2 + + POP P,B + POP P,A + POPJ P, +] + + ; SUBR to create an entry in the vector for one of these guys + +MFUNCTION PCODE,SUBR + + ENTRY 2 + + GETYP 0,(AB) ; check 1st arg is string + CAIE 0,TCHSTR + JRST WTYP1 + GETYP 0,2(AB) ; second must be fix + CAIE 0,TFIX + JRST WTYP2 + + MOVE A,(AB) ; convert name of program to sixbit + MOVE B,1(AB) + PUSHJ P,STRTO6 +PCODE4: MOVE C,(P) ; get name in sixbit + +; Now look for either this one or an empty slot + + MOVEI E,0 + MOVE B,PURVEC+1 + +PCODE2: CAMN C,FB.NAM(B) ; skip if this is not it + JRST PCODE1 ; found it, drop out of loop + JUMPN E,.+3 ; dont record another empty if have one + SKIPN FB.NAM(B) ; skip if slot filled + MOVE E,B ; remember pointer + ADD B,[ELN,,ELN] + JUMPL B,PCODE2 ; jump if more to look at + + JUMPE E,PCODE3 ; if E=0, error no room + MOVEM C,FB.NAM(E) ; else stash away name and zero rest + SETZM FB.PTR(E) + SETZM FB.AGE(E) + CAIA +PCODE1: MOVE E,B ; build ,, + MOVEI 0,0 ; flag whether new slot + SKIPE FB.PTR(E) ; skip if mapped already + MOVEI 0,1 + MOVE B,3(AB) + HLRE D,E + HLRE E,PURVEC+1 + SUB D,E + HRLI B,(D) + MOVSI A,TPCODE + SKIPN NOSHUF ; skip if not shuffling + JRST FINIS + JUMPN 0,FINIS ; jump if winner + PUSH TP,A + PUSH TP,B + HLRZ A,B + PUSHJ P,PLOAD + JRST PCOERR + POP TP,B + POP TP,A + JRST FINIS + +PCOERR: ERRUUO EQUOTE PURE-LOAD-FAILURE + +PCODE3: HLRE A,PURVEC+1 ; get current length + MOVNS A + ADDI A,10*ELN ; add 10(8) more entry slots + PUSHJ P,IBLOCK + EXCH B,PURVEC+1 ; store new one and get old + HLRE A,B ; -old length to A + MOVSI B,(B) ; start making BLT pointer + HRR B,PURVEC+1 + SUBM B,A ; final dest to A +IFE ITS, HRLI A,-1 ; force local index + BLT B,-1(A) + JRST PCODE4 + +; Here if must try to GC for some more core + +ASKAGC: SKIPE GCFLG ; if already in GC, lose +IFN ITS, POPJ P, +IFE ITS, JRST SPOPJ + MOVEM A,0 ; amount required to 0 + ASH 0,PGSHFT ; TO WORDS + MOVEM 0,GCDOWN ; pass as funny arg to AGC + EXCH A,C ; save A from gc's destruction +IFN ITS,.IOPUSH MAPCH, ; gc uses same channel + PUSH P,C + SETOM PLODR + MOVE C,[8,,9.] ; SET UP INDICATORS FOR GC + PUSHJ P,AGC + SETZM PLODR + POP P,C +IFN ITS,.IOPOP MAPCH, + EXCH C,A +IFE ITS,[ + JUMPL C,.+3 + JUMPL E,GETPAG + JRST GETPAX +] +IFN ITS, JUMPGE C,GETPAG + ERRUUO EQUOTE NO-MORE-PAGES + +; Here to clean up pure space by flushing all shared stuff + +PURCLN: SKIPE NOSHUF + POPJ P, + MOVEI B,EOC + HRRM B,PURVEC ; flush chain pointer + MOVE B,PURVEC+1 ; get pointer to table +CLN1: SETZM FB.PTR(B) ; zero pointer entry + SETZM FB.AGE(B) ; zero link and age slots + SETZM FB.PGS(B) + ADD B,[ELN,,ELN] ; go to next slot + JUMPL B,CLN1 ; do til exhausted + MOVE B,PURBOT ; now return pages + SUB B,PURTOP ; compute page AOBJN pointer +IFE ITS, SETZM MAPJFN ; make sure zero mapjfn + JUMPE B,CPOPJ ; no pure pages? + MOVSI B,(B) + HRR B,PURBOT + ASH B,-PGSHFT +IFN ITS,[ + DOTCAL CORBLK,[[1000,,0],[1000,,-1],B] + .LOSE %LSSYS +] +IFE ITS,[ + + SKIPE MULTSG + JRST CLN2 + HLRE D,B ; - # of pges to flush + HRLI B,.FHSLF ; specify hacking hom fork + MOVNI A,1 + MOVEI C,0 + + PMAP + ADDI B,1 + AOJL D,.-2 +] + + MOVE B,PURTOP ; now fix up pointers + MOVEM B,PURBOT ; to indicate no pure +CPOPJ: POPJ P, + +IFE ITS,[ +CLN2: HLRE C,B ; compute pos no. pages + HRLI B,.FHSLF + MOVNS C + MOVNI A,1 ; flushing pages + HRLI C,PM%CNT + MOVE D,NSEGS + MOVE E,PURTOP ; for munging table + ADDI B,_9. ; do it to the correct segment + PMAP + ADDI B,1_9. ; cycle through segments + HRRZM E,PURBTB(D) ; mung table + SOJG D,.-3 + + MOVEM E,PURBOT + POPJ P, +] + +; Here to move the entire pure space. +; A/ # and direction of pages to move (+ ==> up) + +MOVPUR: SKIPE NOSHUF + FATAL CANT MOVE PURE SPACE AROUND +IFE ITS,ASH A,1 + SKIPN B,A ; zero movement, ignore call + POPJ P, + + ASH B,PGSHFT ; convert to words for pointer update + MOVE C,PURVEC+1 ; loop through updating non-zero entries + SKIPE 1(C) + ADDM B,1(C) + ADD C,[ELN,,ELN] + JUMPL C,.-3 + + MOVE C,PURTOP ; found pages at top and bottom of pure + ASH C,-PGSHFT + MOVE D,PURBOT + ASH D,-PGSHFT + ADDM B,PURTOP ; update to new boundaries + ADDM B,PURBOT +IFE ITS,[ + SKIPN MULTSG ; in multi-seg mode, must mung whole table + JRST MOVPU1 + MOVN E,NSEGS + HRLZS E + ADDM PURBTB(E) + AOBJN E,.-1 +] +MOVPU1: CAIN C,(D) ; differ? + POPJ P, + JUMPG A,PUP ; if moving up, go do separate CORBLKs + +IFN ITS,[ + SUBM D,C ; -size of area to C (in pages) + MOVEI E,(D) ; build pointer to bottom of destination + ADD E,A + HRLI E,(C) + HRLI D,(C) + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,-1],D] + .LOSE %LSSYS + POPJ P, + +PUP: SUBM C,D ; pages to move to D + ADDI A,(C) ; point to new top + +PUPL: SUBI C,1 + SUBI A,1 + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,-1],C] + .LOSE %LSSYS + SOJG D,PUPL + POPJ P, +] +IFE ITS,[ + SUBM D,C ; pages to move to D + MOVSI E,(C) ; build aobjn pointer + HRRI E,(D) ; point to lowest + ADD D,A ; D==> new lowest page + MOVEI F,0 ; seg info + SKIPN MULTSG + JRST XPLS3 + MOVEI F,FSEG-1 + ADD F,NSEGS + ASH F,9. +XPLS3: MOVE G,E + MOVE H,D ; save for outer loop + +PURCL1: MOVSI A,.FHSLF ; specify here + HRRI A,(E) ; get a page + IORI A,(F) ; hack seg i + RMAP ; get a real handle on it + MOVE B,D ; where to go + HRLI B,.FHSLF + MOVSI C,PM%RD+PM%EX + IORI A,(F) + PMAP + ADDI D,1 + AOBJN E,PURCL1 + SKIPN MULTSG + POPJ P, + SUBI F,1_9. + CAIGE F,FSEG_9. + POPJ P, + MOVE E,G + MOVE D,H + JRST PURCL1 + +PUP: SUB D,C ; - count to D + MOVSI E,(D) ; start building AOBJN + HRRI E,(C) ; aobjn to top + ADD C,A ; C==> new top + MOVE D,C + MOVEI F,0 ; seg info + SKIPN MULTSG + JRST XPLS31 + MOVEI F,FSEG + ADD F,NSEGS + ASH F,9. +XPLS31: MOVE G,E + MOVE H,D ; save for outer loop + +PUPL: MOVSI A,.FHSLF + HRRI A,(E) + IORI A,(F) ; segment + RMAP ; get real handle + MOVE B,D + HRLI B,.FHSLF + IORI B,(F) + MOVSI C,PM%RD+PM%EX + PMAP + SUBI E,2 + SUBI D,1 + AOBJN E,PUPL + SKIPN MULTSG + POPJ P, + SUBI F,1_9. + CAIGE F,FSEG_9. + POPJ P, + MOVE E,G + MOVE D,H + JRST PUPL + + POPJ P, +] +IFN ITS,[ +.GLOBAL CSIXBT +CSIXBT: MOVEI 0,5 + PUSH P,[440700,,C] + PUSH P,[440600,,D] + MOVEI D,0 +CSXB2: ILDB E,-1(P) + CAIN E,177 + JRST CSXB1 + SUBI E,40 + IDPB E,(P) + SOJG 0,CSXB2 +CSXB1: SUB P,C%22 + MOVE C,D + POPJ P, +] +GENVN: MOVE C,[440700,,MUDSTR+2] + MOVEI D,5 + MOVEI B,0 +VNGEN: ILDB 0,C + CAIN 0,177 + POPJ P, + IMULI B,10. + SUBI 0,60 + ADD B,0 + SOJG D,VNGEN + POPJ P, + +IFE ITS,[ +MSKS: 774000,,0 + 777760,,0 + 777777,,700000 + 777777,,777400 + 777777,,777776 +] + + ; THESE ARE DIRECTORY SEARCH ROUTINES + + +; THIS ROUTINE DOES A BINARY SEARCH ON A DIRECTORY AND RETURNS A POINTER +; RESTED DOWN TO THE APPROPRIATE SLOT IN THE DIRECTORY. +; ARGS: E==DIR POINTER D==FILE-NAME 1 A==VERSION # +; RETS: A==RESTED DOWN DIRECTORY + +DIRSR1: TLOA 0,400000 ; INDICATION OF ONE ARGUMENT SEARCH +DIRSRC: TLZ 0,400000 ; INDICATOR OF 2 ARGUMENT SEARCH + PUSH P,A ; SAVE VERSION # + HLRE B,E ; GET LENGTH INTO B + MOVNS B + MOVE A,E + HRLS B ; GET BOTH SIDES +UP: ASH B,-1 ; HALVE TABLE + AND B,[-2,,-2] ; FORCE DIVIS BY 2 + MOVE C,A ; COPY POINTER + JUMPLE B,LSTHLV ; CANT GET SMALLER + ADD C,B +IFE ITS, HRRZ F,C ; avoid lossage in multi-sections +IFN ITS, CAMLE D,(C) ; SKIP IF EITHER FOUND OR IN TOP +IFE ITS, CAMLE D,(F) ; SKIP IF EITHER FOUND OR IN TOP + MOVE A,C ; POINT TO SECOND HALF +IFN ITS, CAMN D,(C) ; SKIP IF NOT FOUND +IFE ITS, CAMN D,(F) ; SKIP IF NOT FOUND + JRST WON +IFN ITS, CAML D,(C) ; SKIP IF IN TOP HALF +IFE ITS, CAML D,(F) ; SKIP IF IN TOP HALF + JRST UP + HLLZS C ; FIX UP POINTER + SUB A,C + JRST UP + +WON: JUMPL 0,SUPWIN + MOVEI 0,0 ; DOWN FLAG +WON1: LDB A,[221200,,1(C)] ; GET VERSION NUMBER + CAMN A,(P) ; SKIP IF NOT EQUAL + JRST SUPWIN + CAMG A,(P) ; SKIP IF LT + JRST SUBIT + SETO 0, + SUB C,C%22 ; GET NEW C + JRST SUBIT1 + +SUBIT: ADD C,C%22 ; SUBTRACT + JUMPN 0,C1POPJ +SUBIT1: +IFN ITS, CAMN D,(C) ; SEE WHETHER WERE STILL WINNING +IFE ITS,[ + HRRZ F,C + CAMN D,(F) +] + JRST WON1 +C1POPJ: SUB P,C%11 ; GET RID OF VERSION # + POPJ P, ; LOSE LOSE LOSE +SUPWIN: MOVE A,C ; RETURN ARGUMENT IN A + AOS -1(P) ; SKIP RETURN INDICATES IT WAS FOUND + JRST C1POPJ + +LSTHLV: +IFN ITS, CAMN D,(C) ; LINEAR SEARCH REST +IFE ITS,[ + HRRZ F,C + CAMN D,(F) ; LINEAR SEARCH REST +] + JRST WON + ADD C,C%22 + JUMPL C,LSTHLV + JRST C1POPJ + + ; ROUTINE TO GET A DIRECTORY. ASSUMES MAPCH IS OPEN TO FIXUP OR SAV FILE AND 0 IS THE +; LAST CHAR TO BE HASHED. RETURNS POINTER TO DIRECTORY IN E + +IFN ITS,[ +GETDIR: PUSH P,C + PUSH P,0 + PUSHJ P,SQKIL + MOVEI A,1 ; GET A BUFFER + PUSHJ P,GETBUF + MOVEI C,(B) + ASH C,-10. + DOTCAL CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],[1000,,0]] + PUSHJ P,SLEEPR + POP P,0 + IDIV 0,(B) ; A NOW CONTAINS THE DIRECTORY NUMBER + ADDI A,1(B) + DOTCAL CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],(A)] + PUSHJ P,SLEEPR + MOVN E,(B) ; GET -LENGTH OF DIRECTORY + HRLZS E ; BUILD AOBJN PTR TO DIR + HRRI E,1(B) + POP P,C + POPJ P, +] +; IN WONDERFUL TOPS20 VERSION DIRCHN CONTAINS THE JFN + +IFE ITS,[ +GETDIR: JRST @[.+1] + PUSH P,C + PUSH P,0 + PUSHJ P,SQKIL + MOVEI A,1 ; GET A BUFFER + PUSHJ P,GETBUF + HRROI E,(B) + ASH B,-9. + HRLI B,.FHSLF ; SET UP DESTINATION (CORE) + MOVS A,DIRCHN ; SET UP SOURCE (FILE) + MOVSI C,PM%RD+PM%EX ; READ+EXEC ACCESS + PMAP + POP P,0 + IDIV 0,(E) ; A NOW CONTAINS THE DIRECTORY NUMBER + ADDI A,1(E) ; POINT TO THE DIRECTORY ENTRY + MOVE A,(A) ; GET THE PAGE NUMBER + HRL A,DIRCHN ; SET UP SOURCE (FILE) + PMAP ; AGAIN READ IN DIRECTORY + MOVEI A,(E) + MOVN E,(E) ; GET -LENGTH OF DIRECTORY + HRLZS E ; BUILD AOBJN PTR TO DIR + HRRI E,1(A) + POP P,C + SKIPN MULTSG + POPJ P, + POP P,21 + SETZM 20 + XJRST 20 +] +; HERE IF CAN'T FIND FIXUP FILE IN MAIN DIRECTORY + +NOFXUP: +IFE ITS,[ + MOVE A,DIRCHN ; JFN FOR FIXUP FILE + CLOSF ; CLOSE IT + JFCL +] + MOVE A,FXTBL ; GET AOBJN POINTER TO FIXUP TABLE +NOFXU1: HRRZ B,(A) ; GET VERSION TO TRY + HRRM B,VER(P) ; STUFF IN VERSION + MOVEI B,1 ; DUMP IN FIXUP INDICATOR + HRLM B,VER(P) + MOVEM A,TEMP(P) ; SAVE POINTER TO FXTBL + PUSHJ P,OPXFIL ; LOOK FOR FIXUP FILE + JRST NOFXU2 + PUSHJ P,RFXUP ; READ IN THE FIXUP FILE + HRRZS VER(P) ; INDICATE SAV FILE + PUSHJ P,OPXFIL ; TRY OPENING IT + JRST MAPLS0 ; GIVE UP NO SAV FILE TO BE HAD + PUSHJ P,RSAV + JRST FXUPGO ; GO FIXUP THE WORLD +NOFXU2: MOVE A,TEMP(P) ; GET BACK POINTER + AOBJN A,NOFXU1 ; TRY NEXT + JRST MAPLS1 ; NO FILE TO BE HAD + +GETIT: HRRZM B,SPAG(P) ; GET BLOCK OF START + HLRZM B,FLEN(P) ; DAMMIT SAVE THIS! + HLRZ A,B ; GET LENGTH +IFN ITS,[ + .CALL MNBLK + PUSHJ P,TRAGN +] +IFE ITS,[ + MOVE E,MAPJFN + MOVEM E,DIRCHN +] + + JRST PLOD1 + +; ROUTINE TO SEE IF FILE IS NOT OPEN BECAUSE OF FNF AND FATAL IF SO + +IFN ITS,[ +TRAGN: PUSH P,0 ; SAVE 0 + .STATUS MAPCH,0 ; GET STATUS BITS + LDB 0,[220600,,0] + CAIN 0,4 ; SKIP IF NOT FNF + FATAL MAJOR FILE NOT FOUND + POP P,0 + SOS (P) + SOS (P) ; RETRY OPEN + POPJ P, +] +IFE ITS,[ +OPSAV: MOVSI A,%GJSHT+%GJOLD ; BITS FOR GTJFN + HRROI B,SAVSTR ; STRING POINTER + SKIPE OPSYS + HRROI B,TSAVST + GTJFN + FATAL CANT FIND SAV FILE + MOVEM A,MAPJFN ; STORE THE JFN + MOVE B,[440000,,OF%RD+OF%EX+OF%THW+OF%DUD] + OPENF + FATAL CANT OPEN SAV FILE + POPJ P, +] + +; OPMFIL IS USED TO OPEN A FILE ON MUDTMP. IT CAN OPEN EITHER A SAV OR FIXUP FILE +; AND THE VERSION NUMBER IS SPECIFIED. THE ARGUMENTS ARE +; NAM-1(P) HAS SIXBIT OF FILE NAME +; VER-1(P) HAS 0,,VERSION # FOR SAV FILE AND 1,,VERSION# FOR FIXUP FILE +; RETURNS LENGTH OF FILE IN SLEN AND + +; OPXFIL IS A KLUDGE FOR GETTING SAV AND FIXUP FILES OFF OF THE MDLLIB +; DIRECTORY DURING THE CHANGEOVER TO PRE- AND POST- MUDSAV WORLDS + +OPXFIL: MOVEI 0,1 + MOVEM 0,WRT-1(P) + JRST OPMFIL+1 + +OPWFIL: SETOM WRT-1(P) + SKIPA +OPMFIL: SETZM WRT-1(P) + +IFN ITS,[ + HRRZ C,VER-1(P) ; GET VERSION NUMBER + PUSHJ P,NTOSIX ; CONVERT TO SIXBIT + HRLI C,(SIXBIT /SAV/) ; BUILD SECOND FILE NAME + HLRZ 0,VER-1(P) + SKIPE 0 ; SKIP IF SAV + HRLI C,(SIXBIT/FIX/) + MOVE B,NAM-1(P) ; GET NAME + MOVSI A,7 ; WRITE MODE + SKIPL WRT-1(P) + MOVSI A,6 ; READ MODE +RETOPN: .CALL FOPBLK + JRST OPCHK ; SEE IF FIXUP IS NECESSARY OR JUST REOPENING + DOTCAL FILLEN,[[1000,,MAPCH],[2000,,A]] + .LOSE 1000 + ADDI A,PGMSK ; ROUND + ASH A,-PGSHFT ; TO PAGES + MOVEM A,FLEN-1(P) + SETZM SPAG-1(P) + AOS (P) ; SKIP RETURN TO SHOW SUCCESS + POPJ P, + +OPCHK: .STATUS MAPCH,0 ; GET STATUS BITS + LDB 0,[220600,,0] + CAIE 0,4 ; SKIP IF FNF + JRST OPCHK1 ; RETRY + POPJ P, + +OPCHK1: MOVEI 0,1 ; SLEEP FOR A WHILE + .SLEEP + JRST OPCHK + +; NTOSIX GETS NUMBER IN C AND CONVERTS IT TO SIXBIT AND RETURNS RESULT IN C + +NTOSIX: PUSH P,A ; SAVE A AND B + PUSH P,B + PUSH P,D + MOVE D,[220600,,C] + MOVEI A,(C) ; GET NUMBER + MOVEI C,0 + IDIVI A,100. ; GET RESULT OF DIVISION + SKIPN A + JRST ALADD + ADDI A,20 ; CONVERT TO DIGIT + IDPB A,D +ALADD: MOVEI A,(B) + IDIVI A,10. ; GET TENS DIGIT + SKIPN C + SKIPE A ; IF BOTH 0 BLANK DIGIT + ADDI A,20 + IDPB A,D + SKIPN C + SKIPE B + ADDI B,20 + IDPB B,D + POP P,D + POP P,B + POP P,A + POPJ P, + +] + +IFE ITS,[ + MOVE E,P ; save pdl base + MOVE B,NAM-1(E) ; GET FIRST NAME + PUSH P,C%0 ; [0]; slots for building strings + PUSH P,C%0 ; [0] + MOVE A,[440700,,1(E)] + MOVE C,[440600,,B] + +; DUMP OUT SIXBIT NAME + + MOVEI D,6 + ILDB 0,C + JUMPE 0,.+4 ; violate cardinal ".+ rule" + ADDI 0,40 ; to ASCII + IDPB 0,A + SOJG D,.-4 + + MOVE 0,[ASCII / SAV/] + HLRZ C,VER-1(E) ; GET SAV/FIXUP FLAG + SKIPE C + MOVE 0,[ASCII / FIX/] + PUSH P,0 + HRRZ C,VER-1(E) ; get ascii of vers no. + PUSHJ P,NTOSEV ; CONVERT TO STRING LEFT JUSTIFIED + PUSH P,C + MOVEI B,-1(P) ; point to it + HRLI B,260700 + HRROI D,1(E) ; point to name + MOVEI A,1(P) + MOVSI 0,100000 ; INPUT FILE (GJ%OLD) + SKIPGE WRT-1(E) + MOVSI 0,400000 ; OUTPUT FILE (GJ%FOU) + PUSH P,0 + PUSH P,[377777,,377777] + MOVE 0,[-1,,[ASCIZ /DSK/]] + SKIPN OPSYS + MOVE 0,[-1,,[ASCIZ /PS/]] + PUSH P,0 + HRROI 0,[ASCIZ /MDL/] + SKIPLE WRT-1(E) + HRROI 0,[ASCIZ /MDLLIB/] ; USE MDLLIB FOR SPECIAL CASE + PUSH P,0 + PUSH P,D + PUSH P,B + PUSH P,C%0 ; [0] + PUSH P,C%0 ; [0] + PUSH P,C%0 ; [0] + MOVEI B,0 + MOVE D,4(E) ; save final version string + GTJFN + JRST OPMLOS ; FAILURE + MOVEM A,DIRCHN + MOVE B,[440000,,OF%RD+OF%EX] + SKIPGE WRT-1(E) + MOVE B,[440000,,OF%RD+OF%WR] + OPENF + FATAL OPENF FAILED + MOVE P,E ; flush crap + PUSH P,A + SIZEF ; get length + JRST MAPLOS + SKIPL WRT-1(E) + MOVEM C,FLEN-1(E) ; ONLY SAVE LENGTH FOR READ JFNS + SETZM SPAG-1(E) + +; RESTORE STACK AND LEAVE + + MOVE P,E + MOVE A,C ; NUMBER OF PAGES IN A, DAMN! + AOS (P) + POPJ P, + +OPMLOS: MOVE P,E + POPJ P, + +; CONVERT A NUMBER IN C TO AN ASCII STRING LEFT JUSTIFIED IN C + +NTOSEV: PUSH P,A ; SAVE A AND B + PUSH P,B + PUSH P,D + MOVE D,[440700,,C] + MOVEI A,(C) ; GET NUMBER + MOVEI C,0 + IDIVI A,100. ; GET RESULT OF DIVISION + JUMPE A,ALADD + ADDI A,60 ; CONVERT TO DIGIT + IDPB A,D +ALADD: MOVEI A,(B) + IDIVI A,10. ; GET TENS DIGIT + ADDI A,60 + IDPB A,D +ALADD1: ADDI B,60 + IDPB B,D + POP P,D + POP P,B + POP P,A + POPJ P, + +] + +; ROUTINE TO READ IN THE FIXUPS FROM DIRCHN OR MAPCH WORKS +; FOR FIXUP FILE OR FIXUPS IN A SEPERATE FILE AS LONG AS THE +; CHANNEL IS OPENED AND ACCESSED TO THE RIGHT PLACE + +RFXUP: +IFN ITS,[ + MOVE 0,[-2,,A] ; PREPARE TO READ VERSION AND LENGTH + .IOT MAPCH,0 ; READ IT IN + SKIPGE 0 ; SKIP IF NOT HIT EOF + FATAL BAD FIXUP FILE + MOVEI A,-2(A) ; COUNT FOR FIRST 2 WORDS + HRRM B,VER-1(P) ; SAVE VERSION # + .IOPUS MAPCH, ; PUSH THE MAPPING CHANNEL + SETOM PLODR + PUSHJ P,IBLOCK ; GET A UVECTOR OF APPROPRIATE SIZE + SETZM PLODR + .IOPOP MAPCH, + MOVE 0,$TUVEC + MOVEM 0,-1(TP) ; SAVE UVECTOR + MOVEM B,(TP) + MOVE A,B ; GET AOBJN POINTER TO UVECTOR FOR IOT + .IOT MAPCH,A ; GET FIXUPS + .CLOSE MAPCH, + POPJ P, +] + +IFE ITS,[ + MOVE A,DIRCHN + BIN ; GET LENGTH OF FIXUP + MOVE C,B + MOVE A,DIRCHN + BIN ; GET VERSION NUMBER + HRRM B,VER-1(P) + SETOM PLODR + MOVEI A,-2(C) + PUSHJ P,IBLOCK + SETZM PLODR + MOVSI 0,$TUVEC + MOVEM 0,-1(TP) + MOVEM B,(TP) + MOVE A,DIRCHN + HLRE C,B +; SKIPE OPSYS ; SKIP IF TOPS20 SINCE C MUST BE NEGETIVE +; MOVNS C ; C IS POSITIVE FOR TENEX ????? + HRLI B,444400 + SIN + MOVE A,DIRCHN + CLOSF + FATAL CANT CLOSE FIXUP FILE + RLJFN + JFCL + POPJ P, +] + +; ROUTINE TO READ IN THE CODE + +RSAV: MOVE A,FLEN-1(P) + PUSHJ P,ALOPAG ; GET PAGES + JRST MAPLS2 + MOVE E,SPAG-1(P) + +IFN ITS,[ + MOVN A,FLEN-1(P) ; build aobjn pointer + MOVSI A,(A) + HRRI A,(B) + MOVE B,A + HRRI 0,(E) + DOTCAL CORBLK,[[1000,,104000],[1000,,-1],A,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, + POPJ P, +] +IFE ITS,[ + PUSH P,B ; SAVE PAGE # + MOVS A,DIRCHN ; SOURCE (MUDSAV) + HLRM A,SJFNS ; SAVE POINTER FOR FUTURE CLOSING + HRR A,E + HRLI B,.FHSLF ; DESTINATION (FORK) + MOVSI C,PM%RD+PM%CPY ; MAKE COPY ON WRITE + SKIPE OPSYS + JRST RSAV1 ; HANDLE TENEX + TLO C,PM%CNT ; REPEAT COUNT BIT FOR TOPS20 + HRR C,FLEN-2(P) ; PAGE (FOR PUSHJ AND PUSHED B) + PMAP +RSAVDN: POP P,B + MOVN 0,FLEN-1(P) + HRL B,0 + POPJ P, + +RSAV1: HRRZ D,FLEN-2(P) ; GET IN PAGE COUNT +RSAV2: PMAP + ADDI A,1 ; NEXT PAGE + ADDI B,1 + SOJN D,RSAV2 ; LOOP + JRST RSAVDN +] + +PDLOV: SUB P,[NSLOTS,,NSLOTS] + PUSH P,C%0 ; [0]; CAUSE A PDL OVERFLOW + JRST .-1 + +; CONSTANTS RELATED TO DATA BASE +DEV: SIXBIT /DSK/ +MODE: 6,,0 +MNDIR: SIXBIT /MUDSAV/ ; DIR OF MAIN DATA BASE FILES +WRKDIR: SIXBIT /MUDTMP/ ; DIRECTORY OF UPDATE FILES + +IFN ITS,[ +MNBLK: SETZ + SIXBIT /OPEN/ + MODE + DEV + [SIXBIT /SAV/] + [SIXBIT /FILE/] + SETZ MNDIR + + +FIXBLK: SETZ + SIXBIT /OPEN/ + MODE + DEV + [SIXBIT /FIXUP/] + [SIXBIT /FILE/] + SETZ MNDIR + +FOPBLK: SETZ + SIXBIT /OPEN/ + A + DEV + B + C + SETZ WRKDIR + +FXTBL: -2,,.+1 + 55. + 54. +] +IFE ITS,[ + +FXSTR: ASCIZ /PS:FIXUP.FILE/ +SAVSTR: ASCIZ /PS:SAV.FILE/ +TFXSTR: ASCIZ /DSK:FIXUP.FILE/ +TSAVST: ASCIZ /DSK:SAV.FILE/ + +FXTBL: -3,,.+1 + 55. + 54. + 104. +] +IFN SPCFXU,[ + +;This code does two things to code for FBIN; +; 1) Makes dispatches win in multi seg mode +; 2) Makes OBLIST? work with "new" atom format +; 3) Makes LENGTH win in multi seg mode +; 4) Gets AOBJN pointer to code vector in C + +SFIX: PUSH P,A + PUSH P,B + PUSH P,C ; for referring back + +SFIX1: MOVSI B,-MLNT ; for looping through tables + +SFIX2: MOVE A,(C) ; get code word + + AND A,SMSKS(B) + CAMN A,SPECS(B) ; do we match + JRST @SFIXR(B) + + AOBJN B,SFIX2 + +SFIX3: AOBJN C,SFIX1 ; do all of code +SFIX4: POP P,C + POP P,B + POP P,A + POPJ P, + +SMSKS: -1 + 777000,,-1 + -1,,0 + 777037,,0 +MLNT==.-SMSKS + +SPECS: HLRES A ; begin of arg diaptch table + SKIPN 2 ; old compiled OBLIST? + JRST (M) ; compiled LENGTH + ADDI (M) ; begin a case dispatch + +SFIXR: SETZ DFIX + SETZ OBLFIX + SETZ LFIX + SETZ CFIX + +DFIX: AOBJP C,SFIX4 ; make sure dont run out + MOVE A,(C) ; next ins + CAME A,[ASH A,-1] ; still winning? + JRST SFIX3 ; false alarm + AOBJP C,SFIX4 ; make sure dont run out + HLRZ A,(C) ; next ins + CAIE A,(ADDI A,(M)) ; still winning? + JRST SFIX3 ; false alarm + AOBJP C,SFIX4 + HLRZ A,(C) + CAIE A,(PUSHJ P,@(A)) ; last one to check + JRST SFIX3 + AOBJP C,SFIX4 + MOVE A,(C) + CAME A,[JRST FINIS] ; extra check + JRST SFIX3 + + MOVSI B,(SETZ) +SFIX5: AOBJP C,SFIX4 + HLRZ A,(C) + CAIN A,(SUBM M,(P)) + JRST SFIX3 + CAIE A,M ; dispatch entry? + JRST SFIX3 ; maybe already fixed + IORM B,(C) ; fix it + JRST SFIX5 + +OBLFIX: PUSH P,[-TLN,,TPTR] + PUSH P,C + MOVE B,-1(P) + +OBLFXY: PUSH P,1(B) + PUSH P,(B) + +OBLFI1: AOBJP C,OBLFXX + MOVE A,(C) + AOS B,(P) + AND A,(B) + MOVE B,-1(P) + CAME A,(B) + JRST OBLFXX + AOBJP B,DOOBFX + MOVEM B,-1(P) + JRST OBLFI1 + +OBLFXX: SUB P,C%22 ; for checking more ins + MOVE B,-1(P) + ADD B,C%22 + JUMPGE B,OBLFX1 + MOVEM B,-1(P) + MOVE C,(P) + JRST OBLFXY + + +INSBP==331100 ; byte pointer for ins field +ACBP==270400 ; also for ac +INDXBP==220400 + +DOOBFX: MOVE C,-2(P) + SUB P,C%44 + MOVEI B,<<(HRRZ)>_<-9>> ; change em + DPB B,[INSBP,,(C)] ; SKIPN==>HRRZ + LDB A,[ACBP,,(C)] ; get AC field + MOVEI B,<<(JUMPE)>_<-9>> + DPB B,[INSBP,,1(C)] + DPB A,[ACBP,,1(C)] + AOS 1(C) ; JRST FOO==>JUMPE ac,FOO+1 + MOVE B,[CAMG VECBOT] + DPB A,[ACBP,,B] + MOVEM B,2(C) ; JUMPL ==> CAMG ac,VECBOT + HRRZ A,3(C) ; get indicator of existence of ADD AC,TVP + CAIE A,TVP ; skip if extra ins exists + JRST NOATVP + MOVSI A,(JFCL) + EXCH A,4(C) + MOVEM A,3(C) + ADD C,C%11 +NOATVP: TLC B,(CAMG#HRLI) ; change CAMG to HRLI (preserving AC) + HRRZ A,4(C) ; see if moves in type + CAIE A,$TOBLS + SUB C,[1,,1] ; fudge it + HLLOM B,5(C) ; in goes HRLI -1 + CAIE A,$TOBLS ; do we need a skip? + JRST NOOB$ + MOVSI B,(CAIA) ; skipper + EXCH B,6(C) + MOVEM B,7(C) + ADD C,[7,,7] + JRST SFIX3 + +NOOB$: MOVSI B,(JFCL) + MOVEM B,6(C) + ADD C,C%66 + JRST SFIX3 + +OBLFX1: MOVE C,(P) + SUB P,C%22 + JRST SFIX3 + +; Here to fixup compiled LENGTH + +LFIX: MOVSI B,-LLN ; for checking other LENGTH ins + PUSH P,C + +LFIX1: AOBJP C,LFIXY + MOVE A,(C) + AND A,LMSK(B) + CAME A,LINS(B) + JRST LFIXY + AOBJN B,LFIX1 + + POP P,C ; restore code pointer + MOVE A,(C) ; save jump for its addr + MOVE B,[MOVSI 400000] + MOVEM B,(C) ; JRST .+2 ==> MOVSI 0,400000 + LDB B,[ACBP,,1(C)] ; B==> AC of interest + ADDI A,2 + DPB B,[ACBP,,A] + MOVEI B,<<(JUMPE)>_<-9.>> + DPB B,[INSBP,,A] + EXCH A,1(C) + TLC A,(HRR#HRRZ) ; HRR==>HRRZ + HLLZM A,2(C) ; TRNN AC,-1 ==> HRRZ AC,(AC) + MOVEI B,(AOBJN (M)) + HRLM B,3(C) ; AOBJP AC,.-2 ==> AOBJN 0,.-2 + MOVE B,2(C) ; get HRRZ AC,(AC) + TLZ B,17 ; kill (AC) part + MOVEM B,4(C) ; HLRZS AC ==> HRRZ AC,0 + ADD C,C%44 + JRST SFIX3 + +LFIXY: POP P,C + JRST SFIX3 + +; Fixup a CASE dispatch + + CFIX: LDB A,[ACBP,,(C)] + AOBJP C,SFIX4 + HLRZ B,(C) ; Next ins + ANDI B,777760 + CAIE B,(JRST @) + JRST SFIX3 + LDB B,[INDXBP,,(C)] + CAIE A,(B) + JRST SFIX3 + MOVE A,(C) ; ok, fix it up + TLZ A,20 ; kill indirection + MOVEM A,(C) + HRRZ B,-1(C) ; point to table + ADD B,(P) ; point to code to change + +CFIXLP: HLRZ A,(B) ; check one out + TRZ A,400000 ; kill bit + CAIE A,M ; check for just index (or index with SETZ) + JRST SFIX3 + MOVEI A,(JRST (M)) + HRLM A,(B) + AOJA B,CFIXLP + +DEFINE FOO LBL,LNT,LBL2,L +LBL: + IRP A,,[L] + IRP B,C,[A] + B + .ISTOP + TERMIN + TERMIN +LNT==.-LBL +LBL2: + IRP A,,[L] + IRP B,C,[A] + C + .ISTOP + TERMIN + TERMIN +TERMIN + +IMSK==777017,,0 +AIMSK==777000,,-1 + +FOO OINS,OLN,OMSK,[[,IMSK],[,IMSK],[MOVE,AIMSK] + [,AIMSK],[,IMSK] + [,AIMSK],[MOVEI,AIMSK]] + +FOO OINS3,OLN3,OMSK3,[[,IMSK],[,IMSK],[MOVE,AIMSK] + [,IMSK],[MOVEI,AIMSK]] + +FOO OINS2,OLN2,OMSK2,[[,IMSK],[,IMSK],[,AIMSK] + [MOVE,AIMSK],[,AIMSK],[,IMSK] + [,AIMSK],[MOVEI,AIMSK]] + +FOO OINS4,OLN4,OMSK4,[[,IMSK],[,IMSK],[,AIMSK] + [MOVE,AIMSK],[,IMSK],[MOVEI,AIMSK]] + +TPTR: -OLN,,OINS + OMSK-1 + -OLN2,,OINS2 + OMSK2-1 + -OLN3,,OINS3 + OMSK3-1 + -OLN4,,OINS4 + OMSK4-1 +TLN==.-TPTR + +FOO LINS,LLN,LMSK,[[,AIMSK],[,AIMSK],[,IMSK] + [,<-1,,777760>]] + +] +IMPURE + +SAVSNM: 0 ; SAVED SNAME +INPLOD: 0 ; FLAG SAYING WE ARE IN MAPPUR + +IFE ITS,[ +MAPJFN: 0 ; JFN OF SAV FILE +DIRCHN: 0 ; JFN USED BY GETDIR +] + +PURE + +END + diff --git a//mappur.mid.162 b//mappur.mid.162 new file mode 100644 index 0000000..416f6e8 --- /dev/null +++ b//mappur.mid.162 @@ -0,0 +1,1986 @@ + +TITLE MAPURE-PAGE LOADER + +RELOCATABLE + +MAPCH==0 ; channel for MAPing +XJRST==JRST 5, + +.GLOBAL PURVEC,PURTOP,PURBOT,P.TOP,GCSTOP,FRETOP,MUDSTR,STRTO6,PLOAD,AGC,GCDOWN +.GLOBAL SQUTOA,IGVAL,IBLOCK,PURCLN,MOVPUR,GETPAG,GCFLG,NOSHUF,DIR,NDIRS,SQUPNT +.GLOBAL PLODR,SQUKIL,GETBUF,KILBUF,INPLOD,SQKIL,PVSTOR,TVSTOR,DSTOREM,SLEEPR +.GLOBAL OPSYS,SJFNS,MULTSG,PURBTB,SFIX,NSEGS +.GLOBAL C%11,C%22,C%33,C%44,C%55,C%66,C%0,C%1,C%2,C%3,C%M1,C%M2,C%M10 +.GLOBAL C%M20,C%M30,C%M40,C%M60 +.GLOBAL MAPJFN,DIRCHN + +.INSRT MUDDLE > +SPCFXU==1 +SYSQ + +IFE ITS,[ +IF1, .INSRT STENEX > +] + +F==PVP +G==TVP +H==SP +RDTP==1000,,200000 +FME==1000,,-1 + + +IFN ITS,[ +PGMSK==1777 +PGSHFT==10. +] + +IFE ITS,[ +FLUSHP==0 +PGMSK==777 +PGSHFT==9. +] + +LNTBYT==340700 +ELN==4 ; LENGTH OF SLOT +FB.NAM==0 ; NAME SLOT IN TABLE +FB.PTR==1 ; Pointer to core pages +FB.AGE==2 ; age,,chain +FB.PGS==3 ; PTR AND LENGTH OF PAGE IN FILE +FB.AMK==37777777 ; extended address mask +FB.CNT==<-1># ; page count mask +EOC==400000 ; END OF PURVEC CHAIN + +IFE ITS,[ +.FHSLF==400000 ; THIS FORK +%GJSHT==000001 ; SHORT FORM GTJFN +%GJOLD==100000 + ;PMAP BITS +PM%CNT==400000 ; PMAP WITH REPEAT COUNT +PM%RD==100000 ; PMAP WITH READ ACCESS +PM%EX==20000 ; PMAP WITH EXECUTE ACCESS (NO-OP ON 20X) +PM%CPY==400 ; PMAP WITH COPY-ON-WRITE ACCESS +PM%WR==40000 ; PMAP WITH WRITE ACCESS + + ;OPENF BITS +OF%RD==200000 ; OPEN IN READ MODE +OF%WR==100000 ; OPEN IN WRITE MODE +OF%EX==040000 ; OPEN IN EXECUTE MODE (TENEX CARES) +OF%THW==02000 ; OPEN IN THAWED MODE +OF%DUD==00020 ; DON'T UPDATE THAWED PAGES +] +; THIS ROUTINE TAKES A SLOT OFFSET IN REGISTER A AND MAPS IN THE ASSOCIATED +; FILE. IT CLOBBERS ALL ACs AND SKIP RETURNS IF IT WINS. + +OFF==-5 ; OFFSET INTO PURVEC OF SLOT +NAM==-4 ; SIXBIT NAME OF THING BEING LOADED +LASTC==-3 ; LAST CHARACTER OF THE NAME +DIR==-2 ; SAVED POINTER TO DIRECTORY +SPAG==-1 ; FIRST PAGE IN FILE +PGNO==0 ; FIRST PAGE IN CORE +VER==-6 ; VERSION NUMBER OF MUDDLE TO USE IN OPENING FILES +FLEN==-7 ; LENGTH OF THE FILE +TEMP==-10 ; GENERAL TEMPORARY SLOT +WRT==-11 ; INDICATION IF OPEN IS FOR WRITING OR READING +CADDR==-12 ; ADDRESS OF CORE IMAGE LOCATION OF FILE +NSLOTS==13 + +; IT FIRST LOOKS TO SEE IF IT HAS THE PAGE NUMBER OF THE FILE + +PLOAD: ADD P,[NSLOTS,,NSLOTS] + SKIPL P + JRST PDLOV + MOVEM A,OFF(P) + PUSH TP,C%0 ; [0] + PUSH TP,C%0 ; [0] +IFE ITS,[ + SKIPN MAPJFN + PUSHJ P,OPSAV +] + +PLOADX: PUSHJ P,SQKIL + MOVE A,OFF(P) + ADD A,PURVEC+1 ; GET TO SLOT + SKIPE B,FB.PGS(A) ; SKIP IF PAGE NUMBER + JRST GETIT + MOVE B,FB.NAM(A) + MOVEM B,NAM(P) + MOVE 0,B + MOVEI A,6 ; FIND LAST CHARACTER + TRNE 0,77 ; SKIP IF NOT DONE + JRST .+3 + LSH 0,-6 ; BACK A CHAR + SOJG A,.-3 ; NOW CHAR IS BACKED OUT + ANDI 0,77 ; LASTCHR + MOVEM 0,LASTC(P) + +; NOT TO TRY TO FIND FILE IN MAIN DATA BASE. +; THE GC'S WINDOW IS USED IN THIS CASE. + +IFN ITS,[ + .CALL MNBLK ; OPEN CHANNEL TO MAIN FILE + JRST NTHERE + PUSHJ P,TRAGN ; TRY OPENING UP CHANNEL AGAIN IF POSSIBLE +] +IFE ITS,[ + SKIPN E,MAPJFN + JRST NTHERE ;who cares if no SAV.FILE? + MOVEM E,DIRCHN +] + MOVE D,NAM(P) + MOVE 0,LASTC(P) + PUSHJ P,GETDIR + MOVEM E,DIR(P) + PUSHJ P,GENVN ; GET VERSION # AS FIX + MOVE E,DIR(P) + MOVE D,NAM(P) + MOVE A,B + PUSHJ P,DIRSRC ; SEARCH DIRECTORY + JRST NTHERE ; GO TRY FIXING UP ITS NOT THERE + ANDI A,-1 ; WIN IN MULT SEG CASE + MOVE B,OFF(P) ; GET SLOT NUMBER + ADD B,PURVEC+1 ; POINT TO SLOT + HRRZ C,1(A) ; GET BLOCK NUMBER + HRRM C,FB.PGS(B) ; SMASH INTO SLOT + LDB C,[LNTBYT,,1(A)] ; SMASH IN LENGTH + HRLM C,FB.PGS(B) ; SMASH IN LENGTH + JRST PLOADX + +; NOW TRY TO FIND FILE IN WORKING DIRECTORY + +NTHERE: PUSHJ P,KILBUF + MOVE A,OFF(P) ; GET POINTER TO PURVEC SLOT + ADD A,PURVEC+1 + PUSHJ P,GENVN ; GET VERSION NUMBER + HRRZM B,VER(P) + PUSHJ P,OPMFIL ; OPEN FILE + JRST FIXITU + +; NUMBER OF PAGES ARE IN A +; STARTING PAGE NUMBER IN SPAG(P) + +PLOD1: PUSHJ P,ALOPAG ; get the necessary pages + JRST MAPLS2 + MOVE E,SPAG(P) ; E starting page in file + MOVEM B,PGNO(P) +IFN ITS,[ + MOVN A,FLEN(P) ; get neg count + MOVSI A,(A) ; build aobjn pointer + HRR A,PGNO(P) ; get page to start + MOVE B,A ; save for later + HRRI 0,(E) ; page pointer for file + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, ; no need to have file open anymore +] +IFE ITS,[ + MOVEI A,(E) ; First page on rh of A + HRL A,DIRCHN ; JFN to lh of A + HRLI B,.FHSLF ; specify this fork + MOVSI C,PM%RD+PM%EX ; bits for read/execute + MOVE D,FLEN(P) ; # of pages to D + HRROI E,(B) ; build page aobjn for later + TLC E,-1(D) ; sexy way of doing lh + + SKIPN OPSYS + JRST BLMAP ; if tops-20 can block PMAP + PMAP + ADDI A,1 + ADDI B,1 + SOJG D,.-3 ; map 'em all + MOVE B,E + JRST PLOAD1 + +BLMAP: HRRI C,(D) + TLO C,PM%CNT ; say it is counted + PMAP ; one PMAP does the trick + MOVE B,E +] +; now try to smash slot in PURVEC + +PLOAD1: MOVE A,PURVEC+1 ; get pointer to it + ASH B,PGSHFT ; convert to aobjn pointer to words + MOVE C,OFF(P) ; get slot offset + ADDI C,(A) ; point to slot + MOVEM B,FB.PTR(C) ; clobber it in + TLZ B,(FB.CNT) ; isolate address of page + HRRZ D,PURVEC ; get offset into vector for start of chain + TRNE D,EOC ; skip if not end marker + JRST SCHAIN + HRLI D,400000+A ; set up indexed pointer + ADDI D,1 +IFN ITS, HRRZ 0,@D ; get its address +IFE ITS,[ + MOVE 0,@D + TLZ 0,(FB.CNT) +] + JUMPE 0,SCHAIN ; no chain exists, start one + CAMLE 0,B ; skip if new one should be first + AOJA D,INLOOP ; jump into the loop + + SUBI D,1 ; undo ADDI +FCLOB: MOVE E,OFF(P) ; get offset for this guy + HRRM D,FB.AGE(C) ; link up + HRRM E,PURVEC ; store him away + JRST PLOADD + +SCHAIN: MOVEI D,EOC ; get end of chain indicator + JRST FCLOB ; and clobber it in + +INLOOP: MOVE E,D ; save in case of later link up + HRR D,@D ; point to next table entry + TRNE D,EOC ; 400000 is the end of chain bit + JRST SLFOUN ; found a slot, leave loop + ADDI D,1 ; point to address of progs +IFN ITS, HRRZ 0,@D ; get address of block +IFE ITS,[ + MOVE 0,@D + TLZ 0,(FB.CNT) +] + CAMLE 0,B ; skip if still haven't fit it in + AOJA D,INLOOP ; back to loop start and point to chain link + SUBI D,1 ; point back to start of slot + +SLFOUN: MOVE 0,OFF(P) ; get offset into vector of this guy + HRRM 0,@E ; make previous point to us + HRRM D,FB.AGE(C) ; link it in + + +PLOADD: AOS -NSLOTS(P) ; skip return + MOVE B,FB.PTR(C) + +MAPLOS: SUB P,[NSLOTS,,NSLOTS] ; flush stack crap + SUB TP,C%22 + POPJ P, + + +MAPLS0: ERRUUO EQUOTE NO-SAV-FILE + JRST MAPLOS + +MAPLS1: ERRUUO EQUOTE NO-FIXUP-FILE + JRST MAPLOS + +MAPLS2: ERRUUO EQUOTE NO-ROOM-AVAILABLE + JRST MAPLOS + +FIXITU: + +;OPEN FIXUP FILE ON MUDSAV + +IFN ITS,[ + .CALL FIXBLK ; OPEN UP FIXUP FILE + PUSHJ P,TRAGN ; SEE IF TOTALLY LOSING +] +IFE ITS,[ + MOVSI A,%GJSHT ; GTJFN BITS + HRROI B,FXSTR + SKIPE OPSYS + HRROI B,TFXSTR + GTJFN + FATAL FIXUP FILE NOT FOUND + MOVEM A,DIRCHN + MOVE B,[440000,,OF%RD+OF%EX] + OPENF + FATAL FIXUP FILE CANT BE OPENED +] + + MOVE 0,LASTC(P) ; GET DIRECTORY + PUSHJ P,GETDIR + MOVE D,NAM(P) + PUSHJ P,DIRSR1 ; SEARCH DIRECTORY FOR FIXUP + JRST NOFXUP ; NO FIXUP IN MAIN DIRECTORY + ANDI A,-1 ; WIN IN MULTI SEGS + HRRZ A,1(A) ; GET BLOCK NUMBER OF START + ASH A,8. ; CONVERT TO WORDS +IFN ITS,[ + .ACCES MAPCH,A ; ACCESS FILE +] + +IFE ITS,[ + MOVEI B,(A) + MOVE A,DIRCHN + SFPTR + JFCL +] + PUSHJ P,KILBUF +FIXT1: PUSHJ P,RFXUP ; READ IN THE FIXUP FILE + +IFN ITS,[ + .CALL MNBLK ; REOPEN SAV FILE + PUSHJ P,TRAGN +] + +IFE ITS,[ + MOVE A,MAPJFN ; SET UP DIRCHAN AGAIN + MOVEM A,DIRCHN +] + +; NOW TRY TO LOCATE SAV FILE + + MOVE 0,LASTC(P) ; GET LASTCHR + PUSHJ P,GETDIR ; GET DIRECTORY + HRRZ A,VER(P) ; GET VERSION # + MOVE D,NAM(P) ; GET NAME OF FILE + PUSHJ P,DIRSRC ; SEARCH DIRECTORY + JRST MAPLS1 ; NO SAV FILE THERE + ANDI A,-1 + HRRZ E,1(A) ; GET STARTING BLOCK # + LDB A,[LNTBYT,,1(A)] ; GET LENGTH INTO A + MOVEM A,FLEN(P) ; SAVE LENGTH + MOVEM E,SPAG(P) ; SAVE STARTING BLOCK NUMBER + PUSHJ P,KILBUF + PUSHJ P,RSAV ; READ IN CODE +; now to do fixups + +FXUPGO: MOVE A,(TP) ; pointer to them + SETOM INPLOD ; ABSOLUTE CLUDGE TO PREVENT BUFFER FROM + ; SCREWING US +IFE ITS,[ + SKIPN MULTSG + JRST FIXMLT + HRRZ D,B ; this codes gets us running in the correct + ; segment + ASH D,PGSHFT + HRRI D,FIXMLT + MOVEI C,0 + XJRST C ; good bye cruel segment (will work if we fell + ; into segment 0) +FIXMLT: ASH B,PGSHFT ; aobjn to program + +FIX1: SKIPL E,(A) ; read one hopefully squoze + FATAL ATTEMPT TO TYPE FIX PURE + TLZ E,740000 + +NOPV1: PUSHJ P,SQUTOA ; look it up + FATAL BAD FIXUPS + +; N.B. THE VALUE IN THE FIXUPS FOR AN ADDRESS CAN BE NEGATIVE. IF THIS HAPPENS +; IT MEANS THAT THE LEFT HALF CONTAINS THE VALUE INSTEAD OF THE RIGHT HALF +NOPV2: AOBJP A,FIX2 + HLRZ D,(A) ; get old value + HRRZS E + SUBM E,D ; D is diff between old and new + HRLM E,(A) ; fixup the fixups +NOPV3: MOVEI 0,0 ; flag for which half +FIX4: JUMPE 0,FIXRH ; jump if getting rh + MOVEI 0,0 ; next time will get rh + AOBJP A,FIX2 ; done? + HLRE C,(A) ; get lh + JUMPE C,FIX3 ; 0 terminates +FIX5: SKIPGE C ; If C is negative then left half garbage + JRST FIX6 + ADDI C,(B) ; access the code + +NOPV4: ADDM D,-1(C) ; and fix it up + JRST FIX4 + +; FOR LEFT HALF CASE + +FIX6: MOVNS C ; GET TO ADRESS + ADDI C,(B) ; ACCESS TO CODE + HLRZ E,-1(C) ; GET OUT WORD + ADDM D,E ; FIX IT UP + HRLM E,-1(C) + JRST FIX4 + +FIXRH: MOVEI 0,1 ; change flag + HRRE C,(A) ; get it and + JUMPN C,FIX5 + +FIX3: AOBJN A,FIX1 ; do next one + +IFN SPCFXU,[ + MOVE C,B + PUSHJ P,SFIX +] + PUSHJ P,SQUKIL ; KILL SQUOZE TABLE + SETZM INPLOD +FIX2: + HRRZS VER(P) ; INDICATE SAV FILE + MOVEM B,CADDR(P) + PUSHJ P,GENVN + HRRM B,VER(P) + PUSHJ P,OPWFIL + FATAL MAP FIXUP LOSSAGE +IFN ITS,[ + MOVE B,CADDR(P) + .IOT MAPCH,B ; write out the goodie + .CLOSE MAPCH, + PUSHJ P,OPMFIL + FATAL WHERE DID THE FILE GO? + MOVE E,CADDR(P) + ASH E,-PGSHFT ; to page AOBJN + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, +] + + +IFE ITS,[ + MOVE A,DIRCHN ; GET JFN + MOVE B,CADDR(P) ; ready to write it out + HRLI B,444400 + HLRE C,CADDR(P) + SOUT ; zap it out + TLO A,400000 ; dont recycle the JFN + CLOSF + JFCL + ANDI A,-1 ; kill sign bit + MOVE B,[440000,,240000] + OPENF + FATAL MAP FIXUP LOSSAGE + MOVE B,CADDR(P) + ASH B,-PGSHFT ; aobjn to pages + HLRE D,B ; -count + HRLI B,.FHSLF + MOVSI A,(A) + MOVSI C,PM%RD+PM%EX + PMAP + ADDI A,1 + ADDI B,1 + AOJN D,.-3 +] + + SKIPGE MUDSTR+2 + JRST EFIX2 ; exp vers, dont write out +IFE ITS,[ + HRRZ A,SJFNS ; get last jfn from savxxx file + JUMPE A,.+4 ; oop + CAME A,MAPJFN + CLOSF ; close it + JFCL + HLLZS SJFNS ; zero the slot +] + MOVEI 0,1 ; INDICATE FIXUP + HRLM 0,VER(P) + PUSHJ P,OPWFIL + FATAL CANT WRITE FIXUPS + +IFN ITS,[ + MOVE E,(TP) + HLRE A,E ; get length + MOVNS A + ADDI A,2 ; account for these 2 words + MOVE 0,[-2,,A] ; write version and length + .IOT MAPCH,0 + .IOT MAPCH,E ; out go the fixups + SETZB 0,A + MOVEI B,MAPCH + .CLOSE MAPCH, +] + +IFE ITS,[ + MOVE A,DIRCHN + HLRE B,(TP) ; length of fixup vector + MOVNS B + ADDI B,2 ; for length and version words + BOUT + PUSHJ P,GENVN + BOUT + MOVSI B,444400 ; byte pointer to fixups + HRR B,(TP) + HLRE C,(TP) + SOUT + CLOSF + JFCL +] + +EFIX2: MOVE B,CADDR(P) + ASH B,-PGSHFT + JRST PLOAD1 + +; Here to try to get a free page block for new thing +; A/ # of pages to get + +ALOPAG: MOVE C,GCSTOP ; FOOL GETPAG + ADDI C,3777 + ASH C,-PGSHFT + MOVE B,PURBOT +IFE ITS,[ + SKIPN MULTSG ; skip if multi-segments + JRST ALOPA1 +; Compute the "highest" PURBOT (i.e. find the least busy segment) + + PUSH P,E + PUSH P,A + MOVN A,NSEGS ; aobjn pntr to table + HRLZS A + MOVEI B,0 +ALOPA3: CAML B,PURBTB(A) ; if this one is larger + JRST ALOPA2 + MOVE B,PURBTB(A) ; use it + MOVEI E,FSEG(A) ; and the segment # +ALOPA2: AOBJN A,ALOPA3 + POP P,A +] + +ALOPA1: ASH B,-PGSHFT + SUBM B,C ; SEE IF ROOM + CAIL C,(A) + JRST ALOPGW + PUSHJ P,GETPAX ; try to get enough pages +IFE ITS, JRST EPOPJ +IFN ITS, POPJ P, + +ALOPGW: +IFN ITS, AOS (P) ; won skip return +IFE ITS,[ + SKIPE MULTSG + AOS -1(P) ; ret addr + SKIPN MULTSG + AOS (P) +] + MOVE 0,PURBOT +IFE ITS,[ + SKIPE MULTSG + MOVE 0,PURBTB-FSEG(E) +] + ASH 0,-PGSHFT + SUBI 0,(A) + MOVE B,0 +IFE ITS,[ + SKIPN MULTSG + JRST ALOPW1 + ASH 0,PGSHFT + HRRZM 0,PURBTB-FSEG(E) + ASH E,PGSHFT ; INTO POSITION + IORI B,(E) ; include segment in address + POP P,E + JRST ALOPW2 +] +ALOPW1: ASH 0,PGSHFT +ALOPW2: CAMGE 0,PURBOT + MOVEM 0,PURBOT + CAML 0,P.TOP + POPJ P, +IFE ITS,[ + SUBI 0,1777 + ANDCMI 0,1777 +] + MOVEM 0,P.TOP + POPJ P, + +EPOPJ: SKIPE MULTSG + POP P,E + POPJ P, +IFE ITS,[ +GETPAX: TDZA B,B ; here if other segs ok +GETPAG: MOVEI B,1 ; here for only main segment + JRST @[.+1] ; run in sect 0 + MOVNI E,1 +] +IFN ITS,[ +GETPAX: +GETPAG: +] + MOVE C,P.TOP ; top of GC space + ASH C,-PGSHFT ; to page number +IFE ITS,[ + SKIPN MULTSG + JRST GETPA9 + JUMPN B,GETPA9 ; if really wan all segments, + ; must force all to be free + PUSH P,A + MOVN A,NSEGS ; aobjn pntr to table + HRLZS A + MOVE B,P.TOP +GETPA8: CAMLE B,PURBTB(A) ; if this one is larger (or the same) + JRST GETPA7 + MOVE B,PURBTB(A) ; use it + MOVEI E,FSEG(A) ; and the segment # +GETPA7: AOBJN A,GETPA8 + POP P,A + JRST .+2 +] +GETPA9: MOVE B,PURBOT + ASH B,-PGSHFT ; also to pages + SUBM B,C ; pages available ==> C + CAMGE C,A ; skip if have enough already + JRST GETPG1 ; no, try to shuffle around + SUBI B,(A) ; B/ first new page +CPOPJ1: AOS (P) +IFN ITS, POPJ P, +IFE ITS,[ +SPOPJ: SKIPN MULTSG + POPJ P, ; return with new free page in B + ; (and seg# in E?) + POP P,21 + SETZM 20 + XJRST 20 +] +; Here if shuffle must occur or gc must be done to make room + +GETPG1: MOVEI 0,0 + SKIPE NOSHUF ; if can't shuffle, then ask gc + JRST ASKAGC + MOVE 0,PURTOP ; get top of mapped pure area + SUB 0,P.TOP + ASH 0,-PGSHFT ; to pages + CAMGE 0,A ; skip if winnage possible + JRST ASKAGC ; please AGC give me some room!! + SUBM A,C ; C/ amount we must flush to make room + +IFE ITS,[ + SKIPE MULTSG ; if multi and getting in all segs + JUMPL E,LPGL1 ; check out each and every segment + + PUSHJ P,GL1 + + SKIPE MULTSG + PUSHJ P,PURTBU ; update PURBOT in multi case + + JRST GETPAX + +LPGL1: PUSH P,A + PUSH P,[FSEG-1] + +LPGL2: AOS E,(P) ; count segments + MOVE B,NSEGS + ADDI B,FSEG + CAML E,B + JRST LPGL3 + PUSH P,C + MOVE C,PURBOT ; fudge so look for appropriate amt + SUB C,PURBTB-FSEG(E) + ASH C,-PGSHFT ; to pages + ADD C,(P) + SKIPLE C ; none to flush + PUSHJ P,GL1 + HRRZ E,-1(P) ; fet section again + HRRZ B,PURBOT + HRRZ C,PURBTB-FSEG(E) ; lets share with 0 again + SUB C,B + HRL B,E ; get segment + MOVEI A,(B) + ASH B,-PGSHFT + ASH A,-PGSHFT + HRLI A,.FHSLF + HRLI B,.FHSLF + ASH C,-PGSHFT + HRLI C,PM%CNT+PM%RD+PM%WR+PM%EX + PMAP +LPGL4: POP P,C + JRST LPGL2 + +LPGL3: SUB P,C%11 + POP P,A + + SKIPE MULTSG + PUSHJ P,PURTBU ; update PURBOT in multi case + + JRST GETPAG +] +; Here to find pages for flush using LRU algorithm (in multi seg mode, only +; care about the segment in E) + +GL1: MOVE B,PURVEC+1 ; get pointer to pure sr vector + MOVEI 0,-1 ; get very large age + +GL2: SKIPL FB.PTR(B) ; skip if not already flushed + JRST GL3 +IFE ITS,[ + SKIPN MULTSG + JRST GLX + LDB D,[220500,,FB.PTR(B)] ; get segment # + CAIE D,(E) + JRST GL3 ; wrong swegment, ignore +] +GLX: HLRZ D,FB.AGE(B) ; get this ones age + CAMLE D,0 ; skip if this is a candidate + JRST GL3 + MOVE F,B ; point to table entry with E + MOVEI 0,(D) ; and use as current best +GL3: ADD B,[ELN,,ELN] ; look at next + JUMPL B,GL2 + + HLRE B,FB.PTR(F) ; get length of flushee + ASH B,-PGSHFT ; to negative # of pages + ADD C,B ; update amount needed +IFN ITS,SETZM FB.PTR(F) ; indicate it will be gone +IFE ITS,MOVNS FB.PTR(F) ; save page info for flushing pages + JUMPG C,GL1 ; jump if more to get + +; Now compact pure space + + PUSH P,A ; need all acs + HRRZ D,PURVEC ; point to first in core addr order + HRRZ C,PURTOP +IFE ITS,[ + SKIPE MULTSG + HRLI C,(E) ; adjust for segment +] + ASH C,-PGSHFT ; to page number + SETZB F,A + +CL1: ADD D,PURVEC+1 ; to real pointer + SKIPGE FB.PTR(D) ; skip if this one is a flushee + JRST CL2 ; this one stays + +IFE ITS,[ + PUSH P,C + PUSH P,D + HRRZ C,FB.PGS(D) ; is this from SAV FILE? + JUMPN C,CLFOUT ; yes. don't bother flushing pages + MOVN C,FB.PTR(D) ; get aobjn pointer to code in C + SETZM FB.PTR(D) ; and flush this because it works (sorry) + ASH C,-PGSHFT ; pages speak louder than words + HLRE D,C ; # of pages saved here for unmap + HRLI C,.FHSLF ; C now contains myfork,,lowpage + MOVE A,C ; put that in A for RMAP + RMAP ; A now contains JFN in left half + MOVE B,C ; ac roulette: get fork,,page into B for PMAP + HLRZ C,A ; hold JFN in C for future CLOSF + MOVNI A,1 ; say this page to be unmapped +CLFLP: PMAP ; do the unmapping + ADDI B,1 ; next page + AOJL D,CLFLP ; continue for all pages + MOVE A,C ; restore JFN + CLOSF ; and close it, throwing away the JFN + JFCL ; should work in 95/100 cases +CLFOU1: POP P,D ; fatal error if can't close + POP P,C +] + HRRZ D,FB.AGE(D) ; point to next one in chain + JUMPN F,CL3 ; jump if not first one + HRRM D,PURVEC ; and use its next as first + JRST CL4 + +IFE ITS,[ +CLFOUT: SETZM FB.PTR(D) ; zero the code pointer + JRST CLFOU1 +] + +CL3: HRRM D,FB.AGE(F) ; link up + JRST CL4 + +; Found a stayer, move it if necessary + +CL2: +IFE ITS,[ + SKIPN MULTSG + JRST CL9 + LDB F,[220500,,FB.PTR(D)] ; check segment + CAIE E,(F) + JRST CL6X ; no other segs move at all +] +CL9: MOVEI F,(D) ; another pointer to slot + HLRE B,FB.PTR(D) ; - length of block +IFE ITS,[ + TRZ B,<-1>#<(FB.CNT)> + MOVE D,FB.PTR(D) ; pointer to block + TLZ D,(FB.CNT) ; kill count bits +] +IFN ITS, HRRZ D,FB.PTR(D) + SUB D,B ; point to top of block + ASH D,-PGSHFT ; to page number + CAMN D,C ; if not moving, jump + JRST CL6 + + ASH B,-PGSHFT ; to pages +IFN ITS,[ +CL5: SUBI C,1 ; move to pointer and from pointer + SUBI D,1 + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],C,[1000,,-1],D] + .LOSE %LSSYS + AOJL B,CL5 ; count down +] +IFE ITS,[ + PUSH P,B ; save # of pages + MOVEI A,-1(D) ; copy from pointer + HRLI A,.FHSLF ; get this fork code + RMAP ; get a JFN (hopefully) + EXCH D,(P) ; D # of pages (save from) + ADDM D,(P) ; update from + MOVEI B,-1(C) ; to pointer in B + HRLI B,.FHSLF + MOVSI C,PM%RD+PM%EX ; read/execute modes + + SKIPN OPSYS + JRST CCL1 + PMAP ; move a page + SUBI A,1 + SUBI B,1 + AOJL D,.-3 ; move them all + AOJA B,CCL2 + +CCL1: TLO C,PM%CNT + MOVNS D + SUBI B,-1(D) + SUBI A,-1(D) + HRRI C,(D) + PMAP + +CCL2: MOVEI C,(B) + POP P,D +] +; Update the table address for this loser + + SUBM C,D ; compute offset (in pages) + ASH D,PGSHFT ; to words + ADDM D,FB.PTR(F) ; update it +CL7: HRRZ D,FB.AGE(F) ; chain on +CL4: TRNN D,EOC ; skip if end of chain + JRST CL1 + + ASH C,PGSHFT ; to words +IFN ITS, MOVEM C,PURBOT ; reset pur bottom +IFE ITS,[ + SKIPN MULTSG + JRST CLXX + + HRRZM C,PURBTB-FSEG(E) + CAIA +CLXX: MOVEM C,PURBOT ; reset pur bottom +] + POP P,A + POPJ P, + +IFE ITS,[ +CL6X: MOVEI F,(D) ; chain on + JRST CL7 +] +CL6: +IFN ITS, HRRZ C,FB.PTR(F) ; get new top of world +IFE ITS,[ + MOVE C,FB.PTR(F) + TLZ C,(FB.CNT) +] + ASH C,-PGSHFT ; to page # + JRST CL7 + +IFE ITS,[ +PURTBU: PUSH P,A + PUSH P,B + + MOVN B,NSEGS + HRLZS B + MOVE A,PURTOP + +PURTB2: CAMGE A,PURBTB(B) + JRST PURTB1 + MOVE A,PURBTB(B) + MOVEM A,PURBOT +PURTB1: AOBJN B,PURTB2 + + POP P,B + POP P,A + POPJ P, +] + + ; SUBR to create an entry in the vector for one of these guys + +MFUNCTION PCODE,SUBR + + ENTRY 2 + + GETYP 0,(AB) ; check 1st arg is string + CAIE 0,TCHSTR + JRST WTYP1 + GETYP 0,2(AB) ; second must be fix + CAIE 0,TFIX + JRST WTYP2 + + MOVE A,(AB) ; convert name of program to sixbit + MOVE B,1(AB) + PUSHJ P,STRTO6 +PCODE4: MOVE C,(P) ; get name in sixbit + +; Now look for either this one or an empty slot + + MOVEI E,0 + MOVE B,PURVEC+1 + +PCODE2: CAMN C,FB.NAM(B) ; skip if this is not it + JRST PCODE1 ; found it, drop out of loop + JUMPN E,.+3 ; dont record another empty if have one + SKIPN FB.NAM(B) ; skip if slot filled + MOVE E,B ; remember pointer + ADD B,[ELN,,ELN] + JUMPL B,PCODE2 ; jump if more to look at + + JUMPE E,PCODE3 ; if E=0, error no room + MOVEM C,FB.NAM(E) ; else stash away name and zero rest + SETZM FB.PTR(E) + SETZM FB.AGE(E) + CAIA +PCODE1: MOVE E,B ; build ,, + MOVEI 0,0 ; flag whether new slot + SKIPE FB.PTR(E) ; skip if mapped already + MOVEI 0,1 + MOVE B,3(AB) + HLRE D,E + HLRE E,PURVEC+1 + SUB D,E + HRLI B,(D) + MOVSI A,TPCODE + SKIPN NOSHUF ; skip if not shuffling + JRST FINIS + JUMPN 0,FINIS ; jump if winner + PUSH TP,A + PUSH TP,B + HLRZ A,B + PUSHJ P,PLOAD + JRST PCOERR + POP TP,B + POP TP,A + JRST FINIS + +PCOERR: ERRUUO EQUOTE PURE-LOAD-FAILURE + +PCODE3: HLRE A,PURVEC+1 ; get current length + MOVNS A + ADDI A,10*ELN ; add 10(8) more entry slots + PUSHJ P,IBLOCK + EXCH B,PURVEC+1 ; store new one and get old + HLRE A,B ; -old length to A + MOVSI B,(B) ; start making BLT pointer + HRR B,PURVEC+1 + SUBM B,A ; final dest to A +IFE ITS, HRLI A,-1 ; force local index + BLT B,-1(A) + JRST PCODE4 + +; Here if must try to GC for some more core + +ASKAGC: SKIPE GCFLG ; if already in GC, lose +IFN ITS, POPJ P, +IFE ITS, JRST SPOPJ + MOVEM A,0 ; amount required to 0 + ASH 0,PGSHFT ; TO WORDS + MOVEM 0,GCDOWN ; pass as funny arg to AGC + EXCH A,C ; save A from gc's destruction +IFN ITS,.IOPUSH MAPCH, ; gc uses same channel + PUSH P,C + SETOM PLODR + MOVE C,[8,,9.] ; SET UP INDICATORS FOR GC + PUSHJ P,AGC + SETZM PLODR + POP P,C +IFN ITS,.IOPOP MAPCH, + EXCH C,A +IFE ITS,[ + JUMPL C,.+3 + JUMPL E,GETPAG + JRST GETPAX +] +IFN ITS, JUMPGE C,GETPAG + ERRUUO EQUOTE NO-MORE-PAGES + +; Here to clean up pure space by flushing all shared stuff + +PURCLN: SKIPE NOSHUF + POPJ P, + MOVEI B,EOC + HRRM B,PURVEC ; flush chain pointer + MOVE D,PURVEC+1 ; get pointer to table +CLN1: +IFE ITS,[ + SKIPN A,FB.PTR(D) + JRST NOCL + ASH A,-PGSHFT + HRLI A,.FHSLF + RMAP + HLRZS A + CLOSF + JFCL +] +NOCL: SETZM FB.PTR(D) ; zero pointer entry + SETZM FB.AGE(D) ; zero link and age slots + SETZM FB.PGS(D) + ADD D,[ELN,,ELN] ; go to next slot + JUMPL D,CLN1 ; do til exhausted + MOVE B,PURBOT ; now return pages + SUB B,PURTOP ; compute page AOBJN pointer +IFE ITS, SETZM MAPJFN ; make sure zero mapjfn + JUMPE B,CPOPJ ; no pure pages? + MOVSI B,(B) + HRR B,PURBOT + ASH B,-PGSHFT +IFN ITS,[ + DOTCAL CORBLK,[[1000,,0],[1000,,-1],B] + .LOSE %LSSYS +] +IFE ITS,[ + + SKIPE MULTSG + JRST CLN2 + HLRE D,B ; - # of pges to flush + HRLI B,.FHSLF ; specify hacking hom fork + MOVNI A,1 + MOVEI C,0 + + PMAP + ADDI B,1 + AOJL D,.-2 +] + + MOVE B,PURTOP ; now fix up pointers + MOVEM B,PURBOT ; to indicate no pure +CPOPJ: POPJ P, + +IFE ITS,[ +CLN2: HLRE C,B ; compute pos no. pages + HRLI B,.FHSLF + MOVNS C + MOVNI A,1 ; flushing pages + HRLI C,PM%CNT + MOVE D,NSEGS + MOVE E,PURTOP ; for munging table + ADDI B,_9. ; do it to the correct segment + PMAP + ADDI B,1_9. ; cycle through segments + HRRZM E,PURBTB(D) ; mung table + SOJG D,.-3 + + MOVEM E,PURBOT + POPJ P, +] + +; Here to move the entire pure space. +; A/ # and direction of pages to move (+ ==> up) + +MOVPUR: SKIPE NOSHUF + FATAL CANT MOVE PURE SPACE AROUND +IFE ITS,ASH A,1 + SKIPN B,A ; zero movement, ignore call + POPJ P, + + ASH B,PGSHFT ; convert to words for pointer update + MOVE C,PURVEC+1 ; loop through updating non-zero entries + SKIPE 1(C) + ADDM B,1(C) + ADD C,[ELN,,ELN] + JUMPL C,.-3 + + MOVE C,PURTOP ; found pages at top and bottom of pure + ASH C,-PGSHFT + MOVE D,PURBOT + ASH D,-PGSHFT + ADDM B,PURTOP ; update to new boundaries + ADDM B,PURBOT +IFE ITS,[ + SKIPN MULTSG ; in multi-seg mode, must mung whole table + JRST MOVPU1 + MOVN E,NSEGS + HRLZS E + ADDM PURBTB(E) + AOBJN E,.-1 +] +MOVPU1: CAIN C,(D) ; differ? + POPJ P, + JUMPG A,PUP ; if moving up, go do separate CORBLKs + +IFN ITS,[ + SUBM D,C ; -size of area to C (in pages) + MOVEI E,(D) ; build pointer to bottom of destination + ADD E,A + HRLI E,(C) + HRLI D,(C) + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],E,[1000,,-1],D] + .LOSE %LSSYS + POPJ P, + +PUP: SUBM C,D ; pages to move to D + ADDI A,(C) ; point to new top + +PUPL: SUBI C,1 + SUBI A,1 + DOTCAL CORBLK,[[1000,,200000],[1000,,-1],A,[1000,,-1],C] + .LOSE %LSSYS + SOJG D,PUPL + POPJ P, +] +IFE ITS,[ + SUBM D,C ; pages to move to D + MOVSI E,(C) ; build aobjn pointer + HRRI E,(D) ; point to lowest + ADD D,A ; D==> new lowest page + MOVEI F,0 ; seg info + SKIPN MULTSG + JRST XPLS3 + MOVEI F,FSEG-1 + ADD F,NSEGS + ASH F,9. +XPLS3: MOVE G,E + MOVE H,D ; save for outer loop + +PURCL1: MOVSI A,.FHSLF ; specify here + HRRI A,(E) ; get a page + IORI A,(F) ; hack seg i + RMAP ; get a real handle on it + MOVE B,D ; where to go + HRLI B,.FHSLF + MOVSI C,PM%RD+PM%EX + IORI A,(F) + PMAP + ADDI D,1 + AOBJN E,PURCL1 + SKIPN MULTSG + POPJ P, + SUBI F,1_9. + CAIGE F,FSEG_9. + POPJ P, + MOVE E,G + MOVE D,H + JRST PURCL1 + +PUP: SUB D,C ; - count to D + MOVSI E,(D) ; start building AOBJN + HRRI E,(C) ; aobjn to top + ADD C,A ; C==> new top + MOVE D,C + MOVEI F,0 ; seg info + SKIPN MULTSG + JRST XPLS31 + MOVEI F,FSEG + ADD F,NSEGS + ASH F,9. +XPLS31: MOVE G,E + MOVE H,D ; save for outer loop + +PUPL: MOVSI A,.FHSLF + HRRI A,(E) + IORI A,(F) ; segment + RMAP ; get real handle + MOVE B,D + HRLI B,.FHSLF + IORI B,(F) + MOVSI C,PM%RD+PM%EX + PMAP + SUBI E,2 + SUBI D,1 + AOBJN E,PUPL + SKIPN MULTSG + POPJ P, + SUBI F,1_9. + CAIGE F,FSEG_9. + POPJ P, + MOVE E,G + MOVE D,H + JRST PUPL + + POPJ P, +] +IFN ITS,[ +.GLOBAL CSIXBT +CSIXBT: MOVEI 0,5 + PUSH P,[440700,,C] + PUSH P,[440600,,D] + MOVEI D,0 +CSXB2: ILDB E,-1(P) + CAIN E,177 + JRST CSXB1 + SUBI E,40 + IDPB E,(P) + SOJG 0,CSXB2 +CSXB1: SUB P,C%22 + MOVE C,D + POPJ P, +] +GENVN: MOVE C,[440700,,MUDSTR+2] + MOVEI D,5 + MOVEI B,0 +VNGEN: ILDB 0,C + CAIN 0,177 + POPJ P, + IMULI B,10. + SUBI 0,60 + ADD B,0 + SOJG D,VNGEN + POPJ P, + +IFE ITS,[ +MSKS: 774000,,0 + 777760,,0 + 777777,,700000 + 777777,,777400 + 777777,,777776 +] + + ; THESE ARE DIRECTORY SEARCH ROUTINES + + +; THIS ROUTINE DOES A BINARY SEARCH ON A DIRECTORY AND RETURNS A POINTER +; RESTED DOWN TO THE APPROPRIATE SLOT IN THE DIRECTORY. +; ARGS: E==DIR POINTER D==FILE-NAME 1 A==VERSION # +; RETS: A==RESTED DOWN DIRECTORY + +DIRSR1: TLOA 0,400000 ; INDICATION OF ONE ARGUMENT SEARCH +DIRSRC: TLZ 0,400000 ; INDICATOR OF 2 ARGUMENT SEARCH + PUSH P,A ; SAVE VERSION # + HLRE B,E ; GET LENGTH INTO B + MOVNS B + MOVE A,E + HRLS B ; GET BOTH SIDES +UP: ASH B,-1 ; HALVE TABLE + AND B,[-2,,-2] ; FORCE DIVIS BY 2 + MOVE C,A ; COPY POINTER + JUMPLE B,LSTHLV ; CANT GET SMALLER + ADD C,B +IFE ITS, HRRZ F,C ; avoid lossage in multi-sections +IFN ITS, CAMLE D,(C) ; SKIP IF EITHER FOUND OR IN TOP +IFE ITS, CAMLE D,(F) ; SKIP IF EITHER FOUND OR IN TOP + MOVE A,C ; POINT TO SECOND HALF +IFN ITS, CAMN D,(C) ; SKIP IF NOT FOUND +IFE ITS, CAMN D,(F) ; SKIP IF NOT FOUND + JRST WON +IFN ITS, CAML D,(C) ; SKIP IF IN TOP HALF +IFE ITS, CAML D,(F) ; SKIP IF IN TOP HALF + JRST UP + HLLZS C ; FIX UP POINTER + SUB A,C + JRST UP + +WON: JUMPL 0,SUPWIN + MOVEI 0,0 ; DOWN FLAG +WON1: LDB A,[221200,,1(C)] ; GET VERSION NUMBER + CAMN A,(P) ; SKIP IF NOT EQUAL + JRST SUPWIN + CAMG A,(P) ; SKIP IF LT + JRST SUBIT + SETO 0, + SUB C,C%22 ; GET NEW C + JRST SUBIT1 + +SUBIT: ADD C,C%22 ; SUBTRACT + JUMPN 0,C1POPJ +SUBIT1: +IFN ITS, CAMN D,(C) ; SEE WHETHER WERE STILL WINNING +IFE ITS,[ + HRRZ F,C + CAMN D,(F) +] + JRST WON1 +C1POPJ: SUB P,C%11 ; GET RID OF VERSION # + POPJ P, ; LOSE LOSE LOSE +SUPWIN: MOVE A,C ; RETURN ARGUMENT IN A + AOS -1(P) ; SKIP RETURN INDICATES IT WAS FOUND + JRST C1POPJ + +LSTHLV: +IFN ITS, CAMN D,(C) ; LINEAR SEARCH REST +IFE ITS,[ + HRRZ F,C + CAMN D,(F) ; LINEAR SEARCH REST +] + JRST WON + ADD C,C%22 + JUMPL C,LSTHLV + JRST C1POPJ + + ; ROUTINE TO GET A DIRECTORY. ASSUMES MAPCH IS OPEN TO FIXUP OR SAV FILE AND 0 IS THE +; LAST CHAR TO BE HASHED. RETURNS POINTER TO DIRECTORY IN E + +IFN ITS,[ +GETDIR: PUSH P,C + PUSH P,0 + PUSHJ P,SQKIL + MOVEI A,1 ; GET A BUFFER + PUSHJ P,GETBUF + MOVEI C,(B) + ASH C,-10. + DOTCAL CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],[1000,,0]] + PUSHJ P,SLEEPR + POP P,0 + IDIV 0,(B) ; A NOW CONTAINS THE DIRECTORY NUMBER + ADDI A,1(B) + DOTCAL CORBLK,[[RDTP],[FME],C,[1000,,MAPCH],(A)] + PUSHJ P,SLEEPR + MOVN E,(B) ; GET -LENGTH OF DIRECTORY + HRLZS E ; BUILD AOBJN PTR TO DIR + HRRI E,1(B) + POP P,C + POPJ P, +] +; IN WONDERFUL TOPS20 VERSION DIRCHN CONTAINS THE JFN + +IFE ITS,[ +GETDIR: JRST @[.+1] + PUSH P,C + PUSH P,0 + PUSHJ P,SQKIL + MOVEI A,1 ; GET A BUFFER + PUSHJ P,GETBUF + HRROI E,(B) + ASH B,-9. + HRLI B,.FHSLF ; SET UP DESTINATION (CORE) + MOVS A,DIRCHN ; SET UP SOURCE (FILE) + MOVSI C,PM%RD+PM%EX ; READ+EXEC ACCESS + PMAP + POP P,0 + IDIV 0,(E) ; A NOW CONTAINS THE DIRECTORY NUMBER + ADDI A,1(E) ; POINT TO THE DIRECTORY ENTRY + MOVE A,(A) ; GET THE PAGE NUMBER + HRL A,DIRCHN ; SET UP SOURCE (FILE) + PMAP ; AGAIN READ IN DIRECTORY + MOVEI A,(E) + MOVN E,(E) ; GET -LENGTH OF DIRECTORY + HRLZS E ; BUILD AOBJN PTR TO DIR + HRRI E,1(A) + POP P,C + SKIPN MULTSG + POPJ P, + POP P,21 + SETZM 20 + XJRST 20 +] +; HERE IF CAN'T FIND FIXUP FILE IN MAIN DIRECTORY + +NOFXUP: +IFE ITS,[ + MOVE A,DIRCHN ; JFN FOR FIXUP FILE + CLOSF ; CLOSE IT + JFCL +] + MOVE A,FXTBL ; GET AOBJN POINTER TO FIXUP TABLE +NOFXU1: HRRZ B,(A) ; GET VERSION TO TRY + HRRM B,VER(P) ; STUFF IN VERSION + MOVEI B,1 ; DUMP IN FIXUP INDICATOR + HRLM B,VER(P) + MOVEM A,TEMP(P) ; SAVE POINTER TO FXTBL + PUSHJ P,OPXFIL ; LOOK FOR FIXUP FILE + JRST NOFXU2 + PUSHJ P,RFXUP ; READ IN THE FIXUP FILE + HRRZS VER(P) ; INDICATE SAV FILE + PUSHJ P,OPXFIL ; TRY OPENING IT + JRST MAPLS0 ; GIVE UP NO SAV FILE TO BE HAD + PUSHJ P,RSAV + JRST FXUPGO ; GO FIXUP THE WORLD +NOFXU2: MOVE A,TEMP(P) ; GET BACK POINTER + AOBJN A,NOFXU1 ; TRY NEXT + JRST MAPLS1 ; NO FILE TO BE HAD + +GETIT: HRRZM B,SPAG(P) ; GET BLOCK OF START + HLRZM B,FLEN(P) ; DAMMIT SAVE THIS! + HLRZ A,B ; GET LENGTH +IFN ITS,[ + .CALL MNBLK + PUSHJ P,TRAGN +] +IFE ITS,[ + MOVE E,MAPJFN + MOVEM E,DIRCHN +] + + JRST PLOD1 + +; ROUTINE TO SEE IF FILE IS NOT OPEN BECAUSE OF FNF AND FATAL IF SO + +IFN ITS,[ +TRAGN: PUSH P,0 ; SAVE 0 + .STATUS MAPCH,0 ; GET STATUS BITS + LDB 0,[220600,,0] + CAIN 0,4 ; SKIP IF NOT FNF + FATAL MAJOR FILE NOT FOUND + POP P,0 + SOS (P) + SOS (P) ; RETRY OPEN + POPJ P, +] +IFE ITS,[ +OPSAV: MOVSI A,%GJSHT+%GJOLD ; BITS FOR GTJFN + HRROI B,SAVSTR ; STRING POINTER + SKIPE OPSYS + HRROI B,TSAVST + GTJFN + FATAL CANT FIND SAV FILE + MOVEM A,MAPJFN ; STORE THE JFN + MOVE B,[440000,,OF%RD+OF%EX+OF%THW+OF%DUD] + OPENF + FATAL CANT OPEN SAV FILE + POPJ P, +] + +; OPMFIL IS USED TO OPEN A FILE ON MUDTMP. IT CAN OPEN EITHER A SAV OR FIXUP FILE +; AND THE VERSION NUMBER IS SPECIFIED. THE ARGUMENTS ARE +; NAM-1(P) HAS SIXBIT OF FILE NAME +; VER-1(P) HAS 0,,VERSION # FOR SAV FILE AND 1,,VERSION# FOR FIXUP FILE +; RETURNS LENGTH OF FILE IN SLEN AND + +; OPXFIL IS A KLUDGE FOR GETTING SAV AND FIXUP FILES OFF OF THE MDLLIB +; DIRECTORY DURING THE CHANGEOVER TO PRE- AND POST- MUDSAV WORLDS + +OPXFIL: MOVEI 0,1 + MOVEM 0,WRT-1(P) + JRST OPMFIL+1 + +OPWFIL: SETOM WRT-1(P) + SKIPA +OPMFIL: SETZM WRT-1(P) + +IFN ITS,[ + HRRZ C,VER-1(P) ; GET VERSION NUMBER + PUSHJ P,NTOSIX ; CONVERT TO SIXBIT + HRLI C,(SIXBIT /SAV/) ; BUILD SECOND FILE NAME + HLRZ 0,VER-1(P) + SKIPE 0 ; SKIP IF SAV + HRLI C,(SIXBIT/FIX/) + MOVE B,NAM-1(P) ; GET NAME + MOVSI A,7 ; WRITE MODE + SKIPL WRT-1(P) + MOVSI A,6 ; READ MODE +RETOPN: .CALL FOPBLK + JRST OPCHK ; SEE IF FIXUP IS NECESSARY OR JUST REOPENING + DOTCAL FILLEN,[[1000,,MAPCH],[2000,,A]] + .LOSE 1000 + ADDI A,PGMSK ; ROUND + ASH A,-PGSHFT ; TO PAGES + MOVEM A,FLEN-1(P) + SETZM SPAG-1(P) + AOS (P) ; SKIP RETURN TO SHOW SUCCESS + POPJ P, + +OPCHK: .STATUS MAPCH,0 ; GET STATUS BITS + LDB 0,[220600,,0] + CAIE 0,4 ; SKIP IF FNF + JRST OPCHK1 ; RETRY + POPJ P, + +OPCHK1: MOVEI 0,1 ; SLEEP FOR A WHILE + .SLEEP + JRST OPCHK + +; NTOSIX GETS NUMBER IN C AND CONVERTS IT TO SIXBIT AND RETURNS RESULT IN C + +NTOSIX: PUSH P,A ; SAVE A AND B + PUSH P,B + PUSH P,D + MOVE D,[220600,,C] + MOVEI A,(C) ; GET NUMBER + MOVEI C,0 + IDIVI A,100. ; GET RESULT OF DIVISION + SKIPN A + JRST ALADD + ADDI A,20 ; CONVERT TO DIGIT + IDPB A,D +ALADD: MOVEI A,(B) + IDIVI A,10. ; GET TENS DIGIT + SKIPN C + SKIPE A ; IF BOTH 0 BLANK DIGIT + ADDI A,20 + IDPB A,D + SKIPN C + SKIPE B + ADDI B,20 + IDPB B,D + POP P,D + POP P,B + POP P,A + POPJ P, + +] + +IFE ITS,[ + MOVE E,P ; save pdl base + MOVE B,NAM-1(E) ; GET FIRST NAME + PUSH P,C%0 ; [0]; slots for building strings + PUSH P,C%0 ; [0] + MOVE A,[440700,,1(E)] + MOVE C,[440600,,B] + +; DUMP OUT SIXBIT NAME + + MOVEI D,6 + ILDB 0,C + JUMPE 0,.+4 ; violate cardinal ".+ rule" + ADDI 0,40 ; to ASCII + IDPB 0,A + SOJG D,.-4 + + MOVE 0,[ASCII / SAV/] + HLRZ C,VER-1(E) ; GET SAV/FIXUP FLAG + SKIPE C + MOVE 0,[ASCII / FIX/] + PUSH P,0 + HRRZ C,VER-1(E) ; get ascii of vers no. + PUSHJ P,NTOSEV ; CONVERT TO STRING LEFT JUSTIFIED + PUSH P,C + MOVEI B,-1(P) ; point to it + HRLI B,260700 + HRROI D,1(E) ; point to name + MOVEI A,1(P) + MOVSI 0,100000 ; INPUT FILE (GJ%OLD) + SKIPGE WRT-1(E) + MOVSI 0,400000 ; OUTPUT FILE (GJ%FOU) + PUSH P,0 + PUSH P,[377777,,377777] + MOVE 0,[-1,,[ASCIZ /DSK/]] + SKIPN OPSYS + MOVE 0,[-1,,[ASCIZ /PS/]] + PUSH P,0 + HRROI 0,[ASCIZ /MDL/] + SKIPLE WRT-1(E) + HRROI 0,[ASCIZ /MDLLIB/] ; USE MDLLIB FOR SPECIAL CASE + PUSH P,0 + PUSH P,D + PUSH P,B + PUSH P,C%0 ; [0] + PUSH P,C%0 ; [0] + PUSH P,C%0 ; [0] + MOVEI B,0 + MOVE D,4(E) ; save final version string + GTJFN + JRST OPMLOS ; FAILURE + MOVEM A,DIRCHN + MOVE B,[440000,,OF%RD+OF%EX] + SKIPGE WRT-1(E) + MOVE B,[440000,,OF%RD+OF%WR] + OPENF + FATAL OPENF FAILED + MOVE P,E ; flush crap + PUSH P,A + SIZEF ; get length + JRST MAPLOS + SKIPL WRT-1(E) + MOVEM C,FLEN-1(E) ; ONLY SAVE LENGTH FOR READ JFNS + SETZM SPAG-1(E) + +; RESTORE STACK AND LEAVE + + MOVE P,E + MOVE A,C ; NUMBER OF PAGES IN A, DAMN! + AOS (P) + POPJ P, + +OPMLOS: MOVE P,E + POPJ P, + +; CONVERT A NUMBER IN C TO AN ASCII STRING LEFT JUSTIFIED IN C + +NTOSEV: PUSH P,A ; SAVE A AND B + PUSH P,B + PUSH P,D + MOVE D,[440700,,C] + MOVEI A,(C) ; GET NUMBER + MOVEI C,0 + IDIVI A,100. ; GET RESULT OF DIVISION + JUMPE A,ALADD + ADDI A,60 ; CONVERT TO DIGIT + IDPB A,D +ALADD: MOVEI A,(B) + IDIVI A,10. ; GET TENS DIGIT + ADDI A,60 + IDPB A,D +ALADD1: ADDI B,60 + IDPB B,D + POP P,D + POP P,B + POP P,A + POPJ P, + +] + +; ROUTINE TO READ IN THE FIXUPS FROM DIRCHN OR MAPCH WORKS +; FOR FIXUP FILE OR FIXUPS IN A SEPERATE FILE AS LONG AS THE +; CHANNEL IS OPENED AND ACCESSED TO THE RIGHT PLACE + +RFXUP: +IFN ITS,[ + MOVE 0,[-2,,A] ; PREPARE TO READ VERSION AND LENGTH + .IOT MAPCH,0 ; READ IT IN + SKIPGE 0 ; SKIP IF NOT HIT EOF + FATAL BAD FIXUP FILE + MOVEI A,-2(A) ; COUNT FOR FIRST 2 WORDS + HRRM B,VER-1(P) ; SAVE VERSION # + .IOPUS MAPCH, ; PUSH THE MAPPING CHANNEL + SETOM PLODR + PUSHJ P,IBLOCK ; GET A UVECTOR OF APPROPRIATE SIZE + SETZM PLODR + .IOPOP MAPCH, + MOVE 0,$TUVEC + MOVEM 0,-1(TP) ; SAVE UVECTOR + MOVEM B,(TP) + MOVE A,B ; GET AOBJN POINTER TO UVECTOR FOR IOT + .IOT MAPCH,A ; GET FIXUPS + .CLOSE MAPCH, + POPJ P, +] + +IFE ITS,[ + MOVE A,DIRCHN + BIN ; GET LENGTH OF FIXUP + MOVE C,B + MOVE A,DIRCHN + BIN ; GET VERSION NUMBER + HRRM B,VER-1(P) + SETOM PLODR + MOVEI A,-2(C) + PUSHJ P,IBLOCK + SETZM PLODR + MOVSI 0,$TUVEC + MOVEM 0,-1(TP) + MOVEM B,(TP) + MOVE A,DIRCHN + HLRE C,B +; SKIPE OPSYS ; SKIP IF TOPS20 SINCE C MUST BE NEGETIVE +; MOVNS C ; C IS POSITIVE FOR TENEX ????? + HRLI B,444400 + SIN + MOVE A,DIRCHN + CLOSF + FATAL CANT CLOSE FIXUP FILE + RLJFN + JFCL + POPJ P, +] + +; ROUTINE TO READ IN THE CODE + +RSAV: MOVE A,FLEN-1(P) + PUSHJ P,ALOPAG ; GET PAGES + JRST MAPLS2 + MOVE E,SPAG-1(P) + +IFN ITS,[ + MOVN A,FLEN-1(P) ; build aobjn pointer + MOVSI A,(A) + HRRI A,(B) + MOVE B,A + HRRI 0,(E) + DOTCAL CORBLK,[[1000,,104000],[1000,,-1],A,[1000,,MAPCH],0] + .LOSE %LSSYS + .CLOSE MAPCH, + POPJ P, +] +IFE ITS,[ + PUSH P,B ; SAVE PAGE # + MOVS A,DIRCHN ; SOURCE (MUDSAV) + HLRM A,SJFNS ; SAVE POINTER FOR FUTURE CLOSING + HRR A,E + HRLI B,.FHSLF ; DESTINATION (FORK) + MOVSI C,PM%RD+PM%CPY ; MAKE COPY ON WRITE + SKIPE OPSYS + JRST RSAV1 ; HANDLE TENEX + TLO C,PM%CNT ; REPEAT COUNT BIT FOR TOPS20 + HRR C,FLEN-2(P) ; PAGE (FOR PUSHJ AND PUSHED B) + PMAP +RSAVDN: POP P,B + MOVN 0,FLEN-1(P) + HRL B,0 + POPJ P, + +RSAV1: HRRZ D,FLEN-2(P) ; GET IN PAGE COUNT +RSAV2: PMAP + ADDI A,1 ; NEXT PAGE + ADDI B,1 + SOJN D,RSAV2 ; LOOP + JRST RSAVDN +] + +PDLOV: SUB P,[NSLOTS,,NSLOTS] + PUSH P,C%0 ; [0]; CAUSE A PDL OVERFLOW + JRST .-1 + +; CONSTANTS RELATED TO DATA BASE +DEV: SIXBIT /DSK/ +MODE: 6,,0 +MNDIR: SIXBIT /MUDSAV/ ; DIR OF MAIN DATA BASE FILES +WRKDIR: SIXBIT /MUDTMP/ ; DIRECTORY OF UPDATE FILES + +IFN ITS,[ +MNBLK: SETZ + SIXBIT /OPEN/ + MODE + DEV + [SIXBIT /SAV/] + [SIXBIT /FILE/] + SETZ MNDIR + + +FIXBLK: SETZ + SIXBIT /OPEN/ + MODE + DEV + [SIXBIT /FIXUP/] + [SIXBIT /FILE/] + SETZ MNDIR + +FOPBLK: SETZ + SIXBIT /OPEN/ + A + DEV + B + C + SETZ WRKDIR + +FXTBL: -2,,.+1 + 55. + 54. +] +IFE ITS,[ + +FXSTR: ASCIZ /PS:FIXUP.FILE/ +SAVSTR: ASCIZ /PS:SAV.FILE/ +TFXSTR: ASCIZ /DSK:FIXUP.FILE/ +TSAVST: ASCIZ /DSK:SAV.FILE/ + +FXTBL: -3,,.+1 + 55. + 54. + 104. +] +IFN SPCFXU,[ + +;This code does two things to code for FBIN; +; 1) Makes dispatches win in multi seg mode +; 2) Makes OBLIST? work with "new" atom format +; 3) Makes LENGTH win in multi seg mode +; 4) Gets AOBJN pointer to code vector in C + +SFIX: PUSH P,A + PUSH P,B + PUSH P,C ; for referring back + +SFIX1: MOVSI B,-MLNT ; for looping through tables + +SFIX2: MOVE A,(C) ; get code word + + AND A,SMSKS(B) + CAMN A,SPECS(B) ; do we match + JRST @SFIXR(B) + + AOBJN B,SFIX2 + +SFIX3: AOBJN C,SFIX1 ; do all of code +SFIX4: POP P,C + POP P,B + POP P,A + POPJ P, + +SMSKS: -1 + 777000,,-1 + -1,,0 + 777037,,0 +MLNT==.-SMSKS + +SPECS: HLRES A ; begin of arg diaptch table + SKIPN 2 ; old compiled OBLIST? + JRST (M) ; compiled LENGTH + ADDI (M) ; begin a case dispatch + +SFIXR: SETZ DFIX + SETZ OBLFIX + SETZ LFIX + SETZ CFIX + +DFIX: AOBJP C,SFIX4 ; make sure dont run out + MOVE A,(C) ; next ins + CAME A,[ASH A,-1] ; still winning? + JRST SFIX3 ; false alarm + AOBJP C,SFIX4 ; make sure dont run out + HLRZ A,(C) ; next ins + CAIE A,(ADDI A,(M)) ; still winning? + JRST SFIX3 ; false alarm + AOBJP C,SFIX4 + HLRZ A,(C) + CAIE A,(PUSHJ P,@(A)) ; last one to check + JRST SFIX3 + AOBJP C,SFIX4 + MOVE A,(C) + CAME A,[JRST FINIS] ; extra check + JRST SFIX3 + + MOVSI B,(SETZ) +SFIX5: AOBJP C,SFIX4 + HLRZ A,(C) + CAIN A,(SUBM M,(P)) + JRST SFIX3 + CAIE A,M ; dispatch entry? + JRST SFIX3 ; maybe already fixed + IORM B,(C) ; fix it + JRST SFIX5 + +OBLFIX: PUSH P,[-TLN,,TPTR] + PUSH P,C + MOVE B,-1(P) + +OBLFXY: PUSH P,1(B) + PUSH P,(B) + +OBLFI1: AOBJP C,OBLFXX + MOVE A,(C) + AOS B,(P) + AND A,(B) + MOVE B,-1(P) + CAME A,(B) + JRST OBLFXX + AOBJP B,DOOBFX + MOVEM B,-1(P) + JRST OBLFI1 + +OBLFXX: SUB P,C%22 ; for checking more ins + MOVE B,-1(P) + ADD B,C%22 + JUMPGE B,OBLFX1 + MOVEM B,-1(P) + MOVE C,(P) + JRST OBLFXY + + +INSBP==331100 ; byte pointer for ins field +ACBP==270400 ; also for ac +INDXBP==220400 + +DOOBFX: MOVE C,-2(P) + SUB P,C%44 + MOVEI B,<<(HRRZ)>_<-9>> ; change em + DPB B,[INSBP,,(C)] ; SKIPN==>HRRZ + LDB A,[ACBP,,(C)] ; get AC field + MOVEI B,<<(JUMPE)>_<-9>> + DPB B,[INSBP,,1(C)] + DPB A,[ACBP,,1(C)] + AOS 1(C) ; JRST FOO==>JUMPE ac,FOO+1 + MOVE B,[CAMG VECBOT] + DPB A,[ACBP,,B] + MOVEM B,2(C) ; JUMPL ==> CAMG ac,VECBOT + HRRZ A,3(C) ; get indicator of existence of ADD AC,TVP + CAIE A,TVP ; skip if extra ins exists + JRST NOATVP + MOVSI A,(JFCL) + EXCH A,4(C) + MOVEM A,3(C) + ADD C,C%11 +NOATVP: TLC B,(CAMG#HRLI) ; change CAMG to HRLI (preserving AC) + HRRZ A,4(C) ; see if moves in type + CAIE A,$TOBLS + SUB C,[1,,1] ; fudge it + HLLOM B,5(C) ; in goes HRLI -1 + CAIE A,$TOBLS ; do we need a skip? + JRST NOOB$ + MOVSI B,(CAIA) ; skipper + EXCH B,6(C) + MOVEM B,7(C) + ADD C,[7,,7] + JRST SFIX3 + +NOOB$: MOVSI B,(JFCL) + MOVEM B,6(C) + ADD C,C%66 + JRST SFIX3 + +OBLFX1: MOVE C,(P) + SUB P,C%22 + JRST SFIX3 + +; Here to fixup compiled LENGTH + +LFIX: MOVSI B,-LLN ; for checking other LENGTH ins + PUSH P,C + +LFIX1: AOBJP C,LFIXY + MOVE A,(C) + AND A,LMSK(B) + CAME A,LINS(B) + JRST LFIXY + AOBJN B,LFIX1 + + POP P,C ; restore code pointer + MOVE A,(C) ; save jump for its addr + MOVE B,[MOVSI 400000] + MOVEM B,(C) ; JRST .+2 ==> MOVSI 0,400000 + LDB B,[ACBP,,1(C)] ; B==> AC of interest + ADDI A,2 + DPB B,[ACBP,,A] + MOVEI B,<<(JUMPE)>_<-9.>> + DPB B,[INSBP,,A] + EXCH A,1(C) + TLC A,(HRR#HRRZ) ; HRR==>HRRZ + HLLZM A,2(C) ; TRNN AC,-1 ==> HRRZ AC,(AC) + MOVEI B,(AOBJN (M)) + HRLM B,3(C) ; AOBJP AC,.-2 ==> AOBJN 0,.-2 + MOVE B,2(C) ; get HRRZ AC,(AC) + TLZ B,17 ; kill (AC) part + MOVEM B,4(C) ; HLRZS AC ==> HRRZ AC,0 + ADD C,C%44 + JRST SFIX3 + +LFIXY: POP P,C + JRST SFIX3 + +; Fixup a CASE dispatch + + CFIX: LDB A,[ACBP,,(C)] + AOBJP C,SFIX4 + HLRZ B,(C) ; Next ins + ANDI B,777760 + CAIE B,(JRST @) + JRST SFIX3 + LDB B,[INDXBP,,(C)] + CAIE A,(B) + JRST SFIX3 + MOVE A,(C) ; ok, fix it up + TLZ A,20 ; kill indirection + MOVEM A,(C) + HRRZ B,-1(C) ; point to table + ADD B,(P) ; point to code to change + +CFIXLP: HLRZ A,(B) ; check one out + TRZ A,400000 ; kill bit + CAIE A,M ; check for just index (or index with SETZ) + JRST SFIX3 + MOVEI A,(JRST (M)) + HRLM A,(B) + AOJA B,CFIXLP + +DEFINE FOO LBL,LNT,LBL2,L +LBL: + IRP A,,[L] + IRP B,C,[A] + B + .ISTOP + TERMIN + TERMIN +LNT==.-LBL +LBL2: + IRP A,,[L] + IRP B,C,[A] + C + .ISTOP + TERMIN + TERMIN +TERMIN + +IMSK==777017,,0 +AIMSK==777000,,-1 + +FOO OINS,OLN,OMSK,[[,IMSK],[,IMSK],[MOVE,AIMSK] + [,AIMSK],[,IMSK] + [,AIMSK],[MOVEI,AIMSK]] + +FOO OINS3,OLN3,OMSK3,[[,IMSK],[,IMSK],[MOVE,AIMSK] + [,IMSK],[MOVEI,AIMSK]] + +FOO OINS2,OLN2,OMSK2,[[,IMSK],[,IMSK],[,AIMSK] + [MOVE,AIMSK],[,AIMSK],[,IMSK] + [,AIMSK],[MOVEI,AIMSK]] + +FOO OINS4,OLN4,OMSK4,[[,IMSK],[,IMSK],[,AIMSK] + [MOVE,AIMSK],[,IMSK],[MOVEI,AIMSK]] + +TPTR: -OLN,,OINS + OMSK-1 + -OLN2,,OINS2 + OMSK2-1 + -OLN3,,OINS3 + OMSK3-1 + -OLN4,,OINS4 + OMSK4-1 +TLN==.-TPTR + +FOO LINS,LLN,LMSK,[[,AIMSK],[,AIMSK],[,IMSK] + [,<-1,,777760>]] + +] +IMPURE + +SAVSNM: 0 ; SAVED SNAME +INPLOD: 0 ; FLAG SAYING WE ARE IN MAPPUR + +IFE ITS,[ +MAPJFN: 0 ; JFN OF SAV FILE +DIRCHN: 0 ; JFN USED BY GETDIR +] + +PURE + +END + diff --git a//maps.bin.2 b//maps.bin.2 new file mode 100644 index 0000000000000000000000000000000000000000..3a7b0d0dde54e68c3ab298ed45a8e322f3b4ae5b GIT binary patch literal 8690 zcmd5>`#W1r7u`96h$NB-lDZwY@@hi0N?OH1((+QbhSDl2t)eaQ7In|R{;f49$w^vo zKlJf@-~4dw%F4AC*+(_AF&2r|YGv5^=Vko09D$1;IJkllkdf z*fb?=tNFCWA))aMNat>Cropwa7dA!r*SWqWh;}J&e>l?3%13U`d^PJtcc<MBi+c8mYKtmI^?I5uOsaHJJuXZV6I*E$ZMdx50mc1|9kyji+u^If?P(9uK zjDj?M2+hVMs$-n(va@=FbrpRbv-~R(>4@~MtJb2%1#i+|oz)uNUvF%*2CYw=7ny@L zH-9;gNl+JYu!o&6TsbV8N6#zL9MtA!4}&V!pv}(*!ZB;mO3q6S2`~Bg8gf|n4c1xR zh{Yp8;C6_8Rt)KoyeX+GuSRBHpkWKv-~u-=^1ebiS@qrLmgqw%;wn>?ypu# z5Go`5Y5GkYPNx+hR!O5P^`pYH8b>x*XDz?E$yfE(nmmIUDzqBbri*y!a|2a*-I`9f zC2n;CEj}m!q(#G^1cL&Dp{TwTq-QQPiymIlV317N`>~h4kl;hCqYhQ!A$+(lEknY2 za}#POiTLxAg4u3C!UF>%=PiMb&o}$OlMpam(F_*ZJbHF=BN85PT4hdWmV~}ygLRe{ zfTiK|7ZPTtq%KJ~Ur0h=!sWFR1fPzQ(sa7(zKHD!gK|x? z$a2ppY)*=nh8yrzo3J?v6>`_6m>ot2cpL7EiY(aszrC?+daKy!3mKT_C#q~paGbSm z++|U*Q8vpIXrdQ{Dj!zn5J`?cm`1oZLzOR>V@W8-66j@E(vxG!Rg-U6E4mF!bP)sx z6fG(aL@A&7>tlR=cl9O&0bCRkKbPkWfm>G+hk4ay*^9Y<|cCz2q1l4Wwz( zMSS(1q;FJrvB5xa>wST`el(!nFj^xN!hH_W)TayG-VTCco^T($sy@~L1_p4GT<`c< zHW^0AFw*I?F6s2;MosmbP2#H(JA$xo01HR4sSoG%a7xdxjs`NeRqq5@yLK=@SLdu~ zx`zCr+wnosL@iKvW?TDoNDmCSNoTumPlKUg{VIvQ9tnU8>oZ$Bxdu z#Mgom#_js(8i2=^Oe{719Nt`vh8|tb7@)$_(AiQKoqtvaIM{hQcOC}C_B6aY2kqp% z3W4nzY>;MMpm5~C+$I{jt6^P!Y-%ESkoeS;IK!xs|7qPF-jU$3bZdT*7Bvyad-Ti! zJ%#07-H!iUok`dr;YIFve3UtHc8fCg&Nm|4XG-t>_e1^E+9|i&`*j9~D@+sl+wV6i zt8pJGD+6frXuzm5_tv$}O+F@LtP*=GcZTyt4AvE5nU^5k=n&!21dOnzq%Kp|RD5JH z4vXg>o_t^<`b-S}wRJBSk;0Sgfy0w8l8Z>tGb7U3K`tU)1!LN>^KBv$fMeTaJ*W+< z!;{ZEVE`Y>EcG%hP4KMTtAfJgM~D%Mow^-#-0x|>+_UU* zJN}IrTuh5-hLp_lRW)10TTntZ@o(QQ1f=jEO!%spy- z!rY_IX4iGHqKk6!;N3d;37tGH!7X{B;UJ}}K+B-D@(|GdboY`K3H8>sblOZ$4QT1b z(dBs);%TK~M9pOS!e`m zq_SU2TleK>%Otl7f;HxOp}^h2-NNi=2>&c6ozJIK4F;YWOIo4W0@@Qp#zkhDchF_7 z6G6HQ%4sOzZdn3J{~MpV66hTs|2Qn-tNpZUpQ!Q4LAit*ItmURmi-h;C<6>`(} zw2P$0joY!k&A_0A!7cb!f=Sj&nXV>MvieNVBq9^j5hU8ki-qa2#Kg?B6y(|(yjD3x zrnSdKD~?qL zUncomnO&AKp?b-{TMn72;xnyg14mf4*ns+6c};1)@4WqNO~$>lT2U2ndMm0*Y(GA@ z7rx^fu4n2DDq0avKW}NvyEHVi2Q@@r|8Q9zdcjMVc#^Ks-4m#VsahP}UY|Q;j zNFN#QzWk*J#+z;4zjRo>{7nzgq7eA8vbb7@K~(v`d%E%mB{XUP`0K;nUtruVaKtP5 z_O9>SJNG}q$pmrKmcReF6{KXin!2ZEDAhRY)?-OZCFQFtA37-2m#&pF8wTuBW=-!MBsXDuRXSPd8z0OzK5S$IitFw#q^V#z^{Ml6=EKA|F z8@srEuubogV2b$qlj52yoiW%@;##XbaZ%Ep<1?otlwLT;zu5wmp1K!3m7ge0xD%dG zh?29kaaC*|q&U1zhW(49U}po$1&(TI%je7glwsVz+SG3S%b!3-ViSHmS7-kVdT(m? z%zOiA>pZdN{ku!`<@#js-pP7i4?hQ04Ux{1_5R;j2phtn;{Pd?uW6y$vC+B?wcgg= zwv9#WAA;Am5I2W9Zjx8p`M8h&Da45B&xmh)3C=5N1je+Cq(nv&fhk?JjIFLrAt9s0 zRy?1O_3=y{d$;%TBdc7aiN~d5l)U~=eaZKfBJr>OR?dK<0qVX`3I}jsP)~X@{`x~- zjCH=ia^g#p($Z-CL3f1;xUp!=d^r&Gs7Lt4(+jX@1|_Ydw`XiAgRgrNkrH7u5S_c9 zq*PiNh~a;@D2s7dW5|4W_99tK1(tK>rdGwL3mw|!Fb|+gO#e0uRPbo>HYPI%vS?fIKD2Bv$cGrd>*`;#ztw#eUNk5=e2)9u1oZ6fhu_;no*h|2ouZWb5Bbr~ QqVHIesIyAC5!_JaKi>^7H~;_u literal 0 HcmV?d00001 diff --git a//maps.mid.29 b//maps.mid.29 new file mode 100644 index 0000000..4c0cbf2 --- /dev/null +++ b//maps.mid.29 @@ -0,0 +1,247 @@ + +TITLE MAPS -- MAP FUNCTIONS FOR MUDDLE + +RELOCATABLE + +.INSRT MUDDLE > + +.GLOBAL TYPSEG,NXTLM,NAPT,APLQ,INCR1,SPECBI,FRMSTK,MAPPLY +.GLOBAL CHFSWP,SSPEC1,ILVAL,CHUNW,DSTORE,PVSTOR,TVSTOR + +; PSTACK OFFSETS + +INCNT==0 ; INNER LOOP COUNT +LISTNO==-1 ; ARG NUMBER BEING HACKED +ARGCNT==-2 ; FINAL ARG COUNTER +NARGS==-3 ; NUMBER OF STRUCTURES +NTHRST==-4 ; 0=> MAP REST, OTHERWISE MAP FIRST + +; MAP THE "CAR" OF EACH LIST + +IMFUNCTION MAPF,SUBR + + PUSH P,. ; PUSH NON-ZERO + JRST MAP1 + +; MAP THE "CDR" OF EACH LIST + +IMFUNCTION MAPR,SUBR + + PUSH P,[0] + +MAP1: ENTRY + HLRE C,AB ; HOW MANY ARGS + ASH C,-1 ; TO # OF PAIRS + ADDI C,2 ; AT LEAST 3 + JUMPG C,TFA ; NOT ENOUGH + GETYP A,(AB) ; TYPE OF CONSTRUCTOR + CAIN A,TFALSE ; ANY CONSING NEEDE? + JRST MAP2 ; NO, SKIP CHECK + PUSHJ P,APLQ ; CHECK IF APPLICABLE + JRST NAPT ; NO, ERROR +MAP2: MOVNS C ; POS NO. OF ARGS (-3) + PUSH P,C ; SAVE IT + PUSH TP,[TATOM,,-1] ; ALL **GFP** INSTRUCTIONS ARE TO DO WITH MAPRET + PUSH TP,IMQUOTE LMAP,[LMAP ]INTRUP + PUSHJ P,FRMSTK ; **GFP** + PUSH TP,[0] ; **GFP** + PUSH TP,[0] ; **GFP** + PUSHJ P,SPECBIND ; **GFP** + MOVE C,(P) ; RESTORE COUNT OF ARGS + MOVE A,AB ; COPY ARG POINTER + MOVSI 0,TAB ; CLOBBER A'S TYPE + MOVE PVP,PVSTOR+1 + MOVEM 0,ASTO(PVP) + JUMPE C,ARGSDN ; NOA ARGS? + +ARGLP: INTGO ; STACK MAY OVERFLOW + PUSH TP,4(A) ; SKIP FCNS + PUSH TP,5(A) + ADD A,[2,,2] + SOJG C,ARGLP ; ALL UP ON STACK + +; ALL STRUCTURES ARE ON THE STACK, NOW PUSH THE CONSTRUCTOR + +ARGSDN: PUSH TP,(AB) ; CONSTRUCTOR + PUSH TP,1(AB) + MOVE PVP,PVSTOR+1 + SETZM ASTO(PVP) + PUSH P,[-1] ; FUNNY TEMPS + PUSH P,[0] + PUSH P,[0] + +; OUTER LOOP CDRING EACH STRUCTURE + +OUTRLP: SETZM LISTNO(P) ; START AT 0TH LIST + MOVE 0,NARGS(P) ; TOTAL # OF STRUCS + MOVEM 0,INCNT(P) ; AS COUNTER IN INNER LOOP + PUSH TP,2(AB) ; PUSH THE APPLIER + PUSH TP,3(AB) + +; INNER LOOP, CONS UP EACH APPLICATION + +INRLP: INTGO + SOSGE INCNT(P) + JRST INRLP2 + MOVEI E,2 ; READY TO BUMP LISTNO + ADDB E,LISTNO(P) ; CURRENT STORED AND IN C + ADDI E,(TB)4 ; POINT TO A STRUCTURE + MOVE A,(E) ; PICK IT UP + MOVE B,1(E) ; AND VAL + PUSHJ P,TYPSEG ; SETUP TO REST IT ETC. + MOVE E,LISTNO(P) + ADDI E,4(TB) + SKIPL ARGCNT(P) ; DONT INCR THE 1ST TIME + XCT INCR1(C) ; INCREMENT THE LOSER + MOVE 0,DSTORE ; UPDATE THE LIST + MOVEM 0,(E) + MOVEM D,1(E) ; CLOBBER AWAY + PUSH TP,DSTORE ; FOR REST CASE + PUSH TP,D + PUSHJ P,NXTLM ; SKIP IF GOT ONE, ELSE DONT + JRST DONEIT ; FINISHED + SETZM DSTORE + SKIPN NTHRST(P) ; SKIP IF MAP REST + JRST INRLP1 + MOVEM A,-1(TP) ; IUSE AS ARG + MOVEM B,(TP) +INRLP1: JRST INRLP ; MORE, GO DO THEM + + +; ALL ARGS PUSHED, APPLY USER FCN + +INRLP2: SKIPGE ARGCNT(P) ; UN NEGATE ARGCNT + SETZM ARGCNT(P) + MOVE A,NARGS(P) ; GET # OF ARGS + ADDI A,1 + ACALL A,MAPPLY ; APPLY THE BAG BITER + + GETYP 0,(AB) ; GET TYPE OF CONSTRUCTOR + CAIN 0,TFALSE ; SKIP IF ONE IS THERE + JRST OUTRL1 + PUSH TP,A + PUSH TP,B + AOS ARGCNT(P) + JRST OUTRLP + +OUTRL1: MOVEM A,-1(TP) ; SAVE PARTIAL VALUE + MOVEM B,(TP) + JRST OUTRLP + +; HERE IF ALL FINISHED + +DONEIT: HRLS C,LISTNO(P) ; HOW MANY DONE + SUB TP,[2,,2] ; FLUSH SAVED VAL + SUB TP,C ; FLUSH TUPLE OF CRUFT +DONEI1: SKIPGE ARGCNT(P) + SETZM ARGCNT(P) ; IN CASE STILL NEGATIVE + SETZM DSTORE ; UNSCREW + GETYP 0,(AB) ; ANY CONSTRUCTOR + CAIN 0,TFALSE + JRST MFINIS ; NO, LEAVE + AOS D,ARGCNT(P) ; IF NO ARGS + ACALL D,APPLY ; APPLY IT + + JRST FINIS + +; HERE TO FINISH IF CONSTRUCTOR WAS #FALSE () + +MFINIS: POP TP,B + POP TP,A + JRST FINIS + +; **GFP** FROM HERE TO THE END + +MFUNCTION MAPLEAVE,SUBR + + ENTRY + + CAMGE AB,[-3,,0] + JRST TMA + MOVE B,IMQUOTE LMAP,[LMAP ]INTRUP + PUSHJ P,ILVAL + GETYP 0,A + CAIE 0,TFRAME ; MAKE SURE WINNER + JRST NOTM + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) ; POINT TO FRAME POINTER + PUSHJ P,CHFSWP + PUSHJ P,CHUNW + JUMPL C,MAPL1 ; RET VAL SUPPLIED + MOVSI A,TATOM + MOVE B,IMQUOTE T + JRST FINIS + +MAPL1: MOVE A,(C) + MOVE B,1(C) + JRST FINIS + +MFUNCTION MAPSTOP,SUBR + + ENTRY + + PUSH P,[1] + JRST MAPREC + +MFUNCTION MAPRET,SUBR + + ENTRY + + PUSH P,[0] +MAPREC: MOVE B,IMQUOTE LMAP,[LMAP ]INTRUP + PUSHJ P,ILVAL ; GET VALUE + GETYP 0,A ; FRAME? + CAIE 0,TFRAME + JRST NOTM + PUSH TP,A + PUSH TP,B + MOVEI B,-1(TP) + POP P,0 ; RET/STOP SWITCH + JUMPN 0,MAPRC1 ; JUMP IF STOP + PUSHJ P,CHFSWP ; CHECK IT OUT (AND MAYBE SWAP) + PUSH P,[NLOCR] + JRST MAPRC2 +MAPRC1: PUSHJ P,CHFSWP + PUSH P,[NLOCR1] +MAPRC2: HRRZ E,SPSAV(B) ; UNBIND BEFORE RETURN + PUSH TP,$TAB + PUSH TP,C + ADDI E,1 ; FUDGE FOR UNBINDER + PUSHJ P,SSPEC1 ; UNBINDER + HLRE D,(TP) ; FIND NUMBER + JUMPE D,MAPRE1 ; SKIP IF NONE TO MOVE + MOVNS E,D ; AND PLUS IT + HRLI E,(E) ; COMPUTE NEW TP + ADD E,TPSAV(B) ; NEW TP + HRRZ C,TPSAV(B) ; GET OLD TOP + MOVEM E,TPSAV(B) + HRL C,(TP) ; AND NEW BOT + ADDI C,1 + BLT C,(E) ; BRING IT ALL DOWN +MAPRE1: ASH D,-1 ; NO OF ARGS + HRRI TB,(B) ; PREPARE TO FINIS + MOVSI A,TFIX + MOVEI B,(D) + POP P,0 ; GET PC TO GO TO + MOVEM 0,PCSAV(TB) + JRST CONTIN ; BACK TO MAPPER + +NLOCR1: TDZA A,A ; ZER SW +NLOCR: MOVEI A,1 + GETYP 0,(AB) ; CHECK IF BUILDING + CAIN 0,TFALSE + JRST FLUSHM ; REMOVE GOODIES + ADDM B,ARGCNT(P) ; BUMP ARG COUNTER +NLOCR2: JUMPE A,DONEI1 + JRST OUTRLP + +FLUSHM: ASH B,1 ; FLUSH GOODIES DROPPED + HRLI B,(B) + SUB TP,B + JRST NLOCR2 + +NOTM: ERRUUO EQUOTE NOT-IN-MAP-FUNCTION + +END +  \ No newline at end of file diff --git a//mdl106.agc.1 b//mdl106.agc.1 new file mode 100644 index 0000000000000000000000000000000000000000..4602c83618768a2116f805cecb11826b519cfa14 GIT binary patch literal 35840 zcmeHP`&S#cw$_Y|2gn2RXb4G~2*(&dXUroeZBA1gYy&9)Y#?#%+~TIR>FG(6ws}Dd z@xOk*Z)-e5IGo)XmI6do!SFWh$0w<{H8 zk8ABHl~YQsXf!Vc&8jpD-zjBbm{ObQb+oNwN-rsU%)RP(=fNd&pmQo7BU4K!K!G#RyeO@`KTZ>rMW!AExkW)!j z0am`GGe+>cz`#qYxN5RPBqe^3-b@s?$y6{^dWOVlfC%yI%OZyKO4FrOEbIaH_C+Bk zKTGIbZmR}K_S5FLG&!t=TKWO;YZ(wlRc=#Nu9ehzeYK>{>B}WGs;`&Sh032wITgqv zMFKVJKz4?kcMhyZZweOxVc!v{$i6Id2r-?WBtA^v1#}F{SJm%3pI?G-&d-t_NZ|R*r+>V=U_TI zO?4dAHl>2Gj}G=SV+`9((5zsgzp{6v@X+zN`|0;aQeVfFswGvdpRt|(UzHnJv|taq z*up}}neKOh_;^O4S0{mFGJyqpOW3FqP*kO!zsf%`Vq`UGqn9#UO>XFR4~3gVp=-(} z#3QdW=pEvUMvNGNDs$errc@Mn__T(J)=|Ahi#2#wH4qx+u&Na77{ORobx|7@`;{g( z-n*a+7y=1Czrii5O2LkcLC4Js5obZefz5y}KCqdQkHqgH7^L6x+xZR`n1(V8<6G?4 z%qleO)hNKykH*zn?zuC4$t)0ajD>Ujm*R#aJ`tC0J%x!o!@yoVu!oA(t^tovT

} z4RsuYXrpv#>9Wx)aT($$xCFXGs`Bs!Svi!|7OM~y5NB@XY_R77OVqUydM;I3QtIL? z3aa;Xi8b2v^cSp+vsUg5Lsb@5(L4XMQY&r)&F}XiIC~eQm%f}{H2qY*g>;173JO*D zh>5!RXD?L1Z%%_BN0eNAvzirfmgXKwh=%I)P@Bs@1xgtNP3i5>b9fqs8;mG5Xvt*1 z$9?lwQIvHCTEcG~g__5vJB%j9wPdXHavQ~?pT>$9T;Y_j1hvw0ACg{2jZJ^k)WpC7 zKe*`WUQoPaO^Ro%NfGv*Rr@FDUIh$ZHDz<`3q6csjK8J{bfH%n=v8|adl_uJsDLzWL0r5Fm|nHY zbUa23g__4ElmT2cxCHy#+k>Z(UBw9Fr670@+gM8bYJp8bhsR#oWJHbWUdSMjxp!ja zl>U^=B1;#XZL0hU;*hS%wFw=aheNkiLn!iSE@@l59{gmiFTNPP*5Qd>vE+yNMy;#q zTeJ__G>iKLtcHRkpbjVO{BPrQrEOv7Wi)fq;|#91^^25RzLG z%JUUO;x8H0`E8Q^^s;Y$@Wlc9b6_8P4%BQq_>onKoG7e=R!>>qbuPngHs^pE5)pe+ zAZDsj6@j*U5CcKop3KA{mCGPURt%LRZx%H~LoNN8ICFkGmaL%i8@G`uVjIM9!Wm-` z@1PmOULsjca)B6eIJMv$q3OIlF#C(|@Gh8*Vl0PZAZ~?|kJ2@d%xlIEV*$1=)n5h! z%0g{A2PExt8lHu-jgCSY@a>~%jvOy)1aNeuxwYy0rF|rttS!&hl$vI3sl=KOEMV%A z6+3F&BTFJ(*bMhAgJDQqS78uoptk5+S$cP66&4jHN^K@eogRxgifT$({Wf!{*?r?3 z)4N>97*JEKrbdB%15={W8HHZWKY|#Pph*&`ZHj1Ac{7n@L1O1vYUWVfNR#tQjfGzm zT(B%Pk)$>;w9P(;7-c;cpZiil*9p_uX?d+nWoP3qNkbOWB zd=m!3Ibe{T9Q20lvz#(yU(jg!0tLk6lHU$CB`#@qmq)Vw1oqKO-s$&~X%tPsX(2NQ zV1gQVi^Jl^WiTrM8duMA`SGAI!BBEXoWW+!=~M-qGL8hiOylIH{8>sFe>!tfGH!gE zIp4LR5&JeIpnFF6^oe;IyY&sCsr3eQ)5j#1W9bPoDzKx3(1|6BEQrpwlkB1JQZxPj zHkM$u(_rl;(af>d>fs!)LkH!Oq`d?Q#8#Jhau6ZGH2sn?zc&lyCbw%L9ct36)d4yx zSf#F^Cf{(ZvVPAEj^^g9Yn0Gd){j)yD$RL`-up-Bv-K;Q7ISYDsJ&qG1)DE)%JHrc zgFhgUjcAHFbo{#2lN=7m46COb%6f$WWc@*eKG*R(?w$~Lg&4iBgIhnXJD$j4(Ir^JCPIzU|Ig+mGg6?S z+`Np`n3PK`@wu4@gEeAB>{7V`AuBAfHf4R)b7mgnUI0j@l;XK3#`6abo@p$9@J-dt zw*T$i;+C~o!TKnbSy5X4Yb*60spfw3M)W`2N?pvfay z2)4u-36&UuVYEDn=Yq4G44V=|Vfw0_qLTsa4C)!iX|>|P4E_xAoVTah1JieN&z1Go zsyN=&`R5ox1^xwGG6{aWu~@^3`0cF(>-i*z$v#HSeq+{wRkj9aNeGE4--&$SGF~N@ z+wyH7hOyeWCd^U-BNc{WjzL-`QgPm2F{P1;z-D;(nGrjG2XL&n9*RHV3Bd)mce+L{ zVD(;R3&f=kS#LuIgQaG8Dmuwj*nh%6CeI8B1Hwr(GUCkT4rM8nd9dj7yurwfo{Dc^ z0C2ETOC@d@Nv?_hm6C9M($uM8t6xh&(VIPNC^+L9lD)LZnXsH;7gX^t|?lAaK2#k1#7>u_A5Gu z$8N@HBsCO)^hI=Js?6{hsHRp}qX$L}S^Zs!Z>*)d@YKg07K}JHixY=iPV{DB$;sRo zgC*i+NgL@}4lAP1~u=v2@Jq$uM7(>sqCUn%; z_~nIXPVDZz4hk@}d0vg(CDS~Ml8I{A9-c7lp2+-p${t&th90P2;Eb$HVxlkidM1NU zW8;SwesVG^U)WBjAtQJa7M0qR-sUQT9A=ZVOJ+?rg(S@8GOaF?d@9#<0g(*UKWr4n zB+)Tp&<#j9Y>il%4mQ{CB^~<*Ijl&E<55p};!|^g^F7(?yJ%XoNDO7(uH4dv&8ZCh zRU3ts%OIJc5g)TSBK!XlS!mtII)UC^!})0BqXir<>^qs~%&z-%&Hb04ljZ*)Q&#zH zV&Cx=h0A{u^1~TIzWh|kmuCohL?Qp8kgozErTHC|<}jSnqn&rJ!FDG!WZ6frLRQ7& z2!gkZ+feDae^v)JAh#^nu5#=Xrd=lV+C~8dwjHRl{ez}!C{4jVK%neR+398j`wI;2 zAZ-L4Sf#&`<3nc%*(N%yKE`Gzi676zg%$EkERIgZ=k(}Ay4%d*el1TiC!m=3PmNvF zp!;<$j+B#yq^lB{=AoEXDX7_BEHWNZsu?+=gs%X)hI@Xk(2MtqEW<3GFDk*^KSQ7g z^|8!RX7m8JTaTPrikxR1=a(y@X!Yu5`GeB0X1`3yIl#J)pZT^GcEhwe?TJl84a(J`7^d@C67o z{6G>f@eCsKd=4oX`7L;Oy@{`i2GL4vDEFwkY_ zJ&hBuS}2V91=hImi<5mOBNkJ1OZ%~}`;aex#9LEqU#W`1)oK2S+WAJT!b^kS9!-~` zb;W+EH0DV|o~*c{woylhEYTb&p}5U#53dT@J-oX4&1OR(wB2^{EOIZI9#zTU2e@Ht zZ?OWvbOWNv1_WIGC5u_?`CNXHy{sf4G`Spz?uJbn>*nr=dgqS1aWEa+$>cx#z6P*3 z<>ZvcWG<(aCMEr&CHs+rr)k!%qq~BFz1_;7HhF5PE?*A?Q$8mtIDHJGg|cRC_fUwq zL4nI)Jg;=QTl=G+@sb`)jmhx<=iC=!R$|yR;_EbG-ht*u*qmXL+Mc_^=6N<}6 zJA`CWOk7+Ln%FJe1j;!NsSCvg$p>T<@SalZ;9IblM{?Eqj28hS#wSXhyV&Fl7OjVO z0GY$BfFFr1hHYHOVEOEjS4&KUru*+r+e61kk>FYSIx;OVm7^OokKBhnY=uQ}Ef137 z;KO;@oU0f+%H5pO_{1ZgnKI-jbRlQ%;1QdPoZ|}g$~r9j8=uPxB(P9hAWpZpI4`bu zJ~pxEmW;qyfLH=dn;b^0Vp^k++X~mevdA8VXoSN=3_({mg{%(#+x;Myp)M9JVdAju z*K!}qNqnOU+#`uO?1dA_dS&y1{rD)(QgZKr&bJC!txfy5(BYe$c}tDQshCKLJSwKB zvYSIQRDQAPDq}798FOatll_;ZQ4)pbeCy6Nn5Thy1+?AVrx>wB+Wcmcr6k(l@ zvEo{&2mePv>$~jrqsS<3NgiW=BrVpJ)|@5 zV01i|ba1<81C<)Q-q8KSR*hTN3GQGTJ1E~IOh|jH1}cz`^K@L5Z<@I`ugCUy zOKiPNtBR_4|x|7thRhA%Nt&r{k}LUinFjZcvu*C_NSPlo&F(FZf_Z zW(0`?=_h1AeCdJT9`w{QqAfZ3n`en8s@!}+I%ex$83o?j)R4yjshLg-zkyx);chPu zNjpS{be7mY9jzs&_cmRD*;?j_p_7q7+Fn90Hu>ax5AzqhgWaMR%}MJ->Z6wf$g{o}bB00V>UBp$9o%n?lECDJh~%^Wgm!xIiV zG@=zqz>iZh;9j-JrC%*8t3QjapoQkY+2ejJl%4#VoTI3~=2S!@HfJj@x7Y6vvb4PX zj%Pz2GCZc2?jtjY|I?RHW0NVY(xrbkH)ttDH4##biO$!d1Z%QUQ}AZvD?Tg8(!=D) zL2wHJlRR+_XfmspKp;TK3k=>l^Ur2$a-u>_e%L`^hvWiBrj+A|!G)-W8S=|HsFNf% zpv&{(E&oQQls5;DHr-^FAvb|!I!f3rF&q;A*i4$}k~t)MOTsoger7~G5t#XUgQqA= zzR$P?W5U6`hUiSX@r%aLk>>xsiuLN{-;FH>5YYVrfDMw$8TQH}?2qE^y4doq5;ihc-j}7b*n>XYL7f;0i0+<_X4vIH0YFu^5dO~lYtdbHBlokB21m6|VG?>wfSrs0T^Izn0AU`!@wkdbRgQjmsra7>q z!UNiyeQ(Jr%nM9B!^RgYWBrc=_Up6!kpB(mk56zed_^s3h!%%Fo8KM}6sfSx=C+WK z{c`9i#IHfUzwT?~n6H~Ts5~;VSf}$7z~0rMv!(=uQJg-5= z-j5ng`|@ilUIaYjJ_{UwJCdyssRrzQ!;ud8;h2{Jp6)6ZEhJ!&o$PS=h1)K1(4=kzM#6i&81;Tgl>Y(!l{n;1qOD@Mb1NLmZ#tg! zAU%GiS2)=J0|AZm{>ZbRd5LQ#l{&Ww&mbM2@s~uFm%;+KmhkO6W&rn|IK|HvsSF%@ zRoBSGcx%}cyEV?+!DXm5APdPJ% z-^cRI?&1+0-{irZzshdlSJ}mBy#;0H*x=PkRFowrW;ns37ceN2!LcxqvGRjhxS(SG z-j-9$YI(D!v*bpZTPA9RM0=Bm1wW>BxCvjd-*vlwX{7NjvS&BfL)`iunG=&F=(?=Q1o3{nT6M%7T@Q!9NlDfQ2 zFc;C1BN1beLKykpiWq0fcWNS@Iz*-3nxA+uDI#Z!hWHl0r*UomZca$vv~l>s(FhJD zw+}-!TQLq<2-pSl&?0#RFB=BWEAA~xAW!9qv-^BSu_oLRxys>I+^ujwg5m~iQb@1Wnh*;~0dEfOt?-AqVLEM8kLNNu zYKcKC5{-~VGA-OpxGDZnxGF0Td-t%tHj)Io*H4DI)NvB0pg+4+2aF?()i}yLjmLVqH;Age&@;ov;!G3M<%Uic4z|K~XvucDk zWK|e(59@v0sX!oNzri1KGnBheMBA&W7><$PY&Dtic@5OMK+S^pc9%J#(M9%v-y!ey z`(2t9@!M@SK*HYL4h0X1(QE$@xG#&>hL(7A$$}dEk=QA48y4?ae8BMN@Be`S@~3{ENFJ~_Wbr49zgQfxIA(!u zay-(}u{$N~xL?2;oD!a%>P~fC*ITX4maeWW7mK?a)ur{i-r3ZTt6LghwzsOw zb-lKMFUy;)y1scqBspvBR&}Mmtv5DzboEJfZCw}%`B}umYdoEy_RjX-iQC%U*jU?G(XH*>rIvnL z-+l-WRz}VgGdP^@?*VpT{BDT5Fs@L^4^Z~5V-q|W{?^Kt+VHf^(Hn)oF^(Xap%#JbJ z{JgThxx`(mu0ufwbkHkP$LO84&5dg7TfO#pYZvwwGRK+Da0i#AO^72?;g_H5n@=~u z=@dC^w?#qyIoPZNG>l!}1aJy}E3M6^Qc>$`+rH)bK%jTKj!!673<;Oosk6?BiZpgC zt6Bpd_=Y`D3aSHFvb(iYT&-@@)}?2o{#0y4hONOgK^*->2t)`(2t)`(2t)`(2t)`( z2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`( z2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`( u2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)|{9Rl)y8vS3E$guDL literal 0 HcmV?d00001 diff --git a//mdl106.agc.2 b//mdl106.agc.2 new file mode 100644 index 0000000000000000000000000000000000000000..4602c83618768a2116f805cecb11826b519cfa14 GIT binary patch literal 35840 zcmeHP`&S#cw$_Y|2gn2RXb4G~2*(&dXUroeZBA1gYy&9)Y#?#%+~TIR>FG(6ws}Dd z@xOk*Z)-e5IGo)XmI6do!SFWh$0w<{H8 zk8ABHl~YQsXf!Vc&8jpD-zjBbm{ObQb+oNwN-rsU%)RP(=fNd&pmQo7BU4K!K!G#RyeO@`KTZ>rMW!AExkW)!j z0am`GGe+>cz`#qYxN5RPBqe^3-b@s?$y6{^dWOVlfC%yI%OZyKO4FrOEbIaH_C+Bk zKTGIbZmR}K_S5FLG&!t=TKWO;YZ(wlRc=#Nu9ehzeYK>{>B}WGs;`&Sh032wITgqv zMFKVJKz4?kcMhyZZweOxVc!v{$i6Id2r-?WBtA^v1#}F{SJm%3pI?G-&d-t_NZ|R*r+>V=U_TI zO?4dAHl>2Gj}G=SV+`9((5zsgzp{6v@X+zN`|0;aQeVfFswGvdpRt|(UzHnJv|taq z*up}}neKOh_;^O4S0{mFGJyqpOW3FqP*kO!zsf%`Vq`UGqn9#UO>XFR4~3gVp=-(} z#3QdW=pEvUMvNGNDs$errc@Mn__T(J)=|Ahi#2#wH4qx+u&Na77{ORobx|7@`;{g( z-n*a+7y=1Czrii5O2LkcLC4Js5obZefz5y}KCqdQkHqgH7^L6x+xZR`n1(V8<6G?4 z%qleO)hNKykH*zn?zuC4$t)0ajD>Ujm*R#aJ`tC0J%x!o!@yoVu!oA(t^tovT

} z4RsuYXrpv#>9Wx)aT($$xCFXGs`Bs!Svi!|7OM~y5NB@XY_R77OVqUydM;I3QtIL? z3aa;Xi8b2v^cSp+vsUg5Lsb@5(L4XMQY&r)&F}XiIC~eQm%f}{H2qY*g>;173JO*D zh>5!RXD?L1Z%%_BN0eNAvzirfmgXKwh=%I)P@Bs@1xgtNP3i5>b9fqs8;mG5Xvt*1 z$9?lwQIvHCTEcG~g__5vJB%j9wPdXHavQ~?pT>$9T;Y_j1hvw0ACg{2jZJ^k)WpC7 zKe*`WUQoPaO^Ro%NfGv*Rr@FDUIh$ZHDz<`3q6csjK8J{bfH%n=v8|adl_uJsDLzWL0r5Fm|nHY zbUa23g__4ElmT2cxCHy#+k>Z(UBw9Fr670@+gM8bYJp8bhsR#oWJHbWUdSMjxp!ja zl>U^=B1;#XZL0hU;*hS%wFw=aheNkiLn!iSE@@l59{gmiFTNPP*5Qd>vE+yNMy;#q zTeJ__G>iKLtcHRkpbjVO{BPrQrEOv7Wi)fq;|#91^^25RzLG z%JUUO;x8H0`E8Q^^s;Y$@Wlc9b6_8P4%BQq_>onKoG7e=R!>>qbuPngHs^pE5)pe+ zAZDsj6@j*U5CcKop3KA{mCGPURt%LRZx%H~LoNN8ICFkGmaL%i8@G`uVjIM9!Wm-` z@1PmOULsjca)B6eIJMv$q3OIlF#C(|@Gh8*Vl0PZAZ~?|kJ2@d%xlIEV*$1=)n5h! z%0g{A2PExt8lHu-jgCSY@a>~%jvOy)1aNeuxwYy0rF|rttS!&hl$vI3sl=KOEMV%A z6+3F&BTFJ(*bMhAgJDQqS78uoptk5+S$cP66&4jHN^K@eogRxgifT$({Wf!{*?r?3 z)4N>97*JEKrbdB%15={W8HHZWKY|#Pph*&`ZHj1Ac{7n@L1O1vYUWVfNR#tQjfGzm zT(B%Pk)$>;w9P(;7-c;cpZiil*9p_uX?d+nWoP3qNkbOWB zd=m!3Ibe{T9Q20lvz#(yU(jg!0tLk6lHU$CB`#@qmq)Vw1oqKO-s$&~X%tPsX(2NQ zV1gQVi^Jl^WiTrM8duMA`SGAI!BBEXoWW+!=~M-qGL8hiOylIH{8>sFe>!tfGH!gE zIp4LR5&JeIpnFF6^oe;IyY&sCsr3eQ)5j#1W9bPoDzKx3(1|6BEQrpwlkB1JQZxPj zHkM$u(_rl;(af>d>fs!)LkH!Oq`d?Q#8#Jhau6ZGH2sn?zc&lyCbw%L9ct36)d4yx zSf#F^Cf{(ZvVPAEj^^g9Yn0Gd){j)yD$RL`-up-Bv-K;Q7ISYDsJ&qG1)DE)%JHrc zgFhgUjcAHFbo{#2lN=7m46COb%6f$WWc@*eKG*R(?w$~Lg&4iBgIhnXJD$j4(Ir^JCPIzU|Ig+mGg6?S z+`Np`n3PK`@wu4@gEeAB>{7V`AuBAfHf4R)b7mgnUI0j@l;XK3#`6abo@p$9@J-dt zw*T$i;+C~o!TKnbSy5X4Yb*60spfw3M)W`2N?pvfay z2)4u-36&UuVYEDn=Yq4G44V=|Vfw0_qLTsa4C)!iX|>|P4E_xAoVTah1JieN&z1Go zsyN=&`R5ox1^xwGG6{aWu~@^3`0cF(>-i*z$v#HSeq+{wRkj9aNeGE4--&$SGF~N@ z+wyH7hOyeWCd^U-BNc{WjzL-`QgPm2F{P1;z-D;(nGrjG2XL&n9*RHV3Bd)mce+L{ zVD(;R3&f=kS#LuIgQaG8Dmuwj*nh%6CeI8B1Hwr(GUCkT4rM8nd9dj7yurwfo{Dc^ z0C2ETOC@d@Nv?_hm6C9M($uM8t6xh&(VIPNC^+L9lD)LZnXsH;7gX^t|?lAaK2#k1#7>u_A5Gu z$8N@HBsCO)^hI=Js?6{hsHRp}qX$L}S^Zs!Z>*)d@YKg07K}JHixY=iPV{DB$;sRo zgC*i+NgL@}4lAP1~u=v2@Jq$uM7(>sqCUn%; z_~nIXPVDZz4hk@}d0vg(CDS~Ml8I{A9-c7lp2+-p${t&th90P2;Eb$HVxlkidM1NU zW8;SwesVG^U)WBjAtQJa7M0qR-sUQT9A=ZVOJ+?rg(S@8GOaF?d@9#<0g(*UKWr4n zB+)Tp&<#j9Y>il%4mQ{CB^~<*Ijl&E<55p};!|^g^F7(?yJ%XoNDO7(uH4dv&8ZCh zRU3ts%OIJc5g)TSBK!XlS!mtII)UC^!})0BqXir<>^qs~%&z-%&Hb04ljZ*)Q&#zH zV&Cx=h0A{u^1~TIzWh|kmuCohL?Qp8kgozErTHC|<}jSnqn&rJ!FDG!WZ6frLRQ7& z2!gkZ+feDae^v)JAh#^nu5#=Xrd=lV+C~8dwjHRl{ez}!C{4jVK%neR+398j`wI;2 zAZ-L4Sf#&`<3nc%*(N%yKE`Gzi676zg%$EkERIgZ=k(}Ay4%d*el1TiC!m=3PmNvF zp!;<$j+B#yq^lB{=AoEXDX7_BEHWNZsu?+=gs%X)hI@Xk(2MtqEW<3GFDk*^KSQ7g z^|8!RX7m8JTaTPrikxR1=a(y@X!Yu5`GeB0X1`3yIl#J)pZT^GcEhwe?TJl84a(J`7^d@C67o z{6G>f@eCsKd=4oX`7L;Oy@{`i2GL4vDEFwkY_ zJ&hBuS}2V91=hImi<5mOBNkJ1OZ%~}`;aex#9LEqU#W`1)oK2S+WAJT!b^kS9!-~` zb;W+EH0DV|o~*c{woylhEYTb&p}5U#53dT@J-oX4&1OR(wB2^{EOIZI9#zTU2e@Ht zZ?OWvbOWNv1_WIGC5u_?`CNXHy{sf4G`Spz?uJbn>*nr=dgqS1aWEa+$>cx#z6P*3 z<>ZvcWG<(aCMEr&CHs+rr)k!%qq~BFz1_;7HhF5PE?*A?Q$8mtIDHJGg|cRC_fUwq zL4nI)Jg;=QTl=G+@sb`)jmhx<=iC=!R$|yR;_EbG-ht*u*qmXL+Mc_^=6N<}6 zJA`CWOk7+Ln%FJe1j;!NsSCvg$p>T<@SalZ;9IblM{?Eqj28hS#wSXhyV&Fl7OjVO z0GY$BfFFr1hHYHOVEOEjS4&KUru*+r+e61kk>FYSIx;OVm7^OokKBhnY=uQ}Ef137 z;KO;@oU0f+%H5pO_{1ZgnKI-jbRlQ%;1QdPoZ|}g$~r9j8=uPxB(P9hAWpZpI4`bu zJ~pxEmW;qyfLH=dn;b^0Vp^k++X~mevdA8VXoSN=3_({mg{%(#+x;Myp)M9JVdAju z*K!}qNqnOU+#`uO?1dA_dS&y1{rD)(QgZKr&bJC!txfy5(BYe$c}tDQshCKLJSwKB zvYSIQRDQAPDq}798FOatll_;ZQ4)pbeCy6Nn5Thy1+?AVrx>wB+Wcmcr6k(l@ zvEo{&2mePv>$~jrqsS<3NgiW=BrVpJ)|@5 zV01i|ba1<81C<)Q-q8KSR*hTN3GQGTJ1E~IOh|jH1}cz`^K@L5Z<@I`ugCUy zOKiPNtBR_4|x|7thRhA%Nt&r{k}LUinFjZcvu*C_NSPlo&F(FZf_Z zW(0`?=_h1AeCdJT9`w{QqAfZ3n`en8s@!}+I%ex$83o?j)R4yjshLg-zkyx);chPu zNjpS{be7mY9jzs&_cmRD*;?j_p_7q7+Fn90Hu>ax5AzqhgWaMR%}MJ->Z6wf$g{o}bB00V>UBp$9o%n?lECDJh~%^Wgm!xIiV zG@=zqz>iZh;9j-JrC%*8t3QjapoQkY+2ejJl%4#VoTI3~=2S!@HfJj@x7Y6vvb4PX zj%Pz2GCZc2?jtjY|I?RHW0NVY(xrbkH)ttDH4##biO$!d1Z%QUQ}AZvD?Tg8(!=D) zL2wHJlRR+_XfmspKp;TK3k=>l^Ur2$a-u>_e%L`^hvWiBrj+A|!G)-W8S=|HsFNf% zpv&{(E&oQQls5;DHr-^FAvb|!I!f3rF&q;A*i4$}k~t)MOTsoger7~G5t#XUgQqA= zzR$P?W5U6`hUiSX@r%aLk>>xsiuLN{-;FH>5YYVrfDMw$8TQH}?2qE^y4doq5;ihc-j}7b*n>XYL7f;0i0+<_X4vIH0YFu^5dO~lYtdbHBlokB21m6|VG?>wfSrs0T^Izn0AU`!@wkdbRgQjmsra7>q z!UNiyeQ(Jr%nM9B!^RgYWBrc=_Up6!kpB(mk56zed_^s3h!%%Fo8KM}6sfSx=C+WK z{c`9i#IHfUzwT?~n6H~Ts5~;VSf}$7z~0rMv!(=uQJg-5= z-j5ng`|@ilUIaYjJ_{UwJCdyssRrzQ!;ud8;h2{Jp6)6ZEhJ!&o$PS=h1)K1(4=kzM#6i&81;Tgl>Y(!l{n;1qOD@Mb1NLmZ#tg! zAU%GiS2)=J0|AZm{>ZbRd5LQ#l{&Ww&mbM2@s~uFm%;+KmhkO6W&rn|IK|HvsSF%@ zRoBSGcx%}cyEV?+!DXm5APdPJ% z-^cRI?&1+0-{irZzshdlSJ}mBy#;0H*x=PkRFowrW;ns37ceN2!LcxqvGRjhxS(SG z-j-9$YI(D!v*bpZTPA9RM0=Bm1wW>BxCvjd-*vlwX{7NjvS&BfL)`iunG=&F=(?=Q1o3{nT6M%7T@Q!9NlDfQ2 zFc;C1BN1beLKykpiWq0fcWNS@Iz*-3nxA+uDI#Z!hWHl0r*UomZca$vv~l>s(FhJD zw+}-!TQLq<2-pSl&?0#RFB=BWEAA~xAW!9qv-^BSu_oLRxys>I+^ujwg5m~iQb@1Wnh*;~0dEfOt?-AqVLEM8kLNNu zYKcKC5{-~VGA-OpxGDZnxGF0Td-t%tHj)Io*H4DI)NvB0pg+4+2aF?()i}yLjmLVqH;Age&@;ov;!G3M<%Uic4z|K~XvucDk zWK|e(59@v0sX!oNzri1KGnBheMBA&W7><$PY&Dtic@5OMK+S^pc9%J#(M9%v-y!ey z`(2t9@!M@SK*HYL4h0X1(QE$@xG#&>hL(7A$$}dEk=QA48y4?ae8BMN@Be`S@~3{ENFJ~_Wbr49zgQfxIA(!u zay-(}u{$N~xL?2;oD!a%>P~fC*ITX4maeWW7mK?a)ur{i-r3ZTt6LghwzsOw zb-lKMFUy;)y1scqBspvBR&}Mmtv5DzboEJfZCw}%`B}umYdoEy_RjX-iQC%U*jU?G(XH*>rIvnL z-+l-WRz}VgGdP^@?*VpT{BDT5Fs@L^4^Z~5V-q|W{?^Kt+VHf^(Hn)oF^(Xap%#JbJ z{JgThxx`(mu0ufwbkHkP$LO84&5dg7TfO#pYZvwwGRK+Da0i#AO^72?;g_H5n@=~u z=@dC^w?#qyIoPZNG>l!}1aJy}E3M6^Qc>$`+rH)bK%jTKj!!673<;Oosk6?BiZpgC zt6Bpd_=Y`D3aSHFvb(iYT&-@@)}?2o{#0y4hONOgK^*->2t)`(2t)`(2t)`(2t)`( z2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`( z2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`( u2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)`(2t)|{9Rl)y8vS3E$guDL literal 0 HcmV?d00001 diff --git a//mdl106.dec.1 b//mdl106.dec.1 new file mode 100644 index 0000000000000000000000000000000000000000..1912f484c0a42b8d7362abf93ff78062f261d9fc GIT binary patch literal 20480 zcmeHNYg-e^wyy3DX%C}<$_S#PMM&q;KoTIp9L6o$#t*jRrTd86e zq@+vea_lv_)@ycOv-^_Wm+ZdOad&QVwV3U9$ z>fM|=qgy$3POF|gSMRWOMyaNVTJT-xXwrA*rgGa#jq)5Hf{V&gwWSC)2cN62yK`3p zpf&>SBUb^Fw7exPO4?8Z6W)DJ6bW%T6H`vNOadhBDLsy()^bXX#bRjb2;}LgJ2!m+ zy-6%{4#;k2qbO?iK*SGP zWBpe22MU7oz{aIm(>*7xvJIiS-4OZ<2E2D&z!H5*gVGD5!&MburNfDe47|;4lHQqC#BHu)c^D=cpnPrAJwDw-jz`3iPkrwj2crSikJ#67sV&hRi#k-{_)S=f;{hso2uJSzC5(} zE@S2vHn%(CLqEjru}v?oEcFUeW~HK&-Hf=8Fei`zM)E(qp7*2edb6@(u>?^RpOM+x zChiKj0Ad^`N{CiuvB;8Z+t2{|sVU4FA6K|#Cl>9;^|D=*T10|(^q> z@gBDn=HxTBGW}(#t6WC$-W#@_P9jq7o;cB(o{TIp9ZoIcq^iKy{9P1JIssgk5iUg` z%szM5;y?{2Pn_S_M9Ya6fTUteqm{|QPjzgg+ik&FRWSMy5O2GQb2T5=on1S%bTt)kU&iJk^ zkf583DfRtFJC$;aKq z9h&j>VOg0luvjrUa%hG@`9yq(D`&u>4n`qB=Tk5gV#dk>2+KspAV~7B+(b@R=n3ez z7H7&hbnbQYO*eI}4I$Pce1tlu&aE`vL|MEfn}E;*h86Y8X+lS zfWfamqNPA;aV*Pfus9fJMWIH-huRU$nhG9=p2?SC^BM5z3{63WoP5Gf+^-AlkP@kt zr!dWw%h_C^-*Upkh+k!Vun2Sk4TY48Wl@}sEvwN15g!sm4TvqF)~00+N5PnlWxHL$ zv=3);Ts%=6Jy*uHLvOdK%M*5!>_*sq$L?8nlWW*pv2}y_@BI8-s3svPp{B24mfEAZ z!^BNSg~NTF+bMK;!|DJN1H0`8MB_=~25u&<_{NnJoth2pd4G(G&G*QnjZnzr3Tw51 zEi;Ta&RSvkW%^x9qLE!Y3%+BrSWgn@Qu25P&g$rG2rx(J>wJ6w)vy*s{6Lbqbe9Uf zV0ts7p$}g+MuVPs;%qiYOEw~iy8;-uyd=fvYTqr61S^E8JxRVlTaUOeusW{6BP>~A zR9nUIt6WC>9IZiC8NV44*+UQtVGq}aV}iZd%?SNFlhLzXf%AmjD0HNa1DZf=u@#D6 zjiC!&l4r>$Pow>C_AA44*}!IoOOv*TjKxn}FihPzF zpYCYYI$&uL4L$(PqicY8OR#G3M&tpV@WNoKw}U7MZL}akC;32xeiMGl+r7kyT4fOm z@m@{d$)RPlJ1yP9Gnlc^cV$P@GMP9C`KC2mPFqcO&7GHHwZvt&wGBf(NlbQ+2RiR( z=@9|5sN5+nUf^I(IBggjRoYnhXsHaqWGtJ&m}qYv!SJsAS(G(sFKMoQAh z?1V)r-C`c))*?(1r7n*TXpel}P3}u22)Lt;ZpEAwB#a?J78lo zh23BjJ7BiW@`}!E_qCVA9eQjmj+1BTwlx-?JpLt7T-=rl?YBGF1KC@Rgr+6SzB~rR zw1Pn(*J2qJ-eMU(&b2RfU+4(GNA#{r-W3KCLacRx;xWqtD*`#fv6ZCm=o;1?;9&W7#O~ zlcmQ>H78$AxW|aB2m?pQ!17Ieq;{olk~#;)N$RZ5LoyXI&w`r@E+A6+x+I+CGRi0% zI+5mz>8uo_9h^umVHO?Mi6T0P;vKNKjxgY|oKC=jX(L?kP*O8ot6=q#4T1dI&pn~OlY@Dh2}CroK7 zkRX-fOCWb!)l`GwBJyN&c^hDD!s*9MYArxuTe$*ER(J*w<@qJr8=Z->9)+mRtKKPZ ziF=2V1I`ZIR*H$f+d`h~CJ-}7=%)tV4XVqpF5dp2gtfo!_9Dv6_9H5_!N{{$N_dS4 z8g$3VT4BuC@~6`xfLR_v%tr%GAdbl#k=mjkYzxF;;^tVb?<%P(yZd1`^b$#AaMpWW zjl1?=H9v)1H>#W<_!)bwYB(m>J{g?%Xte+q?3-3u@{zec$FVllgR9^@NSJ^hqsO?9 zjP)igE^7-*e$!1or-0VMDEIZTU95w(HI#2hYrnuxdBBfI(oQSGH=-t=-sEf<{!;`JwwF_38CxAGM?i(3)e5?`$AKE5v|Nu zY#LPT>ukdbvkWzCne2+mf-^uin*z!3dy}kyJUBnmn7*ZgSelD$dHb zo1PE)S}nB7DdpfnnaE4zrGjRi~f1%FJ zOZ;?|vE8}De9TQR>qqdHz;4mGTFTOVa3C?J?+gUoqJSeB`GTws_(DTkO8>a>$W5Z*n*DCM0P zzyO8|{Br;9mJH%ci4#_l#&hKBpos5ZUF~w!*Lcp$?FU(ST=oAXl8S`=3U%;LGmru%z zhy0psP5RUF2&Q;`2lf{RWR5K%GI4^0eA2?J&-M8U*k2;~2Z^kZF_bD_OAgn{Y$#cF z6K0VT@<~gWh2;*u@A?a?Jf&a|mea=d_?(m1n8eH)`9c<{&F+l4{t7?87v<#P>;cSc zqpV=^{brf?IGI=EO@eQcem-Q@EOwT+@$p9_^TUyzkuRwQ7*xjE9Y{VQRB{CKnkiRB zd+8#h`{f`yj@U|oWNp&B~Ucc(M0hH5kZ)(l{3juNMkQ{a2FL zB>yCNL-Lm7J;?`>k0hT+{v`PVxx>Hz0|Ka!y4{Eo;LaTr(=Nz7M%;Oe1om_1aWVA> zc-?vYZsyLz4c&Q|-knDo`-SM_?aS=`Z;dc9iL#f|$53%gZ)zgn;8;-li$PO-F8(aoxE6q{R(^~btisXeST znhkyR93&w7oFbt9aCdiWcSF}34@-5uU)gQy;(qaQZ^>yZnveG?`cdV66FTfxo4UHL zzaHXVr!9N9+gI;FaZf|{#$NG$MQ`mwVL8HoP;#%hQEA9#;W>r<#6~?d?)9{9Zat{n z(LDJ@{+M%-_m(1w=Rr=a6*wOh>pxY>dat-u*Dyn4t6VW1qpa*nQJXB)P80BOw_dql z-PqjHGdg0L^mB;?s1N(}r7fr3`(w z>4{~fA`Vw!*MTj4)`?Ns-7A?XA=+`UdkdwZ~30ftz+Qw5F+e;f7czBJU%R-=~ydO%>dQNa+% zhGF4Rg9_W+Xo2y8V-?H517k3WQt%|?iHCd5h0Wq_c}He;EBg|vvTO?(0?a4}^iQ5u zn)&Ei+cTd$t3LC^vx1oNtY@)N&w3U6&a>Xe#y#tEY{j$f*e%ZC$moRZh@oNe!g=hVGlJSXs8iS9!( zL|}-(5P=~ALj;Bh3=tS2FhpR8zz~5U0z(9b2n-PzA}~Z?h`/mdl106.dec.2 b//mdl106.dec.2 new file mode 100644 index 0000000000000000000000000000000000000000..1912f484c0a42b8d7362abf93ff78062f261d9fc GIT binary patch literal 20480 zcmeHNYg-e^wyy3DX%C}<$_S#PMM&q;KoTIp9L6o$#t*jRrTd86e zq@+vea_lv_)@ycOv-^_Wm+ZdOad&QVwV3U9$ z>fM|=qgy$3POF|gSMRWOMyaNVTJT-xXwrA*rgGa#jq)5Hf{V&gwWSC)2cN62yK`3p zpf&>SBUb^Fw7exPO4?8Z6W)DJ6bW%T6H`vNOadhBDLsy()^bXX#bRjb2;}LgJ2!m+ zy-6%{4#;k2qbO?iK*SGP zWBpe22MU7oz{aIm(>*7xvJIiS-4OZ<2E2D&z!H5*gVGD5!&MburNfDe47|;4lHQqC#BHu)c^D=cpnPrAJwDw-jz`3iPkrwj2crSikJ#67sV&hRi#k-{_)S=f;{hso2uJSzC5(} zE@S2vHn%(CLqEjru}v?oEcFUeW~HK&-Hf=8Fei`zM)E(qp7*2edb6@(u>?^RpOM+x zChiKj0Ad^`N{CiuvB;8Z+t2{|sVU4FA6K|#Cl>9;^|D=*T10|(^q> z@gBDn=HxTBGW}(#t6WC$-W#@_P9jq7o;cB(o{TIp9ZoIcq^iKy{9P1JIssgk5iUg` z%szM5;y?{2Pn_S_M9Ya6fTUteqm{|QPjzgg+ik&FRWSMy5O2GQb2T5=on1S%bTt)kU&iJk^ zkf583DfRtFJC$;aKq z9h&j>VOg0luvjrUa%hG@`9yq(D`&u>4n`qB=Tk5gV#dk>2+KspAV~7B+(b@R=n3ez z7H7&hbnbQYO*eI}4I$Pce1tlu&aE`vL|MEfn}E;*h86Y8X+lS zfWfamqNPA;aV*Pfus9fJMWIH-huRU$nhG9=p2?SC^BM5z3{63WoP5Gf+^-AlkP@kt zr!dWw%h_C^-*Upkh+k!Vun2Sk4TY48Wl@}sEvwN15g!sm4TvqF)~00+N5PnlWxHL$ zv=3);Ts%=6Jy*uHLvOdK%M*5!>_*sq$L?8nlWW*pv2}y_@BI8-s3svPp{B24mfEAZ z!^BNSg~NTF+bMK;!|DJN1H0`8MB_=~25u&<_{NnJoth2pd4G(G&G*QnjZnzr3Tw51 zEi;Ta&RSvkW%^x9qLE!Y3%+BrSWgn@Qu25P&g$rG2rx(J>wJ6w)vy*s{6Lbqbe9Uf zV0ts7p$}g+MuVPs;%qiYOEw~iy8;-uyd=fvYTqr61S^E8JxRVlTaUOeusW{6BP>~A zR9nUIt6WC>9IZiC8NV44*+UQtVGq}aV}iZd%?SNFlhLzXf%AmjD0HNa1DZf=u@#D6 zjiC!&l4r>$Pow>C_AA44*}!IoOOv*TjKxn}FihPzF zpYCYYI$&uL4L$(PqicY8OR#G3M&tpV@WNoKw}U7MZL}akC;32xeiMGl+r7kyT4fOm z@m@{d$)RPlJ1yP9Gnlc^cV$P@GMP9C`KC2mPFqcO&7GHHwZvt&wGBf(NlbQ+2RiR( z=@9|5sN5+nUf^I(IBggjRoYnhXsHaqWGtJ&m}qYv!SJsAS(G(sFKMoQAh z?1V)r-C`c))*?(1r7n*TXpel}P3}u22)Lt;ZpEAwB#a?J78lo zh23BjJ7BiW@`}!E_qCVA9eQjmj+1BTwlx-?JpLt7T-=rl?YBGF1KC@Rgr+6SzB~rR zw1Pn(*J2qJ-eMU(&b2RfU+4(GNA#{r-W3KCLacRx;xWqtD*`#fv6ZCm=o;1?;9&W7#O~ zlcmQ>H78$AxW|aB2m?pQ!17Ieq;{olk~#;)N$RZ5LoyXI&w`r@E+A6+x+I+CGRi0% zI+5mz>8uo_9h^umVHO?Mi6T0P;vKNKjxgY|oKC=jX(L?kP*O8ot6=q#4T1dI&pn~OlY@Dh2}CroK7 zkRX-fOCWb!)l`GwBJyN&c^hDD!s*9MYArxuTe$*ER(J*w<@qJr8=Z->9)+mRtKKPZ ziF=2V1I`ZIR*H$f+d`h~CJ-}7=%)tV4XVqpF5dp2gtfo!_9Dv6_9H5_!N{{$N_dS4 z8g$3VT4BuC@~6`xfLR_v%tr%GAdbl#k=mjkYzxF;;^tVb?<%P(yZd1`^b$#AaMpWW zjl1?=H9v)1H>#W<_!)bwYB(m>J{g?%Xte+q?3-3u@{zec$FVllgR9^@NSJ^hqsO?9 zjP)igE^7-*e$!1or-0VMDEIZTU95w(HI#2hYrnuxdBBfI(oQSGH=-t=-sEf<{!;`JwwF_38CxAGM?i(3)e5?`$AKE5v|Nu zY#LPT>ukdbvkWzCne2+mf-^uin*z!3dy}kyJUBnmn7*ZgSelD$dHb zo1PE)S}nB7DdpfnnaE4zrGjRi~f1%FJ zOZ;?|vE8}De9TQR>qqdHz;4mGTFTOVa3C?J?+gUoqJSeB`GTws_(DTkO8>a>$W5Z*n*DCM0P zzyO8|{Br;9mJH%ci4#_l#&hKBpos5ZUF~w!*Lcp$?FU(ST=oAXl8S`=3U%;LGmru%z zhy0psP5RUF2&Q;`2lf{RWR5K%GI4^0eA2?J&-M8U*k2;~2Z^kZF_bD_OAgn{Y$#cF z6K0VT@<~gWh2;*u@A?a?Jf&a|mea=d_?(m1n8eH)`9c<{&F+l4{t7?87v<#P>;cSc zqpV=^{brf?IGI=EO@eQcem-Q@EOwT+@$p9_^TUyzkuRwQ7*xjE9Y{VQRB{CKnkiRB zd+8#h`{f`yj@U|oWNp&B~Ucc(M0hH5kZ)(l{3juNMkQ{a2FL zB>yCNL-Lm7J;?`>k0hT+{v`PVxx>Hz0|Ka!y4{Eo;LaTr(=Nz7M%;Oe1om_1aWVA> zc-?vYZsyLz4c&Q|-knDo`-SM_?aS=`Z;dc9iL#f|$53%gZ)zgn;8;-li$PO-F8(aoxE6q{R(^~btisXeST znhkyR93&w7oFbt9aCdiWcSF}34@-5uU)gQy;(qaQZ^>yZnveG?`cdV66FTfxo4UHL zzaHXVr!9N9+gI;FaZf|{#$NG$MQ`mwVL8HoP;#%hQEA9#;W>r<#6~?d?)9{9Zat{n z(LDJ@{+M%-_m(1w=Rr=a6*wOh>pxY>dat-u*Dyn4t6VW1qpa*nQJXB)P80BOw_dql z-PqjHGdg0L^mB;?s1N(}r7fr3`(w z>4{~fA`Vw!*MTj4)`?Ns-7A?XA=+`UdkdwZ~30ftz+Qw5F+e;f7czBJU%R-=~ydO%>dQNa+% zhGF4Rg9_W+Xo2y8V-?H517k3WQt%|?iHCd5h0Wq_c}He;EBg|vvTO?(0?a4}^iQ5u zn)&Ei+cTd$t3LC^vx1oNtY@)N&w3U6&a>Xe#y#tEY{j$f*e%ZC$moRZh@oNe!g=hVGlJSXs8iS9!( zL|}-(5P=~ALj;Bh3=tS2FhpR8zz~5U0z(9b2n-PzA}~Z?h`/mdl106.exe.2 b//mdl106.exe.2 new file mode 100644 index 0000000000000000000000000000000000000000..925e0f7d24fe38e197c112a4edb7f880a50ab317 GIT binary patch literal 207353 zcmeEvi(eDTvu{rl=`U0q#WUHzOHl`5#pMup4q5VR6fX{92>MR-$TaDara!b$s3 zw83Md)EDKD4wqhiqEZJ2z6>ulaH)Yy4P0vAQUjM7xYWR<2L6X=AT;p9f)&GLBO~KgiGN65ok-PsuR?pE(rU^nEvhb#~C$L z{N_hQSkn^xnDT!TwzpG9R}oa%3F==I-hH)NEV}Pji)Z&-r6z7W&|&Wr5I+e4N~aOH ztldUpyApegJA|E4DR`? zbj2}@`WoA`(}f^ZB*czD0{jNoo#K`28|^)Xt)I&qJEDt+p3}RfbT>+*;vN&s;s56K zVzE(b=H&`v!-+>PCZ6}rzFdBS-@$=Z)rjVzs>dv@1X;|#`V9sCr39HY(!@hHy{xC%n;-v5$7gy!QoBEpEr3jg;G>HEpM7uAh zL!G7t076UgaoqxeOQ^#_xG5_y+iF_1w3~Lc_Y(Md??e|>qEJ3Cq9&4a{{Qs#;#QbP+bsv)rY*;bO25GP^R-|3$^e0P;TwI zrR#J9C}!zmk1f>MVxd^tLhaDAl*sG6;zRkhHXq8Zbq2T_mM(TDfFeGWi9HB#uPxMR z%a&ie>El+{Zrc={Hf?@wAV`5~GO~17t$7_*&zX)LKQ_NM63`WVXmxEgfNXiaj&GK( z{nSDoc^}HHjr&l3ZOVr-9kwoWYtMq%xgf<-0Im9v*YPfZvO(-yADVAJ3~-(g<=1`> zaDN2QS`cgNBfnOv-=l!;%tGr{f0>RIA2+vdHNLvu5a5~v=pRAap8{Ocho;wid?>YU z>tlNTo{#f778Dj?L!p>ne-uE_vyV#!5bSC|Ii!Pj2UM8QQ=iM~y4CaQ`ttw>&Qj-d z>#qWw)n9J?y^qVU2lcjYYc;pN>Br{Q_XEgU&gw?U;x@Do&27{MkZonT4cjVm8y$XZ zY9sDL_cywIXnLdHhw>YDeJHo_(1*O(mjDNCNQrVAlRh-JF&p6KeJH=N96*@>vL(-N z1opD=DTuXs2_Q3f6{J3%0%G3fn%He8Jj~*D(>~VfB~W4Ewmb z&8QEpZr1xy|7Md9r8a{eVl(06rZ;Z}v9{#7&0!yx+kD_dUfgoYZ9egFKW$oBrZ;Vy z$+UL`X>G};H&Jra-ZpbK7lixfD zaJFsbH?1GabXZAqTUJB4Eo)c#Evuo`t)OgMt$uFv9k%529oC~~I&3SO-m*57+Ojq@ z-(kH}rak6!>EE)rxh-o=t6SEZrnjs$&25eQDZH4i4=-jpdogQQ(_1qvFWbTva09B6 zknIC*Zdr}bZDoCat6R3M&TU!Wp4$5A$Ifj9UTVwgG`D3n>BVe{{I+eO`Rz(SZGJmw zjoY@pt!~>kxVmj^ZEoB3Q{=XP_93ss`mo%#)lh!BFW_u-mD|1-;C=}p_;G22`Rz#` z@?viT+_M0(dhuef0$kwNwqFOhcLDSdQ`1>8( zR&zU6LvuS;L-`%sPv>{6<>Yp(UUEBDFVj0#FRMH2ejal>+dj0qgVtzzmz^^U?N$U( zbpTmy<;)`^1HUD^J2C{`Q3*>tSxzd*OolLYkRu< z?#qDA>MysO@o}kLcqvnk-A@7ZM*wa3P=43;YWZE;tL1iW$@6;=n_|!UoYlR0AD7x| z@}cQHYX_-4Tk_PN^`fhL)+^8L*;X;VXFbT=-s6DFQy-e!v!zV!*;2Ob+4`N^vwpXK z&z5a&&wAV3p7jUwEg_#@ZqL?gelIB7zV)a1ecR*Y_UmkleOtENeyf#lzte|O`^f;Z zwVK->4AR;bpWCVef&?!fBm{=xeo*7}3o!J3boJFqsidaxhhte>1dw0?5#Q2VjdhgPc9Lo5B8 zj;{Go|540`=8kUo(Daej#`IBtKxb<|b@V8}SshFtJ@avy*l_>_)_FAVp{Gjm2~dNYRHT22K;QB$;7OG$shgU$4(!u`;gaSYdU{qHJLxM{&e-o>MDO6 z_?%rIz`D5FT^2c{Lf>Ibk9b3akvsm)r^_ANmXbTp`?$GdtBuv;tpIlrq&T(Ei7jvLBq;BR zwTS#lP~H<;-nkQ7-u#IzZ|=mFH+RzKbIzZjlyH?O`H3y1*V0TJXU8YD^>{6f0i7Lv zc`da89qh{J@8pTkdHN(xTn)KQ`nc7T*#LU!L%EYBAIhHu?d{}UK=(1Av-aY(SRG8C z*p`<+v9^{w3EI|4(aL-p@wucZ$dexl`M=@~3et!Kv+ubEmyQ zTH9NtPVWaetAqa2r$Jh4C99`Fi#oMdGJX0cNNcU+{^@5*Uk&}8T7NoyYW->M)cVu> z>50wb%=**SGus;TXSP-3&ul4kXF(~?Y$;{I{>=J=+}U=JHfR-Rw!HbGEpM)9eQds1 z<)_FO(LRi27lZauyha@7oW(YuZn|i7uv!dy*y2q;_I^=31KURteTvTy+VCONxewXa zlWBLY%*BUkS&dz|kImCiYPq^t%&gB7sv!isPc7GCw|N~JN-Z}Pi{3iyAhkSFEY7T> z1*DemlI{bcdxT&SspUt6psUpK1R>Z)Y8hMD-g<%10&&nB=sKY%q=P0? zD^tXE5Sk_g9i&!H2qg)fk`6lcp&mf5G;z>w>Q$6-pW>J?Qb);2|f0q%m(~R>eW-?CI~Gu#WbN$gwWnnt3R=9@HDAaw^$tASR{n#kwgQrQYiVnUK>c(3A1}rhPdW#Tsy4piJSYm4RHq)|JS9^ggP=Bj;K*x2d)anW( zC^Qm!MTlBk%|OyZO8`-8tM7@U)>c0dqSjWw5JGEAt^UEZ@Hwf~Z-j0U+GH%Xwz@?e zwYIuPXqXUcHNzFE)anr-YHbxq4Kf9Iq*Mm`0UpVR|x$|2)ddn zpf5{hlEf_$f)3^j)LMpiP@tV=p!-aL`pdBPxqg+(%rXy*np2tQguW1h4!i=!&#BC7 za;8o*zY#~BW<&>jgnlO%^!BMto)Fr3Dsu?BO+|<{#MQ0TYt(9bvyu=c-K53|d7HG; z*QiTx6TU9>8g=AtqQ$3P(}p%%3Bj`Gx%QQMJx$zCgwRqvu7agrza!_LeQ17@cKSNU z*gis^3Bli|UPC@_lXm+0fDkpFjX>s2YCKyPJu*8CO+T;|b)MAo_S z{gYd(YNy=iDqN3Xrru3pG_sJ;>Q)b+lzW}ABN^aEaB!#}x6{ZYTm-9$PIp4hG~`0q zZtLf%B1EK{7RDPD4?@;X^E71oNeHdT4Mic^IBr#1H+sGIw5smK2_nap*vV+k5LJjr$Bx4o8Z^i7r?blZE?VQpjg0(ZUo0 z=n86jIiNb-5EzIZ#FG%s?FRMy1eEP+1UZ~PcKWA~Z)T<&xGCWJ0I0qYrAnx(yC{A% z5(E{5D%6C2w*#Gq!_-g{a1~b&K%GWcNb5qoHK1Ggohd4VKoimdgHXVrifMfYl`X6a zRr|~xr@{hA_|bA4))A`_28Z59p^~$MrqHTURk>*uu5%TOpKe6pG6kS^)RuDYbm{CY zY)DNa%i3Qha1-zWR)TOHA&vS~6|A1;ymd(TJYy})>1(EiiJq4S)Rj1-3c2G0>YAI- ztE&RpvQ>5v5~g8WgvcR{pUvgf2TK=?5)vKYpe|L{scQNeymAw$x6HT-ORK10ovZ#t zOVLB|RmHSasK~-XvsP8V+g~hZ(`b26PIL!B*d0ZM=8eo4(_BUCu6;pCuTrNWHUnhN z3cVk#nYL1ecL`M!_e@RcUz(nTV7n#Uc{)iuBXsx1L5H?b^=Cgk4O=5L1aTD`&I^q2 zl{5H7sn{S4u9b90{e+S%Q6CBzdi+6E?OFB}HwYO6u}V}C6e~6pPr&3e4AQ7%)dMID z2DL9~qHmb5p`#sCEr2A#h|G_Y{T1=+e}_2x7sOQxP7pN{f=iDoT$4y3gE8D>Wn#-Pdck8bR+F z=!QR_Qdkwubi-L_H{<~g2J~Eu;=>|<-q3Gkp1C3^l#N5ux(h)F##()c-Z8w8R9C!y zsqP8TjU_aC1Gvar*+@gNI4}V-Lq^p-nHk)=Js`x1=1o80out#I^@B-r&qEqmDh>%+ez3`Uq&_ocb9nVr>-4o!_mz+l_ zCvwGOmrtO(fKJlsR^>>c#W%6a-mzbJez#jy&-6ZVk&G(o`J$?)L>u%p)i`2)rPZCt zD0O#2RTtd|+}E3GFn#|Fl2Svj&dY*sELS{2!@2T?4khMR=8C6oG*>)hSNYDRkc+G+ zscF+&C2%{Igbqd~R8>y~9-S^1)$>8s=A?SE%r{q!AmKr~l++OuU@47MBWYFrE{jT# z&PMgmfbI?S?l9u_K@V-(NgICEzh|o<2Bj)ySv4ciRP`TkqNql<`)0A&|BPv)NIUQa z$%Mhk47k96RfvW5gqUu`5n}d|PCs<-ys1XA1$2<;NCA=f&s+!@F;-=zpFv?xs2608 zI?AwSvV1MT$dsxs40It&CM&o}2uWydp$lCqE5+%3f@A`@7*NBWiDO%ED-Y1(JK1$i zuxwKC)VRmFBCl*}Xs;mqqFkpF_f%J|GaYd>* zH<|%cR-Q2n=J6?n!PqAZhl+z~)CDrC`A3{aJq~w>0K{)X2r#;-x$cH2)i@cHAkcKaRnQvT_M0& zh02jOLoels)fp2dNnmyP_zYBrH)FsJZ}G=O9I0 zMWRcE{~#R(JKZKl)olm~dqFI;=DZUj!3aoPzcK)CAL6aki6D&fs4(nFg&7+rdAI_> zj0C)$VZ;ncW=I_6Gf5RU5JdQVPvkL!Ul2$#!$4RG(+C8@Py^A5dQMr@DJQ`7QfrG; ztQhNDDMbrX7`h9P;Q~ce`l?g456-EsuJU`;RYPei+zr_(s6)(Oe9e8QL*R9S#_lFV z=s6;scqJhp72eX9MELlNs(DW?4S@i^oEMBfC_yNY!2N3p5~1$SH&N7oHiV$XRdsQJ$1pU3ay+P1HOGU1ZY_Ew zNrI&16X~F|5dGL;V16LSb=N#CYHpt45iwl1RS~@+FKX93F*e@cKDZ#by6Zi40`TDS zqeTIWeO}ndMN|q4Cuo+q8n8U%DwTGk4O%&06b?OmJ|yufJa2ws1Tz+5*@~YIIv<#{ zs?|?%_U52At(*e6@aVMAeLUzKMD;N(CKwnjditWQe9%%8Z zR5lZP8UAl+V1|=?6>UUaUS5|PxYWR<1}-&lsewxkTx#G_1D6`O)WD?%{>wCw#_X=h zW4@djn#XX<^1ivcVyA}<5t(yhv9NQ{%waLzT)}D;E*JlV9F@i#n^0JJN?j#XLFgJG zY&2m$PN<%fO0IsXD~_iW*T&SfI?Qan@)xTDd3jxG;8FvZ8o1QJr3NlFaH)Yy4gBY7 zKz1CQ?#33Z{d*Yy?GCg}h2KV7Dwk(wm+s6j&OM!6T0)jH>I*YYw{ZKd1t-L08=RENQc86xsewxkTx#G_1OK%eh9Xrg^#-u;INEj(k@Qfw0I8Mr(3)g z;Bdyrq+RR^(ze;O3%>`r4of$;6Qp$m+*Uw`qc<@49u()iHHW%O? z2e=ObZZyFCZgD*&{e7{xrlElDwZ&a6&d|QFB#AaCP=)0r_m zqfy5GR@o6Ar!~4&d4OO`I3KF;B~b0JW`rW-wWq)|E&=Syzfd;+ zk~39(_RgFOL{Yo3hWuY}8L>mr_POO{ScYGUR+Kz6+K#9C=&#HiqR^H-t8rxxF}G;v z5bY~|CF4nFKW!u4S|llU3vFmKsP4IyWxu`yYr zJQbuy+jkAg!9W{MDmW81QjOf8PR zm?VR%WPlf;dYn+sx3T)beiGSOV~ACm*n`G4I5NaOpIus>JlD?g4h~^(Fy96~Aeo~e z0RtRJ2fBDrX!{_sOOp^Hh;1^lhmCEYBz9tQYWC$hFBQW}S;^pVpzX6Ic`^1Bpye`( zx1t%6`L-`-_hwouk;k-+9f;v=l)|9U_Ei{QHJ~ikcVtJ6ZQmpo#h)Cbo-BjW7+!Jd zL4u=!wsj$yel>;%^vp`aKnw#GiJfmNNbK`-vA6u#Lfh8a{l=C`M6N*hUqA}o_nO$_ z#Y#@9>;&SH)|iD4?Z)kl$1_NuKhkk@7LfQw_(sP#5Sucwr;Y6q$%7Uq zY2iTzVzYkiKs$)VIwjWE-*Z29zCC(2?6p)btjsN!v^(d=7TT+ebEAyllE+&y*~Ua()NI+6q_-z#X>uVTSz;$JjY5AtqsK9_-W_c8-31b zSwW?|^J5F`XnsgL^?Ys&3pn4f>4@^a_c=GVb3q8Pvyzs!iP%qm>_Gc1VwCru<^_TU>d%ys|hs5fJnB8y)p5Q5_*H44M}fbu<#-7CR zeXMnK0jp*b^9gJCD?r!D0G;M&2UZ8oo1i*c89PiIp1(G4jOu73bdR`pv;7T-&t%Ix z#5y_%%`>)>5Ds&XcKk$$Z|&%C3E}zc(GEP)!*|$~Ur^3V^h3UU105Xtb^Oc}zZ2pU z>aiDu@Z6Glw_gX|HelZO*MTSP&07OI`XCkFBv^j6RQ@_SIe!P1y)s{Jb?FW~p+4F% zOojEACx9_LoqO>DJtMGz!iGpZO7UPO@>N1l3E|BLqaD-GO9zG|Wf#nwcYfM| z4!rYWv||Qz@_x+@zJUO}8gS1DH4>Vm81kG+zz20S{q)Y%^D%hsKny&BKiV$yq|z?1}?wY^5z!DrdgRJ z?nIx`Ax8L>O!Fn$Vh1|^r*jjNLdRKe2VOEV+QEf$45I+S|M6AD!F3ixiq*MAJU$Q3 z98h(vlWv=IWv;Kd(JkV#|M;fePj!6d(=XJ18E?tuOQi%?4?HKLE!)_jwQGN;CiqN5l80e(y>!j<$JD|%i zSPq7xuiz=?Ua~~jAY>;uK|1j=7Z0zKF297S(NHs)aucKzF4BwPH4dYl@PFo|)Sd8u z9u`u7ga7m7<<*_=e|+6_`6c{biI5m84|Fy$1zcZ7UXa}>t}jg-oLdGj(k{O+yd0Mi z0+1A(1B_0#lur1+jJ$ullOC=Uby;?yBOQCbBtxqxv&1_yMmuki&Ml*2<)J=|?F!uu z(!o1s|L5V}o>O}w+840=oH&vpwkeON?w zprNru7zTij#C+pNET=-L;uAt>6$eV=!Pu~C9&wKhsK$PDf`{$|K7Qrmww4ecOXb@E z1ee6oCc(v%cy=a}#B2eNgE0>T{KQh1$RbY(v63FivqAD$P!J0>SWwv4d&X;jQ*pW3~#vx?BjAI}ybdO4`d>Q9FU2csF z8d&s13cQDIR5^ACYakA53Hjg1A!NRh1IYhIj!Y!Df*~m|9!GABHDBq$>&DDzJwynD ze9#Gw1AoEEWIzd*D?ZLI2k1(W{{Da?0xLV!32Gim+r@bJ7D=5N3e!i*14 zHK7AQW%a?g8k#TiV5;SRk%x;;n4p5L%F0KrnQ!wL=rLn4B{St4s~?KfL-V~J=$R`7z#&C$ zjq6P%J75a`%ROQ_9%IGoIKem8$tk>n)(C-fsb=zPoQ6}oJ`QR9@}lJCyFMXIMtvNi zwWAqnN7ZS31CE#7-Hc;bM#ZawTh?WqliN5Znf3}lPsgLrxrN{oWmjF|Y%X!UD$&Eo z3d%1KW7*lYYb|k@a;kurUGf7Y1eYhggfBJl|DXnpWmh%E zz5lktC)OZZqHN9bdr1?6-{XFSN$>?e|2tPgmWzMDA;IIxf8$EvjEzcQL0=`(2!3=W zzWfOL_i%}ie~<2x>fg~oG~|K2I+_?j@4}9mpJ8)cLI-iYyjpM=JVoxzOZ}oha%7M= zpSWx3@X1p{SNg0QQ*<@@HW{RNSVrgP5u}wAULvh{1u0U&u{<29LcVy(U}DlrT6h$> zIUw|9DJIHN_;L8*E902`hX1}Qj@vvhtQL0YEh9T1mRRt~H-yHbw8 zno1w~V~RV<_i#ZTn;4gDp5G?wI8*=P(wkU#)_AeG(maTu&xXHCpm$q+oZiOvO6k%? zoch!2vSJ-zJI)WDh}Ub_h0;4%_SYNV`)s{_=qJ`YTma{#_Zi@|;ukNyPtPAaKajgf zbnaen!_@T}wxaY}_*~5S8@-OBf9C4AgWrxcQfy(DOm#Ad{e&R6^p4%A(mPnD*L!1R ze{LU9pY8&;f$bW7f@Y$(Frw9G=eBzEnsv>(5U6-}KFH;t0@%p7cot31PH)wmi#Yy-TO1TIm)^ip0e$+YoJ3%aSMe)- z3{%mYe|#5PLg+no$9n60*|0l|WOk!Uub+=CB^D?~)A^g1-iiJbO1&O*;2p9V4qCm3 zR-(@e2)5Z~wym}6ZM$`(w;uXT^-kPEr?)J0M&mkv>Fsf_+W)I@1c`NlSsqvm(|gZ- z7J3t|S#RR>lRlI!^>eKC-d9U^z^cU=mhvkGpCp%FhopL6NNCRmY$jg3aMtSLrPtCx z#cbIwMC((`luDPz_YwZqg=1wGFTIWfIePyAf`bhk*&%1$?4A7Tv$FZ%xftH)t%2`w zg3ucuejITDt50d|y!6Ir1Sj+Y9jk)*SAq8Dw%^lr*yf@S>1lZBHM>Wu_pL+LyL%=Q zu9U}ouD9n&qeQc?fgqweKxa?^#zMH2M(k;V&N)?V!z}ubyiUsy^Y8|&;pB4J@K(CJ=#X-qcSt0d4ZDaRlIq^j} z7WkYkWT_A5eFD7!mvQlG|K6Kve5%4+`m6yAj#K4{^oDg+<=Atu-iGJbhg&{UAAH}~ z^?|LAQc8VzfMocl4I1n|&>glN35h;!E0Kbv5L6@4x_}-+pXSO*1lDWtm7iEz7V4Nk8ult&1xPk_^#-{DcL*X2lk7Fc_L)*CD|FTEAi z;P&qZg}&@uE%;dbqt|UU>TOhy-iIcCbm^TR$aaA+2G^nwuUx=>cdPfI7rkR8{Vx7{ zgxo?+dfhq&y><_=I8XDpFTGjo)9O7qRed;! z0AJ}bmtJQVy}6BG%^Hl}CfyPIf!<_p|NO$~C$w|hruByP2P$S8j>gwxE?#=wc3Bdm z*R0Dmw+HB5^xh6`Iy7amMJTb+r*P&Muh*13C92C?bVkyJcgKT|k}iaQfs2y^Bv({-gKdEi}GkWG=n^ z=3MNW%~!B`D~(^A?fyHLK4nK*@cx3fvkwt5+qU#BimK24^ojK$#L#Ew9l-ASCWNC` z{)I!@=F;nATDtHAz<O( zwblUp7l1zcex@X(dKax$AMJgYPM;Ci0t1mtALM+f^rH(SNPC#J7;FyV!86ppUK_Hw zfBuVy6U?RerY&@YfsH=2ZoMph$5GkMk3l@@2Nj>M(DRh~?4?C?upM;-PC7PcBif4= z3V!tgEJrTAcCH!d1J=Se1~w-4^fhh^Rswzaiy!gNfAk3kKzfb6#_l-_yO2yD+qPwL z+c-z8H|Xz=Zk|gNJH;&y@q#_Z8~U{2Tx@WokM9OB0DS^0)*IHS%cB^(`@J>keT>88 z()-UWbad=P7k_ZB89tkSd;=|B7mz}4AkYIm6=QoVU3l~e)x4ZHTs;x55|p#jrq!iAgX+~L1S zbQyiAflCeikJNzp3+a+%yyH>{-3$g8&}XYOgBb?%3^EKn245Hy7#!fAV@BnWpF@5Q z`8h5F@^i?~AwMV0fczZtbI8x}7?2;o>!BR-3*ldd$WLCT8X~`t%YgjwI6ngN3#A#5 zUx@tVGau5igvc*Mej)Oc@k5yW!i@~bFYGcPzcBfQ$uFE{Kz?EJ3uhR349G7`eqr*9 z;9s^bmFzM`$S>kDAU`}%fq?uXX$IsMA-@RuMLY)N7a_k0`N;^nB1)(c0ge{^AHPJW zl8Y!-AgP55kSIcMq8F1Qkne|SS*#0m7K2~vz+3?&^(Hv62ooFRQPM^!R!qgDNE`CY z@IOrhGr}oavP3+KkMB=1aM?8RloEY}G^$djh(+ryKi>+=E*4=7#o`wR9)o#&sV%M4 zDjrAb#uvYI@^Kc-28kPbL$>!AOK9-!xOS=-JAen1;a9O>0NJO@d!MfdY^pKJf)QrlpWh z#lkpbA*9J=2;Um@#bpFU)6Q0qY|F*+Psjzku*gCvVloHh#1m0SiWGbCF30u1Ta`eb z{>Q7dQ-_Z^fh1s1N-Lk8Vn+5$SK2XOCp8&?OV|(ta`+L=Mfn=n6NOq3D2u7*fP7dA zUt2Rptzl93gO5!$y9w0!8$>!eXuKlf0UAs~X3`zYSN!-PG<-u30=h}GU#N3d%7Kq{ z;dUSm)1a=pT3j8%t&8tbg|u@+zE;JE+xV6pz8=Un-ICNHhuTuU*?mzhwo2OqbWC1}-&lsewxk zTx#G_1D6`O)WH7?4PdYxiM-*lcuc>--dhh7{9FigzfbrKQZa!6^U-b0^40w$X72*I z7@6}GA`u11+3Cma7(ZwI`_KpFd?xfc2b@e9@wswL1&4s!<5=F6j4&~A@?V4bwcYhD8Ktihd$naC<5t7>uV3+&F*W1^z+MK zlymRl7n#{aT4iFA<<*fRFaQiyM_65`IXB6xsewxk{Lj@ua%4t14A9?vQIX^bdJ=fY(9wm3p839~bBmK$k;3B9 zM6k4@!!5}Xbb%L%@e)dRX@2bKr2BlXd~r&tw2G`_Z7%eg!Np`;Kth5g{`$*V$q|em z)J&sNNd^#2Z^Mu4s|YGSAgKJ6!As(9Gl(;|!C-|!4}(<(83ycF^lJuL25%U=a?#Vh z<6>cs(AyC*c5ZbYcWRdjp{UC>%TPO&)d6y9$Z zADTh$KLlJB4BifOp-TdTia+|hka(>tqAI^3Q0!|nF4Iafe^h{1rNz6T9A@6wcO4ns zy{9YZ-Kkvh)LmwjuaZjzl}l1 zg%n5r)&f|)_Uz#49`dNf6080!!>IdN#6D=&mDPO@5z~jFR#F>7pSpBWA=EuR_oj@SB z%t+X`Gb72;WaP$>hX|g9Xc)ahO-NBu?4u?ARbhnHD^~`UEQc>7%<;T@k3~L;E5#q? zZ77ibffV7q;P>1>@F3Z!2uZ1S*#?3Yrq3|<>}>UK4nlJ}e!(h>P6hUjnL zK0XuiGdH=!q-Nb7xQxuR)#3@;W#b6i#{#ROiB%Emy~m=Oz~CZDHKkWG!qkOf7HK{M z*ieXcQOGf?zsj+|634_d^nm?47me|qWX`gE{L2Vvx4n)e>l6bLKnEO7tGh$Ga;5j) z3~>nhuEIdD$yK?eKIrKhO7O8%eBP!hP-X#R{z`Y8?^%4sz|1w^EyS0wAy)J%WEn>u zt(gQY!W}>7T4X9y@-J+S?{9M>%`Yz?zr295pHUwf_8RVW=GMtKJu=Ioc|a)J3+-M7 zNwyMdmkE*eQkADv>}T46w83wzH))rJQfsspTZuF4V1IXvd1O&aVRhTVtr#JSuOs5& z?9{Dt-KC9}T#)!2(y6|O5Lft(q;=(SP>sjgdhi?SLsO$VPy6cOmOk~tBe^(@sOWgY z*vPFsElFU~QVchWV4)jy;{U`;l`7OYsFGWH#kP+?xqK@-bK7P)*z$BkDH*Nv#sa;H zF^ixz28PbYt{cRINIM$(Y^2w9B_H92*kMF+#Uh=|H|DnGcq($UuNm%!5XFw%dfQ|C z%h8m#alT>RN)RE`$l$FS*F9HgS8o}JSB?-0 z2Z8KMn$1b#WW&--s(H%uE#~Jc`Zk2L+;#h%!6V@;?e~JDC}3(t>Zm_^02Nbm&I6%r zSWY^PKqAa+_KDWtdKplYy@b{zaFO7x^fQEV%uS6!B}FOLum?R4BW8@rhWlOE+5&D( zH@4v7+>x7>DL1_UNY**Ef1Ab8gtK@eGBz)klVOQW9_Vj97w>H<$}O4x5@%;PJ_VA# zC<570B;>vAQvMO|k!M;z8+fMFPfRi0dmowfu{P<*GJT|b>}mZdkN}U&qodDaHQ=oG zRU;Gui}?EZlh#iSNgNR_ge-Et|BW5J8u$w1Ap6;GJ&>~ZUbo8dHq{S%i3rZE>3`Fg z!$I9pe>G}#sTv}D>Ir*dwjm*QuR}R*YX)liES3m4O11E#*d8vLcpk=K2?R=R?E=KY zJ&N`=-US7c{crKEiirTKwNNNxp^A)!B0dgFAbLaW$_10RE?-53)s!=Ur zgas-XS*QpDhe3z|F20hc2C=9ErJ6lTKLx4SvFy-joPp0E5-Yjw{8X_bGIPweb1w<0 zF32*AE#ztJF0ZW2ajY#p4mR(r3-H;_PzDQS@9eg_KFN9*&9Kp#-RrkWU42XJl+f*S zM_Q^23*#Vmd1wMhP^x#BjAva8)IjJUo^UaA22*E&8D%2~N=F5LbZCWKT3jY8i6KqM zSOi^$DFW<|0~Y7mq6elDn?>Y1IPNIBS-o!?SoDg^pwG`-AfK%b_G%yVC+X zhdmC5$5SvT1N3s<5#5uyWAIc6jM(uYYX^k8r`aq{IT2{Q z#Ry4S7Ij4qJ~2y3itKv6>gXct?So__#6e&TDV_*rF_2U0ge1elil!7sbb+$?R`>m&?~yxL$!0F zBgCE520NDMpG@H&s_E3#eay0S8VFN!M2mGIbDVD)$3Y;Dkfj1z??RxHw@Fp|ghCDx zN}cm&HI>v_jmSr1t)+8Qtlt5#5||MhYY}hG$5n$DAr@=!l083YVr1DBcUebirB3gI z0aaI3F*=Tbg<(Z~z`I{`m1b@gtjj^*s^SRXWc+zbq^~qOR1X0ofS#%AFH zl1RS|;4<#fSb-am0Ldou#F+@(zT3g1wdNYN%XvjrJLv``5T=p`gmi9O_GL_mNGHKC zAqhqZji_gqGpD6BrdgpJHHcO4CAw-bkltklh)P`6;3P5%c^Eb(zL;ceA8d4*&Zrs# zG_{6-O%*&1?)$m7BMr7M3GMguC}A>*6c{GgTRH0YIVtG_^tJ!DEP_t^{zr zrAwRW44Rb;KApZUa29jq_6jNw9As35R$JA#fV52uN#%HtBXD@;6L#+G%h_dxEASxn zYoUK&+bLX}U?4pmeIRt8)ZUT@Vpw9;W2R8-YsJey$a3RGPN*#qhf`)ac*oOsJ&DG! zcrMlRL08?U%tl<%)%ytyQu`tp*NML}MP<9hxDyR?N>@#15-3cTt&H7tga+60{*xM0 z2pZuST@@97z=+nK&$?=yc^FT_<80I1m>VC&*Cg3ZR6VBwk7w|D&PI^{?!kwoM1dll zu>?euLv~VwK|^eDCs0&0_C^M2VY&HJ^mq@q!TXhYO~1{H~(<>;i;B~`pGDwdL4 z?KVoWzGWjQYUxm+^bkTKoP+KuD!0bgKIy8@qF5K1u`{eH2ozK;cT2@+sy-R{C{>_# zoH<4`^NP*A&j&{DlJf_q_!vm=5fRnxjF7R)U5Q|B zB8KUsAY^r|3zX@sWgH>wnPp)i>9{y=i<~mn#$~Nk&Yz;sYgJK-YkDCr)?AE`>MqMy zG9qUYSBh%X$+Tkkce`};RnE7hW1+Q6eN$k%4MpL);&~Trv&9wT3adNZj1{ed!H%!xf~F

Fk2Mh`MlC>e+yE>!^A>5Hm1HF*aqLp5;_llnLK)x=O@TeF#P51hETb@J!zp%GqSx)NMlkplj)%7K zi%2Ef^^1xKb4J**ZyD&pd4UI*Lp(4hic*T3^K~la?bLO@(oSnRBpG7uPt&Z1<4Fwe z-0?;=-1A9Srx`Iek$@~Rpz2Skkh=RpSC5PI?Bin`8O7-8hfy}?n5P8P<1e~;l3yih z5FA$XLS`+f4|Cn&?&t8G@g7VWeLLv(hZRHPTJ&7~vJ~N$5+u_c|H*KWN^HU4uKJm9 z!NffTuIR0(p=V~$hRhv`#&2{vkB#Z!Fh#wKCxWglOmPT{1;k;|kPLQYeDzJ%@6lhf ziP!y#iCs-cIt>jO6-#-k=O2{!w^Df_M*A?RB6nF)!wiP7Dp~#K@Q_w`SBp*!u!rsB zL_%sc@8bNi8gP;CfTvU~N$$9a9S-O?%&Y!-FAXOM(Ww^pPS~=@HjibxPrez;VcDH^+CugEdgg+u#n$1p5l`})G z7wE>8@!`W6Y>Q3IF3Pd&*Y3pJJ;Z4SE{}px&mT zJ`eBC{w^aqhCRPH$-~%_8SKXKB=`CA-!m%wU9!^gZ!~udPmuf~6WMJ;+sCwb0#;r6 z81IWoZpTs8Z(b#Ty(()I+$OnLB7W%W4l=sA>{9vX$_47$QJj>)a_YyID`1}nMqz7$ zS5)Otjn!|s2dVlxb;AjlsCfpcq1hcT7Ed|yU6X(VLoO-T&mxG{y6Cn~@#IF>yEhTV z*i`BIDVK+h+zDC4f)?4j!yb}xUR!gkJFSbSk3Z;|n`16;T%bF<{|rnSJK_SuGOoV> zCK>g)_`Vq%Sbe>VH=p~ls2Db@`W8thV;YVbPUVnOwh|I#rr^1-Fw=0dK!|h+q;Q^< zWEQ4bNP0?Wfh1W#wJxF8CN~a>WGcuhZBfPy@Ea~#ZLxUr7T!^P>A6`f%9Mx6#>AnN zCcJQ8HBZ>}h8X)a!;!G;JPMsexYVB+bl~;pr+s_~L^hT_VJuL<5Haj|GvGi5FBeEC z%Zsi9rZ{X=ER3WPG2}rd52CteuD@G>0d#emnZb@z<{20;?TX8^gr0L4AIelA2skfa zV0w`s79>wIV@yV-4{>{h5kSLu-M3Tssjt(<0Ho~IjP z)B)F}8cx}7;iFW#QHBP@H9A}a^-X{l!8*DQR`rjhy5%t=Ge75C14>jy@~gS+A_TGX zj44hSac0;D{IWD#F*A~g4P^||YOumYtl@-qe_~BfST#i5P{uq@au!tgR%ryE>DDz{ z(mBY+gH-4}PMKMl%1=EyO{v~J;B9r!xUP-7i6WMBjZi=AKExwmW*rF?T5BMo%h8@O zqOA?xN7=-bVI?rVzL}ro8KRnl1h`tnHId1(Dca4E5LP=cO?o;Y&48tgG zhEZ&_)7AuPZ?R97@uW(?)`piLmDwgAf?*D`2;KCF!!C^hy07h$9#*u`KLODO*y2go z3;Ak)A@o2R30s+QEwb9^g0bvC54kw9iBSqhbNw7X$k09z=x#UYBH1)a(9R>%T!v(p zbV0QymfI%NZW;l2sc~t){Vr$63>aZ>B8H?Dk~~T-GiE+y*7%P^k3!~9&bSOO0|_SY zPUzZ6>ZM#INIM>=BuW8HY=VfBI0?y!tShfrQN zzgmxF!iI*h?DSed-pT+BGo9p5NCnL{ua8xS;S3$15@mX zg}wXahurGQrd2#M>%iyK788I}I*mY*885&SIBcuZI9plq&Ku-mCLwH%<^kBzZe4pA z(3uu$Y?2zvMw!QRU8gb_d3luJx@5$XpJZkRM2U6Rt#azZExo$2ec%}iNaA+47gFUS z2tGlA1{eI)r*8DC{ZX)&=N5-&0FgK*8Zxz?K))X>pS1QwQTu%}w3j6OZfT?tRb7(|2lb~B{Bq9(TzTzK9GX<@*Elj@cN$|PP4Z0zy z*Nq@R!};(a`-=o zb_u6|2!WW9L;DNms==O>99l?%CXSj(Qh#(Fl^=P`;3Jnw%^EFB#D*=Wn(7|&?x=S&9g_Y|AMXvoZl68*wq;3ei1>N~;jli2*a-5QhiT zgWhEn6hyShP@EF%2xn1Ze=jsN$iP%B#0|4VJQh&5Bd#h=sWOz0F5F);?*(M#s}KJN z<(p1I=F(7&rw$yMWN>E&*v3+77o{LYLgv88TG@Q_a2T5tb#WD1B2^xbM`K0S_ODC6Q zKREOSWh1dOOs5KU*2jmseW-1b47k)z_g~*O;_CVyaU+-|G~O5dw=2VOVCKO0Xi)9?g} z1*hN)$&6GQtg$NyUM$s{IO#4rmp<--x*^z)%xg_QLtKLAMwU?MP=>=*@h>GKBepfDY$N9gf8y6 z_P{=`esPY_eW2hS0WlBlM*13r|dcEe(}n5NZdxS`e9l15q@>x!#D z@}{!CctU|3-u6jFWr<_Sx1{piB#O0=488Z>c7vgtfceB-2W{2uFCNDOd*(0{S?ES| zd|X`xG$8!my1H@jo(E!qj4?bxy$So0;70nSLLN~pZi*sU=uIleOt~dXs%a=t)3ChV zM3@rSKxMzWN739Vlp~$)$4X2ma`SB$(i_DRCr}`eS%h|@8qX?m&r7Dr-0~a3oUVSK zU1e(vWHIAnMpTq=>{D7>Cdd?~S6a#Ua|`+Q*UX0PP!=)AX4>D0=`RyM$?DNWXF84k zGL9pmRc<;5=_fLfg(+*c~=*XS<@ejT;D3RAP0mH9rdPAX+_OJlEmOxY$w8DX&TP)1lRZZx>er9B8n&R4Ay z$1>HK8$#8Ng<2YJ4Ue}p+`jF!G~B`Hupx;ZorW9YMuNZ;750zIgKNg8ilDpq2yz~B zp`pXueu0;A5u{Pneg?lVSYVLrnbHk6B}=UHH*&_@&?UGx6k}jKw8fR83%K_jU-`HT zX=P`i#9(kdbjmjZHOQ%Po=j@!n&z;A(0!KoMCzO=(m~0;4WZ6F3sf{FgIpXQbtmZhXYvDOs+>OMV(3v*|jNIUPu!raeBcKgkQhZY%AW>t`_`$$LD8n8CvB+p_02@nEA6+8GC*&KIGwRvMPuzPy zK&!w!1;&8$Dv}Imo-&mSOomBU!)LLu5n7n5aJdQ(1PG2$)Fra$fr}r|PQ_Ra&fb=| z^dUi*ss0UC!bS41{4!Y7DSBxHJ!y#c#sfb;-+|&0`Z4P

dT@+UN4c8w;UKc9ugBboYs7m9gI zU3h?OhR>(`NT8>v8eg430p$D!8dK%Rdr64Z*NC754SQ&+JbvrQ@!L2DF}wu{f+UGK zdVRzBTLqr^R@3ZZ-^wZ&eU4c~h5L67(8D$^qXWkx2bhe@h<51H0R~xcHw!Yhm6i9Q zZr~tL<8$`YX1R#Bvvg2q(bMb^Kqup}b||^YSjr4jKvy=R70$xS?Z&?D&=)^TzF4gB zdC>8d4tAK)jgg*1aprqrta9;KBkZMd{DQ{WT*els*|xZMClC4=gHfU=|qOg~I-LI*d(k_%KutcilK6nCJvaxccR{8HX(2L!-iWk&vO28m&w}vv{=*n z%d}E9$q4(Q&6BJEhX)Ot2Bu&KV3jf_DcvL-qvR_jh`5sAS|5&VDpl_rziytA1Ak&+ zZY5&hPeE5C?#H?^PDM=NeUW2WRK(;0u^6s4PsMv8V|i{WPmr!h=rW|c15tjK$y7@k zrF=A{uiWvzYLAM&aubhQUFj0ybQ;7Wfn@G@Dv~a(%_T4>$5JfT(x_Njufq%%ICSOB z)6}8*%C!>ADz6N4mCiiQaKl4H7b6z96~%q*2A3-YvbUK23TR|pUzvJSjo7gseAikQ zKDee3>i>YCF9h~(6!q5Ejok1w+m#u&(Z$qe9w}Iau^!-NneUS<9sw$1UA}o{a0dPl zXDhBOGhl;Mp*Nv!tYYK#q0kW;6A4NtDitqvDX}tNCFe0oL6>GWf|fmGlqJ961nr)) z{I?!rCG!Df&N{!cID}`;q~5R>0|{t8^a589#61-pm)ey(gIE@I3hRVd zvTv%<-YC5qOHf1L;!s1XpZa6kXW8mj1FZrR8N1L@XqaM?Vu@vo!EPmtn&$lhTx>h? zZ(;mFi@MO5#Ilj%s(2b>=oI4%f)q~Fih;l;*$}yB$d-o^m0C|4)59|cr`X22`m>ar z$>bSD7#C)ca(Xt%m&aC{s%4Q^mUhRuw0r*)nmn#N?9`fbwQNYR(wKMIWw0*Z4 zS+bI6F0guo6&q(^oBo&9#U84iBU;C;h7o3-2?QLNUi}HdIMy;4F#(*^uQW-w z($8r2?i6aKWLGXt^jz}ff=Os~QXJAS1)+ zC%C1gvyumJO-)d1WCFc-s=qWokj0fD3>ThJ&v&uWg0_|Rz5JlGs8ZieD;Wh{scp&a zU$iZ-nivEtmz?FfV|t6L6It#p!XI4C4u63Y5Fdffh^y%Vj$BD{hMk7yX)$UV61oKR z3z+p@9T$)Ob_O*=x)~%(^;2Aj88zL9UKxQMBD7T=0QpzFBs|j9tn9B2CVX2fJzmUK zfu^RA8#OsYYscy!RP53=D8WN4)LvbBgPE%1axZ~6d58cBYe3HBOv zkyk&`g;x+dMR}X1zq2N>E2vKR1;iVqs}LMr?lboB!VgcbK@sHl%|%^`gFn0PqO+FX zIa>kcWVu>K!~7zuBXPkvtqJOnEnaQ|13tRXZbF00g|Snw2E*LbM;il z5mO&>#pCx7Nc49q&R5(pNw_3%^;o#D2GJHEixs1($w5<_Vld4Bs!`!$(8ZWB+&PnP zGNVm1ECWB@{vj=8qGWo&HF3zv4#R3vMs9A1x3omcQY~Ugt#V0lk!*lFAzi{IRHi`^R15;L-W38wdgi-_+@<11V)wTwFaFm>orV zq(gKd``8mms=7Vhlzitl6gRqDC|@>iL?wueJi90#-3ayU%jfUxkOk^-=%(kG)1{3$3M>2k%oXnj&sk!6-PDBjwdP+3P`6davbm!pcEIVwGfo; zw#?bh#9g-RrC2zt*7TbhYDB^6-1xrfH}8w~*v^}>-(+Y2(+hF;>&*0**4q8W{xj$S zSEQM}+H(nzHq}q)1-Zy{*pXd*_HR7o)bvdZq*S$bV%+qV=fcZ;C!5O)e^3OivAGyl zFtaNkn2bw~7z9GG5{uCTTnu98xNlYYvCK|6&i2Mb;=`J@P1B|H2I5;rn0Z)q%DSAh z6%WqB-bHQMF;epw*f-Y>v2PsqU1`&?q?M;!P}5;NuYnX}Jl@Yrsg&4$4&M6^oS6-% z8JZNuFfI8BluanawO5%Dylm;w%`fGQYZteoq~DSQiFl5*xrXzPt6eY#%yG~VyLkMh zPh3^PMQeOVel{@UCicG^q&8P&k%xmms=4hgW(hKMmcb4(M@Fs-ob)(DegT`WLgr9q zhB60=xV|VYMHp~ID6`YTjS!YB zP;XKgD&kHqgj;{?!xU__rP^QM7(|S}k1nkz2^GhaDs2Xp!iodAXZOabmo$7VnLg~j z2Rc9S2hlP(!6qi?Fdq!D2WyrG2O{FWSgeS9bwCE1i`4Y#`~LRp`Pd7$JWo@W_QEY^31zVt zZr9GoUbtN^i%r0Z@%FLE98V~fK7Z?;zipKAO386h9g1b~Nz%;vox1Iyx>+exQnkbt zZ!_qDS^O-IZ%Ah|=3>og*uz4?u!}yO3})qxHs4?am0}=*o9D=!I3+J*5iV))n~?KE zaB0_mf5VvwGg3Uwg2@>wrTc@vmLYVNP?r2SQoXjov{OiSJ;Jp6=m?yj*&9qqgvpmh z!0T47ErTVmhHEQEdJkgA9=+U3QNg9{w{hs;3Xg7xBHsKj+P=lFsT^qgoL(rRE_kCL z0%<9=+=?lgpb&HLQ|;UNA2b^9+9Q! z#P}FvsvhHf)Up{RiVh}v1WeTPImZlBd;W9JV z3=g=I`X}l9z$$2)%oifQSwv>Mdw}V)?;T^YalAXhSd_7L#v+Wh1+h3|n7i2oKZeX~ zD&8Tp7nAk-1KT!qx7A9qSKsF?biOM(0}vU}GlldF_81!|mX9zWnk601G1O_Q-1b73 zb)SCXAU0(XV;1XQ0L}yUt|{OB22!!y1o$NsTd0GJS?mN%TKe9xf$u?=*pFV2P;W&* zc1uJ!hDPih8Tj3JwX?hCtR{M`VIbdq#Gs2vcDfRCV2kd_R2u6P43yXtJl=Dqd$Y=t zO0Y3Y2;5I)Pw-9T(Jg&T?Wq(M1N-RiH}+x z?=kj*!Al0O80<56&0vVZo2LwUbK|gF2f+yWCeNrSs*<;9c;`+vuoOg}!=|H==)Qvm zYTrk$h3ICe`w5qG_SA?S@KJ)6djMR%cCR(Ai2(FanaDdMFHx1jLB4gm5*VM zMJB6sS>+ZVG1w7+?D#!PbT`ODD1j_Yuz^bGk}Xt&ZZLYn!ARjL{j)@pD^eU?F5!{b zb7<6xMDh+EVn0dKEYT>0?>-bUS8%_sR$#N_DN`j%YGu&CS78HLf|sef-{2hLkayB+ zMN*O{7s=c9+>gyi%VG1r0K~C`@BZ17AZ!d$pQa3A28)ZRfq8+enE0TI1a8bEYk-VH zWy4;mBd?IuikUp**3rYRa3+!`W|Kni9Zqe#$O zpcSw(9l**gBVcC3%&x(b+ch{pa`-M~>db-!2Rqxqxt>ERwzu6>+P2qjas5*H0Q`s= z4HJ@+W5q;rSiR4Y=MZr+W-^z7Frs6fO9Pw2vR50 zxUmjUxVFCJxVU4S=%e!^cZ2{cu={sUF;?1QF&=oF3R6|Dm7M3=m>th@WlDJ5usW-RnX7j-J?(SMCMxT6Y$YFghj{QWtz+H(VaK4W9o|j5I#b zV=0Nvejt&7>4t+VKqztMMjefT zq(+d2yyhxlylKE5;5i&>B-ondA6hg&jz^sNKVgw@Y_SB}`wO-^lDr6wfa5L1StIZ0 zpi?Tv$ZH%CgE6hd1Y{`~o&Y7}6f6S%C|@5uzlI%_UBIVU_ytQfD&hVI2&+9wcO9)@|mOJBpxA^BOJ+;SGwqgcRd$u<;+(K^R<(Qg3QWN z?MU?foEnX=R~;L;KVVEpO$P9`BXIv(T1xahN#$ba*AVM&Aa-?ae1Li#2;pt{fC()F zn-1b)9H+h_dv7P_v~w?4TZtOomx*5|8{=#v6{024_oYI9W?Y zj-HI&vwS>hH%znmAh3K3ODOoKRgIrQS_Ne{o8LW!u`f2e{-z?=i8-ZbNG^$08@Zjc z>4iHo(+B|kz?dE9*u?ixLn~sRASZin;Jnroo0_r1d3sy&86pi-1DSXf?-ck5JCC06 z;(m`zS#cgpI!V$@))PJDWE;pw*OQtiN;q`vDZ-t};UBO9aph{Rh>LMeFkkCH^5*&(KB~r#qk6g5O68co$*kf z0#w^`t^)rSuT{O1<(}K5v%8pcoSKHcR4~Ywo>h$B>!e28^KEDazXd(BrV?KN+I31a zA{|}bIQ^_kKCF5k@QUV%$t5uyHm7vwjEXfTdQj~sJgoR&EXa3u-Gj=Xb%#I+N}Naw zlGtbFJB~NL=qz6ohS);=OGU{5wO)H}idfHcpI>@D`8r|GOX?BS8LVC>Wvp4R%OrY# zmoRS;;YU@b9Vxw$@Wy*S5rdB=#<_l)Y=|6-s@rqARv@iB=+x;-l0~C%$g;8PZ_RzQs{mwC)Fub zTqC=0BCxAs3?zv?&?93HCApx-QhQ}ZoJd2hz=0H?v*TXgsp%!3>#^@c9SvL&3n;T# zAn5%*#yIWtcKf|gs|bu*g6E7qyJ9d59L_z!G;wjXjMzgyKHy`X`8JdfLsBXjN?>S2 zVTkKecJ^M8MP>huRm=5*e9Q zOtPJG-btZ01tuJ;a3*FQljXD*8xu>BRxWO$_vSoMAZ##Fgp0M4;XAF*xfb_g#E&}2 zGQ1%`g^&&c6}xv5+j3FPtBe`6gT@Nsl#dcHkfQC!Gz3a?3t8lNC0ecX2E{V3OaQVr z5x6vOdycu4JA58-&ajo#GI}4{X$�fO==8X_*M}1=PJcOW z&SPw%!a4}*0dRJ^D$fXt?V#>0FX2uVqZX459!U)r-^tZ>M_6bWuB8 zLl#ZtX!*s>3LNHq$HxQ3SnM6|&Yda%T}T?lNX`!&l4;v$o%Stz{7i@5eFy3fb^xy! z-Z%-t0|^YOX%2u!fe!Ej@7-5ye>&b!1D&-F7NC zYB)r3XmRo4)>466%D`Sy%HUQbbm~F)%2^&nK8Qm{+KtJsqA}zgoFZTR&O{2JGd{dV z#d@9V56tJI0J;sI-(O+RdNCFPWh+4(G_?vsaFATQ(88EF{g(!Hv4=ziNf1EO`hhb9 zxO0h5JC9eRL442r4E9-GZ5|_g2kTAfjEw zmDn*ZNe5z+5Y(0LJK)4U;|v~3U$epp-QD5Vw0=|ar?%-DB~eZpD@-Ii{5OcniRt*OdOh!K>0pF~U>DuQ^p z1Zz!p9(y$)-3d_KS+-*^APKF8;spvQ4>Bs+2CY7o83;0D#3fnQSY{AB(Ajn=qYw22yEvpW3F7;aB^m}bq=Wyr}iG=KspkzLd)iTMto>f}!Mv$F7b;JvWNOwvb> zC*Gkq)gF8NO$Mg3eD||5>wJ)Cz+@@e$Ab|lJ7AwP8Xw??zA}RfgOVPJ=}87>7<4n} zBhX?Ubu6=O9cBr77#9*2-HVDo3k2NRc4j9taW)=R0BaU5r@j$Vbma^D=^r3r5| z1qVTx7RfJJJXg6KX0f_NZmNNIfm7OoR?JxD_RS|>0sx!Pv}q>{2y{%%^6Tvi>&0D# z#HAr*adl5PqHo;D%N$C@qe1U`&UQfEp!eZyhszuGxi*+ecG~6y&M79rfpdb0Kj5(} z*X)=+(NVC5v|2_yhRu~nTS@@paei>&o_77bIWGhGhj;4_Ijg-lIk3QXd?8_$2+|GV* zcz;qc(}qd2x`Mfz@b)R-4M}Y3&%i@?*IRSY?~a2S(T5BSgF61Xj6@h5m*Xr?zrYhr zS7DWe4(vo~hxW%Lm?G&<-HGw#R~j_ogCrokOq)DwC1_tVUaBK6Y@Pu0@Nm^_y&rn_ zp1H#>|J}X*;8EbI)G6Y8@36;>6O`*j>-6Sn2n8)~xm|ek&LivI6xT74s&=(xxqI)f zS%Yg*TztL1a{He0w`4hzjO;9OeQRy;?(*W&ZCsZ{>Emt!-@Iq8tuEfZd;PY#e*gZx z`|y5hZY-jMN0|)11z`~d;j|4 zgPUm3w@R`z6MfeYzc$=+A8yaM=U`0c!hMX`C2{^aBj*srV1Cgmi~Dik1s!jLg#;e? z`CiU>+SG}p5Ie!ugkrK%j`5vh@B$A;XKEWuoQEC;qjXMkmF0wU9;|$+R7Q-O1DB?^ zpaeQbPD``kCRB9ZeH=rqknX}AeDbbY#$(E$N>fMdX#_#K0bDdkaR-gNN0+|eV6m+X zcw7^j+>(xFFrpqb5Ev$`u{P-psN5bL!hF<;?rJv$P?r9p7{N*oK(!nW!3!wsbyJxx zuOh3SW8E$M2G+0)hlw=cVeI$YZSWQ(AN%;(wgoDfGynzG+O^6CVm9c%kit|hodLF- zsJHSAb&zy#WOi=YK$+Fz^x@Ll4)>`mqmKJ4bUg%Z&?5>6uJJ2O5q{{4tCLGl3!{S| z?5$v;Z%g#|Vj7bH=B1D9Zo2D&8UWS6s~me;pq0_N(50s)gP5WDE#W<8Mc23pUPRfB zvSK_Of;xjN{J_&SI{msUBt!f|x6fcWh;|Q84u(^$aHU z{)^CuTrMpyeK0w|6R~+4%i^--t)efze@wOz$HM3~x(oFqx{FoxrLSeb(Fa~xG{MfC z0X%~LOH61YAXDiXKK_7r{bzP4vlk5{r*^>k?(_~X7%XzR#2Jw`v;8N;X3AUu07pCJ z4D4NQuNXi9q5hM!x+f9)u~~?BB(bAne23wJcT3oxROVCkM(psW9?m})Wc{)Pb*?3K z`^tfXsnw~eB^Q5 zK!mX@V<&~=7*XSqhO4{R3ym+(^#XVVU%@4T0iH|^WKGtflW!;b;SQC>jxo^>^I7Zx z8TR zPx$VGyaLl%+Zo*^r?1W(Qs_g7xVU|+4(uuLAT|>N+Dn6rHjqx3dhfgh7yjm=J4}ec zK%oBz0^NGbWkH@YjAA{qz6!Ocx{r1cjrUwEZ{_7rRkt&h3O7w(=i3wg&vh4|U;u#p z_hSkG+$`x#P%s=rK29B2ela$R0jpwpdb}H}qsq5jYcTbI{)-RU(=SaspwQ74yc5C8 zlKPT{N(aQ{hlO_JYeEQm8X!ZEG4laE0K-rdkcmAk5b=(&AG9jROfv9_k3S1CLz zcDY~Nj*|u?9L*e2J~1X%82x{eX|N!|#s>rHypBx5Q4mX72A5bRyha=ag(i$pGK?^_ zvzkMyMF{W4!~#3*B#t;1S<)f8>#ImmD}9#gp9||yJ~bap>HfLWDpsk?JSU(5ym$yt z_dk>cZe0g1ib4dyTc!gSE9jF&S<$Rx4TgK_{_qRo9R=lvS>y+oP_oL*06dPK7P>(( zd-Z626;%Qa3~W?sl?hQzVnk)b5@lp|?8g~3`;lsJ2se-tBauPgNy6EAkfKyEfodA| z(Ekr>9Q&+yLW0MZ0D$+x1rCd21A2$9jJE~aX0Y}fc+WYR>fpeFzbZQS39Go5Yq-bz@hlEGomy`X*`VK6o4Jj6vOCd=J=em1;{p)+n-G_BunGQ zdH2AtI1EEiBlg13Att97d_CtW$N5tcyY0Du329)nyn^F?VzmindtlSB4pT?}8eVnb zZP~x{$gSP4>WbYxv{12ahr}26!C6M+7bE0{uAMUWBuxBi@(l|L}!$S4V8?I2Q21$ros4-Zs9FyNpaM>ZdnERH7VexgTe!+C~;bK%Hh4Uh*JvOy@q1f zSh0H#gU;T*owo)su#xaKheyUJMNK@2#TcXRJ?JpTVLI3syn78a%%41|;hxN35_^n7 z4e!#Ze2I{i%GHVYDYOWn@K{?o%Ykpx4a;z(q%a-32AUwWb+(9eH@0KWH2C2cStWYT zA?(>A_<&k&=Qeo9fvv_M+)D!&Vs+Z8=R9Q4w}aQAJ;Y%^lb#>NvLJ3o;cPMAfu0`C z7665Osx{O6%fuj@Dxh+r8^_WpJ&*RL-XEiOTdqUu;9FMt6N5{%$`QdXE;xuKNs^~+ zT@LPp4Vo#O`47SiGU(3CR2B!fs@cK8r}}~)ALocc3TJoe1?Uk2hd35XFCg>4;q(fN z)zR@mSy~7Iii8I_0-_)qeHuY+IL{j#vwO4|Bye}@E;CQCj(ZCjN1cpaSECt(jk#wN z2s8jCuY_&@k6-X}b<81Lri|${yysx-ND1(}w}|FP3kdYBWHRvJ+?;2gJ~#uxovwvV z2x_abMPY6HR8~`Mb=F4rJYH=Y$J)^pm*~Q+p*{u^AKWL!*>hhp#?BQ&48a-VlxRX z=+JIEC<~C>8mkWuKBJ#I(RAHJ5H*~#NT#}gN{$zwL4~k&1OqG!61SO1=iol?kh>#T zD7uS?MdjYy-{JG10IvPHb>Ond;2MK0gFJ(2RU~qfev84QlLlecjW4=PV#2 zEUS-$y&5S2JQ}9T zme>qv;P9Ss2j}kwfI69V6I*PsG4%apQhYbSb_@o^GKS72!?G%7D>^{#<9>%!#`^~l z^sV+$@%iU3Oz6vDe_6lqUHGVXEeT%s|HnUvClA{!h`!~%?~es`Ttdq`J%+)tVE!Lo z9>)E`-#`&0J_h%ecX|v1ALRedUkQ(vfP>_f-ZA!bOX@chS~BY~432~HAKs}=92Jyx z2A?5zaL~u0#uz@O&Y{LR#m1f>pa0H$4#rGa_HHhV3QnyG}ROh^S8KFSAdLgMzv{Yx|~5sc@U9$nB}OoIac?EMB4Jkb*G_~(i* zy@+LGdWmxPB)7A4&<9KMRZE-{Z+&1N#6Y*j`t5<321f?zCCIh?mnMd$ZnPPg9-wUG z1|&beh{x3q0cf3vd^nxM-ewB``lQ^~P7yM<+uerCSOuo#QZlZIpb9E+221@AieZRS zd~BI5GT0-F-bXj`MAjX_!7yl_asL!uGGu`vZZCGgR3N=PwUNLt2h zR$NmH693GSVSl)4CEs~74%^1n-7ZnPjt!yo3LZ7>q^=1b+4h#uAe4Sp1P|Aq($6W5yq;9d8-3S0DVq#vvGZW;SxoP_3iu5D_*whU?Vkohvp%Y%?3LNr) zsZSWNHVX>yv=(xMrVhOY%WFnd&*+mf+7P$9;^fnl)NP~cOM!A5P80IMI?CRMIEhNRta8v)s0+hV9}y{hW$pCdI9||eOob<$H_{~AjCfxf4CEcI4SfU zcA0Fx&&2+=hkej;G=Y|n4E%R$M@!}G!5V@Adv^pi#J_7D@dm0Nk1D(a{cxO1a)B-y zJwwoGPSL|ldWpNl+!jtp#jzYh?hRb$;&Fd!5WU*&*aVbywK`S;EANCgUmABVbT!47 z2a|Zm%PgLj3xl=voo0lE&gCCp{$O(V*OGf9)lC17qy49c z&ySt$xqNBt)00wc{PEP+;feL#Cztcn7caao^fh)Sif6`WPZfWEbfZw(IX&A~Ui(tn ztxR>-f0(>@wd>tf*Y#W1r#^0eO-}#t_VLx~+PObo&P?`v8Jz7M?7lpExboMpbH6>F zn7*>LF|&7dVL$tIzLM(6FZ7&Pm|HkF`Ad84!>dV1B<}~ZW8%ZV=tl&XLGx(a8fFEw zAyVqDJ4rOb{blNwa~3UN-uT&2mXJZ-V)%{d9!B6BE&VeRa3h1pWQ_5S@yH%Ws1-K^ zAcab&`q-^ar1`bTb<HU{VSO zQGm7S-Zc|(;u<8}&$edgm`;#Isd%@3mwUc;3mETKXv>uTl}$Zw7yTHpu+!J~Yn}K7 zN??5+GKN*_j zAVHjX4=Kb`x1k~*d-aIv$@$;`^*IM+ho&i6?IsK)>&U)8bwEBZVJB7B6vhW3D+sTO zfXsyi1s>~l!3G?Ql~XK?nC^L-g^IgamAxBtd2x-r*B{x|<=s%9m zsOa{1&_^#wCiM|Xg3Cn?$Z3GRdrX!%FQWcuKKNEeEzB_Rzd@3E1n#=|NJc`YVaNBQ z%DcQvHnLAlIVwi(^YJzLfU;!dK6@cfV<>yolw`-X411->e(gGL$?1302dol65=aLw zgO>i1WxuWzO|NWWjkt{IMSKPDLqBtRj~njVPrpQWmtebK?;}=MEJx7Z5%BV>C|2D^ zfPM6l*VtAcd1Lr)y92bx>3ZAq`wheh6n>(ec+##l5F20}=YY#S-Wl+kDz)1mYPOa5 z+{+sDUC!NXR!c@7fb%wmykE|zK2%M+OWSB%lFVE^R< zU=?ZLk;gEZVImpf#bq3`VI45Jl*kM*c7~u_3kqkrr;Xt-z(*@j^H}V(KL#^>*e7(r z@<2m!XmTZy!Q~D~B-CLdKKN9YdQ-a-A4FrC?`Q)J(DWPmc8FxR!Son`2+w5d^&a}) zz@q|0DojrSkFoC*<3&4qKtcjK z${;g+b#^%hA3t1dSXzM^&JCJRnH6M4+v?{OQ!$hnc?dD*yyIgbc>KAFV%9tFG`NX9 zlc^vzyEoJT!C=wjoSV9y%*-HRWZk=8hJ08IjJ)Bw=?T+DX2tRg3w#9DdDN3HjxGV) z4|qX+%e-dr6N8@_{KDW3g4|oilzJO6V2xmo!FfNH`+(T+76WF<>@&8@-~fTmJdaq8 z3Ay(OMmGEeLC$^T<2nDG;AOEkOALPv-m%!_vwUR2#WyrKfo;{=fMOde-|!=ZLMvALdX#}Cvc+O|7@(KZ@^vqjVkvvDY? zIpa8M#Grs6V$s+{b>j@Mns9y!#(swFeZ^*xJF^Q##L|q_MF@^Tu?pwa>^%-diu%k4 z#K4pp@9`ZI+GWW`i-jI$c~@_s<%%&irp#=S9jpI{L2JoDGT3iMNX(_O(e+nqxmF?} z0~41$tu??LLTK3GZ3N2f4BaJ-JmlBm+{Vj9!m(ui3A zons4$;STw$&roLPxkU*7CBvu9Er@?Y?lMd$-avGZpXby$aCS){@eAv4NU6gw{f zEPKE@%z^`EK(WjpewCR&WcOeJcnR&c2?B*LXgCC4cXFuGA|!Z%0;U=HiDd=!3#k!# zQ3neUwLv5ZR7MFTlWp(t9tyP6DK}e``NOuCI0xt+zI7r2rcuR)`_utSP(^P6&S}(b zYKCV|!+l~$0i`P5j#gS+`p6OL+CF{}HIikZPSyuf!;hnwc2aj0xR62-6mtz?7V%lc z>TKJ{15L-u!WgNGYdwsm(r6qLV(A75CJLbh1`fJs4ha_2imn&SZY0ZVBi&1mv)K)t z@ATry8H%8C_}_>+ELP*uAXSawMXa_*e&Vj~IUJY|UmHZ`$Y889&GYWz<$gZ)>k$g> z1LETD;g$NMy3PA#jXJ1C)FOFaaK@F&;VZQ8Q+o}eTv0nRvCHXa7cdBf*A0l2#|(2BsN7X24~5_5v>0Uq3ya#x!Bl zj}Cv|T5gBdf@0ULIjZvo7)Y;!EN&wxomsa90I-9b82N?rIZ$TR6f{JRYa0X9vT+)ZsW$>zB1Pis8mT~7v55{UgzGBd!QuhXG@2F6a<9S6)k-b4?eF4cWq$+9&#o+G&Sm&$1kQTL zVpr5ro_Yx+VZE4L4T+7^tlfWM=9_r5jCmtuM<(15ypTb}^29V4OxYW%h?%cVXRKD0 z-KGMr;qn7gUwq*CLY-M21z8@4S(va9B<#@HHWzGJN-mU5qp%iY+}J<8$H%=TkV8Nv zSr-;sM8Kq# z+)LlM_VY37bA5K1370ZV;QF$Qhjn!Hv4{KOkfM*%ATb_atr1ffo1>Rg8sd-BUe{g` z6nWjvuP`$v0!#^%z+BgQkH~By3}QeiWhl+$YXh9a9j{kwdgS>V4B&XIee}FrN8M%# z3ELPIXb~#H$_|_J0pci;;htdbwkCgWOmiOzAXg zeYAk1ebxp}WJfVDX$*sPp0nE$_R}+yv=EBkWgTvfQniW zYQbfE0g&-7H_5UeFb7S)Ht4pJjFcIFg+8$sjoRoL-|RsGgUNa`zfdXn_{AGI#lB=29XAdzv?v@Np073``}XKfxixA+5^^ISXN~idtAX9E1N( z_9}L)MRqxXkshW=_>x__fEhUD$G$_o_%vr5G+M+u(@d4)kV_oNZ@H-9PIrw>RTL})#xaVMvfV}#EH{i+M}&tOgk<_-!QKbSOa+iuttEK z_hs#%gH2ha*zZWx_b7OvetguDCkw33Q~pJ-Cx#>V_Mwb#fc#OuQ zW{7Y?Gq@>raCHyx3ZOkcHh?TCOkx$e8#REB3{71bBk95&tw;^Ti z#jXe!I^vhC&pDv8&qJ5RLx6nw7qU-o?owy&-Z+B+23-sy4BB1yyvtvEJO6L`*{Am2 z&NJ?J?&%X9@o0Cf&5Z;<_rh8CoXwwTDi%ghcAfGbj!#dzJ*f8E^=DYRy?221_p|;~ z`r?uL2VG+;I39lA(53&eeh^!Fc8*_I$P|xTUn&9lvbdV(MCu%L)bKKI*tM|ZcH*=! z$o*c$q|_F?8$IUTnBE0hXuO0asMlq7Fma?rp2h%0izg4 zhojsKL0PQdFtDi#4dX=22hh?i@epzOi}PTc;Z;O7aM8!bw&;r;DM-*x0+q3m6Gzq> zBa|gtxQ|e5+MSMeX5q{}a;gXlai4XBM>82-XBfH8lNB91;Utc%Oe8sJQgC}8Z^lvb z$XRTBbTwG^ytZ}~Gq4AVQK#upD;sr3TSFsBKtB5;vS{h1*hplNGdq={(zd|W!FXKOC z@k#P}N{~qs_c4e~#(X{Xs)I~JK_P^6Zl&WX23of8M#ig?O4yHJa$o`-DD1zeLQmvE z(Oc(H<2lV0J+~c3>RRl*067H(E=^exv+!7_3r?l+K?Cl@prgFiaTBqzj-ti6)ZdZK zAd5iNFf)zJLnRiEkH8f&9!Woq0Le85Bfo=R;u8v(Z2Y@n%4@`7b?xJma$JnR)4L?<;3^HX! zRvqJy>>?KZJv2fHNgUoj)90Uf{F9e67Hs4m9y)H_IfZv4P`wd&Zdm|T_vBUp)%lJ= zX0nHWicU1Jv4QT882-S3mO{=TgYyjX0JS{Fpy2$CVuy!c9GEs?)$4!-xXwKM>Ns^L z7J2p8j9Gg1*VRY-D3zP(8U#Z4VO0Xb#vp<)J_SGO<x609+)=BF`?ZZyHxsUjv~iO7RIrieX~)C$Zu#>?nNc;Se~8MN2P{ zMGGerS>>2PAdbN6cok5_PO=W`5s2?*f_K}hlJBTv+I(BVyE(q24m{cyyyNy$^E-IR z9_^EikVs1z=R}~*jb=EU>0vzojxoyiyj|8~c{rM;xWSPSst5SjQ+y2k58?Zvqi8hM zMm0LeqaNNN+JCXrK#3dp=WH;hrf$<}oQ^Zu)bjgXWafmi|7xE-)4-!OC1i{PXEguT zfK)2$4P6S9a3rIZJx$wVn@mMuRcAF-eGVy5#(sNCK&*UupdDeWSi@Sq{1@;WU55E` z`7e5BvkBVbLIM{3>~0vUJLlH<8BQJ-Vy_gHLsFM@mC4b4CVe`9frk~cSS>PT9DK(e zb=(q7k6=oyET$GeZYRXZW?p80*04sIVH4ow8$&iE4yW1gerQ9Lm}@Q7Bwjf_#?m5_ z=?1NK8yK=A_6E%sTpkR2f((z~Q@jghj?X^rLJ01W0g7eq7gnXv6VsPL!W+MYQHiDm z=F@`6!wT5j#vI3v-0rn^mMt@YlCEYUK*{qvI%WB{4V+(sINt<+6x4BLEzY3dIkc#$ zsXS@$o64_ZA8oHvZF>zZ(H$MEO`kk|s0C&3SFQQPLUYBBZ8HeqU0Lq@V<4zi9_7MtBs;+@0@6G~T9 z$MmQj)3pLV^IPVEZ49nd@ecU8w zbKtCT5*5ePxsmdOpmgTNdWn#|D;-j(YJ9U4%mEc=dc}$IBPC-a#b=H)!dT;Rq;qU~ z3|$0gMSd_1@M`b4@3C#{vThp}a4qAJt!O$?;rPI0GmXs)F9-ygKF9?8_yJs$;7N!V z;I2M1|0R11Gm4A-AcVfaRAFzGf59w1)_}k$U??RDZx9q=yN-9q1xOt`R03kv816ie)duzM_I^y>Kle68A+ zsBi*DmvIju-#$2wFTFtgm>7bVio#CDry<6>$skRj1Rktqe-Zw1w<7?$Lsa|}tTHR&#ZMgjx-@4XP&xGFeJxs347vq7cJtq zu)#EoS&Z7!QjbOaE>29!hj4K`e#-^b=EYaGz2VqDinEyEe}gX0l)i!P4$)=5HFP)9 zpTM8#lYN%G!?tacYL>A7jvASelWT+vEPB142)XV*Q1{|D(Pg8#VO6Lx#$7AKh?Q#N z;UsGt|Fva=stHWM@qmVIyW@r=4jU*?%mO|@0Pth!@?N6CjqdS3kICmr8s<|fv7*6{ z#mdSJ0p(?3Rq4?b`38^jJ=MnYFKhz0;KrZ34JRfCP*5*Da@y;YtOHzvMysM7rWWu{ z$__FgVs{^pXM!QQgM-pqdHW^ujny$E3mhNvj3=#Sj)!YC&vat~G6(s#v0Fg!S5MG$ zhBp<7hr*602KpEW(cmS4iBlL%m6%W?k_*C5%?g{q24?UsU*2ulc`GkBB^t0eD?;UR zs7KTyTor|d@3>VVP?OhtRt1{nsdNcMev^&GLZ_D=~aI6J;Wp#Ap1 zSLc!(0hal(@g@)BI(%{L(E<;K?MW~zlC)3*S=(tX(yL1(ESkRr(U*64Tw|r)3sIeI2)eBTzc!*xs2%xpA zr7k|CV9zw|WpERov})Vhn!^kvCh(CflDGrSLfMJmRV8tG%~2ckS$^V)6rk;PU@9X@ zRc?q&n)byh1{NU!1-jsN09B*&yvC?AAk~4DSNSmi4DZk>6ZZ|>=(S{?hBg{ei5nf4 zCw5fKpA9BJ-}V=~0(`8tO!K<{vkC#X1F zoA_c6*A7r6g-lbQr%X@>_E{r*j2pxhaQm*gHjXHm2_e-k04;|(0LXfgc|WU`4>izA z_PHC5Um+Q$%I-nt4H7aO-Az^pE%mCbnhNTce{nJ4E-sq~>LgRW_z_z)0`(v?Y;m~|Etc0UB4qr%+cvH&x$XIaO?rE8Egz4lmR#^P=m_jfLzW_i}>VMF}TN=a1|4Po(zmrpH-V;m7et96FduRAEdQLiVC&g7 zuu!w>lyKqnt-fq&k&cSg-X7tA=ZAhL@oZN-}G8f;--g4b9UMoD-q zdXELL1>S8fVJw(U23@$BW7Y<-FZzT5*3qmI_c=Lg*-E=>Z|lVvj&GgE^&CRxUbuHw zDQ0D0(FodcnR6(Q0t&JvA@Wol!dBue5T8v4U95-Guv5qzcEZrgkezp0ftsN9GO&(5!eSN|P)){%r#WH7sAHtm9JKKZ6v@BC^j{p5dw=E7#rJHowczzw9?l5_P=# zobToUpp(UTwo{l_9|gp5tQ;b`wn~&JDOH#fA-hK_{FG(O_zXvQlhyj66pX?=E2q8L zix0LJKw|A~jSwDZ9GeABI5=uikrve#5QC!LL6YP!f7ow!0#uI@;E%R&n~-h3jnP=w z3+8K+3&({U=HnS& zSHZnDvKjK}1L{sSgR-o{%|efhU^XZ`#f^u;kAkwxPG;K{El}j^t{Rk3V}>|8TU-}Q7?$Ph1`h%LA)Cz7o<=^?sjKbeTn8lslH;%6Rj5SEf4xEEk z;Em~v<7`EM{SGj7@&kZ8wU8))_Gprn34>I33#o|$W9tp(L(C%>Mx#!qpjZ4PwkiDvohv&`0mjWwS14%mhHjHVBg0I9>I^fj2@T;ryAcvTqS4ovcMUax-)pJq!UFP zBP5EZj93XyuZxDOqS!F@ZJiOgw8C}~+Xeu+03I!7Ja}B;#@IbE*%-13kzsKsvW$~o zA~S$&{W7H?&7v~a&(k7)tez}ZYrrDfA59i#XIB!%6h2T?pFh6zXWz_^0}tkBMh0hZzpRv>4Hm1F^kA_94Xy|? zRWGP0hT={)g9{p~;z^8dqgJxd3uQgBKkCfFQEN9nxnqMEH&TKuat_8_jiTgkYZjhh z@d{f0-5z7eXSbd)*t^i)W3(G(0ee?Y*7rfH`whxOf4n7K0~0zGH&=*PUG;P zRFqTSfH!IrnMA2gH?!r+68%vs>Z-l}SlrxwnP{NjAPR{6S3*9Gpmc@cPaAM(WDndq zxJBj8>c!jvvhxD^(n>wutebOyWI&Slq*@+=$DS=V7MMy;cCJ3MOC+txKpn8%B3pn$ zp1pbwJQwir12x=GlfY{xb*a4R6< zq6Xc11{)v#`Yq(Y*VhD8!Y$+>-_)@*V!s6oc&#kucV6)}j{7T}!2tV39Y9=0g*akG z8Z}hhkjGm%n_2eVh7(^*EtfMUwcfs*K7)TL#5Plkrq|n7Qknk!<#dKA3{u044WH>= zPBTlY-ql$u%`hl3$T2VsdKh#uXlLLs&|-d%>`p%Ds@FmBCb85kph`E1Jw9!UEV~Uz zOllr(I3NPvy-xl+<0n935;FR&bkombwXdcuXt}q>4#b0%5g|)y3|@t-+u0&>C7Z=? z=@Hi?6vL$ljL}4^^dP*xR`Q3?quoZta^fQm64fS5$EdEd_hG9BW(^aBv*ft4NRBHX z>-b*$qQ@Zc^x}YY9yJIQvrCQZ-!o)PKJq-kOVElQ8}@#_ZH$it3hp-)pa)6nqG7Qx zH7KFxzhG@R|Y8SWXCCv~98$FXf@-o}Sn|1M^*8B&cWF^>Fmh+_}o z2mo7uC?XzUq5K`seXEow{2&dA}MSWam^bV~oqb%V42PkY{6W8&v^<0uz$bPW9 z5c35E`hy8%u2DM^`v_^_q@z50Xy);s;S$@6z54Qwkkn*YS;lPy#*&PUGSQ;5)m(w@uI{ z7J_4YQ0)jHKT%V^1z9V4QEk9N7IDC4`1&a*1o7Hs1!K$TsggIeKsctA@U29g6$E^x z%<948QiJ}WoGe@GUP(tQxDVJ==o?n@2eXit+{EwsXXcZor?=n4xkB&cGf8H!!r<`m zJ+!RDHJV|=(ily&F`T%fMS;z>Q#-`3#VzE+yK9U0H?A9egYuEN`M~=)2?rOb^wl5aHpspffSjRbT27n`}iJ_In+dwrpLKuVx z@BK(nCl`AFDwLR^ttsC%ZDG1lc9wByF;(Fifi>}+z)HmW0uKB;dS3$0BA;xmX;N=9 z^LUi(T`Psf2-HOo8_i~77(U2yhmK7)>DUCyEXawI5hN@z0rhV70tld>UBlS2aNcB) zF9)Z-m?8WUpi71Rn<{6Hi76pWJwsfEgiwJdJXr>L1{nqu*~DZ*K_9?7^q}I%=L(&t zD7AyB+`jq858ci_(obyB5`YiLD*Q$FTIdI$6*z}oMPH)jj*w)3kbW|$kG6jA^JocI zEn*3-2-=m9?p9^rg_Cz6N-py}A+T#ILs?j&;w`%!$ffWgcQ< zHX2P$h_3`?gO5mgWmSTpCRMK!xpB85st zsaNp`SA9rHV)#wLrQg()h98^t7h~+V3cvG>n-1^Ih=2(=r&F`QljS|cDj5X$#qY3F*xt!bKHk-1z;MC$$|23b)XH~(ye7o4 z)B>+nmJ5@-c0EZq&y(GiTX?5Ok|em1(e|8=RAFPh!lJixQO{ROu-hDBrH5-!uT2sR0K?z4igv~8#Aa+2nBVF9gVT6lX_=k z8oC1IA30B!q0V4bxP?lNt8&G%e9ZE&*wI7~P8j+)tz?8c**+ql6-KO$(^-5&BMLjI zQ`|`&~3%x7i5hO+`5=KXsFc4Sv@Gj&|LVmz8(*wgh zOiG}^qF>f=b1{_Q#9~Yv5E^7p_mWS$myv*dDRunh65&~{BfN)#*BeVr@q*CgZKVn* zQ#X~`k}wnjfXXwLpqes>vb;z%d7Cqs(~nfAH-dNl&-{uA<$`bq=v=LnsIh(t{LaOno}sR>xc_%e33>);LBLFYY|#DBN8gXFB&5%dFt zMQoZ(;ZP41A>ULyJPP1;Aon*a{r<+_)T#dVrredveh$S9*O=lucb4Z&;m$`#~y_lOYXJ@yJ8F-Fw z+dt}9e`~ssYPyqMjowl+@-_Q@tG}-9G1cyu?TyZa`_*h;`}Fu}^yXO6{MFWX!~D28 zv_7~wal-+;C(pWYCBSVvg&?;KTyhx%i!lJb!C-~KO$PYIcX6aKwL^6?oSrw8Z{ zC6;Rg#d+B7PQA1q+NTF8?|E1E7H`DV2weqr?h_g; zwhj!B2Ur4kc@TtNZLhyX0+z_rrqGRcgph^7QFx!{c;w>j!$lxKK|XJy1Ouxs;BR~n zH*%*_NX5-C+_Yuq$)(VAit|1_NUGNsG z`H1HS2%C!A`Zmlh#MZgnBQwNN+O5ijc54!Ykj;XmHULEoO#PAiqiye1gpW);LhR{F zdAjGBTuMy+hNez!%NOu^2B6eYY<{2HaN@5}k}`rrE>h!$0R#m~^0&_fr7KAAnwf&| zU31LkgM#oav1|QBTVLS0B_E)eAQuS1Jq7$IjVRLo@tXqfrg|rmzYX(rCnLQElzS^p zd>R1;=!)rOeP#jYR@2v{i>4bWqazY6@#H-dnA&;fjqa{vK-3oSuBPK#xofrSK~w}Y z19+iuM)wla-=oUuJ1VQIp%Y`B(`y_be{1o>RDCei8FM?Qd1J0tKrp?*-~oe&3^u{G zwc0m>F$Y~C`)B&p7N}P^s;Jd`8*q%;QIL+uc7Ge}+upt0y_3^>Z*(ek_#4tErPAu-2J2?H5rPV$k0r@?azM$0# zNe6gEWu8uxLd?u}6Hh_9uVM?k=*RBm-xe}s>dWR!Qd{6tIzUlb)mHRstDdp=;T9|| ziUCutKfr|5)6D>YS_pt<*tUNKrIG=7K(3zJb`Z<+h)DsC3cUpIRkgq@r`LH-GRofbPA4^L z($xVTgwt(IwT@ee&Urqb+X4Vsbb}8Ri1x~&RI7rqE4INjhuAUjdNAP5HyjH~)R50+ zxmTQL1G8zuLouE%Ef1`br8G#A(E6^)+ky`7)n#i?UEp#7e1+Yp>PzS#HR|Kl=SrX# zEq9v}ZYgVQAH6UTM%+d_@9OqhanE8^eW8O=Y3o(w^;AC$>{@CxR!@i!@K#n^mYtxk zR?Nl{)r}-ag|%F1fK}#!#wO8NHrX#;I|^B}h|G`EQe=j;P2Ccf@UAC;fSX)JfW5Ek z6V2=enm23!9xP1|SkqIA7DASMan{JOe7uhK&YaiSG8`JdoocPVO#ny1zfvkG^i0f< zVwN&gL{PDC-bV4vpI^c1NFoXO*;8x^_xELx!`)>y+*C=zz67KNzn&1H8Sm z2A7f!eHPk#EKsqlI38tYLD>Z9^ks0?@zJ9d8p8&z_C57_0Ey zjLd|Wvr>RkB?%4c1~ntPQJxv*iaEkZUN4y$R%Sis+tAZYy=b!dp5ad0;Ne#xUR*|k z)*9lMAn+_8fY5k=5FB=*lS72IBS2`U4QLe7gP;(XX(fF8&@r3s&MDs2vKQWpFOh|~ zRCgkShkpm?P6=HvL7;$Damh!B3G~i3GaF!F?{KtWzz!YJ&AReStX^4cft}~JfCBFE zcfpQBu+v+k_sn_D5VKs|&Z5_x`1_W8CbNo`0~a!vmyfi!+H0tMvTagV$Jw?}j~!rw zwAWd%-Yl1WvyjguCx@E9QkuCTecu=)h_ff_i5Yp|57tbxe_JmoX=vJFc~!1=06KFY zC1Yo#ni9WNqM_NjH2o4yD1t)dP7JjS67VId+D#VQr5?)|4ggT>R#>cxmWw+l@@yn!YK}o0RXVd@vi~>f+HN!Ia(wkG->XKbp%xs05-7G0J;`IZAl_Y$l>QD(N z4a7AJ#8}n%^JRJOP&3KwcfRSt?01+YXYD6TbxF^1@e{z~i3$6Bc7^cBK5fsnQ~tDp zgdqmXydCpn8Vl5x&a5MqcIHug7g;Kk?jrB7Sb@rf;WAf{L*BJ?X+v3p(sJqQxL^o5Jibs<|7IOcBg#&JwvGgc z=@$T8Mnx*ix#D{&$L--U2h!uew{$lfL-}IatPPZ`mAE9+k%1+w0i#^Lao zam{6=>M}|YRN+1)uq?JFMiaN_uGJ2|PqZ{)mf0HNeb!?Dv}s6E&ATNgl$U}sAY*BC zd3Ke-4U!}fJoZ4V>3qup_+jfn*mL%wKYnM| zDIGPht^}zYOyxRd_Q5vAO_&7-zFuaKc=ke=pouDEB=$KgpWQ{4nfn3cr;L$IGcq|; z9Zvvs=DyxF>Q+aedBDf}ejQ$FD80ddvo{IZ<|D=bAU{(rn|;YgUUsO}0^<04;SkjZ zWQpONv$jm|pIPD!gP+8wSa{B^2C*B0!c@$I03TuyFe{upL*q6%C@h6-jQ9YkygbnP z476|n{oM`&|M3%K$qY9eX1LEVv!OL2%2Ggq_BMuHVyh!1!N7NP$-6{tseH>=Uc)V7 z3=$2_A`=uV-Nrr*aGpDZt&KSc;AamI%*7aB1SRHXg4iv_6m%mtOM|AljZlWkeAF%) zR&14XozUUty0B?C*Cq9hOVtySaD2RDAKQ`HC&XOWb^^rNKCuN2Z-uc{#E4&9*o#6! zTyA%^V<=l(@*6{?ExtpGEsyqkBzOo43q?39Fx0s?z-|~~AcTr_ykl+fsfZFr%K|uG zSddKIfo6Uv5h)c%>Z(Mk6`)+J6#z*pn3bYC)M!;=yMc~p@YQ$xJ(r)O>*ty|l;oeY zcXPS#O}2o)2QJRcGJx9scHnYwG}V5VGGwWMh_t_&%W&8EfKvGmsdhtDdrIQ$h-%AV zZM}n23Me~A`%-O_VjTd5y*GwIeg!SczXVp;FP^KgqR!)h(j*-IEkF$tc3vH2AHkjT zA^)lJ4bC`LZ6q2di#jCHwK&tRpFVNc@-9G)X4AE6IOVC;^Gn3<8SzUe=IZ_mXs**v zPXQr>-!{!D#XfAu1~I+M-HN+KZ)XCykW0iM5KwdXlW35e#7;t_T(?qhZUc*uxwUX? zHM#KRbs*AC2Hw#zErwCNX4q`53-5d&rX7Cn4twbpFNH7;d`EnG>M`r%Q;4cQB5nPQha2T9GV4)na zD`;VQrBeu1Zxyak%XpogtfN14Nza3fN>S{}{|FiR@QY)YDRHIaC}bYjydG3sViBeE@3i2V`gyhuLPaMKpqWy+VEb9%8kEr9BSPa3;q~p zcvpUBz#V4WWsKP_a~W%ALXLaBDHOW`XK*-P0d+58up=fLdhtE2q_~*BLQ?^Ca$6)o z&704ULyg108sv}=6aYdJ8=OqwU<%NkBSM`FE-^4cY=p7P45|pOaMrZw&Ijn04K@c{ zejUVW=FCELYb69%FQw989ZZ$82lgx#YlCPwuVOgYCbS!X6Vxk zIFoC0G|S9Sx5w_FW7`Xh^`LmH7cyo53)R?34r#b-TOQSB(0sjT%w`=rS5pq z-pjH#OE^&x-fO6^>hr5nKH_75zJqWnv*Bj&eFt0Z+8kxTvKOx<$!6*|p`rOr$FfMh zdXFm8mcjNDJT##!ZJuB#f^f_bfR90g@H`K|09v+OH;{-GuvL8Z>>9V*IHJ4~RQ-fn z5U_37XWe8L28LJ9sVOYex3F{HL9l0>!Na$x_rw}82r4IGulBL!I%jV}gCn`QUSxR| zV)_&#K*Wv^-9-wNb>A$nHlZrnzr3k@vD}2cC?2$zMh#R$uZ|J}Z9Q8Im_V~Z0wuvP zh$~iankMNGxM9y!4X8^f<<>rW!tN1GR~ZwU^=p{$4j z)-y;w+OMGfb|BUV70k3g|@+S3&2wcakrVkM`vu2F(B@V z2jXl-4erWNn%O2Wp9K|gSjt?6WeDColO}QX?hd<$6Dd65fPU!)Vg=A3LV`!Ke5WjV zs#YNblj8Hbg~JbxxcMB%5n~|Y)rI0dID&McE_HQTLXf>5?2^(O!Me;5QOBB88bmq;=}m z51c-C80Z{F?>^%3^)!RBHg%4xh}TebtIVEd87`Ml`Mjob43g%`>BD7S{T31JebQa& z{U=>se@{&5%&<0(4w#8<`bq3EU*Q(;P{wtXM(2p;#NC( z187*%X&d}0lo+Rgma7CgXTDtrk*MgryOpz}cD@~@90$#3%nPW(+Q(CjAy5_s8YD-! zZvKK87~p3g`7!N3x5Wa@sC64?5?dw9)5{nU*bSJcWBl1=R5ZKd2lIyYhCzyt3ew6F zZuzwA1)*)tJ3v0B+Sm^_aH2(!czP&YOrd3MSkYt6ROEDwZM51f%j!^o-*s!=>=zAC z5sXY|bAraq^UIaBx@PPUsHmaNUZEM<%lol;g>Lt!` z=C5&jqW#+ZEsAFMXFTdIZ3nt`-nywXNA*+o2P*Ozon;?doFl+lphPAZOV8_5kYf2e zg2%ECLJfthgc~{+VzE2K<%FaoWAdTvSjfa6m4+BrpEr?&Xy|}jjfQQ{{8O=j`kYm6 z3L)y9axbIaf5}Ie(w`>2wFmx;J^!;Y6!km^ziLpHBFNSK^WqYU%(o@xUuz4_kXC|R zVgf#eW_f6n@RmGDh&hE>HU%_Epu|1`$O}@PE#&gj7Yq3VQ|%q?AZC>qdr^BOG5?iV z;i5LN0(6`$qH@*|UZs;BX7AGxU3?es5Iagd{U==>2R3V6jNDgy!{${l1J5Jx}- zHFuMkCsF?O^Z9;zUj|~H=RNOx&N^!y*0SwA-CbQ>U0q#WUEM9t9+U6Ue0N_5)Kwh= zTA&8+7%dBosav$xNL%D#phj!=;m-WJlRPGl{C%!=d@So4rwD^&sLbZ8gsT>}c_V#kR4}0gi z*sN&-G&d#Yo63@5VM5Eo9Mm!JQw(G;$FfmR@p4hPM#Ns55-ISN&%5 zggB>3j@uq#e#s^Os$5G3dSIH7o(lJNzo2a*Vz5zk_9#^x#w0R)N$?WJWNi6xR?|AA zU-QCz7hP+~CBB;1V8TYhZ@T3x^dQ?3!!6zVO%%G@uM(Gm><##$Zsj5$0au&d;dUKa znE!kJ19IVXgJ5t23WXh- z;Fdqx&r)KBU~|h1TYw*y;lqbX!=|WiE*H|avZl)Nw9XO zu6o0t4~k#{5O;|WX$5Vpe)IDL?O92ny_th2-r~&1ySbkbNY}2vy;w#lS z0PX7=s|+kdrdRuZahZI*6U44IsMiU`rO=4VhZX43z8#g_nb7A^ z1;-S$DLAg+go2X_PAT|Q!D$8U3Oei;UN5i6RS&3c%r3*b{Gou!b)5a4?rRX+ z2hImOYV-`fQ=pePFHWo&$r`E{zcJ&mo`?=`PCTL`s@$myEIsiS`5eLLC`)s{(oVs15O4sWnF=F7)6rA?!X3^htV>m(| z^+r-Oc6Vp~eY{6iLsj>ji;jGF`3Z{13Hnh*r1MJ5^$>Lo-X}H2aR0a;BHhk>*xN7sPL9OwDDKa zYWzE4KN3$w#nygJPqLvD_>4wa85UbTt91dnVC)eJ#n$=m()~#7_|zMMVm-{C&??-y z3_>G@GCy(N&aYJ*$B5kpOe5NdobdOs;c9yQt;gNfj9kfjYwow(5XDTycliw5y+5>Y%La-9W{9D+Em2SJQ zULypQgV-C>h44EIPXkVXJqsJ zepM%`&`+zk;pbwdzvvF7%Tz47s=aqX`IgF~*UZk)Q_BP7YAqbtN_r3_S}{=#rLsC@fjpolm^bhST8piP_lIT) z3eCD^gz9=UD{g6D)%%yB2@?jd)cXa*|7QvUNi^bH`w6&58se}pE*=$&a$=YSl~^}> zH^!o>sj=)-CCoQcmamU=V{2w2C}KjYRCU~T4<;?=r$c1V_r^E}57g1>Mk8-A!KkLY+S*-m^cWCO!XUZ&=Zy9t<=Ut8} zpB%164k>0LzE{lj`#mNyG7$45reFK&uQGa`y(op$zw%UXFUFL{-tEDyuxIsWxHt`;bx{bLFw>HAzGbUj2v?1~wO4nq`6I#%mPe zmJNV_6@8f)#EIog{i2>=3$+9s>2ta%dNT9trc; z*LtaUh_>L{O=_OGz9;jAEORf9OpbqVN0uNv!Cq?oxGrPHi*it zfB8$+M=FF!?Z3i|=lStZeVLlq50jmASGQ>=yaO(}*tvdEK`s@L5UL;vRk z1aFxyqmj7ECs|76r+gmZx57*DRjh=UbaMGCQfCG|dD&`EFAwVdJTlf>2cwgK(vAdd zrV=||{Pc9|liL=y8RsqQKyF$0I>i#iE}%-?QR+sW)Td7MStx`;;gu4!|It#&iwS5! z#a<~P&_MMTRPSpd(Ot)?TOh>2kV4OD1pAo1eQk$1)=pil14iahAqsBzRlQaMLns`r1**4XY}-e~5YA_vN6 zZr8ggA)f@)$WNVJtY>I%X&s=mg{z|#8#qV4r?%o@W%*Sa-dj>zbRQY@!g{uiL@Fzm z=UNO#R6(ZaNM!oW%M4*E--VIyk=ap`8)saUBvfEVr%?F}+kk~%;xckcE&n^`Q&w5y zJJl))GFi0FDt05L-ySx_K!{c4NYmv}0W0{xNUEteCzPJigx15}VgXmnNN2Dzkb*v>~0xJA!LfoKj!Ly+syX^^o_K(85itQ?< zTNw%;vS4?JgtwqEdK%Rr8tw05p){u8N>>zVTWs_*F|}Nl+D7~-GL4FeZx#F|o*eO9 z=0m$R%vps#*@sleTcwU_M2+N~(p7|2z{NUxBptm)w&Bs!@bKt41?Lr9Qh>%#8NH=o zTmh1!GCHe(NwqS%s9;$^O~I-HJgh3CjZk^3Dkm7ZN@K!OU;QioE4+0lKPB}**A~C^ z_X6Vz?DD&2p;-9}*ETA}O-K@*6%F1GZbVV=Q@}HQ(H|7k%`G9OYg9&mFjl~0d=T6n=mKcKWt7!JMu>_jIRO2N zd6xceM9>w6-yi+m5cc25`MaSs$&wE=E6@)L=^Db(ZS~ua?l&bAMY^A|grBm6!p9QO zBTA9a{|W;^E?H>(>|*?u@V)Bzuk^Qq#zKJ|TM=oDgqiy1!nH;Of7d7ot=mSmAL z-stoG6HL7ZnoWihP{V^mU6U47W6#nmqq9`WYklAtW{CMNEdiwcYvlP%brUDL*xtVU z-M^8we0HDJDwDCneLic&FvERt3m^wgFZKHok_}WoKR=>Lk<}pzp^l7`8Cr1i(sVTA7E?Ro1#JjYPyJg4p zo2Hn%Qf5baJ(fYD!1sdLBc+&16{Eq*-{;lJa_2q7=+=_)jfo>%)ZV+siE6vH$Ebn@O4|4&k4)#AgU%o_fMQ~FKr{3`Vv5`&dK_2`?Bd{8O z4aBDyx`8;iMA#$tAa);VP5i2Nw1R$*04UUT$PrK8yH~1;NviOE9^E7Mc}H2Z&)rdf zx`8p43&yJOV;8_i3F)zSo4hP+4FFS)=P>egoy6TKQ@mP*LDFa0M*p%6>P`dNtL1kt z-oPA_A*qG?-D_%F@NbGI=d8TnJsh_ZGeWk8hS4|yF2QOb)m}s6;GFtRbDjh=CgXk8`HbE#p`rHIdm9e{s&HyQ~T+^|e0F`SW9l_ln}GO@s&!-xu<; z;hnuv6@w5ghRSsJ*Tg===MbvjA$M8Y=<+6e)`-5Wm3d5M--lG{;JAP~S$)ov1<`9? z(u$gQ_g!3+q|r$ROB%4ZC>=W}&fy>oElJsX>{&R|P@V*oM8TqfCg=)$xrRPjB^4;V z#YNB>Zi5vDhBtVZVoF#yF5LS&b|9lE(oqs!fjiIe%n>4I_s1v+YG2;z(h}6>%5&mk zsdNR4xrH$}tfnz2_BOYl$w`;fswtLXnzlTgc{I)<#MtMBMpXWfSA3e2IqgoPg~p%8 zRI_RHeHYbjDR|RGUpk+}uof5N3&O?bn1Cd95X<7RKGgk07PIUtyjUDX(kv*L*ZKX& ziiueZYYl>JBl+*L5sU%fqM$7yEzWrK{k$-xobJFeu@4!SR5FZdb7SXv zUWa)|@Wx!Zfl9I#3|ai5%eO39$DXlIH~vNom^Z0!;~0xQDmQAjY_l6QR(*2_iZ4#3 z=o<1~tPbwQ>RV$4#x1{ln(*Y%gd~>eUB=Pa%zV#e($xO1;o?56f^*`Si#0fP|AyB` zEpKyp7VriN7mqEgZMw%MX>Tfm+ax9B_n5ZwNSKs9A(*Z zLDPz?4hqz^XvHZt{*zd55kLFgAX{8L!v<+)N`{tG`S-?3G$>+c9lkX9D%nfDG&BV$ zL4K=xf4N#cKmG}d_1Ldhh-uk8JXnw5FwFD>GWRkQkNq@XCROlkeJcu~6Fu6hh`V5m ze(h%TNaybbeA#;#?c0!KeoE7)h;6b%@$oWyC)MzlE`H|Ye_8P0IW_*~G7T4M<945t z<}uC#CxG|G68b#gqjYs~BHlLR2kdB*rM6hw3f&LVBO>e@)xw)@C}s!c)iTX88Ux*D zxv^S?k9-~^e^gN5zmp12y=;YkroD%irngdXOl%(P)41ZNu;Q)_|w`; zEqdM$SW$U2szLl0l6riO%!j{|b@jcaw-flSZG@oEPEb10RPP7(IqZ`)RlLh;LVQ2i zLt}*Q6H=y{Al-d-(d6=%DLPYrtI|R(;85SbuSI`F&4H>kpJ?Z}=-`dV6 z6+x2f&Mobgd&hm>b@TV`UK(4To{KMCikBYGjmN$xKAsr4|8RL>JX}5>oB_U!3Jrm0 zKVIrlL`5g$NEL-3)+g;aAMu6%7<1)9g6+$*7mR9|9_t#e{bCy;d?|DSET2BDx-vEoQZLNDt2GzVKt#m%({O= zCu{Gi9^trixk`+D)0YU!n<^IecCrE##xUV47r>%GsPM)j%F}rT;kQwR19hLPGfxZ^7EhY2s~X z7h4Oq9{_p!l3!M@OYm@nc|scAVqNtn`1J+UW?Exno^c9siOfEJs>i>C-}EKV27;{F zU_u)x6Yug4O^B$O4osmMb&%zrWyz%=TJZDL=RLjPxA>T`Zdr1#!|tuKtAFq7Y*#-h zy+dN8A*7{*$KsNlTMG5coD3E4sYX;VokpWDrbjXeP5m&`pv1Qk9+I6h<=lhyibDkE zNv@(zVmlYl2FUmD3Zsc0A1)>&w^bXjCsL(E-xF=To>PK65$^pMZP1u7P4s|}e1FS* zJx_Q4OQ@}|J7tnphhj@6Dk1a+`4UmLAV-mjM+PCUjZb)3|kH+lW)SY@%HSjYEZP`Z+Sexji( zA+tCegD#tT1j={(4fzyXoK@Lp`t6{KId)X3S{g0R65RWsgbigWzoAs5RQKS%)UWc| z>IbO^t)8pvi$a&)DjRXmE`f`hu;2t)orB<}%aRS5^!AIvwDTtW)8;SEex&(2{{~R% z@LX}uu?+FekgAG4h6{^Zgk{1xlikgnLkTsy({o<`1eEmAed!yY2jR*T>p9>ce6!15UWBWYD!C+;zSuaNWHR0vcGwBz_41PCk>xnejuJ95xMHx!R@) zcX&XbfjhIFal)W61;42+<7f3qBU#%VlUfr`=*;bdw;Fk6PwK&d4R4e*W^{Ps!BUO3 z@w9yuEeT4A9lJ%tD-OjhJa8Q-{HI=47KTenJyT-8mfPnks|~!#HSO*A&Z#BGs$ifK zS`Xej7WY&pAG!`@ewYKj(FIL|h9VV0d&uWEfgo+q9G`0kuhUM6EoG~Or~R61kI$%XGpNptG$WEnRGq4I1A+av1lK-PF)sm z5S1%`)JgZ`$1IyPK{(?6VKajUNvJKKP5?S3pPj`S>Ej8Kr8er&K8g8{%wY*o+<%1w zW#6PuQ}@HE#&FG_URVI={V(f>80YoY0Zbs1m1!MFzJI)aXdwCR@?>Q~o-p@2Ecu0o zCq5cT+f;eeeH3C==87nc+OYW&CM8HxFf({GdVj&PL_AawnbfR%@>RQkR>G1aA}Q%^ zcUA6x<>5k>xl-0qvle~*VDMZ!7rJlrizC&lZnf>=+GBeT^mRcYBknPs&%dInByVY2gX-{z$!y)Y3Gj-Szw0W1e~`lE~S7>Y0LVCEQ47&ikXO zuryC5nI#HBzhx!#ip_&hpTSoWbNAn*v+4b@bT+*|kyiBJbe=DrQtv%ROEF} zUXeuOfPHlXe%2?>WQg2!*xz3W)W{e~sA+6X&uCP9uGpL$m2k5MaY>ahwfQ|^ z8HC>X>|9p^@blg3!O=EG-WY*u(_p&)ByG&%Y-blXfGcCi?*GiC|MzucCDU;PN5pt^ z7X+TQB*d0HEyrC*R&4}T`e3s^J++C4u>UC#D<|vjX8&>2C@{73(ID2vy!UaFi(mSdd(j@65vsF*lpzCBSd0$i4q-My4k~L9U@+arzsq1k{IK!lm{4 zTphW)6h$*5)8o;|GEl~AOA8|^VM{7OW$|S?qNY|erapKs*{Qy73vQlyO~TDxCL&I) zHWJR6nh-fP=iPtr*Vc&z*4t5+(fnQc8ki)+lvyKw>X?nKS-qMErz)1f`Yl`FPgP>3 zTuyC8Eq`CFM&--OcN_{$yfd-m(E;8v7(-|c9D+|5prdg0(sHakD`p;54DMoiEB75h-eKFCAp^LUCF00Orc;z^;4gac>l z6-!y=RDVp*)M1tPYcT)&0UdbR?na{PS(AdFFd2A6p9_svwWC?Lfb&=mC;GwCP@Jj| z0JXX>bunwg*VQWdRFP);sZ(k5rEUo!^+(p1R)D5Bslg)OX*iG1dgF6N;t@VLuS#ujTJTBPw4Z7PxLKW$&qFMB4pdkeK(SU`#Eh5^hR| zt*2+=Zjl6H2YF=ykTaoZ`ci?%2SzcPpv+;Un5hNSi<%9^mTd~NP}S$ds#gS3E6mjV zcK=Ty^s^9>nm47DFbfW4Ny(nf29mZO#9I4JO%G`&Q?Vz$0$j1W$XN?>cQ~0Ddz(08Fd}_X?1h5h)Q$v;ip?;f$ z8V|qL%>FthMNcP~;3gk>CV8WEw^R)d>7iq$isl1b5sf6q zTgHstz~WMykklt*^?;;f*>wPZ>2D)0e>e~Ot+WYKf0O#)t<*QmFpb&=N1ZQAkY4vd zGxh^*?Jv$Mv#gg7TC|OtT>zg$fi4;v>7^~e(_H4|oFGepK6vX*YJgf(VBR7@;~Wx~ z$gEMeRacAh7;9MlMykf@OK1KkR+<7ScBP6wN){MNNUFqkia1#gL8j1o%p_|9by{=E zHt;;nKIltlhzA!GE8Gyl6zjBf)QYz$M%^7gN4I&zFkz zTlvgl+y2z_&Ts~l&8cczSdB@gbE7ByKG^k*%7e*v1mn(74H?m%FT5)s+_8?{Upn?+*eem07>wxE z0t+(w5_Dfl8wt!`mmxWBQD6yNR4iCOh+dUCDr?Ua03b|#?_~1AN&>obWv^UKVwF`(uW8DZz^E$|RdvP~_&pL3XK5S+O)$U!{t7Ttq)L3|PWOP{(If?LA% zNL_we5$hAsFMwK9=pZPyNDen@oB(JpufMS`x5j5JEVu9GycI%*+(EIVpru+wr=yLl6fMQ6| zhbMFJYIMC*%6niv!3(z%s_f|opCX-%D-S=r!%s`jm&fGURn*mR=GfOcC=hzEJ&ST!NF6EM5!^ zJDf_YXqtUEpcZKZIkf1-M_bfNm2sI?_EC8uo*=gWlZp<{s~tIHgNobOo2|`J;>M(i z!)DkKtGc20k*vow;?ay8gCt3eQQ>p0vWVyqwTI-%-{VN1Rq|!{ zVBj3pJJ5Fz+V_DKr?sK;1Wnaai~GW1i)C;=sn7T3I>mPV)}^Sim2wGMnp6W{?w2vh z`#sDsT@1`HN&{D2k@*qCG+IjZ#@`=HS-{pBCrD zyPfnZ?}l5U46rIJ_UurzN%X}-M(5TraO%_u&3K}0kS5!>Ca*%bjA?-MsGDL zDi%(1)zk|^Retkw&gXyQ$&M(h>bH7Zl{spzGJV**i+k7N_W_NRLcz&N70DlS`YTry zw^pNqq2w{8ek#{*q074Wxx6^_ok<|Ch$I>5e}aio>jH~lZrg-HI3QXql?-m z4oL)Y1x97@*Ho6kNSTFMzv+{Kjj+7vH4e@N(_D-&37Hh&nYp<7O|ddP8ExPgV>@*i zLLyk)Ccz`_bmb!FrBzFL21&T#D(+<_8PK7`AdKXVE2jvJ?rA@xYYi%F%i@_CHnfUs z-C~CBSk{m8)~XWP?*s4AW1Cz5X#s^Te10|9kn>SiV-n#A^EW0f^6j zYC_y@RHnljHUO0`p2deyfnq_7%t#bNT$>$c?KshZ-;G_0&k&ZHcDt1G~ z&VtL#>%3UVhxCXB<1ja#)Dg6q*YyY&K{3rs9G`eOa1`)>n*NDlU(jlC`X}*_G|>6C z0zdRmtQH>#t5dZi%aII?n`ypTuKa*t$nj(^Ur@fuQ`6=z9#b91Nj=b)Het4$Hoc}$DK#D5KV1(bxABOGFFIU1MS zeD@~=>kj^K_^O30+_NJn@r4*7yTp)q4ep$IB?=wQCLp_$OJAFrxPoV#Dw>(Fc&KTH zy&^ua-k+l>bM&5QLz#5AW==Q-_O6(Qz4Tlrcv+v`*; zy!d0p;~o&dGDSsov=)}@q-uaoKBEqkWUVd{>3c-ju}ewP3PM7|Bq0kV8SG7v95ZC! z0Wqjcw(_g6EccDUkGQ=t49 zqe8g2RRr53A{P!>&K@bC+{pp3#m6!AK%A$nFtqrQ+%QS{(7qNX z1drR#NHtLPn;2>Kvwy9lso37dO4c9OgEXVs$*h&%Hg&hyaX)zR2I67%8*`3Rg~l~e zT+(*-=Bj35_m&d^T@ukZ`;C7KKvPg7zTj2$W>31&)NU%*Z}RD#{d8XmG0jWWVG0c^ z%Sar-Tvw``^wHVy}b6&yk?f#*Gd{=Ut-YE=1>N7$=iUj7~}FbA~$22^?kgt z58g*Q{&iEI_j*+PqvO};!TINI{zp1~{$J~8Dz=9tFY2vSG$_Oc^hI3c#8N(f_rVhl zv>*}19g50gt~nVMr`8qdXropbl{r5>W6wBri#fq#2TPe-$ujZIepUJ{!W1@#n}&Sy zCn~eQ$REl1j@Ff$tM-N>0D3uk(Hl4C^m)1-k?&fyGWWT*dJ5*^v@vt1neEFmOi%6D zqeps)77a^(=L<>i|uL!8t81s)3o$ z9pLSuHW%k>gCLs0&&EBk7qEYz7^l5jb;X)dd26pKDJ_ySo>B}&$@4;E#2j{+Ll)Ad=B@+Yo>de?41~ft3~Ah# z;NgOPr3=jpNRZpt8QqI>-hu8!l{(;^eu46Vlw1|}bAOu4=9fLQt9xFHJ2gz_9>rz! zEycd^u2Fc=u7}jnUd?pg2uk|5&6&$vWN7)*s{}3)ib`2m7}O>!n}3{;p^oNP2-I6N zCh7P$k{}|)@MV=1)&9}v2_cX#ronzfXks=seC(@u z6Bp;hAo+Oe+;0NVVrLJHX#tqpNzd}!3kS}Dd_X%AO^{CjdG4=0Wu3*__z(Li!J!;X z#dvTEQ@Z<@76?aV>*Jt~q^Kr({>pd%jfaBpZ5{z+*EY2JWB$0h$Hp4vTbwf=TpK0U z-koee7Lqd|FayiTWaH3+Osb#e`1xZ&ib^7-V#!i!uGON{!czIdd+KVhiiP7KWBU<@ z30H*60S#~~bvVY9)WZL|k*yAbal(5I?A;VSn8(RmO1+MEW& zBf3XDBh++o8T{lT-InwqUS{zlNgDNAokb=_JC9!iCY$+zY85E9veTmJPlm{547j

rUtwkazeosmw|tat zUa-!!T8<%m@7Zw6W?`NMuRQW(ywDy-wvM`r&Yu{0>HTC*fs)d5Ufoo_FC@q`m(6d* zbf8WA`Ggx?>Z#Q4Ydh(XY@mg(?in4_1<3lu?El4u0+0)hs65X9rLAn>gsb^Q7Yq0% z+l`noU0TwEdsdZ+Z4Uev4#~(V9aG;&@A9W?HT&}_@#7`{tW%*-%_i~ zLbs?ZtII-HZgp`M&?!%5OcfBOk$~4!7tocr9>?G=EG8ND`QK3$c5{? zA21*mkdSFPf+=ia>1HnzpGfz+#7JgmU6@PltP68W$dx;WMzF3fEJ=x$917M|5}0;$ z!ji{EVG!R)FsIstvnQ{hYIw@ZdMl`4Mm%P|Ymz1AHNdBqCwc*6*B*fqY*2nakTnkP zulC}jIa*oRQk7xL*^{-8K>^B3ltnzI8ArBOOfU4M>?&6uia{pKB?167xL2|*xmPk9;;8W&&Ww1?u=!5N!du@! z6HkR9zQ}nxpfrzj;5Ci&9>x|XYHq~@$(UhP_>rq$7Jt{U*ByBbds}--TyF`og&*OC zkBog%v)xF>xv}q%i$eSE``RcyBSy!IflrGs$0Q!O-9axklp=|d($@aw#f@HHKjdAF{ z%2>663#KhU?L$&+t9UFJlo~U`l4lV`n7$OyKK(Y!Z}Z3X+dD6y&o%hfyC@Q>vP>+> z_q@D0q+-s;s93!2_iMdFDHrZ&;CFbOr$iPnd)B>Bg*jBmHQA(BIUK!sc|ftaNanai zVA0Y^q&3TYQ#gkc@F6wpo>UIC{CtDov}Hd$u>VxIoGyG|OZATD>%lzc5n zn{I$Z2y&-grWpy!ZEO-DWSNUl-l`GO3iy7NL}iO)nfme3$iwCFyCV-DMzeEEk%IfP z^UJeK<0A|A7Ne!*xrZoxFiaHv6jcOt+0U*-5hqnf@6U{p5J&P~+THcNDSm)O*|}r| z!bX2nHoR@3J68%?2{bFIrwT36wo%<{)1hYuqud9pjNd1pXO!Os{BwaTj_yiY6J2ONSUj zD_9azn?h_guZ!$D39{icU5ah0uRuDJxD?<&4#s;iuRJkVCy&AF1fL0c5qc z`m-ib&nAHE7AbhoNBMb1h~%}%6iExg%Zb#3E=jDiawU%mp~N#dS=KLd0*?+raag)0 z46dlX0=0C_#}4Bv9TiNDlqkyoxv&?C6uza;va*`|m#)PnfO>&1kt>a2<~L=zD)2Jr zFMTaTK%pkhSD$gcl}|+T%GFM5=9>I1pzJs2-9EJ=EDOR)E}8t7xZbVi8GGfLPD&MO zlWfo$s1xJ~h;r8}eo>%$NnP$NG@|m02%75k=ap+Jp+$6APSq>dC8XbHonoD4Feqbc z%mwYu;%?GZZ0Fy4rb!o`j7XZB^_YzZ#ND&vG3O zP~0D@!ETBxGdSy0jR{(n`?p6@!2PS9CUv

pbmd1Ou_uvYR*S8p-mH<-|4J7axuB7vGl!&^R=%U3H5@I#7$TXd_CWQS!)?q04jBUj6!05p*DPZs1cgL zi}R{Y2`5!$nbf5nXCZ6(O$KG(U>6JUd@5K)>sh@ws&tX3XpIzfbm_Yg$Cvjso&Sxi z2=mTZQi@nn4%v@_Fof$OGmK$%Ezd9@BZg^c9=s!(KDtZ?VkDQ=np;TGohP z?nNJ8xn_h|?=$w1W*Q62=bf5}B_SzAB%G=!%gIw`f|W(gu>55>ib%qH8p!4jdF?c% z`BNr10?s9@3@LN_6=Hg!XSrjnhlG1&0=bXAuS-)ELN~oE&~om85|Vd_bQ()Yek0dE zjmzZ|$q`5)R3e`Nn4E?p>}4-0f1k!Aav5s-?!|F0C@4s*OITu*5OE5PsQg0^P}1df zIJ&5yMM23_i({~NuL>c{=j&pXa>^>pW9A%ESI)83xblsMnrjR7o~f*9M`BqwAJP@5 zQNe%mver1cJGu2MtzpCM##hGz-!ESyR{jwHw|f-(iP*gr#dOZ=_QkB_tO9AEtF#yq zb@l92se`8O+(q21bj#L<|1NaSc_^=P&jNb+qDq|i!JlhWm1Vt#yyA9DU8yp!dj182 zM`olcV$1i#NEX3NIs*_%uIq6@aowYHifMo?&uH6SF{sAy^Q5HDNBtR3GWQ^x@@56X zo~b+-W|b9 z4wWpw6(@>cRz49Lc0RPbyO!LZ)K{+fkcC?G`w&)a?aVL#qTia1TZA(;V=%uI8zh`7 zS64{CoEpFRQZY4>rP<5U9C(QnujA z)u!qQ$Ahg%Eef7imEI~7^&DJU0=HLT}t9dxOgy|Y8%0Jy=a{ULIl%1 z`qZOGZ7X=W9xgGa--?n=S2|@E5YEzaleYZ`R<}CEPGTRWK6;@l!^QKBYETHA`B7|& zyR2~0RJ3xgs{tClW%9)$ad(UYo`cG{-DN>CWs8hpehyARe`p#mAUTki%?Am)GK>Xv zx9GRolttM4wKTSBS30G?+_KVUB_{2tN0+jzk-|7nX}WUG*sJ3;Ypk>g{6n$DTRtC+ zG!JYlYQmIyJzF)SyUuU!fM5)ku?EB+nOScddv7tRx5|)Yg}G5cX>_frMVUO!g;jApP&Jt@Qs69rIwCSpZh_KnfVI_2vO@unGq zrnU?YZm{@O6E@=m$9Sa96IBcmJ9`LYQ9K>u%MwP98bQF9m5^LZuoAi=tL+^5ma&GW zWtpf-!HB8`hRj0f5QZ%#!!TtfONww;toi;%48hXV+K;{u6iOvmfHD*(9q`j?80>Vv zh=YvXMU3zO#(QZGe}@BkItl00eWE!Ns$`Z>ouWjws#qqeZ*)+<6vw`kZO&yc$vi-7NnWK{e(>%6iIDpZBUSlZBWB z?Y^C}oVoN`_y_HwY1a7WkDSc}nY}>J^(-l%CoLkh z4y`=8t=~R)h-;(%H-l0gm*g zO;jtFG5|Wzy`r;jWt~?GG0p5DmhBc)yukO4UDN4wkx9$6;p@CED^t!SXz4F8KhfUA z{KORF9j7I2JJ~L!xAF?Lv9tPQdDC(dp3~ z!Sa;f@U^0Jty)>R+hFe2;&$b3d(9iFJka6UaAQ%7fnDcK=PzoMEsMIrE?S#fabxVmQYl1Wx+2KSl&qko zRo2xDD?5Caer9qg3G!?i&R#EAuj4k;6THiIjBa=ktduTQHRCWPZ61$~Uc*l`Q~#c1-nd0}=qBt21l| z4hl&bVb%-UA^JpFxS1zvu^Re=vp}2{&6hRC2Qg9dnFu?s%)ba1tE*B{gYETC%(I=k z{ri9@xgY%R0+Bdu2YesT`aUlor3&%&0^I3KZk0K`K(gJh!eTI>| z56^14i(ajrQL0a472xr{Pt|25b(tyjnQ5?AY()bdCE+UP_$tchH-~6o%2$T0kynUD zkqlN-kX-8r%y7c=q{helkS|53WL$&+`r11d)o0v}h(D0j!6bKlCR@g>YNd9g zu31PFIv@(UKZZQ*_^ub$F15i_3tBI#G2yK(@Bd~rz2VvF%4k#)qt|ZuY{ot)PM}5R zFfE5uI_tN6D!)JW|T?N zi2pn^u=O>k=5olXOQ}SvJrSsR1zv6jjuq)7UVX!9ZJD0AC&@tPC1S4jG{uj~>3uV` z$3oI*akdiNzpdKz=A|40+O|>?!wKi<|G08kq{5@yFuG_j&0`p=23f)|s8-II?*nRT zZz8l(F44fQeV>k*3C;jU6`lB>J)P53#Xiw*g^allTuF55n#{B7WwTiTWv133!LVgt zwc7n5PzxKNz98+|M5XpeEQbjERKxbN{B3K$_~J|s>D4$r+A7l!!QdqMY7XpvVH>DE z+k0U>wt3e}on4yR%1;wj7rNX!Cb}HPCS7~a4#K+jO})v#-YPPk(5F3MrOwnaSOp0; zqss?zV8z1x{#v!N!lj$`OVbQd(ynh0btuclD{{CZHqGQJC#(~sdLy!nvxnSi2jX&3 z-SrbD@o51#MG)MLdk_V_kzS-LiF7t*ehDs*k92;i_TCb4dT4}xJEkm7{VZ0hHVO(i zzWphr9`Bb2o#Dm3#5x;H@BN=gEsY!BI-&CT)BbPckhyKONHK}w#5QuK^2r(15nHZV z`Hb0tliYpWHcv&&9|R(V_Y#6Kg1 z1`Cx~M zm+J>rd50j+$7M*O*zDsXv7AE2RQ1Aj7Ell@2q@|Z-L2ZB3I0#@)`9%@U>5^t=)f_p zb(yS%%Sm^ID=IX?Zgb_hsyw0I-_+O-y^lm+KNOFmgy%cZ-_eAyy$2etzN}-c%5U6e z5X65;>kq4qm6O059^mAu;XQsW$eJ7BtIVm|eJQ$l)S~}QqJehvAWnC86iI=6{Hszm zK9D|2{i;-1|Kva2Q6YLo7R*ZRyZtZ?E<7q07m3Bn;&$L~7VYlE`75FOQJgizrR+R* z&)8AZpC4+xOZFePGK_d};t+KlR_0$_%vzcu>mFCeJ^|C%#KDZ~Bv0wGb$-t}`P9Bn z);!p%VIXSM52vaD{^(~a$Ip0=xlivO#a-xd1NhiTvbKt)zM1fV&}X|pfl>K%|0GAM zcA&qJt<`7b2|*GK~oi zldcF>x%(QM5iDhiIo837l;Bk07Xei&Z$l$bai3b}#?KC1uevL&!LDs*3qiqa*3o0uzhaTa%Y*ATGYU&wy_SzbD-g=9JDK6CLETEP4kdC9<1fDB0&51iEx7Vw$b5NkoRr&$AJFCg!ISu1)Jjj^N@5S%mduurHpYY%ppI z{0rL!%vT2QDsSOMZC&q3%3Q;P=^5U&GX^S_dYLlFFqr6%m4KXHx7-XDop;87uZqq-ZMT>wluX9;gakNj)~cG9j&EM>E7PYlmE7 zxXuMKVQ6^YZ`Ieb6qrc8kG)zZR+6k+ZB@Ra_0y3q>^EVgV1@0lRd*!jw<}eo8JXA4 z`tdoh^WyF}xDEct?JyLHb!j}jG`SJ1x@%`OG-NecEh|>ockGadX#zs%@?lvJ={V9_ z?Djgd8uLEA>!ALY`yN(xx~9Gc%hx3%{DxcUtB(?~H=+YXI!{U|IahTd=4vNp%bWY? zmlAgMOiIbs&-9xnIrMCZZJkxrz(WYPBe%_-+G=^-kDYPl?;hfSL?wR=I@`fVWv>Ql zmUOqU>dRS_&(L`nb7E8PT9{%wyQ1V$bAVK0g3=L!7Cm6#&z86P{5|~)zx}=U^F5!X zg7WPu7Af{$3O?wwL=YgK&?kOm$!A%g2MAi;DfmU7?F1q7A$=aqK80FH=!}Tv4iO0< zG@GXL$CKy52LnQkxqC!|j+{IBZFK=CrTvQ6zF8=PlBs@c9hMs-s3i6Z`zjrN<+uBU zQ94DhYW)j?NDhHU%iuK_4(Y?dF?)NzLcI`d$inLAK2RA}R;Yqzq~8umd+1hUR@L&a z6npY`tSyWv&GtbE0z4{xo&n8#Yy#&5pcw<3Cqo@qx`Q^i`lC`0h|L6abw{6VDc7z3 zXdbUI=M}Qb&$;rZEHeAkd~BAK^}eY=xh&TgbTGh}w^%+fx>d*XLL;i21My0ChWI{~ zR~-q<%W_f>5rutu(@Y)Qra$nT1;D&OUp$+Bru|m=PX<0a%z`9@oD!gck<@Rnk0y-9 zSX5LUPd12^B3*v8JHo8n=03{%H{Fj~s|?B%Mv1kvopLqtdy5j>yrDIjpli1yd8S7r zlAST`LM-S?1_Lxb#~4N=N+Kw_3_*Xslhw2v~~lRZ+k_rk$mU z*z^JxDh2qaJjk<97MIOpW&OC;R>zy%@x!qj^`N-3xuc?%!c{ER#%fee81f^3irrA` zQ5IWq49D$ty}8zM3R}V2tvKSdzY3JN43q)c`D2Pjp>kCJf?m`q^!0EK|$bza2ezqPSJ7X4m!K3 zd#7!iS@be)%PO~1wygSu(W(SRzg9cfH!5q}n$HhfYtCXa2ZrCcjSjUmRW-hxl=^#e z9;{Y%^k~&edB2uWYVTiupA*EtoK%*YveZPxKldg)R)Vfv-Jeibf}T-Z`_oq4;A_R+ zET=Ts+0%%^G2iX5%1+Ez&bWc1ZfI5??^N?_H6+Os+yo7hT0E)MyUgJFd>l_Tf7as( zmo+FfBNuDZ2L+D@=Aid0~2;5@CFhl$}8~d^>kH~WGYqHqB`-Jkm2a%<&kb2<; zseQ*O`y{-xoa#+Yw#X(uma=OdK}GCECZ@)QC#Uk6-6WAL&PDjAmX0plln;`yDaDLK z%nbYO1t`EIL86w zocBH%Oj(v2D$(CBrP9HWW+uNGHYB65u)1=&N~)}b+)@gFaG9Z&L6&-CVJQu(ARZWM z_|iS;x09^O_6xsL*6RH})9pi*CwGPf#kZ6Wl>)J!+yRYZfWkbu`rFm9-cb21KOylA z#lH1~5i{WyVr@GG;o-)-V9_?z2qjj3i@RV^RemdmoYEdza)ZmoWM&6lTh;O`ZU;YC zxUY{HNN;C0X_52-4ke?|fPA@5{Uj)X^c&MjL;Znl3mZY?tBb!Y{TaNEDigVq&;&lE zuC$CNkM_+UnXL1KwqFMsks3M_x0kMn1{+VyHH_bf2=oMpH(pO&qtBnZMa1fBxgNp( zFHfXTLdksIPdGc-S>e$l_}+o~TxwZ30IPkMa^32OgFIC<7~Ds8HOuCwV5?%3wHyyC z|D%J^nSt(`VQG%>f;E8Jo7mCWq+#gNn8d0<%pL|q6HE?j@9(;Gt*A#ywe9re_lq}3 zaKM^w>u&n4!jqpoa6FRrh+bRLN?1PettFOhy^-p&g7NfR{@UGbFw&z^mGc4f3}|KUB@2JCg;AX@Ur#6h^`=wAN)2MpvJQk=4@+p} zSD=MUWG%=-@F4)MT+YTvKHl_PSQu{-L5w#I2!31d&eyP39ApuRw)$8lA_y}x zGYMDZt8IekR?0;|<89sZs@<@o8Y`vi7lfa(BnRx(==c!uT*7<8u2M01;H>+}o1g_{ zsHvjXBd#dJZ^8JXX%*HrVPF@4eR@j>EiFA3(8JKZw<_y1+D$85c|}iCA}U;+BBqKa zuJk3b;ROL0P^uD!{hURH--jH(td$SlA`5-B^5NcAHZ?V`P22tRxR$KXsE+%I*HC4h z7u{e-cz6Bw?yh)OV7vle&SYF5fGqDWQ=cf->qi0jo-$%qItBM_0&`z-J+cVN8 zL2O0yAbO^=1}`0`kM7UZqG)FkzF+(uJ^J;mMgPGfJV(!^~Qmq0n?je|0&_{5Jp0U2xqVvD&K7_6vF;;;{U>`@R63*N9KQ(Mmnik+wn}W50I$ha5l*!6j~< z-h;Z>`ide%iGbh2c0+Nsp(@LBfYQGG;N*cX>STU;Nsp}Q908W-E_OUMc|D=n*jH7S zcu$xXL7d(S4pQtxtS@H!5GOi&wCB%M`JuB1{FK15kB7tL)l{D6x1v4|dNQQS9W4u< zc6auIuCA7n9C~_9F}Y8L*nwUtO8#`_XQM^Sm#4Bp*{r$!gJ>n0^K?jO&7)94k}xCU zV3>aa`kfnHmx`GF7D!U)?7{}XOJ?gYc**SPEe!VC+&p(|J?u@?qo;T^RVz<_wtmnq zsVCz=>);C{j4HotU!2=ysn)7wHu!4P7PTrUD_|O-`JFNI=RFywS$b^$NZE!iQfumS z?_UO6i&{RcV8NX%2AQ|>tHEb1P|jn{ca5DLm#4} z0Hu{kL%ujq|85!@3B0F2DT|DXPhY05-89NZEh`bmw6ZK1p6oPgLZcjys=X;>Hl<*x zA^oPzKPjIf8x6In!Mn6cQ;ka)({d+kMZe6)@aZ4^?R10R z`pKu6?&+_>?~Lj_Yf$=ZHyZxTW8aj>?CDt6g#7+`U*19@C zqm?@F&jF1HinmuOar;H3!D}s~^uM54&vcN|6*cv$Mn$24GY$d@!#7;_lSfY~KpQeY zJ)Oi;d;13zkwztsA>tEd?jqnyCIYeTPa;H%6qaZnfgkk=BeCAk0>Gt~h?aU0Oh;5= zew5ha20&X?(7HXD)9?(c#Ozj7xpCvs!G#Rn_)2ze#0pe0ibJzW$@cp**%4GjfV6 z#3cegH@4&QJ5g8Ix5m1`f);T!Z~K>f0EpEAabpsA3gYj(m|x#?Aq&>JNj}c+tuG1i zp&|%M%o&=6+-OX@%KB)VNJ7tac9*K?a1hYo-!PLHD8IF6nCceBYGwUb5(@IljtT~^ zCQP9=Zo@C>Bog=R?(Qm8N0_&Njb(lk7yqDMb)&yk?1Zu$yATt~`9Y`Xil^Kd#SSP| zctc`wo&b_SA*VjBwnazcskZ1)O$JGuSXnl=uz}p_@piCN^o!QIpaIsw?YF83-vvGg z)`16M4|WfT5PKyEH*QnMzR7_GKI2^(AP0icJtpiyBOaa{NjvYgGJF3m%tzu$X1W@j zNU>H0Wd#)l2Tk@^d>RHAs1-!miYdv(5{+e#!J#;FLAgUi3=iAGHqV6tR7}I^YRV=9 zmMrf5wI0Y$%L`pyVtMy|U;*HLG)A30mE9Tj zTS+vP#C*n_OzHr2e6$CL#tsf_FoFHOI_V`mUkMCHv&-VNOlHBxp7DL*!YH=zz1t|Ba<*=rn842)6LHMCifa!J+Zo$ zeaQ|ce=65Rg`N`~dxiuTt!T_AYR9PtM6@6~P^+Hb-JK=jP#mEhD$9vHR_A`WHW5ee zsH1XhNrEqD5*%6z|NSRi@C5nmmqXS?;Th4gcF`vyfYAU*q@hJRVC6@VweGO zM|FUKEHTgQ{}(=kRL+F7=O{N-Wux4^(Dz4Ft4vRtFp`-G%g(N6`zGm#C`N@)#gz`raL~PuVa3bZN0;+hez4=?z1gq(*+n^v&%-CCbU9>DS=ONdlGg`W3}MN ztHd-{ddDieKkXyzg=+i8mpOH<e~<3L;q&w!lW5sHF(qi47{d!rqsNeyDkKl+s`_KqDnUHP1f<^%&W#dNF?#=WcE z@T5VdILA=-o+ikB%QRtsLR!HI)tgI!Qm`vSY(Z&Ah26Qn*w9#Qr4D;B^cNxa&?qBH zM0`oUjkj_6{L`_1dI7SZO+-uIc4cGJ4AO)yLWWmjDBF$&<9n?+y`4EY_zEVJ8LcHC zL~WH@eU*)0q@Wcvbx1yM{J=!8p<{TPMeD5oEz>rOeMLt6g-C;46*&-xh4G7$weddg zLn848_wk0uw3<~>9mW1QirNhH*>>e8x9#uE(e}-V_3y@e1-Sl^Sygh)1{HzENx$Wi z*!e#IrU3Nas6|19K;f5T3Zk=vF)Gbq1BnKJ&C&p$Z4R!*mF<^GknLgnWj3Pj+VM{P z8;pVRP&TKXns`rViM=sj-@ABb!&NG*ilOprnn1M!CeMKmlwO5BlHn08nEmD@NIl~#K zCgvh8$eRn|XB}F@NX~E4WX8jRlzn@yg$D1{(ZTZb ztSNY=N3M$LQP|Bt{Rk43pIo{SQwz_l@94VLP0q+dKN30(?~i;-*Snx0^-f}DPB#T) zozZ>&3OJRQ1nd^Hp*0h5ATJ4U+>xG5Kv@S~`ch?#P_+&xl3)jxVKC^9#XW0{)rJI* zF~|ePYFj1%gg8D4Stn~2I--EtiYlF|roL5I1j__%+guKkTBo|jXW5bC&9`o}N_ay* zy=54x1s?*sG4{bT1Z~Ulbdj`mVEqt$f32^wbs%mfR%dy}Tt>`+ZQ-{`ZLvY}Hv7|& z_oAt2%M@zL=e=myXR8vu;EGB&A;&(evZ~&1T9*ae2){vCb&m+U`pSf55D!k34>vAP zl^(L-t!#Dhd5h2TEqSMIbr74DKjs#v8uySXoMdI)*kpxGO}nz!^{Ro1%x1ghDU)Ft zvOj|zC6Tty>MHZLZdRm4EQVWW`+J~^9L$PJIHBKqlvx5`tH%RY0b@{0=`)p6g;jYL z4p2`)MvdZtig~PBmJA49kKi%DTH0h=vb`y)RwCOIQNqBE>RLH?17&Q*PZ`H?K02XmPQ{rRxGuwYC$A zMYnEx+E(mzTojp#)R7CuA)o|=vV83(M36{nW`TO%7MlNo5?(53bZcpzjBeGTDZaA* z4(v<^5tL+=@7q^ycU89D>=7ATPo%URm4f!kJ~mt3FiTCUfdqCUQk9fwV!gynz>Qfu zM|CZgEW%qGsKh&_6?dm{{b&*Z#exTwu7h28K~^_zbtV0lSR3`54|3SvsnH!ed7%ME z=<|ePZT1n-%%oNZ|K|tXVbIdXDe=%ftG<#hy(4~W-Nt2~pcRs<#-LtAb#gO~8n7k5mY3{IiF4@v7Io-J%hp|Z zpSQ@&!v3lTu~G$USF6gR##Y;i%;lFoJ}6H|XIS zg_zKTvkSpP11menmGCJp56R%v=O@k=__<6Ljmbj0+IuG=5YE~vdw#UQraNNC5l*)tbF+ z#MyS`&xHcc(g|~^_gS>|QN356+%NU~+!ej~91<9-1qlFI8=p_I*4>fHwEdC`bDj_5 zp1EU+f1~}-Vob{q=P`A>yL-%YxBBv-FpZwJA^`L}L9t)m$ky-kJ9>nWLu=4a16!4s z(H0>h#kPBz0Z_K9K|YtwwE~yWOnf*AnkKoeyC?+7do1czFC_k8yOq_+x;`an)ygAk z7{hWIcom)b4kp=8|q)jrbyVi9vs1e z^1VNW3p zhp<2Zp zIqfWPi9Kt!-yj`xJHznhI)V&uzIWb3dwFtiZ{4vdO`rLA;VXY74qx1oKyDVVvKV$* zsKR<}LA(+xIF^goy}dt<{5x>aijDW9^cncTNM`lk)pFSN`Z8D5E54`23JQVjQ|Y*j zS+;y~bt)Cydt0=m7V%V|q&JhRud(n=9PYts(duel;#yVuxA}Cd?8O6(#$r4*2mehF zh!D$H)Om_678+bkY!T#yy4Laj%rKBs$cx8DSF=V-Hh+Ye2U7^NGK^&&z>fKXB`w3i z>^;NePo#Lcq8*EW<$KkylP?yuojt`Ux~D9j1JY|)Uwkh$Kyva0mkAS-MphhZP-ShB z&pY}}GsJG5&jOySL0&x3aQTg$hMo5Rg;~vwZlXahE%p+ky>(C9pi7@ti_kP1=h^0l z64FWd0~E^Fjhg*p%CcwErEOHE$~ZjN-h&1;uRxw>XLZnoXSSqxrBW){OPye5$9G|; zL-aclB!lV*Q~tlzCbjXb?J5#@0aO4lD4k4vCo_0IT3m|>m$d>q!3yZ*1@oWT_J+2T zXyEpM80k7Y)i4)XdcE==)hQg{blI-UdwOf<@uP(3O(K8k}5H8==b-W-}PZ(8)bPU4039*%tDrC z)oA$<`lArePaB?=9w*w>XyL-n6j|_7csWpGUbW+Kkig0ubxPgWlqzbxyuzL}Gl@FD zRP%8fuil+cSuPJ@VeXKb`7;f_6Vl-AsC0H7P>n!?%)}7)KuP-OAX*>!q`4Jo0v+X> z0VW3-_5u}8V*cwS;b6>fSXjs$7F`Uof;yo1(TzDl$?m{DP^|(b->frViJyPu3bdy` z|6lEWX?qh#)2=Kz$RR)oSs)<^!Vqu>3TuFeJc%~TvOt!M7B4K30txaWyvnw0Yx(Qv zzN@=y7W1C#{dhi{zF<6>>FTPkuCA`CUgpK*B{Y->7x=!t!d3u^qyF>`tN=JKqRZKNb3aq>ro<7XR+i!*UFsE09?SEZl zll{piYh}?MN~B$cPZ13@Jli}WEp5mEE%pODY(XiH-P8yswacgCD?q4X zGbTJoj9Ks*Q;3C>g8AAB!#dnW&9XcZF09{ZZ+e;moeA@0sE2RM39Z*Cqn9G%n^JSB zAjEqNUvZ!eX^cns?8((@%E9eF6QB*Uk+?I3Dm+S~M~T$^$_Z5>M|=%9ut2Xpco9Vf zI}9wqm0A7n4wuE>&f#tAEhaHot)th-61_uVSed+HMv~HNM$e^CL!Yn{mnc@ot$dG? zS5A?F*mY7cg$bw)S?DHluE`sG2D2x=A`(Uc5jFDC6`FYXKE5(R<#t}cJU)A^KtoAv z>T_^1SI!aTEVUdrB0y*poJo_#&{v>ibLj}N}6D$v>8K9OX+{T{A7oYLPRXS%ePgDPc7gp+3!1wQ&YO3N;&lq;r}=$#I;QwsJ~bZgv-Z8~`5G)kO4Vgf?a@ z5s9x}7aStbLL?mbmD?0in#Ap@OxeTlUb!XBD6s;`i~`0uWVPRm=rLBnFxARqi4?J$ zen~l{dkuH^6dF{YnXa3N;+edl-u;|o-US(K*ay%45skOGE%GXtbz@8ku*AQU=1=g1 z<2k-GgbPgU!e>BaVnOVeE7?R8j8Gx;@3>jO3-Zbv+7|w|h?oy<29QUl&1TJ&6z=1T z8jsMO_r@Cbj9H8y&;oy_fn1m)OuPz?GmDuGU;1B^0Uoxg0H~TJ701ib{kSQJtBuSMg!1VktlEI2p=<4TR;HM5$5()4`$8 z+uFwp04q=ndy?EvYyHzMlfS}cf=Ix^< zMp(Ikg6H0(C`j{yM60jlC)*s$fFKN9yD;`!3(owL1gG(%v+S_EFa&HiYLfz~7U_H8 zAs6cL4$F5~bGVGFn1^r`Lo{Xe-i-`F1TmJl)KUp{PQx>t|L#pVFzK!$bvsd1)I*UgsVUyYD zAk3MyDKKLE4h}wByDCHKKa=s6&*!YRfRxx0GC0V9_Vlv(NFYWBs?1uZkVmFOBr0DR zL|_^i9Use*#`PbhySo;%TU~3`EO?K=vOH=4aFQ%|5gkAg#UOuA=lDH2(%A$7(5}U?{xP=iSwwP{> zN?t!kvUEDnP5U7tceoE~TI)+z$=c=~RH$84;)D0g1pTsk%g89xjdi-T6FM%aXmlGguECG?fEFS=;l`922GZyVQDkwDb#BChK zEf+kKv#7;b^rRhw!&+4`qmkEtW>E}^nOP_)G)1a-hJAcZs>-7j#@%tZYm0K+Z5Wms zoi$oEJb*9$Evui$wtrEZYcS9*q55EFfagh=r;$yg^D+`1Y& z2U^zn9YxD_Qt(rddQlG(kEhXEQbG1I*3I;-4=QUqeS4z%+FF?Sx2+|VW+{4~ammOT zhGIWWJi7wjek;C)Z+%>WA&h6|<=O2i3Z}V0u5M3JxMq=M>DEoI@WZgkw?E&WLREQ* z`XL-FMf8m91itk?zII3{#{519O-|)$jW)cGYndUR&IMJK5eD*allKM z`z8AmksWh~59-n-gL}9>0ojP-J5#uT0?z;%8qlZ|xUE8X-cj`5g4>r6z z^39h;4j5hsHIew9iiMta5RfZkOJHERj1%D2Cs{ImN#S2iq;sF89PrZP<&c*nyP5tb zKMeui*+kP6B3~7asfS45+0C_nB!;h~ij~U(j>$=c0U~i8EHQD0X25;ioqh?oY8_`C z#5;(`@^UKPp^enx9PT=2R@NW7g?Al(-?YPkcUh49!)14pkO%Pl`GMeT^7U!Chxj`4Cb>83p6O4sHwLU8) zQ;o=($=JXY@3a|!kO0ZoR4A|orchOMg9=Oe9gb(GO{&teitx@2jDGSpBW&y{qIgTG zIlUS`;yfgM0%yU+JJ{}s3riu#ac;6i1Mu?|p1oPu8p*LXcUemlwt0y{eLpF6vW(q( z>-(8bBQq~NW%%rKj=#}IZ?O`D<^4wbqS%2lc3Y8OqkcY4oW^UCcI{y{-r)gI5qtpx z+FK5?lE~N}|HRkd^8-Z`nu+eqRuB0PL#-D6@Az z;x2)=f4|_{tCM(h^*Tt!j;gDXsR=X>VJ||cQ4cf}<}jp`c;^FuZiw>G%ckg4u`EH$yE&d? z-6t)Kh;;6fyAtk|TAF8Ay4zWMlz?1`A1aoS;7D*P-f##lC;>3zQJJ^ncq zB-_hk*Tzr8J6oJ&m3@%Wdl-cx7vJM2PPORVmcC#vLr^)^f_~*?j2DETAV?f>D1RM@ zvi!vOi(|n%TX+_2kros5w` zr$bc>(*2OHLtDNxEjYMb@e|Ca^x^fQ=9UM9#S3mBEk>ZF#--uq%oo^2atziaYMF(6Vg`X7iR<8G&PbH8C3H&s zJ8z1LrX!<+mV~$?SMfB0xE^pw5KCfOAhEM<&X>Y-hMGDZ7A$ugd~}5*jWb{sIh~u$ zl*{>2vRtVrtNB{JQq51Fj+|c16zjJWIs8iCO=3A;Pt4}4c_;~h@M)%6EiN#tq_Kqg z>#nhJ)+dsVaGyD%hG^g?B&FTyxh(QGHjY&o`D!^+0;`aDDiT4yNHoW;Vz_OaS=@vok<) z4@)gjY66gWz|4>=oB0egpN)*Qm^I%06W7>yy*Ov850p~<)Q2xf!3CGE_d@cq-5XUp zoGcW*(-!(Q3;jkjv#C&MreN}&)k42zq2IZD!%4|EU#;ZwwVEvynQfszu+Sgz*rwsy z-PrhCCRfE!(}5&8N}){KAFjDV4}Ke!kuST95H9n5rTH+y-2QOWl@^H%r@*Fsd7)UX zl;`s0I^PiDYyM%Ye!z~Q#Sg#mxu)27rdG*GzHhW-?5S*jAm6-1k;>I2A0h{qrw^Eq z;_s!{_=`p{_dHn@VZn1!@SRfdm=us7UUCqixVp^8gt)8_|0Tp9k+BwE#gAbdqbaax zXs*6IpHJqP`3GfjhAhsy%zM;7U|q3ZlS09JOL(4yL+|+#3N7a9o-m-7+IB0l&}XjD z&59ISDwdy1p$RRt%tHCrOAy;xEON?M@raZrv{2ad%?~wK=vEpTV&hN-IF`<3hI+9S zEHLw;%e)PCBJ*^yHdj5h`7Fc!Vcq_9`Hpj=?^n6&AXxnX|}YGh;s1P~c_mF!KjK*AyFP z=s!aWpyDkB+oWJe^F)R-OCpn5sSz}n&9}#V`wsabV-m6P%FIkHuN~rNr4)znH9s7= z%p1^G$Xv)JryFzgxKBq`h|spefSHFF*7z(QJ*{99_zkW#s>K;Az&@}I*f-4$NTLP% zhtQg0_{6j*!Q?`wTFhiiwvD8KS!6ScyRzX^hjKNIQnQEb7l~|C-ABhcu z>C$iq+$h&)W%x`YikPhM|4g!)DHkBcLMa;)eEE4aDr~?=bZJz7f(BT~=P>RHs7Ule zu~L%rADPV-u!LI_0L7TvprCmv7SC6!056u4xysx;r-g7c&2|hT$9Fah8;@jCixW;r zxcpiy7a^DKXXveYsc*%;@G^TwhJBVmnPV+nBJmB(u0bZ}8l`$MSwjVJoTUj>xmn8@?n3%)uT?&LeD$5jTkPB~iXsmb?cfSW?NB ziZ$v2oB0WDfe7=J%?ss3^R+Ur(pX6CelRX!C|vtn*`fduww-~9)1P-Os!HUz@QGB8;CR+Y+roh zz&6JOTd7ic-eB(tVLKui>^}=;?M&uF0^1vb=AvbuLrS&E}^=*d7v0npbl}l#3|bf5j(Y5#Zr-AzIV*$vsy4e9Xllh zRWM(h`J`f6X6#fEzD0<>b>@Tq^QG7+S{b2yPPr^+1+qy?u?mI2;4VD$QP!=Z2 ze#aH6Y5_VlNIeX`_SR#CP>W&<<0>Gu9wCCBlA!-Ou#2A%i>6rIR@#kfv^yJ!^=P%` zaSMf9gW}%GD3K*R6}JlZ;2fGH$b%G7VkDm;p7=$LJ#5ilqZ$r5CZ->4Jtx?lf<0Dj zivk7*HE7aVFj#`kEp$qYjbn;UqvCArlo&ukPJT*GF1cLtHx^g^B^zb6ACnl;>iKeh z$reDMXliQ)1L;;sC(1}{<8Lg|LZl7E-!Njf-txJoSe&+S5-O;kpGyjvcxS<^=)I@t zwUrS&$bbk7%*$ikJCFw7esK%_ui?fe`GYqm#ZIAZxm5~3Eh5WAdih(s ziiqpl#Ld-wR&41uZ=r+P;{S4Y-y(9^B9i!abTkQ(2a;q7Qd|llq9wQmC1?uxc22=y zv{9rQWkX&NY(HOd9Jj&MO>4mTu#6cD{_sL0gzW#!rp6vUWYu2{7BOhawMj%{yGI+T|$ z`Vayl?)>3^cgsAs6w~duucF&;-weUdPnVLgYpXM*%3?Cxpuv~SFU@8e5M;HHOi$T{ zI!tY=I^3qTNq`P)M3;5gj1X@B#72IgG(Yq3j!whI%vBK5tCW(3R6usO?-LB&-pI!H zKPhuKC?ZzX$kyt`dP5Bniw&{E<~Hm}1BUNN`V+7rke~EmlZ!Q;(|%&-#*)@l3K_hrc5cPBTM*EJ2hnh;m8HV>BYuC0-Jd2qH?f9_6Wf zrlc7s7^Ras22xkYR{#oitu@c%I8b=WwK$ z;p`FzYD}MD)~ss7V790gQxsx?cXoU+K|GDc7c!+rJ~;;knat)9&LUb1Hfz9O4pw&V z(3f057xrJ4 z!P!a`PH%|F42jJ8fLOOOgChv56mu?oV5oJl7G;4bXB&`F1Q$3?sD8mWaxic(j4_jt zvLO#vBIKvJfIj5GNK;!b*E37TUNVgVExcTxMeK;9a-jm7P3yY_VDM^gG`hLNj^QQ4 zT^TsVj)GC;*|D}!mRaAI9?U4#Ghi~ymaKEox6PPFE+B#vytvcyAaG|OME*Vbb#Y{+Z_q>9A%N!;R-@`)5LW<2OD-nB3WEwfZKZH&f zcfYaO%^xcpcJ>kGN&sT_J3?FzLD-oP$U%*oq%rRagK5>>D`?f-LZZE((aD-d#ensx;@N{70s>+PEJev<%uf6Nj zdcy)n7iU^3H!P(|B7fwN?=ngU%Qx#)-xf+gdG~kMMh|qRb$5Cc-(tYtQ->DfPeP;> zVqS4j0sv9;6pDpFl%&0j9%4lF!IDBCCm`X|;D@ zQ(1^N3b7;*znp}?Byf8do{xpl2*K`~;XB~C=L_fCdN2sMi>Q);c&Kro-M7QUdE3B~WD|0>;TOmXzZtkl8`%uMEVukQEUSLup zSbgZf_O9x`hbf1sYxG~PazcQq|GKLG9u^eh^yoR3Zq!bQW0(4`tNQPuihS4Tzfz?T z2~yRi{_Cp#d$^!Dz7mFI>X~u~0;;dwJ+BOVuMkv%@J^QI!#FVi+wMZ2TH#Xbze`gM z&B(7<1$foP)Ni|s_@9CJ4QrKK$ckk+*94-9IkON1LVxY<6@^g8xXU7-9uV;lL2x-t z7q*_op~0yxyC7m7)od6C;(zV#&kCXbWtW;OHoioVU_IdVw!6P7#7(US?KSY~#X=Z@ zny~voA%0c}6EOWBbYd4qV6zL+w3R`xws-fn0E{X?IhTRE%4K7YQX|h@c&W`UdWQu& zR4}XhGV@qOhL#P1(dX=NqBlZ9<8CMnd zC!muvjk1|!wgt>0Uo^G*6hm9LqS&ChP`6qo-08a1o!y4gm-etIgbV3`XDGS5M2MGK z^4rmOEgL#O7$#f~_&Ck3D#1tST`mpJ!wm4REnDFmTm3r0pb33RGwTWkvj78GY|Y7h z(AS3j+?B!%^l$*n(jrRER8Kkx-4C!Hx*I-R;FUsPD3*m0d>vqMcZV$2NMIMCI} zuaK|Hnk&U?3fPOHfIY~N5yB_`DBjOUu}hpc_&C@E!C*>Sun!9M)euuwAh%qo&ywDN z?C#O@+dHpds?GMk8+{5o_n{|E#r3z7DK5WgwJzl!5efq-WkhQQQsd+(`( zc)F<&M*m?&PZ;74LIAa)>gm2hASYN1sS86u>$Ue(PM;1Gf`)=XXtdil3cTL-9#pBp z@wzjDu4rcpL=Sb?ycY{?d)A6GjcP8YXkmwL#AVY$e7QPQk@3&_U)1<1z!mtFy*&Ppu4h$Y2^q>E3?=-5}Y zu&hHgwGSm&*oQgjOF&+!BxmxA9t?u?^H`2*qSis=@Pt$Q2_HBlObVDo$mruG1Pj27 zL~8$rSHNgzLgr4ArUqn$Yoj!Bfo7O~i~BSsy~K&WDnfslbMe7hM6<{TFvkD(X-|3y zvjurfc}$1km?6j}7=eX-T9#h2p$MpO1atDqY1s348AJ)wud+|`(o0~D1CcO>Z|PzX zB{X4SUzCah19rAp4O1IL3Hz_IPs`FvFiGs50mL1#(3=w?m3c;dGqR4x7O(^eunBfu zYM(05OC|#887RUo1Ol~KuHj?{OmbDHlwB26reye8QZj6_i~DLZrWQN|xU;iCGexw9 z<4~BLun8;s%@CN&>GSr-?B|6=meW*xZG7XBQ#EgR41(9J2-~?Cp zJCU&#;o|$o^_8U?2t4Zg4Wk(M5#n#|Z#$)sf$}rsN2aL-z-i^EmP#8cI!SGG>^|o|_Eq&|w;alY_^=9FrO0J$7Mp=Mz|=?k0QRK8 zmeYXC!5P6J`X>m%3DAQHg;-G>7Yu|^R^e(Le1>WrK%ZJfy6pVm;%H$Oq}k=YA#NOe zK`^K}3%0Jgpe)4VammJpl%n5ubTgFdTQ+LLO|Fo*BGa zk+=nd1bh<2mLeFGrfE=|J>tMh$cn%MhnyTI0BF2A*fegz&OF9|12}~Swop^p1-wTE zW$qZa4$SnZ1I+q14`@o-G0(FHd$!P(K4q7_`%xfcbGE;g$sf~ z*EJ9RRj@tf6^u4uE75ihQngB|))hiMssk8pfDk*z-zb*58$`6_z{*~O9*vggxrBn1 z%EMv}(zi>nJq7zj?=*N;KI3Tajg6wv5d|$PSkxhlf)#1RqO5_?UR($-DCGgL9+x!t zq6((5&7M(xSqw^!X47sxs=nTY*}{Ue;?LGkT{1@!nN|rR5WX#dJu!2Yt#~ zM&c0rv6kHRZsHFGbCIk-3i1zYiJQGi1@qaW1dH44b#BXKW6mxzbEV897rI&lI<_bE zBnC+VCy6V+3Yg=~KugltaQkm8EiFJqQ@teCPWOH_;P#4A?0R%8Bq~Az?W88>RcA6K z%znd|!5pr<)Ve{CSsoO?&7Qg_JsNok4x9*+_HK}Mu=Pws)jWxv8T~@xC*LfkR)*4q z$U3gobZL9Nt=I0U)~jjIvqugxu!>F@#DP5$?H=^0rRrzBgCFlpGM8_= zr}EVmHH(a31dZ9A_*VhDubFl~rsVYw3582ER{v;YPoTWtNmT^aJ13ovU*3AH4%mFZXzLg4I{)(Wvy20n2lJ1pE|PL?=EKa@e|2c%rF8 zD8a(vm77fG&^vWRRCt)RahUe{ix!T!UfLSQXKUbp`l z;Xk|yxjNL&Sy%i1@PUBIZV@cK#KbBMkRVIw4j)3{ktUqu9_1gCM%z!Qvn{j(vncNq zaecUo`)26 zj9cVgfOUsh`qDmx!%I%09==8%eSh9)8YhBcry-Xuz&0{W?8+gI4roaMht*MbiPd-G zMX*LQtPw_N%QaQ-hiq_8=9oc7aacwm64*S1AX~7xFbg+0xqtd2P25Swn=$t-0yqvg`%$m>EW59aA|8;4!1?owQxITt$w&XPOfDG7< zi$_tHU;d)L2!)|hC6ZO6nV|dFeF998iKdRA2~$U5O?aXJ*O#?l254c!qNuY7PaK^K z(L#*Ld?`<@XjjW2A_)D(z_DYKrR6Kq@^z>H<`Y1PjL7OWYCqHG?J_)qSiV?VE|Zq; zLq(b4RCFfBuz(PnRy~?Ts~%nRz(y&!S_Z6Ay`yYo5gy8U+@kuJ|0oaD5DvU^1nuZcMxLcg(uOCu6IzxO z$&zP2NV4RXY=>Y#!6JHsTkswuSo4U0UW&yTEy~jp1LMq|gM2@dJg0HR4NlWS6Zr^pG8F8hN6r z<0xe4_=(~$PB3u<&EMlk#GzK-OE_YdQkC{sUu!AF5$C`mB}KEO(;rc?c;O;19>Z}q zrM&vdqj>lxjWC~^*O2OlXvR#);<2vNI<60&Z5h6B?1{L{R!YijJj7BgB9LP55I*rG zr@fuphQDAHITd*D5Q!Gxz&aShkB=FZvdk;hhE z-h84&8YP%135~D~g4p2tHv6#fjF`R2DVR}$4PvqoW{m1X|F!$7|K7|f#1F!a+^oRh zK8T3=uYXAq!R7HKJG2>5;d~y$iLLa7&~0tNweVvq636 zD?ng@eMP279hl`Glwh+DE*M7qrXIdxg!pNijN)h(&xlTzvu^`x{;kdSOSGv zSuYHkMy_b8Pp_?CR%u$oQ|`U4%l9IbW|D!-Q1Hz@gxR##TU`U$f1_X_w!`&p_to`% ztB!X6t%Jzqa=3M177;aJUtQm~zbkz!qj%8bvai>u3Jx1q;7inS3pkKV;zfkFi!;2AZCka)rX|>&dn6J%+cdztfdd;ra}kWk2nG?+6Yh^3#6LN1X-3{l z_-`(}u_+jDXIZkXk;LH4L#2f>0zP-)-VAiX)xb=Bpf$}=dO^YmFd>=)n39I@e?B;r z@)vjoOi!!|H0S^pZLunsu0%|;uk?g>C9E;A@zaA8*nGc0BcfC>^5kqvAZ6lW;Nu;0iqIJ~CPE4qGiKnK+-j}xm& z(*_YN!NmdkvV~=@_L8yOWNfh8viZ&;pT#XI4R5Xu_oW2d03x#oVjK#wxY zWAGBnWAKV)YC;>CyqJ(ce+*gX0~lkA0~mq6WV*(qBv$l#`|dc^AWGBfK1*{8aG)7B z;p4%39RGmDOv`eBsh-bZ3Kng_?&42q%X-aK1yd}#L0ws5s|AO*Fwo%R;24D<1e~v9 z%wvvV;~|pJ92~d?SiKP$YY}OjdeMTFEW}+r0rf}hjeUjqMIlZJ1j3{rMKl7U;h2J{ zK{bSy0wPQ?R}c(m7!pd}5t+tqG&TGLY#+uQ?3&K@4UH1yK4Ax8h#W$PwTEXF;tM76 z8^MM{d^Cngp5}mHmy~AbgM%^& zoB#1pXwYIP*_<%r2xI1KNs0xVMK-hy;(wLl9p&zS@D#=;PB<<4=T0cf$V}sNhzOsp zD#t}H1qMS~0N!ahNp(Q zXK(mw^bSPcLr8GmR?A8(XTOGvjy|}dV=ZEh5BbNONtDF#BVlep>ote36)Z|$db!f5 zCIv-agw@(AMC1xxkwWLNWWsURl7V$H?V-+ptZM*gNTUOjG%PSkIA=YEYWl5f>;^|w z5<*PjAOvH0L)eq1Db~?(dn{1j#{k!5lvkpkRbuZ_Saqv?Hi5HX{$m4sc^M!9qV( zZm0$xT@VO4O*;qy|F=Clrx3T91+K{@lEsT{mQj89$g~aS?d2!|DOZ@4{+fB0I(7M A^Z)<= literal 0 HcmV?d00001 diff --git a//mdl106.exe.3 b//mdl106.exe.3 new file mode 100644 index 0000000000000000000000000000000000000000..3ea621543ab8d0a640910d64d5ebcdc56655959f GIT binary patch literal 250865 zcmeEviC+`Twr-`95I|HE6>w}2F(3hC62}ZAkO&zd0h*xDGEXXsIJ@(&zwfIa(&+>? z`<(OMz3*PwzukVRTD5A`TB}wKUEM9hhoZh&@K446L>>_lLLu@BU5KkhexmC{0k0}V zE72uSM2HB{6^|~&B+>PY5rH4!9dI%K8iWXcw|<=ed#-_V4V-J>Tm$DCIM=|r2F^9` zKTZS6K2T1T=aB<32hacac;4*^$Jt{87-^D42 zcJQ|g2uu2iRZh(J;=ljk#b*5f7{G#o!@sNZvj43lDe>>`i2v8*_uUQDFXGZ*FGg!O zU0ql#mDH8R(qCh$5b;MItX})rYhEc_4P!|w)R^!*=vzVBBe>@S^6~P5)veie2+sa@ zc%$AY8JxXHP0GvHZwYbv`W;^G@}lz6!OQ)s0++A1GUF*P&vE4ahF8SfcqXaHfArt)7Xpf+&Jtvc`HQ zmyyb!|L$Mz-(_%K{#*m+8aUU$e+LaT?fiF;;#`Jv4V-J>Tm$DCIM=|r2F^8bu7UrT z8cZ7ngu~S9to6)HKnniu%9$?uw=%Y#??7pJ5?gUyKP63r9fwh>L3#X|Vx$ z=@fxdPzjWN&FaV~;{R9>NxueEKn)}Yaet@qaVt^8R#;4rc}t~{PI2KTSxq3FQ;5g_E{7vA(Qvh+6Lo4#Q@bD^q*8QQYzS#lY`-<$Q=3H7q&g$KmvBj5QaiB= zH`^HyJ-t9-^#*fCG^CASZ(#sGr%;Et1Xl68YFs2QuPWGx8;~0hog&gQ8*3Ka2yL3; zZfN9{f=xJ8sfTDW{1lNuv)(rr5RHA<+4HC}H&K5fF$!_-a<4R^)`_O1T93=J(uS>l zWITF|vMm(1!$!|l=BhC$tBjrrZ2I@3Y^onzQX}1>p=%YQDV_boUmCcCDyeL*){mXo z&hF+q&+MeAFLm^SMtu#midzca&hC4q5{r2UG8FPPS~Sa}O3)S5lo=FvRRs*BA9Qp< zG&Kn7TpY?)1Guan*2I zO(2oFLRl5sy#Tt|O(%)P%4VQAb8QB7tu%#bdacH&IvYuT^c)XuB!J*>T|yBsa`Caz zXq@tDP$R;7Q59@Hj&R*&^F2hjU@hSZbq9(m_>f3I+@@)HQ9D;lC94VEi$np~SNLh3 z8UFN;Zbq{_%+r639wzl%7!+4JAeExV2E}!?GqAWQk+W?9A(?v3CP1BZes-6IwMsgv zL~PVkb$7*u0bUl=PS{P039sxGe%c%iT1z^bFZ@%|pi&k#npPD9>OiSfjG*U1IrU#~ z@v7r6=(ZuVGAOR1cQ>Ue=~e1fkv9blS)SBin5vYju@7ml#bn@l%PZx(;S5GvC0z^Y zl9FyL20HYGhW!CV8umtL2;vHMoOCNq@pwmw+mGRJZKV4-K-9$+^`n8x%QeyPwUWKz zVYVOm(5&0Zj!w9|#!G}J_IiQ5V9=DIi!QTXgN}aCFbfhNGqhU8P9k3VC&a}Qh#Lfg zAS|OGq|t%n(yA&Yy@K=@gHcxPq;`pT$=R1#B6*o3l9xP@ycCG!Wu8c07KnI(#!<&2 zT8|5KuZ=~77?OzLYe{XyrSC7$4X?o{G{rTB;UcuF=tu?w#;`dV!+b!?j2qf(RZ0qF z<0eU<8y5x6+8APV^v-sPEBb&mcN}!l&HzROgvg$v?{cX$7)K~TMUA~$5TBSPv1KNw1iRo) zy}e*6Z*B3S$W}&Bg_sIodvsl>gen+B2;{}g@ZdKyn2uNvf21dJG-!%hh(W;|Ar!R^ zdNG|;<|(q?)ka)8 zb!eB8dZY`mm4;L!5z)9(gc0OmBLV(@F+EH*+6N>wV-G$XG? zzZ@L$wP+61|`8#*j**c=}$U zm_%wJ9_+G4jpl}O&XrMmp_*UbxI*0N6=@;^tZDtn9k`S>3}jWsbnDU zSgQCbigH?k3Cn~A={+jMl~QHZdJRlzJi{$m$A*H**aoIUrN<6 zRm6oRhL(+TXbHvye4KuT3+5_Rj_fmxQXc7bhKrKKcD>$ZT81r99#0yoyKsS=w^`+7 zqJ0}3+UQuKWj1Rt<`Z7d(x~Q*RuP(;z9R^FSC|$=koK;stZ1VfHO*mq(0$O7-24fJPaNPy)2llt4O-^d>8cdZf)e zRC1<$* z*wfKjhx6_Nive~?c%oz=F4}1qJt%R}-`Op^yQITpCuo#tcmyHgFUW<~JS$R2q!@qG z{0F>+kcb!0U0l3qkMP2ugqOKq)F-@tT$1v_pGjsUNsvvP(+=nI??pBLUkAGs#Vtrr3r5kviYe) ztY1vcRp}7vflfNR+NEIR@NwbQ1^KA(*8VPBU+#zt@5tq{Ex_|i0WMbyaIu9F2wQ^I zQzh_N65Kvff)A9S&6eOrr37s?B)Clp6k7uIWC=Qz;N9hV*uSXY(yEG!9cs5|8k2!x zD2{eKtrHi1JqGHT(@D|=lGY8$DX`aCd!asU}LO*Z1Ly~c|6Jdyp34f;!lE+=p zBr{$x5MT^JGu18)i^?uvN{S0-#ZRy@xICa`qWJ0AMQCrjPtK2|;L>C?N(?7vP`L_{ zL9|lRJ&XyEXl~1ML z;>&YbQ<4kiuSj!Jl+_Xh%kBM8d|1xft5__=u$MHbqT?thIL3( zD*YVgK}_1@MeE?et*5bpTaRZi-srt3X0rKwbSe=FO=RNxmY! zX*Hh8M{~JEbS@ER6}AvEvoM!RX5n+otaPML1&PKLX}jpgc{2hlB%qh z4KO6A;A;vsk%fQ>t&qsX^AMUO5_d>CyoSMnT z(Dr;zs%dg2y9j@n5QTYIva!ddn~7+qpr)hK33W21&F651J3%WVN&D0y&gK#sH*u;N z>`Spj)`7vSRU0Qfx!8BtrGtx=i8F=i~kFp zRWZhZIL7%trH}rn>mbutyo76Uo`6Rr)O=xna*_&nkxWJBV(3}wM0RE-F;QSQ$*bv9 zKA*}=nf6JdW4Mb+f2n077yC@MfbOcI_o9D-v2e`P(Mkgi``MjE)G%A>k!gu2=m1+)jiOf8<=+6JnHSo_h;0X#*I?fev)VYiX zEk2$yQth;}BJeZ+;LpaNtmB(l>K7gaiqhBmBI-S~b1`2s>5yywmD9?yoFhyVEd`w; zOs)Qlw4vzm;!mh$zllb*uoPEVklS=CECA z^E2v2t}8qne*xS-q$B8hT)mEPq`H8|rb4RFKzWFQ5(ztMbwTo-9vPf$VYSwxq3a(ZKhoyxdqnq{cAp44n3~>A^nj>`sGGSVqK8ZyBnmQZn5c(njHs9BDbb@+DW|_6 z>SGBk8OIAD=EjNoiKd9KXRqt8i3W+%M2}e_M>IqvtuV~oMW&4q6^TZf`<7^owdq7p zh&G7EnY%;ulqIC@pAmgz+H<1ML@!8pO!Sgz--%u^?H5s)s6-S2dZ!RYLHDkXD8{q~ zq6wlVqBwJ#i4sIDM3cqIFa|2rb+K3s=ZCf`B#;W{bv zJdu=C0}8;~lked7;Q+in`R*MNyj^>@2~-aoCEvl@C5pUzPXud?zk{A7ioAn%!wu+p z`nx|udD74%gt{h(aL+rq1|NUY(84q?5q9a+HF*1z21JCmHE8@vLp$~#)&k(ts6&5i z(0%v<)~mU-i$ogH6{01`vIf5oUxXLyYd48t-{cxJ9=-_e=GLI`a5K1QYY&L1jkO-4 z_e6a}heYu9aPt>(fwza7zcCHo9&Y|c^bF_f_LT^|LRz5OiQv!SYXx$CY@-pP zdD6k3O@xRZzP3QRSMY-y*luWEr=D*xI<8L;G1jfav!C3!kKKfIM3wLj*6 z58r@~>+5qiqV8{?PiyPcJ(0dn-QPg(*4I}}q^++Jp`Rz$>Fq@N`W_K9nOvv06KU(8 zh|u@7^-75@Qm2S2;Ty23wvN~yZuJ9gAgY90(YGQSej-NY4O*cU(M;PwL=U$j zhG`r0>{jSS+n^O%*NEDPK0}rbTERfHLL2(!_y(=eb{(F$fmjl5qrYrW_iY$mk{i^0 z8^#KKgPz?6@6mOxedhea2q4d20gnCy4N=l$HQ&(=M8GS?Jd)$h<2Gqjklu* z=o^eB?Hofl=;Q4iFEL+iyaX`X*vY_$DHp zzR3u3GYeg9HUZtDhBoQ#x8O~YP3rj;#;x&9Mvz;K)SJ}qEymN$`$X_veY2Yg5k%i) z1i9VC+&-YY?A@D;Aa`N?woU4pD6&a^z6ZN$o78E?H6rS?V~M%Y>5~o}H#;`ryH7g4 zU<+b1!`vUFqfR^PSQ~ZP*}${~BKVNLNu740z1k*q+PTd%==4eFPsGzr>J$!!G?aKm^~_w-~8|Ux?_jJw77Fh#vNeE$X!A77=~7=MFhTr%!sYyPMnQIM_2SguYFk z_Ml&?+tg`K4qUdW$sR=DHBoZ=77;vle4Co=fyXAd9}vM4we4Oa&H%PU zL|=&*i+eppjK#h5uf6+0FRY+%GZy!@5^>Dyr9HN((_VOvzD=Dz zLJ4h~I(^hnGz-+{C7LIK|7qJAkxE4E_AwG}uM(j|ZkxW_H_EhaB6`y{<3S(2X`3F~ z$0)T;?e@X%bKBHz2>z1W<~SI-&D=jg{qT+Cjxdq71MPLC6xz-u zqFtsj0uL~9?a*TfskI&I`Edsk_565{=q}I@?YqMWJcPFCJJk3Pb+yBBaENhthrT-m zAJTXFi7+qGcc}Xzc$2AQ?2qZrHdU0P-okxSpD zWkzYE-43G1OrvE+6GXJk=oAqxGm2iO@6s}(s8`#iWkxa1=)1Jcm>{BM#^}Ynw9FW6 zuI;i{jQN?%UNJ@+?Xp*lA?E12DWV7wVtaTDwQ0MYmyDww+U^_??Ym3MjQ7EJcbAEt zk_+uI&d9aPzA!$)66_1(=<)h4tuQXNMk|c3GnZBvKOmwN#$`JgX~zFz+ApA|jNZG5 zG~uW00eg(zPhS%GiD;ue_KK&}(B1_i*ht&EM1(r@J?j4HCJ}Z2Od{(386)8yb^q)u z5q1CU4-s|$oFmv?7ZH7Y?;#O%rSCB!JrA)CMx+-bh+KPvKre4FZHy>L#2L!VVIua0 zm!Q-4B0#Tti5S~o%`cEHX?gP6OHdt<6-#A z_}+$za(j$9VR%k*k9sDG>@ntqhnPkmCyMMbj)x&%a^GX3@qOwv3`v{!smU;`rR_6j zN6?S7{ToDSmbgg-{|oL@YY{}BcSiS^OYe+A05JmNU>S_WKX#3RFgsg)R zB#wBX?Jp9+cO(1MTAaSIPp!pgiRh*lCyDfZ z`eYmuXb1Gk1pCJU^_SqdaKLyliP)|kFdj^DRe8`%v;}?#)am37(^`S18i}aWDb7j{ z?hw%r4mcuC<)O&~dg5#L+5<*`*YHm5fKlKz#x4DTQQ$R39Q}ZLCdwU9&#%!dw1aV= zY4FnzUI3-pqYlDE<4j|GPP0V^38HbE{56Cd+L5pN;(6Sr~ckkW}-U+J_VoJW=~V zP0C%<4~z`lHPt>aGH};4_kodtJD>Uo>W@2j$q&?@+`0QekLAvt_JNT>?!$ec$8rZv z`|zF!?bSaV5}}pa2YPG)?a)3jS`_w~`;+L9Y1Cwae)W->oX3nT_mP^Me~5ZNas->_ z9O)zdbRPXu`$#{XhXu8dj282>;796o{uSw{(|P!d_L0$Ieu{|EVjfJQU`lP@ZHGA4@5mg z)afGnbnqj6a`6$%vd1s>A?=X*Tg2EHIpk=y$kFtWF?NyT)*-dFs6o=hRvS@ki-_p@ zA+@%+MntVG?hxH4;z)AXO>{uS-o5yVxzyU?XQokWiyXlYhlyZS?T}hqM6}QjskOxt z5&cwS+&HA4YSj24wWcB7Yln=n+7%+kSPi;L99Wt_N+eD14+7Hlu z5=8W&PhOxUST*vAk#&iZexk;S^iTBDB}Si5?E6cwk^YJCbcsInsf`Gpo%?i)Xo_i! z0!!#A`X|QIr4@2!JSEC~qMt5tKJ=-dXp4yPUR+yoj+!|3r-!(IWj5{j><5)IZGYHF+%w`z7?TU{gY1ghH3QTB6a$SF}C=Hwb7r8Qc^~XB0NI>#AvZBm`f`xLuUQc zH=<^upG4P~%V@FOinPzP!ZJJ}_nB5$?k5V^h*ns}c%J)AD;TJS2)fUGZnY70zl@%o z`%K*%h~BGwq{|q$Xc5O=?o2U(Ce_oBLd{ z(2>+1VrTBi(w}~0=}$kpL^^0qJGx>cdNF0zj_AeIkbcBj0X3u_Nlij8`VqaD+R%^a z#ca8D6eL1z+L6>Laqm?r z%V?#3B=sy2<1X8)AEk+;R5_wB>y;X3v^bI)#~8026`4Cn#8|RC&$91`5F-YUHcXT| zq8Bf7CV0dMvV2JNndk@6G0>X^B1Vumm&kWL6Hv@aa# z-XMA>zg#AwPQP3u`ir@(KyN)nH;LHKzuYClY)SjlL4+3RU#Ri7oS}T7#@`~MC%;hR zZxPp$Ul^(1GPZwV+*r9wI?A_lL`3;kz99FQ@~yB%$B1xGR&XX!J#IkSD*CE^3@>@I zit|cs$Mlj_Khq%dlhu0cPaZSstwIO-F{FR8in~T_$CQ4R+Bk;iJXyv4fcoQGNYm>O z>y9z@Jb8zM7=y?3oOc)va>s1PJIqV;V~#lQ5JhvxeL!pQI_;S4Sfhs>vmI;j2<`X@ zQGscUf9nC3;5fYw-RsBn7X#5>*4vpze=!jKWu4kMroXIH_s5KX>-4bWf{o}e>-4Z= z`ip_y5=EKD__q!TBFF5jMEda#(Qk6z2ikzO^kaC=6Kt?Ur=OSx4;w#buibc0y6;5a zVXb3YW)qPx_mxp^6JC=0>Lcm^-B)_fCL*E!m7cRj-}p+;*@8~Bue8F}1tQLowlI&- zzH%NS7dc`z)&Q_SHiwHen{3|_YyM=Td<98r)@atnDjH}vL_RF0dbJ;I< z;8(e?VWKU_{B^=ak*`T2j8VC-)G5*6SLpN!HljSiuhitu9(47Un%wOs=T#z(E?=p? z-2~G(+uVa6rx+xwGRee?zW z+YAwGsej87Au8+N<|siNeel~n)AHoEfHW+~MdTaxeBdSB8zR_O|3-};V7!ccTO%5T zp1*CIDDn*+`%FwxYtZvEu}FTHBRvyuSQZiPnRl8c;HS@2j%wfGr-Kc6qhs(p{B*DZ zC!*Ewh#=z)h{f7>Xne3C$}~if!G;(SbU)q@XD(vNctep~t`M<~@36vn!wPd@h4BXV zkMFR;cmrmj+ILuCyx}L&eV_|TqHY`Y647J7!;4J>D~w-wP0l0MVU_cL|0^|+WaXYn zGp@=wF)x3I;Lax9KSz!_a5v4Y?W_o6nY)BiE(>9dT*XFs_M$q?=2E7sg+#zEi?P<^ zd@4fhsiwoD1ZLSX!V_C&JIV-Sx0zOFBU=JK5auqS)GB+yrYj>Hn>QsW+YK`SlON8K zxRHYAEzA-%^ru|5avip`=^PrjYje=qoP~{)vQF(**0cvs>YI|<8tt4tv(qg4I$^h5L5DGAF_7#>qA`L8RUWoS@nYS8(&)c*IjRzE1X8cZUIPWL z_#z?(eu2h!e(!~r1E7l!e39P;<~Hlz!Px8XL|?p*JUF@r^xYfG{lb_MX#VBfQ#N#< zD}G<_or1GHfh&#Pm0u(Gh?f1MmjVxgt_~{q)FskgE%_U!bMW>+%ME|wo;FO>tqd)% zQG%8s<*3X!hY<8Nx&p^8`Q?|IAm!VCwi$|>$xh^Ui%^?zI{0`ob$cpBkVw$Zycxc zh>FU)Pdn88@Urr5ZVV%PVEC#=?)f=>2S&EMOOulkqMw0DZzs`cTOgI&l;~C=`Z(Akm@qN9#NR5vUqHSKCXvjA{3j+d8`o`xbB$@)c2L}y|{s7AOfX2K)3Cwc> zV}5_Wct1iEp}!!O1jeQUuY+0aSp>!-fy6d8DuCk3W8Y(yXwe%iG$Kw0#y9+zS`75w z7rY&L!?d5i&e<%zZu~Fh+13c2%?mso^mm6_*=wIZ@#P~KO7--m@|QL!QCRt1xJDm; zn)2miSEh(Il+yKAZA6>?(e^)-@7b1e_k+$7&p!Iz#Bf{%=&LuFmwxc<52Q+v?s=X6 z(p8!Eyv4f`0~ylp`qQ}-{or}OFWNE*6$M_l1`@w+v)-3M-*ewEb6*bop8GH9M5F$L z23g0eUbGV1{vz;dL3#9PQzg><3;M--K;bLiha&+fIuKq^hBjIzfue)n?%z4q8(l?Q zyG(x3Z_K3^$2>|}86}t4q3^-9ml2?eN8TI3Z={=;@xGmTNcko-Z_#_3eQRQ;?nVX& zD}i?F>Sun_f)o4RHQx(7ju(hGc|E^nT0G_TyUIPNwn=zckSU}6Ht2H*S90Nqz~%6g>Q^B>5tx_-ku?%V_)~zTWopyFJ+|of%eTP z%H86vD3RYgv?|MH>iuKEUP_<2;O%=aOJth7-8Y}fw42^;9h=q2z2hIfS`a|l&&uGp zZcrS+oh=eft;{_bX$$W8j!hh9sxtfW1QEITXeyrmIx zo^64@bd$^Mrm}jogDs!yR#v~Ib)p`BIx9VFZqm1ue?u<$Cg0IGm;hZ-ZjBz2E`QbA zemus$kiW0o8p|L%kbmeq+D9{hdX(v#zMDkPlw|rQdvg9q04qxksNnGzF5RSd3kpy> zBYNSY_u-C_+fwJ=Qz+(hqv`}GcCQ;r`$Qd ztP&;B%29GzDtKQd8fDt5e|CO*hiTjJjkk<6MV~J?JAI4jQr+x85P>aFyb3RoV{P$9 z-Rt~!nbz+8cF{)=xT1ECr^;5J!mOJ0iBS_=SibyL>$`)6)Bq=mAO` zV+SIz9QI#~{dz?-i4kXwT3gQeU#{WE9MHV)c|fI&mREe8a|Sw8lKZbEm!H0TdLMJH zz#A3)W2T4bFZ6{L#=o};`0Z>H`IVc!cS!ek0^{ls`^Vc!CHelLOv_+&ei~ugj=%8x z2KJ=_D|dZ`rc2b?%8~a**F1Aqz9`8A7P3I7cj}mQYePVvsMEDkAZ3r}xwrY@J?d&b z;2*s#HMxG*+xqj)GSlYCg*|HhkN48i!9LK&gl~L&v`F-xGOqw_c3@-=PzRe`-b+8; zQGZ*C|K+<3?Y7n9Z~A7SK4tvsW7=&e<-MAGIzW_zhpkZN-EJTpxdwU!Uo+As(WfKy z#Jwh8KD$b~y(@wE&9{9-*WrI%yF{&u+A+g+?6vuu?*5^Cdp-Wqn*o{j+`o8x?mpAz zFa~tdC--z^>_PukqHPiT>klQ}M`yknWr=;oHy$rCD(~O$JzF>wMD6~C@G|YOf7{y@ z(I~6(}?4ElwNJY~QOL?X)2+z2SYk zAyL-jEv~dNEsJ^BpWz595piF~z)Tjv^T7A1JE$?Oootz<~WOrOa2eo zCFS4Mz)&<3L9VzI7>ayDNVa*^|=`lvK|# zdq6gzq{cSJiEbzW*icfBiLeO6(bL$QYSH|(>xP^-El|;HXMY;uO97o|0RbKdCwIsWNmZ8bV zMcN#1cz`A)8iH>$EHG`%7u^`3ckYh**MmE3khl^Ux`jXk|GVPV+6r-?*e@kJIj%C- zr)>W+kl*(v-_(WN^gAUzvqm($sbovyCeaoVdsO{pW%ABbFVi-Z={IfcAH(a)^lcd# zMuN(8UB8aBkzOTv9mWEBs7#esWEw{M_7Rn7nvxy-B6H`IMDe3cD=6`)c!aszN;dM2 z-Z?U>Og&v=+Hh2v3g2WuAC45o#I<1i3@Q!~NCoS;j`Q#6I<^Tel+jS2c4RnAA_l&*b zZIssf3{?C>^c!fo!?!fgnKWK_s3bKU0Y!}XqU7p+2Y}wpde^V>4Sa!FmGdk1ve}Gp zX>M_ZC6fN<_eLWCULWQlV;E=fx*kMA9O(n9L)#XMC~@VTk{Z3O16_RrP44EIc2S8Z zZyf-&DDaI(Y;Ozaw&}}2VZ@E`l{-Ma=;x35;>keoJkdKMjcALgs3Zk8U@@-h3gRR! z-Fu*v@E>C4$~x3m8l;%K8lF+!Mpr+@flF&m~k=$l%7>mcUG`)4D`m)r*Hp7 zH0+GB%>zUW@BUn_9%aN-KO9@1^rT z9K~S({6)QeAGotEylaRmD?>zhSJz*EFmJ+Z6Mc{Fry-RP?Y^bayXY0do5u*NVYh;o zo_%c0w0f27t7)nGM@sg7jM^CEZbdsH684f1o32HW1}jYd#_b05qhX>KHln}Ok0|ly zzmh=t5LVHRECG~_e0d49g6P=${y9)*t8%Zy%d#tv&_Co1d1qcpYj`^hJaO84z5WZ@ z5x{a{Gtq+*!n@?(jN@<+kcPC&14PS8LN(Sx7k%Rk7gUr8Vs*T5VFO4Up#)cp!dpa) zc(Dj13jX0k_8H;%jFIyW`Wv1O@;}|%yU*IXeZ{++=Ln_6_r_n466Ae_OFoHaq5Iq9 zd~q7Hvkg=+kp^wcvI(~z_N{qquM<$O+eu7Uq4 z8jzi?QTDC>DNQVXt+*v>0A1xwchiQX&T0@@hwF&UPaHgGzCQ)fE7YUlWU@@q6salN@ zmA&E&B!%ddZI9|Ya&uX})x4sq|GbVfi1D8xNk=EXNnsk{@dZn)#%0SoYO5_xl)v}Tex!h zxf84MS}`J(E-d8|p@|dK8A}yTF=!s&d%(vQ$_=a@Tyv?3f_q#zgAQCIGpWq<$?Zrb z6VW&(0k)p2#X!i$2W~1!T)Kj9L>(Q>m5XoYI0rA6eE8A}zj<+*1ht&YRfn`?=xJes>~4v;NsM}3 z#QX+P2ov*oh~G-7=-rao&`aP73kriXIXYEWQF#WFUkpo$P;_o;-WY@0bTlm(<)FQl>0#;b{K_p~8Xvj}@oPT_yiWNHy)^5x%CtS{H%Y+7WjC9`;_@FO zv24`*Malw2IVUG}?su6hL)F}Tu3(Kqvb|<_Am0v~g!rxpXjW4(no!E|eVls-3aT*Cjq*-BhF2n_*A!T;b z!C51&kd(zt?pE=9E-{gsOifs^#gs~~Dl1ijrp8l~lh8*7LCjd0nk8gtF`J5W|M+vQ z94sre$Wyi=m#J8o*ty-ZY+hy)memw7&Dg@jr8sBm7#yJ6|4jd|#h^3dEN~_+tEm*D zLZ_w{KwOs8rS|zuI$D@WChRG(WKh8+lbSKih>^kIXis626vR+$ixD|s^LAGfKjT};F^q?AIxl{-f?kR8lTq;P0l#BR3P&iNaC2b%oRfN05ti*v^u3-?E-v?2$X=sN5ymKvry zjIm<+D|@3$S7lbFKRa0217xUbIakdplUU?rugp(YR8bp5tD3S~;o*ji{(^g+70ow- z#|>SIl~_RRF00O^99vwAfvntM(CU{As@hR4q)B28hMbVjV?W)NDn~{pQ#@sWKiM^~ zU2Ml3XT47(Nh0G~TsTRdN)mp&)L4L==(e>RC|OAsxYQzXd6=BjR4UQYlWXK!yq)Z^ zXt5`tA&ji}_-R5jnQAOhAr)hGc^B6*PsE^eR9+*OGW7Wo5AMPp$LwJJxup($rNLSRS7JX?N*-B zLoG!}wO7dZj|U}Lt#PU4O_uYwH%pq@Boz{zt|1w#Pjp9@^e$I+PK2d$4Ar$`S%^P~ z7MelGu=kOqa!isVNrExY(7#K6GSj%o2I7Vm0s-!9ak*gIBT0%1N5|(=%~;8msKqow zTtOEtaBCG4-z?{}i8*v9`7a|tjf!@v7?g!ERp)FQ9!tYttv#~8(_e+%T)Jly938BN z-DI`K#nHg@d}d01#F^`xdAU333>1bvZnesC(fmXzRp|^)rsj4<#Wn=<%@Q&+SLitx zp9%4!)BKupD26ZULe&W^8J$NEv1hazS(swHCKlLrhJh+~FI^U#$YQTKI}@4;mkmJe zIy8j6r#ZFUn7`A#A;IkjQi9q8y+LwUy1Kxgc)pM-%<}~+J1ityUeSDh^*2TRF_FyXqN%D`smwGk>`~EBp@5~V+&Kr!ihF^mSFUnkPX4v=qRM?ePV;4|m1Y^a z<0pv(c(Q(=YWX_r43edkoeQP^g9diuVORX6(wK;u?5i1IH_cR04GE-4@o{qOX_Xno zvl&iBWQ*j*P-myHXoZ(Y<7Hy@(3q2WT*_o#{%$liINvun6}h!m=6nW4xJYWPG+iVV zH&kE*tk%Z;eknCcCX()cX-djRNQJ;O1WK(WaaDAhW8UZUyVy6wkZ*|ryNSx^jc)Z2 z`=O*^o+)mG*px-4iy1cw4B(PQQj|A-%B);;XV9O)N-B_&oXF~|Ro1eHORBS0Sxe(C zR@n5d+=;H%RV@-xX&Fv5F{$DnHSgb6DHhS<|4O}>4HpVgZj-<*5M#MNguP+t2OCLq zrYW?l%BK^F9QJ#)`J8i)F;YcW-i|g|RV&AJU(%(Q{Oo*@bLVsnLl#5oBu~+B7M&>I zQ}X!7*v2;5@6drzNBNJ=V7XLvhggWt%qK!=jH;nnf(=4JlU0&DDp=7*GL}||EZA5D1}N-YS;P<{QYpp^gtl_gB3JIzskyWBS$ov2 zE_*uX({slC6)?FoXX(Db}Ea7p>3^0@~h%v2?Qm&a%n<28 zibH3$T}qy4sTe;ZHJQ4?pCv(Ure-Wb_eo7n%`AmtIQ}-Bz%6>K7(KnRS(*8C49aod zDYJ;Ho$w5Sv9`ITQSdHDRxhxRR>-HgFH{Z>)=<=IOi1T5vfUsqlSC>7uQeNqm;+j` zF%8IZwQ4euCNsq7ZINOyccMnFG1p`6;~Kff#D8LLX3`SP$+=x}##|i52~U*XwG=#4 z+bZ0#R`Xq^J;UzN8IDHC*tb~O7*|EcRQFU8JBrF9Czf6!)KEpU&TxbWs!ba;mbL2= zh_zW{<$Y?@=Av`mZ*_nJymjQZ8%dj$CBAcED za*fRuOfGAc9c?o>=MjOc%Z}cXxpO$QQ7hND+X9VL9zQd*G5SE3&CbPYmVGF5HD=eS zw@2nCW*2JaN>>uKLxEZOkYrHx%z&AT9en(yqdDgkCt^;mMh!zD*S>!w`&;E!BC^#Q zg8#5M&m^KenPHN^OX%K?@nfcv!P%UD%xkg7!Bg1N!QOI}F~3EEl_cR=B@mTEKG&pJ zxIxO$r1kKF$qKGw*A^ib`K-(3Wv`G~X0BGPt1&~*avu}h&`wERvYg@R5R=3{Kxa%; zP`Ozzl~vh5tAsq$Zqr3hq{CP#&*+h$S`p*2ps+X8<1!YQbTZFyy>Vk#R6gzEBrzR? z%*{Wi@ub6>4CF*rxQ-=T_88xgrKb`FNnlGV?O`%_FG+BC@MIDrWXvQoQ-!1>96Gre zw=@hAGBlg&AbBdK7RI&@7ei%|2p@yO;nJs1_z!mXD^~ATW1bpAYUU-Pxmnhsh^I!h zWu_zdZ2jn|T)GI}@mX?N!LHoUWTuk6ox3RoXJ$p^hKipV0hxz19l2K7XCGx*Y=t<> z+PPn4E)IFt%>5&CVc%N0&+DvQ=SGUf`MJ3$oUdK>t}M&(r-sbW`(-Z9LU6uWCXwcr z7nzTX`#uwQJ@O&z0G4S+jnsy&UK-2IbT$*M=raySdMPQf^KNuN+ZmiB!?ON#f=hkE zvai_{janqLR<6UFUdd^WkWsbT*IpUpFZztMX)X4zbjd!3)lCidVPmi8x9@k; zx8z;IY>xZsQF+GCET*wJ6_)0fV|h4|jmI9K&5Vb~{DZ1#4JZv#s!Vij`aVoR*;Na(Be$VCrC}N(VHfDYtowyRtT; zfl(O;j5BCZnZ164I$aHf-4M&%4;DsPugPka7*9*!VoC+(E-tlB+Sv@gnG8aRh=eAW z8nQTYWdjTeVutCe4%C^shmt+IgMENT%4g(G$km*vI#6fk@_|pRa4VmswFIA#9w<^Q zTyD9YyCciW5LF|0*T}Wc>XjR9GuSss>}Oo7N#acgiTzBLlcb_+utSHWCt^z+vC~~5 zN3|P`jvF%tTe1p!m?X2ZURyE;iOc!jG25&cw*+2eajvxcd;{udUq?&SnTx8 z5Lb&bc$UI=1kR~!Q!ndMFRsTnZN+ZOT;uEmVKswm~>dVvP+t|Ut}%@b>}H>R_@%aVYW)b z6XmP&k_snuisY$gUVd_8WqGuW8@W_-CLHC4Kz$U+ai@SpIM~o%Q}#jsW6W@rIQCS zFe#o-n+Lxwra2nk(AuoA@^?KI;Br=+ib!CRi?CJp7f~5}9qVKsIm6QdSS_U{`CO;< z=&M;)Cl{kdbKSBoT@2f*b-sp7p zuBOF6dW2!*{6mX@9Wf>n+MPoK%S z#IQyu9Hg@R(rR>)O{r+Kai7?J5r?UqNKHEE9}9AmL~^NMl}?~LWTs~D3Kt&i!^tF^ zIlz&li5VW@az5d!SFuk<^C7vn7m8)$OP08`#Q;B?DLGLL`g%gc{F2Wo%1~+Byt?`3 zoJNi%5bDI{%hN#iBuy@6E#g{CApyq^y!Jz$Mwc5SW%jwM=1ca*VIyeRc%IyprJB9m z{zjL^!$}B2JdBOTavo`xsAg|%oSUyrI2J^U%JPJfPPZUE=dbtOI^|vv<u0PUD$X8hfgIB-I$ZOcL2Plf>BKw+L)5P7-{l27eZb9dex{#*za2-ZBI@ zxwvdzdemF}SMK;xvQ*LhI zZ7T9PUt7`$vn%LmBS%1VuA`DHRzd92iz~OhQCPO1i=@1&JdwoOp|@p*1THR=*K(xl zmY<=M)b0TlP0i*wKAif-JCN8yR>zI18#iwD&a$FX&$TLd>ELwswRGTO;9Bsya$S=m zSFUwv%x*%pjs9&0_QtGbX{o;oCDM20zK+qKO_!?nap!G>Jm;I1{IZ-`Osnb|RmH5R zXuD5Ey*pJ5*~-$PJcFLNci?89=$nqwMYi-2LoIPT55Ou?(` zHKr}{P7XFEWpA;F(WgbFuNlPIxdB@#a%0G5pQ|dtseu#?gk@Eh=V8?)EFBmP;zTV#;nxj#(g3RvlchC(J!$1I~-lg5nJENltE36{KRK|>hF+E3IZJxmHM zwO{>G3N+Q#HEJ z8C|-WMCe|o-!Uhv}%KjT_sL` zmz1TPr4FeaxM{+=0cAG-w4P!#YpG9`t?^RO)5=P{$bz{1?G4o>*#`thDCZ4JYdXDT zOxfjDPT6=aMf~#>E^mj+ks#!3TZBTJEjMoSa^KD}K(*7jf~8&7yzw=IN6pGIyS(Xy zvPBsmnp|!$9nU0zqAa9cN4w0` zUZ29iIEX7LYB0Db8RRS3yL8}sncV5Ql3)4J+S7?$xqs_~#U;s}vk6P%Ft?}-^>VHu z-x`38S9?1;LON6J?}!EI99tH4?iV{ZRJFBR(PvIy$(^2CYi91!#_0@Pxt8?H#v?^i z2XdxVcFfb++YBDa=EJj7#xHgz?g!_7@W0d#T+#OQ zS7%op^s0!lwGK47*jFw8!N5ggpRKZjbTx_Vpooisa|%{H$#QPTROezt(jJMcbL~Sz z4$(yAI8%Esw?a+kicE%`9eSP2tswc^7s@+d3h!z@n&6!IR_C7nGJ5An7^=%Uw_>Yv zoi76ym3o0x&ZF(sWu1@CRF|!Ms;5F%uH$0%{6NkJGamDpNE(xyLEca;3$E}@AjRw9^Sq5*Q`P&yE%89G>ieB>;Xt`dOZ&Wqatj##A z#e20Cvr>n~-zridd9zc}m~}Ww{E`GNn!)>!$_oxBiCiBDyi1(~*hQ_u#pnz3BrtOk z|195lYjlH&q|8UMlRxAa-{@trlA=8{w^)() z#kglE=}N!F7vs!?{CR#k*T8>~2BgD_dijsx$}7e*Q+OFkRz4wO`Lm<1t{h2ev$;ej zlyMwoaFQ4+f09@Xndmiz`g56ia&-FfiS4hjGA3KRt8QcXw zk#iT$*wKOEve}YUaicHa2#+> zW4BvP4am4;NFWs}FGfxBwcGM6N!9!QU6Q(PptwZiyd=bTy6{~_wm=b9Vi;--O2J9I4(gFD_4d-Gxxd0AUfgN0irC9JyqAcCoBop1CoJ!kDM`vanfXp z5h1G3i_7L!xfMos<+_~9mFu#(EuYa{@VfV^eMc7q=ia953l)O@qsm>J|D8t5;mO$%Xsp?+!+1^@zG!?!twM~7mj9!ZiUvRXyD4Sw6fWOk~q|~*~N4jCu3%=qrYt_GMC+DBAde&Z<&G1 zY0hwGwAQ^(OOsp1c~ORIW64>r$R;svrO3uqElVR+UH4xWsKRa&c;#FnGzGbMv{K%i zH|myg&Jp7n2w2m_3fDZ5E^UD+_gB>z3OuLgJ7I;1E ziT5yeWOouW)>S=(9%1PUnYsS3eciTnZ8|ylneV10BU8R4aRpQ3In_AcfhXV9SFXS; zAw{exVTurv9oOEOh*WXrOnNMY=kv?&TH|wSvbARLH0#jiYlZPmxFr=UOVxe_I9ZyZ zKuS;{20m$K35$cW_S<*uraD5^u5scV2k$W8GTp3K@-wWpYdkebk{L61kd>Rc=Bj-D zWCnZ2L2x`KlEpC@p51bs42hIk?HPx@`9e`k3`a$K#w~~xR_?WOTgeA+ppNtFBsk$z z-HyFBNdgt(-HC)XNQ|Cbd&|dY@18M=)3>W{u2opU3^SV}Xc?O@AnZ(jhO<6eM`V@pJQ+^sd?5apTIld@Mm(?h)vEq zF(NA~W-T>zwJk|v2rtv%WIuFYUAZKw;&PIF2185%$#g!EDGv?~`HZJU#bX?;$eE%! zTxDO8qVbi^A!yzyJ-26;vh#BxSu`R2!0bm(2FC5tG@iP#TJFp>ZjVay*QngMGb$&E z&fJRjniFA{Vk<~YmpPThew4*&9yb@BJvog_{M0v%mf!X4ti$k5=CWhg$`WP)zfob9Z_zO z$kiQ&DjpqXjHWE61Ucf0+KeC$H+M@-1Y4)mzqwziGEf(Irk}>7Mow(_OUGO;!Tm$DCIM=}c z=NeF(g!huVGANqWyTa4g_euy~-`zm>-AF_z&8iv@f=A=0RQ$YR|BT9?eJetEPz)d3 zLT*4+gjc9BpQU=JhqT`BMlob4Y8~c|GEMCeijPb$se%1iEg>pR7$tVwoXD z>nE#zB`|Ptq%+WUrFetVTM`5)&_qYjC&WlD&~;xOiwIF{o+_1MNll35I$Vm4xb!!o z*g!WVn4QE=2p~KIy=_7ajNL1h$mQ!J5$L-81kJii)KeC+qfkhT!+1gMm)r z6SK^al2U(=-l)i@kg3$EP#==G8%l(D%2g?b%#}a;DHSh@rF-R)Bql$Pr0b_yRgm;l z{%n>%S!@od`#JSDXDCs+3O=ONtlk(DP3pBlaY4mbZX4CML2)sHn_z(mWRaITAkTMc z85-{bST){~T%ZW$o|KC0$7CInm}ObaWZL!*Iu+NEf#u(23WK&N)Xn`GLu4`?Hf9ME;GP9^bE6_Bc5 zZ7r3w2!B#YEqA$8QV01{DV0h^6!VP4QDS%lulG@X&G62y07#SoG*k!q)OyMX#rjq3 zO(fJCnqVi{onTY_Y8|-HWJ0>$a2&*x;GG(WOVRmTKpgy`#_&@rr>LOvfxGBxYV5n& ztZW3iQg9GooObl?H`HH|`dgs!3N+pvjin=4*Cq}d{&=n_>20x1P0w-nbstqF6f3c z)FaLNKA41ueQ1QT)Yr`-)w>pWaK&gK>bP94-HP09Wk0FKt8sJYj1GuQ*V%t|=MWm5dMF}HHL2w;r9PBpT0!Bf` z0CT00F={-}%M5Ipbw|r7y-Q{(%Q84Cba@AHnQoSClXMIo0fwbGhN1y>mu^KyJ;X_G zNycL2dVV-^Wlw&EG$%os4>(Bk=QHgFs!| z2>L<{qeW5t>}fBL&QEkh_dV@$be3asKVmxuVPwcbSe9V0yz+!xBtoOblpJDI>ONS9 z;iMdChC07X<#gYH1P7B;$!$55KZ;-^e#SwaY3+=sSIzE+SZuSu0QTNBXiZ^&Z%E3K z6Bp0-IbC>G@C27v%;JCs<`zO}mn!B|BPs>Tqm>-gmG+AMyaPZx*FVYcRP#eXV zD2st{t6X^_LvzEh%JIYK0g5TrFGB~Eh2C@lnp7^Rh%BtFu@TOIG{!I~?h_RQI8ZlD z+dV$Gfr%#3#N)US4~SxeM5bb)re(5XMw~YC$dRu6vuw8@ieciKM2F~x)}ENXtb2Yc zi5^v+C~2H16?I;GxJ0{zr=)Q%^?1XGj@|QY$7N_u%+0E}z;0klZ4?{fSNtFdCy?E< zB#|g9MWf3b70FqU?B{4|@P`Z|v#eJlUQ8tQf@X=b$$ZnC?X_A5DY%}O-w{pwudstY- zra(3^xjf3-M)ApM_cE7c8+EYbKvytOPoBTn4%xmP&cp!J~D9b$=&*_7ctM zSO*jsp!!Lo#UO#~t1+$|q>y0ReL$JN8V#h8wRo8hNam{IJ2E0@r5Xp4X;@ZyKJ{8l zb7QS*IH4jun{?JFyK{`udlUZbd5@nS&b@H~+UCz~{@hl(0s}47!Dk4hU^GP?s;|wX z%Q+mD86I7o6rK+lfIOe6p*yPYUjM2jUY5kj{b=W^$Q|I4ThWau1q&M9F2yB-`!W*B zCdj}D6?;DS%DH!BP%n(m4h%8`$KviN#xecMJ#>0Jv?e@XJdwb_ zwc$0CpabtgpkN)-Za#^lMNIo52kYTZ5R<)^o_%Dr1Ff91){+nsRUS+Ez@<4#E_Y>` zC5F*!zZkLzg{rnip@q8J;6mbOPPVy)F4+yPNtH51p`@m&@UNKozzB926MTG5-ZDWHM;3JNg7?_8yG-2 zFjQ=iCL_rW>3@Tr2z~OW+Ewo<#k=6>vpNh4&e(=zE_?S>upW~b=?tCBpkrdM1q>hW zSp0Ylsr9KZ5WI$F`R-alE7;B;*oibnH@Z09+KKMRIOJm-s$(3gXB=u|9Fi;7@{G2b zamcmzb%}9^I|Qgh6e5U2ezgg~$Q~PwB`trlcZ(QQhgcH(KkU7YUsK1^H+;@X$Uy`F zL0+WQO-w=vknkp0TQwj8T3-NB(_kf4YOS@cwYJ(;$-n-5zu!GCNyN6-^}C+?x$ozO z&&PGoIlHs7v$M0av$GS3YoeASIltrMcg+3B+>iLs**lixBw0lgVLy!zg=K1ZT&U9P z%uxa(2d(~`);H#|xM$_QuQB0@<1uO4+_Irx7gqej1x;8|d{Js6Mav%*@iU>|!+2k~ zXcjJzfvLF_7Er`lWx3ZX%;YVTH%xxVgg^xP3by*psT?^rd2->QpE!5Eh6F%8?pG7% z2y~Lkj9t|*JltV;b>aMJ*6ZEKfe)PL5JqkxHQbP0Ph98bG4LG=PyNFBXP#eJQw{Ef z#Zq_lb!!8Q99q-frEpz?!Xnh>3fsF>^2uByA|e4eUwBCDl*ET&OWmjlt6e9p><2#H zJfHEsC)%t?#VM0dx#M%@K+fL@-kiguI}627?e5A-7eA&8kXKbCZm|Gmf|K|?lXnFF zwQ%9=es5CvT3_=IEPk8;?-%y{!eeUJ4T|Q*3zSp$pQy=Yz8l{6%S(dtF(ls{g5--< zBwrkY9$TWY%O_n*&cZV={hYfJq$5#hhmGx9hl<29&4;K#mfB`68 zmDyF>J^|gOLT@}IU|`P&D|=52MZ-)Q;sFRvjA^8|)-b-H!C9z{Cf64JYSJ*KmG!s|fqrByBRoV9X0`b(ajv{WzC|%E?6Ps#d0X zFy^una`tCST#ty=xV9+qDS%mpo!>b4it~yIF0(kks6@7ZE`epRk88IwU2kFCy5Udc z)23sUYQ@B?48IF={>0fWYK(YScw1vRS@+Y%OWJZ$-)6@_obzk`M5pvM;k-+$v-nqPrsms9Llkrus!5Vj zvx2Y84b(WG!k)b>#)bKHBq}$ecBN#2ZG)Y#^f1nVH{sgT*#m?+KbPVq$snBPi%`J` zZ=sCSo5Z@~moHCNfUdsI@hg)gi(H6`T#1W_uR;tQPpz@t-_=^dgG8c!)uiUx#wl6| zbTQ@^oj3`eDS~%nbB7KiW-^X9ip5{Xkg1i;ZH(%9jPwSj%A0wL7Q)-m)J+?|Q7@5^ z47WUcJi~w;ec}hQ?b7~gFyCArYT4sB&bKRV^G&#vPz0t)05FT-drnTAY9X=HFPe=D z&;5yqs zLHR+QS*iz6o@*>CDIiTKZ^gUuqw1E5XT{#dce_ad4Q(=$r@mPQvDoBj+Mux#o75vQ zeYLIe$U@R=t&ZSx1qr|IR>It9TUSdwJrqrOoa8|0qZ(%@bMDyvffkSPah#9j_TpJScJpyuCNAdAk|ax-;u1l4 z#Av}1sC^z(7ov+IZ=g{?dMa1LyJ#%m$<+Cfh5(__!qmkRTRg$y?4b>y@W*BZkA+<> z+c3wV`~09&OEiSX(ua>;86OUW!NdFrG%Wzt){UA+@y#BF!X>(H8JJ?@!*=;NSF!V` zIF>ee#Vwv~GKQyeF=US5J3cP4jREkL`^RE1@Wly{1T)kViSyM>whQyl!4}5cRSnby z5obWAJFG@pC5%BLYegwASxmf(sS#Hb8ltWSg`nR4+wmZjj$L$G%fuhmAXj{|n87=; zz{)6uNydayR3>AJl}klD#>}rd zz09>1@a%M^?lbX&)F`b&bHVH`uE|OqEkMqmgKqIureneQ#Tz_Y)fA#$JTb{OI@q_h z(jao2LLJJfaY-?bE3g2LPT&Y7Vf z01H1Z74f(Qm>oqP6R98ekQ(i#BD#Rr0%C`S@hD+lk|m$w)vyME-p6W+Wu1qy5-sF| ze^}61t=3AgpFbcN#PHt}Y{_ssV}6JbJEF5jkl^j3au=yWq^Zta>Vn$Ca`qgIg2&Yd z4)<)tQsLnucBYb0+UJZj+gb$Q1_;JY>!rA_eI{R zh|OF9jTv1REW%dJo7YIn-ZC`)2^vb2htPz(-#GZ`VhK3ps5D$A~Yp`&H z{jkO(z#jD51E0DUwH1GI>@d{C%3JqYj@o*85ed%PoQ^UVNJDj6@WOc+EO&cJU|J)E zSkBelr=WGUd#_Ry*rBDK7z-IKq}3IC#UMAI_fUWFY8Wj_(aE%=j}|lmZCOMnXEZOD z4V3)Z3f4E)n43Y)$#l1!&)Y2y9 z$8%c;8D*-Mr5m=5!1X2O*i06^EKxpN3tASdnvm3FqVV;J!F3H(8q%z9Jpct<>S!D~ z2&@p8l1=-7Eo${z2t){-z~G#7^5N{Nc2vm8v4e!|kO4eyfGlw$g^cJ-YSpo^Pi)42-aaj1E_=uul=11p$c;|ihq#sQ@bWok?V|Lq#ah>xeWg(_z-3ao3- zNld7XqgbGepMrs{^*007~0W;al=;(BPb;5_UI9$lMU3)C|7i$V}d;z zY&#VU=h0N2?BlGj!d+|@8B4m@fh(LTQpkd zKIeS%&ae1W^CA=Xu*s!LZ{vW3y>gfw3f^J=(L(2`OXQL@ad9lO`R-Q8NK;q&cvnRT z{%R~JB-g;+R~iO7=FeM2usk%fM6LD|#HQ)RW8G@h-JzB+fA19%`%tX1s_~i+f@-bVoW_Cfa+cs+byEGOdWN%ZZsP2m!5%(+0YBf>_oLh zJB?vEv%#;cNG^5yQ{NbahU7JL-uP3yX#jBZd`D2)oxIojL5s+HsDq7$s;M<0K50;n zUk?m`Hsno3L%>7YX%2Ku#PNme28#ffuS}AlB7~%#^WA~!UhX8~Bne6PP}SIv2i%Rl zGtkZ6X()tM2tJrN`XI-#asl)#ZJ^UC0ss@EHFkgM3~2yR4MPkF`6rSSLLsCx)I86- zLxHmN6i`rP`nYyaW^n{Y!1{>xu+zuTtr8{m^f7(l;!55P-Vvxquw!osAF!HEyRy=; zMxwgIed8k5Bh;W!wRNLu;A?*wJ(4$~NkY3`f_&d0=Kq}XN&>l-syYeS+@}7JPshVL zu!oo4)Z6`6SkTz+x7_>Llen#n;~ZatWYC9G^dxf2S#)r71@9hF12})*pFXujW?qOs+s-e?|)rb|>bSvOlFYILUHCS0${`jaXnOMe zrawJlbY@Lq$$_#~CUS&Ud#i^<&a^&9p=Z~73B)T%B%5L*jHbP|eX-tDUWCdte3ANn z&9V0EQ~}$*1Q)7Q@iee6*N|{4=+{!uAi_b2WwZmAJ}%bP3f}Q6SE1=knki*&jH}s~ z_yBQ}VBwDPDpFz~3yXXR{MtJp3E_)n33WI0mASG=jQ-*vl5<8my9EHO!`N)oYE|LX zka57ucCoUOh?{N-RGXT@jYRua2JKFIB4QK4*f&T=+Zm}YFVtxPjd<-G*R5n3ie|EQ zBVd(t@zmv5#`xL!rUORKLGo_t6UvPf5)bTt&!PdbNu0-VYuNF5))`a$EwZ=CV+hR*NK#$HV-3?q zT=Gt6geru^4+DU&plaVDyvcOYCd6@*HV3$TkxApmLT~PoSYQqrN!D1KVVCd zOfOckeqa%SY!AL(_*k{i5342$N&ib{lQ;@q?F9ePL@iMu35Qt`=m#ncnO!PdDdl0; zOCEO?gO#bY#u<7a>qlt?eRFBgnclXASuS*|EnS_5h9}xz4?S;7+am021v;z2(gv*x zHO`~Iw`vt2MB3k`GdGv=(tUCJayEf&Bp|z6RQSqk$nAn^E~IzqDr>CmLVJK8@?N8{ z%V|aW-P>A25q`Z_BjRykeD$70;>)Gk(3M1&7PLkuu{Pr9_@|XZ!LITE*i!|oJC0vQ zZ~gLjOulFGoXHC&KQZ~4$txzmGWm_k8&p5~`wu7p`P*oal5d&(!Q@XSe=&K-1aZOq zGKR@7vm6DxKZ6ku63hmF21n2OyWk{nje}Xsf4Omtd5#LZY?ispjS39Jj#Fp3x;9B& zTr`iNad2IB0o=Kc(0WdG0VOVunYHDe<(o$L`pxqC)oDbQU{ndSbI0(fdGY4%=JM5R z{PCGP<|+bin6VyVa#-EX<@IZKTjLek;)fL$u)9~cuRSpLHUp^qZ3`ptE(90W7ze#~ zHk^*b0Nf4`iee)X>AQ$Cba(A5v&|SX_`%D+Ll==&7$e0fEU$Thkh*61!SYu@mBX53 z*i~aA^QxP7)=cv&l4j@nt!tOmhm$)QtXzl)GQ z_Q6tK^!CaZxE?G341jJ>6Fdymz1xUcb!YuH!Wpib;Md7Qe1mZ#UA@EV2Ho1cgQ30~ zA%Y$TADXZ^yzvhJn8Pa{*0?$!H_e)Q)zoNPwUuS`aCwJuBEh$I%)r!++g2_N_-qgx z?=JY0CEJRK?*r@~T;JI+wQJjV2zV6%U<^a88ykv@b@9um+vX}_^x}teG0coLWWwmi z#@X4lKXl4Z_=|pU2CbvcUB1STs;^+mDH@etupHz4st&^k@kb7~zcSZv@uz;8fMZW* zp##dw9pI_oRE6i~O-4;J_=U@s;+VVJL^QyKkBIogx;O8DaA?+9-@fxe8T|m7%>{(O zS41&1OxEoOcC~hmdHnx7_K0M$TZ>)uHu)E@Ggkbj2x<6$JBI= z{*EYcM1dm;98uti0!I`$qQDUajwoDMw_?u4<=OF*@a|}iAW*_l83S#_aRai)5E&rP+pS*x z!?*$2ZhReQoD;;$G=nRbebhSV{09;2ORd|3ql`8LR0HV>q!!OQf z&+1T*=a&!hkrh-+arksAS%JzF zBTsjhd3$-Of}a2Vtz@8a*lpwN1>$#}mtEU$8*|9oFBOxA-txjPul^!75HI}VJT!4G zzN`uFo$NK;z2PxA?`dYQ$&p}-&JT1Sn1K60cI_j61=*ibBag#a6xR7~g#i9rNzOsF ze@MDmq zeh?_1HPj;kjS2QIh@%>n1a)$X<#FG4YXWhq?KdYlo1}Xg9hr zn7z#VgY?SDO;B*tcQ61N=lCJIN|(JHUZBf;!4LGY&R&ku`1?+46hxd_9W!{Tf<%wT zL-%8N?exRV$;hKSds$!aCQ)~{8#hp95L3rOp;vb6<&*4Xy+e)Ma*SHboti9uuoO(V z%sVyFO&VUT$?fREj9QbkkZQb9n!Vg|xdV@!GaugT$X=71kg8!N z20w?xXy-3L4Z3$h*v9e{FXh~{mvVAH3IkCi_Hz8lb(&y|BD(w*yY~w~Ta!^2EC!M) z^ukQWk|w0X`hBdzixr**UE znxc_8jBVrFEA$7}6+ZfhfuB>LT6l3KKlSe}u0U;s&ZXO)gp$vOcUJOQtB`vB_;~0# zo}X)T9bYsM@T|6AAi|yMO<)lE^yW*_rFLH69gECGnm+xJ{!4LK@}DCPOa7u1`Y;Yl z{_2NuSn`+Hh7-nN$*=vl;;`f|Q8kU?u;eT7=|wO!EX+;?&Txs)9WZ}?&%>;!uQ(NT za1-%b^0!wu>`cku58Y++*GpXA;O?HkV~Ut5@rON%Iab?Q30C&}{pAe(1i4s~YN(4G z>)s3Mh9BTpn!Q$n$apaK0vjysKfJ+NHpFGIKv|*zeO%%F3PT6cvRP_0D$D4{Rvk&n zASs$MZdju1t18RY;1>F7>n3vPDRj%+#8-9N>cuQV2Ws3%L-e>>SmT$th=b5RK*ArN zW>RK?CBq+|V*=M3fBZa?3rs#^@;Q@B0D1KHA5Z|2L=J@G;D3Mo3X=*G47NYM!sIHG zRVLS%tTEY$k{ir@dF!tH{)9&-z0p4O|7&(-&c- z&96%ST<`&E_3K(+-d>^W(A7Kep}M*wM>TpF(m$;Yz+paK0U-+x+Y&bc}kQ%&67)KS& z%~|7K5LGmH)u2dwR8h0ycq3HToGmQKy*9vM67WpQpFG`<_rs`WMW29A={>zl@Qb zzcTm9zl#W&{ZT^!jW+uOfpW~_h>(-A;xHzH!YF5dgbF+PDGPsJsleuoX5XNlHrCMUP=7uOY6tndd3QyDp zIpnLhn5~l+fQI|qDpBH?|P6mT$dzhPP+a8KB6<|bI{bRt+T)t(am@EEQ z19s*vw#35BT|6WfW)!e9_l5Rg2y^w(fStMJnSG}%U}tXST-{M%4h8I-v`}PN;J(%d z(2|L84(xMCz|P!_RwQp6f@Bo1GiNXI5=jQ^%za_yF2~o}G8C|L5St5J?w!1}kLluM zfS-enB`!D*BK_zGu*LW%9}U=vGa%2#>I~0-@`@c}BX-Eh+h&PIjeLRxV}#DaU7Qf* z_A1zNC&DE6D{{G4d>n|9lgu$0KhI>INs-AKlUq!_LxNbgK{dTAT;Zc26O`)eQD0;5 zYEp&A9}`L`tX3FfHGeFnVUbXA9f^-s%d*OR+_k4B7zw@_ra7 zH1|M-RnD+nON`LmZ_>FeYLVh4&ej+)B#zEWYI-N35QhTYLKmbspbczz<2DrKL0Azy zLxbcKVPMak4Zjq1p+D{d%XwkBJOV+qkq+y^KZejO+%^uXZC2jmkfDO#`p`TI<7nnT zp*_r`&7pBL^Orb`U+k|sb{e=XaWp4a+vbOas;quCj^+ZW%Q@2;M>Cith@+WT>|@6a z0>3zz=E9C&=xGV2S?D>xgP+F`m$U@a%p+74MxUzzR4e4d(}(<&72Fs>mrKzyDfvYW zkv$px|PO9#YIqtHDDuq!(5(=4q6R!e!97`^4hDgUtL#3}zP9}kI{IewxgW@hd| zTZ~49vok9&+L?#o4STV_IdEqFwoW8Ia)Onwx13<*stOg!I4saD08eKkixmeW!>B5X zo~aL-eu|#SM>l%3(KGcfj-JU2=Lv(rHS|+J7cBU4MEy($d0$UVCcsNT7zlk@iQ}EWlU3VnC1Se-e+9|L1+!83Dg(_=I?@O=5LEaO=Qp7 zlfB%7_?_lV7*_M|h78@pPbqykZalMzP6cyS1=x(ihlhmY-QiKs2aSswV!deannG>H zpopnsXA~y3r<_8_#ivmJHs0n(=RR?{Wc7`Vl^f${VNHgRIY3gH*~9=FE;|(@TRTYf zK|)439h>YyT0|iS$H%ENe9%M>VEJ1j@(Q|8s$QVNvh8Q;f34(1d8BIF?TCL4x7 zqIgxb3PTPO3fiDF(+PeQa&UZFqwtZCgX3R(7;G~>kb~owT0#zDkxQ~$ygSTt z9}77+{)PD<U~Z{Hr~V$HIa?{$Q6mPE)JbVef)=xj0bXJLN3a3dP1KXOOcS zZLR_98wIom>e@&!Enx^D%pr@LBE){=+%#vyK@*_|yLHsiNoG8>?Arrv1~jx}Tg4=D zu+EHs7al&3e-|G)htUSHRPtocl7u8Srb6&&g9^r|mRW!=FqY#ueuxnt{#~@e@t0w= zK}Z2mJc>3r{%gyDbgue$(FVu=_{ga=WD|#xU*jKja7ky|5JC=)a}zw?P+*BRvWH|E ze>V@_2!fk(4%WK*FcGOX?s^zEu}_&CD{W4e6D{hR-SNaxw2Bt@fx_*UNQH%N!%zh= z`^1q^LR|6*L@JzI<={=grKNDXEm9$sj`pa8wG{RNh)S4eye}v~{}h!l(2PO{mBOj0 z@fq3*uJMryX+gj7)x-=T3l#L@$fApj8E{xs!a}j-aJMk=?+$kZ)M8bQXqfPXw_vnm zRwA4=(kOyKeuQxg`!W7*v0}INc5cN12~Sb}4TRBzat{Pbi)$EnFrG7orPwhcj5`>@ zBa{#04i-KS&36IhkHj4$+rG7@rFQOzaR)WQ3hQCq!GOKF$T56X^yr6*2$?@LQx(=J z>*(lExFTvO?o1eWu<+$!Gk}3*b-0_9Ak$1C#jleOZit*=+`)W;@3uk`7w+)!LHrnt zjDP1nG5Ij!ruU)a#Dwz^$BD^dsjDq<2l)=#D?hZlP!yhg%!ML~JBYAZe-n4G@MDV$ zMd7=29c{F_P#h9>u<&D>3&n?V2Pf+-aR;s3{V&HI1QdoV