From 3774f5986a38a0471f1f96a9de834fd1bb12085f Mon Sep 17 00:00:00 2001 From: Lars Brinkhoff Date: Tue, 15 May 2018 06:40:25 +0200 Subject: [PATCH] C20, port to TOPS-20. --- c20/c.defs | 41 + c20/cc.hlp | 139 +++ c20/cinsrt-stinkr.mid | 76 ++ c20/cinsrt.mid | 76 ++ c20/ctype.h | 24 + c20/gt/cmac.gt | 115 ++ c20/gt/g0.c | 85 ++ c20/gt/g1.c | 505 ++++++++ c20/gt/g2.c | 153 +++ c20/gt/g3.c | 1045 ++++++++++++++++ c20/gt/g4.c | 308 +++++ c20/gt/g5.c | 276 +++++ c20/gt/get.ctl | Bin 0 -> 103 bytes c20/gt/gt.cmac | 7 + c20/gt/gt.h | 152 +++ c20/gt/gt.stinkr | Bin 0 -> 75 bytes c20/gt/h6000.gt | 282 +++++ c20/gt/pdp10.gt | 234 ++++ c20/gt/pdp10.gtout | 429 +++++++ c20/gt/pdp11.gt | 285 +++++ c20/gt/pdp20.gt | 234 ++++ c20/gt/unix.gt | 340 ++++++ c20/lex.h | 51 + c20/lex/base.c | 250 ++++ c20/lex/base.old | 250 ++++ c20/lex/bcpl.lxi | 149 +++ c20/lex/btob.c | 170 +++ c20/lex/btob.lxi | 51 + c20/lex/cap.c | 177 +++ c20/lex/cap.lxi | 33 + c20/lex/cap.stinkr | 4 + c20/lex/clex.c | 539 +++++++++ c20/lex/clex.lxi | 139 +++ c20/lex/commen.c | 32 + c20/lex/ctoc.c | 225 ++++ c20/lex/ctype.h | 24 + c20/lex/dfa.c | 200 +++ c20/lex/dfa.old | 200 +++ c20/lex/eclosu.c | 52 + c20/lex/foo.c | 94 ++ c20/lex/foo.lxi | 12 + c20/lex/foo.out | 58 + c20/lex/foo.stinkr | 4 + c20/lex/gettok.c | 24 + c20/lex/hword.c | 219 ++++ c20/lex/hword.lxi | 109 ++ c20/lex/impure.c | 65 + c20/lex/integ.c | 28 + c20/lex/lex-source-files.cmd | 1 + c20/lex/lex.c | 568 +++++++++ c20/lex/lex.ccl | 1 + c20/lex/lex.ctl | 19 + c20/lex/lex.h | 51 + c20/lex/lex.hlp | Bin 0 -> 2506 bytes c20/lex/lex.log | 172 +++ c20/lex/lex.mem | 1717 ++++++++++++++++++++++++++ c20/lex/lex.old | 660 ++++++++++ c20/lex/lex.rnh | 75 ++ c20/lex/lex.rno | 2084 ++++++++++++++++++++++++++++++++ c20/lex/lex.stinkr | 11 + c20/lex/lex.y | 596 +++++++++ c20/lex/lexcha.c | 19 + c20/lex/lexech.c | 28 + c20/lex/lexerr.c | 20 + c20/lex/lexerr.old | 31 + c20/lex/lexget.c | 26 + c20/lex/lexlen.c | 20 + c20/lex/lexlex.h | 155 +++ c20/lex/lexlex.old | 150 +++ c20/lex/lexlib.ctl | 23 + c20/lex/lexlib.mic | 2 + c20/lex/lexlib.stinkr | 16 + c20/lex/lexpee.c | 17 + c20/lex/lexsrt.c | 120 ++ c20/lex/lexswi.c | 28 + c20/lex/lextab.c | 62 + c20/lex/llsave.c | 9 + c20/lex/lmovb.c | 35 + c20/lex/lmovi.c | 34 + c20/lex/mapch.c | 67 + c20/lex/min.c | 180 +++ c20/lex/obase.c | 208 ++++ c20/lex/ocap.c | 215 ++++ c20/lex/ocap.lxi | 33 + c20/lex/out.c | 400 ++++++ c20/lex/out.old | 368 ++++++ c20/lex/out1.c | 306 +++++ c20/lex/out2.c | 140 +++ c20/lex/readme.604 | 19 + c20/lex/token.c | 21 + c20/lex/word.c | 194 +++ c20/lex/word.lxi | 73 ++ c20/lex/word.oc | 164 +++ c20/lex/ytab.c | 948 +++++++++++++++ c20/lex/ytab.h | 5 + c20/lex/ytab.old | 946 +++++++++++++++ c20/lex/yylex.c | 174 +++ c20/lex/yylex.c-2 | 176 +++ c20/minsrt.mid | 0 c20/mulseg.mid | Bin 0 -> 1586 bytes c20/nc.mid | 62 + c20/new/cc.c | 622 ++++++++++ c20/new/cc.stinkr | 7 + c20/new/cinsrt.mid | 53 + c20/new/doc/cc.bwr | 29 + c20/new/doc/cc.doc | 265 ++++ c20/new/doc/cc.hlp | 105 ++ c20/new/doc/debug.doc | 36 + c20/new/doc/extensions.doc | 94 ++ c20/new/doc/install.doc | 84 ++ c20/new/doc/int.doc | 98 ++ c20/new/doc/jsys.doc | 68 ++ c20/new/doc/stinkr.doc | 63 + c20/new/file.cmd | 1 + c20/new/include/ctype.h | 24 + c20/new/include/int.h | 21 + c20/new/include/jsys.h | 332 +++++ c20/new/include/setjmp.h | 7 + c20/new/include/stdio.h | 52 + c20/new/lib/ac.c | 289 +++++ c20/new/lib/c20ati.c | 69 ++ c20/new/lib/c20blt.cmid | 19 + c20/new/lib/c20flt.cmid | 212 ++++ c20/new/lib/c20fnm.c | 336 +++++ c20/new/lib/c20fpr.c | 538 +++++++++ c20/new/lib/c20int.c | 87 ++ c20/new/lib/c20io.c | 2058 +++++++++++++++++++++++++++++++ c20/new/lib/c20lib.cmid | 28 + c20/new/lib/c20lod.cmid | 82 ++ c20/new/lib/c20mem.c | 708 +++++++++++ c20/new/lib/c20pip.cmid | 312 +++++ c20/new/lib/c20prt.c | 349 ++++++ c20/new/lib/c20run.cmid | 439 +++++++ c20/new/lib/c20scn.c | 297 +++++ c20/new/lib/c20str.cmid | 245 ++++ c20/new/lib/c20sys.cmid | 705 +++++++++++ c20/new/lib/c20tty.c | 285 +++++ c20/new/lib/c20typ.c | 141 +++ c20/new/lib/c2ddbg.c | 79 ++ c20/new/lib/c2ddrn.cmid | 248 ++++ c20/new/lib/c2dmdb.cmid | 14 + c20/new/lib/cddt.c | 353 ++++++ c20/new/lib/date.c | 229 ++++ c20/new/lib/echo.c | 11 + c20/new/lib/echo.stinkr | 3 + c20/new/lib/exec.c | 151 +++ c20/new/lib/files.c | 132 ++ c20/new/lib/grep.c | 451 +++++++ c20/new/lib/hpio.c | 423 +++++++ c20/new/lib/hpplotter.c | 491 ++++++++ c20/new/lib/hpplotter.h | 35 + c20/new/lib/puz.c | 164 +++ c20/new/lib/puz.stinkr | Bin 0 -> 27 bytes c20/new/lib/puzzle.c | Bin 0 -> 3600 bytes c20/new/lib/puzzle.stinkr | Bin 0 -> 32 bytes c20/new/lib/qsort.c | 185 +++ c20/new/lib/random.cmid | 30 + c20/new/lib/setjmp.cmid | 65 + c20/new/lib/string.c | 90 ++ c20/new/license.note | 10 + c20/new/minsrt.mid | 122 ++ c20/new/mulseg.mid | 74 ++ c20/new/ncc.c | 623 ++++++++++ c20/new/pcc.stat | 50 + c20/new/pcc20.c | 593 +++++++++ c20/new/pcc20.stat | 5 + c20/new/pcc20.stinkr | 4 + c20/new/rel/cinsrt.mid | 61 + c20/new/rel/decseg.mid | 44 + c20/new/stddbg.stinkr | 22 + c20/new/stdio.stinkr | 20 + c20/new/tape.ctl | 25 + c20/new/tape.files | 56 + c20/new/testc.c | 487 ++++++++ c20/new/yaccpar. | 140 +++ c20/nm.mid | 166 +++ c20/oyacc.hlp | 341 ++++++ c20/pcc20.c | 593 +++++++++ c20/pcc20.hlp | 100 ++ c20/pcc20.stat | 634 ++++++++++ c20/pcc20lib/-read-.-this- | 30 + c20/pcc20lib/ac.broken | 268 ++++ c20/pcc20lib/ac.c | 275 +++++ c20/pcc20lib/all.ctl | 23 + c20/pcc20lib/all.log | Bin 0 -> 7470 bytes c20/pcc20lib/alloc.c | 797 ++++++++++++ c20/pcc20lib/apfnam.c | 25 + c20/pcc20lib/atoi.c | 69 ++ c20/pcc20lib/blt.cmid | Bin 0 -> 220 bytes c20/pcc20lib/c.defs | 41 + c20/pcc20lib/c20dat.c | 81 ++ c20/pcc20lib/c20exc.c | 146 +++ c20/pcc20lib/c20exp.c | 49 + c20/pcc20lib/c20fd.c | 38 + c20/pcc20lib/c20fil.c | 59 + c20/pcc20lib/c20fnm.c | 312 +++++ c20/pcc20lib/c20hak.c | 24 + c20/pcc20lib/c20int.c | 49 + c20/pcc20lib/c20io.c | 1663 +++++++++++++++++++++++++ c20/pcc20lib/c20lib.cmid | 0 c20/pcc20lib/c20lod.cmid | 0 c20/pcc20lib/c20pip.cmid | 313 +++++ c20/pcc20lib/c20run.cmid | 237 ++++ c20/pcc20lib/c20std.c | 392 ++++++ c20/pcc20lib/c20sys.cmid | Bin 0 -> 6641 bytes c20/pcc20lib/c20tty.c | 278 +++++ c20/pcc20lib/cfloat.cmid | Bin 0 -> 2952 bytes c20/pcc20lib/clib.ccl | 31 + c20/pcc20lib/clib.mic | 40 + c20/pcc20lib/cprint.c | 347 ++++++ c20/pcc20lib/ctype.c | 21 + c20/pcc20lib/ctype.h | 24 + c20/pcc20lib/date.c | 142 +++ c20/pcc20lib/fprint.c | 534 ++++++++ c20/pcc20lib/full-stdio.stinkr | 32 + c20/pcc20lib/hack.for | 155 +++ c20/pcc20lib/hack2.mac | 11 + c20/pcc20lib/halves.cmid | Bin 0 -> 121 bytes c20/pcc20lib/math.h | 6 + c20/pcc20lib/pr60th.c | 54 + c20/pcc20lib/random.cmid | 31 + c20/pcc20lib/scanf.c | 306 +++++ c20/pcc20lib/setjmp.cmid | 65 + c20/pcc20lib/stdio.h | Bin 0 -> 1215 bytes c20/pcc20lib/stdio.stinkr | 31 + c20/pcc20lib/string.cmid | 125 ++ c20/pcc20lib/stringp.c | 89 ++ c20/setjmp.h | 4 + c20/stdio.h | 40 + c20/stinkr/s.h | 86 ++ c20/stinkr/s10.stinkr | 11 + c20/stinkr/sjob.c | 98 ++ c20/stinkr/sjob10.c | 116 ++ c20/stinkr/sjob20.c | 167 +++ c20/stinkr/sload.c | 262 ++++ c20/stinkr/sread.c | 531 ++++++++ c20/stinkr/ssym.c | 230 ++++ c20/stinkr/stinkr.c | 353 ++++++ c20/stinkr/stinkr.stinkr | 10 + c20/yacc.hlp | 75 ++ c20/yacc.par | 149 +++ c20/yerror.c | 32 + c20/yparse.c | 535 ++++++++ 243 files changed, 45810 insertions(+) create mode 100644 c20/c.defs create mode 100644 c20/cc.hlp create mode 100644 c20/cinsrt-stinkr.mid create mode 100644 c20/cinsrt.mid create mode 100644 c20/ctype.h create mode 100644 c20/gt/cmac.gt create mode 100644 c20/gt/g0.c create mode 100644 c20/gt/g1.c create mode 100644 c20/gt/g2.c create mode 100644 c20/gt/g3.c create mode 100644 c20/gt/g4.c create mode 100644 c20/gt/g5.c create mode 100644 c20/gt/get.ctl create mode 100644 c20/gt/gt.cmac create mode 100644 c20/gt/gt.h create mode 100644 c20/gt/gt.stinkr create mode 100644 c20/gt/h6000.gt create mode 100644 c20/gt/pdp10.gt create mode 100644 c20/gt/pdp10.gtout create mode 100644 c20/gt/pdp11.gt create mode 100644 c20/gt/pdp20.gt create mode 100644 c20/gt/unix.gt create mode 100644 c20/lex.h create mode 100644 c20/lex/base.c create mode 100644 c20/lex/base.old create mode 100644 c20/lex/bcpl.lxi create mode 100644 c20/lex/btob.c create mode 100644 c20/lex/btob.lxi create mode 100644 c20/lex/cap.c create mode 100644 c20/lex/cap.lxi create mode 100644 c20/lex/cap.stinkr create mode 100644 c20/lex/clex.c create mode 100644 c20/lex/clex.lxi create mode 100644 c20/lex/commen.c create mode 100644 c20/lex/ctoc.c create mode 100644 c20/lex/ctype.h create mode 100644 c20/lex/dfa.c create mode 100644 c20/lex/dfa.old create mode 100644 c20/lex/eclosu.c create mode 100644 c20/lex/foo.c create mode 100644 c20/lex/foo.lxi create mode 100644 c20/lex/foo.out create mode 100644 c20/lex/foo.stinkr create mode 100644 c20/lex/gettok.c create mode 100644 c20/lex/hword.c create mode 100644 c20/lex/hword.lxi create mode 100644 c20/lex/impure.c create mode 100644 c20/lex/integ.c create mode 100644 c20/lex/lex-source-files.cmd create mode 100644 c20/lex/lex.c create mode 100644 c20/lex/lex.ccl create mode 100644 c20/lex/lex.ctl create mode 100644 c20/lex/lex.h create mode 100644 c20/lex/lex.hlp create mode 100644 c20/lex/lex.log create mode 100644 c20/lex/lex.mem create mode 100644 c20/lex/lex.old create mode 100644 c20/lex/lex.rnh create mode 100644 c20/lex/lex.rno create mode 100644 c20/lex/lex.stinkr create mode 100644 c20/lex/lex.y create mode 100644 c20/lex/lexcha.c create mode 100644 c20/lex/lexech.c create mode 100644 c20/lex/lexerr.c create mode 100644 c20/lex/lexerr.old create mode 100644 c20/lex/lexget.c create mode 100644 c20/lex/lexlen.c create mode 100644 c20/lex/lexlex.h create mode 100644 c20/lex/lexlex.old create mode 100644 c20/lex/lexlib.ctl create mode 100644 c20/lex/lexlib.mic create mode 100644 c20/lex/lexlib.stinkr create mode 100644 c20/lex/lexpee.c create mode 100644 c20/lex/lexsrt.c create mode 100644 c20/lex/lexswi.c create mode 100644 c20/lex/lextab.c create mode 100644 c20/lex/llsave.c create mode 100644 c20/lex/lmovb.c create mode 100644 c20/lex/lmovi.c create mode 100644 c20/lex/mapch.c create mode 100644 c20/lex/min.c create mode 100644 c20/lex/obase.c create mode 100644 c20/lex/ocap.c create mode 100644 c20/lex/ocap.lxi create mode 100644 c20/lex/out.c create mode 100644 c20/lex/out.old create mode 100644 c20/lex/out1.c create mode 100644 c20/lex/out2.c create mode 100644 c20/lex/readme.604 create mode 100644 c20/lex/token.c create mode 100644 c20/lex/word.c create mode 100644 c20/lex/word.lxi create mode 100644 c20/lex/word.oc create mode 100644 c20/lex/ytab.c create mode 100644 c20/lex/ytab.h create mode 100644 c20/lex/ytab.old create mode 100644 c20/lex/yylex.c create mode 100644 c20/lex/yylex.c-2 create mode 100644 c20/minsrt.mid create mode 100644 c20/mulseg.mid create mode 100644 c20/nc.mid create mode 100644 c20/new/cc.c create mode 100644 c20/new/cc.stinkr create mode 100644 c20/new/cinsrt.mid create mode 100644 c20/new/doc/cc.bwr create mode 100644 c20/new/doc/cc.doc create mode 100644 c20/new/doc/cc.hlp create mode 100644 c20/new/doc/debug.doc create mode 100644 c20/new/doc/extensions.doc create mode 100644 c20/new/doc/install.doc create mode 100644 c20/new/doc/int.doc create mode 100644 c20/new/doc/jsys.doc create mode 100644 c20/new/doc/stinkr.doc create mode 100644 c20/new/file.cmd create mode 100644 c20/new/include/ctype.h create mode 100644 c20/new/include/int.h create mode 100644 c20/new/include/jsys.h create mode 100644 c20/new/include/setjmp.h create mode 100644 c20/new/include/stdio.h create mode 100644 c20/new/lib/ac.c create mode 100644 c20/new/lib/c20ati.c create mode 100644 c20/new/lib/c20blt.cmid create mode 100644 c20/new/lib/c20flt.cmid create mode 100644 c20/new/lib/c20fnm.c create mode 100644 c20/new/lib/c20fpr.c create mode 100644 c20/new/lib/c20int.c create mode 100644 c20/new/lib/c20io.c create mode 100644 c20/new/lib/c20lib.cmid create mode 100644 c20/new/lib/c20lod.cmid create mode 100644 c20/new/lib/c20mem.c create mode 100644 c20/new/lib/c20pip.cmid create mode 100644 c20/new/lib/c20prt.c create mode 100644 c20/new/lib/c20run.cmid create mode 100644 c20/new/lib/c20scn.c create mode 100644 c20/new/lib/c20str.cmid create mode 100644 c20/new/lib/c20sys.cmid create mode 100644 c20/new/lib/c20tty.c create mode 100644 c20/new/lib/c20typ.c create mode 100644 c20/new/lib/c2ddbg.c create mode 100644 c20/new/lib/c2ddrn.cmid create mode 100644 c20/new/lib/c2dmdb.cmid create mode 100644 c20/new/lib/cddt.c create mode 100644 c20/new/lib/date.c create mode 100644 c20/new/lib/echo.c create mode 100644 c20/new/lib/echo.stinkr create mode 100644 c20/new/lib/exec.c create mode 100644 c20/new/lib/files.c create mode 100644 c20/new/lib/grep.c create mode 100644 c20/new/lib/hpio.c create mode 100644 c20/new/lib/hpplotter.c create mode 100644 c20/new/lib/hpplotter.h create mode 100644 c20/new/lib/puz.c create mode 100644 c20/new/lib/puz.stinkr create mode 100644 c20/new/lib/puzzle.c create mode 100644 c20/new/lib/puzzle.stinkr create mode 100644 c20/new/lib/qsort.c create mode 100644 c20/new/lib/random.cmid create mode 100644 c20/new/lib/setjmp.cmid create mode 100644 c20/new/lib/string.c create mode 100644 c20/new/license.note create mode 100644 c20/new/minsrt.mid create mode 100644 c20/new/mulseg.mid create mode 100644 c20/new/ncc.c create mode 100644 c20/new/pcc.stat create mode 100644 c20/new/pcc20.c create mode 100644 c20/new/pcc20.stat create mode 100644 c20/new/pcc20.stinkr create mode 100644 c20/new/rel/cinsrt.mid create mode 100644 c20/new/rel/decseg.mid create mode 100644 c20/new/stddbg.stinkr create mode 100644 c20/new/stdio.stinkr create mode 100644 c20/new/tape.ctl create mode 100644 c20/new/tape.files create mode 100644 c20/new/testc.c create mode 100644 c20/new/yaccpar. create mode 100644 c20/nm.mid create mode 100644 c20/oyacc.hlp create mode 100644 c20/pcc20.c create mode 100644 c20/pcc20.hlp create mode 100644 c20/pcc20.stat create mode 100644 c20/pcc20lib/-read-.-this- create mode 100644 c20/pcc20lib/ac.broken create mode 100644 c20/pcc20lib/ac.c create mode 100644 c20/pcc20lib/all.ctl create mode 100644 c20/pcc20lib/all.log create mode 100644 c20/pcc20lib/alloc.c create mode 100644 c20/pcc20lib/apfnam.c create mode 100644 c20/pcc20lib/atoi.c create mode 100644 c20/pcc20lib/blt.cmid create mode 100644 c20/pcc20lib/c.defs create mode 100644 c20/pcc20lib/c20dat.c create mode 100644 c20/pcc20lib/c20exc.c create mode 100644 c20/pcc20lib/c20exp.c create mode 100644 c20/pcc20lib/c20fd.c create mode 100644 c20/pcc20lib/c20fil.c create mode 100644 c20/pcc20lib/c20fnm.c create mode 100644 c20/pcc20lib/c20hak.c create mode 100644 c20/pcc20lib/c20int.c create mode 100644 c20/pcc20lib/c20io.c create mode 100644 c20/pcc20lib/c20lib.cmid create mode 100644 c20/pcc20lib/c20lod.cmid create mode 100644 c20/pcc20lib/c20pip.cmid create mode 100644 c20/pcc20lib/c20run.cmid create mode 100644 c20/pcc20lib/c20std.c create mode 100644 c20/pcc20lib/c20sys.cmid create mode 100644 c20/pcc20lib/c20tty.c create mode 100644 c20/pcc20lib/cfloat.cmid create mode 100644 c20/pcc20lib/clib.ccl create mode 100644 c20/pcc20lib/clib.mic create mode 100644 c20/pcc20lib/cprint.c create mode 100644 c20/pcc20lib/ctype.c create mode 100644 c20/pcc20lib/ctype.h create mode 100644 c20/pcc20lib/date.c create mode 100644 c20/pcc20lib/fprint.c create mode 100644 c20/pcc20lib/full-stdio.stinkr create mode 100644 c20/pcc20lib/hack.for create mode 100644 c20/pcc20lib/hack2.mac create mode 100644 c20/pcc20lib/halves.cmid create mode 100644 c20/pcc20lib/math.h create mode 100644 c20/pcc20lib/pr60th.c create mode 100644 c20/pcc20lib/random.cmid create mode 100644 c20/pcc20lib/scanf.c create mode 100644 c20/pcc20lib/setjmp.cmid create mode 100644 c20/pcc20lib/stdio.h create mode 100644 c20/pcc20lib/stdio.stinkr create mode 100644 c20/pcc20lib/string.cmid create mode 100644 c20/pcc20lib/stringp.c create mode 100644 c20/setjmp.h create mode 100644 c20/stdio.h create mode 100644 c20/stinkr/s.h create mode 100644 c20/stinkr/s10.stinkr create mode 100644 c20/stinkr/sjob.c create mode 100644 c20/stinkr/sjob10.c create mode 100644 c20/stinkr/sjob20.c create mode 100644 c20/stinkr/sload.c create mode 100644 c20/stinkr/sread.c create mode 100644 c20/stinkr/ssym.c create mode 100644 c20/stinkr/stinkr.c create mode 100644 c20/stinkr/stinkr.stinkr create mode 100644 c20/yacc.hlp create mode 100644 c20/yacc.par create mode 100644 c20/yerror.c create mode 100644 c20/yparse.c diff --git a/c20/c.defs b/c20/c.defs new file mode 100644 index 00000000..4a73ee22 --- /dev/null +++ b/c20/c.defs @@ -0,0 +1,41 @@ +/* C Standard Definitions, for TOPS-20 */ + +/* data types */ + +struct _cal {int year, month, day, hour, minute, second;}; +# define cal struct _cal + +struct _tag {int *pc, *fp, *ap, *sp, regs[10];}; +# define tag struct _tag + + +/* common values */ + +# define TRUE 1 +# define FALSE 0 + +# define OPENLOSS (-1) /* returned by COPEN if lose */ +# define EOF_VALUE 0 /* returned by CGETC if EOF */ + +# define channel *int + +/* C interrupts */ + +# define INT_DEFAULT 0 +# define INT_IGNORE 1 + +/* 0-5, 23-35 are user assignable */ + +# define aov_interrupt 6 /* arithmetic overflow */ +# define fov_interrupt 7 /* floating point overflow */ +# define eof_interrupt 10 /* end of file */ +# define dae_interrupt 11 /* data error */ +# define qta_interrupt 12 /* quota exceeded or disk full */ +# define ili_interrupt 15 /* illegal instruction */ +# define ird_interrupt 16 /* illegal memory read */ +# define iwr_interrupt 17 /* illegal memory write */ +# define ift_interrupt 19 /* inferior process termination */ +# define mse_interrupt 20 /* system resources exhausted */ +# define nxp_interrupt 22 /* non-existent page */ + +# define halves(l, r) (((l) << 18) | ((r) & 0777777)) diff --git a/c20/cc.hlp b/c20/cc.hlp new file mode 100644 index 00000000..c6c1f928 --- /dev/null +++ b/c20/cc.hlp @@ -0,0 +1,139 @@ +C Info (30 July 1979) + +--- C --- + +C is an implementation language, similar to BCPL except with data +types. It is the primary language used in the Unix operating system. +This implementation runs on the ITS and TOPS-20 operating systems. +(The ITS implementation exists only on DM.) This implementation is +moderately compatible with the Unix C implementation. The Unix +system calls are NOT implemented. Some implemented library routines +are described below. + +Further information is available from Eliot Moss (EBM@XX). + +--- Compiling --- + +CC is the C compiler command. Usage is + + :cc file1.c file2.c ... + +where the arguments are the path names of C source files which are to +be compiled. Each file will be compiled in turn, and if the compilation +is successful, the resulting relocatable file will be placed in the file +"file*.stk". [The ITS compiler currently produces "file*.rel". This will +soon be changed.] Arguments beginning with the '-' character are taken +to be compiler options. Available options include: + + -c compile only, do not assemble + -g do not delete MIDAS file + -x syntax check only + -s produce a symbol table listing + -b compile big function (FUNCTION TOO LARGE) + +For example, the command + + :cc foo.c + +would compile the C program in the file "foo.c" ("FOO C" on ITS) in the +current directory, and place the resulting relocatable program in the file +"foo.stk" ("FOO STK" on ITS). + +--- Loading --- + +Relocatable programs produced by the C compiler are loaded together +with the C support routines using the STINKR loader. To load program +files "foo", "bar", and "bletch" and produce a runnable file "foo", +type the following to STINKR: + + (TOPS-20: (ITS: + + x clib x c/clib + l foo l foo + l bar l bar + l bletch l bletch + o foo.exe o ts.foo + ^Z ^@ + +The ^@ (ASCII NUL) or ^Z terminates the terminal input file. +The ^Z must be followed by a CR. These commands (minus the ^@) +could also be written in a file, say "foo.stinkr" ("FOO STINKR" +on ITS), in which case one could invoke STINKR with "foo" as a +JCL argument and STINKR would read the commands from the +command file. + +--- Library --- + +The above STINKR commands will load in a set of library routines +for performing I/O, etc. These routines are similar to the +Unix "Portable I/O Library". A brief description of the most useful +routines follows: + +char c; /* an ASCII character */ +int i, n, cc; /* an integer */ +int *p; /* an integer pointer */ +int b; /* a boolean */ +char *s, *s1, *s2; /* strings */ +char *fn; /* an ITS file name or a path name */ +int fd; /* a "file descriptor" */ + +fd = copen (fn, mode, options); /* open file */ + char mode; /* 'r', 'w', or 'a' (append) */ + char *options; /* 0 (char I/O), "s" (string file), "b" (binary) */ + /* for string file, pass string as fn */ + /* returns -1 if open fails */ + +extern int cin; /* standard input - pre-existing */ +extern int cout; /* standard output - pre-existing */ +extern int cerr; /* standard error ouput - pre-existing */ + +c = cgetc (fd); /* get character; returns 0 if eof */ +c = cputc (c, fd); /* put character */ +b = ceof (fd); /* test for end of file */ +cclose (fd); /* close file */ + +c = getchar (); /* equivalent to cgetc(cin) */ +putchar (c); /* equivalent to cputc(c,cout) */ + +gets (s1); /* read string (line) from cin */ +puts (s1); /* put string and newline to cout */ + +cprint (fd, format, arg...); /* formatted print routine */ + /* the format is a string which may contain format items + of the form %nf, where n is an optional decimal integer + (the minimum field width) and f is one of the following + characters: + + d - print next arg (an integer) in decimal + o - print next arg (an integer) in octal + s - print next arg (a string) + c - print next arg (a character) + + The file descriptor FD can be omitted, in which case + COUT is used. + */ + +i = cgeti (fd); /* get integer (binary input) */ +i = cputi (i, fd); /* put integer (binary output) */ + +b = istty (fd); /* test if file is a TTY */ + +c = utyi (); /* read char from TTY (unbuffered, no echo) */ +utyo (c); /* output char to TTY (unbuffered) */ +tyo_flush (); /* flush TTY output buffer */ + +cexit (cc); /* terminate job, closing all files */ + /* returning from "main" is equivalent */ + + /* STRING Routines */ + +i = slen (s); /* find string length */ +stcpy (s1, s2); /* copy string from S1 to S2 */ +b = stcmp (s1, s2); /* compare strings */ + +/* storage allocation */ + +p = salloc (n); /* allocate n words, return pointer to it */ +sfree (p); /* free storage allocated by salloc */ +s = calloc (n); /* allocate n characters, return ptr to it */ +cfree (s); /* free storage allocated by calloc */ diff --git a/c20/cinsrt-stinkr.mid b/c20/cinsrt-stinkr.mid new file mode 100644 index 00000000..1bf0c036 --- /dev/null +++ b/c20/cinsrt-stinkr.mid @@ -0,0 +1,76 @@ +; PS:CINSRT.MID + +; This file is needed to assemble MIDAS programs produced by +; the "new" C compiler as well as hand-coded MIDAS programs designed +; to be loaded with C programs. + +;.SYMTAB 4000.,4000. +.symtab 6089.,4001. + +RELOCATABLE +.INSRT PS:MULSEG +.MSEG 400000',500000' + +IF1,[ +.MLLIT==1 + +A=1 +B=2 +C=3 +D=4 +EP=14. +P=15. +GO=JRST + +EQUALS ENTRY .GLOBAL +EQUALS EXTERN .GLOBAL + +.GLOBAL CFLOAT +.GLOBAL CFIX + +DEFINE .IDATA +.SEG 0 +TERMIN + +DEFINE .CODE +.SEG 1 +TERMIN + +DEFINE .PDATA +.SEG 2 +TERMIN + +; STACK HACKING FOR VARIABLE REFERENCES + +DEFINE PPUSH [A] + PUSH P,A + TERMIN + +DEFINE PPOP [A] + POP P,A + TERMIN + +DEFINE CCALL N,F + PUSHJ P,F + HRRI P,%V(EP) + TERMIN + +];END IF1 + +IF2,[IFDEF FS1,[ + .KILL A,B,C,D,EP,P,GO + ]] + +; HACK FOR CONSTANTS + +EQUALS NM%EN END +EXPUNGE END +DEFINE END ENDLOC + .CODE +; INSCODE + .PDATA + CONSTANTS + NM%EN ENDLOC + TERMIN + +.CODE diff --git a/c20/cinsrt.mid b/c20/cinsrt.mid new file mode 100644 index 00000000..1bf0c036 --- /dev/null +++ b/c20/cinsrt.mid @@ -0,0 +1,76 @@ +; PS:CINSRT.MID + +; This file is needed to assemble MIDAS programs produced by +; the "new" C compiler as well as hand-coded MIDAS programs designed +; to be loaded with C programs. + +;.SYMTAB 4000.,4000. +.symtab 6089.,4001. + +RELOCATABLE +.INSRT PS:MULSEG +.MSEG 400000',500000' + +IF1,[ +.MLLIT==1 + +A=1 +B=2 +C=3 +D=4 +EP=14. +P=15. +GO=JRST + +EQUALS ENTRY .GLOBAL +EQUALS EXTERN .GLOBAL + +.GLOBAL CFLOAT +.GLOBAL CFIX + +DEFINE .IDATA +.SEG 0 +TERMIN + +DEFINE .CODE +.SEG 1 +TERMIN + +DEFINE .PDATA +.SEG 2 +TERMIN + +; STACK HACKING FOR VARIABLE REFERENCES + +DEFINE PPUSH [A] + PUSH P,A + TERMIN + +DEFINE PPOP [A] + POP P,A + TERMIN + +DEFINE CCALL N,F + PUSHJ P,F + HRRI P,%V(EP) + TERMIN + +];END IF1 + +IF2,[IFDEF FS1,[ + .KILL A,B,C,D,EP,P,GO + ]] + +; HACK FOR CONSTANTS + +EQUALS NM%EN END +EXPUNGE END +DEFINE END ENDLOC + .CODE +; INSCODE + .PDATA + CONSTANTS + NM%EN ENDLOC + TERMIN + +.CODE diff --git a/c20/ctype.h b/c20/ctype.h new file mode 100644 index 00000000..d314c058 --- /dev/null +++ b/c20/ctype.h @@ -0,0 +1,24 @@ +#define _U 01 +#define _L 02 +#define _N 04 +#define _S 010 +#define _P 020 +#define _C 040 +#define _X 0100 + +extern char _ctype_[]; + +#define isalpha(c) ((_ctype_+1)[c]&(_U|_L)) +#define isupper(c) ((_ctype_+1)[c]&_U) +#define islower(c) ((_ctype_+1)[c]&_L) +#define isdigit(c) ((_ctype_+1)[c]&_N) +#define isxdigit(c) ((_ctype_+1)[c]&(_N|_X)) +#define isspace(c) ((_ctype_+1)[c]&_S) +#define ispunct(c) ((_ctype_+1)[c]&_P) +#define isalnum(c) ((_ctype_+1)[c]&(_U|_L|_N)) +#define isprint(c) ((_ctype_+1)[c]&(_P|_U|_L|_N)) +#define iscntrl(c) ((_ctype_+1)[c]&_C) +#define isascii(c) ((unsigned)(c)<=0177) +#define toupper(c) ((c)-'a'+'A') +#define tolower(c) ((c)-'A'+'a') +#define toascii(c) ((c)&0177) diff --git a/c20/gt/cmac.gt b/c20/gt/cmac.gt new file mode 100644 index 00000000..8599f6bf --- /dev/null +++ b/c20/gt/cmac.gt @@ -0,0 +1,115 @@ +typenames (char, int, float, double); +regnames (a, b); +memnames (reg, auto, ext, stat, param, label, intlit, floatlit, + stringlit, ia, ib); +size 1 (char, int, float, double); +align 1 (char, int, float, double); +class r (a, b); +saveareasize 8; +pointer p0 (1); +offsetrange p0 (0, 0); +returnreg a (int, double, p0); +type char(r), int(r), float(r), double(r), p0(r); + +.sw: a,,1; + ++i: -i: *i: /i: %: <<: >>: +&: .OR: ^: +p0: -p0: -p0p0: a,b,a; + +.BNOT: -ui: r,,1; + +&u0: M,,r; + +.ic: .ci: .ip0: .p0i: r,,1; + +==p0: !=p0: p0: <=p0: >=p0: +==i: !=i: i: <=i: >=i: a,b,label; + +==0p0: !=0p0: a,,label; + + +macros + ++i: " CADD" +-i: " CSUB" +*i: " CMUL" +/i: " CDIV" +%: " CMOD" +<<: " CLS" +>>: " CRS" +&: " CAND" +.OR: " COR" +^: " CXOR" ++p0: " PINC" +-p0: " PDEC" +-p0p0: " PSUB" +-ui: " CMINUS #R" +.BNOT: " CNOT #R" + +&u0: + (auto,,): " LAAUTO #R,#F" + (ext,,): " LAEXTN #R,#F" + (stat,,): " LASTAT #R,#F" + (param,,): " LAPARM #R,#F" + (stringlit,,): " LASTRG #R,#F" + +==i: ==p0: " JEQ #R" +!=i: !=p0: " JNE #R" +i: >p0: " JGT #R" +<=i: <=p0: " JLE #R" +>=i: >=p0: " JGE #R" + +==0p0: " JNULL #R" +!=0p0: " JNNULL #R" + +.cc: .ii: .p0p0: + (r,,r): " LREG #R,#F" + (auto,,): " LAUTO #R,#F" + (ext,,): " LEXTRN #R,#F" + (stat,,): " LSTAT #R,#F" + (param,,): " LPARM #R,#F" + (ia|ib,,): " LVPTR #R,#F" + (intlit,,): " LLIT #R,#F" + (,,auto): " STAUTO #F,#R" + (,,ext): " STEXTN #F,#R" + (,,stat): " STSTAT #F,#R" + (,,param): " STPARM #F,#R" + (,,ia|ib): " STVPTR #F,#R" + +.ic: .ci: +.ip0: .p0i: "\" + +hd: " HEAD" +end: " CEND" +en: " CENTRY #0" +ex: " CEXTRN #0" + +eq: " CEQU #0" +l: " LABDEF #0" +st: " STATIC #0" +ln: " LINNUM #0" + +ad0: + (,,ext): " ADCON #R" + (,,stat): " SADCON #R" +in: c: " INTCON #0" +lc: " LABCON #0" +sc: " STRCON #0" +z: " CZERO #0" + +p: " PROLOG #0,%i(#1)" +ep: " EPILOG #0,#1" +ca: + (ext,,): " CCALL #0,#1,#F" + (ia|ib,,): " CALREG #0,#1,#F" +rt: " CRETRN" +go: " CGOTO #R" +ts: " TSWITCH #0,#5,#2" +ets: " ETSWIT #0,#5,#2" +ls: " LSWITCH #0,#2" +els: " ELSWIT #0,#2" + +pu: pd: " PURE" +im: da: " IMPURE" +al: "\" diff --git a/c20/gt/g0.c b/c20/gt/g0.c new file mode 100644 index 00000000..73353e17 --- /dev/null +++ b/c20/gt/g0.c @@ -0,0 +1,85 @@ +# include "gt.h" + +/* + + GT Compiler + Section 0: Command Routine + +*/ + +/********************************************************************** + + Command Usage: GT {-options} source.file + + Output is written on the file "source.gtout". + + Options: + d - print parser debugging info + t - print tokens + +**********************************************************************/ + + +/********************************************************************** + + External Routines used by GT compiler: + + copen open file for input/output + cgetc read character + cputc write character + ceof test for end-of-file + cclose close file + cexit terminate process + apfname append suffix to file name + + plus C24.C (parser) and C96.C (cprint) + +**********************************************************************/ + +char *fn_source, + *fn_out, + fnbuff[40]; + +main (argc, argv) int argc; char *argv[]; + + {int f, i, c; + extern int debug, tflag; + char *s; + + /* check for options */ + + if (argc > 1 && (s = argv[1])[0] == '-') i = 2; + else {i = 1; s = 0;} + + /* check for file name */ + + if (argc <= i) + {cprint ("Usage: GT description.file\n"); + cexit (100); + } + + /* process options */ + + if (s) while (c = *++s) switch (c) { + case 'd': debug = TRUE; break; + case 't': tflag = TRUE; break; + default: cprint ("unrecognized option: '%c'\n", c); + } + + /* check that source file exists */ + + fn_source = argv[i]; + if ((f = copen (fn_source, MREAD, TEXT)) == OPENLOSS) + {cprint ("Can't Find '%s'.\n", fn_source); + cexit (100); + } + cclose (f); + + apfname (fnbuff, fn_source, "gtout"); + fn_out = fnbuff; + + pinit (); + parse (); + cleanup (0); + } + diff --git a/c20/gt/g1.c b/c20/gt/g1.c new file mode 100644 index 00000000..d6c4ec4d --- /dev/null +++ b/c20/gt/g1.c @@ -0,0 +1,505 @@ +# include "gt.h" + +/* + + GT Compiler + Section 1: Lexical Analyzer + +*/ + +/********************************************************************** + + A token consists of a TAG and an INDEX. + The valid token TAGs are listed in the include file. + The interpretation of the INDEX is dependent upon the TAG: + + T_AMOP the number of the abstract_machine_operator + TIDN index of identifier name in CSTORE + TINTCON value of integer constant + TSTRING index of source representation in CSTORE + others the line number upon which the token appeared + +**********************************************************************/ + +char *keyn[] { + "typenames", + "align", + "pointer", + "class", + "conflict", + "type", + "memnames", + "macros", + "size", + "indirect", + "regnames", + "returnreg", + "saveareasize", + "offsetrange", + "m", + 0}; + +int keyv[] { + _TYPENAMES, + _ALIGN, + _POINTER, + _CLASS, + _CONFLICT, + _TYPE, + _MEMNAMES, + _MACROS, + _SIZE, + _INDIRECT, + _REGNAMES, + _RETURNREG, + _SAVEAREASIZE, + _OFFSETRANGE, + _M}; + +/* character type array */ + +# define _ALPHA 50 /* identifier or keyword */ +# define _DIGIT 51 /* constant or identifier */ +# define _QUOTE 52 /* character string indicator */ +# define _AMOP 53 /* character beginning an abstract_machine_operation */ +# define _EOL 54 /* newline */ +# define _BLANK 55 /* blank, tab, VT, FF, CR */ +# define _BAD 56 /* invalid character */ +# define _MINUS 57 /* minus sign: integer or AMOP */ +# define _NAME (typ[t]==_ALPHA || typ[t]==_DIGIT) + +int typ[] { +_BAD, _BAD, _BAD, _BAD, _BAD, _BAD, _BAD, _BAD, +_BAD, _BLANK, _EOL, _BLANK, _BLANK, _BLANK, _BAD, _BAD, +_BAD, _BAD, _BAD, _BAD, _BAD, _BAD, _BAD, _BAD, +_BAD, _BAD, _BAD, _BAD, _BAD, _BAD, _BAD, _BAD, +_BLANK, _AMOP, _QUOTE, _BAD, _BAD, _AMOP, _AMOP, _BAD, +_LPARN, _RPARN, _AMOP, _AMOP, _COMMA, _MINUS, _AMOP, _AMOP, +_DIGIT, _DIGIT, _DIGIT, _DIGIT, _DIGIT, _DIGIT, _DIGIT, _DIGIT, +_DIGIT, _DIGIT, _COLON, _SEMI, _AMOP, _AMOP, _AMOP, _AMOP, +_BAD, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, +_ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, +_ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, +_ALPHA, _ALPHA, _ALPHA, _LBRAK, _BAD, _RBRAK, _AMOP, _ALPHA, +_BAD, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, +_ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, +_ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, _ALPHA, +_ALPHA, _ALPHA, _ALPHA, _BAD, _OR, _BAD, _NOT, _BAD}; + +/* translation table */ + +int trt[] { +000,001,002,003,004,005,006,007,010,' ','\n',' ',' ',' ',016,017, +020,021,022,023,024,025,026,027,030,031,032,033,034,035,036,037, +' ','!','"','#','$','%','&','\'','(',')','*','+',',','-','.','/', +'0','1','2','3','4','5','6','7','8','9',':',';','<','=','>','?', +0100,'a','b','c','d','e','f','g','h','i','j','k','l','m','n','o', +'p','q','r','s','t','u','v','w','x','y','z','[','\\',']','^','_', +0140,'a','b','c','d','e','f','g','h','i','j','k','l','m','n','o', +'p','q','r','s','t','u','v','w','x','y','z','{','|','}','~',0177 }; + +/* hash table, holds keywords and identifiers */ + +# define hentry struct _hentry +hentry + {char *hnp; /* pointer to string in cstore */ + int hclass; /* 1 - identifier, >1 - keyword type, + <=0 - manifest constant, index in mcdef */ + }; + +/* identifier classes */ + +# define h_idn 1 + +hentry hshtab[hshsize], *lookup(), *lookx(); +int hshused 0; /* number of entries used */ + +/* character store: holds keywords and identifiers */ + +char cstore[cssiz]; +char *cscsp -1; /* current string pointer: points to first + unused character in cstore */ +char *cscnp -1; /* current name pointer: points to last unused + character in cstore */ +char *cp; /* pointer to working string */ + +/* communication between lexical routines */ + +extern int lextag, lexindex, lexline; + +int ccard, /* indicates that current + tokens should be interpreted + by the lexical phase */ + lccard, /* lgetc local ccard */ + c, /* current untranslated input char */ + t, /* current translated input char */ + peekt, /* lookahead translated character */ + truncate; /* indicates that cstore is full */ + +/* FILES */ + +int f_source -1; /* source file */ + +extern char *fn_source; + +int i_line, /* current line number */ + i_eof, /* indicates end-of-file */ + i_nlflag; /* indicates first char of line */ + +/* manifest constants */ + +int jdefine, /* index of "DEFINE" in hashtab */ + mcdef[mcdsz], /* storage of manifest constant + definitions */ + *cmcdp {mcdef}; /* pointer to next free word in mcdef */ + +char *eopch[] { + "-ui", "-ud", "++bi", "++ai", "--bi", "--ai", ".bnot", "!", + ".lseq", "", ".sw", "++bc", "++ac", "--bc", "--ac", "&u0", + "&u1", "&u2", "&u3", "*u", "==0p0", "==0p1", "==0p2", "==0p3", + "!=0p0", "!=0p1", "!=0p2", "!=0p3", "", "", "", "", + ".ci", ".cf", ".cd", ".ic", ".if", ".id", ".ip0", ".ip1", + ".ip2", ".ip3", ".fc", ".fi", ".fd", ".dc", ".di", ".df", + ".p0i", ".p0p1", ".p0p2", ".p0p3", ".p1i", ".p1p0", ".p1p2", ".p1p3", + ".p2i", ".p2p0", ".p2p1", ".p2p3", ".p3i", ".p3p0", ".p3p1", ".p3p2", + "+i", "=+i", "+d", "=+d", "-i", "=-i", "-d", "=-d", + "*i", "=*i", "*d", "=*d", "/i", "=/i", "/d", "=/d", + "%", "=%", "<<", "=<<", ">>", "=>>", "&", "=&", + "^", "=^", ".or", "=or", "&&", ".tvor", "-p0p0", "=", + ".argi", ".argd", ".arg0", ".arg1", ".arg2", ".arg3", "+p0", "+p1", + "+p2", "+p3", "-p0", "-p1", "-p2", "-p3", "", "", + ".cc", ".ii", ".ff", ".dd", ".p0p0", ".p1p1", ".p2p2", ".p3p3", + "", "?", ".", "call", "float", "string", "int", "idn", + "==i", "!=i", "i", "<=i", ">=i", "==d", "!=d", + "d", "<=d", ">=d", "==p0", "!=p0", "p0", + "<=p0", ">=p0", "==p1", "!=p1", "p1", "<=p1", ">=p1", + "==p2", "!=p2", "p2", "<=p2", ">=p2", "==p3", "!=p3", + "p3", "<=p3", ">=p3", "", "", "", "", + "++bf", "++af", "--bf", "--af", "++bd", "++ad", "--bd", "--ad", + "++bp0", "++ap0", "--bp0", "--ap0", "++bp1", "++ap1", "--bp1", "--ap1", + "++bp2", "++ap2", "--bp2", "--ap2", "++bp3", "++ap3", "--bp3", "--ap3"}; + +/********************************************************************** + + GETTOK - Get Next Token + + Sets variables LEXTAG, LEXINDEX, LEXLINE. This routine + implements compiler control lines. + +**********************************************************************/ + +gettok () + + {while (TRUE) + {tokget(); + if (ccard) + {if (lextag==TIDN && lexindex==jdefine) + defccl (); + else {error (1004, lexline); + while (lextag) tokget(); + } + continue; + } + return; + } + } + +/********************************************************************** + + DEFCCL - Handle DEFINE Compiler Control Line + +**********************************************************************/ + +defccl () + + {hentry *hp; + int k; + + tokget (); + if (lextag != TIDN) + {error (1003, lexline); + while (lextag) tokget (); + } + else + {hp = lookx (); + k = -(cmcdp-mcdef); + do + {tokget(); + if(cmcdp >= &mcdef[mcdsz-1]) + error(4004, lexline); + *cmcdp++ = lextag; + if (lextaghclass = k; + } + } + +/********************************************************************** + + TOKGET - Internal Get Token Routine + +**********************************************************************/ + +tokget () + + {static int *mcp, mcflag; + int sum, flag, i; + char buf[40]; + hentry *hp; + +while (TRUE) + {if (mcflag) + {lextag= *mcp++; + lexindex= *mcp++; + if (lexindex==UNDEF) lexindex=lexline; + if (lextag) return; + mcflag=FALSE; + } + if (peekt) t=peekt; + else t=trt[lgetc()]; + if (!t) break; + peekt=NULL; + flag = truncate = FALSE; + cp = cscsp; /* character stack pointer */ + lexline = i_line; /* lgetc current line */ + ccard =| lccard; /* set control card indicator */ + + switch (typ[t]) { + +case _ALPHA: do move(t); while (_NAME); + *cp = 0; + hp = lookup (cscsp); + peekt = t; + if (hp->hclass > 1) /* keyword */ + {lextag = hp->hclass; + lexindex = lexline; + } + else if (hp->hclass <= 0) /* manifest constant */ + {mcflag = TRUE; + mcp = mcdef + -hp->hclass; + continue; + } + else /* identifier */ + {lextag = TIDN; + lexindex = hp->hnp - cstore; + if (truncate) error (4001,lexline); + } + return; + +case _MINUS: move(0); /* look at next char */ + if (typ[t] != _DIGIT) + {peekt = '-'; + goto l_amop; + } + flag = TRUE; + +case _DIGIT: /* fall through */ + + sum = 0; + do + {sum = sum*10 + t-'0'; + move (0); + } while (typ[t] == _DIGIT); + + lextag = TINTCON; + lexindex = (flag ? -sum : sum); + peekt = t; + return; + +case _AMOP: /* abstract machine operator */ + +l_amop: i = 0; + if (peekt) buf[i++]=peekt; + do {buf[i++]=t; move(0);} + while(typ[t]==_AMOP || typ[t]==_ALPHA + || typ[t]==_DIGIT || typ[t]==_MINUS ); + peekt = t; + buf[i]=0; + for (i=0;i=hshsize) i=0; + + /* not found, so enter */ + + if (++hshused >= hshsize) error (4000,lexline); + while (--p >= np) *cscnp-- = *p; /* move name */ + hp = &hshtab[i]; + hp->hnp = cscnp+1; + hp->hclass = h_idn; + return (hp); + } + +/********************************************************************** + + LOOKX - lookup current identifier + +**********************************************************************/ + +hentry *lookx () + {return (lookup (&cstore[lexindex]));} + +/********************************************************************** + + LXINIT - Lexical Phase Initializaton Routine + +**********************************************************************/ + +lxinit() + + {int i; + char *s; + + f_source = xopen (fn_source, MREAD, TEXT); + cscsp = cstore; + cscnp = &cstore[cssiz-1]; + lexline = i_line = 1; + i_eof = FALSE; + i_nlflag = TRUE; + + i = 0; + while (s = keyn[i]) keyword (s, keyv[i++]); + + jdefine=lookup("define")->hnp-cstore; + } + +/********************************************************************** + + KEYWORD - Define a Reserved Word + +**********************************************************************/ + +int keyword (s, type) int type; char *s; + + {lookup(s)->hclass = type;} + +/********************************************************************** + + LGETC - Character Input Routine + +**********************************************************************/ + +int lgetc() + + {int ch; + + if (i_eof) return (LEXEOF); + + while (TRUE) + {ch = cgetc (f_source); + if (ceof (f_source)) + {i_eof=TRUE; + return (LEXEOF); + } + if (trt[ch]=='\n') + {++i_line; + lccard=FALSE; + i_nlflag=TRUE; + } + else if (i_nlflag) + {i_nlflag=FALSE; + if (trt[ch]=='#') + {lccard=TRUE; + continue; + } + } + return (ch); + } + } + +/********************************************************************** + + STCMP - Compare Strings + +**********************************************************************/ + +int stcmp (s1, s2) char *s1,*s2; + + {int u; + + while ((u = *s1++) == *s2++) if (!u) return (TRUE); + return (FALSE); + } + \ No newline at end of file diff --git a/c20/gt/g2.c b/c20/gt/g2.c new file mode 100644 index 00000000..d1d8d807 --- /dev/null +++ b/c20/gt/g2.c @@ -0,0 +1,153 @@ +# include "gt.h" + +/* + + GT Compiler + Section 2: Parser Interface + +*/ + +extern int lineno; +extern char cstore[], *fn_out; + +int f_out -1; + +/********************************************************************** + + Parser Error Message Routines + +**********************************************************************/ + +synerr (line) {error (2007, line);} +giveup (line) {error (4012, line);} +stkovf (line) {error (4003, line);} +delmsg (line) {error (2012, line);} +skpmsg (line) {error (2013, line);} + +qprint (q) {error (2008, -1, q);} +tprint (tp) token *tp; {error (2011, -1, tp->type, tp->index);} +pcursor () {error (2010, -1);} + +stkunf (line) {error (6006, line);} +tkbovf (line) {error (6002, line);} +badtwp (line) {error (6005, line);} +badtok (line, i) {error (6000, line, i);} + +/********************************************************************** + + PTOKEN - Print Token Routine + +**********************************************************************/ + +ptoken (tp, f) token *tp; + + {int type, index; + extern char *sterm[], *eopch[]; + + type = tp->type; + index = tp->index; + switch (type) { + case TIDN: cprint (f, "%s", &cstore[index]); + return; + case TINTCON: cprint (f, "%d", index); + return; + case TSTRING: cprint (f, "\"\""); + return; + case T_AMOP: cprint (f, "%s", eopch[index]); + return; + default: cprint (f, "%s", sterm[type]); + } + } + +/********************************************************************** + + PINIT - Parser Initialization Routine + +**********************************************************************/ + +pinit () + + {extern int prm(); + lxinit (); + f_out = xopen (fn_out, MWRITE, TEXT); + deffmt ('m', prm, 1); + } + +/********************************************************************** + + CLEANUP - Parser CleanUp Routine + +**********************************************************************/ + +cleanup (rcode) + + {cclose (f_out); + cexit (rcode); + } + +/********************************************************************** + + STACK FOR ACTION ROUTINES + +**********************************************************************/ + +int stack[pssize]; +int *sp {stack}; + +int *push (i) + + {if (++sp >= &stack[pssize]) error (4007, lineno); + *sp = i; + return (sp); + } + +int pop () + + {int i; + + i = *sp--; + if (sp < stack) error (6001, lineno); + return (i); + } + +int *setsp (nsp) int *nsp; /* set stack pointer */ + + {if (nsp < stack) error (6003, lineno); + if (nsp >= &stack[pssize]) error (6004, lineno); + return (sp = nsp); + } + +int *top () /* get stack pointer */ + + {return (sp); + } + +int *get_top (nsp) int *nsp; /* get list from top of stack */ + + {int *ot; + + ot = top(); + setsp (nsp-1); + return (ot); + } + +/********************************************************************** + + GPRINT - Formatted Print Routine + +**********************************************************************/ + +gprint (fmt,x1,x2,x3) char fmt[]; + + {cprint (f_out, fmt, x1, x2, x3);} + +/********************************************************************** + + PRM - Print String in Cstore + +**********************************************************************/ + +prm (i, f) + + {cprint (f, "%s", &cstore[i]);} + \ No newline at end of file diff --git a/c20/gt/g3.c b/c20/gt/g3.c new file mode 100644 index 00000000..099dacca --- /dev/null +++ b/c20/gt/g3.c @@ -0,0 +1,1045 @@ +# include "gt.h" + +/* + + GT Compiler + Section 3: Action Routines + +*/ + +/* The maximum number of registers is really limited by the number + of bits in a word on the machine running this program and + on the machine running the C compiler since the set of all + registers is represented by the bits in a single word. + Also, the maximum number of indirect classes is even further + limited because the set of all memory reference classes, which + includes indirection via registers, is also represented by the + bits in a single word. */ + +# define maxregs 16 /* maximum number of registers */ +# define maxtypes 8 /* maximum number of data types */ +# define maxmem 16 /* maximum number of memory refs */ +# define maxnmacs 100 /* maximum number of named macros */ +# define retregsz 18 /* 2 + maxtypes*2 */ +# define namop 0300 /* number of abstract machine operators */ +# define mdfsz 2000 /* size of macro definition list table */ + +# define find_reg fndrg +# define find_pc fndpc +# define find_type fndty + +extern char cstore[], *cscsp; +extern int lineno, f_out, *get_top(); + +int ntype 0, /* number of data types */ + typname[maxtypes], /* names of data types */ + nmem 0, /* current number of memory refs */ + memname[maxmem], /* names of memory refs */ + nreg 0, /* current number of registers */ + regname[maxregs], /* index to name of register */ + rcname[maxregs], /* index to name of register classes */ + rcp[maxregs], /* descriptions of register classes */ + nrc 0, /* number of register classes */ + pcname[maxtypes], /* index to name of pointer classes */ + npc 0, /* current number of pointer classes */ + pcor[maxtypes], /* pointer class offset range function no. */ + norr 0, /* number of offset range functions emitted */ + trdt[maxtypes], /* registers holding a given type */ + prdt[maxtypes], /* registers holding a given pointer */ + cfp[maxregs], /* descriptions of conflicts */ + nac 0, /* number of alignment classes */ + calign[maxtypes], /* align. factors of align. classes */ + tsize[maxtypes], /* sizes of each type */ + talign[maxtypes], /* align. classes of each type */ + tpoint[maxtypes], /* pointer classes of each type */ + pc_align[maxtypes], /* resolution of pointer class in characters */ + retreg[retregsz], /* the registers in which values + of a given type are returned + in a function call - this array is + indexed by the value returned by a + routine CTYPE in the code generator */ + cfactor 0, /* current alignment factor */ + save_area_size -1, + opreg[namop], /* registers for result of op */ + opmem[namop], /* memory refs for result of op */ + oplist[namop], /* used to construct opreg, opmem */ + coplist 0, /* index into oplist */ + amopp[namop], /* indices to lists in amopl */ + c_oploc 0, /* current index in oploc table */ + amopl[500], /* lists of indices to oplocs */ + c_amopl 0, /* current entry in amopl */ + copflag l_unknown, /* current flag */ + allmem -1, /* this name represents all mem_refs */ + mactab[namop], /* names of macro calls */ + macdef[namop], /* index in mdeflist to beginning of macro */ + nnmacs 0, /* current number of named macros */ + nmacname[maxnmacs], /* names of named macros */ + nmacdef[maxnmacs], /* index in mdeflist to beginning of macro */ + mdeflist[mdfsz], /* list of macro definitons, each a list of + integers: + + flag(operand 1) + word(operand 1) + flag(operand 2) + word(operand 2) + flag(result) + word(result) + + ... + + -1 + + */ + cmacro 1, /* current macro number */ + cmdf 0; /* current entry in mdeflist */ + +struct oploc { + int flag[3], /* flag for opnd 1, opnd 2, result: + 1 - memory ref type + 2 - registers + 3 - result left in opnd 1 + 4 - result left in opnd 2 + */ + word[3], /* word for opnd1, opnd2, result: + bits represent memory ref + types or register numbers + according to the flag + */ + clobber;} /* bits indicate registers which + are clobbered as a result of this + operation + */ + doploc; + +/********************************************************************** + + PRCOM - Print Comment + +**********************************************************************/ + +prcom (name, narray, varray, count) + int name, narray[], varray[], count; + + {int i; + + for (i=0; i>i) & 1) + '0'); + } + +/********************************************************************** + + GENERIC TABLE ROUTINES + + TFIND - find name in table, return -1 if not there + TENTER - find name in table, enter if not there + TEFIND - find name in table, emit error message if not there + +**********************************************************************/ + +int tfind (name, table, size) + int name, *table, size; + + {int i; + + for (i=0;i= 0) return (i); + if (size >= maxsize) error (errno, lineno); + table[size] = name; + return ((*psize)++); + } + +int tefind (name, table, size, errno) + int name, *table, size, errno; + + {int i; + + i = tfind (name, table, size); + if (i<0) error (errno, lineno, TIDN, name); + return (i); + } + +/********************************************************************** + + SPECIFIC TABLE ROUTINES + +**********************************************************************/ + +int typ_find (n) {return (tfind (n, typname, ntype));} +int typ_enter (n) {return (tenter (n, typname, &ntype, maxtypes, 4019));} +int find_type (n) {return (tefind (n, typname, ntype, 2028));} + +int mem_find (n) {return (tfind (n, memname, nmem));} +int mem_enter (n) {return (tenter (n, memname, &nmem, maxmem, 4020));} +int find_mem (n) {return (tefind (n, memname, nmem, 2029));} + +int reg_find (n) {return (tfind (n, regname, nreg));} +int reg_enter (n) {return (tenter (n, regname, &nreg, maxregs, 4017));} +int find_reg (n) {return (tefind (n, regname, nreg, 2027));} + +int rc_find (n) {return (tfind (n, rcname, nrc));} +int rc_enter (n) {return (tenter (n, rcname, &nrc, maxregs, 4018));} + +int pc_find (n) {return (tfind (n, pcname, npc));} +int pc_enter (n) {return (tenter (n, pcname, &npc, maxtypes, 4016));} +int find_pc (n) {return (tefind (n, pcname, npc, 2026));} + +/********************************************************************** + + GETREG - return bit set for register named N + if undefined, emit message and return empty set + +**********************************************************************/ + +int getreg (n) + + {int r; + + if ((r = find_reg (n)) < 0) return (0); + return (1 << r); + } + +/********************************************************************** + + GETRC - same as GETREG but N can name register class + +**********************************************************************/ + +int getrc (n) + + {int c; + + if ((c = rc_find (n)) >= 0) return (rcp[c]); + return (getreg (n)); + } + +/********************************************************************** + + ATNAMES - define names of data types + +**********************************************************************/ + +atnames (sp) int *sp; + + {int *ot; + + ot = get_top (sp); + if (ntype != 0) error (2002, lineno); + else while (sp<=ot) typ_enter (*sp++); + } + +/********************************************************************** + + ARNAMES - define names of registers + +**********************************************************************/ + +arnames (sp) int *sp; + + {int *ot; + + ot = get_top (sp); + if (nreg != 0) error (2003, lineno); + else while (sp <= ot) reg_enter (*sp++); + } + +/********************************************************************** + + AMNAMES - define names of memory references + +**********************************************************************/ + +amnames (sp) int *sp; + + {int *ot; + + ot = get_top (sp); + if (nmem != 0) error (2004, lineno); + else while (sp <= ot) mem_enter (*sp++); + } + +/********************************************************************** + + FS1 - finished with TYPENAMES,REGNAMES, and MEMNAMES statements + +**********************************************************************/ + +fs1() + + {int t; + + if (ntype == 0) error (4013,lineno); + if (nreg == 0) error (4014,lineno); + if (nmem == 0) error (4015,lineno); + + for (t=0; t=0;--c) if ((a%pc_align[c])==0) break; + if (c<0) error(2022,lineno,TIDN,typname[t]); + else tpoint[t]=c; + } + } + +/********************************************************************** + + ASIZE - define size of basic types + + SIZE - the size in characters + SP - a pointer to a list of the types with the given size + +**********************************************************************/ + +asize (size, sp) int size, *sp; + + {int *ot, t; + + ot = get_top (sp); + while (sp<=ot) + {if ((t = find_type (*sp++)) >= 0) + if (tsize[t] >= 0) + error(2015,lineno,TIDN,typname[t]); + else tsize[t]=size; + } + } + +/********************************************************************** + + AALIGN - define alignment class + + factor - alignment factor + sp - pointer to list of types in this alignment class + +**********************************************************************/ + +aalign (factor, sp) int factor, *sp; + + {int *ot, t; + + ot = get_top (sp); + if (factor <= cfactor) + {error (2009, lineno); + return; + } + cfactor = calign[nac] = factor; + while (sp <= ot) + {if ((t = find_type (*sp++)) >= 0) + if (talign[t]>=0) + error (2020,lineno,TIDN,typname[t]); + else talign[t] = nac; + } + nac++; + } + +/********************************************************************** + + APOINT - define pointer class + + name - the name of the pointer class + resolution - the resolution in characters of a pointer + in the pointer class + +**********************************************************************/ + +apoint (name, resolution) int name,resolution; + + {static int current_resolution; + + if (npc==0) current_resolution=0; + if (resolution<0 || resolution<=current_resolution) + {error(2009,lineno); + return; + } + current_resolution=pc_align[pc_enter(name)]=resolution; + } + +/********************************************************************** + + ACLASS - define register class + + idn - name of register class + sp - pointer to list of names of members of the class + +**********************************************************************/ + +aclass (idn ,sp) int idn, *sp; + + {int *ot, rc; + + ot = get_top (sp); + rc = rc_enter (idn); + while (sp <= ot) rcp[rc] =| getreg (*sp++); + } + +/********************************************************************** + + ASAVE - define save area size (in characters) + +**********************************************************************/ + +asave (i) + + {save_area_size = i; + } + +/********************************************************************** + + AOR1 - Handle Offset_Range of Form (lo,hi) + +**********************************************************************/ + +aor1 (idn, lo, hi) + + {int pc; + + if ((pc = find_pc (idn)) >= 0) + {gprint ("int ofok%d (i) {return (i>=%d && i<=%d);}\n", + ++norr, lo, hi); + pcor[pc] = norr; + } + } + +/********************************************************************** + + AOR2 - Handle Offset_Range of Form (lo,) + +**********************************************************************/ + +aor2 (idn, lo) + + {int pc; + + if ((pc = find_pc (idn)) >= 0) + {gprint ("int ofok%d(i) {return (i>=%d);}\n", + ++norr, lo); + pcor[pc] = norr; + } + } + +/********************************************************************** + + AOR3 - Handle Offset_Range of Form (,hi) + +**********************************************************************/ + +aor3 (idn, hi) + + {int pc; + + if ((pc = find_pc (idn)) >= 0) + {gprint ("int ofok%d(i) {return (i<=%d);}\n", + ++norr, hi); + pcor[pc] = norr; + } + } + +/********************************************************************** + + AOR4 - Handle Offset_Range of Form (,) + +**********************************************************************/ + +aor4 (idn) + + {int pc; + + if ((pc = find_pc (idn)) >= 0) + {gprint ("int ofok%d(i) {return (1);}\n", ++norr); + pcor[pc] = norr; + } + } + +/********************************************************************** + + ARETREG - define the types which are returned in a given register + + REG_NAME - the name of the register + SP - a pointer to a list of type or pointer_class names + +**********************************************************************/ + +aretreg (reg_name, sp) int *sp; + + {int *ot, type_name, type, pc, reg, i; + + ot = get_top (sp); + + if ((reg = find_reg (reg_name)) >= 0) + while (sp<=ot) + {i = 0; + type_name = *sp++; + if ((type=typ_find(type_name)) >= 0) i=type+2; + else if ((pc=pc_find(type_name)) >= 0) i=pc+ntype+2; + if (i==0) error(2028,lineno,TIDN,type_name); + else if (retreg[i]>=0) error(2005,lineno,TIDN,type_name); + else retreg[i]=reg; + } + } + +/********************************************************************** + + ATYPE - define register types + + type - C type + sp - pointer to list of register names of that type + +**********************************************************************/ + +atype (type_name, sp) int type_name, *sp; + + {int *ot, type; + + if ((type = typ_find (type_name)) < 0) + {aptype (type_name, sp); + return; + } + ot = get_top (sp); + while (sp<=ot) trdt[type] =| getrc (*sp++); + } + +/********************************************************************** + + FTYPE - finished with TYPE statement + +**********************************************************************/ + +ftype() + + {int i, r, flt_hack; + + prcom ("\ttype", typname, trdt, ntype); + prcom ("pointer class", pcname, prdt, npc); + + if (save_area_size <0) + {error (2014, lineno); + save_area_size=0; + } + + flt_hack = 1; + if (tsize[tdouble]==tsize[tint] && tsize[tfloat]==tsize[tint] + && talign[tdouble]<=talign[tint] && talign[tfloat]<=talign[tint]) + flt_hack = 0; + + /* output OFF_OK array */ + + gprint ("\nint (*off_ok[])() {"); + i = 0; + for (r=0;r= 0) + while (sp <= ot) prdt[pc] =| getrc (*sp++); + } + +/********************************************************************** + + ACONF - define a conflicting pair of registers + + n1 - name of one register + n2 - name of the other register + +**********************************************************************/ + +aconf (n1, n2) int n1, n2; + + {int r1, r2; + + r1 = find_reg (n1); + r2 = find_reg (n2); + if (r1>=0 && r2>=0 && r1!=r2) + {cfp[r1] =| 1<= 0) + {copflag = l_register; + return (1 << j); + } + else if ((c = rc_find(n)) >= 0) + {copflag = l_register; + return (rcp[c]); + } + else if (copflag == l_register) + {error (2027, lineno, TIDN, n); + return (0); + } + } + if ((j = find_mem (n)) >= 0) + {copflag = l_memory; + return (1 << j); + } + return (0); + } + +/********************************************************************** + + ACLOBBER - determine the clobber field + +**********************************************************************/ + +aclobber (sp) int *sp; + + {int *ot, i; + + ot = get_top (sp); + i = 0; + while (sp<=ot) i =| getrc (*sp++); + return (i); + } + +/********************************************************************** + + FOPLOC - finished with OPLOCs + +**********************************************************************/ + +foploc() + + {int i; + + gprint ("\t0};\n"); + + /* set predefined values of OPREG and OPMEM */ + + i = trdt[1]; + opreg[e_not] = opreg[e_and] = opreg[e_or] = opreg[e_qmark] = i; + opmem[e_not] = opmem[e_and] = opmem[e_or] = opmem[e_qmark] = 0; + opreg[e_int] = opreg[e_float] = opreg[e_string] = 0; + opmem[e_int] = 1 << c_integer; + opmem[e_float] = 1 << c_float; + opmem[e_string] = 1 << c_string; + outarray ("rtopp",amopp,namop); + outarray ("rtopl",amopl,c_amopl); + outarray ("opreg",opreg,namop); + outarray ("opmem",opmem,namop); + } + +/********************************************************************** + + MPUSH - push an integer onto DEFLIST + +**********************************************************************/ + +int mpush (a1) + + {int j; + + mdeflist[j = cmdf++] = a1; + if (cmdf>=mdfsz) error(4002,lineno); + return (j); + } + +/********************************************************************** + + MPSH2 - push two integers onto DEFLIST + +**********************************************************************/ + +int mpsh2 (a1, a2) + + {int j; + + j = mpush (a1); + mpush (a2); + return (j); + } + +/********************************************************************** + + FMACRO - finished with MACRO specifications + +**********************************************************************/ + +int col; + +fmacro() + + {int c, f, lc, *ip, *ep, flag; + char *p; + + outarray ("mactab",mactab,namop); + outint ("ntype",ntype); + outint ("nmem",nmem); + outint ("nac",nac); + outint ("npc",npc); + outint ("sv_area_sz",save_area_size); + outint ("nreg",nreg); + + /* gprint out MCSTORE */ + + lc=col=0; + flag=TRUE; + ip=mdeflist; + ep= &mdeflist[cmdf]; + + p = cstore; + gprint ("char mcstuff[] {\n"); + + while (TRUE) + {c = *p++; + if (p >= cscsp) break; + if (flag) while (ip < ep) if (*++ip == -3) + {*ip = lc; + flag = FALSE; + break; + } + +again: switch(c) { + +case '\\': switch (c = *p++) { + + case 't': mputc ('\t'); ++lc; continue; + case 'n': mputc ('\n'); ++lc; continue; + case '#': mputs ("\\#"); lc=+2; continue; + case '\\': mputs ("\\\\"); lc=+2; continue; + case '\n': continue; + } + + mputc ('\\'); + ++lc; + goto again; + +case 0: flag=TRUE; + mputc (0); + ++lc; + continue; + +case '\"': mputc ('\"'); + ++lc; + continue; + +case '\t': mputc ('\t'); + ++lc; + continue; + +case '\n': mputc ('\n'); + ++lc; + continue; + +case '#': c = *p++; + if (c == '\'') + {switch (c = *p++) { + case 'F': + mputs("#3,#4"); + lc =+ 5; + break; + case 'S': + mputs("#5,#6"); + lc =+ 5; + break; + case 'R': + mputs("#1,#2"); + lc =+ 5; + break; + case 'O': + mputs("#0"); + lc =+ 2; + } + continue; + } + mputc ('#'); + mputc (c); + lc =+ 2; + continue; + +default: mputc (c & 0177); + ++lc; + } + } + + gprint ("};\n"); + gprint ("char *mcstore {mcstuff};\n"); + outarray ("macdef",macdef,cmacro); + gprint ("char *nmacname[] {\n"); + for (f=0;f= 12) + {cputc ('\n', f_out); + col=0; + } + else cputc (' ', f_out); + } + +/********************************************************************** + + OUTINT - write out an integer in C definition format + +**********************************************************************/ + +outint (n,i) char n[]; int i; + + {gprint ("int %s { %d };\n", n, i); + } + +/********************************************************************** + + OUTARRAY - write out integer array in C definition format + +**********************************************************************/ + +outarray (n,v,s) char n[]; int v[],s; + + {int i; + + gprint ("int %s[%d] {\n",n,s); + for(i=0;i= maxnmacs) error(4006,lineno); + nmacname[nnmacs] = idn; + nmacdef[nnmacs] = def; + ++nnmacs; + } + +/********************************************************************** + + XOPEN - Open File with Error Detection + + open file given + + file - name of file + mode - mode of file + opt - string of system-dependent options + + If unable to open print a message and exit. + Otherwise, return the file number. + +**********************************************************************/ + +xopen (file, mode, opt) char *file, *opt; int mode; + + {int i; + + i = copen (file, mode, opt); + if (i == OPENLOSS) + {cprint ("Unable to open '%s'.\n", file); + cexit (100); + } + return (i); + } + + \ No newline at end of file diff --git a/c20/gt/g4.c b/c20/gt/g4.c new file mode 100644 index 00000000..69f8eb8f --- /dev/null +++ b/c20/gt/g4.c @@ -0,0 +1,308 @@ +# include "gt.h" + +/* + + GT Compiler + Section 4: Parsing Tables + +*/ + +extern int copflag, amopl[], c_amopl, coplist; +extern int mactab[], macdef[], cmacro, lineno; + +extern int val, line, *pv, *pl; + +ar3 () + {fs1();} + +ar4 () + {fs2();} + +ar21 () + {error(4025,lineno);} + +ar22 () + {ftype();} + +ar23 () + {error(4022,lineno);} + +ar24 () + {foploc();} + +ar25 () + {error(4023,lineno);} + +ar26 () + {fmacro();} + +ar27 () + {error(4024,lineno);} + +ar56 () + {amopl[c_amopl++]= -1;coplist=0;} + +ar57 () + {asave(pv[2]);} + +ar58 () + {asize(pv[1],pv[3]);} + +ar59 () + {aalign(pv[1],pv[3]);} + +ar60 () + {apoint(pv[1],pv[3]);} + +ar61 () + {aclass(pv[1],pv[3]);} + +ar62 () + {aretreg(pv[1],pv[3]);} + +ar63 () + {atype(pv[1],pv[3]);} + +ar64 () + {aconf(pv[2],pv[4]);} + +ar65 () + {push(pv[3]);} + +ar66 () + {val=push(pv[1]);} + +ar67 () + {push(pv[3]);} + +ar68 () + {val=push(pv[1]);} + +ar69 () + {atnames(pv[3]);} + +ar70 () + {amnames(pv[3]);} + +ar71 () + {arnames(pv[3]);} + +ar72 () + {aor1(pv[1],pv[3],pv[5]);} + +ar73 () + {aor2(pv[1],pv[3]);} + +ar74 () + {aor3(pv[1],pv[4]);} + +ar75 () + {aor4(pv[1]);} + +ar78 () + {aoploc(pv[6]);} + +ar79 () + {aamop(pv[1]);} + +ar80 () + {aamop(pv[1]);} + +ar81 () + {aopl(0,copflag,pv[1]);} + +ar82 () + {aopl(1,copflag,pv[1]);} + +ar83 () + {aopl(1,0,0);} + +ar84 () + {aopl(2,copflag,pv[1]);} + +ar86 () + {copflag=pv[1]+2;val=0;} + +ar87 () + {val=pv[1] | pv[3];} + +ar88 () + {val= ~pv[2];} + +ar89 () + {val=pv[2];} + +ar90 () + {val=aope(-1);} + +ar91 () + {val=aope(-2);} + +ar92 () + {val=aope(pv[1]);} + +ar93 () + {val=aclobber(pv[2]);} + +ar94 () + {val=0;} + +ar95 () + {macdef[cmacro++]=pv[2];mpush(-1);} + +ar100 () + {mpush(-3);val=pv[2];} + +ar101 () + {val=mpsh2(3,-3);} + +ar102 () + {val=mpsh2(copflag,pv[1]);copflag=0;} + +ar103 () + {val=mpsh2(0,0);} + +ar104 () + {mactab[pv[1]]=cmacro;} + +ar105 () + {nmac(pv[1],cmacro);} + +ar106 () + {push(pv[3]);} + +ar107 () + {val=push(pv[1]);} + +int (*act[])() { + 0, 0, 0, ar3, ar4, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, ar21, ar22, ar23, ar24, ar25, ar26, ar27, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, ar56, ar57, ar58, ar59, ar60, ar61, + ar62, ar63, ar64, ar65, ar66, ar67, ar68, ar69, ar70, ar71, + ar72, ar73, ar74, ar75, 0, 0, ar78, ar79, ar80, ar81, ar82, + ar83, ar84, 0, ar86, ar87, ar88, ar89, ar90, ar91, ar92, + ar93, ar94, ar95, 0, 0, 0, 0, ar100, ar101, ar102, ar103, + ar104, ar105, ar106, ar107, -1}; + + + +int r1[] { + 0, 1, 2, 3, 4, 5, 5, 6, 6, 6, 7, 7, 8, 8, 8, 8, 8, 8, 9, + 9, 10, 10, 11, 11, 12, 12, 13, 13, 14, 14, 15, 15, 16, + 17, 17, 18, 19, 19, 20, 21, 21, 22, 23, 23, 24, 25, 25, + 26, 27, 27, 28, 29, 29, 30, 31, 31, 32, 33, 34, 35, 36, + 37, 38, 39, 40, 41, 41, 42, 42, 43, 44, 45, 46, 46, 46, + 46, 47, 47, 48, 49, 49, 50, 51, 51, 52, 53, 53, 54, 54, + 54, 54, 54, 54, 55, 55, 56, 57, 57, 58, 58, 59, 59, 60, + 60, 61, 61, 62, 62, -1}; + +int r2[] { + 0, 2, 8, 1, 1, 2, 0, 1, 1, 1, 2, 0, 1, 1, 1, 1, 1, 1, 1, + 0, 1, 0, 1, 0, 1, 0, 1, 0, 2, 1, 2, 1, 3, 3, 1, 3, 3, 1, + 3, 3, 1, 3, 3, 1, 3, 3, 1, 3, 3, 1, 3, 3, 1, 3, 3, 1, 2, + 3, 4, 4, 4, 4, 4, 4, 5, 3, 1, 3, 1, 5, 5, 5, 6, 5, 5, 4, + 2, 1, 7, 3, 2, 1, 1, 0, 1, 1, 1, 3, 2, 3, 1, 1, 1, 3, 0, + 2, 3, 2, 2, 1, 9, 1, 1, 0, 1, 1, 3, 1, -1}; + +int g[] { + 0, 0, 2, 0, 3, 0, 5, 0, 4, 0, 10, 0, 6, 0, 23, 0, 15, 0, + 37, 0, 66, 0, 98, 0, 152, 0, 99, 0, 153, 0, 24, 0, 52, + 0, 25, 0, 40, 0, 26, 0, 43, 0, 27, 0, 46, 0, 16, 0, 34, + 0, 38, 0, 63, 0, 67, 0, 95, 0, 28, 0, 49, 99, 126, 0, 100, + 0, 29, 82, 111, 0, 53, 70, 103, 0, 41, 73, 105, 0, 44, + 76, 107, 0, 47, 93, 120, 0, 64, 123, 148, 0, 96, 79, 109, + 0, 50, 0, 50, 31, 57, 32, 58, 68, 102, 74, 106, 80, 110, + 91, 119, 121, 147, 185, 188, 0, 56, 0, 11, 0, 12, 0, 13, + 61, 90, 0, 35, 0, 133, 133, 159, 0, 134, 124, 149, 0, 101, + 0, 135, 0, 173, 0, 182, 160, 174, 180, 183, 0, 136, 127, + 157, 128, 158, 161, 175, 166, 176, 181, 176, 187, 176, + 0, 137, 0, 186, 153, 165, 0, 154, 0, 155, 0, 168, 168, + 178, 0, 169, 181, 184, 187, 190, 0, 177, 155, 170, 0, 156, + 0, 156, -1}; + +int pg[] { + 0, 0, 1, 3, 5, 7, 9, 11, 13, 15, 17, 19, 21, 23, 25, 27, + 29, 31, 33, 35, 37, 39, 41, 43, 45, 47, 49, 51, 53, 55, + 57, 59, 61, 65, 67, 71, 75, 79, 83, 87, 91, 95, 97, 115, + 117, 119, 121, 125, 127, 131, 135, 137, 139, 141, 147, + 161, 163, 167, 169, 171, 175, 181, 185, -1}; + +int nbpw {16}; + +int nwpbt {2}; + +int a[] { + 0, 0, 0, 60, 30, 85, 185, 191, 124, 61, 161, 128, 97, 7, + 17, 18, 19, 20, 65, 8, 125, 21, 129, 9, 36, 22, 14, 130, + 33, 39, 167, 12294, 4097, 16384, 0, 12299, 20481, 8192, + 136, 12291, 4122, 8206, 12307, 20481, 49152, 547, 12292, + 4100, 8222, 0, 4100, 8223, 0, 4100, 8224, 0, 12293, 12295, + 12297, 12296, 4124, 8225, 0, 4120, 8228, 12309, 12306, + 4125, 8231, 0, 4124, 8234, 0, 4124, 8237, 0, 4100, 8240, + 0, 4125, 8243, 0, 4125, 8246, 0, 12298, 12300, 12301, 12304, + 12302, 12303, 12305, 4124, 8247, 0, 4100, 8251, 0, 4099, + 8252, 4105, 8253, 0, 12334, 4124, 8254, 0, 4114, 8257, + 12311, 12308, 4100, 8260, 0, 4099, 8261, 4105, 8262, 0, + 12325, 4100, 8263, 0, 4099, 8264, 4105, 8265, 0, 12328, + 4100, 8266, 0, 4099, 8267, 4105, 8268, 0, 12331, 4124, + 8269, 0, 4099, 8270, 4105, 8271, 0, 12343, 4100, 8272, + 0, 4099, 8273, 4105, 8274, 0, 12322, 4099, 8275, 0, 12356, + 4101, 8277, 4105, 8276, 0, 4101, 8278, 4105, 8276, 0, 4101, + 8279, 4105, 8276, 0, 4105, 8281, 4125, 8280, 0, 12332, + 4124, 8225, 0, 4100, 8283, 0, 4099, 8284, 4105, 8285, 0, + 12337, 4124, 8286, 0, 4108, 8289, 12313, 12310, 12323, + 4125, 8231, 0, 4125, 8296, 0, 12326, 4124, 8234, 0, 12329, + 4124, 8237, 0, 4105, 8300, 0, 12341, 4100, 8240, 0, 12320, + 4125, 8243, 0, 12345, 4124, 8304, 0, 4099, 8305, 0, 4099, + 8306, 0, 4099, 8307, 0, 4105, 8308, 0, 4101, 8310, 4125, + 8309, 0, 12333, 12335, 4124, 8254, 0, 4100, 8313, 0, 4099, + 8314, 4105, 8315, 0, 12340, 4104, 8316, 0, 4116, 8317, + 0, 4108, 8289, 12312, 12317, 20481, 2048, 2112, 4100, 8319, + 4124, 8323, 4125, 8324, 0, 4101, 8330, 4105, 8276, 0, 12324, + 4101, 8331, 0, 12327, 4101, 8332, 4105, 8276, 0, 12330, + 4124, 8333, 0, 12342, 4101, 8334, 4105, 8276, 0, 12321, + 12355, 12357, 12358, 12359, 4101, 8336, 4125, 8335, 0, + 4101, 8337, 0, 12363, 4101, 8338, 4105, 8276, 0, 12336, + 12338, 4124, 8286, 0, 4108, 8289, 12368, 4108, 8342, 4124, + 8343, 12315, 12316, 20481, 2048, 2112, 4100, 8319, 4124, + 8323, 0, 12378, 12379, 12380, 12374, 20481, 2048, 2112, + 4100, 8319, 4124, 8323, 4125, 8324, 12344, 12365, 4105, + 8352, 0, 12369, 4106, 8353, 12373, 12347, 12348, 12349, + 4101, 8354, 0, 12346, 4101, 8355, 0, 12361, 12362, 12350, + 4101, 8356, 4105, 8276, 0, 12339, 12367, 12392, 12393, + 12290, 4108, 8342, 4124, 8343, 12314, 12319, 4100, 8358, + 4108, 8342, 4124, 8343, 4126, 8359, 0, 4104, 8363, 0, 4101, + 8364, 4106, 8353, 0, 12376, 12364, 20481, 2048, 2112, 4100, + 8319, 4124, 8323, 4125, 8324, 12371, 12352, 12360, 12351, + 12318, 20481, 2048, 2112, 4100, 8319, 4124, 8323, 12391, + 12389, 4100, 8358, 4126, 8359, 12383, 12387, 4104, 8371, + 0, 12385, 12377, 4105, 8372, 0, 12370, 12375, 4106, 8353, + 12390, 4105, 8373, 0, 12386, 12384, 20481, 2048, 2112, + 4100, 8319, 4124, 8323, 4125, 8324, 0, 20481, 2048, 2112, + 4100, 8319, 4124, 8323, 12391, 4102, 8377, 12382, 12372, + 4105, 8379, 0, 4099, 8381, 0, 20481, 2048, 2112, 4100, + 8319, 4124, 8323, 12391, 4103, 8383, 4105, 8276, 0, 12366, + 4101, 8384, 0, 12381, 4104, 8385, 0, 4126, 8386, 0, 12388, + -1}; + +int pa[] { + 0, 31, 32, 35, 36, 40, 43, 47, 50, 53, 56, 57, 58, 59, + 60, 63, 66, 67, 70, 73, 76, 79, 82, 85, 86, 87, 88, 89, + 90, 91, 92, 92, 92, 95, 98, 103, 104, 107, 110, 111, 114, + 119, 120, 123, 128, 129, 132, 137, 138, 141, 146, 147, + 150, 155, 156, 159, 160, 165, 170, 175, 180, 181, 184, + 187, 192, 193, 196, 199, 92, 200, 201, 204, 207, 208, 92, + 211, 212, 215, 218, 219, 92, 222, 223, 226, 227, 230, 233, + 236, 239, 242, 247, 92, 248, 249, 252, 255, 260, 261, 264, + 267, 270, 271, 281, 286, 287, 290, 291, 296, 297, 300, + 301, 306, 307, 308, 309, 310, 311, 316, 319, 320, 325, + 92, 326, 327, 330, 333, 338, 339, 339, 347, 348, 349, 350, + 351, 361, 362, 365, 366, 369, 370, 371, 372, 375, 376, + 379, 380, 381, 382, 387, 388, 389, 390, 391, 392, 397, + 398, 407, 410, 415, 416, 417, 339, 427, 428, 429, 430, + 431, 439, 440, 445, 446, 449, 450, 451, 454, 455, 456, + 459, 462, 463, 464, 474, 482, 485, 486, 92, 489, 492, 500, + 505, 506, 509, 510, 513, 516, -1}; + + \ No newline at end of file diff --git a/c20/gt/g5.c b/c20/gt/g5.c new file mode 100644 index 00000000..14b84b4b --- /dev/null +++ b/c20/gt/g5.c @@ -0,0 +1,276 @@ +# include "gt.h" + +/* + + GT Compiler + Section 5: Error Message Editor + +*/ + +/********************************************************************** + + global variables + + sterm table of GT terminal symbols + snterm table of GT nonterminal symbols + sq table of states + +**********************************************************************/ + +extern char cstore[], *eopch[]; + +char *sterm[] { + "", "-|", "error", ";", "(", ")", "[", "]", ":", ",", "|", + "~", "amop", "TYPENAMES", "ALIGN", "POINTER", "CLASS", + "CONFLICT", "TYPE", "MEMNAMES", "MACROS", "SIZE", "INDIRECT", + "REGNAMES", "RETURNREG", "SAVEAREASIZE", "OFFSETRANGE", + "M", "idn", "integer", "string", 0}; + +char *snterm[] { + "", "$accept", "program", "$s1", "$s2", "$s1.list", "s1", + "$s2.list", "s2", "$or", "$r", "$t", "$o", "$m", "$o.list", + "$m.list", "$size", "s.list", "$align", "a.list", "$pointer", + "p.list", "$class", "c.list", "$offsetrange", "or.list", + "$returnreg", "r.list", "$type", "t.list", "$conflict", + "x.list", "$oploc", "$saveareasize", "s.elem", "a.elem", + "p.elem", "c.elem", "r.elem", "t.elem", "x.elem", "int_list", + "idn_list", "$typenames", "$memnames", "$regnames", "or.elem", + "oploc_list", "oploc", "oplist", "op1", "op2", "op3", "opl", + "ope", "clobber", "macro", "name_list", "cstring_list", + "cstring", "ope2", "name", "amop_list", 0}; + +int sq[] { + 0, 0, 4098, 4099, 4101, 4100, 4103, 13, 19, 23, 4102, 4139, + 4140, 4141, 26, 4105, 4120, 14, 15, 16, 17, 21, 25, 4104, + 4112, 4114, 4116, 4118, 4126, 4129, 4, 4, 4, 28, 4121, + 4142, 24, 4106, 4122, 29, 4115, 4131, 28, 4117, 4132, 28, + 4119, 4133, 4, 4127, 4136, 29, 4113, 4130, 29, 28, 4138, + 4138, 4138, 4, 3, 9, 28, 4123, 4134, 18, 4107, 4124, 4, + 3, 9, 4, 3, 9, 4, 3, 9, 28, 3, 9, 4, 3, 9, 3, 9, 5, 5, + 5, 29, 9, 4142, 4, 3, 9, 28, 4125, 4135, 12, 4108, 4110, + 4128, 4145, 4138, 4131, 29, 4132, 4138, 4133, 9, 4136, + 4138, 4130, 28, 3, 3, 3, 9, 29, 5, 4138, 4134, 4, 3, 9, + 8, 20, 4128, 4, 11, 22, 27, 28, 29, 4143, 4144, 4146, 4149, + 4150, 5, 5, 5, 28, 5, 29, 5, 5, 5, 4138, 4135, 4145, 12, + 28, 4109, 4111, 4152, 4153, 4157, 4150, 4150, 4144, 9, + 10, 5, 5, 5, 4152, 4, 30, 4154, 4155, 4157, 8, 5, 4147, + 4149, 4150, 4150, 4156, 4155, 8, 9, 9, 4148, 4149, 4156, + 6, 4151, 9, 4138, 3, 4156, 7, 5, 8, 30, -1}; + +/********************************************************************** + + ERROR MESSAGES + +**********************************************************************/ + +char *m1000[] { +/* 1000 */ "INVALID CHARACTER", +/* 1001 */ "INVALID ESCAPE CHARACTER", +/* 1002 */ "UNRECOGNIZED ABSTRACT MACHINE OPERATOR", +/* 1003 */ "INVALID MANIFEST CONSTANT DEFINITION", +/* 1004 */ "INVALID COMPILER CONTROL LINE", +/* 1005 */ "INVALID ESCAPE CONTROL LINE" + }; + +char *m2000[] { +/* 2000 */ 0, +/* 2001 */ "UNTERMINATED STRING CONSTANT", +/* 2002 */ "MULTIPLE TYPENAMES STATEMENTS IGNORED", +/* 2003 */ "MULTIPLE REGNAMES STATEMENTS IGNORED", +/* 2004 */ "MULTIPLE MEMNAMES STATEMENTS IGNORED", +/* 2005 */ "RETURN REGISTER FOR %t REDEFINED", +/* 2006 */ "%q DELETED", +/* 2007 */ "SYNTAX ERROR. PARSE SO FAR: ", +/* 2008 */ " %q", +/* 2009 */ "ALIGNMENT FACTORS MUST INCREASE", +/* 2010 */ " _ ", +/* 2011 */ " %t", +/* 2012 */ "DELETED: ", +/* 2013 */ "SKIPPED: ", +/* 2014 */ "MISSING SAVEAREASIZE STATEMENT", +/* 2015 */ "SIZE OF %t REDECLARED", +/* 2016 */ "SIZE OF %t NOT SPECIFIED", +/* 2017 */ "MACRO %t REDEFINED", +/* 2018 */ "ATTEMPT TO MIX REGISTER AND MEMORY IN LOCATION EXPRESSION", +/* 2019 */ 0, +/* 2020 */ "ALIGNMENT OF TYPE %t REDECLARED", +/* 2021 */ "INVALID ALIGMENT CLASS %d", +/* 2022 */ "NO POINTER CLASS CAN RESOLVE TYPE %t", +/* 2023 */ "ALIGNMENT CLASS FOR %t NOT SPECIFIED", +/* 2024 */ "SMALLEST ALIGNMENT FACTOR MUST BE 1", +/* 2025 */ 0, +/* 2026 */ "UNDEFINED POINTER CLASS %t", +/* 2027 */ "UNDEFINED REGISTER %t", +/* 2028 */ "UNDEFINED DATA TYPE %t", +/* 2029 */ "UNDEFINED MEMORY REFERENCE TYPE %t" + }; + +char *m4000[] { +/* 4000 */ "NAME TABLE OVERFLOW", +/* 4001 */ "NAME TABLE OVERFLOW", +/* 4002 */ "MACRO DEFINITION OVERFLOW", +/* 4003 */ "PROGRAM TOO COMPLICATED. PARSER STACK OVERFLOW.", +/* 4004 */ "MANIFEST CONSTANT DEFINITION TABLE OVERFLOW", +/* 4005 */ "PROGRAM TOO LARGE: SYMBOL TABLE OVERFLOW", +/* 4006 */ "TOO MANY NAMED MACROS", +/* 4007 */ 0, +/* 4008 */ 0, +/* 4009 */ 0, +/* 4010 */ 0, +/* 4011 */ 0, +/* 4012 */ "I GIVE UP", +/* 4013 */ "TYPENAMES STATEMENT MISSING", +/* 4014 */ "REGNAMES STATEMENT MISSING", +/* 4015 */ "MEMNAMES STATEMENT MISSING", +/* 4016 */ "TOO MANY POINTER CLASSES", +/* 4017 */ "TOO MANY REGISTERS", +/* 4018 */ "TOO MANY REGISTER CLASSES", +/* 4019 */ "TOO MANY DATA TYPES", +/* 4020 */ "TOO MANY MEMORY REFERENCE TYPES", +/* 4021 */ "POINTER STATEMENT MISSING", +/* 4022 */ "TYPE STATEMENT MISSING", +/* 4023 */ "OPLOC STATEMENTS MISSING", +/* 4024 */ "MACROS MISSING", +/* 4025 */ "RETURNREG STATEMENT MISSING" + }; + +char *m6000[] { +/* 6000 */ "T(P): ATTEMPT TO REFERENCE TOKEN %d", +/* 6001 */ "POP(P): STACK ERROR", +/* 6002 */ "LEX(P): TOKEN BUFFER OVERFLOW", +/* 6003 */ "SETSP(P): STACK POINTER TOO SMALL", +/* 6004 */ "SETSP(P): STACK POINTER TOO LARGE", +/* 6005 */ "LEX(P): INCONSISTENT TOKEN POINTERS", +/* 6006 */ "PARSE(P): ATTEMPT TO POP EMPTY PARSER STACK" + }; + +/********************************************************************** + + DTOKEN - Print Token + +**********************************************************************/ + +dtoken (type, index) + + {extern int cout; + ptoken (&type, cout); + } + +/********************************************************************** + + EPRINT - Error Editor Formatted Print Routine + +**********************************************************************/ + +eprint (fmt, x1, x2) char *fmt; + + {int *argp, x, c; + char *s; + + argp = &x1; /* argument pointer */ + while (c = *fmt++) + {if (c != '%') eputc (c); + else + {x = *argp++; + switch (c = *fmt++) { + +case 'd': /* decimal */ if (x<0) {x = -x; eputc ('-');} + eprd (x); + break; +case 'q': /* parser state */ + x = sq[x]; + if (x<0) break; + if (x<010000) eprint ("%s", sterm[x]); + else eprint ("<%s>", snterm[x-010000]); + break; +case 's': /* string */ s = x; + while (c = *s++) eputc (c); + break; +case 't': /* token */ dtoken (x, *argp++); + break; +default: eputc (c); + --argp; + } + } + } + } + +/********************************************************************** + + EPRD - Print Positive Decimal Integer + +**********************************************************************/ + +eprd (n) + + {int a; + if (a=n/10) eprd (a); + eputc (n%10+'0'); + } + +/********************************************************************** + + EPUTC - Write a character onto standard output unit. + + Break lines which exceed 60 characters. + +**********************************************************************/ + +eputc (c) + + {static int column; + extern int cout; + + if (column >= 59 && c == ' ') c = '\n'; + else if (column >= 80 && c != '\n') + {cputc ('\n', cout); column = 0; + } + cputc (c, cout); + if (c=='\n') column=0; else ++column; + } + +/********************************************************************** + + ERROR - Print Error Message + +**********************************************************************/ + +error (errno, lineno, p1, p2) + + {char *f, *getfmt(); + + if (lineno>0) eprint ("\n%d: ", lineno); + if (errno>=6000) eprint ("COMPILER ERROR. "); + + if (errno < 2000) + f = getfmt (errno-1000, m1000, sizeof m1000); + else if (errno < 4000) + f = getfmt (errno-2000, m2000, sizeof m2000); + else if (errno < 6000) + f = getfmt (errno-4000, m4000, sizeof m4000); + else f = getfmt (errno-6000, m6000, sizeof m6000); + + if (f==0) {f = "ERROR %d"; p1=errno;} + eprint (f, p1, p2); + if (errno>=4000) cleanup (1); + } + +/********************************************************************** + + GETFMT - get format given + N - relative error number + T - error message table + Z - size of error message table + +**********************************************************************/ + +char *getfmt (n, t, z) + char *t[]; + + {int nm; + + nm = z / sizeof t[0]; + if (n < 0 || n >= nm) return (0); + return (t[n]); + } + \ No newline at end of file diff --git a/c20/gt/get.ctl b/c20/gt/get.ctl new file mode 100644 index 0000000000000000000000000000000000000000..45eb87f7e62321fdef505b03897aaee2f8ddaa76 GIT binary patch literal 103 zcmYMqK?;B%5CA~W`-(j;9GGR3jM2-`J5WdtITwA@6wm}K myxWpm1v* LORY%dVgLdFHg*%n literal 0 HcmV?d00001 diff --git a/c20/gt/h6000.gt b/c20/gt/h6000.gt new file mode 100644 index 00000000..c49f1385 --- /dev/null +++ b/c20/gt/h6000.gt @@ -0,0 +1,282 @@ +typenames (char,int,float,double); +memnames (reg,auto,ext,stat,param,label,intlit,floatlit,string, + ix0,ix1,ix2,ix3,ix4,ia,iq); +regnames (x0,x1,x2,x3,x4,a,q,f); +size 1(char),4(int,float),8(double); +align 1(char),4(int,float),8(double); +class x(x0,x1,x2,x3,x4), r(a,q); +conflict (a,f),(q,f); +saveareasize 16; +pointer p0(1), p1(4); +offsetrange p1 (,); +returnreg q(char,int,p0,p1), f(double); +type int(r), char(r), float(f), double(f), p0(r), p1(x); + +.sw: a,,1[x4]; ++p0: -p0: +i:-i:&:^: .OR: -p0p0:<<: >>: r,M,1; ++p1: M,M,x; x,r,1; x,intlit,1; +-p1: x,r,1; x,intlit,1; +=+i: =&: =^: =OR: M,r,1; +*i: /i: q,M,q[a]; ++d: -d: *d: /d: f,M,f; +%: q,M,a[q]; +=<<: =>>: M,a,q; M,q,a; +&u0: auto|ext|stat|string|ia|iq,,r; +&u1: M,,x; +.BNOT: .ic: .ci: r,,1; +-ui: M,,r; +.cf: .cd: .if: .id: a,,f; +.fc: .dc: .fi: .di: f,,q; +.fd: M,,f; +.df: -ud: f,,1; +.ip0: .p0i: r,,1; M,,r; +.ip1: .p0p1: r,,x; M,,x; +.p1i: .p1p0: x,,r; M,,r; +++bi: M,,1; +++ai: M,,a[q]; + M,,q[a]; +++ap1: --ap1: M,M,x; +==i: !=i: i: <=i: >=i: +==p0: !=p0: p0: <=p0: >=p0: r,M,M; +==d: !=d: d: <=d: >=d: f,M,M; +==p1: !=p1: p1: <=p1: >=p1: x,M,M; + +macros + ++i: " AD#R #S" +-i: " SB#R #S" +*i: " MPY #S" +/i: %: " DIV #S" ++d: " DFAD #S" +-d: " DFSB #S" +*d: " DFMP #S" +/d: " DFDV #S" +=+i: " AS#S #R" +&: " AN#F #S" +=&: " ANS#S #F" +^: " ER#F #S" +=^: " ERS#S #F" +.OR: " OR#F #S" +=OR: " ORS#S #F" + +>>: +(,intlit,): " #FRS %o(#'S)" +(,~intlit,): " LXL5 #S\n #FRS 0,5" + +<<: +(,intlit,): " #FLS %o(#'S)" +(,~intlit,): " LXL5 #S\n #FLS 0,5" + +=>>: +" LD#R #F + #RRS 0,#SL + ST#R #F" + +=<<: +" LD#R #F + #RLS 0,#SL + ST#R #F" + ++p0: +(,~intlit,): " #FRS 16\n AD#F #S\n #FLS 16" +(,intlit,): " ADL#R %co(#'S)" + +-p0: +(,~intlit,): " #FRS 16\n SB#F #S\n #FLS 16" +(,intlit,): " SBL#R %co(#'S)" + ++p1: +(M,M,): " LXL#R #S\n ADLX#R #F" +(x,r,): " #SLS 18\n ST#S .TEMP\n ADX#F .TEMP" +(x,intlit,): " EAX#R %o(#'S),#R" + +-p1: +(,r,): " #SLS 18\n ST#S .TEMP\n SBX#F .TEMP" +(,intlit,): " EAX#R -%o(#'S),#R" + +-ui: " LC#R #F" +-ud: " FNEG" +++bi: " AOS #F" +++ai: " LD#R #F\n AOS #F" + +++ap1: +" LDX#R #F + EAX5 %o(#'S),#1 + STX5 #F" + +--ap1: +" LDX#R #F + EAX5 -%o(#'S),#1 + STX5 #F" + +.BNOT: " ER#F =-1" +&u0: +(ia|iq,,r): +"%if(%o(#'F), AD#F %co(#'F)\n,)\" +(ia,,q): " LLR 36" +(iq,,a): " LLR 36" +(auto|stat,,r): +" EA#R %n(#3,0) +%if(%o(#'F), AD#R %co(#'F)\n,)\" +(ext|string,,r): +" EA#R #F" + +&u1: " EAX#R #F" + +==i: " CMP#F #S\n TZE #R" +!=i: " CMP#F #S\n TNZ #R" +i: " CMP#F #S\n TZE *+2\n TPL #R" +<=i: " CMP#F #S\n TZE #R\n TMI #R" +>=i: " CMP#F #S\n TPL #R" + +==d: " DFCMP #S\n TZE #R" +!=d: " DFCMP #S\n TNZ #R" +d: " DFCMP #S\n TZE *+2\n TPL #R" +<=d: " DFCMP #S\n TZE #R\n TMI #R" +>=d: " DFCMP #S\n TPL #R" + +==p0: " CMP#F #S\n TZE #R" +!=p0: " CMP#F #S\n TNZ #R" +p0: " CMP#F #S\n TZE *+2\n TRC #R" +<=p0: " CMP#F #S\n TZE #R\n TNC #R" +>=p0: " CMP#F #S\n TRC #R" + +==p1: " CMPX#F #S\n TZE #R" +!=p1: " CMPX#F #S\n TNZ #R" +p1: " CMPX#F #S\n TZE *+2\n TRC #R" +<=p1: " CMPX#F #S\n TZE #R\n TNC #R" +>=p1: " CMPX#F #S\n TRC #R" + +-p0p0: " SBL#F #S\n #FRL 16" + +.cc: +(auto,,): " EA#R 0,7\n" +(stat,,): " EA#R .STAT\n" +(ia,,q): " STA .TEMP\n LDQ .TEMP\n" +(iq,,a): " STQ .TEMP\n LDA .TEMP\n" +(auto|stat|indirect,,): +"%if(%o(#'F), AD#R %co(#'F)\n,)\ + TSX5 .CTO#R" +(ext|string,,): " LD#R #F\n #RRL 27" +(r,,r): " EA#R 0,#FL\n #RRL 18" +(r,,auto|stat|indirect|string): + " EAX5 0,#FL\n" +(r,,auto): " EA#F 0,7\n" +(r,,stat): " EA#F .STAT\n" +(r,,auto|stat): +"%if(%o(#'R), AD#F %co(#'R)\n,)\ + TSX4 .#FTOC" +(r,,string): " EA#F #R\n TSX4 .#FTOC" +(r,,ext): " #FLS 27\n ST#F #R\n #FRL 27" +(q,,ia): +"%if(%o(#'R), ADA %co(#'R)\n,)\ + TSX4 .ATOC" +(a,,iq): +"%if(%o(#'R), ADQ %co(#'R)\n,)\ + TSX4 .QTOC" +.ii: +(r,,M): " ST#F #R" +(M,,r): " LD#R #F" +(r,,r): " LLR 36" +.ff: +(f,,M): " FSTR #R" +(M,,f): " FLD #F" +.dd: +(f,,M): " DPSTR #R" +(M,,f): " DPLD #F" +.p0p0: +(r,,r): " LLR 36" +(r,,M): " ST#F #R" +(M,,r): " LD#R #F" +.p1p1: +(x,,x): " EAX#R 0,#F" +(x,,M): " STZ #R\n STX#F #R" +(M,,x): " LDX#R #F" +(x,,q): " EAQ 0,#F" +(q,,x): " EAX#R 0,QU" +(M,,q): " LDQ #F" +(q,,M): " STQ #R" + +.ci: "\" +.ic: " AN#F =O377,DL" + +.p0p1: .ip1: +(r,,x): " EAX#R 0,#FU" +(M,,x): " LDX#R #F" + +.p1p0: .p1i: +(x,,r): " EA#R 0,#F" +(M,,r): " LD#R #F" + +.ip0: .p0i: +(M,,r): " LD#R #F" +(r,,r): "\" + +.fd: " FLD #F" +.df: " FRD" + +.cf: .cd: .if: .id: +" LDQ 0,DL + LDE =35B25,DU + FNO" + +.fi: .di: " UFA =71B25,DU" +.fc: .dc: +" UFA =71B25,DU + ANQ =O377,DL" + +hd: +"$ GMAP + SYMREF .PROLG,.EPILG,.TEMP,.LSIWT,.TSWIT + SYMREF .CTOA,.CTOQ,.ATOC,.QTOC" + +en: " SYMDEF #0" +ex: " SYMREF #0" +st: ".I#0 EQU *" +rt: " TRA .EPILG" +go: " TRA #R" +l: ".L#0 EQU *" +lc: " ZERO .L#0" + +p: +"* +* FUNCTION %m(#1) +* +%i(#1) TSX0 .PROLG + ZERO .FS#0" +ca: +" TSX1 #F + ZERO #1/4,#0" +ep: +" TRA .EPILG +.FS#0 EQU #1/4" + +ls: +" TSX5 .LSWIT + ZERO #R,#0" +ts: +" TSX5 .TSWIT + ZERO #0,#5 + TRA #R" + +o: "#1" +co: "=V20/#1,16/0" + +ln: "%flush().N#0 EQU *" +eq: "%flush()#0 EQU *" +in: "%flush() DEC #0" +ad0: ad1: "%flush() ZERO #R" +sc: "%flush() ZERO .S#0" +end: "%flush() END" +f: "%flush() DEC %ff(#0)" +nf: "%flush() DEC -%ff(#0)" +d: "%flush() DEC %dd(#0)" +nd: "%flush() DEC -%dd(#0)" +al1: "%flush()\" +al2: "%flush() EVEN" +im: da: pu: pd: "\" + \ No newline at end of file diff --git a/c20/gt/pdp10.gt b/c20/gt/pdp10.gt new file mode 100644 index 00000000..e16c25af --- /dev/null +++ b/c20/gt/pdp10.gt @@ -0,0 +1,234 @@ +typenames (char, int, float, double); +regnames (a, c, d, b); +memnames (reg, auto, ext, stat, param, label, intlit, floatlit, + stringlit, ia, ic, id, ib); +size 1 (char, int, float, double); +align 1(char, int, float, double); +class r (a, b, c, d); +saveareasize 1; +pointer p0 (1); +offsetrange p0 (,); +returnreg a (int, double, p0); +type char(r), int(r), float(r), double(r), p0(r); + +.sw: a|c|d,,1[b]; +.argi: .argd: .arg0: r,,1; M,,1; + ++i: *i: &: ^: .OR: +p0: ++d: *d: r,r,1; r,M,1; M,r,2; + +-i: -p0: -p0p0: -d: /d: r,r,1; r,M,1; + +/i: a,r,1[b]; b,r,1[c]; c,r,1[d]; + a,M,1[b]; b,M,1[c]; c,M,1[d]; + +%: a,r,b; b,r,c; c,r,d; + a,M,b; b,M,c; c,M,d; + +<<: >>: r,r,1; r,intlit,1; + +=+i: =*i: =&: =^: =OR: +=+d: =*d: M,r,1; M,r,2; + +.BNOT: -ui: -ud: r,,1; M,,r; + +&u0: +++ai: ++ac: --ai: --ac: M,,r; + +++ap0: --ap0: M,b,a|c|d; M,d,b; + +++bi: ++bc: +--bi: --bc: M,,r; M,,1; + +++bp0: --bp0: M,r,2; + +.ic: .ci: .ip0: .p0i: .df: .fd: +.cf: .cd: .if: .id: r,,1; + +.fc: .dc: .fi: .di: a,,b; + +==p0: !=p0: p0: <=p0: >=p0: +==i: !=i: i: <=i: >=i: +==d: !=d: d: <=d: >=d: r,r,label; r,M,label; + +==0p0: !=0p0: r,,label; M,,label; + + + + +macros + ++i: *i: &: ^: .OR: +p0: + + (r,r,): " #O #F,#S" + (M,,): " #O #S,#F" + (r,~intlit,): " #O #F,#S" + (r,intlit,): " #O%ifm(#'S,I #F\,#6, #F\,#S)" + +-i: /i: %: -p0: sb: + + (,r,): " #O #F,#S" + (,~intlit,): " #O #F,#S" + (,intlit,): " #O%ifm(#'S,I #F\,#6, #F\,#S)" + ++d: *d: + + (r,,): " #O #F,#S" + (M,,): " #O #S,#F" + +-d: /d: -p0p0: + + " #O #F,#S" + +<<: + (,intlit,): " LSH #R,#6" + (,r,): " LSH #R,(#S)" +>>: + (,intlit,): " LSH #R,-#6" + (,r,): " MOVN #S,#S\n LSH #R,(#S)" + +=+i: " ADDB #S,#F" +=*i: " IMULB #S,#F" +=&: " ANDB #S,#F" +=^: " XORB #S,#F" +=OR: " IORB #S,#F" +=+d: " FADRB #S,#F" +=*d: " FMPRB #S,#F" + +&u0: " MOVEI #R,#F" +++ai: ++ac: " MOVE #R,#F\n AOS #F" +--ai: --ac: " MOVE #R,#F\n SOS #F" +++bi: ++bc: + (,,r): " MOVEI #R,1\n ADDB #R,#F" + (,,M): " AOS #F" +--bi: --bc: + (,,r): " SETO #R,\n ADDB #R,#F" + (,,M): " SOS #F" +++ap0: " MOVE #R,#F\n ADDM #S,#F" +--ap0: " MOVE #R,#F\n MOVN #S,#S\n ADDM #S,#F" +++bp0: " ADDB #S,#F" +--bp0: " MOVN #S,#S\n ADDB #S,#F" +.BNOT: + (r,,): " SETCA #R," + (M,,): " SETCM #R,#F" +-ui: -ud: " MOVN #R,#F" + +==p0: " CAMN #F,#S\n GO #R" +!=p0: " CAME #F,#S\n GO #R" +p0: " CAMLE #F,#S\n GO #R" +<=p0: " CAMG #F,#S\n GO #R" +>=p0: " CAML #F,#S\n GO #R" + +==i: "%ifm(#'S,%if(#6,\tCAIN\t#F\,#6\n\tGO\t#R,\tJUMPE\t#F\,#R),\tCAMN\t#F\,#S\n\tGO\t#R)" +!=i: "%ifm(#'S,%if(#6,\tCAIE\t#F\,#6\n\tGO\t#R,\tJUMPN\t#F\,#R),\tCAME\t#F\,#S\n\tGO\t#R)" +i: "%ifm(#'S,%if(#6,\tCAILE\t#F\,#6\n\tGO\t#R,\tJUMPG\t#F\,#R),\tCAMLE\t#F\,#S\n\tGO\t#R)" +<=i: "%ifm(#'S,%if(#6,\tCAIG\t#F\,#6\n\tGO\t#R,\tJUMPLE\t#F\,#R),\tCAMG\t#F\,#S\n\tGO\t#R)" +>=i: "%ifm(#'S,%if(#6,\tCAIL\t#F\,#6\n\tGO\t#R,\tJUMPGE\t#F\,#R),\tCAML\t#F\,#S\n\tGO\t#R)" + +==d: " FSBR #F,#S\n JUMPE #F,#R" +!=d: " FSBR #F,#S\n JUMPN #F,#R" +d: " FSBR #F,#S\n JUMPG #F,#R" +<=d: " FSBR #F,#S\n JUMPLE #F,#R" +>=d: " FSBR #F,#S\n JUMPGE #F,#R" + +==0p0: + (M,,): " SKIPN #F\n GO #R" + (r,,): " JUMPE #F,#R" +!=0p0: + (M,,): " SKIPE #F\n GO #R" + (r,,): " JUMPN #F,#R" + +.cc: .ii: +.ff: .dd: +.p0p0: + (r,,r): " MOVE #R,#F" + (r,,M): " MOVEM #F,#R" + (~intlit,,r): " MOVE #R,#F" + (intlit,,r): " %ifm(#'F,MOVEI\t#R\,#4,%ifm(#3,-#4,MOVNI\t#R\,-#4,MOVE\t#R\,#F))" + +.if: .id: +.cf: .cd: " FSC #R,155" +.di: .dc: +.fi: .fc: " JSP 0,FIXIFY""" +.ic: .ci: +.ip0: .p0i: +.df: .fd: "\" + +.argi: +.argd: +.arg0: " PPUSH #F" + +in: c: " #0" +ad0: " #R" + +al: "\" +ca: " CCALL #0,#F" + +end: +".PDATA +CONSTANTS +END" + +en: " ENTRY #0" +ex: " EXTERN #0" +eq: "#0:" +go: " GO #R" +hd: + +" TITLE %pname() + RADIX 10. +.INSRT C;NC INSERT +" + +ln: "\n; LINE #0\n" +p: + +"%setfno(#0) +\%A==#2 + \%A,,[ASCIZ/%m(#1)/] +%i(#1): ADDI P,FS#0" + +rt: +" SUBI P,FS#0+\%A+1 + GO @<\%A+1>(P)" +ep: +" SUBI P,FS#0+\%A+1 + GO @<\%A+1>(P) +FS#0==#1-1" + +st: "I#0:" +z: " BLOCK #0" + +f: d: " %ff(#0)" +nf: nd: " -%ff(#0)" + +ts: +"%if(#0,%sb(68,#'F,#'F,-6,#0) +,) JUMPL #F,#R + CAILE #F,#5-#0 + GO #R + GO @(#F)[" + +ets: " ]" + +ls: +" MOVE B,[-#0,,[" + +els: +" ]] + CAMN #F,(B) + GO @#0(B) + AOBJN B,.-2 + GO #R" + +lc: " L#0" +l: "L#0:" +sc: " S#0" +pu: ".CODE" +pd: ".PDATA" +im: ".UDATA" +da: ".IDATA" + \ No newline at end of file diff --git a/c20/gt/pdp10.gtout b/c20/gt/pdp10.gtout new file mode 100644 index 00000000..5e7c88f0 --- /dev/null +++ b/c20/gt/pdp10.gtout @@ -0,0 +1,429 @@ +/* class r 1111 */ +/* conflict a 0000 */ +/* conflict c 0000 */ +/* conflict d 0000 */ +/* conflict b 0000 */ +int ofok1(i) {return (1);} +/* type char 1111 */ +/* type int 1111 */ +/* type float 1111 */ +/* type double 1111 */ +/* pointer class p0 1111 */ + +int (*off_ok[])() {ofok1}; + +int tsize[4] { +1,1,1,1}; +int talign[4] { +0,0,0,0}; +int calign[1] { +1}; +int retreg[7] { +-1,-1,-1,0,-1,0,0}; +int tpoint[4] { +0,0,0,0}; +int spoint[1] { +1}; +int trdt[4] { +15,15,15,15}; +int prdt[1] { +15}; +int conf[4] { +0,0,0,0}; +int flt_hack { 0 }; +int xoploc[] { + 1,7,0,0,3,0,8, + 1,15,0,0,3,0,0, + 2,-1,0,0,3,0,0, + 1,15,1,15,3,0,0, + 1,15,2,-1,3,0,0, + 2,-1,1,15,4,0,0, + 1,15,1,15,3,0,0, + 1,15,2,-1,3,0,0, + 1,1,1,15,3,0,8, + 1,8,1,15,3,0,2, + 1,2,1,15,3,0,4, + 1,1,2,-1,3,0,8, + 1,8,2,-1,3,0,2, + 1,2,2,-1,3,0,4, + 1,1,1,15,1,8,0, + 1,8,1,15,1,2,0, + 1,2,1,15,1,4,0, + 1,1,2,-1,1,8,0, + 1,8,2,-1,1,2,0, + 1,2,2,-1,1,4,0, + 1,15,1,15,3,0,0, + 1,15,2,64,3,0,0, + 2,-1,1,15,3,0,0, + 2,-1,1,15,4,0,0, + 1,15,0,0,3,0,0, + 2,-1,0,0,1,15,0, + 2,-1,0,0,1,15,0, + 2,-1,1,8,1,7,0, + 2,-1,1,4,1,8,0, + 2,-1,0,0,1,15,0, + 2,-1,0,0,3,0,0, + 2,-1,1,15,4,0,0, + 1,15,0,0,3,0,0, + 1,1,0,0,1,8,0, + 1,15,1,15,2,32,0, + 1,15,2,-1,2,32,0, + 1,15,0,0,2,32,0, + 2,-1,0,0,2,32,0, + 0}; +int rtopp[192] { +32,32,40,35,40,35,32,-1,-1,-1, +0,40,35,40,35,35,-1,-1,-1,-1, +52,-1,-1,-1,52,-1,-1,-1,-1,-1, +-1,-1,45,45,45,45,45,45,45,-1, +-1,-1,47,47,45,47,47,45,45,-1, +-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, +-1,-1,-1,-1,5,29,5,29,9,-1, +9,-1,5,29,5,29,12,-1,9,-1, +19,-1,26,-1,26,-1,5,29,5,29, +5,29,-1,-1,9,-1,2,2,2,-1, +-1,-1,5,-1,-1,-1,9,-1,-1,-1, +-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, +-1,-1,-1,-1,-1,-1,-1,-1,49,49, +49,49,49,49,49,49,49,49,49,49, +49,49,49,49,49,49,-1,-1,-1,-1, +-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, +-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, +-1,-1,-1,-1,-1,-1,43,37,43,37, +-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, +-1,-1}; +int rtopl[55] { +0,-1,1,2,-1,3,4,5,-1,6, +7,-1,8,9,10,11,12,13,-1,14, +15,16,17,18,19,-1,20,21,-1,22, +23,-1,24,25,-1,26,-1,27,28,-1, +29,30,-1,31,-1,32,-1,33,-1,34, +35,-1,36,37,-1}; +int opreg[192] { +15,15,15,15,15,15,15,15,0,0, +7,15,15,15,15,15,0,0,0,0, +0,0,0,0,0,0,0,0,0,0, +0,0,15,15,15,15,15,15,15,0, +0,0,8,8,15,8,8,15,15,0, +0,0,0,0,0,0,0,0,0,0, +0,0,0,0,15,15,15,15,15,0, +15,0,15,15,15,15,11,0,15,0, +14,0,15,0,15,0,15,15,15,15, +15,15,15,15,15,0,15,15,15,0, +0,0,15,0,0,0,15,0,0,0, +0,0,0,0,0,0,0,0,0,0, +0,15,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,15,15,15,15, +0,0,0,0,0,0,0,0,0,0, +0,0}; +int opmem[192] { +0,0,-1,0,-1,0,0,0,0,0, +0,-1,0,-1,0,0,0,0,0,0, +32,0,0,0,32,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,-1,0,-1,0,0, +0,0,0,-1,0,-1,0,0,0,0, +0,0,0,0,0,0,0,-1,0,-1, +0,-1,0,0,0,0,-1,-1,-1,0, +0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0, +0,0,0,0,128,256,64,0,32,32, +32,32,32,32,32,32,32,32,32,32, +32,32,32,32,32,32,0,0,0,0, +0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0, +0,0,0,0,0,0,0,0,0,0, +0,0}; +int mactab[192] { +24,24,17,15,18,16,23,-1,-1,-1, +-1,17,15,18,16,14,-1,-1,-1,-1, +43,-1,-1,-1,44,-1,-1,-1,-1,-1, +-1,-1,48,46,46,48,46,46,48,-1, +-1,-1,47,47,48,47,47,48,48,-1, +-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, +-1,-1,-1,-1,1,7,3,12,2,-1, +4,-1,1,8,3,13,2,-1,4,-1, +2,-1,5,-1,6,-1,1,9,1,10, +1,11,-1,-1,4,-1,49,49,49,-1, +-1,-1,1,-1,-1,-1,2,-1,-1,-1, +-1,-1,45,45,45,45,45,-1,-1,-1, +-1,-1,-1,-1,-1,-1,-1,-1,31,32, +33,34,35,36,37,38,39,40,41,42, +25,26,27,28,29,30,-1,-1,-1,-1, +-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, +-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, +-1,-1,-1,-1,-1,-1,21,19,22,20, +-1,-1,-1,-1,-1,-1,-1,-1,-1,-1, +-1,-1}; +int ntype { 4 }; +int nmem { 13 }; +int nac { 1 }; +int npc { 1 }; +int sv_area_sz { 1 }; +int nreg { 4 }; +char mcstuff[] { +'\t', '#', 'O', '\t', '#', 'F', ',', '#', 'S', 0, '\t', '#', +'O', '\t', '#', 'S', ',', '#', 'F', 0, '\t', '#', 'O', '\t', +'#', 'F', ',', '#', 'S', 0, '\t', '#', 'O', '%', 'i', 'f', +'m', '(', '#', '5', ',', '#', '6', ',', 'I', '\t', '#', 'F', +'\\', ',', '#', '6', ',', '\t', '#', 'F', '\\', ',', '#', 'S', +')', 0, '\t', '#', 'O', '\t', '#', 'F', ',', '#', 'S', 0, +'\t', '#', 'O', '\t', '#', 'F', ',', '#', 'S', 0, '\t', '#', +'O', '%', 'i', 'f', 'm', '(', '#', '5', ',', '#', '6', ',', +'I', '\t', '#', 'F', '\\', ',', '#', '6', ',', '\t', '#', 'F', +'\\', ',', '#', 'S', ')', 0, '\t', '#', 'O', '\t', '#', 'F', +',', '#', 'S', 0, '\t', '#', 'O', '\t', '#', 'S', ',', '#', +'F', 0, '\t', '#', 'O', '\t', '#', 'F', ',', '#', 'S', 0, +'\t', 'L', 'S', 'H', '\t', '#', 'R', ',', '#', '6', 0, '\t', +'L', 'S', 'H', '\t', '#', 'R', ',', '(', '#', 'S', ')', 0, +'\t', 'L', 'S', 'H', '\t', '#', 'R', ',', '-', '#', '6', 0, +'\t', 'M', 'O', 'V', 'N', '\t', '#', 'S', ',', '#', 'S', '\n', +'\t', 'L', 'S', 'H', '\t', '#', 'R', ',', '(', '#', 'S', ')', +0, '\t', 'A', 'D', 'D', 'B', '\t', '#', 'S', ',', '#', 'F', +0, '\t', 'I', 'M', 'U', 'L', 'B', '\t', '#', 'S', ',', '#', +'F', 0, '\t', 'A', 'N', 'D', 'B', '\t', '#', 'S', ',', '#', +'F', 0, '\t', 'X', 'O', 'R', 'B', '\t', '#', 'S', ',', '#', +'F', 0, '\t', 'I', 'O', 'R', 'B', '\t', '#', 'S', ',', '#', +'F', 0, '\t', 'F', 'A', 'D', 'R', 'B', '\t', '#', 'S', ',', +'#', 'F', 0, '\t', 'F', 'M', 'P', 'R', 'B', '\t', '#', 'S', +',', '#', 'F', 0, '\t', 'M', 'O', 'V', 'E', 'I', '\t', '#', +'R', ',', '#', 'F', 0, '\t', 'M', 'O', 'V', 'E', '\t', '#', +'R', ',', '#', 'F', '\n', '\t', 'A', 'O', 'S', '\t', '#', 'F', +0, '\t', 'M', 'O', 'V', 'E', '\t', '#', 'R', ',', '#', 'F', +'\n', '\t', 'S', 'O', 'S', '\t', '#', 'F', 0, '\t', 'M', 'O', +'V', 'E', 'I', '\t', '#', 'R', ',', '1', '\n', '\t', 'A', 'D', +'D', 'B', '\t', '#', 'R', ',', '#', 'F', 0, '\t', 'A', 'O', +'S', '\t', '#', 'F', 0, '\t', 'S', 'E', 'T', 'O', '\t', '#', +'R', ',', '\n', '\t', 'A', 'D', 'D', 'B', '\t', '#', 'R', ',', +'#', 'F', 0, '\t', 'S', 'O', 'S', '\t', '#', 'F', 0, '\t', +'M', 'O', 'V', 'E', '\t', '#', 'R', ',', '#', 'F', '\n', '\t', +'A', 'D', 'D', 'M', '\t', '#', 'S', ',', '#', 'F', 0, '\t', +'M', 'O', 'V', 'E', '\t', '#', 'R', ',', '#', 'F', '\n', '\t', +'M', 'O', 'V', 'N', '\t', '#', 'S', ',', '#', 'S', '\n', '\t', +'A', 'D', 'D', 'M', '\t', '#', 'S', ',', '#', 'F', 0, '\t', +'A', 'D', 'D', 'B', '\t', '#', 'S', ',', '#', 'F', 0, '\t', +'M', 'O', 'V', 'N', '\t', '#', 'S', ',', '#', 'S', '\n', '\t', +'A', 'D', 'D', 'B', '\t', '#', 'S', ',', '#', 'F', 0, '\t', +'S', 'E', 'T', 'C', 'A', '\t', '#', 'R', ',', 0, '\t', 'S', +'E', 'T', 'C', 'M', '\t', '#', 'R', ',', '#', 'F', 0, '\t', +'M', 'O', 'V', 'N', '\t', '#', 'R', ',', '#', 'F', 0, '\t', +'C', 'A', 'M', 'N', '\t', '#', 'F', ',', '#', 'S', '\n', '\t', +'G', 'O', '\t', '#', 'R', 0, '\t', 'C', 'A', 'M', 'E', '\t', +'#', 'F', ',', '#', 'S', '\n', '\t', 'G', 'O', '\t', '#', 'R', +0, '\t', 'C', 'A', 'M', 'G', 'E', '\t', '#', 'F', ',', '#', +'S', '\n', '\t', 'G', 'O', '\t', '#', 'R', 0, '\t', 'C', 'A', +'M', 'L', 'E', '\t', '#', 'F', ',', '#', 'S', '\n', '\t', 'G', +'O', '\t', '#', 'R', 0, '\t', 'C', 'A', 'M', 'G', '\t', '#', +'F', ',', '#', 'S', '\n', '\t', 'G', 'O', '\t', '#', 'R', 0, +'\t', 'C', 'A', 'M', 'L', '\t', '#', 'F', ',', '#', 'S', '\n', +'\t', 'G', 'O', '\t', '#', 'R', 0, '%', 'i', 'f', 'm', '(', +'#', '5', ',', '#', '6', ',', '%', 'i', 'f', '(', '#', '6', +',', '\t', 'C', 'A', 'I', 'N', '\t', '#', 'F', '\\', ',', '#', +'6', '\n', '\t', 'G', 'O', '\t', '#', 'R', ',', '\t', 'J', 'U', +'M', 'P', 'E', '\t', '#', 'F', '\\', ',', '#', 'R', ')', ',', +'\t', 'C', 'A', 'M', 'N', '\t', '#', 'F', '\\', ',', '#', 'S', +'\n', '\t', 'G', 'O', '\t', '#', 'R', ')', 0, '%', 'i', 'f', +'m', '(', '#', '5', ',', '#', '6', ',', '%', 'i', 'f', '(', +'#', '6', ',', '\t', 'C', 'A', 'I', 'E', '\t', '#', 'F', '\\', +',', '#', '6', '\n', '\t', 'G', 'O', '\t', '#', 'R', ',', '\t', +'J', 'U', 'M', 'P', 'N', '\t', '#', 'F', '\\', ',', '#', 'R', +')', ',', '\t', 'C', 'A', 'M', 'E', '\t', '#', 'F', '\\', ',', +'#', 'S', '\n', '\t', 'G', 'O', '\t', '#', 'R', ')', 0, '%', +'i', 'f', 'm', '(', '#', '5', ',', '#', '6', ',', '%', 'i', +'f', '(', '#', '6', ',', '\t', 'C', 'A', 'I', 'G', 'E', '\t', +'#', 'F', '\\', ',', '#', '6', '\n', '\t', 'G', 'O', '\t', '#', +'R', ',', '\t', 'J', 'U', 'M', 'P', 'L', '\t', '#', 'F', '\\', +',', '#', 'R', ')', ',', '\t', 'C', 'A', 'M', 'G', 'E', '\t', +'#', 'F', '\\', ',', '#', 'S', '\n', '\t', 'G', 'O', '\t', '#', +'R', ')', 0, '%', 'i', 'f', 'm', '(', '#', '5', ',', '#', +'6', ',', '%', 'i', 'f', '(', '#', '6', ',', '\t', 'C', 'A', +'I', 'L', 'E', '\t', '#', 'F', '\\', ',', '#', '6', '\n', '\t', +'G', 'O', '\t', '#', 'R', ',', '\t', 'J', 'U', 'M', 'P', 'G', +'\t', '#', 'F', '\\', ',', '#', 'R', ')', ',', '\t', 'C', 'A', +'M', 'L', 'E', '\t', '#', 'F', '\\', ',', '#', 'S', '\n', '\t', +'G', 'O', '\t', '#', 'R', ')', 0, '%', 'i', 'f', 'm', '(', +'#', '5', ',', '#', '6', ',', '%', 'i', 'f', '(', '#', '6', +',', '\t', 'C', 'A', 'I', 'G', '\t', '#', 'F', '\\', ',', '#', +'6', '\n', '\t', 'G', 'O', '\t', '#', 'R', ',', '\t', 'J', 'U', +'M', 'P', 'L', 'E', '\t', '#', 'F', '\\', ',', '#', 'R', ')', +',', '\t', 'C', 'A', 'M', 'G', '\t', '#', 'F', '\\', ',', '#', +'S', '\n', '\t', 'G', 'O', '\t', '#', 'R', ')', 0, '%', 'i', +'f', 'm', '(', '#', '5', ',', '#', '6', ',', '%', 'i', 'f', +'(', '#', '6', ',', '\t', 'C', 'A', 'I', 'L', '\t', '#', 'F', +'\\', ',', '#', '6', '\n', '\t', 'G', 'O', '\t', '#', 'R', ',', +'\t', 'J', 'U', 'M', 'P', 'G', 'E', '\t', '#', 'F', '\\', ',', +'#', 'R', ')', ',', '\t', 'C', 'A', 'M', 'L', '\t', '#', 'F', +'\\', ',', '#', 'S', '\n', '\t', 'G', 'O', '\t', '#', 'R', ')', +0, '\t', 'F', 'S', 'B', 'R', '\t', '#', 'F', ',', '#', 'S', +'\n', '\t', 'J', 'U', 'M', 'P', 'E', '\t', '#', 'F', ',', '#', +'R', 0, '\t', 'F', 'S', 'B', 'R', '\t', '#', 'F', ',', '#', +'S', '\n', '\t', 'J', 'U', 'M', 'P', 'N', '\t', '#', 'F', ',', +'#', 'R', 0, '\t', 'F', 'S', 'B', 'R', '\t', '#', 'F', ',', +'#', 'S', '\n', '\t', 'J', 'U', 'M', 'P', 'L', '\t', '#', 'F', +',', '#', 'R', 0, '\t', 'F', 'S', 'B', 'R', '\t', '#', 'F', +',', '#', 'S', '\n', '\t', 'J', 'U', 'M', 'P', 'G', '\t', '#', +'F', ',', '#', 'R', 0, '\t', 'F', 'S', 'B', 'R', '\t', '#', +'F', ',', '#', 'S', '\n', '\t', 'J', 'U', 'M', 'P', 'L', 'E', +'\t', '#', 'F', ',', '#', 'R', 0, '\t', 'F', 'S', 'B', 'R', +'\t', '#', 'F', ',', '#', 'S', '\n', '\t', 'J', 'U', 'M', 'P', +'G', 'E', '\t', '#', 'F', ',', '#', 'R', 0, '\t', 'S', 'K', +'I', 'P', 'N', '\t', '#', 'F', '\n', '\t', 'G', 'O', '\t', '#', +'R', 0, '\t', 'J', 'U', 'M', 'P', 'E', '\t', '#', 'F', ',', +'#', 'R', 0, '\t', 'S', 'K', 'I', 'P', 'E', '\t', '#', 'F', +'\n', '\t', 'G', 'O', '\t', '#', 'R', 0, '\t', 'J', 'U', 'M', +'P', 'N', '\t', '#', 'F', ',', '#', 'R', 0, '\t', 'M', 'O', +'V', 'E', '\t', '#', 'R', ',', '#', 'F', 0, '\t', 'M', 'O', +'V', 'E', 'M', '\t', '#', 'F', ',', '#', 'R', 0, '\t', 'M', +'O', 'V', 'E', '\t', '#', 'R', ',', '#', 'F', 0, '\t', '%', +'i', 'f', 'm', '(', '#', '3', ',', '#', '4', ',', 'M', 'O', +'V', 'E', 'I', '\t', '#', 'R', '\\', ',', '#', '4', ',', '%', +'i', 'f', 'm', '(', '#', '3', ',', '-', '#', '4', ',', 'M', +'O', 'V', 'N', 'I', '\t', '#', 'R', '\\', ',', '-', '#', '4', +',', 'M', 'O', 'V', 'E', '\t', '#', 'R', '\\', ',', '#', 'F', +')', ')', 0, '\t', 'F', 'S', 'C', '\t', '#', 'R', ',', '1', +'5', '5', 0, '\t', 'J', 'S', 'P', '\t', '0', ',', 'F', 'I', +'X', 'I', 'F', 'Y', '"', 0, '\\', 0, '\t', 'P', 'P', 'U', +'S', 'H', '\t', '#', 'F', 0, '\t', '#', '0', 0, '\t', '#', +'R', 0, '\\', 0, '\t', 'C', 'C', 'A', 'L', 'L', '\t', '#', +'0', ',', '#', 'F', 0, '.', 'P', 'D', 'A', 'T', 'A', '\n', +'C', 'O', 'N', 'S', 'T', 'A', 'N', 'T', 'S', '\n', 'E', 'N', +'D', 0, '\t', 'E', 'N', 'T', 'R', 'Y', '\t', '#', '0', 0, +'\t', 'E', 'X', 'T', 'E', 'R', 'N', '\t', '#', '0', 0, '#', +'0', ':', 0, '\t', 'G', 'O', '\t', '#', 'R', 0, '\t', 'T', +'I', 'T', 'L', 'E', ' ', '%', 'p', 'n', 'a', 'm', 'e', '(', +')', '\n', '\t', 'R', 'A', 'D', 'I', 'X', ' ', '1', '0', '.', +'\n', '.', 'I', 'N', 'S', 'R', 'T', ' ', 'C', ';', 'N', 'C', +' ', 'I', 'N', 'S', 'E', 'R', 'T', '\n', 0, '\n', ';', '\t', +'L', 'I', 'N', 'E', ' ', '#', '0', '\n', 0, '%', 's', 'e', +'t', 'f', 'n', 'o', '(', '#', '0', ')', '\n', '\\', '%', 'A', +'=', '=', '#', '2', '\n', '\t', '\\', '%', 'A', ',', ',', '[', +'A', 'S', 'C', 'I', 'Z', '/', '%', 'm', '(', '#', '1', ')', +'/', ']', '\n', '%', 'i', '(', '#', '1', ')', ':', '\t', 'A', +'D', 'D', 'I', '\t', 'P', ',', 'F', 'S', '#', '0', 0, '\t', +'S', 'U', 'B', 'I', '\t', 'P', ',', 'F', 'S', '#', '0', '+', +'\\', '%', 'A', '+', '1', '\n', '\t', 'G', 'O', '\t', '@', '<', +'\\', '%', 'A', '+', '1', '>', '(', 'P', ')', 0, '\t', 'S', +'U', 'B', 'I', '\t', 'P', ',', 'F', 'S', '#', '0', '+', '\\', +'%', 'A', '+', '1', '\n', '\t', 'G', 'O', '\t', '@', '<', '\\', +'%', 'A', '+', '1', '>', '(', 'P', ')', '\n', 'F', 'S', '#', +'0', '=', '=', '#', '1', '-', '1', 0, 'I', '#', '0', ':', +0, '\t', 'B', 'L', 'O', 'C', 'K', '\t', '#', '0', 0, '\t', +'%', 'f', 'f', '(', '#', '0', ')', 0, '\t', '-', '%', 'f', +'f', '(', '#', '0', ')', 0, '%', 'i', 'f', '(', '#', '0', +',', '%', 's', 'b', '(', '6', '8', ',', '#', '3', ',', '#', +'4', ',', '#', '3', ',', '#', '4', ',', '-', '6', ',', '#', +'0', ')', '\n', ',', ')', '\t', 'J', 'U', 'M', 'P', 'L', '\t', +'#', 'F', ',', '#', 'R', '\n', '\t', 'C', 'A', 'I', 'L', 'E', +'\t', '#', 'F', ',', '#', '5', '-', '#', '0', '\n', '\t', 'G', +'O', '\t', '#', 'R', '\n', '\t', 'G', 'O', '\t', '@', '(', '#', +'F', ')', '[', 0, '\t', ']', 0, '\t', 'M', 'O', 'V', 'E', +'\t', 'B', ',', '[', '-', '#', '0', ',', ',', '[', 0, '\t', +']', ']', '\n', '\t', 'C', 'A', 'M', 'N', '\t', '#', 'F', ',', +'(', 'B', ')', '\n', '\t', 'G', 'O', '\t', '@', '#', '0', '(', +'B', ')', '\n', '\t', 'A', 'O', 'B', 'J', 'N', '\t', 'B', ',', +'.', '-', '2', '\n', '\t', 'G', 'O', '\t', '#', 'R', 0, '\t', +'L', '#', '0', 0, 'L', '#', '0', ':', 0, '\t', 'S', '#', +'0', 0, '.', 'C', 'O', 'D', 'E', 0, '.', 'P', 'D', 'A', +'T', 'A', 0, '.', 'U', 'D', 'A', 'T', 'A', 0, '.', 'I', +'D', 'A', 'T', 'A', }; +char *mcstore {mcstuff}; +int macdef[79] { +0,0,29,51,66,69,84,99,102,105, +108,111,114,117,120,123,126,129,144,159, +162,165,168,171,186,189,192,195,198,201, +204,207,210,213,216,219,222,225,228,231, +234,237,240,243,258,273,302,305,308,311, +314,317,320,323,326,329,332,335,338,341, +344,347,350,353,356,359,362,365,368,371, +374,377,380,383,386,389,392,395,398}; +char *nmacname[] { + "sb", + "in", + "c", + "ad0", + "al", + "ca", + "end", + "en", + "ex", + "eq", + "go", + "hd", + "ln", + "p", + "rt", + "ep", + "st", + "z", + "f", + "d", + "nf", + "nd", + "ts", + "ets", + "ls", + "els", + "lc", + "l", + "sc", + "pu", + "pd", + "im", + "da"}; +int nmacdef[33] { +2,50,50,51,52,53,54,55,56,57, +58,59,60,61,62,63,64,65,66,66, +67,67,68,69,70,71,72,73,74,75, +76,77,78}; +int mdeflist[401] { +1,15,1,15,0,0,0,2,-1,0, +0,0,0,10,1,15,2,-65,0,0, +20,1,15,2,64,0,0,30,-1,0, +0,1,15,0,0,62,0,0,2,-65, +0,0,72,0,0,2,64,0,0,82, +-1,1,15,0,0,0,0,114,2,-1, +0,0,0,0,124,-1,3,134,-1,0, +0,2,64,0,0,144,0,0,1,15, +0,0,155,-1,0,0,2,64,0,0, +168,0,0,1,15,0,0,180,-1,3, +205,-1,3,217,-1,3,230,-1,3,242, +-1,3,254,-1,3,266,-1,3,279,-1, +3,292,-1,3,305,-1,3,325,-1,0, +0,0,0,1,15,345,0,0,0,0, +2,-1,369,-1,0,0,0,0,1,15, +377,0,0,0,0,2,-1,399,-1,3, +407,-1,3,431,-1,3,467,-1,3,479, +-1,1,15,0,0,0,0,503,2,-1, +0,0,0,0,514,-1,3,527,-1,3, +539,-1,3,558,-1,3,577,-1,3,597, +-1,3,617,-1,3,636,-1,3,655,-1, +3,729,-1,3,803,-1,3,879,-1,3, +955,-1,3,1030,-1,3,1105,-1,3,1130, +-1,3,1155,-1,3,1180,-1,3,1205,-1, +3,1231,-1,2,-1,0,0,0,0,1257, +1,15,0,0,0,0,1274,-1,2,-1, +0,0,0,0,1287,1,15,0,0,0, +0,1304,-1,1,15,0,0,1,15,1317, +1,15,0,0,2,-1,1329,2,-65,0, +0,1,15,1342,2,64,0,0,1,15, +1354,-1,3,1419,-1,3,1431,-1,3,1446, +-1,3,1448,-1,3,1458,-1,3,1462,-1, +3,1466,-1,3,1468,-1,3,1481,-1,3, +1502,-1,3,1512,-1,3,1523,-1,3,1527, +-1,3,1534,-1,3,1581,-1,3,1593,-1, +3,1655,-1,3,1690,-1,3,1736,-1,3, +1741,-1,3,1751,-1,3,1760,-1,3,1770, +-1,3,1852,-1,3,1855,-1,3,1871,-1, +3,1919,-1,3,1924,-1,3,1929,-1,3, +1934,-1,3,1940,-1,3,1947,-1,3,1954, +-1}; +int nnmacs { 33 }; +int mdflsz { 401 }; +int nmacros { 79 }; diff --git a/c20/gt/pdp11.gt b/c20/gt/pdp11.gt new file mode 100644 index 00000000..ac8ecb43 --- /dev/null +++ b/c20/gt/pdp11.gt @@ -0,0 +1,285 @@ +typenames (char, int, float, double); +regnames (r0, r2, r3, r1, fr0, fr1, fr2, fr3); +memnames (reg, auto, ext, stat, param, label, intlit, floatlit, + stringlit, ir0, ir2, ir3, ir1); +size 1 (char), 2 (int, float), 4 (double); +align 1 (char), 2 (int, float), 4 (double); +class r (r0, r1, r2, r3), f (fr0, fr1, fr2, fr3); +saveareasize 0; +pointer p0 (1); +offsetrange p0 (,); +returnreg r0 (int, p0), fr0 (double); +type char(r), int(r), float(f), double(f), p0(r); + +.sw: r0|r2,,1[r1,r3]; + ++i: &: .OR: +p0: r,r,1; r,M,1; M,r,2; + +-i: -p0: -p0p0: <<: >>: r,r,1; r,M,1; + +*i: r1,r,r1; + r3,r,r3; + r1,M,r1; + r3,M,r3; + r0,r,r1[r0]; + r2,r,r3[r2]; + r0,M,r1[r0]; + r2,M,r3[r2]; + +/i: r1,r2|r3,r0[r1]; + r3,r0|r1,r2[r3]; + r1,M,r0[r1]; + r3,M,r2[r3]; + +%: r1,r2|r3,r1[r0]; + r3,r0|r1,r3[r2]; + r1,M,r1[r0]; + r3,M,r3[r1]; + +^: r,r,1; + ++d: *d: f,f,1; f,M,1; M,f,2; + +-d: /d: f,f,1; f,M,1; + +=+i: =-i: =&: =OR: +++bp0: --bp0: M,r,1; M,M,1; + +=^: M,r,1; + +.BNOT: -ui: r,,1; + +-ud: f,,1; + +&u0: M,,r; + +++ai: ++ac: --ai: --ac: M,,r; + +++ap0: --ap0: M,r,r; M,M,r; + +++bi: ++bc: +--bi: --bc: M,,1; + +.ic: .ci: .ip0: .p0i: r,,1; + +.df: .fd: f,,1; + +.cf: .cd: r,,f; +.if: .id: r,,f; M,,f; +.fc: .dc: .fi: .di: f,,r; + +==p0: !=p0: p0: <=p0: >=p0: +==i: !=i: i: <=i: >=i: r,r,label; + r,M,label; + M,r,label; + M,M,label; + +==d: !=d: d: <=d: >=d: f,f,label; M,f,label; + + +macros + ++i: .OR: +p0: +d: *d: + + (r|f,,): " #O #S,#F" + (M,,): " #O #F,#S" + +-i: -p0: -p0p0: sb: ^: *i: -d: /d: + + " #O #S,#F" +/i: %: + +" tst #F + sxt #F-1 + #O #S,#F-1" + +&: + +(r,,): +" mov #S,-(sp) + com (sp) + bic (sp)+,#F" + +(M,,): +" mov #F,-(sp) + com (sp) + bic (sp)+,#S" + +<<: " ash #S,#F" +>>: +(,intlit,): " ash \#-#6.,#F" +(,~intlit,): +" mov #S,-(sp) + neg (sp) + ash (sp)+,#F" + +=+i: ++bp0: " add #S,#F" +=-i: --bp0: " sub #S,#F" +=OR: " bis #S,#F" +=^: " xor #S,#F" +=&: + +" mov #S,-(sp) + com (sp) + bic (sp)+,#F" + +.BNOT: -ui: -ud: + + " #O #R" + +&u0: +(auto,,): +" mov sp,#R + add \##4.,#R" +(ext|stat|label|stringlit,,): +" mov \##F,#R" +(param,,): +" mov r4,#R + add \##4.,#R" + +++ai: + +" mov #F,#R + inc #F" + +++ac: + +" movb #F,#R + incb #F" + +--ai: + +" mov #F,#R + dec #F" + +--ac: + +" movb #F,#R + decb #F" + +++ap0: + +" mov #F,#R + add #S,#F" + +--ap0: + +" mov #F,#R + sub #S,#F" + +++bi: " inc #R" +--bi: " dec #R" +++bc: " incb #R" +--bc: " decb #R" + +.ic: +.ip0: .p0i: +.df: .fd: "\" + +.ci: " bic \#177400,#R" + +.cf: .cd: + +" bic \#177400,#F + ldcid #F,#R" + +.if: .id: " ldcid #F,#R" +.fi: .di: +.fc: .dc: " stcdi #F,#R" + +==i: !=i: i: <=i: >=i: + +" cmp #F,#S + %bc(#'O) .+6 + jmp #R" + +==d: !=d: d: <=d: >=d: + +" cmpd #F,#S + %bc(#'O) .+6 + jmp #R" + +==p0: !=p0: p0: <=p0: >=p0: + +" cmp #F,#S + %ubc(#'O) .+6 + jmp #R" + +.cc: " movb #F,#R" +.ii: .p0p0: " mov #F,#R" +.ff: + + (f,,f): " ldd #F,#R" + (M,,f): " ldcfd #F,#R" + (f,,M): " stcdf #F,#R" + +.dd: + + (,,f): " ldd #F,#R" + (,,M): " std #F,#R" + +in: " #0." +ad0: " #R" +c: " .byte #0." +ca: + +" jsr r5,#F + #1. + #0." + +end: ".end" +en: ex: ".globl #0" +ep: + +" jmp epilog +fs#0=#1." + +eq: "#0:" +go: " jmp #R" +hd: + +".title %pname() +.insrt c;c11 insert +" + +ln: "\n; line #0\n" +p: + +" +%i(#1): jsr r0,prolog + fs#0" + +rt: " jmp epilog" +st: "i#0:" +z: " .blkb #0." + +f: d: " %ff(#0)" +nf: nd: " -%ff(#0)" + +ts: +"%if(#0,%sb(68,#'F,#'F,-6,#0) +,) tst #F + bge .+6 + jmp #R + cmp #F,\#<#5.-#0.> + bgt .+8. + asl #F + jmp @<.+8.>(#F) + jmp #R" + +ls: +" mov \##0.,r1 + mov \#.+18.,r3 + cmp #F,(r3)+ + bne .+6 + jmp @2*#0.-2(r3) + sob r1,.-8. + jmp #R" + +lc: " l#0" +l: "l#0:" +sc: " s#0" +pu: pd: ".text" +da: ".data" +im: ".bss" + \ No newline at end of file diff --git a/c20/gt/pdp20.gt b/c20/gt/pdp20.gt new file mode 100644 index 00000000..093978dc --- /dev/null +++ b/c20/gt/pdp20.gt @@ -0,0 +1,234 @@ +typenames (char, int, float, double); +regnames (a, c, d, b); +memnames (reg, auto, ext, stat, param, label, intlit, floatlit, + stringlit, ia, ic, id, ib); +size 1 (char, int, float, double); +align 1(char, int, float, double); +class r (a, b, c, d); +saveareasize 1; +pointer p0 (1); +offsetrange p0 (,); +returnreg a (int, double, p0); +type char(r), int(r), float(r), double(r), p0(r); + +.sw: a|c|d,,1[b]; +.argi: .argd: .arg0: r,,1; M,,1; + ++i: *i: &: ^: .OR: +p0: ++d: *d: r,r,1; r,M,1; M,r,2; + +-i: -p0: -p0p0: -d: /d: r,r,1; r,M,1; + +/i: a,r,1[b]; b,r,1[c]; c,r,1[d]; + a,M,1[b]; b,M,1[c]; c,M,1[d]; + +%: a,r,b; b,r,c; c,r,d; + a,M,b; b,M,c; c,M,d; + +<<: >>: r,r,1; r,intlit,1; + +=+i: =*i: =&: =^: =OR: +=+d: =*d: M,r,1; M,r,2; + +.BNOT: -ui: -ud: r,,1; M,,r; + +&u0: +++ai: ++ac: --ai: --ac: M,,r; + +++ap0: --ap0: M,b,a|c|d; M,d,b; + +++bi: ++bc: +--bi: --bc: M,,r; M,,1; + +++bp0: --bp0: M,r,2; + +.ic: .ci: .ip0: .p0i: .df: .fd: +.cf: .cd: .if: .id: r,,1; + +.fc: .dc: .fi: .di: a,,b; + +==p0: !=p0: p0: <=p0: >=p0: +==i: !=i: i: <=i: >=i: +==d: !=d: d: <=d: >=d: r,r,label; r,M,label; + +==0p0: !=0p0: r,,label; M,,label; + + + + +macros + ++i: *i: &: ^: .OR: +p0: + + (r,r,): " #O #F,#S" + (M,,): " #O #S,#F" + (r,~intlit,): " #O #F,#S" + (r,intlit,): " #O%ifm(#'S,I #F\,#6, #F\,#S)" + +-i: /i: %: -p0: sb: + + (,r,): " #O #F,#S" + (,~intlit,): " #O #F,#S" + (,intlit,): " #O%ifm(#'S,I #F\,#6, #F\,#S)" + ++d: *d: + + (r,,): " #O #F,#S" + (M,,): " #O #S,#F" + +-d: /d: -p0p0: + + " #O #F,#S" + +<<: + (,intlit,): " LSH #R,#6" + (,r,): " LSH #R,(#S)" +>>: + (,intlit,): " LSH #R,-#6" + (,r,): " MOVN #S,#S\n LSH #R,(#S)" + +=+i: " ADDB #S,#F" +=*i: " IMULB #S,#F" +=&: " ANDB #S,#F" +=^: " XORB #S,#F" +=OR: " IORB #S,#F" +=+d: " FADRB #S,#F" +=*d: " FMPRB #S,#F" + +&u0: " MOVEI #R,#F" +++ai: ++ac: " MOVE #R,#F\n AOS #F" +--ai: --ac: " MOVE #R,#F\n SOS #F" +++bi: ++bc: + (,,r): " MOVEI #R,1\n ADDB #R,#F" + (,,M): " AOS #F" +--bi: --bc: + (,,r): " SETO #R,\n ADDB #R,#F" + (,,M): " SOS #F" +++ap0: " MOVE #R,#F\n ADDM #S,#F" +--ap0: " MOVE #R,#F\n MOVN #S,#S\n ADDM #S,#F" +++bp0: " ADDB #S,#F" +--bp0: " MOVN #S,#S\n ADDB #S,#F" +.BNOT: + (r,,): " SETCA #R," + (M,,): " SETCM #R,#F" +-ui: -ud: " MOVN #R,#F" + +==p0: " CAMN #F,#S\n GO #R" +!=p0: " CAME #F,#S\n GO #R" +p0: " CAMLE #F,#S\n GO #R" +<=p0: " CAMG #F,#S\n GO #R" +>=p0: " CAML #F,#S\n GO #R" + +==i: "%ifm(#'S,%if(#6,\tCAIN\t#F\,#6\n\tGO\t#R,\tJUMPE\t#F\,#R),\tCAMN\t#F\,#S\n\tGO\t#R)" +!=i: "%ifm(#'S,%if(#6,\tCAIE\t#F\,#6\n\tGO\t#R,\tJUMPN\t#F\,#R),\tCAME\t#F\,#S\n\tGO\t#R)" +i: "%ifm(#'S,%if(#6,\tCAILE\t#F\,#6\n\tGO\t#R,\tJUMPG\t#F\,#R),\tCAMLE\t#F\,#S\n\tGO\t#R)" +<=i: "%ifm(#'S,%if(#6,\tCAIG\t#F\,#6\n\tGO\t#R,\tJUMPLE\t#F\,#R),\tCAMG\t#F\,#S\n\tGO\t#R)" +>=i: "%ifm(#'S,%if(#6,\tCAIL\t#F\,#6\n\tGO\t#R,\tJUMPGE\t#F\,#R),\tCAML\t#F\,#S\n\tGO\t#R)" + +==d: " FSBR #F,#S\n JUMPE #F,#R" +!=d: " FSBR #F,#S\n JUMPN #F,#R" +d: " FSBR #F,#S\n JUMPG #F,#R" +<=d: " FSBR #F,#S\n JUMPLE #F,#R" +>=d: " FSBR #F,#S\n JUMPGE #F,#R" + +==0p0: + (M,,): " SKIPN #F\n GO #R" + (r,,): " JUMPE #F,#R" +!=0p0: + (M,,): " SKIPE #F\n GO #R" + (r,,): " JUMPN #F,#R" + +.cc: .ii: +.ff: .dd: +.p0p0: + (r,,r): " MOVE #R,#F" + (r,,M): " MOVEM #F,#R" + (~intlit,,r): " MOVE #R,#F" + (intlit,,r): " %ifm(#'F,MOVEI\t#R\,#4,%ifm(#3,-#4,MOVNI\t#R\,-#4,MOVE\t#R\,#F))" + +.if: .id: +.cf: .cd: " FSC #R,155" +.di: .dc: +.fi: .fc: " JSP 0,FIXIFY""" +.ic: .ci: +.ip0: .p0i: +.df: .fd: "\" + +.argi: +.argd: +.arg0: " PPUSH #F" + +in: c: " #0" +ad0: " #R" + +al: "\" +ca: " CCALL #0,#F" + +end: +".PDATA +CONSTANTS +END" + +en: " ENTRY #0" +ex: " EXTERN #0" +eq: "#0:" +go: " GO #R" +hd: + +" TITLE %pname() + RADIX 10. +.INSRT NC +" + +ln: "\n; LINE #0\n" +p: + +"%setfno(#0) +\%A==#2 + \%A,,[ASCIZ/%m(#1)/] +%i(#1): ADDI P,FS#0" + +rt: +" SUBI P,FS#0+\%A+1 + GO @<\%A+1>(P)" +ep: +" SUBI P,FS#0+\%A+1 + GO @<\%A+1>(P) +FS#0==#1-1" + +st: "I#0:" +z: " BLOCK #0" + +f: d: " %ff(#0)" +nf: nd: " -%ff(#0)" + +ts: +"%if(#0,%sb(68,#'F,#'F,-6,#0) +,) JUMPL #F,#R + CAILE #F,#5-#0 + GO #R + GO @(#F)[" + +ets: " ]" + +ls: +" MOVE B,[-#0,,[" + +els: +" ]] + CAMN #F,(B) + GO @#0(B) + AOBJN B,.-2 + GO #R" + +lc: " L#0" +l: "L#0:" +sc: " S#0" +pu: ".CODE" +pd: ".PDATA" +im: ".UDATA" +da: ".IDATA" + \ No newline at end of file diff --git a/c20/gt/unix.gt b/c20/gt/unix.gt new file mode 100644 index 00000000..7f91df92 --- /dev/null +++ b/c20/gt/unix.gt @@ -0,0 +1,340 @@ +typenames (char, int, float, double); +regnames (r0, r2, r3, r1, fr0, fr1, fr2, fr3); +memnames (reg, auto, ext, stat, param, label, intlit, floatlit, + stringlit, ir0, ir2, ir3, ir1); +size 1 (char), 2 (int), 4 (float), 8 (double); +align 1 (char), 2 (int, float, double); +class r (r0, r1, r2, r3), f (fr0, fr1, fr2, fr3); +saveareasize 0; +pointer p0 (1); +offsetrange p0 (,); +returnreg r0 (int, p0), fr0 (double); +type char(r), int(r), float(f), double(f), p0(r); + +.sw: r0|r2,,1[r1,r3]; + ++i: &: .OR: +p0: r,r,1; r,M,1; M,r,2; + +-i: -p0: -p0p0: <<: >>: r,r,1; r,M,1; + +*i: r1,r,r1; + r3,r,r3; + r1,M,r1; + r3,M,r3; + r0,r,r1[r0]; + r2,r,r3[r2]; + r0,M,r1[r0]; + r2,M,r3[r2]; + +/i: r1,r2|r3,r0[r1]; + r3,r0|r1,r2[r3]; + r1,M,r0[r1]; + r3,M,r2[r3]; + +%: r1,r2|r3,r1[r0]; + r3,r0|r1,r3[r2]; + r1,M,r1[r0]; + r3,M,r3[r1]; + +^: r,r,1; + ++d: *d: f,f,1; f,~floatlit,1; ~floatlit,f,2; + +-d: /d: f,f,1; f,~floatlit,1; + +=+i: =-i: =&: =OR: +++bp0: --bp0: M,r,1; M,M,1; + +=^: M,r,1; + +.BNOT: -ui: r,,1; + +-ud: f,,1; + +&u0: M,,r; + +++ai: ++ac: --ai: --ac: M,,r; + +++ap0: --ap0: M,r,r; M,M,r; + +++bi: ++bc: +--bi: --bc: M,,1; + +.ic: .ci: .ip0: .p0i: r,,1; + +.df: .fd: f,,1; + +.cf: .cd: r,,f; +.if: .id: r,,f; M,,f; +.fc: .dc: .fi: .di: f,,r; + +==p0: !=p0: p0: <=p0: >=p0: +==i: !=i: i: <=i: >=i: r,r,label; + r,M,label; + M,r,label; + M,M,label; + +==d: !=d: d: <=d: >=d: f,f,label; ~floatlit,f,label; + +macros + ++i: .OR: +p0: +d: *d: + + (r|f,,): " #O #S,#F" + (M,,): " #O #F,#S" + +-i: -p0: -p0p0: sb: ^: *i: -d: /d: + + " #O #S,#F" +/i: %: + +" tst #F + sxt #F-1 + #O #S,#F-1" + +&: + +(r,,): +" mov #S,-(sp) + com (sp) + bic (sp)+,#F" + +(M,,): +" mov #F,-(sp) + com (sp) + bic (sp)+,#S" + +<<: " ash #S,#F" +>>: +(,intlit,): " ash $-#6.,#F" +(,~intlit,): +" mov #S,-(sp) + neg (sp) + ash +(sp),#F" + +=+i: ++bp0: " add #S,#F" +=-i: --bp0: " sub #S,#F" +=OR: " bis #S,#F" +=^: " xor #S,#F" +=&: + +" mov #S,-(sp) + com (sp) + bic (sp)+,#F" + +.BNOT: -ui: -ud: + + " #O #R" + +&u0: +(auto,,): +" mov sp,#R + add $#4.,#R" +(ext|stat|label|stringlit,,): +" mov $#F,#R" +(param,,): +" mov r4,#R + add $#4.,#R" + +++ai: + +" mov #F,#R + inc #F" + +++ac: + +" movb #F,#R + incb #F" + +--ai: + +" mov #F,#R + dec #F" + +--ac: + +" movb #F,#R + decb #F" + +++ap0: + +" mov #F,#R + add #S,#F" + +--ap0: + +" mov #F,#R + sub #S,#F" + +++bi: " inc #R" +--bi: " dec #R" +++bc: " incb #R" +--bc: " decb #R" + +.ic: +.ip0: .p0i: +.df: .fd: "\" + +.ci: " bic $177400,#R" + +.cf: .cd: + +" bic $177400,#F + movif #F,#R" + +.if: .id: " movif #F,#R" +.fi: .di: +.fc: .dc: " movfi #F,#R" + +==i: +==p0: + +" cmp #F,#S + jeq #R" + +!=i: +!=p0: + +" cmp #F,#S + jne #R" + +i: + +" cmp #F,#S + jgt #R" + +<=i: + +" cmp #F,#S + jle #R" + +>=i: + +" cmp #F,#S + jge #R" + +==d: + +" cmpf #F,#S + jeq #R" + +!=d: + +" cmpf #F,#S + jne #R" + +d: + +" cmpf #F,#S + jgt #R" + +<=d: + +" cmpf #F,#S + jle #R" + +>=d: + +" cmpf #F,#S + jge #R" + +p0: + +" cmp #F,#S + jhi #R" + +<=p0: + +" cmp #F,#S + jlos #R" + +>=p0: + +" cmp #F,#S + jhis #R" + +.cc: " movb #F,#R" +.ii: .p0p0: " mov #F,#R" +.ff: + + (f,,f): " movf #F,#R" + (M,,f): " movof #F,#R" + (f,,M): " movfo #F,#R" + +.dd: + +(~floatlit,,f): " movf #F,#R" +(,,M): " movf #F,#R" +(floatlit,,f): +" movf 0f,#R +.data +0: %ff(#4) +.text" + +in: " #0." +ad0: " #0" +c: " .byte #0." +al: ".even" +ca: " jsr r5,#F; #1.; #0." + +end: "\" +en: ex: ".globl #0" +ep: + +" jmp epilog +fs#0=#1." + +eq: "#0:" +go: " jbr #R" +hd: ".globl prolog,epilog" + +ln: "\n/ line #0\n" +p: "\n%i(#1): jsr r0,prolog; fs#0" + +rt: " jmp epilog" +st: "i#0:" +z: ".=.+#0." + +f: d: " %ff(#0)" +nf: nd: " %nff(#0)" + +ts: +"%if(#0,%sb(68,#'F,#'F,-6,#0) +,) cmp #F,$#5.-[#0.] + jhi #R + asl #F + jmp *0f(#F) +0:" + +ls: +" mov $#0.,r1 + mov $0f,r3 +2: cmp #F,(r3)+ + beq 1f + sob r1,2b + jbr #R +1: jmp *2*#0.-2(r3) +0:" + +lc: " l#0" +l: "l#0:" +sc: " s#0" +pu: pd: ".text" +da: ".data" +im: ".bss" + \ No newline at end of file diff --git a/c20/lex.h b/c20/lex.h new file mode 100644 index 00000000..b6c96a24 --- /dev/null +++ b/c20/lex.h @@ -0,0 +1,51 @@ + +/* + * lex library header file -- accessed through + * #include + */ + +/* + * description of scanning + * tables. + * the entries at the front of + * the struct must remain in + * place for the assembler routines + * to find. + */ +struct lextab { + int llendst; /* Last state number */ + char *lldefault; /* Default state table */ + char *llnext; /* Next state table */ + char *llcheck; /* Check table */ + int *llbase; /* Base table */ + int llnxtmax; /* Last in base table */ + + int (*llmove)(); /* Move between states */ + int *llfinal; /* Final state descriptions */ + int (*llactr)(); /* Action routine */ + int *lllook; /* Look ahead vector if != NULL */ + char *llign; /* Ignore char vec if != NULL */ + char *llbrk; /* Break char vec if != NULL */ + char *llill; /* Illegal char vec if != NULL */ +}; + +extern struct lextab *_tabp; + +/* extern FILE *lexin; */ /* scanner input file */ + +/*PLB #define lexval yylval */ +#define LEXERR 256 +#define LEXSKIP (-1) +/* + * #define LEXECHO(fp) {lexecho((fp));} + */ +extern int lexval; +extern int yyline; + +extern char llbuf[]; +extern char *llend; +#define lextext llbuf +#define lexlast llend + +#define _lmovb _lmvb +#define _lmovi _lmvi diff --git a/c20/lex/base.c b/c20/lex/base.c new file mode 100644 index 00000000..223c93ed --- /dev/null +++ b/c20/lex/base.c @@ -0,0 +1,250 @@ +/* + * Copyright (c) 1978 Charles H. Forsyth + * + * Modified 02-Dec-80 Bob Denny -- Conditionalize debug code to reduce size + * More 29-May-81 Bob Denny -- RSX overlaying + * More 19-Mar-82 Bob Denny -- New C library & compiler + * More 28-Aug-82 Bob Denny -- Reference "a" to shut up compiler + */ + +/* + * lex -- find and set base values for `move' vector + */ +#include +#include "lexlex.h" + +extern struct set *chase(); + +/* + * Choose the best default + * state for `st'. + * Only states previous to the + * current state are considered, + * as these are guaranteed to + * exist. + */ +struct dfa * +defalt(st, xsep) +struct dfa *st; +struct xset **xsep; +{ + register struct dfa *dp; + register unsigned minv, u; + struct dfa *def; + struct xset *xse; + int i; + + xse = *xsep; + if ((i = xse-sets)==0) + return(NULL); +#ifdef DEBUG + if (lldebug>1) + fprintf(stderr, "State %d, default:\n", st-dfa); +#endif + minv = -1; + def = NULL; + for (dp = dfa; dp < st; dp++) { + u = compat(st, dp, xse); +#ifdef DEBUG + if (lldebug > 1) + fprintf(stderr, "\t%d rates %d\n", dp-dfa, u); +#endif + if (u < minv) { + def = dp; + minv = u; + } + } + if (minv == -1 || 10*(i-(int)minv) < i) + def = NULL; +#ifdef DEBUG + if (lldebug>1 && def) + fprintf(stderr, "\t%d chosen\n", def-dfa); +#endif + if (def) + resolve(st, def, xsep); + return(def); +} + +/* + * State `b' is compatible with, + * and hence a suitable default state + * for state `a', + * if its transitions agree with + * those of `a', except those for + * which `a' has transitions to the + * (alleged) default. + * Circularity of the default + * relation is also not allowed. + * If the state `b' has at least + * twice as many transitions as `a', + * it is not even worth considering. + */ +compat(a, b, xse) +struct dfa *a, *b; +struct xset *xse; +{ + register struct dfa *dp; + struct xset *xs; + register nt; + + if (a==b || b->df_ntrans >= a->df_ntrans*2) + return(-1); + for (dp = b; dp; dp = dp->df_default) + if (dp == a) + return(-1); + nt = b->df_ntrans + a->df_ntrans; + for (xs = sets; xs < xse; xs++) + if (chase(b, xs->x_char) == xs->x_set) + nt -= 2; + return(nt); +} + +struct set * +chase(st, c) +register struct dfa *st; +register c; +{ + register struct move *dp; + + c &= 0377; + while ((dp = st->df_base) != NULL && + ((dp += c) >= st->df_max || dp->m_check != st)) + if ((st = st->df_default) == NULL) + return(NULL); + if (dp) + dp = dp->m_next; + return(dp); +} + +/* + * set `sets' to indicate those + * characters on which the state `a' + * and its default agree and + * those characters on which `a' + * should go to `error' (as the default + * accepts it, but `a' does not). + */ +resolve(a, def, xsep) +struct dfa *a, *def; +struct xset **xsep; +{ + register struct move *dp; + register c, i; + struct xset *xs, *xse; + + a = a; /* Quiet compiler the easy way */ + + xse = *xsep; + i = xse-sets; + for (xs = sets; xs < xse; xs++) + xs->x_defsame = 0; + for (; def; def = def->df_default) + for (dp = def->df_base; dp < def->df_max; dp++) + if (dp->m_check == def) { + c = dp - def->df_base; + for (xs = sets; xs < xse; xs++) + if (c==(xs->x_char&0377)) { + if (xs->x_set==dp->m_next) { + xs->x_defsame++; + i--; + } + break; + } + if (xs >= xse) { + xs->x_defsame = 0; + xs->x_char = c; + xs->x_set = NULL; + i++; + xse++; + } + } + *xsep = xse; + return(i); +} + +/* + * Choose a base in `move' + * for the current state. + * The transitions of that + * state are in the vector + * `sets'. + */ +struct move * +stbase(xse) +struct xset *xse; +{ + register a; + register struct move *base; + register conflicts; + struct xset *xs; + + if (xse==sets) + return(NULL); + base = move; + do { + if (base-move >= NNEXT) { + error("No space in `move' (stbase)"); +#ifdef DEBUG + if (lldebug>1) + dfaprint(); +#endif + exit(1); + } + conflicts = 0; + for (xs = sets; xs < xse; xs++) { + a = xs->x_char&0377; + if (xs->x_defsame==0 && + (base+a>=move+NNEXT || base[a].m_check!=NULL)) { + conflicts++; + base++; + break; + } + } + } while (conflicts); + return(base); +} + +/* + * Given a state, + * its `base' value in `move', + * and the set of transitions in + * `sets' (ending near `xse'), + * set the `move' values. + */ +setbase(st, base, xse) +struct dfa *st; +register struct move *base; +struct xset *xse; +{ + register struct move *dp; + register struct xset *xs; + struct move *maxdp; + + st->df_base = base; + st->df_max = base; +#ifdef DEBUG + if (lldebug>1) + fprintf(stderr, "Setbase: state %d\n", st-dfa); + if (lldebug>1 && base==0) + fprintf(stderr, "\tno base\n"); +#endif + if (base==NULL) + return; + maxdp = base; + for (xs = sets; xs < xse; xs++) + if (xs->x_defsame==0) { + dp = base + (xs->x_char&0377); + if (dp > maxdp) + maxdp = dp; + dp->m_next = xs->x_set; + dp->m_check = st; + if (dp-move > llnxtmax) + llnxtmax = dp-move; +#ifdef DEBUG + if (lldebug>1) + fprintf(stderr, "\t%c nets %d\n", + xs->x_char&0377, dp-move); +#endif + } + st->df_max = maxdp+1; +} diff --git a/c20/lex/base.old b/c20/lex/base.old new file mode 100644 index 00000000..223c93ed --- /dev/null +++ b/c20/lex/base.old @@ -0,0 +1,250 @@ +/* + * Copyright (c) 1978 Charles H. Forsyth + * + * Modified 02-Dec-80 Bob Denny -- Conditionalize debug code to reduce size + * More 29-May-81 Bob Denny -- RSX overlaying + * More 19-Mar-82 Bob Denny -- New C library & compiler + * More 28-Aug-82 Bob Denny -- Reference "a" to shut up compiler + */ + +/* + * lex -- find and set base values for `move' vector + */ +#include +#include "lexlex.h" + +extern struct set *chase(); + +/* + * Choose the best default + * state for `st'. + * Only states previous to the + * current state are considered, + * as these are guaranteed to + * exist. + */ +struct dfa * +defalt(st, xsep) +struct dfa *st; +struct xset **xsep; +{ + register struct dfa *dp; + register unsigned minv, u; + struct dfa *def; + struct xset *xse; + int i; + + xse = *xsep; + if ((i = xse-sets)==0) + return(NULL); +#ifdef DEBUG + if (lldebug>1) + fprintf(stderr, "State %d, default:\n", st-dfa); +#endif + minv = -1; + def = NULL; + for (dp = dfa; dp < st; dp++) { + u = compat(st, dp, xse); +#ifdef DEBUG + if (lldebug > 1) + fprintf(stderr, "\t%d rates %d\n", dp-dfa, u); +#endif + if (u < minv) { + def = dp; + minv = u; + } + } + if (minv == -1 || 10*(i-(int)minv) < i) + def = NULL; +#ifdef DEBUG + if (lldebug>1 && def) + fprintf(stderr, "\t%d chosen\n", def-dfa); +#endif + if (def) + resolve(st, def, xsep); + return(def); +} + +/* + * State `b' is compatible with, + * and hence a suitable default state + * for state `a', + * if its transitions agree with + * those of `a', except those for + * which `a' has transitions to the + * (alleged) default. + * Circularity of the default + * relation is also not allowed. + * If the state `b' has at least + * twice as many transitions as `a', + * it is not even worth considering. + */ +compat(a, b, xse) +struct dfa *a, *b; +struct xset *xse; +{ + register struct dfa *dp; + struct xset *xs; + register nt; + + if (a==b || b->df_ntrans >= a->df_ntrans*2) + return(-1); + for (dp = b; dp; dp = dp->df_default) + if (dp == a) + return(-1); + nt = b->df_ntrans + a->df_ntrans; + for (xs = sets; xs < xse; xs++) + if (chase(b, xs->x_char) == xs->x_set) + nt -= 2; + return(nt); +} + +struct set * +chase(st, c) +register struct dfa *st; +register c; +{ + register struct move *dp; + + c &= 0377; + while ((dp = st->df_base) != NULL && + ((dp += c) >= st->df_max || dp->m_check != st)) + if ((st = st->df_default) == NULL) + return(NULL); + if (dp) + dp = dp->m_next; + return(dp); +} + +/* + * set `sets' to indicate those + * characters on which the state `a' + * and its default agree and + * those characters on which `a' + * should go to `error' (as the default + * accepts it, but `a' does not). + */ +resolve(a, def, xsep) +struct dfa *a, *def; +struct xset **xsep; +{ + register struct move *dp; + register c, i; + struct xset *xs, *xse; + + a = a; /* Quiet compiler the easy way */ + + xse = *xsep; + i = xse-sets; + for (xs = sets; xs < xse; xs++) + xs->x_defsame = 0; + for (; def; def = def->df_default) + for (dp = def->df_base; dp < def->df_max; dp++) + if (dp->m_check == def) { + c = dp - def->df_base; + for (xs = sets; xs < xse; xs++) + if (c==(xs->x_char&0377)) { + if (xs->x_set==dp->m_next) { + xs->x_defsame++; + i--; + } + break; + } + if (xs >= xse) { + xs->x_defsame = 0; + xs->x_char = c; + xs->x_set = NULL; + i++; + xse++; + } + } + *xsep = xse; + return(i); +} + +/* + * Choose a base in `move' + * for the current state. + * The transitions of that + * state are in the vector + * `sets'. + */ +struct move * +stbase(xse) +struct xset *xse; +{ + register a; + register struct move *base; + register conflicts; + struct xset *xs; + + if (xse==sets) + return(NULL); + base = move; + do { + if (base-move >= NNEXT) { + error("No space in `move' (stbase)"); +#ifdef DEBUG + if (lldebug>1) + dfaprint(); +#endif + exit(1); + } + conflicts = 0; + for (xs = sets; xs < xse; xs++) { + a = xs->x_char&0377; + if (xs->x_defsame==0 && + (base+a>=move+NNEXT || base[a].m_check!=NULL)) { + conflicts++; + base++; + break; + } + } + } while (conflicts); + return(base); +} + +/* + * Given a state, + * its `base' value in `move', + * and the set of transitions in + * `sets' (ending near `xse'), + * set the `move' values. + */ +setbase(st, base, xse) +struct dfa *st; +register struct move *base; +struct xset *xse; +{ + register struct move *dp; + register struct xset *xs; + struct move *maxdp; + + st->df_base = base; + st->df_max = base; +#ifdef DEBUG + if (lldebug>1) + fprintf(stderr, "Setbase: state %d\n", st-dfa); + if (lldebug>1 && base==0) + fprintf(stderr, "\tno base\n"); +#endif + if (base==NULL) + return; + maxdp = base; + for (xs = sets; xs < xse; xs++) + if (xs->x_defsame==0) { + dp = base + (xs->x_char&0377); + if (dp > maxdp) + maxdp = dp; + dp->m_next = xs->x_set; + dp->m_check = st; + if (dp-move > llnxtmax) + llnxtmax = dp-move; +#ifdef DEBUG + if (lldebug>1) + fprintf(stderr, "\t%c nets %d\n", + xs->x_char&0377, dp-move); +#endif + } + st->df_max = maxdp+1; +} diff --git a/c20/lex/bcpl.lxi b/c20/lex/bcpl.lxi new file mode 100644 index 00000000..bf11dca3 --- /dev/null +++ b/c20/lex/bcpl.lxi @@ -0,0 +1,149 @@ +/* + * bcpl syntax + */ +digit = [0-9]; +letter = [a-zA-Z_]; +name = letter (letter|digit)*; +integer = [123456789]digit*; +hexdigit = [0-9a-fA-F]; +octal = #[0-7][0-7]*; +hex = #[xX]hexdigit*; +realdigits = integer "." [0-9]* +| "." [0-9][0-9]* +; +real = realdigits ("e" ([+-]|"") integer | ""); +any = [\n\t \014]; +illegal = [^a-zA-Z\n\t \014#+-*/^%0-9~!=<>:'"&|()[\]{}`@?,.]; +%% +AND {return(AND);} +BE {return(BE);} +BREAK {return(BREAK);} +BY {return(BY);} +CASE {return(CASE);} +DO {return(DO);} +DEFAULT {return(DEFAULT);} +EQ {return('=');} +EQV {return(EQV);} +ELSE {return(OR);} +ENDCASE {return(ENDCASE);} +FALSE {return(FALSE);} +FOR {return(FOR);} +FINISH {return(FINISH);} +GOTO {return(GOTO);} +GE {return(GE);} +GR {return('>');} +GLOBAL {return(GLOBAL);} +GET {return(GET);} +IF {return(IF);} +INTO {return(INTO);} +LET {return(LET);} +LV {return('@');} +LE {return(LE);} +LS {return('<');} +LOGOR {return('|');} +LOGAND {return('&');} +LOOP {return(LOOP);} +LSHIFT {return(LSHIFT);} +MANIFEST {return(MANIFEST);} +NE {return(NE);} +NOT {return('~');} +NEQV {return(NEQV);} +OR {return(OR);} +RESULTIS {return(RESULTIS);} +RETURN {return(RETURN);} +REM {return(REM);} +RSHIFT {return(RSHIFT);} +RV {return('!');} +REPEAT {return(REPEAT);} +REPEATWHILE {return(REPEATWHILE);} +REPEATUNTIL {return(REPEATUNTIL);} +SWITCHON {return(SWITCHON);} +STATIC {return(STATIC);} +TO {return(TO);} +TEST {return(TEST);} +TRUE {return(TRUE);} +THEN {return(THEN);} +TABLE {return(TABLE);} +UNTIL {return(UNTIL);} +UNLESS {return(UNLESS);} +VEC {return(VEC);} +VALOF {return(VALOF);} +WHILE {return(WHILE);} + +name { + gettoken(token, sizeof token); + lexval = lookup(token, 0); + return(IDENTIFIER); + } +hex {return(number(16));} +octal {return(number(8));} +integer {return(number(10));} + +"<" {single: return(*token(0));} +">" {goto single;} +"%" {goto single;} +"/" {goto single;} +"*" {goto single;} +"&" {goto single;} +"|" {goto single;} +"^" {goto single;} +"+" {goto single;} +"-" {goto single;} +"!" {goto single;} +"@" {goto single;} +"~" {goto single;} +"(" {goto single;} +")" {goto single;} +"{" {goto single;} +"}" {goto single;} +":" {goto single;} +";" {goto single;} +"," {goto single;} + +":=" {return(GETS);} +"<=" {return(LE);} +"~=" {return(NE);} +">=" {return(GE);} +"<<" {return(LS);} +">>" {return(RS);} +"&&" {return('&');} +"||" {return('|');} +"$(" {return('{');} +"$)" {return('}');} +"->" {return(ARROW);} + +"+:=" {return(ASPLUS);} +"-:=" {return(ASMINUS);} +"/:=" {return(ASDIV);} +"REM:=" {return(ASMOD);} +"*:=" {return(ASTIMES);} +"<<:=" {return(ASLSHIFT);} +">>:=" {return(ASRSHIFT);} +"|:=" {return(ASOR);} +"&:=" {return(ASAND);} +"NEQV:=" {return(ASEXOR);} + +"/*" {comment("*/");} +"'" {;} +"\"" { + lexval = calloc(2, sizeof lexval); + string(lexval); + return(STRING); + } +any { + gettoken(token, sizeof token); + c = *token; + if (c=='\n') + yyline++; + } +%% + +number(radix) +{ + long l; + char digits[30]; + + gettoken(digits, sizeof digits); + l = integ(digits, radix); + return(l); +} diff --git a/c20/lex/btob.c b/c20/lex/btob.c new file mode 100644 index 00000000..0814b8f0 --- /dev/null +++ b/c20/lex/btob.c @@ -0,0 +1,170 @@ +# +#include +#include + +extern int _lmovb(); + +#line 4 "BTOB.LXI" + +struct maptab { + char *old; + char *new; +} maptab[] { + "=+", "+=", + "=-", "-=", + "=*", "*=", + "=%", "%=", + "=&", "&=", + "=|", "|=", + "=<<", "<<=", + "=>>", ">>=", + "=/", "/=", + "=^", "^=", + 0, +}; +struct maptab *mp; +char tbuf[10]; +char *token(); + +main() +{ + while (yylex()) + ; +} +_Alextab(__na__) { + switch (__na__) { + case 0: + +#line 33 "BTOB.LXI" + + gettoken(tbuf, sizeof tbuf); + for (mp = maptab; mp->old; mp++) + if (equal(tbuf, mp->old)) { + printf("%s", mp->new); + break; + } + if (mp->old==0) + fprintf(stderr, "error\n"); + return(1); + + break; + case 1: + +#line 44 "BTOB.LXI" + + relat: + gettoken(tbuf, sizeof tbuf); + printf(tbuf); + + break; + case 2: + +#line 49 "BTOB.LXI" +goto relat; + break; + case 3: + +#line 50 "BTOB.LXI" +printf("="); return(1); + break; + case 4: + +#line 51 "BTOB.LXI" +putchar(*token(NULL)); return(1); + break; + } + return(LEXSKIP); +} + +#line 52 "BTOB.LXI" + +int _Flextab[] { + -1, 4, 4, 1, 4, 0, 0, 0, 0, 0, 0, 2051, 0, 2051, 0, 2, + 0, 2, 0, -1, +}; + +#line 52 "BTOB.LXI" + +#define LLTYPE1 char + +LLTYPE1 _Nlextab[] { + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 4, 2, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 3, 8, 7, 11, 13, 16, 14, 12, 18, 10, 19, 9, 19, 19, 19, 19, + 19, 19, 19, 19, 19, 19, 19, 19, 17, 3, 15, 19, 19, 19, 19, 19, + 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, + 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 5, 19, 19, 19, 19, 19, + 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, + 19, 19, 19, 19, 19, 19, 19, 19, 6, +}; + +LLTYPE1 _Clextab[] { + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 2, 4, 4, 10, 12, 15, 4, 4, 17, 4, -1, 4, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 4, 4, 4, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 4, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 4, +}; + +LLTYPE1 _Dlextab[] { + 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, + 19, 19, 19, +}; + +int _Blextab[] { + 0, 0, 195, 0, 220, 0, 0, 0, 0, 0, 214, 0, 217, 0, 0, 199, + 0, 204, 0, 0, +}; +char *llsave[1]; + +int _Llextab[] { + 00, 00, 00, 00, 01, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, + 00, 00, 00, 0, +}; + +struct lextab lextab { + 19, /* last state */ + _Dlextab, /* defaults */ + _Nlextab, /* next */ + _Clextab, /* check */ + _Blextab, /* base */ + 344, /* last in base */ + _lmovb, /* byte-int move routines */ + _Flextab, /* final state descriptions */ + _Alextab, /* action routine */ + _Llextab, /* look-ahead vector */ + 0, /* no ignore class */ + 0, /* no break class */ + 0, /* no illegal class */ +}; diff --git a/c20/lex/btob.lxi b/c20/lex/btob.lxi new file mode 100644 index 00000000..e1e3c728 --- /dev/null +++ b/c20/lex/btob.lxi @@ -0,0 +1,51 @@ +/* + * btob -- convert old b operators to new b form + */ +%{ +struct maptab { + char *old; + char *new; +} maptab[] { + "=+", "+=", + "=-", "-=", + "=*", "*=", + "=%", "%=", + "=&", "&=", + "=|", "|=", + "=<<", "<<=", + "=>>", ">>=", + "=/", "/=", + "=^", "^=", + 0, +}; +struct maptab *mp; +char tbuf[10]; +char *token(); + +main() +{ + while (yylex()) + ; +} +%} +%% + +"=" (<< | >> | "*" | + | - | "/" | "%" | "&" | "|" | "^") { + gettoken(tbuf, sizeof tbuf); + for (mp = maptab; mp->old; mp++) + if (equal(tbuf, mp->old)) { + printf("%s", mp->new); + break; + } + if (mp->old==0) + fprintf(stderr, "error\n"); + return(1); +} +[<=>!]"=" { + relat: + gettoken(tbuf, sizeof tbuf); + printf(tbuf); +} +"="[<>] {goto relat;} +"=" / (++ | --) {printf("="); return(1);} +[\0-\377] {putchar(*token(NULL)); return(1);} diff --git a/c20/lex/cap.c b/c20/lex/cap.c new file mode 100644 index 00000000..00c1385c --- /dev/null +++ b/c20/lex/cap.c @@ -0,0 +1,177 @@ +#include +#ifdef vms +#include "c:lex.h" +#else +#include +#endif +extern int _lmovb(); + +#line 10 "cap.lxi" + +extern char *token(); + +main() +{ + while (yylex()) + ; +} +extern struct lextab cap; + +/* Standard I/O selected */ +extern FILE *lexin; + +llstin() + { + if(lexin == NULL) + lexin = stdin; + if(_tabp == NULL) + lexswitch(&cap); + } + +_Acap(__na__) /* Action routine */ + { + +#line 20 "cap.lxi" + + register char *cp; + char *et; + switch (__na__) { + case 0: + +#line 25 "cap.lxi" + + cp = token(&et); + while (cp < et) + putchar(*cp++); + + break; + case 1: + +#line 30 "cap.lxi" +putchar(token(0)[1]); + break; + case 2: + +#line 31 "cap.lxi" +putchar(*token(0)+'a'-'A'); + break; + case 3: + +#line 32 "cap.lxi" +putchar(*token(0)); + break; + } + return(LEXSKIP); +} + +#line 33 "cap.lxi" + + +int _Fcap[] = { + -1, 3, 2, 3, 1, 3, -1, 0, -1, -1, -1, -1, 3, -1, -1, -1, + -1, +}; + +#line 34 "cap.lxi" + +#define LLTYPE1 char + +LLTYPE1 _Ncap[] = { + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 5, 1, 1, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 12, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 5, + 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 6, 8, 14, 6, 15, 16, + 8, 8, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, + 9, 16, 11, 10, 16, 16, 16, 11, 16, 11, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 8, 16, 16, 16, 16, 8, 8, 16, 16, 16, 16, 16, + 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, + 16, 16, 16, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 6, 16, 16, + 6, 16, 16, 16, 16, 16, 16, 16, 6, 16, 16, 16, 16, 16, 16, 16, + 16, 16, 16, 10, 16, 8, 9, 16, 11, 16, 8, 8, 16, 11, 9, 11, + 11, 16, 16, 16, 16, 11, 16, 11, 16, 16, 16, 16, 16, 16, 16, 16, + 16, 16, 16, 16, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 13, 8, + 16, 16, 16, 16, 8, 8, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, + 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, +}; + +LLTYPE1 _Ccap[] = { + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, 3, 3, 5, 6, 13, 9, 14, -1, + 6, 6, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 5, -1, 5, 9, -1, -1, -1, 5, -1, 5, 6, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 8, -1, -1, -1, -1, 8, 8, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, + 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 10, -1, -1, + 11, -1, -1, -1, -1, -1, -1, -1, 12, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, 10, -1, 10, 11, -1, 11, -1, 10, 10, -1, 11, 12, 11, + 12, -1, -1, -1, -1, 12, -1, 12, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 12, 15, + -1, -1, -1, -1, 15, 15, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, +}; + +LLTYPE1 _Dcap[] = { + 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, 16, + +}; + +int _Bcap[] = { + 0, 0, 0, 191, 0, 272, 249, 0, 306, 275, 387, 390, 398, 204, 276, 445, + 0, +}; + +struct lextab cap = { + 16, /* last state */ + _Dcap, /* defaults */ + _Ncap, /* next */ + _Ccap, /* check */ + _Bcap, /* base */ + 535, /* last in base */ + _lmovb, /* byte-int move routines */ + _Fcap, /* final state descriptions */ + _Acap, /* action routine */ + NULL, /* look-ahead vector */ + 0, /* no ignore class */ + 0, /* no break class */ + 0, /* no illegal class */ +}; diff --git a/c20/lex/cap.lxi b/c20/lex/cap.lxi new file mode 100644 index 00000000..6c3f0897 --- /dev/null +++ b/c20/lex/cap.lxi @@ -0,0 +1,33 @@ +/* + * capitalise things + */ + +letter = [A-Z]; +open = ["'(]; +close = ["')]; +any = [\0-\377]; +eos = [.?!]; +%{ +extern char *token(); + +main() +{ + while (yylex()) + ; +} +%} +%% +%{ + register char *cp; + char *et; +%} + +(".PP\n"|eos close* " "* (" "|"\n"))open*letter { + cp = token(&et); + while (cp < et) + putchar(*cp++); + } +$letter {putchar(token(0)[1]);} +letter {putchar(*token(0)+'a'-'A');} +any {putchar(*token(0));} +%% diff --git a/c20/lex/cap.stinkr b/c20/lex/cap.stinkr new file mode 100644 index 00000000..b3fa4920 --- /dev/null +++ b/c20/lex/cap.stinkr @@ -0,0 +1,4 @@ +x clib:stdio +x lex:lexlib +l cap +o cap.exe diff --git a/c20/lex/clex.c b/c20/lex/clex.c new file mode 100644 index 00000000..e0189084 --- /dev/null +++ b/c20/lex/clex.c @@ -0,0 +1,539 @@ +#include +#include + +extern int _lmovb(); + +#line 4 "CLEX.LXI" + +extern char *install(); + +#line 11 "CLEX.LXI" + +main() +{ + register int i; + char buffer[80]; + extern char *token(); + + while (i = yylex()) { + gettoken(buffer, sizeof buffer); + printf("yylex returns %d, token = \"%s\"\n", + i, buffer); + if (i == LEXERR) { + error("LEXERR -- abort"); + break; + } + } +} +_Alextab(__na__) { + +#line 30 "CLEX.LXI" + + register int c; + switch (__na__) { + case 0: + +#line 33 "CLEX.LXI" + return(__na__); + break; + case 1: + +#line 34 "CLEX.LXI" + return(__na__); + break; + case 2: + +#line 35 "CLEX.LXI" + return(__na__); + break; + case 3: + +#line 36 "CLEX.LXI" + return(__na__); + break; + case 4: + +#line 37 "CLEX.LXI" + return(__na__); + break; + case 5: + +#line 38 "CLEX.LXI" + return(-1); + break; + case 6: + +#line 39 "CLEX.LXI" + return(__na__); + break; + case 7: + +#line 40 "CLEX.LXI" + return(__na__); + break; + case 8: + +#line 41 "CLEX.LXI" + return(__na__); + break; + case 9: + +#line 42 "CLEX.LXI" + return(__na__); + break; + case 10: + +#line 43 "CLEX.LXI" + return(__na__); + break; + case 11: + +#line 44 "CLEX.LXI" + return(__na__); + break; + case 12: + +#line 45 "CLEX.LXI" + return(__na__); + break; + case 13: + +#line 46 "CLEX.LXI" + return(__na__); + break; + case 14: + +#line 47 "CLEX.LXI" + return(__na__); + break; + case 15: + +#line 48 "CLEX.LXI" + return(__na__); + break; + case 16: + +#line 49 "CLEX.LXI" + return(__na__); + break; + case 17: + +#line 50 "CLEX.LXI" + return(__na__); + break; + case 18: + +#line 51 "CLEX.LXI" + return(__na__); + break; + case 19: + +#line 52 "CLEX.LXI" + return(__na__); + break; + case 20: + +#line 53 "CLEX.LXI" + return(__na__); + break; + case 21: + +#line 54 "CLEX.LXI" + return(__na__); + break; + case 22: + +#line 55 "CLEX.LXI" + return(__na__); + break; + case 23: + +#line 56 "CLEX.LXI" + return(__na__); + break; + case 24: + +#line 57 "CLEX.LXI" + return(__na__); + break; + case 25: + +#line 58 "CLEX.LXI" + + lexval = install(); + return(6); + + break; + case 26: + +#line 62 "CLEX.LXI" + + lexval = install(); + return(7); + + break; + case 27: + +#line 66 "CLEX.LXI" + return(__na__); + break; + case 28: + +#line 67 "CLEX.LXI" + return(__na__); + break; + case 29: + +#line 68 "CLEX.LXI" + return(__na__); + break; + case 30: + +#line 69 "CLEX.LXI" + return(__na__); + break; + case 31: + +#line 70 "CLEX.LXI" + return(__na__); + break; + case 32: + +#line 71 "CLEX.LXI" + return(__na__); + break; + case 33: + +#line 72 "CLEX.LXI" + return(__na__); + break; + case 34: + +#line 73 "CLEX.LXI" + return(__na__); + break; + case 35: + +#line 74 "CLEX.LXI" + return(__na__); + break; + case 36: + +#line 75 "CLEX.LXI" + return(__na__); + break; + case 37: + +#line 76 "CLEX.LXI" + return(__na__); + break; + case 38: + +#line 77 "CLEX.LXI" + return(__na__); + break; + case 39: + +#line 78 "CLEX.LXI" + return(__na__); + break; + case 40: + +#line 79 "CLEX.LXI" + return(__na__); + break; + case 41: + +#line 80 "CLEX.LXI" + return(__na__); + break; + case 42: + +#line 81 "CLEX.LXI" + return(__na__); + break; + case 43: + +#line 82 "CLEX.LXI" + return(__na__); + break; + case 44: + +#line 83 "CLEX.LXI" + return(__na__); + break; + case 45: + +#line 84 "CLEX.LXI" + return(__na__); + break; + case 46: + +#line 85 "CLEX.LXI" + return(__na__); + break; + case 47: + +#line 86 "CLEX.LXI" + return(__na__); + break; + case 48: + +#line 87 "CLEX.LXI" + return(__na__); + break; + case 49: + +#line 88 "CLEX.LXI" + return(__na__); + break; + case 50: + +#line 89 "CLEX.LXI" + return(__na__); + break; + case 51: + +#line 90 "CLEX.LXI" + return(__na__); + break; + case 52: + +#line 91 "CLEX.LXI" + return(__na__); + break; + case 53: + +#line 92 "CLEX.LXI" + return(__na__); + break; + case 54: + +#line 93 "CLEX.LXI" + return(__na__); + break; + case 55: + +#line 94 "CLEX.LXI" + return(__na__); + break; + case 56: + +#line 95 "CLEX.LXI" + return(__na__); + break; + case 57: + +#line 96 "CLEX.LXI" + + comment("*/"); + return(LEXSKIP); + + break; + case 58: + +#line 100 "CLEX.LXI" + + if ((c = mapch('\'', '\\')) != -1) + while (mapch('\'', '\\') != -1) + lexerror("Long character constant"); + printf("%c", c); + return(__na__); + + break; + case 59: + +#line 107 "CLEX.LXI" + return(__na__); + break; + case 60: + +#line 108 "CLEX.LXI" + return(__na__); + break; + case 61: + +#line 109 "CLEX.LXI" + return(__na__); + break; + case 62: + +#line 110 "CLEX.LXI" + return(__na__); + break; + case 63: + +#line 111 "CLEX.LXI" + return(__na__); + break; + case 64: + +#line 112 "CLEX.LXI" + return(__na__); + break; + case 65: + +#line 113 "CLEX.LXI" + return(__na__); + break; + case 66: + +#line 114 "CLEX.LXI" + return(__na__); + break; + case 67: + +#line 115 "CLEX.LXI" + return(__na__); + break; + case 68: + +#line 116 "CLEX.LXI" + return(__na__); + break; + case 69: + +#line 117 "CLEX.LXI" + return(__na__); + break; + case 70: + +#line 118 "CLEX.LXI" + return(__na__); + break; + } + return(LEXSKIP); +} + +#line 119 "CLEX.LXI" + +char * +install() +/* + * Install the current token in the symbol table + */ +{ + register char *buffer; /* Where to put the character */ + register char *first; /* -> first byte of the token */ + char *last; /* Can't be in a register */ + extern char *token(); + + first = token(&last); /* Find first/last of token */ + if ((buffer = alloc((last - first) + 1)) == NULL) { + error("Out of space in install"); + exit(1); + } + first = copy(buffer, first, (last - first)); + *first = '\0'; + return(buffer); +} + +int _Flextab[] { + -1, 70, 69, 68, 67, 66, 65, 62, 61, 60, 59, 58, 56, 55, 54, 53, + 50, 52, 49, 51, 46, 63, 45, 64, 41, 40, 57, 39, 32, 34, 31, -1, + 30, 29, 48, 47, -1, 44, -1, 43, 42, 38, 37, 36, 35, 27, 33, 28, + 26, 26, 25, 25, 25, 25, 25, 25, 25, 24, 25, 25, 25, 25, 25, 25, + 23, 25, 25, 21, 25, 25, 25, 25, 25, 25, 20, 19, 25, 25, 25, 25, + 17, 25, 25, 25, 25, 25, 25, 25, 18, 25, 25, 16, 25, 25, 25, 25, + 13, 25, 12, 25, 25, 25, 10, 25, 25, 25, 25, 25, 11, 25, 25, 25, + 25, 25, 9, 25, 25, 25, 14, 25, 25, 25, 25, 7, 25, 25, 25, 6, + 25, 25, 25, 25, 25, 22, 25, 25, 25, 25, 15, 25, 25, 25, 25, 8, + 25, 25, 25, 5, -1, -1, -1, -1, -1, -1, -1, 4, -1, -1, -1, 3, + -1, -1, -1, -1, 2, -1, -1, 1, -1, -1, -1, -1, -1, 0, -1, +}; + +#line 140 "CLEX.LXI" + +#define LLTYPE1 char + +LLTYPE1 _Nlextab[] { + 174, 174, 174, 174, 174, 174, 174, 174, 174, 7, 9, 174, 174, 174, 174, 174, + 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, + 8, 31, 10, 148, 50, 27, 22, 11, 6, 5, 24, 18, 12, 16, 13, 25, + 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 17, 15, 45, 33, 28, 14, + 19, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, + 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 4, 23, 3, 26, 50, + 32, 124, 76, 81, 68, 115, 65, 99, 50, 97, 50, 50, 50, 50, 50, 50, + 50, 50, 103, 128, 58, 53, 50, 92, 50, 50, 50, 2, 20, 1, 21, 30, + 29, 41, 34, 37, 39, 54, 40, 44, 55, 43, 56, 42, 46, 47, 49, 49, + 49, 49, 49, 49, 49, 49, 49, 49, 38, 57, 36, 59, 52, 60, 61, 62, + 63, 64, 66, 67, 70, 71, 72, 73, 51, 51, 51, 51, 51, 51, 51, 51, + 51, 51, 74, 77, 78, 79, 80, 83, 84, 52, 52, 52, 52, 52, 52, 52, + 52, 52, 52, 52, 52, 52, 52, 52, 52, 52, 52, 52, 52, 52, 52, 52, + 52, 52, 52, 85, 86, 87, 88, 52, 35, 52, 52, 52, 52, 52, 52, 52, + 52, 52, 52, 52, 52, 52, 52, 52, 52, 52, 52, 52, 52, 52, 52, 52, + 52, 52, 52, 69, 89, 90, 91, 93, 94, 95, 96, 98, 100, 75, 101, 102, + 104, 109, 82, 106, 107, 108, 110, 111, 112, 113, 114, 116, 117, 118, 105, 120, + 121, 122, 123, 125, 126, 127, 129, 119, 130, 131, 132, 133, 135, 136, 137, 138, + 140, 139, 141, 142, 134, 143, 145, 146, 147, 168, 160, 156, 151, 152, 149, 153, + 154, 144, 155, 150, 157, 158, 159, 165, 162, 161, 163, 164, 166, 167, 169, 170, + 171, 172, 173, +}; + +LLTYPE1 _Clextab[] { + -1, -1, -1, -1, -1, -1, -1, -1, -1, 0, 0, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 16, 0, 0, 0, 0, 0, + 18, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 22, 0, 25, 0, + 31, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 20, 28, + 28, 33, 33, 36, 38, 53, 33, 33, 54, 33, 55, 33, 45, 45, 48, 48, + 48, 48, 48, 48, 48, 48, 48, 48, 33, 56, 33, 58, 50, 59, 60, 61, + 62, 63, 65, 66, 69, 70, 71, 72, 50, 50, 50, 50, 50, 50, 50, 50, + 50, 50, 73, 76, 77, 78, 79, 82, 83, 50, 50, 50, 50, 50, 50, 50, + 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, + 50, 50, 50, 84, 85, 86, 87, 50, 33, 50, 50, 50, 50, 50, 50, 50, + 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, + 50, 50, 50, 68, 81, 89, 90, 92, 93, 94, 95, 97, 99, 68, 100, 101, + 103, 104, 81, 105, 106, 107, 109, 110, 111, 112, 113, 115, 116, 117, 104, 119, + 120, 121, 122, 124, 125, 126, 128, 115, 129, 130, 131, 132, 134, 135, 136, 137, + 139, 128, 140, 141, 128, 142, 144, 145, 146, 148, 148, 149, 150, 151, 148, 152, + 153, 139, 154, 149, 156, 157, 158, 160, 161, 160, 162, 163, 165, 166, 168, 169, + 170, 171, 172, +}; + +LLTYPE1 _Dlextab[] { + 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, + 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, + 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, + 174, 48, 174, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, + 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, + 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, + 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, + 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, + 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, 50, + 50, 50, 50, 50, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, + 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, 174, +}; + +int _Blextab[] { + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 13, 0, 21, 0, 2, 0, 54, 0, 0, 52, 0, 0, 66, 0, 0, 35, + 0, 92, 0, 0, 69, 0, 72, 0, 0, 0, 0, 0, 0, 80, 0, 0, + 94, 0, 120, 0, 0, 23, 31, 27, 43, 0, 34, 45, 57, 59, 59, 59, + 0, 51, 49, 0, 142, 62, 68, 49, 59, 62, 0, 0, 65, 79, 84, 75, + 0, 147, 73, 68, 106, 102, 96, 113, 0, 130, 145, 0, 143, 143, 141, 149, + 0, 149, 0, 141, 138, 144, 0, 155, 154, 142, 146, 151, 0, 157, 148, 148, + 164, 152, 0, 159, 153, 168, 0, 155, 171, 159, 164, 0, 158, 160, 166, 0, + 173, 158, 180, 171, 181, 0, 179, 169, 187, 183, 0, 191, 174, 186, 194, 0, + 177, 196, 180, 0, 197, 197, 201, 193, 186, 204, 205, 0, 208, 208, 208, 0, + 203, 212, 209, 213, 0, 201, 216, 0, 217, 217, 215, 211, 221, 0, 0, +}; + +struct lextab lextab { + 174, /* last state */ + _Dlextab, /* defaults */ + _Nlextab, /* next */ + _Clextab, /* check */ + _Blextab, /* base */ + 322, /* last in base */ + _lmovb, /* byte-int move routines */ + _Flextab, /* final state descriptions */ + _Alextab, /* action routine */ + NULL, /* look-ahead vector */ + 0, /* no ignore class */ + 0, /* no break class */ + 0, /* no illegal class */ +}; diff --git a/c20/lex/clex.lxi b/c20/lex/clex.lxi new file mode 100644 index 00000000..902f275f --- /dev/null +++ b/c20/lex/clex.lxi @@ -0,0 +1,139 @@ +/* + * C lex + */ +%{ +extern char *install(); +%} +digit = [0-9]; +letter = [a-zA-Z_$]; +name = letter (letter|digit)*; +integer = digit digit*; +%{ +main() +{ + register int i; + char buffer[80]; + extern char *token(); + + while (i = yylex()) { + gettoken(buffer, sizeof buffer); + printf("yylex returns %d, token = \"%s\"\n", + i, buffer); + if (i == LEXERR) { + error("LEXERR -- abort"); + break; + } + } +} +%} +%% +%{ + register int c; +%} +#DEFINE { return(__na__); } +#ELSE { return(__na__); } +#ENDIF { return(__na__); } +#IFDEF { return(__na__); } +#INCLUDE { return(__na__); } +STRUCT { return(-1); } +AUTO { return(__na__); } +EXTERN { return(__na__); } +STATIC { return(__na__); } +REGISTER { return(__na__); } +GOTO { return(__na__); } +RETURN { return(__na__); } +IF { return(__na__); } +WHILE { return(__na__); } +ELSE { return(__na__); } +SWITCH { return(__na__); } +CASE { return(__na__); } +BREAK { return(__na__); } +CONTINUE { return(__na__); } +DO { return(__na__); } +DEFAULT { return(__na__); } +FOR { return(__na__); } +SIZEOF { return(__na__); } +TYPEDEF { return(__na__); } +UNION { return(__na__); } +name { + lexval = install(); + return(6); + } +integer { + lexval = install(); + return(7); + } +"<" { return(__na__); } +"<=" { return(__na__); } +"=" { return(__na__); } +"!=" { return(__na__); } +">=" { return(__na__); } +">" { return(__na__); } +"<<" { return(__na__); } +">>" { return(__na__); } +"=+" { return(__na__); } +"=-" { return(__na__); } +"=/" { return(__na__); } +"=%" { return(__na__); } +"%" { return(__na__); } +"/" { return(__na__); } +"*" { return(__na__); } +"=*" { return(__na__); } +"=<<" { return(__na__); } +"=>>" { return(__na__); } +"&" { return(__na__); } +"|" { return(__na__); } +"=|" { return(__na__); } +"=&" { return(__na__); } +"+" { return(__na__); } +"-" { return(__na__); } +"++" { return(__na__); } +"--" { return(__na__); } +";" { return(__na__); } +"?" { return(__na__); } +"." { return(__na__); } +"," { return(__na__); } +"/*" { + comment("*/"); + return(LEXSKIP); + } +"'" { + if ((c = mapch('\'', '\\')) != -1) + while (mapch('\'', '\\') != -1) + lexerror("Long character constant"); + printf("%c", c); + return(__na__); + } +"\"" { return(__na__); } /* This should call "lexswitch" */ +"\n" { return(__na__); } +" " { return(__na__); } +"\t" { return(__na__); } +"||" { return(__na__); } +"&&" { return(__na__); } +"(" { return(__na__); } +")" { return(__na__); } +"[" { return(__na__); } +"]" { return(__na__); } +"{" { return(__na__); } +"}" { return(__na__); } +%% +char * +install() +/* + * Install the current token in the symbol table + */ +{ + register char *buffer; /* Where to put the character */ + register char *first; /* -> first byte of the token */ + char *last; /* Can't be in a register */ + extern char *token(); + + first = token(&last); /* Find first/last of token */ + if ((buffer = alloc((last - first) + 1)) == NULL) { + error("Out of space in install"); + exit(1); + } + first = copy(buffer, first, (last - first)); + *first = '\0'; + return(buffer); +} diff --git a/c20/lex/commen.c b/c20/lex/commen.c new file mode 100644 index 00000000..8bf2016e --- /dev/null +++ b/c20/lex/commen.c @@ -0,0 +1,32 @@ +/* + * Bob Denny 28-Aug-82 Remove reference to stdio.h + */ +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +/*)LIBRARY +*/ + +comment(mat) +char *mat; +{ + register c; + register char *cp; + int lno; + + lno = yyline; + c = 1; + for (cp = mat; *cp && c>=0;) { + if ((c = lexchar())=='\n') + yyline++; + if (c!=*cp++) + cp = mat; + } + if (c < 0) { + yyline = lno; + lexerror("End of file in comment"); + } +} diff --git a/c20/lex/ctoc.c b/c20/lex/ctoc.c new file mode 100644 index 00000000..43400da6 --- /dev/null +++ b/c20/lex/ctoc.c @@ -0,0 +1,225 @@ +/* + * Created by DECUS LEX from file "CTOC.LXI" Mon Mar 22 12:44:32 1982 + */ +# +#include +#include + +extern int _lmovb(); + +#line 19 "CTOC.LXI" + + +char tbuf[80]; /* Token buffer */ + +main() + { + while (yylex()) + ; + } + +_Alextab(__na__) { + switch (__na__) { + case 0: + +#line 42 "CTOC.LXI" + + gettoken(tbuf, sizeof tbuf); + printf("%s=",tbuf+1); + + break; + case 1: + +#line 48 "CTOC.LXI" + + lexecho(stdout); + + break; + case 2: + +#line 53 "CTOC.LXI" + + lexecho(stdout); + + break; + case 3: + +#line 58 "CTOC.LXI" + + lexecho(stdout); + + break; + case 4: + +#line 63 "CTOC.LXI" + + lexecho(stdout); + + break; + case 5: + +#line 68 "CTOC.LXI" + + lexecho(stdout); + + break; + } + return(LEXSKIP); +} + +#line 71 "CTOC.LXI" + +int _Flextab[] { + -1, 5, 5, 4, -1, -1, -1, 5, 3, -1, -1, -1, 5, 1, 5, 0, + 0, 0, 0, 0, 0, 2050, 0, 2050, 0, 1, 0, 1, 0, -1, +}; + +#line 71 "CTOC.LXI" + +#define LLTYPE1 char + +LLTYPE1 _Nlextab[] { + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 12, 2, 1, 1, 1, 1, 7, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 12, 14, 12, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 3, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 5, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 8, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 10, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 13, 18, 17, 21, 23, 26, 24, 22, 28, 20, 29, 19, 29, 29, 29, 29, + 29, 29, 29, 29, 29, 29, 29, 29, 27, 13, 25, 29, 29, 29, 29, 29, + 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, + 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 15, 29, 29, 29, 29, 29, + 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, + 29, 29, 29, 29, 29, 29, 29, 29, 16, +}; + +LLTYPE1 _Clextab[] { + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 12, 14, 14, 20, 22, 25, 14, 14, 27, 14, -1, 14, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 14, 14, 14, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 14, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, 14, +}; + +LLTYPE1 _Dlextab[] { + 29, 29, 29, 29, 2, 29, 2, 29, 29, 7, 29, 7, 29, 29, 29, 29, + 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, 29, +}; + +int _Blextab[] { + 0, 0, 256, 0, 0, 384, 0, 512, 0, 0, 640, 0, 707, 0, 732, 0, + 0, 0, 0, 0, 726, 0, 729, 0, 0, 711, 0, 716, 0, 0, +}; +char *llsave[1]; + +int _Llextab[] { + 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 01, 00, + 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 00, 0, +}; + +struct lextab lextab { + 29, /* last state */ + _Dlextab, /* defaults */ + _Nlextab, /* next */ + _Clextab, /* check */ + _Blextab, /* base */ + 856, /* last in base */ + _lmovb, /* byte-int move routines */ + _Flextab, /* final state descriptions */ + _Alextab, /* action routine */ + _Llextab, /* look-ahead vector */ + 0, /* no ignore class */ + 0, /* no break class */ + 0, /* no illegal class */ +}; diff --git a/c20/lex/ctype.h b/c20/lex/ctype.h new file mode 100644 index 00000000..d314c058 --- /dev/null +++ b/c20/lex/ctype.h @@ -0,0 +1,24 @@ +#define _U 01 +#define _L 02 +#define _N 04 +#define _S 010 +#define _P 020 +#define _C 040 +#define _X 0100 + +extern char _ctype_[]; + +#define isalpha(c) ((_ctype_+1)[c]&(_U|_L)) +#define isupper(c) ((_ctype_+1)[c]&_U) +#define islower(c) ((_ctype_+1)[c]&_L) +#define isdigit(c) ((_ctype_+1)[c]&_N) +#define isxdigit(c) ((_ctype_+1)[c]&(_N|_X)) +#define isspace(c) ((_ctype_+1)[c]&_S) +#define ispunct(c) ((_ctype_+1)[c]&_P) +#define isalnum(c) ((_ctype_+1)[c]&(_U|_L|_N)) +#define isprint(c) ((_ctype_+1)[c]&(_P|_U|_L|_N)) +#define iscntrl(c) ((_ctype_+1)[c]&_C) +#define isascii(c) ((unsigned)(c)<=0177) +#define toupper(c) ((c)-'a'+'A') +#define tolower(c) ((c)-'A'+'a') +#define toascii(c) ((c)&0177) diff --git a/c20/lex/dfa.c b/c20/lex/dfa.c new file mode 100644 index 00000000..4a64a810 --- /dev/null +++ b/c20/lex/dfa.c @@ -0,0 +1,200 @@ +/* + * Copyright (c) 1978 Charles H. Forsyth + * + * Modified 02-Dec-80 Bob Denny -- Conditionalize debug code for reduced size + * Modified 29-May-81 Bob Denny -- Clean up overlay stuff for RSX. + * More 19-Mar-82 Bob Denny -- New C library & compiler + * More 03-May-82 Bob Denny -- Final touches, remove unreferenced autos + * More 29-Aug-82 Bob Denny -- Clean up -d printouts + * More 29-Aug-82 Bob Denny -- Reformat for readability and comment + * while learning about LEX. + */ + +/* + * ********* + * * DFA.C * + * ********* + * + * LEX -- DFA construction routines + */ + +#include +#include "lexlex.h" + +extern struct set *eclosure(); /* Used only by DFA */ +extern struct dfa *defalt(); /* Used only by DFA */ +extern struct move *stbase(); /* Used only by DFA */ + +/* + * Build the DFA from the NFA + */ +dfabuild() + { + struct trans *trp; + struct nfa **vec, **tp, *np, *temp[MAXNFA+1]; + int a, i; + struct set **sp, *stack[MAXDFA], **spp, *xp; /* DFA set stack */ + struct dfa *state; /* --> current DFA state */ + struct xset *xs, *xse; + + /* + * Simulate an epsilon transition from nfa state 0 to + * the initial states of the machines for each + * translation. + */ + nfa[0].n_char = EPSILON; /* Set NFA state 0 transition EPSILON */ + /* + * Allocate a state vector, each node of which will + * point to an NFA starting state. Each translation + * generates an NFA, so the number of translations + * equals the number of NFA start states. + */ + vec = lalloc(i = (trnsp-trans)+1, sizeof(*vec), "dfabuild"); + /* + * Fill in the start state vector + */ + vec[0] = nfa; /* vec[0] always --> NFA state 0 */ + for (a = 1, trp = trans; trp < trnsp; trp++) /* For each translation */ + vec[a++] = trp->t_start; /* Pick up the NFA start state */ + /* + * Now build the set sp --> e-CLOSURE(vec) + */ + sp = eclosure(newset(vec, i, 1)); + free(vec); /* Deallocate the start state vector */ + + /* + * At this point state 0 of the DFA is constructed. + * This is the start state of the DFA. + * Mark it "added" and push it on to the stack. + */ + sp->s_flag |= ADDED; + spp = stack; + *spp++ = sp; + /* + * From state 0, which is now stacked, all further DFA + * states will be derived. + */ + while (spp > stack) + { + sp = *--spp; + for (a = 0; a < NCHARS; a++) + insets[a] = 0; + xse = sets; + for (i = 0; i < sp->s_len; i++) + xse = addset(sp->s_els[i], xse); + state = newdfa(); + sp->s_state = state; + state->df_name = sp; +#ifdef DEBUG + if (lldebug) + { + fprintf(lexlog, "build state %d ", state-dfa); + pset(sp, 1); + fprintf(lexlog, "\n"); + } +#endif + state->df_ntrans = xse-sets; + for (xs = sets; xs < xse; xs++) + { + a = xs->x_char&0377; + tp = temp; + for (i = 0; i < sp->s_len; i++) + if ((np = sp->s_els[i])->n_char==a || + np->n_char==CCL && + np->n_ccl[a/NBPC]&(1<<(a%NBPC))) + add(temp, &tp, np->n_succ[0]); + xp = newset(temp, tp-temp, 1); + xp = eclosure(xp); +#ifdef DEBUG + if (lldebug) + { + putc('\t', lexlog); + chprint(a); + putc('\t', lexlog); + pset(xp, 1); + fprintf(lexlog, "\n"); + } +#endif + xs->x_set = xp; + if (xp->s_state==0 && (xp->s_flag&ADDED)==0) + { + xp->s_flag |= ADDED; + if (spp >= stack+MAXDFA) + { + error("dfabuild: stack overflow"); + exit(1); + } + *spp++ = xp; + } + } + state->df_default = defalt(state, &xse); + setbase(state, stbase(xse), xse); + } + } + +/* + * If an nfa state is not + * already a member of the vector + * `base', add it. + */ +add(base, tpp, np) +struct nfa ***tpp, **base, *np; + { + register struct nfa **tp; + + for (tp = base; tp < *tpp; tp++) + if (*tp == np) + return; + *(*tpp)++ = np; + } + +/* + * Add the character(s) + * on which state `np' + * branches to the transition + * vector. + */ +addset(np, xse) +register struct nfa *np; +struct xset *xse; + { + register a; + register char *ccl; + + if ((a = np->n_char) < NCHARS) + xse = addxset(a, xse); + if (a != CCL) + return(xse); + ccl = np->n_ccl; + for (a = 0; a < NCHARS; a++) + if (ccl[a/NBPC]&(1<<(a%NBPC))) + xse = addxset(a, xse); + return(xse); + } + +/* + * Add a character to the + * transition vector, if it + * isn't there already. + */ +addxset(a, xse) +register a; +struct xset *xse; + { + register struct xset *xs; + register int temp; + + /* + * VMS native doesn't do this correctly: + * if (insets[a]++) + */ + temp = insets[a]; + insets[a] += 1; + if (temp) + return(xse); + xs = xse++; + xs->x_char = a; + xs->x_set = NULL; + xs->x_defsame = 0; + return(xse); + } diff --git a/c20/lex/dfa.old b/c20/lex/dfa.old new file mode 100644 index 00000000..a4c3312d --- /dev/null +++ b/c20/lex/dfa.old @@ -0,0 +1,200 @@ +/* + * Copyright (c) 1978 Charles H. Forsyth + * + * Modified 02-Dec-80 Bob Denny -- Conditionalize debug code for reduced size + * Modified 29-May-81 Bob Denny -- Clean up overlay stuff for RSX. + * More 19-Mar-82 Bob Denny -- New C library & compiler + * More 03-May-82 Bob Denny -- Final touches, remove unreferenced autos + * More 29-Aug-82 Bob Denny -- Clean up -d printouts + * More 29-Aug-82 Bob Denny -- Reformat for readability and comment + * while learning about LEX. + */ + +/* + * ********* + * * DFA.C * + * ********* + * + * LEX -- DFA construction routines + */ + +#include +#include "lexlex.h" + +extern struct set *eclosure(); /* Used only by DFA */ +extern struct dfa *defalt(); /* Used only by DFA */ +extern struct move *stbase(); /* Used only by DFA */ + +/* + * Build the DFA from the NFA + */ +dfabuild() + { + struct trans *trp; + struct nfa **vec, **tp, *np, *temp[MAXNFA+1]; + int a, i; + struct set **sp, *stack[MAXDFA], **spp, *xp; /* DFA set stack */ + struct dfa *state; /* --> current DFA state */ + struct xset *xs, *xse; + + /* + * Simulate an epsilon transition from nfa state 0 to + * the initial states of the machines for each + * translation. + */ + nfa[0].n_char = EPSILON; /* Set NFA state 0 transition EPSILON */ + /* + * Allocate a state vector, each node of which will + * point to an NFA starting state. Each translation + * generates an NFA, so the number of translations + * equals the number of NFA start states. + */ + vec = lalloc(i = (transp-trans)+1, sizeof(*vec), "dfabuild"); + /* + * Fill in the start state vector + */ + vec[0] = nfa; /* vec[0] always --> NFA state 0 */ + for (a = 1, trp = trans; trp < transp; trp++) /* For each translation */ + vec[a++] = trp->t_start; /* Pick up the NFA start state */ + /* + * Now build the set sp --> e-CLOSURE(vec) + */ + sp = eclosure(newset(vec, i, 1)); + free(vec); /* Deallocate the start state vector */ + + /* + * At this point state 0 of the DFA is constructed. + * This is the start state of the DFA. + * Mark it "added" and push it on to the stack. + */ + sp->s_flag |= ADDED; + spp = stack; + *spp++ = sp; + /* + * From state 0, which is now stacked, all further DFA + * states will be derived. + */ + while (spp > stack) + { + sp = *--spp; + for (a = 0; a < NCHARS; a++) + insets[a] = 0; + xse = sets; + for (i = 0; i < sp->s_len; i++) + xse = addset(sp->s_els[i], xse); + state = newdfa(); + sp->s_state = state; + state->df_name = sp; +#ifdef DEBUG + if (lldebug) + { + fprintf(lexlog, "build state %d ", state-dfa); + pset(sp, 1); + fprintf(lexlog, "\n"); + } +#endif + state->df_ntrans = xse-sets; + for (xs = sets; xs < xse; xs++) + { + a = xs->x_char&0377; + tp = temp; + for (i = 0; i < sp->s_len; i++) + if ((np = sp->s_els[i])->n_char==a || + np->n_char==CCL && + np->n_ccl[a/NBPC]&(1<<(a%NBPC))) + add(temp, &tp, np->n_succ[0]); + xp = newset(temp, tp-temp, 1); + xp = eclosure(xp); +#ifdef DEBUG + if (lldebug) + { + putc('\t', lexlog); + chprint(a); + putc('\t', lexlog); + pset(xp, 1); + fprintf(lexlog, "\n"); + } +#endif + xs->x_set = xp; + if (xp->s_state==0 && (xp->s_flag&ADDED)==0) + { + xp->s_flag |= ADDED; + if (spp >= stack+MAXDFA) + { + error("dfabuild: stack overflow"); + exit(1); + } + *spp++ = xp; + } + } + state->df_default = defalt(state, &xse); + setbase(state, stbase(xse), xse); + } + } + +/* + * If an nfa state is not + * already a member of the vector + * `base', add it. + */ +add(base, tpp, np) +struct nfa ***tpp, **base, *np; + { + register struct nfa **tp; + + for (tp = base; tp < *tpp; tp++) + if (*tp == np) + return; + *(*tpp)++ = np; + } + +/* + * Add the character(s) + * on which state `np' + * branches to the transition + * vector. + */ +addset(np, xse) +register struct nfa *np; +struct xset *xse; + { + register a; + register char *ccl; + + if ((a = np->n_char) < NCHARS) + xse = addxset(a, xse); + if (a != CCL) + return(xse); + ccl = np->n_ccl; + for (a = 0; a < NCHARS; a++) + if (ccl[a/NBPC]&(1<<(a%NBPC))) + xse = addxset(a, xse); + return(xse); + } + +/* + * Add a character to the + * transition vector, if it + * isn't there already. + */ +addxset(a, xse) +register a; +struct xset *xse; + { + register struct xset *xs; + register int temp; + + /* + * VMS native doesn't do this correctly: + * if (insets[a]++) + */ + temp = insets[a]; + insets[a] += 1; + if (temp) + return(xse); + xs = xse++; + xs->x_char = a; + xs->x_set = NULL; + xs->x_defsame = 0; + return(xse); + } diff --git a/c20/lex/eclosu.c b/c20/lex/eclosu.c new file mode 100644 index 00000000..809a97e4 --- /dev/null +++ b/c20/lex/eclosu.c @@ -0,0 +1,52 @@ +/* + * Copyright (c) 1978 Charles H. Forsyth + */ + +#include +#include "lexlex.h" + +/* + * Construct the + * epsilon closure of + * a given set; this is + * the set of states that may + * be reached by some number of + * epsilon transitions from + * that state. + */ +struct set * +eclosure(t) +struct set *t; +{ + register struct nfa *np, *xp; + register i; + struct nfa **sp, **tp, **ip, *stack[MAXNFA], *temp[MAXNFA]; + + tp = temp; + for (sp = stack, i = 0; i < t->s_len; i++) + if (sp <= stack+MAXNFA) + *tp++ = *sp++ = t->s_els[i]; + else { + error("Stack overflow in `eclosure'"); + exit(1); + } + while (sp > stack) { + np = *--sp; + if (np->n_char==EPSILON) + for (i = 0; i < 2; i++) + if (xp = np->n_succ[i]) { + for (ip = temp; ip < tp;) + if (*ip++ == xp) + goto cont; + if (tp >= temp+MAXNFA) { + error("eclosure: list overflow"); + exit(1); + } + *sp++ = *tp++ = xp; + cont:; + } + } + t = newset(temp, tp-temp, 1); + return(t); +} + diff --git a/c20/lex/foo.c b/c20/lex/foo.c new file mode 100644 index 00000000..3a4d34f4 --- /dev/null +++ b/c20/lex/foo.c @@ -0,0 +1,94 @@ +#include +#ifdef vms +#include "c:lex.h" +#else +#include +#endif +extern int _lmovb(); + +#line 1 "foo.lxi" + +main() { + int res; + res = yylex(); + printf("lexval=\t%d\nyylex()=\t%d\n", lexval, res); +} +extern struct lextab foo; + +/* Standard I/O selected */ +extern FILE *lexin; + +llstin() + { + if(lexin == NULL) + lexin = stdin; + if(_tabp == NULL) + lexswitch(&foo); + } + +_Afoo(__na__) /* Action routine */ + { + switch (__na__) { + case 0: + +#line 11 "foo.lxi" + printf("foo"); + + break; + } + return(LEXSKIP); +} + +#line 13 "foo.lxi" + +int _Ffoo[] = { + -1, -1, -1, 0, -1, +}; + +#line 13 "foo.lxi" + +#define LLTYPE1 char + +LLTYPE1 _Nfoo[] = { + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 2, 1, 2, 1, 2, 3, 2, 1, +}; + +LLTYPE1 _Cfoo[] = { + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, 0, 0, 1, 1, 2, 2, 3, 3, +}; + +LLTYPE1 _Dfoo[] = { + 4, 4, 4, 4, +}; + +int _Bfoo[] = { + 0, 2, 4, 6, 0, +}; + +struct lextab foo = { + 4, /* last state */ + _Dfoo, /* defaults */ + _Nfoo, /* next */ + _Cfoo, /* check */ + _Bfoo, /* base */ + 104, /* last in base */ + _lmovb, /* byte-int move routines */ + _Ffoo, /* final state descriptions */ + _Afoo, /* action routine */ + NULL, /* look-ahead vector */ + 0, /* no ignore class */ + 0, /* no break class */ + 0, /* no illegal class */ +}; diff --git a/c20/lex/foo.lxi b/c20/lex/foo.lxi new file mode 100644 index 00000000..8a7e5069 --- /dev/null +++ b/c20/lex/foo.lxi @@ -0,0 +1,12 @@ +%{ +main() { + int res; + res = yylex(); + printf("lexval=\t%d\nyylex()=\t%d\n", lexval, res); +} +%} + +%% + +("a" | "b")* "ab" { printf("foo"); + } diff --git a/c20/lex/foo.out b/c20/lex/foo.out new file mode 100644 index 00000000..5f45a989 --- /dev/null +++ b/c20/lex/foo.out @@ -0,0 +1,58 @@ + +NFA for complete syntax +state 0 + epsilon 7 +state 7 + epsilon 5 + epsilon 8 + +state 5 + epsilon 1 + epsilon 3 + +state 1 + a 2 + +state 2 + epsilon 6 + +state 6 + epsilon 5 + epsilon 8 + +state 8 + a 10 + +state 10 + b 11 + +state 11 + final state + +state 3 + b 4 + +state 4 + epsilon 6 + + +Minimised DFA for complete syntax + +state 0 + a 2 + b 1 + +state 1 + a 2 + b 1 + +state 2 + a 2 + b 3 + +state 3 (final 11[0],) + a 2 + b 1 + +12/600 NFA states, 4/800 DFA states +104/15000 entries in move vectors diff --git a/c20/lex/foo.stinkr b/c20/lex/foo.stinkr new file mode 100644 index 00000000..8b1bc0dc --- /dev/null +++ b/c20/lex/foo.stinkr @@ -0,0 +1,4 @@ +x clib:stdio +x lex:lexlib +l foo +o foo.exe diff --git a/c20/lex/gettok.c b/c20/lex/gettok.c new file mode 100644 index 00000000..f012c69b --- /dev/null +++ b/c20/lex/gettok.c @@ -0,0 +1,24 @@ +/* + * Bob Denny 28-Aug-82 Remove reference to stdio.h + */ +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +/*)LIBRARY +*/ + +gettoken(lltb, lltbsiz) +char *lltb; +{ + register char *lp, *tp, *ep; + + tp = lltb; + ep = tp+lltbsiz-1; + for (lp = llbuf; lp < llend && tp < ep;) + *tp++ = *lp++; + *tp = 0; + return(tp-lltb); +} diff --git a/c20/lex/hword.c b/c20/lex/hword.c new file mode 100644 index 00000000..e33fa880 --- /dev/null +++ b/c20/lex/hword.c @@ -0,0 +1,219 @@ +# +#include +#include + +extern int _lmovb(); + +#line 34 "hword.lxi" + + +main() +{ + while (yylex()) + ; +} +_Alextab(__na__) { + switch (__na__) { + case 0: + +#line 50 "hword.lxi" + + output(TRUE); + return(LEXSKIP); + + break; + case 1: + +#line 58 "hword.lxi" + + output(FALSE); + return(LEXSKIP); + + break; + case 2: + +#line 68 "hword.lxi" + + return(LEXSKIP); + + break; + case 3: + +#line 77 "hword.lxi" + + return(LEXSKIP); + + break; + } + return(LEXSKIP); +} + +#line 81 "hword.lxi" + + +output(flag) +int flag; +/* + * Output the current token. The parameter is TRUE if this is + * the start of a hyphenated word. + */ +{ + register char *tokptr; /* Locate token start */ + char *tokend; /* Locate token end */ + char *token(); + + + tokptr = token(&tokend); + /* + * Skip over leading and trailing non-alpha stuff + */ + while (!isalpha(*tokptr) && tokptr < tokend) + tokptr++; + while (!isalpha(*--tokend) && tokend > tokptr); + printf("%.?s", (tokend - tokptr + 1), tokptr); + if (!flag) + putchar('\n'); +} + +int _Flextab[] { + -1, 3, 3, 2, 2, 3, 2, 1, 1, -1, -1, 2048, -1, 1, -1, 3, + 2, -1, -1, -1, +}; + +#line 106 "hword.lxi" + +#define LLTYPE1 char + +LLTYPE1 _Nlextab[] { + 2, 1, 1, 1, 1, 1, 1, 1, 1, 4, 3, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 4, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 15, 15, 15, 15, 15, + 15, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 15, 15, 15, 15, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, + 6, 6, 9, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, + 19, 19, 19, 19, 19, 19, 19, 6, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, 14, + 14, 14, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 14, 14, 14, 14, 14, 14, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 14, 14, 14, 14, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, + 13, 13, 8, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, 13, + 13, 13, 13, 13, 13, 13, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 13, 13, 13, 13, 13, 13, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 13, 13, 13, 13, 12, 12, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, + 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 12, 19, 19, 19, 19, + 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, + 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 19, 19, 19, 19, 19, 19, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 19, 19, 19, 19, 19, 19, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 16, 16, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, 19, + 19, 19, 19, 19, 19, 19, 19, 16, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, 18, + 18, 18, 18, 18, 18, 18, 18, 18, 17, 17, 17, 17, 17, 17, 17, 17, + 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, + 17, 17, 18, 18, 18, 18, 18, 18, 17, 17, 17, 17, 17, 17, 17, 17, + 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, 17, + 17, 17, 18, 18, 18, 18, +}; + +LLTYPE1 _Clextab[] { + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 5, 5, 8, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 9, 9, 14, 14, 17, 17, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 9, -1, 14, -1, 17, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, -1, -1, -1, -1, -1, -1, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 9, 9, 9, 9, 9, 9, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + -1, -1, -1, -1, -1, -1, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 15, 15, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, 15, + 15, 15, 15, 15, 15, 15, +}; + +LLTYPE1 _Dlextab[] { + 19, 19, 19, 19, 19, 19, 19, 19, 7, 19, 19, 19, 9, 7, 5, 19, + 19, 14, 15, +}; + +int _Blextab[] { + 0, 0, 0, 0, 0, 247, 0, 341, 248, 459, 517, 0, 0, 0, 461, 631, + 0, 463, 0, 0, +}; +char *llsave[1]; + +int _Llextab[] { + 00, 00, 00, 00, 00, 00, 00, 00, 01, 00, 00, 00, 00, 00, 00, 00, + 00, 00, 00, 0, +}; + +struct lextab lextab { + 19, /* last state */ + _Dlextab, /* defaults */ + _Nlextab, /* next */ + _Clextab, /* check */ + _Blextab, /* base */ + 757, /* last in base */ + _lmovb, /* byte-int move routines */ + _Flextab, /* final state descriptions */ + _Alextab, /* action routine */ + _Llextab, /* look-ahead vector */ + 0, /* no ignore class */ + 0, /* no break class */ + 0, /* no illegal class */ +}; diff --git a/c20/lex/hword.lxi b/c20/lex/hword.lxi new file mode 100644 index 00000000..fcde5555 --- /dev/null +++ b/c20/lex/hword.lxi @@ -0,0 +1,109 @@ +/* + * Word recognizer (with hyphenation) + * + * This program acts as a very simple filter for files of + * text that may have hyphenated words at the end of an input + * line. Output consists of each word on a seperate line + * with hyphenated words rejoined. Note: a word is said to + * start with the first alphabetic character and end with the + * last alphabetic character. Embedded graphics will be removed. + */ + +/* + * Basic elements + */ +white = [\n\t ]; /* End of a word */ +bol = [\n] white*; /* Beginning of a line */ +eol = [\0\n]; /* End of input line */ +letter = [A-Za-z]; /* Is a letter */ +graphic = [!-@\[-`{-~]; /* Not a letter */ +text = [!-~]; /* All printing chars. */ +garbage = [\1-\377]; /* Whatever remains */ + +/* + * A word contains "junk", at least one letter, then at + * least another letter, then more junk. + * + * A hyphenated word is a word- followed by a word + * on the next line. + */ + +word = graphic* letter text* letter graphic*; +junk = (letter white) | (graphic* white); + +%{ + +#define TRUE 1 +#define FALSE 0 +#define EOS 0 + +main() +{ + while (yylex()) + ; +} +%} + +%% + +/* + * A hyphenated word + */ + +word "-" / bol letter letter + { + output(TRUE); + return(LEXSKIP); + } +/* + * An ordinary word + */ + +word { + output(FALSE); + return(LEXSKIP); + } + +/* + * Junk (one letter words or all graphics) + */ + +junk + { + return(LEXSKIP); + } + +/* + * Other stuff + */ + +eol | white | garbage + { + return(LEXSKIP); + } + +%% + +output(flag) +int flag; +/* + * Output the current token. The parameter is TRUE if this is + * the start of a hyphenated word. + */ +{ + register char *tokptr; /* Locate token start */ + char *tokend; /* Locate token end */ + char *token(); + + + tokptr = token(&tokend); + /* + * Skip over leading and trailing non-alpha stuff + */ + while (!isalpha(*tokptr) && tokptr < tokend) + tokptr++; + while (!isalpha(*--tokend) && tokend > tokptr); + printf("%.*s", (tokend - tokptr + 1), tokptr); + if (!flag) + putchar('\n'); +} diff --git a/c20/lex/impure.c b/c20/lex/impure.c new file mode 100644 index 00000000..81f255b5 --- /dev/null +++ b/c20/lex/impure.c @@ -0,0 +1,65 @@ +/* + * impure.c -- Impure data for ytab.c and min.c + * + * Created 02-Dec-80 Bob Denny -- Impure data from ytab.c and min.c moved + * here so they can reside in overlays. + * More 19-Mar-82 Bob Denny -- New C library & compiler + */ +#include +#include "lexlex.h" +#include "ytab.h" + +/* + * min's + */ +struct set **oldpart; +int **newpart; +int nold; +int nnew; + +/* + * ytab's + */ + +struct nlist { + struct nlist *nl_next; + struct nfa *nl_base; + struct nfa *nl_end; + struct nfa *nl_start; + struct nfa *nl_final; + } *nlist; + +#ifndef YYSTYPE +#define YYSTYPE int +#endif + +YYSTYPE yyval = 0; +YYSTYPE *yypv; +YYSTYPE yylval = 0; + +int nlook = 0; +int yyline = 0; +char *breakc; +char *ignore; +char *illeg; + +char buffer[150]; +int str_length; + +char ccl[(NCHARS+1)/NBPC]; + +/* + * Copied from ytab.c just before yyparse() ... kludgy. + */ +#define YYMAXDEPTH 150 + +/* + * These are impure data for the parser driver yyparse(). + */ + +int yydebug = 0; /* Make this 1 for yyparse() debugging */ +YYSTYPE yyv[YYMAXDEPTH]; +int yychar = -1; +int yynerrs = 0; +int yyerrflag = 0; + diff --git a/c20/lex/integ.c b/c20/lex/integ.c new file mode 100644 index 00000000..99f23c3b --- /dev/null +++ b/c20/lex/integ.c @@ -0,0 +1,28 @@ + +/* + * integ -- ascii to long (various bases) + */ + +/*)LIBRARY +*/ + +long +integ(cp, base) +char *cp; +register base; +{ + register c; + long n; + + n = 0; + while (c = *cp++) { + if (c>='A' && c<='Z') + c += 'a'-'A'; + if (c>='a' && c<='z') + c = (c-'a')+10+'0'; + if (c < '0' || c > base+'0') + break; + n = n*base + c-'0'; + } + return(n); +} diff --git a/c20/lex/lex-source-files.cmd b/c20/lex/lex-source-files.cmd new file mode 100644 index 00000000..746bb869 --- /dev/null +++ b/c20/lex/lex-source-files.cmd @@ -0,0 +1 @@ +lex.c, lexsrt.c, impure.c, dfa.c, min.c, out.c, ytab.c, base.c, eclosu.c diff --git a/c20/lex/lex.c b/c20/lex/lex.c new file mode 100644 index 00000000..dc1a8de2 --- /dev/null +++ b/c20/lex/lex.c @@ -0,0 +1,568 @@ +/* + * Copyright (c) 1978 Charles H. Forsyth + */ + +/* + * lex -- initialisation, allocation, set creation + * + * Revised for PDP-11 (Decus) C by Martin Minow + */ +#ifdef DOCUMENTATION + +title lex A Lexical Analyser Generator +index A Lexical Analyser Generator + +synopsis + + lex [-options] [-i grammar] [-o outfile] [-t table] + +description + + Lex compiles a lexical analyser from a grammar and description of + actions. It is described more fully in lex.doc: only usage is + described. The following options are available: + .lm +16 + .s.i-16;-a Disable recognition of non-ASCII characters + (codes > 177 octal) for exception character classes (form [^ ...]). + .s.i-16;-d Enable debugging code within lex. Normally + needed only for debugging lex. + .s.i-16;-e "Easy" command line. Saying "lex#-e#name" is the + same as saying: + .s.i 4;"lex -i name.lxi -o name.c -t name" + .s + Do not include devices or an extension on "name" or make it longer + than 8 characters, or you'll get several error messages. + .s.i-16;-i file Read the grammar from the file. If "-i" is not + specified, input will be read from the standard input. + .s.i-16;-m Enable state minimization. Currently not + implemented, switch is a no-op. + .s.i-16;-o file Write the output to the file. If "-o" is not + specified, output will be written to file "lextab.c". + .s.i-16;-s "Stand-alone" switch. Supresses the line + "#include " normally generated in the lex output. Use this + if LEX is generating a module to be used in a program which does not + use the "standard I/O" package. + .s.i-16;-t table Name the recognizer "table" instead of the + default "lextab". If -o is not given, output will be written to file + "table.c". + .s.i-16;-v [file] Verify -- write internal tables to the + indicated file. If "-v" is given without a file name argument, + tables will be written to "lex.out". + .lm -16 + +diagnostics + + The following error messages may occur on invocation. See lex + documentation for information on compilation errors. + .lm +8 + .s.i -8;Can't create ... + .s.i -8;Cannot open ... + .s.i -8;Illegal option. + .s.i -8;Illegal switch combination. + .s + "-i", "-o" or "-t" given with "-e" or vice-versa + .s.i -8;Table name too long. + .s + The table name (argument to "-t") must not be longer than 8 bytes. + .s.i -8;Missing table name. + .s.i -8;Missing input file. + .s.i -8;Missing output file. + .s.i -8;Missing name. + .lm -8 + +author + + Charles Forsyth + Modified by Bob Denny +bugs + +#endif + + +#include +#include "lexlex.h" + +extern char *lalloc(); +extern char *tolower(); + +struct nfa nfa[MAXNFA]; +struct nfa *nfap = &nfa[1]; + +struct xset sets[NCHARS]; +char insets[NCHARS]; + +struct trans trans[NTRANS]; +struct trans *trnsp = &trans[0]; /* transp */ + +char ccls[NCCLS][(NCHARS+1)/NBPC]; +int nccls; + +int ndfa; +struct dfa dfa[MAXDFA]; +struct move move[NNEXT]; + +char *tabname = "lextab"; +char tabfile[15]; +char *infile = NULL; +char *outfile = NULL; + +#ifdef DEBUG +char *dumpfile = "lex.out"; +int lldebug = 0; +#endif + +int llnxtmax = 0; + +FILE *llout; +FILE *lexin; +FILE *lexlog; + +/* + * Flags. Allow globals only for + * those requiring same. Some only + * used for checking for bad combos. + */ + int aflag = 0; /* Ignore non-ASCII in [^ ...] */ +static int eflag = 0; /* Easy command line */ +static int iflag = 0; /* "-i" given */ + int mflag = 0; /* Enable state minimization (not imp.) */ +static int oflag = 0; /* "-o" given */ + int sflag = 0; /* Supress "#include " in output */ +static int tflag = 0; /* "-t" given */ + +struct set *setlist = 0; + +main(argc, argv) +char **argv; +{ + register char *cp, *cp2; + +#ifdef DEBUG + int vflag; + vflag = 0; +#endif + + for (; argc>1 && *argv[1]=='-'; argv++, argc--) + switch (tolower(argv[1][1])) { + +#ifdef DEBUG + /* + * Create "verification" file, describing the + * scanner. + */ + case 'v': /* -v => lex.out */ + vflag++; /* -v x.out => x.out */ + if (argc > 2 && argv[2][1] != '1') { + --argc; + dumpfile = (++argv)[1]; + } + break; + + /* + * Enable debug displays + */ + case 'd': + lldebug++; + break; +#endif + /* + * Enable state minimization. Currently not + * implemented. + */ + case 'm': + mflag++; + break; + + /* + * Disable matching of non-ASCII characters (codes > 177(8)) + * for exception character classes (form "[^ ...]"). + */ + case 'a': + aflag++; + break; + + /* + * Supress "#include " in generated + * code for programs not using standard I/O. + */ + case 's': + sflag++; + break; + + /* + * "Easy" command line + */ + case 'e': + if(iflag || oflag || tflag) { + error("Illegal switch combination\n"); + exit(1); + } + if (--argc <= 1) { + error("Missing name\n"); + exit(1); + } + if (strlen(tabname = (++argv)[1]) > 8) { + error("Name too long\n"); + exit(1); + } + infile = malloc(14); + outfile = malloc(12); + concat(infile, tabname, ".lxi", 0); +/* if (freopen(infile, "r", stdin) == NULL) { */ + if ((lexin = fopen(infile, "r")) == NULL) { + error("Cannot open input \"%s\"\n", infile); + exit(1); + } + concat(outfile, tabname, ".c", 0); + break; + + /* + * Specify input file name. Default = terminal (stdin) + */ + case 'i': + if (eflag) { + error("Illegal switch combination\n"); + exit(1); + } + iflag++; + if (--argc <= 1) { + error("Missing input file\n"); + exit(1); + } + infile = (++argv)[1]; + if (freopen(infile, "r", stdin) == NULL) { + error("Cannot open input \"%s\"\n", infile); + exit(1); + } + break; + + /* + * Specify output file name. Default = "lextab.c" + */ + case 'o': + if (eflag) { + error("Illegal switch combination\n"); + exit(1); + } + oflag++; + if (--argc <= 1) { + error("Missing output file"); + exit(1); + } + outfile = (++argv)[1]; + break; + + /* + * Specify table name. Default = "lextab". If "-o" + * not given, output will go to "tabname.c". + */ + case 't': + if (eflag) { + error("Illegal switch combination\n"); + exit(1); + } + tflag++; + if (--argc <= 1) { + error("Missing table name"); + exit(1); + } + if (strlen(tabname = (++argv)[1]) > 8) { + error("Table name too long\n"); + exit(1); + } + break; + + default: + error("Illegal option: %s\n", argv[1]); + exit(1); + } +/* lexin = stdin; */ + +#ifdef DEBUG + cp = (vflag) ? dumpfile : "nul:"; /* Dec specific */ + if ((lexlog = fopen(cp, "w")) == NULL) { + error("Cannot open \"%s\"", cp); + exit(1); + } +#endif + + if (infile == NULL) { + infile = malloc(31); + fgetname(lexin, infile); + } + cp = infile; /* Fold infile to lower case */ + while(*cp) + *cp++ = tolower(*cp); + cp = tabname; /* Fold tabname to lower case */ + while(*cp) + *cp++ = tolower(*cp); + if (outfile == NULL) { + /* + * Typical hacker's idiom! + */ + for (cp = tabname, cp2 = tabfile; *cp2 = *cp++;) + cp2++; + for (cp = ".c"; *cp2++ = *cp++;) + ; + outfile = tabfile; + } + if ((llout = freopen(outfile, "w", stdout))==NULL) { + error("Can't create %s\n", outfile); + exit(1); + } + heading(); + if (yyparse()) + error("Parse failed\n"); + dfabuild(); /* 01+ */ + dfamin(); + dfaprint(); + dfawrite(); +/* stats(stdout); */ +#ifdef DEBUG + stats(lexlog); +#endif /* 01- */ +} /** END OF MAIN **/ + +/* + * This module was moved here from out.c so it could be called from + * ytab.c residing in same overlay region as out.c. + * 02-Dec-80 Bob Denny. + */ + /* 01+ */ +/* here for overlaying +ending() +{ + static int ended; + + if (ended++) + return; + fprintf(llout, "\t}\n\treturn(LEXSKIP);\n}\n"); + setlne(); +} */ + /* 01- */ + +stats(f) +FILE *f; +{ + fprintf(f, "\n"); + fprintf(f, "%d/%d NFA states, %d/%d DFA states\n", + nfap-nfa, MAXNFA, ndfa, MAXDFA); + fprintf(f, "%d/%d entries in move vectors\n", llnxtmax, NNEXT); +} + +#ifdef DEBUG +/* + * Print a state set on { ... } form on lexlog. + */ +pset(t, nf) +register struct set *t; +{ + register i; + + fprintf(lexlog, "{"); + for (i = 0; i < t->s_len; i++) + if (nf) + fprintf(lexlog, " %d", t->s_els[i]-nfa); else + fprintf(lexlog, " %d", t->s_els[i]); + fprintf(lexlog, "}"); +} +#endif + +/* + * The following functions simply + * allocate various kinds of + * structures. + */ +struct nfa * +newnfa(ch, nf1, nf2) +struct nfa *nf1, *nf2; +{ + register struct nfa *nf; + + if ((nf = nfap++) >= &nfa[MAXNFA]) { + error("Too many NFA states"); + exit(1); + } + nf->n_char = ch; + nf->n_succ[0] = nf1; + nf->n_succ[1] = nf2; + nf->n_trans = 0; + nf->n_flag = 0; + nf->n_look = 0; + return(nf); +} + +newdfa() +{ + register struct dfa *df; + + if ((df = &dfa[ndfa++]) >= &dfa[MAXDFA]) { + error("Out of dfa states"); + exit(1); + } + return(df); +} + +char * +newccl(ccl) +char *ccl; +{ + register char *p, *q; + register i; + int j; + + for (j = 0; j < nccls; j++) { + p = ccl; + q = ccls[j]; + for (i = sizeof(ccls[j]); i--;) + if (*p++ != *q++) + goto cont; + return(ccls[j]); + cont:; + } + if (nccls >= NCCLS) { + error("Too many character classes"); + exit(1); + } + p = ccl; + q = ccls[j = nccls++]; + for (i = sizeof(ccls[j]); i--;) + *q++ = *p++; + return(ccls[j]); +} + +struct trans * +newtrans(st, en) +struct nfa *st, *en; +{ + register struct trans *tp; + + if ((tp = trnsp++) >= &trans[NTRANS]) { + error("Too many translations"); + exit(1); + } + tp->t_start = st; + tp->t_final = en; + en->n_trans = tp; + return(tp); +} + +/* + * create a new set. + * `sf', if set, indicates + * that the elements of the + * set are states of an NFA). + * If `sf' is not set, the + * elements are state numbers of + * a DFA. + */ +struct set * +newset(v, i, sf) +register struct nfa **v; +register i; +{ + register struct set *t; + register k; + int setcomp(); + + qsort(v, i, sizeof(*v), setcomp); + for (t = setlist; t; t = t->s_next) + if (t->s_len==i && eqvec(t->s_els, v, i)) + return(t); + t = lalloc(1, sizeof(*t)+i*sizeof(t->s_els[0]), "set nodes"); + t->s_next = setlist; + setlist = t; + t->s_final = 0; + t->s_state = 0; + t->s_flag = 0; + t->s_len = i; + t->s_group = 0; + t->s_look = 0; + for (v += i; i;) { + --v; + if (sf) { + if ((*v)->n_char==FIN) + t->s_final = (*v)-nfa; + if ((*v)->n_flag&LOOK) + t->s_look |= 1<<(*v)->n_look; + } else { + k = *v; + dfa[k].df_name->s_group = t; + } + t->s_els[--i] = *v; + } + return(t); +} + +setcomp(n1p, n2p) +struct nfa **n1p, **n2p; +{ + register struct nfa *n1, *n2; + + n1 = *n1p; + n2 = *n2p; + if (n1 > n2) + return(1); + if (n1==n2) + return(0); + return(-1); +} + +eqvec(a, b, i) +register *a, *b, i; +{ + if (i) + do { + if (*a++ != *b++) + return(0); + } while (--i); + return(1); +} + +/* + * Ask for core, and + * complain if there is no more. + */ +char * +lalloc(n, s, w) +char *w; +{ + register char *cp; + + if ((cp = calloc(n, s)) == NULL) { + fprintf(stderr, "No space for %s", w); +#ifdef DEBUG + if (lldebug) + dfaprint(); +#endif + exit(1); + } + return(cp); +} + + +/* Added -PB */ +error(s,x) +char *s; +{ + fprintf(stderr, s, x); +} + +fgetname(fd, s) +FILE *fd; +char *s; +{ + SYSJFNS(mkbptr(s), cjfn(fd), 0); +} + +concat(out, in1, in2, in3) /* minimal version */ +char *out, *in1, *in2, *in3; +{ + while( *in1 ) + *out++ = *in1++; + + while( *in2 ) + *out++ = *in2++; + + *out = '\0'; +} diff --git a/c20/lex/lex.ccl b/c20/lex/lex.ccl new file mode 100644 index 00000000..45acd297 --- /dev/null +++ b/c20/lex/lex.ccl @@ -0,0 +1 @@ +/NOLOC BASE.REL, DFA.REL, ECLOSU.REL, LEX.REL, LEXSRT.REL, MIN.REL, OUT.REL, YTAB.REL, IMPURE.REL diff --git a/c20/lex/lex.ctl b/c20/lex/lex.ctl new file mode 100644 index 00000000..11192df9 --- /dev/null +++ b/c20/lex/lex.ctl @@ -0,0 +1,19 @@ +; BUILD DECUS LEX FOR TOPS-20 +@DEF C: MSC:, PS: +@DEF SS: MSC: +@DEF CLIB: MSC: +@DEF SYS: SYS:, C: + +@PCC20 BASE.C +@PCC20 ECLOSU.C +@PCC20 MIN.C +@PCC20 DFA.C +@PCC20 OUT.C +@PCC20 LEX.C +@PCC20 YTAB.C +@PCC20 LEXSRT.C +@PCC20 IMPURE.C + +@STINKR +*X LEX +*Q diff --git a/c20/lex/lex.h b/c20/lex/lex.h new file mode 100644 index 00000000..b6c96a24 --- /dev/null +++ b/c20/lex/lex.h @@ -0,0 +1,51 @@ + +/* + * lex library header file -- accessed through + * #include + */ + +/* + * description of scanning + * tables. + * the entries at the front of + * the struct must remain in + * place for the assembler routines + * to find. + */ +struct lextab { + int llendst; /* Last state number */ + char *lldefault; /* Default state table */ + char *llnext; /* Next state table */ + char *llcheck; /* Check table */ + int *llbase; /* Base table */ + int llnxtmax; /* Last in base table */ + + int (*llmove)(); /* Move between states */ + int *llfinal; /* Final state descriptions */ + int (*llactr)(); /* Action routine */ + int *lllook; /* Look ahead vector if != NULL */ + char *llign; /* Ignore char vec if != NULL */ + char *llbrk; /* Break char vec if != NULL */ + char *llill; /* Illegal char vec if != NULL */ +}; + +extern struct lextab *_tabp; + +/* extern FILE *lexin; */ /* scanner input file */ + +/*PLB #define lexval yylval */ +#define LEXERR 256 +#define LEXSKIP (-1) +/* + * #define LEXECHO(fp) {lexecho((fp));} + */ +extern int lexval; +extern int yyline; + +extern char llbuf[]; +extern char *llend; +#define lextext llbuf +#define lexlast llend + +#define _lmovb _lmvb +#define _lmovi _lmvi diff --git a/c20/lex/lex.hlp b/c20/lex/lex.hlp new file mode 100644 index 0000000000000000000000000000000000000000..3c6628a23be0bd1ace47051641b6cb83c552298a GIT binary patch literal 2506 zcmZWr!EPHj5cPS#Vz8IkfVD+W34$VkYrBPjBn2v`EnxUSaj6v%E-8>)*_*HLo8hix zXLXRY6gl(e&6`I#^FsW(q0i>UYUSw0D>o(+=}+TLR5`?|N}~^lWK&hiX1qC^dt8M> zw!x<-e6`d?)%Pm$L!dC^oppvEGG(>J*Q#nw($UJ9b0p*?9r^=yCsG_(V5k|!E`}cK zQ*=_krB`t%>`s`J7BmgfI+IP)wykNY57E$WaBd{)IYrY3{gHyl!jM#Fu>BOKM8`1% zdf4M!a4tMs-_cYqDMV98WgXY`v8q;Trlow|*~Gt4G&*$NGAiICAN=ZObGu%X-m3_- zCMLSn0SW07{rdj>3BnvM=&alo5JWOB+6Z&!!=#-`35PGSp{GY`n&#=M0iJdaP(JUy zz-i5P=sGThbJDZT`-u&ruZWs1uX9K;WOF$5x-ZNf>-S81k7T#9>Z?wq5xL_s>ItO{0%0|`oDu{@n{@<-YIMyYAj#LSdc&No6nYK8QWD%u`erypbPn1n&0w9Q4YRTq zAbv}^wV~O6LKHs_8{{D#%L9i|az^bC>y+te9fKr%991$S(Ne$~?{;KJq^moXVDVhv@rs*qYu5d8< z-46@})nfXrNuRRl7!FvrwPvRVw^ZrWh#G~XxsU_OV?>=j8jqnWDpACcn#FV?AFe{tNgo68V&*iar4Luw<{blT(Yos z&U9e4+?&`jFO)Ijz+3AJuCrCMm0g$FhL6^(To(lhv3SNDVx4_^1z%07svhKe6QXkn z;>$=j>yv2`Ey$ffmvb+;%N+fR`XS}XwRmVIUx!#>?DXLjXgg-H=`S`Vp0{&QWSbX@ zzjEhaEl$$?X_WzElN$1#|76X0Z}I1V{|o&QVjA=QwEiWu;^DL%>G!auJLCOW;Yx=j IE-o(q2T1?sh5!Hn literal 0 HcmV?d00001 diff --git a/c20/lex/lex.log b/c20/lex/lex.log new file mode 100644 index 00000000..678867a7 --- /dev/null +++ b/c20/lex/lex.log @@ -0,0 +1,172 @@ + + 20-Feb-83 17:48:20 + +BATCON Version 104(4205) GLXLIB Version 1(1137) + + Job LEX Req #6 for BUDNE in Stream 0 + + OUTPUT: Nolog TIME-LIMIT: 0:05:00 + UNIQUE: Yes BATCH-LOG: Supersede + RESTART: Yes ASSISTANCE: Yes + SEQUENCE: 3773 + + Input from => MSC:LEX.CTL.5 + Output to => MSC:LEX.LOG + + + +17:48:20 MONTR MRFORT - The Fortran Development System, TOPS-20 Monitor 5.1(5050) +17:48:20 MONTR Job 10 on TTY231 20-Feb-83 17:48:21 +17:48:21 USER FTN: mounted +17:48:21 USER LNK: mounted +17:48:21 USER TST: mounted +17:48:21 USER MSC: mounted, accessed +17:48:21 MONTR End of BATCH.CMD.2 +17:48:22 MONTR End of ORIGINAL.CMD.2 +17:48:22 MONTR @ +17:48:22 MONTR [CONNECTED TO MSC:] + ; BUILD DECUS LEX FOR TOPS-20 +17:48:23 MONTR @DEF C: MSC:, PS: +17:48:23 MONTR @@DEF SS: MSC: +17:48:23 MONTR +17:48:23 MONTR @@DEF CLIB: MSC: +17:48:23 MONTR +17:48:23 MONTR @@DEF SYS: SYS:, C: +17:48:23 MONTR +17:48:23 MONTR @ + +17:48:23 MONTR @i lo job +17:48:23 MONTR BP: => PS: +17:48:23 MONTR C: => MSC:,PS: +17:48:23 MONTR CLIB: => MSC: +17:48:23 MONTR DSK: => DSK:,ME: +17:48:23 MONTR F: => FTN:,M:,T: +17:48:23 MONTR LEX: => MSC: +17:48:23 MONTR M: => MSC: +17:48:23 MONTR ME: => M:,BP: +17:48:23 MONTR SS: => MSC: +17:48:23 MONTR SYS: => SYS:,C: +17:48:23 MONTR T: => TST: +17:48:23 MONTR U: => PS: +17:48:23 MONTR @@v sys:pcc20* +17:48:24 MONTR +17:48:24 MONTR MSC: +17:48:24 MONTR PCC20.EXE.1;P777700 37 18944(36) 21-Dec-82 20:34:39 BUDNE +17:48:24 MONTR .HLP.1;P777700 2 3227(7) 21-Dec-82 20:46:27 BUDNE +17:48:24 MONTR PCC20LIB.DIRECTORY.1;P20200 0 0(0) 18-Feb-83 14:15:18 BUDNE +17:48:24 MONTR +17:48:24 MONTR Total of 39 pages in 3 files +17:48:24 MONTR @@v c:pcc20* +17:48:24 MONTR +17:48:24 MONTR MSC: +17:48:24 MONTR PCC20.EXE.1;P777700 37 18944(36) 21-Dec-82 20:34:39 BUDNE +17:48:24 MONTR .HLP.1;P777700 2 3227(7) 21-Dec-82 20:46:27 BUDNE +17:48:24 MONTR PCC20LIB.DIRECTORY.1;P20200 0 0(0) 18-Feb-83 14:15:18 BUDNE +17:48:24 MONTR +17:48:24 MONTR Total of 39 pages in 3 files +17:48:25 MONTR @ + +17:48:25 MONTR @PCC20 BASE.C +17:48:27 USER ^[<^[[?2l"BASE.C", line 115: warning: illegal structure pointer combination, op = +17:48:31 USER "BASE.C", line 116: warning: illegal structure pointer combination, op RETURN +17:48:33 USER ^[<^[[?2l^[<^[[?2l^[<^[[?2l^[<^[[?2l@@PCC20 ECLOSU.C +17:48:40 USER ^[<^[[?2l^[<^[[?2l^[<^[[?2l^[<^[[?2l^[<^[[?2l +17:48:47 MONTR @@PCC20 MIN.C +17:48:52 USER ^[<^[[?2l"MIN.C", line 74: warning: illegal pointer combination, op = +17:48:55 USER "MIN.C", line 75: warning: illegal pointer combination, op = +17:48:56 USER "MIN.C", line 76: warning: illegal pointer combination, op = +17:48:56 USER "MIN.C", line 93: warning: illegal pointer combination, op = +17:48:56 USER "MIN.C", line 96: warning: illegal pointer combination, op - +17:48:56 USER "MIN.C", line 126: warning: illegal pointer combination, op = +17:48:57 USER "MIN.C", line 130: warning: illegal pointer combination, op - +17:48:57 USER "MIN.C", line 132: warning: illegal pointer/integer combination, op = +17:48:57 USER "MIN.C", line 136: warning: illegal pointer combination, op - +17:48:57 USER "MIN.C", line 138: warning: illegal pointer/integer combination, op = +17:48:57 USER "MIN.C", line 143: warning: illegal pointer combination, op = +17:48:58 USER ^[<^[[?2l^[<^[[?2l^[<^[[?2l^[<^[[?2l@@PCC20 DFA.C +17:49:08 USER ^[<^[[?2l"DFA.C", line 52: warning: illegal pointer combination, op = +17:49:11 USER "DFA.C", line 62: warning: illegal pointer combination, op = +17:49:12 USER "DFA.C", line 70: warning: struct/union or struct/union pointer required +17:49:12 USER "DFA.C", line 72: warning: illegal pointer combination, op = +17:49:12 USER "DFA.C", line 79: warning: illegal pointer combination, op = +17:49:12 USER "DFA.C", line 83: warning: struct/union or struct/union pointer required +17:49:12 USER "DFA.C", line 84: warning: struct/union or struct/union pointer required +17:49:12 USER "DFA.C", line 84: warning: illegal pointer/integer combination, op = +17:49:12 USER "DFA.C", line 85: warning: illegal pointer/integer combination, op = +17:49:12 USER "DFA.C", line 86: warning: struct/union or struct/union pointer required +17:49:12 USER "DFA.C", line 87: warning: illegal pointer combination, op = +17:49:13 USER "DFA.C", line 101: warning: struct/union or struct/union pointer required +17:49:13 USER "DFA.C", line 102: warning: struct/union or struct/union pointer required +17:49:14 USER "DFA.C", line 165: warning: illegal pointer/integer combination, op = +17:49:14 USER "DFA.C", line 167: warning: illegal pointer/integer combination, op RETURN +17:49:14 USER "DFA.C", line 171: warning: illegal pointer/integer combination, op = +17:49:14 USER "DFA.C", line 172: warning: illegal pointer/integer combination, op RETURN +17:49:14 USER "DFA.C", line 194: warning: illegal pointer/integer combination, op RETURN +17:49:14 USER "DFA.C", line 199: warning: illegal pointer/integer combination, op RETURN +17:49:14 USER ^[<^[[?2l^[<^[[?2l^[<^[[?2l^[<^[[?2l@@PCC20 OUT.C +17:49:25 USER ^[<^[[?2l"OUT.C", line 144: warning: illegal pointer/integer combination, op = +17:49:30 USER "OUT.C", line 165: warning: illegal pointer/integer combination, op RETURN +17:49:31 USER "OUT.C", line 199: warning: illegal pointer/integer combination, op RETURN +17:49:35 USER ^[<^[[?2l^[<^[[?2l^[<^[[?2l^[<^[[?2l@@PCC20 LEX.C +17:49:47 USER ^[<^[[?2l"LEX.C", line 208: warning: illegal pointer/integer combination, op = +17:49:52 USER "LEX.C", line 209: warning: illegal pointer/integer combination, op = +17:49:53 USER "LEX.C", line 290: warning: illegal pointer/integer combination, op = +17:49:54 USER "LEX.C", line 295: warning: illegal pointer/integer combination, op = +17:49:54 USER "LEX.C", line 298: warning: illegal pointer/integer combination, op = +17:49:55 USER "LEX.C", line 403: warning: illegal pointer/integer combination, op RETURN +17:49:56 USER "LEX.C", line 472: warning: illegal pointer combination, op = +17:49:56 USER "LEX.C", line 489: warning: illegal pointer/integer combination, op = +17:49:59 USER ^[<^[[?2l^[<^[[?2l^[<^[[?2l^[<^[[?2l@@PCC20 YTAB.C +17:50:12 USER ^[<^[[?2l"lex.y", line 65: warning: illegal pointer/integer combination, op = +17:50:15 USER "lex.y", line 66: warning: illegal pointer/integer combination, op = +17:50:15 USER "lex.y", line 77: warning: illegal pointer combination, op = +17:50:15 USER "lex.y", line 90: warning: illegal pointer/integer combination, op = +17:50:15 USER "lex.y", line 98: warning: illegal pointer/integer combination, op = +17:50:16 USER "lex.y", line 104: warning: illegal pointer/integer combination, op = +17:50:16 USER "lex.y", line 107: warning: illegal pointer/integer combination, op = +17:50:16 USER "lex.y", line 110: warning: illegal pointer/integer combination, op = +17:50:16 USER "lex.y", line 113: warning: illegal pointer/integer combination, op = +17:50:17 USER "lex.y", line 116: warning: illegal pointer/integer combination, op = +17:50:17 USER "lex.y", line 119: warning: illegal pointer/integer combination, op = +17:50:17 USER "YTAB.C", line 169: warning: illegal pointer combination, op = +17:50:17 USER "YTAB.C", line 169: warning: illegal pointer/integer combination, op = +17:50:17 USER "lex.y", line 134: warning: illegal pointer/integer combination, op = +17:50:17 USER "lex.y", line 134: warning: illegal pointer/integer combination, op = +17:50:18 USER "lex.y", line 143: warning: illegal pointer/integer combination, op = +17:50:18 USER "lex.y", line 143: warning: illegal pointer/integer combination, op = +17:50:18 USER "lex.y", line 148: warning: illegal pointer/integer combination, op = +17:50:18 USER "lex.y", line 154: warning: illegal pointer/integer combination, op = +17:50:20 USER "lex.y", line 197: warning: illegal pointer/integer combination, op = +17:50:20 USER "YTAB.C", line 269: warning: illegal pointer/integer combination, op = +17:50:20 USER "YTAB.C", line 269: warning: illegal pointer/integer combination, op = +17:50:21 USER "lex.y", line 248: warning: illegal pointer/integer combination, op = +17:50:22 USER "lex.y", line 290: warning: illegal pointer/integer combination, op = +17:50:22 USER "lex.y", line 300: warning: illegal pointer/integer combination, op = +17:50:22 USER "lex.y", line 341: warning: illegal pointer/integer combination, op = +17:50:24 USER "lex.y", line 403: warning: illegal pointer/integer combination, op = +17:50:24 USER "lex.y", line 421: warning: illegal pointer/integer combination, op = +17:50:24 USER "lex.y", line 431: warning: illegal pointer combination, op = +17:50:25 USER "lex.y", line 503: warning: illegal pointer combination, op = +17:50:32 USER ^[<^[[?2l^[<^[[?2l^[<^[[?2l^[<^[[?2l@@PCC20 LEXSRT.C +17:50:46 USER ^[<^[[?2l^[<^[[?2l^[<^[[?2l^[<^[[?2l^[<^[[?2l +17:50:55 MONTR @@PCC20 IMPURE.C +17:50:59 USER ^[<^[[?2l^[<^[[?2l^[<^[[?2l^[<^[[?2l^[<^[[?2l +17:51:07 MONTR @ + +17:51:07 MONTR @STINKR +17:51:09 USER ^[<^[[?2l =^[K*X LEX +17:51:09 USER X LEX +17:51:19 USER =^[K*Q +17:51:19 USER Q +17:51:33 USER +17:51:33 USER --- Segments --- +17:51:33 USER +17:51:33 USER 0 0140 - 0156667 (0156530=56664) +17:51:33 USER 1 0157000 - 0214227 (035230=15000) +17:51:33 USER 2 0214230 - 0215136 (0707=455) +17:51:33 USER 3 0215137 - 0220173 (03035=1565) +17:51:35 USER ^[<^[[?2l^[<^[[?2l +17:51:36 MONTR @@ +17:51:42 MONTR Killed by OPERATOR, TTY 222 +17:51:42 MONTR Killed Job 10, User BUDNE, Account , TTY 231, +17:51:42 MONTR at 20-Feb-83 17:51:42, Used 0:01:24 in 0:03:21 diff --git a/c20/lex/lex.mem b/c20/lex/lex.mem new file mode 100644 index 00000000..75ac3223 --- /dev/null +++ b/c20/lex/lex.mem @@ -0,0 +1,1717 @@ +No Viginia, this file in not empty... + + + + + + + + + + + + + + + + + + + + + + + + + + + + DECUS C LANGUAGE SYSTEM + + + LEX + A lexical Analyser Generator + + + by + + Charles H. Forsyth + + University of Waterloo + Waterloo, Ontario, N2L 3G1 + Canada + + + Revised by + + Robert B. Denny & Martin Minow + + + LEX transforms a regular-expression grammar and associated + action routines into a C function and set of tables, yielding a + table-driven lexical analyser which manages to be compact and + rapid. + + + DECUS Structured Languages SIG + + Version of 30-Oct-82 + + + + + + + + + + Copyright (C) 1978, Charles H. Forsyth + + + + + + Modifications Copyright (C) 1980, 1982, DECUS + + General permission to copy or modify, but not for + profit, is hereby granted, provided that the above + copyright notice is included and reference made to the + fact that reproduction privileges were granted by DECUS. + + The information in this document is subject to change + without notice and should not be construed as a + commitment by Digital Equipment Corporation or by DECUS. + + Neither Digital Equipment Corporation, DECUS, nor the + authors assume any responsibility for the use or + reliability of this document or the described software. + + This software is made available without any support + whatsoever. The person responsible for an + implementation of this system should expect to have to + understand and modify the source code if any problems + are encountered in implementing or maintaining the + compiler or its run-time library. The DECUS 'Structured + Languages Special Interest Group' is the primary focus + for communication among users of this software. + + + + + + + + + + UNIX is a trademark of Bell Telephone Laboratories. RSX, + RSTS/E, RT-11 and VMS are trademarks of Digital Equipment + Corporation. + + A Lexical Analyser Generator Page 3 + + + 1.0 Introduction ____________ + + + A computer program often has an input stream which is composed + of small elements, such as a stream of characters, and which it + would like to convert to larger elements in order to process the + data conveniently. A compiler is a common example of such a + program: it reads a stream of characters forming a program, and + would like to turn this sequence of characters into a sequence + of larger items, namely identifiers, numbers, and operators, for + parsing. In a compiler, the procedures which do this are + collectively called the lexical analyser, or scanner; this _______ ________ _______ + terminology will be used more generally here. + + It may happen that the speed with which this transformation is + done will noticeably affect the speed at which the rest of the + program operates. It is certainly true that although such code + is rarely difficult to write, writing and debugging it is both + tedious, and time-consuming, and one typically would rather + spend the time on the hard parts of the program. It is also + true that while certain transformations are easily thought of, + they are often hard to express succinctly in the usual + general-purpose programming languages (eg, the description of a + floating-point number). + + LEX is a program which tries to give a programmer a good deal of + help in this, by writing large parts of the lexical analyser + automatically, based on a description supplied by the programmer + of the items to be recognised (which are known as tokens), as ______ + patterns of the more basic elements of the input stream. The + LEX description is very much a special-purpose language for + writing lexical analysers, and LEX is then simply a translator + for this language. The LEX language is easy to write, and the + resulting processor is compact and fast running. + + The purpose of a LEX program is to read an input stream, and + recognise tokens. As the lexical analyser will usually exist as ______ + a subroutine in a larger set of programs, it will return a + "token number", which indicates which token was found, and + possibly a "token value", which provides more detailed + information about the token (eg, a copy of the token itself, or + an index into a symbol table). This need not be the only + possibility; a LEX program is often a good description of the + structure of the whole computation, and in such a case, the + lexical analyser might choose to call other routines to perform + the necessary actions whenever a particular token is recognised, + without reference to its own caller. + A Lexical Analyser Generator Page 4 + + + 2.0 The Lex Language ___ ___ ________ + + LEX transforms a regular-expression grammar into a deterministic + finite-state automaton that recognizes that grammar. Each rule + of the grammar is associated with an action which is to be + performed when that rule successfully matches some part of the + input data. + + Because of the nature of regular expression grammars, certain + language constructions cannot be recognized by LEX programs. + Specifically, expressions with balanced parentheses cannot be + recognized. This means that LEX cannot be used to recognize all + Fortran keywords as some (DO, IF, and FORMAT, for example) + require elaborate recognition to distinguish between ambiguous + constructions. + + + + 2.1 Elementary Things __________ ______ + + + Strings, characters, sets of characters called character + classes, and operators to form these into patterns, are the + fundamental elements of the LEX language. + + A string is a sequence of characters, not including newline, ______ + enclosed in quotes, or apostrophes. Within a string, the + following escape sequences + (which are those of the C language) allow any 8-bit character to + be represented, including the escape character, quotes, and + newlines: + + \n NL (012) + \r CR (015) + \b BS (010) + \t TAB (011) + \" " + \' ' + \c c + \\ \ + \NNN (NNN) + + where NNN is a number in octal, and c is any printable _ + character. A string may be continued across a line by writing + the escape character before the newline. + + Outside a string, a sequence of upper-case letters stands for a + sequence of the equivalent lower-case letters, while a sequence __________ + of lower-case letters is taken as the name of a LEX expression, + and handled specially, as described below. These conventions + make the use of named expressions and the description of + lower-case keywords (the usual case on Unix) fairly convenient. + Keywords in case-independent languages, such as Fortran, require + additional effort to match, as will be noted. + A Lexical Analyser Generator Page 5 + + + An Ascii character other than one of + + () {} [ * | = ; % / \ ' " - + + may be used in LEX to stand for itself. + + A sequence of characters enclosed by brackets ('[' and ']') + forms a character class, which stands for all those characters + within the brackets. If a circumflex ('^') follows the opening + bracket, then the class will instead stand for all those + characters but those inside the brackets. The escapes used in ___ + strings may be used in character classes as well. + + Within a character class, the construction "A-B" (where "A" and + "B" are arbitrary characters) stands for the range of characters + between "A" and "B" inclusive. + + For example, + + "ABC" matches "abc" + + "[ABC]" matches "A" or "B" or "C" + + "[A-Za-z0-9]" matches all letters and digits + + Case-independent keyword recognition may be described by using + auxiliary definitions to define expressions that match either + case. For example, + + a = [Aa]; + b = [Bb]; + ... + z = [Zz]; + %% + d o Matches "DO", "do", "Do", or "dO" + + + + + 2.2 Putting Things Together _______ ______ ________ + + + Several operators are provided to allow construction of a type + of pattern called a regular expression. Such expressions can be _______ __________ + implemented as finite-state automata (without memory or stacks). + A reference to an "occurrence" of a regular expression is + generally taken to mean an occurrence of any string matched by + that regular expression. The operators are presented in order + of decreasing priority. In all cases, operators work on either + strings or character classes, or on other regular expressions. + + Any string or character class forms a regular expression which + matches whatever the string or character class stands for (as + described above). + A Lexical Analyser Generator Page 6 + + + The operator '*' applied following a regular expression forms a + new regular expression which matches an arbitrary number (ie, + zero or more) of adjacent occurrences of the first regular + expression. The operation is often referred to as (Kleene) + closure. + + The operation of concatenation of two regular expressions is _____________ + expressed simply by writing the regular expressions adjacent to + each other. The resulting regular expression matches any + occurrence of the first regular expression followed directly by + an occurrence of the second regular expression. + + The operator '|', alternation, written between two regular ___________ + expressions forms a regular expression which matches an + occurrence of the first regular expression or an occurrence of + the second regular expression. + + Any regular expression may be enclosed in parentheses to cause + the priority of operators to be overridden in the usual manner. + + A few examples should help to make all of this clear: + + "[0-9]*" matches a (possibly empty) sequence of + digits. + + "[A-Za-z_$][A-Za-z0-9_$]*" + matches a C identifier. + + "([A-Za-z_$]|[0-9])*" + matches a C identifier, or a sequence of + digits, or a sequence of letters and + digits intermixed, or nothing. + + + + + 2.3 The General Form of Lex Programs ___ _______ ____ __ ___ ________ + + + A LEX source input file consists of three sections: a section + containing auxiliary definitions, a section containing _________ ___________ + translations, and a section containing programs. ____________ ________ + + Throughout a LEX program, spaces, tabs, and newlines may be used + freely, and PL/1-style comments: + + /* ... anything but '*/' ... */ + + may be used, and are treated as a space. + + The auxiliary definition section must be present, separated from _________ __________ + following sections by the two-character sequence '%%', but may + be empty. This section allows definition of named regular + expressions, which provide the useful ability to use names of + regular expressions in the translation section, in place of + A Lexical Analyser Generator Page 7 + + + common sub-expressions, or to make that section more readable. + + The translation section follows the '%%' sequence, and contains ___________ + regular expressions paired with actions which describe what the _______ + lexical analyser should do when it discovers an occurrence of a + given regular expression in its input stream. + + The program section may be omitted; if it is present it must be _______ + separated from the translation section by the '%%' sequence. If + present, it may contain anything in general, as it is simply + tacked on to the end of the LEX output file. + + The style of this layout will be familiar to users of Yacc. As + LEX is often used with that processor, it seemed reasonable to + keep to a similar format. + + + + 2.4 Auxiliary Definitions _________ ___________ + + + Given the set of regular expressions forming a complete syntax, + there are often common sub-expressions. LEX allows these to be + named, defined but once, and referred to by name in any + subsequent regular expression. Note that definition must + precede use. A definition has the form: + + expression_name = regular_expression ; + + where a name is composed of a lower-case letter followed by a + sequence string of letters and digits, and where an underscore + is considered a letter. For example, + + digit = [0-9]; + letter = [a-zA-Z]; + name = letter(letter|digit)*; + + The semicolon is needed to resolve some ambiguities in the LEX + syntax. + + Three auxiliary definitions have special meaning to LEX: + "break", "illegal", and "ignore." They are all defined as + character classes ("break = [,.?]", for example) and are used as + follows: + + break An input token will always terminate if a member + of the "break" class is scanned. + + illegal The "illegal" class allows simplification of + error detection, as will be described in a later + section. If this class is defined, and the + lexical analyser stops at a character that + "cannot" occur in its present context, the + analyser will output a suitable error message + and ignore the offender. + A Lexical Analyser Generator Page 8 + + + ignore This class defines a set of characters that are + ignored by the analyser's input routine. + + + + + 2.5 Translations ____________ + + + One would like to provide a description of the action to be + taken when a particular sequence of input characters has been + matched by a given regular expression. The kind of action taken + might vary considerably, depending upon the application. In a + compiler, typical actions are: enter an identifer into a symbol + table, read and store a string, or return a particular token to + the parser. In text processing, one might wish to reproduce + most of the input stream on an output stream unchanged, making + substitutions when a particular sequence of characters is found. + In general, it is hard to predict what form the action might + take, and so, in LEX the nature of the action is left to the + user, by allowing specification, for each regular expression of + interest, C-language code to be executed when a string matching + that expression is discovered by the driving program of the + lexical analyser. An action, together with its regular + expression, is called a translation, and has the format: ___________ + + regular_expression { action } + + All of this may be spread across several lines. The action may + be empty, but the braces must appear. + + Earlier, it was argued that most general-purpose languages are + inappropriate for writing lexical analysers, and it is important + to see that the subsequent use of such a language to form the + actions is not a contradiction. Most languages are fairly good + at expressing the actions described above (symbol table + manipulation, writing character strings, and such). Leaving + this part of the lexical analyser to those languages therefore + not only makes sense, but also ensures that decisions by the + writer of the lexical analyser generator will not unduly cramp + the user's style. However, general-purpose languages do not as + a rule provide inexpensive pattern matching facilities, or input + description formats, appropriate for describing or structuring a + lexical analyser. + + Allowing a user to provide his own code is not really enough, as + he will need some help from LEX to obtain a copy of, or a + pointer to, the current token, if nothing else. LEX provides a + library of C functions which may be called to obtain controlled + access to some of the data structures used by the driving + programs of the lexical analyser. These are described in a + later section. + A Lexical Analyser Generator Page 9 + + + 2.5.1 Numbers and Values - _______ ___ ______ + + Typically, a lexical analyser will return a value to its caller + indicating which token has been found. Within an action, this + is done by writing a C return statement, which returns the ______ + appropriate value: + + BEGIN { + return(T_BEGIN); + } + name { + lookup(token(NULL)); + return(T_NAME); + } + "/" { + return('/'); + } + + Note that function lookup() is provided by the user program. + + In many cases, other information must be supplied to its caller + by the scanner. When an identifier is recognised, for example, + both a pointer to a symbol-table entry, and the token number + T_NAME must be returned, yet the C return statement can return ______ + but a single value. Yacc has a similar problem, and so its + lexical analyser sets an external word 'yylval' to the token + value, while the token number is returned by the scanner. LEX + uses the external 'yylval' (to be compatible), but, to make LEX + programs more readable when used alone, the name 'lexval' is set + by a #define statement to 'yylval'. For example, + + name { + lexval = lookup(token(NULL)); + return(T_NAME); + } + + + Certain token numbers are treated specially; these are + automatically defined as manifests (see section 3.2) by LEX, and + all begin with the sequence 'LEX...' so as not to clash with the + user's own names. There are two such tokens defined at present: + + LEXSKIP When returned by a user's action routine, + LEXSKIP causes the lexical analyser to ignore + the current token (ie, it does not inform the + parser of its presence), and to look instead for + a new token. This may be used when a comment + sequence has been discovered, and discarded. It + is also useful when the action routine completes + processing of the token. See the discussion of + the comment() library function for an example of + its usage. + + LEXERR This is returned by the lexical analyser + (function yylex()) when an unrecognizable input + A Lexical Analyser Generator Page 10 + + + sequence has been detected. By default, LEXERR + is 256. This the same as the yacc error value. + + + To summarise, the token number is set by the action with a + return statement, and the token value (ie, auxiliary ______ + information) is set by assigning this value to the external + integer 'lexval'. + + + + 2.6 Declaration Sections ___________ ________ + + + Declarations in the language of the actions may be included in + both the auxiliary definition section and in the translation + section. In the former case, these declarations will be + external to the lexical analyser, and in the latter case, they + will be local to the lexical analyser (ie, static, or automatic + storage). Declaration sections consist of a sequence of + declarations surrounded by the special bracketing sequences '%{' + and '%}' (as in Yacc). The characters within these brackets are + copied unchanged into the appropriate spots in the lexical + analyser program that LEX writes. The examples in appendix A + suggest how these might be used. + + + + 3.0 Using Lex from C _____ ___ ____ _ + + + The present version of LEX is intended for use with C; and it + is this usage which will be described here. + + + + 3.1 The Function yylex() ___ ________ _______ + + + The structure of LEX programs is influenced by what Yacc + requires of its lexical analyser. + + To begin with, the lexical analyser must be named 'yylex', has + no parameters, and is expected to return a token number, where + that number is determined by Yacc. The token number for an + Ascii character is its Ascii value (ie, its value as a C + character constant). Named tokens, defined in yacc '%token' + statements, have a number above 256, with the particular number + accessible through a Yacc-produced #define of the given token + name as its number. Yacc also allows 'yylex' to pass a value to + the Yacc action routines, by assigning that value to the + external 'yylval'. + + LEX thus provides a lexical analyser function named 'yylex', + which interprets tables constructed by the LEX program returning + A Lexical Analyser Generator Page 11 + + + the token number returned by the actions it performs. Values + assigned to lexval are available in 'yylval', so that use with + Yacc is straightforward. + + A value of zero is returned by 'yylex' at end-of-file, and in + the absence of a return statement in an action, a non-zero value ______ + is returned. If computation is performed entirely by the + lexical analyser, then a suitable main program would be + + main() + { + while (yylex()) ; + } + + + + + 3.2 Serial Re-Use of yylex() ______ ______ __ _______ + + + The yylex() function contains several variables which are + statically initialized at compile time. Once yylex() sees an + EOF (-1) input character, it will continue to return NULL. If + yylex() is to be used inside a loop which processes multiple + files, it must be re-initialized at the beginning of each new + file with a call to the LEX library routine llinit(). For + example (slightly extending the previous example): + + main() + { + getfilelist(); + for(file = first; file != last; file = next) + { + llinit(); + while (yylex()); + } + printf("All files done\n"); + } + + The call to llinit() is unnecessary if yylex() is to process + only one file, or is kept from seeing an EOF input character. + + + + 3.3 The Lex Table File ___ ___ _____ ____ + + + In the absence of instructions to the contrary (see below), LEX + reads a given LEX language file, (from the standard input, if an + input file has not been specified) and produces a C program file + 'lextab.c' which largely consists of tables which are then + interpreted by 'yylex()' (which is in the LEX library). The + actions supplied by the user in each translation are combined + with a switch statement into a single function, which is called ______ + by the table interpreter when a particular token is found. The + A Lexical Analyser Generator Page 12 + + + contents of the program section of the LEX file are added at the + end of the output file (lextab.c by default). Normally, LEX + also inserts the lines + + #include + #include + + at the top of the file; this causes declarations required by + the standard I/O library and by LEX to be included when the C + program is compiled. + + + + 3.4 Analyzers Which Don't Use "Standard I/O" _________ _____ _____ ___ _________ ____ + + + With the current release, LEX supports the generation of + analyzers which may be incorporated into programs which do not + use the "standard I/O" library. By setting the "-s" switch, as + shown below, the generation of the "#include " line is + supressed. All references to standard I/O specific files and + stdio.h have been removed from the LEX library (described in a + later section), with the exception of lexgetc(), lexerror(), + mapch() and lexecho(), which are standard I/O dependent. + + The declaration of yylex()'s input file iov pointer "lexin" now + resides in LEXGET.C (lexgetc()). The code which defaults lexin + to stdin has been moved from yylex() to the table file. yylex() + now calls the routine llstin(), which is generated into the + table file. There are no longer any hardwired references to the + variable "lextab", the default table name. Instead, LEX + generates a call to lexswitch() in llstin(), which initializes + yylex() to use the table whose name was given in a "-t" or "-e" + option in LEX's command line. If neither was given, the default + name "lextab" is used. Once the initial table has been set up, + further automatic calls to lexswitch() are supressed, allowing + the user to manually switch tables as before. + + In addition, If the "-s" switch is not given (i.e., normal use + with standard I/O), llstin() defaults lexin to stdin. If "-s" + is given, llstin() is generated to do the lexswitch() mentioned + above only. In any case, yylex() contains no references to the + standard I/O system. + + What all of this means is that under normal operation, you won't + notice any change in LEX's characteristics. In addition, you + may use the "-e" ("easy") switch, which will generate a C output + file and LEX tables which (conveniently) have the same name as + the input file, and everything will get set up automagically. + If you specify the "-s" switch, the table file will contain no + references to the standard I/O package, and you may use any of + the lexlib routines except lexgetc(), lexerror(), mapch() or + lexecho(). + + Don't forget that you must supply your own startup routine + A Lexical Analyser Generator Page 13 + + + "$$main" if you do not want the standard I/O library. With a + bit of care in this regard, it will be possible to link your + program with the C library without dragging in any I/O modules. + This prevents your having to build another library in order to + access non-I/O library functions. Just make the reference to + the C library the last one given to the linker or taskbuilder so + that only those routines which have not already been found are + pulled from CLIB. + + + NOTE + + Programs that use LEX-generated analyzers and do not use + the standard I/O package must supply their own lexgetc() + and lexerror() routines. Failure to do so will result + in undefined globals. + + + + + + 3.5 Operating LEX _________ ___ + + + LEX normally reads the grammar from the standard input, writing + the C program to the file 'lextab.c'. It may be further + controlled by using the following flags upon invocation: + + -i filename The grammar is read from 'filename'. + + -o filename The analyser is written to 'filename'. + + -t tablename The default finite-state automaton is + named lextab (and it is, by default, + written to file 'lextab.c'). The -t + switch causes the internal tables to be + named 'tablename' and, if the -o switch + is not given, written to file + 'tablename.c'. This is necessary if the + processor-switching capabilities + described in a later section are to be + used. + + -e name "Easy" command line. "-e name" is + equivalent to typing + + -i name.LXI -o name.C -t name + + Do not include device names or file + extensions on the "easy" command line. + + -v [filename] Internal state information is written to + 'filename.' If not present, state + information is written to file + 'lex.out.' + A Lexical Analyser Generator Page 14 + + + -d Enable various debugging printouts. + + -s Generate analyzer without references to + standard I/O + + + The command line for compilation of the table file should + contain no surprises: + + cc -c -O lextab.c (on Unix) + + xcc lextab -a (on Dec operating systems) + + but when one is producing the running program, one must be + careful to include the necessary libraries. On Unix, the proper + sequence is: + + cc userprog.o lextab.o -ll -lS + + The '-ll' causes the LEX library (described below) to be + searched, and the '-lS' causes the Standard I/O library to be + used; both libraries are required. If Yacc is used as well, + the library '-ly' should be included before the '-ll'. The ______ + actual order and content of the rest of the command line is + determined by the user's own requirements. + + If using the Decus C compiler, the lexical analyser built by LEX + is linked with c:lexlib. + + The complete process (assuming the Decus compiler running on + RSTS/E in RT11 mode) is thus: + + mcr lex -i grammar.lxi -o grammar.c ! Build analyser + cc grammar ! Compile the + as grammar ! grammar table + link out=in,grammar,c:lexlib,c:suport,c:clib/b:2000 + + + + + 4.0 The Lex Library ___ ___ _______ + + + All programs using grammars generated by LEX must be linked + together with the LEX library. On Unix, this is '/lib/libl.a' + (or '-ll' on the cc command line) and on DEC operating systems, + C:LEXLIB (LB:[1,1]LEX.OLB for RSX). It contains routines which + are either essential or merely useful to users of LEX. The + essential routines include a routine to obtain a copy of the + current token, and a routine to switch to a different set of + scanning tables. Routines of the second, useful, class perform + functions which might well be written by the user himself, but + are there to save him the bother; including a routine to + process various forms of comments and a routine to transform + numbers written in arbitrary bases. Both sets of routines are + A Lexical Analyser Generator Page 15 + + + expected to grow as LEX sees use. + + Those functions which produce diagnostics do so by calling + lexerror(), which is called as + + lexerror(string, arg1, ..., argN) + + and is expected to write its arguments (likely using the "remote + format" facility of the fprintf() function), followed by a + newline, on some output stream. A Lexerror() function is + included in the LEX library, but a user is free to include his + own. The routine in the LEX library is standard I/O specific. + + + NOTE + + The VAX/VMS native C library does not support remote + formats. The Lexerror function in the LEX library + conditionally compiles to support a call to lexerror() + with only an error message string. Remote formats are + supported under Decus C. Learn to use them, they are + very nice! + + + + + + 4.0.1 Comment -- skip over a comment - _______ __ ____ ____ _ _______ + + comment(delim) + char delim[]; + + Comment() may be called by a translation when the sequence of + characters which mark the start of a comment in the given syntax + has been recognised by LEX. It takes a string which gives the + sequence of characters which mark the end of a comment, and + skips over characters in the input stream until this sequence is + found. Newlines found while skipping characters cause the + external 'yyline' to be incremented; an unexpected end-of-file + produces a suitable diagnostic. Thus, 'comment("*/")' matches + C-style comments, and 'comment("\n")' matches as-style comments. + There are other methods of handling comments in LEX; the + comment() function is usually the best with regard to both space + and time. + + + + 4.0.2 Gettoken -- obtain a copy of token - ________ __ ______ _ ____ __ _____ + + gettoken(buf, sizeof(buf)) + char buf[]; + + Gettoken() takes the address of a character buffer, and its size + in bytes, and copies the token most recently matched by LEX into + the buffer. A null byte is added to mark the end of the token + A Lexical Analyser Generator Page 16 + + + in the buffer, but, as null bytes are legitimate characters to + LEX, the true length of the token is returned by gettoken(). + + For example, the following function calls lexlength() to obtain + the length of a token. It then calls the storage allocator to + allocate sufficient storage for the token and copies the token + into the allocated area. + + char * + save() + /* + * Save current token, return a pointer to it + */ + { + register char *tbuffer; + register int len; + register char *tend; + extern char *token(); + extern char *copy(); + + len = lexlength() + 1; + if (tbuffer = malloc(len)) == NULL) + error("No room for token"); + gettoken(tbuffer, len); + return(tbuffer); + } + + + + + 4.0.3 Integ -- long integer, any base - _____ __ ____ ________ ___ ____ + + long + integ(nptr, base) + char *nptr; + + Integ() converts the Ascii string at 'nptr' into a long integer, + which it returns. Conversion stops at the first non-digit, + where the digits are taken from the class "[0-9a-zA-Z]" as + limited by the given 'base'. Integ() does not understand signs, + nor are blanks or tabs allowed in the string. + + + + 4.0.4 Lexchar -- steal character - _______ __ _____ _________ + + lexchar() + + Lexchar() returns the next character from the LEX input stream. + (This means that LEX will no longer see it.) LEX uses a + look-ahead buffer to handle complex languages, and this function + takes this into account. + A Lexical Analyser Generator Page 17 + + + 4.0.5 Lexecho -- write token to a file (STDIO ONLY) - _______ __ _____ _____ __ _ ____ ______ _____ + + lexecho(fp); + FILE *fp; + + Lexecho() may be called by a LEX action routine to write the + current token to a specified file. + + + NOTE + + Programs using analyzers built with LEX's "-s" switch + must supply their own lexecho() function if needed. + + + + + + 4.0.6 Lexgetc -- supply characters to yylex (STDIO ONLY) - _______ __ ______ __________ __ _____ ______ _____ + + lexgetc() + + Lexgetc() is called by the lexical analyser to obtain characters + from its input stream. The version in the library is dependent + on the standard I/O package, and is: + + FILE *lexin; /* Declare iov address locally */ + lexgetc() + { + return(getc(lexin)); + } + + If lexin is NULL when yylex() is entered, it will be assigned to + stdin. This is done by yylex() calling the function llstin(), + which is generated in the table file. Unless the "-s" switch is + given to LEX, the llstin() function assigns lexin to stdin if + lexin is NULL. If the "-s" switch was given, the llstin() + routine is a no-op. The user may provide his own version of + lexgetc() to pre-process the data to the lexical analyser. An + example of this is shown in the appendix. + + + NOTE + + Programs using analyzers built with LEX's "-s" switch + must supply their own lexgetc() function, and "lexin" + has no meaning in this context. + + + A Lexical Analyser Generator Page 18 + + + 4.0.7 Lexlength -- return length of a token. - _________ __ ______ ______ __ _ ______ + + lexlength(); + + Lexlength() may be called by a LEX action routine to obtain the + length of the current token in bytes. An example of this is + shown in the description of gettoken(). + + + + 4.0.8 Lexpeek -- examine character - _______ __ _______ _________ + + lexpeek() + + Lexpeek() performs a function similar to that of Lexchar(), but + does not have the side-effect of removing the character from + LEX's view. + + + + 4.0.9 Lexswitch -- switch scanning tables - _________ __ ______ ________ ______ + + struct lextab * + lexswitch(newtb) + struct lextab *newtb; + + Lexswitch() is called to cause LEX to use a different scanning + table; it returns a pointer to the one previously in use. This + facility is useful if certain objects of the language (eg, + strings in C) have a fairly complicated structure of their own + which cannot be handled within the translation section of the + LEX description of the larger language. + + + + 4.0.10 Llinit -- Reinitialize yylex() - ______ __ ____________ _______ + + llinit() + + Llinit() is a function which resets the state of yylex() to it's + cold-start condition. Several of yylex()'s variables are + initialized at compile time, and must be reinitialized if it is + to be serially re-used. An example of this is where yylex() is + repeatedly called inside a loop which processes multiple input + files. Each time a new file is started, llinit() must be called + before the first call to yylex() for the new file. + A Lexical Analyser Generator Page 19 + + + 4.0.11 Mapch -- Handle C escapes within strings (STDIO ONLY) - _____ __ ______ _ _______ ______ _______ ______ _____ + + int mapch(delim, esc) + char delim; + char esc; + + Mapch() is a function which handles C "escape" characters such + as "\n" and "\nnn". It will scan off the entire escape sequence + and return the equivalent ASCII code as an integer. It is meant + for use with YACC while scanning quoted strings and character + constants. + + If it encounters EOF while scanning, it calls lexerror() to + print an error message warning of "Unterminated string". If a + normal character is read, it returns the ASCII value. If + "delim" (usually " or ') is read, it returns EOF. If a newline + (ASCII linefeed) is read, it increments the global "yyline" and + calls itself recursively for the next line of input. It may use _____ ______ ___________ + the ungetc() function to back up in the input stream. + + + NOTE + + This routine is very application-specific for use by LEX + and YACC when they are working together. You should + read the code in MAPCH.C before using this function. + + + + + + 4.0.12 Token -- get pointer to token - _____ __ ___ _______ __ _____ + + char * + token(end_pointer) + char **end_pointer; + + Token() locates the first byte of the current token and returns + its address. It takes an argument which is either NULL or a + pointer to a character pointer; if the latter, that pointer is + set to point to the byte after the last byte of the current _____ + token. Token() is slightly faster, and more convenient than + gettoken() for those cases where the token is only one or two + bytes long. + + + + + 5.0 Error Detection and Recovery _____ _________ ___ ________ + + + If a character is detected in the input stream which cannot be + added to the last-matched string, and which cannot start a + string, then that character is considered illegal by LEX. LEX + may be instructed to return a special 'error' token, or to write + A Lexical Analyser Generator Page 20 + + + a diagnostic with lexerror(). At present, the former is the + default action. + + The token LEXERR is a special value which is recognised by Yacc, + and causes it to start its own error recovery. It is defined by + the header file lex.h for use by other programs. + + Often, it makes more sense to simply type a suitable diagnostic, + and continue by ignoring the offending character. It is fairly + easy to cause LEX to do this, by including the auxiliary + definition: + + illegal = [\0-\377]; + + which defines a character class "illegal" which is handled + specially by LEX. If the character that is causing the trouble + is a member of that character class (and in the example, all + characters are), then LEX will write a diagnostic, and ignore + it; otherwise, it will return the special token LEXERR + + More comprehensive techniques may be added as they become + apparent. + + + + 6.0 Ambiguity and Look-ahead _________ ___ __________ + + Many computer languages have ambiguous grammars in that an input + token may represent more than one logical entity. This section + discusses the way in which grammars built by LEX resolve + ambiguous input, as well as a way for the grammar to assign + unique meaning to a token by looking ahead in the input stream. + + + + 6.1 Resolving Ambiguities _________ ___________ + + + A LEX program may be ambiguous, in the sense that a particular + input string or strings might be matched by the regular + expression of more than one translation. Consider, + + [a-z] { putchar(*token(NULL)); } + aaa* { printf("abc"); } + + in which the string 'aa' is matched by both regular expressions + (twice by the first, and once by the second). Also, the string + 'aaaaaa' may be matched in many different ways. LEX has to + decide somehow which actions should be performed. + (Alternatively, it could produce a diagnostic, and give up. As + it happens, LEX never does this.) + + Consider a second example, + + letter = [a-z]; + A Lexical Analyser Generator Page 21 + + + %% + A(letter)* { return(1); } + AB(letter)* { return(2); } + + which attempts to distinguish sequences of letters that begin + with 'a' from similar sequences that begin with 'ab'. These two + examples illustrate two different kinds of ambiguity, and the + following indicates how LEX resolves these. + + In the first example, it seems likely that the intent was to + have both 'aa' and 'aaaaaa' perform the second action, while all + single letters 'a' cause the first action to be performed. LEX + does this by ensuring that the longest possible part of the + input stream will be used to determine the match. Thus, + + < { return(LESS); } + <= { return(LESSEQ); } + + or + + digit(digit)* { return(NUMBER); } + letter(letter|digit)* { return(NAME); } + + would work as one might expect. + + In the second example, the longest-string need not work. On the + string "abb9", either action could apply, and so another rule + must be followed. This states that if, after the longest-string + rule has been applied, there remains an ambiguity, then the + action which appears first in the LEX program file is to be + performed. As the second example is written, the second action + will never be performed. It would have been written as: + + letter = [a-z]; + %% + AB(letter)* { return(1); } + A(letter)* { return(2); } + + The two rules together completely determine a string. + + At present, LEX produces no diagnostic in either case; it + merely applies the rules and proceeds. In the case where + priority is given to the first-appearing rule, it might be a + good idea to produce a diagnostic. + + + + 6.2 Look-ahead __________ + + + Some facility for looking ahead in the input stream is sometimes + required. (This facility might also be regarded as a way for + the programmer to more closely control LEX's ambiguity + resolution process.) For example, in C, a name followed by "(" + is to be contextually declared as an external function if it is + A Lexical Analyser Generator Page 22 + + + otherwise undefined. + + In Pascal, look-ahead is required to determine that + + 123..1234 + + is an integer 123, followed by the subrange symbol "..", + followed by the integer 1234, and not simply two real numbers + run together. + + In both of these cases, the desire is to look ahead in the input + stream far enough to be able to make a decision, but without + losing tokens in the process. + + A special form of regular expression is used to indicate + look-ahead: + + re1 '/' re2 '{' action '}' + + where 're1' and 're2' are regular expressions. The slash is + treated as concatenation for the purposes of matching incoming + characters; thus both 're1' and 're2' must match adjacently for + the action to be performed. 'Re1' indicates that part of the + input string which is the token to be returned, while 're2' + indicates the context. The characters matched by 're2' will be + re-read at the next call to yylex(), and broken into tokens. + + Note that you cannot write: + + name = re1 / re2; + + The look-ahead operator must be part of the rule. It is not + valid in definitions. + + In the first example, the look-ahead operator would be used as: + + name / "(" { + if (name undefined) + declare name a global function; + } + name { /* usual processing for identifiers */ + } + + In the second example, the range construction would be parsed as + follows: + + digit = [0-9]; + int = digit(digit)*; + %% + int / ".." int { /* Start of a range */ + ".." int { /* End of a range */ + + + Note that right-context is not sufficient to handle certain + types of ambiguity, as is found in several places in the Fortran + A Lexical Analyser Generator Page 23 + + + language. For example, + + do i = 1 Is an assignment statement + do i = 1, 4 Is a DO statement + + It is not sufficient to use right-context scanning to look for + the comma, as it may occur within a parenthesized + sub-expression: + + do i = j(k,l) Is an assignment statement + + In Fortran, similar problems exist for IF and FORMAT statements, + as well as counted (Hollerith) string constants. All of these + require a more powerful grammar than is possible with LEX + regular-expressions. + + + + 7.0 Multiple Scanning Tables; Processor Switching ________ ________ _______ _________ _________ + + + Even a fairly simple syntax may be difficult, or impossible, to + describe and process with a single set of translations. An + example of this may be found in C, where strings, which are part + of the language, have quite a different structure, and in order + to process them, either a function must be called which reads + and parses the input stream for itself, or some mechanism within + LEX must be invoked to cause a (usually massive) change of + state. + + LEX does provide such a facility, which is known, after AED, as + 'processor switching'. Yylex() locates its tables through a + pointer; if one simply changes the pointer to point at a new + set of tables, one will have effected the required change of + state. The LEX library function lexswitch(), which is described + elsewhere in this guide, arranges to do this; it also returns + the old value of the pointer so that it may be restored by a + later call to Lexswitch. Thus, scanning environments may be + stacked, or not, as the user requires. + + + + 7.1 Creation of a Processor ________ __ _ _________ + + + It should be clear that if all the tables produced by LEX from a + user's translation file have the same name, someone (the loader) + is bound to object. Some method must be provided to change the + name of the table. + + This is done by an option flag to the LEX command: + + -t name + + will cause the scanning table to be declared as + A Lexical Analyser Generator Page 24 + + + struct lextab name; + + so that it may be passed to LEXswitch: + + lexswitch(&name); + + LEX also writes the program file to the file "name.c" rather + than to "lextab.c." + + + NOTE + + If you use the "easy" command line ("-e name") when + running LEX, the output file and table names will + correspond nicely. Re-read the section on operating LEX + for more details. + + + + + + 8.0 Conclusion __________ + + + LEX seems to handle most lexical analysis tasks easily. Indeed, + LEX may be more generally used to write commands of a + text-processing nature; an example of such usage may be found + in an appendix. LEX programs are far easier to write than the + equivalent C programs, and generally consume less space + (although there is an initial overhead for the more general + table-interpreter program). The encoding suggested in [4] + achieves a reasonable compromise between table size, and + scanning speed. Certainly lexical analysers are less tedious + and time-consuming to write. + + It is expected that most change in the future will be through + additions to the LEX library. The LEX language may change + slightly to accomodate common kinds of processing (eg, break + characters), or to extend its range of application. Neither + kind of change should affect existing LEX programs. + + LEX produces tables and programs for the C language. The tables + are in a very simple (and stylised) format, and when LEX copies + the action routines or the program section, the code might as + well be Fortran for all it cares. One could write Unix filters + to translate the very simple C format tables into other + languages, allowing LEX to be used with a larger number of + languages, with little extra development cost. This seems a + likely future addition. + + Because of the look-ahead necessary to implement the "longest + string match" rule, LEX is unsuitable for interactive programs + whose overall structure is: + + for (;;) { + A Lexical Analyser Generator Page 25 + + + prompt_user(); + get_input(); + process(); + print_output(); + } + + If these are rewritten as LEX-generated grammars, the user will + be confused by the fact the second input datum must be entered + before the first is processed. It is possible to solve this + dilemna by rewriting function lexgetc() to return an + "end-of-line" character until processing is complete for that + line. An example is shown in the Appendix. + + + + 9.0 Acknowledgements ________________ + + + LEX is based on a processor of the same name at Bell + Laboratories, which also runs under Unix [3], and, more + distantly, on AED-0 [1]. This version of LEX was based on the + description and suggestions of [4], although the implementation + differs significantly in a number of ways. + + + + 10.0 References __________ + + + 1. Johnson, W.L., et. al., "Automatic generation of + efficient lexical analysers using finite state + techniques", CACM Vol. 11, No. 12, pp. 805-813, 1968. + + 2. Johnson, S.C., "Yacc -- Yet Another Compiler-Compiler", + CSTR-32, Bell Telephone Laboratories, Murray Hill, New + Jersey, 1974. + + 3. Lesk, M.E., "Lex - a lexical analyser generator", + CSTR-39, Bell Telephone Laboratories, Murray Hill, New + Jersey, 1975. + + 4. Aho, A.V., Ullman, J.D., Principles of Compiler Design, __________ __ ________ _______ + Addison-Wesley, Don Mills, Ontario, 1977. + + + + + + + + + + + + + APPENDIX A + + LEX SOURCE GRAMMAR + + + + The following is a grammar of LEX programs which generally + follows Bacus-Naur conventions. In the rules, "||" stands for + alternation (choose one or the other). Other graphic text + stands for itself. Several grammar elements have special + meaning: + + Any text not including the following + grammar element (either a literal or + end-of-file). + + Nothing -- used for optional rule + elements. + + A variable name. + + A character class specifier. + + A string (text inclosed in '"'). + + The end of the input file. + + This grammar was abstracted from the Yacc grammar used to + describe LEX. + + program :== aux_section trans_section + + aux_section ::= auxiliaries %% + || %% + + auxiliaries ::= auxiliaries aux_def + || aux_def + + aux_def ::= name_def = reg_exp ; + || %{ %} + + name_def ::= + + reg_exp ::= + || + || + A Lexical Analyser Generator Page A-2 + LEX Source Grammar + + + || reg_exp * + || reg_exp | reg_exp + || reg_exp reg_exp + || ( reg_exp ) + + trans_section ::= translations + || + + translations ::= translations translation + || translation + + translation ::= pattern action + || %{ %} + || %% + + pattern ::= reg_exp / reg_exp + || reg_exp + + + + + + + + + + + + + APPENDIX B + + SOME SMALL EXAMPLES + + + + + + The following example illustrates the use of the look-ahead + operator, and various other of the nuances of using LEX. + + + + B.1 A Complete Command _ ________ _______ + + + The C programming language has had two different ways of writing + its assignment operators. The original method was to write a + binary operator immediately following the ordinary assignment + operator, forming a compound operator. Thus 'a =+ b' caused the + value of 'a+b' to be assigned to 'a'. Similarly, + + =- =/ =% =* =<< =>> =| =& =^ + + were written for the assignment operators corresponding to + subtraction, division, modulus, multiplication, left shift, + right shift, logical OR, logical AND, and exclusive OR. In the + current version of the language, the binary operator is written + to the left of the assignment operator, to remove potential + ambiguity. + + The LEX program "ctoc" is a filter which converts programs + written in the older style into programs written in the newer + style. It uses the look-ahead operator, and the various + dis-ambiguating rules to ensure that sequences like + + a==-1 a=++b + + remain unchanged. + A Lexical Analyser Generator Page B-2 + Some Small Examples + + + /* + * ctoc.lxi -- Convert old C operators to new C form + * + * Adapted from example in C. Forsythe's LEX manual. + * + * NOTE: + * Forsythe's program put an entire comment into the token + * buffer. Either define a huge token buffer for my typical + * monster comments, or filter text within comments as if + * it were real C code. This is what I did. So =+ inside + * a comment will get changed to +=, etc. Note tnat you + * may use the commen() function in LEXLIB if you want the + * comments eaten. I wanted 'em in the output. + * by + * Bob Denny + * 31-Feb-81 + */ + %{ + char tbuf[80]; /* Token buffer */ + main() + { + while (yylex()) + ; + } + %} + any = [\0-\177]; + nesc = [^\\]; + nescquote = [^\\"]; + nescapost = [^\\']; + schar = "\\" any | nescquote; + cchar = "\\" any | nescapost; + string = '"' schar* '"'; + charcon = "'" cchar* "'"; + %% + "=" ( << | >> | "*" | + | - | "/" | "%" | "&" | "|" | "^" ) + { + gettoken(tbuf, sizeof tbuf); + printf("%s=",tbuf+1); + } + /* + * The following will overflow the token buffer on any but a + * small comment: + */ + /********* + "/*" ([^*] | "*"[^/])* "*/" + { + lexecho(stdout); + } + **********/ + [<=>!]"=" | "="[<>] + { + lexecho(stdout); + } + "=" / ( ++ | -- ) + A Lexical Analyser Generator Page B-3 + Some Small Examples + + + { + lexecho(stdout); + } + charcon + { + lexecho(stdout); + } + string + { + lexecho(stdout); + } + [\0-\377] + { + lexecho(stdout); + } + + + Assuming the Decus compiler running on RSTS/E in RT11 mode, the + above program would be built and executed as follows: + + mcr lex -i ctoc.lxi -o ctoc.c + cc ctoc/v + as ctoc/d + link ctoc=ctoc,c:lexlib,c:suport,c:clib/b:2000 + + mcr ctoc new.c + + + + + B.2 Interactive Lexical Analysis ___________ _______ ________ + + The following program reads words from the terminal, counting + each as they are entered. The interaction with the operator is + "natural" in the sense that processing for one line is complete + before the next line is input. To implement this program, it + was necessary to include a special version of lexgetc() which + returns if the current line has been completely + transmitted to the parser. Because the parser must still have + some look-ahead context, it will return the "end-of-line" token + twice at the beginning of processing. This required some _____ + additional tests in the main program. + + /* + * Count words -- interactively + */ + white = [\n\t ]; /* End of a word */ + eol = [\0]; /* End of input line */ + any = [!-~]; /* All printing char's */ + illegal = [\0-\377]; /* Skip over junk */ + %{ + char line[133]; + char *linep = &line; + int iseof = 0; + A Lexical Analyser Generator Page B-4 + Some Small Examples + + + int wordct = 0; + #define T_EOL 1 + main() + { + register int i; + while ((i = yylex()) != 0) { + /* + * If the "end-of-line" token is + * returned AND we're really at + * the end of a line, read the + * next line. Note that T_EOL is + * returned twice when the program + * starts because of the nature of + * the look-ahead algorithms. + */ + if (i == T_EOL && !is_eof + && *linep == 0) { + printf("* "); + fflush(stdout); + getline(); + } + } + printf("%d words\n", wordct); + } + %} + %% + any(any)* { + /* + * Write each word on a + * seperate output line. + */ + lexecho(stdout); + printf("\n"); + wordct++; + return(LEXSKIP); + } + eol { + return(T_EOL); + } + white(white)* { + return(LEXSKIP); + } + %% + getline() + /* + * Read a line for lexgetc() + */ + { + is_eof = (fgets(line, sizeof line, stdin) + == NULL); + linep = &line; + } + lexgetc() + /* + A Lexical Analyser Generator Page B-5 + Some Small Examples + + + * Homemade lexgetc -- return zero while at the + * end of an input line or EOF at end of file. If + * more on this line, return the next byte. + */ + { + return( (is_eof) ? EOF + : (*linep == 0) ? 0 + : *linep++); + } diff --git a/c20/lex/lex.old b/c20/lex/lex.old new file mode 100644 index 00000000..a0a69e1c --- /dev/null +++ b/c20/lex/lex.old @@ -0,0 +1,660 @@ +/* + * Copyright (c) 1978 Charles H. Forsyth + */ + +/* + * lex -- initialisation, allocation, set creation + * + * Revised for PDP-11 (Decus) C by Martin Minow + */ + +/* Modified 02-Dec-80 Bob Denny -- Conditionalized debug code for smaller size + * 01 -- Moved calls to dfa build, min, print, write + * and to stat, and code for ending() into + * this module so that 'ytab' could be put + * into overlay region. + * 29-May-81 Bob Denny -- More extern hacking for RSX overlaying. + * More 19-Mar-82 Bob Denny -- New C library & compiler + * More 03-May-82 Bob Denny -- Final touches, remove unreferenced autos + * 28-Aug-82 Bob Denny -- Add "-s" switch to supress references to + * "stdio.h" in generated code. Add switch + * comments in code. Add -e for "easy" com- + * mand line. "lex -e file" is the short way + * of saying: + * "lex -i file.lxi -o file.c -t file" + * More(!) 30-Oct-82 Bob Denny -- Fix RSX ODL to put lots of FCS junk into + * overlay, pick up (badly needed) 3KW for + * NFA nodes, etc. Change static allocations + * in LEXLEX.H for RSX so can do non-trivial + * things. Task is now big on RSX and grows + * from big to huge as it runs. + * Fix "-s" support so it is again possible + * to do a lexswitch() (dumb!). + */ + + +/*)BUILD $(PROGRAM) = lex + $(INCLUDE) = { lexlex.h ytab.h } + $(FILES) = { base dfa eclosu lex impure + min out1 out2 lexsrt ytab } + $(STACK) = 4000 + $(TKBOPTIONS) = { + STACK = 3000 + TASK = ...LEX + ;DON'T TRY TO USE FCSRES (RBD) + } + $(ODL) = { +; +; ODL FOR BUILDING LEX ON RSX11M. +; BOB DENNY 29-MAY-81 +; BOB DENNY 19-MAR-82 +; BOB DENNY 03-MAY-82 +; BOB DENNY 30-OCT-82 PUT SOME FCS JUNK IN OVERLAY. REORGANIZE FOR +; SIMPLICITY. +; + .NAME OVR1 + .NAME FCSJNK + .NAME LXPROC + .NAME PARSER + .ROOT L0,L1 +; +L0: .FCTR LEX-IMPURE-OUT2-LB:[1,1]C/LB +; +L1: .FCTR OVR1-*(FCS,STAT,PARS) +; +FCS: .FCTR FCSJNK-(F1,F2) +; +F1: .FCTR LB:[1,1]SYSLIB/LB:.CSI1:.CSI2 +F2: .FCTR LB:[1,1]SYSLIB/LB:OPEN-(OP1,OP2) +; +OP1: .FCTR LB:[1,1]SYSLIB/LB:CREATE:CLOSE:DEL:FINIT:MKDL:OPFNB:RQLCB +OP2: .FCTR LB:[1,1]SYSLIB/LB:PARSE +; +STAT: .FCTR LXPROC-LEXSRT-DFA-BASE-ECLOSU-MIN-OUT1-LB:[1,1]C/LB +; +PARS: .FCTR PARSER-YTAB-LB:[1,1]C/LB +; + .END + } + $(OVR) = { + LEX + LEXSRT + IMPURE + $(SUPORT) + $(RTLIB) + DFA/O:1 + MIN/O:1 + OUT1/O:1 + YTAB/O:1 + BASE/O:2 + OUT2/O:2 + ECLOSU/O:2 + } +*/ + +#ifdef DOCUMENTATION + +title lex A Lexical Analyser Generator +index A Lexical Analyser Generator + +synopsis + + lex [-options] [-i grammar] [-o outfile] [-t table] + +description + + Lex compiles a lexical analyser from a grammar and description of + actions. It is described more fully in lex.doc: only usage is + described. The following options are available: + .lm +16 + .s.i-16;-a Disable recognition of non-ASCII characters + (codes > 177 octal) for exception character classes (form [^ ...]). + .s.i-16;-d Enable debugging code within lex. Normally + needed only for debugging lex. + .s.i-16;-e "Easy" command line. Saying "lex#-e#name" is the + same as saying: + .s.i 4;"lex -i name.lxi -o name.c -t name" + .s + Do not include devices or an extension on "name" or make it longer + than 8 characters, or you'll get several error messages. + .s.i-16;-i file Read the grammar from the file. If "-i" is not + specified, input will be read from the standard input. + .s.i-16;-m Enable state minimization. Currently not + implemented, switch is a no-op. + .s.i-16;-o file Write the output to the file. If "-o" is not + specified, output will be written to file "lextab.c". + .s.i-16;-s "Stand-alone" switch. Supresses the line + "#include " normally generated in the lex output. Use this + if LEX is generating a module to be used in a program which does not + use the "standard I/O" package. + .s.i-16;-t table Name the recognizer "table" instead of the + default "lextab". If -o is not given, output will be written to file + "table.c". + .s.i-16;-v [file] Verify -- write internal tables to the + indicated file. If "-v" is given without a file name argument, + tables will be written to "lex.out". + .lm -16 + +diagnostics + + The following error messages may occur on invocation. See lex + documentation for information on compilation errors. + .lm +8 + .s.i -8;Can't create ... + .s.i -8;Cannot open ... + .s.i -8;Illegal option. + .s.i -8;Illegal switch combination. + .s + "-i", "-o" or "-t" given with "-e" or vice-versa + .s.i -8;Table name too long. + .s + The table name (argument to "-t") must not be longer than 8 bytes. + .s.i -8;Missing table name. + .s.i -8;Missing input file. + .s.i -8;Missing output file. + .s.i -8;Missing name. + .lm -8 + +author + + Charles Forsyth + Modified by Bob Denny +bugs + +#endif + + +#include +#include "lexlex.h" + +extern char *lalloc(); +extern char *tolower(); + +struct nfa nfa[MAXNFA]; +struct nfa *nfap = &nfa[1]; + +struct xset sets[NCHARS]; +char insets[NCHARS]; + +struct trans trans[NTRANS]; +struct trans *transp = &trans[0]; + +char ccls[NCCLS][(NCHARS+1)/NBPC]; +int nccls; + +int ndfa; +struct dfa dfa[MAXDFA]; +struct move move[NNEXT]; + +char *tabname = "lextab"; +char tabfile[15]; +char *infile = NULL; +char *outfile = NULL; + +#ifdef DEBUG +char *dumpfile = "lex.out"; +int lldebug = 0; +#endif + +int llnxtmax = 0; + +FILE *llout; +FILE *lexin; +FILE *lexlog; + +/* + * Flags. Allow globals only for + * those requiring same. Some only + * used for checking for bad combos. + */ + int aflag = 0; /* Ignore non-ASCII in [^ ...] */ +static int eflag = 0; /* Easy command line */ +static int iflag = 0; /* "-i" given */ + int mflag = 0; /* Enable state minimization (not imp.) */ +static int oflag = 0; /* "-o" given */ + int sflag = 0; /* Supress "#include " in output */ +static int tflag = 0; /* "-t" given */ + +struct set *setlist = 0; + +main(argc, argv) +char **argv; +{ + register char *cp, *cp2; + +#ifdef DEBUG + int vflag; + vflag = 0; +#endif + + for (; argc>1 && *argv[1]=='-'; argv++, argc--) + switch (tolower(argv[1][1])) { + +#ifdef DEBUG + /* + * Create "verification" file, describing the + * scanner. + */ + case 'v': /* -v => lex.out */ + vflag++; /* -v x.out => x.out */ + if (argc > 2 && argv[2][1] != '1') { + --argc; + dumpfile = (++argv)[1]; + } + break; + + /* + * Enable debug displays + */ + case 'd': + lldebug++; + break; +#endif + /* + * Enable state minimization. Currently not + * implemented. + */ + case 'm': + mflag++; + break; + + /* + * Disable matching of non-ASCII characters (codes > 177(8)) + * for exception character classes (form "[^ ...]"). + */ + case 'a': + aflag++; + break; + + /* + * Supress "#include " in generated + * code for programs not using standard I/O. + */ + case 's': + sflag++; + break; + + /* + * "Easy" command line + */ + case 'e': + if(iflag || oflag || tflag) { + error("Illegal switch combination\n"); + exit(1); + } + if (--argc <= 1) { + error("Missing name\n"); + exit(1); + } + if (strlen(tabname = (++argv)[1]) > 8) { + error("Name too long\n"); + exit(1); + } + infile = malloc(14); + outfile = malloc(12); + concat(infile, tabname, ".lxi", 0); + if (freopen(infile, "r", stdin) == NULL) { + error("Cannot open input \"%s\"\n", infile); + exit(1); + } + concat(outfile, tabname, ".c", 0); + break; + + /* + * Specify input file name. Default = terminal (stdin) + */ + case 'i': + if (eflag) { + error("Illegal switch combination\n"); + exit(1); + } + iflag++; + if (--argc <= 1) { + error("Missing input file\n"); + exit(1); + } + infile = (++argv)[1]; + if (freopen(infile, "r", stdin) == NULL) { + error("Cannot open input \"%s\"\n", infile); + exit(1); + } + break; + + /* + * Specify output file name. Default = "lextab.c" + */ + case 'o': + if (eflag) { + error("Illegal switch combination\n"); + exit(1); + } + oflag++; + if (--argc <= 1) { + error("Missing output file"); + exit(1); + } + outfile = (++argv)[1]; + break; + + /* + * Specify table name. Default = "lextab". If "-o" + * not given, output will go to "tabname.c". + */ + case 't': + if (eflag) { + error("Illegal switch combination\n"); + exit(1); + } + tflag++; + if (--argc <= 1) { + error("Missing table name"); + exit(1); + } + if (strlen(tabname = (++argv)[1]) > 8) { + error("Table name too long\n"); + exit(1); + } + break; + + default: + error("Illegal option: %s\n", argv[1]); + exit(1); + } + lexin = stdin; + +#ifdef DEBUG + cp = (vflag) ? dumpfile : "nl:"; /* Dec specific */ + if ((lexlog = fopen(cp, "w")) == NULL) { + error("Cannot open \"%s\"", cp); + exit(1); + } +#endif + + if (infile == NULL) { + infile = malloc(31); + fgetname(lexin, infile); + } + cp = infile; /* Fold infile to lower case */ + while(*cp) + *cp++ = tolower(*cp); + cp = tabname; /* Fold tabname to lower case */ + while(*cp) + *cp++ = tolower(*cp); + if (outfile == NULL) { + /* + * Typical hacker's idiom! + */ + for (cp = tabname, cp2 = tabfile; *cp2 = *cp++;) + cp2++; + for (cp = ".c"; *cp2++ = *cp++;) + ; + outfile = tabfile; + } + if ((llout = freopen(outfile, "w", stdout))==NULL) { + error("Can't create %s\n", outfile); + exit(1); + } + heading(); + if (yyparse()) + error("Parse failed\n"); + dfabuild(); /* 01+ */ + dfamin(); + dfaprint(); + dfawrite(); +#ifdef DEBUG + stats(); +#endif /* 01- */ +} /** END OF MAIN **/ + +/* + * This module was moved here from out.c so it could be called from + * ytab.c residing in same overlay region as out.c. + * 02-Dec-80 Bob Denny. + */ + /* 01+ */ +ending() +{ + static int ended; + + if (ended++) + return; + fprintf(llout, "\t}\n\treturn(LEXSKIP);\n}\n"); + setline(); +} + /* 01- */ + +#ifdef DEBUG +stats() +{ + fprintf(lexlog, "\n"); + fprintf(lexlog, "%d/%d NFA states, %d/%d DFA states\n", + nfap-nfa, MAXNFA, ndfa, MAXDFA); + fprintf(lexlog, "%d/%d entries in move vectors\n", llnxtmax, NNEXT); +} + +/* + * Print a state set on { ... } form on lexlog. + */ +pset(t, nf) +register struct set *t; +{ + register i; + + fprintf(lexlog, "{"); + for (i = 0; i < t->s_len; i++) + if (nf) + fprintf(lexlog, " %d", t->s_els[i]-nfa); else + fprintf(lexlog, " %d", t->s_els[i]); + fprintf(lexlog, "}"); +} + +/* + * Print a character to lexlog in readable form. + * Returns the number of characters generated. + */ +chprint(ch) +{ + register char *s; + + ch &= 0377; + switch (ch) { + case '\t': + s = "\\t"; + break; + case '\n': + s = "\\n"; + break; + case '\b': + s = "\\b"; + break; + case '\r': + s = "\\r"; + break; + default: + if(ch<040 || ch>=0177) + { + fprintf(lexlog, "\\%03o", ch); + return(4); + } + else + { + putc(ch, lexlog); + return(1); + } + } + fprintf(lexlog, s); + return(2); +} +#endif + +/* + * The following functions simply + * allocate various kinds of + * structures. + */ +struct nfa * +newnfa(ch, nf1, nf2) +struct nfa *nf1, *nf2; +{ + register struct nfa *nf; + + if ((nf = nfap++) >= &nfa[MAXNFA]) { + error("Too many NFA states"); + exit(1); + } + nf->n_char = ch; + nf->n_succ[0] = nf1; + nf->n_succ[1] = nf2; + nf->n_trans = 0; + nf->n_flag = 0; + nf->n_look = 0; + return(nf); +} + +newdfa() +{ + register struct dfa *df; + + if ((df = &dfa[ndfa++]) >= &dfa[MAXDFA]) { + error("Out of dfa states"); + exit(1); + } + return(df); +} + +char * +newccl(ccl) +char *ccl; +{ + register char *p, *q; + register i; + int j; + + for (j = 0; j < nccls; j++) { + p = ccl; + q = ccls[j]; + for (i = sizeof(ccls[j]); i--;) + if (*p++ != *q++) + goto cont; + return(ccls[j]); + cont:; + } + if (nccls >= NCCLS) { + error("Too many character classes"); + exit(1); + } + p = ccl; + q = ccls[j = nccls++]; + for (i = sizeof(ccls[j]); i--;) + *q++ = *p++; + return(ccls[j]); +} + +struct trans * +newtrans(st, en) +struct nfa *st, *en; +{ + register struct trans *tp; + + if ((tp = transp++) >= &trans[NTRANS]) { + error("Too many translations"); + exit(1); + } + tp->t_start = st; + tp->t_final = en; + en->n_trans = tp; + return(tp); +} + +/* + * create a new set. + * `sf', if set, indicates + * that the elements of the + * set are states of an NFA). + * If `sf' is not set, the + * elements are state numbers of + * a DFA. + */ +struct set * +newset(v, i, sf) +register struct nfa **v; +register i; +{ + register struct set *t; + register k; + int setcomp(); + + qsort(v, i, sizeof(*v), setcomp); + for (t = setlist; t; t = t->s_next) + if (t->s_len==i && eqvec(t->s_els, v, i)) + return(t); + t = lalloc(1, sizeof(*t)+i*sizeof(t->s_els[0]), "set nodes"); + t->s_next = setlist; + setlist = t; + t->s_final = 0; + t->s_state = 0; + t->s_flag = 0; + t->s_len = i; + t->s_group = 0; + t->s_look = 0; + for (v += i; i;) { + --v; + if (sf) { + if ((*v)->n_char==FIN) + t->s_final = (*v)-nfa; + if ((*v)->n_flag&LOOK) + t->s_look |= 1<<(*v)->n_look; + } else { + k = *v; + dfa[k].df_name->s_group = t; + } + t->s_els[--i] = *v; + } + return(t); +} + +setcomp(n1p, n2p) +struct nfa **n1p, **n2p; +{ + register struct nfa *n1, *n2; + + n1 = *n1p; + n2 = *n2p; + if (n1 > n2) + return(1); + if (n1==n2) + return(0); + return(-1); +} + +eqvec(a, b, i) +register *a, *b, i; +{ + if (i) + do { + if (*a++ != *b++) + return(0); + } while (--i); + return(1); +} + +/* + * Ask for core, and + * complain if there is no more. + */ +char * +lalloc(n, s, w) +char *w; +{ + register char *cp; + + if ((cp = calloc(n, s)) == NULL) { + fprintf(stderr, "No space for %s", w); +#ifdef DEBUG + if (lldebug) + dfaprint(); +#endif + exit(1); + } + return(cp); +} diff --git a/c20/lex/lex.rnh b/c20/lex/lex.rnh new file mode 100644 index 00000000..5bba3d59 --- /dev/null +++ b/c20/lex/lex.rnh @@ -0,0 +1,75 @@ +.lit +lex A Lexical Analyser Generator + +synopsis + + lex [-options] [-i grammar] [-o outfile] [-t table] + +description + + Lex compiles a lexical analyser from a grammar and description of + actions. It is described more fully in lex.doc: only usage is + described. The following options are available: +.el +.lm +16 +.s.i-16;-a Disable recognition of non-ASCII characters +(codes > 177 octal) for exception character classes (form [^ ...]). +.s.i-16;-d Enable debugging code within lex. Normally +needed only for debugging lex. +.s.i-16;-e "Easy" command line. Saying "lex#-e#name" is the +same as saying: +.s.i 4;"lex -i name.lxi -o name.c -t name" +.s +Do not include devices or an extension on "name" or make it longer +than 8 characters, or you'll get several error messages. +.s.i-16;-i file Read the grammar from the file. If "-i" is not +specified, input will be read from the standard input. +.s.i-16;-m Enable state minimization. Currently not +implemented, switch is a no-op. +.s.i-16;-o file Write the output to the file. If "-o" is not +specified, output will be written to file "lextab.c". +.s.i-16;-s "Stand-alone" switch. Supresses the line +"#include " normally generated in the lex output. Use this +if LEX is generating a module to be used in a program which does not +use the "standard I/O" package. +.s.i-16;-t table Name the recognizer "table" instead of the +default "lextab". If -o is not given, output will be written to file +"table.c". +.s.i-16;-v [file] Verify -- write internal tables to the +indicated file. If "-v" is given without a file name argument, +tables will be written to "lex.out". +.lm -16 + +.lit + +diagnostics + + The following error messages may occur on invocation. See lex + documentation for information on compilation errors. + +.el +.lm +8 +.s.i -8;Can't create ... +.s.i -8;Cannot open ... +.s.i -8;Illegal option. +.s.i -8;Illegal switch combination. +.s +"-i", "-o" or "-t" given with "-e" or vice-versa +.s.i -8;Table name too long. +.s +The table name (argument to "-t") must not be longer than 8 bytes. +.s.i -8;Missing table name. +.s.i -8;Missing input file. +.s.i -8;Missing output file. +.s.i -8;Missing name. +.lm -8 + +.lit + +author + + Charles Forsyth + Modified by Bob Denny +bugs + +.el diff --git a/c20/lex/lex.rno b/c20/lex/lex.rno new file mode 100644 index 00000000..75880cde --- /dev/null +++ b/c20/lex/lex.rno @@ -0,0 +1,2084 @@ +.comment Standard DECUS C Documentation layout +.comment +.comment Position the printer to start on the 4th line for 66 line +.comment (11 inch) paper. The 60 lines printed should be vertically +.comment centered on the page, with 3 line vertical margins top and bottom. +.comment +.comment The title page is laid out so that the title will show through +.comment a "window" cover such as is used on Digital documentation. +.comment +.comment The following statement will give a (non-fatal) error on RNO.TSK +.comment It is needed because somebody was clever in designing "Standard +.comment RUNOFF". +.NO AUTOSUBTITLE .STYLE HEADERS 3,0,0 +.comment +.nhd.uc.ps 58,80.lm 8.rm 72 +# +.s 26 +.c ;DECUS C LANGUAGE SYSTEM +.s 2 +.c ;LEX +.c ;A lexical Analyser Generator +.s 2 +.c ;by +.s +.c ;Charles H. Forsyth +.s 1 +.nf +.lm +20 +University of Waterloo +Waterloo, Ontario, N2L 3G1 +Canada +.lm -20 +.f +.s 2 +.c ;Revised by +.s +.c ;Robert B. Denny _& Martin Minow +.s 2 +LEX transforms a regular-expression grammar and associated action +routines into a C function and set of tables, yielding a table-driven +lexical analyser which manages to be compact and rapid. +.s 2 +.c ;DECUS Structured Languages SIG +.s +.c ;Version of 30-Oct-82 +.nhy +.p 2, 1, 3 +.pg +# +.s 6 +.note Copyright (C) 1978, Charles H. Forsyth +.en +.note Modifications Copyright (C) 1980, 1982, DECUS +General permission to copy or modify, but not for profit, is hereby granted, +provided that the above copyright notice is included and reference made to +the fact that reproduction privileges were granted by DECUS. +.s +The information in this document is subject to change without notice +and should not be construed as a commitment by Digital Equipment +Corporation or by DECUS. +.s +Neither Digital Equipment Corporation, DECUS, nor the authors assume +any responsibility for the use or reliability of this document or +the described software. +.s +This software is made available without any support whatsoever. +The person responsible for an implementation of this system +should expect to have to understand and modify the source code if +any problems are encountered in implementing or maintaining the compiler or +its run-time library. The DECUS 'Structured Languages Special Interest +Group' is the primary focus for communication among users of this software. +.en +.s 7 +UNIX is a trademark of Bell Telephone Laboratories. RSX, RSTS/E, RT-11 +and VMS are trademarks of Digital Equipment Corporation. +.s +.hd +.hd mixed +.comment The following gives an error on RNO.TSK +.head mixed +.pg +.lm 8.rm 72 +.t ########A Lexical Analyser Generator +.f +.hl 1 ^&Introduction\& +.tp 3.s +A computer program +often has an input stream +which is composed of small +elements, such as a +stream of characters, +and which it would like to +convert to larger elements +in order to process the data conveniently. +A compiler is a common +example of such a program: +it reads a stream of characters +forming a program, and would like +to turn this sequence of characters +into a sequence of larger items, +namely +identifiers, numbers, and operators, +for parsing. +In a compiler, +the procedures which do this are collectively called the +^&lexical analyser\&, +or +^&scanner\&; +this terminology will be used more generally here. +.tp 3.s +It may happen that the speed with which +this transformation is done will noticeably affect the +speed at which the rest of the program operates. +It is certainly true that +although such code is rarely difficult to write, +writing and debugging it is both tedious, and time-consuming, +and one typically would rather spend the time on +the hard parts of the program. +It is also true that +while certain transformations are easily thought of, +they are often hard to express succinctly +in the usual general-purpose +programming languages +(eg, the description of a floating-point number). +.tp 3.s +LEX +is a program which tries to give a programmer +a good deal of help in this, +by writing large parts of the +lexical analyser +automatically, +based on a description supplied by +the programmer +of +the items to be recognised +(which are known as +^&tokens\&), +as patterns of the more basic elements of the input stream. +The +LEX +description is +very much a special-purpose +language for writing lexical analysers, +and +LEX +is then simply a translator for this language. +The +LEX +language +is easy +to write, +and the resulting processor is +compact +and fast running. +.tp 3.s +The purpose of +a +LEX +program +is to read an input stream, +and recognise +^&tokens\&. +As the lexical analyser will +usually exist as a subroutine +in a larger set of programs, +it will return a +"token number", +which indicates which token +was found, and possibly a +"token value", +which provides more detailed information +about the token (eg, a copy of the token itself, +or an index into a symbol table). +This need not be the only possibility; +a +LEX +program is often a good description +of the structure of the whole computation, +and in such a case, the lexical analyser +might choose to call other routines to perform +the necessary actions whenever a particular +token is recognised, without reference to its own caller. +.tp 14 +.hl 1 ^&The Lex Language\& +LEX transforms a regular-expression grammar +into a deterministic finite-state automaton that recognizes that +grammar. Each rule of the grammar is associated with an +action which is to be performed when that rule successfully matches +some part of the input data. +.s +Because of the nature of regular expression grammars, certain language +constructions cannot be recognized by LEX programs. Specifically, +expressions with balanced parentheses cannot be recognized. This means +that LEX cannot be used to recognize all Fortran keywords as some +(DO, IF, and FORMAT, for example) +require elaborate recognition to distinguish between ambiguous +constructions. +.hl 2 ^&Elementary Things\& +.tp 3.s +Strings, +characters, +sets of characters called +character +classes, +and operators to form these into +patterns, +are the fundamental elements of the +LEX +language. +.tp 3.s +A +^&string\& +is a sequence of characters, +not including newline, +enclosed +in quotes, or apostrophes. +Within a string, +the following escape +sequences +.tp 14 +(which are those of the C language) +allow any 8-bit character to be represented, +including the escape character, quotes, +and newlines: +.nf.s + _\n NL (012) + _\r CR (015) + _\b BS (010) + _\t TAB (011) + _\" " + _\' ' + _\c c + _\_\ _\ + _\NNN (NNN) +.f.s +where +NNN +is a number in octal, +and +^&c\& +is any printable character. +A string may be continued across +a line by writing the escape character +before the newline. +.tp 3.s +Outside a string, +a sequence of upper-case letters +stands for a sequence of the +equivalent +^&lower-case\& +letters, +while a sequence of lower-case +letters is taken as the name +of a +LEX +expression, and handled +specially, +as described below. +These conventions make the use of +named expressions and the description +of +lower-case +keywords +(the usual case on Unix) +fairly +convenient. +Keywords in case-independent languages, such as Fortran, require +additional effort to match, as will be noted. +.tp 3.s +An +Ascii +character +other +than +one of +.nf.s + () {} [ * | = ; _% / _\ ' " - +.f.s +may be used in +LEX +to stand for itself. +.tp 3.s +A sequence of +characters enclosed by +brackets ('[' and ']') +forms a +character +class, +which stands for all those characters +within the brackets. +If a circumflex ('_^') +follows the opening bracket, +then the class will instead stand +for all those characters +^&but\& +those inside the brackets. +The escapes used in strings may be +used in character classes as well. +.s +Within a character class, the construction "A-B" (where "A" and "B" +are arbitrary characters) stands for the range of characters between +"A" and "B" inclusive. +.s +For example, +.lm +24 +.s.i-16;"ABC" matches "abc" +.s.i-16;"[ABC]" matches "A" or "B" or "C" +.s.i-16;"[A-Za-z0-9]" matches all letters and digits +.s.lm -24; +Case-independent keyword recognition may be described by using auxiliary +definitions to define expressions that match either case. For example, +.s.nf + a = [Aa]; + b = [Bb]; + ... + z = [Zz]; + _%_% + d o Matches "DO", "do", "Do", or "dO" +.s.f +.hl 2 ^&Putting Things Together\& +.tp 3.s +Several operators +are provided to allow +construction of +a type of pattern called +a +^®ular expression\&. +Such expressions can be implemented as finite-state automata (without +memory or stacks). +A reference to an +"occurrence" of a regular expression +is generally taken to mean an +occurrence of any string matched by that regular expression. +The operators are presented in order of +decreasing priority. +In all cases, +operators work on either +strings or character classes, +or on other +regular expressions. +.tp 3.s +Any string or character class +forms a regular expression which +matches whatever the string +or character class +stands for (as described above). +.tp 3.s +The operator '*' +applied following +a regular expression +forms a new regular expression +which matches an arbitrary number +(ie, zero or more) of +adjacent occurrences of +the first regular expression. +The operation is often referred to +as +(Kleene) closure. +.tp 3.s +The operation of +^&concatenation\& +of two regular expressions is expressed +simply by writing the regular expressions +adjacent to each other. +The resulting regular expression matches +any occurrence of the first regular expression +followed directly by an occurrence of the +second regular expression. +.tp 3.s +The operator '|', +^&alternation\&, +written between two regular expressions +forms a regular expression which matches +an occurrence of the first regular expression +or +an occurrence of the second regular expression. +.tp 3.s +Any regular expression may be enclosed +in parentheses +to cause the priority of operators to be overridden +in the usual manner. +.tp 6 +.tp 3.s +A few examples should help to +make all of this clear: +.lm +24 +.s.i-16;"[0-9]*" matches a (possibly empty) sequence of digits. +.s.i-16;"[A-Za-z__$][A-Za-z0-9__$]*" +.br +matches a C identifier. +.s.i-16;"([A-Za-z__$]|[0-9])*" +.br +matches a C identifier, +or a sequence of digits, +or a sequence of letters and digits intermixed, +or nothing. +.s.lm -24 +.hl 2 ^&The General Form of Lex Programs\& +.tp 3.s +A +LEX +source input file consists of +three sections: +a +section containing +^&auxiliary\& ^&definitions\&, +a +section containing +^&translations\&, +and a section +containing +^&programs\&. +.tp 3.s +Throughout a +LEX +program, +spaces, +tabs, +and newlines +may be used +freely, +and +PL/1-style comments: +.nf.s + /* ... anything but '*/' ... */ +.f.s +may be used, and are treated +as a space. +.tp 3.s +The +^&auxiliary\& +^&definition\& +section +must be present, +separated from +following +sections +by the two-character sequence '_%_%', +but may be empty. +This section allows definition of named regular expressions, which +provide the useful ability +to use names of regular +expressions in the translation +section, in place of common sub-expressions, +or to make that section more readable. +.tp 3.s +The +^&translation\& +section +follows the '_%_%' sequence, +and contains regular expressions +paired with +^&actions\& +which describe what the lexical analyser +should do when it discovers an occurrence of a given +regular expression +in its input stream. +.tp 3.s +The +^&program\& +section +may be omitted; +if it is present +it must be separated from the translation +section by the '_%_%' sequence. +If present, it may contain +anything +in general, as it is simply tacked on to the end of +the +LEX +output file. +.tp 3.s +The style of this layout +will be familiar to users of Yacc. +As +LEX +is often used with that processor, +it seemed reasonable to keep to a similar format. +.hl 2 ^&Auxiliary Definitions\& +.tp 3.s +Given the set of regular expressions +forming a complete syntax, +there are often common sub-expressions. +LEX +allows these to be named, +defined but once, +and referred to by name in any +subsequent regular expression. +Note that definition must precede use. +A definition has the form: +.nf.s + expression__name = regular__expression ; +.f.s +where a name is +composed of a lower-case letter followed +by a sequence string of letters and digits, +and where an underscore is considered a letter. +For example, +.nf.s + digit = [0-9]; + letter = [a-zA-Z]; + name = letter(letter|digit)*; +.f.s +The semicolon +is needed to resolve some ambiguities +in the +LEX +syntax. +.s +Three auxiliary definitions have special meaning to LEX: +"break", "illegal", and "ignore." They are all defined as character +classes ("break = [,.?]", for example) and are used as follows: +.lm +16 +.s.i -8;break An input token will always terminate if +a member of the "break" class is scanned. +.s.i -8;illegal The "illegal" class allows simplification of error +detection, as will be described in a later section. If this class +is defined, and the lexical analyser stops at a character that +"cannot" occur in its present context, the analyser will output +a suitable error message and ignore the offender. +.s.i -8;ignore This class defines a set of characters that are +ignored by the analyser's input routine. +.s.lm -16 +.hl 2 ^&Translations\& +.tp 3.s +One would like to provide +a description of the action +to be taken when a particular +sequence of input characters has been +matched by a given regular expression. +The kind of action taken +might vary considerably, +depending upon the application. +In a compiler, +typical actions are: +enter an identifer into a symbol table, +read and store a string, +or +return a particular token to the parser. +In text processing, +one might wish to reproduce +most of the input stream on an output stream +unchanged, +making substitutions when a particular +sequence of characters is found. +In general, +it is hard to predict +what form the action might take, +and so, +in +LEX +the nature of the action is left to the user, +by allowing specification, +for each regular expression of interest, +C-language code +to be executed when a string matching that expression +is discovered by +the driving program of +the lexical analyser. +An action, +together with its regular expression, +is called a +^&translation\&, +and has the format: +.nf.s + regular__expression { action } +.f.s +All of this may be spread across several lines. +The action may be empty, +but the braces must appear. +.tp 3.s +Earlier, +it was argued that +most general-purpose languages +are inappropriate for writing +lexical analysers, +and it is important to see that the +subsequent use of such a language +to form the actions is not a contradiction. +Most languages are fairly +good at expressing the actions described +above (symbol table manipulation, +writing character strings, and such). +Leaving this part of the lexical +analyser to +those languages therefore not +only makes sense, +but also ensures that decisions by the +writer of the lexical +analyser generator will not +unduly cramp the +user's style. +However, +general-purpose languages +do not as a rule +provide inexpensive pattern matching +facilities, +or input description formats, +appropriate for describing or structuring +a lexical analyser. +.tp 3.s +Allowing a user to +provide his own code is not really enough, +as +he will need some help from +LEX +to obtain a copy of, or a pointer to, +the current token, if nothing else. +LEX +provides a +library of C functions +which may be called to +obtain controlled access +to some of the data structures +used by the driving programs +of the lexical analyser. +These are described in a later section. +.hl 3 ^&Numbers and Values\& +.tp 3.s +Typically, +a lexical analyser +will return +a value +to its caller indicating +which token has been found. +Within an action, this is done by +writing a +C +^&return\& +statement, which returns the appropriate +value: +.tp 12 +.nf.s + BEGIN { + return(T__BEGIN); + } + name { + lookup(token(NULL)); + return(T__NAME); + } + "/" { + return('/'); + } +.f.s +Note that function lookup() is provided by the user program. +.s +In many cases, +other information must be supplied to its caller +by the scanner. +When an identifier is recognised, for example, +both a pointer to a symbol-table entry, and the token number T__NAME +must be returned, +yet the C +^&return\& +statement can return but a single value. +Yacc has a similar problem, and +so its lexical analyser sets an +external word +'yylval' +to the +token +value, +while the +token +number +is returned by the scanner. +LEX +uses the external +'yylval' +(to be compatible), +but, to make +LEX +programs more readable +when used alone, +the name +'lexval' +is +set by +a _#define statement +to +'yylval'. +For example, +.nf.s + name { + lexval = lookup(token(NULL)); + return(T__NAME); + } +.f.s +.tp 3.s +Certain token numbers are treated specially; +these are automatically defined as manifests +(see section 3.2) +by +LEX, +and all begin with the sequence 'LEX...' +so as not to clash with the user's +own names. +There are two such tokens defined +at present: +.tp 3 +.lm +16 +.s.i -8;LEXSKIP When returned by a user's action routine, +LEXSKIP causes the lexical analyser to ignore the current +token (ie, it does not inform the parser of its presence), +and to look instead for a new token. +This may be used when a comment sequence has been +discovered, and discarded. It is also useful when the action +routine completes processing of the token. +See the discussion of the comment() +library function for an example of its usage. +.s.i -8;LEXERR This is returned by the lexical analyser (function +yylex()) when an unrecognizable +input sequence has been detected. By default, LEXERR is 256. +This the same as the yacc error value. +.s.lm -16 +.tp 3.s +To summarise, +the token +number +is set by the action with a +^&return\& +statement, +and the token +value +(ie, auxiliary information) +is set by assigning this value to the external +integer +'lexval'. +.hl 2 ^&Declaration Sections\& +.tp 3.s +Declarations in the language +of the actions +may be included in both +the +auxiliary definition +section +and in the +translation section. +In the former case, +these declarations will be external +to the lexical analyser, +and in the latter case, +they will be local +to the lexical analyser +(ie, static, or +automatic storage). +Declaration sections +consist of a sequence of declarations +surrounded +by the special bracketing +sequences '_%{' and '_%}' +(as in Yacc). +The characters within these brackets are +copied unchanged into the appropriate spots +in the lexical analyser program +that +LEX +writes. +The examples in +appendix A +suggest how these might be used. + +.hl 1 ^&Using Lex from C\& +.tp 3.s +The present +version of +LEX +is intended for use with C; +and it is this usage which will be described here. +.hl 2 ^&The Function yylex()\& +.tp 3.s +The structure of +LEX +programs +is influenced by what +Yacc +requires of its lexical analyser. +.tp 3.s +To begin with, +the lexical analyser must be named +'yylex', +has no parameters, and +is expected to return +a token number, +where that number is determined by +Yacc. +The token number for an Ascii +character is its Ascii value +(ie, its value as a C character constant). +Named tokens, defined in yacc '_%token' +statements, +have a number above 256, +with the particular number accessible +through a Yacc-produced +_#define +of the given token name as its number. +Yacc also allows +'yylex' +to pass a value to the Yacc +action routines, by assigning that +value to the external +'yylval'. +.tp 3.s +LEX thus +provides a +lexical analyser function named +'yylex', +which interprets tables constructed +by the +LEX +program +returning the token +number returned by the actions +it performs. +Values assigned to +lexval +are available in +'yylval', +so that use with Yacc is straightforward. +.tp 3.s +A value of zero is returned +by +'yylex' +at end-of-file, +and in the absence of a +^&return\& +statement in an action, +a non-zero value is returned. +If computation is performed +entirely by +the lexical analyser, +then a suitable main program would be +.nf.s + main() + { + while (yylex()) ; + } +.f.s +.hl 2 ^&Serial Re-Use of yylex()\& +.tp 3.s +The yylex() function contains several variables which are +statically initialized at compile time. Once yylex() sees +an EOF (-1) input character, it will continue to return NULL. +If yylex() is to be used +inside a loop which processes multiple files, it must be +re-initialized at the beginning of each new file with a call to +the LEX library routine llinit(). For example (slightly +extending the previous example): +.s.nf +.tp 12 + main() + { + get_file_list(); + for(file = first; file != last; file = next) + { + llinit(); + while (yylex()); + } + printf("All files done_\n"); + } +.f +.tp 3.s +The call to llinit() is unnecessary if yylex() is to process only +one file, or is kept from seeing an EOF input character. +.hl 2 ^&The Lex Table File\& +.tp 3.s +In the absence of instructions to the contrary (see below), +LEX +reads a given +LEX +language file, (from the standard input, if an input file has +not been specified) and +produces a C program file +'lextab.c' +which largely consists of tables which are then +interpreted by +'yylex()' (which is in the LEX library). +The actions supplied by the user in each +translation are combined with a +^&switch\& +statement into a single function, +which is called by the table interpreter +when a particular token is found. +The contents of the program section +of the +LEX +file are added at the end of +the output file (lextab.c by default). +Normally, LEX +also inserts +the lines +.nf.s + _#include + _#include +.f.s +at the top of the file; +this causes declarations +required by +the standard I/O library and by LEX +to be included when the C program is compiled. +.hl 2 ^&Analyzers Which Don't Use "Standard I/O"\& +.tp 3.s +With the current release, LEX supports the generation of +analyzers which may be incorporated into programs which do not +use the "standard I/O" library. By setting the "-s" switch, as +shown below, the generation of the "_#include#" line is +supressed. All references to standard I/O specific files and +stdio.h have been removed from the LEX library (described in a +later section), with the exception of lexgetc(), lexerror(), +mapch() and lexecho(), which are standard I/O dependent. +.s +The declaration of yylex()'s input file iov pointer "lexin" now resides +in LEXGET.C (lexgetc()). The code which defaults lexin to stdin +has been moved from yylex() to the table file. yylex() now calls +the routine llstin(), which is generated into the table file. +There are no longer any hardwired references to the variable +"lextab", the default table name. Instead, LEX generates a call +to lexswitch() in llstin(), which initializes yylex() to +use the table whose name was given in a "-t" or "-e" option in +LEX's command line. If neither was given, the default name +"lextab" is used. Once the initial table has been set up, +further automatic calls to lexswitch() are supressed, allowing +the user to manually switch tables as before. +.s +In addition, If the "-s" switch is not given (i.e., normal use +with standard I/O), llstin() defaults lexin to stdin. If "-s" +is given, llstin() is generated to do the lexswitch() mentioned +above only. In any case, yylex() contains no references to the +standard I/O system. +.s +What all of this means is that under normal operation, you won't +notice any change in LEX's characteristics. In addition, you may +use the "-e" ("easy") switch, which will generate a C output file +and LEX tables which (conveniently) have the same name as the +input file, and everything will get set up automagically. +If you specify +the "-s" switch, the table file will contain no references to the +standard I/O package, and you may use any of the lexlib routines +except lexgetc(), lexerror(), mapch() or lexecho(). +.s +Don't forget that you must supply your own startup routine "$$main" if +you do not want the standard I/O library. With a bit of care in this +regard, it will be possible to link your program with the C library +without dragging in any I/O modules. This prevents your having to +build another library in order to access non-I/O library functions. +Just make the reference to the C library the last one given to the +linker or taskbuilder so that only those routines which have not already +been found are pulled from CLIB. +.note +Programs that use LEX-generated analyzers and do not use the +standard I/O package must supply their own lexgetc() and +lexerror() routines. Failure to do so will result in undefined +globals. +.en +.hl 2 ^&Operating LEX\& +.tp 3.s +LEX normally reads the grammar from the standard input, writing +the C program to the file 'lextab.c'. It may be further controlled +by using the following flags upon invocation: +.lm +24 +.s.i-16;-i filename The grammar is read from 'filename'. +.s.i-16;-o filename The analyser is written to 'filename'. +.s.i-16;-t table_name The default finite-state automaton is named +lextab (and it is, by default, written to file 'lextab.c'). The +-t switch causes the internal tables to be named 'table_name' and, if +the -o switch is not given, written to file 'table_name.c'. This +is necessary if the processor-switching capabilities described in a +later section are to be used. +.s.i-16;-e name "Easy" command line. "-e#name" is equivalent to typing +.s.i 3;-i#name.LXI#-o#name.C#-t#name +.s +Do not include device names or file extensions on the "easy" command line. +.s.i-16;-v [filename] Internal state information is written to 'filename.' +If not present, state information is written to file 'lex.out.' +.s.i-16;-d Enable various debugging printouts. +.s.i-16;-s Generate analyzer without references to standard I/O +.s.lm -24 +.tp 3.s +The command line for compilation of the table +file should contain no surprises: +.nf.s + cc -c -O lextab.c (on Unix) +.s + xcc lextab -a (on Dec operating systems) +.f.s +but when one is producing the running program, +one must be careful to include the necessary +libraries. On Unix, the proper sequence is: +.nf.s + cc userprog.o lextab.o -ll -lS +.f.s +The '-ll' causes the +LEX +library (described below) +to be searched, and the +'-lS' causes the Standard I/O library +to be used; both libraries are required. +If Yacc is used as well, +the library '-ly' should be included +^&before\& +the +'-ll'. +The actual order and content of the rest of the +command line is determined by the +user's own requirements. +.s +If using the Decus C compiler, the lexical analyser built by LEX +is linked with c:lexlib. +.s +The complete process (assuming the Decus compiler running on RSTS/E +in RT11 mode) is thus: +.s.nf + mcr lex -i grammar.lxi -o grammar.c ! Build analyser + cc grammar ! Compile the + as grammar ! grammar table + link out=in,grammar,c:lexlib,c:suport,c:clib/b:2000 +.s.f +.hl 1 ^&The Lex Library\& +.tp 3.s +All programs using grammars generated by LEX must be linked together +with the LEX library. On Unix, this is +'/lib/libl.a' +(or '-ll' on the +cc +command line) and on DEC operating systems, C:LEXLIB +(LB:[1,1]LEX.OLB for RSX). +It contains routines which are either essential +or merely useful to users of +LEX. +The essential routines +include +a routine to obtain a copy of the current token, +and a routine to switch to a different +set of scanning tables. +Routines of the second, useful, class +perform functions which might well be written +by the user himself, but are there to save him +the bother; +including +a routine to process various forms of comments +and a routine to transform numbers written +in arbitrary bases. +Both sets of routines are expected to grow as +LEX +sees use. +.tp 3.s +Those functions which produce diagnostics +do so by calling +lexerror(), +which is called as +.nf.s + lexerror(string, arg1, ..., argN) +.f.s +and is expected to write its arguments (likely using +the "remote format" facility of the fprintf() function), +followed by a newline, +on some output stream. +A +Lexerror() +function is included in +the +LEX +library, but a user is free to include his own. The routine in +the LEX library is standard I/O specific. +.note +The VAX/VMS native C library does not support remote formats. The +Lexerror function in the LEX library conditionally compiles to support +a call to lexerror() with only an error message string. Remote formats +are supported under Decus C. Learn to use them, they are very nice! +.en +.hl 3 ^&Comment -- skip over a comment\& +.s.i +8;comment(delim) +.i +8;char delim[]; +.s +Comment() +may be called by a translation when the sequence of characters +which mark the start of a comment in the +given syntax has been recognised by +LEX. +It takes a string which gives +the sequence of characters which mark +the end of a comment, and skips +over characters in the input stream +until this sequence is found. +Newlines found while skipping characters +cause the external +'yyline' +to be incremented; +an unexpected end-of-file produces a suitable +diagnostic. +Thus, +'comment("*/")' matches C-style +comments, and 'comment("_\n")' matches as-style comments. +There are other methods of handling comments in +LEX; +the +comment() +function is usually the best with regard to both +space and time. +.hl 3 ^&Gettoken -- obtain a copy of token\& +.s.i +8;gettoken(buf, sizeof(buf)) +.i +8;char buf[]; +.s +Gettoken() +takes the address of a character buffer, and its size in bytes, +and copies the token most recently matched by +LEX +into the buffer. +A null byte is added to mark the end of the +token in the buffer, +but, as null bytes are legitimate +characters to +LEX, +the true length of the token is returned by +gettoken(). +.s +For example, the following function calls lexlength() to obtain +the length of a token. It then calls the storage allocator to +allocate sufficient storage for the token and copies the token +into the allocated area. +.s.nf + char * + save() + /* + * Save current token, return a pointer to it + */ + { + register char *tbuffer; + register int len; + register char *tend; + extern char *token(); + extern char *copy(); +.s + len = lexlength() + 1; + if (tbuffer = malloc(len)) == NULL) + error("No room for token"); + gettoken(tbuffer, len); + return(tbuffer); + } +.s.f +.hl 3 ^&Integ -- long integer, any base\& +.s.i +8;long +.i +8;integ(nptr, base) +.i +8;char *nptr; +.s +Integ() +converts the Ascii string +at +'nptr' +into a +long +integer, which it returns. +Conversion stops at the first non-digit, +where the digits are taken from the class +"[0-9a-zA-Z]" +as limited by +the given +'base'. +Integ() +does not understand signs, +nor are blanks or tabs allowed in the string. +.hl 3 ^&Lexchar -- steal character\& +.s.i +8;lexchar() +.s +Lexchar() +returns +the next character from the +LEX +input stream. +(This means that +LEX +will no longer see it.) +LEX +uses a look-ahead buffer to handle +complex languages, and this function +takes this into account. +.hl 3 ^&Lexecho -- write token to a file (STDIO ONLY)\& +.s.i +8;lexecho(fp); +.br.i+8;FILE *fp; +.s +Lexecho() may be called by a LEX action routine to write the +current token to a specified file. +.note +Programs using analyzers built with LEX's "-s" switch must supply +their own lexecho() function if needed. +.en +.hl 3 ^&Lexgetc -- supply characters to yylex (STDIO ONLY)\& +.s.i +8;lexgetc() +.s +Lexgetc() +is called by the lexical analyser to obtain +characters from its input stream. +The version in the library is dependent on the standard I/O +package, and is: +.nf.s + FILE *lexin; /* Declare iov address locally */ + lexgetc() + { + return(getc(lexin)); + } +.f.s +If lexin is NULL when yylex() is entered, it will be assigned to +stdin. This is done by yylex() calling the function llstin(), +which is generated in the table file. Unless the "-s" switch +is given to LEX, the llstin() function assigns lexin to stdin +if lexin is NULL. If the "-s" switch was given, the llstin() +routine is a no-op. +The user may provide his own version of +lexgetc() +to pre-process the data to the lexical analyser. An example of this +is shown in the appendix. +.note +Programs using analyzers built with LEX's "-s" switch must supply +their own lexgetc() function, and "lexin" has no meaning in this +context. +.en +.hl 3 ^&Lexlength -- return length of a token.\& +.s.i +8;lexlength(); +.s +Lexlength() may be called by a LEX action routine to obtain the +length of the current token in bytes. An example of this is shown +in the description of gettoken(). +.hl 3 ^&Lexpeek -- examine character\& +.s.i +8;lexpeek() +.s +Lexpeek() performs a function similar to that of Lexchar(), +but does not have the side-effect of removing the character from +LEX's view. +.hl 3 ^&Lexswitch -- switch scanning tables\& +.s.i +8;struct lextab * +.i +8;lexswitch(newtb) +.i +8;struct lextab *newtb; +.s +Lexswitch() +is called to cause +LEX +to use a different scanning table; +it returns a pointer to the one previously in use. +This facility is useful if certain objects of the language +(eg, strings in C) +have a fairly complicated structure of their own +which cannot be handled within the translation section +of the +LEX +description +of the larger language. + +.hl 3 ^&Llinit -- Reinitialize yylex()\& +.s.i +8;llinit() +.s +Llinit() is a function which resets the state of yylex() to it's +cold-start condition. Several of yylex()'s variables are +initialized at compile time, and must be reinitialized if it is +to be serially re-used. An example of this is where yylex() is +repeatedly called inside a loop which processes multiple input +files. Each time a new file is started, llinit() must be called +before the first call to yylex() for the new file. +.hl 3 ^&Mapch -- Handle C escapes within strings (STDIO ONLY)\& +.s.i +8;int mapch(delim, esc) +.i +8;char delim; +.i +8;char esc; +.s +Mapch() is a function which handles C "escape" characters such as +"_\n" and "_\nnn". It will scan off the entire escape sequence and +return the equivalent ASCII code as an integer. It is meant for use with +YACC +while scanning quoted strings and character constants. +.s +If it encounters +EOF while scanning, it calls lexerror() to print an error message warning +of "Unterminated#string". If a normal character is read, it returns the +ASCII value. If "delim" (usually " or ') is read, it returns EOF. If +a newline (ASCII linefeed) is read, it increments the global "yyline" +and ^&calls itself recursively\& for the next line of input. It may use +the ungetc() function to back up in the input stream. +.note +This routine is very application-specific for use by LEX and YACC when they +are working together. You should read the code in MAPCH.C before using this +function. +.en +.hl 3 ^&Token -- get pointer to token\& +.s.i +8;char * +.i +8;token(end__pointer) +.i +8;char **end__pointer; +.s +Token() +locates the first byte +of the current token and returns its address. +It takes an argument which is either NULL +or a pointer to a character pointer; +if the latter, that pointer is set to point to +the byte +^&after\& +the last byte of the current token. +Token() +is slightly faster, and more convenient than +gettoken() +for those cases where the token +is only one or two bytes long. +.s.f +.hl 1 ^&Error Detection and Recovery\& +.tp 3.s +If a character is detected +in the input stream +which cannot be added to the +last-matched string, +and which cannot start a string, +then that character is considered +illegal +by +LEX. +LEX +may be instructed to return a special +'error' +token, +or to write a diagnostic with +lexerror(). +At present, +the former is the default action. +.tp 3.s +The +token +LEXERR +is a special value which is recognised +by +Yacc, +and causes it to start its own error recovery. +It is defined by +the header file +lex.h +for use by other programs. +.tp 3.s +Often, it makes more sense to simply +type a suitable diagnostic, and continue +by ignoring the offending character. +It is fairly easy to cause +LEX +to do this, by including the +auxiliary definition: +.nf.s + illegal = [_\0-_\377]; +.f.s +which defines a character class +"illegal" +which is handled specially by +LEX. +If the character that is causing the trouble +is a member of that character class +(and in the example, +all characters are), +then +LEX +will write a diagnostic, +and ignore it; +otherwise, it will return the special +token +LEXERR +.tp 3.s +More comprehensive +techniques may be added +as they become apparent. +.hl 1 ^&Ambiguity and Look-ahead\& +Many computer languages have ambiguous grammars in that an input token +may represent more than one logical entity. This section discusses +the way in which grammars built by LEX resolve ambiguous input, as +well as a way for the grammar to assign unique meaning to a token +by looking ahead in the input stream. +.hl 2 ^&Resolving Ambiguities\& +.tp 3.s +A +LEX +program +may be ambiguous, +in the sense that +a particular input string or strings +might be matched by the regular expression of +more than one translation. +Consider, +.nf.s + [a-z] { putchar(*token(NULL)); } + aaa* { printf("abc"); } +.f.s +in which the string 'aa' is matched by +both regular expressions +(twice by the first, +and once by the second). +Also, the string 'aaaaaa' may be matched +in many different ways. +LEX +has to decide somehow +which actions should be performed. +(Alternatively, +it could produce a diagnostic, and give up. +As it happens, +LEX +never does this.) +.tp 3.s +Consider a second example, +.nf.s + letter = [a-z]; + %% + A(letter)* { return(1); } + AB(letter)* { return(2); } +.f.s +which attempts to distinguish +sequences of letters that begin with 'a' +from similar sequences that begin with 'ab'. +These two examples illustrate +two different kinds of ambiguity, +and the following indicates how +LEX +resolves these. +.tp 3.s +In the first example, +it seems likely that the intent was +to have both 'aa' and 'aaaaaa' perform +the second action, while all single letters 'a' +cause the first action to be performed. +LEX +does this by ensuring that the longest +possible part of the input stream +will be used to determine the match. +Thus, +.nf.s + < { return(LESS); } + <= { return(LESSEQ); } +.f.s +or +.nf.s + digit(digit)* { return(NUMBER); } + letter(letter|digit)* { return(NAME); } +.f.s +would work as one might expect. +.tp 3.s +In the second example, +the longest-string +need not work. +On the string "abb9", +either action could apply, +and so another rule must be followed. +This states that +if, after the longest-string +rule has been applied, there remains an ambiguity, +then the action which appears first in the +LEX +program +file is to be performed. +As the second example is written, the second +action will never be performed. +It would have been written as: +.nf.s + letter = [a-z]; + %% + AB(letter)* { return(1); } + A(letter)* { return(2); } +.f.s +The two rules together +completely determine a string. +.tp 3.s +At present, +LEX +produces no diagnostic in either case; +it merely applies the rules and +proceeds. +In the case where priority is given to +the first-appearing rule, +it might be a good idea to produce a diagnostic. +.hl 2 ^&Look-ahead\& +.tp 3.s +Some facility for looking ahead in the +input stream +is sometimes required. +(This facility might also be regarded +as a way for the programmer to more closely control +LEX's +ambiguity resolution process.) +For example, in C, +a name followed by "(" is +to be contextually declared as an external +function if it is otherwise undefined. +.tp 3.s +In Pascal, +look-ahead is required +to determine that +.nf.s + 123..1234 +.f.s +is an integer 123, followed by +the subrange symbol "..", +followed by the integer 1234, +and not simply two real numbers +run together. +.tp 3.s +In both of these cases, the desire is to look ahead +in the input stream far enough to be able to +make a decision, +but +without +losing +tokens in the process. +.tp 3.s +A special form of regular expression is used to indicate look-ahead: +.nf.s + re1 '/' re2 '{' action '}' +.f.s +where +'re1' +and +'re2' +are regular expressions. +The slash +is treated as concatenation +for the purposes of matching +incoming characters; +thus both +'re1' +and +'re2' +must match adjacently for the +action +to be performed. +'Re1' +indicates that part +of the input string +which is the token to be returned, +while +'re2' +indicates the context. +The characters matched by +'re2' +will be re-read at the next call to +yylex(), +and broken into tokens. +.s +Note that you cannot write: +.nf.s + name = re1 / re2; +.f.s +The look-ahead operator must be part of the rule. It is not valid +in definitions. +.tp 3.s +In the first example, +the look-ahead operator would be used as: +.nf.s + name / "(" { + if (name undefined) + declare name a global function; + } + name { /* usual processing for identifiers */ + } +.f.s +In the second example, the range construction would be parsed +as follows: +.s.nf + digit = [0-9]; + int = digit(digit)*; + _%_% + int / ".." int { /* Start of a range */ + ".." int { /* End of a range */ +.s.f +.tp 3.s +Note that right-context is not sufficient to handle certain types of +ambiguity, as is found in several places in the Fortran language. +For example, +.s.nf + do i = 1 Is an assignment statement + do i = 1, 4 Is a DO statement +.s.f +It is not sufficient to use right-context scanning to look for the +comma, as it may occur within a parenthesized sub-expression: +.s.nf + do i = j(k,l) Is an assignment statement +.s.f +In Fortran, similar problems exist for IF and FORMAT statements, as +well as counted (Hollerith) string constants. All of these require +a more powerful grammar than is possible with LEX regular-expressions. +.hl 1 ^&Multiple Scanning Tables_; Processor Switching\& +.tp 3.s +Even a fairly simple syntax +may be difficult, or impossible, +to describe +and process with a single set of translations. +An example of this may be found in C, +where strings, +which are part of the language, +have quite a different structure, +and in order to process them, either +a function must be called which reads and parses +the input stream for itself, +or some mechanism within +LEX +must be invoked to cause a (usually massive) +change of state. +.tp 3.s +LEX +does provide such a facility, +which is known, +after AED, +as +'processor switching'. +Yylex() +locates its tables through a pointer; +if one simply changes the pointer to point +at a new set of tables, +one will have effected the required change of state. +The +LEX +library function +lexswitch(), +which is described elsewhere in this guide, +arranges to do this; +it also returns the old value of the pointer +so that it may be restored by a later call +to +Lexswitch. +Thus, scanning environments may be stacked, or not, +as the user requires. +.hl 2 ^&Creation of a Processor\& +.tp 3.s +It should be clear that if all the +tables produced by +LEX +from a user's translation file +have the same name, +someone (the loader) is bound to object. +Some method must be provided to +change the name +of the table. +.tp 3.s +This is done by an option flag to +the +LEX +command: +.nf.s + -t name +.f.s +will cause the scanning table to +be declared as +.nf.s + struct lextab name; +.f.s +so that it may be passed to +LEXswitch: +.nf.s + lexswitch(_&name); +.f.s +LEX +also writes the program file to +the file +"name.c" +rather than to +"lextab.c." +.note +If you use the "easy" command line ("-e name") when running LEX, +the output file and table names will correspond nicely. Re-read the +section on operating LEX for more details. +.en +.hl 1 ^&Conclusion\& +.tp 3.s +LEX +seems to handle +most lexical analysis +tasks easily. +Indeed, +LEX +may be more generally used to write +commands of a text-processing nature; +an example of such usage may +be found in an appendix. +LEX +programs are far easier to write +than the equivalent C programs, +and generally consume less +space +(although there is an initial overhead +for the more general table-interpreter +program). +The encoding +suggested in +[4] +achieves a reasonable compromise between +table size, and scanning speed. +Certainly +lexical analysers +are less tedious and +time-consuming to write. +.tp 3.s +It is expected that most change +in the future will be through additions +to the +LEX +library. +The +LEX +language may change slightly to +accomodate common kinds of processing +(eg, break characters), +or to extend its range of application. +Neither kind of change should affect +existing +LEX +programs. +.tp 3.s +LEX +produces tables and programs +for the C language. +The tables are in a very simple +(and stylised) +format, and when +LEX +copies the action routines +or the program section, +the code might as well be Fortran +for all it cares. +One could write Unix filters +to translate the very simple C format tables +into other languages, +allowing +LEX +to be used with a larger number of +languages, +with little extra development cost. +This seems a likely future addition. +.s +Because of the look-ahead necessary to implement the "longest string match" +rule, LEX is unsuitable for interactive programs whose overall +structure is: +.s.nf + for (;;) { + prompt__user(); + get__input(); + process(); + print__output(); + } +.s.f +If these are rewritten as LEX-generated grammars, the user will be confused +by the fact the second input datum must be entered before the first is +processed. It is possible to solve this dilemna by rewriting function +lexgetc() to return an "end-of-line" character until processing is +complete for that line. An example +is shown in the Appendix. +.hl 1 ^&Acknowledgements\& +.tp 3.s +LEX +is based on a processor of the same name +at Bell Laboratories, +which also runs under Unix [3], +and, +more distantly, +on AED-0 [1]. +This version of +LEX +was based on +the description and suggestions of +[4], +although the implementation +differs significantly in a number of ways. + +.hl 1 ^&References\& +.lm +8 +.s.i -4;#1.#Johnson, W.L., et. al., +"Automatic generation of efficient lexical analysers using finite +state techniques", +CACM Vol. 11, No. 12, +pp. 805-813, 1968. +.s.i -4;#2.#Johnson, S.C., +"Yacc -- Yet Another Compiler-Compiler", +CSTR-32, +Bell Telephone Laboratories, +Murray Hill, +New Jersey, +1974. +.s.i -4;#3.#Lesk, M.E., +"Lex - a lexical analyser generator", +CSTR-39, +Bell Telephone Laboratories, +Murray Hill, +New Jersey, 1975. +.s.i -4;#4.#Aho, A.V., +Ullman, J.D., +^&Principles of Compiler Design,\& +Addison-Wesley, +Don Mills, +Ontario, +1977. +.lm -8 + .appendix LEX Source Grammar +.t ########A Lexical Analyser Generator +.st ########LEX Source Grammar +.lm 8.rm 72 +The following is a grammar of LEX programs which generally follows +Bacus-Naur conventions. In the rules, "||" stands for +alternation (choose one or the other). +Other graphic text stands for +itself. Several grammar elements have special meaning: +.lm +24 +.s.i -16;_ Any text not including the following +grammar element (either a literal or end-of-file). +.s.i -16;_ Nothing -- used for optional rule elements. +.s.i -16;_ A variable name. +.s.i -16;_ A character class specifier. +.s.i -16;_ A string (text inclosed in '"'). +.s.i -16;_ The end of the input file. +.lm -24 +.s +This grammar was abstracted from the Yacc grammar used to describe +LEX. +.literal + + program :== aux_section trans_section + + aux_section ::= auxiliaries %% + || %% + + auxiliaries ::= auxiliaries aux_def + || aux_def + + aux_def ::= name_def = reg_exp ; + || %{ %} + + name_def ::= + + reg_exp ::= + || + || + || reg_exp * + || reg_exp | reg_exp + || reg_exp reg_exp + || ( reg_exp ) + + trans_section ::= translations + || + + translations ::= translations translation + || translation + + translation ::= pattern action + || %{ %} + || %% + + pattern ::= reg_exp / reg_exp + || reg_exp +.end literal + .appendix Some Small Examples +.t ########A Lexical Analyser Generator +.st ########Some Small Examples +.lm 8.rm 72 +.s 2 +The following example illustrates +the use of the look-ahead operator, +and various other of the nuances of using +LEX. +.hl 1 ^&A Complete Command\& +.s +The C programming language +has had two different +ways of writing its assignment operators. +The original method was to write a +binary operator immediately following the +ordinary assignment operator, +forming a compound operator. +Thus +'a =+ b' caused the value of 'a+b' +to be assigned to 'a'. +Similarly, +.s.nf + =- =/ =_% =* =<< =>> =| =_& =_^ +.s.f +were written for the assignment operators +corresponding to +subtraction, +division, +modulus, +multiplication, +left shift, +right shift, +logical OR, +logical AND, +and +exclusive OR. +In the current version +of the language, +the binary operator +is written to the left of the assignment operator, +to remove potential ambiguity. +.s +The +LEX +program +"ctoc" +is a +filter which +converts programs written in the older style +into programs written in the newer style. +It uses the look-ahead operator, +and the various +dis-ambiguating rules +to ensure that sequences like +.s.nf + a==-1 a=++b +.s.f +remain unchanged. +.page +.nf +/* + * ctoc.lxi -- Convert old C operators to new C form + * + * Adapted from example in C. Forsythe's LEX manual. + * + * NOTE: + * Forsythe's program put an entire comment into the token + * buffer. Either define a huge token buffer for my typical + * monster comments, or filter text within comments as if + * it were real C code. This is what I did. So =+ inside + * a comment will get changed to +=, etc. Note tnat you + * may use the commen() function in LEXLIB if you want the + * comments eaten. I wanted 'em in the output. + * by + * Bob Denny + * 31-Feb-81 + */ + +_%{ + +char tbuf[80]; /* Token buffer */ + +main() + { + while (yylex()) + ; + } + +_%} + +any = [_\0-_\177]; +nesc = [_^_\_\]; +nescquote = [_^_\_\"]; +nescapost = [_^_\_\']; +schar = "_\_\" any | nescquote; +cchar = "_\_\" any | nescapost; +string = '"' schar* '"'; +charcon = "'" cchar* "'"; +_%_% + +"=" ( << | >> | "*" | + | - | "/" | "_%" | "_&" | "|" | "_^" ) + { + gettoken(tbuf, sizeof tbuf); + printf("_%s=",tbuf+1); + } + +/* + * The following will overflow the token buffer on any but a + * small comment: + */ +/********* +"/*" ([_^*] | "*"[_^/])* "*/" + { + lexecho(stdout); + } +**********/ + +[<=>!]"=" | "="[<>] + { + lexecho(stdout); + } + +"=" / ( ++ | -- ) + { + lexecho(stdout); + } + +charcon + { + lexecho(stdout); + } + +string + { + lexecho(stdout); + } + +[_\0-_\377] + { + lexecho(stdout); + } +.s 2.f +Assuming the Decus compiler running on RSTS/E in RT11 mode, the +above program would be built and executed as follows: +.s.nf + mcr lex -i ctoc.lxi -o ctoc.c + cc ctoc/v + as ctoc/d + link ctoc=ctoc,c:lexlib,c:suport,c:clib/b:2000 +.s + mcr ctoc new.c +.s.f +.hl 1 ^&Interactive Lexical Analysis\& +The following program reads words from the terminal, counting each +as they are entered. The interaction with the operator is "natural" +in the sense that processing for one line is complete before the +next line is input. To implement this program, it was necessary +to include a special version of lexgetc() which returns +if the current line has been completely transmitted to the parser. +Because the parser must still have some look-ahead context, it will +return the "end-of-line" token ^&twice\& at the beginning of processing. +This required some additional tests in the main program. +.s.nf +/* + * Count words -- interactively + */ +white = [_\n_\t ]; /* End of a word */ +eol = [_\0]; /* End of input line */ +any = [!-~]; /* All printing char's */ +illegal = [_\0-_\377]; /* Skip over junk */ +_%{ +char line[133]; +char *linep = _&line; +int is_eof = 0; +int wordct = 0; +_#define T__EOL 1 +main() +{ + register int i; + while ((i = yylex()) != 0) { + /* + * If the "end-of-line" token is + * returned AND we're really at + * the end of a line, read the + * next line. Note that T__EOL is + * returned twice when the program + * starts because of the nature of + * the look-ahead algorithms. + */ + if (i == T__EOL _&_& !is__eof + _&_& *linep == 0) { + printf("* "); + fflush(stdout); + getline(); + } + } + printf("_%d words_\n", wordct); +} +_%} +_%_% + +any(any)* { + /* + * Write each word on a + * seperate output line. + */ + lexecho(stdout); + printf("_\n"); + wordct++; + return(LEXSKIP); + } +eol { + return(T__EOL); + } +white(white)* { + return(LEXSKIP); + } +_%_% + +getline() +/* + * Read a line for lexgetc() + */ +{ + is__eof = (fgets(line, sizeof line, stdin) + == NULL); + linep = _&line; +} + +lexgetc() +/* + * Homemade lexgetc -- return zero while at the + * end of an input line or EOF at end of file. If + * more on this line, return the next byte. + */ +{ + return( (is__eof) ? EOF + : (*linep == 0) ? 0 + : *linep++); +} diff --git a/c20/lex/lex.stinkr b/c20/lex/lex.stinkr new file mode 100644 index 00000000..1573fee0 --- /dev/null +++ b/c20/lex/lex.stinkr @@ -0,0 +1,11 @@ +x clib:stdio +l lex +l lexsrt +l dfa +l min +l out +l ytab +l base +l eclosu +l impure +o lex.exe diff --git a/c20/lex/lex.y b/c20/lex/lex.y new file mode 100644 index 00000000..f3c33c17 --- /dev/null +++ b/c20/lex/lex.y @@ -0,0 +1,596 @@ +/* + * Copyright (c) 1978 Charles H. Forsyth + */ + +/* + * W A R N I N G + * + * This file is NOT identical with ytab.c. Several changes which were + * made directly to ytab.c have not been made to lex.y + * + * If you have access to yacc and rebuild ytab.c from lex.y, it is + * essential that you compare the current ytab.c with the new version, + * incorporating the necessary changes. + */ + +/* + * lex -- grammar/lexical analyser + */ + +%{ +#include +#include "lexlex.h" +char copr[] "Copyright (c) 1978 Charles H. Forsyth"; +struct des { + struct nfa *d_start; + struct nfa *d_final; +}; +struct nlist { + struct nlist *nl_next; + struct nfa *nl_base; + struct nfa *nl_end; + struct nfa *nl_start; + struct nfa *nl_final; + char *nl_name; +} *nlist; +int strlen; +extern struct nfa *elem(); +extern struct des *newdp(); +extern struct nlist *lookup(); +extern char *spccl(); +%} +%term NAME CCLASS STRING CONCAT + +%left ';' +%left '=' +%left '/' +%left '|' +%left '(' NAME STRING CCLASS +%left CONCAT +%left '*' +%% +%{ + struct nfa *np, *nbase; + char *cp; + struct des *dp; + struct trans *tp; + struct nlist *nl; + int i, c; +%} +lexfile: + auxiliary_section translation_section +| +; + +auxiliary_section: + auxiliaries '%' '%' +| '%' '%' +; + +auxiliaries: + auxiliaries auxiliary +| auxiliary +; + +auxiliary: + namedef '=' regexp ';' ={ + dp = $3; + nl = $1; + np = nl->nl_base; + nl->nl_start = dp->d_start; + nl->nl_final = dp->d_final; + nl->nl_end = nfap; + printf("NFA for %s\n", nl->nl_name); + nfaprint(dp->d_start, nl->nl_base); + nbase = lalloc(i = nl->nl_end-nl->nl_base, sizeof(*nbase), + "nfa storage"); + copynfa(nl, nbase, dp); + nl->nl_start = dp->d_start; + nl->nl_final = dp->d_final; + nl->nl_end = nbase+i; + nl->nl_base = nbase; + nfap = np; + ignore = spccl(nl->nl_name, "ignore", dp); + breakc = spccl(nl->nl_name, "break", dp); + illeg = spccl(nl->nl_name, "illegal", dp); + } +| '%' '{' ={ copycode(); } +; + +namedef: + NAME ={ + $$ = lookup($1); + $$->nl_base = nfap; + if ($$->nl_start) + error("%s redefined", $$->nl_name); + } +; + +name: + NAME ={ $$ = lookup($1); } +; + +regexp: + CCLASS ={ + np = elem(CCL, $1); + $$ = newdp(np, np->n_succ[0] = elem(FIN)); + } +| STRING ={ + cp = $1; + if (strlen == 0) { + np = elem(EPSILON); + $$ = newdp(np, np->n_succ[0] = elem(FIN)); + return; + } + $$ = np = elem(*cp++); + while (--strlen > 0) + np = np->n_succ[0] = elem(*cp++); + $$ = newdp($$, np->n_succ[0] = elem(FIN)); + } +| name ={ + if ((nl = $1)->nl_end == 0) { + error("%s not defined", nl->nl_name); + nl->nl_base = nl->nl_end = elem(FIN); + nl->nl_start = nl->nl_final = nl->nl_base; + } + $$ = dp = lalloc(1, sizeof(*dp), "dfa input"); + nbase = nfap; + i = nl->nl_end-nl->nl_base; + if ((nfap += i) >= &nfa[MAXNFA]) { + error("Out of NFA nodes"); + exit(1); + } + copynfa(nl, nbase, dp); + } +| regexp '*' ={ + $$ = dp = $1; + dp->d_start = newnfa(EPSILON, np = dp->d_start, 0); + dp->d_final->n_char = EPSILON; + dp->d_final->n_succ[0] = np; + dp->d_final->n_succ[1] = np = elem(FIN); + dp->d_start->n_succ[1] = np; + dp->d_final = np; + } +| regexp '|' regexp ={ + $$ = dp = $1; + dp->d_start = newnfa(EPSILON, dp->d_start, $3->d_start); + dp->d_final->n_char = EPSILON; + dp->d_final = dp->d_final->n_succ[0] = np = elem(FIN); + dp = $3; + dp->d_final->n_char = EPSILON; + dp->d_final->n_succ[0] = np; + cfree($3); + } +| regexp regexp %prec CONCAT ={ + $$ = $1; + dp = $2; + np = $$->d_final; + $$->d_final = dp->d_final; + np->n_char = dp->d_start->n_char; + np->n_ccl = dp->d_start->n_ccl; + np->n_succ[0] = dp->d_start->n_succ[0]; + np->n_succ[1] = dp->d_start->n_succ[1]; + cfree($2); + } +| '(' regexp ')' ={ $$ = $2; } +; + +translation_section: + translations ={ + ending(); + trans1: + printf("\nNFA for complete syntax\n"); + printf("state 0\n"); + for (tp = trans; tp < transp; tp++) + printf("\tepsilon\t%d\n", tp->t_start-nfa); + for (tp = trans; tp < transp; tp++) + nfaprint(tp->t_start, nfa); + dfabuild(); + dfamin(); + dfaprint(); + dfawrite(); + stats(); + } +| ={ goto trans1; } +; + +translations: + translations translation +| llactr translation +; + +llactr: + ={ + llactr(); + } +; + +translation: + pattern action ={ dp = $1; newtrans(dp->d_start, dp->d_final); } +| '%' '{' ={ copycode(); } +| '%' '%' ={ + ending(); + while ((c = get()) != EOF) + putc(c, llout); + } +; + +action: + '{' ={ action(); } +; + +pattern: + regexp '/' regexp ={ + if (nlook >= NBPW) + error("More than %d translations with lookahead",NBPW); + $$ = dp = $1; + np = dp->d_final; + np->n_char = EPSILON; + np->n_flag |= LOOK; + np->n_succ[0] = $3->d_start; + dp->d_final = $3->d_final; + np->n_look = nlook; + dp->d_final->n_look = nlook++; + dp->d_final->n_flag |= FLOOK; + cfree($3); + } +| regexp +; + +%% +/* + * Lexical analyser + * (it isn't done with lex...) + */ +char buffer[150]; + +yylex() +{ + register c; + register char *cp; + int lno; + + if (yyline == 0) + yyline++; +loop: + c = get(); + if (isupper(c)) { + name(c); + for (cp = yylval; c = *cp; cp++) + if (isupper(c)) + *cp = tolower(c); + return(STRING); + } else if (islower(c) || c == '_') { + name(c); + return(NAME); + } + switch (c) { + case EOF: + return(0); + + case '[': + return(cclass()); + + case '(': + case ')': + case '{': + case '}': + case '*': + case '|': + case '=': + case ';': + case '%': + return(c); + + case '/': + if ((c = get()) != '*') { + unget(c); + return('/'); + } + lno = yyline; + for (; c != EOF; c = get()) + if (c == '*') + if ((c = get()) == '/') + goto loop; else + unget(c); + yyline = lno; + error("End of file in comment"); + + case '\'': + case '"': + yylval = buffer; + string(c); + return(STRING); + + case '\n': + case ' ': + case '\t': + goto loop; + + default: + yylval = buffer; + if (c == '\\') { + unget(c); + c = mapch(EOF); + } + buffer[0] = c; + buffer[1] = 0; + strlen = 1; + return(STRING); + } +} + +char ccl[(NCHARS+1)/NBPC]; + +cclass() +{ + register c, i, lc; + int compl; + + compl = 0; + for (i = 0; i < sizeof ccl; i++) + ccl[i] = 0; + if ((c = get()) == '^') + compl++; else + unget(c); + lc = -1; + while ((c = mapc(']')) != EOF) { + if (c == '-' && lc >= 0) { + if ((c = mapc(']')) == EOF) + break; + for (i = lc; i <= c; i++) + ccl[i/NBPC] |= 1<<(i%NBPC); + lc = -1; + continue; + } + ccl[c/NBPC] |= 1<<(c%NBPC); + lc = c; + } + if (compl) { + for (i = 0; i < sizeof ccl; i++) + ccl[i] ^= -1; + if (aflag == 0) + for (i = 0200; i < (1<= '0' && c <= '7') { + i = 0; + for (v = 0; c>='0' && c<='7' && i++<3; c = get()) + v = v*010 + c-'0'; + unget(c); + return(v&0377); + } + switch (c) { + case 'n': + return('\n'); + + case 't': + return('\t'); + + case 'b': + return('\b'); + + case 'r': + return('\r'); + + case '\n': + yyline++; + return(mapc(ec)); + } + + default: + return(c); + } +} + +name(c) +register c; +{ + register char *cp; + + for (yylval=cp=buffer; isalpha(c) || isdigit(c) || c=='_'; c=get()) + *cp++ = c; + *cp = 0; + strlen = cp-buffer; + unget(c); +} + +/* + * Miscellaneous functions + * used only by lex.y + */ +struct nfa * +elem(k, v) +{ + struct nfa *fp; + + fp = newnfa(k, 0, 0); + if (k == CCL) + fp->n_ccl = v; + return(fp); +} + +struct des * +newdp(st, fi) +struct nfa *st, *fi; +{ + register struct des *dp; + + dp = lalloc(1, sizeof(*dp), "dfa input"); + dp->d_start = st; + dp->d_final = fi; + return(dp); +} + +action() +{ + register c; + int lno, lev; + + newcase(transp-trans); + lno = yyline; + lev = 0; + for (; (c = get()) != EOF && (c != '}' || lev); putc(c, llout)) + if (c == '{') + lev++; + else if (c == '}') + lev--; + else if (c == '\'' || c == '"') { + putc(c, llout); + skipstr(c); + } + fprintf(llout, "\n\tbreak;\n"); + if (c == EOF) { + yyline = lno; + error("End of file in action"); + } +} + +skipstr(ec) +register ec; +{ + register c; + + while ((c = get()) != ec && c != EOF) { + putc(c, llout); + if (c == '\\' && (c = get()) != EOF) + putc(c, llout); + } +} + + +copycode() +{ + int lno; + register c; + + setline(); + lno = yyline; + for (; (c = get()) != EOF; putc(c, llout)) + if (c == '%') { + if ((c = get()) == '}') + return; + unget(c); + c = '%'; + } + yyline = lno; + error("Incomplete %{ declaration"); + exit(1); +} + +struct nlist * +lookup(s) +register char *s; +{ + register struct nlist *nl; + register char *cp; + int i; + + for (nl = nlist; nl; nl = nl->nl_next) + if (streq(s, nl->nl_name)) + return(nl); + nl = lalloc(1, sizeof(*nl), "namelist"); + nl->nl_start = nl->nl_end = nl->nl_base = nl->nl_end = 0; + nl->nl_next = nlist; + nlist = nl; + i = 0; + for (cp = s; *cp++;) + i++; + nl->nl_name = cp = lalloc(i+1, sizeof(*cp), "namelist"); + while (*cp++ = *s++) + ; + return(nl); +} + +copynfa(nl, nbase, dp) +struct nlist *nl; +struct des *dp; +struct nfa *nbase; +{ + register struct nfa *np, *ob; + register j; + int i, ix; + + ob = nl->nl_base; + i = nl->nl_end-ob; + copy(ob, sizeof(*np), i, nbase); + for (np = nbase; i-- > 0; np++) { + np->n_flag &= ~NPRT; + for (j = 0; j < 2; j++) + if (np->n_succ[j]) + np->n_succ[j] = (np->n_succ[j]-ob)+nbase; + } + dp->d_start = (nl->nl_start-ob)+nbase; + dp->d_final = (nl->nl_final-ob)+nbase; +} + +char * +spccl(nm, isit, dp) +char *nm, *isit; +register struct des *dp; +{ + if (!streq(nm, isit)) + return(0); + if (dp->d_start->n_char == CCL && + dp->d_start->n_succ[0] == dp->d_final) + return(dp->d_start->n_ccl); + error("Illegal %s class", isit); + return(0); +} + +get() +{ + register c; + + if ((c = getc(stdin)) == '\n') + yyline++; + return(c); +} + +unget(c) +register c; +{ + if (c == '\n') + yyline--; + ungetc(c, stdin); +} + +error(s) +char *s; +{ + if (yyline) + fprintf(stderr, "%d: ", yyline); + fprintf(stderr, "%r", &s); + if (yychar > 256) + fprintf(stderr, " near `%s'", yysterm[yychar-256]); + else if (yychar < 256 && yychar > 0) + fprintf(stderr, " near `%c'", yychar); + fprintf(stderr, "\n"); +} diff --git a/c20/lex/lexcha.c b/c20/lex/lexcha.c new file mode 100644 index 00000000..5fad0f99 --- /dev/null +++ b/c20/lex/lexcha.c @@ -0,0 +1,19 @@ +/* + * Bob Denny 28-Aug-82 Remove reference to stdio.h + */ + +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +/*)LIBRARY +*/ + +extern char *llp2; + +lexchar() +{ + return(llend +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +/*)LIBRARY +*/ + +lexecho(fp) +register FILE *fp; +{ + register char *lp; + + for (lp = llbuf; lp < llend;) + putc(*lp++, fp); +} diff --git a/c20/lex/lexerr.c b/c20/lex/lexerr.c new file mode 100644 index 00000000..48be77ea --- /dev/null +++ b/c20/lex/lexerr.c @@ -0,0 +1,20 @@ +/* + * lexerr.c + * + * Bob Denny 28-Aug-82 + * Move stdio dependencies to lexerr(), lexget(), lexech() and mapch() + * + * This is one of 4 modules in lexlib which depend + * upon the standard I/O package. + */ + +#include +#include + +lexerror(s) +{ + if (yyline) + fprintf(stderr, "%d: ", yyline); + fprintf(stderr, "%s", s); + fprintf(stderr, "\n"); +} diff --git a/c20/lex/lexerr.old b/c20/lex/lexerr.old new file mode 100644 index 00000000..05f49b03 --- /dev/null +++ b/c20/lex/lexerr.old @@ -0,0 +1,31 @@ +/* + * lexerr.c + * + * Bob Denny 28-Aug-82 + * Move stdio dependencies to lexerr(), lexget(), lexech() and mapch() + * + * This is one of 4 modules in lexlib which depend + * upon the standard I/O package. + */ + +#include +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +/*)LIBRARY +*/ + +lexerror(s) +{ + if (yyline) + fprintf(stderr, "%d: ", yyline); +#ifdef vms + fprintf(stderr, "%s", s); +#else + fprintf(stderr, "%r", &s); +#endif + fprintf(stderr, "\n"); +} diff --git a/c20/lex/lexget.c b/c20/lex/lexget.c new file mode 100644 index 00000000..d3b4fa1b --- /dev/null +++ b/c20/lex/lexget.c @@ -0,0 +1,26 @@ +/* + * lexget.c + * + * Bob Denny 28-Aug-82 + * Move stdio dependencies to lexerr(), lexget(), lexech() and mapch() + * + * This is one of 4 modules in lexlib which depend + * upon the standard I/O package. + */ + +#include +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +/*)LIBRARY +*/ + +FILE *lexin; /* File pointer moved to here */ + +lexgetc() +{ + return(getc(lexin)); +} diff --git a/c20/lex/lexlen.c b/c20/lex/lexlen.c new file mode 100644 index 00000000..be9549a7 --- /dev/null +++ b/c20/lex/lexlen.c @@ -0,0 +1,20 @@ +/* + * Bob Denny 28-Aug-82 Remove reference to stdio.h + */ + +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +/*)LIBRARY +*/ + +lexlength() +/* + * Return the length of the current token + */ +{ + return(llend - llbuf); +} diff --git a/c20/lex/lexlex.h b/c20/lex/lexlex.h new file mode 100644 index 00000000..071d9b5b --- /dev/null +++ b/c20/lex/lexlex.h @@ -0,0 +1,155 @@ + +/* + * lex -- header file for lex.c + */ + +#define DEBUG 1 /* Debuging */ + +#define NCHARS 0400 /* Size of character set */ +#define NCPW 2 /* # characters per word */ +#define NBPC 8 /* # bits per character */ +#define NBPW (NCPW*NBPC) /* # bits per word */ + +#define MAXNFA 600 /* Number of NFA states */ +#define MAXDFA 800 /* Number of DFA states */ +/* + * Cut down maxnfa/maxdfa for Decus C + */ +#ifdef decus +#ifdef rt11 +#define MAXNFA 300 /* Number of NFA states */ +#define MAXDFA 400 /* Number of DFA states */ +#else +#define MAXNFA 200 /* Number of NFA states */ +#define MAXDFA 300 /* Number of DFA states */ +#endif +#endif + +#define NTRANS 128 /* Number of translations */ +#define NCCLS 50 /* Number of character classes */ +#define NNEXT 15000 /* 2400 */ /* Size of dfa move vectors (later: allocate) */ + +/* + * Special node characters. + */ +#define CCL NCHARS /* One of a character class */ +#define EPSILON NCHARS+1 /* Transition on epsilon */ +#define FIN NCHARS+2 /* Final state; NFA */ + +/* + * Set of state numbers (dfa state name). + */ +struct set { + struct set *s_next; + struct dfa *s_state; /* pointer into dfa array */ + struct set *s_group; /* pointer to owning group (dfamin) */ + int s_final; /* nf state which matches */ + char s_flag; /* see below */ + int s_look; /* look-ahead bits */ + int s_len; /* number of elements in set */ + struct nfa *s_els[100]; +}; + +/* + * State entry + */ +struct nfa { + int n_char; + char *n_ccl; + char n_flag; + char n_look; /* lookahead index */ + struct nfa *n_succ[2]; + struct trans *n_trans; +}; + +/* + * DFA transition entry. + */ +struct move { + struct set *m_next; + struct dfa *m_check; +}; + +/* + * Structure of DFA vector. + */ +struct dfa { + struct set *df_name; + struct move *df_base; + struct move *df_max; + struct dfa *df_default; + int df_ntrans; +}; + +/* + * s_flag values for DFA node + */ +#define LOOK 01 /* Lookahead mark */ +#define ADDED 02 /* DFA construction mark */ +#define FLOOK 04 /* Mark on final state of lookahead translation */ + +/* + * Flag used to print node + */ +#define NPRT 010 /* NFA node printed */ + +/* + * Transition set. + */ +struct xset { + struct set *x_set; + char x_char; + char x_defsame; +}; + +/* + * Translations + */ +struct trans { + struct nfa *t_start; + struct nfa *t_final; +}; + +/* + * External definitions. + */ +extern struct trans trans[]; +extern struct trans *trnsp; +extern struct nfa nfa[]; +extern struct nfa *nfap; +extern struct dfa dfa[]; +extern int ndfa; +extern struct move move[]; +extern struct xset sets[]; +extern char insets[]; +extern struct set *setlist; +extern char ccls[][(NCHARS+1)/NBPC]; +extern int nccls; +extern int nlook; +extern int llnxtmax; +extern char *tabname; +extern FILE *llout; +extern FILE *lexlog; +extern FILE *lexin; +extern int lldebug; +extern int aflag; +extern char *infile; + +extern char *ignore; +extern char *illeg; +extern char *breakc; + +extern struct nfa *newnfa(); +extern struct set *newset(); +extern struct set *eclosure(); +extern struct dfa *defalt(); +extern struct move *stbase(); +extern struct set *chase(); +extern char *newccl(); +extern char *lalloc(); + +/* + * Yacc externals. + */ +extern int yyline; +extern char *yysterm[]; diff --git a/c20/lex/lexlex.old b/c20/lex/lexlex.old new file mode 100644 index 00000000..dc4cadd6 --- /dev/null +++ b/c20/lex/lexlex.old @@ -0,0 +1,150 @@ + +/* + * lex -- header file for lex.c + */ + +#define NCHARS 0400 /* Size of character set */ +#define NCPW 2 /* # characters per word */ +#define NBPC 8 /* # bits per character */ +#define NBPW (NCPW*NBPC) /* # bits per word */ + +#define MAXNFA 600 /* Number of NFA states */ +#define MAXDFA 800 /* Number of DFA states */ +/* + * Cut down maxnfa/maxdfa for Decus C + */ +#ifdef rt11 +#define MAXNFA 300 /* Number of NFA states */ +#define MAXDFA 400 /* Number of DFA states */ +#else +#define MAXNFA 200 /* Number of NFA states */ +#define MAXDFA 300 /* Number of DFA states */ +#endif +#define NTRANS 128 /* Number of translations */ +#define NCCLS 50 /* Number of character classes */ +#define NNEXT 2400 /* Size of dfa move vectors (later: allocate) */ + +/* + * Special node characters. + */ +#define CCL NCHARS /* One of a character class */ +#define EPSILON NCHARS+1 /* Transition on epsilon */ +#define FIN NCHARS+2 /* Final state; NFA */ + +/* + * Set of state numbers (dfa state name). + */ +struct set { + struct set *s_next; + struct dfa *s_state; /* pointer into dfa array */ + struct set *s_group; /* pointer to owning group (dfamin) */ + int s_final; /* nf state which matches */ + char s_flag; /* see below */ + int s_look; /* look-ahead bits */ + int s_len; /* number of elements in set */ + struct nfa *s_els[]; +}; + +/* + * State entry + */ +struct nfa { + int n_char; + char *n_ccl; + char n_flag; + char n_look; /* lookahead index */ + struct nfa *n_succ[2]; + struct trans *n_trans; +}; + +/* + * DFA transition entry. + */ +struct move { + struct set *m_next; + struct dfa *m_check; +}; + +/* + * Structure of DFA vector. + */ +struct dfa { + struct set *df_name; + struct move *df_base; + struct move *df_max; + struct dfa *df_default; + int df_ntrans; +}; + +/* + * s_flag values for DFA node + */ +#define LOOK 01 /* Lookahead mark */ +#define ADDED 02 /* DFA construction mark */ +#define FLOOK 04 /* Mark on final state of lookahead translation */ + +/* + * Flag used to print node + */ +#define NPRT 010 /* NFA node printed */ + +/* + * Transition set. + */ +struct xset { + struct set *x_set; + char x_char; + char x_defsame; +}; + +/* + * Translations + */ +struct trans { + struct nfa *t_start; + struct nfa *t_final; +}; + +/* + * External definitions. + */ +extern struct trans trans[]; +extern struct trans *transp; +extern struct nfa nfa[]; +extern struct nfa *nfap; +extern struct dfa dfa[]; +extern int ndfa; +extern struct move move[]; +extern struct xset sets[]; +extern char insets[]; +extern struct set *setlist; +extern char ccls[][(NCHARS+1)/NBPC]; +extern int nccls; +extern int nlook; +extern int llnxtmax; +extern char *tabname; +extern FILE *llout; +extern FILE *lexlog; +extern FILE *lexin; +extern int lldebug; +extern int aflag; +extern char *infile; + +extern char *ignore; +extern char *illeg; +extern char *breakc; + +extern struct nfa *newnfa(); +extern struct set *newset(); +extern struct set *eclosure(); +extern struct dfa *defalt(); +extern struct move *stbase(); +extern struct set *chase(); +extern char *newccl(); +extern char *lalloc(); + +/* + * Yacc externals. + */ +extern int yyline; +extern char *yysterm[]; diff --git a/c20/lex/lexlib.ctl b/c20/lex/lexlib.ctl new file mode 100644 index 00000000..6988b4c6 --- /dev/null +++ b/c20/lex/lexlib.ctl @@ -0,0 +1,23 @@ +; BUILD DECUS LEX LIBRARY FOR TOPS-20 +@DEF C: MSC:, PS: +@DEF SS: MSC: +@DEF CLIB: MSC: +@DEF SYS: SYS:, C: + +@pcc20 LEXSRT.C +@pcc20 COMMEN.C +@pcc20 GETTOK.C +@pcc20 INTEG.C +@pcc20 LEXCHA.C +@pcc20 LEXECH.C +@pcc20 LEXERR.C +@pcc20 LEXGET.C +@pcc20 LEXLEN.C +@pcc20 LEXPEE.C +@pcc20 LEXSWI.C +@pcc20 LLSAVE.C +@pcc20 LMOVB.C +@pcc20 LMOVI.C +@pcc20 TOKEN.C +@pcc20 YYLEX.C +@pcc20 MAPCH.C diff --git a/c20/lex/lexlib.mic b/c20/lex/lexlib.mic new file mode 100644 index 00000000..9ce186e1 --- /dev/null +++ b/c20/lex/lexlib.mic @@ -0,0 +1,2 @@ +@PIP +*LEXLIB.REL=LEX:LEXSRT.REL,LEX:COMMEN.REL,LEX:GETTOK.REL,LEX:INTEG.REL,LEX:LEXCHA.REL,LEX:LEXECH.REL,LEX:LEXGET.REL,LEX:LEXLEN.REL,LEX:LEXPEE.REL,LEX:LEXSWI.REL,LEX:LMOVB.REL,LEX:LMOVI.REL,LEX:TOKEN.REL,LEX:YYLEX.REL,LEX:MAPCH.REL,LEX:LLSAVE.REL,LEX:LEXERR.REL diff --git a/c20/lex/lexlib.stinkr b/c20/lex/lexlib.stinkr new file mode 100644 index 00000000..5c7dcba5 --- /dev/null +++ b/c20/lex/lexlib.stinkr @@ -0,0 +1,16 @@ +l lex:commen +l lex:gettok +l lex:integ +l lex:lexcha +l lex:lexech +l lex:lexerr +l lex:lexget +l lex:lexlen +l lex:lexpee +l lex:lexswi +l lex:lmovb +l lex:lmovi +l lex:token +l lex:mapch +l lex:yylex +l lex:llsave diff --git a/c20/lex/lexpee.c b/c20/lex/lexpee.c new file mode 100644 index 00000000..1db12770 --- /dev/null +++ b/c20/lex/lexpee.c @@ -0,0 +1,17 @@ +#include + +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +/*)LIBRARY +*/ + +extern char *llp2; + +lexpeekc() +{ + return(llend hp) { + if((c = (*qs__cmp)(hp, j)) == 0) { + q_exc(hp += es, j); + goto loop; + } + if(c > 0) { + if(i == lp) { + q_tex(i, hp += es, j); + i = lp += es; + goto loop; + } + q_exc(i, j); + j -= es; + i += es; + continue; + } + j -= es; + goto loop; + } + + + if(i == lp) { + if(lp-a >= l-hp) { + q_sort(hp+es, l); + l = lp; + } else { + q_sort(a, lp); + a = hp+es; + } + goto start; + } + + + q_tex(j, lp -= es, i); + j = hp -= es; + } +} + +q_exc(i, j) +char *i, *j; +{ + register char *ri, *rj, c; + int n; + + n = size; + ri = i; + rj = j; + do { + c = *ri; + *ri++ = *rj; + *rj++ = c; + } while(--n); +} + +q_tex(i, j, k) +char *i, *j, *k; +{ + register char *ri, *rj, *rk; + int c; + int n; + + n = size; + ri = i; + rj = j; + rk = k; + do { + c = *ri; + *ri++ = *rk; + *rk++ = *rj; + *rj++ = c; + } while(--n); +} diff --git a/c20/lex/lexswi.c b/c20/lex/lexswi.c new file mode 100644 index 00000000..850a4aca --- /dev/null +++ b/c20/lex/lexswi.c @@ -0,0 +1,28 @@ + +/* + * lexswitch -- switch lex tables + */ + +/* + * Bob Denny 28-Aug-82 Remove reference to stdio.h + */ + +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +/*)LIBRARY +*/ + +struct lextab * +lexswitch(lp) +struct lextab *lp; +{ + register struct lextab *olp; + + olp = _tabp; + _tabp = lp; + return(olp); +} diff --git a/c20/lex/lextab.c b/c20/lex/lextab.c new file mode 100644 index 00000000..ae20a385 --- /dev/null +++ b/c20/lex/lextab.c @@ -0,0 +1,62 @@ +/* + * Created by DECUS LEX from file "tt1:" Tue Aug 31 21:01:15 1982 + */ + +/* + * CREATED FOR USE WITH STANDARD I/O + */ + +# +#include +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +extern int _lmovb(); + +int _Flextab[] = + { + -1, -1, + }; + +#line 1 "tt1:" + +#define LLTYPE1 char + +LLTYPE1 _Nlextab[] = + { + 1, + }; + +LLTYPE1 _Clextab[] = + { + -1, + }; + +LLTYPE1 _Dlextab[] = + { + 1, + }; + +int _Blextab[] = + { + 0, 0, + }; + +struct lextab lextab = { + 1, /* Highest state */ + _Dlextab, /* --> "Default state" table */ + _Nlextab, /* --> "Next state" table */ + _Clextab, /* --> "Check value" table */ + _Blextab, /* --> "Base" table */ + 0, /* Index of last entry in "next" */ + _lmovb, /* --> Byte-int move routine */ + _Flextab, /* --> "Final state" table */ + _Alextab, /* --> Action routine */ + NULL, /* Look-ahead vector */ + 0, /* No Ignore class */ + 0, /* No Break class */ + 0, /* No Illegal class */ + }; diff --git a/c20/lex/llsave.c b/c20/lex/llsave.c new file mode 100644 index 00000000..cb56be27 --- /dev/null +++ b/c20/lex/llsave.c @@ -0,0 +1,9 @@ +/*)LIBRARY +*/ + +/* + * This is linked from lexlib to resolve a global in yylex which + * will be undefined if the user grammar has not defined any rules + * with right-context (look-ahead) + */ +char *llsave[1]; /* Look ahead buffer */ diff --git a/c20/lex/lmovb.c b/c20/lex/lmovb.c new file mode 100644 index 00000000..0cfba48f --- /dev/null +++ b/c20/lex/lmovb.c @@ -0,0 +1,35 @@ +/* + * Bob Denny 28-Aug-82 Remove reference to stdio.h + */ + +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +/*)LIBRARY +*/ + +_lmovb(lp, c, st) +register c, st; +register struct lextab *lp; +{ + int base; + + while ((base = lp->llbase[st]+c) > lp->llnxtmax || + (lp->llcheck[base] & 0377) != st) { + + if (st != lp->llendst) { +/* + * This miscompiled on Decus C many years ago: + * st = lp->lldefault[st] & 0377; + */ + base = lp->lldefault[st] & 0377; + st = base; + } + else + return(-1); + } + return(lp->llnext[base]&0377); +} diff --git a/c20/lex/lmovi.c b/c20/lex/lmovi.c new file mode 100644 index 00000000..1cb2aea0 --- /dev/null +++ b/c20/lex/lmovi.c @@ -0,0 +1,34 @@ +/* + * Bob Denny 28-Aug-82 Remove reference to stdio.h + */ + +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +/*)LIBRARY +*/ + +_lmovi(lp, c, st) +register int c; +register int st; +register struct lextab *lp; +{ + int base; + + while ((base = lp->llbase[st]+c) > lp->llnxtmax || + (int *)(lp->llcheck)[base]!=st) + if (st != lp->llendst) { +/* + * This miscompiled on Decus C many years ago + * st = ((int *)lp->lldefault)[st]; + */ + base = ((int *)lp->lldefault)[st]; + st = base; + } + else + return(-1); + return(((int *)lp->llnext)[base]); +} diff --git a/c20/lex/mapch.c b/c20/lex/mapch.c new file mode 100644 index 00000000..37a581b9 --- /dev/null +++ b/c20/lex/mapch.c @@ -0,0 +1,67 @@ +/* + * mapch -- handle escapes within strings + */ + +/* + * mapch.c + * + * Bob Denny 28-Aug-82 + * Move stdio dependencies to lexerr(), lexget(), lexech() and mapch() + * + * This is one of 4 modules in lexlib which depend + * upon the standard I/O package. + */ + +#include +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +/*)LIBRARY +*/ + +extern FILE *lexin; + +mapch(delim, esc) +{ + register c, octv, n; + + if ((c = lexchar())==delim) + return(EOF); + if (c==EOF || c=='\n') { + lexerror("Unterminated string"); + ungetc(c, lexin); + return(EOF); + } + if (c!=esc) + return(c); + switch (c=lexchar()) { + case 't': + return('\t'); + case 'n': + return('\n'); + case 'f': + return('\f'); + case '\"': case '\'': + return(c); + case 'e': + return('\e'); + case 'p': + return(033); + case 'r': + return('\r'); + case '0': case '1': case '2': case '3': + case '4': case '5': case '6': case '7': + octv = c-'0'; + for (n = 1; (c = lexchar())>='0' && c<='7' && n<=3; n++) + octv = octv*010 + (c-'0'); + ungetc(c, lexin); + return(octv); + case '\n': + yyline++; + return(mapch(delim, esc)); + } + return(c); +} diff --git a/c20/lex/min.c b/c20/lex/min.c new file mode 100644 index 00000000..8af43ae2 --- /dev/null +++ b/c20/lex/min.c @@ -0,0 +1,180 @@ +# define MIN 1 /* PLB */ +/* + * Copyright (c) 1978 Charles H. Forsyth + * + * Modified 02-Dec-80 Bob Denny -- Conditionalize debug code for smaller size + * Also note other mods. Now minimization is turned on at run time by '-m'. + * More 19-Mar-82 Bob Denny -- New C library & compiler + * This routine is unimplemented. Define MIN to turn it on. Have fun. + */ + +/* + * lex -- dfa minimisation routines + */ + +#include +#include "lexlex.h" + +#ifdef MIN +#else +/* + * Dummy routine + */ +dfamin() +{ +} +#endif + +#ifdef MIN +extern int mflag; + +member(e, v, i) +register e, *v, i; +{ + + while (i--) + if (e==*v++) + return(1); + return(0); +} + +extern struct set **oldpart; +extern int **newpart; +extern int nold, nnew; + +struct xlist { + struct set *x_set; + struct trans *x_trans; + }; + +xcomp(a, b) +struct xlist *a, *b; +{ + if (a->x_trans > b->x_trans) + return(1); + if (a->x_trans==b->x_trans) + return(0); + return(-1); +} + +dfamin() +{ + struct xlist *temp, *tp, *xp, *zp; + struct trans *trp; + int *tp2, *ip; + struct set *gp, **xch; + int i, j, k, niter; + + if(mflag == 0) return; /*** NOTE ***/ + +#ifdef DEBUG + fprintf(lexlog, "\nDFA minimisation (%d states)\n", ndfa); +#endif + + temp = lalloc(ndfa, sizeof(*temp), "minimisation"); + oldpart = lalloc(ndfa, sizeof(*oldpart), "minimisation"); + newpart = lalloc(ndfa*2+1, sizeof(*newpart), "minimisation"); + setlist = 0; +/* + * partition first into final + * states which identify different + * translations, and non-final + * states. + */ + tp = temp; + for (i = 0; i < ndfa; i++, tp++) { + tp->x_set = dfa[i].df_name; + if (tp->x_set->s_final) + tp->x_trans = nfa[tp->x_set->s_final].n_trans; else + tp->x_trans = 0; + } + qsort(temp, tp-temp, sizeof(*tp), xcomp); + for (xp = temp; xp < tp; xp = zp) { + ip = newpart; + for (zp = xp; zp < tp && zp->x_trans==xp->x_trans; zp++) + *ip++ = zp->x_set->s_state-dfa; + oldpart[nold++] = newset(newpart, ip-newpart, 0); + } + free(temp); +/* + * create a new partition, + * by considering each group in + * the old partition. For each + * such group, create new subgroups + * such that two states are in the + * same subgroup iff they have + * transitions on the same set of + * characters into the same + * set of groups in the old partition. + * repeat this process until + * a fixed point is reached. + */ + niter = 0; + do { + niter++; + +#ifdef DEBUG + fprintf(lexlog, "\n%d groups in partition %d\n", nold, niter); +#endif + + for (i = 0; i < nold; i++) { + fprintf(lexlog, "group %d: ", i); + pset(oldpart[i], 0); + fprintf(lexlog, "\n"); + } + nnew = 0; + tp2 = newpart; + for (i = 0; i < nold; i++) { + gp = oldpart[i]; + for (j = 0; j < gp->s_len; j++) { + if (member(gp->s_els[j], newpart, tp2-newpart)) + continue; + *tp2++ = gp->s_els[j]; + for (k = 0; k < gp->s_len; k++) + if (k!=j && + !member(gp->s_els[k], newpart, + tp2-newpart) && + eqstate(gp->s_els[j],gp->s_els[k])) + *tp2++ = gp->s_els[k]; + *tp2++ = -1; + } + } + *tp2++ = -1; + for (tp2 = newpart; *tp2 != -1; tp2 = ++ip) { + for (ip = tp2; *ip != -1; ip++) + ; + oldpart[nnew++] = newset(tp2, ip-tp2, 0); + } + i = nold; nold = nnew; nnew = i; + } while (nnew!=nold); + +#ifdef DEBUG + if (ndfa==nnew) + fprintf(lexlog, "\nno states saved by minimisation\n"); else + fprintf(lexlog, "\n%d states saved by minimisation\n", ndfa-nnew); +#endif + + free(newpart); + free(oldpart); +} + +eqstate(a, b) +{ + register struct move *dp1, *dp2; + +/** dfa vector has no element 'df_moves', transition entries have no elements + df_char nor df_set. Obviously unimplemented stuff. + + dp1 = dfa[a].df_moves; + dp2 = dfa[b].df_moves; + for (; dp1->df_set; dp1++, dp2++) + if (dp2->df_set==0) + return(0); + else if (dp1->df_char != dp2->df_char || + dp1->df_set->s_group != dp2->df_set->s_group) + return(0); + return(dp2->df_set==0); +**/ + +} +#endif diff --git a/c20/lex/obase.c b/c20/lex/obase.c new file mode 100644 index 00000000..edc6bf78 --- /dev/null +++ b/c20/lex/obase.c @@ -0,0 +1,208 @@ + +/* + * Copyright (c) 1978 Charles H. Forsyth + */ + +/* + * lex -- find and set base values for `move' vector + */ + +#include +#include "lexlex.h" + +/* + * Choose the best default + * state for `st'. + * Only states previous to the + * current state are considered, + * as these are guaranteed to + * exist. + */ +struct dfa * +defalt(st, xsep) +struct dfa *st; +struct xset **xsep; +{ + register struct dfa *dp; + register unsigned minv, u; + struct dfa *def; + struct xset *xse; + int i; + + xse = *xsep; + if ((i = xse-sets)==0) + return(NULL); + if (lldebug>1) + fprintf(stderr, "State %d, default:\n", st-dfa); + minv = -1; + def = NULL; + for (dp = dfa; dp < st; dp++) + if ((u = compat(st, dp, xse)) < minv) { + if (lldebug>1) + fprintf(stderr, "\t%d rates %d\n", dp-dfa, u); + def = dp; + minv = u; + } + if (minv == -1 || 10*(i-minv) < i) + def = NULL; + if (lldebug>1 && def) + fprintf(stderr, "\t%d chosen\n", def-dfa); + if (def) + resolve(st, def, xsep); + return(def); +} + +/* + * State `b' is compatible with, + * and hence a suitable default state + * for state `a', + * if its transitions agree with + * those of `a', except those for + * which `a' has transitions to the + * (alleged) default. + * Circularity of the default + * relation is also not allowed. + * If the state `b' has at least + * twice as many transitions as `a', + * it is not even worth considering. + */ +compat(a, b, xse) +struct dfa *a, *b; +struct xset *xse; +{ + register struct dfa *dp; + register i, c; + + if (a==b || b->df_ntrans >= a->df_ntrans*2) + return(-1); + for (dp = b; dp; dp = dp->df_default) + if (dp == a) + return(-1); + i = resolve(a, b, &xse); + return(i); +} + +/* + * set `sets' to indicate those + * characters on which the state `a' + * and its default agree and + * those characters on which `a' + * should go to `error' (as the default + * accepts it, but `a' does not). + */ +resolve(a, def, xsep) +struct dfa *a, *def; +struct xset **xsep; +{ + register struct move *dp; + register c, i; + struct xset *xs, *xse; + + xse = *xsep; + i = xse-sets; + for (xs = sets; xs < xse; xs++) + xs->x_defsame = 0; + for (; def; def = def->df_default) + for (dp = def->df_base; dp < def->df_max; dp++) + if (dp->m_check == def) { + c = dp - def->df_base; + for (xs = sets; xs < xse; xs++) + if (c==(xs->x_char&0377)) { + if (xs->x_set==dp->m_next) { + xs->x_defsame++; + i--; + } + break; + } + if (xs >= xse) { + xs->x_defsame = 0; + xs->x_char = c; + xs->x_set = NULL; + i++; + xse++; + } + } + *xsep = xse; + return(i); +} + +/* + * Choose a base in `move' + * for the current state. + * The transitions of that + * state are in the vector + * `sets'. + */ +struct move * +stbase(xse) +struct xset *xse; +{ + register a; + register struct move *base; + register conflicts; + struct xset *xs; + + if (xse==sets) + return(NULL); + base = move; + do { + if (base-move >= NNEXT) { + error("No space in `move' (stbase)"); + if (lldebug>1) + dfaprint(); + exit(1); + } + conflicts = 0; + for (xs = sets; xs < xse; xs++) { + a = xs->x_char&0377; + if (xs->x_defsame==0 && + (base+a>=move+NNEXT || base[a].m_check!=NULL)) { + conflicts++; + base++; + break; + } + } + } while (conflicts); + return(base); +} + +/* + * Given a state, + * its `base' value in `move', + * and the set of transitions in + * `sets' (ending near `xse'), + * set the `move' values. + */ +setbase(st, base, xse) +struct dfa *st; +register struct move *base; +struct xset *xse; +{ + register struct move *dp; + register struct xset *xs; + struct move *maxdp; + + st->df_base = base; + st->df_max = base; + if (lldebug>1) + fprintf(stderr, "Setbase: state %d\n", st-dfa); + if (lldebug>1 && base==0) + fprintf(stderr, "\tno base\n"); + if (base==NULL) + return; + maxdp = base; + for (xs = sets; xs < xse; xs++) + if (xs->x_defsame==0) { + dp = base + (xs->x_char&0377); + if (dp > maxdp) + maxdp = dp; + dp->m_next = xs->x_set; + dp->m_check = st; + if (dp-move > llnxtmax) + llnxtmax = dp-move; + if (lldebug>1) + fprintf(stderr, "\t%c nets %d\n", + xs->x_char&0377, dp-move); + } + st->df_max = maxdp+1; +} diff --git a/c20/lex/ocap.c b/c20/lex/ocap.c new file mode 100644 index 00000000..0941ea35 --- /dev/null +++ b/c20/lex/ocap.c @@ -0,0 +1,215 @@ +/* + * Created by DECUS LEX from file "cap.lxi" Sun Aug 29 01:19:05 1982 + */ + +/* + * CREATED FOR USE WITH STANDARD I/O + */ + +# +#include +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +extern int _lmovb(); + +#line 10 "cap.lxi" + +extern char *token(); + +main() +{ + while (yylex()) + ; +} + +/* Standard I/O selected */ +extern FILE *lexin; + +llstin() + { + if(lexin == NULL) + lexin = stdin; + } + +_Acap(__na__) /* Action routine */ + { + +#line 20 "cap.lxi" + + register char *cp; + char *et; + switch (__na__) + { + + case 0: + +#line 25 "cap.lxi" + + cp = token(&et); + while (cp < et) + putchar(*cp++); + + break; + + case 1: + +#line 30 "cap.lxi" +putchar(token(0)[1]); + break; + + case 2: + +#line 31 "cap.lxi" +putchar(*token(0)+'a'-'A'); + break; + + case 3: + +#line 32 "cap.lxi" +putchar(*token(0)); + break; + } + return(LEXSKIP); +} + +#line 33 "cap.lxi" + + +int _Fcap[] = + { + -1, 3, 2, 3, 1, 3, -1, 0, + -1, -1, -1, -1, 3, -1, -1, -1, + -1, + }; + +#line 34 "cap.lxi" + +#define LLTYPE1 char + +LLTYPE1 _Ncap[] = + { + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 5, 1, 1, 3, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 12, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 5, + 1, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 2, 2, 2, 2, 2, + 2, 2, 2, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 1, 1, 1, 1, 1, 1, 1, 1, + 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 6, 8, 13, 6, 6, 14, + 8, 8, 15, 16, 16, 16, 16, 16, + 16, 16, 16, 16, 16, 16, 16, 16, + 9, 16, 11, 10, 10, 16, 16, 11, + 16, 11, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, 7, 7, 7, 7, + 7, 7, 7, 7, + }; + +LLTYPE1 _Ccap[] = + { + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, + 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 3, 3, 3, 3, 3, 3, + 3, 3, 5, 6, 12, 9, 10, 13, + 6, 6, 14, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, + 5, -1, 5, 9, 10, -1, -1, 5, + -1, 5, 6, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 6, 6, 6, 6, + 6, 6, 6, 6, + }; + +LLTYPE1 _Dcap[] = + { + 16, 16, 16, 16, 16, 16, 16, 16, + 6, 16, 6, 5, 5, 16, 16, 6, + + }; + +int _Bcap[] = + { + 0, 0, 0, 191, 0, 272, 249, 0, + 0, 275, 276, 0, 204, 207, 280, 0, + 0, + }; + +struct lextab cap = { + 16, /* Highest state */ + _Dcap, /* --> "Default state" table */ + _Ncap, /* --> "Next state" table */ + _Ccap, /* --> "Check value" table */ + _Bcap, /* --> "Base" table */ + 339, /* Index of last entry in "next" */ + _lmovb, /* --> Byte-int move routine */ + _Fcap, /* --> "Final state" table */ + _Acap, /* --> Action routine */ + NULL, /* Look-ahead vector */ + 0, /* No Ignore class */ + 0, /* No Break class */ + 0, /* No Illegal class */ + }; diff --git a/c20/lex/ocap.lxi b/c20/lex/ocap.lxi new file mode 100644 index 00000000..6c3f0897 --- /dev/null +++ b/c20/lex/ocap.lxi @@ -0,0 +1,33 @@ +/* + * capitalise things + */ + +letter = [A-Z]; +open = ["'(]; +close = ["')]; +any = [\0-\377]; +eos = [.?!]; +%{ +extern char *token(); + +main() +{ + while (yylex()) + ; +} +%} +%% +%{ + register char *cp; + char *et; +%} + +(".PP\n"|eos close* " "* (" "|"\n"))open*letter { + cp = token(&et); + while (cp < et) + putchar(*cp++); + } +$letter {putchar(token(0)[1]);} +letter {putchar(*token(0)+'a'-'A');} +any {putchar(*token(0));} +%% diff --git a/c20/lex/out.c b/c20/lex/out.c new file mode 100644 index 00000000..39a39e7b --- /dev/null +++ b/c20/lex/out.c @@ -0,0 +1,400 @@ + +# +/* + * Copyright (c) 1978 Charles H. Forsyth + */ + +/* + * lex -- output human- and machine-readable tables + */ + +#include +#include "lexlex.h" + +extern int sflag; + +char strdec[] = {"\n\ +struct\tlextab\t%s = {\n\ +\t%d,\t/* last state */\n\ +\t_D%s,\t/* defaults */\n\ +\t_N%s,\t/* next */\n\ +\t_C%s,\t/* check */\n\ +\t_B%s,\t/* base */\n\ +\t%d,\t/* last in base */\n\ +\t%s,\t/* byte-int move routines */\n\ +\t_F%s,\t/* final state descriptions */\n\ +\t_A%s,\t/* action routine */\n\ +\t%s%s,\t/* look-ahead vector */\n\ +"}; + +nfaprint(np, base) +register struct nfa *np; +struct nfa *base; +{ + register i; + + if (np->n_flag&NPRT) + return; + np->n_flag |= NPRT; + fprintf(lexlog, "state %d\n", np-base); + switch (np->n_char) { + case EPSILON: + for (i = 0; i < 2; i++) + if (np->n_succ[i]) + fprintf(lexlog, + "\tepsilon %d\n", np->n_succ[i]-base); + break; + case FIN: + fprintf(lexlog, "\tfinal state\n"); + break; + case CCL: + fprintf(lexlog, "\t["); + cclprint(np->n_ccl); + fprintf(lexlog, "] %d\n", np->n_succ[0]-base); + break; + default: + putc('\t', lexlog); + chprint(np->n_char); + fprintf(lexlog, " %d\n", np->n_succ[0]-base); + break; + } + fprintf(lexlog, "\n"); + if (np->n_succ[0]) + nfaprint(np->n_succ[0], base); + if (np->n_succ[1]) + nfaprint(np->n_succ[1], base); +} + +cclprint(cp) +register char *cp; +{ + register i; + + for (i = 0; i < NCHARS; i++) + if (cp[i/NBPC]&(1<<(i%NBPC))) + chprint(i); +} + +chprint(ch) +{ + register char *s; + + ch &= 0377; + switch (ch) { + case '\t': + s = "\\t"; + break; + case '\n': + s = "\\n"; + break; + case '\b': + s = "\\b"; + break; + case '\r': + s = "\\r"; + break; + default: + fprintf(lexlog, (ch<040 || ch>=0177) ? "\\%o": "%c", ch); + return; + } + fprintf(lexlog, s); +} + + +/* + * print the minimised DFA, + * and at the same time, + * construct the vector which + * indicates final states by + * associating them with + * their translation index. + */ +dfaprint() +{ + register struct move *dp; + register struct dfa *st; + register i; + int fi, k, l; + + vstart("int _", "F", tabname); + fprintf(lexlog, "\nMinimised DFA for complete syntax\n"); + for (i = 0; i < ndfa; i++) { + fprintf(lexlog, "\nstate %d", i); + st = &dfa[i]; + k = -1; + if (fi = st->df_name->s_final) { + k = nfa[fi].n_trans - trans; + fprintf(lexlog, " (final %d[%d],)", fi, k); + if (nfa[fi].n_flag&FLOOK) { + k |= (nfa[fi].n_look+1)<<11; + fprintf(lexlog, " restore %d", nfa[fi].n_look); + } + } + if (l = st->df_name->s_look) + fprintf(lexlog, " look-ahead %o", l); + veld(k); +/* + k = st->df_name->s_group->s_els[0]; + if (k!=i) { + fprintf(lexlog, " deleted\n"); + continue; + } +*/ + fprintf(lexlog, "\n"); + for (dp = st->df_base; dp < st->df_max; dp = range(st, dp)) + ; + if (st->df_default) + fprintf(lexlog, "\t.\tsame as %d\n", + st->df_default-dfa); + } + veld(-1); /* blocking state */ + vend(); +} + +range(st, dp) +register struct dfa *st; +register struct move *dp; +{ + int low, high, last; + struct set *s; + register a; + + while (dp < st->df_max && dp->m_check!=st) + dp++; + if (dp >= st->df_max) + return(dp); + low = dp - st->df_base; +/* + s = dp->m_next->s_group->s_els[0]; +*/ + s = dp->m_next; + for (last = low-1; dp < st->df_max && + dp->m_check==st && + (a = dp - st->df_base)==last+1 && +/* + dp->m_next->s_state->s_els[0]==s; dp++) +*/ + dp->m_next==s; dp++) + last = a; + high = last; + fprintf(lexlog, "\t"); + if (high==low) + chprint(low); + else { + fprintf(lexlog, "["); + if (high-low > 4) { + chprint(low); + fprintf(lexlog, "-"); + chprint(high); + } else { + while (low<=high) + chprint(low++); + } + fprintf(lexlog, "]"); + } + if (s == NULL || s->s_state == NULL) + fprintf(lexlog, "\tNULL\n"); + else + fprintf(lexlog, "\t%d\n", s->s_state-dfa); + return(dp); +} + +heading() +{ + fprintf(llout, "\ +\#include \n\ +\#ifdef vms\n\ +\#include \"c:lex.h\"\n\ +\#else\n\ +\#include \n\ +\#endif\n"); + fprintf(llout, "extern int _lmov%c();\n", + (ndfa <= 255) ? 'b' : 'i'); +} + +llactr() +{ + /* + * Prior to generating the action routine, create + * the llstin() routine, which initializes yylex(), + * per the setting of the "-s" switch. All hardwired + * variables have now been removed from yylex(). This + * allows analyzers to be independent of the standard + * I/O library and the table name. + */ + fprintf(llout, "extern struct lextab %s;\n", tabname); + if(sflag == 0) /* If stdio flavor */ + { + fprintf(llout, "\n/* Standard I/O selected */\n"); + fprintf(llout, "extern FILE *lexin;\n\n"); + fprintf(llout, "llstin()\n {\n if(lexin == NULL)\n"); + fprintf(llout, " lexin = stdin;\n"); + } + else /* Stand-alone flavor */ + { + fprintf(llout, "\n/* Stand-alone selected */\n"); + fprintf(llout, "\llstin()\n {\n"); + } + fprintf(llout, " if(_tabp == NULL)\n"); + fprintf(llout, " lexswitch(&%s);\n }\n\n", tabname); + fprintf(llout, "_A%s(__na__)\t\t/* Action routine */\n {\n", tabname); +} + +/* +llactr() +{ + fprintf(llout, "_A%s(__na__) {\n", tabname); +} +*/ + +newcase(i) +{ + static int putsw; + + if (!putsw++) + fprintf(llout, "\tswitch (__na__) {\n"); + fprintf(llout, "\tcase %d:\n", i); + setlne(); +} + +ending() +{ + static int ended; + + if (ended++) + return; + fprintf(llout, "\t}\n\treturn(LEXSKIP);\n}\n"); + setlne(); +} + +dfawrite() +{ + register struct move *dp; + register i, a; + int k, base, nr, c; + struct dfa *st, *def; + struct set *xp; + + setlne(); + fprintf(llout, "\n#define\tLLTYPE1\t%s\n", ndfa<=255? "char": "int"); + vstart("LLTYPE1 _", "N", tabname); + for (i = 0; i <= llnxtmax; i++) + if (xp = move[i].m_next) + veld(xp->s_state-dfa); else + veld(ndfa); + vend(); + vstart("LLTYPE1 _", "C", tabname); + for (i = 0; i <= llnxtmax; i++) + if (st = move[i].m_check) + veld(st-dfa); else + veld(-1); + vend(); + vstart("LLTYPE1 _", "D", tabname); + for (i = 0; i < ndfa; i++) + if (def = dfa[i].df_default) + veld(def-dfa); else + veld(ndfa); /* refer to blocking state */ + vend(); + vstart("int _", "B", tabname); + for (i = 0; i < ndfa; i++) + if (dp = dfa[i].df_base) + veld(dp-move); else + veld(0); + veld(0); /* for blocking state */ + vend(); + if (nlook) { + fprintf(llout, "char *llsave[%d];\n", nlook); + vstart("int _", "L", tabname); + a = nlook<=NBPC? NCHARS-1: -1; + for (i = 0; i < ndfa; i++) + velo(dfa[i].df_name->s_look&a); + velo(0); + vend(); + } + dospccl(ignore, "LLIGN", "X"); + dospccl(breakc, "LLBRK", "Y"); + dospccl(illeg, "LLILL", "Z"); + + fprintf(llout, strdec, + tabname, ndfa, tabname, tabname, tabname, tabname, + llnxtmax, ndfa<=255? "_lmovb": "_lmovi", tabname, tabname, + nlook? "_L": "", nlook? tabname: "NULL"); + refccl(ignore, "ignore", "X"); + refccl(breakc, "break", "Y"); + refccl(illeg, "illegal", "Z"); + fprintf(llout, "};\n"); + fclose(llout); +} + +dospccl(cp, s, tag) +register char *cp; +char *s, *tag; +{ + register n; + + if (cp==0) + return; + fprintf(llout, "#define\t%s\t%s\n", s, s); + vstart("char _", tag, tabname); + for (n = sizeof(ccls[0]); n--;) + velo(*cp++&0377); + vend(); +} + +refccl(cp, nm, tag) +char *cp, *nm, *tag; +{ + if (cp==0) + fprintf(llout, "\t0,\t/* no %s class */\n", nm); else + fprintf(llout, "\t_%s%s,\t/* %s class */\n", tag, + tabname, nm); +} + +int vnl; + +static +vstart(def, tag, name) +char *def, *tag, *name; +{ + vnl = 0; + fprintf(llout, "\n%s%s%s[] = {\n", def, tag, name); +} + +vend() +{ + fprintf(llout, "\n};\n"); +} + +veld(e) +int e; +/* + * Print decimal value e + */ +{ + fprintf(llout, " %d,", e); + veol(); +} + +velo(e) +int e; +/* + * Print octal value e + */ +{ + fprintf(llout, " 0%o,", e); + veol(); +} + +veol() +/* + * End of line + */ +{ + if ((++vnl & 017) == 0) + fprintf(llout, "\n"); +} + +setlne() +{ + fprintf(llout, "\n#line %d \"%s\"\n", yyline, infile); +} diff --git a/c20/lex/out.old b/c20/lex/out.old new file mode 100644 index 00000000..49edb209 --- /dev/null +++ b/c20/lex/out.old @@ -0,0 +1,368 @@ + +# +/* + * Copyright (c) 1978 Charles H. Forsyth + */ + +/* + * lex -- output human- and machine-readable tables + */ + +#include +#include "lexlex.h" + +char strdec[] = {"\n\ +struct\tlextab\t%s = {\n\ +\t%d,\t/* last state */\n\ +\t_D%s,\t/* defaults */\n\ +\t_N%s,\t/* next */\n\ +\t_C%s,\t/* check */\n\ +\t_B%s,\t/* base */\n\ +\t%d,\t/* last in base */\n\ +\t%s,\t/* byte-int move routines */\n\ +\t_F%s,\t/* final state descriptions */\n\ +\t_A%s,\t/* action routine */\n\ +\t%s%s,\t/* look-ahead vector */\n\ +"}; + +nfaprint(np, base) +register struct nfa *np; +struct nfa *base; +{ + register i; + + if (np->n_flag&NPRT) + return; + np->n_flag |= NPRT; + fprintf(lexlog, "state %d\n", np-base); + switch (np->n_char) { + case EPSILON: + for (i = 0; i < 2; i++) + if (np->n_succ[i]) + fprintf(lexlog, + "\tepsilon %d\n", np->n_succ[i]-base); + break; + case FIN: + fprintf(lexlog, "\tfinal state\n"); + break; + case CCL: + fprintf(lexlog, "\t["); + cclprint(np->n_ccl); + fprintf(lexlog, "] %d\n", np->n_succ[0]-base); + break; + default: + putc('\t', lexlog); + chprint(np->n_char); + fprintf(lexlog, " %d\n", np->n_succ[0]-base); + break; + } + fprintf(lexlog, "\n"); + if (np->n_succ[0]) + nfaprint(np->n_succ[0], base); + if (np->n_succ[1]) + nfaprint(np->n_succ[1], base); +} + +cclprint(cp) +register char *cp; +{ + register i; + + for (i = 0; i < NCHARS; i++) + if (cp[i/NBPC]&(1<<(i%NBPC))) + chprint(i); +} + +chprint(ch) +{ + register char *s; + + ch &= 0377; + switch (ch) { + case '\t': + s = "\\t"; + break; + case '\n': + s = "\\n"; + break; + case '\b': + s = "\\b"; + break; + case '\r': + s = "\\r"; + break; + default: + fprintf(lexlog, (ch<040 || ch>=0177) ? "\\%o": "%c", ch); + return; + } + fprintf(lexlog, s); +} + + +/* + * print the minimised DFA, + * and at the same time, + * construct the vector which + * indicates final states by + * associating them with + * their translation index. + */ +dfaprint() +{ + register struct move *dp; + register struct dfa *st; + register i; + int fi, k, l; + + vstart("int _", "F", tabname); + fprintf(lexlog, "\nMinimised DFA for complete syntax\n"); + for (i = 0; i < ndfa; i++) { + fprintf(lexlog, "\nstate %d", i); + st = &dfa[i]; + k = -1; + if (fi = st->df_name->s_final) { + k = nfa[fi].n_trans - trans; + fprintf(lexlog, " (final %d[%d],)", fi, k); + if (nfa[fi].n_flag&FLOOK) { + k |= (nfa[fi].n_look+1)<<11; + fprintf(lexlog, " restore %d", nfa[fi].n_look); + } + } + if (l = st->df_name->s_look) + fprintf(lexlog, " look-ahead %o", l); + veld(k); +/* + k = st->df_name->s_group->s_els[0]; + if (k!=i) { + fprintf(lexlog, " deleted\n"); + continue; + } +*/ + fprintf(lexlog, "\n"); + for (dp = st->df_base; dp < st->df_max; dp = range(st, dp)) + ; + if (st->df_default) + fprintf(lexlog, "\t.\tsame as %d\n", + st->df_default-dfa); + } + veld(-1); /* blocking state */ + vend(); +} + +range(st, dp) +register struct dfa *st; +register struct move *dp; +{ + int low, high, last; + struct set *s; + register a; + + while (dp < st->df_max && dp->m_check!=st) + dp++; + if (dp >= st->df_max) + return(dp); + low = dp - st->df_base; +/* + s = dp->m_next->s_group->s_els[0]; +*/ + s = dp->m_next; + for (last = low-1; dp < st->df_max && + dp->m_check==st && + (a = dp - st->df_base)==last+1 && +/* + dp->m_next->s_state->s_els[0]==s; dp++) +*/ + dp->m_next==s; dp++) + last = a; + high = last; + fprintf(lexlog, "\t"); + if (high==low) + chprint(low); + else { + fprintf(lexlog, "["); + if (high-low > 4) { + chprint(low); + fprintf(lexlog, "-"); + chprint(high); + } else { + while (low<=high) + chprint(low++); + } + fprintf(lexlog, "]"); + } + if (s == NULL || s->s_state == NULL) + fprintf(lexlog, "\tNULL\n"); + else + fprintf(lexlog, "\t%d\n", s->s_state-dfa); + return(dp); +} + +heading() +{ + fprintf(llout, "\ +\#include \n\ +\#ifdef vms\n\ +\#include \"c:lex.h\"\n\ +\#else\n\ +\#include \n\ +\#endif\n"); + fprintf(llout, "extern int _lmov%c();\n", + (ndfa <= 255) ? 'b' : 'i'); +} + +llactr() +{ + fprintf(llout, "_A%s(__na__) {\n", tabname); +} + +newcase(i) +{ + static int putsw; + + if (!putsw++) + fprintf(llout, "\tswitch (__na__) {\n"); + fprintf(llout, "\tcase %d:\n", i); + setline(); +} + +ending() +{ + static int ended; + + if (ended++) + return; + fprintf(llout, "\t}\n\treturn(LEXSKIP);\n}\n"); + setline(); +} + +dfawrite() +{ + register struct move *dp; + register i, a; + int k, base, nr, c; + struct dfa *st, *def; + struct set *xp; + + setline(); + fprintf(llout, "\n#define\tLLTYPE1\t%s\n", ndfa<=255? "char": "int"); + vstart("LLTYPE1 _", "N", tabname); + for (i = 0; i <= llnxtmax; i++) + if (xp = move[i].m_next) + veld(xp->s_state-dfa); else + veld(ndfa); + vend(); + vstart("LLTYPE1 _", "C", tabname); + for (i = 0; i <= llnxtmax; i++) + if (st = move[i].m_check) + veld(st-dfa); else + veld(-1); + vend(); + vstart("LLTYPE1 _", "D", tabname); + for (i = 0; i < ndfa; i++) + if (def = dfa[i].df_default) + veld(def-dfa); else + veld(ndfa); /* refer to blocking state */ + vend(); + vstart("int _", "B", tabname); + for (i = 0; i < ndfa; i++) + if (dp = dfa[i].df_base) + veld(dp-move); else + veld(0); + veld(0); /* for blocking state */ + vend(); + if (nlook) { + fprintf(llout, "char *llsave[%d];\n", nlook); + vstart("int _", "L", tabname); + a = nlook<=NBPC? NCHARS-1: -1; + for (i = 0; i < ndfa; i++) + velo(dfa[i].df_name->s_look&a); + velo(0); + vend(); + } + dospccl(ignore, "LLIGN", "X"); + dospccl(breakc, "LLBRK", "Y"); + dospccl(illeg, "LLILL", "Z"); + + fprintf(llout, strdec, + tabname, ndfa, tabname, tabname, tabname, tabname, + llnxtmax, ndfa<=255? "_lmovb": "_lmovi", tabname, tabname, + nlook? "_L": "", nlook? tabname: "NULL"); + refccl(ignore, "ignore", "X"); + refccl(breakc, "break", "Y"); + refccl(illeg, "illegal", "Z"); + fprintf(llout, "};\n"); + fclose(llout); +} + +dospccl(cp, s, tag) +register char *cp; +char *s, *tag; +{ + register n; + + if (cp==0) + return; + fprintf(llout, "#define\t%s\t%s\n", s, s); + vstart("char _", tag, tabname); + for (n = sizeof(ccls[0]); n--;) + velo(*cp++&0377); + vend(); +} + +refccl(cp, nm, tag) +char *cp, *nm, *tag; +{ + if (cp==0) + fprintf(llout, "\t0,\t/* no %s class */\n", nm); else + fprintf(llout, "\t_%s%s,\t/* %s class */\n", tag, + tabname, nm); +} + +int vnl; + +static +vstart(def, tag, name) +char *def, *tag, *name; +{ + vnl = 0; + fprintf(llout, "\n%s%s%s[] = {\n", def, tag, name); +} + +vend() +{ + fprintf(llout, "\n};\n"); +} + +veld(e) +int e; +/* + * Print decimal value e + */ +{ + fprintf(llout, " %d,", e); + veol(); +} + +velo(e) +int e; +/* + * Print octal value e + */ +{ + fprintf(llout, " 0%o,", e); + veol(); +} + +veol() +/* + * End of line + */ +{ + if ((++vnl & 017) == 0) + fprintf(llout, "\n"); +} + +setline() +{ + fprintf(llout, "\n#line %d \"%s\"\n", yyline, infile); +} diff --git a/c20/lex/out1.c b/c20/lex/out1.c new file mode 100644 index 00000000..61aa6e06 --- /dev/null +++ b/c20/lex/out1.c @@ -0,0 +1,306 @@ +/* + * Copyright (c) 1978 Charles H. Forsyth + * + * Modified 02-Dec-80 Bob Denny -- Conditionalize debug code for smaller size + * 01 -- Removed ending() function code from here + * to lex.c, so ytab.c code could share the + * same overlay region as this module. + * 02 -- Removed nfaprint(), llactr(), newcase(), + * cclprint(), chprint() and setline(), + * the rest of this can share an overlay. + * They're in 'out2.c'. This is now 'out1.c'. + * 29-May-81 Bob Denny -- More extern hacking for RSX overlaying. + * 19-Mar-82 Bob Denny -- New compiler and library + * 03-May-82 Bob Denny -- Final touches, remove unreferenced autos + * 28-Aug-82 Bob Denny -- Put "=" into table initializers to make + * new compiler happy. Add "-s" code to + * supress "#include " in output. + * Tables output 8 values/line instead of + * 16. Overran R.H. edge on 3 digit octals. + * Change output format for readability. + * 31-Aug-82 Bob Denny -- Add lexswitch( ...) to llstin so table + * name selected by -t switch is automatically + * switched-to at yylex() startup time. Removed + * hard reference to "lextab" from yylex(); + * This module generates extern declaration + * for forward reference. + */ + +/* + * lex -- output human- and machine-readable tables + */ + +#include +#include "lexlex.h" + +extern char *ignore; +extern char *illeg; +extern char *breakc; + +char strdec[] = {"\n\ +struct lextab %s =\t{\n\ +\t\t\t%d,\t\t/* Highest state */\n\ +\t\t\t_D%s\t/* --> \"Default state\" table */\n\ +\t\t\t_N%s\t/* --> \"Next state\" table */\n\ +\t\t\t_C%s\t/* --> \"Check value\" table */\n\ +\t\t\t_B%s\t/* --> \"Base\" table */\n\ +\t\t\t%d,\t\t/* Index of last entry in \"next\" */\n\ +\t\t\t%s,\t\t/* --> Byte-int move routine */\n\ +\t\t\t_F%s\t/* --> \"Final state\" table */\n\ +\t\t\t_A%s\t/* --> Action routine */\n\ +\t\t\t%s%s\t/* Look-ahead vector */\n\ +"}; + +char ptabnam[] = { " " }; + +/* + * Print the minimised DFA, + * and at the same time, + * construct the vector which + * indicates final states by + * associating them with + * their translation index. + * (DFA printout supressed ifndef DEBUG. RBD) + */ +dfaprint() +{ + register struct move *dp; + register struct dfa *st; + register i; + int fi, k, l; + + vstart("int _F%s", tabname); +#ifdef DEBUG + fprintf(lexlog, "\nMinimised DFA for complete syntax\n"); +#endif + for (i = 0; i < ndfa; i++) { +#ifdef DEBUG + fprintf(lexlog, "\nstate %d", i); +#endif + st = &dfa[i]; + k = -1; + if (fi = st->df_name->s_final) { + k = nfa[fi].n_trans - trans; +#ifdef DEBUG + fprintf(lexlog, " (final %d[%d])", fi, k); +#endif + if (nfa[fi].n_flag&FLOOK) { + k |= (nfa[fi].n_look+1)<<11; +#ifdef DEBUG + fprintf(lexlog, " restore %d", nfa[fi].n_look); +#endif + } + } + if (l = st->df_name->s_look) +#ifdef DEBUG + fprintf(lexlog, " look-ahead %o", l); +#else + ; +#endif + vel(" %d,", k); +#ifdef DEBUG + k = st->df_name->s_group->s_els[0]; + if (k!=i) { + fprintf(lexlog, " deleted\n"); + continue; + } + fprintf(lexlog, "\n"); + for (dp = st->df_base; dp < st->df_max; dp = range(st, dp)) + if (st->df_default) + fprintf(lexlog, "\t.\tsame as %d\n", st->df_default-dfa); +#endif + } + vel(" -1,"); /* blocking state */ + vend(); +} + +#ifdef DEBUG + +range(st, dp) +register struct dfa *st; +register struct move *dp; +{ + int low, high, last; + struct set *s; + register a; + + while (dp < st->df_max && dp->m_check!=st) + dp++; +/*************************************************** + * This always returns given the above statement ! * + ***************************************************/ + if (dp >= st->df_max) + return(dp); + + low = dp - st->df_base; +/* + s = dp->m_next->s_group->s_els[0]; +*/ + s = dp->m_next; + for (last = low-1; dp < st->df_max && + dp->m_check==st && + (a = dp - st->df_base)==last+1 && +/* + dp->m_next->s_state->s_els[0]==s; dp++) +*/ + dp->m_next==s; dp++) + last = a; + high = last; + fprintf(lexlog, "\t"); + if (high==low) + chprint(low); + else { + fprintf(lexlog, "["); + if (high-low > 4) { + chprint(low); + fprintf(lexlog, "-"); + chprint(high); + } else { + while (low<=high) + chprint(low++); + } + fprintf(lexlog, "]"); + } + if (s->s_state==NULL) + fprintf(lexlog, "\tNULL\n"); else + fprintf(lexlog, "\t%d\n", s->s_state-dfa); + return(dp); +} +#endif + +heading() +{ + fprintf(llout, + "/*\n * Created by DECUS LEX from file \"%s\" %s\n */\n\n", + infile, ctime(0)); + if(sflag == 0) /* If "standalone" switch off */ + { + fprintf(llout, + "/*\n * CREATED FOR USE WITH STANDARD I/O\n */\n\n"); + fprintf(llout, "#\n#include \n"); + } + else + fprintf(llout, "/*\n * CREATED FOR STAND-ALONE I/O\n */\n\n"); + + fprintf(llout, "#ifdef vms\n"); + fprintf(llout, "#include \"c:lex.h\"\n#else\n"); + fprintf(llout, "#include \n#endif\n\n"); + fprintf(llout, "extern int _lmov%c();\n", + (ndfa <= 255) ? 'b' : 'i'); + fprintf(llout, "extern struct lextab %s;\t/* Forward reference */\n\n", + tabname); +} + + /* 02 */ + /* 01 */ +dfawrite() +{ + register struct move *dp; + register i, a; + struct dfa *st, *def; + struct set *xp; + char *xcp; + + setline(); + fprintf(llout, "\n#define\tLLTYPE1\t%s\n", ndfa<=255? "char": "int"); + vstart("LLTYPE1 _N%s", tabname); + for (i = 0; i <= llnxtmax; i++) + if (xp = move[i].m_next) + vel(" %d,", xp->s_state-dfa); else + vel(" %d,", ndfa); + vend(); + vstart("LLTYPE1 _C%s", tabname); + for (i = 0; i <= llnxtmax; i++) + if (st = move[i].m_check) + vel(" %d,", st-dfa); else + vel(" -1,"); + vend(); + vstart("LLTYPE1 _D%s", tabname); + for (i = 0; i < ndfa; i++) + if (def = dfa[i].df_default) + vel(" %d,", def-dfa); else + vel(" %d,", ndfa); /* refer to blocking state */ + vend(); + vstart("int _B%s", tabname); + for (i = 0; i < ndfa; i++) + if (dp = dfa[i].df_base) + vel(" %d,", dp-move); else + vel(" 0,"); + vel(" 0,"); /* for blocking state */ + vend(); + if (nlook) { + fprintf(llout, "char *llsave[%d];\n", nlook); + vstart("int _L%s", tabname); + a = nlook<=NBPC? NCHARS-1: -1; + for (i = 0; i < ndfa; i++) + vel(" 0%o,", dfa[i].df_name->s_look&a); + vel(" 0,"); + vend(); + } + dospccl(ignore, "LLIGN", "X"); + dospccl(breakc, "LLBRK", "Y"); + dospccl(illeg, "LLILL", "Z"); + + i = (7 - strlen(tabname)); /* Yes, 7 */ + xcp = cpystr(ptabnam, tabname); + *xcp++ = ','; + while(i--) + *xcp++ = ' '; + *xcp = '\0'; + fprintf(llout, strdec, + tabname, ndfa, ptabnam, ptabnam, ptabnam, ptabnam, + llnxtmax, ndfa<=255? "_lmovb": "_lmovi", ptabnam, ptabnam, + nlook? "_L": "", nlook? ptabnam: "NULL, "); + refccl(ignore, "Ignore", "X"); + refccl(breakc, "Break", "Y"); + refccl(illeg, "Illegal", "Z"); + fprintf(llout, "\t\t\t};\n"); + fclose(llout); +} + +dospccl(cp, s, tag) +register char *cp; +char *s, *tag; +{ + register n; + + if (cp==0) + return; + fprintf(llout, "#define\t%s\t%s\n", s, s); + vstart("char _%s%s", tag, tabname); + for (n = sizeof(ccls[0]); n--;) + vel(" 0%o,", *cp++&0377); + vend(); +} + +refccl(cp, nm, tag) +char *cp, *nm, *tag; +{ + if (cp==0) + fprintf(llout, "\t\t\t0,\t\t/* No %s class */\n", nm); + else + fprintf(llout, "\t_%s%s,\t/* %s class */\n", tag, tabname, nm); +} + +int vnl; + +vstart(t) +{ + vnl = 0; + fprintf(llout, "\n%r", &t); + fprintf(llout, "[] =\n {\n "); +} + +vend() +{ + fprintf(llout, "\n };\n"); +} + +vel(s) +char *s; +{ + fprintf(llout, "%r", &s); + if ((++vnl&07)==0) + fprintf(llout, "\n "); +} + /* 02 */ diff --git a/c20/lex/out2.c b/c20/lex/out2.c new file mode 100644 index 00000000..2770556f --- /dev/null +++ b/c20/lex/out2.c @@ -0,0 +1,140 @@ +/* + * out2.c -- Some of Lex's output routines for overlaying, moved + * here from the original out.c as part of size reduction + * effort. + * Bob Denny + * 03-Dec-80 + * More... + * Bob Denny + * 29-May-81 RSX overlaying + * 19-Mar-82 Bob Denny -- New compiler and library + * 28-Aug-82 Bob Denny -- Change output format for readability. I know + * you UNIX hackers are not going to like this + * one. Add code to generate llstin() per + * setting of "-s" switch. Fix cclprint() to + * put 16 "characters" on a line. Clean up + * nfaprint(). + * 29-Aug-82 Bob Denny -- Move chprint to root. Add llstin() to + * default lexin to stdin for standard I/O + * and no-op for stand-alone I/O. Allows + * sdtio-specific code to be removed from + * yylex(). + * 31-Aug-82 Bob Denny -- Add lexswitch( ...) to llstin so table + * name selected by -t switch is automatically + * switched-to at yylex() startup time. Removed + * hard reference to "lextab" from yylex(); + * 30-Oct-82 Bob Denny -- Remove lexswitch() from llstin(). Made it + * impossible to do a real lexswitch()! (dumb.) + * Default the table by statically initializing + * it to NULL and doing the lexswitch only if + * _tabp is NULL. + */ + +#include +#include "lexlex.h" + +extern int yyline; + +#ifdef DEBUG + +nfaprint(np, base) +register struct nfa *np; +struct nfa *base; +{ + register i; + + if (np->n_flag&NPRT) + return; + np->n_flag |= NPRT; + fprintf(lexlog, "state %d\n", np-base); + switch (np->n_char) { + case EPSILON: + for (i = 0; i < 2; i++) + if (np->n_succ[i]) + fprintf(lexlog, "\tepsilon %d\n", np->n_succ[i]-base); + break; + case FIN: + fprintf(lexlog, "\tfinal state\n"); + break; + case CCL: + fprintf(lexlog, "\t["); + cclprint(np->n_ccl); + fprintf(lexlog, "] %d\n", np->n_succ[0]-base); + break; + default: + putc('\t', lexlog); + chprint(np->n_char); + fprintf(lexlog, " %d\n", np->n_succ[0]-base); + break; + } + putc('\n', lexlog); + if (np->n_succ[0]) + nfaprint(np->n_succ[0], base); + if (np->n_succ[1]) + nfaprint(np->n_succ[1], base); +} + +cclprint(cp) +register char *cp; +{ + register i; + register nc; + + nc = 0; + for (i = 0; i < NCHARS; i++) + { + if (cp[i / NBPC] & (1 << (i % NBPC))) + nc += chprint(i); + if(nc >= 64) + { + nc = 0; + fprintf(lexlog, "\n\t "); + } + } +} + +#endif + + +llactr() +{ + /* + * Prior to generating the action routine, create + * the llstin() routine, which initializes yylex(), + * per the setting of the "-s" switch. All hardwired + * variables have now been removed from yylex(). This + * allows analyzers to be independent of the standard + * I/O library and the table name. + */ + if(sflag == 0) /* If stdio flavor */ + { + fprintf(llout, "\n/* Standard I/O selected */\n"); + fprintf(llout, "extern FILE *lexin;\n\n"); + fprintf(llout, "llstin()\n {\n if(lexin == NULL)\n"); + fprintf(llout, " lexin = stdin;\n"); + } + else /* Stand-alone flavor */ + { + fprintf(llout, "\n/* Stand-alone selected */\n"); + fprintf(llout, "\llstin()\n {\n"); + } + fprintf(llout, " if(_tabp == NULL)\n"); + fprintf(llout, " lexswitch(&%s);\n }\n\n", tabname); + fprintf(llout, "_A%s(__na__)\t\t/* Action routine */\n {\n", tabname); +} + +newcase(i) +{ + static int putsw; + + if (!putsw++) + fprintf(llout, " switch (__na__)\n {\n"); + fprintf(llout, "\n case %d:\n", i); + setline(); +} + + +setline() +{ + fprintf(llout, "\n#line %d \"%s\"\n", yyline, infile); +} diff --git a/c20/lex/readme.604 b/c20/lex/readme.604 new file mode 100644 index 00000000..d3906e10 --- /dev/null +++ b/c20/lex/readme.604 @@ -0,0 +1,19 @@ +[6,4] [.LEX] Lexical Analyser Generator + +This is an implementation of the Unix program LEX, which generates +lexical analysers from regular expression grammars. + +Because the Decus compiler does not seperate I and D space, LEX +cannot be used to build very large grammars. There are several +possibilities: + + 1. Remove the dfa/nfa print routines, which are needed + for debugging. + + 2. Use I/O redirection to read the grammar source from + stdin. This will save 1/4 K-word or so. + + 3. Overlay the parser phases. + +Have fun. + diff --git a/c20/lex/token.c b/c20/lex/token.c new file mode 100644 index 00000000..f085c3ce --- /dev/null +++ b/c20/lex/token.c @@ -0,0 +1,21 @@ +/* + * Bob Denny 28-Aug-82 Remove reference to stdio.h + */ + +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +/*)LIBRARY +*/ + +char * +token(cpp) +char **cpp; +{ + if (cpp) + *cpp = llend; + return(llbuf); +} diff --git a/c20/lex/word.c b/c20/lex/word.c new file mode 100644 index 00000000..c390aa04 --- /dev/null +++ b/c20/lex/word.c @@ -0,0 +1,194 @@ +#include +#ifdef vms +#include "c:lex.h" +#else +#include +#endif +extern int _lmovb(); + +#line 8 "word.lxi" + +char line[133]; +char *linep = &line; +int is_eof = 0; +int wordct = 0; +#define T_EOL 1 +main() +{ + register int i; + while ((i = yylex()) != 0) { + /* + * If the "end-of-line" token is returned + * AND we're really at the end of a line, + * read the next line. Note that T_EOL is + * returned twice when the program starts + * because of the nature of the look-ahead + * algorithms. + */ + if (i == T_EOL && !is_eof && *linep == 0) { + if (ftty(stdin)) { + printf("* "); + fflush(stdout); + } + getline(); + } + } + printf("%d words\n", wordct); +} +extern struct lextab word; + +/* Standard I/O selected */ +extern FILE *lexin; + +llstin() + { + if(lexin == NULL) + lexin = stdin; + if(_tabp == NULL) + lexswitch(&word); + } + +_Aword(__na__) /* Action routine */ + { + switch (__na__) { + case 0: + +#line 39 "word.lxi" + + /* + * Write each word on a seperate line + */ + lexecho(stdout); + printf("\n"); + wordct++; + return(LEXSKIP); + + break; + case 1: + +#line 48 "word.lxi" + + return(T_EOL); + + break; + case 2: + +#line 51 "word.lxi" + + return(LEXSKIP); + + break; + } + return(LEXSKIP); +} + +#line 54 "word.lxi" + + +getline() +/* + * Read a line for lexgetc() + */ +{ + is_eof = (fgets(line, sizeof line, stdin) == NULL); + linep = &line; +} + +lexgetc() +/* + * Homemade lexgetc -- return zero while at the end of an + * input line or EOF at end of file. If more on this line, + * return it. + */ +{ + return((is_eof) ? EOF : (*linep == 0) ? 0 : *linep++); +} + +int _Fword[] = { + -1, 2, 2, 1, 0, 0, -1, +}; + +#line 74 "word.lxi" + +#define LLTYPE1 char + +LLTYPE1 _Nword[] = { + 3, 6, 6, 6, 6, 6, 6, 6, 6, 1, 1, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, + 1, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 2, + 2, 2, 2, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 6, 6, 2, 6, 2, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, +}; + +LLTYPE1 _Cword[] = { + 0, -1, -1, -1, -1, -1, -1, -1, -1, 0, 0, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, + 1, 2, 2, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 1, -1, 2, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, +}; + +LLTYPE1 _Dword[] = { + 6, 6, 6, 6, 6, 6, +}; + +int _Bword[] = { + 0, 118, 120, 0, 120, 214, 0, +}; +#define LLILL LLILL + +char _Zword[] = { + 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, + 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, + +}; + +struct lextab word = { + 6, /* last state */ + _Dword, /* defaults */ + _Nword, /* next */ + _Cword, /* check */ + _Bword, /* base */ + 340, /* last in base */ + _lmovb, /* byte-int move routines */ + _Fword, /* final state descriptions */ + _Aword, /* action routine */ + NULL, /* look-ahead vector */ + 0, /* no ignore class */ + 0, /* no break class */ + _Zword, /* illegal class */ +}; diff --git a/c20/lex/word.lxi b/c20/lex/word.lxi new file mode 100644 index 00000000..097b1b34 --- /dev/null +++ b/c20/lex/word.lxi @@ -0,0 +1,73 @@ +/* + * Count words -- interactively + */ +white = [\n\t ]; /* End of a word */ +eol = [\0]; /* End of input line */ +any = [!-~]; /* All printing char's */ +illegal = [\0-\377]; /* Skip over junk */ +%{ +char line[133]; +char *linep = &line; +int is_eof = 0; +int wordct = 0; +#define T_EOL 1 +main() +{ + register int i; + while ((i = yylex()) != 0) { + /* + * If the "end-of-line" token is returned + * AND we're really at the end of a line, + * read the next line. Note that T_EOL is + * returned twice when the program starts + * because of the nature of the look-ahead + * algorithms. + */ + if (i == T_EOL && !is_eof && *linep == 0) { + if (ftty(stdin)) { + printf("* "); + fflush(stdout); + } + getline(); + } + } + printf("%d words\n", wordct); +} +%} +%% + +any(any)* { + /* + * Write each word on a seperate line + */ + lexecho(stdout); + printf("\n"); + wordct++; + return(LEXSKIP); + } +eol { + return(T_EOL); + } +white(white)* { + return(LEXSKIP); + } +%% + +getline() +/* + * Read a line for lexgetc() + */ +{ + is_eof = (fgets(line, sizeof line, stdin) == NULL); + linep = &line; +} + +lexgetc() +/* + * Homemade lexgetc -- return zero while at the end of an + * input line or EOF at end of file. If more on this line, + * return it. + */ +{ + return((is_eof) ? EOF : (*linep == 0) ? 0 : *linep++); +} diff --git a/c20/lex/word.oc b/c20/lex/word.oc new file mode 100644 index 00000000..a2344f76 --- /dev/null +++ b/c20/lex/word.oc @@ -0,0 +1,164 @@ +# +#include +#include + +extern int _lmovb(); + +#line 8 "WORD.LXI" + +char line[133]; +char *linep = &line; +int is_eof = 0; +int wordct = 0; +#define T_EOL 1 +main() +{ + register int i; + while ((i = yylex()) != 0) { + /* + * If the "end-of-line" token is returned + * AND we're really at the end of a line, + * read the next line. Note that T_EOL is + * returned twice when the program starts + * because of the nature of the look-ahead + * algorithms. + */ + if (i == T_EOL && !is_eof && *linep == 0) { + printf("* "); + fflush(stdout); + getline(); + } + } + printf("%d words\n", wordct); +} +_Alextab(__na__) { + switch (__na__) { + case 0: + +#line 37 "WORD.LXI" + + /* + * Write each word on a seperate line + */ + lexecho(stdout); + printf("\n"); + wordct++; + return(LEXSKIP); + + break; + case 1: + +#line 46 "WORD.LXI" + + return(T_EOL); + + break; + case 2: + +#line 49 "WORD.LXI" + + return(LEXSKIP); + + break; + } + return(LEXSKIP); +} + +#line 52 "WORD.LXI" + + +getline() +/* + * Read a line for lexgetc() + */ +{ + is_eof = (fgets(line, sizeof line, stdin) == NULL); + linep = &line; +} + +lexgetc() +/* + * Homemade lexgetc -- return zero while at the end of an + * input line or EOF at end of file. If more on this line, + * return it. + */ +{ + return((is_eof) ? EOF : (*linep == 0) ? 0 : *linep++); +} + +int _Flextab[] { + -1, 2, 2, 1, 0, 0, -1, +}; + +#line 72 "WORD.LXI" + +#define LLTYPE1 char + +LLTYPE1 _Nlextab[] { + 3, 6, 6, 6, 6, 6, 6, 6, 6, 1, 1, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, + 1, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 2, + 2, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, 6, + 6, 6, 6, 6, 6, 6, 2, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, 5, + 5, 5, 5, 5, 5, +}; + +LLTYPE1 _Clextab[] { + 0, -1, -1, -1, -1, -1, -1, -1, -1, 0, 0, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, + 1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, -1, + -1, -1, -1, -1, -1, -1, 1, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, 4, + 4, 4, 4, 4, 4, +}; + +LLTYPE1 _Dlextab[] { + 6, 6, 1, 6, 6, 4, +}; + +int _Blextab[] { + 0, 118, 0, 0, 118, 0, 0, +}; +#define LLILL LLILL + +char _Zlextab[] { + 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, + 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, 0377, + +}; + +struct lextab lextab { + 6, /* last state */ + _Dlextab, /* defaults */ + _Nlextab, /* next */ + _Clextab, /* check */ + _Blextab, /* base */ + 244, /* last in base */ + _lmovb, /* byte-int move routines */ + _Flextab, /* final state descriptions */ + _Alextab, /* action routine */ + NULL, /* look-ahead vector */ + 0, /* no ignore class */ + 0, /* no break class */ + _Zlextab, /* illegal class */ +}; diff --git a/c20/lex/ytab.c b/c20/lex/ytab.c new file mode 100644 index 00000000..774aa71e --- /dev/null +++ b/c20/lex/ytab.c @@ -0,0 +1,948 @@ +# define vms 1 +/* + * * * * W A R N I N G * * * + * + * This file has been hand-modified from that which was produced by Yacc + * from 'lex.y'. If you plan on rebuilding this with Yacc, be SURE to run + * the virgin supplied 'lex.y' thru Yacc first, do a source compare of it's + * output 'ytab.c' with this file, and note & understand the manual mods + * that were made here. + * Bob Denny + * + * Modified 02-Dec-80 Bob Denny -- Conditionalized debug code for smaller size + * YYSMALL no longer used. + * Removed hackish accent grave's. + * 01 Moved calls do dfa build, min, print and + * write, and to stat() to lex.c, so this + * module could be put in overlay region. + * Moved impure data out into ytdata.c to + * go to the root. + * + * 29-May-81 Bob Denny -- Define yysterm fwd. Remove from LEXLEX.H. + * for RSX overlaying. + * 19-Mar-82 Bob Denny -- New compiler and library. Typcasts needed. + * Conditionally compile remote formats, not + * supported in VAX C. + * More 03-May-82 Bob Denny -- Final touches, remove unreferenced autos + */ + +#include +#include "ytab.h" +#include + +extern char *yysterm[]; /* Hack forward definition */ + +#line 9 "lex.y" +#include "lexlex.h" + +#define streq(a,b) (stcmp(a,b) != 0) + +/* char copr[] = "Copyright (c) 1978 Charles H. Forsyth";*/ + +struct des { + struct nfa *d_start; + struct nfa *d_final; +}; +extern struct nlist { /* 01+ */ + struct nlist *nl_next; + struct nfa *nl_base; + struct nfa *nl_end; + struct nfa *nl_start; + struct nfa *nl_final; + char *nl_name; +} *nlist; /* 01- */ +extern int str_length; +extern struct nfa *elem(); +extern struct des *newdp(); +extern struct nlist *lookup(); +#define yyclearin yychar = -1 +/* #define yyerrok yyerrflag = 0 */ +extern int yychar, yyerrflag; + +#ifndef YYSTYPE +#define YYSTYPE int +#endif +#ifndef YYVCOPY +#define YYVCOPY(x,y) (x)=(y) +#endif + +extern YYSTYPE yyval; /* 01+ */ +extern YYSTYPE *yypv; +extern YYSTYPE yylval; + + + +extern int nlook; +extern int yyline; +extern char *breakc; +extern char *ignore; +extern char *illeg; /* 01- */ + +yyacr(__np__){ + +#line 40 "lex.y" + struct nfa *np, *nbase; + char *cp; + struct des *dp; + struct trans *tp; + struct nlist *nl; + int i, c; + +switch(__np__){ + +case 7: +#line 64 "lex.y" +{ + dp = yypv[3]; + nl = yypv[1]; + np = nl->nl_base; + nl->nl_start = dp->d_start; + nl->nl_final = dp->d_final; + nl->nl_end = nfap; +#ifdef DEBUG + fprintf(lexlog, "NFA (auxiliary definition) for %s\n", + nl->nl_name); + nfaprint(dp->d_start, nl->nl_base); +#endif + nbase = lalloc(i = nl->nl_end-nl->nl_base, sizeof(*nbase), + "nfa storage"); + copynfa(nl, nbase, dp); + nl->nl_start = dp->d_start; + nl->nl_final = dp->d_final; + nl->nl_end = nbase+i; + nl->nl_base = nbase; + nfap = np; + spccl(nl->nl_name, "ignore", dp, &ignore); + spccl(nl->nl_name, "break", dp, &breakc); + spccl(nl->nl_name, "illegal", dp, &illeg); + } break; +case 8: +#line 85 "lex.y" +{ copycode(); } break; +case 9: +#line 89 "lex.y" +{ + yyval = lookup(yypv[1]); + ((struct nlist *)yyval)->nl_base = nfap; + if (((struct nlist *)yyval)->nl_start) +#ifdef vms + yyemsg("redefined", ((struct nlist *)yyval)->nl_name); +#else + yyemsg("%s redefined", ((struct nlist *)yyval)->nl_name); +#endif + } break; +case 10: +#line 98 "lex.y" +{ yyval = lookup(yypv[1]); } break; +case 11: +#line 102 "lex.y" +{ + np = elem(CCL, yypv[1]); + yyval = newdp(np, np->n_succ[0] = elem(FIN)); + } break; +case 12: +#line 106 "lex.y" +{ + cp = yypv[1]; + if (str_length == 0) { + np = elem(EPSILON); + yyval = newdp(np, np->n_succ[0] = elem(FIN)); + return; + } + yyval = np = elem(*cp++); + while (--str_length > 0) + np = np->n_succ[0] = elem(*cp++); + yyval = newdp(yyval, np->n_succ[0] = elem(FIN)); + } break; +case 13: +#line 118 "lex.y" +{ + if ((nl = yypv[1])->nl_end == 0) { +#ifdef vms + yyemsg("not defined", nl->nl_name); +#else + yyemsg("%s not defined", nl->nl_name); +#endif + nl->nl_base = nl->nl_end = elem(FIN); + nl->nl_start = nl->nl_final = nl->nl_base; + } + yyval = dp = lalloc(1, sizeof(*dp), "dfa input"); + nbase = nfap; + i = nl->nl_end-nl->nl_base; + if ((nfap += i) >= &nfa[MAXNFA]) { + yyemsg("Out of NFA nodes", NULL); + exit(1); + } + copynfa(nl, nbase, dp); + } break; +case 14: +#line 133 "lex.y" +{ + yyval = dp = yypv[1]; + dp->d_start = newnfa(EPSILON, np = dp->d_start, 0); + dp->d_final->n_char = EPSILON; + dp->d_final->n_succ[0] = np; + dp->d_final->n_succ[1] = np = elem(FIN); + dp->d_start->n_succ[1] = np; + dp->d_final = np; + } break; +case 15: +#line 142 "lex.y" +{ + yyval = dp = yypv[1]; + dp->d_start = newnfa(EPSILON, dp->d_start, + ((struct des *)yypv[3])->d_start); + dp->d_final->n_char = EPSILON; + dp->d_final = dp->d_final->n_succ[0] = np = elem(FIN); + dp = yypv[3]; + dp->d_final->n_char = EPSILON; + dp->d_final->n_succ[0] = np; + free(yypv[3]); + } break; +case 16: +#line 152 "lex.y" +{ + yyval = yypv[1]; + dp = yypv[2]; + np = ((struct des *)yyval)->d_final; + ((struct des *)yyval)->d_final = dp->d_final; + np->n_char = dp->d_start->n_char; + np->n_ccl = dp->d_start->n_ccl; + np->n_succ[0] = dp->d_start->n_succ[0]; + np->n_succ[1] = dp->d_start->n_succ[1]; + free(yypv[2]); + } break; +case 17: +#line 163 "lex.y" +{ yyval = yypv[2]; } break; +case 18: +#line 167 "lex.y" +{ + ending(); + trans1: +#ifdef DEBUG + fprintf(lexlog, "\nNFA for complete syntax\n"); + fprintf(lexlog, "state 0\n"); + for (tp = trans; tp < trnsp; tp++) + fprintf(lexlog, "\tepsilon\t%d\n", tp->t_start-nfa); + for (tp = trans; tp < trnsp; tp++) + nfaprint(tp->t_start, nfa); +#else + ; +#endif + /* 01 */ + } break; +case 19: +#line 182 "lex.y" +{ goto trans1; } break; +case 22: +#line 191 "lex.y" +{ + llactr(); + } break; +case 23: +#line 197 "lex.y" +{ dp = yypv[1]; newtrans(dp->d_start, dp->d_final); } break; +case 24: +#line 198 "lex.y" +{ copycode(); } break; +case 25: +#line 199 "lex.y" +{ + ending(); + while ((c = get()) != EOF) + putc(c, llout); + } break; +case 26: +#line 207 "lex.y" +{ action(); } break; +case 27: +#line 211 "lex.y" +{ + if (nlook >= NBPW) +#ifdef vms + yyemsg("Too many translations with lookahead", NULL); +#else + yyemsg("More than %d translations with lookahead", + NBPW); +#endif + yyval = dp = yypv[1]; + np = dp->d_final; + np->n_char = EPSILON; + np->n_flag |= LOOK; + np->n_succ[0] = ((struct des *)yypv[3])->d_start; + dp->d_final = ((struct des *)yypv[3])->d_final; + np->n_look = nlook; + dp->d_final->n_look = nlook++; + dp->d_final->n_flag |= FLOOK; + free(yypv[3]); + } break; +} +} +int yyeval = 256; /* yyerrval */ + +#line 228 "lex.y" + +/* + * Lexical analyser + * (it isn't done with lex...) + */ +extern char buffer[150]; /* 01 */ +extern int str_length; /* 01 */ + +yylex() +{ + register c; + register char *cp; + int lno; + + if (yyline == 0) + yyline++; +loop: + c = get(); + if (isupper(c)) { + name(c); + for (cp = yylval; c = *cp; cp++) + if (isupper(c)) + *cp = tolower(c); + return(STRING); + } else if (islower(c) || c == '_') { + name(c); + return(NAME); + } + switch (c) { + case EOF: + return(0); + + case '[': + return(cclass()); + + case '(': + case ')': + case '{': + case '}': + case '*': + case '|': + case '=': + case ';': + case '%': + return(c); + + case '/': + if ((c = get()) != '*') { + un_get(c); + return('/'); + } + lno = yyline; + for (; c != EOF; c = get()) + if (c == '*') + if ((c = get()) == '/') + goto loop; else + un_get(c); + yyline = lno; + yyemsg("End of file in comment", NULL); + + case '\'': + case '"': + yylval = buffer; + string(c); + return(STRING); + + case '\n': + case ' ': + case '\t': + goto loop; + + default: + yylval = buffer; + buffer[0] = c; + buffer[1] = 0; + str_length = 1; + return(STRING); + } +} + +extern char ccl[(NCHARS+1)/NBPC]; /* 01 */ + +cclass() +{ + register c, i, lc; + int compl; + + compl = 0; + for (i = 0; i < sizeof ccl; i++) + ccl[i] = 0; + if ((c = get()) == '^') + compl++; else + un_get(c); + lc = -1; + while ((c = mapc(']')) != EOF) { + if (c == '-' && lc >= 0) { + if ((c = mapc(']')) == EOF) + break; + for (i = lc; i <= c; i++) + ccl[i/NBPC] |= 1<<(i%NBPC); + lc = -1; + continue; + } + ccl[c/NBPC] |= 1<<(c%NBPC); + lc = c; + } + if (compl) { + for (i = 0; i < sizeof ccl; i++) + ccl[i] ^= -1; + if (aflag == 0) + for (i = 0200; i < (1<= '0' && c <= '7') { + i = 0; + for (v = 0; c>='0' && c<='7' && i++<3; c = get()) + v = v*010 + c-'0'; + un_get(c); + return(v&0377); + } + switch (c) { + case 'n': + return('\n'); + + case 't': + return('\t'); + + case 'b': + return('\b'); + + case 'r': + return('\r'); + + case '\n': + yyline++; + return(mapc(ec)); + } + + default: + return(c); + } +} + +name(c) +register c; +{ + register char *cp; + + for (yylval=cp=buffer; isalpha(c) || isdigit(c) || c=='_'; c=get()) + *cp++ = c; + *cp = 0; + str_length = cp-buffer; + un_get(c); +} + +/* + * Miscellaneous functions + * used only by lex.y + */ +struct nfa * +elem(k, v) +{ + struct nfa *fp; + + fp = newnfa(k, 0, 0); + if (k == CCL) + fp->n_ccl = v; + return(fp); +} + +struct des * +newdp(st, fi) +struct nfa *st, *fi; +{ + register struct des *dp; + + dp = lalloc(1, sizeof(*dp), "dfa input"); + dp->d_start = st; + dp->d_final = fi; + return(dp); +} + +action() +{ + register c; + int lno, lev; + + newcase(trnsp-trans); + lno = yyline; + lev = 0; + for (; (c = get()) != EOF && (c != '}' || lev); putc(c, llout)) + if (c == '{') + lev++; + else if (c == '}') + lev--; + else if (c == '\'' || c == '"') { + putc(c, llout); + skipstr(c); + } + fprintf(llout, "\n break;\n"); + if (c == EOF) { + yyline = lno; + yyemsg("End of file in action", NULL); + } +} + +skipstr(ec) +register ec; +{ + register c; + + while ((c = get()) != ec && c != EOF) { + putc(c, llout); + if (c == '\\' && (c = get()) != EOF) + putc(c, llout); + } +} + + +copycode() +{ + int lno; + register c; + + setlne(); + lno = yyline; + for (; (c = get()) != EOF; putc(c, llout)) + if (c == '%') { + if ((c = get()) == '}') + return; + un_get(c); + c = '%'; + } + yyline = lno; + yyemsg("Incomplete %{ declaration", NULL); + exit(1); +} + +struct nlist * +lookup(s) +register char *s; +{ + register struct nlist *nl; + register char *cp; + int i; + for (nl = nlist; nl; nl = nl->nl_next) + if (streq(s, nl->nl_name)) + return(nl); + nl = lalloc(1, sizeof(*nl), "namelist"); + nl->nl_start = nl->nl_end = nl->nl_base = nl->nl_end = 0; + nl->nl_next = nlist; + nlist = nl; + i = 0; + nl->nl_name = cp = lalloc(strlen(s) + 1, sizeof(*cp), "namelist"); + strcpy(cp, s); + return(nl); +} + + +copynfa(nl, nbase, dp) +struct nlist *nl; +struct des *dp; +struct nfa *nbase; +{ + register struct nfa *np, *ob; + register j; + int i; + + ob = nl->nl_base; + i = nl->nl_end-ob; +/* + * Assumes Decus compiler: copy(out, in, nbytes) + */ + copy(nbase, ob, sizeof(*np) * i); + for (np = nbase; i-- > 0; np++) { + np->n_flag &= ~NPRT; + for (j = 0; j < 2; j++) + if (np->n_succ[j]) + np->n_succ[j] = (np->n_succ[j]-ob)+nbase; + } + dp->d_start = (nl->nl_start-ob)+nbase; + dp->d_final = (nl->nl_final-ob)+nbase; +} + +/* #ifdef vms */ +copy(out, in, count) +register char *out; +register char *in; +register int count; +/* + * Block copy for vms -- should be in stdio.lib (in macro) + */ +{ + while (--count >= 0) + *out++ = *in++; +} +/* #endif */ + +spccl(nm, isit, dp, where) +char *nm; +char *isit; +register struct des *dp; +char **where; +{ + + if (streq(nm, isit)) { + if (*where != 0) +#ifdef vms + yyemsg("Redefinition of class", isit); +#else + yyemsg("Redefinition of %s class", isit); +#endif + if (dp->d_start->n_char == CCL && + dp->d_start->n_succ[0] == dp->d_final) + *where = dp->d_start->n_ccl; + else +#ifdef vms + yyemsg("Illegal class", isit); +#else + yyemsg("Illegal %s class", isit); +#endif + } +} + +get() +{ + register int c; + + if ((c = getc(lexin)) == '\n') + yyline++; + return(c); +} + +un_get(c) +register c; +{ + if (c == '\n') + yyline--; + ungetc(c, lexin); +} + +#ifdef vms +yyemsg(s, arg) +char *s; +char *arg; +{ + if (yyline) + fprintf(stderr, "%d: ", yyline); + fprintf(stderr, "%s", s); + if(arg != NULL) + fprintf(stderr, ": \"%s\"", arg); +#else +yyemsg(s) +char *s; +{ + if (yyline) + fprintf(stderr, "%d: ", yyline); + fprintf(stderr, "%r", &s); +#endif + if (yychar > 256) + fprintf(stderr, " near '%s'", yysterm[yychar-256]); + else if (yychar < 256 && yychar > 0) + fprintf(stderr, " near '%c'", yychar); + fprintf(stderr, "\n"); +} + + + + + + + +int nterms = 15; +int nnonter = 13; +int nstate = 41; +char *yysterm[] = { +"error", +"NAME", +"CCLASS", +"STRING", +"CONCAT", +0 }; + +char *yysnter[] = { +"$accept", +"lexfile", +"auxiliary_section", +"translation_section", +"auxiliaries", +"auxiliary", +"namedef", +"regexp", +"name", +"translations", +"translation", +"llactr", +"pattern", +"action" }; +# +extern int yychar; + +int yylast = 245; +yyexcp(s){ + extern int yydef[]; + switch(s){ + case 1: + if( yychar == 0 ) return( -1 ); + return( 0 ); + case 2: + if( yychar == 0 ) return( 19 ); + return( 22 ); + } + } + +yyact[] = { + + 23, 40, 32, 23, 29, 32, 23, 15, 32, 23, + 31, 32, 23, 35, 32, 18, 26, 13, 23, 32, + 34, 23, 37, 11, 4, 5, 16, 28, 17, 12, + 19, 19, 10, 9, 22, 6, 27, 25, 3, 8, + 2, 1, 0, 0, 36, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 38, 0, 39, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 33, 0, 0, 33, 0, 0, + 33, 0, 0, 33, 0, 0, 30, 0, 0, 0, + 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 24, 20, 21, + 24, 20, 21, 24, 20, 21, 24, 20, 21, 24, + 20, 21, 0, 0, 0, 24, 20, 21, 24, 20, + 21, 0, 0, 7, 7 }; +yypact[] = { + + -13,-2000,-2000, -14, -20,-1000, -54,-1000,-1000, -22, + -22, -21,-1000,-1000,-1000, -19,-1000,-119, -27, -34, +-1000,-1000,-1000, -19,-1000,-1000,-1000, -37,-1000,-1000, +-1000,-1000,-1000, -19, -23, -19, -40,-1000, -28, -31, +-1000 }; +yypgo[] = { + + 0, 41, 40, 39, 38, 25, 35, 20, 34, 33, + 26, 32, 28, 27 }; +yyr1[] = { + + 0, 1, 1, 2, 2, 4, 4, 5, 5, 6, + 8, 7, 7, 7, 7, 7, 7, 7, 3, 3, + 9, 9, 11, 10, 10, 10, 13, 12, 12, -1 }; +yyr2[] = { + + 0, 2, 0, 3, 2, 2, 1, 4, 2, 1, + 1, 1, 1, 1, 2, 3, 2, 3, 1, 0, + 2, 2, 0, 2, 2, 2, 1, 3, 1, -1 }; +yychk[] = { + + 0, -1, -2, -4, 37, -5, -6, 257, -3, -9, + -11, 37, -5, 37, 123, 61, -10, -12, 37, -7, + 258, 259, -8, 40, 257, -10, 37, -7, -13, 123, + 123, 37, 42, 124, -7, 47, -7, 59, -7, -7, + 41 }; +yydef[] = { + + 2, -2, -2, 0, 0, 6, 0, 9, 1, 18, + 0, 0, 5, 4, 8, 0, 20, 0, 0, 28, + 11, 12, 13, 0, 10, 21, 3, 0, 23, 26, + 24, 25, 14, 0, 16, 0, 0, 7, 15, 27, + 17 }; + +# define YYFLAG1 -1000 +# define YYFLAG2 -2000 + +/* test me on cases where there are more than one reduction +per state, leading to the necessity to look ahead, and other +arcane flows of control. +*/ +# define YYMAXDEPTH 150 + +/* parser for yacc output */ +/* extern YYSTYPE yyval; -- defined in the table file + * extern YYSTYPE yylval; -- defined in the table file + * extern YYSTYPE *yypv; -- defined in the table file + */ + +#ifdef DEBUG +#define LOGOUT lexlog +#endif + +extern int yydebug; /* 1 for debugging */ /* 01+ */ + +extern YYSTYPE yyv[YYMAXDEPTH]; /* where the values are stored */ +extern int yychar; /* current input token number */ +extern int yynerrs ; /* number of errors */ +extern int yyerrflag ; /* error recovery flag */ /* 01- */ + + +yyparse() { + +/* extern int yypgo[], yyr1[], yyr2[], yyact[], yypact[]; + * extern int yydef[], yychk[]; + * extern int yylast, yyeval; + */ + int yys[YYMAXDEPTH]; + int yyj; + register yyn, yystate, *yyps; + + yystate = 0; + yychar = -1; + yynerrs = 0; + yyerrflag = 0; + yyps= &yys[0]-1; + yypv= &yyv[0]-1; + + yystack: /* put a state and value onto the stack */ + +#ifdef DEBUG + if( yydebug ) + fprintf(LOGOUT, "state %d, value %d, char %d\n",yystate,yyval,yychar); +#endif + + *++yyps = yystate; + *++yypv = yyval; + + yynewstate: + + yyn = yypact[yystate]; + + if( yyn<= YYFLAG1 ){ /* simple state */ + if( yyn == YYFLAG2 && yychar<0 ) yychar = yylex(); + goto yydefault; + } + + if( yychar<0 ) yychar = yylex(); + if( (yyn += yychar)<0 || yyn >= yylast ) goto yydefault; + + if( yychk[ yyn=yyact[ yyn ] ] == yychar ){ /* valid shift */ + yychar = -1; + yyval = yylval; + yystate = yyn; + if( yyerrflag > 0 ) --yyerrflag; + goto yystack; + } + + yydefault: + /* default state action */ + + if( (yyn=yydef[yystate]) == -2 ) yyn = yyexcp( yystate ); + + if( yyn == -1 ){ /* accept */ + return( 0 ); + } + + if( yyn == 0 ){ /* error */ + /* error ... attempt to resume parsing */ + + switch( yyerrflag ){ + + case 0: /* brand new error */ + + ++yynerrs; + yyemsg("syntax error", NULL); + + case 1: + case 2: /* incompletely recovered error ... try again */ + + yyerrflag = 3; + + /* find a state where "error" is a legal shift action */ + + while ( yyps >= yys ) { + yyn = yypact[*yyps] + yyeval; + if( yyn>= 0 && yyn < yylast && yychk[yyact[yyn]] == yyeval ){ + yystate = yyact[yyn]; /* simulate a shift of "error" */ + goto yystack; + } + yyn = yypact[*yyps]; + + /* the current yyps has no shift onn "error", pop stack */ + +#ifdef DEBUG + if(yydebug) + fprintf(LOGOUT, "error recovery pops state %d, uncovers %d\n", + *yyps, yyps[-1]); +#endif + + --yyps; + --yypv; + } + + /* there is no state on the stack with an error shift ... abort */ + + abort: + return(1); + + + case 3: /* no shift yet; clobber input char */ + +#ifdef DEBUG + if (yydebug) + fprintf(LOGOUT, "error recovery discards char %d\n", yychar ); +#endif + + if( yychar == 0 ) goto abort; /* don't discard EOF, quit */ + yychar = -1; + goto yynewstate; /* try again in the same state */ + + } + + } + + /* reduction by production yyn */ + +#ifdef DEBUG + if(yydebug) fprintf(LOGOUT, "reduce %d\n",yyn); +#endif + + yyps -= yyr2[yyn]; + yypv -= yyr2[yyn]; +/* YYVCOPY(yyval,yypv[1]); + */ yyval = yypv[1]; + yyacr(yyn); + /* consult goto table to find next state */ + yyn = yyr1[yyn]; + yyj = yypgo[yyn] + *yyps + 1; + if( yyj>=yylast || yychk[ yystate = yyact[yyj] ] != -yyn ) + yystate = yyact[yypgo[yyn]]; + goto yystack; /* stack new state and value */ + + } diff --git a/c20/lex/ytab.h b/c20/lex/ytab.h new file mode 100644 index 00000000..9a103326 --- /dev/null +++ b/c20/lex/ytab.h @@ -0,0 +1,5 @@ + +# define NAME 257 +# define CCLASS 258 +# define STRING 259 +# define CONCAT 260 diff --git a/c20/lex/ytab.old b/c20/lex/ytab.old new file mode 100644 index 00000000..6af7ddf7 --- /dev/null +++ b/c20/lex/ytab.old @@ -0,0 +1,946 @@ +/* + * * * * W A R N I N G * * * + * + * This file has been hand-modified from that which was produced by Yacc + * from 'lex.y'. If you plan on rebuilding this with Yacc, be SURE to run + * the virgin supplied 'lex.y' thru Yacc first, do a source compare of it's + * output 'ytab.c' with this file, and note & understand the manual mods + * that were made here. + * Bob Denny + * + * Modified 02-Dec-80 Bob Denny -- Conditionalized debug code for smaller size + * YYSMALL no longer used. + * Removed hackish accent grave's. + * 01 Moved calls do dfa build, min, print and + * write, and to stat() to lex.c, so this + * module could be put in overlay region. + * Moved impure data out into ytdata.c to + * go to the root. + * + * 29-May-81 Bob Denny -- Define yysterm fwd. Remove from LEXLEX.H. + * for RSX overlaying. + * 19-Mar-82 Bob Denny -- New compiler and library. Typcasts needed. + * Conditionally compile remote formats, not + * supported in VAX C. + * More 03-May-82 Bob Denny -- Final touches, remove unreferenced autos + */ + +#include +#include "ytab.h" +#ifdef vms +#include +#endif + +extern char *yysterm[]; /* Hack forward definition */ + +#line 9 "lex.y" +#include "lexlex.h" + +/* char copr[] = "Copyright (c) 1978 Charles H. Forsyth";*/ + +struct des { + struct nfa *d_start; + struct nfa *d_final; +}; +extern struct nlist { /* 01+ */ + struct nlist *nl_next; + struct nfa *nl_base; + struct nfa *nl_end; + struct nfa *nl_start; + struct nfa *nl_final; + char *nl_name; +} *nlist; /* 01- */ +extern int str_length; +extern struct nfa *elem(); +extern struct des *newdp(); +extern struct nlist *lookup(); +#define yyclearin yychar = -1 +#define yyerrok yyerrflag = 0 +extern int yychar, yyerrflag; + +#ifndef YYSTYPE +#define YYSTYPE int +#endif +#ifndef YYVCOPY +#define YYVCOPY(x,y) (x)=(y) +#endif + +extern YYSTYPE yyval; /* 01+ */ +extern YYSTYPE *yypv; +extern YYSTYPE yylval; + + + +extern int nlook; +extern int yyline; +extern char *breakc; +extern char *ignore; +extern char *illeg; /* 01- */ + +yyactr(__np__){ + +#line 40 "lex.y" + struct nfa *np, *nbase; + char *cp; + struct des *dp; + struct trans *tp; + struct nlist *nl; + int i, c; + +switch(__np__){ + +case 7: +#line 64 "lex.y" +{ + dp = yypv[3]; + nl = yypv[1]; + np = nl->nl_base; + nl->nl_start = dp->d_start; + nl->nl_final = dp->d_final; + nl->nl_end = nfap; +#ifdef DEBUG + fprintf(lexlog, "NFA (auxiliary definition) for %s\n", + nl->nl_name); + nfaprint(dp->d_start, nl->nl_base); +#endif + nbase = lalloc(i = nl->nl_end-nl->nl_base, sizeof(*nbase), + "nfa storage"); + copynfa(nl, nbase, dp); + nl->nl_start = dp->d_start; + nl->nl_final = dp->d_final; + nl->nl_end = nbase+i; + nl->nl_base = nbase; + nfap = np; + spccl(nl->nl_name, "ignore", dp, &ignore); + spccl(nl->nl_name, "break", dp, &breakc); + spccl(nl->nl_name, "illegal", dp, &illeg); + } break; +case 8: +#line 85 "lex.y" +{ copycode(); } break; +case 9: +#line 89 "lex.y" +{ + yyval = lookup(yypv[1]); + ((struct nlist *)yyval)->nl_base = nfap; + if (((struct nlist *)yyval)->nl_start) +#ifdef vms + yyerror("redefined", ((struct nlist *)yyval)->nl_name); +#else + yyerror("%s redefined", ((struct nlist *)yyval)->nl_name); +#endif + } break; +case 10: +#line 98 "lex.y" +{ yyval = lookup(yypv[1]); } break; +case 11: +#line 102 "lex.y" +{ + np = elem(CCL, yypv[1]); + yyval = newdp(np, np->n_succ[0] = elem(FIN)); + } break; +case 12: +#line 106 "lex.y" +{ + cp = yypv[1]; + if (str_length == 0) { + np = elem(EPSILON); + yyval = newdp(np, np->n_succ[0] = elem(FIN)); + return; + } + yyval = np = elem(*cp++); + while (--str_length > 0) + np = np->n_succ[0] = elem(*cp++); + yyval = newdp(yyval, np->n_succ[0] = elem(FIN)); + } break; +case 13: +#line 118 "lex.y" +{ + if ((nl = yypv[1])->nl_end == 0) { +#ifdef vms + yyerror("not defined", nl->nl_name); +#else + yyerror("%s not defined", nl->nl_name); +#endif + nl->nl_base = nl->nl_end = elem(FIN); + nl->nl_start = nl->nl_final = nl->nl_base; + } + yyval = dp = lalloc(1, sizeof(*dp), "dfa input"); + nbase = nfap; + i = nl->nl_end-nl->nl_base; + if ((nfap += i) >= &nfa[MAXNFA]) { + yyerror("Out of NFA nodes", NULL); + exit(1); + } + copynfa(nl, nbase, dp); + } break; +case 14: +#line 133 "lex.y" +{ + yyval = dp = yypv[1]; + dp->d_start = newnfa(EPSILON, np = dp->d_start, 0); + dp->d_final->n_char = EPSILON; + dp->d_final->n_succ[0] = np; + dp->d_final->n_succ[1] = np = elem(FIN); + dp->d_start->n_succ[1] = np; + dp->d_final = np; + } break; +case 15: +#line 142 "lex.y" +{ + yyval = dp = yypv[1]; + dp->d_start = newnfa(EPSILON, dp->d_start, + ((struct des *)yypv[3])->d_start); + dp->d_final->n_char = EPSILON; + dp->d_final = dp->d_final->n_succ[0] = np = elem(FIN); + dp = yypv[3]; + dp->d_final->n_char = EPSILON; + dp->d_final->n_succ[0] = np; + free(yypv[3]); + } break; +case 16: +#line 152 "lex.y" +{ + yyval = yypv[1]; + dp = yypv[2]; + np = ((struct des *)yyval)->d_final; + ((struct des *)yyval)->d_final = dp->d_final; + np->n_char = dp->d_start->n_char; + np->n_ccl = dp->d_start->n_ccl; + np->n_succ[0] = dp->d_start->n_succ[0]; + np->n_succ[1] = dp->d_start->n_succ[1]; + free(yypv[2]); + } break; +case 17: +#line 163 "lex.y" +{ yyval = yypv[2]; } break; +case 18: +#line 167 "lex.y" +{ + ending(); + trans1: +#ifdef DEBUG + fprintf(lexlog, "\nNFA for complete syntax\n"); + fprintf(lexlog, "state 0\n"); + for (tp = trans; tp < transp; tp++) + fprintf(lexlog, "\tepsilon\t%d\n", tp->t_start-nfa); + for (tp = trans; tp < transp; tp++) + nfaprint(tp->t_start, nfa); +#else + ; +#endif + /* 01 */ + } break; +case 19: +#line 182 "lex.y" +{ goto trans1; } break; +case 22: +#line 191 "lex.y" +{ + llactr(); + } break; +case 23: +#line 197 "lex.y" +{ dp = yypv[1]; newtrans(dp->d_start, dp->d_final); } break; +case 24: +#line 198 "lex.y" +{ copycode(); } break; +case 25: +#line 199 "lex.y" +{ + ending(); + while ((c = get()) != EOF) + putc(c, llout); + } break; +case 26: +#line 207 "lex.y" +{ action(); } break; +case 27: +#line 211 "lex.y" +{ + if (nlook >= NBPW) +#ifdef vms + yyerror("Too many translations with lookahead", NULL); +#else + yyerror("More than %d translations with lookahead", + NBPW); +#endif + yyval = dp = yypv[1]; + np = dp->d_final; + np->n_char = EPSILON; + np->n_flag |= LOOK; + np->n_succ[0] = ((struct des *)yypv[3])->d_start; + dp->d_final = ((struct des *)yypv[3])->d_final; + np->n_look = nlook; + dp->d_final->n_look = nlook++; + dp->d_final->n_flag |= FLOOK; + free(yypv[3]); + } break; +} +} +int yyerrval = 256; + +#line 228 "lex.y" + +/* + * Lexical analyser + * (it isn't done with lex...) + */ +extern char buffer[150]; /* 01 */ +extern int str_length; /* 01 */ + +yylex() +{ + register c; + register char *cp; + int lno; + + if (yyline == 0) + yyline++; +loop: + c = get(); + if (isupper(c)) { + name(c); + for (cp = yylval; c = *cp; cp++) + if (isupper(c)) + *cp = tolower(c); + return(STRING); + } else if (islower(c) || c == '_') { + name(c); + return(NAME); + } + switch (c) { + case EOF: + return(0); + + case '[': + return(cclass()); + + case '(': + case ')': + case '{': + case '}': + case '*': + case '|': + case '=': + case ';': + case '%': + return(c); + + case '/': + if ((c = get()) != '*') { + unget(c); + return('/'); + } + lno = yyline; + for (; c != EOF; c = get()) + if (c == '*') + if ((c = get()) == '/') + goto loop; else + unget(c); + yyline = lno; + yyerror("End of file in comment", NULL); + + case '\'': + case '"': + yylval = buffer; + string(c); + return(STRING); + + case '\n': + case ' ': + case '\t': + goto loop; + + default: + yylval = buffer; + buffer[0] = c; + buffer[1] = 0; + str_length = 1; + return(STRING); + } +} + +extern char ccl[(NCHARS+1)/NBPC]; /* 01 */ + +cclass() +{ + register c, i, lc; + int compl; + + compl = 0; + for (i = 0; i < sizeof ccl; i++) + ccl[i] = 0; + if ((c = get()) == '^') + compl++; else + unget(c); + lc = -1; + while ((c = mapc(']')) != EOF) { + if (c == '-' && lc >= 0) { + if ((c = mapc(']')) == EOF) + break; + for (i = lc; i <= c; i++) + ccl[i/NBPC] |= 1<<(i%NBPC); + lc = -1; + continue; + } + ccl[c/NBPC] |= 1<<(c%NBPC); + lc = c; + } + if (compl) { + for (i = 0; i < sizeof ccl; i++) + ccl[i] ^= -1; + if (aflag == 0) + for (i = 0200; i < (1<= '0' && c <= '7') { + i = 0; + for (v = 0; c>='0' && c<='7' && i++<3; c = get()) + v = v*010 + c-'0'; + unget(c); + return(v&0377); + } + switch (c) { + case 'n': + return('\n'); + + case 't': + return('\t'); + + case 'b': + return('\b'); + + case 'r': + return('\r'); + + case '\n': + yyline++; + return(mapc(ec)); + } + + default: + return(c); + } +} + +name(c) +register c; +{ + register char *cp; + + for (yylval=cp=buffer; isalpha(c) || isdigit(c) || c=='_'; c=get()) + *cp++ = c; + *cp = 0; + str_length = cp-buffer; + unget(c); +} + +/* + * Miscellaneous functions + * used only by lex.y + */ +struct nfa * +elem(k, v) +{ + struct nfa *fp; + + fp = newnfa(k, 0, 0); + if (k == CCL) + fp->n_ccl = v; + return(fp); +} + +struct des * +newdp(st, fi) +struct nfa *st, *fi; +{ + register struct des *dp; + + dp = lalloc(1, sizeof(*dp), "dfa input"); + dp->d_start = st; + dp->d_final = fi; + return(dp); +} + +action() +{ + register c; + int lno, lev; + + newcase(transp-trans); + lno = yyline; + lev = 0; + for (; (c = get()) != EOF && (c != '}' || lev); putc(c, llout)) + if (c == '{') + lev++; + else if (c == '}') + lev--; + else if (c == '\'' || c == '"') { + putc(c, llout); + skipstr(c); + } + fprintf(llout, "\n break;\n"); + if (c == EOF) { + yyline = lno; + yyerror("End of file in action", NULL); + } +} + +skipstr(ec) +register ec; +{ + register c; + + while ((c = get()) != ec && c != EOF) { + putc(c, llout); + if (c == '\\' && (c = get()) != EOF) + putc(c, llout); + } +} + + +copycode() +{ + int lno; + register c; + + setline(); + lno = yyline; + for (; (c = get()) != EOF; putc(c, llout)) + if (c == '%') { + if ((c = get()) == '}') + return; + unget(c); + c = '%'; + } + yyline = lno; + yyerror("Incomplete %{ declaration", NULL); + exit(1); +} + +struct nlist * +lookup(s) +register char *s; +{ + register struct nlist *nl; + register char *cp; + int i; + for (nl = nlist; nl; nl = nl->nl_next) + if (streq(s, nl->nl_name)) + return(nl); + nl = lalloc(1, sizeof(*nl), "namelist"); + nl->nl_start = nl->nl_end = nl->nl_base = nl->nl_end = 0; + nl->nl_next = nlist; + nlist = nl; + i = 0; + nl->nl_name = cp = lalloc(strlen(s) + 1, sizeof(*cp), "namelist"); + strcpy(cp, s); + return(nl); +} + + +copynfa(nl, nbase, dp) +struct nlist *nl; +struct des *dp; +struct nfa *nbase; +{ + register struct nfa *np, *ob; + register j; + int i; + + ob = nl->nl_base; + i = nl->nl_end-ob; +/* + * Assumes Decus compiler: copy(out, in, nbytes) + */ + copy(nbase, ob, sizeof(*np) * i); + for (np = nbase; i-- > 0; np++) { + np->n_flag &= ~NPRT; + for (j = 0; j < 2; j++) + if (np->n_succ[j]) + np->n_succ[j] = (np->n_succ[j]-ob)+nbase; + } + dp->d_start = (nl->nl_start-ob)+nbase; + dp->d_final = (nl->nl_final-ob)+nbase; +} + +#ifdef vms +copy(out, in, count) +register char *out; +register char *in; +register int count; +/* + * Block copy for vms -- should be in stdio.lib (in macro) + */ +{ + while (--count >= 0) + *out++ = *in++; +} +#endif + +spccl(nm, isit, dp, where) +char *nm; +char *isit; +register struct des *dp; +char **where; +{ + + if (streq(nm, isit)) { + if (*where != 0) +#ifdef vms + yyerror("Redefinition of class", isit); +#else + yyerror("Redefinition of %s class", isit); +#endif + if (dp->d_start->n_char == CCL && + dp->d_start->n_succ[0] == dp->d_final) + *where = dp->d_start->n_ccl; + else +#ifdef vms + yyerror("Illegal class", isit); +#else + yyerror("Illegal %s class", isit); +#endif + } +} + +get() +{ + register int c; + + if ((c = getc(lexin)) == '\n') + yyline++; + return(c); +} + +unget(c) +register c; +{ + if (c == '\n') + yyline--; + ungetc(c, lexin); +} + +#ifdef vms +yyerror(s, arg) +char *s; +char *arg; +{ + if (yyline) + fprintf(stderr, "%d: ", yyline); + fprintf(stderr, "%s", s); + if(arg != NULL) + fprintf(stderr, ": \"%s\"", arg); +#else +yyerror(s) +char *s; +{ + if (yyline) + fprintf(stderr, "%d: ", yyline); + fprintf(stderr, "%r", &s); +#endif + if (yychar > 256) + fprintf(stderr, " near '%s'", yysterm[yychar-256]); + else if (yychar < 256 && yychar > 0) + fprintf(stderr, " near '%c'", yychar); + fprintf(stderr, "\n"); +} + + + + + + + +int nterms = 15; +int nnonter = 13; +int nstate = 41; +char *yysterm[] = { +"error", +"NAME", +"CCLASS", +"STRING", +"CONCAT", +0 }; + +char *yysnter[] = { +"$accept", +"lexfile", +"auxiliary_section", +"translation_section", +"auxiliaries", +"auxiliary", +"namedef", +"regexp", +"name", +"translations", +"translation", +"llactr", +"pattern", +"action" }; +# +extern int yychar; + +int yylast = 245; +yyexcp(s){ + extern int yydef[]; + switch(s){ + case 1: + if( yychar == 0 ) return( -1 ); + return( 0 ); + case 2: + if( yychar == 0 ) return( 19 ); + return( 22 ); + } + } + +yyact[] = { + + 23, 40, 32, 23, 29, 32, 23, 15, 32, 23, + 31, 32, 23, 35, 32, 18, 26, 13, 23, 32, + 34, 23, 37, 11, 4, 5, 16, 28, 17, 12, + 19, 19, 10, 9, 22, 6, 27, 25, 3, 8, + 2, 1, 0, 0, 36, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 38, 0, 39, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 33, 0, 0, 33, 0, 0, + 33, 0, 0, 33, 0, 0, 30, 0, 0, 0, + 0, 0, 14, 14, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, + 0, 0, 0, 0, 0, 0, 0, 24, 20, 21, + 24, 20, 21, 24, 20, 21, 24, 20, 21, 24, + 20, 21, 0, 0, 0, 24, 20, 21, 24, 20, + 21, 0, 0, 7, 7 }; +yypact[] = { + + -13,-2000,-2000, -14, -20,-1000, -54,-1000,-1000, -22, + -22, -21,-1000,-1000,-1000, -19,-1000,-119, -27, -34, +-1000,-1000,-1000, -19,-1000,-1000,-1000, -37,-1000,-1000, +-1000,-1000,-1000, -19, -23, -19, -40,-1000, -28, -31, +-1000 }; +yypgo[] = { + + 0, 41, 40, 39, 38, 25, 35, 20, 34, 33, + 26, 32, 28, 27 }; +yyr1[] = { + + 0, 1, 1, 2, 2, 4, 4, 5, 5, 6, + 8, 7, 7, 7, 7, 7, 7, 7, 3, 3, + 9, 9, 11, 10, 10, 10, 13, 12, 12, -1 }; +yyr2[] = { + + 0, 2, 0, 3, 2, 2, 1, 4, 2, 1, + 1, 1, 1, 1, 2, 3, 2, 3, 1, 0, + 2, 2, 0, 2, 2, 2, 1, 3, 1, -1 }; +yychk[] = { + + 0, -1, -2, -4, 37, -5, -6, 257, -3, -9, + -11, 37, -5, 37, 123, 61, -10, -12, 37, -7, + 258, 259, -8, 40, 257, -10, 37, -7, -13, 123, + 123, 37, 42, 124, -7, 47, -7, 59, -7, -7, + 41 }; +yydef[] = { + + 2, -2, -2, 0, 0, 6, 0, 9, 1, 18, + 0, 0, 5, 4, 8, 0, 20, 0, 0, 28, + 11, 12, 13, 0, 10, 21, 3, 0, 23, 26, + 24, 25, 14, 0, 16, 0, 0, 7, 15, 27, + 17 }; + +# define YYFLAG1 -1000 +# define YYFLAG2 -2000 + +/* test me on cases where there are more than one reduction +per state, leading to the necessity to look ahead, and other +arcane flows of control. +*/ +# define YYMAXDEPTH 150 + +/* parser for yacc output */ +/* extern YYSTYPE yyval; -- defined in the table file + * extern YYSTYPE yylval; -- defined in the table file + * extern YYSTYPE *yypv; -- defined in the table file + */ + +#ifdef DEBUG +#define LOGOUT lexlog +#endif + +extern int yydebug; /* 1 for debugging */ /* 01+ */ + +extern YYSTYPE yyv[YYMAXDEPTH]; /* where the values are stored */ +extern int yychar; /* current input token number */ +extern int yynerrs ; /* number of errors */ +extern int yyerrflag ; /* error recovery flag */ /* 01- */ + + +yyparse() { + +/* extern int yypgo[], yyr1[], yyr2[], yyact[], yypact[]; + * extern int yydef[], yychk[]; + * extern int yylast, yyerrval; + */ + int yys[YYMAXDEPTH]; + int yyj; + register yyn, yystate, *yyps; + + yystate = 0; + yychar = -1; + yynerrs = 0; + yyerrflag = 0; + yyps= &yys[0]-1; + yypv= &yyv[0]-1; + + yystack: /* put a state and value onto the stack */ + +#ifdef DEBUG + if( yydebug ) + fprintf(LOGOUT, "state %d, value %d, char %d\n",yystate,yyval,yychar); +#endif + + *++yyps = yystate; + *++yypv = yyval; + + yynewstate: + + yyn = yypact[yystate]; + + if( yyn<= YYFLAG1 ){ /* simple state */ + if( yyn == YYFLAG2 && yychar<0 ) yychar = yylex(); + goto yydefault; + } + + if( yychar<0 ) yychar = yylex(); + if( (yyn += yychar)<0 || yyn >= yylast ) goto yydefault; + + if( yychk[ yyn=yyact[ yyn ] ] == yychar ){ /* valid shift */ + yychar = -1; + yyval = yylval; + yystate = yyn; + if( yyerrflag > 0 ) --yyerrflag; + goto yystack; + } + + yydefault: + /* default state action */ + + if( (yyn=yydef[yystate]) == -2 ) yyn = yyexcp( yystate ); + + if( yyn == -1 ){ /* accept */ + return( 0 ); + } + + if( yyn == 0 ){ /* error */ + /* error ... attempt to resume parsing */ + + switch( yyerrflag ){ + + case 0: /* brand new error */ + + ++yynerrs; + yyerror("syntax error", NULL); + + case 1: + case 2: /* incompletely recovered error ... try again */ + + yyerrflag = 3; + + /* find a state where "error" is a legal shift action */ + + while ( yyps >= yys ) { + yyn = yypact[*yyps] + yyerrval; + if( yyn>= 0 && yyn < yylast && yychk[yyact[yyn]] == yyerrval ){ + yystate = yyact[yyn]; /* simulate a shift of "error" */ + goto yystack; + } + yyn = yypact[*yyps]; + + /* the current yyps has no shift onn "error", pop stack */ + +#ifdef DEBUG + if(yydebug) + fprintf(LOGOUT, "error recovery pops state %d, uncovers %d\n", + *yyps, yyps[-1]); +#endif + + --yyps; + --yypv; + } + + /* there is no state on the stack with an error shift ... abort */ + + abort: + return(1); + + + case 3: /* no shift yet; clobber input char */ + +#ifdef DEBUG + if (yydebug) + fprintf(LOGOUT, "error recovery discards char %d\n", yychar ); +#endif + + if( yychar == 0 ) goto abort; /* don't discard EOF, quit */ + yychar = -1; + goto yynewstate; /* try again in the same state */ + + } + + } + + /* reduction by production yyn */ + +#ifdef DEBUG + if(yydebug) fprintf(LOGOUT, "reduce %d\n",yyn); +#endif + + yyps -= yyr2[yyn]; + yypv -= yyr2[yyn]; +/* YYVCOPY(yyval,yypv[1]); + */ yyval = yypv[1]; + yyactr(yyn); + /* consult goto table to find next state */ + yyn = yyr1[yyn]; + yyj = yypgo[yyn] + *yyps + 1; + if( yyj>=yylast || yychk[ yystate = yyact[yyj] ] != -yyn ) yystate = yyact[yypgo[yyn]]; + goto yystack; /* stack new state and value */ + + } diff --git a/c20/lex/yylex.c b/c20/lex/yylex.c new file mode 100644 index 00000000..9f032910 --- /dev/null +++ b/c20/lex/yylex.c @@ -0,0 +1,174 @@ +/* + * yylex for lex tables + */ + +/* + * Bob Denny 28-Aug-82 Remove reference to stdio.h + * Remove code to default lexin, change to call to + * llstin(), generated by lex depending upon setting + * of "-s" switch. Eliminates hardwired dependency + * on standard I/O library. Moved declaration of + * lexin to lexgetc(). + * + * Bob Denny 31-Aug-82 Add call to lexswitch() in + * the generated file, to switch to the table whose + * name was given in the "-t" switch (or to "lextab" + * if "-t" wasn't given). Removed hardwired setting + * of _tabp --> "lextab" here. Now handled automagically. + * + * Bob Denny 21-Oct-82 Add llinit() function to re-initialize + * yylex(), making it serially reusable. + * + * Initialize _tabp to NULL so lexswitch() to real table happens + * only once. + */ + +#include /* PLB */ +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +/*)LIBRARY +*/ + +#define ERROR 256 /* yacc's value */ + +#define NBPW 16 /* bits per word */ + +tst__b(c, tab) +register int c; +char tab[]; +{ + return(tab[(c >> 3) & 037] & (1 << (c & 07)) ); +} + +struct lextab *_tabp = 0; + +extern char *llsave[]; /* Right-context buffer */ +char llbuf[100]; /* work buffer */ +char *llp1 = &llbuf[0]; /* pointer to next avail. in token */ +char *llp2 = &llbuf[0]; /* pointer to end of lookahead */ +char *llend = &llbuf[0]; /* pointer to end of token */ +char *llebuf = &llbuf[sizeof llbuf]; +int lleof; +int yylval = 0; +int yyline = 0; + +yylex() +{ + register c, st; + int final, l, llk, i; + register struct lextab *lp; + char *cp; + + /* + * Call llstin() to default lexin to stdin + * and assign _tabp to "real" table. + */ + llstin(); /* Initialize yylex() variables */ +loop: + llk = 0; + if (llset()) + return(0); /* Prevent EOF loop */ + st = 0; + final = -1; + lp = _tabp; + + do { + if (lp->lllook && (l = lp->lllook[st])) { + for (c=0; cllfinal[st]) != -1) { + final = i; + llend = llp1; + } + if ((c = llinp()) < 0) + break; + if ((cp = lp->llbrk) && llk==0 && tst__b(c, cp)) { + llp1--; + break; + } + } while ((st = (*lp->llmove)(lp, c, st)) != -1); + + + if (llp2 < llp1) + llp2 = llp1; + if (final == -1) { + llend = llp1; + if (st == 0 && c < 0) + return(0); + if ((cp = lp->llill) && tst__b(c, cp)) { + lexerror("Illegal (out of range) input character"); +/* + lexerror("Illegal character: %c (%03o)", c, c); +*/ + goto loop; + } + return(ERROR); + } + if (c = (final >> 11) & 037) + llend = llsave[c-1]; + if ((c = (*lp->llactr)(final&03777)) >= 0) + return(c); + goto loop; +} + +llinp() +{ + register c; + register struct lextab *lp; + register char *cp; + + lp = _tabp; + cp = lp->llign; /* Ignore class */ + for (;;) { + /* + * Get the next character from the save buffer (if possible) + * If the save buffer's empty, then return EOF or the next + * input character. Ignore the character if it's in the + * ignore class. + */ + c = (llp1 < llp2) ? *llp1 & 0377 : (lleof) ? EOF : lexgetc(); + if (c >= 0) { /* Got a character? */ + if (cp && tst__b(c, cp)) + continue; /* Ignore it */ + if (llp1 >= llebuf) { /* No, is there room? */ + lexerror("Token buffer overflow"); + exit(1); + } + *llp1++ = c; /* Store in token buff */ + } else + lleof = 1; /* Set EOF signal */ + return(c); + } +} + +llset() +/* + * Return TRUE if EOF and nothing was moved in the look-ahead buffer + */ +{ + register char *lp1, *lp2; + + for (lp1 = llbuf, lp2 = llend; lp2 < llp2;) + *lp1++ = *lp2++; + llend = llp1 = llbuf; + llp2 = lp1; + return(lleof && lp1 == llbuf); +} + +/* + * Re-initialize yylex() so that it can be re-used on + * another file. + */ +llinit() + { + llp1 = llp2 = llend = llbuf; + llebuf = llbuf + sizeof(llbuf); + lleof = yylval = yyline = 0; + } diff --git a/c20/lex/yylex.c-2 b/c20/lex/yylex.c-2 new file mode 100644 index 00000000..dd86c1bf --- /dev/null +++ b/c20/lex/yylex.c-2 @@ -0,0 +1,176 @@ +/* + * yylex for lex tables + */ + +/* + * Bob Denny 28-Aug-82 Remove reference to stdio.h + * Remove code to default lexin, change to call to + * llstin(), generated by lex depending upon setting + * of "-s" switch. Eliminates hardwired dependency + * on standard I/O library. Moved declaration of + * lexin to lexgetc(). + * + * Bob Denny 31-Aug-82 Add call to lexswitch() in + * the generated file, to switch to the table whose + * name was given in the "-t" switch (or to "lextab" + * if "-t" wasn't given). Removed hardwired setting + * of _tabp --> "lextab" here. Now handled automagically. + * + * Bob Denny 21-Oct-82 Add llinit() function to re-initialize + * yylex(), making it serially reusable. + * + * Initialize _tabp to NULL so lexswitch() to real table happens + * only once. + */ + +#include /* PLB */ +#ifdef vms +#include "c:lex.h" +#else +#include +#endif + +/*)LIBRARY +*/ + +#define ERROR 256 /* yacc's value */ + +#define NBPW 16 /* bits per word */ + +tst__b(c, tab) +register int c; +char tab[]; +{ + return(tab[(c >> 3) & 037] & (1 << (c & 07)) ); +} + +struct lextab *_tabp = 0; + +extern char *llsave[]; /* Right-context buffer */ +char llbuf[100]; /* work buffer */ +char *llp1 = &llbuf[0]; /* pointer to next avail. in token */ +char *llp2 = &llbuf[0]; /* pointer to end of lookahead */ +char *llend = &llbuf[0]; /* pointer to end of token */ +char *llebuf = &llbuf[sizeof llbuf]; +int lleof; +int yylval = 0; +int yyline = 0; + +yylex() +{ + register c, st; + int final, l, llk, i; + register struct lextab *lp; + char *cp; + + /* + * Call llstin() to default lexin to stdin + * and assign _tabp to "real" table. + */ + llstin(); /* Initialize yylex() variables */ + +loop: + llk = 0; + if (llset()) + return(0); /* Prevent EOF loop */ + st = 0; + final = -1; + lp = _tabp; + + do { + if (lp->lllook && (l = lp->lllook[st])) { + for (c=0; cllfinal[st]) != -1) { + final = i; + llend = llp1; + } + if ((c = llinp()) < 0) + break; + if ((cp = lp->llbrk) && llk==0 && tst__b(c, cp)) { + llp1--; + break; + } + } while ((st = (*lp->llmove)(lp, c, st)) != -1); + + + if (llp2 < llp1) + llp2 = llp1; + if (final == -1) { + llend = llp1; + if (st == 0 && c < 0) + return(0); + if ((cp = lp->llill) && tst__b(c, cp)) { +#ifdef vms + lexerror("Illegal (out of range) input character"); +#else + lexerror("Illegal character: %c (%03o)", c, c); +#endif + goto loop; + } + return(ERROR); + } + if (c = (final >> 11) & 037) + llend = llsave[c-1]; + if ((c = (*lp->llactr)(final&03777)) >= 0) + return(c); + goto loop; +} + +llinp() +{ + register c; + register struct lextab *lp; + register char *cp; + + lp = _tabp; + cp = lp->llign; /* Ignore class */ + for (;;) { + /* + * Get the next character from the save buffer (if possible) + * If the save buffer's empty, then return EOF or the next + * input character. Ignore the character if it's in the + * ignore class. + */ + c = (llp1 < llp2) ? *llp1 & 0377 : (lleof) ? EOF : lexgetc(); + if (c >= 0) { /* Got a character? */ + if (cp && tst__b(c, cp)) + continue; /* Ignore it */ + if (llp1 >= llebuf) { /* No, is there room? */ + lexerror("Token buffer overflow"); + exit(1); + } + *llp1++ = c; /* Store in token buff */ + } else + lleof = 1; /* Set EOF signal */ + return(c); + } +} + +llset() +/* + * Return TRUE if EOF and nothing was moved in the look-ahead buffer + */ +{ + register char *lp1, *lp2; + + for (lp1 = llbuf, lp2 = llend; lp2 < llp2;) + *lp1++ = *lp2++; + llend = llp1 = llbuf; + llp2 = lp1; + return(lleof && lp1 == llbuf); +} + +/* + * Re-initialize yylex() so that it can be re-used on + * another file. + */ +llinit() + { + llp1 = llp2 = llend = llbuf; + llebuf = llbuf + sizeof(llbuf); + lleof = yylval = yyline = 0; + } diff --git a/c20/minsrt.mid b/c20/minsrt.mid new file mode 100644 index 00000000..e69de29b diff --git a/c20/mulseg.mid b/c20/mulseg.mid new file mode 100644 index 0000000000000000000000000000000000000000..857c18882df891529934c640579a372f629826ec GIT binary patch literal 1586 zcmZWpVQ-sA5bam?S4?%fFA0Zn+DfN$9f>;Y6a{0K#cHG~sy1eAuLNwxLet!@znKLR z*Jo+XvNLbyy*DdnkbjN^#Hrv}4$C;<5GBd_tAMTGuwH`53<{L#OSrXDJ(PIy)A(*nepnP`_mLqf|cO_h4!TM`@v;P4DmfkbXYZ zsG(7%*~wNumS{v#G|F0KLDz^LNl)QPmnGO%HZANMQ~d_&s}0(BN27O&eA~m|!$|K% zA3C6`AEs$#-6B2IrfYJt1>GXD)Ro3j&{!+^OIKY5R{yKU3H&@4-CrEKH^>?Br#7V!-kZg`?-D(<(GZA)O z)8PF<{MZFGhIDsXyqx;q7`x%iIOX0-{22-FVw2(P{e}MrvQF3jh1f3Xoq2uWtvi0( zpE57!*(y%Q8p8~u>{d(|6->o^K6SfwIG=}Zm*6g7UYu2QF337d8fdk;{#oUD^l@wo!xjJuigjWuRa9Vmmd+7itp3EgKO7i za3td!{6JF0RGewgR~r-^eG;2feg3O*1i764N&fYtb|&B(2_Y6hy)o0LdoZT>lj{>d sF|ZJBXlR~e9(praeCCTgv0a@IW-pURz79qIR2&~k=sJY#fxUV2AN||84FCWD literal 0 HcmV?d00001 diff --git a/c20/nc.mid b/c20/nc.mid new file mode 100644 index 00000000..c440792e --- /dev/null +++ b/c20/nc.mid @@ -0,0 +1,62 @@ +; NC.MID + +; This file is needed to assemble MIDAS programs produced by +; the C compiler as well as hand-coded MIDAS programs designed +; to be loaded with C programs. + +.SYMTAB 4000.,4000. +RELOCATABLE +.INSRT MULSEG +.MSEG 200000',600000',700000' + +IF1,[ +.MLLIT==1 + +A=1 +B=2 +C=3 +D=4 +P=15. +.CCALL=1_27. +GO=JRST + +EQUALS ENTRY .GLOBAL +EQUALS EXTERN .GLOBAL + +DEFINE .IDATA +.SEG 0 +TERMIN + +DEFINE .UDATA +.SEG 1 +TERMIN + +DEFINE .CODE +.SEG 2 +TERMIN + +DEFINE .PDATA +.SEG 3 +TERMIN + +; STACK HACKING FOR VARIABLE REFERENCES + +%P==0 +DEFINE PPUSH [A] + PUSH P,A + %P==%P+1 + TERMIN +DEFINE PPOP [A] + POP P,A + %P==%P-1 + TERMIN +DEFINE CCALL N,F + .CCALL N,F + %P==%P-N + TERMIN + +];END IF1 + +IF2,[IFDEF FS1,[ + .KILL %A,%P,A,B,C,D,P,GO,.CCALL + ]] diff --git a/c20/new/cc.c b/c20/new/cc.c new file mode 100644 index 00000000..cbcfdc7e --- /dev/null +++ b/c20/new/cc.c @@ -0,0 +1,622 @@ +# include +# include +# define FALSE 0 +# define TRUE 1 +/* + + TOPS-20 Portable C Compiler Command Routine + + + Compiler Options + + -c compile only, do not assemble + -d generate debugging code + -f write errors to file instead of tty + -g do not delete assembly language temp file + -k keep intermediate files + -o run code optimizer + -r ring bell when done + -l link file and standard library, producing .EXE file + + p=xxx predefine symbol xxx (to be 1) + l=xxx look in directory xxx for include files + +*/ + +/* renamings to allow long names */ + +# define construct_output_file_names cnsofn +# define execute_phase execph +# define write_statistics wrstat +# define print_phase_time prphtm +# define process_options proopt +# define process_minus_option promin +# define process_equal_option proeq + +# define phase_name phsnm +# define phase_pname phspnm +# define phase_prog phspr +# define phase_argc phsac +# define phase_argv phsav +# define phase_option phsop +# define phase_et phset +# define phase_pt phspt + +# define argv_P avp +# define argv_C avc + +/* program file names */ + +/* where to look for executable image files */ +# define PREFIX "C:" + +/* extension of executable image files */ +# define SUFFIX ".exe" + +# define OBJDIR "" + +# define INTSUF "i" +# define OBJSUF "obj" +# define OPTSUF "mid" +# define RELSUF "stk" +# define ERRSUF "cerr" +# define EXESUF "exe" + +# define ASMFILE "c:casm.exe" +# define LDFILE "sys:stinkr.exe" +# define LIBRARY "c:stdio" + +# define FNSIZE 100 + + +/* options */ + +int kflag, cflag, gflag, oflag, rflag, fflag, dflag, lflag; + +/* table for pre-defined symbols */ + +# define maxpds 10 +char *pdstab[maxpds + 1]; +char **pdsptr = {pdstab}; + +/* tables for #include default directories */ + +# define maxdirs 5 +char *dfdirs[maxdirs + 1]; +char **dfdptr = {dfdirs}; + +/* default search directories for # include <> */ + +# define n10dirs 2 +char *df10dirs[] = {"-IC:", "-ICLIB:"}; + + +/* phase information */ + +# define nphase 3 + +# define phase_P 0 +# define phase_C 1 +# define phase_O 2 + +# define extra maxpds + maxdirs + +char *argv_P[2 + extra]; +char *argv_C[4 + extra]; +char *argv_O[2]; + +char *phase_name[] = {"P","C","O"}; +char *phase_pname[] = {"cpp","pcc","opt"}; +char phase_prog[nphase][FNSIZE]; +int phase_argc[] = {2, 3, 2}; +char **phase_argv[] = {argv_P, argv_C, argv_O}; +int phase_et[] = {0, 0, 0}; +int phase_pt[] = {0, 0, 0}; + +static char *pdp10_pdefs[] = {"-DPDP10=1", 0}; /* predefined symbols */ + +# define opsys_name "-DTOPS20=1" + +char *opsys = NULL; + +extern char *sconcat (); + +/********************************************************************** + + THE MAIN PROGRAM + +**********************************************************************/ + +main (argc, argv) +char *argv[]; +{ + extern FILE *stdout; + FILE *f; + int snum, cc, i, ttyflag; + cal start_time; + char *fargv[50], buffer[2000]; + char src_name[FNSIZE], + int_name[FNSIZE], + obj_name[FNSIZE], + opt_name[FNSIZE], + rel_name[FNSIZE], + err_name[FNSIZE], + exe_name[FNSIZE]; + char *fptr; + char nambuf[2][FNSIZE]; + char cmdbuf[100]; + + --argc; /* skip over program name */ + ++argv; + argc = process_options (argc, argv); + argc = exparg (argc, argv, fargv, buffer); + argv = fargv; + + pp_setup (); /* set up preprocessor arguments */ + + nambuf[0][0] = '<'; /* for re-directed input */ + nambuf[1][0] = '>'; /* for re-directed output */ + + for (snum = 0; snum < argc; ++snum) { + char name[FNSIZE]; + + strcpy (src_name, argv[snum]); + + /* check that source file exists */ + + if ((f = fopen (src_name, "r")) == NULL) { + char ext[FNSIZE]; + + fngtp (src_name, ext); + if (*ext == 0) { + fnsfd (src_name, src_name, 0, 0, 0, "c", 0, 0); + f = fopen (src_name, "r"); + } + if (f == NULL) { + printf ("Can't Find '%s'.\n", src_name); + continue; + } + } + fclose (f); + fngnm (src_name, name); /* get name part of file spec */ + for (fptr=name;*fptr!=0;fptr++) + *fptr = upperr(*fptr); + +#ifdef SHORTNAME + name[6] = 0; /* print only six chars to match macro */ +#endif + + now (&start_time); + + /* construct output file names from source file name */ + + construct_output_file_names (src_name, int_name, obj_name, + opt_name, rel_name, err_name, + exe_name); + + for (i = 0; i < nphase; ++i) phase_pt[i] = -1; + +#ifdef PHASEPRINT + printf ("CPP:\t%s\n",name); +#else + printf ("C:\t%s\n",name); +#endif + fflush (stdout); + + argv_P[0] = src_name; /* name of source file */ + argv_P[1] = &nambuf[1][0]; /* >intname for redirected output */ + strcpy (&nambuf[1][1],int_name); /* get intname */ + cc = execute_phase (phase_P); /* reu preprocessor */ + if (!cc) { + +#ifdef PHASEPRINT + printf ("PCC:\t%s\n",name); + fflush (stdout); +#endif + + argv_C[0] = &nambuf[0][0]; /* input from int file */ + strcpy (&nambuf[0][1],int_name); + argv_C[1] = &nambuf[1][0]; /* output to obj file */ + strcpy (&nambuf[1][1],obj_name); + argv_C[2] = name; /* tell pcc the module name */ + if (fflag) { + cmdbuf[0] = '%'; + strcpy (cmdbuf + 1,err_name); + argv_C[3] = cmdbuf; + phase_argc[phase_C] = 4; + } + cc = execute_phase (phase_C); + } + if (!kflag) unlink (int_name); + + if (oflag) { + argv_O[0] = &nambuf[0][0]; + strcpy (&nambuf[0][1],obj_name); + argv_O[1] = &nambuf[1][0]; + strcpy (&nambuf[1][1],opt_name); +#ifdef PHASEPRINT + printf ("OPT:\t%s\n",name); + fflush(stdout); +#endif + cc = execute_phase (phase_O); + if (!kflag) unlink (obj_name); + } + else strcpy (opt_name, obj_name); + + stats(src_name, &start_time); + + if (cc) { + if (!gflag) unlink (opt_name); + } + else if (!cflag) { + +#ifdef PHASEPRINT + printf ("CASM:\t%s\n",name); + fflush(stdout); +#endif + + cc = assemble (opt_name, rel_name); + if (!cc) { + if (!gflag) unlink (opt_name); + if (lflag) { + load( rel_name, exe_name ); + unlink( rel_name ); + } + } + } + if (rflag) { + putc ('\007', stdout); + fflush (stdout); + } + } + if (rflag) { + putc ('\007', stdout); + fflush (stdout); + } +} + +/********************************************************************** + + PROCESS_OPTIONS - Process options in command arguments + and remove options from argument list. + +**********************************************************************/ + +int process_options (argc, argv) +char *argv[]; +{ + char *s, **ss, **dd; + int n, opt; + + kflag = cflag = gflag = rflag = FALSE; + + dd = ss = argv; + n = 0; + while (--argc >= 0) { + s = *ss++; + if (s[0] == '-') process_minus_option (s + 1); + else if ((opt = s[0]) && s[1] == '=') + process_equal_option (opt, s + 2); + else { + *dd++ = s; + ++n; + } + } + return (n); +} + +/********************************************************************** + + PROCESS_MINUS_OPTION + +**********************************************************************/ + +process_minus_option (s) +char *s; +{ + int c; + + while (c = *s) { + *s++ = c = lower (c); + switch (c) { + case 'k': kflag = TRUE; break; + case 'c': cflag = TRUE; break; + case 'g': gflag = TRUE; break; + case 'o': oflag = TRUE; break; + case 'r': rflag = TRUE; break; + case 'f': fflag = TRUE; break; + case 'd': dflag = TRUE; break; + case 'l': lflag = TRUE; break; + default: printf ("Unrecognized option: -%c\n", c); + break; + } + } +} + +/********************************************************************** + + PROCESS_EQUAL_OPTION + +**********************************************************************/ + +process_equal_option (opt, s) +char *s; +{ + char *r; + int c; + + switch (opt = lower (opt)) { + case 'p': if (pdsptr < pdstab + maxpds) { + static char pdss[maxpds][20]; + r = &pdss[pdsptr - pdstab][0]; + *pdsptr++ = r; + sconcat (r, 3, "-D", s + 2, "=1"); + } + else printf ("Sorry, too many pre-defined symbols.\n"); + return; + + case 'l': if (dfdptr < dfdirs + maxdirs) { + *dfdptr++ = s; + s[0] = '-'; + s[1] = 'I'; + } + else printf ("Sorry, too many search directories.\n"); + return; + + default: printf ("Unrecognized option: %c=%s\n", opt, s); + } +} + +/********************************************************************** + + PP_SETUP + + Add pre-defined symbols and search directories to ARGV_P + +**********************************************************************/ + +pp_setup () +{ + char **p, *q; + + /* add defined search directories to preproc args */ + p = df10dirs; + while (p < df10dirs + n10dirs) add_arg (phase_P, *p++); + p = dfdirs; + while (p < dfdptr) add_arg (phase_P, *p++); + + /* add predefined symbols to preprocessor args */ + p = pdp10_pdefs; + add_arg (phase_P, *p); /* add system predefined symbols */ + if (q = opsys) { + if (strcmp (q, "-DTOPS20=1")) add_arg (phase_P, "-UTOPS20"); + add_arg (phase_P, q); + } + p = pdstab; /* add user predefined symbols */ + while (p < pdsptr) add_arg (phase_P, *p++); +} + +/********************************************************************** + + ADD_ARG - append an argument to the list for the given phase + +**********************************************************************/ + +add_arg (phs, arg) +char *arg; +{ + phase_argv[phs][phase_argc[phs]++] = arg; +} + +/********************************************************************** + + CONSTRUCT_OUTPUT_FILE_NAMES + + Construct assembler, relocatable, and symbol table listing + file names from source file name. + +**********************************************************************/ + +construct_output_file_names (src_name, int_name, obj_name, opt_name, rel_name, err_name,exe_name) +char *src_name,*int_name,*obj_name,*opt_name,*rel_name,*err_name,*exe_name; +{ + fnsfd (obj_name, src_name, "", OBJDIR, 0, OBJSUF, 0, 0); + fnsfd (opt_name, obj_name, 0, 0, 0, OPTSUF, 0, 0); + fnsfd (int_name, obj_name, 0, 0, 0, INTSUF, 0, 0); + if (!cflag) fnsfd (rel_name, obj_name, 0, 0, 0, RELSUF, 0, 0); + if (fflag) fnsfd (err_name, obj_name, 0, 0, 0, ERRSUF, 0, 0); + if (lflag) fnsfd (exe_name, obj_name, 0, 0, 0, EXESUF, 0, 0); +} + +/********************************************************************** + + EXECUTE PHASE + +**********************************************************************/ + +execute_phase (n) +int n; +{ + extern int exctime, exccode; + int t; + + set_program_name (n); + t = etime (); + if (execv (phase_prog[n], phase_argc[n], phase_argv[n])) { + printf ("Unable to execute phase %s\n", phase_name[n]); + return (-1); + } + phase_et[n] = etime () - t; /* elapsed time */ + phase_pt[n] = exctime; /* runtime */ + return (exccode); +} + +/********************************************************************** + + SET_PROGRAM_NAME + + Construct the file name of program for the given phase. + +**********************************************************************/ + +set_program_name (n) +int n; +{ + char *r, *s; + + r = PREFIX; + s = SUFFIX; + sconcat (phase_prog[n], 4, r, phase_pname[n],".",s); +} + +/********************************************************************** + + STATS - write statistics to stat file + +**********************************************************************/ + +# define STATFILE1 "C:pcc.stat" + + +stats (src_name, st) +char *src_name; +cal *st; +{ + FILE *f; + int flag, i; + char temp[50]; + + flag = TRUE; + f = fopen (STATFILE1, "a"); +# ifdef statfile2 + if (f == NULL) f = fopen (STATFILE2, "a"); +# endif + if (f == NULL) return; + putc ('\n', f); + strcpy (temp,username ()); + fprintf (f, "%s - ", temp); + prcal (st, f); + fprintf (f, " - "); + fngdr (src_name, temp); + if (temp[0]) { + slower (temp); + fprintf (f, "%s/", temp); + } + fngnm (src_name, temp); + slower (temp); + fprintf (f, "%s", temp); + +# define hack if (flag) {fprint (f, " ("); flag = FALSE;} else putc (' ', f) + + if (cflag || gflag || kflag) { + hack; + if (cflag) putc ('c', f); + if (gflag) putc ('g', f); + if (kflag) putc ('k', f); + } + if (!flag) putc (')', f); + + fprintf (f, "\n\n"); + for (i = 0; i < nphase; ++i) print_phase_time (i, f); + fclose (f); +} + +/********************************************************************** + + PRINT_PHASE_TIME - As Part Of Statistics + +**********************************************************************/ + +print_phase_time (n, f) +FILE *f; +{ + if (phase_pt[n] != -1) { + fprint (f, phase_name[n]); + if (!phase_name[n][1]) putc (' ', f); + fprint (f, " P="); + pr60th (phase_pt[n], f); + fprint (f, " E="); + pr60th (phase_et[n], f); + putc ('\n', f); + } +} + +/********************************************************************** + + ASSEMBLE - Create the relocatable file from the assembler file + + return TRUE iff an error occurred + +**********************************************************************/ + +int assemble (obj_name, rel_name) +char *obj_name, *rel_name; +{ +# ifdef TENEX + /* TENEX can't run MIDAS as an inferior -- sigh */ + fprint ("OUTPUT on %s\n", obj_name); + return (TRUE); +} +# else + + char *s, temp[100]; + FILE *f; + + /* construct Assembler command line */ + + strcpy (temp, rel_name); + strcat (temp, " _ "); + strcat (temp, obj_name); + strcat (temp, " (w)", s); + + /* execute Assembler */ + if (execs (ASMFILE, temp)) { + fprint (stderr,"Unable to Assemble.\n"); + return (TRUE); + } + + /* construct Assembler record file name */ + + fnsfd (temp, obj_name, 0, 0, 0, "err", 0, 0); + + /* examine Assembler record file */ + + f = fopen (temp, "r"); + if (f != NULL) { /* look for '-' + '\t' */ + register int c; + + while ((c = getc (f)) != EOF) { + if (c == '-') { + c = getc (f); + if (!isdigit (c)) continue; + while (isdigit (c)) c = getc (f); + if (c != '\t') continue; + fprint (stderr, "Assembler Errors.\n"); + fclose (f); + return (TRUE); + } + } + fclose (f); + unlink(temp); + } + return (FALSE); +} + +load (rn,en) +char *rn, *en; +{ + char buf[50]; + FILE *tfile; + + tmpnam(buf); + if ((tfile = fopen(buf,"w")) == NULL) return( TRUE ); + fprintf(tfile,"x %s\nl %s\no %s\nq\n",LIBRARY,rn,en); + fclose(tfile); + if (execs (LDFILE, buf)) { + fprint (stderr,"Unable to load.\n"); + return (TRUE); + } + unlink( buf ); + return( FALSE ); +} +# endif diff --git a/c20/new/cc.stinkr b/c20/new/cc.stinkr new file mode 100644 index 00000000..15faf250 --- /dev/null +++ b/c20/new/cc.stinkr @@ -0,0 +1,7 @@ +x c:stdio +l cc +l clib:exec +l clib:date +l clib:string +l clib:files +o cc.exe diff --git a/c20/new/cinsrt.mid b/c20/new/cinsrt.mid new file mode 100644 index 00000000..7d0c983f --- /dev/null +++ b/c20/new/cinsrt.mid @@ -0,0 +1,53 @@ +; C:CINSRT.MID + +; This file is .INSRTed by code generated by the C compiler PCC20 + +.symtab 4000.,4000. +relocatable +.insrt c:mulseg +.mseg 400000',600000' + +if1,[ +.mllit==1 + +a==1 +b==2 +c==3 +d==4 +t1=1 +t2=2 +t3=3 +t4=4 + +ep=16 +p=17 + +.global cfloat +.global cfix + +define .idata +.seg 0 +termin + +define .code +.seg 1 +termin + +define .pdata +.seg 2 +termin + +];end if1 + +; hack for constants so they end up in segment .pdata + +equals nm%en end +expunge end + +define end endloc + .pdata + constants + nm%en endloc + termin + +.code diff --git a/c20/new/doc/cc.bwr b/c20/new/doc/cc.bwr new file mode 100644 index 00000000..3e3f5f72 --- /dev/null +++ b/c20/new/doc/cc.bwr @@ -0,0 +1,29 @@ +[CC.BWR JTW 5/5/83] + +Known oddities with the TOPS-20 C Compiler at this time: + +0) Oops! UNSIGNED comparisons sometimes actually generate code + which performs a signed comparison. I wonder why nobody noticed + this until now??? (5/2/83) + +1) In some rare cases type conflicts which generate only "warning" + messages actually cause bad code to be generated. + +2) The compiler was recently changed to put file-wide STATIC object + names into an internal name-space, rather than passing the name to the + assembler and linker. This results in file-wide STATIC function and + variable names being unique to infinite characters instead of 5, but also + requires that any STATIC object be declared as such before it's first + use. (I feel that the C language requires this, but you used to be able + to get away with cheating.) Some system library files may not conform + to this new requirement. If so, recompiling the library file will + result in warning messages explaining the problem. You will have to + fix it if you want to recompile such a file. + +3) The optimizer occasionally optimizes the functionality right out of + your code. + +4) A recent attempt to compile the unix spread-sheet calculator program + SC divulged hitherto unsuspected bugs of currently unknown origin. + These result in fatal compiler errors, rather than generation of bad + code. diff --git a/c20/new/doc/cc.doc b/c20/new/doc/cc.doc new file mode 100644 index 00000000..4878f67f --- /dev/null +++ b/c20/new/doc/cc.doc @@ -0,0 +1,265 @@ + + +1. Introduction + This note describes the process of compiling, linking, and running a C +program on the DECSYSTEM-20. It assumes that you already have a working +knowledge of both the C programming language and the standard I/O packages. +The definitive C reference manual is "The C Programming Language" by Brian +Kernighan and Dennis Ritchie. Further information about I/O routines may be +had by looking at the sources, which are in the directory CLIB: + + The C compiler described here is based on the Portable C Compiler written by +S. C. Johnson of Bell Labs. The PDP-10 code generator was written by Eliot +Moss and Chris Terman of the MIT Lab for Computer Science, and John Wroclawski +of the MIT Research Lab of Electronics. + + THIS IS LICENSED SOFTWARE. You should feel perfectly free not to steal it +from this machine. Copies of the compiler are available to any not-for-profit +organization that has a valid UNIX (which, as we all know by now, is a +trademark of Bell Labs) version 7 license. + +2. Compiler Characteristics + + + +2.1. Language Implementation + This compiler implements the full C language, as described in Kernighan and +Ritchie. In addition this compiler supports enumerated data types and +structure assignment and parameter passing. These recent extensions to the C +language are described in the file CDOC:EXTENSIONS.DOC. The type-checking of +this compiler is significantly tighter than that of the old UNIX compilers; in +particular, attempts to assign an integer to a pointer variable or vice versa +will result in a warning message. The compiler will let you do these things, it +just makes sure to tell you you are doing it. + + The compiler supports both the old and new forms for assignment operators and +initializers, although the old forms result in a warning. + + + +2.2. Datatypes + All datatypes are stored in one PDP-10 word (36 bits). You can thus assign +things to different datatypes without fear of losing information. If you are +writing portable software you should, of course, be more careful about +representational issues. Note that strings take up 36 bits per character and +can therefore use lots of memory. + +2.3. Names + Variable names which are internal to a single file may be of any length, and +are completely unique, with case being significant. This includes STATIC +variables and functions, AUTO variables, typedef'd types, ENUM type names and +members, and structure and union tagnames and member names. Variable names +which must be handled by the linker must be unique to within the first 5 +characters, with no case significance. This includes EXTERN function and +variable names. They may still be of any length, however. + +3. Compiling + The compiler is executed by typing + + cc + +to the exec. is a list of one or more filenames, possibly +containing wildcard characters, and separated by spaces. The extension on + defaults to .c, if your file has another extension it must be +specified. CC will invoke (one or more of) the C preprocessor, compiler, code +optimizer, assembler and linker for each file, depending on the . + + + +3.1. Compiler Switches + Several switches may be specified to control the operation of the compiler. +They are typed on the command line preceded by a minus sign. At present the +switches are: + +-c Compile only, do not assemble + +-l Link file with standard runtime library to produce a .EXE file + +-d Generate debugging code. See the file CDOC:DEBUG.DOC for more + info + +-f Write compiler errors to .cerr, rather than to terminal + +-g Do not delete assembler source file + +-k Keep intermediate files (preprocessor output and unoptimized + assembler source, if present) + +-o Run code optimization phase (NOTE: the optimizer occasionally + screws up and breaks your code - use with caution) + +-r Beep when finished compiling + + The -c flag is useful to syntax check a file in the early stages of +development. The -l flag may be used to directly generate a runnable (.EXE) +file for simple programs (see 4) + + As an example, the command line + + cc foo -lr + +would cause the compiler to compile the file foo.c, link it with the standard C +runtime library to form a runnable image, and beep the terminal bell when +finished. + + + +3.2. Error Messages + Most of the compiler error messages are self-explanatory. Messages come in +two forms; errors and warnings. Warnings generally do not affect the operation +of a program, but are provided to inform you of possibly ambiguous constructs +or type clashes. + + When a syntax error is discovered, the compiler attempts to bypass the error +so that it may continue checking for later errors. Often this process results +in some spurious errors until the parser unconfuses itself. Thus if you receive +a large group of error messages clustered around a certain point in the file, +fixing the first one will often eliminate the others as well. + + Occasionally the message "Assembler Errors" will appear. This generally +means that two EXTERN variable or function names in your program have mapped to +the same label in the assembly code. This happens because external names are +unique only to the first five characters. (see 2.3) Error output from the +assembler is written to .err, and will provide hints as to the offending +names. + +4. Linking + After you have compiled your program you must link it with the C runtime +routines to produce an executable image. There are two ways to accomplish +this. + + -Use the -l flag to the compiler + + -Run the linker as a separate program + +The -l flag is useful when you are writing a program which is completely +contained in one file, and requires only the runtime functions from the +standard library. If the file you are compiling meets these conditions, giving +the -l flag to CC will cause it to run the linker for you, directly producing a +runnable program. + + + +4.1. The Linker + If your program is split among many files, or you need to link in a function +from the library that is not automaticaly loaded, you will have to run the +linker yourself. (see 4.2 for an easy way to do this repetitively) The current +C linker program is called STINKR. Stinkr has several commands, of which only 5 +are relevant to the normal user. The commands are: + +l load file + +x execute command file + +o specify output file name + +q link files, then exit + +; a comment + + Blank command lines are ignored. + + The basic operation of STINKR is to read all of the commands, loading +specified files and remembering the other information. When the basic command +file is finished (or q is typed, if terminal input), STINKR then does the +following: + + 1. prints a list of undefined symbols, if any + + 2. prints a segment map + + 3. writes the program to output file, if specified + +Stinkr commands and options are further described in the file CDOC:STINKR.DOC, +however the normal user will not find that information necessary. + + To link a C program, first run the linker by typing + + stinkr + +to the exec. When the '=' prompt appears, type + + x c:stdio + +This causes the contents of the file c:stdio.stinkr to be read as STINKR +commands, with the result of correctly setting up the linker segments and +initialization routine, and loading in the standard runtime package. Next +specify the name(s) of the file(s) containing your program using the l command: + + l + +No extension is needed on the filename; the correct extension .stk will be +appended automatically. If a program is spread over several seperately compiled +files, simply give the l command to STINKR for each file you wish to load. + + Finally, specify the name of the .exe file you wish the final program to be +written into, using the o command + + o outfile.exe + +In this case the .exe extension must be explicitly typed. Lastly, typing the q +command will cause STINKR to link your program and write it out. + + + +4.2. Linker Command Files + To make this process easier you may put all of the STINKR commands needed to +link a program into a command file with the extension .stinkr, and invoke +STINKR with the name of that file as an argument + + stinkr foo + +invokes stinkr and causes it to execute the commands contained in the file +foo.stinkr. This method is useful for programs composed of many source files, +or those which are frequently recompiled. + +5. Example + This example shows the steps needed to compile the program foo.c and produce +the executable version. and = prompts are typed by the computer, all else is +typed by you. + + @cc foo + @stinkr + =x c:stdio + =l foo + =o foo.exe + =q + +After a short wait, STINKR will print some information, then return you to exec +level. Your program may then be run in the normal TOPS-20 fashion. If the +program is executed using the EXEC's RUN command or is started from DDT, you +will be given the opportunity to specify a command line. If the program is in +the user's SYS: search path and is executed by name, any text following the +program name will be used as the command line. In either case the program may +view it's command line through use of the standard argc and argv arguments to +the main function. + +6. I/O Redirection + I/O redirection, as in UNIX, is supported by the runtime package. Thus, for +example, typing + + foo outfile.txt + +will cause the program foo to be executed with stdin connected to infile.txt +and stdout connexted to outfile.txt. Redirection of stderr is also supported. + + For more information about available I/O routines, see the first part of the +file CLIB:C20IO.C. Several other files in the CLIB: directory +(date,files,string) contain specialized I/O routines. These files are not +automatically loaded with the runtime system, but must be specified in a STINKR +'l' command. + + Table of Contents +1. Introduction 0 +2. Compiler Characteristics 0 + 2.1. Language Implementation 0 + 2.2. Datatypes 0 + 2.3. Names 1 +3. Compiling 1 + 3.1. Compiler Switches 1 + 3.2. Error Messages 2 +4. Linking 2 + 4.1. The Linker 3 + 4.2. Linker Command Files 4 +5. Example 4 +6. I/O Redirection 5 \ No newline at end of file diff --git a/c20/new/doc/cc.hlp b/c20/new/doc/cc.hlp new file mode 100644 index 00000000..cbec4270 --- /dev/null +++ b/c20/new/doc/cc.hlp @@ -0,0 +1,105 @@ +[CC.HLP JTW 5/8/82] + +This file gives terse information and examples for use of the DECsystem-20 +C compiler. For lots of more detailed information, see the file C:CC.DOC. + +-> COMPILING + + The compiler is executed by typing + +cc + +to the exec. The extension on defaults to .c, if your file +has another extension it must be specified. + +-> COMPILER SWITCHES + + Several switches control the operation of the compiler. They are +typed on the command line preceded by a minus sign. The more useful ones +are: + +-c Compile only, do not assemble + +-l Link compiled code with standard runtime library to + form a runnable image (.EXE file) + +-d Generate debugging code. This isn't finished yet. + See the file C:DEBUG.DOC for more info. + +-f Write compiler errors to file.cerr, rather than to terminal. + +-r Beep when finished compiling + + +As an example, the command line + +cc foo -lr + +would cause the compiler to compile the file foo.c, link it with the standard +C runtime library to form a runnable image, and beep the terminal bell when +finished. + +-> LINKING + + A program contained within one file and needing only the standard +runtime library can be automatically loaded (linked) by giving the -l switch +to the compiler. + + Programs spread among many files or desiring special library +functions currently must be linked by hand. To link a C program, first run +the linker by typing: + +@stinkr + +to the exec. When the '=' prompt appears, type + +x c:stdio + +This causes the contents of the file c:stdio.stinkr to be read as +STINKR commands, with the result of correctly setting up the linker +segments and initialization routine, and loading in the runtime +package. Next specify the name(s) of the file(s) containing your +program using the l command: + +l + +No extension is needed on the filename; the correct extension .stk +will be appended automatically. Finally, specify the name of the .exe +file you wish the final program to be written into, using the o +command + +o outfile.exe + +In this case the .exe extension must be explicitly typed. Lastly, +typing the q command will cause STINKR to link your program and write +it out. + +Alternatively you can put all necessary STINKR commands in a file, and +cause STINKR to read this file as a command file by simply saying + +@stinkr + +The file extension for a STINKR command file is .stinkr + +EXAMPLE + + This example shows the steps needed to compile and link a program +contained in the files foo.c and bar.c. @ and = prompts are typed by the +computer, all else is typed by you. + +@cc foo +cc bar +@stinkr +=x c:stdio +=l foo +=l bar +=o myprog.exe +=q + +After a short wait, STINKR will print some information, then return +you to exec level. Your program may then be run simply by typing its +name. + +Again, see C:CC.DOC for more information. + +[End of CC.HLP] \ No newline at end of file diff --git a/c20/new/doc/debug.doc b/c20/new/doc/debug.doc new file mode 100644 index 00000000..2f2baf6f --- /dev/null +++ b/c20/new/doc/debug.doc @@ -0,0 +1,36 @@ +This file documents the current state of the C debugging system. + +To link a debugging version of a C program, compile those files +which you wish to debug with the -d option to the compiler. This +causes the compiler to generate extra information needed by the +debugger. Then say "x c:stddbg" rather than "x c:stdio" as the +first command to STINKR. This causes the debugger to be loaded with +the runtimes. + +********************************************************************** + +5/8/82 - there is no C debugger as yet. However, if you link your +program using the "x c:stddbg" command to STINKR, typing ^D (ctrl-D) +will activate an immediate trace of the runtime stack, showing +all currently active procedures. For each active procedure call, +the name of the procedure, code address from which it was called, +and octal values of any arguments will be displayed. Note that this +will always work, whether or not the program was compiled with the -d +switch to the compiler. Note further that functions which have +structure-type arguments will not have their arguments printed +correctly, since the stack-tracer cannot yet figure out how big +the argument is. + +Coming soon - + + Stack-tracer will know argument types and sizes, and print + out accordingly. + + Execution tracing by function call, function return, or source + code line. + + Breakpointing by function call, function return, or source + code line. + + Display and modification of variables. + diff --git a/c20/new/doc/extensions.doc b/c20/new/doc/extensions.doc new file mode 100644 index 00000000..f0820b23 --- /dev/null +++ b/c20/new/doc/extensions.doc @@ -0,0 +1,94 @@ + +1. Introduction + This note describes several features of the C programming language which +exist in the TOPS-20 C compiler but are not described in the standard C +reference manual. These changes reflect the continued growth and evolution of +the C language, and are incorporated in all recent C compilers. + +2. Enumerated Data Types + The Enumerated Data Type allows the programmer to specify scalar variables +which may take on any of a range of user-specified values. The syntax of +Enumerated Data Type declarations is reminiscent of that for structures: + + enum colors {red, yellow, blue, green}; + +which specifies the type without declaring any variables, or + + enum colors {red, yellow, blue, green} sky, car; + +which declares two variables sky and car of enumerated type colors. Types +defined with the first declaration form above may later be used to declare +variables: + + enum colors leaf; + +which declares the variable leaf. + + Once declared, enumerated type variables and constants may be used anywhere +an integer would be legal. They may be assigned: + + leaf = green; + +compared: + + if (leaf == green) ... + +or passed as parameters to functions. + + Internally, the values of an Enumerated Data Type are represented as small +integers starting with zero and assigned in the order that the possible values +of the type are listed in the declaration. If such a value is output to a file +or the terminal it will be printed as an integer, rather than with its name. + +Enumerated data values may be compared using the normal relational operators +(<, >, etc.) for integers. + + While all Enumerated Data Types are represented internally as integer values, +each is considered to be a seperate type. It is a mistake to attempt to assign +an integer or member of another Enumerated Type to an Enumerated Data Type +variable. Such actions will draw a warning message from the compiler. If one +wishes to intentionally do this, use of the type cast operation is needed. + +3. Structure Assignment + Structure data objects may now be assigned to one another, passed as +parameters to functions, and returned as values from functions. The syntax of +such operations is exactly that of operations involving scalar data types. For +example: + + struct foo { + int a; + char *b; + } x, y, foogen(); + +declares two variables of type struct foo, and a function returning such a +type. We may now write: + + x = foogen(); + y = x; + +just as we could if x and y were of type int. Additionally, we could write: + + int funct(a,b) + struct foo a,b; + { + ... + body of function + ... + } + +to declare a function which accepts objects of type struct foo as arguments. + + Structures, like scalar types, are assigned, passed as parameters, and +returned by value. Thus a function receiving a structure as an argument will +receive it's own copy of the structure, while an assignment statement or +function returning a structure value will copy the appropriate data into the +receiving variable. Obviously such copying actions require more time than a +simple passing of pointers. In the TOPS-20 compiler these operations are +implemented by use of the hardware BLT (BLock Transfer) instruction, resulting +in only a small time penalty. + + Attempting to assign an object of one structure type to a variable of another +structure type will draw a compiler warning. Such an assignment may be +performed without warnings using the type cast operator, but it is the +responsibility of the programmer to insure that the object being assigned will +fit in it's destination space without overwriting other data. diff --git a/c20/new/doc/install.doc b/c20/new/doc/install.doc new file mode 100644 index 00000000..4e532f37 --- /dev/null +++ b/c20/new/doc/install.doc @@ -0,0 +1,84 @@ +INSTALLATION OF THE C COMPILER: + +Installation assuming you can build the C compiler some directories +of its own: + + Build a directory (or some such, the name doesn't matter). + This directory doesn't need to be on PS:. It will need either + 550 or 950 pages, depending on whether you will keep the + compiler sources on line. + + Build a subdirectory of the above ( usually, again it + doesn't really matter). Give this directory 300 pages. (this + will reduce the directory to 250 or 650 pages). + + If you wish to keep the sources on line, build another subdirectory + of . Call it whatever you want, we don't care. Give it 400 + pages. (Now is down to 250 pages no matter what.) + + Define a system-wide logical name C: pointing to the top-level + directory you created above. (System-wide logical names are + defined in the N-CONFIG.CMD file. You will have to be/get + an OPERATOR or WHEEL to do this.) Define another system-wide logical + name CLIB: pointing to the first subdirectory. THESE NAMES ARE BUILT + INTO THE COMPILER. If you cannot make these definitions, you have + two choices. Either have people who wish to use C make these + definitions on a job-wide basis, or get in touch with us regarding + the changes necessary to the compiler. + + You're almost there! Mount the tape and restore the files from + it as described below. + +Installation if you cannot build the C compiler some directories of its +own. + + This is absurd. Go back and hammer on whoever said it couldn't + have its own directories. If you can't win, go on to the next + instruction. + + Figure out where everything is going to live. Get this directory + logically defined as C: and CLIB:. See the section on system- + wide logical definitions, above. + + Mount the tape and restore the files as described below. + +TAPE FILES + +This tape contains five save sets, in order as follows: + +DOC FILES - Documentation for the compiler. Presumably you have + already put this somewhere, since you are reading this. + It probably should live in C: + +SYS: FILES - This includes the newest version of the MIDAS assembler + and CC.EXE, the top-level control program. These + files should be placed somewhere in the SYS: search + path, probably or . If you already + have MIDAS, you now have a newer one. Note that a special + stripped-down version of MIDAS called CASM is used for + assembling the output of the compiler, you need MIDAS + only to reassemble the assembly-code library files. + +C: FILES - These files go in the directory you defined as C: + +INCLUDE FILES - These files contain standard definitions and are often + #include'd by other programs. They should be placed + in the C: search path. + +CLIB: FILES These files go in the directory you defined as CLIB: + +SOURCE FILES Compiler sources, if you want to keep them on-line. + Remember, however, that this compiler is covered + by license agreements with the Western Electric + Company, and both us and them will get truely annoyed + if this code is distributed to another site, with or + without your cooperation. Keep these sources protected! + +All done? OK, read CC.hlp to figure out how to run the compiler. +Now, there is a program TESTC.C in C: which, when compiled and run, +will perform a quick and semi-complete test of C. Try it out. Good Luck! + + +If you wish to be informed of bug fixes and future developments regarding +this compiler, please send the net-address of the appropriate person +to JTW@MIT-MC. diff --git a/c20/new/doc/int.doc b/c20/new/doc/int.doc new file mode 100644 index 00000000..35c848fa --- /dev/null +++ b/c20/new/doc/int.doc @@ -0,0 +1,98 @@ +This file documents C language support for the TOPS-20 PSI +(pseudo-interrupt) system. + +TOPS-20 supports two conceptually different types of software +interrupts; system interrupts and user interrupts. System interrupts +are very much like UNIX signals, occurring whenever an error or +unexpected event happens during the execution of a program. User +interrupts occur due to actions initiated by the user, such as typing +a particular character on the job's controlling terminal. + +The following functions are currently provided for interrupt support. +These functions are auto-loaded with the standard I/O package. Programs +which use these functions should have the line + +# include + +somewhere near the beginning. + +*Warning* This documentation is currently quite minimal. It will be + more than helpful to have a basic understanding of TOPS-20 + software interrupts before trying to use these functions. + This understanding can be gained by reading the relevant + sections of the TOPS-20 Monitor Calls Users Manual. + +*Note* all enabled interrupts (except stack overflow, which is + handled specially by the runtime package) are currently + at level 3. This means you cannot interrupt an interrupt + routine... + + +iset(chan,proc) This function is used to associate a particular + action with a particular interrupt channel. + + may be a system interrupt channel or a user + interrupt channel. The file c:int.h defines the + available system interrupt channels and their + functions. The function ialloc, described below, + may be used to obtain the next available user + interrupt channel. + + may be one of INT_DEFAULT, INT_IGNORE, or + the name of a C procedure to execute when the + interrupt occurs. Calling iset with INT_DEFAULT + is equivalent to turning the interrupt channel off. + This will generally result in the interrupt being + ignored. Program execution will be terminated on + the occurrence of a "panic" interrupt. (See the + TOPS-20 Monitor Calls Users Manual for more on + panic interrupts.) Calling iset with INT_IGNORE + turns the interrupt channel on and connects it to + a service routine which does nothing. Thus the + interrupt will always be ignored. Calling iset + with a function name causes that function to be used + as the interrupt service routine for the given + interrupt channel. + +onchar(char,proc) Enables the given character as an interrupt + character and causes the given procedure to + be executed when this character is typed. Returns + the user interrupt channel connected to the + character, or -1 on failure. + + As in iset, above, the may be one of INT_DEFAULT, + INT_IGNORE, or a C procedure name. may be + any of the legal TOPS-20 terminal interrupt + characters, as follows: + + '\000' - '\032' - The corresponding ascii "control + character". + + '\033' - The ascii "escape" character. + + '\034' - The ascii "rubout" character, + really '\177' + + '\035' - The ascii "space" character. + + '\036' - Loss of dataset carrier on a + remote line. + + '\037' - Any typein + + '\040' - Any typeout + + More information on terminal interrupt characters + may be found in the Monitor Calls Reference Manual. + +ialloc() returns the next available user interrupt channel, + or 0 if there aren't any more. Can be used to + request a user interrupt channel from the system for + a non-standard use. + +ifree(chan) Turns the given user interrupt channel off and + returns it to the pool managed by ialloc. + + +That's all for now. More and better support functions will be provided +as time goes on... Thoughts to JTW@MIT-AI. diff --git a/c20/new/doc/jsys.doc b/c20/new/doc/jsys.doc new file mode 100644 index 00000000..9d0f8a43 --- /dev/null +++ b/c20/new/doc/jsys.doc @@ -0,0 +1,68 @@ +System Interface (JSYS Calls) + +Arbitrary monitor functions (JSYS Calls) may be performed from a +TOPS-20 C program through the use of the _jsys function. If you use +this function, you should have + +# include + +near the beginning of your file. + +The _jsys function is invoked as follows: + +_jsys(num, acp); + +The first argument num is the number of the desired jsys. These are +#defined mnemonically in jsys.h, so you can just place the jsys name +(in caps) here. The second argument is a pointer to an object of type +acblk, defined in jsys.h. This object is a structure containing four +elements t1, t2, t3, and t4. The contents of these elements will be +copied into AC's 1 - 4 before the specified JSYS is executed. + +_jsys returns 0 if the JSYS was successful, or the resulting system +error number if the call was unsuccessful. Additionally, the elements +of the acblk structure pointed to by acp will be set to the value of +AC's 1 - 4 after the JSYS call, whether or not an error occurred. Note +that erjmp is used to detect JSYS errors, so that any element of the +acblk which would normally contain an error code may be invalid on an +error return. Always use the value returned by _jsys to obtain the +error code. + +Auxiliary Functions + +The function _erstr can be used to translate an error number returned +by _jsys (or obtained from anywhere else, for that matter) into the +corresponding system error message. The function is called as follows: + +_erstr(error, buf, size) + +error is the system error number, buf is a pointer to a character +array in which the error string is to be written, and size is the +maximum allowable length of the error message string. + +Example + +The following simple program executes the GTRPI system call to obtain +pager information for itself and prints the results on the standard +output. If an error occurs during the system call, the applicable +error message is also printed. + +#include +#include + +acblk foo; + +main() +{ + acblk *ap = &foo; + int res; + char buf[100]; + + ap->t1 = 0400000; /* process handle for ourself */ + res = _jsys(GTRPI,ap); + printf("%o,%o,%o\n", ap->t1,ap->t2,ap->t3); + if (res) { + _erstr(res,buf,100); + printf(buf); + } +} diff --git a/c20/new/doc/stinkr.doc b/c20/new/doc/stinkr.doc new file mode 100644 index 00000000..a3ff3c51 --- /dev/null +++ b/c20/new/doc/stinkr.doc @@ -0,0 +1,63 @@ +----- STINKR.DOC ----- 20 April 1977 ----- AS@DM ----- + + +-- JCL Format -- + +JCL to STINKR is optional. If present, it should consist of a +sequence of arguments separated by spaces. An argument can be +an option string or a file name. An option string has the form +-abc, where a, b, and c are option names. The existing options are: + + s - print symbol table + p - print description of RELOCATABLE files loaded + d - print additional STINKR debugging info + +A file name is either loaded or xfiled, depending upon its format. +If no file extension is given, it is assumed to be .STINKR. +Patterns using * (matches any sequence of characters) and ? (matches +any single character) can be given. If no file names are specified, +command input is taken from the terminal. + +-- Command Format -- + +STINKR takes commands from files or the terminal in a manner similar +to STINK. A command consists of a single line, beginning with the +command name, optionally followed by arguments. The commands are: + + s ,,,... define segments (see below) + l load file + x execute command file + i specify initialization routine + o specify output file name + ; a comment + +Blank command lines are ignored. + +The basic operation of STINKR is to read all of the commands, loading +specified files and remembering the other information. When the +basic command file is finished (or ^Z is typed, if terminal input), +STINKR then does the following: + + a) print list of undefined symbols, if any + b) print segment map + c) print symbol table, if desired (-s option) + d) call initialization routine, if any + e) PDUMP to output file, if any + +-- Segments -- + +In order to use multiple segments, one must use the macros in the +file C:MULSEG.MID while assembling. If more than one segment +is to be used, the s command must be given, before any files are +loaded. The arguments to the s command are a list of OCTAL +addresses, which specify the origins of all of the segments, +starting with segment 0. Instead of giving a particular origin, +one may also specify either N (next location) or P (next page); +in order for these to work, the MULSEG macros MUST be used. + +-- Initialization Routine -- + +One may specify an initialization routine to be run immediately +before PDUMPing. This routine could, for example, purify read-only +segments. When invoked, locations 20 to 20+N-1 will contain the +FIRST,,LAST locations of the N segments. diff --git a/c20/new/file.cmd b/c20/new/file.cmd new file mode 100644 index 00000000..b9374d29 --- /dev/null +++ b/c20/new/file.cmd @@ -0,0 +1 @@ +c20run,c20fnm,c20io,c20pip,c20lib,c20sys,c20tty,c20int,c20mem,c20ati,c20blt,c20prt,c20fpr,c20scn,c20str,c20typ diff --git a/c20/new/include/ctype.h b/c20/new/include/ctype.h new file mode 100644 index 00000000..437566d9 --- /dev/null +++ b/c20/new/include/ctype.h @@ -0,0 +1,24 @@ +#define _U 01 +#define _L 02 +#define _N 04 +#define _S 010 +#define _P 020 +#define _C 040 +#define _X 0100 + +extern char _ctype_[]; + +#define isalpha(c) ((_ctype_)[c]&(_U|_L)) +#define isupper(c) ((_ctype_)[c]&_U) +#define islower(c) ((_ctype_)[c]&_L) +#define isdigit(c) ((_ctype_)[c]&_N) +#define isxdigit(c) ((_ctype_)[c]&(_N|_X)) +#define isspace(c) ((_ctype_)[c]&_S) +#define ispunct(c) ((_ctype_)[c]&_P) +#define isalnum(c) ((_ctype_)[c]&(_U|_L|_N)) +#define isprint(c) ((_ctype_)[c]&(_P|_U|_L|_N)) +#define iscntrl(c) ((_ctype_)[c]&_C) +#define isascii(c) ((unsigned)(c)<=0177) +#define toupper(c) ((c)-'a'+'A') +#define tolower(c) ((c)-'A'+'a') +#define toascii(c) ((c)&0177) diff --git a/c20/new/include/int.h b/c20/new/include/int.h new file mode 100644 index 00000000..b28edb11 --- /dev/null +++ b/c20/new/include/int.h @@ -0,0 +1,21 @@ +/* - int.h - header file for C interrupt system */ + +# define INT_DEFAULT 0 +# define INT_IGNORE 1 + +/* 1-5, 23-35 are user assignable */ + +# define INT_AOV 6 /* arithmetic overflow */ +# define INT_FOV 7 /* floating point overflow */ +# define INT_EOF 10 /* end of file */ +# define INT_DAE 11 /* data error */ +# define INT_QTA 12 /* quota exceeded or disk full */ +# define INT_ILI 15 /* illegal instruction */ +# define INT_IRD 16 /* illegal memory read */ +# define INT_IWR 17 /* illegal memory write */ +# define INT_IFT 19 /* inferior process termination */ +# define INT_MSE 20 /* system resources exhausted */ +# define INT_NXP 22 /* non-existent page */ + + + diff --git a/c20/new/include/jsys.h b/c20/new/include/jsys.h new file mode 100644 index 00000000..66020675 --- /dev/null +++ b/c20/new/include/jsys.h @@ -0,0 +1,332 @@ +/* Header file for JSYS system call function */ + +typedef struct { + int t1; + int t2; + int t3; + int t4; + } acblk; + +/* Jsys definitions, these are from the MIT monsym circa early 1982 */ + +# define LOGIN 01 +# define CRJOB 02 +# define LGOUT 03 +# define CACCT 04 +# define EFACT 05 +# define SMON 06 +# define TMON 07 +# define GETAB 010 +# define ERSTR 011 +# define GETER 012 +# define GJINF 013 +# define TIME 014 +# define RUNTM 015 +# define SYSGT 016 +# define GNJFN 017 +# define GTJFN 020 +# define OPENF 021 +# define CLOSF 022 +# define RLJFN 023 +# define GTSTS 024 +# define STSTS 025 +# define DELF 026 +# define SFPTR 027 +# define JFNS 030 +# define FFFFP 031 +# define RDDIR 032 +# define CPRTF 033 +# define CLZFF 034 +# define RNAMF 035 +# define SIZEF 036 +# define GACTF 037 +# define STDIR 040 +# define DIRST 041 +# define BKJFN 042 +# define RFPTR 043 +# define CNDIR 044 +# define RFBSZ 045 +# define SFBSZ 046 +# define SWJFN 047 +# define BIN 050 +# define BOUT 051 +# define SIN 052 +# define SOUT 053 +# define RIN 054 +# define ROUT 055 +# define PMAP 056 +# define RPACS 057 +# define SPACS 060 +# define RMAP 061 +# define SACTF 062 +# define GTFDB 063 +# define CHFDB 064 +# define DUMPI 065 +# define DUMPO 066 +# define DELDF 067 +# define ASND 070 +# define RELD 071 +# define CSYNO 072 +# define PBIN 073 +# define PBOUT 074 +# define PSIN 075 +# define PSOUT 076 +# define MTOPR 077 +# define CFIBF 0100 +# define CFOBF 0101 +# define SIBE 0102 +# define SOBE 0103 +# define DOBE 0104 +# define GTABS 0105 +# define STABS 0106 +# define RFMOD 0107 +# define SFMOD 0110 +# define RFPOS 0111 +# define RFCOC 0112 +# define SFCOC 0113 +# define STI 0114 +# define DTACH 0115 +# define ATACH 0116 +# define DVCHR 0117 +# define STDEV 0120 +# define DEVST 0121 +# define MOUNT 0122 +# define DSMNT 0123 +# define INIDR 0124 +# define SIR 0125 +# define EIR 0126 +# define SKPIR 0127 +# define DIR 0130 +# define AIC 0131 +# define IIC 0132 +# define DIC 0133 +# define RCM 0134 +# define RWM 0135 +# define DEBRK 0136 +# define ATI 0137 +# define DTI 0140 +# define CIS 0141 +# define SIRCM 0142 +# define RIRCM 0143 +# define RIR 0144 +# define GDSTS 0145 +# define SDSTS 0146 +# define RESET 0147 +# define RPCAP 0150 +# define EPCAP 0151 +# define CFORK 0152 +# define KFORK 0153 +# define FFORK 0154 +# define RFORK 0155 +# define RFSTS 0156 +# define SFORK 0157 +# define SFACS 0160 +# define RFACS 0161 +# define HFORK 0162 +# define WFORK 0163 +# define GFRKH 0164 +# define RFRKH 0165 +# define GFRKS 0166 +# define DISMS 0167 +# define HALTF 0170 +# define GTRPW 0171 +# define GTRPI 0172 +# define RTIW 0173 +# define STIW 0174 +# define SOBF 0175 +# define RWSET 0176 +# define GETNM 0177 +# define GET 0200 +# define SFRKV 0201 +# define SAVE 0202 +# define SSAVE 0203 +# define SEVEC 0204 +# define GEVEC 0205 +# define GPJFN 0206 +# define SPJFN 0207 +# define SETNM 0210 +# define FFUFP 0211 +# define DIBE 0212 +# define FDFRE 0213 +# define GDSKC 0214 +# define LITES 0215 +# define TLINK 0216 +# define STPAR 0217 +# define ODTIM 0220 +# define IDTIM 0221 +# define ODCNV 0222 +# define IDCNV 0223 +# define NOUT 0224 +# define NIN 0225 +# define STAD 0226 +# define GTAD 0227 +# define ODTNC 0230 +# define IDTNC 0231 +# define FLIN 0232 +# define FLOUT 0233 +# define DFIN 0234 +# define DFOUT 0235 + +# define CRDIR 0240 +# define GTDIR 0241 +# define DSKOP 0242 +# define SPRIW 0243 +# define DSKAS 0244 +# define SJPRI 0245 +# define STO 0246 +# define ARCF 0247 +# define ASNDP 0260 +# define RELDP 0261 +# define ASNDC 0262 +# define RELDC 0263 +# define STRDP 0264 +# define STPDP 0265 +# define STSDP 0266 +# define RDSDP 0267 +# define WATDP 0270 + +# define GTNCP 0272 +# define GTHST 0273 +# define ATNVT 0274 +# define CVSKT 0275 +# define CVHST 0276 +# define FLHST 0277 + +# define GCVEC 0300 +# define SCVEC 0301 +# define STTYP 0302 +# define GTTYP 0303 +# define BPT 0304 +# define GTDAL 0305 +# define WAIT 0306 +# define HSYS 0307 +# define USRIO 0310 +# define PEEK 0311 +# define MSFRK 0312 +# define ESOUT 0313 +# define SPLFK 0314 +# define ADVIS 0315 +# define JOBTM 0316 +# define DELNF 0317 +# define SWTCH 0320 +# define TFORK 0321 +# define RTFRK 0322 +# define UTFRK 0323 +# define SCTTY 0324 + +# define OPRFN 0326 + +# define SETER 0336 + +/* NEW (NOT IN BBN TENEX) JSYS'S ADDED STARTING AT 500 */ + +# define RSCAN 0500 +# define HPTIM 0501 +# define CRLNM 0502 +# define INLNM 0503 +# define LNMST 0504 +# define RDTXT 0505 +# define SETSN 0506 +# define GETJI 0507 +# define MSEND 0510 +# define MRECV 0511 +# define MUTIL 0512 +# define ENQ 0513 +# define DEQ 0514 +# define ENQC 0515 +# define SNOOP 0516 +# define SPOOL 0517 +# define ALLOC 0520 +# define CHKAC 0521 +# define TIMER 0522 +# define RDTTY 0523 +# define TEXTI 0524 +# define UFPGS 0525 +# define SFPOS 0526 +# define SYERR 0527 +# define DIAG 0530 +# define SINR 0531 +# define SOUTR 0532 +# define RFTAD 0533 +# define SFTAD 0534 +# define TBDEL 0535 +# define TBADD 0536 +# define TBLUK 0537 +# define STCMP 0540 +# define SETJB 0541 +# define GDVEC 0542 +# define SDVEC 0543 +# define COMND 0544 +# define PRARG 0545 +# define GACCT 0546 +# define LPINI 0547 +# define GFUST 0550 +# define SFUST 0551 +# define ACCES 0552 +# define RCDIR 0553 +# define RCUSR 0554 +# define MSTR 0555 +# define STPPN 0556 +# define PPNST 0557 +# define PMCTL 0560 +# define PLOCK 0561 +# define BOOT 0562 +# define UTEST 0563 +# define USAGE 0564 +# define WILD 0565 +# define VACCT 0566 +# define NODE 0567 +# define ADBRK 0570 +# define SINM 0571 +# define SOUTM 0572 +# define SWTRP 0573 +# define GETOK 0574 +# define RCVOK 0575 +# define GIVOK 0576 +# define SKED 0577 +# define MTU 0600 +# define XRIR 0601 +# define XSIR 0602 + +# define GTBLT 0634 +# define VTSOP 0635 +# define RTMOD 0636 +# define STMOD 0637 +# define RTCHR 0640 +# define STCHR 0641 +# define RTGRV 0642 +# define STGRV 0643 +# define DBGIM 0677 + +/* TEMPORARY JSYS DEFINITIONS */ + +# define SEND 0740 +# define RECV 0741 +# define OPEN 0742 +# define CLOSE 0743 +# define SCSLV 0744 +# define STAT 0745 +# define CHANL 0746 +# define ABORT 0747 + +/* MORE TEMPORARY JSYS DEFINITIONS */ + +# define SNDIM 0750 +# define RCVIM 0751 +# define ASNSQ 0752 +# define RELSQ 0753 + +# define SNDIN 0754 +# define RCVIN 0755 +# define ASNIQ 0756 +# define RELIQ 0757 + +# define METER 0766 +# define SMAP 0767 +# define THIBR 0770 +# define TWAKE 0771 +# define MRPAC 0772 +# define SETPV 0773 +# define MTALN 0774 +# define TTMSG 0775 +# define MDDT 0777 diff --git a/c20/new/include/setjmp.h b/c20/new/include/setjmp.h new file mode 100644 index 00000000..02897055 --- /dev/null +++ b/c20/new/include/setjmp.h @@ -0,0 +1,7 @@ +/* SETJMP.H for DECsystem-20 C */ + +typedef int jump_buf [3]; + +/* jump_buf[0] is return address for setjmp call */ +/* jump_buf[1] is sp just before setjmp call */ +/* jump_buf[2] is fp just before setjmp call */ diff --git a/c20/new/include/stdio.h b/c20/new/include/stdio.h new file mode 100644 index 00000000..4e9eded2 --- /dev/null +++ b/c20/new/include/stdio.h @@ -0,0 +1,52 @@ +/* STDIO.H for TOPS-20 implementation */ + +/* The I/O drivers are in the file CLIB:C20IO.C */ + +typedef struct _file { + int jfn; /* JFN */ + struct _file *next; /* next file block in FILELIST */ + int ftype; /* file type (see C20IO) */ + int direction; /* I/O direction */ + int bsize; /* byte size */ + int bptr; /* byte pointer into buffer */ + int devtype; /* for optimization in istty */ + int bcnt; /* number positions free/avail */ + int eof; /* end-of-file flag (never reset) */ + int *buf; /* buffer */ + int *ubuf; /* unget buffer */ + int ucnt; /* unget count */ + } FILE; + +# define BUFSIZ 512 /* this number is irrelevant */ +# define NULL 0 /* null file pointer for error return */ +# define EOF (-1) /* returned on end of file */ + +typedef struct { /* used for date and time conversions */ + int year; + int month; + int day; + int hour; + int minute; + int second; + } cal; + +extern FILE *stdin,*stdout,*stderr; + +extern FILE *fopen(), *freopen(); +extern long int ftell(); +extern int getc(), fgetc(), peekc(), pkchar(), putc(), fputc(); +extern char *gets(), *fgets(), *ftoa(), *getpw(), *ctime(); +extern int exit(), _exit(); +extern int *malloc(), *realloc(); +extern char *calloc(); +extern double atof(); + + +# define getchar() getc(stdin) +# define putchar(c) putc((c),(stdout)) +# define fgetc(c) getc(c) +# define fputc(c,f) putc((c),(f)) +# define halves(l,r) (((l) << 18) | ((r) & 0777777)) + +#rename strncpy "STRNCP" +#rename strncmp "STRNCM" diff --git a/c20/new/lib/ac.c b/c20/new/lib/ac.c new file mode 100644 index 00000000..9bd1a51e --- /dev/null +++ b/c20/new/lib/ac.c @@ -0,0 +1,289 @@ +# include + +/* requires STRING.C to be loaded also */ +/* + + AC - Array of Characters Cluster + + operations: + + ac_new () => ac create empty array + ac_alloc (size) => ac create empty array, preferred size + ac_create (string) => ac create with initial value + ac_xh (ac, c) => c extend array with character + ac_trim (ac) => ac trim excess storage + ac_fetch (ac, i) => c fetch character from array + ac_link (ac) => ac make new link to array + ac_unlink (ac) remove link to array + ac_puts (ac, f) print array + ac_cat (ac, ac) => ac concatenate arrays + ac_copy (ac) => ac copy array + ac_unlink_string (ac) => ac remove link to string version + ac_string (ac) => *char return string version + ac_size (ac) => size return current size of array + ac_flush (ac) make array empty + ac_n () => int return # of active arrays + +*/ + +struct rep { + int count; /* reference count */ + char *s; /* pointer to actual array */ + int csize; /* logical size of array */ + int msize; /* physical size of array (at least csize+1) */ + }; + +# define ac struct rep* /* watch usage! */ +# define ASIZE 4 /* number of words in rep */ +# define initial_size 8 /* default initial allocation */ + +# define ac_unlink_string acunlstr + +ac ac_new(); +ac ac_alloc(); +ac ac_create(); +ac ac_link(); +ac ac_cat(); +ac ac_copy(); + +static int count; + +/********************************************************************** + + AC_NEW - Create empty array. + AC_ALLOC - Create empty array, preferred size given. + +**********************************************************************/ + +ac ac_new () + + {return (ac_alloc (initial_size));} + +ac ac_alloc (sz) +register int sz; +{ + register ac a; + + if (sz < 0) sz = 0; + a = malloc (ASIZE); + a->count = 1; + a->csize = 0; + a->s = calloc (1,a->msize = ++sz); + ++count; + return (a); +} + +/********************************************************************** + + AC_CREATE - Create array with initial value. + +**********************************************************************/ + +ac ac_create (s) +register char *s; +{ + register int sz; + register ac a; + + sz = strlen (s); + a = ac_alloc (sz); + a->csize = sz; + cmove (s, a->s, sz); + return (a); +} + +/********************************************************************** + + AC_XH - Extend Array with Character. + +**********************************************************************/ + +char ac_xh (a, c) +register ac a; +{ + if (a->csize >= a->msize - 1) { + if (a->s) { + if (a->msize >= 1000) a->msize += 500; + else a->msize *= 2; + a->s = realloc (a->s, a->msize); + } + else a->s = calloc (1,a->msize *= 2); + } + a->s[a->csize++] = c; + return (c); +} + +/********************************************************************** + + AC_TRIM - Discard excess storage. + +**********************************************************************/ + +ac ac_trim (a) +register ac a; +{ + if (a->csize < a->msize - 1) + a->s = realloc (a->s, a->msize = a->csize + 1); + return (a); +} + +/********************************************************************** + + AC_FETCH - Fetch Character from Array. + +**********************************************************************/ + +char ac_fetch (a, n) +register ac a; +register int n; +{ + if (n < 0 || n >= a->csize) { + fprintf (stderr, "Character array bounds error."); + return (0); + } + return (a->s[n]); +} + +/********************************************************************** + + AC_LINK - Create link to array. + +**********************************************************************/ + +ac ac_link (a) +ac a; +{ + ++a->count; + return (a); +} + +/********************************************************************** + + AC_UNLINK - Remove link to array. + +**********************************************************************/ + +ac_unlink (a) +register ac a; +{ + if (--a->count == 0) { + if (a->s) free (a->s); + --count; + free (a); + } +} + +/********************************************************************** + + AC_PUTS - Print array. + +**********************************************************************/ + +ac_puts (a, f, wid) +register ac a; +{ + register char *p; + register int i; + + p = a->s; + i = a->csize; + while (--i >= 0) putc (*p++, f); +} + +/********************************************************************** + + AC_CAT - Concatenate arrays. + +**********************************************************************/ + +ac ac_cat (a1, a2) +register ac a1; +register ac a2; +{ + register ac a; + register int i; + + a = ac_alloc (i = a1->csize + a2->csize); + a->csize = i; + cmove (a1->s, a->s, a1->csize); + cmove (a2->s, a->s + a1->csize, a2->csize); + return (a); +} + +/********************************************************************** + + AC_COPY - Copy array. + +**********************************************************************/ + +ac ac_copy (a1) +register ac a1; + + register ac a; + + a = ac_alloc (a1->csize); + cmove (a1->s, a->s, a->csize = a1->csize); + return (a); +} + +/********************************************************************** + + AC_STRING - Return string version of array. The returned + string is valid only while the array remains linked + to and unchanged. + +**********************************************************************/ + +char *ac_string (a) +register ac a; +{ + a->s[a->csize] = 0; + return (a->s); +} + +/********************************************************************** + + AC_UNLINK_STRING - Remove link to string version of array. + +**********************************************************************/ + +ac ac_unlink_string (a) +ac a; +{ + return (a); +} + +/********************************************************************** + + AC_SIZE - Return current size of array. + +**********************************************************************/ + +int ac_size (a) +ac a; +{ + return (a->csize); +} + +/********************************************************************** + + AC_FLUSH - Make array empty + +**********************************************************************/ + +ac_flush (a) +ac a; +{ + a->csize = 0; +} + +/********************************************************************** + + AC_N - Return number of active arrays. + +**********************************************************************/ + +int ac_n () +{ + return (count); +} diff --git a/c20/new/lib/c20ati.c b/c20/new/lib/c20ati.c new file mode 100644 index 00000000..5f04155f --- /dev/null +++ b/c20/new/lib/c20ati.c @@ -0,0 +1,69 @@ +# rename eprint "EPRINT" +# rename fprint "FPRINT" +/********************************************************************** + + ATOI - Convert String to Integer + +**********************************************************************/ + +int atoi (s) + register char *s; + + {register int i, f, c; + + if (s == 0) return (0); + i = 0; + f = 1; + while (*s == '-') + {++s; + f = -f; + } + while ((c = *s++) >= '0' && c <= '9') i = i * 10 + c - '0'; + if (i < 0) + {i = -i; /* treat - specially */ + if (i < 0) return (f > 0 ? -(i + 1) : i); + } + return (f > 0 ? i : -i); + } + +/********************************************************************** + + ITOA - Convert Integer to String + + (Returns a pointer to the null character appended to the end.) + +**********************************************************************/ + +char *itoa (n, s) + register char *s; + + {register int a; + if (n < 0) + {*s++ = '-'; + n = -n; + if (n < 0) n = 0; + } + if (a = (n / 10)) s = itoa (a, s); + *s++ = '0' + n % 10; + *s = 0; + return (s); + } + +/********************************************************************** + + FTOA - Convert float to string + +**********************************************************************/ + +int ftoa (d, s, p, f) + double d; + char *s, f; + int p; + + {register int outs, cnt; + outs = fopen (s, "ws"); + if (f == 'f' || f == 'F') cnt = fprint (d, outs, p); + else cnt = eprint (d, outs, p); + fclose (outs); + return (cnt); + } diff --git a/c20/new/lib/c20blt.cmid b/c20/new/lib/c20blt.cmid new file mode 100644 index 00000000..ea680e6e --- /dev/null +++ b/c20/new/lib/c20blt.cmid @@ -0,0 +1,19 @@ +; +; blt +; +; this file is pdp-10 dependent, system-independent. +; + +title blt +.insrt c:minsrt + +centry blt,[from,to,num] + + hrrz a,to + hrrzi b,-1(a) + add b,num + hrl a,from + blt a,(b) + return + +end diff --git a/c20/new/lib/c20flt.cmid b/c20/new/lib/c20flt.cmid new file mode 100644 index 00000000..e45b4601 --- /dev/null +++ b/c20/new/lib/c20flt.cmid @@ -0,0 +1,212 @@ +; +; cfloat - floating point arithmetic functions +; +; this file is pdp-10 dependent, system-independent. +; + +title cfloat +.insrt c:minsrt + +; contains: log, exp, cos, sin, atan, sqrt, dtruncate, dround, dabs + +centry log,[v] + + move b,v + 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,sqrt2 + fadr b,sqrt2 + 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 + move a,b + return + +centry exp,[v] + + move b,v +; push p,b ; don't play with stack !!! + 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] + caie a,0 + 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 + skipl v ; just use arg value !!! + skipn b,d + fdvr b,d + move a,b + return + +expr2: ldb d,[030300,,b] + andi b,7 + move d,floap1(d) + 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 + +outrng: croak [argument out of range] + jrst rtn1 + +centry cos,[v] + + move b,v + fadr b,[1.570796326] ;cos(x)=sin (x+pi/2) + ccall sin,[b] +rtn1: return + +centry sin,[v] + + move b,v + pushj p,.sin + return + +.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, + +centry sqrt,[v] + + move b,v + ;; added 3/8/83 RCA + setz a ; return 0 if v <= 0 + jumple b,sq3 + ;; + 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 + move a,b +sq3: return + +centry atan,[v],[temp] + + move b,v + movem b,temp + 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 temp ;was input negative? + movns b ;yes,complement +atan3: move a,b + return + +sqrt2: 1.41421356 +pi2: 1.57079632675 ; bogus pi2: 3.1415926535/2.0 + +centry dround,[v] + + movm a,v + fadr a,[.499999] + fix a,a + skipge v + movn a,a + return + +centry dtruncate,[v] + + fix a,v + return + +centry dabs,[v] + + move a,v + jumpge a,ret + movn a,a + jumpge a,ret + tlz a,400000 +ret: return + +end diff --git a/c20/new/lib/c20fnm.c b/c20/new/lib/c20fnm.c new file mode 100644 index 00000000..d305d1b9 --- /dev/null +++ b/c20/new/lib/c20fnm.c @@ -0,0 +1,336 @@ +/********************************************************************** + + TOPS-20 filename stuff + + components: + DEV:NAME.TYP.GEN;ATTR + All components manipulated without punctuation, + except ATTR. + Also accepts UNIX format: + /DEV/DIR1/DIR2/.../DIRn/NAME.TYP.GEN;ATTR + as equivalent to: + DEV:NAME.TYP.GEN;ATTR + +Routines: + + fnparse - parse file name into components + + fngxxx - extract a given component (xxx = dev, dir, ...) + + fncons - make a complete filename from components + + fnsdf - given an old file name and a set of default + components, make a new file name using the + components as defaults for any components + unspecified by the old name + + fnsfd - make a new file name given an old file name and + a set of components. Nonzero arguments specify + components; the corresponding components of the + old file name will be changed in the new file name. + + fnstd - Convert an input string into standard TOPS-20 + filename format + + +**********************************************************************/ + + + +# define FNSIZE 100 +# define QUOTE 022 /* ^V */ +# define TRUE 1 +# define FALSE 0 + +static char *fnscan(), *fnsmove(); /* forward decls */ + +/********************************************************************** + + FNPARSE - Parse file name into components. + +**********************************************************************/ + +fnparse (old, dv, dir, nm, typ, gen, attr) + register char *old; + char *dv, *dir, *nm, *typ, *gen, *attr; + + {register char *p, *q; + *dv = *dir = *nm = *typ = *gen = *attr = 0; + while (*old == ' ') ++old; + p = fnscan (old, ":<"); + if (*p == 0) /* must be OK in UNIX format */ + {if (*old == '/') /* get device part */ + {p = fnscan (++old, "/"); + fnsmove (old, p, dv); + if (*p == 0) return; + old = ++p; + } + q = dir; + while (TRUE) /* get dir parts */ + {p = fnscan (old, "/.;"); + if (*p != '/') break; + if (q != dir) *q++ = '.'; + fnsmove (old, p, q); + q += (p - old); + old = ++p; + } + fnsmove (old, p, nm); /* get name part */ + if (*p == 0) return; + if (*p == '.') + {old = ++p; /* get type part */ + p = fnscan (old, ".;"); + fnsmove (old, p, typ); + if (*p == 0) return; + } + if (*p == '.') + {old = ++p; /* get gen part */ + p = fnscan (old, ";"); + fnsmove (old, p, gen); + if (*p == 0) return; + } + fnsmove (p, 0, attr); /* get attr part */ + return; + } + + if (*old != '<') + {p = fnscan (old, ":"); + if (*p == ':') + {fnsmove (old, p, dv); + old = ++p; + } + } + if (*old == '<') + {p = fnscan (++old, ">"); + fnsmove (old, p, dir); + if (*p == 0) return; + old = ++p; + } + p = fnscan (old, ".;"); + fnsmove (old, p, nm); + old = p + 1; + if (*p == '.') + {p = fnscan (old, ".;"); + fnsmove (old, p, typ); + old = p + 1; + if (*p == '.') + {p = fnscan (old, ";"); + fnsmove (old, p, gen); + } + } + if (*p == ';') + fnsmove (p, 0, attr); + } + +/********************************************************************** + + FNGxx - Extrace a given component. + +**********************************************************************/ + +char *fngdv (old, buf) + char *old, *buf; + + {char temp[FNSIZE]; + fnparse (old, buf, temp, temp, temp, temp, temp); + return (buf); + } + +char *fngdr (old, buf) + char *old, *buf; + + {char temp[FNSIZE]; + fnparse (old, temp, buf, temp, temp, temp, temp); + return (buf); + } + +char *fngnm (old, buf) + char *old, *buf; + + {char temp[FNSIZE]; + fnparse (old, temp, temp, buf, temp, temp, temp); + return (buf); + } + +char *fngtp (old, buf) + char *old, *buf; + + {char temp[FNSIZE]; + fnparse (old, temp, temp, temp, buf, temp, temp); + return (buf); + } + +char *fnggn (old, buf) + char *old, *buf; + + {char temp[FNSIZE]; + fnparse (old, temp, temp, temp, temp, buf, temp); + return (buf); + } + +char *fngat (old, buf) + char *old, *buf; + + {char temp[FNSIZE]; + fnparse (old, temp, temp, temp, temp, temp, buf); + return (buf); + } + +/********************************************************************** + + FNCONS - Construct a file name from its components. + +**********************************************************************/ + +char *fncons (buf, dv, dir, nm, typ, gen, attr) + register char *buf; + char *dv, *dir, *nm, *typ, *gen, *attr; + + {if (dv && *dv) + {buf = fnsmove (dv, 0, buf); + *buf++ = ':'; + } + if (dir && *dir) + {*buf++ = '<'; + buf = fnsmove (dir, 0, buf); + *buf++ = '>'; + } + if (nm) buf = fnsmove (nm, 0, buf); + if (typ && *typ) + {*buf++ = '.'; + buf = fnsmove (typ, 0, buf); + } + if (gen && *gen) + {*buf++ = '.'; + buf = fnsmove (gen, 0, buf); + } + if (attr && *attr) + {if (*attr != ';') *buf++ = ';'; + fnsmove (attr, 0, buf); + } + return (buf); + } + +/********************************************************************** + + FNSDF - Make a new file name with specified defaults. + Nonzero arguments specify defaults; the corresponding + components will be set if they are null. + +**********************************************************************/ + +char *fnsdf (buf, old, dv, dir, nm, typ, gen, attr) + char *old, *buf, *dv, *dir, *nm, *typ, *gen, *attr; + + {char odv[FNSIZE], odir[FNSIZE], onm[FNSIZE], + otyp[FNSIZE], ogen[FNSIZE], oattr[FNSIZE]; + fnparse (old, odv, odir, onm, otyp, ogen, oattr); + if (dv && *odv == 0) fnsmove (dv, 0, odv); + if (dir && *odir == 0) fnsmove (dir, 0, odir); + if (nm && *onm == 0) fnsmove (nm, 0, onm); + if (typ && *otyp == 0) fnsmove (typ, 0, otyp); + if (gen && *ogen == 0) fnsmove (gen, 0, ogen); + if (attr && *oattr == 0) fnsmove (attr, 0, oattr); + fncons (buf, odv, odir, onm, otyp, ogen, oattr); + return (buf); + } + +/********************************************************************** + + FNSFD - Make a new file name with specified components. + Nonzero arguments specify components; the corresponding + components of the file name will be set. + +**********************************************************************/ + +char *fnsfd (buf, old, dv, dir, nm, typ, gen, attr) + char *old, *buf, *dv, *dir, *nm, *typ, *gen, *attr; + + {char odv[FNSIZE], odir[FNSIZE], onm[FNSIZE], + otyp[FNSIZE], ogen[FNSIZE], oattr[FNSIZE]; + fnparse (old, odv, odir, onm, otyp, ogen, oattr); + if (dv) fnsmove (dv, 0, odv); + if (dir) fnsmove (dir, 0, odir); + if (nm) fnsmove (nm, 0, onm); + if (typ) fnsmove (typ, 0, otyp); + if (gen) fnsmove (gen, 0, ogen); + if (attr) fnsmove (attr, 0, oattr); + fncons (buf, odv, odir, onm, otyp, ogen, oattr); + return (buf); + } + +/**************************************************************** + + FNSTD - standardize file name in TOPS-20 format + +****************************************************************/ + +fnstd (ins, outs) + char *ins, *outs; + + {char dev[40], dir[40], name[40], type[40], gen[10], attr[20]; + fnparse (ins, dev, dir, name, type, gen, attr); + fncons (outs, dev, dir, name, type, gen, attr); + } + +/* Internal procedures */ + +/* Scan starting from P for any character in M. Stops if an illegal + * character is encountered and returns a pointer to a null character. + */ + +static char *fnscan (p, m) + register char *p, *m; + + {while (TRUE) + {register int c; + register char *q; + if ((c = *p++) == QUOTE) + {c = *p++; + if (c == 0) return (--p); + continue; + } + if (!fnlegal (c)) return (""); + q = m; + while (*q) if (c == *q++) return (--p); + } + } + +/* + * Internal routine: FNSMOVE + * + * Move characters starting with *FIRST up to (but not + * including) *AFTER into *DEST. If AFTER is null, then + * move characters until a NUL byte is encountered. + * Always terminate the destination with a NUL byte + * and return a pointer to the terminating NUL. + * Stop on illegal characters, don't move them. + */ + + +static char *fnsmove (first, after, dest) + register char *first, *after, *dest; + + {register char c; + if (after && *after) + while (first < after) + if (fnlegal (c = *first++)) *dest++ = c; + else break; + else while (c = *first++) + if (fnlegal (c)) *dest++ = c; + else break; + *dest = 0; + return (dest); + } + +static char *legals = {"#%**-.0<>>AZ__az"}; + +static int fnlegal (c) + register char c; + + {register char *q; + q = legals; + while (*q) + if (c < *q++) break; + else if (c <= *q++) return (TRUE); + return (FALSE); + } diff --git a/c20/new/lib/c20fpr.c b/c20/new/lib/c20fpr.c new file mode 100644 index 00000000..3ea4d613 --- /dev/null +++ b/c20/new/lib/c20fpr.c @@ -0,0 +1,538 @@ +# include + +/********************************************************************** + + d = atof (s) parser + nchars = fprint (d, fd, prec) write d to fd with prec decimals + nchars = eprint (d, fd, prec) (same, but always xxxe+xx format) + + requires: + + putc (c, fd) + + internal routines and tables: + + exps, mants, hpmul, dextract, doround, eform, fform + + PDP10 dependent, system independent + + Note: special effort is applied to get exact conversions! + +**********************************************************************/ + +# rename eprint "EPRINT" +# rename fprint "FPRINT" +# rename hpmul "HPMUL" +# rename dextract "DEXTRACT" +# rename doround "DOROUND" +# rename eform "EFORM" +# rename fform "FFORM" + +#define TRUE 1 +#define FALSE 0 + +unsigned hpmul (); + +static unsigned exps[] = + { halves (0741566, 0111742), /* -48 */ + halves (0744723, 0534333), /* -47 */ + halves (0750444, 0231611), /* -46 */ + halves (0753555, 0300153), /* -45 */ + halves (0756710, 0560206), /* -44 */ + halves (0762435, 0346123), /* -43 */ + halves (0765544, 0637550), /* -42 */ + halves (0770676, 0007502), /* -41 */ + halves (0774426, 0604611), /* -40 */ + halves (0777534, 0345754), /* -39 */ + halves (0002663, 0437347), /* -38 */ + halves (0006420, 0163520), /* -37 */ + halves (0011524, 0220444), /* -36 */ + halves (0014651, 0264555), /* -35 */ + halves (0020411, 0660744), /* -34 */ + halves (0023514, 0235135), /* -33 */ + halves (0026637, 0304365), /* -32 */ + halves (0032403, 0472631), /* -31 */ + halves (0035504, 0411377), /* -30 */ + halves (0040625, 0513677), /* -29 */ + halves (0043773, 0036657), /* -28 */ + halves (0047474, 0723215), /* -27 */ + halves (0052614, 0110061), /* -26 */ + halves (0055757, 0132075), /* -25 */ + halves (0061465, 0370246), /* -24 */ + halves (0064602, 0666320), /* -23 */ + halves (0067743, 0444004), /* -22 */ + halves (0073456, 0166402), /* -21 */ + halves (0076571, 0624103), /* -20 */ + halves (0101730, 0171123), /* -19 */ + halves (0105447, 0113564), /* -18 */ + halves (0110560, 0736521), /* -17 */ + halves (0113715, 0126245), /* -16 */ + halves (0117440, 0165747), /* -15 */ + halves (0122550, 0223341), /* -14 */ + halves (0125702, 0270232), /* -13 */ + halves (0131431, 0363140), /* -12 */ + halves (0134537, 0657770), /* -11 */ + halves (0137667, 0633766), /* -10 */ + halves (0143422, 0701372), /* -9 */ + halves (0146527, 0461670), /* -8 */ + halves (0151655, 0376246), /* -7 */ + halves (0155414, 0336750), /* -6 */ + halves (0160517, 0426542), /* -5 */ + halves (0163643, 0334272), /* -4 */ + halves (0167406, 0111564), /* -3 */ + halves (0172507, 0534121), /* -2 */ + halves (0175631, 0463146), /* -1 */ + halves (0201400, 0000000), /* 0 */ + halves (0204500, 0000000), /* 1 */ + halves (0207620, 0000000), /* 2 */ + halves (0212764, 0000000), /* 3 */ + halves (0216470, 0400000), /* 4 */ + halves (0221606, 0500000), /* 5 */ + halves (0224750, 0220000), /* 6 */ + halves (0230461, 0132000), /* 7 */ + halves (0233575, 0360400), /* 8 */ + halves (0236734, 0654500), /* 9 */ + halves (0242452, 0013710), /* 10 */ + halves (0245564, 0416672), /* 11 */ + halves (0250721, 0522450), /* 12 */ + halves (0254443, 0023471), /* 13 */ + halves (0257553, 0630407), /* 14 */ + halves (0262706, 0576511), /* 15 */ + halves (0266434, 0157115), /* 16 */ + halves (0271543, 0212741), /* 17 */ + halves (0274674, 0055531), /* 18 */ + halves (0300425, 0434430), /* 19 */ + halves (0303532, 0743536), /* 20 */ + halves (0306661, 0534465), /* 21 */ + halves (0312417, 0031701), /* 22 */ + halves (0315522, 0640261), /* 23 */ + halves (0320647, 0410336), /* 24 */ + halves (0324410, 0545213), /* 25 */ + halves (0327512, 0676455), /* 26 */ + halves (0332635, 0456171), /* 27 */ + halves (0336402, 0374713), /* 28 */ + halves (0341503, 0074076), /* 29 */ + halves (0344623, 0713116), /* 30 */ + halves (0347770, 0675742), /* 31 */ + halves (0353473, 0426555), /* 32 */ + halves (0356612, 0334310), /* 33 */ + halves (0361755, 0023372), /* 34 */ + halves (0365464, 0114134), /* 35 */ + halves (0370601, 0137163), /* 36 */ + halves (0373741, 0367020), /* 37 */ + halves (0377454, 0732312), /* 38 */ + halves (0402570, 0120775), /* 39 */ + halves (0405726, 0145174), /* 40 */ + halves (0411445, 0677215), /* 41 */ + halves (0414557, 0257061), /* 42 */ + halves (0417713, 0132675), /* 43 */ + halves (0423436, 0770626), /* 44 */ + halves (0426546, 0566774), /* 45 */ + halves (0431700, 0324573), /* 46 */ + halves (0435430, 0204754), /* 47 */ + halves (0440536, 0246150) }; /* 48 */ + +static unsigned mants[] = + { halves (0566111, 0742473), /* -48 */ + halves (0723534, 0333211), /* -47 */ + halves (0444231, 0611026), /* -46 */ + halves (0555300, 0153233), /* -45 */ + halves (0710560, 0206102), /* -44 */ + halves (0435346, 0123651), /* -43 */ + halves (0544637, 0550624), /* -42 */ + halves (0676007, 0502771), /* -41 */ + halves (0426604, 0611673), /* -40 */ + halves (0534345, 0754252), /* -39 */ + halves (0663437, 0347325), /* -38 */ + halves (0420163, 0520505), /* -37 */ + halves (0524220, 0444626), /* -36 */ + halves (0651264, 0555774), /* -35 */ + halves (0411660, 0744575), /* -34 */ + halves (0514235, 0135735), /* -33 */ + halves (0637304, 0365324), /* -32 */ + halves (0403472, 0631304), /* -31 */ + halves (0504411, 0377565), /* -30 */ + halves (0625513, 0677523), /* -29 */ + halves (0773036, 0657450), /* -28 */ + halves (0474723, 0215571), /* -27 */ + halves (0614110, 0061127), /* -26 */ + halves (0757132, 0075355), /* -25 */ + halves (0465370, 0246324), /* -24 */ + halves (0602666, 0320011), /* -23 */ + halves (0743444, 0004013), /* -22 */ + halves (0456166, 0402407), /* -21 */ + halves (0571624, 0103111), /* -20 */ + halves (0730171, 0123733), /* -19 */ + halves (0447113, 0564351), /* -18 */ + halves (0560736, 0521443), /* -17 */ + halves (0715126, 0245754), /* -16 */ + halves (0440165, 0747563), /* -15 */ + halves (0550223, 0341520), /* -14 */ + halves (0702270, 0232044), /* -13 */ + halves (0431363, 0140226), /* -12 */ + halves (0537657, 0770274), /* -11 */ + halves (0667633, 0766353), /* -10 */ + halves (0422701, 0372023), /* -9 */ + halves (0527461, 0670430), /* -8 */ + halves (0655376, 0246536), /* -7 */ + halves (0414336, 0750132), /* -6 */ + halves (0517426, 0542161), /* -5 */ + halves (0643334, 0272616), /* -4 */ + halves (0406111, 0564570), /* -3 */ + halves (0507534, 0121727), /* -2 */ + halves (0631463, 0146314), /* -1 */ + halves (0400000, 0000000), /* 0 */ + halves (0500000, 0000000), /* 1 */ + halves (0620000, 0000000), /* 2 */ + halves (0764000, 0000000), /* 3 */ + halves (0470400, 0000000), /* 4 */ + halves (0606500, 0000000), /* 5 */ + halves (0750220, 0000000), /* 6 */ + halves (0461132, 0000000), /* 7 */ + halves (0575360, 0400000), /* 8 */ + halves (0734654, 0500000), /* 9 */ + halves (0452013, 0710000), /* 10 */ + halves (0564416, 0672000), /* 11 */ + halves (0721522, 0450400), /* 12 */ + halves (0443023, 0471240), /* 13 */ + halves (0553630, 0407510), /* 14 */ + halves (0706576, 0511432), /* 15 */ + halves (0434157, 0115760), /* 16 */ + halves (0543212, 0741354), /* 17 */ + halves (0674055, 0531647), /* 18 */ + halves (0425434, 0430110), /* 19 */ + halves (0532743, 0536132), /* 20 */ + halves (0661534, 0465561), /* 21 */ + halves (0417031, 0701446), /* 22 */ + halves (0522640, 0261760), /* 23 */ + halves (0647410, 0336354), /* 24 */ + halves (0410545, 0213024), /* 25 */ + halves (0512676, 0455631), /* 26 */ + halves (0635456, 0171177), /* 27 */ + halves (0402374, 0713617), /* 28 */ + halves (0503074, 0076563), /* 29 */ + halves (0623713, 0116320), /* 30 */ + halves (0770675, 0742004), /* 31 */ + halves (0473426, 0555202), /* 32 */ + halves (0612334, 0310443), /* 33 */ + halves (0755023, 0372554), /* 34 */ + halves (0464114, 0134543), /* 35 */ + halves (0601137, 0163674), /* 36 */ + halves (0741367, 0020653), /* 37 */ + halves (0454732, 0312413), /* 38 */ + halves (0570120, 0775116), /* 39 */ + halves (0726145, 0174341), /* 40 */ + halves (0445677, 0215615), /* 41 */ + halves (0557257, 0061160), /* 42 */ + halves (0713132, 0675414), /* 43 */ + halves (0436770, 0626347), /* 44 */ + halves (0546566, 0774041), /* 45 */ + halves (0700324, 0573052), /* 46 */ + halves (0430204, 0754732), /* 47 */ + halves (0536246, 0150120) }; /* 48 */ + +/********************************************************************** + + ATOF - Convert string to float + +**********************************************************************/ + +static int biggest = {halves (0377777, 07777777)}; +static double *pbig = {&biggest}; + +double atof (s) + register char *s; + + {register int e, c; + register unsigned frac; + int negexp, isneg, sigcnt, adjust; + unsigned holder; + double *pdouble; + + if (s == 0 || *s == 0) return (0.0); + negexp = isneg = FALSE; + e = sigcnt = adjust = frac = 0; + while (*s == '-' || *s == '+') + {if (*s == '-') isneg = !isneg; + ++s; + } + while ((c = *s++) >= '0' && c <= '9') + {if (c == '0' && sigcnt == 0) continue; + if (sigcnt < 10) + {frac = frac * 10 + (c - '0'); + ++sigcnt; + } + else ++adjust; + } + if (c == '.') + {while ((c = *s++) >= '0' && c <= '9') + {if (c == '0' && sigcnt == 0) --adjust; + else if (sigcnt >= 10) continue; + else {frac = frac * 10 + (c - '0'); + ++sigcnt; + --adjust; + } + } + } + if (c == 'e' || c == 'E') + {while (*s == '-' || *s == '+') + {if (*s == '-') negexp = !negexp; + ++s; + } + while ((c = *s++) >= '0' && c <= '9') + e = e * 10 + (c - '0'); + } + if (frac == 0) return (0.0); + if (negexp) e = -e; + adjust += e; + if (adjust < -48) return (0.0); + else if (adjust > 38) return (isneg ? -(*pbig) : *pbig); + + sigcnt = 0; /* now use sigcnt to remember # of shifts */ + while (!(frac & halves (0400000, 0))) /* normalize */ + {frac <<= 1; + ++sigcnt; + } + frac = hpmul (frac, mants[adjust + 48], &negexp); /* high prec mult */ + while (!(frac & halves (0400000, 0))) /* normalize */ + {frac <<= 1; + ++sigcnt; + } + frac >>= 8; + if (frac & 01) /* round and maybe shift one more */ + {++frac; + if (frac & halves (0776000, 0)) + {frac >>= 1; + --sigcnt; + } + } + frac >>= 1; /* now have fraction -- need exp */ + e = exps[adjust + 48] >> 27; + if (e & 0400) e |= halves (0777777, 0777000); + e += (36 - sigcnt); + if (e < 0) return (0.0); + else if (e >= 0400) return (isneg ? -(*pbig) : *pbig); + + holder = (e << 27) | frac; + if (isneg) holder = -holder; + pdouble = &holder; + return (*pdouble); + } + +unsigned hpmul (x, y, plprod) + register unsigned x, y, *plprod; + + {unsigned x1, x2, x3, y1, y2, y3; + register unsigned prod, lprod; + + x1 = x >> 24; + x2 = (x >> 12) & 07777; + x3 = x & 07777; + y1 = y >> 24; + y2 = (y >> 12) & 07777; + y3 = y & 07777; + + prod = x3 * y3; + lprod = prod & 07777; + prod >>= 12; + prod += (x2 * y3) + (x3 * y2); + lprod |= (prod & 07777) << 12; + prod >>= 12; + prod += (x1 * y3) + (x2 * y2) + (x3 * y1); + *plprod = lprod | ((prod & 07777) << 24); + prod >>= 12; + prod += (x1 * y2) + (x2 * y1); + prod += (x1 * y1) << 12; + return (prod); + } + +dextract (d, psign, digits, pexpon) + double d; + int *psign, *pexpon; + char *digits; + + {unsigned dd; + double *pdd; + register int exp, maxexp; + unsigned frac, hfrac; + int nshift; + + *psign = FALSE; + if (d == 0.0) /* special case 0.0 */ + {*digits++ = '0'; + *digits = 0; + *pexpon = 0; + return; + } + + if (d < 0.0) /* take care of sign stuff */ + {*psign = TRUE; + d = -d; + } + + pdd = ⅆ /* prepare to hack */ + *pdd = d; + + exp = -39; /* find exponent */ + maxexp = 38; + do {int avg; + avg = (exp + maxexp) >> 1; + if (dd < exps[avg + 48]) maxexp = avg; + else exp = avg; + } + while ((maxexp - exp) > 1); + if (exp != maxexp && dd >= exps[maxexp + 48]) ++exp; + ++exp; /* for . at left */ + + frac = (dd & halves (0777, 0777777)) << 9; + frac = hpmul (frac, mants[49 - exp], &hfrac); + nshift = (dd >> 27) + (exps[49 - exp] >> 27) - 256; + if (nshift <= 0) + {hfrac = 1; + frac = 0; + } + else {hfrac = 0; + while (--nshift >= 0) + {hfrac <<= 1; + if (frac & halves (0400000, 0)) ++hfrac; + frac <<= 1; + } + } + nshift = 12; + while (TRUE) + {*digits++ = hfrac + '0'; + if (--nshift < 0) break; + hfrac = hpmul (frac, 10, &frac); + } + *digits = 0; + *pexpon = exp; + } + +int fprint (d, fd, p) + double d; + register int p; + int fd; + + {register int cnt; + char buf[15]; + int minus, expon, ndigs; + + cnt = 0; + if (p < 0) p = 0; + else if (p > 22) p = 22; + + dextract (d, &minus, buf, &expon); + + if (minus) + {putc ('-', fd); + ++cnt; + } + ndigs = expon + p; + if (ndigs <= 0 || expon > 8) + {expon += doround (buf, p + 1); + return (cnt + eform (fd, buf, expon, p)); + } + expon += doround (buf, ndigs); + return (cnt + fform (fd, buf, expon, p)); + } + +int doround (p, n) + register char *p; + + {register char *q; + + if (n >= 12) n = 12; + else if (n <= 0) n = 1; + q = &p[n]; + if (n < 12 && p[n] >= '5') + {while (TRUE) + {*q = 0; + if (++(*--q) <= '9') break; + if (q == p) + {p[0] = '1'; + p[1] = 0; + return (1); + } + } + ++q; + } + while (TRUE) + {*q = 0; + if (q <= p || *--q != '0') break; + } + return (0); + } + +int eform (fd, q, expon, p) + register char *q; + + {register int cnt, ndigs; + char buf[5]; + + if (*q) putc (*q++, fd); + else putc ('0', fd); + putc ('.', fd); + cnt = p + 3; + while (--p >= 0) + {if (*q) putc (*q++, fd); + else putc ('0', fd); + } + putc ('e', fd); + if (--expon < 0) + {expon = -expon; + putc ('-', fd); + } + else putc ('+', fd); + itoa (expon, buf); + q = buf; + while (*q) + {putc (*q++, fd); + ++cnt; + } + return (cnt); + } + +int fform (fd, q, expon, p) + register char *q; + + {register int cnt; + cnt = 0; + while (*q && *q == '0' && expon > 1) + {--expon; + ++q; + } + while (expon > 0) + {if (*q) putc (*q++, fd); + else putc ('0', fd); + --expon; + ++cnt; + } + putc ('.', fd); + cnt += (p + 1); + while (--p >= 0) + {if (expon >= 0 && *q) putc (*q++, fd); + else putc ('0', fd); + ++expon; + } + return (cnt); + } + +int eprint (d, fd, p) + double d; + int fd, p; + + {char buf[15]; + int cnt, minus, expon; + + cnt = 0; + if (p < 0) p = 0; + else if (p > 22) p = 22; + + dextract (d, &minus, buf, &expon); + expon += doround (buf, p + 1); + if (minus) + {putc ('-', fd); + ++cnt; + } + return (cnt + eform (fd, buf, expon, p)); + } diff --git a/c20/new/lib/c20int.c b/c20/new/lib/c20int.c new file mode 100644 index 00000000..f3e2b7a0 --- /dev/null +++ b/c20/new/lib/c20int.c @@ -0,0 +1,87 @@ +/* TOPS-20 C interrupt interface, non-extended-addressing version */ + +# include + +# rename chntab "CHNTAB" +# rename prctab "PRCTAB" + +extern int chntab[], prctab[]; + +static int assigned = 0; /* interrupt channels assigned to user */ +static int ignore() {;} /* a function which does nothing */ + +/* reserve PDLOV */ +#define reserved halves(0400,0) + +/* these channels are not allocatable to the user (0 is for debugger) */ +#define system_interrupts halves(0407777, 0760000) + +# define halves(l,r) (((l) << 18) | ((r) & 0777777)) + +iset (chan,proc) +int chan; +int proc; /* really a pointer to the function to execute */ +{ + register unsigned prev, mask; + + mask = (unsigned) 0400000000000 >> chan; + if (chan < 0 || chan > 35 || (mask & reserved)) return (-1); + proc &= 0777777; + prev = prctab[chan]; + switch (proc) { + case INT_DEFAULT: + if (prev) { + _DIC (0400000, mask); /* interrupt off */ + chntab[chan] &= 0777777; /* set priority to 0 */ + } + break; + case INT_IGNORE: + proc = (int) ignore; /* falls through */ + default: + prctab[chan] = proc; + if (proc && (prev == 0)) { + chntab[chan] |= (3 << 18); /* always priority 3 */ + _AIC (0400000, mask); + } + } + if (prev == (int) ignore) prev = INT_IGNORE; + return (prev); +} + +ialloc () +{ + register unsigned left, num; + + if ((left = ~(assigned | system_interrupts)) == 0) return (0); + num = 35; + while (!(left & 1)) { + --num; + left >>= 1; + } + assigned |= (unsigned) 0400000000000 >> num; + return (num); +} + +ifree (chan) +int chan; +{ + if (chan >= 0 && chan <= 35) { + assigned &= ~((unsigned)0400000000000 >> chan) & ~system_interrupts; + iset (chan,INT_DEFAULT); + } +} + +int onchar(chr,proc) +char chr; +int proc; +{ + int intno; + + if ((chr < 0) || (chr > 29)) + return (-1); + if((intno = ialloc()) < 0) /* no int channels left */ + return(-1); + _ati(halves(chr,intno)); /* tie channel to char */ + iset(intno,proc); /* tie channel to proc */ + return(intno); +} diff --git a/c20/new/lib/c20io.c b/c20/new/lib/c20io.c new file mode 100644 index 00000000..e0a1f583 --- /dev/null +++ b/c20/new/lib/c20io.c @@ -0,0 +1,2058 @@ +# include +# include + +/************************************************************************ + + C20IO - C TOPS-20/TENEX I/O Routines + Note: Must # include . + + + Functions defined, either here, in the auxiliary files of + the library, or as macros in STDIO.H: + + Functions similar to UNIX standard I/O: + + fileptr = fopen (name, mode) + fileptr = freopen (name, mode, fileptr) + c = getc (fileptr) + c = fgetc (fileptr) + i = getw (fileptr) + c = putc (c, fileptr) + c = fputc (f, fileptr) + fclose (fileptr) + fflush (fileptr) + exit (errcode) - flush buffers, close files, and exit + _exit (errcode) - just exit. This is continuable + b = feof (fileptr) + c = getchar () + putchar (c) + s = gets (s) + s = fgets (s, n, fileptr) + puts (s) + fputs (s, fileptr) + putw (i, fileptr) + i = getw (filptr) + ungetc (c, fileptr) + printf (format, a1, ...) + fprintf (fileptr, format, a1, ...) + sprintf (buf, format, a1, ...) + scanf (format, a1, ...) + fscanf (fileptr, format, a1, ...) + sscanf (s, format, a1, ...) + fread (ptr, itemsize, nitems, fileptr) these use getw, putw + fwrite (ptr, itemsize, nitems, fileptr) +** fcread (ptr, itemsize, nitems, fileptr) these use getc, putc +** fcwrite (ptr, itemsize, nitems, fileptr) + rewind (fileptr) + fileno (fileptr) + fseek (fileptr, offset, mode) + i = ftell (fileptr) + i = atoi (s) (in C20ATI.C) + itoa (n, s) (in C20ATI.C) + d = atof (s) (in C20FPR.C) + ftoa (d, s, p, f) (in C20ATI.C) + i = strcmp (s1, s2) (in C20STR.MID) + strcpy (dest, source) (in C20STR.MID) + strcat (dest, source) (in C20STR.MID) + i = strlen (s) (in C20STR.MID) + sleep(i) - sleep i seconds + unlink (s) - delete and expunge the file + uid = getuid () - get user number + buf = getpw (uid, buf) - writes user name into buf + p = malloc (size) (in C20MEM.C) + p = calloc (num, size) (in C20MEM.C) + free (ptr) (in C20MEM.C) + + Other Routines: + + username () - returns a pointer to string containing users name + valret (s) - return a command string to the superior program + delete (fp) - Delete, but do not expunge, the file + tmpnam (bp) - Cons a temp file name. Not like the UNIX one at all. + + Routines from stdio not implemented: + + ferror, system, abort, intss, wdleng, nargs, setbuf, gcvt + + See C20PRT.C for information about PRINTF formats. + +** = hack routines to provide functionality not otherwise available + +**********************************************************************/ + +static fnpipe(); +static refill_buffer(),change_direction(); +static istty(),rdtty(),ttychar(),calc_hpos(); +static FILE *channel_allocate(); +static channel_free(); +static setio(),parse(),errout(); +static do_options(),fix_primary_io(); + +# define EOL 037 /* newline on TENEX */ +# define QUOTE 026 /* control-V, for file names */ +# define ARGQUOTE '\\' /* for command args */ + +# define FILBUFPGS 1 +# define FILBUFSIZ (FILBUFPGS << 9) +# define UBUFSIZ 15 +# define PIPSIZ 4096 +# define TTYLINSIZ 120 + + /* file types */ + +# define FTTY 0 /* interactive terminal (primary I/O only) */ +# define FTEXT 1 /* text file, other terminals */ +# define FBIN 2 /* binary file */ +# define FSTR 3 /* string I/O */ +# define FPIPE 4 /* pipe (special hack file) */ + +# define UFLAG 010 /* indicates UNGETC'ed units available */ +# define FUTTY (FTTY|UFLAG) /* "unget" versions of these */ +# define FUTEXT (FTEXT|UFLAG) +# define FUBIN (FBIN|UFLAG) +# define FUSTR (FSTR|UFLAG) +# define FUPIPE (FPIPE|UFLAG) + +# define EFLAG 020 /* indicates EOF on channel */ +# define FETTY (FTTY|EFLAG) /* eof versions */ +# define FETEXT (FTEXT|EFLAG) +# define FEBIN (FBIN|EFLAG) +# define FESTR (FSTR|EFLAG) +# define FEPIPE (FPIPE|EFLAG) + + /* file directions */ + /* possible states are: */ + /* FREAD (reading only) */ + /* FWRITE (writing only) */ + /* FREAD | FWRITE (reading and writing, currently writing) */ + /* FREAD | FWRITE | FREADING (both, currently reading) */ + +# define FREAD 1 +# define FWRITE 2 +# define FREADING 4 /* currently reading */ + +static FILE *eopen (),*channel_allocate (); +char *pg_get(); + +static FILE sinfb; /* standard input file data block */ +static FILE soutb; /* standard output file block */ +static FILE serrb; /* standard error file block */ + +FILE *stdin,*stdout,*stderr; + +static char *sinfn, /* standard input file name, if redirected */ + *soutfn, /* standard output file name, if redirected */ + *serrfn; /* standard errout file name, if redirected */ + +int cerrno; /* system OPEN error codes returned here */ + +# define tty_prompt tprmpt +# define tty_ptr tptr + +static char *tty_prompt; /* terminal prompt string */ +static int tty_eof; /* set when (unquoted) ^@, ^Z typed */ +static char tty_line[TTYLINSIZ+1]; /* current output line (for prompt) */ +static char *tty_ptr; /* pointer to end of tty_line */ + +# define FALSE 0 +# define TRUE 1 + +/********************************************************************** + + FOPEN - Open File + + Open a file, given a file name and an optional options string. + + The first letter of the options string controls the mode the + file is opened in. The possible modes are: + + r - read + w - write + a - append + b - both (read and write, new file, exclusive access) + u - update (read and write, exclusive access) + m - modify (read and write, non-exclusive access) + + The default mode is read. Normally, I/O is character oriented + and produces text files. In particular, the lines of a text + file are assumed (by the user) to be separated by newline + characters with any conversion to the system format performed + by the I/O routines. + + Any additional characters in the options string specify + non-standard file operations or modes. There are several of + these, as follows: + + If the options string contains the character "b", then I/O is + integer (word) - oriented and produces image files. + + If the "additional characters" of the option string begin with + digits, they are interpreted as a decimal integer to use as + the byte size when opening the file. Text I/O is defaultly + 7-bit, and binary I/O is defaultly 36-bit. The byte size field + is ignored for TTY and in core string I/O. + + I/O to and from character strings in core is accomplished by + including "s" in the options string and supplying a character + pointer to the string to be read or written into as the first + argument to FOPEN. Closing a string open for write will + append a NULL character to the string and return a character + pointer to that character. + + If the filename attributes include ;PIPE, then a pipe will be + opened using the given file name (with the ;PIPE removed from + the name, of course). Pipe I/O is always in 36-bit units; the + byte size is ignored. See C20PIP for more details. ;PIPE is + looked for only if the "s" option is not given. + + FOPEN returns a pointer to a FILE structure which contains + the necessary information for performing I/O functions using + the file. The global variables "stdin", "stdout", and "stderr" + point to already-open channels for the standard input, standard + output, and standard error output, respectively. + + FOPEN returns NULL in case of error. The system error code + is stored in the global variable "cerrno". + +**********************************************************************/ + +FILE *fopen (fname, opt) +char *fname,*opt; +{ + register FILE *p; + int append; /* TRUE if append mode */ + int thawed; /* TRUE if thawed access */ + int direction; /* read or write */ + int new; /* new file ? */ + int reading, writing, both; /* for each direction */ + int ftype; /* file type */ + int jfn, bsize; /* the actual jfn, desired byte size */ + int pipe; /* is it to be a pipe ? */ + char fnbuf[100]; /* buf for standardizing file name */ + + cerrno = 0; + do_options (opt,&direction,&ftype,&append,&new,&thawed,&bsize); + reading = ((direction & FREAD) != 0); + writing = ((direction & FWRITE) != 0); + both = (reading && writing); + if (ftype == FSTR) { /* string I/O */ + if (both) return (NULL); + if (append) while (*fname) ++fname; + jfn = 0; + bsize = 36; + } + else if (*fname == 0 && ftype == FTEXT) { /* primary I/O */ + if (both) return (NULL); + if (reading) jfn = 0100; + else jfn = 0101; + bsize = 7; /* byte size always 7 bits */ + } + else { /* is it to be a pipe ? */ + if (fnpipe (fname, fnbuf)) { + if (both) return(NULL); /*one way only!*/ + p = fopen (fnbuf, "m36b"); + if (p == NULL) return (NULL); + jfn = p->jfn; + if ((pipe = mkpipe ()) < 0) { + /* no pipes avail; discard jfn, aborting */ + _CLOSF (halves (0004000, jfn)); + channel_free (p, TRUE); + return (NULL); + } + bsize = 36; + ftype = FPIPE; + } + else { /* must GTJFN, OPENF */ + int oflag; + + oflag = halves (1, 0); /* GTJFN short form */ + if (new) + /* "output" use */ + oflag |= halves (0400000, 0); + if (reading && !writing) + /* require old file */ + oflag |= halves (0100000, 0); + jfn = _GTJFN (oflag, mkbptr (fnbuf)); + if (jfn >= 0600000) { + cerrno = jfn; + return (NULL); + } + oflag = 0; + if (reading) oflag = 0200000; + if (writing) { + if (append) oflag = 020000; + else oflag |= 0100000; + if (thawed) oflag |= 02000; + } + cerrno = _OPENF (jfn, oflag | (bsize << 30)); + if (cerrno) { + _RLJFN (jfn); + return (NULL); + } + } + } + /* file open, now set up FILE block */ + + if (ftype == FPIPE) p->jfn = pipe; + else { + if ((p = channel_allocate ()) == 0) { + if (ftype != FSTR) + /* close, aborting */ + _CLOSF (halves (0004000, jfn)); + return (NULL); + } + p->jfn = jfn; + } + p->ftype = ftype; + p->direction = direction; + p->bsize = bsize; + /* strings use a byte pointer, too, for uniform code */ + /* in other routines */ + if (ftype == FSTR) p->bptr = consbp (36, fname); + if (ftype == FTEXT && istty (p) && (jfn == 0100 || jfn == 0101)) + p->ftype = FTTY; /* really the terminal ? */ + if (p->ftype == FTTY) { + /* output buffering handled by C20TTY */ + if (reading) { + p->buf = pg_get (FILBUFPGS); + p->bcnt = 0; + p->bsize = 36; + tty_eof = FALSE; + } + } + else if (p->ftype == FTEXT || p->ftype == FBIN || p->ftype == FPIPE) { + if (p->ftype != FPIPE) p->buf = pg_get (FILBUFPGS); + if (writing) { + p->bcnt = FILBUFSIZ * (36 / bsize); + p->bptr = consbp (bsize, p->buf); + } + else p->bcnt = 0; + } + if (p->ftype == FPIPE) spipe (p->jfn, jfn, writing, PIPSIZ); + return (p); +} + +/********************************************************************** + + FNPIPE - standardize filename and see if it is pipe + +**********************************************************************/ + +static int fnpipe (fname, fnbuf) +char *fname, *fnbuf; +{ + char dev[40], dir[40], name[40], type[40], gen[10], attr[20]; + register char *p, *q, *qq; + int ispipe; + + fnparse (fname, dev, dir, name, type, gen, attr); + p = q = attr; + ispipe = FALSE; + while (TRUE) { + register char c; + + qq = q; + c = *q++ = *p++; + if (c == 0) break; + while (TRUE) { + c = *q++ = *p++; + if (c == 0 || c == ';') break; + } + --p; + *--q = 0; + if (qq[0] == ';' && + (qq[1] == 'p' || qq[1] == 'P') && + (qq[2] == 'i' || qq[2] == 'I') && + (qq[3] == 'p' || qq[3] == 'P') && + (qq[4] == 'e' || qq[4] == 'E') && + qq[5] == 0) { + ispipe = TRUE; + q = qq; + } + else *q = c; + } + fncons (fnbuf, dev, dir, name, type, gen, attr); + return (ispipe); +} + +/********************************************************************** + + SETPROMPT - set the terminal prompt string used when + getting a line of edited input from the terminal + +**********************************************************************/ + +setprompt (s) +char *s; +{ + tty_prompt = s; + return (0); +} + +/********************************************************************** + + FREOPEN - open a different file with the same FILE pointer + +**********************************************************************/ + +FILE *freopen (name, mode, file) +char *name, *mode; +{ + int i; + fclose (file); + return (fopen (name, mode)); +} + + +/********************************************************************** + + GETC + +**********************************************************************/ + +int getc (p) +register FILE *p; +{ + register int c; + + switch (p->direction) { + case FWRITE: + return (EOF); /* can't read */ + case (FREAD | FWRITE): + change_direction (p); + } + + switch (p->ftype) { + + case FTEXT: /* these all just try to ILDB from the buffer, */ + case FTTY: /* and refill it if empty, noting EOF as necessary */ + case FBIN: + case FPIPE: + while (--p->bcnt < 0) + if (!refill_buffer (p)) { + p->eof = TRUE; + p->ftype |= EFLAG; + return (EOF); + } + c = ildb (&p->bptr); +/* # ifdef TENEX ... Twenex does this on FORTRAN text I/O */ + /* NULLs can appear in the middle of text - ignore them */ + if (c == '\000' && p->ftype == FTEXT) return (getc (p)); +/* # endif */ + /* converts CRLF to newline on text input */ + if (p->ftype == FTEXT && c == '\r') { + char peekchar; + + if ((peekchar = getc (p)) == '\n') return ('\n'); + ungetc (peekchar, p); + } + return (c); + + case FSTR: + if ((c = ildb (&p->bptr)) == 0) { + p->ftype = FESTR; + p->eof = TRUE; + return (EOF); + } + return (c); + + case FUTTY: /* return any UNGETC'ed units; ubuf is used as a */ + case FUTEXT: /* stack, and ucnt indicates the number of items */ + case FUBIN: /* pushed back. We must restore the correct type */ + case FUSTR: /* when the stack becomes empty. */ + case FUPIPE: + c = p->ubuf[--p->ucnt]; + if (p->ucnt == 0) { + p->ftype &= ~UFLAG; + if (p->eof) p->ftype |= EFLAG; + } + return (c); + + case FETTY: /* at EOF, keep returning EOF_VALUE */ + case FETEXT: + case FEBIN: + case FESTR: + case FEPIPE: + return (EOF); + } +} + +/**************************************************************** + + REFILL_BUFFER - internal routine to get another input + buffer full for the specified channel + +****************************************************************/ + +static int refill_buffer (p) +register FILE *p; +{ + register int nc, nbytes, bp; + + bp = consbp (p->bsize, p->buf); /* cons new byte pointer */ + switch (p->ftype) { + case FTTY: + nc = rdtty (p->buf); /* special case */ + break; + case FTEXT: + case FBIN: + nbytes = FILBUFSIZ * (36 / p->bsize); + nc = _SIN (p->jfn, bp, -nbytes, 0); + nc += nbytes; + break; + case FPIPE: + nc = rdpipe (p->jfn, bp, FILBUFSIZ); + } + p->bptr = bp; /* store new byte pointer */ + p->bcnt = nc; /* store available count */ + return (nc != 0); /* say if got any */ +} + +/********************************************************************** + + UNGETC - push a unit back on an input channel + +**********************************************************************/ + +ungetc (c, p) +register FILE *p; +{ + switch (p->direction) { + case FWRITE: + return; + case (FWRITE | FREAD): + change_direction (p); + } + /* alloc a buffer, if necessary */ + if (p->ubuf == NULL) { + p->ubuf = malloc (UBUFSIZ); + p->ucnt = 0; + } + /* punt character if full */ + else if (p->ucnt >= UBUFSIZ) return; + /* change state if previously empty */ + if (p->ucnt == 0) { + p->ftype &= ~EFLAG; + p->ftype |= UFLAG; + } + p->ubuf[p->ucnt++] = c; /* finally, push unit */ +} + +/********************************************************************** + + GETW - INTs are encoded as SIXBITs on text streams + +**********************************************************************/ + +int getw (p) +register FILE *p; +{ + register int btype; + + btype = p->ftype & ~(UFLAG | EFLAG); /* get basic type */ + if (btype == FTEXT) { + register int i, j; + + i = 0; + for (j = 6; j > 0; --j) i = (i << 6) + getc (p) - 040; + if (feof(p)) return (EOF); + else return (i); + } + else return (getc (p)); +} + +/********************************************************************** + + PUTC + +**********************************************************************/ + +int putc(c, p) +register int c; +register FILE *p; +{ + switch (p->direction) { + case FREAD: + return (c); + case (FREAD | FWRITE | FREADING): + change_direction (p); + } + switch (p->ftype) { + + case FTTY: /* newline ==> CRLF; use C20TTY stuff */ + if (c == '\n') { + tyos ("\r\n"); + tty_ptr = tty_line; + fflush (p); + break; + } + if (tty_ptr < tty_line + TTYLINSIZ) *tty_ptr++ = c; + tyo (c); + break; + + case FTEXT: + if (c == '\n') putc ('\r', p); /* newline ==> CRLF */ + case FBIN: + case FPIPE: + while (--p->bcnt < 0) { /* send a full buffer */ + ++p->bcnt; /* restore count for fflush */ + fflush (p); + } + case FSTR: + idpb (c, &p->bptr); /* store the unit */ + break; + } + return (c); +} + +/********************************************************************** + + PUTW - INTs are encoded as SIXBITs on text streams + +**********************************************************************/ + +int putw(i, p) +register unsigned i; +register FILE *p; +{ + int btype; + + btype = p->ftype & ~(UFLAG | EFLAG); /* get basic type */ + if (btype == FTEXT) { + putc ((i >> 30) + 040, p); + putc (((i >> 24) & 077) + 040, p); + putc (((i >> 18) & 077) + 040, p); + putc (((i >> 12) & 077) + 040, p); + putc (((i >> 6) & 077) + 040, p); + putc ((i & 077) + 040, p); + return (0); + } + else return (putc (i, p)); +} + +/********************************************************************** + + FEOF + +**********************************************************************/ + +int feof (p) +FILE *p; +{ + if (p->ucnt > 0) return (FALSE); + else return (p->eof); +} + +/********************************************************************** + + FFLUSH + +**********************************************************************/ + +fflush (p) +register FILE *p; +{ + register int nbytes, bp, nc; + + switch (p->direction) { + case FREAD: + case (FREAD | FWRITE | FREADING): /* flush buffers */ + p->bcnt = 0; + p->ucnt = 0; + p->ftype &= ~UFLAG; /* restore correct type */ + if (p->eof) p->ftype |= EFLAG; + return(EOF); + } + + switch (p->ftype) { + + case FTTY: + tyo_flush (); /* use C20TTY's facilities */ + case FSTR: + return (EOF); + + case FTEXT: /* skip system call if nothing to do; avoids */ + case FBIN: /* overhead, and any screws if user did a _CLOSF */ + case FPIPE: + nbytes = FILBUFSIZ * (36 / p->bsize); + bp = consbp (p->bsize, p->buf); + nc = nbytes - p->bcnt; + if (nc != 0) { + if (p->ftype == FPIPE) + wrpipe (p->jfn, bp, nc); + else nc += _SOUT (p->jfn, bp, -nc, 0); + } + p->bcnt = nbytes; + p->bptr = bp; + return (nc); + } +} + +/********************************************************************** + + PRINTF, FPRINTF, SPRINTF - formatted printing routines + + These all use a set of basic formatted printing routines + contained in the file CPRINT.C + +**********************************************************************/ + +# rename _print "PRINT" + +printf (a, b, c, d, e, f, g, h, i, j, k, l, m, n) +{ + _print (stdout, a, b, c, d, e, f, g, h, i, j, k, l, m, n); +} + +fprintf (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) +{ + _print (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o); +} + +sprintf (s, a, b, c, d, e, f, g, h, i, j, k, l, m, n) +char *s; +{ + register FILE *fp; + fp = fopen (s, "ws"); + _print (fp, a, b, c, d, e, f, g, h, i, j, k, l, m, n); + fclose (fp); +} + +/********************************************************************** + + SCANF, FSCANF, SSCANF - formatted text input routines + + These all use the basic text input routines in SCANF.C + +**********************************************************************/ + +# rename _scanf "SCANF" + +scanf (fmt, a, b, c, d, e, f, g, h, i, j, k, l, m) +char *fmt; +{ + return (_scanf (stdin, fmt, a, b, c, d, e, f, g, h, i, j, k, l, m)); +} + +fscanf (fp, fmt, a, b, c, d, e, f, g, h, i, j, k, l, m) +FILE *fp; +char *fmt; +{ + return (_scanf (fp, fmt, a, b, c, d, e, f, g, h, i, j, k, l, m)); +} + +sscanf (s, fmt, a, b, c, d, e, f, g, h, i, j, k, l, m) +char *s, *fmt; +{ + int result; + FILE *fp; + + fp = fopen (s, "rs"); + result = _scanf (fp, fmt, a, b, c, d, e, f, g, h, i, j, k, l, m); + fclose (fp); + return (result); +} + + + +/********************************************************************** + + CHANGE_DIRECTION - switch between reading and writing + use only if channel can both read and write! + +**********************************************************************/ + +static change_direction (p) +register FILE *p; +{ + register int dir; + + fflush (p); + dir = (p->direction ^= FREADING); + if (dir & FREADING) p->bcnt = 0; /* was writing, now reading */ + else { /* was reading, now writing */ + p->eof = FALSE; + p->ftype &= ~EFLAG; + p->bcnt = FILBUFSIZ * (36 / p->bsize); + p->bptr = consbp (p->bsize, p->buf); + } +} + +/********************************************************************** + + FTELL - get position in file + +**********************************************************************/ + +ftell (p) +register FILE *p; +{ + register int btype; + + btype = p->ftype & ~(UFLAG | EFLAG); /* get basic type */ + if (btype == FTEXT || btype == FBIN) { + register int pos, n; + + switch (p->direction) { + case FREAD: + case (FREAD | FWRITE | FREADING): + n = -p->bcnt; + break; + case FWRITE: + case (FREAD | FWRITE): + n = FILBUFSIZ * (36 / p->bsize) - p->bcnt; + break; + } + if ((pos = _RFPTR (p->jfn)) < 0) return (-1); + return (pos + n); + } + /* TTY, string I/O, or pipe */ + return (0); +} + +/********************************************************************** + + FSEEK - set position in file + +**********************************************************************/ + +fseek (p, offset, mode) +register FILE *p; +int offset, mode; +{ + register int btype; + + btype = p->ftype & ~(UFLAG | EFLAG); /* get basic type */ + if (btype == FTEXT || btype == FBIN) { + register int pos; + + if (mode == 1) /* adjust for buffering */ + {switch (p->direction) { + case FREAD: + case (FREAD | FWRITE | FREADING): + /* not clear p->ucnt should be here ... */ + offset -= p->bcnt + p->ucnt; + } + } + fflush (p); + switch (mode) { + case 2: /* relative to end */ + if (_SFPTR (p->jfn, -1) < 0) return (-1); + case 1: /* relative to current */ + if (offset == 0) return (0); + if ((pos = _RFPTR (p->jfn)) < 0) return (-1); + offset += pos; + case 0: /* relative to start */ + break; + } + p->ftype &= ~EFLAG; + p->eof = FALSE; + return (_SFPTR (p->jfn, offset)); + } + /* no effect on TTY, string I/O, or pipes */ + return (-1); +} + +/********************************************************************** + + REWIND - reset to beginning of file + +**********************************************************************/ + +rewind (p) +FILE *p; +{ + return (fseek (p, 0, 0)); +} + +/********************************************************************** + + ISTTY + +**********************************************************************/ + +static int istty (p) +register FILE *p; +{ + unsigned vals[3]; + + switch (p->ftype & ~(EFLAG | UFLAG)) { + case FSTR: + case FPIPE: + return (FALSE); + case FTTY: + return (TRUE); + } + if (p->devtype == -1) { /* this is a trick so DVCHR done only once */ + register int jfn; + + if ((jfn = p->jfn) == 0100) + jfn = (unsigned)(_GPJFN (0400000)) >> 18; + else if (p->jfn == 0101) + jfn = _GPJFN (0400000) & 0777777; + if (jfn == 0377777) /* .NULIO */ + p->devtype = 015; /* .DVNUL */ + else if (jfn == 0677777) /* .SIGIO */ + p->devtype = 012; /* .DVTTY (assumption!) */ + else { + _DVCHR (p->jfn, vals); + p->devtype = (vals[1] >> 18) & 0777; + } + } + return ((p->devtype & ~01) == 012); /* TTY or PTY */ +} + +/********************************************************************** + + FCLOSE - Close a file. This doesn't do enough error checking yet + +**********************************************************************/ + +fclose (p) +register FILE *p; +{ + register int ftype; + + ftype = p->ftype & ~(EFLAG | UFLAG); + if (ftype == FSTR) { + int s; + + if (p->direction & FWRITE) idpb (0, &p->bptr); + s = p->bptr & 0777777; + channel_free (p, TRUE); + return (s); + } + if (ftype == FTTY) { + dpyreset (); + dpyinit (); + } + fflush (p); + if (ftype == FPIPE) clpipe (p->jfn); + else _CLOSF (p->jfn); /* close file and release jfn */ + channel_free (p, TRUE); + return (0); +} + + +/********************************************************************** + + GETS - Read a string from the standard input unit + +**********************************************************************/ + +char *gets (p) +register char *p; +{ + register int c; + char *s; + + s = p; + while ((c = getc (stdin)) != '\n' && c > 0) *p++ = c; + *p = 0; + return (s); +} + +/********************************************************************** + + FGETS - read a string from a file + +**********************************************************************/ + +char *fgets (s, n, f) +char *s; +FILE *f; +{ + register char *sp; + register int c; + + sp = s; + while (--n > 0 && (c = getc (f)) != EOF) + if ((*sp++ = c) == '\n') break; + *sp = 0; + if (c == EOF && sp == s) return (NULL); + return (s); +} + +/********************************************************************** + + PUTS - Output a string to the standard output unit + +**********************************************************************/ + +puts (s) +register char *s; +{ + register int c; + + while (c = *s++) putc (c, stdout); + putc ('\n', stdout); +} + +/********************************************************************** + + FPUTS - write a string to a file + +**********************************************************************/ + +fputs (s, f) +register char *s; +FILE *f; +{ + register int c; + while (c = *s++) putc (c, f); +} + +/********************************************************************** + + FREAD, FCREAD - read data from a file to a buffer + fread uses getw, for binary files + fcread uses getc, generally better + for text files + +**********************************************************************/ + +fread (buf, size, number, f) +int *buf; +FILE *f; +{ + register int i, j, k; + for (i = 0; i < number; ++i) { + j = size; + while (--j >= 0) { + k = getw (f); + if (feof (f)) return (i); + *buf++ = k; + } + } + return (i); +} + +fcread (buf, size, number, f) +char *buf; +FILE *f; +{ + register int i, j, k; + for (i = 0; i < number; ++i) { + j = size; + while (--j >= 0) { + k = getc (f); + if (feof (f)) return (i); + *buf++ = k; + } + } + return (i); +} + +/********************************************************************** + + FWRITE, FCWRITE - write data from a buffer to a file + fwrite uses putw + fcwrite uses putc + +**********************************************************************/ + +fwrite (buf, size, number, f) +register int *buf, size; +FILE *f; +{ + size *= number; + while (--size >= 0) putw (*buf++, f); + return (number); +} + +fcwrite (buf, size, number, f) +register char *buf; +register int size; +FILE *f; +{ + size *= number; + while (--size >= 0) putc (*buf++, f); + return (number); +} + + +/********************************************************************** + + RDTTY - C buffered TTY input editing: + implements ^@, ^I, ^J, ^L, ^M, ^R, ^U, ^V, ^W, ^Z + display terminals handled nicely; others still edit + +**********************************************************************/ + +# define alpha(c) ((c>='0'&&c<='9')||(c>='A'&&c<='Z')||(c>='a'&&c<='z')) +# define PRIOU 0101 + +static int rdtty (p) /* returns number of chars in buffer */ +register int *p; +{ + register int *q, *qq, c; + register char *prompt; /* standardized prompt */ + int quoteflag, delflag, disp; + if (tty_eof) return (0); + q = p; /* pointer to next char slot */ + delflag = quoteflag = FALSE; + disp = isdisplay (); /* flag for display-ness */ + *tty_ptr = 0; + prompt = tty_line; + if (*prompt != 0) c = utyi (); + else {if (tty_prompt) prompt = tty_prompt; + c = '\022'; /* simulate ^R to start */ + } + while (TRUE) + {register int hpos; /* calculate cursor position */ + hpos = calc_hpos (p, q, calc_hpos (prompt, 0, 0)); + + /* check for end of deleting on non-displays */ + if (delflag && c != '\177') + {tyo ('\\'); + delflag = FALSE; + } + + /* check for special characters */ + if (!quoteflag) switch (c) { + case '\r': +# ifdef TENEX + case EOL: +# endif + c = '\n'; /* treat as newline */ + case '\n': + *q++ = c; /* insert into buffer */ + break; + + case '\177': /* rubout - rubout character */ + if (q <= p) /* beep if none */ + {utyo ('\007'); + c = utyi (); + continue; + } + --q; /* delete it */ + if (!disp) /* do non-display rubout stuff */ + {if (!delflag) + {delflag = TRUE; + tyo ('\\'); + } + ttychar (*q); + c = utyi (); + continue; + } + /* fall through to redisplay code */ + + case '\027': /* ^W - rubout word */ + if (c == '\027') /* so falling through works */ + {register int cc; + if (q <= p) /* beep if none */ + {utyo ('\007'); + c = utyi (); + continue; + } + cc = q[-1]; + while (!alpha (cc) && --q > p) cc = q[-1]; + while (alpha (cc) && --q > p) cc = q[-1]; + } + + case '\025': /* ^U - rubout line */ + if (c == '\025') /* so falling through works */ + {if (q <= p) /* beep if none */ + {utyo ('\007'); + c = utyi (); + continue; + } + q = p; /* just reset pointer */ + } + if (disp) /* redisplay by backing up cursor, */ + /* then kill to end of line */ + {register int nhpos; + nhpos = calc_hpos (prompt, 0, 0); + nhpos = calc_hpos (p, q, nhpos); + while (nhpos < hpos) + {spctty ('B'); + --hpos; + } + spctty ('L'); + tyo_flush (); + c = utyi (); + continue; + } + /* non-display ^W, ^U fall through here */ + + case '\014': /* ^L - clear and retype */ + case '\022': /* ^R - just retype */ + /* more cursor, maybe clear */ + if (disp) + {if (c == '\p') spctty ('C'); + else tyo ('\r'); + } + else tyos ("\r\n"); + tyos (prompt); + qq = p; + while (qq < q) ttychar (*qq++); + if (disp) spctty ('L'); /* zap rest of line */ + tyo_flush (); + c = utyi (); + continue; + } + /* here is non-special character, or \r or \n */ + + /* display all except unquoted newline, ^V */ + if (quoteflag || (c != '\n' && c != '\026')) + {if (q - p >= FILBUFSIZ - 1) + {utyo ('\007'); /* beep if buffer full */ + c = utyi (); + continue; + } + ttychar (c); + tyo_flush (); + } + + /* done if unquoted ^@, ^Z, or newline */ + if (!quoteflag && (c == '\000' || c == '\032' || c == '\n')) + {tty_eof = (c != '\n'); + tyos ("\r\n"); + tyo_flush (); + tty_ptr = tty_line; + return (q - p); + } + + /* adjust quote flag */ + quoteflag = (c == '\026' && !quoteflag); + /* add all except ^V to buffer */ + if (quoteflag) + {int omode; /* permit ^Q/^S to be input */ + omode = _RFMOD (PRIOU); + if (omode & 2) _STPAR (PRIOU, omode & ~2); + c = utyi (); + if (omode & 2) _STPAR (PRIOU, omode); + } + else {*q++ = c; /* normal case */ + c = utyi (); + } + } + } + +/**************************************************************** + + TTYCHAR - echo char on terminal + converts control chars to ^letter, except \t + +****************************************************************/ + +static ttychar (c) +register char c; +{ + if (c == '\177') { + tyos ("^?"); + return; + } + if (c < ' ' && c != '\t') { + tyo ('^'); + c += 0100; + } + tyo (c); +} + +/**************************************************************** + + CALC_HPOS - calculates position of terminal cursor after + displaying given string via TTYCHAR + +****************************************************************/ + +static int calc_hpos (s, e, h) +register char *s, *e; +register int h; +{ + /* s = start of string, e = end, h = initial hpos */ + register char c; + if (e == 0) { /* calculate e if not supplied */ + e = s; + while (*e != 0) e++; + } + while (s < e) { + c = *s++; + if (c == '\t') { + h = (h + 8) & ~07; /* assumes first position is 0 */ + continue; + } + if (c < ' ' || c == '\177') h++; + h++; + } + return (h); +} + + + +# define COMSIZE 500 /* size of command buffer */ +# define MAXARG 100 /* maximum number of command arguments */ + +# rename combuf "COMBUF" +# rename pjflag "PJFLAG" +# rename riflag "RIFLAG" +# ifdef TENEX +# rename dbgflg "DBGFLG" +# endif TENEX + +char combuf[COMSIZE]; /* command buffer */ +char *argv[MAXARG]; /* command arguments */ +int argc; /* number of command arguments */ + +/********************************************************************** + + SETUP - Initialization Routine + +**********************************************************************/ + +# rename setup "SETUP" + +setup () +{ + register int n; + tty_eof = FALSE; /* reset global I/O stuff */ + tty_prompt = ""; + tty_ptr = tty_line; + stdin = &sinfb; + stdout = &soutb; + stderr = &serrb; + sinfn = soutfn = serrfn = NULL; + dpysetup (); /* reset C20TTY stuff, too */ + dpyinit (); + +# ifdef TOPS20 + n = _RSCAN (0); /* command line in rescan buffer */ + if (n > 0) { + register int i; + + _SIN (0777777, mkbptr (combuf), n, 0); + i = n - 1; + while (i >= 0) { /* remove trailing CR and NLs */ + register int c; + c = combuf[i]; + if (c != '\r' && c != '\n') break; + --i; + } + combuf[i+1] = 0; /* terminate string */ + } + if (n == 0 || nojcl ()) { + /* if run from IDDT or by some EXEC command, then */ + /* no jcl, so give the user a chance ... */ + combuf[0] = '.'; /* dummy program name */ + combuf[1] = ' '; + tty_prompt = "Command: "; + fix_primary_io (stdin, fopen ("", "r")); + gets (&combuf[2]); /* get a command string */ + fclose (stdin); + tty_eof = FALSE; /* just in case */ + tty_prompt = 0; + } +# endif +# ifdef TENEX + combuf[0] = '.'; /* hack jcl */ + n = _GPJFN (0400000); /* what is primary input ? */ + if (((unsigned)(n) >> 18) == 0777777) { /* controlling terminal */ + extern int dbgflg; + register char c, *p; + if (dbgflg || _BKJFN (0100) != 0) c = ' '; + else c = utyi (); + if (c == '\r' || c == '\n' || c == EOL) combuf[1] = 0; + else { + combuf[1] = c; + tty_prompt = "Command: "; + if (!dbgflg) tty_ptr = stcpy (tty_prompt, tty_line); + p = &combuf[2]; + p += rdtty (p); /* don't copy newline */ + while (p[-1] == '\n' || p[-1] == ' ') *--p = 0; + tty_eof = FALSE; /* just in case */ + tty_prompt = 0; + tty_ptr = tty_line; + } + } + else { + register char *p; + p = combuf; + while (TRUE) { + register char c; + c = _BIN ((unsigned)(n) >> 18); + if (c == '\r' || c == '\n' || c == EOL || c == 0) + break; + *p++ = c; + } + *p++ = 0; + _SPJFN (0400000, 0777777, n & 0777777); + } +# endif TENEX + + argc = parse (combuf, argv); /* parse command line */ + setio (); /* maybe redirect I/O */ +} + +# ifdef TOPS20 +int nojcl () { /* just to see if RUN was used, or we are in a debugger */ + + char temp[COMSIZE]; + register char *p; + strcpy (temp,combuf); + p = temp; + while (*p) { + if (*p == ' ') { + *p = 0; + break; + } + *p = isupper(*p) ? tolower(*p) : (*p); + ++p; + } + if (!strcmp (temp, "run")) return (TRUE); + if (!strcmp (temp, "r")) return (TRUE); + /* match anything ending in "ddt" */ + if (p - temp >= 3 && !strcmp (p - 3, "ddt")) + return (TRUE); + return (FALSE); +} +# endif TOPS20 + +static int append, errappend; + +/********************************************************************** + + PARSE - Parse Command Arguments + + given: in - the command string + av - a pointer to a character pointer array + where pointers to the args should be placed + returns: number of arguments + + PJFLAG set to false suppresses parsing and I/O redirection + RIFLAG set to false suppresses I/O redirection + + Command syntax: + + Arguments beginning with <, >, >>, %, %% do file + redirection, a la Unix. + (A < redirection must not have an unmatched '>' + in the file name.) + Arguments are separated by spaces. + Arguments may be surrounded by "s, in which case + embedded spaces are allowed and embedded + "s must be doubled. + ^V and \ both prohibit the special interpretation of + the next character (i.e., space, ", <, >, %) + A \ is eaten, a ^V is left in the string unless it + is followed by a - or a ?. + +**********************************************************************/ + +int pjflag = TRUE; /* set to false in binary file to suppress parsing */ +int riflag = TRUE; /* set to false in binary file to suppress redirect */ + /* of primary I/O; pjflag false also suppresses it */ + +static int parse (in, av) +register char *in, *av[]; +{ + register int ac; + register char *out; + + ac = 0; + out = in; + append = errappend = FALSE; + sinfn = soutfn = serrfn = NULL; + + if (!pjflag) { /* don't parse (except hack ^V, \ as usual) */ + register int c; + av[0] = out; + while (TRUE) { /* get program name */ + c = *in++; + if (c == ' ' || c == 0) break; + *out++ = c; + } + *out++ = 0; + ac++; + while (c == ' ') c = *in++; + av[1] = out; + while (c) { /* get rest of line */ + if (c == QUOTE) { + c = *in++; + if (c != '?' && c != '-') *out++ = QUOTE; + } + else if (c == ARGQUOTE) c = *in++; + *out++ = c; + c = *in++; + } + if (out != av[1]) ac++; + return (ac); + } + while (TRUE) { + int quoteflag, firstch, secondch; + register int c; + register char *s; + + quoteflag = FALSE; + + /* find beginning of next arg */ + + c = *in++; + while (c == ' ') c = *in++; + if (c == 0) break; + if (c == '"') { + quoteflag = TRUE; + c = *in++; + } + if (c == 0) break; + firstch = c; /* \< should not be special */ + secondch = *in; /* >\> should not be special */ + av[ac] = s = out; + + /* scan arg */ + + while (TRUE) { + if (c == 0) break; + if (quoteflag) { + if (c == '"') { + c = *in++; + if (c != '"') break; + } + } + else if (c == ' ') break; + if (c == QUOTE || c == ARGQUOTE) { + if (c == QUOTE) { + c = *in++; + if (c != '?' && c != '-') + *out++ = QUOTE; + } + else c = *in++; + if (c == 0) break; + } + *out++ = c; + c = *in++; + } + + *out++ = 0; + + /* check for redirection command */ + + if (ac == 0 || !riflag) firstch = -1; + switch (firstch) { + case '<': { /* if there is a matching '>' then this */ + /* is not a redirection command */ + register char *p, t; + int level; + p = s + 1; + level = 0; + while (t = *p++) { + if (t == QUOTE && *p) { + ++p; + continue; + } + if (t == '<') ++level; + if (t == '>') { + if (level == 0) break; /* unmatched */ + --level; + } + } + if (s[1] && (t != '>')) sinfn = s+1; + else if (++ac < MAXARG) av[ac] = out; + } + break; + case '>': + if (secondch == '>') { + if (s[2]) { + soutfn = s + 2; + append = TRUE; + } + } + else { + if (s[1]) { + soutfn = s + 1; + append = FALSE; + } + } + break; + case '%': + if (secondch == '%') { + if (s[2]) { + serrfn = s + 2; + errappend = TRUE; + } + } + else { + if (s[1]) { + serrfn = s + 1; + errappend = FALSE; + } + } + break; + default: + /* normal argument */ + if (++ac < MAXARG) av[ac] = out; + } + + if (c == 0) break; + } + return (ac > MAXARG ? MAXARG : ac); +} + +/********************************************************************** + + SETIO - Setup standard I/O + +**********************************************************************/ + +static setio () +{ + register FILE *f; + closall (); + if (sinfn) { /* input is redirected */ + fix_primary_io (stdin, f = eopen (sinfn, "r")); + if (f == NULL) sinfn = 0; + } + if (!sinfn) fix_primary_io (stdin, eopen ("", "r")); + if (soutfn) { /* output is redirected */ + f = eopen (soutfn, append ? "a" : "w"); + fix_primary_io (stdout, f); + if (f == NULL) { + errout ("Can't open specified output file."); + soutfn = 0; + } + } + if (!soutfn) fix_primary_io (stdout, eopen ("", "w")); + if (serrfn) /* errout is redirected */ + {f = eopen (serrfn, errappend ? "a" : "w"); + fix_primary_io (stderr, f); + if (f == NULL) { + errout ("Can't open specified error file."); + serrfn = 0; + } + } + if (!serrfn) fix_primary_io (stderr, fopen ("", "w")); +} + +/********************************************************************** + + EOPEN - Open with error message + +**********************************************************************/ + +static FILE *eopen (name, mode) +char *name, *mode; +{ + register FILE *f; + + f = fopen (name, mode); + if (f == NULL) { + errout ("Unable to "); + if (*mode != 'r') errout ("write"); + else errout ("read"); + errout (" '"); + errout (name); + errout ("'\r\n"); + } + return (f); +} + +/********************************************************************** + + ERROUT - Write error message + +**********************************************************************/ + +static errout (s) +char *s; +{ + _PSOUT (mkbptr (s)); +} + +/********************************************************************** + + MKBPTR - Make byte pointer from string + +**********************************************************************/ + +int mkbptr (p) +int p; +{ + return (consbp (36, p)); +} + +/**************************************************************** + + CONSBP - Make byte pointer given byte size and buffer address + +****************************************************************/ + +int consbp (bs, bp) +int bs, bp; +{ + return (halves (0440000 + (bs << 6), bp)); +} + +/********************************************************************** + + DO_OPTIONS - Process mode and options. Set direction, + ftype, append, and byte size flags. + +**********************************************************************/ + +static int do_options (opt, pdirection, pftype, + pappend, pnew, pthaw, pbsize) +register char *opt; +int *pdirection, *pftype, *pappend, *pnew, *pthaw, *pbsize; + + { + register char *c,ch; + register int x; + char mode; + + mode = *opt++; /* pick off first char for mode */ + + if (mode < 'A' || mode > 'z') mode = 'r'; + c = opt; + x = 0; + if (c < (char *)0100 || c >= (char *) halves (1, 0)) opt = ""; + else { + while (*opt >= '0' && *opt <= '9') + x = x * 10 + (*opt++ - '0'); + if (x < 1 || x > 36) x = 0; /* ignore bad value */ + if (opt[0]<'A' || opt[0]>'z') opt = ""; + } + + *pdirection = FREAD; + *pappend = FALSE; + *pnew = FALSE; + *pthaw = FALSE; + *pftype = FTEXT; + *pbsize = 7; + switch (isupper(mode) ? tolower(mode) : mode) { + case 'a': *pappend = TRUE; *pdirection = FWRITE; + break; + case 'b': *pnew = TRUE; *pdirection = (FREAD | FWRITE); + break; + case 'w': *pnew = TRUE; *pdirection = FWRITE; + break; + case 'm': *pthaw = TRUE; /* fall through */ + case 'u': *pdirection = (FREAD | FWRITE); + default: break; + } + while (ch = *opt++) { + switch (isupper(ch) ? tolower(ch) : ch) { + case 'b': + *pftype = FBIN; + *pbsize = 36; + break; + case 's': + *pftype = FSTR; + break; + } + } + if (x) *pbsize = x; +} + +/********************************************************************** + + CHANLIST - List of open channels. + +**********************************************************************/ + +static FILE *chanlist; + +static FILE *channel_allocate () +{ + register FILE *p; + + p=(FILE *) malloc(sizeof(struct _file)); /* presumed zeroed */ + p->next = chanlist; + chanlist = p; + p->devtype = -1; /* for istty optimization */ + return (p); +} + +static channel_free (p, bfree) +register FILE *p; +{ + register FILE *q, **qq; + + qq = &chanlist; + q = *qq; + while (q) { + if (q == p) { + *qq = p->next; /* unchain */ + if (bfree) { + if (p->buf) pg_ret (p->buf); + if (p->ubuf) free (p->ubuf); + } + if (p != stdin && p != stdout && p != stderr) + free (p); + break; + } + qq = &q->next; + q = *qq; + } +} + +static fix_primary_io (statptr, dynptr) +FILE *statptr, * dynptr; +{ + register FILE *q, **qq; + if (dynptr == NULL) return; + blt (dynptr, statptr, sizeof (*statptr)); + channel_free (dynptr, FALSE); + statptr->next = chanlist; + chanlist = statptr; +} + +/********************************************************************** + + CLOSALL + +**********************************************************************/ + +closall () +{ + while (chanlist) fclose (chanlist); +} + +/********************************************************************** + + CISFD - is p a pointer to a FILE block? + +**********************************************************************/ + +int cisfd (p) +FILE *p; +{ + register FILE *q; + + q = chanlist; + while (q) { + if (q == p) return (TRUE); + q = q->next; + } + return (FALSE); +} + +/********************************************************************** + + FILE MANIPULATION ROUTINES + + rename (file1, file2) - rename file1 to file2 + delete (file) - delete file, do not expunge + unlink (file) - delete and expunge file + fileno (p) - return jfn of a file opened with fopen + tmpnam () - return a filename usable as a temp file + +**********************************************************************/ + +/********************************************************************** + + RENAME (file1, file2) + + Should work even if a file2 already exists. + Return 0 if no error. + + *TOPS-20 VERSION* + +**********************************************************************/ + +int rename (s1, s2) +char *s1, *s2; +{ + register int jfn1, jfn2, rc; + char buf1[100], buf2[100]; + + fnstd (s1, buf1); + fnstd (s2, buf2); + jfn1 = _GTJFN (halves (0100001, 0), mkbptr (buf1)); /* old file */ + if (jfn1 >= 0600000) return (jfn1); + jfn2 = _GTJFN (halves (0400001, 0), mkbptr (buf2)); /* new file */ + if (jfn2 >= 0600000) return (jfn2); + if (rc = _RNAMF (jfn1, jfn2)) { + _RLJFN (jfn1); + _RLJFN (jfn2); + return (rc); + } + _RLJFN (jfn2); + return (0); +} + +/********************************************************************** + + DELETE + +**********************************************************************/ + +delete (s) +char *s; +{ + register int jfn; + char buf[100]; + fnstd (s, buf); + jfn = _GTJFN (halves (0100001, 0), mkbptr (buf)); /* old file */ + if (jfn < 0600000) { + _DELF (halves(0, jfn)); + _CLOSF (jfn); + } +} + +/********************************************************************** + + UNLINK - delete and expunge + +**********************************************************************/ + +unlink (s) +char *s; +{ + register int jfn; + char buf[100]; + fnstd (s, buf); + jfn = _GTJFN (halves (0100001, 0), mkbptr (buf)); /* old file */ + if (jfn < 0600000) { + _DELF (halves(0200000, jfn)); + } +} + +/********************************************************************** + + FILENO - Return JFN of file. + +**********************************************************************/ + +int fileno (p) +FILE *p; +{ + return (p->jfn); +} + +/********************************************************************** + + TMPNAM - fills *bp with a file name usable as a temp file. + The name will point to the default device and + directory. The length of the name is limited to + < 50 characters. + +**********************************************************************/ + +char *tmpnam(bp) +char *bp; +{ + register char *p; + char *username(); + + sprintf(bp,"%d%s",_hptim(0),username()); + for (p = bp ; (*p != '\0') && (p < bp+39) ; p++) + if (*p == '.') *p = '_'; + strcpy (p,".tmp;t"); + return (bp); +} + +/********************************************************************** + + STRING ROUTINES + +**********************************************************************/ +/* these routines are all in the file C20STR.MID, having been written */ +/* in assembly for speed */ + +#ifdef STRINGROUTINES + +strcpy (dest, source) +register char *dest, *source; +{ + while (*dest++ = *source++); + *dest = 0; +} + +strcmp (s1, s2) +register char *s1, *s2; +{ + register char c1, c2; + while ((c1 = *s1++) == (c2 = *s2++) && c1); + if (c1 < c2) return (-1); + else if (c2 == 0) return (0); + else return (1); +} + +strcat (dest, source) +register char *dest; +register char *source; +{ + while (*dest) ++dest; + while (*dest++ = *source++); + *dest = 0; +} + +int strlen (s) +char *s; +{ + register char *e; + e = s; + while (*e) ++e; + return (e - s); +} + +#endif STRINGROUTINES + +/********************************************************************** + + OTHER ROUTINES + +**********************************************************************/ + +int getuid () +{ + int un; + register int *x; + x = &un; + _GJI (-1, halves (0777777,((int)x)), 2); + /* GETJI - read user number */ + return (un); + } + + +char *getpw (un, buf) + char *buf; +{ + _DIRST (mkbptr (buf), un); + return (buf); +} + +/********************************************************************** + + USERNAME - return ptr to a buffer containing username + +**********************************************************************/ + +char *username () +{ + static char buffer[40]; + register int *p; + int un; + + p = &un; + p = (int *)((int) p | halves(0777777,0)); + _GJI (-1, p, 2); /* GETJI - read user number */ + _DIRST (mkbptr (buffer), un); + return (buffer); +} + +/********************************************************************** + + VALRET - return "command string" to superior + +**********************************************************************/ + +# ifdef TOPS20 +valret (s) char *s; +{ + _RSCAN (mkbptr (s)); /* put string in RSCAN buffer */ + _RSCAN (0); /* attach RSCAN buffer to terminal input */ + _HALTF (); /* return control to superior */ +} +# endif TOPS20 + +/********************************************************************** + + SLEEP - go to sleep for n seconds + +**********************************************************************/ + +sleep (nsec) +{ + _DSMS (nsec * 1000); +} diff --git a/c20/new/lib/c20lib.cmid b/c20/new/lib/c20lib.cmid new file mode 100644 index 00000000..9b471c32 --- /dev/null +++ b/c20/new/lib/c20lib.cmid @@ -0,0 +1,28 @@ +; +; c20lib- random tops-20 midas stuff +; + +title c20lib +.insrt c:minsrt + +centry wfnz,[ptr] ; wait for word to become non-zero + +wfnz1: move a,ptr + skipe (a) + jrst wfnz2 + movei a,20. + disms + jrst wfnz1 +wfnz2: return + +centry wfz,[ptr] ; wait for word to become zero + +wfz1: move a,ptr + skipn (a) + jrst wfz2 + movei a,20. + disms + jrst wfz1 +wfz2: return + +end diff --git a/c20/new/lib/c20lod.cmid b/c20/new/lib/c20lod.cmid new file mode 100644 index 00000000..18c6aaf2 --- /dev/null +++ b/c20/new/lib/c20lod.cmid @@ -0,0 +1,82 @@ +; +; c20lod - load-time initialization (tops20) +; + +title c20lod +.insrt c:minsrt + +.global timing,pzero,pushd + +.idata +; no literals in this code! + +mdata linit + + movei p,$argv" ; temporary pdl + +mdata istart + + jfcl + + ; setup segment boundaries + + hlrz a,20 + movem a,seg0lo + hrrz a,20 + movem a,seg0hi + setzm 20 + hlrz a,21 + movem a,seg1lo + hrrz a,21 + movem a,seg1hi + setzm 21 + hlrz a,22 + movem a,seg2lo + hrrz a,22 + movem a,seg2hi + setzm 22 + hlrz a,23 + movem a,seg3lo + hrrz a,23 + + hrrz b,23+1 ; on tops-20, the symbol table + ; is written as segment 4. at run time, + ; however, we prefer to consider the + ; symbol table to be part of segment 3. + caml b,a ; in case the symbol table is written other + ; than where we expect (possible in the case + ; of a shared library), then make sure that + ; seg3hi is not decreased. + move a,b + movem a,seg3hi + setzm 23 + setzm 24 + + jfcl + setzb a,0 + setzb b,c ; clean up + setz d, ; like a good boy should + haltf ; return to loader + +; these variables contain the segment boundaries in the dumped program + +.idata +mdata seg0lo + 0 +mdata seg0hi + 0 +mdata seg1lo + 0 +mdata seg1hi + 0 +mdata seg2lo + 0 +mdata seg2hi + 0 +mdata seg3lo + 0 +mdata seg3hi + 0 + +.code +end diff --git a/c20/new/lib/c20mem.c b/c20/new/lib/c20mem.c new file mode 100644 index 00000000..838defce --- /dev/null +++ b/c20/new/lib/c20mem.c @@ -0,0 +1,708 @@ +# include + +/************************************************************************ + +ALLOC - C Dynamic Storage Management Package for Single Section TOPS-20 + + This code was written by Alan Snyder and Eliot B. Moss. Modified + for the Standard I/O Library by John Wroclawski + + This package implements allocation and freeing of variable sized blocks + of free storage. A modified buddy system is used, with provision for + allocating page sized units on page boundaries so that page mapping may + be done. + + p = malloc (n) allocates a block n "sizeof's" long + (e.g., malloc (sizeof (foo))). Unlike + UNIX malloc, the memory is zeroed. + + p = calloc (num, size) allocates a block of storage for an + array of num elements of size "size" + + free (p) returns blocks to storage + + + q = realloc (p, n) returns a pointer to a block of size n + with q[0] == p[0] ... p[k] == q[k], + where k = min (n, length (p)) (p is a + previously allocated block) q == p if + n <= length (p) + + n = pg_size () returns the size of a page + p = pg_get (n) returns the address of a newly allocated block + of pages + pg_ret (p) frees a previously allocated block of pages + + nwfree = alocstat (&nwalloc, &nbfree); + returns statistics + + n = alocflush () flushes pages not in use; returns number + of words saved + + + Additionally, a global variable, nocore, is provided, which + contains (a pointer to) the procedure to invoke when memory runs + out (this could trigger garbage collection, if the user programs + it). The normal function is to ignore the situation, the allocator + will then return NULL. + + Theory of operation: + + Sizes less than a page long are treated separately from larger + sizes. One reason is that in order to support page mapping, + information concerning allocated blocks of page size and larger is kept + in a separate array. On the other hand, there are potentially much too + many small objects to do that, so one word of each object keeps the + necessary size and link information. + We modify the basic buddy system by allocating blocks of size + halfway between powers of two as well as the usual powers of two. This + should result in less external fragmentation than the powers-of-two + buddy system, with no ill effects. A block that is a power of two in + size may be split in the ratios 3:1 or 2:2, and one that is a multiple + of 6 in size may be split 4:2 or 3:3. + For sizes less than a page, a header word is used to store + information necessary for putting blocks back together, etc. This + includes a code indicating the size of the block, whether it is the + left or right member of a pair, and the ratio of the sizes of the + members of the pair. In addition it is necessary for the right member + to save the old values of the flags for the left member (i.e., the + values before the pair was split). Here is the encoding of the header + words for blocks less than a page in size; the numbers in parentheses + indicate the widths of the fields, in bits: + + magic (18), unused (5), free (1), oflags (3), flags (3), size (6) + + The size is actually an index into a table of standard sizes; there are + 19 of them. The flags are encoded as three separate bits: + + even split: 1 <=> ratio was 1:1 + right sibling: 1 <=> this is a right hand member of a pair + (i.e., the one with the higher address) + parent-power-of-two: 1 <=> size of parent block was power of 2 + + The free flag indicates whether the block is free or not. The magic + number value is the address of the block XORed with a magic number; it + is checked in the freeing routines, for consistency. + + Free blocks are doubly linked, using the second word. The forward link + is in the right half, and the back link in the left half. + + Blocks a page or more in size do not have the information stored + directly in the block, but in a separate array, so the whole block can + be used for page mapping. Here is the layout of bits for them: + + prev page (9), next page (9), unused (4), + exists (1), free (1), oflags (3), flags (3), size (6) + + The exists bit is not currently used on TOPS-20. + +************************************************************************/ + +/* Page size and shift amount constants */ + +# define PGSIZE 512 +# define PGLOG2 9 +# define NSIZES 16 + +# define NPAGES (01000000 / PGSIZE) + +# define TSIZES 34 +# define BADSIZ (NSIZES + 1) + +/* Masks and shift amounts for usual header flags */ + +# define SIZMSK 077 +# define _RIGHT 0100 +# define _EVEN 0200 +# define _PP2 0400 +# define FLGMSK 0700 +# define FSHIFT 6 +# define OFLGMSK 07000 +# define OFSHIFT 3 +# define ISFREE 010000 +# define MAGIC 0732561 +# define MMASK halves (0777777, 0) +# define MSHIFT 18 +# define LMASK halves (0777777, 0) +# define RMASK 0777777 + +/* extra masks and shifts for blocks of page size and up */ + +# define PPREVMSK halves (0777000, 0) +# define PNEXTMSK halves (0000777, 0) +# define PNSHIFT 18 +# define PPSHIFT 27 +# define PEXISTS 020000 + +static unsigned blksiz[] = { + 2, 3, 4, 6, 8, 12, 16, + 24, 32, 48, 64, 96, 128, 192, + 256, 384, 512, 0, 1024, 1536, 2048, + 3072, 4096, 6144, 8192, 12288, 16384, 24576, + 32768, 49152, 65536, 98304, 131072, 196608 }; + +static unsigned free_blks[TSIZES]; +static unsigned page_info[NPAGES]; + +/* this table is for quick size lookup */ + +static int iblksiz[] = { + 0, 0, 1, 2, 3, 3, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, + 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, + 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12 }; + +# define TRUE 1 +# define FALSE 0 + +/* forward references */ + +static int *split(), psplit(), *palloc(); + +/* links to runtime package */ + +# rename lowlim "LOWLIM" +# rename highlim "HILIM" + +extern int lowlim, highlim; + +ainit () +{ + register int i, n, p; + + fill (free_blks, TSIZES, 0); + fill (page_info, NPAGES, 0); + p = lowlim; + n = highlim - lowlim; + i = TSIZES - 1; + while (n > 0) { + register unsigned num; + while ((num = blksiz[i] >> PGLOG2) > n || num == 0) --i; + page_info[p] = ISFREE | i; + free_blks[i] = p; + p += num; + n -= num; + } +} + +static alose (s) +char *s; +{ + register int p; + p = halves (0444400, ((int) s)); + while (TRUE) { + _PSOUT (p); + _HALTF (); + } +} + +static int *alloc (n) +register int n; +{ + register int s, ns, w, *p, *q; + /* eliminate bad arguments */ + if (n <= 0 || n > blksiz[TSIZES-1]) return (NULL); + /* find block size, quickly */ + for (s = 0; n > 128; n = (n + 63) / 64) s += 12; + s += iblksiz[--n]; + if (s >= NSIZES) { /* handle page size and up */ + if (blksiz[s] == 0) ++s; + if (p = palloc (s, TRUE)) + *p = (((n = (int) p) ^ MAGIC) << MSHIFT) | s; + return (p); + } + ns = s; + while (!(p = (int *) free_blks[ns])) + if (++ns >= NSIZES) { + /* get a page and put it on the special free list */ + if (!(p = palloc (NSIZES, TRUE))) return (0); + n = (int) p; + *p = ((n ^ MAGIC) << MSHIFT) | ISFREE | NSIZES + | (page_info[n >> PGLOG2] & (OFLGMSK | FLGMSK)); + p[1] = 0; + goto skip; + } + if (q = free_blks[ns] = (p[1] & RMASK)) q[1] &= RMASK; +skip: while (TRUE) /* split down as far as necessary ... */ + switch (ns - s) { + case 0: *p &= ~ISFREE; + return (p); + + case 1: if (ns > 2) { + /* 3:1 or 2:1 split */ + --ns; + split (p, ns, (ns - 2) - (ns & 1), TRUE); + continue; + } + ns = s; /* special case: can't split */ + continue; + + even: + case 2: ns -= 2; + split (p, ns, ns, TRUE); + continue; + + case 3: if (!(ns & 1)) goto even; + default: + --ns; + p = split (p, ns, (w = (ns - 2) - (ns & 1)), FALSE); + ns = w; + continue; + + } +} + +static int *split (p, s1, s2, first) +register int *p; +{ + /* split p into two blocks with size codes s1 and s2, returning */ + /* first one if first is TRUE, otherwise second one. Block not */ + /* returned is put on correct free list. Note: s1 >= s2. */ + + register int s, x, w, n, *q, *qq, *q2; + q2 = p + blksiz[s1]; + x = 0; + if (s1 == s2) x |= _EVEN; + if (!((w = *p) & 1)) x |= _PP2; + n = (int) q2; + *q2 = ((n ^ MAGIC) << MSHIFT) | ISFREE | ((w & FLGMSK) << OFSHIFT) + | x | _RIGHT | s2; + *p = (w & ~(FLGMSK | SIZMSK)) | x | s1; + if (first) q = q2; + else { + q = p; + p = q2; + } + s = (*q) & SIZMSK; + if (qq = q[1] = free_blks[s]) qq[1] |= ((n = (int) q) << 18); + free_blks[s] = (int) q; + return (p); +} + +static all_gone () {} /* dummy routine to execute if no more core */ + +int (*nocore)() = all_gone; + +static int *palloc (s, must_exist) +{ + register int ns, v, w; + ns = s; + while (!(v = free_blks[ns])) + if (++ns >= TSIZES) { + (*nocore)(); + return (0); + } + if (free_blks[ns] = w = ((page_info[v] & PNEXTMSK) >> PNSHIFT)) + page_info[w] &= ~PPREVMSK; + while (TRUE) /* split down as far as necessary ... */ + switch (ns - s) { + case 0: page_info[v] &= ~(ISFREE | PPREVMSK | PNEXTMSK); + return ((int *)(v << PGLOG2)); + + case 1: --ns; /* 3:1 or 2:1 split */ + psplit (v, ns, (ns - 2) - (ns & 1), TRUE); + continue; + + even: /* even split */ + case 2: ns -= 2; + psplit (v, ns, ns, TRUE); + continue; + + case 3: if (!(ns & 1)) goto even; + default: /* 3:1 or 2:1 split */ + --ns; + v = psplit (v, ns, (w = (ns - 2) - (ns & 1)), FALSE); + ns = w; + continue; + + } +} + +static int psplit (v, s1, s2, first) +{ + /* split v into two blocks with size codes s1 and s2, returning */ + /* first one if first is TRUE, otherwise second one. Block not */ + /* returned is put on correct free list. Note: s1 >= s2. */ + + register int s, x, w, ww, w2; + w2 = v + (blksiz[s1] >> PGLOG2); + x = 0; + if (s1 == s2) x |= _EVEN; + if (!((ww = page_info[v]) & 1)) x |= _PP2; + page_info[w2] = ((ww & FLGMSK) << OFSHIFT) | ISFREE | x | _RIGHT | s2; + page_info[v] = (ww & (OFLGMSK | PEXISTS)) | ISFREE | x | s1; + if (first) w = w2; + else {w = v; + v = w2; + } + s = page_info[w] & SIZMSK; + if (ww = free_blks[s]) + {page_info[ww] |= (w << PPSHIFT); + page_info[w] |= (ww << PNSHIFT); + } + free_blks[s] = w; + return (v); +} + +free (p) +register int *p; +{ + register int n; + register unsigned w, ww; + + --p; + if ((w = *p) & ISFREE) + alose ("FREE: Block Already Free"); + if (((w >> MSHIFT) ^ (n = (int) p)) != MAGIC) { + alose ("FREE: Bad Block Header"); + } + *p |= ISFREE; + while (TRUE) { + int bs, s, *q; + if ((s = (w & SIZMSK)) >= NSIZES) { /* page or bigger ? */ + pfree (p, FALSE); + return; + } + + if (w & _RIGHT) { /* find buddy */ + if (w & _EVEN) bs = s; + else if (w & _PP2) bs = s + 3; + else bs = s + 2; + q = p - blksiz[bs]; + } + else { + q = p + blksiz[s]; + if (w & _EVEN) bs = s; + else bs = (s - 2) - (s & 1); + } + + /* to merge, buddy must be free and right size */ + if (((ww = *q) & ISFREE) && ((ww & SIZMSK) == bs)) { + register int *qq, *prev; + + ww = q[1]; + q[1] = 0; + if (qq = (int *) (ww & RMASK)) { + qq[1] &= RMASK; + qq[1] |= (ww & LMASK); + } + if (prev = (int *) (ww >> 18)) { + prev[1] &= LMASK; + prev[1] |= (n = (int) qq); + } + else free_blks[bs] = (int) qq; + + if (w & _RIGHT) { /* swap so p is first */ + qq = p; p = q; q = qq; + s = bs; + w = *p; + } + + if (w & _EVEN) bs = s + 2; /* new size, etc. */ + else bs = s + 1; + *p = w = (w & (LMASK | OFLGMSK)) | ISFREE | bs + | (((*q) & OFLGMSK) >> OFSHIFT); + } + else { + if (q = p[1] = free_blks[s]) + q[1] |= ((n = (int) p) << 18); + free_blks[s] = (int) p; + return; + } + } +} + +static pfree (p, unmap) +int *p; +{ + register int m, w, s; + + if ((m = (int) p) & (PGSIZE - 1)) + alose ("PFREE: Not On A Page Boundary"); + if ((w = page_info[m >>= PGLOG2]) & ISFREE) + alose ("PFREE: Block Already Free"); + w = (page_info[m] |= ISFREE); + if (unmap) expunge_pages (m, blksiz[w & SIZMSK] >> PGLOG2); + while (TRUE) { + register int n, ww, bs; + s = w & SIZMSK; + + /* see where buddy would be and see if buddy exists */ + if (w & _RIGHT) { + if (w & _EVEN) bs = s; + else if (w & _PP2) bs = s + 3; + else bs = s + 2; + if (bs >= TSIZES + || (n = m - (blksiz[bs] >> PGLOG2)) < lowlim) + break; /* no buddy -- don't merge */ + } + else { + if (w & _EVEN) bs = s; + else bs = (s - 2) - (s & 1); + n = m + (blksiz[s] >> PGLOG2); + if ((n + (blksiz[bs] >> PGLOG2)) > highlim) break; + } + + /* merge if buddy is free and correct size */ + if (((ww = page_info[n]) & ISFREE) && ((ww & SIZMSK) == bs)) { + register unsigned nn, prev, next; + + page_info[n] &= ~(PPREVMSK | PNEXTMSK); + prev = ww & PPREVMSK; + next = ww & PNEXTMSK; + if (nn = (next >> PNSHIFT)) { + page_info[nn] &= ~PPREVMSK; + page_info[nn] |= prev; + } + if (prev >>= PPSHIFT) { + page_info[prev] &= ~PNEXTMSK; + page_info[prev] |= next; + } + else free_blks[bs] = nn; + + if (w & _RIGHT) { /* swap so m is first */ + nn = m; m = n; n = nn; + s = bs; + w = page_info[m]; + } + + /* calculate new size, update page_info */ + if (w & _EVEN) bs = s + 2; + else bs = s + 1; + page_info[m] = w = + (w & ~(FLGMSK|SIZMSK)) | ISFREE | bs + | ((page_info[n] & OFLGMSK) >> OFSHIFT); + } + else break; + } + if (w = free_blks[s]) { + page_info[w] |= (m << PPSHIFT); + page_info[m] &= ~(PPREVMSK | PNEXTMSK); + page_info[m] |= (w << PNSHIFT); + } + free_blks[s] = m; +} + +int *malloc (n) +{ + register int *p; + if (!(p = alloc (n + 1))) + if (!(p = alloc (n + 1))) + return (NULL); + fill (++p, n, 0); + return (p); +} + +char *calloc (num,size) +int num,size; +{ + register char *p; + int n; + + n = size * num; + if (!(p = alloc (n + 1))) + if (!(p = alloc (n + 1))) + return (NULL); + fill (++p,n,0); + return (p); +} + +int *realloc (p, n) +register int *p; +{ + register int ns, s, ww, l1, l2, *q; + register unsigned w; + ++n; /* get real size and real address */ + --p; + + /* consistency checks */ + if (n < 0 || n > blksiz[TSIZES-1]) return (0); + if ((w = *p) & ISFREE) alose ("REALLOC: Block Is Free"); + if (((w >> MSHIFT) ^ (ww = (int) p)) != MAGIC) + alose ("REALLOC: Bad Block Header"); + + /* get current and desired size codes */ + s = w & SIZMSK; + ww = n; + for (ns = 0; ww > 128; ww = (ww + 63) / 64) ns += 12; + ns += iblksiz[--ww]; + if (blksiz[ns] == 0) ++ns; + if (s == ns) return (++p); + else if (ns < s) { + /* can we alloc and copy over more cheaply ? */ + w = ns; + while (!free_blks[w]) + if (++w >= s) goto keep; + goto new; + + /* split and return part */ +keep: if (s > NSIZES) { + if (ns >= NSIZES) { + prealloc (p, s, ns); + return (++p); + } + prealloc (p, s, NSIZES); + s = NSIZES; + } + while (TRUE) + switch (s - ns) { + + case 0: *p &= ~ISFREE; + return (++p); + + case 1: if (ns <= 1) ns = s; + else { + --s; + split (p, s, (s - 2) - (s & 1), TRUE); + } + continue; + + default: + s -= 2; + split (p, s, s, TRUE); + continue; + } + } + +new: if (!(q = alloc (n))) + if (!(q = alloc (n))) + return (NULL); + l1 = blksiz[s]; + l2 = blksiz[ns]; + if (ns < s) + blt (p + 1, q + 1, l2 - 1); + else { + blt (p + 1, q + 1, l1 - 1); + fill (q + l1, l2 - l1, 0); + } + free (p); + return (++q); +} + +static prealloc (p, s, ns) +register int *p; +{ + register unsigned pp; + pp = (pp = (int) p) >> PGLOG2; + while (TRUE) + switch (s - ns) { + + case 0: *p &= MMASK; + *p |= (page_info[pp] &= ~(ISFREE|PPREVMSK|PNEXTMSK)); + return; + + uneven: + case 1: --s; + psplit (pp, s, (s - 2) - (s & 1), TRUE); + continue; + + even: + default: + case 2: s -= 2; + psplit (pp, s, s, TRUE); + continue; + + case 3: if (ns == NSIZES) goto uneven; + else goto even; + } +} + +int pg_size () {return (PGSIZE);} + +int *pg_get (n) +{ + register int ns; + if (n <= 0 || n > (3 * NPAGES) / 4) return (NULL); + n <<= (PGLOG2 - 6); + for (ns = 12; n > 128; n = (n + 63) / 64) ns += 12; + ns += iblksiz[--n]; + if (blksiz[ns] == 0) ++ns; + n = ns; + while (!free_blks[n]) + if (++n >= TSIZES) + return (NULL); + return (palloc (ns, FALSE)); +} + +pg_ret (p) +int *p; +{ + pfree (p, TRUE); +} + +int alocstat (pnalloc, pnbfree) +register int *pnalloc, *pnbfree; +{ + register int pn; + int wfree; + pn = lowlim; + wfree = *pnalloc = *pnbfree = 0; + while (pn < highlim) { + register int pcode, sz; + sz = blksiz[(pcode = page_info[pn]) & SIZMSK]; + if (pcode & ISFREE) { + (*pnalloc) += sz; + wfree += sz; + ++(*pnbfree); + } + else { + (*pnalloc) += sz; + if (sz == PGSIZE) + scan_page (pn << PGLOG2, &wfree, pnbfree); + } + pn += (sz >> PGLOG2); + } + return (wfree); +} + +static scan_page (p, pwfree, pfreeb) +register int *p, *pwfree, *pfreeb; +{ + register int *q, sz; + register unsigned hdr; + if (p != (q = ((hdr = *p) >> MSHIFT) ^ MAGIC)) return; + q = p + PGSIZE; + while (p < q) { + p += (sz = blksiz[(hdr = *p) & SIZMSK]); + if (hdr & ISFREE) { + (*pwfree) += sz; + ++(*pfreeb); + } + } +} + +int alocflush () +{ + register int pn, wfree; + pn = lowlim; + wfree = 0; + while (pn < highlim) { + register int pcode, sz; + sz = blksiz[(pcode = page_info[pn]) & SIZMSK] >> PGLOG2; + if (pcode & ISFREE) { + expunge_pages (pn, sz); + wfree += (sz << PGLOG2); + } + pn += sz; + } + return (wfree); +} + +static expunge_pages (start, count) +{ + _PMAP (-1, halves (0400000, start), halves (0400000, count)); +} + +static fill (start, count, val) +int *start, count, val; +{ + if (count > 0) { + *start = val; + if (--count > 0) blt (start, start + 1, count); + } +} + diff --git a/c20/new/lib/c20pip.cmid b/c20/new/lib/c20pip.cmid new file mode 100644 index 00000000..3b0babd8 --- /dev/null +++ b/c20/new/lib/c20pip.cmid @@ -0,0 +1,312 @@ +; +; C20PIP - TOPS-20 implementation of pipes using shared files +; +; The technique is to use a circular buffer within a shared file. The +; first few words of the file are set aside for interlocking purposes, +; with the reader and writer (there must be only one of each) each +; mapping a single page at a time. + +title c20pip +.insrt c:minsrt + +;; offsets into data structure + +o.jfn== 0 ;; jfn of file +o.hdr== 1 ;; pointer to header page +o.buf== 2 ;; pointer to buffer page +o.wrt== 3 ;; flag indicating direction +o.ptr== 4 ;; position +o.siz== 5 ;; total size + +;; offsets into header page + +p.size== 0 ;; total size of the file (always even pages) +p.free== 1 ;; number of free slots (for writer) +p.used== 2 ;; number of words avail to reader +p.flgs== 3 ;; flags + p%wcls== 1 ;; writer has closed + p%rcls== 2 ;; reader has closed +p.strt== 4 ;; first used word + +;; mkpipe () => return address of new structure + +centry mkpipe,[],[q] + ccall malloc,[[[o.siz]]] + movem a, q + setom o.jfn(a) + ccall pg%get,[[[1]]] + jumpe a, mk$bd1 + move b, q + movem a, o.hdr(b) + ccall pg%get,[[[1]]] + jumpe a, mk$bd2 + move b, q + movem a, o.buf(b) + move a, b + return +mk$bd2: move b, q + move b, o.hdr(b) + ccall pg%ret,[b] +mk$bd1: ccall free,[q] + movni a, 1 + return + +;; spipe (pipe, jfn, writing, size) +;; setup given pipe to use stated jfn and direction +;; size is size of pipe if writing, ignored if reading + +centry spipe,[pipe,jfn,writing,size] + move a, pipe + skipl o.jfn(a) ; should be in newly allocated state + jrst s$bad + move b, jfn + movem b, o.jfn(a) + skipe writing + jrst swrite + setzm o.wrt(a) +srtry: hrlz a, jfn + ffufp ; wait until page 0 exists + caia + jrst spmap + movei a, 100. ; wait for writer + disms + jrst srtry + +spmap: hrlz a, jfn ; map in first page + move b, pipe + move b, o.hdr(b) + lsh b, -9. + hrli b, .fhslf + movsi c, (pm%rd\pm%wr) ; read/write access + pmap + erjmp s$bad + move b, pipe + move b, o.buf(b) + lsh b, -9. + hrli b, .fhslf + pmap ; map to buffer slot, too + erjmp s$bad + move a, pipe + movei b, p.strt + movem b, o.ptr(a) + movei a, 1 + return + +swrite: setom o.wrt(a) + move b, o.hdr(a) + move c, size + addi c, 777 ; round up + trz c, 777 + movem c, p.size(b) ; init header + subi c, p.strt + movem c, p.free(b) + setzm p.used(b) + setzm p.flgs(b) + movei a, (b) ; map the page out + lsh a, -9. + hrli a, .fhslf + hrlz b, jfn + movsi c, (pm%rd\pm%wr) + pmap + erjmp s$bad + jrst spmap + +s$bad: movei a, 0 + return + +;; rdpipe (pipe, bp, max) +;; reads up to max units into given byte pointer +;; returns number read; must be > 0 unless eof + +centry rdpipe,[pipe,bp,max] + move a, pipe + skipn o.wrt(a) + skipg max + jrst rd$bad + movn c, o.ptr(a) ; how much left in current page ? + andi c, 777 + jumpn c, rdsome + move b, o.hdr(a) ; get next page + move c, o.ptr(a) + camge c, p.size(b) ; wrap around ? + jrst rnwrap + movei c, p.strt ; yes + movem c, o.ptr(a) +rnwrap: lsh c, -9. + move b, o.buf(a) + lsh b, -9. + hrli b, .fhslf + hrl a, o.jfn(a) + hrri a, (c) + movsi c, (pm%rd\pm%wr) + pmap + erjmp rd$bad + move a, pipe + move b, o.ptr(a) + andi b, 777 + movei c, 1000 + subi c, (b) +rdsome: camle c, max ; more than requested ? + move c, max + move b, o.hdr(a) ; see how much available +rdwait: skipe d, p.used(b) + jrst rdcont + movei a, p%wcls ; writer done ? + tdne a, p.flgs(b) + jrst rdeof ; yep ... + movei a, 100. ; wait a little + disms + move a, pipe + jrst rdwait + +rdcont: camle c, d ; min again + move c, d + move d, o.ptr(a) ; blt data + andi d, 777 + add d, o.buf(a) + hrli d, (d) + hrr d, bp ; get dest + add c, bp + blt d, -1(c) + sub c, bp + movn d, c + addm d, p.used(b) ; decrement amount used + addm c, p.free(b) ; increment amount free + addm c, o.ptr(a) ; bump pointer + movei a, (c) ; return amount transferred + return + +rdeof: tdza a, a ; got none +rd$bad: movni a, 1 + return + +;; wrpipe (pipe, bp, amt) +;; writes given amt to given pipe from byte pointer bp + +centry wrpipe,[pipe,bp,amt] +wrloop: move a, pipe + skipe o.wrt(a) + skipg amt + jrst wr$bad + movn c, o.ptr(a) ; how much left in current page ? + andi c, 777 + jumpn c, wrsome + move b, o.hdr(a) ; get next page + move c, o.ptr(a) + camge c, p.size(b) ; wrap around ? + jrst wnwrap + movei c, p.strt ; yes + movem c, o.ptr(a) +wnwrap: lsh c, -9. + move b, o.buf(a) + lsh b, -9. + hrli b, .fhslf + hrl a, o.jfn(a) + hrri a, (c) + movsi c, (pm%rd\pm%wr) + pmap + erjmp wr$bad + move a, pipe + move b, o.ptr(a) + andi b, 777 + movei c, 1000 + subi c, (b) +wrsome: camle c, amt ; more than requested ? + move c, amt + move b, o.hdr(a) ; see how much available +wrwait: skipe d, p.free(b) + jrst wrcont + movei a, p%rcls ; reader done ? + tdne a, p.flgs(b) + jrst wreof ; yep ... + movei a, 100. ; wait a little + disms + move a, pipe + jrst wrwait + +wrcont: camle c, d ; min again + move c, d + move d, o.ptr(a) ; blt data + andi d, 777 + add d, o.buf(a) + hrl d, bp + movei a, (d) + addi a, (c) + blt d, -1(a) + move a, pipe + movn d, c + addm d, p.free(b) ; decrement amount free + addm c, p.used(b) ; increment amount used + addm c, o.ptr(a) ; bump pointer + addm c, bp ; update count and buffer pointer + addb d, amt + jumpn d, wrloop ; loop for more ? + movei a, 1 ; return ok + return + +wreof: tdza a, a ; got none +wr$bad: movni a, 1 + return + +;; clpipe (pipe) +;; closes the indicated pipe + +centry clpipe,[pipe] + move a, pipe + movei c, p%rcls + skipe o.wrt(a) + movei c, p%wcls + move b, o.hdr(a) + iorb c, p.flgs(b) + trc c, p%rcls\p%wcls + trnn c, p%rcls\p%wcls ; are we second to close ? + jrst clkill + push p, pipe + pushj p, cunmap ; no, unmap and close + pop p, a + move a, o.jfn(a) + closf + jrst cl$bad +clclr: move a, pipe + move a, o.hdr(a) + ccall pg%ret,[a] + move a, pipe + move a, o.buf(a) + ccall pg%ret,[a] + ccall free,[pipe] + movei a, 1 + return + +clkill: push p, pipe + pushj p, cunmap ; unmap pages + pop p, a + move a, o.jfn(a) + hrli a, (co%nrj) ; don't release jfn + closf + jrst cl$bad + hrli a, (df%exp) + delf ; delete and expunge file + jrst cl$bad + jrst clclr + +cunmap: movni a, 1 ; unmap pages from fork + move b, -1(p) ; get pipe pointer + move b, o.hdr(b) + lsh b, -9. + hrli b, .fhslf + movei c, 0 + pmap + erjmp cl$bd1 + move b, -1(p) + move b, o.buf(b) + lsh b, -9. + hrli b, .fhslf + pmap + erjmp cl$bd1 + popj p, +cl$bd1: pop p, a ; flush inner return address + pop p, a ; and argument +cl$bad: movei a, 0 + return + +end diff --git a/c20/new/lib/c20prt.c b/c20/new/lib/c20prt.c new file mode 100644 index 00000000..8b59723c --- /dev/null +++ b/c20/new/lib/c20prt.c @@ -0,0 +1,349 @@ +# include + +/* + PRINT - C Formatted Print Routine + Extendable Format Version: + Print Routines should expect the following + arguments (n specified when defined): + 1 to n: n data arguments + n+1: file descriptor + n+2: field width (0 if none given) + n+3: pad character + + Format options: (upper case treated identically) + %s string + %c character + %o octal + %d decimal + %u unsigned (= decimal) + %x hexadecimal + %f F format floating point (without exponent, if poss) + %e E format floating point (always with exponent) + %z Like %c except repeat characters width times + If number preceeds format char (as in %4d) then number will be + minimum field width in which the argument appears. If the + number is followed by a '.' and another number, that number is + the precision (max # chars from a string, # digits to right of + decimal point in floating point numbers). + A positive field width will right justify the arg. + A negative field width will left justify. + + If a 0 immediately follows the %, then the pad character is + changed to 0 (instead of space). If the next character after the + 0 is not a digit, then the pad character is changed to that character. + For example: + %09d -- zero pad, width nine. -- 000000312 + %0*9d -- pad with *, width nine -- ******312 + %-0*9d -- left justified -- 312****** + Note that the 0 does NOT mean that the following number is octal. +*/ + +# rename _print "PRINT" + +# define SMALLEST "-34359738368" +# define FALSE 0 +# define TRUE 1 + +static int prcf(), prdf(), pref(), prff(), prof(), prsf(), prxf(), przf(); + +# define format_table fmttab +# define format_nargs fmtcnt + +static int (*format_table[26]) () = { + 0, 0, prcf, prdf, pref, prff, 0, 0, + 0, 0, 0, 0, 0, 0, prof, 0, + 0, 0, prsf, 0, prdf, 0, 0, prxf, + 0, przf}; + +static int format_nargs [26] = { + 0, 0, 1, 1, 1, 1, 0, 0, + 0, 0, 0, 0, 0, 0, 1, 0, + 0, 0, 1, 0, 1, 0, 0, 1, + 0, 1}; + +static fmtf (c, p, n) + int (*p)(); + {if (c >= 'A' && c <= 'Z') c += ('a' - 'A'); + if (c >= 'a' && c <= 'z') + {if (n >= 0 && n <= 3) + {format_table [c - 'a'] = p; + format_nargs [c - 'a'] = n; + } + else fprintf (stderr, "bad nargs to FMTF: %d\n", n); + } + else fprintf (stderr, "bad character to FMTF: %c\n", c); + } + +# define adxsub(n) adx[-n] +# define bumpadx(n) adx -= n + +_print (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) +{ +register int *adx, c, width, prec, n; +register char *fmt; +int rjust, fn, (*p)(); +char padc; + +if (cisfd(a1)) /* file descriptor */ + {fn = a1; + fmt = a2; + adx = &a3; + } +else {fn = stdout; + fmt = a1; + adx = &a2; + } +while (c = *fmt++) + {if (c != '%') putc (c, fn); + else {width = 0; + prec = -1; /* precision not given */ + rjust = FALSE; /* right justify off */ + padc = ' '; /* pad with a space */ + if (*fmt == '-') /* then right justify */ + {rjust = TRUE; + fmt++; + } + if (*fmt == '0') /* then change pad character */ + {fmt++; + if (*fmt >= '0' && *fmt <= '9') padc = '0'; + else padc = *fmt++; + } + while ((c = *fmt) >= '0' && c <= '9') + width = (width * 10) + (*fmt++ - '0'); + if (rjust) width = -width; + c = *fmt++; + if (c == '.') + {prec = 0; + while ((c = *fmt++) >= '0' && c <= '9') + prec = (prec * 10) + (c - '0'); + } + c = lower (c); + if (c == 'l' || c == 'h') /* accept LONG and SHORT prefixes */ + {char nc; + nc = lower (*fmt); + if (nc == 'd' || nc == 'o' || nc == 'x' || + nc == 'u' || nc == 'e' || nc == 'f') + {c = nc; + fmt++; + } + } + if (c >= 'a' && c <= 'z') { + p = format_table [c - 'a']; + n = format_nargs [c - 'a']; + if (p) + { + switch (n) { + case 0: (*p) (fn, width, prec, padc); + break; + case 1: (*p) (adxsub(0), fn, width, prec, padc); + break; + case 2: (*p) (adxsub(0), adxsub(1), + fn, width, prec, padc); + break; + case 3: (*p) (adxsub(0), adxsub(1), adxsub(2), + fn, width, prec, padc); + break; + } + bumpadx (n); + continue; + } + putc (c, fn); + } + else putc (c, fn); + } + } +} + +/********************************************************************** + + PRZF - Print Character N Times + +**********************************************************************/ + +static przf (chr, f, num, prec, padc) + register int num; + int f; + char chr, padc; + + {while (--num >= 0) putc (chr, f); + } + +/********************************************************************** + + PROF - Print Octal Integer + +**********************************************************************/ + +static prof (i, f, w, prec, padc) + register unsigned i; + int f, w; + char padc; + + {char b[30]; + register char *p; + register int nd; + + p = b; + do {*p++ = (i & 07) + '0'; + i >>= 3; + } while (i); + nd = p - b; + if (w > 0) przf (padc, f, w - nd, prec, padc); + while (p > b) putc (*--p, f); + if (w < 0) przf (padc, f, (-w) - nd, prec, padc); + } + +/********************************************************************** + + PRDF - Print Decimal Integer + +**********************************************************************/ + +static prdf (i, f, w, prec, padc) + register int i; + int f, w; + char padc; + + {char b[30]; + register char *p; + register int flag, nd; + + flag = 0; + p = b; + if (i < 0) {i = -i; flag = 1;} + if (i < 0) + {strcpy (b,SMALLEST); + p = b + strlen (b); + flag = 0; + } + else {do {*p++ = i % 10 + '0'; + i /= 10; + } while (i); + } + if (flag) *p++ = '-'; + nd = p - b; + if (w > 0) przf (padc, f, w - nd, 0, padc); + while (p > b) putc (*--p, f); + if (w < 0) przf (padc, f, (-w) - nd, 0, padc); + } + +/********************************************************************** + + PRSF - Print String + +**********************************************************************/ + +static prsf (s, f, w, prec, padc) + int f, w, prec; + register char *s; + char padc; + + {register int i, nd; + nd = strlen (s); + if (prec >= 0 && nd > prec) nd = prec; + prec = (w >= 0 ? w : -w) - nd; + if (prec <= 0) w = 0; + if (w > 0) przf (padc, f, prec, 0, padc); + while (--nd >= 0) putc (*s++, f); + if (w < 0) przf (padc, f, prec, 0, padc); + } + +/********************************************************************** + + PRCF - Print Character + +**********************************************************************/ + +static prcf (c, f, w, prec, padc) + int f, w; + char c, padc; + + {if (w > 0) przf (padc, f, w - 1, prec, padc); + putc (c, f); + if (w < 0) przf (padc, f, (-w) - 1, prec, padc); + } + +/********************************************************************** + + PRXF - Print Hexadecimal + +**********************************************************************/ + +static prxf (i, f, w, prec, padc) + register unsigned i; + int f, w; + char padc; + + {char b[30]; + register char *p; + register int nd; + + p = b; + do {register char c; + c = i & 017; + if (c < 10) c += '0'; + else c += ('A' - 10); + *p++ = c; + i >>= 4; + } while (i); + nd = p - b; + if (w > 0) przf (padc, f, w - nd, prec, padc); + while (p > b) putc (*--p, f); + if (w < 0) przf (padc, f, (-w) - nd, prec, padc); + } + +/********************************************************************** + + PREF - Print Floating Point Number, E format + +**********************************************************************/ + +# rename eprint "EPRINT" + +static pref (d, f, w, prec, padc) + double d; + int f, w; + char padc; + + {char b[30]; + register char *p, c; + register int nd, chn; + + if (prec < 0) prec = 6; + chn = fopen (b, "ws"); + nd = eprint (d, chn, prec); + fclose (chn); + if (w > 0) przf (padc, f, w - nd, prec, padc); + p = b; + while (c = *p++) putc (c, f); + if (w < 0) przf (padc, f, (-w) - nd, prec, padc); + } + +/********************************************************************** + + PRFF - Print Floating Point Number, F format + +**********************************************************************/ + +#rename fprint "FPRINT" + +static prff (d, f, w, prec, padc) + double d; + int f, w; + char padc; + + {char b[30]; + register char *p, c; + register int nd, chn; + + if (prec < 0) prec = 6; + chn = fopen (b, "ws"); + nd = fprint (d, chn, prec); + fclose (chn); + if (w > 0) przf (padc, f, w - nd, prec, padc); + p = b; + while (c = *p++) putc (c, f); + if (w < 0) przf (padc, f, (-w) - nd, prec, padc); + } + + diff --git a/c20/new/lib/c20run.cmid b/c20/new/lib/c20run.cmid new file mode 100644 index 00000000..a34b2e4b --- /dev/null +++ b/c20/new/lib/c20run.cmid @@ -0,0 +1,439 @@ +; +; c20run - runtime support for C programs +; + +title c20run +.insrt c:minsrt + +.global $argc,$argv +.global chntab,prctab,lowlim,hilim + +pdlsiz==20000 ; desired pdl size + +; +; start-up routine +; + +begin": move a,[440700,,[0]] ; null string + rscan ; set rscan buffer to null +start: skipa + setom cclflg ;set ccl flag if started at +1 + reset + +;activate the interrupt system + movei 1,.fhslf + move 2,[levtab,,chntab] + sir + movei 1,.fhslf + eir + movei 1,.fhslf + move 2,[000400,,000000] ;enable pdl overflow channel + aic + +;activate arithmetic exception trapping + movei t1,.fhslf + movei t2,.swart + movei t3,trapb + swtrp + +;initialize free storage allocator + skipe lowlim ; if restarting, don't init free storage + jrst r1 ; system. + move p,pdlbot ; start runtime stack + movei ep,(p) ; first frame pointer + move a,seg3hi" ; top of symbol table + addi a,1000 ; get ready to ... + lsh a,-9. ; turn it into a page number + movem a,lowlim ; and mark as lower memory bound + move a,[.fhslf,,770] ; we are going to find out if DDT is here + rmap + came a,[-1] ;does this page exist? yes -> DDT loaded + skipa a,[760] ;top of core if DDT is loaded + movei a,1000 ;top of core if DDT isn't loaded + movem a,hilim ;is upper memory bound + ccall ainit ;initialise the storage allocator + +r1: mcall setup + +restart: + ccall main,[$argc,[[$argv]]] ;run the users program + ccall exit,[[[0]]] ;and go home (this never returns) + + +; +; interrupt handlers +; + +pdlsrv: + hrroi a,[asciz/?Fatal stack overflow - Can't continue +/] + psout + haltf + jrst pdlsrv + debrk + + +; +; trap handler +; mostly from R.Gorin, DEC-20 Assy. Lang. Prog. + +acp==16 ;holds pointer to saved AC's during trap + +;pc flags +pc%ovf==400000,,0 ;overflow +pc%cy0==200000,,0 ;carry 0 +pc%cy1==100000,,0 ;carry 1 +pc%fov==40000,,0 ;floating overflow +pc%bis==20000,,0 ;byte increment suppression +pc%usr==10000,,0 ;user mode +pc%uio==4000,,0 ;user iot mode +pc%lip==2000,,0 ;last instruction public +pc%afi==1000,,0 ;address failure inhibit +pc%atn==600,,0 ;apr trap number +pc%fuf==100,,0 ;floating underflow +pc%ndv==40,,0 ;no divide + +fl%ndv==1,,0 ;flag for floating divide error + +;messages for possible traps +trpmsg: pc%ovf+[asciz /%Integer Overflow /] + pc%fov+[asciz /%Floating Overflow /] + pc%ndv+[asciz /%Integer Division by Zero /] + pc%fuf+[asciz /%Floating Underflow /] + fl%ndv+[asciz /%Floating Division by Zero /] +trpmln==.-trpmsg + +;table of fp instructions and where they store their results. +; used to zero result in case of fp underflow. +acf==1 ;result in ac +ddf==2 ;result in AC,AC+1 +mmf==4 ;result in memoru + +define fopxx op + f!op acf ;;result in ac + f!op!m mmf ;;result in memory + f!op!b mmf\acf ;;result in both + f!op!r acf ;;result in ac + f!op!ri acf ;;result in ac + f!op!rm mmf ;;result in memory + f!op!rb mmf\acf ;;result in both + df!op acf\ddf ;;result in ac,ac+1 +termin + +fxutab: fopxx ad + fopxx sb + fopxx mp + fopxx dv + fsc acf +fxutln==.-fxutab + +;register saver +savacs: adjsp p,17 ;allocate stack space for ac's + movem 16,0(p) ;save ac16 + movei 16,-16(p) ;source,,dest + blt 16,-1(p) ;save AC's + movei acp,-16(p) ;set up pointer to saved AC's + pushj p,@-17(p) ;go do whatever + skipa ;non-skip return, avoid aos + aos -20(p) ;skip return, we will too + movsi 16,-16(p) ;restore saved AC's + blt 16,16 + adjsp p,-20 ;untrash stack + popj p, + + +trphnd: pushj p,trapnt ;process trap + xjrstf trapb+.arpfl ;return from whence we came + +trapnt: pushj p,savacs ;safety first + move b,trapb+.arpfl ;get saved flags + and b,[pc%ovf\pc%fov\pc%ndv\pc%fuf] ;just interesting ones + tlne b,(pc%fuf) ;underflow? + tlz b,(pc%ovf\pc%fov) ;yes, don't bitch about overflow + tlne b,(pc%fov) ;floating overflow? + tlz b,(pc%ovf) ;yes, don't bitch about integer overflow + tlne b,(pc%ndv) ;divide by 0? + tlz b,(pc%ovf) ;don't bitch about overflow + tlne b,(pc%ndv) ;divide by 0? + tlzn b,(pc%fov) ;and floating point error? + skipa ;nope + tlc b,(pc%ndv\fl%ndv) ;yes, mark floating divide error + +;scan table to print message + movsi d,-trpmln ;get table length +trpnt1: tdnn b,trpmsg(d) ;flag set for this message? + jrst trpnt2 ;nope + hrro a,trpmsg(d) ;yes, get message + psout ;print it +trpnt2: aobjn d,trpnt1 ;loop till done + hrroi a,[asciz /at PC = /] ;print PC + psout + movei a,.priou + move b,trapb+.aropc ;get trap PC + subi b,1 ;point to losing instr + movei c,10 ;octal + nout + jfcl ;don't lose + hrroi a,[asciz / +/] + psout + + move b,trapb+.arpfl ;get flags again + tlne b,(pc%fuf) ;special processing for underflow + pushj p,dofxu + hrlzi b,(pc%ovf\pc%fov\pc%ndv\pc%fuf\fl%ndv) + andcam b,trapb+.arpfl ;zero out flags + popj p, ;thats all... + + +;routine to fix up result on floating pt underflow +dofxu: movsi d,-fxutln ;length of opcode table + ldb a,[.bp 777000,trapb+.arpfl] ;get opcode of losing instr +dofxu1: ldb b,[.bp 777000000000,fxutab(d)] ;get opcode from table + camn a,b ;match + jrst dofxu2 ;yes, go fix + aobjn d,dofxu1 ;no, try again + hrroi a,[asciz /?Runtime error: Unknown Instruction in Trap Routine +/] + psout + haltf ;lose badly + popj p, + +;here with d pointing to correct entry in fp instr table +dofxu2: hrrz a,fxutab(d) ;get result flags + ldb b,[.bp 740,trapb+.arpfl] ;get ac field of instr + cail b,16 ;SP or FP register? + jrst dofxe1 ;yes, shouldn't happen + add b,acp ;offset to saved AC's + trnn a,acf ;result in AC? + jrst dofxu3 ;no, don't do anything + setzm (b) ;yes, clear saved copy of AC + +dofxu3: trnn a,mmf ;result in memory? + jrst dofxu4 ;no + hrrz b,trapb+.arefa ;yes, get in-section result address + hlrz d,trapb+.arefa ;get section number of result + caig b,16 ;skip if not an AC address + caile d,1 ;skip if it is an AC address + jrst dofxu6 ;not an AC address, leave + add b,acp ;offset to saved copy of AC + setzm (b) ;zero it + jrst dofxu4 + +dofxu6: setzm @trapb+.arefa ;memory location. zero it + +dofxu4: trnn a,ddf ;result also in AC+1? + jrst dofxu5 ;no + ldb b,[.bp 740,trapb+.arpfl] ;AC field of instr again + addi b,1 ;next ac + cail b,16 ;shouldn't be 16 or 17 + jrst dofxe1 ;error if so + add b,acp ;point to saved AC's + setzm (b) ;zero result +dofxu5: popj p, ;all done + +;here if result appears to be in SP or FP registers +dofxe1: hrroi a,[asciz /?Runtime Error: Trap Points to SP or FP +/] + psout + haltf + popj p, ;keep going if he wants + +; +; exit routines +; + +centry %exit,[cc] ;exit without cleaning up files + move a,cc ;can be continued + haltf + return + +;; Functions to turn arithmetic traps on and off. They are on by +;; default, but must be turned off if you want to catch arithmetic +;; exceptions with the software interrupt system. + +;activate arithmetic exception trapping +centry %tpon + movei t1,.fhslf + movei t2,.swart + movei t3,trapb + swtrp + return + +;turn it off +centry %tpoff + movei t1,.fhslf + movei t2,.swart + setzm t3 + swtrp + return + + +centry exit,[cc] + ccall closall ; close all c files + move a,cc + + move c,a ; save return code + seto a, + closf ; close all files + jfcl + move a,c + haltf ; commit suicide +.exit1: hrroi a,[asciz/?Can't continue from exit() call +/] + psout + haltf + jrst .exit1 + + + +; +; number conversion +; + +cfix": + movm 0,-1(p) + fadr 0,[.499999] + fix 0,0 + skipge -1(p) + movns 0 + movem 0,-1(p) + popj p, + +cfloat": + fltr 0,-1(p) + movem 0,-1(p) + popj p, + +; impure area + +.idata + +mdata cclflg + 0 ; -1 if started from CCL +timing: block 1 ; timing flag +exiter: block 1 ; exit routine (for timing) +pdl": block pdlsiz ; the stack + +chntab: 0,,intr0 ;unavailable, reserved for debugger + 0,,intr1 + 0,,intr2 + 0,,intr3 + 0,,intr4 + 0,,intr5 + 0,,intr6 + 0,,intr7 + 0,,intr8 + 1,,pdlsrv ; pdlov handler + 0,,intr10 + 0,,intr11 + 0,,intr12 + 0,,intr13 + 0,,intr14 + 0,,intr15 + 0,,intr16 + 0,,intr17 + 0,,intr18 + 0,,intr19 + 0,,intr20 + 0,,intr21 + 0,,intr22 + 0,,intr23 + 0,,intr24 + 0,,intr25 + 0,,intr26 + 0,,intr27 + 0,,intr28 + 0,,intr29 + 0,,intr30 + 0,,intr31 + 0,,intr32 + 0,,intr33 + 0,,intr34 + 0,,intr35 +.code +intr0: jsr intr +intr1: jsr intr +intr2: jsr intr +intr3: jsr intr +intr4: jsr intr +intr5: jsr intr +intr6: jsr intr +intr7: jsr intr +intr8: jsr intr + jsr intr +intr10: jsr intr +intr11: jsr intr +intr12: jsr intr +intr13: jsr intr +intr14: jsr intr +intr15: jsr intr +intr16: jsr intr +intr17: jsr intr +intr18: jsr intr +intr19: jsr intr +intr20: jsr intr +intr21: jsr intr +intr22: jsr intr +intr23: jsr intr +intr24: jsr intr +intr25: jsr intr +intr26: jsr intr +intr27: jsr intr +intr28: jsr intr +intr29: jsr intr +intr30: jsr intr +intr31: jsr intr +intr32: jsr intr +intr33: jsr intr +intr34: jsr intr +intr35: jsr intr + +; note: only one level of interrupts permitted (level 3)! +begint": +intr: 0 ; clobbered by jsr + movem 0,intsav ; save all registers + movei 0,intsav+1 + hrli 0,1 + blt 0,intsav+p + hrrz 1,intr ; find out interrupt number + subi 1,intr0+1 + movem 1,intnum + pushj p,@prctab(1) ; call routine + hrli 0,intsav+1 + hrri 0,1 + blt 0,p + move 0,intsav + setzm intnum + debrk +endint": + +.idata +levtab: pclev1 + pclev2 ; not used currently + pclev3 + +pclev1":block 1 +pclev2":block 1 +pclev3":block 1 + +intsav: block p+1 +pdlbot: <-pdlsiz,,pdl> +pdltop: pdl+pdlsiz-1 + +prctab: 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 + 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 + 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 + +intnum":0 +lowlim: 0 +hilim: 0 + +trapb: 0 + 0 + 0 + 0,,trphnd + +patch: block 100 + +end start diff --git a/c20/new/lib/c20scn.c b/c20/new/lib/c20scn.c new file mode 100644 index 00000000..0290c415 --- /dev/null +++ b/c20/new/lib/c20scn.c @@ -0,0 +1,297 @@ +# include + +/* + SCANF - C Formatted Input Routine + + Format options: (upper case treated identically) + %s string + %c character + %o octal + %d decimal + %u unsigned (= decimal) + %x hexadecimal + %f F format floating point (without exponent, if poss) + %e E format floating point (always with exponent) + %[...] string whose chars are only in ... + %[^...] string whose chars are NOT in ... + + If * precedes format char (as in %*d) then that item will be + read, but not assigned to a variable in the variable list. +*/ + +# rename _scanf "SCANF" +# define TRUE 1 +# define FALSE 0 + +extern FILE *stdin; +extern double atof(); + +# define bumpadx --adx + +_scanf (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) + +{register int *adx, n, fn; +register char *fmt, c; + +n = 0; +if (cisfd (a1)) /* file descriptor */ + {fn = a1; + fmt = a2; + adx = &a3; + } +else {fn = stdin; + fmt = a1; + adx = &a2; + } +if ((c = getc (fn)) < 0) return (-1); /* check for initial eof */ +ungetc (c, fn); +while (c = *fmt++) + {register int assign, win, width; + if (c == ' ' || c == '\t' || c == '\n') continue; + if (c != '%') + {register char cc; + while (TRUE) + {if ((cc = getc (fn)) < 0) return (n); + if (cc != ' ' && cc != '\t' && cc != '\n') break; + } + if (c == cc) continue; + ungetc (cc, fn); + return (n); + } + c = *fmt++; + if (c == '*') + {assign = FALSE; + c = *fmt++; + } + else assign = TRUE; + width = 0; + while (c >= '0' && c <= '9') + {width = width * 10 + (c - '0'); + c = *fmt++; + } + if (c == 'l' || c == 'h') c = *fmt++; + switch (c) { + case 'c': + win = scnc (fn, assign, *adx, width); break; + case 'd': + win = scnd (fn, assign, *adx, width); break; + case 'e': + case 'f': + win = scnf (fn, assign, *adx, width); break; + case 'o': + win = scno (fn, assign, *adx, width); break; + case 's': + win = scns (fn, assign, *adx, width); break; + case 'x': + win = scnx (fn, assign, *adx, width); break; + case '[': + {char *p, cc; + p = fmt; + while ((cc = *fmt++) && cc != ']'); + win = scnb (fn, assign, *adx, width, p); + } + break; + default: + win = FALSE; + } + if (!win) return (n); + if (assign) + {n++; + bumpadx; + } + } +return (n); +} + +/* SCNC - Parse a character */ + +static int scnc (fn, assign, var, width) +int fn, assign, *var, width; + + {char c; + if ((c = getc (fn)) < 0) return (FALSE); + if (assign) *var = c; + return (TRUE); + } + +/* SCND - Parse a decimal integer */ + +static int scnd (fn, assign, var, width) +int fn, assign, *var, width; + + {return (scnint (fn, assign, var, width, 10)); + } + +/* SCNO - Parse an octal integer */ + +static int scno (fn, assign, var, width) +int fn, assign, *var, width; + + {return (scnint (fn, assign, var, width, 8)); + } + +/* SCNX - Parse a hexadecimal number */ + +static int scnx (fn, assign, var, width) +int fn, assign, *var, width; + + {return (scnint (fn, assign, var, width, 16)); + } + +/* SCNINT - parse an integer, base specified */ + +static int scnint (fn, assign, var, width, base) + int fn, assign, *var, width, base; + + {register int i; + int neg, win; + register char c; + if (!skpblk (fn)) return (FALSE); + i = 0; + win = neg = FALSE; + while (TRUE) + {if ((c = getc (fn)) < 0) return (FALSE); + if (c == '-') neg = !neg; + else if (c != '+') break; + } + while (TRUE) + {register char cc; + cc = c; + if (c >= '0' && c <= '9') cc = c - '0'; + else if (c >= 'a' && c <= 'z') cc = c - 'a' + 10; + else if (c >= 'A' && c <= 'Z') cc = c - 'A' + 10; + else if (c == ' ' || c == '\t' || c == '\n'|| c == ',') + {win = TRUE; + break; + } + else break; + if (cc >= base) break; + i = i * base + cc; + if (--width == 0 || (c = getc (fn)) < 0) + {win = TRUE; + break; + } + } + if (c >= 0) ungetc (c, fn); + if (win) + {if (neg) i = -i; + if (assign) *var = i; + } + return (win); + } + +/* SCNF - Parse a floating point number of this form: */ +/* [- | +] ddd [.] ddd [ E [- | +] ddd ] */ + +static int scnf (fn, assign, var, width) + int fn, assign; + register int width; + double *var; + + {char buf[100]; + register char c, *p; + + if (width <= 0 || width > 100) width = 100; + p = buf; + if (!skpblk (fn)) return (FALSE); + c = getc (fn); + if (c == '-' || c == '+') + {*p++ = c; + if (--width == 0) goto finish; + if ((c = getc (fn)) < 0) return (FALSE); + } + while (TRUE) + {if (c >= '0' && c <= '9') *p++ = c; + else break; + if (--width == 0 || (c = getc (fn)) < 0) goto finish; + } + if (c == '.') + {*p++ = c; + if (--width == 0 || (c = getc (fn)) < 0) goto finish; + else while (TRUE) + {if (c >= '0' && c <= '9') *p++ = c; + else break; + if (--width == 0 || (c = getc (fn)) < 0) + goto finish; + } + } + if (c == 'e' || c == 'E') + {*p++ = c; + if (--width == 0) goto finish; + c = getc (fn); + if (c == '-' || c == '+') + {*p++ = c; + if (--width == 0) goto finish; + c = getc (fn); + } + while (TRUE) + {if (c >= '0' && c <= '9') *p++ = c; + else break; + if (--width == 0 || (c = getc (fn)) < 0) goto finish; + } + } + if (c >= 0) ungetc (c, fn); + if (c != ' ' && c != '\t' && c != '\n' && c != ',') return (FALSE); +finish: *p++ = 0; + if (assign) *var = atof (buf); + return (TRUE); + } + +/* SCNS - Read a string */ + +static int scns (fn, assign, var, width) + int fn, assign, width; + register char *var; + + {register char c; + if (!skpblk (fn)) return (FALSE); + while (TRUE) + {if ((c = getc (fn)) < 0 || c == ' ' || c == '\n') break; + if (assign) *var++ = c; + if (--width == 0) goto done; + } + if (c >= 0) ungetc (c, fn); +done: if (assign) *var++ = 0; + return (TRUE); + } + +/* SCNB - Scan a string of the bracket form */ + +static int scnb (fn, assign, var, width, matchers) +int fn, assign, width; +char *var, *matchers; + + {register char c; + int member[128], nots; + nots = FALSE; + if (*matchers == '^') + {nots = TRUE; + matchers++; + } + *member = nots; + blt (member, member + 1, 127); + nots = !nots; + while ((c = *matchers++) && c != ']') member[c] = nots; + while (TRUE) + {if ((c = getc (fn)) < 0 || !member[c]) break; + if (assign) *var++ = c; + if (--width == 0) goto done; + } + if (c >= 0) ungetc (c, fn); +done: if (assign) *var = 0; + return (TRUE); + } + +/* SKPBLK - Skips blank things; returns TRUE if won, FALSE if EOF reached */ + +static int skpblk (fn) + + {while (TRUE) + {register char c; + if ((c = getc (fn)) < 0) return (FALSE); + if (c != ' ' && c != '\t' && c != '\n') + {ungetc (c, fn); + return (TRUE); + } + } + } diff --git a/c20/new/lib/c20str.cmid b/c20/new/lib/c20str.cmid new file mode 100644 index 00000000..fa00a9bd --- /dev/null +++ b/c20/new/lib/c20str.cmid @@ -0,0 +1,245 @@ +; +; string - c string, byte, and bit routines +; +; this file is pdp-10 dependent, system-independent. +; + +title string +.insrt c:minsrt + +; contains: + +; strlen ; string length +; strcpy ; string copy +; strncpy ; fixed length string copy +; strcat ; string concatenate +; strcmp ; string compare +; strncmp ; fixed length string compare + +; pack ; pack C strings into PDP10 words +; npack ; pack N-char C strings into PDP10 words +; unpack ; unpack PDP10 words into C strings +; nunpack ; unpack PDP10 words into N-char C strings + +; bget ; bit array bit get +; bset ; bit array bit set + +; ildb ; increment and load byte +; idpb ; increment and deposit byte + +centry strlen,[str] ; string length + + move b,str ; pointer to string +sl$1: skipe (b) ; get next character + aoja b,sl$1 + sub b,str + movei a,(b) + return + +centry strcat,[dest,src] ; string copy + + ; concatenate source string to end of destination string + ; return pointer to destination + + move b,src ; source pointer + move a,dest ; destination pointer +sct$1: skipe (a) + aoja a,sct$1 ; find end of string + subi b,(a) + hrli b,a ; hack to make loop shorter +sct$2: move c,@b ; get next char + movem c,(a) ; store + caie c,0 + aoja a,sct$2 ; incr both pointers + move a, dest ; return pointer to dest for UNIX compatibility +sct$rt: return + +centry strcpy,[dest,src] ; string copy + + ; copy string from src to dest + ; return pointer to dest + + move b,src ; source pointer + move a,dest ; destination pointer + subi b,(a) + hrli b,a ; hack to make loop shorter +sc$1: move c,@b ; get next char + movem c,(a) ; store + caie c,0 + aoja a,sc$1 ; incr both pointers + move a,dest ; return pointer to dest + return + +mentry strncp,[dest,src,n] ; string copy + + ; copy n characters from src to dest + ; return pointer to dest + ; renamed in STDIO.H to get full 6-char function name + + push p,d ; d isn't a temp reg + move d,n ; get count + move b,src ; source pointer + move a,dest ; destination pointer + subi b,(a) + hrli b,a ; b is now offset(a) - use it as address +snc$1: move c,@b ; get next char + movem c,(a) ; store + sojle d,snc$r ; done enough characters + caie c,0 + aoja a,snc$1 ; incr both pointers + aos a, ; end of source, but not enough chars +snc$2: movem c,(a) ; write zeros to rest of dest + sosle d ; check count + aoja a,snc$2 ; incr ptr and loop +snc$r: pop p,d ; restore register + return + + +centry strcmp,[s1,s2] ; string compare + + move b,s1 ; pointer to s1 + move c,s2 ; pointer to s2 + subi c,(b) ; c has s2-s1 + hrli c,b ; c is now offset(b) +sm$1: move a,(b) ; get next char from s1 + came a,@c ; compare it with char from s2 + jrst sm$2 ; jump if difference + caie a,0 ; end of string? + aoja b,sm$1 ; no, back for more + movei a,0 ; they were equal, return 0 + return + ; here if they not equal +sm$2: caml a,@c ; a has char from s1 + skipa a,[1] ; s2 was greater, return 1 + move a,[-1] ; s1 was greater, return -1 + return + +mentry strncm,[s1,s2,n] ; fixed length compare + ; renamed in STDIO.H + + push p,d ; d isn't a temp + move d,n ; length + move b,s1 ; pointer to s1 + move c,s2 ; pointer to s2 + subi c,(b) ; c has s2-s1 + hrli c,b ; c is now offset(b) +snm$1: move a,(b) ; get next char from s1 + came a,@c ; compare it with char from s2 + jrst snm$2 ; jump if difference + jumpe a,snm$3 ; end of string? + sosle d ; or done enough characters? + aoja b,snm$1 ; no, back for more +snm$3: movei a,0 ; they were equal, return 0 + pop p,d ; restore reg + return + ; here if strings differ +snm$2: caml a,@c ; a has char from s1 + skipa a,[1] ; s2 was greater, return 1 + move a,[-1] ; s1 was greater, return -1 + pop p,d ; restore reg + return + +centry lower,[ch] ; cvt char to lower case + + move a,ch + cail a,"A + caile a,"Z + caia + addi a,"a-"A + return + +centry upper,[ch] ; cvt char to upper case + + move a,ch + cail a,"a + caile a,"z + caia + subi a,"a-"A + return + + +centry pack,[str,wp] ;pack C string into PDP10 words at wp + + move a,str ;address of string + hrrz b,wp ;address of words to pack + hrli b,440700 ;make a byte ptr +p$1: move c,(a) ;get char + idpb c,b ;save it + caie c,0 ;done? + aoja a,p$1 ;no, incr string pointer + move a,wp ;return address of first word + return + +centry unpack,[str,wp] ;unpack 7-bit chars at WP to C string + + move a,str ;address of string + hrrz b,wp ;address of words + hrli b,440700 ;make bp +up$1: ildb c,b ;get char + movem c,(a) ;save it + caie c,0 ;done? + aoja a,up$1 ;no + move a,str ;return address of string + return + +centry npack,[str,wp,n] ;pack N chars from C string to PDP10 + ; words. Null fill if needed. + + push p,d + move d,n + move a,str + hrrz b,wp + hrli b,440700 +np$1: move c,(a) ;get char + idpb c,b ;into word + sojle d,np$r ;enough chars + caie c,0 ;end of string? + aoja a,np$1 ;nope, do more +np$2: idpb c,b + sojg d,np$2 +np$r: pop p,d + return + + +centry bget,[barray,bindex] ; bit array bit get + + hrrz c,bindex + hrrz a,barray + movei b,(c) ; subscript + + lsh c,-5 ; get word offset + addi a,(c) ; get word address + move a,(a) ; get the word + andi b,37 ; bit offset + rot a,1(b) ; put bit in right-most position + andi a,1 ; get the bit + return + +centry bset,[barray,bindex] ; bit array bit set + + hrrz c,bindex + hrrz a,barray + movei b,(c) ; subscript + + lsh c,-5 ; get word offset + addi a,(c) ; get word address + andi b,37 ; bit offset + movn b,b ; negative bit offset + movei c,1 ; a bit + rot c,-1(b) ; put in right position + iorm c,(a) ; smash array word + movei a,1 + return + +centry ildb,[abptr] ; increment and load byte + + ildb a,@abptr + return + +centry idpb,[ch,abptr] ; increment and deposit byte + + move b,ch ; the character + idpb b,@abptr + return + +end diff --git a/c20/new/lib/c20sys.cmid b/c20/new/lib/c20sys.cmid new file mode 100644 index 00000000..02baf84c --- /dev/null +++ b/c20/new/lib/c20sys.cmid @@ -0,0 +1,705 @@ +; +; c20sys - system-call interfaces (tops20) +; + +title c20sys +.insrt c:minsrt + +; general jsys interface - see documentation + +centry %jsys,[num,acs] + + push p,4 ; ac4 and ac5 aren't temp regs + push p,5 ; the current compiler + move 5,acs ; pointer to ac block + move t1,0(5) ; load the ac's + move t2,1(5) + move t3,2(5) + move t4,3(5) + hrrz 5,num ; get the jsys number + hrli 5,104000 ; build a jsys + xct 5 ; and do it + erjmp js$err ; lose? + move 5,acs ; nope, update ac block + movem t4,3(5) + movem t3,2(5) + movem t2,1(5) + movem t1,0(5) + movei t1,0 ; return 0 for success + jrst js$ret + +js$err: move 5,acs ; get ac block pointer + movem t4,3(5) ; put the ac's back in the ac block + movem t3,2(5) + movem t2,1(5) + movem t1,0(5) + movei t1,.fhslf ; get the error code + geter + hrr t1,t2 ; and return it + +js$ret: pop p,5 ; get ac's back + pop p,4 + return + +centry %erstr,[err,buf,size] + + hrr t1,buf + hrli t1,444400 ; make a 36 bit byteptr for C string + hrr t2,err + hrli t2,.fhslf + movn t3,size ; trying to get -size,,0 + movs t3,t3 + trz t3,777777 + erstr ; write the error message + jfcl ; unknown error number or + skipa ; output error, skip to ... + skipa t1,buf ; OK, return buffer address + setz t1, ; ... error return of 0 + return + + +; Interfaces for specific system calls + +centry %gtjfn,[flags,name] + + move a,flags + move b,name + gtjfn + jfcl ; leave error code in a + return + +centry %gnjfn,[handle] + + move a,handle + gnjfn + jfcl + return + +centry %openf,[jfn,flags] + + move a,jfn + move b,flags + openf + caia + movei a,0 + return + +centry %sfptr,[jfn,byteno] + + move a,jfn + move b,byteno + sfptr + caia + movei a,0 + return + +centry %rfptr,[jfn] + + move a,jfn + rfptr + seto b, + move a,b + return + +centry %bin,[source] + + move a,source + bin + move a,b + return + +centry %bout,[dest,byte] + + move a,dest + move b,byte + bout + return + +centry %sin,[source,ptr,count,tbyte] + + move a,source + move b,ptr + move c,count + move d,tbyte + sin + move a,c + return + +centry %sout,[jfn,ptr,count,tbyte] + + move a,jfn + move b,ptr + move c,count + move d,tbyte + sout + move a,c + return + +centry %bkjfn,[jfn] + + move a,jfn + bkjfn + tdza a,a + seto a, + setca a, + return + +centry %gests,[jfn] ; gtsts + + move a,jfn + gtsts + move a,b + return + +centry %gtsts,[jfn] + + move a,jfn + gtsts + move a,b + return + +centry %sibe,[jfn] + + move a,jfn + sibe + caia + movei b,0 + move a,b + return + +centry %closf,[jfn] + + move a,jfn + closf + jfcl + return + +centry %rdtty,[buf,siz,opt] + + move a,buf + move b,siz + move c,opt + setz d, + rdtty + seto d, + move a,d + return + +centry %psout,[str] + + move a,str + psout + return + +centry %dobe,[jfn] + + move a,jfn + dobe + return + +centry %gyp,[jfn] ; gttyp + + move a,jfn + seto b, + gttyp + erjmp l2 +l2: move a,b + return + +centry %dvchr,[jfn,vals] + + move a,jfn + dvchr + move d,vals + movem a,(d) + movem b,1(d) + movem c,2(d) + return + +centry %rscan,[ptr] + + move a,ptr + rscan + seto a, + return + +centry %rljfn,[jfn] + + move a,jfn + rljfn + jfcl + return + +centry %jfns,[buf,jfn,bits] + + move a,buf + move b,jfn + move c,bits + jfns + return + +centry %gji,[job,ptr,first] ;getji + + move a,job + move b,ptr + move c,first + setz d, + getji + seto d, + move a,d + return + +centry %dirst,[buf,num] + + move a,buf + move b,num + setz c, + dirst + seto c, + move a,c + return + +centry %odcnv,[dat,bits,vec] + + move b,dat + move d,bits + odcnv + move a,vec + movem b,(a) + movem c,1(a) + movem d,2(a) + return + +centry %idtim,[str,bits] + + move a,str + move b,bits + idtim + seto b, + move a,b + return + +centry %rtad,[jfn,ptr,len] ; rftad + + move a,jfn + move b,ptr + move c,len + rftad + return + +centry %ftad,[jfn,ptr,len] ; sftad + + move a,jfn + move b,ptr + move c,len + sftad + return + +centry %gtad ; gtad + + gtad + return + +centry %runtm,[prcs,prt,pct] + move a,prcs + runtm + movem a,@prt + movem c,@pct + return + +centry %rcoc,[jfn,ptr] ;rfcoc + + move a,jfn + rfcoc + move a,ptr + movem b,(a) + movem c,1(a) + return + +centry %scoc,[jfn,ptr] ;sfcoc + + move a,ptr + move b,(a) + move c,1(a) + move a,jfn + sfcoc + return + +centry %dsms,[msec] ;disms + + move a,msec + disms + return + +centry %smod,[jfn,mode] ;sfmod + + move a,jfn + move b,mode + sfmod + return + +centry %sfmod,[jfn,mode] + + move a,jfn + move b,mode + sfmod + return + +centry %stpar,[jfn,mode] + + move a,jfn + move b,mode + stpar + return + +centry %rmod,[jfn] ;rfmod + + move a,jfn + rfmod + move a,b + return + +centry %rfmod,[jfn] + + move a,jfn + rfmod + move a,b + return + +centry %rtiw,[frk,wrd] + + move a,frk + rtiw + move a,wrd + movem b,(a) + move a,c + return + +centry %stiw,[frk,wrd1,wrd2] + + move a,frk + move b,wrd1 + move c,wrd2 + stiw + return + +centry %rpcap,[frk,wrd] + + move a,frk + rpcap + move a,wrd + movem c,(a) + move a,b + return + +centry %epcap,[frk,wrd1,wrd2] + + move a,frk + move b,wrd1 + move c,wrd2 + epcap + return + +centry %cfibf,[jfn] + + move a,jfn + cfibf + return + +centry %gtfdb,[jfn,cptr,ptr] + + move a,jfn + move b,cptr + move c,ptr + gtfdb + return + +centry %chfdb,[jfn,mask,stuff] + + move a,jfn + move b,mask + move c,stuff + chfdb + return + +centry %delf,[jfn] + move a,jfn + delf + jfcl + return + +centry %deldf,[bits,dirn] + move a,bits + move b,dirn + deldf + return + +centry %spjfn,[ph,pin,pout] + move a,ph + hrl b,pin + hrr b,pout + spjfn + return + +centry %gpjfn,[ph] + move a,ph + gpjfn + move a,b + return + +centry %cfork,[bits,blk] + move a,bits + move b,blk + cfork + jfcl + return + +centry %wfork,[ph] + move a,ph + wfork + return + +centry %kfork,[ph] + move a,ph + kfork + return + +centry %sfork,[ph,sa] + move a,ph + move b,sa + sfork + return + +centry %rfork,[ph] + move a,ph + rfork + return + +centry %sfrkv,[ph,en] + move a,ph + move b,en + sfrkv + return + +centry %rfsts,[ph] + move a,ph + rfsts + return + +centry %rfpc,[ph] + move a,ph + rfsts + move a,b + return + +centry %get,[info,pns] + move a,info + move b,pns + get + erjmp get$1 + tdza a,a +get$1: seto a, + return + +centry %gevec,[ph] + move a,ph + gevec + move a,b + return + +centry %rnamf,[jfn1,jfn2] + move a,jfn1 + move b,jfn2 + rnamf + caia + movei a,0 + return + +centry %gtdal,[dirn,pnwork,pnused,pnperm] + move a,dirn + gtdal + movem a,@pnwork + movem b,@pnused + movem c,@pnperm + return + +centry %gjinf,[puser,pdir,pjob,pterm] + gjinf + movem a,@puser + movem b,@pdir + movem c,@pjob + movem d,@pterm + return + +centry %ssave,[pj,te,flags] + move a,pj + move b,te + move c,flags + ssave + return + +centry %pmap,[source,dest,bits] + move a,source + move b,dest + move c,bits + pmap + return + +centry %sevec,[ph,vw] + move a,ph + move b,vw + sevec + jfcl + return + +centry %rfacs,[ph,blk] + move a,ph + move b,blk + rfacs + return + +centry %sfacs,[ph,blk] + move a,ph + move b,blk + sfacs + return + +centry %haltf + haltf + return + +centry %rmap,[ph,pn,pac] + hrlz a,ph + hrr a,pn + rmap + movem b,@pac + return + +centry %spacs,[ph,pn,acs] + hrlz a,ph + hrr a,pn + move b,acs + spacs + return + +centry %aic,[frk,wrd] + move a,frk + move b,wrd + movei c,0 + aic + erjmp aic$1 + movei c,1 +aic$1: movei a,(c) + return + +centry %dic,[frk,wrd] + move a,frk + move b,wrd + movei c,0 + dic + erjmp dic$1 + movei c,1 +dic$1: movei a,(c) + return + +centry %iic,[frk,wrd] + move a,frk + move b,wrd + movei c,0 + iic + erjmp iic$1 + movei c,1 +iic$1: movei a,(c) + return + +centry %ati,[wrd] + move a,wrd + movei c,0 + ati + erjmp ati$1 + movei c,1 +ati$1: movei a,(c) + return + +centry %dti,[wrd] + move a,wrd + movei c,0 + dti + erjmp dti$1 + movei c,1 +dti$1: movei a,(c) + return + +centry %eir,[frk] + move a,frk + movei c,0 + eir + erjmp eir$1 + movei c,1 +eir$1: movei a,(c) + return + +centry %dir,[frk] + move a,frk + movei c,0 + dir + erjmp dir$1 + movei c,1 +dir$1: movei a,(c) + return + +centry %skpir,[frk] + move a,frk + skpir + tdza a,a + movei a,1 + return + +centry %rcm,[frk] + move a,frk + rcm + return + +centry %rwm,[frk,levs] + move a,frk + rwm + movem b,@levs + return + +centry %wait + wait + return + +centry %prarg,[x,y,z] + move a,x + move b,y + move c,z + prarg + erjmp pr$err + skipa a,c +pr$err: movni a,1 + return + +centry %mtopr,[x,y,z] + move a,x + move b,y + move c,z + mtopr + move a,c + return + +centry %hfork,[ph] + + move a,ph + hfork + return + +centry %hptim,[clk] + + move a,clk + hptim + jrst [ setz a, + jrst .+1] + return + +end diff --git a/c20/new/lib/c20tty.c b/c20/new/lib/c20tty.c new file mode 100644 index 00000000..f69cf801 --- /dev/null +++ b/c20/new/lib/c20tty.c @@ -0,0 +1,285 @@ +# include + +/********************************************************************** + + TOPS-20 Display Terminal Hacking + + isdisplay () => bool return true if terminal is known display + dpytype () => int return terminal type code + utyi () => c read character without echoing + tyo (c) output character (buffered) + utyo (c) output character (unbuffered) + tyos (s) output string by repeated tyo (c) + tyo_flush () flush output buffer + spctty (c) perform display function: + C: clear screen + T: move cursor to top of screen + L: erase to end-of-line + E: erase to end-of-screen + D: move cursor down + K: erase next character (avoid overprinting) + B: backspace + dpymove (ln, cn) Move cursor to given LineNumber and + ColumnNumber (<0,0> is top) + dpyreset () Restore original terminal mode. + dpyinit () Forces later re-initialization by resetting + flags + + Note: use of any display routine changes the terminal mode to allow + escape sequences to be output and turns page mode off. Dpyreset should + be called to reset the terminal to its original state before + termination. + + Output is normally buffered. The output buffer is flushed implicitly by + UTYI, UTYO, and DPYRESET, and is flushed explicitly by TYO_FLUSH. + UTYI does image input, but you must turn page mode on/off yourself if + you care about it. + +**********************************************************************/ + +# ifdef TOPS20 +# define IMLAC 4 /* not a standard code */ +# define DATAMEDIA 100 /* non-existent */ +# define HP264X 6 /* standard ? */ +# define VT52 15 +# define VT100 18 /* currently implemented as a VT52 */ +# define HEATH 20 /* currently implemented as a VT52 */ +# define HP262X 21 /* non-standard: implemented as HP264X */ +# endif + +# ifdef TENEX +# define IMLAC 10 /* not a standard code */ +# define DATAMEDIA 11 /* At SUMEX-AIM */ +# define HEATH 18 /* currently implemented as a VT52 */ +# define HP264X 101 /* these are not defined ... */ +# define VT52 102 +# define VT100 103 +# define HP262X 104 +# endif + +static int ttype; /* terminal type */ +static int dflag; /* is-display flag */ +static int iflag; /* own variable initialization flag */ +static int cflag; /* mode flag: TRUE => control-chars mode */ +static int omode; /* original terminal mode */ + +# define TYOSIZ 1000 +static char tyobuf[TYOSIZ], *ctyop = tyobuf; + +# define PRIIN 0100 +# define PRIOU 0101 + +dpysetup () + + {/* NOTE: This is called ONLY by C20IO, to make sure things are + cool in a dumped and restarted program, etc. */ + cflag = FALSE; + iflag = FALSE; + } + +int isdisplay () +{ + if (iflag) return (dflag); + /* own variable initialization */ + iflag = TRUE; + ttype = _GYP (PRIOU); + dflag = (ttype == HP264X || ttype == VT52 || ttype == HP262X || + ttype == IMLAC || ttype == VT100 || ttype == HEATH || + ttype == DATAMEDIA); + if (!dflag) return (FALSE); + if (ttype == HEATH) { + dpyon (); + tyos ("\033<\033[?2h"); + dpyreset (); + /* put into Heath (VT52 compatible) mode */ + ttype = VT52; + } + else if (ttype == HP262X) ttype = HP264X; + else if (ttype == VT100) { + /* VT100 now implemented only as a VT52 */ + dpyon (); + tyos ("\033<\033[?2l"); + dpyreset (); + /* put it in VT52 mode */ + ttype = VT52; /* pretend it's a VT52 */ + } +#if 0 + if (ttype == VT100) { + /* (someday) make sure its in ANSI mode */ + dpyon (); + tyos ("\033<"); + dpyreset (); + } +# endif + return (TRUE); + +} + + + +int dpytype () +{ + if (!iflag) isdisplay (); + return (ttype); +} + +dpyinit () +{ + if (iflag) { + dpyreset (); + iflag = FALSE; + } +} + +dpyreset () +{ + if (!iflag) isdisplay (); + tyo_flush (); + if (cflag) { + /* restore mode */ + _DOBE (PRIOU); + _SFMOD (PRIOU, omode); + _STPAR (PRIOU, omode); + cflag = FALSE; + } +} + +dpyon () +{ + if (!iflag) isdisplay (); + tyo_flush (); + if (!cflag) { + /* binary mode (no translation), but leave page mode alone */ + int nmode; + omode = _RFMOD (PRIOU); + nmode = omode & ~04300; /* no echo, binary */ + _DOBE (PRIOU); + _SFMOD (PRIOU, nmode); + cflag = TRUE; + } +} + +int dpymove (ln, cn) +{ + char buf[10]; + if (!iflag) isdisplay (); + if (!cflag) dpyon (); + switch (ttype) { + case IMLAC: + tyos ("\177\021"); tyo (++ln); tyo (++cn); + return; + case HP264X: + tyos ("\033&a"); + itoa (ln, buf); tyos (buf); tyo ('r'); + itoa (cn, buf); tyos (buf); tyo ('C'); + return; + case VT100: + tyos ("\033["); + if (ln > 0) {itoa (++ln, buf); tyos (buf);} + tyo (';'); + if (cn > 0) {itoa (++cn, buf); tyos (buf);} + tyo ('H'); + return; + case VT52: + tyos ("\033Y"); tyo (ln + 32); tyo (cn + 32); + return; + case DATAMEDIA: /* do ^L col XOR 0140, row XOR 0140 */ + tyo ('\014'); tyo (cn ^ 0140); tyo (ln ^ 0140); + return; + } +} + +spctty (c) +{ + if (!iflag) isdisplay (); + if (!cflag) dpyon (); + switch (ttype) { + case IMLAC: + tyo (0177); + switch (c) { + case 'B': tyo (0211-0176); return; + case 'C': tyo (0220-0176); return; + case 'D': tyo (0212-0176); return; + case 'E': tyo (0202-0176); return; + case 'K': tyo (0204-0176); return; + case 'L': tyo (0203-0176); return; + case 'T': tyo (0217-0176); + tyo (0+1); /* vertical */ + tyo (0+1); /* horizontal */ + return; + } + return; + case VT100: + switch (c) { + case 'B': tyos ("\033[D"); return; + case 'C': tyos ("\033[H\033[J"); return; + case 'D': tyos ("\033[B"); return; + case 'E': tyos ("\033[J"); return; + case 'K': return; + case 'L': tyos ("\033[K"); return; + case 'T': tyos ("\033[H"); return; + } + return; + case HP264X: + case VT52: + switch (c) { + case 'B': tyos ("\033D"); return; + case 'C': tyos ("\033H\033J"); return; + case 'D': tyos ("\033B"); return; + case 'E': tyos ("\033J"); return; + case 'K': return; + case 'L': tyos ("\033K"); return; + case 'T': tyos ("\033H"); return; + } + return; + case DATAMEDIA: + switch (c) { + case 'B': tyo ('\010'); return; + case 'C': tyos ("\002\037"); return; + case 'D': tyo ('\012'); return; + case 'E': tyo ('\037'); return; + case 'K': tyo ('\034'); return; + case 'L': tyo ('\027'); return; + case 'T': tyo ('\002'); return; + } + return; + } + tyos ("\r\n"); +} + +tyo (c) +{ + *ctyop++ = c; + if (ctyop >= tyobuf + (TYOSIZ-2)) tyo_flush (); +} + +tyos (s) +register char *s; +{ + register int c; + while (c = *s++) tyo (c); +} + +utyo (c) +{ + tyo_flush (); + _BOUT (PRIOU, c); +} + +int utyi () +{ + register char c; + if (!iflag) isdisplay (); + if (!cflag) dpyon (); + tyo_flush (); + c = _BIN (PRIIN); + return (c & 0177); +} + +tyo_flush () +{ + if (ctyop > tyobuf) { + _SOUT (PRIOU, mkbptr (tyobuf), tyobuf - ctyop, 0); + ctyop = tyobuf; + } +} diff --git a/c20/new/lib/c20typ.c b/c20/new/lib/c20typ.c new file mode 100644 index 00000000..1dfb3e56 --- /dev/null +++ b/c20/new/lib/c20typ.c @@ -0,0 +1,141 @@ +#define _U 01 +#define _L 02 +#define _N 04 +#define _S 010 +#define _P 020 +#define _C 040 +#define _X 0100 + +/* Character types for use by ctype.h */ + +char _ctype_[] = { +_C, /* NUL */ +_C, /* SOH */ +_C, /* STX */ +_C, /* ETX */ +_C, /* EOT */ +_C, /* ENQ */ +_C, /* ACK */ +_C, /* BEL */ +_C, /* BS */ +_C|_S, /* HT */ +_C|_S, /* LF */ +_C|_S, /* VT */ +_C|_S, /* FF */ +_C|_S, /* CR */ +_C, /* SO */ +_C, /* SI */ +_C, /* DLE */ +_C, /* DC1 */ +_C, /* DC2 */ +_C, /* DC3 */ +_C, /* DC4 */ +_C, /* NAK */ +_C, /* SYN */ +_C, /* ETB */ +_C, /* CAN */ +_C, /* EM */ +_C, /* SUB */ +_C, /* ESC */ +_C, /* FS */ +_C, /* GS */ +_C, /* RS */ +_C, /* US */ +_S, /* SP */ +_P, /* ! */ +_P, /* " */ +_P, /* # */ +_P, /* $ */ +_P, /* % */ +_P, /* & */ +_P, /* ' */ +_P, /* ( */ +_P, /* ) */ +_P, /* * */ +_P, /* + */ +_P, /* , */ +_P, /* - */ +_P, /* . */ +_P, /* / */ +_N, /* 0 */ +_N, /* 1 */ +_N, /* 2 */ +_N, /* 3 */ +_N, /* 4 */ +_N, /* 5 */ +_N, /* 6 */ +_N, /* 7 */ +_N, /* 8 */ +_N, /* 9 */ +_P, /* : */ +_P, /* ; */ +_P, /* < */ +_P, /* = */ +_P, /* > */ +_P, /* ? */ +_P, /* @ */ +_U|_X, /* A */ +_U|_X, /* B */ +_U|_X, /* C */ +_U|_X, /* D */ +_U|_X, /* E */ +_U|_X, /* F */ +_U, /* G */ +_U, /* H */ +_U, /* I */ +_U, /* J */ +_U, /* K */ +_U, /* L */ +_U, /* M */ +_U, /* N */ +_U, /* O */ +_U, /* P */ +_U, /* Q */ +_U, /* R */ +_U, /* S */ +_U, /* T */ +_U, /* U */ +_U, /* V */ +_U, /* W */ +_U, /* X */ +_U, /* Y */ +_U, /* Z */ +_P, /* [ */ +_P, /* \ */ +_P, /* ] */ +_P, /* ^ */ +_P, /* _ */ +_P, /* ` */ +_L|_X, /* a */ +_L|_X, /* b */ +_L|_X, /* c */ +_L|_X, /* d */ +_L|_X, /* e */ +_L|_X, /* f */ +_L, /* g */ +_L, /* h */ +_L, /* i */ +_L, /* j */ +_L, /* k */ +_L, /* l */ +_L, /* m */ +_L, /* n */ +_L, /* o */ +_L, /* p */ +_L, /* q */ +_L, /* r */ +_L, /* s */ +_L, /* t */ +_L, /* u */ +_L, /* v */ +_L, /* w */ +_L, /* x */ +_L, /* y */ +_L, /* z */ +_P, /* { */ +_P, /* | */ +_P, /* } */ +_P, /* ~ */ +_P /* DEL */ +}; + diff --git a/c20/new/lib/c2ddbg.c b/c20/new/lib/c2ddbg.c new file mode 100644 index 00000000..a7915962 --- /dev/null +++ b/c20/new/lib/c2ddbg.c @@ -0,0 +1,79 @@ +#include + +#rename stacktrace "STACKT" +#rename getfp "GETFP" +#rename pdlbot "PDL" +#rename seg1lo "SEG1LO" +#rename seg1hi "SEG1HI" +#rename begint "BEGINT" +#rename endint "ENDINT" +#rename pclev3 "PCLEV3" +#rename debug "DEBUG" +#rename debugc "DEBUGC" + +extern int *pdlbot,*seg1lo,*seg1hi,*pclev3; +extern int begint,endint; +char debugc; /* current debugger interrupt char */ + +stacktrace() +{ + int *fp,*rpc,*bp,*aptr,*crpc; + char funname[9],*funptr; + int nargs; + + printf("Stack trace:\n\n"); + fp = getfp() & 0777777; + while (fp > pdlbot) { + rpc = *(fp-1) & 0777777; + fp = *fp & 0777777; + crpc = *(fp-1) & 0777777; + aptr = (int *) ((int) (fp-2) & 0777777); + if ((rpc >= &begint) && (rpc <= &endint)) { + rpc = (int *) ((int) pclev3 & 0777777); + } + if ((rpc < seg1lo) || (rpc > seg1hi)) { + printf("Trace error: PC not in Code segment\n\n"); + printf("This may occur if the stack is trashed,\n"); + printf("or you may have been in the middle of a\n"); + printf("procedure call. Try again.\n"); + return; + } + while (rpc >= seg1lo) { + if ((*rpc >> 27) == 0) break; /* should be header */ + rpc--; + } + bp = consbp(7,*rpc & 0777777); /* get function name */ + funptr = funname; + while (*funptr = ildb(&bp)) + funptr++; + *funptr = 0; + nargs = (*rpc >> 18) & 077; + printf("%s (",funname); + for (;nargs > 0;nargs--,aptr--) { + printf("%d",*aptr); + if (nargs > 1) putchar(','); + } + printf(")\n\tCalled from %o\n\n",crpc); + if (!strcmp(funname,"main")) break; + } +} + +chgdbc(chr) /* change debugger interrupt char, or -1 to have none */ +int chr; +{ + if (debugc != -1) + _dti(halves(debugc,0)); + if (chr != -1) + _ati(halves(chr,0)); + debugc = chr; +} + +debug(argc,argv) /* called instead of "main" by runtimes */ +int argc; char **argv; +{ + + iset(0,stacktrace); /* tie channel 0 to stacktrace */ + debugc = '\004'; + _ati(halves('\004',0)); /* tie channel 0 to ^D */ + main(argc,argv); /* go to it */ +} diff --git a/c20/new/lib/c2ddrn.cmid b/c20/new/lib/c2ddrn.cmid new file mode 100644 index 00000000..62fbf91b --- /dev/null +++ b/c20/new/lib/c2ddrn.cmid @@ -0,0 +1,248 @@ +; +; c2ddrn - debugging runtime support for C programs +; + +title c2ddrn +.insrt c:minsrt + +.global $argc,$argv +.global chntab,prctab,lowlim,hilim,stackt + +pdlsiz==20000 ; desired pdl size + +; +; start-up routine +; + +begin": move a,[440700,,[0]] ; null string + rscan ; set rscan buffer to null +start: skipa + setom cclflg ;set ccl flag if started at +1 + reset + + movei 1,.fhslf ;activate the interrupt system + move 2,[levtab,,chntab] + sir + movei 1,.fhslf + eir + movei 1,.fhslf + move 2,[400400,,000000] ;enable pdl overflow, debugger channels + aic + + skipe lowlim ; if restarting, don't init free storage + jrst r1 ; system. + move p,pdlbot ; start runtime stack + movei ep,(p) ; first frame pointer + move a,seg3hi" ; top of symbol table + addi a,1000 ; get ready to ... + lsh a,-9. ; turn it into a page number + movem a,lowlim ; and mark as lower memory bound + move a,[.fhslf,,770] ; we are going to find out if DDT is here + rmap + came a,[-1] ;does this page exist? yes -> DDT loaded + skipa a,[760] ;top of core if DDT is loaded + movei a,1000 ;top of core if DDT isn't loaded + movem a,hilim ;is upper memory bound (you can't use DDT!) + ccall ainit ;initialise the storage allocator + +r1: mcall setup + +restart: + mcall debug,[$argc,[[$argv]]] ;run the users program + ccall exit,[[[0]]] ;and go home (this never returns) + + +; +; interrupt handlers +; + +pdlsrv: + hrroi a,[asciz/?Fatal stack overflow - Can't continue +/] + psout + haltf + jrst pdlsrv + debrk + + +; +; exit routines +; + +centry %exit,[cc] ;exit without cleaning up files + move a,cc ;can be continued + haltf + +centry exit,[cc] + ccall closall ; close all c files + move a,cc + + move c,a ; save return code + seto a, + closf ; close all files + jfcl + move a,c + haltf ; commit suicide +.exit1: hrroi a,[asciz/?Can't continue from exit() call +/] + psout + haltf + jrst .exit1 + + + +; +; number conversion +; + +cfix": cfix ; convert float to int + movm 0,-1(p) + fadr 0,[.499999] + fix 0,0 + skipge -1(p) + movns 0 + movem 0,-1(p) + popj p, + +cfloat": + fltr 0,-1(p) + movem 0,-1(p) + popj p, + +; impure area + +.idata + +mdata cclflg + 0 ; -1 if started from CCL +timing: block 1 ; timing flag +exiter: block 1 ; exit routine (for timing) +pdl": block pdlsiz ; the stack + +chntab: 0,,intr0 ;debugger + 0,,intr1 + 0,,intr2 + 0,,intr3 + 0,,intr4 + 0,,intr5 + 0,,intr6 + 0,,intr7 + 0,,intr8 + 1,,pdlsrv ; pdlov handler + 0,,intr10 + 0,,intr11 + 0,,intr12 + 0,,intr13 + 0,,intr14 + 0,,intr15 + 0,,intr16 + 0,,intr17 + 0,,intr18 + 0,,intr19 + 0,,intr20 + 0,,intr21 + 0,,intr22 + 0,,intr23 + 0,,intr24 + 0,,intr25 + 0,,intr26 + 0,,intr27 + 0,,intr28 + 0,,intr29 + 0,,intr30 + 0,,intr31 + 0,,intr32 + 0,,intr33 + 0,,intr34 + 0,,intr35 +.code +intr0: jsr intr +intr1: jsr intr +intr2: jsr intr +intr3: jsr intr +intr4: jsr intr +intr5: jsr intr +intr6: jsr intr +intr7: jsr intr +intr8: jsr intr + jsr intr +intr10: jsr intr +intr11: jsr intr +intr12: jsr intr +intr13: jsr intr +intr14: jsr intr +intr15: jsr intr +intr16: jsr intr +intr17: jsr intr +intr18: jsr intr +intr19: jsr intr +intr20: jsr intr +intr21: jsr intr +intr22: jsr intr +intr23: jsr intr +intr24: jsr intr +intr25: jsr intr +intr26: jsr intr +intr27: jsr intr +intr28: jsr intr +intr29: jsr intr +intr30: jsr intr +intr31: jsr intr +intr32: jsr intr +intr33: jsr intr +intr34: jsr intr +intr35: jsr intr + +; note: only one level of interrupts permitted (level 3)! +begint": +intr: 0 ; clobbered by jsr + movem 0,intsav ; save all registers + movei 0,intsav+1 + hrli 0,1 + blt 0,intsav+p + hrrz 1,intr ; find out interrupt number + subi 1,intr0+1 + movem 1,intnum + pushj p,@prctab(1) ; call routine + hrli 0,intsav+1 + hrri 0,1 + blt 0,p + move 0,intsav + setzm intnum + debrk +endint": + +mentry dismiss + skipn intnum + jrst ds$1 + movei b,ds$1 + hrli b,010000 ; turn on user-mode bit + movem b,pclev3 + setzm intnum + debrk +ds$1: return + +.idata +levtab: pclev1 + pclev2 ; not used currently + pclev3 + +pclev1":block 1 +pclev2":block 1 +pclev3":block 1 + +intsav: block p+1 +pdlbot: <-pdlsiz,,pdl> +pdltop: pdl+pdlsiz-1 + +prctab: 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 + 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 + 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 + +intnum: 0 +lowlim: 0 +hilim: 0 + +patch: block 100 + +end start diff --git a/c20/new/lib/c2dmdb.cmid b/c20/new/lib/c2dmdb.cmid new file mode 100644 index 00000000..a64b2d20 --- /dev/null +++ b/c20/new/lib/c2dmdb.cmid @@ -0,0 +1,14 @@ +; +; getfp - get the stack frame pointer of the procedure that +; called this one. +; + +title getfp +.insrt c:minsrt.mid + +mentry getfp + move a,ep ;our frame pointer + move a,(a) ;our caller's frame pointer + return + + end diff --git a/c20/new/lib/cddt.c b/c20/new/lib/cddt.c new file mode 100644 index 00000000..17d2fccd --- /dev/null +++ b/c20/new/lib/cddt.c @@ -0,0 +1,353 @@ +#include +#include +#include "cddt.h" + +#rename uuohnd "UUOHND" + +uuohnd(op,arglist) +int op; +int *arglist; +{ + switch(op) { + case 1: /* initialization. happens right before main() */ + /* is executed. no args, this is just to let the */ + /* user get control and set things up */ + + iniddt(); + break; + + case 2: /* beginning of execution of a line of code */ + /* *arglist is the line number, *(arglist+1) */ + /* is the starting address of a packed asciz */ + /* string giving the file name */ + + line(arglist); + break; + + case 3: /* function entry point. *arglist is the address */ + /* of a packed asciz string containing the funct */ + /* name. *(arglist+1) is the number of arguments */ + /* *(arglist+2) on up is the address of a data */ + /* block for each argument. I dont know what's in*/ + /* each data block yet. */ + + break; + + case 4: /* function exit. arglist should be some information */ + /* about the returned value, i guess */ + + break; + } + +} + +extern int consbp(),ildb(); + +static line(arglist) +int *arglist; +{ + int lineno; + int bp; + char filename[40]; + register char *fp; + + lineno = *arglist; /* get line number */ + bp = consbp(7,arglist+1); /* get file name */ + fp = filename; + while (*fp = ildb(&bp)) + if (*fp != '"') fp++; /* kill quotes */ + *fp = 0; + + printf("Line %d, file %s\n",lineno,filename); +} + + +/* gets control whenever we want info from the user */ + +static command() +{ + char ch; + +again: + tyos("\r\nCDDT>"); + tyo_flush(); + ch = utyi(); + ch = isupper(ch) ? tolower(ch): ch; + switch (ch) { + case '?': + tyos("\n\tType one of the following single character commands:"); + tyos("\r\n\n"); + tyos("\tS(et) a breakpoint or variable\r\n"); + tyos("\tR(emove) a breakpoint\r\n"); + tyos("\tB(egin) tracing at specified line number or function\r\n"); + tyos("\tE(nd) tracing at specified line number or function\r\n"); + tyos("\tD(isplay) stack frames\r\n"); + tyos("\tC(ontinue) program execution\r\n"); + tyos("\tQ(uit) to superior level\r\n"); + tyo_flush(); + goto again; + case 'c': + return; + case 's': /* set something */ + doset(); + goto again; + case 'r': + doremove(); + goto again; + case 'b': + dobeg(); + goto again; + case 'e': + doend(); + goto again; + case 'd': + dodisp(); + goto again; + case 'q': + tyos("Quit\r\n"); + exit(); + default: + tyos(" Unknown command - type a ? for help\r\n"); + } +} + +static doset() +{ + char ch; + + tyos("Set "); +again: + tyo_flush(); + ch = utyi(); + ch = isupper(ch) ? tolower(ch): ch; + switch (ch) { + case '?': + tyos("\r\n"); + tyos("\tB(reakpoint) at line or function call\r\n"); + tyos("\tV(ariable) to a value\r\n"); + tyos("\tQ(uit) to main command loop\r\n"); + tyos("\r\nSet "); + goto again; + case 'b': + setbreak(); + break; + case 'v': + setvar(); + break; + case 'q': + tyos("Quit\r\n"); + tyo_flush(); + break; + default: + loser(); + tyos("Set "); + goto again; + } +} + +static setvar() +{ + char ch; + + tyos("Variable "); + notyet(); + return; +} + + +static setbreak() +{ + char ch; + + tyos("Breakpoint at "); +again: + tyo_flush(); + ch = utyi(); + ch = isupper(ch) ? tolower(ch): ch; + switch (ch) { + case '?': + tyos("\r\n"); + tyos("\tL(ine) number\r\n"); + tyos("\tF(unction) name\r\n"); + tyos("\tE(xit) from function\r\n"); + tyos("\tQ(uit) to main command loop\r\n"); + tyos("\nSet Breakpoint at "); + goto again; + case 'l': + setbln(); + break; + case 'f': + notyet(); + break; + case 'e': + notyet(); + break; + case 'q': + tyos("Quit\r\n"); + break; + default: + loser(); + tyos("Set Breakpoint "); + goto again; + } +} + + +static doremove() +{ + char ch; + + tyos("Remove breakpoint number (? to show current breakpoints)"); +again: + tyo_flush; + ch = utyi(); + ch = isupper(ch) ? tolower(ch): ch; + switch (ch) { + case '?': + listbps(); + tyos("Remove Breakpoint "); + goto again; + default: + notyet; + } +} + +static dobeg() +{ + char ch; + +again: + tyos("Begin Tracing at "); + tyo_flush(); + ch = utyi(); + ch = isupper(ch) ? tolower(ch) : ch; + switch (ch) { + case '?': + tyos("\r\n"); + tyos("\tL(ine) number\r\n"); + tyos("\tF(unction) entry point\r\n"); + tyos("\tE(xit) from function\r\n"); + tyos("\tQ(uit) to main command loop\r\n"); + tyos("\r\n"); + goto again; + default: + notyet(); + break; + } +} + +static doend() +{ + char ch; + +again: + tyos("End Tracing at "); + tyo_flush(); + ch = utyi(); + ch = isupper(ch) ? tolower(ch) : ch; + switch (ch) { + case '?': + tyos("\r\n"); + tyos("\tL(ine) number\r\n"); + tyos("\tF(unction) entry point\r\n"); + tyos("\tE(xit) from function\r\n"); + tyos("\tQ(uit) to main command loop\r\n"); + tyos("\r\n"); + goto again; + default: + notyet(); + break; + } +} + +static dodisp() +{ + + tyos("D(isplay) stack frames. Number of levels? "); + tyo_flush(); + notyet(); +} + +static notyet() +{ + + tyos("\r\n\n - Sorry this isn't written yet\r\n"); + tyo_flush(); +} + +static loser() +{ + tyos(" Unknown command - type a ? for help\r\n"); +} + +static iniddt() +{;} + +main() { command();} + +listbps() +{ +notyet(); +} + +setbln() +{ +notyet(); +} + +static char *strsave(s) /* save a string somewhere */ +char *s; +{ +char *temp; + +if ((temp = calloc(1,1+strlen(s))) != NULL) + strcpy(temp,s); +else printf("CDDT: free memory exhausted\n"); +return (temp); +} + +tnode *tree(p,w,c,n) +tnode *p; +char *w; +int c; /* object class */ +int n; /* object number */ +{ + int cond; + + if (p == NULL) { /*at a leaf */ + p = (tnode *) calloc(1,sizeof(tnode)); + p->word = strsave(w); + p->left = p->right = NULL; + p->class = c; + p->number = n; + } + else if ((cond = strcmp(w,p->word) == 0) && c == p->class) + printf("tree: duplicate word: %s\n",w); + else if (cond < 0) + p->left = tree(p->left,w); + else + p->right = tree(p->right,w); + return(p); +} + +treeprint(p) +struct tnode *p; +{ + if (p != NULL) { + treeprint(p->left); + printf("%s\n",p->word); + treeprint(p->right); + } +} + +main() +{ + struct tnode *root; + char word[500]; + char * t; + + root = NULL; + while ((t = gets(word)) != NULL) + root = tree(root,word); + treeprint(root); +} diff --git a/c20/new/lib/date.c b/c20/new/lib/date.c new file mode 100644 index 00000000..bb3926ab --- /dev/null +++ b/c20/new/lib/date.c @@ -0,0 +1,229 @@ +# include + +/* + +DATE - Date and Time Hacking Routines + +These routines recognize three representations for dates: + +(1) CAL - calender date, a system-independent representation + consisting of a record containing six integers + for the year, month, day, hour, minute, and second + +(2) UDATE - the UNIX date representation, seconds since + Jan 1, 1970, GMT. + +(3) TDATE - the TOPS-20 date representation + + +The routines: + + u2cal (udate, cd) - convert udate to cal + udate = cal2u (cd) - convert cal to udate + t2cal (tdate, cd) - convert tdate to cal + tdate = cal2t (cd) - convert cal to tdate + prcal (cd, fd) - pretty-print cal block to a file + pr60th (time, fd) - pretty-print time (60th's sec) to file + now (cp) - fill *cp wih the current time and date + rtime () - return runtime for this job in 60th/sec + etime () - return logged-in time in 60th's + cputime () - return runtime for this process in 60th's + fcmdat (fp, cp) - *cp gets the creation/modification date + of the file pointed to by fp +*/ + +# define ZONE 5 /* offset of local zone from GMT */ + +# define month_tab1 mtab1 +# define month_tab2 mtab2 + +static int month_tab1[] = {0,31,59,90,120,151,181,212,243,273,304,334}; +static int month_tab2[] = {0,31,60,91,121,152,182,213,244,274,305,335}; +static int year_tab[] = {0,365,2*365,3*365+1}; + +# define four_years (4*365+1) + +static char *month_name[] = { + "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}; + +# define TRUE 1 +# define FALSE 0 + +static int srctab (tab, sz, n) +int *tab, sz, *n; +{ + register int *p, i; + + p = tab + sz; + i = *n; + + while (--p >= tab) { + if (*p <= i) { + *n = i - *p; + return (p - tab); + } + } + return (0); +} + +u2cal (udate, cd) +register cal *cd; +int udate; +{ + udate -= (ZONE * 60 * 60); + cd->second = udate % 60; udate /= 60; + cd->minute = udate % 60; udate /= 60; + cd->hour = udate % 24; udate /= 24; + cd->year = 1970 + 4 * (udate / four_years); + udate %= four_years; + cd->year += srctab (year_tab, 4, &udate); + cd->month = srctab (cd->year % 4 == 0 ? month_tab2 : month_tab1, + 12, &udate) + 1; + cd->day = udate + 1; +} + +int cal2u (cd) +register cal *cd; +{ + register int udate, year; + + year = cd->year; + udate = cd->second + 60 * (cd->minute + 60 * + (cd->hour + 24 * (cd->day - 1))); + udate += (year % 4 == 0 ? month_tab2 : month_tab1) [cd->month - 1] + * 60 * 60 * 24; + year -= 1970; + if (year < 0) year = 0; + udate += 60 * 60 * 24 * (four_years * (year / 4) + year_tab[year % 4]); + udate += (ZONE * 60 * 60); + return (udate); +} + +t2cal (tdate, cd) +register cal *cd; +{ + unsigned vec[3]; + register int udate; + _ODCNV (tdate, 0, vec); + cd->year = vec[0] >> 18; + cd->month = (vec[0] & 0777777) + 1; + cd->day = (vec[1] >> 18) + 1; + udate = vec[2] & 0777777; + cd->second = udate % 60; udate /= 60; + cd->minute = udate % 60; udate /= 60; + cd->hour = udate % 24; +} + +int cal2t (cd) +register cal *cd; +{ + char buf[100]; + FILE *f; + + f = fopen (buf, "ws"); + fprintf (f, "%d/%d/%d %d:%d:%d", cd->month, cd->day, cd->year, + cd->hour, cd->minute, cd->second); + fclose (f); + return (_IDTIM (mkbptr (buf), 0)); +} + +prcal (cd, f) +register cal *cd; +FILE *f; +{ + register char *s; + register int m; + m = cd->month - 1; + if (m >= 0 && m <= 11) s = month_name[m]; + else s = "?"; + fprintf (f, "%s%3d,%5d %02d:%02d:%02d", s, cd->day, cd->year, + cd->hour, cd->minute, cd->second); +} + +pr60th (time, file) +int time; +FILE *file; +{ + register int ss, sc, mn, hour, zs; + + if (time < 0) time = -time; + zs = TRUE; + ss = time % 60; + time = time / 60; + sc = time % 60; + time = time / 60; + mn = time % 60; + hour = time / 60; + if (hour) { + fprint (file, "%3d:", hour); + zs = FALSE; + } + else fprint (file, " "); + xput2 (mn, file, zs); + if (zs && mn == 0) putc (' ', file); + else { + putc (':', file); + zs = FALSE; + } + if (zs && !sc) fprint (file, " 0"); + else { + xput2 (sc, file, zs); + zs = FALSE; + } + putc ('.', file); + xput2 (ss, file, FALSE); + } + +static xput2 (val, file, zs) +FILE *file; +{ + register int num; + num = val / 10; + if (num > 0 || !zs) { + putc ('0' + num, file); + zs = FALSE; + } + else putc (' ', file); + num = val % 10; + if (num > 0 || !zs) putc ('0' + num, file); + else putc (' ', file); +} + +now (cp) +cal *cp; +{ + t2cal (_GTAD (), cp); +} + +int rtime () +{ + int rt, ct; + _RUNTM (-5, &rt, &ct); + return (rt * 60 / 1000); +} + +int etime () +{ + int rt, ct; + _RUNTM (-5, &rt, &ct); + return (ct * 60 / 1000); +} + +int cputime () +{ + int rt, ct; + _RUNTM (0400000, &rt, &ct); + return (rt * 60 / 1000); +} + +fcmdat (f, cp) +FILE *f; +cal *cp; +{ + int q; + _RTAD (fileno(f), &q, 1); + t2cal (q, cp); +} + + diff --git a/c20/new/lib/echo.c b/c20/new/lib/echo.c new file mode 100644 index 00000000..b48e6fec --- /dev/null +++ b/c20/new/lib/echo.c @@ -0,0 +1,11 @@ + + + + +#include + +main (argc, argv) + char **argv; + {argv++; + while (--argc >= 0) print("%s ",*argv++); + } diff --git a/c20/new/lib/echo.stinkr b/c20/new/lib/echo.stinkr new file mode 100644 index 00000000..ac3edbb9 --- /dev/null +++ b/c20/new/lib/echo.stinkr @@ -0,0 +1,3 @@ +x c:stdio +l echo +o echo.exe diff --git a/c20/new/lib/exec.c b/c20/new/lib/exec.c new file mode 100644 index 00000000..16363b9f --- /dev/null +++ b/c20/new/lib/exec.c @@ -0,0 +1,151 @@ +# include + +/********************************************************************** + + EXEC20 + +**********************************************************************/ + +int exctime = 0; +int exccode = 0; + +# define _NULIO 0377777 +# define JCLSIZE 500 +# define TRUE 1 + +/********************************************************************** + + EXECS - Execute a program with a given command string + + Returns: + + -5 Job valretted something and was not continued. + -4 Internal fatal error. + -3 Unable to load program file. + -2 Unable to create job. + -1 Unable to open program file. + 0 Job terminated normally. + other Job terminated abnormally with said PIRQ + + Sets: + + exctime - job's CPU time in 1/60 sec. units + exccode - contents of job's loc 1 at termination + +**********************************************************************/ + +int execs (pname, args) +char *pname, *args; +{ + register int rph; /* relative process handle */ + register int pjfn; /* jfn for program file */ + register int rc; /* return code */ + char jcl[JCLSIZE]; /* to construct JCL */ + + fnstd (pname, jcl); + pjfn = _GTJFN (halves (0100001, 0), mkbptr (jcl)); + if (pjfn >= 0600000) return (-1); + + rph = _CFORK (halves (0200000, 0), 0); + /* create process, with my capabilities */ + if (rph >= 0600000) { + _CLOSF (pjfn); + return (-2); + } + + rc = _GET (halves (rph, pjfn), 0); /* load program file */ + _CLOSF (pjfn); /* release program file */ + if (rc) { + _KFORK (rph); + return (-3); + } +/* _SPJFN (rph, _NULIO, _GPJFN (0400000) & 0777777); */ + + strcpy(jcl, pname); /* construct JCL line */ + strcat(jcl, " "); + strcat(jcl, args); + _RSCAN (mkbptr (jcl)); /* set JCL */ + _SFRKV (rph, 0); /* start job */ + + while (TRUE) { + register unsigned sts, code; + _WFORK (rph); + sts = _RFSTS (rph); + code = (sts >> 18) & 07777; + + if (code == 2) break; + if (code == 3) { + register int number; + number = sts & 0777777; + if (number == 12) { + int nwork, nused, nperm; + int usern, dirn, jobn, termn; + fprintf (stderr, "Disk quota exceeded.\n"); + _GJINF (&usern, &dirn, &jobn, &termn); + _GTDAL (dirn, &nwork, &nused, &nperm); + if (nused == nwork) { + _DELDF (0, dirn); + _GTDAL (dirn, &nwork, &nused, &nperm); + if (nused < nwork) { + fprintf (stderr, + "%d pages expunged\n", + nwork - nused); + goto restart; + } + } + } + fprintf (stderr, + "Process terminated, error number %d.\n", + number); + _KFORK (rph); + return (number); + } + fprintf (stderr, "Process terminated, status %d.\n", code); + if (code != 0) break; + restart: + _RFORK (rph); /* unfreeze it if it was frozen */ + _SFORK (rph, _RFPC (rph)); /* continue it */ + } + + { + int junk; + int acs[16]; + + _RUNTM (rph, &exctime, &junk); + exctime = exctime * 60 / 1000; + _RFACS (rph, acs); + exccode = acs[1]; + } + + _KFORK (rph); + return (0); +} + +/********************************************************************** + + EXECV - Execute file given a vector of arguments + +**********************************************************************/ + +int execv (prog, argc, argv) +char *prog, *argv[]; +{ + register char **ap, **ep, *p, *s; + char buff[JCLSIZE]; + register int c; + + p = buff; + ap = argv; + ep = argv + argc - 1; + + while (ap <= ep) { + s = *ap++; + *p++ = '"'; + while (c = *s++) *p++ = c; + *p++ = '"'; + *p++ = ' '; + } + + *p++ = 0; + return (execs (prog, buff)); +} diff --git a/c20/new/lib/files.c b/c20/new/lib/files.c new file mode 100644 index 00000000..c3fa815c --- /dev/null +++ b/c20/new/lib/files.c @@ -0,0 +1,132 @@ +# include + +/********************************************************************** + + FILES.C - This file contains useful stuff related to files + + fdmap (p, f) - p is a file spec string possibly containing + wildcard characters. Call the function f(s) + for each existing file matching the pattern p. + The argument s is the actual name of the file + currently being processed. + + exparg - given an argument vector possibly containing + wildcarded filenames, convert it to an argument + vector with all wildcarded filenames expanded. + Function return value is the new argc. + + +The next two are just specific uses of the routines in C20FNM.C + + outfnm - make an output file name, given an input file + name and a suffix. + + apfname _ generate a file name with a specific suffix. + + +**********************************************************************/ + + +# define QUOTE 22 /* control-V */ +# define TRUE 1 +# define FALSE 0 + +/********************************************************************** + + FDMAP (P, F) + + Call F(S) for all filenames S that match the pattern P. + +**********************************************************************/ + +fdmap (p, f) +char *p; +int (*f)(); +{ + register int jfn, rc; + char buf[100]; + + fnstd (p, buf); + rc = jfn = _GTJFN (halves (0100121, 0), + /* GJ%OLD+GJ%IFG+GJ%FLG+GJ%SHT */ + mkbptr (buf)); + while ((rc & 0600000) == 0) { + _JFNS (mkbptr (buf), jfn & 0777777, 0); + (*f)(buf); + _CLOSF (jfn); + rc = _GNJFN (jfn); + } +} + +/********************************************************************** + + EXPAND ARGUMENT VECTOR CONTAINING FILE NAME PATTERNS + TOPS-20 Version + +**********************************************************************/ + +static char **next; +static char *bufp; + +int exparg (argc, argv, outv, buffer) +char *argv[], *outv[], buffer[]; +{ + register int i; + int expfile(); + register char *s; + + bufp = buffer; + next = outv; + i = 0; + while (i < argc) { + s = argv[i++]; + if (expmagic (s)) fdmap (s, expfile); + else *next++ = s; + } + return (next - outv); +} + +static int expmagic (s) /* does it contain magic pattern chars? */ +register char *s; +{ + register int c; + while (c = *s++) switch (c) { + case '%': + case '*': return (TRUE); + case QUOTE: if (*s) ++s; continue; + } + return (FALSE); +} + +static expfile (s) +register char *s; +{ + *next++ = bufp; + while (*bufp++ = *s++); +} + +/********************************************************************** + + APFNAME - Append suffix to file name + +**********************************************************************/ + +char *apfname (dest, source, suffix) +char *dest, *source, *suffix; +{ + fnsfd (dest, source, 0, 0, 0, suffix, "", ""); + return (dest); +} + +/********************************************************************** + + OUTFNM - Make output file name + +**********************************************************************/ + +char *outfnm (dest, source, suffix) +char *dest, *source, *suffix; +{ + fnsfd (dest, source, "", 0, 0, suffix, "", ""); + return (dest); +} diff --git a/c20/new/lib/grep.c b/c20/new/lib/grep.c new file mode 100644 index 00000000..830b4bdc --- /dev/null +++ b/c20/new/lib/grep.c @@ -0,0 +1,451 @@ +/* Copyright (c) 1979 Regents of the University of California */ +#include +/* + * grep -- print lines matching (or not matching) a pattern + */ + +#define CCHR 2 +#define CDOT 4 +#define CCL 6 +#define NCCL 8 +#define CDOL 10 +#define CEOF 11 + +#define CBRC 14 +#define CLET 15 +#define STAR 01 + +#define LBSIZE 256 +#define ESIZE 256 + +char expbuf[ESIZE]; +long lnum; +char linebuf[LBSIZE+1]; +int bflag; +int nflag; +int cflag; +int vflag; +int nfile; +int iflag; + +int lflag; +int wflag; +int circf; +int blkno; +char ibuf[512]; +long tln; + +main(argc, argv) +char **argv; +{ + + char obuf[BUFSIZ]; + + while (--argc > 0 && (++argv)[0][0]=='-') { + char *cp = argv[0] + 1; + while (*cp) switch (*cp++) { + + case 'v': + vflag++; + continue; + + case 'b': + bflag++; + continue; + + + case 'i': + iflag++; + continue; + + case 'l': + lflag++; + + case 'c': + cflag++; + continue; + + case 'w': + wflag++; + continue; + + case 'n': + nflag++; + continue; + + + default: + fprintf(stderr, "Unknown flag\n"); + continue; + } + } + if(argc<=0) + exit(2); + compile(*argv); + nfile = --argc; + if (argc<=0) + execute(NULL); + else while (--argc >= 0) { + argv++; + fdmap(*argv,execute); + } + exit(0); +} + +compile(astr) +char *astr; +{ + register c; + register char *ep, *sp; + char *lastep; + int cclcnt; + + ep = expbuf; + sp = astr; + if (*sp == '^') { + circf++; + sp++; + } + if (wflag) + *ep++ = CBRC; + for (;;) { + if (ep >= &expbuf[ESIZE]) + goto cerror; + + if ((c = *sp++) != '*') + lastep = ep; + switch (c) { + + case '\0': + if (wflag) + *ep++ = CLET; + *ep++ = CEOF; + return; + + case '.': + *ep++ = CDOT; + continue; + + case '*': + if (lastep==0) + goto defchar; + + *lastep |= STAR; + continue; + + case '$': + if (*sp != '\0') + goto defchar; + *ep++ = CDOL; + continue; + + case '[': + *ep++ = CCL; + *ep++ = 0; + cclcnt = 1; + if ((c = *sp++) == '^') { + c = *sp++; + ep[-2] = NCCL; + } + do { + *ep++ = c; + cclcnt++; + if (c=='\0' || ep >= &expbuf[ESIZE]) + goto cerror; + } while ((c = *sp++) != ']'); + lastep[1] = cclcnt; + continue; + + + case '\\': + if ((c = *sp++) == '\0') + goto cerror; + if (c == '<') { + + *ep++ = CBRC; + continue; + } + if (c == '>') { + *ep++ = CLET; + + continue; + } + defchar: + default: + *ep++ = CCHR; + *ep++ = c; + + } + } + cerror: + fprintf(stderr, "RE error\n"); +} + +same(a, b) + register + int a, b; +{ + + return (a == b || iflag && (a ^ b) == ' ' && letter(a) == letter(b)); +} + +letter(c) + register int c; +{ + + if (c >= 'a' && c <= 'z') + return (c); + if (c >= 'A' && c <= 'Z') + return (c + 'a' - 'A'); + return (0); +} + +execute(file) +{ + register char *p1, *p2; + register c; + FILE *f; + char *ebp, *cbp; + + if (file != NULL) { + if((f = fopen(file, "r")) == NULL) { + fprintf(stderr, "Can't open %s\n", file); + exit(1); + } + + } else + f = stdin; + ebp = ibuf; + cbp = ibuf; + lnum = 0; + tln = 0; + blkno = -1; + for (;;) { + lnum++; + if((lnum&0377) == 0) + fflush(stdout); + p1 = linebuf; + p2 = cbp; + for (;;) { + if (p2 >= ebp) { + if ((c = lread( f, ibuf, 512)) <= 0) { + fclose(f); + if (cflag) { + if (lflag) { + if (tln) + printf("%s\n", file); + } else { + if (nfile > 1) + printf("%s:", file); + + printf("%ld\n", tln); + } + } + return; + } + blkno++; + + p2 = ibuf; + ebp = ibuf+c; + } + if ((c = *p2++) == '\n') + break; + + if(c) + if (p1 < &linebuf[LBSIZE-1]) + *p1++ = c; + } + *p1++ = 0; + cbp = p2; + p1 = linebuf; + p2 = expbuf; + if (circf) { + if (advance(p1, p2)) + goto found; + goto nfound; + } + /* fast check for first character */ + if (*p2==CCHR) { + c = p2[1]; + do { + if (*p1!=c && (!iflag || (c ^ *p1) != ' ' + || letter(c) != letter(*p1))) + continue; + if (advance(p1, p2)) + goto found; + + } while (*p1++); + goto nfound; + } + /* regular algorithm */ + do { + if (advance(p1, p2)) + goto found; + } while (*p1++); + nfound: + if (vflag) + succeed(file); + continue; + found: + if (vflag==0) + succeed(file); + } +} + +advance(alp, aep) +char *alp, *aep; +{ + + register char *lp, *ep, *curlp; + char *nextep; + + lp = alp; + ep = aep; + for (;;) switch (*ep++) { + + case CCHR: + if (!same(*ep, *lp)) + return (0); + + ep++, lp++; + continue; + + case CDOT: + if (*lp++) + continue; + return(0); + + case CDOL: + if (*lp==0) + continue; + return(0); + + case CEOF: + +return(1); + + case CCL: + if (cclass(ep, *lp++, 1)) { + ep += *ep; + continue; + } + return(0); + + case NCCL: + if (cclass(ep, *lp++, 0)) { + ep += *ep; + continue; + } + return(0); + + case CDOT|STAR: + curlp = lp; + while (*lp++); + goto star; + + case CCHR|STAR: + curlp = lp; + while (same(*lp, *ep)) + lp++; + lp++; + ep++; + goto star; + + case CCL|STAR: + case NCCL|STAR: + curlp = lp; + while (cclass(ep, *lp++, ep[-1]==(CCL|STAR))); + ep += *ep; + goto star; + + star: + do { + lp--; + if (advance(lp, ep)) + return(1); + } while (lp > curlp); + return(0); + + case CBRC: + if (lp == expbuf) + continue; + +#define uletter(c) (letter(c) || c == '_') + + if (uletter(*lp) && !uletter(lp[-1]) && !digit(lp[-1])) + continue; + return (0); + + case CLET: + if (!uletter(*lp) && !digit(*lp)) + continue; + return(0); + + default: + fprintf(stderr, "RE botch\n"); + } +} + +cclass(aset, ac, af) +char *aset; +{ + register char *set, c; + register n; + + set = aset; + if ((c = ac) == 0 +) + return(0); + n = *set++; + while (--n) + if (n > 2 && set[1] == '-') { + if (c >= (set[0] & 0177) && c <= (set[2] & 0177)) + return (af); + set += 3; + n -= 2; + } else + if((*set++ & 0177) == c) + return(af); + return(!af); +} + +succeed(f) +{ + if(cflag) { + tln++; + return; + } + if (nfile > 1) + printf("%s:", f); + if (bflag) + printf("%l:", blkno); + if (nflag) + printf("%ld:", lnum); + printf("%s\n", linebuf); +} + +digit(c) + char c; +{ + return (c>='0' && c<='9'); +} + +/* local read routine... + * return number of chars read + */ + +lread(ioptr, buf, count) +FILE *ioptr; +char *buf; +{ + int i = 0; + int val; + while (i <= count) + { + val = getc(ioptr); + if (val == EOF) break; + buf[i++] = val; + + } + return(i); +} diff --git a/c20/new/lib/hpio.c b/c20/new/lib/hpio.c new file mode 100644 index 00000000..4cb066bf --- /dev/null +++ b/c20/new/lib/hpio.c @@ -0,0 +1,423 @@ +#include + +# define TRUE 1 +# define FALSE 0 + +/* Low level I/O stuff for HP plotters */ +/* Routines include: + h_init + h_open + h_close + h_exit + h_flush + h_putc + h_puts + h_sbn + h_mbn + h_mbp + h_pmb + h_mba + +*/ + +#define BUF_ENQ '\005' +#define BUF_RDY '\006' +#define BUFSIZE 128 + +#define init_plotter _hpip + + +#define REP struct _rep +struct _rep { + int jfn; + int index; + char can_use; + char buffer[BUFSIZE]; + }; + + +/********************************************************************** +* h_init - returns pointer to a "stream" +**********************************************************************/ + +REP *h_init () + { + register REP *temp; + + temp = (REP *) calloc (1, sizeof (REP)); + temp->can_use = FALSE; + return (temp); + } + +/********************************************************************** +* h_open - attach a stream to a device name +**********************************************************************/ + +h_open (stream, file) +register REP *stream; +char *file; + { + int errno,flag,oflag; + + flag = 01000000; + + stream->jfn = _GTJFN (flag,mkbptr(file)); + if (stream->jfn > 0600000) { + h_error ("h_open: Can't find the plotter..."); + exit(1); + } + oflag = 04000300000; /* read/write, image... */ + errno = _OPENF(stream->jfn,oflag | 7<<30); + if (errno) { + h_error ("h_open: Can't open plotter (probably in use...)"); + exit(1); + } + stream->can_use = TRUE; + stream->index = 0; + + init_plotter(stream); + } + +static init_plotter (stream) +REP *stream; + { + char line[200], temp[100]; + + strcpy (line, "\033.(\033.J\033.K\033.I"); + sprintf (temp, "%d;%d;%d;0:", BUFSIZE,BUF_ENQ,BUF_RDY); + strcat (line, temp); + h_pts (stream, line); + _dump (stream); + } + + +/********************************************************************** +* h_close - close stream +**********************************************************************/ + +h_close (stream) +REP *stream; + { + if (stream->can_use = TRUE) { + h_flush (stream); + h_pts (stream, "\033.L"); /* wait till buffer empty */ + _dump (stream); + while (h_getc (stream) != '\015') + ; + h_pts (stream, "\033.)"); /* turn plotter off */ + _dump (stream); + _CLOSF(stream->jfn); + stream->can_use = FALSE; + } + } + + +/*********************************************************************** +* check if stream to plotter is alive +**********************************************************************/ + +static check_can_use (stream) +REP *stream; + { + return (stream->can_use); + } + +/********************************************************************** +* write a char to the plotter +**********************************************************************/ + +h_ptc (stream,chr) +register REP *stream; +char chr; + { + register int i; + + i = stream->index + 1; + stream->index = i; + stream->buffer[i] = chr; + if (i >= BUFSIZE) + h_flush (stream); + } + +/********************************************************************** +* h_getc - get char from plotter (unbuffered) +**********************************************************************/ + +static h_getc (stream) +REP *stream; + { + return ((_BIN (stream->jfn)) & 0177); + } + + +/********************************************************************** +* write a string to the plotter +**********************************************************************/ + +h_pts (stream, str) +register REP *stream; +register char *str; + { + while (*str) { + h_ptc (stream, *str); + str++; + } + } + +/********************************************************************** +* write a SBN to the plotter +**********************************************************************/ + +h_sbn (stream, i) +register REP *stream; +int i; + { + if ((i < 0) || (i > 63)) { + h_error ("h_sbn: SBN out of range"); + i = 0; + } + if (i < 32) i += 64; + _puti (stream, i); + } + +/********************************************************************** +* write a MBN to the plotter +**********************************************************************/ + +h_mbn (stream, i) +REP *stream; +register int i; + { + register int n1,n2,n3,nr; + + if ((i < 0) || (i > 32767)) { + h_error ("h_mbn: MBN out of range"); + i = 0; + } + if (i < 16) { /* single byte */ + _puti (stream, i + 96); + return; + } + if (i < 1024 ) { /* two bytes needed */ + n1 = i / 64; + n2 = i % 64; + _puti (stream, n1 + 96); + h_sbn (stream, n2); + return; + } + /* here for three digit number */ + n1 = i / 4096; + nr = i % 4096; + n2 = nr / 64; + n3 = nr % 64; + _puti (stream, n1 + 96); + h_sbn (stream, n2); + h_sbn (stream, n3); + } + +/********************************************************************** +* write MBP to plotter +**********************************************************************/ + +h_mbp (stream, x, y) +REP *stream; +register int x,y; + { + int nx1,nx2,nx3,nxr; + int ny1,ny2,ny3,ny4,ny5,nyr; + int nmax; + + if ((x < 0) || (x > 16383) || (y < 0) || (y > 16383)) { + h_error ("h_mbp: MBP out of range"); + x = y = 0; + } + if (x > y) nmax = x; else nmax = y; + if (nmax < 4) { /* single byte */ + _puti (stream, y + 4*x + 96); + return; + } + if (nmax < 32) { /* two bytes */ + nx1 = x / 2; + nx2 = x % 2; + _puti (stream, nx1 + 96); + h_sbn (stream, y + 32*nx2); + return; + } + if (nmax < 256) { /* three bytes */ + nx1 = x / 16; + nx2 = x % 16; + ny2 = y / 64; + ny3 = y % 64; + _puti (stream, nx1 + 96); + h_sbn (stream, ny2 + 4*nx2); + h_sbn (stream, ny3); + return; + } + if (nmax < 2048) { /* four bytes */ + nx1 = x / 128; + nxr = x % 128; + nx2 = nxr / 2; + nx3 = nxr % 2; + ny3 = y / 64; + ny4 = y % 64; + _puti (stream, nx1 + 96); + h_sbn (stream, nx2); + h_sbn (stream, ny3 + 32*nx3); + h_sbn (stream, ny4); + return; + } + /* here for five bytes */ + nx1 = x / 1024; + nxr = x % 1024; + nx2 = nxr / 16; + nx3 = nxr % 16; + ny3 = y / 4096; + nyr = y % 4096; + ny4 = nyr / 64; + ny5 = nyr % 64; + _puti (stream, nx1 + 96); + h_sbn (stream, nx2); + h_sbn (stream, ny3 + 4*nx3); + h_sbn (stream, ny4); + h_sbn (stream, ny5); + } + +/********************************************************************** +* write PMB to plotter +**********************************************************************/ + +h_pmb (stream, x, y) +REP *stream; +int x,y; + { + _ppmb (stream, x, 64); + _ppmb (stream, y, 32); + } + +static _ppmb (stream, val, flag) +REP *stream; +int val, flag; + { + register int nx1,nx2,nx3,nxr; + + if ((val < -16384) || (val > 16383)) { + h_error ("_ppmb: PMB out of range"); + val = 0; + } + if ((-16 <= val) && (val < 16)) { + val = _abs (val, 32); + _puti (stream, val + flag); + return; + } + if ((-512 <= val) && (val < 512)) { + val = _abs (val, 1024); + nx1 = val / 32; + nx2 = val % 32; + _puti (stream, nx1 + flag); + _puti (stream, nx2 + flag); + return; + } + val = _abs (val, 32768); + nx1 = val / 1024; + nxr = val % 1024; + nx2 = nxr / 32; + nx3 = nxr % 32; + _puti (stream, nx1 + flag); + _puti (stream, nx2 + flag); + _puti (stream, nx3 + flag); + } + +/********************************************************************** +* h_mba - write MBA to plotter +**********************************************************************/ + +h_mba (h,a) +REP *h; +int a; + { + int na,np1,na1,na2,na3,nr; + if ((a < 0) || (a > 360)) { + h_error ("h_mba: Angle out of range"); + a = 0; + } + np1 = 0; + if (a > 180) { + np1 = 8; + a -= 180; + } + na = (int) (((float) a) * 32768.0 / 180.0); + na1 = na / 4096; + _puti (h,np1+na1+96); + nr = na % 4096; + if (nr = 0) + return; + na2 = nr / 64; + h_sbn (h,na2); + na3 = nr % 64; + if (na3 = 0) + return; + h_sbn (h,na3); + } + + +static _abs (i, offset) +register int i, offset; + { + if (i < 0) i += offset; + return (i); + } + +/********************************************************************** +* h_error - report an error +**********************************************************************/ + +h_error (msg) +register char *msg; + { + fprintf (stderr, "%s\n", msg); + } + +/********************************************************************** +* h_flush - send accumulated output +**********************************************************************/ + +h_flush (stream) +REP *stream; + { + buf_wait (stream); + _dump (stream); + er_chk (stream); + } + +static _puti (stream, i) +REP *stream; +int i; + { + h_ptc (stream,i); + } + +static buf_wait (stream) +REP *stream; + { + char c; + + _BOUT (stream->jfn, BUF_ENQ); + if (h_getc (stream) != BUF_RDY) { + h_error ("Bad handshake character received"); + exit (1); + } + } + +static er_chk (stream) +REP *stream; + {;} + +static _dump (stream) +register REP *stream; + { + register int i; + + for (i = 0; i <= stream->index; i++) + _BOUT (stream->jfn, stream->buffer[i]); + stream->index = 0; + } \ No newline at end of file diff --git a/c20/new/lib/hpplotter.c b/c20/new/lib/hpplotter.c new file mode 100644 index 00000000..d0e9ed97 --- /dev/null +++ b/c20/new/lib/hpplotter.c @@ -0,0 +1,491 @@ +/********************************************************************** + + HPPLOTTER - this is a set of routines which drive an HP + plotter. HPIO.C is used as a low-level interface to the + operating system + + Functions in this package: + + open set up and get a plotter + close punt plotter + flush execute commands now + set_char_size set char size + set_print_space set size of character square + set_char_slant + get_char_size + get_print_space + set_color select a pen + get_color + set_page_size set max x,y coordinates + get_page_size get max x,y coordinates + set_solid_line start using solid line + set_dash_line start using dashed lines + set_dot_line start using dotted lines + set_scale scale factor for entire drawing + set_offset offset for entire drawing + get_scale_offset + printc write a text character + prints write a text string + draw_to draw from current to given + draw_by draw from current to c + given + move_to same as above with pen up + move_by " " " " " " + line draw a line from here to there + box draw box given center and size + square draw square given center and size + circle draw circle given center, diameter + text write text, start at given point + +*********************************************************************/ + +#include "hpplotter.h" +#include + +#define scale _hscle + +#define REP struct _hpplotter +struct _hpplotter { + int stm; /* plotter stream */ + char lbl_trm; /* label terminator */ + int line_space; /* between lines */ + int char_space; /* between chars */ + int h_offset; + int v_offset; + int h_page_size; /* page size in plotter coordinates */ + int v_page_size; + float scale_factor; + }; + +/* default parameter values */ +#define LBL_TRM '\003' +#define PAGE_H_SIZE 3040 +#define PAGE_V_SIZE 2000 + +/* hacks */ +#define PUTC h_ptc +#define PUTS h_pts + +/********************************************************************** +* HP_OPEN - open a plotter. +**********************************************************************/ + +REP *hp_open (hpname) +char *hpname; + { + register int hpstm; + register REP *temp; + + hpstm = h_init (); + temp = (REP *) calloc (1, sizeof (REP)); + temp->stm = hpstm; + temp->h_offset = temp->v_offset = 0; + temp->line_space = 50; + temp->char_space = 25; + temp->lbl_trm = LBL_TRM; + temp->scale_factor = 1.0; + + h_open (hpstm, hpname); + h_pts (hpstm, "~_"); /* init plotter */ + h_pts (hpstm, "~\\"); /* set label terminator */ + h_mbn (hpstm, LBL_TRM); + hp_set_page_size (temp, PAGE_H_SIZE, PAGE_V_SIZE); + h_flush (hpstm); + return (temp); + } + +/********************************************************************** +* HP_CLOSE - close plotter stream +**********************************************************************/ + +hp_close (h) +REP *h; + { + hp_set_color (h,""); + hp_flush (h); + h_close (h->stm); + free (h); + } + +/********************************************************************** +* HP_FLUSH - send data to plotter +**********************************************************************/ + +hp_flush (h) +REP *h; + { + h_ptc (h->stm, '}'); /* NOP to force last graphics cmd */ + h_flush (h->stm); + } + +/********************************************************************** +* HP_SET_COLOR - pick a pen +**********************************************************************/ + +hp_set_color (h, color) +REP *h; +char *color; + { + register int ccode; + + if (!strcmp (color, "")) /* no pen */ + ccode = 0; + else if (!strcmp (color, "black")) + ccode = 1; + else if (!strcmp (color, "red")) + ccode = 2; + else if (!strcmp (color, "green")) + ccode = 3; + else if (!strcmp (color, "blue")) + ccode = 4; + else { + h_error ("hp_set_color: Unknown color, using black"); + ccode = 1; + } + + PUTC (h->stm, 'v'); + h_sbn (h->stm, ccode); + hp_flush (h); + } + +/********************************************************************** +* HP_SET_PAGE_SIZE +**********************************************************************/ + +hp_set_page_size (pltr, h, v) +REP *pltr; +int h, v; + { + pltr->h_page_size = h; + pltr->v_page_size = v; + PUTS (pltr->stm, "~S"); + h_mbp (pltr->stm, h, v); + } + +/********************************************************************** +* HP_GET_PAGE_SIZE +**********************************************************************/ + +hp_get_page_size(p,h,v) +REP *p; +int *h,*v; +{ + *h = p->h_page_size; + *v = p->v_page_size; +} + +/********************************************************************** +* HP_SET_CHAR_SLANT +**********************************************************************/ + +hp_set_char_slant (p,a) +REP *p; +int a; + { + PUTS (p->stm,"/"); + h_mba (p->stm, a); + } + +/********************************************************************** +* HP_SET_SCALE +**********************************************************************/ + +hp_set_scale (p,sc) +REP *p; +float sc; + { + p->scale_factor = sc; + } + +/********************************************************************** +* HP_SET_OFFSET +**********************************************************************/ + +hp_set_offset (p,hb,vb) +REP *p; +int hb,vb; + { + p->h_offset = hb; + p->v_offset = vb; + } + +/********************************************************************** +* HP_INCREMENT_SCALE +**********************************************************************/ + +hp_increment_scale (p,sc) +REP *p; +float sc; + { + p->scale_factor = p->scale_factor * sc; + } + +/********************************************************************** +* HP_SET_PRINT_SPACE +**********************************************************************/ + +hp_set_print_space (p,h,v) +REP *p; +int h,v; + { + p->char_space = h; + p->line_space = v; + } + +/********************************************************************** +* HP_SET_CHAR_SIZE +**********************************************************************/ + +hp_set_char_size (p,h,v) +REP *p; +int h,v; + { + hp_set_print_space (p,(3*h)/2,2*v); + } + +/********************************************************************** +* HP_MOVE_TO +**********************************************************************/ + +hp_move_to (p, h, v) +REP *p; +int h,v; + { + s_offset (p,h,v,&h,&v); + PUTC (p->stm, 'p'); + h_mbp (p->stm, h, v); + } + +/********************************************************************** +* HP_MOVE_BY +**********************************************************************/ + +hp_move_by (p, dh, dv) +REP *p; +int dh,dv; + { + scale (p,dh,dv,&dh,&dv); + PUTC (p->stm, 'r'); + h_pmb (p->stm,dh,dv); + } + +/********************************************************************** +* HP_DRAW_TO +**********************************************************************/ + +hp_draw_to (p,h,v) +REP *p; +int h,v; + { + s_offset (p,h,v,&h,&v); + PUTC (p->stm, 'q'); + h_mbp (p->stm,h,v); + } + +/********************************************************************** +* HP_DRAW_BY +**********************************************************************/ + +hp_draw_by (p,dh,dv) +REP *p; +int dh,dv; + { + scale (p,dh,dv,&dh,&dv); + PUTC (p->stm, 's'); + h_pmb (p->stm, dh,dv); + } + +/********************************************************************** +* HP_PRINTS +**********************************************************************/ + +hp_prints (p, string) +REP *p; +register char *string; + { + int h,v; + register int stream; + register char t; + + stream = p->stm; + scale (p, p->char_space, p->line_space, &h,&v); + PUTS (stream, "~%"); + h_mbp (stream, h, v); + PUTS (stream, "~'"); + while (t = *string++) { + PUTC (stream, t); + } + PUTC (stream, p->lbl_trm); + } + +/********************************************************************** +* HP_PRINTC +**********************************************************************/ + +hp_printc (p, chr) +REP *p; +char chr; + { + char buff[2]; + + buff[1] = chr; + buff[2] = 0; + hp_prints (p, buff); + } + +/********************************************************************** +* HP_SET_SOLID_LINE +**********************************************************************/ + +hp_set_solid_line (p) +REP *p; + { + PUTS (p->stm, "~Q"); + } + +/********************************************************************** +* HP_SET_DASH_LINE +**********************************************************************/ + +hp_set_dash_line (p,l) +REP *p; +int l; + { + register int stm; + + stm = p->stm; + PUTS (stm, "~Q"); + h_sbn (stm, 32 + 2); + h_sbn (stm, 2); + h_mbn (stm, sscale (p,l)); + } + +/********************************************************************** +* HP_SET_DOT_LINE +**********************************************************************/ + +hp_set_dot_line (p,s) +REP *p; +int s; + { + register int stm; + int t; + + stm = p->stm; + PUTS (stm, "~R"); + s = sscale (p,s); + h_sbn (stm, 32 + 1); + for (t = 1; t <= (s-1)/31; t++) + h_sbn (stm,31); + h_sbn (stm, (s-1)%31); + h_mbn (stm, s); + } + +/********************************************************************** +* HP_CIRCLE +**********************************************************************/ + +hp_circle (p,h,v,d) +REP *p; +int h,v,d; + { + int r; + + r = d/2; + hp_move_to (p,h + r,v); + PUTC (p->stm, 'u'); + h_mbn (p->stm, sscale (p,r)); + } + +/********************************************************************** +* HP_BOX +**********************************************************************/ + +hp_box (p,h,v,dh,dv) +REP *p; +int h,v,dh,dv; + { + hp_move_to (p,h - dh/2,v - dv/2); + hp_draw_by (p,dh,0); + hp_draw_by (p,0,dv); + hp_draw_by (p,-dh,0); + hp_draw_by (p,0,-dv); + } + +/********************************************************************** +* HP_SQUARE +**********************************************************************/ + +hp_square (p,h,v,d) +REP *p; +int h,v,d; + { + hp_box (p,h,v,d,d); + } + +/********************************************************************** +* HP_LINE +**********************************************************************/ + +hp_line (p,h,v,dh,dv) +REP *p; +int h,v,dh,dv; + { + hp_move_to (p,h,v); + hp_draw_by (p,dh,dv); + } + +/********************************************************************** +* HP_TEXT +**********************************************************************/ + +hp_text (p,h,v,string) +REP *p; +int h,v; +char *string; + { + hp_move_to (p,h,v); + hp_prints (p,string); + } + + +/********************************************************************** +* internal routines +**********************************************************************/ + +static scale (p,x,y,ax,ay) +REP *p; +int x,y; +int *ax, *ay; + { + register float sc; + + sc = p->scale_factor; + *ax = (int) (sc * (float) x); + *ay = (int) (sc * (float) y); + } + +static s_offset (p,h,v,ah,av) +REP *p; +int h,v; +int *ah, *av; + { + int ht,vt; + + if (p->scale_factor != 1.0) + scale (p,h,v,&h,&v); + if ((p->h_offset != 0) || (p->v_offset != 0)) { + *ah = h + sscale (p,p->h_offset); + *av = v + sscale (p,p->v_offset); + } + else { + *ah = h; + *av = v; + } + } + +static sscale (p,i) +REP *p; +int i; + { + return ((int) (p->scale_factor * (float) i)); + } \ No newline at end of file diff --git a/c20/new/lib/hpplotter.h b/c20/new/lib/hpplotter.h new file mode 100644 index 00000000..bdb9ce55 --- /dev/null +++ b/c20/new/lib/hpplotter.h @@ -0,0 +1,35 @@ +/* Header file for HPPLOTTER package */ + +/* This file renames most functions to avoid conflicts */ + +#define hp_open _hopn +#define hp_close _hcls +#define hp_flush _hfls +#define hp_set_color _hsec +#define hp_set_page_size _hsps +#define hp_get_page_size _hgps +#define hp_set_char_size _hscc +#define hp_set_char_slant _hscs +#define hp_set_print_space _hspp + +#define hp_set_solid_line _hssl +#define hp_set_dash_line _hsdl +#define hp_set_dot_line _hsdd + +#define hp_set_scale _hsca +#define hp_set_offset _hsof +#define hp_increment_scale _hisc + +#define hp_printc _hprc +#define hp_prints _hprs + +#define hp_draw_to _hdr2 +#define hp_draw_by _hdby +#define hp_move_to _hmo2 +#define hp_move_by _hmby + +#define hp_box _hbox +#define hp_square _hsqr +#define hp_circle _hcrc +#define hp_line _hlin +#define hp_text _htxt diff --git a/c20/new/lib/puz.c b/c20/new/lib/puz.c new file mode 100644 index 00000000..2eb68864 --- /dev/null +++ b/c20/new/lib/puz.c @@ -0,0 +1,164 @@ +/* an undocumented, compute-bound program from forest baskett */ + + +#define size 511 /* d*d*d - 1 */ +#define classMax 3 +#define typeMax 12 +#define d 8 +#define true 1 +#define false 0 + +#define pieceCount pCount +#define pieceMax pMax + +/*type pieceClass = 0..classMax; + pieceType = 0..typeMax; + position = 0..size;*/ + +int + pieceCount[classMax+1], + class[typeMax+1], + pieceMax[typeMax+1], + puzzle[size+1], + m,n, + i,j,k, + kount; +short p[typeMax+1][size+1]; + +int fit (i, j) int i, j; +{ +register int k, *plim, *puz; register short *piece; + + k = pieceMax[i]; + piece = &p[i][0]; + plim = &puzzle[j+k]; + for (puz = &puzzle[j]; puz <= plim; puz++) + if( *piece++ && *puz ) return(false); + return(true); +} + +int place (i, j) int i, j; +{ +register int k, *pjk, *pklim; register short *pik, *plim; + + pik = p[i]; + pjk = &puzzle[j]; + plim = &pik[pieceMax[i]]; + while (pik <= plim) + { + if( *pik ) *pjk = true; + pik++; pjk++; + } + pieceCount[class[i]]--; + pjk = &puzzle[j]; + for (k = j; k <= size; k++) + { + if( ! *pjk ) return(k); + pjk++; + } + printf("puzzle filled\n"); + return(0); +}; + +remove(i, j) int i, j; +{ +register int *pjk, *pklim; register short *pik, *plim; + + pik = p[i]; + pjk = &puzzle[j]; + plim = &pik[pieceMax[i]]; + while (pik <= plim) + { + if( *pik ) *pjk = false; + pik++; pjk++; + } + pieceCount[class[i]]++; +} + +int trial(j) int j; +{ + +register int i, k, *ci; + + ci = class; + for( i = 0; i <= typeMax; i++) + if( pieceCount[*ci++] ) + if( fit (i, j) ) { + k = place (i, j); + if( trial(k) || (k == 0) ) { + printf("piece %d at %d\n",i+1,k+1); + kount++; + return(true); + } else remove (i, j); + }; + kount++; + return(false); +} + +main(){ + for( m = 0; m <= size; m++) puzzle[m] = true; + for( i = 1; i <= 5; i++) for( j = 1; j <= 5; j++) for( k = 1; k <= 5; k++) + puzzle[i+d*(j+d*k)] = false; + for( i = 0; i <= typeMax; i++) for( m = 0; m <= size; m++) p[i][m] = false; + for( i = 0; i <= 3; i++) for( j = 0; j <= 1; j++) for( k = 0; k <= 0; k++) + p[0][i+d*(j+d*k)] = true; + class[0] = 0; + pieceMax[0] = 3+d*1+d*d*0; + for( i = 0; i <= 1; i++) for( j = 0; j <= 0; j++) for( k = 0; k <= 3; k++) + p[1][i+d*(j+d*k)] = true; + class[1] = 0; + pieceMax[1] = 1+d*0+d*d*3; + for( i = 0; i <= 0; i++) for( j = 0; j <= 3; j++) for( k = 0; k <= 1; k++) + p[2][i+d*(j+d*k)] = true; + class[2] = 0; + pieceMax[2] = 0+d*3+d*d*1; + for( i = 0; i <= 1; i++) for( j = 0; j <= 3; j++) for( k = 0; k <= 0; k++) + p[3][i+d*(j+d*k)] = true; + class[3] = 0; + pieceMax[3] = 1+d*3+d*d*0; + for( i = 0; i <= 3; i++) for( j = 0; j <= 0; j++) for( k = 0; k <= 1; k++) + p[4][i+d*(j+d*k)] = true; + class[4] = 0; + pieceMax[4] = 3+d*0+d*d*1; + for( i = 0; i <= 0; i++) for( j = 0; j <= 1; j++) for( k = 0; k <= 3; k++) + p[5][i+d*(j+d*k)] = true; + class[5] = 0; + pieceMax[5] = 0+d*1+d*d*3; + for( i = 0; i <= 2; i++) for( j = 0; j <= 0; j++) for( k = 0; k <= 0; k++) + p[6][i+d*(j+d*k)] = true; + class[6] = 1; + pieceMax[6] = 2+d*0+d*d*0; + for( i = 0; i <= 0; i++) for( j = 0; j <= 2; j++) for( k = 0; k <= 0; k++) + p[7][i+d*(j+d*k)] = true; + class[7] = 1; + pieceMax[7] = 0+d*2+d*d*0; + for( i = 0; i <= 0; i++) for( j = 0; j <= 0; j++) for( k = 0; k <= 2; k++) + p[8][i+d*(j+d*k)] = true; + class[8] = 1; + pieceMax[8] = 0+d*0+d*d*2; + for( i = 0; i <= 1; i++) for( j = 0; j <= 1; j++) for( k = 0; k <= 0; k++) + p[9][i+d*(j+d*k)] = true; + class[9] = 2; + pieceMax[9] = 1+d*1+d*d*0; + for( i = 0; i <= 1; i++) for( j = 0; j <= 0; j++) for( k = 0; k <= 1; k++) + p[10][i+d*(j+d*k)] = true; + class[10] = 2; + pieceMax[10] = 1+d*0+d*d*1; + for( i = 0; i <= 0; i++) for( j = 0; j <= 1; j++) for( k = 0; k <= 1; k++) + p[11][i+d*(j+d*k)] = true; + class[11] = 2; + pieceMax[11] = 0+d*1+d*d*1; + for( i = 0; i <= 1; i++) for( j = 0; j <= 1; j++) for( k = 0; k <= 1; k++) + p[12][i+d*(j+d*k)] = true; + class[12] = 3; + pieceMax[12] = 1+d*1+d*d*1; + pieceCount[0] = 13; + pieceCount[1] = 3; + pieceCount[2] = 1; + pieceCount[3] = 1; + m = 1+d*(1+d*1); + kount = 0; + if( fit(0, m) ) n = place(0, m); else printf("error 1\n"); + if( trial(n) ) printf("success in %d\n", kount); + else printf("failure\n"); +} diff --git a/c20/new/lib/puz.stinkr b/c20/new/lib/puz.stinkr new file mode 100644 index 0000000000000000000000000000000000000000..3545b9677ba41efb2bcb8dd28060baead08323a3 GIT binary patch literal 27 ecmbuAdD6Qhk2a$TI6{%bdKmY)Gfd`rZ literal 0 HcmV?d00001 diff --git a/c20/new/lib/puzzle.c b/c20/new/lib/puzzle.c new file mode 100644 index 0000000000000000000000000000000000000000..e0b6baa3d3d8f0c973fdc704e4c897371b5af0c0 GIT binary patch literal 3600 zcmb`K$!^;)5QclDo`OkGK#Ekrvg0gpbLzQI;QAog6hLheWVvXwynAP%Xzf9Y1c((4 zw~zn)oX}SX73)HYqkdLm9frcWGLd~29gjbwKXPS5_1{uKM1)HlI*5DwcU_&72<>Ye zWk)3zjt!Jr?bVN`Q&EeO9^Dq4xrC2%w9-W#3$ZWp566KIah_w_0Q%uBa0I<=4Izi9 zFHG2ro}QmGwZ#paZmsrKI1dV#RtHIt!ZSte4Kc`A*V5I2Ogsrl61r@h7e~ZTl`B*E zC>I-ee1DX7eZ7N-?|Y6AI(B8b)w^xFlQ10Lm?!ZmQmOh>6)tJ#Z5(0VQCfI?GX!N8 z?NygS5(G+=LZ|ka5T*y3pTn+#!ul_4=QpwgZFUo?Ae?>NQXQlew` zl2JhDEK`SH#bry0g^{6B`O|OJNyBGLKuP$Z20m)gq^YiSl)1(xlppdiSm&H0&4$rv z7~|fJ)Gf2vL&Jur1YCg0B-)Am)bgVzUoa}rhHaC;E=*@;Na+HkCm4jZ5sdDtEaW8d8g+tI3yRTVWNeu}%B&H$3NvwNe1RY`+VUDgj zAKE`$y9s=x97~iUwN<*A zN4gmxQ3P=~aic0tCJt5}Ph8te>v^R00Er`j#P%Nb(sIg6lPa|ncRP=Ci%6)1J#iFS zT9rlnb^j;qv0x|>J38z4~xlZIFmMPL#M8pe@;)tJY#G`6QaF90Ai_y%z!Ca1EHT=(y zOSrTSUZR={6dDG<2EZlGT?8`6%UA)u>GsBv4d0-e%dx7er%HzAT8v})PFLX2rql7X f->c&hzMz=<8{gD$Wx9?v{o+Vxr%Lf;Z_by0Ol!c- literal 0 HcmV?d00001 diff --git a/c20/new/lib/puzzle.stinkr b/c20/new/lib/puzzle.stinkr new file mode 100644 index 0000000000000000000000000000000000000000..3c88e666edf54ec930cd46f88cd036242647c4c2 GIT binary patch literal 32 hcmbuAdD6Oi>N#)9iGW1d_Qn?ry7y!3u3NQcw literal 0 HcmV?d00001 diff --git a/c20/new/lib/qsort.c b/c20/new/lib/qsort.c new file mode 100644 index 00000000..276d0203 --- /dev/null +++ b/c20/new/lib/qsort.c @@ -0,0 +1,185 @@ +/*********************************************************************** +* * +* qsort - PDP10 implementation of the quicksort algorithm. * +* * +* call - qsort(base, size, width, compar) * +* * +* base - pointer to the base of the array of objects to * +* sort. * +* * +* size - number of objects in the array * +* * +* width - size of each element, in units of char * +* (like from sizeof) * +* * +* compar - a function which takes pointers to two * +* objects as arguments and returns <0 if * +* the first object is "smaller" than the second, * +* 0 if the first is "equal" to the second, and * +* >0 if the first is "greater" than the second. * +* * +***********************************************************************/ + +/* this file is PDP10 dependant due to use of the "blt" function */ +/* copyright (C) 1981 by John T. Wroclawski */ + +#define TBUFSIZE 50 +#define MINSIZE 10 +#include + + + +qsort(base,size,width,compar) +char *base; +register int width; +int (*compar)(); +{ + char tbuf[TBUFSIZE]; + char medval[TBUFSIZE]; + + char *median, *top; + register char *right,*left; /* working pointers */ + int smallsize; /* size of divided segment */ + + if (size < 0) { + fprintf(stderr,"qsort: negative number of objects\n"); + exit(1); + } + + while(MINSIZE < size) { + + top = base + ((size - 1) * width); /* top element */ + median = base + ((size/2) * width); /* middle element*/ + + /* sort bottom, median, and top elements */ + + if ((*compar)(base, median) < 0) { /* low < median */ + if ((*compar)(median,top) > 0) { /* median < top */ + blt(median,tbuf,width); /* swap median, top */ + blt(top,median,width); + blt(tbuf,top,width); + if ((*compar)(base,median) > 0) { /* low < new median */ + blt(base,tbuf,width); /* swap low, median */ + blt(median,base,width); + blt(tbuf,median,width); + } /* end of swap low, median */ + } /* end of med > top */ + } /* end of low < median */ + + else /* here if base > median */ + + if((*compar)(median,top) < 0 ) { /* med and top are ok */ + blt(base,tbuf,width); /* swap low, median */ + blt(median,base,width); + blt(tbuf,median,width); + if ((*compar)(median,top) > 0) { /* new med > top */ + blt(median,tbuf,width); /* swap median, top */ + blt(top,median,width); + blt(tbuf,top,width); + } /* end med > top swap */ + } /* end med, top were ok */ + + else { /* here if top TBUFSIZE) { + fprintf(stderr,"qsort: objects too big\n"); + exit(1); + } + for(top = base + width; top < base + nel*width; top += width) { + blt(top,tbuf,width); /* create a hole in the data */ + hole = top; + trial = top - width; + + while ((base <= trial) && ((*compar)(tbuf,trial) < 0)) { + blt(trial,hole,width); + hole = trial; + trial -= width; + } + blt(tbuf,hole,width); + } +} diff --git a/c20/new/lib/random.cmid b/c20/new/lib/random.cmid new file mode 100644 index 00000000..c6dc6a2a --- /dev/null +++ b/c20/new/lib/random.cmid @@ -0,0 +1,30 @@ +; +; random - random number generator (stolen from muddle) +; +; this file is pdp-10 dependent, system-independent. +; + +title random +.insrt c:minsrt + +centry srand,[seed] + move a,seed + rot a,-1 + movem a,rlow + return + +centry rand + 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 + move a,b + return + +.idata +rhi: 267762113337 +rlow: 155256071112 +.code + +end diff --git a/c20/new/lib/setjmp.cmid b/c20/new/lib/setjmp.cmid new file mode 100644 index 00000000..aa69a020 --- /dev/null +++ b/c20/new/lib/setjmp.cmid @@ -0,0 +1,65 @@ +; +; setjmp(), longjmp(), _dismiss() - nonlocal flow of control +; note - unlike UNIX you cannot directly longjmp out of +; an interrupt routine. You may however do so by calling +; the system function _dismiss() before doing the longjmp. +; This will put you back in process context. Then you can +; longjmp() off to where you want to be. + +title setjmp +.insrt c:minsrt + +subttl setjmp - save a stack environment + +comment | + +After the CENTRY macro, the stack looks like this: + + (P) -> Old frame ptr + -1(P)-> Return address + -2(P)-> Argument to setjmp() + +|; end comment + +centry setjmp,[envp] + + hrrz a,envp ;get environment pointer + move b,-1(p) ;return pc + movem b,(a) ;save return pc + move b,p ;get current sp + adjsp b,-2 ;sp before call + movem b,1(a) ;save stack pointer + move b,(p) ;get pre-call frame pointer + movem b,2(a) ;save it away. + setz a, ;return zero + return + + +subttl longjmp - return to a stack environment saved by setjmp + +centry longjmp,[envp,val] + + hrrz b,envp ;get env pointer + move a,val ;set up the return value + hrrz d,(b) ;pick up return address + move p,1(b) ;restore stack pointer + move ep,2(b) ; and frame pointer + jrst (d) ;and off we go + + +subttl _dismiss() - leave interrupt context + +.global intnum,pclev3 ;in C20RUN + +centry %dismiss + skipn intnum ;doing an interrupt? + jrst ds$1 ;no, just return + movei b,ds$1 ;yes, get a place for debrk to return to + hrli b,010000 ;turn on user-mode bit + movem b,pclev3 ;make this saved address + setzm intnum ;no more interrupt + debrk ;dismiss +ds$1: return ;and say goodbye + + + end diff --git a/c20/new/lib/string.c b/c20/new/lib/string.c new file mode 100644 index 00000000..5dea7a8a --- /dev/null +++ b/c20/new/lib/string.c @@ -0,0 +1,90 @@ +# include + +/* Useful functions for character strings */ + + +/********************************************************************** + + SCONCAT - String Concatenate + + concatenate strings S1 ... Sn into buffer B + return B + +**********************************************************************/ + + +char *sconcat (b, n, s1) /* any number of string args possible */ +char *b, *s1; +{ + char **s; + register char *p, *q; + register int c; + + q = b; + s = &s1; + + while (--n >= 0) { + p = *s--; + while (c = *p++) *q++ = c; + } + + *q = 0; + return (b); +} + +/********************************************************************** + + SLOWER - Convert String To Lower Case + +**********************************************************************/ + +slower (s) +register char *s; +{ + register int c; + while (c = *s) *s++ = lower (c); +} + +/**************************************************************** + + CMOVE, SMOVE - copy non-overlapping regions + +****************************************************************/ + +smove (from, to, n) +int *from, *to, n; +{ + if (n > 0) blt (from, to, n); +} + +cmove (from, to, n) +char *from, *to; +int n; +{ + if (n > 0) blt (from, to, n); +} + +/**************************************************************** + + CFILL, SFILL - fill a region with a given value + +****************************************************************/ + +sfill (start, count, val) +int *start, count, val; +{ + if (count > 0) { + *start = val; + if (--count > 0) blt (start, start + 1, count); + } +} + +cfill (start, count, val) +char *start, val; +int count; +{ + if (count > 0) { + *start = val; + if (--count > 0) blt (start, start + 1, count); + } +} diff --git a/c20/new/license.note b/c20/new/license.note new file mode 100644 index 00000000..00600d93 --- /dev/null +++ b/c20/new/license.note @@ -0,0 +1,10 @@ +Some of the code in this compiler is covered by UNIX licensing agreements +with the Western Electric Company, and is distributed to this site on the +condition that you have presented us with a valid and appropriate UNIX +license. The rest of the code was written at the Massachusetts Institute +of Technology. + +We ask that you do not redistribute or allow the distribution of this code +to any other site without the prior permission of MIT. We further ask +that users of this code consider it to be covered by a UNIX license, and +use it only for the purposes covered by that license. \ No newline at end of file diff --git a/c20/new/minsrt.mid b/c20/new/minsrt.mid new file mode 100644 index 00000000..ae57547b --- /dev/null +++ b/c20/new/minsrt.mid @@ -0,0 +1,122 @@ +; C:MINSRT.MID + +; This file provides useful macros for hand-coded midas programs designed +; to be loaded with "new" c programs. + + .insrt c:cinsrt.mid + +rtn=popj p, + +define inform a,b +if1,[printx \ a = b +\] +termin + +; support routines + +define %len [list] + %count==0 + irp elem,,list + %count==%count+1 + termin + termin + +define defvar name,#offset + define name +&777777'(ep)termin +termin + +; define c-callable procedure (renamed as compiler would) + +define centry name,[args],[vars] + prolog $!name,name,args,vars + termin + +; define c-callable procedure (not renamed) + +define mentry name,[args],[vars] + prolog name,name,args,vars + termin + +; define globally accessible C variable + +define cdata name +$!name":termin + +; define globally accessible internal (non-renamed) variable + +define mdata name +name":termin + +; prolog macro + +define prolog cname,pname,[args],[vars] + %len args + %a==%count + %len vars + %v==%count + %off== -2 + irp argnam,,args + defvar argnam,%off + %off==%off-1 + termin + %off==1 + irp varnam,,vars + defvar varnam,%off + %off==%off+1 + termin + <%a&77',,[asciz/pname/]> +cname": push p,ep ; stash frame pointer + movei ep,(p) ; get new frame pointer + ifn %v,[adjsp p,%v] ; allocate locals + termin + +; define midas-accessible data + +; fatal error + +define croak string/ + pushj p,[ + hrroi 1,[asciz \?!string \] + psout + haltf ] + termin + +; return statement + +define return + move ep,(ep) + adjsp p,-<%v+1> + popj p, + termin + +; call statement (call a C-compiled procedure) + +define ccall name,[args] + nn==0 + pushem args + pushj p,$!name" + adjsp p,-nn + termin + +; midas-call statement (call a non-renamed procedure) + +define mcall name,[args] + nn==0 + pushem args + pushj p,name" + adjsp p,-nn + termin + +; push a bunch of args on the stack + +define pushem [args] + irp arg,arglst,args + ifb [arg],.istop + pushem [arglst] + push p,arg + nn==nn+1 + .istop + termin + termin + diff --git a/c20/new/mulseg.mid b/c20/new/mulseg.mid new file mode 100644 index 00000000..537ab7f5 --- /dev/null +++ b/c20/new/mulseg.mid @@ -0,0 +1,74 @@ +; THIS INSERT FILE ALLOWS USE OF STINKR MULTIPLE SEGMENT FEATURE + +; MACROS: +; +; .MSEG o1,o2,o3,... +; +; This macro should come after the RELOCATABLE and any RADIX +; command and before any code. The arguments are the virtual +; origins of the segments other than segment 0. The virtual +; origin of segment 0 is always 0. The virtual origins are used +; internally to distinguish the various segments. For example, +; if one has done .MSEG 400000, then relocatable addresses in +; segment 1 will start from relocatable 400000. The choice +; of virtual segment origins is important only in that it +; limits the maximum size of the various segments. +; +; .SEG n +; +; This macro switches to segment n, where n ranges from 0 to +; one less than the number of segments. Initially, the current +; segment is 0. +; + +if1,[ + +define ms%as *prefix*,#segno,*suffix* + prefix!segno!suffix + termin + +define .mseg args/ + ms%ns==1 + ms%o0==0 + ms%l0==. + irp arg,,[args] + ms%as /ms%o/,ms%ns,/==arg/ + ms%as /ms%l/,ms%ns,/==.+arg/ + ms%as /.kill ms%o/,ms%ns + ms%as /.kill ms%l/,ms%ns + ms%ns==ms%ns+1 + termin + ms%cs==0 + termin + +define .seg n + ifn n-ms%cs,[ + ms%as /ms%l/,ms%cs,/==./ + ms%cs==n + ms%as /loc ms%l/,ms%cs + ] + termin + +equals ms%end end +expunge end +define end endloc + ms%as /ms%l/,ms%cs,/==./ + equals end ms%end + end endloc + termin +] + +if2,[ + word <24._25.>+ + ms%cs==0 + repeat ms%ns,[ + ms%as /ms%tmp==.absp ms%l/,ms%cs, + ms%as /ms%tmp==ms%tmp-ms%o/,ms%cs + ms%as /word / + ms%cs==ms%cs+1 + ] + word 0 ; checksum + ms%cs==0 + +.kill ms%ns,ms%cs,ms%tmp,ms%l0,ms%o0 +] diff --git a/c20/new/ncc.c b/c20/new/ncc.c new file mode 100644 index 00000000..738c1a1f --- /dev/null +++ b/c20/new/ncc.c @@ -0,0 +1,623 @@ +# include +# include +# define FALSE 0 +# define TRUE 1 +# define PHASEPRINT 1 +/* + + TOPS-20 Portable C Compiler Command Routine + + + Compiler Options + + -c compile only, do not assemble + -d generate debugging code + -f write errors to file instead of tty + -g do not delete assembly language temp file + -k keep intermediate files + -o run code optimizer + -r ring bell when done + -l link file and standard library, producing .EXE file + + p=xxx predefine symbol xxx (to be 1) + l=xxx look in directory xxx for include files + +*/ + +/* renamings to allow long names */ + +# define construct_output_file_names cnsofn +# define execute_phase execph +# define write_statistics wrstat +# define print_phase_time prphtm +# define process_options proopt +# define process_minus_option promin +# define process_equal_option proeq + +# define phase_name phsnm +# define phase_pname phspnm +# define phase_prog phspr +# define phase_argc phsac +# define phase_argv phsav +# define phase_option phsop +# define phase_et phset +# define phase_pt phspt + +# define argv_P avp +# define argv_C avc + +/* program file names */ + +/* where to look for executable image files */ +# define PREFIX "C:" + +/* extension of executable image files */ +# define SUFFIX ".exe" + +# define OBJDIR "" + +# define INTSUF "i" +# define OBJSUF "obj" +# define OPTSUF "mid" +# define RELSUF "stk" +# define ERRSUF "cerr" +# define EXESUF "exe" + +# define ASMFILE "c:casm.exe" +# define LDFILE "sys:stinkr.exe" +# define LIBRARY "c:stdio" + +# define FNSIZE 100 + + +/* options */ + +int kflag, cflag, gflag, oflag, rflag, fflag, dflag, lflag; + +/* table for pre-defined symbols */ + +# define maxpds 10 +char *pdstab[maxpds + 1]; +char **pdsptr = {pdstab}; + +/* tables for #include default directories */ + +# define maxdirs 5 +char *dfdirs[maxdirs + 1]; +char **dfdptr = {dfdirs}; + +/* default search directories for # include <> */ + +# define n10dirs 2 +char *df10dirs[] = {"-IC:", "-ICLIB:"}; + + +/* phase information */ + +# define nphase 3 + +# define phase_P 0 +# define phase_C 1 +# define phase_O 2 + +# define extra maxpds + maxdirs + +char *argv_P[2 + extra]; +char *argv_C[4 + extra]; +char *argv_O[2]; + +char *phase_name[] = {"P","C","O"}; +char *phase_pname[] = {"cpp","pcc","opt"}; +char phase_prog[nphase][FNSIZE]; +int phase_argc[] = {2, 3, 2}; +char **phase_argv[] = {argv_P, argv_C, argv_O}; +int phase_et[] = {0, 0, 0}; +int phase_pt[] = {0, 0, 0}; + +static char *pdp10_pdefs[] = {"-DPDP10=1", 0}; /* predefined symbols */ + +# define opsys_name "-DTOPS20=1" + +char *opsys = NULL; + +extern char *sconcat (); + +/********************************************************************** + + THE MAIN PROGRAM + +**********************************************************************/ + +main (argc, argv) +char *argv[]; +{ + extern FILE *stdout; + FILE *f; + int snum, cc, i, ttyflag; + cal start_time; + char *fargv[50], buffer[2000]; + char src_name[FNSIZE], + int_name[FNSIZE], + obj_name[FNSIZE], + opt_name[FNSIZE], + rel_name[FNSIZE], + err_name[FNSIZE], + exe_name[FNSIZE]; + char *fptr; + char nambuf[2][FNSIZE]; + char cmdbuf[100]; + + --argc; /* skip over program name */ + ++argv; + argc = process_options (argc, argv); + argc = exparg (argc, argv, fargv, buffer); + argv = fargv; + + pp_setup (); /* set up preprocessor arguments */ + + nambuf[0][0] = '<'; /* for re-directed input */ + nambuf[1][0] = '>'; /* for re-directed output */ + + for (snum = 0; snum < argc; ++snum) { + char name[FNSIZE]; + + strcpy (src_name, argv[snum]); + + /* check that source file exists */ + + if ((f = fopen (src_name, "r")) == NULL) { + char ext[FNSIZE]; + + fngtp (src_name, ext); + if (*ext == 0) { + fnsfd (src_name, src_name, 0, 0, 0, "c", 0, 0); + f = fopen (src_name, "r"); + } + if (f == NULL) { + printf ("Can't Find '%s'.\n", src_name); + continue; + } + } + fclose (f); + fngnm (src_name, name); /* get name part of file spec */ + for (fptr=name;*fptr!=0;fptr++) + *fptr = upperr(*fptr); + +#ifdef SHORTNAME + name[6] = 0; /* print only six chars to match macro */ +#endif + + now (&start_time); + + /* construct output file names from source file name */ + + construct_output_file_names (src_name, int_name, obj_name, + opt_name, rel_name, err_name, + exe_name); + + for (i = 0; i < nphase; ++i) phase_pt[i] = -1; + +#ifdef PHASEPRINT + printf ("CPP:\t%s\n",name); +#else + printf ("C:\t%s\n",name); +#endif + fflush (stdout); + + argv_P[0] = src_name; /* name of source file */ + argv_P[1] = &nambuf[1][0]; /* >intname for redirected output */ + strcpy (&nambuf[1][1],int_name); /* get intname */ + cc = execute_phase (phase_P); /* reu preprocessor */ + if (!cc) { + +#ifdef PHASEPRINT + printf ("PCC:\t%s\n",name); + fflush (stdout); +#endif + + argv_C[0] = &nambuf[0][0]; /* input from int file */ + strcpy (&nambuf[0][1],int_name); + argv_C[1] = &nambuf[1][0]; /* output to obj file */ + strcpy (&nambuf[1][1],obj_name); + argv_C[2] = name; /* tell pcc the module name */ + if (fflag) { + cmdbuf[0] = '%'; + strcpy (cmdbuf + 1,err_name); + argv_C[3] = cmdbuf; + phase_argc[phase_C] = 4; + } + cc = execute_phase (phase_C); + } + if (!kflag) unlink (int_name); + + if (oflag) { + argv_O[0] = &nambuf[0][0]; + strcpy (&nambuf[0][1],obj_name); + argv_O[1] = &nambuf[1][0]; + strcpy (&nambuf[1][1],opt_name); +#ifdef PHASEPRINT + printf ("OPT:\t%s\n",name); + fflush(stdout); +#endif + cc = execute_phase (phase_O); + if (!kflag) unlink (obj_name); + } + else strcpy (opt_name, obj_name); + + stats(src_name, &start_time); + + if (cc) { + if (!gflag) unlink (opt_name); + } + else if (!cflag) { + +#ifdef PHASEPRINT + printf ("CASM:\t%s\n",name); + fflush(stdout); +#endif + + cc = assemble (opt_name, rel_name); + if (!cc) { + if (!gflag) unlink (opt_name); + if (lflag) { + load( rel_name, exe_name ); + unlink( rel_name ); + } + } + } + if (rflag) { + putc ('\007', stdout); + fflush (stdout); + } + } + if (rflag) { + putc ('\007', stdout); + fflush (stdout); + } +} + +/********************************************************************** + + PROCESS_OPTIONS - Process options in command arguments + and remove options from argument list. + +**********************************************************************/ + +int process_options (argc, argv) +char *argv[]; +{ + char *s, **ss, **dd; + int n, opt; + + kflag = cflag = gflag = rflag = FALSE; + + dd = ss = argv; + n = 0; + while (--argc >= 0) { + s = *ss++; + if (s[0] == '-') process_minus_option (s + 1); + else if ((opt = s[0]) && s[1] == '=') + process_equal_option (opt, s + 2); + else { + *dd++ = s; + ++n; + } + } + return (n); +} + +/********************************************************************** + + PROCESS_MINUS_OPTION + +**********************************************************************/ + +process_minus_option (s) +char *s; +{ + int c; + + while (c = *s) { + *s++ = c = lower (c); + switch (c) { + case 'k': kflag = TRUE; break; + case 'c': cflag = TRUE; break; + case 'g': gflag = TRUE; break; + case 'o': oflag = TRUE; break; + case 'r': rflag = TRUE; break; + case 'f': fflag = TRUE; break; + case 'd': dflag = TRUE; break; + case 'l': lflag = TRUE; break; + default: printf ("Unrecognized option: -%c\n", c); + break; + } + } +} + +/********************************************************************** + + PROCESS_EQUAL_OPTION + +**********************************************************************/ + +process_equal_option (opt, s) +char *s; +{ + char *r; + int c; + + switch (opt = lower (opt)) { + case 'p': if (pdsptr < pdstab + maxpds) { + static char pdss[maxpds][20]; + r = &pdss[pdsptr - pdstab][0]; + *pdsptr++ = r; + sconcat (r, 3, "-D", s + 2, "=1"); + } + else printf ("Sorry, too many pre-defined symbols.\n"); + return; + + case 'l': if (dfdptr < dfdirs + maxdirs) { + *dfdptr++ = s; + s[0] = '-'; + s[1] = 'I'; + } + else printf ("Sorry, too many search directories.\n"); + return; + + default: printf ("Unrecognized option: %c=%s\n", opt, s); + } +} + +/********************************************************************** + + PP_SETUP + + Add pre-defined symbols and search directories to ARGV_P + +**********************************************************************/ + +pp_setup () +{ + char **p, *q; + + /* add defined search directories to preproc args */ + p = df10dirs; + while (p < df10dirs + n10dirs) add_arg (phase_P, *p++); + p = dfdirs; + while (p < dfdptr) add_arg (phase_P, *p++); + + /* add predefined symbols to preprocessor args */ + p = pdp10_pdefs; + add_arg (phase_P, *p); /* add system predefined symbols */ + if (q = opsys) { + if (strcmp (q, "-DTOPS20=1")) add_arg (phase_P, "-UTOPS20"); + add_arg (phase_P, q); + } + p = pdstab; /* add user predefined symbols */ + while (p < pdsptr) add_arg (phase_P, *p++); +} + +/********************************************************************** + + ADD_ARG - append an argument to the list for the given phase + +**********************************************************************/ + +add_arg (phs, arg) +char *arg; +{ + phase_argv[phs][phase_argc[phs]++] = arg; +} + +/********************************************************************** + + CONSTRUCT_OUTPUT_FILE_NAMES + + Construct assembler, relocatable, and symbol table listing + file names from source file name. + +**********************************************************************/ + +construct_output_file_names (src_name, int_name, obj_name, opt_name, rel_name, err_name,exe_name) +char *src_name,*int_name,*obj_name,*opt_name,*rel_name,*err_name,*exe_name; +{ + fnsfd (obj_name, src_name, "", OBJDIR, 0, OBJSUF, 0, 0); + fnsfd (opt_name, obj_name, 0, 0, 0, OPTSUF, 0, 0); + fnsfd (int_name, obj_name, 0, 0, 0, INTSUF, 0, 0); + if (!cflag) fnsfd (rel_name, obj_name, 0, 0, 0, RELSUF, 0, 0); + if (fflag) fnsfd (err_name, obj_name, 0, 0, 0, ERRSUF, 0, 0); + if (lflag) fnsfd (exe_name, obj_name, 0, 0, 0, EXESUF, 0, 0); +} + +/********************************************************************** + + EXECUTE PHASE + +**********************************************************************/ + +execute_phase (n) +int n; +{ + extern int exctime, exccode; + int t; + + set_program_name (n); + t = etime (); + if (execv (phase_prog[n], phase_argc[n], phase_argv[n])) { + printf ("Unable to execute phase %s\n", phase_name[n]); + return (-1); + } + phase_et[n] = etime () - t; /* elapsed time */ + phase_pt[n] = exctime; /* runtime */ + return (exccode); +} + +/********************************************************************** + + SET_PROGRAM_NAME + + Construct the file name of program for the given phase. + +**********************************************************************/ + +set_program_name (n) +int n; +{ + char *r, *s; + + r = PREFIX; + s = SUFFIX; + sconcat (phase_prog[n], 4, r, phase_pname[n],".",s); +} + +/********************************************************************** + + STATS - write statistics to stat file + +**********************************************************************/ + +# define STATFILE1 "C:pcc.stat" + + +stats (src_name, st) +char *src_name; +cal *st; +{ + FILE *f; + int flag, i; + char temp[50]; + + flag = TRUE; + f = fopen (STATFILE1, "a"); +# ifdef statfile2 + if (f == NULL) f = fopen (STATFILE2, "a"); +# endif + if (f == NULL) return; + putc ('\n', f); + strcpy (temp,username ()); + fprintf (f, "%s - ", temp); + prcal (st, f); + fprintf (f, " - "); + fngdr (src_name, temp); + if (temp[0]) { + slower (temp); + fprintf (f, "%s/", temp); + } + fngnm (src_name, temp); + slower (temp); + fprintf (f, "%s", temp); + +# define hack if (flag) {fprint (f, " ("); flag = FALSE;} else putc (' ', f) + + if (cflag || gflag || kflag) { + hack; + if (cflag) putc ('c', f); + if (gflag) putc ('g', f); + if (kflag) putc ('k', f); + } + if (!flag) putc (')', f); + + fprintf (f, "\n\n"); + for (i = 0; i < nphase; ++i) print_phase_time (i, f); + fclose (f); +} + +/********************************************************************** + + PRINT_PHASE_TIME - As Part Of Statistics + +**********************************************************************/ + +print_phase_time (n, f) +FILE *f; +{ + if (phase_pt[n] != -1) { + fprint (f, phase_name[n]); + if (!phase_name[n][1]) putc (' ', f); + fprint (f, " P="); + pr60th (phase_pt[n], f); + fprint (f, " E="); + pr60th (phase_et[n], f); + putc ('\n', f); + } +} + +/********************************************************************** + + ASSEMBLE - Create the relocatable file from the assembler file + + return TRUE iff an error occurred + +**********************************************************************/ + +int assemble (obj_name, rel_name) +char *obj_name, *rel_name; +{ +# ifdef TENEX + /* TENEX can't run MIDAS as an inferior -- sigh */ + fprint ("OUTPUT on %s\n", obj_name); + return (TRUE); +} +# else + + char *s, temp[100]; + FILE *f; + + /* construct Assembler command line */ + + strcpy (temp, rel_name); + strcat (temp, " _ "); + strcat (temp, obj_name); + strcat (temp, " (w)", s); + + /* execute Assembler */ + if (execs (ASMFILE, temp)) { + fprint (stderr,"Unable to Assemble.\n"); + return (TRUE); + } + + /* construct Assembler record file name */ + + fnsfd (temp, obj_name, 0, 0, 0, "err", 0, 0); + + /* examine Assembler record file */ + + f = fopen (temp, "r"); + if (f != NULL) { /* look for '-' + '\t' */ + register int c; + + while ((c = getc (f)) != EOF) { + if (c == '-') { + c = getc (f); + if (!isdigit (c)) continue; + while (isdigit (c)) c = getc (f); + if (c != '\t') continue; + fprint (stderr, "Assembler Errors.\n"); + fclose (f); + return (TRUE); + } + } + fclose (f); + unlink(temp); + } + return (FALSE); +} + +load (rn,en) +char *rn, *en; +{ + char buf[50]; + FILE *tfile; + + tmpnam(buf); + if ((tfile = fopen(buf,"w")) == NULL) return( TRUE ); + fprintf(tfile,"x %s\nl %s\no %s\nq\n",LIBRARY,rn,en); + fclose(tfile); + if (execs (LDFILE, buf)) { + fprint (stderr,"Unable to load.\n"); + return (TRUE); + } + unlink( buf ); + return( FALSE ); +} +# endif diff --git a/c20/new/pcc.stat b/c20/new/pcc.stat new file mode 100644 index 00000000..3e93023a --- /dev/null +++ b/c20/new/pcc.stat @@ -0,0 +1,50 @@ + +BUDNE - Nov 7, 1983 18:26:21 - funct (k) + +P P= 1.37 E= 3.58 +C P= 4.08 E= 10.41 +O P= 1.45 E= 3.42 + +BUDNE - Nov 7, 1983 21:37:24 - phbook + +P P= 1.40 E= 3.06 +C P= 4.24 E= 7.07 + +BUDNE - Nov 7, 1983 21:45:22 - phbook (g) + +P P= 1.41 E= 3.08 +C P= 4.26 E= 7.19 +O P= 2.16 E= 3.29 + +BUDNE - Nov 7, 1983 21:51:21 - pcc20 + +P P= 1.37 E= 3.03 +C P= 6.08 E= 9.22 + +BUDNE - Nov 7, 1983 22:00:52 - phbook (g) + +P P= 1.28 E= 2.58 + +BUDNE - Nov 7, 1983 22:02:08 - phbook (g) + +P P= 1.41 E= 3.09 +C P= 4.29 E= 7.43 + +BUDNE - Nov 7, 1983 22:18:59 - grep + +P P= 1.34 E= 2.56 +C P= 5.32 E= 8.32 + +BUDNE - Nov 10, 1983 13:57:05 - pcc20 + +P P= 1.36 E= 3.25 +C P= 6.21 E= 11.30 + +BUDNE - Dec 14, 1983 01:39:10 - awkint + +P P= 1.13 E= 2.39 + +BUDNE - Dec 14, 1983 01:40:12 - awkint + +P P= 1.22 E= 2.55 +C P= 4.55 E= 8.01 diff --git a/c20/new/pcc20.c b/c20/new/pcc20.c new file mode 100644 index 00000000..b3cb077b --- /dev/null +++ b/c20/new/pcc20.c @@ -0,0 +1,593 @@ +# include +# include +# define FALSE 0 +# define TRUE 1 +/* + + TOPS-20 Portable C Compiler Command Routine + + + Compiler Options + + -c compile only, do not assemble + -g do not delete assembly language temp file + -k keep intermediate files + -f write errors to file instead of tty + -o run code optimizer + -r ring bell when done + + + p=xxx predefine symbol xxx (to be 1) + l=xxx look in directory xxx for include files + +*/ + +/* renamings to allow long names */ + +# define construct_output_file_names cnsofn +# define execute_phase execph +# define write_statistics wrstat +# define print_phase_time prphtm +# define process_options proopt +# define process_minus_option promin +# define process_equal_option proeq + +# define phase_name phsnm +# define phase_pname phspnm +# define phase_prog phspr +# define phase_argc phsac +# define phase_argv phsav +# define phase_option phsop +# define phase_et phset +# define phase_pt phspt + +# define argv_P avp +# define argv_C avc + +/* program file names */ + +/* where to look for executable image files */ +# define PREFIX "C:" + +/* extension of executable image files */ +# define SUFFIX ".exe" + +# define OBJDIR "" + +# define INTSUF "i" +# define OBJSUF "obj" +# define OPTSUF "mid" +# define RELSUF "stk" +# define ERRSUF "cerr" + +# define ASMFILE "sys:midas.exe" + +# define PHASEPRINT 1 + +# define file_name_size 100 + + +/* options */ + +int kflag, cflag, gflag, oflag, rflag, fflag; + +/* table for pre-defined symbols */ + +# define maxpds 10 +char *pdstab[maxpds + 1]; +char **pdsptr = {pdstab}; + +/* tables for #include default directories */ + +# define maxdirs 5 +char *dfdirs[maxdirs + 1]; +char **dfdptr = {dfdirs}; + +/* default search directories for # include <> */ + +# define n10dirs 2 +char *df10dirs[] = {"-IC:", "-ICLIB:"}; + + +/* phase information */ + +# define nphase 3 + +# define phase_P 0 +# define phase_C 1 +# define phase_O 2 + +# define extra maxpds + maxdirs + +char *argv_P[2 + extra]; +char *argv_C[4 + extra]; +char *argv_O[2]; + +char *phase_name[] = {"P","C","O"}; +char *phase_pname[] = {"cpp","pcc","opt"}; +char phase_prog[nphase][file_name_size]; +int phase_argc[] = {2, 3, 2}; +char **phase_argv[] = {argv_P, argv_C, argv_O}; +int phase_et[] = {0, 0, 0}; +int phase_pt[] = {0, 0, 0}; + +static char *pdp10_pdefs[] = {"-DPDP10=1", 0}; /* predefined symbols */ + +# define opsys_name "-DTOPS20=1" + +char *opsys = NULL; + +extern char *sconcat (); + +/********************************************************************** + + THE MAIN PROGRAM + +**********************************************************************/ + +main (argc, argv) +char *argv[]; +{ + extern FILE *stdout; + FILE *f; + int snum, cc, i, ttyflag; + cal start_time; + char *fargv[50], buffer[2000]; + char src_name[file_name_size], + int_name[file_name_size], + obj_name[file_name_size], + opt_name[file_name_size], + rel_name[file_name_size], + err_name[file_name_size]; + char *fptr; + char nambuf[2][file_name_size]; + char cmdbuf[100]; + + --argc; /* skip over program name */ + ++argv; + argc = process_options (argc, argv); + argc = exparg (argc, argv, fargv, buffer); + argv = fargv; + + pp_setup (); /* set up preprocessor arguments */ + + nambuf[0][0] = '<'; /* for re-directed input */ + nambuf[1][0] = '>'; /* for re-directed output */ + + for (snum = 0; snum < argc; ++snum) { + char name[file_name_size]; + + strcpy (src_name, argv[snum]); + + /* check that source file exists */ + + if ((f = fopen (src_name, "r")) == NULL) { + char ext[file_name_size]; + + fngtp (src_name, ext); + if (*ext == 0) { + fnsfd (src_name, src_name, 0, 0, 0, "c", 0, 0); + f = fopen (src_name, "r"); + } + if (f == NULL) { + printf ("Can't Find '%s'.\n", src_name); + continue; + } + } + fclose (f); + fngnm (src_name, name); /* get name part of file spec */ + for (fptr=name;*fptr!=0;fptr++) + *fptr = upperr(*fptr); + +#ifdef SHORTNAME + name[6] = 0; /* print only six chars to match macro */ +#endif + + now (&start_time); + + /* construct output file names from source file name */ + + construct_output_file_names (src_name, int_name, obj_name, + opt_name, rel_name, err_name); + + for (i = 0; i < nphase; ++i) phase_pt[i] = -1; + +#ifdef PHASEPRINT + printf ("CPP:\t%s\n",name); +#else + printf ("CC:\t%s\n",name); +#endif + fflush (stdout); + + argv_P[0] = src_name; /* name of source file */ + argv_P[1] = &nambuf[1][0]; /* >intname for redirected output */ + strcpy (&nambuf[1][1],int_name); /* get intname */ + cc = execute_phase (phase_P); /* reu preprocessor */ + if (!cc) { + +#ifdef PHASEPRINT + printf ("PCC:\t%s\n",name); + fflush (stdout); +#endif + + argv_C[0] = &nambuf[0][0]; /* input from int file */ + strcpy (&nambuf[0][1],int_name); + argv_C[1] = &nambuf[1][0]; /* output to obj file */ + strcpy (&nambuf[1][1],obj_name); + argv_C[2] = name; /* tell pcc the module name */ + if (fflag) { + cmdbuf[0] = '%'; + strcpy (cmdbuf + 1,err_name); + argv_C[3] = cmdbuf; + phase_argc[phase_C] = 4; + } + cc = execute_phase (phase_C); + } + if (!kflag) unlink (int_name); + + if (oflag) { + argv_O[0] = &nambuf[0][0]; + strcpy (&nambuf[0][1],obj_name); + argv_O[1] = &nambuf[1][0]; + strcpy (&nambuf[1][1],opt_name); +#ifdef PHASEPRINT + printf ("OPT:\t%s\n",name); + fflush(stdout); +#endif + cc = execute_phase (phase_O); + if (!kflag) unlink (obj_name); + } + else strcpy (opt_name, obj_name); + + stats(src_name, &start_time); + + if (cc) { + if (!gflag) unlink (opt_name); + } + else if (!cflag) { + +#ifdef PHASEPRINT + printf ("MIDAS:\t%s\n",name); + fflush(stdout); +#endif + + cc = assemble (opt_name, rel_name); + if (!cc && !gflag) unlink (opt_name); + } + if (rflag) { + putc ('\007', stdout); + fflush (stdout); + } + } + if (rflag) { + putc ('\007', stdout); + fflush (stdout); + } +} + +/********************************************************************** + + PROCESS_OPTIONS - Process options in command arguments + and remove options from argument list. + +**********************************************************************/ + +int process_options (argc, argv) +char *argv[]; +{ + char *s, **ss, **dd; + int n, opt; + + kflag = cflag = gflag = rflag = FALSE; + + dd = ss = argv; + n = 0; + while (--argc >= 0) { + s = *ss++; + if (s[0] == '-') process_minus_option (s + 1); + else if ((opt = s[0]) && s[1] == '=') + process_equal_option (opt, s + 2); + else { + *dd++ = s; + ++n; + } + } + return (n); +} + +/********************************************************************** + + PROCESS_MINUS_OPTION + +**********************************************************************/ + +process_minus_option (s) +char *s; +{ + int c; + + while (c = *s) { + *s++ = c = lower (c); + switch (c) { + case 'k': kflag = TRUE; break; + case 'c': cflag = TRUE; break; + case 'g': gflag = TRUE; break; + case 'o': oflag = TRUE; break; + case 'r': rflag = TRUE; break; + case 'f': fflag = TRUE; break; + default: printf ("Unrecognized option: -%c\n", c); + break; + } + } +} + +/********************************************************************** + + PROCESS_EQUAL_OPTION + +**********************************************************************/ + +process_equal_option (opt, s) +char *s; +{ + char *r; + int c; + + switch (opt = lower (opt)) { + case 'p': if (pdsptr < pdstab + maxpds) { + static char pdss[maxpds][20]; + r = &pdss[pdsptr - pdstab][0]; + *pdsptr++ = r; + sconcat (r, 3, "-D", s + 2, "=1"); + } + else printf ("Sorry, too many pre-defined symbols.\n"); + return; + + case 'l': if (dfdptr < dfdirs + maxdirs) { + *dfdptr++ = s; + s[0] = '-'; + s[1] = 'I'; + } + else printf ("Sorry, too many search directories.\n"); + return; + + default: printf ("Unrecognized option: %c=%s\n", opt, s); + } +} + +/********************************************************************** + + PP_SETUP + + Add pre-defined symbols and search directories to ARGV_P + +**********************************************************************/ + +pp_setup () +{ + char **p, *q; + + /* add defined search directories to preproc args */ + p = df10dirs; + while (p < df10dirs + n10dirs) add_arg (phase_P, *p++); + p = dfdirs; + while (p < dfdptr) add_arg (phase_P, *p++); + + /* add predefined symbols to preprocessor args */ + p = pdp10_pdefs; + add_arg (phase_P, *p); /* add system predefined symbols */ + if (q = opsys) { + if (strcmp (q, "-DTOPS20=1")) add_arg (phase_P, "-UTOPS20"); + add_arg (phase_P, q); + } + p = pdstab; /* add user predefined symbols */ + while (p < pdsptr) add_arg (phase_P, *p++); +} + +/********************************************************************** + + ADD_ARG - append an argument to the list for the given phase + +**********************************************************************/ + +add_arg (phs, arg) +char *arg; +{ + phase_argv[phs][phase_argc[phs]++] = arg; +} + +/********************************************************************** + + CONSTRUCT_OUTPUT_FILE_NAMES + + Construct assembler, relocatable, and symbol table listing + file names from source file name. + +**********************************************************************/ + +construct_output_file_names (src_name, int_name, obj_name, opt_name, rel_name, err_name) +char *src_name, *int_name, *obj_name, *opt_name, *rel_name, *err_name; +{ + char *relsuf; + + fnsfd (obj_name, src_name, "", OBJDIR, 0, OBJSUF, 0, 0); + fnsfd (opt_name, obj_name, 0, 0, 0, OPTSUF, 0, 0); + fnsfd (int_name, obj_name, 0, 0, 0, INTSUF, 0, 0); + fnsfd (rel_name, obj_name, 0, 0, 0, RELSUF, 0, 0); + fnsfd (err_name, obj_name, 0, 0, 0, ERRSUF, 0, 0); +} + +/********************************************************************** + + EXECUTE PHASE + +**********************************************************************/ + +execute_phase (n) +int n; +{ + extern int exctime, exccode; + int t; + + set_program_name (n); + t = etime (); + if (execv (phase_prog[n], phase_argc[n], phase_argv[n])) { + printf ("Unable to execute phase %s\n", phase_name[n]); + return (-1); + } + phase_et[n] = etime () - t; /* elapsed time */ + phase_pt[n] = exctime; /* runtime */ + return (exccode); +} + +/********************************************************************** + + SET_PROGRAM_NAME + + Construct the file name of program for the given phase. + +**********************************************************************/ + +set_program_name (n) +int n; +{ + char *r, *s; + + r = PREFIX; + s = SUFFIX; + sconcat (phase_prog[n], 4, r, phase_pname[n],".",s); +} + +/********************************************************************** + + STATS - write statistics to stat file + +**********************************************************************/ + +# define STATFILE1 "C:pcc.stat" + + +stats (src_name, st) +char *src_name; +cal *st; +{ + FILE *f; + int flag, i; + char temp[50]; + + flag = TRUE; + f = fopen (STATFILE1, "a"); +# ifdef statfile2 + if (f == NULL) f = fopen (STATFILE2, "a"); +# endif + if (f == NULL) return; + putc ('\n', f); + strcpy (temp,username ()); + fprintf (f, "%s - ", temp); + prcal (st, f); + fprintf (f, " - "); + fngdr (src_name, temp); + if (temp[0]) { + slower (temp); + fprintf (f, "%s/", temp); + } + fngnm (src_name, temp); + slower (temp); + fprintf (f, "%s", temp); + +# define hack if (flag) {fprint (f, " ("); flag = FALSE;} else putc (' ', f) + + if (cflag || gflag || kflag) { + hack; + if (cflag) putc ('c', f); + if (gflag) putc ('g', f); + if (kflag) putc ('k', f); + } + if (!flag) putc (')', f); + + fprintf (f, "\n\n"); + for (i = 0; i < nphase; ++i) print_phase_time (i, f); + fclose (f); +} + +/********************************************************************** + + PRINT_PHASE_TIME - As Part Of Statistics + +**********************************************************************/ + +print_phase_time (n, f) +FILE *f; +{ + if (phase_pt[n] != -1) { + fprint (f, phase_name[n]); + if (!phase_name[n][1]) putc (' ', f); + fprint (f, " P="); + pr60th (phase_pt[n], f); + fprint (f, " E="); + pr60th (phase_et[n], f); + putc ('\n', f); + } +} + +/********************************************************************** + + ASSEMBLE - Create the relocatable file from the assembler file + + return TRUE iff an error occurred + +**********************************************************************/ + +int assemble (obj_name, rel_name) +char *obj_name, *rel_name; +{ +# ifdef TENEX + /* TENEX can't run MIDAS as an inferior -- sigh */ + fprint ("OUTPUT on %s\n", obj_name); + return (TRUE); +} +# else + + char *s, temp[100]; + FILE *f; + + /* construct Assembler command line */ + + strcpy (temp, rel_name); + strcat (temp, " _ "); + strcat (temp, obj_name); + strcat (temp, " (w)", s); + + /* execute Assembler */ + if (execs (ASMFILE, temp)) { + fprint (stderr,"Unable to Assemble.\n"); + return (TRUE); + } + + /* construct Assembler record file name */ + + fnsfd (temp, obj_name, 0, 0, 0, "err", 0, 0); + + /* examine Assembler record file */ + + f = fopen (temp, "r"); + if (f != NULL) { /* look for '-' + '\t' */ + register int c; + + while ((c = getc (f)) != EOF) { + if (c == '-') { + c = getc (f); + if (!isdigit (c)) continue; + while (isdigit (c)) c = getc (f); + if (c != '\t') continue; + fprint (stderr, "Assembler Errors.\n"); + fclose (f); + return (TRUE); + } + } + fclose (f); + unlink(temp); + } + return (FALSE); +} +# endif diff --git a/c20/new/pcc20.stat b/c20/new/pcc20.stat new file mode 100644 index 00000000..c06924f9 --- /dev/null +++ b/c20/new/pcc20.stat @@ -0,0 +1,5 @@ + +BUDNE - Nov 10, 1983 13:58:38 - peep + +P P= 1.21 E= 2.44 +C P= 3.02 E= 7.05 diff --git a/c20/new/pcc20.stinkr b/c20/new/pcc20.stinkr new file mode 100644 index 00000000..42c60e5b --- /dev/null +++ b/c20/new/pcc20.stinkr @@ -0,0 +1,4 @@ +x c:clib +l pcc20 +l clib:c20exc +o pcc20.exe diff --git a/c20/new/rel/cinsrt.mid b/c20/new/rel/cinsrt.mid new file mode 100644 index 00000000..1b404006 --- /dev/null +++ b/c20/new/rel/cinsrt.mid @@ -0,0 +1,61 @@ +; C:CINSRT.MID +; hacked /plb to procduce .REL files + +; This file is .INSRTed by code generated by the C compiler PCC20 + +ifn 0,[ ;plb +.symtab 4000.,4000. +relocatable +.insrt c:mulseg +.mseg 400000',600000' +] ;plb + +.symtab 6089.,4001. ;plb +.dectwo 400000 ;plb +.insrt c:decseg ;plb +.mseg 400000 ;plb + +if1,[ +.mllit==1 + +a==1 +b==2 +c==3 +d==4 +t1=1 +t2=2 +t3=3 +t4=4 + +ep=16 +p=17 + +.global cfloat +.global cfix + +define .idata +.seg 0 +termin + +define .code +.seg 1 +termin + +define .pdata +.seg 2 +termin + +];end if1 + +; hack for constants so they end up in segment .pdata + +equals nm%en end +expunge end + +define end endloc + .pdata + constants + nm%en endloc + termin + +.code diff --git a/c20/new/rel/decseg.mid b/c20/new/rel/decseg.mid new file mode 100644 index 00000000..23b96000 --- /dev/null +++ b/c20/new/rel/decseg.mid @@ -0,0 +1,44 @@ +; DEC TWOSEG MACROS FOR CLIB THAT LOOK LIKE "MULSEG.MID" FOR STINKR +; **** ONLY USE SEGMENTS 0 & 1 + + +IF1,[ +; CROCK FOR C20RUN.CMID + +DEFINE SEG3HI +[0]!TERMIN + +DEFINE MS%AS *PREFIX*,#SEGNO,*SUFFIX* + PREFIX!SEGNO!SUFFIX + TERMIN + +DEFINE .MSEG ARGS/ + MS%NS==1 + MS%O0==0 + MS%L0==. + IRP ARG,,[ARGS] + MS%AS /MS%O/,MS%NS,/==ARG/ + MS%AS /MS%L/,MS%NS,/==.+ARG/ + MS%AS /.KILL MS%O/,MS%NS + MS%AS /.KILL MS%L/,MS%NS + MS%NS==MS%NS+1 + TERMIN + MS%CS==0 + TERMIN + +DEFINE .SEG N + IFN N-MS%CS,[ + MS%AS /MS%L/,MS%CS,/==./ + MS%CS==N + MS%AS /LOC MS%L/,MS%CS + ] + TERMIN + +EQUALS MS%END END +EXPUNGE END +DEFINE END ENDLOC + MS%AS /MS%L/,MS%CS,/==./ + EQUALS END MS%END + END ENDLOC + TERMIN +] diff --git a/c20/new/stddbg.stinkr b/c20/new/stddbg.stinkr new file mode 100644 index 00000000..dc6a0042 --- /dev/null +++ b/c20/new/stddbg.stinkr @@ -0,0 +1,22 @@ +s 140,p,n,n +i linit +l clib:c2ddrn ; debugging runtime support +l clib:c20lod ; load-time routines +l clib:c20fnm ; basic file name hacking +l clib:c20io ; I/O drivers +l clib:c20pip ; pipes +l clib:c20lib ; random macro code +l clib:c20sys ; JSYS interface +l clib:c20tty ; TTY output drivers +l clib:c20int ; interrupt handlers +l clib:c20mem ; storage allocator +l clib:c20ati ; string <-> number conversions +l clib:c20blt ; BLT instruction interface +l clib:c20flt ; floating point functions (sin, cos, ...) +l clib:c20prt ; formatted printing stuff +l clib:c20fpr ; formatted floating point printing stuff +l clib:c20scn ; SCANF code +l clib:c20str ; string manipulation routines +l clib:c20typ ; support for CTYPE.H macros +l clib:c2ddbg ; debugging code +l clib:c2dmdb ; macro debugger support \ No newline at end of file diff --git a/c20/new/stdio.stinkr b/c20/new/stdio.stinkr new file mode 100644 index 00000000..da7613a4 --- /dev/null +++ b/c20/new/stdio.stinkr @@ -0,0 +1,20 @@ +s 140,p,n,n +i linit +l clib:c20run ; basic runtime support +l clib:c20lod ; load-time routines +l clib:c20fnm ; basic file name hacking +l clib:c20io ; I/O drivers +l clib:c20pip ; pipes +l clib:c20lib ; random macro code +l clib:c20sys ; JSYS interface +l clib:c20tty ; TTY output drivers +l clib:c20int ; interrupt handlers +l clib:c20mem ; storage allocator +l clib:c20ati ; string <-> number conversions +l clib:c20blt ; BLT instruction interface +l clib:c20flt ; floating point functions (sin, cos, ...) +l clib:c20prt ; formatted printing stuff +l clib:c20fpr ; formatted floating point printing stuff +l clib:c20scn ; SCANF code +l clib:c20str ; string manipulation routines +l clib:c20typ ; support for CTYPE.H macros diff --git a/c20/new/tape.ctl b/c20/new/tape.ctl new file mode 100644 index 00000000..a556f93b --- /dev/null +++ b/c20/new/tape.ctl @@ -0,0 +1,25 @@ +! CTL file to make PCC20 Distribution tape +! JTW 3/26/82 +@define tape: mta0: +@enable +@delete c:pcc.stat.* +@dumper +*tape tape: +*list tape.files +*ssname DOC FILES +*save *.*.* +*ssname SYS: FILES +*save sys:cc.exe,sys:stinkr.exe,sys:midas.exe +*ssname FILES +*save ps:*.*.* +*ssname INCLUDE FILES +*save ps:*.*.* +*ssname CLIB: FILES +*save *.*.* +*ssname SOURCE FILES +*save ps:*.*.* +*unload +*exit +@undelete c:pcc.stat +@disable +@logout diff --git a/c20/new/tape.files b/c20/new/tape.files new file mode 100644 index 00000000..07980513 --- /dev/null +++ b/c20/new/tape.files @@ -0,0 +1,56 @@ + +DUMPER tape # 1, DOC FILES, Friday, 6-May-83 1519 + +Directory (number) + file last write size (pages) checksum + +PS: (540) + + CC.BWR.5 6-May-83 1219 1 + CC.DOC.4 24-Mar-83 0309 5 + CC.HLP.3 3-Dec-82 2044 2 + DEBUG.DOC.1 8-May-82 2029 1 + EXTENSIONS.DOC.2 8-May-82 2036 2 + INSTALL.DOC.4 3-Dec-82 2102 2 + INT.DOC.3 8-May-82 2149 2 + JSYS.DOC.1 20-Apr-82 2001 1 + STINKR.DOC.1 8-May-82 1908 1 + + Total 9 files, 17 pages + + +Total files dumped = 9 +Total pages dumped = 17 + +DUMPER tape # 1, SYS: FILES, Friday, 6-May-83 1530 + +Directory (number) + file last write size (pages) checksum + +PS: (132) + + CC.EXE.3 15-Sep-82 2142 38 + + Total 1 files, 38 pages + +PS: (3) + + STINKR.EXE.5 27-May-81 0050 47 + + Total 1 files, 47 pages + +PS: (62) + + MIDAS.EXE.430 26-Jan-83 1639 66 + + Total 1 files, 66 pages + +PS: (3) + + MIDAS.EXE.430 26-Jan-83 1639 66 + + Total 1 files, 66 pages + + +Total files dumped = 4 +Total pages dumped = 217 diff --git a/c20/new/testc.c b/c20/new/testc.c new file mode 100644 index 00000000..9523e33d --- /dev/null +++ b/c20/new/testc.c @@ -0,0 +1,487 @@ +# include + +/* + + TESTC - Program to test C Compiler + +*/ + +/********************************************************************** + + data for testing global data definition and initialization + +**********************************************************************/ + +int e1; +int e2 = 9; +int e3 = {2*6}; +int e4[5] = {0, 1, 2, 3, 4}; + +static int i1; +static int i2 = -13; +static int i3 = {4096}; +static int i4[5] = {0, -1, -2, -3, -4}; + +char c1; +char c2 = 'a'; +char c3 = {'b'}; +char c4[5] = {'A', 'B', 'C', 'D', 'E'}; + +int *p1 = {&i2}; +char *p2[2] = {"foo", &c3}; +int *p3; + + +/********************************************************************** + + small functions for testing functions + +**********************************************************************/ + +int f1 (z) {return z+3;} +int f2 (x, y) {return x-y;} + +/********************************************************************** + + MAIN - control routine + +**********************************************************************/ + +main () + + {printf ("C Testing Program.\n"); + tcond (); + tint (); + tincr (); + tbit (); + tclass (5, -9999); + tfunc (f1); + tswitch (); + printf ("Done.\n"); + } + +error (i) + + {printf ("*** Error No. %d ***\n", i);} + +/********************************************************************** + + TCOND - test conditionals and logical operations + +**********************************************************************/ + +tcond () + + {int i, j; + + printf ("Testing Conditionals.\n"); + + if (0) error (10); + if (1) ; else error (20); + i = 0; + if (i) error (30); + if (i > 0) error (40); + if (i < 0) error (50); + if (i != 0) error (60); + if (i == 0) ; else error (70); + if (i <= 0) ; else error (80); + if (i >= 0) ; else error (90); + if (i > 0) i = 4; else i = 3; + if (i != 3) error (100); + if (i == 0) error (110); + if (i == 4) error (120); + i = 0; + j = 0; + if (i && j) error (130); + if (i || j) error (140); + if (!i) ; else error (150); + j = 1; + if (i && j) error (160); + if (i || j) ; else error (170); + if (!j) error (180); + i = 2; + if (i && j) ; else error (190); + if (i || j) ; else error (200); + if (!i) error (210); + } + +/********************************************************************** + + TINT - test integer arithmetic + +**********************************************************************/ + +tint () + + {int i, j, k; + int x0, x1, x2, x3, x4; + + printf ("Testing Integer Arithmetic.\n"); + + x0=0;x1=1;x2=2;x3=3;x4=4; + if (x0 != 0) error (10); + if (x1 > 1) error (20); + if (x2 < 2) error (30); + if (x3 <= 3) ; else error (31); + if (x4 >= 4) ; else error (32); + if (x1 + x2 != x3) error (40); + if (x1 * x3 != x3) error (50); + if (x4 / x2 != x2) error (60); + if (x4 % x3 != x1) error (70); + i = 56; + j = -102; + k = 7; + if (i*j + i*k != i*(j+k)) error (80); + if (i*(k+3) + j*(k+3) != (i+j)*(k+3)) error (90); + j += i; + if (j != -46) error (100); + if ((j += i) != 10 || j != 10) error (110); + if (++j != 11 || j != 11) error (120); + if (j++ != 11 || j != 12) error (130); + if (--j != 11 || j != 11) error (140); + if (j-- != 11 || j != 10) error (150); + if (-j != k-17) error (160); + if ((j *= 2) != 20 || j != 20) error (170); + if ((j -= 13) != k || j != k) error (180); + if ((j %= 4) != 3 || j != 3) error (190); + if ((i /= 14) != x4 || i != x4) error (200); + if (3 + 5 - 12 * 40 != -472) error (210); + if (-5 * 10 != -448/56 + 68%9 - 47) error (220); + if (k*1 != 0+k) error (230); + if (k/1 != k || k != k-0) error (240); + if (i*0) error (250); + } + +/********************************************************************** + + TFUNC - test function calling + +**********************************************************************/ + +tfunc (x) int (*x)(); + + {printf ("Testing Function Calling.\n"); + + if ((*x)(4) != 7) error (10); + x = f2; + if ((*x)(7,2) != 5) error (20); + } + +/********************************************************************** + + TSWITCH - test switch statement + +**********************************************************************/ + +tswitch () + + {printf ("Testing Switch Statements.\n"); + + tsw1 (0); + tsw1 (1); + tsw1 (2); + tsw1 (3); + tsw1 (4); + tsw1 (-2); + tsw1 (-5); + tsw1 (-10000); + tsw1 (4000); + tsw1 (15); + tsw2 (0); + tsw2 (1); + tsw2 (2); + tsw2 (3); + tsw2 (4); + tsw2 (-2); + tsw2 (-5); + tsw2 (-10000); + tsw2 (4000); + tsw2 (15); + } + +/********************************************************************** + + support routines for testing of switch statement + +**********************************************************************/ + +tsw1 (i) + + {switch (i) { + + error (10); + break; + error (20); +case 4: + if (i!=4) error (30); + break; + error (40); +case 2: + if (i!=2) error (50); +case 3: + if (i!=3 && i!=2) error (60); + break; + error (70); +case 0: + if (i!=0) error (80); + break; +case -2: + if (i != -2) error (90); + break; +default: + if (i == -2 || i == 0 || i == 2 || i == 3 || i == 4) + error (100); + } + } + +tsw2 (i) + + {int j; + + j = -9; + + switch (i) { + + error (200); + break; + error (210); +case -10000: + if (i != -10000) error (220); + break; + error (230); +case 3: + if (i != 3) error (240); + j = 3; +case -5: + if (i != -5 && i != 3) error (250); + if (i == 3 && j != 3) error (251); + break; +case 4000: + if (i != 4000) error (260); + j = 36; + break; +default: + if (i == -10000 || i == 3 || i == -5 || i == 4000) + error (270); + if (i == 1) j = 24; + } + + if (i == 3 && j != 3) error (280); + if (i == 4000 && j != 36) error (290); + if (i == 1 && j != 24) error (300); + } + +/********************************************************************** + + TINCR - test increment and decrement operations + +**********************************************************************/ + +tincr () + + {int i, *p, a[3]; + + printf ("Testing Increment and Decrement Operations.\n"); + + i = 0; + if (i) error (4000); + ++i; + if (i != 1) error (4010); + ++i; + if (i != 2) error (4020); + i++; + if (i != 3) error (4030); + i++; + if (i != 4) error (4040); + i--; + if (i != 3) error (4050); + i = -10; + --i; + if (i != -11) error (4060); + ++i; + if (i != -10) error (4070); + if (--i != -11) error (4080); + if (i != -11) error (4090); + if (i-- != -11) error (4100); + if (i != -12) error (4110); + if (++i != -11) error (4120); + if (i != -11) error (4130); + if (i++ != -11) error (4140); + if (i != -10) error (4150); + + a[0] = 10; + a[1] = 11; + a[2] = 12; + + p = a+1; + if (*p != 11) error (4160); + if (*--p != 10) error (4170); + if (*p != 10) error (4180); + if (*p++ != 10) error (4190); + if (*p != 11) error (4200); + if (*++p != 12) error (4210); + if (*p != 12) error (4220); + if (*p-- != 12) error (4230); + if (*p != 11) error (4240); + } + +/********************************************************************** + + TBIT - test bit hacking operations + +**********************************************************************/ + +tbit () + + {int i, j; + + printf ("Testing Bit Hacking Operations.\n"); + + i = 0; + j = -1; + if (~i != j) error (10); + if (~~i != i) error (20); + if (~j != i) error (30); + if (i & j) error (40); + if (i | i) error (50); + if (j ^ j) error (60); + i = 1; + if ((i << 1) != 2) error (70); + if ((i <<= 1) != 2 || i != 2) error (71); + i = 1; + if ((i << 8) != 0400) error (80); + if ((i <<= 8) != 0400 || i != 0400) error (81); + i = 0404; + if ((i >> 1) != 0202) error (90); + if ((i >>= 1) != 0202 || i != 0202) error (91); + i = 0404; + if ((i >> 2) != 0101) error (100); + if ((i >> 6) != 04) error (110); + i = 0404; + if ((i ^ 0703) != 0307) error (120); + if ((i ^= 0703) != 0307 || i != 0307) error (121); + i = 0404; + if ((i ^ 0707) != 0303) error (130); + if ((i ^= 0707) != 0303 || i != 0303) error (131); + i = 0404; + if ((i | 030) != 0434) error (140); + if ((i |= 030) != 0434 || i != 0434) error (141); + i = 0625; + if ((i & 0451) != 0401) error (150); + if ((i &= 0451) != 0401 || i != 0401) error (151); + } + +/********************************************************************** + + TCLASS - test different storage classes + +**********************************************************************/ + +tclass (x, y) int x, y; + + {int i, j; + static int k, l; + + printf ("Testing Storage Classes.\n"); + + if (x != 5) error (5010); + if (y != -9999) error (5020); + if (k != 0) error (5030); + if (l != 0) error (5040); + i = 6; + j = 9; + x = i; + k = y; + if (i != 6) error (5050); + if (j != 9) error (5060); + if (x != 6) error (5070); + if (y != -9999) error (5080); + if (k != -9999) error (5090); + if (l != 0) error (5100); + if (e1 != 0) error (5110); + if (e2 != 9) error (5120); + if (e3 != 12) error (5130); + if (e4[0] != 0) error (5140); + if (e4[4] != 4) error (5150); + if (i1 != 0) error (5160); + if (i2 != -13) error (5170); + if (i3 != 4096) error (5180); + if (i4[1] != -1) error (5190); + if (i4[3] != -3) error (5200); + if (c1 != 0) error (5210); + if (c2 != 'a') error (5220); + if (c3 != 'b') error (5230); + if (c4[0] != 'A') error (5240); + if (c4[4] != 'E') error (5250); + if (p1 != &i2) error (5260); + if (p2[0][1] != 'o') error (5270); + if (p2[1] != &c3) error (5280); + e2 = i2; + i1 = e3; + if (e2 != -13) error (5290); + e2 = c1; + if (e2 != 0) error (5300); + if (i1 != 12) error (5310); + p1 = &x; + if (*p1 != 6) error (5320); + *p1 = 98; + p1 = &k; + if (*p1 != -9999) error (5330); + *p1 = 34; + if (x != 98) error (5340); + if (k != 34) error (5350); + if ((&c4[4] - &c4[1]) != 3) error (5360); + if ((&e4[2] - &e4[3]) != -1) error (5370); + if (p3) error (5380); + if (!p3); else error (5480); + p1 = &y; + if (*p1 != y) error (5490); + *p1 = 77; + if (y != 77) error (5500); + } + +/********************************************************************** + + output routines + +**********************************************************************/ + +#ifdef NOLIB + +printf (fmt, x1, x2) char fmt[], x1[], x2[]; + + {int *argp, x, c; + char *s; + + argp = &x1; /* argument pointer */ + while (c = *fmt++) + {if (c != '%') putchar (c); + else + {x = *argp++; + switch (c = *fmt++) { + + case 'd': /* decimal */ + if (x<0) {x= -x; putchar ('-');} + cprd (x); + break; + + case 's': /* string */ + s = x; + while (c = *s++) putchar (c); + break; + + default: putchar (c); + argp--; + } + } + } + } + +cprd (n) + + {int a; + if (a=n/10) cprd (a); + putchar (n%10+'0'); + } + +#endif \ No newline at end of file diff --git a/c20/new/yaccpar. b/c20/new/yaccpar. new file mode 100644 index 00000000..dc3a194f --- /dev/null +++ b/c20/new/yaccpar. @@ -0,0 +1,140 @@ + + +# define YYFLAG -1000 +# define YYERROR goto yyerrlab +# define YYACCEPT return(0) +# define YYABORT return(1) + +/* parser for yacc output */ + +int yydebug = 0; /* 1 for debugging */ +YYSTYPE yyv[YYMAXDEPTH]; /* where the values are stored */ +int yychar = -1; /* current input token number */ +int yynerrs = 0; /* number of errors */ +short yyerflag = 0; /* error recovery flag */ + +yyparse() { + + short yys[YYMAXDEPTH]; + short yyj, yym; + register YYSTYPE *yypvt; + register short yystate, *yyps, yyn; + register YYSTYPE *yypv; + register short *yyxi; + + yystate = 0; + yychar = -1; + yynerrs = 0; + yyerflag = 0; + yyps= &yys[-1]; + yypv= &yyv[-1]; + + yystack: /* put a state and value onto the stack */ + + if( yydebug ) printf( "state %d, char 0%o\n", yystate, yychar ); + if( ++yyps> &yys[YYMAXDEPTH] ) { yyerror( "yacc stack overflow" ); return(1); } + *yyps = yystate; + ++yypv; + *yypv = yyval; + + yynewstate: + + yyn = yypact[yystate]; + + if( yyn<= YYFLAG ) goto yydefault; /* simple state */ + + if( yychar<0 ) if( (yychar=yylex())<0 ) yychar=0; + if( (yyn += yychar)<0 || yyn >= YYLAST ) goto yydefault; + + if( yychk[ yyn=yyact[ yyn ] ] == yychar ){ /* valid shift */ + yychar = -1; + yyval = yylval; + yystate = yyn; + if( yyerflag > 0 ) --yyerflag; + goto yystack; + } + + yydefault: + /* default state action */ + + if( (yyn=yydef[yystate]) == -2 ) { + if( yychar<0 ) if( (yychar=yylex())<0 ) yychar = 0; + /* look through exception table */ + + for( yyxi=yyexca; (*yyxi!= (-1)) || (yyxi[1]!=yystate) ; yyxi += 2 ) ; /* VOID */ + + while( *(yyxi+=2) >= 0 ){ + if( *yyxi == yychar ) break; + } + if( (yyn = yyxi[1]) < 0 ) return(0); /* accept */ + } + + if( yyn == 0 ){ /* error */ + /* error ... attempt to resume parsing */ + + switch( yyerflag ){ + + case 0: /* brand new error */ + + yyerror( "syntax error" ); + yyerrlab: + ++yynerrs; + + case 1: + case 2: /* incompletely recovered error ... try again */ + + yyerflag = 3; + + /* find a state where "error" is a legal shift action */ + + while ( yyps >= yys ) { + yyn = yypact[*yyps] + YYERRCODE; + if( yyn>= 0 && yyn < YYLAST && yychk[yyact[yyn]] == YYERRCODE ){ + yystate = yyact[yyn]; /* simulate a shift of "error" */ + goto yystack; + } + yyn = yypact[*yyps]; + + /* the current yyps has no shift onn "error", pop stack */ + + if( yydebug ) printf( "error recovery pops state %d, uncovers %d\n", *yyps, yyps[-1] ); + --yyps; + --yypv; + } + + /* there is no state on the stack with an error shift ... abort */ + + yyabort: + return(1); + + + case 3: /* no shift yet; clobber input char */ + + if( yydebug ) printf( "error recovery discards char %d\n", yychar ); + + if( yychar == 0 ) goto yyabort; /* don't discard EOF, quit */ + yychar = -1; + goto yynewstate; /* try again in the same state */ + + } + + } + + /* reduction by production yyn */ + + if( yydebug ) printf("reduce %d\n",yyn); + yyps -= yyr2[yyn]; + yypvt = yypv; + yypv -= yyr2[yyn]; + yyval = yypv[1]; + yym=yyn; + /* consult goto table to find next state */ + yyn = yyr1[yyn]; + yyj = yypgo[yyn] + *yyps + 1; + if( yyj>=YYLAST || yychk[ yystate = yyact[yyj] ] != -yyn ) yystate = yyact[yypgo[yyn]]; + switch(yym){ + $A + } + goto yystack; /* stack new state and value */ + + } diff --git a/c20/nm.mid b/c20/nm.mid new file mode 100644 index 00000000..7f070cf9 --- /dev/null +++ b/c20/nm.mid @@ -0,0 +1,166 @@ +; NM.MID + +; This file provides useful macros for hand-coded MIDAS programs designed +; to be loaded with C programs. + +CL=PUSHJ P, +RTN=POPJ P, + +.VCALL=2_33 +.ACALL=3_33 +.XCALL=4_33 + +DEFINE SYSCAL NAME,ARGS,DUMMY,LABEL + SETZ A, + .CALL [SETZ + .1STWD SIXBIT /NAME/ + ARGS + 403000,,A + ] + IFSN [LABEL][]GO LABEL + IFSE [LABEL][]MOVN A,A + TERMIN + +DEFINE INFORM A,B +IF1,[PRINTX \ A = B +\] +TERMIN + +; SUPPORT ROUTINES + +DEFINE %LEN [LIST] +%COUNT==0 +IRP ELEM,,LIST + %COUNT==%COUNT+1 + TERMIN +TERMIN + +DEFINE DEFVAR NAME,#OFFSET + DEFINE NAME +&262143.(P)TERMIN +TERMIN + +; DEFINE C-CALLABLE PROCEDURE (C NAME) + +DEFINE CENTRY NAME,[ARGS],[VARS] + PROLOG Z!NAME,NAME,ARGS,VARS + TERMIN + +; DEFINE C-CALLABLE PROCEDURE (MIDAS NAME) + +DEFINE MENTRY NAME,[ARGS],[VARS] + PROLOG NAME,NAME,ARGS,VARS + TERMIN + +; DEFINE MIDAS ENTRY POINT (NOT PROCEDURE) + +DEFINE IENTRY NAME +NAME": TERMIN + +; PROLOG MACRO + +DEFINE PROLOG MNAME,PNAME,[ARGS],[VARS] + %LEN ARGS + %A==%COUNT + %LEN VARS + %V==%COUNT + %OFF== -<%A+%V> + IRP ARGNAM,,ARGS + DEFVAR ARGNAM,%OFF + %OFF==%OFF+1 + TERMIN + %OFF==%OFF+1 + IRP VARNAM,,VARS + DEFVAR VARNAM,%OFF + %OFF==%OFF+1 + TERMIN + %A,,[ASCIZ/PNAME/] +MNAME": IFN %V,[ADDI P,%V] + TERMIN + +; DEFINE SYNONYM FOR C-CALLABLE ENTRY POINT + +DEFINE XENTRY NEWNAME,OLDNAME +Z!NEWNAME"=Z!OLDNAME" +TERMIN + +; DEFINE MIDAS-ACCESSIBLE DATA + +DEFINE MDATA NAME +NAME":TERMIN + +; FATAL ERROR + +DEFINE CROAK STRING/ + PUSH P,[ + HRROI 1,[ASCIZ \; STRING \] + PSOUT + HALTF + ] + TERMIN + +; RETURN STATEMENT + +DEFINE RETURN + IFE %A,[ + IFN %V,[SUBI P,%V] + POPJ P, + ] + IFN %A,[ + SUBI P,%V+%A+1 + JRST @<%A+1>(P) + ] + TERMIN + +; CALL STATEMENT + +DEFINE CALL NAME,[ARGS] + NN==0 + IRP ARG,,ARGS + PPUSH ARG + NN==NN+1 + TERMIN + ICALL NN,NAME + TERMIN + +; MIDAS-CALL STATEMENT + +DEFINE MCALL NAME,[ARGS] + NN==0 + IRP ARG,,ARGS + PPUSH ARG + NN==NN+1 + TERMIN + CCALL NN,NAME" + TERMIN + +; VARIABLE-CALL STATEMENT + +DEFINE VCALL F,[ARGS] + NN==0 + IRP ARG,,ARGS + PPUSH ARG + NN==NN+1 + TERMIN + CCALL NN,F + TERMIN + +; INTERNAL CALL + +DEFINE ICALL N,NAME + CCALL N,Z!NAME" + TERMIN + +; HACK FOR CONSTANTS + +EQUALS NM%EN END +EXPUNGE END +DEFINE END ENDLOC + .CODE +; INSCODE + .PDATA + CONSTANTS + NM%EN ENDLOC + TERMIN + +.CODE diff --git a/c20/oyacc.hlp b/c20/oyacc.hlp new file mode 100644 index 00000000..8e6b3df0 --- /dev/null +++ b/c20/oyacc.hlp @@ -0,0 +1,341 @@ + YACC - Use and Operation + - 2 - + + +1. Introduction + +This paper describes the use and operation of a LALR(1) parser +generator YACC (Yet Another Compiler-Compiler). YACC accepts as +input a BNF-like grammar and, if possible, produces as output a +set of tables for a table-driven shift-reduce parsing routine. +The parsing routine and the tables together form a parser which +recognizes the language defined by the grammar. The parser +generated by YACC can be used as the core of a syntax analyzer by +including in the grammar calls to user-provided action routines. +These calls are made by the parser at the appropriate points in +the analysis of the input string. + +The class of LALR(1) grammars is a subclass of the class of LR(1) +grammars, those which can be parsed by a deterministic bottom-up +parser using one symbol of lookahead. The LALR(1) grammars are +those LR(1) grammars for which a parser can be constructed by a +relatively efficient process. Theoretically, all deterministic +context-free languages have a LR(1) grammar, but not necessarily +a LALR(1) grammar. Practically, however, it has been observed +that most common programming languages have "natural" grammars +which are easily converted to be LALR(1). + +The original YACC was designed and implemented on a PDP-11/45 and +a Honeywell 6000 by S. C. Johnson at Bell Laboratories. The +version described in this paper was implemented on the PDP-10 by +Alan Snyder. + - 3 - + + +2. Using YACC + +In the simplest case, the input to YACC is a file containing a +BNF-like grammar for the language. The grammar consists of a +sequence of rules, which have the following syntax: + + rule: lhs ':' rhs_list + lhs: symbol + rhs_list: rhs | rhs_list '|' rhs + rhs: symbol_sequence + symbol_sequence: symbol | symbol_sequence symbol + +The above rules for rules are examples of rules. Another example +is the following simple grammar for expressions: + + e: e '+' t | e '-' t | t + t: t '*' p | t '/' p | p + p: idn | '(' e ')' + +A symbol is any sequence of alphanumeric characters, including +underlines, dollar signs, and periods. In addition, a symbol may +be any sequence of characters enclosed in single quotes. + +The symbols which appear as the left-hand-sides of rules are the +non-terminal symbols; all other symbols appearing in the grammar +are assumed to be terminal symbols. The symbol appearing as the +left-hand-side of the first rule is considered to be the start +symbol of the grammar. + +After a file containing the grammar has been prepared, YACC may be +run. YACC will respond by asking for the name of the file containing +the grammar. After the file name is entered, YACC will analyze +the grammar and construct the parsing tables. YACC will print some +messages on the terminal to indicate its progress. When it has +finished, a listing will have been placed on the file YACC OUTPUT and +the parsing tables will have been written onto the file YACC TABLES. + +In the process of constructing a parser for the grammar, YACC +may discover conflicts in the grammar. These conflicts indicate +that the grammar is not LALR(1). The conflicts, which are listed +in the OUTPUT file, may be of two types. The first type of +conflict is a shift/reduce conflict, abbreviated S/R. A +shift/reduce conflict indicates that, in the given state and with +the given input symbol, the constructed parser could legitimately +either shift the input symbol onto the stack or make an immediate +reduction. Shift/reduce conflicts are resolved by YACC in favor +of shifting. The second type of conflict is a reduce/reduce +conflict, abbreviated R/R. A reduce/reduce conflict indicates +that, in the given state and with the given input symbol, the +parser could legitimately make either of two reductions. +Reduce/reduce conflicts are resolved by YACC in favor of the +production appearing earlier in the input file. + +The relation of a conflict to a problem in the grammar can be + - 4 - + + +determined by examining the description of the particular state +in the action table section of the OUTPUT file. The first part +of the description is a set of items, where an item is a rule +which contains a marker ('.') in the right-hand-side. The marker +indicates how much of the right-hand-side has been seen by the +parser when the parser is in that state. Thus, the collection of +items represents the set of possibilities being considered by the +parser when in that state. A conflict indicates that the parser +cannot discard one of two possibilities on the basis of the +current input symbol, yet any action it takes will have the +effect of eliminating one of the two possibilities. + - 5 - + + +3. Interfacing with a Lexical Analyzer + +The parsing tables produced by YACC are in the form of a C +program, ready to be compiled by the C compiler (CC). This C +program may be loaded together with the compiled version of a +parsing routine in order to construct a working parser for the +language. A standard parsing routine, called PARSE, may be found +in the file "YPARSE.C". + +PARSE assumes the existence of a lexical routine, called GETTOK, +which it can call in order to obtain the next terminal symbol +from the input stream. GETTOK is expected to set the values of +three integer global variables, LEXTYPE, LEXINDEX, and LEXLINE. +LEXTYPE should be set to an integer which distinguishes which +terminal symbol has been read. The correspondence between +integers and terminal symbols is listed in the OUTPUT file +produced by YACC. However, it is more convenient when an actual +parser is to be constructed to specify in the grammar the +correspondence between integers and terminal symbols. This is +done by listing at the beginning of the file the terminal symbols +of the grammar. They will be numbered consecutively, starting +with 3. (The integer 1 is to be returned by the lexical routine +to indicate the end of the input stream; the integer 2 is +reserved for an error recovery method.) The listing of terminal +symbols in the grammar should be separated from the list of rules +by the symbol '\\'. For example, the grammar + + '+' '-' '*' '/' '(' ')' idn + + \\ + + e: e '+' t | e '-' t | t + t: t '*' p | t '/' p | p + p: idn | '(' e ')' + +defines the following representations of terminal symbols: + + eof 1 + + 3 + - 4 + * 5 + / 6 + ( 7 + ) 8 + idn 9 + +The variable LEXLINE should be set to the line number in the +input file on which the terminal symbol being returned appeared; +this value is used by PARSE when reporting syntax errors and is +made available to any action routines. The variable LEXINDEX is +used only when performing translations (see next section). + +In addition, PARSE requires a routine PTOKEN which will print +some symbolic representation of a token; this routine is used +when reporting syntax errors. + - 6 - + + +4. Performing Translations + +As described so far, the parser performs only recognition; that +is, given an input string of terminal symbols, it will produce +error messages if the string is not in the language defined by +the grammar and do nothing otherwise. YACC is capable also of +producing tables for a parser which performs translations, for +example, the syntax analyzer of a compiler. The following +extension is made in order to support translation: the parser +associates with each terminal symbol (received from the lexical +routine) and each nonterminal symbol (resulting from a reduction) +a word (integer, pointer) called a translation element. The +translation element for a terminal symbol is produced by the +lexical routine; it is communicated to PARSE via the global +variable LEXINDEX. Typically, the translation element for a +terminal symbol is used to distinguish between different +identifiers and constants. The translation element for a +nonterminal symbol is obtained by calling a user-provided action +routine when a reduction is made which produces the nonterminal +symbol. This action routine is specified by following the +production rule in the grammar with the body of the routine, +enclosed in braces. The action routine may access the +translation elements associated with the symbols on the right- +hand-side of the production using the notation #n, where "n" is +the number of the symbol (i.e., #1 refers to the translation +element for the first symbol of the right-hand-side). The action +routine specifies the value for the left-hand-side by setting the +global variable VAL. A typical action routine in a parser which +produces tree representations is + + {val=node(node_type,#1,#2,#3);} + +where node is a routine which constructs nodes of the tree and +node_type is a tag which indicates the type of the node. An +action routine may also specify a line-number to be associated +with the left-hand-side by setting the global variable LINE; the +line-numbers of the symbols on the right-hand-side are accessible +through the global variable PL (i.e., pl[3] refers to the line- +number of the third symbol on the right-hand-side). + - 7 - + + +5. Disambiguation + +YACC is capable of disambiguating ambiguous grammars through the +use of precedence and associativity information. This is +especially useful in the case of arithmetic expressions since it +allows a much simpler grammar to be used. For example, the +grammar for expressions given above could be written: + + '+' '-' '*' '/' '(' ')' idn + + \< '+' '-' + \< '*' '/' + + \\ + + e: e '+' e + | e '-' e + | e '*' e + | e '/' e + | idn + | '(' e ')' + +The two lines following the list of terminal symbols create two +levels of precedence in increasing order and assign those levels +to the terminal symbols appearing on those lines. The '\<' which +begins a new precedence level also indicates left-association. +One may also specify '\>' for right-association and '\2' +indicating that association is not permitted (is to be regarded +as a syntax error). This last feature may be used to prohibit +the misleading association of operators such as comparision +operators. + - 8 - + + +6. The Operation of YACC + +The operation of YACC is performed in five steps. First, the +input file is read and an internal representation of the grammar +is created. Second, certain auxiliary data structures are +constructed which contain information about the grammar which is +used by later steps. Third, the canonical LR(0) parser for the +grammar is constructed. Fourth, the LR(0) parser is analyzed by +computing and applying lookahead in order to resolve conflicts in +the LR(0) parser. Finally, a listing is written onto the OUTPUT +file containing the remaining conflicts in the parser, the +grammar, and the parser itself, and the tables are written onto +the TABLES file. + +6.1 Constructing the Canonical LR(0) Parser + +The canonical LR(0) parser for the grammar is constructed by the +following method: First, the grammar is augmented by adding a +production + + $accept: S -| + +where the symbol $accept is a distinguished nonterminal added by +YACC, S represents the starting symbol of the original grammar, +and -| represents the end-of-file symbol. Second, the initial +state of the parser is created containing the item + + $accept -> . S -| + +and its closure. The closure of a set of items I is defined to +be the smallest set of items C containing I such that if C +contains an item of the form + + A -> a . B b + +for some nonterminal B and strings a and b, then C contains all +items of the form + + B -> . w + +for string w. The final step in constructing the canonical LR(0) +parser consists of constructing the set of states accesible from +the initial state. The set of accesible states is defined to be +the smallest set of states containing the initial state such that +for each state i in S, if j is the successor state of i on some +symbol x, then j is in S. The successor state j of a state i on +a symbol x is constructed in two steps: First, for each item in +state i of the form + + A -> a . x b + +for nonterminal A and strings a and b, the item + + A -> a x . b + + - 9 - + + +is added to state j. Second, the closure of the set of items in +state j is added to state j. + +6.2 Applying Lookahead to the LR(0) Parser + +The constructed LR(0) parser will generally contain conflicts, +that is, states in which more than one action is valid for some +input symbol. An item of the form + + A -> a . + +is called a reduce item (reduction) since it indicates that the +entire right-hand-side of a rule has been recognized and can be +reduced to the left-hand-side. An item of the form + + A -> a . x b + +where x is a terminal symbol, is called a shift item since it +indicates that if x is the current input symbol, then it should +be shifted onto the stack and control passed to the x-successor +state, which will contain the item + + A -> a x . b + +If a state in the LR(0) parser contains a reduce item and one or +more shift items, or more than one reduce item, then the state +contains a conflict. Such conflicts may be resolved if it can be +determined that the reductions are valid only for certain input +symbols. In any state, if the sets of valid input symbols +("lookahead sets") for each reduction and the set of terminal +symbols for which successor states exist are disjoint, then there +is no conflict in that state, since the parser can determine by +looking at the current input symbol whether to shift or to +reduce, and what reduction to make. + +In YACC, the lookahead sets are computed one terminal symbol at a +time; that is, for each terminal symbol, it is determined which +reductions are applicable (contain that terminal symbol in their +lookahead set). Then, each state of the LR(0) parser is checked +for conflicts on that terminal symbol. If there are more than +one applicable reduction, then a reduce/reduce conflict is +announced. If there is a successor state on that terminal symbol +and one or more applicable reductions, then a shift/reduce +conflict is announced. diff --git a/c20/pcc20.c b/c20/pcc20.c new file mode 100644 index 00000000..0ae86ce0 --- /dev/null +++ b/c20/pcc20.c @@ -0,0 +1,593 @@ +# include +# include +# define FALSE 0 +# define TRUE 1 +/* + + TOPS-20 Portable C Compiler Command Routine + + + Compiler Options + + -c compile only, do not assemble + -g do not delete assembly language temp file + -k keep intermediate files + -f write errors to file instead of tty + -o run code optimizer + -r ring bell when done + + + p=xxx predefine symbol xxx (to be 1) + l=xxx look in directory xxx for include files + +*/ + +/* renamings to allow long names */ + +# define construct_output_file_names cnsofn +# define execute_phase execph +# define write_statistics wrstat +# define print_phase_time prphtm +# define process_options proopt +# define process_minus_option promin +# define process_equal_option proeq + +# define phase_name phsnm +# define phase_pname phspnm +# define phase_prog phspr +# define phase_argc phsac +# define phase_argv phsav +# define phase_option phsop +# define phase_et phset +# define phase_pt phspt + +# define argv_P avp +# define argv_C avc + +/* program file names */ + +/* where to look for executable image files */ +# define PREFIX "C:" + +/* extension of executable image files */ +# define SUFFIX ".exe" + +# define OBJDIR "" + +# define INTSUF "i" +# define OBJSUF "obj" +# define OPTSUF "mid" +# define RELSUF "rel" +# define ERRSUF "cerr" + +# define ASMFILE "sys:midas.exe" + +# define PHASEPRINT 1 + +# define file_name_size 100 + + +/* options */ + +int kflag, cflag, gflag, oflag, rflag, fflag; + +/* table for pre-defined symbols */ + +# define maxpds 10 +char *pdstab[maxpds + 1]; +char **pdsptr = {pdstab}; + +/* tables for #include default directories */ + +# define maxdirs 5 +char *dfdirs[maxdirs + 1]; +char **dfdptr = {dfdirs}; + +/* default search directories for # include <> */ + +# define n10dirs 2 +char *df10dirs[] = {"-IC:", "-ICLIB:"}; + + +/* phase information */ + +# define nphase 3 + +# define phase_P 0 +# define phase_C 1 +# define phase_O 2 + +# define extra maxpds + maxdirs + +char *argv_P[2 + extra]; +char *argv_C[4 + extra]; +char *argv_O[2]; + +char *phase_name[] = {"P","C","O"}; +char *phase_pname[] = {"cpp","pcc","opt"}; +char phase_prog[nphase][file_name_size]; +int phase_argc[] = {2, 3, 2}; +char **phase_argv[] = {argv_P, argv_C, argv_O}; +int phase_et[] = {0, 0, 0}; +int phase_pt[] = {0, 0, 0}; + +static char *pdp10_pdefs[] = {"-DPDP10=1", 0}; /* predefined symbols */ + +# define opsys_name "-DTOPS20=1" + +char *opsys = NULL; + +extern char *sconcat (); + +/********************************************************************** + + THE MAIN PROGRAM + +**********************************************************************/ + +main (argc, argv) +char *argv[]; +{ + extern FILE *stdout; + FILE *f; + int snum, cc, i, ttyflag; + cal start_time; + char *fargv[50], buffer[2000]; + char src_name[file_name_size], + int_name[file_name_size], + obj_name[file_name_size], + opt_name[file_name_size], + rel_name[file_name_size], + err_name[file_name_size]; + char *fptr; + char nambuf[2][file_name_size]; + char cmdbuf[100]; + + --argc; /* skip over program name */ + ++argv; + argc = process_options (argc, argv); + argc = exparg (argc, argv, fargv, buffer); + argv = fargv; + + pp_setup (); /* set up preprocessor arguments */ + + nambuf[0][0] = '<'; /* for re-directed input */ + nambuf[1][0] = '>'; /* for re-directed output */ + + for (snum = 0; snum < argc; ++snum) { + char name[file_name_size]; + + strcpy (src_name, argv[snum]); + + /* check that source file exists */ + + if ((f = fopen (src_name, "r")) == NULL) { + char ext[file_name_size]; + + fngtp (src_name, ext); + if (*ext == 0) { + fnsfd (src_name, src_name, 0, 0, 0, "c", 0, 0); + f = fopen (src_name, "r"); + } + if (f == NULL) { + printf ("Can't Find '%s'.\n", src_name); + continue; + } + } + fclose (f); + fngnm (src_name, name); /* get name part of file spec */ + for (fptr=name;*fptr!=0;fptr++) + *fptr = upperr(*fptr); + +#ifdef SHORTNAME + name[6] = 0; /* print only six chars to match macro */ +#endif + + now (&start_time); + + /* construct output file names from source file name */ + + construct_output_file_names (src_name, int_name, obj_name, + opt_name, rel_name, err_name); + + for (i = 0; i < nphase; ++i) phase_pt[i] = -1; + +#ifdef PHASEPRINT + printf ("CPP:\t%s\n",name); +#else + printf ("CC:\t%s\n",name); +#endif + fflush (stdout); + + argv_P[0] = src_name; /* name of source file */ + argv_P[1] = &nambuf[1][0]; /* >intname for redirected output */ + strcpy (&nambuf[1][1],int_name); /* get intname */ + cc = execute_phase (phase_P); /* reu preprocessor */ + if (!cc) { + +#ifdef PHASEPRINT + printf ("PCC:\t%s\n",name); + fflush (stdout); +#endif + + argv_C[0] = &nambuf[0][0]; /* input from int file */ + strcpy (&nambuf[0][1],int_name); + argv_C[1] = &nambuf[1][0]; /* output to obj file */ + strcpy (&nambuf[1][1],obj_name); + argv_C[2] = name; /* tell pcc the module name */ + if (fflag) { + cmdbuf[0] = '%'; + strcpy (cmdbuf + 1,err_name); + argv_C[3] = cmdbuf; + phase_argc[phase_C] = 4; + } + cc = execute_phase (phase_C); + } + if (!kflag) unlink (int_name); + + if (oflag) { + argv_O[0] = &nambuf[0][0]; + strcpy (&nambuf[0][1],obj_name); + argv_O[1] = &nambuf[1][0]; + strcpy (&nambuf[1][1],opt_name); +#ifdef PHASEPRINT + printf ("OPT:\t%s\n",name); + fflush(stdout); +#endif + cc = execute_phase (phase_O); + if (!kflag) unlink (obj_name); + } + else strcpy (opt_name, obj_name); + + stats(src_name, &start_time); + + if (cc) { + if (!gflag) unlink (opt_name); + } + else if (!cflag) { + +#ifdef PHASEPRINT + printf ("MIDAS:\t%s\n",name); + fflush(stdout); +#endif + + cc = assemble (opt_name, rel_name); + if (!cc && !gflag) unlink (opt_name); + } + if (rflag) { + putc ('\007', stdout); + fflush (stdout); + } + } + if (rflag) { + putc ('\007', stdout); + fflush (stdout); + } +} + +/********************************************************************** + + PROCESS_OPTIONS - Process options in command arguments + and remove options from argument list. + +**********************************************************************/ + +int process_options (argc, argv) +char *argv[]; +{ + char *s, **ss, **dd; + int n, opt; + + kflag = cflag = gflag = rflag = FALSE; + + dd = ss = argv; + n = 0; + while (--argc >= 0) { + s = *ss++; + if (s[0] == '-') process_minus_option (s + 1); + else if ((opt = s[0]) && s[1] == '=') + process_equal_option (opt, s + 2); + else { + *dd++ = s; + ++n; + } + } + return (n); +} + +/********************************************************************** + + PROCESS_MINUS_OPTION + +**********************************************************************/ + +process_minus_option (s) +char *s; +{ + int c; + + while (c = *s) { + *s++ = c = lower (c); + switch (c) { + case 'k': kflag = TRUE; break; + case 'c': cflag = TRUE; break; + case 'g': gflag = TRUE; break; + case 'o': oflag = TRUE; break; + case 'r': rflag = TRUE; break; + case 'f': fflag = TRUE; break; + default: printf ("Unrecognized option: -%c\n", c); + break; + } + } +} + +/********************************************************************** + + PROCESS_EQUAL_OPTION + +**********************************************************************/ + +process_equal_option (opt, s) +char *s; +{ + char *r; + int c; + + switch (opt = lower (opt)) { + case 'p': if (pdsptr < pdstab + maxpds) { + static char pdss[maxpds][20]; + r = &pdss[pdsptr - pdstab][0]; + *pdsptr++ = r; + sconcat (r, 3, "-D", s + 2, "=1"); + } + else printf ("Sorry, too many pre-defined symbols.\n"); + return; + + case 'l': if (dfdptr < dfdirs + maxdirs) { + *dfdptr++ = s; + s[0] = '-'; + s[1] = 'I'; + } + else printf ("Sorry, too many search directories.\n"); + return; + + default: printf ("Unrecognized option: %c=%s\n", opt, s); + } +} + +/********************************************************************** + + PP_SETUP + + Add pre-defined symbols and search directories to ARGV_P + +**********************************************************************/ + +pp_setup () +{ + char **p, *q; + + /* add defined search directories to preproc args */ + p = df10dirs; + while (p < df10dirs + n10dirs) add_arg (phase_P, *p++); + p = dfdirs; + while (p < dfdptr) add_arg (phase_P, *p++); + + /* add predefined symbols to preprocessor args */ + p = pdp10_pdefs; + add_arg (phase_P, *p); /* add system predefined symbols */ + if (q = opsys) { + if (strcmp (q, "-DTOPS20=1")) add_arg (phase_P, "-UTOPS20"); + add_arg (phase_P, q); + } + p = pdstab; /* add user predefined symbols */ + while (p < pdsptr) add_arg (phase_P, *p++); +} + +/********************************************************************** + + ADD_ARG - append an argument to the list for the given phase + +**********************************************************************/ + +add_arg (phs, arg) +char *arg; +{ + phase_argv[phs][phase_argc[phs]++] = arg; +} + +/********************************************************************** + + CONSTRUCT_OUTPUT_FILE_NAMES + + Construct assembler, relocatable, and symbol table listing + file names from source file name. + +**********************************************************************/ + +construct_output_file_names (src_name, int_name, obj_name, opt_name, rel_name, err_name) +char *src_name, *int_name, *obj_name, *opt_name, *rel_name, *err_name; +{ + char *relsuf; + + fnsfd (obj_name, src_name, "", OBJDIR, 0, OBJSUF, 0, 0); + fnsfd (opt_name, obj_name, 0, 0, 0, OPTSUF, 0, 0); + fnsfd (int_name, obj_name, 0, 0, 0, INTSUF, 0, 0); + fnsfd (rel_name, obj_name, 0, 0, 0, RELSUF, 0, 0); + fnsfd (err_name, obj_name, 0, 0, 0, ERRSUF, 0, 0); +} + +/********************************************************************** + + EXECUTE PHASE + +**********************************************************************/ + +execute_phase (n) +int n; +{ + extern int exctime, exccode; + int t; + + set_program_name (n); + t = etime (); + if (execv (phase_prog[n], phase_argc[n], phase_argv[n])) { + printf ("Unable to execute phase %s\n", phase_name[n]); + return (-1); + } + phase_et[n] = etime () - t; /* elapsed time */ + phase_pt[n] = exctime; /* runtime */ + return (exccode); +} + +/********************************************************************** + + SET_PROGRAM_NAME + + Construct the file name of program for the given phase. + +**********************************************************************/ + +set_program_name (n) +int n; +{ + char *r, *s; + + r = PREFIX; + s = SUFFIX; + sconcat (phase_prog[n], 4, r, phase_pname[n],".",s); +} + +/********************************************************************** + + STATS - write statistics to stat file + +**********************************************************************/ + +# define STATFILE1 "C:pcc20.stat" + + +stats (src_name, st) +char *src_name; +cal *st; +{ + FILE *f; + int flag, i; + char temp[50]; + + flag = TRUE; + f = fopen (STATFILE1, "a"); +# ifdef statfile2 + if (f == NULL) f = fopen (STATFILE2, "a"); +# endif + if (f == NULL) return; + putc ('\n', f); + strcpy (temp,username ()); + fprintf (f, "%s - ", temp); + prcal (st, f); + fprintf (f, " - "); + fngdr (src_name, temp); + if (temp[0]) { + slower (temp); + fprintf (f, "%s/", temp); + } + fngnm (src_name, temp); + slower (temp); + fprintf (f, "%s", temp); + +# define hack if (flag) {fprint (f, " ("); flag = FALSE;} else putc (' ', f) + + if (cflag || gflag || kflag) { + hack; + if (cflag) putc ('c', f); + if (gflag) putc ('g', f); + if (kflag) putc ('k', f); + } + if (!flag) putc (')', f); + + fprintf (f, "\n\n"); + for (i = 0; i < nphase; ++i) print_phase_time (i, f); + fclose (f); +} + +/********************************************************************** + + PRINT_PHASE_TIME - As Part Of Statistics + +**********************************************************************/ + +print_phase_time (n, f) +FILE *f; +{ + if (phase_pt[n] != -1) { + fprint (f, phase_name[n]); + if (!phase_name[n][1]) putc (' ', f); + fprint (f, " P="); + pr60th (phase_pt[n], f); + fprint (f, " E="); + pr60th (phase_et[n], f); + putc ('\n', f); + } +} + +/********************************************************************** + + ASSEMBLE - Create the relocatable file from the assembler file + + return TRUE iff an error occurred + +**********************************************************************/ + +int assemble (obj_name, rel_name) +char *obj_name, *rel_name; +{ +# ifdef TENEX + /* TENEX can't run MIDAS as an inferior -- sigh */ + fprint ("OUTPUT on %s\n", obj_name); + return (TRUE); +} +# else + + char *s, temp[100]; + FILE *f; + + /* construct Assembler command line */ + + strcpy (temp, rel_name); + strcat (temp, " _ "); + strcat (temp, obj_name); + strcat (temp, " (w)", s); + + /* execute Assembler */ + if (execs (ASMFILE, temp)) { + fprint (stderr,"Unable to Assemble.\n"); + return (TRUE); + } + + /* construct Assembler record file name */ + + fnsfd (temp, obj_name, 0, 0, 0, "err", 0, 0); + + /* examine Assembler record file */ + + f = fopen (temp, "r"); + if (f != NULL) { /* look for '-' + '\t' */ + register int c; + + while ((c = getc (f)) != EOF) { + if (c == '-') { + c = getc (f); + if (!isdigit (c)) continue; + while (isdigit (c)) c = getc (f); + if (c != '\t') continue; + fprint (stderr, "Assembler Errors.\n"); + fclose (f); + return (TRUE); + } + } + fclose (f); + unlink(temp); + } + return (FALSE); +} +# endif diff --git a/c20/pcc20.hlp b/c20/pcc20.hlp new file mode 100644 index 00000000..675354ad --- /dev/null +++ b/c20/pcc20.hlp @@ -0,0 +1,100 @@ +pcc info (2/82 -- cjt@mit-xx) + +This implementation of C for TOPS-20 is based on the Portable C Compiler +written by Steve Johnson of Bell Labs. The compiler is source compatible +with V7 C as described in the book by Kernighan and Ritchie -- in fact, +it is the same compiler as used for the VAX with a different code generation +phase, so programs that compile and run on the VAX should do so with little +change on the 20. + +The i/o system is moderately compatible with the "Standard I/O Library" +available under UNIX; see stdio.h. For most purposes, you can use the +standard i/o interface just as you would on UNIX. + +--- Compiling --- + +PCC20 is the C compiler command. Usage is + + pcc20 file1.c file2.c ... + +where the arguments are the path names of C source files which +are to be compiled. Each file will be compiled in turn, and if +the compilation is successful, the resulting relocatable file +will be placed in the file "file*.stk". Arguments beginning +with the '-' character are taken to be compiler options. +Available options include: + + -c compile only, do not assemble + -g do not delete MIDAS file + -n run the optimizer + +For example, the command + + pcc20 foo.c + +would compile the C program in the file "foo.c" in the current +directory, and place the resulting relocatable program in the +file "foo.stk". + +--- Loading --- + +Relocatable programs produced by the C compiler are loaded +together with the C support routines using the STINKR loader. +To load program files "foo", "bar", and "bletch" and produce a +runnable file "foo", type the following to STINKR: + + x ss:stdio + l foo + l bar + l bletch + o foo.exe + q + +The q terminates the terminal input file. These commands +(minus the 'q') could also be written in a file, say "foo.stinkr", +in which case one could invoke STINKR by saying + + stinkr foo + +and STINKR would read the commands from the command file. The +'x' command on the first line is another way of causing commands +to be read from a file, in this "ss:stdio.stinkr" which loads +the routines that implement the standard i/o functions. + +--- Installation --- + +There are 3 .exe files that must be installed where the system +can find them: + + pcc20.exe an executive that calls the preprocessor, compiler, + and assembler to process the specified files. + + midas.exe an assembler compatible with the compiler output + and the loader input. + + stinkr.exe a loader. + +PCC20 currently looks for the following files: + + ss: This is directory that gets search for system + header files (e.g., ). + + ss:cpp.exe The standard C preprocessor, see UNIX manual for + details. + + ss:pcc.exe The compiler, reads pre-processed C from its + standard input, writes assembly language to its + standard output. + + ss:opt.exe The optimizer, similar to C2 of the old Ritchie + compiler. It works on the assembly language + ouput, producing another assembly language file. + +Each assembly language intermediate file inserts: + + ps:cinsrt.mid + ps:mulseg.mid + +which contain various header sorts of info. To change the various +path names, you'll have to fix PCC20 and the correct piece of PCC +(code.c I think). diff --git a/c20/pcc20.stat b/c20/pcc20.stat new file mode 100644 index 00000000..d7516a17 --- /dev/null +++ b/c20/pcc20.stat @@ -0,0 +1,634 @@ + +BUDNE - Nov 10, 1983 14:01:29 - ytab + +P P= 1.05 E= 2.23 +C P= 6.21 E= 10.19 + +BUDNE - Nov 10, 1983 14:02:32 - ytab + +P P= 1.06 E= 2.44 +C P= 6.20 E= 11.08 +O P= 2.54 E= 4.29 + +BUDNE - Nov 10, 1983 14:11:55 - ytab + +P P= 1.06 E= 2.27 +C P= 6.18 E= 9.56 + +BUDNE - Nov 10, 1983 19:18:37 - ytab + +P P= 1.05 E= 2.22 +C P= 6.58 E= 16.41 + +BUDNE - Nov 10, 1983 19:19:31 - awklex + +P P= 2.11 E= 4.47 +C P= 20.00 E= 45.09 + +BUDNE - Nov 10, 1983 22:44:37 - ytab + +P P= 1.22 E= 6.56 +C P= 9.12 E= 39.43 + +BUDNE - Nov 10, 1983 23:32:42 - scan + +P P= 0.15 E= 3.53 +C P= 0.38 E= 7.24 + +BUDNE - Nov 10, 1983 23:36:06 - scan + +P P= 0.16 E= 2.54 +C P= 0.44 E= 7.10 + +BUDNE - Nov 10, 1983 23:37:36 - scan + +P P= 0.16 E= 6.01 +C P= 0.44 E= 11.38 + +BUDNE - Nov 14, 1983 23:03:41 - awkact + +P P= 0.40 E= 2.16 +C P= 1.12 E= 3.42 + +BUDNE - Nov 14, 1983 23:05:27 - awkact + +P P= 0.40 E= 2.07 +C P= 1.14 E= 3.26 + +BUDNE - Nov 14, 1983 23:09:07 - awkact + +P P= 0.40 E= 1.52 +C P= 1.45 E= 4.14 + +BUDNE - Nov 14, 1983 23:13:35 - bert + +P P= 0.14 E= 1.14 +C P= 0.35 E= 2.44 + +BUDNE - Nov 14, 1983 23:15:05 - bert + +P P= 0.14 E= 1.11 +C P= 0.35 E= 10.08 + +BUDNE - Nov 17, 1983 18:39:02 - awksym + +P P= 0.33 E= 1.49 +C P= 0.45 E= 4.24 + +BUDNE - Nov 17, 1983 18:40:12 - awksym + +P P= 0.33 E= 1.52 +C P= 0.46 E= 5.38 + +BUDNE - Nov 17, 1983 18:41:00 - awksym + +P P= 0.32 E= 1.43 +C P= 0.46 E= 4.32 + +BUDNE - Nov 17, 1983 18:41:37 - awksym + +P P= 0.32 E= 1.44 +C P= 0.44 E= 4.23 + +BUDNE - Nov 17, 1983 18:43:51 - awksym + +P P= 0.32 E= 1.44 +C P= 0.44 E= 5.32 + +BUDNE - Nov 17, 1983 18:44:43 - awksym + +P P= 0.32 E= 1.59 +C P= 0.44 E= 4.22 + +BUDNE - Nov 17, 1983 18:46:24 - awksym (g) + +P P= 0.32 E= 1.40 +C P= 0.45 E= 2.57 + +BUDNE - Nov 17, 1983 19:08:08 - awksym + +P P= 0.40 E= 5.15 +C P= 1.27 E= 6.13 + +BUDNE - Nov 17, 1983 19:12:46 - awksym + +P P= 0.39 E= 1.54 +C P= 1.23 E= 3.32 + +BUDNE - Nov 17, 1983 19:13:37 - awksym (g) + +P P= 0.40 E= 1.55 +C P= 1.30 E= 4.51 +O P= 0.32 E= 1.45 + +BUDNE - Nov 17, 1983 19:42:48 - awksym + +P P= 0.43 E= 2.02 +C P= 0.37 E= 2.39 + +BUDNE - Nov 17, 1983 19:45:30 - awksym + +P P= 0.43 E= 2.07 +C P= 0.36 E= 3.53 + +BUDNE - Nov 17, 1983 19:46:48 - awksym + +P P= 0.43 E= 1.56 +C P= 1.13 E= 3.40 + +BUDNE - Nov 17, 1983 19:47:46 - awksym + +P P= 0.43 E= 1.58 +C P= 1.44 E= 4.27 + +BUDNE - Nov 17, 1983 19:48:33 - awksym + +P P= 0.43 E= 1.54 +C P= 1.42 E= 4.11 + +BUDNE - Nov 21, 1983 01:38:30 - awkint + +P P= 0.41 E= 1.56 +C P= 1.07 E= 3.31 + +BUDNE - Dec 2, 1983 16:28:24 - awkint + +P P= 0.41 E= 1.59 +C P= 1.12 E= 4.13 + +BUDNE - Dec 2, 1983 16:31:14 - awkint + +P P= 0.44 E= 2.09 +C P= 1.15 E= 3.49 + +BUDNE - Dec 2, 1983 16:31:43 - awkint + +P P= 0.46 E= 4.10 +C P= 1.18 E= 4.27 + +BUDNE - Dec 2, 1983 17:22:23 - awkact + +P P= 0.59 E= 3.16 +C P= 2.55 E= 7.25 + +BUDNE - Dec 2, 1983 17:22:59 - awkint + +P P= 0.43 E= 2.00 +C P= 1.04 E= 3.22 + +BUDNE - Dec 9, 1983 00:10:25 - qqq + +P P= 0.14 E= 1.29 +C P= 0.38 E= 2.50 + +BUDNE - Dec 9, 1983 00:11:40 - qqq + +P P= 0.14 E= 1.13 +C P= 0.39 E= 2.47 + +BUDNE - Dec 9, 1983 00:13:27 - qqq + +P P= 0.15 E= 1.17 +C P= 0.40 E= 3.04 + +BUDNE - Dec 14, 1983 01:30:26 - awkint + +P P= 1.14 E= 2.38 +C P= 2.45 E= 5.28 + +BUDNE - Dec 14, 1983 01:34:15 - awkint + +P P= 1.14 E= 2.32 +C P= 2.46 E= 5.29 + +BUDNE - Dec 14, 1983 01:36:07 - awkint + +P P= 1.14 E= 2.39 +C P= 4.15 E= 7.16 + +BUDNE - Dec 14, 1983 01:37:39 - awkint + +P P= 1.14 E= 2.43 +C P= 4.43 E= 7.53 + +BUDNE - Dec 14, 1983 01:41:54 - awkint + +P P= 1.16 E= 2.41 +C P= 2.52 E= 6.07 + +BUDNE - Dec 14, 1983 01:42:23 - awkint + +P P= 1.19 E= 3.09 +C P= 2.58 E= 5.56 + +BUDNE - Dec 14, 1983 01:43:22 - awkint + +P P= 1.15 E= 2.39 +C P= 3.09 E= 6.04 + +BUDNE - Dec 14, 1983 01:44:08 - awkint + +P P= 1.15 E= 2.39 +C P= 3.11 E= 6.04 + +BUDNE - Dec 14, 1983 01:44:49 - awkint + +P P= 1.15 E= 2.37 +C P= 3.11 E= 6.09 + +BUDNE - Dec 14, 1983 01:45:30 - awkint + +P P= 1.15 E= 2.35 +C P= 3.12 E= 5.59 + +BUDNE - Dec 14, 1983 01:46:01 - awkint + +P P= 1.15 E= 2.58 +C P= 3.12 E= 6.12 + +BUDNE - Dec 14, 1983 01:47:15 - awkint + +P P= 1.15 E= 2.37 +C P= 4.41 E= 7.36 + +BUDNE - Dec 14, 1983 01:51:10 - awkint + +P P= 1.15 E= 2.37 +C P= 4.41 E= 7.29 + +BUDNE - Dec 14, 1983 01:53:21 - awkint + +P P= 1.16 E= 2.44 +C P= 4.46 E= 8.20 + +BUDNE - Dec 14, 1983 01:54:55 - awkint + +P P= 1.16 E= 2.44 +C P= 4.45 E= 7.50 + +BUDNE - Jan 19, 1984 11:24:23 - xlio + +P P= 0.43 E= 2.27 + +BUDNE - Jan 19, 1984 11:24:55 - xlio + +P P= 0.57 E= 3.06 +C P= 1.18 E= 3.47 + +BUDNE - Jan 19, 1984 11:25:45 - xlbind + +P P= 0.55 E= 2.21 +C P= 1.25 E= 4.18 + +BUDNE - Jan 19, 1984 11:26:44 - xldmem + +P P= 1.30 E= 3.52 +C P= 2.36 E= 6.16 + +BUDNE - Jan 19, 1984 11:28:53 - xlfio + +P P= 1.12 E= 2.40 +C P= 3.00 E= 6.03 + +BUDNE - Jan 19, 1984 11:30:15 - xlsubr + +P P= 1.43 E= 3.25 +C P= 5.18 E= 7.51 + +BUDNE - Jan 19, 1984 11:30:45 - xlstr + +P P= 1.16 E= 4.16 +C P= 3.07 E= 6.34 + +BUDNE - Jan 19, 1984 11:31:13 - xlread + +P P= 1.33 E= 3.35 +C P= 4.15 E= 9.50 + +BUDNE - Jan 19, 1984 11:31:51 - xlprin + +P P= 1.04 E= 2.59 +C P= 2.04 E= 5.11 + +BUDNE - Jan 19, 1984 11:32:27 - xlobj + +P P= 2.12 E= 4.00 +C P= 8.17 E= 14.43 + +BUDNE - Jan 19, 1984 11:33:42 - xlmath + +P P= 1.29 E= 3.26 +C P= 4.12 E= 7.42 + +BUDNE - Jan 19, 1984 11:34:18 - xllist + +P P= 1.46 E= 4.08 +C P= 5.43 E= 9.51 + +BUDNE - Jan 19, 1984 11:35:07 - xlkmap + +P P= 1.21 E= 4.31 +C P= 3.58 E= 8.05 + +BUDNE - Jan 19, 1984 11:36:20 - xlisp + +P P= 1.00 E= 2.30 + +BUDNE - Jan 19, 1984 11:36:47 - xleval + +P P= 1.26 E= 3.33 + +BUDNE - Jan 19, 1984 11:37:06 - xlbind + +P P= 0.57 E= 2.28 +C P= 1.30 E= 6.03 + +BUDNE - Jan 19, 1984 11:37:37 - xlfio + +P P= 1.13 E= 2.47 +C P= 2.58 E= 6.03 + +BUDNE - Jan 19, 1984 11:41:46 - xldmem + +P P= 1.32 E= 3.56 +C P= 2.37 E= 5.40 + +BUDNE - Jan 19, 1984 11:46:03 - xldmem + +P P= 1.28 E= 3.03 +C P= 2.41 E= 6.07 + +BUDNE - Jan 19, 1984 11:48:46 - xldmem + +P P= 1.33 E= 4.02 +C P= 4.26 E= 7.38 + +BUDNE - Jan 19, 1984 11:55:23 - xlprin + +P P= 1.05 E= 2.29 +C P= 2.09 E= 5.09 + +BUDNE - Jan 19, 1984 11:56:05 - xllist + +P P= 1.44 E= 3.15 +C P= 5.37 E= 9.45 + +BUDNE - Jan 19, 1984 11:56:39 - xlobj + +P P= 2.14 E= 5.12 +C P= 8.07 E= 16.04 + +BUDNE - Jan 19, 1984 11:59:27 - xleval + +P P= 1.24 E= 3.02 +C P= 3.09 E= 5.47 + +BUDNE - Jan 19, 1984 12:00:23 - xlisp + +P P= 1.02 E= 2.37 +C P= 1.15 E= 4.11 + +BUDNE - Jan 19, 1984 12:02:32 - xleval + +P P= 1.23 E= 2.56 +C P= 3.13 E= 6.42 + +BUDNE - Mar 1, 1984 19:18:06 - xl20 + +P P= 0.23 E= 2.53 +C P= 0.46 E= 5.06 + +BUDNE - Mar 6, 1984 17:09:58 - peep + +P P= 1.25 E= 6.24 +C P= 3.30 E= 19.52 + +BUDNE - Mar 6, 1984 17:13:42 - peep (c) + +P P= 1.27 E= 7.03 +C P= 3.46 E= 20.31 + +BUDNE - Mar 28, 1984 15:50:48 - vt52 + +P P= 0.22 E= 3.33 +C P= 1.11 E= 6.23 + +BUDNE - Mar 28, 1984 16:22:16 - savior + +P P= 0.52 E= 9.19 +C P= 3.05 E= 21.03 + +BUDNE - Mar 28, 1984 16:30:41 - savior + +P P= 0.46 E= 3.04 +C P= 2.29 E= 8.59 + +BUDNE - Mar 28, 1984 16:31:16 - savior + +P P= 0.45 E= 2.48 +C P= 3.05 E= 7.43 + +BUDNE - Mar 28, 1984 16:32:40 - savior + +P P= 0.46 E= 2.16 +C P= 3.02 E= 6.27 + +BUDNE - Mar 28, 1984 16:42:49 - savior + +P P= 0.48 E= 4.39 +C P= 3.08 E= 6.29 + +BUDNE - Mar 28, 1984 16:53:31 - savior + +P P= 0.45 E= 2.11 +C P= 3.08 E= 8.02 + +BUDNE - Mar 28, 1984 16:57:23 - savior + +P P= 0.44 E= 2.13 +C P= 3.14 E= 9.21 + +BUDNE - Mar 28, 1984 17:28:09 - savior + +P P= 0.51 E= 3.33 +C P= 3.22 E= 19.03 + +BUDNE - Mar 28, 1984 18:24:37 - savior + +P P= 0.52 E= 6.57 +C P= 3.52 E= 16.21 + +BUDNE - Mar 28, 1984 18:26:45 - savior + +P P= 0.50 E= 6.10 +C P= 3.47 E= 20.38 + +BUDNE - May 8, 1984 21:05:25 - game + +P P= 0.21 E= 2.44 +C P= 0.48 E= 7.02 + +BUDNE - May 8, 1984 21:16:06 - game + +P P= 0.26 E= 2.33 +C P= 0.52 E= 6.39 + +BUDNE - May 8, 1984 22:03:15 - game + +P P= 0.25 E= 2.43 +C P= 0.51 E= 8.17 + +BUDNE - May 8, 1984 23:10:52 - test + +P P= 0.38 E= 2.17 +C P= 1.02 E= 5.35 + +BUDNE - May 8, 1984 23:15:32 - test + +P P= 0.38 E= 3.53 +C P= 1.10 E= 6.18 + +BUDNE - May 8, 1984 23:20:25 - test + +P P= 0.37 E= 2.57 +C P= 1.16 E= 8.23 + +BUDNE - May 8, 1984 23:25:03 - test + +P P= 0.43 E= 4.09 +C P= 1.26 E= 9.03 + +BUDNE - May 8, 1984 23:26:34 - test + +P P= 0.40 E= 2.22 +C P= 1.25 E= 7.52 + +BUDNE - May 9, 1984 00:18:32 - test + +P P= 0.41 E= 3.43 +C P= 1.13 E= 9.32 + +BUDNE - May 9, 1984 00:38:26 - test + +P P= 0.41 E= 2.49 +C P= 1.02 E= 6.42 + +BUDNE - May 9, 1984 00:39:10 - test + +P P= 0.39 E= 2.48 +C P= 1.12 E= 7.09 + +BUDNE - May 9, 1984 00:43:04 - test + +P P= 0.43 E= 3.45 +C P= 1.15 E= 5.57 + +BUDNE - May 9, 1984 00:45:46 - test + +P P= 0.43 E= 3.09 +C P= 1.21 E= 8.38 + +BUDNE - May 12, 1984 20:32:39 - recio + +P P= 0.48 E= 3.02 +C P= 1.14 E= 8.57 + +BUDNE - May 12, 1984 20:35:07 - init + +P P= 0.27 E= 4.09 +C P= 1.04 E= 8.04 + +BUDNE - May 13, 1984 14:01:09 - init + +P P= 0.27 E= 2.25 +C P= 0.58 E= 9.08 + +BUDNE - May 13, 1984 14:49:55 - init + +P P= 0.35 E= 5.26 +C P= 1.27 E= 10.38 + +BUDNE - May 13, 1984 14:51:08 - init + +P P= 0.35 E= 2.21 +C P= 1.53 E= 11.20 + +BUDNE - May 15, 1984 22:10:13 - cdecl + +P P= 1.09 E= 8.00 +C P= 3.57 E= 16.43 + +BUDNE - Jun 22, 1984 16:13:02 - lib + +P P= 1.54 E= 8.26 +C P= 6.38 E= 36.23 + +BUDNE - Jun 22, 1984 16:15:46 - lib + +P P= 1.53 E= 6.36 +C P= 6.39 E= 24.36 + +BUDNE - Jun 22, 1984 16:26:25 - ytab + +P P= 3.13 E= 10.23 +C P= 16.59 E= 2:53.36 + +BUDNE - Jun 22, 1984 16:39:38 - ytab + +P P= 3.16 E= 14.33 +C P= 19.35 E= 1:42.45 + +BUDNE - Jun 22, 1984 16:43:44 - run + +P P= 2.25 E= 8.50 +C P= 7.08 E= 27.17 + +BUDNE - Jun 26, 1984 17:53:01 - ytab + +P P= 2.51 E= 9.20 +C P= 12.34 E= 1:41.08 + +BUDNE - Jun 28, 1984 13:43:24 - action + +P P= 2.18 E= 7.40 +C P= 7.58 E= 50.28 + +BUDNE - Jun 28, 1984 13:56:55 - error + +P P= 0.43 E= 10.57 +C P= 1.46 E= 13.15 + +BUDNE - Jun 28, 1984 14:07:08 - types + +P P= 1.10 E= 3.04 +C P= 2.11 E= 5.03 + +BUDNE - Jun 28, 1984 14:18:13 - action + +P P= 2.26 E= 8.43 +C P= 4.54 E= 17.35 + +BUDNE - Jun 28, 1984 14:20:19 - action + +P P= 2.18 E= 10.57 +C P= 4.23 E= 10.32 + +BUDNE - Jun 28, 1984 14:21:14 - action + +P P= 2.17 E= 6.20 +C P= 7.37 E= 13.42 + +MURPHY - Aug 14, 1984 13:06:37 - nums + +P P= 0.43 E= 4.29 +C P= 2.06 E= 11.21 + +MURPHY - Aug 14, 1984 16:42:36 - nums + +P P= 0.43 E= 4.25 +C P= 2.05 E= 8.10 + +BUDNE - Sep 5, 1984 20:15:57 - wild + +P P= 0.37 E= 4.06 +C P= 1.41 E= 8.23 diff --git a/c20/pcc20lib/-read-.-this- b/c20/pcc20lib/-read-.-this- new file mode 100644 index 00000000..cd954bae --- /dev/null +++ b/c20/pcc20lib/-read-.-this- @@ -0,0 +1,30 @@ +MRFORT::MSC: + +This directory contains the library needed to run C programs generated +by the 'new' C compiler (PCC20). + +If the output from the compiler is in STINKR format, then the directions +in PCC20.HLP & CC.HLP are correct; + +@stinkr +=x clib:stdio +=l myfile +=l alsomyfile +=o myfile.exe +=q + +If your output files were produced in REL format use LINK or SLINK + +@LINK +*/NOLOC MYFILE.STK.... +*CLIB:CLIB.REL/SEA +*/G + +** important ** + +If your program does not use 'standard' or 'portable' I/O, you may +have to load the start module (C20RUN) by hand before the search. + +-Phil Budne; April 7, 83 + +To create CLIB.REL, you must DO CLIB.MIC diff --git a/c20/pcc20lib/ac.broken b/c20/pcc20lib/ac.broken new file mode 100644 index 00000000..38124714 --- /dev/null +++ b/c20/pcc20lib/ac.broken @@ -0,0 +1,268 @@ +# +/* + + AC - Array of Characters Cluster + + operations: + + ac_new () => ac create empty array + ac_alloc (size) => ac create empty array, preferred size + ac_create (string) => ac create with initial value + ac_xh (ac, c) => c extend array with character + ac_trim (ac) => ac trim excess storage + ac_fetch (ac, i) => c fetch character from array + ac_link (ac) => ac make new link to array + ac_unlink (ac) remove link to array + ac_puts (ac, f) print array + ac_cat (ac, ac) => ac concatenate arrays + ac_copy (ac) => ac copy array + ac_unlink_string (ac) => ac remove link to string version + ac_string (ac) => *char return string version + ac_size (ac) => size return current size of array + ac_flush (ac) make array empty + ac_n () => int return # of active arrays + +*/ + +struct rep { + int count; /* reference count */ + char *s; /* pointer to actual array */ + int csize; /* logical size of array */ + int msize; /* physical size of array (at least csize+1) */ + }; + +# define ac struct rep* /* watch usage! */ +# define ASIZE 4 /* number of words in rep */ +# define initial_size 8 /* default initial allocation */ + +# define ac_unlink_string acunlstr + +# ifdef TOPS20 +# rename crealloc "ZREALL" /* really same as realloc on 20's */ +# endif + +char *calloc (); +int *salloc (); +char *crealloc (); +ac ac_new(); +ac ac_alloc(); +ac ac_create(); +ac ac_link(); +ac ac_cat(); +ac ac_copy(); + +static int count; + +/********************************************************************** + + AC_NEW - Create empty array. + AC_ALLOC - Create empty array, preferred size given. + +**********************************************************************/ + +ac ac_new () + + {return (ac_alloc (initial_size));} + +ac ac_alloc (sz) + register int sz; + + {register ac a; + + if (sz < 0) sz = 0; + a = salloc (ASIZE); + a->count = 1; + a->csize = 0; + a->s = calloc (a->msize = ++sz); + ++count; + return (a); + } + +/********************************************************************** + + AC_CREATE - Create array with initial value. + +**********************************************************************/ + +ac ac_create (s) + register char *s; + + {register int sz; + register ac a; + + sz = slen (s); + a = ac_alloc (sz); + a->csjhRz + + 4TAeeCt yHQCK<9R3W2yEPNratinn7!Q CK}Y=hPRuh8DD'K.:2P2o'Jrray!;aYY_Dz?JRuh8DGK2P2vw'Jray,',\lreKHN=>Y"x|Yp{#94w3*krc crfLTiiPA]m=9XA[=9#EFP0q*J> c _L]dACel({iP8csize >= a->msize - 1) + {if (a->s) + {if (a->msize >= 1000) a->msize += 500; + else a->msize *= 2; + a->s = crealloc (a->s, a->msize); + } + else a->s = calloc (a->msize *= 2); + } + a->s[a->csize++] = c; + return (c); + } + +/********************************************************************** + + AC_TRIM - Discard excess storage. + +**********************************************************************/ + +ac ac_trim (a) + register ac a; + + {if (a->csize < a->msize - 1) + a->s = crealloc (a->s, a->msize = a->csize + 1); + return (a); + } + +/********************************************************************** + + AC_FETCH - Fetch Character from Array. + +**********************************************************************/ + +char ac_fetch (a, n) + register ac a; + register int n; + + {extern int cerr; + if (n < 0 || n >= a->csize) + {cprint (cerr, "Character array bounds error."); + return (0); + } + return (a->s[n]); + } + +/********************************************************************** + + AC_LINK - Create link to array. + +**********************************************************************/ + +ac ac_link (a) ac a; + + {++a->count; + return (a); + } + +/********************************************************************** + + AC_UNLINK - Remove link to array. + +**********************************************************************/ + +ac_unlink (a) + register ac a; + + {if (--a->count == 0) + {if (a->s) cfree (a->s); + --count; + sfree (a); + } + } + +/********************************************************************** + + AC_PUTS - Print array. + +**********************************************************************/ + +ac_puts (a, f, wid) + register ac a; + /* 3 args for cprint usage */ + + {register char *p; + register int i; + + p = a->s; + i = a->csize; + while (--i >= 0) cputc (*p++, f); + } + +/********************************************************************** + + AC_CAT - Concatenate arrays. + +**********************************************************************/ + +ac ac_cat (a1, a2) + register ac a1; + register ac a2; + + {register ac a; + register int i; + + a = ac_alloc (i = a1->csize + a2->csize); + a->csize = i; + cmove (a1->s, a->s, a1->csize); + cmove (a2->s,&N2F->cso,Tg BZ}^=>Y(Z@E$"B"}w# +_9TFHHO^f (a+m^=e@|zF +AB5{2Q-u+FEHN.ge a->^=, Tz@g1"B"B5{H(1{3fqP0+wb->mso,U1 +qQB"9Yg' /\PfwqPbkvoze *:%1 +z!8+/g75x|z}1-.uP1]FO/'rn (b1Q!}uJJJTT))*JJ)))RU*RRRR*****%%%%*TTTU%JJJTT))*JJ)))RU*PhPh a = ac_alloc (a1->csize); + cmove (a1->s, a->s, a->csize = a1->csize); + return (a); + } + +/********************************************************************** + + AC_STRING - Return string version of array. The returned + string is valid only while the array remains linked + to and unchanged. + +**********************************************************************/ + +char *ac_string (a) + register ac a; + + {a->s[a->csize] = 0; + return (a->s); + } + +/********************************************************************** + + AC_UNLINK_STRING - Remove link to string version of array. + +**********************************************************************/ + +ac ac_unlink_string (a) ac a; + + {return (a); + } + +/********************************************************************** + + AC_SIZE - Return current size of array. + +**********************************************************************/ + +int ac_size (a) + ac a; + + {return (a->csize);} + +/********************************************************************** + + AC_FLUSH - Make array empty + +**********************************************************************/ + +ac_flush (a) + ac a; + + {a->csize = 0;} + +/********************************************************************** + + AC_N - Return number of active arrays. + +**********************************************************************/ + +int ac_n () + + {return (count);} diff --git a/c20/pcc20lib/ac.c b/c20/pcc20lib/ac.c new file mode 100644 index 00000000..86398bb9 --- /dev/null +++ b/c20/pcc20lib/ac.c @@ -0,0 +1,275 @@ +# +/* + + AC - Array of Characters Cluster + + operations: + + ac_new () => ac create empty array + ac_alloc (size) => ac create empty array, preferred size + ac_create (string) => ac create with initial value + ac_xh (ac, c) => c extend array with character + ac_trim (ac) => ac trim excess storage + ac_fetch (ac, i) => c fetch character from array + ac_link (ac) => ac make new link to array + ac_unlink (ac) remove link to array + ac_puts (ac, f) print array + ac_cat (ac, ac) => ac concatenate arrays + ac_copy (ac) => ac copy array + ac_unlink_string (ac) => ac remove link to string version + ac_string (ac) => *char return string version + ac_size (ac) => size return current size of array + ac_flush (ac) make array empty + ac_n () => int return # of active arrays + +*/ + +struct rep { + int count; /* reference count */ + char *s; /* pointer to actual array */ + int csize; /* logical size of array */ + int msize; /* physical size of array (at least csize+1) */ + }; + +# define ac struct rep* /* watch usage! */ +# define ASIZE 4 /* number of words in rep */ +# define initial_size 8 /* default initial allocation */ + +# define ac_unlink_string acunlstr + +# ifdef TOPS20 +# rename crealloc "ZREALL" /* really same as realloc on 20's */ +# endif + +char *calloc (); +int *salloc (); +char *crealloc (); +ac ac_new(); +ac ac_alloc(); +ac ac_create(); +ac ac_link(); +ac ac_cat(); +ac ac_copy(); + +static int count; + +/********************************************************************** + + AC_NEW - Create empty array. + AC_ALLOC - Create empty array, preferred size given. + +**********************************************************************/ + +ac ac_new () + + {return (ac_alloc (initial_size));} + +ac ac_alloc (sz) + register int sz; + + {register ac a; + + if (sz < 0) sz = 0; + a = salloc (ASIZE); + a->count = 1; + a->csize = 0; + a->s = calloc (a->msize = ++sz); + ++count; + return (a); + } + +/********************************************************************** + + AC_CREATE - Create array with initial value. + +**********************************************************************/ + +ac ac_create (s) + register char *s; + + {register int sz; + register ac a; + + sz = slen (s); + a = ac_alloc (sz); + a->csize = sz; + cmove (s, a->s, sz); + return (a); + } + +/********************************************************************** + + AC_XH - Extend Array with Character. + +**********************************************************************/ + +char ac_xh (a, c) + register ac a; + + {if (a->csize >= a->msize - 1) + {if (a->s) + {if (a->msize >= 1000) a->msize += 500; + else a->msize *= 2; + a->s = crealloc (a->s, a->msize); + } + else a->s = calloc (a->msize *= 2); + } + a->s[a->csize++] = c; + return (c); + } + +/********************************************************************** + + AC_TRIM - Discard excess storage. + +**********************************************************************/ + +ac ac_trim (a) + register ac a; + + {if (a->csize < a->msize - 1) + a->s = crealloc (a->s, a->msize = a->csize + 1); + return (a); + } + +/********************************************************************** + + AC_FETCH - Fetch Character from Array. + +**********************************************************************/ + +char ac_fetch (a, n) + register ac a; + register int n; + + {extern int cerr; + if (n < 0 || n >= a->csize) + {cprint (cerr, "Character array bounds error."); + return (0); + } + return (a->s[n]); + } + +/********************************************************************** + + AC_LINK - Create link to array. + +**********************************************************************/ + +ac ac_link (a) ac a; + + {++a->count; + return (a); + } + +/********************************************************************** + + AC_UNLINK - Remove link to array. + +**********************************************************************/ + +ac_unlink (a) + register ac a; + + {if (--a->count == 0) + {if (a->s) cfree (a->s); + --count; + sfree (a); + } + } + +/********************************************************************** + + AC_PUTS - Print array. + +**********************************************************************/ + +ac_puts (a, f, wid) + register ac a; + /* 3 args for cprint usage */ + + {register char *p; + register int i; + + p = a->s; + i = a->csize; + while (--i >= 0) cputc (*p++, f); + } + +/********************************************************************** + + AC_CAT - Concatenate arrays. + +**********************************************************************/ + +ac ac_cat (a1, a2) + register ac a1; + register ac a2; + + {register ac a; + register int i; + + a = ac_alloc (i = a1->csize + a2->csize); + a->csize = i; + cmove (a1->s, a->s, a1->csize); + cmove (a2->s, a->s + a1->csize, a2->csize); + return (a); + } + +/********************************************************************** + + AC_STRING - Return string version of array. The returned + string is valid only while the array remains linked + to and unchanged. + +**********************************************************************/ + +char *ac_string (a) + register ac a; + + {a->s[a->csize] = 0; + return (a->s); + } + +/********************************************************************** + + AC_UNLINK_STRING - Remove link to string version of array. + +**********************************************************************/ + +ac ac_unlink_string (a) ac a; + + {return (a); + } + +/********************************************************************** + + AC_SIZE - Return current size of array. + +**********************************************************************/ + +int ac_size (a) + ac a; + + {return (a->csize);} + +/********************************************************************** + + AC_FLUSH - Make array empty + +**********************************************************************/ + +ac_flush (a) + ac a; + + {a->csize = 0;} + +/********************************************************************** + + AC_N - Return number of active arrays. + +**********************************************************************/ + +int ac_n () + + {return (count);} diff --git a/c20/pcc20lib/all.ctl b/c20/pcc20lib/all.ctl new file mode 100644 index 00000000..583d73ef --- /dev/null +++ b/c20/pcc20lib/all.ctl @@ -0,0 +1,23 @@ +DEF PS: PS:,F: +PCC20 AC.C +!PCC20 ALLOC.C +!PCC20 APFNAM.C +!PCC20 ATOI.C +!PCC20 C20DAT.C +PCC20 C20EXC.C +!PCC20 C20EXP.C +!PCC20 C20FD.C +!PCC20 C20FIL.C +PCC20 C20FNM.C +;!PCC20 C20HAK.C +!PCC20 C20INT.C +PCC20 C20IO.C +PCC20 C20STD.C +!PCC20 C20TTY.C +!PCC20 CPRINT.C +PCC20 CTYPE.C +!PCC20 DATE.C +!PCC20 FPRINT.C +!PCC20 PR60TH.C +!PCC20 SCANF.C +!PCC20 STRINGP.C diff --git a/c20/pcc20lib/all.log b/c20/pcc20lib/all.log new file mode 100644 index 0000000000000000000000000000000000000000..dfedb538456af760fd813807d14d659a9284f808 GIT binary patch literal 7470 zcmcgxZF8bX5Z7=1k+sz;C3YNn1@@fd*AkwkQ3J#w{5=4)>Am-h*OObgYg)l*bM%OnqL1Ph)}+0IWL) z#=NI}M{Lpnb?ixaO<@oRofyiHZTU122+=sqHxrdz>x_f6u?U0d}!kMYn=$!`G z%cT=w+?kD-*o=F|<%@O@IhFTu( z!dzb7*}lC* zr?HSp0-Srxy}f0bTDbnoIzS0%q440WGa4bSZ>AnW4`Wn7ULM30j z$2A~{ohl6c$0BLg!ydX=9-d#S0(YbCd<_0Y{3SEu!a+L+Xpu99;6}o;uLX}FE zgC|p~7?r2>#lDi`a+Rej62Sf{?s6V6AXh0_g{X?m3G1gZ@JgsvN|r)ftw+38DujxB zJX)$yNv{QqwW?OqYr&GOcKKqEEiQHtY}W41arf9}IlhhC5tjc2Xl?a$opv-qWnC!k z5@$oBH=&(kM-$n$B6fniW<8HJ9i_$+p;**7y{5+4g${aFYL2}^vSp#>>Gi=}|H2xo zj+W{PVd8PNUh~PHC9}AnLO3R*Je(+S3HlT8Iw&EQ=b7G=WO~yQk0OK@_os-L3vK+O zGfIC~6LG&A?=oZhx$6V{!$E4D?rErXdd*pnaJNoxOKk4^^+!Anc$-KK{TUieYF#aT zB)xmp`;-F8teW6c@i>bl-PO`1kc~5kPmya0 zT&7ja%C)GLAR1fq^3LG~_RvsQN8_t!WwgvHUl}d4x>rYgc}2%4u;O~iq0ux^yn?4k zG)7T~a8v_Pz@1)noD=VGPg7o#SUQ>lz4=3QUu4Qw>-IxKhL)?HbTq zE~76E}iJBCH^=582RSSe`hLv A$^ZZW literal 0 HcmV?d00001 diff --git a/c20/pcc20lib/alloc.c b/c20/pcc20lib/alloc.c new file mode 100644 index 00000000..5c2559a7 --- /dev/null +++ b/c20/pcc20lib/alloc.c @@ -0,0 +1,797 @@ +# include + +/************************************************************************ + + ALLOC - C Dynamic Storage Management Package + + This package implements allocation and freeing of variable sized blocks + of free storage. A modified buddy system is used, with provision for + allocating page sized units on page boundaries so that page mapping may + be done. + + p = calloc (n) allocates a block n chars long + p = salloc (n) allocates a block n "sizeof's" long + (e.g., salloc (sizeof (foo))) + sfree (p) returns blocks to storage + cfree (p) + + q = realloc (p, n) returns a pointer to a block of size n + with q[0] == p[0] ... p[k] == q[k], + where k = min (n, length (p)) (p is a + previously allocated block) q == p if + n <= length (p) + q = crealloc (p, n) same for char's instead of int's (sizeof's) + + n = pg_size () returns the size of a page + p = pg_get (n) returns the address of a newly allocated block + of pages + pg_ret (p) frees a previously allocated block of pages + + nwfree = alocstat (&nwalloc, &nbfree); + returns statistics + n = alocflush () flushes pages not in use; returns number + of words saved + + + Additionally, a global variable, nocore, is provided, which + contains (a pointer to) the procedure to invoke when memory runs + out (this could trigger garbage collection, if the user programs + it). The normal function is to print a message and halt. + + Theory of operation: + + Sizes less than a page long are treated separately from larger + sizes. One reason is that in order to support page mapping, + information concerning allocated blocks of page size and larger is kept + in a separate array. On the other hand, there are potentially much too + many small objects to do that, so one word of each object keeps the + necessary size and link information. + We modify the basic buddy system by allocating blocks of size + halfway between powers of two as well as the usual powers of two. This + should result in less external fragmentation than the powers-of-two + buddy system, with no ill effects. A block that is a power of two in + size may be split in the ratios 3:1 or 2:2, and one that is a multiple + of 6 in size may be split 4:2 or 3:3. + For sizes less than a page, a header word is used to store + information necessary for putting blocks back together, etc. This + includes a code indicating the size of the block, whether it is the + left or right member of a pair, and the ratio of the sizes of the + members of the pair. In addition it is necessary for the right member + to save the old values of the flags for the left member (i.e., the + values before the pair was split). Here is the encoding of the header + words for blocks less than a page in size; the numbers in parentheses + indicate the widths of the fields, in bits: + + magic (18), unused (5), free (1), oflags (3), flags (3), size (6) + + The size is actually an index into a table of standard sizes; there are + 19 of them. The flags are encoded as three separate bits: + + even split: 1 <=> ratio was 1:1 + right sibling: 1 <=> this is a right hand member of a pair + (i.e., the one with the higher address) + parent-power-of-two: 1 <=> size of parent block was power of 2 + + The free flag indicates whether the block is free or not. The magic + number value is the address of the block XORed with a magic number; it + is checked in the freeing routines, for consistency. + + Free blocks are doubly linked, using the second word. The forward link + is in the right half, and the back link in the left half. + + Blocks a page or more in size do not have the information stored + directly in the block, but in a separate array, so the whole block can + be used for page mapping. Here is the layout of bits for them: + + prev page (9), next page (9), unused (4), + exists (1), free (1), oflags (3), flags (3), size (6) + + The exists bit is used only on ITS, to know whether the page actually + exists, or must be created with a CORBLK call. + +************************************************************************/ + +/* Page size and shift amount for each system */ + +# ifdef ITS +# define PGSIZE 1024 +# define PGLOG2 10 +# define NSIZES 18 +# else +# define PGSIZE 512 +# define PGLOG2 9 +# define NSIZES 16 +# endif + +# define NPAGES (01000000 / PGSIZE) + +# define TSIZES 34 +# define BADSIZ (NSIZES + 1) + +/* Masks and shift amounts for usual header flags */ + +# define SIZMSK 077 +# define _RIGHT 0100 +# define _EVEN 0200 +# define _PP2 0400 +# define FLGMSK 0700 +# define FSHIFT 6 +# define OFLGMSK 07000 +# define OFSHIFT 3 +# define ISFREE 010000 +# define MAGIC 0732561 +# define MMASK halves (0777777, 0) +# define MSHIFT 18 +# define LMASK halves (0777777, 0) +# define RMASK 0777777 + +/* extra masks and shifts for blocks of page size and up */ + +# define PPREVMSK halves (0777000, 0) +# define PNEXTMSK halves (0000777, 0) +# define PNSHIFT 18 +# define PPSHIFT 27 +# define PEXISTS 020000 + +static unsigned blksiz[] { + 2, 3, 4, 6, 8, 12, 16, + 24, 32, 48, 64, 96, 128, 192, +# ifdef ITS + 256, 384, 512, 768, 1024, 0, 2048, +# else + 256, 384, 512, 0, 1024, 1536, 2048, +# endif + 3072, 4096, 6144, 8192, 12288, 16384, 24576, + 32768, 49152, 65536, 98304, 131072, 196608 }; + +static unsigned free_blks[TSIZES]; +static unsigned page_info[NPAGES]; + +/* this table is for quick size lookup */ + +static int iblksiz[] { + 0, 0, 1, 2, 3, 3, 4, 4, 5, 5, 5, 5, 6, 6, 6, 6, + 7, 7, 7, 7, 7, 7, 7, 7, 8, 8, 8, 8, 8, 8, 8, 8, + 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, 9, + 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, 10, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, 11, + 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, + 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12, 12 }; + +/* avoid name conflicts */ + +# rename ainit "AINIT" +# rename alose "ALOSE" +# rename alloc "IALLOC" +# rename palloc "PALLOC" +# rename split "SPLIT" +# rename psplit "PSPLIT" +# rename free "FREE" +# rename pfree "PFREE" +# rename prealloc "PREALC" +# rename scan_page "SCNPAG" +# rename expunge_pages "EXPPGS" + +# ifdef ITS +# rename check_its_page "CITSPG" +# rename get_its_pages "GITSPG" +# rename create_its_pages "CRIPGS" +# endif + +/* forward references */ + +extern int *split(), psplit(), *palloc(); + +# ifdef ITS +extern int check_its_page(), get_its_pages(), create_its_pages(); +# endif + +# rename lowlim "LOWLIM" +# rename highlim "HILIM" + +extern int lowlim, highlim; + +ainit () + + {register int i, n, p; + sfill (free_blks, 0, TSIZES); + sfill (page_info, 0, NPAGES); + p = lowlim; + n = highlim - lowlim; + i = TSIZES - 1; + while (n > 0) + {register unsigned num; + while ((num = blksiz[i] >> PGLOG2) > n || num == 0) --i; + page_info[p] = ISFREE | i; + free_blks[i] = p; + p += num; + n -= num; + } + } + +alose (s) + char *s; + +# ifdef ITS + {int p, buf[100]; + register char c; + p = halves (0440700, p = buf); + idpb ('\r', &p); + idpb ('\n', &p); + idpb (':', &p); + idpb ('\033', &p); + while (c = *s++) idpb (c, &p); + idpb ('\033', &p); + idpb (0, &p); + while (TRUE) val7ret (buf); + } +# else + {register int p; + p = halves (0444400, p = s); + while (TRUE) + {SYSPSOUT (p); + _HALTF (); + } + } +# endif + +int *alloc (n) + register int n; + + {register int s, ns, w, *p, *q; + /* eliminate bad arguments */ + if (n <= 0 || n > blksiz[TSIZES-1]) return (0); + /* find block size, quickly */ + for (s = 0; n > 128; n = (n + 63) / 64) s += 12; + s += iblksiz[--n]; + if (s >= NSIZES) /* handle page size and up */ + {if (blksiz[s] == 0) ++s; + if (p = palloc (s, TRUE)) + *p = (((n = p) ^ MAGIC) << MSHIFT) | s; + return (p); + } + ns = s; + while (!(p = free_blks[ns])) + if (++ns >= NSIZES) + {/* get a page and put it on the special free list */ + if (!(p = palloc (NSIZES, TRUE))) return (0); + n = p; + *p = ((n ^ MAGIC) << MSHIFT) | ISFREE | NSIZES + | (page_info[n >> PGLOG2] & (OFLGMSK | FLGMSK)); + p[1] = 0; + goto skip; + } + if (q = free_blks[ns] = (p[1] & RMASK)) q[1] &= RMASK; +skip: while (TRUE) /* split down as far as necessary ... */ + switch (ns - s) + { + + case 0: *p &= ~ISFREE; + return (p); + + case 1: if (ns > 2) + {/* 3:1 or 2:1 split */ + --ns; + split (p, ns, (ns - 2) - (ns & 1), TRUE); + continue; + } + ns = s; /* special case: can't split */ + continue; + + even: + case 2: ns -= 2; + split (p, ns, ns, TRUE); + continue; + + case 3: if (!(ns & 1)) goto even; + default: + --ns; + p = split (p, ns, (w = (ns - 2) - (ns & 1)), FALSE); + ns = w; + continue; + + } + } + +int *split (p, s1, s2, first) + register int *p; + + {/* split p into two blocks with size codes s1 and s2, returning + first one if first is TRUE, otherwise second one. Block not + returned is put on correct free list. Note: s1 >= s2. */ + + register int s, x, w, n, *q, *qq, *q2; + q2 = p + blksiz[s1]; + x = 0; + if (s1 == s2) x |= _EVEN; + if (!((w = *p) & 1)) x |= _PP2; + n = q2; + *q2 = ((n ^ MAGIC) << MSHIFT) | ISFREE | ((w & FLGMSK) << OFSHIFT) + | x | _RIGHT | s2; + *p = (w & ~(FLGMSK | SIZMSK)) | x | s1; + if (first) q = q2; + else {q = p; + p = q2; + } + s = (*q) & SIZMSK; + if (qq = q[1] = free_blks[s]) qq[1] |= ((n = q) << 18); + free_blks[s] = q; + return (p); + } + +# rename all_gone "ALLGON" + +all_gone () {alose ("FREE STORAGE EXHAUSTED");} + +int (*nocore)() {all_gone}; + +int *palloc (s, must_exist) + + {register int ns, v, w; + ns = s; + while (!(v = free_blks[ns])) + if (++ns >= TSIZES) + {(*nocore)(); + return (0); + } + if (free_blks[ns] = w = ((page_info[v] & PNEXTMSK) >> PNSHIFT)) + page_info[w] &= ~PPREVMSK; + while (TRUE) /* split down as far as necessary ... */ + switch (ns - s) + { + + case 0: page_info[v] &= ~(ISFREE | PPREVMSK | PNEXTMSK); +# ifdef ITS + if (must_exist) get_its_pages (v, blksiz[s] >> PGLOG2); +# endif + return (v << PGLOG2); + + case 1: --ns; /* 3:1 or 2:1 split */ + psplit (v, ns, (ns - 2) - (ns & 1), TRUE); + continue; + + even: /* even split */ + case 2: ns -= 2; + psplit (v, ns, ns, TRUE); + continue; + + case 3: if (!(ns & 1)) goto even; + default: /* 3:1 or 2:1 split */ + --ns; + v = psplit (v, ns, (w = (ns - 2) - (ns & 1)), FALSE); + ns = w; + continue; + + } + } + +int psplit (v, s1, s2, first) + + {/* split v into two blocks with size codes s1 and s2, returning + first one if first is TRUE, otherwise second one. Block not + returned is put on correct free list. Note: s1 >= s2. */ + + register int s, x, w, ww, w2; + w2 = v + (blksiz[s1] >> PGLOG2); + x = 0; + if (s1 == s2) x |= _EVEN; + if (!((ww = page_info[v]) & 1)) x |= _PP2; + page_info[w2] = +# ifdef ITS + (page_info[w2] & PEXISTS) | +# endif + ((ww & FLGMSK) << OFSHIFT) | ISFREE | x | _RIGHT | s2; + page_info[v] = (ww & (OFLGMSK | PEXISTS)) | ISFREE | x | s1; + if (first) w = w2; + else {w = v; + v = w2; + } + s = page_info[w] & SIZMSK; + if (ww = free_blks[s]) + {page_info[ww] |= (w << PPSHIFT); + page_info[w] |= (ww << PNSHIFT); + } + free_blks[s] = w; + return (v); + } + +free (p) + register int *p; + + {register int n; + register unsigned w, ww; + if ((w = *p) & ISFREE) + alose ("FREE: BLOCK ALREADY FREE"); + if (((w >> MSHIFT) ^ (n = p)) != MAGIC) + alose ("FREE: BAD BLOCK HEADER"); + *p |= ISFREE; + while (TRUE) + {int bs, s, *q; + if ((s = (w & SIZMSK)) >= NSIZES) /* page or bigger ? */ + {pfree (p, FALSE); + return; + } + + if (w & _RIGHT) /* find buddy */ + {if (w & _EVEN) bs = s; + else if (w & _PP2) bs = s + 3; + else bs = s + 2; + q = p - blksiz[bs]; + } + else {q = p + blksiz[s]; + if (w & _EVEN) bs = s; + else bs = (s - 2) - (s & 1); + } + + /* to merge, buddy must be free and right size */ + if (((ww = *q) & ISFREE) && ((ww & SIZMSK) == bs)) + {register int *qq, *prev; + + ww = q[1]; + q[1] = 0; + if (qq = (ww & RMASK)) + {qq[1] &= RMASK; + qq[1] |= (ww & LMASK); + } + if (prev = (ww >> 18)) + {prev[1] &= LMASK; + prev[1] |= (n = qq); + } + else free_blks[bs] = qq; + + if (w & _RIGHT) /* swap so p is first */ + {qq = p; p = q; q = qq; + s = bs; + w = *p; + } + + if (w & _EVEN) bs = s + 2; /* new size, etc. */ + else bs = s + 1; + *p = w = (w & (LMASK | OFLGMSK)) | ISFREE | bs + | (((*q) & OFLGMSK) >> OFSHIFT); + } + else {if (q = p[1] = free_blks[s]) q[1] |= ((n = p) << 18); + free_blks[s] = p; + return; + } + } + } + +pfree (p, unmap) + int *p; + + {register int m, w, s; + if ((m = p) & (PGSIZE - 1)) + alose ("PFREE: NOT ON A PAGE BOUNDARY"); + if ((w = page_info[m >>= PGLOG2]) & ISFREE) + alose ("PFREE: BLOCK ALREADY FREE"); + w = (page_info[m] |= ISFREE); + if (unmap) expunge_pages (m, blksiz[w & SIZMSK] >> PGLOG2); + while (TRUE) + {register int n, ww, bs; + s = w & SIZMSK; + + /* see where buddy would be and see if buddy exists */ + if (w & _RIGHT) + {if (w & _EVEN) bs = s; + else if (w & _PP2) bs = s + 3; + else bs = s + 2; + if (bs >= TSIZES + || (n = m - (blksiz[bs] >> PGLOG2)) < lowlim) + break; /* no buddy -- don't merge */ + } + else {if (w & _EVEN) bs = s; + else bs = (s - 2) - (s & 1); + n = m + (blksiz[s] >> PGLOG2); + if ((n + (blksiz[bs] >> PGLOG2)) > highlim) break; + } + + /* merge if buddy is free and correct size */ + if (((ww = page_info[n]) & ISFREE) && ((ww & SIZMSK) == bs)) + {register unsigned nn, prev, next; + + page_info[n] &= ~(PPREVMSK | PNEXTMSK); + prev = ww & PPREVMSK; + next = ww & PNEXTMSK; + if (nn = (next >> PNSHIFT)) + {page_info[nn] &= ~PPREVMSK; + page_info[nn] |= prev; + } + if (prev >>= PPSHIFT) + {page_info[prev] &= ~PNEXTMSK; + page_info[prev] |= next; + } + else free_blks[bs] = nn; + + if (w & _RIGHT) /* swap so m is first */ + {nn = m; m = n; n = nn; + s = bs; + w = page_info[m]; + } + + /* calculate new size, update page_info */ + if (w & _EVEN) bs = s + 2; + else bs = s + 1; + page_info[m] = w = + (w & ~(FLGMSK|SIZMSK)) | ISFREE | bs + | ((page_info[n] & OFLGMSK) >> OFSHIFT); + } + else break; + } + if (w = free_blks[s]) + {page_info[w] |= (m << PPSHIFT); + page_info[m] &= ~(PPREVMSK | PNEXTMSK); + page_info[m] |= (w << PNSHIFT); + } + free_blks[s] = m; + } + +# ifdef ITS + +check_its_page (n) + + {int temp[4]; + if (page_info[n] & PEXISTS) return; + CORTYP (n, temp); + if (temp[0] < 0) page_info[n] |= PEXISTS; + } + +get_its_pages (start, cnt) + + {register int i, j, k, lim; + lim = start + cnt; + for (i = start; i < lim; ++i) check_its_page (i); + for (i = start; i < lim; ++i) + {if (page_info[i] & PEXISTS) continue; + for (j = i + 1; j < lim; ++j) + if (page_info[j] & PEXISTS) break; + create_its_pages (i, j - i); + for (k = i; k < j; ++k) page_info[k] |= PEXISTS; + } + } + +create_its_pages (start, cnt) + + {start = halves (-cnt, start); + while (TRUE) + {int errcod; + errcod = CORBLK (0130000, -1, start, -5, 0); + if (errcod == 0) return; + else if (errcod == -037) /* no core available; sleep, retry */ + SLEEP (30); + else alose ("CORBLK LOST"); + } + } +# endif + +int *salloc (n) + + {register int *p; + if (!(p = alloc (n + 1))) + if (!(p = alloc (n + 1))) + return (0); + sfill (++p, n, 0); + return (p); + } + +char *calloc (n) + + {register char *p; + if (!(p = alloc (n + 1))) + if (!(p = alloc (n + 1))) + return (0); + cfill (++p, n, 0); + return (p); + } + +sfree (p) int *p; {free (--p);} + +cfree (p) char *p; {free (--p);} + +int *realloc (p, n) + register int *p; + + {register int ns, s, ww, l1, l2, *q; + register unsigned w; + ++n; /* get real size and real address */ + --p; + + /* consistency checks */ + if (n < 0 || n > blksiz[TSIZES-1]) return (0); + if ((w = *p) & ISFREE) alose ("REALLOC: BLOCK IS FREE"); + if (((w >> MSHIFT) ^ (ww = p)) != MAGIC) + alose ("REALLOC: BAD BLOCK HEADER"); + + /* get current and desired size codes */ + s = w & SIZMSK; + ww = n; + for (ns = 0; ww > 128; ww = (ww + 63) / 64) ns += 12; + ns += iblksiz[--ww]; + if (blksiz[ns] == 0) ++ns; + if (s == ns) return (++p); + else if (ns < s) + {/* can we alloc and copy over more cheaply ? */ + w = ns; + while (!free_blks[w]) + if (++w >= s) goto keep; + goto new; + + /* split and return part */ +keep: if (s > NSIZES) + {if (ns >= NSIZES) + {prealloc (p, s, ns); + return (++p); + } + prealloc (p, s, NSIZES); + s = NSIZES; + } + while (TRUE) + switch (s - ns) { + + case 0: *p &= ~ISFREE; + return (++p); + + case 1: if (ns <= 1) ns = s; + else {--s; + split (p, s, (s - 2) - (s & 1), TRUE); + } + continue; + + default: + s -= 2; + split (p, s, s, TRUE); + continue; + } + } + +new: if (!(q = alloc (n))) + if (!(q = alloc (n))) + return (0); + l1 = blksiz[s]; + l2 = blksiz[ns]; + if (ns < s) smove (p + 1, q + 1, l2 - 1); + else {smove (p + 1, q + 1, l1 - 1); + sfill (q + l1, l2 - l1, 0); + } + free (p); + return (++q); + } + +char *crealloc (p, n) int *p; {return (realloc (p, n));} + +prealloc (p, s, ns) + register int *p; + + {register unsigned pp; + pp = (pp = p) >> PGLOG2; + while (TRUE) + switch (s - ns) { + + case 0: *p &= MMASK; + *p |= (page_info[pp] &= + ~(ISFREE | PPREVMSK | PNEXTMSK)); + return; + + uneven: + case 1: --s; + psplit (pp, s, (s - 2) - (s & 1), TRUE); + continue; + + even: + default: + case 2: s -= 2; + psplit (pp, s, s, TRUE); + continue; + + case 3: if (ns == NSIZES) goto uneven; + else goto even; + } + } + +int pg_size () {return (PGSIZE);} + +int *pg_get (n) + + {register int ns; + if (n <= 0 || n > (3 * NPAGES) / 4) return (0); + n =<< (PGLOG2 - 6); + for (ns = 12; n > 128; n = (n + 63) / 64) ns += 12; + ns += iblksiz[--n]; + if (blksiz[ns] == 0) ++ns; + n = ns; + while (!free_blks[n]) + if (++n >= TSIZES) + return (0); + return (palloc (ns, FALSE)); + } + +# ifndef ITS +pg_ret (p) + int *p; + + {pfree (p, TRUE);} +# else +pg_ret (p, n) /* obsolete interface */ + int p; + + {pfree (p << PGLOG2, TRUE);} +# endif + +int alocstat (pnalloc, pnbfree) + register int *pnalloc, *pnbfree; + + {register int pn; + int wfree; + pn = lowlim; + wfree = *pnalloc = *pnbfree = 0; + while (pn < highlim) + {register int pcode, sz; + sz = blksiz[(pcode = page_info[pn]) & SIZMSK]; + if (pcode & ISFREE) + { +# ifdef ITS + register int i, lim; + lim = pn + (sz >> PGLOG2); + for (i = pn; i < lim; ++i) + if (page_info[i] & PEXISTS) + {(*pnalloc) += PGSIZE; + wfree += PGSIZE; + } +# else + (*pnalloc) += sz; + wfree += sz; +# endif + ++(*pnbfree); + } + else {(*pnalloc) += sz; + if (sz == PGSIZE) + scan_page (pn << PGLOG2, &wfree, pnbfree); + } + pn += (sz >> PGLOG2); + } + return (wfree); + } + +scan_page (p, pwfree, pfreeb) + register int *p, *pwfree, *pfreeb; + + {register int *q, sz; + register unsigned hdr; + if (p != (q = ((hdr = *p) >> MSHIFT) ^ MAGIC)) return; + q = p + PGSIZE; + while (p < q) + {p += (sz = blksiz[(hdr = *p) & SIZMSK]); + if (hdr & ISFREE) + {(*pwfree) += sz; + ++(*pfreeb); + } + } + } + +int alocflush () + + {register int pn, wfree; + pn = lowlim; + wfree = 0; + while (pn < highlim) + {register int pcode, sz; + sz = blksiz[(pcode = page_info[pn]) & SIZMSK] >> PGLOG2; + if (pcode & ISFREE) + {expunge_pages (pn, sz); + wfree += (sz << PGLOG2); + } + pn += sz; + } + return (wfree); + } + +expunge_pages (start, count) + +# ifdef ITS + {CORBLK (0, -1, halves (-count, start)); + while (--count >= 0) page_info[start++] &= ~PEXISTS; + } +# else + {_PMAP (-1, halves (0400000, start), halves (0400000, count));} +# endif diff --git a/c20/pcc20lib/apfnam.c b/c20/pcc20lib/apfnam.c new file mode 100644 index 00000000..f18b9963 --- /dev/null +++ b/c20/pcc20lib/apfnam.c @@ -0,0 +1,25 @@ +/********************************************************************** + + APFNAME - Append suffix to file name + +**********************************************************************/ + +char *apfname (dest, source, suffix) + char *dest, *source, *suffix; + + {fnsfd (dest, source, 0, 0, 0, suffix, "", ""); + return (dest); + } + +/********************************************************************** + + FNMKOUT - Make output file name + +**********************************************************************/ + +char *fnmkout (dest, source, suffix) + char *dest, *source, *suffix; + + {fnsfd (dest, source, "", 0, 0, suffix, "", ""); + return (dest); + } diff --git a/c20/pcc20lib/atoi.c b/c20/pcc20lib/atoi.c new file mode 100644 index 00000000..24d38a63 --- /dev/null +++ b/c20/pcc20lib/atoi.c @@ -0,0 +1,69 @@ +# rename eprint "EPRINT" + +/********************************************************************** + + ATOI - Convert String to Integer + +**********************************************************************/ + +int atoi (s) + register char *s; + + {register int i, f, c; + + if (s == 0) return (0); + i = 0; + f = 1; + while (*s == '-') + {++s; + f = -f; + } + while ((c = *s++) >= '0' && c <= '9') i = i * 10 + c - '0'; + if (i < 0) + {i = -i; /* treat - specially */ + if (i < 0) return (f > 0 ? -(i + 1) : i); + } + return (f > 0 ? i : -i); + } + +/********************************************************************** + + ITOA - Convert Integer to String + + (Returns a pointer to the null character appended to the end.) + +**********************************************************************/ + +char *itoa (n, s) + register char *s; + + {register int a; + if (n < 0) + {*s++ = '-'; + n = -n; + if (n < 0) n = 0; + } + if (a = (n / 10)) s = itoa (a, s); + *s++ = '0' + n % 10; + *s = 0; + return (s); + } + +/********************************************************************** + + FTOA - Convert float to string + +**********************************************************************/ + +int ftoa (d, s, p, f) + double d; + char *s, f; + int p; + + {register int outs, cnt; + outs = copen (s, 'w', "s"); + if (f == 'f' || f == 'F') cnt = fprint (d, outs, p); + else cnt = eprint (d, outs, p); + cclose (outs); + return (cnt); + } diff --git a/c20/pcc20lib/blt.cmid b/c20/pcc20lib/blt.cmid new file mode 100644 index 0000000000000000000000000000000000000000..bff6fa41d1bafc418e53037faa7668e86aab7d0d GIT binary patch literal 220 zcmY*TO$&lR5be72EB0uxN?tPpbvF`pm2o^&baNx2B+yI$zS->3T;9jLH%tPF$V!5Q zk?zAJZ^Oe$#zr?`ypg?oxv_WStmO2bX7>ySmOn4z8c;!{k^V+h*cM5)?RJ;%^RM{# zs>OrcSi+OQzBS6uyear = vec[0] >> 18; + cd->month = (vec[0] & 0777777) + 1; + cd->day = (vec[1] >> 18) + 1; + udate = vec[2] & 0777777; + cd->second = udate % 60; udate /= 60; + cd->minute = udate % 60; udate /= 60; + cd->hour = udate % 24; + } + +int cal2t (cd) + register cal *cd; + + {char buf[100]; + int f; + f = copen (buf, 'w', "s"); + cprint (f, "%d/%d/%d %d:%d:%d", cd->month, cd->day, cd->year, + cd->hour, cd->minute, cd->second); + cclose (f); + return (_IDTIM (mkbptr (buf), 0)); + } + +now (cp) + cal *cp; + + {t2cal (_GTAD (), cp);} + +int etime () /* return elapsed time in 1/60th second units */ + + {int rt, ct; + _RUNTM (-5, &rt, &ct); + return (ct * 60 / 1000); + } + +/********************************************************************** + + CPUTM + +**********************************************************************/ + +int cputm () + + {int rt, ct; + _RUNTM (0400000, &rt, &ct); + return (rt * 60 / 1000); + } + +/********************************************************************** + + GFILDATE - Get file creation/modification date + +**********************************************************************/ + +gfildate (f, cp) + int f; + cal *cp; + + {int q; + _RTAD (cjfn (f), &q, 1); + t2cal (q, cp); + } + diff --git a/c20/pcc20lib/c20exc.c b/c20/pcc20lib/c20exc.c new file mode 100644 index 00000000..f10b10bf --- /dev/null +++ b/c20/pcc20lib/c20exc.c @@ -0,0 +1,146 @@ +# include + +/********************************************************************** + + EXEC20 + +**********************************************************************/ + +int exctime 0; +int exccode 0; + +# define _GTJFN SYSGTJFN +# define _RSCAN SYSRSCAN +# define _CLOSF SYSCLOSF +# define _NULIO 0377777 +# define JCLSIZE 500 + +/********************************************************************** + + EXECS - Execute a program with a given command string + + Returns: + + -5 Job valretted something and was not continued. + -4 Internal fatal error. + -3 Unable to load program file. + -2 Unable to create job. + -1 Unable to open program file. + 0 Job terminated normally. + other Job terminated abnormally with said PIRQ + + Sets: + + exctime - job's CPU time in 1/60 sec. units + exccode - contents of job's loc 1 at termination + +**********************************************************************/ + +int execs (pname, args) char *pname, *args; + + {register int j; /* process handle */ + register int f; /* jfn for program file */ + register int rc; /* return code */ + char jcl[JCLSIZE]; /* to construct JCL */ + + fnstd (pname, jcl); + f = _GTJFN (halves (0100001, 0), mkbptr (jcl)); /* access prog file */ + if (f >= 0600000) return (-1); + + j = _CFORK (halves (0200000, 0), 0); + /* create process, with my capabilities */ + if (j >= 0600000) + {_CLOSF (f); + return (-2); + } + + rc = _GET (halves (j, f), 0); /* load program file */ + _CLOSF (f); /* release program file */ + if (rc) + {_KFORK (j); + return (-3); + } + SYSSPJFN (j, _NULIO, SYSGPJFN (0400000) & 0777777); + + sconcat (jcl, 3, pname, " ", args); /* construct JCL line */ + _RSCAN (mkbptr (jcl)); /* set JCL */ + _SFRKV (j, 0); /* start job */ + + while (TRUE) + {register unsigned sts, code; + _WFORK (j); + sts = _RFSTS (j); + code = (sts >> 18) & 07777; + + if (code == 2) break; + if (code == 3) + {register int number; + number = sts & 0777777; + if (number == 12) + {int nwork, nused, nperm; + int usern, dirn, jobn, termn; + cprint ("Disk quota exceeded.\n"); + _GJINF (&usern, &dirn, &jobn, &termn); + _GTDAL (dirn, &nwork, &nused, &nperm); + if (nused == nwork) + {_DELDF (0, dirn); + _GTDAL (dirn, &nwork, &nused, &nperm); + if (nused < nwork) + {cprint ("%d pages expunged\n", + nwork - nused); + goto restart; + } + } + } + cprint ("Process terminated, error number %d.\n", + number); + _KFORK (j); + return (number); + } + cprint ("Process terminated, status %d.\n", code); + if (code != 0) break; + restart: + _RFORK (j); /* unfreeze it if it was frozen */ + _SFORK (j, _RFPC (j)); /* continue it */ + } + + {int junk; + int acs[16]; + _RUNTM (j, &exctime, &junk); + exctime = exctime * 60 / 1000; + _RFACS (j, acs); + exccode = acs[1]; + } + + _KFORK (j); + return (0); + } + +/********************************************************************** + + EXECV - Execute file given a vector of arguments + +**********************************************************************/ + +int execv (prog, argc, argv) + char *prog, *argv[]; + + {register char **ap, **ep, *p, *s; + char buff[JCLSIZE]; + register int c; + + p = buff; + ap = argv; + ep = argv + argc - 1; + + while (ap <= ep) + {s = *ap++; + *p++ = '"'; + while (c = *s++) *p++ = c; + *p++ = '"'; + *p++ = ' '; + } + + *p++ = 0; + return (execs (prog, buff)); + } diff --git a/c20/pcc20lib/c20exp.c b/c20/pcc20lib/c20exp.c new file mode 100644 index 00000000..1da72b37 --- /dev/null +++ b/c20/pcc20lib/c20exp.c @@ -0,0 +1,49 @@ +# include +# define QUOTE 22 /* control-V */ + +/********************************************************************** + + EXPAND ARGUMENT VECTOR CONTAINING FILE NAME PATTERNS + TOPS-20 Version + +**********************************************************************/ + +static char **next; +static char *bufp; + +int exparg (argc, argv, outv, buffer) + char *argv[], *outv[], buffer[]; + + {register int i; + int expfile(); + register char *s; + + bufp = buffer; + next = outv; + i = 0; + while (i < argc) + {s = argv[i++]; + if (expmagic (s)) fdmap (s, expfile); + else *next++ = s; + } + return (next - outv); + } + +int expmagic (s) /* does it contain magic pattern chars? */ + register char *s; + + {register int c; + while (c = *s++) switch (c) { + case '%': + case '*': return (TRUE); + case QUOTE: if (*s) ++s; continue; + } + return (FALSE); + } + +expfile (s) + register char *s; + + {*next++ = bufp; + while (*bufp++ = *s++); + } diff --git a/c20/pcc20lib/c20fd.c b/c20/pcc20lib/c20fd.c new file mode 100644 index 00000000..aeb2bd2b --- /dev/null +++ b/c20/pcc20lib/c20fd.c @@ -0,0 +1,38 @@ +# include + +/********************************************************************** + + FD-20 + File Directory Routines + TOPS-20 Version + +**********************************************************************/ + + +/********************************************************************** + + FDMAP (P, F) + + Call F(S) for all filenames S that match the pattern P. + +**********************************************************************/ + +fdmap (p, f) + char *p; + int (*f)(); + + {register int jfn, rc; + char buf[100]; + + fnstd (p, buf); + rc = jfn = SYSGTJFN (halves (0100121, 0), + /* GJ%OLD+GJ%IFG+GJ%FLG+GJ%SHT */ + mkbptr (buf)); + while ((rc & 0600000) == 0) + {SYSJFNS (mkbptr (buf), jfn & 0777777, 0); + (*f)(buf); + SYSCLOSF (jfn); + rc = SYSGNJFN (jfn); + } + } + diff --git a/c20/pcc20lib/c20fil.c b/c20/pcc20lib/c20fil.c new file mode 100644 index 00000000..adf40bc1 --- /dev/null +++ b/c20/pcc20lib/c20fil.c @@ -0,0 +1,59 @@ +# include + +/********************************************************************** + + rename (fn1, fn2) + delete (fn) + +**********************************************************************/ + +/********************************************************************** + + RENAME (file1, file2) + + Should work even if a file2 already exists. + Return 0 if no error. + + *TOPS-20 VERSION* + +**********************************************************************/ + +int rename (s1, s2) + char *s1, *s2; + + {register int jfn1, jfn2, rc; + char buf1[100], buf2[100]; + + fnstd (s1, buf1); + fnstd (s2, buf2); + jfn1 = SYSGTJFN (halves (0100001, 0), mkbptr (buf1)); /* old file */ + if (jfn1 >= 0600000) return (jfn1); + jfn2 = SYSGTJFN (halves (0400001, 0), mkbptr (buf2)); /* new file */ + if (jfn2 >= 0600000) return (jfn2); + if (rc = _RNAMF (jfn1, jfn2)) + {SYSRLJFN (jfn1); + SYSRLJFN (jfn2); + return (rc); + } + SYSRLJFN (jfn2); + return (0); + } + +/********************************************************************** + + DELETE + +**********************************************************************/ + +delete (s) + char *s; + + {register int jfn; + char buf[100]; + fnstd (s, buf); + jfn = SYSGTJFN (halves (0100001, 0), mkbptr (buf)); /* old file */ + if (jfn < 06000000) + {SYSDELF (jfn & 0777777); + SYSCLOSF (jfn); + } + } diff --git a/c20/pcc20lib/c20fnm.c b/c20/pcc20lib/c20fnm.c new file mode 100644 index 00000000..f6bd4258 --- /dev/null +++ b/c20/pcc20lib/c20fnm.c @@ -0,0 +1,312 @@ +# include +# define FNSIZE 100 +# define QUOTE 022 /* ^V */ + +/* + + TOPS-20 filename cluster + + components: + DEV:NAME.TYP.GEN;ATTR + All components manipulated without punctuation, + except ATTR. + Also accepts UNIX format: + /DEV/DIR1/DIR2/.../DIRn/NAME.TYP.GEN;ATTR + as equivalent to: + DEV:NAME.TYP.GEN;ATTR + +*/ + +/* declarations of internal procedures */ +char *fnscan(), *fnsmove(); + +/********************************************************************** + + FNPARSE - Parse file name into components. + +**********************************************************************/ + +fnparse (old, dv, dir, nm, typ, gen, attr) + register char *old; + char *dv, *dir, *nm, *typ, *gen, *attr; + + {register char *p, *q; + *dv = *dir = *nm = *typ = *gen = *attr = 0; + while (*old == ' ') ++old; + p = fnscan (old, ":<"); + if (*p == 0) /* must be OK in UNIX format */ + {if (*old == '/') /* get device part */ + {p = fnscan (++old, "/"); + fnsmove (old, p, dv); + if (*p == 0) return; + old = ++p; + } + q = dir; + while (TRUE) /* get dir parts */ + {p = fnscan (old, "/.;"); + if (*p != '/') break; + if (q != dir) *q++ = '.'; + fnsmove (old, p, q); + q =+ (p - old); + old = ++p; + } + fnsmove (old, p, nm); /* get name part */ + if (*p == 0) return; + if (*p == '.') + {old = ++p; /* get type part */ + p = fnscan (old, ".;"); + fnsmove (old, p, typ); + if (*p == 0) return; + } + if (*p == '.') + {old = ++p; /* get gen part */ + p = fnscan (old, ";"); + fnsmove (old, p, gen); + if (*p == 0) return; + } + fnsmove (p, 0, attr); /* get attr part */ + return; + } + + if (*old != '<') + {p = fnscan (old, ":"); + if (*p == ':') + {fnsmove (old, p, dv); + old = ++p; + } + } + if (*old == '<') + {p = fnscan (++old, ">"); + fnsmove (old, p, dir); + if (*p == 0) return; + old = ++p; + } + p = fnscan (old, ".;"); + fnsmove (old, p, nm); + old = p + 1; + if (*p == '.') + {p = fnscan (old, ".;"); + fnsmove (old, p, typ); + old = p + 1; + if (*p == '.') + {p = fnscan (old, ";"); + fnsmove (old, p, gen); + } + } + if (*p == ';') + fnsmove (p, 0, attr); + } + +/********************************************************************** + + FNGxx - Extrace a given component. + +**********************************************************************/ + +char *fngdv (old, buf) + char *old, *buf; + + {char temp[FNSIZE]; + fnparse (old, buf, temp, temp, temp, temp, temp); + return (buf); + } + +char *fngdr (old, buf) + char *old, *buf; + + {char temp[FNSIZE]; + fnparse (old, temp, buf, temp, temp, temp, temp); + return (buf); + } + +char *fngnm (old, buf) + char *old, *buf; + + {char temp[FNSIZE]; + fnparse (old, temp, temp, buf, temp, temp, temp); + return (buf); + } + +char *fngtp (old, buf) + char *old, *buf; + + {char temp[FNSIZE]; + fnparse (old, temp, temp, temp, buf, temp, temp); + return (buf); + } + +char *fnggn (old, buf) + char *old, *buf; + + {char temp[FNSIZE]; + fnparse (old, temp, temp, temp, temp, buf, temp); + return (buf); + } + +char *fngat (old, buf) + char *old, *buf; + + {char temp[FNSIZE]; + fnparse (old, temp, temp, temp, temp, temp, buf); + return (buf); + } + +/********************************************************************** + + FNCONS - Construct a file name from its components. + +**********************************************************************/ + +char *fncons (buf, dv, dir, nm, typ, gen, attr) + register char *buf; + char *dv, *dir, *nm, *typ, *gen, *attr; + + {if (dv && *dv) + {buf = fnsmove (dv, 0, buf); + *buf++ = ':'; + } + if (dir && *dir) + {*buf++ = '<'; + buf = fnsmove (dir, 0, buf); + *buf++ = '>'; + } + if (nm) buf = fnsmove (nm, 0, buf); + if (typ && *typ) + {*buf++ = '.'; + buf = fnsmove (typ, 0, buf); + } + if (gen && *gen) + {*buf++ = '.'; + buf = fnsmove (gen, 0, buf); + } + if (attr && *attr) + {if (*attr != ';') *buf++ = ';'; + fnsmove (attr, 0, buf); + } + return (buf); + } + +/********************************************************************** + + FNSDF - Make a new file name with specified defaults. + Nonzero arguments specify defaults; the corresponding + components will be set if they are null. + +**********************************************************************/ + +char *fnsdf (buf, old, dv, dir, nm, typ, gen, attr) + char *old, *buf, *dv, *dir, *nm, *typ, *gen, *attr; + + {char odv[FNSIZE], odir[FNSIZE], onm[FNSIZE], + otyp[FNSIZE], ogen[FNSIZE], oattr[FNSIZE]; + fnparse (old, odv, odir, onm, otyp, ogen, oattr); + if (dv && *odv == 0) fnsmove (dv, 0, odv); + if (dir && *odir == 0) fnsmove (dir, 0, odir); + if (nm && *onm == 0) fnsmove (nm, 0, onm); + if (typ && *otyp == 0) fnsmove (typ, 0, otyp); + if (gen && *ogen == 0) fnsmove (gen, 0, ogen); + if (attr && *oattr == 0) fnsmove (attr, 0, oattr); + fncons (buf, odv, odir, onm, otyp, ogen, oattr); + return (buf); + } + +/********************************************************************** + + FNSFD - Make a new file name with specified components. + Nonzero arguments specify components; the corresponding + components of the file name will be set. + +**********************************************************************/ + +char *fnsfd (buf, old, dv, dir, nm, typ, gen, attr) + char *old, *buf, *dv, *dir, *nm, *typ, *gen, *attr; + + {char odv[FNSIZE], odir[FNSIZE], onm[FNSIZE], + otyp[FNSIZE], ogen[FNSIZE], oattr[FNSIZE]; + fnparse (old, odv, odir, onm, otyp, ogen, oattr); + if (dv) fnsmove (dv, 0, odv); + if (dir) fnsmove (dir, 0, odir); + if (nm) fnsmove (nm, 0, onm); + if (typ) fnsmove (typ, 0, otyp); + if (gen) fnsmove (gen, 0, ogen); + if (attr) fnsmove (attr, 0, oattr); + fncons (buf, odv, odir, onm, otyp, ogen, oattr); + return (buf); + } + +/**************************************************************** + + FNSTD - standardize file name in TOPS-20 format + +****************************************************************/ + +fnstd (ins, outs) + char *ins, *outs; + + {char dev[40], dir[40], name[40], type[40], gen[10], attr[20]; + fnparse (ins, dev, dir, name, type, gen, attr); + fncons (outs, dev, dir, name, type, gen, attr); + } + +/* Internal procedures */ + +/* Scan starting from P for any character in M. Stops if an illegal + * character is encountered and returns a pointer to a null character. + */ + +char *fnscan (p, m) + register char *p, *m; + + {while (TRUE) + {register int c; + register char *q; + if ((c = *p++) == QUOTE) + {c = *p++; + if (c == 0) return (--p); + continue; + } + if (!fnlegal (c)) return (""); + q = m; + while (*q) if (c == *q++) return (--p); + } + } + +/* + * Internal routine: FNSMOVE + * + * Move characters starting with *FIRST up to (but not + * including) *AFTER into *DEST. If AFTER is null, then + * move characters until a NUL byte is encountered. + * Always terminate the destination with a NUL byte + * and return a pointer to the terminating NUL. + * Stop on illegal characters, don't move them. + */ + + +char *fnsmove (first, after, dest) + register char *first, *after, *dest; + + {register char c; + if (after && *after) + while (first < after) + if (fnlegal (c = *first++)) *dest++ = c; + else break; + else while (c = *first++) + if (fnlegal (c)) *dest++ = c; + else break; + *dest = 0; + return (dest); + } + +static char *legals {"#%**-.0<>>AZ__az"}; + +int fnlegal (c) + register char c; + + {register char *q; + q = legals; + while (*q) + if (c < *q++) break; + else if (c <= *q++) return (TRUE); + return (FALSE); + } diff --git a/c20/pcc20lib/c20hak.c b/c20/pcc20lib/c20hak.c new file mode 100644 index 00000000..626382bb --- /dev/null +++ b/c20/pcc20lib/c20hak.c @@ -0,0 +1,24 @@ +typedef int channel; + +/********************************************************************** + + GETI + +**********************************************************************/ + +int geti (p) + channel p; + + {return (cgeti (p));} + +/********************************************************************** + + PUTI + +**********************************************************************/ + +int puti (i, p) + channel p; + + {return (cputi (i, p));} + diff --git a/c20/pcc20lib/c20int.c b/c20/pcc20lib/c20int.c new file mode 100644 index 00000000..40719fce --- /dev/null +++ b/c20/pcc20lib/c20int.c @@ -0,0 +1,49 @@ +# include + +# rename handle "HANDLE" /* avoid name conflict, etc. */ +# rename chntab "CHNTAB" +# rename prctab "PRCTAB" + +extern int chntab[], prctab[]; + +int assigned {0}; /* interrupt channels assigned to user */ + +# define reserved halves (0000400, 0) /* PDLOV reserved */ +# define system_interrupts halves (0007777, 0760000) + +on (x, y) + {register unsigned prev, mask; + mask = ((unsigned)(halves (0400000, 0)) >> x); + if (x < 0 || x > 35 || (mask & reserved)) return (-1); + y =& 0777777; + if (y == INT_DEFAULT || y == INT_IGNORE) y = 0; + prev = prctab[x]; + if (prev && y == 0) + {_DIC (0400000, mask); + chntab[x] =& 0777777; + } + prctab[x] = y; + if (y && prev == 0) + {chntab[x] =| (3 << 18); /* always level 3 */ + _AIC (0400000, mask); + } + return (prev); + } + +ialloc () + {register unsigned left, num; + if ((left = ~(assigned | system_interrupts)) == 0) return (-1); + num = 35; + while (!(left & 1)) + {--num; + left =>> 1; + } + assigned =| (halves (0400000, 0) >> num); + return (num); + } + +ifree (num) + {if (num >= 0 && num <= 35) + assigned =& ~(((unsigned)(halves (0400000, 0)) >> num) & + ~system_interrupts); + } diff --git a/c20/pcc20lib/c20io.c b/c20/pcc20lib/c20io.c new file mode 100644 index 00000000..0e62da9a --- /dev/null +++ b/c20/pcc20lib/c20io.c @@ -0,0 +1,1663 @@ +# include +# undef channel +# undef _channel + +/* + * + * C20IO - C TOPS-20/TENEX I/O Routines (written in C) + * + * Routines: + * + * fd = copen (fname, mode, opt) + * setprompt (s) + * c = cgetc (fd) + * ungetc (c, fd) + * i = cgeti (fd) + * cputc (c, fd) + * cputi (i, fd) + * b = ceof (fd) + * cflush (fd) + * i = tell (fd) + * seek (fd, offset, mode) + * rew (fd) + * b = istty (fd) + * cclose (fd) + * c = getchar () + * p = gets (s) + * putchar (c) + * puts (s) + * closall () + * b = cisfd (fd) + * s = username () + * sleep (nsec) + * stkdmp () (dummy only) + * + * System-dependent routines: + * + * jfn = cjfn (fd) + * valret (s) [TOPS-20 only] + * + * Internal routines: + * + * nonempty = refill_buffer (p) + * change_direction (p) + * n = rdtty (p->buf) + * ttychar (c) + * new = calc_hpos (strt, end, old) + * setup () + * n = parse (s, v) + * setio () + * fd = c0open (fname, mode) + * errout (s) + * p = mkbptr (s) + * p = consbp (siz, s) + * copen_options (mode, opt, pdir, ptype, pappend, pnew, pthaw, pbsize) + * c = channel_allocate () + * channel_free (c, free); free <==> free I/O buffers + * + * Variables: + * + * cin - standard input channel + * cout - standard output channel + * cerr - standard error output channel + * + * cinfn - standard input file name (if redirected) + * coutfn - standard output file name (if redirected) + * cerrfn - standard errout file name (if redirected) + * + * + */ + +# rename copen_options "COPTNS" +# rename channel_allocate "CHALLC" +# rename channel_free "CHFREE" + +# define EOL 037 /* newline on TENEX */ +# define QUOTE 026 /* control-V, for file names */ +# define ARGQUOTE '\\' /* for command args */ + +# define FILBUFPGS 1 +# define FILBUFSIZ (FILBUFPGS << 9) +# define UBUFSIZ 15 +# define PIPSIZ 4096 +# define TTYLINSIZ 120 + + /* file types */ + +# define FTTY 0 /* interactive terminal (primary I/O only) */ +# define FTEXT 1 /* text file, other terminals */ +# define FBIN 2 /* binary file */ +# define FSTR 3 /* string I/O */ +# define FPIPE 4 /* pipe (special hack file) */ + +# define UFLAG 010 /* indicates UNGETC'ed units available */ +# define FUTTY (FTTY|UFLAG) /* "unget" versions of these */ +# define FUTEXT (FTEXT|UFLAG) +# define FUBIN (FBIN|UFLAG) +# define FUSTR (FSTR|UFLAG) +# define FUPIPE (FPIPE|UFLAG) + +# define EFLAG 020 /* indicates EOF on channel */ +# define FETTY (FTTY|EFLAG) /* eof versions */ +# define FETEXT (FTEXT|EFLAG) +# define FEBIN (FBIN|EFLAG) +# define FESTR (FSTR|EFLAG) +# define FEPIPE (FPIPE|EFLAG) + + /* file directions */ + /* possible states are: */ + /* FREAD (reading only) */ + /* FWRITE (writing only) */ + /* FREAD | FWRITE (reading and writing, currently writing) */ + /* FREAD | FWRITE | FREADING (both, currently reading) */ + +# define FREAD 1 +# define FWRITE 2 +# define FREADING 4 /* currently reading */ + +typedef struct _channel { + int jfn; /* JFN */ + struct _channel *next; /* next channel in CHANLIST */ + int ftype; /* file type (see above) */ + int direction; /* I/O direction */ + int bsize; /* byte size */ + int bptr; /* byte pointer into buffer */ + int devtype; /* for optimization in istty */ + int bcnt; /* number positions free/avail */ + int eof; /* end-of-file flag (never reset) */ + int *buf; /* buffer */ + int *ubuf; /* unget buffer */ + int ucnt; /* unget count */ + } *channel; + +channel c0open (), channel_allocate (); + +struct _channel cinblk, /* standard input unit */ + coutblk, /* standard output unit */ + cerrblk; /* standard error output unit */ + +int cin, cout, cerr; + +char *cinfn, /* standard input file name, if redirected */ + *coutfn, /* standard output file name, if redirected */ + *cerrfn; /* standard errout file name, if redirected */ + +int cerrno; /* system OPEN error codes returned here */ + +# define tty_prompt tprmpt +# define tty_ptr tptr + +static char *tty_prompt; /* terminal prompt string */ +static int tty_eof; /* set when (unquoted) ^@, ^Z typed */ +static char tty_line[TTYLINSIZ+1]; /* current output line (for prompt) */ +static char *tty_ptr; /* pointer to end of tty_line */ + +# rename refill_buffer "REFILL" +# rename change_direction "CHANGE" + +/********************************************************************** + + COPEN - CIO Open File + + Open a file, given a file name, an optional mode, and an + optional options string. The possible modes are + + 'r' - read + 'w' - write + 'a' - append + 'b' - both (read and write, new file, exclusive access) + 'u' - update (read and write, exclusive access) + 'm' - modify (read and write, non-exclusive access) + + The default mode is read. Normally, I/O is character oriented + and produces text files. In particular, the lines of a text + file are assumed (by the user) to be separated by newline + characters with any conversion to the system format performed + by the I/O routines. + + If an options string is given and contains the character "b", + then I/O is integer (word) - oriented and produces image files. + + If the options string begins with digits, they are + interpreted as a decimal integer to use as the byte size + when opening the channel. Text I/O is defaultly 7-bit, + and binary I/O is defaultly 36-bit. The byte size field + is ignored for TTY and in core string I/O. + + I/O to and from character strings in core is accomplished by + including "s" in the options string and supplying a character + pointer to the string to be read or written into as the first + argument to COPEN. Closing a string open for write will + append a NULL character to the string and return a character + pointer to that character. + + If the filename attributes include ;PIPE, then a pipe will be + opened using the given file name (with the ;PIPE removed from + the name, of course). Pipe I/O is always in 36-bit units; the + byte size is ignored. See C20PIP for more details. ;PIPE is + looked for only if the "s" option is not given. + + COPEN returns a CHANNEL, which is a pointer to a control block. + The external variables CIN, COUT, and CERR contain already-open + channels for standard input, standard output, and standard + error output, respectively. + + COPEN returns OPENLOSS in case of error. The system error code + is stored in CERRNO. + +**********************************************************************/ + +channel copen (fname, mode, opt) + char *fname, *opt; + + {register channel p; + int append; /* TRUE if append mode */ + int thawed; /* TRUE if thawed access */ + int direction; /* read or write */ + int new; /* new file ? */ + int reading, writing, both; /* for each direction */ + int ftype; /* file type */ + int jfn, bsize; /* the actual jfn, desired byte size */ + int pipe; /* is it to be a pipe ? */ + char fnbuf[100]; /* buffer for standardizing file name */ + + cerrno = 0; + copen_options (mode, opt, &direction, &ftype, + &append, &new, &thawed, &bsize); + reading = ((direction & FREAD) != 0); + writing = ((direction & FWRITE) != 0); + both = (reading && writing); + if (ftype == FSTR) /* string I/O */ + {if (both) return (OPENLOSS); + if (append) while (*fname) ++fname; + jfn = 0; + bsize = 36; + } + else if (*fname == 0 && ftype == FTEXT) + /* primary I/O */ + {if (both) return (OPENLOSS); + if (reading) jfn = 0100; + else jfn = 0101; + bsize = 7; /* byte size always 7 bits */ + } + else {/* is it to be a pipe ? */ + if (fnpipe (fname, fnbuf)) + {if (both) return (OPENLOSS); /* one way only! */ + jfn = p = copen (fnbuf, 'm', "36b"); + if (jfn == OPENLOSS) return (OPENLOSS); + jfn = p->jfn; + if ((pipe = mkpipe ()) < 0) + {/* no pipes avail; discard jfn, aborting */ + SYSCLOSF (halves (0004000, jfn)); + channel_free (p, TRUE); + return (OPENLOSS); + } + bsize = 36; + ftype = FPIPE; + } + else {int oflag; /* must GTJFN, OPENF */ + oflag = halves (1, 0); /* GTJFN short form */ + if (new) oflag |= halves (0400000, 0); + /* "output" use */ + if (reading && !writing) + oflag |= halves (0100000, 0); + /* require old file */ + jfn = SYSGTJFN (oflag, mkbptr (fnbuf)); + if (jfn >= 0600000) + {cerrno = jfn; + return (OPENLOSS); + } + oflag = 0; + if (reading) oflag = 0200000; + if (writing) + {if (append) oflag = 020000; + else oflag |= 0100000; + if (thawed) oflag |= 02000; + } + cerrno = SYSOPENF (jfn, oflag | (bsize << 30)); + if (cerrno) + {SYSRLJFN (jfn); + return (OPENLOSS); + } + } + } + + if (ftype == FPIPE) p->jfn = pipe; + else {if ((p = channel_allocate ()) == 0) + {if (ftype != FSTR) + SYSCLOSF (halves (0004000, jfn)); + /* close, aborting */ + return (OPENLOSS); + } + p->jfn = jfn; + } + p->ftype = ftype; + p->direction = direction; + p->bsize = bsize; + /* strings use a byte pointer, too, for uniform code */ + /* in other routines (cgetc, cputc) */ + if (ftype == FSTR) p->bptr = consbp (36, fname); + if (ftype == FTEXT && istty (p) && (jfn == 0100 || jfn == 0101)) + p->ftype = FTTY; /* really the terminal ? */ + if (p->ftype == FTTY) + {if (reading) + {p->buf = pg_get (FILBUFPGS); + p->bcnt = 0; + p->bsize = 36; + tty_eof = FALSE; + } + /* no output buffer required (C20TTY keeps buffer) */ + } + else if (p->ftype == FTEXT || p->ftype == FBIN || p->ftype == FPIPE) + {if (p->ftype != FPIPE) p->buf = pg_get (FILBUFPGS); + if (writing) + {p->bcnt = FILBUFSIZ * (36 / bsize); + p->bptr = consbp (bsize, p->buf); + } + else p->bcnt = 0; + } + if (p->ftype == FPIPE) spipe (p->jfn, jfn, writing, PIPSIZ); + return (p); + } + +/********************************************************************** + + FNPIPE - standardize filename and see if it is pipe + +**********************************************************************/ + +int fnpipe (fname, fnbuf) + char *fname, *fnbuf; + + {char dev[40], dir[40], name[40], type[40], gen[10], attr[20]; + register char *p, *q, *qq; + int ispipe; + fnparse (fname, dev, dir, name, type, gen, attr); + p = q = attr; + ispipe = FALSE; + while (TRUE) + {register char c; + qq = q; + c = *q++ = *p++; + if (c == 0) break; + while (TRUE) + {c = *q++ = *p++; + if (c == 0 || c == ';') break; + } + --p; + *--q = 0; + if (qq[0] == ';' && + lower (qq[1]) == 'p' && + lower (qq[2]) == 'i' && + lower (qq[3]) == 'p' && + lower (qq[4]) == 'e' && + qq[5] == 0) + {ispipe = TRUE; + q = qq; + } + else *q = c; + } + fncons (fnbuf, dev, dir, name, type, gen, attr); + return (ispipe); + } + +/********************************************************************** + + SETPROMPT - set the terminal prompt string used when + getting a line of edited input from the terminal + +**********************************************************************/ + +setprompt (s) + char *s; + + {tty_prompt = s; + return (0); + } + +/********************************************************************** + + CGETC + +**********************************************************************/ + +int cgetc (p) + register channel p; + + {register int c; + + switch (p->direction) { + case FWRITE: + return (EOF_VALUE); /* can't read */ + case (FREAD | FWRITE): + change_direction (p); + } + + switch (p->ftype) { + + case FTEXT: /* these all just try to ILDB from the buffer, */ + case FTTY: /* and refill it if empty, noting EOF as necessary */ + case FBIN: + case FPIPE: + while (--p->bcnt < 0) + if (!refill_buffer (p)) + {p->eof = TRUE; + p->ftype |= EFLAG; + return (EOF_VALUE); + } + c = ildb (&p->bptr); +# ifdef TENEX + /* NULLs can appear in the middle of text - ignore them */ + if (c == '\000' && p->ftype == FTEXT) return (cgetc (p)); +# endif + /* converts CRLF to newline on text input */ + if (c == '\r' && p->ftype == FTEXT) + {char peekchar; + if ((peekchar = cgetc (p)) == '\n') return ('\n'); + ungetc (peekchar, p); + return (c); + } + return (c); + + case FSTR: + if ((c = ildb (&p->bptr)) == 0) + {p->ftype = FESTR; + p->eof = TRUE; + return (EOF_VALUE); + } + return (c); + + case FUTTY: /* return any UNGETC'ed units; ubuf is used as a */ + case FUTEXT: /* stack, and ucnt indicates the number of items */ + case FUBIN: /* pushed back. We must restore the correct type */ + case FUSTR: /* when the stack becomes empty. */ + case FUPIPE: + c = p->ubuf[--p->ucnt]; + if (p->ucnt == 0) + {p->ftype &= ~UFLAG; + if (p->eof) p->ftype |= EFLAG; + } + return (c); + + case FETTY: /* at EOF, keep returning EOF_VALUE */ + case FETEXT: + case FEBIN: + case FESTR: + case FEPIPE: + return (EOF_VALUE); + } + } + +/**************************************************************** + + REFILL_BUFFER - internal routine to get another input + buffer full for the specified channel + +****************************************************************/ + +int refill_buffer (p) + register channel p; + + {register int nc, nbytes, bp; + bp = consbp (p->bsize, p->buf); /* cons new byte pointer */ + switch (p->ftype) { + case FTTY: + nc = rdtty (p->buf); /* special case */ + break; + case FTEXT: + case FBIN: + nbytes = FILBUFSIZ * (36 / p->bsize); + nc = SYSSIN (p->jfn, bp, -nbytes, 0); + nc += nbytes; + break; + case FPIPE: + nc = rdpipe (p->jfn, bp, FILBUFSIZ); + } + p->bptr = bp; /* store new byte pointer */ + p->bcnt = nc; /* store available count */ + return (nc != 0); /* say if got any */ + } + +/********************************************************************** + + UNGETC - push a unit back on an input channel + +**********************************************************************/ + +ungetc (c, p) + register channel p; + + {switch (p->direction) { + case FWRITE: + return; + case (FWRITE | FREAD): + change_direction (p); + } + if (p->ubuf == 0) /* alloc a buffer, if necessary */ + {p->ubuf = salloc (UBUFSIZ); + p->ucnt = 0; + } + else if (p->ucnt >= UBUFSIZ) return; /* punt if full */ + if (p->ucnt == 0) /* change state if previously empty */ + {p->ftype &= ~EFLAG; + p->ftype |= UFLAG; + } + p->ubuf[p->ucnt++] = c; /* finally, push unit */ + } + +/********************************************************************** + + CGETI - INTs are encoded as SIXBITs on text streams + +**********************************************************************/ + +int cgeti (p) + channel p; + + {register int btype; + btype = p->ftype & ~(UFLAG | EFLAG); /* get basic type */ + if (btype == FTEXT) + {register int i, j; + i = 0; + for (j = 6; j > 0; --j) i = (i << 6) + cgetc (p) - 040; + return (i); + } + else return (cgetc (p)); + } + +/********************************************************************** + + CPUTC + +**********************************************************************/ + +int cputc (c, p) + register int c; + register channel p; + + {switch (p->direction) { + case FREAD: + return (c); + case (FREAD | FWRITE | FREADING): + change_direction (p); + } + switch (p->ftype) { + + case FTTY: /* newline ==> CRLF; use C20TTY stuff */ + if (c == '\n') + {tyos ("\r\n"); + tty_ptr = tty_line; + cflush (p); + break; + } + if (tty_ptr < tty_line + TTYLINSIZ) *tty_ptr++ = c; + tyo (c); + break; + + case FTEXT: + if (c == '\n') cputc ('\r', p); /* newline ==> CRLF */ + case FBIN: + case FPIPE: + while (--p->bcnt < 0) /* send a full buffer */ + {++p->bcnt; /* restore count for cflush */ + cflush (p); + } + case FSTR: + idpb (c, &p->bptr); /* store the unit */ + break; + } + return (c); + } + +/********************************************************************** + + CPUTI - INTs are encoded as SIXBITs on text streams + +**********************************************************************/ + +int cputi (i, p) + unsigned i; + channel p; + + {int btype; + btype = p->ftype & ~(UFLAG | EFLAG); /* get basic type */ + if (btype == FTEXT) + {cputc ((i >> 30) + 040, p); + cputc (((i >> 24) & 077) + 040, p); + cputc (((i >> 18) & 077) + 040, p); + cputc (((i >> 12) & 077) + 040, p); + cputc (((i >> 6) & 077) + 040, p); + cputc ((i & 077) + 040, p); + return (0); + } + else return (cputc (i, p)); + } + +/********************************************************************** + + CEOF + +**********************************************************************/ + +int ceof (p) + channel p; + + {if (p->ucnt > 0) return (FALSE); + else return (p->eof); + } + +/********************************************************************** + + CFLUSH + +**********************************************************************/ + +cflush (p) + register channel p; + + {register int nbytes, bp, nc; + switch (p->direction) { + case FREAD: + case (FREAD | FWRITE | FREADING): + p->bcnt = 0; + p->ucnt = 0; + p->ftype &= ~UFLAG; /* restore correct type */ + if (p->eof) p->ftype |= EFLAG; + return (0); + } + + switch (p->ftype) { + + case FTTY: + tyo_flush (); /* use C20TTY's facilities */ + case FSTR: + return (0); + + case FTEXT: /* skip system call if nothing to do; avoids */ + case FBIN: /* overhead, and any screws if user did a */ + case FPIPE: /* SYSCLOSF (as in STINKR) */ + nbytes = FILBUFSIZ * (36 / p->bsize); + bp = consbp (p->bsize, p->buf); + nc = nbytes - p->bcnt; + if (nc != 0) + {if (p->ftype == FPIPE) + wrpipe (p->jfn, bp, nc); + else nc += SYSSOUT (p->jfn, bp, -nc, 0); + } + p->bcnt = nbytes; + p->bptr = bp; + return (nc); + } + } + +/********************************************************************** + + CHANGE_DIRECTION - switch between reading and writing + use only if channel can both read and write! + +**********************************************************************/ + +change_direction (p) + register channel p; + + {register int dir; + cflush (p); + dir = (p->direction ^= FREADING); + if (dir & FREADING) p->bcnt = 0; /* was writing, now reading */ + else {/* was reading, now writing */ + p->eof = FALSE; + p->ftype &= ~EFLAG; + p->bcnt = FILBUFSIZ * (36 / p->bsize); + p->bptr = consbp (p->bsize, p->buf); + } + } + +/********************************************************************** + + TELL - get position in file + +**********************************************************************/ + +tell (p) + register channel p; + + {register int btype; + btype = p->ftype & ~(UFLAG | EFLAG); /* get basic type */ + if (btype == FTEXT || btype == FBIN) + {register int pos, n; + switch (p->direction) { + case FREAD: + case (FREAD | FWRITE | FREADING): + n = -p->bcnt; + break; + case FWRITE: + case (FREAD | FWRITE): + n = FILBUFSIZ * (36 / p->bsize) - p->bcnt; + break; + } + if ((pos = SYRFPTR (p->jfn)) < 0) return (-1); + return (pos + n); + } + /* TTY, string I/O, or pipe */ + return (0); + } + +/********************************************************************** + + SEEK - set position in file + +**********************************************************************/ + +seek (p, offset, mode) + register channel p; + int offset, mode; + + {register int btype; + btype = p->ftype & ~(UFLAG | EFLAG); /* get basic type */ + if (btype == FTEXT || btype == FBIN) + {register int pos; + if (mode == 1) /* adjust for buffering */ + {switch (p->direction) { + case FREAD: + case (FREAD | FWRITE | FREADING): + /* not clear p->ucnt should be here ... */ + offset -= p->bcnt + p->ucnt; + } + } + cflush (p); + switch (mode) { + case 2: /* relative to end */ + if (SYSSFPTR (p->jfn, -1) < 0) return (-1); + case 1: /* relative to current */ + if (offset == 0) return (0); + if ((pos = SYRFPTR (p->jfn)) < 0) return (-1); + offset += pos; + case 0: /* relative to start */ + break; + } + p->ftype &= ~EFLAG; + p->eof = FALSE; + return (SYSSFPTR (p->jfn, offset)); + } + /* no effect on TTY, string I/O, or pipes */ + return (0); + } + +/********************************************************************** + + REW - reset to beginning of file + +**********************************************************************/ + +rew (p) + channel p; + + {return (seek (p, 0, 0)); + } + +/********************************************************************** + + ISTTY + +**********************************************************************/ + +int istty (p) + register channel p; + + {unsigned vals[3]; + + switch (p->ftype & ~(EFLAG | UFLAG)) { + case FSTR: + case FPIPE: + return (FALSE); + case FTTY: + return (TRUE); + } + if (p->devtype == -1) /* this is a trick so DVCHR done only once */ + {register int jfn; + if ((jfn = p->jfn) == 0100) + jfn = (unsigned)(SYSGPJFN (0400000)) >> 18; + else if (p->jfn == 0101) jfn = SYSGPJFN (0400000) & 0777777; + if (jfn == 0377777) /* .NULIO */ + p->devtype = 015; /* .DVNUL */ + else if (jfn == 0677777) /* .SIGIO */ + p->devtype = 012; /* .DVTTY (assumption!) */ + else {SYSDVCHR (p->jfn, vals); + p->devtype = (vals[1] >> 18) & 0777; + } + } + return ((p->devtype & ~01) == 012); /* TTY or PTY */ + } + +/********************************************************************** + + CCLOSE + +**********************************************************************/ + +cclose (p) + register channel p; + + {register int ftype; + ftype = p->ftype & ~(EFLAG | UFLAG); + if (ftype == FSTR) + {char *s; + if (p->direction & FWRITE) idpb (0, &p->bptr); + s = p->bptr & 0777777; + channel_free (p, TRUE); + return (s); + } + if (ftype == FTTY) + {dpyreset (); + dpyinit (); + } + cflush (p); + if (ftype == FPIPE) clpipe (p->jfn); + else SYSCLOSF (p->jfn); /* close file and release jfn */ + channel_free (p, TRUE); + return (0); + } + +/********************************************************************** + + GETCHAR - Read a character from the standard input unit + +**********************************************************************/ + +getchar () {return (cgetc (cin));} + +/********************************************************************** + + GETS - Read a string from the standard input unit + +**********************************************************************/ + +char *gets (p) + register char *p; + + {register int c; + char *s; + + s = p; + while ((c = cgetc (cin)) != '\n' && c > 0) *p++ = c; + *p = 0; + return (s); + } + +/********************************************************************** + + PUTCHAR - Output a character to the standard output unit + +**********************************************************************/ + +putchar (c) + int c; + + {return (cputc (c, cout));} + +/********************************************************************** + + PUTS - Output a string to the standard output unit + +**********************************************************************/ + +puts (s) + register char *s; + + {register int c; + + while (c = *s++) cputc (c, cout); + cputc ('\n', cout); + } + +/********************************************************************** + + RDTTY - C buffered TTY input editing: + implements ^@, ^I, ^J, ^L, ^M, ^R, ^U, ^V, ^W, ^Z + display terminals handled nicely; others still edit + +**********************************************************************/ + +# define alpha(c) ((c>='0'&&c<='9')||(c>='A'&&c<='Z')||(c>='a'&&c<='z')) +# define PRIOU 0101 + +int rdtty (p) /* returns number of chars in buffer */ + register int *p; + + {register int *q, *qq, c; + register char *prompt; /* standardized prompt */ + int quoteflag, delflag, disp; + if (tty_eof) return (0); + q = p; /* pointer to next char slot */ + delflag = quoteflag = FALSE; + disp = isdisplay (); /* flag for display-ness */ + *tty_ptr = 0; + prompt = tty_line; + if (*prompt != 0) c = utyi (); + else {if (tty_prompt) prompt = tty_prompt; + c = '\022'; /* simulate ^R to start */ + } + while (TRUE) + {register int hpos; /* calculate cursor position */ + hpos = calc_hpos (p, q, calc_hpos (prompt, 0, 0)); + + /* check for end of deleting on non-displays */ + if (delflag && c != '\177') + {tyo ('\\'); + delflag = FALSE; + } + + /* check for special characters */ + if (!quoteflag) switch (c) { + case '\r': +# ifdef TENEX + case EOL: +# endif + c = '\n'; /* treat as newline */ + case '\n': + *q++ = c; /* insert into buffer */ + break; + + case '\177': /* rubout - rubout character */ + if (q <= p) /* beep if none */ + {utyo ('\007'); + c = utyi (); + continue; + } + --q; /* delete it */ + if (!disp) /* do non-display rubout stuff */ + {if (!delflag) + {delflag = TRUE; + tyo ('\\'); + } + ttychar (*q); + c = utyi (); + continue; + } + /* fall through to redisplay code */ + + case '\027': /* ^W - rubout word */ + if (c == '\027') /* so falling through works */ + {register int cc; + if (q <= p) /* beep if none */ + {utyo ('\007'); + c = utyi (); + continue; + } + cc = q[-1]; + while (!alpha (cc) && --q > p) cc = q[-1]; + while (alpha (cc) && --q > p) cc = q[-1]; + } + + case '\025': /* ^U - rubout line */ + if (c == '\025') /* so falling through works */ + {if (q <= p) /* beep if none */ + {utyo ('\007'); + c = utyi (); + continue; + } + q = p; /* just reset pointer */ + } + if (disp) /* redisplay by backing up cursor, */ + /* then kill to end of line */ + {register int nhpos; + nhpos = calc_hpos (prompt, 0, 0); + nhpos = calc_hpos (p, q, nhpos); + while (nhpos < hpos) + {spctty ('B'); + --hpos; + } + spctty ('L'); + tyo_flush (); + c = utyi (); + continue; + } + /* non-display ^W, ^U fall through here */ + + case '\014': /* ^L - clear and retype */ + case '\022': /* ^R - just retype */ + /* more cursor, maybe clear */ + if (disp) + {if (c == '\p') spctty ('C'); + else tyo ('\r'); + } + else tyos ("\r\n"); + tyos (prompt); + qq = p; + while (qq < q) ttychar (*qq++); + if (disp) spctty ('L'); /* zap rest of line */ + tyo_flush (); + c = utyi (); + continue; + } + /* here is non-special character, or \r or \n */ + + /* display all except unquoted newline, ^V */ + if (quoteflag || (c != '\n' && c != '\026')) + {if (q - p >= FILBUFSIZ - 1) + {utyo ('\007'); /* beep if buffer full */ + c = utyi (); + continue; + } + ttychar (c); + tyo_flush (); + } + + /* done if unquoted ^@, ^Z, or newline */ + if (!quoteflag && (c == '\000' || c == '\032' || c == '\n')) + {tty_eof = (c != '\n'); + tyos ("\r\n"); + tyo_flush (); + tty_ptr = tty_line; + return (q - p); + } + + /* adjust quote flag */ + quoteflag = (c == '\026' && !quoteflag); + /* add all except ^V to buffer */ + if (quoteflag) + {int omode; /* permit ^Q/^S to be input */ + omode = _RFMOD (PRIOU); + if (omode & 2) _STPAR (PRIOU, omode & ~2); + c = utyi (); + if (omode & 2) _STPAR (PRIOU, omode); + } + else {*q++ = c; /* normal case */ + c = utyi (); + } + } + } + +/**************************************************************** + + TTYCHAR - echo char on terminal + converts control chars to ^letter, except \t + +****************************************************************/ + +ttychar (c) + register char c; + + {if (c == '\177') + {tyos ("^?"); + return; + } + if (c < ' ' && c != '\t') + {tyo ('^'); + c += 0100; + } + tyo (c); + } + +/**************************************************************** + + CALC_HPOS - calculates position of terminal cursor after + displaying given string via TTYCHAR + +****************************************************************/ + +int calc_hpos (s, e, h) + register char *s, *e; + register int h; + + {/* s = start of string, e = end, h = initial hpos */ + register char c; + if (e == 0) /* calculate e if not supplied */ + {e = s; + while (*e != 0) e++; + } + while (s < e) + {c = *s++; + if (c == '\t') + {h = (h + 8) & ~07; /* assumes first position is 0 */ + continue; + } + if (c < ' ' || c == '\177') h++; + h++; + } + return (h); + } + +/********************************************************************** + + CJFN - Return JFN of file. + +**********************************************************************/ + +int cjfn (p) + channel p; + + {return (p->jfn);} + +# define COMSIZE 500 /* size of command buffer */ +# define MAXARG 100 /* maximum number of command arguments */ + +# rename combuf "COMBUF" +# rename argv "ARGV" +# rename argc "ARGC" +# rename setup "$SETUP" +# rename setio "$SETIO" +# rename parse "$PARSE" +# rename errout "ERROUT" +# rename pjflag "PJFLAG" +# rename riflag "RIFLAG" +# ifdef TENEX +# rename dbgflg "DBGFLG" +# endif TENEX + +char combuf[COMSIZE]; /* command buffer */ +char *argv[MAXARG]; /* command arguments */ +int argc; /* number of command arguments */ + +/********************************************************************** + + SETUP - Initialization Routine + +**********************************************************************/ + +setup () + + {register int n; + tty_eof = FALSE; /* reset global I/O stuff */ + tty_prompt = ""; + tty_ptr = tty_line; + cin = &cinblk; + cout = &coutblk; + cerr = &cerrblk; + cinfn = coutfn = cerrfn = 0; + dpysetup (); /* reset its stuff, too */ + dpyinit (); + +# ifdef TOPS20 + n = SYSRSCAN (0); /* command line in rescan buffer */ + if (n > 0) + {register int i; + SYSSIN (0777777, mkbptr (combuf), n, 0); + i = n - 1; + while (i >= 0) /* remove trailing CR and NLs */ + {register int c; + c = combuf[i]; + if (c != '\r' && c != '\n') break; + --i; + } + combuf[i+1] = 0; /* terminate string */ + } + if (n == 0 || nojcl ()) + /* if run from IDDT or by some EXEC command, then */ + /* no jcl, so give the user a chance ... */ + {combuf[0] = '.'; /* dummy program name */ + combuf[1] = ' '; + tty_prompt = "Command: "; + fix_primary_io (cin, copen ("", 'r')); + gets (&combuf[2]); + cclose (cin); + tty_eof = FALSE; /* just in case */ + tty_prompt = 0; + } +# endif +# ifdef TENEX + combuf[0] = '.'; /* hack jcl */ + n = SYSGPJFN (0400000); /* what is primary input ? */ + if (((unsigned)(n) >> 18) == 0777777) /* controlling terminal */ + {extern int dbgflg; + register char c, *p; + if (dbgflg || _BKJFN (0100) != 0) c = ' '; + else c = utyi (); + if (c == '\r' || c == '\n' || c == EOL) combuf[1] = 0; + else {combuf[1] = c; + tty_prompt = "Command: "; + if (!dbgflg) tty_ptr = stcpy (tty_prompt, tty_line); + p = &combuf[2]; + p += rdtty (p); /* don't copy newline */ + while (p[-1] == '\n' || p[-1] == ' ') *--p = 0; + tty_eof = FALSE; /* just in case */ + tty_prompt = 0; + tty_ptr = tty_line; + } + } + else {register char *p; + p = combuf; + while (TRUE) + {register char c; + c = SYSBIN ((unsigned)(n) >> 18); + if (c == '\r' || c == '\n' || c == EOL || c == 0) + break; + *p++ = c; + } + *p++ = 0; + SYSSPJFN (0400000, 0777777, n & 0777777); + } +# endif TENEX + + argc = parse (combuf, argv); /* parse command line */ + setio (); /* maybe redirect I/O */ + } + +# ifdef TOPS20 +int nojcl () /* just to see if RUN was used, or we are in a debugger */ + + {char temp[COMSIZE]; + register char *p; + stcpy (combuf, temp); + p = temp; + while (*p) + {if (*p == ' ') {*p = 0; break;} + *p = lower (*p); ++p; + } + if (stcmp (temp, "run")) return (TRUE); + if (stcmp (temp, "r")) return (TRUE); + /* match anything ending in "ddt" */ + if (p - temp >= 3 && stcmp (p - 3, "ddt")) return (TRUE); + return (FALSE); + } +# endif TOPS20 + +static int append, errappend; + +/********************************************************************** + + PARSE - Parse Command Arguments + + given: in - the command string + av - a pointer to a character pointer array + where pointers to the args should be placed + returns: number of arguments + + PJFLAG set to false suppresses parsing and I/O redirection + RIFLAG set to false suppresses I/O redirection + + Command syntax: + + Arguments beginning with <, >, >>, %, %% do file + redirection, a la Unix. + (A < redirection must not have an unmatched '>' + in the file name.) + Arguments are separated by spaces. + Arguments may be surrounded by "s, in which case + embedded spaces are allowed and embedded + "s must be doubled. + ^V and \ both prohibit the special interpretation of + the next character (i.e., space, ", <, >, %) + A \ is eaten, a ^V is left in the string unless it + is followed by a - or a ?. + +**********************************************************************/ + +int pjflag {TRUE}; /* set to false in binary file to suppress parsing */ +int riflag {TRUE}; /* set to false in binary file to suppress redirect */ + /* of primary I/O; pjflag false also suppresses it */ + +int parse (in, av) + register char *in, *av[]; + + {register int ac; + register char *out; + + ac = 0; + out = in; + append = errappend = FALSE; + cinfn = coutfn = cerrfn = 0; + + if (!pjflag) /* don't parse (except hack ^V, \ as usual) */ + {register int c; + av[0] = out; + while (TRUE) /* get program name */ + {c = *in++; + if (c == ' ' || c == 0) break; + *out++ = c; + } + *out++ = 0; + ac++; + while (c == ' ') c = *in++; + av[1] = out; + while (c) /* get rest of line */ + {if (c == QUOTE) + {c = *in++; + if (c != '?' && c != '-') *out++ = QUOTE; + } + else if (c == ARGQUOTE) c = *in++; + *out++ = c; + c = *in++; + } + if (out != av[1]) ac++; + return (ac); + } + while (TRUE) + {int quoteflag, firstch, secondch; + register int c; + register char *s; + + quoteflag = FALSE; + + /* find beginning of next arg */ + + c = *in++; + while (c == ' ') c = *in++; + if (c == 0) break; + if (c == '"') {quoteflag = TRUE; c = *in++;} + if (c == 0) break; + firstch = c; /* \< should not be special */ + secondch = *in; /* >\> should not be special */ + av[ac] = s = out; + + /* scan arg */ + + while (TRUE) + {if (c == 0) break; + if (quoteflag) + {if (c == '"') + {c = *in++; + if (c != '"') break; + } + } + else if (c == ' ') break; + if (c == QUOTE || c == ARGQUOTE) + {if (c == QUOTE) + {c = *in++; + if (c != '?' && c != '-') + *out++ = QUOTE; + } + else c = *in++; + if (c == 0) break; + } + *out++ = c; + c = *in++; + } + + *out++ = 0; + + /* check for redirection command */ + + if (ac == 0 || !riflag) firstch = -1; + switch (firstch) { + case '<': /* if there is a matching '>' then this */ + /* is not a redirection command */ + {register char *p, t; + int level; + p = s + 1; + level = 0; + while (t = *p++) + {if (t == QUOTE && *p) + {++p; continue;} + if (t == '<') ++level; + if (t == '>') + {if (level == 0) break; /* unmatched */ + --level; + } + } + if (s[1] && (t != '>')) cinfn = s+1; + else if (++ac < MAXARG) av[ac] = out; + } + break; + case '>': + if (secondch == '>') + {if (s[2]) + {coutfn = s + 2; + append = TRUE; + } + } + else {if (s[1]) + {coutfn = s + 1; + append = FALSE; + } + } + break; + case '%': + if (secondch == '%') + {if (s[2]) + {cerrfn = s + 2; + errappend = TRUE; + } + } + else {if (s[1]) + {cerrfn = s + 1; + errappend = FALSE; + } + } + break; + default: + /* normal argument */ + if (++ac < MAXARG) av[ac] = out; + } + + if (c == 0) break; + } + return (ac > MAXARG ? MAXARG : ac); + } + +/********************************************************************** + + SETIO - Setup standard I/O + +**********************************************************************/ + +setio () + + {register int f; + closall (); + if (cinfn) /* input is redirected */ + {fix_primary_io (cin, f = c0open (cinfn, 'r')); + if (f == OPENLOSS) cinfn = 0; + } + if (!cinfn) fix_primary_io (cin, c0open ("", 'r')); + if (coutfn) /* output is redirected */ + {f = c0open (coutfn, append ? 'a' : 'w'); + fix_primary_io (cout, f); + if (f == OPENLOSS) + {errout ("Can't open specified output file."); + coutfn = 0; + } + } + if (!coutfn) fix_primary_io (cout, c0open ("", 'w')); + if (cerrfn) /* errout is redirected */ + {f = c0open (cerrfn, errappend ? 'a' : 'w'); + fix_primary_io (cerr, f); + if (f == OPENLOSS) + {errout ("Can't open specified error file."); + cerrfn = 0; + } + } + if (!cerrfn) fix_primary_io (cerr, copen ("", 'w')); + } + +/********************************************************************** + + C0OPEN - Open with error message + +**********************************************************************/ + +channel c0open (name, mode) + + {register int f; + + f = copen (name, mode, 0); + if (f == OPENLOSS) + {errout ("Unable to "); + if (mode != 'r') errout ("write"); + else errout ("read"); + errout (" '"); + errout (name); + errout ("'\r\n"); + } + return (f); + } + +/********************************************************************** + + ERROUT - Write error message + +**********************************************************************/ + +errout (s) + char *s; + + {SYSPSOUT (mkbptr (s)); + } + +/********************************************************************** + + MKBPTR - Make byte pointer from string + +**********************************************************************/ + +int mkbptr (p) + int p; + + {return (consbp (36, p)); + } + +/**************************************************************** + + CONSBP - Make byte pointer given byte size and buffer address + +****************************************************************/ + +int consbp (bs, bp) + int bs, bp; + + {return (halves (0440000 + (bs << 6), bp));} + +/********************************************************************** + + COPEN_OPTIONS - Process mode and options. Set direction, + ftype, append, and byte size flags. + +**********************************************************************/ + +int copen_options (mode, opt, pdirection, pftype, pappend, pnew, pthaw, pbsize) + register char *opt; + int *pdirection, *pftype, *pappend, *pnew, *pthaw, *pbsize; + + {register int c, x; + + if (mode < 'A' || mode > 'z') mode = 'r'; + c = opt; + x = 0; + if (c < 0100 || c >= halves (1, 0)) opt = ""; + else {while (*opt >= '0' && *opt <= '9') + x = x * 10 + (*opt++ - '0'); + if (x < 1 || x > 36) x = 0; /* ignore bad value */ + if (opt[0]<'A' || opt[0]>'z') opt = ""; + } + + *pdirection = FREAD; + *pappend = FALSE; + *pnew = FALSE; + *pthaw = FALSE; + *pftype = FTEXT; + *pbsize = 7; + switch (lower (mode)) { + case 'a': *pappend = TRUE; *pdirection = FWRITE; + break; + case 'b': *pnew = TRUE; *pdirection = (FREAD | FWRITE); + break; + case 'w': *pnew = TRUE; *pdirection = FWRITE; + break; + case 'm': *pthaw = TRUE; /* fall through */ + case 'u': *pdirection = (FREAD | FWRITE); + default: break; + } + while (c = *opt++) switch (lower (c)) { + case 'b': *pftype = FBIN; *pbsize = 36; break; + case 's': *pftype = FSTR; break; + } + if (x != 0) *pbsize = x; + } + +/********************************************************************** + + CHANLIST - List of open channels. + +**********************************************************************/ + +channel chanlist; + +channel channel_allocate () + + {register channel p; + register int sz; + + sz = sizeof (*p) / sizeof (p); + p = salloc (sz); /* presumed initialized to zero */ + p->next = chanlist; + chanlist = p; + p->devtype = -1; /* for istty optimization */ + return (p); + } + +channel_free (p, bfree) + register channel p; + + {register channel q, *qq; + + qq = &chanlist; + q = *qq; + while (q) + {if (q == p) + {*qq = p->next; /* unchain */ + if (bfree) + {if (p->buf) pg_ret (p->buf); + if (p->ubuf) sfree (p->ubuf); + } + if (p != cin && p != cout && p != cerr) sfree (p); + break; + } + qq = &q->next; + q = *qq; + } + } + +fix_primary_io (statptr, dynptr) + channel statptr, dynptr; + + {register channel q, *qq; + if (dynptr == OPENLOSS) return; + smove (dynptr, statptr, sizeof (*statptr)); + channel_free (dynptr, FALSE); + statptr->next = chanlist; + chanlist = statptr; + } + +/********************************************************************** + + CLOSALL + +**********************************************************************/ + +closall () + + {while (chanlist) cclose (chanlist); + } + +/********************************************************************** + + CISFD + +**********************************************************************/ + +int cisfd (p) + channel p; + + {register channel q; + + q = chanlist; + while (q) + {if (q == p) return (TRUE); + q = q->next; + } + return (FALSE); + } + +/********************************************************************** + + USERNAME + +**********************************************************************/ + +char *username () + + {static char buffer[40]; + register int p; + int un; + + p = &un; + p |= halves (0777777, 0); + SYSGJI (-1, p, 2); /* GETJI - read user number */ + SYSDIRST (mkbptr (buffer), un); + return (buffer); + } + +/********************************************************************** + + VALRET - return "command string" to superior + +**********************************************************************/ + +# ifdef TOPS20 +valret (s) char *s; + + {SYSRSCAN (mkbptr (s)); /* put string in RSCAN buffer */ + SYSRSCAN (0); /* attach RSCAN buffer to terminal input */ + _HALTF (); /* return control to superior */ + } +# endif TOPS20 + +/********************************************************************** + + SLEEP (nsec) + +**********************************************************************/ + +sleep (nsec) + + {SYSDSMS (nsec * 1000);} + +/********************************************************************** + + STKDMP - a dummy + +**********************************************************************/ + +stkdmp () + + {;} diff --git a/c20/pcc20lib/c20lib.cmid b/c20/pcc20lib/c20lib.cmid new file mode 100644 index 00000000..e69de29b diff --git a/c20/pcc20lib/c20lod.cmid b/c20/pcc20lib/c20lod.cmid new file mode 100644 index 00000000..e69de29b diff --git a/c20/pcc20lib/c20pip.cmid b/c20/pcc20lib/c20pip.cmid new file mode 100644 index 00000000..2d450819 --- /dev/null +++ b/c20/pcc20lib/c20pip.cmid @@ -0,0 +1,313 @@ +; +; C20PIP - TOPS-20 implementation of pipes using shared files +; +; The technique is to use a circular buffer within a shared file. The +; first few words of the file are set aside for interlocking purposes, +; with the reader and writer (there must be only one of each) each +; mapping a single page at a time. + +TITLE C20PIP +.INSRT PS:CINSRT +.INSRT PS:MINSRT + +;; OFFSETS INTO DATA STRUCTURE + +O.JFN== 0 ;; JFN OF FILE +O.HDR== 1 ;; POINTER TO HEADER PAGE +O.BUF== 2 ;; POINTER TO BUFFER PAGE +O.WRT== 3 ;; FLAG INDICATING DIRECTION +O.PTR== 4 ;; POSITION +O.SIZ== 5 ;; TOTAL SIZE + +;; OFFSETS INTO HEADER PAGE + +P.SIZE== 0 ;; TOTAL SIZE OF THE FILE (ALWAYS EVEN PAGES) +P.FREE== 1 ;; NUMBER OF FREE SLOTS (FOR WRITER) +P.USED== 2 ;; NUMBER OF WORDS AVAIL TO READER +P.FLGS== 3 ;; FLAGS + P%WCLS== 1 ;; WRITER HAS CLOSED + P%RCLS== 2 ;; READER HAS CLOSED +P.STRT== 4 ;; FIRST USED WORD + +;; MKPIPE () => RETURN ADDRESS OF NEW STRUCTURE + +CENTRY MKPIPE,[],[Q] + CALL SALLOC,[[[O.SIZ]]] + MOVEM A, Q + SETOM O.JFN(A) + CALL PGJGET,[[[1]]] + JUMPE A, MK$BD1 + MOVE B, Q + MOVEM A, O.HDR(B) + CALL PGJGET,[[[1]]] + JUMPE A, MK$BD2 + MOVE B, Q + MOVEM A, O.BUF(B) + MOVE A, B + RETURN +MK$BD2: MOVE B, Q + MOVE B, O.HDR(B) + CALL PGJRET,[B] +MK$BD1: CALL SFREE,[Q] + MOVNI A, 1 + RETURN + +;; SPIPE (PIPE, JFN, WRITING, SIZE) +;; SETUP GIVEN PIPE TO USE STATED JFN AND DIRECTION +;; SIZE IS SIZE OF PIPE IF WRITING, IGNORED IF READING + +CENTRY SPIPE,[PIPE,JFN,WRITING,SIZE] + MOVE A, PIPE + SKIPL O.JFN(A) ; SHOULD BE IN NEWLY ALLOCATED STATE + JRST S$BAD + MOVE B, JFN + MOVEM B, O.JFN(A) + SKIPE WRITING + JRST SWRITE + SETZM O.WRT(A) +SRTRY: HRLZ A, JFN + FFUFP ; WAIT UNTIL PAGE 0 EXISTS + CAIA + JRST SPMAP + MOVEI A, 100. ; WAIT FOR WRITER + DISMS + JRST SRTRY + +SPMAP: HRLZ A, JFN ; MAP IN FIRST PAGE + MOVE B, PIPE + MOVE B, O.HDR(B) + LSH B, -9. + HRLI B, .FHSLF + MOVSI C, (PM%RD\PM%WR) ; READ/WRITE ACCESS + PMAP + ERJMP S$BAD + MOVE B, PIPE + MOVE B, O.BUF(B) + LSH B, -9. + HRLI B, .FHSLF + PMAP ; MAP TO BUFFER SLOT, TOO + ERJMP S$BAD + MOVE A, PIPE + MOVEI B, P.STRT + MOVEM B, O.PTR(A) + MOVEI A, 1 + RETURN + +SWRITE: SETOM O.WRT(A) + MOVE B, O.HDR(A) + MOVE C, SIZE + ADDI C, 777 ; ROUND UP + TRZ C, 777 + MOVEM C, P.SIZE(B) ; INIT HEADER + SUBI C, P.STRT + MOVEM C, P.FREE(B) + SETZM P.USED(B) + SETZM P.FLGS(B) + MOVEI A, (B) ; MAP THE PAGE OUT + LSH A, -9. + HRLI A, .FHSLF + HRLZ B, JFN + MOVSI C, (PM%RD\PM%WR) + PMAP + ERJMP S$BAD + JRST SPMAP + +S$BAD: MOVEI A, 0 + RETURN + +;; RDPIPE (PIPE, BP, MAX) +;; READS UP TO MAX UNITS INTO GIVEN BYTE POINTER +;; RETURNS NUMBER READ; MUST BE > 0 UNLESS EOF + +CENTRY RDPIPE,[PIPE,BP,MAX] + MOVE A, PIPE + SKIPN O.WRT(A) + SKIPG MAX + JRST RD$BAD + MOVN C, O.PTR(A) ; HOW MUCH LEFT IN CURRENT PAGE ? + ANDI C, 777 + JUMPN C, RDSOME + MOVE B, O.HDR(A) ; GET NEXT PAGE + MOVE C, O.PTR(A) + CAMGE C, P.SIZE(B) ; WRAP AROUND ? + JRST RNWRAP + MOVEI C, P.STRT ; YES + MOVEM C, O.PTR(A) +RNWRAP: LSH C, -9. + MOVE B, O.BUF(A) + LSH B, -9. + HRLI B, .FHSLF + HRL A, O.JFN(A) + HRRI A, (C) + MOVSI C, (PM%RD\PM%WR) + PMAP + ERJMP RD$BAD + MOVE A, PIPE + MOVE B, O.PTR(A) + ANDI B, 777 + MOVEI C, 1000 + SUBI C, (B) +RDSOME: CAMLE C, MAX ; MORE THAN REQUESTED ? + MOVE C, MAX + MOVE B, O.HDR(A) ; SEE HOW MUCH AVAILABLE +RDWAIT: SKIPE D, P.USED(B) + JRST RDCONT + MOVEI A, P%WCLS ; WRITER DONE ? + TDNE A, P.FLGS(B) + JRST RDEOF ; YEP ... + MOVEI A, 100. ; WAIT A LITTLE + DISMS + MOVE A, PIPE + JRST RDWAIT + +RDCONT: CAMLE C, D ; MIN AGAIN + MOVE C, D + MOVE D, O.PTR(A) ; BLT DATA + ANDI D, 777 + ADD D, O.BUF(A) + HRLI D, (D) + HRR D, BP ; GET DEST + ADD C, BP + BLT D, -1(C) + SUB C, BP + MOVN D, C + ADDM D, P.USED(B) ; DECREMENT AMOUNT USED + ADDM C, P.FREE(B) ; INCREMENT AMOUNT FREE + ADDM C, O.PTR(A) ; BUMP POINTER + MOVEI A, (C) ; RETURN AMOUNT TRANSFERRED + RETURN + +RDEOF: TDZA A, A ; GOT NONE +RD$BAD: MOVNI A, 1 + RETURN + +;; WRPIPE (PIPE, BP, AMT) +;; WRITES GIVEN AMT TO GIVEN PIPE FROM BYTE POINTER BP + +CENTRY WRPIPE,[PIPE,BP,AMT] +WRLOOP: MOVE A, PIPE + SKIPE O.WRT(A) + SKIPG AMT + JRST WR$BAD + MOVN C, O.PTR(A) ; HOW MUCH LEFT IN CURRENT PAGE ? + ANDI C, 777 + JUMPN C, WRSOME + MOVE B, O.HDR(A) ; GET NEXT PAGE + MOVE C, O.PTR(A) + CAMGE C, P.SIZE(B) ; WRAP AROUND ? + JRST WNWRAP + MOVEI C, P.STRT ; YES + MOVEM C, O.PTR(A) +WNWRAP: LSH C, -9. + MOVE B, O.BUF(A) + LSH B, -9. + HRLI B, .FHSLF + HRL A, O.JFN(A) + HRRI A, (C) + MOVSI C, (PM%RD\PM%WR) + PMAP + ERJMP WR$BAD + MOVE A, PIPE + MOVE B, O.PTR(A) + ANDI B, 777 + MOVEI C, 1000 + SUBI C, (B) +WRSOME: CAMLE C, AMT ; MORE THAN REQUESTED ? + MOVE C, AMT + MOVE B, O.HDR(A) ; SEE HOW MUCH AVAILABLE +WRWAIT: SKIPE D, P.FREE(B) + JRST WRCONT + MOVEI A, P%RCLS ; READER DONE ? + TDNE A, P.FLGS(B) + JRST WREOF ; YEP ... + MOVEI A, 100. ; WAIT A LITTLE + DISMS + MOVE A, PIPE + JRST WRWAIT + +WRCONT: CAMLE C, D ; MIN AGAIN + MOVE C, D + MOVE D, O.PTR(A) ; BLT DATA + ANDI D, 777 + ADD D, O.BUF(A) + HRL D, BP + MOVEI A, (D) + ADDI A, (C) + BLT D, -1(A) + MOVE A, PIPE + MOVN D, C + ADDM D, P.FREE(B) ; DECREMENT AMOUNT FREE + ADDM C, P.USED(B) ; INCREMENT AMOUNT USED + ADDM C, O.PTR(A) ; BUMP POINTER + ADDM C, BP ; UPDATE COUNT AND BUFFER POINTER + ADDB D, AMT + JUMPN D, WRLOOP ; LOOP FOR MORE ? + MOVEI A, 1 ; RETURN OK + RETURN + +WREOF: TDZA A, A ; GOT NONE +WR$BAD: MOVNI A, 1 + RETURN + +;; CLPIPE (PIPE) +;; CLOSES THE INDICATED PIPE + +CENTRY CLPIPE,[PIPE] + MOVE A, PIPE + MOVEI C, P%RCLS + SKIPE O.WRT(A) + MOVEI C, P%WCLS + MOVE B, O.HDR(A) + IORB C, P.FLGS(B) + TRC C, P%RCLS\P%WCLS + TRNN C, P%RCLS\P%WCLS ; ARE WE SECOND TO CLOSE ? + JRST CLKILL + PUSH P, PIPE + PUSHJ P, CUNMAP ; NO, UNMAP AND CLOSE + POP P, A + MOVE A, O.JFN(A) + CLOSF + JRST CL$BAD +CLCLR: MOVE A, PIPE + MOVE A, O.HDR(A) + CALL PGJRET,[A] + MOVE A, PIPE + MOVE A, O.BUF(A) + CALL PGJRET,[A] + CALL SFREE,[PIPE] + MOVEI A, 1 + RETURN + +CLKILL: PUSH P, PIPE + PUSHJ P, CUNMAP ; UNMAP PAGES + POP P, A + MOVE A, O.JFN(A) + HRLI A, (CO%NRJ) ; DON'T RELEASE JFN + CLOSF + JRST CL$BAD + HRLI A, (DF%EXP) + DELF ; DELETE AND EXPUNGE FILE + JRST CL$BAD + JRST CLCLR + +CUNMAP: MOVNI A, 1 ; UNMAP PAGES FROM FORK + MOVE B, -1(P) ; GET PIPE POINTER + MOVE B, O.HDR(B) + LSH B, -9. + HRLI B, .FHSLF + MOVEI C, 0 + PMAP + ERJMP CL$BD1 + MOVE B, -1(P) + MOVE B, O.BUF(B) + LSH B, -9. + HRLI B, .FHSLF + PMAP + ERJMP CL$BD1 + POPJ P, +CL$BD1: POP P, A ; FLUSH INNER RETURN ADDRESS + POP P, A ; AND ARGUMENT +CL$BAD: MOVEI A, 0 + RETURN + +END diff --git a/c20/pcc20lib/c20run.cmid b/c20/pcc20lib/c20run.cmid new file mode 100644 index 00000000..1b9f412a --- /dev/null +++ b/c20/pcc20lib/c20run.cmid @@ -0,0 +1,237 @@ +; +; C20RUN - BASIC C RUN-TIME SUPPORT (TOPS20) +; + +TITLE C20RUN +.INSRT SS:CINSRT +.INSRT SS:MINSRT + +.GLOBAL A,B,C,D,EP,P +.GLOBAL ARGC,ARGV,SEG3HI,FNWORDS +.GLOBAL CHNTAB,PRCTAB,LOWLIM,HILIM + +PDLSIZ==20000 ; DESIRED PDL SIZE + +; +; START-UP ROUTINE +; + +IENTRY BEG ; START FROM DDT + + MOVE A,[440700,,[0]] ; NULL STRING + RSCAN ; SET RSCAN BUFFER TO NULL + +IENTRY START + + RESET + + ;SET UP PDLOV HANDLER + + MOVEI 1,400000 + MOVE 2,[LEVTAB,,CHNTAB] + SIR + MOVEI 1,400000 + EIR + MOVEI 1,400000 + MOVE 2,[000400,,000000] + AIC + + SKIPE LOWLIM ; If restarting, don't init free storage + JRST R1 ; system. + MOVE P,PDLBOT ; STACK + MOVEI EP,(P) + SKIPN A,SEG3HI ;[PLB] ALWAYS 0 WITH DECSEG.MAC & LINK + HRRZ A,115 ;[PLB] GET .JBHRL (SYMBOL TABLE INCLUDED) + ADDI A,1000 + LSH A,-9. + MOVEM A,LOWLIM + MOVEI A,1000 + MOVEM A,HILIM + MCALL AINIT + +R1: MOVE P,PDLBOT ; STACK + MOVEI EP,(P) + MCALL $SETUP + +IENTRY RESTART + MOVE P,PDLBOT + MOVEI EP,(P) + CALL MAIN,[ARGC,[[ARGV]]] + CALL CEXIT,[[[0]]] + +IENTRY .EXIT + + MOVE C,A ; SAVE RETURN CODE + SETO A, + CLOSF ; CLOSE ALL FILES + JFCL + MOVE A,C + HALTF ; COMMIT SUICIDE + GO .-1 ; DON'T ALLOW RESTARTING + +IENTRY PDLSRV + DEBRK + + +; +; EXIT ROUTINES +; + +CENTRY CEXIT,[CC] + CALL CLOSALL ; CLOSE ALL C FILES + MOVE A,CC + GO .EXIT + +CENTRY CQUIT,[CC] + CALL CEXIT,[CC] + + +IENTRY CFIX + MOVM 0,-1(P) + FADR 0,[.499999] + FIX 0,0 + SKIPGE -1(P) + MOVNS 0 + MOVEM 0,-1(P) + POPJ P, + +IENTRY CFLOAT + FLTR 0,-1(P) + MOVEM 0,-1(P) + POPJ P, + +; IMPURE AREA + +.IDATA +TIMING: BLOCK 1 ; TIMING FLAG +EXITER: BLOCK 1 ; EXIT ROUTINE (FOR TIMING) +PDL: BLOCK PDLSIZ ; THE STACK + +CHNTAB: 0,,INTR0 + 0,,INTR1 + 0,,INTR2 + 0,,INTR3 + 0,,INTR4 + 0,,INTR5 + 0,,INTR6 + 0,,INTR7 + 0,,INTR8 + 1,,PDLSRV ; PDLOV HANDLER + 0,,INTR10 + 0,,INTR11 + 0,,INTR12 + 0,,INTR13 + 0,,INTR14 + 0,,INTR15 + 0,,INTR16 + 0,,INTR17 + 0,,INTR18 + 0,,INTR19 + 0,,INTR20 + 0,,INTR21 + 0,,INTR22 + 0,,INTR23 + 0,,INTR24 + 0,,INTR25 + 0,,INTR26 + 0,,INTR27 + 0,,INTR28 + 0,,INTR29 + 0,,INTR30 + 0,,INTR31 + 0,,INTR32 + 0,,INTR33 + 0,,INTR34 + 0,,INTR35 +.CODE +INTR0: JSR INTR +INTR1: JSR INTR +INTR2: JSR INTR +INTR3: JSR INTR +INTR4: JSR INTR +INTR5: JSR INTR +INTR6: JSR INTR +INTR7: JSR INTR +INTR8: JSR INTR + JSR INTR +INTR10: JSR INTR +INTR11: JSR INTR +INTR12: JSR INTR +INTR13: JSR INTR +INTR14: JSR INTR +INTR15: JSR INTR +INTR16: JSR INTR +INTR17: JSR INTR +INTR18: JSR INTR +INTR19: JSR INTR +INTR20: JSR INTR +INTR21: JSR INTR +INTR22: JSR INTR +INTR23: JSR INTR +INTR24: JSR INTR +INTR25: JSR INTR +INTR26: JSR INTR +INTR27: JSR INTR +INTR28: JSR INTR +INTR29: JSR INTR +INTR30: JSR INTR +INTR31: JSR INTR +INTR32: JSR INTR +INTR33: JSR INTR +INTR34: JSR INTR +INTR35: JSR INTR + +; Note: only one level of interrupts permitted (level 3)! + +INTR: 0 ; Clobbered by JSR + MOVEM 0,INTSAV ; Save registers + MOVEI 0,INTSAV+1 + HRLI 0,1 + BLT 0,INTSAV+P-1 + HRRZ 1,INTR ; Save interrupt number + SUBI 1,INTR0+1 + MOVEM 1,INTNUM + PUSHJ P,@PRCTAB(1) ; Call routine + HRLI 0,INTSAV+1 + HRRI 0,1 + BLT 0,P-1 + MOVE 0,INTSAV + SETZM INTNUM + DEBRK + +MENTRY DISMISS + SKIPN INTNUM + JRST DS$1 + MOVEI B,DS$1 + HRLI B,010000 ; Turn on user-mode bit + MOVEM B,PCLEV3 + SETZM INTNUM + DEBRK +DS$1: RETURN + +.IDATA +LEVTAB: PCLEV1 + PCLEV2 ; not used currently + PCLEV3 +PCLEV1: BLOCK 1 +PCLEV2: BLOCK 1 +PCLEV3: BLOCK 1 +INTSAV: BLOCK P ; registers 0 thru P-1 +PDLBOT: PDL +PDLTOP: PDL+PDLSIZ-1 +PRCTAB: 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 + 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 + 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 ? 0 +INTNUM: 0 +LOWLIM: 0 +HILIM: 0 +.PDATA +PZERO: PUSH P,ZERO +ZERO: 0 +PUSHD: PUSH P,D + +CONSTANTS + +PATCH: + +END START diff --git a/c20/pcc20lib/c20std.c b/c20/pcc20lib/c20std.c new file mode 100644 index 00000000..67d18318 --- /dev/null +++ b/c20/pcc20lib/c20std.c @@ -0,0 +1,392 @@ +# include +# include + +/********************************************************************** + + STDIO.C - 'Standard I/O' Simulator + + Note: Must # include . + To link with STINKR, say X STDIO instead of X CLIB. + ** Not complete. ** + + Routines implemented, either here, by redefinition (in STDIO.H), + or in the default TOPS-20 library: + + fileptr = fopen (name, mode) + fileptr = freopen (name, mode, fileptr) + c = getc (fileptr) + c = fgetc (fileptr) + i = getw (fileptr) + c = putc (c, fileptr) + c = fputc (f, fileptr) + fclose (fileptr) + fflush (fileptr) + exit (errcode) + b = feof (fileptr) + c = getchar () + putchar (c) + s = gets (s) + s = fgets (s, n, fileptr) + puts (s) + fputs (s, fileptr) + putw (i, fileptr) + ungetc (c, fileptr) + printf (format, a1, ...) + fprintf (fileptr, format, a1, ...) + sprintf (buf, format, a1, ...) + scanf (format, a1, ...) + fscanf (fileptr, format, a1, ...) + sscanf (s, format, a1, ...) + fread (ptr, itemsize, nitems, fileptr) these use cgeti, cputi + fwrite (ptr, itemsize, nitems, fileptr) +** fcread (ptr, itemsize, nitems, fileptr) these use cgetc, cputc +** fcwrite (ptr, itemsize, nitems, fileptr) + rewind (fileptr) + fileno (fileptr) + fseek (fileptr, offset, mode) + i = ftell (fileptr) + atof (s) (in ATOI.C) + ftoa (d, s, p, f) (in ATOI.C) + unlink (s) + i = strcmp (s1, s2) + strcpy (dest, source) + strcat (dest, source) + i = strlen (s) + b = isalpha (c) + b = isupper (c) + b = islower (c) + b = isdigit (c) + b = isspace (c) + c = toupper (c) + c = tolower (c) + uid = getuid () + buf = getpw (uid, buf) + - writes user name into buf + time (int[2]) + - write current time into array + s = ctime (int[2]) + - convert time to string format + p = calloc (num, size) + cfree (ptr) (in ALLOC.C) + + Routines not implemented: + + ferror, system, tmpnam, abort, intss, wdleng, nargs, setbuf, gcvt + + See CPRINT.C for information about PRINTF formats. + +** = hack routines to provide functionality not otherwise available + +**********************************************************************/ + +extern int cin, cout, cerr; + +stdio () {;} /* for historical reasons */ + +FILE *fopen (name, mode) /* this is renamed */ + char *name, *mode; + + {register int f; + f = copen (name, *mode, mode + 1); + if (f == OPENLOSS) return (NULL); + return (f); + } + +char fgetc (f) + + {register char c; + if ((c = cgetc (f)) == 0 && ceof (f)) return (EOF); + return (c); + } + +char getchar () /* this is renamed */ + + {return (fgetc (cin));} + +char peekc (f) + + {int c; + if ((c = cgetc (f)) == 0 && ceof (f)) return (EOF); + ungetc (c, f); + return (c); + } + +char pkchar () + + {return (peekc (cin));} + +char *gets (s) + char *s; + + {register char c, *sp; + sp = s; + while ((c = fgetc (stdin)) != EOF) + if (c == '\n') break; + else *sp++ = c; + *sp = 0; + if (c == EOF && sp == s) return (NULL); + return (s); + } + +char *fgets (s, n, f) + char *s; + FILE *f; + + {register char *sp; + register int c; + sp = s; + while (--n > 0 && (c = fgetc (f)) != EOF) + if ((*sp++ = c) == '\n') break; + *sp = 0; + if (c == EOF && sp == s) return (NULL); + return (s); + } + +fputs (s, f) + char *s; + FILE *f; + + {register int c; + while (c = *s++) fputc (c, f); + } + +printf (a, b, c, d, e, f, g, h, i, j, k, l, m, n) + {cprint (cout, a, b, c, d, e, f, g, h, i, j, k, l, m, n);} + +fprintf (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) /* this is renamed */ + {cprint (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o);} + +sprintf (s, a, b, c, d, e, f, g, h, i, j, k, l, m, n) + char *s; + {register int fp; + fp = copen (s, 'w', "s"); + cprint (fp, a, b, c, d, e, f, g, h, i, j, k, l, m, n); + cclose (fp); + } + +pscanf (fmt, a, b, c, d, e, f, g, h, i, j, k, l, m) + char *fmt; + {return (cscanf (cin, fmt, a, b, c, d, e, f, g, h, i, j, k, l, m)); + } + +fscanf (fp, fmt, a, b, c, d, e, f, g, h, i, j, k, l, m) + FILE *fp; char *fmt; + {return (cscanf (fp, fmt, a, b, c, d, e, f, g, h, i, j, k, l, m)); + } + +sscanf (s, fmt, a, b, c, d, e, f, g, h, i, j, k, l, m) + char *s, *fmt; + {int fp, result; + fp = copen (s, 'r', "s"); + result = cscanf (fp, fmt, a, b, c, d, e, f, g, h, i, j, k, l, m); + cclose (fp); + return (result); + } + +fclose (f) {cclose (f);} + +getw (f) + FILE *f; + + {int i; + i = cgeti (f); + if (ceof (f)) return (EOF); + return (i); + } + +fread (buf, size, number, f) + int *buf; + FILE *f; + + {register int i, j, k; + for (i = 0; i < number; ++i) + {j = size; + while (--j >= 0) + {k = cgeti (f); + if (ceof (f)) return (i); + *buf++ = k; + } + } + return (i); + } + +fwrite (buf, size, number, f) + register int *buf, size; + FILE *f; + + {size *= number; + while (--size >= 0) cputi (*buf++, f); + return (number); + } + +fcread (buf, size, number, f) + char *buf; + FILE *f; + + {register int i, j, k; + for (i = 0; i < number; ++i) + {j = size; + while (--j >= 0) + {k = cgetc (f); + if (ceof (f)) return (i); + *buf++ = k; + } + } + return (i); + } + +fcwrite (buf, size, number, f) + register char *buf; + register int size; + FILE *f; + + {size *= number; + while (--size >= 0) cputc (*buf++, f); + return (number); + } + +FILE *freopen (name, mode, f) + char *name, *mode; + + {int i; + cclose (f); + i = copen (name, *mode, mode + 1); + if (i == OPENLOSS) return (NULL); + return (i); + } + +fileno (f) + FILE *f; + {return (cjfn (f)); + } + +/********************************************************************** + + STRING ROUTINES + +**********************************************************************/ + +strcmp (s1, s2) + register char *s1, *s2; + + {register int c1, c2; + while ((c1 = *s1++) == (c2 = *s2++) && c1); + if (c1 < c2) return (-1); + else if (c1 == 0) return (0); + else return (1); + } + +strcpy (dest, source) + char *dest, *source; + + {stcpy (source, dest);} + +strcat (dest, source) + register char *dest; + char *source; + + {while (*dest) ++dest; + stcpy (source, dest); + } + +int strlen (s) + char *s; + + {register char *e; + e = s; + while (*e) ++e; + return (e - s); + } + +/********************************************************************** + + CHARACTER ROUTINES + +**********************************************************************/ + +int isalpha (c) + char c; + + {return ((c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z'));} + +int isupper (c) + char c; + + {return (c >= 'A' && c <= 'Z');} + +int islower (c) + char c; + + {return (c >= 'a' && c <= 'z');} + +int isdigit (c) + char c; + + {return (c >= '0' && c <= '9');} + +int isspace (c) + char c; + + {return (c == ' ' || c == '\t' || c == '\n' || c == '\p');} + +int tolower (c) + char c; + + {if (c >= 'A' && c <= 'Z') c += ('a' - 'A'); + return (c); + } + +int toupper (c) + char c; + + {if (c >= 'a' && c <= 'z') c -= ('a' - 'A'); + return (c); + } + +/********************************************************************** + + OBSCURE ROUTINES + +**********************************************************************/ + +int getuid () + + {int un, x; + SYSGJI (-1, halves (0777777, x = &un), 2); + /* GETJI - read user number */ + return (un); + } + +char *getpw (un, buf) + char *buf; + + {SYSDIRST (mkbptr (buf), un); + return (buf); + } + +nowtime (tv) + int tv[]; + + {cal foo; + now (&foo); + tv[0] = tv[1] = cal2f (&foo); + } + +char *ctime (tv) int tv[]; + + {static char buf[100]; + cal foo; + int f; + f2cal (tv[0], &foo); + f = copen (buf, 'w', "s"); + prcal (&foo, f); + cputc ('\n', f); + cclose (f); + return (buf); + } + +unlink (s) {delete (s);} +exit (cc) {cexit (cc);} +fflush (f) {cflush (f);} +rewind (f) {rew(f);} +char *calloc (num, size) {return (salloc (num*size));} diff --git a/c20/pcc20lib/c20sys.cmid b/c20/pcc20lib/c20sys.cmid new file mode 100644 index 0000000000000000000000000000000000000000..9d8ccaa1bf5c088c472f738e9316d92cf0ba8270 GIT binary patch literal 6641 zcmcgx&2pSL5Y82zfm2stLH)1( zmE`CAIg?M{%&RHB7Wiw``Kv7ZzGw%lbW=)YiU&JR=IPs){5j8UYkO5Vj{L87FxnQz zeE(biBYANPJ3Ck|)nN5&2KfiuHG_C>`to4JP@dJVJkQSKRb{1M;Jm6BnP*I&XGPb@ zKFgkqUX@o>D6L0b$gx(ivncaSD|^vH9xEDH(XkxrK33uY5KQ=4aEgDN)X<1`62f*x zb}}Q|TzQ+B8q#Fh!kVHWY>O>@ONlnkWVI7ry;?PlcVs(co-zGec##&agY30X#z2Zu zcFZafyk4bDtXc%gj2A6q-#I{@0lULKUaWYpm9c_05t%};5MshX8i-Rin8gM`4wK_$ zu)?kcdYk5WfN&Ns9mBk;9V46>*)Ef6*>;NieWh^*>}%xx%{jhR*KyZAyN#7*C`6DeVtZ;4gKT* z!zWm-ba$SL{weRDzI*GFey*?bIQPM8*_&t!oH2}^_g@R5aEmi?@S*@j)rY z50Lql#7ZXTzLuj5n}Vx!1Hj5t4i=R8p?@dx+gO{G4s)wxndwm`WpN^*2XVnV#`I065 zi3mHDbCcc|LA0q2X|S>xTeZh@GpTvu_sK;4_WIBY4wXV{#(~~SQYwuY~*p#VqX?DoU zgzwai+>hGI+^L|-rmgNAlL(VwIoPJITslgW7`4O5XK_{&I{1vgnKvQR$YT(CF3m|8 zduf_GVu>J#Wx_mT{*>Ta^?rLkG1)|d-y8THkTtk?d|~$Cgzb6V;FxoQP-p-|oKkHj zXhLf}iV2sX2^WM#&UDPPqwX=|fTK@MpM1w)wv@bsmv<|M!Ha<#&Q3NX%Es-c>Q4*z z&1Qgs8;SI;TV9-?>9~lXeK2^d_LQb(@Rr(mYGKM-@w2lH?lDZX<<*||mXX0*YJ<|m z`2=CX3=e*zjm(;8SToU-2oh`r z2Cp9qqt~6(>H9MpRJil;`ult&OdN;1gThg3YaN4w&O{&5c<*r)^+>}L{n8tVm2Z(1 zqu>!DhK>6#D!4h;WshScY6|;)p_HA5i%~UxCZ%yu^?F>{F};J)UE+u1@qmf|#O(oe zQeipUFdaI$7M=h(x*4R4$(_rcRz`ad9z3Q5?? zH9kwk^<{}bR4i8vUM9NRHR$~jhbYwBP4kIlaO+{RgaQAJ+Ys57`&jlC`8WTpgP_@I z)Sr=ZC2lFylHZU_WE-_)e9^(3Jwsujlj#poZWS3o-6kOmpZ8?VEryL{o~@{|MOlX9 zgAX8|b7t;v!fA1u#WM&vLLb04^#P(J>|@RVcZH|7%m=x>Hg)xfRe~d^#P_XA2JEP8 zKdcfQK_$L#RWe{lWodEahVPa<-Z;{>K?SI9RWM*j1umaEDnJob;QLku19ns>^e0M> zWfvhe=5zo>P=W7T6%5!>K`rq2D!Ap%lLz0oDj2Y%!knhG5=OxMFvy~Jc;xk_ge5Mo zTW@HY=(+mE(TZMOqq)lN1I{;XlsFM=b-k1==B@j?wqw$zK8W|9;#IsYk@*=KIUWPK pc%{ITArprXP5Lwb6M`;!YA1S`mAQjpc!Oo2qK!7LhC2WB>0bnu5Jdn0 literal 0 HcmV?d00001 diff --git a/c20/pcc20lib/c20tty.c b/c20/pcc20lib/c20tty.c new file mode 100644 index 00000000..5541ba58 --- /dev/null +++ b/c20/pcc20lib/c20tty.c @@ -0,0 +1,278 @@ +# include + +/********************************************************************** + + TOPS-20 Display Terminal Hacking + + isdisplay () => bool return true if terminal is known display + dpytype () => int return terminal type code + utyi () => c read character without echoing + tyo (c) output character (buffered) + utyo (c) output character (unbuffered) + tyos (s) output string by repeated tyo (c) + tyo_flush () flush output buffer + spctty (c) perform display function: + C: clear screen + T: move cursor to top of screen + L: erase to end-of-line + E: erase to end-of-screen + D: move cursor down + K: erase next character (avoid overprinting) + B: backspace + dpymove (ln, cn) Move cursor to given LineNumber and + ColumnNumber (<0,0> is top) + dpyreset () Restore original terminal mode. + dpyinit () Forces later re-initialization by resetting + flags + + Note: use of any display routine changes the terminal mode to allow + escape sequences to be output and turns page mode off. Dpyreset should + be called to reset the terminal to its original state before + termination. + + Output is normally buffered. The output buffer is flushed implicitly by + UTYI, UTYO, and DPYRESET, and is flushed explicitly by TYO_FLUSH. + UTYI does image input, but you must turn page mode on/off yourself if + you care about it. + +**********************************************************************/ + +# ifdef TOPS20 +# define IMLAC 4 /* not a standard code */ +# define DATAMEDIA 100 /* non-existent */ +# define HP264X 6 /* standard ? */ +# define VT52 15 +# define VT100 18 /* currently implemented as a VT52 */ +# define HEATH 20 /* currently implemented as a VT52 */ +# define HP262X 21 /* non-standard: implemented as HP264X */ +# endif + +# ifdef TENEX +# define IMLAC 10 /* not a standard code */ +# define DATAMEDIA 11 /* At SUMEX-AIM */ +# define HEATH 18 /* currently implemented as a VT52 */ +# define HP264X 101 /* these are not defined ... */ +# define VT52 102 +# define VT100 103 +# define HP262X 104 +# endif + +static int ttype; /* terminal type */ +static int dflag; /* is-display flag */ +static int iflag; /* own variable initialization flag */ +static int cflag; /* mode flag: TRUE => control-chars mode */ +static int omode; /* original terminal mode */ + +# define TYOSIZ 1000 +static char tyobuf[TYOSIZ], *ctyop {tyobuf}; + +# define PRIIN 0100 +# define PRIOU 0101 + +dpysetup () + + {/* NOTE: This is called ONLY by C20IO, to make sure things are + cool in a dumped and restarted program, etc. */ + cflag = FALSE; + iflag = FALSE; + } + +int isdisplay () + + {if (iflag) return (dflag); + /* own variable initialization */ + iflag = TRUE; + ttype = SYSGYP (PRIOU); + dflag = (ttype == HP264X || ttype == VT52 || ttype == HP262X || + ttype == IMLAC || ttype == VT100 || ttype == HEATH || + ttype == DATAMEDIA); + if (!dflag) return (FALSE); + if (ttype == HEATH) + {dpyon (); + tyos ("\033<\033[?2h"); + dpyreset (); + /* put into Heath (VT52 compatible) mode */ + ttype = VT52; + } + else if (ttype == HP262X) ttype = HP264X; + else if (ttype == VT100) + /* VT100 now implemented only as a VT52 */ + {dpyon (); + tyos ("\033<\033[?2l"); + dpyreset (); + /* put it in VT52 mode */ + ttype = VT52; /* pretend it's a VT52 */ + } +# if 0 + if (ttype == VT100) + /* (someday) make sure its in ANSI mode */ + {dpyon (); + tyos ("\033<"); + dpyreset (); + } +# endif + return (TRUE); + } + +int dpytype () + + {if (!iflag) isdisplay (); + return (ttype); + } + +dpyinit () + + {if (iflag) + {dpyreset (); + iflag = FALSE; + } + } + +dpyreset () + + {if (!iflag) isdisplay (); + tyo_flush (); + if (cflag) + {/* restore mode */ + SYSDOBE (PRIOU); + _SFMOD (PRIOU, omode); + _STPAR (PRIOU, omode); + cflag = FALSE; + } + } + +dpyon () + + {if (!iflag) isdisplay (); + tyo_flush (); + if (!cflag) + /* binary mode (no translation), but leave page mode alone */ + {int nmode; + omode = _RFMOD (PRIOU); + nmode = omode & ~04300; /* no echo, binary */ + SYSDOBE (PRIOU); + _SFMOD (PRIOU, nmode); + cflag = TRUE; + } + } + +int dpymove (ln, cn) + + {char buf[10]; + if (!iflag) isdisplay (); + if (!cflag) dpyon (); + switch (ttype) { + case IMLAC: + tyos ("\177\021"); tyo (++ln); tyo (++cn); + return; + case HP264X: + tyos ("\033&a"); + itoa (ln, buf); tyos (buf); tyo ('r'); + itoa (cn, buf); tyos (buf); tyo ('C'); + return; + case VT100: + tyos ("\033["); + if (ln > 0) {itoa (++ln, buf); tyos (buf);} + tyo (';'); + if (cn > 0) {itoa (++cn, buf); tyos (buf);} + tyo ('H'); + return; + case VT52: + tyos ("\033Y"); tyo (ln + 32); tyo (cn + 32); + return; + case DATAMEDIA: /* do ^L col XOR 0140, row XOR 0140 */ + tyo ('\014'); tyo (cn ^ 0140); tyo (ln ^ 0140); + return; + } + } + +spctty (c) + + {if (!iflag) isdisplay (); + if (!cflag) dpyon (); + switch (ttype) { + case IMLAC: + tyo (0177); + switch (c) { + case 'B': tyo (0211-0176); return; + case 'C': tyo (0220-0176); return; + case 'D': tyo (0212-0176); return; + case 'E': tyo (0202-0176); return; + case 'K': tyo (0204-0176); return; + case 'L': tyo (0203-0176); return; + case 'T': tyo (0217-0176); + tyo (0+1); /* vertical */ + tyo (0+1); /* horizontal */ + return; + } + return; + case VT100: + switch (c) { + case 'B': tyos ("\033[D"); return; + case 'C': tyos ("\033[H\033[J"); return; + case 'D': tyos ("\033[B"); return; + case 'E': tyos ("\033[J"); return; + case 'K': return; + case 'L': tyos ("\033[K"); return; + case 'T': tyos ("\033[H"); return; + } + return; + case HP264X: + case VT52: + switch (c) { + case 'B': tyos ("\033D"); return; + case 'C': tyos ("\033H\033J"); return; + case 'D': tyos ("\033B"); return; + case 'E': tyos ("\033J"); return; + case 'K': return; + case 'L': tyos ("\033K"); return; + case 'T': tyos ("\033H"); return; + } + return; + case DATAMEDIA: + switch (c) { + case 'B': tyo ('\010'); return; + case 'C': tyos ("\002\037"); return; + case 'D': tyo ('\012'); return; + case 'E': tyo ('\037'); return; + case 'K': tyo ('\034'); return; + case 'L': tyo ('\027'); return; + case 'T': tyo ('\002'); return; + } + return; + } + tyos ("\r\n"); + } + +tyo (c) + {*ctyop++ = c; + if (ctyop >= tyobuf + (TYOSIZ-2)) tyo_flush (); + } + +tyos (s) + register char *s; + + {register int c; + while (c = *s++) tyo (c); + } + +utyo (c) + {tyo_flush (); + SYSBOUT (PRIOU, c); + } + +int utyi () + {register char c; + if (!iflag) isdisplay (); + if (!cflag) dpyon (); + tyo_flush (); + c = SYSBIN (PRIIN); + return (c & 0177); + } + +tyo_flush () + {if (ctyop > tyobuf) + {_SOUT (PRIOU, mkbptr (tyobuf), tyobuf - ctyop, 0); + ctyop = tyobuf; + } + } diff --git a/c20/pcc20lib/cfloat.cmid b/c20/pcc20lib/cfloat.cmid new file mode 100644 index 0000000000000000000000000000000000000000..1792f1e91ebb0c18a9542b1424f4fe238daed8f2 GIT binary patch literal 2952 zcmai0S&!Q`5bi7aEBMykRMv{34$Dqk=%8gKwxme(9x-;Gx{ctj#0m4qr!V67Pk+7&eEX`O$w2(} z`uFSS-(Ej|^~9HdzI=WCYxW6Kx8_5Po5pOkn6z`hX~zLN$Hm+7m(ory*S6CdUy8D8 zO^(?@Y`WSL`my)0HhN-gT2JIA$M5)IFrKK)uxrcQXbgvL*H-xE#mIT7TQfW{lHcDy zbI!Kiy=H}X&)K`(w%^dW+nJ%QIonhPtGvBZQU-zN70+y04|zd$yB2yl8+S#6BViyJ zTMn9ZiK59z&dlZ`G^J@81OZ!)+MG$5O@}=Q**#%8A)Oz&S8%o(i-F}HT_nUTuLhhx z%&PkWdvt2s(>g}>2Bo(T{76M%oTagRcKfA0NgC{aoF?&{4*kb|mdJS!q{;X9Lw`Px zRfYp6@!UB$smHntXNC2#q+2TGjuc+$yei1oBvUdx(NYu39UY^T5=)*rX*5TX1Kmn@3r(%CBVQ41gy7PYg8JWD^o1W&S7&?AoQHVqb|AmA(?*L1O27^$25mINA$ng|yqkpp@T>*=%%_lJJ zUfvYYLRf>ZGEj=JRz5SUSz{441wkhFq=l1N+>gJz^_pgN#r-#j3g|%wqg)mTi0%hnfo%{->Hl#M{c<&Wau5Rv~WI&C09b1M0}E zwV0bVXzD=^r_J*bGGvngTv1RKO!_jGVHT!y&H&3KOjR(SM>GlJNM$NcW10kMn8h+x z38IXdOruarnPr@XejG=cOta)=1`uSv3X>>I(wAAp`IKWagFH$I((mDO{GJA9qw^t+ z`2?*6D~B$BFZTIR@3!C}fpx<2khir4gbBB%mB-2KT`zNB^Jr&=#3rR&D8CiH)^I%Q_e1Z zA!b4`IaE*`O?86$vnr1d`8MG{~_0W`~aBQBj96Ptkn;u zYjLryHtPug_y$KKxP zZGYMG$SaVgM>|%<7VQj{Y+AsH=qWF=IR$wO5D49NyLv6g&Nf?$`s1(28C)PE3U_ zN0h(IZpdj3weMVms9gcJiR5d|2t>}-WgnpYK&l-X!Jn*^9lf=PysQr8v|jXm`{W_w zj3lU5#R-SW1yjC^WSoUbtm3=ySeNdZcdSgR9z5#oJ&^`K%IJ@R)I4H~+TY|g4q4}> z#VcYvy(1^ZlQ2ZC&jF0*9BXacBv1#(VVlu*vT?aiFGc&b00VNIJdvwzEB?d3a2JOV literal 0 HcmV?d00001 diff --git a/c20/pcc20lib/clib.ccl b/c20/pcc20lib/clib.ccl new file mode 100644 index 00000000..7c8ba313 --- /dev/null +++ b/c20/pcc20lib/clib.ccl @@ -0,0 +1,31 @@ +ALLOC.REL +APFNAM.REL +ATOI.REL +BLT.REL +C20DAT.REL +C20EXC.REL +C20EXP.REL +C20FD.REL +C20FIL.REL +C20FNM.REL +C20HAK.REL +C20INT.REL +C20IO.REL +C20LIB.REL +C20LOD.REL +C20PIP.REL +C20RUN.REL +C20STD.REL +C20SYS.REL +C20TTY.REL +CFLOAT.REL +CPRINT.REL +CTYPE.REL +DATE.REL +FPRINT.REL +HALVES.REL +PR60TH.REL +RANDOM.REL +SCANF.REL +STRING.REL +STRNGP.REL diff --git a/c20/pcc20lib/clib.mic b/c20/pcc20lib/clib.mic new file mode 100644 index 00000000..384d0492 --- /dev/null +++ b/c20/pcc20lib/clib.mic @@ -0,0 +1,40 @@ +@PIP +*X.REL=AC.REL, APFNAM.REL, BLT.REL, C20DAT.REL, C20EXC.REL, C20EXP.REL, C20FD.REL, C20FIL.REL, C20FNM.REL, C20HAK.REL, C20INT.REL, C20LIB.REL, C20PIP.REL, C20TTY.REL, CFLOAT.REL, CPRINT.REL, CTYPE.REL, DATE.REL, HALVES.REL, PR60TH.REL, RANDOM.REL, SCANF.REL, STRING.REL, STRNGP.REL + +*T1.REL=C20STD.REL, C20IO.REL, C20RUN.REL, ALLOC.REL + +*T2.REL=FPRINT.REL, ATOI.REL, C20SYS.REL + +@RUN HACK +X.REL +X.REL + +@RUN HACK +T1.REL +T1.REL + +@RUN HACK +T2.REL +T2.REL + +@GLOB +*X=X + +@MAKLIB +*X.EP=X/P + +@EX CKS:RELSRT.SNO +X + +@MAKLIB +*@X + +@PIP +*NX.REL=T1.REL,NX.REL,T2.REL + +@MAKLIB +*NX=NX/NOLOC +*NX=NX/INDEX + +@DEL T1.*, T2.* +@DEL X.CCL, X.EP, X.GLB, X.REL diff --git a/c20/pcc20lib/cprint.c b/c20/pcc20lib/cprint.c new file mode 100644 index 00000000..34a987ae --- /dev/null +++ b/c20/pcc20lib/cprint.c @@ -0,0 +1,347 @@ +# include + +/* + CPRINT - C Formatted Print Routine + Extendable Format Version: + Print Routines should expect the following + arguments (n specified when defined): + 1 to n: n data arguments + n+1: file descriptor + n+2: field width (0 if none given) + n+3: pad character + + Format options: (upper case treated identically) + %s string + %c character + %o octal + %d decimal + %u unsigned (= decimal) + %x hexadecimal + %f F format floating point (without exponent, if poss) + %e E format floating point (always with exponent) + %z Like %c except repeat characters width times + If number preceeds format char (as in %4d) then number will be + minimum field width in which the argument appears. If the + number is followed by a '.' and another number, that number is + the precision (max # chars from a string, # digits to right of + decimal point in floating point numbers). + A positive field width will right justify the arg. + A negative field width will left justify. + + If a 0 immediately follows the %, then the pad character is + changed to 0 (instead of space). If the next character after the + 0 is not a digit, then the pad character is changed to that character. + For example: + %09d -- zero pad, width nine. -- 000000312 + %0*9d -- pad with *, width nine -- ******312 + %-0*9d -- left justified -- 312****** + Note that the 0 does NOT mean that the following number is octal. +*/ + +# define SMALLEST "-34359738368" + +extern int cin, cout, cerr; +int prcf(), prdf(), pref(), prff(), prof(), prsf(), prxf(), przf(); + +# define format_table fmttab +# define format_nargs fmtcnt + +static int (*format_table[26]) () { + /* a */ 0, 0, prcf, prdf, pref, prff, 0, 0, + /* i */ 0, 0, 0, 0, 0, 0, prof, 0, + /* q */ 0, 0, prsf, 0, prdf, 0, 0, prxf, + /* y */ 0, przf}; + +static int format_nargs [26] { + /* a */ 0, 0, 1, 1, 1, 1, 0, 0, + /* i */ 0, 0, 0, 0, 0, 0, 1, 0, + /* q */ 0, 0, 1, 0, 1, 0, 0, 1, + /* y */ 0, 1}; + +fmtf (c, p, n) + int (*p)(); + {if (c >= 'A' && c <= 'Z') c += ('a' - 'A'); + if (c >= 'a' && c <= 'z') + {if (n >= 0 && n <= 3) + {format_table [c - 'a'] = p; + format_nargs [c - 'a'] = n; + } + else cprint (cerr, "bad nargs to FMTF: %d\n", n); + } + else cprint (cerr, "bad character to FMTF: %c\n", c); + } + + +cprint (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) + +# ifdef snyder_compiler +# define adxsub(n) adx[n] +# define bumpadx(n) adx += n +# else +# define adxsub(n) adx[-n] +# define bumpadx(n) adx -= n +# endif + +{register int *adx, c, width, prec, n; +register char *fmt; +int rjust, fn, (*p)(); +char padc; + +if (cisfd(a1)) /* file descriptor */ + {fn = a1; + fmt = a2; + adx = &a3; + } +else {fn = cout; + fmt = a1; + adx = &a2; + } +while (c = *fmt++) + {if (c != '%') cputc (c, fn); + else {width = 0; + prec = -1; /* precision not given */ + rjust = FALSE; /* right justify off */ + padc = ' '; /* pad with a space */ + if (*fmt == '-') /* then right justify */ + {rjust = TRUE; + fmt++; + } + if (*fmt == '0') /* then change pad character */ + {fmt++; + if (*fmt >= '0' && *fmt <= '9') padc = '0'; + else padc = *fmt++; + } + while ((c = *fmt) >= '0' && c <= '9') + width = (width * 10) + (*fmt++ - '0'); + if (rjust) width = -width; + c = *fmt++; + if (c == '.') + {prec = 0; + while ((c = *fmt++) >= '0' && c <= '9') + prec = (prec * 10) + (c - '0'); + } + c = lower (c); + if (c == 'l' || c == 'h') /* accept LONG and SHORT prefixes */ + {char nc; + nc = lower (*fmt); + if (nc == 'd' || nc == 'o' || nc == 'x' || + nc == 'u' || nc == 'e' || nc == 'f') + {c = nc; + fmt++; + } + } + if (c >= 'a' && c <= 'z') + {p = format_table [c - 'a']; + n = format_nargs [c - 'a']; + if (p) + {switch (n) { + case 0: (*p) (fn, width, prec, padc); + break; + case 1: (*p) (adxsub(0), fn, width, prec, padc); + break; + case 2: (*p) (adxsub(0), adxsub(1), + fn, width, prec, padc); + break; + case 3: (*p) (adxsub(0), adxsub(1), adxsub(2), + fn, width, prec, padc); + break; + } + bumpadx (n); + continue; + } + cputc (c, fn); + } + else cputc (c, fn); + } + } +} + +/********************************************************************** + + PRZF - Print Character N Times + +**********************************************************************/ + +przf (chr, f, num, prec, padc) + register int num; + int f; + char chr, padc; + + {while (--num >= 0) cputc (chr, f); + } + +/********************************************************************** + + PROF - Print Octal Integer + +**********************************************************************/ + +prof (i, f, w, prec, padc) + register unsigned i; + int f, w; + char padc; + + {char b[30]; + register char *p; + register int nd; + + p = b; + do {*p++ = (i & 07) + '0'; + i >>= 3; + } while (i); + nd = p - b; + if (w > 0) przf (padc, f, w - nd, prec, padc); + while (p > b) cputc (*--p, f); + if (w < 0) przf (padc, f, (-w) - nd, prec, padc); + } + +/********************************************************************** + + PRDF - Print Decimal Integer + +**********************************************************************/ + +prdf (i, f, w, prec, padc) + register int i; + int f, w; + char padc; + + {char b[30]; + register char *p; + register int flag, nd; + + flag = 0; + p = b; + if (i < 0) {i = -i; flag = 1;} + if (i < 0) + {stcpy (SMALLEST, b); + p = b + slen (b); + flag = 0; + } + else {do {*p++ = i % 10 + '0'; + i /= 10; + } while (i); + } + if (flag) *p++ = '-'; + nd = p - b; + if (w > 0) przf (padc, f, w - nd, 0, padc); + while (p > b) cputc (*--p, f); + if (w < 0) przf (padc, f, (-w) - nd, 0, padc); + } + +/********************************************************************** + + PRSF - Print String + +**********************************************************************/ + +prsf (s, f, w, prec, padc) + int f, w, prec; + register char *s; + char padc; + + {register int i, nd; + nd = slen (s); + if (prec >= 0 && nd > prec) nd = prec; + prec = (w >= 0 ? w : -w) - nd; + if (prec <= 0) w = 0; + if (w > 0) przf (padc, f, prec, 0, padc); + while (--nd >= 0) cputc (*s++, f); + if (w < 0) przf (padc, f, prec, 0, padc); + } + +/********************************************************************** + + PRCF - Print Character + +**********************************************************************/ + +prcf (c, f, w, prec, padc) + int f, w; + char c, padc; + + {if (w > 0) przf (padc, f, w - 1, prec, padc); + cputc (c, f); + if (w < 0) przf (padc, f, (-w) - 1, prec, padc); + } + +/********************************************************************** + + PRXF - Print Hexadecimal + +**********************************************************************/ + +prxf (i, f, w, prec, padc) + register unsigned i; + int f, w; + char padc; + + {char b[30]; + register char *p; + register int nd; + + p = b; + do {register char c; + c = i & 017; + if (c < 10) c += '0'; + else c += ('A' - 10); + *p++ = c; + i >>= 4; + } while (i); + nd = p - b; + if (w > 0) przf (padc, f, w - nd, prec, padc); + while (p > b) cputc (*--p, f); + if (w < 0) przf (padc, f, (-w) - nd, prec, padc); + } + +/********************************************************************** + + PREF - Print Floating Point Number, E format + +**********************************************************************/ + +# rename eprint "EPRINT" + +pref (d, f, w, prec, padc) + double d; + int f, w; + char padc; + + {char b[30]; + register char *p, c; + register int nd, chn; + + if (prec < 0) prec = 6; + chn = copen (b, 'w', "s"); + nd = eprint (d, chn, prec); + cclose (chn); + if (w > 0) przf (padc, f, w - nd, prec, padc); + p = b; + while (c = *p++) cputc (c, f); + if (w < 0) przf (padc, f, (-w) - nd, prec, padc); + } + +/********************************************************************** + + PRFF - Print Floating Point Number, F format + +**********************************************************************/ + +prff (d, f, w, prec, padc) + double d; + int f, w; + char padc; + + {char b[30]; + register char *p, c; + register int nd, chn; + + if (prec < 0) prec = 6; + chn = copen (b, 'w', "s"); + nd = fprint (d, chn, prec); + cclose (chn); + if (w > 0) przf (padc, f, w - nd, prec, padc); + p = b; + while (c = *p++) cputc (c, f); + if (w < 0) przf (padc, f, (-w) - nd, prec, padc); + } diff --git a/c20/pcc20lib/ctype.c b/c20/pcc20lib/ctype.c new file mode 100644 index 00000000..927df282 --- /dev/null +++ b/c20/pcc20lib/ctype.c @@ -0,0 +1,21 @@ +#include + +char _ctype_[] = { + 0, + _C, _C, _C, _C, _C, _C, _C, _C, + _C, _S, _S, _S, _S, _S, _C, _C, + _C, _C, _C, _C, _C, _C, _C, _C, + _C, _C, _C, _C, _C, _C, _C, _C, + _S, _P, _P, _P, _P, _P, _P, _P, + _P, _P, _P, _P, _P, _P, _P, _P, + _N, _N, _N, _N, _N, _N, _N, _N, + _N, _N, _P, _P, _P, _P, _P, _P, + _P, _U|_X, _U|_X, _U|_X, _U|_X, _U|_X, _U|_X, _U, + _U, _U, _U, _U, _U, _U, _U, _U, + _U, _U, _U, _U, _U, _U, _U, _U, + _U, _U, _U, _P, _P, _P, _P, _P, + _P, _L|_X, _L|_X, _L|_X, _L|_X, _L|_X, _L|_X, _L, + _L, _L, _L, _L, _L, _L, _L, _L, + _L, _L, _L, _L, _L, _L, _L, _L, + _L, _L, _L, _P, _P, _P, _P, _C +}; diff --git a/c20/pcc20lib/ctype.h b/c20/pcc20lib/ctype.h new file mode 100644 index 00000000..d314c058 --- /dev/null +++ b/c20/pcc20lib/ctype.h @@ -0,0 +1,24 @@ +#define _U 01 +#define _L 02 +#define _N 04 +#define _S 010 +#define _P 020 +#define _C 040 +#define _X 0100 + +extern char _ctype_[]; + +#define isalpha(c) ((_ctype_+1)[c]&(_U|_L)) +#define isupper(c) ((_ctype_+1)[c]&_U) +#define islower(c) ((_ctype_+1)[c]&_L) +#define isdigit(c) ((_ctype_+1)[c]&_N) +#define isxdigit(c) ((_ctype_+1)[c]&(_N|_X)) +#define isspace(c) ((_ctype_+1)[c]&_S) +#define ispunct(c) ((_ctype_+1)[c]&_P) +#define isalnum(c) ((_ctype_+1)[c]&(_U|_L|_N)) +#define isprint(c) ((_ctype_+1)[c]&(_P|_U|_L|_N)) +#define iscntrl(c) ((_ctype_+1)[c]&_C) +#define isascii(c) ((unsigned)(c)<=0177) +#define toupper(c) ((c)-'a'+'A') +#define tolower(c) ((c)-'A'+'a') +#define toascii(c) ((c)&0177) diff --git a/c20/pcc20lib/date.c b/c20/pcc20lib/date.c new file mode 100644 index 00000000..2aef3c1b --- /dev/null +++ b/c20/pcc20lib/date.c @@ -0,0 +1,142 @@ +# + +/* + +DATE - Date Hacking Routines + +These routines recognize three representations for dates: + +(1) CAL - calender date, a system-independent representation + consisting of a record containing six integers + for the year, month, day, hour, minute, and second + +(2) FDATE - the ITS date representation used in file directories + +(3) UDATE - the UNIX date representation, seconds since + Jan 1, 1970, GMT. + +(4) TDATE - the TOPS-20 date representation + + *** The TOPS-20 representation is recognized only on TOPS-20; + the routines are in C20DAT *** + +The routines: + + u2cal (udate, cd) - convert udate to cal + udate = cal2u (cd) - convert cal to udate + f2cal (fdate, cd) - convert fdate to cal + fdate = cal2f (cd) - convert cal to fdate + t2cal (tdate, cd) - convert tdate to cal (TOPS-20 only) + tdate = cal2t (cd) - convert cal to tdate (TOPS-20 only) + prcal (cd, fd) - print cal (CIO) + +*/ + +# define ZONE 5 /* offset of local zone from GMT */ +struct _cal {int year, month, day, hour, minute, second;}; +# define cal struct _cal + +# define month_tab1 mtab1 +# define month_tab2 mtab2 + +static int month_tab1[] { 0, 31, 59, 90, 120, 151, + 181, 212, 243, 273, 304, 334}; +static int month_tab2[] { 0, 31, 60, 91, 121, 152, + 182, 213, 244, 274, 305, 335}; +static int year_tab[] {0, 365, 2*365, 3*365+1}; + +# define four_years (4*365+1) + +static char *month_name[] { + "Jan", "Feb", "Mar", "Apr", "May", "Jun", + "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"}; + +# rename srctab "SRCTAB" + +u2cal (udate, cd) + register cal *cd; + int udate; + + {udate -= (ZONE * 60 * 60); + cd->second = udate % 60; udate /= 60; + cd->minute = udate % 60; udate /= 60; + cd->hour = udate % 24; udate /= 24; + cd->year = 1970 + 4 * (udate / four_years); + udate %= four_years; + cd->year += srctab (year_tab, 4, &udate); + cd->month = srctab (cd->year % 4 == 0 ? month_tab2 : month_tab1, + 12, &udate) + 1; + cd->day = udate + 1; + } + +int cal2u (cd) + register cal *cd; + + {register int udate, year; + + year = cd->year; + udate = cd->second + 60 * (cd->minute + 60 * + (cd->hour + 24 * (cd->day - 1))); + udate += (year % 4 == 0 ? month_tab2 : month_tab1) [cd->month - 1] + * 60 * 60 * 24; + year -= 1970; + if (year < 0) year = 0; + udate += 60 * 60 * 24 * (four_years * (year / 4) + year_tab[year % 4]); + udate += (ZONE * 60 * 60); + return (udate); + } + +f2cal (fdate, cd) + register cal *cd; + register unsigned fdate; + + {cd->year = 1900 + ((fdate >> 27) & 0177); + if ((cd->month = (fdate >> 23) & 017) > 12) cd->month = 0; + cd->day = (fdate >> 18) & 037; + fdate = (fdate & 0777777) >> 1; + cd->second = fdate % 60; + fdate /= 60; + cd->minute = fdate % 60; + cd->hour = fdate / 60; + } + +int cal2f (cd) + register cal *cd; + + {register int fdate; + + fdate = 2 * (cd->second + 60 * (cd->minute + 60 * cd->hour)); + fdate |= cd->day << 18; + fdate |= cd->month << 23; + fdate |= (cd->year - 1900) << 27; + return (fdate); + } + +prcal (cd, f) + register cal *cd; + + {register char *s; + register int m; + m = cd->month - 1; + if (m >= 0 && m <= 11) s = month_name[m]; + else s = "?"; + cprint (f, "%s%3d%5d %02d:%02d:%02d", s, cd->day, cd->year, + cd->hour, cd->minute, cd->second); + } + +int srctab (tab, sz, n) + int *tab, sz, *n; + + {register int *p, i; + + p = tab + sz; + i = *n; + + while (--p >= tab) + {if (*p <= i) + {*n = i - *p; + return (p - tab); + } + } + return (0); + } diff --git a/c20/pcc20lib/fprint.c b/c20/pcc20lib/fprint.c new file mode 100644 index 00000000..236ae00d --- /dev/null +++ b/c20/pcc20lib/fprint.c @@ -0,0 +1,534 @@ +# include + +/********************************************************************** + + d = atof (s) parser + nchars = fprint (d, fd, prec) write d to fd with prec decimals + nchars = eprint (d, fd, prec) (same, but always xxxe+xx format) + + requires: + + cputc (c, fd) + + internal routines and tables: + + exps, mants, hpmul, dextract, doround, eform, fform + + PDP10 dependent, system independent + + Note: special effort is applied to get exact conversions! + +**********************************************************************/ + +# rename eprint "EPRINT" +# rename hpmul "HPMUL" +# rename dextract "DEXTRACT" +# rename doround "DOROUND" +# rename eform "EFORM" +# rename fform "FFORM" + +unsigned hpmul (); + +static unsigned exps [] + { halves (0741566, 0111742), /* -48 */ + halves (0744723, 0534333), /* -47 */ + halves (0750444, 0231611), /* -46 */ + halves (0753555, 0300153), /* -45 */ + halves (0756710, 0560206), /* -44 */ + halves (0762435, 0346123), /* -43 */ + halves (0765544, 0637550), /* -42 */ + halves (0770676, 0007502), /* -41 */ + halves (0774426, 0604611), /* -40 */ + halves (0777534, 0345754), /* -39 */ + halves (0002663, 0437347), /* -38 */ + halves (0006420, 0163520), /* -37 */ + halves (0011524, 0220444), /* -36 */ + halves (0014651, 0264555), /* -35 */ + halves (0020411, 0660744), /* -34 */ + halves (0023514, 0235135), /* -33 */ + halves (0026637, 0304365), /* -32 */ + halves (0032403, 0472631), /* -31 */ + halves (0035504, 0411377), /* -30 */ + halves (0040625, 0513677), /* -29 */ + halves (0043773, 0036657), /* -28 */ + halves (0047474, 0723215), /* -27 */ + halves (0052614, 0110061), /* -26 */ + halves (0055757, 0132075), /* -25 */ + halves (0061465, 0370246), /* -24 */ + halves (0064602, 0666320), /* -23 */ + halves (0067743, 0444004), /* -22 */ + halves (0073456, 0166402), /* -21 */ + halves (0076571, 0624103), /* -20 */ + halves (0101730, 0171123), /* -19 */ + halves (0105447, 0113564), /* -18 */ + halves (0110560, 0736521), /* -17 */ + halves (0113715, 0126245), /* -16 */ + halves (0117440, 0165747), /* -15 */ + halves (0122550, 0223341), /* -14 */ + halves (0125702, 0270232), /* -13 */ + halves (0131431, 0363140), /* -12 */ + halves (0134537, 0657770), /* -11 */ + halves (0137667, 0633766), /* -10 */ + halves (0143422, 0701372), /* -9 */ + halves (0146527, 0461670), /* -8 */ + halves (0151655, 0376246), /* -7 */ + halves (0155414, 0336750), /* -6 */ + halves (0160517, 0426542), /* -5 */ + halves (0163643, 0334272), /* -4 */ + halves (0167406, 0111564), /* -3 */ + halves (0172507, 0534121), /* -2 */ + halves (0175631, 0463146), /* -1 */ + halves (0201400, 0000000), /* 0 */ + halves (0204500, 0000000), /* 1 */ + halves (0207620, 0000000), /* 2 */ + halves (0212764, 0000000), /* 3 */ + halves (0216470, 0400000), /* 4 */ + halves (0221606, 0500000), /* 5 */ + halves (0224750, 0220000), /* 6 */ + halves (0230461, 0132000), /* 7 */ + halves (0233575, 0360400), /* 8 */ + halves (0236734, 0654500), /* 9 */ + halves (0242452, 0013710), /* 10 */ + halves (0245564, 0416672), /* 11 */ + halves (0250721, 0522450), /* 12 */ + halves (0254443, 0023471), /* 13 */ + halves (0257553, 0630407), /* 14 */ + halves (0262706, 0576511), /* 15 */ + halves (0266434, 0157115), /* 16 */ + halves (0271543, 0212741), /* 17 */ + halves (0274674, 0055531), /* 18 */ + halves (0300425, 0434430), /* 19 */ + halves (0303532, 0743536), /* 20 */ + halves (0306661, 0534465), /* 21 */ + halves (0312417, 0031701), /* 22 */ + halves (0315522, 0640261), /* 23 */ + halves (0320647, 0410336), /* 24 */ + halves (0324410, 0545213), /* 25 */ + halves (0327512, 0676455), /* 26 */ + halves (0332635, 0456171), /* 27 */ + halves (0336402, 0374713), /* 28 */ + halves (0341503, 0074076), /* 29 */ + halves (0344623, 0713116), /* 30 */ + halves (0347770, 0675742), /* 31 */ + halves (0353473, 0426555), /* 32 */ + halves (0356612, 0334310), /* 33 */ + halves (0361755, 0023372), /* 34 */ + halves (0365464, 0114134), /* 35 */ + halves (0370601, 0137163), /* 36 */ + halves (0373741, 0367020), /* 37 */ + halves (0377454, 0732312), /* 38 */ + halves (0402570, 0120775), /* 39 */ + halves (0405726, 0145174), /* 40 */ + halves (0411445, 0677215), /* 41 */ + halves (0414557, 0257061), /* 42 */ + halves (0417713, 0132675), /* 43 */ + halves (0423436, 0770626), /* 44 */ + halves (0426546, 0566774), /* 45 */ + halves (0431700, 0324573), /* 46 */ + halves (0435430, 0204754), /* 47 */ + halves (0440536, 0246150) }; /* 48 */ + +static unsigned mants [] + { halves (0566111, 0742473), /* -48 */ + halves (0723534, 0333211), /* -47 */ + halves (0444231, 0611026), /* -46 */ + halves (0555300, 0153233), /* -45 */ + halves (0710560, 0206102), /* -44 */ + halves (0435346, 0123651), /* -43 */ + halves (0544637, 0550624), /* -42 */ + halves (0676007, 0502771), /* -41 */ + halves (0426604, 0611673), /* -40 */ + halves (0534345, 0754252), /* -39 */ + halves (0663437, 0347325), /* -38 */ + halves (0420163, 0520505), /* -37 */ + halves (0524220, 0444626), /* -36 */ + halves (0651264, 0555774), /* -35 */ + halves (0411660, 0744575), /* -34 */ + halves (0514235, 0135735), /* -33 */ + halves (0637304, 0365324), /* -32 */ + halves (0403472, 0631304), /* -31 */ + halves (0504411, 0377565), /* -30 */ + halves (0625513, 0677523), /* -29 */ + halves (0773036, 0657450), /* -28 */ + halves (0474723, 0215571), /* -27 */ + halves (0614110, 0061127), /* -26 */ + halves (0757132, 0075355), /* -25 */ + halves (0465370, 0246324), /* -24 */ + halves (0602666, 0320011), /* -23 */ + halves (0743444, 0004013), /* -22 */ + halves (0456166, 0402407), /* -21 */ + halves (0571624, 0103111), /* -20 */ + halves (0730171, 0123733), /* -19 */ + halves (0447113, 0564351), /* -18 */ + halves (0560736, 0521443), /* -17 */ + halves (0715126, 0245754), /* -16 */ + halves (0440165, 0747563), /* -15 */ + halves (0550223, 0341520), /* -14 */ + halves (0702270, 0232044), /* -13 */ + halves (0431363, 0140226), /* -12 */ + halves (0537657, 0770274), /* -11 */ + halves (0667633, 0766353), /* -10 */ + halves (0422701, 0372023), /* -9 */ + halves (0527461, 0670430), /* -8 */ + halves (0655376, 0246536), /* -7 */ + halves (0414336, 0750132), /* -6 */ + halves (0517426, 0542161), /* -5 */ + halves (0643334, 0272616), /* -4 */ + halves (0406111, 0564570), /* -3 */ + halves (0507534, 0121727), /* -2 */ + halves (0631463, 0146314), /* -1 */ + halves (0400000, 0000000), /* 0 */ + halves (0500000, 0000000), /* 1 */ + halves (0620000, 0000000), /* 2 */ + halves (0764000, 0000000), /* 3 */ + halves (0470400, 0000000), /* 4 */ + halves (0606500, 0000000), /* 5 */ + halves (0750220, 0000000), /* 6 */ + halves (0461132, 0000000), /* 7 */ + halves (0575360, 0400000), /* 8 */ + halves (0734654, 0500000), /* 9 */ + halves (0452013, 0710000), /* 10 */ + halves (0564416, 0672000), /* 11 */ + halves (0721522, 0450400), /* 12 */ + halves (0443023, 0471240), /* 13 */ + halves (0553630, 0407510), /* 14 */ + halves (0706576, 0511432), /* 15 */ + halves (0434157, 0115760), /* 16 */ + halves (0543212, 0741354), /* 17 */ + halves (0674055, 0531647), /* 18 */ + halves (0425434, 0430110), /* 19 */ + halves (0532743, 0536132), /* 20 */ + halves (0661534, 0465561), /* 21 */ + halves (0417031, 0701446), /* 22 */ + halves (0522640, 0261760), /* 23 */ + halves (0647410, 0336354), /* 24 */ + halves (0410545, 0213024), /* 25 */ + halves (0512676, 0455631), /* 26 */ + halves (0635456, 0171177), /* 27 */ + halves (0402374, 0713617), /* 28 */ + halves (0503074, 0076563), /* 29 */ + halves (0623713, 0116320), /* 30 */ + halves (0770675, 0742004), /* 31 */ + halves (0473426, 0555202), /* 32 */ + halves (0612334, 0310443), /* 33 */ + halves (0755023, 0372554), /* 34 */ + halves (0464114, 0134543), /* 35 */ + halves (0601137, 0163674), /* 36 */ + halves (0741367, 0020653), /* 37 */ + halves (0454732, 0312413), /* 38 */ + halves (0570120, 0775116), /* 39 */ + halves (0726145, 0174341), /* 40 */ + halves (0445677, 0215615), /* 41 */ + halves (0557257, 0061160), /* 42 */ + halves (0713132, 0675414), /* 43 */ + halves (0436770, 0626347), /* 44 */ + halves (0546566, 0774041), /* 45 */ + halves (0700324, 0573052), /* 46 */ + halves (0430204, 0754732), /* 47 */ + halves (0536246, 0150120) }; /* 48 */ + +/********************************************************************** + + ATOF - Convert string to float + +**********************************************************************/ + +static int biggest {halves (0377777, 07777777)}; +static double *pbig {&biggest}; + +double atof (s) + register char *s; + + {register int e, c; + register unsigned frac; + int negexp, isneg, sigcnt, adjust; + unsigned holder; + double *pdouble; + + if (s == 0 || *s == 0) return (0.0); + negexp = isneg = FALSE; + e = sigcnt = adjust = frac = 0; + while (*s == '-' || *s == '+') + {if (*s == '-') isneg = !isneg; + ++s; + } + while ((c = *s++) >= '0' && c <= '9') + {if (c == '0' && sigcnt == 0) continue; + if (sigcnt < 10) + {frac = frac * 10 + (c - '0'); + ++sigcnt; + } + else ++adjust; + } + if (c == '.') + {while ((c = *s++) >= '0' && c <= '9') + {if (c == '0' && sigcnt == 0) --adjust; + else if (sigcnt >= 10) continue; + else {frac = frac * 10 + (c - '0'); + ++sigcnt; + --adjust; + } + } + } + if (c == 'e' || c == 'E') + {while (*s == '-' || *s == '+') + {if (*s == '-') negexp = !negexp; + ++s; + } + while ((c = *s++) >= '0' && c <= '9') + e = e * 10 + (c - '0'); + } + if (frac == 0) return (0.0); + if (negexp) e = -e; + adjust += e; + if (adjust < -48) return (0.0); + else if (adjust > 38) return (isneg ? -(*pbig) : *pbig); + + sigcnt = 0; /* now use sigcnt to remember # of shifts */ + while (!(frac & halves (0400000, 0))) /* normalize */ + {frac <<= 1; + ++sigcnt; + } + frac = hpmul (frac, mants[adjust + 48], &negexp); /* high prec mult */ + while (!(frac & halves (0400000, 0))) /* normalize */ + {frac <<= 1; + ++sigcnt; + } + frac >>= 8; + if (frac & 01) /* round and maybe shift one more */ + {++frac; + if (frac & halves (0776000, 0)) + {frac >>= 1; + --sigcnt; + } + } + frac >>= 1; /* now have fraction -- need exp */ + e = exps[adjust + 48] >> 27; + if (e & 0400) e |= halves (0777777, 0777000); + e += (36 - sigcnt); + if (e < 0) return (0.0); + else if (e >= 0400) return (isneg ? -(*pbig) : *pbig); + + holder = (e << 27) | frac; + if (isneg) holder = -holder; + pdouble = &holder; + return (*pdouble); + } + +unsigned hpmul (x, y, plprod) + register unsigned x, y, *plprod; + + {unsigned x1, x2, x3, y1, y2, y3; + register unsigned prod, lprod; + + x1 = x >> 24; + x2 = (x >> 12) & 07777; + x3 = x & 07777; + y1 = y >> 24; + y2 = (y >> 12) & 07777; + y3 = y & 07777; + + prod = x3 * y3; + lprod = prod & 07777; + prod >>= 12; + prod += (x2 * y3) + (x3 * y2); + lprod |= (prod & 07777) << 12; + prod >>= 12; + prod += (x1 * y3) + (x2 * y2) + (x3 * y1); + *plprod = lprod | ((prod & 07777) << 24); + prod >>= 12; + prod += (x1 * y2) + (x2 * y1); + prod += (x1 * y1) << 12; + return (prod); + } + +dextract (d, psign, digits, pexpon) + double d; + int *psign, *pexpon; + char *digits; + + {unsigned dd; + double *pdd; + register int exp, maxexp; + unsigned frac, hfrac; + int nshift; + + *psign = FALSE; + if (d == 0.0) /* special case 0.0 */ + {*digits++ = '0'; + *digits = 0; + *pexpon = 0; + return; + } + + if (d < 0.0) /* take care of sign stuff */ + {*psign = TRUE; + d = -d; + } + + pdd = ⅆ /* prepare to hack */ + *pdd = d; + + exp = -39; /* find exponent */ + maxexp = 38; + do {int avg; + avg = (exp + maxexp) >> 1; + if (dd < exps[avg + 48]) maxexp = avg; + else exp = avg; + } + while ((maxexp - exp) > 1); + if (exp != maxexp && dd >= exps[maxexp + 48]) ++exp; + ++exp; /* for . at left */ + + frac = (dd & halves (0777, 0777777)) << 9; + frac = hpmul (frac, mants[49 - exp], &hfrac); + nshift = (dd >> 27) + (exps[49 - exp] >> 27) - 256; + if (nshift <= 0) + {hfrac = 1; + frac = 0; + } + else {hfrac = 0; + while (--nshift >= 0) + {hfrac <<= 1; + if (frac & halves (0400000, 0)) ++hfrac; + frac <<= 1; + } + } + nshift = 12; + while (TRUE) + {*digits++ = hfrac + '0'; + if (--nshift < 0) break; + hfrac = hpmul (frac, 10, &frac); + } + *digits = 0; + *pexpon = exp; + } + +int fprint (d, fd, p) + double d; + register int p; + int fd; + + {register int cnt; + char buf[13]; + int minus, expon, ndigs; + + cnt = 0; + if (p < 0) p = 0; + else if (p > 22) p = 22; + + dextract (d, &minus, buf, &expon); + + if (minus) + {cputc ('-', fd); + ++cnt; + } + ndigs = expon + p; + if (ndigs <= 0 || expon > 8) + {expon += doround (buf, p + 1); + return (cnt + eform (fd, buf, expon, p)); + } + expon += doround (buf, ndigs); + return (cnt + fform (fd, buf, expon, p)); + } + +int doround (p, n) + register char *p; + + {register char *q; + + if (n >= 12) n = 12; + else if (n <= 0) n = 1; + q = &p[n]; + if (n < 12 && p[n] >= '5') + {while (TRUE) + {*q = 0; + if (++(*--q) <= '9') break; + if (q == p) + {p[0] = '1'; + p[1] = 0; + return (1); + } + } + ++q; + } + while (TRUE) + {*q = 0; + if (q <= p || *--q != '0') break; + } + return (0); + } + +int eform (fd, q, expon, p) + register char *q; + + {register int cnt, ndigs; + char buf[5]; + + if (*q) cputc (*q++, fd); + else cputc ('0', fd); + cputc ('.', fd); + cnt = p + 3; + while (--p >= 0) + {if (*q) cputc (*q++, fd); + else cputc ('0', fd); + } + cputc ('e', fd); + if (--expon < 0) + {expon = -expon; + cputc ('-', fd); + } + else cputc ('+', fd); + itoa (expon, buf); + q = buf; + while (*q) + {cputc (*q++, fd); + ++cnt; + } + return (cnt); + } + +int fform (fd, q, expon, p) + register char *q; + + {register int cnt; + cnt = 0; + while (*q && *q == '0' && expon > 1) + {--expon; + ++q; + } + while (expon > 0) + {if (*q) cputc (*q++, fd); + else cputc ('0', fd); + --expon; + ++cnt; + } + cputc ('.', fd); + cnt += (p + 1); + while (--p >= 0) + {if (expon >= 0 && *q) cputc (*q++, fd); + else cputc ('0', fd); + ++expon; + } + return (cnt); + } + +int eprint (d, fd, p) + double d; + int fd, p; + + {char buf[15]; + int cnt, minus, expon; + + cnt = 0; + if (p < 0) p = 0; + else if (p > 22) p = 22; + + dextract (d, &minus, buf, &expon); + expon += doround (buf, p + 1); + if (minus) + {cputc ('-', fd); + ++cnt; + } + return (cnt + eform (fd, buf, expon, p)); + } diff --git a/c20/pcc20lib/full-stdio.stinkr b/c20/pcc20lib/full-stdio.stinkr new file mode 100644 index 00000000..f8e0ada7 --- /dev/null +++ b/c20/pcc20lib/full-stdio.stinkr @@ -0,0 +1,32 @@ +s 140,p,n,n +i linit +l FTN20:c20run +l FTN20:c20lod +l FTN20:c20fnm +l FTN20:c20io +l FTN20:c20pip +l FTN20:c20std +l FTN20:c20lib +l FTN20:c20sys +l FTN20:c20tty +l FTN20:c20int +l FTN20:c20fil +l FTN20:c20exp +l FTN20:c20fd +l FTN20:c20dat +l FTN20:ac +l FTN20:alloc +l FTN20:apfnam +l FTN20:atoi +l FTN20:blt +l FTN20:cfloat +l FTN20:cprint +l FTN20:date +l FTN20:fprint +l FTN20:halves +l FTN20:scanf +l FTN20:pr60th +l FTN20:random +l FTN20:string +l FTN20:stringp +l FTN20:ctype diff --git a/c20/pcc20lib/hack.for b/c20/pcc20lib/hack.for new file mode 100644 index 00000000..3ba5688a --- /dev/null +++ b/c20/pcc20lib/hack.for @@ -0,0 +1,155 @@ +! The purpose of this hack is to much MIDAS rel files +! and insert ENTRY blocks before each module with INTERNs + + program hack + integer wrd,typ,lh,rh,len,buffer,ptr,recnum + common ptr,buffer(10000) + + call opnfil + recnum=0 +1 read(20,end=999) wrd + recnum=recnum+1 + call stuff(wrd) + + typ=lh(wrd) + len=rh(wrd) +! type *,'record: ', recnum,' type ',typ, ', length ',len + if( typ == 0) then !illegal + stop '? type 0 block read' + else if( typ == 1 ) then !code + call copy(len) + else if( typ == 2 ) then !symbols + call type2 + else if( typ == 3 ) then !hiseg + call copy(len) + else if( typ == 4 ) then !entry + type *, '% ENTRY block read.. copying...' + call copy(len) + else if( typ == 5 ) then !end + call copy(len) + call copy1 + call dump + else if( typ == 6 ) then !name + call copy(len) + else if( typ == 7 ) then !start + type *,'% START block read.. copying...' + call copy(len) + else + type *,'? Unknown block ', typ,' @ record ',recnum + stop 'quitting' + end if + goto 1 + +999 close(20) + close(21) + type *, recnum, ' records copied' + end + + subroutine opnfil + character*20 name + + type *,'input file' + accept 1000, name +1000 format(a) + open(20,dialog=name,mode='image',access='seqin') + + type *,'output file' + accept 1000, name + open(21,dialog=name,mode='image',access='seqout') + end + + subroutine copy(l) + integer l,wrd,cnt,t,i,ptr + + cnt=l +10 if( cnt == 0 ) return + call copy1 !copy relocation + + t=cnt + if( cnt > 18 ) t=18 + do i=1,t + call copy1 + cnt=cnt-1 + end do + goto 10 + end + + subroutine copy1 + integer wrd + read(20,end=999) wrd + call stuff(wrd) + return +999 stop '? EOF in copy1' + end + + subroutine type2(l) + integer l,l2,wrd,t,ptr,tfld,bits + + l2=l !copy length + +10 if( l2 <= 0 ) return !if no more words, return + call copy1 !copy relocation + t=l2 + if( t > 18 ) t=18 !upto 18 words + +20 read(20,end=999) wrd !read symbol name + call stuff(wrd) + bits=tfld(wrd) !get type bits + if(bits == 4 .OR. bits == 24 .OR. bits == 44 ) then !entry? + call mkent(wrd) + end if + call copy1 !copy value + l2=l2-2 + t=t-2 + if( t > 0 ) goto 20 + goto 10 + +999 stop '? eof in type2' + end + + subroutine stuff(w) + integer w,ptr,buffer + common ptr,buffer(10000) + ptr=ptr+1 + if( ptr > 10000) stop '? write overflow' + buffer(ptr)=w + end + + subroutine dump + integer ptr,buffer + common ptr,buffer(10000) + if( ptr == 0 ) return + call dmpent + write(21) (buffer(i), i=1,ptr) + ptr=0 + end + + subroutine mkent(n) + integer n,cnt,buf + common /ent/ cnt,buf(100) + if( cnt == 100 ) call dmpent + cnt = cnt + 1 + buf(cnt) = n + end + + subroutine dmpent + integer cnt,ptr,t,buf + common /ent/ cnt,buf(100) + +100 if( cnt == 0 ) return !none to do + ptr=1 !start at first one + write(21) cnt+"4000000 !entry block + +110 if( cnt == 0 ) return !any more? + write(21) 0 !reloc for next 18 (must be 0) + t=cnt + if( t > 18 ) t=18 !do upto 18 + +120 write(21) buf(ptr) !write name + ptr=ptr+1 + t=t-1 + cnt=cnt-1 + if( t > 0 ) goto 120 !anymore in this group? + + goto 110 !no, do next group + end \ No newline at end of file diff --git a/c20/pcc20lib/hack2.mac b/c20/pcc20lib/hack2.mac new file mode 100644 index 00000000..9c2f46ca --- /dev/null +++ b/c20/pcc20lib/hack2.mac @@ -0,0 +1,11 @@ +LH:: HLRZ @(16) + POPJ 17, + +RH:: HRRZ @(16) + POPJ 17, + +TFLD:: LDB [360636,,0] + ANDI 74 + POPJ 17, + + END diff --git a/c20/pcc20lib/halves.cmid b/c20/pcc20lib/halves.cmid new file mode 100644 index 0000000000000000000000000000000000000000..68d487bf4681b5532a231fbc2a11fd01d2b317b3 GIT binary patch literal 121 zcmY+6OA3H639uFYQRG5B8`HG_rHeUjk}pyOhBM1%E}c1ux!Ha^EQ{N p=4$QwG^9uHYxCQXxR`F=#_!_w08J_sz1*M|C`j2BEdX&D(VPl+9Gd_D literal 0 HcmV?d00001 diff --git a/c20/pcc20lib/math.h b/c20/pcc20lib/math.h new file mode 100644 index 00000000..3c7a2e80 --- /dev/null +++ b/c20/pcc20lib/math.h @@ -0,0 +1,6 @@ +/* +Rudimentary MATH library since most other C implementations +seem to have one and programs want to include it. DLM 3/12/84 +*/ + +extern double atof(); diff --git a/c20/pcc20lib/pr60th.c b/c20/pcc20lib/pr60th.c new file mode 100644 index 00000000..101ba2ef --- /dev/null +++ b/c20/pcc20lib/pr60th.c @@ -0,0 +1,54 @@ +# include + +/********************************************************************** + + PR60TH - Print time in 1/60 sec. + + Print time HH:MM:SS.XX on file FILE. + TIME is in units of 1/60 sec. + +**********************************************************************/ + +pr60th (time, file) + + {register int ss, sc, mn, hour, zs; + + if (time < 0) time = -time; + zs = TRUE; + ss = time % 60; + time = time / 60; + sc = time % 60; + time = time / 60; + mn = time % 60; + hour = time / 60; + if (hour) + {cprint (file, "%3d:", hour); + zs = FALSE; + } + else cprint (file, " "); + xput2 (mn, file, zs); + if (zs && mn == 0) cputc (' ', file); + else {cputc (':', file); + zs = FALSE; + } + if (zs && !sc) cprint (file, " 0"); + else {xput2 (sc, file, zs); + zs = FALSE; + } + cputc ('.', file); + xput2 (ss, file, FALSE); + } + +xput2 (val, file, zs) + + {register int num; + num = val / 10; + if (num > 0 || !zs) + {cputc ('0' + num, file); + zs = FALSE; + } + else cputc (' ', file); + num = val % 10; + if (num > 0 || !zs) cputc ('0' + num, file); + else cputc (' ', file); + } diff --git a/c20/pcc20lib/random.cmid b/c20/pcc20lib/random.cmid new file mode 100644 index 00000000..e997f6af --- /dev/null +++ b/c20/pcc20lib/random.cmid @@ -0,0 +1,31 @@ +; +; RANDOM - RANDOM NUMBER GENERATOR (STOLEN FROM MUDDLE) +; +; This file is PDP-10 dependent, system-independent. +; + +TITLE RANDOM +.INSRT SS:CINSRT +.INSRT SS:MINSRT + +CENTRY SRAND,[SEED] + MOVE A,SEED + ROT A,-1 + MOVEM A,RLOW + RETURN + +CENTRY RAND + 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 + MOVE A,B + RETURN + +.IDATA +RHI: 267762113337 +RLOW: 155256071112 +.PDATA + +END diff --git a/c20/pcc20lib/scanf.c b/c20/pcc20lib/scanf.c new file mode 100644 index 00000000..89cb07d1 --- /dev/null +++ b/c20/pcc20lib/scanf.c @@ -0,0 +1,306 @@ +# include + +/* + SCANF - C Formatted Input Routine + + Format options: (upper case treated identically) + %s string + %c character + %o octal + %d decimal + %u unsigned (= decimal) + %x hexadecimal + %f F format floating point (without exponent, if poss) + %e E format floating point (always with exponent) + %[...] string whose chars are only in ... + %[^...] string whose chars are NOT in ... + + If * precedes format char (as in %*d) then that item will be + read, but not assigned to a variable in the variable list. +*/ + +extern int cin; +extern char scnget (); + +scanf (a1, a2, a3, a4, a5, a6, a7, a8, a9, a10, a11, a12, a13, a14, a15) + +# ifdef snyder_compiler +# define bumpadx ++adx +# else +# define bumpadx --adx +# endif + +{register int *adx, n, fn; +register char *fmt, c; + +n = 0; +if (cisfd (a1)) /* file descriptor */ + {fn = a1; + fmt = a2; + adx = &a3; + } +else {fn = cin; + fmt = a1; + adx = &a2; + } +if ((c = scnget (fn)) < 0) return (-1); /* check for initial eof */ +ungetc (c, fn); +while (c = *fmt++) + {register int assign, win, width; + if (c == ' ' || c == '\t' || c == '\n') continue; + if (c != '%') + {register char cc; + while (TRUE) + {if ((cc = scnget (fn)) < 0) return (n); + if (cc != ' ' && cc != '\t' && cc != '\n') break; + } + if (c == cc) continue; + ungetc (cc, fn); + return (n); + } + c = *fmt++; + if (c == '*') + {assign = FALSE; + c = *fmt++; + } + else assign = TRUE; + width = 0; + while (c >= '0' && c <= '9') + {width = width * 10 + (c - '0'); + c = *fmt++; + } + if (c == 'l' || c == 'h') c = *fmt++; + switch (c) { + case 'c': + win = scnc (fn, assign, *adx, width); break; + case 'd': + win = scnd (fn, assign, *adx, width); break; + case 'e': + case 'f': + win = scnf (fn, assign, *adx, width); break; + case 'o': + win = scno (fn, assign, *adx, width); break; + case 's': + win = scns (fn, assign, *adx, width); break; + case 'x': + win = scnx (fn, assign, *adx, width); break; + case '[': + {char *p, cc; + p = fmt; + while ((cc = *fmt++) && cc != ']'); + win = scnb (fn, assign, *adx, width, p); + } + break; + default: + win = FALSE; + } + if (!win) return (n); + if (assign) + {n++; + bumpadx; + } + } +return (n); +} + +/* SCNGET - Get a character (returns -1 if eof) */ + +char scnget (fn) + + {char c; + c = cgetc (fn); + if (ceof (fn)) return (-1); + else return (c); + } + +/* SCNC - Parse a character */ + +int scnc (fn, assign, var, width) + int fn, assign, *var, width; + + {char c; + if ((c = scnget (fn)) < 0) return (FALSE); + if (assign) *var = c; + return (TRUE); + } + +/* SCND - Parse a decimal integer */ + +int scnd (fn, assign, var, width) + int fn, assign, *var, width; + + {return (scnint (fn, assign, var, width, 10)); + } + +/* SCNO - Parse an octal integer */ + +int scno (fn, assign, var, width) + int fn, assign, *var, width; + + {return (scnint (fn, assign, var, width, 8)); + } + +/* SCNX - Parse a hexadecimal number */ + +int scnx (fn, assign, var, width) + int fn, assign, *var, width; + + {return (scnint (fn, assign, var, width, 16)); + } + +/* SCNINT - parse an integer, base specified */ + +int scnint (fn, assign, var, width, base) + int fn, assign, *var, width, base; + + {register int i; + int neg, win; + register char c; + if (!skpblk (fn)) return (FALSE); + i = 0; + win = neg = FALSE; + while (TRUE) + {if ((c = scnget (fn)) < 0) return (FALSE); + if (c == '-') neg = !neg; + else if (c != '+') break; + } + while (TRUE) + {register char cc; + cc = c; + if (c >= '0' && c <= '9') cc = c - '0'; + else if (c >= 'a' && c <= 'z') cc = c - 'a' + 10; + else if (c >= 'A' && c <= 'Z') cc = c - 'A' + 10; + else if (c == ' ' || c == '\t' || c == '\n') + {win = TRUE; + break; + } + else break; + if (cc >= base) break; + i = i * base + cc; + if (--width == 0 || (c = scnget (fn)) < 0) + {win = TRUE; + break; + } + } + if (c >= 0) ungetc (c, fn); + if (win) + {if (neg) i = -i; + if (assign) *var = i; + } + return (win); + } + +/* SCNF - Parse a floating point number of this form: */ +/* [- | +] ddd [.] ddd [ E [- | +] ddd ] */ + +int scnf (fn, assign, var, width) + int fn, assign; + register int width; + double *var; + + {char buf[100]; + register char c, *p; + + if (width <= 0 || width > 100) width = 100; + p = buf; + if (!skpblk (fn)) return (FALSE); + c = scnget (fn); + if (c == '-' || c == '+') + {*p++ = c; + if (--width == 0) goto finish; + if ((c = scnget (fn)) < 0) return (FALSE); + } + while (TRUE) + {if (c >= '0' && c <= '9') *p++ = c; + else break; + if (--width == 0 || (c = scnget (fn)) < 0) goto finish; + } + if (c == '.') + {*p++ = c; + if (--width == 0 || (c = scnget (fn)) < 0) goto finish; + else while (TRUE) + {if (c >= '0' && c <= '9') *p++ = c; + else break; + if (--width == 0 || (c = scnget (fn)) < 0) + goto finish; + } + } + if (c == 'e' || c == 'E') + {*p++ = c; + if (--width == 0) goto finish; + c = scnget (fn); + if (c == '-' || c == '+') + {*p++ = c; + if (--width == 0) goto finish; + c = scnget (fn); + } + while (TRUE) + {if (c >= '0' && c <= '9') *p++ = c; + else break; + if (--width == 0 || (c = scnget (fn)) < 0) goto finish; + } + } + if (c >= 0) ungetc (c, fn); + if (c != ' ' && c != '\t' && c != '\n') return (FALSE); +finish: *p++ = 0; + if (assign) *var = atof (buf); + return (TRUE); + } + +/* SCNS - Read a string */ + +int scns (fn, assign, var, width) + int fn, assign, width; + register char *var; + + {register char c; + if (!skpblk (fn)) return (FALSE); + while (TRUE) + {if ((c = scnget (fn)) < 0 || c == ' ' || c == '\n') break; + if (assign) *var++ = c; + if (--width == 0) goto done; + } + if (c >= 0) ungetc (c, fn); +done: if (assign) *var++ = 0; + return (TRUE); + } + +/* SCNB - Scan a string of the bracket form */ + +int scnb (fn, assign, var, width, matchers) + int fn, assign, width; + char *var, *matchers; + + {register char c; + int member[128], nots; + nots = FALSE; + if (*matchers == '^') + {nots = TRUE; + matchers++; + } + sfill (member, 128, nots); + nots = !nots; + while ((c = *matchers++) && c != ']') member[c] = nots; + while (TRUE) + {if ((c = scnget (fn)) < 0 || !member[c]) break; + if (assign) *var++ = c; + if (--width == 0) goto done; + } + if (c >= 0) ungetc (c, fn); +done: if (assign) *var = 0; + return (TRUE); + } + +/* SKPBLK - Skips blank things; returns TRUE if won, FALSE if EOF reached */ + +int skpblk (fn) + + {while (TRUE) + {register char c; + if ((c = scnget (fn)) < 0) return (FALSE); + if (c != ' ' && c != '\t' && c != '\n') + {ungetc (c, fn); + return (TRUE); + } + } + } diff --git a/c20/pcc20lib/setjmp.cmid b/c20/pcc20lib/setjmp.cmid new file mode 100644 index 00000000..f7403f26 --- /dev/null +++ b/c20/pcc20lib/setjmp.cmid @@ -0,0 +1,65 @@ +; +; setjmp(), longjmp(), _dismiss() - nonlocal flow of control +; note - unlike UNIX you cannot directly longjmp out of +; an interrupt routine. You may however do so by calling +; the system function _dismiss() before doing the longjmp. +; This will put you back in process context. Then you can +; longjmp() off to where you want to be. + +title setjmp + +.insrt c:cinsrt +.insrt c:minsrt + +subttl setjmp - save a stack environment + +comment | + +After the CENTRY macro, the stack looks like this: + + (P) -> Old frame ptr + -1(P)-> Return address + -2(P)-> Argument to setjmp() + +|; end comment + +centry setjmp,[envp] + + hrrz a,envp ;get environment pointer + move b,-1(p) ;return pc + movem b,(a) ;save return pc + move b,p ;get current sp + adjsp b,-2 ;sp before call + movem b,1(a) ;save stack pointer + move b,(p) ;get pre-call frame pointer + movem b,2(a) ;save it away. + setz a, ;return zero + return + + +subttl longjmp - return to a stack environment saved by setjmp + +centry longjmp,[envp,val] + + hrrz b,envp ;get env pointer + move a,val ;set up the return value + hrrz d,(b) ;pick up return address + move p,1(b) ;restore stack pointer + move ep,2(b) ; and frame pointer + jrst (d) ;and off we go + + +subttl _dismiss() - leave interrupt context + +.global intnum,pclev3 ;in C20RUN + +centry %dismiss + skipn intnum ;doing an interrupt? + jrst ds$1 ;no, just return + movei b,ds$1 ;yes, get a place for debrk to return to + hrli b,010000 ;turn on user-mode bit + movem b,pclev3 ;make this saved address + setzm intnum ;no more interrupt + debrk ;dismiss +ds$1: return ;and say goodbye + end diff --git a/c20/pcc20lib/stdio.h b/c20/pcc20lib/stdio.h new file mode 100644 index 0000000000000000000000000000000000000000..f2e97b5e309eabc01b5387fc1a66807f98581290 GIT binary patch literal 1215 zcmZ`&!EW0y49zw93L*oB#AuT=z)l?otXYEv2$}+EFTE);)d-bkLzdfp{zxiyoWZ-0 zw4NR*(vR~D_D{byyV-9rWq_yMJt#8tW16p4a=$3w*m-4u`~!N8%If2xJ3NBI&9vd%s)5(5nI=mZ08Cn}dAm(i>;>WtXO`(1UU8q~!Qw z2(K757`FXj4TjOWAC*@ze(b?b6=)pP&?(?|Ul!NOxsu8!-;<)&${VP}b>UO{I^pA& z{p#n#dfXN`kIo=XRFe^QZUfSIVo<(zt=`UaZfF*|BHOKXl9=K1|Dptb2x$ALHT^(f z(+5T*`LO8$i!`8GT&Jsm2(=+Q8sQ&OoM#<_w*KJWu4rqTm;w?Z1-Bh7)iI}KntV-n zr{|mm5RH+t%arj<1e>B*DhUXyJ|xo77TDoZ*9Tf%6-(1O<#A?7 KmV7!G4E_RHvTu$6 literal 0 HcmV?d00001 diff --git a/c20/pcc20lib/stdio.stinkr b/c20/pcc20lib/stdio.stinkr new file mode 100644 index 00000000..a6dc32ed --- /dev/null +++ b/c20/pcc20lib/stdio.stinkr @@ -0,0 +1,31 @@ +s 140,p,n,n +i linit +l MSC:alloc +l MSC:apfnam +l MSC:atoi +l MSC:blt +l MSC:c20dat +l MSC:c20exp +l MSC:c20fd +l MSC:c20fil +l MSC:c20fnm +l MSC:c20int +l MSC:c20io +l MSC:c20lib +l MSC:c20lod +l MSC:c20pip +l MSC:c20run +l MSC:c20std +l MSC:c20sys +l MSC:c20tty +l MSC:cfloat +l MSC:cprint +l MSC:ctype +l MSC:date +l MSC:fprint +l MSC:halves +l MSC:pr60th +l MSC:random +l MSC:scanf +l MSC:string +l MSC:stringp diff --git a/c20/pcc20lib/string.cmid b/c20/pcc20lib/string.cmid new file mode 100644 index 00000000..b088458d --- /dev/null +++ b/c20/pcc20lib/string.cmid @@ -0,0 +1,125 @@ +; +; STRING - C STRING, BYTE, AND BIT ROUTINES +; +; This file is PDP-10 dependent, system-independent. +; + +;TITLE STRING ;[plb] confuses with STRINGP (STRNGP.REL) +TITLE STR +.INSRT SS:CINSRT +.INSRT SS:MINSRT + +; CONTAINS: + +; SLEN ; STRING LENGTH +; STCPY ; STRING COPY +; STCMP ; STRING COMPARE +; LOWER ; CVT CHAR TO LOWER CASE +; UPPER ; CVT CHAR TO UPPER CASE + +; BGET ; BIT ARRAY BIT GET +; BSET ; BIT ARRAY BIT SET + +; ILDB ; INCREMENT AND LOAD BYTE +; IDPB ; INCREMENT AND DEPOSIT BYTE + +CENTRY SLEN,[STR] ; STRING LENGTH + + MOVE B,STR ; POINTER TO STRING +SL$1: SKIPE (B) ; GET NEXT CHARACTER + AOJA B,SL$1 + SUB B,STR + MOVEI A,(B) + RETURN + +CENTRY STCPY,[SRC,DEST] ; STRING COPY + + ; COPY STRING FROM SRC TO DEST + ; RETURN POINTER TO NULL TERMINATING NEW COPY + + MOVE B,SRC ; SOURCE POINTER + MOVE A,DEST ; DESTINATION POINTER + SUBI B,(A) + HRLI B,A ; HACK TO MAKE LOOP SHORTER +SC$1: MOVE C,@B ; GET NEXT CHAR + MOVEM C,(A) ; STORE + CAIE C,0 + AOJA A,SC$1 ; INCR BOTH POINTERS +SC$RET: RETURN + +CENTRY STCMP,[S1,S2] ; STRING COMPARE + + MOVE B,S1 + MOVE C,S2 + SUBI C,(B) + HRLI C,B +SM$1: MOVE A,(B) ; GET NEXT CHAR + CAME A,@C + GO SM$2 + CAIE A,0 + AOJA B,SM$1 + MOVEI A,1 + RETURN +SM$2: MOVEI A,0 + RETURN + +CENTRY LOWER,[CH] ; CVT CHAR TO LOWER CASE + + MOVE A,CH + CAIL A,"A + CAILE A,"Z + CAIA + ADDI A,"a-"A + RETURN + +CENTRY UPPER,[CH] ; CVT CHAR TO UPPER CASE + + MOVE A,CH + CAIL A,"a + CAILE A,"z + CAIA + SUBI A,"a-"A + RETURN + +CENTRY BGET,[BARRAY,BINDEX] ; BIT ARRAY BIT GET + + HRRZ C,BINDEX + HRRZ A,BARRAY + MOVEI B,(C) ; SUBSCRIPT + + LSH C,-5 ; GET WORD OFFSET + ADDI A,(C) ; GET WORD ADDRESS + MOVE A,(A) ; GET THE WORD + ANDI B,37 ; BIT OFFSET + ROT A,1(B) ; PUT BIT IN RIGHT-MOST POSITION + ANDI A,1 ; GET THE BIT + RETURN + +CENTRY BSET,[BARRAY,BINDEX] ; BIT ARRAY BIT SET + + HRRZ C,BINDEX + HRRZ A,BARRAY + MOVEI B,(C) ; SUBSCRIPT + + LSH C,-5 ; GET WORD OFFSET + ADDI A,(C) ; GET WORD ADDRESS + ANDI B,37 ; BIT OFFSET + MOVN B,B ; NEGATIVE BIT OFFSET + MOVEI C,1 ; A BIT + ROT C,-1(B) ; PUT IN RIGHT POSITION + IORM C,(A) ; SMASH ARRAY WORD + MOVEI A,1 + RETURN + +CENTRY ILDB,[ABPTR] ; INCREMENT AND LOAD BYTE + + ILDB A,@ABPTR + RETURN + +CENTRY IDPB,[CH,ABPTR] ; INCREMENT AND DEPOSIT BYTE + + MOVE B,CH ; THE CHARACTER + IDPB B,@ABPTR + RETURN + +END diff --git a/c20/pcc20lib/stringp.c b/c20/pcc20lib/stringp.c new file mode 100644 index 00000000..f77e283c --- /dev/null +++ b/c20/pcc20lib/stringp.c @@ -0,0 +1,89 @@ +/********************************************************************** + + SCONCAT - String Concatenate + + concatenate strings S1 ... Sn into buffer B + return B + +**********************************************************************/ + +# ifdef snyder_compiler +# define bumps *s++ +# else +# define bumps *s-- +# endif + +char *sconcat (b, n, s1, s2, s3, s4, s5, s6, s7, s8, s9, s10, s11, s12, s13) + char *b, *s1, *s2, *s3, *s4, *s5, *s6, *s7, *s8, *s9, *s10, + *s11, *s12, *s13; + + {char **s; + register char *p, *q; + register int c; + + q = b; + s = &s1; + + while (--n >= 0) + {p = bumps; + while (c = *p++) *q++ = c; + } + + *q = 0; + return (b); + } + +/********************************************************************** + + SLOWER - Convert String To Lower Case + +**********************************************************************/ + +slower (s) + register char *s; + + {register int c; + while (c = *s) *s++ = lower (c); + } + +/**************************************************************** + + CMOVE, SMOVE - copy non-overlapping regions + +****************************************************************/ + +smove (from, to, n) + int *from, *to, n; + + {if (n > 0) blt (from, to, n);} + +cmove (from, to, n) + char *from, *to; + int n; + + {if (n > 0) blt (from, to, n);} + +/**************************************************************** + + CFILL, SFILL - fill a region with a given value + +****************************************************************/ + +sfill (start, count, val) + int *start, count, val; + + {if (count > 0) + {*start = val; + if (--count > 0) blt (start, start + 1, count); + } + } + +cfill (start, count, val) + char *start, val; + int count; + + {if (count > 0) + {*start = val; + if (--count > 0) blt (start, start + 1, count); + } + } diff --git a/c20/setjmp.h b/c20/setjmp.h new file mode 100644 index 00000000..e9a37da3 --- /dev/null +++ b/c20/setjmp.h @@ -0,0 +1,4 @@ +/* type defn for PDP-10 setjmp buffer */ +/* PLB@DEC */ + +typedef int jmp_buf[17]; diff --git a/c20/stdio.h b/c20/stdio.h new file mode 100644 index 00000000..275294ba --- /dev/null +++ b/c20/stdio.h @@ -0,0 +1,40 @@ +/* STDIO.H for TOPS-20 implementation */ + +/* actual code is in C20STD.C */ + +# define BUFSIZ 512 /* this number is irrelevant */ +# define FILE int /* the actual structure is irrelevant */ +# define NULL 0 /* null file pointer for error return */ +# define EOF (-1) /* returned on end of file */ + +# define peekchar pkchar /* rename to avoid name conflict */ +# define fopen flopen /* " */ +# define getc fgetc /* " */ +# define gets ffgets /* " */ +# define getchar fgeth /* " */ +# define fprintf ffprintf /* " */ +# define calloc fcalloc /* " */ +# define scanf pscanf /* " */ +# rename cscanf "ZSCANF" /* " */ + +# define feof ceof /* direct translation */ +# define putc cputc /* " */ +# define fputc cputc /* " */ +# define putw cputi /* " */ +# define fseek seek /* " */ +# define ftell tell /* " */ +# define malloc salloc +# define free sfree + +extern int cinblk, coutblk, cerrblk; + +# define stdin (&cinblk) +# define stdout (&coutblk) +# define stderr (&cerrblk) + +extern FILE *fopen(), *freopen(); +extern long int ftell(); +extern char getc(), fgetc(), peekc(), pkchar(), putc(), fputc(), getchar(); +extern char *gets(), *fgets(), *ftoa(), *getpw(), *ctime(); +extern double atof(); +extern int *calloc(); diff --git a/c20/stinkr/s.h b/c20/stinkr/s.h new file mode 100644 index 00000000..76b8ec94 --- /dev/null +++ b/c20/stinkr/s.h @@ -0,0 +1,86 @@ +# include "c.defs" + +# define PAGE_SHIFT 10 +# ifdef tops20 +# define PAGE_SHIFT 9 +# endif + +# define PAGE_SIZE (1<= 1025 */ +# define NWINDOW 4 /* number of windows onto inferior */ + +# define NAMMASK 0037777777777 /* name mask away flags */ +# define SYMMASK 0037777777777 /* symtab mask for name */ +# define SYMDBIT 0400000000000 /* symtab 'defined' bit */ +# define SYMHBIT 0200000000000 /* symtab 'half kill' bit */ + +# define DDTHBIT 0400000000000 /* DDT symtab 'half kill' bit */ +# define DDTGBIT 0040000000000 /* DDT symtab 'global' bit */ + +# define ONEXT -1 /* segment origin at next word */ +# define OPAGE -2 /* segment origin at next page */ + +/* + * symbol types + * + * program = record [n: name, vals: sequence[symbol]] + * symbol = oneof [undefined: list[fixup], defined: int] + * fixup = record [ + * subtract: boolean, + * swap: boolean, + * action: oneof [word, right, left, ac], + * location: int + * ] + */ + +typedef int fixup; +struct _fxcell {fixup f; struct _fxcell *p;}; +typedef struct _fxcell fxcell; +typedef struct _fxcell *fxlist; +struct _syment {int sym, val; struct _syment *next;}; +typedef struct _syment syment; +typedef struct _syment *symbol; +typedef int name; +struct _progent {name n; symbol p;}; +typedef struct _progent progent; + +# define fixsub(x) ((x) & 010000000) +# define fixswap(x) ((x) & 04000000) +# define fixact(x) (((x) >> 18) & 03) +# define fixloc(x) ((x) & 0777777) +# define fixcons(sub,swap,act,loc) ((sub)<<21|(swap)<<20|(act)<<18|(loc)) +# define fa_word 0 +# define fa_right 1 +# define fa_left 2 +# define fa_ac 3 + +# define symdefined(z) ((z)->sym<0) +# define symname(z) (((z)->sym)&SYMMASK) +# define symvalue(z) ((z)->val) +# define symfixups(z) ((z)->val) +# define symhkill(z) ((z)->sym =| SYMHBIT) +# define symhkilled(z) ((z)->sym & SYMHBIT) + +# define wleft(w) ((w)>>18) +# define wright(w) ((w)&0777777) +# define wcons(l,r) (((l)<<18)|((r)&0777777)) + \ No newline at end of file diff --git a/c20/stinkr/s10.stinkr b/c20/stinkr/s10.stinkr new file mode 100644 index 00000000..cffb1653 --- /dev/null +++ b/c20/stinkr/s10.stinkr @@ -0,0 +1,11 @@ +x c/clib +l stinkr.stk +l ssym.stk +l sread.stk +l sload.stk +l sjob10.stk +l sjob.stk +l ar3:c;jobs +l ar3:c;c10fnm +o ts.stinkr + \ No newline at end of file diff --git a/c20/stinkr/sjob.c b/c20/stinkr/sjob.c new file mode 100644 index 00000000..df35bc33 --- /dev/null +++ b/c20/stinkr/sjob.c @@ -0,0 +1,98 @@ +# include "s.h" + +/********************************************************************** + + STINKR + Code for manipulating inferior process. + Relatively system-independent code. + +**********************************************************************/ + +int job; /* some identification of inferior process */ +int jch; /* the inferior process handle (for calls) */ +int jpages[NPAGES]; /* "page map" of inferior process */ +int *jwindow[NWINDOW]; /* pointer to windows */ +int jwpage[NWINDOW]; /* page number of first window */ +int jcpage[NWINDOW]; /* current inferior pages in windows */ +int jnwindow; /* next window to be used */ +extern int startadr; +extern char oname[]; + +jinit () + + {job = j_create (0202027); + if (job<0) fatal ("unable to create inferior"); + jch = jbhandle (job); + jpages[0] = 1; + jnwindow = NWINDOW; + + while (--jnwindow >= 0) + {jcpage[jnwindow] = -1; + jwpage[jnwindow] = pg_get (1); + jwindow[jnwindow] = jwpage[jnwindow] << PAGE_SHIFT; + } + jnwindow = 0; + } + +int jread (l) + {int p, w; + p = l >> PAGE_SHIFT; + w = NWINDOW; + while (--w >= 0) + if (p == jcpage[w]) + return (jwindow[w][l & PAGE_MASK]); + if (p >= NPAGES) bletch ("bad page number"); + if (jpages[p] == 0) + {pgwzero (jch, p); + jpages[p] = 1; + } + pgwindow (jch, p, jwpage[jnwindow]); + jcpage[jnwindow] = p; + p = jnwindow; + if (++jnwindow >= NWINDOW) jnwindow = 0; + return (jwindow[p][l & PAGE_MASK]); + } + +int jwrite (l, v) + {int p, w; + p = l >> PAGE_SHIFT; + w = NWINDOW; + while (--w >= 0) + if (p == jcpage[w]) + {jwindow[w][l & PAGE_MASK] = v; + return; + } + if (p >= NPAGES) bletch ("bad page number"); + if (jpages[p] == 0) + {pgwzero (jch, p); + jpages[p] = 1; + } + pgwindow (jch, p, jwpage[jnwindow]); + jcpage[jnwindow] = p; + p = jnwindow; + if (++jnwindow >= NWINDOW) jnwindow = 0; + jwindow[p][l & PAGE_MASK] = v; + } + +jexit () + + {extern int ninit, iloc[]; + extern name iname[]; + int i; + + for (i=0;i= 0) jbrun (job, jch, loc, iname[i]); + } + + if (oname[0]) /* write output file */ + {int ofd; + ofd = sopen (oname, 'w', "b"); + if (ofd==OPENLOSS) return; + jbdump (jch, ofd, startadr); + cclose (ofd); + } + j_kill (job); + } + diff --git a/c20/stinkr/sjob10.c b/c20/stinkr/sjob10.c new file mode 100644 index 00000000..22bab172 --- /dev/null +++ b/c20/stinkr/sjob10.c @@ -0,0 +1,116 @@ +# include "s.h" +# include "c/its.bits" + +/********************************************************************** + + STINKR + System-dependent code for manipulating inferior process. + This version for running on ITS. + +**********************************************************************/ + +int jbhandle (j) + + {return (j_ch (j)); + } + +pgwzero (jch, p) + int jch; + int p; + + /* write a zero page into page P of inferior */ + {corblk (0300000,jch,p,-5,0); + } + +pgwindow (jch, p, mypage) + int jch; + int p; + int mypage; + + /* map inferior page P into my page MYPAGE */ + {corblk (0110000,-1,mypage,jch,p); + } + +jsetup (jch) + + {extern int nsegs, segaorg[], cloc[]; + int n; + for (n=0;n> 35; + checksum = (checksum << 1) + hi + w; + } + +sostart (count, jch, ofd) + + {count = (count + 1) * 2; + checksum = 0; + oofd = ofd; + souti ((-count)<<18); + souti (015315513316); + souti ((-count)<<18); + } + +soentry (p, jch, ofd) + symbol p; + + {name n; + n = (symname (p) & SYMMASK) | DDTGBIT; + if (symhkilled (p)) n =| DDTHBIT; + souti (n); + souti (symvalue (p)); + } + +soend (count, jch, ofd) + {souti (checksum); + } + + \ No newline at end of file diff --git a/c20/stinkr/sjob20.c b/c20/stinkr/sjob20.c new file mode 100644 index 00000000..a31a2254 --- /dev/null +++ b/c20/stinkr/sjob20.c @@ -0,0 +1,167 @@ +# include "s.h" + +# define _CLOSF SYSCLOSF + +/********************************************************************** + + STINKR + System-dependent code for manipulating inferior process. + This version for running on TOPS-20. + +**********************************************************************/ + +int j_create (jname) + + {int j; + j = _CFORK (0200000000000, 0); + /* create process, with my capabilities */ + if (j >= 0600000) return (-2); + return (j); + } + +int jbhandle (j) + + {return (j); + } + +int j_kill (j) + + {_KFORK (j); + } + +int pg_get (n) + + {static int space[(NWINDOW+1)*PAGE_SIZE]; + /* space used for windows */ + static int *sp {space}; + /* pointer to next available page */ + + int i, pn; + i = sp; + if (i & PAGE_MASK) /* sp hasn't been aligned yet */ + {i =+ PAGE_MASK; + i =& ~PAGE_MASK; + } + pn = i >> PAGE_SHIFT; /* page number of allocated page */ + i =+ PAGE_SIZE; /* advance to next page */ + sp = i; + return (pn); + } + +pgwzero (jch, p) + int jch; + int p; + + /* write a zero page into page P of inferior */ + {; /* not needed on TOPS-20 */ + } + +pgwindow (jch, p, mypage) + int jch; + int p; + int mypage; + + /* map inferior page P into my page MYPAGE */ + {_PMAP (wcons(jch,p), wcons(0400000,mypage), wcons(0140000,0)); + } + +jsetup (jch) + + {extern int nsegs, segaorg[], cloc[]; + int n; + + /* append symbol table to highest segment */ + symwrite (jch, 0); + /* initialize segment tables for program's benefit */ + for (n=0;n> 18) & 07777; + if (code == 2) return; + cprint ("Initialization routine %x failed, ", n); + if (code == 3) + {int number; + number = sts & 0777777; + cprint ("error number %d.\n", number); + } + else cprint ("status %d.\n", code); + } + +jbdump (jch, ofd, startadr) + + {int jfn; + jfn = cjfn (ofd); + _CLOSF (wcons (0400000, jfn)); /* do not release */ + jwrite (0120, wcons (jread (0121), startadr)); + _SEVEC (jch, wcons (0254000, startadr)); + _SSAVE (wcons (jch, jfn), wcons (-NPAGES, 0360000)); + } + +static int where; + +souti (w) + + {jwrite (where, w); + where = where + 1; + } + +sostart (count, jch, ofd) + + {extern int cloc[], nsegs; + int pat; + where = cloc[nsegs-1]; + count =* 2; + count =+ 2*2; /* pat.. and program entries */ + pat = where + count; + if (pat%2 == 1) /* make sure patch area on even address */ + ++pat; + jwrite (0116, wcons (-count, where)); + jwrite (0121, where+count); + jwrite (0133, where+count-1); + cloc[nsegs-1] = pat+32; /* leave room for DDT patch area */ + souti (rj40 (rdname ("pat..")) | DDTGBIT); + souti (pat); + } + +soentry (p, jch, ofd) + symbol p; + + {name n; + n = symname (p) & SYMMASK; + n = rj40 (n); + n =| DDTGBIT; + if (symhkilled (p)) n =| DDTHBIT; + souti (n); + souti (symvalue (p)); + } + +soend (count, jch, ofd) + + {; + souti (017573520526); + souti (wcons (-0100, 0100)); + } + +rj40 (n) /* right justify a SQUOZE coded symbol (remove trailing blanks) */ + + {for (;;) + {int c; + c = n % 40; /* trailing character */ + if (c) break; /* not a blank */ + n =/ 40; /* remove trailing character */ + } + return (n); + } + \ No newline at end of file diff --git a/c20/stinkr/sload.c b/c20/stinkr/sload.c new file mode 100644 index 00000000..8e923bc6 --- /dev/null +++ b/c20/stinkr/sload.c @@ -0,0 +1,262 @@ +# include "s.h" + +extern int debug, pflag; /* option flags */ +extern int ovflag; /* assignment being processed */ +extern int nlfile; /* number of loaded files */ + +int loc; /* current location */ +int creloc[MAXSEGS]; /* current relocation */ +int cloc[MAXSEGS]; /* current location */ +int segvsiz[MAXSEGS]; /* declared size of segments for + current load file */ +int segvorg[MAXSEGS]; /* segment virtual origins */ +int segaorg[MAXSEGS] /* segment actual origins */ + {ORIGIN_0, ORIGIN_1}; /* default values */ +int cseg 0; /* current segment */ +int nvsegs 2; /* number of virtual segments for + current load file */ +int nsegs 2; /* number of segments */ + +linit () + {int n; + for (n=0;n=0) cloc[cseg] = loc; + for (n=0;ncloc[n]) cloc[n] = nloc; + } + } + +getval (n, sub) name n; int sub; + + {symbol s; + int swap, action, flags, global; + + flags = n >> 32; + swap = (flags >> 3) & 1; + action = (flags >> 1) & 03; + global = flags & 01; + + if (!global) + {error ("reference to local symbol %x not implemented", n); + return (0); + } + s = symfind (n); + if (symdefined (s)) + {int val; + val = symvalue (s); + if (swap) val = wswap (val); + if (sub) val = -val; + switch (action) { + case fa_word: break; + case fa_right: val =& 0777777; break; + case fa_left: val =& ~0777777; break; + case fa_ac: val =& 0740000000; break; + } + return (val); + } + if (ovflag) + {error ("%x undefined in assignment", n); + return (0); + } + symaddfix (s, fixcons (sub, swap, action, loc)); + return (0); + } + +linkreq (n, chain) name n; int chain; + + {int flags, relocate, global, count; + flags = n >> 32; + global = flags & 01; + relocate = chain & 0100000000000; + chain =& 0777777; + if (relocate) chain = reloc (chain); + if (global) + {symbol s; + if (pflag) cprint ("\n\tlink for global %x at %o", + n, chain); + s = symfind (n); + count = 1000; + while (chain) + {int w; + if (--count < 0) + {error ("link chain too long"); + break; + } + w = jread (chain); + if (symdefined (s)) + {if (debug) cprint ("\n\tsmashing"); + jwrite (chain, wcons(wleft(w), + wright(symvalue(s)))); + } + else + {if (debug) cprint ("\n\tfollowing"); + jwrite (chain, w & 0777777000000); + symaddfix (s, fixcons(0,0,fa_right,chain)); + } + if (debug) cprint (" link at %o", chain); + chain = wright(w); + } + } + else + {if (pflag) cprint ("\n\tlink for local %x at %o", + n, chain); + unimplemented (); + } + } + +dodef (n, val, allowredef) name n; + + {int flags, rleft, rright, global, halfkill; + flags = n >> 32; + halfkill = flags & 010; + rleft = flags & 04; + rright = flags & 02; + global = flags & 01; + + if (pflag) + {if (allowredef) cprint ("\n\tredefine symbol"); + else cprint ("\n\t define symbol"); + if (halfkill) cprint (" half-killed"); + if (global) cprint (" global"); + else cprint (" local"); + cprint (" %x = ", n, val); + } + if (rright) val = wcons(wleft(val),reloc(wright(val))); + if (rleft) val = wcons(reloc(wleft(val)),wright(val)); + if (pflag) cprint ("%o", val); + if (global) + {symbol s; + s = symfind (n); + if (symdefined (s) && symvalue (s) != val && !allowredef) + error ("%x multiply defined", n); + else symdef (s, val); + if (halfkill) symhkill (s); + } + } + +setloc (l) + {loc = l; + if (cseg >= 0) cloc[cseg] = loc; + } + +setaloc (l) + {if (cseg >= 0) cloc[cseg] = loc; + loc = l; + cseg = -1; + if (debug) cprint ("\n\tswitching to absolute mode"); + } + +setrloc (l) + + {int n, o; + + n = nvsegs; + while (--n > 0) if (l >= segvorg[n]) break; + o = l - segvorg[n]; + if (n != cseg) if (cseg >= 0) cloc[cseg] = loc; + cseg = n; + loc = creloc[n] + o; + } + +reloc (l) + + {int n, o; + + n = nvsegs; + while (--n >= 0) if ((o = l - segvorg[n]) >= 0) break; + if (o<0) + {error ("virtual address %o not in any segment", l); + return (0); + } + n = creloc[n] + o; + if (n<0 || n>=01000000) + {error ("address wraparound"); + n =& 0777777; + } + return (n); + } + +char *actnam[] {"word", "right half of", "left half of", "AC of"}; + +dofixup (f, val) fixup f; + + {int lc, action, sub, swap; + sub = fixsub (f); + swap = fixswap (f); + action = fixact (f); + lc = fixloc (f); + if (debug) cprint ("\n\tfixup %s %o to %o", + actnam[action], lc, val); + if (swap) {val = wswap (val); if (debug) cprint (" (swap)");} + if (sub) {val = -val; if (debug) cprint (" (subtract)");} + switch (action) { + case fa_word: break; + case fa_right: val =& 0777777; break; + case fa_left: val =& ~0777777; break; + case fa_ac: val =& 0740000000; break; + } + jwrite (lc, jread (lc) + val); + } + \ No newline at end of file diff --git a/c20/stinkr/sread.c b/c20/stinkr/sread.c new file mode 100644 index 00000000..03fdde3c --- /dev/null +++ b/c20/stinkr/sread.c @@ -0,0 +1,531 @@ +# include "s.h" + +int bcount; /* number of current block in file */ +int boffset; /* offset of current block in file */ +int eof; /* eof flag */ +int type; /* type of current block */ +int size; /* size field of current block */ +int adr; /* address field of current block */ +int block[MAXBLOCK]; /* current block from load file */ +int *blkp; /* current location in block */ +int *eblk; /* end of block */ +int lfile; /* current file being loaded */ +int loffset; /* current offset in load file */ +int ovflag; /* flag indicating one value needed */ +int value; /* current standard block value */ +int valexists; /* a value has been defined */ +int startadr; /* program starting address */ + +int segsiz[MAXSEGS]; /* segment sizes (for 2-pass) */ + +extern int loc, cseg, nsegs, nvsegs, segvorg[], segvsiz[], debug, pflag; +extern int pass, npass, comfd; +extern char *combuf; + +loadfile (s) char *s; + + {char buf[100]; + stcpy (s, buf); + lfile = sopen (buf, 'r', "b"); + if (lfile != OPENLOSS) + {if (pass < npass) load1 (buf); + else load2 (buf); + } + } + +load1 (s) char *s; /* load file - first pass of two-pass loading */ + + {if (combuf == 0) + {combuf = calloc (COMSIZ); + comfd = copen (combuf, 'w', "s"); + } + cprint (comfd, "l %s\n", s); + bcount = loffset = eof = 0; + while (TRUE) + {rdblock(); + if (eof) break; + if (bcount > 3) break; + if (type == 030) /* define segment block */ + {int n; + n = 0; + while (blkp < eblk && n>35; + type = (header>>25) & 0177; + size = (header>>18) & 0177; + adr = header & 0777777; + ++bcount; + if (eof) return; + p = block; + n = size; + eblk = p + n; + while (--n >= 0) *p++ = geti (lfile); + geti (lfile); + if (ceof (lfile)) + {error ("premature EOF"); + eof = 1; + } + loffset =+ (size + 2); + } + +prblock () + + {cprint ("#%d (%o) type=%d, size=%d, adr=%o\n", bcount, + boffset,type, size, adr); + } + +doblock () + + {switch (type) { + case 001: ldcom(); break; + case 002: absol(); break; + case 003: dreloc(); break; + case 004: dpname(); break; + case 005: lsrch(); break; + case 006: commn(); break; + case 007: gassn(); break; + case 010: locals(); break; + case 011: lcond(); break; + case 012: elcnd(); break; + case 013: dhkill(); break; + case 014: eprog(); break; + case 015: entries(); break; + case 016: externs(); break; + case 017: lifneed(); break; + case 020: globals(); break; + case 021: fixups(); break; + case 022: polish(); break; + case 023: dlnklst(); break; + case 024: dldfile(); break; + case 025: dldlib(); break; + case 026: dlvar(); break; + case 027: dindex(); break; + case 030: dhiseg(); break; + default: error ("illegal block type"); + } + } + +ldcom() + {if (pflag) cprint ("Loader command: "); + switch (adr) { + case 0: lcassn(); break; + case 1: ljump(); break; + case 2: lgloc(); break; + case 3: lcommon(); break; + case 4: lgreloc(); break; + case 5: lcvalue(); break; + case 6: lgoffset(); break; + case 7: loper(); break; + case 8: lrgoffset(); break; + default: error ("bad loader command"); + } + } + +absol() + {if (pflag) cprint ("Absolute block"); + setaloc (adr); + if (pflag) cprint (" at %o", loc); + standard (); + } + +dreloc() + {if (pflag) cprint ("Relocatable block"); + if (size > 0 || bcount > 2) /* avoid MIDAS problem */ + {setrloc (adr); + if (pflag) cprint (" at %o (segment %d)", loc, cseg); + standard (); + } + } + +dpname() + {if (pflag) cprint ("Program name"); + if (size > 2) badfmt (); + else + {name n; + n = block[0]; + stpname (n); + if (pflag) cprint (": %x", n); + } + } + +lsrch() + {if (pflag) cprint ("Library search"); + unimplemented (); + } + +commn() + {if (pflag) cprint ("Common block"); + unimplemented (); + } + +gassn() + {if (pflag) cprint ("Global parameter assignment: "); + assnb (); + } + +locals() + {if (pflag) cprint ("Local symbols"); + if (size&1) badfmt (); + while (blkp> 32; + if (pflag) + {cprint ("\n\t%x %13o", sym, val); + if (flags & 010) cprint (" (half-kill)"); + if (flags & 004) cprint (" (LH reloc)"); + if (flags & 002) cprint (" (RH reloc)"); + if (flags & 001) cprint (" (block name)"); + } + } + } + +lcond() + {if (pflag) cprint ("Load-time conditional"); + unimplemented (); + } + +elcnd() + {if (pflag) cprint ("End load-time conditional"); + unimplemented (); + } + +dhkill() + {if (pflag) cprint ("Local half-killed symbols"); + while (blkp < eblk) + {int sym; + sym = *blkp++; + if (pflag) cprint ("\n\t%x", sym); + hkill (sym); + } + } + +eprog() + {if (pflag) cprint ("End of program"); + unimplemented (); + } + +entries() + {if (pflag) cprint ("Entries"); + unimplemented (); + } + +externs() + {if (pflag) cprint ("External symbols"); + unimplemented (); + } + +lifneed() + {if (pflag) cprint ("Load if needed"); + unimplemented (); + } + +globals() + {if (pflag) cprint ("Global symbols"); + if (size&1) badfmt (); + unimplemented (); + while (blkp < eblk) + {int sym, val; + sym = *blkp++; + val = *blkp++; + if (pflag) cprint ("\n\t%x %o", sym, val); + } + } + +fixups() + {if (pflag) cprint ("Fixups"); + unimplemented (); + } + +polish() + {if (pflag) cprint ("Polish fixups"); + unimplemented (); + } + +dlnklst() + {if (pflag) cprint ("Link list"); + unimplemented (); + } + +dldfile() + {if (pflag) cprint ("Load file"); + unimplemented (); + } + +dldlib() + {if (pflag) cprint ("Load library"); + unimplemented (); + } + +dlvar() + {if (pflag) cprint ("Local variables"); + unimplemented (); + } + +dindex() + {if (pflag) cprint ("Index"); + unimplemented (); + } + +dhiseg() + {int n; + if (pflag) cprint ("High segment"); + n = 0; + while (blkp < eblk && nnsegs) error ("more virtual segments used than defined"); + nvsegs = n; + } + +lcassn() + {if (pflag) cprint ("global parameter assignment: "); + assnb (); + } + +ljump() + {int l; + if (pflag) cprint ("starting address specification"); + l = oneval (); + if (l) startadr = l; + if (pflag) cprint (": %o", l); + } + +lgloc() + {if (pflag) cprint ("global location assignment"); + unimplemented (); + } + +lcommon() + {if (pflag) cprint ("reset COMMON origin"); + unimplemented (); + } + +lgreloc() + {if (pflag) cprint ("reset global relocation constant"); + unimplemented (); + } + +lcvalue() + {if (pflag) cprint ("loader conditional on value"); + unimplemented (); + } + +lgoffset() + {if (pflag) cprint ("set global offset"); + unimplemented (); + } + +loper() + {if (pflag) cprint ("load-time instruction execution"); + unimplemented (); + } + +lrgoffset() + {if (pflag) cprint ("reset global offset"); + unimplemented (); + } + +assnb() + {int sym, val; + sym = *blkp++; + val = oneval(); + dodef (sym, val, TRUE); + } + +oneval() + + {int result; + value = 0; + valexists = FALSE; + ++ovflag; + standard (); + --ovflag; + result = value; + value = 0; + if (!valexists) error ("missing value"); + return (result); + } + +hkill(n) name n; + {int flags; + flags = n >> 32; + if (flags & 001) + {symbol s; + s = symfind (n); + symhkill (s); + } + } + +standard() + + {int codeword, code, n, sym, data; + while (blkp < eblk) + {codeword = *blkp++; + n = 12; + while (--n >= 0 && blkp < eblk) + {code = (codeword >> 33); + codeword =<< 3; + data = *blkp++; + switch (code) { + case 0: value =+ data; outval (); + continue; + case 1: value =+ wcons(wleft(data),reloc(wright(data))); + outval (); + continue; + case 2: value =+ wcons(reloc(wleft(data)),wright(data)); + outval (); + continue; + case 3: value =+ wcons(reloc(wleft(data)), + reloc(wright(data))); + outval (); + continue; + case 4: sym = data; + value =+ getval (sym, 0); + continue; + case 5: sym = data; + value =+ getval (sym, 1); + continue; + case 6: linkreq (data, *blkp++); + continue; + case 7: if (--n<0) + {if (blkp>=eblk) {badfmt();return;} + codeword = *blkp++; + n = 11; + } + code = (codeword >> 33); + codeword =<< 3; + *--blkp = data; + switch (code) { + case 0: defsym (); continue; + case 1: comrel (); continue; + case 2: lclglo (); continue; + case 3: libreq (); continue; + case 4: rdfsym (); continue; + case 5: glomul (); continue; + case 6: defdot (); continue; + default: error ("bad extend code"); + } + } + } + } + } + +outval () + + {if (ovflag) + {valexists=TRUE; + blkp = eblk; + } + else + {jwrite (loc, value); + value = 0; + setloc(loc+1); + } + } + +defsym () + + {int sym, val; + sym = *blkp++; + val = *blkp++; + dodef (sym, val, FALSE); + } + +comrel () + {if (pflag) cprint ("\n\tcommon relocation"); + ++blkp; + unimplemented (); + } + +lclglo () + {if (pflag) cprint ("\n\tlocal to global recovery"); + ++blkp; + unimplemented (); + } + +libreq () + {if (pflag) cprint ("\n\tlibrary request"); + ++blkp; + unimplemented (); + } + +rdfsym () + {int sym, val; + sym = *blkp++; + val = *blkp++; + dodef (sym, val, TRUE); + } + +glomul () + {if (pflag) cprint ("\n\tmultiply next global"); + unimplemented (); + } + +defdot () + {int sym, flags; + if (pflag) cprint ("\n\t define symbol"); + sym = *blkp++; + flags = sym >> 32; + if (pflag) + {if (flags & 001) cprint (" global"); + else cprint (" local"); + cprint (" %x = . (%o)", sym, loc); + } + if (flags & 001) + {symbol s; + s = symfind (sym); + if (symdefined (s) && symvalue (s) != loc) + error ("%x multiply defined", sym); + else symdef (s, loc); + } + } + \ No newline at end of file diff --git a/c20/stinkr/ssym.c b/c20/stinkr/ssym.c new file mode 100644 index 00000000..d44e6d38 --- /dev/null +++ b/c20/stinkr/ssym.c @@ -0,0 +1,230 @@ +# include "s.h" + +int pname; /* program name */ +syment *hshtab[HSHSIZE]; +syment symtab[MAXSYMS]; +syment *csymp, *esymp; +progent progs[MAXPROGS]; +progent *cprog, *zprog; +fxlist freelist; + +syminit () + + {csymp = symtab; + esymp = symtab + MAXSYMS; + cprog = progs; + zprog = progs + MAXPROGS; + freelist = 0; + } + +stpname (n) name n; + {pname = n & NAMMASK; + } + +symsprog () + + {if (cprog >= zprog) fatal ("too many programs"); + cprog->n = 0; + cprog->p = csymp; + } + +symeprog () + + {cprog->n = pname; + ++cprog; + } + +symbol symfind (n) name n; + + {symbol p; + int h; + + n =& NAMMASK; + h = n % HSHSIZE; + p = hshtab[h]; + while (p) if (symname(p) == n) return (p); else p=p->next; + if (csymp>=esymp) fatal ("too many symbols"); + p = csymp++; + p->sym = n; + p->val = 0; + p->next = hshtab[h]; + hshtab[h] = p; + return (p); + } + +symdef (p, val) symbol p; int val; + + {if (!symdefined (p)) sfixups (p->val, val); + p->sym =| SYMDBIT; + p->val = val; + } + +sfixups (l, val) fxlist l; int val; + + {while (l) + {fxlist next; + dofixup (l->f, val); + next = l->p; + fcreturn (l); + l = next; + } + } + +symaddfix (p, f) symbol p; fixup f; + + {if (symdefined (p)) + bletch ("attempt to add fixup to defined symbol"); + else + {fxlist l, fcalloc (); + l = fcalloc (); + l->f = f; + l->p = p->val; + p->val = l; + } + } + +symulist () /* works on original table only */ + + {symbol p; + progent *pp; + int ucount, lcount; + name pn, opn; + + pp = progs; + opn = ucount = 0; + for (p=symtab;pp && ppn; + ++pp; + } + n = symname (p); + defined = symdefined (p); + if (defined) continue; + if (++ucount == 1) + cprint ("\n\n --- Undefined Symbols ---"); + if (opn != pn) + {cprint ("\n\nProgram %x\n", pn); + opn = pn; + lcount = 7; + } + if (++lcount == 8) + {cprint ("\n"); + lcount = 0; + } + if (lcount != 0) cprint ("\t"); + cprint ("%x", n); + } + if (ucount) cprint ("\n"); + } + +symlist () /* works on rehashed table only */ + + {int h; + cprint ("\n\n --- SYMBOL TABLE ---\n\n"); + for (h=0;h<=02000;++h) + {symbol p; + p = hshtab[h]; + while (p) + {name n; + int defined; + n = symname (p); + defined = symdefined (p); + cprint ("\t%x\t", n); + if (defined) cprint ("%13o", symvalue (p)); + else cprint (" undefined"); + cprint ("\n"); + p = p->next; + } + } + } + +symsort () + + {symungo (); /* remove undefined symbols */ + symrehash (); /* rehash, on value */ + } + + +symungo () /* remove undefined symbols */ + + {symbol p, q; + q = symtab; + for (p=symtab;psym = p->sym; + q->val = p->val; + ++q; + } + csymp = q; + } + +symrehas () /* rehash, on value */ + + {symbol p; + int h; + + for (h=0;h> 8); + current = hshtab[h]; + previous = 0; + while (TRUE) + {if (current==0 || symvalue(current) > v) + {p->next = current; + if (previous) previous->next = p; + else hshtab[h] = p; + break; + } + previous = current; + current = current->next; + } + } + } + +symwrite (jch, ofd) + + {int count, h; + count = csymp - symtab; + sostart (count, jch, ofd); + for (h=0;h<=02000;++h) + {symbol p; + p = hshtab[h]; + while (p) + {soentry (p, jch, ofd); + p = p->next; + } + } + soend (count, jch, ofd); + } + +fxlist fcalloc () + + {fxlist p, ep; + + if (freelist==0) + {freelist = salloc (2*NLALLOC); + p = freelist; + ep = p + (NLALLOC-1); + while (p < ep) + {p->p = p+1; + ++p; + } + ep->p = 0; + } + p = freelist; + freelist = p->p; + return (p); + } + +fcreturn (p) fxlist p; + + {p->p = freelist; + freelist = p; + } + \ No newline at end of file diff --git a/c20/stinkr/stinkr.c b/c20/stinkr/stinkr.c new file mode 100644 index 00000000..fe985ca3 --- /dev/null +++ b/c20/stinkr/stinkr.c @@ -0,0 +1,353 @@ +# include "s.h" + +/********************************************************************** + + STINKR + + A relocating loader. Semi-compatible with "STINK" on + the M.I.T. ITS machines. Does not implement a number + of the hairier features of STINK. However, does implement + multiple segments (not just two). + + Written by Alan Snyder for the implementation of C. + +**********************************************************************/ + +int pass; /* current pass (1 or 2) */ +int npass; /* number of passes (1 or 2) */ +int debug, pflag, sflag; /* option flags */ +int nlfile; /* number of files loaded */ +name iname[MAXINIT]; /* name(s) of init routine */ +int iloc[MAXINIT]; /* location(s) of init routine */ +int ninit; /* number of init routines */ +char oname[FNSIZE]; /* name of output file */ +char *combuf; /* command buffer (2-pass only) */ +int comfd; /* command buffer output file */ + +extern int segaorg[], segsiz[], nsegs; + +main (argc, argv) char *argv[]; + + {int prname(); + extern int cin; + char buffer[1000], *outv[100]; + int i; + + npass = pass = 1; + ninit = 0; + setprompt ("="); + fmtf ('x', prname, 1); + syminit (); + jinit (); + linit (); + --argc; + ++argv; + argc = options (argc, argv); + argc = exparg (argc, argv, outv, buffer); + argv = outv; + if (argc == 0) docom (cin); + else while (--argc>=0) dofile (*argv++); + if (npass==2) + {int oo, osz, n; + cclose (comfd); + oo = ORIGIN_0; + osz = 0; + for (n=0; n= 0) + {s = *ss++; + if (s[0] == '-') opt1 (s+1); + else if (s[0] && s[1]=='=') opt2 (s[0], s+2); + else *dd++ = s; + } + return (dd - argv); + } + +opt1 (s) char *s; + + {int c; + while (c = *s++) switch (lower (c)) { + case 'd': debug = TRUE; break; + case 'p': pflag = TRUE; break; + case 's': sflag = TRUE; break; + default: error ("unrecognized option: %c", c); + } + } + +opt2 (c, s) char *s; + + {switch (lower (c)) { + default: error ("unrecognized option: %c=%s", c, s); + } + } + +dofile (s) char *s; + + {int f, c; + char fn[FNSIZE]; + + stcpy (s, fn); + f = sopen (fn, 'r', ""); + if (f == OPENLOSS) return; + c = cgetc (f); + cclose (f); + if (c<2) loadfile (fn); /* its a REL file, we hope */ + else comfile (fn); + } + +comfile (fn) char *fn; + + {int f; + char buf[FNSIZE]; + + stcpy (fn, buf); + f = sopen (buf, 'r', ""); + if (f == OPENLOSS) return; + docom (f); + cclose (f); + } + +docom (f) int f; + + {while (TRUE) + {char buf[500], *s; + int command, c; + s = buf; + while ((c = cgetc (f)) && c != '\n') *s++ = c; + *s = 0; + if (buf[0] == 0 && ceof (f)) break; + command = lower (buf[0]); + if (command == 0 || command == ';') continue; + if (buf[1] != 0 && buf[1] != ' ') + {error ("bad command: %s", buf); + continue; + } + switch (command) { + case 's': defseg (buf+2); continue; + case 'l': loadfile (buf+2); + continue; + case 'x': comfile (buf+2); continue; + case 'i': definit (buf+1); continue; + case 'o': stcpy (buf+2, oname); continue; + case 'q': return; + case '?': prhelp (); continue; + default: error ("bad command: %s", buf); + } + } + } + +definit (s) char *s; + + {if (ninit>=MAXINIT) + {error ("too many initialization routines specified"); + return; + } + iname[ninit] = rdname (s); + ++ninit; + } + +prhelp () + + {puts ("Commands:"); + puts (" s ,,,... - define segments"); + puts (" = octal origin, 'n' (next word), or 'p' (next page)"); + puts (" l - load file"); + puts (" x - execute command file"); + puts (" i - specify name of initialization routine"); + puts (" o - specify name of output file"); + puts (" q - quit (writes output file)"); + puts (""); + puts ("Options:"); + puts (" -s - print symbol table"); + puts (" -p - print tabular representation of object files"); + puts (" -d - print debugging information"); + } + +defseg (s) char *s; + + {if (nlfile>0) error ("too late to define segments"); + else + {int need2; + char *e; + + need2 = FALSE; + npass = 1; + nsegs = 0; + e = s; + while (nsegs='a' && c<='z') c =+ ('A'-'a'); + for (i=0;i<40;++i) + if (c == tab40[i]) + {w =+ (i * factor); + factor =/ 40; + break; + } + if (i>=40) + {error ("bad char %c in name %s", c, s); + break; + } + } + return (w); + } + +prname (n, fn, w, c) name n; + + {n =& NAMMASK; + if (n) p40 (n, fn); + } + +p40 (i, fn) + {int a; + if (a = i/40) p40 (a, fn); + i =% 40; + cputc (tab40[i], fn); + } + +fatal (fmt, a1, a2, a3, a4, a5) + {error (fmt, a1, a2, a3, a4, a5); + cexit (1); + } + +error (fmt, a1, a2, a3, a4, a5) + {cprint ("\n *** "); + cprint (fmt, a1, a2, a3, a4, a5); + cprint (" ***\n"); + } + +bletch (fmt, a1, a2, a3, a4, a5) + {cprint ("\n *** internal error: "); + cprint (fmt, a1, a2, a3, a4, a5); + cprint (" ***\n"); + cexit (2); + } + +unimplemented () + {error ("unimplemented operation"); + } + +badfmt () + {error ("bad format"); + } + +int otoi (s) char *s; + + {int w, c; + w = 0; + while (c = *s++) + {if (c>='0' && c<='7') w = (w<<3) | (c-'0'); + else + {error ("bad char %c in octal %s", c, s); + break; + } + } + return (w); + } + +int wswap (w) + + {return ((w << 18) | (w >> 18)); + } + +int sopen (fnbuf, m, o) char fnbuf[], *o; + /* fnbuf is modified to contain actual file name opened */ + + {if (o==0) o = ""; /* just in case */ + while (TRUE) + {int f; + char temp[FNSIZE]; + fngtp (fnbuf, temp); /* extract type field of file name */ + if (temp[0]==0 && m == 'r') /* not specified, set default */ + {if (o[0]==0) stcpy ("stinkr", temp); + else stcpy ("stk", temp); + fnsdf (fnbuf, fnbuf, 0, 0, 0, temp, 0, 0); + } + f = copen (fnbuf, m, o); + if (f == OPENLOSS) + {cprint ("\nUnable to open %s\n", fnbuf); + cprint ("Use what filename instead ('*' to ignore)? "); + gets (temp); + if (temp[0] == '*' && temp[1] == 0) return (OPENLOSS); + if (temp[0]) stcpy (temp, fnbuf); + } + else return (f); + } + } + \ No newline at end of file diff --git a/c20/stinkr/stinkr.stinkr b/c20/stinkr/stinkr.stinkr new file mode 100644 index 00000000..a756806c --- /dev/null +++ b/c20/stinkr/stinkr.stinkr @@ -0,0 +1,10 @@ +x clib +l c20hak +l stinkr +l ssym +l sread +l sload +l sjob20 +l sjob +o stinkr.exe + \ No newline at end of file diff --git a/c20/yacc.hlp b/c20/yacc.hlp new file mode 100644 index 00000000..6f1fb3ab --- /dev/null +++ b/c20/yacc.hlp @@ -0,0 +1,75 @@ +Operating syntax: + +yacc [switches] input.y + +switches; +-v create y.output (describes states) +-d create ytab.h (help file; contains token defs) + +output is to ytab.c; should be compiled with C:PCC20.EXE +the file YACC.PAR should be available on the device C: + +---------------------------------------------------------------- + +YACC Input syntax; + +/* Comment */ + +both '\' and '%' can be used to prefix pseudo-ops + +%{ text pass text to output file +%} + +%type define type? +%union define union? +%start specify start state? +%term, %token, %0 specify tokens +%<, %left specify left associativity +%2, %binary, %nonassoc specify no associativity +%>, %right specify right associativity +%%, \\ mark - beginning of grammar + +/* productions */ +name: + production1 ={ action; } + | production2 ={ act2; } + . + . + +/* actions (need not be present) */ + +$ ??? +$$ yyval -- production value +$- ??? +$n value of nth token in production + +---------------------------------------------------------------------------- + +To be supplied; + +char *c; + +yyermsg(c) /* YACC fatal error message */ +yylex() /* lexical analyzer -- returns characters, + values from ytab.h, or -1 on EOF */ +yylval /* lexical value set by yylex() + ie; pointer to identifier string */ + +PCC20 demands that its segments be located on SS:, and the MIDAS +code produced .INSRTS files from PS:; Therefore PS:, and SS: must +be re-DEFINED. + +ytab.c will contain the routine yyparse, the file c:yacc.par. + +yparse takes no arguments and returns 0 on a successful parse. When +an (unrecoverable) error occurs yyermsg is called with a message +string of "syntax error" or "yacc stack overflow". + +To debug a parser put a "# define YYDEBUG" at the top of your ytab.c +to include debugging code, and deposit a '1' in the global yydebug +(ZYYDEB) to turn on typeout. + + +yyparse will attempt to recover from an error by popping the stack or +discarding input tokens until a continuable state is found. No indication +is made when error recovery is attempted. diff --git a/c20/yacc.par b/c20/yacc.par new file mode 100644 index 00000000..b0d47565 --- /dev/null +++ b/c20/yacc.par @@ -0,0 +1,149 @@ +# +# define YYFLAG -1000 +# define YYERROR goto yyerrlab +# define YYACCEPT return(0) +# define YYABORT return(1) + +/* parser for yacc output */ + +#ifdef YYDEBUG +int yydebug = 0; /* 1 for debugging */ +#endif +YYSTYPE yyv[YYMAXDEPTH]; /* where the values are stored */ +int yychar = -1; /* current input token number */ +int yynerrs = 0; /* number of errors */ +short yyerflag = 0; /* error recovery flag */ + +yyparse() { + + short yys[YYMAXDEPTH]; + short yyj, yym; + register YYSTYPE *yypvt; + register short yystate, *yyps, yyn; + register YYSTYPE *yypv; + register short *yyxi; + + yystate = 0; + yychar = -1; + yynerrs = 0; + yyerflag = 0; + yyps= &yys[-1]; + yypv= &yyv[-1]; + + yystack: /* put a state and value onto the stack */ + +#ifdef YYDEBUG + if( yydebug ) printf( "state %d, char 0%o\n", yystate, yychar ); +#endif + if( ++yyps> &yys[YYMAXDEPTH] ) { yyermsg( "yacc stack overflow" ); return(1); } + *yyps = yystate; + ++yypv; + *yypv = yyval; + + yynewstate: + + yyn = yypact[yystate]; + + if( yyn<= YYFLAG ) goto yydefault; /* simple state */ + + if( yychar<0 ) if( (yychar=yylex())<0 ) yychar=0; + if( (yyn += yychar)<0 || yyn >= YYLAST ) goto yydefault; + + if( yychk[ yyn=yyact[ yyn ] ] == yychar ){ /* valid shift */ + yychar = -1; + yyval = yylval; + yystate = yyn; + if( yyerflag > 0 ) --yyerflag; + goto yystack; + } + + yydefault: + /* default state action */ + + if( (yyn=yydef[yystate]) == -2 ) { + if( yychar<0 ) if( (yychar=yylex())<0 ) yychar = 0; + /* look through exception table */ + + for( yyxi=yyexca; (*yyxi!= (-1)) || (yyxi[1]!=yystate) ; yyxi += 2 ) ; /* VOID */ + + while( *(yyxi+=2) >= 0 ){ + if( *yyxi == yychar ) break; + } + if( (yyn = yyxi[1]) < 0 ) return(0); /* accept */ + } + + if( yyn == 0 ){ /* error */ + /* error ... attempt to resume parsing */ + + switch( yyerflag ){ + + case 0: /* brand new error */ + + yyermsg( "syntax error" ); + yyerrlab: + ++yynerrs; + + case 1: + case 2: /* incompletely recovered error ... try again */ + + yyerflag = 3; + + /* find a state where "error" is a legal shift action */ + + while ( yyps >= yys ) { + yyn = yypact[*yyps] + YYERRCODE; + if( yyn>= 0 && yyn < YYLAST && yychk[yyact[yyn]] == YYERRCODE ){ + yystate = yyact[yyn]; /* simulate a shift of "error" */ + goto yystack; + } + yyn = yypact[*yyps]; + + /* the current yyps has no shift onn "error", pop stack */ + +#ifdef YYDEBUG + if( yydebug ) printf( "error recovery pops state %d, uncovers %d\n", *yyps, yyps[-1] ); +#endif + --yyps; + --yypv; + } + + /* there is no state on the stack with an error shift ... abort */ + + yyabort: + return(1); + + + case 3: /* no shift yet; clobber input char */ + +#ifdef YYDEBUG + if( yydebug ) printf( "error recovery discards char %d\n", yychar ); +#endif + + if( yychar == 0 ) goto yyabort; /* don't discard EOF, quit */ + yychar = -1; + goto yynewstate; /* try again in the same state */ + + } + + } + + /* reduction by production yyn */ + +#ifdef YYDEBUG + if( yydebug ) printf("reduce %d\n",yyn); +#endif + yyps -= yyr2[yyn]; + yypvt = yypv; + yypv -= yyr2[yyn]; + yyval = yypv[1]; + yym=yyn; + /* consult goto table to find next state */ + yyn = yyr1[yyn]; + yyj = yypgo[yyn] + *yyps + 1; + if( yyj>=YYLAST || yychk[ yystate = yyact[yyj] ] != -yyn ) yystate = yyact[yypgo[yyn]]; + switch(yym){ + $A + } + goto yystack; /* stack new state and value */ + + } diff --git a/c20/yerror.c b/c20/yerror.c new file mode 100644 index 00000000..a4179958 --- /dev/null +++ b/c20/yerror.c @@ -0,0 +1,32 @@ +/* sample error actions for OYACC & CC */ +struct _token { int type, index, line; }; +# define token struct _token +extern int cout; + +synerr (line) {cprint ("\n%d: Syntax Error. Parse So Far: ", line);} +giveup (line) {cprint ("\n%d: I Give Up.", line);} +stkovf (line) {cprint ("\n%d: Parser Stack Overflow", line);} +delmsg (line) {cprint ("\n%d: Deleted: ", line);} +skpmsg (line) {cprint ("\n%d: Skipped: ", line);} + +qprint (q) {cputc (' ', cout); prstat (q, cout);} +tprint (tp) {cputc (' ', cout); ptoken (tp, cout);} +pcursor () {prs (" |_", cout);} + +stkunf (line) {cprint ("\n%d: Parser Stack Underflow!", line);} +tkbovf (line) {cprint ("\n%d: Token Buffer Overflow!", line);} +badtwp (line) {cprint ("\n%d: Inconsistent Internal Pointers!", line);} +badtok (line, i) {cprint ("\n%d: Bad Reference to Tok(%d)!", line, i);} + +prstat (q, f) + + {char *p; + extern int sq[]; + extern char *sterm[], *snterm[]; + + q = sq[q]; + if (q & 010000) p = snterm[q & 07777]; + else p = sterm[q]; + prs (p, f); + } + diff --git a/c20/yparse.c b/c20/yparse.c new file mode 100644 index 00000000..50e5522b --- /dev/null +++ b/c20/yparse.c @@ -0,0 +1,535 @@ +/* + + PARSING ROUTINE (for use with CC & OYACC) + + Requires the following: + + the tables produced by YACC + GETTOK - a lexical routine + PTOKEN - a token printing routine + a set of error message routines (one such set is + contained in the file YERROR >) + Returns TRUE if a fatal syntax error occured. + +*/ + +struct _token { int type, index, line; }; +# define token struct _token +token *dmperr(),*lex(),*tok(),*ctok(),*yreset(); + +# define pssize 200 +# define tbsize 30 +# define FALSE 0 +# define TRUE 1 + +extern int cout; + +/* GLOBAL VARIABLES USED TO RECEIVE INFO FROM GETTOK */ + +int lextype; /* indicates which terminal symbol read */ +int lexindex; /* used as translation element */ +int lexline; /* line-number of line which token appears on */ + +/* GLOBAL VARIABLES WHICH MAY BE SET TO INDICATE OPTIONS */ + +int debug FALSE; /* nonzero => print debugging info */ +int edebug FALSE; /* nonzero => print error recovery info */ +int xflag FALSE; /* nonzero => do not call action routines */ +int tflag FALSE; /* nonzero => print tokens as read */ + +/* GLOBAL VARIABLES REFERENCED BY ACTION ROUTINES */ + +int val; /* set to indicate translation element of LHS */ +int line; /* set to indicate line number of LHS */ +int *pv; /* used to reference translations of RHS */ +int *pl; /* used to reference line numbers of RHS */ +int lineno; /* used to reference lineno of current token */ + +/* INTERNAL STATIC VARIABLES */ + +static int *ps; /* parser stack pointer - states */ +static int s[pssize]; /* parser stack - states */ +static int v[pssize]; /* parser stack - translation elements */ +static int l[pssize]; /* parser stack - line numbers */ +static int *sps; /* save stack pointer - states*/ +static int *spv; /* save stack pointer - translation elements */ +static int *spl; /* save stack pointer - line numbers */ +static int ss[pssize]; /* save stack - states */ +static int sv[pssize]; /* save stack - translation elements */ +static int sl[pssize]; /* save stack - line numbers */ +static int must 7; /* number of tokens which must shift + correctly before error recovery is + considered successful */ +static int errcount 0; /* number of tokens left until successful */ +static int tskip; /* number of tokens skipped */ +static int spop; /* number of states popped */ +static int errmode 0; /* error recovery mode */ +static int tabmod FALSE; /* indicates index tables have been optimized */ + +/********************************************************************** + + PARSE - THE PARSER ITSELF + +**********************************************************************/ + +parse() + +{extern int (*act[])(), g[], pg[], r1[], r2[], a[], pa[], nwpbt; +int ac, op, n, state, *ap, *gp, control, i, r, + tlimit, slimit, *p, *ip, o, (*fp)(), t, errn; +token *ct, *tp; + +ps = &s[0]; +pv = &v[0]; +pl = &l[0]; + +state = 1; +*ps = 1; +*pv = 0; +*pl = 0; + +ct = lex(); + +if (!tabmod) + + { /* precompute index tables into action + and goto arrays */ + + ip = pa; + while ((o = *++ip) != -1) *ip = &a[o]; + ip = pg; + while ((o = *++ip) != -1) *ip = &g[o]; + tabmod = TRUE; + } + +while (TRUE) + {ap = pa[state]; + + if (debug) + cprint("executing state %d, token=%d\n",state, ct->type); + + while (TRUE) + + {ac = *ap++; + op = ac>>12; + n = ac&07777; + + switch (op) { + + case 1: /* SKIP ON TEST */ + + if (ct->type!=n) ++ap; + continue; + + case 2: /* SHIFT INPUT SYMBOL */ + + state = n; + +shift: val = ct->index; + line = ct->line; + ct = lex(); + + if (errcount) + {--errcount; + if (errcount==0) /* successful recovery */ + {ct = dmperr(); /* list recovery actions */ + control = 0; + break; + } + } + + control=1; /* stack new state */ + break; + + case 3: /* MAKE A REDUCTION */ + + if (debug) cprint ("reduce %d\n",n); + r = r2[n]; + ps =- r; + pv =- r; + pl =- r; + if (r>0) + {val = pv[1]; + line = pl[1]; + } + else + {val = ct->index; + line = ct->line; + } + if (!xflag && (fp = act[n])) (*fp)(); + state = *ps; + gp= pg[r1[n]]; + while (*gp) + {if (*gp==state) break; + gp=+2; + } + state = *++gp; + control = 1; /* stack new state */ + break; + + case 5: /* SHIFT ON MASK */ + + t = ct->type; + if (ap[t>>4] & (1<<(t&017))) /* bit on */ + {state = *(a+n+t-1); + goto shift; + } + + ap =+ nwpbt; /* skip over bit array */ + continue; + + case 4: /* ACCEPT INPUT */ + + if (errmode) + {ct = dmperr(); + control = 0; + break; + } + return (FALSE); + + case 0: /* SYNTAX ERROR */ + +/* The error recovery method used is to try skipping input symbols + and popping states off the stack in all possible combinations, + subject to a limitation on the number of symbols which may be + skipped. If a combination can be found which allows parsing + to continue for at least 7 more symbols, then the recovery is + considered a success. If no such combination can be found, the + parser gives up. + + In running through the possible recovery actions, skipping + input symbols is given priority over popping states, since + popping states tends to confuse the action routines, while + skipping symbols can not have any harmful effects on the + action routines. + + While searching for a successful combination of states and + symbols, the action routines are not called. When a successful + combination is found, the appropriate error messages are + written, the action routines are turned back on, and the parser + is reset at the point where the corrections have just been made. + + */ + + switch (errmode) { + + case 0: /* NEW ERROR */ + + if (edebug) cprint("errmode=0:st=%d,nst=%d,tok=%d\n", + state,ps-s,ct->type); + + synerr (ct->line); /* report syntax error */ + + p=s; + while (p<=ps) qprint (*p++); + pcursor (); + + tkeem(); /* enter error mode to save tokens */ + for (i=0;i<5;++i) + {tp = tok(i); + if (tp->type==1) break; + tprint (tp); + } + + save(); /* save parser stack */ + errcount = must; + errmode = 1; + xflag =| 2; /* turn off action routnes */ + + /* set up limits for recovery search */ + + tlimit = tbsize - must - 2; + slimit = ps-s; + + tskip = 0; + spop = 0; + errn = 1; + + case 1: /* try next recovery attempt */ + + restore(); + yreset(); + + if ((++tskip & 1) == 0) --spop; + if (spop<0 || ct->type==1 || tskip>tlimit) + {spop = errn++; + tskip = 0; + } + if (spop <= slimit) + {ct = ctok(tskip); + control = -spop; + break; + } + giveup (ct->line); /* give up */ + return (TRUE); + } + + if (edebug) cprint ("spop=%d,tskip=%d,token=%d\n", + spop,tskip,ct->type); + break; + } + + if (control>0) + {if (debug) cprint ("stack st=%d val=%d\n",state,val); + *++ps = state; + *++pv = val; + *++pl = line; + if (ps-s>=pssize) /* stack overflow */ + {stkovf (ct->line); + return (TRUE); + } + } + + else if (control<0) + {pv =+ control; + ps =+ control; + pl =+ control; + if (psline); + return (TRUE); + } + } + state = *ps; + break; + } + } +} + +/********************************************************************** + + DMPERR - PRINT ERROR RECOVERY ACTION TAKEN + RESET PARSER TO RESTART WITH ACTION ROUTINES + RETURN PTR TO NEW CURRENT TOKEN + +**********************************************************************/ + +token *dmperr() + + {int i; + token *tp; + extern token *ct; + + yreset(); + restore(); + if (spop>0) delmsg (ct->line); /* print DELETED: */ + for (i=1;i<=spop;++i) + qprint (ps[-spop+i]); /* print symbol associated with state */ + if (tskip>0) skpmsg (ct->line); + for(i=0;i= twp) + + /* If true, it is neccessary to read in another token. + If in normal mode, place the token in the first + element of the buffer. + */ + + {if (tokmode==0) ct=twp=tokbuf; + else + {if (twp>=tokbuf+tbsize) tkbovf (ct->line); + if (ct>twp) badtwp (ct->line); + } + rtoken (twp++); /* read token into next slot */ + } + + if (tflag && !tokmode) + {ptoken (ct, cout); + cputc (' ', cout); + } + lineno = ct->line; + return (ct); /* return ptr to token read */ + } + +token *tok(i) + + {token *p; + + p = ct + i; + if (p=tokbuf+tbsize) badtok (ct->line, i); + while (p>=twp) rtoken (twp++); + return (p); + } + +token *ctok(i) + + {return (ct = tok(i));} + +token *yreset() + + {return (ct = tokbuf);} + +tkeem() + + {int i,j; + token *tp1, *tp2; + + tokmode = 1; + j = i = twp - ct; /* number of valid tokens in buf */ + if (i>0) + {tp1 = tokbuf-1; + tp2 = ct-1; + while (i--) + {(++tp1)->type = (++tp2)->type; + tp1->index = tp2->index; + tp1->line = tp2->line; + } + } + ct = tokbuf; + twp = ct + j; + } + +tklem() + + {tokmode = 0;} + + +/********************************************************************** + + RTOKEN - PARSER READ TOKEN ROUTINE + +**********************************************************************/ + +rtoken(p) token *p; + + { + gettok(); + p->type = lextype; + p->index = lexindex; + p->line = lexline; + } + +/********************************************************************** + + PARSER ERROR MESSAGE ROUTINES + + synerr - announce syntax error + delmsg - print "DELETED:" message + skpmsg - print "SKIPPED:" message + + qprint - print symbol corresponding to parser state + tprint - print token + pcursor - print cursor symbol + + *** fatal errors *** + + giveup - announce failure of recovery attempt + stkovf - parser stack overflow + + *** internal fatal errors *** + + stkunf - parser stack underflow + tkbovf - token buffer overflow + badtwp - inconsistent token pointers + badtok - bad token reference + + ***** + + The routines are contained in the file YERROR.C so that + one may easily substitute other routines for them. + +*/