From 98cab31fc3659e33aef260efca55bf9f1753164c Mon Sep 17 00:00:00 2001 From: Lars-Dominik Braun Date: Mon, 11 Feb 2019 11:49:19 +0100 Subject: Add source files from Michael --- app/misc-games/unknown/src/LINDWURM.ELA | 337 ++ app/misc-games/unknown/src/SCHIFFEV.ELA | 424 +++ app/misc-games/unknown/src/SCHIFFEV2.ELA | 409 ++ app/mpg/1987/doc/GDOKKURZ.ELA | 119 + app/mpg/1987/doc/GRAPHIK.doc.e | 2234 +++++++++++ app/mpg/1987/doc/PLOTBOOK.ELA | 660 ++++ app/mpg/1987/src/ATPLOT.ELA | 438 +++ app/mpg/1987/src/B108PLOT.ELA | 642 ++++ app/mpg/1987/src/BASISPLT.ELA | 781 ++++ app/mpg/1987/src/DIPCHIPS.DS | Bin 0 -> 9216 bytes app/mpg/1987/src/FUPLOT.ELA | 319 ++ app/mpg/1987/src/GRAPHIK.Basis | 1573 ++++++++ app/mpg/1987/src/GRAPHIK.Configurator | 945 +++++ app/mpg/1987/src/GRAPHIK.Fkt | 1378 +++++++ app/mpg/1987/src/GRAPHIK.Install | 82 + app/mpg/1987/src/GRAPHIK.Manager | 900 +++++ app/mpg/1987/src/GRAPHIK.Plot | 1156 ++++++ app/mpg/1987/src/GRAPHIK.Turtle | 138 + app/mpg/1987/src/GRAPHIK.list | 22 + app/mpg/1987/src/HRZPLOT.ELA | 150 + app/mpg/1987/src/INCRPLOT.ELA | 405 ++ app/mpg/1987/src/M20PLOT.ELA | 419 ++ app/mpg/1987/src/MTRXPLOT.ELA | 416 ++ app/mpg/1987/src/Muster | 73 + app/mpg/1987/src/NEC P-9 2-15.MD.GCONF | 219 ++ app/mpg/1987/src/PCPLOT.ELA | 276 ++ app/mpg/1987/src/PICFILE.ELA | 446 +++ app/mpg/1987/src/PICPLOT.ELA | 241 ++ app/mpg/1987/src/PICTURE.ELA | 521 +++ app/mpg/1987/src/PLOTSPOL.ELA | 129 + app/mpg/1987/src/PUBINSPK.ELA | 654 ++++ app/mpg/1987/src/RUCTEPLT.ELA | 326 ++ app/mpg/1987/src/STDPLOT.ELA | 234 ++ app/mpg/1987/src/TELEVPLT.ELA | 176 + app/mpg/1987/src/VIDEOPLO.ELA | 382 ++ app/mpg/1987/src/ZEICH610.DS | Bin 0 -> 10752 bytes app/mpg/1987/src/ZEICH912.DS | Bin 0 -> 9216 bytes app/mpg/1987/src/ZEICHEN.DS | Bin 0 -> 9728 bytes app/mpg/1987/src/matrix printer | 129 + app/mpg/1987/src/std primitives | 79 + app/mpg/1987/src/terminal plot | 113 + app/speedtest/1986/doc/MEM64180.PRT | 103 + app/speedtest/1986/doc/MEMATARI.PRT | 101 + app/speedtest/1986/doc/MEMB108.PRT | 99 + app/speedtest/1986/doc/MEMB1082.PRT | 112 + app/speedtest/1986/doc/MEMBIC10.PRT | 100 + app/speedtest/1986/doc/MEMBIC8.PRT | 101 + app/speedtest/1986/doc/MEMCLA15.PRT | 100 + app/speedtest/1986/doc/MEMRUC12.PRT | 101 + app/speedtest/1986/doc/MEMV30.PRT | 100 + app/speedtest/1986/src/convert operation | 396 ++ app/speedtest/1986/src/gen.benchmark | 98 + app/speedtest/1986/src/integer operation | 614 +++ app/speedtest/1986/src/notice | 102 + app/speedtest/1986/src/real operation | 519 +++ app/speedtest/1986/src/run down logic | 429 +++ app/speedtest/1986/src/speed tester | 209 + app/speedtest/1986/src/text operation | 1401 +++++++ devel/debugger/doc/DEBUGGER.PRT | 2021 ++++++++++ devel/debugger/src/DEBUGGER.ELA | 3151 +++++++++++++++ devel/misc/unknown/src/0DISASS.ELA | 1110 ++++++ devel/misc/unknown/src/ASSEMBLE.ELA | 387 ++ devel/misc/unknown/src/COPYDS.ELA | 294 ++ devel/misc/unknown/src/DS4.ELA | 268 ++ devel/misc/unknown/src/PRIVS.ELA | 485 +++ devel/misc/unknown/src/TABINFO.ELA | 117 + devel/misc/unknown/src/TRACE.ELA | 552 +++ devel/misc/unknown/src/XLIST.ELA | 143 + devel/misc/unknown/src/XSTATUS.ELA | 188 + devel/misc/unknown/src/Z80.ELA | 495 +++ system/at/unknown/src/AT Generator | 134 + system/at/unknown/src/AT Utilities | 601 +++ system/at/unknown/src/AT install | 92 + system/base/unknown/src/SPOLMAN5.ELA | 1003 +++++ system/base/unknown/src/STD.ELA | 220 ++ system/base/unknown/src/STDPLOT.ELA | 365 ++ system/base/unknown/src/bildeditor | 722 ++++ system/base/unknown/src/command handler | 239 ++ system/base/unknown/src/dateieditorpaket | 743 ++++ system/base/unknown/src/editor | 210 + system/base/unknown/src/elan | 245 ++ system/base/unknown/src/feldeditor | 747 ++++ system/base/unknown/src/file | 810 ++++ system/base/unknown/src/init | 250 ++ system/base/unknown/src/integer | 134 + system/base/unknown/src/mathlib | 359 ++ system/base/unknown/src/real | 378 ++ system/base/unknown/src/scanner | 255 ++ system/base/unknown/src/stdescapeset | 31 + system/dos/1986/doc/DSKDOS.ELA | 967 +++++ system/dos/1986/src/252 | Bin 0 -> 1024 bytes system/dos/1986/src/253 | Bin 0 -> 1024 bytes system/dos/1986/src/254 | Bin 0 -> 1024 bytes system/dos/1986/src/255 | Bin 0 -> 1024 bytes system/dos/1986/src/COND.TXT | 5 + system/dos/1986/src/block i-o | 104 + system/dos/1986/src/cluster | 109 + system/dos/1986/src/disk descriptor.dos.fd | 290 ++ system/dos/1986/src/disk descriptor.dos.hd | 290 ++ system/dos/1986/src/disk manager | 245 ++ system/dos/1986/src/eu disk descriptor.fd | 102 + system/dos/1986/src/eu disk descriptor.hd | 102 + system/dos/1986/src/eumel-ebcdic + sub | 550 +++ system/dos/1986/src/fat and dir.dos.fd | 1190 ++++++ system/dos/1986/src/fat and dir.dos.hd | 1190 ++++++ system/dos/1986/src/fetch | 333 ++ system/dos/1986/src/files.dos | 23 + system/dos/1986/src/gen.dos | 99 + system/dos/1986/src/manager-M.dos.fd | 198 + system/dos/1986/src/manager-M.dos.hd | 198 + system/dos/1986/src/name conversion | 77 + system/dos/1986/src/open | 51 + system/dos/1986/src/save | 273 ++ system/dos/1986/src/shard interface | 19 + system/dos/1986/src/table thes.dos | 5 + system/eumel0-z80/data/EUMEL0.DS | Bin 0 -> 30720 bytes system/eumel0-z80/src/DISEUMEL.ELA | 607 +++ system/eumel0-z80/src/eumel0.prt.1 | 3948 +++++++++++++++++++ system/eumel0-z80/src/eumel0.prt.2 | 3957 +++++++++++++++++++ system/eumel0-z80/src/eumel0.prt.3 | 4004 +++++++++++++++++++ system/eumel0-z80/src/eumel0.prt.4 | 4001 +++++++++++++++++++ system/printer-9nadel/1986/doc/readme | 323 ++ system/printer-9nadel/1986/src/CHARED.ELA | 47 + system/printer-9nadel/1986/src/EPSONFX.ELA | 575 +++ system/printer-9nadel/1986/src/EPSONRX.ELA | 171 + system/printer-9nadel/1986/src/FONTTAB.10A | Bin 0 -> 3072 bytes system/printer-9nadel/1986/src/FONTTAB.12A | Bin 0 -> 3072 bytes system/printer-9nadel/1986/src/FONTTAB.S10 | Bin 0 -> 3072 bytes system/printer-9nadel/1986/src/FONTTAB.S12 | Bin 0 -> 3072 bytes system/printer-9nadel/1986/src/beschreibungen9 | 96 + system/printer-9nadel/1986/src/fonttab.1 | Bin 0 -> 11776 bytes system/printer-9nadel/1986/src/fonttab.10 | Bin 0 -> 16384 bytes system/printer-9nadel/1986/src/fonttab.20 | Bin 0 -> 37376 bytes system/printer-9nadel/1986/src/fonttab.20.lc | Bin 0 -> 37376 bytes system/printer-9nadel/1986/src/fonttab.20.lx | Bin 0 -> 25088 bytes system/printer-9nadel/1986/src/fonttab.7 | Bin 0 -> 46592 bytes system/printer-9nadel/1986/src/fonttab.7.cxp | Bin 0 -> 46592 bytes system/printer-9nadel/1986/src/fonttab.7.fuj | Bin 0 -> 57344 bytes system/printer-9nadel/1986/src/fonttab.7.mt | Bin 0 -> 46592 bytes system/printer-9nadel/1986/src/fonttab.epson.fx | Bin 0 -> 25600 bytes system/printer-9nadel/1986/src/fonttab.epson.lq | Bin 0 -> 36352 bytes system/printer-9nadel/1986/src/fonttab.epson.mx | Bin 0 -> 11776 bytes system/printer-9nadel/1986/src/fonttab.epson.rx | Bin 0 -> 20480 bytes system/printer-9nadel/1986/src/module9 | 1098 ++++++ system/printer-9nadel/1986/src/printer.epson.fx | 505 +++ system/printer-9nadel/1986/src/printer.epson.lq | 501 +++ system/printer-9nadel/1986/src/printer.epson.mx | 488 +++ system/printer-9nadel/1986/src/printer.epson.rx | 446 +++ system/printer-9nadel/1986/src/printer.std | 431 +++ system/ruc-terminal/unknown/doc/BIOSINT.PRT | 281 ++ system/ruc-terminal/unknown/doc/MACROS.PRT | 54 + system/ruc-terminal/unknown/doc/TDOC.PRT | 3012 +++++++++++++++ system/ruc-terminal/unknown/doc/TDOCP.PRT | 4008 ++++++++++++++++++++ system/ruc-terminal/unknown/doc/TINHALT.PRT | 120 + system/ruc-terminal/unknown/doc/TINHALTP.PRT | 157 + system/ruc-terminal/unknown/doc/TSTICHP.PRT | 211 ++ system/ruc-terminal/unknown/doc/TSTICHWO.PRT | 161 + system/ruc-terminal/unknown/doc/TTAB.PRT | 510 +++ system/ruc-terminal/unknown/doc/TTABP.PRT | 666 ++++ system/ruc-terminal/unknown/src/SCCPARAM.ELA | 144 + system/ruc-terminal/unknown/src/SETUP.ELA | 257 ++ system/ruc-terminal/unknown/src/Terminal108(ascii) | 121 + .../ruc-terminal/unknown/src/Terminal108(deutsch) | 122 + system/ruc-terminal/unknown/src/ructerm.apl-german | 125 + system/ruc-terminal/unknown/src/ructerm.ascii | 94 + system/shard-x86-at/7/README.rst | 5 + system/shard-x86-at/7/data/EXEMOD.EXE | Bin 0 -> 11034 bytes system/shard-x86-at/7/data/EXEPACK.EXE | Bin 0 -> 10848 bytes system/shard-x86-at/7/data/FSHARD.EXE | Bin 0 -> 9293 bytes system/shard-x86-at/7/data/FSHGET.EXE | Bin 0 -> 1024 bytes system/shard-x86-at/7/data/GENBOOT.EXE | Bin 0 -> 13064 bytes system/shard-x86-at/7/doc/8039.PRT | 569 +++ system/shard-x86-at/7/doc/BIOSINT.TXT | 305 ++ system/shard-x86-at/7/doc/CONTROLS.ELA | 76 + system/shard-x86-at/7/doc/PORTS.PRT | 658 ++++ system/shard-x86-at/7/src/ATSHARD.ASM | 156 + system/shard-x86-at/7/src/BLOCKERR.ASM | 82 + system/shard-x86-at/7/src/BOOT.ASM | 426 +++ system/shard-x86-at/7/src/CLOCK.ASM | 56 + system/shard-x86-at/7/src/DEVICE.ASM | 92 + system/shard-x86-at/7/src/EUCONECT.ASM | 80 + system/shard-x86-at/7/src/FDISK.ASM | 839 ++++ system/shard-x86-at/7/src/FIXDISK.ASM | 307 ++ system/shard-x86-at/7/src/FLOPPY.ASM | 454 +++ system/shard-x86-at/7/src/FSHARD.ASM | 223 ++ system/shard-x86-at/7/src/HARDWARE.ASM | 17 + system/shard-x86-at/7/src/HDISK.ASM | 482 +++ system/shard-x86-at/7/src/HSHARD.ASM | 242 ++ system/shard-x86-at/7/src/I8250.ASM | 437 +++ system/shard-x86-at/7/src/MAC286.ASM | 23 + system/shard-x86-at/7/src/MACROS.ASM | 80 + system/shard-x86-at/7/src/NILCHAN.ASM | 54 + system/shard-x86-at/7/src/PATCH.ELA | 500 +++ system/shard-x86-at/7/src/PATCHARE.ASM | 17 + system/shard-x86-at/7/src/PCPAR.ASM | 226 ++ system/shard-x86-at/7/src/PCPLOT.ASM | 430 +++ system/shard-x86-at/7/src/PCSCREEN.ASM | 438 +++ system/shard-x86-at/7/src/PCSYS.ASM | 131 + system/shard-x86-at/7/src/SHMAIN.ASM | 241 ++ system/shard-x86-at/7/src/STREAM.ASM | 290 ++ system/shard-x86-at/7/src/WAIT.ASM | 176 + system/shard-z80-altos/6/src/ALTOSSHD.ASM | 1786 +++++++++ system/shard-z80-ruc-64180/1.5/doc/SHARD.PRT | 584 +++ system/shard-z80-ruc-64180/1.5/src/65.SUB | 2 + system/shard-z80-ruc-64180/1.5/src/BOOT.INC | 122 + system/shard-z80-ruc-64180/1.5/src/CONOUT.MAC | 124 + system/shard-z80-ruc-64180/1.5/src/CONOUT4.INC | 467 +++ system/shard-z80-ruc-64180/1.5/src/CREF.COM | Bin 0 -> 3968 bytes system/shard-z80-ruc-64180/1.5/src/DB.COM | Bin 0 -> 12160 bytes system/shard-z80-ruc-64180/1.5/src/DISK.MAC | 1658 ++++++++ system/shard-z80-ruc-64180/1.5/src/DISK80.MAC | 302 ++ system/shard-z80-ruc-64180/1.5/src/DUMP.COM | Bin 0 -> 1024 bytes system/shard-z80-ruc-64180/1.5/src/EBOOT.COM | Bin 0 -> 2560 bytes system/shard-z80-ruc-64180/1.5/src/EBOOT.MAC | 339 ++ system/shard-z80-ruc-64180/1.5/src/EBOOT.SUB | 3 + system/shard-z80-ruc-64180/1.5/src/EINST.COM | Bin 0 -> 17664 bytes system/shard-z80-ruc-64180/1.5/src/EINST.PAS | 509 +++ system/shard-z80-ruc-64180/1.5/src/EUMEL.COM | Bin 0 -> 10880 bytes system/shard-z80-ruc-64180/1.5/src/FBOOT.COM | Bin 0 -> 2048 bytes system/shard-z80-ruc-64180/1.5/src/FBOOT.MAC | 714 ++++ system/shard-z80-ruc-64180/1.5/src/FBOOT.SYM | 2 + system/shard-z80-ruc-64180/1.5/src/GRAFIK65.MAC | 1636 ++++++++ system/shard-z80-ruc-64180/1.5/src/GRAFIK80.MAC | 203 + system/shard-z80-ruc-64180/1.5/src/HD64180.LIB | 160 + system/shard-z80-ruc-64180/1.5/src/IINST.COM | Bin 0 -> 8576 bytes system/shard-z80-ruc-64180/1.5/src/IINST.PAS | 21 + system/shard-z80-ruc-64180/1.5/src/INIMOD.MAC | 637 ++++ system/shard-z80-ruc-64180/1.5/src/INT65.MAC | 412 ++ system/shard-z80-ruc-64180/1.5/src/INTMOD.MAC | 1293 +++++++ system/shard-z80-ruc-64180/1.5/src/L80.COM | Bin 0 -> 10752 bytes system/shard-z80-ruc-64180/1.5/src/LOAD.MAC | 170 + system/shard-z80-ruc-64180/1.5/src/M80.COM | Bin 0 -> 20480 bytes system/shard-z80-ruc-64180/1.5/src/NIBLE.INC | 113 + system/shard-z80-ruc-64180/1.5/src/PORTS.MAC | 38 + system/shard-z80-ruc-64180/1.5/src/SC.COM | Bin 0 -> 10624 bytes system/shard-z80-ruc-64180/1.5/src/SCSI.MAC | 1478 ++++++++ system/shard-z80-ruc-64180/1.5/src/SCSI.PAS | 272 ++ system/shard-z80-ruc-64180/1.5/src/SETDEF.COM | Bin 0 -> 4096 bytes system/shard-z80-ruc-64180/1.5/src/SHARD.AEX | 15 + system/shard-z80-ruc-64180/1.5/src/SHARD.MAC | 1434 +++++++ system/shard-z80-ruc-64180/1.5/src/SHARD.SUB | 7 + system/shard-z80-ruc-64180/1.5/src/SLR.COM | Bin 0 -> 24576 bytes system/shard-z80-ruc-64180/1.5/src/START.MAC | 5 + system/shard-z80-ruc-64180/1.5/src/SUB.COM | Bin 0 -> 5376 bytes system/shard-z80-ruc-64180/1.5/src/TRACK.INC | 167 + system/shard-z80-ruc-64180/1.5/src/ZPAGE.INC | 155 + system/std.zusatz/1.7.3/src/17CHARS.ELA | 44 + system/std.zusatz/1.7.3/src/EMU16.ELA | 109 + system/std.zusatz/1.7.3/src/EMU16M.ELA | 162 + system/std.zusatz/1.7.3/src/FONTR16.ELA | 360 ++ system/std.zusatz/1.7.3/src/MINPRINT.ELA | 94 + system/std.zusatz/1.7.3/src/TO16.ELA | 102 + system/std.zusatz/1.7.3/src/complex | 133 + system/std.zusatz/1.7.3/src/crypt | 139 + system/std.zusatz/1.7.3/src/elan lister | 263 ++ system/std.zusatz/1.7.3/src/eumel printer | 369 ++ system/std.zusatz/1.7.3/src/eumelmeter | 130 + system/std.zusatz/1.7.3/src/free channel | 292 ++ system/std.zusatz/1.7.3/src/longint | 422 +++ system/std.zusatz/1.7.3/src/matrix | 470 +++ system/std.zusatz/1.7.3/src/minimal fonts routines | 9 + system/std.zusatz/1.7.3/src/printer-M | 69 + system/std.zusatz/1.7.3/src/printer-S | 36 + system/std.zusatz/1.7.3/src/purge | 85 + system/std.zusatz/1.7.3/src/referencer | 1077 ++++++ system/std.zusatz/1.7.3/src/reporter | 479 +++ system/std.zusatz/1.7.3/src/scheduler | 419 ++ system/std.zusatz/1.7.3/src/spool manager | 377 ++ system/std.zusatz/1.7.3/src/std printer | 434 +++ .../std.zusatz/1.7.3/src/std printer generator-M | 22 + .../std.zusatz/1.7.3/src/std printer generator-S | 15 + system/std.zusatz/1.7.3/src/vector | 213 ++ system/std.zusatz/1.7.5/src/eumel printer | 3067 +++++++++++++++ system/std.zusatz/1.7.5/src/font convertor 9 | 1065 ++++++ .../terminal-codes/1.8.2/src/AT.ascii(SHard>=4.5) | 74 + system/terminal-codes/1.8.2/src/GEN182.ELA | 245 ++ system/terminal-codes/unknown/src/A210 | 78 + system/terminal-codes/unknown/src/A210.german | 87 + system/terminal-codes/unknown/src/A230+ | 61 + system/terminal-codes/unknown/src/DEC.VT220.ascii | 49 + system/terminal-codes/unknown/src/DEC.VT220.german | 66 + system/terminal-codes/unknown/src/DM5 | 53 + system/terminal-codes/unknown/src/ELBIT.ascii | 32 + system/terminal-codes/unknown/src/ELBIT.german | 47 + system/terminal-codes/unknown/src/FT10-20.ascii | 75 + system/terminal-codes/unknown/src/FT10-20.german | 94 + system/terminal-codes/unknown/src/GENGEN.ELA | 244 ++ system/terminal-codes/unknown/src/GT100 | 44 + system/terminal-codes/unknown/src/IBM.PC.AT | 63 + system/terminal-codes/unknown/src/M20 | 10 + system/terminal-codes/unknown/src/M20.original | 27 + system/terminal-codes/unknown/src/M24 | 63 + system/terminal-codes/unknown/src/M24.keybfr1 | 64 + system/terminal-codes/unknown/src/PC.KB2 | 79 + system/terminal-codes/unknown/src/PC.french | 68 + system/terminal-codes/unknown/src/PC.german | 63 + system/terminal-codes/unknown/src/Qume.german | 77 + system/terminal-codes/unknown/src/REGENT25 | 34 + system/terminal-codes/unknown/src/REGENT40 | 37 + system/terminal-codes/unknown/src/RUC.AT.ascii | 75 + system/terminal-codes/unknown/src/SIEMENS.PC-D | 88 + system/terminal-codes/unknown/src/TAP5060.ELA | 49 + system/terminal-codes/unknown/src/TVI.german | 57 + system/terminal-codes/unknown/src/TVI914.ascii | 43 + system/terminal-codes/unknown/src/VC404.ascii | 61 + system/terminal-codes/unknown/src/VC404.german | 75 + system/terminal-codes/unknown/src/VC404.hrz | 67 + system/terminal-codes/unknown/src/VIDEOSTAR | 52 + system/terminal-codes/unknown/src/basis108(ascii) | 90 + .../terminal-codes/unknown/src/basis108(deutsch) | 106 + system/terminal-codes/unknown/src/basis108(info) | 107 + system/terminal-codes/unknown/src/ws580 | 62 + 312 files changed, 113202 insertions(+) create mode 100644 app/misc-games/unknown/src/LINDWURM.ELA create mode 100644 app/misc-games/unknown/src/SCHIFFEV.ELA create mode 100644 app/misc-games/unknown/src/SCHIFFEV2.ELA create mode 100644 app/mpg/1987/doc/GDOKKURZ.ELA create mode 100644 app/mpg/1987/doc/GRAPHIK.doc.e create mode 100644 app/mpg/1987/doc/PLOTBOOK.ELA create mode 100644 app/mpg/1987/src/ATPLOT.ELA create mode 100644 app/mpg/1987/src/B108PLOT.ELA create mode 100644 app/mpg/1987/src/BASISPLT.ELA create mode 100644 app/mpg/1987/src/DIPCHIPS.DS create mode 100644 app/mpg/1987/src/FUPLOT.ELA create mode 100644 app/mpg/1987/src/GRAPHIK.Basis create mode 100644 app/mpg/1987/src/GRAPHIK.Configurator create mode 100644 app/mpg/1987/src/GRAPHIK.Fkt create mode 100644 app/mpg/1987/src/GRAPHIK.Install create mode 100644 app/mpg/1987/src/GRAPHIK.Manager create mode 100644 app/mpg/1987/src/GRAPHIK.Plot create mode 100644 app/mpg/1987/src/GRAPHIK.Turtle create mode 100644 app/mpg/1987/src/GRAPHIK.list create mode 100644 app/mpg/1987/src/HRZPLOT.ELA create mode 100644 app/mpg/1987/src/INCRPLOT.ELA create mode 100644 app/mpg/1987/src/M20PLOT.ELA create mode 100644 app/mpg/1987/src/MTRXPLOT.ELA create mode 100644 app/mpg/1987/src/Muster create mode 100644 app/mpg/1987/src/NEC P-9 2-15.MD.GCONF create mode 100644 app/mpg/1987/src/PCPLOT.ELA create mode 100644 app/mpg/1987/src/PICFILE.ELA create mode 100644 app/mpg/1987/src/PICPLOT.ELA create mode 100644 app/mpg/1987/src/PICTURE.ELA create mode 100644 app/mpg/1987/src/PLOTSPOL.ELA create mode 100644 app/mpg/1987/src/PUBINSPK.ELA create mode 100644 app/mpg/1987/src/RUCTEPLT.ELA create mode 100644 app/mpg/1987/src/STDPLOT.ELA create mode 100644 app/mpg/1987/src/TELEVPLT.ELA create mode 100644 app/mpg/1987/src/VIDEOPLO.ELA create mode 100644 app/mpg/1987/src/ZEICH610.DS create mode 100644 app/mpg/1987/src/ZEICH912.DS create mode 100644 app/mpg/1987/src/ZEICHEN.DS create mode 100644 app/mpg/1987/src/matrix printer create mode 100644 app/mpg/1987/src/std primitives create mode 100644 app/mpg/1987/src/terminal plot create mode 100644 app/speedtest/1986/doc/MEM64180.PRT create mode 100644 app/speedtest/1986/doc/MEMATARI.PRT create mode 100644 app/speedtest/1986/doc/MEMB108.PRT create mode 100644 app/speedtest/1986/doc/MEMB1082.PRT create mode 100644 app/speedtest/1986/doc/MEMBIC10.PRT create mode 100644 app/speedtest/1986/doc/MEMBIC8.PRT create mode 100644 app/speedtest/1986/doc/MEMCLA15.PRT create mode 100644 app/speedtest/1986/doc/MEMRUC12.PRT create mode 100644 app/speedtest/1986/doc/MEMV30.PRT create mode 100644 app/speedtest/1986/src/convert operation create mode 100644 app/speedtest/1986/src/gen.benchmark create mode 100644 app/speedtest/1986/src/integer operation create mode 100644 app/speedtest/1986/src/notice create mode 100644 app/speedtest/1986/src/real operation create mode 100644 app/speedtest/1986/src/run down logic create mode 100644 app/speedtest/1986/src/speed tester create mode 100644 app/speedtest/1986/src/text operation create mode 100644 devel/debugger/doc/DEBUGGER.PRT create mode 100644 devel/debugger/src/DEBUGGER.ELA create mode 100644 devel/misc/unknown/src/0DISASS.ELA create mode 100644 devel/misc/unknown/src/ASSEMBLE.ELA create mode 100644 devel/misc/unknown/src/COPYDS.ELA create mode 100644 devel/misc/unknown/src/DS4.ELA create mode 100644 devel/misc/unknown/src/PRIVS.ELA create mode 100644 devel/misc/unknown/src/TABINFO.ELA create mode 100644 devel/misc/unknown/src/TRACE.ELA create mode 100644 devel/misc/unknown/src/XLIST.ELA create mode 100644 devel/misc/unknown/src/XSTATUS.ELA create mode 100644 devel/misc/unknown/src/Z80.ELA create mode 100644 system/at/unknown/src/AT Generator create mode 100644 system/at/unknown/src/AT Utilities create mode 100644 system/at/unknown/src/AT install create mode 100644 system/base/unknown/src/SPOLMAN5.ELA create mode 100644 system/base/unknown/src/STD.ELA create mode 100644 system/base/unknown/src/STDPLOT.ELA create mode 100644 system/base/unknown/src/bildeditor create mode 100644 system/base/unknown/src/command handler create mode 100644 system/base/unknown/src/dateieditorpaket create mode 100644 system/base/unknown/src/editor create mode 100644 system/base/unknown/src/elan create mode 100644 system/base/unknown/src/feldeditor create mode 100644 system/base/unknown/src/file create mode 100644 system/base/unknown/src/init create mode 100644 system/base/unknown/src/integer create mode 100644 system/base/unknown/src/mathlib create mode 100644 system/base/unknown/src/real create mode 100644 system/base/unknown/src/scanner create mode 100644 system/base/unknown/src/stdescapeset create mode 100644 system/dos/1986/doc/DSKDOS.ELA create mode 100644 system/dos/1986/src/252 create mode 100644 system/dos/1986/src/253 create mode 100644 system/dos/1986/src/254 create mode 100644 system/dos/1986/src/255 create mode 100644 system/dos/1986/src/COND.TXT create mode 100644 system/dos/1986/src/block i-o create mode 100644 system/dos/1986/src/cluster create mode 100644 system/dos/1986/src/disk descriptor.dos.fd create mode 100644 system/dos/1986/src/disk descriptor.dos.hd create mode 100644 system/dos/1986/src/disk manager create mode 100644 system/dos/1986/src/eu disk descriptor.fd create mode 100644 system/dos/1986/src/eu disk descriptor.hd create mode 100644 system/dos/1986/src/eumel-ebcdic + sub create mode 100644 system/dos/1986/src/fat and dir.dos.fd create mode 100644 system/dos/1986/src/fat and dir.dos.hd create mode 100644 system/dos/1986/src/fetch create mode 100644 system/dos/1986/src/files.dos create mode 100644 system/dos/1986/src/gen.dos create mode 100644 system/dos/1986/src/manager-M.dos.fd create mode 100644 system/dos/1986/src/manager-M.dos.hd create mode 100644 system/dos/1986/src/name conversion create mode 100644 system/dos/1986/src/open create mode 100644 system/dos/1986/src/save create mode 100644 system/dos/1986/src/shard interface create mode 100644 system/dos/1986/src/table thes.dos create mode 100644 system/eumel0-z80/data/EUMEL0.DS create mode 100644 system/eumel0-z80/src/DISEUMEL.ELA create mode 100644 system/eumel0-z80/src/eumel0.prt.1 create mode 100644 system/eumel0-z80/src/eumel0.prt.2 create mode 100644 system/eumel0-z80/src/eumel0.prt.3 create mode 100644 system/eumel0-z80/src/eumel0.prt.4 create mode 100644 system/printer-9nadel/1986/doc/readme create mode 100644 system/printer-9nadel/1986/src/CHARED.ELA create mode 100644 system/printer-9nadel/1986/src/EPSONFX.ELA create mode 100644 system/printer-9nadel/1986/src/EPSONRX.ELA create mode 100644 system/printer-9nadel/1986/src/FONTTAB.10A create mode 100644 system/printer-9nadel/1986/src/FONTTAB.12A create mode 100644 system/printer-9nadel/1986/src/FONTTAB.S10 create mode 100644 system/printer-9nadel/1986/src/FONTTAB.S12 create mode 100644 system/printer-9nadel/1986/src/beschreibungen9 create mode 100644 system/printer-9nadel/1986/src/fonttab.1 create mode 100644 system/printer-9nadel/1986/src/fonttab.10 create mode 100644 system/printer-9nadel/1986/src/fonttab.20 create mode 100644 system/printer-9nadel/1986/src/fonttab.20.lc create mode 100644 system/printer-9nadel/1986/src/fonttab.20.lx create mode 100644 system/printer-9nadel/1986/src/fonttab.7 create mode 100644 system/printer-9nadel/1986/src/fonttab.7.cxp create mode 100644 system/printer-9nadel/1986/src/fonttab.7.fuj create mode 100644 system/printer-9nadel/1986/src/fonttab.7.mt create mode 100644 system/printer-9nadel/1986/src/fonttab.epson.fx create mode 100644 system/printer-9nadel/1986/src/fonttab.epson.lq create mode 100644 system/printer-9nadel/1986/src/fonttab.epson.mx create mode 100644 system/printer-9nadel/1986/src/fonttab.epson.rx create mode 100644 system/printer-9nadel/1986/src/module9 create mode 100644 system/printer-9nadel/1986/src/printer.epson.fx create mode 100644 system/printer-9nadel/1986/src/printer.epson.lq create mode 100644 system/printer-9nadel/1986/src/printer.epson.mx create mode 100644 system/printer-9nadel/1986/src/printer.epson.rx create mode 100644 system/printer-9nadel/1986/src/printer.std create mode 100644 system/ruc-terminal/unknown/doc/BIOSINT.PRT create mode 100644 system/ruc-terminal/unknown/doc/MACROS.PRT create mode 100644 system/ruc-terminal/unknown/doc/TDOC.PRT create mode 100644 system/ruc-terminal/unknown/doc/TDOCP.PRT create mode 100644 system/ruc-terminal/unknown/doc/TINHALT.PRT create mode 100644 system/ruc-terminal/unknown/doc/TINHALTP.PRT create mode 100644 system/ruc-terminal/unknown/doc/TSTICHP.PRT create mode 100644 system/ruc-terminal/unknown/doc/TSTICHWO.PRT create mode 100644 system/ruc-terminal/unknown/doc/TTAB.PRT create mode 100644 system/ruc-terminal/unknown/doc/TTABP.PRT create mode 100644 system/ruc-terminal/unknown/src/SCCPARAM.ELA create mode 100644 system/ruc-terminal/unknown/src/SETUP.ELA create mode 100644 system/ruc-terminal/unknown/src/Terminal108(ascii) create mode 100644 system/ruc-terminal/unknown/src/Terminal108(deutsch) create mode 100644 system/ruc-terminal/unknown/src/ructerm.apl-german create mode 100644 system/ruc-terminal/unknown/src/ructerm.ascii create mode 100644 system/shard-x86-at/7/README.rst create mode 100644 system/shard-x86-at/7/data/EXEMOD.EXE create mode 100644 system/shard-x86-at/7/data/EXEPACK.EXE create mode 100644 system/shard-x86-at/7/data/FSHARD.EXE create mode 100644 system/shard-x86-at/7/data/FSHGET.EXE create mode 100644 system/shard-x86-at/7/data/GENBOOT.EXE create mode 100644 system/shard-x86-at/7/doc/8039.PRT create mode 100644 system/shard-x86-at/7/doc/BIOSINT.TXT create mode 100644 system/shard-x86-at/7/doc/CONTROLS.ELA create mode 100644 system/shard-x86-at/7/doc/PORTS.PRT create mode 100644 system/shard-x86-at/7/src/ATSHARD.ASM create mode 100644 system/shard-x86-at/7/src/BLOCKERR.ASM create mode 100644 system/shard-x86-at/7/src/BOOT.ASM create mode 100644 system/shard-x86-at/7/src/CLOCK.ASM create mode 100644 system/shard-x86-at/7/src/DEVICE.ASM create mode 100644 system/shard-x86-at/7/src/EUCONECT.ASM create mode 100644 system/shard-x86-at/7/src/FDISK.ASM create mode 100644 system/shard-x86-at/7/src/FIXDISK.ASM create mode 100644 system/shard-x86-at/7/src/FLOPPY.ASM create mode 100644 system/shard-x86-at/7/src/FSHARD.ASM create mode 100644 system/shard-x86-at/7/src/HARDWARE.ASM create mode 100644 system/shard-x86-at/7/src/HDISK.ASM create mode 100644 system/shard-x86-at/7/src/HSHARD.ASM create mode 100644 system/shard-x86-at/7/src/I8250.ASM create mode 100644 system/shard-x86-at/7/src/MAC286.ASM create mode 100644 system/shard-x86-at/7/src/MACROS.ASM create mode 100644 system/shard-x86-at/7/src/NILCHAN.ASM create mode 100644 system/shard-x86-at/7/src/PATCH.ELA create mode 100644 system/shard-x86-at/7/src/PATCHARE.ASM create mode 100644 system/shard-x86-at/7/src/PCPAR.ASM create mode 100644 system/shard-x86-at/7/src/PCPLOT.ASM create mode 100644 system/shard-x86-at/7/src/PCSCREEN.ASM create mode 100644 system/shard-x86-at/7/src/PCSYS.ASM create mode 100644 system/shard-x86-at/7/src/SHMAIN.ASM create mode 100644 system/shard-x86-at/7/src/STREAM.ASM create mode 100644 system/shard-x86-at/7/src/WAIT.ASM create mode 100644 system/shard-z80-altos/6/src/ALTOSSHD.ASM create mode 100644 system/shard-z80-ruc-64180/1.5/doc/SHARD.PRT create mode 100644 system/shard-z80-ruc-64180/1.5/src/65.SUB create mode 100644 system/shard-z80-ruc-64180/1.5/src/BOOT.INC create mode 100644 system/shard-z80-ruc-64180/1.5/src/CONOUT.MAC create mode 100644 system/shard-z80-ruc-64180/1.5/src/CONOUT4.INC create mode 100644 system/shard-z80-ruc-64180/1.5/src/CREF.COM create mode 100644 system/shard-z80-ruc-64180/1.5/src/DB.COM create mode 100644 system/shard-z80-ruc-64180/1.5/src/DISK.MAC create mode 100644 system/shard-z80-ruc-64180/1.5/src/DISK80.MAC create mode 100644 system/shard-z80-ruc-64180/1.5/src/DUMP.COM create mode 100644 system/shard-z80-ruc-64180/1.5/src/EBOOT.COM create mode 100644 system/shard-z80-ruc-64180/1.5/src/EBOOT.MAC create mode 100644 system/shard-z80-ruc-64180/1.5/src/EBOOT.SUB create mode 100644 system/shard-z80-ruc-64180/1.5/src/EINST.COM create mode 100644 system/shard-z80-ruc-64180/1.5/src/EINST.PAS create mode 100644 system/shard-z80-ruc-64180/1.5/src/EUMEL.COM create mode 100644 system/shard-z80-ruc-64180/1.5/src/FBOOT.COM create mode 100644 system/shard-z80-ruc-64180/1.5/src/FBOOT.MAC create mode 100644 system/shard-z80-ruc-64180/1.5/src/FBOOT.SYM create mode 100644 system/shard-z80-ruc-64180/1.5/src/GRAFIK65.MAC create mode 100644 system/shard-z80-ruc-64180/1.5/src/GRAFIK80.MAC create mode 100644 system/shard-z80-ruc-64180/1.5/src/HD64180.LIB create mode 100644 system/shard-z80-ruc-64180/1.5/src/IINST.COM create mode 100644 system/shard-z80-ruc-64180/1.5/src/IINST.PAS create mode 100644 system/shard-z80-ruc-64180/1.5/src/INIMOD.MAC create mode 100644 system/shard-z80-ruc-64180/1.5/src/INT65.MAC create mode 100644 system/shard-z80-ruc-64180/1.5/src/INTMOD.MAC create mode 100644 system/shard-z80-ruc-64180/1.5/src/L80.COM create mode 100644 system/shard-z80-ruc-64180/1.5/src/LOAD.MAC create mode 100644 system/shard-z80-ruc-64180/1.5/src/M80.COM create mode 100644 system/shard-z80-ruc-64180/1.5/src/NIBLE.INC create mode 100644 system/shard-z80-ruc-64180/1.5/src/PORTS.MAC create mode 100644 system/shard-z80-ruc-64180/1.5/src/SC.COM create mode 100644 system/shard-z80-ruc-64180/1.5/src/SCSI.MAC create mode 100644 system/shard-z80-ruc-64180/1.5/src/SCSI.PAS create mode 100644 system/shard-z80-ruc-64180/1.5/src/SETDEF.COM create mode 100644 system/shard-z80-ruc-64180/1.5/src/SHARD.AEX create mode 100644 system/shard-z80-ruc-64180/1.5/src/SHARD.MAC create mode 100644 system/shard-z80-ruc-64180/1.5/src/SHARD.SUB create mode 100644 system/shard-z80-ruc-64180/1.5/src/SLR.COM create mode 100644 system/shard-z80-ruc-64180/1.5/src/START.MAC create mode 100644 system/shard-z80-ruc-64180/1.5/src/SUB.COM create mode 100644 system/shard-z80-ruc-64180/1.5/src/TRACK.INC create mode 100644 system/shard-z80-ruc-64180/1.5/src/ZPAGE.INC create mode 100644 system/std.zusatz/1.7.3/src/17CHARS.ELA create mode 100644 system/std.zusatz/1.7.3/src/EMU16.ELA create mode 100644 system/std.zusatz/1.7.3/src/EMU16M.ELA create mode 100644 system/std.zusatz/1.7.3/src/FONTR16.ELA create mode 100644 system/std.zusatz/1.7.3/src/MINPRINT.ELA create mode 100644 system/std.zusatz/1.7.3/src/TO16.ELA create mode 100644 system/std.zusatz/1.7.3/src/complex create mode 100644 system/std.zusatz/1.7.3/src/crypt create mode 100644 system/std.zusatz/1.7.3/src/elan lister create mode 100644 system/std.zusatz/1.7.3/src/eumel printer create mode 100644 system/std.zusatz/1.7.3/src/eumelmeter create mode 100644 system/std.zusatz/1.7.3/src/free channel create mode 100644 system/std.zusatz/1.7.3/src/longint create mode 100644 system/std.zusatz/1.7.3/src/matrix create mode 100644 system/std.zusatz/1.7.3/src/minimal fonts routines create mode 100644 system/std.zusatz/1.7.3/src/printer-M create mode 100644 system/std.zusatz/1.7.3/src/printer-S create mode 100644 system/std.zusatz/1.7.3/src/purge create mode 100644 system/std.zusatz/1.7.3/src/referencer create mode 100644 system/std.zusatz/1.7.3/src/reporter create mode 100644 system/std.zusatz/1.7.3/src/scheduler create mode 100644 system/std.zusatz/1.7.3/src/spool manager create mode 100644 system/std.zusatz/1.7.3/src/std printer create mode 100644 system/std.zusatz/1.7.3/src/std printer generator-M create mode 100644 system/std.zusatz/1.7.3/src/std printer generator-S create mode 100644 system/std.zusatz/1.7.3/src/vector create mode 100644 system/std.zusatz/1.7.5/src/eumel printer create mode 100644 system/std.zusatz/1.7.5/src/font convertor 9 create mode 100644 system/terminal-codes/1.8.2/src/AT.ascii(SHard>=4.5) create mode 100644 system/terminal-codes/1.8.2/src/GEN182.ELA create mode 100644 system/terminal-codes/unknown/src/A210 create mode 100644 system/terminal-codes/unknown/src/A210.german create mode 100644 system/terminal-codes/unknown/src/A230+ create mode 100644 system/terminal-codes/unknown/src/DEC.VT220.ascii create mode 100644 system/terminal-codes/unknown/src/DEC.VT220.german create mode 100644 system/terminal-codes/unknown/src/DM5 create mode 100644 system/terminal-codes/unknown/src/ELBIT.ascii create mode 100644 system/terminal-codes/unknown/src/ELBIT.german create mode 100644 system/terminal-codes/unknown/src/FT10-20.ascii create mode 100644 system/terminal-codes/unknown/src/FT10-20.german create mode 100644 system/terminal-codes/unknown/src/GENGEN.ELA create mode 100644 system/terminal-codes/unknown/src/GT100 create mode 100644 system/terminal-codes/unknown/src/IBM.PC.AT create mode 100644 system/terminal-codes/unknown/src/M20 create mode 100644 system/terminal-codes/unknown/src/M20.original create mode 100644 system/terminal-codes/unknown/src/M24 create mode 100644 system/terminal-codes/unknown/src/M24.keybfr1 create mode 100644 system/terminal-codes/unknown/src/PC.KB2 create mode 100644 system/terminal-codes/unknown/src/PC.french create mode 100644 system/terminal-codes/unknown/src/PC.german create mode 100644 system/terminal-codes/unknown/src/Qume.german create mode 100644 system/terminal-codes/unknown/src/REGENT25 create mode 100644 system/terminal-codes/unknown/src/REGENT40 create mode 100644 system/terminal-codes/unknown/src/RUC.AT.ascii create mode 100644 system/terminal-codes/unknown/src/SIEMENS.PC-D create mode 100644 system/terminal-codes/unknown/src/TAP5060.ELA create mode 100644 system/terminal-codes/unknown/src/TVI.german create mode 100644 system/terminal-codes/unknown/src/TVI914.ascii create mode 100644 system/terminal-codes/unknown/src/VC404.ascii create mode 100644 system/terminal-codes/unknown/src/VC404.german create mode 100644 system/terminal-codes/unknown/src/VC404.hrz create mode 100644 system/terminal-codes/unknown/src/VIDEOSTAR create mode 100644 system/terminal-codes/unknown/src/basis108(ascii) create mode 100644 system/terminal-codes/unknown/src/basis108(deutsch) create mode 100644 system/terminal-codes/unknown/src/basis108(info) create mode 100644 system/terminal-codes/unknown/src/ws580 diff --git a/app/misc-games/unknown/src/LINDWURM.ELA b/app/misc-games/unknown/src/LINDWURM.ELA new file mode 100644 index 0000000..57de114 --- /dev/null +++ b/app/misc-games/unknown/src/LINDWURM.ELA @@ -0,0 +1,337 @@ +PACKET lind wurm DEFINES lindwurm: +deklaration; +LET max = 500,zeilen = 23,spalten = 77; + +PROC kriech : + speicher := stelle; + REP + putline(""1"Punkte:"+text(punkte + bonus) + ""6""0""30"Zeit:" + zeit); + IF punkte <> 0 + THEN ende INCR 1; + IF ende > max THEN ende := 1 FI; + laenge := laenge + 1 - zaehler; + IF laenge > max THEN laenge := 1 FI; + wurm(ende) := speicher; + IF zaehler = 0 AND wurm(laenge) >= basis AND wurm(laenge) < (basis+(spalten*zeilen)) + THEN poke(wurm(laenge),leerzeichen) + FI; + IF speicher >= basis AND speicher < (basis+(spalten*zeilen)) THEN + poke(speicher,char1) + FI + ELSE IF speicher >= basis AND speicher < (basis+(spalten*zeilen)) + THEN poke (speicher,leerzeichen) + FI; + FI; + zaehler := 0; + speicher INCR richtung; + IF peek(speicher) <> leerzeichen THEN nahrung oder gift FI; + IF speicher >= basis AND speicher < (basis+(spalten*zeilen)) THEN poke(speicher,char2) FI; + tastaturabfrage; + IF punkte > begrenzung THEN x := int(zeit); index := 1 FI; + IF zeit > stopzeit THEN index := 2 FI; + UNTIL index <> 0 PER +ENDPROC kriech; + +PROC nahrung oder gift : + IF peek(speicher) <> char 3 THEN index := 3 + ELSE punkte INCR 10; zaehler := 1 + FI; +ENDPROC nahrung oder gift; + +PROC tastaturabfrage : + taste := incharety(9 DIV geschwindigkeit); + feuer := taste = ""13""; + IF feuer THEN richtung := 0 + ELIF taste = ""10"" THEN richtung INCR spalten + ELIF taste = ""8"" THEN richtung DECR 1 + ELIF taste = ""2"" THEN richtung INCR 1 + ELIF taste = ""3"" THEN richtung DECR spalten + FI +ENDPROC tastatur abfrage; + +PROC bonus erreicht : + x := (int(stopzeit)-x) * schwierigkeit; + cspalte := 10; + czeile := 10; + cursorpositionieren; + putline("B O N U S ! ! !"); + line; + putline(""15" "+text(x)+" Punkte !!!"14""); + bonus := bonus + punkte + x; +ENDPROC bonus erreicht; + +PROC poke (INT CONST stelle,wert) : + INT VAR x pos := 1 + ((stelle - basis) MOD spalten), + y pos := 1 + ((stelle - basis) DIV spalten); + cursor(x pos,y pos); + IF wert = 126 THEN out(""15""8""14"") ELSE + out(code(wert)); + FI; + bildschirm (x pos)(y pos) := wert; +ENDPROC poke; + +INT PROC peek (INT CONST stelle) : + INT VAR x pos := 1 + ((stelle - basis) MOD spalten), + y pos := 1 + ((stelle - basis) DIV spalten); + bildschirm (x pos)(y pos) +ENDPROC peek; + +PROC cursorpositionieren : + bildschirm zeile := basis + spalten*czeile; + cursor(cspalte+1,czeile+1); +ENDPROC cursor positionieren; + +PROC highscore und platznummer : + punkte := punkte + bonus; + bonus := 0; + IF punkte > highscore THEN highscore := punkte FI; + player counter INCR 1; + q := player counter + 1; + spieler punkte(playercounter) := punkte; + FOR i FROM 1 UPTO playercounter REP + IF punkte > spielerpunkte (i) THEN q DECR 1 FI; + PER; + c spalte :=10; + czeile := 10; + cursorpositionieren; + putline("Hoechstpunktzahl "+text(highscore));line; + putline(" Punkte :"+text(punkte)); + putline(" Platznr.:"+text(q-1)); + IF q-1 >= 10 THEN inchar(hilf) + ELSE put("Name des Gewinners:"); + getline(hilf); + disablestop; + FOR i FROM playercounter DOWNTO q REP + spielername(i+1) := spielername(i); + IF iserror THEN clearerror; spielername(i+1) := "" FI; + PER; + enablestop; + spielername(q-1) := "(" +text(punkte) + " Punkte: " + hilf+")"; + FI; + page; + putline("Die ersten 10 Gewinner :"); + disablestop; + FOR i FROM 1 UPTO min(playercounter,10) REP + putline(text(i)+"."+spielername(i)); + IF iserror THEN clearerror;spielername(i) := "" FI + PER; + enablestop; + putline("Druecken Sie eine Taste"); + inchar(hilf); +ENDPROC highscore und platznummer; + +PROC explosion : + out(""7""); + FOR i FROM ende DOWNTO laenge +1REP + IF wurm (i) >= basis AND wurm(i) < (basis+spalten*zeilen) THEN poke(wurm(i),leerzeichen); + FI; + PER; + highscore und platznummer +ENDPROC explosion; + +PROC lindwurm : + bonus := 0; + + REP + clearscreen; + out(""14""1""4""); + IF bonus = 0 THEN neues spiel FI; + IF bonus > 0 THEN bonusspiel FI; + page; + rahmen; + lebensraum generieren; + lindwurm kopf setzen; + reset time; + kriech; + SELECT index OF + CASE 1 : bonus erreicht + CASE 2 : highscore und platznummer + CASE 3 : explosion + ENDSELECT + UNTIL bonus<= 0 COR no(""1""4""10""10"Noch ein Spiel") PER + +ENDPROC lindwurm; + +PROC neues spiel : + basis := 0; + stelle := basis + spalten*zeilen DIV 2; + schwierigkeit := 4; + geschwindigkeit :=9; + char 1:= 126; + char 2:= 79; + char 3:= 42; + char 4:= 124; + leerzeichen := 32; + index := 0; + ende := 0; + laenge := 0; + richtung := 0; + zaehler := 0; + bonus := 0; + punkte := 0; + stopzeit :="3:00"; + vorwahl; + begrenzung := 120 * schwierigkeit; +ENDPROC neues spiel; + +PROC liste aller spieler : + page; + FOR i FROM 1 UPTO playercounter REP + putline(text(i)+"."+spielername(i)); + IF i > 24 THEN pause(20) FI; + PER; + putline("ENDE"); + inchar(hilf); + page; +ENDPROC liste aller spieler; + + +PROC vorwahl : + spielregeln; + page; + REP + out(""1""); + putline(""142" Lindwurm "143""); + czeile :=12; + cspalte:=3; + cursorpositionieren; + putline("Schwierigkeitsgrad (1/2) "+ text(schwierigkeit,3)); + czeile :=14; + cspalte:=3; + cursorpositionieren; + putline("Geschwindigkeit (3/4) "+ text(geschwindigkeit,3)); + czeile :=16; + cspalte:=3; + cursorpositionieren; + putline("Liste aller Spieler (5) "); + czeile :=18; + cspalte:=3; + cursorpositionieren; + putline("Start mit RETURN"); + x := 0; + inchar(hilf); + IF hilf = ""13""THEN LEAVE vorwahl + ELIF hilf = "1" THEN schwierigkeit INCR 1 + ELIF hilf = "2" THEN schwierigkeit DECR 1 + ELIF hilf = "3" THEN geschwindigkeit INCR 1 + ELIF hilf = "4" THEN geschwindigkeit DECR 1 + ELIF hilf = "5" THEN liste aller spieler + ELSE out(""7"") + FI; + IF schwierigkeit > 26 THEN schwierigkeit := 1 + ELIF schwierigkeit < 1 THEN schwierigkeit := 26 FI; + IF geschwindigkeit > 9 THEN geschwindigkeit := 1 + ELIF geschwindigkeit < 1 THEN geschwindigkeit := 9 FI; + PER + +ENDPROC vorwahl; + +PROC spielregeln : + putline(code(char1)+" = Rahmen (Mauer)"); + line; + putline(code(char2)+" = Lindwurmkopf"); + line; + putline(code(char3)+" = Nahrung"); + line; + putline(""15""8""14" = Lindwurm"); + line; + putline(". = Gift"); + line; + putline ("Ziel des Spiels ist es, den Wurm mit Nahrung zu versorgen. Gift ist tdlich."); + line; + putline ("Der Wurm kann mit den Pfeiltasten gesteuert werden. Wird eine Taste mehrmals"); + line; + putline ("gedrckt, wird der Wurm schneller. Vorsicht: Der Wurm darf nicht auf eine"); + line; + putline ("Mauer treffen. Mit jedem gefressenen Nahrungsteilchen wird der Wurm etwas"); + line; + putline ("lnger. Du hast 3 Minuten Zeit, den Wurm zu fttern."); + line; + putline ("Viel Erfolg. Bitte drcke jetzt eine Taste."); + pause(6000); +ENDPROC spielregeln; + +PROC bonusspiel : + stelle := basis+zeilen*spaltenDIV2; + index := 0; + punkte := 0; + richtung := 0; + zaehler := 0; + ende := 0; + laenge := 0; + schwierigkeit INCR 1; + IF schwierigkeit > 26 THEN schwierigkeit := 26 FI; + begrenzung := 120 * schwierigkeit + +ENDPROC bonusspiel; + +PROC lebensraum generieren : + FOR i FROM 1 UPTO 16 * schwierigkeit REP + REP + x := int(random * real((zeilen-2)*spalten) + real(spalten)); + UNTIL peek(basis+x) = leerzeichen PER; + poke(basis+x,char3) + PER; + FOR i FROM 1 UPTO schwierigkeit REP + REP + x := int(random * real((zeilen-2)*spalten) + real(spalten)); + UNTIL peek(basis+x) = leerzeichen PER; + poke(basis+x,46) + PER; +ENDPROC lebensraum generieren; + +PROC lindwurmkopf setzen : + WHILE peek(stelle) <> leerzeichen REP stelle INCR 1 PER; + poke(stelle,char2); + out(""7""); + +ENDPROC lindwurmkopf setzen; + +PROC rahmen : + FOR i FROM basis UPTO basis + spalten-1 REP + poke(i,char4); + poke(i+(zeilen-1)*spalten,char4); + PER; + i := basis + spalten; + REP poke(i ,char4); + poke(i+spalten-1,char4); + i INCR spalten + UNTIL i >( basis + (zeilen-1)*spalten )PER + +ENDPROC rahmen; + +PROC clearscreen : + INT VAR x,y; + putline ("Nun markiert der Wurm sein Revier."); + line ; + put("Es ist");put(spalten);put("qm gross.");line; + FOR x FROM 1 UPTO spalten REP + cout(x); + FOR y FROM 1 UPTO zeilen REP + bildschirm(x)(y) := leerzeichen + PER + PER +ENDPROC clearscreen; + +TEXT PROC zeit : + subtext(time(clock(1)-uhr),5,8) +ENDPROC zeit; + +PROC reset time : + uhr := clock(1) +ENDPROC reset time;. + +deklaration : + ROW spalten ROW zeilen INT VAR bildschirm; + ROW 300 INT VAR spielerpunkte; + ROW 300 TEXT VAR spielername; + ROW max INT VAR wurm; + TEXT VAR hilf,taste,stopzeit; + INT VAR basis:=0,playercounter:=0,highscore:=0,q:=0,i:=0,x:=0,y:=0,stelle:=1000,richtung, + punkte:=0,bonus:=0,index:=0,cspalte,czeile,bildschirmzeile,zaehler:=0,ende:=0, + laenge:=0,speicher:=1,leerzeichen:=32,begrenzung:=480,schwierigkeit:=4, + geschwindigkeit:=9,c:=90,char1:=90,char2:=90,char3:=90,char4:=90; + + REAL VAR uhr; + BOOL VAR feuer; +ENDPACKET lindwurm diff --git a/app/misc-games/unknown/src/SCHIFFEV.ELA b/app/misc-games/unknown/src/SCHIFFEV.ELA new file mode 100644 index 0000000..2979a2c --- /dev/null +++ b/app/misc-games/unknown/src/SCHIFFEV.ELA @@ -0,0 +1,424 @@ + (* M.Staubermann,15.03.83 *) + +PACKET schiffe versenken DEFINES schiffe versenken : + + +(* D E K L A R A T I O N S T E I L *) + + +TEXT VAR eingabe, mitteilung := ""; +INT VAR x pos, y pos, reply; +BOOL VAR spieler 1, dran; +ROW 5 INT VAR count := ROW 5 INT : (0,0,0,0,0); +DATASPACE VAR ds; +forget(ds); +ds := nilspace; +BOUND TEXT VAR msg := ds; +CONCR(msg) := ""; +TASK VAR gegner,source; +forget(ds); +ds:=nilspace; +BOUND STRUCT (INT x , y) VAR schuss := ds; +forget(ds); +CONCR(schuss).x:= 1; +CONCR(schuss).y := 1; +ROW 11 ROW 17 TEXT VAR spielfeld; +LET mark begin = ""15"", + mark end = ""14"", + return = ""13"", + down = ""10"", + back = ""8"", + bell = ""7"", + up = ""3"", + vor = ""2"", + blank = " ", + nil = "", + schiffstypen= "5:F4:K3:S2:V1:P"; + +(* Ende des Deklarationsteils *) + + + +PROC schiffe versenken : + command dialogue(TRUE); + REP + IF no("Sind die Spielregeln bekannt") THEN page; + gib die spielregeln aus; + pause(200); + FI; + page; + line(6); + putline(" ABCDEFGH"); + putline(" +--------+"); + putline("1| |"); + putline("2| |"); + putline("3| |"); + putline("4| |"); + putline("5| |"); + putline("6| |"); + putline("7| |"); + putline("8| |"); + putline(" +--------+"); + putline(" Spielfeld"); + cursor(20,1); + putline("S c h i f f e v e r s e n k e n : "); + spiel ausfuehren;page + UNTIL no("Noch ein Spiel") PER +END PROC schiffe versenken; + + + +PROC gib die spielregeln aus: + cursor(15,2); + putline("DIE SPIELREGELN :"); + cursor(15,3); + putline("Es gibt fuenf Schiffstypen mit verschieden Laengen, die beim"); + cursor(15,4); + putline("""Gegner"" versenkt werden muessen.Er versenkt sie hier.Dazu"); + cursor(15,5); + putline("geht man mit dem Cursor an die entsprechende Stelle im Spiel -"); + cursor(15,6); + putline("feld und gibt zuerst die Position der Schiffe(waagerecht und "); + cursor(15,7); + putline("senkrecht) ein und waehrend des Spiels die Position, an der "); + cursor(15,8); + putline("ein gegnerisches Schiff vermutet wird. Ein Signal ertoent, "); + cursor(15,9); + putline("wenn man getroffen hat.Von jedem Schiffstyp ist nur ein Schiff"); + cursor(15,10); + putline("erlaubt.Beenden des Spiels mit 'E'. Schiessen mit ."); + cursor(3,9); +END PROC gib die spielregeln aus; + + + + +PROC botschaft (TEXT CONST message , TEXT CONST darstellen): + forget(ds); + ds := nilspace; + msg := ds; + CONCR(msg) := message; + REP send(gegner,0,ds,reply) UNTIL reply = 0 PER; + IF NOT (darstellen = "") THEN cursor(1,21); + putline(darstellen); + pause(100); + cursor(1,21); + leerzeile; + cursor(3,9) + FI +END PROC botschaft; + + + +PROC empfang (TEXT VAR message , BOOL CONST darstellen) : + forget(ds); + ds := nilspace; + REP wait (ds,reply,source) UNTIL (reply = 0) AND (source=gegner) + PER; + msg := ds; + message := CONCR(msg); + forget(ds); + IF darstellen THEN cursor(1,21); + putline(message); + pause(100); + cursor(1,21); + leerzeile; + cursor(3,9) + FI +END PROC empfang; + + + +PROC darstellen (TEXT CONST message) : + cursor(1,21); + putline(message); + pause(100); + cursor(1,21); + leerzeile; + cursor(3,9); +END PROC darstellen; + + + +PROC spiel ausfuehren : + forget(ds); + ds := nilspace; + msg := ds; + forget(ds); + ds := nilspace; + schuss := ds; + forget(ds); + cursor(1,20); + putline(mark begin + 28 * blank + "Info an den Spieler" + 28 * blank + + mark end); + cursor(1,21); + put("Task - Name des Mitspielers : "); + getline(eingabe); + IF exists(task(eingabe)) AND NOT (task (eingabe) + = myself) AND NOT (channel(task(eingabe)) < 0) + THEN gegner := task(eingabe); + putline("Er sitzt an Terminal " + text (channel(gegner))); + pause(100); + cursor(1,22); + leerzeile; + cursor(1,21); + leerzeile; + ELSE putline("Unerlaubter Task - Name !"); + pause(100); + LEAVE spiel ausfuehren + FI; + darstellen("Mit dem Partner vereinbaren , wer beginnt."); + cursor(1,21); + spieler 1 := yes("Faengt der Spieler an, der an diesem Terminal sitzt"); + cursor(1,21); + pause(10); + leerzeile; + IF spieler 1 THEN botschaft (name(myself) + " faengt an !",""); + ELSE empfang(mitteilung, TRUE) + FI; + dran := spieler 1; + cursor(15,14); + putline("Schiffstypen sind :"); + cursor(15,15); + putline("Flugzeugtraeger : FFFFF"); + cursor(15,16); + putline("Kreuzer : KKKK"); + cursor(15,17); + putline("Schnellboote : SSS"); + cursor(15,18); + putline("Versorger : VV"); + cursor(15,19); + putline("Paddelboote : P"); + cursor(3,9); + eingabe der schiffe; + spiele eine runde; +END PROC spiel ausfuehren; + + + +PROC eingabe der schiffe : + count := ROW 5 INT : (0,0,0,0,0); + FOR y pos FROM 8 UPTO 17 REP + FOR x pos FROM 2 UPTO 11 REP + spielfeld[ x pos] [y pos] := "" + PER + PER; + darstellen("Positionieren Sie den Cursor auf die entsprechende Position innerhalb des"); + darstellen("Spielfeldes und druecken Sie (mit ) die Buchstaben , so dass alle"); + darstellen("Schiffe auf dem Spielfeld sind."); + REP + inchar(eingabe); + getcursor(x pos , y pos); + IF NOT randbegrenzung ueberschritten THEN + IF eingabe = "E" THEN IF spieler 1 THEN + botschaft(name(myself) + "hoert auf","Spiel beendet"); + ELSE darstellen("Spiel beendet.") + FI; + LEAVE eingabe der schiffe + ELIF eingabe = "F" THEN wenn moeglich vergroessere("F") + ELIF eingabe = "K" THEN wenn moeglich vergroessere("K") + ELIF eingabe = "S" THEN wenn moeglich vergroessere("S") + ELIF eingabe = "V" THEN wenn moeglich vergroessere("V") + ELIF eingabe = "P" THEN wenn moeglich vergroessere("P") + ELIF eingabe = " " THEN loesche position + ELIF eingabe = "?" THEN gib die spielregeln aus + ELIF (eingabe = back) OR (eingabe = vor) OR (eingabe = down) + OR (eingabe = up) THEN out(eingabe) + ELSE out(bell) + FI + ELSE out(bell) + FI + UNTIL alle schiffe eingegeben PER. + + + loesche position : + out(" ");out(""8""); + IF NOT (spielfeld [x pos] [y pos] = "") THEN count[int(schiffstypen + SUB (pos(schiffstypen,spielfeld[x pos][y pos])-2))] DECR 1 + FI; + spielfeld [x pos] [y pos] := "". + + + + + alle schiffe eingegeben : + (count [5] = 5) CAND (count [4] = 4) CAND (count [3] = 3) CAND + (count [2] = 2) CAND (count [1] = 1). + + +END PROC eingabe der schiffe; + + + + BOOL PROC randbegrenzung ueberschritten : + ((eingabe = back) CAND (x pos <= 3)) COR ((eingabe = vor) CAND (x pos >= + 10)) COR ((eingabe = down) CAND (y pos >= 16)) COR ((eingabe = up) CAND + (y pos <= 9)) + +END PROC randbegrenzung ueberschritten; + + + +PROC wenn moeglich vergroessere (TEXT CONST schiff) : + IF ((schiff = "F") AND (count [5] < 5)) COR ((schiff = "K") AND + (count [4] < 4)) COR ((schiff = "S") AND (count [3] < 3)) COR + ((schiff = "V") AND (count [2] < 2)) COR ((schiff = "P") AND + (count [1] = 0)) + THEN IF waagerechter oder senkrechter nachbar AND NOT diagonaler nachbar + OR(count [int(schiffstypen SUB (pos(schiffstypen, schiff) - 2))]=0) + AND noch kein schiff da + THEN count [int(schiffstypen SUB (pos(schiffstypen, schiff) - 2))] + INCR 1; + out(schiff + ""8""); + spielfeld [x pos] [y pos] :=schiff + FI + FI. + + + + waagerechter oder senkrechter nachbar : + ((spielfeld [sub x(x pos - 1)] [y pos] = schiff) OR + (spielfeld [sub x(x pos + 1)] [y pos] = schiff))XOR + ((spielfeld [x pos] [sub y(y pos - 1)] = schiff) OR + (spielfeld [x pos] [sub y(y pos + 1)] = schiff)). + + + + diagonaler nachbar : + (spielfeld [sub x(x pos + 1)] [sub y(y pos + 1)] = schiff) OR + (spielfeld [sub x(x pos + 1)] [sub y(y pos - 1)] = schiff) OR + (spielfeld [sub x(x pos - 1)] [sub y(y pos + 1)] = schiff) OR + (spielfeld [sub x(x pos - 1)] [sub y(y pos - 1)] = schiff) . + + + + noch kein schiff da : + IF spielfeld[x pos] [y pos] <> "" THEN out(bell);FALSE ELSE TRUE FI. + +END PROC wenn moeglich vergroessere; + + + +INT PROC sub x(INT CONST subscription): + IF subscription > 11 THEN 11 + ELIF subscription < 2 THEN 2 + ELSE subscription + FI + +END PROC sub x; + + + +INT PROC sub y(INT CONST subscription): + IF subscription > 17 THEN 17 + ELIF subscription < 8 THEN 8 + ELSE subscription + FI + +END PROC sub y; + + + +PROC spiele eine runde : + IF spieler 1 THEN botschaft(name(myself)+" hat alle Schiffe eingegeben." + , "Eingabe der Schiffe beendet.") + ELSE empfang(mitteilung , TRUE) + FI; + REP + IF dran THEN darstellen("Jetzt schiessen !"); + abschiessen + ELSE rufe gegner + FI; + dran := NOT dran; + UNTIL kein schiff mehr da PER; + gegner hat verloren . + + + + kein schiff mehr da : + (count [5] = 0) CAND (count [4] = 0) CAND (count [3] = 0) CAND + (count [2] = 0) CAND (count [1] = 0). + + + + abschiessen : + REP + inchar(eingabe); + getcursor(x pos, y pos); + IF NOT randbegrenzung ueberschritten THEN + IF eingabe = "E" THEN IF spieler 1 THEN + botschaft(name(myself)+" hoert auf.","Spiel beendet."); + ELSE darstellen ("Spiel beendet.") FI; + LEAVE spiele eine runde + ELIF eingabe = return THEN schuss gegner; + forget(ds); + ds := nilspace; + CONCR(schuss).x := x pos; + CONCR(schuss).y := y pos; + schuss := ds; + REP send (gegner,0,ds,reply) + UNTIL reply = 0 PER; + empfang(mitteilung,TRUE); + ELIF eingabe = "?" THEN gib die spielregeln aus + ELIF (eingabe = back) OR (eingabe = vor) OR (eingabe = up) + OR (eingabe = down) THEN out(eingabe) + ELSE out(bell) + FI + ELSE out(bell) + FI + UNTIL eingabe = return PER. + + + + elem : + spielfeld [sub x(CONCR(schuss).x)] [sub y(CONCR(schuss).y)]. + + + + gegner hat verloren : + botschaft("gegner hat verloren","Sie haben gewonnen.Herzlichen Glueckwunsch meinerseits !"). + + + schuss gegner : + botschaft("gegner schiesst",""). + + + + rufe gegner : + empfang(mitteilung,FALSE); + IF mitteilung = "gegner schiesst" THEN forget(ds); + ds := nilspace; + REP wait(ds,reply,source) + UNTIL (reply = 0) AND (source + = gegner) PER; + schuss := ds; + IF elem <> "" THEN + count[int(schiffstypen SUB + (pos(schiffstypen,elem)- 2 + ))] DECR 1; + cursor(CONCR(schuss).x, + CONCR(schuss).y); + out(" "); + IF count[int(schiffstypen SUB (pos(schiff + stypen,elem) - 2))] = 0 + THEN botschaft(elem + " versenkt" + + bell, "") + ELSE botschaft(elem + " getroffen" + + bell,"") + FI; + elem := "" + ELSE botschaft("nicht getroffen","") + FI;forget(ds) + ELIF mitteilung = "gegner hat verloren" THEN + botschaft("Spiel beendet", + "Sie haben verloren.Tut mir leid."); + LEAVE spiele eine runde + ELSE darstellen(mitteilung) + FI +END PROC spiele eine runde. + + +leerzeile : + 77 TIMESOUT blank + +END PACKET schiffe versenken diff --git a/app/misc-games/unknown/src/SCHIFFEV2.ELA b/app/misc-games/unknown/src/SCHIFFEV2.ELA new file mode 100644 index 0000000..a4b8b0b --- /dev/null +++ b/app/misc-games/unknown/src/SCHIFFEV2.ELA @@ -0,0 +1,409 @@ + (* M.Staubermann,15.03.83 *) + (* Korr. 24.05.87 *) +PACKET schiffe versenken DEFINES schiffe versenken : + + +(* D E K L A R A T I O N S T E I L *) + + +TEXT VAR eingabe, mitteilung := ""; +INT VAR x pos, y pos, reply; +BOOL VAR spieler 1, dran; +ROW 5 INT VAR count := ROW 5 INT : (0,0,0,0,0); +DATASPACE VAR ds; +forget(ds); +ds := nilspace; +BOUND TEXT VAR msg := ds; +CONCR(msg) := ""; +TASK VAR gegner,source; +forget(ds); +ds:=nilspace; +BOUND STRUCT (INT x , y) VAR schuss := ds; +forget(ds); +CONCR(schuss).x:= 1; +CONCR(schuss).y := 1; +ROW 11 ROW 17 TEXT VAR spielfeld; +LET mark begin = ""15"", + mark end = ""14"", + return = ""13"", + down = ""10"", + back = ""8"", + bell = ""7"", + up = ""3"", + vor = ""2"", + blank = " ", + schiffstypen= "5:F4:K3:S2:V1:P"; + +(* Ende des Deklarationsteils *) + + + +PROC schiffe versenken : + command dialogue(TRUE); + REP + IF no("Sind die Spielregeln bekannt") THEN page; + gib die spielregeln aus; + pause(200); + FI; + page; + line(6); + putline(" ABCDEFGH"); + putline(" +--------+"); + putline("1| |"); + putline("2| |"); + putline("3| |"); + putline("4| |"); + putline("5| |"); + putline("6| |"); + putline("7| |"); + putline("8| |"); + putline(" +--------+"); + putline(" Spielfeld"); + cursor(20,1); + putline("S c h i f f e v e r s e n k e n : "); + spiel ausfuehren;page + UNTIL no("Noch ein Spiel") PER +END PROC schiffe versenken; + + + +PROC gib die spielregeln aus: + cursor(15,2); + putline("DIE SPIELREGELN :"); + cursor(15,3); + putline("Es gibt fnf Schiffstypen mit verschieden Lngen, die beim"); + cursor(15,4); + putline("""Gegner"" versenkt werden mssen. Er versenkt sie hier. Dazu"); + cursor(15,5); + putline("geht man mit dem Cursor an die entsprechende Stelle im Spiel-"); + cursor(15,6); + putline("feld und gibt zuerst die Position der Schiffe (waagerecht und"); + cursor(15,7); + putline("senkrecht) ein und whrend des Spiels die Position an der "); + cursor(15,8); + putline("ein gegnerisches Schiff vermutet wird. Ein Signal ertnt,"); + cursor(15,9); + putline("wenn man getroffen hat. Von jedem Schiffstyp ist nur ein Schiff"); + cursor(15,10); + putline("erlaubt. Beenden des Spiels mit 'E'. Schieen mit ."); + cursor(3,9); +END PROC gib die spielregeln aus; + + + + +PROC botschaft (TEXT CONST message , TEXT CONST darstellen): + forget(ds); + ds := nilspace; + msg := ds; + CONCR(msg) := message; + REP send(gegner,0,ds,reply) UNTIL reply = 0 PER; + IF NOT (darstellen = "") THEN cursor(1,21); + putline(darstellen); + pause(100); + cursor(1,21); + leerzeile; + cursor(3,9) + FI +END PROC botschaft; + + + +PROC empfang (TEXT VAR message , BOOL CONST darstellen) : + forget(ds); + ds := nilspace; + REP wait (ds,reply,source) UNTIL (reply = 0) AND (source=gegner) + PER; + msg := ds; + message := CONCR(msg); + forget(ds); + IF darstellen THEN cursor(1,21); + putline(message); + pause(100); + cursor(1,21); + leerzeile; + cursor(3,9) + FI +END PROC empfang; + + + +PROC darstellen (TEXT CONST message) : + cursor(1,21); + leerzeile ; + putline(message); + pause(50); + cursor(3,9); +END PROC darstellen; + + + +PROC spiel ausfuehren : + forget(ds); + ds := nilspace; + msg := ds; + forget(ds); + ds := nilspace; + schuss := ds; + forget(ds); + cursor(1,20); + putline(mark begin + 28 * blank + "Info an den Spieler" + 28 * blank + + mark end); + cursor(1,21); + put("Task - Name des Mitspielers : "); + getline(eingabe); + IF exists task(eingabe) AND NOT (task (eingabe) + = myself) AND NOT (channel(task(eingabe)) <= 0) + THEN gegner := task(eingabe); + putline("Er sitzt an Terminal " + text (channel(gegner))); + pause(100); + cursor(1,22); + leerzeile; + cursor(1,21); + leerzeile; + ELSE putline("Unerlaubter Task - Name !"); + pause(100); + LEAVE spiel ausfuehren + FI; + darstellen("Mit dem Partner vereinbaren, wer beginnt."); + cursor(1,21); + spieler 1 := yes("Faengt der Spieler an, der an diesem Terminal sitzt"); + cursor(1,21); + pause(10); + leerzeile; + IF spieler 1 THEN botschaft (name(myself) + " faengt an !",""); + ELSE empfang(mitteilung, TRUE) + FI; + dran := spieler 1; + cursor(15,14); + putline("Schiffstypen sind :"); + cursor(15,15); + putline("Flugzeugtraeger : FFFFF"); + cursor(15,16); + putline("Kreuzer : KKKK"); + cursor(15,17); + putline("Schnellboote : SSS"); + cursor(15,18); + putline("Versorger : VV"); + cursor(15,19); + putline("Paddelboote : P"); + cursor(3,9); + eingabe der schiffe; + spiele eine runde; +END PROC spiel ausfuehren; + + + +PROC eingabe der schiffe : + count := ROW 5 INT : (0,0,0,0,0); + FOR y pos FROM 8 UPTO 17 REP + FOR x pos FROM 2 UPTO 11 REP + spielfeld[ x pos] [y pos] := "" + PER + PER; + darstellen("Positionieren Sie den Cursor auf die entsprechende Position innerhalb des"); + darstellen("Spielfeldes und drcken Sie (mit ) die Buchstaben, so da alle"); + darstellen("Schiffe auf dem Spielfeld sind."); + REP + inchar(eingabe); + getcursor(x pos , y pos); + IF eingabe = "E" THEN IF spieler 1 THEN + botschaft(name(myself) + "hoert auf","Spiel beendet"); + ELSE darstellen("Spiel beendet.") + FI; + LEAVE eingabe der schiffe + ELIF eingabe = "F" THEN wenn moeglich vergroessere("F") + ELIF eingabe = "K" THEN wenn moeglich vergroessere("K") + ELIF eingabe = "S" THEN wenn moeglich vergroessere("S") + ELIF eingabe = "V" THEN wenn moeglich vergroessere("V") + ELIF eingabe = "P" THEN wenn moeglich vergroessere("P") + ELIF eingabe = " " THEN loesche position + ELIF eingabe = "?" THEN gib die spielregeln aus + ELIF (eingabe = back) AND x pos > 3 THEN out (back) + ELIF (eingabe = vor) AND x pos < 10 THEN out (vor) + ELIF (eingabe = down) AND y pos < 16 THEN out (down) + ELIF (eingabe = up) AND y pos > 9 THEN out(up) + FI + UNTIL alle schiffe eingegeben PER. + + + loesche position : + out(" ");out(""8""); + IF NOT (spielfeld [x pos] [y pos] = "") THEN count[int(schiffstypen + SUB (pos(schiffstypen,spielfeld[x pos][y pos])-2))] DECR 1 + FI; + spielfeld [x pos] [y pos] := "". + + + + + alle schiffe eingegeben : + (count [5] = 5) CAND (count [4] = 4) CAND (count [3] = 3) CAND + (count [2] = 2) CAND (count [1] = 1). + + +END PROC eingabe der schiffe; + + + +PROC wenn moeglich vergroessere (TEXT CONST schiff) : + IF ((schiff = "F") AND (count [5] < 5)) COR ((schiff = "K") AND + (count [4] < 4)) COR ((schiff = "S") AND (count [3] < 3)) COR + ((schiff = "V") AND (count [2] < 2)) COR ((schiff = "P") AND + (count [1] = 0)) + THEN IF waagerechter oder senkrechter nachbar AND NOT diagonaler nachbar + OR(count [int(schiffstypen SUB (pos(schiffstypen, schiff) - 2))]=0) + AND noch kein schiff da + THEN count [int(schiffstypen SUB (pos(schiffstypen, schiff) - 2))] + INCR 1; + out(schiff + ""8""); + spielfeld [x pos] [y pos] :=schiff + FI + FI. + + + + waagerechter oder senkrechter nachbar : + ((spielfeld [sub x(x pos - 1)] [y pos] = schiff) OR + (spielfeld [sub x(x pos + 1)] [y pos] = schiff))XOR + ((spielfeld [x pos] [sub y(y pos - 1)] = schiff) OR + (spielfeld [x pos] [sub y(y pos + 1)] = schiff)). + + + + diagonaler nachbar : + (spielfeld [sub x(x pos + 1)] [sub y(y pos + 1)] = schiff) OR + (spielfeld [sub x(x pos + 1)] [sub y(y pos - 1)] = schiff) OR + (spielfeld [sub x(x pos - 1)] [sub y(y pos + 1)] = schiff) OR + (spielfeld [sub x(x pos - 1)] [sub y(y pos - 1)] = schiff) . + + + + noch kein schiff da : + IF spielfeld[x pos] [y pos] <> "" THEN out(bell);FALSE ELSE TRUE FI. + +END PROC wenn moeglich vergroessere; + + + +INT PROC sub x(INT CONST subscription): + IF subscription > 11 THEN 11 + ELIF subscription < 2 THEN 2 + ELSE subscription + FI + +END PROC sub x; + + + +INT PROC sub y(INT CONST subscription): + IF subscription > 17 THEN 17 + ELIF subscription < 8 THEN 8 + ELSE subscription + FI + +END PROC sub y; + + + +PROC spiele eine runde : + IF spieler 1 THEN botschaft(name(myself)+" hat alle Schiffe eingegeben." + , "Eingabe der Schiffe beendet.") + ELSE empfang(mitteilung , TRUE) + FI; + REP + IF dran THEN darstellen("Jetzt schiessen !"); + abschiessen + ELSE rufe gegner + FI; + dran := NOT dran; + UNTIL kein schiff mehr da PER; + gegner hat verloren . + + + + kein schiff mehr da : + (count [5] = 0) CAND (count [4] = 0) CAND (count [3] = 0) CAND + (count [2] = 0) CAND (count [1] = 0). + + + + abschiessen : + REP + inchar(eingabe); + getcursor(x pos, y pos); + IF eingabe = "E" THEN IF spieler 1 THEN + botschaft(name(myself)+" hoert auf.","Spiel beendet."); + ELSE darstellen ("Spiel beendet.") FI; + LEAVE spiele eine runde + ELIF eingabe = return THEN schuss gegner; + forget(ds); + ds := nilspace; + CONCR(schuss).x := x pos; + CONCR(schuss).y := y pos; + schuss := ds; + REP send (gegner,0,ds,reply) + UNTIL reply = 0 PER; + empfang(mitteilung,TRUE); + ELIF eingabe = "?" THEN gib die spielregeln aus + ELIF (eingabe = back) AND x pos > 3 THEN out (back) + ELIF (eingabe = vor) AND x pos < 10 THEN out (vor) + ELIF (eingabe = down) AND y pos < 16 THEN out (down) + ELIF (eingabe = up) AND y pos > 9 THEN out(up) + FI + UNTIL eingabe = return PER. + + + + elem : + spielfeld [sub x(CONCR(schuss).x)] [sub y(CONCR(schuss).y)]. + + + + gegner hat verloren : + botschaft("gegner hat verloren","Sie haben gewonnen.Herzlichen Glueckwunsch meinerseits !"). + + + schuss gegner : + botschaft("gegner schiesst",""). + + + + rufe gegner : + empfang(mitteilung,FALSE); + IF mitteilung = "gegner schiesst" THEN forget(ds); + ds := nilspace; + REP wait(ds,reply,source) + UNTIL (reply = 0) AND (source + = gegner) PER; + schuss := ds; + IF elem <> "" THEN + count[int(schiffstypen SUB + (pos(schiffstypen,elem)- 2 + ))] DECR 1; + cursor(CONCR(schuss).x, + CONCR(schuss).y); + out(" "); + IF count[int(schiffstypen SUB (pos(schiff + stypen,elem) - 2))] = 0 + THEN botschaft(elem + " versenkt" + + bell, "") + ELSE botschaft(elem + " getroffen" + + bell,"") + FI; + elem := "" + ELSE botschaft("nicht getroffen","") + FI;forget(ds) + ELIF mitteilung = "gegner hat verloren" THEN + botschaft("Spiel beendet", + "Sie haben verloren. Tut mir leid."); + LEAVE spiele eine runde + ELSE darstellen(mitteilung) + FI +END PROC spiele eine runde ; + + +.leerzeile : + out (""5"") + +END PACKET schiffe versenken diff --git a/app/mpg/1987/doc/GDOKKURZ.ELA b/app/mpg/1987/doc/GDOKKURZ.ELA new file mode 100644 index 0000000..f8203f2 --- /dev/null +++ b/app/mpg/1987/doc/GDOKKURZ.ELA @@ -0,0 +1,119 @@ +#type ("hs")##limit (16.0)# +#type ("prop3.3-24")# #center#*** MPG-GRAPHIK *** #block# + +#type ("prop7.5-16")# +#on ("u")#Einleitung:#off ("u")# +#type ("prop10-12")# + + Das MPG-Graphik-System ist eine Sammlung von aufein- + ander aufbauenden Umgebungs- und Applikationspaketen, in + die auch die bisherige EUMEL-Graphik vollstndig integriert + ist. + + Folgende Leistungsmerkmale zeichnen die MPG-Graphik aus: + - verbesserter und nun auch in der Paket-Hierarchie voll- + stndig Endgertunabhngiger EUMEL-Graphik-Kern. + - umfassende Dokumentation der EUMEL-Graphik und des + MPG-Graphik-Systems. + - taskunabhngige und mehrbenutzerfhige Ansteuerung der + Endgerte. + - normierte Ansteuerung der Endgerte auf unterster + Ebene. + - indirekte Graphik-Ausgabe. + - komfortable Steuerung der Graphik-Ausgabe. + - Vollstndige Untersttzung aller von der EUMEL-Graphik + vorgesehenen Leistungen: + - beliebig breite Linien + - frei definierbare Linientypen mit Erhalt des Musters + bei verketteten Linien + - Ansatzfreie verkettete Linien durch abrundung der + Enden. + - frei definierbare vektorielle Zeichenstze in beliebiger + Gre und Rotation. + - schnelles Clipping an den Kanten der Zeichenflche. + + Desweiteren: + - frei definierbare Farben in normierter RGB-Codierung. + - automatische Einstellung der EUMEL-Farben auf den + Endgerten (abschaltbar). + - Automatische Pause nach Abschlu der Ausgabe + (abschaltbar, also auch unterbrechungslose Ausgabe + mglich). + - bereinanderzeichnen mehrerer Zeichnungen mglich. + - leichte Anpassung und Integration neuer Endgerte bzw. + Endgert-Typen. + +#type ("prop7.5-16")# +#on ("u")#Applikationen:#off ("u")# +#type ("prop10-12")# + + - der komfortable mengesteuerte Funktionenplotter 'FKT'. + + - die einfach zu programmierende 'TURTLE'-Graphik. + + - der vollintegrierte dynamische Multispool-Manager 'PLOT'. + + - das 'EUCLID'-System zur umfassenden graphischen + Funktions- und Kurvendiskussion (in Vorbereitung). + + - der objektorientierte 2D-Graphik-Editor 'GED', auch zur + Zeichensatz-Erstellung (in PLanung). + +#type ("prop7.5-16")# +#on ("u")#Zur EUMEL-Graphik:#off ("u")# +#type ("prop10-12")# + - Es wurde die vorletzte Version der EUMEL-Graphik + (PICFILE-Typ: 1102) verwendet, da diese einen um- + fassenderen Objektumfang (neue Version: keine Hidden- + Lines und kein Zeichen in Weltkoordinaten) bietet. + Neuere PICFILEs (Typ: 1103) knnen mittels + 'GRAPHIK.Convert' in diesen Typ knvertiert werden. + + - Fehler dieser Version (die auch in der neuen Version + auftreten) wurden weitgehend beseitigt bzw. in der teil- + weise neuerstellten Dokumentation vermerkt. + + - Die Ausgabe von PICTUREs und PICFILEs wurde von den + Verwaltungspaketen ('picture' bzw. 'picfile') abgespalten, + so da die Erzeugung von Graphiken auch in der + Paket-Hierarchie Endgert-unabhngig mglich ist. + +#type ("prop7.5-16")# +#on ("u")#Zum Graphik-Tasksystem:#off ("u")# +#type ("prop10-12")# + - Jede Task im 'GRAPHIK'-Zweig kann auf jedes Endgert + direkt zugreifen, und aufgrund der normierten An- + steuerung der Endgerte knnen auch die (schnelleren) + Zeichnungs-Primitiva (Gerade ziehen, positionieren usw.) + bei Beachtung der Auflsung endgertunabhngig + verwendet werden. + + - Die indirekte Ausgabe von PICFILEs ist ber die Task + 'PLOT' mglich, dabei kann ber das Netz auch auf + Endgerte anderer Stationen zugegriffen werden. + +#type ("prop7.5-16")# +#on ("u")#Zur Ansteuerung der Endgerte:#off ("u")# +#type ("prop10-12")# + Vor der Ausgabe ist mit 'select plotter' das Endgert + einzustellen, auf das ausgegeben werden soll. + Die vom Graphik-System verwendeten Konstanten + ('drawing area' usw.) beziehen sich nunmehr auf das + eingestellte Endgert. + Bei Verwendung der Zeichnungs-Primitiva ist zu beachten, + das diese nur am Endgert-Kanal sinnvoll sind (die ber- + einstimmung von Endgert- und Task-Kanal wird aus Zeit- + grnden jedoch nicht berprft). + Die Ausgabe von PICFILEs erfolgt automatisch richtig, d.h. + am Endgert-Kanal direkt, ansonsten indirekt ber die + 'PLOT', die zur Ausgabe dynamische Kanal-Server erzeugt. + +#type ("prop7.5-16")# +#on ("u")#Zur Mehrbenutzerfhigkeit:#off ("u")# +#type ("prop10-12")# + Da die Task 'PLOT' fr alle Endgerte auch als Spooler + arbeitet, knnen Graphiken als PICFILEs von beliebig vielen + Benutzern von jeder Task im Graphik-Zweig aus erstellt + und ausgegeben werden (Soweit der Endgert-Kanal nicht + direkt genutzt wird), 'PLOT' sorgt dann fr die sequentielle + Ausgabe auf dem jeweils zugeordneten Endgert. diff --git a/app/mpg/1987/doc/GRAPHIK.doc.e b/app/mpg/1987/doc/GRAPHIK.doc.e new file mode 100644 index 0000000..9ea40dd --- /dev/null +++ b/app/mpg/1987/doc/GRAPHIK.doc.e @@ -0,0 +1,2234 @@ +#type ("prop.lq")##limit (16.0)# +#free(10.0)# +#headoff##bottomoff# + +#type("prop.breit.lq")##center##on("u")#Dokumentation des MPG-Graphik-Systems#off("u")# + +#free(1.0)# +#type("prop")##center#Version 2.1 vom 10.09.87 + +#free(0.5)# +#center#(c) 1987 Beat Jegerlehner & Carsten Weinholz + +#page# +#type("prop")##center#Dokumentation des MPG-Graphik-Systems +#type("8.5.klein")##center#Inhaltsverzeichnis +#type("pica.lq")##free(1.0)# +#type("prop")##limit(16.0)##linefeed(01.0)# +#type("pica")##on("u")#Inhaltsverzeichnis#off("u")##type("prop.lq")# +#free(0.5)# +#type ("prop.lq")##limit (16.0)# + Teil 1: Komponenten des Graphik-Systems ................... 1 + 1.0 GRAPHIK.Basis ................................ 1 + 2.0 GRAPHIK.Configuration/GRAPHIK.Configurator ... 1 + 3.0 GRAPHIK.Plot ................................. 1 + Teil 1.1: Generierung der Graphik ......................... 2 + Teil 1.2: Tasks des Graphik-Systems ....................... 3 + 1.0 Task: 'GRAPHIK' .............................. 3 + 2.0 Task: 'PLOT' ................................. 3 + 3.0 Task: 'FKT' .................................. 4 + Teil 2: Operationen der Basisgraphik ...................... 5 + 1.0 Paket: 'transformation' ...................... 5 + 2.0 Paket: picture ............................... 8 + 3.0 Paket: 'picfile' ............................. 13 + 4.0 Paket: 'devices' ............................. 17 + Teil 2.1: Operationen des 'device interface' .............. 19 + 1.0 Paket: 'device interface' .................... 19 + Teil 2.2: Operationen zur Graphik-Ausgabe ................. 23 + 2.0 Paket: 'basisplot' ........................... 23 + 3.0 Paket: 'plot interface' ...................... 27 + 4.0 Paket: 'plot' ................................ 29 + Teil 3: Konfigurierung der Graphik ........................ 30 + Teil 3.1: Der Graphik-Konfigurator ........................ 30 + Teil 3.2: Erstellung der Konfigurationsdateien ............ 31 + 1.0 Pseudo-Schlsselworte ........................ 32 + 2.0 Pseudo-Prozeduren ............................ 34 + Teil 4: Graphik-Applikationen ............................. 37 + Teil 4.1: Der Funktionenplotter 'FKT' ..................... 37 + 1.0 Allgemeines ber FKT ......................... 37 + 2.0 Das FKT-Menue ................................ 37 + 3.0 FKT-Menuepunkte .............................. 38 + Teil 4.2: Die TURTLE-Graphik .............................. 44 + 1.0 Paket: 'turtlegraphics' ...................... 44 + Stichwortverzeichnis ....................................... XX +#page(1)# +#head on##bottom on# +#bottom# +#right#Seite % +#end# +#head# +#type("prop")##center#Dokumentation des MPG-Graphik-Systems +#type("8.5.klein")##center#Teil 1: Komponenten des Graphik-Systems +#type("pica.lq")##free(1.0)# +#end# +#type("pica")##on("u")##ib(1)#Teil 1: Komponenten des Graphik-Systems#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + + Das MPG-Graphik-System besteht aus folgenden Komponenten: + + #ib(1)#1.0 GRAPHIK.Basis#ie(1)# + + 1.1 #ib(2," (1.1)")#PACKET transformation#ie(2,"")# + - Transformations- und Umrechnungsprozeduren zur Endgert- + unabhngigen Abbildung von PICTURES bzw. PICFILES. + + 1.2 #ib(2," (1.2)")#PACKET picture#ie(2,"")# + - Verwaltung des Datentyps PICTURE, der eine Bildebene objekt- + orientiert beschreibt. + + 1.3 #ib(2," (1.3)")#PACKET picfile#ie(2,"")# + - Verwaltung des Datentyps PICFILE, der ein aus verschiedenen Bild- + ebenen (PICTURES) bestehendes Bild und seine (allgemeine) Abbildung + auf den Endgerten beschreibt. + + 1.4 #ib(2," (1.4)")#PACKET devices#ie(2,"")# + - Allgemeine Verwaltung der verschiedenen Endgerte. + + + #ib(1)#2.0 GRAPHIK.Configuration/GRAPHIK.Configurator#ie(1)# + + 2.1 #ib(2," (2.1)")#PACKET deviceinterface#ie(2,"")# + - Bereitstellung der allgemeinen graphischen Basisoperationen, die + fr jedes Endgerat gleichartig vorhanden sind. + - Das 'deviceinterface' wird vom 'GRAPHIK.Configurator' bei Bedarf + durch geeignetes Zusammenbinden veschiedener Endgert- + Konfigurationsdateien automatisch erzeugt. + + + #ib(1)#3.0 GRAPHIK.Plot#ie(1)# + + 3.1 #ib(2," (3.1)")#PACKET basisplot#ie(2,"")# + - Bereitstellung der von der EUMEL-Graphik bentigten + Basisoperationen. + + 3.2 #ib(2," (3.2)")#PACKET plotinterface#ie(2,"")# + - Paket zur Ansteuerung und Kontrolle der Endgerte. + + 3.3 #ib(2," (3.3)")#PACKET plot#ie(2,"")# + - Ausgabeprozeduren fr PICTURES bzw. PICFILES fr alle Endgerte. +#page# +#type("pica")##on("u")##ib(1)#Teil 1.1: Generierung der Graphik#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + Es wird zunchst eine Task 'GRAPHIK' (o..) eingerichtet. + Das MPG-Graphik-Sytem befindet sich auf der Diskette 'GRAPHIK 2.1': + + - archive ("GRAPHIK 2.1") + - fetch ("GRAPHIK.Install",archive) + - run ("GRAPHIK.Install") + + 'GRAPHIK.Install' enthlt ein Generierungsprogramm, das die weitere Generierung + des Graphik-Systems vornimmt. + Existiert auf dem Archiv eine Datei 'GRAPHIK.Configuration', so wird nachge- + fragt, ob das Graphiksystem hinsichtlich der anzusteuernden Endgerte neu- + konfiguriert('GRAPHIK.Configuration' also in Abhngigkeit von den ebenfalls + auf der Diskette vorhandenen Endgert-Konfigurationsdateien neu erstellt + werden soll). Fehlt 'GRAPHIK.Configuration', so wird es zwangslufig neu er- + stellt (siehe 'Neukonfiguration des Graphik-Systems', S. #to page ("newconf")#). + Mit der im Hintergrund ablaufenden Installation des Plotmanagers in der + (Sohn-)Task 'PLOT' (siehe 'Funktion von PLOT', S.#to page ("plotmanager")#) steht dann die Graphik allen + Sohntasks von 'GRAPHIK' zur Verfgung: + + . + . + GRAPHIK + PLOT + FKT + EUCLID + user + usw. + . + . +#page# +#type("pica")##on("u")##ib(1)#Teil 1.2: Tasks des Graphik-Systems#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + + #ib(1)#1.0 Task: 'GRAPHIK'#ie(1)# + + 'GRAPHIK' ist die Ausgangstask des Graphik-Systems; in ihr werden (s.o) die + einzelnen Graphikpakete insertiert, und stehen den Sohntasks zur Verfgung + (siehe 'Operationen der Basisgraphik', S. #topage("gfuncts")#). Zustzlich kann sie den Plot- + manager in der Task 'PLOT' kontrollieren + + #ib(1)#2.0 Task: 'PLOT'#ie(1)##goalpage("plotmanager")# + + 'PLOT' enthlt den Multispool-Manager des Graphik-Systems, der die indirekte + Ausgabe von PICFILES auf jedem Endgert der Station ermglicht. Der Manager + verwaltet im Gegensatz zum 'PRINTER' aber nicht nur eine Warteschlange bzw. + Server sondern mehrere (die Anzahl ist durch die Konstante 'max spools' in + 'GRAPHIK.Manager' festgelegt). + (Achtung !, eine Task kann nicht mehr als 255 Datenrume, also Eintrge in + Warteschlangen verwalten !). + Sollte PLOT neben PRINTER zur graphischen Ausgabe auf dem Drucker arbei- + ten, so ist in PRINTER 'spool control task (/"PLOT")' einzustellen. + Der Plotmanager besitzt eine Kommandoebene, die wie folgt arbeitet: + Nach 'continue' erscheint der Prompt 'All-Plotter', der anzeigt, da nach- + folgende Kommandos gleichermassen auf alle Spools/Server wirken; sollen + die Kommandos auf nur einen Spool/Server wirken, so ist dieser mit 'select + plotter' einzustellen, was durch eine nderung des Prompts auf den + Plotternamen angezeigt wird. + + - 2.1 #ib(2," (2.1)")#listspool#ie(2,"")# + Gibt Auskunft ber die Inhalte und Aktivitten aller bzw. des + gewhlten Spools. + + - 2.2 #ib(2," (2.2)")#clearspool#ie(2,"")# + Initialisiert nach Rckfrage alle bzw. den gewhlten Spool; + smtliche Eintrge werden gelscht, evtl. laufende Ausgaben + abgebrochen (der Server beendet). + + - 2.3 #ib(2," (2.3)")#spool control#ie(2,"")# + (TEXT CONST control task) + Stellt die Task mit dem Namen 'control task' und alle ihre Shne + als privilegiert ein, d.h. Kommandos wie 'start', 'stop' usw. werden + von diesen Tasks wie auch von Systemstasks und von 'GRAPHIK' + aus zugelassen. + + - 2.4 #ib(2," (2.4)")#stop#ie(2,"")# + Unterbricht eine evtl. laufende Ausgabe und unterbindet die + weitere Ausgabe von Eintrgen aller bzw. des gewhlten Spools; + wobei nach Rckfrage die abgebrochene Ausgabe als erster + Eintrag erneut eingetragen wird. + + - 2.5 #ib(2," (2.5)")#start#ie(2,"")# + Nimmt die Ausgabe des gewhlten bzw. aller Spools wieder auf. + + - 2.6 #ib(2," (2.6)")#halt#ie(2,"")# + Unterbindet die weitere Ausgabe von Eintrgen aller bzw. des + gewhlten Spools; evtl. laufende Ausgaben werden jedoch nicht + abgebrochen. + + - 2.7 #ib(2," (2.7)")#select plotter#ie(2,"")# + Bietet als Auswahl die Endgerte der Station an; die obenge- + nannten Operationen wirken danach nur auf den gewhlten Spool, + was durch die nderung des Prompts auf den Namen des gewhlten + Endgertes angezeigt wird. + Der Abbruch der Auswahloperation fhrt dementsprechend wieder + zur Einstellung 'All-Plotter'. + Das aktuell zu kontrollierende Endgert kann jedoch auch mit + den Standard-Auswahloperationen gewhlt werden; diese lassen + aber auch die Wahl von Plottern anderer Stationen zu, was im + Plotmanager als 'All-Plotter' gewertet wird. + + Folgende Funktionen knnen nur auf einzelne Spools; also nicht auf + 'All-Plotter' angewendet werden: + + - 2.8 #ib(2," (2.8)")#killer#ie(2,"")# + Bietet im Dialog alle im Spool enthaltenen Eintrge zum Lschen + an. + + - 2.9 #ib(2," (2.9)")#first#ie(2,"")# + Bietet im Dialog alle dem ersten Eintrag nachfolgenden Eintrge + zum Vorziehen an. + + #ib(1)#3.0 Task: 'FKT'#ie(1)# + + Die Task 'FKT' stellt den Funktionenplotter FKT, bzw. dessen menuegesteuerten + Monitor als Taskmonitor zur Verfgung. + Wird die Task mit dem Menuepunkt + 'q' - in die Kommandoebene zurueck + verlassen, so werden alle enthaltenen PICFILES gelscht. + Der Funktionenplotter wird in 'FKT' mit dem Kommando 'fktmanager' instal- + liert; er ist jedoch auch in jeder anderen Task mit dem Kommando 'fktplot' + erreichbar. + +#page# +#bottom# +#right#Seite % +#end# +#head# +#type("prop")##center#Dokumentation des MPG-Graphik-Systems +#type("8.5.klein")##center#Teil 2: Operationen der Basisgraphik +#type("pica.lq")##free(1.0)# +#end# +#type("pica")##on("u")##ib(1)#Teil 2: Operationen der Basisgraphik#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# +#goalpage("gfuncts")# + Die Pakete der Basisgraphik sind in der Datei 'GRAPHIK.Basis' enthalten, und + realisieren folgende Aufgaben: + - Vektorielle Abbildung virtueller Koordinaten unter Verwendung einer + Transformationsmatrix auf die konkrete Endgert-Zeichenflche unter + Bercksichtigung des eingestellten Teils der Zeichenflche ('viewport') + und des Fensters ('window'). + - Bereitstellung des Datentyps PICTURE, der die gemeinsame Manipulation + von Objekten ermglicht. + - Bereitstellung des Datentyps PICFILE, der die gemeinsame Manipulation + von PICTURES hinsichtlich ihrer Ausgabe ermglicht. + - Bereitstellung des Datentyps PLOTTER, der die freie Auswahl von End- + gerten ermglicht, und Informationen ber sie liefert. + + Zu den mit '*' gekennzeichneten Beschreibungen vgl. die Beschreibung im + Programmierhandbuch. + + #ib(1)#1.0 Paket: 'transformation'#ie(1)# + + 1.1 BOOL PROC #ib(2," (1.1)")#clippedline#ie(2," (PROC)")# + (REAL VAR x0, y0, x1, y1) + - Intern verwendete Prozedur, welche die in den Variablen ber- + gebenen Anfangs- und Endkoordinaten einer Geraden auf die + Ausmae der aktuellen Endgert-Zeichenflche begrenzt. + Es wird zurckgeliefert, ob Teile der bergebenen Geraden inner- + halb der Zeichenflche liegen, also gezeichnet werden mssen. + + 1.2 PROC #ib(2," (1.2)")#drawingarea *#ie(2," (PROC)")# + (REAL VAR x cm, REAL VAR y cm, REAL VAR xp, REAL yp) + - Trgt in die bergebenen Variablen die Ausmae der aktuellen + Endgert-Zeichenflche in cm und Pixel ein. + + 1.3 PROC #ib(2," (1.3)")#getvalues#ie(2," (PROC)")# + (ROW 3 ROW 2 REAL VAR, ROW 2 ROW 2 REAL VAR, + ROW 4 REAL VAR, ROW 2 REAL VAR, ROW 3 REAL VAR) + - Intern verwendete Prozedur, die in die bergebenen Felder die + aktuellen Werte der Transformationsmatrix eintrgt. + + 1.4 BOOL PROC #ib(2," (1.4)")#newvalues#ie(2," (PROC)")# + - Intern verwendete Prozedur, die anzeigt, ob die Transformations- + matrix verndert wurde. + + 1.5 PROC #ib(2," (1.5)")#oblique *#ie(2," (PROC)")# + (REAL CONST a, b) + - Stellt fr o.g. Abbildungsfunktion die Projektionsart + 'schiefwinklig' ein; 'a;b' ist der Punkt in der X-Y-Ebene, auf den der + Einheitsvektor in Z-Richtung abgebildet werden soll. + + 1.6 PROC #ib(2," (1.6)")#orthographic *#ie(2," (PROC)")# + - Stellt die Projektionsart 'Paralellprojektion' ein (s.o.). + + 1.7 PROC #ib(2," (1.7)")#perspective *#ie(2," (PROC)")# + (REAL CONST x,y,z) + - Stellt die Abbildungsart 'perspektivisch' ein; 'x;y;z' gibt den + Fluchtpunkt der Zentralperspektive an. + + 1.8 PROC #ib(2," (1.8)")#setdrawingarea#ie(2," (PROC)")# + (REAL CONST x cm, y cm, x p, y p) + - Intern verwendete Prozedur, die vorm Beginn des Zeichnens dem + Transformationspaket die Ausmae der Endgert-Zeichenflche + bergibt. + + 1.9 PROC #ib(2," (1.9)")#setvalues#ie(2," (PROC)")# + (ROW 3 ROW 2 REAL CONST, ROW 2 ROW 2 REAL CONST, + ROW 4 REAL CONST, ROW 2 REAL CONST, ROW 3 REAL CONST) + - Intern verwendete Prozedur, welche die Transformationsmatrix mit + den Werten der bergebenen Felder fllt. + + 1.10 PROC #ib(2," (1.10)")#transform#ie(2," (PROC)")# + (REAL CONST x, y, z, xp, yp) + - Intern verwendete Prozedur zur Abbildung eines drei- + dimensionalen Vektors in virtuellen Koordinaten auf + (zweidimensionale) Bildschirmkoordinaten. + + 1.11 PROC #ib(2," (1.11)")#view *#ie(2," (PROC)")# + (REAL CONST alpha, phi, theta) + - Stellt fr o.g. Abbildungsfunktion zustzlich die Drehwinkel der + Abbildung in Polarkoordinaten ein. + In der derzeitigen Version fehlerhaft ! + + 1.12 PROC #ib(2," (1.12)")#view *#ie(2," (PROC)")# + (REAL CONST alpha, phi) + - s.o.; ebenfalls fehlerhaft ! + + 1.13 PROC #ib(2," (1.13)")#view *#ie(2," (PROC)")# + (REAL CONST alpha) + - Dreht die Abbildung um den Mittelpunkt der Zeichenflche um + 'alpha' Grad ! + + 1.14 PROC #ib(2," (1.14)")#viewport *#ie(2," (PROC)")##goalpage("viewport")# + (REAL CONST hormin, hormax, vertmin, vertmax) + - Definiert den verwendeten Teil der Endgert-Zeichenflche in + Welt- oder Gertekoordinaten, bei Verwendung dieser Prozedur ist + vorangehend 'window (TRUE)' aufzurufen; damit die neuen Werte + auch Bercksichtigung finden. + + 1. Angabe in Weltkoordinaten (cm): + 'hor min;vert min' - Position der unteren linken Ecke der ver- + wendeten Zeichenflche in cm. + 'hor max;vert max' - Position der oberen rechten Ecke der ver- + wendeten Zeichenflche in cm. + + 2. Angabe in Gertekoordinaten: + Es wird eine Angabe in Gertekoordinaten angenommen, wenn + hor max < 2.0 und vert max < 2.0 gilt. + Die Werte werden als Bruchteile der Gre der gesamten Zei- + chenflche aufgefat, wobei fr die horizontalen Werte zu- + stzlich das Verhltnis 'Horizontale/Vertikale' (i.d. Regel > 1) + bercksichtigt wird. + Das bedeutet fr 'vert max' = 'hor max' = 1, + da der obere Rand der spezifizierten Zeichenflche an der + Oberkante der Gesamt-Zeichenflche, und der rechte Rand an + der rechten Kante des durch die Gesamthhe der Zeichenflche + gegebenen Quadrates liegt (unverzerrt). + Soll die gesamte Zeichenflche genutzt werden, so ist 'hor min' + = 'vert min' = 0 und 'vert max' = 1 zu setzen; + 'hor max' dagegen auf das Verhltnis 'Horizontale/Vertikale' !. + Die halbe horizontale Verwendung der Zeichenflche ist durch + Halbierung des Seitenverhltnisses zu erreichen. + + 1.15 PROC #ib(2," (1.15)")#window *#ie(2," (PROC)")# + (REAL CONST xmin, xmax, ymin, ymax, zmin, zmax) + - Stellt die Fenstergre der virtuellen Zeichenflche, zu der die + virtuellen Koordinaten in Bezug gesetzt werden sollen, mittels + der gegenberliegenden Ecken 'min' und 'max' ein. + + 1.16 PROC #ib(2," (1.16)")#window *#ie(2," (PROC)")# + (REAL CONST xmin, xmax, ymin, ymax) + - s.o., jedoch fr zweidimensionale Darstellungen. + + 1.17 PROC #ib(2," (1.17)")#window *#ie(2," (PROC)")# + (BOOL CONST update) + - Die bergabe von TRUE verursacht die interne Neuberechnung der + Transformationsmatrix beim nchsten 'set values'; die immer dann + notwendig wird, wenn die Zeichenflche oder das mit 'viewport' + eingestellte virtuelle Fenster verndert werden soll. +#page# + #ib(1)#2.0 Paket: picture#ie(1)# + + 2.1 #ib(2," (2.1)")#TYPE PICTURE *#ie(2,"")# + - Datentyp zur Verwaltung eines einfarbigen Bildes; das aus entwe- + der zwei- oder dreidimensionalen Objekten besteht. + + 2.2 OP #ib(2," (2.2)")#:= *#ie(2," (OP)")# + (PICTURE VAR dest, PICTURE CONST source) + - Zuweisungsoperator fr den Datentyp PICTURE. + + 2.3 PROC #ib(2," (2.3)")#bar *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST width, height, pattern) + - Zeichnet in 'pic' an der aktuellen Position ein Rechteck + 'width/height' mit dem Muster 'pattern', wobei zu beachten ist, da + die aktuelle X-Position die horizontale Position der vertikalen + Symmetrieachse des Rechtecks angibt. + Als 'pattern' z.Zt. implementiert: + 0 - nicht gefllt + 1 - halb gefllt (zeitaufwendig!) + 2 - gefllt + 3 - horizontal schraffiert + 4 - vertikal schraffiert + 5 - horizontal und vertikal schraffiert + 6 - diagonal rechts schraffiert + 7 - diagonal links schraffiert + 8 - diagonal rechts und links schraffiert + + 2.4 OP #ib(2," (2.4)")#CAT *#ie(2," (OP)")# + (PICTURE VAR dest, PICTURE CONST add) + - Fgt die Bilder 'dest' und 'add' in 'dest' zusammen. + + 2.5 PROC #ib(2," (2.5)")#circle *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST x, y, rad, INT CONST pattern) + - Zeichnet in 'pic' an der Position 'x;y' mit dem Radius 'rad' und dem + Muster 'pattern' gefllt ('pattern' z.Zt. wirkungslos) + + 2.6 INT PROC #ib(2," (2.6)")#dim *#ie(2," (PROC)")# + (PICTURE CONST pic) + - Liefert die fr 'pic' eingestellte Dimensionalitt + (2 - zweidimensional; 3 - dreidimensional); wobei die Dimensionali- + tt mit der ersten Zeichenoperation eingestellt wird. + + 2.7 PROC #ib(2," (2.7)")#draw *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST x, y, z) + - Zeichnet in 'pic' von der aktuellen Position einen Gerade zur + Position 'x;y'. + + 2.8 PROC #ib(2," (2.8)")#draw *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST x, y, z) + - s.o., jedoch fr zweidimensionale Bilder. + + 2.9 PROC #ib(2," (2.9)")#draw *#ie(2," (PROC)")# + (PICTURE VAR pic, TEXT CONST text, REAL CONST angle, height, width) + - Zeichnet in 'pic' an der aktuellen Position 'text' in der Gre + 'height/width' unter dem Winkel 'angle'. + + 2.10 PROC #ib(2," (2.10)")#draw *#ie(2," (PROC)")# + (PICTURE VAR pic, TEXT CONST text) + - Zeichnet in 'pic' an der aktuellen Position 'text' in Standardgre + und normaler Ausrichtung. + + 2.11 PROC #ib(2," (2.11)")#draw cm *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST x cm, y cm) + - Zeichnet in 'pic' eine Gerade zur cm-Position 'x;y', d.h., die Projek- + tionseinstellung wird nicht beachtet. + + 2.12 PROC #ib(2," (2.12)")#draw cm r *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST dx cm, dy cm) + - Zeichnet in 'pic' eine Gerade zur um 'dx cm;dy cm' verschobenen + Zeichenposition, d.h, die Projektionseinstellung wird nicht beach- + tet. + + 2.13 PROC #ib(2," (2.13)")#draw r *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST dx, dy, dz) + - Zeichnet in 'pic' eine Gerade der Lnge 'dx;dy;dz' relativ zur + aktuellen Position. + + 2.14 PROC #ib(2," (2.14)")#draw r *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST dx, dy) + - s.o., jedoch fr zweidimensionale Bilder. + + 2.15 PROC #ib(2," (2.15)")#extrema *#ie(2," (PROC)")# + (PICTURE CONST pic, REAL VAR x min, x max, y min, y max, z min, z max) + - Trgt in die bergebenen Variablen die grssten und kleinsten + Koordinaten aller Objekte in 'pic' ein. + + 2.16 PROC #ib(2," (2.16)")#extrema *#ie(2," (PROC)")# + (PICTURE CONST pic, REAL VAR x min, x max, y min, y max) + - s.o., jedoch fr zweidimensionale Bilder. + + 2.17 INT PROC #ib(2," (2.17)")#length *#ie(2," (PROC)")# + (PICTURE CONST pic) + - Liefert die Lnge des Objekt-Verwaltungstextes von 'pic'. + + 2.18 PROC #ib(2," (2.18)")#move *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST x, y, z) + - Fhrt den Zeichenstift auf 'pic' an die Position 'x;y;z'. + + 2.19 PROC #ib(2," (2.19)")#move *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST x, y) + - s.o., jedoch fr zweidimensionale Bilder. + + 2.20 PROC #ib(2," (2.20)")#move cm *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST x cm, y cm) + - Die aktuelle Zeichenposition wird auf 'x cm;y cm' verschoben, wobei + die Darstellungsart unbercksichtigt bleibt. + + 2.21 PROC #ib(2," (2.21)")#move cm r *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST d xcm, d ycm) + - Die aktuelle Zeichenposition wird um 'd xcm;d ycm' verschoben, + wobei die Darstellungsart unbercksichtigt bleibt. + + 2.22 PROC #ib(2," (2.22)")#move r *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST dx, dy, dz) + - Verschiebt die aktuelle Zeichenposition in 'pic' um 'dx;dy;dz'. + + 2.23 PROC #ib(2," (2.23)")#move r *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST dx, dy) + - s.o., jedoch fr zweidimensionale Bilder. + + 2.24 PICTURE PROC #ib(2," (2.24)")#nilpicture *#ie(2," (PROC)")# + - Initialisierungsfunktion; liefert 'leeres Bild'. + + 2.25 INT PROC #ib(2," (2.25)")#pen *#ie(2," (PROC)")# + (PICTURE CONST pic) + - Liefert den fr 'pic' eingestellten Stift (Nummer 1 - 16). + + 2.26 PROC #ib(2," (2.26)")#pen *#ie(2," (PROC)")# + (PICTURE VAR pic, INT CONST no) + - Stellt den Stift 'no' fr 'pic' ein, wobei 'no' die Werte 1 - 16 an- + nehmen darf. + + 2.27 PICTURE PROC #ib(2," (2.27)")#picture *#ie(2," (PROC)")# + (TEXT CONST objects) + - Die Objektbeschreibung aller Objekte eines Bildes wird in einem + Text verwaltet; mit dieser Prozedur wird ein TEXT im entsprechen- + den Format in ein PICTURE verwandelt. + Das Format des TEXTes: Dimension : 2- oder 3-D + Zeichenstift-Nummer + <...> Objekteintrge + + Die Objekteintrge haben folgendes Format: + Objektcode <...> Parameter. + + Objektcodes fr: > Die Parameter entsprechen der + - draw 1 Parameterfolge der Prozeduren. + - move 2 + - text 3 > Vor dem Text wird als die + - move r 4 Textlnge gehalten. + - draw r 5 + - move cm 6 + - draw cm 7 + - move cm r 8 + - draw cm r 9 + - bar 10 + - circle 11 + + 2.28 PROC #ib(2," (2.28)")#rotate *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST alpha, beta, gamma) + - Die Objekte von 'pic' werden gem den Winkeln 'alpha;beta;gamma' + im positiven Sinne um die X-,Y-,Z-Achse gedreht; wobei nur ein + Winkel <> 0.0 sein darf. + + 2.29 PROC #ib(2," (2.29)")#rotate *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST alpha) + - Die Objekte von 'pic' werden gem dem Winkel 'alpha' im positiven + Sinne um die X-Achse gedreht. + + 2.30 PROC #ib(2," (2.30)")#stretch *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST xc, yc, zc) + - 'pic' wird um die Faktoren 'xc;yc;zc' gestreckt oder gestaucht: + Faktor > 1 -> Streckung + Faktor < 1 -> Stauchung + Faktor < 0 -> zustzlich Achsenspiegelung + + 2.31 PROC #ib(2," (2.31)")#stretch *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST xc, yc) + - s.o., jedoch fr zweidimensionale Bilder. + + 2.32 TEXT PROC #ib(2," (2.32)")#text *#ie(2," (PROC)")# + (PICTURE CONST pic) + - Liefert den Objekt-Verwaltungstext von 'pic'(vergleiche + 'picture'). + + 2.33 PROC #ib(2," (2.33)")#translate *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST dx, dy, dz) + - 'pic' wird um 'dx;dy;dz' verschoben. + + 2.34 PROC #ib(2," (2.34)")#translate *#ie(2," (PROC)")# + (PICTURE VAR pic, REAL CONST dx, dy) + - s.o., jedoch fr zweidimensionale Bilder. + + 2.35 PROC #ib(2," (2.35)")#where *#ie(2," (PROC)")# + (PICTURE CONST pic, REAL VAR x, y, z) + - Trgt die aktuelle Zeichenposition in 'pic' in die bergebenen + Variablen 'x;y;z' ein. + + 2.36 PROC #ib(2," (2.36)")#where *#ie(2," (PROC)")# + (PICTURE CONST pic, REAL VAR x, y) + - s.o., jedoch fr zweidimensionale Bilder. +#page# + #ib(1)#3.0 Paket: 'picfile'#ie(1)# + + 3.1 #ib(2," (3.1)")#TYPE PICFILE#ie(2,"")# + - Datentyp zur Verwaltung mehrerer Bilder (PICTUREs) und der + Darstellungsparameter.(Aktuelle Typnummer: 1102 !). + + 3.2 OP #ib(2," (3.2)")#:= *#ie(2," (OP)")# + (PICFILE VAR dest, DATASPACE CONST source) + - Assoziiert das PICFILE 'dest' mit dem DATASPACE 'source'. + + 3.3 OP #ib(2," (3.3)")#:= *#ie(2," (OP)")# + (PICFILE VAR dest, PICFILE CONST source): + - Assoziiert das PICFILE 'dest' mit 'source'; wie bei Files entsteht + keine Kopie! + + 3.4 INT PROC #ib(2," (3.4)")#background *#ie(2," (PROC)")# + (PICFILE CONST pf) + - Liefert die auf 'pf' eingestellte Hintergrundfarbe. + + 3.5 PROC #ib(2," (3.5)")#background *#ie(2," (PROC)")# + (PICFILE VAR pf, INT CONST no) + - Stellt die Farbe 'no' als Hintergrundfarbe fr 'pf' ein: + + 3.6 PROC #ib(2," (3.6)")#delete picture *#ie(2," (PROC)")# + (PICFILE VAR pf) + - Lscht das aktuelle Bild in 'pf'. + + 3.7 PROC #ib(2," (3.7)")#down *#ie(2," (PROC)")# + (PICFILE VAR pf) + - Positioniert in 'pf' ein Bild weiter. + + 3.8 PROC #ib(2," (3.8)")#down *#ie(2," (PROC)")# + (PICFILE VAR pf, INT CONST step) + - Positioniert in 'pf' 'step'-Bilder weiter. + + 3.9 BOOL PROC #ib(2," (3.9)")#eof *#ie(2," (PROC)")# + (PICFILE CONST) + - Liefert zurck, ob das aktuelle Bild auch das letzte des PICFILES + ist. + + 3.10 PROC #ib(2," (3.10)")#extrema *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL VAR x min, x max, y min, y max, z min, z max) + - Trgt in die bergebenen Variablen die kleinsten bzw. grten + Koordinaten aller Bilder in 'pf' ein. + + 3.11 PROC #ib(2," (3.11)")#extrema *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL VAR x min, x max, y min, y max) + - s.o., jedoch fr zweidimensionale PICFILEs. + + 3.12 PROC #ib(2," (3.12)")#get *#ie(2," (PROC)")# + (PICFILE VAR pf, FILE VAR source) + - Liest die in 'source' enthaltenen Informationen ber Bilder nach + 'pf' ein. + + 3.13 PROC #ib(2," (3.13)")#get values *#ie(2," (PROC)")# + (PICFILE CONST pf, ROW 3 ROW 2 REAL VAR,ROW 2 ROW 2 REAL VAR, + ROW 4 REAL VAR, ROW 2 REAL VAR, ROW 3 REAL VAR) + - Trgt die Werte der Transformationsmatrix von 'pf' in die ber- + gebenen Variablenfelder ein. + + 3.14 PROC #ib(2," (3.14)")#insert picture *#ie(2," (PROC)")# + (PICFILE VAR pf) + - Fgt vor das aktuelle Bild von 'pf' ein leeres Bild ein. + + 3.15 BOOL PROC #ib(2," (3.15)")#is first picture *#ie(2," (PROC)")# + (PICFILE CONST pf) + - Liefert zurck, ob das aktuelle auch das erste Bild von 'pf' ist. + + 3.16 PROC #ib(2," (3.16)")#oblique *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL CONST a, b) + - Stellt fr 'pf' die Projektionsart 'schiefwinklig' ein; 'a;b' ist der + Punkt in der X-Y-Ebene, auf den der Einheitsvektor in Z-Richtung + abgebildet werden soll. + + 3.17 PROC #ib(2," (3.17)")#perspective *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL CONST x, y, z) + - Stellt fr 'pf' die Projektionsart 'perspektivisch' ein; 'x;y;z' gibt + den Fluchtpunkt der Zentralperspektive an. + + 3.18 INT PROC #ib(2," (3.18)")#picture no *#ie(2," (PROC)")# + (PICFILE CONST pf) + - Liefert die Nummer des aktuellen Bildes von 'pf' zurck. + + 3.19 INT PROC #ib(2," (3.19)")#pictures *#ie(2," (PROC)")# + (PICFILE CONST pf) + - Liefert die Anzahl der in 'pf' enthaltenen Bilder zurck. + + 3.20 PROC #ib(2," (3.20)")#put *#ie(2," (PROC)")# + (FILE VAR dest, PICFILE CONST pf) + - Liest 'pf' nach 'dest' aus. + + 3.21 PROC #ib(2," (3.21)")#put picture *#ie(2," (PROC)")# + (PICFILE VAR pf, PICTURE CONST ins) + - Fgt das Bild 'ins' vor das aktuelle Bild von 'pf' ein. + + 3.22 PROC #ib(2," (3.22)")#read picture *#ie(2," (PROC)")# + (PICFILE VAR pf, PICTURE VAR pic) + - Trgt das aktuelle Bild von 'pf' in 'pic' ein. + + 3.23 PROC #ib(2," (3.23)")#selected pen *#ie(2," (PROC)")# + (PICFILE VAR pf, INT CONST no, INT VAR color, thickness, linetype, + BOOL VAR visible) + - Trgt in die bergebenen Variablen die fr den Stift 'no' aktuell + eingestellten Werte ein, wobei 'no' die Werte 1 - 16 annehmen darf. + + 3.24 PROC #ib(2," (3.24)")#select pen *#ie(2," (PROC)")# + (PICFILE VAR pf, INT CONST no, INT CONST color, thickness, linetype, + BOOL CONST visible) + - Stellt fr den Stift 'no' von 'pf' die bergebenen Werte fr Farbe, + Stiftbreite, Art des Linenzuges ein, wobei 'no' die Werte 1 - 16 + annehmen darf. + 'visible' = FALSE bedeutet, das die mit diesem Stift gezogenen + Linien innerhalb bereits durch das Zeichnen entstandener Flchen + nicht gezeichnet werden, die Flchen sie also 'verdecken'. + Vordefiniert sind: + - color: + <0 - nicht standardisierte XOR-Modi + 0 - Lschstift + 1 - Standardfarbe d. Endgertes (s/w) + 2 - rot + 3 - blau + 4 - grn + 5 - schwarz + 6 - weiss + n - Sonderfarben + - thickness: + 0 - Standardstrichstrke d. Endgertes + n - Strichstrke in 1/10 mm + - linetype: + 0 - keine Linie + 1 - durchgngige Linie + 2 - gepunktete Linie + 3 - kurz gesrichelte Linie + 4 - lang gestrichelte Linie + 5 - Strichpunktlinie + (Standard-Definitionen, die Linetypes knnen + ber 'basisplot' auch verndert werden.) + + 3.25 PROC #ib(2," (3.25)")#set values *#ie(2," (PROC)")# + (PICFILE VAR pf, ROW 3 ROW 2 REAL CONST, + ROW 2 ROW 2 REAL CONST, + ROW 4 REAL CONST, + ROW 2 REAL CONST, ROW 3 REAL CONST) + - Die bergebenen Felder werden in die Transformationsmatrix von + 'pf' bernommen. + + 3.26 PROC #ib(2," (3.26)")#to eof *#ie(2," (PROC)")# + (PICFILE VAR pf) + - Positioniert auf das letzte Bild von 'pf'. + + 3.27 PROC #ib(2," (3.27)")#to first pic *#ie(2," (PROC)")# + (PICFILE VAR pf) + - Positioniert auf das erste Bild von 'pf'. + + 3.28 PROC #ib(2," (3.28)")#to pic *#ie(2," (PROC)")# + (PICFILE VAR pf, INT CONST n) + - Positioniert auf das 'n'-te Bild von 'pf'. + + 3.29 PROC #ib(2," (3.29)")#up *#ie(2," (PROC)")# + (PICFILE VAR pf) + - Positioniert in 'pf' ein Bild zurck. + + 3.30 PROC #ib(2," (3.30)")#up *#ie(2," (PROC)")# + (PICFILE VAR pf, INT CONST step) + - Positioniert in 'pf' 'step'-Bilder zurck. + + 3.31 PROC #ib(2," (3.31)")#view *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL CONST alpha, phi, theta) + - Stellt fr die Abbildung von 'pf' zustzlich die Drehwinkel der + Abbildung in Polarkoordinaten ein. + In der derzeitigen Version fehlerhaft ! + + 3.32 PROC #ib(2," (3.32)")#view *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL CONST alpha, phi) + - s.o.; in der derzeitigen Version fehlerhaft ! + + 3.33 PROC #ib(2," (3.33)")#view *#ie(2," (PROC)")# + (REAL CONST alpha) + - Dreht das Bild um den Mittelpunkt der Zeichenflche um 'alpha' + Grad ! + + 3.34 PROC #ib(2," (3.34)")#viewport *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL CONST hor min, hor max, vert min, vert max) + - Spezifiziert die Zeichenflche, auf die 'pf' abgebildet werden soll. + Siehe dazu auch 'viewport' im 'transformation'-Paket (S. #topage("viewport")#). + + 3.35 PROC #ib(2," (3.35)")#window *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL CONST x min, x max, y min, y max, z min, z max) + - Definiert die virtuelle Zeichenflche von 'pf'. + + 3.36 PROC #ib(2," (3.36)")#window *#ie(2," (PROC)")# + (PICFILE VAR pf, REAL CONST x min, x max, y min, y max) + - s.o., jedoch fr zweidimensionale PICFILEs. + + 3.37 PROC #ib(2," (3.37)")#write picture *#ie(2," (PROC)")# + (PICFILE VAR pf, PICTURE CONST new) + - berschreibt das aktuelle Bild von 'pf' mit 'new'. +#page# + #ib(1)#4.0 Paket: 'devices'#ie(1)# + + 4.1 #ib(2," (4.1)")#TYPE PLOTTER#ie(2,"")# + - Verwaltungstyp zur Reprsentation eines Endgertes hinsichtlich + seiner Station, seines Kanals, seines Namens sowie seiner Zeichen- + flche. Dabei ist zu beachten, da der gltige Endgert- + Descriptor, der zur Selektion verwendet wird, aus Station, Kanal + und Namen besteht; die Namen also nicht eindeutig vergeben + werden mssen. + + 4.2 OP #ib(2," (4.2)")#:=#ie(2," (OP)")# + (PLOTTER VAR dest, PLOTTER CONST source) + - Zuweisungsoperator fr den Datentyp 'PLOTTER'. + + 4.3 BOOL OP #ib(2," (4.3)")#=#ie(2," (OP)")# + (PLOTTER CONST left, right) + - Vergleichsoperator fr den Datentyp 'PLOTTER'. + + 4.4 INT PROC #ib(2," (4.4)")#actual plotter#ie(2," (PROC)")# + - Liefert die interne Verwaltungsnummer des eingestellten End- + gertes (Kein Endgert eingestellt -> 0). + + 4.5 INT PROC #ib(2," (4.5)")#channel#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Liefert den Kanal von 'plotter'. + + 4.6 PROC #ib(2," (4.6)")#drawingarea#ie(2," (PROC)")# + (REAL VAR x cm, y cm, INT VAR x p, y p) + - Trgt in die bergebenen Variablen die Mae der + Zeichenflche des eingestellten Endgertes ein. + + 4.7 PROC #ib(2," (4.7)")#drawingarea#ie(2," (PROC)")# + (REAL VAR x cm, y cm, INT VAR x p, y p, PLOTTER CONST plotter) + - Trgt in die bergebenen Variablen die Mae der Zeichenflche + von 'plotter' ein. + + 4.8 PROC #ib(2," (4.8)")#install plotter#ie(2," (PROC)")# + (TARGET VAR new descriptors) + - bergibt dem Verwaltungspacket den zu verwaltenden Satz End- + gerte. Wird intern vom 'device interface' verwendet, kann aber + auch im nachhinein zur Installation von Endgerten anderer + Stationen oder zum Ausblenden von Endgerten dienen. Nachdem + die Graphik installiert wurde, knnen jedoch keine neuen sta- + tionseigenen Endgerte erzeugt werden (oder nur verwaltungs- + seitig, d.h. die Ansteuerung fehlt). + + 4.9 TEXT PROC #ib(2," (4.9)")#name#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Liefert den Namen von 'plotter' + + 4.10 PLOTTER PROC #ib(2," (4.10)")#no plotter#ie(2," (PROC)")# + - Liefert den Endgert-Descriptor 'kein Plotter'. + + 4.11 PLOTTER PROC #ib(2," (4.11)")#plotter#ie(2," (PROC)")# + - Liefert den Endgert-Descriptor des eingestellten Endgertes. + + 4.12 PLOTTER PROC #ib(2," (4.12)")#plotter#ie(2," (PROC)")# + (TEXT CONST descriptor) + - Liefert den Endgert-Descriptor des durch 'descriptor' beschrie- + benen Endgertes. + 'descriptor' hat folgendes Format: + //Endgertname, + wobei nicht vorhandene Endgerte abgelehnt werden. + + 4.13 TEXT PROC #ib(2," (4.13)")#plotterinfo#ie(2," (PROC)")# + (TEXT CONST descriptor, INT CONST length) + - Liefert einen auf die Lnge 'length' eingerichteten TEXT, der + 'descriptor' in aufbereiteter Form wiedergibt. + Format von 'descriptor' s.o. + + 4.14 THESAURUS PROC #ib(2," (4.14)")#plotters#ie(2," (PROC)")# + - Liefert alle vorhandenen Endgerte in Form o.g. Descriptoren. + + 4.15 PROC #ib(2," (4.15)")#select plotter#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Stellt 'plotter' als aktuelles Endgert ein. + + 4.16 PROC #ib(2," (4.16)")#select plotter#ie(2," (PROC)")# + (TEXT CONST descriptor) + - Stellt das durch 'descriptor' beschriebene Endgert als aktuelles + Endgert ein. + + 4.17 PROC #ib(2," (4.17)")#select plotter#ie(2," (PROC)")# + - Bietet eine Auswahl aller Endgerte an, und stellt das gewhlte + als aktuelles Endgert ein. + + 4.18 INT PROC #ib(2," (4.18)")#station#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Liefert die Stationsnummer von 'plotter' zurck. +#page# +#type("pica")##on("u")##ib(1)#Teil 2.1: Operationen des 'device interface'#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + + Das automatisch vom 'GRAPHIK.Configurator' anhand von Konfigurationsda- + teien erstellte Paket 'device interface' realisiert die normierte, jedoch von + der Zeichenflche des Endgerts abhngige Ansteuerung der verschiedenen + Endgerte. Es entspricht dabei dem Paket 'Endgert.Basis' der EUMEL-Graphik, + geht aber teilweise ber dessen Leistungen hinaus.Hinweis: Falls diese Lei- + stung nicht bereits endgertseitig implementiert ist, wird nicht geclipped; + die berschreitung der Zeichengrenzen hat also Undefiniertes zur Folge. + Zudem ist die Mehrheit der Prozeduren ausschlielich nach 'initplot' funk- + tionsfhig. + + #ib(1)#1.0 Paket: 'device interface'#ie(1)# + + 1.1 INT PROC #ib(2," (1.1)")#background#ie(2," (PROC)")# + - Liefert die Nummer der aktuell fr den Hintergrund eingestellten + Farbe zurck. + + 1.2 PROC #ib(2," (1.2)")#background#ie(2," (PROC)")# + (INT CONST color no) + - Stellt die Farbe 'color no' als Hintergrundfarbe ein. + + 1.3 PROC #ib(2," (1.3)")#box#ie(2," (PROC)")# + (INT CONST x1, y1, x2, y2, pattern) + - Zeichnet ein Rechteck mit den gegenberliegenden Ecken 'x1;y1' + und 'x2;y2', das mit dem Muster 'pattern' gefllt wird, wobei + 'pattern' endgertspezifisch ist. + + 1.4 PROC #ib(2," (1.4)")#circle#ie(2," (PROC)")# + (INT CONST x, y, rad, from, to) + - Zeichnet an der Stelle 'x;y' einen Kreis (bzw. Kreissegment) des + Radius 'rad' mit dem Anfangswinkel 'from' und dem Endwinkel 'to'. + + 1.5 PROC #ib(2," (1.5)")#clear#ie(2," (PROC)")# + - Initialisiert die Zeichenflche des aktuellen Endgertes, wobei + die Zeichenposition auf '0;0' und die Standardfarben + gesetzt werden. + + 1.6 PROC #ib(2," (1.6)")#clear#ie(2," (PROC)")# + (BOOL CONST onoff) + - Die bergabe von FALSE bewirkt, da alle nachfolgenden Aufrufe + von 'clear' wirkungslos sind; mit TRUE werden sie entsprechend + wieder aktiviert. + + 1.7 INT PROC #ib(2," (1.7)")#color#ie(2," (PROC)")# + (INT CONST color no) + - Liefert den fr die Farbe 'color no' eingestellten Farbwert im + normierten RGB-Code von 0-999. + + 1.8 INT PROC #ib(2," (1.8)")#colors#ie(2," (PROC)")# + - Liefert die Anzahl mglicher Farben fr das aktuelle Endgert. + + 1.9 PROC #ib(2," (1.9)")#draw to#ie(2," (PROC)")# + (INT CONST x, y) + - Zieht von der aktuellen Zeichenposition eine Gerade zur Position + 'x;y'. + + 1.10 PROC #ib(2," (1.10)")#endplot#ie(2," (PROC)")# + - Wartet auf eine Eingabe des Benutzers und beendet dann die + graphische Ausgabe; ggf. durch Umschalten in den Text-Modus. + Falls mglich, sollte die ausgegebene Graphik jedoch auf dem + Bildschirm erhalten bleiben. + + 1.11 PROC #ib(2," (1.11)")#end plot#ie(2," (PROC)")# + (BOOL CONST onoff) + - Die bergabe von FALSE bewirkt, da alle nachfolgenden Aufrufe + von 'endplot' wirkungslos sind; mit TRUE werden sie entsprechend + wieder aktiviert. + + 1.12 PROC #ib(2," (1.12)")#fill#ie(2," (PROC)")# + (INT CONST x, y, INT CONST pattern) + - Die Umgebung von 'x;y' wird mit dem Muster 'pattern' gefllt, wobei + sowohl 'pattern' als auch die genauen Fll-Bedingungen (Art der + Umrahmung usw.) endgertspezifisch sind. + + 1.13 INT PROC #ib(2," (1.13)")#foreground#ie(2," (PROC)")# + - Liefert die Nummer der aktuell fr den Vordergrund eingestellten + Farbe zurck. + + 1.14 PROC #ib(2," (1.14)")#foreground#ie(2," (PROC)")# + (INT CONST color no) + - Stellt die Farbe 'color no' als Vordergrundfarbe ein. + + 1.15 PROC #ib(2," (1.15)")#get cursor#ie(2," (PROC)")# + (INT VAR x, y, TEXT VAR exit char) + - Nach Aufruf dieser Prozedur sollte das Endgert die Eingabe + einer Position mittels eines graphischen Cursors (i.d.R. + Fadenkreuz) ermglichen. Dieser Modus soll bleibt solange auf- + rechterhalten bis eine Taste gedrckt wird; in 'x;y' findet sich + dann die Position des Cursors, und in 'exit char' die gedrckte + Taste. + Diese Prozedur ist jedoch nicht fr das Ein bzw. Ausschalten des + graphischen Cursors zustndig, d.h der eingeschaltete Cursor ist + stndig sichtbar; bei ausgeschaltetem Cursor kehrt die Prozedur + sofort mit 'exit char' = ""0"" zurck. + + 1.16 BOOL PROC #ib(2," (1.16)")#graphik cursor#ie(2," (PROC)")# + - Diese Prozedur gibt an, ob graphische Eingabeoperationen und + die dazugehrigen Operationen auf dem aktuellen Endgert ver- + fgbar sind. + + 1.17 PROC #ib(2," (1.17)")#graphik cursor#ie(2," (PROC)")# + (INT CONST x, y, BOOL CONST onoff) + - Diese Prozedur schaltet den graphischen Cursor an bzw. aus oder + positioniert ihn. Nach dem Einschalten sollte der Cursor perma- + nent sichtbar sein. Ein erneutes Einschalten hat die + Neupositionierung des Cursors zur Folge. + + 1.18 PROC #ib(2," (1.18)")#home#ie(2," (PROC)")# + - Positioniert die aktuelle Zeichenposition auf den Punkt '0;0'; bei + eingeschaltetem graphischen Cursor diesen auf die Mitte der + Zeichenflche. + + 1.19 PROC #ib(2," (1.19)")#init plot#ie(2," (PROC)")# + - Initialisiert das aktuelle Endgert zur graphischen Ausgabe, + (schaltet ggf. in den Graphik-Modus), wobei der Bildschirm jedoch + mglichst nicht gelscht werden sollte. + + 1.20 PROC #ib(2," (1.20)")#move to#ie(2," (PROC)")# + (INT CONST xp, yp) + - Die Position 'xp;yp' wird neue Stiftposition; die Wirkung ist unde- + finiert bei berschreitung der Bildschrimgrenzen. + + 1.21 PROC #ib(2," (1.21)")#prepare#ie(2," (PROC)")# + - Bereitet die Ausgabe auf einem Endgert vor; d.h. die Task wird an + den entsprechenden Kanal angekoppelt, und andere Tasks am An- + koppeln gehindert (z.B. 'stop' des PRINTER-Servers). Dabei wird die + Prozedur erst dann verlassen, wenn die Aktion erfolgreich been- + det ist. (z.B. bis zur Freigabe des Kanals). + + + 1.22 PROC #ib(2," (1.22)")#set color#ie(2," (PROC)")# + (INT CONST no, rgb) + - Setzt die Farbe von 'no' auf die normierte RGB-Farbkombination + 'rgb' (0 - 999). + + 1.23 PROC #ib(2," (1.23)")#setmarker#ie(2," (PROC)")# + (INT CONST xp, yp, type) + - Zeichnet an der Position 'xp;yp' eine Markierung; wobei die Wir- + kung bei berschreitung der Bildschirmgrenzen undefiniert ist. + Als 'type' sollten vorhanden sein: + 0 - Kreuz '+' + 1 - Kreuz diagonal 'x' + - weitere beliebig + + 1.24 PROC #ib(2," (1.24)")#setpalette#ie(2," (PROC)")# + - Initialisiert die Farben des Endgertes gem den im Paket ge- + setzten Farben. + + 1.25 PROC #ib(2," (1.25)")#setpixel#ie(2," (PROC)")# + (INT CONST xp, yp) + - Setzt das Pixel 'xp;yp' in der aktuellen Schreibfarbe. + + 1.26 PROC #ib(2," (1.26)")#stdcolors#ie(2," (PROC)")# + - Initialisiert die Paket-Intern verwendete Farbtabelle auf die + standardmig fr das Endgert definierten Farben; + wobei die Farben jedoch nicht auf dem Endgert eingestellt + werden. + + 1.27 PROC #ib(2," (1.27)")#stdcolors#ie(2," (PROC)")# + (BOOL CONST onoff) + - Die bergabe von FALSE bewirkt, da alle nachfolgenden Aufrufe + von 'stdcolors' wirkungslos sind; mit TRUE werden sie entspre- + chend wieder aktiviert. +#page# +#type("pica")##on("u")##ib(1)#Teil 2.2: Operationen zur Graphik-Ausgabe#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + Die Pakete zur Ausgabe von Graphiken (PICFILES) sind in der Datei + 'GRAPHIK.Basis' enthalten, und realisieren folgende Leistungen: + - Im Datentyp PICTURE bzw. PICFILE in Codierter Form verwendete Ausgabe- + prozeduren auf einzelne Objekte unter Bercksichtigung der Abbil- + dungsparameter und Zeichenflche. + - Kommunikations- und Kontrolloperationen auf die Task 'PLOT' zur + indirekten Ausgabe von PICFILES. + - Ausgabeoperationen auf den Datentyp PICTURE bzw. PICFILE unter Be- + rcksichtung des eingestellten Endgertes. + Wird fr die Angabe von Koordinaten der Typ REAL verwendet, so handelt es + sich um virtuelle Koordinaten, d.h. die Ausgabe-Parameter wie 'viewport' und + 'window' werden bercksichtigt; bei Verwendung von INT ist die Ausgabe end- + gertspezifisch. + + #ib(1)#2.0 Paket: 'basisplot'#ie(1)# + + 2.1 PROC #ib(2," (2.1)")#bar *#ie(2," (PROC)")# + (INT CONST x, y, height, width, pattern) + - Zeichnet an der Position 'x;y' ein Rechteck der Lnge/Breite + 'width/height' mit dem Muster 'pattern', wobei 'x;y' die untere linke + Ecke des Rechtecks angibt. + Als 'pattern' z.Zt. implementiert: + 0 - nicht gefllt + 1 - halb gefllt + 2 - gefllt + 3 - horizontal schraffiert + 4 - vertikal schraffiert + 5 - horizontal und vertikal schraffiert + 6 - diagonal rechts schraffiert + 7 - diagonal links schraffiert + 8 - diagonal rechts und links schraffiert + + 2.2 PROC #ib(2," (2.2)")#bar *#ie(2," (PROC)")# + (REAL CONST height, width, INT CONST pattern) + - siehe oben, jedoch mit Ausgangspunkt an der aktuellen Zeichen- + position, wobei zu beachten ist, da die x-Koordinate die horizon- + tale Position der vertikalen Symmetrieachse des Rechtecks angibt. + + 2.3 PROC #ib(2," (2.3)")#beginplot#ie(2," (PROC)")# + - Leitet die graphische Ausgabe ein, wobei das Endgert in seinen + Startzustand versetzt wird, und dem Transformationspaket die + Abmessungen der Zeichenflche mitgeteilt werden. + + 2.4 PROC #ib(2," (2.4)")#box *#ie(2," (PROC)")# + - Zeichnet eine Umrahmung der gesamten Zeichenflche (Nicht nur + des verwendeten Teiles). + + 2.5 PROC #ib(2," (2.5)")#circle *#ie(2," (PROC)")# + (REAL CONST rad, from, to, INT CONST pattern) + - Zeichnet an aktuellen Position einen Kreis od. ein Kreissegment + des Radius 'rad'; beginnend bei 'from' bis zum Endwinkel 'to' und + gefllt mit dem Muster 'pattern' ('pattern' z.Zt. nicht + implementiert). + + 2.6 PROC #ib(2," (2.6)")#draw *#ie(2," (PROC)")# + (INT CONST x, y) + - Zeichnet von der aktuellen Position eine Gerade zur Position 'x;y'. + + 2.7 PROC #ib(2," (2.7)")#draw *#ie(2," (PROC)")# + (INT CONST x0, y0, x1, y1) + - Zieht eine Gerade von der Position 'x0;y0' bis zur Position 'x1;y1'. + + 2.8 PROC #ib(2," (2.8)")#draw *#ie(2," (PROC)")# + (REAL CONST x, y, z) + - Zieht von der aktuellen Zeichenposition eine Gerade zur + (transformierten) 3-D Position 'x;y;z'. + + 2.9 PROC #ib(2," (2.9)")#draw *#ie(2," (PROC)")# + (REAL CONST x, y) + - s.o., jedoch fr zweidimensionale Bilder. + + 2.10 PROC #ib(2," (2.10)")#draw *#ie(2," (PROC)")# + (TEXT CONST text, REAL CONST angle, height, width) + - Zeichnet den TEXT 'text' ab der aktuellen Zeichenposition unter + dem Winkel 'angle' und in der Hhe/Breite 'height;width'. + + 2.11 PROC #ib(2," (2.11)")#draw *#ie(2," (PROC)")# + - s.o., jedoch in Standard-Ausrichtung (0 Grad) und + Standard-Hhe/Breite (0.5/0.5). + + 2.12 PROC #ib(2," (2.12)")#draw cm *#ie(2," (PROC)")# + (REAL CONST x cm, y cm) + - Zeichnet von der aktuellen Position eine Gerade zur cm-Position + 'x cm;y cm'. + + 2.13 PROC #ib(2," (2.13)")#draw cm r *#ie(2," (PROC)")# + (REAL CONST x cm, REAL CONST y cm) + - Zieht von der aktuellen Zeichenposition eine Gerade zur um 'x cm; + y cm' verschobenen Zielposition. + + 2.14 PROC #ib(2," (2.14)")#draw r *#ie(2," (PROC)")# + (REAL CONST dx, dy) + - Zieht von der aktuellen Zeichenposition eine Gerade zur um 'dx;dy' + Einheiten verschobenen Zielposition. + + 2.15 PROC #ib(2," (2.15)")#draw r *#ie(2," (PROC)")# + (REAL CONST dx, dy, dz) + - Zeichnet von der aktuellen Zeichenposition eine Gerade zur um + 'dx;dy;dz' Einheiten verschobenen und transformierten 3-D Ziel- + position. + + 2.16 PROC #ib(2," (2.16)")#hidden lines *#ie(2," (PROC)")# + (BOOL CONST visible) + - Schaltet die vektorisierte Speicherung aller zuknftigen Aus- + gabe ein (FALSE) bzw. aus.Ist dieser Modus eingeschaltet, so werden + alle durch vorheriges Zeichnen entstandenen Flchen beim Zeichen + bercksichtigt, also nicht bermalt; sie 'verdecken' die weiteren + Linien. + + 2.17 PROC #ib(2," (2.17)")#linetype#ie(2," (PROC)")# + (INT CONST line no, TEXT CONST bitpattern) + - Stellt fr den Linientyp 'line no' das Bitmuster 'bitpattern' ein; + wobei der 'bitpattern'-TEXT ausschlielich aus den Zeichen '0' und + '1' bestehen sollte. + + 2.18 PROC #ib(2," (2.18)")#move *#ie(2," (PROC)")# + (INT CONST x,y) + - Zeichnet von der aktuellen Position eine Gerade zur Position 'x;y'. + + 2.19 PROC #ib(2," (2.19)")#move *#ie(2," (PROC)")# + (REAL CONST x, y, z) + - Zeichnet von der aktuellen Position eine Gerade zur trans- + formierten 3-D-Position 'x;y;z' + + 2.20 PROC #ib(2," (2.20)")#move *#ie(2," (PROC)")# + (REAL CONST x, y) + - s.o., jedoch fr zweidimensionale Bilder. + + 2.21 PROC #ib(2," (2.21)")#move cm#ie(2," (PROC)")# + (REAL CONST x cm, y cm) + - Setzt die aktuelle Zeichenposition auf die cm-Position 'x cm,;y cm'. + + 2.22 PROC #ib(2," (2.22)")#move cm r *#ie(2," (PROC)")# + (REAL CONST d x cm, d y cm) + - Zeichnet von der aktuellen Position eine Gerade zur um + 'd x cm;d y cm' verschobenen Zielposition. + + 2.23 PROC #ib(2," (2.23)")#move r *#ie(2," (PROC)")# + (REAL CONST d x, d y, d z) + - Zeichnet von der aktuellen Position eine Gerade zur um 'd x;d y;d z' + Einheiten verschobenen und transformierten Zielposition. + + 2.24 PROC #ib(2," (2.24)")#move r *#ie(2," (PROC)")# + (REAL CONST d x, d y) + - s.o., jedoch fr zweidimensionale Bilder. + + 2.25 PROC #ib(2," (2.25)")#pen *#ie(2," (PROC)")# + (INT CONST background, foreground, thickness, linetype) + - Aktiviert fr alle folgenden Ausgaben mit virtuellen Koordi- + naten den Hintergrund 'background'; die Schreibfarbe + 'foreground'; die Zeichenstrke 'thickness' in 1/10 mm und den + Linientyp 'linetype' (i.d.R. 1-6). Vergleiche 'select pen'. + + 2.26 PROC #ib(2," (2.26)")#reset *#ie(2," (PROC)")# + - Die mit 'hidden lines (FALSE)' vektorisiert abgespeicherte + Ausgabe wird gelscht. + + 2.27 PROC #ib(2," (2.27)")#reset linetypes *#ie(2," (PROC)")# + - Setzt die Linientypen 1-6 auf Standard-Linientypen: 1 - durch- + gngige Linie + 2 - gepunktete Linie + 3 - kurz gestrichelte Linie + 4 - lang gestrichelte Linie + 5 - Strichpunktlinie + + 2.28 PROC #ib(2," (2.28)")#reset zeichensatz *#ie(2," (PROC)")# + - Setzt den Zeichensatz auf den Standard-Zeichensatz 'ZEICHENSATZ'. + + 2.29 PROC #ib(2," (2.29)")#where *#ie(2," (PROC)")# + (REAL VAR x, y, z) + - Trgt die aktuelle Zeichenposition als (retransformierte) 3-D + Position in die bergeben Variablen ein. + + 2.30 PROC #ib(2," (2.30)")#where *#ie(2," (PROC)")# + (REAL VAR x, y) + - s.o., jedoch fr zweidimensionale Bilder. + + 2.31 PROC #ib(2," (2.31)")#zeichensatz *#ie(2," (PROC)")# + (TEXT CONST zeichenname) + - Ldt den Zeichensatz 'zeichenname' zur Verwendung bei Beschrif- + tungen. +#page# + #ib(1)#3.0 Paket: 'plot interface'#ie(1)# + + 3.1 THESAURUS OP #ib(2," (3.1)")#ALL#ie(2," (OP)")# + (PLOTTER CONST plotter) + - Liefert die Namen der z.Zt. im Spool 'plotter' zur indirekten + Graphik-Ausgabe gespoolten task-eigenen PICFILES. + Bei Aufruf aus 'GRAPHIK' werden die Namen aller zur Ausgabe + gespoolten PICFILES geliefert. + + 3.2 PROC #ib(2," (3.2)")#erase#ie(2," (PROC)")# + (TEXT CONST picname, PLOTTER CONST plotter) + - Lscht nach Rckfrage das im Spool 'plotter' zur indirekten + Graphik-Ausgabe gespoolte task-eigene PICFILE 'picname'. + Bei Aufruf aus 'GRAPHIK' ist auch das Lschen fremder zur Ausgabe + gespoolter PICFILES mglich. + + 3.3 PROC #ib(2," (3.3)")#erase#ie(2," (PROC)")# + (THESAURUS CONST piclist, PLOTTER CONST plotter) + - Lscht im Dialog alle in 'piclist' und im Spool 'plotter' zur in- + direkten Graphik-Ausgabe gespoolten task-eigenen PICFILES. + Bei Aufruf aus 'GRAPHIK' ist auch das Lschen fremder zur Ausgabe + gespoolter PICFILES mglich. + + 3.4 BOOL PROC #ib(2," (3.4)")#exists#ie(2," (PROC)")# + (TEXT CONST picname, PLOTTER CONST plotter) + - Liefert zurck, ob z.Zt. im Spool 'plotter' ein task-eigenes PICFILE + 'picname' zur indirekten Graphik-Ausgabe gespoolt wird. + Bei Aufruf aus 'GRAPHIK' kann auch die Existenz fremder zur Aus- + gabe gespoolter PICFILES erfragt werden. + + 3.5 PROC #ib(2," (3.5)")#first#ie(2," (PROC)")# + (TEXT CONST picname, PLOTTER CONST plotter) + - Zieht das im Spool 'plotter' zur indirekten Ausgabe gespoolte + PICFILE 'picname' an die erste Stelle der Warteschlange. Der Auf- + ruf ist nur aus 'GRAPHIK' zulssig. + + 3.6 PROC #ib(2," (3.6)")#generate plotmanager#ie(2," (PROC)")# + - Erzeugt die Task 'PLOT', in der dann im Hintergrund der Plot- + manager insertiert wird. Dabei darf 'PLOT' zuvor nicht existieren, + und in der Task mu die Datei 'GRAPHIK.Manager' vorhanden sein. + + 3.7 PROC #ib(2," (3.7)")#halt#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Unterbindet die weitere indirekte Graphik-Ausgabe aus dem Spool + 'plotter'; eine aktuell laufende Ausgabe wird jedoch nicht ab- + gebrochen. Der Aufruf ist nur aus 'GRAPHIK' zulssig. + + 3.8 PROC #ib(2," (3.8)")#list#ie(2," (PROC)")# + (FILE VAR list file, PLOTTER CONST plotter) + - Erzeugt in 'list file' eine Inhalts/Aktivittsbersicht des Spools + 'plotter'. + + 3.9 PROC #ib(2," (3.9)")#list#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Zeigt eine Inhalts/Aktivittsbersicht des Spools 'plotter'. + + 3.10 THESAURUS PROC #ib(2," (3.10)")#picfiles#ie(2," (PROC)")# + - Liefert eine Liste der Namen aller in der Task enthaltenen + PICFILES. + + 3.11 PROC #ib(2," (3.11)")#save#ie(2," (PROC)")# + (TEXT CONST picname, PLOTTER CONST plotter) + - Sendet das PICFILE 'picname' zwecks indirekter Graphik-Ausgabe + zum Spool 'plotter'. + + 3.12 PROC #ib(2," (3.12)")#save#ie(2," (PROC)")# + (THESAURUS CONST piclist, PLOTTER CONST plotter) + - Sendet alle in 'piclist' namentlich enthaltenen PICFILES zwecks + indirekter Graphik-Ausgabe zum Spool 'plotter'. + + 3.13 PROC #ib(2," (3.13)")#start#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Nimmt die zuvor mit 'halt','wait for halt','stop' oder spoolseitig + unterbrochene indirekte Graphik-Ausgabe des Spools 'plotter' + wieder auf. Der Aufruf ist nur aus 'GRAPHIK' zulssig. + + 3.14 PROC #ib(2," (3.14)")#stop#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Unterbricht sofort die aktuell laufende Ausgabe des Spools + 'plotter', und unterbindet weitere Ausgaben. Nach Rckfrage wird + das PICFILE, das aktuell ausgegeben wurde, erneut an erster + Steller der Warteschlange eingetragen. + + 3.15 PROC #ib(2," (3.15)")#wait for halt#ie(2," (PROC)")# + (PLOTTER CONST plotter) + - Unterbindet die weitere Ausgabe der + gespoolten PICFILES, und wartet bis die aktuell laufende Ausgabe + beendet ist. +#page# + #ib(1)#4.0 Paket: 'plot'#ie(1)# + + 4.1 PROC #ib(2," (4.1)")#plot *#ie(2," (PROC)")# + (PICTURE CONST picture) + - Ausgabe der Objektebene 'picture', unter Verwendung des in + 'picture' angegebenen Stiftes gem seiner aktuellen Einstellung + im 'basisplot'.Nur fr Direkt-Ausgaben verwendbar. + + 4.2 PROC #ib(2," (4.2)")#plot *#ie(2," (PROC)")# + (PICFILE CONST pf) + - Ausgabe des Bildes 'pf' unter vollstndiger Bercksichtung der in + 'pf' mit 'select pen';'window';'viewport' usw. eingestellten + Ausgabeparameter. Nur fr Direkt-Ausgaben verwendbar. + + 4.3 PROC #ib(2," (4.3)")#plot *#ie(2," (PROC)")# + (TEXT CONST picfile name) + - Direkte oder indirekte Ausgabe des Bildes 'picfile name'. + Bei direkter Ausgabe wird obiges 'plot' verwendet; bei indirekter + Ausgabe wird das PICFILE an den aktuell eingestellten Spool zur + graphischen Ausgabe gesendet. +#page# +#bottom# +#right#Seite % +#end# +#head# +#type("prop")##center#Dokumentation des MPG-Graphik-Systems +#type("8.5.klein")##center#Teil 3: Konfigurierung der Graphik +#type("pica.lq")##free(1.0)# +#end# +#type("pica")##on("u")##ib(1)#Teil 3: Konfigurierung der Graphik#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + +#type("pica")##on("u")##ib(1)#Teil 3.1: Der Graphik-Konfigurator#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# +#goalpage("newconf")# + Die MPG-EUMEL-Graphik besitzt eine normierte Schnittstelle zu allen graphischen + Endgerten. Diese wird vom Programm 'GRAPHIK.Configurator' aus verschiede- + nen Dateien, die einer gewissen Syntax zu gengen haben, zu einem Paket + namens 'device interface' zusammengefgt. Diese Dateien enthalten verschie- + dene Informationen und endgertspezifische ELAN-Prozeduren, die zur + Erzeugung graphischer Primitiva wie Gerade, Kreis, Rechteck und zur Be- + rechnung der konkreten Abbildung graphischer Objekte sowie zur Realisa- + tion von Eingaben bentigt werden. Das Konfigurationsprogramm erkennt + diese Dateien an der Namensendung '.GCONF', und bietet diese zu + Programmbeginn zur Auswahl an. + Dann werden die gewhlten Dateien inhaltlich untersucht und die relevan- + ten Informationen, Rmpfe der bentigten Prozeduren sowie alle vom Benut- + zer zustzlich eingetragenen globalen Objekte (globale Variablen, + LET-Objekte, zustzlich bentigte Prozeduren usw.) vom Programm extrahiert + und zwischengespeichert. + Im letzten Schritt erstellt das Programm schlielich das Paket 'device + interface' in der Datei 'GRAPHIK.Configuration', indem die zwischengespei- + cherten Texte sinnvoll zusammengefgt werden. + Die bentigten Konfigurationsdateien sind relativ einfach zu erstellen, da + sich der Programmierer ausschlielich mit der Realisation der geforderten + Leistungen auf einem Endgert-Typ befassen kann, da die programmseitige + Einbindung ins Graphiksystem vom Konfigurationsprogramm vorgenommen + wird. +#page# +#type("pica")##on("u")##ib(1)#Teil 3.2: Erstellung der Konfigurationsdateien#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + Namensgebung: ".GCONF" + Konfigurationsdateien zur Anbindung eines Endgert-Types auf der + eigenen Station enthalten die bentigten ELAN-Quelltexte zur Realisa- + tion der geforderten Leistungen und weitere Verwaltungs- und Berech- + nungsoperationen. + Das Konfigurationsprogramm erkennt die relevanten Daten bzw. Quelltexte + dieser Dateien an verschiedenen Pseudo-Schlsselworten bzw. Pseudo- + Prozedurdeklarationen, wobei die Namensgebung hinsichtlich des Pro- + zedurnamens, der Parameter sowie ihrer Namen vollstndig festgelegt ist. + Daher ist es unzulssig, Parameternamen zu ndern oder Delimiter + (Semikolon, Doppelpunkt) fortzulassen. + Derartige Fehler werden jedoch i.d.R. vom Konfigurationsprogramm + erkannt und gemeldet, wohingegen Fehler in den Prozedurrmpfen, den + zustzlichen Prozeduren bzw. das Fehlen zustzlich bentigter Pro- + zeduren nicht erkannt, sondern erst beim Compilieren des Gesamt-Paketes + vom ELAN-Compiler gemeldet werden. + (Die Korrektur im Gesamt-Paket sollte unterlassen werden, vielmehr ist + der Fehler in der entsprechenden Konfigurationsdatei zu beheben, falls + nicht einfach die Einbindung eines zustzlichen Paketes vergessen + wurde.) + Zudem ist zu beachten, da die bentigten Prozedurrmpfe vom Kon- + figurationsprogramm in Refinements umgewandelt werden, und zustz- + liche Objekte (Prozeduren, LET-Objekte, Variablen) einfach mit ein- + gebunden werden, so da: + - Globale und lokale Variablen eindeutig fr alle! Konfigurations- + dateien benannt werden mssen. + (Zweckmssig: ... VAR endgertname variablenname) + - Zustzliche Prozeduren und LET-Objekte ebenso eindeutig benannt + werden mssen. + - berflssige Delimiter, die aber vom ELAN-Compiler nicht bemngelt + werden (z.B. Punkt am Ende des Prozedurrumpfes) nicht vorkommen + drfen. + - Nicht realisierbare Pseudo-Prozeduren mit leerem Rumpf enthalten + sein mssen (z.B. Vordergrund/Hintergrund od. Farben bei + Monochrom-Endgerten) + - Prozedur-Kpfe bzw. -Enden allein in einer Zeile und an ihrem Anfang + stehen mssen. + + Namensgebung: "ENVIRONMENT.GCONF" + Dient zur verwaltungsseitigen Einbindung von Endgerten anderer + Stationen, da fr diese Endgerte nur die Verwaltungsinformationen + bentigt werden, weil die konkrete Anpassung auf der anderen Station + erfolgt. + Die in 'ENVIRONMENT.GCONF' zeilenweise enthaltenen Informationen werden + dem Benutzer bei der Auswahl der Konfigurationsdateien mit angeboten; er + kann sie aber auch 'von Hand' in die THESAURUS-Auswahl einfgen. + + Namensgebung: "Dateizweck" (also beliebig) + Darberhinaus existieren weitere Dateien, die globale Prozeduren und + weitere Objekte enthalten, die fr verschiedene Endgert-Anpassungen + ntzlich sein knnen, wie z.B. unten beschriebene Dateien: + - 'std primitives' + Enthlt Prozeduren zur softwareseitigen Emulation von zwar gefor- + derten, hardwareseitig aber eventuell nicht bereitgestellten + Leistungen wie 'circle' und 'box'. + - 'matrix printer' + Enthlt Prozeduren zur Erzeugung von Geraden und Fllmustern auf + einer Bitmatrix, die zur graphischen Ausgabe auf Druckern bentigt + wird. + - 'terminal plot' + Enthlt grundlegende Prozeduren zur (behelfsmigen) Ausgabe von + Graphiken auf Ascii-Terminals (Zeichenorientiert, nicht graphikfhig) + + Folgende Pseudo-Schlsselworte bzw. Pseudo-Prozeduren werden vom + Konfigurationsprogramm erkannt und behandelt: + + #ib(1)#1.0 Pseudo-Schlsselworte#ie(1)# + + 1.1 #ib(2," (1.1)")#COLORS#ie(2,"")# + Syntax: COLORS "RGB-Kombinationen"; + - Dient der Definition der Standard-Farben. + - "RGB-Kombinationen": (TEXT) Pro Farbe 3-ziffrige RGB- + (Rot-Grn-Blau)- + Kombinationen in normierter + Notation + (jeder Farbanteil wird durch + die Ziffern 0-9 dargestellt; + sollte das Endgert dieser + Notation nicht gengen, so ist + eine anteilige Umrechnung + vorzunehmen). + Die erste RGB-Kombination + wird fr die Hintergrundfarbe + verwendet (i.d.R. 000), bei + monochromen Endgerten ist + also "000999" einzusetzen. + + 1.2 #ib(2," (1.2)")#EDITOR#ie(2,"")# + Syntax: EDITOR; + - Schlsselwort, das dem Konfigurationsprogramm anzeigt, da + folgende Eingabeprozeduren vorhanden sind: + - 'graphik cursor' + - 'get cursor' + - 'set marker' + Fehlt das Schlsselwort, so knnen o.g. Pseudo-Prozeduren weg- + gelasssen werden, brauchen also nicht mit leerer Leistung + implementiert werden. + + 1.3 #ib(2," (1.3)")#INCLUDE#ie(2,"")# + Syntax: INCLUDE "Name der Includedatei"; + - Schlsselwort, mit dem weitere Dateien in die Konfigurationsdatei + textuell eingebunden werden knnen (s.o). + + 1.4 #ib(2," (1.4)")#LINK#ie(2,"")# + Syntax: LINK /, .... ; + - Dient zur Anbindung mehrerer Endgerte an einen Endgert-Typ, + die hier genannten Kanle werden eigenstndig verwaltet, aber + wie das bei 'PLOTTER' definierte Endgert angesteuert; wobei fr + alle Endgerte der gleiche Name gilt, sie also durch die Kanal- + nummer unterschieden werden. + Durch Kommata getrennt, knnen mit dieser Anweisung beliebig + viele Endgerte zustzlich angebunden werden. + - : (INT) Stationsnummer des Endgertes + (eigene Station) + - : (INT) Kanalnummer des Endgertes + + 1.5 #ib(2," (1.5)")#PLOTTER#ie(2,"")# + Syntax: PLOTTER "Endgertname",,, + ,,,; + - Dient zur Erkennung als Endgert-Konfigurationsdatei, und zur + bergabe der verwaltungsseitig bentigten + Endgert-Spezifikationen: + - "Endgertname": (TEXT) Name des Endgertes + - : (INT) Stationsnummer des Endgertes + (eigene Station) + - : (INT) Kanalnummer des Endgertes + Jedes Endgert wird ber diese drei Werte eindeutig identifiziert, + der Endgertname kann also mehrfach verwendet werden. + - : (INT) X-Rasterkoordinate des letzten + Pixels in X-Richtung (i.d.R + adressierbare Pixel - 1) + - : (INT) Y-Rasterkoordinate des letzten + Pixels in Y-Richtung (s.o.) + - : (REAL) Breite der Zeichenflche in cm. + - : (REAL) Hhe der Zeiuchenflche in cm. + (Mglichst genau ausmessen od. berechnen, um Verzerrungen zu + vermeiden) + 'PLOTTER' mu als erstes in der Konfigurationsdatei stehen! + + #ib(1)#2.0 Pseudo-Prozeduren#ie(1)# + + 2.1 PROC #ib(2," (2.1)")#background#ie(2," (PROC)")# + Syntax: PROC background (INT VAR type): + - Stellt die Hintergrundfarbe 'type' ein. Ist bei monochromen End- + gerten mit leerer Leistung zu implementieren.In 'type' ist die + tatschlich eingestellte Hintergrundfarbe angegeben, womit die + erbrachte Leistung kontrolliert werden kann. + + 2.2 PROC #ib(2," (2.2)")#box#ie(2," (PROC)")# + Syntax: PROC box (INT CONST x1, y1, x2, y2, pattern): + - Zeichnet ein Rechteck mit den gegenberliegenden Ecken + 'x1;y1/x2;y2'. Sollte das Endgert diese Leistung nicht erbringen, + so mu 'std box' aus 'std.GCONF' mit gleichen Parametern aufge- + rufen werden. + 'pattern' als Fllmuster kann endgertspezifisch implementiert + werden, wobei von System nur 'pattern' = 0 verwendet wird, was ein + ungeflltes Rechteck anfordert. + + 2.3 PROC #ib(2," (2.3)")#circle#ie(2," (PROC)")# + Syntax: PROC circle (INT CONST x, y, rad, from, to): + - Zeichnet einen Kreis oder ein Kreissegment an den Raster- + Koordinaten 'x;y', die auch neue Zeichenposition werden. 'rad' gibt + den Radius und 'from,to' den Start bzw. Endwinkel im mathematisch + positivem Sinne an. + Sollte das Endgert diese Leistung nicht erbringen, so mu 'std + circle' aus 'std.GCONF' mit gleichen Parametern aufgerufen werden. + + 2.4 PROC #ib(2," (2.4)")#clear#ie(2," (PROC)")# + Syntax: PROC clear: + - Lscht den Bildschirm bzw. initialisiert das Ausgabe-Raster. + Die Zeichenposition wird '0;0' und die Standardfarben werden + eingestellt. + + 2.5 PROC #ib(2," (2.5)")#drawto#ie(2," (PROC)")# + Syntax: PROC drawto (INT CONST x, y): + - Zieht von der aktuellen Zeichenposition eine Gerade zu den Ko- + ordinaten 'x;y', die Zeichenposition wird entsprechend gendert. + + 2.6 PROC #ib(2," (2.6)")#endplot#ie(2," (PROC)")# + Syntax: PROC endplot: + - Schliet die Graphik-Ausgabe auf einem Endgert ab; evtl. Wechsel + in den Text-Modus, ggf. Cursor einschalten. + Bei Terminals sollte der Bildschirm nicht gelscht werden. + + 2.7 PROC #ib(2," (2.7)")#fill#ie(2," (PROC)")# + Syntax: PROC fill (INT CONST x, y, pattern): + - Zustzliche vom System nicht verwendete Leistung zum Fllen von + Polygonen (rundum geschlossen), wobei die genau erbrachte Lei- + stung und die Bedingungen endgertspezifisch sind. + + 2.8 PROC #ib(2," (2.8)")#foreground#ie(2," (PROC)")# + Syntax: PROC foreground (INT VAR type): + - Stellt die Vordergrundfarbe 'type' ein. Ist bei monochromen + Endgerten mit leerer Leistung zu implementieren.In 'type' ist die + tatschlich eingestellte Hintergrundfarbe angegeben, womit die + erbrachte Leistung kontrolliert werden kann. + + 2.9 PROC #ib(2," (2.9)")#get cursor#ie(2," (PROC)")# + Syntax: PROC get cursor (INT VAR x, y, TEXT VAR exit char): + - Wartet auf eine Eingabe vom Endgert, wobei der Cursor beweglich + bleiben mu. Wird eine Taste gedrckt, so wird deren Code in 'exit + char' und die aktuelle Position des Cursors in 'x;y' eingetragen. + Der Cursor sollte nur innerhalb dieser Prozedur beweglich sein, + aber immer sichtbar bleiben (falls er eingeschaltet ist). + + 2.10 PROC #ib(2," (2.10)")#graphik cursor#ie(2," (PROC)")# + Syntax: PROC graphik cursor (INT CONST x, y, BOOL CONST on): + - Schaltet einen endgertseitig vorhandenen graphischen Cursor + (i.d.R Fadenkreuz) ein oder aus bzw. setzt ihn auf eine bestimmte + Position. + Mit 'on' = TRUE wird der Cursor dauerhaft! eingeschaltet bzw. neu + positioniert, falls er bereits eingeschaltet war. + Mit 'on' = FALSE wird er grundstzlich abgeschaltet. + Durch Einschalten des Cursors wird die Wirkung von 'home' + verndert: + normal - 'home' positioniert die Zeichenposition auf + '0;0' + cursor - 'home' positioniert die Zeichenposition und + den graphischen Cursor auf die Mitte der + Zeichenflche. + + 2.11 PROC #ib(2," (2.11)")#home#ie(2," (PROC)")# + Syntax: PROC home: + - Die Zeichenposition wird auf '0;0' eingestellt; ist ein graphischer + Cursor eingeschaltet, so sollte dieser, sowie die Zeichenposition, + jedoch auf den Mittelpunkt der Zeichenflche gesetzt werden. + + 2.12 PROC #ib(2," (2.12)")#initplot#ie(2," (PROC)")# + Syntax: PROC initplot: + - Bereitet die Graphik-Ausgabe auf einem Endgert vor; evtl. + Wechsel in den Graphik-Modus, ggf. Cursor abschalten. + Bei Terminals sollte der Bildschirm nicht gelscht werden. + + 2.13 PROC #ib(2," (2.13)")#moveto#ie(2," (PROC)")# + Syntax: PROC moveto (INT CONST x, y): + - Die Zeichenposition wird auf die Koordinaten 'x;y' gesetzt, bei + berschreitung der Zeichenflche ist die Wirkung undefiniert. + + 2.14 PROC #ib(2," (2.14)")#prepare#ie(2," (PROC)")# + Syntax: PROC prepare: + - Bereitet die Ausgabe auf einem Kanal vor. + Die eigene Task sollte an den Kanal angekoppelt, und andere Tasks + ggf. am Ankoppeln gehindert bzw. abgekoppelt werden (z.B. der + PRINTER-Server bei Drucker-Graphik). Es darf erst nach erfolg- + reichem Abschlu der Aktion zurckgekehrt werden. + + 2.15 PROC #ib(2," (2.15)")#set marker#ie(2," (PROC)")# + Syntax: PROC set marker (INT CONST x, y, type): + - Zeichnet an der Position 'x;y', die auch neue Zeichenposition wird, + eine Markierung. Folgende Markierungsarten knnen systemseitig + verwendet werden: + 0 - Kreuz '+' + 1 - Kreuz diagonal 'x' + Weitere Typen knnen endgertspezifisch implementiert werden. + + 2.16 PROC #ib(2," (2.16)")#setpalette#ie(2," (PROC)")# + Syntax: PROC setpalette: + - Stellt die aktuell eingestellten RGB-Kombinationen auf dem End- + gert ein. Dazu sind die vom Konfigurationsprogramm + hinzugefgten Prozeduren 'colors' und 'color' zu verwenden: + INT PROC colors + - Liefert die Anzahl der fr das Endgert mglichen Farben + (abgeleitet aus den mit 'COLOR' angebenen + Standard-Kombinationen). + INT PROC color (INT CONST no) + - Liefert die normierte RGB-Kombination der fr 'no' ein- + gestellten Farbe (0 - 999). Die Rckgabe von 'maxint' (32767) + bedeutet: Farbe nicht initialisiert oder existiert nicht. + + 2.17 PROC #ib(2," (2.17)")#setpixel#ie(2," (PROC)")# + Syntax: PROC setpixel (INT CONST x, y): + - Setzt ein Pixel an den Raster-Koordinaten 'x;y'. +#page# +#bottom# +#right#Seite % +#end# +#head# +#type("prop")##center#Dokumentation des MPG-Graphik-Systems +#type("8.5.klein")##center#Teil 4: Graphik-Applikationen +#type("pica.lq")##free(1.0)# +#end# +#type("pica")##on("u")##ib(1)#Teil 4: Graphik-Applikationen#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + +#type("pica")##on("u")##ib(1)#Teil 4.1: Der Funktionenplotter 'FKT'#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + Mit diesem Programmpaket kann man fr beliebige reelle und reellwertige + Funktionen Graphen erstellen. Diese Graphen werden im System gespeichert. + + Zur Ausgabe der erstellten Graphen stehen alle graphikfhigen Endgerte + zur Verfgung. + + #ib(1)#1.0 Allgemeines ber FKT#ie(1)# + Zu einer Zeichnung, wie sie mit 'FKT' erstellt werden kann, gehren + folgende Eigenschaften: + - Der Name der Zeichnung (zum Wiederfinden) + - Das Format + - Der Graph mit den Achsen bzw. dem Rahmen. + + Es knnen beliebig viele Zeichnungen angelegt und aufbewahrt werden, + wobei der Name aller Zeichnungen mit "PICFILE." beginnt. + + Es wird von FKT zwischen den Definitions- und Wertebereich einerseits + und dem Format anderseits unterschieden: + - Der Definitionsbereich wird vom Benutzer gewhlt. Er gibt das + Intervall an, ber dem der Graph gezeichnet wird. Der + Wertebereich wird vom Rechner automatisch ermittelt. + - Das Format besteht aus der Angabe von vier Werten, die Auskunft + geben ber die maximale Ausdehnung der Koordinatenachsen, wobei + die Zeichnung auf den Endgerten stets so abgebildet wird, da sie + unverzerrt in maximaler Gre (also im grtmglichen Quadrat) + gezeichnet wird. + + Der Funktionenplotter FKT ist in allen Sohntasks von 'GRAPHIK' verfg- + bar, zustzlich existiert die Task 'FKT', in der das FKT-Menue als + Kommandoebene verwendet wird. + + #ib(1)#2.0 Das FKT-Menue#ie(1)# + Das Menue des Funktionenplotters ist wie folgt aufgebaut: + - in der obersten Zeile wird der eingegebene Funktionsterm angezeigt + - die nachfolgende Zeile zeigt in eckigen Klammern den Definitions- + bereich und die Schachtelung des Intervalles, ber dem der Graph + gezeichnet wird. + - dann folgt ebenfalls in eckigen Klammern der von FKT selbst zu + ermittelnde Wertebereich der Funktion innerhalb des zuvor + definierten Intervalles. + Wird kein Funktionsterm angezeigt, oder erscheinen in den eckigen + Klammern Sternchen, so wurde noch kein Funktionsterm bzw. + Definitionsbereich eingegeben, oder der Wertebereich noch nicht + ermittelt. + - Der Bereich zwischen o.g Anzeige und der Auflistung der Menuepunkte + ist der Dialogbereich, in dem weitere Anfragen an den Benutzer oder + auch Fehlermeldungen erscheinen. + - Unterhalb der Bildschirmmitte werden die unten beschriebenen + Menuepunkte zur Auswahl aufgefhrt. + - Dann folgt der Endgert-Auswahlbereich, das Endgert, auf dem eine + Zeichnung ausgegeben werden soll, kann mit den Tasten 'Links' bzw. + 'Rechts' eingestellt werden, wobei der Name des aktuell eingestellten + Endgertes invertiert erscheint. + - Als unterste Zeile der FKT-Tapete folgt der Eingabebereich, hier wird + der Benutzer zur Eingabe eines bei den Menuepunkten genannten + Buchstabens aufgefordert, und dieser bei einem zulssigen + Tastendruck dort angezeigt. + + #ib(1)#3.0 FKT-Menuepunkte#ie(1)# + + Jede Eingabe oder Operation kann durch Drcken der Taste 'ESC' + abgebrochen werden, die Eingabe wird dann ignoriert, und im Dialog- + bereich erscheint die Fehlermeldung 'F E H L E R : Abgebrochen'. + + 3.1 #ib(2," (3.1)")#(f) Funktionsterm eingeben#ie(2,"")# + Im Dialogbereich wird die Eingabe des Funktionsterms erwartet, wobei + als Variable im Term 'x' verwendet werden mu. + Es stehen alle mathematischen Funktionen des EUMEL-Systems zur + Verfgung, sofern sie reelle Werte (REAL) zurckliefern. + Beispiele von Funktionstermen (alternative Mglichkeiten in eckigen, + Erklrungen in runden Klammern): + + 2*x + [2x] + 2x*x + 3x - 5 + [2.0*x*x + 3.0*x - 5.0] + 0.7 * sqrt (x) (sqrt : Quadratwurzel aus) + log10 (x) (log10 : 10-er Logar.) + ln (3x) (ln : Nat. Logar.) + 2**x (** : Potenzieren) + exp (1/x) + [e**(1/x)] (exp : Expon.Fktn) + arctan (pi*x) (arctan: arkus tangens ) + sin (x) (sin : Sinus in Radiant ) + sind (x) (sind : Sinus in Altgrad ) + 1/(x*x+1) + + Die Klammern drfen dabei NICHT weggelassen werden, es sind nur + runde Klammern zulssig, auch geschachtelt, wie z.B. in: + + log10 (abs (sin (x) + 5)) (abs : Absolutbetrag ) + + Ein Dezimalkomma gibt es nicht, sondern nur den Dezimalpunkt. + + Beispiele von abschnittsweise definierten Funktionen: + + IF x < 5 THEN x*x ELSE sqrt (x - 5) END IF + IF x = 0 THEN 0 ELSE 1/x END IF + IF x < 0 THEN x ELIF x = 0 THEN 1 ELSE x*x END IF + + Die sog. Schlsselworte "IF" "THEN" "ELIF" "ELSE" "END IF" mssen + dabei immer in der angegebenen Form (alle, in der angegebenen Reihen- + folge, vollstndig aus Grobuchstaben) auftauchen. + + IF --+--> THEN --+--> ELSE --> END IF + | | + | | + +--- ELIF --+ + + + Es knnen bei IF auch mehrere Bedingungen mit logischem OR oder AND + verknpft werden: + + IF x <= 0 OR x > 100 THEN 0 ELSE x*x END IF + + Hat die Funktion eine Definitionslcke an einer bereits bekannten + Stelle, so kann dies im Term auf folgende Art bercksichtigt werden, + z.B.: + + IF x = 0 THEN luecke ELSE 1/x END IF + IF x < -0.05 THEN -1/x ELIF x > 0.05 THEN 1/x ELSE luecke END IF + + Taucht eine unvorhergesehene Definitionslcke auf, so wird beim + Erstellen des Wertebereichs eine entspr. Fehlermeldung ausgegeben. + Dann mu entweder der Funktionsterm durch Fallunterscheidung (s.o.) + angepat, oder der Definitionsbereich gendert werden. + + Graphen mit Definitionslcken knnen auch in zwei oder mehr Teilen + erstellt werden, nmlich jeweils ber den zusammenhngenden + Definitionsintervallen, die keine Lcke enthalten. Dazu mu jeweils + die Zeichnung ergnzt (siehe '(z) Zeichnung anfertigen') werden. + + Fehlerquelle: Der Funktionsterm ist fehlerhaft. + Es tauchen z.B. dem Rechner unbekannte Operationen auf, + Multiplikationszeichen fehlen, andere Symbole als 'x' wurden + fr die Variable benutzt, 'END IF' fehlt o.. + + 3.2 #ib(2," (3.2)")#(d) Definitionsbereich waehlen#ie(2,"")# + Im Dialogbereich wird die Eingabe von Unter- und Obergrenze erwartet, + wobei Untergrenze < Obergrenze gilt, ansonsten wird die Eingabe der + Obergrenze nochmals gefordert. + Erscheinen in der zug. Informationszeile Sterne, so ist die gewhlte + Genauigkeit zu gro und sollte umgewhlt werden. + + Fehlerquelle: Der Funktionsterm ist noch nicht vorhanden. + + 3.3 #ib(2," (3.3)")#(w) Wertebereich ermitteln lassen#ie(2,"")# + Es werden automatisch der grte und kleinste Funktionswert + ermittelt, also die tatschlichen Grenzen des Wertebereichs. + Erscheinen in der zug. Informationszeile Sterne, so ist die gewhlte + Genauigkeit zu gro und sollte umgewhlt werden. + + 3.4 #ib(2," (3.4)")#(z) Zeichnung anfertigen#ie(2,"")# + Eine Zeichnung kann auf allen zur Verfgung stehenden Gerten + ausgegeben werden, wenn sie erzeugt ist. + Mit diesem Menuepunkt werden die Zeichnungen nur erstellt, d.h. der + Graph erscheint noch nicht auf einem Ausgabegert. + Diese Zeichnungen werden dann im System aufbewahrt und knnen + somit mehrfach ausgegeben werden. + + Im Dialogbereich wird zunchst der Name der Zeichnung angefordert, + dieser beginnt grundstzlich mit dem Prefix 'PICFILE.', das nicht + verndert werden kann. + Dabei wird als Ergnzung des Namens der Funktionsterm angeboten, so + da die Zeichnung z.B. 'PICFILE.sin(x)' heit. + Dieser Teil des Namens kann aber frei verndert werden. + Existiert bereits eine Zeichnung gleichen Namens, so erscheint im + Dialogbereich eine Anfrage, wie verfahren werden soll, wobei + folgende Mglichkeiten genannt werden: + + - : Die alte Zeichnung wird gelscht. + - : Der Name wird erneut zur nderung angeboten. + - : Die neue Zeichnung, welche hiernach erstellt wird, wird an die + schon existierende Zeichnung angahngt. Dies ist vorteil- + haft, wenn mehrere od. abschnittsweise definierte Graphen + auf in eine Zeichnung kommen sollen. + Die Eingabe anderer Buchstaben wird ignoriert. + + Ansonsten wird eine Zeichnung erstellt, die unter dem eingegebenen + Namen abgelegt wird. + + Danach wird im Dialogbereich erfragt, ob und wie das Format der + Zeichnung gendert werden soll. + Nachdem die Zeichnung erstellt wurde, was durch den + Sttzpunkt-Zhler angezeigt wird, mu noch die Farbe, in der der + Graph gezeichnet werden soll eingegeben werden. + + Fehlerquelle: Wertebereich ist noch nicht bestimmt (siehe 4). + Unzulessiges Format: ymax ist kleiner oder gleich + ymin, bzw. xmax ist kleiner + oder gleich xmin. + + 3.5 #ib(2," (3.5)")#(a) Ausgabe der Zeichnung auf Endgert#ie(2,"")# + Im Dialogbereich wird der Name der auszugebenden Zeichnung erfragt, + wobei die zuletzt bearbeitete Zeichnung angeboten wird. + Die Wahl von '?' als Namen der Zeichnung ('PICFILE.?') fhrt zu einer + Auswahl aller vorhanden Bilder, von denen eines zur Ausgabe + ausgewhlt werden kann. + Danach kann wie oben nochmals das Format variiert werden. + Dann wird im Dialogbereich die berschrift der Zeichnung erfragt, + wobei der Funktionsterm angeboten wird. Die berschrift erscheint + zentriert am oberen Rand. + Je nach Lage des Ursprungs (innerhalb od. auerhalb der Zeichnung) + kann die Ausgabe mit Koordinatensystem od. mit Rahmen gewhlt + werden, liegt der Ursprung nicht innerhalb der Zeichnung, so wird + grundstzlich der Rahmen verwendet. + Zum Abschlu wird dann die Farbgebung von Koordinatensystem bzw. + Rahmen sowie der berschrift erfragt, dann wird die Zeichnung auf + dem im unteren Teil eingestelltem Endgert ausgegeben. + + 3.6 #ib(2," (3.6)")#(t) Wertetafel erstellen lassen#ie(2,"")# + In dem gewhlten Definitionsbereich kann eine Wertetafel erstellt + werden, die in einer von Ihnen gewnschten Schrittweite ermittelte + Funktionswerte zeigt. + Zunchst wird die Schrittweite erfragt, dann die von FKT formatiert + erstellte Wertetafel gezeigt. + Diese befindet sich in einer Datei, die den Namen des zugehrigen + Funktionsterms trgt, existiert diese bereits, so wird die Wertetafel + ergnzt. + Enthlt diese Tafel Sterne, so mssen Sie die Genauigkeit umwhlen + und die Tafel neu erstellen lassen. + Nach Verlassen der Anzeige wird noch gefragt, ob die Wertetafel + gedruckt, und ob sie aufbewahrt werden soll. + + Fehlerquelle: Definitionsbereich bzw. Funktionsterm ist noch nicht + gewhlt. + Die Schrittweite wurde zu klein gewhlt. Sie mu so + gro sein, da nicht mehr als 512 Werte zu berechnen + sind. + + 3.7 #ib(2," (3.7)")#(l) Zeichnungen auflisten#ie(2,"")# + Es wird eine Namesliste aller vorhandenen Zeichnungen gezeigt. + + 3.8 #ib(2," (3.8)")#(?) Hilfestellung#ie(2,"")# + Es wird eine Kurzanleitung gezeigt. + + 3.9 #ib(2," (3.9)")#(q) in die Kommandoebene zurck#ie(2,"")# + Die Arbeit mit dem Funktionsplotter wird beendet, in normalen Tasks + erscheint die Ebene, aus der 'FKT' mit 'fktplot' aufgerufen wurde. + Wird die Task 'FKT' mit 'q' verlassen, so wird dagegen die Task + abgekoppelt und alle in ihr enthaltenen Zeichnungen gelscht! + + 3.10 #ib(2," (3.10)")#(s) Anzahl der Sttzpunkte waehlen#ie(2,"")# + Bei der Ermittlung des Wertebereiches und beim Erstellen des Funk- + tionsgraphen ist es wegen der Endlichkeit des Computers nicht mg- + lich, alle Punkte des Definitionsbereiches zu benutzen. Deshalb wird + der Definitionsbereich diskretisiert, d.h. es wird eine endliche An- + zahl von Sttzpunkten ausgesucht. Diese Sttzpunkte liegen gleich- + verteilt ber dem Definitionsbereich. Die Mindestanzahl ist 2, d.h. als + Sttzpunkte werden nur die beiden Randwerte zugelassen. Aus + technischen Grnden ist die Hchstgrenze 512. + + Fehlerquelle: Zahl der Sttzpunkte ist fehlerhaft. + Nur ganze Zahlen aus dem Intervall [2;512] zulssig. + + 3.11 #ib(2," (3.11)")#(n) Nachkommastellenzahl whlen#ie(2,"")# + Hier kann die Zahl der angezeigten Nachkommastellen eingestellt + werden (intern wird immer hchstmgliche Genauigkeit verwendet). + Maximal sind neun Nachkommastellen zulssigt, jedoch kann die + Genauigkeit zu gro fr das Anzeigeformat werden; dann erscheinen + in der Anzeige Sterne (*************). + Es gilt grundstzlich: + Anzahl Vorkommastellen + Anz. Nachkommastellen = 12. + + 3.12 #ib(2," (3.12)")#(e) Arbeit beenden#ie(2,"")# + Die Arbeit mit 'FKT' wird abgeschlossen, die Task vom Terminal + abgekoppelt. Fr jede Task bleibt dabei FKT das laufende Programm, + d.h. nach erneutem Ankoppeln erscheint wieder die FKT-Tapete. In der + Task FKT bleiben die Zeichnungen bei Verlassen mit 'e' erhalten (im + Gegensatz zum Verlassen mit 'q'). + + 3.13 #ib(2," (3.13)")#(L) Zeichnungen loeschen#ie(2,"")# + Es erscheint eine Namensliste aller in der Task enthaltenen + Zeichnungen. Die dann ausgewhlten Zeichnungen werden nach noch- + maliger Rckfrage gelscht. + + 3.14 #ib(2," (3.14)")#(A) Zeichnungen archivieren#ie(2,"")# + Nach Aufruf dieses Menuepunktes knnen Zeichnungen zu anderen + Tasks geschickt, oder auch auf Diskette geschrieben werden. + Dazu wird der MPG-Dateimanager 'dm' verwendet. + + 3.15 #ib(2," (3.15)")#(b) Zeichnungen beschriften#ie(2,"")# + Mit diesem Menuepunkt knnen Zeichnungen frei beschriftet werden. + Zunchst wird im Dialogbereich erfragt, wie mit bereits bestehenden + Beschriftungen verfahren werden soll: + + - : Die nachfolgenden Texte werden zustzlich zu den schon + vorhandenen Beschriftungen angefgt. + - : Die vorhandenen Beschriftungen werden gelscht, und es wird + zum Menue zurckgekehrt. + - : Die Operation wird abgebrochen. + + Nun wird die Farbgebung aller Beschriftungen erfragt, + danach wird das aktuelle Format der Zeichnung gezeigt, was bei der + Positionierung hilfreich sein kann. + Nach der nun geforderten Eingabe des Beschriftungstextes wird die + Positionierung der Beschriftung in zwei Weisen angeboten: + - in cm : Die nachfolgend einzugebenden Werte werden als + cm-Angabe relativ zur unteren linken Ecke der Zeichnung + aufgefat. + - in REAL: Die nachfolgend einzugebenden Werte werden als + Koordinatenangabe im Koordinatensystem der erstellten + Zeichnung aufgefat ('0;0' demnach im Ursprung) Nach + Eingabe o.g. Werte wird noch die Texthhe und Breite erfragt, wobei die + eingegebenen Werte als mm-Angaben aufgeft werden (Standard: 5 * 5 + mm). + Anschlieend wird erfragt, ob noch weitere Beschriftungen + vorgenommen werden sollen. + + Fehlerquelle: Zeichnung existiert nicht. +#page# + +#type("pica")##on("u")##ib(1)#Teil 4.2: Die TURTLE-Graphik#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# + + Die TURTLE-Graphik bietet die Mglichkeit, sehr einfach zweidimensionale + Zeichnungen zu erstellen. Sie basiert auf dem in LOGO verwendeten Modell, in + dem eine Zeichenposition in jeweils eine bestimmte Richtung vorwrts bzw. + rckwrts bewegt werden kann, und die Zeichenrichtung verndert werden + kann.Bei den Bewegungen, die vornehmlich relativ zur alten Position bzw. + Zeichenrichtung ausgefhrt werden, kann dann eine Linie hinterlassen + werden. Diese Art der Graphik eignet sich insbesondere fr Programm- + gesteuerte Zeichnungen, wie z.B. die rekursiven 'Sierpinski' - bzw. 'Hilbert'- + "Funktionen". + + Die Koordinaten bewegen sich im Intervall von [-500.0,500.0]. + (0,0) liegt dabei in der Bildschirmmitte und ist auch die Anfangsposition. + Der Anfangswinkel ist 0. Winkel werden in Grad angegeben. + + #ib(1)#1.0 Paket: 'turtlegraphics'#ie(1)# + + 1.1 REAL PROC #ib(2," (1.1)")#angle#ie(2," (PROC)")# + - liefert den momentanen Winkel zwischen Zeichenrichtung und + X-Achse. + + 1.2 PROC #ib(2," (1.2)")#turnto#ie(2," (PROC)")# + (REAL CONST w) + - Die Zeichenrichtung wird absolut auf den Winkel 'w' als Winkel + zwischen Zeichenrichtung und X-Achse eingestellt. + + 1.3 PROC #ib(2," (1.3)")#forward#ie(2," (PROC)")# + (REAL CONST s) + - Die Zeichenposition wird in Zeichenrichtung um die Strecke 's' + verschoben, wobei ggf. gezeichnet wird. + + 1.4 PROC #ib(2," (1.4)")#penup#ie(2," (PROC)")# + - Der Zeichenstift wird abgehoben, Bewegungen erzeugen keine + Linien mehr. + + 1.5 PROC #ib(2," (1.5)")#forward to#ie(2," (PROC)")# + (REAL CONST x,y) + - Die Zeichenposition wird absolut auf die Position 'x;y' gesetzt, die + Zeichenrichtung wird nicht verndert. + + 1.6 PROC #ib(2," (1.6)")#endturtle#ie(2," (PROC)")# + - Wurde die Graphik im Direktmodus ('begin turtle' ohne Parameter), + also auch sofort sichtbar erzeugt, so wird die Graphikausgabe in + blicher Weise beendet, sonst nunmehr das erzeugte PICFILE + ausgegeben. + + 1.7 PROC #ib(2," (1.7)")#pendown#ie(2," (PROC)")# + - Der Zeichenstift wird gesenkt, Bewegungen erzeugen Linien. + + 1.8 PROC #ib(2," (1.8)")#beginturtle#ie(2," (PROC)")# + (TEXT CONST picfile name) + - ffnet ein PICFILE 'picfile name', in das alle Aktionen eingetragen + werden. Auf dem Bildschirm geschieht nichts. Ist das Picfile schon + vorhanden, werden die Aktionen hinzugefgt. + + 1.9 PROC #ib(2," (1.9)")#beginturtle#ie(2," (PROC)")# + - Leitet die direkte graphische Ausgabe einer TURTLE-Graphik ein, + alle Aktionen werden sofort auf dem Bildschirm sichtbar. + + 1.10 PROC #ib(2," (1.10)")#turn#ie(2," (PROC)")# + (REAL CONST w) + - Dreht die Zeichenposition um 'w'-Grad im mathematisch positiven + Sinne. + + 1.11 BOOL PROC #ib(2," (1.11)")#pen#ie(2," (PROC)")# + - Liefert zurck, ob der Zeichenstift oben (FALSE) oder unten (TRUE) + ist, also ob Bewegungen Linien hervorrufen oder nicht. + + 1.12 PROC #ib(2," (1.12)")#getturtle#ie(2," (PROC)")# + - In die bergebenen Variablen wird die aktuelle Zeichenposition + absolut eingetragen. +#page# + Diese Dokumentation und die einzelnen Programme wurden mit grtmglicher + Sorgfalt erstellt bzw. weiterentwickelt. + Dennoch kann keine Fehlerfreiheit garantiert oder die Haftung fr evtl. aus + Fehlern resultierende Folgen bernommen werden. + Fr Hinweise auf Fehler sind die Autoren stets dankbar. +#page# +#bottom off# +#head# +#type("prop")##center#Dokumentation des MPG-Graphik-Systems +#type("8.5.klein")##center#Stichwortverzeichnis +#type("pica.lq")##free(1.0)# +#end# +#type("pica")##on("u")##ib(1)#Stichwortverzeichnis#ie(1)##off("u")##type("prop.lq")# +#free(0.5)# +(a) Ausgabe der Zeichnung auf Endgert ........... 41 (3.5) +actual plotter (PROC) ............................ 17 (4.4) +ALL (OP) ......................................... 27 (3.1) +angle (PROC) ..................................... 44 (1.1) +(A) Zeichnungen archivieren ...................... 42 (3.14) +background * (PROC) .............................. 13 (3.4), 13 (3.5), 19 (1.1), + 19 (1.2), 34 (2.1) +bar * (PROC) ..................................... 8 (2.3), 23 (2.1), 23 (2.2) +beginplot (PROC) ................................. 23 (2.3) +beginturtle (PROC) ............................... 45 (1.9), 45 (1.8) +box (PROC) ....................................... 19 (1.3), 23 (2.4), 34 (2.2) +(b) Zeichnungen beschriften ...................... 42 (3.15) +CAT * (OP) ....................................... 8 (2.4) +channel (PROC) ................................... 17 (4.5) +circle (PROC) .................................... 8 (2.5), 19 (1.4), 24 (2.5), + 34 (2.3) +clear (PROC) ..................................... 19 (1.5), 19 (1.6), 34 (2.4) +clearspool ....................................... 3 (2.2) +clippedline (PROC) ............................... 5 (1.1) +color (PROC) ..................................... 19 (1.7) +COLORS ........................................... 32 (1.1) +colors (PROC) .................................... 20 (1.8) +(d) Definitionsbereich waehlen ................... 39 (3.2) +delete picture * (PROC) .......................... 13 (3.6) +dim * (PROC) ..................................... 8 (2.6) +down * (PROC) .................................... 13 (3.7), 13 (3.8) +draw cm * (PROC) ................................. 9 (2.11), 24 (2.12) +draw cm r * (PROC) ............................... 9 (2.12), 24 (2.13) +drawingarea * (PROC) ............................. 5 (1.2), 17 (4.6), 17 (4.7) +draw * (PROC) .................................... 8 (2.8), 8 (2.7), 9 (2.10), + 9 (2.9), 24 (2.6), 24 (2.9), + 24 (2.8), 24 (2.7), 24 (2.11), + 24 (2.10) +draw r * (PROC) .................................. 9 (2.13), 9 (2.14), 24 (2.14), + 25 (2.15) +drawto (PROC) .................................... 20 (1.9), 34 (2.5) +(e) Arbeit beenden ............................... 42 (3.12) +EDITOR ........................................... 33 (1.2) +end plot (PROC) .................................. 20 (1.10), 20 (1.11), 34 (2.6) +endturtle (PROC) ................................. 44 (1.6) +eof * (PROC) ..................................... 13 (3.9) +erase (PROC) ..................................... 27 (3.3), 27 (3.2) +exists (PROC) .................................... 27 (3.4) +extrema * (PROC) ................................. 9 (2.16), 9 (2.15), 13 (3.11), + 13 (3.10) +(f) Funktionsterm eingeben ....................... 38 (3.1) +fill (PROC) ...................................... 20 (1.12), 34 (2.7) +first ............................................ 4 (2.9) +first (PROC) ..................................... 27 (3.5) +foreground (PROC) ................................ 20 (1.14), 20 (1.13), 35 (2.8) +forward (PROC) ................................... 44 (1.3) +forward to (PROC) ................................ 44 (1.5) +generate plotmanager (PROC) ...................... 27 (3.6) +get cursor (PROC) ................................ 20 (1.15), 35 (2.9) +get * (PROC) ..................................... 14 (3.12) +getturtle (PROC) ................................. 45 (1.12) +getvalues (PROC) ................................. 5 (1.3), 14 (3.13) +graphik cursor (PROC) ............................ 20 (1.16), 21 (1.17), 35 (2.10) +halt ............................................. 4 (2.6) +halt (PROC) ...................................... 27 (3.7) +hidden lines * (PROC) ............................ 25 (2.16) +(?) Hilfestellung ................................ 41 (3.8) +home (PROC) ...................................... 21 (1.18), 35 (2.11) +INCLUDE .......................................... 33 (1.3) +init plot (PROC) ................................. 21 (1.19), 35 (2.12) +insert picture * (PROC) .......................... 14 (3.14) +install plotter (PROC) ........................... 17 (4.8) +is first picture * (PROC) ........................ 14 (3.15) +killer ........................................... 4 (2.8) +length * (PROC) .................................. 9 (2.17) +linetype (PROC) .................................. 25 (2.17) +LINK ............................................. 33 (1.4) +list (PROC) ...................................... 27 (3.8), 28 (3.9) +listspool ........................................ 3 (2.1) +(l) Zeichnungen auflisten ........................ 41 (3.7) +(L) Zeichnungen loeschen ......................... 42 (3.13) +move cm (PROC) ................................... 10 (2.20), 25 (2.21) +move cm r * (PROC) ............................... 10 (2.21), 25 (2.22) +move * (PROC) .................................... 9 (2.19), 9 (2.18), 25 (2.18), + 25 (2.19), 25 (2.20) +move r * (PROC) .................................. 10 (2.23), 10 (2.22), + 25 (2.23), 25 (2.24) +move to (PROC) ................................... 21 (1.20), 35 (2.13) +name (PROC) ...................................... 17 (4.9) +newvalues (PROC) ................................. 5 (1.4) +nilpicture * (PROC) .............................. 10 (2.24) +(n) Nachkommastellenzahl whlen .................. 42 (3.11) +no plotter (PROC) ................................ 17 (4.10) +oblique * (PROC) ................................. 5 (1.5), 14 (3.16) +:= (OP) .......................................... 8 (2.2), 13 (3.2), 13 (3.3), + 17 (4.3), 17 (4.2) +orthographic * (PROC) ............................ 5 (1.6) +PACKET basisplot ................................. 1 (3.1) +PACKET deviceinterface ........................... 1 (2.1) +PACKET devices ................................... 1 (1.4) +PACKET picfile ................................... 1 (1.3) +PACKET picture ................................... 1 (1.2) +PACKET plot ...................................... 1 (3.3) +PACKET plotinterface ............................. 1 (3.2) +PACKET transformation ............................ 1 (1.1) +pendown (PROC) ................................... 44 (1.7) +pen * (PROC) ..................................... 10 (2.25), 10 (2.26), + 26 (2.25), 45 (1.11) +penup (PROC) ..................................... 44 (1.4) +perspective * (PROC) ............................. 6 (1.7), 14 (3.17) +picfiles (PROC) .................................. 28 (3.10) +picture no * (PROC) .............................. 14 (3.18) +picture * (PROC) ................................. 11 (2.27) +pictures * (PROC) ................................ 14 (3.19) +plot * (PROC) .................................... 29 (4.3), 29 (4.2), 29 (4.1) +PLOTTER .......................................... 33 (1.5) +plotterinfo (PROC) ............................... 18 (4.13) +plotter (PROC) ................................... 18 (4.11), 18 (4.12) +plotters (PROC) .................................. 18 (4.14) +prepare (PROC) ................................... 21 (1.21), 36 (2.14) +put picture * (PROC) ............................. 14 (3.21) +put * (PROC) ..................................... 14 (3.20) +(q) in die Kommandoebene zurck .................. 41 (3.9) +read picture * (PROC) ............................ 14 (3.22) +reset linetypes * (PROC) ......................... 26 (2.27) +reset * (PROC) ................................... 26 (2.26) +reset zeichensatz * (PROC) ....................... 26 (2.28) +rotate * (PROC) .................................. 11 (2.28), 11 (2.29) +(s) Anzahl der Sttzpunkte waehlen ............... 42 (3.10) +save (PROC) ...................................... 28 (3.12), 28 (3.11) +selected pen * (PROC) ............................ 15 (3.23) +select pen * (PROC) .............................. 15 (3.24) +select plotter ................................... 4 (2.7) +select plotter (PROC) ............................ 18 (4.16), 18 (4.15), 18 (4.17) +set color (PROC) ................................. 21 (1.22) +setdrawingarea (PROC) ............................ 6 (1.8) +set marker (PROC) ................................ 21 (1.23), 36 (2.15) +setpalette (PROC) ................................ 21 (1.24), 36 (2.16) +setpixel (PROC) .................................. 21 (1.25), 36 (2.17) +setvalues (PROC) ................................. 6 (1.9), 15 (3.25) +spool control .................................... 3 (2.3) +start ............................................ 4 (2.5) +start (PROC) ..................................... 28 (3.13) +station (PROC) ................................... 18 (4.18) +stdcolors (PROC) ................................. 22 (1.26), 22 (1.27) +stop ............................................. 3 (2.4) +stop (PROC) ...................................... 28 (3.14) +stretch * (PROC) ................................. 11 (2.31), 11 (2.30) +text * (PROC) .................................... 11 (2.32) +to eof * (PROC) .................................. 15 (3.26) +to first pic * (PROC) ............................ 16 (3.27) +to pic * (PROC) .................................. 16 (3.28) +transform (PROC) ................................. 6 (1.10) +translate * (PROC) ............................... 12 (2.33), 12 (2.34) +turn (PROC) ...................................... 45 (1.10) +turnto (PROC) .................................... 44 (1.2) +(t) Wertetafel erstellen lassen .................. 41 (3.6) +TYPE PICFILE ..................................... 13 (3.1) +TYPE PICTURE * ................................... 8 (2.1) +TYPE PLOTTER ..................................... 17 (4.1) +up * (PROC) ...................................... 16 (3.30), 16 (3.29) +viewport * (PROC) ................................ 7 (1.14), 16 (3.34) +view * (PROC) .................................... 6 (1.13), 6 (1.12), 6 (1.11), + 16 (3.32), 16 (3.31), 16 (3.33) +wait for halt (PROC) ............................. 28 (3.15) +where * (PROC) ................................... 12 (2.35), 12 (2.36), + 26 (2.30), 26 (2.29) +window * (PROC) .................................. 7 (1.15), 7 (1.16), 7 (1.17), + 16 (3.35), 16 (3.36) +write picture * (PROC) ........................... 16 (3.37) +(w) Wertebereich ermitteln lassen ................ 40 (3.3) +zeichensatz * (PROC) ............................. 26 (2.31) +(z) Zeichnung anfertigen ......................... 40 (3.4) + diff --git a/app/mpg/1987/doc/PLOTBOOK.ELA b/app/mpg/1987/doc/PLOTBOOK.ELA new file mode 100644 index 0000000..12f881c --- /dev/null +++ b/app/mpg/1987/doc/PLOTBOOK.ELA @@ -0,0 +1,660 @@ +#type ("basker12")##limit (16.0)##block# + +#head# +#type ("triumb18")# +#center#EUMEL-Grafik-System +#type ("basker12")# +#end# + #on("italics")#gescheit, gescheiter, + gescheitert#off("italics")# + +#type ("basker14")# +#on("bold")#Beschreibung der Graphik-Prozeduren#off("bold")# +#type ("basker12")# + + #on("italics")#Zweidimensionale PICTURE brauchen weniger Speicherplatz als dreidimen- + sionale. Daher werden in einigen Fehlermeldungen unterschiedliche Gren + angegeben.#off("italics")# + +#on("underline")#Picture-Prozeduren#off("underline")# +PICTURE + + +:= + OP := (PICTURE VAR l, PICTURE CONST r) + Zweck: Zuweisung + +CAT + OP CAT (PICTURE VAR l, PICTURE CONST r) + Zweck: Aneinanderfgen von zwei PICTURE. + Fehlerflle: + * left dimension <> right dimension + Es knnen nur PICTURE mit gleicher Dimension angefgt werden. + * Picture overflow + Die beiden PICTURE berschreiten die maximale Gre eines + PICTURE. + +nilpicture + PICTURE PROC nilpicture + Zweck: Die Prozedur liefert ein leeres PICTURE zur Initialisierung. + +draw + PROC draw (PICTURE VAR p, TEXT CONST text) + Zweck: Der angegebene Text wird gezeichnet. Der Anfang ist dabei die aktuelle + Stiftposition, die nicht verndert wird. + Fehlerflle: + * Picture overflow + Der Text pat nicht mehr in das PICTURE. + + PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle, + height, bright) + Zweck: Der angegebene Text wird unter dem Winkel #on("italics")#angle#off("italics")# gegenber der + Waagerechten mit der Zeichenhhe #on("italics")#hight#off("italics")# und der Breite #on("italics")#bright#off("italics")# gezeich- + net. Der Anfang ist dabei die aktuelle Stiftposition, die nicht verndert + wird. + Fehlerflle: + * Picture overflow + Der Text pat nicht mehr in das PICTURE. + + PROC draw (PICTURE VAR p, REAL CONST x, y, z) + Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y, z). + Fehlerflle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is two dimensional + + PROC draw (PICTURE VAR p, REAL CONST x, y) + Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y). + Fehlerflle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + +draw r PROC draw r (PICTURE VAR p, REAL CONST x, y, z) + Zweck: Zeichnen einer Linie der Lnge (x, y, z) relativ zur aktuellen Position. + Fehlerflle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is two dimensional + + PROC draw r (PICTURE VAR p, REAL CONST x, y) + Zweck: Zeichnen einer Linie der Lnge (x, y) relativ zur aktuellen Position. + Fehlerflle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + +draw cm + PROC draw cm (PICTURE VAR p, REAL CONST x, y) + Zweck: Zeichnen einer Linie von der aktuellen Position zur Position (x, y) cm. + Dabei werden die angegebenen Projektionsparameter nicht beachtet, + sondern die Angaben in #on("bold")#Zentimeter#off("bold")# berechnet. + Fehlerflle: + * Picture overflow + Zu viele Befehle in einem PICTURE + +draw cm r + PROC draw cm r (PICTURE VAR p, REAL CONST x, y) + Zweck: Zeichnen einer Linie der Lnge (x, y) cm relativ zur aktuellen Position. + Dabei werden die angegebenen Projektionsparameter nicht beachtet, + sondern die Angaben in #on("bold")#Zentimeter#off("bold")# berechnet. + Fehlerflle: + * Picture overflow + Zu viele Befehle in einem PICTURE + +move + PROC move (PICTURE VAR p, REAL CONST x, y, z) + Zweck: Die aktuelle Position wird auf (x, y, z) gesetzt. + Fehlerflle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is two dimensional + + PROC move (PICTURE VAR p, REAL CONST x, y) + Zweck: Die aktuelle Position wird auf (x, y) gesetzt. + Fehlerflle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + +move r + PROC move r (PICTURE VAR p, REAL CONST x, y, z) + Zweck: Die aktuelle Position wird um (x, y, z) erhht. + Fehlerflle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is two dimensional + + PROC move r (PICTURE VAR p, REAL CONST x, y) + Zweck: Die aktuelle Position wird um (x, y) erhht. + Position. + Fehlerflle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + +move cm + PROC move cm (PICTURE VAR p, REAL CONST x, y) + Zweck: Die aktuelle Position wird auf (x, y) cm gesetzt. Dabei werden die an- + gegebenen Projektionsparameter nicht beachtet, sondern die Angaben in #on("bold")# + Zentimeter#off("bold")# berechnet. + Fehlerflle: + * Picture overflow + Zu viele Befehle in einem PICTURE + +move cm r + PROC move cm r (PICTURE VAR p, REAL CONST x, y) + Zweck: Die aktuelle Position wird um (x, y) cm erhht. Dabei werden die an- + gegebenen Projektionsparameter nicht beachtet, sondern die Angaben in #on("bold")# + Zentimeter#off("bold")# berechnet. + Fehlerflle: + * Picture overflow + Zu viele Befehle in einem PICTURE + +bar + PROC bar (PICTURE VAR p, REAL CONST width, hight, INT CONST + pattern): + Zweck: Die Prozedur zeichnet an der aktuellen Position einen Balken mit dem + Muster #on("italics")#pattern#off("italics")#: 0 = Leerer Balken + 1 = Gepunkteter Balken + 2 = Gefllter Balken + 3 = Horizontale Linien + 4 = Vertikale Linien + 5 = Gekreuzte Linien + 6 = Diagonale Linien von Links nach Rechts + 7 = Diagonale Linien von Rechts nach Links + 8 = Gekreuzte diagonale Linien. + Die aktuelle Stiftposition wird dabei nicht verndert. + Fehlerflle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + * Unknown pattern + Das angegebene Muster liegt nicht im Bereich 0-8 + +circle + PROC circle (PICTURE VAR p, REAL CONST from, to, INT CONST + pattern) + Zweck: Die Prozedur zeichnet an der aktuellen Position ein Kreissegment vom + Winkel #on("italics")#from#off("italics")# bis #on("italics")#to#off("italics")# (im Gradma) mit dem Muster #on("italics")#pattern#off("italics")# (s.o.). Die + aktuelle Stiftposition wird dabei nicht verndert. + Fehlerflle: + * Picture overflow + Zu viele Befehle in einem PICTURE + * Picture is three dimensional + * Unknown pattern + Das angegebene Muster liegt nicht im Bereich 0-8 + +dim + INT PROC dim (PICTURE CONST pic) + Zweck: Liefert die Dimension eines PICTURE. + +pen + INT PROC pen (PICTURE CONST p) + Zweck: Liefert den virtuellen Stift des PICTURE + + PROC pen (PICTURE VAR p, INT CONST pen) + Zweck: Setzen des (virtuellen) Stiftes eines PICTURE. Bei pen=0 wird das + Picture nicht gezeichnet. + Fehlerflle: + * pen out of range + Der gewnschte Stift ist kleiner als 0 oder grer als 16. + +extrema + PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y + max) + Zweck: Die Prozedur liefert die grten und kleinsten Werte des PICTURE. + Fehlerflle: + * Picture is three dimensional + + PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y + max, z min, z max) + Zweck: Die Prozedur liefert die grten und kleinsten Werte des PICTURE. + Fehlerflle: + * Picture is two dimensional + +where + PROC where (PICTURE CONST p, REAL VAR x, y, z) + Zweck: Die Prozedur liefert die aktuelle Stiftposition (Angaben mit #on("italics")#cm#off("italics")# werden + dabei nicht bercksichtigt). + Fehlerflle: + * Picture is two dimensional + + PROC where (PICTURE CONST p, REAL VAR x, y, z) + Zweck: Die Prozedur liefert die aktuelle Stiftposition (Angaben mit #on("italics")#cm#off("italics")# werden + dabei nicht bercksichtigt). + Fehlerflle: + * Picture is three dimensional + +rotate: + PROC rotate (PICTURE VAR p, REAL CONST angle) + Zweck: Das PICTURE wird um den Punkt (0, 0) um den Winkel #on("italics")#angle#off("italics")# (im + Gradma) im mathematisch positiven Sinn gedreht. + Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")# + verndert. + + PROC rotate (PICTURE CONST p, REAL CONST phi, theta, lambda ) : + PICTURE 1-397 + Zweck: Das PICTURE wird um den Winkel #on("italics")#lambda#off("italics")# um die Drehachse #on("italics")#(phi, + theta)#off("italics")# gedreht. + Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")# + verndert. + +stretch + PROC stretch (PICTURE VAR pic, REAL CONST sx, sy) + Zweck: Das PICTURE wird in X-Richtung um den Faktor #on("italics")#sx#off("italics")#, in Y-Rich- + tung um den Faktor #on("italics")#sy#off("italics")# gestreckt (bzw. gestaucht). Dabei bewirkt der + Faktor + s > 1 eine Streckung + 0 < s < 1 eine Stauchung + s < 0 zustzlich eine Achsenspiegelung. + Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")# + verndert. + Fehlerflle: + * Picture is three dimensional + + PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz) + Zweck: s. o. + Fehlerflle: + * Picture is two dimensional + +translate + PROC translate (PICTURE VAR p, REAL CONST dx, dy) + Zweck: Das PICTURE wird um #on("italics")#dx#off("italics")# und #on("italics")#dy#off("italics")# verschoben. + Dabei werden nur die Werte von #on("italics")#draw, draw r, move #off("italics")# und #on("italics")#move r#off("italics")# + verndert. + Fehlerflle: + * Picture is three dimensional + + PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz) + Zweck: s. o. + Fehlerflle: + * Picture is two dimensional + +plot PROC plot (PICTURE CONST p) + Zweck: Das Picfile wird gezeichnet. + Achtung: Es wird kein #on("italics")#begin plot#off("italics")# oder #on("italics")#end plot#off("italics")# durchgefhrt. Es wird + auch kein Stift gsetzt und die Projektionsparameter bleiben + unverndert. + + +#on("underline")#Graphische PICFILE-Prozeduren#off("underline")# +plot + PROC plot (TEXT CONST name) + Zweck: Der PICFILE mit dem Namen #on("italics")#name#off("italics")# wird entsprechend der angegebenen + Darstellungsart gezeichnet. Diese Parameter (#on("italics")#perspective, orthographic, + oblique, view, window etc.#off("italics")#) mssen vorher eingestellt werden. + Fehlerflle: + * PICFILE does not exist + Es existiert kein PICFILE mit dem Namen #on("italics")#name#off("underline")# + + PROC plot (PICFILE VAR p) + Zweck: Der PICFILE #on("italics")#p#off("italics")# wird entsprechend der angegebenen Darstellungsart ge- + zeichnet. Diese Parameter mssen vorher eingestellt werden: + + #on("bold")#zweidimensional:#off("bold")# + obligat: #on("italics")#window#off("italics")# (zweidimensional) + optional: #on("italics")#view#off("italics")# (zweidimensional) + #on("italics")#viewport#off("italics")# + #on("italics")#select pen#off("italics")# + + #on("bold")#dreidimensional:#off("bold")# + obligat: #on("italics")#window#off("italics")# (dreidimensional) + optional: #on("italics")#view#off("italics")# (dreidimensional) + #on("italics")#orthographic | perspective | oblique#off("italics")# + #on("italics")#viewport#off("italics")# + #on("italics")#select pen#off("italics")# + + +select pen + PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line + type, + BOOL VAR hidden lines) Zweck: Fr die + Darstellung des Bildes #on("italics")#p#off("italics")# soll dem #on("italics")#virtuellen#off("italics")# Stift #on("italics")#pen#off("italics")# ein realer Stift + zugeordnet werden, der mglichst die Farbe #on("italics")#colour#off("italics")# und die Dicke #on("italics")#thick- + ness#off("italics")# hat und dabei Linien mit dem Typ #on("italics")#line type#off("italics")# zeichnet. Es wird die + beste Annherung fr das Ausgabegert genommen. + Wenn #on("italics")#hidden lines#off("italics")# auf TRUE gesetzt wird, werden bei dreidimensionalen + Zeichnungen die verdeckten Linien mitgezeichnet, ansonsten werden sie + unterdrckt. Um sicherzustellen, das der Algorithmus auch funktioniert, + mssen die Linien allerdings von vorn nach hinten gezeichnet werden. Es + ist also nicht mglich, das Bild so zu drehen, das die hinteren Linien + zuerst gezeichnet werden. + Dabei gelten folgende Vereinbarungen: + + #on("bold")#Farbe:#off("bold")# Negative Farben werden XOR gezeichnet (dunkel wird hell und + hell wird dunkel), Farbe 0 ist der Lschstift und positive Farben + berschreiben (ersetzen) den alten Punkt mit folgenden Werten: + + 1 Standardfarbe des Endgertes + 2 rot + 3 blau + 4 grn + 5 schwarz + 6 wei + > 6 nicht normierte Sonderfarben + + + #on("bold")#Dicke:#off("bold")# 0 Standardstrichstrke des Endgertes, ansonsten Strichstrke in + 1/10 mm. + + + #on("bold")#Linientyp:#off("bold")# + 0 keine sichtbare Linie + 1 durchgngige Linie + 2 gepunktete Linie + 3 kurz gestrichelte Linie + 4 lang gestrichelte Linie + 5 Strichpunktlinie + > 5 nicht normierte Linie + + #on("bold")#Verdeckte Linien:#off("bold")# + TRUE Verdeckte Linien werden mitgezeichnet + FALSE Verdeckte Linien werden unterdrckt (nur bei drei- + dimensionalen PICTURE) + + Die hier aufgefhrten Mglichkeiten mssen nicht an allen graphischen + Endgerten vorhanden sein. Der gerteabhngige Graphik-Treiber whlt + jeweils die bestmgliche Annherung. + + Fehlerflle: + * pen out of range + #on("italics")#pen#off("italics")# muss im Bereich 1-16 sein. + +background + PROC background (PICFILE VAR p, INT CONST colour) + Zweck: Der Hintergrund wird auf die Farbe #on("italics")#colour#off("italics")# (s.o.) gesetzt wenn mglich. + + INT PROC background (PICFILE CONST p): + Zweck: Liefert die eingestellte Hintergrundfarbe. + +view + PROC view (PICFILE VAR p, REAL CONST alpha) + Zweck: Setzt den Winkel der Y-Achse zur Senkrechten auf #on("italics")#alpha#off("italics")# Grad, falls + diese nicht senkrecht zur Betrachtungsebene steht. + + PROC view (PICFILE VAR p, REAL CONST phi, theta) + Zweck: Dreidimensionale Bilder werden hufig nicht direkt von vorne dargestellt, + sondern fr die Betrachtung gedreht. Mit der Prozedur #on("italics")#view#off("italics")# kann die + Betrachtungsrichtung durch die Polarwinkel #on("italics")#phi#off("italics")# und #on("italics")#theta#off("italics")# (im Gradmass) + angegeben werden. Voreingestellt ist #on("italics")#phi#off("italics")# = 0 und #on("italics")#theta#off("bold")# = 0, d.h. senk- + recht von oben. + + Im Gegensatz zu #on("italics")#rotate#off("italics")# hat #on("italics")#view#off("italics")# keine Wirkung auf das eigentliche Bild + (PICFILE), sondern nur auf die gewhlte Darstellung. So addieren sich + zwar aufeinanderfolgende #on("italics")#Rotationen#off("italics")#, #on("italics")#view#off("italics")# aber geht immer von der + Nullstellung aus. Auch kann das Bild durch eine #on("italics")#Rotation#off("italics")# ganz oder + teilweise aus oder in das Darstellungsfenster (#on("italics")#window#off("italics")# gedreht werden. Bei + #on("italics")#view#off("italics")# verndern sich die Koordinaten der Punkte nicht, d. h. das Fenster + wird mitgedreht. + + PROC view (PICFILE VAR p, REAL CONST x, y, z) + Zweck: Wie oben, nur werden die Winkel nicht in Polarkoordinaten angegeben, + sondern es wird die Blickrichtung als Vektor in Karthesischen Koordina- + ten angegeben. (Die Lnge darf ungleich 1 sein). + +viewport + PROC viewport (PICFILE VAR p, REAL CONST hormin, hormax, vertmin, + vertmax) : 1-709 + Zweck: Die Zeichenflche auf dem Endgert, auf dem das Bild dargestellt werden + soll, wird spezifiziert. Dabei wird sowohl die Gre als auch die relative + Lage der Zeichenflche definiert. Der linke untere Eckpunkt der physi- + kalischen Zeichenflche des Gertes hat die Koordinaten (0, 0). Die + definierte Zeichenflche erstreckt sich + + #on("italics")#hormin - hormax#off("italics")# in der Horizontalen, + #on("italics")#vertmin - vertmax#off("italics")# in der Vertikalen. + + So liegt der linke untere Eckpunkt dann bei (#on("italics")#hormin, hormax#off("italics")#), der rechte + obere Eckpunkt bei (#on("italics")#hormax, vertmax#off("italics")#). + + Damit sowohl gerteunabhngige als auch mastabgetreue Zeichnungen + mglich sind, knnen die Koordinaten in zwei Arten spezifiziert werden: + a) #on("bold")#Gertekoordinaten#off("bold")# + Die Koordinaten knnen Werte von 0.0 bis 2.0 annehmen. Dabei + hat die krzere Seite der physikalischen Zeichenflche definitionsge- + m die Lnge 1.0. + b) #on("bold")#Absolute Koordinaten#off("bold")# + Die Werte werden in #on("italics")#cm#off("italics")# angegeben. Dabei mssen die Maximal- + werte aber grer als 2.0 sein, da sonst Fall a) angenommen wird. + + Voreingestellt ist + + viewport (0.0, 1.0, 0.0, 1.0) + + d.h. das grtmgliche Quadrat, beginnend mit der linken unteren Ecke + der physikalischen Zeichenflche. In vielen Fllen wird diese Einstellung + ausreichen, so da der Anwender kein eigenes #on("italics")#viewport#off("italics")# definieren muss. + + Der Abbildungsmastab wird durch das Zusammenspiel von #on("italics")#viewport#off("italics")# und + #on("italics")#window#off("italics")# festgelegt (s. dort). Dabei ist insbesondere darauf zu achten, da + winkeltreue Darstellung nur bei gleichen X- und Y-Mastab mglich + ist. Da man oft quadratische Fenster (#on("italics")#window#off("italics")#) verwendet, wurde als + Standardeinstellung auch ein quadratisches #on("italics")#viewport#off("italics")# gewhlt. + + Hinweis: Mit der Prozedur #on("italics")#check limit#off("italics")# aus dem PACKET #on("italics")#basis plot#off("italics")# kann die + berprfung der Grenzen des eingestellten #on("italics")#viewport#off("italics")#-Bereiches ein- + bzw. ausgeschaltet werden. Bei eingeschateter berprfung, werden + Linien, die den Bereich berschreiten, am Rand abgetrennt. + + +window + PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) + Zweck: Fr die Darstellung eines zweidimensionalen Bildes wird das darzustel- + lende Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im In- + tervall [#on("italics")#x min, x max#off("italics")#] und deren Y-Koordinaten im Bereich [#on("italics")#y min, y + max#off("italics")#] liegen, gehren zum definierten Fenster.Vektoren, die auerhalb + dieses Fensters liegen, gehen ber die durch #on("italics")#viewport#off("italics")# Flche hinaus + (s.dort). + + Der Darstellungsmastab ergibt sich als + + #ub# x max - x min #ue# + horizontale Seitenlnge der Zeichenflche + + + #ub# y max - y min #ue# + vertikale Seitenlnge der Zeichenflche + + PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max, + z min, z max) + + Zweck: Fr die darstellung eines dreidimensionalen Bildes wird das darzustellende + Fenster definiert. Alle Bildpunkte, deren X-Koordinaten im Intervall [#on("italics")#x + min, x max#off("italics")#], deren Y-Koordinaten im Bereich [#on("italics")#y min, y max#off("italics")#] und + deren Z-Koordinaten im Bereich [#on("italics")#z min, z max#off("italics")#] liegen, gehren zum + definierten Fenster. Dieses dreidimensionale Fenster (#on("italics")#Quader#off("italics")#) wird ent- + sprechend der eingestellten Projektionsart (orthographisch, perspektivisch + oder schiefwinklig) und den Betrachtungswinkeln (s. #on("italics")#view#off("italics")#) auf die spezi- + fizierte Zeichenflche abgebildet. + Anders als im zweidimensionalen Fall ist das Problem der Mastabe + nicht mehr nur durch das Zusammenspiel von #on("italics")#window#off("italics")# und #on("italics")#viewport#off("italics")# zu + beschreiben. Hier spielen auch die Projektionsart und Darstellungswinkel + herein. + +oblique: + PROC oblique (PICFILE VAR p, REAL CONST a, b) + Zweck: Bei dem (dreidimensionalen) Bild #on("italics")#p#off("italics")# wir #on("underline")#schiefwinklig#off("underline")# als gewnschte + Projektionsart eingestellt. Dabei ist (#on("italics")#a, b#off("italics")#) der Punkt auf der X-Y- + Ebene, auf den der Einheitsvektor der Z-Richtung abgebildet werden + soll. + +orthographic + PROC orthographic (PICFILE VAR p) + Zweck: Bei dem (dreidimensionalen) Bild #on("italics")#p#off("italics")# wir #on("underline")#orthographisch#off("underline")# als gewnschte + Projektionsart eingestellt. Bei der orthographischen Projektion wird ein + dreidimensionaler Krper mit parallelen Strahlen senkrecht auf der Pro- + jektionsebene dabgebildet. + +perpective + PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) + Zweck: Bei dem (dreidimensionalen) Bild #on("italics")#p#off("italics")# wir #on("underline")#perspectivisch#off("underline")# als gewnschte + Projektionsart eingestellt. Der Punkt (#on("italics")#cx, 1/cy, cz#off("underline")#) ist der Fluchtpunkt der + Projektion, d. h. alle Parallen zur Z-Achse schneiden sich in diesem + Punkt. + +extrema + PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) + Zweck: Die Prozedur liefert die grten und kleinsten Werte des PICFILE. + + PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z + min,z max) : 1-651 + Zweck: Die Prozedur liefert die grten und kleinsten Werte des PICFILE. + + +#on("underline")#Prozeduren zur Manipulation von PICFILE#off("underline")# +:= + OP := (PICFILE VAR p, DATASPACE CONST d) + Zweck: Assoziert die PICFILE Variable #on("italics")#p#off("italics")# mit dem Datenraum #on("italics")#d#off("italics")# und initialisiert + die Variable, wenn ntig. + Fehlerflle: + * dataspace is no PICFILE + Der anzukoppelnde Datenraum hat einen unzulssigen Typ + +picture file + DATASPACE PROC picture file (TEXT CONST name) + Zweck: Assoziaten eines benannten Datenraumes mit einem PICFILE (s.o.). + +put + PROC put (FILE VAR f, PICFILE VAR p) + Zweck: Schreibt den Inhalt eines PICFILE in ein FILE. Die Informationen + werden im internen Format abgelegt. + +get + PROC get (PICFILE VAR p, FILE VAR f) + Zweck: Liest den Inhalt eines PICFILE aus einem FILE. Die Informationen + mssen mit #on("italics")#put#off("italics")# geschrieben worden sein. + Fehlerfall: + * Picfile overflow + Es knnen nur maximal 1024 Picture (Stze) in einem PICFILE abgelegt + werden. + +to first pic + PROC to first pic (PICFILE VAR p) + Zweck: Positioniert auf das erste PICTURE. + +to eof + PROC to last pic (PICFILE VAR p) + Zweck: Positioniert hinter das letzte PICTURE. + +to pic + PROC to pic (PICFILE VAR p, INT CONST pos) + Zweck: Positioniert auf das PICTURE Nummer #on("italics")#pos#off("italics")#. + Fehlerflle: + * Position underflow + Es wurde eine Position kleiner Null angegeben. * Position after + eof Es wurde versucht, hinter das Ende eines PICFILE zu positionieren + +up + PROC up (PICFILE VAR p) + Zweck: Positioniert genau ein PICTURE zurck. + Fehlerfall: + * Position underflow + Es wurde versucht, vor das erste PICTURE zu positionieren + + PROC up (PICFILE VAR p, INT CONST n) + Zweck: Positioniert genau #on("italics")#n#off("italics")# Picture zurck. + Fehlerfall: + * Position underflow + Es wurde versucht, vor das erste PICTURE zu positionieren + +down + PROC down (PICFILE VAR p) + Zweck: Positioniert genau ein PICTURE vorwrts. + Fehlerfall: + * Position after eof + Es wurde versucht, hinter das Ende eines PICFILE zu positionieren + + PROC down (PICFILE VAR p, INT CONST n) + Zweck: Positioniert genau #on("italics")#n#off("italics")# Picture vorwrts. + Fehlerfall: + * Position after eof + Es wurde versucht, hinter das Ende eines PICFILE zu positionieren + +is first picture + BOOL PROC is first picture (PICFILE CONST p) + Zweck: Liefert genau dann #on("italics")#TRUE#off("italics")#, wenn das erste PICTURE erreicht ist. + +eof + BOOL PROC eof (PICFILE CONST p) + Zweck: Liefert genau dann #on("italics")#TRUE#off("italics")#, wenn das Ende eines PICFILE erreicht ist. + +picture no + INT PROC picture no (PICFILE CONST p) + Zweck: Liefert die Nummer des aktuellen PICTURE. + +pictures + INT PROC pictures (PICFILE CONST p) + Zweck: Liefert die Anzahl PICTURE eines PICFILE. + +delete picture + PROC delete picture (PICFILE VAR p) + Zweck: Lscht das aktuelle PICTURE + +insert picture + PROC insert picture (PICFILE VAR p) + Zweck: Fgt ein PICTURE #on("underline")#vor#off("underline")# der aktuellen Position ein. + +read picture + PROC read picture (PICFILE CONST p, PICTURE VAR pic) + Zweck: Liest das aktuelle PICTURE. + +write picture + PROC write picture (PICFILE VAR p, PICTURE CONST pic) + Zweck: Schreibt das PICTURE #on("italics")#pic#off("italics")# auf der aktuellen Position. + +put picture + PROC write picture (PICFILE VAR p, PICTURE CONST pic) + Zweck: Schreibt das PICTURE #on("italics")#pic#off("italics")# hinter das letzte PICTURE des PICFILE. + Die aktuelle Position wird nicht verndert. + +#page# + #on("italics")#Wo wir sind, da klappt nichts, + aber wir knnen nicht berall sein !#off("italics")# + +#type ("basker14")# +#on("bold")#Kurzbeschreibung des Graphik-Editors#off("bold")# +#type ("basker12")# + +In der Kommondozeile werden folgende Informationen angezeigt: + +#on("revers")#LEN nnnnn <...Name...> DIM n PEN nn Picture nnnn +#off("revers")# + + +Folgende Kommandos stehen zur Verfgung: + + PICTURE PROC pic neu + PICFILE PROC picfile neu + PROC neu zeichnen + + OP UP n (n PICTURE up) + OP DOWN n (n PICTURE down) + OP T n (to PICTURE n) + + PROC oblique (REAL CONST a, b) + PROC orthographic + PROC perspective (REAL CONST cx, cy, cz) + PROC window (BOOL CONST dev) + PROC window (REAL CONST x min, x max, y min, y max) + PROC window (REAL CONST x min, x max, y min, y max, z min, z max) + PROC viewport (REAL CONST h min, h max, v min, v max) + PROC view (REAL CONST alpha) + PROC view (REAL CONST phi, theta) + PROC view (REAL CONST x, y, z) + + PROC pen (INT CONST n) + PROC select pen (INT CONST pen, colour, thickness, line type, BOOL CONST + hidden) + PROC background (INT CONST colour) + + PROC extrema pic + PROC extrema picfile + PROC selected pen + + PROC rotate (REAL CONST angle) + PROC rotate (REAL CONST phi, theta, lambda ) + PROC stretch (REAL CONST sx, sy) + PROC stretch (REAL CONST sx, sy, sz) + PROC translate (REAL CONST dx, dy) + PROC translate (REAL CONST dx, dy, dz) diff --git a/app/mpg/1987/src/ATPLOT.ELA b/app/mpg/1987/src/ATPLOT.ELA new file mode 100644 index 0000000..4799ab0 --- /dev/null +++ b/app/mpg/1987/src/ATPLOT.ELA @@ -0,0 +1,438 @@ +PACKET at plot DEFINES (* at plot *) + (* Datum : 14:05:86 *) + begin plot, (* Geaendert: 30.05:86 *) + end plot, (* Autoren : BJ & CW *) + clear, (* MPG Bielefeld *) + + pen, + background, + foreground, + thickness, + linetype, + + move, + draw, + bar, circle, + drawing area, + range, set range: + +LET max x = 719, + max y = 347, + x pixel = 720, + y pixel = 348, + x cm = 24.5, + y cm = 18.5; + +INT VAR thick :: 0, (* Normale Linien *) + ltype :: 1, + x max :: max x, (* Zeichenfenster *) + y max :: max y, + x min :: 0, + y min :: 0, + old x :: 0, + old y :: 0; + +ROW 5 ROW 4 INT CONST nibble :: ROW 5 ROW 4 INT: (* Bitmuster fuer Linien*) + (ROW 4 INT : ( 4369, 4369, 4369, 4369), (* durchgezogen *) + ROW 4 INT : ( 17, 17, 17, 17), (* gepunktet *) + ROW 4 INT : ( 4369, 0, 4369, 0), (* kurz gestrichelt *) + ROW 4 INT : ( 4369, 4369, 0, 0), (* lang gestrichelt *) + ROW 4 INT : ( 4369, 4369, 4096, 1)); (* gestrichpunktet *) + +PROC begin plot: + INT VAR return; + REP (* Fehler? Ab und zu versagt der *) + control (-5,512+0,0,return); (* Graphik-Aufruf !!!!!! *) + UNTIL return <> -1 PER; + IF return <> 0 + THEN errorstop ("Graphik nicht ansprechbar") + FI +END PROC begin plot; + +PROC end plot: + INT VAR return; + pause; + control (-5,2,0,return); +END PROC end plot; + +PROC clear: + begin plot +END PROC clear; + +PROC pen (INT CONST backgr, foregr, thickn, linety): + INT VAR dummy; + background (backgr, dummy); + thickness (thickn, dummy); + linetype (linety, dummy); + foreground (foregr, dummy) +END PROC pen; + +PROC background (INT CONST desired, INT VAR realized): + realized := 0 +END PROC background; + +PROC foreground (INT CONST desired, INT VAR realized): + IF desired < 2 OR desired = 5 (* 0 = loeschen, 1 = setzen, 5 = schwarz *) + THEN realized := desired + ELSE realized := 1 + FI; + IF realized = 0 + THEN INT VAR return; + control ( -9,0,0,return); + control (-10,0,0,return) + ELSE linetype (ltype,return) (* Alten Typ wiederherstellen *) + FI +END PROC foreground; + +PROC linetype (INT CONST desired, INT VAR realized): + IF desired > 5 + THEN realized := 1 + ELSE realized := desired + FI; + INT VAR return; + ltype := realized; + control ( -9,nibble [realized][2], nibble [realized][1], return); + control (-10,nibble [realized][4], nibble [realized][3], return); + IF realized = 1 + THEN control (-11,0,0,return) + ELSE control (-11,1,0,return) + FI +END PROC linetype; + +PROC thickness (INT CONST desired, INT VAR realized): + thick := int ( real (desired) / 200.0 * (* Angabe in 1/10 mm *) + real (x pixel) / x cm); (* Unrechnung in X Punkte *) + realized := thick * 2 + 1 (* Rueckgabe in Punkten *) +END PROC thickness; + +PROC move (INT CONST x,y): + old x := x; (* Kein direktes move, da clipping ! *) + old y := y +END PROC move; + +PROC draw (INT CONST x,y): + draw (old x,old y,x,y); +END PROC draw; + +PROC draw (INT CONST x0,y0,x1,y1): + IF thick = 0 + THEN line (x0,y0,x1,y1) + ELSE draw thick line (x0,y0,x1,y1) + FI; + move (x1,y1) +END PROC draw; + +PROC draw thick line (INT CONST x1,y1,x2,y2): + INT VAR x0 :: x1, + y0 :: y1, + x :: x2, + y :: y2; + swap if neccessary; + REAL VAR xr0 :: real(x0), (* Unwandlung in *) + yr0 :: real(y0) / (x cm * real(y pixel)) * (* 1:1-Koordinaten*) + (y cm * real(x pixel)), + xr1 :: real(x), + yr1 :: real(y) / (x cm * real(y pixel)) * + (y cm * real(x pixel)); + INT VAR line counter; + control(-11,1,0,line counter); + IF is vertical line + THEN draw vertical line + ELSE draw line + FI; + move(x1,y1). + + swap if neccessary: + IF x < x0 OR (x = x0 AND y < y0) + THEN INT VAR dummy :: x0; + x0 := x; + x := dummy; + dummy := y0; + y0 := y; + y := dummy + FI. + + is vertical line: + x = x0. + + draw vertical line: + INT VAR i; + FOR i FROM - thick UPTO thick REP + INT VAR return; + control(-11, 1,line counter,return); (* Einheitliches Muster ! *) + line (xr0+real(i),yr0-real(thick),xr0+real(i),yr1+real(thick)) + PER. + + draw line: + REAL VAR m :: (yr1 - yr0) / (xr1 - xr0), + dx :: real(thick)/sqrt(1.0+m**2), + dy :: m * dx, + xn, + yn, + diff, + dsx :: dy, + dsy :: -dx, + x incr :: -real(sign(dsx)), + y incr :: -real(sign(dsy)); + xr0 INCR -dx; + yr0 INCR -dy; + xr1 INCR dx; + yr1 INCR dy; + xn := xr0 + dsx; + yn := yr0 + dsy; + REP + control (-11, 1,line counter,return); + line(xn,yn,xr1 - xr0 + xn,yr1 - yr0 + yn); + diff := (2.0*dsy *(xn - (xr0 - dy)) - 2.0 * dsx * (yn - (yr0 + dx))) + * real(sign(m)); + IF diff < 0.0 + THEN xn INCR x incr + ELIF diff > 0.0 + THEN yn INCR y incr + ELSE xn INCR x incr; + yn INCR y incr + FI + UNTIL int(xn - xr0 + dy) = 0 AND int(yn - yr0 - dx) = 0 PER + +END PROC draw thick line; + +PROC line (REAL CONST x0,y0,x1,y1): (* 1:1-Koordinaten -> Geraetek. *) + line (int(x0),int(y0 * (x cm * real(y pixel)) / (y cm * real(x pixel))), + int(x1),int(y1 * (x cm * real(y pixel)) / (y cm * real(x pixel)))) +END PROC line ; + +PROC line (INT CONST x0,y0,x1,y1): (* Normale Linie mit clipping *) + REAL VAR dx :: real(xmax - xmin) / 2.0, + dy :: real(ymax - ymin) / 2.0, + rx0 :: real(x0-x min) - dx, + ry0 :: real(y0-y min) - dy, + rx1 :: real(x1-x min) - dx, + ry1 :: real(y1-y min) - dy; + INT VAR cx0, + cy0, + cx1, + cy1; + calculate cells; + IF (cx0*cx1 = 1) OR (cy0 * cy1 = 1) + THEN (* Linie ausserhalb *) + ELSE do clipping + FI. + + do clipping: + IF cx0 <> 0 + THEN REAL VAR next x :: real(cx0) * dx; + ry0 := (ry1 - ry0) / (rx1 - rx0) * (next x - rx0) + ry0; + rx0 := next x + FI; + calculate cells; + IF cy0 <> 0 + THEN REAL VAR next y :: real(cy0) * dy; + rx0 := (rx1 - rx0) / (ry1 - ry0) * (next y - ry0) + rx0; + ry0 := next y + FI; + IF cx1 <> 0 + THEN next x := real(cx1) * dx; + ry1 := (ry1 - ry0) / (rx1 - rx0) * (next x - rx1) + ry1; + rx1 := next x + FI; + calculate cells; + IF cy1 <> 0 + THEN next y := real(cy1) * dy; + rx1 := (rx1 - rx0) / (ry1 - ry0) * (next y - ry1) + rx1; + ry1 := next y + FI; + IF (rx1 = rx0) AND (ry1 = ry0) + THEN LEAVE line + FI; + draw std line (int (rx0+dx) + x min,int (ry0+dy) + y min, + int (rx1+dx) + x min,int (ry1+dy) + y min). + + calculate cells: + cx0 := 0; + cy0 := 0; + cx1 := 0; + cy1 := 0; + IF abs(rx0) > dx + THEN cx0 := sign(rx0) + FI; + IF abs(rx1) > dx + THEN cx1 := sign(rx1) + FI; + IF abs(ry0) > dy + THEN cy0 := sign(ry0) + FI; + IF abs(ry1) > dy + THEN cy1 := sign(ry1) + FI + +END PROC line; + +PROC draw std line (INT CONST x0,y0,x1,y1): (* Terminallinie ziehen *) + INT VAR return; + control(-7,x0,max y - y0,return); (* move *) + control(-6,x1,max y - y1,return) (* draw *) +END PROC draw std line; + +PROC drawing area (REAL VAR x c, y c, INT VAR x pix, y pix): + x pix := x pixel; + y pix := y pixel; + x c := x cm; + y c := y cm +END PROC drawing area; + +PROC range (INT CONST hmin,hmax,vmin,vmax): (* Zeichenflaeche setzen *) + x min := max (0, min (max x,h min)); + x max := max (0, min (max x,h max)); + y min := max (0, min (max y,v min)); + y max := max (0, min (max y,v max)) +END PROC range; + +PROC set range ( INT CONST hmin, hmax, vmin, vmax): + range( hmin, hmax, vmin, vmax ) +ENDPROC set range; + +(* Textausgabe von C. Indenbirken *) +(* Erweitert um stufenlose Rotierbarkeit der Zeichen *) + +LET ZEICHENSATZ = ROW 255 TEXT; +ZEICHENSATZ VAR zeichen; +INT CONST char x :: 6, char y :: 10; + +zeichensatz ("ZEICHENSATZ"); + +PROC zeichensatz (TEXT CONST name): + IF exists (name) + THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name); + zeichen := new zeichen; + ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI +END PROC zeichensatz; + +PROC draw char (INT CONST char no,REAL CONST x, y,REAL CONST x size, + y size, direction): + TEXT CONST character :: zeichen [char no]; + INT VAR n :: 1, x0, y0, x1, y1; + INT CONST len :: length (character); + REAL CONST sindir :: sind(direction), + cosdir :: cosd(direction); + WHILE n < len + REP value (character, n, x0, y0, x1, y1); + REAL VAR xr0 :: real(x0), + yr0 :: real(y0), + xr1 :: real(x1), + yr1 :: real(y1); + transform (xr0, yr0, x, y, x size, y size, sindir,cosdir); + transform (xr1, yr1, x, y, x size, y size, sindir,cosdir); + draw (int(xr0),int(yr0 * (x cm * real(y pixel)) / + (y cm * real(x pixel))), + int(xr1),int(yr1 * (x cm * real(y pixel)) / + (y cm * real(x pixel)))); + n INCR 4 + PER . + +END PROC draw char; + +PROC value (TEXT CONST char, INT CONST n, INT VAR x0, y0, x1, y1): + x0 := val (code (char SUB n)); y0 := val (code (char SUB n+1)); + x1 := val (code (char SUB n+2)); y1 := val (code (char SUB n+3)); +END PROC value; + +INT PROC val (INT CONST n): + IF n > 127 + THEN -256 OR n + ELSE n FI +END PROC val; + +PROC transform (REAL VAR x, y,REAL CONST x0, y0,REAL CONST x size, y size, + sindir,cosdir): + REAL CONST old x :: x, old y :: y; + REAL CONST dx :: x size / real(char x) * old x * cosdir - + y size / real(char y) * old y * sindir, + dy :: y size / real(char y) * old y * cosdir + + x size / real(char x) * old x * sindir; + + x := x0 + dx; + y := y0 + dy +END PROC transform; + +PROC draw text (REAL CONST x pos, y pos,TEXT CONST msg, REAL CONST angle, + REAL CONST height, width): + INT VAR i; + REAL VAR x :: x pos, y :: y pos, + x step :: cosd (angle)*width, + y step :: sind (angle)*width; + FOR i FROM 1 UPTO length (msg) + REP IF control char + THEN execute control char + ELSE execute normal char FI + PER . + +control char: + akt char < ""32"" . + +execute control char: + SELECT code (akt char) OF + CASE 1: home + CASE 2: right + CASE 3: up + CASE 7: out (""7"") + CASE 8: left + CASE 10: down + CASE 13: return + ENDSELECT . + +home: + x := x pos; + y := y pos . + +right: + x INCR x step; y INCR y step . + +up: + x INCR y step; y INCR x step . + +left: + x DECR x step; y DECR y step . + +down: + x DECR y step; y DECR x step . + +return: + x := x pos . + +execute normal char: + draw char (code (akt char), x, y, height, width, + angle); + x INCR x step; + y INCR y step . + +akt char: + msg SUB i . + +END PROC draw text; + +PROC draw (TEXT CONST msg): + draw (msg,0.0,5.0,5.0) +END PROC draw; + +PROC draw (TEXT CONST msg,REAL CONST angle,REAL CONST heigth,width): + REAL CONST xr :: real(old x), + yr :: real(old y) / (x cm * real(y pixel)) * + (y cm * real(x pixel)); + draw text (xr,yr,msg,angle,heigth * real(x pixel) / x cm / 10.0, + width * real(x pixel) / x cm / 10.0) + (* heigth mm --> x punkte *) +END PROC draw; + +PROC draw (TEXT CONST msg , REAL CONST winkel, INT CONST hoehe, breite): + draw ( msg, winkel, real(hoehe), real(breite) ) +ENDPROC draw; + +PROC bar ( INT CONST xmin, ymin, xmax, ymax, pattern ) : + (* zur Zeit leer *) +ENDPROC bar; + +PROC circle ( INT CONST x,y, rad, REAL CONST from, to, INT CONST pattern): + (* zur Zeit leer *) +ENDPROC circle; + +END PACKET at plot diff --git a/app/mpg/1987/src/B108PLOT.ELA b/app/mpg/1987/src/B108PLOT.ELA new file mode 100644 index 0000000..1ca301e --- /dev/null +++ b/app/mpg/1987/src/B108PLOT.ELA @@ -0,0 +1,642 @@ +PACKET basis108 plot DEFINES (* M. Staubermann, 22.06.86 *) + drawing area, (* 1.8.0: 09.11.86 *) + begin plot, (* SHard 8: 07.02.87 *) + end plot, + clear, + pen, + move, + draw, + get cursor , + + testbit, fill, trans, + full screen,(* FALSE:Mit Text in den letzten 4 Zeilen *) + visible page, work page, + ctrl word, (* Zugriff auf control word *) + zeichensatz , + get screen , + put screen : + +LET max x = 279 , + max y = 191 , + + hor faktor = 11.2 , { xpixel/cm } + vert faktor = 11.29412 , { ypixel/cm } + + + delete = 0 , + std = 1 , + black = 5 , + white = 6 , + yellow = 7 , +{ lilac = 8 , } + + durchgehend = 1 , + gepunktet = 2 , + kurz gestrichelt = 3 , + lang gestrichelt = 4 , + strichpunkt = 5 , + + onoff bit = 0 , + visible page bit = 1 , + work page bit = 2 , + and bit = 3 , + xor bit = 4 , + size bit = 5 , + pattern bit = 6 , + color bit = 7 ; + + +LET PEN = STRUCT (INT back, fore, thick, line) , + POS = STRUCT (INT x, y) , + ZEICHENSATZ = STRUCT (ROW 255 TEXT char, INT width, height) , + BLOCK = ROW 256 INT ; + +INT CONST ctrl clr :: -3 , + ctrl fill :: -4 , + ctrl move :: -5 , + ctrl draw :: -6 , + ctrl test :: -7 , + ctrl ctrl :: -8 , + ctrl trans:: -9 ; + +ZEICHENSATZ VAR zeichen; (* 4KB *) + +PEN VAR stift ; +POS VAR pos ; +INT VAR r, i, n, work page nr, visible page nr, + line pattern, control word := 0 ; + +visible page (0) ; +work page (0) ; + +clear ; +zeichensatz ("ZEICHEN 6*10") ; + +PROC zeichensatz (TEXT CONST name) : + + IF exists (name) + THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name) ; + zeichen := new zeichen + ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") + FI + +END PROC zeichensatz; + + +PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : + + x cm := 25.0 ; + y cm := 17.0 ; + x pixel := max x ; + y pixel := max y + +END PROC drawing area; + + +PROC begin plot : + setbit (control word, onoff bit) ; + graphic control +ENDPROC begin plot ; + + +PROC end plot : + resetbit (control word, onoff bit) ; + graphic control +ENDPROC end plot ; + + +PROC ctrl word (INT CONST word) : + control word := word ; + graphic control +ENDPROC ctrl word ; + + +INT PROC ctrl word : + control word +ENDPROC ctrl word ; + + +PROC full screen (BOOL CONST true) : + + IF true + THEN resetbit (control word, size bit) + ELSE setbit (control word, size bit) + FI ; + graphic control + +ENDPROC full screen ; + + +PROC fill (INT CONST muster) : +(********************************************************************) +(* *) +(* FILL (muster nummer) *) +(* Fllt eine beliebig (sichtbar) umrandete Flche mit *) +(* dem angegebenen Muster. *) +(* *) +(* Das Muster ist eine 8 x 8 Matrix, die sich auf allen pos MOD 8*) +(* -Adressen wiederholt. *) +(* Im NAND-Modus wird mit dem inversen Muster gefllt, die Flche*) +(* mu dann aber mit unsichtbaren Pixels begrenzt werden. *) +(* *) +(* Folgende Muster sind mglich: *) +(* 0 = 'solid' (alles gefllt) *) +(* 1 = 'lrs2' (jeder zweite Punkt, Zeilenweise versetzt) *) +(* 2 = 'row4' (jede 4. Zeile wird gefllt) *) +(* 3 = 'row2' (jede 2. Zeile wird gefllt) *) +(* 4 = 'col4' (jede 4. Spalte wird gefllt) *) +(* 5 = 'col2' (jede 2. Spalte wird gefllt) *) +(* 6 = 'grid4' (jede 4. Spalte/Zeile wird gefllt) *) +(* 7 = 'grid2' (jede 2. Spalte/Zeile wird gefllt) *) +(* 8 = 'ls4' (Schraffur links unten --> rechts oben, jede 4.) *) +(* 9 = 'rs4' (Schraffur rechts unten --> links oben, jede 4.) *) +(* 10 = 'lrs4' (Schrges Gitter wie 8 und 9 zusammen) *) +(* 11 = 'point2'(In jeder 2. Zeile jeder 2. Punkt) *) +(* 12 = 'wall4' (Mauer, ein Ziegelstein 4 Pixel hoch) *) +(* 13 = 'basket'(Korb/Netz) *) +(* 14 = 'wave4' (Wellenlinie 4 Pixel hoch) *) +(* 15 = 'wave8' (Wellenlinie 8 Pixel hoch) *) +(* *) +(* Falls die zu fllende Flche zu komplex wird, kann es vorkommen,*) +(* da der interne Stack berluft. In diesem Fall wird nicht die *) +(* gesamte Flche gefllt wird. *) +(* *) +(********************************************************************) + control (ctrl fill, muster, 0, r) + +ENDPROC fill ; + + +PROC trans (INT CONST from, to) : +(********************************************************************) +(* *) +(* TRANS (from page, to page) *) +(* Kopiert den Inhalt der Graphikseite 'from page' in die *) +(* Seite 'to page'. Folgende Seitennummern sind mglich: *) +(* *) +(* 0 : Seite 0 kann mit 'visible page (0)' angezeigt werden *) +(* 1 : Seite 1 kann mit 'visible page (1)' angezeigt werden *) +(* 2 : Seite 2 kann nicht sichtbar werden (Hilfsspeicher-Seite) *) +(* 3 : hnlich Seite 2, wird aber bei 'FILL' noch als Arbeits- *) +(* seite benutzt (wird dann berschrieben!) *) +(* *) +(********************************************************************) + + control (ctrl trans, from, to, r) +ENDPROC trans ; + + +BOOL PROC testbit (INT CONST x, y) : +(********************************************************************) +(* *) +(* TEST (x pos, y pos) --> Byte *) +(* Testet den Status eines bestimmten Pixels. *) +(* *) +(* Die Pixelposition wird mit xpos/ypos beschrieben. *) +(* Als Result wird zurckgeliefert: *) +(* 255, falls xpos/ypos auerhalb des sichtbaren Fensters *) +(* liegt. *) +(* Bit 0 = 1: Pixel sichtbar *) +(* Bit 0 = 0: Pixel unsichtbar *) +(* Bit 7 = 1: Pixelfarbe ist hell (gelb) *) +(* Bit 7 = 0: Pixelfarbe ist dunkel (violett) *) +(* *) +(********************************************************************) + + control (ctrl test, x, y, r) ; + bit (r, 0) +ENDPROC testbit ; + + +PROC clear : +(********************************************************************) +(* *) +(* CLR (seite, muster) *) +(* Fllt die angegebene Seite mit dem angegebenen Muster *) +(* *) +(* Bit 7 des Musters bestimmt die Farbe (0 = dunkel, 1 = hell) *) +(* Die anderen 7 Bits werden Spalten- und Zeilenweise wiederholt.*) +(* (128 lscht die Seite mit unsichtbaren Punkten) *) +(* *) +(********************************************************************) + + pos := POS : (0, 0) ; + stift := PEN : (std, std, std, durchgehend) ; + pen (std, std, std, durchgehend) ; (* Standard pen *) + control (ctrl clr, work page nr, control word AND 128, r) ; + +END PROC clear; + + +PROC pen (INT CONST background, foreground, thickness, linetype) : +(********************************************************************) +(* *) +(* CTRL (flags, linienmuster) *) +(* Setzt verschiedene Graphikmodi. *) +(* *) +(* Die Bits im ersten Parameter sind folgendermaen zugeordnet. *) +(* *) +(* Bit 0 : *) +(* 0 = Textmodus einschalten, Graphikmodus ausschalten *) +(* 1 = Graphikmodus einschalten, Textmodus ausschalten *) +(* Bit 1 : *) +(* 0 = Seite 0 als sichtbare Seite whlen *) +(* 1 = Seite 1 als sichtbare Seite whlen *) +(* Bit 2 : *) +(* 0 = Seite 0 als bearbeitete Seite whlen *) +(* 1 = Seite 1 als bearbeitete Seite whlen *) +(* Bit 3, 4 : Verknpfung Patternbit: 0 1 *) +(* 0 OR setzen unverndert *) +(* 1 NAND lschen unverndert *) +(* 2 XOR invertieren unverndert *) +(* 3 COPY lschen setzen *) +(* Bit 5 : *) +(* 0 = Der gesmate Bildschirm zeigt die Graphikseite ('full') *) +(* 1 = In den letzten 32 Graphikzeilen erscheint die Textseite *) +(* Bit 6 : *) +(* 0 = Das im zweiten Parameter bergebene Wort wird als 16-Bit *) +(* Linienmuster eingestellt. Modus siehe Bit 3/4. *) +(* 1 = Das alte (bzw. voreingestellte) Linienmuster wird benutzt*) +(* Bit 7 : *) +(* 0 = Als Punkthelligkeit wird 'dunkel' (bzw. Violett) eingest.*) +(* 1 = Als Punkthelligkeit word 'hell' (bzw. Gelb) eingestellt *) +(* Bit 8..11 : *) +(* 0 = Default-Strichdicke (1) *) +(* 1..15 = Strichdicke (Es werden 2*s-1 Linien parallel ge- *) +(* zeichnet.) *) +(* *) +(* Der zweite Parameter enthlt das 16-Bit Linienmuster. Dieses *) +(* wird beim zeichnen einer Linie zyklisch Bitweise abgetastet. *) +(* Je nach Status des Bits im Linienmuster wird eine Punkt- *) +(* aktion ausgefhrt, deren Wirkung im 1. Parameter mit den Bits *) +(* 3 und 4 spezifiziert wird. *) +(* *) +(********************************************************************) + + INT CONST farbe := abs (foreground) ; + set thickness ; + set linetype ; + set colour ; + graphic control ; + stift := PEN : (background, foreground, abs (thickness), linetype) . + +set colour : + IF farbe = std OR farbe = yellow OR farbe = white + THEN set bit (control word, color bit) + ELSE reset bit (control word, color bit) + FI ; + IF farbe = delete OR farbe = black + THEN set bit (control word, and bit) ; (* RESET *) + reset bit (control word, xor bit) + ELIF foreground < 0 AND thickness >= 0 + THEN set bit (control word, xor bit) ; (* XOR *) + reset bit (control word, and bit) + ELIF foreground < 0 (* AND thickness < 0 *) + THEN set bit (control word, xor bit) ; (* COPY *) + set bit (control word, and bit) + ELSE reset bit (control word, xor bit) ; (* SET *) + reset bit (control word, and bit) + FI . + +set thickness : + control word := (control word AND 255) + 256 * abs (thickness) . + +set linetype: + reset bit (control word, pattern bit) ; (* Pattern neu definieren *) + SELECT linetype OF + CASE durchgehend : line pattern := -1 + CASE gepunktet : line pattern := 21845 + CASE kurz gestrichelt : line pattern := 3855 + CASE lang gestrichelt : line pattern := 255 + CASE strichpunkt : line pattern := 4351 + OTHERWISE : line pattern := line type + END SELECT . + +END PROC pen; + + +PROC move (INT CONST x, y) : +(********************************************************************) +(* *) +(* MOVE (x pos, y pos) *) +(* Setzt den (unsichtbaren) Graphikcursor auf xpos/ypos. *) +(* *) +(* Der nchste 'draw' zeichnet eine Linie beginnend bei xpos/ypos*) +(* *) +(********************************************************************) + + control (ctrl move, x, y, r) ; + pos := POS:(x, y) + +END PROC move; + + +PROC draw (INT CONST x, y) : +(********************************************************************) +(* *) +(* DRAW (x pos, y pos) *) +(* Zeichnet eine Linie zur angegebeben Position xpos/ypos. *) +(* *) +(* Die eingestellten Parameter Helligkeit, Linientyp, Bitver- *) +(* knpfung und Dicke werden beachtet. *) +(* Der nchste 'draw' zeichnet eine Linie beginnend bei xpos/ypos*) +(* *) +(********************************************************************) + + control (ctrl draw, x, y, r) ; + pos := POS : (x, y) . + +END PROC draw; + + +PROC draw (TEXT CONST record, REAL CONST angle, height, width): +{ x fak = width * hor faktor / max width + y fak = heigth * vert faktor / max height + x' = x fak * ( x * cos phi + y * sin phi) + x pos + y' = y fak * (-x * sin phi + y * cos phi) + y pos + x step = x fak * max width * cos phi + y step =-y fak * max height * sin phi } + + REAL CONST sin a :: sind (angle) , + cos a :: cosd (angle) , + x fak :: character width , + y fak :: character height ; + INT CONST xstep :: character x step , + ystep :: character y step ; + + REAL VAR x off r, y off r ; + INT VAR x pos := pos.x , + y pos := pos.y , + x off, y off, i ; + + POS VAR old pos := pos; + FOR i FROM 1 UPTO length (record) REP + draw character i + PER ; + pos := old pos . + +character width: + IF width = 0.0 + THEN 1.0 + ELSE hor faktor * width / real (zeichen.width) + FI . + +character x step: + int (hor faktor * width * cos a + 0.5) . + +character height: + IF height = 0.0 + THEN 1.0 + ELSE vert faktor * height / real (zeichen.height) + FI . + +character y step: + int (- vert faktor * height * sin a + 0.5) . + +draw character i: + IF code (record SUB i) < 32 + THEN steuerzeichen + ELSE normale zeichen + FI . + +steuerzeichen: + SELECT code (record SUB i) OF + CASE 2 : x pos INCR x step ; y pos INCR y step + CASE 3 : x pos DECR x step + CASE 7 : out (""7"") + CASE 8 : x pos DECR x step ; y pos DECR y step + CASE 10 : y pos INCR y step + CASE 13: x pos := pos.x ; y pos := pos.y + END SELECT . + +normale zeichen: + TEXT CONST char :: zeichen.char [code (record SUB i)] ; + INT CONST char len :: LENGTH char DIV 2 ; + IF char len < 2 + THEN LEAVE normale zeichen + FI ; + x off r := real ((char ISUB 1) AND 15) ; + y off r := real ((char ISUB 2) AND 15) ; + move (int (0.5 + x fak * (x off r * cos a + y off r * sin a)) + x pos, + int (0.5 + y fak * (x off r *-sin a + y off r * cos a)) + y pos) ; + + n := 3 ; + WHILE n <= char len REP + x off := char ISUB n ; + n INCR 1 ; + y off := char ISUB n+1 ; + n INCR 1 ; + BOOL CONST to draw := ((x off OR y off) AND 16384) = 0 ; + x off r := real (x off AND 15) ; + y off r := real (y off AND 15) ; + IF to draw + THEN + draw (int (0.5 + x fak * (x off r * cos a + y off r * sin a)) + x pos, + int (0.5 + y fak * (x off r *-sin a + y off r * cos a)) + y pos) + ELSE + move (int (0.5 + x fak * (x off r * cos a + y off r * sin a)) + x pos, + int (0.5 + y fak * (x off r *-sin a + y off r * cos a)) + y pos) + FI + PER ; + + x pos INCR x step ; + y pos INCR y step . + +END PROC draw ; + + +PROC draw (TEXT CONST record) : + draw (record, 0.0, 0.0, 0.0) +END PROC draw; + + +PROC get cursor (TEXT VAR t, INT VAR x, y) : + get cursor (t, x, y, -1, -1, -1, -1) +END PROC get cursor; + + +PROC get cursor (TEXT VAR t, INT VAR x, y, INT CONST x0, y0, x1, y1) : + get cursor (t, x, y, x0, y0, x1, y1, FALSE) +ENDPROC get cursor ; + + +PROC get cursor (TEXT VAR t, INT VAR x, y, INT CONST x0, y0, x1, y1, + BOOL CONST only one key): + BOOL VAR hop key := FALSE ; + t := "" ; + check; + init cursor; + REP set cursor; + get step; + set cursor; + move cursor + UNTIL only one key PER ; + graphic control . + +init cursor: + control (ctrl ctrl, 17 + (control word AND 134), -1, r) ; + INT VAR delta := 1 ; + x := pos.x ; + y := pos.y . + +set cursor: + IF x0 >= 0 AND y0 >= 0 + THEN control (ctrl move, x0, y0, r); + control (ctrl draw, x, y, r) + FI; + IF x1 >= 0 AND y1 >= 0 + THEN control (ctrl move, x1, y1, r); + control (ctrl draw, x, y, r) + FI; + control (ctrl move, x - 4, y, r); + control (ctrl draw, x + 4, y, r); + control (ctrl move, x, y + 4, r); + control (ctrl draw, x, y - 4, r) . + +get step: + hop key := t = ""1"" ; + t := incharety (1); + IF t <> "" + THEN delta INCR 1 + ELSE delta := 1 ; + inchar (t) + FI . + +move cursor: + IF hop key + THEN hop mode + ELSE single key + FI ; + check . + +single key : + SELECT code (t) OF + CASE 1 : + CASE 2, 54 : x INCR delta (* right, '6' *) + CASE 3, 56 : y INCR delta (* up, '8' *) + CASE 8, 52 : x DECR delta (* left, '4' *) + CASE 10, 50 : y DECR delta(* down, '2' *) + CASE 55 : x DECR delta ; y INCR delta (* '7' *) + CASE 57 : x INCR delta ; y INCR delta (* '9' *) + CASE 49 : x DECR delta ; y DECR delta (* '1' *) + CASE 51 : x INCR delta ; y DECR delta (* '3' *) + OTHERWISE leave get cursor ENDSELECT . + +hop mode : + SELECT code (t) OF + CASE 1 : t := "" ; x := 0 ; y := max y ; + CASE 2, 54 : x := max x + CASE 3, 56 : y := max y + CASE 8, 52 : x := 0 + CASE 10, 50 : y := 0 + CASE 55 : x := 0 ; y := max y + CASE 57 : x := max x ; y := max y + CASE 49 : x := 0 ; y := 0 + CASE 51 : x := max x ; y := 0 + OTHERWISE t := ""1"" + t ; leave get cursor ENDSELECT . + +leave get cursor: + control (ctrl move, pos.x, pos.y, r); + graphic control ; + LEAVE get cursor . + +check : + IF x < 0 + THEN x := 0 ; out (""7"") + ELIF x > max x + THEN x := max x ; out (""7"") FI ; + + IF y < 0 + THEN y := 0 ; out (""7"") + ELIF y > max y + THEN y := max y ; out (""7"") FI . + +END PROC get cursor; + + +.graphic control : + control (ctrl ctrl, control word, line pattern, r) . + + +PROC get screen (TEXT CONST name, INT CONST screen nr): + IF exists (name) + THEN get screen (old (name), screen nr) + ELSE get screen (new (name), screen nr) + FI ; +END PROC get screen; + + +PROC get screen (DATASPACE CONST to ds, INT CONST screen nr) : +(********************************************************************) +(* *) +(* BLOCKIN/BLOCKOUT (0, seiten nummer * 16 + block) *) +(* 512 Bytes in/aus dem Graphikspeicher transportieren. *) +(* *) +(* Der zweite Parameter sollte zwischen 0..63 liegen. Als Seiten *) +(* sind also sowohl die 'displayable' 0 und 1, sowie 'temporary' *) +(* 2 und 3 erlaubt. *) +(* *) +(********************************************************************) + + INT CONST page :: screen nr * 16 ; + BOUND ROW 16 BLOCK VAR screen := to ds ; + FOR i FROM 0 UPTO 15 REP + blockin (screen (i+1), 0, page + i, r) + PER + +END PROC get screen; + + +PROC put screen (TEXT CONST name, INT CONST screen nr): + IF exists (name) + THEN put screen (old (name), screen nr) + ELSE errorstop ("Der Datenraum """ + name + """ existiert nicht") FI +END PROC put screen; + + +PROC put screen (DATASPACE CONST from ds, INT CONST screen nr) : + + BOUND ROW 16 BLOCK VAR screen :: from ds ; + INT CONST page :: screen nr * 16 ; + FOR i FROM 0 UPTO 15 REP + block out (screen (i+1), 0, page + i, r) + PER + +END PROC put screen; + + +PROC work page (INT CONST nr) : + + work page nr := nr ; + IF bit (nr, 0) + THEN setbit (control word, work page bit) + ELSE reset bit (control word, work page bit) + FI ; + graphic control + +ENDPROC work page ; + + +PROC visible page (INT CONST nr) : + + visible page nr := nr ; + IF bit (nr, 0) + THEN setbit (control word, visible page bit) + ELSE reset bit (control word, visible page bit) + FI ; + graphic control + +ENDPROC visible page ; + + +INT PROC visible page : + visible page nr +ENDPROC visible page ; + + +INT PROC work page : + work page nr +ENDPROC work page ; + + +END PACKET basis108 plot ; diff --git a/app/mpg/1987/src/BASISPLT.ELA b/app/mpg/1987/src/BASISPLT.ELA new file mode 100644 index 0000000..366f4a6 --- /dev/null +++ b/app/mpg/1987/src/BASISPLT.ELA @@ -0,0 +1,781 @@ +PACKET basis plot DEFINES (* Autor: H. Indenbirken *) + (* Stand: 30.12.84 *) +(********************** Hardwareunabhngiger Teil ************************* +* * +* * +* Im Harwareunabhngigen Paket 'transformation' werden folgende * +* Prozeduren definiert: * +* Procedure : Bedeutung * +* -------------------------------------------------------------------* +* transform  : Sie Prozedur projeziert einen dreidimensionalen * +* Vektor (x,y,z) auf einen zweidimensionalen (h,v)* +* set values  : Mit dieser Prozedur werden die Projektionspara- * +* meter gesetzt. * +* size: Weltkoordinatenbereich * +* ((xmin,xmax),(ymin,ymax),(zmin,zmax)) * +* limits: Zeichenflche * +* ((h min, h max), (v min, v max)) * +* Bei Werten < 2.0 werden die Werte als * +* Prozente interpretiert, ansonsten als * +* cm-Grssen. * +* get values  : bergibt die aktuellen Werte * +* new values  : Vermerkt neue Werte * +* * +* * +* drawing area  : bergibt die aktuelle Zeichengre in Pixel. * +* * +* angles  : a) alpha: Winkel der Y-Achse in Grad * +* b) (x, y, z): karth. Projektionswinkel * +* oblique  : Schiefwinklige Projektion mit dem * +* Normalenvektor (a, b). * +* perspective  : Perspektive mit dem Betrachtungsstandort * +* (x, y, z). * +* window  : siehe set values, size * +* viewport  : siehe set values, limit * +* view  : siehe set values, angle * +* oblique  : Schiefwinklige Projektion * +* orthographic  : Orthografische Projektion * +* perspective  : Perspektivische Projektion * +* * +* * +* box  : Rahmen um die aktuelle Zeichenflche * +* reset  : Lscht alte verdeckte Linien * +* hidden lines  : Unterdrckt verdeckte Linien * +* * +* move  : Positioniert auf (x, y, [z]) in Weltkoordinaten * +* draw  : Zeichnet eine Linie bis zum Punkt (x, y, [z]). * +* move r  : Positioniert (x, y, [z]) weiter * +* draw r  : Zeichnet (x, y, [z]) weiter * +* move cm  : Positioniert auf (x cm, y cm). * +* draw cm  : Zeichnet eine Linie bis (x cm, y cm) * +* move cm r  : Positioniert (x cm, y cm) weiter * +* draw cm r  : Zeichnet (x cm, y cm) weiter * +* * +* bar  : Balken mit (hight, width, pattern) * +* circle  : Kreis(segment) mit (radius, from, to, pattern) * +* * +* where  : Gibt die aktuelle Stiftposition (x, y, [z]) * +* * +* get cursor  : Graphische Eingabe * +* * +* * +****************************************************************************) + + transform, + set values, + get values, + new values, + drawing area, + + window, + viewport, + view, + oblique, + orthographic, + perspective, + + box, + reset, + hidden lines, + + move, + draw, + move r, + draw r, + move cm, + draw cm, + move cm r, + draw cm r, + bar, + circle, + + where: + +BOOL VAR new limits :: TRUE, values new :: TRUE, + perspective projektion :: FALSE; +INT VAR pixel hor, pixel vert; +REAL VAR display hor, display vert, (* Anzahl der Pixel *) + size hor, size vert; (* Groesse des Bildschirms *) +drawing area (size hor, size vert, pixel hor, pixel vert); +display hor := real (pixel hor); display vert := real (pixel vert); + +REAL VAR h min limit :: 0.0, h max limit :: display hor, + v min limit :: 0.0, v max limit :: display vert, + h min :: 0.0, h max :: size hor, + v min :: 0.0, v max :: size vert, + hor relation :: display hor/size hor, + vert relation :: display vert/size vert, + relation :: size hor/size vert; + +ROW 5 ROW 5 REAL VAR p :: ROW 5 ROW 5 REAL : + (ROW 5 REAL : (1.0, 0.0, 0.0, 0.0, 0.0), + ROW 5 REAL : (0.0, 1.0, 0.0, 0.0, 0.0), + ROW 5 REAL : (0.0, 0.0, 1.0, 0.0, 0.0), + ROW 5 REAL : (0.0, 0.0, 0.0, 1.0, 0.0), + ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0)); + +ROW 3 ROW 2 REAL VAR size d :: ROW 3 ROW 2 REAL : + (ROW 2 REAL : (0.0, 1.0), + ROW 2 REAL : (0.0, 1.0), + ROW 2 REAL : (0.0, 1.0)), + last size :: size d; +ROW 2 ROW 2 REAL VAR limits d :: ROW 2 ROW 2 REAL : + (ROW 2 REAL : (0.0, relation), + ROW 2 REAL : (0.0, 1.0)); +ROW 4 REAL VAR angles d :: ROW 4 REAL : (0.0, 0.0, 0.0, 0.0); +ROW 2 REAL VAR oblique d :: ROW 2 REAL : (0.0, 0.0); +ROW 3 REAL VAR perspective d :: ROW 3 REAL : (0.0, 0.0, 0.0); +REAL VAR size hor d := size hor, size vert d := size vert; +INT VAR pixel hor d := pixel hor, pixel vert d := pixel vert; + +INT VAR i, j, k; + +BOOL OP = (ROW 3 ROW 2 REAL CONST l, r): + FOR i FROM 1 UPTO 3 + REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2] + THEN LEAVE = WITH FALSE FI + PER; + TRUE +END OP =; + +BOOL OP = (ROW 2 ROW 2 REAL CONST l, r): + FOR i FROM 1 UPTO 2 + REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2] + THEN LEAVE = WITH FALSE FI + PER; + TRUE +END OP =; + +BOOL OP = (ROW 2 REAL CONST l, r): + l [1] = r [1] AND l [2] = r [2] +END OP =; + +BOOL OP = (ROW 3 REAL CONST l, r): + l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3] +END OP =; + +BOOL OP = (ROW 4 REAL CONST l, r): + l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3] AND l [4] = r [4] +END OP =; + +PROC oblique (REAL CONST a, b) : + set values (size d, limits d, angles d, ROW 2 REAL : (a, b), ROW 3 REAL : (0.0, 0.0, 0.0)) +END PROC oblique; + +PROC orthographic : + set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (0.0, 0.0, 0.0)) +END PROC orthographic; + +PROC perspective (REAL CONST cx, cy, cz) : + set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (cx, cy, cz)) +END PROC perspective; + +PROC window (BOOL CONST dev) : + new limits := dev +END PROC window; + +PROC window (REAL CONST x min, x max, y min, y max) : + window (x min, x max, y min, y max, 0.0, 1.0) +END PROC window; + +PROC window (REAL CONST x min, x max, y min, y max, z min, z max) : + set values (ROW 3 ROW 2 REAL : (ROW 2 REAL : (x min, x max), + ROW 2 REAL : (y min, y max), + ROW 2 REAL : (z min, z max)), + limits d, angles d, oblique d, perspective d) +END PROC window; + +PROC viewport (REAL CONST h min, h max, v min, v max) : + set values (size d, ROW 2 ROW 2 REAL : (ROW 2 REAL : (h min, h max), + ROW 2 REAL : (v min, v max)), + angles d, oblique d, perspective d) +END PROC view port; + +PROC view (REAL CONST alpha) : + set values (size d, limits d, ROW 4 REAL : (alpha, angles d(2), angles d (3), angles d (4)), + oblique d, perspective d) +END PROC view; + +PROC view (REAL CONST phi, theta) : + set values (size d, limits d, ROW 4 REAL : (angles d(1), sind (theta) * cosd (phi), + sind (theta) * sind (phi), cosd (theta)), + oblique d, perspective d) +END PROC view; + +PROC view (REAL CONST x, y, z) : + set values (size d, limits d, ROW 4 REAL : (angles d (1), x, y, z), oblique d, perspective d) +END PROC view; + +set values (size d, limits d, angles d, oblique d, perspective d); + +PROC drawing area (REAL VAR min h, max h, min v, max v): + min h := h min limit; max h := h max limit; + min v := v min limit; max v := v max limit +END PROC drawing area; + +BOOL PROC new values: + IF values new + THEN values new := FALSE; + TRUE + ELSE FALSE FI +END PROC new values; + +PROC get values (ROW 3 ROW 2 REAL VAR size, + ROW 2 ROW 2 REAL VAR limits, + ROW 4 REAL VAR angles, + ROW 2 REAL VAR oblique, + ROW 3 REAL VAR perspective) : + size := size d; + limits := limits d; + angles := angles d; + oblique := oblique d; + perspective := perspective d; + +END PROC get values; + +PROC set values (ROW 3 ROW 2 REAL CONST size, + ROW 2 ROW 2 REAL CONST limits, + ROW 4 REAL CONST angles, + ROW 2 REAL CONST oblique, + ROW 3 REAL CONST perspective) : + drawing area (size hor, size vert, pixel hor, pixel vert); + display hor := real (pixel hor); display vert := real (pixel vert); + IF NOT same values + THEN values new := TRUE; + copy values; + set views; + check perspective projektion; + calc limits; + change projektion + FI . + +same values: + size hor d = size hor AND size vert d = size vert AND + pixel hor d = pixel hor AND pixel vert d = pixel vert AND + size d = size AND limits d = limits AND angles d = angles AND + oblique d = oblique AND perspective d = perspective . + +copy values : + size hor d := size hor; + size vert d := size vert; + pixel hor d := pixel hor; + pixel vert d := pixel vert; + size d := size; + limits d := limits; + angles d := angles; + oblique d := oblique; + perspective d := perspective . + +set views : + REAL VAR diagonale := sqrt (angles [2] * angles [2] + + angles [3] * angles [3] + + angles [4] * angles [4]), + projektion := sqrt (angles [2] * angles [2] + + angles [4] * angles [4]), + sin p, cos p, sin t, cos t, sin a, cos a; + + IF diagonale = 0.0 + THEN sin p := 0.0; cos p := 1.0; + sin t := 0.0; cos t := 1.0 + ELIF projektion = 0.0 + THEN sin p := angles [3] / diagonale; + cos p := projektion / diagonale; + sin t := 0.0; cos t := 1.0 + ELSE sin p := angles [3] / diagonale; + cos p := projektion / diagonale; + sin t := angles [2] / projektion; + cos t := angles [4] / projektion + FI; + + REAL VAR sin p sin t := sin p * sin t, + sin p cos t := sin p * cos t, + cos p sin t := cos p * sin t, + cos p cos t := cos p * cos t, + + dx := size [1][2] - size [1][1], + dy := size [2][2] - size [2][1], + dz := size [3][2] - size [3][1], + norm az := oblique [1] , + norm bz := oblique [2] , + norm cx := perspective [1] / dx, + norm cy := perspective [2] / dy, + norm cz := perspective [3] / dz, + xx := - size [1][1] / dx * cos p sin t - + size [2][1] / dy * sin p + + size [3][1] / dz * cos p cos t; + +p := ROW 5 ROW 5 REAL : + (ROW 5 REAL : ( cos t / dx - cos p sin t / dx * norm az , + - sin p sin t / dx - cos p sin t / dx * norm bz, + 0.0, + - cos p sin t / dx * norm cz, + 0.0 ), + ROW 5 REAL : ( - sin p / dy * norm az, + cos p / dy - sin p / dy * norm bz, + 0.0, + - sin p / dy * norm cz, + 0.0 ), + ROW 5 REAL : ( sin t / dz + cos p cos t / dz * norm az, + + sin p cos t / dz + cos p cos t / dz * norm bz, + 0.0, + cos p cos t / dz * norm cz, + 0.0 ), + ROW 5 REAL : (- norm cx, - norm cy, 0.0, 1.0, 0.0 ), + ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0)); + + IF angles (1) = 0.0 + THEN set alpha as y vertical + ELSE sin a := sind (angles (1)); + cos a := cosd (angles (1)) + FI; + + FOR j FROM 1 UPTO 5 + REP REAL CONST p j 1 := p (j)(1); + p (j)(1) := p j 1 * cos a - p (j)(2) * sin a; + p (j)(2) := p j 1 * sin a + p (j)(2) * cos a + PER . + +set alpha as y vertical : + REAL VAR r := sqrt (p(2)(1)**2 + p(2)(2)**2); + IF r = 0.0 + THEN sin a := 0.0; + cos a := 1.0 + ELSE sin a :=-p(2)(1)/r; + cos a := p(2)(2)/r + FI . + +check perspective projektion: + perspective projektion := perspective [3] <> 0.0 . + +calc limits : + IF new limits + THEN calc two dim extrema; + IF all limits smaller than 2 + THEN prozente + ELSE zentimeter FI + FI . + +calc two dim extrema : + h min := max real; h max :=-max real; + v min := max real; v max :=-max real; + + extrema (size [1][1], size [2][1], size [3][1], h min, h max, v min, v max); + extrema (size [1][2], size [2][1], size [3][1], h min, h max, v min, v max); + extrema (size [1][2], size [2][2], size [3][1], h min, h max, v min, v max); + extrema (size [1][1], size [2][2], size [3][1], h min, h max, v min, v max); + extrema (size [1][1], size [2][1], size [3][2], h min, h max, v min, v max); + extrema (size [1][2], size [2][1], size [3][2], h min, h max, v min, v max); + extrema (size [1][2], size [2][2], size [3][2], h min, h max, v min, v max); + extrema (size [1][1], size [2][2], size [3][2], h min, h max, v min, v max) . + +all limits smaller than 2 : + limits (1)(2) < 2.0 AND limits (2)(2) < 2.0 . + +prozente : + h min limit := display hor * limits (1)(1)/relation; + h max limit := display hor * limits (1)(2)/relation; + + v min limit := limits (2)(1) * display vert; + v max limit := limits (2)(2) * display vert . + +zentimeter : + h min limit := display hor * (limits (1)(1)/size hor); + h max limit := display hor * (limits (1)(2)/size hor); + + v min limit := display vert * (limits (2)(1)/size vert); + v max limit := display vert * (limits (2)(2)/size vert) . + +change projektion : + REAL VAR sh := (h max limit - h min limit) / (h max - h min), + sv := (v max limit - v min limit) / (v max - v min), + dh := h min limit - h min*sh, + dv := v min limit - v min*sv; + + FOR j FROM 1 UPTO 5 + REP + p (j)(1) := p (j)(1) * sh; + p (j)(2) := p (j)(2) * sv + PER; + p (5)(1) := dh; + p (5)(2) := dv. +END PROC set values; + +PROC transform (REAL CONST x, y, z, INT VAR h, v) : + disable stop; + IF perspective projektion + THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0); + h := int ((x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (4)(1))*w + p (5)(1)); + v := int ((x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (4)(2))*w + p (5)(2)) + ELSE h := int (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (5)(1)); + v := int (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (5)(2)); + FI; + IF is error + THEN h := -1; + v := -1; + clear error + FI +END PROC transform; + +PROC extrema (REAL CONST x, y, z, REAL VAR h min, h max, v min, v max): + REAL VAR h, v; + IF perspective projektion + THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0); + h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) +p (4)(1))*w; + v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) +p (4)(2))*w + ELSE h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1)); + v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2)) + FI; + + IF h < h min + THEN h min := h + ELIF h > h max + THEN h max := h FI; + + IF v < v min + THEN v min := v + ELIF v > v max + THEN v max := v FI + +END PROC extrema; + +(**************************** Plot Prozeduren ****************************) +LET empty = 0, {Punktmuster} + half = 1, + full = 2, + horizontal = 3, + vertical = 4, + cross = 5, + diagonal right = 6, + diagonal left = 7, + diagonal both = 8; + +LET POS = STRUCT (REAL x, y, z); +POS VAR pos :: POS : (0.0, 0.0, 0.0); +INT VAR h :: 0, v :: 0, new h :: 0, new v :: 0; +BOOL VAR hidden :: FALSE; +DATASPACE VAR ds :: nilspace; +BOUND STRUCT (ROW 32764 INT akt, last) VAR maxima :: ds; + + +PROC box : + move (int (h min limit+0.5), int (v min limit+0.5)); + draw (int (h max limit+0.5), int (v min limit+0.5)); + draw (int (h max limit+0.5), int (v max limit+0.5)); + draw (int (h min limit+0.5), int (v max limit+0.5)); + draw (int (h min limit+0.5), int (v min limit+0.5)) +END PROC box; + +PROC reset: + forget (ds); + ds := nilspace; + maxima := ds +END PROC reset; + +PROC move (REAL CONST x, y) : + IF hidden + THEN maxima.last := maxima.akt FI; + + transform (x, y, 0.0, h, v); + move (h, v); + pos := POS : (x, y, 0.0) +END PROC move; + +PROC move (REAL CONST x, y, z) : + IF hidden + THEN maxima.last := maxima.akt FI; + + transform (x, y, z, h, v); + move (h, v); + pos := POS : (x, y, z) +END PROC move; + +PROC draw (REAL CONST x, y) : + IF hidden + THEN transform (x, y, 0.0, new h, new v); + vector (new h-h, new v-v) + ELSE transform (x, y, 0.0, h, v); + draw (h, v) + FI; + pos := POS : (x, y, 0.0) +END PROC draw; + +PROC draw (REAL CONST x, y, z) : + IF hidden + THEN transform (x, y, z, new h, new v); + vector (new h-h, new v-v) + ELSE transform (x, y, z, h, v); + draw (h, v) + FI; + pos := POS : (x, y, z) +END PROC draw; + +PROC move r (REAL CONST x, y) : + IF hidden + THEN maxima.last := maxima.akt FI; + + transform (pos.x+x, pos.y+y, pos.z, h, v); + move (h, v); + pos := POS : (pos.x+x, pos.y+y, pos.z) +END PROC move r; + +PROC move r (REAL CONST x, y, z) : + IF hidden + THEN maxima.last := maxima.akt FI; + + transform (pos.x+x, pos.y+y, pos.z+z, h, v); + move (h, v); + pos := POS : (pos.x+x, pos.y+y, pos.z+z) +END PROC move r; + +PROC draw r (REAL CONST x, y) : + IF hidden + THEN transform (pos.x+x, pos.y+y, pos.z, h, v); + vector (new h-h, new v-v) + ELSE transform (pos.x+x, pos.y+y, pos.z, h, v); + draw (h, v) + FI; + pos := POS : (pos.x+x, pos.y+y, pos.z) +END PROC draw r; + +PROC draw r (REAL CONST x, y, z) : + IF hidden + THEN transform (pos.x+x, pos.y+y, pos.z+z, h, v); + vector (new h-h, new v-v) + ELSE transform (pos.x+x, pos.y+y, pos.z+z, h, v); + draw (h, v) + FI; + pos := POS : (pos.x+x, pos.y+y, pos.z+z) +END PROC draw r; + +PROC move cm (REAL CONST x cm, y cm) : + IF hidden + THEN maxima.last := maxima.akt FI; + + h := int (x cm*hor relation+0.5); + v := int (y cm*vert relation+0.5); + move (h, v) +END PROC move cm; + +PROC draw cm (REAL CONST x cm, y cm) : + IF hidden + THEN vector (int (x cm*hor relation+0.5)-h, int (y cm*vert relation+0.5)-v) + ELSE h := int (x cm*hor relation+0.5); + v := int (y cm*vert relation+0.5); + draw (h, v) + FI +END PROC draw cm; + +PROC move cm r (REAL CONST x cm, y cm) : + IF hidden + THEN maxima.last := maxima.akt FI; + + h INCR int (x cm*hor relation+0.5); + v INCR int (y cm*vert relation+0.5); + move (h, v) +END PROC move cm r; + +PROC draw cm r (REAL CONST x cm, y cm) : + IF hidden + THEN vector (int (x cm*hor relation+0.5), int (y cm*vert relation+0.5)) + ELSE h INCR int (x cm*hor relation+0.5); + v INCR int (y cm*vert relation+0.5); + draw (h, v) + FI +END PROC draw cm r; + +PROC hidden lines (BOOL CONST dev): + hidden := NOT dev; +END PROC hidden lines; + +PROC vector (INT CONST dx, dy): + IF dx >= 0 + THEN IF dy > dx THEN vector (v, h, dy, dx, 1, 1) + ELIF dy > 0 THEN vector (h, v, dx, dy, 1, 1) + + ELIF dy > -dx THEN vector (h, v, dx, -dy, 1,-1) + ELSE vector (v, h, -dy, dx,-1, 1) FI + + ELSE IF dy > -dx THEN vector (v, h, dy, -dx, 1,-1) + ELIF dy > 0 THEN vector (h, v, -dx, dy,-1, 1) + + ELIF dy > dx THEN vector (h, v, -dx, -dy,-1,-1) + ELSE vector (v, h, -dy, -dx,-1,-1) FI + FI . + +ENDPROC vector ; + +PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) : + INT VAR i; + prepare first step ; + draw point; + FOR i FROM 1 UPTO dx + REP do one step PER; + + IF was visible + THEN draw (h, v) FI . + + +prepare first step : + INT VAR up right error := dy - dx, + right error := dy, + old error := 0, + last h :: h, last v :: v; + BOOL VAR was visible :: visible . + + +do one step: + IF right is better + THEN do right step + ELSE do up right step + FI . + +right is better : + abs (old error + right error) < abs (old error + up right error) . + +do upright step : + x pos INCR right ; + y pos INCR up ; + draw point ; + old error INCR upright error . + +do right step : + x pos INCR right ; + draw point ; + old error INCR right error . + +draw point : + IF was visible + THEN IF NOT visible + THEN draw (last h, last v); + was visible := FALSE + FI; + last h := h; + last v := v + ELSE IF visible + THEN move (h, v); + was visible := TRUE; + last h := h; + last v := v + FI + FI . + +visible: + IF h < 1 OR h > pixel hor + THEN FALSE + ELSE IF maxima.akt [h] < v + THEN maxima.akt [h] := v FI; + v > maxima.last [h] + FI +END PROC vector; + +PROC where (REAL VAR x, y) : + x := pos.x; y := pos.y +END PROC where; + +PROC where (REAL VAR x, y, z) : + x := pos.x; y := pos.y; z := pos.z +END PROC where; + +PROC bar (REAL CONST hight, width, INT CONST pattern): + INT VAR zero x, zero y, end x, end y; + transform (0.0, 0.0, 0.0, zero x, zero y); + transform (width, hight, 0.0, end x, end y); + bar (h-(end x-zero x) DIV 2, v, end x-zero x, end y-zero y, pattern) +END PROC bar; + +PROC bar (INT CONST from x, from y, width, hight, pattern): + INT CONST to x :: from x+width, to y :: from y+hight; + INT VAR x, y; + draw frame; + SELECT pattern OF + CASE empty: (* nothing to do *) + CASE half: half bar + CASE full: full bar + CASE horizontal: horizontal bar + CASE vertical: vertical bar + CASE cross: horizontal bar; + vertical bar + CASE diagonal right: diagonal right bar + CASE diagonal left: diagonal left bar + CASE diagonal both: diagonal both bar + OTHERWISE errorstop ("Unknown pattern") ENDSELECT . + +draw frame: + move (from x, from y); + draw (from x, to y); + draw (to x, to y); + draw (to x, from y) . + +full bar: + FOR y FROM from y UPTO to y + REP move (from x, y); + draw (to x, y) + PER . + +half bar: + FOR y FROM from y UPTO to y + REP x := from x + 1 + (y AND 1); + WHILE x < to x + REP move (x, y); + draw (x, y); + x INCR 2 + PER + PER . + +horizontal bar: + y := from y; + WHILE y < to y + REP move (from x, y); + draw (to x, y); + y INCR 5 + PER . + +vertical bar: + x := from x + 5; + WHILE x < to x + REP move (x, from y); + draw (x, to y); + x INCR 5 + PER . + +diagonal right bar: + y := from y-width+5; + WHILE y < to y + REP move (max (from x, to x-y-width+from y), max (from y, y)); + draw (min (to x, from x+to y-y), min (to y, y+width)); + y INCR 5 + PER . + +diagonal left bar: + y := from y-width+5; + WHILE y < to y + REP move (min (to x, to x-from y+y), max (from y, y)); + draw (max (from x, from x+y+width-to y), min (to y, y+width)); + y INCR 5 + PER . + +diagonal both bar: + y := from y-width+5; + WHILE y < to y + REP move (max (from x, to x-y-width+from y), max (from y, y)); + draw (min (to x, from x+to y-y), min (to y, y+width)); + move (min (to x, to x-from y+y), max (from y, y)); + draw (max (from x, from x+y+width-to y), min (to y, y+width)); + y INCR 5 + PER . + +END PROC bar; + +PROC circle (REAL CONST r, from, to, INT CONST pattern): + REAL VAR t :: from; + WHILE t < to + REP transform (pos.x + r*cosd (t), pos.y + r*sind (t), 0.0, h, v); + draw (h, v); + t INCR 1.0 + PER; + transform (pos.x, pos.y, 0.0, h, v); + draw (h, v) . + +END PROC circle; + +ENDPACKET basis plot; diff --git a/app/mpg/1987/src/DIPCHIPS.DS b/app/mpg/1987/src/DIPCHIPS.DS new file mode 100644 index 0000000..2cdd8e9 Binary files /dev/null and b/app/mpg/1987/src/DIPCHIPS.DS differ diff --git a/app/mpg/1987/src/FUPLOT.ELA b/app/mpg/1987/src/FUPLOT.ELA new file mode 100644 index 0000000..1d0d247 --- /dev/null +++ b/app/mpg/1987/src/FUPLOT.ELA @@ -0,0 +1,319 @@ +PACKET fuplot DEFINES axis, (*Autor : H.Indenbirken *) + plot, (*Stand : 23.02.85 *) + cube: + +PICTURE VAR pic; +TEXT VAR value text; + +PICTURE PROC cube (REAL CONST x min, x max, INT CONST no x, + REAL CONST y min, y max, INT CONST no y, + REAL CONST z min, z max, INT CONST no z): + cube (x min, x max, (x max-x min)/real (no x), + y min, y max, (y max-y min)/real (no y), + z min, z max, (z min-z max)/real (no z)) +END PROC cube; + +PICTURE PROC cube (REAL CONST x min, x max, dx, y min, y max, dy, z min, z max, dz): + pic := cube (x min, x max, y min, y max, z min, z max); + move (pic, x max, y min, z min); draw (pic, text (x max)); + move (pic, x min, y max, z min); draw (pic, text (y max)); + move (pic, x min, y min, z max); draw (pic, text (z max)); + + draw tabs (pic, x min, y min, z min, x max, y min, z min, dx, 0.0, 0.0); + draw tabs (pic, x min, y min, z min, x min, y max, z min, 0.0, dy, 0.0); + draw tabs (pic, x min, y min, z min, x min, y min, z max, 0.0, 0.0, dx); + pic +END PROC cube; + +PICTURE PROC cube (REAL CONST x min, x max, y min, y max, z min, z max): + pic := nilpicture; + move (pic, x min, y min, z min); + draw (pic, x max, y min, z min); + draw (pic, x max, y max, z min); + draw (pic, x min, y max, z min); + draw (pic, x min, y min, z min); + + move (pic, x min, y min, z max); + draw (pic, x max, y min, z max); + draw (pic, x max, y max, z max); + draw (pic, x min, y max, z max); + draw (pic, x min, y min, z max); + + move (pic, x min, y min, z min); + draw (pic, x min, y min, z max); + + move (pic, x max, y min, z min); + draw (pic, x max, y min, z max); + + move (pic, x max, y max, z min); + draw (pic, x max, y max, z max); + + move (pic, x min, y max, z min); + draw (pic, x min, y max, z max); + pic + +END PROC cube; + +PICTURE PROC axis (REAL CONST x min, x max, INT CONST no x, + REAL CONST y min, y max, INT CONST no y) : + axis (x min, x max, (x max-x min) / real (no x - 1), + y min, y max, (y max-y min) / real (no y - 1)) +END PROC axis; + +PICTURE PROC axis (REAL CONST x min, x max, dx, y min, y max, dy) : + REAL CONST x diff :: x max - x min, + y diff :: y max - y min; + pic := nilpicture; + calc axis pos; + IF dx > 0.0 + THEN x axis FI; + IF dy > 0.0 + THEN y axis FI; + pic . + +calc axis pos : + REAL VAR x0, y0; + IF x min < 0.0 AND x max < 0.0 + THEN y0 := y max + ELIF x min > 0.0 AND x max > 0.0 + THEN y0 := y max + ELSE y0 := 0.0 FI; + + IF y min < 0.0 AND y max < 0.0 + THEN x0 := x max + ELIF y min > 0.0 AND y max > 0.0 + THEN x0 := x max + ELSE x0 := 0.0 FI . + +x axis : + move (pic, x max, y0); + move cm r (pic, 0.1, -0.3); + draw (pic, "X"); + + draw tabs (pic, x0,y0, x max,y0, dx,0.0); + value text := text (x max); + draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text); + + draw tabs (pic, x0,y0, x min,y0,-dx,0.0); + value text := text (x min); + draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text) . + +y axis : + move (pic, x0, y max); + move cm r (pic, -0.18, 0.1); + draw (pic, "Y"); + + draw tabs (pic, x0,y0, x0,y max, 0.0, dy); + value text := text (y max); + draw (pic, length (value text) * ""8"" + value text); + + draw tabs (pic, x0,y0, x0,y min, 0.0,-dy); + value text := text (y min); + draw (pic, length (value text) * ""8"" + value text) . + +END PROC axis; + +PROC draw tabs (PICTURE VAR pic, REAL CONST x0,y0, x1,y1, dx,dy) : + move (pic, x0, y0); + draw (pic, x1, y1); + + REAL VAR x :: x0, y :: y0; + INT VAR i :: 0; + WHILE abs (x) <= abs (x1) AND abs (y) <= abs (y1) + REP move (pic, x, y); + IF dx <> 0.0 + THEN draw cm r (pic, 0.0, size) + ELIF dy <> 0.0 + THEN draw cm r (pic, size, 0.0) FI; + i INCR 1; + x INCR dx; y INCR dy + PER . + +size: + IF i MOD 10 = 0 + THEN -0.75 + ELIF i MOD 5 = 0 + THEN -0.5 + ELSE -0.3 FI . + +END PROC draw tabs; + +PICTURE PROC axis (REAL CONST x min, x max, INT CONST no x, + REAL CONST y min, y max, INT CONST no y, + REAL CONST z min, z max, INT CONST no z) : + axis (x min, x max, (x max-x min) / real (no x - 1), + y min, y max, (y max-y min) / real (no y - 1), + z min, z max, (z max-z min) / real (no z - 1)) +END PROC axis; + +PICTURE PROC axis (REAL CONST x min, x max, dx, + y min, y max, dy, + z min, z max, dz) : + REAL CONST x diff :: x max - x min, + y diff :: y max - y min, + z diff :: z max - z min; + pic := nilpicture; + calc axis pos; + IF dx > 0.0 + THEN x axis FI; + IF dy > 0.0 + THEN y axis FI; + IF dz > 0.0 + THEN z axis FI; + pic . + +calc axis pos : + REAL VAR x0, y0, z0; + IF x min < 0.0 AND x max < 0.0 + THEN y0 := y max + ELIF x min > 0.0 AND x max > 0.0 + THEN y0 := y max + ELSE y0 := 0.0 FI; + + IF y min < 0.0 AND y max < 0.0 + THEN x0 := x max + ELIF y min > 0.0 AND y max > 0.0 + THEN x0 := x max + ELSE x0 := 0.0 FI; + + IF z min < 0.0 AND z max < 0.0 + THEN z0 := z max + ELIF z min > 0.0 AND z max > 0.0 + THEN z0 := z max + ELSE z0 := 0.0 FI . + +x axis : + move (pic, x max, y0, z0); + move cm r (pic, 0.1, -0.3); + draw (pic, "X"); + + draw tabs (pic, x0,y0,z0, x max,y0,z0, dx,0.0,0.0); + value text := text (x max); + draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text); + + draw tabs (pic, x0,y0,z0, x min,y0,z0,-dx,0.0,0.0); + value text := text (x min); + draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text) . + +y axis : + move (pic, x0, y max, z0); + move cm r (pic, -0.18, -0.1); + draw (pic, "Y"); + + draw tabs (pic, x0,y0,z0, x0,y max,z0, 0.0, dy,0.0); + value text := text (y max); + draw (pic, length (value text) * ""8"" + value text); + + draw tabs (pic, x0,y0,z0, x0,y min,z0, 0.0,-dy,0.0); + value text := text (y min); + draw (pic, length (value text) * ""8"" + value text) . + +z axis : + move (pic, x0, y0, z max); + move cm r (pic, 0.1, -0.3); + draw (pic, "Z"); + + draw tabs (pic, x0,y0,z0, x0,y0,z max, 0.0,0.0, dz); + value text := text (z max); + draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text); + + draw tabs (pic, x0,y0,z0, x0,y0,z min, 0.0,0.0,-dz); + value text := text (z min); + draw (pic, (length (value text) DIV 2) * ""8"" + ""10"" + value text) . + +END PROC axis; + +PROC draw tabs (PICTURE VAR pic, REAL CONST x0,y0,z0, x1,y1,z1, dx,dy,dz) : + move (pic, x0, y0, z0); + draw (pic, x1, y1, z1); + + REAL VAR x :: x0, y :: y0, z :: z0; + INT VAR i :: 0; + WHILE abs (x) <= abs (x1) AND abs (y) <= abs (y1) AND abs (z) <= abs (z1) + REP move (pic, x, y, z); + IF dx <> 0.0 + THEN draw cm r (pic, 0.0, size); + ELIF dy <> 0.0 + THEN draw cm r (pic, size, 0.0); + ELIF dz <> 0.0 + THEN draw cm r (pic, 0.0, size) FI; + i INCR 1; + x INCR dx; y INCR dy; z INCR dz + PER . + +size: + IF i MOD 10 = 0 + THEN -0.75 + ELIF i MOD 5 = 0 + THEN -0.5 + ELSE -0.3 FI . + +END PROC draw tabs; + +PROC plot (PICFILE VAR p, REAL PROC (REAL CONST, REAL CONST) f, + REAL CONST x min, x max, INT CONST pixel x, + REAL CONST z min, z max, INT CONST pixel z) : + plot (p, PROC f, 1, x min, x max, (x max-x min) / real (pixel x), + z min, z max, (z max-z min) / real (pixel z)) +END PROC plot; + +PROC plot (PICFILE VAR p, REAL PROC (REAL CONST, REAL CONST) f, INT CONST pen, + REAL CONST x min, x max, INT CONST pixel x, + REAL CONST z min, z max, INT CONST pixel z) : + plot (p, PROC f, pen, x min, x max, (x max-x min) / real (pixel x), + z min, z max, (z max-z min) / real (pixel z)) +END PROC plot; + +PROC plot (PICFILE VAR p, REAL PROC (REAL CONST, REAL CONST) f, + REAL CONST x min, x max, dx, + REAL CONST z min, z max, dz) : + plot (p, PROC f, 1, x min, x max, dx, z min, z max, dz) +END PROC plot; + +PROC plot (PICFILE VAR p, REAL PROC (REAL CONST, REAL CONST) f, INT CONST n, + REAL CONST x min, x max, dx, + REAL CONST z min, z max, dz) : + REAL VAR z := z min; + line; + WHILE z <= z max + REP out (""13""5"Ebene: " + text (z)); + pic := plot (PROC f, x min, x max, dx, z); + pen (pic, n); + put picture (p, pic); + z INCR dz + PER . + +END PROC plot; + +PICTURE PROC plot (REAL PROC (REAL CONST, REAL CONST) f, + REAL CONST x min, x max, dx, z): + pic := nilpicture; + REAL VAR x := x min; + move (pic, x, f (x, z), z); + WHILE x < x max + REP x INCR dx; + draw (pic, x, f (x, z), z); + PER; + draw (pic, x, f (x, z), z); + pic . + +END PROC plot; + +PICTURE PROC plot (REAL PROC (REAL CONST) f, + REAL CONST x min, x max, INT CONST pixel) : + plot (PROC f, x min, x max, (x max-x min) / real (pixel)) +END PROC plot; + +PICTURE PROC plot (REAL PROC (REAL CONST) f, REAL CONST x min, x max, dx) : + PICTURE VAR pic :: nilpicture; + REAL VAR x := x min; + move (pic, x, f (x)); + WHILE x < x max + REP x INCR dx; + draw (pic, x, f (x)); + PER; + draw (pic, x, f (x)); + pic +END PROC plot; + +END PACKET fuplot diff --git a/app/mpg/1987/src/GRAPHIK.Basis b/app/mpg/1987/src/GRAPHIK.Basis new file mode 100644 index 0000000..62cb790 --- /dev/null +++ b/app/mpg/1987/src/GRAPHIK.Basis @@ -0,0 +1,1573 @@ +(**************************************************************************) +(* *) +(* MPG - Graphik - System *) +(* *) +(* Version 2.2 vom 23.09.1987 *) +(* *) +(* (c) 1987 Beat Jegerlehner & Carsten Weinholz *) +(* unter Verwendung der Standard-Graphik *) +(* "Graphik-Basis" geschrieben von C.Weinholz/EUMEL-Std *) +(* *) +(**************************************************************************) +(* *) +(* Paket I: Endgeraet-unabhaengige Graphikroutinen *) +(* *) +(* 1. Transformation (Umsetzung 3D -> 2D), *) +(* Clipping und Normierung *) +(* 2. PICTURE - Verwaltung *) +(* (geanderte Standard-Version) *) +(* 3. PICFILE - Verwaltung *) +(* (geanderte Standard-Version) *) +(* 4. Endgeraet - Verwaltung *) +(* *) +(**************************************************************************) +(* Urversion : 10.09.87 *) +(* Aenderungen: 23.09.87, Carsten Weinholz *) +(* OP := (PICFILE VAR, PICFILE CONST) hinzugefuegt *) +(* TEXT PROC text (PICTURE CONST) *) +(* wg. Heapueberlauf geaendert *) +(* *) +(**************************************************************************) + +(****************************** transformation ****************************) + +PACKET transformation DEFINES + transform, + set values, + get values, + new values, + drawing area, + set drawing area, + + window, + viewport, + view, + oblique, + orthographic, + perspective, + + clipped line: + +BOOL VAR new limits :: TRUE, + values new :: TRUE, + perspective projektion :: FALSE; + +REAL VAR display hor, display vert, (* Anzahl der Pixel *) + size hor, size vert, (* Groesse des Bildschirms *) + size hor d, size vert d, + h min limit, h max limit, + v min limit, v max limit, + h min, h max, + v min, v max, + relation; + +ROW 5 ROW 5 REAL VAR p ; +ROW 3 ROW 2 REAL VAR size d ; +ROW 2 ROW 2 REAL VAR limits d ; +ROW 4 REAL VAR angles d ; +ROW 2 REAL VAR oblique d ; +ROW 3 REAL VAR perspective d ; + +INT VAR i, j; + +PROC init transformation rows: + size d := ROW 3 ROW 2 REAL : (ROW 2 REAL : (0.0, 1.0), + ROW 2 REAL : (0.0, 1.0), + ROW 2 REAL : (0.0, 1.0)); + + limits d := ROW 2 ROW 2 REAL : (ROW 2 REAL : (0.0, relation), + ROW 2 REAL : (0.0, 1.0)); + + angles d := ROW 4 REAL : (0.0, 0.0, 0.0, 0.0); + + oblique d := ROW 2 REAL : (0.0, 0.0); + + perspective d := ROW 3 REAL : (0.0, 0.0, 0.0); + set values (size d, limits d, angles d, oblique d, perspective d); +END PROC init transformation rows; + +BOOL OP = (ROW 3 ROW 2 REAL CONST l, r): + FOR i FROM 1 UPTO 3 + REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2] + THEN LEAVE = WITH FALSE FI + PER; + TRUE +END OP =; + +BOOL OP = (ROW 2 ROW 2 REAL CONST l, r): + FOR i FROM 1 UPTO 2 + REP IF l [i][1] <> r [i][1] OR l [i][2] <> r [i][2] + THEN LEAVE = WITH FALSE FI + PER; + TRUE +END OP =; + +BOOL OP = (ROW 2 REAL CONST l, r): + l [1] = r [1] AND l [2] = r [2] +END OP =; + +BOOL OP = (ROW 3 REAL CONST l, r): + l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3] +END OP =; + +BOOL OP = (ROW 4 REAL CONST l, r): + l [1] = r [1] AND l [2] = r [2] AND l [3] = r [3] AND l [4] = r [4] +END OP =; + +PROC oblique (REAL CONST a, b) : + set values (size d, limits d, angles d, ROW 2 REAL : (a, b), ROW 3 REAL : (0.0, 0.0, 0.0)) +END PROC oblique; + +PROC orthographic : + set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (0.0, 0.0, 0.0)) +END PROC orthographic; + +PROC perspective (REAL CONST cx, cy, cz) : + set values (size d, limits d, angles d, ROW 2 REAL : (0.0, 0.0), ROW 3 REAL : (cx, cy,-cz)) +END PROC perspective; + +PROC window (BOOL CONST dev) : + new limits := dev +END PROC window; + +PROC window (REAL CONST x min, x max, y min, y max) : + window (x min, x max, y min, y max, 0.0, 1.0) +END PROC window; + +PROC window (REAL CONST x min, x max, y min, y max, z min, z max) : + set values (ROW 3 ROW 2 REAL : (ROW 2 REAL : (x min, x max), + ROW 2 REAL : (y min, y max), + ROW 2 REAL : (z min, z max)), + limits d, angles d, oblique d, perspective d) +END PROC window; + +PROC viewport (REAL CONST h min, h max, v min, v max) : + set values (size d, ROW 2 ROW 2 REAL : (ROW 2 REAL : (h min, h max), + ROW 2 REAL : (v min, v max)), + angles d, oblique d, perspective d) +END PROC view port; + +PROC view (REAL CONST alpha) : + set values (size d, limits d, ROW 4 REAL : (alpha, angles d(2), angles d (3), angles d (4)), + oblique d, perspective d) +END PROC view; + +PROC view (REAL CONST phi, theta) : + set values (size d, limits d, ROW 4 REAL : (angles d(1), sind (theta) * cosd (phi), + sind (theta) * sind (phi), cosd (theta)), + oblique d, perspective d) +END PROC view; + +PROC view (REAL CONST x, y, z) : + set values (size d, limits d, ROW 4 REAL : (angles d (1), x, y, z), oblique d, perspective d) +END PROC view; + +PROC drawing area (REAL VAR min h, max h, min v, max v): + min h := h min limit; max h := h max limit; + min v := v min limit; max v := v max limit +END PROC drawing area; + +PROC set drawing area (REAL CONST new size hor,new size vert, + new display hor,new display vert): + size hor := new size hor; + size vert:= new size vert; + display hor := new display hor; + display vert:= new display vert; + relation := size hor/size vert; + new limits := TRUE; + init transformation rows +END PROC set drawing area; + +BOOL PROC new values: + IF values new + THEN values new := FALSE; + TRUE + ELSE FALSE FI +END PROC new values; + +PROC get values (ROW 3 ROW 2 REAL VAR size, + ROW 2 ROW 2 REAL VAR limits, + ROW 4 REAL VAR angles, + ROW 2 REAL VAR oblique, + ROW 3 REAL VAR perspective) : + size := size d; + limits := limits d; + angles := angles d; + oblique := oblique d; + perspective := perspective d; + +END PROC get values; + +PROC set values (ROW 3 ROW 2 REAL CONST size, + ROW 2 ROW 2 REAL CONST limits, + ROW 4 REAL CONST angles, + ROW 2 REAL CONST oblique, + ROW 3 REAL CONST perspective) : + IF NOT same values + THEN values new := TRUE; + copy values; + set views; + check perspective projektion; + calc limits; + change projektion + FI . + +same values: + size hor d = size hor AND size vert d = size vert AND + size d = size AND limits d = limits AND angles d = angles AND + oblique d = oblique AND perspective d = perspective . + +copy values : + size hor d := size hor; + size vert d := size vert; + size d := size; + limits d := limits; + angles d := angles; + oblique d := oblique; + perspective d := perspective . + +set views : + REAL VAR diagonale := sqrt (angles [2] * angles [2] + + angles [3] * angles [3] + + angles [4] * angles [4]), + projektion := sqrt (angles [2] * angles [2] + + angles [4] * angles [4]), + sin p, cos p, sin t, cos t, sin a, cos a; + + IF diagonale = 0.0 + THEN sin p := 0.0; cos p := 1.0; + sin t := 0.0; cos t := 1.0 + ELIF projektion = 0.0 + THEN sin p := angles [3] / diagonale; + cos p := projektion / diagonale; + sin t := 0.0; cos t := 1.0 + ELSE sin p := angles [3] / diagonale; + cos p := projektion / diagonale; + sin t := angles [2] / projektion; + cos t := angles [4] / projektion + FI; + + REAL VAR sin p sin t := sin p * sin t, + sin p cos t := sin p * cos t, + cos p sin t := cos p * sin t, + cos p cos t := cos p * cos t, + + dx := size [1][2] - size [1][1], + dy := size [2][2] - size [2][1], + dz := size [3][2] - size [3][1], + norm az := oblique [1] , + norm bz := oblique [2] , + norm cx := perspective [1] / dx, + norm cy := perspective [2] / dy, + norm cz := perspective [3] / dz; + +p := ROW 5 ROW 5 REAL : + (ROW 5 REAL : ( cos t / dx - cos p sin t / dx * norm az , + - sin p sin t / dx - cos p sin t / dx * norm bz, + 0.0, + - cos p sin t / dx * norm cz, + 0.0 ), + ROW 5 REAL : ( - sin p / dy * norm az, + cos p / dy - sin p / dy * norm bz, + 0.0, + - sin p / dy * norm cz, + 0.0 ), + ROW 5 REAL : ( sin t / dz + cos p cos t / dz * norm az, + + sin p cos t / dz + cos p cos t / dz * norm bz, + 0.0, + cos p cos t / dz * norm cz, + 0.0 ), + ROW 5 REAL : (- norm cx, - norm cy, 0.0, 1.0, 0.0 ), + ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0)); + + IF angles (1) = 0.0 + THEN set alpha as y vertical + ELSE sin a := sind (angles (1)); + cos a := cosd (angles (1)) + FI; + + FOR j FROM 1 UPTO 5 + REP REAL CONST p j 1 := p (j)(1); + p (j)(1) := p j 1 * cos a - p (j)(2) * sin a; + p (j)(2) := p j 1 * sin a + p (j)(2) * cos a + PER . + +set alpha as y vertical : + REAL VAR r := sqrt (p(2)(1)**2 + p(2)(2)**2); + IF r = 0.0 + THEN sin a := 0.0; + cos a := 1.0 + ELSE sin a :=-p(2)(1)/r; + cos a := p(2)(2)/r + FI . + +check perspective projektion: + perspective projektion := perspective [3] <> 0.0 . + +calc limits : + IF new limits + THEN calc two dim extrema; + IF all limits smaller than 2 + THEN prozente + ELSE zentimeter FI + FI . + +calc two dim extrema : + h min := max real; h max :=-max real; + v min := max real; v max :=-max real; + + extrema (size [1][1], size [2][1], size [3][1], h min, h max, v min, v max); + extrema (size [1][2], size [2][1], size [3][1], h min, h max, v min, v max); + extrema (size [1][2], size [2][2], size [3][1], h min, h max, v min, v max); + extrema (size [1][1], size [2][2], size [3][1], h min, h max, v min, v max); + extrema (size [1][1], size [2][1], size [3][2], h min, h max, v min, v max); + extrema (size [1][2], size [2][1], size [3][2], h min, h max, v min, v max); + extrema (size [1][2], size [2][2], size [3][2], h min, h max, v min, v max); + extrema (size [1][1], size [2][2], size [3][2], h min, h max, v min, v max) . + +all limits smaller than 2 : + limits (1)(2) < 2.0 AND limits (2)(2) < 2.0 . + +prozente : + h min limit := display hor * limits (1)(1)/relation; + h max limit := display hor * limits (1)(2)/relation; + + v min limit := limits (2)(1) * display vert; + v max limit := limits (2)(2) * display vert . + +zentimeter : + h min limit := display hor * (limits (1)(1)/size hor); + h max limit := display hor * (limits (1)(2)/size hor); + + v min limit := display vert * (limits (2)(1)/size vert); + v max limit := display vert * (limits (2)(2)/size vert) . + +change projektion : + REAL VAR sh := (h max limit - h min limit) / (h max - h min), + sv := (v max limit - v min limit) / (v max - v min), + dh := h min limit - h min*sh, + dv := v min limit - v min*sv; + + FOR j FROM 1 UPTO 5 + REP + p (j)(1) := p (j)(1) * sh; + p (j)(2) := p (j)(2) * sv + PER; + p (5)(1) := dh; + p (5)(2) := dv. +END PROC set values; + +PROC transform (REAL CONST x, y, z, INT VAR h, v) : + disable stop; + IF perspective projektion + THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0); + h := int ((x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (4)(1))*w + p (5)(1)); + v := int ((x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (4)(2))*w + p (5)(2)) + ELSE h := int (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) + p (5)(1)); + v := int (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) + p (5)(2)); + FI; + IF is error + THEN h := -1; + v := -1; + clear error + FI +END PROC transform; + +PROC extrema (REAL CONST x, y, z, REAL VAR h min, h max, v min, v max): + REAL VAR h, v; + IF perspective projektion + THEN REAL CONST w :: 1.0/(x*p (1)(4) + y*p (2)(4) + z*p (3)(4) + 1.0); + h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1) +p (4)(1))*w; + v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2) +p (4)(2))*w + ELSE h := (x*p (1)(1)+y*p (2)(1)+z*p (3)(1)); + v := (x*p (1)(2)+y*p (2)(2)+z*p (3)(2)) + FI; + + IF h < h min + THEN h min := h + ELIF h > h max + THEN h max := h FI; + + IF v < v min + THEN v min := v + ELIF v > v max + THEN v max := v FI + +END PROC extrema; + +BOOL PROC clipped line (REAL VAR x0,y0,x1,y1): + REAL VAR dx :: (display hor - 1.0) / 2.0, + dy :: (display vert- 1.0) / 2.0, + rx0 :: x0 - dx, + ry0 :: y0 - dy, + rx1 :: x1 - dx, + ry1 :: y1 - dy; + INT VAR cx0, + cy0, + cx1, + cy1; + calculate cells; + IF (cx0*cx1 = 1) OR (cy0 * cy1 = 1) + THEN FALSE + ELIF (x0 = x1) AND (y0 = y1) + THEN cx0 = 0 AND cy0 = 0 + ELSE do clipping + FI. + + do clipping: + IF cx0 <> 0 + THEN REAL VAR next x :: real(cx0) * dx; + ry0 := (ry1 - ry0) / (rx1 - rx0) * (next x - rx0) + ry0; + rx0 := next x + FI; + calculate cells; + IF cy0 <> 0 + THEN REAL VAR next y :: real(cy0) * dy; + rx0 := (rx1 - rx0) / (ry1 - ry0) * (next y - ry0) + rx0; + ry0 := next y + FI; + IF cx1 <> 0 + THEN next x := real(cx1) * dx; + ry1 := (ry1 - ry0) / (rx1 - rx0) * (next x - rx1) + ry1; + rx1 := next x + FI; + calculate cells; + IF cy1 <> 0 + THEN next y := real(cy1) * dy; + rx1 := (rx1 - rx0) / (ry1 - ry0) * (next y - ry1) + rx1; + ry1 := next y + FI; + IF (rx1 = rx0) AND (ry1 = ry0) + THEN FALSE + ELSE x0 := rx0+dx; + y0 := ry0+dy; + x1 := rx1+dx; + y1 := ry1+dy; + TRUE + FI. + + calculate cells: + cx0 := 0; + cy0 := 0; + cx1 := 0; + cy1 := 0; + IF abs(rx0) > dx + THEN cx0 := sign(rx0) + FI; + IF abs(rx1) > dx + THEN cx1 := sign(rx1) + FI; + IF abs(ry0) > dy + THEN cy0 := sign(ry0) + FI; + IF abs(ry1) > dy + THEN cy1 := sign(ry1) + FI. + +END PROC clipped line; + +END PACKET transformation; + +(******************************** picture ********************************) + +PACKET picture DEFINES (* Autor: H.Indenbirken *) + PICTURE, (* Stand: 23.02.1985 *) + :=, CAT, nilpicture, + draw, draw r, draw cm, draw cm r, + move, move r, move cm, move cm r, + bar, circle, + length, dim, pen, where, + extrema, rotate, stretch, translate, + text, picture: + +LET draw key = 1, + move key = 2, + text key = 3, + move r key = 4, + draw r key = 5, + move cm key = 6, + draw cm key = 7, + move cm r key = 8, + draw cm r key = 9, + bar key = 10, + circle key = 11, + max 2 dim = 31983, + max 3 dim = 31975, + max text = 31974, + max bar = 31982, + max circle = 31974, + max length = 32000; + + +TYPE PICTURE = STRUCT (INT dim, pen, TEXT points); + + +INT VAR read pos; +REAL VAR x, y, z; +TEXT VAR r2 :: 16*""0"", r3 :: 24*""0"", i1 :: ""0""0""; + +OP := (PICTURE VAR l, PICTURE CONST r) : + CONCR (l) := CONCR (r) +END OP :=; + +OP CAT (PICTURE VAR l, PICTURE CONST r) : + IF l.dim <> r.dim + THEN errorstop ("OP CAT : left dimension <> right dimension") + ELIF length (l.points) > max length - length (r.points) + THEN errorstop ("OP CAT : Picture overflow") FI; + + l.points CAT r.points +END OP CAT; + +PICTURE PROC nilpicture : + PICTURE : (0, 1, "") +END PROC nilpicture; + +PROC draw (PICTURE VAR p, TEXT CONST text) : + draw (p, text, 0.0, 0.0, 0.0) +END PROC draw; + +PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle, height, bright): + write (p, text, angle, height, bright, text key) +END PROC draw; + +PROC draw (PICTURE VAR p, REAL CONST x, y, z) : + check dim (p, 3); + write (p, x, y, z, draw key) +END PROC draw; + +PROC draw (PICTURE VAR p, REAL CONST x, y) : + check dim (p, 2); + write (p, x, y, draw key) +END PROC draw; + +PROC draw r (PICTURE VAR p, REAL CONST x, y, z) : + check dim (p, 3); + write (p, x, y, z, draw r key) +END PROC draw r; + +PROC draw r (PICTURE VAR p, REAL CONST x, y) : + check dim (p, 2); + write (p, x, y, draw r key) +END PROC draw r; + +PROC draw cm (PICTURE VAR p, REAL CONST x, y) : + write (p, x, y, draw cm key) +END PROC draw cm; + +PROC draw cm r (PICTURE VAR p, REAL CONST x, y) : + write (p, x, y, draw cm r key) +END PROC draw cm r; + +PROC move (PICTURE VAR p, REAL CONST x, y, z) : + check dim (p, 3); + write (p, x, y, z, move key) +END PROC move; + +PROC move (PICTURE VAR p, REAL CONST x, y) : + check dim (p, 2); + write (p, x, y, move key) +END PROC move; + +PROC move r (PICTURE VAR p, REAL CONST x, y, z) : + check dim (p, 3); + write (p, x, y, z, move r key) +END PROC move r; + +PROC move r (PICTURE VAR p, REAL CONST x, y) : + check dim (p, 2); + write (p, x, y, move r key) +END PROC move r; + +PROC move cm (PICTURE VAR p, REAL CONST x, y) : + write (p, x, y, move cm key) +END PROC move cm; + +PROC move cm r (PICTURE VAR p, REAL CONST x, y) : + write (p, x, y, move cm r key) +END PROC move cm r; + +PROC bar (PICTURE VAR p, REAL CONST width, height, INT CONST pattern): + write (p, width, height, pattern, bar key) +END PROC bar; + +PROC circle (PICTURE VAR p, REAL CONST radius, from, to, INT CONST pattern): + write (p, radius, from, to, pattern, circle key) +END PROC circle; + + +PROC write (PICTURE VAR p, REAL CONST x, y, z, INT CONST key) : + IF length (p.points) < max 3 dim + THEN p.points CAT code (key); + replace (r3, 1, x); + replace (r3, 2, y); + replace (r3, 3, z); + p.points CAT r3 + ELSE errorstop ("Picture overflow") FI +END PROC write; + +PROC write (PICTURE VAR p, REAL CONST x, y, INT CONST key) : + IF length (p.points) < max 2 dim + THEN p.points CAT code (key); + replace (r2, 1, x); + replace (r2, 2, y); + p.points CAT r2 + ELSE errorstop ("Picture overflow") FI +END PROC write; + +PROC write (PICTURE VAR p, REAL CONST x, y, INT CONST n, key) : + IF length (p.points) < max bar + THEN p.points CAT code (key); + replace (r2, 1, x); + replace (r2, 2, y); + p.points CAT r2; + replace (i1, 1, n); + p.points CAT i1 + ELSE errorstop ("Picture overflow") FI +END PROC write; + +PROC write (PICTURE VAR p, REAL CONST x, y, z, INT CONST n, key) : + IF length (p.points) < max circle + THEN p.points CAT code (key); + replace (r3, 1, x); + replace (r3, 2, y); + replace (r3, 3, z); + p.points CAT r3; + replace (i1, 1, n); + p.points CAT i1 + ELSE errorstop ("Picture overflow") FI +END PROC write; + +PROC write (PICTURE VAR p, TEXT CONST t, REAL CONST angle, height, bright, + INT CONST key) : + IF max text - length (p.points) >= length (t) + THEN p.points CAT code (key); + replace (i1, 1, length (t)); + p.points CAT i1; + p.points CAT t; + replace (r3, 1, angle); + replace (r3, 2, height); + replace (r3, 3, bright); + p.points CAT r3 + FI; +END PROC write; + +PROC check dim (PICTURE VAR p, INT CONST dim): + IF p.dim = 0 + THEN p.dim := dim + ELIF p.dim <> dim + THEN errorstop ("Picture is " + text (p.dim) + " dimensional") FI +END PROC check dim; + +INT PROC length (PICTURE CONST p): + length (p.points) +END PROC length; + +INT PROC dim (PICTURE CONST pic) : + pic.dim +END PROC dim; + +PROC pen (PICTURE VAR p, INT CONST pen) : + IF pen < 0 OR pen > 16 + THEN errorstop ("pen out of range [0-16]") FI; + p.pen := pen +END PROC pen; + +INT PROC pen (PICTURE CONST p) : + p.pen +END PROC pen; + +PROC where (PICTURE CONST p, REAL VAR x, y) : + IF p.dim = 0 + THEN x := 0.0; y := 0.0 + ELIF p.dim = 3 + THEN errorstop ("Picture is 3 dimensional") + ELSE x := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1; + y := subtext (p.points, length (p.points)-7, length (p.points)) RSUB 1 + FI +END PROC where; + +PROC where (PICTURE CONST p, REAL VAR x, y, z) : + IF p.dim = 0 + THEN x := 0.0; y := 0.0; z := 0.0 + ELIF p.dim = 2 + THEN errorstop ("Picture is 2 dimensional") + ELSE x := subtext (p.points, length (p.points)-23, length (p.points)-16) RSUB 1; + y := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1; + z := subtext (p.points, length (p.points)-7, length (p.points)) RSUB 1; + FI +END PROC where; + + +PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max, z min, z max) : + x min := max real; x max :=-max real; + y min := max real; y max :=-max real; + z min := max real; z max :=-max real; + read pos := 0; + INT CONST pic length := length (p.points); + WHILE read pos < pic length + REP check position PER . + +check position : + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : calc extrema + CASE move key : calc extrema + CASE move r key : calc rel extrema + CASE draw r key : calc rel extrema + CASE move cm key : read pos INCR 16 + CASE draw cm key : read pos INCR 16 + CASE move cm r key : read pos INCR 16 + CASE draw cm r key : read pos INCR 16 + CASE text key : read pos INCR next int + 24 + CASE bar key : read pos INCR 18 + CASE circle key : read pos INCR 26 + OTHERWISE errorstop ("wrong key code") END SELECT . + +calc extrema : + x := next real; y := next real; z := next real; + x min := min (x min, x); x max := max (x max, x); + y min := min (y min, y); y max := max (y max, y); + z min := min (z min, z); z max := max (z max, z) . + +calc rel extrema : + x INCR next real; y INCR next real; z INCR next real; + x min := min (x min, x); x max := max (x max, x); + y min := min (y min, y); y max := max (y max, y); + z min := min (z min, z); z max := max (z max, z) . + +next real : + read pos INCR 8; + subtext (p.points, read pos-7, read pos) RSUB 1 . + +next int : + read pos INCR 2; + subtext (p.points, read pos-1, read pos) ISUB 1 . + +END PROC extrema; + +PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max): + x min := max real; x max :=-max real; + y min := max real; y max :=-max real; + read pos := 0; + INT CONST pic length := length (p.points); + WHILE read pos < pic length + REP check position PER . + +check position : + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : calc extrema + CASE move key : calc extrema + CASE move r key : calc rel extrema + CASE draw r key : calc rel extrema + CASE move cm key : read pos INCR 16 + CASE draw cm key : read pos INCR 16 + CASE move cm r key : read pos INCR 16 + CASE draw cm r key : read pos INCR 16 + CASE text key : read pos INCR next int + 24 + CASE bar key : read pos INCR 18 + CASE circle key : read pos INCR 26 + OTHERWISE errorstop ("wrong key code") END SELECT . + +calc extrema : + x := next real; y := next real; + x min := min (x min, x); x max := max (x max, x); + y min := min (y min, y); y max := max (y max, y) . + +calc rel extrema : + x INCR next real; y INCR next real; + x min := min (x min, x); x max := max (x max, x); + y min := min (y min, y); y max := max (y max, y) . + +next real : + read pos INCR 8; + subtext (p.points, read pos-7, read pos) RSUB 1 . + +next int : + read pos INCR 2; + subtext (p.points, read pos-1, read pos) ISUB 1 . + +END PROC extrema; + +PROC rotate (PICTURE VAR p, REAL CONST angle) : (* X-Rotation *) + REAL CONST s :: sind( angle ), c := cosd( angle ); + transform (p, ROW 4 ROW 3 REAL : + (ROW 3 REAL : ( 1.0, 0.0, 0.0 ), + ROW 3 REAL : ( 0.0, c , s ), + ROW 3 REAL : ( 0.0, -s , c ), + ROW 3 REAL : ( 0.0, 0.0, 0.0 ))) +END PROC rotate; + +PROC yrotate (PICTURE VAR p, REAL CONST angle): (* Y-Rotation *) + REAL CONST s :: sind (angle), c :: cosd (angle); + transform (p, ROW 4 ROW 3 REAL : + (ROW 3 REAL : ( c , 0.0, -s ), + ROW 3 REAL : ( 0.0, 1.0, 0.0 ), + ROW 3 REAL : ( s , 0.0, c ), + ROW 3 REAL : ( 0.0, 0.0, 0.0 ))) +END PROC yrotate; + +PROC zrotate (PICTURE VAR p, REAL CONST angle): (* Z-Rotation *) + REAL CONST s :: sind (angle), c :: cosd (angle); + transform (p, ROW 4 ROW 3 REAL : + (ROW 3 REAL : ( c , s , 0.0 ), + ROW 3 REAL : ( -s , c , 0.0 ), + ROW 3 REAL : ( 0.0, 0.0, 1.0 ), + ROW 3 REAL : ( 0.0, 0.0, 0.0 ))) +END PROC zrotate; + +PROC rotate (PICTURE VAR p, REAL CONST phi, theta, lambda ) : + IF phi <> 0.0 + THEN rotate (p, phi) FI; + IF theta <> 0.0 + THEN yrotate (p, theta) FI; + IF lambda <> 0.0 + THEN zrotate (p, lambda) + FI +END PROC rotate; + +PROC stretch (PICTURE VAR pic, REAL CONST sx, sy) : + stretch (pic, sx, sy, 1.0) +END PROC stretch; + +PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz) : + transform (p, ROW 4 ROW 3 REAL : + (ROW 3 REAL : ( sx, 0.0, 0.0), + ROW 3 REAL : (0.0, sy, 0.0), + ROW 3 REAL : (0.0, 0.0, sz), + ROW 3 REAL : (0.0, 0.0, 0.0))) +END PROC stretch; + +PROC translate (PICTURE VAR p, REAL CONST dx, dy) : + translate (p, dx, dy, 0.0) +END PROC translate; + +PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz) : + transform (p, ROW 4 ROW 3 REAL : + (ROW 3 REAL : (1.0, 0.0, 0.0), + ROW 3 REAL : (0.0, 1.0, 0.0), + ROW 3 REAL : (0.0, 0.0, 1.0), + ROW 3 REAL : ( dx, dy, dz))) +END PROC translate; + +PROC transform (PICTURE VAR p, ROW 4 ROW 3 REAL CONST a) : + INT CONST pic length := length (p.points); + INT VAR begin pos; + read pos := 0; + x := 0.0; y := 0.0; z := 0.0; + IF p.dim = 2 + THEN transform 2 dim pic + ELSE transform 3 dim pic FI . + +transform 2 dim pic: + WHILE read pos < pic length + REP transform 2 dim position PER . + +transform 2 dim position: + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : transform 2 dim point + CASE move key : transform 2 dim point + CASE move r key : transform 2 dim point + CASE draw r key : transform 2 dim point + CASE move cm key : read pos INCR 16 + CASE draw cm key : read pos INCR 16 + CASE move cm r key : read pos INCR 16 + CASE draw cm r key : read pos INCR 16 + CASE text key : read pos INCR next int + 24 + CASE bar key : read pos INCR 18 + CASE circle key : read pos INCR 26 + OTHERWISE errorstop ("wrong key code") END SELECT . + +transform 2 dim point: + begin pos := read pos+1; + x := next real; y := next real; + transform (a, x, y, z); + replace (r2, 1, x); + replace (r2, 2, y); + replace (p.points, begin pos, r2) . + +transform 3 dim pic: + WHILE read pos < pic length + REP transform 3 dim position PER . + +transform 3 dim position : + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : transform 3 dim point + CASE move key : transform 3 dim point + CASE move r key : transform 3 dim point + CASE draw r key : transform 3 dim point + CASE move cm key : read pos INCR 16 + CASE draw cm key : read pos INCR 16 + CASE move cm r key : read pos INCR 16 + CASE draw cm r key : read pos INCR 16 + CASE text key : read pos INCR next int + 24 + CASE bar key : read pos INCR 18 + CASE circle key : read pos INCR 26 + OTHERWISE errorstop ("wrong key code") END SELECT . + +transform 3 dim point: + begin pos := read pos+1; + x := next real; y := next real; z := next real; + transform (a, x, y, z); + replace (r3, 1, x); + replace (r3, 2, y); + replace (r3, 3, z); + replace (p.points, begin pos, r3) . + +next real : + read pos INCR 8; + subtext (p.points, read pos-7, read pos) RSUB 1 . + +next int : + read pos INCR 2; + subtext (p.points, read pos-1, read pos) ISUB 1 . + +END PROC transform; + +PROC transform (ROW 4 ROW 3 REAL CONST a, REAL VAR x, y, z) : + REAL CONST ox :: x, oy :: y, oz :: z; + x := ox*a(1)(1) + oy*a(2)(1) + oz*a(3)(1) + a(4)(1); + y := ox*a(1)(2) + oy*a(2)(2) + oz*a(3)(2) + a(4)(2); + z := ox*a(1)(3) + oy*a(2)(3) + oz*a(3)(3) + a(4)(3) +END PROC transform; + +TEXT PROC text (PICTURE CONST pic): + TEXT VAR result :: ""0""0""0""0""; (* 23.09.87 -cw- *) + replace (result, 1, pic.dim); (* wegen Heap-Ueberlauf *) + replace (result, 2, pic.pen); + result CAT pic.points; + result +END PROC text; + +PICTURE PROC picture (TEXT CONST text): + PICTURE : (text ISUB 1, text ISUB 2, subtext (text, 5)) +END PROC picture; + +END PACKET picture; + +(******************************** picfile *********************************) + +PACKET picfile DEFINES (* Autor: H.Indenbirken *) + (* Stand: 23.02.1985 *) + PICFILE, :=, picture file, + select pen, selected pen, background, + set values, get values, + view, viewport, window, oblique, orthographic, perspective, + extrema, + + put, get, + to first pic, to eof, to pic, up, down, + is first picture, eof, picture no, pictures, + delete picture, insert picture, read picture, + write picture, put picture: + + +LET max pics = 1024, + pic dataspace = 1102; + + +TYPE PICFILE = BOUND STRUCT (INT size, pos, background, + ROW 16 ROW 3 INT pens, + ROW 16 BOOL hidden, + ROW 3 ROW 2 REAL sizes, + ROW 2 ROW 2 REAL limits, + ROW 4 REAL angles, + ROW 2 REAL obliques, + ROW 3 REAL perspectives, + ROW max pics PICTURE pic); + +TEXT VAR i text :: ""0""0"", r text :: ""0""0""0""0""0""0""0""0""; +INT VAR i; + +OP := (PICFILE VAR dest, PICFILE CONST source): + EXTERNAL 260 +END OP := ; + +OP := (PICFILE VAR p, DATASPACE CONST d) : + IF type (d) = pic dataspace + THEN CONCR (p) := d + ELIF type (d) < 0 + THEN type (d, pic dataspace) ; + CONCR (p) := d ; + init picfile dataspace ; + ELSE errorstop ("dataspace is no PICFILE") FI . + +init picfile dataspace : + r.size := 0; + r.pos := 0; + r.background := 0; + r.sizes [1][1] := 0.0; + r.sizes [1][2] := 1.0; + r.sizes [2][1] := 0.0; + r.sizes [2][2] := 1.0; + r.sizes [3][1] := 0.0; + r.sizes [3][2] := 1.0; + r.limits [1][1] := 0.0; + r.limits [1][2] := 1.0; + r.limits [2][1] := 0.0; + r.limits [2][2] := 1.0; + r.angles [1] := 0.0; + r.angles [2] := 0.0; + r.angles [3] := 0.0; + r.angles [4] := 0.0; + r.obliques [1] := 0.0; + r.obliques [2] := 0.0; + r.perspectives [1] := 0.0; + r.perspectives [2] := 0.0; + r.perspectives [3] := 0.0; + FOR i FROM 1 UPTO 16 + REP r.pens [i][1] := 1; + r.pens [i][2] := 0; + r.pens [i][3] := 1; + r.hidden [i] := TRUE + PER. + +r : CONCR (CONCR (p)). + +END OP :=; + +DATASPACE PROC picture file (TEXT CONST name) : + IF exists (name) + THEN old (name) + ELSE new (name) FI +END PROC picture file; + +PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line type, + BOOL CONST hidden): + IF pen < 1 OR pen > 16 + THEN errorstop ("pen out of range") FI; + p.pens [pen][1] := colour; + p.pens [pen][2] := thickness; + p.pens [pen][3] := line type; + p.hidden [pen] := hidden +END PROC select pen; + +PROC selected pen (PICFILE CONST p, INT CONST pen, + INT VAR colour, thickness, line type, + BOOL VAR hidden): + IF pen < 1 OR pen > 16 + THEN errorstop ("pen out of range") FI; + colour := p.pens [pen][1]; + thickness := p.pens [pen][2]; + line type := p.pens [pen][3]; + hidden := p.hidden [pen] +END PROC selected pen; + +INT PROC background (PICFILE CONST p): + p.background +END PROC background; + +PROC background (PICFILE VAR p, INT CONST colour): + p.background := colour +END PROC background; + +PROC get values (PICFILE CONST p, + ROW 3 ROW 2 REAL VAR size, + ROW 2 ROW 2 REAL VAR limits, + ROW 4 REAL VAR angles, + ROW 2 REAL VAR oblique, + ROW 3 REAL VAR perspective) : + size := p.sizes; + limits := p.limits; + angles := p.angles; + oblique := p.obliques; + perspective := p.perspectives; + +END PROC get values; + +PROC set values (PICFILE VAR p, + ROW 3 ROW 2 REAL CONST size, + ROW 2 ROW 2 REAL CONST limits, + ROW 4 REAL CONST angles, + ROW 2 REAL CONST oblique, + ROW 3 REAL CONST perspective) : + p.sizes := size; + p.limits := limits; + p.angles := angles; + p.obliques := oblique; + p.perspectives := perspective; + +END PROC set values; + +PROC view (PICFILE VAR p, REAL CONST alpha): + p.angles [1] := alpha +END PROC view; + +PROC view (PICFILE VAR p, REAL CONST phi, theta): + p.angles [2] := sind (theta) * cosd (phi); + p.angles [3] := sind (theta) * sind (phi); + p.angles [4] := cosd (theta); +END PROC view; + +PROC view (PICFILE VAR p, REAL CONST x, y, z): + p.angles [2] := x; + p.angles [3] := y; + p.angles [4] := z +END PROC view; + +PROC viewport (PICFILE VAR p,REAL CONST hor min,hor max,vert min,vert max) : + p.limits [1][1] := hor min; + p.limits [1][2] := hor max; + p.limits [2][1] := vert min; + p.limits [2][2] := vert max; +END PROC viewport; + +PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) : + window (p, x min, x max, y min, y max, 0.0, 1.0) +END PROC window; + +PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max, z min, z max) : + p.sizes [1][1] := x min; + p.sizes [1][2] := x max; + p.sizes [2][1] := y min; + p.sizes [2][2] := y max; + p.sizes [3][1] := z min; + p.sizes [3][2] := z max; +END PROC window; + +PROC oblique (PICFILE VAR p, REAL CONST a, b) : + p.obliques [1] := a; + p.obliques [2] := b; + p.perspectives [1] := 0.0; + p.perspectives [2] := 0.0; + p.perspectives [3] := 0.0 +END PROC oblique; + +PROC orthographic (PICFILE VAR p) : + p.obliques [1] := 0.0; + p.obliques [2] := 0.0; + p.perspectives [1] := 0.0; + p.perspectives [2] := 0.0; + p.perspectives [3] := 0.0 +END PROC orthographic; + +PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) : + p.obliques [1] := 0.0; + p.obliques [2] := 0.0; + p.perspectives [1] := cx; + p.perspectives [2] := cy; + p.perspectives [3] := cz +END PROC perspective; + +PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) : + REAL VAR dummy; + extrema (p, x min, x max, y min, y max, dummy, dummy) +END PROC extrema; + +PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z min,z max) : + REAL VAR new x min, new x max, new y min, new y max, new z min, new z max; + x min := max real; x max := - max real; + y min := max real; y max := - max real; + z min := max real; z max := - max real; + FOR i FROM 1 UPTO p.size + REP IF dim (p.pic [i]) = 2 + THEN extrema (p.pic [i], new x min, new x max, new y min, new y max) + ELSE extrema (p.pic [i], new x min, new x max, new y min, new y max, + new z min, new z max) + FI; + x min := min (x min, new x min); x max := max (x max, new x max); + y min := min (y min, new y min); y max := max (y max, new y max); + z min := min (z min, new z min); z max := max (z max, new z max); + PER +END PROC extrema; + +PROC put (FILE VAR f, PICFILE CONST p): + put line (f, parameter); + FOR i FROM 1 UPTO p.size + REP put line (f, text (p.pic [i])) PER . + +parameter: + intern (p.size) + intern (p.pos) + intern (p.background) + intern (p.pens) + + intern (p.hidden) + intern (p.sizes) + intern (p.limits) + intern (p.angles) + + intern (p.obliques) + intern (p.perspectives) . + +END PROC put; + +PROC get (PICFILE VAR p, FILE VAR f): + TEXT VAR record; + get line (f, record); + convert parameter; + FOR i FROM 1 UPTO p.size + REP get line (f, record); + p.pic [i] := picture (record) + PER . + +convert parameter: + convert (record, p.size); convert (record, p.pos); + convert (record, p.background); convert (record, p.pens); + convert (record, p.hidden); convert (record, p.sizes); + convert (record, p.limits); convert (record, p.angles); + convert (record, p.obliques); convert (record, p.perspectives) . + +END PROC get; + +PROC to first pic (PICFILE VAR p): + p.pos := 1 +END PROC to first pic; + +PROC to eof (PICFILE VAR p): + p.pos := p.size+1 +END PROC to eof; + +PROC to pic (PICFILE VAR p, INT CONST n): + IF n < 1 + THEN errorstop ("Position underflow") + ELIF n > p.size + THEN errorstop ("Position after end of PICFILE") + ELSE p.pos := n FI +END PROC to pic; + +PROC up (PICFILE VAR p): + to pic (p, p.pos-1) +END PROC up; + +PROC up (PICFILE VAR p, INT CONST n): + to pic (p, p.pos-n) +END PROC up; + +PROC down (PICFILE VAR p): + to pic (p, p.pos+1) +END PROC down; + +PROC down (PICFILE VAR p, INT CONST n): + to pic (p, p.pos+n) +END PROC down; + +BOOL PROC is first picture (PICFILE CONST p): + p.pos = 1 +END PROC is first picture; + +BOOL PROC eof (PICFILE CONST p): + p.pos >= p.size +END PROC eof; + +INT PROC picture no (PICFILE CONST p): + p.pos +END PROC picture no; + +INT PROC pictures (PICFILE CONST p): + p.size +END PROC pictures; + +PROC delete picture (PICFILE VAR p) : + INT VAR i; + FOR i FROM p.pos+1 UPTO p.size + REP p.pic [i-1] := p.pic [i] PER; + + p.pic [p.size] := nilpicture; + IF p.size > 1 + THEN p.size DECR 1 FI +END PROC delete picture; + +PROC insert picture (PICFILE VAR p) : + INT VAR i; + IF p.size >= max pics + THEN errorstop ("PICFILE overflow") + ELSE p.size INCR 1; + FOR i FROM p.size DOWNTO p.pos+1 + REP p.pic [i] := p.pic [i-1] PER; + + p.pic [p.pos] := nilpicture; + FI +END PROC insert picture; + +PROC read picture (PICFILE VAR p, PICTURE VAR pic) : + pic := p.pic (p.pos) . +END PROC read picture; + +PROC write picture (PICFILE VAR p, PICTURE CONST pic) : + p.pic (p.pos) := pic . +END PROC write picture; + +PROC put picture (PICFILE VAR p, PICTURE CONST pic) : + IF p.size >= max pics + THEN errorstop ("PICFILE overflow") + ELSE p.size INCR 1; + p.pic [p.size] := pic; + FI +END PROC put picture; + +TEXT PROC intern (INT CONST n): + replace (i text, 1, n); + i text +END PROC intern; + +TEXT PROC intern (ROW 16 ROW 3 INT CONST n): + INT VAR i, j; + TEXT VAR result :: ""; + FOR i FROM 1 UPTO 16 + REP FOR j FROM 1 UPTO 3 + REP result CAT intern (n [i][j]) PER + PER; + result +END PROC intern; + +TEXT PROC intern (ROW 16 BOOL CONST n): + INT VAR i, result :: 0; + FOR i FROM 1 UPTO 16 + REP IF n [i] + THEN set bit (result, i-1) FI + PER; + intern (result) +END PROC intern; + +TEXT PROC intern (REAL CONST r): + replace (r text, 1, r); + r text +END PROC intern; + +TEXT PROC intern (ROW 3 ROW 2 REAL CONST r): + INT VAR i, j; + TEXT VAR result :: ""; + FOR i FROM 1 UPTO 3 + REP FOR j FROM 1 UPTO 2 + REP result CAT intern (r [i][j]) PER + PER; + result +END PROC intern; + +TEXT PROC intern (ROW 2 ROW 2 REAL CONST r): + INT VAR i, j; + TEXT VAR result :: ""; + FOR i FROM 1 UPTO 2 + REP FOR j FROM 1 UPTO 2 + REP result CAT intern (r [i][j]) PER + PER; + result +END PROC intern; + +TEXT PROC intern (ROW 4 REAL CONST r): + intern (r [1]) + intern (r [2]) + intern (r [3]) + intern (r [4]) +END PROC intern; + +TEXT PROC intern (ROW 3 REAL CONST r): + intern (r [1]) + intern (r [2]) + intern (r [3]) +END PROC intern; + +TEXT PROC intern (ROW 2 REAL CONST r): + intern (r [1]) + intern (r [2]) +END PROC intern; + +PROC convert (TEXT VAR record, INT VAR n): + n := record ISUB 1; + record := subtext (record, 3) +END PROC convert; + +PROC convert (TEXT VAR record, ROW 16 ROW 3 INT VAR n): + INT VAR i, j; + FOR i FROM 1 UPTO 16 + REP FOR j FROM 1 UPTO 3 + REP convert (record, n [i][j]) PER + PER +END PROC convert; + +PROC convert (TEXT VAR record, ROW 16 BOOL VAR n): + INT VAR i, result; + convert (record, result); + FOR i FROM 1 UPTO 16 + REP n [i] := bit (i-1, result) PER +END PROC convert; + +PROC convert (TEXT VAR record, REAL VAR r): + r := record RSUB 1; + record := subtext (record, 9) +END PROC convert; + +PROC convert (TEXT VAR record, ROW 3 ROW 2 REAL VAR r): + INT VAR i, j; + FOR i FROM 1 UPTO 3 + REP FOR j FROM 1 UPTO 2 + REP convert (record, r [i][j]) PER + PER; +END PROC convert; + +PROC convert (TEXT VAR record, ROW 2 ROW 2 REAL VAR r): + INT VAR i, j; + FOR i FROM 1 UPTO 2 + REP FOR j FROM 1 UPTO 2 + REP convert (record, r [i][j]) PER + PER; +END PROC convert; + +PROC convert (TEXT VAR record, ROW 4 REAL VAR r): + convert (record, r [1]); convert (record, r [2]); + convert (record, r [3]); convert (record, r [4]) +END PROC convert; + +PROC convert (TEXT VAR record, ROW 3 REAL VAR r): + convert (record, r [1]); convert (record, r [2]); convert (record, r [3]) +END PROC convert; + +PROC convert (TEXT VAR record, ROW 2 REAL VAR r): + convert (record, r [1]); convert (record, r [2]) +END PROC convert; + +END PACKET picfile; + +(********************************* devices ********************************) + +PACKET devices DEFINES PLOTTER, + select plotter, + install plotter, + plotters, + plotter, + no plotter, + name, + channel, + station, + actual plotter, + drawing area, + plotter info, + :=, + = : + +LET trenn = "/"; + +TYPE PLOTTER = STRUCT (INT station, channel, TEXT name); +PLOTTER CONST noplotter :: PLOTTER : (0,0,""); +PLOTTER VAR plotter id :: no plotter; +TARGET VAR devices; +TEXT VAR plotter set; +INT VAR act plotter; + +OP := (PLOTTER VAR dest, PLOTTER CONST source): + CONCR (dest) := CONCR (source) +END OP := ; + +BOOL OP = (PLOTTER CONST a, b): + (a.station = b.station) AND + (a.channel = b.channel) AND + (a.name = b.name ) +END OP =; + +PLOTTER PROC plotter: + plotter id +END PROC plotter; + +PLOTTER PROC plotter (TEXT CONST def plotter): + select target (devices, def plotter, plotter set); + IF plotter set = "" + THEN IF def plotter = "" + THEN act plotter := 0; + no plotter + ELSE errorstop ("Unbekannter Plot-Id : " + def plotter); + no plotter + FI + ELSE select;plotter id + FI. + + select: + INT VAR tp; + PLOTTER VAR plotter id; + plotter id.station := int(def plotter); + tp := pos (def plotter, trenn) + 1; + plotter id.channel := int(subtext (def plotter,tp)); + plotter id.name := subtext (def plotter, pos (def plotter,trenn,tp)+1); +END PROC plotter; + +PROC select plotter: + THESAURUS VAR plotter list :: empty thesaurus; + TEXT VAR plotter name; + INT VAR index :: 0; + get (plotters, plotter name, index); + WHILE index > 0 REP + insert (plotter list,plotter info (plotter name,60)); + get (plotters, plotter name, index) + PER; + select plotter (name (plotters, link (plotter list, one(plotter list)))) +END PROC select plotter; + +PROC select plotter (PLOTTER CONST plotter): + select plotter (text (plotter.station) + trenn + text (plotter.channel) + + trenn + plotter.name) +END PROC select plotter; + +PROC select plotter (TEXT CONST def plotter): + select target (devices, def plotter, plotter set); + IF plotter set = "" + THEN IF def plotter = "" + THEN act plotter := 0; + plotter id := no plotter + ELSE errorstop ("Unbekannter Plot-Id : " + def plotter) + FI + ELSE select + FI. + + select: + INT VAR xp, yp, tp; REAL VAR xc, yc; + act plotter := link (plotters, def plotter); + plotter id.station := int(def plotter); + tp := pos (def plotter, trenn) + 1; + plotter id.channel := int(subtext (def plotter,tp)); + plotter id.name := subtext (def plotter, pos (def plotter,trenn,tp)+1); + drawing area (xc, yc, xp, yp); + set drawing area (xc, yc, real (xp), real (yp)); +END PROC select plotter; + +PROC install plotter (TARGET VAR new plotset): + THESAURUS VAR new plotter :: target names (new plotset); + INT VAR index :: 0; + TEXT VAR name,set; + initialize target (devices); + get (new plotter,name,index); + WHILE index > 0 REP + select target (new plotset, name, set); + complete target (devices, name, set); + get (new plotter, name, index) + PER +END PROC install plotter; + +INT PROC actual plotter: + act plotter +END PROC actual plotter; + +THESAURUS PROC plotters: + target names (devices) +END PROC plotters; + +TEXT PROC name (PLOTTER CONST plotter): + plotter.name +END PROC name; + +INT PROC channel (PLOTTER CONST plotter): + plotter.channel +END PROC channel; + +INT PROC station (PLOTTER CONST plotter): + plotter.station +END PROC station; + +PROC drawing area (REAL VAR xcm, ycm, INT VAR xp, yp): + IF plotter set <> "" + THEN INT VAR cp; + xp := int(plotter set); + cp := pos (plotter set,",")+1; + yp := int (subtext (plotter set,cp)); + cp := pos (plotter set,",",cp)+1; + xcm := real (subtext (plotter set,cp)); + cp := pos (plotter set,",",cp)+1; + ycm := real (subtext (plotter set,cp)) + FI +END PROC drawing area; + +PROC drawing area (REAL VAR xcm, ycm, INT VAR xp, yp,PLOTTER CONST pl): + PLOTTER CONST keep :: plotter; + select plotter (pl); + drawing area (xcm, ycm, xp, yp); + select plotter (keep) +END PROC drawing area; + +TEXT PROC plotter info (TEXT CONST plotter id,INT CONST len): + INT VAR tp :: pos (plotter id, trenn)+1; + TEXT VAR plotter name :: plotter id, + station :: "/Station" + text (int(plotter name),2), + kanal :: " Kanal" + text (int (subtext (plottername,tp)),3); + plotter name := subtext (plotter name, pos (plotter name, trenn,tp)+1) + " "; + INT VAR llen :: length (plotter name + kanal + station); + plotter name + (max(len-llen,0) * ".") + kanal + station +END PROC plotter info; + +END PACKET devices diff --git a/app/mpg/1987/src/GRAPHIK.Configurator b/app/mpg/1987/src/GRAPHIK.Configurator new file mode 100644 index 0000000..7bfdbb9 --- /dev/null +++ b/app/mpg/1987/src/GRAPHIK.Configurator @@ -0,0 +1,945 @@ +(**************************************************************************) +(* *) +(* MPG - Graphik - System *) +(* *) +(* Version 2.2 vom 11.11.1987 *) +(* *) +(* (c) 1987 Beat Jegerlehner & Carsten Weinholz *) +(* unter Verwendung der Standard-Graphik *) +(* "Graphik-Konfiguration" geschrieben von C.Weinholz *) +(* *) +(**************************************************************************) +(* *) +(* Graphik-Konfiguration *) +(* *) +(* Erstellung eines fuer alle Engeraete gueltigen *) +(* Basisgraphik-Paketes durch zusammenfuegen *) +(* von '.GCONF'-Dateien *) +(* *) +(* Aufruf durch 'configurate graphik', wenn insertiert *) +(* (normalerweise nicht notwendig) *) +(* Bei 'run' muss 'configurate graphik' ans Dateiende *) +(* geschrieben werden. *) +(* *) +(**************************************************************************) +PACKET graphik configuration DEFINES configurate graphik: + +LET PLOTTERCONF = STRUCT (TEXT name, station, channel, area, prep, init, end, + clear, home, move, draw, pixel, foreground, + background, palette, std colors, circle, box, + fill, cursor, get cursor, set marker, linked, + BOOL editor, + BOOL no plotter); +LET max conf = 15, + dquote = ""34""34"", + interface = "GRAPHIK.Configuration", + env conf file = "ENVIRONMENT.GCONF", + packet header = "PACKET device interface DEFINES prepare, init plot, endplot, clear, home, moveto, drawto, setpixel, foreground, background, set color, stdcolors, color, colors, set palette, circle, box,fill,graphik cursor, get cursor, set marker:", + packet end = "END PACKET device interface", + target = "TARGET VAR plotter; initialize target ( plotter);", + install target= "install plotter ( plotter);", + init set = "PROC initplot: IF wsc THEN palette := std palette + ELSE palette := empty palette FI; initplot; set palette + END PROC initplot;", + end set = "BOOL VAR we::TRUE; + PROCendplot(BOOL CONSTs): we:=s + END PROCendplot; + PROCendplot: IF weTHEN endplotFI + END PROCendplot;", + clear set = "BOOL VAR wc::TRUE; PROCclear(BOOL CONSTs): wc:=s + END PROC clear; PROC clear:IF wcTHEN clearFI END PROC clear;", + color set = "BOOL VAR wsc::TRUE; TEXT VAR palette; PROC setcolor (INT CONST no,rgb): + IF (no+1) <= colors THEN replace( palette,no+1,rgb) + FI END PROC set color;", + color set2 = "INT PROC colors : length ( palette) DIV 2 END PROC colors; + INT PROC color (INT CONST no): IF no >= 0 AND (no+1) <= colors + THEN palette ISUB (no+1) ELSE maxint FI END PROC color;", + std colors = "PROCstdcolors(BOOL CONSTs): wsc:=s END PROCstdcolors; + PROC stdcolors:IF wscTHEN palette := std palette;set palette FI END PROCstdcolors;", + foreground = "INT VAR af::1; INT PROCforeground: af END PROCforeground; + PROCforeground(INT CONSTm): af:=m; foreground( af) END PROCforeground;", + background = "INT VAR ab::0; INT PROCbackground: ab END PROCbackground; + PROCbackground(INT CONSTm): ab:=m; background( ab) END PROCbackground;"; + +ROW max conf PLOTTERCONF VAR plotter; +ROW max conf DATASPACE VAR global data; + +TEXT CONST spaces :: 20 * " "; +INT VAR inst plotter, targets, error line :: 0; +TEXT VAR errorm1, errorm2, procvalue :: "", env conf, error source :: ""; +BOOL VAR errors :: FALSE; +FILE VAR f; +DATASPACE VAR conf ds; +THESAURUS VAR plotconfs; + +PROC configurate graphik: + FOR inst plotter FROM 1 UPTO max conf REP + act plotter.name := ""; + act plotter.area := ""; + act plotter.prep := ""; + act plotter.init := ""; + act plotter.end := ""; + act plotter.clear:= ""; + act plotter.home := ""; + act plotter.move := ""; + act plotter.draw := ""; + act plotter.pixel:= ""; + act plotter.foreground := ""; + act plotter.background := ""; + act plotter.palette := ""; + act plotter.circle := ""; + act plotter.box := ""; + act plotter.fill := ""; + act plotter.cursor := ""; + act plotter.get cursor := ""; + act plotter.set marker := ""; + act plotter.linked := ""; + act plotter.editor := FALSE; + PER; + env conf := ""; + inst plotter := 0; + plotconfs := empty thesaurus; + IF exists (env conf file) + THEN plotconfs := ALL env conf file + FI; + plotconfs := SOME (plotconfs + (all LIKE "*.GCONF") - env conf file); + INT VAR id :: 0; TEXT VAR conf file; + get (plotconfs, conf file, id); + WHILE id > 0 REP + IF exists (conf file) + THEN extract conf data (conf file) + ELSE get environment plotter + FI; + get (plotconfs, conf file, id); + PER; + IF inst plotter > 0 + THEN generate interface + ELSE errorstop ("Kein Interface erzeugt") + FI; + last param (interface). + + get environment plotter: + check sequence (conf file, "PLOTTER *,*,*,*,*,*,*;", + "2|4,3,3,3,3,3,3;", + "PLOTTER erwartet,"+ + "Name erwartet,,"+ + "Station erwartet,,"+ + "Kanal erwartet,,"+ + "XPixel erwartet,,"+ + "YPixel erwartet,,"+ + "Xcm erwartet,,"+ + "Ycm erwartet,,"+ + "Plotterkommando fehlerhaft"); + IF errors + THEN errorstop (errorm2) + ELSE TEXT VAR one int :: ""0""0"", one real :: 8 * ""0""; + replace (one int,1,length(get var (1))); + env conf CAT one int; + env conf CAT get var (1); + replace (one int, 1, int (get var (2))); + env conf CAT one int; + replace (one int, 1, int (get var (3))); + env conf CAT one int; + replace (one int, 1, int (get var (4))); + env conf CAT one int; + replace (one int, 1, int (get var (5))); + env conf CAT one int; + replace (one real, 1, real (get var (6))); + env conf CAT one real; + replace (one real, 1, real (get var (7))); + env conf CAT one real; + FI +END PROC configurate graphik; + +PROC extract conf data (TEXT CONST conf file): + TEXT VAR line; + inst plotter INCR 1; + IF inst plotter > max conf + THEN putline ("Warnung: Es koennen nicht mehr als " + text(max conf) + + " Geraete konfiguriert werden"); + inst plotter DECR 1 + ELSE error source := conf file; + conf ds := old (conf file); + f := sequential file (modify, conf ds); + set line numbers; + IF is plotter configuration + THEN get name and area (line, act plotter.name, + act plotter.station, + act plotter.channel, + act plotter.area); + get linked (act plotter.linked); + get includes; + putline ("""" + act plotter.name + """ wird eingelesen"); + get paramless ("initplot",act plotter.init); + get paramless ("endplot" ,act plotter.end); + get paramless ("clear" ,act plotter.clear); + get paramless ("home" ,act plotter.home); + get paramless ("prepare" ,act plotter.prep); + get koord ("moveto" ,act plotter.move); + get koord ("drawto" ,act plotter.draw); + get koord ("setpixel",act plotter.pixel); + get var param ("foreground",act plotter.foreground); + get var param ("background",act plotter.background); + get paramless ("setpalette",act plotter.palette); + get std colors(act plotter.std colors); + get circle (act plotter.circle); + get box (act plotter.box); + get fill (act plotter.fill); + IF editor available + THEN get graphik cursor (act plotter.cursor); + get get cursor (act plotter.get cursor); + get set marker (act plotter.set marker) + FI; + push error; + IF anything noted + THEN f := sequential file (modify,conf file); + out (""7"");note edit (f);errorstop("") + FI + FI; + global data [inst plotter] := conf ds; + forget (conf ds) + FI. + + is plotter configuration: + plotter [inst plotter].no plotter := NOT sequence found ("PLOTTER", + line, 1,TRUE); + NOT plotter [inst plotter].no plotter. + + editor available: + plotter [inst plotter].editor := sequence found ("EDITOR", line, 1,TRUE); + IF plotter [inst plotter].editor + THEN delete record (f); + check sequence (line, "EDITOR;", "2;", + "EDITOR erwartet,"+ + "Semikolon erwartet," + + "Editorkommando fehlerhaft") + FI; + plotter [inst plotter].editor. + + set line numbers: + INT VAR line number; + to line (f,1); + FOR line number FROM 1 UPTO lines (f)-1 REP + cout (line number); + insert line number; + down (f) + PER; + insert line number. + + insert line number: + TEXT VAR new line; + read record (f, new line); + insert char (new line, " ", 1); + insert char (new line, " ", 1); + replace (new line, 1, line number); + write record (f, new line). + + get includes: + BOOL VAR include found :: sequence found ("INCLUDE",line, 1, TRUE); + WHILE include found REP + push error; + include found := sequence found ("INCLUDE",line, line no (f), TRUE); + IF include found + THEN add to plotconfs + FI + PER. + + add to plotconfs: + check sequence (line, "INCLUDE *;","2|4;", + "INCLUDE erwartet,Dateiname erwartet," + + "Includekommando fehlerhaft"); + IF NOT errors CAND exists (get var (1)) + THEN IF NOT (plotconfs CONTAINS get var (1)) + THEN insert (plotconfs,get var (1)) + FI; + ELIF NOT errors + THEN error ("""" + get var (1) + """ existiert nicht") + FI; + delete record (f) +END PROC extract conf data; + +PROC generate interface: + INT VAR act conf; + conf ds := nilspace; + forget (interface,quiet); + proc value := ""; + FILE VAR f :: sequential file (output, conf ds); + putline (f,packet header); + putline (f,target); + generate target; + putline (f,install target); + putline (f,init set); + putline (f,end set); + putline (f,clear set); + putline (f,color set); + putline (f,color set 2); + putline (f, std colors); + putline (f,foreground); + putline (f,background); + FOR act conf FROM 1 UPTO inst plotter REP + FILE VAR source := sequential file (modify,global data [act conf]); + copy lines (f,source) + PER; + generate proc (""," initplot", TEXT PROC (INT CONST) initplotbody); + generate proc (""," endplot", TEXT PROC (INT CONST) endplotbody); + generate proc (""," clear", TEXT PROC (INT CONST) clearbody); + generate proc ("","prepare", TEXT PROC (INT CONST) prepbody); + proc value := " TEXT"; + generate proc (""," std palette", TEXT PROC (INT CONST) std palette body); + generate proc (""," empty palette", TEXT PROC (INT CONST) empty palette body); + proc value := ""; + generate proc ("","home", TEXT PROC (INT CONST) homebody); + generate proc ("INT CONST x,y","moveto", TEXT PROC (INT CONST) movebody); + generate proc ("INT CONST x,y","drawto", TEXT PROC (INT CONST) drawbody); + generate proc ("INT CONST x,y","set pixel", TEXT PROC (INT CONST) pixelbody); + generate proc ("INT VAR type"," foreground", TEXT PROC (INT CONST) foregroundbody); + generate proc ("INT VAR type"," background", TEXT PROC (INT CONST) backgroundbody); + generate proc ("","set palette", TEXT PROC (INT CONST) set palette body); + generate proc ("INT CONST x,y,rad,from,to","circle", TEXT PROC (INT CONST) circlebody); + generate proc ("INT CONST x1,y1,x2,y2,pattern", "box", TEXT PROC (INT CONST) box body); + generate proc ("INT CONST x,y,pattern","fill", TEXT PROC (INT CONST) fill body); + generate proc ("INT CONST x,y, BOOL CONST on","graphik cursor",TEXT PROC (INT CONST) graphik cursor body); + generate proc ("INT VAR x,y, TEXT VAR exit char","get cursor",TEXT PROC (INT CONST) get cursor body); + generate proc ("INT CONST x,y, type","set marker",TEXT PROC (INT CONST) set marker body); + proc value := "BOOL "; + generate proc ("","graphik cursor",TEXT PROC (INT CONST) editor available); + generate device link; + putline (f,packet end); + copy (conf ds,interface); + IF yes ("""" + interface + """ insertieren") + THEN insert (interface) + FI. + + generate target: + INT VAR devices :: 0; + targets := 0; + FOR act conf FROM 1 UPTO inst plotter REP + TEXT VAR linked :: plotter[act conf].linked, + one int:: ""0""0""; + plotter [act conf].linked := ""; + IF NOT plotter [act conf].no plotter + THEN putline (f,"complete target ( plotter,""" + + plotter [act conf].station + "/" + + plotter [act conf].channel + "/" + + plotter [act conf].name + + """,""" + plotter [act conf].area + """);"); + devices INCR 1; + targets INCR 1; + replace (one int, 1, devices); + plotter [act conf].linked CAT one int; + replace (one int, 1, targets); + plotter [act conf].linked CAT one int; + IF linked > "" + THEN INT VAR x :: 1; + WHILE x <= length (linked) DIV 2 REP + putline (f,"complete target ( plotter, """ + + text(linked ISUB x) + "/" + + text(linked ISUB (x+1)) + "/" + + plotter[act conf].name + """,""" + + plotter[act conf].area + """);"); + targets INCR 1; + replace (one int, 1, targets); + plotter [act conf].linked CAT one int; + x INCR 2 + PER + FI + FI + PER; + WHILE env conf <> "" REP + generate env target (env conf) + PER +END PROC generate interface; + +PROC generate env target (TEXT VAR conf): + INT VAR nlen :: conf ISUB 1; + TEXT VAR tnam :: subtext (conf, 3, 2+nlen); + conf := subtext (conf, nlen + 3); + putline (f,"complete target ( plotter, """ + text (conf ISUB 1) + "/" + + text (conf ISUB 2) + "/" + tnam + """,""" + + text (conf ISUB 3) + "," + text (conf ISUB 4) + "," + + first real + "," + text (conf RSUB 2) + """);"); + conf := subtext (conf, 17). + + first real: + conf := subtext (conf, 9); + text (conf RSUB 1) +END PROC generate env target; + +TEXT PROC initplotbody (INT CONST no): + plotter [no].init +END PROC initplotbody; + +TEXT PROC endplotbody (INT CONST no): + plotter [no].end +END PROC endplotbody; + +TEXT PROC clearbody (INT CONST no): + plotter [no].clear +END PROC clearbody; + +TEXT PROC prepbody (INT CONST no): + plotter [no].prep +END PROC prepbody; + +TEXT PROC homebody (INT CONST no): + plotter [no].home +END PROC homebody; + +TEXT PROC movebody (INT CONST no): + plotter [no].move +END PROC movebody; + +TEXT PROC drawbody (INT CONST no): + plotter [no].draw +END PROC drawbody; + +TEXT PROC pixelbody (INT CONST no): + plotter [no].pixel +END PROC pixelbody; + +TEXT PROC std palette body (INT CONST no): + TEXT CONST rgb codes :: plotter [no].std colors; + TEXT VAR body :: dquote; + INT VAR x; + FOR x FROM 1 UPTO length (rgb codes) DIV 3 REP + INT VAR color :: int (subtext(rgb codes, (x-1)*3+1, x*3)); + body CAT (text (color AND 255) + dquote); + body CAT (text (color DIV 256) + dquote); + PER; + body +END PROC std palette body; + +TEXT PROC empty palette body (INT CONST no): + text (length (plotter[no].std colors) DIV 3) + "*" + dquote + + "255" + dquote + "127" + dquote +END PROC empty palette body; + +TEXT PROC set palette body (INT CONST no): + plotter[no].palette +END PROC set palette body; + +TEXT PROC foregroundbody (INT CONST no): + plotter [no].foreground +END PROC foregroundbody; + +TEXT PROC backgroundbody (INT CONST no): + plotter [no].background +END PROC backgroundbody; + +TEXT PROC circle body (INT CONST no): + plotter [no].circle +END PROC circle body; + +TEXT PROC box body (INT CONST no): + plotter [no].box +END PROC box body; + +TEXT PROC fill body (INT CONST no): + plotter [no].fill +END PROC fill body; + +TEXT PROC graphik cursor body (INT CONST no): + plotter [no].cursor +END PROC graphik cursor body; + +TEXT PROC get cursor body (INT CONST no): + plotter [no].get cursor +END PROC get cursor body; + +TEXT PROC set marker body (INT CONST no): + plotter [no].set marker +END PROC set marker body; + +TEXT PROC editor available (INT CONST no): + IF plotter [no].editor + THEN "TRUE" + ELSE "FALSE" + FI +END PROC editor available; + +PROC generate device link: + INT VAR actconf; + putline (f, "INT PROC act device :"); + putline (f, "SELECT actual plotter OF"); + FOR act conf FROM 1 UPTO inst plotter REP + IF NOT plotter [act conf].no plotter + THEN putline (f,"CASE " + text (plotter[act conf].linked ISUB 2) + ":"); + put (f,text (plotter[act conf].linked ISUB 1)); + IF length (plotter[act conf].linked) > 2 + THEN generate table + FI + FI + PER; + putline (f,"OTHERWISE errorstop (""Kein Endgeraet angekoppelt"");0"); + putline (f,"END SELECT END PROC act device;"). + + generate table: + INT VAR x; + FOR x FROM 3 UPTO length (plotter[act conf].linked) DIV 2 REP + put (f,"CASE"); + put (f,text (plotter[act conf].linked ISUB x)); + put (f,":"); + put (f, text (plotter[act conf].linked ISUB 1)) + PER +END PROC generate device link; + +PROC generate proc (TEXT CONST params,procname,TEXT PROC (INT CONST)procbody): + INT VAR actconf, no plotter :: 0; + IF params = "" + THEN putline (f,procvalue + " PROC " + procname + ":") + ELSE putline (f,procvalue + " PROC " + procname + "(" + params + "):") + FI; + IF procvalue <> "" + THEN putline (f,procvalue + " VAR d;") + FI; + putline (f,"SELECT act device OF"); + FOR act conf FROM 1 UPTO inst plotter REP + IF NOT plotter [act conf].no plotter + THEN putline (f, "CASE " + text (act conf-no plotter) + ":" + + lowercase(plotter[act conf].name) + + plotter [act conf].channel + procname) + ELSE no plotter INCR 1 + FI + PER; + IF procvalue <> "" + THEN putline (f," OTHERWISE d END SELECT") + ELSE putline (f," END SELECT") + FI; + FOR act conf FROM 1 UPTO inst plotter REP + IF NOT plotter [act conf].no plotter + THEN putline (f,"."); + putline (f,lowercase(plotter[act conf].name)+ + plotter[act conf].channel + procname + ":"); + putline (f,procbody (act conf)) + FI + PER; + putline (f,"END PROC "+ procname +";") +END PROC generate proc; + +PROC get name and area (TEXT CONST line, TEXT VAR name, station, channel, area): + push error; + check sequence (line, "PLOTTER *,*,*,*,*,*,*;", + "2|4,3,3,3,3,3,3;", + "PLOTTER erwartet,"+ + "Name erwartet,,"+ + "Station erwartet,,"+ + "Kanal erwartet,,"+ + "XPixel erwartet,,"+ + "YPixel erwartet,,"+ + "Xcm erwartet,,"+ + "Ycm erwartet,,"+ + "Plotterkommando fehlerhaft"); + name := get var (1); + station := get var (2); + channel := get var (3); + area := ""; + area CAT (get var (4) + ","); + area CAT (get var (5) + ","); + area CAT (get var (6) + ","); + area CAT (get var (7) + ","); + delete record (f) +END PROC get name and area; + +PROC get linked (TEXT VAR keep): + TEXT VAR line; + IF sequence found ("LINK", line, 1, TRUE) + THEN extract data; + delete record (f) + FI. + + extract data: + TEXT VAR symbol, one int :: ""0""0""; + INT VAR ltyp :: 2,type :: 0;(* 0 = ',' 1 = '/' 2 = Station 3 = Kanal*) + push error; (* 4 = Ende erwartet ! *) + keep := ""; + errorm1 := line; + scan (line); + next symbol (symbol); + IF symbol <> "LINK" + THEN error ("LINK erwartet") + FI; + WHILE type < 7 AND NOT errors REP + next symbol (symbol, type); + IF ltyp = 0 + THEN IF symbol = "," + THEN ltyp := 2 + ELIF symbol = ";" + THEN ltyp := 4 + ELSE error ("Semikolon oder Komma erwartet") + FI + ELIF ltyp = 1 + THEN IF symbol = "/" + THEN ltyp := 3 + ELSE error ("'/' erwartet") + FI + ELIF ltyp = 4 + THEN IF type = 8 + THEN error ("Kommentarende fehlt") + ELIF type = 9 + THEN error ("Text unzulaessig (Textende fehlt)") + ELIF type <> 7 + THEN error ("Zeilenende nach Semikolon erwartet") + FI + ELIF type = 3 + THEN replace (one int, 1, int (symbol)); + keep CAT one int; + ltyp DECR 1; + IF ltyp = 2 + THEN ltyp := 0 + FI + FI + PER +END PROC get linked; + +PROC get graphik cursor (TEXT VAR keep): + get proc ("graphik cursor","(INT CONST x,y, BOOL CONST on)", + "(2|2 x,y,2|2 on)","INT erwartet, CONST erwartet,"+ + "Formaler Parameter muss x heissen,"+ + "Formaler Parameter muss y heissen,"+ + "BOOL erwartet, CONST erwartet,"+ + "Formaler Parameter muss on heissen", + keep); +END PROC get graphik cursor; + +PROC get get cursor (TEXT VAR keep): + get proc ("get cursor","(INT VAR x,y, TEXT VAR exit char)", + "(2|2 x,y,2|2 exit char)","INT erwartet, VAR erwartet,"+ + "Formaler Parameter muss x heissen,"+ + "Formaler Parameter muss y heissen,"+ + "TEXT erwartet, VAR erwartet,"+ + "Formaler Parameter muss exit char heissen", + keep); +END PROC get get cursor; + +PROC get set marker (TEXT VAR keep): + get proc ("set marker","(INT CONST x,y,type)","(2|2 x,y,type)", + "INT erwartet, CONST erwartet,"+ + "Formaler Parameter muss x heissen,"+ + "Formaler Parameter muss y heissen,"+ + "Formaler Parameter muss type heissen", + keep); +END PROC get set marker; + +PROC get std colors (TEXT VAR keep): + TEXT VAR line; + push error; + IF sequence found ("COLORS", line, 1, TRUE) + THEN extract data + ELSE error ("COLORS fehlt") + FI. + + extract data: + check sequence (line, "COLORS *;","2|4;", + "COLORS erwartet,"+ + "Rgbcodes erwartet,Semikolon fehlt"); + keep := get var (1); + delete record (f); +END PROC get std colors; + +PROC get paramless (TEXT CONST procname, TEXT VAR keep): + get proc (procname, "", "", "", keep) +END PROC get paramless; + +PROC get var param (TEXT CONST procname, TEXT VAR keep): + get proc (procname, "(INT VAR type)","(2|2 type)", + "INT erwartet, VAR erwartet, Formaler Parameter muss type heissen", + keep); +END PROC get var param; + +PROC get koord (TEXT CONST procname, TEXT VAR keep): + get proc (procname, "(INT CONST x,y)","(2|2 x,y)", + "INT erwartet,CONST erwartet,Formaler Parameter muss x heissen,"+ + "Formaler Parameter muss y heissen",keep) +END PROC get koord; + +PROC get circle (TEXT VAR keep): + get proc ("circle","(INT CONST x,y,rad,from,to)","(2|2 x,y,rad,from,to)", + "INT erwartet,CONST erwartet,Formaler Parameter muss x heissen,"+ + "Formaler Parameter muss y heissen,Formaler Parameter muss rad heissen,"+ + "Formaler Parameter muss from heissen,Formaler Parameter muss to heissen", + keep); +END PROC get circle; + +PROC get box (TEXT VAR keep): + get proc ("box","(INT CONST x1,y1,x2,y2,pattern)","(2|2 x1,y1,x2,y2,pattern)", + "INT erwartet,CONST erwartet,Formaler Parameter muss x1 heissen,"+ + "Formaler Parameter muss y1 heissen,Formaler Parameter muss x2 heissen,"+ + "Formaler Parameter muss y2 heissen,Formaler Parameter muss pattern heissen", + keep); +END PROC get box; + +PROC get fill (TEXT VAR keep): + get proc ("fill","(INT CONST x,y,pattern)","(2|2 x,y,pattern)", + "INT erwartet,CONST erwartet,Formaler Parameter muss x heissen"+ + "Formaler Parameter muss y heissen,Formaler Parameter muss pattern heissen", + keep); +END PROC get fill; + +PROC get proc (TEXT CONST procname, psym, ptyp, perr, + TEXT VAR keep): + TEXT VAR line; + push error; + IF sequence found ("PROC"+procname, line, 1, TRUE) + THEN errors := FALSE; + get body (line,procname,psym,ptyp,perr,keep) + ELSE error (procname + " nicht gefunden") + FI +END PROC get proc; + +PROC get body (TEXT CONST header,procname,psyms,ptypes ,perrs, TEXT VAR keep body): + INT VAR start, ende; + start := line no(f); + keep body := ""; + check sequence (header, "PROC " + procname + psyms + ":", + "2|1"+ ptypes + ":", + "PROC erwartet," + + procname + " erwartet,,"+ + perrs+ + ",Fehler in " + procname + "-Header"); + IF NOT errors + THEN get to end of proc + FI. + + get to end of proc: + TEXT VAR last; + errors := FALSE; + IF sequence found ("END PROC " + procname, last, line no(f),FALSE) + THEN ende := line no (f); + check sequence (last, "END PROC " + procname + ";", + "2|2|1;", + "END erwartet,"+ + "PROC erwartet,"+ + "PROC heisst " + procname + + ",Semikolon fehlt"); + IF NOT errors + THEN to line (f,start); + delete record (f); + INT VAR lc; + FOR lc FROM start UPTO ende-2 REP + TEXT VAR scratch; + read record (f,scratch); + scratch := subtext (scratch, 3); + keep body CAT (" " + scratch); + delete record (f); + PER; + delete record (f) + FI + ELSE error ("END PROC " + procname + " nicht gefunden") + FI +END PROC get body; + +BOOL PROC sequence found (TEXT CONST sequence text, + TEXT VAR sequence line, INT CONST from line, + BOOL CONST evtl at): + BOOL VAR found :: FALSE, at char :: evtl at; + to line (f,from line); + col (f,1); + WHILE NOT (found OR eof (f)) REP + cout (line no (f)); + to first char; + IF found + THEN read record (f, sequence line); + error line := sequence line ISUB 1; + sequence line := subtext (sequence line, 3); + scan sequence + FI + PER; + IF NOT found + THEN read record (f, sequence line); + IF pos (first char, sequence line) > 0 + THEN scan sequence + FI + FI; + found. + + to first char: + IF at char + THEN downety (f, first char) + ELSE down (f, first char) + FI; + at char := FALSE; + found := pattern found. + + scan sequence: + TEXT VAR source symbols,symbols; + scan (sequence text); + get symbols; + source symbols := symbols; + scan (sequence line); + get symbols; + found := pos (symbols,source symbols) = 1. + + get symbols: + TEXT VAR symbol; + INT VAR type; + symbols := ""; + REP + next symbol (symbol, type); + symbols CAT symbol + UNTIL type > 6 PER. + + first char: + sequence text SUB 1 +END PROC sequence found; + +PROC error (TEXT CONST emsg): + IF NOT eof (f) + THEN read record (f,errorm1); + errorm1 := """" + error source + """, Zeile " + + text (error line) + ":" + ELSE errorm1 := """" + error source + """, Fileende:" + FI; + errorm2 := spaces + emsg; + errors := TRUE +END PROC error; + +PROC push error: + IF errors + THEN note (errorm1);note line; + note (10* " " + errorm2); note line; + errors := FALSE + FI +END PROC push error; + + (* Hinweis: bei Fehlermeldungen statt Blank ' ' (geschuetzt) verwenden. + Bei verschiedenen Typen ohne trennenden Delimiter zur + Abgrenzung in 'seq typ' '|' verwenden. + '*' wird in 'seq sym' als Wildcard verwendet (Itemweise) + Bei Delimitern wird der 'allgemeine Fehler' (letzter i.d Liste) + verwendet. Jedoch muss auch fuer Delimiter ein Eintrag + in der Liste freigehalten werden (...,,... oder ...,dummy,...). +*) + +ROW 100 STRUCT (TEXT sym, INT typ, BOOL var) VAR seqlist; +INT VAR scanpos; + +TEXT PROC get var (INT CONST no): + INT VAR count :: 0, checkpos :: 1; + WHILE checkpos <= scanpos REP + IF seqlist[checkpos].var + THEN count INCR 1; + IF count >= no + THEN LEAVE get var WITH seqlist[checkpos].sym + FI + FI; + checkpos INCR 1 + PER;"" +END PROC get var; + +PROC check sequence (TEXT CONST seq, seq sym, seq typ, seq err): + ROW 100 TEXT VAR err; + INT VAR checkpos,erpos, typ, error1 :: 0,error2 :: 0; + TEXT VAR sym; + scan (seq err); + next symbol (sym, typ); + erpos := 1; + err[erpos] := ""; + REP + SELECT typ OF + CASE 5: err[erpos] CAT " " + CASE 6: erpos INCR 1; + err [erpos] := "" + OTHERWISE err[erpos] CAT sym + END SELECT; + next symbol (sym, typ) + UNTIL typ >= 7 PER; + scan (seq); + FOR scanpos FROM 1 UPTO 100 REP + next symbol (seqlist[scanpos].sym,seqlist[scanpos].typ); + UNTIL seqlist[scanpos].typ >= 7 PER; + SELECT seqlist[scanpos].typ OF + CASE 8: error ("Kommentarende fehlt") + CASE 9: error ("Textende fehlt") + OTHERWISE IF scanpos = 100 + THEN error ("Kommando zu schwierig") + FI + END SELECT; + scan (seq sym); + FOR checkpos FROM 1 UPTO scanpos REP + next symbol (sym, typ); + IF sym = "*" + THEN seqlist[checkpos].var := TRUE + ELSE seqlist[checkpos].var := FALSE + FI + PER; + scan (seq typ); + next symbol (sym,typ); + FOR checkpos FROM 1 UPTO scanpos REP + WHILE sym = "|" REP + next symbol (sym, typ) + PER; + BOOL VAR std err :: typ <> 3; + IF NOT std err + THEN typ := int(sym); + IF seqlist[checkpos].typ <> typ + THEN error1 := checkpos + FI; + ELIF seqlist[checkpos].sym <> sym + THEN error1 := erpos + FI; + next symbol (sym, typ) + UNTIL error1 > 0 OR typ >= 7 PER; + scan (seq sym); + next symbol (sym,typ); + FOR checkpos FROM 1 UPTO scanpos-1 REP + std err := typ = 6; + IF (seqlist[checkpos].sym <> sym) AND (sym <> "*") + THEN IF std err + THEN error2 := erpos + ELSE error2 := checkpos + FI + FI; + next symbol (sym, typ) + UNTIL error2 > 0 PER; + IF error1 = 0 + THEN error1 := error2 + ELIF error1 = erpos + THEN IF (error2 <> 0) AND (error2 <> erpos) + THEN error1 := error2 + FI + FI; + IF error1 > 0 + THEN error (err [error1]) + FI +END PROC check sequence; + +INT PROC lower pair (INT CONST upper pair): + INT VAR lower :: upper pair; + set bit (lower,5); + set bit (lower,13); + lower +END PROC lower pair; + +TEXT PROC lower case (TEXT CONST uppercase): + TEXT VAR lower :: uppercase; + INT VAR x; + IF length(lower) MOD 2 <> 0 + THEN lower CAT ""0"" + FI ; + FOR x FROM 1 UPTO length(lower)DIV2 REP + replace (lower,x,lower pair (lower ISUB x)) + PER; + lower +END PROC lower case; + +PROC copy lines (FILE VAR dest, source): + INT VAR l; + input(source); + output(dest); + FOR l FROM 1 UPTO lines (source) REP + TEXT VAR scratch,test; + getline (source,scratch); + scratch := subtext (scratch,3); + test := scratch; + change all (test," ",""); + IF test <> "" + THEN putline (dest, scratch) + FI + PER +END PROC copy lines; + +.act plotter: + plotter[inst plotter] + +END PACKET graphik configuration; +configurate graphik diff --git a/app/mpg/1987/src/GRAPHIK.Fkt b/app/mpg/1987/src/GRAPHIK.Fkt new file mode 100644 index 0000000..b48141c --- /dev/null +++ b/app/mpg/1987/src/GRAPHIK.Fkt @@ -0,0 +1,1378 @@ +(***************************************************************************) +(* *) +(* FKT - Funktionenplotter *) +(* *) +(* Grundversion : MPG, KB, KN, LP 23.05.84 | 7756 Byte Code *) +(* Version 6.20 : MPG, Rainer Kottmann 23.09.85 | 7196 Byte Paketdaten *) +(* Angepasst an MPG-Turtle-Standard : 07.03.85 | 1374 Zeilen *) +(* Version 8.21 : MPG,Beat Jegerlehner 18.09.87 | *) +(* Angepasst an MPG EUMELGRAPHIK/EUMEL Version 1.8.1| *) +(* *) +(***************************************************************************) +PACKET funktionen DEFINES fkt plot, (*************************************) + y grenzen, (* Interaktives Programm *) + wertetafel, (* Einzelprozeduren fuer "do" *) + ~, (* BOOL OP "ungefaehr gleich" *) + luecke : (* Dummykonstante fuer "undefiniert" *) + (*************************************) + (* Autoren: Klaus Bovermann *) + (* Kai Nikisch *) + (* Lutz Prechelt *) + (* Rainer Kottmann *) + (* Beat Jegerlehner *) + (*************************************) + +LET fkpos = 1, (* Diese LETs sind Bildschirmpositionen *) + inpos = 2, + wpos = 3, + fehlerpos = 5, + eingpos = 7, + textpos = 11, + wahlpos = 24, + xupos = 16, + yupos = 16, + xopos = 32, + yopos = 32, + stuetzpktpos = 48, + endgeraetepos = 20; + +LET punkte = 512, (* maximale Anzahl der Stuetzpunkte *) + ug1 = 0.15051, (* Hilfswerte fuer 'gauss' *) + ug2 = 0.5, + ug3 = 0.84948, + din a 4 hoehe = 5.0, (* Hoehe der Beschriftung *) + din a 4 breite = 5.0, (* in mm *) + ziffern = 12, (* Genauigkeitsangabe *) + gross = 8.888888e88, + epsilon = 1.0e-11; + +LET wahlstring = ""8""2"fdwsazntlLAqeb~?", + farbstr = "Standard ot lau ruen chwarz", + farbchars = ""13"rbgs", + graphikvater = "GRAPHIK", + helpfile = "FKT.help"; + +ROW punkte REAL VAR graph; + +TEXT VAR term :: "", + rohterm :: "", + picfilename :: "", + prefix :: "PICFILE.", + postfix :: "", + fehlernachricht :: "", + proc, + inline; + +REAL VAR x min :: -gross, x max :: gross, + y min :: maxreal, y max :: -maxreal, + xstep; + +INT VAR nachkomma :: 2, + stuetzen :: punkte, + endgeraet :: 1, + endgeraete :: highest entry(plotters); + +BOOL VAR intervall definiert :: FALSE, + wertebereich bestimmt :: FALSE, + wertetafel vorhanden :: FALSE, + fehlerzustand :: FALSE; + +REAL CONST luecke :: gross; + +PICTURE VAR dummy picture :: nilpicture; +move (dummy picture,0.0,0.0); + +(***************************************************************************) +(* Alte Prozeduren (Graphik-unabhaengig) *) +(***************************************************************************) + +PROC get (TEXT VAR text): (* moeglichkeit, ueberall abzubrechen! *) + text := ""; + TEXT VAR exit char; + editget (text,""27"","",exit char); + IF exit char = ""27"" + THEN errorstop("Abgebrochen") + FI +END PROC get; + +PROC get (INT VAR nr): + TEXT VAR t; + get(t); + line; + nr := int(t) +END PROC get; + +PROC get (REAL VAR nr): + TEXT VAR t; + get(t); + line; + nr := real(t) +END PROC get; + +PROC editget (TEXT VAR t): + TEXT VAR t2 :: t,exit char; + editget(t2,""27"","",exit char); + IF exit char = ""27"" + THEN errorstop("Abgebrochen") + FI; + t := t2 +END PROC editget; + +PROC inchar (TEXT VAR a,TEXT CONST b): + REP + inchar (a) + UNTIL pos(b,a) <> 0 OR a = ""27"" PER; + IF a = ""27"" + THEN errorstop("Abgebrochen") + FI +END PROC inchar; + +BOOL OP ~ (REAL CONST left , right) : + abs (left - right) <= xstep +END OP ~; + +(******************* MAIN PROGRAMM *****************************) + +PROC fkt plot: + auswahlbild; + select plotter(name(plotters,endgeraet)); + REP + bild; + auswahl (inline) + UNTIL inline = "q" PER + +END PROC fkt plot; + +(****************** LAY OUT *****************************) + +PROC auswahlbild: + page; + cursor (1,textpos); + put ("(f) Funktionsterm eingeben "); + putline ("(?) Hilfestellung "); + put ("(d) Definitionsbereich waehlen "); + putline ("(q) in die Kommandoebene zurueck "); + put ("(w) Wertebereich ermitteln lassen "); + putline ("(s) Anzahl der Stuetzpunkte waehlen "); + put ("(z) Zeichnung anfertigen "); + putline ("(n) Nachkommastellenzahl waehlen "); + put ("(a) Ausgabe der Zeichnung auf Endgeraet"); + putline ("(e) Arbeit beenden "); + put ("(t) Wertetafel erstellen lassen "); + putline ("(L) Zeichnungen loeschen "); + put ("(l) Zeichnungen auflisten "); + putline ("(A) Zeichnungen archivieren "); + put (" "); + putline ("(b) Zeichnung beschriften "); + cursor (1,wahlpos); + put ("Ihre Wahl:") +END PROC auswahlbild; + +PROC bild: + cursor (1,fkpos); + put ("f(x) = " + rohterm); + out (""5""); + cursor (1,inpos); + put ("Def.Bereich: [ / ]"); + cursor (xupos,inpos); + put (text (x min,ziffern,nachkomma)); + cursor (xopos,inpos); + put (text (x max,ziffern,nachkomma)); + cursor (1,wpos); + put ("Wertebereich: [ / ]"); + cursor (yupos,wpos); + put (text (y min,ziffern,nachkomma)); + cursor (yopos,wpos); + put (text (y max,ziffern,nachkomma)); + cursor (1,endgeraetepos); + put endgeraetestring; + cursor (stuetzpktpos,inpos); + put ("Anzahl der Stuetzpunkte: " + text (stuetzen,3)); + drei zeilen ab eingpos loeschen. +END PROC bild; + +(****************** MONITOR *****************************) + +PROC auswahl 1 (TEXT VAR wahl): + enable stop; + SELECT code (wahl) OF + CASE 8 : endgeraet := max(endgeraet-1,1); + select plotter(name(plotters,endgeraet)) + CASE 2 : endgeraet := min(endgeraet+1,endgeraete); + select plotter(name(plotters,endgeraet)) + CASE 102 : fkt lesen (* f *) + CASE 100 : defbereich waehlen (* d *) + CASE 119 : wertebereich erstellen (* w *) + CASE 116 : wertetafel erstellen (* t *) + CASE 113 : LEAVE auswahl 1 (* q *) + CASE 122 : graph erstellen (* z *) + CASE 97 : graph zeigen (* a *) + CASE 110 : genauigkeitsangabe (* n *) + CASE 65 : dm; (* A *) + auswahlbild + CASE 108 : dateien listen (* l *) + CASE 76 : dateien aus task raeumen (* L *) + CASE 101 : unterbrechung (* e *) + CASE 126 : spezialeingabe (* TIL *) + CASE 63 : hilfe (* ? *) + CASE 115 : stuetzpunkte setzen (* s *) + CASE 98 : zeichnung beschriften (* b *) + END SELECT; +END PROC auswahl 1; + +PROC auswahl (TEXT VAR wahl): (* Faengerebene *) + cursor (12,24); + out (""5""); + inchar (wahl,wahlstring); + fehlerloeschen; + disable stop; + auswahl 1 (wahl); + IF is error + THEN fehlersetzen (error message); + clear error + FI; + enable stop; + IF fehlerzustand + THEN fehleraus (fehlernachricht) + FI +END PROC auswahl; + +PROC put endgeraetestring: + TEXT VAR s :: "Endgeraet: "; + INT VAR i; + THESAURUS CONST t :: plotters; + FOR i FROM 1 UPTO endgeraete REP + IF length(s)+length(name(t,i))+4 > 79 + THEN putline(s+""5""); + s := " " + FI; + IF i = endgeraet + THEN s CAT ""15"" + name(t,i) + " "14" " + ELSE s CAT " "+name(t,i) + " " + FI + PER; + putline(s+""5"") + +END PROC put endgeraetestring; + + +(**************************** f *******************************************) + +PROC fkt lesen: + reset wertebereich; + cursor (1,eingpos); + put ("f(x) ="); + out (""5""); + cursor (1,eingpos + 1); + out(""5""); + cursor (8,eingpos); + editget (rohterm); + change int to real (rohterm,term); + change all (term,"X","x"); + change all (term,"=","~"); (* Ueberdeckung von = *) + change all (term,"<~","<="); (* ruecksetzen von <= *) + change all (term,">~",">="); (* " >= *) + term testen; + wertetafel vorhanden := FALSE. + +term testen: + disable stop; + proc := "REAL PROC f (REAL CONST x):"; + proc CAT term; + proc CAT " END PROC f"; + do ("do ("""+proc+""")"); (* komischer do-Fehler *) + IF is error + THEN fehlersetzen ("Term fehlerhaft"); + clear error; + LEAVE fkt lesen + FI +END PROC fkt lesen; + +(**************************** d *******************************************) + +PROC defbereich waehlen: + cursor (1,eingpos); + put ("Untergrenze :"); + out (""5""); + get (x min); + obergrenze lesen; + intervall definiert := TRUE; + reset wertebereich. + +obergrenze lesen: + REP + put ("Obergrenze :"); + out (""5""); + get (x max); + IF x max <= x min + THEN out (""7""13""3""5"") + FI + UNTIL x max > x min PER +END PROC defbereich waehlen; + +(**************************** w *******************************************) + +PROC wertebereich erstellen: + IF rohterm = "" + THEN fehlersetzen ("Erst Fkts.Term eingeben! (f)"); + LEAVE wertebereich erstellen + ELIF NOT intervall definiert + THEN fehlersetzen ("Erst Def.Bereich waehlen (d)"); + LEAVE wertebereich erstellen + ELIF wertebereich bestimmt + THEN fehlersetzen ("Wertebereich ist bereits bestimmt"); + LEAVE wertebereich erstellen + FI; + proc := "REAL PROC f (REAL CONST x):"+ term; + proc CAT " END PROC f; ygrenzen (PROC f)"; + do (proc) +END PROC wertebereich erstellen; + +PROC ygrenzen (REAL PROC (REAL CONST) f): + REAL VAR x, f von x; + INT VAR i :: 1; + + disable stop; + xstep := (x max - x min) / real (stuetzen - 1); + x := x min; + y min := maxreal; + y max := -maxreal; + cursor (1,eingpos); + putline ("Wertebereich wird ermittelt"); + out (""5""); + out ("bei Stuetzpunkt Nr.: "); + wertegrenzen berechnen; + IF is error + THEN fehler setzen (error message); + reset wertebereich; + LEAVE ygrenzen + ELIF fehlerzustand + THEN reset wertebereich; + LEAVE ygrenzen + ELSE wertebereich bestimmt := TRUE + FI; + IF y min = y max + THEN y min DECR 1.0; + y max INCR 1.0 + FI. + +wertegrenzen berechnen: + FOR i FROM 1 UPTO stuetzen REP + x := real (i-1) * xstep + x min; + cout (i); + f von x := f (x); + graph [i] := f von x; + IF f von x <> luecke + THEN y min := min (y min, f von x); + y max := max (y max, f von x) + FI + UNTIL is error OR interrupt PER . + +interrupt: + IF incharety = ""27"" + THEN fehlersetzen ("Abgebrochen"); + TRUE + ELSE FALSE + FI +END PROC ygrenzen; + +(**************************** t *******************************************) + +PROC wertetafel erstellen: + IF rohterm = "" + THEN fehleraus ("Erst Fkts.Term eingeben (f)"); + LEAVE wertetafel erstellen + ELIF NOT intervall definiert + THEN fehleraus ("Erst Def.Bereich waehlen (d)"); + LEAVE wertetafel erstellen + FI; + proc := "REAL PROC f (REAL CONST x):"+ term; + proc CAT " END PROC f; wertetafel (PROC f)"; + do (proc) +END PROC wertetafel erstellen; + +PROC wertetafel (REAL PROC (REAL CONST ) f): + FILE VAR g :: sequential file (output,rohterm); + REAL VAR x, f von x; + INT VAR i :: 0; + + REP + schrittweite einlesen + UNTIL (xstep > 0.0) CAND ((x max-x min) / xstep < real (punkte)) PER; + x := x min; + evtl ueberschrift; + disable stop; + REP + datei erstellen + UNTIL x > x max OR is error PER; + fehleraus in tafel; + enable stop; + modify (g); + edit (g); + line; + IF yes("Tafel drucken") + THEN print (rohterm) + FI; + line (2); + IF yes("Tafel loeschen") + THEN forget(rohterm,quiet); + wertetafel vorhanden := FALSE + ELSE wertetafel vorhanden := TRUE + FI; + auswahlbild. + +evtl ueberschrift: + IF NOT wertetafel vorhanden + THEN putline (g, " W E R T E T A F E L"); + line (g); + putline (g, " x ! " + rohterm); + putline (g, "----------------!----------------") + FI. + +fehleraus in tafel: + IF is error + THEN fehlernachricht := errormessage; + clearerror; + line (g,2); + putline (g,fehlernachricht); + fehlernachricht := "" + FI. + +datei erstellen: + i INCR 1; + cout (i); + put (g, text (x,ziffern,nachkomma)); + put (g, " !"); + f von x := f (x); + IF f von x <> luecke + THEN put (g, text (f von x,ziffern,nachkomma)) + ELSE put (g, "Definitionsluecke") + FI; + line (g); + x INCR xstep. + +schrittweite einlesen: + cursor (1,eingpos); + put ("Schrittweite:"); + out (""5""); + cursor (1,eingpos + 1); + out (""5""); + cursor (15,eingpos); + get (xstep); + put ("Zwischenpunkt :"); + IF (xstep <= 0.0) COR ((x max-x min) / xstep > real (punkte)) + THEN fehleraus ("Schrittweite zu klein"); + LEAVE wertetafel + FI +END PROC wertetafel; + +(*********************************** n *************************************) + +PROC genauigkeitsangabe: + cursor (1,eingpos); + put ("Anzahl der Nachkommastellen : "); + get (nachkomma); + disable stop; + nachkomma := min (nachkomma, ziffern - 3); + nachkomma := max (nachkomma, 0); + IF is error + THEN fehlersetzen ("Falscher Wert"); + clear error; + nachkomma := 2 + FI +END PROC genauigkeitsangabe; + +(********************************l ****************************************) + +PROC dateien listen: + th(all LIKE (prefix+"*")); + auswahlbild +END PROC dateien listen; + +(********************************L ****************************************) + +PROC dateien aus task raeumen: + forget(some(all LIKE (prefix+"*"))); + auswahlbild +END PROC dateien aus task raeumen; + +(**************************** s *******************************************) + +PROC stuetzpunkte setzen: + cursor (1,eingpos); + put ("Anzahl der Stuetzpunkte :"); + get (stuetzen); + disable stop; + IF stuetzen <= 1 OR stuetzen > punkte + THEN fehler setzen ("Achtung Stuetzpunkte fehlerhaft") + FI; + stuetzen := max (stuetzen, 2) ; + stuetzen := min (stuetzen, punkte); + IF is error + THEN fehlersetzen ("Falscher Wert"); + clear error; + stuetzen := punkte + FI; + reset wertebereich +END PROC stuetzpunkte setzen; +(**************************** e *******************************************) + +PROC unterbrechung: + break; + auswahlbild +END PROC unterbrechung; + +(****************************** ? ******************************************) + +PROC hilfe: + IF NOT exists(helpfile) + THEN fetch(helpfile,task (graphikvater)) + FI; + FILE VAR f :: sequential file(input,helpfile); + headline(f,"Verlassen mit "); + open editor(f,FALSE); + edit (groesster editor,"q",PROC (TEXT CONST) dummy ed); + auswahlbild +END PROC hilfe; + +PROC dummy ed (TEXT CONST t): + IF t = "q" + THEN quit + ELSE out(""7"") + FI +END PROC dummy ed; + +(**************************** TILDE ****************************************) + +PROC spezialeingabe: + TEXT CONST termeingabename :: "Bitte Funktionsrumpf eingeben"; + TEXT VAR t; + FILE VAR f :: sequential file (modify, termeingabename); + + edit (f); + lese den term aus; + teste den term; + rohterm := "spezial"; + reset wertebereich; + auswahlbild. + +lese den term aus: + term := ""; + input (f); + WHILE NOT eof (f) REP + getline (f,t); + term CAT t; + term CAT " " + PER. + +teste den term: + disable stop; + proc := "REAL PROC f (REAL CONST x):"; + proc CAT term; + proc CAT " END PROC f"; + do (proc); + IF is error + THEN fehlersetzen ("Funktionsrumpf fehlerhaft"); + clear error; + term := ""; + rohterm := ""; + reset wertebereich; + auswahlbild; + LEAVE spezialeingabe + FI +END PROC spezialeingabe; + +(***************************************************************************) +(********* Ab hier Hilfsprozeduren *********) +(***************************************************************************) + +PROC fehleraus (TEXT CONST t): + cursor (1,fehlerpos); + out (""7"F E H L E R : ", t); + fehlerzustand := FALSE +END PROC fehleraus; + +PROC fehlerloeschen: + cursor (1,fehlerpos); + out (""5""); + fehlernachricht := ""; + fehlerzustand := FALSE +END PROC fehlerloeschen; + +PROC fehler setzen (TEXT CONST message): + fehlernachricht := message; + fehlerzustand := TRUE; + clear error +END PROC fehler setzen; + +REAL PROC gauss (REAL CONST z): + IF is integer (z) + THEN round (z,0) + ELIF sign (z) = -1 + THEN floor (z) - 1.0 + ELSE floor (z) + FI +END PROC gauss; + +BOOL PROC is integer (REAL CONST x): + abs (x - floor (x)) < epsilon +END PROC is integer; + +PROC berechnung (REAL CONST min, max, + REAL VAR sweite, + INT VAR styp): + + sweite := faktor * round (10.0 ** expo,11). + +faktor: + IF nachkomma < ug1 + THEN styp := 1; + 1.0 + ELIF nachkomma < ug2 + THEN styp := 2; + 2.0 + ELIF nachkomma < ug3 + THEN styp := 5; + 5.0 + ELSE styp := 1; + 10.0 + FI. + +nachkomma: + IF frac (logwert) < -epsilon + THEN 1.0 + frac (logwert) + ELIF frac (logwert) > epsilon + THEN frac (logwert) + ELSE 0.0 + FI. + +differenz: + max - min. + +expo: + gauss (logwert) - 1.0. + +logwert: + round (log10 (differenz),8) +END PROC berechnung; + +REAL PROC runde ab (REAL CONST was, auf): + auf * gauss (was / auf) +END PROC runde ab; + +REAL PROC runde auf (REAL CONST was, auf): + REAL VAR hilf :: runde ab (was,auf); + + IF abs (hilf - was) < epsilon + THEN was + ELSE hilf + auf + FI +END PROC runde auf; + +PROC loesche zeile (INT CONST zeile): + cursor (1,zeile); + out (""5"") +END PROC loesche zeile; + +PROC drei zeilen ab eingpos loeschen: + loesche zeile (eingpos); + loesche zeile (eingpos + 1); + loesche zeile (eingpos + 2); +END PROC drei zeilen ab eingpos loeschen; + +PROC change int to real (TEXT CONST term alt,TEXT VAR term neu): + TEXT VAR symbol :: "", presymbol :: ""; + INT VAR type :: 0, pretype :: 0, position; + LET number = 3, + tag = 1, + end of scan = 7, + pot = "**"; + + term neu := ""; + scan (term alt); + WHILE type <> end of scan REP + presymbol := symbol; + pretype := type; + next symbol (symbol,type); + IF type <> number OR presymbol = pot + THEN term neu CAT evtl mal und symbol + ELSE term neu CAT changed symbol + FI + PER. + +evtl mal und symbol: + IF pretype = number AND type = tag + THEN "*" + symbol + ELSE symbol + FI. + +changed symbol: + position := pos (symbol,"e"); + IF position <> 0 + THEN text (symbol,position - 1) + ".0" + + subtext (symbol,position,length (symbol)) + ELIF pos (symbol,".") = 0 + THEN symbol CAT ".0"; + symbol + ELSE symbol + FI +END PROC change int to real; + +PROC reset wertebereich: + y min := -maxreal; + y max := maxreal; + wertebereich bestimmt := FALSE +END PROC reset wertebereich; + +TEXT PROC textreal (REAL CONST z): + TEXT VAR t :: text (z); + + IF (t SUB length (t)) = "." + THEN subtext (t,1,length (t) - 1) + ELIF (t SUB 1) = "." + THEN "0" + t + ELIF (t SUB 2) = "." AND sign (z) = -1 + THEN "-0" + subtext (t,2) + ELIF t = "0.0" + THEN "0" + ELSE t + FI +END PROC textreal; + +INT PROC length (REAL CONST z): + length (text (z)) +END PROC length; + +PROC put format(INT CONST wo, REAL CONST xxmi,xxma,yymi,yyma): + cursor (1,wo); + put ("Aktuelles Format: xmin xmax" + + " ymin ymax"); + cursor (19,wo + 1); + put (text (xx mi,ziffern,nachkomma)); + cursor (34,wo + 1); + put (text (xx ma,ziffern,nachkomma)); + cursor (49,wo + 1); + put (text (yy mi,ziffern,nachkomma)); + cursor (64,wo + 1); + put (text (yy ma,ziffern,nachkomma)) +END PROC put format; + +PROC out (TEXT CONST a, b) : + out (a); out (b) +END PROC out; + +(***************************************************************************) +(* Neue Prozeduren *) +(***************************************************************************) + +PROC graph erstellen: + PICFILE VAR funktionen; + PICTURE VAR funktionsgraph :: nilpicture, + formatpic :: nilpicture; + REAL VAR xx min :: x min, + xx max :: x max, + yy min :: y min, + yy max :: y max; + + IF rohterm = "" + THEN fehlersetzen ("Erst Funktionsterm waehlen (f)"); + LEAVE graph erstellen + ELIF NOT wertebereich bestimmt + THEN fehlersetzen ("Erst Wertebereich bestimmen lassen (w)"); + LEAVE graph erstellen + FI; + + hole filenamen; + funktionen := picture file (picfilename); + initialisiere stifte; + waehle format; + zeichne graphen; + pictures ins picfile. + +hole filenamen: + TEXT VAR t :: ""; + REP + namen lesen + UNTIL t = "l" OR t = "e" PER. + +namen lesen: + cursor (1,eingpos); + out ("Welchen Namen soll die Zeichnung haben: "+ prefix); + postfix:= rohterm; + editget (postfix); + line; + IF (postfix SUB 1) = "?" + THEN picfilename := one(all LIKE (prefix+"*")); + auswahlbild; + bild; + cursor(1,eingpos) + ELSE picfilename := prefix + postfix; + picfilename := compress (picfilename) + FI; + IF NOT exists (picfilename) + THEN LEAVE hole filenamen + FI; + putline ("Zeichnung gibt es schon!"); + put ("loeschen (l), Namen neuwaehlen (n), " + + "alte Zeichnung ergaenzen (e):"); + inchar (t,"lne"); + IF t = "l" + THEN forget (picfilename,quiet) + ELIF t = "n" + THEN drei zeilen ab eingpos loeschen + FI. + +initialisiere stifte: + select pen (funktionen, 1, 1, 0, 1, TRUE); (* Standardfarbe *) + select pen (funktionen, 2, 2, 0, 1, TRUE); (* Rot *) + select pen (funktionen, 3, 3, 0, 1, TRUE); (* Blau *) + select pen (funktionen, 4, 4, 0, 1, TRUE); (* Gruen *) + select pen (funktionen, 5, 5, 0, 1, TRUE). (* Schwarz *) + +waehle format: + IF altes picfile + THEN ergaenze wertebereich + FI; + drei zeilen ab eingpos loeschen; + REAL VAR step; + INT VAR i dummy; + berechnung (yy min, yy max, step, idummy); + yy min := runde ab (yy min, step); + yy max := runde auf (yy max, step); + put format(eingpos, xx min, xx max, yy min, yy max); + pause ; + drei zeilen ab eingpos loeschen; + cursor(1,eingpos); + IF yes("Format aendern") + THEN interactive change of format (xx min,xx max,yy min,yy max) + FI; + drei zeilen ab eingpos loeschen. + +ergaenze wertebereich: + to pic (funktionen,3); (* Formatpicture *) + read picture (funktionen,formatpic); + move (formatpic, xx min, yy min); + move (formatpic, xx max, yy max); + extrema (formatpic, xx min, xx max, yy min, yy max). + +altes picfile: + t = "e". + +zeichne graphen: + REAL VAR x :: x min, + x schrittweite :: (x max - x min) / real (stuetzen - 1); + INT VAR i; + + cursor (1,eingpos); + put ("Graph bei Stuetzpunkt Nr. "); + FOR i FROM 1 UPTO stuetzen REP + cout (i); + IF graph[i] <> luecke + THEN IF zuletzt luecke + THEN move (funktionsgraph, x, graph[i]) + ELSE draw (funktionsgraph, x, graph[i]) + FI + FI; + x INCR x schrittweite + UNTIL abbruch PER; + drei zeilen ab eingpos loeschen. + + abbruch: + IF incharety = ""27"" + THEN errorstop("Abgebrochen"); + TRUE + ELSE FALSE + FI. + + zuletzt luecke: + i = 1 COR graph[i-1] = luecke. + +pictures ins picfile: + setze graphenfarbe; + to first pic(funktionen); + IF altes picfile + THEN down (funktionen); (* Skip *) + down (funktionen) + ELSE put picture (funktionen, dummy picture); (* Zusaetzliche Beschr.*) + put picture (funktionen, dummy picture) + FI; + formatpic := nilpicture; + move (formatpic, xx min, yy min); + move (formatpic, xx max, yy max); + IF altes picfile + THEN write picture (funktionen, formatpic) + ELSE put picture (funktionen, formatpic) + FI; + put picture (funktionen, funktionsgraph). + +setze graphenfarbe: + cursor (1,eingpos); + put("Farbe des Graphen :"); + pen (funktionsgraph, farbe). + +farbe : + TEXT VAR ff; + put(farbstr); + inchar (ff,farbchars); + out(ff); + pos (farbchars,ff). + +END PROC graph erstellen; + +PROC interactive change of format (REAL VAR x mi,x ma,y mi,y ma): + TEXT VAR tt; + REP + cursor (1,eingpos + 2); + put ("Geben Sie die neuen Koordinaten ein"); + out (""5""); + pause (20); + loesche zeile (eingpos + 2); + cursor (1,eingpos + 2); + put ("xmin:"); + tt := text (xmi); + editget (tt); + xmi := real (tt); + cursor (1,eingpos + 2); + put ("xmax:"); + out (""5""); + tt := text (xma); + editget (tt); + xma := real (tt); + cursor (1,eingpos + 2); + put ("ymin:"); + out (""5""); + tt := text (ymi); + editget (tt); + ymi := real (tt); + cursor (1,eingpos + 2); + put ("ymax:"); + out (""5""); + tt := text (yma); + editget (tt); + yma := real (tt); + UNTIL format ok PER. + + format ok: + IF xma <= xmi OR yma <= ymi + THEN fehlersetzen ("Format falsch"); + FALSE + ELSE TRUE + FI +END PROC interactive change of format; + +PROC geraet waehlen: +END PROC geraet waehlen; + +PROC zeichnung beschriften: + namen holen; + PICFILE VAR funktionen :: picture file(picfilename); + PICTURE VAR beschr; + to pic(funktionen,2); + read picture(funktionen,beschr); + cursor(1,eingpos); + put("Beschriftung (e) rgaenzen , (l) oeschen oder (a) bbruch"); + TEXT VAR t; + inchar(t,"ela"); + IF t = "l" + THEN to pic(funktionen,2); + beschr := nilpicture; + write picture(funktionen,beschr) + ELIF t = "e" + THEN beschrifte + FI; + cursor(1,eingpos); + drei zeilen ab eingpos loeschen. + + beschrifte: + farbe holen; + REAL VAR rx,ry,hx,bx; + to pic(funktionen,3); + PICTURE VAR format; + read picture(funktionen,format); + extrema(format,rx,ry,hx,bx); + drei zeilen ab eingpos loeschen; + put format (eingpos,rx,ry,hx,bx); + pause; + REP + drei zeilen ab eingpos loeschen; + cursor(1,eingpos); + put("Text :"); + TEXT VAR btext; + getline(btext); + put("Koordinaten in (c)m oder in (r)eal "); + inchar(t,"cra"); + drei zeilen ab eingpos loeschen; + cursor(1,eingpos); + put("X-Koordinate:"); + get(rx); + put("Y-Koordinate:"); + get(ry); + IF t = "c" + THEN move cm(beschr,rx,ry) + ELSE move (beschr,rx,ry) + FI; + drei zeilen ab eingpos loeschen; + cursor(1,eingpos); + put("Hoehe der Zeichen in mm :"); + get(hx); + put("Breite der Zeichen in mm:"); + get(bx); + draw(beschr,btext,0.0,hx,bx); + drei zeilen ab eingpos loeschen; + cursor(1,eingpos) + UNTIL no("Weitere Beschriftungen") PER; + to pic(funktionen,2); + write picture(funktionen,beschr). + + farbe holen: + drei zeilen ab eingpos loeschen; + cursor(1,eingpos); + put("Farbe der Beschriftungen: "); + TEXT VAR ff; + put(farbstr); + inchar (ff,farbchars); + out(ff); + pen(beschr,pos (farbchars,ff)). + + namen holen: + cursor(1,eingpos); + put("Wie heisst die Zeichnung:"); + out(prefix); + editget(postfix); + picfilename := prefix + postfix; + IF (postfix SUB 1) = "?" + THEN picfilename := one(all LIKE (prefix + "*")); + auswahlbild; + bild + FI; + IF NOT exists(picfilename) + THEN fehlersetzen("Zeichnung gibt es nicht"); + LEAVE zeichnung beschriften + FI + +END PROC zeichnung beschriften; + +PROC graph zeigen: + REAL VAR xx max,xx min,yy max,yy min; + + cursor (1,eingpos); + put ("Wie heisst die Zeichnung :"); + out(prefix); + editget(postfix); + picfilename := prefix+postfix; + IF (postfix SUB 1) = "?" + THEN picfilename := one(all LIKE (prefix+"*")); + postfix := subtext(picfilename,length(prefix)+1); + auswahlbild; + bild + ELIF NOT exists (picfilename) + THEN fehlersetzen ("Zeichnung gibt es nicht"); + LEAVE graph zeigen + FI; + drei zeilen ab eingpos loeschen; + PICFILE VAR funktionen :: picture file (picfilename); + PICTURE VAR rahmen :: nilpicture; + hole ausschnitt; + hole headline; + erzeuge rahmen; + gib bild aus. + + gib bild aus: + REAL VAR x cm,y cm; INT VAR i,j; + drawing area (x cm,y cm,i,j); + viewport (funktionen, 0.0, x cm/y cm, 0.0, 1.0); + erweitere bereich; (* Rundungsfehler beim clippen vermeiden !!! *) + window (funktionen, xx min, xx max, yy min, yy max); + plot (picfilename); + auswahlbild. + + erweitere bereich: + xx max := xx max + (xx max - xx min) / real(i). + + erzeuge rahmen: + to pic (funktionen,1); + waehle achsenart; + IF achsenart = "r" + THEN rahmen := frame (xx min,xx max,yy min,yy max) + ELSE rahmen := axis (xx min,xx max,yy min,yy max) + FI; + rahmen CAT beschriftung (xx min,xx max,yy min,yy max,headline, + achsenart = "r"); + cursor (1,eingpos); + put ("Farbe des"); + IF achsenart = "k" + THEN put("Koordinatensystems :") + ELSE put("Rahmens :") + FI; + pen (rahmen,farbe); + drei zeilen ab eingpos loeschen; + write picture (funktionen,rahmen). + + farbe : + TEXT VAR ff; + put(farbstr); + inchar (ff,farbchars); + out(ff); + pos (farbchars,ff). + + waehle achsenart: + TEXT VAR achsenart :: "r"; + IF koord moeglich + THEN frage nach achsenart + FI. + + frage nach achsenart: + cursor (1,eingpos); + put("oordinatensystem oder ahmen zeichnen ?"); + inchar (achsenart,"kr"); + putline(achsenart); + drei zeilen ab eingpos loeschen. + + koord moeglich: + NOT (xmin >= 0.0 OR xx max <= 0.0 OR yy min >= 0.0 OR yy max <= 0.0). + + hole ausschnitt: + PICTURE VAR format; + to pic (funktionen,3); + read picture (funktionen,format); + extrema (format, xx min, xx max, yy min, yy max); + cursor (1,eingpos); + put format (eingpos, xx min, xx max, yy min, yy max); + pause; + drei zeilen ab eingpos loeschen; + cursor (1,eingpos); + IF yes ("Wollen Sie den Ausschnitt veraendern") + THEN interactive change of format (xx min,xx max,yy min,yy max) + FI; + drei zeilen ab eingpos loeschen. + + hole headline: + cursor (1,eingpos); + TEXT VAR headline :: rohterm; + put ("Ueberschrift :"); + editget (headline); + drei zeilen ab eingpos loeschen +END PROC graph zeigen; + +PICTURE PROC frame (REAL CONST xx min,xx max,yy min,yy max): + + PICTURE VAR rahmen :: nilpicture; + zeichne achsen; + zeichne restrahmen; + rahmen. + + zeichne restrahmen: + move (rahmen,xx min,yy max); + draw (rahmen,xx max,yy max); + draw (rahmen,xx max,yy min). + + zeichne achsen: + rahmen := axis (xx min,xx max,yy min,(yy max - yy min) / 90.0,0,0); + rahmen CAT axis (yy min,yy max,xx min,(xx max - xx min) / 90.0,1,0) + +END PROC frame; + +PICTURE PROC axis (REAL VAR xx min,xx max,yy min,yy max): + PICTURE VAR rahmen :: nilpicture; + rahmen := axis (xx min,xx max,0.0,(yy max - yy min) / 180.0,0,1); + rahmen CAT axis (yy min,yy max,0.0,(xx max - xx min) / 180.0,1,1); + rahmen +END PROC axis; + +PICTURE PROC axis (REAL CONST min, max, pos,strich, + INT CONST dir,mode): + PICTURE VAR achse :: nilpicture; + REAL VAR step, + feinstep, + wert; + INT VAR type; + berechnung (min,max,step,type); + feinstep := step / real(zwischenstriche); + IF min MOD feinstep <> 0.0 + THEN wert := runde auf (min,feinstep); + ELSE wert := min + FI; + INT VAR zaehler :: int( wert MOD step / feinstep + 0.5); + WHILE wert <= max REP + IF wert = 0.0 + THEN ziehe nullstrich + ELIF zaehler MOD zwischenstriche = 0 + THEN ziehe normstrich + ELSE ziehe feinstrich + FI; + wert INCR feinstep; + zaehler INCR 1 + PER; + zeichne achse; + achse. + + zwischenstriche: + IF type = 2 + THEN 4 + ELSE 5 + FI. + + ziehe nullstrich: + REAL VAR p0 :: pos + real (mode) * strich * 3.0, + p1 :: pos - strich * 3.0; + ziehe linie. + + ziehe normstrich: + p0 := pos + real (mode) * strich * 2.0; + p1 := pos - strich * 2.0; + ziehe linie. + + ziehe feinstrich: + p0 := pos + real (mode) * strich; + p1 := pos - strich; + ziehe linie. + + zeichne achse: + IF dir = 0 + THEN move (achse,min,pos); + draw (achse,max,pos) + ELSE move (achse,pos,min); + draw (achse,pos,max) + FI. + + ziehe linie: + IF dir = 0 + THEN move (achse,wert,p0); + draw (achse,wert,p1) + ELSE move (achse,p0,wert); + draw (achse,p1,wert) + FI +END PROC axis; + +PICTURE PROC beschriftung (REAL VAR xx min,xx max,yy min,yy max, + TEXT CONST ueberschrift, + BOOL CONST mode): + PICTURE VAR rahmen :: nilpicture; + beschrifte; + rahmen. + + beschrifte : + REAL VAR x cm,y cm; + INT VAR dummy; + drawing area (x cm,y cm,dummy,dummy); + erweitere; + zeichne x achse; + zeichne y achse; + zeichne ueberschrift; + xx max := xn max; + xx min := xn min; + yy max := yn max; + yy min := yn min. + + erweitere: + REAL VAR hoehe :: din a4 hoehe / 23.5 * y cm, { der Zeichen } + breite :: din a4 breite / 30.5 * x cm; + INT CONST anzahl y stellen :: max (stellen (yy min),stellen (yy max)), + anzahl x stellen :: max (stellen (xx min),stellen (xx max)); + REAL VAR xn min :: xx min, + xn max :: xx max, + yn min :: yy min; + IF mode { rahmen wg clipping } + THEN xn min DECR (xx max - xx min) / 30.0; + yn min DECR (yy max - yy min) / 30.0 + FI; + REAL VAR xx dif :: xx max - xn min, + yy dif :: yy max - yn min, + yn dif :: y cm / (y cm - 2.0 * hoehe / 10.0 - 0.4) * yy dif, + xn dif :: x cm / (x cm - x erweiterung) * xx dif, + y 1 mm :: yn dif / y cm / 10.0, + r hoch :: hoehe / y cm / 10.0 * yn dif, + r breit:: breite / x cm / 10.0 * xn dif, + yn max :: yy max + r hoch + 3.0 * y 1 mm; + yn min := yn min - r hoch - 2.0 * y 1 mm; + IF mode + THEN xn min := xn min - real(anzahl y stellen) * r breit + FI. + + x erweiterung: + IF mode + THEN real(anzahl y stellen) * breite / 10.0 + ELSE 0.0 + FI. + + zeichne x achse: + TEXT VAR zahl :: text (xx min, anzahl x stellen, nachkomma); + ersetze zahl; + move (rahmen, max(xn min, xx min - real(length(zahl)) * r breit / 2.0), + yn min); + draw (rahmen, zahl, 0.0, breite, hoehe); + zahl := text (xx max, anzahl x stellen, nachkomma); + ersetze zahl; + move (rahmen, xx max - real(length(zahl)) * r breit, yn min); + draw (rahmen, zahl, 0.0, breite, hoehe). + + zeichne y achse: + zahl := text (yy min, anzahl y stellen, nachkomma); + ersetze zahl; + move (rahmen, max (xn min, xx min - real(length(zahl)) * r breit - + (xx max - xx min) / 30.0),yy min - r hoch / 2.0); + draw (rahmen, zahl, 0.0, breite, hoehe); + zahl := text (yy max,anzahl y stellen,nachkomma); + ersetze zahl; + move (rahmen, max (xn min, xx min - real(length(zahl)) * r breit - + (xx max - xx min) / 30.0),yy max - r hoch / 2.0); + draw (rahmen, zahl, 0.0, breite, hoehe). + + zeichne ueberschrift: + move (rahmen, (xx max + xx min - real(length(ueberschrift)) * r breit) + / 2.0, yy max + y 1 mm); + draw (rahmen, ueberschrift, 0.0, breite, hoehe). + + ersetze zahl: + change all (zahl, ".", ",") + +END PROC beschriftung; + +INT PROC stellen (REAL CONST r): + IF r = 0.0 + THEN nachkomma + 2 + ELSE nachkomma + 3 + max (0, int ( round(log10 (abs(r)),nachkomma))) + FI +END PROC stellen + +END PACKET funktionen; + +PACKET fkt manager DEFINES fkt manager: + +LET continue code = 100, + ack = 0, + nack = 1; + +DATASPACE VAR dummy space; +INT VAR order; +TASK VAR order task; + +PROC fkt manager: + set autonom; + disable stop; + break (quiet); + REP + forget (dummy space); + wait (dummy space, order, order task); + IF order >= continue code AND order task = supervisor + THEN call (supervisor, order, dummy space, order); + IF order = ack + THEN fkt online + FI; + set autonom; + command dialogue (FALSE); + forget (ALL myself) + ELSE send (order task, nack, dummy space) + FI + PER. + + fkt online: + command dialogue (TRUE); + fktplot; + IF online + THEN eumel must advertise; + break (quiet) + FI +END PROC fktmanager + +END PACKET fktmanager diff --git a/app/mpg/1987/src/GRAPHIK.Install b/app/mpg/1987/src/GRAPHIK.Install new file mode 100644 index 0000000..1058c2e --- /dev/null +++ b/app/mpg/1987/src/GRAPHIK.Install @@ -0,0 +1,82 @@ +(**************************************************************************) +(* *) +(* MPG - Graphik - System *) +(* *) +(* Version 2.1 vom 10.09.1987 *) +(* *) +(* (c) 1987 Beat Jegerlehner & Carsten Weinholz *) +(* unter Verwendung der Standard-Graphik *) +(* "Graphik-Installation" geschrieben von C.Weinholz *) +(* *) +(**************************************************************************) +(* *) +(* Dieses Programm wird in eine neueingerichtete Task *) +(* GRAPHIK vom Archiv geladen, und sorgt nach 'run' *) +(* fuer die volstaendige Installation des Graphik-Systems *) +(* *) +(**************************************************************************) +(* Urversion : 10.09.87 *) +(* Aenderungen: 23.09.87, Carsten Weinholz *) +(* global manager aequivalent ersetzt *) +(* 'family password' wird nun erfragt und gesetzt *) +(* *) +(**************************************************************************) +LET packet 1 = "GRAPHIK.Basis", + packet 2 = "GRAPHIK.Plot", + config = "GRAPHIK.Configurator", + install = "GRAPHIK.Configuration", + fkt = "GRAPHIK.Fkt", + fkthelp = "FKT.help", + turtle = "GRAPHIK.Turtle"; + +FILE VAR f; +TEXT VAR l; +INT VAR x; + +check off; +warnings off; +archiv; +fetch (ALLarchive- all,archive); +BOOL VAR new conf :: NOT exists (install); +IF new conf + THEN mess ("GRAPHIK muss neu konfiguriert werden") + ELSE new conf := yes ("GRAPHIK neu konfigurieren") +FI; +release; +ins (packet 1); +IF new conf + THEN run (config) + ELSE ins (install) +FI; +ins (packet 2); +ins (fkt); +ins (turtle); +do ("generate plot manager"); +mess (""15" Fertig "14""); +IF yes ("Alles loeschen") + THEN command dialogue (FALSE); + forget (all-fkthelp); + command dialogue (TRUE) +FI; +TEXT VAR geheim; +put ("GRAPHIK-Password: "); +get secret line (geheim); +family password (geheim); +global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) std manager); + +PROC ins (TEXT CONST name): + page; + f := sequential file (input, name); + FOR x FROM 1 UPTO 11 REP + getline (f,l); + putline (l); + PER; + mess ("""" + name + """ wird insertiert"13""10""); + insert (name) +END PROC ins; + +PROC mess (TEXT CONST msg): + line; + putline (msg); +END PROC mess; + diff --git a/app/mpg/1987/src/GRAPHIK.Manager b/app/mpg/1987/src/GRAPHIK.Manager new file mode 100644 index 0000000..b186e32 --- /dev/null +++ b/app/mpg/1987/src/GRAPHIK.Manager @@ -0,0 +1,900 @@ +(**************************************************************************) +(* *) +(* MPG - Graphik - System *) +(* *) +(* Version 2.2 vom 23.09.1987 *) +(* *) +(* (c) 1987 Beat Jegerlehner & Carsten Weinholz *) +(* unter Verwendung der Standard-Graphik *) +(* "Graphik-Plotmanager" geschrieben von C.Weinholz *) +(* *) +(**************************************************************************) +(* *) +(* Dieses Paket stellt den Multispool-Ausgabemanager *) +(* zur Verfuegung. *) +(* Er wird in der Regel durch Aufruf von *) +(* 'generate plot manager' in GRAPHIK in einer neuerzeugten *) +(* Sohntask 'PLOT' installiert. *) +(* *) +(**************************************************************************) +(* Urversion : 10.09.87 *) +(* Aenderungen: 23.09.87, Carsten Weinholz *) +(* Kommando 'spool control ("TEXT")' im Plot-Monitor *) +(* Anzeige von 'order tasks' anderer Stationen *) +(* Fehler : 'Zu viele DATASPACEs', selten, Ursache ungeklaert *) +(**************************************************************************) +PACKET plot manager DEFINES plot manager , + plot server : + +LET max spools = 12, (* BJ 15.10.87 (wg P9) *) + max entries = 20, (* Hinweis: max spools * max entries < 250 *) + + ack = 0, + second phase ack = 5, + false code = 6, + fetch code = 11, + save code = 12, + existscode = 13, + erase code = 14, + list code = 15, + all code = 17, + first code = 25, + start code = 26, + stop code = 27, + halt code = 28, + wait for halt code = 29, + continue code = 100, + picfiletype = 1102, + + trenn = "/", + + MSG = STRUCT (TEXT ds name, dev name, passwd, INT dev no), + + JOB = STRUCT (DATASPACE ds, TEXT ds name, TASK order task), + + ENTRY = STRUCT (JOB job, INT link), + + CHAIN = STRUCT (ROW max entries ENTRY entry, INT first, last, empty), + + SERVER = STRUCT (TASK task, wait for halt, REAL time, + JOB current job, BOOL stopped, INT link); + +ROW max spools STRUCT (SERVER server, CHAIN chain) VAR device; + +MSG VAR msg; + +INT VAR entry to erase, last created server, reply, current plotter; +FILE VAR chain info; +THESAURUS VAR managed plotter; +BOUND THESAURUS VAR thesaurus msg; +DATASPACE VAR reply ds; +TASK VAR control task; + +(********************************* SPOOL ***********************************) + +PROC plot manager : + INT VAR act dev; + managed plotter := plotters LIKE (text (station (myself)) + any); + FOR act dev FROM 1 UPTO max devices REP + init device (act dev) + PER; + control task := niltask; + end global manager (FALSE); + global manager (PROC (DATASPACE VAR,INT CONST,INT CONST,TASK CONST)plot manager) +END PROC plot manager; + +PROC plot manager (DATASPACE VAR ds, INT CONST order, phase, TASK CONST order task): + INT VAR act dev; + SELECT order OF + CASE fetch code : y fetch + CASE save code : y save + CASE exists code: y exists + CASE erase code : y erase + CASE list code : y list + CASE all code : y all + OTHERWISE IF order >= continue code AND order task = supervisor + THEN forget (ds); + continue (order - continue code); + spool monitor + ELIF priv control op + THEN SELECT order OF + CASE first code : y first + CASE start code : y start + CASE stop code : y stop + CASE halt code : y halt + CASE wait for halt code : y halt + OTHERWISE order error + ENDSELECT + ELSE order error + FI; + END SELECT; + BOOL VAR test; + FOR act dev FROM 1 UPTO max devices REP + test := server is active (act dev) + PER. + + priv control op: + (order task = father) OR (order task < supervisor) OR + spool control task. + + spool control task: + NOT (order task = niltask) CAND + ((order task = control task) OR (order task < control task)). + + y fetch: + FOR act dev FROM 1 UPTO max devices REP + UNTIL act server.task = order task PER; + IF act dev > max devices + THEN order error + ELIF chain is empty (act dev) OR act server.stopped + THEN end server (act dev); + IF exists (act server.wait for halt) + THEN send (act server.wait for halt, ack); + act server.wait for halt := niltask + FI + ELSE transfer next job (act dev); + send current job (act dev) + FI. + + y save: + IF phase = 1 + THEN y save pre + ELSE y save post + FI. + + y save pre: + link dev; + IF act dev = 0 + THEN device error + ELIF chain is full (act dev) + THEN errorstop ("SPOOL ist voll") + ELSE send (order task, second phase ack) + FI. + + y save post: + act dev := msg.dev no; + IF type (ds) <> picfile type + THEN forget (ds); + errorstop ("Datenraum hat falschen Typ") + ELSE entry into chain (act dev, new job); + forget (ds); + IF NOT (server is active (act dev) OR act server.stopped) + THEN create server (act dev) + FI; + send ack + FI. + + new job: + JOB : (ds, msg.ds name, order task). + + y exists: + link dev; + IF find entry (msg.ds name,act dev,order task, priv control op) = 0 + THEN send (order task, false code, ds) + ELSE send ack + FI. + + y erase: + IF phase = 1 + THEN link dev; + IF act dev > 0 + THEN y erase pre + ELSE device error + FI + ELSE erase entry (act dev, entry to erase); + send ack + FI. + + y erase pre: + entry to erase := find entry (msg.ds name,act dev, order task, priv control op); + IF order not from job order task AND NOT priv control op + THEN errorstop ("Kein Zugriffsrecht auf Auftrag """ + msg.ds name + """") + ELIF entry to erase = 0 + THEN manager message ("""" + msg.ds name + """ existiert nicht") + ELSE manager question (erase msg) + FI. + + erase msg: + TASK VAR owner ::act chain.entry [entry to erase].job.order task; + owner id (owner) + "/ """ + msg.ds name + + """ in Spool """ + name (managed plotter, act dev) + + """ loeschen". + + order not from job order task: + NOT (act chain.entry [entry to erase].job.order task = order task). + + y list: + link dev; + create chain list (act dev); + send (order task, ack, reply ds). + + y all: + link dev; + forget (reply ds); + reply ds := nilspace; + thesaurus msg := reply ds; + thesaurus msg := chain thesaurus (act dev, owner or priv task, FALSE); + send (order task, ack, reply ds). + + owner or priv task: + IF priv control op + THEN niltask + ELSE order task + FI. + + y start: + link dev; + IF act dev = 0 + THEN FOR act dev FROM 1 UPTO max devices REP + start (act dev) + PER + ELSE start (act dev) + FI; + send ack. + + y stop: + IF phase = 1 + THEN y stop pre + ELSE y stop post + FI. + + y stop pre: + link dev; + IF act dev > 0 + THEN stop (act dev); + IF NOT is no job (act server.current job) + THEN manager question ("""" + act server.current job.ds name + + """ neu eintragen") + ELSE send ack + FI + ELSE FOR act dev FROM 1 UPTO max devices REP + stop (act dev) + PER; + send ack + FI. + + y stop post: + act dev := msg.dev no; + entry into chain (act dev, act server.current job); + IF act chain.last > 1 + THEN make new first (act dev, act chain.last) + FI; + send ack. + + y halt: + link dev; + IF act dev = 0 + THEN IF order <> halt code + THEN device error + ELSE FOR act dev FROM 1 UPTO max devices REP + halt (act dev) + PER; + send ack + FI + ELSE halt (act dev); + IF order = halt code + THEN send ack; + act server.wait for halt := niltask + ELSE act server.wait for halt := order task + FI + FI. + + y first: + link dev; + IF act dev = 0 + THEN device error + ELSE INT VAR new first entry :: find entry (msg.ds name,act dev,order task,TRUE); + IF new first entry = 0 + THEN manager message ("""" + msg.ds name + """ existiert nicht") + ELSE make new first (act dev,new first entry); + send ack + FI + FI. + + act server: + device [act dev].server. + + act chain: + device [act dev].chain. + + send ack: + send (order task, ack). + + link dev: + msg := ds; + act dev := msg.dev no. + + order error: + errorstop ("Falscher Auftrag fuer Task """ + name (myself) + """"). + + device error: + IF plotter (msg.dev name) = no plotter + THEN clear error; (* 'plotter(TEXT)' liefert evtl. bereits error *) + errorstop ("Kein Endgeraet eingestellt") + ELSE clear error; + errorstop ("Unbekanntes Endgeraet: """ + msg.dev name + """") + FI. +END PROC plot manager; + +(****************************** Spool Monitor ******************************) + +INT VAR command index , params ; +TEXT VAR command line, param 1, param 2 ; + +LET spool command list = +"break:1.0start:2.0stop:3.0halt:4.0first:5.0killer:6.0listspool:7.0 + clearspool:8.0selectplotter:9.0spoolcontrol:10.1"; + +PROC spool monitor: + disable stop ; + current plotter := 0; + select plotter (""); + REP command dialogue (TRUE) ; + get command (gib kommando, command line); + analyze command (spool command list, command line, 3, command index, + params, param1, param2); + execute command; + UNTIL NOT online PER; + command dialogue (FALSE); + break (quiet); + set autonom. + + gib kommando: + IF actual plotter > 0 + THEN plotter info (name(plotters,actual plotter),50) + ELSE "ALL-Plotter: " + FI +END PROC spool monitor; + +PROC execute command: + enable stop; + SELECT command index OF + CASE 1 : break + CASE 2 : start cmd + CASE 3 : stop cmd + CASE 4 : halt cmd + CASE 5 : first cmd + CASE 6 : killer cmd + CASE 7 : show spool list + CASE 8 : clear spool + CASE 9 : select plotter cmd + CASE 10 : set spool control + OTHERWISE do (command line); + set current plotter + END SELECT. + + set current plotter: + current plotter := link(managed plotter, name (plotters,actual plotter)); + IF actual plotter > 0 AND current plotter = 0 + THEN select plotter (""); + current plotter := 0; + errorstop ("Auf dieser Station unbekannt: """+name(plotter)+"""") + FI. + + start cmd: + FOR act dev FROM curr dev UPTO top dev REP + start (act dev) + PER. + + stop cmd: + FOR act dev FROM curr dev UPTO top dev REP + IF device [act dev].server.current job.ds name <> "" CAND + yes ("""" + device [act dev].server.current job.ds name + + """ neu eintragen") + THEN entry into chain (act dev, device [act dev].server.current job); + IF device [act dev].chain.last > 1 + THEN make new first (act dev, device [act dev].chain.last) + FI + FI; + stop (act dev) + PER. + + halt cmd: + FOR act dev FROM curr dev UPTO top dev REP + halt (act dev) + PER. + + first cmd: + IF current plotter = 0 + THEN device error + FI; + TEXT VAR make to first :: one (chain thesaurus (current plotter,niltask,TRUE) + -first chain entry) + IF make to first <> "" + THEN INT VAR new first entry :: find entry (make to first, + current plotter, niltask, FALSE); + IF new first entry > 1 + THEN make new first (current plotter, new first entry) + FI + FI. + + first chain entry: + INT VAR first entry id :: device [current plotter].chain.first; + IF first entry id > 0 + THEN device [current plotter].chain.entry[first entry id].job.ds name + ELSE "" + FI. + + killer cmd: + IF current plotter = 0 + THEN device error + FI; + THESAURUS VAR to erase :: chain thesaurus (current plotter,niltask,FALSE); + INT VAR index, act dev; + TEXT VAR name to erase; + FOR act dev FROM curr dev UPTO top dev REP + index := 0; + get (to erase, name to erase, index); + WHILE index > 0 REP + INT VAR entry to erase := find entry (name to erase, current plotter, niltask, TRUE); + IF (entry to erase > 0) CAND + yes ("""" + name to erase + """ loeschen") + THEN erase entry (current plotter, entry to erase) + FI; + get (to erase, name to erase, index) + PER + PER. + + show spool list : + create chain list (current plotter); + show (chain info); + forget (reply ds). + + clear spool: + FOR act dev FROM curr dev UPTO top dev REP + IF yes ("Spool """ + name (managed plotter, act dev) + """ initialisieren") + THEN BOOL VAR stopped :: device [act dev].server.stopped; + stop (act dev); + init device (act dev); + IF stopped + THEN device [act dev].server.stopped := TRUE + ELSE start (act dev) + FI + FI + PER. + + set spool control: + control task := task (param 1). + + select plotter cmd: + THESAURUS VAR plotter list :: empty thesaurus; + TEXT VAR plotter name; + get (managed plotter, plotter name, index); + WHILE index > 0 REP + insert (plotter list, plotter info (plotter name, 60)); + get (managed plotter, plotter name, index) + PER; + select plotter (name (managed plotter, + link (plotter list,one (plotter list)))); + set current plotter. + + curr dev: + IF current plotter = 0 + THEN 1 + ELSE current plotter + FI. + + top dev: + IF current plotter = 0 + THEN max devices + ELSE current plotter + FI. + + device error: + errorstop ("Kein Endgeraet eingestellt") + +ENDPROC execute command ; + +(************************** SPOOL - Verwaltung *****************************) + +PROC entry into chain (INT CONST dev no, JOB CONST new job): + INT VAR act entry := act chain.empty; + act chain.empty := act chain.entry [act entry].link; + IF act chain.last > 0 + THEN act chain.entry [act chain.last].link := act entry + FI; + act chain.last := act entry; + IF act chain.first = 0 + THEN act chain.first := act entry + FI; + act chain.entry [act entry] := ENTRY : (new job,0). + + act chain : + device [dev no].chain +END PROC entry into chain; + +PROC erase entry (INT CONST dev no, to erase): + INT VAR act entry; + to forward entry; + IF act entry > 0 + THEN act chain.entry [act entry].link := act chain.entry [to erase].link + FI; + IF act chain.last = to erase + THEN act chain.last := act entry + FI; + IF act chain.first = to erase + THEN act chain.first := act chain.entry [to erase].link + FI; + init job (act chain.entry [to erase].job); + act chain.entry [to erase].link := act chain.empty; + act chain.empty := to erase. + + to forward entry: + FOR act entry FROM 1 UPTO max entries REP + UNTIL act chain.entry [act entry].link = to erase PER; + IF act entry > max entries + THEN act entry := 0 + FI. + + act chain: + device [dev no].chain +END PROC erase entry; + +INT PROC find entry (TEXT CONST ds name, INT CONST dev, TASK CONST order task,BOOL CONST priviledged): + INT VAR act dev :: dev,act entry,last found :: 0; + IF act dev = 0 + THEN FOR act dev FROM 1 UPTO max devices REP + find entry of order task + UNTIL act entry > 0 PER + ELSE find entry of order task + FI; + IF act entry = 0 + THEN last found + ELSE act entry + FI. + + find entry of order task: + BOOL VAR entry found; + act entry := act chain.first; + WHILE act entry > 0 REP + entry found := (act chain.entry [act entry].job.ds name = ds name); + IF entry found + THEN last found := act entry; + entry found := (index (act chain.entry [act entry].job.order task) = + index (order task)) OR priviledged + FI; + IF NOT entry found + THEN act entry := act chain.entry [act entry].link + FI + UNTIL entry found PER. + + act chain: + device [act dev].chain + +END PROC find entry; + +PROC make new first (INT CONST dev no, new first): + JOB VAR new first job :: act chain.entry [new first].job; + erase entry (dev no, new first); + INT VAR act entry := act chain.empty; + act chain.empty := act chain.entry [act entry].link; + act chain.entry [act entry] := ENTRY : (new first job, act chain.first); + act chain.first := act entry; + IF act chain.last = 0 + THEN act chain.last := act entry + FI. + + act chain: + device [dev no].chain + +END PROC make new first; + +THESAURUS PROC chain thesaurus (INT CONST dev no, TASK CONST order task, + BOOL CONST double): + THESAURUS VAR list :: empty thesaurus; + INT VAR act dev := dev no,act entry; + IF act dev = 0 + THEN FOR act dev FROM 1 UPTO max devices REP + list chain + PER + ELSE list chain + FI; + list. + + list chain: + act entry := act chain.first; + WHILE act entry > 0 REP + IF (order task = niltask) OR + (act chain.entry [act entry].job.order task = order task) + THEN insert job name + FI; + act entry := act chain.entry [act entry].link + PER. + + insert job name: + TEXT VAR this job :: act chain.entry [act entry].job.ds name + IF double OR (NOT (list CONTAINS this job)) + THEN insert (list, this job) + FI. + + act chain: + device [act dev].chain + +END PROC chain thesaurus; + + +PROC create chain list (INT CONST dev no): + INT VAR act dev :: dev no, act entry; + init chain info; + IF act dev = 0 + THEN FOR act dev FROM 1 UPTO max devices REP + list chain + PER + ELSE list chain + FI. + + init chain info: + forget (reply ds); + reply ds := nilspace; + chain info := sequential file (output, reply ds); + headline (chain info,"GRAPHIK - Ausgabe um "+ time of day (clock (1)) + " Uhr :"). + + + list chain: + server head; + IF NOT server is active (act dev) OR is no job (act server.current job) + THEN put (chain info, "- Kein Auftrag in Bearbeitung") ; + IF act server.stopped + THEN put (chain info, " ( SERVER deaktiviert )") + FI; + line (chain info) + ELSE put (chain info, "- In Bearbeitung seit "+time of day (act server.time)+" Uhr :"); + IF act server.stopped + THEN put (chain info, " ( SERVER wird deaktiviert !)") + FI; + line (chain info, 2); + putline (chain info, job note (act server.current job)) + FI; + line (chain info); + IF act chain.last = 0 + THEN putline (chain info, "- Keine Auftraege im SPOOL") + ELSE putline (chain info, "- Weitere Auftraege im SPOOL :"); + line (chain info); + act entry := act chain.first; + WHILE act entry > 0 REP + putline (chain info, job note (act chain.entry [act entry].job)); + act entry := act chain.entry [act entry].link + PER + FI; + line (chain info, 2). + + server head: + TEXT VAR plotter name :: name (managed plotter,act dev); + INT VAR station :: int (plottername), + tp :: pos (plottername,trenn)+1, + channel :: int (subtext (plottername,tp)); + plotter name := subtext (plotter name, pos (plotter name, trenn, tp)+1); + putline (chain info, 77 * "-"); + putline (chain info, + center (plotter name + (30-length(plotter name))*"." + + "Kanal " + text (channel) + + "/Station " + text (station))); + putline (chain info, 77 * "-"); + line (chain info). + + act chain: + device [act dev].chain. + + act server: + device [act dev].server + +END PROC create chain list; + +BOOL PROC chain is empty (INT CONST dev no): + device [dev no].chain.first = 0 OR device [dev no].chain.last = 0 +END PROC chain is empty; + +BOOL PROC chain is full (INT CONST dev no): + device [dev no].chain.empty = 0 +END PROC chain is full; + +PROC transfer next job (INT CONST dev no): + INT VAR next chain entry := device [dev no].chain.first; + next server job (dev no, device [dev no].chain.entry [next chain entry].job); + erase entry (dev no,next chain entry) +END PROC transfer next job; + +(*************************** SERVER - Verwaltung ***************************) + +PROC next server job (INT CONST dev no,JOB CONST next job): + act server.time := clock (1); + act server.current job := next job. + + act server: + device [dev no].server +END PROC next server job; + +BOOL PROC server is active (INT CONST dev no): + exists (act server.task) CAND server alive or restarted. + + server alive or restarted: + SELECT status (act server.task) OF + CASE 0 (* busy *) , + 4 (* busy-blocked *), + 2 (* wait *), + 6 (* wait-blocked *) : TRUE + CASE 1 (* i/o *), + 5 (* i/o -blocked *): IF channel (act server.task) = 0 + THEN restart + ELSE TRUE + FI + OTHERWISE restart + END SELECT. + + restart: + end server (dev no); + IF NOT act server.stopped AND NOT chain is empty (dev no) + THEN create server (dev no) + FI; + NOT is niltask (act server.task). + + act server: + device [dev no].server + +END PROC server is active; + +PROC create server (INT CONST dev no): + init job (act server.current job); + act server.wait for halt := niltask; + act server.time := 0.0; + act server.stopped := FALSE; + last created server := dev no; + begin (PROC plot server, device [dev no].server.task). + + act server: + device [dev no].server +END PROC create server; + +PROC end server (INT CONST dev no): + end (act server.task); + act server.task := niltask. + + act server: + device [dev no].server + +END PROC end server; + +PROC start (INT CONST dev no): + IF server is active (dev no) + THEN end server (dev no) + FI; + IF NOT chain is empty (dev no) + THEN create server (dev no) + FI; + device [dev no].server.stopped := FALSE +END PROC start; + +PROC stop (INT CONST dev no): + device [dev no].server.stopped := TRUE; + IF exists (device [dev no].server.wait for halt) + THEN send (device [dev no].server.wait for halt,ack) + FI; + device [dev no].server.wait for halt := niltask; + IF server is active (dev no) + THEN end server (dev no) + FI +END PROC stop; + +PROC halt (INT CONST dev no): + device [dev no].server.stopped := TRUE +END PROC halt; + +PROC send current job (INT CONST dev no): + forget (reply ds); + reply ds := device [dev no].server.current job.ds; + send (device [dev no].server.task, ack,reply ds); +END PROC send current job; + +(****************************** Hilfsprozeduren ****************************) + +PROC init device (INT CONST dev no): + INT VAR act entry; + act server.task := niltask; + act server.time := 0.0; + init job (act server.current job); + act server.stopped := FALSE; + act chain.first := 0; + act chain.last := 0; + act chain.empty := 1; + FOR act entry FROM 1 UPTO max entries-1 REP + init job (act chain.entry [act entry].job); + act chain.entry [act entry].link := act entry + 1 + PER; + init job (act chain.entry [act entry].job); + act chain.entry [act entry].link := 0. + + act server : + device [dev no].server. + + act chain : + device [dev no].chain + +END PROC init device; + +INT PROC max devices: + highest entry (managed plotter) +END PROC max devices; + +OP := (MSG VAR dest, DATASPACE VAR source): + TEXT VAR ds name :: "", dev name :: ""; + BOUND STRUCT (TEXT ds name, dev name, passwd) VAR msg in := source; + divide names; + dest := MSG : (ds name, dev name, msg in .passwd, + link (managed plotter,dev name)); + forget (source). + + divide names: + INT VAR pps :: pos (msg in.ds name, ""0""); + WHILE pos (msg in.ds name, ""0"", pps+1) > 0 REP + pps := pos (msg in.ds name,""0"", pps+1) + PER; + IF pps > 0 + THEN ds name := subtext (msg in.ds name, 1, pps-1); + FI; + dev name := subtext (msg in.ds name, pps+1). + +END OP :=; + +TEXT PROC job note (JOB CONST job): + " - " + owner id (job.order task) + " : " + qrline (job.ds name, 20) + + " (" + text (storage (job.ds)) + " K)". +END PROC job note; + +TEXT PROC owner id (TASK CONST owner): + TEXT VAR test :: name (owner); + IF test <> "" + THEN text (station (owner)) + "/" + qrline (test,15) + ELSE "?????" + FI +END PROC owner id; + +PROC init job (JOB VAR to initialize): + forget (to initialize.ds); + to initialize.ds name := ""; + to initialize.order task := niltask +END PROC init job; + +TEXT PROC qrline (TEXT CONST t,INT CONST len): + IF length (t) > len-2 + THEN """" + text (t, len-5) + "...""" + ELSE text ("""" + t + """", len) + FI +END PROC qrline; + +TEXT PROC center (TEXT CONST chars,INT CONST len): + len DIV 2 * " " + chars +END PROC center; + +BOOL PROC is no job (JOB CONST job): + job.ds name = "" +END PROC is no job; + +PROC send (TASK CONST task, INT CONST code): + DATASPACE VAR ds :: nilspace; + send (task, code, ds); + forget (ds) +END PROC send; + +(**************************** Plot - Server ********************************) + +PROC plot server: + disable stop; + select plotter (name (managed plotter,last created server)); + prepare; + REP + TEXT VAR dummy; + catinput (dummy, dummy); (* evtl. Zeichen im Tastaturpuffer *) + PICFILE VAR pic :: next server job; + plot (pic); + PER. + + next server job: + forget (reply ds); + reply ds := nilspace; + REP + call (father, fetch code, reply ds, reply) + UNTIL reply = ack PER; + reply ds +END PROC plot server; + +END PACKET plot manager diff --git a/app/mpg/1987/src/GRAPHIK.Plot b/app/mpg/1987/src/GRAPHIK.Plot new file mode 100644 index 0000000..00911a8 --- /dev/null +++ b/app/mpg/1987/src/GRAPHIK.Plot @@ -0,0 +1,1156 @@ +(**************************************************************************) +(* *) +(* MPG - Graphik - System *) +(* *) +(* Version 2.2 vom 23.09.1987 *) +(* *) +(* (c) 1987 Beat Jegerlehner & Carsten Weinholz *) +(* unter Verwendung der Standard-Graphik *) +(* "Graphik-Plot" geschrieben von C.Weinholz *) +(* *) +(**************************************************************************) +(* *) +(* Paket II: Endgeraet-abhaengige Graphikroutinen *) +(* (koennen erst nach 'Interface.Conf' insertiert werden) *) +(* *) +(* 1. Plot (Grundlegende Graphik-Operationen *) +(* *) +(* 2. Plot Input/Output (Routinen zum *) +(* Ansprechen des PLOT-Spoolers *) +(* zur indirekten Graphik-Ausgabe) *) +(* *) +(* 3. Plot Picture/Picfile *) +(* (Ausgabe von PICTURES/ PICFILES) *) +(* *) +(**************************************************************************) +(* Urversion : 10.09.87 *) +(* Aenderungen: 23.09.87, Carsten Weinholz *) +(* PROC save (PICFILE CONST, TEXT CONST, PLOTTER CONST) *) +(* hinzugefuegt *) +(* PROC plot (PICFILE CONST) auch indirekt *) +(* Fehlermeldung bei indirektem 'plot (PICTURE)' *) +(* 20.11.87, Beat Jegerlehner *) +(* Clipping bei move eingefuehrt. Gibt sonst bei Watanabe *) +(* Probleme *) +(* Textgenerator korrigiert *) +(* *) +(**************************************************************************) + +(************************************ Plot ********************************) + +PACKET basis plot DEFINES + + beginplot, + pen , + + move , + move r , + move cm , + move cm r, + + draw , + draw r , + draw cm , + draw cm r, + + hidden lines, + reset , + + zeichensatz, + reset zeichensatz, + + linetype, + reset linetypes, + + where, + bar, + circle, + box: + +LET empty = 0, (* Punktmuster *) + half = 1, + full = 2, + horizontal = 3, + vertical = 4, + cross = 5, + diagonal right = 6, + diagonal left = 7, + diagonal both = 8, + std zeichenname = "ZEICHENSATZ"; + +INT VAR ltype :: 1, + thick :: 0, + xpixel :: 0, + ypixel :: 0, + old x :: 0, + old y :: 0, + real old x :: 0, + real old y :: 0; + +REAL VAR x cm, ycm,hor relation, vert relation,x to y,y to x; + +ROW 5 TEXT VAR linetypes; + +INT VAR cnt :: 0; +TEXT VAR muster :: "0"; +INT VAR lentxt :: length(muster); + +LET POS = STRUCT (REAL x, y, z); +POS VAR pos :: POS : (0.0, 0.0, 0.0); + +LET ZEICHENSATZ = ROW 255 TEXT; +ZEICHENSATZ VAR zeichen; +REAL CONST char x :: 6.0, char y :: 6.0,y base :: 2.0; + +BOUND ZEICHENSATZ VAR std zeichen :: old (std zeichenname); +reset zeichensatz; +reset linetypes; + +INT VAR h :: 0, v :: 0, new h :: 0, new v :: 0; + +BOOL VAR hidden :: FALSE; + +DATASPACE VAR ds :: nilspace; +BOUND STRUCT (ROW 32764 INT akt, last) VAR maxima :: ds; + +(*************************** Initialisierung *******************************) + +PROC beginplot: + init plot; + drawing area (x cm, y cm, x pixel, y pixel); + hor relation := real (x pixel)/x cm; + vert relation:= real (y pixel)/y cm; + x to y := x cm / real(x pixel) / (y cm / real (y pixel)); (*umrechnung:*) + y to x := 1.0 / x to y; (* x pixel in y pixel u andersherum*) +END PROC beginplot; + +PROC pen (INT CONST backgr,colour,thickn,linetype): + background(backgr); + foreground(colour); + thick := int(real(thickn) / 200.0 * real(x pixel) / x cm); + ltype := selected linetype; + IF ltype > 1 + THEN muster := linetypes[ltype]; + lentxt := length (muster); + cnt := 0 + FI. + + selected linetype: + IF linetype < 0 OR linetype > 5 + THEN 1 + ELSE linetype + FI +END PROC pen; + +(************************** MOVE - Prozeduren ******************************) + +PROC move (INT CONST x,y): + old x := x; + old y := y +END PROC move; + +PROC do move (INT CONST x,y): + IF x <> real old x OR + y <> real old y + THEN real old x := x; + real old y := y; + move to (x,y) + FI; + old x := x; + old y := y +END PROC do move; + +PROC move (REAL CONST x, y) : + IF hidden + THEN maxima.last := maxima.akt FI; + + transform (x, y, 0.0, h, v); + move (h, v); + pos := POS : (x, y, 0.0) +END PROC move; + +PROC move (REAL CONST x, y, z) : + IF hidden + THEN maxima.last := maxima.akt FI; + + transform (x, y, z, h, v); + move (h, v); + pos := POS : (x, y, z) +END PROC move; + +PROC move r (REAL CONST x, y) : + IF hidden + THEN maxima.last := maxima.akt FI; + + transform (pos.x+x, pos.y+y, pos.z, h, v); + move (h, v); + pos := POS : (pos.x+x, pos.y+y, pos.z) +END PROC move r; + +PROC move r (REAL CONST x, y, z) : + IF hidden + THEN maxima.last := maxima.akt FI; + + transform (pos.x+x, pos.y+y, pos.z+z, h, v); + move (h, v); + pos := POS : (pos.x+x, pos.y+y, pos.z+z) +END PROC move r; + +PROC move cm (REAL CONST x cm, y cm) : + IF hidden + THEN maxima.last := maxima.akt FI; + + h := int (x cm*hor relation+0.5); + v := int (y cm*vert relation+0.5); + move (h, v) +END PROC move cm; + +PROC move cm r (REAL CONST x cm, y cm) : + IF hidden + THEN maxima.last := maxima.akt FI; + + h INCR int (x cm*hor relation+0.5); + v INCR int (y cm*vert relation+0.5); + move (h, v) +END PROC move cm r; + +(************************** DRAW - Prozeduren ******************************) + +PROC draw (INT CONST x,y): + draw (old x,old y,x,y) +END PROC draw; + +PROC draw (INT CONST x0,y0,x1,y1): + IF thick = 0 + THEN line (x0, y0,x1,y1) + ELSE old x := x0; + old y := y0; + draw thick line (x1,y1) + FI; + old x := x1; + old y := y1 +END PROC draw; + +PROC draw (REAL CONST x, y) : + IF hidden + THEN transform (x, y, 0.0, new h, new v); + vector (new h-h, new v-v) + ELSE transform (x, y, 0.0, h, v); + draw (h, v) + FI; + pos := POS : (x, y, 0.0) +END PROC draw; + +PROC draw (REAL CONST x, y, z) : + IF hidden + THEN transform (x, y, z, new h, new v); + vector (new h-h, new v-v) + ELSE transform (x, y, z, h, v); + draw (h, v) + FI; + pos := POS : (x, y, z) +END PROC draw; + +PROC draw r (REAL CONST x, y) : + IF hidden + THEN transform (pos.x+x, pos.y+y, pos.z, h, v); + vector (new h-h, new v-v) + ELSE transform (pos.x+x, pos.y+y, pos.z, h, v); + draw (h, v) + FI; + pos := POS : (pos.x+x, pos.y+y, pos.z) +END PROC draw r; + +PROC draw r (REAL CONST x, y, z) : + IF hidden + THEN transform (pos.x+x, pos.y+y, pos.z+z, h, v); + vector (new h-h, new v-v) + ELSE transform (pos.x+x, pos.y+y, pos.z+z, h, v); + draw (h, v) + FI; + pos := POS : (pos.x+x, pos.y+y, pos.z+z) +END PROC draw r; + +PROC draw cm (REAL CONST x cm, y cm) : + IF hidden + THEN vector (int (x cm*hor relation+0.5)-h, int (y cm*vert relation+0.5)-v) + ELSE h := int (x cm*hor relation+0.5); + v := int (y cm*vert relation+0.5); + draw (h, v) + FI +END PROC draw cm; + +PROC draw cm r (REAL CONST x cm, y cm) : + IF hidden + THEN vector (int (x cm*hor relation+0.5), int (y cm*vert relation+0.5)) + ELSE h INCR int (x cm*hor relation+0.5); + v INCR int (y cm*vert relation+0.5); + draw (h, v) + FI +END PROC draw cm r; + +(*************************** LINIEN zeichnen *******************************) + +PROC line (INT CONST x0,y0,x1,y1): + REAL VAR x0r :: real (x0), + y0r :: real (y0), + x1r :: real (x1), + y1r :: real (y1); + IF clipped line (x0r,y0r,x1r,y1r) + THEN IF ltype > 1 + THEN draw special line(int(x0r),int(y0r),int(x1r),int(y1r)) + ELIF ltype = 1 + THEN do move (int(x0r),int(y0r)); + draw std line (int(x1r),int(y1r)) + FI + FI +END PROC line; + +PROC draw std line (INT CONST x,y): + old x := x; + old y := y; + real old x := x; + real old y := y; + draw to (x,y) +END PROC draw std line; + +PROC draw special line (INT CONST x0,y0,x1,y1): + IF x0 = x1 + THEN vertical line + ELIF y0 = y1 + THEN horizontal line + ELIF abs(x1-x0) > abs(y1 - y0) + THEN steile linie + ELSE flache linie + FI. + + vertical line: + INT VAR steps :: abs(y1 - y0), + sig :: sign(y1-y0), + i; + FOR i FROM 0 UPTO steps REP + IF next pixel + THEN set pixel(x0,y0+i*sig) + FI + PER. + + horizontal line: + steps := abs(x1 - x0); + sig := sign(x1 - x0); + FOR i FROM 0 UPTO steps REP + IF next pixel + THEN set pixel(x0+i*sig,y0) + FI + PER. + + steile linie: + steps := abs(x1 - x0); + sig := sign(x1 - x0); + REAL VAR m :: real(y1 - y0) / real(x1 - x0); + FOR i FROM 0 UPTO steps REP + IF next pixel + THEN set pixel(x0+sig*i,y0+int(m*real(sig*i) + 0.5)) + FI + PER. + + flache linie: + steps := abs(y1 - y0); + sig := sign(y1 - y0); + m := real(x1 - x0) / real(y1 - y0); + FOR i FROM 0 UPTO steps REP + IF next pixel + THEN set pixel(x0+int(m*real(sig*i) + 0.5),y0+sig*i) + FI + PER. + + next pixel: + BOOL VAR is set :: (muster SUB cnt) <> "0"; + cnt INCR 1; + IF cnt > lentxt THEN cnt := 1 FI; + is set +END PROC drawspecialline; + +PROC draw thick line (INT CONST x1,y1): + INT VAR x0 :: old x, + y0 :: old y, + x :: x1, + y :: y1; + swap if neccessary; + REAL VAR xr0 :: real(x0), + yr0 :: real(y0) / (x cm * real(y pixel)) * + (y cm * real(x pixel)), + xr1 :: real(x), + yr1 :: real(y) / (x cm * real(y pixel)) * + (y cm * real(x pixel)); + IF is vertical line + THEN draw vertical line + ELSE draw line + FI; + move(x1,y1). + + swap if neccessary: + IF x < x0 OR (x = x0 AND y < y0) + THEN INT VAR dummy :: x0; + x0 := x; + x := dummy; + dummy := y0; + y0 := y; + y := dummy + FI. + + is vertical line: + x = x0. + + draw vertical line: + INT VAR i; + FOR i FROM - thick UPTO thick REP + cnt := 0; + line (xr0+real(i),yr0-real(thick),xr0+real(i),yr1+real(thick)) + PER. + + draw line: + REAL VAR m :: (yr1 - yr0) / (xr1 - xr0), + dx :: real(thick)/sqrt(1.0+m**2), + dy :: m * dx, + xn, + yn, + diff, + dsx :: dy, + dsy :: -dx, + x incr :: -real(sign(dsx)), + y incr :: -real(sign(dsy)); + xr0 INCR -dx; + yr0 INCR -dy; + xr1 INCR dx; + yr1 INCR dy; + xn := xr0 + dsx; + yn := yr0 + dsy; + REP + line(xn,yn,xr1 - xr0 + xn,yr1 - yr0 + yn); + diff := (2.0*dsy *(xn - (xr0 - dy)) - 2.0 * dsx * (yn - (yr0 + dx))) + * real(sign(m)); + IF diff < 0.0 + THEN xn INCR x incr + ELIF diff > 0.0 + THEN yn INCR y incr + ELSE xn INCR x incr; + yn INCR y incr + FI + UNTIL int(xn - xr0 + dy) = 0 AND int(yn - yr0 - dx) = 0 PER + +END PROC draw thick line; + +PROC line (REAL CONST x0,y0,x1,y1): + line (int(x0),int(y0 * (x cm * real(y pixel)) / (y cm * real(x pixel))), + int(x1),int(y1 * (x cm * real(y pixel)) / (y cm * real(x pixel)))) +END PROC line ; + +(*************************** HIDDEN LINES **********************************) + +PROC hidden lines (BOOL CONST dev): + hidden := NOT dev; +END PROC hidden lines; + +PROC vector (INT CONST dx, dy): + IF dx >= 0 + THEN IF dy > dx THEN vector (v, h, dy, dx, 1, 1) + ELIF dy > 0 THEN vector (h, v, dx, dy, 1, 1) + + ELIF dy > -dx THEN vector (h, v, dx, -dy, 1,-1) + ELSE vector (v, h, -dy, dx,-1, 1) FI + + ELSE IF dy > -dx THEN vector (v, h, dy, -dx, 1,-1) + ELIF dy > 0 THEN vector (h, v, -dx, dy,-1, 1) + + ELIF dy > dx THEN vector (h, v, -dx, -dy,-1,-1) + ELSE vector (v, h, -dy, -dx,-1,-1) FI + FI . + +ENDPROC vector ; + +PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) : + INT VAR i; + prepare first step ; + draw point; + FOR i FROM 1 UPTO dx + REP do one step PER; + + IF was visible + THEN draw (h, v) FI . + + +prepare first step : + INT VAR up right error := dy - dx, + right error := dy, + old error := 0, + last h :: h, last v :: v; + BOOL VAR was visible :: visible . + + +do one step: + IF right is better + THEN do right step + ELSE do up right step + FI . + +right is better : + abs (old error + right error) < abs (old error + up right error) . + +do upright step : + x pos INCR right ; + y pos INCR up ; + draw point ; + old error INCR upright error . + +do right step : + x pos INCR right ; + draw point ; + old error INCR right error . + +draw point : + IF was visible + THEN IF NOT visible + THEN draw (last h, last v); + was visible := FALSE + FI; + last h := h; + last v := v + ELSE IF visible + THEN move (h, v); + was visible := TRUE; + last h := h; + last v := v + FI + FI . + +visible: + IF h < 1 OR h > x pixel + THEN FALSE + ELSE IF maxima.akt [h] < v + THEN maxima.akt [h] := v FI; + v > maxima.last [h] + FI +END PROC vector; + +PROC reset: + forget (ds); + ds := nilspace; + maxima := ds +END PROC reset; + +(**************************** TEXT - Ausgabe *******************************) + +PROC zeichensatz (TEXT CONST name): + IF exists (name) + THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name); + zeichen := new zeichen; + ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI +END PROC zeichensatz; + +PROC reset zeichensatz: + zeichen := std zeichen +END PROC reset zeichensatz; + +PROC draw char (INT CONST char no,REAL CONST x, y,REAL CONST y size, + x size, direction): + TEXT CONST character :: zeichen [char no]; + INT VAR n :: 1, x0, y0, x1, y1; + INT CONST len :: length (character); + REAL CONST sindir :: sind(direction), + cosdir :: cosd(direction); + WHILE n < len + REP value (character, n, x0, y0, x1, y1); + REAL VAR xr0 :: real(x0), + yr0 :: real(y0), + xr1 :: real(x1), + yr1 :: real(y1); + transform (xr0, yr0, x, y, x size, y size, sindir,cosdir); + transform (xr1, yr1, x, y, x size, y size, sindir,cosdir); + draw (int(xr0), int (yr0 * x to y), + int(xr1),int(yr1 * x to y)); + n INCR 4 + PER . + +END PROC draw char; + +PROC value (TEXT CONST char, INT CONST n, INT VAR x0, y0, x1, y1): + x0 := val (code (char SUB n)); y0 := val (code (char SUB n+1)); + x1 := val (code (char SUB n+2)); y1 := val (code (char SUB n+3)); +END PROC value; + +INT PROC val (INT CONST n): + IF n > 127 + THEN -256 OR n + ELSE n FI +END PROC val; + +PROC transform (REAL VAR x, y,REAL CONST x0, y0,REAL CONST x size, y size, + sindir,cosdir): + REAL CONST old x :: x, old y :: y; + REAL CONST dx :: x size / char x * old x * cosdir - + (y size-y base) / char y * old y * sindir, + dy :: (y size-y base) / char y * old y * cosdir + + x size / char x * old x * sindir; + x := x0 + dx; + y := y0 + dy +END PROC transform; + +PROC draw text (REAL CONST x pos, y pos,TEXT CONST msg, REAL CONST angle, + REAL CONST height, width): + INT VAR i; + REAL VAR x :: x pos, y :: y pos, + x step :: cosd (angle)*width, + y step :: sind (angle)*width; + FOR i FROM 1 UPTO length (msg) + REP IF control char + THEN execute control char + ELSE execute normal char FI + PER . + +control char: + akt char < ""32"" . + +execute control char: + SELECT code (akt char) OF + CASE 1: home + CASE 2: right + CASE 3: up + CASE 7: out (""7"") + CASE 8: left + CASE 10: down + CASE 13: return + ENDSELECT . + +home: + x := x pos; + y := y pos . + +right: + x INCR x step; y INCR y step . + +up: + x INCR y step; y INCR x step . + +left: + x DECR x step; y DECR y step . + +down: + x DECR y step; y DECR x step . + +return: + x := x pos . + +execute normal char: + draw char (code (akt char), x, y, height, width, + angle); + x INCR x step; + y INCR y step . + +akt char: + msg SUB i . + +END PROC draw text; + +PROC draw (TEXT CONST msg): + draw (msg,0.0,5.0,5.0) +END PROC draw; + +PROC draw (TEXT CONST msg,REAL CONST angle,REAL CONST heigth,width): + REAL CONST xr :: real(old x), + yr :: real(old y) * y to x; + draw text (xr,yr,msg,angle,heigth * real(x pixel) / x cm / 10.0, + width * real(x pixel) / x cm / 10.0) + (* heigth mm --> x punkte *) +END PROC draw; + +(***************************** LINETYPES ***********************************) + +PROC linetype (INT CONST nummer,TEXT CONST lt): + IF nummer > 5 OR nummer < 2 + THEN errorstop ("number out of range") + ELSE linetypes [nummer] := lt + FI +END PROC linetype ; + +PROC reset linetypes : + linetype (2,"1100"); + linetype (3,"11110000"); + linetype (4,"1111111100000000"); + linetype (5,"1111111100011000"); +END PROC reset linetypes ; + +(***************************** UTILIES *************************************) + +PROC where (REAL VAR x, y) : + x := pos.x; y := pos.y +END PROC where; + +PROC where (REAL VAR x, y, z) : + x := pos.x; y := pos.y; z := pos.z +END PROC where; + +PROC bar (REAL CONST hight, width, INT CONST pattern): + INT VAR zero x, zero y, end x, end y; + transform (0.0, 0.0, 0.0, zero x, zero y); + transform (width, hight, 0.0, end x, end y); + bar (h-(end x-zero x) DIV 2, v, end x-zero x, end y-zero y, pattern) +END PROC bar; + +PROC bar (INT CONST from x, from y, width, hight, pattern): + INT CONST to x :: from x+width, to y :: from y+hight; + INT VAR x, y; + draw frame; + SELECT pattern OF + CASE empty: (* nothing to do *) + CASE half: half bar + CASE full: full bar + CASE horizontal: horizontal bar + CASE vertical: vertical bar + CASE cross: horizontal bar; + vertical bar + CASE diagonal right: diagonal right bar + CASE diagonal left: diagonal left bar + CASE diagonal both: diagonal both bar + OTHERWISE errorstop ("Unknown pattern") ENDSELECT . + +draw frame: + move (from x, from y); + draw (from x, to y); + draw (to x, to y); + draw (to x, from y); + draw (from x, from y). + +full bar: + FOR y FROM from y UPTO to y + REP move (from x, y); + draw (to x, y) + PER . + +half bar: + FOR y FROM from y UPTO to y + REP x := from x + 1 + (y AND 1); + WHILE x < to x + REP move (x, y); + draw (x, y); + x INCR 2 + PER + PER . + +horizontal bar: + y := from y; + WHILE y < to y + REP move (from x, y); + draw (to x, y); + y INCR 5 + PER . + +vertical bar: + x := from x + 5; + WHILE x < to x + REP move (x, from y); + draw (x, to y); + x INCR 5 + PER . + +diagonal right bar: + y := from y-width+5; + WHILE y < to y + REP move (max (from x, to x-y-width+from y), max (from y, y)); + draw (min (to x, from x+to y-y), min (to y, y+width)); + y INCR 5 + PER . + +diagonal left bar: + y := from y-width+5; + WHILE y < to y + REP move (min (to x, to x-from y+y), max (from y, y)); + draw (max (from x, from x+y+width-to y), min (to y, y+width)); + y INCR 5 + PER . + +diagonal both bar: + y := from y-width+5; + WHILE y < to y + REP move (max (from x, to x-y-width+from y), max (from y, y)); + draw (min (to x, from x+to y-y), min (to y, y+width)); + move (min (to x, to x-from y+y), max (from y, y)); + draw (max (from x, from x+y+width-to y), min (to y, y+width)); + y INCR 5 + PER . + +END PROC bar; + +PROC circle (REAL CONST r, from, to, INT CONST pattern): + REAL VAR t :: from; INT VAR i; i := pattern; (* sonst WARNUNG *) + WHILE t < to + REP transform (pos.x + r*cosd (t), pos.y + r*sind (t), 0.0, h, v); + draw (h, v); + t INCR 1.0 + PER; + transform (pos.x, pos.y, 0.0, h, v); + draw (h, v) . + +END PROC circle; + +PROC box : + move (0,0); + draw (0,y pixel-1); + draw (x pixel-1, y pixel-1); + draw (x pixel-1, 0); + draw (0,0) +END PROC box; + +END PACKET basis plot; + +(************************* Plot Spool Input/ Output ***********************) + +PACKET plot interface DEFINES (* Carsten Weinholz *) + (* V 1.1 02.07.87 *) + save , + exists , + erase , + ALL , + first , + start , + stop , + halt , + wait for halt , + list , + picfiles , + generate plot manager: + +LET initfile = "GRAPHIK.Manager", + plot manager name= "PLOT" , + + picfiletype = 1102, + + ack = 0, + false code = 6, + fetch code = 11, + save code = 12, + exists code = 13, + erase code = 14, + list code = 15, + all code = 17, + first code = 25, + start code = 26, + stop code = 27, + halt code = 28, + wait for halt code = 29; + +BOUND STRUCT (TEXT tname,user id,pass) VAR msg; + +DATASPACE VAR ds; + +INT VAR reply; +THESAURUS VAR all myself picfiles; + +PROC first (TEXT CONST ds name, PLOTTER CONST plotter id): + call (first code, ds name + ""0"" + id name (plotter id), plot id (plotter id)) +END PROC first; + +PROC start (PLOTTER CONST plotter id): + call (start code, id name (plotter id), plot id (plotter id)) +END PROC start; + +PROC stop (PLOTTER CONST plotter id): + call (stop code, id name (plotter id), plot id (plotter id)) +END PROC stop; + +PROC halt (PLOTTER CONST plotter id): + call (halt code, id name (plotter id), plot id (plotter id)) +END PROC halt; + +PROC wait for halt (PLOTTER CONST plotter id): + call (wait for halt code, id name (plotter id), plot id (plotter id)) +END PROC wait for halt; + +PROC save (TEXT CONST ds name, PLOTTER CONST plotter id): + enable stop; + last param (ds name); + call (save code, ds name + ""0"" + id name (plotter id), + old (ds name), plot id (plotter id)) +END PROC save; + +PROC save (PICFILE CONST p, TEXT CONST pname, PLOTTER CONST plotter id): + enable stop; + DATASPACE VAR ds; + ds BECOMES p; + call (save code, pname + ""0"" + id name (plotter id), ds, + plot id (plotter id)); +END PROC save; + +OP BECOMES (DATASPACE VAR ds, PICFILE CONST p): + EXTERNAL 260 +END OP BECOMES; + +PROC save (THESAURUS CONST nameset, PLOTTER CONST plotter id): + TEXT VAR name; + INT VAR i :: 0; + get (nameset, name, i); + WHILE i > 0 REP + save (name, plotter id); + cout (i); + get (nameset, name, i) + PER +END PROC save; + +BOOL PROC exists (TEXT CONST ds name, PLOTTER CONST plotter id): + INT VAR reply; + DATASPACE VAR ds :: nilspace; + BOUND TEXT VAR qname :: ds; + qname := ds name + ""0"" + id name (plotter id); + REP + call (plot id (plotter id), exists code, ds, reply) + UNTIL reply = false code OR reply = ack PER; + forget (ds); + reply = ack +END PROC exists; + +PROC erase (TEXT CONST ds name,PLOTTER CONST plotter id): + call (erase code, ds name + ""0"" + id name (plotter id), plot id (plotter id)) +END PROC erase; + +PROC erase (THESAURUS CONST nameset, PLOTTER CONST plotter id): + TEXT VAR name; + INT VAR i :: 0; + get (nameset, name, i); + WHILE i > 0 REP + erase (name, plotter id); + cout (i); + get (nameset, name, i) + PER +END PROC erase; + +THESAURUS OP ALL (PLOTTER CONST plotter id): + REP + forget (ds); + ds := nilspace; + msg := ds; + msg.tname := id name (plotter id); + msg.user id := ""; + msg.pass := ""; + call (plot id (plotter id), all code, ds, reply) + UNTIL reply = ack PER; + BOUND THESAURUS VAR result ds :: ds; + THESAURUS VAR result :: result ds; + forget (ds); + result +END OP ALL; + +PROC list (FILE VAR f,PLOTTER CONST plotter id): + REP + forget (ds); + ds := nilspace; + msg := ds; + msg.tname := id name (plotter id); + msg.user id := ""; + msg.pass := ""; + call (plot id (plotter id), list code, ds, reply) + UNTIL reply = ack PER; + f := sequential file (modify, ds) +END PROC list; + +PROC list (PLOTTER CONST plotter id): + FILE VAR list file; + list (list file, plotter id); + show (list file) +END PROC list; + +THESAURUS PROC picfiles: + all myself picfiles := empty thesaurus; + do (PROC (TEXT CONST) insert if picfile,ALL myself); + all myself picfiles +END PROC picfiles; + +PROC insert if picfile (TEXT CONST filename): + IF type (old (filename)) = picfiletype + THEN insert (all myself picfiles,filename) + FI +END PROC insert if picfile; + +PROC generate plot manager: + TASK VAR plot manager; + IF exists (initfile) + THEN generate in background + ELSE errorstop ("""" + init file + """ existiert nicht") + FI. + + generate in background: + begin (plot manager name,PROC init plot manager, plot manager); + INT VAR manager call; + DATASPACE VAR initspace; + TASK VAR order task; + REP + wait (initspace, manager call, order task) + UNTIL order task = plot manager PER; + initspace := old (initfile); + send (plot manager, ack, initspace); + say ("Plot-Manager wird generiert"13""10""); + say ("Bitte etwas Geduld..."13""10""); + REP + wait (initspace, manager call, order task) + UNTIL order task = plot manager PER; + forget (initspace); + say ("Plotmanager generiert !"13""10"") +END PROC generate plot manager; + +PROC init plot manager: + DATASPACE VAR initspace :: nilspace; + INT VAR dummy; + call (father, fetch code, initspace, dummy); + copy (init space,init file); + insert (init file); + send (father,ack,initspace); + do ("plot manager"); +END PROC init plot manager; + +TASK PROC plot id (PLOTTER CONST plotter id): + IF plotter id = no plotter + THEN task (plot manager name) + ELSE station (plotter id)/plot manager name + FI +END PROC plot id; + +TEXT PROC id name (PLOTTER CONST plotter id): + text (station (plotter id)) + "/" + text (channel (plotter id)) + "/" + + name (plotter id) +END PROC id name; + +END PACKET plot interface; + +(************************* Plot Picture / Picfile *************************) + +PACKET plot DEFINES plot : + +LET draw key = 1, + move key = 2, + text key = 3, + move r key = 4, + draw r key = 5, + move cm key = 6, + draw cm key = 7, + move cm r key = 8, + draw cm r key = 9, + bar key = 10, + circle key = 11; + +LET postfix = ".PICFILE" + +INT VAR read pos; + +PROC plot (TEXT CONST name) : + PICFILE VAR p :: old (name); + IF channel <> channel (plotter) OR station (myself) <> station (plotter) + THEN save (name, plotter) + ELSE plot (p) + FI +END PROC plot; + +PROC plot (PICFILE VAR p) : + IF channel <> channel (plotter) OR station(myself) <> station(plotter) + THEN save (p, name (myself) + "." + text (highest entry (ALL plotter)) + + postfix, plotter) + ELSE direct plot + FI. + + direct plot: + ROW 3 ROW 2 REAL VAR sizes; + ROW 2 ROW 2 REAL VAR limits; + ROW 4 REAL VAR angles; + ROW 2 REAL VAR obliques; + ROW 3 REAL VAR perspectives; + get values (p,sizes,limits,angles,obliques,perspectives); + set values (sizes,limits,angles,obliques,perspectives); + begin plot; + clear; + INT VAR i; + FOR i FROM 1 UPTO pictures (p) + REP PICTURE VAR act pic :: nilpicture; + to pic (p,i); + read picture (p,act pic); + IF pen (act pic) <> 0 + THEN plot pic FI + PER; + end plot . + + plot pic: + INT VAR colour, thickness, linetype; + BOOL VAR hidden; + selected pen (p,pen (act pic),colour,thickness,linetype,hidden); + pen (background (p),colour,thickness,linetype); + hidden lines (hidden); + plot (act pic). + +END PROC plot; + +PROC plot (PICTURE CONST p) : + IF channel <> channel (plotter) OR station (myself) <> station (plotter) + THEN errorstop ("PICTURES koennen nur direkt ausgegeben werden") + ELSE plot pic + FI. + +plot pic: + INT CONST pic length :: length (p); + TEXT CONST points :: subtext (text(p),5); + read pos := 0; + IF dim (p) = 2 + THEN plot two dim pic + ELSE plot three dim pic FI . + +plot two dim pic: + WHILE read pos < pic length + REP plot two dim position PER . + +plot two dim position : + read pos INCR 1; + SELECT code (points SUB read pos) OF + CASE draw key : draw (next real, next real) + CASE move key : move (next real, next real) + CASE move r key : move r (next real, next real) + CASE draw r key : draw r (next real, next real) + CASE move cm key : move cm (next real, next real) + CASE draw cm key : draw cm (next real, next real) + CASE move cm r key : move cm r (next real, next real) + CASE draw cm r key : draw cm r (next real, next real) + CASE text key : draw (next text, next real, next real, next real) + CASE bar key : bar (next real, next real, next int) + CASE circle key : circle (next real, next real, next real, next int) + OTHERWISE errorstop ("wrong key code") END SELECT . + +plot three dim pic: + WHILE read pos < pic length + REP plot three dim position PER . + +plot three dim position : + read pos INCR 1; + SELECT code (points SUB read pos) OF + CASE draw key : draw (next real, next real, next real) + CASE move key : move (next real, next real, next real) + CASE move r key : move r (next real, next real, next real) + CASE draw r key : draw r (next real, next real, next real) + CASE move cm key : move cm (next real, next real) + CASE draw cm key : draw cm (next real, next real) + CASE move cm r key : move cm r (next real, next real) + CASE draw cm r key : draw cm r (next real, next real) + CASE text key : draw (next text, next real, next real, next real) + CASE bar key : bar (next real, next real, next int) + CASE circle key : circle (next real, next real, next real, next int) + OTHERWISE errorstop ("wrong key code") END SELECT . + +next real : + read pos INCR 8; + subtext (points, read pos-7, read pos) RSUB 1 . + +next int : + read pos INCR 2; + subtext (points, read pos-1, read pos) ISUB 1 . + +next text : + INT CONST text length :: next int; + read pos INCR text length; + subtext (points, read pos-text length+1, read pos) . + +END PROC plot; + +END PACKET plot diff --git a/app/mpg/1987/src/GRAPHIK.Turtle b/app/mpg/1987/src/GRAPHIK.Turtle new file mode 100644 index 0000000..7dcfff1 --- /dev/null +++ b/app/mpg/1987/src/GRAPHIK.Turtle @@ -0,0 +1,138 @@ +(**************************************************************************) +(* *) +(* MPG - Graphik - System *) +(* *) +(* Version 2.1 vom 10.09.1987 *) +(* *) +(* (c) 1987 Beat Jegerlehner & Carsten Weinholz *) +(* unter Verwendung der Standard-Graphik *) +(* "Turtle-Graphik" geschrieben von B.Jegerlehner *) +(* *) +(**************************************************************************) +(* *) +(* Dieses Paket stellt eine LOGO-aehnliche *) +(* 'Schildkroetengraphik' zur Verfuegung *) +(* *) +(**************************************************************************) +PACKET turtle graphics DEFINES begin turtle, + end turtle, + forward , + forward to , + turn , + turn to , + pen up , + pen down , + pen , + angle , + get turtle : + +REAL VAR x pos, + y pos, + winkel; + +PICFILE VAR bild; +PICTURE VAR pic; + +BOOL VAR direct, + pen status; + +PROC begin turtle: + direct := TRUE; + x pos := 0.0; + y pos := 0.0; + winkel := 0.0; + begin plot; + clear; + viewport (0.0, 1.0, 0.0, 1.0); + window (-500.0, 500.0, -500.0, 500.0); + pen up; + forward to (0.0, 0.0) +END PROC begin turtle; + +PROC begin turtle (TEXT CONST picfile): + direct := FALSE; + bild := picture file (picfile); + pic := nilpicture; + x pos := 0.0; + y pos := 0.0; + winkel := 0.0; + pen up; + forward to (0.0,0.0) +END PROC begin turtle; + +PROC end turtle: + IF direct + THEN end plot + ELSE ausgabe + FI. + + ausgabe: + REAL VAR x cm,y cm; + INT VAR dummy; + put picture (bild,pic); + drawing area (x cm,y cm,dummy,dummy); + viewport (bild, 0.0, 1.0, 0.0, 1.0); + window (bild, -500.0,500.0,-500.0,500.0); + plot(bild) +END PROC end turtle; + +PROC turn (REAL CONST w): + winkel := (winkel + w) MOD 360.0 +END PROC turn; + +PROC turn to (REAL CONST w): + winkel := w MOD 360.0 +END PROC turn to; + +REAL PROC angle: + winkel +END PROC angle; + +PROC forward (REAL CONST len): + forward to (x pos + cosd (winkel) * len, + y pos + sind (winkel) * len) +END PROC forward; + +PROC pen up: + pen status := FALSE +END PROC pen up; + +PROC pen down: + pen status := TRUE +END PROC pen down; + +BOOL PROC pen: + pen status +END PROC pen; + +PROC forward to (REAL CONST x,y): + IF direct + THEN dir plot + ELSE pic plot + FI; + x pos := x; + y pos := y. + + dir plot: + IF pen status + THEN draw (x,y) + ELSE move (x,y) + FI. + + pic plot: + IF length (pic) > 1923 + THEN put picture (bild,pic); + pic := nilpicture + FI; + IF pen status + THEN draw (pic,x,y) + ELSE move (pic,x,y) + FI +END PROC forward to; + +PROC get turtle (REAL VAR x,y): + x := x pos; + y := y pos +END PROC get turtle + +END PACKET turtle graphics diff --git a/app/mpg/1987/src/GRAPHIK.list b/app/mpg/1987/src/GRAPHIK.list new file mode 100644 index 0000000..0ee6612 --- /dev/null +++ b/app/mpg/1987/src/GRAPHIK.list @@ -0,0 +1,22 @@ +GRAPHIK.list +GRAPHIK.Install +GRAPHIK.Basis +GRAPHIK.Configurator +GRAPHIK.Plot +GRAPHIK.Manager +GRAPHIK.Fkt +GRAPHIK.Turtle +ZEICHENSATZ +FKT.help +Muster +std primitives +matrix printer +terminal plot +DATAGRAPH 3.GCONF +VIDEOSTAR 7.GCONF +AMPEX 1-2/4-6.GCONF +NEC P-3 15.GCONF +WATANABE 9.GCONF +VC 404 8.GCONF +NEC P-9 HD.GCONF +NEC P-9 MD.GCONF diff --git a/app/mpg/1987/src/HRZPLOT.ELA b/app/mpg/1987/src/HRZPLOT.ELA new file mode 100644 index 0000000..b788187 --- /dev/null +++ b/app/mpg/1987/src/HRZPLOT.ELA @@ -0,0 +1,150 @@ +PACKET hrz plot DEFINES drawing area, {Autor: H. Indenbirken} + begin plot, {Stand: 16.01.85 } + end plot, + clear, + pen, + move, + draw: + +LET delete = 0, {Farbcodes} + std = 1, + red = 2, + green = 3, + blue = 4, + black = 5, + white = 6, + + nothing = 0; {Linientypen} + +LET POS = STRUCT (INT x, y); + +FILE VAR tr; +TEXT VAR dummy; +INT VAR act thick :: 0, i; +POS VAR pos :: POS : (0, 0); + +PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : + x cm := 39.1; y cm := 27.6; + x pixel := 3910; y pixel := 2760 +END PROC drawing area; + +PROC begin plot : +ENDPROC begin plot ; + +PROC end plot : +ENDPROC end plot ; + +PROC clear : + IF exists ("Plotter") + THEN put line (tr, "NEXT 1;") + ELSE init tr file FI; + + pos := POS : (0, 0); + act thick := 0 . + +init tr file: + tr := sequential file (output, "Plotter"); + put line (tr, "#XBA,BEN=7800017 0029 UHRZS012 Graphik#."); + put line (tr, "ECCO "); + put line (tr, "#ANFANG,GRAFIK"); + put line (tr, "#ZEICHNE,PL(1,9),MOD.=ZCH123,DINAF.=3.2,AUSS.=0'0'4200'2970,STIFTE=1'2'3'4'5'6,DATEI=/"); + put line (tr, "CLEAR;BOX;") . + +END PROC clear; + +PROC pen (INT CONST background, foreground, thickness, linetype): + set foreground; + set thickness . + +set foreground: + put line (tr, "PEN " + text (foreground) + ";") . + +set thickness: + act thick := thickness * 2 . + +END PROC pen; + +PROC move (INT CONST x, y) : + put (tr, text (x) + "!" + text (y) + ";"); + pos := POS : (x, y) +END PROC move; + +PROC draw (INT CONST x, y) : + IF act thick <> 0 + THEN IF horizontal line + THEN thick y + ELSE thick x FI; + x MOVE y + ELSE put (tr, text (x) + "&" + text (y) + ";") FI; + pos := POS : (x, y) . + +horizontal line: + abs (pos.x-x) > abs (pos.y-y) . + +thick y: + INT VAR dy, old x :: pos.x-x ausgleich, new x :: x+x ausgleich; + old x MOVE pos.y; + new x DRAW y; + FOR dy FROM 1 UPTO act thick + REP old x MOVE pos.y+dy; + new x DRAW y+dy; + old x MOVE pos.y-dy; + new x DRAW y-dy; + PER . + +x ausgleich: + IF pos.x <= x + THEN act thick + ELSE -act thick FI . + +thick x: + INT VAR dx, old y :: pos.y-y ausgleich, new y :: y+y ausgleich; + pos.x MOVE old y; + x DRAW new y; + FOR dx FROM 1 UPTO act thick + REP pos.x+dx MOVE old y; + x+dx DRAW new y; + pos.x-dx MOVE old y; + x-dx DRAW new y; + PER . + +y ausgleich: + IF pos.y <= y + THEN act thick + ELSE -act thick FI . + +END PROC draw; + +PROC draw (TEXT CONST record, REAL CONST angle, height, width): + put (tr, height symbol + angle symbol + " SYMB """ + double record + """;") . + +height symbol: + IF height = 0.0 + THEN "" + ELSE "H" + text (height) FI . + +angle symbol: + IF angle = 0.0 + THEN "" + ELSE "A" + text (angle) FI . + +double record: + dummy := record; + change all (dummy, """", """"""); + dummy . + +END PROC draw; + +PROC draw (TEXT CONST record) : + draw (record, 0.0, 0.0, 0.0) +END PROC draw; + +OP MOVE (INT CONST x, y): + put (tr, text (x) + "!" + text (y) + ";") +END OP MOVE; + +OP DRAW (INT CONST x, y): + put (tr, text (x) + "&" + text (y) + ";") +END OP DRAW; + +END PACKET hrz plot diff --git a/app/mpg/1987/src/INCRPLOT.ELA b/app/mpg/1987/src/INCRPLOT.ELA new file mode 100644 index 0000000..408ab5f --- /dev/null +++ b/app/mpg/1987/src/INCRPLOT.ELA @@ -0,0 +1,405 @@ +PACKET incremental plot DEFINES drawing area, { Autor: H. Indenbirken } + begin plot, { Stand: 07.09.84 } + end plot, + clear, + pen, + move, + draw, + get cursor, + + zeichensatz, + reset: + +LET max x = 511, {***** Bildschirm : 0-511 x 0-255*****} + max x plus 1 = 512, + max y = 255, + + hor faktor = 22.21739, {***** x pixel / x cm *****} + vert faktor = 18.61314, {***** y pixel / y cm *****} + + + delete = 0, {Farbcodes} + std = 1, + black = 5, + white = 6, + + nothing = 0, {Linientypen} + durchgehend = 1, + gepunktet = 2, + kurz gestrichelt = 3, + lang gestrichelt = 4, + strichpunkt = 5, + + pen up = "U", + pen down = "D", + up = "8", {Richtungen} + up right = "9", + right = "6", + down right = "3", + down = "2", + down left = "1", + left = "4", + up left = "7"; + +LET PEN = STRUCT (INT back, fore, thick, line, BOOL hidden); +LET POS = STRUCT (INT x, y); +LET ZEICHENSATZ = STRUCT (ROW 255 TEXT char, INT width, height); + +ROW max x plus 1 INT VAR akt maxima, last maxima; +ZEICHENSATZ VAR zeichen; +PEN VAR stift :: PEN : (black, white, 0, durchgehend, FALSE); +POS VAR pos :: POS : (0, 0), start, end; +TEXT VAR point :: ""; +INT VAR i, n, diff, up right error, right error, old error, from, to, + pattern pos :: 0, line pattern :: -1; +BOOL VAR bit set :: TRUE; + +reset; +zeichensatz ("STD Zeichensatz"); + +PROC reset: + FOR i FROM 1 UPTO 512 + REP last maxima [i] := -1; + akt maxima [i] := -1 + PER +END PROC reset; + +PROC zeichensatz (TEXT CONST name): + IF exists (name) + THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name); + zeichen := new zeichen; + ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI +END PROC zeichensatz; + +PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : + x cm := 23.0; y cm := 13.7; {***** Horizontale und vertikale *****} + {***** Gre in Zentimetern. *****} + x pixel := 511; y pixel := 255 {***** Koordinaten des rechten *****} + {***** oberen Punktes. *****} +END PROC drawing area; + +PROC begin plot : + {***** Graphikmodus einschalten *****} + out (""16"") +ENDPROC begin plot ; + +PROC end plot : + {***** Graphikmodus ausschalten *****} + out (""0"") +ENDPROC end plot ; + +PROC clear : + stift := PEN : (black, white, 0, durchgehend, FALSE); + pos := POS : (0, 0); + line pattern := -1; + pattern pos := 0; + point := ""; + + reset; + {***** neue Zeichenflche *****} + out ("P") +END PROC clear; + +PROC pen (INT CONST background, foreground, thickness, linetype): + set background; + set foreground; + set thickness; + set linetype; + stift := PEN:(background, foreground, thickness, linetype, thickness<0) . + +set background: + {***** Hintergrundfarbe setzen *****} . + +set foreground: + {***** Stift auswhlen *****} . + +set thickness: + {***** Es wird ein breiterer Sift simuliert, indem jeder Punkt *****} + {***** dicker gezeichet wird. Mit 'stift.thick' wird angegeben, *****} + {***** aus wieviel Pixeln ein Punkt bestehen soll. In 'point' *****}; + {***** stehen die Befehle, um einen dicken Punkt zu zeichnen. *****} + point := ""; + i := 2; + WHILE i <= thickness + REP point CAT down left; + point CAT (i * right); + point CAT (i * up); + point CAT (i * left); + point CAT (i * down); + i INCR 2 + PER; + point CAT (thickness DIV 2) * up right . + +set linetype: + {***** Falls das Endgert hardwaremig verschieden Linientypen *****} + {***** besitzt, knnen diese hier angesteuert werden. Ansonsten *****} + {***** werden sie softwaremig simuliert. *****} + pattern pos := 0; + SELECT linetype OF + CASE durchgehend : line pattern := -1 + CASE gepunktet : line pattern := 21845 + CASE kurz gestrichelt : line pattern := 3855 + CASE lang gestrichelt : line pattern := 255 + CASE strichpunkt : line pattern := 4351 + OTHERWISE line pattern := linetype END SELECT . + +END PROC pen; + +PROC move (INT CONST x, y) : + IF stift.hidden + THEN last maxima := akt maxima FI; + + {***** Der Stift muss gehoben und ein Vektor zur Position (x,y) *****} + {***** gezeichnet werden. *****} + out (pen up); + IF right to left + THEN (x-pos.x) TIMESOUT right; + IF down to up + THEN (y-pos.y) TIMESOUT up + ELSE (pos.y-y) TIMESOUT down FI + ELSE (pos.x-x) TIMESOUT left; + IF down to up + THEN (y-pos.y) TIMESOUT up + ELSE (pos.y-y) TIMESOUT down FI + FI; + + pos := POS : (x, y) . + +right to left: x > pos.x . +down to up: y > pos.y . + +END PROC move; + +PROC draw (INT CONST x, y) : + {***** Der Stift muss gehoben und ein Vektor zur Position (x,y) *****} + {***** gezeichnet werden. *****} + vector (x-pos.x, y-pos.y); + pos := POS : (x, y) . + +END PROC draw; + +PROC vector (INT CONST dx , dy) : + IF dx >= 0 + THEN IF dy > dx THEN vector (pos.y, pos.x, dy, dx, 1, 1, up, up right) + ELIF dy > 0 THEN vector (pos.x, pos.y, dx, dy, 1, 1, right, up right) + + ELIF dy > -dx THEN vector (pos.x, pos.y, dx,-dy, 1,-1, right, down right) + ELSE vector (pos.y, pos.x,-dy, dx,-1, 1, down, down right) FI + + ELSE IF dy > -dx THEN vector (pos.y, pos.x, dy,-dx, 1,-1, up, up left) + ELIF dy > 0 THEN vector (pos.x, pos.y,-dx, dy,-1, 1, left, up left) + + ELIF dy > dx THEN vector (pos.x, pos.y,-dx,-dy,-1,-1, left, down left) + ELSE vector (pos.y, pos.x,-dy,-dx,-1,-1, down, down left) FI + FI . + +ENDPROC vector ; + +PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, x step, y step, + TEXT CONST step right, step up) : + prepare first step ; + FOR i FROM 1 UPTO dx + REP do one step PER . + +prepare first step : + up right error := dy - dx; + right error := dy; + old error := 0; + IF visible (pos) + THEN out (pen down); + out (point) + ELSE out (pen up) FI . + +do one step: + IF right is better + THEN do right step + ELSE do up right step + FI . + +right is better : + abs (old error + right error) < abs (old error + up right error) . + +do upright step : + x pos INCR x step; + y pos INCR y step; + check point; + out (step up); + out (point); + old error INCR upright error . + +do right step : + x pos INCR x step; + check point; + out (step right); + out (point); + old error INCR right error . + +check point : + { In Abhngigkeit vom Ergebnis der Prozedur 'visible' wird der *****} + { Stift gehoben oder gesenkt. *****} + + IF visible (pos) + THEN out (pen down) + ELSE out (pen up) FI . + +END PROC vector; + +BOOL PROC visible (POS CONST pos) : + IF pos.x < 0 OR pos.x > max x OR pos.y < 0 OR pos.y > max y + THEN FALSE + ELSE pattern AND hidden FI . + +pattern: + bit set := bit (line pattern, pattern pos); + pattern pos := (pattern pos+1) AND 15; + bit set . + +hidden: + IF akt maxima [pos.x+1] < pos.y + THEN akt maxima [pos.x+1] := pos.y FI; + + pos.y > last maxima [pos.x+1] . + +END PROC visible; + +PROC draw (TEXT CONST record, REAL CONST angle, height, width): +{**** Hier werden Texte mit dem Winkel 'angle',der Hhe 'height' und *****} +{**** der Breite 'width' gezeichnet. Falls die Hardware dieses *****} +{**** bereits ermglicht, so mssen die Variable 'zeichen' und die *****} +{**** Prozedur Zeichensatz gelscht werden. Der Datenraum *****} +{**** 'STD Zeichensatz' wird in diesem Fall nicht bentigt. *****} + BOOL CONST horizontal :: NOT (abs (angle) MOD 180.0 > 45.0 AND abs (angle) MOD 180.0 < 135.0); + INT CONST x fak :: character width, x step :: character x step, + y fak :: character height, y step :: character y step; + INT VAR x pos :: pos.x, y pos :: pos.y, i; + from := pos; + + FOR i FROM 1 UPTO length (record) + REP draw character i PER; + move (from) . + +character width: + IF width <> 0.0 + THEN int (hor faktor * width+0.5) + ELSE zeichen.width FI . + +character x step: + IF horizontal + THEN IF width <> 0.0 + THEN int (cosd (angle) * hor faktor * width+0.5) + ELSE int (cosd (angle) * real (zeichen.width)+0.5) FI + ELSE IF width <> 0.0 + THEN int (cosd (angle) * vert faktor * width+0.5) + ELSE int (cosd (angle) * real (zeichen.height)+0.5) FI + FI . + +character height: + IF height <> 0.0 + THEN int (vert faktor * height+0.5) + ELSE zeichen.height FI . + +character y step: + IF horizontal + THEN IF height <> 0.0 + THEN int (sind (angle) * vert faktor * height+0.5) + ELSE int (sind (angle) * real (zeichen.height)+0.5) FI + ELSE IF height <> 0.0 + THEN int (sind (angle) * hor faktor * height+0.5) + ELSE int (sind (angle) * real (zeichen.width)+0.5) FI + FI . + +draw character i: + IF code (record SUB i) < 32 + THEN steuerzeichen + ELSE normale zeichen FI . + +steuerzeichen: + SELECT code (record SUB i) OF + CASE 7: out (""0""7""16"") + CASE 13: x pos := pos.x; y pos := pos.y + END SELECT . + +normale zeichen: + TEXT CONST char :: zeichen.char [code (record SUB i)]; + IF horizontal + THEN draw horizontal + ELSE draw vertical FI . + +draw vertical: + n := 3; + IF char <> "" + THEN move (((char ISUB 2)*y fak) DIV zeichen.height + x pos, + -((char ISUB 1)*x fak) DIV zeichen.width + y pos) + FI; + WHILE n <= length (char) DIV 2 + REP IF (char ISUB n) < 0 OR (char ISUB n+1) < 0 + THEN move (((char ISUB n+1)*y fak) DIV zeichen.height + x pos, + -((char ISUB n )*x fak) DIV zeichen.width + y pos) + ELSE draw (-((char ISUB n+1)*y fak) DIV zeichen.height + x pos, + ((char ISUB n )*x fak) DIV zeichen.width + y pos) + FI; + n INCR 2 + PER; + x pos INCR x step; + y pos INCR y step . + +draw horizontal: + n := 3; + IF char <> "" + THEN move (-((char ISUB 1)*x fak) DIV zeichen.width + x pos, + -((char ISUB 2)*y fak) DIV zeichen.height + y pos) + FI; + WHILE n <= length (char) DIV 2 + REP IF (char ISUB n) < 0 OR (char ISUB n+1) < 0 + THEN move (-((char ISUB n )*x fak) DIV zeichen.width + x pos, + -((char ISUB n+1)*y fak) DIV zeichen.height + y pos) + ELSE draw (((char ISUB n )*x fak) DIV zeichen.width + x pos, + ((char ISUB n+1)*y fak) DIV zeichen.height + y pos) + FI; + n INCR 2 + PER; + x pos INCR x step; + y pos INCR y step . + +END PROC draw; + +PROC draw (TEXT CONST record) : + draw (record, 0.0, 0.0, 0.0) +END PROC draw; + +PROC get cursor (TEXT VAR t, INT VAR x, y) : + x := pos.x; + y := pos.y; + cursor on; + REP inchar (t); + SELECT code (t) OF + CASE 54: x INCR 1; out (right) {normaler Zehnerblock} + CASE 57: x INCR 1; y INCR 1; out (up right) + CASE 56: y INCR 1; out (up) + CASE 55: x DECR 1; y INCR 1; out (up left) + CASE 52: x DECR 1; out (left) + CASE 49: x DECR 1; y DECR 1; out (down left) + CASE 50: y DECR 1; out (down) + CASE 51: x INCR 1; y DECR 1; out (down right) + OTHERWISE leave get cursor ENDSELECT; + PER . + +cursor on: + {***** Der Graphische Cursor muss eingeschaltet werden *****}; + out ("C") . + +cursor off: + {***** Der Graphische Cursor muss eingeschaltet werden *****}; + out ("c") . + +leave get cursor: + cursor off; + out (pen up); + (x-pos.x) TIMESOUT left; + (y-pos.y) TIMESOUT right; + + LEAVE get cursor . + +END PROC get cursor; + +END PACKET incremental plot; diff --git a/app/mpg/1987/src/M20PLOT.ELA b/app/mpg/1987/src/M20PLOT.ELA new file mode 100644 index 0000000..ea7f905 --- /dev/null +++ b/app/mpg/1987/src/M20PLOT.ELA @@ -0,0 +1,419 @@ +PACKET m20 plot DEFINES drawing area, (*Autor: H. Indenbirken*) + begin plot, (*Stand: 18.11.84 *) + end plot, + clear, + pen, + move, + draw, + + cursor on, cursor off, + get cursor, + + zeichensatz, + get screen, put screen: + +LET hor faktor = 22.21739, (****** x pixel / x cm ******) + vert faktor = 18.61314, (****** y pixel / y cm ******) + + delete = 0, (*Farbcodes *) + std = 1, + black = 5, + white = 6, + + nothing = 0, (*Linientypen *) + durchgehend = 1, + gepunktet = 2, + kurz gestrichelt = 3, + lang gestrichelt = 4, + strichpunkt = 5, + + bit 14 = 16384; + +TYPE SCREEN = ROW 32 ROW 256 INT; +LET POS = STRUCT (INT x, y); +LET ZEICHENSATZ = STRUCT (ROW 255 TEXT char, INT width, height); + +ZEICHENSATZ VAR zeichen; +BOOL VAR character defined :: FALSE; +TEXT VAR act pen :: "P"1"L"255""255"", + cursor pos :: ""0"M"0""0""0""0""0"D"0""0""0""0""0"M"0""0""0""0""0"D"0""0""0""0"", + cursor line :: ""0"M"0""0""0""0""0"D"0""0""0""0""0"D"0""0""0""0""; +INT VAR act thick :: 0, i; +POS VAR pos :: POS : (0, 0); +out (""16"" + act pen + ""9""); + +PROC zeichensatz (TEXT CONST name): + IF exists (name) (* Hhe: 0.64 cm*) + THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name);(* Breite: 0.40 cm*) + zeichen := new zeichen; + character defined := TRUE + ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI +END PROC zeichensatz; + +PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : + x cm := 22.0; y cm := 13.7; + x pixel := 511; y pixel := 255 +END PROC drawing area; + +PROC begin plot : + out (""9""16""); +ENDPROC begin plot ; + +PROC end plot : + out (""9""); +ENDPROC end plot ; + +PROC clear : + pos := POS : (0, 0); + act thick := 0; + act pen := "P"1"L"255""255""; + out ("CP"1"L"255""255"M"0""0""0""0"") + +END PROC clear; + +PROC pen (INT CONST background, foreground, thickness, linetype): + set foreground; + set thickness; + set linetype; + out (act pen) . + +set foreground: + IF foreground = delete + THEN act pen := "P"0"" + ELIF foreground < 0 + THEN act pen := "P"2"" + ELSE act pen := "P"1"" FI . + +set thickness: + act thick := thickness . + +set linetype: + SELECT linetype OF + CASE nothing : act pen CAT "L"0""0"" + CASE durchgehend : act pen CAT "L"255""255"" + CASE gepunktet : act pen CAT "L"85""85"" + CASE kurz gestrichelt : act pen CAT "L"15""15"" + CASE lang gestrichelt : act pen CAT "L"255""0"" + CASE strichpunkt : act pen CAT "L"255""16"" + OTHERWISE act pen CAT "L" + intern (linetype) END SELECT . + +END PROC pen; + +PROC move (INT CONST x, y) : + replace (vektor, 1, x); + replace (vektor, 2, y); + + out ("M"); + out (vektor); + pos := POS : (x, y) +END PROC move; + +PROC draw (INT CONST x, y) : + IF act thick <> 0 + THEN IF horizontal line + THEN thick y + ELSE thick x FI; + x MOVE y + ELSE replace (vektor, 1, x); + replace (vektor, 2, y); + out ("D"); + out (vektor) + FI; + pos := POS : (x, y) . + +horizontal line: + abs (pos.x-x) > abs (pos.y-y) . + +thick y: + INT VAR dy, old x :: pos.x-x ausgleich, new x :: x+x ausgleich; + old x MOVE pos.y; + new x DRAW y; + FOR dy FROM 1 UPTO act thick + REP old x MOVE pos.y+dy; + new x DRAW y+dy; + old x MOVE pos.y-dy; + new x DRAW y-dy; + PER . + +x ausgleich: + IF pos.x <= x + THEN act thick + ELSE -act thick FI . + +thick x: + INT VAR dx, old y :: pos.y-y ausgleich, new y :: y+y ausgleich; + pos.x MOVE old y; + x DRAW new y; + FOR dx FROM 1 UPTO act thick + REP pos.x+dx MOVE old y; + x+dx DRAW new y; + pos.x-dx MOVE old y; + x-dx DRAW new y; + PER . + +y ausgleich: + IF pos.y <= y + THEN act thick + ELSE -act thick FI . + +END PROC draw; + +INT VAR x fak :: zeichen.width, + y fak :: zeichen.height; +PROC draw (TEXT CONST record, REAL CONST angle, height, width): + IF act pen = "L"0""0"" + THEN + ELIF character defined + THEN draw graphic character + ELSE out (""9""); + pos cursor (pos.x, pos.y); + get cursor (x pos, y pos); + outsubtext (record, 1, 79-y pos); + out (""16"") + FI . + +draw graphic character: +(**** Hier werden Texte mit dem Winkel 'angle',der Hhe 'height' und ****) +(**** der Breite 'width' gezeichnet. Die Form der Zeichen ist in der ****) +(**** Datei 'STD Zeichensatz' enthalten. ****) + INT CONST x step :: character x step, y step :: character y step; + INT VAR x pos :: pos.x, y pos :: pos.y, i, n, x, y; + BOOL VAR move order; + + set character height and width; + out ("L"255""255""); + + FOR i FROM 1 UPTO length (record) + REP draw character i PER; + out (act pen); + pos.x MOVE pos.y . + +set character height and width: + IF width = 0.0 AND height = 0.0 + THEN x fak := zeichen.width; + y fak := zeichen.height + ELSE x fak := int (hor faktor * width+0.5); + y fak := int (vert faktor * height+0.5) + FI . + +character x step: + IF width <> 0.0 + THEN int (cosd (angle) * hor faktor * width+0.5) + ELSE int (cosd (angle) * real (zeichen.width)+0.5) FI . + +character y step: + IF height <> 0.0 + THEN int (sind (angle) * vert faktor * height+0.5) + ELSE int (sind (angle) * real (zeichen.height)+0.5) FI . + +draw character i: + IF code (record SUB i) < 32 + THEN steuerzeichen + ELSE normale zeichen FI . + +steuerzeichen: + SELECT code (record SUB i) OF + CASE 1: x pos := 0; + y pos := 255-y fak + CASE 2: x pos INCR x fak + CASE 3: y pos INCR y fak + CASE 4: out (""9""); pos cursor (x pos, y pos); out (""4""16"") + CASE 5: out (""9""); pos cursor (x pos, y pos); out (""5""16"") + CASE 7: out (""9""7""16"") + CASE 8: x pos DECR x fak + CASE 10: y pos DECR y fak + CASE 13: x pos := pos.x + END SELECT . + +normale zeichen: + TEXT CONST char :: zeichen.char [code (record SUB i)]; + FOR n FROM 1 UPTO length (char) DIV 4 + REP value (char, n, x, y, move order); + IF move order + THEN x pos+x MOVE y pos+y + ELSE x pos+x DRAW y pos+y FI + PER; + x pos INCR x step; + y pos INCR y step . + +END PROC draw; + +PROC draw (TEXT CONST record) : + draw (record, 0.0, 0.0, 0.0) +END PROC draw; + +PROC value (TEXT CONST char, INT CONST n, INT VAR x, y, BOOL VAR move): + x := char ISUB n+n-1; + y := char ISUB n+n; + IF x < 0 + THEN IF (x AND bit 14) <> 0 + THEN move := FALSE + ELSE move := TRUE; + x := x XOR bit 14 + FI + ELSE IF (x AND bit 14) <> 0 + THEN move := TRUE; + x := x XOR bit 14 + ELSE move := FALSE FI + FI; + x := (x*x fak) DIV zeichen.width; + y := (y*y fak) DIV zeichen.height + +END PROC value; + +PROC get cursor (TEXT VAR t, INT VAR x, y) : + get cursor (t, x, y, -1, -1, -1, -1) +END PROC get cursor; + +PROC get cursor (TEXT VAR t, INT VAR x, y, INT CONST x0, y0, x1, y1): + init cursor; + out ("P"2""); + REP set cursor; + get step; + out (cursor pos); + out (cursor line); + move cursor + PER . + +init cursor: + INT VAR delta :: 1; + x := pos.x; + y := pos.y; + + IF x0 >= 0 AND x0 <= 511 AND y0 >= 0 AND y0 <= 255 + THEN replace (cursor line, 2, "M"); + replace (cursor line, 2, x0); + replace (cursor line, 3, y0); + replace (cursor line, 8, "D") + ELSE replace (cursor line, 2, ""0""0""0""0""0""0"M") FI; + + IF x1 >= 0 AND x1 <= 511 AND y1 >= 0 AND y1 <= 255 + THEN replace (cursor line,14, "D"); + replace (cursor line, 8, x1); + replace (cursor line, 9, y1); + ELSE replace (cursor line,14, ""0""0""0""0""0"") FI . + +get step: + t := incharety (1); + IF t <> "" + THEN IF delta < 10 + THEN delta INCR delta + ELSE delta INCR 1 FI + ELSE delta := 1; + inchar (t) + FI . + +move cursor: + SELECT code (t) OF + CASE 2 : x INCR delta (*normaler Zehnerblock*) + CASE 19: x INCR delta; y INCR delta + CASE 3 : y INCR delta + CASE 18: x DECR delta; y INCR delta + CASE 8 : x DECR delta + CASE 14: x DECR delta; y DECR delta + CASE 10: y DECR delta + CASE 15: x INCR delta; y DECR delta + OTHERWISE leave get cursor ENDSELECT; + check . + +set cursor: + replace (cursor pos, 2, x-4); replace (cursor pos, 3, y); + replace (cursor pos, 5, x+4); replace (cursor pos, 6, y); + replace (cursor pos, 8, x); replace (cursor pos, 9, y-4); + replace (cursor pos,11, x); replace (cursor pos,12, y+4); + out (cursor pos); + + replace (cursor line, 5, x); replace (cursor line, 6, y); + out (cursor line) . + +leave get cursor: + out (act pen); + pos.x MOVE pos.y; + + LEAVE get cursor . + +check : + IF x < 0 + THEN x := 0; + out (""9""7""16"") + ELIF x > 511 + THEN x := 511; + out (""9""7""16"") + FI; + IF y < 0 + THEN y := 0; + out (""9""7""16"") + ELIF y > 255 + THEN y := 255; + out (""9""7""16"") + FI . + +END PROC get cursor; + +PROC cursor on (INT CONST x, y): + out ("P"2""); + replace (cursor pos, 2, x-4); replace (cursor pos, 3, y); + replace (cursor pos, 5, x+4); replace (cursor pos, 6, y); + replace (cursor pos, 8, x); replace (cursor pos, 9, y-4); + replace (cursor pos,11, x); replace (cursor pos,12, y+4); + out (cursor pos) + +END PROC cursor on; + +PROC cursor off: + out ("P"2""); + out (cursor pos); + out (act pen); + pos.x MOVE pos.y +END PROC cursor off; + +(* Bildwiederholspeicheraufbau der M20: *) +(* 32 Blcke (0...31) enthalten jeweils 8 Microzeilen. Die Bitbelegung *) +(* eines Blocks von 256 INT ist 7654321FEDCBA98. *) + +PROC get screen (DATASPACE VAR ds, INT CONST page): + INT VAR i, n, begin :: 32*page; + FOR i FROM 0 UPTO 31 + REP block in (ds, begin+i, -1, i, n) PER +END PROC get screen; + +PROC put screen (DATASPACE CONST ds, INT CONST page): + INT VAR i, n, begin :: 32*page; + FOR i FROM 0 UPTO 31 + REP block out (ds, begin+i, -1, i, n) PER +END PROC put screen; + +TEXT VAR conv :: ""0""0""; +TEXT PROC intern (INT CONST n): + replace (conv, 1, n); + conv +END PROC intern; + +TEXT VAR vektor :: ""0""0""0""0""; +OP MOVE (INT CONST x, y): + replace (vektor, 1, x); + replace (vektor, 2, y); + + out ("M"); + out (vektor) +END OP MOVE; + +OP DRAW (INT CONST x, y): + replace (vektor, 1, x); + replace (vektor, 2, y); + + out ("D"); + out (vektor) +END OP DRAW; + +PROC pos cursor (INT CONST x, y): + cursor ((x-10) DIV 6, (237-y) DIV 10) +END PROC pos cursor; + +END PACKET m20 plot + +IF exists ("ZEICHEN 6*10") +THEN zeichensatz ("ZEICHEN 6*10") +ELIF exists ("ZEICHEN 9*12") +THEN zeichensatz ("ZEICHEN 9*12") +ELSE put line ("Warnung: Zeichensatz fehlt") FI diff --git a/app/mpg/1987/src/MTRXPLOT.ELA b/app/mpg/1987/src/MTRXPLOT.ELA new file mode 100644 index 0000000..4068866 --- /dev/null +++ b/app/mpg/1987/src/MTRXPLOT.ELA @@ -0,0 +1,416 @@ +PACKET matrix plot DEFINES drawing area, + begin plot, + end plot, + clear, + pen, + move, + draw, + get cursor, + + zeichensatz, + reset, + SCREEN, :=, + get screen, put screen: + +LET max x = 511, {Bildschirm : 1-512 x 1-256} + max x plus 1 = 512, + max y = 255, + + hor faktor = 22.21739, {***** x pixel / x cm *****} + vert faktor = 18.61314, {***** y pixel / y cm *****} + + + delete = 0, {Farbcodes} + std = 1, + black = 5, + white = 6, + + durchgehend = 1, {Linientypen} + gepunktet = 2, + kurz gestrichelt = 3, + lang gestrichelt = 4, + strichpunkt = 5; + + +LET PEN = STRUCT (INT back, fore, thick, line, BOOL hidden, action); +LET POS = STRUCT (INT x, y); +TYPE SCREEN = ROW 32 ROW 256 INT; +LET ZEICHENSATZ = STRUCT (ROW 255 TEXT char, INT width, height); + +ROW max x plus 1 INT VAR akt maxima, last maxima; +ZEICHENSATZ VAR zeichen; +SCREEN VAR screen; +PEN VAR stift :: PEN : (black, white, 0, durchgehend, FALSE, TRUE); +POS VAR pos :: POS : (0, 0), start, delta; +INT VAR i, n, diff, up right error, right error, old error, + pattern pos :: 0, line pattern :: -1; +BOOL VAR bit set :: TRUE; + +reset; +zeichensatz ("STD Zeichensatz"); +clear (screen); + +PROC reset: + FOR i FROM 1 UPTO 512 + REP last maxima [i] := -1; + akt maxima [i] := -1 + PER +END PROC reset; + +PROC zeichensatz (TEXT CONST name): + IF exists (name) + THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name); + zeichen := new zeichen + ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI +END PROC zeichensatz; + +PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : + x cm := 23.0; y cm := 13.7; {***** Horizontale und vertikale *****} + {***** Gre in Zentimetern. *****} + x pixel := 511; y pixel := 255 {***** Koordinaten des rechten *****} + {***** oberen Punktes. *****} +END PROC drawing area; + +PROC begin plot : +ENDPROC begin plot ; + +PROC end plot : +ENDPROC end plot ; + +PROC clear : + stift := PEN : (black, white, 0, durchgehend, FALSE, TRUE); + pos := POS : (0, 0); + +(* Lschen der Hiddenmaxima *); + reset; + +(* Ausgabe der Bildmatrix auf dem Endgert *); + put screen; + +(* Lschen der Bildmatrix *); + clear (screen) + +END PROC clear; + +PROC pen (INT CONST background, foreground, thickness, linetype): + set linetype; + stift := PEN : (background, foreground,thickness, linetype, + linetype <> 0, thickness < 0) . + +set linetype: + pattern pos := 0; + SELECT linetype OF + CASE durchgehend : stift.line := -1 + CASE gepunktet : stift.line := 21845 + CASE kurz gestrichelt : stift.line := 3855 + CASE lang gestrichelt : stift.line := 255 + CASE strichpunkt : stift.line := 4351 + OTHERWISE stift.line := linetype END SELECT; + +END PROC pen; + +PROC move (INT CONST x, y) : + pattern pos := 0; + IF stift.hidden + THEN last maxima := akt maxima FI; + + pos := POS : (x, y) +END PROC move; + +PROC draw (INT CONST x, y) : + IF stift.action + THEN IF stift.thick > 1 + THEN draw thick vektor + ELSE vector (x-pos.x, y-pos.y) FI + FI; + pos := POS : (x, y) . + +draw thick vektor: + INT CONST old pattern pos := pattern pos; + check direction; + FOR diff FROM -stift.thick UPTO stift.thick + REP draw single vektor PER . + +check direction : + BOOL CONST x direction := abs (x-pos.x) > abs (y-pos.y); + IF x direction + THEN start := POS : (pos.x+stift.thick * sign (pos.x-x), pos.y); + delta := POS : (x+stift.thick * sign (x-pos.x)-pos.x, y-pos.y) + ELSE start := POS : (pos.x, pos.y+stift.thick * sign (pos.y-y)); + delta := POS : (x-pos.x, y+stift.thick * sign (y-pos.y)-pos.y); + FI . + +draw single vektor : + pattern pos := old pattern pos; + IF x direction + THEN pos := POS : (start.x, start.y+diff); + vector (delta.x, delta.y+diff) + ELSE pos := POS : (start.x+diff, start.y+diff); + vector (delta.x+diff, delta.y) + FI . + +END PROC draw; + +PROC vector (INT CONST dx , dy) : + IF dx >= 0 + THEN IF dy > dx THEN vector (pos.y, pos.x, dy, dx, 1, 1) + ELIF dy > 0 THEN vector (pos.x, pos.y, dx, dy, 1, 1) + + ELIF dy > -dx THEN vector (pos.x, pos.y, dx, -dy, 1,-1) + ELSE vector (pos.y, pos.x, -dy, dx,-1, 1) FI + + ELSE IF dy > -dx THEN vector (pos.y, pos.x, dy, -dx, 1,-1) + ELIF dy > 0 THEN vector (pos.x, pos.y, -dx, dy,-1, 1) + + ELIF dy > dx THEN vector (pos.x, pos.y, -dx, -dy,-1,-1) + ELSE vector (pos.y, pos.x, -dy, -dx,-1,-1) FI + FI . + +ENDPROC vector ; + +PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) : + prepare first step ; + point; + FOR i FROM 1 UPTO dx + REP do one step PER . + +prepare first step : + up right error := dy - dx; + right error := dy; + old error := 0 . + +do one step: + IF right is better + THEN do right step + ELSE do up right step + FI . + +right is better : + abs (old error + right error) < abs (old error + up right error) . + +do upright step : + x pos INCR right ; + y pos INCR up ; + point ; + old error INCR upright error . + +do right step : + x pos INCR right ; + point ; + old error INCR right error . + +point : + IF visible (pos) + THEN SELECT (pos.x+1) MOD 16 OF + CASE 0: set bit (block [byte], 8) + CASE 1: set bit (block [byte], 7) + CASE 2: set bit (block [byte], 6) + CASE 3: set bit (block [byte], 5) + CASE 4: set bit (block [byte], 4) + CASE 5: set bit (block [byte], 3) + CASE 6: set bit (block [byte], 2) + CASE 7: set bit (block [byte], 1) + CASE 8: set bit (block [byte], 0) + CASE 9: set bit (block [byte], 15) + CASE 10: set bit (block [byte], 14) + CASE 11: set bit (block [byte], 13) + CASE 12: set bit (block [byte], 12) + CASE 13: set bit (block [byte], 11) + CASE 14: set bit (block [byte], 10) + CASE 15: set bit (block [byte], 9) + END SELECT; + FI . + +block: + screen [(255-pos.y) DIV 8 + 1] . + +byte: + pos.x DIV 16 + ((255-pos.y) AND 7) * 32 + 1 . + +END PROC vector; + +BOOL PROC visible (POS CONST pos) : + IF pos.x < 0 OR pos.x > max x OR pos.y < 0 OR pos.y > max y + THEN FALSE + ELSE pattern AND hidden FI . + +pattern: + bit set := bit (line pattern, pattern pos); + pattern pos := (pattern pos+1) AND 15; + bit set . + +hidden: + IF akt maxima [pos.x+1] < pos.y + THEN akt maxima [pos.x+1] := pos.y FI; + + pos.y > last maxima [pos.x+1] . + +END PROC visible; + +PROC draw (TEXT CONST record, REAL CONST angle, height, width): +{**** Hier werden Texte mit dem Winkel 'angle',der Hhe 'height' und *****} +{**** der Breite 'width' gezeichnet. Falls die Hardware dieses *****} +{**** bereits ermglicht, so mssen die Variable 'zeichen' und die *****} +{**** Prozedur Zeichensatz gelscht werden. Der Datenraum *****} +{**** 'STD Zeichensatz' wird in diesem Fall nicht bentigt. *****} + BOOL CONST horizontal :: NOT (abs (angle) MOD 180.0 > 45.0 AND abs (angle) MOD 180.0 < 135.0); + INT CONST x fak :: character width, x step :: character x step, + y fak :: character height, y step :: character y step; + INT VAR x pos :: pos.x, y pos :: pos.y, i; + POS VAR old pos := pos; + + FOR i FROM 1 UPTO length (record) + REP draw character i PER; + pos := old pos . + +character width: + IF width <> 0.0 + THEN int (hor faktor * width+0.5) + ELSE zeichen.width FI . + +character x step: + IF horizontal + THEN IF width <> 0.0 + THEN int (cosd (angle) * hor faktor * width+0.5) + ELSE int (cosd (angle) * real (zeichen.width)+0.5) FI + ELSE IF width <> 0.0 + THEN int (cosd (angle) * vert faktor * width+0.5) + ELSE int (cosd (angle) * real (zeichen.height)+0.5) FI + FI . + +character height: + IF height <> 0.0 + THEN int (vert faktor * height+0.5) + ELSE zeichen.height FI . + +character y step: + IF horizontal + THEN IF height <> 0.0 + THEN int (sind (angle) * vert faktor * height+0.5) + ELSE int (sind (angle) * real (zeichen.height)+0.5) FI + ELSE IF height <> 0.0 + THEN int (sind (angle) * hor faktor * height+0.5) + ELSE int (sind (angle) * real (zeichen.width)+0.5) FI + FI . + +draw character i: + IF code (record SUB i) < 32 + THEN steuerzeichen + ELSE normale zeichen FI . + +steuerzeichen: + SELECT code (record SUB i) OF + CASE 7: out (""0""7""16"") + CASE 13: x pos := pos.x; y pos := pos.y + END SELECT . + +normale zeichen: + TEXT CONST char :: zeichen.char [code (record SUB i)]; + IF horizontal + THEN draw horizontal + ELSE draw vertical FI . + +draw vertical: + n := 3; + IF char <> "" + THEN pos := POS : (((char ISUB 2)*y fak) DIV zeichen.height + x pos, + -((char ISUB 1)*x fak) DIV zeichen.width + y pos) + FI; + WHILE n <= length (char) DIV 2 + REP IF (char ISUB n) < 0 OR (char ISUB n+1) < 0 + THEN pos := POS : (((char ISUB n+1)*y fak) DIV zeichen.height + x pos, + -((char ISUB n )*x fak) DIV zeichen.width + y pos) + ELSE vector (-((char ISUB n+1)*y fak) DIV zeichen.height + x pos-pos.x, + ((char ISUB n )*x fak) DIV zeichen.width + y pos-pos.y) + FI; + n INCR 2 + PER; + x pos INCR x step; + y pos INCR y step . + +draw horizontal: + n := 3; + IF char <> "" + THEN pos := POS : (-((char ISUB 1)*x fak) DIV zeichen.width + x pos, + -((char ISUB 2)*y fak) DIV zeichen.height + y pos) + FI; + WHILE n <= length (char) DIV 2 + REP IF (char ISUB n) < 0 OR (char ISUB n+1) < 0 + THEN pos := POS : (-((char ISUB n )*x fak) DIV zeichen.width + x pos, + -((char ISUB n+1)*y fak) DIV zeichen.height + y pos) + ELSE vector (((char ISUB n )*x fak) DIV zeichen.width + x pos-pos.x, + ((char ISUB n+1)*y fak) DIV zeichen.height + y pos-pos.y) + FI; + n INCR 2 + PER; + x pos INCR x step; + y pos INCR y step . + +END PROC draw; + +PROC draw (TEXT CONST record) : + draw (record, 0.0, 0.0, 0.0) +END PROC draw; + +PROC get cursor (TEXT VAR t, INT VAR x, y) : + t := ""; + x := 0; + y := 0 +END PROC get cursor; + +OP := (SCREEN VAR l, SCREEN CONST r): + CONCR (l) := CONCR (r) +END OP :=; + +PROC get screen (TEXT CONST name): + IF exists (name) + THEN get screen (old (name)) + ELSE get screen (new (name)) FI; +END PROC get screen; + +PROC get screen (DATASPACE CONST ds): + BOUND SCREEN VAR ds screen :: ds; + ds screen := screen +END PROC get screen; + +PROC get screen (SCREEN VAR ds screen): + ds screen := screen +END PROC get screen; + +PROC get screen: + FOR i FROM 1 UPTO 32 + REP block in (screen [i], -1, i-1, n) PER +END PROC get screen; + +PROC put screen (TEXT CONST name): + IF exists (name) + THEN put screen (old (name)) + ELSE errorstop ("Der Datenraum """ + name + """ existiert nicht") FI +END PROC put screen; + +PROC put screen (DATASPACE CONST ds): + BOUND SCREEN VAR ds screen :: ds; + screen := ds screen; + put screen +END PROC put screen; + +PROC put screen (SCREEN VAR ds screen): + screen := ds screen; + put screen +END PROC put screen; + +PROC put screen: + FOR i FROM 1 UPTO 32 + REP block out (screen [i], -1, i-1, n) PER +END PROC put screen; + +PROC clear (SCREEN VAR screen): + FOR i FROM 1 UPTO 256 + REP screen [1] [i] := 0 PER; + FOR i FROM 2 UPTO 32 + REP screen [i] := screen [1] PER +END PROC clear; + +END PACKET matrix plot; + + diff --git a/app/mpg/1987/src/Muster b/app/mpg/1987/src/Muster new file mode 100644 index 0000000..336e2ef --- /dev/null +++ b/app/mpg/1987/src/Muster @@ -0,0 +1,73 @@ +INCLUDE "Name der Include-Datei"; + +PLOTTER "Plottername",,,,,,; + +LINK /,/....; + +COLORS ""; + + . + . + . + + +PROC initplot: + Warnung: Da der Configurator den Prozedur-Rumpf in ein Refinement + verwandelt, muessen Namenskonflikte vermieden wrden ! +END PROC initplot; + +PROC endplot: +END PROC endplot; + +PROC prepare: +END PROC prepare; + +PROC clear: +END PROC clear; + +PROC home: +END PROC home; + +PROC moveto (INT CONST x,y): +END PROC moveto; + +PROC drawto (INT CONST x,y): +END PROC drawto; + +PROC setpixel (INT CONST x,y): +END PROC setpixel; + +PROC foreground (INT CONST type): +END PROC foreground; + +PROC background (INT CONST type): +END PROC background; + +PROC setpalette: +END PROC setpalette: + +PROC circle (INT CONST x,y,rad,from,to): +END PROC circle; + +PROC box (INT CONST x1,y1,x2,y2,pattern): +END PROC box; + +PROC fill (INT CONST x,y,pattern): +END PROC fill; + +EDITOR; (* Durch EDITOR wird das optionale Vorhandensein nachfolgender + Editor-Befehle angezeigt *) + +PROC get cursor (INT VAR x,y,TEXT VAR exit char): +END PROC get cursor; + +PROC graphik cursor (INT CONST x,y,BOOL CONST on): +END PROC graphik cursor; + +PROC set marker (INT CONST x,y,type): +END PROC set marker; diff --git a/app/mpg/1987/src/NEC P-9 2-15.MD.GCONF b/app/mpg/1987/src/NEC P-9 2-15.MD.GCONF new file mode 100644 index 0000000..0058f48 --- /dev/null +++ b/app/mpg/1987/src/NEC P-9 2-15.MD.GCONF @@ -0,0 +1,219 @@ +INCLUDE "std primitives"; +INCLUDE "matrix printer"; + +PLOTTER "NEC P9 MD",2,15,2340,1984,33.02,27.99644; + +COLORS "000999"; + +(* Version vom 21.10.87 BJ *) + +(* Globale Daten fuer NEC P9 *) + +LET md p9 graf = ""27"*"39"", (* Nec P9 in 24-Nadel 180 Pixel/zoll Modus *) + md p9 feed = ""28"3", (* Zeilenabstand in 360 Pixel/Zoll setzen *) + md p9 nlq = ""27"x"1"", (* NLQ Modus waehlen *) + md p9 pos = ""27"\"; (* in 1/180 Zoll-Schritten rel Positionieren *) + +LET md p9 x max = 2339, + md p9 y max = 1979, + md p9 y lines = 124, (* y pixel / 16 (Punkte pro INT) *) + md p9 x per ds= 780, (* Maximale x pixel pro Dataspace ( Darf *) + (* Nicht mehr als 256 K sein !!! *) + (* x per ds = 256 * 1024 / p9 y lines / 4 *) + md p9 x lines = 3; (* x pixel / hd p9 x per ds *) + +LET MDPYLINE = ROW md p9 x per ds INT, + MDPSMAP = ROW md p9 y lines MDPYLINE, + MDPMAP = ROW md p9 x lines BOUND MDPSMAP; + +MDPMAP VAR md p9 map; + +ROW md p9 x lines DATASPACE VAR md p9 ds; + +INT VAR md p9 x pos, md p9 y pos; + +(* Globale Daten Ende *) + +PROC prepare: + REP + call (29, "", printer); (* wait for halt *) + IF task(channel(plotter)) = niltask (* Es koennte der HD worker dran sein *) + THEN continue (channel (plotter)) (* der startet den PRINTER wieder ! *) + ELSE pause(300) (* folge : Kanal belegt -> dead *) + FI + UNTIL channel(myself) = channel(plotter) PER +END PROC prepare; + +PROC initplot: + INT VAR md p9 i; + FOR md p9 i FROM 1 UPTO md p9 x lines REP + md p9 ds[md p9 i] := nilspace; + md p9 map[md p9 i] := md p9 ds[md p9 i] + PER +END PROC initplot; + +PROC endplot: + md p9 put map; + break(quiet); + call (26, "", printer); (* start spool *) + enable stop +END PROC endplot; + +PROC md p9 put map: + open graf; + put map; + close graf; + forget dataspaces. + + open graf: + out(md p9 feed + ""32""); (* LF auf 16/180 Zoll setzen *) + out(md p9 nlq). (* NLQ Modus waehlen, damit Positionierung in 1/180 *) + (* Schritten geht (sonst 1/120) *) + close graf: + out(""12""). (* Form Feed ! Drucker muss auf richtige Seitenlaenge *) + (* eingestellt sein (EUMEL-DR macht kein FF) *) + + forget dataspaces: + INT VAR i; + FOR i FROM 1 UPTO md p9 x lines REP + forget(md p9 ds[i]) + PER. + + put map: + INT VAR j; + FOR j FROM 1 UPTO md p9 y lines REP + put line; + PER. + + put line: + INT VAR actual pos :: 0, (* actual pos : aktuelle x-position 0..x max*) + last pos; + WHILE actual pos <= md p9 x max REP + put blank cols; + put nonblank cols + PER; + line. + + put blank cols: + last pos := actual pos; + WHILE actual pos <= md p9 x max CAND actual col is blank REP + actual pos INCR 1 + PER; + IF actual pos > last pos AND actual pos <= md p9 x max + THEN out blank cols + FI. + + put nonblank cols: + last pos := actual pos; + WHILE actual pos <= md p9 x max CAND NOT actual col is blank REP + actual pos INCR 1 + PER; + IF actual pos > last pos + THEN out nonblank cols + FI. + + out blank cols: + TEXT VAR t :: " "; + replace(t, 1, actual pos - last pos); + out (md p9 pos + t). + + out nonblank cols: + t := " "; + replace (t,1, actual pos - last pos); + out(md p9 graf + t); + INT VAR k; + FOR k FROM last pos UPTO actual pos - 1 REP + INT VAR word :: md p9 map [(k DIV md p9 x per ds) + 1][j] + [(k MOD md p9 x per ds) + 1], + first byte :: word; + rotate (word, 8); + out (code (word)); + out (code (first byte)); + out (""0"") + PER. + + actual col is blank: + md p9 map [(actual pos DIV md p9 x per ds) + 1][j] + [(actual pos MOD md p9 x per ds) + 1] = 0 + +END PROC md p9 put map; + +PROC clear: + md p9 clear +END PROC clear; + +PROC md p9 clear: + create initline; + initialize all lines. + + create initline: + MDPYLINE VAR initline; + INT VAR i; + FOR i FROM 1 UPTO md p9 x per ds REP + initline[i] := 0 + PER. + + initialize all lines: + INT VAR k; + FOR i FROM 1 UPTO md p9 x lines REP + FOR k FROM 1 UPTO md p9 y lines REP + md p9 map[i][k] := initline + PER + PER +END PROC md p9 clear; + +PROC home: + move to (0,0) +END PROC home; + +PROC moveto (INT CONST x,y): + md p9 x pos := x; + md p9 y pos := y +END PROC moveto; + +PROC drawto (INT CONST x,y): + printer line (md p9 x pos,md p9 y max - md p9 y pos, + x, md p9 y max - y, + PROC (INT CONST, INT CONST) md p9 set pixel); + md p9 x pos := x; + md p9 y pos := y +END PROC drawto; + +PROC setpixel (INT CONST x,y): + md p9 set pixel (x, md p9 y max - x) +END PROC setpixel; + +PROC md p9 set pixel (INT CONST x,y): + setbit (md p9 map [(x DIV md p9 x per ds) + 1][(y DIV 16) + 1] + [(x MOD md p9 x per ds) + 1],15 - (y AND 15)) +END PROC md p9 set pixel; + +BOOL PROC md p9 is pixel (INT CONST x,y): + bit (md p9 map [(x DIV md p9 x per ds) + 1][(y DIV 16) + 1] + [(x MOD md p9 x per ds) + 1],15 - (y AND 15)) +END PROC md p9 is pixel; + +PROC foreground (INT VAR type): + type := 1 +END PROC foreground; + +PROC background (INT VAR type): + type := 0 +END PROC background; + +PROC setpalette: +END PROC setpalette; + +PROC circle (INT CONST x,y,rad,from,to): + std circle (x,y,rad,from,to) +END PROC circle; + +PROC box (INT CONST x1,y1,x2,y2,pattern): + std box (x1, y1, x2, y2, pattern) +END PROC box; + +PROC fill (INT CONST x,y,pattern): + printer fill (x,x,md p9 y max - y,1, + BOOL PROC (INT CONST, INT CONST) md p9 is pixel, + PROC (INT CONST, INT CONST) md p9 set pixel) +END PROC fill; diff --git a/app/mpg/1987/src/PCPLOT.ELA b/app/mpg/1987/src/PCPLOT.ELA new file mode 100644 index 0000000..f0949ae --- /dev/null +++ b/app/mpg/1987/src/PCPLOT.ELA @@ -0,0 +1,276 @@ +PACKET pc plot DEFINES drawing area, {Autor: H. Indenbirken} + begin plot, {Stand: 08.02.85 } + end plot, + clear, + colour palette, + pen, + move, + draw, + + get cursor, + zeichensatz: + +LET hor faktor = 22.21739, {***** x pixel / x cm *****} + vert faktor = 18.61314, {***** y pixel / y cm *****} + + delete = 0, {Farbcodes} + std = 1, + black = 5, + white = 6, + + nothing = 0, {Linientypen} + durchgehend = 1, + gepunktet = 2, + kurz gestrichelt = 3, + lang gestrichelt = 4, + strichpunkt = 5, + + bit 14 = 16384; + +LET POS = STRUCT (INT x, y); +LET ZEICHENSATZ = STRUCT (ROW 255 TEXT char, INT width, height); + +ZEICHENSATZ VAR zeichen; +BOOL VAR character defined :: FALSE; +TEXT VAR cursor pos :: ""0"M"0""0""0""0""0"D"0""0""0""0""0"M"0""0""0""0""0"D"0""0""0""0"", + cursor line :: ""0"M"0""0""0""0""0"D"0""0""0""0""0"D"0""0""0""0""; +INT VAR act thick :: 0, i, dummy, resolution :: 6, colour code :: 256; +POS VAR pos :: POS : (0, 0); + +PROC zeichensatz (TEXT CONST name): + IF exists (name) { Hhe: 0.64 cm } + THEN BOUND ZEICHENSATZ VAR new zeichen :: old (name); { Breite: 0.40 cm } + zeichen := new zeichen; + character defined := TRUE + ELSE errorstop ("Der Zeichensatz """ + name + """ existiert nicht") FI +END PROC zeichensatz; + +PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : + x cm := 22.0; y cm := 13.7; + IF resolution = 6 + THEN x pixel := 639; y pixel := 199 + ELSE x pixel := 319; y pixel := 199 FI +END PROC drawing area; + + +PROC colour palette (INT CONST colour): + SELECT colour OF + CASE 0: resolution := 6 + CASE 1: resolution := 4; + colour code:= 256 + CASE 2: resolution := 4; + colour code:= 257 + OTHERWISE errorstop ("colour palette nicht vorhanden") ENDSELECT + +END PROC colour palette; + +PROC begin plot : + control (-5, resolution, 0, dummy); + control (-4, 0, colour code, dummy) +ENDPROC begin plot ; + +PROC end plot : + control (-5, 3, 0, dummy) +ENDPROC end plot ; + +PROC clear : + control (-5, resolution, 0, dummy); + control (-4, 0, colour code, dummy); + act thick := 0; + +END PROC clear; + +PROC pen (INT CONST background, foreground, thickness, linetype): + act thick := thickness; + control (-8, linetype code, foreground code, dummy) . + +linetype code: + SELECT linetype OF + CASE nothing : 0 + CASE durchgehend : -1 + CASE gepunktet : 21845 + CASE kurz gestrichelt : 3855 + CASE lang gestrichelt : 255 + CASE strichpunkt : 4351 + OTHERWISE linetype END SELECT . + +foreground code: + IF foreground = delete + THEN 0 + ELIF foreground < 0 + THEN 128 + ELSE foreground FI . + +END PROC pen; + +PROC move (INT CONST x, y) : + control (-7, x, 200-y, dummy); + pos := POS : (x, y) +END PROC move; + +PROC draw (INT CONST x, y) : + IF act thick <> 0 + THEN IF horizontal line + THEN thick y + ELSE thick x FI; + x MOVE y + ELSE control (-6, x, 200-y, dummy) FI; + pos := POS : (x, y) . + +horizontal line: + abs (pos.x-x) > abs (pos.y-y) . + +thick y: + INT VAR dy, old x :: pos.x-x ausgleich, new x :: x+x ausgleich; + old x MOVE pos.y; + new x DRAW y; + FOR dy FROM 1 UPTO act thick + REP old x MOVE pos.y+dy; + new x DRAW y+dy; + old x MOVE pos.y-dy; + new x DRAW y-dy; + PER . + +x ausgleich: + IF pos.x <= x + THEN act thick + ELSE -act thick FI . + +thick x: + INT VAR dx, old y :: pos.y-y ausgleich, new y :: y+y ausgleich; + pos.x MOVE old y; + x DRAW new y; + FOR dx FROM 1 UPTO act thick + REP pos.x+dx MOVE old y; + x+dx DRAW new y; + pos.x-dx MOVE old y; + x-dx DRAW new y; + PER . + +y ausgleich: + IF pos.y <= y + THEN act thick + ELSE -act thick FI . + +END PROC draw; + +INT VAR x fak :: zeichen.width, + y fak :: zeichen.height; +PROC draw (TEXT CONST record, REAL CONST angle, height, width): + IF character defined + THEN draw graphic character + ELSE pos cursor (pos.x, pos.y); + get cursor (x pos, y pos); + outsubtext (record, 1, 79-y pos); + FI . + +draw graphic character: +{**** Hier werden Texte mit dem Winkel 'angle',der Hhe 'height' und *****} +{**** der Breite 'width' gezeichnet. Die Form der Zeichen ist in der *****} +{**** Datei 'STD Zeichensatz' enthalten. *****} + INT CONST x step :: character x step, y step :: character y step; + INT VAR x pos :: pos.x, y pos :: pos.y, i, n, x, y; + BOOL VAR move order; + + set character height and width; + + FOR i FROM 1 UPTO length (record) + REP draw character i PER; + pos.x MOVE pos.y . + +set character height and width: + IF width = 0.0 AND height = 0.0 + THEN x fak := zeichen.width; + y fak := zeichen.height + ELSE x fak := int (hor faktor * width+0.5); + y fak := int (vert faktor * height+0.5) + FI . + +character x step: + IF width <> 0.0 + THEN int (cosd (angle) * hor faktor * width+0.5) + ELSE int (cosd (angle) * real (zeichen.width)+0.5) FI . + +character y step: + IF height <> 0.0 + THEN int (sind (angle) * vert faktor * height+0.5) + ELSE int (sind (angle) * real (zeichen.height)+0.5) FI . + +draw character i: + IF code (record SUB i) < 32 + THEN steuerzeichen + ELSE normale zeichen FI . + +steuerzeichen: + SELECT code (record SUB i) OF + CASE 1: x pos := 0; + y pos := 255-y fak + CASE 2: x pos INCR x fak + CASE 3: y pos INCR y fak + CASE 4: pos cursor (x pos, y pos); + CASE 5: pos cursor (x pos, y pos); + CASE 7: out (""7"") + CASE 8: x pos DECR x fak + CASE 10: y pos DECR y fak + CASE 13: x pos := pos.x + END SELECT . + +normale zeichen: + TEXT CONST char :: zeichen.char [code (record SUB i)]; + FOR n FROM 1 UPTO length (char) DIV 4 + REP value (char, n, x, y, move order); + IF move order + THEN x pos+x MOVE y pos+y + ELSE x pos+x DRAW y pos+y FI + PER; + x pos INCR x step; + y pos INCR y step . + +END PROC draw; + +PROC draw (TEXT CONST record) : + draw (record, 0.0, 0.0, 0.0) +END PROC draw; + +PROC value (TEXT CONST char, INT CONST n, INT VAR x, y, BOOL VAR move): + x := char ISUB n+n-1; + y := char ISUB n+n; + IF x < 0 + THEN IF (x AND bit 14) <> 0 + THEN move := FALSE + ELSE move := TRUE; + x := x XOR bit 14 + FI + ELSE IF (x AND bit 14) <> 0 + THEN move := TRUE; + x := x XOR bit 14 + ELSE move := FALSE FI + FI; + x := (x*x fak) DIV zeichen.width; + y := (y*y fak) DIV zeichen.height + +END PROC value; + +PROC get cursor (TEXT VAR t, INT VAR x, y) : +END PROC get cursor; + +OP MOVE (INT CONST x, y): + control (-7, x, 200-y, dummy) +END OP MOVE; + +OP DRAW (INT CONST x, y): + control (-6, x, 200-y, dummy) +END OP DRAW; + +PROC pos cursor (INT CONST x, y): + cursor ((x-10) DIV 6, (237-y) DIV 10) +END PROC pos cursor; + +END PACKET pc plot + +IF exists ("ZEICHEN 6*10") +THEN zeichensatz ("ZEICHEN 6*10") +ELIF exists ("ZEICHEN 9*12") +THEN zeichensatz ("ZEICHEN 9*12") +ELSE put line ("Warnung: Zeichensatz fehlt") FI + diff --git a/app/mpg/1987/src/PICFILE.ELA b/app/mpg/1987/src/PICFILE.ELA new file mode 100644 index 0000000..8cd4945 --- /dev/null +++ b/app/mpg/1987/src/PICFILE.ELA @@ -0,0 +1,446 @@ +PACKET picfile DEFINES (*Autor: H.Indenbirken *) + (*Stand: 23.02.1985 *) + PICFILE, :=, picture file, plot, + select pen, selected pen, background, + set values, get values, + view, viewport, window, oblique, orthographic, perspective, + extrema, + + put, get, + to first pic, to eof, to pic, up, down, + is first picture, eof, picture no, pictures, + delete picture, insert picture, read picture, + write picture, put picture: + + +LET max pics = 1024, + pic dataspace = 1102; + + +TYPE PICFILE = BOUND STRUCT (INT size, pos, background, + ROW 16 ROW 3 INT pens, + ROW 16 BOOL hidden, + ROW 3 ROW 2 REAL sizes, + ROW 2 ROW 2 REAL limits, + ROW 4 REAL angles, + ROW 2 REAL obliques, + ROW 3 REAL perspectives + ROW max pics PICTURE pic); + +TEXT VAR i text :: ""0""0"", r text :: ""0""0""0""0""0""0""0""0""; +INT VAR i; + +OP := (PICFILE VAR p, DATASPACE CONST d) : + IF type (d) = pic dataspace + THEN CONCR (p) := d + ELIF type (d) < 0 + THEN type (d, pic dataspace) ; + CONCR (p) := d ; + init picfile dataspace ; + ELSE errorstop ("dataspace is no PICFILE") FI . + +init picfile dataspace : + r.size := 0; + r.pos := 0; + r.background := 0; + r.sizes := ROW 3 ROW 2 REAL : (ROW 2 REAL : (0.0, 1.0), + ROW 2 REAL : (0.0, 1.0), + ROW 2 REAL : (0.0, 1.0)); + r.limits := ROW 2 ROW 2 REAL : (ROW 2 REAL : (0.0, 1.0), + ROW 2 REAL : (0.0, 1.0)); + r.angles := ROW 4 REAL : (0.0, 0.0, 0.0, 0.0); + r.obliques := ROW 2 REAL : (0.0, 0.0); + r.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0); + FOR i FROM 1 UPTO 16 + REP r.pens [i] := ROW 3 INT : (1, 0, 1); + r.hidden [i] := TRUE + PER . + +r : CONCR (CONCR (p)). +END OP :=; + +DATASPACE PROC picture file (TEXT CONST name) : + IF exists (name) + THEN old (name) + ELSE new (name) FI +END PROC picture file; + +PROC plot (TEXT CONST name) : + PICFILE VAR p :: old (name); + plot (p); +END PROC plot; + +PROC plot (PICFILE VAR p) : + set values (p.sizes, p.limits, p.angles, p.obliques, + p.perspectives); + begin plot; + clear; + FOR i FROM 1 UPTO p.size + REP IF pen (p.pic [i]) <> 0 + THEN plot pic FI + PER; + end plot . + +plot pic: + pen (p.background, p.pens (pen (p.pic (i)))(1), + p.pens (pen (p.pic (i)))(2), p.pens (pen (p.pic (i)))(3)); + hidden lines (p.hidden [pen (p.pic [i])]); + plot (p.pic (i)) . + +END PROC plot; + +PROC select pen (PICFILE VAR p, INT CONST pen, colour, thickness, line type, + BOOL CONST hidden): + IF pen < 1 OR pen > 16 + THEN errorstop ("pen out of range") FI; + p.pens [pen] := ROW 3 INT : (colour, thickness, line type); + p.hidden [pen] := hidden +END PROC select pen; + +PROC selected pen (PICFILE CONST p, INT CONST pen, + INT VAR colour, thickness, line type, + BOOL VAR hidden): + IF pen < 1 OR pen > 16 + THEN errorstop ("pen out of range") FI; + colour := p.pens [pen][1]; + thickness := p.pens [pen][2]; + line type := p.pens [pen][3]; + hidden := p.hidden [pen] +END PROC selected pen; + +INT PROC background (PICFILE CONST p): + p.background +END PROC background; + +PROC background (PICFILE VAR p, INT CONST colour): + p.background := colour +END PROC background; + +PROC get values (PICFILE CONST p, + ROW 3 ROW 2 REAL VAR size, + ROW 2 ROW 2 REAL VAR limits, + ROW 4 REAL VAR angles, + ROW 2 REAL VAR oblique, + ROW 3 REAL VAR perspective) : + size := p.sizes; + limits := p.limits; + angles := p.angles; + oblique := p.obliques; + perspective := p.perspectives; + +END PROC get values; + +PROC set values (PICFILE VAR p, + ROW 3 ROW 2 REAL CONST size, + ROW 2 ROW 2 REAL CONST limits, + ROW 4 REAL CONST angles, + ROW 2 REAL CONST oblique, + ROW 3 REAL CONST perspective) : + p.sizes := size; + p.limits := limits; + p.angles := angles; + p.obliques := oblique; + p.perspectives := perspective; + +END PROC set values; + +PROC view (PICFILE VAR p, REAL CONST alpha): + p.angles [1] := alpha +END PROC view; + +PROC view (PICFILE VAR p, REAL CONST phi, theta): + p.angles [2] := sind (theta) * cosd (phi); + p.angles [3] := sind (theta) * sind (phi); + p.angles [4] := cosd (theta); +END PROC view; + +PROC view (PICFILE VAR p, REAL CONST x, y, z): + p.angles [2] := x; + p.angles [3] := y; + p.angles [4] := z +END PROC view; + +PROC viewport (PICFILE VAR p,REAL CONST hor min,hor max,vert min,vert max) : + p.limits := ROW 2 ROW 2 REAL : (ROW 2 REAL : (hor min, hor max), + ROW 2 REAL : (vert min, vert max)) +END PROC viewport; + +PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max) : + window (p, x min, x max, y min, y max, 0.0, 1.0) +END PROC window; + +PROC window (PICFILE VAR p, REAL CONST x min, x max, y min, y max, z min, z max) : + p.sizes := ROW 3 ROW 2 REAL : (ROW 2 REAL : (x min, x max), + ROW 2 REAL : (y min, y max), + ROW 2 REAL : (z min, z max)) +END PROC window; + +PROC oblique (PICFILE VAR p, REAL CONST a, b) : + p.obliques := ROW 2 REAL : (a, b); + p.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0) +END PROC oblique; + +PROC orthographic (PICFILE VAR p) : + p.obliques := ROW 2 REAL : (0.0, 0.0); + p.perspectives := ROW 3 REAL : (0.0, 0.0, 0.0) +END PROC orthographic; + +PROC perspective (PICFILE VAR p, REAL CONST cx, cy, cz) : + p.obliques := ROW 2 REAL : (0.0, 0.0); + p.perspectives := ROW 3 REAL : (cx, cy, cz) +END PROC perspective; + +PROC extrema (PICFILE VAR p, REAL VAR x min, x max, y min, y max) : + REAL VAR dummy; + extrema (p, x min, x max, y min, y max, dummy, dummy) +END PROC extrema; + +PROC extrema (PICFILE VAR p, REAL VAR x min,x max,y min,y max,z min,z max) : + REAL VAR new x min, new x max, new y min, new y max, new z min, new z max; + x min := max real; x max := - max real; + y min := max real; y max := - max real; + z min := max real; z max := - max real; + FOR i FROM 1 UPTO p.size + REP IF dim (p.pic [i]) = 2 + THEN extrema (p.pic [i], new x min, new x max, new y min, new y max) + ELSE extrema (p.pic [i], new x min, new x max, new y min, new y max, + new z min, new z max) + FI; + x min := min (x min, new x min); x max := max (x max, new x max); + y min := min (y min, new y min); y max := max (y max, new y max); + z min := min (z min, new z min); z max := max (z max, new z max); + PER +END PROC extrema; + +PROC put (FILE VAR f, PICFILE CONST p): + put line (f, parameter); + FOR i FROM 1 UPTO p.size + REP put line (f, text (p.pic [i])) PER . + +parameter: + intern (p.size) + intern (p.pos) + intern (p.background) + intern (p.pens) + + intern (p.hidden) + intern (p.sizes) + intern (p.limits) + intern (p.angles) + + intern (p.obliques) + intern (p.perspectives) . + +END PROC put; + +PROC get (PICFILE VAR p, FILE VAR f): + TEXT VAR record; + get line (f, record); + convert parameter; + FOR i FROM 1 UPTO p.size + REP get line (f, record); + p.pic [i] := picture (record) + PER . + +convert parameter: + convert (record, p.size); convert (record, p.pos); + convert (record, p.background); convert (record, p.pens); + convert (record, p.hidden); convert (record, p.sizes); + convert (record, p.limits); convert (record, p.angles); + convert (record, p.obliques); convert (record, p.perspectives) . + +END PROC get; + +PROC to first pic (PICFILE VAR p): + p.pos := 1 +END PROC to first pic; + +PROC to eof (PICFILE VAR p): + p.pos := p.size+1 +END PROC to eof; + +PROC to pic (PICFILE VAR p, INT CONST n): + IF n < 1 + THEN errorstop ("Position underflow") + ELIF n > p.size + THEN errorstop ("Position after end of PICFILE") + ELSE p.pos := n FI +END PROC to pic; + +PROC up (PICFILE VAR p): + to pic (p, p.pos-1) +END PROC up; + +PROC up (PICFILE VAR p, INT CONST n): + to pic (p, p.pos-n) +END PROC up; + +PROC down (PICFILE VAR p): + to pic (p, p.pos+1) +END PROC down; + +PROC down (PICFILE VAR p, INT CONST n): + to pic (p, p.pos+n) +END PROC down; + +BOOL PROC is first picture (PICFILE CONST p): + p.pos = 1 +END PROC is first picture; + +BOOL PROC eof (PICFILE CONST p): + p.pos >= p.size +END PROC eof; + +INT PROC picture no (PICFILE CONST p): + p.pos +END PROC picture no; + +INT PROC pictures (PICFILE CONST p): + p.size +END PROC pictures; + +PROC delete picture (PICFILE VAR p) : + INT VAR i; + FOR i FROM p.pos+1 UPTO p.size + REP p.pic [i-1] := p.pic [i] PER; + + p.pic [p.size] := nilpicture; + IF p.size > 1 + THEN p.size DECR 1 FI +END PROC delete picture; + +PROC insert picture (PICFILE VAR p) : + INT VAR i; + IF p.size >= max pics + THEN errorstop ("PICFILE overflow") + ELSE p.size INCR 1; + FOR i FROM p.size DOWNTO p.pos+1 + REP p.pic [i] := p.pic [i-1] PER; + + p.pic [p.pos] := nilpicture; + FI +END PROC insert picture; + +PROC read picture (PICFILE VAR p, PICTURE VAR pic) : + pic := p.pic (p.pos) . +END PROC read picture; + +PROC write picture (PICFILE VAR p, PICTURE CONST pic) : + p.pic (p.pos) := pic . +END PROC write picture; + +PROC put picture (PICFILE VAR p, PICTURE CONST pic) : + IF p.size >= max pics + THEN errorstop ("PICFILE overflow") + ELSE p.size INCR 1; + p.pic [p.size] := pic; + FI +END PROC put picture; + +TEXT PROC intern (INT CONST n): + replace (i text, 1, n); + i text +END PROC intern; + +TEXT PROC intern (ROW 16 ROW 3 INT CONST n): + INT VAR i, j; + TEXT VAR result :: ""; + FOR i FROM 1 UPTO 16 + REP FOR j FROM 1 UPTO 3 + REP result CAT intern (n [i][j]) PER + PER; + result +END PROC intern; + +TEXT PROC intern (ROW 16 BOOL CONST n): + INT VAR i, result :: 0; + FOR i FROM 1 UPTO 16 + REP IF n [i] + THEN set bit (result, i-1) FI + PER; + intern (result) +END PROC intern; + +TEXT PROC intern (REAL CONST r): + replace (r text, 1, r); + r text +END PROC intern; + +TEXT PROC intern (ROW 3 ROW 2 REAL CONST r): + INT VAR i, j; + TEXT VAR result :: ""; + FOR i FROM 1 UPTO 3 + REP FOR j FROM 1 UPTO 2 + REP result CAT intern (r [i][j]) PER + PER; + result +END PROC intern; + +TEXT PROC intern (ROW 2 ROW 2 REAL CONST r): + INT VAR i, j; + TEXT VAR result :: ""; + FOR i FROM 1 UPTO 2 + REP FOR j FROM 1 UPTO 2 + REP result CAT intern (r [i][j]) PER + PER; + result +END PROC intern; + +TEXT PROC intern (ROW 4 REAL CONST r): + intern (r [1]) + intern (r [2]) + intern (r [3]) + intern (r [4]) +END PROC intern; + +TEXT PROC intern (ROW 3 REAL CONST r): + intern (r [1]) + intern (r [2]) + intern (r [3]) +END PROC intern; + +TEXT PROC intern (ROW 2 REAL CONST r): + intern (r [1]) + intern (r [2]) +END PROC intern; + +PROC convert (TEXT VAR record, INT VAR n): + n := record ISUB 1; + record := subtext (record, 3) +END PROC convert; + +PROC convert (TEXT VAR record, ROW 16 ROW 3 INT VAR n): + INT VAR i, j; + FOR i FROM 1 UPTO 16 + REP FOR j FROM 1 UPTO 3 + REP convert (record, n [i][j]) PER + PER +END PROC convert; + +PROC convert (TEXT VAR record, ROW 16 BOOL VAR n): + INT VAR i, result; + convert (record, result); + FOR i FROM 1 UPTO 16 + REP n [i] := bit (i-1, result) PER +END PROC convert; + +PROC convert (TEXT VAR record, REAL VAR r): + r := record RSUB 1; + record := subtext (record, 9) +END PROC convert; + +PROC convert (TEXT VAR record, ROW 3 ROW 2 REAL VAR r): + INT VAR i, j; + FOR i FROM 1 UPTO 3 + REP FOR j FROM 1 UPTO 2 + REP convert (record, r [i][j]) PER + PER; +END PROC convert; + +PROC convert (TEXT VAR record, ROW 2 ROW 2 REAL VAR r): + INT VAR i, j; + FOR i FROM 1 UPTO 2 + REP FOR j FROM 1 UPTO 2 + REP convert (record, r [i][j]) PER + PER; +END PROC convert; + +PROC convert (TEXT VAR record, ROW 4 REAL VAR r): + convert (record, r [1]); convert (record, r [2]); + convert (record, r [3]); convert (record, r [4]) +END PROC convert; + +PROC convert (TEXT VAR record, ROW 3 REAL VAR r): + convert (record, r [1]); convert (record, r [2]); convert (record, r [3]) +END PROC convert; + +PROC convert (TEXT VAR record, ROW 2 REAL VAR r): + convert (record, r [1]); convert (record, r [2]) +END PROC convert; + +END PACKET picfile diff --git a/app/mpg/1987/src/PICPLOT.ELA b/app/mpg/1987/src/PICPLOT.ELA new file mode 100644 index 0000000..d8bf5a5 --- /dev/null +++ b/app/mpg/1987/src/PICPLOT.ELA @@ -0,0 +1,241 @@ +PACKET pic plot DEFINES drawing area, {Autor: H. Indenbirken} + begin plot, {Stand: 13.02.85 } + end plot, + clear, + pen, + move, + draw, + get cursor, + + get screen, put screen: + +LET hor faktor = 22.21739, {***** x pixel / x cm *****} + vert faktor = 18.61314, {***** y pixel / y cm *****} + + h max = 639, + v max = 287, + + delete = 0, {Farbcodes} + std = 1, + black = 5, + white = 6, + + nothing = 0, {Linientypen} + durchgehend = 1, + gepunktet = 2, + kurz gestrichelt = 3, + lang gestrichelt = 4, + strichpunkt = 5; + +INT CONST move code :: -255, {Controlcodes} + draw code :: -254, + plot code :: -253, + norm code :: -252, + del code :: -251, + xor code :: -250, + line code :: -249; + +LET POS = STRUCT (INT x, y); + +INT VAR pen thick :: 0, pen code :: draw code, ack; +POS VAR pos :: POS : (0, 0); + +PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : + x cm := 23.0; y cm := 13.7; + x pixel := h max; y pixel := v max +END PROC drawing area; + +PROC begin plot : + control (plot code, 0, 0, ack); + out (""15"") +ENDPROC begin plot ; + +PROC end plot : + out (""14""); + control (norm code, 0, 0, ack) +ENDPROC end plot ; + +PROC clear : + pos := POS : (0, 0); + pen (0, 1, 0, 1); + page +END PROC clear; + +PROC pen (INT CONST background, foreground, thickness, linetype): + pen code := foreground colour; + pen thick := thickness; + control (line code, 0, 0, ack) . + +foreground colour: + IF linetype = nothing + THEN move code + ELIF foreground = delete OR foreground = black + THEN del code + ELIF foreground < 0 + THEN xor code + ELSE draw code FI . + +END PROC pen; + +PROC move (INT CONST x, y) : + control (move code, x, y); + pos := POS : (x, y) +END PROC move; + +PROC draw (INT CONST x, y) : + control (pen code, x, y); + IF thick line + THEN IF horizontal line + THEN thick y + ELSE thick x FI; + control (move code, x, y) + FI; + pos := POS : (x, y) . + +thick line: + pen thick > 0 AND pen code <> move code . + +horizontal line: + abs (pos.x-x) > abs (pos.y-y) . + +thick y: + INT VAR dy; + FOR dy FROM 1 UPTO pen thick + REP control (move code, pos.x, pos.y+dy); + control (pen code, x, y+dy); + control (move code, pos.x, pos.y-dy); + control (pen code, x, y-dy) + PER . + +thick x: + INT VAR dx; + FOR dx FROM 1 UPTO pen thick + REP control (move code, pos.x+dx, pos.y); + control (pen code, x+dx, y); + control (move code, pos.x-dx, pos.y); + control (pen code, x-dx, y) + PER . + +END PROC draw; + +PROC draw (TEXT CONST record) : + draw (record, 0.0, 0.0, 0.0) +END PROC draw; + +PROC draw (TEXT CONST record, REAL CONST angle, height, width): + IF pen code = draw code + THEN cursor (x position, y position); + out (record) + FI . + +x position: + (pos.x-1) DIV 8 + 1 . + +y position: + (pos.y-1) DIV 12 + 1 . + +END PROC draw; + +PROC control (INT CONST code, x, y): + control (code, x check, y check, ack) . + +x check: + IF x < 0 + THEN 0 + ELIF x > h max + THEN h max + ELSE x FI . + +y check: + IF y =< 0 + THEN v max + ELIF y >= v max + THEN 0 + ELSE v max-y FI . + +END PROC control; + +PROC get cursor (TEXT VAR t, INT VAR x, y) : + get cursor (t, x, y, -1, -1, -1, -1) +END PROC get cursor; + +PROC get cursor (TEXT VAR t, INT VAR x, y, INT CONST x0, y0, x1, y1): + check; + init cursor; + REP set cursor; + get step; + set cursor; + move cursor + PER . + +init cursor: + INT VAR delta := 1; + x := pos.x; + y := pos.y . + +set cursor: + IF x0 > 0 AND y0 > 0 + THEN control (move code, x0, v max-y0, ack); + control (xor code, x, v max-y, ack) + FI; + IF x1 > 0 AND y1 > 0 + THEN control (move code, x1, v max-y1, ack); + control (xor code, x, v max-y, ack) + FI; + control (move code, x-4, v max-y, ack); + control (xor code, x+5, v max-y, ack); + control (move code, x, v max-y-4, ack); + control (xor code, x, v max-y-4, ack) . + +get step: + t := incharety (1); + IF t <> "" + THEN IF delta < 10 + THEN delta INCR delta + ELSE delta INCR 1 FI + ELSE delta := 1; + inchar (t) + FI . + +move cursor: + SELECT code (t) OF + CASE 2 : x INCR delta + CASE 3 : y INCR delta + CASE 8 : x DECR delta + CASE 10: y DECR delta + OTHERWISE leave get cursor ENDSELECT; + check . + +leave get cursor: + control (move code, pos.x, pos.y); + LEAVE get cursor . + +check : + IF x < 0 + THEN x := 0; out (""7"") + ELIF x > h max + THEN x := h max; out (""7"") FI; + + IF y < 0 + THEN y := 0; out (""7"") + ELIF y > v max + THEN y := v max; out (""7"") FI . + +END PROC get cursor; + +(* Bildwiederholspeicheraufbau des Pic 400: *) +(* 45 Blcke (0...44) enthalten den Bildwiederholspeicher. *) + +PROC get screen (DATASPACE VAR ds, INT CONST page): + INT VAR i, n, begin :: 45*page; + FOR i FROM 0 UPTO 44 + REP block in (ds, begin+i, -1, i, n) PER +END PROC get screen; + +PROC put screen (DATASPACE CONST ds, INT CONST page): + INT VAR i, n, begin :: 45*page; + FOR i FROM 0 UPTO 44 + REP block out (ds, begin+i, -1, i, n) PER +END PROC put screen; + +END PACKET pic plot; diff --git a/app/mpg/1987/src/PICTURE.ELA b/app/mpg/1987/src/PICTURE.ELA new file mode 100644 index 0000000..d5e00fa --- /dev/null +++ b/app/mpg/1987/src/PICTURE.ELA @@ -0,0 +1,521 @@ +PACKET picture DEFINES (*Autor: H.Indenbirken *) + PICTURE, (*Stand: 23.02.1985 *) + :=, CAT, nilpicture, + draw, draw r, draw cm, draw cm r, + move, move r, move cm, move cm r, + bar, circle, + length, dim, pen, where, + extrema, rotate, stretch, translate, + text, picture, plot: + +LET draw key = 1, + move key = 2, + text key = 3, + move r key = 4, + draw r key = 5, + move cm key = 6, + draw cm key = 7, + move cm r key = 8, + draw cm r key = 9, + bar key = 10, + circle key = 11, + max 2 dim = 31983, + max 3 dim = 31975, + max text = 31974, + max bar = 31982, + max circle = 31974, + max length = 32000; + + +TYPE PICTURE = STRUCT (INT dim, pen, TEXT points); + + +INT VAR i, read pos, key; +REAL VAR x, y, z; +TEXT VAR t, r2 :: 16*""0"", r3 :: 24*""0"", i1 :: ""0""0"", i2 :: ""0""0""0""0""; + +OP := (PICTURE VAR l, PICTURE CONST r) : + CONCR (l) := CONCR (r) +END OP :=; + +OP CAT (PICTURE VAR l, PICTURE CONST r) : + IF l.dim <> r.dim + THEN errorstop ("OP CAT : left dimension <> right dimension") + ELIF length (l.points) > max length - length (r.points) + THEN errorstop ("OP CAT : Picture overflow") FI; + + l.points CAT r.points +END OP CAT; + +PICTURE PROC nilpicture : + PICTURE : (0, 1, "") +END PROC nilpicture; + +PROC draw (PICTURE VAR p, TEXT CONST text) : + draw (p, text, 0.0, 0.0, 0.0) +END PROC draw; + +PROC draw (PICTURE VAR p, TEXT CONST text, REAL CONST angle, height, bright): + write (p, text, angle, height, bright, text key) +END PROC draw; + +PROC draw (PICTURE VAR p, REAL CONST x, y, z) : + check dim (p, 3); + write (p, x, y, z, draw key) +END PROC draw; + +PROC draw (PICTURE VAR p, REAL CONST x, y) : + check dim (p, 2); + write (p, x, y, draw key) +END PROC draw; + +PROC draw r (PICTURE VAR p, REAL CONST x, y, z) : + check dim (p, 3); + write (p, x, y, z, draw r key) +END PROC draw r; + +PROC draw r (PICTURE VAR p, REAL CONST x, y) : + check dim (p, 2); + write (p, x, y, draw r key) +END PROC draw r; + +PROC draw cm (PICTURE VAR p, REAL CONST x, y) : + write (p, x, y, draw cm key) +END PROC draw cm; + +PROC draw cm r (PICTURE VAR p, REAL CONST x, y) : + write (p, x, y, draw cm r key) +END PROC draw cm r; + +PROC move (PICTURE VAR p, REAL CONST x, y, z) : + check dim (p, 3); + write (p, x, y, z, move key) +END PROC move; + +PROC move (PICTURE VAR p, REAL CONST x, y) : + check dim (p, 2); + write (p, x, y, move key) +END PROC move; + +PROC move r (PICTURE VAR p, REAL CONST x, y, z) : + check dim (p, 3); + write (p, x, y, z, move r key) +END PROC move r; + +PROC move r (PICTURE VAR p, REAL CONST x, y) : + check dim (p, 2); + write (p, x, y, move r key) +END PROC move r; + +PROC move cm (PICTURE VAR p, REAL CONST x, y) : + write (p, x, y, move cm key) +END PROC move cm; + +PROC move cm r (PICTURE VAR p, REAL CONST x, y) : + write (p, x, y, move cm r key) +END PROC move cm r; + +PROC bar (PICTURE VAR p, REAL CONST width, height, INT CONST pattern): + write (p, width, height, pattern, bar key) +END PROC bar; + +PROC circle (PICTURE VAR p, REAL CONST radius, from, to, INT CONST pattern): + write (p, radius, from, to, pattern, circle key) +END PROC circle; + + +PROC write (PICTURE VAR p, REAL CONST x, y, z, INT CONST key) : + IF length (p.points) < max 3 dim + THEN p.points CAT code (key); + replace (r3, 1, x); + replace (r3, 2, y); + replace (r3, 3, z); + p.points CAT r3 + ELSE errorstop ("Picture overflow") FI +END PROC write; + +PROC write (PICTURE VAR p, REAL CONST x, y, INT CONST key) : + IF length (p.points) < max 2 dim + THEN p.points CAT code (key); + replace (r2, 1, x); + replace (r2, 2, y); + p.points CAT r2 + ELSE errorstop ("Picture overflow") FI +END PROC write; + +PROC write (PICTURE VAR p, REAL CONST x, y, INT CONST n, key) : + IF length (p.points) < max bar + THEN p.points CAT code (key); + replace (r2, 1, x); + replace (r2, 2, y); + p.points CAT r2; + replace (i1, 1, n); + p.points CAT i1 + ELSE errorstop ("Picture overflow") FI +END PROC write; + +PROC write (PICTURE VAR p, REAL CONST x, y, z, INT CONST n, key) : + IF length (p.points) < max circle + THEN p.points CAT code (key); + replace (r3, 1, x); + replace (r3, 2, y); + replace (r3, 3, z); + p.points CAT r3; + replace (i1, 1, n); + p.points CAT i1 + ELSE errorstop ("Picture overflow") FI +END PROC write; + +PROC write (PICTURE VAR p, TEXT CONST t, REAL CONST angle, height, bright, + INT CONST key) : + IF max text - length (p.points) >= length (t) + THEN p.points CAT code (key); + replace (i1, 1, length (t)); + p.points CAT i1; + p.points CAT t; + replace (r3, 1, angle); + replace (r3, 2, height); + replace (r3, 3, bright); + p.points CAT r3 + FI; +END PROC write; + +PROC check dim (PICTURE VAR p, INT CONST dim): + IF p.dim = 0 + THEN p.dim := dim + ELIF p.dim <> dim + THEN errorstop ("Picture is " + text (p.dim) + " dimensional") FI +END PROC check dim; + +INT PROC length (PICTURE CONST p): + length (p.points) +END PROC length; + +INT PROC dim (PICTURE CONST pic) : + pic.dim +END PROC dim; + +PROC pen (PICTURE VAR p, INT CONST pen) : + IF pen < 0 OR pen > 16 + THEN errorstop ("pen out of range [0-16]") FI; + p.pen := pen +END PROC pen; + +INT PROC pen (PICTURE CONST p) : + p.pen +END PROC pen; + +PROC where (PICTURE CONST p, REAL VAR x, y) : + IF p.dim = 0 + THEN x := 0.0; y := 0.0 + ELIF p.dim = 3 + THEN errorstop ("Picture is 3 dimensional") + ELSE x := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1; + y := subtext (p.points, length (p.points)-7, length (p.points)) RSUB 1 + FI +END PROC where; + +PROC where (PICTURE CONST p, REAL VAR x, y, z) : + IF p.dim = 0 + THEN x := 0.0; y := 0.0; z := 0.0 + ELIF p.dim = 2 + THEN errorstop ("Picture is 2 dimensional") + ELSE x := subtext (p.points, length (p.points)-23, length (p.points)-16) RSUB 1; + y := subtext (p.points, length (p.points)-15, length (p.points)-8) RSUB 1; + z := subtext (p.points, length (p.points)-7, length (p.points)) RSUB 1; + FI +END PROC where; + + +PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max, z min, z max) : + x min := max real; x max :=-max real; + y min := max real; y max :=-max real; + z min := max real; z max :=-max real; + read pos := 0; + INT CONST pic length := length (p.points); + WHILE read pos < pic length + REP check position PER . + +check position : + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : calc extrema + CASE move key : calc extrema + CASE move r key : calc rel extrema + CASE draw r key : calc rel extrema + CASE move cm key : read pos INCR 16 + CASE draw cm key : read pos INCR 16 + CASE move cm r key : read pos INCR 16 + CASE draw cm r key : read pos INCR 16 + CASE text key : read pos INCR next int + 24 + CASE bar key : read pos INCR 18 + CASE circle key : read pos INCR 26 + OTHERWISE errorstop ("wrong key code") END SELECT . + +calc extrema : + x := next real; y := next real; z := next real; + x min := min (x min, x); x max := max (x max, x); + y min := min (y min, y); y max := max (y max, y); + z min := min (z min, z); z max := max (z max, z) . + +calc rel extrema : + x INCR next real; y INCR next real; z INCR next real; + x min := min (x min, x); x max := max (x max, x); + y min := min (y min, y); y max := max (y max, y); + z min := min (z min, z); z max := max (z max, z) . + +next real : + read pos INCR 8; + subtext (p.points, read pos-7, read pos) RSUB 1 . + +next int : + read pos INCR 2; + subtext (p.points, read pos-1, read pos) ISUB 1 . + +END PROC extrema; + +PROC extrema (PICTURE CONST p, REAL VAR x min, x max, y min, y max): + x min := max real; x max :=-max real; + y min := max real; y max :=-max real; + read pos := 0; + INT CONST pic length := length (p.points); + WHILE read pos < pic length + REP check position PER . + +check position : + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : calc extrema + CASE move key : calc extrema + CASE move r key : calc rel extrema + CASE draw r key : calc rel extrema + CASE move cm key : read pos INCR 16 + CASE draw cm key : read pos INCR 16 + CASE move cm r key : read pos INCR 16 + CASE draw cm r key : read pos INCR 16 + CASE text key : read pos INCR next int + 24 + CASE bar key : read pos INCR 18 + CASE circle key : read pos INCR 26 + OTHERWISE errorstop ("wrong key code") END SELECT . + +calc extrema : + x := next real; y := next real; + x min := min (x min, x); x max := max (x max, x); + y min := min (y min, y); y max := max (y max, y) . + +calc rel extrema : + x INCR next real; y INCR next real; + x min := min (x min, x); x max := max (x max, x); + y min := min (y min, y); y max := max (y max, y) . + +next real : + read pos INCR 8; + subtext (p.points, read pos-7, read pos) RSUB 1 . + +next int : + read pos INCR 2; + subtext (p.points, read pos-1, read pos) ISUB 1 . + +END PROC extrema; + +PROC rotate (PICTURE VAR p, REAL CONST angle) : + REAL CONST s :: sind( angle ), c := cosd( angle ); + transform (p, ROW 4 ROW 3 REAL : + (ROW 3 REAL : ( 1.0, 0.0, 0.0 ), + ROW 3 REAL : ( 0.0, c , s ), + ROW 3 REAL : ( 0.0, -s , c ), + ROW 3 REAL : ( 0.0, 0.0, 0.0 ))) +END PROC rotate; + +PROC rotate (PICTURE VAR p, REAL CONST phi, theta, lambda ) : + REAL CONST s :: sind ( theta ), c :: cosd ( theta ), + s p :: sind ( phi ), s l :: sind ( lambda ), + ga :: cosd ( phi ), c l :: cosd ( lambda ), + be :: s p * s l, al :: s p * c l, c1 :: 1.0 - c; + transform (p, ROW 4 ROW 3 REAL : + (ROW 3 REAL : ( al*al*c1 + c , be*al*c1+ga*s, ga*al*c1-be*s ), + ROW 3 REAL : ( al*be*c1-ga*s, be*be*c1 + c , ga*be*c1+al*s ), + ROW 3 REAL : ( al*ga*c1+be*s, be*ga*c1-al*s, ga*ga*c1 + c ), + ROW 3 REAL : ( 0.0 , 0.0 , 0.0 ))) +END PROC rotate; + +PROC stretch (PICTURE VAR pic, REAL CONST sx, sy) : + stretch (pic, sx, sy, 1.0) +END PROC stretch; + +PROC stretch (PICTURE VAR p, REAL CONST sx, sy, sz) : + transform (p, ROW 4 ROW 3 REAL : + (ROW 3 REAL : ( sx, 0.0, 0.0), + ROW 3 REAL : (0.0, sy, 0.0), + ROW 3 REAL : (0.0, 0.0, sz), + ROW 3 REAL : (0.0, 0.0, 0.0))) +END PROC stretch; + +PROC translate (PICTURE VAR p, REAL CONST dx, dy) : + translate (p, dx, dy, 0.0) +END PROC translate; + +PROC translate (PICTURE VAR p, REAL CONST dx, dy, dz) : + transform (p, ROW 4 ROW 3 REAL : + (ROW 3 REAL : (1.0, 0.0, 0.0), + ROW 3 REAL : (0.0, 1.0, 0.0), + ROW 3 REAL : (0.0, 0.0, 1.0), + ROW 3 REAL : ( dx, dy, dz))) +END PROC translate; + +PROC transform (PICTURE VAR p, ROW 4 ROW 3 REAL CONST a) : + INT CONST pic length := length (p.points); + INT VAR begin pos; + read pos := 0; + x := 0.0; y := 0.0; z := 0.0; + IF p.dim = 2 + THEN transform 2 dim pic + ELSE transform 3 dim pic FI . + +transform 2 dim pic: + WHILE read pos < pic length + REP transform 2 dim position PER . + +transform 2 dim position: + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : transform 2 dim point + CASE move key : transform 2 dim point + CASE move r key : transform 2 dim point + CASE draw r key : transform 2 dim point + CASE move cm key : read pos INCR 16 + CASE draw cm key : read pos INCR 16 + CASE move cm r key : read pos INCR 16 + CASE draw cm r key : read pos INCR 16 + CASE text key : read pos INCR next int + 24 + CASE bar key : read pos INCR 18 + CASE circle key : read pos INCR 26 + OTHERWISE errorstop ("wrong key code") END SELECT . + +transform 2 dim point: + begin pos := read pos+1; + x := next real; y := next real; + transform (a, x, y, z); + replace (r2, 1, x); + replace (r2, 2, y); + replace (p.points, begin pos, r2) . + +transform 3 dim pic: + WHILE read pos < pic length + REP transform 3 dim position PER . + +transform 3 dim position : + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : transform 3 dim point + CASE move key : transform 3 dim point + CASE move r key : transform 3 dim point + CASE draw r key : transform 3 dim point + CASE move cm key : read pos INCR 16 + CASE draw cm key : read pos INCR 16 + CASE move cm r key : read pos INCR 16 + CASE draw cm r key : read pos INCR 16 + CASE text key : read pos INCR next int + 24 + CASE bar key : read pos INCR 18 + CASE circle key : read pos INCR 26 + OTHERWISE errorstop ("wrong key code") END SELECT . + +transform 3 dim point: + begin pos := read pos+1; + x := next real; y := next real; z := next real; + transform (a, x, y, z); + replace (r3, 1, x); + replace (r3, 2, y); + replace (r3, 3, z); + replace (p.points, begin pos, r3) . + +next real : + read pos INCR 8; + subtext (p.points, read pos-7, read pos) RSUB 1 . + +next int : + read pos INCR 2; + subtext (p.points, read pos-1, read pos) ISUB 1 . + +END PROC transform; + +PROC transform (ROW 4 ROW 3 REAL CONST a, REAL VAR x, y, z) : + REAL CONST ox :: x, oy :: y, oz :: z; + x := ox*a(1)(1) + oy*a(2)(1) + oz*a(3)(1) + a(4)(1); + y := ox*a(1)(2) + oy*a(2)(2) + oz*a(3)(2) + a(4)(2); + z := ox*a(1)(3) + oy*a(2)(3) + oz*a(3)(3) + a(4)(3) +END PROC transform; + +TEXT PROC text (PICTURE CONST pic): + replace (i2, 1, pic.dim); + replace (i2, 2, pic.pen); + i2 + pic.points +END PROC text; + +PICTURE PROC picture (TEXT CONST text): + PICTURE : (text ISUB 1, text ISUB 2, subtext (text, 5)) +END PROC picture; + +PROC plot (PICTURE CONST p) : + INT CONST pic length := length (p.points); + read pos := 0; + IF p.dim = 2 + THEN plot two dim pic + ELSE plot three dim pic FI . + +plot two dim pic: + WHILE read pos < pic length + REP plot two dim position PER . + +plot two dim position : + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : draw (next real, next real) + CASE move key : move (next real, next real) + CASE move r key : move r (next real, next real) + CASE draw r key : draw r (next real, next real) + CASE move cm key : move cm (next real, next real) + CASE draw cm key : draw cm (next real, next real) + CASE move cm r key : move cm r (next real, next real) + CASE draw cm r key : draw cm r (next real, next real) + CASE text key : draw (next text, next real, next real, next real) + CASE bar key : bar (next real, next real, next int) + CASE circle key : circle (next real, next real, next real, next int) + OTHERWISE errorstop ("wrong key code") END SELECT . + +plot three dim pic: + WHILE read pos < pic length + REP plot three dim position PER . + +plot three dim position : + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : draw (next real, next real, next real) + CASE move key : move (next real, next real, next real) + CASE move r key : move r (next real, next real, next real) + CASE draw r key : draw r (next real, next real, next real) + CASE move cm key : move cm (next real, next real) + CASE draw cm key : draw cm (next real, next real) + CASE move cm r key : move cm r (next real, next real) + CASE draw cm r key : draw cm r (next real, next real) + CASE text key : draw (next text, next real, next real, next real) + CASE bar key : bar (next real, next real, next int) + CASE circle key : circle (next real, next real, next real, next int) + OTHERWISE errorstop ("wrong key code") END SELECT . + +next real : + read pos INCR 8; + subtext (p.points, read pos-7, read pos) RSUB 1 . + +next int : + read pos INCR 2; + subtext (p.points, read pos-1, read pos) ISUB 1 . + +next text : + INT CONST text length :: next int; + read pos INCR text length; + subtext (p.points, read pos-text length+1, read pos) . + +END PROC plot; + +END PACKET picture diff --git a/app/mpg/1987/src/PLOTSPOL.ELA b/app/mpg/1987/src/PLOTSPOL.ELA new file mode 100644 index 0000000..f15b13c --- /dev/null +++ b/app/mpg/1987/src/PLOTSPOL.ELA @@ -0,0 +1,129 @@ +PACKET plotten spool DEFINES plot: #Autor: H.Indenbirken # + #Stand: 10.02.1985 # +LET draw key = 1, + move key = 2, + text key = 3, + move r key = 4, + draw r key = 5, + move cm key = 6, + draw cm key = 7, + move cm r key = 8, + draw cm r key = 9, + bar key = 10, + circle key = 11, + max length = 32000; + + +TYPE PICTURE = STRUCT (INT dim, pen, TEXT points); + + +INT VAR i, read pos, key; +REAL VAR x, y, z; +TEXT VAR t; + + +PROC plot (PICTURE CONST p) : + INT CONST pic length := length (p.points); + read pos := 0; + IF p.dim = 2 + THEN plot two dim pic + ELSE plot three dim pic FI . + +plot two dim pic: + WHILE read pos < pic length + REP plot two dim position PER . + +plot two dim position : + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : draw (next real, next real) + CASE move key : move (next real, next real) + CASE move r key : move r (next real, next real) + CASE draw r key : draw r (next real, next real) + CASE move cm key : move cm (next real, next real) + CASE draw cm key : draw cm (next real, next real) + CASE move cm r key : move cm r (next real, next real) + CASE draw cm r key : draw cm r (next real, next real) + CASE text key : draw (next text, next real, next real, next real) + CASE bar key : bar (next real, next real, next int) + CASE circle key : circle (next real, next real, next real, next int) + OTHERWISE errorstop ("wrong key code") END SELECT . + +plot three dim pic: + WHILE read pos < pic length + REP plot three dim position PER . + +plot three dim position : + read pos INCR 1; + SELECT code (p.points SUB read pos) OF + CASE draw key : draw (next real, next real, next real) + CASE move key : move (next real, next real, next real) + CASE move r key : move r (next real, next real, next real) + CASE draw r key : draw r (next real, next real, next real) + CASE move cm key : move cm (next real, next real) + CASE draw cm key : draw cm (next real, next real) + CASE move cm r key : move cm r (next real, next real) + CASE draw cm r key : draw cm r (next real, next real) + CASE text key : draw (next text, next real, next real, next real) + CASE bar key : bar (next real, next real, next int) + CASE circle key : circle (next real, next real, next real, next int) + OTHERWISE errorstop ("wrong key code") END SELECT . + +next real : + read pos INCR 8; + subtext (p.points, read pos-7, read pos) RSUB 1 . + +next int : + read pos INCR 2; + subtext (p.points, read pos-1, read pos) ISUB 1 . + +next text : + INT CONST text length :: next int; + read pos INCR text length; + subtext (p.points, read pos-text length+1, read pos) . + +END PROC plot; + +LET max pics = 1024, + pic dataspace = 1102; + + +TYPE PICFILE = BOUND STRUCT (INT size, pos, background, + ROW 16 ROW 3 INT pens, + ROW 16 BOOL hidden, + ROW 3 ROW 2 REAL sizes, + ROW 2 ROW 2 REAL limits, + ROW 4 REAL angles, + ROW 2 REAL obliques, + ROW 3 REAL perspectives + ROW max pics PICTURE pic); + +PICFILE VAR p; + +PROC plot (DATASPACE VAR ds): + IF type (ds) = pic dataspace + THEN CONCR (p) :: old (ds); + plot (p) + ELSE errorstop ("Dataspace is no PICFILE") FI; +END PROC plot; + +PROC plot (PICFILE VAR p) : + set values (p.sizes, p.limits, p.angles, p.obliques, + p.perspectives); + begin plot; + clear; + FOR i FROM 1 UPTO p.size + REP IF pen (p.pic [i]) <> 0 + THEN plot pic FI + PER; + end plot . + +plot pic: + pen (p.background, p.pens (pen (p.pic (i)))(1), + p.pens (pen (p.pic (i)))(2), p.pens (pen (p.pic (i)))(3)); + hidden lines (p.hidden [pen (p.pic [i])]); + plot (p.pic (i)) . + +END PROC plot; + +END PACKET plotten spool diff --git a/app/mpg/1987/src/PUBINSPK.ELA b/app/mpg/1987/src/PUBINSPK.ELA new file mode 100644 index 0000000..0650c20 --- /dev/null +++ b/app/mpg/1987/src/PUBINSPK.ELA @@ -0,0 +1,654 @@ +PACKETmpgtestelanprogramsDEFINESelantest:LETs17=0,s30="",s31="*** ELAN TEST VOR +ZEITIG ABGEBROCHEN ***",s33=1000,s34=1,s35="line exceeding screen",s37="comment +exceeding line",s38="text denoter too long (",s39=" characters)",s40="text denot +er exceeding source line",s43=" ""("" open",s44=" ""["" open",s46=";",s47=".", +s48="(",s49=")",s50="[",s51="]",s53=" ""("" open at end of unit",s54=" ""["" ope +n at end of unit",s57=77,s58="=",s59="EUMEL - Datei : ",s60=" Zeilen , ", +s61="Elan - Quelltext : ",s62=" Units , ",s63=" Scanner - Operationen durchg +efuehrt.",s66="dito ",s67="dito",s68="EOLN ",s69=" ",s74=10,s75="00",s76=100, +s77="0",s78=" Byte";LETs1=7,s2=8,s3=9,s4=2,s5=4,s6=6,s7=77,s8=255,s9="ENDIFIENDS +ELECTENDREPEATPERENDPROCEDURENDPACKETENDOP",s10="WARNING: ",s11="ERROR : ";INT + VARs12;FILE VARs13;TEXT VARs14;PROCelantest:elantest(lastparam)ENDPROCelantest; +PROCelantest(TEXT CONSTs15):INT VARs16:=s17,s18:=s17,s19:=s17,s20:=s17,s21:=s17, +s22:=s17,s23,s24:=s17,s25:=s17,s26:=s17;TEXT VARs27,s28;FILE VARs29:= +sequentialfile(input,s15);s13:=notefile;s12:=s17;s14:=s30;scan(s30);nextsymbol( +s27);WHILE NOTeof(s29)REPs32;s36;s27:=incharetyUNTILs27<>s30PER;IFs27<>s30THEN +putline(s13,s31)FI;s14:=s30;s56;modify(s29);noteedit(s29);line.s32:getline(s29, +s27);continuescan(s27);s16INCR LENGTHs27;s18INCRs16DIVs33;s16:=s16MODs33;s12INCR +s34;cout(s12);IF LENGTHs27>s7THENs64(s10+s35)FI.s36:REPEATnextsymbol(s28,s23); +s24INCRs34;s41UNTILs23>=s1PER;IFs23=s2THENs64(s10+s37)FI;IFs23=s3THENs21INCR + LENGTHs28;IFs21>s8THENs64(s11+s38+text(s21)+s39)ELSEs64(s10+s40)FI ELSEs21:=s17 +FI;s20INCRs19DIVs33;s19:=s19MODs33.s41:IFs23=s1THENs42ELIFs23=s6THENs45ELIFs23= +s5THENs21INCR LENGTHs28;IFs21>s8THENs64(s11+s38+text(s21)+s39)FI ELIFs23=s4CAND +pos(s9,s28)<>s17THENs52FI;s19INCR LENGTHs28.s42:IFs25<>s17THENs64(s10+text(s25)+ +s43)FI;IFs26<>s17THENs64(s10+text(s26)+s44)FI.s45:IFs28=s46OR(s28=s47ANDs55)THEN +s52ELIFs28=s48THENs25INCRs34ELIFs28=s49THENs25DECRs34ELIFs28=s50THENs26INCRs34 +ELIFs28=s51THENs26DECRs34FI.s52:s22INCRs34;IFs25<>s17THENs64(s11+text(s25)+s53); +s25:=s17FI;IFs26<>s17THENs64(s11+text(s26)+s54);s26:=s17FI.s55:FALSE.s56:line( +s13);putline(s13,s57*s58);putline(s13,s59+text(s12)+s60+s70(s18,s16));putline( +s13,s61+text(s22)+s62+s70(s20,s19));putline(s13,text(s24)+s63);putline(s13,s57* +s58).ENDPROCelantest;PROCs64(TEXT CONSTs65):IFs65=s14THENputline(s13,s66+text( +s12));IFonlineTHENput(s12);putline(s67)FI;LEAVEs64FI;s14:=s65;putline(s13,s68+ +text(s12)+s69+s65);IFonlineTHENput(s12);putline(s65)FI ENDPROCs64;TEXT PROCs70( +INT CONSTs71,s72):TEXT VARs73:=text(s71);IFs72s84THENs97ELSEreserve(archive);SELECTs95OF CASEs81:call(s79,s90 +,task(s87))CASEs82:call(s80,s90,task(s87))ENDSELECT;archivFI.s97:errorstop(s98) +ENDPROCarchiv;PROCarchiv:s88:=TRUE;TEXT CONSTs93:=archivname;IFs89=s90THEN +display(s99+s93+s100);ELSEerrorstop(s89)FI;display(s101).ENDPROCarchiv;BOOL PROC +archivangemeldet:s88ENDPROCarchivangemeldet;TEXT PROCarchivname:TEXT VARs93:=s90 +;THESAURUS VARs102;IF NOTs88THENerrorstop(s103);s90ELSEs88:=FALSE;s89:=s90; +disablestop;archive(s90);IFiserrorTHENs89:=errormessage;LEAVEarchivnameWITHs90FI +;s102:=ALLarchive;s104;clearerror;enablestop;archive(s93);s88:=TRUE;s93FI.s104: +IFsubtext(errormessage,s105,s106)=s107THENs93:=subtext(errormessage,s108,LENGTH +errormessage-s105)ELSEs89:=errormessageFI ENDPROCarchivname;TEXT PROCarchiverror +:s89ENDPROCarchiverror;PROCfrom(TEXT CONSTs93):fetch(s93,archive)ENDPROCfrom; +PROCto(TEXT CONSTs93):BOOL CONSTs109:=commanddialogue;commanddialogue(FALSE); +save(s93,archive);commanddialogue(s109)ENDPROCto;PROCto:to(lastparam)ENDPROCto; +PROCfrom(THESAURUS CONSTs110):fetch(s110,archive)ENDPROCfrom;PROCto(THESAURUS + CONSTs110):BOOL CONSTs109:=commanddialogue;commanddialogue(FALSE);save(s110, +archive);commanddialogue(s109)ENDPROCto;PROCpla:pla(TRUE)ENDPROCpla;PROCpla(BOOL + CONSTs111):LETs112=18;FILE VARs113;INT VARs114;TEXT CONSTs115:=s116*s117,s118:= +s116*s119;TEXT VARs120;WHILEyes(s121)REPs122UNTIL NOTs111PER;release.s122:archiv +;s113:=sequentialfile(output,s123);list(s113,archive);s124;s130;s133;s134.s124: +modify(s113);toline(s113,s105);FORs114FROMs105UPTOs125REPinsertrecord(s113)PER; +toline(s113,s105);writerecord(s113,s115);down(s113);writerecord(s113,s126+ +headline(s113)+s127+timeofday+s127+date);down(s113);writerecord(s113,s115);down( +s113);writerecord(s113,s128);down(s113);writerecord(s113,s129).s130:toline(s113, +s131);WHILE NOTeof(s113)REPreadrecord(s113,s120);IF(s120SUBs112)=s132THEN +deleterecord(s113)ELSEdown(s113)FI PER.s133:output(s113);putline(s113,s118).s134 +:modify(s113);edit(s113);line(s135);IFyes(s136)THENprint(s123)FI;forget(s123, +quiet)ENDPROCplaENDPACKETmpgarchivesystem;PACKETmpgsomeDEFINESsome,SOME,one, +inchar,center,invers,editsome,editone,reorganize:LETs139=" ",s140=1,s144=2,s145= +0,s148=""7"",s162=04,s163="-",s164="> "15"weitere Eintraege "14"",s165=52,s200= +"",s203="Fenster zu klein",s206=""5"",s209=3,s210=5,s212=6,s213=""8"",s219="-> " +,s220=" > ",s222="----> ",s225="""",s226=""5""13""10"",s228=79,s235=40,s245=4, +s261=7,s262=8,s263=9,s267="Bitte warten !",s283="-> """,s284=""11"",s285=""2"", +s306="!",s310=" INFO : Auswahl mehrerer Dateien ",s311=" INFO : Auswahl einer Da +tei ",s312="q19",s320="zum Editieren",s324="Datei ",s325=30,s326=" wird reorgani +siert :",s327=" ",s328=" ist keine Datei.",s330=""15" Mit den angekreuzte +n Namen wird die gewaehlte Operation ausgefuehrt "14"",s331=" "15" +Positionierungen: "14" ",s332=" Oben : zum vorausgehenden N +amen",s333=" Unten : zum folgenden Namen ",s334=" + HOP Oben : zum ersten Namen der (vorigen) Seite",s335=" +HOP Unten : zum letzten Namen der (vorigen) Seite",s336=" HOP RE +TURN : aktuelle Zeile wird erste Zeile",s337=" ESC 1 : zum + ersten Namen der Liste",s338=" ESC 9 : zum letzten Namen d +er Liste",s339=" ESC s : Liste nach Nummern ordnen",s340=" + "15" Auswahl treffen: "14" ",s341=" ( Folgende Befehle sind + nur bei einer )",s342=" ( Auswahl von mehreren Namen M"218"glich. +)",s343=" RETURN bzw. x: diesen Namen ankreuzen ",s344=" + RUBOUT bzw. o: Kreuz vor dem Namen loeschen",s345=" HOP x + : alle Namen ankreuzen ",s346=" HOP o : alle Kreuz +e loeschen ",s347=" ESC x : alle folgenden Namen ankreuz +en",s348=" ESC o : alle folgenden Kreuze loeschen",s349=" + RUBIN : einen neuen Namen eintragen",s350=" ( Nur + dieser Befehl kann benutzt werden , wenn )",s351=" ( die Auswahl e +ines ! Namens m"218"glich ist. )",s352=" RETURN bzw. x: diesen + Namen auswaehlen",s353=" "15" Auswahl verlassen: "14"",s354=" + ESC q : Auswaehlen beenden ",s355=" ESC a + : Auswahl abbrechen (ohne Kreuze !)",s356=""15" Zum Verlassen des +Infos bitte 'ESC q' tippen! "14"";LETs137=80;TEXT PROCcenter( +TEXT CONSTs138):center(s138,s139,s137-s140)ENDPROCcenter;TEXT PROCcenter(TEXT + CONSTs138,s141,INT CONSTs142):TEXT VARs143:=((s142-length(s138))DIVs144)*s141; +s143CAT(s138+s143);IF(LENGTHs143)-s142=s145THENs143ELSEs143+s141FI ENDPROCcenter +;TEXT PROCinvers(TEXT CONSTs138):s157+s138+s139+s158ENDPROCinvers;PROCinchar( +TEXT VARs146,TEXT CONSTs147):REPgetchar(s146);IFpos(s147,s146)=s145THENout(s148) +FI UNTILpos(s147,s146)<>s145PER ENDPROCinchar;LETs149=3,s150=24,s151=200;LETs152 +=""222"",s153=""1""27""3""10""13"x"12"o?"11"",s154=""3""10""12"o"13"x",s155="q19 +a"13"x"12"os";LETs156=""13""10"",s157=""15"",s158=""14"";LETs159="Auswahl einer +Datei ( Bei Unklarheiten bitte )",s160="Auswahl mehrerer Dateien ( Bei +Unklarheiten bitte )";TEXT CONSTs161:=s162*s163+s164+s165*s163;LETs166=1, +s167=2,s168=3,s169=4,s170=5,s171=6,s172=7,s173=8,s174=9,s175=10;LETs176=1003;INT + VARs177,s178,s179,s180,s181,s182,s183;TEXT VARs184,s185,s186,s187;BOOL VARs188, +s189;ROWs151TEXT VARs190;THESAURUS VARs191;FILE VARs192;DATASPACE VARs193; +INITFLAG VARs194;THESAURUS PROCs195(THESAURUS CONSTs146,BOOL CONSTs196,TEXT + CONSTs197,INT CONSTs198,s199):IF NOTinitialized(s194)THENs329FI;s178:=s198;s180 +:=s199;s186:=s197;s184:=s200;s179:=s145;s185:=s200;s231;IFgroesstereditor>s145 +THEN INT VARs201,s202;geteditcursor(s201,s202);IFs150-s179-s149s150THENerrorstop(s203)FI;THESAURUS VARs204:=emptythesaurus;s191 +:=s146;INT VARs205;s177:=s145;FORs205FROMs140UPTOhighestentry(s146)REP IFname( +s146,s205)<>s200THENs177INCRs140;s190[s177]:=name(s146,s205)FI PER;IFs177=s145 +THEN LEAVEs195WITHs204FI;s236;s189:=FALSE;s237(s196);IFs189THEN LEAVEs195WITH +s204FI;cursor(s140,s180);out(s206);s207;s204.s207:TEXT VARs208;WHILEs184<>s200 +REPs208:=subtext(s184,s140,s209);s184:=subtext(s184,s210);insert(s204,s190[int( +s208)])PER ENDPROCs195;PROCs211:cursor(s140,s179+s182+s178);out(s214(s183,TRUE)+ +s212*s213)ENDPROCs211;TEXT PROCs214(INT CONSTs215,BOOL CONSTs216):INT VARs217:= +s307(s215);IFs217=s145THENs221ELSEs218FI.s218:IFs216THEN(s209-length(text(s217)) +)*s163+text(s217)+s219ELSEtext(s217,s209)+s220FI.s221:IFs216THENs222ELSEs212* +s139FI ENDPROCs214;PROCs223(INT CONSTs224):cursor(s140,s179+s178);INT VARs205; +s227;FORs205FROMs224UPTOs230REPout(s214(s205,FALSE));putline(s225+s190[s205]+ +s225+s206)PER;s229;IFs230s145THENs232ELIFs186<>s200ANDlength(s186) +s200THENs232FI;IFs179>s180- +s178-s149THENs179:=s180-s178-s149FI;s181:=s180-s178-s149-s179+s140.s232:s187:= +s186;REPs179INCRs140;s233;s185CATsubtext(s187,s140,pos(s187,s152)-s140);s185CAT +s156;s187:=subtext(s187,pos(s187,s152)+s140);UNTILpos(s187,s152)=s145PER;IFs187 +<>s200THENs185CATs187;s185CATs156;s179INCRs140FI.s233:IF(pos(s187,s152)>s137OR +pos(s187,s152)=s145)ANDlength(s187)>s137THENs234FI.s234:INT VARs205;FORs205FROM +s137DOWNTOs235REP UNTIL(s187SUBs205)=s139PER;s187:=subtext(s187,s140,s205)+s152+ +subtext(s187,s205+s140)+s152ENDPROCs231;PROCs236:cursor(s140,s178);out(s185); +s183:=s140;s182:=s140;s223(s140);s211ENDPROCs236;PROCs237(BOOL CONSTs196):s188:= +FALSE;REPs238;s240UNTILs188PER.s238:TEXT VARs239;inchar(s239,s153).s240:SELECT +pos(s153,s239)OF CASEs166:s242(s196)CASEs167:s260(s196)CASEs168:s293CASEs169: +s298CASEs170:s276(s196,FALSE);s241CASEs171:s276(s196,TRUE);s241CASEs172:s279CASE +s173:s279CASEs174:s308(s196)CASEs175:s280;IFs190[s183]<>s200THENs241FI ENDSELECT +.s241:IF NOTs196THEN LEAVEs237FI ENDPROCs237;PROCs242(BOOL CONSTs196):s243;s240. +s243:TEXT VARs244;getchar(s244).s240:SELECTpos(s154,s244)OF CASEs145:out(s148) +CASEs140:s249CASEs144:s254CASEs209,s245:s248CASEs210:s246CASEs212:IFs196THENs247 +ELSEout(s148)FI ENDSELECT.s246:s182:=s140;s223(s183);s211.s247:INT VARs205;FOR +s205FROMs140UPTOs177REP IFs307(s205)=s145THENs184CATs304(s205)FI PER;s290;s211. +s248:s184:=s200;s290;s211.s249:IFs250THENout(s148)ELIFs251THENs252ELSEs253FI. +s250:s183=s140.s251:s182=s140.s252:s183DECR(s181+s140);s183:=max(s183,s140);s223 +(s183);s211.s253:s303;s183DECR(s182-s140);s182:=s140;s211.s254:IFs255THENout( +s148)ELIFs256THENs257ELSEs259FI.s255:s183=s177.s256:s182>s181.s257:INT VARs258:= +s183;s183INCR(s181+s140);s183:=min(s183,s177);s182:=s183-s258;s223(s258+s140); +s211.s259:s303;s258:=s183;s183INCR(s181+s140-s182);s183:=min(s177,s183);s182INCR +(s183-s258);s211ENDPROCs242;PROCs260(BOOL CONSTs196):TEXT VARs244;getchar(s244); +SELECTpos(s155,s244)OF CASEs145:out(s148)CASEs140:s188:=TRUE CASEs144:s273CASE +s209:s274CASEs245:s189:=TRUE;s188:=TRUE CASEs210,s212:IFs196THENs272ELSEout(s148 +)FI CASEs261,s262:IFs196THENs268ELSEout(s148)FI CASEs263:s264ENDSELECT.s264: +THESAURUS VARs265:=emptythesaurus;TEXT VARs208,s266:=s200;cursor(s140,s180);out( +center(invers(s267),s163,s137-s140));s205:=s145;WHILEs184<>s200REPs205INCRs140; +s208:=subtext(s184,s140,s209);s184:=subtext(s184,s210);insert(s265,s190[int(s208 +)]);s266CATs304(s205)PER;s177:=s145;s184:=s266;s191:=s265+s191;FORs205FROMs140 +UPTOhighestentry(s191)REP IFname(s191,s205)<>s200THENs177INCRs140;s190[s177]:= +name(s191,s205)FI PER;cursor(s140,s180);out(s206);s236.s268:INT VARs269;FORs269 +FROMs183UPTOs177REP INT VARs270:=s307(s269);IFs270<>s145THENs271FI PER;s290;s211 +.s271:s184:=subtext(s184,s140,s245*s270-s245)+subtext(s184,s245*s270+s140).s272: +INT VARs205;FORs205FROMs183UPTOs177REP IFs307(s205)=s145THENs184CATs304(s205)FI + PER;s290;s211.s273:IFs183=s140THENout(s148)ELIFs183=s182THENs303;s183:=s140; +s182:=s140;s211ELSEs183:=s140;s182:=s140;s223(s140);s211FI.s274:IFs183=s177THEN +out(s148)ELIFs275THENs303;s182INCR(s177-s183);s183:=s177;s211ELSEs183:=s177;s182 +:=s181+s140;s223(s177-s181);s211FI.s275:(s182+s177-s183)s145THENout(s148); +s278;LEAVEs276FI;s184CATs304(s183);IFs196THENs278FI.s278:IFs277THENs211ELSE IF +s183s140.s295 +:IFs182=s140THENs296ELSEs297FI.s296:s183DECRs140;s223(s183);s211.s297:s303;s183 +DECRs140;s182DECRs140;s211ENDPROCs293;PROCs298:IFs299THENs300ELSEout(s148)FI. +s299:s183s181THENs301ELSEs302FI.s301:s183INCRs140;s223(s183- +s181);s211.s302:s303;s183INCRs140;s182INCRs140;s211ENDPROCs298;PROCs303:out(s214 +(s183,FALSE))ENDPROCs303;TEXT PROCs304(INT CONSTs305):text(s305,s209)+s306 +ENDPROCs304;INT PROCs307(INT CONSTs215):IFpos(s184,s304(s215))=s145THENs145ELSE( +pos(s184,s304(s215))DIVs245)+s140FI ENDPROCs307;PROCs308(BOOL CONSTs309):modify( +s192);IFs309THENheadline(s192,s310);ELSEheadline(s192,s311);FI;toline(s192,s140) +;openeditor(groesstereditor+s140,s192,FALSE,s140,s178,s228,s180-s178+s140);edit( +groesstereditor,s312,PROC(TEXT CONST)stdkommandointerpreter);s236ENDPROCs308; +THESAURUS PROCsome(THESAURUS CONSTs146,TEXT CONSTs313,INT CONSTs198,s199):s195( +s146,TRUE,s313,s198,s199)ENDPROCsome;THESAURUS PROCsome(THESAURUS CONSTs146): +some(s146,center(invers(s160)),s140,s150)ENDPROCsome;THESAURUS PROCsome:s195(all +,TRUE,center(invers(s160)),s140,s150)ENDPROCsome;THESAURUS PROCsome(TEXT CONST +s314):some(ALLs314)ENDPROCsome;THESAURUS PROCsome(TASK CONSTs315):some(ALLs315) +ENDPROCsome;THESAURUS OP SOME(THESAURUS CONSTs316):some(s316)ENDOP SOME; +THESAURUS OP SOME(TASK CONSTs317):some(ALLs317)ENDOP SOME;THESAURUS OP SOME(TEXT + CONSTs314):some(ALLs314)ENDOP SOME;TEXT PROCone(THESAURUS CONSTs146,TEXT CONST +s318,INT CONSTs198,s199):name(s195(s146,FALSE,s318,s198,s199),s140)ENDPROCone; +TEXT PROCone(THESAURUS CONSTs146):one(s146,center(invers(s159)),s140,s150) +ENDPROCone;TEXT PROCone(TASK CONSTs315):one(ALLs315)ENDPROCone;TEXT PROCone:one( +all)ENDPROCone;TEXT PROCone(TEXT CONSTs314):one(ALLs314)ENDPROCone;PROCeditone: +TEXT CONSTs319:=one(all,center(invers(s159))+s152+center(invers(s320)),s140,s150 +);IFs319<>s200CAND(NOTexists(s319)CORtype(old(s319))=s176)THENedit(s319)FI + ENDPROCeditone;PROCeditsome:THESAURUS CONSTs321:=some(all,center(invers(s160))+ +s152+center(invers(s320)),s140,s150);INT VARs205;FORs205FROMs140UPTOhighestentry +(s321)REP TEXT VARs319:=name(s321,s205);IFs319<>s200CAND(NOTexists(s319)CORtype( +old(s319))=s176)THENedit(s319)FI PER ENDPROCeditsome;PROCreorganize(THESAURUS + CONSTs146):page;do(PROC(TEXT CONST)s322,s146)ENDPROCreorganize;PROCs322(TEXT + CONSTs323):IFtype(old(s323))=s176THENput(s324+center(invers(s225+s323+s225), +s139,s325)+s326);reorganize(s323)ELSEput(s327+center(invers(s225+s323+s225),s139 +,s325)+s328)FI;lineENDPROCs322;PROCs329:s193:=nilspace;s192:=sequentialfile( +output,s193);putline(s192,s330);line(s192);putline(s192,s331);line(s192);putline +(s192,s332);putline(s192,s333);putline(s192,s334);putline(s192,s335);putline( +s192,s336);putline(s192,s337);putline(s192,s338);putline(s192,s339);line(s192); +putline(s192,s340);line(s192);putline(s192,s341);putline(s192,s342);line(s192); +putline(s192,s343);putline(s192,s344);putline(s192,s345);putline(s192,s346); +putline(s192,s347);putline(s192,s348);putline(s192,s349);line(s192);putline(s192 +,s350);putline(s192,s351);line(s192);putline(s192,s352);line(s192);putline(s192, +s353);line(s192);putline(s192,s354);putline(s192,s355);line(s192);putline(s192, +s356);ENDPROCs329;ENDPACKETmpgsome;PACKETmpgdmDEFINESdm:LETs364="PUBLIC",s374="k +",s375="q",s377="",s379=27,s380=" ",s381="V O R M O N I T O R ",s382=4,s383="t", +s384="Task einstellen, mit der kommuniziert werden soll",s385="p",s386="Es soll + mit 'PUBLIC' kommuniziert werden",s387="v",s388="Es soll mit der Vatertask + kommuniziert werden",s389="a",s390="Es soll mit dem Archiv kommuniziert werd +en",s391="Programm beenden",s393="Bitte Eingabe :",s394="tvapq",s395=0,s397="tva +p",s399="ARCHIVE",s402=1,s403=20,s404=""7""15"FEHLER: ",s405=""14"",s407=14,s408 +="Neue Task:",s409="Mit der eigenen Task kann nicht kommuniziert werden.",s416=2 +,s417="Task ist nicht im Wartezustand",s420=15,s423="ARCHIVE ist nicht im Wartez +ustand",s428=5,s429=" Erst Diskette einlegen !",s430=100,s432=24,s433="D A T E I + M O N I T O R ",s434=3,s435="Auflisten aller Dateien in dieser Task",s436="l", +s437="Loeschen von Dateien in dieser Task",s438="Archiv: ",s439="Task : ", +s440=40,s441="'",s442=" ...",s443="""",s447="des Archivs",s448="zum Archiv",s449 +="vom Archiv",s450="in ",s451="zu ",s452="von ",s453="u",s454="Uebersicht uebe +r alle Dateien ",s455="s",s456="Senden von Dateien ",s457="h",s458="H +olen von Dateien ",s459="c",s460="'Checken' von Dateien ", +s461="Vernichten von Dateien ",s462="d",s463="Drucken einer Liste der Dat +eien des Archivs",s464="f",s465="Formatieren einer Diskette",s466="i",s467="Init +ialisieren/vollstaendiges Loeschen des Archivs",s468="n",s469="Neue Diskette anm +elden",s470="Zurueck zum Vormonitor",s472=" Bitte warten...",s473=6,s474=7, +s475=8,s476=9,s477=10,s478=11,s479=12,s482=""15"",s483=" "14"",s484=" ... ",s486 +="Formatieren einer Diskette.",s487="===========================",s488=""15"Acht +ung: Alle Disketten-Informationen werden gel"218"scht!"14"",s489="Dies sind die +moeglichen Formate:",s490="o",s491="... Ohne Format-Angabe",s492="0",s493="... S +tandard-Format",s494="1",s495="... 40 Spur - 360 KB",s496="2",s497="... 80 Spur + - 720 KB",s498="3",s499="... IBM Std - 1200 KB",s500="... Es wird nicht format +iert.",s502="Ihre Wahl:",s503="o01234q",s504="zuk"219"nftiger Name des Archives +:",s508="Liste der eigenen Task",s510="Loeschen von Dateien ",s511=" Info mit < +?>",s512="Bitte alle zu loeschenden Dateien ankreuzen",s513="(Ankreuzen mit )",s516="Bitte warten...",s521="nicht reserviert",s522="Haben Sie die Diske +tte eingelegt und das Laufwerk geschlossen",s524=""15"Sie muessen unbedingt erst + das Archiv reservieren, "14"",s525=""15"sonst kann ich nicht darauf zugreifen! +"14"",s527="Dateiliste",s533=""15"'Checken' von Dateien (auf dem Archiv) "14"", +s534="Bitte alle zu 'checkenden' Dateien ankreuzen",s537=""15"Schreiben von Date +ien "14" Info mit ",s538="Bitte alle zu schreibenden Dateien ankreuzen.",s542 +=" <--- """,s544="Bitte Warten",s545="-",s546=80,s548="Zuerst Dateien auf der Di +skette loeschen?",s553=""15"Holen von Dateien "14" Info mit ",s554="Bitte al +le zu holenden Dateien ankreuzen.",s555=" --> """,s558=""15"Vernichten (Loeschen +) von Dateien "14" Info mit ",s559="Bitte alle zu loeschenden Dateien ankreuz +en.",s562=""15"Vollstaendiges Loeschen des Archivs "14"",s563="Eingestellter Arc +hivname: ",s564="Moechten Sie einen anderen Namen fuer das Archiv",s566="Bitte d +en Namen fuer das Archiv (maximal 30 Buchstaben):",s567="Der neue Archivname ist + zu lang!",s569="Bitte Fehler beseitigen und Vorgang wiederholen!",s576="keine d +iskette",s577=""15"Ich mache die Reservierung rueckgaengig! "14"",s578="inkonsis +tent",s579=""15"Diskette ist nicht formatiert / initialisiert "14"",s580="Lesen +unmoeglich",s581="Schreiben unmoeglich",s582=""15"Die Diskette ist falsch eingel +egt "14"",s583=""15"oder das Laufwerk ist nicht geschlossen "14"",s584=""15"oder + die Diskette ist nicht formatiert !"14"",s585="Archiv heisst",s586="?????",s587 +=""15"Diskette nicht lesbar ! (Name: '?????') "14"",s588=""15"Moeglicherweise is +t die Diskette defekt ! "14"",s589=""15"Diskette wurde mit anderem Namen angemel +det!"14"",s590="Bitte neu reservieren!",s592="Bitte den Fehler beseitigen und da +s Archiv neu reservieren !",s594="Zum Weitermachen bitte irgendeine Taste tippen +!";LETs357=""15"",s358=""14"",s359=""222"",s360=24,s361="alnfqushcvdi",s362="al + qush v";TASK CONSTs363:=task(s364);TASK VARs365;BOOL VARs366:=archivangemeldet, +s367,s368:=FALSE;TEXT VARs369,s370,s371;PROCdm:TEXT VARs372,s373:= +lernsequenzauftaste(s374);REPs376UNTILs372=s375PER;lernsequenzauftastelegen(s374 +,s373).s376:s365:=s363;s392;IFs372<>s375ANDs370<>s377THENs424FI.s378:s370:=name( +s365);page;write(s379*s380);write(s357);write(s381);write(s358);line(s382);s480( +s383,s384);s480(s385,s386);s480(s387,s388);s480(s389,s390);s480(s375,s391).s392: +IFisincharety(s377)THENs378FI;line;write(s393);inchar(s372,s394);out(s372);line; +IFpos(s389,s372)=s395CANDs365=archiveTHENs574FI;s396.s396:IFpos(s397,s372)<>s395 +THENs398FI.s398:s370:=s377;IFs372=s389THENs370:=s399ELIFs372=s385THENs370:=s364 +ELIFs372=s387THENs370:=name(father)ELSEs406FI;TEXT VARs400;BOOL VARs401:=s370= +s377CORs370=s364CORs410(s370,s400);IF NOTs401THENcursor(s402,s403);putline(s404+ +s400+s405);pause;s370:=s377;FI;IFs370=s377THENs365:=s363ELIFs370=s399THENs365:= +archiveELSEs365:=task(s370)FI.s406:REPcursor(s402,s407);put(s408);editget(s370); +line;IFs370=name(myself)THENputline(s409)FI;UNTILs370<>name(myself)PER; +lernsequenzauftastelegen(s374,s370).ENDPROCdm;BOOL PROCs410(TEXT CONSTs411,TEXT + VARs412):disablestop;TASK VARs413:=task(s411);IFiserrorTHENs412:=errormessage; +clearerror;enablestop;FALSE ELSEs414FI.s414:IFs411<>s399THENs415ELSEs422FI.s415: +IFstatus(s413)<>s416THENs412:=s417;enablestop;FALSE ELSEs418FI.s418:INT CONST +s419:=s420;DATASPACE VARs421:=nilspace;call(s419,s377,s421,s413);forget(s421);IF +iserrorTHENs412:=errormessage;clearerror;enablestop;FALSE ELSEs412:=s377; +enablestop;TRUE FI.s422:IFstatus(archive)<>s416THENs412:=s423;LEAVEs422WITH + FALSE FI;archive(s377);IFiserrorTHENs412:=errormessage;clearerror;enablestop; +FALSE ELSEenablestop;s366:=TRUE;s368:=FALSE;s412:=s377;TRUE FI ENDPROCs410;PROC +s424:s367:=(s365=archive);TEXT VARs425;IFs367THENs425:=s361ELSEs425:=s362FI;TEXT + VARs426;INT VARs427;s368:=FALSE;IFs367THENs514FI;REP IFisincharety(s377)THEN +s431FI;line;write(s393);inchar(s426,s425);s427:=pos(s361,s426);IFs427>s428AND + NOTs368ANDs367THENline;putline(s429);pause(s430)ELIFs426<>s380THENs471FI UNTIL +s426=s375PER;IFarchivangemeldetTHENs574FI.s431:page;write(s432*s380);write(s357) +;write(s433);write(s358);line(s434);s480(s389,s435);s480(s436,s437);line(s416); +write(s420*s380);IFs367THENwrite(s438)ELSEwrite(s439)FI;IFs367THEN IFs368THEN IF +length(s369)>s440THENwrite(s441+subtext(s369,s402,s440)+s442)ELSEwrite(invers( +s443+s369+s443))FI FI ELSEwrite(invers(s443+s370+s443))FI;line(s416);TEXT VAR +s444,s445,s446;IFs367THENs444:=s447;s445:=s448;s446:=s449ELSEs444:=s450+s370; +s445:=s451+s370;s446:=s452+s370FI;s480(s453,s454+s444);s480(s455,s456+s445);s480 +(s457,s458+s446);IFs367THENs480(s459,s460+s444)FI;s480(s387,s461+s444);IFs367 +THENs480(s462,s463);s480(s464,s465);s480(s466,s467);s480(s468,s469);FI;line(s402 +);s480(s375,s470).s471:out(s380+s426+s472);SELECTs427OF CASEs402:s505CASEs416: +s509CASEs434:s572CASEs382:s485CASEs428:CASEs473:s526CASEs474:s535CASEs475:s551 +CASEs476:s531CASEs477:s556CASEs478:s570CASEs479:s560ENDSELECT ENDPROCs424;PROC +s480(TEXT CONSTs413,s481):putline(s475*s380+s482+s413+s483+s484+s481)ENDPROCs480 +;PROCs485:page;putline(s486);putline(s487);putline(s488);line;putline(s489);s480 +(s490,s491);s480(s492,s493);s480(s494,s495);s480(s496,s497);s480(s498,s499);s480 +(s375,s500);TEXT VARs501;put(s502);inchar(s501,s503);IFs501=s375THEN LEAVEs485FI +;out(s501);line;put(s504);editget(s369);line;archive(s369);s368:=TRUE; +disablestop;IFs501=s490THENformat(archive)ELSEformat(int(s501),archive)FI;IF +iserrorTHENs595(errormessage);clearerror;s368:=FALSE ELSEs369:=archivnameFI; +enablestopENDPROCs485;PROCs505:DATASPACE VARs506:=nilspace;FILE VARs507:= +sequentialfile(output,s506);list(s507);headline(s507,s508);modify(s507);toline( +s507,s402);show(s507);forget(s506)ENDPROCs505;PROCs509:s371:=center(invers(s510) ++s511)+s359+center(s512)+s359+center(invers(s513));forget(some(all,s371,s402, +s360))ENDPROCs509;PROCs514:TEXT VARs515;page;cursor(s402,s402);write(s516);line( +s416);s517(s515);IFs515<>s377THENpage;line(s477);write(s482+s515+s483);s593;s368 +:=FALSE;s366:=FALSE;LEAVEs514FI;s519(s369,s515);IFs515<>s377THENs575(s515)FI. +ENDPROCs514;PROCs517(TEXT VARs518):s518:=s377;IFs366THEN LEAVEs517FI;disablestop +;archive(s377);IFiserrorTHENs518:=errormessage;s366:=FALSE;clearerror;enablestop +;ELSEs366:=TRUE;s518:=s377;enablestopFI ENDPROCs517;PROCs519(TEXT VARs520,s518): +page;line(s434);s518:=s377;IF NOTs366THENs520:=s377;s368:=FALSE;s518:=s521;LEAVE +s519FI;IFyes(s522)THENline;write(s516);s520:=archivname;IFarchiverror<>s377THEN +s518:=archiverror;s368:=FALSE ELSEs368:=TRUE FI ELSEs368:=FALSE;s520:=s377FI + ENDPROCs519;PROCs523:page;line(s474);write(s524);line(s416);write(s525);line( +s416);s593ENDPROCs523;PROCs526:forget(s527,quiet);s528;s529;s530;forget(s527, +quiet).s528:IFs367ANDs368AND NOTs366THENs523;LEAVEs526FI.s529:FILE VARs507:= +sequentialfile(output,s527);disablestop;list(s507,s365);IFiserrorTHENpage;IFs367 +THENs575(errormessage)FI;clearerror;enablestop;LEAVEs526;ELSEenablestopFI.s530: +show(s507)ENDPROCs526;PROCs531:s528;s532.s528:IFs367ANDs368AND NOTs366THENs523; +LEAVEs531FI.s532:s371:=center(s533)+s359+center(s534);disablestop;check(some(ALL +s365,s371,s402,s360),s365);s593;IFiserrorTHEN IFs367THENs575(errormessage)FI; +clearerror;enablestop;LEAVEs531ELSEenablestop;FI ENDPROCs531;PROCs535:s528;s536. +s528:IFs367ANDs368AND NOTs366THENs523;LEAVEs535FI.s536:s371:=center(s537)+s359+ +center(s538)+s359+center(invers(s513));THESAURUS VARs539:=some(ALLmyself,s371, +s402,s360);s543;INT VARs540;TEXT VARs541;page;FORs540FROMs402UPTOhighestentry( +s539)REPs541:=name(s539,s540);disablestop;IFs541<>s377THENputline(s370+s542+s541 ++s443);save(s541,s365)FI;IFiserrorTHEN IFs367THENs575(errormessage)FI;clearerror +;enablestop;LEAVEs535FI;enablestopPER.s543:IFs367CAND(s549(s539))THENout(center( +invers(s544),s545,s546));THESAURUS CONSTs547:=s539/ALLs365;IFs549(s547)THENpage; +putline(s548);erase(s547,s365)FI FI ENDPROCs535;BOOL PROCs549(THESAURUS CONST +s413):INT VARs550;FORs550FROMs402UPTOhighestentry(s413)REP IFname(s413,s550)<> +s377THEN LEAVEs549WITH TRUE FI PER;FALSE ENDPROCs549;PROCs551:s528;s552.s528:IF +s367ANDs368AND NOTs366THENs523;LEAVEs551FI.s552:s371:=center(s553)+s359+center( +s554);THESAURUS VARs539:=some(ALLs365,s371,s402,s360);INT VARs540;TEXT VARs541; +page;FORs540FROMs402UPTOhighestentry(s539)REPs541:=name(s539,s540);disablestop; +IFs541<>s377THENputline(s370+s555+s541+s443);fetch(s541,s365)FI;IFiserrorTHEN IF +s367THENs575(errormessage)FI;clearerror;enablestop;LEAVEs551ELSEenablestopFI PER + ENDPROCs551;PROCs556:s528;s557.s528:IFs367ANDs368AND NOTs366THENs523;LEAVEs556 +FI.s557:s371:=center(s558)+s359+center(s559);disablestop;erase(some(ALLs365,s371 +,s402,s360),s365);IFiserrorTHEN IFs367THENs575(errormessage)FI;clearerror; +enablestop;LEAVEs556ELSEenablestop;FI ENDPROCs556;PROCs560:TEXT VARs561;page; +line(s416);write(center(s562));line(s416);IFs366ANDs368THENwrite(s563+invers( +s443+s369+s443));line(s416);IFyes(s564)THENline(s416);s565ELSEs561:=s369FI ELSE +s565FI;s568.s565:write(s566);line;getline(s561);s561:=compress(s561);IFlength( +s561)>s440THENline(s416);write(s567);s593;LEAVEs560FI.s568:disablestop;s369:= +s561;archive(s561);IFiserrorTHENs595(errormessage);line;write(s569);clearerror; +enablestop;s593;s368:=FALSE;s366:=FALSE;LEAVEs560ELSEclear(archive);IFiserror +THENpage;line(s416);s575(errormessage);clearerror;enablestop;s593;s368:=FALSE; +LEAVEs560ELSEs369:=archivname;s368:=archiverror=s377FI FI ENDPROCs560;PROCs570: +s528;s571;s593.s528:IFs367ANDs368AND NOTs366THENs523;LEAVEs570FI.s571:pla(FALSE) +.ENDPROCs570;PROCs572:s528;s573.s528:IF NOTs366THENs514;LEAVEs572FI.s573:TEXT + VARs515;page;cursor(s402,s402);write(s516);line(s416);s519(s369,s515);IFs515<> +s377THENs575(s515)FI.ENDPROCs572;PROCs574:s366:=FALSE;s368:=FALSE; +commanddialogue(FALSE);release(archive);commanddialogue(TRUE)ENDPROCs574;PROC +s575(TEXT CONSTs515):line(s416);IFs515=s521THENs523;ELIFs515=s576THENwrite(s577) +;s591ELIFpos(s515,s578)>s395THENwrite(s579);s591;ELIFpos(s515,s580)>s395CORpos( +s515,s581)>s395THENwrite(s582);line(s416);write(s583);line(s416);write(s584); +s591;ELIFpos(s515,s585)>s395ANDpos(s515,s586)>s395THENwrite(s587);line(s416); +write(s588);s591;ELIFpos(s515,s585)>s395THENwrite(invers(s515));line(s416);write +(s589);line(s416);write(s590);s593ELSEwrite(invers(s515));s591FI ENDPROCs575; +PROCs591:line(s416);write(s592);s593;s368:=FALSE ENDPROCs591;PROCs593:line(s416) +;write(s594);pauseENDPROCs593;PROCs595(TEXT CONSTs515):page;line(s477);write( +invers(s515));s593ENDPROCs595ENDPACKETmpgdm;PACKETmpgtoolsDEFINESput,th,gen:LET +s596="E",s597=""27""2""27"p"27"qedit ("27"g)"13"",s599="TRUE",s600="FALSE",s606= +"***",s607="-->",s608=""13""10"",s610=77,s611="=",s612=" wird insertiert"13""10" +",s619="gen.",s622=0,s623="GENERIERUNG VON ",s624=16,s626=1,s627=2,s628="Bitte e +ntfernen Sie Ihre Diskette aus dem Laufwerk!",s630="global manager"; +lernsequenzauftastelegen(s596,s597);PROCput(BOOL CONSTs598):IFs598THENput(s599) +ELSEput(s600)FI ENDPROCput;PROCth(THESAURUS CONSTs601):THESAURUS VARs602:=SOME +s601;s602:=emptythesaurusENDPROCth;BOOL VARs603:=FALSE;PROCs604(TEXT CONSTs605): +IFexists(s605)THENdisplay(s606)ELSE IF NOTs603THENarchiv;s603:=TRUE FI;display( +s607);from(s605)FI;display(s605+s608)ENDPROCs604;PROCs609(TEXT CONSTs605):line; +out(s610*s611+s608);out(s605+s612);insert(s605);forget(s605,quiet)ENDPROCs609; +LETs613=20;ROWs613TEXT VARs614;INT VARs615,s616;PROCgen:TEXT CONSTs617:=name( +myself),s618:=s619+s617;TEXT VARs620;BOOL VARs621:=TRUE;s603:=FALSE;s615:=s622; +s616:=s622;page;putline(s623+s617);putline((s624+length(s617))*s611);s604(s618); +FILE VARs625:=sequentialfile(input,s618);WHILE NOTeof(s625)ANDs616s640THENs637:=name( +s635.s633,s639);s635.s631:=s639ELSEs637:=s641FI ENDPROCselecttarget;TEXT PROC +actualtargetname(TARGET CONSTs635):IFs635.s631=s634THENs641ELSEname(s635.s632, +s635.s631)FI ENDPROCactualtargetname;TEXT PROCactualtargetset(TARGET CONSTs635): +IFs635.s631=s634THENs641ELSEname(s635.s633,s635.s631)FI ENDPROCactualtargetset; +THESAURUS PROCtargetnames(TARGET CONSTs635):s635.s632ENDPROCtargetnamesENDPACKET +targethandling;PACKETmpgprintcmdDEFINESprint,selectprinter,installprinters, +listprinters,printer,printers:LETs650="",s654=1,s656=24,s660=0;TARGET VARs642; +LETs643="PRINTER",s644="PRINTER AUSWAHL";LETs645=""222"";TARGET PROCprinters: +s642ENDPROCprinters;PROCinstallprinters(FILE VARs646):initializetarget(s642); +TEXT VARs647,s648;TEXT VARs649:=s650,s651:=s650;WHILE NOTeof(s646)REP TEXT VAR +s652;getline(s646,s652);IFs652<>s650THEN INT CONSTs653:=pos(s652,s645);s647:= +subtext(s652,s654,s653-s654);s648:=subtext(s652,s653+s654);completetarget(s642, +s647,s648);IFint(s647)=station(myself)THENs649:=s647;s651:=s648FI FI PER; +selecttarget(s642,s649,s651);IFs651<>s650THENfonttable(s651)FI ENDPROC +installprinters;PROCselectprinter:TEXT VARs655;selecttarget(s642,one(targetnames +(s642),s644,s654,s656),s655);IFs655<>s650THENfonttable(s655)FI ENDPROC +selectprinter;PROClistprinters:th(targetnames(s642))ENDPROClistprinters;PROC +print:print(lastparam)ENDPROCprint;PROCprint(TEXT CONSTs657):save(s657,printer) +ENDPROCprint;PROCprint(THESAURUS CONSTs658):save(s658,printer)ENDPROCprint;TASK + PROCprinter:INT VARs659:=int(actualtargetname(s642));IFs659=s660THENniltaskELSE +s659/s643FI ENDPROCprinterENDPACKETmpgprintcmd;PACKETeditmonitorDEFINES +editmonitor,close,F,table:LETs670="quitmonitor:1.0edit:2.1run:3.1insert:4.1", +s671="forget:5.1rename:6.2copy:7.2fetch:8.1",s672="save:9.1close:10.1fileinfo:11 +.0reorganize:12.1",s684=0,s689="",s698="Q",s702=""1""8""1""12"quitmonitor"13"", +s703=1,s704="Editmonitor overflow: Bereits ",s705="Monitore geoeffnet",s708=" +"10"",s711=22,s715=""3"",s716=" ",s717=""13""10" ",s718="fk",s719=" +"27"k",s720=""13""5"",s721="f",s722=7,s725=50,s728=4,s730=""1"",s731=2,s732=" : +",s733="""",s734=""5""10""13"",s735=""5"",s737=5,s738=" ",s739=11,s740="=",s741= +16,s742=" ",s745=3,s746=6,s747=8,s748=9,s749=10,s750=12,s754=""7"",s765="Maxima +l 10 Parallel-Editoren",s774=79,s775=25,s776=24,s778="Undefinierter Index [1;15] +",s780=""5"? ",s781=""13""10"",s782=""2"",s783="Datei neu einrichten",s795=120; +LETs661=18,s662=15,s663=1003,s664=24,s665=3,s666=4711,s667="Gib Edit-Monitor ", +s668=" Kommando :";TEXT CONSTs669:=s670+s671+s672;LET SGHD=ROWs662STRUCT( +THESAURUSs674,TEXTs675,FILEs676);LETs677=0,s678=1,s679=2;INT VARs680,s681,s682, +s683:=s684,s685;TEXT VARs686,s687,s688:=s689,s690:=s689;BOOL VARs691,s692:=FALSE +,s693:=FALSE;INITFLAG VARs694;SGHD VARs695;PROCeditmonitor:TEXT VARs696,s697:= +lernsequenzauftaste(s698);INT VARs699,s700:=heapsize;disablestop;s701;s756;REP +s706;s712;s743;s727UNTILs693PER;lernsequenzauftastelegen(s698,s697);s726.s701: +lernsequenzauftastelegen(s698,s702);s693:=FALSE;s683INCRs703;IFs683>s662THENs683 +DECRs703;errorstop(s704+text(s662)+s705)ELSE IF NOTinitialized(s694)THEN FORs699 +FROMs703UPTOs662REPs695[s699].s674:=emptythesaurus;s695[s699].s675:=s689PER FI; +FORs699FROMs703UPTOs662REPs695[s699].s675:=name(s695[s683].s674,s699)PER FI.s706 +:s707;s729.s707:out(s708);INT VARs709,s710;getcursor(s709,s710);FORs709FROMs703 +UPTOs710-s711REPout(s708)PER;s685:=max(s661,min(s710+s703,s711)).s712:BOOL VAR +s713:=FALSE,s714:=FALSE;IFiserrorTHENs690:=s688;out(s715);puterror;clearerror; +s714:=TRUE ELSEs690:=s689FI;out(s716);out(s798);out(s717);IF NOTs714THENs723FI; +IFs713THENs680:=s666;LEAVEs712FI;editget(s690,s689,s718,s696);IFs696=s719THENout +(s720);s690:=s688;out(s716);editget(s690,s689,s721,s696)FI;line;s688:=s690;s680 +:=s796(s690);paramposition(LENGTHs690+s722);IF(s680>s684ANDs680<=s662)ANDs682> +s684THENs691:=TRUE ELSEs691:=FALSE;analyzecommand(s669,s690,s665,s680,s681,s686, +s687)FI.s723:BOOL VARs724;s696:=getcharety;IFs696<>s689THENpush(s696);LEAVEs723 +FI;s696:=incharety(s725);IFs696<>s689THENtype(s696);LEAVEs723FI;FORs699FROMs703 +UPTOs662REPreorganize(s695[s699].s675,s713,s724,s699);UNTILs724ORs713PER.s726: +s683DECRs703;s680:=s684;s693:=s683=s684;IFs683>s684THEN FORs699FROMs703UPTOs662 +REPs695[s699].s675:=name(s695[s683].s674,s699)PER;ELSEs686:=s689;s687:=s689;s690 +:=s689;s688:=s689FI.s727:IFheapsize>s700+s728THENcollectheapgarbage;s700:= +heapsizeFI ENDPROCeditmonitor;PROCs729:INT VARs699;out(s730);FORs699FROMs703UPTO +s662WHILE NOTisincharetyREPout(text(s699,s731));out(s732);IFs692THENs736FI;IF +s695[s699].s675<>s689THENout(s733+s695[s699].s675+s733)FI;out(s734)PER;out(s735) +;cursor(s703,s685).s736:IFexists(s695[s699].s675)THEN IFtype(old(s695[s699].s675 +))=s663THENout(text(lines(s695[s699].s676),s737));out(s738);out(text(segments( +s695[s699].s676),s728));out(s738)ELSEout(s739*s740)FI;out(text(storage(old(s695[ +s699].s675)),s737))ELIFs695[s699].s675<>s689THENout(s741*s740)FI;out(s742). +ENDPROCs729;PROCs743:enablestop;IFs680=s666THEN LEAVEs743FI;IFs691THENs761(s680) +ELSEs744FI.s744:SELECTs680OF CASEs703:s693:=TRUE CASEs731:edit(s785(s686))CASE +s745:run(s785(s686))CASEs728:insert(s785(s686))CASEs737:forget(s785(s686));close +(int(s686))CASEs746:rename(s785(s686),s785(s687))CASEs722:copy(s785(s686),s785( +s687))CASEs747:fetch(s785(s686))CASEs748:save(s785(s686))CASEs749:close(int(s686 +))CASEs739:s692:=NOTs692CASEs750:reorganize(s785(s686))OTHERWISEdo(s690) +ENDSELECT ENDPROCs743;PROCclose(INT CONSTs751):IF(s751>s684ANDs751<=s662)CAND +s695[s751].s675<>s689THEN IFexists(s695[s751].s675)CANDtype(old(s695[s751].s675) +)=s663THENclose(s695[s751].s676)FI;INT VARs752;delete(s695[s683].s674,s695[s751] +.s675,s752);s695[s751].s675:=s689FI ENDPROCclose;TEXT OP F(INT CONSTs753):IFs753 +>s684ANDs753<=s662THENs695[s753].s675ELSEout(s754);s689FI ENDOP F;OP F(INT CONST +s753,TEXT CONSTs755):IFs753>s684ANDs753<=s662THENs695[s753].s675:=s755;insert( +s695[s683].s674,s755);IFexists(s755)CANDtype(old(s755))=s663THENs695[s753].s676 +:=sequentialfile(modify,s755)FI ELSEout(s754)FI ENDOP F;PROCs756:table(some(all+ +s695[s683].s674+s757)).s757:IFs683=s703THENemptythesaurusELSEs695[s683-s703]. +s674FI ENDPROCs756;THESAURUS PROCtable:THESAURUS VARs758:=emptythesaurus;INT VAR +s699;FORs699FROMs703UPTOs662REP IFexists(s695[s699].s675)AND NOT(s758CONTAINS +s695[s699].s675)THENinsert(s758,s695[s699].s675)FI PER;s758ENDPROCtable;PROC +table(THESAURUS CONSTs759):INT VARs699,s753:=s703,s709;TEXT VARs760;s695[s683]. +s674:=emptythesaurus;FORs699FROMs703UPTOs662REPs695[s699].s675:=s689PER;FORs699 +FROMs703UPTOhighestentry(s759)REPget(s759,s760,s709);IFs760<>s689THENs753Fs760; +s753INCRs703FI UNTILs753>s662PER ENDPROCtable;PROCs761(INT CONSTs762):enablestop +;IFs682=s703THENs763ELSEs764FI.s763:SELECTs777(s762)OF CASEs678:lastparam(s695[ +s762].s675);edit(s695[s762].s676);pageCASEs679:do(s695[s762].s675)ENDSELECT.s764 +:IFs682<=s749THENs766;IFgroesstereditor>s684THENedit(s703);WHILEgroesstereditor> +s684REPquitPER;pageFI ELSEerrorstop(s765)FI.s766:TEXT VARs767,s768:=s689;INT VAR +s769:=s703,s770:=s762,s771;WHILEgroesstereditor>s684REPquitPER;FORs771FROMs703 +UPTOs731REP IFs771=s731THENs690:=s768FI;scan(s690);nextsymbol(s767);REP INT VAR +s772:=s777(s770);IFs771=s703THEN SELECTs772OF CASEs677:s682DECRs703CASEs678:s768 +CAT(s767+s738)CASEs679:s768CAT(s767+s738);s682DECRs703ENDSELECT ELSE SELECTs772 +OF CASEs678:s773CASEs679:do(s695[s770].s675);IFgroesstereditor>s684THEN +bildzeigen;ueberschriftzeigenFI ENDSELECT FI;nextsymbol(s767);s770:=int(s767) +UNTILs767=s689PER;s770:=s762;PER.s773:openeditor(groesstereditor+s703,s695[s770] +.s676,TRUE,s703,s769,s774,s775-s769);s769INCR(s776DIVs682)ENDPROCs761;INT PROC +s777(INT CONSTs762):IFs762>s684ANDs762<=s662THEN IFs695[s762].s675=s689THENs779; +IFs695[s762].s675<>s689THEN IFexists(s695[s762].s675)THEN IFtype(old(s695[s762]. +s675))=s663THENs678ELSEs677FI ELSEs679FI ELSEs677FI ELIF NOTexists(s695[s762]. +s675)THENs679ELIFtype(old(s695[s762].s675))<>s663THENs677ELSEmodify(s695[s762]. +s676);s678FI ELSEerrorstop(s778);s677FI.s779:cursor(s728,s762);out(s780);editget +(s695[s762].s675);IFs695[s762].s675<>s689THENs762Fs695[s762].s675;IF NOTexists( +s695[s762].s675)THENout(s781);IFno(s737*s782+s783)THEN LEAVEs777WITHs677ELSEs784 +FI ELIFtype(old(s695[s762].s675))=s663THENs784FI FI.s784:s695[s762].s676:= +sequentialfile(output,s695[s762].s675).ENDPROCs777;BOOL PROCisincharety:TEXT VAR +s696:=getcharety;IFs696=s689THEN FALSE ELSEpush(s696);TRUE FI ENDPROCisincharety +;TEXT PROCs785(TEXT CONSTs786):INT VARs699:=int(s786);IF(s699>s684ANDs699<=s662) +THENs695[s699].s675ELSEs786FI.ENDPROCs785;PROCreorganize(TEXT CONSTs755,BOOL VAR +s787,s788,INT CONSTs789):DATASPACE VARs790;FILE VARs791,s792;TEXT VARs760;INT + VARs793,s699,s794,s710;getcursor(s794,s710);s788:=FALSE;IF NOTexists(s755)COR +type(old(s755))<>s663THEN LEAVEreorganizeFI;s791:=sequentialfile(modify,s755); +s793:=lineno(s791);input(s791);IF(lines(s791)=s664THENmodify(s791);toline(s791,s793);LEAVE +reorganizeFI;disablestop;s790:=nilspace;s792:=sequentialfile(output,s790);IFs692 +THEN FORs699FROMs703UPTOlines(s791)REPcursor(s728,s789);put(s699);getline(s791, +s760);putline(s792,s760);IFiserrorCORisincharetyTHENs724FI PER ELSE FORs699FROM +s703UPTOlines(s791)REPgetline(s791,s760);putline(s792,s760);IFiserrorCOR +isincharetyTHENs724FI PER FI;copyattributes(s791,s792);modify(s792);toline(s792, +s793);forget(s755,quiet);copy(s790,s755);forget(s790);s787:=TRUE.s724:cursor( +s728,lines(s791));forget(s790);s788:=TRUE;cursor(s794,s710);enablestop;LEAVE +reorganize.ENDPROCreorganize;INT PROCs796(TEXT CONSTs690):INT VARs797,s758:=s684 +;TEXT VARs767;s682:=s684;scan(s690);REPnextsymbol(s767,s797);IFs797=s745THEN IF +s682=s684THENs758:=int(s767)FI;s682INCRs703ELIFs797<>s722THENs682:=s684FI UNTIL +s797=s722ORs682=s684PER;s758ENDPROCs796;TEXT PROCs798:s667+text(s683)+s668 +ENDPROCs798;ENDPACKETeditmonitor;PACKETmpgglobalmanagerDEFINESmonitor,break, +endglobalmanager,begin,beginpassword,managermessage,managerquestion,freemanager, +stdmanager,mpgmanager,freeglobalmanager,globalmanager:LETs832="",s840="checkoff; +endglobalmanager(TRUE);",s841="warnings off;sysout("""");sysin("""");",s842="mon +itor",s847="Task-Passwort :",s848="Beginn-Passwort:",s854=2,s856=1,s860="Kein Z +ugriffsrecht auf Task """,s861="""",s867="Falscher Auftrag fuer Task """,s875="- +",s876="Passwort falsch",s881=""" existiert nicht",s882=""" loeschen",s885=""" u +eberschreiben",s888=" ",s899="break:1.0end:2.0monitor:3.0stdbeginproc:4.1",s900= +"Gib ",s901="-Kommando :",s902=0,s903=3,s904=4,s916=""3""13""5"",s920=6,s932="gi +b kommando :",s936=""7"Speicher Engpass! Dateien loeschen!"13""10"",s938=5,s939= +7,s940=8,s941=9,s942=10,s943=11,s944=12,s945=13,s946=14,s947=15,s948=16,s949=17, +s950=18,s951=19;LETs799=0,s800=1,s801=2,s802=3,s803=4,s804=5,s805=6,s806=4,s807= +9,s808=11,s809=12,s810=13,s811=14,s812=15,s813=17,s814=24,s815=100,s816=""7""13" +"10""5"Fehler : ",s817=""13""10"";DATASPACE VARs818:=nilspace;BOUND STRUCT(TEXT +s819,s820,s821)VARs822;BOUND TEXT VARs823;TASK VARs824,s825;FILE VARs826;INT VAR +s827,s828,s829,s830;TEXT VARs831:=s832,s833,s834,s835:=s832,s836,s837,s838;TEXT + VARs839:=s840+s841+s842;BOOL VARs843,s844;PROCmpgmanager(PROC(DATASPACE VAR,INT + CONST,INT CONST,TASK CONST)s845):IFonlineTHEN TEXT VARs846;put(s847); +getsecretline(s846);IFs846<>s832THENtaskpassword(s846)FI;put(s848);getsecretline +(s846);IFs846<>s832THENbeginpassword(s846)FI FI;s844:=FALSE;globalmanager(PROC( +DATASPACE VAR,INT CONST,INT CONST,TASK CONST)s845)ENDPROCmpgmanager;PROC +globalmanager:mpgmanager(PROC(DATASPACE VAR,INT CONST,INT CONST,TASK CONST) +stdmanager)ENDPROCglobalmanager;PROCglobalmanager(PROC(DATASPACE VAR,INT CONST, +INT CONST,TASK CONST)s845):s843:=TRUE;s849(PROC(DATASPACE VAR,INT CONST,INT + CONST,TASK CONST)s845)ENDPROCglobalmanager;PROCs849(PROC(DATASPACE VAR,INT + CONST,INT CONST,TASK CONST)s845):s919;setautonom;disablestop;commanddialogue( +FALSE);s825:=niltask;s851;REPwait(s818,s828,s824);IFs828<>s804THENs855;s845(s818 +,s828,s830,s824)ELIFs824=s825THENs857;s845(s818,s828,s830,s824)ELSEs858FI;s850; +s853UNTIL(NOTs843)AND(NOTs844)PER;commanddialogue(TRUE);resetautonom.s850:IF +iserrorTHENforget(s818);s818:=nilspace;s823:=s818;CONCR(s823):=errormessage; +clearerror;send(s824,s801,s818)FI.s851:INT VARs852:=heapsize.s853:IFheapsize> +s852+s854THENcollectheapgarbage;s852:=heapsizeFI.s855:s830:=s856;s829:=s828;s825 +:=s824.s857:s830INCRs856;s828:=s829.s858:forget(s818);s818:=nilspace;send(s824, +s800,s818)ENDPROCs849;PROCfreeglobalmanager:mpgmanager(PROC(DATASPACE VAR,INT + CONST,INT CONST,TASK CONST)freemanager)ENDPROCfreeglobalmanager;PROCstdmanager( +DATASPACE VARs818,INT CONSTs828,s859,TASK CONSTs824):IF(s828=s806ANDs862)CORs863 +THENfreemanager(s818,s828,s859,s824)ELSEerrorstop(s860+name(myself)+s861)FI.s862 +:(s864ORs865)ANDs843.s863:s864ORs865.s864:s824s815ANDs824=supervisorTHENs893ELIFs828= +s806ANDs843THENs869ELSEs866FI.s866:s868;SELECTs828OF CASEs808:s879CASEs809:s883 +CASEs810:s889CASEs811:s880CASEs812:s890CASEs813:s891CASEs814:s907OTHERWISE +errorstop(s867+name(myself)+s861)ENDSELECT.s868:IFs828>=s808ANDs828<=s811ANDs859 +=s856THENs822:=s818;s834:=s822.s819FI.s869:BOUND STRUCT(TEXTs870,s871,TASKs872, +PROCAs873)VARs874:=s818;IFs835=s874.s871ANDs835<>s875THENs877ELIFs874.s871=s832 +THENs878ELSEerrorstop(s876)FI.s877:begin(s818,PROCs912,s827);send(s824,s827,s818 +).s878:send(s824,s807,s818).s879:IFreadpermission(s834,s822.s821)CORs824< +supervisorTHENforget(s818);s818:=old(s834);send(s824,s799,s818)ELSEerrorstop( +s876)FI.s880:s822:=s818;s834:=s822.s819;IF NOTexists(s834)THENmanagermessage( +s861+s834+s881,s824)ELIFs830=s856THENmanagerquestion(s861+s834+s882,s824)ELIF +writepermission(s834,s822.s820)CORs824s832THENout(s816);out(s831);out(s817); +s831:=s832FI.s906:IFiserrorTHENs831:=errormessage;clearerrorFI.s907:FILE VARs908 +:=sequentialfile(input,s818);WHILE NOTeof(s908)REPgetline(s908,s833);IFexists( +s833)THENforget(s833,quiet)FI PER;send(s824,s799,s818).ENDPROCfreemanager;PROC +managerquestion(TEXT CONSTs909):forget(s818);s818:=nilspace;s823:=s818;s823:= +s909;send(s824,s803,s818)ENDPROCmanagerquestion;PROCmanagerquestion(TEXT CONST +s909,TASK CONSTs910):forget(s818);s818:=nilspace;s823:=s818;s823:=s909;send(s910 +,s803,s818)ENDPROCmanagerquestion;PROCmanagermessage(TEXT CONSTs911):forget(s818 +);s818:=nilspace;s823:=s818;s823:=s911;send(s824,s802,s818)ENDPROCmanagermessage +;PROCmanagermessage(TEXT CONSTs911,TASK CONSTs910):forget(s818);s818:=nilspace; +s823:=s818;s823:=s911;send(s910,s802,s818)ENDPROCmanagermessage;PROCs912:do(s839 +)ENDPROCs912;PROCbegin(TEXT CONSTs913):TASK VARs914;begin(s913,PROCmonitor,s914) +ENDPROCbegin;PROCbeginpassword(TEXT CONSTs915):s917;s835:=s915;display(s916); +covertracks.s917:replace(s835,s856,LENGTHs835*s888)ENDPROCbeginpassword;PROC +endglobalmanager(BOOL CONSTs918):s843:=NOTs918;s844:=NOTs918ENDPROC +endglobalmanager;PROCs919:eumelmustadvertise;s921(s920)ENDPROCs919;PROCbreak:IF +s843THENs919;LEAVEbreakFI;s844:=TRUE;s843:=FALSE;s849(PROC(DATASPACE VAR,INT + CONST,INT CONST,TASK CONST)stdmanager)ENDPROCbreak;PROCs921(INT CONSTs922): +DATASPACE VARs923:=nilspace;INT VARs924;call(supervisor,s922,s923,s924);IFs924= +s801THEN BOUND TEXT VARs925:=s923;forget(s923);errorstop(s925)FI;forget(s923) +ENDPROCs921;LETs926="edit:1.01end:3.0run:4.01runagain:6.0insert:7.01forget:9.01r +ename:11.2copy:12.2list:13.0storageinfo:14.0taskinfo:15.0fetch:16.1save:17.01sav +eall:19.0";INT VARs927,s928,s929;TEXT VARs930,s931;PROCmonitor:disablestop;s929 +:=heapsize;REPcommanddialogue(TRUE);sysin(s832);sysout(s832);s933;getcommand( +s932);analyzecommand(s926,s904,s927,s928,s930,s931);s937;s853PER.s853:IFheapsize +>s929+s904THENcollectheapgarbage;s929:=heapsizeFI.s933:INT VARs934,s935;storage( +s934,s935);IFs935>s934THENout(s936)FI.ENDPROCmonitor;PROCs937:enablestop;SELECT +s927OF CASEs856:editCASEs854:edit(s930)CASEs903:endCASEs904:runCASEs938:run(s930 +)CASEs920:runagainCASEs939:insertCASEs940:insert(s930)CASEs941:forgetCASEs942: +forget(s930)CASEs943:rename(s930,s931)CASEs944:copy(s930,s931)CASEs945:listCASE +s946:storageinfoCASEs947:taskinfoCASEs948:fetch(s930)CASEs949:saveCASEs950:save( +s930)CASEs951:saveallOTHERWISEdocommandENDSELECT.ENDPROCs937;ENDPACKET +mpgglobalmanager diff --git a/app/mpg/1987/src/RUCTEPLT.ELA b/app/mpg/1987/src/RUCTEPLT.ELA new file mode 100644 index 0000000..684c358 --- /dev/null +++ b/app/mpg/1987/src/RUCTEPLT.ELA @@ -0,0 +1,326 @@ +PACKET ructerm plot DEFINES (* M. Staubermann, 23.11.86 *) + drawing area, + begin plot, + end plot, + clear, + pen, + move, + draw, + get cursor , + + testbit, where, + pages , + circle, ellipse, fill, box, filled box, + get screen , + put screen : + +LET max x = 279 , {Abmessungen : 280 x 192} + max y = 191 , + + hor faktor = 11.2 , {***** x pixel / x cm *****} + vert faktor = 11.29412 , {***** y pixel / y cm *****} + + + delete = 0 , {Farbcodes} + std = 1 , + black = 5 , + white = 6 , + yellow = 7 ; +(* lilac = 8 , + + durchgehend = 1 , {Linientypen} + gepunktet = 2 , + kurz gestrichelt = 3 , + lang gestrichelt = 4 , + strichpunkt = 5 , + strichpunktpunkt = 6 ;*) + +LET POS = STRUCT (INT x, y) ; + +POS VAR pos ; +INT VAR i ; + +clear ; + +TEXT PROC text word (INT CONST i) : + TEXT VAR t := " " ; + replace (t, 1, i) ; + t +ENDPROC text word ; + +PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : + x cm := 25.0; y cm := 17.0; {***** Horizontale und vertikale *****} + {***** Gre in Zentimetern. *****} + x pixel := maxx; y pixel := maxy{***** Koordinaten des rechten *****} + {***** oberen Punktes. *****} +END PROC drawing area; + +PROC begin plot : + out (""27"$") +ENDPROC begin plot ; + +PROC end plot : + out (""27"%") +ENDPROC end plot ; + +PROC where (INT VAR x, y) : + REP UNTIL incharety = "" PER ; + out (""27";") ; + x := (incharety (1000) + incharety (1000)) ISUB 1 ; + y := (incharety (1000) + incharety (1000)) ISUB 1 +ENDPROC where ; + +BOOL PROC testbit : + TEXT VAR t ; + REP UNTIL incharety = "" PER ; + out (""27"-") ; + inchar (t) ; + bit (code (t), 0) +ENDPROC testbit ; + +PROC clear : + pos := POS:(0, 0) ; + out (""27"O0"27"y") ; (* Clear und Cursor (0,0) *) +END PROC clear; + +PROC pen (INT CONST background, foreground, thickness, linetype): + INT CONST farbe := abs (foreground) ; + set linetype ; + set colour ; + set thickness . + +set colour : + IF farbe = std OR farbe = yellow OR farbe = white + THEN out (""27"O21") + ELSE out (""27"O20") + FI ; + IF farbe = delete OR farbe = black THEN out (""27"O41") (* AND *) + ELIF foreground < 0 AND thickness >= 0 THEN out (""27"O42") (* XOR *) + ELIF foreground < 0{AND thickness < 0} THEN out (""27"O43") (* COPY *) + ELSE out (""27"O40") (* SET *) + FI . + +set thickness : + IF thickness > 0 AND thickness < 16 + THEN out (""27"O1" + code (thickness + 32)) + FI . + +set linetype: + IF linetype < 7 AND linetype > 0 + THEN out (""27"O3" + code (line type + 32)) + ELSE out (""27"O6" + text word (line type) + ""27"O37") ; + FI . + +END PROC pen; + +PROC move (INT CONST x, y) : + TEXT VAR cmd := ""27"v" ; + cmd CAT text (x) ; + cmd CAT "," ; + cmd CAT text (y) ; + cmd CAT ";" ; + out (cmd) ; + pos := POS:(x,y) +END PROC move; + +PROC draw (INT CONST x, y) : + TEXT VAR cmd := ""27"w" ; + cmd CAT text (x) ; + cmd CAT "," ; + cmd CAT text (y) ; + cmd CAT ";" ; + out (cmd) ; + pos := POS : (x, y) + +END PROC draw; + +PROC draw (TEXT CONST record, REAL CONST angle, height, width): + TEXT VAR cmd := ""27"&"27"N" ; + cmd CAT code (72 + int (angle / 5.0) MOD 72) ; + cmd CAT code (int (hor faktor * width + 0.5)) ; + cmd CAT code (int (vert faktor * height + 0.5)) ; + out (cmd) ; + out (record) ; + out (""27"N"0""0""0"") ; + move (pos.x, pos.y) . +END PROC draw; + +PROC draw (TEXT CONST record) : + draw (record, 0.0, 0.0, 0.0) +END PROC draw; + +PROC get cursor (TEXT VAR t, INT VAR x, y) : + get cursor (t, x, y, -1, -1, -1, -1) +END PROC get cursor; + +PROC get cursor (TEXT VAR t, INT VAR x, y, INT CONST x0, y0, x1, y1) : + get cursor (t, x, y, x0, y0, x1, y1, FALSE) +ENDPROC get cursor ; + +PROC get cursor (TEXT VAR t, INT VAR x, y, INT CONST x0, y0, x1, y1, + BOOL CONST only one key): + BOOL VAR hop key := FALSE ; + t := "" ; + check; + init cursor; + REP set cursor; + get step; + set cursor; + move cursor + UNTIL only one key PER . + +init cursor: + POS CONST old pos :: pos ; + REP UNTIL incharety = "" PER ; + out (""27"5") ; + TEXT VAR old params ; + inchar (old params) ; + out (""27"O5a") ; (* Strichdicke 1, XOR, Gelb *) + INT VAR delta := 1 ; + x := pos.x ; + y := pos.y . + +set cursor: + IF x0 >= 0 AND y0 >= 0 + THEN move (x0, y0) ; + draw (x, y) + FI; + IF x1 >= 0 AND y1 >= 0 + THEN move (x1, y1) ; + draw (x, y) + FI; + out (""24"") . (* Fadenkreuz an/aus *) + +get step: + hop key := t = ""1"" ; + t := incharety (1); + IF t <> "" + THEN delta INCR 1 + ELSE delta := 1 ; + inchar (t) + FI . + +move cursor: + IF hop key + THEN hop mode + ELSE single key + FI ; + check . + +single key : + SELECT code (t) OF + CASE 1 : + CASE 2, 54 : x INCR delta (* right, '6' *) + CASE 3, 56 : y INCR delta (* up, '8' *) + CASE 8, 52 : x DECR delta (* left, '4' *) + CASE 10, 50 : y DECR delta(* down, '2' *) + CASE 55 : x DECR delta ; y INCR delta (* '7' *) + CASE 57 : x INCR delta ; y INCR delta (* '9' *) + CASE 49 : x DECR delta ; y DECR delta (* '1' *) + CASE 51 : x INCR delta ; y DECR delta (* '3' *) + OTHERWISE leave get cursor + ENDSELECT . + +hop mode : + SELECT code (t) OF + CASE 1 : t := "" ; x := 0 ; y := max y ; + CASE 2, 54 : x := max x + CASE 3, 56 : y := max y + CASE 8, 52 : x := 0 + CASE 10, 50 : y := 0 + CASE 55 : x := 0 ; y := max y + CASE 57 : x := max x ; y := max y + CASE 49 : x := 0 ; y := 0 + CASE 51 : x := max x ; y := 0 + OTHERWISE t := ""1"" + t ; leave get cursor + ENDSELECT . + +leave get cursor: + out (""27"O5" + old params) ; + move (old pos.x, old pos.y); + LEAVE get cursor . + +check : + IF x < 0 + THEN x := 0 ; out (""7"") + ELIF x > max x + THEN x := max x ; out (""7"") FI ; + + IF y < 0 + THEN y := 0 ; out (""7"") + ELIF y > max y + THEN y := max y ; out (""7"") FI . + +END PROC get cursor; + +PROC get screen (TEXT CONST name): + IF exists (name) + THEN get screen (old (name)) + ELSE get screen (new (name)) + FI ; +END PROC get screen; + +PROC get screen (DATASPACE CONST to ds) : + BOUND ROW 16 ROW 256 INT VAR screen := to ds ; + INT VAR i, j ; + REP UNTIL incharety = "" PER ; + FOR i FROM 0 UPTO 16 REP + out (""27"\"0""2""0"" + code (i * 2)) ; + FOR j FROM 1 UPTO 256 REP + screen (i)(j) := (incharety (1000) + incharety (1000)) ISUB 1 + PER ; + PER +END PROC get screen; + +PROC put screen (TEXT CONST name): + IF exists (name) + THEN put screen (old (name)) + ELSE errorstop ("Der Datenraum """ + name + """ existiert nicht") FI +END PROC put screen; + +PROC put screen (DATASPACE CONST from ds) : + BOUND ROW 4096 INT VAR screen :: from ds ; + out (""27"/"0""32""0""0"") ; + FOR i FROM 1 UPTO 4096 REP + out (textword (screen (i))) + PER +END PROC put screen; + +PROC pages (INT CONST bits) : + out (""27"O7" + code (bits + 32)) +ENDPROC pages ; + +INT PROC pages : + TEXT VAR t ; + REP UNTIL incharety = "" PER ; + out (""27"4") ; + inchar (t) ; + code (t) AND 7 +ENDPROC pages ; + +PROC circle (INT CONST radius) : + IF radius > 0 + THEN out (""27"K" + text (radius) + ",0;") ; + FI +ENDPROC circle ; + +PROC ellipse (INT CONST x rad, y rad, REAL CONST from, to) : + out (""27"s" + text (x rad) + "," + text (yrad) + "," + + text (72 + int (from / 5.0) MOD 72) + "," + + text (72 + int (to / 5.0) MOD 72) + ";") +ENDPROC ellipse ; + +PROC box (INT CONST width, height) : + out (""27"J" + text (width) + "," + text (height) + ";") +ENDPROC box ; + +PROC filled box (INT CONST width, height) : (* Width max. 255 *) + out (""27"N" + code (width) + code (height)) ; (* Groes inverses Blank *) + put (""0""27"&"27"O41"27"G0 "27"N"0""0""0"") (* ausgeben *) +ENDPROC filled box ; + +PROC fill (INT CONST pattern) : + out (""27"|" + code (pattern + 32)) +ENDPROC fill ; + +END PACKET ructerm plot ; diff --git a/app/mpg/1987/src/STDPLOT.ELA b/app/mpg/1987/src/STDPLOT.ELA new file mode 100644 index 0000000..542b032 --- /dev/null +++ b/app/mpg/1987/src/STDPLOT.ELA @@ -0,0 +1,234 @@ +PACKET std plot DEFINES drawing area, + begin plot, + end plot, + clear, + pen, + move, + draw, + get cursor: + +LET delete = 0, {Farbcodes} + std = 1, + black = 5, + white = 6, + + durchgehend = 1, {Linientypen} + gepunktet = 2, + kurz gestrichelt = 3, + lang gestrichelt = 4, + strichpunkt = 5, + + empty = 0, {Punktsymbole} + high = 1, + low = 2, + both = 3; + +LET POS = STRUCT (INT x, y); + +ROW 79 ROW 24 INT VAR screen; +BOOL VAR colour :: TRUE, action :: TRUE; +POS VAR pos :: POS : (0, 0); + +clear; + +PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : + x cm := 25.0; y cm := 17.0; {***** Horizontale und vertikale *****} + {***** Gre in Zentimetern. *****} + x pixel := 79; y pixel := 48 {***** Koordinaten des rechten *****} + {***** oberen Punktes. *****} +END PROC drawing area; + +PROC begin plot : +ENDPROC begin plot ; + +PROC end plot : +ENDPROC end plot ; + +PROC clear : + INT VAR i, j; + colour := TRUE; + action := TRUE; + pos := POS : (0, 0); + + FOR i FROM 1 UPTO 24 + REP screen [1] [i] := 0 PER; + FOR i FROM 2 UPTO 79 + REP screen [i] := screen [1] PER; + page; + out (""6""23""0"") . +END PROC clear; + +PROC pen (INT CONST background, foreground, thickness, linetype): + colour := foreground > 0; + action := linetype <> 0 . + +END PROC pen; + +PROC move (INT CONST x, y) : + out (""6""+ code (23-y DIV 2) + code (x)); + pos := POS : (x, y) +END PROC move; + +PROC draw (INT CONST x, y) : + IF action + THEN vector (x-pos.x, y-pos.y) FI; + pos := POS : (x, y) . + +END PROC draw; + +PROC vector (INT CONST dx , dy) : + IF dx >= 0 + THEN IF dy > dx THEN vector (pos.y, pos.x, dy, dx, 1, 1) + ELIF dy > 0 THEN vector (pos.x, pos.y, dx, dy, 1, 1) + + ELIF dy > -dx THEN vector (pos.x, pos.y, dx, -dy, 1,-1) + ELSE vector (pos.y, pos.x, -dy, dx,-1, 1) FI + + ELSE IF dy > -dx THEN vector (pos.y, pos.x, dy, -dx, 1,-1) + ELIF dy > 0 THEN vector (pos.x, pos.y, -dx, dy,-1, 1) + + ELIF dy > dx THEN vector (pos.x, pos.y, -dx, -dy,-1,-1) + ELSE vector (pos.y, pos.x, -dy, -dx,-1,-1) FI + FI . + +ENDPROC vector ; + +PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) : + INT VAR i; + prepare first step ; + point; + FOR i FROM 1 UPTO dx + REP do one step PER . + +prepare first step : + INT VAR up right error := dy - dx, + right error := dy, + old error := 0 . + +do one step: + IF right is better + THEN do right step + ELSE do up right step + FI . + +right is better : + abs (old error + right error) < abs (old error + up right error) . + +do upright step : + x pos INCR right ; + y pos INCR up ; + point ; + old error INCR upright error . + +do right step : + x pos INCR right ; + point ; + old error INCR right error . + +point : + IF (pos.y AND 1) = 0 + THEN lower point + ELSE upper point FI . + +lower point : + out (""6""+ code (23-pos.y DIV 2) + code (pos.x)); + IF colour + THEN set lower point + ELSE reset lower point FI . + +set lower point: + SELECT screen [pos.x+1] [pos.y DIV 2+1] OF + CASE empty : out (","8""); + screen [pos.x+1] [pos.y DIV 2+1] := low + CASE high : out ("|"8""); + screen [pos.x+1] [pos.y DIV 2+1] := both + ENDSELECT . + +reset lower point: + SELECT screen [pos.x+1] [pos.y DIV 2+1] OF + CASE low : out (" "8""); + screen [pos.x+1] [pos.y DIV 2+1] := empty + CASE both : out ("'"8""); + screen [pos.x+1] [pos.y DIV 2+1] := high + ENDSELECT . + +upper point : + out (""6""+ code (23-pos.y DIV 2) + code (pos.x)); + IF colour + THEN set upper point + ELSE reset upper point FI . + +set upper point: + SELECT screen [pos.x+1] [pos.y DIV 2+1] OF + CASE empty : out ("'"8""); + screen [pos.x+1] [pos.y DIV 2+1] := high + CASE low : out ("|"8""); + screen [pos.x+1] [pos.y DIV 2+1] := both + ENDSELECT . + +reset upper point: + SELECT screen [pos.x+1] [pos.y DIV 2+1] OF + CASE high : out (" "8""); + screen [pos.x+1] [pos.y DIV 2+1] := empty + CASE both : out (","8""); + screen [pos.x+1] [pos.y DIV 2+1] := low + ENDSELECT . + +END PROC vector; + +PROC draw (TEXT CONST record, REAL CONST angle, height, width): + out (subtext (record, 1, 79-pos.x)); + out (""6""+ code (23-pos.y DIV 2) + code (pos.x)); +END PROC draw; + +PROC draw (TEXT CONST record) : + draw (record, 0.0, 0.0, 0.0) +END PROC draw; + +PROC get cursor (TEXT VAR t, INT VAR x, y) : + x := pos.x; + y := pos.y; + REP out (""6""+ code (23-y DIV 2) + code (x)); + inchar (t); + SELECT code (t) OF + CASE 2 : x INCR 1 + CASE 3 : y INCR 1 + CASE 8 : x DECR 1 + CASE 10: y DECR 1 + CASE 1 : out (""0""1"" + text (x, 3) + "," + text (y, 3) + " "13""16"") + OTHERWISE leave get cursor ENDSELECT; + check + PER . + +leave get cursor: + out (""6""+ code (23-pos.y DIV 2) + code (pos.x)); + LEAVE get cursor . + +check : + IF x < 0 + THEN x := 0; + out (""7"") + ELIF x > 47 + THEN x := 47; + out (""7"") + FI; + IF y < 0 + THEN y := 0; + out (""7"") + ELIF y > 78 + THEN y := 78; + out (""7"") + FI . + +END PROC get cursor; + +PROC test (INT CONST x, y, TEXT CONST t): + out (""27";(" + text (x) + "," + text (y) + ") " + t + ""29""); + IF incharety (10000) = ""27"" + THEN stop FI +END PROC test; + + +END PACKET std plot; + + diff --git a/app/mpg/1987/src/TELEVPLT.ELA b/app/mpg/1987/src/TELEVPLT.ELA new file mode 100644 index 0000000..155eb02 --- /dev/null +++ b/app/mpg/1987/src/TELEVPLT.ELA @@ -0,0 +1,176 @@ +PACKET televideo plot DEFINES drawing area, { Autor: H. Indenbirken } + begin plot, { Stand: 31.01.85 } + end plot, + clear, + pen, + move, + draw, + get cursor, + cursor: + + +LET delete = 0, {Farbcodes} + std = 1, + black = 5, + white = 6, + + nothing = 0, {Linientypen} + durchgehend = 1, + gepunktet = 2, + kurz gestrichelt = 3, + lang gestrichelt = 4, + strichpunkt = 5, + mittel gestrichelt = 6, + punkt punkt strich = 7; + +INT VAR act thick :: 0; +LET POS = STRUCT (INT x, y); + +POS VAR pos :: POS : (0, 0); + +PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : + x cm := 23.0; y cm := 13.7; + x pixel := 639; y pixel := 239 +END PROC drawing area; + +PROC begin plot : + page; + out (""27".0") +ENDPROC begin plot ; + +PROC end plot : + out (""27".1") +ENDPROC end plot ; + +PROC clear : + act thick := 0; + pos := POS : (0, 0); + out (""27"mCGD") +END PROC clear; + +PROC pen (INT CONST background, foreground, thickness, linetype): + out (""27"m"); + set background; + set foreground; + set thickness; + set linetype; + out ("D") . + +set background: + IF background = white + THEN out (""27"n1") + ELSE out (""27"n0") FI . + +set foreground: + IF foreground = delete + THEN out ("U0W1") + ELIF foreground < 0 + THEN out ("U1W4") + ELSE out ("U1W1") FI . + +set thickness: + act thick := thickness . + +set linetype: + SELECT linetype OF + CASE durchgehend : out ("T1") + CASE gepunktet : out ("T3") + CASE kurz gestrichelt : out ("T6") + CASE lang gestrichelt : out ("T5") + CASE strichpunkt : out ("T4") + CASE mittel gestrichelt : out ("T2") + CASE punkt punkt strich : out ("T7") + END SELECT . + +END PROC pen; + +PROC move (INT CONST x, y) : + out (""27"mM" + text (x, y) + ";D"); + pos := POS : (x, y) +END PROC move; + +PROC draw (INT CONST x, y) : + IF act thick <> 0 + THEN IF horizontal line + THEN thick y + ELSE thick x FI; + x MOVE y + ELSE out (""27"mL" + text (x, y) + ";D") FI; + pos := POS : (x, y) . + +horizontal line: + abs (pos.x-x) > abs (pos.y-y) . + +thick y: + INT VAR dy, old x :: pos.x-x ausgleich, new x :: x+x ausgleich; + FOR dy FROM 1 UPTO act thick + REP old x MOVE pos.y+dy; + new x DRAW y+dy; + old x MOVE pos.y-dy; + new x DRAW y-dy; + PER . + +x ausgleich: + IF pos.x <= x + THEN act thick + ELSE -act thick FI . + +thick x: + INT VAR dx, old y :: pos.y-y ausgleich, new y :: y+y ausgleich; + FOR dx FROM 1 UPTO act thick + REP pos.x+dx MOVE old y; + x+dx DRAW new y; + pos.x-dx MOVE old y; + x-dx DRAW new y; + PER . + +y ausgleich: + IF pos.y <= y + THEN act thick + ELSE -act thick FI . + +END PROC draw; + +PROC draw (TEXT CONST record, REAL CONST angle, height, width): + out (""27"m""" + record + """D") +END PROC draw; + +PROC draw (TEXT CONST record) : + draw (record, 0.0, 0.0, 0.0) +END PROC draw; + +PROC get cursor (TEXT VAR t, INT VAR x, y) : +END PROC get cursor; + +OP MOVE (INT CONST x, y): + out (""27"mM" + text (x, y) + ";D") +END OP MOVE; + +OP DRAW (INT CONST x, y): + out (""27"mL" + text (x, y) + ";D") +END OP DRAW; + +PROC cursor (INT CONST no,x,y): + out (""27"m|" + text (no) + "~0H" + text (x, y) + ";D") +END PROC cursor; + +TEXT PROC text (INT CONST x,y): + x text + "," + y text . + +x text: + IF x < 0 + THEN "0" + ELIF x > 639 + THEN "639" + ELSE text (x) FI . + +y text: + IF y < 0 + THEN "0" + ELIF y > 639 + THEN "639" + ELSE text (y) FI . + +END PROC text; + +END PACKET televideo plot diff --git a/app/mpg/1987/src/VIDEOPLO.ELA b/app/mpg/1987/src/VIDEOPLO.ELA new file mode 100644 index 0000000..9721cad --- /dev/null +++ b/app/mpg/1987/src/VIDEOPLO.ELA @@ -0,0 +1,382 @@ +# Stand : 26.Juni 1985 # +PACKET videostar plot DEFINES drawing area, + begin plot, + end plot, + clear, + + background, + foreground, + thickness, + linetype, + + move, + draw, + marker, + + range, + clipping: + +LET begin vector = ""16""; +LET max x = 679, + max y = 479; (* Direkt-Adressierung *) +LET POS = STRUCT (INT x, y); +POS VAR pos :: POS : (0, 0); + +INT VAR akt pen :: 1, akt pen line type :: 1; +BOOL VAR check :: TRUE; +INT VAR thick :: 0, i, x min :: 0, x max :: 679, y min :: 0, y max :: 479; +TEXT VAR old pos :: ""; + +PROC drawing area (REAL VAR x cm, y cm, INT VAR x pixel, y pixel) : + x cm := 27.0 ; y cm := 20.00; + x pixel := 679; y pixel := 479 +END PROC drawing area; + +PROC range (INT CONST h min, h max, v min, v max): + x min := h min; x max := h max; + y min := v min; y max := v max +END PROC range; + +PROC clipping (BOOL CONST flag): + check := flag +END PROC clipping; + +BOOL PROC clipping: + check +END PROC clipping; + +PROC begin plot : +ENDPROC begin plot ; + +PROC end plot : + out (""27"0@") +ENDPROC end plot ; + +PROC clear : +write (""29""27""140""27"/0d"24"") +END PROC clear; + +PROC background (INT CONST desired, INT VAR realized): + realized := 0 (*Nur schwarzer Hintergrund mglich *) +END PROC background; + +PROC foreground (INT CONST desired, INT VAR realized): + akt pen := desired; + realized := sign (desired) . (*Nur weier Sift mglich, aber *) + (*lschend, ndernd oder berschreibend *) +END PROC foreground; + +PROC thickness (INT CONST desired, INT VAR realized): + thick := desired DIV 10; + realized := thick*2+1 (*Breite des Stiftes in Pixel *) +END PROC thickness; + +PROC linetype (INT CONST desired, INT VAR realized): + IF desired <> akt pen linetype + THEN write (""29"") ; # Graphicmode on # + akt pen line type := desired; + write (type cmd); + write (""27"x"24"") + FI; + IF desired >= 0 AND desired <= 5 + THEN realized := desired + ELSE realized := 0 FI . + +type cmd: + SELECT desired OF + CASE 1 : ""27"/a" # durchgngige Linie # + CASE 2 : ""27"/1;1a" # gepunktet # + CASE 3 : ""27"/3;3a" # kurz gestrichelt # + CASE 4 : ""27"/6;6a" # lang gestrichelt # + CASE 5 : ""27"/6;3;1;3a" # Strichpunkt # + OTHERWISE ""27"/a" END SELECT +END PROC linetype; + + +PROC move (INT CONST x, y) : + x MOVE y; + pos := POS:(x, y) . +END PROC move; + +PROC draw (INT CONST x, y): + IF std thickness + THEN draw (pos.x, pos.y, x, y) + ELIF is point + THEN point (x, y, thick); + x MOVE y; + ELIF is horizontal line + THEN horizontal line (pos.x, pos.y, x, y, thick); + x MOVE y; + ELSE vertical line (pos.x, pos.y, x, y, thick); + x MOVE y + FI; + pos := POS:(x, y) . + +std thickness: + thick = 0 . + +is point: + pos.x = x AND pos.y = y . + +is horizontal line: + abs (pos.x-x) >= abs (pos.y-y) . + +END PROC draw; + +PROC point (INT CONST x, y, thick): + INT VAR i; + FOR i FROM -thick UPTO thick + REP line (x-thick, y+i, x+thick, y+i) PER + +END PROC point; + +PROC horizontal line (INT CONST from x, from y, to x, to y, thick): + IF from x > to x + THEN horizontal line (to x, to y, from x, from y, thick) + ELSE draw line FI . + +draw line: + INT VAR i; + calculate increase; + calculate limit points; + FOR i FROM -thick UPTO thick + REP calculate delta x; + line (x start+delta x, y start+i, x end+delta x, y end+i) + PER . + +calculate increase: + REAL VAR increase :: -dy / dx . + +calculate limit points: + INT CONST x start :: from x - thick, + x end :: to x + thick, + y start :: from y + int (increase * real (thick)), + y end :: to y - int (increase * real (thick)) . + +calculate delta x: + INT CONST delta x :: int (increase*real (i)) . + +dx: real (to x-from x) . +dy: real (to y-from y) . + +END PROC horizontal line; + +PROC vertical line (INT CONST from x, from y, to x, to y, thick): + IF from y > to y + THEN vertical line (to x, to y, from x, from y, thick) + ELSE draw line FI . + +draw line: + INT VAR i; + calculate increase; + calculate limit points; + FOR i FROM -thick UPTO thick + REP calculate delta y; + line (x start+i, y start+delta y, x end+i, y end+delta y) + PER . + +calculate increase: + REAL VAR increase :: -dx / dy . + +calculate limit points: + INT CONST x start :: from x + int (increase * real (thick)), + x end :: to x - int (increase * real (thick)), + y start :: from y - thick, + y end :: to y + thick . + +calculate delta y: + INT CONST delta y :: int (increase*real (i)) . + +dx: real (to x-from x) . +dy: real (to y-from y) . + +END PROC vertical line; + +PROC marker (INT CONST x, y, no, size): + IF no = 0 + THEN draw cursor FI; + pos.x MOVE pos.y . + +draw cursor: + write(""29""27"/f"27""26"") . + +END PROC marker; + +PROC line (INT CONST from x, from y, to x, to y): + from x MOVE from y; + draw (from x, from y, to x, to y) +END PROC line; + +PROC draw (INT CONST from x, from y, to x, to y): + IF check + THEN draw with clipping + ELSE to x DRAW to y FI . + +draw with clipping: + INT VAR x, y; + calculate parts of line; + IF both points inside + THEN to x DRAW to y + ELIF both points outside + THEN + ELIF first point outside + THEN intersection (to x, to y, to part, from x, from y, from part, x, y); + x MOVE y; + to x DRAW to y + ELIF second point outside + THEN intersection (from x, from y, from part, to x, to y, to part, x, y); + x DRAW y + ELSE check intersection FI . + +calculate parts of line: + INT CONST from part :: part (from x, from y), + to part :: part (to x, to y) . + +both points inside: + from part = 0 AND to part = 0 . + +both points outside: + (from part AND to part) <> 0 . + +first point outside: + from part <> 0 AND to part = 0 . + +second point outside: + to part <> 0 AND from part = 0 . + +check intersection: + intersection (to x, to y, to part, from x, from y, from part, x, y); + x MOVE y; + draw (x, y, to x, to y) . + +END PROC draw; + +INT PROC part (INT CONST x, y): + INT VAR index :: 0; + IF x > x max + THEN set bit (index, 0) + ELIF x < x min + THEN set bit (index, 1) FI; + + IF y > y max + THEN set bit (index, 2) + ELIF y < y min + THEN set bit (index, 3) FI; + + index + +END PROC part; + +PROC intersection (INT CONST from x, from y, from part, to x, to y, to part, + INT VAR x, y): + SELECT to part OF + CASE 1: right side + CASE 2: left side + CASE 4: up side + CASE 5: upright side + CASE 6: upleft side + CASE 8: down side + CASE 9: downright side + CASE 10: downleft side + OTHERWISE errorstop ("wrong partno.:" + text (to part)) ENDSELECT . + +right side: + y := from y + int (real (x max-from x)*(dy/dx)); + x := x max . + +left side: + y := from y + int (real (x min-from x)*(dy/dx)); + x := x min . + +up side: + x := from x + int (real (y max-from y)*(dx/dy)); + y := y max . + +down side: + x := from x + int (real (y min-from y)*(dx/dy)); + y := y min . + +upright side: + right side; + IF y > y max + THEN up side FI . + +downright side: + right side; + IF y < y min + THEN down side FI . + +upleft side: + left side; + IF y > y max + THEN up side FI . + +downleft side: + left side; + IF y < y min + THEN down side FI . + +dx: real (to x-from x) . +dy: real (to y-from y) . + +END PROC intersection; + +PROC draw (TEXT CONST text, REAL CONST angle, height, thick) : +INT CONST hoehe :: int(height); + IF akt pen linetype <> 0 + THEN write (""29""); + write (old pos); + write (""31""); + write (size); + write (text); + write(""24"") + FI . + +size: + SELECT hoehe OF + CASE 1 : ""27"4" + CASE 2 : ""27"5" + CASE 3 : ""27"0" + CASE 4 : ""27"1" + CASE 5 : ""27"2" + CASE 6 : ""27"3" + OTHERWISE ""27"0" END SELECT . # Gre 3 fr undefinierte Werte # + +END PROC draw; + +PROC draw (TEXT CONST record) : + draw (record, 0.0, 0.0, 0.0) +END PROC draw; + +OP MOVE (INT CONST x, y) : + write (""29""); + old pos := koordinaten (x,y); + write (old pos); + write (""24""); +END OP MOVE; + +OP DRAW (INT CONST x, y) : + IF akt pen line type = 0 + THEN x MOVE y + ELSE write (""29""); (* plot ein *) + write (colour cmd); + write (old pos); + old pos := koordinaten (x,y); + write (old pos); + write (""24""); (* plot aus *) + FI . + +colour cmd: + IF akt pen = 0 THEN ""27"/1d" # lschend # + ELIF akt pen < 0 THEN ""27"/2d" # XOR # + ELSE ""27"/0" # normal # + FI . + +END OP DRAW; + +TEXT PROC koordinaten (INT CONST x,y): + code(32+((y DIV 32) AND 31)) + code(96+(y MOD 32)) + + code(32+((x DIV 32) AND 31)) + code(64+(x MOD 32)) +END PROC koordinaten; + +END PACKET videostar plot diff --git a/app/mpg/1987/src/ZEICH610.DS b/app/mpg/1987/src/ZEICH610.DS new file mode 100644 index 0000000..c06b5eb Binary files /dev/null and b/app/mpg/1987/src/ZEICH610.DS differ diff --git a/app/mpg/1987/src/ZEICH912.DS b/app/mpg/1987/src/ZEICH912.DS new file mode 100644 index 0000000..fc55473 Binary files /dev/null and b/app/mpg/1987/src/ZEICH912.DS differ diff --git a/app/mpg/1987/src/ZEICHEN.DS b/app/mpg/1987/src/ZEICHEN.DS new file mode 100644 index 0000000..0c4927d Binary files /dev/null and b/app/mpg/1987/src/ZEICHEN.DS differ diff --git a/app/mpg/1987/src/matrix printer b/app/mpg/1987/src/matrix printer new file mode 100644 index 0000000..e5821ff --- /dev/null +++ b/app/mpg/1987/src/matrix printer @@ -0,0 +1,129 @@ +(* Version vom 21.10.87 BJ *) +(* Standardoperationen *) +(* printer line - Linienalgorithmus *) +(* printer fill - Fuellalgorithmus *) + +PROC printer line (INT CONST x1,y1,x2,y2, + PROC (INT CONST, INT CONST) p set pixel): + INT VAR x,y,z, + a,b,d, + dx :: abs(x2-x1), + dy :: abs(y2-y1), + dp,dq; + IF dx <> 0 AND dy <> 0 + THEN IF dy <= dx + THEN draw line 1 + ELSE draw line 2 + FI + ELSE IF dx = 0 AND dy <> 0 + THEN draw vertical line + ELSE draw horizontal line + FI + FI. + + draw line 1: + x := x1; + y := y1; + z := x2; + a := sign(x2-x1); + b := sign(y2-y1); + dp := dy * 2; + d := dp - dx; + dq := dp - 2 * dx; + setpoint; + WHILE x <> z REP + x := x + a; + IF d < 0 + THEN d := d + dp + ELSE y := y + b; + d := d + dq + FI; + setpoint + PER. + + draw line 2: + x := x1; + y := y1; + z := y2; + b := sign(x2-x1); + a := sign(y2-y1); + dp := dx * 2; + d := dp - dy; + dq := dp - 2 * dy; + setpoint; + WHILE y <> z REP + y := y + a; + IF d < 0 + THEN d := d + dp + ELSE x := x + b; + d := d + dq + FI; + setpoint + PER. + + draw vertical line: + a := sign(y2-y1); + x := x1; + y := y1; + z := y2; + setpoint; + WHILE y <> z REP + y := y + a; + setpoint + PER. + + draw horizontal line: + a := sign(x2-x1); + x := x1; + y := y1; + z := x2; + setpoint; + WHILE x <> z REP + x := x + a; + setpoint + PER. + + setpoint: + p set pixel (x,y) +END PROC printer line; + +PROC printer fill (INT CONST xl, xr, y, dir, + BOOL PROC (INT CONST, INT CONST) point, + PROC (INT CONST, INT CONST) pset): + INT VAR xl1 :: xl; + WHILE point(xl1,y) REP + xl1 INCR 1; + IF xl1 >= xr + THEN LEAVE printer fill + FI + PER; + INT VAR xrn :: xl1+1, + xln :: xl1; + WHILE NOT point(xrn,y) REP + pset(xrn,y); + xrn INCR 1 + PER; + WHILE NOT point(xln,y) REP + pset(xln,y); + xln DECR 1 + PER; + IF xrn > xr + THEN printer fill (xr, xrn-1,y-dir,-dir, + BOOL PROC (INT CONST, INT CONST) point, + PROC (INT CONST, INT CONST) pset) + ELSE printer fill (xrn, xr, y, dir, + BOOL PROC (INT CONST, INT CONST) point, + PROC (INT CONST, INT CONST) pset) + FI; + IF xln < xl + THEN printer fill (xln+1,xl, y-dir,-dir, + BOOL PROC (INT CONST, INT CONST) point, + PROC (INT CONST, INT CONST) pset) + ELSE printer fill (xl,xln, y, dir, + BOOL PROC (INT CONST, INT CONST) point, + PROC (INT CONST, INT CONST) pset) + FI; + printer fill(xln+1, xrn-1, y+dir, dir, + BOOL PROC (INT CONST, INT CONST) point, + PROC (INT CONST, INT CONST) pset) +END PROC printer fill; diff --git a/app/mpg/1987/src/std primitives b/app/mpg/1987/src/std primitives new file mode 100644 index 0000000..dca20bd --- /dev/null +++ b/app/mpg/1987/src/std primitives @@ -0,0 +1,79 @@ +PROC std circle (INT CONST xp,yp,r,from,to): + moveto (xp,yp); + REAL VAR ang :: real (from MOD 360), + rad :: real(r), + max :: endwinkel, + cx :: real (xp), + cy :: real (yp), + ax0 :: cx, + ay0 :: cy, + ax1, ay1; + + BOOL VAR fullcircle :: ang = 0.0 AND max = 360.0; + IF fullcircle + THEN move to (int (cx + rad * cosd (ang)+0.5), + int (cy + rad * -sind (ang)+0.5)); + ang INCR 1.0 + FI; + WHILE ang <= max REP + ax1 := cx + rad * cosd (ang); + ay1 := cy + rad * -sind (ang); + draw arc; + ang INCR 1.0 + PER; + IF NOT fullcircle + THEN ax0 := cx; + ay0 := cy; + draw arc; + draw to (xp,yp) + ELSE move to (xp,yp) + FI. + + draw arc: + IF clipped line (ax0,ay0,ax1,ay1) + THEN draw to (int (ax1+0.5), int (ay1+0.5)) + FI; + ax0 := ax1; + ay0 := ay1. + + endwinkel: + IF (to MOD 360) = 0 + THEN 360.0 + ELSE real (to MOD 360) + FI +END PROC std circle; + +PROC std box (INT CONST x0, y0, x1, y1, pattern): + REAL VAR xx0 :: real (x0), + yy0 :: real (y0), + xx1 :: real (x0), + yy1 :: real (y1); + IF clipped line (xx0,yy0,xx1,yy1) + THEN moveto (int (xx0), int (yy0)); + drawto (int (xx1), int (yy1)) + FI; + xx0 := real (x0); + yy0 := real (y1); + xx1 := real (x1); + yy1 := real (y1); + IF clipped line (xx0,yy0,xx1,yy1) + THEN moveto (int (xx0), int (yy0)); + drawto (int (xx1), int (yy1)) + FI; + xx0 := real (x1); + yy0 := real (y1); + xx1 := real (x1); + yy1 := real (y0); + IF clipped line (xx0,yy0,xx1,yy1) + THEN moveto (int (xx0), int (yy0)); + drawto (int (xx1), int (yy1)) + FI; + xx0 := real (x1); + yy0 := real (y0); + xx1 := real (x0); + yy1 := real (y0); + IF clipped line (xx0,yy0,xx1,yy1) + THEN moveto (int (xx0), int (yy0)); + drawto (int (xx1), int (yy1)) + FI +END PROC std box; diff --git a/app/mpg/1987/src/terminal plot b/app/mpg/1987/src/terminal plot new file mode 100644 index 0000000..d4eccbd --- /dev/null +++ b/app/mpg/1987/src/terminal plot @@ -0,0 +1,113 @@ +(* Prozeduren zur Ausgabe auf ASCII-Terminals *) +INT CONST up := 1 , + right := 1 , + down := -1 , + left := -1 ; + +INT VAR x pos := 0 , + y pos := 0 , + new x pos , + new y pos ; + +BOOL VAR plot := FALSE; +TEXT CONST empty line :: 79 * " "; +ROW 24 TEXT VAR display; + + +PROC plot vector (INT CONST dx , dy) : + + IF dx >= 0 + THEN IF dy > dx THEN vector (y pos, x pos, dy, dx, up, right) + ELIF dy > 0 THEN vector (x pos, y pos, dx, dy, right, up) + + ELIF dy > -dx THEN vector (x pos, y pos, dx, -dy, right, down) + ELSE vector (y pos, x pos, -dy, dx, down, right) + FI + ELSE IF dy > -dx THEN vector (y pos, x pos, dy, -dx, up, left) + ELIF dy > 0 THEN vector (x pos, y pos, -dx, dy, left, up) + + ELIF dy > dx THEN vector (x pos, y pos, -dx, -dy, left, down) + ELSE vector (y pos, x pos, -dy, -dx, down, left) + FI + FI . + +ENDPROC plot vector ; + +PROC vector (INT VAR x pos, y pos, INT CONST dx, dy, right, up) : + + prepare first step ; + INT VAR i ; + FOR i FROM 1 UPTO dx REP + do one step + PER . + +prepare first step : + point; + INT VAR old error := 0 , + up right error := dy - dx , + right error := dy . + +do one step : + IF right is better + THEN do right step + ELSE do up right step + FI . + +right is better : + abs (old error + right error) < abs (old error + up right error) . + +do upright step : + x pos INCR right ; + y pos INCR up ; + point ; + old error INCR upright error . + +do right step : + x pos INCR right ; + point ; + old error INCR right error . + +ENDPROC vector ; + + +PROC point : + IF x pos < 1 + THEN x pos := 1 + ELIF x pos > 78 + THEN x pos := 78 FI; + + IF y pos < 1 + THEN y pos := 1 + ELIF y pos > 47 + THEN y pos := 47 FI; + + INT CONST line :: y pos DIV 2; + BOOL CONST above :: (y pos MOD 2) = 1; + TEXT CONST point :: display [line+1] SUB (x pos+1), + new point :: calculated point; + + replace (display [line+1], x pos+1, new point); + cursor (x pos, 24-line); + out (new point) . + +calculated point : + IF above + THEN IF point = "," OR point = "|" + THEN "|" + ELSE "'" FI + ELSE IF point = "'" OR point = "|" + THEN "|" + ELSE "," FI + FI + +END PROC point; + +REAL CONST real max int := real (max int); +INT PROC round (REAL CONST x) : + IF x > real max int + THEN max int + ELIF x < 0.0 + THEN 0 + ELSE int (x + 0.5) FI + +END PROC round; diff --git a/app/speedtest/1986/doc/MEM64180.PRT b/app/speedtest/1986/doc/MEM64180.PRT new file mode 100644 index 0000000..36f495e --- /dev/null +++ b/app/speedtest/1986/doc/MEM64180.PRT @@ -0,0 +1,103 @@ +#type("17.klein")# + BASIS 108 mit 64180, SHARD 8, 64180/6.144 + ========================================= + + +Wiederholungsfaktor fr schnelle Operationen : 32766 +Wiederholungsfaktor fr langsame Operationen : 16384 +Gesamtlaufzeit (CPU): 98.95774 msec + + Steuerkonstrukte + +FOR REP .12208 msec +WHILE REP .11903 msec +UNTIL REP .10682 msec +IF .03968 msec +SELECT .17701 msec +PROC .29299 msec +PROC (INT) .35097 msec +PROC (INT, INT) .40896 msec + --------------- + 1.61754 msec + Integer Operationen + +INT := (Paketdaten) .05188 msec +INT := (Prozedurdaten) .07630 msec +INT := (Parameter) .12818 msec +ROW INT [i] .24416 msec +INT = .06409 msec +INT <= .06409 msec +INT + .07630 msec +INT * .18312 msec +DIV .34487 msec +INCR .05493 msec +MOD .36623 msec +abs (INT) .89727 msec +min (INT , INT) .89117 msec + ---------------- + 3.44259 msec + Real Operationen + +REAL := .07935 msec +ROW REAL [i] .29299 msec +REAL = .18617 msec +REAL <= .13123 msec +REAL + .44864 msec +REAL * 1.36718 msec +REAL / 2.64892 msec +INCR 1.08344 msec +MOD 5.84106 msec +abs (REAL) .99799 msec +min (REAL, REAL) .94610 msec + ----------------- + 14.02307 msec + Text Operationen + +TEXT := (1) .08545 msec +TEXT := (10) .45169 msec +TEXT := (30) .55545 msec +ROW TEXT [i] .30214 msec +TEXT = (1) .10682 msec +TEXT = (10) .35097 msec +TEXT = (30) .58903 msec +TEXT <= (1) .20753 msec +TEXT <= (10) .38454 msec +TEXT <= (30) .61649 msec +TEXT * (Faktor 1) 1.41305 msec +CAT (1) .34792 msec +TEXT + (1) 1.15669 msec +TEXT + (10) 2.22778 msec +TEXT + (30) 2.73437 msec +length (1) .07935 msec +length (10) .07630 msec +length (30) .08240 msec +SUB (1) .17701 msec +SUB (10) .17701 msec +SUB (30) .22890 msec +subtext (TEXT, INT, INT) (1) .22584 msec +subtext (TEXT, INT, INT) (10) .22584 msec +subtext (TEXT, INT, INT) (30) .27773 msec +replace (TEXT, TEXT, INT) (1) .24721 msec +replace (TEXT, TEXT, INT) (10) .24416 msec +replace (TEXT, TEXT, INT) (30) .32045 msec +text (TEXT, INT, INT) (1) 2.45971 msec +text (TEXT, INT, INT) (10) 2.37426 msec +text (TEXT, INT, INT) (30) 2.75268 msec +pos (TEXT, TEXT, INT) (1) .30825 msec +pos (TEXT, TEXT, INT) (10) .32351 msec +pos (TEXT, TEXT, INT) (30) .42422 msec + ---------------- + 22.53475 msec + Konvertierungs Operationen + +int (REAL) 2.21266 msec +real (INT) 1.15058 msec +int (TEXT) 10.32104 msec +text (INT) 1.98376 msec +text (INT, INT) 6.70776 msec +text (REAL) 28.53393 msec +text (REAL, INT, INT) 6.24389 msec +code (INT) .07630 msec +code (TEXT) .10987 msec + ----------------- + 57.33979 msec diff --git a/app/speedtest/1986/doc/MEMATARI.PRT b/app/speedtest/1986/doc/MEMATARI.PRT new file mode 100644 index 0000000..7512919 --- /dev/null +++ b/app/speedtest/1986/doc/MEMATARI.PRT @@ -0,0 +1,101 @@ + ATARI ST 68000-8 + ===================== + + +Wiederholungsfaktor fr schnelle Operationen : 32766 +Wiederholungsfaktor fr langsame Operationen : 16383 + + + Steuerkonstrukte + +FOR REP .64701 msec +WHILE REP .54630 msec +UNTIL REP .43338 msec +IF .31130 msec +SELECT .93389 msec +PROC 1.43441 msec +PROC (INT) 1.67247 msec +PROC (INT, INT) 1.91967 msec + + + Integer Operationen + +INT := (Paketdaten) .36318 msec +INT := (Prozedurdaten) .39370 msec +INT := (Parameter) .58292 msec +ROW INT [i] 1.05597 msec +INT = .43643 msec +INT <= .43643 msec +INT + .50967 msec +INT * .69890 msec +DIV .73857 msec +INCR .39980 msec +MOD .75383 msec +abs (INT) 3.92175 msec +min (INT , INT) 3.86987 msec + + + Real Operationen + +REAL := .38760 msec +ROW REAL [i] 1.06513 msec +REAL = .85149 msec +REAL <= .71721 msec +REAL + .94305 msec +REAL * 2.80168 msec +REAL / 5.93298 msec +INCR 3.35409 msec +MOD 15.60154 msec +abs (REAL) 4.12928 msec +min (REAL, REAL) 3.98584 msec + + + Text Operationen + +TEXT := (1) .56461 msec +TEXT := (10) 1.04376 msec +TEXT := (30) 2.43850 msec +ROW TEXT [i] 1.26350 msec +TEXT = (1) .68974 msec +TEXT = (10) 1.04376 msec +TEXT = (30) 2.26759 msec +TEXT <= (1) 1.08954 msec +TEXT <= (10) 1.17195 msec +TEXT <= (30) 2.39578 msec +TEXT * (Faktor 1) 6.59525 msec +CAT (1) 1.67552 msec +TEXT + (1) 5.10590 msec +TEXT + (10) 7.75194 msec +TEXT + (30) 10.13245 msec +length (1) .48221 msec +length (10) .48221 msec +length (30) .50357 msec +SUB (1) .99188 msec +SUB (10) .98883 msec +SUB (30) 1.47409 msec +subtext (TEXT, INT, INT) (1) 1.13532 msec +subtext (TEXT, INT, INT) (10) 1.13227 msec +subtext (TEXT, INT, INT) (30) 1.61448 msec +replace (TEXT, TEXT, INT) (1) 1.15058 msec +replace (TEXT, TEXT, INT) (10) 1.18721 msec +replace (TEXT, TEXT, INT) (30) 1.73350 msec +text (TEXT, INT, INT) (1) 10.85882 msec +text (TEXT, INT, INT) (10) 10.23012 msec +text (TEXT, INT, INT) (30) 11.81102 msec +pos (TEXT, TEXT, INT) (1) 1.51682 msec +pos (TEXT, TEXT, INT) (10) 1.56565 msec +pos (TEXT, TEXT, INT) (30) 2.35000 msec + + + Konvertierungs Operationen + +int (REAL) 9.87304 msec +real (INT) 5.28597 msec +int (TEXT) 50.36318 msec +text (INT) 5.92077 msec +text (INT, INT) 26.21010 msec +text (REAL) 124.03101 msec +text (REAL, INT, INT) 27.72996 msec +code (INT) .49747 msec +code (TEXT) .65922 msec + diff --git a/app/speedtest/1986/doc/MEMB108.PRT b/app/speedtest/1986/doc/MEMB108.PRT new file mode 100644 index 0000000..ac9527c --- /dev/null +++ b/app/speedtest/1986/doc/MEMB108.PRT @@ -0,0 +1,99 @@ + Basis108 HD64180-6.144 + =========================== + +Wiederholungsfaktor fr schnelle Operationen : 32766 +Wiederholungsfaktor fr langsame Operationen : 16383 + + + Steuerkonstrukte + +FOR REP .17701 msec +WHILE REP .18312 msec +UNTIL REP .14344 msec +IF .08545 msec +SELECT .30214 msec +PROC .48831 msec +PROC (INT) .57682 msec +PROC (INT, INT) .66838 msec + + + Integer Operationen + +INT := (Paketdaten) .10377 msec +INT := (Prozedurdaten) .14344 msec +INT := (Parameter) .21974 msec +ROW INT [i] .38760 msec +INT = .12208 msec +INT <= .12513 msec +INT + .14344 msec +INT * .24721 msec +DIV .57377 msec +INCR .10987 msec +MOD .60734 msec +abs (INT) 1.57480 msec +min (INT , INT) 1.41915 msec + + + Real Operationen + +REAL := .13429 msec +ROW REAL [i] .41506 msec +REAL = .28993 msec +REAL <= .20143 msec +REAL + .70805 msec +REAL * 2.18519 msec +REAL / 4.24220 msec +INCR 1.73350 msec +MOD 9.34505 msec +abs (REAL) 1.55344 msec +min (REAL, REAL) 1.47409 msec + + + Text Operationen + +TEXT := (1) .15565 msec +TEXT := (10) .39980 msec +TEXT := (30) .68058 msec +ROW TEXT [i] .43338 msec +TEXT = (1) .19227 msec +TEXT = (10) .40286 msec +TEXT = (30) .78740 msec +TEXT <= (1) .35708 msec +TEXT <= (10) .44864 msec +TEXT <= (30) .82708 msec +TEXT * (Faktor 1) 2.29201 msec +CAT (1) .57987 msec +TEXT + (1) 1.84948 msec +TEXT + (10) 2.89324 msec +TEXT + (30) 3.16792 msec +length (1) .14649 msec +length (10) .14344 msec +length (30) .15260 msec +SUB (1) .30825 msec +SUB (10) .30825 msec +SUB (30) .39370 msec +subtext (TEXT, INT, INT) (1) .36318 msec +subtext (TEXT, INT, INT) (10) .36318 msec +subtext (TEXT, INT, INT) (30) .44253 msec +replace (TEXT, TEXT, INT) (1) .41201 msec +replace (TEXT, TEXT, INT) (10) .41506 msec +replace (TEXT, TEXT, INT) (30) .53409 msec +text (TEXT, INT, INT) (1) 4.08961 msec +text (TEXT, INT, INT) (10) 3.72337 msec +text (TEXT, INT, INT) (30) 4.05298 msec +pos (TEXT, TEXT, INT) (1) .51578 msec +pos (TEXT, TEXT, INT) (10) .54019 msec +pos (TEXT, TEXT, INT) (30) .66227 msec + + + Konvertierungs Operationen + +int (REAL) 3.59519 msec +real (INT) 1.92272 msec +int (TEXT) 17.15803 msec +text (INT) 1.99902 msec +text (INT, INT) 9.44882 msec +text (REAL) 45.09553 msec +text (REAL, INT, INT) 10.03479 msec +code (INT) .14039 msec +code (TEXT) .19532 msec diff --git a/app/speedtest/1986/doc/MEMB1082.PRT b/app/speedtest/1986/doc/MEMB1082.PRT new file mode 100644 index 0000000..b52bb8a --- /dev/null +++ b/app/speedtest/1986/doc/MEMB1082.PRT @@ -0,0 +1,112 @@ +#type("17.klein")# + Basis108/Urlader #326 HD64180-6.144 10.10.86 + ===================================== + +Wiederholungsfaktor fr schnelle Operationen : 32766 +Wiederholungsfaktor fr langsame Operationen : 16383 + +Anmerkung: In der Version 1.8.0 (Urlader 175 #326) ist der Basis in fast +allen Punkten schneller geworden als mit Urlader 173 #073 (bis zu 40%!). + +Langsamer sind die Vergleichsoperationen bei Texten auf dem Heap und die +Integermultiplikation, sowie abhngige davon (ROW-TEXT Subscript mit mehr +als zwei Elementen), da bei diesem Benchmakr die EUMEL0-INT-Multiplikation +nicht durch den HD64180-Prozessorbefehl MULT ersetzt wurde. + +Der FMOV Befehl (REAL :=) ist schneller als auf der +M24, sowie einige Vergleiche von langen Texten. Der Test auf der M24 war mit +einem V30 Prozessor durchgefhrt worden. + + + Steuerkonstrukte + +FOR REP .17396 msec +WHILE REP .17396 msec +UNTIL REP .14955 msec +IF .05799 msec +SELECT .24721 msec +PROC .41201 msec +PROC (INT) .49441 msec +PROC (INT, INT) .66532 msec + + + Integer Operationen + +INT := (Paketdaten) .07630 msec +INT := (Prozedurdaten) .11292 msec +INT := (Parameter) .18922 msec +ROW INT [i] .34182 msec +INT = .08851 msec +INT <= .09156 msec +INT + .10987 msec +INT * .25942 msec +DIV .48831 msec +INCR .07630 msec +MOD .51578 msec +abs (INT) 1.28792 msec +min (INT , INT) 1.27876 msec + + + Real Operationen + +REAL := .10987 msec (schneller als M24) +ROW REAL [i] .40591 msec +REAL = .25636 msec +REAL <= .17701 msec +REAL + .63175 msec +REAL * 1.93798 msec (schneller als M24) +REAL / 3.75084 msec +INCR 1.55649 msec +MOD 8.37148 msec +abs (REAL) 1.43441 msec +min (REAL, REAL) 1.35812 msec + + + Text Operationen + +TEXT := (1) .11903 msec +TEXT := (10) .64091 msec +TEXT := (30) .59513 msec +ROW TEXT [i] .42727 msec +TEXT = (1) .14955 msec (schneller als M24) +TEXT = (10) .50052 msec +TEXT = (30) .66838 msec (schneller als M24) +TEXT <= (1) .29299 msec +TEXT <= (10) .54019 msec +TEXT <= (30) .71415 msec (schneller als M24) +TEXT * (Faktor 1) 2.03259 msec +CAT (1) .49136 msec +TEXT + (1) 1.66331 msec +TEXT + (10) 2.57889 msec +TEXT + (30) 2.79863 msec +length (1) .10987 msec +length (10) .10987 msec +length (30) .11597 msec +SUB (1) .25026 msec +SUB (10) .25026 msec +SUB (30) .32351 msec +subtext (TEXT, INT, INT) (1) .32045 msec +subtext (TEXT, INT, INT) (10) .32045 msec +subtext (TEXT, INT, INT) (30) .39370 msec +replace (TEXT, TEXT, INT) (1) .34792 msec +replace (TEXT, TEXT, INT) (10) .35097 msec +replace (TEXT, TEXT, INT) (30) .45779 msec +text (TEXT, INT, INT) (1) 3.54331 msec +text (TEXT, INT, INT) (10) 3.40902 msec +text (TEXT, INT, INT) (30) 3.75084 msec +pos (TEXT, TEXT, INT) (1) .43643 msec +pos (TEXT, TEXT, INT) (10) .45779 msec +pos (TEXT, TEXT, INT) (30) .56461 msec + + + Konvertierungs Operationen + +int (REAL) 3.17097 msec +real (INT) 1.65110 msec +int (TEXT) 14.84160 msec +text (INT) 2.84746 msec +text (INT, INT) 9.62888 msec +text (REAL) 41.02728 msec +text (REAL, INT, INT) 8.95746 msec +code (INT) .10682 msec +code (TEXT) .15260 msec diff --git a/app/speedtest/1986/doc/MEMBIC10.PRT b/app/speedtest/1986/doc/MEMBIC10.PRT new file mode 100644 index 0000000..259688d --- /dev/null +++ b/app/speedtest/1986/doc/MEMBIC10.PRT @@ -0,0 +1,100 @@ + BICOS SYSTEM 286/20 80286-10 + =================================== + + +Wiederholungsfaktor fr schnelle Operationen : 32766 +Wiederholungsfaktor fr langsame Operationen : 16383 + + + Steuerkonstrukte + +FOR REP .03357 msec +WHILE REP .02747 msec +UNTIL REP .02442 msec +IF .01221 msec +SELECT .07630 msec +PROC .08240 msec +PROC (INT) .09461 msec +PROC (INT, INT) .10987 msec + + + Integer Operationen + +INT := (Paketdaten) .01526 msec +INT := (Prozedurdaten) .02136 msec +INT := (Parameter) .03357 msec +ROW INT [i] .09766 msec +INT = .02136 msec +INT <= .02136 msec +INT + .01831 msec +INT * .06104 msec +DIV .07019 msec +INCR .01221 msec +MOD .07019 msec +abs (INT) .31435 msec +min (INT , INT) .25331 msec + + + Real Operationen + +REAL := .04273 msec +ROW REAL [i] .12818 msec +REAL = .10071 msec +REAL <= .06714 msec +REAL + .24416 msec +REAL * .92474 msec +REAL / 1.70604 msec +INCR .49441 msec +MOD 3.42733 msec +abs (REAL) .37234 msec +min (REAL, REAL) .33877 msec + + + Text Operationen + +TEXT := (1) .04883 msec +TEXT := (10) .24721 msec +TEXT := (30) .20448 msec +ROW TEXT [i] .14039 msec +TEXT = (1) .06104 msec +TEXT = (10) .20753 msec +TEXT = (30) .31740 msec +TEXT <= (1) .10987 msec +TEXT <= (10) .21669 msec +TEXT <= (30) .32656 msec +TEXT * (Faktor 1) .49747 msec +CAT (1) .18312 msec +TEXT + (1) .45169 msec +TEXT + (10) .74162 msec +TEXT + (30) .77825 msec +length (1) .04273 msec +length (10) .04273 msec +length (30) .04273 msec +SUB (1) .09461 msec +SUB (10) .09156 msec +SUB (30) .12208 msec +subtext (TEXT, INT, INT) (1) .11597 msec +subtext (TEXT, INT, INT) (10) .11597 msec +subtext (TEXT, INT, INT) (30) .14344 msec +replace (TEXT, TEXT, INT) (1) .12208 msec +replace (TEXT, TEXT, INT) (10) .12208 msec +replace (TEXT, TEXT, INT) (30) .15565 msec +text (TEXT, INT, INT) (1) .80877 msec +text (TEXT, INT, INT) (10) .83928 msec +text (TEXT, INT, INT) (30) .96136 msec +pos (TEXT, TEXT, INT) (1) .15870 msec +pos (TEXT, TEXT, INT) (10) .16480 msec +pos (TEXT, TEXT, INT) (30) .20143 msec + + + Konvertierungs Operationen + +int (REAL) .79045 msec +real (INT) .35708 msec +int (TEXT) 4.05603 msec +text (INT) .61649 msec +text (INT, INT) 2.32253 msec +text (REAL) 12.34511 msec +text (REAL, INT, INT) 2.25539 msec +code (INT) .03968 msec +code (TEXT) .05493 msec diff --git a/app/speedtest/1986/doc/MEMBIC8.PRT b/app/speedtest/1986/doc/MEMBIC8.PRT new file mode 100644 index 0000000..315e1c2 --- /dev/null +++ b/app/speedtest/1986/doc/MEMBIC8.PRT @@ -0,0 +1,101 @@ + BICOS 286/20 INTEL80286-8 + ========================================== + + +Wiederholungsfaktor fr schnelle Operationen : 32766 +Wiederholungsfaktor fr langsame Operationen : 16383 + + + Steuerkonstrukte + +FOR REP .04273 msec +WHILE REP .03968 msec +UNTIL REP .03357 msec +IF .01831 msec +SELECT .10071 msec +PROC .10377 msec +PROC (INT) .12208 msec +PROC (INT, INT) .13734 msec + + + Integer Operationen + +INT := (Paketdaten) .01831 msec +INT := (Prozedurdaten) .02442 msec +INT := (Parameter) .04273 msec +ROW INT [i] .12513 msec +INT = .02442 msec +INT <= .02136 msec +INT + .02442 msec +INT * .07935 msec +DIV .08545 msec +INCR .01831 msec +MOD .08545 msec +abs (INT) .39980 msec +min (INT , INT) .32045 msec + + + Real Operationen + +REAL := .05188 msec +ROW REAL [i] .16480 msec +REAL = .12208 msec +REAL <= .08240 msec +REAL + .30825 msec +REAL * 1.17805 msec +REAL / 2.16688 msec +INCR .63175 msec +MOD 4.30324 msec +abs (REAL) .47000 msec +min (REAL, REAL) .42117 msec + + + Text Operationen + +TEXT := (1) .06104 msec +TEXT := (10) .30519 msec +TEXT := (30) .25636 msec +ROW TEXT [i] .17396 msec +TEXT = (1) .07935 msec +TEXT = (10) .25636 msec +TEXT = (30) .39675 msec +TEXT <= (1) .13734 msec +TEXT <= (10) .26857 msec +TEXT <= (30) .40896 msec +TEXT * (Faktor 1) .61954 msec +CAT (1) .22890 msec +TEXT + (1) .57377 msec +TEXT + (10) .93389 msec +TEXT + (30) .98883 msec +length (1) .04883 msec +length (10) .05188 msec +length (30) .05188 msec +SUB (1) .11903 msec +SUB (10) .11903 msec +SUB (30) .15565 msec +subtext (TEXT, INT, INT) (1) .14344 msec +subtext (TEXT, INT, INT) (10) .14955 msec +subtext (TEXT, INT, INT) (30) .18006 msec +replace (TEXT, TEXT, INT) (1) .15565 msec +replace (TEXT, TEXT, INT) (10) .15565 msec +replace (TEXT, TEXT, INT) (30) .19532 msec +text (TEXT, INT, INT) (1) 1.02545 msec +text (TEXT, INT, INT) (10) 1.06208 msec +text (TEXT, INT, INT) (30) 1.21467 msec +pos (TEXT, TEXT, INT) (1) .20143 msec +pos (TEXT, TEXT, INT) (10) .21058 msec +pos (TEXT, TEXT, INT) (30) .25331 msec + + + Konvertierungs Operationen + +int (REAL) .99799 msec +real (INT) .44864 msec +int (TEXT) 5.13947 msec +text (INT) .78130 msec +text (INT, INT) 2.93597 msec +text (REAL) 15.58323 msec +text (REAL, INT, INT) 2.85662 msec +code (INT) .04883 msec +code (TEXT) .07019 msec + diff --git a/app/speedtest/1986/doc/MEMCLA15.PRT b/app/speedtest/1986/doc/MEMCLA15.PRT new file mode 100644 index 0000000..cd9213e --- /dev/null +++ b/app/speedtest/1986/doc/MEMCLA15.PRT @@ -0,0 +1,100 @@ + + Classis AT 15 MHz / 80286 + ========================= + +Wiederholungsfaktor fr schnelle Operationen : 32766 +Wiederholungsfaktor fr langsame Operationen : 16383 + + + Steuerkonstrukte + +FOR REP .02442 msec +WHILE REP .02136 msec +UNTIL REP .01831 msec +IF .00916 msec +SELECT .04883 msec +PROC .05188 msec +PROC (INT) .06104 msec +PROC (INT, INT) .06714 msec + + + Integer Operationen + +INT := (Paketdaten) .00610 msec +INT := (Prozedurdaten) .01221 msec +INT := (Parameter) .02136 msec +ROW INT [i] .06104 msec +INT = .00916 msec +INT <= .00916 msec +INT + .00916 msec +INT * .03662 msec +DIV .04273 msec +INCR .00916 msec +MOD .04273 msec +abs (INT) .18006 msec +min (INT , INT) .16786 msec + + + Real Operationen + +REAL := .02442 msec +ROW REAL [i] .08240 msec +REAL = .07019 msec +REAL <= .04883 msec +REAL + .16786 msec +REAL * .62260 msec +REAL / 1.12312 msec +INCR .33571 msec +MOD 2.29506 msec +abs (REAL) .25331 msec +min (REAL, REAL) .22584 msec + + + Text Operationen + +TEXT := (1) .03052 msec +TEXT := (10) .15870 msec +TEXT := (30) .13429 msec +ROW TEXT [i] .09156 msec +TEXT = (1) .03968 msec +TEXT = (10) .13734 msec +TEXT = (30) .21058 msec +TEXT <= (1) .07325 msec +TEXT <= (10) .14039 msec +TEXT <= (30) .21364 msec +TEXT * (Faktor 1) .32656 msec +CAT (1) .11903 msec +TEXT + (1) .30214 msec +TEXT + (10) .49441 msec +TEXT + (30) .51883 msec +length (1) .02442 msec +length (10) .02442 msec +length (30) .02442 msec +SUB (1) .06104 msec +SUB (10) .06104 msec +SUB (30) .08240 msec +subtext (TEXT, INT, INT) (1) .07630 msec +subtext (TEXT, INT, INT) (10) .07630 msec +subtext (TEXT, INT, INT) (30) .09156 msec +replace (TEXT, TEXT, INT) (1) .07935 msec +replace (TEXT, TEXT, INT) (10) .07935 msec +replace (TEXT, TEXT, INT) (30) .10377 msec +text (TEXT, INT, INT) (1) .54325 msec +text (TEXT, INT, INT) (10) .55545 msec +text (TEXT, INT, INT) (30) .63480 msec +pos (TEXT, TEXT, INT) (1) .10071 msec +pos (TEXT, TEXT, INT) (10) .10682 msec +pos (TEXT, TEXT, INT) (30) .13123 msec + + + Konvertierungs Operationen + +int (REAL) .54630 msec +real (INT) .23500 msec +int (TEXT) 2.72844 msec +text (INT) .41506 msec +text (INT, INT) 1.55039 msec +text (REAL) 8.32570 msec +text (REAL, INT, INT) 1.56870 msec +code (INT) .02747 msec +code (TEXT) .03357 msec diff --git a/app/speedtest/1986/doc/MEMRUC12.PRT b/app/speedtest/1986/doc/MEMRUC12.PRT new file mode 100644 index 0000000..b9a8225 --- /dev/null +++ b/app/speedtest/1986/doc/MEMRUC12.PRT @@ -0,0 +1,101 @@ +#type ("17.klein")# + ruc-AT 80286/12 MHz + ======================== + + +Wiederholungsfaktor fr schnelle Operationen : 32766 +Wiederholungsfaktor fr langsame Operationen : 16383 + + + Steuerkonstrukte + +FOR REP .03052 msec +WHILE REP .03052 msec +UNTIL REP .02747 msec +IF .01221 msec +SELECT .06409 msec +PROC .06714 msec +PROC (INT) .07935 msec +PROC (INT, INT) .08851 msec + + + Integer Operationen + +INT := (Paketdaten) .00916 msec +INT := (Prozedurdaten) .01221 msec +INT := (Parameter) .02747 msec +ROW INT [i] .07935 msec +INT = .01526 msec +INT <= .01221 msec +INT + .01221 msec +INT * .04883 msec +DIV .05493 msec +INCR .00916 msec +MOD .05799 msec +abs (INT) .22584 msec +min (INT , INT) .21364 msec + + + Real Operationen + +REAL := .03052 msec +ROW REAL [i] .10682 msec +REAL = .08851 msec +REAL <= .06409 msec +REAL + .21058 msec +REAL * .79351 msec +REAL / 1.42831 msec +INCR .42727 msec +MOD 2.91155 msec +abs (REAL) .32045 msec +min (REAL, REAL) .28383 msec + + + Text Operationen + +TEXT := (1) .03968 msec +TEXT := (10) .20143 msec +TEXT := (30) .16786 msec +ROW TEXT [i] .11292 msec +TEXT = (1) .04883 msec +TEXT = (10) .17091 msec +TEXT = (30) .26552 msec +TEXT <= (1) .08851 msec +TEXT <= (10) .18006 msec +TEXT <= (30) .27162 msec +TEXT * (Faktor 1) .42422 msec +CAT (1) .14955 msec +TEXT + (1) .38149 msec +TEXT + (10) .62260 msec +TEXT + (30) .66532 msec +length (1) .03357 msec +length (10) .03357 msec +length (30) .03357 msec +SUB (1) .07630 msec +SUB (10) .07630 msec +SUB (30) .09766 msec +subtext (TEXT, INT, INT) (1) .09766 msec +subtext (TEXT, INT, INT) (10) .09461 msec +subtext (TEXT, INT, INT) (30) .11903 msec +replace (TEXT, TEXT, INT) (1) .10377 msec +replace (TEXT, TEXT, INT) (10) .10071 msec +replace (TEXT, TEXT, INT) (30) .13123 msec +text (TEXT, INT, INT) (1) .68974 msec +text (TEXT, INT, INT) (10) .71415 msec +text (TEXT, INT, INT) (30) .81182 msec +pos (TEXT, TEXT, INT) (1) .12818 msec +pos (TEXT, TEXT, INT) (10) .13429 msec +pos (TEXT, TEXT, INT) (30) .16786 msec + + + Konvertierungs Operationen + +int (REAL) .69279 msec +real (INT) .29909 msec +int (TEXT) 3.45480 msec +text (INT) .52799 msec +text (INT, INT) 1.95935 msec +text (REAL) 10.56583 msec +text (REAL, INT, INT) 1.98376 msec +code (INT) .03357 msec +code (TEXT) .04883 msec diff --git a/app/speedtest/1986/doc/MEMV30.PRT b/app/speedtest/1986/doc/MEMV30.PRT new file mode 100644 index 0000000..0d259be --- /dev/null +++ b/app/speedtest/1986/doc/MEMV30.PRT @@ -0,0 +1,100 @@ + M 24 mit V 30 V 30 /8Mhz + ============================= + + +Wiederholungsfaktor fr schnelle Operationen : 32766 +Wiederholungsfaktor fr langsame Operationen : 16383 + + + Steuerkonstrukte + +FOR REP .07325 msec +WHILE REP .07019 msec +UNTIL REP .06409 msec +IF .03968 msec +SELECT .18006 msec +PROC .18312 msec +PROC (INT) .21058 msec +PROC (INT, INT) .24416 msec + + + Integer Operationen + +INT := (Paketdaten) .03052 msec +INT := (Prozedurdaten) .04273 msec +INT := (Parameter) .07325 msec +ROW INT [i] .20143 msec +INT = .04273 msec +INT <= .03968 msec +INT + .04273 msec +INT * .12513 msec +DIV .13734 msec +INCR .03052 msec +MOD .13734 msec +abs (INT) .58292 msec +min (INT , INT) .54325 msec + + + Real Operationen + +REAL := .13123 msec +ROW REAL [i] .26857 msec +REAL = .20143 msec +REAL <= .14039 msec +REAL + .51273 msec +REAL * 2.10584 msec +REAL / 3.72337 msec +INCR 1.11091 msec +MOD 7.51389 msec +abs (REAL) .77825 msec +min (REAL, REAL) .70500 msec + + + Text Operationen + +TEXT := (1) .10071 msec +TEXT := (10) .48526 msec +TEXT := (30) .55545 msec +ROW TEXT [i] .28078 msec +TEXT = (1) .17701 msec +TEXT = (10) .40896 msec +TEXT = (30) .75078 msec +TEXT <= (1) .21974 msec +TEXT <= (10) .42727 msec +TEXT <= (30) .77214 msec +TEXT * (Faktor 1) 1.03766 msec +CAT (1) .36929 msec +TEXT + (1) .95221 msec +TEXT + (10) 1.69688 msec +TEXT + (30) 1.94104 msec +length (1) .08545 msec +length (10) .08545 msec +length (30) .08851 msec +SUB (1) .18922 msec +SUB (10) .18922 msec +SUB (30) .26247 msec +subtext (TEXT, INT, INT) (1) .24110 msec +subtext (TEXT, INT, INT) (10) .23805 msec +subtext (TEXT, INT, INT) (30) .29299 msec +replace (TEXT, TEXT, INT) (1) .24721 msec +replace (TEXT, TEXT, INT) (10) .24721 msec +replace (TEXT, TEXT, INT) (30) .32656 msec +text (TEXT, INT, INT) (1) 1.72740 msec +text (TEXT, INT, INT) (10) 1.77013 msec +text (TEXT, INT, INT) (30) 2.27675 msec +pos (TEXT, TEXT, INT) (1) .32351 msec +pos (TEXT, TEXT, INT) (10) .33266 msec +pos (TEXT, TEXT, INT) (30) .40591 msec + + + Konvertierungs Operationen + +int (REAL) 1.68467 msec +real (INT) .75993 msec +int (TEXT) 8.32570 msec +text (INT) .93389 msec +text (INT, INT) 4.52298 msec +text (REAL) 26.61295 msec +text (REAL, INT, INT) 5.20662 msec +code (INT) .08240 msec +code (TEXT) .11292 msec diff --git a/app/speedtest/1986/src/convert operation b/app/speedtest/1986/src/convert operation new file mode 100644 index 0000000..903f2e5 --- /dev/null +++ b/app/speedtest/1986/src/convert operation @@ -0,0 +1,396 @@ +PACKET convert DEFINES real to int, + int to real, + text to int, + int to text, + int to text 2, + real to text, + real to text 2, + code int, + code text : + + +(***************************************************************************) +(* *) +(* Autor: A. Steinmann Copyright (C): HRZ - Unibi *) +(* *) +(***************************************************************************) + + +INT VAR index, + first int, + i ; + + +REAL VAR begin, + end, + act result, + first real ; + + +TEXT VAR single text :: "*", + free text ; + + + + +PROC real to int (INT CONST frequency) : + + first real := 1.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + i := int (first real) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + real to int s (frequency) + +END PROC real to int ; + + + + +PROC real to int s (INT CONST frequency) : + + first real := 1.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + i := int (first real) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("int (REAL)", act result * msec factor (frequency) - for corr) + +END PROC real to int s ; + + + + +PROC int to real (INT CONST frequency) : + + first int := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first real := real (first int) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + int to real s (frequency) + +END PROC int to real ; + + + + +PROC int to real s (INT CONST frequency) : + + first int := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first real := real (first int) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("real (INT)", act result * msec factor (frequency) - for corr) + +END PROC int to real s ; + + + + +PROC text to int (INT CONST frequency) : + + free text := "1111" ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int := int (free text) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text to int s (frequency) + +END PROC text to int ; + + + + +PROC text to int s (INT CONST frequency) : + + free text := "1111" ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int := int (free text) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("int (TEXT)", act result * msec factor (frequency) - for corr) + +END PROC text to int s ; + + + + +PROC int to text (INT CONST frequency) : + + first int := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := text (first int) ; + END REP ; + end := clock (0) ; + + act result := end - begin ; + + int to text s (frequency) + +END PROC int to text ; + + + + +PROC int to text s (INT CONST frequency) : + + first int := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := text (first int) ; + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("text (INT)", act result * msec factor (frequency) - for corr) + +END PROC int to text s ; + + + + +PROC int to text 2 (INT CONST frequency) : + + first int := 1 ; + i := 3 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := text (first int, i) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + int to text 2 s (frequency) + +END PROC int to text 2 ; + + + + +PROC int to text 2 s (INT CONST frequency) : + + first int := 1 ; + i := 3 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := text (first int, i) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("text (INT, INT)", act result * msec factor (frequency) - for corr) + +END PROC int to text 2 s ; + + + + +PROC real to text (INT CONST frequency) : + + first real := 1.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := text (first real) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + real to text s (frequency) + +END PROC real to text ; + + + + +PROC real to text s (INT CONST frequency) : + + first real := 1.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := text (first real) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("text (REAL)", act result * msec factor (frequency) - for corr) + +END PROC real to text s ; + + + + +PROC real to text 2 (INT CONST frequency) : + + first real := 1.0 ; + i := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := text (first real, i, i) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + real to text 2 s (frequency) + +END PROC real to text 2 ; + + + + +PROC real to text 2 s (INT CONST frequency) : + + first real := 1.0 ; + i := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := text (first real, i, i) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("text (REAL, INT, INT)", act result * msec factor (frequency) - for corr) + +END PROC real to text 2 s ; + + + + +PROC code int (INT CONST frequency) : + + i := 65 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := code (i) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + code int s (frequency) + +END PROC code int ; + + + + +PROC code int s (INT CONST frequency) : + + i := 65 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := code (i) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("code (INT)", act result * msec factor (frequency) - for corr) + +END PROC code int s ; + + + + +PROC code text (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int := code (single text) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + code text s (frequency) + +END PROC code text ; + + + + +PROC code text s (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int := code (single text) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("code (TEXT)", act result * msec factor (frequency) - for corr) + +END PROC code text s ; + + +END PACKET convert ; diff --git a/app/speedtest/1986/src/gen.benchmark b/app/speedtest/1986/src/gen.benchmark new file mode 100644 index 0000000..bb53ecc --- /dev/null +++ b/app/speedtest/1986/src/gen.benchmark @@ -0,0 +1,98 @@ +(***************************************************************************) +(* *) +(* Autor: A. Steinmann Copyright (C): HRZ - Unibi *) +(* *) +(***************************************************************************) + + +LET max quantity = 99, + pagelength = 20 ; + +ROW max quantity TEXT VAR prog list ; + +INT VAR prog counter :: 0, + namelength :: 0, + counter, + storage size, + used storage ; + + + +PROC announce (TEXT CONST prog name) : + + prog counter INCR 1 ; + prog list [prog counter] := prog name ; + IF NOT exists (prog name) + THEN fetch (prog name, archive) + FI ; + IF LENGTH prog name > namelength + THEN namelength := LENGTH prog name + FI ; + +END PROC announce ; + + + +PROC execute : + + INT CONST first page :: 1, + last page :: (prog counter DIV pagelength) + 1 ; + + INT VAR pagenumber, + linenumber, + act linenumber, + act first line, + act last line ; + + FOR page number FROM first page UPTO last page + REP act first line := (pagenumber - 1) * pagelength + 1 ; + act last line := min (prog counter, pagenumber * pagelength) ; + FOR act line number FROM act first line UPTO act last line + REP display (""1""4"") ; + display (" Stand der Benchmark Insertierung ") ; + IF last page > 1 + THEN display ("(" + text (pagenumber) + ". von " + text (last page) + " Seiten) :") + ELSE display (":") + FI ; + display (""13""10""13""10"") ; + FOR linenumber FROM act first line UPTO act last line + REP IF linenumber = act linenumber + THEN display (" " + ""15""8"" + prog list [linenumber] + ""14""8""5"") + ELSE display (" " + prog list [linenumber] + ""5"") + FI ; + display (""13""10"") + PER ; + display (""6"" + code (act linenumber - act first line + 2) + code (namelength + 20)) ; + insert (prog list [act linenumber]) ; + #forget (prog list [act linenumber], quiet)# + PER + PER ; + display (""1""4"") ; + display ("Insertierung abgeschlossen!") ; + display (""13""10"") ; + IF yes ("Benchmark starten") + THEN do ("test speed") + FI ; + +END PROC execute ; + + + +check off ; +announce ("notice") ; +announce ("run down logic") ; +announce ("integer operation") ; +announce ("real operation") ; +announce ("text operation") ; +announce ("convert operation") ; +announce ("speed tester") ; + + +display (""1""4"") ; +execute ; +release (archive) ; +#forget ("gen.benchmark", quiet) ;# +check on ; + + + diff --git a/app/speedtest/1986/src/integer operation b/app/speedtest/1986/src/integer operation new file mode 100644 index 0000000..90ef0f2 --- /dev/null +++ b/app/speedtest/1986/src/integer operation @@ -0,0 +1,614 @@ +PACKET integer operation DEFINES int assign global, + int assign local, + int assign param, + int equal, + int lequal, + int abs, + int min, + int incr, + row int, + int div, + int mod, + int add, + int mult : + + +(***************************************************************************) +(* *) +(* Autor: A. Steinmann Copyright (C): HRZ - Unibi *) +(* *) +(***************************************************************************) + + +ROW 10 INT VAR introw ; + + +REAL VAR begin, + end, + act result, + int assign factor ; + + +INT VAR first int, + second int, + third int, + rest, + i , + index ; + + + +PROC int assign global (INT CONST frequency) : + + first int := 0 ; + second int := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int := second int + END REP ; + end := clock (0); + + act result := end - begin ; + + int assign global s (frequency) + +END PROC int assign global ; + + + + +PROC int assign global s (INT CONST frequency) : + + first int := 0 ; + second int := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int := second int + END REP ; + end := clock (0); + + IF act result > end - begin + THEN act result := end - begin + FI ; + + int assign factor := act result * msec factor (frequency) - for corr ; + + notice result ("INT := (Paketdaten)", int assign factor) ; + +END PROC int assign global s ; + + + + +PROC int assign local (INT CONST frequency) : + + INT VAR number one :: 0, + number two :: 1 ; + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + number one := number two + END REP ; + end := clock (0); + + act result := end - begin ; + + int assign local s (frequency) + +END PROC int assign local ; + + + + +PROC int assign local s (INT CONST frequency) : + + INT VAR number one :: 0, + number two :: 1 ; + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + number one := number two + END REP ; + end := clock (0); + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("INT := (Prozedurdaten)", act result * msec factor (frequency) - for corr) ; + +END PROC int assign local s ; + + + + +PROC int assign param (INT CONST frequency) : + + first int := 0 ; + second int := 1 ; + int assign (first int, second int, frequency) ; + first int := 0 ; + int assign s (first int, second int, frequency) + +END PROC int assign param ; + + + + +PROC int assign (INT VAR one, INT CONST two, frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + one := two + END REP ; + end := clock (0) ; + + act result := end - begin ; + +END PROC int assign ; + + + + +PROC int assign s (INT VAR one, INT CONST two, frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + one := two + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("INT := (Parameter)", act result * msec factor (frequency) - for corr) ; + +END PROC int assign s ; + + + + +PROC row int (INT CONST frequency) : + + i := 7 ; + int row [i] := 0 ; + first int := 10000 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + introw [i] := first int + END REP ; + end := clock (0) ; + + act result := end - begin ; + + row int s (frequency) + +END PROC row int ; + + + + +PROC row int s (INT CONST frequency) : + + i := 7 ; + int row [i] := 0 ; + first int := 10000 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + introw [i] := first int + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("ROW INT [i]", act result * msec factor (frequency) - for corr) ; + +END PROC row int s ; + + + + +PROC int equal (INT CONST frequency) : + + first int := 10 ; + second int := 10 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF first int = second int + THEN + FI + END REP ; + end := clock (0) ; + + act result := end - begin ; + + int equal s (frequency) + +END PROC int equal ; + + + + +PROC int equal s (INT CONST frequency) : + + first int := 10 ; + second int := 10 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF first int = second int + THEN + FI + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("INT =", act result * msec factor (frequency) - for corr) + +END PROC int equal s ; + + + + +PROC int lequal (INT CONST frequency) : + + first int := 10 ; + second int := 11 ; + begin := clock(0) ; + FOR index FROM 1 UPTO frequency + REP + IF first int <= second int + THEN + FI + END REP ; + end := clock (0) ; + + act result := end - begin ; + + int lequal s (frequency) + +END PROC int lequal ; + + + + +PROC int lequal s (INT CONST frequency) : + + first int := 10 ; + second int := 11 ; + begin := clock(0) ; + FOR index FROM 1 UPTO frequency + REP + IF first int <= second int + THEN + FI + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("INT <=", act result * msec factor (frequency) - for corr) + +END PROC int lequal s ; + + + + +PROC int add (INT CONST frequency) : + + first int := 0 ; + second int := 1 ; + third int := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int := second int + third int + END REP ; + end := clock (0) ; + + act result := end - begin ; + + int add s (frequency) + +END PROC int add ; + + + + +PROC int add s (INT CONST frequency) : + + first int := 0 ; + second int := 1 ; + third int := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int := second int + third int + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("INT +", act result * msec factor (frequency) - for corr) + +END PROC int add s ; + + + + +PROC int mult (INT CONST frequency) : + + first int := 0 ; + second int := 99 ; + third int := 11 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int := second int * third int + END REP ; + end := clock (0) ; + + act result := end - begin ; + + int mult s (frequency) + +END PROC int mult ; + + + + +PROC int mult s (INT CONST frequency) : + + first int := 0 ; + second int := 99 ; + third int := 11 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int := second int * third int + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("INT *", act result * msec factor (frequency) - for corr) + +END PROC int mult s ; + + + + +PROC int div (INT CONST frequency) : + + first int := 0 ; + second int := 10001 ; + third int := 99 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int := second int DIV third int + END REP ; + end := clock (0) ; + + act result := end - begin ; + + int div s (frequency) + +END PROC int div ; + + + + +PROC int div s (INT CONST frequency) : + + first int := 0 ; + second int := 10001 ; + third int := 99 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int := second int DIV third int + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("DIV", act result * msec factor (frequency) - for corr) + +END PROC int div s ; + + + + +PROC int mod (INT CONST frequency) : + + first int := 9999 ; + second int := 55 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + rest := first int MOD second int + END REP ; + end := clock (0) ; + + act result := end - begin ; + + int mod s (frequency) + +END PROC int mod ; + + + + +PROC int mod s (INT CONST frequency) : + + first int := 9999 ; + second int := 55 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + rest := first int MOD second int + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("MOD", act result * msec factor (frequency) - for corr) + +END PROC int mod s ; + + + + +PROC int incr (INT CONST frequency) : + + first int:= 0 ; + second int := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int INCR second int + END REP ; + end := clock (0) ; + + act result := end - begin ; + + int incr s (frequency) + +END PROC int incr ; + + + + +PROC int incr s (INT CONST frequency) : + + first int:= 0 ; + second int := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int INCR second int + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("INCR" , act result * msec factor (frequency) - for corr) ; + +END PROC int incr s ; + + + + +PROC int abs (INT CONST frequency) : + + first int := - 10000 ; + second int := 0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + second int := abs (first int) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + int abs s (frequency) + +END PROC int abs ; + + + + +PROC int abs s (INT CONST frequency) : + + first int := - 10000 ; + second int := 0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + second int := abs (first int) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("abs (INT)", act result * msec factor (frequency) - for corr) ; + +END PROC int abs s ; + + + + +PROC int min (INT CONST frequency) : + + i := 0 ; + first int := 9999 ; + second int := 10000 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + i := min (first int, second int) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + int min s (frequency) + +END PROC int min ; + + + + +PROC int min s (INT CONST frequency) : + + i := 0 ; + first int := 9999 ; + second int := 10000 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + i := min (first int, second int) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("min (INT , INT)", act result * msec factor (frequency) - for corr) ; + +END PROC int min s ; + + +END PACKET integer operation ; diff --git a/app/speedtest/1986/src/notice b/app/speedtest/1986/src/notice new file mode 100644 index 0000000..ea1bca9 --- /dev/null +++ b/app/speedtest/1986/src/notice @@ -0,0 +1,102 @@ +PACKET notice DEFINES notice material, + notice heading, + notice operation, + notice result, + notice frequency, + notice runtime, + output mem : + + +(***************************************************************************) +(* *) +(* Autor: A. Steinmann Copyright (C): HRZ - Unibi *) +(* *) +(***************************************************************************) + + +FILE VAR mem ; + + + +PROC notice result (TEXT CONST operation, REAL CONST runtime) : + + TEXT VAR layout :: "" ; + + layout CAT (operation + (40 - LENGTH operation) * " " + text (runtime, 10, 5) + " msec") ; + putline (mem, layout) + +END PROC notice result ; + + + +PROC notice material (TEXT CONST name) : + + TEXT VAR layout :: "" ; + + layout CAT (" " + name) ; + line (mem, 4) ; + putline (mem, layout) ; + layout := " " + LENGTH name * "=" ; + putline (mem, layout) ; + line (mem, 3) + +END PROC notice material ; + + + +PROC notice heading (TEXT CONST name) : + + TEXT VAR layout :: "" ; + + layout CAT (" " + name) ; + line (mem,2) ; + putline (mem, layout) ; + line (mem, 1) ; + + display (""6""+code(21)+code(0)) ; + display (""5""13"") ; + display (""15""+" "+name+" "+""14"") + +END PROC notice heading ; + + + +PROC notice frequency (INT CONST frequency 1, frequency 2) : + + line (mem, 1) ; + put (mem, "Wiederholungsfaktor fr schnelle Operationen : "+text (frequency 1)) ; + line (mem, 1) ; + put (mem, "Wiederholungsfaktor fr langsame Operationen : "+text (frequency 2)) ; + line (mem, 1) + +END PROC notice frequency ; + + + +PROC notice operation (TEXT CONST operation) : + + display(""6""+code(22)+code(0)) ; + display (""5""13"") ; + display (""15""+" "+ operation +" "+""14"") ; + +END PROC notice operation ; + + + +PROC notice runtime (REAL CONST runtime) : + + line (mem, 3) ; + putline (mem, "Gesamtlaufzeit : " + text (runtime)) ; + +END PROC notice runtime ; + + + +PROC output mem : + + mem := sequential file (output, "memory") + +END PROC output mem ; + + +END PACKET notice ; diff --git a/app/speedtest/1986/src/real operation b/app/speedtest/1986/src/real operation new file mode 100644 index 0000000..2d63d1b --- /dev/null +++ b/app/speedtest/1986/src/real operation @@ -0,0 +1,519 @@ +PACKET real operation DEFINES real assign, + row real, + real add, + real mult, + real div, + real incr, + real mod, + real equal, + real lequal, + real abs, + real min : + + +(***************************************************************************) +(* *) +(* Autor: A. Steinmann Copyright (C): HRZ - Unibi *) +(* *) +(***************************************************************************) + + +ROW 10 REAL VAR real row ; + + + +INT VAR index, + i ; + + +REAL VAR begin, + end, + first real, + second real, + third real, + rest, + act result, + real assign factor ; + + + + +PROC real assign (INT CONST frequency) : + + first real := 0.0 ; + second real := 1.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first real := second real + END REP ; + end := clock (0) ; + + act result := end - begin ; + + real assign s (frequency) + +END PROC real assign ; + + + + +PROC real assign s (INT CONST frequency) : + + first real := 0.0 ; + second real := 1.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first real := second real + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + real assign factor := act result * msec factor (frequency) - for corr ; + + notice result ("REAL :=", real assign factor) ; + +END PROC real assign s ; + + + + +PROC row real (INT CONST frequency) : + + first real := 1.0 ; + i := 7 ; + real row [i] := 0.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + real row [i] := first real + END REP ; + end := clock (0) ; + + act result := end - begin ; + + row real s (frequency) + +END PROC row real ; + + + + +PROC row real s (INT CONST frequency) : + + first real := 1.0 ; + i := 7 ; + real row [i] := 0.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + real row [i] := first real + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("ROW REAL [i]", act result * msec factor (frequency) - for corr) ; + +END PROC row real s ; + + + + +PROC real equal (INT CONST frequency) : + + first real := 10.0 ; + second real := 10.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF first real = second real + THEN + FI + END REP ; + end := clock (0) ; + + act result := end - begin ; + + real equal s (frequency) + +END PROC real equal ; + + + + +PROC real equal s (INT CONST frequency) : + + first real := 10.0 ; + second real := 10.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF first real = second real + THEN + FI + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("REAL =", act result * msec factor (frequency) - for corr) + +END PROC real equal s ; + + + + +PROC real lequal (INT CONST frequency) : + + first real := 10.0 ; + second real := 11.0 ; + begin := clock(0) ; + FOR index FROM 1 UPTO frequency + REP + IF first real <= second real + THEN + FI + END REP ; + end := clock (0) ; + + act result := end - begin ; + + real lequal s (frequency) + +END PROC real lequal ; + + + + +PROC real lequal s (INT CONST frequency) : + + first real := 10.0 ; + second real := 11.0 ; + begin := clock(0) ; + FOR index FROM 1 UPTO frequency + REP + IF first real <= second real + THEN + FI + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("REAL <=", act result * msec factor (frequency) - for corr) + +END PROC real lequal s ; + + + + +PROC real add (INT CONST frequency) : + + first real := 0.0 ; + second real := 1.0 ; + third real := 1.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first real := second real + third real + END REP ; + end := clock (0) ; + + act result := end - begin ; + + real add s (frequency) + +END PROC real add ; + + + + +PROC real add s (INT CONST frequency) : + + first real := 0.0 ; + second real := 1.0 ; + third real := 1.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first real := second real + third real + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("REAL +", act result * msec factor (frequency) - for corr) ; + +END PROC real add s ; + + + + +PROC real mult (INT CONST frequency) : + + first real := 0.0 ; + second real := 1.001 ; + third real := 1.001 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first real := second real * third real + END REP ; + end := clock (0) ; + + act result := end - begin ; + + real mult s (frequency) + +END PROC real mult ; + + + + +PROC real mult s (INT CONST frequency) : + + first real := 0.0 ; + second real := 1.001 ; + third real := 1.001 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first real := second real * third real + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("REAL *", act result * msec factor (frequency) - for corr) ; + +END PROC real mult s ; + + + + +PROC real div (INT CONST frequency) : + + first real := 0.0 ; + second real := 10000.0 ; + third real := 1.0001 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first real := second real / third real + END REP ; + end := clock (0) ; + + act result := end - begin ; + + real div s (frequency) + +END PROC real div ; + + + + +PROC real div s (INT CONST frequency) : + + first real := 0.0 ; + second real := 10000.0 ; + third real := 1.0001 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first real := second real / third real + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("REAL /", act result * msec factor (frequency) - for corr) ; + +END PROC real div s ; + + + + +PROC real incr (INT CONST frequency) : + + first real := 0.0 ; + second real := 1.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first real INCR second real + END REP ; + end := clock (0) ; + + act result := end - begin ; + + real incr s (frequency) + +END PROC real incr ; + + + + +PROC real incr s (INT CONST frequency) : + + first real := 0.0 ; + second real := 1.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first real INCR second real + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("INCR", act result * msec factor (frequency) - for corr) ; + +END PROC real incr s ; + + + + +PROC real mod (INT CONST frequency) : + + first real := 9999.9 ; + second real := 21.21 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + rest := first real MOD second real + END REP ; + end := clock (0) ; + + act result := end - begin ; + + real mod s (frequency) + +END PROC real mod ; + + + + +PROC real mod s (INT CONST frequency) : + + first real := 9999.9 ; + second real := 21.21 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + rest := first real MOD second real + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("MOD", act result * msec factor (frequency) - for corr) ; + +END PROC real mod s ; + + + + +PROC real abs (INT CONST frequency) : + + first real := 0.0 ; + second real := - 12345.6 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first real := abs (second real) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + real abs s (frequency) + +END PROC real abs ; + + + + +PROC real abs s (INT CONST frequency) : + + first real := 0.0 ; + second real := - 12345.6 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first real := abs (second real) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("abs (REAL)", act result * msec factor (frequency) - for corr) ; + +END PROC real abs s ; + + + + +PROC real min (INT CONST frequency) : + + first real := 10000.0 ; + second real := 1.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + rest := min (first real, second real) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + real min s (frequency) + +END PROC real min ; + + + + +PROC real min s (INT CONST frequency) : + + first real := 10000.0 ; + second real := 1.0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + rest := min (first real, second real) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("min (REAL, REAL)", act result * msec factor (frequency) - for corr) ; + +END PROC real min s ; + + +END PACKET real operation ; diff --git a/app/speedtest/1986/src/run down logic b/app/speedtest/1986/src/run down logic new file mode 100644 index 0000000..49f0f0f --- /dev/null +++ b/app/speedtest/1986/src/run down logic @@ -0,0 +1,429 @@ +PACKET run down logic DEFINES for loop, + msec factor, + for corr, + while loop, + until loop, + if, + select, + proc, + proc one param int, + proc two param int : + + +(***************************************************************************) +(* *) +(* Autor: A. Steinmann Copyright (C): HRZ - Unibi *) +(* *) +(***************************************************************************) + + +INT VAR first int, + second int, + index ; + +REAL VAR for loop corr, + begin, + end, + int incr corr, + act result ; + +BOOL VAR is initialized :: FALSE, + situation :: TRUE ; + + + +PROC for loop (INT CONST frequency) : + + notice operation ("FOR LOOP") ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + END REP ; + end := clock (0) ; + + act result := end - begin ; + + for loop s (frequency) + +END PROC for loop ; + + + +PROC for loop s (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + for loop corr := act result * msec factor (frequency) ; + + notice result ("FOR REP",for loop corr) + +END PROC for loop s ; + + + +PROC initialize int incr corr (INT CONST frequency) : + + first int := 0 ; + second int := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int INCR second int + END REP ; + end := clock (0) ; + + act result := end - begin ; + + initialize int incr corr s (frequency) + +END PROC initialize int incr corr ; + + + +PROC initialize int incr corr s (INT CONST frequency) : + + first int := 0 ; + second int := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + first int INCR second int + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + int incr corr := act result * msec factor (frequency) - for corr ; + +END PROC initialize int incr corr s ; + + + +PROC while loop (INT CONST frequency) : + + IF NOT is initialized + THEN initialize int incr corr (frequency) + FI ; + + notice operation ("WHILE LOOP") ; + first int := 0 ; + second int := 1 ; + begin := clock (0) ; + WHILE first int < frequency + REP + first int INCR second int + END REP ; + end := clock (0) ; + + act result := end - begin ; + + while loop s (frequency) + +END PROC while loop ; + + + +PROC while loop s (INT CONST frequency) : + + first int := 0 ; + second int := 1 ; + begin := clock (0) ; + WHILE first int < frequency + REP + first int INCR second int + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("WHILE REP", act result * msec factor (frequency) - int incr corr) ; + +END PROC while loop s ; + + + +PROC until loop (INT CONST frequency) : + + IF NOT is initialized + THEN initialize int incr corr (frequency) + FI ; + + notice operation ("UNTIL LOOP") ; + first int := 1 ; + second int := 1 ; + begin := clock (0) ; + REP + first int INCR second int + UNTIL first int > frequency + END REP ; + end := clock (0) ; + + act result := end - begin ; + + until loop s (frequency) + +END PROC until loop ; + + + +PROC until loop s (INT CONST frequency) : + + first int := 1 ; + second int := 1 ; + begin := clock (0) ; + REP + first int INCR second int + UNTIL first int > frequency + END REP ; + end := clock (0) ; + + IF act result > act result + THEN act result := end - begin + FI ; + + notice result("UNTIL REP", act result * msec factor (frequency) - int incr corr) + +END PROC until loop s ; + + + +PROC if (INT CONST frequency) : + + notice operation ("IF") ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF situation + THEN + FI + END REP ; + end := clock (0) ; + + act result := end - begin ; + + if s (frequency) + +END PROC if ; + + + +PROC if s (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF situation + THEN + FI + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("IF", act result * msec factor (frequency) - for corr) ; + +END PROC if s ; + + + +PROC select (INT CONST frequency) : + + notice operation ("SELECT") ; + first int := 0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + SELECT first int OF + CASE 0 : + OTHERWISE + END SELECT + END REP ; + end := clock (0) ; + + act result := end - begin ; + + select s (frequency) + +END PROC select ; + + + +PROC select s (INT CONST frequency) : + + first int := 0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + SELECT first int OF + CASE 0 : + OTHERWISE + END SELECT + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("SELECT", act result * msec factor (frequency) - for corr) ; + +END PROC select s ; + + + +PROC proc (INT CONST frequency) : + + notice operation ("PROC") ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + nilproc + END REP ; + end := clock (0) ; + + act result := end - begin ; + + proc s (frequency) + +END PROC proc ; + + + +PROC proc s (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + nilproc + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("PROC", act result * msec factor (frequency) - for corr) ; + +END PROC proc s ; + + + +PROC proc one param int (INT CONST frequency) : + + notice operation ("PROC one param INT") ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + nilproc (first int) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + proc one param int s (frequency) + +END PROC proc one param int ; + + + +PROC proc one param int s (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + nilproc (first int) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("PROC (INT)", act result * msec factor (frequency) - for corr) ; + +END PROC proc one param int s ; + + + +PROC proc two param int (INT CONST frequency) : + + notice operation ("PROC two param INT") ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + nilproc (first int, second int) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + proc two param int s (frequency) + +END PROC proc two param int ; + + + +PROC proc two param int s (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + nilproc (first int, second int) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("PROC (INT, INT)", act result * msec factor (frequency) - for corr) ; + +END PROC proc two param int s ; + + + +PROC nilproc : +END PROC nilproc ; + + + +PROC nilproc (INT CONST number one) : +END PROC nilproc ; + + + +PROC nilproc (INT CONST number one, number two) : +END PROC nilproc ; + + + +REAL PROC for corr : + + for loop corr + +END PROC for corr ; + + + +REAL PROC msec factor (INT CONST frequency) : + + 1000.0 / real (frequency) + +END PROC msec factor ; + + +END PACKET run down logic ; diff --git a/app/speedtest/1986/src/speed tester b/app/speedtest/1986/src/speed tester new file mode 100644 index 0000000..37f937f --- /dev/null +++ b/app/speedtest/1986/src/speed tester @@ -0,0 +1,209 @@ +PACKET speed tester DEFINES test speed : + + +(***************************************************************************) +(* *) +(* Autor: A. Steinmann Copyright (C): HRZ - Unibi *) +(* *) +(***************************************************************************) + + +PROC test speed : + + INT VAR frequency 1, + frequency 2 ; + + TEXT VAR name of material, + name of the heart of material, + high, + low ; + + REAL VAR begin, + end ; + + + page ; + cursor (1,3) ; + out (""15""+" EUMEL SPEED TESTER "+" "+" EUMEL SPEED TESTER "+" "+" EUMEL SPEED TESTER "+""14"") ; + cursor (1,6) ; + put ("Bitte gib Name/Typbezeichnung des Test-PC ein") ; + line ; + getline (name of material) ; + line ; + put ("Bitte gib Prozessortyp/Taktfrequenz ein") ; + line ; + getline (name of the heart of material) ; + line ; + name of material CAT " " ; + + output mem ; + notice material (name of material + name of the heart of material) ; + + REP + output mem ; + putline ("Bitte gib Genauigkeitsfaktor fuer schnelle Operationen ein") ; + put ("Voreingestellt ist maxint --> ") ; + getline (high) ; + line ; + IF high = "" + THEN frequency 1 := 32766 + ELSE frequency 1 := int (high) + FI ; + putline ("Bitte gib Genauigkeitsfaktor fuer langsame Operationen ein") ; + put ("Voreingestellt ist maxint Div 2 --> ") ; + getline (low) ; + IF low = "" + THEN frequency 2 := maxint DIV 2 + ELSE frequency 2 := int (low) + FI ; + notice frequency (frequency 1, frequency 2) ; + + begin := clock (0) ; + + + test run down logic ; + test integer operation ; + test real operation ; + test text operation ; + test convert ; + + end := clock (0) ; + page ; + put ("Gesamtlaufzeit : ") ; + put (time (end-begin)) ; + line (2) ; + put ("Taste drcken oder warten") ; + pause (600) ; + + + page ; + cursor (1,5) ; + out (""5""13"") ; + IF yes ("Ergebnis anschauen") + THEN edit ("memory") ; + page + FI ; + + cursor (1,5) ; + out (""5""13"") ; + IF yes ("Ergebnis loeschen") + THEN forget ("memory",quiet) + FI ; + + cursor (1,5) ; + out (""5""13"") + UNTIL no ("Neuer test") + END REP . + + +test run down logic : + +notice heading ("Steuerkonstrukte") ; + +for loop (frequency 1) ; +while loop (frequency 1) ; +until loop (frequency 1) ; +if (frequency 1) ; +select (frequency 1) ; +proc (frequency 1) ; +proc one param int (frequency 1) ; +proc two param int (frequency 1) . + + + +test integer operation : + +notice heading ("Integer Operationen") ; + +int assign global (frequency 1) ; +int assign local (frequency 1) ; +int assign param (frequency 1) ; +row int (frequency 1) ; +int equal (frequency 1) ; +int lequal (frequency 1) ; +int add (frequency 1) ; +int mult (frequency 1) ; +int div (frequency 1) ; +int incr (frequency 1) ; +int mod (frequency 1) ; +int abs (frequency 1) ; +int min (frequency 1) . + + + +test real operation : + +notice heading ("Real Operationen") ; + +real assign (frequency 1) ; +row real (frequency 1) ; +real equal (frequency 1) ; +real lequal (frequency 1) ; +real add (frequency 1) ; +real mult (frequency 2) ; +real div (frequency 2) ; +real incr (frequency 1) ; +real mod (frequency 2) ; +real abs (frequency 1) ; +real min (frequency 1) . + + + +test text operation : + +notice heading ("Text Operationen") ; + +text assign 1 (frequency 1) ; +text assign 10 (frequency 1) ; +text assign 30 (frequency 1) ; +row text (frequency 1) ; +text equal 1 (frequency 1) ; +text equal 10 (frequency 1) ; +text equal 30 (frequency 1) ; +text lequal 1 (frequency 1) ; +text lequal 10 (frequency 1) ; +text lequal 30 (frequency 1) ; +text mult (frequency 1) ; +cat (frequency 1) ; +text add 1 (frequency 1) ; +text add 10 (frequency 2) ; +text add 30 (frequency 2) ; +text length 1 (frequency 1) ; +text length 10 (frequency 1) ; +text length 30 (frequency 1) ; +text sub 1 (frequency 1) ; +text sub 10 (frequency 1) ; +text sub 30 (frequency 1) ; +subtext 1 (frequency 1) ; +subtext 10 (frequency 1) ; +subtext 30 (frequency 1) ; +replace 1 (frequency 1) ; +replace 10 (frequency 1) ; +replace 30 ( frequency 1) ; +text 1 (frequency 2) ; +text 10 (frequency 2) ; +text 30 (frequency 2) ; +pos 1 (frequency 1) ; +pos 10 (frequency 1) ; +pos 30 (frequency 1) . + + + +test convert : + +notice heading ("Konvertierungs Operationen") ; + +real to int (frequency 1) ; +int to real (frequency 1) ; +text to int (frequency 2) ; +int to text (frequency 1) ; +int to text 2 (frequency 2) ; +real to text (frequency 2) ; +real to text 2 (frequency 2) ; +code int (frequency 1) ; +code text (frequency 1) ; + + +END PROC test speed ; + +END PACKET speed tester diff --git a/app/speedtest/1986/src/text operation b/app/speedtest/1986/src/text operation new file mode 100644 index 0000000..30ad2ba --- /dev/null +++ b/app/speedtest/1986/src/text operation @@ -0,0 +1,1401 @@ +PACKET text operation DEFINES text assign 1, + text assign 10, + text assign 30, + row text, + text mult, + cat, + text equal 1, + text equal 10, + text equal 30, + text lequal 1, + text lequal 10, + text lequal 30, + text add 1, + text add 10, + text add 30, + text length 1, + text length 10, + text length 30, + text sub 1, + text sub 10, + text sub 30, + subtext 1, + subtext 10, + subtext 30, + replace 1, + replace 10, + replace 30, + text 1, + text 10, + text 30, + pos 1, + pos 10, + pos 30 : + + +(***************************************************************************) +(* *) +(* Autor: A. Steinmann Copyright (C): HRZ - Unibi *) +(* *) +(***************************************************************************) + + +ROW 10 TEXT VAR text row ; + +INT VAR index, + i, + j ; + +REAL VAR begin, + end, + act result, + text assign factor ; + +TEXT VAR single text :: "*", + short text :: "ELAN/EUMEL", + long text :: "Ein Multi User Betriebssystem!", + free text ; + + + + +PROC text assign 1 (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := single text + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text assign 1 s (frequency) + +END PROC text assign 1 ; + + + + +PROC text assign 1 s (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := single text + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + text assign factor := act result * msec factor (frequency) - for corr ; + + notice result ("TEXT := (1)", text assign factor) + +END PROC text assign 1 s ; + + + + +PROC text assign 10 (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := short text + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text assign 10 s (frequency) + +END PROC text assign 10 ; + + + + +PROC text assign 10 s (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := short text + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("TEXT := (10)", act result * msec factor (frequency) - for corr) + +END PROC text assign 10 s ; + + + + +PROC text assign 30 (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := long text + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text assign 30 s (frequency) + +END PROC text assign 30 ; + + + + +PROC text assign 30 s (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := long text + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("TEXT := (30)", act result * msec factor (frequency) - for corr) + +END PROC text assign 30 s ; + + + + +PROC row text (INT CONST frequency) : + + i := 7 ; + text row [i] := "" ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + text row [i] := single text + END REP ; + end := clock (0) ; + + act result := end - begin ; + + row text s (frequency) + +END PROC row text ; + + + + +PROC row text s (INT CONST frequency) : + + i := 7 ; + text row [i] := "" ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + text row [i] := single text + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("ROW TEXT [i]", act result * msec factor (frequency) - for corr) + +END PROC row text s ; + + + + +PROC text equal 1 (INT CONST frequency) : + + free text := single text ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF free text = single text + THEN + FI + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text equal 1 s (frequency) + +END PROC text equal 1 ; + + + + +PROC text equal 1 s (INT CONST frequency) : + + free text := single text ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF free text = single text + THEN + FI + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("TEXT = (1)", act result * msec factor (frequency) - for corr) + +END PROC text equal 1 s ; + + + + +PROC text equal 10 (INT CONST frequency) : + + free text := short text ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF free text = short text + THEN + FI + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text equal 10 s (frequency) + +END PROC text equal 10 ; + + + + +PROC text equal 10 s (INT CONST frequency) : + + free text := short text ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF free text = short text + THEN + FI + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("TEXT = (10)", act result * msec factor (frequency) - for corr) + +END PROC text equal 10 s ; + + + + +PROC text equal 30 (INT CONST frequency) : + + free text := long text ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF free text = long text + THEN + FI + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text equal 30 s (frequency) + +END PROC text equal 30 ; + + + + +PROC text equal 30 s (INT CONST frequency) : + + free text := long text ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF free text = long text + THEN + FI + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("TEXT = (30)", act result * msec factor (frequency) - for corr) + +END PROC text equal 30 s ; + + + + +PROC text lequal 1 (INT CONST frequency) : + + free text := single text ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF free text <= single text + THEN + FI + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text lequal 1 s (frequency) + +END PROC text lequal 1 ; + + + + +PROC text lequal 1 s (INT CONST frequency) : + + free text := single text ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF free text <= single text + THEN + FI + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("TEXT <= (1)", act result * msec factor (frequency) - for corr) + +END PROC text lequal 1 s ; + + + + +PROC text lequal 10 (INT CONST frequency) : + + free text := short text ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF free text <= short text + THEN + FI + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text lequal 10 s (frequency) + +END PROC text lequal 10 ; + + + + +PROC text lequal 10 s (INT CONST frequency) : + + free text := short text ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF free text <= short text + THEN + FI + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("TEXT <= (10)", act result * msec factor (frequency) - for corr) + +END PROC text lequal 10 s ; + + + + +PROC text lequal 30 (INT CONST frequency) : + + free text := long text ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF free text <= long text + THEN + FI + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text lequal 30 s (frequency) + +END PROC text lequal 30 ; + + + + +PROC text lequal 30 s (INT CONST frequency) : + + free text := long text ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + IF free text <= long text + THEN + FI + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("TEXT <= (30)", act result * msec factor (frequency) - for corr) + +END PROC text lequal 30 s ; + + + + +PROC text mult (INT CONST frequency) : + + i := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := i * single text + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text mult s (frequency) + +END PROC text mult ; + + + + +PROC text mult s (INT CONST frequency) : + + i := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := i * single text + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("TEXT * (Faktor 1)", act result * msec factor (frequency) - for corr) + +END PROC text mult s ; + + + + +PROC cat (INT CONST frequency) : + + free text := "" ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text CAT single text ; + free text := "" + END REP ; + end := clock (0) ; + + act result := end - begin ; + + cat s (frequency) + +END PROC cat ; + + + + +PROC cat s (INT CONST frequency) : + + free text := "" ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text CAT single text ; + free text := "" + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("CAT (1)", act result * msec factor (frequency) - for corr) + +END PROC cat s ; + + + + +PROC text add 1 (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := single text + single text + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text add 1 s (frequency) + +END PROC text add 1 ; + + + + +PROC text add 1 s (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := single text + single text + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("TEXT + (1)", act result * msec factor (frequency) - for corr) + +END PROC text add 1 s ; + + + +PROC text add 10 (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := short text + short text + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text add 10 s (frequency) + +END PROC text add 10 ; + + + + +PROC text add 10 s (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := short text + short text + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("TEXT + (10)", act result * msec factor (frequency) - for corr) + +END PROC text add 10 s ; + + + + +PROC text add 30 (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := long text + long text + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text add 30 s (frequency) + +END PROC text add 30 ; + + + + +PROC text add 30 s (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := long text + long text + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("TEXT + (30)", act result * msec factor (frequency) - for corr) + +END PROC text add 30 s ; + + + + +PROC text length 1 (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + i := length (single text) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text length 1 s (frequency) + +END PROC text length 1 ; + + + + +PROC text length 1 s (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + i := length (single text) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("length (1)", act result * msec factor (frequency) - for corr) + +END PROC text length 1 s ; + + + + +PROC text length 10 (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + i := length (short text) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text length 10 s (frequency) + +END PROC text length 10 ; + + + + +PROC text length 10 s (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + i := length (short text) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("length (10)", act result * msec factor (frequency) - for corr) + +END PROC text length 10 s ; + + + + +PROC text length 30 (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + i := length (long text) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text length 30 s (frequency) + +END PROC text length 30 ; + + + + +PROC text length 30 s (INT CONST frequency) : + + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + i := length (long text) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("length (30)", act result * msec factor (frequency) - for corr) + +END PROC text length 30 s ; + + + + +PROC text sub 1 (INT CONST frequency) : + + i := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := single text SUB i + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text sub 1 s (frequency) + +END PROC text sub 1 ; + + + + +PROC text sub 1 s (INT CONST frequency) : + + i := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := single text SUB i + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("SUB (1)", act result * msec factor (frequency) - for corr) + +END PROC text sub 1 s ; + + + + +PROC text sub 10 (INT CONST frequency) : + + i := 7 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := short text SUB i + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text sub 10 s (frequency) + +END PROC text sub 10 ; + + + + +PROC text sub 10 s (INT CONST frequency) : + + i := 7 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := short text SUB i + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("SUB (10)", act result * msec factor (frequency) - for corr) + +END PROC text sub 10 s ; + + + + +PROC text sub 30 (INT CONST frequency) : + + i := 17 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := long text SUB i + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text sub 30 s (frequency) + +END PROC text sub 30 ; + + + + +PROC text sub 30 s (INT CONST frequency) : + + i := 17 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := long text SUB i + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("SUB (30)", act result * msec factor (frequency) - for corr) + +END PROC text sub 30 s ; + + + + +PROC subtext 1 (INT CONST frequency) : + + i := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := subtext (single text , i, i) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + subtext 1 s (frequency) + +END PROC subtext 1 ; + + + + +PROC subtext 1 s (INT CONST frequency) : + + i := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := subtext (single text , i, i) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("subtext (TEXT, INT, INT) (1)", act result * msec factor (frequency) - for corr) + +END PROC subtext 1 s ; + + + + +PROC subtext 10 (INT CONST frequency) : + + i := 7 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := subtext (short text , i, i) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + subtext 10 s (frequency) + +END PROC subtext 10 ; + + + + +PROC subtext 10 s (INT CONST frequency) : + + i := 7 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := subtext (short text , i, i) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("subtext (TEXT, INT, INT) (10)", act result * msec factor (frequency) - for corr) + +END PROC subtext 10 s ; + + + + +PROC subtext 30 (INT CONST frequency) : + + i := 17 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := subtext (long text , i, i) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + subtext 30 s (frequency) + +END PROC subtext 30 ; + + + + +PROC subtext 30 s (INT CONST frequency) : + + i := 17 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := subtext (long text , i, i) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("subtext (TEXT, INT, INT) (30)", act result * msec factor (frequency) - for corr) + +END PROC subtext 30 s ; + + + + +PROC replace 1 (INT CONST frequency) : + + i := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + replace (single text, i, single text) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + replace 1 s (frequency) + +END PROC replace 1 ; + + + + +PROC replace 1 s (INT CONST frequency) : + + i := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + replace (single text, i, single text) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("replace (TEXT, TEXT, INT) (1)", act result * msec factor (frequency) - for corr) + +END PROC replace 1 s ; + + + + +PROC replace 10 (INT CONST frequency) : + + i := 7 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + replace (short text, i, single text) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + replace 10 s (frequency) + +END PROC replace 10 ; + + + + +PROC replace 10 s (INT CONST frequency) : + + i := 7 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + replace (short text, i, single text) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("replace (TEXT, TEXT, INT) (10)", act result * msec factor (frequency) - for corr) + +END PROC replace 10 s ; + + + + +PROC replace 30 (INT CONST frequency) : + + i := 17 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + replace (long text, i, single text) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + replace 30 s (frequency) + +END PROC replace 30 ; + + + + +PROC replace 30 s (INT CONST frequency) : + + i := 17 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + replace (long text, i, single text) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("replace (TEXT, TEXT, INT) (30)", act result * msec factor (frequency) - for corr) + +END PROC replace 30 s ; + + + + +PROC text 1 (INT CONST frequency) : + + i := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := text (single text, i, i) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text 1 s (frequency) + +END PROC text 1 ; + + + + +PROC text 1 s (INT CONST frequency) : + + i := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := text (single text, i, i) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("text (TEXT, INT, INT) (1)", act result * msec factor (frequency) - for corr) + +END PROC text 1 s ; + + + + +PROC text 10 (INT CONST frequency) : + + i := 7 ; + j := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := text (short text, j, i) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text 10 s (frequency) + +END PROC text 10 ; + + + + +PROC text 10 s (INT CONST frequency) : + + i := 7 ; + j := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := text (short text, j, i) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("text (TEXT, INT, INT) (10)", act result * msec factor (frequency) - for corr) + +END PROC text 10 s ; + + + + +PROC text 30 (INT CONST frequency) : + + i := 17 ; + j := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := text (long text, j, i) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + text 30 s (frequency) + +END PROC text 30 ; + + + + +PROC text 30 s (INT CONST frequency) : + + i := 17 ; + j := 1 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + free text := text (long text, j, i) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("text (TEXT, INT, INT) (30)", act result * msec factor (frequency) - for corr) + +END PROC text 30 s ; + + + + +PROC pos 1 (INT CONST frequency) : + + i := 1 ; + j := 0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + j := pos (single text, single text, i) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + pos 1 s (frequency) + +END PROC pos 1 ; + + + + +PROC pos 1 s (INT CONST frequency) : + + i := 1 ; + j := 0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + j := pos (single text, single text, i) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("pos (TEXT, TEXT, INT) (1)", act result * msec factor (frequency) - for corr) + +END PROC pos 1 s ; + + + + +PROC pos 10 (INT CONST frequency) : + + i := 1 ; + j := 0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + j := pos (short text, single text, i) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + pos 10 s (frequency) + +END PROC pos 10 ; + + + + +PROC pos 10 s (INT CONST frequency) : + + i := 1 ; + j := 0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + j := pos (short text, single text, i) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("pos (TEXT, TEXT, INT) (10)", act result * msec factor (frequency) - for corr) + +END PROC pos 10 s ; + + + + +PROC pos 30 (INT CONST frequency) : + + i := 1 ; + j := 0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + j := pos (long text, single text, i) + END REP ; + end := clock (0) ; + + act result := end - begin ; + + pos 30 s (frequency) + +END PROC pos 30 ; + + + + +PROC pos 30 s (INT CONST frequency) : + + i := 1 ; + j := 0 ; + begin := clock (0) ; + FOR index FROM 1 UPTO frequency + REP + j := pos (long text, single text, i) + END REP ; + end := clock (0) ; + + IF act result > end - begin + THEN act result := end - begin + FI ; + + notice result ("pos (TEXT, TEXT, INT) (30)", act result * msec factor (frequency) - for corr) + +END PROC pos 30 s ; + + +END PACKET text operation ; diff --git a/devel/debugger/doc/DEBUGGER.PRT b/devel/debugger/doc/DEBUGGER.PRT new file mode 100644 index 0000000..4379f4a --- /dev/null +++ b/devel/debugger/doc/DEBUGGER.PRT @@ -0,0 +1,2021 @@ +*************************************************************************** +*** *** +*** D o k u m e n t a t i o n *** +*** zum EUMEL-Debugger *** +*** *** +*** Autor: Michael Staubermann *** +*** Stand der Dokumentation: 03.12.86 *** +*** Stand des Debuggers: 01.12.86 *** +*** *** +*************************************************************************** + +1. Anwendung des Debuggers +1.1 Code Disassembler (Decoder) +1.1.1 Datenreprsentation +1.1.2 Datenadressen +1.1.3 Codeadressen + +1.2 Ablaufverfolgung (Tracer) + +2. Die EUMEL0-Instruktionen +2.1 Erluterung der Instruktionen (Thematisch sortiert) +2.2 Alphabetische Liste der Instruktionen + +3. Beschreibung der Pakete +3.1 PACKET address +3.2 PACKET table routines +3.3 PACKET eumel decoder +3.4 PACKET tracer + +#page# +#ub#1. Anwendung des Debuggers#ue# + +Der EUMEL-Debugger ist fr die Software-Entwickler und nicht fr die +Anwender dieser Software gedacht. Insbesondere bei der Entwicklung +systemnaher Software, wie z.B. Compiler, ist der Debugger hilfreich. + +(ELAN-)Programme werden wie bisher compiliert (z.B. insertiert), ohne da +der Quelltext des Programmes vorher modifiziert werden mte. Um den +Sourcetext whrend der Ablaufverfolgung (Trace) beobachten zu knnen, +men die Programme mit 'check on' bersetzt werden. + +Die sinnvolle Anwendung des Debuggers setzt allerdings Kenntnis der +EUMEL0-Instruktionen voraus, die im Kapitel 2 erlutert werden (Der Debugger +setzt die Codierung BIT-A fr diese Instruktionen voraus, d.h. er luft +zumindest in der interpretativen EUMEL0-Version.). + + +#ub#1.1 Code Disassembler (Decoder)#ue# + +Der Decoder konvertiert die vom Compiler erzeugte Bitcodierung (16 Bit) in +Mnemonics (Textdarstellung der Instruktionen), die in eine FILE geschrieben, +bzw. optional auf dem Bildschirm ausgegeben werden knnen. Die Bitcodierung +kann zustzlich ausgegeben werden. +Der Decoder wird mit 'decode' aufgerufen. Whrend der Dekodierung stehen +folgende Tastenfunktionen zur Verfgung: + +Taste Funktion +----------------------------------------------------------------------- + ESC Abbruch der Dekodierung. + e Echo. Schaltet die parallel Bildschirmausgabe ein/aus. + l Zeilennummern statt Hexadezimaladressen mitprotokollieren. + a Hexadezimaladressen statt Zeilennummern mitprotokollieren. + f Zeigt den Namen und die aktuelle Zeilennummer der Protokollfile. + d getcommand ; docommand + s storage info + m Zeigt die aktuelle Modulnummer an (sinnvoll falls kein Echo) + Q,W Zeilennummern/Hexadressen mitprotokollieren (falls kein Echo) + S Keine Zeilennummern/Hexadressen ausgeben (luft auch im Hintergrund) + + +#ub#1.1.1 Datenreprsentation#ue# + +INT-Zahlen werden hexadezimal (xxxxH, xxH) oder dezimal dargestellt, +TEXTe in Anfhrungszeichen ("..."), +REALs im 20-Stellen scientific-Format, +TASK-Objekte durch XX-YYYY/"name" mit XX als Taskindex und YYYY als Version, + wenn die Stationsnummer nicht 0 ist, wird sie vor XX als SS- dargestellt. +DATASPACE-Objekte werden durch XX-YY reprsentiert (XX ist der eigene + Taskindex, YY ist die Datenraumnummer), +BOOL-Objekte durch TRUE oder FALSE. +Module werden durch ihre Modulnummer, optional auch durch ihre + Startadresse, und falls mglich durch ihren Namen reprsentiert. Die + Parameterliste wird in den Fllen, wo das Modul in der Permanenttabelle + vermerkt ist auch angegeben. +Nicht weiter dereferenzierbare Adressen werden durch ein vorgestelltes '@' +gekennzeichnet (z.B. BOUND-Objekte). +In den Fllen, wo es mehrere sinnvolle Darstellungen gibt, werden diese +durch ein '|' getrennt. + + +#ub#1.1.2 Datenadressen#ue# + +Zustzlich zu den globalen Daten (statische Variablen und Denoter) kann auch +deren Adresse ausgegeben werden. Die Daten werden in einer, ihrem Typ +entsprechenden, Darstellung ausgegeben. Komplexe oder zusammengesetzte +Datentypen werden auf Reprsentationen elementarer Datentypen (INT, REAL, +BOOL, TEXT, DATASPACE, TASK) abgebildet. + +Prozeduren, Operatoren und Paketinitialisierungen von Main-Packets werden +zusammenfassend als Module bezeichnet. Einem Modul gehrt ein eigener +Stackbereich fr lokale Daten, Parameter und Rcksprungadresse etc. In +diesem Bereich stehen entweder die Datenobjekte selbst (z.B. lokale +Variablen) oder lokale Referenzadressen auf beliebige Objekte (lokale, +globale Daten, Fremddatenrume und sogar Module). +Da die effektiven lokalen Adressen erst whrend der Runtime bekannt sind, +findet man im Decoder-Output nur die Adressoffsets relativ zum Stackanfang +des Moduls. + +Datenadressen werden in spitzen Klammern angegeben, Branch-Codeaddressen ohne +Klammern. Alle Adressen sind Wortaddressen. Der Adresstyp wird durch einen +Buchstaben nach '<' angezeigt: +'G' kennzeichnet eine globale Adresse (Denoter oder statische Variable). Die +Representation der Daten kann immer angegeben werden (also nicht nur zur +Runtime). +'L' kennzeichnet einen Adressoffset fr ein lokales Datenobjekt auf dem +Stack. Da die lokale Basis, d.h. die Anfangsadresse der Daten des aktuellen +Moduls, erst bei Runtime feststehen, kann hier weder die effektive +Datenadresse, noch der Inhalt des Datenobjekts angegeben werden. +'LR' kennzeichnet eine lokale Referenzadresse, d.h. auf dem Stack steht +eine Adresse (32 Bit), die ein Datenobjekt adressiert. hnlich wie bei 'L' +kann auch bei 'LR' erst zur Runtime eine Representation des adressierten +Datenobjekts angegeben werden. Der Wert nach 'LR' bezeichnet den Offset, der +zur lokalen Basis addiert werden mu, um die Adresse der Referenzadresse zu +erhalten. Die niederwertigsten 16 Bit (das erste der beiden Wrter) knnen +128KB adressieren. Im hherwertigsten Byte des zweiten Wortes steht die +Nummer des Datenraumes der eigenen Task, der das adressierte Datenobjekt +enthlt (0 entspricht dem Standarddatenraum). Das niederwertigste Byte des +zweiten Wortes enthlt die Segmentnummer (128KB-Segmente) mit dem +Wertebereich 0 bis 7 (maximal also 1MB/Datenraum). Im Standarddatenraum +(Datenraumnummer 4) enthalten die Segmente folgene Tabellen: + +Segment Tabelle +------------------------------------------------- + 0 Paketdaten (high 120KB) und Moduladresstabelle + 1 Stack (low 64K), Heap (high 64K) + 2 Codesegment + 3 Codesegment (120KB) u.a. fr eigene Module + 4 Compilertabellen temporr + 5 Compilertabellen permanent + 6 nilsegment fr Compiler (FF's) + 7 Compiler: Intermediate String + +Reprsentationen von Datenobjekten, die in Fremddatenrumen residieren +(BOUND-Objekte) knnen zur Zeit noch nicht ausgegeben werden, statt dessen +wird die Datenraumnummer und die Wortadresse innerhalb dieses Datenraums +ausgegeben. + + +#ub#1.1.3 Codeadressen#ue# + +Module werden in der Regel (Ausnahme: Parameterprozeduren) ber ihre +Modulnummer angesprochen, aus der dann die Adresse des Moduls berechnet +werden kann (mithilfe der Moduladresstabelle). Die Adressen der +Parameterprozeduren sind vom Typ 'LR' (Local-Reference), kommen nur als +Parameter auf dem Stack vor und beeinhalten Codesegment und Codeadresse. + +Sprungadressen (von Branch-Befehlen) adressieren immer nur das eigene +Segment und davon auch nur eine Adresse innerhalb eines 8 KB groen +Bereichs. + + +#ub#1.2 Ablaufverfolgung (Tracer)#ue# + +Um den eigenen (!) Code im Einzelschrittbetrieb abzuarbeiten, wird der +Tracer benutzt. Auer den Inhalten der globalen Daten kann man sich die +Inhalte der Stackobjekte (lokale Variablen) und der aktuellen Parameter +eines Prozeduraufrufs (auch von Parameterprozeduren) ansehen. Es knnen +keine Daten verndert werden! +Man hat die Mglichkeit +- die Resultate der letzten ausgefhrten Instruktion oder +- die aktuellen Parameter fr den nchsten Instruktionsaufruf +zu beobachten. +Der Inhalt des Stacks kann sequentiell durchgesehen werden, Error- und +Disablestop-Zustand knnen gelscht werden. +Der Einzelschrittablauf kann protokolliert und die entsprechende +Sourceline parallel zum ausgefhrten Code beobachtet werden. +Der Einzelschrittbetrieb kann, ber Teile des Codes hinweg, ausgeschaltet +werden, z.B. fr hufig durchlaufene Schleifen. +Fr die Reprsentation der Daten und deren Adressen gilt das unter 1.1 +gesagte. +Der Tracer wird mit 'trace' aufgerufen. Whrend der Aktivitt des Tracers +stehen folgende Funktionen zur Verfgung (Nur der erste Buchstabe wird +getippt): + +Abkrzung Funktion +-------------------------------------------------------------------------- + Auto Die Befehle werden im Einzelschrittbetrieb ausgefhrt, ohne da + eine Taste gedrckt werden mu. + Bpnt Der nchste Breakpoint wird an eine vom Benutzer festgelegte + Codeadrese gesetzt. Damit knnen Teile des Codes abgearbeitet + werden, ohne da der Einzelschrittmodus aktiv ist. Nach der + Eingabe der Adresse wird der Befehl an dieser Adresse angezeigt. + Besttigt wird die Richtigkeit mit oder 's'. + Clrr Ein eventuell vorliegender Fehlerzustand wird gelscht. + Dstp 'disable stop' wird fr das untersuchte Modul gesetzt. + Estp 'enable stop' wird fr das untersuchte Modul gesetzt. + File Der Name der kompilierten Quelldatei wird eingestellt. + Go Der Code wird bis zum Ende abgearbeitet, ohne da der Tracer + aktiviert wird. + Prot Der Name der Protokollfile wird eingestellt. Die abgearbeiteten + Instruktionen werden in dieser File protokolliert. + Rslt Es wird umgeschaltet, ob die angezeigte Instruktion nach + oder 's' abgearbeitet werden soll (Forward-Trace, 'F') oder ob das + Ergebnis der letzten ausgefhrten Instruktion angezeigt werden soll + (Result-Trace, 'R'). Der aktuelle Zustand dieses Switches wird in + der ersten Bildschirmzeile durch 'R' oder 'F' gekennzeichnet. + Kurzzeitige Umschaltung, um das Ergebnis der letzten Operation + anzusehen, ist auch mglich (zweimal 'r' tippen). + Step/CR Mit oder 's' wird die nchste Instruktion ausgefhrt. + Dies ist bei Forward-Trace die angezeigte Instruktion. + Term Bis zur nchst 'hheren' Prozedur der CALL-Sequence, die im + 'disable stop'-Zustand arbeitet, werden die Module verlassen. In + der Regel bedeutet dies ein Programmabbruch. Alle Breakpoints sind + anschlieend zurckgesetzt. + - Der Stackpointer auf den sichtbaren Stack (in der ersten + Bildschirmzeile) wird um zwei verringert. Er zeigt auf die nchst + tiefere Referenzadresse. Der EUMEL-0-Stackpointer wird nicht + verndert. + + Der Stackpointer auf den sichtbaren Stack wird um zwei erhht. + < Bei der Befehlsausgabe werden die Parameteradressen zustzlich + ausgegeben (in spitzen Klammern). + > Bei der Befehlsausgabe werden keine Parameteradressen ausgegeben, + sondern nur die Darstellungen der Parameter (z.B. + Variableninhalte) + +#page# +#ub#2. EUMEL0-Instruktionen#ue# + + +#ub#2.1 Erluterung der Instruktionen (Thematisch sortiert)#ue# + +Nach der Hufigkeit ihres Vorkommens im Code unterscheidet man 3 Klassen von +Instruktionen: 30 Primrbefehle, 6 Spezialbefehle und z.Zt. 127 +Sekundrbefehle. +Die Primrbefehle enthalten im ersten Wort den Opcode (5 Bit) und 11 Bit fr +die erste Parameteradresse d.h. den Wertebereich 0..2047. Liegt die +Parameteradresse auerhalb dieses Bereichs, dann ersetzt ein +Umschaltprefix (LONGAddress) die Opcodebits und im lowbyte des +ersten Wortes wird der Opcode codiert. Die erste Parameteradresse befindet +sich dann als 16 Bit-Wert im zweiten Wort. +Spezialbefehle enthalten im ersten Wort auer dem Opcode (8 Bit) noch einen +8 Bit-Immediatewert (Bytekonstante). +Sekundrebefehle enthalten im ersten Wort nur den Opcode (16 Bit), der aus +einem Umschaltprefix (ESCape, wird im folgenden weggelassen) und im lowbyte +dem 8 Bit Sekndaropcode besteht. + +Im folgenden werden Datenadressen mit 'd', Immediatewerte mit 'v' (Value), +Codeadressen mit 'a' und Modulnummern mit 'm' bezeichnet. Die Anzahl dieser +Buchstaben gibt die Lnge der bentigten Opcodebits (DIV 4) an. Ausnahmsweise +bezeichnet .nn:dd einen 5 Bit Opcode ('nn') und eine 11 Bit Adresse ('dd'). + +Der Adresstyp ist in den Bits 14 und 15 codiert: +15 14 Typ Effektive Adresse + 0 0 global dddd + pbase (pbase wird mit PENTER eingestellt) + 1 0 local (dddd AND 7FFF) DIV 2 + lbase (lbase wird beim CALL gesetzt) + 1 1 local ref adr := ((dddd AND 7FFF) DIV 2 + lbase) ; (adr+1, adr) + +Der Wert eines Wortes an der ersten Parameteradresse wird mit +bezeichnet. Ein Datentyp vor der spitzen Klammer gibt seinen Typ an. Fr die +anderen Parameter gilt entsprechendes (, , ...). + + +#ub#2.1.1 Datentransportbefehle#ue# + +MOV .08:dd dddd 1 Wort (z.B. INT/BOOL) wird von der linken + Adresse zur rechten Adresse transportiert. + := + +FMOV .34:dd dddd 4 Wrter (z.B. REAL) von linker Adresse zur + rechten Adresse tranportieren (kopiert). + := + +TMOV .4C:dd dddd Kopiert einen Text von der linken Adresse zur + rechten Adresse. + TEXT := TEXT + +MOVi FC vv dddd Die Konstante vv (1 Byte) wird als positive + 16 Bit-Zahl dem Wort an der Adresse dddd + zugewiesen. + := vv + +MOVii 7F 23 vvvv dddd Dem Wort an der Adresse dddd wird die 16-Bit + Konstante vvvv zugewiesen. + := vvvv + +MOVx 7D vv dddd dddd Von der linken Adresse zur rechten Adresse + werden vv (max. 255) Wrter transportiert. + := (vv Wrter) + +MOVxx 7F 21 vvvv dddd dddd Von der linken Adresse zur rechten Adresse + werden vvvv (max. 65535) Wrter transportiert. + := (vvvv Wrter) + + +#ub#2.1.2 INT-Operationen#ue# + +ARITHS 7F 5B Schaltet um auf vorzeichenbehaftete + INT-Arithmetik (Normalfall). + ARITH := Signed + +ARITHU 7F 5C Schaltet um auf vorzeichenlose 16Bit-Arithmetik + (Compiler). + ARITH := Unsigned + +CLEAR .24:dd Dem Wort an der Adresse dd wird 0 zugewiesen. + := 0 + +INC1 .0C:dd Der Inhalt des Wortes an der Adresse dddd wird + um eins erhht. + := + 1 + +DEC1 .10:dd Der Inhalt des Wortes an der Adresse dddd wird + um eins verringert. + := - 1 + +INC .14:dd dddd Der Inhalt des Wortes an der ersten Adresse wird + zum Inhalt des Wortes an der zweiten Adresse + addiert. + := + + +DEC .18:dd dddd Der Inhalt des Wortes an der ersten Adresse wird + vom Inhalt des Wortes an der zweiten Adresse + subtrahiert. + := - + +ADD .1C:dd dddd dddd Der Inhalt der Worte der beiden ersten + Adressen wird addiert und bei der dritten + Adresse abgelegt. + := + + +SUB .20:dd dddd dddd Der Inhalt des Wortes an der zweiten Adresse + wird vom Inhalt des Wortes an der ersten Adresse + subtrahiert und das Resultat im Wort an der + dritten Adresse abgelegt. + := - + +MUL 7F 29 dddd dddd dddd Der Wert der Wrter an den beiden ersten + Adressen wird vorzeichenbehaftet multipliziert + und im Wort an der dritten Adresse abgelegt. + Ein berlauf wird im Falle der vorzeichenlosen + Arithmetik ignoriert ( MOD 65536). + := * + +IMULT 7F 28 dddd dddd dddd Der Wert der Wrter an den beiden ersten + Adressen wird vorzeichenlos multipliziert und + im Wort an der dritten Adresse abgelegt. + Falls das Resultat ein Wert grer 65535 wre, + wird := FFFFH, sonst + := * + +DIV 7F 2A dddd dddd dddd Der Wert des Wortes an der ersten Adresse wird + durch den Wert des Wortes an der zweiten + Adresse dividiert und im Wort an der dritten + Adresse abgelegt. Eine Division durch 0 fhrt + zum Fehler. + := DIV + +MOD 7F 2B dddd dddd dddd Der Rest der Division (wie bei DIV) wird im + Wort an der dritten Adresse abgelegt. Falls + = 0 ist, wird ein Fehler ausgelst. + := MOD + +NEG 7F 27 dddd Der Wert des Wortes an der Adresse dddd wird + arithmetisch negiert (Vorzeichenwechsel). + := - + +AND 7F 7C dddd dddd dddd Der Wert der beiden Wrter an den beiden ersten + Adressen wird bitweise UND-verknpft und das + Resultat im Wort an der dritten Adresse + abgelegt. + := AND + +OR 7F 7D dddd dddd dddd Der Wert der beiden Wrter an den beiden ersten + Adressen wird bitweise ODER-verknpft und das + Resultat im Wort an der dritten Adresse + abgelegt. + := OR + +XOR 7F 79 dddd dddd dddd Der Wert der beiden Wrter an den beiden ersten + Adressen wird bitweise Exklusiv-ODER-verknpft + und das Resultat im Wort an der dritten Adresse + abgelegt. + := XOR + +ROTATE 7F 53 dddd dddd Der Wert an der ersten Adresse wird um soviele + Bits links oder rechts rotiert, wie es der Wert + des zweiten Parameters angibt (positiv = + links). + IF < 0 + THEN := ROR + ELSE := ROL + FI + + +#ub#2.1.3 REAL-Operationen#ue# + +FADD .38:dd dddd dddd Die beiden ersten REAL-Werte werden addiert und + das Resultat an der dritten Adresse abgelegt. + REAL := REAL + REAL + +FSUB .3C:dd dddd dddd Der zweite REAL-Wert wird vom ersten + subtrahiert und das Resultat an der dritten + Adresse abgelegt. + REAL := REAL + REAL + +FMUL .40:dd dddd dddd Die beiden ersten REAL-Werte werden + multipliziert und das Resultat an der dritten + Adresse abgelegt. + REAL := REAL * REAL + +FDIV .44:dd dddd dddd Der erste REAL-Wert wird durch den zweiten + dividiert und das Resultat an der dritten + Adresse abgelegt. + REAL := REAL / REAL + +FNEG 7F 26 dddd Das Vorzeichen des REAL-Wertes an der Adresse + dddd wird gewechselt. + REAL := -REAL + +FSLD 7F 60 dddd dddd dddd Die Mantisse des REAL-Wertes an der zweiten + Adresse wird um ein Digit (4 Bit BCD) nach + links verschoben, Vorzeichen und Exponent + bleiben unverndert. Das vorher hherwertigste + Digit steht danach im Wort an der dritten + Adresse. Das neue niederwertigste Digit wurde + aus dem Wort der ersten Adresse entnommen. + INT := digit1 ; + REAL := REAL SLD 1 ; + digit13 := INT<1> + +GEXP 7F 61 dddd dddd Der Exponent des REAL-Wertes an der ersten + Adresse wird in das Wort an der zweiten Adresse + gebracht. + INT := exp + +SEXP 7F 62 dddd dddd Der Wert des Wortes an der ersten Adresse wird + in den Exponenten des REAL-Wertes an der zweiten + Adresse gebracht. + exp := INT + +FLOOR 7F 63 dddd dddd Der REAL-Wert an der ersten Adresse wird ohne + Dezimalstellen an der zweiten Adresse abgelegt. + := floor + + +#ub#2.1.4 TEXT-Operationen#ue# + +ITSUB 7F 2D dddd dddd dddd Aus dem TEXT an der ersten Adresse wird das + Wort, dessen Position durch das Wort an der + zweiten Adresse beschrieben wird, im Wort an + der dritten Adresse abgelegt. + INT := TEXT[INT,2] (Notation: + t[n,s] bezeichnet das n. Element mit einer + Gre von s Bytes, der Bytekette t an der + Byteposition n*s+1) + +ITRPL 7F 2E dddd dddd dddd In dem TEXT an der ersten Adresse wird das + Wort, dessen Position durch das Wort an der + zweiten Adresse beschrieben wird, durch das Wort + an der dritten Adresse ersetzt. + TEXT[INT,2] := INT + +DECOD 7F 2F dddd dddd Der dezimale ASCII-Wert des Zeichens im TEXT an + der ersten Adresse wird im Wort an der zweiten + Adresse abgelegt. + INT := code (TEXT) + +ENCOD 7F 30 dddd dddd Dem der TEXT an der zweiten Adresse wird ein + Zeichen zugewiesen, das dem ASCII-Wert im Wort + an der ersten Adresse entspricht. + TEXT := code (INT) + +SUBT1 7F 31 dddd dddd dddd Dem TEXT an der dritten Adresse wird das + Zeichen des TEXTes an der ersten Adresse + zugewiesen, dessen Position durch das Wort an + der zweiten Adresse bestimmt ist. + TEXT := TEXT[INT, 1] + +SUBTFT 7F 32 dddd dddd dddd dddd Dem TEXT an der vierten Adresse wird ein + Teiltext des TEXTes an der ersten Adresse + zugewiesen, dessen Startposition im Wort an der + zweiten Adresse steht und dessen Endposition im + Wort an der dritten Adresse steht. + TEXT := subtext (TEXT, INT, INT) + +SUBTF 7F 33 dddd dddd dddd Dem TEXT an der dritten Adresse wird ein + Teiltext des TEXTes an der ersten Adresse + zugewiesen, der an der durch das Wort an der + zweiten Adresse beschriebenen Position beginnt + und bis zum Ende des Sourcetextes geht. + TEXT := subtext (TEXT, INT, length + (TEXT)) + +REPLAC 7F 34 dddd dddd dddd Der TEXT an der ersten Adresse wird ab der + Position, die durch das Wort an der zweiten + Position bestimmt wird, durch den TEXT an der + dritten Adresse ersetzt. + replace (TEXT, INT, TEXT) + +CAT 7F 35 dddd dddd Der TEXT an der zweiten Adresse wird an das + Ende des TEXTes an der ersten Adresse angefgt. + TEXT := TEXT + TEXT + +TLEN 7F 36 dddd dddd Die Lnge des TEXTes an der ersten Adresse wird + im Wort an der zweiten Adresse abgelegt. + INT := length (TEXT) + +POS 7F 37 dddd dddd dddd Die Position des ersten Auftretens des TEXTes + an der zweiten Adresse, innerhalb des TEXTes an + der ersten Adresse, wird im Wort an der dritten + Adresse abgelegt. + INT := pos (TEXT, TEXT, 1, length + (TEXT)) + +POSF 7F 38 dddd dddd dddd dddd + Die Position des ersten Auftretens des TEXTes + an der zweiten Adresse, innerhalb des TEXTes an + der ersten Adresse, ab der Position die durch + den Inhalt des Wortes an der dritten Adresse + bestimmt ist, wird im Wort an der vierten + Adresse abgelegt. + INT := pos (TEXT, TEXT, INT, + length (TEXT)) + +POSFT 7F 39 dddd dddd dddd dddd dddd + Die Position des ersten Auftretens des TEXTes + an der zweiten Adresse, innerhalb des TEXTes an + der ersten Adresse, ab der Position die durch + den Inhalt des Wortes an der dritten Adresse + bestimmt ist, bis zur Position die durch den + Inhalt des Wortes an der vierten Adresse + bestimmt ist, wird im Wort an der fnften + Adresse abgelegt. + INT := pos (TEXT, TEXT, INT, + INT) + +STRANL 7F 3A dddd dddd dddd dddd dddd dddd dddd + (ROW 256 INT CONST, INT VAR, INT CONST, + TEXT CONST, INT VAR, INT CONST, INT VAR): + Vereinfachte funktionsweise: + extension := FALSE ; + FOR INT FROM INT UPTO min (INT, + length (TEXT)) WHILE INT < INT + REP + IF extension + THEN extension := FALSE + ELSE INT:=ROW[TEXT[INT,1]]; + IF INT < 0 + THEN extension := TRUE ; + INT INCR (INT-8000H) + ELSE INT INCR INT + FI + FI + PER + +POSIF 7F 3B dddd dddd dddd dddd dddd + Die Position des ersten Auftretens des, durch + die beiden Zeichen des TEXTes an der zweiten + und dritten Adresse begrenzten ASCII-Bereichs + (lowchar, highchar), Zeichens innerhalb des + TEXTes an der ersten Adresse, wird ab der + Position, die durch das Wort an der vierten + Adresse beschrieben wird, im Wort an der + fnften Adresse abgelegt. + INT := pos (TEXT, TEXT, TEXT, + INT). + +GARB 7F 5F Es wird eine Garbagecollection fr den + taskeigenen TEXT-Heap durchgefhrt. + +HPSIZE 7F 5E dddd Die aktuelle Gre des TEXT-Heaps wird in dem + Wort an der Adresse dddd abgelegt. + := heapsize + +RTSUB 7F 64 dddd dddd dddd Aus dem TEXT an der ersten Adresse wird der + REAL-Wert, dessen Position durch das Wort an + der zweiten Adresse beschrieben wird, an der + dritten Adresse abgelegt. + REAL := TEXT[INT, 8] + +RTRPL 7F 65 dddd dddd dddd In dem TEXT an der ersten Adresse wird der + REAL-Wert, dessen Position durch das Wort an der + zweiten Adresse beschrieben wird, durch den + REAL-Wert an der dritten Adresse ersetzt. + TEXT[INT, 8] := REAL + + +#ub#2.1.5 DATASPACE-Operationen#ue# + +DSACC .58:dd dddd Die dsid an der ersten Adresse wird auf + Gltigkeit geprft und an der zweiten Adresse + eine Referenzaddresse abgelegt, die auf das + 4. Wort des Datenraumes (den Anfang des + Datenbereichs) zeigt. + IF valid ds (DS) + THEN REF := DATASPACE.ds base + ELSE "falscher DATASPACE-Zugriff" + FI + +ALIAS 7F 22 vvvv dddd dddd Dem BOUND-Objekt an der dritten Adresse wird + der Datenraum an der zweiten Adresse zugewiesen + (INT-Move). Zuvor wird geprft, ob dies der + erste Zugriff auf den Datenraum ist. Falls ja, + wird der Datenraumtyp auf 0 gesetzt. Falls ein + Heap aufgebaut werden mu und noch keiner + angelegt wurde, wird die Anfangsadresse des + Heaps auf den Wert vvvv+4 innerhalb des + Datenraumes gesetzt. + IF DATASPACE.typ < 0 + THEN DATASPACE.typ := 0 + FI ; + IF DATASPACE.heapanfang < 0 + THEN DATASPACE.heapanfang := vvvv+4 + FI ; + INT := INT + +NILDS 7F 45 dddd Dem Datenraum an der Adresse dddd wird der + 'nilspace' zugewiesen. + INT := 0 + +DSCOPY 7F 46 dddd dddd Dem Datenraum an der ersten Adresse wird eine + Kopie des Datenraumes an der zweiten Adresse + zugewiesen (neue dsid). Es wird ein neuer + Eintrag in die Datenraumverwaltung aufgenommen. + DATASPACE := DATASPACE + +DSFORG 7F 47 dddd Der Datenraum, dessen dsid an der Adresse dddd + steht, wird aus der Datenraumverwaltung + gelscht. + forget (DATASPACE) + +DSWTYP 7F 48 dddd dddd Der Typ des Datenraums, dessen dsid an der + ersten Adresse steht, wird auf den Wert des + Wortes an der zweiten Adresse gesetzt. + DATASPACE.typ := INT ; + IF DATASPACE.heapanfang < 0 + THEN DATASPACE.heapanfang := vvvv+4 + FI + +DSRTYP 7F 49 dddd dddd Der Typ des Datenraums, dessen dsid an der + ersten Adresse steht, wird in dem Wort an der + zweiten Adresse abgelegt. + INT := DATASPACE.typ ; + IF DATASPACE.heapanfang < 0 + THEN DATASPACE.heapanfang := vvvv+4 + FI + +DSHEAP 7F 4A dddd dddd Die Endaddresse Textheaps des Datenraums, dessen + dsid an der ersten Adresse steht, in 1kB + Einehiten, wird in dem Wort an der zweiten + Adresse abgelegt. Falls dieser Wert = 1023 oder + < 96 ist, ist kein Heap vorhanden, anderenfalls + ist seine Gre (in KB): -96. + INT := DATASPACE.heapende DIV 1024 + +NXTDSP 7F 4B dddd dddd dddd Fr den Datenraum an der ersten Adresse wird + die Nummer der Seite, die auf die Nummer der + Seite folgt, die in dem Wort an der zweiten Adresse + steht an der zweiten Adresse abgelegt. Falls + keine Seite mehr folt, wird -1 geliefert. + INT := nextdspage (DATASPACE, INT) + +DSPAGS 7F 4C dddd dddd dddd Fr den Datenraum mit der Nummer, die im Wort + an der ersten Adresse steht, und der Task deren + Nummer im Wort an der zweiten Adresse steht, + wird die Anzahl der belegten Seiten im Wort an + der dritten Adresse abgelegt. + INT := ds pages (INT, INT) + +SEND 7F 71 dddd dddd dddd dddd + Der Datenraum an der dritten Adresse wird der + Task, deren id an der ersten Adresse steht, mit + dem Messagecode der an der zweiten Adresse + steht, gesendet. Der Antwortcode wird im Wort + an der vierten Adresse abgelegt. Vereinfachte + Semantik: + send (TASK, INT, DATASPACE, INT) + +WAIT 7F 72 dddd dddd dddd Die eigene Task geht in einen offenen + Wartezustand, bei dem sie empfangsbereit ist fr + einen Datenraum einer anderen Task. Die id der + sendenden Task wird an der ersten Adresse + abgelegt, der Messagecode an der zweiten + Adresse, der gesendete Datenraum an der dritten + Adresse. Vereinfachte Semantik: + wait (TASK, INT, DATASPACE) + +SWCALL 7F 73 dddd dddd dddd dddd + Der Datenraum an der dritten Adresse wird der + Task, deren id an der ersten Adresse steht, mit + dem Messagecode der an der zweiten Adresse + steht, gesendet bis die Task empfangsbereit ist. + Dann wird auf einen zurckgesandten Datenraum + dieser Task gewartet, der an der dritten + Adresse abgelegt wird. Der zurckgesendete + Messagecode wird an der vierten Adresse + abgelegt. Vereinfachte Semantik: + REP + send (TASK, INT, DATASPACE,INT) + UNTIL INT <> task busy PER ; + wait (TASK, INT, DATASPACE) + +PPCALL 7F 7A dddd dddd dddd dddd + Wirkt wie SWCALL, wartet aber nicht bis die + Zieltask empfangsbereit ist, sondern liefert -2 + an der vierten Adresse zurck, wenn die Task + nicht empfangsbereit ist. Vereinfachte + Semantik: + send (TASK, INT, DATASPACE,INT); + IF INT <> task busy + THEN wait (TASK, INT, DATASPACE) + FI + +SENDFT 7F 7F dddd dddd dddd dddd dddd + Der Datenraum an der vierten Adresse wird der + Task, deren id an der zweiten Adresse steht, + mit dem Messagecode der an der dritten Adresse + steht, gesendet als ob er von der Task kme, + deren id an der ersten Adresse steht. Der + Antwortcode wird im Wort an der vierten + Adresse abgelegt. Dieser Befehl setzt eine + Priviligierung >= 1 voraus und ist nur wirksam, + wenn die from-Task einer anderen Station + angehrt. Vereinfachte Semantik: + IF station (TASK) = station (myself) + THEN send (TASK, INT, DATASPACE, + INT) + ELSE save myself := myself ; + myself := TASK ; + send (TASK, INT, DATASPACE, + INT) ; + myself := save myself + FI + + +#ub#2.1.6 TASK-Operationen#ue# + +TWCPU 7F 52 dddd dddd Die CPU-Zeit der Task, deren Nummer an der + ersten Adresse steht, wird auf den REAL-Wert, + der an der zweiten Adresse steht gesetzt. Dieser + Befehl setzt eine Privilegierung > 1 voraus + (Supervisor). + pcb(INT).clock := REAL + +TPBEGIN 7F 5F dddd dddd dddd aaaaaa + Als Sohn der Task, deren Nummer an der ersten + Adresse steht, wird eine Task eingerichtet, + deren Nummer an der zweiten Adresse steht. Die + neue Task erhlt die Privilegierung, deren + Nummer in dem Wort an der dritten Adresse + steht und wird mit der Prozedur gestartet, + deren Code bei der durch den vierten Parameter + bergebenen Refereznadresse beginnt. Dieser + Befehl setzt eine Privilegierung > 1 voraus + (Supervisor). + +TRPCB 7F 68 dddd dddd dddd Der Wert des Leitblockfeldes der Task + deren Nummer an der ersten Adresse steht und + der Nummer, die in dem Wort an der zweiten + Adresse steht, wird an der dritten Adresse + abgelegt. + INT := pcb(INT, INT) + +TWPCB 7F 69 dddd dddd dddd Der Wert an der dritten Adresse wird in das + Leitblockfeld mit der Nummer an der zweiten + Adresse der Task bertragen, deren Nummer an der + ersten Adresse steht. Privilegierung: + 0: Nur linenumber-Feld (0), der eigenen Task + 1: linenumber-Feld der eigenen Task und + prio-Feld (5) jeder Task + 2: Alle Felder + Fr den Fall, da die Privilegierung ok ist + gilt: + pcb (INT, INT) := INT + +TCPU 7F 6A dddd dddd Die CPU-Zeit der Task, deren Nummer an der + ersten Adresse steht, wird als REAL-Wert an der + zweiten Adresse abgelegt. + REAL := pcb (INT).clock + +TSTAT 7F 6B dddd dddd Der Status (busy, i/o, wait) der Task, deren + Nummer an der ersten Adresse steht, wird im Wort + an der zweiten Adresse abgelegt. + INT := pcb (INT).status + +ACT 7F 6C dddd Die Task mit der Nummer, die an der Adresse dddd + steht wird aktiviert (entblockt). Dieser Befehl + setzt eine Privilegierung >= 1 voraus. + activate (INT) + +DEACT 7F 6D dddd Die Task, deren Nummer an der Adresse dddd + steht, wird deaktiviert (geblockt). Dieser + Befehl setzt eine Privilegierung >= 1 voraus. + deactivate (INT) + +THALT 7F 6E dddd In der Task, deren Nummer an der Adresse dddd + steht, wird ein Fehler 'halt vom Terminal' + induziert. Dieser Befehl setzt eine + Privilegierung > 1 voraus (Supervisor). + halt process (INT) + +TBEGIN 7F 6F dddd aaaaaa Eine neue Task wird eingerichtet, deren Nummer + an der ersten Adresse steht. Die Adresse der + Startprozedur wird als Referenzadresse im + zweiten Parameter bergeben. Der Datenraum 4 + wird von der aufrufenden Task geerbt. Als + Privilegierung wird 0 eingetragen. + Dieser Befehl setzt eine Privilegierung > 1 + voraus (Supervisor). + +TEND 7F 70 dddd Die Task, deren Nummer an der Adresse dddd + steht, wird gelscht (alle Datenrume) und aus + der Prozessverwaltung entfernt. Dieser Befehl + setzt eine Privilegierung > 1 voraus + (Supervisor). + +PNACT 7F 76 dddd Die Nummer der nchsten aktivierten Task + wird aus der Aktivierungstabelle gelesen. Die + Suche beginnt mit dem Wert+1 an der Adresse. Die + Nummer nchsten aktivierten Task wird an dieser + Adresse abgelegt. + INT := next active (INT) + +DEFCOL 7F 80 dddd Die Task an der Adresse wird als Collectortask + (fr Datenaustausch zwischen Stationen) + definiert. Dieser Befehl setzt eine + Privilegierung >= 1 voraus. + TASK collector := TASK + + +#ub#2.1.7 Tests und Vergleiche#ue# + +Alle Tests und Vergleiche liefern ein BOOL-Resultat, welches den Opcode des +nachfolgenden Branch-Befehls bestimmt (Aus LN wird BT aus BR wird BF). + +TEST .28:dd Liefert TRUE, wenn das Wort an der Adresse 0 + ist (Auch fr BOOL-Variablen gebraucht: TRUE=0, + FALSE=1). + FLAG := = 0 + +EQU .2C:dd dddd Liefert TRUE, wenn die Wrter der beiden + Adressen gleich sind. + FLAG := = + +LSEQ .30:dd dddd Liefert TRUE, wenn der Wert des Wortes an der + ersten Adresse (vorzeichenbehaftet) kleiner oder + gleich dem Wert des Wortes an der zweiten + Adresse ist. + FLAG := INT <= INT + +FLSEQ .48:dd dddd Liefert TRUE, wenn der REAL-Wert an der ersten + Adresse kleiner oder gleich dem REAL-Wert an der + zweiten Adresse ist. + FLAG := REAL <= REAL + +FEQU 7F 24 dddd dddd Liefert TRUE, wenn der REAL-Wert an der ersten + Adresse gleich dem REAL-Wert an der zweiten + Adresse ist. + FLAG := REAL = REAL + +TLSEQ 7F 25 dddd dddd Liefert TRUE, wenn der TEXT an der ersten + Adresse kleiner oder gleich dem TEXT an der + zweiten Adresse ist. + FLAG := TEXT <= TEXT + +TEQU .50:dd dddd Liefert TRUE, wenn der TEXT an der ersten + Adresse gleich dem TEXT an der zweiten Adresse + ist. + FLAG := TEXT = TEXT + +ULSEQ .54:dd dddd Liefert TRUE, wenn der Wert des Wortes an der + ersten Adresse (vorzeichenlos) kleiner oder + gleich dem Wert des Wortes an der zweiten + Adresse ist. + FLAG := INT "<=" INT + +EQUIM 7C vv dddd Liefert TRUE, wenn der Wert des Wortes an der + Adresse dddd gleich der 8 Bit Konstanten vv + ist. + FLAG := INT = vv + +ISDIG 7F 12 dddd Liefert TRUE, wenn der ASCII-Code im Wort an + der Adresse dddd einer Ziffer entspricht. + FLAG := INT >= 48 AND INT <= 57 + +ISLD 7F 13 dddd Liefert TRUE, wenn der ASCII-Code im Wort an + der Adresse dddd einer Ziffer oder einem + Kleinbuchstaben entspricht. + FLAG := INT >= 48 AND INT <= 57 OR + INT >= 97 AND INT <= 122 + +ISLCAS 7F 14 dddd Liefert TRUE, wenn der ASCII-Code im Wort an + der Adresse dddd einem Kleinbuchstaben + entspricht. + FLAG := INT >= 97 AND INT <= 122 + +ISUCAS 7F 15 dddd Liefert TRUE, wenn der ASCII-Code im Wort an + der Adresse dddd einem Grobuchstaben + entspricht. + FLAG := INT >= 65 AND INT <= 90 + +ISSHA 7F 18 dddd Liefert TRUE, wenn der Wert des Wortes an der + Adresse dddd im Bereich 0..2047 liegt, d.h. + eine Kurzadresse ist, die noch zusammen mit dem + Opcode im ersten Wort eines Primrbefehls + untergebracht werden kann. + FLAG := INT < 2048 + +ISERR 7F 4E Liefert TRUE, wenn ein Fehlerzustand vorliegt. + FLAG := ERROR + +EXTASK 7F 7B dddd Liefert TRUE, wenn die Task, deren id an der + Adresse dddd steht, existiert (nicht "dead" und + korrekte Versionsnummer). + FLAG := TASK.version = + pcb (TASK.nr).version AND + pcb (TASK.nr).status <> dead + + +#ub#2.1.8 I/O-Operationen#ue# + +OUT 7F 3C dddd Der Text an der Adresse wird ausgegeben. + out (TEXT) + +COUT 7F 3D dddd Falls der Kanal frei ist und die INT-Zahl an + der Adresse dddd positiv ist, wird sie als + Dezimalzahl ausgegeben. + IF free (channel) + THEN out (text (INT, 5) + 5 * ""8"") + FI + +OUTF 7F 3E dddd dddd Der Text an der ersten Adresse wird ab der + Position, die durch den Wert des Wortes an der + zweiten Adresse bestimmt wird, bis zum Ende + ausgegeben. + out (subtext (TEXT, INT, length + (TEXT))) + +OUTFT 7F 3F dddd dddd dddd Der Text an der ersten Adresse wird ab der + Position, die durch den Wert an der zweiten + Adresse bestimmt wird, bis zur Position die + durch den Wert an der dritten Adresse bestimmt + wird, ausgegeben. + out (subtext (TEXT, INT, INT)) + +INCHAR 7F 40 dddd Es wird auf ein Eingabezeichen gewartet, + welches dann im TEXT an der Adresse dddd + abgelegt wird. + IF zeichen da (channel) + THEN TEXT := incharety + ELSE offener wartezustand (inchar) ; + TEXT := incharety + FI + +INCETY 7F 41 dddd Falls kein Eingabezeichen vorhanden ist, wird + im TEXT an der Adresse dddd niltext geliefert, + sonst das Eingabezeichen. + IF zeichen da (channel) + THEN TEXT := incharety + ELSE TEXT := "" + FI + +PAUSE 7F 42 dddd Der Wert an der Adresse dddd bestimmt die + Wartezeit in Zehntelsekunden, die gewartet + werden soll. Die Pause kann durch eine Eingabe + auf dem Kanal abgebrochen werden. + IF NOT zeichen da (channel) + THEN modi := INT ; + offener wartezustand (pause) + FI + +GCPOS 7F 43 dddd dddd Die Cursorposition wird erfragt. Die x-Position + wird an der ersten Adresse abgelegt, die + y-Position an der zweiten Adresse. + getcursor (INT, INT) + +CATINP 7F 44 dddd dddd Aus dem Eingabepuffer werden alle Zeichen + gelesen und an den TEXT an der ersten Adresse + gehngt, bis entweder der Eingabepuffer leer + ist oder ein Zeichen mit einem Code < 32 + gefunden wurde. Im ersten Fall wird niltext an + der zweiten Adresse abgelegt, im zweiten Fall + das Trennzeichen. + REP + IF zeichen da (channel) + THEN zeichen := incharety ; + IF code (zeichen) < 32 + THEN TEXT := zeichen + ELSE TEXT CAT zeichen + FI + ELSE TEXT := "" ; + LEAVE CATINP + FI + PER + +CONTRL 7F 54 dddd dddd dddd dddd + Der IO-Controlfunktion mit der Nummer, die + an der ersten Adresse steht, werden die beiden + Parameter bergeben, die an der zweiten und + dritten Adresse stehen. Die Rckmeldung wird + an der vierten Adresse abgelegt. + IF channel > 0 + THEN iocontrol (INT, INT, INT, + INT) + FI + +BLKOUT 7F 55 dddd dddd dddd dddd dddd + Die Seite des Datenraums, dessen dsid an der + ersten Adresse steht, mit der Seitennummer, die + an der zweiten Adresse steht, wird auf dem + aktuellen Kanal ausgegeben. Als Parameter + werden die Werte an der dritten und vierten + Adresse bergeben. Der Returncode wird an der + fnften Adresse abgelegt. + IF channel > 0 + THEN blockout (DATASPACE[INT, 512], + INT, INT, INT) + FI + +BLKIN 7F 56 dddd dddd dddd dddd dddd + Die Seite des Datenraums, dessen dsid an der + ersten Adresse steht, mit der Seitennummer, die + an der zweiten Adresse steht, wird an dem + aktuellen Kanal eingelesen. Als Parameter + werden die Werte an der dritten und vierten + Adresse bergeben. Der Returncode wird an der + fnften Adresse abgelegt. + IF channel > 0 + THEN blockout (DATASPACE[INT, 512], + INT, INT, INT) + FI + + +#ub#2.1.9 Ablaufsteuerung (Branch und Gosub)#ue# + +B .70:aa bzw. .74:aa Unbedingter Sprung an die Adresse. + ICOUNT := aaaa (aaaa gilt nur fr den + Debugger/Tracer, da die Adressrechung intern + komplizierter ist) + +BF .70:aa bzw. .74:aa Wenn der letzte Befehl FALSE lieferte, Sprung an + die Adresse. + IF NOT FLAG + THEN ICOUNT := aaaa (aaaa s.o.) + FI + +BT .00:aa bzw. .04:aa Wenn der letzte Befehl TRUE lieferte, Sprung an + die Adresse (auch LN-Opcode). + IF FLAG + THEN ICOUNT := aaaa (aaaa s.o.) + FI + +BRCOMP 7F 20 dddd vvvv Wenn das Wort an der Adresse dddd kleiner als 0 + oder grer als die Konstante vvvv ist, wird mit + dem auf den BRCOMP-Befehl folgenden Befehl + (i.d.R. ein B-Befehl) fortgefahren. Sonst wird + die Ausfhrung an der Adresse des + BRCOMP-Befehls + 2 + (dddd) (auch ein B-Befehl) + fortgesetzt. + IF >= 0 AND <= vvvv + THEN ICOUNT INCR ( + 1) + FI + +GOSUB 7F 05 aaaa Die aktuelle Codeadresse wird auf den Stack + gebracht und das Programm an der Adresse aaaa + fortgesetzt. + :=(LBASE, PBASE, ICOUNT, ENSTOP, ARITH) ; + LBASE := TOP ; + ICOUNT := aaaa ; + CMOD := high (ICOUNT) + 16 + +GORET 7F 07 Das Programm wird an der oben auf dem Stack + stehenden Returnadresse fortgesetzt. + TOP := LBASE ; + SP := TOP + 4 ; + (LBASE, PBASE, ICOUNT, ENSTOP, ARITH) := + + +#ub#2.1.10 Modul-Operationen#ue# + +PPV .68:dd Das Wort an der Adresse wird auf den Stack + gebracht. Dieser Befehl wird vom Compiler nicht + generiert. + := INT ; + SP INCR 2 + +PP .6C:dd Die Referenzadresse des Objektes wird auf den + Stack gebracht (2 Worte). + := REF d1 ; + SP INCR 2 + +PPROC 7F 1E mmmm Die Adresse der Prozedur mit der Modulnummer + mmmm wird als Referenzadresse (Codesegment, + Codeadresse) auf den Stack gebracht. + := mod addr (mmmm) ; + SP INCR 2 + +HEAD vvvv (kein Opcode) Der Speicherplatz fr lokale Variablen und + Parameter in diesem Modul wird vermerkt, indem + der Stacktop um vvvv erhoht wird. + TOP INCR vvvv ; + SP := TOP + 4 + +PENTER FE vv Die Paketbasis (Basis der globalen Adressen + dieses Moduls) wird auf den Wert vv*256 + gesetzt. + PBASE := vv * 256 + +CALL .78:mm Das Modul mit der Nummer mm wird aufgerufen. + :=(LBASE, PBASE, ICOUNT, ENSTOP, ARITH) ; + LBASE := TOP ; + ICOUNT := mod addr (mm) ; + CMOD := high (ICOUNT) + 16 + +PCALL 7F 1F dddd Die (Parameter-)Prozedur, deren Startadresse + als Referenzadresse auf dem Stack steht, wird + aufgerufen. + :=(LBASE, PBASE, ICOUNT, ENSTOP, ARITH) ; + LBASE := TOP ; + ICOUNT := d1 ; + CMOD := high (ICOUNT) + 16 . + +EXEC 7F 1D dddd Das Modul dessen Nummer in dem Wort an der + Adresse dddd steht, wird aufgerufen. + :=(LBASE, PBASE, ICOUNT, ENSTOP, ARITH) ; + LBASE := TOP ; + ICOUNT := ; + CMOD := high (ICOUNT) + 16 . + +RTN 7F 00 Das Modul wird verlassen, die + Programmausfhrung setzt an der, auf dem Stack + gesicherten, Adresse fort. + TOP := LBASE ; + SP := TOP + 4 ; + (LBASE, PBASE, ICOUNT, ENSTOP, ARITH) := + +RTNT 7F 01 Das Modul wird verlassen und der BOOL-Wert TRUE + geliefert (fr den dem CALL/PCALL folgenden + BT/BF-Befehl). Die Programmausfhrung setzt an + der, auf dem Stack gesicherten, Adresse fort. + TOP := LBASE ; + SP := TOP + 4 ; + (LBASE, PBASE, ICOUNT, ENSTOP, ARITH) := ; + FLAG := TRUE + +RTNF 7F 02 Das Modul wird verlassen und der BOOL-Wert + FALSE geliefert (fr den dem CALL/PCALL + folgenden BT/BF-Befehl). Die Programmausfhrung setzt an + der, auf dem Stack gesicherten, Adresse fort. + TOP := LBASE ; + SP := TOP + 4 ; + (LBASE, PBASE, ICOUNT, ENSTOP, ARITH) := ; + FLAG := FALSE + + +#ub#2.1.10 Datenadressrechnung#ue# + +REF .5C:dd dddd An der zweiten Adresse wird die Referenzadresse + der ersten Adresse abgelegt (2 Wrt-MOV). + REF := d1 + +SUBS .60:vv vvvv dddd dddd dddd + Wenn der Inhalt des Wortes an der dritten + Adresse (ROW-Index) grer oder gleich der + Konstanten vvvv (limit-1) ist, wird "Subscript + berlauf" gemeldet, falls der ROW-Index kleiner + als eins ist wird "Subscript nterlauf" + gemeldet. Andernfalls wird der um eins + verringerte ROW-Index mit der Konstanten vv + (Size eines ROW-Elements) multipliziert, + zur Basisaddresse (vierter Parameter) addiert + und als Referenzadresse an der fnften Adresse + abgelegt. + IF INT <= vvvv AND INT > 0 + THEN REF := d2 + vv * (INT-1) + ELSE "Fehler" s.o. + FI + +SEL .64:dd vvvv dddd Die Konstante vvvv (Selektor-Offset einer + STRUCT) wird zur Adresse dd addiert und als + Referenzadresse auf dem Stack an der Adresse + dddd abgelegt. + REF := vv + d1 + +CTT 7F 0C dddd dddd Die Adresse des Strings(!) an der ersten + Adresse wird an der zweiten Adresse als + Referenzadresse (Segment 0, DS 4) abgelegt. + CTT steht fr Compiler-Table-Text. + REF := REF (0004, INT) + + +#ub#2.1.12 Compiler-Spezialbefehle#ue# + +PUTW FD v1v2 dddd dddd Das lowbyte des Opcode besteht aus den beiden + Nibbles v1 (Segment) und v2 (Wordoffset). Das + Wort an der zweiten dddd-Adresse wird an die + Adresse im Datenraum 4, Segment v1 geschrieben, + die durch den Wert des Wortes an der ersten + dddd-Adresse + v2 bestimmt ist. + + v2> := INT + +GETW 7E v1v2 dddd dddd Das lowbyte des Opcode besteht aus den beiden + Nibble v1 (Segment) und v2 (Wordoffset). Das + Wort im Datenraum 4, Segment v1 an der durch + den Wert des Wortes an der ersten dddd-Adresse + + v2 bestimmten Adresse wird an der zweiten + dddd-Adresse abgelegt. + INT := + v2) + +PW 7F 6F dddd dddd dddd Das Wort an der dritten Adresse wird im + Datenraum 4 an die Adresse geschrieben, die + durch das Segment (erste Adresse) und die + Adresse in diesem Segment (zweite Adresse) + bestimmt ist. + * 64KW + INT> := INT + +GW 7F 70 dddd dddd dddd Das Wort im Datenraum 4, das durch das Segment + (erste Adresse) und die Adresse in diesem + Segment (zweite Adresse) bestimmt ist, wird an + der dritte Adresse abgelegt. + INT := * 64KW + INT> + +BCRD 7F 08 dddd dddd Bereitet das Lesen einzelner Zeichen aus dem + Segment 4 des Datenraumes 4 vor (Nametable). + Das Wort an der ersten Adresse enthlt die + Startadresse des Strings und zeigt auf das + Lngenbyte. Nach dem Ausfhren des Befehls + enthlt das Wort an der zweiten Adresse das + Lngenbyte und der Pointer an der ersten + Adresse zeigt auf das erste Zeichen des Textes. + Das Bit 15 des Pointers ist gesetzt, wenn das + highbyte adressiert wird. + INT := length (STRING) ; + INT INCR 1/2 + +CRD 7F 09 dddd dddd Liest ein Zeichen aus dem String, dessen Lesen + mit BCRD vorbereitet wurde. Die erste Adresse + enthlt einen Stringpointer, der nach jedem + Lesen erhht wird, die zweite Adresse enthlt + nach dem Aufruf des Befehls den Code des + gelesenen Zeichens. + INT := code (STRING) ; + INT INCR 1/2 + +CWR 7F 0B dddd dddd dddd Der Hashcode an der ersten Adresse wird mit dem + zu schreibenden Zeichencode (dritte Adresse) + verknpft und in den Bereich 0..1023 gemapt. + Das Zeichen wird an die Position des Pointers + geschrieben (Bit 15 des Pointers unterscheidet + lowbyte und highbyte). Anschlieend wird der + Pointer auf die Adresse des nchsten Zeichens + gesetzt. Der Pointer steht an der zweiten + Adresse. Vor dem Schreiben des ersten Zeichens + mu der Hashcode auf 0 gesetzt werden. + INT INCR INT ; + IF INT > 1023 THEN INT DECR 1023 FI ; + INT := (INT + INT) MOD 1024 ; + STRING> := code (INT) ; + INT INCR 1/2 + +ECWR 7F 0A dddd dddd dddd Das Schreiben eines Strings wird beendet. Dazu + wird an der ersten Adresse der Stringpointer + bergegeben, an der zweiten Adresse wird die + endgltige Stringlnge geliefert. An der + dritten Adresse wird die Adresse des nchsten + freien Platzes nach diesem Stringende + geliefert. + +GETC 7F 0D dddd dddd dddd Dieser Befehl liefert ein BOOL-Result und zwar + TRUE, wenn das Wort an der zweiten Adresse + grer als 0 und kleiner als die Lnge des + TEXTes an der ersten Adresse ist. In diesem Fall + wird im Wort an der dritten Adresse der Code + des n. Zeichens des TEXTes geliefert. Die + Position des Zeichens wird durch das Wort an + der zweiten Adresse bestimmt. + FLAG := INT > 0 AND INT <= length + (TEXT) ; + INT := code (TEXT[INT, 1]) + +FNONBL 7F 0E dddd dddd dddd Dieser Befehl liefert ein BOOL-Result. + zaehler := INT ; (* Stringpointer *) + WHILE TEXT[zahler, 1] = " " REP + zaehler INCR 1 + PER ; + IF zaehler > length (TEXT) + THEN FLAG := FALSE + ELSE INT := code (TEXT[zaehler, 1]); + INT := zaehler + 1 + FI + +DREM256 7F 0F dddd dddd Das lowbyte des Wortes an der ersten Adresse + wird in das Wort an der zweiten Adresse + geschrieben, das highbyte des Wortes an der + ersten Adresse ersetzt das gesamte erste Wort. + INT := INT MOD 256 ; + INT := INT DIV 256 + +AMUL256 7F 10 dddd dddd Umkerung von DREM256. + INT := INT * 256 + INT + +GADDR 7F 16 dddd dddd dddd "Adresswort" mit Adresstyp generieren (z.B. + = pbase). + IF INT >= 0 (* Global *) + THEN INT := INT - INT + ELIF bit (INT, 14) (* Local Ref *) + THEN INT := (INT AND 3FFFH)*2 + 1 + ELSE INT := (INT AND 3FFFH)*2 + (* Local *) + FI + +GCADDR 7F 17 dddd dddd dddd Diese Instruktion liefert ein BOOL-Result. + Mit = 0 wird sie eingesetzt, um die + Zeilennummer im LN-Befehl zu generieren, mit + <> 0 wird sie eingesetzt, um die Adresse im + Branchbefehl zu generieren. Beide Befehle gibt + es mit zwei Opcodes (00/04 bzw. 70/74). + byte := high(INT)-high(INT) ; + IF byte < 0 + THEN byte INCR 16 ; (* Bit fr LN1 bzw. B1 + Opcode *) + rotate (byte, right) ; + FI ; + INT := byte * 256 + low (INT) ; + FALSE, wenn irgendeins der Bits 11..14 = 1 ist + +GETTAB 7F 1A Kopiert den Inhalt der unteren 64KB des + Segments 5 im DS 4 in das Segment 4. + (permanentes Segment --> temporres Segment) + DS4: 50000..57FFF --> 40000..47FFF (Wortaddr) + +PUTTAB 7F 1B Kopiert den Inhalt der unteren 64KB des Segments + 4 im DS 4 in das Segment 5. (Temporre Daten + werden permanent) + DS4: 40000..47FFF --> 50000..57FFF (Wortaddr) + +ERTAB 7F 1C Kopiert den Inhalt des Segments 6 im DS 4 + (besteht nur aus FF's) in die Segmente 4 und 7, + d.h. das temporre Segment (u.a. Symboltabelle) + und das Segment mit Compiler-Intermediatestring + werden gelscht. + DS4: 60000..6FDFF --> 40000..4FDFF ; + DS4: 60000..6FDFF --> 70000..7FDFF + +CDBINT 7F 74 dddd dddd Das Wort mit der Nummer wird aus dem + Segment 5 gelesen und in abgelegt. + INT := <50000H + INT> + +CDBTXT 7F 74 dddd dddd Der String(!) an der Adresse im Segment 5 + wird in dem TEXT abgelegt. + TEXT := ctt (<50000H + INT>) + + +#ub#2.1.13 Instruktionen zur Programmsteuerung#ue# + +STOP 7F 04 Alle (aufrufenden) Module werden verlassen, bis + das erste im 'disablestop'-Zustand angetroffen + wird (hnlich errorstop ("")) ; + WHILE ENSTOP REP return PER . + + return: + TOP := LBASE ; + SP := TOP + 4 ; + (LBASE, PBASE, ICOUNT, ENSTOP, ARITH) := + +ESTOP 7F 4B Der 'enable stop'-Zustand wird eingeschaltet. + ENSTOP := TRUE + +DSTOP 7F 4C Der 'disable stop'-Zustand wird eingeschaltet. + ENSTOP := FALSE + +SETERR 7F 4D dddd Es wird der Fehlerzustand eingeschaltet, das + Wort an der Adresse dddd wird in das pcb-Feld + 'error code' gebracht. Falls das Modul im + 'enablestop'-Zustand ist, wird das Modul + verlassen. + IF NOT ERROR + THEN ERROR := TRUE ; + pcb.error line := pcb.line ; + pcb.error code := INT ; + WHILE ENSTOP REP return PER + FI + +CLRERR 7F 4F Falls der Fehlerzustand vorliegt, wird der + Fehler gelscht. + ERROR := FALSE + +LN .00:vv und .04:vv Die Konstante vv wird in das pcb-Feld + 'line number' gebracht (Zur Fehlerbehandlung). + pcb.line := vv + +RPCB 7F 50 dddd dddd Der Inhalt des pcb-Feldes der eigenen Task mit + der Nummer, die im Wort an der ersten Adresse + steht, wird in das Wort an der zweiten Adresse + gebracht. + INT := pcb (myself, INT[) + +CLOCK 7F 66 dddd dddd Die Systemuhr mit der Nummer, die durch den + Wert des Wortes an der ersten Adresse + spezifiziert wird, wird gelesen und deren + REAL-Wert an der zweiten Adresse abgelegt. + Wenn = 0 ist, wird die CPU-Zeit der + eigenen Task geliefert, anderenfalls die + Systemuhr mit der Nummer 1..7 : + Nummer Funktion + 1 REAL-Time + 2 Paging Wait + 3 Paging Busy + 4 Foreground Tasks cpu-time + 5 Background Tasks cpu-time + 6 System cpu-time + 7 Reserviert + + IF INT = 0 + THEN REAL := pcb.clock + ELSE REAL := clock (INT) + FI + + +#ub#2.1.14 Systemglobale Instruktionen#ue# + +KE 7F 06 Der EUMEL0-Debugger 'Info' wird aufgerufen, + falls dies ein infofhiges System ist. + +SYSG 7F 19 Sysgen (Nur beim Sysgen-Urlader). + +INFOPW 7F 51 dddd dddd dddd Das bis zu 10 Zeichen lange Infopassword an der + zweiten Adresse (TEXT) wird eingestellt, falls + das alte Infopassword mit dem TEXT an der + ersten Adresse bereinstimmt. In diesem Fall + wird im Wort an der dritten Adresse eine 0 + abgelegt, andernfalls eine 1. Dies ist kein + privilegierter Befehl, er funktioniert + allerdings nur, wenn das alte Infopasswort + bekannt ist. + IF info password = TEXT + THEN info password := TEXT ; + INT := 0 + ELSE INT := 1 + FI + +STORAGE 7F 5A dddd dddd Die Gre des vorhandene Hintergrundspeichers + in KB wird im Wort an der ersten Adresse + abgelegt, die Gre des benutzten + Hintergrundspeichers an der zweiten Adresse. + INT := size ; + INT := used + +SYSOP 7F 5B dddd Es wird eine Systemoperation mit der Nummer, + die an der Adresse dddd steht, aufgerufen + (1=Garbage Collection, 11=Savesystem, 4=Shutup, + 2=Fixpoint). Dieser Befehl setzt eine + Privilegierung >= 1 voraus. + +SETNOW 7F 67 dddd Die Realtime-Clock (clock(1)) des Systems wird + auf den REAL-Wert an der Adresse dddd gesetzt. + Dieser Befehl setzt eine Privilegierung >= 1 + voraus. + clock (1) := REAL + +SESSION 7F 7E dddd Der aktuelle Wert des Systemlaufzhlers wird + an der Adresse dddd abgelegt. + INT := systemlaufzaehler + +ID 7F 81 dddd dddd Der Wert des id-Feldes mit der Nummer, die an + der ersten Adresse steht, wird in das Wort an + der zweiten Adresse geschrieben. Fr dei + Nummern der id-Felder gilt: + Feld Inhalt + 0 Kleinste HG-Version fr EUMEL0 + 1 CPU-Type (1=Z80,3=8086,4=68000,5=80286) + 2 Urlader-Version + 3 Reserviert + 4 Lizenznummer des Shards + 5 Installationsnummer + 6 Frei fr Shard + 7 Frei fr Shard + IF INT < 4 + THEN INT := eumel0 id (INT) + ELSE INT := shard id (INT) + FI + + +#ub#2.1 Alphabetische Liste der Befehle#ue# + +ACT 7F 6C dddd +ADD .1C:dd dddd dddd +ALIAS 7F 22 vvvv dddd dddd +AMUL256 7F 10 dddd dddd +AND 7F 7C dddd dddd dddd +ARITHS 7F 5B +ARITHU 7F 5C +B .70:aa bzw. .74:aa +BCRD 7F 08 dddd dddd +BF .70:aa bzw. .74:aa +BLKIN 7F 56 dddd dddd dddd dddd dddd +BLKOUT 7F 55 dddd dddd dddd dddd dddd +BRCOMP 7F 20 dddd vvvv +BT .00:aa bzw. .04:aa +CALL .78:mm +CAT 7F 35 dddd dddd +CATINP 7F 44 dddd dddd +CDBINT 7F 74 dddd dddd +CDBTXT 7F 74 dddd dddd +CLEAR .24:dd +CLOCK 7F 66 dddd dddd +CLRERR 7F 4F +CONTRL 7F 54 dddd dddd dddd dddd +COUT 7F 3D dddd +CRD 7F 09 dddd dddd +CTT 7F 0C dddd dddd +CWR 7F 0B dddd dddd dddd +DEACT 7F 6D dddd +DEC .18:dd dddd +DEC1 .10:dd +DECOD 7F 2F dddd dddd +DEFCOL 7F 80 dddd +DIV 7F 2A dddd dddd dddd +DREM256 7F 0F dddd dddd +DSACC .58:dd dddd +DSCOPY 7F 46 dddd dddd +DSFORG 7F 47 dddd +DSHEAP 7F 4A dddd dddd +DSPAGS 7F 4C dddd dddd dddd +DSRTYP 7F 49 dddd dddd +DSTOP 7F 4C +DSWTYP 7F 48 dddd dddd +ECWR 7F 0A dddd dddd dddd +ENCOD 7F 30 dddd dddd +EQU .2C:dd dddd +EQUIM 7C vv dddd +ERTAB 7F 1C +ESTOP 7F 4B +EXEC 7F 1D dddd +EXTASK 7F 7B dddd +FADD .38:dd dddd dddd +FDIV .44:dd dddd dddd +FEQU 7F 24 dddd dddd +FLOOR 7F 63 dddd dddd +FLSEQ .48:dd dddd +FMOV .34:dd dddd +FMUL .40:dd dddd dddd +FNEG 7F 26 dddd +FNONBL 7F 0E dddd dddd dddd +FSLD 7F 60 dddd dddd dddd +FSUB .3C:dd dddd dddd +GADDR 7F 16 dddd dddd dddd +GARB 7F 5F +GCADDR 7F 17 dddd dddd dddd +GCPOS 7F 43 dddd dddd +GETC 7F 0D dddd dddd dddd +GETTAB 7F 1A +GETW 7E v1v2 dddd dddd +GEXP 7F 61 dddd dddd +GORET 7F 07 +GOSUB 7F 05 aaaa +GW 7F 70 dddd dddd dddd +HEAD vvvv (kein Opcode) +HPSIZE 7F 5E dddd +ID 7F 81 dddd dddd +IMULT 7F 28 dddd dddd dddd +INC .14:dd dddd +INC1 .0C:dd +INCETY 7F 41 dddd +INCHAR 7F 40 dddd +INFOPW 7F 51 dddd dddd dddd +ISDIG 7F 11 dddd +ISERR 7F 4E +ISLCAS 7F 13 dddd +ISLD 7F 12 dddd +ISSHA 7F 18 dddd +ISUCAS 7F 14 dddd +ITRPL 7F 2E dddd dddd dddd +ITSUB 7F 2D dddd dddd dddd +KE 7F 06 +LN .00:vv und .04:vv +LSEQ .30:dd dddd +MOD 7F 2B dddd dddd dddd +MOV .08:dd dddd +MOVi FC vv dddd +MOVii 7F 23 vvvv dddd +MOVx 7D vv dddd dddd +MOVxx 7F 21 vvvv dddd dddd +MUL 7F 29 dddd dddd dddd +NEG 7F 27 dddd +NILDS 7F 45 dddd +NXTDSP 7F 4B dddd dddd dddd +OR 7F 7D dddd dddd dddd +OUT 7F 3C dddd +OUTF 7F 3E dddd dddd +OUTFT 7F 3F dddd dddd dddd +PAUSE 7F 42 dddd +PCALL 7F 1F dddd +PENTER FE vv +PNACT 7F 76 dddd +POS 7F 37 dddd dddd dddd +POSF 7F 38 dddd dddd dddd dddd +POSFT 7F 39 dddd dddd dddd dddd dddd +POSIF 7F 3B dddd dddd dddd dddd dddd +PP .6C:dd +PPCALL 7F 7A dddd dddd dddd dddd +PPROC 7F 1E mmmm +PPV .68:dd +PUTTAB 7F 1B +PUTW FD v1v2 dddd dddd +PW 7F 6F dddd dddd dddd +REF .5C:dd dddd +REPLAC 7F 34 dddd dddd dddd +ROTATE 7F 53 dddd dddd +RPCB 7F 50 dddd dddd +RTN 7F 00 +RTNF 7F 02 +RTNT 7F 01 +RTRPL 7F 65 dddd dddd dddd +RTSUB 7F 64 dddd dddd dddd +SEL .64:dd vvvv dddd +SEND 7F 71 dddd dddd dddd dddd +SENDFT 7F 7F dddd dddd dddd dddd dddd +SESSION 7F 7E dddd +SETERR 7F 4D dddd +SETNOW 7F 67 dddd +SEXP 7F 62 dddd dddd +STOP 7F 04 +STORAGE 7F 5A dddd dddd +STRANL 7F 3A dddd dddd dddd dddd dddd dddd dddd +SUB .20:dd dddd dddd +SUBS .60:vv vvvv dddd dddd dddd +SUBT1 7F 31 dddd dddd dddd +SUBTF 7F 33 dddd dddd dddd +SUBTFT 7F 32 dddd dddd dddd dddd +SWCALL 7F 73 dddd dddd dddd dddd +SYSG 7F 19 +SYSOP 7F 5B dddd +TBEGIN 7F 6F dddd aaaaaa +TCPU 7F 6A dddd dddd +TEND 7F 70 dddd +TEQU .50:dd dddd +TEST .28:dd +THALT 7F 6E dddd +TLEN 7F 36 dddd dddd +TLSEQ 7F 25 dddd dddd +TMOV .4C:dd dddd +TPBEGIN 7F 5F dddd dddd dddd aaaaaa +TRPCB 7F 68 dddd dddd dddd +TSTAT 7F 6B dddd dddd +TWCPU 7F 52 dddd dddd +TWPCB 7F 69 dddd dddd dddd +ULSEQ .54:dd dddd +WAIT 7F 72 dddd dddd dddd +XOR 7F 79 dddd dddd dddd + +#page# +#ub#3. Beschreibung der Pakete#ue# + +#ub#3.1 PACKET address#ue# + +Mit diesem Paket werden die Operationen fr 16 Bit Adressrechnung zur +Verfgung gestellt. + +TEXT PROC hex8 (INT CONST dez) : + Der INT-Parameter (0..255) wird in eine 2-Zeichen Hexdarstellung + konvertiert. + + +TEXT PROC hex16 (INT CONST dez) : + Der INT-Parameter (0..65535) wird in eine 4-Zeichen + Hexdarstellung (ohne Vorzeichen) konvertiert. + + +INT PROC integer (TEXT CONST hex) : + Der TEXT-Parameter (1-4 Byte Hexdarstellung, 0..9, a..f/A..F) wird in eine + Dezimalzahl konvertiert. + + +INT PROC getword (INT CONST segment, address) : + Das Wort an der Adresse 'address' (0..65535) im Segment 'segment' (0..7) + wird gelesen. + + +PROC putword (INT CONST segment, address, value) : + Der Wert 'value' wird in das Wort an der Adresse 'address' (0..65535) im + Segment 'segment' (0..7) geschrieben. + + +INT PROC cdbint (INT CONST address) : + Der Wert an der Adresse 'address' (0..32767 sinnvoll) im Segment 5 + (permanente Compilertabellen) wird gelesen. + + +TEXT PROC cdbtext (INT CONST address) : + Der String, der an der Adresse 'address' im Segment 5 (permanente + Compilertabellen) beginnt, wird als TEXT gelesen. + + +PROC splitword (INT VAR word, lowbyte) : + Das Wort 'word' wird in den hherwertigen und niederwertigen Teil zerlegt. + Das highbyte steht nach dieser Operation in 'word', das lowbyte in + 'lowbyte'. + + +PROC makeword (INT VAR word, INT CONST lowbyte) : + word := word * 256 + lowbyte + + +BOOL PROC ulseq (INT CONST left, right) : + '<=' fr positive INT-Zahlen (0..65535). + + +OP INC (INT VAR word) : + 'word INCR 1' fr positive INT-Zahlen (0..65535), ohne da ein berlauf + auftritt. + + +OP DEC (INT VAR word) : + 'word DECR 1' fr poistive INT-Zahlen (0..65535), ohne da ein Unterlauf + auftritt. + + +INT OP ADD (INT CONST left, right) : + 'left + right' fr positive INT-Zahlen (0..65535), ohne da ein berlauf + auftritt. + + +INT OP SUB (INT CONST left, right) : + 'left - right' fr positive INT-Zahlen (0..65535), ohne da ein berlauf + auftritt. + + +INT OP MUL (INT CONST left, right) : + 'left * right' fr positive INT-Zahlen (0..65535), ohne da ein berlauf + auftritt. + + +#ub#3.2 PACKET table routines#ue# + +PROC init module table (TEXT CONST name) : + Ein benannter Datenraum ('name') wird eingerichtet. Dieser enthlt die + aufbereitete Permanenttabelle fr schnelle Zugriffe. Die Datenstruktur + beschreibt drei Tabellen (PACKETTABLE, MODULETABLE, TYPETABLE), ber die + zu einer Modulnummer deren Name und deren Parameter, sowie der zugehrige + Paketname gefunden werden kann, wenn sie in der Permanenttabelle steht. + Die TYPETABLE enthlt zu jedem TYPE, der in der Permanenttabelle steht, + seine Gre in Words. + + +PROC add modules : + Module und Typen neu insertierter Pakete werden in die 'module table' + aufgenommen. + + +PROC dump tables (TEXT CONST name) : + Der Inhalt der geladenen Modultabelle wird in der FILE 'name' ausgedumpt. + + +TEXT PROC module name and specifications (INT CONST module number) : + Der Name und die Parameter des Moduls mit der Nummer 'module number' + (0..2047) wird als TEXT geliefert. Falls das Modul nicht in der + Permanenttabelle steht, wird niltext geliefert. + + +TEXT PROC packetname (INT CONST module number) : + Der Name des Pakets, das das Modul mit der Nummer 'module number' + definiert, wird als TEXT geliefert. Falls das Modul nicht in der + Permanenttabelle steht, wird der Name des letzten vorher insertierten + Pakets geliefert (In manchen Fllen also nicht der wahre Paketname). + + +INT PROC storage (TEXT CONST typename) : + Aus der Modultabelle wird Gre des TYPEs mit dem Namen 'typname' gelesen. + Wenn der Typ nicht in der Permanenttabelle steht, wird 0 geliefert. + + +PROC getmodulenumber (INT VAR module number) : + Erfragt eine Modulnummer am Bildschirm. Der Benutzer kann entweder eine + Zahl eingeben oder den Namen einer PROC/OP. Wenn mehrere Module mit diesem + Namen existieren, wird eine Auswahlliste angeboten. In 'module number' + wird die ausgewhlte Modulnummer bergeben. + + +INT PROC codeaddress (INT CONST module number) : + Liefert die Anfangsadresse des Moduls mit der Nummer 'module number'. + + +INT PROC codesegment (INT CONST module number) : + Liefert die Nummer des Codesegments, in dem der Code des Moduls mit der + Nummer 'module number' steht. + + +INT PROC hash (TEXT CONST object name) : + Berechnet den Hashcode des Objekts 'object name', um ber die Hashtable, + Nametable, Permanenttable die Parameter eines Objekts zu suchen. + + +#ub#3.3 PACKET eumel decoder#ue# + +#ub#3.3.1 Zugriff auf globale Parameter#ue# + +PROC default no runtime : + Bereitet den Decoder darauf vor, da keine runtime vorliegt, d.h. + Stackzugriffe nicht sinnvoll sind. Fr Parameter mit lokalen Adressen + werden deshalb keine Variableninhalte dargestellt. Bei fast allen + Decoderaufrufen mit 'decode'/'decode module' bis auf die 'decode' mit + mehr als zwei Parametern, wird 'default no runtime' automatisch aufgerufen. + + +PROC set parameters (INT CONST lbase, pbase, line number, c8k) : +PROC get parameters (INT VAR lbase, pbase, line number, c8k) : + Einstell- und Informationsprozeduren (fr den Tracer). 'lbase' ist die + lokale Basis (Stackoffset fr dies Modul), 'pbase' ist das highbyte der + Paketbasis, 'line number' ist die letzte 'LN'-Zeilennummer, 'c8k' (cmod) + wird von EUMEL0 beim Eintritt in ein Modul auf + high (Modulstartaddresse + 16KB) gesetzt (fr Branch-Befehle). + + +PROC pbase (INT CONST pbase highbyte) : +INT PROC pbase : + Einstell- und Informationsprozeduren, nicht nur fr den Tracer. Die + Paketbasis (Globale Daten) wird gesetzt. Dazu wird nur das Highbyte (z.B. + nach 'PENTER') bergeben. + + +PROC lbase (INT CONST local base) : + Einstellprozedur fr den Tracer. Stellt whrend der runtime die aktuelle + Basis ein. Wird der Decoder nicht whrend runtime betrieben, sollte + lbase(-1) eingestellt werden. + + +INT PROC line number : + Liefert die letzte, mit 'LN' eingestellte, Zeilennummer. + +PROC list filename (TEXT CONST name) : + Stellt den Namens-Prefix der Outputfiles ein. Voreingestellt ist "". An + den Filename wird ".n" angehngt, wobei n mit '0' beginnt. + +PROC bool result (BOOL CONST status) : +BOOL PROC bool result : + Einstell- und Informationsprozeduren, die fr den Tracer bentigt werden. + Lieferte der letzte disassemblierte Befehl ein BOOL-Result ? + +PROC with object address (BOOL CONST status) : +BOOL with object address : + Einstell- und Informationsprozeduren, nicht nur fr den Tracer. Sollen + auer den Darstellungen der Speicherinhalte auch die Parameteradressen (in + spitzen Klammern) ausgegeben werden ? + +PROC with code words (BOOL CONST status) : +BOOL PROC with code words : + Einstell- und Informationsprozeduren, nicht fr den Tracer. Sollen ab der + 80. Spalte in der Outputfile die Hexdarstellungen der dekodierten + Codewrter ausgegeben werden ? + + +#ub#3.3.2 Aufruf des Disassemblers#ue# + +PROC decode : + Aufruf des Decoders. Die Modulnummer der ersten zu dekodierenden Prozedur + wird erfragt. Die Modultabelle wird ggf. ergnzt, es wird 'default no + runtime' eingestellt. + + +PROC decode (INT CONST first module number) : + Aufruf des Decoders. Die Modulnummer der ersten zu dekodierenden Prozedur + wird bergeben. Die Modultabelle wird ggf. ergnzt, es wird 'default no + runtime' eingestellt. + + +PROC decode (INT CONST segment, address) : + Aufruf des Decoders. Die Disassemblierung beginnt in dem + Codesegment/Adresse, das/die als Parameter bergeben wird. Die Modultabelle + wird ggf. ergnzt, es wird 'default no runtime' eingestellt. + + +PROC decode (INT CONST segment, INT VAR address, INT CONST to addr, + BOOL CONST only one module) : + Dieser Decoderaufruf setzt kein 'default no runtime', erweitert aber ggf. + die Modultabelle. Der bei 'address' beginnende und bei 'to addr' endende + Adressbereich im Codesegment 'segment' wird dekodiert. Ist 'only one + module' TRUE, wird nur bis zum Ende des aktuellen Moduls dekodiert. + 'address' zeigt nach dem Prozeduraufruf auf die nchste Instruktion nach + 'to addr'. + + +PROC decode (INT CONST segment, INT VAR address, TEXT VAR words, + instruction, INT PROC (INT CONST, INT VAR, TEXT VAR) next word)): + Diese Prozedur ist das Herz des Decoders. Sie disassembliert eine + Instruktion, die im Codesegment 'segment', Adresse 'address' beginnt und + legt die mit 'nextword' gelesenen Wrter als Hexdarstellung in 'words' ab. + Die dekodierte Instruktion steht dann in 'instruction'. Vor dem Aufruf + dieser Prozedur sollte 'words' und 'instruction' niltext zugewiesen werden. + Die passende Prozedur 'nextword' wird auch vom 'eumel decoder' + herausgereicht. 'address' zeigt nach der Ausfhrung des Befehls auf die + nchste Instruktion. + + +PROC decodemodule : + Wie 'decode', nur wird bis nur zum Ende des gewnschten Moduls + disassembliert. + + +PROC decodemodule (INT CONST module number) : + Wie 'decode', nur wird bis nur zum Ende des gewnschten Moduls + disassembliert. + + +#ub#3.3.3 Weitere Prozeduren#ue# + +PROC nextmoduleheader (INT CONST segment, INT CONST address, + INT VAR header address, module number) : + Diese Prozedur findet ab der angegeben Adresse ('segment'/'address') den + Anfang des nchsten Moduls. In 'header address' wird die Startadresse des + gefundenen Moduls geliefert (bleibt im Segment 'segment'), in 'module + number' die Nummer des gefundenen Moduls. + + +INT PROC next word (INT CONST segment, INT VAR address, TEXT VAR words) : + Diese Prozedur liefert das durch 'segment'/'address' angegeben Wort, hngt + die Hexdarstellung dieses Wortes an 'words' an und erhht 'address' um + eins. + + +TEXT PROC data representation (INT CONST data addr, segment, address, type): + Diese Prozedur liefert die Darstellung des Parameters 'data addr' ggf. mit + Adresse (--> with object address). 'segment'/'address' bezeichnet die + Position, an der die Instruktion fr diesen Parameter steht. 'type' ist + ein (durch die Instruktion festgelegter) Typ des Parameters, mit dem die + Art der Darstellung gewhlt wird (TEXT, REAL, INT, ...). Im Gegensatz zu + 'object representation' braucht bei dieser Prozedur keine Darstellung + vorhanden sein. In diesem Falle wird nur z.B. der Stackoffset '' + ausgegeben. + + +TEXT PROC object representation (INT CONST data segment, data address, + segment, address, type) : + Diese Prozedur wird von 'data representation' aufgerufen und liefert die + Darstellung des Parameters. In 'data segment'/'data address' wird die + Anfangsadresse der darzustellenden Daten bergeben. Die anderen drei + Parameter verhalten sich wie bei 'data representation'. + + +TEXT PROC last actual parameter : + Liefert den Wert (nach TEXT konvertiert) des letzten dekodierten aktuellen + Parameters (am sinnvollsten whrend runtime). Diese prozedur wird vom + Tracer benutzt. + + +#ub#3.4 PACKET tracer#ue# + +#ub#3.4.1 Zugriff auf globale Parameter#ue# + + +PROC prot file (TEXT CONST filename) : +TEXT PROC prot file : + Einstell- und Informationsprozeduren fr den Namen der Protokollfile. + Wird ein 'filename' ungleich niltext eingestellt, dann werden die + dekodierten Instruktionen whrend der Ablaufverfolgung zustzlich in diese + File geschrieben. + + +PROC source file (TEXT CONST filename) : +TEXT PROC source file : + Einstell- und Informationsprozeduren fr den Namen der Quelltextdatei. + Wird ein 'filename' ungleich niltext eingestellt, dann wird nach dem + Ausfhren eines 'LN'-Befehls (LineNumber) die Zeile mit dieser Nummer aus + der Quelldatei gelesen und parallel zur dekodierten EUMEL0-Instruktion + angezeigt. + + +PROC tracer channel (INT CONST) : +INT PROC tracerchannel : + Einstell- und Informationsprozeduren fr den Kanal, an dem das Programm + ausgefhrt werden soll. Die Ablaufverfolgung bleibt an dem Kanal, an dem + die PROC/OP aufgerufen wurde. + + +#ub#3.4.2 Aufruf des Tracers#ue# + + Eine PROC/OP, in der ein Breakpoint gesetzt wurde, kann zum Beispiel im + Monitor aufgerufen werden. Ab der Adresse, an der der Breakpoint gesetzt + wurde, kann die Abarbeitung des Codes verfolgt werden. Das Setzen der + Breakpoints geschieht mit 'set breakpoint'. + + +PROC trace : + Diese Prozedur erfragt vom Benutzer die PROC/OP, bei der der die + Ablaufverfogung beginnen soll. Anschlieend mu der Aufruf der PROC/OP + eingegeben werden. Der Benutzer wird auerdem nach dem Namen der + compilierten Quelldatei, dem Namen der Protokollfile und dem + Abarbeitungskanal gefragt. Nachdem alle Angaben gemacht worden sind, wird + der PROC/OP-Aufruf mit 'do' ausgefhrt. + + +PROC set breakpoint : + Die Modultabelle wird ggf. erweitert, der Benutzer wird nach dem Namen + einer PROC/OP gefragt, deren Codeabarbeitung verfolgt werden soll. Der Code + dieser PROC/OP mu im Codesegment 3 stehen (sonst erfolgt ein 'errorstop'). + Der Protokoll- und Sourcefilename werden auf niltext gesetzt. + + +PROC set breakpoint (INT CONST breakpointnr, address) : + Setzt an der bergebenen Codeadresse im Segment 3 einen Breakpoint der + beiden Breakpoints (1 oder 2 als 'breakpointnr'). Der Benuzter ist selbst + dafr verantwortlich da + - dies nicht die Einsprungsadresse eines Moduls ist (HEAD-Instruktion), + - die bergebene Adresse das erste (Opcode-) Wort einer Instruktion ist, + - vor dem Aufruf des Moduls die Paketbasis korrekt gesetzt ist, falls + vor der ersten Instruktion mit Parametern kein 'PENTER' ausgefhrt wird. + + +PROC reset breakpoints : + Die Breakpoints werden zurckgesetzt und der (wegen des Breakpointhandler- + CALLs) gesicherte Code wieder an seinen Originalplatz zurckgeschrieben. + + +PROC reset breakpoint (INT CONST breakpointnr) : + Es wird nur gezielt der eine Breakpoint mit der Nummer 'breakpointnr' + zurckgesetzt. + + +PROC list breakpoints : + Der Status, die Adresse und der gesicherte Code (an dieser Adresse) werden + fr beide Breakpoints gelistet. diff --git a/devel/debugger/src/DEBUGGER.ELA b/devel/debugger/src/DEBUGGER.ELA new file mode 100644 index 0000000..fddde7d --- /dev/null +++ b/devel/debugger/src/DEBUGGER.ELA @@ -0,0 +1,3151 @@ +(*************************************************************************) +(** **) +(* EUMEL - Debugger: (C) Michael Staubermann, Oktober/November '86 *) +(* Ab EUMEL 1.7.5.4 *) +(* Stand: 01.12.86, 1.8.2: 26.07.88 *) +(* Noch keine BOUND-Variablen-Zugriffe implementiert *) +(** **) +(*************************************************************************) + + +PACKET address DEFINES ADD, (* 1.7.5 861006 *) + SUB, (* 1.8.0 861022 *) + MUL, (* M. Staubermann*) + INC, + DEC, + ulseq, + + split word , + make word , + + hex16, + hex8 , + integer , + + cdbint , + cdbtext , + + get word , + put word : + + +(*********************** Hex-Konvertierung ********************************) + +LET hex digits = "0123456789ABCDEF" ; + +PROC paket initialisierung : + (* Paketinitialisierung, wird nur einmal durchlaufen *) + INT CONST ulseq addr :: getword (0, 512 + + mod nr (BOOL PROC (INT CONST, INT CONST) ulseq)) ADD 2 ; + IF getword (3, ulseq addr) = integer ("B009") (* bei checkoff LSEQ *) + THEN putword (3, ulseq addr, integer ("D409")) (* ULSEQ *) + ELIF getword (3, ulseq addr ADD 1) = integer ("B009") (* bei checkon *) + THEN putword (3, ulseq addr ADD 1, integer ("D409")) + FI + +ENDPROC paket initialisierung ; + +INT PROC integer (TEXT CONST hex) : + INT VAR summe := 0, i ; + FOR i FROM 1 UPTO min (4, LENGTH hex) REP + rotate (summe, 4) ; + summe INCR digit + PER ; + summe . + +digit : + TEXT CONST char := hex SUB i ; + IF char >= "a" THEN code (char) - 87 + ELIF char >= "A" THEN code (char) - 55 + ELSE code (char) - 48 + FI + +ENDPROC integer ; + +TEXT PROC hex8 (INT CONST wert) : + (hex digits SUB ((wert DIV 16) +1)) + + (hex digits SUB ((wert AND 15) +1)) + +ENDPROC hex8 ; + +TEXT PROC hex16 (INT CONST wert) : + TEXT VAR result := "" ; + INT VAR i, w := wert ; + FOR i FROM 1 UPTO 4 REP + rotate (w, 4) ; + result CAT (hex digits SUB ((w AND 15)+1)) + PER ; + result + +ENDPROC hex16 ; + +(***************************** Adressarithmetik ***************************) + +PROC arith 15 : + + EXTERNAL 91 + +ENDPROC arith 15 ; + + +PROC arith 16 : + + EXTERNAL 92 + +ENDPROC arith 16 ; + + +OP INC (INT VAR a) : + arith 16 ; + a INCR 1 + +ENDOP INC ; + + +OP DEC (INT VAR a) : + arith 16 ; + a DECR 1 + +ENDOP DEC ; + + +INT OP ADD (INT CONST left, right) : + arith 16 ; + left + right + +ENDOP ADD ; + +INT OP SUB (INT CONST left, right) : + arith16 ; + left - right + +ENDOP SUB ; + +INT OP MUL (INT CONST left, right) : + arith 16 ; + left * right (* Multiplikation MOD 65536 im Gegensatz zu IMULT *) + +ENDOP MUL ; + +BOOL PROC ulseq (INT CONST left, right) : + left <= right (* Mu leider(!!) auf ULSEQ Code gepatcht werden *) +ENDPROC ulseq ; + +(*************************** Wortoperationen ******************************) + +PROC split word (INT VAR word and high byte, low byte) : + + EXTERNAL 15 + +ENDPROC split word ; + + +PROC make word (INT VAR highbyte and resultword, INT CONST low byte) : + + EXTERNAL 16 + +ENDPROC make word ; + + +(************************** DS4-Access ***********************************) + +INT PROC cdbint (INT CONST adr) : + + EXTERNAL 116 + +ENDPROC cdbint ; + + +TEXT PROC cdbtext (INT CONST adr) : + + EXTERNAL 117 + +ENDPROC cdbtext ; + + +PROC putword (INT CONST segment, adr, value) : + + EXTERNAL 119 + +ENDPROC put word ; + + +INT PROC getword (INT CONST segment, adr) : + + EXTERNAL 120 + +ENDPROC getword ; + + +INT PROC mod nr (BOOL PROC (INT CONST, INT CONST) proc) : + + EXTERNAL 35 + +ENDPROC mod nr ; + + +paket initialisierung + +ENDPACKET address ; + +(**************************************************************************) + +PACKET table routines DEFINES (* Fr eumel decoder 861017 *) + (* 1.8.0 by M.Staubermann *) + code segment , + code address , + packet name , + module name and specifications , + get module number , + storage , + hash , + init module table, + add modules , + dump tables : + + +LET end of hash table = 1023 , + begin of permanent table = 22784 , + begin of pt minus ptt limit = 12784 , + end of permanent table = 32767 , + + permanent param const = 10000 , + permanent param var = 20000 , + permanent proc op = 30000 , + permanent type = 30000 , + permanent row = 10 , + permanent struct = 11 , + permanent param proc = 12 , + permanent struct end = 0 , + + ptt limit = 10000 , + + void = 0 , + + const = 1 , + var = 2 , + + sysgenoff module number = 1280 , + start of module number link table = 512 , + highest module number 1 = 2048 , + max packets = 128 , + max types = 64 ; + + +LET MODULETABLE = ROW highest module number 1 + STRUCT (TEXT name, specifications, INT packet link) , + PACKETTABLE = ROW max packets STRUCT (TEXT name, INT permanent address), + TYPETABLE = STRUCT (THESAURUS names, ROW max types INT storage), + TABLETYPE = BOUND STRUCT (MODULETABLE module, PACKETTABLE packet, + TYPETABLE types, INT number of packets, + end of permanent table) ; + +TABLETYPE VAR table ; + +TEXT VAR type and mode, result ; +BOOL VAR end of params ; +INT VAR mode, paramlink, index ; + +(************************* Module- und Packettablezugriff **************) + +PROC init module table (TEXT CONST table name) : + forget (table name, quiet) ; + table := new (table name) ; + table.number of packets := 0 ; + table.end of permanent table := begin of permanent table ; + + table.types.names := empty thesaurus ; + insert (table.types.names, "INT", index) ; + table.types.storage (index) := 1 ; + insert (table.types.names, "REAL", index) ; + table.types.storage (index) := 4 ; + insert (table.types.names, "BOOL", index) ; + table.types.storage (index) := 1 ; + insert (table.types.names, "TEXT", index) ; + table.types.storage (index) := 8 ; + insert (table.types.names, "DATASPACE", index) ; + table.types.storage (index) := 1 ; + + scan permanent table (table.end of permanent table) ; + scan hash table (begin of permanent table) ; + +ENDPROC init module table ; + + +PROC add modules : + INT CONST old end of permanent table := table.end of permanent table ; + IF cdbint (table.end of permanent table) <> -3 + THEN scan permanent table (table.end of permanent table) ; + scan hash table (old end of permanent table) + FI + +ENDPROC add modules ; + + +PROC scan hash table (INT CONST minimum permanent address) : + INT VAR hash table pointer ; + FOR hash table pointer FROM 0 UPTO end of hash table REP + IF cdbint (hash table pointer) <> 0 + THEN cout (hash table pointer) ; + list all name table objects with this hash code (hash table pointer, + minimum permanent address) + FI + PER + +ENDPROC scan hash table ; + + +PROC list all name table objects with this hash code (INT CONST link, + minimum permanent address) : + TEXT VAR object name ; + INT VAR name table pointer := first link word, module nr, + permanent pointer ; + WHILE NOT end of name table chain REPEAT + permanent pointer := cdb int (nametable pointer + 1) ; + WHILE permanent pointer >= minimum permanent address REP + object name := cdbtext (name table pointer + 2) ; + IF permanent type definition + THEN insert (table.types.names, object name, index) ; + table.types.storage (index) := cdb int (permanent pointer + 2) + ELSE get specifications (permanent pointer) ; + module nr := cdb int (param link + 1) + 1; + table.module (module nr).name := object name ; + table.module (module nr).specifications := result; + table.module (module nr).packet link := packetlink(permanentpointer) + FI ; + permanent pointer := cdb int (permanent pointer) + PER ; + name table pointer := cdb int (name table pointer) + END REPEAT . + +first link word : + cdb int (link) . + +end of name table chain : + name table pointer = 0 . + +permanent type definition : + (object name SUB 1) <= "Z" AND (object name SUB 1) >= "A" AND + cdbint (permanent pointer + 1) = permanent type + +END PROC list all name table objects with this hash code ; + + +INT PROC packet link (INT CONST permanent address) : + INT VAR packet pointer ; + FOR packet pointer FROM 1 UPTO table.number of packets REP + IF table.packet (packet pointer).permanent address > permanent address + THEN LEAVE packet link WITH packet pointer -1 + FI + PER ; + table.number of packets + +ENDPROC packet link ; + + +PROC scan permanent table (INT VAR permanent pointer) : + FOR permanent pointer FROM permanent pointer UPTO end of permanent table + WHILE cdbint (permanent pointer) <> -3 REP + IF cdbint (permanent pointer) = -2 + THEN cout (permanent pointer) ; + table.number of packets INCR 1 ; + table.packet (table.number of packets).name := + cdbtext (cdbint (permanent pointer +1) +2) ; + table.packet (table.number of packets).permanent address := + permanent pointer + FI + PER + +ENDPROC scan permanent table ; + + +PROC dump tables (TEXT CONST file name) : + INT VAR i ; + forget (filename, quiet) ; + FILE VAR f := sequentialfile (output, filename) ; + maxline length (f, 1000) ; + + putline (f, "PACKETTABLE:") ; + put (f, "End of Permanenttable:") ; + put (f, hex16 (table.end of permanent table)) ; + line (f) ; + putline (f, "Nr. Packetname") ; + FOR i FROM 1 UPTO table.number of packets REP + cout (i) ; + put (f, text (i, 3)) ; + put (f, hex16 (table.packet (i).permanent address)) ; + putline (f, table.packet (i).name) + PER ; + line (f, 2) ; + putline (f, "TYPETABLE:") ; + putline (f, " Size Name") ; + index := 0 ; + get (table.types.names, type and mode, index) ; + WHILE index > 0 REP + put (f, text (table.types.storage (index), 5)) ; + putline (f, type and mode) ; + get (table.types.names, type and mode, index) + PER ; + line (f, 2) ; + putline (f, "MODULETABLE:") ; + putline (f, "Modnr.PNr.Name and Parameters") ; + FOR i FROM 1 UPTO highest module number 1 REP + IF table.module (i).packet link <> -1 + THEN cout (i) ; + put (f, text (i-1, 5)) ; + put (f, text (table.module (i).packet link, 3)) ; + put (f, table.module (i).name) ; + putline (f, table.module (i).specifications) ; + FI + PER + +ENDPROC dump tables ; + + +INT PROC storage (TEXT CONST typename) : + index := link (table.types.names, typename) ; + IF index = 0 + THEN 0 + ELSE table.types.storage (index) + FI + +ENDPROC storage ; + + +TEXT PROC module name and specifications (INT CONST module number) : + IF LENGTH table.module (module number + 1).name > 0 + THEN table.module (module number + 1).name + " " + + table.module (module number + 1).specifications + ELSE "" + FI + +ENDPROC module name and specifications ; + + +TEXT PROC packet name (INT CONST module number) : + IF table.module (module number + 1).packet link > 0 + THEN table.packet (table.module (module number + 1).packet link).name + ELSE FOR index FROM module number DOWNTO 1 REP + IF table.module (index).packet link > 0 + THEN LEAVE packet name WITH table.packet (table.module + (index).packet link).name + FI + PER ; + "" + FI + +ENDPROC packet name ; + + +(************************ Modulnummern ***********************************) + +INT PROC code segment (INT CONST module number) : + IF module number < sysgen off module number + THEN 2 + ELSE 3 + FI + +ENDPROC code segment ; + + +INT PROC code address (INT CONST module number) : + get word (0, start of module number link table + module number) +ENDPROC code address ; + + +PROC get module number (INT VAR module number) : + TEXT VAR object ; + INT VAR anz objects, name table pointer, permanent pointer ; + put ("Name oder Modulnummer der PROC/OP:") ; + getline (object) ; + changeall (object, " ", "") ; + IF object = "" + THEN LEAVE get module number + FI ; + disablestop ; + module number := int (object) ; + IF NOT iserror AND last conversion ok AND module number >= -1 AND + module number < 2048 + THEN LEAVE get module number + FI ; + clear error ; + enablestop ; + anz objects := 0 ; + FILE VAR f := notefile ; + maxlinelength (f, 1000) ; + note ("Modulnummer des gewnschten Objekts merken und ESC q tippen.") ; + noteline ; + noteline ; + module number := -1 ; + scan permanent table chain with object name ; + IF anz objects > 1 + THEN note edit ; + put ("Modulnummer der PROC/OP:") ; + get (module number) + ELSE type (""27"q") ; + note edit + FI . + +scan permanent table chain with object name : + name table pointer := first link word ; + WHILE NOT end of name table chain REP + IF cdb text (name table pointer + 2) = object + THEN permanent pointer := cdb int (nametable pointer + 1) ; + IF NOT permanent type definition + THEN run through permanent chain + FI ; + FI ; + name table pointer := cdb int (name table pointer) + PER . + +run through permanent chain : + WHILE permanent pointer <> 0 REP + anz objects INCR 1 ; + cout (anz objects) ; + get specifications (permanent pointer) ; + IF anz objects = 1 + THEN module number := module nr + FI ; + note (text (module nr, 4)) ; + note (" ") ; + note (object) ; + note (" ") ; + note (result) ; + noteline ; + permanent pointer := cdbint (permanent pointer) + PER . + +module nr : + cdb int (param link + 1) . + +first link word : + cdb int (hash (object)) . + +end of name table chain : + name table pointer = 0 . + +permanent type definition : + (object SUB 1) <= "Z" AND (object SUB 1) >= "A" AND + cdbint (permanent pointer + 1) = permanent type + +ENDPROC get module number ; + + +(************************* Permanenttabellenzugriffe **********************) + +INT PROC hash (TEXT CONST obj name) : + INT VAR i, hash code ; + hash code := 0 ; + FOR i FROM 1 UPTO LENGTH obj name REP + addmult cyclic + PER ; + hash code . + +addmult cyclic : + hash code INCR hash code ; + IF hash code > end of hash table THEN wrap around FI ; + hash code := (hash code + code (obj name SUB i)) AND end of hash table . + +wrap around : + hash code DECR end of hash table + +ENDPROC hash ; + + +PROC next pt param : + mode := cdb int (param link) MOD ptt limit ; + param link INCR 1 ; + IF mode = permanent row + THEN skip over permanent row + ELIF mode = permanent struct + THEN skip over permanent struct + FI ; + set end marker if end of list . + +skip over permanent row : + param link INCR 1 ; (* Skip row size *) + next pt param . + +skip over permanent struct : + mode := cdbint (param link) ; + WHILE mode <> permanent struct end REP + next pt param ; + mode := cdbint (param link) + PER ; + param link INCR 1 (* skip permanent struct end *) + +ENDPROC next pt param ; + + +PROC set end marker if end of list : + mode := cdb int (param link) ; + end of params := mode >= permanent proc op OR mode <= 0 + +ENDPROC set end marker if end of list ; + + +PROC get type and mode (INT VAR type) : + mode := cdb int (param link) ; + IF mode = permanent param proc + THEN type of param proc + ELSE type of object + FI . + +type of param proc : + param link INCR 1 ; + get type and mode (type) ; + mode := permanent param proc . + +type of object : + IF mode < 0 + THEN type := 2769 + (32767 + mode) ; + mode := 0 + ELSE type := mode MOD ptt limit ; + mode DECR type ; + translate type if necessary ; + translate mode if necessary + FI . + +translate type if necessary : + IF permanent row or struct THEN translate type FI . + +translate type : + type := param link - begin of pt minus ptt limit . + +translate mode if necessary : + IF mode = permanent param const + THEN mode := const + ELIF mode = permanent param var + THEN mode := var + FI . + +permanent row or struct : + type = permanent row OR type = permanent struct + +ENDPROC get type and mode ; + + +PROC get specifications (INT CONST permanent pointer) : + result := "" ; + to first param ; + IF NOT end of params THEN put param list FI ; + get result . + +to first param : + param link := permanent pointer + 1 ; + set end marker if end of list . + +get result : + INT VAR type; + get type and mode (type) ; + IF type <> void + THEN type and mode := " --> " ; + name of type (type) ; + result CAT type and mode + FI + +ENDPROC get specifications ; + + +PROC put param list : + result CAT "(" ; + REP + INT VAR type; + get type and mode (type) ; + put type and mode ; + maybe param proc ; + next pt param ; + IF end of params + THEN result CAT ")" ; + LEAVE put param list + FI ; + result CAT ", " ; + PER . + +put type and mode : + INT CONST mode1 :: mode ; + type and mode := "" ; + name of type (type) ; + type and mode CAT name of mode ; + result CAT type and mode . + +name of mode : + IF mode1 = const THEN " CONST" + ELIF mode1 = var THEN " VAR" + ELIF type = void THEN "PROC" + ELSE " PROC" + FI . + +maybe param proc : + IF mode = permanent param proc THEN put virtual params FI . + +put virtual params : + skip over result type if complex type ; + IF NOT end of virtual params + THEN result CAT " " ; + put param list + FI . + +skip over result type if complex type : + next pt param . + +end of virtual params : + end of params + +ENDPROC put param list ; + + +PROC name of type (INT CONST type) : + LET int = 1 , + real = 2 , + string = 3 , + bool = 5 , + bool result = 6 , + dataspace = 7 ; + + SELECT type OF + CASE void : + CASE int : type and mode CAT "INT" + CASE real : type and mode CAT "REAL" + CASE string : type and mode CAT "TEXT" + CASE bool, + bool result : type and mode CAT "BOOL" + CASE dataspace : type and mode CAT "DATASPACE" + OTHERWISE complex type + ENDSELECT . + +complex type : + IF type > ptt limit THEN perhaps permanent struct or row + ELSE get complex type + FI . + +perhaps permanent struct or row : + index := type + begin of pt minus ptt limit ; + mode := cdb int (index) MOD ptt limit ; + IF mode = permanent row THEN get permanent row + ELIF mode = permanent struct THEN get permanent struct + ELSE type and mode CAT "-" + FI . + +get complex type : + index := type + begin of permanent table ; + IF is complex type + THEN get name + ELSE type and mode CAT "" + FI . + +is complex type : + permanent type definition mode = permanent type . + +get name : + type and mode CAT cdb text (link to type name + 2) . + +link to type name : + cdb int (index + 3) . + +permanent type definition mode : + cdb int (index + 1) . + +get permanent row : + INT VAR t; + type and mode CAT "ROW " ; + type and mode CAT text (cdb int (index + 1)) ; + type and mode CAT " " ; + param link := index + 2 ; + get type and mode (t) ; + name of type (t) . + +get permanent struct : + type and mode CAT "STRUCT (" ; + param link := index + 1 ; + WHILE within permanent struct REP + get type and mode (t) ; + name of type (t) ; + next pt param ; + IF within permanent struct + THEN type and mode CAT ", " + FI + PER ; + type and mode CAT ")" . + +within permanent struct : + cdbint (param link) <> permanent struct end . + +ENDPROC name of type ; + + +ENDPACKET table routines ; + + +(*************************************************************************) + +PACKET eumel decoder DEFINES (* M. Staubermann, Mrz/April 86 *) + (* 1.8.0 861201 *) + (* 1.8.2 880726 *) + lbase , + pbase , + set parameters , + get parameters , + default no runtime , + bool result , + line number , + list file name , + last actual parameter , + with code words , + with object address , + + next word , + next module header , + data representation , + object representation , + + decode module , + decode : + + +LET packet data segment = 0 , + local data segment = 1 , + standard dataspace = 0 , (* ds = 4 *) + + first elan address = 13 584 , (* codeaddress (273) *) + begin of stringtable = 1 024 , + begin of nametable = 4 096 , + end of nametable = 22 783 ; + +LET try type = 0 , {?} + int addr = 10 , {I} + real addr = 19 , {R} + text addr = 20 , {S} + dataspace addr = 5 , {D} + task addr = 21 , {T} + ref addr = 1 , {@} + mod addr = 2 , {A} + bool addr = 3 , {B} + int value = 23 , {V} + hexbyte value = 9 , {H} + module nr value = 14 ; {M} + +LET OPN = STRUCT (TEXT mnemonic, params, BOOL bool result) , + PRIMOP = ROW 31 OPN , + SPECIALOP = ROW 6 OPN , + ESCOP = ROW 130 OPN , + + rtnt opcode = 32513 , + rtnf opcode = 32514 ; + +LET hex 3fff = 16 383 , + hex 03ff = 1 023 , + hex 0400 = 1 024 , + hex 7c = 124 , + hex 7f = 127 , + hex f0 = 240 , + hex fd = 253 , + hex ff = 255 ; + +INT CONST hex 83ff :: -31745 , + hex ff00 :: -256 , + hex fff8 :: -8 , + minus one :: -1 ; + +FILE VAR list file ; +TEXT VAR file name := "" , + text val := "" ; +INT VAR file number := 0 , + data base , + ln := minus one , + lbas := minus one , + cmod := minus one ; + +BOOL VAR was bool result , + echo , + with statement line := TRUE , + with object and address := TRUE ; + + +INT PROC line number : + ln +ENDPROC line number ; + + +TEXT PROC last actual parameter : + text val +ENDPROC last actual parameter ; + + +PROC pbase (INT CONST i) : + data base := i ; + makeword (data base, 0) +ENDPROC pbase ; + + +INT PROC pbase : + INT VAR lowbyte, highbyte := data base ; + split word (highbyte, lowbyte) ; + highbyte +ENDPROC pbase ; + + +PROC lbase (INT CONST i) : + lbas := i +ENDPROC lbase ; + + +BOOL PROC bool result : + was bool result +ENDPROC bool result ; + + +BOOL PROC with object address : + with object and address +ENDPROC with object address ; + + +PROC with object address (BOOL CONST b) : + with object and address := b +ENDPROC with object address ; + + +PROC with codewords (BOOL CONST b) : + with statement line := b +ENDPROC with codewords ; + + +BOOL PROC with codewords : + with statement line +ENDPROC with codewords ; + + +PROC bool result (BOOL CONST b) : + was bool result := b +ENDPROC bool result ; + + +PROC list file name (TEXT CONST name) : + file name := name +ENDPROC list file name ; + + +PROC set parameters (INT CONST lbase, pbas, line number, codmod) : + lbas := lbase ; + pbase (pbas) ; + ln := line number ; + cmod := codmod +ENDPROC set parameters ; + + +PROC get parameters (INT VAR lbase, pbas, line number, codmod) : + lbase := lbas ; + pbas := pbase ; + line number := ln ; + codmod := cmod +ENDPROC get parameters ; + + +PROC default no runtime : + lbas := minus one ; + ln := minus one ; + database := minus one ; + cmod := minus one +ENDPROC default no runtime ; + + +PRIMOP CONST primop := PRIMOP :( + OPN :("LN ", "V", FALSE), (* 1 *) + OPN :("LN1 ", "V", FALSE), + OPN :("MOV ", "II", FALSE), + OPN :("INC1 ", "I", FALSE), + OPN :("DEC1 ", "I", FALSE), + OPN :("INC ", "II", FALSE), + OPN :("DEC ", "II", FALSE), + OPN :("ADD ", "III", FALSE), + OPN :("SUB ", "III", FALSE), + OPN :("CLEAR", "I", FALSE), (* 10 *) + OPN :("TEST ", "I", TRUE), + OPN :("EQU ", "II", TRUE), + OPN :("LSEQ ", "II", TRUE), + OPN :("FMOV ", "RR", FALSE), + OPN :("FADD ", "RRR", FALSE), + OPN :("FSUB ", "RRR", FALSE), + OPN :("FMUL ", "RRR", FALSE), + OPN :("FDIV ", "RRR", FALSE), + OPN :("FLSEQ", "RR", TRUE), + OPN :("TMOV ", "SS", FALSE), + OPN :("TEQU ", "SS", TRUE), + OPN :("ULSEQ", "II", TRUE), + OPN :("DSACC", "D?", FALSE), + OPN :("REF ", "?@", FALSE), + OPN :("SUBS ", "VVI?@", FALSE), (* 25 *) + OPN :("SEL ", "?V@", FALSE), (* 26 *) + OPN :("PPV ", "?", FALSE), + OPN :("PP ", "?", FALSE), + OPN :("B ", "V", FALSE), + OPN :("B1 ", "V", FALSE), + OPN :("CALL ", "M", FALSE)) ; + +SPECIALOP CONST special op := SPECIALOP :( + OPN :("EQUIM ", "HI", TRUE), + OPN :("MOVi ", "HI", FALSE), + OPN :("MOVx ", "HII", FALSE), + OPN :("PUTW ", "HII", FALSE), + OPN :("GETW ", "HII", FALSE), + OPN :("PENTER ", "H", FALSE)) ; (* 7F = ESC, FF = LONGA *) + +ESCOP CONST esc op := ESCOP :( + OPN :("RTN ", "", FALSE), (* 0 *) + OPN :("RTNT ", "", FALSE), + OPN :("RTNF ", "", FALSE), + OPN :("???????", "", FALSE), (* was repair text 1.7.1 *) + OPN :("STOP ", "", FALSE), (* TERM *) + OPN :("GOSUB ", "V", FALSE), (* 1 ist Branch Address *) + OPN :("KE ", "", FALSE), + OPN :("GORET ", "", FALSE), + OPN :("BCRD ", "II", FALSE), (* begin char read (pointer, length) *) + OPN :("CRD ", "II", FALSE), (* char read (char, pointer) *) + OPN :("ECWR ", "III", FALSE), (* end char write (pointer, length, next entry) *) + OPN :("CWR ", "III", FALSE), (* char write (hash code, pointer, char) *) + OPN :("CTT ", "?S", FALSE), (* REF d2:=REF compiler table text ) *) + OPN :("GETC ", "SII", TRUE), (* INT := code (TEXT SUB INT), TRUE wenn INT <= length (TEXT) *) + OPN :("FNONBL ", "ISI", TRUE), (* find non blank (char, line, pointer) *) + OPN :("DREM256", "II", FALSE), (* := MOD 256, := DIV 256 *) + OPN :("AMUL256", "II", FALSE), (* := * 256 + *) + OPN :("???????", "", FALSE), + OPN :("ISDIG ", "I", TRUE), + OPN :("ISLD ", "I", TRUE), + OPN :("ISLCAS ", "I", TRUE), + OPN :("ISUCAS ", "I", TRUE), + OPN :("GADDR ", "III", FALSE), (* IF >= 0 (Global) THEN := - (=pbase) ELIF bit (, 14) (Local Ref) THEN := ( AND $3FFF)*2 + 1 ELSE (Local) := ( AND $3FFF)*2 FI *) + OPN :("GCADDR ", "III", TRUE), + OPN :("ISSHA ", "I", TRUE), + OPN :("SYSG ", "", FALSE), (* 25 *) + OPN :("GETTAB ", "", FALSE), + OPN :("PUTTAB ", "", FALSE), + OPN :("ERTAB ", "", FALSE), + OPN :("EXEC ", "M", FALSE), + OPN :("PPROC ", "M", FALSE), + OPN :("PCALL ", "A", FALSE), (* : icount Segment/Address *) + OPN :("BRCOMP ", "IV", FALSE), + OPN :("MOVxx ", "V??", FALSE), + OPN :("ALIAS ", "VDD", FALSE), + OPN :("MOVii ", "VI", FALSE), + OPN :("FEQU ", "RR", TRUE), + OPN :("TLSEQ ", "SS", TRUE), + OPN :("FNEG ", "RR", FALSE), + OPN :("NEG ", "II", FALSE), + OPN :("IMULT ", "III", FALSE), + OPN :("MUL ", "III", FALSE), + OPN :("DIV ", "III", FALSE), + OPN :("MOD ", "III", FALSE), + OPN :("ITSUB ", "SII", FALSE), + OPN :("ITRPL ", "SII", FALSE), + OPN :("DECOD ", "SI", FALSE), + OPN :("ENCOD ", "IS", FALSE), + OPN :("SUBT1 ", "SIS", FALSE), + OPN :("SUBTFT ", "SIIS", FALSE), + OPN :("SUBTF ", "SIS", FALSE), + OPN :("REPLAC ", "SIS", FALSE), + OPN :("CAT ", "SS", FALSE), + OPN :("TLEN ", "SI", FALSE), + OPN :("POS ", "SSI", FALSE), + OPN :("POSF ", "SSII", FALSE), + OPN :("POSFT ", "SSIII", FALSE), + OPN :("STRANL ", "IIISIII", FALSE), + OPN :("POSIF ", "SSSII", FALSE), + OPN :("???????", "", FALSE), + OPN :("OUT ", "S", FALSE), (* 60 *) + OPN :("COUT ", "I", FALSE), + OPN :("OUTF ", "SI", FALSE), + OPN :("OUTFT ", "SII", FALSE), + OPN :("INCHAR ", "S", FALSE), + OPN :("INCETY ", "S", FALSE), + OPN :("PAUSE ", "I", FALSE), + OPN :("GCPOS ", "II", FALSE), + OPN :("CATINP ", "SS", FALSE), + OPN :("NILDS ", "D", FALSE), + OPN :("DSCOPY ", "DD", FALSE), + OPN :("DSFORG ", "D", FALSE), + OPN :("DSWTYP ", "DI", FALSE), + OPN :("DSRTYP ", "DI", FALSE), + OPN :("DSHEAP ", "DI", FALSE), + OPN :("ESTOP ", "", FALSE), + OPN :("DSTOP ", "", FALSE), + OPN :("SETERR ", "I", FALSE), + OPN :("ISERR ", "", TRUE), + OPN :("CLRERR ", "", FALSE), + OPN :("RPCB ", "II", FALSE), + OPN :("INFOPW ", "SSI", FALSE), (* War vorher Writepcb *) + OPN :("TWCPU ", "TR", FALSE), + OPN :("ROTATE ", "II", FALSE), + OPN :("CONTRL ", "IIII", FALSE), + OPN :("BLKOUT ", "DIIII", FALSE), + OPN :("BLKIN ", "DIIII", FALSE), + OPN :("NXTDSP ", "DII", FALSE), + OPN :("DSPAGS ", "ITI", FALSE), + OPN :("STORAGE", "II", FALSE), + OPN :("SYSOP ", "I", FALSE), (* 90 *) + OPN :("ARITHS ", "", FALSE), + OPN :("ARITHU ", "", FALSE), + OPN :("HPSIZE ", "I", FALSE), + OPN :("GARB ", "", FALSE), + OPN :("TPBEGIN", "TTIA", FALSE), (* 1.8.0: privileged begin *) + OPN :("FSLD ", "IRI", FALSE), + OPN :("GEXP ", "RI", FALSE), + OPN :("SEXP ", "IR", FALSE), + OPN :("FLOOR ", "RR", FALSE), + OPN :("RTSUB ", "SIR", FALSE), + OPN :("RTRPL ", "SIR", FALSE), + OPN :("CLOCK ", "IR", FALSE), + OPN :("SETNOW ", "R", FALSE), + OPN :("TRPCB ", "TII", FALSE), + OPN :("TWPCB ", "TII", FALSE), (* 105 *) + OPN :("TCPU ", "TR", FALSE), + OPN :("TSTAT ", "TI", FALSE), + OPN :("ACT ", "T", FALSE), + OPN :("DEACT ", "T", FALSE), + OPN :("THALT ", "T", FALSE), + OPN :("TBEGIN ", "TA", FALSE), (* seg/addr icount *) + OPN :("TEND ", "T", FALSE), + OPN :("SEND ", "TIDI", FALSE), + OPN :("WAIT ", "TID", FALSE), + OPN :("SWCALL ", "TIDI", FALSE), + OPN :("CDBINT ", "II", FALSE), (* 116 *) + OPN :("CDBTXT ", "IS", FALSE), (* 117 *) + OPN :("PNACT ", "I", FALSE), + OPN :("PW ", "III", FALSE), + OPN :("GW ", "III", FALSE), + OPN :("XOR ", "III", FALSE), + OPN :("PPCALL ", "TIDI", FALSE), (* pingpong call *) + OPN :("EXTASK ", "T", TRUE), + OPN :("AND ", "III", FALSE), + OPN :("OR ", "III", FALSE), + OPN :("SESSION", "I", FALSE), + OPN :("SENDFT ", "TTIDI", FALSE), + OPN :("DEFCOL ", "T", FALSE), + OPN :("ID ", "II", FALSE)) ; (* 129 *) + + +PROC decode : + INT VAR mod nr ; + get module number (mod nr) ; + IF mod nr >= minus one + THEN decode (mod nr) + FI +ENDPROC decode ; + + +PROC decode module : + INT VAR mod nr ; + get module number (mod nr) ; + IF mod nr >= minus one + THEN decode module (mod nr) + FI +ENDPROC decode module ; + + +PROC decode module (INT CONST mod nr) : + INT VAR address :: code address (mod nr) ; + default no runtime ; + decode (code segment (mod nr), address, minus one, TRUE) +ENDPROC decode module ; + + +PROC decode (INT CONST mod nr) : + INT VAR address :: code address (mod nr) ; + default no runtime ; + decode (code segment (mod nr), address, minus one, FALSE) +ENDPROC decode ; + + +PROC decode (INT CONST seg, from) : + INT VAR address := from ; + default no runtime ; + decode (seg, address, minus one, FALSE) +ENDPROC decode ; + + +PROC decode (INT CONST seg, INT VAR addr, INT CONST to addr, + BOOL CONST only one module) : + + TEXT VAR taste, opcode, codewords, hex addr ; + BOOL VAR addr out := TRUE , + output permitted := TRUE ; + INT VAR size, used, mod nr, header address, start address := addr ; + + add modules ; + storage (size, used) ; + echo := TRUE ; + file number := 0 ; + cmod := minus one ; + init list file ; + next module header (seg, addr, header address, mod nr) ; + was bool result := FALSE ; + + WHILE ulseq (addr, to addr) REP + protocoll ; + taste := incharety ; + decode one statement ; + analyze key ; + IF (addr AND 31) = 0 + THEN storage (size, used) ; + FI ; + UNTIL taste = ""27"" OR used > size PER ; + + IF used > size + THEN list line ("Abbruch wegen Speicherengpass!") + FI . + +protocoll : + IF output permitted AND NOT echo (* Falls Decoder im Hintergrund laufen soll *) + THEN IF addr out + THEN out (" ") ; + out (hex16 (addr)) ; + out (" "8""8""8""8""8""8"") ; + ELSE cout (ln) + FI + FI . + +analyze key : + SELECT code (taste) OF +{l} CASE 108 : addr out := FALSE (* Zeilennummern ausgeben *) +{d} CASE 100 : get command ("Gib Kommando:") ; do command +{f} CASE 102 : show filename and fileline +{a} CASE 97 : addr out := TRUE (* Hexaddressen ausgeben *) +{e} CASE 101 : echo := NOT echo (* Bildschirmausgabe zus. *) +{s} CASE 115 : storage (size,used) ; out(""13""5"System-Storage: " + text (used) + " ") +{m} CASE 109 : out (""13""5"Modulnr: " + text (mod nr-1) + " ") +{Q,W}CASE 87,81:output permitted := TRUE (* Luft nur im Vordergrund *) +{S} CASE 83 : output permitted := FALSE (* Luft auch im Hintergrund *) +{ESC}CASE 27 : IF incharety <> "" + THEN taste := "" + ELSE list line ("Abbruch mit ESC") + FI + (* Wegen Steuertasten, wie ESC P *) + ENDSELECT . + +show filename and fileline : + out (""13""5"Filename: " + filename + "." + text (filenumber) + + " Fileline: " + text (lines (list file)) + " ") . + +decode one statement : + check if module head ; + hex addr := hex16 (addr) ; + codewords := "" ; + opcode := "" ; + decode (seg, addr, codewords, opcode, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; + hex addr CAT " " ; + hex addr CAT opcode ; + IF with statement line + THEN hex addr CAT " " ; + WHILE LENGTH hex addr < 80 REP + hex addr CAT " " + PER ; + hex addr CAT codewords ; + FI ; + list line (hex addr) . + +check if module head : + IF addr = header address + THEN IF only one module AND addr <> start address + THEN LEAVE decode + FI ; + list line (" ") ; + list line ("Module " + process module nr (mod nr)) ; + list line (" ") ; + IF output permitted AND NOT echo + THEN put ("Module:") ; + cout (mod nr) ; + 8 TIMESOUT ""8"" + FI ; + calculate c8k ; + codewords := "" ; + hex addr := hex16 (addr) ; + hex addr CAT " HEAD " ; + hex addr CAT text (next word (seg, addr, codewords)) ; + IF with statement line + THEN hex addr CAT " " ; + WHILE LENGTH hex addr < 80 REP + hex addr CAT " " + PER ; + hex addr CAT code words ; + FI ; + list line (hex addr) ; + next module header (seg, addr, header address, mod nr) ; + FI . + +calculate c8k : + INT VAR dummy ; + cmod := addr ; + splitword (cmod, dummy) ; + cmod INCR 16 ; + cmod := cmod AND 255 . + +ENDPROC decode ; + + +PROC init list file : + forget (filename + "." + text (filenumber), quiet) ; + list file := sequentialfile (output, filename + "." + text (filenumber)) ; + maxlinelength (list file, 2000) ; + list line ("Addr Opcode Parameter") ; +ENDPROC init list file ; + + +PROC list line (TEXT CONST zeile) : + IF lines (list file) > 4000 + THEN file number INCR 1 ; + init list file + FI ; + putline (list file, zeile) ; + IF echo THEN outsubtext (zeile, 1, 79) ; line FI +ENDPROC list line ; + + +PROC decode (INT CONST segment, INT VAR address, TEXT VAR words, instruction, + INT PROC (INT CONST, INT VAR, TEXT VAR) next word) : + + INT VAR opcode, word, lowbyte, highbyte, + opcode address := address ; + BOOL VAR shorta opcode ; + + ln := minus one ; (* Wenn kein LN Befehl vorkam -1 *) + + word := next word (segment, address, words) ; + highbyte := word ; + split word (highbyte, lowbyte) ; + opcode := highbyte AND hex 7c ; + shorta opcode := TRUE ; + + IF opcode = hex 7c AND highbyte <> hex ff + THEN esc or special instruction (* Kann kein LONGA sein *) + ELSE IF highbyte = hex ff + THEN longa instruction + ELSE word := word AND hex 83ff + FI ; + primaer instruction + FI . + +esc or special instruction : + IF highbyte = hex 7f + THEN esc instruction + ELSE special instruction + FI . + +longa instruction : + IF lowbyte = hex ff + THEN instruction CAT "-" ; + LEAVE decode + ELIF lowbyte = hex fd + THEN instruction CAT "Block unlesbar" ; + LEAVE decode + ELSE instruction CAT "LONGA " ; + shorta opcode := FALSE ; + opcode := lowbyte ; + word := next word (segment, address, words) ; + highbyte := word ; + splitword (highbyte, lowbyte) + FI . + +special instruction : + opcode := (highbyte AND 3) * 2 + 1 ; + IF highbyte > hex 7f + THEN opcode INCR 1 + FI ; + word := word AND hex ff ; + instruction CAT special op (opcode).mnemonic ; + instruction CAT " " ; (* ESC Ausgleich *) + instruction CAT params0 (special op (opcode).params, word, segment, address, + words, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; + was bool result := special op (opcode).bool result ; + IF opcode = 6 (* PENTER *) + THEN database := lowbyte ; + makeword (database, 0) ; + FI . + +esc instruction : + opcode := lowbyte + 1 ; + IF opcode < 1 OR opcode > 131 + THEN instruction CAT "???????" + ELSE instruction CAT "ESC " ; + instruction CAT esc op (opcode).mnemonic ; + instruction CAT " " ; + instruction CAT params (esc op (opcode).params, segment, address, + words, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; + was bool result := esc op (opcode).bool result + FI . + +primaer instruction : + rotate (opcode, -2) ; + SELECT opcode OF + CASE 0, 1 : process ln + CASE 28, 29 : process br + CASE 30 : process call + OTHERWISE + opcode INCR 1 ; + instruction CAT prim op (opcode).mnemonic ; + IF shorta opcode + THEN instruction CAT " " + ELSE instruction CAT " " + FI ; + instruction CAT params0 (prim op (opcode).params, word, segment, address, words, + INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; + IF opcode = 25 (* SUBS *) + THEN instruction CAT "(ESiz,Lim-1,Idx,Base,Ref) " + ELIF opcode = 26 (* SEL *) + THEN instruction CAT "(Base,Offs,Ref) " + FI ; + was bool result := prim op (opcode).bool result ; + ENDSELECT . + +process call : + opcode INCR 1 ; + word := word AND hex 03ff ; + IF highbyte > hex 7f + THEN word INCR hex 0400 + FI ; + instruction CAT prim op (opcode).mnemonic ; + IF shorta opcode + THEN instruction CAT " " + ELSE instruction CAT " " + FI ; + was bool result := FALSE ; (* Wird von params0 ggf berschrieben *) + instruction CAT params0 (prim op (opcode).params, word, segment, address, words, + INT PROC (INT CONST, INT VAR, TEXT VAR) next word) . + +process ln : + IF shorta opcode + THEN word := short address (lowbyte, highbyte, opcode = 1) + FI ; + IF was bool result + THEN instruction CAT "BT " ; + IF shorta opcode + THEN instruction CAT " " + FI ; + instruction CAT hex16 (branch address) + ELSE IF segment = 2 + THEN instruction CAT "HEAD " + ELSE ln := word ; + instruction CAT "LN " + FI ; + IF shorta opcode + THEN instruction CAT " " + FI ; + instruction CAT text (word) + FI ; + was bool result := FALSE . + +process br : + word := short address (lowbyte, highbyte, opcode = 29) ; + IF was bool result + THEN instruction CAT "BF " ; + ELSE instruction CAT "B " ; + FI ; + IF shorta opcode + THEN instruction CAT " " + FI ; + instruction CAT hex16 (branch address) ; + was bool result := FALSE . + +branch address : + INT VAR high address byte := opcode address ; + split word (high address byte, lowbyte) ; + highbyte := word ; + split word (highbyte, lowbyte) ; + high address byte INCR highbyte ; + IF cmod <> minus one AND high address byte >= cmod + THEN high address byte DECR 16 (* cms = 16 *) + FI ; + make word (high address byte, lowbyte) ; + high address byte . + +ENDPROC decode ; + + +INT PROC short address (INT CONST lowbyte, highbyte, BOOL CONST bit12) : + (* Bit 7 des Highbytes in Bit 0 rotieren *) + INT VAR effective address := (highbyte * 2) AND 6 ; + IF highbyte > hex 7f + THEN effective address INCR 1 + FI ; + make word (effective address, lowbyte) ; (* high and result, low *) + IF bit12 + THEN effective address INCR 2048 + FI ; + effective address + +ENDPROC short address ; + + +INT PROC next word (INT CONST segment, INT VAR address, TEXT VAR words) : + INT CONST word :: get word (segment, address) ; + INC address ; + words CAT hex16 (word) ; + words CAT " " ; + word + +ENDPROC next word ; + + +PROC next module header (INT CONST segment, address, + INT VAR header address, module number) : + INT VAR first, last, mid ; + IF segment = 2 + THEN first := 0 ; + last := 1275 + ELSE first := 1282 ; (* 1280/1281 MAIN doagain & runagain modaddr *) + last := 2047 + FI ; + REP + mid := (first + last) DIV 2 ; + IF ulseq (address, getword (0, 512 + mid)) + THEN last := mid + ELSE first := mid + 1 + FI + UNTIL first = last PER ; + header address := getword (0, 512 + first) ; + module number := first + +ENDPROC next module header ; + + +TEXT PROC params (TEXT CONST types, INT CONST segment, INT VAR address, + TEXT VAR words, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) : + + INT VAR i, param addr, type ; + TEXT VAR result ; + + IF types = "" + THEN LEAVE params WITH "" + FI ; + result := "" ; + FOR i FROM 1 UPTO LENGTH types REP + param addr := next word (segment, address, words) ; + type := code (types SUB i)-63 ; + result CAT data representation (param addr, segment, address, type) ; + IF i <> LENGTH types + THEN result CAT ", " + FI ; + PER ; + result + +ENDPROC params ; + + +TEXT PROC params0 (TEXT CONST types, INT CONST word, segment, INT VAR address, + TEXT VAR words, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) : + + INT VAR i, param addr, type ; + TEXT VAR result ; + + IF types = "" + THEN LEAVE params0 WITH "" + FI ; + result := "" ; + param addr := word ; + FOR i FROM 1 UPTO LENGTH types REP + type := code (types SUB i)-63 ; + result CAT data representation (param addr, segment, address, type) ; + IF i <> LENGTH types + THEN result CAT ", " ; + param addr := next word (segment, address, words) + FI + PER ; + result + +ENDPROC params0 ; + + +TEXT PROC data representation (INT CONST data addr, segment, address, type) : + INT VAR stack offset, ds segment, ds number, ds address ; + TEXT VAR result ; + IF is data address + THEN IF local data address + THEN stack offset := data addr ; + rotate (stack offset, minus one) ; + stack offset := stack offset AND hex 3fff ; + IF local reference address OR type = ref addr + THEN get referenced representation + ELSE get representation from stack + FI + ELSE get representation from packet data + FI + ELSE object representation (minus one, data addr, segment, address, type) + FI . + +is data address : + NOT (type = 23 OR type = 9 OR type = 14) . + +local data address : + data addr < 0 . + +local reference address : + (data addr AND 1) = 1 . + +is runtime : + lbas <> minus one . + +get representation from packet data : + IF with object and address + THEN result := "" + ELSE result := "" + FI ; + result CAT object representation (packet data segment, data addr ADD data base, + segment, address, type) ; + result . + +get representation from stack : + result := "" ; + IF is runtime + THEN IF NOT with object and address + THEN result := "" + FI ; + result CAT object representation (local data segment, + lbas ADD stack offset, segment, address, type) + FI ; + result . + +get referenced representation : + IF is runtime + THEN ds address := getword (local data segment, lbas ADD stack offset) ; + ds number := getword (local data segment, lbas ADD stack offset ADD 1) ; + split word (ds number, ds segment) ; + IF ds number = standard dataspace + THEN IF with object and address + THEN result := "" + ELSE result := "" + FI ; + IF ds segment <= local data segment + THEN result CAT object representation (ds segment, + ds address, segment, address, type) + + ELIF ds segment > 3 (* Illegal! *) + THEN result := "" + ELSE (* PROC-Addresse *) + result CAT object representation (ds segment, + ds address, segment, address, mod addr) + FI ; + result + ELSE "" + FI + ELSE "" + FI . + +ENDPROC data representation ; + + +INT VAR anzahl zeros, anzahl steuerzeichen ; + +TEXT PROC object representation (INT CONST data segment, data address, + segment, address, type) : + TEXT VAR t, result ; + INT VAR i, zeichen, highbyte, lowbyte, first word ; + SELECT type OF + CASE try type,refaddr: try representation + CASE int addr : int representation + CASE real addr : real representation + CASE text addr : text representation + CASE dataspace addr : dataspace representation + CASE task addr : task representation + CASE mod addr : module address representation + CASE bool addr : bool representation + CASE int value : integer value + CASE hexbyte value : integer hexbyte + CASE module nr value : module nr representation + OTHERWISE "unbek. Typ: " + code (type + 63) + ENDSELECT . + +module nr representation : + text val := text (data address) ; + process module nr (data address) . + +bool representation : + IF getword (data segment, data address) = 0 + THEN text val := "TRUE" + ELSE text val := "FALSE" + FI ; + text val . + +reference address : + highbyte := getword (data segment, data address ADD 1) ; + splitword (highbyte, lowbyte) ; + result := "@" + hex8 (highbyte) + "-" + hex8 (lowbyte) ; + result CAT hex16 (getword (data segment, data address)) ; + text val := result ; + result . + +int representation : + i := get word (data segment, data address) ; + text val := text (i) ; + result := text (i) ; + IF i < 0 + THEN result CAT "|" ; + result CAT hex16 (i) ; + result CAT "H" + ELIF i >= 256 + THEN result CAT "|" ; + result CAT hex16 (i) ; + result CAT "H" ; + FI ; + result . + +integer value : + text val := text (data address) ; + text (data address) . + +integer hexbyte : + text val := text (data address) ; + IF (data address AND hex ff00) = 0 + THEN hex8 (data address) + "H" + ELSE hex16 (data address) + "H" + FI . + +real representation : + result := "12345678" ; + FOR i FROM 0 UPTO 3 REP + replace (result, i + 1, get word (data segment, data address ADD i)) + PER ; + disablestop ; + result := compress (text (result RSUB 1, 20)) ; + IF iserror + THEN clear error ; + result := "undefined REAL" + FI ; + text val := result ; + result . + +text representation : + t := copied text var (data segment, data address) ; + result := """" ; + anzahl steuerzeichen := 0 ; + anzahl zeros := 0 ; + FOR i FROM 1 UPTO length (t) REP + zeichen := code (t SUB i) ; + IF zeichen = 34 THEN result CAT """""" + ELIF zeichen = 251 OR zeichen > 31 AND zeichen < 127 OR + zeichen > 213 AND zeichen < 224 THEN result CAT code (zeichen) + ELSE result CAT """" ; + result CAT text (zeichen) ; + result CAT """" ; + anzahl steuerzeichen INCR 1 ; + IF zeichen = 0 + THEN anzahl zeros INCR 1 + FI + FI + PER ; + result CAT """" ; + text val := result ; + result . + +task representation : + INT CONST index := get word (data segment, data address) , + version := get word (data segment, data address ADD 1) ; + IF index < 256 + THEN result := hex8 (index) + ELSE result := hex16 (index) ; + insertchar (result, "-", 3) + FI ; + result CAT "-" ; + result CAT hex16 (version) ; + result CAT "/" ; + result CAT taskname (index, version) ; + text val := result ; + result . + +dataspace representation : + highbyte := get word (data segment, data address) ; + splitword (highbyte, lowbyte) ; + result := hex8 (highbyte) ; + result CAT "-" ; + result CAT hex8 (lowbyte) ; + IF (highbyte AND lowbyte) = 255 + THEN result CAT ":not init" + ELIF (highbyte OR lowbyte) = 0 + THEN result CAT ":nilspace" + FI ; + text val := result ; + result . + +module address representation : + (* Hier: lowbyte = mod nr, highbyte = mod addr *) + next module header (data segment, data address, highbyte, lowbyte) ; + IF highbyte <> data address + THEN linear search (* Adresse mu doch zu finden sein *) + FI ; + text val := text (lowbyte) ; + process module nr (lowbyte) . + +linear search : + IF data segment = 2 + THEN FOR i FROM 512 UPTO 767 REP + IF getword (packet data segment, i) = data address + THEN lowbyte := i-512 ; + LEAVE linear search + FI + PER + ELSE FOR i FROM 1792 UPTO 3839 REP + IF getword (packet data segment, i) = data address + THEN lowbyte := i-512 ; + LEAVE linear search + FI + PER + FI ; (* Moduleaddress nicht gefunden, da stimmt doch was nicht! *) + LEAVE module address representation WITH reference address . + +try representation : + first word := getword (data segment, data address) ; + result := text (first word) ; + IF first word < 0 OR first word >= 256 + THEN result CAT "|" ; + result CAT hex16 (first word) ; + result CAT "H" + FI ; + IF first word = 0 + THEN result CAT "|TRUE" + ELIF first word = 1 + THEN result CAT "|FALSE" + FI ; + IF vorzeichen ok AND nur digits (* real *) + THEN result CAT "|" ; + disablestop ; + TEXT CONST txt :: compress (text (t RSUB 1, 20)) ; + IF is error + THEN clear error + ELSE result CAT txt + FI ; + FI ; + IF within compiler + THEN IF first word >= begin of stringtable CAND first word <= end of nametable + THEN string pointer (* first word wird ggf veraendert! *) + ELIF first word > 9 AND first word < 32 + THEN result CAT "|""""" + text (first word) + """""" (* Char *) + ELIF first word = 34 + THEN result CAT "|""""" + ELIF first word >= 32 AND first word < 127 + THEN result CAT "|""" + code (first word) + """" (* Code-Char *) + FI ; + ELIF text sinnvoll + THEN result CAT "|" ; + result CAT t + FI ; + text val := result ; + result . + +text sinnvoll : + keine steuerzeichen AND + (getword (data segment, data address ADD 1) AND 255) < 80 . + +within compiler : + segment = 2 AND ulseq (address, first elan address-1) . + +string pointer : + IF first word >= begin of name table + THEN first word INCR 2 + FI ; + IF (cdbint (first word) AND 255) < 100 + THEN t := cdbtext (first word) ; + IF pos (t, ""0"", ""31"", 1) = 0 CAND + pos (t, ""127"", ""213"", 1) = 0 CAND + pos (t, ""220"", ""255"", 1) = 0 + THEN result CAT "|""" ; + result CAT t ; + result CAT """" + FI + FI . + +keine steuerzeichen : + t := object representation (data segment, data address, + segment, address, text addr) ; + anzahl steuerzeichen < 4 AND anzahl zeros < 2 AND + getword (data segment, data address ADD 1) <> minus one . + +vorzeichen ok : + (first word AND hex f0) = 0 OR (first word AND hex f0) = 128 . + +nur digits : + t := "12345678" ; + FOR i FROM 0 UPTO 3 REP + replace (t, i + 1, get word (data segment, data address ADD i)) + PER ; + IF (first word AND 15) > 9 THEN FALSE + ELSE FOR i FROM 2 UPTO 7 REP + lowbyte := code (t SUB i) ; + IF (lowbyte AND hex f0) > 249 OR (lowbyte AND 15) > 9 + THEN LEAVE nur digits WITH FALSE + FI + PER ; + TRUE + FI . + +ENDPROC object representation ; + + +TEXT PROC process module nr (INT CONST module number) : + TEXT VAR object specification ; + was bool result := modules last word is bool return ; + IF is elan module number + THEN object specification := module name and specifications (module number) ; + IF object specification = "" + THEN object specification := "Hidden: PACKET " ; + object specification CAT packet name (module number) ; + IF was bool result + THEN object specification CAT " --> BOOL" + FI + ELSE was bool result := pos (object specification, "--> BOOL") > 0 ; + FI + ELIF one of compilers own module numbers + THEN object specification := "CDL (" ; + object specification CAT text ((getword (2, code address (module number)) - 4) DIV 2) ; + object specification CAT ")" ; + IF was bool result + THEN object specification CAT " --> BOOL" + FI + ELIF elan defined internal + THEN SELECT module number - 255 OF + CASE 1 : object specification := "compiler (INT CONST, FILE VAR, TEXT CONST, INT VAR, BOOL CONST ins, BOOL CONST lst, BOOL CONST rtc, BOOL CONST ser)" + CASE 2 : object specification := "outtext (TEXT CONST, INT CONST)" + CASE 3 : object specification := "outline (INT CONST)" + CASE 4 : object specification := "syntaxerror (TEXT CONST)" + CASE 5 : object specification := ":= (FILE VAR, FILE CONST)" + OTHERWISE object specification := "INTERNAL " + text (module number) + ENDSELECT + ELSE object specification := "Modulnummer ohne Code!" ; + was bool result := FALSE + FI ; + IF with object and address OR one of compilers own module numbers + THEN object specification CAT " (" ; + object specification CAT text (module number) ; + object specification CAT ":$" ; + object specification CAT text (code segment (module number)) ; + object specification CAT hex16 (code address (module number)) ; + object specification CAT ")" ; + FI ; + object specification . + +modules last word is bool return : + INT CONST last word :: getword (code segment (module number), + code address (module number + 1) SUB 1) ; + last word = rtnt opcode OR last word = rtnf opcode . + +one of compilers own module numbers : + module number < 244 . + +elan defined internal : + module number >= 256 AND module number < 272 . + +is elan module number : + module number >= 272 . + +ENDPROC process module nr ; + + +TEXT PROC copied text var (INT CONST segment, addr) : + TEXT VAR result, t ; + INT VAR laenge, first char, address, heap segment ; + address := addr ADD 1 ; + first char := getword (segment, address) ; + splitword (first char, laenge) ; + IF laenge = 0 + THEN "" + ELIF laenge = 255 + THEN copy text from heap + ELSE copy text from data segment + FI . + +copy text from data segment : + result := code (first char) ; + laenge DECR 1 ; + t := " " ; + INC address ; + WHILE laenge > 1 REP + replace (t, 1, getword (segment, address)) ; + result CAT t ; + laenge DECR 2 ; + INC address ; + PER ; + IF laenge = 1 + THEN result CAT code (getword (segment, address) AND 255) + FI ; + result . + +copy text from heap : + address := get word (segment, addr) ; + rotate (address, minus one) ; + heap segment := address AND 7 ; + address := address AND hex fff8 ; (* In Vielfachen von 8 *) + laenge := getword (segment, addr ADD 2) AND 255 ; + makeword (laenge, first char) ; (* 16 Bit Laenge ber Wortgrenze *) + laenge := min (laenge, 256) ; (* Mehr ist im Listing nicht sinnvoll *) + IF getword (heap segment, address) = minus one (* Standard DS *) + THEN address INCR 3 ; (* Kann nicht ber 8000H Grenze gehen *) + ELSE INC address (* Im Frei-Datenraum nur Wort Laenge *) + FI ; + result := "" ; + WHILE laenge > 1 REP + result CAT getword (heap segment, address) ; + laenge DECR 2 ; + INC address + PER ; + IF laenge = 1 + THEN result CAT code (getword (heap segment, address) AND 255) + FI ; + result . + +ENDPROC copied text var ; + + +PROC push (INT CONST a, b) : + INT VAR dummy1 := a, dummy2 := b +ENDPROC push ; + + +PROC pop (TASK VAR a, INT CONST dummy) : + TASK VAR x ; + a := x +ENDPROC pop ; + + +TEXT PROC task name (INT CONST id, vers) : + TASK VAR t ; + IF id = 0 + THEN "niltask" + ELSE push (id, vers) ; + pop (t, 0) ; + IF exists (t) + THEN """" + name (t) + """" + ELSE "-" + FI + FI +ENDPROC task name ; + + +ENDPACKET eumel decoder ; + + +(**************************************************************************) + +PACKET tracer DEFINES (* M. Staubermann *) + (* 20.04.86 *) + list breakpoints , (* 1.8.0, 861107 15:45 *) + set breakpoint , + reset breakpoint , + source file , + prot file , + tracer channel , + trace , + reset breakpoints : + +LET local base field = 25 , + packet data segment = 0 , + local data segment = 1 , + code segment 3 = 3 , + + begin of module nr link table = 512 , + + previous local base offset = 0 , + return address offset = 1 , + return segment offset = 2 , + c8k offset = 3 , + + opcode mask = 31744 , + + bt opcode = 0 , + btlong opcode = 1024 , + bf opcode = 28672 , + bflong opcode = 29696 , + br opcode = 28672 , + brlong opcode = 29696 , + brcomp opcode = 32544 , + + ln opcode = 0 , + ln long opcode = 1024 , + call opcode = 30720 , + pcall opcode = 32543 , + + pp opcode = 27648 , + ppv opcode = 26624 , + pproc opcode = 32542 , + + rtn opcode = 32512 , + rtnt opcode = 32513 , + rtnf opcode = 32514 , + + hex 7f00 = 32512 ; + +INT CONST longa opcode :: -256 , + longa ppv opcode :: longa opcode + 104 , + longa pp opcode :: longa opcode + 108 , + hex 83ff :: -31745 , + minus one :: -1 ; + +LET nr of breakpoints = 2 , (* Max. Anzahl unvorhersehbare Verzweigungen/Branch *) + BREAKPOINT = STRUCT (BOOL set, INT address, saved word) ; + +ROW nr of breakpoints BREAKPOINT VAR breakpoints ; +BREAKPOINT CONST init breakpoint :: BREAKPOINT:(FALSE, -5, 0) ; + +FOR actual linenumber FROM 1 UPTO nr of breakpoints REP + breakpoints (actual line number) := init breakpoint +PER ; + + +BOOL VAR auto trace := FALSE , + forward trace := TRUE , + source lines neu := TRUE ; + +INT VAR previous instruction address , + prot file number , + trace channel := minus one , + actual line number := minus one , + handler module := 339 ; (* Dummy: PROC stop *) + +TEXT VAR prot file name := "" , + source line := "" , + source file name := "" ; + +FILE VAR source, protocoll ; + + +INT PROC tracer channel : + trace channel +ENDPROC tracer channel ; + + +PROC tracer channel (INT CONST c) : + IF c < 17 AND c > minus one + THEN trace channel := c + ELSE errorstop ("PROC tracer channel: Kanalnummer unzulssig") + FI +ENDPROC tracer channel ; + + +PROC trace : + TEXT VAR name ; + forward trace := TRUE ; + set breakpoint ; + get command ("PROC/OP-Aufruf eingeben:") ; + out (""13"") ; + put (" Sourcefilename (falls keine Sourcefile RETURN) :") ; + getline (name) ; + source file (name) ; + put (" Protokollfilename (falls kein Protokoll RETURN):") ; + getline (name) ; + prot file (name) ; + put (" Tracekanal (Ausfhrung an diesem Kanal: RETURN):") ; + name := "0" ; + editget (name) ; + line ; + tracer channel (int (name)) ; + do command + +ENDPROC trace ; + + +PROC source file (TEXT CONST file name) : + IF exists (file name) + THEN source := sequentialfile (modify, file name) ; + source file name := file name ; + IF actual line number >= 0 CAND actual line number <= lines (source) + THEN toline (source, actual line number) ; + readrecord (source, source line) + ELSE source line := "" + FI + ELSE source file name := "" + FI + +ENDPROC source file ; + + +TEXT PROC source file : + source file name +ENDPROC source file ; + + +TEXT PROC prot file : + prot file name +ENDPROC prot file ; + + +PROC prot file (TEXT CONST file name) : + IF file name = "" + THEN prot file name := "" + ELSE forget (file name, quiet) ; + prot file number := 0 ; + protocoll := sequentialfile (output, file name) ; + max line length (protocoll, 1000) ; + prot file name := file name ; + FI +ENDPROC prot file ; + + +PROC protocoll line : + IF prot file name <> "" + THEN line (protocoll) ; + IF lines (protocoll) > 4000 + THEN prot file number INCR 1 ; + TEXT CONST file name :: prot file name + "." + + text (prot file number) ; + putline (protocoll, "Fortsetzung in Datei " + file name) ; + forget (file name, quiet) ; + protocoll := sequentialfile (output, file name) ; + max line length (protocoll, 1000) + FI + FI + +ENDPROC protocoll line ; + + +PROC write protocoll (TEXT CONST t) : + IF prot file name <> "" + THEN write (protocoll, t) + FI +ENDPROC write protocoll ; + + +PROC breakpoint handler : + + ROW 32 INT VAR offset fuer inter call stack variablen ; + BOOL VAR was bool result , + ueberschrift neu , + code lines neu ; + TEXT VAR key, previous key, + old error message , + statement line, opcode, + previous opcode, next opcode ; + INT VAR i, x, y , + actual opcode, actual word, op word, next instruction, + following word, saved word, + lbas, this local base, st ptr, + old channel, old error code, old error line, + user address, branch address, address, + lowbyte, + c8k, packet base, + actual instruction address, previous actual address, + next instruction address, + return segment, return address, + breakpoint address, breakpoint nr ; + + determine return address and breakpoint nr ; + reset breakpoints ; + getcursor (x, y) ; + next instruction address := breakpoint address ; + IF NOT forward trace AND previous instruction address <> minus one + THEN decode instruction (previous instruction address, previous actual address, + previous opcode, FALSE) ; + ELSE previous opcode := "" + FI ; + decode instruction (next instruction address, actual instruction address, + next opcode, TRUE) ; + was bool result := bool result ; + IF forward trace + THEN write protocoll (" " + hex16 (actual instruction address) + " ") ; + write protocoll (next opcode) ; + protocoll line + ELSE write protocoll ("*" + hex16 (previous actual address) + " ") ; + write protocoll (previous opcode) ; + protocoll line + FI ; + actual word := getword (code segment 3, actual instruction address) ; + actual opcode := actual word AND opcode mask ; + following word := getword (code segment 3, actual instruction address ADD 1) ; + next instruction := getword (code segment 3, next instruction address) ; + out (""1""10""5""10""5"") ; + IF NOT auto trace + THEN out (""6""6""0"") ; + putline ("Auto, Bpnt, Clrr, Dstp, Estp, File, Go, Prot, Rslt, Step(CR), Term, - + < >"5"") ; + putline ("------------------------------------------------------------------------------"5"") ; + FI ; + ueberschrift neu := TRUE ; + code lines neu := TRUE ; + previous key := "" ; + REP + kopf schreiben ; + IF auto trace + THEN IF incharety = "" + THEN key := "S" + ELSE auto trace := FALSE + FI + FI ; + IF NOT auto trace + THEN REP + inchar (key) + UNTIL pos (""13"abcdefgprst +-<>", key) > 0 PER ; + IF key >= "a" + THEN key := code (code (key)-32) + FI ; + analyze key + FI ; + previous key := key + UNTIL pos ("GST!", key) > 0 PER ; + IF key <> "T" + THEN execute saved instruction + FI ; + IF key = "T" + THEN write protocoll (" Terminated") ; + protocoll line ; + resetbreakpoints ; + term + ELIF key = "G" + THEN write protocoll (" Go") ; + protocoll line + ELIF key = "S" + THEN singlestep + FI ; + previous instruction address := breakpoint address ; + cursor (x, y) ; + IF trace channel > 0 + THEN IF old channel = 0 + THEN break (quiet) + ELSE continue (old channel) + FI + FI ; + IF bit (return segment, 7) + THEN disablestop ; + set line nr (old error line) ; + error stop (old error code, old error message) ; + set line nr (0) + FI . + +analyze key : + IF previous key = "B" + THEN IF key = ""13"" OR key = "S" (* Sicherheitsabfrage *) + THEN key := "!" ; (* Exit-Key *) + write protocoll (" Skip") ; + protocoll line ; + write protocoll (" " + hex16 (user address) + " ") ; + write protocoll (opcode) ; + protocoll line ; + set breakpoint (breakpoint nr, user address) + ELSE code lines neu := TRUE + FI + ELIF key = ""13"" + THEN key := "S" + ELIF key = " " + THEN code lines neu := TRUE ; + source lines neu := TRUE ; + ueberschrift neu := TRUE ; + ELSE SELECT code (key)-43 OF (* Um die Anzahl Branches klein zu halten*) + CASE 0 {+} : stptr := stptr ADD 2 ; + ueberschrift neu := TRUE + CASE 2 {-} : stptr := stptr SUB 2 ; + ueberschrift neu := TRUE + CASE 17 {<} : with object address (TRUE) ; + IF forward trace + THEN decode instruction (breakpoint address, + actual instruction address, next opcode, FALSE) + ELIF previous instruction address <> minus one + THEN decode instruction (previous instruction address, + previous actual address, previous opcode, FALSE) + FI ; + code lines neu := TRUE + CASE 19 {>} : with object address (FALSE) ; + IF forward trace + THEN decode instruction (breakpoint address, + actual instruction address, next opcode, FALSE) + ELIF previous instruction address <> minus one + THEN decode instruction (previous instruction address, + previous actual address, previous opcode, FALSE) + FI ; + code lines neu := TRUE ; + CASE 22 {A} : auto trace := TRUE ; + key := "S" + CASE 23 {B} : get breakpoint address from user + CASE 24 {C} : resetbit (return segment, 7) ; + ueberschrift neu := TRUE + CASE 25 {D} : setbit (return segment, 6) ; + ueberschrift neu := TRUE + CASE 26 {E} : resetbit (return segment, 6) ; + ueberschrift neu := TRUE + CASE 27 {F} : out (""6""5""0"Sourcefile:"5"") ; + editget (source file name) ; + source file (source file name) ; + ueberschrift neu := TRUE ; + source lines neu := TRUE + CASE 37 {P} : out (""6""5""0"Protokollfile:"5"") ; + editget (prot file name) ; + prot file (prot file name) + CASE 39 {R} : forward trace := NOT forward trace ; + IF NOT forward trace AND previous opcode = "" AND + previous instruction address <> minus one + THEN decode instruction (previous instruction address, + previous actual address, previous opcode, FALSE) + FI ; + ueberschrift neu := TRUE ; + code lines neu := TRUE + ENDSELECT + FI . + +kopf schreiben : + out (""6""5""0""5"") ; + IF ueberschrift neu + THEN schreibe ueberschrift ; + ueberschrift neu := FALSE + FI ; + IF source lines neu + THEN schreibe source lines ; + source lines neu := FALSE + FI ; + IF code lines neu + THEN IF forward trace + THEN show decoded opcode (next opcode, + actual instruction address, TRUE, TRUE) + ELIF previous instruction address <> minus one + THEN show decoded opcode (previous opcode, + previous actual address, TRUE, TRUE) + ELSE out (""6""5""0"Kein vorhergehender Befehl") + FI ; + code lines neu := FALSE + FI . + +schreibe ueberschrift : + out (""1"") ; + put (breakpoint nr) ; + IF forward trace + THEN put ("F") (* forward *) + ELSE put ("R") (* result *) + FI ; + IF bit (return segment, 4) + THEN out ("u") (* ARITHU *) + ELSE out ("s") + FI ; + IF bit (return segment, 6) + THEN out ("d") (* Disablestop *) + ELSE out ("e") + FI ; + IF bit (return segment, 7) + THEN put ("E") (* iserror *) + ELSE put (" ") + FI ; + put ("lbas:") ; put (hex16 (lbas)) ; + out ("stack(") ; out (hex16 (stptr)) ; put ("):") ; + out (hex16 (getword (local data segment, stptr))) ; out ("-") ; + put (hex16 (getword (local data segment, stptr ADD 1))) ; + put ("pbas:") ; put (hex8 (packet base)) ; + put ("c8k:") ; put (hex8 (c8k)) ; + IF valid source + THEN out ("""") ; outsubtext (source file name, 1, 19) ; put ("""") + FI ; + out (""5"") . + +schreibe source lines : + out (""1""10"") ; + IF valid source AND source line <> "" + THEN put (text (actual line number, 4)) ; + put ("|") ; + outsubtext (source line, 1, 72) ; + out (""5"") ; + line ; + IF LENGTH source line <= 72 + THEN put (text (actual line number +1, 4)) ; + put ("|") ; + toline (source, actual line number +1) ; + out (subtext (source, 1, 72)) ; + out (""5"") ; + toline (source, actual line number) ; + line + ELSE put ("_____|") ; + outsubtext (source line, 73, 144) ; + out (""5"") ; + line + FI + FI . + +valid source : + exists (source file name) . + +get breakpoint address from user : + put ("Nchste Breakpointaddresse (hex) in Segment 3:") ; + statement line := hex16 (next instruction address) ; + editget (statement line) ; + user address := integer (statement line) ; + opcode := "" ; + statement line := "" ; + address := user address ; + bool result (FALSE) ; + decode (code segment 3, address, statement line, + opcode, INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; + show decoded opcode (opcode, user address, TRUE, TRUE) ; + code lines neu := FALSE . + +singlestep : + IF is return opcode + THEN set breakpoint behind previous call + ELIF was bool result AND NOT is call opcode + THEN set first breakpoint behind branch instruction ; + set second breakpoint at branch address + ELIF is bool return opcode + THEN set first breakpoint behind branch instruction at return address ; + set second breakpoint at branch address of branch instruction at + return address + ELIF is brcomp opcode + THEN set computed branch breakpoint + ELIF is branch instruction + THEN set breakpoint at branch address + ELIF is call opcode AND NOT auto trace CAND segment 3 module CAND + ask if subroutine trace + THEN write protocoll (" Subroutine Trace") ; + protocoll line ; + calculate subroutine segment and address ; + set breakpoint behind next instruction + ELSE set breakpoint behind next instruction + FI . + +ask if subroutine trace : + IF forward trace + THEN yes (""6""5""0"Subroutine Trace") + ELSE show decoded opcode (next opcode, actual instruction address, FALSE, FALSE) ; + yes (""6""6""0"Subroutine Trace"5"") + FI . + +is line number : + actual opcode = ln opcode OR (* Kein LONGA, da ln < 4095 *) + actual opcode = lnlong opcode . + +is branch instruction : + actual opcode = br opcode OR + actual opcode = brlong opcode . + +is conditional branch : + op word = bf opcode OR op word = bflong opcode OR + op word = bt opcode OR op word = btlong opcode . + +is brcomp opcode : + actual word = brcomp opcode . + +is return opcode : + actual word = rtn opcode . + +is bool return opcode : + actual word = rtnt opcode OR + actual word = rtnf opcode . + +is call opcode : + actual opcode = call opcode OR + actual word = pcall opcode . + +read source line : + actual line number := actual word ; + split word (actual line number, lowbyte) ; + actual line number := (actual line number * 2) AND 6 ; + IF actual word < 0 + THEN actual line number INCR 1 + FI ; + IF actual opcode = lnlong opcode + THEN actual line number INCR 8 + FI ; + makeword (actual line number, lowbyte) ; + actual line number DECR 1 ; + source lines neu := TRUE ; + IF valid source + THEN IF lineno (source) = actual line number CAND source line <> "" + THEN (* nichts*) + ELIF actual line number >= 0 AND actual line number <= lines(source) + THEN toline (source, actual line number) ; + readrecord (source, source line) + ELSE source line := "" + FI + ELSE source line := "" + FI . + +set first breakpoint behind branch instruction : + op word := next instruction AND opcode mask ; + IF is conditional branch + THEN write protocoll (" ") ; + write protocoll (hex16 (next instruction address) + " ") ; + bool result (TRUE) ; + statement line := "" ; + opcode := "" ; + address := next instruction address ; + decode (code segment 3, next instruction address, statement line, opcode, + INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; + write protocoll (opcode) ; + protocoll line ; + show decoded opcode (opcode, address, FALSE, FALSE) ; + IF NOT auto trace + THEN pause (20) + FI ; + next free breakpoint ; + set breakpoint (i, next instruction address) ; + ELSE putline ("Interner Fehler: Nach BOOL-Result folgt kein Branch"5""); + LEAVE singlestep + FI . + +set second breakpoint at branch address : + calculate branch address ; + next free breakpoint ; + set breakpoint (i, branch address) . + +set breakpoint at branch address : + next instruction := actual word ; + next instruction address := actual instruction address ; + calculate branch address ; + set breakpoint (breakpoint nr, branch address) . + +set first breakpoint behind branch instruction at return address : + IF (getword (local data segment, lbas + return segment offset) AND 7) = code segment 3 + THEN next instruction address := getword (local data segment, + lbas + return address offset) ; + next instruction := getword (code segment 3, next instruction address) ; + c8k := getword (local data segment, lbas + c8k offset) AND 255 ; + set first breakpoint behind branch instruction + ELSE putline ("Trace bei Vorwrtssprung beendet."5"") + FI . + +set second breakpoint at branch address of branch instruction at return address : + set second breakpoint at branch address . + +set computed branch breakpoint : + address := following word ; + IF address < 0 (* Local/Local Ref *) + THEN rotate (address, minus one) ; + address := (address AND 16 383) ADD lbas ; + IF bit (following word, 0) + THEN branch address := getword (getword (local data segment, + address ADD 1) AND 7, + getword (local data segment, + address)) + ELSE branch address := getword (local data segment, address) + FI + ELSE branch address := getword (packet data segment, + address ADD packet base) + FI ; + IF switch out of range + THEN branch address := actual instruction address ADD 3 + ELSE branch address := actual instruction address ADD branch address ADD 4 + FI ; + set breakpoint (breakpoint nr, branch address) . + +switch out of range : + branch address < 0 OR + branch address > getword (code segment 3, actual instruction address ADD 2) . + +determine return address and breakpoint nr : + FOR x FROM 1 UPTO 10 REP + determine return address ; + determine breakpoint nr ; + PER ; + line ; + put ("Returnaddresse nicht gefunden:"5"") ; + out (text (return segment AND 3)) ; + putline (hex16 (return address)) ; + list breakpoints ; + reset breakpoints ; + enablestop ; + errorstop ("Falsche Returnaddresse") . + +determine return address : + fix local base ; (* Fix pcb's: RAM --> Leitblock *) + this local base := getword (local data segment, pcb (local base field)) ; + lbas := getword (local data segment, this local base + + previous local base offset) ; + c8k := getword (local data segment, this local base + + c8k offset) AND 255 ; + return segment := getword (local data segment, this local base + + return segment offset) ; + return address := getword (local data segment, this local base + + return address offset) ; + packet base := HIGH return segment ; (* Wort besteht aus zwei Teilen!*) + set parameters (lbas, packet base, minus one, c8k) ; + stptr := lbas ADD 4 ; + DEC return address ; (* auf CALL breakpointhandler (ein Wort zurck) *) + IF bit (return segment, 7) (* ISERR *) + THEN old error line := error line ; + old error code := error code ; + old error message := error message + FI ; + clear error ; + enablestop ; + IF trace channel > 0 AND trace channel <> channel + THEN old channel := channel ; + disablestop ; + continue (trace channel) ; + clear error ; + enablestop + FI . + +determine breakpoint nr : + FOR i FROM 1 UPTO nr of breakpoints REP + IF breakpoints (i).set CAND + breakpoints (i).address = return address + THEN breakpoint nr := i ; + breakpoint address := breakpoints (i).address ; + saved word := breakpoints (i).saved word ; + LEAVE determine return address and breakpoint nr + FI + PER . + +segment 3 module : + IF actual word = pcall opcode + THEN op word := following word ; + rotate (op word, minus one) ; + op word := (op word AND 16 383) ADD lbas ; + LEAVE segment 3 module WITH (getword (local data segment, + op word ADD 1) AND 7) = code segment 3 + ELSE op word := actual word AND 1023 ; + IF actual word < 0 + THEN op word INCR 1024 + FI ; + FI ; + op word >= 1280 . + +calculate subroutine segment and address : + IF actual word = pcall opcode + THEN next instruction address := getword (local data segment, op word) + ELSE next instruction address := getword (packet data segment, + begin of module nr link table + op word) + FI ; + INC next instruction address . (* Ab PENTER tracen *) + +calculate branch address : + branch address := next instruction ; + split word (branch address, low byte) ; + branch address := (branch address * 2) AND 6 ; + IF next instruction < 0 + THEN branch address INCR 1 + FI ; + IF branch long + THEN branch address INCR 8 + FI ; + branch address INCR HIGH next instruction address ; + IF branch address >= c8k + THEN branch address DECR 16 + FI ; + makeword (branch address, lowbyte) . + +branch long : + bit (next instruction, 10) . + +execute saved instruction : + putword (local data segment, this local base + return address offset, + return address) ; + putword (local data segment, this local base + return segment offset, + return segment) . + + +set breakpoint behind next instruction : + IF is line number THEN read source line FI ; + set breakpoint (breakpoint nr, next instruction address) . + + +set breakpoint behind previous call : + return segment := getword (local data segment, + lbas + return segment offset) AND 3 ; + return address := getword (local data segment, + lbas + return address offset) ; + IF return segment = code segment 3 + THEN set breakpoint (breakpoint nr, return address) + ELSE putline ("Trace bei Rcksprung beendet."5"") + FI . + +next free breakpoint : + FOR i FROM 1 UPTO nr of breakpoints REP + IF NOT breakpoints (i).set + THEN LEAVE next free breakpoint + FI + PER ; + putline ("Alle " + text(nr of breakpoints) + " Breakpoints sind belegt"5"") ; + LEAVE singlestep + +ENDPROC breakpoint handler ; + + +PROC show decoded opcode (TEXT CONST opcode, INT CONST address, + BOOL CONST zweizeilig, oben) : + IF oben + THEN out (""6""3""0"") + ELSE out (""6""5""0"") + FI ; + put (hex16 (address)) ; + put ("|") ; + outsubtext (opcode, 1, 72) ; + out (""5"") ; + line ; + IF zweizeilig + THEN put (" |") ; + outsubtext (opcode, 73, 144) ; + out (""5"") ; + line + FI + +ENDPROC show decoded opcode ; + + +PROC decode instruction (INT VAR address, actual address, TEXT VAR opcode, + BOOL CONST var) : + + INT VAR actual word, actual opcode, temp address ; + TEXT VAR statement line := "" ; + opcode := "" ; + temp address := address ; + actual address := address ; + actual word := getword (code segment 3, temp address) ; + actual opcode := actual word AND opcode mask ; + bool result (FALSE) ; + IF is param push opcode + THEN opcode := module with actual params (temp address, actual address) ; + ELSE decode (code segment 3, temp address, + statement line, opcode, + INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; + FI ; + IF var THEN address := temp address FI . + +is param push opcode : + actual opcode = pp opcode OR + actual word = pproc opcode OR + actual word = longa pp opcode OR + actual word = longa ppv opcode OR + actual opcode = ppv opcode . + +ENDPROC decode instruction ; + + +TEXT PROC module with actual params (INT VAR address, actual address) : + + TEXT VAR result, statement line, symbol, type text ; + INT VAR end address, start address := address, module nr, + actual word, actual opcode ; + BOOL VAR known paramtypes, was bool result ; + + skip until next call opcode ; + determine module name and module nr ; + collect actual parameters ; + perhaps result type ; + bool result (was bool result) ; + address := end address ; + result . + +skip until next call opcode : + actual word := getword (code segment 3, address) ; + REP + IF (actual word AND hex 7f00) = hex 7f00 (* LONGA oder ESC *) + THEN INC address + FI ; + INC address ; + actual word := getword (code segment 3, address) ; + actual opcode := actual word AND opcode mask ; + UNTIL is call opcode PER . + +determine module name and module nr : + result := "" ; + statement line := "" ; + actual address := address ; (* Addresse des CALL/PCALL Befehls *) + decode (code segment 3, address, statement line, result, + INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; + was bool result := bool result ; + bool result (FALSE) ; + end address := address ; + module nr := int (last actual parameter) ; + statement line := module name and specifications (module nr) ; + scan (statement line) ; + IF statement line = "" + THEN symbol := "(" ; + known paramtypes := FALSE ; + actual word := getword (code segment 3, start address) ; + actual opcode := actual word AND opcode mask ; + IF is call opcode (* Hidden ohen Result und Parameter *) + THEN LEAVE module with actual params WITH result + ELSE result CAT " (" (* Result wird als VAR Parameter betr.*) + FI + ELSE nextsymbol (symbol) ; (* Skip Name *) + nextsymbol (symbol) ; + known paramtypes := TRUE ; + IF symbol = "" (* Weder Parameter, noch Result *) + THEN LEAVE module with actual params WITH result + ELIF symbol = "(" + THEN result := subtext (result, 1, pos (result, "(")) ; + ELSE result := subtext (result, 1, pos (result, "-->")-2) + FI ; + FI ; + address := start address . (* Rcksetzen auf ersten param push *) + +collect actual parameters : + IF symbol <> "(" + THEN LEAVE collect actual parameters + FI ; + REP + nextsymbol (symbol) ; + IF symbol = "ROW" + THEN typetext := "ROW..." ; + nextsymbol (symbol) ; (* ROW-Size *) + skip until end of type (symbol) ; + ELIF symbol = "STRUCT" + THEN typetext := "STRUCT..." ; + nextsymbol (symbol) ; + skip over brackets (symbol) ; + ELIF symbol = "<" (* HIDDEN *) + THEN typetext := "" ; + nextsymbol (symbol) ; + nextsymbol (symbol) ; + nextsymbol (symbol) ; + ELIF symbol <> "PROC" + THEN typetext := symbol ; + nextsymbol (symbol) + FI ; (* symbol jetzt 'PROC', 'CONST' oder 'VAR' *) + IF getword (code segment 3, address) = pproc opcode + THEN result CAT "PROC " ; + type text := "" ; + decode (code segment 3, address, statement line, type text, + INT PROC (INT CONST, INT VAR, TEXT VAR) next word) ; + result CAT subtext (type text, 13) ; + next symbol (symbol) ; + IF symbol = "(" THEN skip over brackets (symbol) FI + ELSE IF statement line <> "" (* Keine Hidden PROC *) + THEN result CAT typetext ; + result CAT " " ; + result CAT symbol ; (* CONST oder VAR *) + result CAT ":" ; + typetext := ":" + typetext ; (* Fr Pos-Suche *) + nextsymbol (symbol) ; (* Jetzt auf ',' oder ')' *) + FI ; + IF (getword (code segment 3, address) AND hex 7f00) = hex 7f00 (* ESC OR LONGA *) + THEN result CAT data representation (getword (code segment 3, + address ADD 1), code segment 3, address, object type) ; + INC address + ELSE result CAT data representation (getword (code segment 3, address) + AND hex 83ff, code segment 3, address, object type) + FI ; + INC address + FI ; + actual word := getword (code segment 3, address) ; + actual opcode := actual word AND opcode mask ; + IF symbol <> ")" AND NOT is call opcode + THEN result CAT ", " + FI ; + UNTIL symbol = ")" OR is call opcode PER ; + result CAT ")" . + +perhaps result type : + WHILE symbol <> "" REP nextsymbol (symbol) UNTIL symbol = ">" PER ; (* --> *) + IF symbol <> "" + THEN nextsymbol (symbol) ; + IF symbol = "ROW" + THEN symbol := "ROW..." ; + ELIF symbol = "STRUCT" + THEN symbol := "STRUCT..." ; + ELIF symbol = "<" (* HIDDEN *) + THEN symbol := "" ; + FI ; + type text := ":" ; + type text CAT symbol ; + result CAT " --> " ; + result CAT symbol ; + IF symbol = "BOOL" (* BOOl-Result nicht mit PP *) + THEN LEAVE perhaps result type + FI ; + result CAT ":" ; + IF (getword (code segment 3, address) AND hex 7f00) = hex 7f00 (* ESC OR LONGA *) + THEN result CAT data representation (getword (code segment 3, + address ADD 1), code segment 3, address, object type) ; + INC address + ELSE result CAT data representation (getword (code segment 3, address) + AND hex 83ff, code segment 3, address, object type) + FI ; + INC address + FI . + +object type : + IF known paramtypes + THEN INT CONST p := pos (types, type text) ; + IF p = 0 + THEN 0 (* Try Type auch bei STRUCT/ROW *) + ELSE code (types SUB (p-1))-63 + FI + ELSE 0 (* Try all types *) + FI . + +types : + "B:BOOL I:INT R:REAL S:TEXT T:TASK D:DATASPACE D:FILE S:THESAURUS" . + +is call opcode : + actual opcode = call opcode OR + actual word = pcall opcode . + +ENDPROC module with actual params ; + + +PROC skip until end of type (TEXT VAR symbol) : + nextsymbol (symbol) ; + IF symbol = "ROW" + THEN nextsymbol (symbol) ; (* ROW-Size *) + skip until end of type (symbol) + ELIF symbol = "STRUCT" + THEN next symbol (symbol) ; + skip over brackets (symbol) + ELSE nextsymbol (symbol) (* steht auf ',' oder ')' *) + FI + +ENDPROC skip until end of type ; + + +PROC skip over brackets (TEXT VAR symbol) : + REP + next symbol (symbol) ; + IF symbol = "(" THEN skip over brackets (symbol) FI + UNTIL symbol = ")" PER ; + nextsymbol (symbol) + +ENDPROC skip over brackets ; + + +INT OP HIGH (INT CONST word) : + INT VAR highbyte := word, lowbyte ; + split word (highbyte, lowbyte) ; + highbyte + +ENDOP HIGH ; + + +PROC fix local base : + (* Kein direkter EXTERNAL-Aufruf, da bei 'CALL' lbas auf Stack gelegt wird*) + REP UNTIL incharety = "" PER ; (* Damit pause ausgefhrt wird *) + internal pause (0) (* ^ War Grund fr 'falsche Returnaddresse'*) + +ENDPROC fix local base ; + + +PROC reset breakpoints : + INT VAR i ; + FOR i FROM 1 UPTO nr of breakpoints REP + IF breakpoints (i).set + THEN reset breakpoint (i) + ELSE breakpoints (i) := init breakpoint + FI + PER + +ENDPROC reset breakpoints ; + + +PROC reset breakpoint (INT CONST nr) : + IF nr < 1 OR nr > nr of breakpoints + THEN errorstop ("Unzulaessige Breakpoint Nummer") + ELIF NOT breakpoints (nr).set + THEN display ("Warnung: Breakpoint " + text (nr) + " war nicht gesetzt") + ELSE putword (code segment 3, breakpoints (nr).address, breakpoints (nr).saved word) ; + breakpoints (nr) := init breakpoint + FI + +ENDPROC reset breakpoint ; + + +PROC set breakpoint (INT CONST nr, address) : + INT VAR new word ; + IF nr < 1 OR nr > nr of breakpoints + THEN errorstop ("Unzulaessige Breakpoint Nummer") + ELIF breakpoints (nr).set + THEN errorstop ("Breakpoint " + text (nr) + " ist bereits gesetzt") + ELSE breakpoints (nr).address := address ; + breakpoints (nr).saved word := get word (code segment 3, address) ; + new word := call opcode + (handler module AND 1023) ; + IF handler module >= 1024 + THEN setbit (new word, 15) + FI ; + putword (code segment 3, address, new word) ; + IF getword (code segment 3, address) <> new word + THEN errorstop ("Addresse Schreibgeschuetzt") + ELSE breakpoints (nr).set := TRUE + FI + FI +ENDPROC set breakpoint ; + + +PROC handlers module nr (INT CONST module nr) : + handler module := module nr +ENDPROC handlers module nr ; + + +INT PROC handlers module nr : + handler module +ENDPROC handlers module nr ; + + +INT PROC module number (PROC proc) : + + EXTERNAL 35 + +ENDPROC module number ; + + +PROC internal pause (INT CONST time) : + + EXTERNAL 66 + +ENDPROC internal pause ; + + +PROC term : + + EXTERNAL 4 + +ENDPROC term ; + + +PROC set breakpoint : + INT VAR i ; + handlers module nr (module number (PROC breakpointhandler)) ; + auto trace := FALSE ; + source lines neu := TRUE ; (* Zum Lschen *) + source file ("") ; + prot file ("") ; + actual line number := minus one ; + previous instruction address := minus one ; + with object address (FALSE) ; + INT VAR module nr ; + add modules ; + get module number (module nr) ; + IF code segment (module nr) <> code segment 3 + THEN errorstop ("PROC/OP liegt nicht im Codesegment 3") + FI ; + naechsten freien breakpoint setzen ; + put ("Breakpoint") ; + put (i) ; + putline ("wurde gesetzt.") . + +naechsten freien breakpoint setzen : + FOR i FROM 1 UPTO nr of breakpoints REP + IF NOT breakpoints (i).set + THEN set breakpoint (i, code address (module nr) ADD 1) ; + LEAVE naechsten freien breakpoint setzen + FI + PER ; + errorstop ("Alle " + text (nr of breakpoints) + " Breakpoints sind belegt"). + +ENDPROC set breakpoint ; + + +PROC list breakpoints : + INT VAR header address, mod nr, i ; + + line ; + putline (" Nr Set Address Word Module") ; + FOR i FROM 1 UPTO nr of breakpoints REP + put (text (i, 2)) ; + IF breakpoints (i).set + THEN put (" Y ") + ELSE put (" N ") + FI ; + out ("3") ; + put (hex16 (breakpoints (i).address)) ; + put (" ") ; + put (hex16 (breakpoints (i).saved word)) ; + IF breakpoints (i).set + THEN next module header (code segment 3, breakpoints (i).address, + header address, mod nr) ; + IF module name and specifications (modnr - 1) = "" + THEN put ("Hidden: PACKET") ; put (packet name (modnr -1)) ; + ELSE put (module name and specifications (modnr -1)) + FI + FI ; + line + PER + +ENDPROC list breakpoints ; + +ENDPACKET tracer ; + +init module table ("table.module") ; +type (""27"q") ; +note ("") ; diff --git a/devel/misc/unknown/src/0DISASS.ELA b/devel/misc/unknown/src/0DISASS.ELA new file mode 100644 index 0000000..954fdf7 --- /dev/null +++ b/devel/misc/unknown/src/0DISASS.ELA @@ -0,0 +1,1110 @@ +PACKET eumel 0 code disassembler DEFINES (* M.Staubermann, Mrz/April 86 *) + disass 0 code, +(* disass object, + disass address, + disass module nr, *) + disass 0, + ADD, + hex16, + hex8 , + integer, + denoter, + opcode, + seg, + addr, + end addr, + local base , + bool result , + code word line : + +LET packet data segment = 0 , + local data segment = 1 , + first elan address = 13322 , + begin of stringtable = 1024 , + begin of nametable = 4096 , + end of nametable = 19455 , + begin of permanent table = 19456 ; + +INT VAR address, segment, lbas ; + +PROC local base (INT CONST i) : + lbas := i (* -1 = lbas unbekannt *) +ENDPROC local base ; + +TEXT PROC code word line : + code words +ENDPROC code word line ; + +PROC code word line (TEXT CONST text) : + code words := text +ENDPROC code word line ; + +PROC seg (INT CONST s) : + segment := s +ENDPROC seg ; + +PROC addr(INT CONST a) : + address := a +ENDPROC addr ; + +INT PROC addr : + address +ENDPROC addr ; + +BOOL PROC bool result : + was bool result +ENDPROC bool result ; + +PROC bool result (BOOL CONST b) : + was bool result := b +ENDPROC bool result ; + +PROC end addr (INT CONST e) : + end address := e +ENDPROC end addr ; + +PROC disass 0 code (INT CONST seg, INT VAR addr, PROC (TEXT CONST) writeln) : + TEXT VAR taste ; + BOOL VAR addr out := TRUE , + output permitted := TRUE, + is packet ; + INT VAR size, used, mod nr, a, b, m ; + storage (size, used) ; + echo := FALSE ; + init list file ; + segment := seg ; + address := addr ; + mod nr := -1 ; + was bool result := FALSE ; + REP + IF output permitted + THEN IF addr out + THEN out (" ") ; + out (hex16 (address)) ; + out (" "8""8""8""8""8""8"") ; + ELSE cout (ln) + FI + FI ; + taste := incharety ; + disass one statement ; + SELECT code (taste) OF +{l}CASE 108 : addr out := FALSE +{d}CASE 100 : get command ("gib kommando:") ; do command +{f}CASE 102 : out (""13""5"Filename: "+filename+ "." + text(filenumber)+" ") +{z}CASE 122 : out (""13""5"Fileline: "+text (lines (list file)) + " ") +{a}CASE 97 : addr out := TRUE +{e}CASE 101 : echo := NOT echo +{s}CASE 115 : storage(size,used);out(""13""5"System-Storage: "+text(used)+" ") +{h}CASE 104 : out (""13""5"Heapsize: " + text (heapsize) + " ") +{m}CASE 109 : out (""13""5"Modulnr: " + text (mod nr) + " ") +{W}CASE 87, 81: output permitted := TRUE +{S}CASE 83 : output permitted := FALSE + CASE 27 : IF incharety <> "" THEN taste := "" FI(* Wegen Steuertasten *) + ENDSELECT ; + arith 16 ; + address INCR 1 ; + arith 15 ; + IF (address AND 31) = 0 + THEN storage (size, used) ; + FI ; + BOOL CONST ende erreicht :: end address <> 0 CAND + real (address) >= real (end address) ; + UNTIL ende erreicht OR taste = ""27"" OR taste = ""129"" OR used > size PER ; + IF used > size + THEN writeln ("Abbruch wegen Speicherengpass!") + ELIF taste = ""27"" + THEN writeln ("Abbruch mit ESC") + FI ; + addr := address . + +code word : + get word (segment, address) . + +disass one statement : + a := address ; + divrem 256 (a, b) ; + IF segment = 2 + THEN m := pos (segment 2 adresses, ""0"" + code (b) + code (a) + ""0"") ; + IF m <= LENGTH segment 2 adresses - 4 + THEN IF code (segment 2 adresses SUB (m + 4)) <= a + THEN IF code (segment 2 adresses SUB (m + 4)) = a + THEN is packet := + code (segment 2 adresses SUB (m + 3)) <= b + ELSE is packet := TRUE + FI + ELSE is packet := FALSE + FI + ELSE is packet := FALSE + FI + ELSE m := pos (segment 3 adresses, ""0"" + code (b) + code (a) + ""0"") ; + IF m <= LENGTH segment 3 adresses - 4 + THEN IF code (segment 3 adresses SUB (m + 4)) <= a + THEN IF code (segment 3 adresses SUB (m + 4)) = a + THEN is packet := + code (segment 3 adresses SUB (m + 3)) <= b + ELSE is packet := TRUE + FI + ELSE is packet := FALSE + FI + ELSE is packet := FALSE + FI + FI ; + IF m > 0 AND end address = 0 AND addr <> address + THEN taste := ""129"" ; + LEAVE disass one statement + ELIF m > 0 + THEN m := (m - 1) DIV 3 + 1 ; + IF segment = 2 + THEN mod nr := segment 2 modules ISUB m + ELSE mod nr := segment 3 modules ISUB m + FI ; + writeln (" ") ; + writeln ("Modulnummer " + process module nr (mod nr, is packet)) ; + writeln ("Top of Stack: " + hex16 (codeword)) ; + arith 16 ; + address INCR 1 ; + arith 15 ; + writeln (" ") + FI ; + codewords := hex16 (address) + " " ; + codewords CAT hex16 (code word) + " " ; + TEXT CONST opc := opcode ; + WHILE length (codewords) < 30 REP + codewords CAT " " + PER ; + writeln (codewords + opc) . + +ENDPROC disass 0 code ; + +PROC init list file : + forget (filename + "." + text (filenumber), quiet) ; + list file := sequentialfile (output, filename + "." + text (filenumber)) ; + maxlinelength (list file, 9999) ; + list line ("Addr Opco Data Data Data Data Opcode Parameter") ; +ENDPROC init list file ; + +PROC list line (TEXT CONST zeile) : + IF lines (list file) > 4000 + THEN file number INCR 1 ; + init list file + FI ; + putline (list file, zeile) ; + IF echo + THEN putline (zeile) + FI +ENDPROC list line ; + +PROC disass object : + TEXT VAR object name ; + INT VAR nth object , code address ; + put ("Filename:") ; + getline (filename) ; + filenumber := 0 ; + end address := 0 ; + REP + clear error ; + enablestop ; + page ; + put ("Name des zu Disassemblierenden Objekts:") ; + getline (object name) ; + changeall(object name, " ", "") ; + putline ("Bitte Gewuenschtes Objekt von vorne an abzaehlen und ESC q druecken.") ; + pause (5) ; + disablestop ; + help (object name) ; + UNTIL NOT iserror PER ; + enablestop ; + page ; + put ("Nummer des Objekts:") ; + get (nth object) ; + code address := code start (object name, nth object) ; + lbas := -1 ; + disass 0 code (code segment, code address, PROC (TEXT CONST) list line) ; + edit (filename + ".0") +ENDPROC disass object ; + +PROC disass module nr : + INT VAR mod nr , code address ; + end address := 0 ; + put ("Filename:") ; + getline (filename) ; + filenumber := 0 ; + page ; + put ("Modulnummer:") ; + get (mod nr) ; + code address := code start (mod nr) ; + lbas := -1 ; + IF code address = -1 + THEN putline ("Unbelegte Modulnummer") + ELSE disass 0 code (code segment, code address, PROC (TEXT CONST) listline) ; + edit (filename + ".0") + FI +ENDPROC disass module nr ; + +PROC disass address : + INT VAR code segment, code address ; + TEXT VAR eingabe ; + put ("Filename:") ; + getline (filename) ; + file number := 0 ; + page ; + put ("Code Segment (2 o. 3):") ; + get (code segment) ; + put ("Startadresse (Hex) :") ; + getline (eingabe) ; + code address := integer (eingabe) ; + put ("Endadresse (Hex) :") ; + getline (eingabe) ; + end address := integer (eingabe) ; + lbas := -1 ; + disass 0 code (code segment, code address, PROC (TEXT CONST) listline) ; + edit (filename + ".0") +ENDPROC disass address ; + +FILE VAR list file ; +TEXT VAR file name ; +INT VAR op data, + file number , + first module line := 200 , + anzahl steuerzeichen, + anzahl zeros, + call data , + long data, + low, + op1, + op 2, + word, + ln := -1, + end address := 0, + high , + data base := 0 ; +BOOL VAR echo, was bool result := FALSE ; +TEXT VAR code words := "" , + segment 2 modules, + segment 2 adresses, + segment 3 modules, + segment 3 adresses; + +TEXT PROC opcode : + TEXT VAR temp := " " ; + word := get word (segment, address) ; + op1 := (word AND 31744) DIV 1024 ; + op2 := (word AND 768) DIV 128 ; + low := word AND 255 ; + ln := -1 ; + replace (temp, 1, address) ; + high := code (temp SUB 2) ; + op data := word AND -31745 ; + long data := (word AND 768) * 2 + (word AND 255) ; + call data := word AND 1023 ; + IF word < 0 + THEN IF word = -3 + THEN LEAVE opcode WITH "Block unlesbar" + ELIF word = -1 + THEN LEAVE opcode WITH "" + ELSE long data INCR 256 ; + op2 INCR 1 ; + call data INCR 1024 + FI + FI ; + IF op1 = 31 AND op2 = 7 + THEN op1 := (word AND 127) DIV 4 ; + op2 := (word AND 3) * 2 ; + low := -1 ; + long data := next word ; + call data := long data ; + op data := long data ; + IF (word AND 128) = 128 THEN op2 INCR 1 FI ; + "LONGA " + opc + ELSE opc + FI . +ENDPROC opcode ; + +TEXT PROC opc : + BOOL CONST previous bool result :: was bool result ; + was bool result := FALSE ; + SELECT op1 OF + CASE 0 : process ln + CASE 1 : process ln long + CASE 2 : "MOV " + two params (6,6) + CASE 3 : "INC1 " + one param (1) + CASE 4 : "DEC1 " + one param (1) + CASE 5 : "INC " + two params (1,1) + CASE 6 : "DEC " + two params (1,1) + CASE 7 : "ADD " + three params (1,1,1) + CASE 8 : "SUB " + three params (1,1,1) + CASE 9 : "CLEAR " + one param (6) + CASE 10 : was bool result := TRUE ; "TEST " + one param (6) + CASE 11 : was bool result := TRUE ; "EQU " + two params (1,1) + CASE 12 : was bool result := TRUE ; "LSEQ " + two params (1,1) + CASE 13 : "FMOV " + two params (2,2) + CASE 14 : "FADD " + three params (2,2,2) + CASE 15 : "FSUB " + three params (2,2,2) + CASE 16 : "FMULT " + three params (2,2,2) + CASE 17 : "FDIV " + three params (2,2,2) + CASE 18 : was bool result := TRUE ; "FLSEQ " + two params (2,2) + CASE 19 : "TMOV " + two params (3,3) + CASE 20 : was bool result := TRUE ; "TEQU " + two params (3,3) + CASE 21 : was bool result := TRUE ; "ULSEQ " + two params (1,1) + CASE 22 : process accds + CASE 23 : "REF " + two params (0,0) + CASE 24 : process subs + CASE 25 : process sel + CASE 26 : "PPV " + one param (0) + CASE 27 : "PP " + one param (0) + CASE 28 : process br + CASE 29 : process brlong + CASE 30 : "CALL " + process module nr (call data, FALSE) + OTHERWISE op 31 + ENDSELECT . + +process ln : + IF previous bool result + THEN "BT " + branch address + ELSE ln := long data ; + "LN " + text (long data) + FI . + +process ln long : + long data INCR 2048 ; + IF previous bool result + THEN "BTLONG " + branch address + ELSE ln := long data ; + "LNLONG " + text (long data) + FI . + +process br : + IF previous bool result + THEN "BF " + branch address + ELSE "BR " + branch address + FI . + +process brlong : + long data INCR 2048 ; + IF previous bool result + THEN "BFLONG " + branch address + ELSE "BRLONG " + branch address + FI . + +process accds : + "ACCDS (DSid:" + hex16 (op data) + denoter (opdata, 8) + ", BOUND-Result:" + + params ("0") . + +process subs : + INT CONST elem len :: long data, limit1 :: next word, index :: next word, + base :: next word, result :: next word ; + "SUBS (Elem.len:" + text (elem len) + ", Limit:" + text (limit1 + 1) + + ", Index:" + hex16 (index) + denoter (index, 1) + ", Base:" + hex16 (base) + + ", Result:" + hex16 (result) + denoter (result, 0) + ")". + +process sel : + INT CONST offset :: next word, result1 :: next word ; + "SEL (Base:" + hex16 (op data) + ", Offset:" + hex16 (offset) + + ", Result:" + hex16 (result1) + denoter (result1, 0) + ")". + +op31 : +SELECT op 2 OF + CASE 0 : was bool result := TRUE ; + "IS (""" + code (low) + """, " + params ("0") (* 7C *) + CASE 1 : "STIM (" + hex8 (low) + ", " + params ("6") (* FC *) + CASE 2 : "MOVX (" + hex8 (low) + ", " + params ("66") (* 7D *) + CASE 3 : "PUTW (" + hex8 (low) + ", " + params ("77") (* FD *) + CASE 4 : "GETW (" + hex8 (low) + ", " + params ("77") (* 7E *) + CASE 5 : data base := ((""0"" + code (low)) ISUB 1) ; + "PENTER (" + hex8 (low) +")" (* FE *) + CASE 6 : "ESC " + esc code (* 7F *) + OTHERWISE"???????" (* FF *) +ENDSELECT . + +ENDPROC opc ; + +TEXT PROC branch address : + INT VAR branch byte := long data DIV 256 ; + branch byte := (branch byte + high) AND 15 + (high AND 240) ; + hex8 (branch byte) + hex8 (long data AND 255) +ENDPROC branch address ; + +INT PROC next word : + arith 16 ; + address INCR 1 ; + arith 15 ; + INT CONST w :: get word (segment, address) ; + codewords CAT hex16 (w) + " " ; + w +ENDPROC next word ; + +TEXT PROC one param (INT CONST type) : + "(" + hex16 (op data) + denoter (op data, type) + ")" +ENDPROC one param ; + +TEXT PROC three params (INT CONST type a, type b, type c) : + INT CONST word b :: next word, word c :: next word ; + "(" + hex16 (op data) + denoter (op data, type a) + ", " + + hex16 (word b) + denoter (word b, type b) + ", " + + hex16 (word c) + denoter (word c, type c) + ")" +ENDPROC three params ; + +TEXT PROC two params (INT CONST type a, type b) : + INT CONST word b :: next word ; + "(" + hex16 (op data) + denoter (op data, type a) + ", " + + hex16 (word b) + denoter (word b, type b) + ")" +ENDPROC two params ; + +TEXT PROC denoter (INT CONST offset, type) : + IF offset < 0 AND lbas = -1 THEN LEAVE denoter WITH " " + ELIF type = 7 THEN LEAVE denoter WITH "" + ELIF type >= 2 AND type <= 5 OR type = 8 THEN + LEAVE denoter WITH " <" + + data object (offset, data base, type) + ">" + FI ; + INT VAR i, byte, word1, word ; + IF offset < 0 + THEN word := get word (local data segment, (offset AND 32767) ADD lbas) + ELSE word := get word (packet data segment, data base ADD offset) + FI ; + TEXT VAR x, t := " <" + hex16 (word) ; + IF address < first elan address + THEN IF word >= begin of stringtable CAND word <= end of nametable + THEN string pointer + ELIF word > 9 AND word < 32 + THEN t CAT ":""""" + text (word) + """""" + ELIF word >= 32 AND word < 127 + THEN t CAT ":""" + code (word) + """" + FI ; + FI ; + IF type = 0 COR type = 6 + THEN BOOL VAR text sinnvoll := FALSE , + real sinnvoll := FALSE , + bool sinnvoll := word = -1 OR word = 0 OR word = 1 ; + IF type = 0 + THEN IF offset < 0 + THEN word1 := get word (local data segment, + lbas ADD (offset AND 32767) ADD 1) + ELSE word1 := get word (packet data segment, + data base ADD offset ADD 1) ; + FI ; + text sinnvoll := keine steuerzeichen AND (word1 AND 255) < 80 ; + real sinnvoll := vorzeichen ok AND nur digits + FI ; + try type + FI ; + t + ">" . + +string pointer : + IF word >= begin of name table + THEN word INCR 2 + FI ; + IF (cdbint (word) AND 255) < 100 + THEN x := cdbtext (word) ; + IF pos (x, ""0"", ""31"", 1) = 0 CAND + pos (x, ""127"", ""213"", 1) = 0 CAND + pos (x, ""220"", code (255), 1) = 0 + THEN t CAT ":""" ; + t CAT x ; + t CAT """" + FI + FI . + +try type : + IF bool sinnvoll + THEN t CAT ":" ; + t CAT data object (offset, data base, 4) + FI ; + IF real sinnvoll + THEN t CAT ":" ; + t CAT x + FI ; + IF text sinnvoll + THEN t CAT ":" ; + t CAT text result + FI . + +keine steuerzeichen : + TEXT VAR text result := data object (offset, data base, 3) ; + anzahl steuerzeichen < 4 AND anzahl zeros < 2 AND word1 <> -1 . + +vorzeichen ok : + (word AND 240) = 0 OR (word AND 240) = 128 . + +nur digits : + IF (word AND 15) > 9 THEN FALSE + ELSE x := data object (offset, data base, 2) ; + FOR i FROM 2 UPTO 7 REP + byte := code (x SUB i) ; + IF (byte AND 240) > 249 OR (byte AND 15) > 9 + THEN LEAVE nur digits WITH FALSE + FI + PER ; + TRUE + FI . + +ENDPROC denoter ; + +TEXT PROC esc code : + SELECT low OF + CASE 0 : "RTN " + CASE 1 : "RTNT " + CASE 2 : "RTNF " + CASE 3 : "REPTXT?" + CASE 4 : "TERM " + CASE 5 : "??????" + CASE 6 : "KE " + CASE 7 : "??????" + CASE 8 : "CRD (" + params ("11") + CASE 9 : "BCRD (" + params ("11") + CASE 10 : "CWR (" + params ("111") + CASE 11 : "ECWR (" + params ("111") + CASE 12 : "CTT (" + params ("01") + CASE 13 : was bool result := TRUE ; "GETC (" + params ("311") + CASE 14 : was bool result := TRUE ; "FNONBL (" + params ("131") + CASE 15 : "DREM256 (" + params ("11") + CASE 16 : "AMUL256 (" + params ("11") + CASE 17 : "??????" + CASE 18 : was bool result := TRUE ; "ISDIG (" + params ("1") + CASE 19 : was bool result := TRUE ; "ISLD (" + params ("1") + CASE 20 : was bool result := TRUE ; "ISLCAS (" + params ("1") + CASE 21 : was bool result := TRUE ; "ISUCAS (" + params ("1") + CASE 22 : "GADDR (" + params ("111") + CASE 23 : was bool result := TRUE ; "GCADDR (" + params ("111") + CASE 24 : was bool result := TRUE ; "ISSHA (" + params ("1") + CASE 25 : "SYSGEN " + CASE 26 : "GETTAB " + CASE 27 : "PUTTAB " + CASE 28 : "ERTAB " + CASE 29 : "EXEC " + process module nr (next word, FALSE) + CASE 30 : "PPROC " + process module nr (next word, FALSE) + CASE 31 : "PCALL (" + params ("1") + CASE 32 : "CASE (" + params ("17") + CASE 33 : "MOVXX (" + params ("700") + CASE 34 : "ALIAS (" + params ("088") + CASE 35 : "MOVIM (" + params ("76") + CASE 36 : was bool result := TRUE ; "FEQU (" + params ("22") + CASE 37 : was bool result := TRUE ; "TLSEQ (" + params ("33") + CASE 38 : "FCOMPL (" + params ("22") + CASE 39 : "COMPL (" + params ("11") + CASE 40 : "IMULT (" + params ("111") + CASE 41 : "MULT (" + params ("111") + CASE 42 : "DIV (" + params ("111") + CASE 43 : "MOD (" + params ("111") + CASE 44 : "ISUB (" + params ("311") + CASE 45 : "replace (" + params ("311") + CASE 46 : "code (" + params ("31") + CASE 47 : "code (" + params ("13") + CASE 48 : "SUB (" + params ("313") + CASE 49 : "subtext (" + params ("3113") + CASE 50 : "subtext (" + params ("313") + CASE 51 : "replace (" + params ("313") + CASE 52 : "CAT (" + params ("33") + CASE 53 : "length (" + params ("31") + CASE 54 : "pos (" + params ("331") + CASE 55 : "pos (" + params ("3311") + CASE 56 : "pos (" + params ("33111") + CASE 57 : "stranalyze (" + params ("1113111") + CASE 58 : "pos (" + params ("33311") + CASE 59 : "??????" + CASE 60 : "out (" + params ("3") + CASE 61 : "cout (" + params ("1") + CASE 62 : "outsubtext (" + params ("31") + CASE 63 : "outsubtext (" + params ("311") + CASE 64 : "inchar (" + params ("3") + CASE 65 : "incharety (" + params ("3") + CASE 66 : "pause (" + params ("1") + CASE 67 : "getcursor (" + params ("11") + CASE 68 : "catinput (" + params ("33") + CASE 69 : "nilspace (" + params ("8") + CASE 70 : ":= DD (" + params ("88") + CASE 71 : "forget (" + params ("8") + CASE 72 : "typeDI (" + params ("81") + CASE 73 : "ItypeD (" + params ("81") + CASE 74 : "heapsize (" + params ("81") + CASE 75 : "enablestop " + CASE 76 : "disablestop " + CASE 77 : "seterrorstop (" + params ("1") + CASE 78 : was bool result := TRUE ; "iserror " + CASE 79 : "clearerror " + CASE 80 : "IpcbI (" + params ("11") + CASE 81 : "pcbII (" + params ("11") + CASE 82 : "setclock (" + params ("52") + CASE 83 : "??????" + CASE 84 : "control (" + params ("1111") + CASE 85 : "blockout (" + params ("81111") + CASE 86 : "blockin (" + params ("81111") + CASE 87 : "nextdspage (" + params ("811") + CASE 88 : "IpagesDT (" + params ("851") + CASE 89 : "storage (" + params ("11") + CASE 90 : "sysop (" + params ("1") + CASE 91 : "ARITH15 " + CASE 92 : "ARITH16 " + CASE 93 : "heapsize (" + params ("1") + CASE 94 : "collectheapgarbage " + CASE 95 : "??????" + CASE 96 : "FSLD (" + params ("121") + CASE 97 : "GEXP (" + params ("21") + CASE 98 : "SEXP (" + params ("12") + CASE 99 : "floor (" + params ("22") + CASE 100: "RSUB (" + params ("312") + CASE 101: "replace (" + params ("312") + CASE 102: "clock (" + params ("12") + CASE 103: "setclock (" + params ("2") + CASE 104: "pcb (" + params ("511") + CASE 105: "pcb (" + params ("511") + CASE 106: "clock (" + params ("52") + CASE 107: "status (" + params ("51") + CASE 108: "unblock (" + params ("5") + CASE 109: "block (" + params ("5") + CASE 110: "haltprocess (" + params ("5") + CASE 111: "createprocess (" + params ("55") + CASE 112: "eraseprocess (" + params ("5") + CASE 113: "send (" + params ("5181") + CASE 114: "wait (" + params ("518") + CASE 115: "call (" + params ("5181") + CASE 116: "cdbint (" + params ("11") + CASE 117: "cdbtext (" + params ("13") + CASE 118: "nextactive (" + params ("1") + CASE 119: "PW (" + params ("111") + CASE 120: "GW (" + params ("111") + CASE 121: "XOR (" + params ("111") + CASE 122: "pingpong (" + params ("5181") + CASE 123: was bool result := TRUE ; "exists (" + params ("5") + CASE 124: "AND (" + params ("111") + CASE 125: "OR (" + params ("111") + CASE 126: "session (" + params ("1") + CASE 127: "send (" + params ("55181") + CASE 128: "definecollector (" + params ("5") + CASE 129: "id (" + params ("11") + OTHERWISE "??????" + ENDSELECT . + +ENDPROC esc code ; + +TEXT PROC params (TEXT CONST types) : + INT VAR i , word ; + TEXT VAR t := "" ; + FOR i FROM 1 UPTO LENGTH types REP + word := next word ; + t CAT hex16 (word) ; + t CAT denoter (word, int (types SUB i)) ; + IF i <> LENGTH types THEN t CAT ", " FI + PER ; + t + ") " . + +ENDPROC params ; + +PROC init module tables : + INT VAR i, j ; + TEXT VAR t := " " ; + segment 2 modules := "" ; + segment 2 adresses := ""0"" ; + segment 3 modules := "" ; + segment 3 adresses := ""0"" ; + i := -1 ; + REP + i INCR 1 ; + cout (i) ; + j := getword (0, i + 512) ; + IF j <> -1 CAND i <> 216 CAND i <> 217 + THEN replace (t, 1, i) ; + segment 2 modules CAT t ; + replace (t, 1, j) ; + segment 2 adresses CAT t + ""0"" + ELIF i < 256 + THEN i := 255 + ELIF i < 320 + THEN i := 319 + FI + UNTIL j = -1 CAND i > 320 PER ; + FOR i FROM 1280 UPTO 2047 REP + cout (i) ; + j := getword (0, i + 512) ; + IF j <> -1 + THEN replace (t, 1, i) ; + segment 3 modules CAT t ; + replace (t, 1, j) ; + segment 3 adresses CAT t + ""0"" + FI + UNTIL j = -1 PER +ENDPROC init module tables ; + +TEXT PROC process module nr (INT CONST module number, BOOL CONST is packet) : + TEXT VAR object specification , mod nr := text (module number, 5) ; + IF module number < 0 + THEN IF lbas = -1 + THEN "LOCAL PROC" + ELSE "LOCAL:" + process module nr (getword (local data segment, lbas + (module number AND 32767)), is packet) + FI + ELSE + INT VAR code address := code start (module number) ; + IF one of compilers own module numbers + THEN object specification := "CDL" + ELIF elan defined internal + THEN SELECT module number OF + CASE 256 : object specification := "compiler (INT CONST, FILE VAR, TEXT CONST, INT VAR, BOOL CONST, BOOL CONST, BOOL CONST, BOOL CONST, BOOL CONST, BOOL CONST, BOOL CONST, BOOL CONST)" + CASE 257 : object specification := "outtext (TEXT CONST, INT CONST)" + CASE 258 : object specification := "outline (INT CONST)" + CASE 259 : object specification := "syntaxerror (TEXT CONST)" + CASE 260 : object specification := ":= (FILE VAR, FILE CONST)" + ENDSELECT + ELIF exists sorted module number table + THEN object specification := binary search (module number, is packet) + ELIF exists unsorted module number table + THEN FILE VAR f := sequentialfile (modify, "table.hash") ; + to firstrecord (f) ; + WHILE NOT eof (f) CAND subtext (f, 33, 37) <> mod nr REP + cout (lineno (f)) ; + down (f) + PER ; + IF eof (f) AND subtext (f, 33, 37) <> mod nr THEN + IF is packet + THEN object specification := "Paketinitialisierung" + ELSE object specification := "Hidden PROC/OP" + FI + ELSE object specification := compress (subtext (f, 1, 15)) + + specifications (begin of permanent table + int (subtext (f, 22, 25))) + FI + ELIF no elan module number + THEN object specification := "Objekt ohne Modulnummer!" + FI ; + was bool result := pos (object specification , "--> BOOL") <> 0 ; + text (module number) + " $" + hex8 (code segment) + + hex16 (code address) + " " + object specification + FI . + +one of compilers own module numbers : + module number < 256 . + +elan defined internal : + module number > 255 AND module number < 261 . + +exists sorted module number table : + exists ("table.module") AND module number > 319 . + +exists unsorted module number table: + exists ("table.hash") AND module number > 319 . + +no elan module number : + module number < 320 . + +ENDPROC process module nr ; + +TEXT PROC binary search (INT CONST nr, BOOL CONST is packet) : + TEXT VAR record , text nr := text (nr, 5) ; + INT VAR first line, last line , mid , i ; + FILE VAR f := sequentialfile (modify, "table.module") ; + first line := first module line ; + last line := lines (f) ; + REP + mid := (first line + last line) DIV 2 ; + to line (f, mid) ; + IF text nr > subtext (f, 33, 37) THEN first line := mid + 1 + ELSE last line := mid + FI + UNTIL first line = last line PER ; + to line (f, first line) ; + IF subtext (f, 33, 37) = text nr + THEN record := compress (subtext (f, 1, 15)) + + specifications (begin of permanent table + int (subtext (f, 22, 25))) + ELSE is hidden module + FI ; + record . + +is hidden module: + IF NOT is packet + THEN to line (f, first line - 1) + FI ; + FOR i FROM int (subtext (f, 22, 25)) + begin of permanent table DOWNTO begin of permanent table + WHILE cdbint (i) <> -2 REP PER ; + IF i <= begin of permanent table + THEN IF is packet + THEN record := "Paketinitialisierung" + ELSE record := "Hidden PROC/OP" + FI + ELSE IF is packet + THEN record := "Paketinitialisierung: " + + cdbtext (cdbint (i + 1) + 2) + ELSE record := "Hidden PROC/OP (Packet " + + cdbtext (cdbint (i + 1) + 2) + ")" + FI + FI . + +ENDPROC binary search ; + +TEXT PROC data object (INT CONST address, data base, denoter type) : + TEXT VAR t , result ; + INT VAR i , laenge , zeichen, index, version, segment, new address ; + IF address < 0 AND lbas = -1 + THEN LEAVE data object WITH "LOCAL" + ELIF address < 0 + THEN segment := local data segment ; + new address := (address AND 32767) ADD lbas + ELSE segment := packet data segment ; + new address := data base ADD address + FI ; + SELECT denoter type OF + CASE 1 : int denoter + CASE 2 : real denoter + CASE 3 : text denoter + CASE 4 : bool denoter + CASE 5 : task denoter + CASE 8 : dataspace denoter + OTHERWISE "DENOTERTYPE(" + text (denoter type) + ")?" + ENDSELECT . + +bool denoter : + IF get word (segment, new address) = 0 + THEN "TRUE" + ELSE "FALSE" + FI . + +int denoter : + hex16 (get word (segment, new address)) . + +real denoter : + t := "12345678" ; + FOR i FROM 0 UPTO 3 REP + replace (t, i + 1, get word (segment, new address ADD i)) + PER ; + disablestop ; + t := text (t RSUB 1) ; + IF iserror THEN clearerror ; + enablestop ; + "9.999999999999e126" + ELSE enablestop ; + t + FI . + +text denoter : + t := copied text var (segment, new address) ; + result := "" ; + anzahl steuerzeichen := 0 ; + anzahl zeros := 0 ; + FOR i FROM 1 UPTO length (t) REP + zeichen := code (t SUB i) ; + IF zeichen = 34 THEN result CAT """""" + ELIF zeichen = 251 OR zeichen > 31 AND zeichen < 127 OR + zeichen > 213 AND zeichen < 224 THEN result CAT code (zeichen) + ELSE result CAT """" ; + result CAT text (zeichen) ; + result CAT """" ; + anzahl steuerzeichen INCR 1 ; + IF zeichen = 0 + THEN anzahl zeros INCR 1 + FI + FI + PER ; + """" + result + """" . + +task denoter : + index := get word (segment, new address) ; + version := get word (segment, new address ADD 1) ; + hex16 (index) + " " + hex16 (version) + ":" + taskname (index, version) . + +dataspace denoter : + result := " " ; + replace (result, 1, get word (segment, new address)) ; + TEXT CONST two bytes :: hex8 (code (result SUB 2)) + " " + + hex8 (code (result SUB 1)) ; + IF result = ""255""255"" + THEN two bytes + ":Not Init" + ELIF result = ""0""0"" + THEN two bytes + ":nilspace" + ELSE two bytes + ":" + taskname (code (result SUB 2), -1) + FI . +ENDPROC data object ; + +TEXT PROC copied text var (INT CONST segment, address) : + TEXT VAR result ; + INT VAR i, laenge ; + result := " " ; + replace (result, 1, getword (segment, address ADD 1)) ; + laenge := code (result SUB 1) ; + IF laenge = 0 + THEN "" + ELIF laenge = 255 + THEN INT CONST basis :: -32765 ADD (getword (segment, address)-3) DIV 2 ; + laenge := ((result SUB 2) + code ((getword (segment, address + ADD 2) AND 255))) ISUB 1 ; + result := "" ; + FOR i FROM 1 UPTO laenge DIV 2 REP + result CAT " " ; + replace (result, i, getword (1, basis + i -1)) + PER ; + IF LENGTH result <> laenge + THEN result CAT code (getword (1, basis + laenge DIV 2)) + FI ; + result + ELSE TEXT CONST first char :: result SUB 2 ; + result := "" ; + FOR i FROM 1 UPTO (laenge-1) DIV 2 REP + result CAT " " ; + replace (result, i, getword (segment, address ADD (i + 1))) ; + PER ; + IF LENGTH result + 1 <> laenge + THEN first char + result + code (getword (segment, address ADD + ((laenge-1) DIV 2 + 2)) AND 255) + ELSE first char + result + FI + FI +ENDPROC copied text var ; + +TEXT PROC task name (INT CONST id, vers) : + TEXT VAR result ; + DATASPACE VAR ds := nilspace ; + BOUND STRUCT (INT index, version) VAR t1 := ds ; + BOUND TASK VAR t2 := ds ; + IF id = 0 + THEN result := "niltask" + ELSE t1.index := id AND 255 ; + IF vers = -1 + THEN t1.version := 0 ; + t1.version := pcb (t2, 10) + ELSE t1.version := vers + FI ; + disablestop ; + IF exists (t2) + THEN result := """" + name (t2) + """" + ELSE result := "-" + FI ; + FI ; + forget (ds) ; + enable stop ; + result +ENDPROC task name ; + +INT PROC integer (TEXT CONST hex addr) : + INT VAR i ; + REAL VAR summe := 0.0 ; + FOR i FROM 1 UPTO length (hex addr) REP + summe := summe * 16.0 ; + summe INCR real (digit) + PER ; + IF summe > 32767.0 THEN int (summe - 65536.0) + ELSE int (summe) + FI. + +digit : + TEXT CONST char := hex addr SUB i ; + IF char >= "a" THEN code (char) - 87 + ELIF char >= "A" THEN code (char) - 55 + ELSE code (char) - 48 + FI +ENDPROC integer ; + +TEXT PROC hex8 (INT CONST wert) : + hex digit (wert DIV 16) + + hex digit (wert AND 15) +ENDPROC hex8 ; + +TEXT PROC hex16 (INT CONST wert) : + TEXT VAR t := " " ; + replace (t, 1, wert) ; + hex digit (code (t SUB 2) DIV 16) + + hex digit (code (t SUB 2) AND 15) + + hex digit (code (t SUB 1) DIV 16) + + hex digit (code (t SUB 1) AND 15) +ENDPROC hex16 ; + +TEXT PROC hex digit (INT CONST wert) : + IF wert < 10 THEN code (wert + 48) + ELSE code (wert + 55) + FI +ENDPROC hex digit ; + +INT OP ADD (INT CONST left, right) : + arith 16 ; + INT CONST result :: left + right ; + arith 15 ; + result +ENDOP ADD ; + +PROC disass0 : +TEXT VAR key ; +IF exists ("table.module") + THEN FILE VAR f := sequentialfile (modify, "table.module") ; + tofirstrecord (f) ; + down (f, " 322 ") ; + first module line := lineno (f) ; +FI ; +REP + page ; + putline ("++++++++++++++++++++++++ EUMEL0 - Code Disassembler ++++++++++++++++++++") ; + line (3) ; + putline (" 0 ......... Ende") ; + putline (" 1 ......... Objekt nach Name auswaehlen und disassemblieren") ; + putline (" 2 ......... Nach Modulnummer auswaehlen und disassemblieren") ; + putline (" 3 ......... Adressbereich disassemblieren") ; + putline (" 4 ......... Denoter aus Staticarea (Segment 0) ausgeben") ; + putline (" 5 ......... Codestart zur Modulnummer errechnen") ; + putline (" 6 ......... Modultabelle ergaenzen") ; + line ; + put ("Wahl:") ; + REP inchar (key) UNTIL key >= "0" AND key <= "6" PER ; + out (key) ; + line (2) ; + SELECT int (key) OF + CASE 0 : LEAVE disass 0 + CASE 1 : disass object + CASE 2 : disass module nr + CASE 3 : disass address + CASE 4 : put denoter + CASE 5 : convert module number + CASE 6 : erweitere modul tabelle + ENDSELECT +PER . + +erweitere modul tabelle : + INT VAR i, j ; + key := " " ; + FOR i FROM LENGTH segment 3 modules DIV 2 + 1280 UPTO 2047 REP + cout (i) ; + j := get word (0, 512 + i) ; + IF j <> -1 + THEN replace (key, 1, i) ; + segment 3 modules CAT key ; + replace (key, 1, j) ; + segment 3 adresses CAT key + ""0"" ; + FI + UNTIL j = -1 PER. + +convert module number : + line (2) ; + INT VAR mod nr ; + put ("Modulnummer:") ; + get (mod nr) ; + mod nr := code start (mod nr) ; + IF mod nr = -1 + THEN putline ("Unbelegte Modulnummer") + ELSE put ("Adresse:") ; put (hex16 (mod nr)) ; line ; + put ("Segment:") ; put (code segment) ; line + FI ; + putline ("- Taste -") ; + pause. + +put denoter : + line (2) ; + put ("PENTER(xx) in Hex:") ; + getline (key) ; + INT VAR base :: integer (key), typ ; + put ("Offset in Hex:") ; + getline (key) ; + typ := integer (key) ; + put ("TYPE (INT, REAL, TEXT, BOOL, TASK, DATASPACE):") ; + getline (key) ; + IF key = "INT" THEN typ := 1 + ELIF key = "REAL" THEN typ := 2 + ELIF key = "TEXT" THEN typ := 3 + ELIF key = "BOOL" THEN typ := 4 + ELIF key = "TASK" THEN typ := 5 + ELIF key = "DATASPACE" THEN typ := 8 + ELSE typ := 0 + FI ; + lbas := -1 ; + putline (data object (typ, (""0"" + code (base)) ISUB 1, typ)) ; + putline ("- Taste -") ; + pause . + +ENDPROC disass 0 ; + +init module tables ; +disass 0 + +ENDPACKET eumel 0 code disassembler ; diff --git a/devel/misc/unknown/src/ASSEMBLE.ELA b/devel/misc/unknown/src/ASSEMBLE.ELA new file mode 100644 index 0000000..7675dc4 --- /dev/null +++ b/devel/misc/unknown/src/ASSEMBLE.ELA @@ -0,0 +1,387 @@ +(***Assembler fuer 8080,8085,Z80***) + +PROC regh: + IF pos(in,"A",4) = (pos(in,",")+1) THEN out(printer,"F"); +ELIF pos(in,"B",4) = (pos(in,",")+1) THEN out(printer,"8"); +ELIF pos(in,"C",4) = (pos(in,",")+1) THEN out(printer,"9"); +ELIF pos(in,"D",4) = (pos(in,",")+1) THEN out(printer,"A"); +ELIF pos(in,"E",4) = (pos(in,",")+1) THEN out(printer,"B"); +ELIF pos(in,"H",4) = (pos(in,",")+1) THEN out(printer,"C"); +ELIF pos(in,"L",4) = (pos(in,",")+1) THEN out(printer,"D"); +ELIF pos(in,"M",4) = (pos(in,",")+1) OR pos(in,"m") = (pos(in,",")+1) + THEN out(printer,"E") FI +ENDPROC regh. + +PROC regl: + IF pos(in,"A",4) > (pos(in,",")+0) THEN out(printer,"7"); +ELIF pos(in,"B",4) > (pos(in,",")+0) THEN out(printer,"0"); +ELIF pos(in,"C",4) > (pos(in,",")+0) THEN out(printer,"1"); +ELIF pos(in,"D",4) > (pos(in,",")+0) THEN out(printer,"2"); +ELIF pos(in,"E",4) > (pos(in,",")+0) THEN out(printer,"3"); +ELIF pos(in,"H",4) > (pos(in,",")+0) THEN out(printer,"4"); +ELIF pos(in,"L",4) > (pos(in,",")+0) THEN out(printer,"5"); +ELIF pos(in,"M",4) > (pos(in,",")+0) OR pos(in,"m") > (pos(in,",")+0) + THEN out(printer,"6") FI +ENDPROC regl. + (*************************) + (*Autor:M.Staubermann *) +BOOL VAR ad,number,falsch; (*Version:1.2.2 *) +ad:=FALSE; (*Datum:7.12.82 *) +number:=FALSE; (*************************) +falsch:=FALSE; +INT VAR count,fehler; +TEXT VAR hilf,in,startaddresse::"0000"; +hilf:=" "; +count:=0; +fehler:=0; +hilf:=" "; +commanddialogue(FALSE); +forget("maschinencode"); +FILE VAR printer:=sequentialfile(output,"maschinencode"); +forget("assemb"); +FILE VAR ass:=sequentialfile(modify,"assemb"); +forget("errors"); +FILE VAR fehlerliste:=sequentialfile(output,"errors"); +commanddialogue(TRUE); +line; +putline(" gib assembler kommando :"); +putline(" edit"); +pause(10); +edit("assemb"); +tofirstrecord(ass); +putline(" gib assembler kommando :"); +putline(" debug"); +pause(10); +line; +put (" "); +put(printer,"Line: Add: Code:"); +line(printer); +hexbeginn; + + REPEAT + fehler:=fehler+1; + out(printer,text(fehler,4)); + cout(fehler); + out(printer," "); + hex; + readrecord(ass,in); + forward(ass); + out(printer," "); + IF pos(in,"NOP") > 0 THEN out(printer,"00"); +ELIF pos(in,"HLT") > 0 THEN out(printer,"76"); +ELIF compress(in)="DI" THEN out(printer,"F3"); +ELIF pos(in,"EI") > 0 THEN out(printer,"FB"); +ELIF pos(in,"CMC") > 0 THEN out(printer,"3F"); +ELIF pos(in,"CMA") > 0 THEN out(printer,"2F"); +ELIF pos(in,"STC") > 0 THEN out(printer,"37"); +ELIF pos(in,"DAA") > 0 THEN out(printer,"27"); +ELIF pos(in,"RRC") > 0 THEN out(printer,"0F"); +ELIF pos(in,"RLC") > 0 THEN out(printer,"07"); +ELIF pos(in,"RAL") > 0 THEN out(printer,"17"); +ELIF pos(in,"RAR") > 0 THEN out(printer,"1F"); +ELIF pos(in,"XCHG")> 0 THEN out(printer,"EB"); +ELIF pos(in,"XTHL")> 0 THEN out(printer,"E3"); +ELIF pos(in,"SPHL")> 0 THEN out(printer,"F9"); +ELIF pos(in,"ADI") > 0 THEN out(printer,"C6");number:=TRUE; +ELIF pos(in,"ACI") > 0 THEN out(printer,"CE");number:=TRUE; +ELIF pos(in,"SUI") > 0 THEN out(printer,"D6");number:=TRUE; +ELIF pos(in,"SBI") > 0 THEN out(printer,"DE");number:=TRUE; +ELIF pos(in,"ANI") > 0 THEN out(printer,"E6");number:=TRUE; +ELIF pos(in,"XRI") > 0 THEN out(printer,"EE");number:=TRUE; +ELIF pos(in,"ORI") > 0 THEN out(printer,"F6");number:=TRUE; +ELIF pos(in,"CPI") > 0 THEN out(printer,"FE");number:=TRUE; +ELIF compress(in)="STA"THEN out(printer,"32");ad:=TRUE; +ELIF compress(in)="LDA"THEN out(printer,"3A");ad:=TRUE; +ELIF pos(in,"SHLD")> 0 THEN out(printer,"22");ad:=TRUE; +ELIF pos(in,"LHLD")> 0 THEN out(printer,"2A");ad:=TRUE; +ELIF pos(in,"PCHL")> 0 THEN out(printer,"E9"); +ELIF pos(in,"JMP") > 0 THEN out(printer,"C3");ad:=TRUE; +ELIF pos(in,"JC") > 0 THEN out(printer,"DA");ad:=TRUE; +ELIF pos(in,"JNC") > 0 THEN out(printer,"D2");ad:=TRUE; +ELIF pos(in,"JZ") > 0 THEN out(printer,"CA");ad:=TRUE; +ELIF pos(in,"JNZ") > 0 THEN out(printer,"C2");ad:=TRUE; +ELIF compress(in)="JM" THEN out(printer,"FA");ad:=TRUE; +ELIF compress(in)="JP" THEN out(printer,"F2");ad:=TRUE; +ELIF pos(in,"JPE") > 0 THEN out(printer,"EA");ad:=TRUE; +ELIF pos(in,"JPO") > 0 THEN out(printer,"E2");ad:=TRUE; +ELIF pos(in,"CALL")> 0 THEN out(printer,"CD");ad:=TRUE; +ELIF pos(in,"OUT") > 0 THEN out(printer,"D3");number:=TRUE; +ELIF pos(in,"CC") > 0 THEN out(printer,"DC");ad:=TRUE; +ELIF pos(in,"CNC") > 0 THEN out(printer,"D4");ad:=TRUE; +ELIF pos(in,"CZ") > 0 THEN out(printer,"CC");ad:=TRUE; +ELIF pos(in,"CNZ") > 0 THEN out(printer,"C4");ad:=TRUE; +ELIF pos(in,"CM") > 0 THEN out(printer,"FC");ad:=TRUE; +ELIF compress(in)="CP" THEN out(printer,"F4");ad:=TRUE; +ELIF pos(in,"CPE") > 0 THEN out(printer,"EC");ad:=TRUE; +ELIF pos(in,"CPO") > 0 THEN out(printer,"E4");ad:=TRUE; +ELIF pos(in,"RET") > 0 THEN out(printer,"C9"); +ELIF pos(in,"RC") > 0 THEN out(printer,"D8"); +ELIF pos(in,"RNC") > 0 THEN out(printer,"D0"); +ELIF pos(in,"RZ") > 0 THEN out(printer,"C8"); +ELIF pos(in,"RNZ") > 0 THEN out(printer,"C0"); +ELIF pos(in,"RM") > 0 THEN out(printer,"F8"); +ELIF compress(in)="RP" THEN out(printer,"F0"); +ELIF pos(in,"RPE") > 0 THEN out(printer,"E8"); +ELIF pos(in,"RPO") > 0 THEN out(printer,"E0"); +ELIF pos(in,"RST") > 0 AND pos(in,"0") > 3 THEN out(printer,"C7"); +ELIF pos(in,"RST") > 0 AND pos(in,"1") > 3 THEN out(printer,"CF"); +ELIF pos(in,"RST") > 0 AND pos(in,"2") > 3 THEN out(printer,"D7"); +ELIF pos(in,"RST") > 0 AND pos(in,"3") > 3 THEN out(printer,"DF"); +ELIF pos(in,"RST") > 0 AND pos(in,"4") > 3 THEN out(printer,"E7"); +ELIF pos(in,"RST") > 0 AND pos(in,"5") > 3 THEN out(printer,"EF"); +ELIF pos(in,"RST") > 0 AND pos(in,"6") > 3 THEN out(printer,"F7"); +ELIF pos(in,"RST") > 0 AND pos(in,"7") > 3 THEN out(printer,"FF"); +ELIF pos(in,"MOV") > 0 THEN + IF pos(in,"A") = (pos(in,",")-1) THEN out(printer,"7");regh; + ELIF pos(in,"B") = (pos(in,",")-1) THEN out(printer,"4");regl; + ELIF pos(in,"C") = (pos(in,",")-1) THEN out(printer,"4");regh; + ELIF pos(in,"D") = (pos(in,",")-1) THEN out(printer,"5");regl; + ELIF pos(in,"E") = (pos(in,",")-1) THEN out(printer,"5");regh; + ELIF pos(in,"H") = (pos(in,",")-1) THEN out(printer,"6");regl; + ELIF pos(in,"L") = (pos(in,",")-1) THEN out(printer,"6");regh; + ELIF pos(in,"M",4) = (pos(in,",")-1) OR pos(in,"m") = (pos(in,",")-1) + THEN out(printer,"4");regl FI; +ELIF pos(in,"MVI") > 0 THEN + IF pos(in,"A") = (pos(in,",")-1) THEN out(printer,"3E"); + ELIF pos(in,"B") = (pos(in,",")-1) THEN out(printer,"06"); + ELIF pos(in,"C") = (pos(in,",")-1) THEN out(printer,"0E"); + ELIF pos(in,"D") = (pos(in,",")-1) THEN out(printer,"16"); + ELIF pos(in,"E") = (pos(in,",")-1) THEN out(printer,"1E"); + ELIF pos(in,"H") = (pos(in,",")-1) THEN out(printer,"26"); + ELIF pos(in,"L") = (pos(in,",")-1) THEN out(printer,"2E"); + ELIF pos(in,"M",4) = (pos(in,",")-1) OR pos(in,"m") = (pos(in,",")-1) + THEN out(printer,"36") FI; +ELIF pos(in,"LXI") > 0 THEN ad:=TRUE; + IF pos(in,"B") > 4 THEN out(printer,"01");ad:=TRUE; + ELIF pos(in,"D") > 4 THEN out(printer,"11");ad:=TRUE; + ELIF pos(in,"H") > 4 THEN out(printer,"21");ad:=TRUE; + ELIF pos(in,"SP")> 4 THEN out(printer,"31");ad:=TRUE FI; +ELIF pos(in,"PUSH") > 0 THEN + IF pos(in,"B") > 4 THEN out(printer,"C5"); + ELIF pos(in,"D") > 4 THEN out(printer,"D5"); + ELIF pos(in,"H",5) > 4 THEN out(printer,"E5"); + ELIF pos(in,"A") > 4 OR pos(in,"PSW")> 4 THEN out(printer,"F5") FI; + ELIF pos(in,"POP") > 0 THEN + IF pos(in,"B") > 4 THEN out(printer,"C1"); + ELIF pos(in,"D") > 4 THEN out(printer,"D1"); + ELIF pos(in,"H") > 4 THEN out(printer,"E1"); + ELIF pos(in,"A") > 4 OR pos(in,"PSW")> 4 THEN out(printer,"F1") FI; +ELIF pos(in,"LDAX") > 0 THEN + IF pos(in,"B") > 4 THEN out(printer,"0A"); + ELIF pos(in,"D",5) > 4 THEN out(printer,"1A") FI; +ELIF pos(in,"STAX") > 0 THEN + IF pos(in,"B") > 4 THEN out(printer,"02"); + ELIF pos(in,"D") > 4 THEN out(printer,"12") FI; +ELIF pos(in,"INX") > 0 THEN + IF pos(in,"B") > 4 THEN out(printer,"03"); + ELIF pos(in,"D") > 4 THEN out(printer,"13"); + ELIF pos(in,"H") > 4 THEN out(printer,"2A"); + ELIF pos(in,"SP")> 4 THEN out(printer,"3A") FI; +ELIF pos(in,"DCX") > 0 THEN + IF pos(in,"B") > 4 THEN out(printer,"0B"); + ELIF pos(in,"D",4)>4 THEN out(printer,"1B"); + ELIF pos(in,"H") > 4 THEN out(printer,"2B"); + ELIF pos(in,"SP")> 4 THEN out(printer,"3B") FI; +ELIF pos(in,"DAD") > 0 THEN + IF pos(in,"B") > 4 THEN out(printer,"09"); + ELIF pos(in,"D",4)>4 THEN out(printer,"19"); + ELIF pos(in,"H") > 4 THEN out(printer,"29"); + ELIF pos(in,"SP")> 4 THEN out(printer,"39") FI; +ELIF pos(in,"ADD") > 0 THEN out(printer,"8");regl; +ELIF pos(in,"ADC") > 0 THEN out(printer,"8");regl; +ELIF pos(in,"SUB") > 0 THEN out(printer,"9");regl; +ELIF pos(in,"SBB") > 0 THEN out(printer,"9");regl; +ELIF pos(in,"ANA") > 0 THEN out(printer,"A");regl; +ELIF pos(in,"XRA") > 0 THEN out(printer,"A");regl; +ELIF pos(in,"ORA") > 0 THEN out(printer,"B");regl; +ELIF pos(in,"CMP") > 0 THEN out(printer,"B");regl; +ELIF pos(in,"INR") > 0 THEN + IFpos(in,"A") > 4 THEN out(printer,"3C") FI; +ELIF pos(in,"INR") > 0 THEN + IFpos(in,"B") > 4 THEN out(printer,"04") FI; +ELIF pos(in,"INR") > 0 THEN + IFpos(in,"C") > 4 THEN out(printer,"0C") FI; +ELIF pos(in,"INR") > 0 THEN + IFpos(in,"D") > 4 THEN out(printer,"14") FI; +ELIF pos(in,"INR") > 0 THEN + IFpos(in,"E") > 4 THEN out(printer,"1C") FI; +ELIF pos(in,"INR") > 0 THEN + IFpos(in,"H") > 4 THEN out(printer,"24") FI; +ELIF pos(in,"INR") > 0 THEN + IFpos(in,"L") > 4 THEN out(printer,"2C") FI; +ELIF pos(in,"INR") > 0 THEN + IFpos(in,"M") > 4 OR pos(in,"m") > 4 THEN out(printer,"34") FI; +ELIF pos(in, "IN") > 0 THEN out(printer,"DB"); number:=TRUE; +ELIF pos(in,"DCR") > 0 THEN + IFpos(in,"A") > 4 THEN out(printer,"3D") FI; +ELIF pos(in,"DCR") > 0 THEN + IFpos(in,"B") > 4 THEN out(printer,"05") FI; +ELIF pos(in,"DCR") > 0 THEN + IFpos(in,"C",4) > 4 THEN out(printer,"0D") FI; +ELIF pos(in,"DCR") > 0 THEN + IFpos(in,"D",4) > 4 THEN out(printer,"15") FI; +ELIF pos(in,"DCR") > 0 THEN + IFpos(in,"E") > 4 THEN out(printer,"1D") FI; +ELIF pos(in,"DCR") > 0 THEN + IFpos(in,"H") > 4 THEN out(printer,"25") FI; +ELIF pos(in,"DCR") > 0 THEN + IFpos(in,"L") > 4 THEN out(printer,"2D") FI; +ELIF pos(in,"DCR") > 0 THEN + IFpos(in,"M") > 4 OR pos(in,"m") > 4 THEN out(printer,"35") FI; +ELIF pos(in,"ORG") > 0 THEN hilf:=compress(subtext(in,4,7)); + putline(printer,hilf); + startaddresse:=hilf; + hexbeginn; +ELIF pos(in,"TITL") > 0 THEN putline(printer,subtext(in,6)); +ELIF pos(in,"#") > 0 THEN hilf:=subtext(in,pos(in,"#")+1); + out(printer,hilf) ; +ELSE putline("Fehler erkannt in Zeile "+text(fehler)+" bei '"+in+"' !"); + out(printer,in); + putline(fehlerliste,"Fehler in Zeile "+text(fehler)+" bei: "+in); + count:=count+1; + falsch:=TRUE +FI; +line(printer); +IF ad THEN ad:=FALSE; + fehler:=fehler+1; + out(printer,text(fehler,4)); + cout(fehler); + out(printer," "); + hex; + out(printer," "); + IF pos(in,",") > 3 THEN hilf:=subtext(in,(pos(in,",")+1),(pos(in,",")+4)); + fehler:=fehler+1; + out(printer,text(fehler,4)); + cout(fehler); + out(printer," "); + hex; + out(printer," "); + line(printer) + ELSE hilf:=compress(subtext(in,10,15)) FI; + fehler:=fehler+1; + out(printer,text(fehler,4)); + cout(fehler); + out(printer," "); + hex; + out(printer," "); + out(printer,subtext(hilf,3,4)); + fehler:=fehler+1; + out(printer,text(fehler,4)); + cout(fehler); + out(printer," "); + hex; + out(printer," "); + out(printer,subtext(hilf,1,2)); + line(printer); + +ELIF number THEN number:=FALSE; + fehler:=fehler+1; + out(printer,text(fehler,4)); + cout(fehler); + out(printer," "); + hex; + out(printer," "); + IF pos(in,",") > 2 THEN hilf:= subtext(in, + (pos(in,",") +1),(pos(in,",")+2)); + out(printer,hilf); + line(printer) + ELSE out(printer,compress(subtext(in,14,21))); + line(printer) FI +FI ; + +UNTIL compress(in) = "END" OR compress(in) = "end" OR eof(ass) ENDREPEAT; + + IF count<> 0 THEN putline(text(count)+" Fehler erkannt."); + falsch:=TRUE +ELSE putline(" Keine Fehler, "+text(fehler)+" Zeilen.") ; + falsch:=FALSE +FI; +putline(8*" "+7*"*"+" ENDE DER UEBERSETZUNG "+7*"*"+8*" "); +pause(20); +IF falsch THEN edit("errors","assemb") ELSE +edit("maschinencode") FI; +IF yes("Maschinencodelisting") THEN print("maschinencode") FI; +IF yes("runagain") THEN runagain FI. + +hexbeginn: +(*Hexadezimalzaehler*) +INT VAR a1,a2,a3,a4,subi; +TEXT VAR a1t,a2t,a3t,a4t,subt,counter; +a1t:=subtext(startaddresse,1,1); +a2t:=subtext(startaddresse,2,2); +a3t:=subtext(startaddresse,3,3); +a4t:=subtext(startaddresse,4,4). + +hex: +subt:=a1t; +decoder; +a1:=subi; + +subt:=a2t; +decoder; +a2:=subi; + +subt:=a3t; +decoder; +a3:=subi; + + +decoder; +a4:=subi; + +zaehl; + +IF a4 = 16 THEN a4:=0; + a3:=a3+1 FI; + +IF a3 = 16 THEN a3:=0; + a2:=a2+1 FI; + +IF a2 = 16 THEN a2:=0; + a1:=a1+1 FI; + +IF a1 = 16 THEN a1:=0; + put(printer,"Storageoverflow !") FI; + +subi:=a1; +encode; +a1t:=subt; + +subi:=a2; +encode; +a2t:=subt; + +subi:=a3; +encode; +a3t:=subt; + +subi:=a4; +encode; +a4t:=subt; + +counter:=a1t; +counter CAT a2t; +counter CAT a3t; +counter CAT a4t; +put(printer,counter). + +zaehl: +a4:=a4+1. + +decoder: +IF subt ="A" THEN subi:=10; +ELIF subt ="B" THEN subi:=11; +ELIF subt ="C" THEN subi:=12; +ELIF subt ="D" THEN subi:=13; +ELIF subt ="E" THEN subi:=14; +ELIF subt ="F" THEN subi:=15 +ELSE subi:=int(subt) FI. + +encode: +IF subi = 10 THEN subt:="A"; +ELIF subi = 11 THEN subt:="B"; +ELIF subi = 12 THEN subt:="C"; +ELIF subi = 13 THEN subt:="D"; +ELIF subi = 14 THEN subt:="E"; +ELIF subi = 15 THEN subt:="F" +ELSE subt:=text(subi) FI. diff --git a/devel/misc/unknown/src/COPYDS.ELA b/devel/misc/unknown/src/COPYDS.ELA new file mode 100644 index 0000000..c0bd83c --- /dev/null +++ b/devel/misc/unknown/src/COPYDS.ELA @@ -0,0 +1,294 @@ +LET systemanker = 2 , (* Wird bei 'blockin' durch 2 geteilt *) + channel field = 4 , + hg channel = 0 ; + +ROW 256 INT VAR block ; +INT VAR return ; + +PROC pcb (TASK CONST id, INT CONST field, value) : + EXTERNAL 105 +ENDPROC pcb ; + +PROC copy ds (INT CONST task nr, ds nr, TEXT CONST destination) : + DATASPACE VAR ds ; + ROW 8 INT VAR dr eintrag ; + INT VAR old channel := channel, link, i, seite ; + + system channel ; + zugriff ueber drdr ; + IF ist nilspace + THEN ds := nilspace + ELIF ist kleindatenraum + THEN lese kleindatenraum + ELSE lese grossdatenraum + FI ; + user channel ; + forget (destination, quiet) ; + copy (ds, destination) ; + forget (ds) . + +user channel : + disablestop ; + continue (old channel) ; + IF iserror + THEN forget (ds) ; + FI ; + enablestop . + +system channel : + break (quiet) ; (* Offiziell abmelden *) + pcb (myself, channel field, hg channel) . (* Inoffiziell anmelden *) + +zugriff ueber drdr : + systemanker lesen ; + drdr taskwurzel lesen ; + drdr dataspacewurzel lesen . + +erste seite im dreintrag : + link := 8 * (dsnr MOD 32) + 1 ; + FOR i FROM link UPTO link + 7 REP + IF block (i) <> -1 + THEN LEAVE erste seite im dreintrag WITH i + FI + PER ; + user channel ; + errorstop ("Der Datenraum existiert nicht (DR-Eintrag = 8 mal FFFF)") ; 0 . + +ist nilspace : + block (erste seite im dreintrag) = -255 . + +ist kleindatenraum : + block (link) > -255 AND block (link) < 0 . + +lese kleindatenraum : + ds := nilspace ; + IF seite eins existiert + THEN blockin (ds, 1, block (link + 1)) ; + IF return <> 0 + THEN user channel ; + putline ("Warnung: Seite 1 des Datenraums nicht lesbar: " + + text (return)) ; + system channel + FI + FI ; + IF seite zwei existiert + THEN blockin (ds, 2, block (link + 2)) ; + IF return <> 0 + THEN user channel ; + putline ("Warnung: Seite 2 des Datenraums nicht lesbar: " + + text (return)) ; + system channel + FI + FI ; + IF mehr als zwei seiten + THEN FOR i FROM 0 UPTO 4 REP + IF hoehere seite existiert + THEN blockin (ds, i + basisseite, block (link + i + 3)) ; + IF return <> 0 + THEN user channel ; + putline ("Warnung: Seite " + text (i + basisseite) + + " des Datenraums nicht lesbar: " + + text (return)) ; + system channel + FI + FI + PER + FI . + +seite eins existiert : + exists (block (link + 1)) . + +seite zwei existiert : + exists (block (link + 2)) . + +mehr als zwei seiten : + exists (block (link)) . + +hoehere seite existiert : + exists (block (link + i + 3)) . + +basisseite : + block (link) AND 255 . + +lese grossdatenraum : + ds := nilspace ; + dreintrag kopieren ; + seite := 0 ; + FOR i FROM 1 UPTO 8 REP + IF seitenblocktabelle existiert + THEN seitenblocktabelle lesen ; + seiten kopieren wenn sie in der seitenblocktabelle vorhanden sind + ELSE seite INCR 256 + FI + PER . + +seitenblocktabelle lesen : + blockin (dr eintrag (i)) ; + IF return <> 0 + THEN user channel ; + putline ("Warnung: Seitenblocktabelle " + text (i-1) + + " des Datenraums nicht lesbar: " + text (return)) ; + putline ("Damit fehlen die Seiten " + text (max (1, seite)) + + " bis " + text (seite + 255)) ; + system channel + FI . + +seiten kopieren wenn sie in der seitenblocktabelle vorhanden sind : + FOR link FROM 1 UPTO 256 REP + IF seite vorhanden + THEN blockin (ds, seite, block (link)) ; + IF return <> 0 + THEN user channel ; + putline ("Warnung: Seite " + text (seite) + + " des Datenraums nicht lesbar: " + text (return)) ; + system channel + FI ; + user channel ; + cout (seite) ; + system channel + FI ; + seite INCR 1 + PER . + +seite vorhanden : + exists (block (link)) . + +seitenblocktabelle existiert : + exists (dreintrag (i)) . + +dreintrag kopieren : + FOR i FROM 0 UPTO 7 REP + dreintrag (i + 1) := block (link + i) + PER . + +systemanker lesen : + blockin (systemanker) ; + IF return <> 0 + THEN user channel ; + errorstop ("Systemanker nicht lesbar: " + text (return)) + FI . + +drdr taskwurzel lesen : + link := block (tasknr DIV 32 + 1) ; + IF link = -1 + THEN user channel ; + errorstop ("Die Task existiert nicht") + FI ; + blockin (link) ; + IF return <> 0 + THEN user channel ; + errorstop ("Taskwurzel des DRDR nicht lesbar: " + text (return)) + FI . + +drdr dataspacewurzel lesen : + link := block (8 * (tasknr MOD 32) + dsnr DIV 32 + 1) ; + IF NOT exists (link) + THEN user channel ; + errorstop ("Der Datenraum (und weitere 31) existiert nicht") + FI ; + blockin (link) ; + IF return <> 0 + THEN user channel ; + errorstop ("Dataspacewurzel des DRDR nicht lesbar: " + + text (return)) + FI . + +ENDPROC copy ds ; + +BOOL PROC exists (INT CONST blocknr) : + blocknr <> -1 AND blocknr <> -255 +ENDPROC exists ; + +PROC blockin (INT CONST blocknr) : + blockin (block, 0, blocknr DIV 2, return) ; (* ggf COPBIT ausblenden *) +ENDPROC blockin ; + +PROC blockin (DATASPACE VAR ds, INT CONST page, blocknr) : + blockin (ds, page, 0, blocknr DIV 2, return) (* ggf COPBIT ausblenden *) +ENDPROC blockin ; + +PROC dump (TEXT CONST datei) : + edit dump (datei, FALSE) +ENDPROC dump ; + +PROC edit dump (TEXT CONST datei, BOOL CONST write access) : + BOUND STRUCT (ROW 252 INT page1, ROW 2047 ROW 256 INT blocks) VAR b ; + b := old (datei) ; + INT VAR blocknr := 1, i ; + TEXT VAR esc char, t ; + BOOL VAR clear := TRUE , modified ; + ROW 256 INT VAR page 1 ; + page 1 (1) := 0 ; + page 1 (2) := 0 ; + page 1 (3) := type (old (datei)) ; + page 1 (4) := -1 ; + page ; + put ("Info mit 'ESC ?'") ; + dump cursor (4, 3) ; + REP + out (""1""5"Datei: """) ; out (datei) ; put ("""") ; + put (", Page:") ; put (text (blocknr, 5)) ; + put (", Dspages:") ; put (text (dspages (old (datei)), 5)) ; + put (", Type:") ; put (type (old (datei))) ; + IF blocknr = 1 + THEN FOR i FROM 1 UPTO 252 REP + page1 (i + 4) := b.page1 (i) + PER ; + edit dump (page 1, 1, 256, clear, write access, modified, esc char); + IF modified + THEN FOR i FROM 1 UPTO 252 REP + b.page1 (i) := page 1 (i + 4) + PER ; + type (old (datei), page 1 (3)) + FI + ELSE edit dump (b.blocks (blocknr), 1, 256, clear, write access, modified, esc char) + FI ; + clear := TRUE ; + IF esc char = ""1""10"" + THEN blocknr INCR 1 + ELIF esc char = ""1""3"" + THEN IF blocknr > 1 + THEN blocknr DECR 1 + ELSE clear := FALSE ; + out (""1""15"E r s t e S e i t e "14""5"") + FI + ELIF esc char = ""27"q" + THEN LEAVE edit dump + ELIF esc char = ""27"?" + THEN clear := FALSE ; + putline (""1"ESC:?,p,q,w,F,0; HOP:HOP,LEFT,UP,DOWN,RIGHT; DEL,INS,LEFT,UP,RIGHT") ; + ELIF esc char = ""27"p" + THEN REP + put(""1""5"Neue Pagenr:") ; + t := text (blocknr) ; + editget (t) ; + blocknr := int (t) + UNTIL blocknr >= 0 AND blocknr < 2048 PER + ELSE clear := FALSE + FI ; + PER +ENDPROC edit dump ; + +INT VAR task index, ds nr ; +TEXT VAR task id ; +page ; +put ("""Taskname"" oder Taskindex:") ; +getline (task id) ; +IF pos (task id, """") > 0 + THEN scan (task id) ; + nextsymbol (task id) ; + task index := index (task (task id)) + ELSE task index := int (task id) +FI ; +put ("Dataspacenummer in der Task:") ; +get (ds nr) ; +IF ds nr < 4 + THEN errorstop ("Es gibt nur DATASPACE-Nummern >= 4") +FI ; +IF yes ("Soll vorher ein Fixpoint gesetzt werden") + THEN fixpoint +FI ; +forget ("new ds", quiet) ; +copy ds (task index, ds nr, "new ds") ; +putline ("Der kopierte Datenraum steht in der Datei ""new ds""") ; +dump ("new ds") diff --git a/devel/misc/unknown/src/DS4.ELA b/devel/misc/unknown/src/DS4.ELA new file mode 100644 index 0000000..6ebcf2d --- /dev/null +++ b/devel/misc/unknown/src/DS4.ELA @@ -0,0 +1,268 @@ +PACKET ds 4 access DEFINES ds 4 : + +PROC ds 4 : + INT VAR segment, block nr , i , adr , byte ; + TEXT VAR key , eingabe ; + BOOL VAR new headline ; + page ; + put ("Segment:") ; + get (segment) ; + ROW 256 INT VAR space ; + block nr := 0 ; + new headline := FALSE ; + REP + IF new headline THEN out (""1""5"") + ELSE page + FI ; + put (" Segment:") ; put (text(segment,5)) ; (* Cursor 1-16 *) + put (", Block:") ; put (text(block nr,5)) ; (* Cursor 17-31 *) + put (", Wortaddr:") ; out (hex8 (segment)) ; + put (text(hex16((""0""+code(blocknr))ISUB1),5)) ; + put ("Wahl : + - e s b w a h d o") ; (* ^ Cursor 32 - 51 *) + IF NOT new headline THEN + line ; (* ^ 52 - 77 *) + adr := (""0"" + code (block nr)) ISUB 1 ; + FOR i FROM 0 UPTO 255 REP + space (i+1) := get word (segment, i + adr) + PER ; + dump (space) + FI ; + out (""1"") ; + new headline := FALSE ; + inchar (key) ; + out (key) ; + IF key = "+" THEN IF block nr = 255 + THEN block nr := 0 ; + segment INCR 1 + ELSE block nr INCR 1 + FI + ELIF key = "-" THEN IF block nr = 0 AND segment > 0 + THEN block nr := 255 ; + segment DECR 1 + ELIF block nr > 0 THEN block nr DECR 1 + FI + ELIF key = "s" THEN cursor (11,1) ; + eingabe := text (segment) ; + editget (eingabe, 1000, 5) ; + segment := int (eingabe) + ELIF key = "b" THEN cursor (26,1) ; + eingabe := hex8 (block nr) ; + editget (eingabe, 1000, 5) ; + block nr := integer (eingabe) + ELIF key = "w" THEN cursor (44,1) ; + eingabe := hex16 (adr) ; + edit get (eingabe, 1000, 5) ; + adr := integer (eingabe) ; + eingabe := hex16 (get word (segment, adr)) ; + cursor (32,1) ; + put (",NeuesWort:") ; + editget (eingabe, 1000,5) ; + put word (segment, adr, integer (eingabe)) ; + ELIF key = "d" THEN cursor (32,1) ; + new headline := TRUE ; + put (", Dez->Hex:") ; + REAL VAR r ; + get (r) ; + cursor (32,1) ; + put (", - Taste - Hex:") ; + IF r < 256.0 AND r >= 0.0 THEN put (hex8 (int(r))) + ELIF r < 0.0 THEN put (hex16 (int (r))) + ELIF r < 32768.0 THEN put (hex16 (int(r))) + ELSE put (hex16 (int (r - 65536.0))) + FI ; pause + ELIF key = "h" THEN cursor (32,1) ; + new headline := TRUE ; + put (", Hex->Dez:") ; + getline (eingabe) ; + cursor (32,1) ; + put (", - Taste - Dez:") ; + put (integer (eingabe)) ; + IF integer (eingabe) < 0 THEN put (", Positiv:") ; + put (positiv (eingabe)) + FI ; pause + ELIF key = "a" THEN cursor (32,1) ; + new headline := TRUE ; + put (", ASCII->Hex (Taste)"5"") ; + inchar (eingabe) ; + put (" = ") ; put (hex8 (code (eingabe))) ; + put ("- Taste -") ; + pause + ELIF key = "o" THEN cursor (32,1) ; + new headline := TRUE ; + put (", Hex->0Opcde:") ; + getline (eingabe) ; + cursor (32,1) ; + put (", - Taste - :") ; + put (eumel0 opcode (integer (eingabe))) ; + pause + FI ; + UNTIL key = "e" PER ; + +ENDPROC ds 4 ; + +PROC dump (ROW 256 INT CONST page) : + INT VAR i,j ,k ; + TEXT VAR t := " " ; + k := 1 ; j := 1 ; + put ("00:") ; + FOR i FROM 1 UPTO 256 WHILE incharety <> ""27""REP + put hex16 (page (i)) ; + replace (t, j, ascii (page (i))) ; + j := j + 2 ; + IF ((j-1) MOD 8) = 0 THEN out (" ") FI ; + IF k = 22 AND j = 9 THEN j := 25 ; 34 TIMESOUT " " FI ; + IF j = 25 THEN + out (" ") ; out (t) ; + replace (t, 1, " ") ; + IF k < 22 THEN + line ; + out(hex8 (i)); put (":") + FI ; + k := k + 1 ; + j := 1 + FI ; +PER ; +ENDPROC dump ; + + +TEXT PROC ascii (INT CONST wert) : + TEXT VAR t := " " ; + replace (t, 1, wert) ; + IF (t SUB 1) < " " OR (t SUB 1) > ""126"" THEN replace (t, 1, ".") FI ; + IF (t SUB 2) < " " OR (t SUB 2) > ""126"" THEN replace (t, 2, ".") FI ; + t +ENDPROC ascii ; + +PROC put hex16 (INT CONST wert) : + TEXT VAR t := " " ; + replace (t, 1, wert) ; + out hex digit (code (t SUB 1) DIV 16) ; + out hex digit (code (t SUB 1) AND 15) ; + out hex digit (code (t SUB 2) DIV 16) ; + out hex digit (code (t SUB 2) AND 15) ; +ENDPROC put hex16 ; + +PROC out hex9 (INT CONST wert) : + out hex digit (wert DIV 256) ; + out hex digit (wert DIV 16 AND 15) ; + out hex digit (wert AND 15) +ENDPROC out hex9 ; + +TEXT PROC hex8 (INT CONST wert) : + hex digit (wert DIV 16) + + hex digit (wert AND 15) +ENDPROC hex8 ; + +TEXT PROC hex16 (INT CONST wert) : + TEXT VAR t := " " ; + replace (t, 1, wert) ; + hex digit (code (t SUB 2) DIV 16) + + hex digit (code (t SUB 2) AND 15) + + hex digit (code (t SUB 1) DIV 16) + + hex digit (code (t SUB 1) AND 15) +ENDPROC hex16 ; + +TEXT PROC hex digit (INT CONST wert) : + IF wert < 10 THEN code (wert + 48) + ELSE code (wert + 55) + FI +ENDPROC hex digit ; + +PROC out hex digit (INT CONST wert) : + IF wert < 10 THEN out (code (wert + 48)) + ELSE out (code (wert + 55)) + FI +ENDPROC out hex digit ; + +INT PROC integer (TEXT CONST hex addr) : + INT VAR i ; + REAL VAR summe := 0.0 ; + FOR i FROM 1 UPTO length (hex addr) REP + summe := summe * 16.0 ; + summe INCR real (digit) + PER ; + IF summe > 32767.0 THEN int (summe - 65536.0) + ELSE int (summe) + FI. + +digit : + TEXT CONST char := hex addr SUB i ; + IF char >= "a" THEN code (char) - 87 + ELIF char >= "A" THEN code (char) - 55 + ELSE code (char) - 48 + FI +ENDPROC integer ; + +REAL PROC positiv (TEXT CONST wert) : + INT VAR i ; + REAL VAR summe := 0.0 ; + FOR i FROM 1 UPTO length (wert) REP + summe := summe * 16.0 ; + summe INCR real (digit) + PER ; + summe . + +digit : + TEXT CONST char := wert SUB i ; + IF char >= "a" THEN code (char) - 87 + ELIF char >= "A" THEN code (char) - 55 + ELSE code (char) - 48 + FI +ENDPROC positiv ; + +TEXT PROC eumel0 opcode (INT CONST word) : + INT VAR op1 := (word AND 31744) DIV 1024 , + op2 := (word AND 768) DIV 128 , + low := word AND 255 , + long data := (word AND 768) * 2 + (word AND 255) ; + IF word < 0 THEN op2 INCR 1 ; long data INCR 256 FI ; + SELECT op1 OF + CASE 0 : "LN " + text (low) + CASE 1 : "LN " + text (long data) + CASE 2 : "MOV " + CASE 3 : "INC1 " + CASE 4 : "DEC1 " + CASE 5 : "INC " + CASE 6 : "DEC " + CASE 7 : "ADD " + CASE 8 : "SUB " + CASE 9 : "CLEAR " + CASE 10 : "TEST " + CASE 11 : "EQU " + CASE 12 : "LSEQ " + CASE 13 : "FMOV " + CASE 14 : "FADD " + CASE 15 : "FSUB " + CASE 16 : "FMULT " + CASE 17 : "FDIV " + CASE 18 : "FLSEQ " + CASE 19 : "TMOV " + CASE 20 : "TEQU " + CASE 21 : "LSEQU " + CASE 22 : "ACCDS " + CASE 23 : "REF " + CASE 24 : "SUBS " + CASE 25 : "SEL " + CASE 26 : "PPV " + CASE 27 : "PP " + CASE 28 : "BR " + hex8 (low) + CASE 29 : "BR " + hex16 (long data) + CASE 30 : "CALL " + OTHERWISE op 31 + ENDSELECT. + +op31 : +SELECT op 2 OF + CASE 0 : "IS """ + code (low) + """" + CASE 1 : "STIM " + hex8 (low) + CASE 2 : "MOVX " + CASE 3 : "PW " + CASE 4 : "GW " + CASE 5 : "PENTER " + hex8 (low) + CASE 6 : "ESC " + text (low) + CASE 7 : "LONGA " + eumel 0 opcode ((low AND 124) * 256) + OTHERWISE "?????" +ENDSELECT +ENDPROC eumel 0 opcode + +ENDPACKET ds 4 access diff --git a/devel/misc/unknown/src/PRIVS.ELA b/devel/misc/unknown/src/PRIVS.ELA new file mode 100644 index 0000000..dfed695 --- /dev/null +++ b/devel/misc/unknown/src/PRIVS.ELA @@ -0,0 +1,485 @@ +PACKET privs DEFINES pcb, + pages, + internal pause, + set error stop, + sld, + next active task index, + create process, + sysgen off, + (* cdb int , + cdb text , *) + block, + unblock, + sys op, + set clock, + fixpoint, + save system, + internal shutup, + collect garbage blocks, + send, + define collector, + erase process, + halt process , + + return false , + return true , + term , + char read , + begin char read , + char write , + end char write , + get char , + find non blank , + div rem 256 , + add mul 256 , + is digit , + is lowercase or digit , + is lowercase , + is uppercase , + gen addr , + gen code addr , + is short address, + sysgen , + get tables , + put tables , + erase tables , + exec , + (* pproc , + pcall , *) + case , + move , + address , + alias , + IMULT , + arith 15 , + arith 16 , + put word , + get word : + + +PROC pcb (TASK CONST id, INT CONST field, value) : + + EXTERNAL 105 + +ENDPROC pcb ; + + +PROC pages (DATASPACE CONST ds, TASK CONST id) : + + EXTERNAL 88 + +ENDPROC pages ; + + +PROC internal pause (INT CONST time limit) : + + EXTERNAL 66 + +ENDPROC internal pause ; + + +PROC set error stop (INT CONST code) : + + EXTERNAL 77 + +ENDPROC set error stop ; + + +PROC sld (INT CONST in, REAL VAR real, INT VAR out) : + + EXTERNAL 96 + +ENDPROC sld ; + + +PROC next active task index (TASK VAR id) : + + EXTERNAL 118 + +ENDPROC next active task index ; + + +PROC create process (TASK CONST id, PROC start) : + + create (id, PROC start) + +ENDPROC create process ; + + +PROC create (TASK CONST id, PROC start) : + + EXTERNAL 111 + +ENDPROC create ; + + +PROC sysgen off : + + INT VAR x := 0 ; + elan (3, x,x,x,x,x,x,x,x,x,x,x) + +ENDPROC sysgen off ; + + +PROC elan (INT CONST mode, INT VAR a,b,c,d,e,f,g,h,i,j,k) : + + EXTERNAL 256 + +ENDPROC elan ; + + +INT PROC cdbint (INT CONST adr) : + + EXTERNAL 116 + +ENDPROC cdbint ; + + +TEXT PROC cdbtext (INT CONST adr) : + + EXTERNAL 117 + +ENDPROC cdbtext ; + + +PROC block (TASK CONST id) : + + EXTERNAL 109 + +ENDPROC block ; + + +PROC unblock (TASK CONST id) : + + EXTERNAL 108 + +ENDPROC unblock ; + + +PROC sys op (INT CONST function) : + + EXTERNAL 90 + +ENDPROC sys op ; + + +PROC set clock (TASK CONST id, REAL CONST value) : + + EXTERNAL 82 + +ENDPROC set clock ; + + +PROC set clock (REAL CONST value) : + + EXTERNAL 103 + +ENDPROC set clock ; + + +PROC fixpoint : + + sys op (2) + +ENDPROC fixpoint ; + + +PROC collect garbage blocks : + + sys op (1) + +ENDPROC collect garbage blocks ; + + +PROC internal shutup : + + sys op (4) + +ENDPROC internal shutup ; + + +PROC save system : + + sys op (12) + +ENDPROC save system ; + + +PROC send (TASK CONST from, to, INT CONST order, DATASPACE VAR ds, + INT VAR receipt) : + + EXTERNAL 127 + +ENDPROC send ; + + +PROC define collector (TASK CONST task) : + + EXTERNAL 128 + +ENDPROC define collector ; + + +PROC erase process (TASK CONST id) : + + EXTERNAL 112 + +ENDPROC erase process ; + + +PROC halt process (TASK CONST id) : + + EXTERNAL 110 + +ENDPROC halt process ; + + +(****************************** undokumentiert **************************) + + +BOOL PROC return false : + + EXTERNAL 1 + +ENDPROC return false ; + + +BOOL PROC return true : + + EXTERNAL 2 + +ENDPROC return true ; + + +PROC term : + + EXTERNAL 4 + +ENDPROC term ; + + +PROC char read (INT CONST pos) : + + EXTERNAL 8 + +ENDPROC char read ; + + +INT PROC begin char read (INT VAR pos) : + + EXTERNAL 9 + +ENDPROC begin char read ; + + +PROC char write (INT VAR next, INT CONST char, int) : + + EXTERNAL 10 + +ENDPROC char write ; + + +PROC end char write (INT VAR a, b, INT CONST char) : + + EXTERNAL 11 + +ENDPROC end char write ; + + +PROC ctt (INT CONST adr, INT VAR result) : + + EXTERNAL 12 + +ENDPROC ctt ; + + +BOOL PROC get char (TEXT CONST text, INT VAR pos, char) : + + EXTERNAL 13 + +ENDPROC get char ; + + +BOOL PROC find non blank (INT VAR non blank char, TEXT CONST string, + INT VAR pos) : + + EXTERNAL 14 + +ENDPROC find non blank ; + + +PROC divrem 256 (INT VAR a, b) : + + EXTERNAL 15 + +ENDPROC divrem 256 ; + + +PROC addmul 256 (INT VAR a, b) : + + EXTERNAL 16 + +ENDPROC addmul 256 ; + + +BOOL PROC is digit (INT CONST char) : + + EXTERNAL 18 + +ENDPROC is digit ; + + +BOOL PROC is lowercase or digit (INT CONST char) : + + EXTERNAL 19 + +ENDPROC is lowercase or digit ; + + +BOOL PROC is lowercase (INT CONST char) : + + EXTERNAL 20 + +ENDPROC is lowercase ; + + +BOOL PROC is uppercase (INT CONST char) : + + EXTERNAL 21 + +ENDPROC is uppercase ; + + +PROC gen addr (INT CONST word1, word2, INT VAR result) : + + EXTERNAL 22 + +ENDPROC gen addr ; + + +BOOL PROC gen code addr (INT CONST word1, word2, INT VAR result) : + + EXTERNAL 23 + +ENDPROC gen code addr ; + + +BOOL PROC is short address (INT CONST address) : + + EXTERNAL 24 + +ENDPROC is short address ; + + +PROC sysgen : + + EXTERNAL 25 + +ENDPROC sysgen ; + + +PROC get tables : + + EXTERNAL 26 + +ENDPROC get tables ; + + +PROC put tables : + + EXTERNAL 27 + +ENDPROC put tables ; + + +PROC erase tables : + + EXTERNAL 28 + +ENDPROC erase tables ; + + +PROC exec (INT CONST module number) : + + EXTERNAL 29 + +ENDPROC exec ; + +(* +PROC pproc (PROC proc) : + + EXTERNAL 30 + +ENDPROC pproc ; + + +PROC pcall (PROC proc) : + + EXTERNAL 31 + +ENDPROC pcall ; +*) + +BOOL PROC case (INT CONST switch, limit) : + + EXTERNAL 32 + +ENDPROC case ; + + +PROC move (PROC len, INT VAR from area, to area) : + + EXTERNAL 33 + +ENDPROC move ; + + +INT PROC alias (DATASPACE CONST ds, INT VAR result) : + + EXTERNAL 34 + +ENDPROC alias ; + + +INT PROC address (INT CONST object) : + + EXTERNAL 35 + +ENDPROC address ; + + +INT OP IMULT (INT CONST a, b) : + + EXTERNAL 40 + +ENDOP IMULT ; + + +PROC arith 15 : + + EXTERNAL 91 + +ENDPROC arith 15 ; + + +PROC arith 16 : + + EXTERNAL 92 + +ENDPROC arith 16 ; + + +PROC put word (INT CONST segment, address, word) : + + EXTERNAL 119 + +ENDPROC put word ; + + +INT PROC get word (INT CONST segment, address) : + + EXTERNAL 120 + +ENDPROC get word + +ENDPACKET privs diff --git a/devel/misc/unknown/src/TABINFO.ELA b/devel/misc/unknown/src/TABINFO.ELA new file mode 100644 index 0000000..af419bb --- /dev/null +++ b/devel/misc/unknown/src/TABINFO.ELA @@ -0,0 +1,117 @@ +PACKET table info DEFINES table info : (* Michael Staubermann *) + (* 02.12.86 *) +LET insert flag addr = 4654 , + +(* prev modnr addr = 4662 , *) + cur modnr addr = 4806 , + + prev code end addr = 4775 , + cur code end addr = 4807 , + + prev name tab end addr = 4688 , + cur name tab end addr = 4693 , + + prev permanent tab end addr = 4704 , + cur permanent tab end addr = 4707 , + + prev denoter end addr = 4815 , + cur denoter end addr = 4809 , + + prev static data end addr = 4816 , + cur static data end addr = 4810 , + prev static data begin addr = 4817 , + cur static data begin addr = 4811 , +(* + begin of hash table = 0 , + end of hash table = 1023 , + + begin of string table = 1024 , + end of string table = 4093 , +*) + begin of name table = 4096 , + end of name table = 22783 , + + begin of permanent table = 22784 , + end of permanent table = 32767 , + + begin of code = 4096 , + + begin of data = 4096 ; + +INT CONST end of code :: -1 , + end of data :: -1 ; + +BOOL VAR was insert ; + +INT PROC getword (INT CONST segment, address) : + EXTERNAL 120 +ENDPROC getword ; + +PROC arith16 : + EXTERNAL 92 +ENDPROC arith16 ; + +INT OP SUB (INT CONST left, right) : + arith 16 ; + left - right +ENDOP SUB ; + +PROC entry (TEXT CONST name, BOOL CONST size, + INT CONST begin, cur, prev, end) : + put (subtext (name + " ....................", 1, 20) + ":") ; + IF size + THEN put (card (end SUB begin)) ; + put (card (end SUB cur)) ; + put (card (cur SUB begin)) ; + put (card (int (positiv (cur SUB begin) / + positiv (end SUB begin) * 100.0))) ; + ELSE put (" ") + FI ; + IF NOT was insert + THEN put (card (prev - cur)) + FI ; + line +ENDPROC entry ; + +PROC table info : + was insert := getword (0, insert flag addr) = 0 ; + line ; + put ("Nchste Modulenr.:") ; + put (getword (0, cur modnr addr)) ; line (2) ; + put ("Name Size Free Used Used%") ; + IF NOT was insert + THEN put ("LastRun") + FI ; + line ; + entry ("Permanenttable", TRUE, begin of permanent table, + getword (0, cur permanent tab end addr), + getword (0, prev permanent tab end addr), end of permanent table) ; + entry ("Nametable", TRUE, begin of name table, + getword (0, cur name tab end addr), + getword (0, prev name tab end addr), end of name table) ; + entry ("Code", TRUE, begin of code, + getword (0, cur code end addr), + getword (0, prev code end addr), end of code) ; + entry ("Data", TRUE, begin of data, + getword (0, cur static data end addr), + getword (0, prev static data end addr), end of data) ; + line ; +ENDPROC table info ; + +REAL PROC positiv (INT CONST value) : + IF value < 0 + THEN real (value) + 65536.0 + ELSE real (value) + FI +ENDPROC positiv ; + +TEXT PROC card (INT CONST i) : + IF i = minint + THEN "32768" + ELIF i < 0 + THEN subtext (text (real (i) + 65536.0), 1, 5) + ELSE text (i, 5) + FI +ENDPROC card + +ENDPACKET table info ; diff --git a/devel/misc/unknown/src/TRACE.ELA b/devel/misc/unknown/src/TRACE.ELA new file mode 100644 index 0000000..63c1455 --- /dev/null +++ b/devel/misc/unknown/src/TRACE.ELA @@ -0,0 +1,552 @@ +PACKET tracer DEFINES breakpoint handler , (* M. Staubermann *) + handlers module nr , (* 20.04.86 *) + list breakpoints , + set breakpoint , + reset breakpoint , + source file , + trace , + reset breakpoints : + +LET local base field = 25 , + packet data segment = 0 , + local data segment = 1 , + + begin of module nr link table = 512 , + + previous local base offset = 0 , + return address offset = 1 , + return segment offset = 2 , + c8k offset = 3 , + + opcode mask = 31744 , + bt opcode = 0 , + btlong opcode = 1024 , + bf opcode = 28672 , + bflong opcode = 29696 , + br opcode = 28672 , + brlong opcode = 29696 , + + ln opcode = 0 , + ln long opcode = 1024 , + call opcode = 30720 , + pcall opcode = 32543 ; + +LET nr of breakpoints = 2 , + BREAKPOINT = STRUCT (BOOL set, + INT segment, + address, + saved word) ; + +ROW nr of breakpoints BREAKPOINT VAR breakpoints ; +BREAKPOINT CONST init breakpoint :: BREAKPOINT:(FALSE, 3, -5, 0) ; + +FOR i FROM 1 UPTO nr of breakpoints REP + breakpoints (i) := init breakpoint +PER ; + +BOOL VAR auto trace := FALSE , + zweizeilig ; +INT VAR next instruction address , + next instruction segment , + next instruction , + return segment, + return address, + breakpoint address , + breakpoint segment , + breakpoint nr , + lbas , + this local base , + branch address , + c8k , + packet base , + op word, + saved word , + i, x, y , + actual line number := -1 , + handler module := 395 ; (* PROC stop *) + +TEXT VAR key := "" , + previous key := "" , + statement line := "" , + source line := "" , + source file name := "" ; + +FILE VAR source ; + +PROC trace (BOOL CONST b) : + auto trace := b +ENDPROC trace ; + +PROC source file (TEXT CONST file name) : + IF exists (file name) + THEN source := sequentialfile (modify, file name) + FI ; + IF actual line number >= 0 CAND actual line number <= lines (source) + THEN toline (source, actual line number) ; + readrecord (source, source line) + ELSE source line := "" + FI +ENDPROC source file ; + +TEXT PROC source file : + source file name +ENDPROC source file ; + +PROC breakpoint handler : + determine return address ; + determine breakpoint nr ; + reset breakpoints ; + getcursor (x, y) ; + REP + ueberschrift schreiben ; + IF auto trace + THEN IF incharety = "" + THEN key := "s" + ELSE auto trace := FALSE + FI + FI ; + IF NOT auto trace + THEN REP + inchar (key) + UNTIL pos (""13"acdefgst", key) > 0 PER ; + IF key = "a" + THEN auto trace := TRUE ; + key := "s" + ELIF key = "f" + THEN out (""13""5"Sourcefile:") ; + getline (source file name) ; + out (""3"") ; + source file (source file name) + ELIF key = ""13"" + THEN key := "s" + FI + FI ; + previous key := key + UNTIL pos ("gst", key) > 0 PER ; + cursor (1, 7) ; + out (""5"") ; + IF key <> "t" + THEN execute saved instruction + FI ; + IF key = "t" + THEN resetbreakpoints ; + term + ELIF key = "s" + THEN singlestep + FI ; + cursor (x, y) . + +ueberschrift schreiben : + feld loeschen ; + put (""1"Breakpoint") ; put (breakpoint nr) ; + put ("lbas:") ; put (hex16 (lbas)) ; + put ("pbas:") ; put (hex8 (packet base)) ; + put ("c8k:") ; put (hex8 (c8k)) ; + IF valid source + THEN out ("""") ; out (source file name) ; put ("""") + FI ; + line ; + IF valid source AND source line <> "" + THEN put (text (actual line number, 5)) ; put ("|") ; + outsubtext (source line, 1, 71) ; + line ; + IF LENGTH source line < 72 + THEN put (text (actual line number +1, 5)) ; put ("|") ; + toline (source, actual line number +1) ; + out (subtext (source, 1, 71)) ; + toline (source, actual line number) ; + line + ELSE put ("______|") ; + outsubtext (source line, 72, 143) ; + line + FI + ELSE line (2) + FI ; + out (text (return segment AND 3)) ; + put (hex16 (return address)) ; + put ("|") ; + seg (breakpoint segment) ; + addr (breakpoint address) ; + zweizeilig := TRUE ; + disassemble one statement ; + IF auto trace + THEN pause (5) + FI ; + next instruction segment := breakpoint segment ; + next instruction address := addr ADD 1 ; + next instruction := getword (next instruction segment, + next instruction address) ; + line ; + put ("a)uto, s)tep, g)o, t)erm, d)stop, e)stop, c)lrerr, f)ile:") . + +feld loeschen : + out (""1"") ; + 7 TIMESOUT ""5""10"" ; + 79 TIMESOUT "-" . + +valid source : + exists (source file name) . + +disassemble one statement : + statement line := hex16 (get word (breakpoint segment, addr)) ; + statement line CAT " " ; + code word line (statement line) ; +(* local base (lbas + offset) ; *) + statement line := opcode ; + local base (-1) ; + put (code word line) ; +(* i := max (0, 26 - length (code word line)) ; + i TIMESOUT " " ; *) +i:=0; i := 71 - LENGTH codeword line - i ; + outsubtext (statement line, 1, i) ; + line ; + IF zweizeilig + THEN put (" |") ; + outsubtext (statement line, i + 1, i + 72) ; + line + FI ; + codeword line ("") . + +singlestep : + IF is return opcode + THEN set breakpoint behind previous call + ELIF bool result + THEN set first breakpoint behind branch instruction ; + set second breakpoint at branch address ; + bool result (FALSE) ; + ELIF is bool return opcode + THEN set first breakpoint behind branch instruction at return address ; + set second breakpoint at branch address of branch instruction at + return address ; + ELIF is branch instruction + THEN set breakpoint at branch address + ELIF is call opcode AND NOT auto trace CAND segment 3 module CAND + yes (""3"Subroutine Trace") + THEN out (""3""13""5"") ; + calculate subroutine segment and address ; + set breakpoint behind next instruction + ELSE set breakpoint behind next instruction + FI . + +is call opcode : + (saved word AND opcode mask) = call opcode OR +(* saved word = pcall opcode OR //einbauen, wenn local zugriffe ok sind// *) + saved word = -136 . (* LONGA CALL *) + +is line number : + (saved word AND opcode mask) = ln opcode OR + (saved word AND opcode mask) = lnlong opcode . + +is branch instruction : + (saved word AND opcode mask) = br opcode OR + (saved word AND opcode mask) = brlong opcode . + +is return opcode : + saved word = 32512 . + +is bool return opcode : + saved word = 32513 OR saved word = 32514 . + +read source line : + actual line number := ((saved word AND 768) * 2) OR (saved word AND 255); + IF saved word < 0 + THEN actual line number INCR 256 + FI ; + IF (saved word AND opcode mask) = lnlong opcode + THEN actual line number INCR 2048 + FI ; + actual line number DECR 1 ; + IF valid source + THEN IF lineno (source) = actual line number CAND source line <> "" + THEN (* nichts*) + ELIF actual line number >= 0 AND actual line number <= lines(source) + THEN toline (source, actual line number) ; + readrecord (source, source line) + ELSE source line := "" + FI + ELSE source line := "" + FI . + +set first breakpoint behind branch instruction : + op word := next instruction AND opcode mask ; + IF op word = bf opcode OR op word = bflong opcode OR + op word = bt opcode OR op word = btlong opcode + THEN seg (next instruction segment) ; + addr (next instruction address) ; + out (""3"") ; + out (text (next instruction segment)) ; + put (hex16 (next instruction address)) ; + put ("|") ; + zweizeilig := FALSE ; + bool result (TRUE) ; + disassemble one statement ; (* Branch instruction *) + IF NOT auto trace + THEN pause (30) + ELSE pause (5) + FI ; + next free breakpoint ; + set breakpoint (i, next instruction segment, + next instruction address ADD 1) ; + ELSE putline (""3""7"Interner Fehler: Nach BOOL-Result folgt kein Branch"); + LEAVE singlestep + FI . + +set second breakpoint at branch address : + calculate branch address ; + next free breakpoint ; + set breakpoint (i, next instruction segment, branch address) . + +set breakpoint at branch address : + next instruction := saved word ; + next instruction address := breakpoint address ; + calculate branch address ; + set breakpoint (breakpoint nr, next instruction segment, branch address) . + +set first breakpoint behind branch instruction at return address : + next instruction address := getword (local data segment, + lbas + return address offset) ; + next instruction segment := getword (local data segment, + lbas + return segment offset) AND 3 ; + next instruction := getword (next instruction segment, + next instruction address) ; + IF next instruction segment = 3 + THEN set first breakpoint behind branch instruction + ELSE putline ("Trace beendet.") + FI . + +set second breakpoint at branch address of branch instruction at return address : + set second breakpoint at branch address . + +determine return address : + pause (0) ; (* Local Base fixieren *) + this local base := getword (local data segment, pcb (local base field)) ; + pause (0) ; + lbas := getword (local data segment, this local base + + previous local base offset) ; + c8k := getword (local data segment, this local base + + c8k offset) AND 255 ; + return segment := getword (local data segment, this local base + + return segment offset) ; + return address := getword (local data segment, this local base + + return address offset) ; + packet base := HIGH return segment ; + arith 16 ; + return address DECR 1 ; + arith 15 . + +segment 3 module : + IF saved word = -136 (* LONGA CALL *) + THEN op word := getword (breakpoint segment, breakpoint address ADD 1) + ELSE op word := saved word AND 1023 ; + IF saved word < 0 + THEN op word INCR 1024 + FI ; + FI ; + op word >= 1280 . + +calculate subroutine segment and address : + next instruction segment := 3 ; (* Laeuft nur in Segment 3 ! *) + next instruction address := getword (packet data segment, + begin of module nr link table + op word) ADD 1. + +determine breakpoint nr : + FOR i FROM 1 UPTO nr of breakpoints REP + IF breakpoints (i).set CAND + breakpoints (i).segment = (return segment AND 3) CAND + breakpoints (i).address = return address + THEN breakpoint nr := i ; + breakpoint address := breakpoints (i).address ; + breakpoint segment := breakpoints (i).segment ; + saved word := breakpoints (i).saved word ; + LEAVE determine breakpoint nr + FI + PER ; + put ("Returnaddresse:") ; + out (text (return segment AND 3)) ; + putline (hex16 (return address)) ; + list breakpoints ; + reset breakpoints ; + enablestop ; + errorstop ("Falsche Returnaddresse") . + +calculate branch address : + IF lowbyte replacement possible + THEN branch address := (next instruction address AND -256) OR + (next instruction AND 255) ; + LEAVE calculate branch address + FI ; + branch address := next instruction AND 768 ; + IF branch long + THEN branch address INCR 2048 + FI ; + branch address INCR branch address ; + IF next instruction < 0 + THEN branch address INCR 256 + FI ; + arith 16 ; + branch address INCR (next instruction address AND -256) ; + IF HIGH branch address >= c8k + THEN branch address DECR 4096 + FI ; + arith 15 ; + branch address := (branch address AND -256) OR (next instruction AND 255) . + +lowbyte replacement possible : + (next instruction AND -32000) = 0 . + +branch long : + bit (next instruction, 10) . + +execute saved instruction : + perhaps change error flags ; + putword (local data segment, this local base + return address offset, + return address) ; + putword (local data segment, this local base + return segment offset, + return segment) . + +perhaps change error flags : + IF bit (return segment, 7) AND previous key = "c" + THEN reset bit (return segment, 7) + FI ; + IF bit (return segment, 6) AND previous key = "e" + THEN reset bit (return segment, 6) + ELIF NOT bit (return segment, 6) AND previous key = "d" + THEN set bit (return segment, 6) + FI . + +set breakpoint behind next instruction : + IF is linenumber + THEN read source line + FI ; + set breakpoint (breakpoint nr, next instruction segment, + next instruction address) . + +set breakpoint behind previous call : + return segment := getword (local data segment, + lbas + return segment offset) AND 3 ; + return address := getword (local data segment, + lbas + return address offset) ; + IF return segment = 3 + THEN set breakpoint (breakpoint nr, return segment, return address) + ELSE putline ("Trace beendet.") + FI . + +next free breakpoint : + FOR i FROM 1 UPTO nr of breakpoints REP + IF NOT breakpoints (i).set + THEN LEAVE next free breakpoint + FI + PER ; + putline (""3""7"Alle " + text(nr of breakpoints) + " Breakpoints sind belegt") ; + LEAVE singlestep . + +ENDPROC breakpoint handler ; + +INT OP HIGH (INT CONST word) : + TEXT VAR t := " " ; + replace (t, 1, word) ; + code (t SUB 2) +ENDOP HIGH ; + +PROC reset breakpoints : + FOR i FROM 1 UPTO nr of breakpoints REP + IF breakpoints (i).set + THEN reset breakpoint (i) + ELSE breakpoints (i) := init breakpoint + FI + PER +ENDPROC reset breakpoints ; + +PROC reset breakpoint (INT CONST nr) : + IF nr < 1 OR nr > nr of breakpoints + THEN errorstop ("Unzulaessige Breakpoint Nummer") + ELIF NOT breakpoints (nr).set + THEN display ("Warnung: Breakpoint " + text (nr) + " war nicht gesetzt") + ELSE putword (breakpoints (nr).segment, breakpoints (nr).address, + breakpoints (nr).saved word) ; + breakpoints (nr) := init breakpoint + FI +ENDPROC reset breakpoint ; + +PROC set breakpoint (INT CONST nr, segment, address) : + INT VAR new word ; + IF nr < 1 OR nr > nr of breakpoints + THEN errorstop ("Unzulaessige Breakpoint Nummer") + ELIF breakpoints (nr).set + THEN errorstop ("Breakpoint " + text (nr) + " ist bereits gesetzt") + ELIF segment < 2 OR segment > 3 + THEN errorstop ("Segment " + text (segment) + " ist kein Codesegment") + ELSE breakpoints (nr).segment := segment ; + breakpoints (nr).address := address ; + breakpoints (nr).saved word := get word (segment, address) ; + new word := call opcode + (handler module AND 1023) ; + IF handler module >= 1024 + THEN setbit (new word, 15) + FI ; + putword (segment, address, new word) ; + IF getword (segment, address) <> new word + THEN errorstop ("Addresse Schreibgeschuetzt") + ELSE breakpoints (nr).set := TRUE + FI + FI +ENDPROC set breakpoint ; + +PROC handlers module nr (INT CONST module nr) : + handler module := module nr +ENDPROC handlers module nr ; + +INT PROC handlers module nr : + handler module +ENDPROC handlers module nr ; + +PROC set breakpoint : + handlers module nr (module number ("breakpointhandler", 1)) ; + auto trace := FALSE ; + source file name := "" ; + actual line number := -1 ; + page ; + TEXT VAR object ; + INT VAR object nr ; + put ("Object Name:") ; + getline (object) ; + changeall (object, " ", "") ; + putline ("Objekt von Anfang an abzaehlen") ; + pause (5) ; + help (object) ; + put ("Objekt Nr:") ; + get (object nr) ; + INT VAR code address := code start (object, object nr) ADD 1 ; + naechsten freien breakpoint setzen ; + put ("Breakpoint") ; + put (i) ; + putline ("wurde gesetzt.") . + +naechsten freien breakpoint setzen : + FOR i FROM 1 UPTO nr of breakpoints REP + IF NOT breakpoints (i).set + THEN set breakpoint (i, code segment, code address) ; + LEAVE naechsten freien breakpoint setzen + FI + PER ; + errorstop ("Alle " + text (nr of breakpoints) + " Breakpoints sind belegt"). + +ENDPROC set breakpoint ; + +PROC list breakpoints : + line ; + putline (" No Set Address Word") ; + FOR i FROM 1 UPTO nr of breakpoints REP + put (text (i, 3)) ; + IF breakpoints (i).set + THEN put (" Y ") + ELSE put (" N ") + FI ; + out (text (breakpoints (i).segment)) ; + put (hex16 (breakpoints (i).address)) ; + put(" ") ; + put (hex16 (breakpoints (i).saved word)) ; + line + PER +ENDPROC list breakpoints ; + +ENDPACKET tracer diff --git a/devel/misc/unknown/src/XLIST.ELA b/devel/misc/unknown/src/XLIST.ELA new file mode 100644 index 0000000..4897dab --- /dev/null +++ b/devel/misc/unknown/src/XLIST.ELA @@ -0,0 +1,143 @@ +PACKET xlist DEFINES xlist : (* M. Staubermann, 1.8.0 861203 *) + (* Heapsize korrigiert 870711 *) +DATASPACE VAR ds, act ; + +PROC x list : + ds := nilspace ; + FILE VAR f := sequentialfile (output, ds) ; + headline (f, "Dataspaces:" + text (dataspaces) + + " Speicher:" + text (storage (myself))) ; + disablestop ; + xlist (f) ; + show (f) ; + forget (ds) ; +ENDPROC x list ; + +PROC x list (FILE VAR f) : + INT VAR i, acttype, heapsiz, seiten ; + TEXT VAR name, status ; + FILE VAR f2 ; + ROW 255 STRUCT (TEXT name, status) VAR names ; + + enablestop ; + FOR i FROM 1 UPTO 255 REP + names (i).name := "" ; + names (i).status := "" + PER ; + begin list ; + get list entry (name, status) ; + WHILE name <> "" REP + makeid (old (name)) ; + names (dsnr).name := name ; + names (dsnr).status := status ; + get list entry (name, status) + PER ; + maxlinelength (f, 1000) ; + putline (f, "Datum Status Ds kB Type HeapLines Segs S/L ""Name""/'Headline'"); + line (f) ; + putline (f, " 4 " + text ((pages (4, myself)+1) DIV 2, 5) + + " " + text (heapsize, 3) + " - - -") ; + disablestop ; + FOR i FROM 5 UPTO 255 REP + cout (i) ; + makeid (i) ; + act := reveal ds ; + IF iserror + THEN clearerror + ELSE name := names (i).name ; + status := names (i).status ; + acttype := type (act) ; + names (i).name := "" ; + names (i).status := "" ; + put (f, stat + id + " " + speicher + " " + typ + " " + heap) ; + putline (f, zeilen + " " + segmente + " " + sl percent + dsname) ; + FI ; + forget (act) ; + IF iserror THEN puterror ; clearerror FI + PER . + +dsname : + IF name = "" + THEN IF act type = 1003 + THEN " '" + headline (f2) + "'" + ELSE "" + FI + ELSE " """ + name + """" + FI . + +stat : + IF status = "" + THEN " " + ELSE status + FI . + +typ: + text (act type, 5) . + +id : + text (i, 3) . + +speicher : + seiten := ds pages (act) ; + text ((seiten+1) DIV 2, 5) . + +zeilen : + IF act type <> 1003 THEN " -" + ELSE f2 := sequentialfile (modify, act) ; + text (lines (f2), 4) + FI . + +segmente : + IF act type <> 1003 THEN " -" + ELSE INT CONST segs :: segments (f2) ; + text (segs, 4) + FI . + +sl percent: + IF act type <> 1003 THEN " - " + ELIF segs = 1 THEN " " + ELSE text (int (real (segs) * 100.0 / real (lines (f2))+0.5), 2) + "%" + FI . + +heap : + heapsiz:= heapsize (act) * 2 ; + IF heapsiz >= 2046 + THEN " -" + ELIF act type = 1003 + THEN IF heapsiz < 192 + THEN " 0" + ELSE text ((heapsiz-192) DIV 2, 4) + FI + ELSE INT CONST next page :: next ds page (act, seiten) ; + IF next page < 0 + THEN " 0" + ELIF heapsiz = next page + THEN " 1" + ELSE text ((heapsiz + 1 - next page) DIV 2, 4) + FI + FI . + +ENDPROC x list ; + +PROC make id (DATASPACE CONST ds) : + BOUND INT VAR i := ds +ENDPROC make id ; + +INT PROC dsnr : + INT VAR id ; + id AND 255 +ENDPROC dsnr ; + +PROC makeid (INT CONST nr) : + INT VAR dsid := nr + 256 * index (myself) +ENDPROC makeid ; + +DATASPACE PROC reveal ds : + DATASPACE VAR ds ; ds +ENDPROC reveal ds ; + +INT PROC pages (INT CONST dsnr, TASK CONST task) : + EXTERNAL 88 +ENDPROC pages ; + +ENDPACKET x list ; diff --git a/devel/misc/unknown/src/XSTATUS.ELA b/devel/misc/unknown/src/XSTATUS.ELA new file mode 100644 index 0000000..36abc23 --- /dev/null +++ b/devel/misc/unknown/src/XSTATUS.ELA @@ -0,0 +1,188 @@ +PACKET x taskinfo DEFINES x task status , (* M.Staubermann 1.8.0, 861009*) + x task info : + +INT PROC pcf (TASK CONST t, INT CONST byte) : + TEXT VAR word := " " ; + replace (word, 1, pcb (t, byte DIV 2 + 17)) ; + IF (byte AND 1) = 0 THEN code (word SUB 1) + ELSE code (word SUB 2) + FI +ENDPROC pcf ; + +TEXT PROC xstatus (TASK CONST task, INT CONST depth) : + TEXT VAR zeile := ".................." , + task name := name (task) ; + change (zeile, 1, length (task name) + depth , depth * " " + task name) ; + task name := zeile ; + zeile CAT " " + hex16 (pcb (task, 9)) + "-" + hex8 (pcb (task, 10)) ; + IF bit (pcf (task, 5), 7) (* ^ tasknr & version *) + THEN zeile CAT "x" + ELSE zeile CAT " " + FI ; + IF bit (pcf (task, 5), 0) + THEN zeile CAT "h" (* comflg *) + ELSE zeile CAT " " (* haltprocess liegt an *) + FI ; + zeile CAT status (pcf (task, 6)) ; (* status *) + zeile CAT " " + bin (pcf (task, 7), 3, 7) ; (* statusflags rstflg *) + INT CONST pcf 11 :: pcf (task, 11) ; + IF bit (pcf 11, 7) (* iserror *) + THEN zeile CAT " e" + ELSE zeile CAT " n" + FI ; + IF bit (pcf 11, 6) (* disablestop *) + THEN zeile CAT "d" + ELSE zeile CAT "e" + FI ; + IF bit (pcf 11, 5) (* unbelegt *) + THEN zeile CAT "*" + ELSE zeile CAT " " + FI ; + IF bit (pcf 11, 4) (* arith 16 *) + THEN zeile CAT "u" (* unsigned *) + ELSE zeile CAT "s" (* signed *) + FI ; + zeile CAT " " + text (pcf 11 AND 3) ; (* codesegment *) + zeile CAT hex8 (pcf (task, 10)) + hex8 (pcf (task, 9)) ; (* icount *) + zeile CAT " " + text (pcb (task, 28) AND 15) ; (* heapsegment *) + zeile CAT hex16 (pcb (task, 28) AND -16) ; (* heaptop *) + zeile CAT " " + hex16 (pcb (task, 23)) ; (* mod *) + zeile CAT text (pcb (task, 4), 4) ; (* channel *) + zeile CAT text (pcb (task, 1), 4) ; (* linenr *) + zeile CAT text (pcb (task, 2), 4) ; (* errorline *) + zeile CAT text (pcb (task, 3), 4) ; (* errorcode *) + zeile CAT text (pcb (task, 7), 4) ; (* msgcode *) + zeile CAT " " + hex16 (pcb (task, 8)) ; (* msgds *) + zeile CAT " " + hex16 (pcb (task, 11)) + "-" + hex8 (pcb (task, 12)) ; + zeile CAT " " + hex8 (pcf (task, 29)) ; (* priv *) + zeile CAT " " + hex8 (pcf (task, 14)) ; (* pbas *) (* ^ fromid *) + zeile CAT " " + hex8 (pcf (task, 15)) ; (* c8k *) + zeile CAT " " + hex16 (pcb (task, 25)) ; (* lbas *) + zeile CAT " " + hex16 (pcb (task, 26)) ; (* ltop *) + zeile CAT " " + hex16 (pcb (task, 27)) ; (* ls_top *) + zeile CAT text (pcb (task, 6), 3) ; (* prio *) + zeile CAT " " + hex8 (pcf (task, 28)) ; (* priclk *) + zeile CAT " " + hex8 (pcf (task, 8)) ; (* pricnt *) + zeile CAT " " + hex16(pcb (task, 17)) + hex16 (pcb (task, 18)) ; + zeile CAT " " + hex8 (pcf (task, 4)) ; (* millis *) (* ^ wstate *) + zeile +ENDPROC xstatus ; + +TEXT PROC status (INT CONST wert) : + stat + blocked . + +stat: + SELECT (wert AND 60) DIV 4 OF + CASE 0 : "INTER" + CASE 1 : "OUT " + CASE 2 : "INCHR" + CASE 3 : "PAUSE" + CASE 4 : "RTN T" + CASE 5 : "RTN F" + CASE 6 : "CALL " + CASE 7 : "RTN " + CASE 8 : "CHGB1" + CASE 9 : "CHGB2" + CASE 10: "CHGB3" + CASE 15: IF wert = 255 THEN "-DEAD" ELSE "WAIT " FI + OTHERWISE "?? "+hex8 (wert AND 252) + ENDSELECT . + +blocked: + IF (wert AND 1) = 1 + THEN "-B" + ELSE " " + FI +ENDPROC status ; + +TEXT PROC hex8 (INT CONST wert) : + hex digit (wert DIV 16) + + hex digit (wert AND 15) +ENDPROC hex8 ; + +TEXT PROC hex16 (INT CONST wert) : + TEXT VAR t := " " ; + replace (t, 1, wert) ; + hex digit (code (t SUB 2) DIV 16) + + hex digit (code (t SUB 2) AND 15) + + hex digit (code (t SUB 1) DIV 16) + + hex digit (code (t SUB 1) AND 15) +ENDPROC hex16 ; + +TEXT PROC hex digit (INT CONST wert) : + "0123456789ABCDEF" SUB (wert+1) +ENDPROC hex digit ; + +TEXT PROC bin (INT CONST wert, from, to) : + INT VAR i ; + TEXT VAR t := "" ; + FOR i FROM to DOWNTO from REP + IF bit (wert, i) THEN t CAT "1" + ELSE t CAT "0" + FI + PER ; + t +ENDPROC bin ; + +PROC x task info (FILE VAR list file) : + access catalogue ; + put (list file, date) ; + put (list file, " ") ; + put (list file, time of day) ; + put (list file, " Size:") ; + INT VAR size, used ; + storage (size, used) ; + put (list file, size) ; + put (list file, "K Used:") ; + put (list file, used) ; + put (list file, "K ") ; + line (list file) ; + put (list file, "TASK ") ; + put (list file, "taskid xhstatus rstflg edxa icount hptop mod chn") ; + write (list file, "lin eln ecd mcd mgds fromid prvpbs c8k lbs ltoplstop"); + put (list file, "pripck pct wstate mls") ; + line (list file) ; + list tree (list file, supervisor, 0) +ENDPROC x task info ; + +DATASPACE VAR ds ; +PROC x task info : + disable stop ; + ds := nilspace ; + FILE VAR list file := sequentialfile (output, ds) ; + max line length (list file, 1000) ; + x task info (list file) ; + edit (list file) ; + forget (ds) ; +ENDPROC x task info ; + +PROC list tree (FILE VAR list file, TASK CONST first son, INT CONST depth) : + enable stop ; + TASK VAR actual task := first son ; + WHILE NOT isniltask (actual task) REP + list actual task ; + list tree (list file, son (actual task), depth + 1) ; + actual task := brother (actual task) + PER . + +list actual task : + putline (list file, x status (actual task, depth)) + +ENDPROC list tree ; + +PROC x task status (TASK CONST t) : + TEXT VAR zeile := x status (t, 0) ; + line ; + put ("Task:") ; putline (name (t)) ; + putline ("taskid xhstatus rstflg edxa icount hptop mod chn lin eln ecd") ; + putline (subtext (zeile, 20, 80)) ; + putline ("mcd mgds fromid prvpbs c8k lbs ltoplstoppripck pct wstate mls") ; + putline (subtext (zeile, 81)) ; + line +ENDPROC x task status ; + +PROC x task status : + x task status (myself) +ENDPROC x task status ; + +ENDPACKET x task info ; diff --git a/devel/misc/unknown/src/Z80.ELA b/devel/misc/unknown/src/Z80.ELA new file mode 100644 index 0000000..58e31bf --- /dev/null +++ b/devel/misc/unknown/src/Z80.ELA @@ -0,0 +1,495 @@ +PACKET z80 disassembler DEFINES hex, dez, disassemble, disass , acht : + +LET max = 4096; (* Anzahl Bytes der ROW DIV 2 *) + +BOUND ROW max INT VAR row; + +INT VAR next byte, + next word, + byte, + div 8, + and 7, + and f, + div 10; +TEXT VAR index; + +belegen (0,0,0); + +INT PROC dez (TEXT CONST wert) : + TEXT VAR zahl := wert; + INT VAR i; + REAL VAR summe := 0.0; + IF (zahl SUB 1) = "!" THEN int(subtext(zahl, 2)) + ELIF (zahl SUB 1) = "%" THEN zahl := subtext(zahl, 2); + FOR i FROM length(zahl) DOWNTO 1 REP + summe INCR (2.0**(length(zahl) - i))* real(number) + PER; + IF summe > 32767.0 THEN int (summe - 65536.0) + ELSE int (summe) + FI + ELSE IF (zahl SUB 1) = "$" THEN zahl := subtext(zahl, 2) FI; + FOR i FROM length(zahl) DOWNTO 1 REP + summe INCR (16.0**(length(zahl) - i))* real(number) + PER; + IF summe > 32767.0 THEN int (summe - 65536.0) + ELSE int (summe) + FI + FI. + +number : + IF (zahl SUB i) > "9" + THEN code( zahl SUB i) -55 + ELSE int (zahl SUB i) + FI +ENDPROC dez; + +PROC disassemble (TEXT CONST source code) : + row := old(source code); + INT VAR counter, start, pc, b1, b2, b3, b4, ende; + TEXT VAR addr; + page; + out (" "15" Z80 - DISASSEMBLER "14""13""10""10""); + out ("F r Adressangaben: $ = hex, % = bin r, ! = dezimal."13""10""10""); + out ("Hexadezimale Eingaben mit den Zeichen 0 bis F."13""10""10""); + out ("Disassemblierung mit ESC abbrechen."13""10""10""); + out ("Addresse des ersten Eintrags der Liste:"); + addr:="$0000"; + editget(addr); + start := dez(addr); + REP + REP + out (""10""13""); + out ("Startaddresse f r Disassemblierung :"); + addr:="$0000"; + editget (addr); + pc := dez(addr); + UNTIL positive int (pc) >= positive int (start) PER; + REP + out (""10""13""); + out ("Endaddresse f r Disassemblierung :"); + addr:="$FFFF"; + editget (addr); + out (""10""13""); + ende := dez(addr); + UNTIL positive int (ende) >= positive int (pc) PER; + REP + berechne b1 bis b4; + put (text(hex(pc),4)); + put(""); + dump; + put (" "); + disass (b1, b2, b3, b4, pc); + line; + UNTIL isincharety (""27"") OR positiveint (pc) > positive int (ende) PER + UNTIL no ("Noch weitere Bereiche disassemblieren") PER. + +berechne b1 bis b4 : + counter := pc - start; + b1 := acht (counter ); + b2 := acht (counter + 1); + b3 := acht (counter + 2); + b4 := acht (counter + 3). + +dump : + put ( text(hex(b1),3)+ + text(hex(b2),3)+ + text(hex(b3),3)+ + text(hex(b4),3)); + put (""142"" + ascii(b1) + ascii(b2) + ascii(b3) + ascii(b4) + ""143""); + +ENDPROC disassemble; + +TEXT PROC ascii (INT CONST byte) : + IF (byte MOD 128) < 32 OR (byte MOD 128) = 127 THEN "." + ELSE code(byte) + FI +ENDPROC ascii; + +REAL PROC positive int (INT CONST wert) : + IF wert < 0 THEN real(wert) + 65536.0 + ELSE real(wert) + FI +ENDPROC positive int; + + +INT PROC acht (INT CONST pos) : + IF (pos DIV 2) + 1 > max THEN LEAVE acht WITH 0 FI; + INT CONST word := row (pos DIV 2 + 1); + TEXT VAR w := " "; + replace (w, 1, word) ; + IF (pos MOD 2) = 1 THEN code(w SUB 1) + ELSE code(w SUB 2) + FI +ENDPROC acht; + +TEXT PROC hex (INT CONST zahl) : + IF zahl < 0 + THEN digit (((zahl XOR -1) DIV 4096) XOR 15) + + hex (zahl MOD 4096) + ELIF zahl < 16 + THEN digit (zahl) + ELSE hex (zahl DIV 16) + digit (zahl MOD 16) + FI +ENDPROC hex; + +TEXT PROC digit (INT CONST d) : + IF d < 10 + THEN code(d + 48) + ELSE code(d + 55) + FI +ENDPROC digit; + +PROC belegen (INT CONST b1, b2, b3) : + byte := b1; + next byte := b2; + next word := (code(b3)+code(b2)) ISUB 1; + and 7 := byte AND 7; + and f := byte AND 15; + div 10:= byte DIV 16; + div 8 := byte DIV 8 AND 7; +ENDPROC belegen; + +PROC counter incr 1 (INT CONST b2, b3, b4) : + byte := b2; + next byte := b3; + next word := (code(b4)+code(b3)) ISUB 1; + and 7 := byte AND 7; + and f := byte AND 15; + div 10:= byte DIV 16; + div 8 := byte DIV 8 AND 7; +ENDPROC counter incr 1; + +PROC counter incr 2 (INT CONST b3, b4) : + byte := b3; + next byte := b4; + next word := b4; + and 7 := byte AND 7; + and f := byte AND 15; + div 10:= byte DIV 16; + div 8 := byte DIV 8 AND 7; +ENDPROC counter incr 2; + +PROC disass (INT CONST b1, b2, b3, b4, INT VAR counter): + counter INCR int disass (b1, b2, b3, b4, counter) +ENDPROC disass; + +TEXT PROC arith log : + SELECT div 8 OF + CASE 0 : "ADD" + CASE 1 : "ADC" + CASE 2 : "SUB" + CASE 3 : "SBC" + CASE 4 : "AND" + CASE 5 : "XOR" + CASE 6 : "OR" + CASE 7 : "CP" + OTHERWISE "???" + ENDSELECT + +ENDPROC arith log; + +TEXT PROC reg1 : + SELECT div8 OF + CASE 0 : "B" + CASE 1 : "C" + CASE 2 : "D" + CASE 3 : "E" + CASE 4 : "H" + CASE 5 : "L" + CASE 6 : "(HL)" + CASE 7 : "A" + OTHERWISE "???" + ENDSELECT + +ENDPROC reg1; + +TEXT PROC reg2 : + SELECT and7 OF + CASE 0 : "B" + CASE 1 : "C" + CASE 2 : "D" + CASE 3 : "E" + CASE 4 : "H" + CASE 5 : "L" + CASE 6 : "(HL)" + CASE 7 : "A" + OTHERWISE "???" + ENDSELECT + +ENDPROC reg2; + +TEXT PROC rp: + SELECT div10 AND 3 OF + CASE 0 : "BC" + CASE 1 : "DE" + CASE 2 : "HL" + CASE 3 : "SP" + OTHERWISE "???" + ENDSELECT + +ENDPROC rp; + + +INT PROC bitmanipulation : + SELECT byte DIV 32 OF + CASE 1 : write ("BIT "+text(div8)+","+reg2);2 + CASE 2 : write ("RES "+text(div8)+","+reg2);2 + CASE 3 : write ("SET "+text(div8)+","+reg2);2 + OTHERWISE write("??? $"+hex(next byte));1 + ENDSELECT + +ENDPROC bitmanipulation; + +BOOL PROC is special instruction : + byte > 192 AND (and 7 = 3 OR + and 7 = 6 OR + and f = 9 ) +OR byte < 64 AND (and 7 = 7 OR + and 7 = 0 OR + and 7 = 2 ) . + +ENDPROC is special instruction; + +INT PROC int disass (INT CONST b1, b2, b3, b4, counter) : + belegen (b1, b2, b3); + IF is special instruction + THEN disass special instruction + ELIF div 10 < 4 + THEN lower case instruction + ELIF div 10 < 128 + THEN ld instruction + ELIF div 10 < 192 + THEN arith log instruction + ELSE higher case instruction + FI. + +arith log instruction : + write (arith log+" "+reg 2);1 . + +ld instruction : + write ("LD "+reg 1+","+reg 2);1 . + +condition code : + SELECT div8 OF + CASE 0 : "NZ" + CASE 1 : "Z" + CASE 2 : "NC" + CASE 3 : "C" + CASE 4 : "PO" + CASE 5 : "PE" + CASE 6 : "P" + CASE 7 : "M" + OTHERWISE "???" + ENDSELECT. + +lower case instruction : + IF and f = 1 THEN write ("LD "+rp+",$"+hex(next word));3 + ELIF and 7 = 3 THEN write ("INC "+rp);1 + ELIF and 7 = 4 THEN write ("INC "+reg1);1 + ELIF and 7 = 5 THEN write ("DEC "+reg1);1 + ELIF and 7 = 6 THEN write ("LD "+reg1+",$"+hex(next byte));2 + ELIF and f = 9 THEN write ("ADD HL,"+rp);1 + ELIF and f =11 THEN write ("DEC "+rp);1 + ELSE write ("??? $"+hex(next byte));1 + FI. + +higher case instruction : + SELECT and 7 OF + CASE 0 : write ("RET "+condition code);1 + CASE 1 : write ("POP "+rp);1 + CASE 2 : write ("JP "+condition code+",$"+hex(next word));3 + CASE 4 : write ("CALL "+condition code+",$"+hex(next word));3 + CASE 5 : write ("PUSH "+rp);1 + CASE 7 : write ("RST "+text(div 8));1 + OTHERWISE write ("??? $"+hex(next byte));1 + ENDSELECT. + + +branchaddress : + "$" + hex(counter + displacement) . + +displacement : + IF next byte < 128 + THEN next byte + 2 + ELSE next byte - 254 + FI. + +cb instructions : + counter incr 1 (b2, b3, b4); + SELECT div 8 OF + CASE 0 : write ("RCC "+reg2);2 + CASE 1 : write ("RRC "+reg2);2 + CASE 2 : write ("RL "+reg2);2 + CASE 3 : write ("RR "+reg2);2 + CASE 4 : write ("SLA "+reg2);2 + CASE 5 : write ("SRA "+reg2);2 + CASE 6 : write ("SLL "+reg2);2 + CASE 7 : write ("SLR "+reg2);2 + OTHERWISE bitmanipulation + ENDSELECT . + +disass special instruction : + SELECT byte OF + CASE 0 : write ("NOP");1 + CASE 2 : write ("LD (BC),A");1 + CASE 7 : write ("RLCA");1 + CASE 8 : write ("EX AF,AF'");1 + CASE 10 : write ("LD A,(BC)");1 + CASE 15 : write ("RRCA");1 + CASE 16 : write ("DJNZ "+branchaddress);2 + CASE 18 : write ("LD (DE),A");1 + CASE 23 : write ("RLA");1 + CASE 24 : write ("JR "+branchaddress);2 + CASE 26 : write ("LD A,(DE)");1 + CASE 31 : write ("RRA");1 + CASE 32 : write ("JR NZ,"+branchaddress);2 + CASE 34 : write ("LD ($"+hex (next word)+"),HL");3 + CASE 39 : write ("DAA");1 + CASE 40 : write ("JR Z,"+branchaddress);2 + CASE 42 : write ("LD HL,($"+hex(next word)+")");3 + CASE 47 : write ("CPL");1 + CASE 48 : write ("JR NC,"+branchaddress);2 + CASE 50 : write ("LD ($"+hex(next word)+"),A");3 + CASE 55 : write ("SCF");1 + CASE 56 : write ("JR C,"+branchaddress);2 + CASE 58 : write ("LD A,($"+hex(next word)+")");3 + CASE 63 : write ("CCF");1 + CASE 118: write ("HALT");1 + CASE 195: write ("JP $"+hex(next word));3 + CASE 198: write ("ADD A,$"+hex(next byte));2 + CASE 201: write ("RET");1 + CASE 203: cb instructions + CASE 205: write ("CALL $"+hex(next word));3 + CASE 206: write ("ADC A,$"+hex(next byte));2 + CASE 211: write ("OUT ($"+hex(next byte)+")");2 + CASE 214: write ("SUB A,$"+hex(next byte));2 + CASE 217: write ("EXX");1 + CASE 219: write ("IN ($"+hex(next byte)+")");2 + CASE 221: index := "IX"; dd and fd instructions + CASE 222: write ("SBC A,$"+hex(next byte));2 + CASE 227: write ("EX (SP),HL");1 + CASE 230: write ("AND $"+hex(next byte));2 + CASE 233: write ("JP (HL)");1 + CASE 235: write ("EX DE,HL");1 + CASE 237: ed instructions + CASE 238: write ("XOR $"+hex(next byte));2 + CASE 243: write ("DI");1 + CASE 246: write ("OR $"+hex(next byte));2 + CASE 249: write ("LD SP,HL");2 + CASE 251: write ("EI");1 + CASE 253: index := "IY"; dd and fd instructions + CASE 254: write ("CP $"+hex(next byte));2 + OTHERWISE write ("??? $"+hex(byte));1 + ENDSELECT. + +dd and fd instructions : + counter incr 1 (b2, b3, b4); + SELECT byte OF + CASE 33 : write ("LD "+index+",$"+hex(next word));4 + CASE 34 : write ("LD ($"+hex(next word)+"),"+index);4 + CASE 35 : write ("INC "+index);2 + CASE 42 : write ("LD "+index+",($"+hex(next word)+")");4 + CASE 43 : write ("DEC "+index);2 + CASE 52 : write ("INC ("+index+"+$"+hex(next byte)+")");2 + CASE 53 : write ("DEC ("+index+"+$"+hex(next byte)+")");2 + CASE 203: dd and fd cb instructions + CASE 225: write ("POP "+index);2 + CASE 227: write ("EX (SP),"+index);2 + CASE 229: write ("PUSH "+index);2 + CASE 233: write ("JP ("+index+")");2 + CASE 249: write ("LD SP,"+index);2 + OTHERWISE calculated dd and fd instructions + ENDSELECT. + +calculated dd and fd instructions : + IF andf = 9 THEN write ("ADD "+index+","+rp);2 + ELIF and7 = 6 AND div 10 > 3 AND div 10 < 8 + THEN write ("LD "+reg1+",("+index+"+$"+hex(next byte)+")");3 + ELIF div 10 = 7 AND byte <> 118 + THEN write ("LD ("+index+"+$"+hex(next byte)+"),"+reg2);3 + ELIF and7 = 6 AND div 10 > 7 AND div 10 < 12 + THEN write (arith log+" ("+index+"+$"+hex(next byte)+")");3 + ELSE write ("??? $DD/FD "+hex(byte));2 + FI. + +dd and fd cb instructions : + counter incr 2 (b4, b3); + IF and7 <> 6 THEN write ("??? $DD/FD "+hex(byte));3 + ELSE SELECT div 8 OF + CASE 0 : write ("RLC ("+index+"+$"+hex(next byte)+")");4 + CASE 1 : write ("RRC ("+index+"+$"+hex(next byte)+")");4 + CASE 2 : write ("RL ("+index+"+$"+hex(next byte)+")");4 + CASE 3 : write ("RR ("+index+"+$"+hex(next byte)+")");4 + CASE 4 : write ("SLA ("+index+"+$"+hex(next byte)+")");4 + CASE 5 : write ("SRA ("+index+"+$"+hex(next byte)+")");4 + CASE 6 : write ("SLL ("+index+"+$"+hex(next byte)+")");4 + CASE 7 : write ("SRL ("+index+"+$"+hex(next byte)+")");4 + OTHERWISE dd and fd bitmanipulation + ENDSELECT + FI. + +dd and fd bitmanipulation : + SELECT byte DIV 32 OF + CASE 1 : write ("BIT "+text(div8)+",("+index+"+$"+hex(next byte)+")");4 + CASE 2 : write ("RES "+text(div8)+",("+index+"+$"+hex(next byte)+")");4 + CASE 3 : write ("SET "+text(div8)+",("+index+"+$"+hex(next byte)+")");4 + OTHERWISE write ("??? $DD/FD CB "+hex(next byte)+" "+hex(byte));4 + ENDSELECT. + +ed instructions : + counter incr 1 (b2, b3, b4); + SELECT byte OF + CASE 68 : write ("NEG");2 + CASE 69 : write ("RETN");2 + CASE 70 : write ("IM 0");2 + CASE 71 : write ("LD I,A");2 + CASE 77 : write ("RETI");2 + CASE 79 : write ("LD R,A");2 + CASE 86 : write ("IM 1");2 + CASE 87 : write ("LD A,I");2 + CASE 94 : write ("IM 2");2 + CASE 95 : write ("LD A,R");2 + CASE 103: write ("RRD");2 + CASE 111: write ("RLD");2 + CASE 171: write ("OUTD");2 + CASE 163: write ("OUTI");2 + CASE 179: write ("OTIR");2 + CASE 187: write ("OTDR");2 + OTHERWISE calculate ed instruction + ENDSELECT. + + +ENDPROC int disass ; + +INT PROC calculate ed instruction : + IF and7 = 0 AND is 40 to 7f THEN write ("IN "+reg1+",(C)");2 + ELIF and7 = 1 AND is 40 to 7f THEN write ("OUT "+reg1+",(C)");2 + ELIF andf = 2 AND is 40 to 7f THEN write ("SBC HL,"+rp);2 + ELIF andf = 3 AND is 40 to 7f THEN write ("LD ($"+hex(nextword)+"),"+rp);4 + ELIF andf =11 AND is 40 to 7f THEN write ("LD "+rp+",($"+hex(nextword)+")");4 + ELIF andf =10 AND is 40 to 7f THEN write ("ADC HL,"+rp);2 + ELIF div10 = 10 OR div10 = 11 THEN + IF and7 = 0 THEN write ("LD"+modification);2 + ELIF and7 = 1 THEN write ("CP"+modification);2 + ELIF and7 = 2 THEN write ("IN"+modification);2 + ELSE write ("??? $ED "+hex(next byte));2 + FI + ELSE write ("??? $ED "+hex(next byte));2 + FI. + +is 40 to 7f : + div 10 < 8 AND div 10 > 3. + +modification : + SELECT div8 OF + CASE 0 : "I" + CASE 1 : "D" + CASE 2 : "IR" + CASE 3 : "DR" + OTHERWISE "???" + ENDSELECT. + +ENDPROC calculate ed instruction; + +ENDPACKET z80 disassembler + diff --git a/system/at/unknown/src/AT Generator b/system/at/unknown/src/AT Generator new file mode 100644 index 0000000..c78bdb9 --- /dev/null +++ b/system/at/unknown/src/AT Generator @@ -0,0 +1,134 @@ +(*************************************************************************) +(*** Generiert Fr IBM-AT einen neuen SYSUR-Zweig. ***) +(*** Danach wird die eingebaute Hardwareuhr fr die Systemzeit benutzt ***) +(*** und andere Partitionen knnen mit neuem 'shutup' gebootet werden. ***) +(*** ***) +(*** Autor : W. Sauerwein Stand : 15.07.86 ***) +(*************************************************************************) + +LET ack = 0, + nak = 1; + +cl eop (1, 4); +erzeuge collector; +erzeuge archive manager; +erzeuge operator; +erzeuge configurator; +loesche collector; +forget ("AT Generator", quiet); +break. + +loesche collector : + end (/"colly"); + put ("Collector gelscht."); + line (2). + +erzeuge collector : + put line ("Generating 'Collector'..."); + begin ("colly", PROC generate collector, t); + warte auf meldung; + IF answer = nak THEN end (/"colly"); + errorstop (meldung) + FI. + TASK VAR t. + +erzeuge archive manager : + put line ("Generating 'ARCHIVE'..."); + end (/"ARCHIVE"); + begin ("ARCHIVE", PROC archive manager, t). + +erzeuge operator : + put line ("Generating 'OPERATOR'..."); + end (/"OPERATOR"); + begin ("OPERATOR", PROC monitor, t). + +erzeuge configurator : + put line ("Generating 'configurator'..."); + end (/"configurator"); + begin ("configurator", PROC generate configurator, t); + warte auf meldung; + IF answer = nak THEN errorstop (meldung) FI. + +warte auf meldung : + DATASPACE VAR ds; INT VAR answer; + wait (ds, answer, t); + BOUND TEXT VAR m := ds; + TEXT VAR meldung := m; + forget (ds). + +PROC generate collector : + + disable stop; + fetch all (/"configurator"); + DATASPACE VAR ds := nilspace; + BOUND TEXT VAR m := ds; m := ""; + send (father, mess, ds); + forget (ds); + free global manager. + +mess : IF is error THEN m := error message; + nak + ELSE ack FI. + +END PROC generate collector; + +PROC generate configurator : + + disable stop; + fetch all (/"colly"); + DATASPACE VAR ds := nilspace; + BOUND TEXT VAR m := ds; m := ""; + send (father, mess, ds); + forget (ds); + enable stop; + new configuration; + setup; + global manager (PROC ( DATASPACE VAR, INT CONST, INT CONST, TASK CONST) + configuration manager with time). + +mess : IF is error THEN m := error message; + nak + ELSE ack FI. + +END PROC generate configurator; + +TEXT PROC inverse (TEXT CONST t): + ""15"" + t + " " + ""14"" +END PROC inverse; + +PROC put center (TEXT CONST t): + put center (t, 80) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t): + put center (zeile, t, 80) +END PROC put center; + +PROC put center (TEXT CONST t, INT CONST gesamtbreite): + INT VAR cy; + get cursor (cy, cy); + put center (cy, t, gesamtbreite) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite): + cursor ((gesamtbreite - length (t)) DIV 2, zeile); + put (t). +END PROC put center; + +PROC cl eol: + out (""5"") +END PROC cl eol; + +PROC cl eop: + out (""4"") +END PROC cl eop; + +PROC cl eol (INT CONST cx, cy): + cursor (cx, cy); + cl eol +END PROC cl eol; + +PROC cl eop (INT CONST cx, cy): + cursor (cx, cy); + cl eop +END PROC cl eop; diff --git a/system/at/unknown/src/AT Utilities b/system/at/unknown/src/AT Utilities new file mode 100644 index 0000000..d1c87d5 --- /dev/null +++ b/system/at/unknown/src/AT Utilities @@ -0,0 +1,601 @@ +(*************************************************************************) +(*** AT-spezifische Software, die zum Lesen der Hardwareuhr und ***) +(*** Booten in anderen Partitionen bentigt wird. ***) +(*** ***) +(*** Zusammengestellt und gendert : Werner Sauerwein, GMD ***) +(*** Stand : 17.07.86 ***) +(*************************************************************************) + +PACKET splitting DEFINES low byte, (* Copyright (C) 1985 *) + high byte, (* Martin Schnbeck, Spenge *) + low word, (* Stand: 13.09.85 *) + high word: + +INT PROC high byte (INT CONST value): + + TEXT VAR x := " "; + replace (x, 1, value); + code (x SUB 2) + +END PROC high byte; + +INT PROC low byte (INT CONST value): + + TEXT VAR x := " "; + replace (x, 1, value); + code (x SUB 1) + +END PROC low byte; + +INT PROC high word (REAL CONST double precission int): + + int (double precission int / 65536.0) + +END PROC high word; + +INT PROC low word (REAL CONST double precission int): + + string of low bytes ISUB 1. + +string of low bytes: + code (int (double precission int MOD 256.0)) + + code (int ((double precission int MOD 65536.0) / 256.0)). + +END PROC low word; +END PACKET splitting; + +PACKET basic block io DEFINES + + read block, + write block: + +PROC read block (DATASPACE VAR ds, + INT CONST ds page no, + INT CONST block no, + INT VAR return code): + read block; + retry if read error. + +read block: + block in (ds, ds page no, 0, block no, return code). + +retry if read error: + INT VAR retry; + FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP + reset to block 0 if fifth try; + read block + PER. + +reset to block 0 if fifth try: + IF retry = 5 + THEN block in (ds, ds page no, 0, 0, return code) + FI. + +END PROC read block; + +PROC write block (DATASPACE CONST ds, + INT CONST ds page no, + INT CONST block no, + INT VAR return code): + write block; + retry if write error. + +write block: + block out (ds, ds page no, 0, block no, return code). + +retry if write error: + INT VAR retry; + FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP + reset to block 0 if fifth try; + write block + PER. + +reset to block 0 if fifth try: + IF retry = 5 + THEN disable stop; + DATASPACE VAR dummy ds := nilspace; + block in (dummy ds, 2, 0, 0, return code); + forget (dummy ds); + enable stop + FI. + +END PROC write block; + +PROC read block (DATASPACE VAR ds, INT CONST ds page, + REAL CONST archive block): + + enable stop; + read block (ds, ds page, archive block, error); + INT VAR error; + SELECT error OF + CASE 0: + CASE 1: error stop ("Platte kann nicht gelesen werden"); + CASE 2: error stop ("Lesefehler bei Block "+ text (archive block)); + CASE 3: error stop ("Versorgungsfehler Archiv"); + OTHERWISE error stop ("unbekannter Fehler auf Platte"); + END SELECT; + +END PROC read block; + +PROC write block (DATASPACE CONST ds, INT CONST ds page, + REAL CONST archive block): + + enable stop; + write block (ds, ds page, archive block, error); + INT VAR error; + SELECT error OF + CASE 0: + CASE 1: error stop ("Platte kann nicht geschrieben werden"); + CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block)); + CASE 3: error stop ("Versorgungsfehler Archiv"); + OTHERWISE error stop ("unbekannter Fehler auf Platte"); + END SELECT; + +END PROC write block; + +PROC read block (DATASPACE VAR ds, + INT CONST ds page no, + REAL CONST block no, + INT VAR return code): + read block; + retry if read error. + +read block: + block in (ds, ds page no, high word (block no), + low word (block no), return code). + +retry if read error: + INT VAR retry; + FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP + reset to block 0 if fifth try; + read block + PER. + +reset to block 0 if fifth try: + IF retry = 5 + THEN block in (ds, ds page no, 0, 0, return code) + FI. + +END PROC read block; + +PROC write block (DATASPACE CONST ds, + INT CONST ds page no, + REAL CONST block no, + INT VAR return code): + write block; + retry if write error. + +write block: + block out (ds, ds page no, high word (block no), + low word (block no), return code). + +retry if write error: + INT VAR retry; + FOR retry FROM 1 UPTO 10 WHILE return code = 2 REP + reset to block 0 if fifth try; + write block + PER. + +reset to block 0 if fifth try: + IF retry = 5 + THEN disable stop; + DATASPACE VAR dummy ds := nilspace; + block in (dummy ds, 2, 0, 0, return code); + forget (dummy ds); + enable stop + FI. + +END PROC write block; +END PACKET basic block io; + +(**************************************************************************) + +PACKET part DEFINES activate : (* Copyright (C) 1985 *) + (* Martin Schnbeck, Spenge *) + (* Stand : 02.02.86 *) + (* Changed by : W.Sauerwein *) + (* Stand : 04.07.86 *) + LET fd channel = 28; + +ROW 256 INT VAR boot block; +INT VAR boot block session := session - 1; + +PROC get boot block: + + IF boot block session <> session + THEN hole aktuellen boot block + FI. + +hole aktuellen boot block: + disable stop; + DATASPACE VAR dummy ds := nilspace; + BOUND STRUCT (ALIGN dummy, + ROW 256 INT block) VAR partition table := dummy ds; + get external block (dummy ds, 2, 0, fd channel); + IF NOT is error + THEN transfer data to boot block + FI; + forget (dummy ds). + +transfer data to boot block: + IF not valid boot block + THEN try to get valid boot block from file + FI; + boot block := partition table. block; + boot block session := session. + +not valid boot block: + partition table. block [256] <> boot indicator OR + it is an old boot block of eumel. + +boot indicator: -21931. + +it is an old boot block of eumel: + partition table. block [1] = 1514. + +try to get valid boot block from file: + forget (dummy ds); + partition table := old ("bootblock"); + IF is error THEN LEAVE transfer data to boot block FI. + +END PROC get boot block; + +PROC put boot block: + + IF boot block ist uptodate + THEN schreibe block auf platte + ELSE errorstop ("boot block nicht uptodate") + FI. + +boot block ist uptodate: + boot block session = session. + +schreibe block auf platte: + disable stop; + DATASPACE VAR dummy ds := nilspace; + BOUND STRUCT (ALIGN dummy, + ROW 256 INT block) VAR partition table := dummy ds; + transfer data to dataspace; + put external block (dummy ds, 2, 0, fd channel); + forget (dummy ds). + +transfer data to dataspace: + partition table. block := boot block. + +END PROC put boot block; + +INT PROC partition type (INT CONST partition): + + low byte (boot block [entry (partition) + 2]) + +END PROC partition type; + +PROC activate (INT CONST part type): + + IF partition type exists AND is possible type + THEN deactivate all partitions and + activate desired partition + ELSE errorstop ("Gewnschte Partitionart gibt es nicht") + FI. + +is possible type: + part type > 0 AND + part type < 256. + +partition type exists: + INT VAR partition; + FOR partition FROM 1 UPTO 4 REP + IF partition type (partition) = part type + THEN LEAVE partition type exists WITH TRUE + FI; + PER; + FALSE. + +deactivate all partitions and activate desired partition: + FOR partition FROM 1 UPTO 4 REP + deactivate this partition; + IF partition type (partition) = part type + THEN activate partition + FI + PER; + put boot block. + +deactivate this partition: + set bit (boot block [entry (partition)], 7); + (* first setting needed, because reset bit does xor *) + reset bit (boot block [entry (partition)], 7). + +activate partition: + set bit (boot block [entry (partition)], 7) + +END PROC activate; + +INT PROC entry (INT CONST partition): + + get boot block; + 256 - 5 * 8 + (partition * 8) + +END PROC entry; + +PROC get external block (DATASPACE VAR ds, INT CONST ds page, + archive block, get channel): + + INT VAR old channel := channel; + continue (get channel); + disable stop; + read block (ds, ds page, archive block, error); + INT VAR error; + SELECT error OF + CASE 0: + CASE 1: error stop ("Platte kann nicht gelesen werden"); + CASE 2: error stop ("Lesefehler bei Block "+ text (archive block)); + CASE 3: error stop ("Versorgungsfehler Archiv"); + OTHERWISE error stop ("unbekannter Fehler auf Platte"); + END SELECT; + continue (old channel). + +END PROC get external block; + +PROC put external block (DATASPACE CONST ds, INT CONST ds page, + archive block, get channel): + + INT VAR old channel := channel; + continue (get channel); + disable stop; + write block (ds, ds page, archive block, error); + INT VAR error; + SELECT error OF + CASE 0: + CASE 1: error stop ("Platte kann nicht geschrieben werden"); + CASE 2: error stop ("Schreibfehler bei Block "+ text (archive block)); + CASE 3: error stop ("Versorgungsfehler Archiv"); + OTHERWISE error stop ("unbekannter Fehler auf Platte"); + END SELECT; + continue (old channel). + +END PROC put external block; +END PACKET part; + +(**************************************************************************) + +PACKET hw clock DEFINES hw clock: (* Copyright (C) 1985 *) + (* Martin Schnbeck, Spenge *) +LET clock length = 7, (* Stand: 06.11.85 *) + clock command = 4; + +BOUND STRUCT (ALIGN dummy, + ROW clock length INT clock field) VAR clock data; + +REAL PROC hw clock: + + disable stop; + get clock; + hw date + hw time. + +get clock: + DATASPACE VAR ds := nilspace; + clock data := ds; + INT VAR return code, actual channel := channel; + go to shard channel; + blockin (ds, 2, -clock command, 0, return code); + IF actual channel = 0 THEN break (quiet) + ELSE continue (actual channel) + FI; + IF return code <> 0 + THEN errorstop ("Keine Hardware Uhr vorhanden"); + FI; + put clock into text; + forget (ds). + +put clock into text: + TEXT VAR clock text := clock length * " "; + INT VAR i; + FOR i FROM 1 UPTO clock length REP + replace (clock text, i, clock data. clock field [i]); + PER. + +go to shard channel: + INT VAR retry; + FOR retry FROM 1 UPTO 20 REP + continue (32); + IF is error + THEN clear error; + pause (30) + FI; + UNTIL channel = 32 PER. + +hw date: + date (day + "." + month + "." + year). + +day: subtext (clock text, 7, 8). + +month: subtext (clock text, 5, 6). + +year: subtext (clock text, 1, 4). + +hw time: + time (hour + ":" + minute + ":" + second). + +hour: subtext (clock text, 9, 10). + +minute: subtext (clock text, 11, 12). + +second: subtext (clock text, 13, 14). + +END PROC hw clock; +END PACKET hw clock + +(**************************************************************************) + +PACKET old shutup DEFINES old shutup, (* Copyright (C) 1985 *) + old save system: (* Martin Schnbeck, Spenge *) + (* Stand: 06.11.85 *) +PROC old shutup : shutup END PROC old shutup; + +PROC old save system : save system END PROC old save system; +END PACKET old shutup; + +PACKET new shutup DEFINES shutup, + ms dos, + save system, + generate ms dos manager, + generate shutup manager: + +LET ack = 0; + +PROC shutup: + + system down (PROC old shutup) + +END PROC shutup; + +PROC shutup (INT CONST new system): + + IF new system <> 0 + THEN prepare for new system + FI; + system down (PROC old shutup). + +prepare for new system: + activate (new system); + prepare for rebooting. + +prepare for rebooting: + INT VAR old channel := channel; + continue (32); + INT VAR dummy; + control (-5, 0, 0, dummy); + break (quiet); + continue (old channel). + +END PROC shutup; + +PROC ms dos: + + shutup (1) + +END PROC ms dos; + +PROC save system: + + IF yes ("Leere Floppy eingelegt") + THEN system down (PROC old save system) + FI + +END PROC save system; + +PROC system down (PROC operation): + + BOOL VAR dialogue :: command dialogue; + command dialogue (FALSE); + operation; + command dialogue (dialogue); + IF command dialogue + THEN wait for configurator; + show date; + FI. + +show date: + page; + line (2); + put (" Heute ist der"); putline (date); + put (" Es ist"); put (time of day); putline ("Uhr"); + line (2). + +END PROC system down; + +DATASPACE VAR ds := nilspace; + +PROC wait for configurator: + + INT VAR i, receipt; + FOR i FROM 1 UPTO 20 WHILE configurator exists REP + pause (30); + forget (ds); + ds := nilspace; + ping pong (configurator, ack, ds, receipt) + UNTIL receipt >= 0 PER. + +configurator exists: + disable stop; + TASK VAR configurator := task ("configurator"); + clear error; + NOT is niltask (configurator). + +END PROC wait for configurator; + +PROC generate shutup manager: + + generate shutup manager ("shutup", 0); + +END PROC generate shutup manager; + +PROC generate ms dos manager: + + generate shutup manager ("ms dos", 1); + +END PROC generate ms dos manager; + +PROC generate shutup manager (TEXT CONST name, INT CONST new system): + + TASK VAR son; + shutup question := name; + new system for manager := new system; + begin (name, PROC shutup manager, son) + +END PROC generate shutup manager; + +INT VAR new system for manager; +TEXT VAR shutup question; + +PROC shutup manager: + + disable stop; + command dialogue (TRUE); + REP + break; + line ; + IF yes (shutup question) + THEN clear error; + shutup (new system for manager); + pause (300); + FI; + PER + +END PROC shutup manager; +END PACKET new shutup + +(**************************************************************************) + +PACKET config manager with time DEFINES configuration manager , + configuration manager with time : + (* Copyright (C) 1985 *) +INT VAR old session := 0; (* Martin Schnbeck, Spenge *) + (* Stand: 06.11.85 *) +PROC configuration manager: + + configurate; + break; + global manager (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) + configuration manager with time) + +END PROC configuration manager; + +PROC configuration manager with time (DATASPACE VAR ds, INT CONST order, + phase, TASK CONST order task): + + IF old session <> session + THEN + disable stop; + set clock (hw clock); + set clock (hw clock); (* twice, to avoid all paging delay *) + IF is error THEN IF online THEN put error; clear error; pause (100) + ELSE errorstop (error message) + FI FI; + old session := session; + set autonom; + FI; + configuration manager (ds, order, phase, order task); + +END PROC configuration manager with time; +END PACKET config manager with time; diff --git a/system/at/unknown/src/AT install b/system/at/unknown/src/AT install new file mode 100644 index 0000000..1fedf70 --- /dev/null +++ b/system/at/unknown/src/AT install @@ -0,0 +1,92 @@ +(*************************************************************************) +(*** Insertiert alle notwendigen Pakete, damit ein AT-System generiert ***) +(*** werden kann, das die Hardwareuhr lesen und Partitionen bedienen ***) +(*** kann. Startet den "AT Generator". ***) +(*** ***) +(*** Autor : W. Sauerwein Stand : 15.07.86 ***) +(*************************************************************************) + +erste bildschirmmeldung; +IF ich bin single THEN putline ("Die AT-spezifische Software ist nur auf Multi-User-Systemen benutzbar !") + ELSE hole dateien vom archiv; + insertiere alle pakete; + put line ("Running ""AT Generator""..."); + run ("AT Generator") +FI; +forget ("AT install", quiet). + +ich bin single : (pcb (9) AND 255) <= 1. + +insertiere alle pakete : + insert and say ("AT Utilities"). + +erste bildschirmmeldung : + page; + put center (" Generator fr AT-spezifische Software gestartet."); line; + put center ("--------------------------------------------------"); + line (2). + +hole dateien vom archiv : + TEXT VAR datei; + datei := "AT Utilities"; hole wenn noetig; + datei := "AT Generator"; hole wenn noetig; + release (archive); + line. + +hole wenn noetig : + IF NOT exists (datei) THEN + put line ("Loading """ + datei + """..."); + fetch (datei, archive) + FI. + +PROC insert and say (TEXT CONST datei) : + + INT VAR cx, cy; + put line ("Inserting """ + datei + """..."); + get cursor (cx, cy); + insert (datei); + cl eop (cx, cy); line; + forget (datei, quiet). + +END PROC insert and say; + +TEXT PROC inverse (TEXT CONST t): + ""15"" + t + " " + ""14"" +END PROC inverse; + +PROC put center (TEXT CONST t): + put center (t, 80) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t): + put center (zeile, t, 80) +END PROC put center; + +PROC put center (TEXT CONST t, INT CONST gesamtbreite): + INT VAR cy; + get cursor (cy, cy); + put center (cy, t, gesamtbreite) +END PROC put center; + +PROC put center (INT CONST zeile, TEXT CONST t, INT CONST gesamtbreite): + cursor ((gesamtbreite - length (t)) DIV 2, zeile); + put (t). +END PROC put center; + +PROC cl eol: + out (""5"") +END PROC cl eol; + +PROC cl eop: + out (""4"") +END PROC cl eop; + +PROC cl eol (INT CONST cx, cy): + cursor (cx, cy); + cl eol +END PROC cl eol; + +PROC cl eop (INT CONST cx, cy): + cursor (cx, cy); + cl eop +END PROC cl eop; diff --git a/system/base/unknown/src/SPOLMAN5.ELA b/system/base/unknown/src/SPOLMAN5.ELA new file mode 100644 index 0000000..99d4ec2 --- /dev/null +++ b/system/base/unknown/src/SPOLMAN5.ELA @@ -0,0 +1,1003 @@ +PACKET queue handler DEFINES enter into que, + exists in que, + all in que, + erase from que, + erase last top of que, + get top of que, + restore , + list que, + info, killer,first, + que status, + que empty, + set entry types, + change entry types, + initialize que: + + +LET que size = 100, + + empty = 0, + used = 1, + blocked = 2, + nil = 0, + user error = 99, + unused char = ""0"", + used char = ""1"", + blocked char= ""2"", + ENTRY = STRUCT(TEXT title, TASK origin, TEXT origin name, + DATASPACE space, INT storage, acc code ) ; + +ROW que size ENTRY VAR que ; + +TEXT VAR status list; +BOOL VAR n ok := FALSE; +INT VAR top of que, + first que entry, + last que entry, + index ; + +.entry: que[index]. ; + +PROC initialize que : + FOR index FROM 1 UPTO que size REP + forget( entry.space ); + entry.acc code := empty + END REP ; + first que entry := nil; + last que entry := nil; + top of que := nil; + index := nil; + status list := que size * unused char; +END PROC initialize que ; + +initialize que ; + +(****************** Interne Queue-Zugriffsoperationen **********************) + +INT PROC next (INT CONST pre) : + pre MOD que size + 1 +END PROC next ; + +PROC block (INT CONST entry number) : + que [entry number].acc code := blocked; + replace (status list,entry number,blocked char); +ENDPROC block; + +PROC unblock (INT CONST entry number) : + que [entry number].acc code := used; + replace (status list,entry number,used char); +ENDPROC unblock; + +PROC to next que entry: + REP + IF index = last que entry OR index = nil + THEN index := nil ; LEAVE to next que entry + FI ; + index := next(index) + UNTIL entry.acc code <> empty PER +END PROC to next que entry ; + +PROC to first que entry : + index := first que entry +END PROC to first que entry ; + +PROC search que entry (TEXT CONST title, TASK CONST origin) : + + check if index identifies entry ; + IF last que entry = nil + THEN index := nil + ELSE index := last que entry ; + REPEAT + IF is wanted entry + THEN LEAVE search que entry + FI ; + IF index = first que entry + THEN index := nil + ELSE index DECR 1 ; + IF index = 0 + THEN index := que size + FI + FI + UNTIL index = nil PER + FI. + +is wanted entry: + + entry.acc code <> empty CAND + entry.title = title CAND + (entry.origin = origin OR + origin = niltask ). + +check if index identifies entry: + + IF index <> nil CAND is wanted entry + THEN LEAVE search que entry + FI + +END PROC search que entry ; + +PROC exec erase : + + forget (entry.space) ; entry.acc code := empty ; + replace (status list,index,unused char); + try to cut off queue ends. + +try to cut off queue ends: + + WHILE first entry is not valid REP + check if que empty ; + first que entry := next(first que entry) + END REP ; + WHILE last entry is not valid REP + make index invalid if necessary ; + last que entry DECR 1 ; + IF last que entry = 0 + THEN last que entry := que size + FI + END REP . + +first entry is not valid: + que [first que entry].acc code = empty. + +last entry is not valid: + que [last que entry].acc code = empty. + +check if que empty: + IF first que entry = last que entry + THEN first que entry := nil ; + last que entry := nil ; + index := nil ; + LEAVE try to cut off queue ends + FI. + +make index invalid if necessary: + IF index = last que entry + THEN index := nil + FI. + +END PROC exec erase ; + +PROC exec first: + IF next (last que entry) = first que entry + THEN errorstop ("Queue ist voll - vorziehen unmoeglich") + ELIF index = top of que + THEN errorstop ("Auftrag wird bereits bearbeitet") + ELIF entry.acc code = empty + THEN errorstop ("undefinierter Queue-Eintrag. /exec first") + ELSE first que entry DECR 1 ; + IF first que entry = 0 + THEN first que entry := que size + FI ; + que[first que entry] := que[index] ; + replace (status list,first que entry,code (entry.acc code)); + exec erase + FI +END PROC exec first ; + +PROC erase last top of que: + IF top of que <> nil + THEN index := top of que; exec erase; + top of que := nil + FI +END PROC erase last top of que; + + +(****************** Behandlung von DATASPACE-typen ***********************) + +LET semicolon = ";" , + colon = ":" , + quote = """"; +TEXT VAR entry types :: "" ; + +BOOL PROC no permitted type (DATASPACE CONST ds) : + TEXT CONST type nr :: semicolon + text(type(ds)) + colon; + INT CONST t pos :: pos (entry types,type nr) ; + entry types <> "" CAND t pos = 0 +END PROC no permitted type ; + +TEXT PROC record of que entry: + IF entry.acc code = empty + THEN errorstop ("undefinierter Queue-Eintrag. /record");"" + ELSE TEXT VAR record :: "" ; + record CAT storage in k ; + record CAT type of entry ; + record CAT name of entry ; + record CAT origin of entry ; + IF entry.acc code = blocked THEN record CAT "- blocked -" FI; + record + FI. + +storage in k: + + text (entry.storage,3) + " K ". + +type of entry: + + IF entry types = "" + THEN 12 * "?" + ELSE TEXT CONST type nr :: semicolon + text(type(entry.space)) + colon ; + INT CONST semi colon pos :: pos (entry types, type nr), + start type :: semi colon pos + LENGTH type nr , + end type :: pos(entrytypes,semicolon,starttype)-1; + IF semi colon pos = 0 + THEN 12 * "?" + ELSE text( subtext(entry types, starttype, endtype),12) + FI + FI. + +name of entry: + + text (quote+ entry.title +quote, 20) . + +origin of entry: + + IF entry.origin = niltask + THEN 20 * " " + ELSE text (" TASK: "+entry.origin name,20) + FI + +END PROC record of que entry ; + +PROC set entry types (TEXT CONST t) : + check if void ; + IF first char is no semicolon + THEN entry types := semicolon + ELSE entry types := "" + FI; + entry types CAT t ; + IF last char is no semicolon + THEN entry types CAT semicolon + FI. + +check if void: + IF t = "" + THEN entry types := ""; + LEAVE set entry types + FI. + +first char is no semicolon: + (t SUB 1) <> semicolon. + +last char is no semicolon: + (t SUB length(t)) <> semicolon + +END PROC set entry types ; + +PROC change entry types: + TEXT VAR t :: entry types; + line;putline("Entrytypes :"); + editget(t); + set entry types (t) +END PROC change entry types; + + +(************************ Std Zugriffe auf Queue ***************************) + + +PROC erase from que (TEXT CONST title, TASK CONST origin) : + search que entry (title, origin) ; + IF index = nil + THEN errorstop ("Auftrag existiert nicht. /erase") + ELIF index = top of que + THEN errorstop (user error, "Dieser Auftrag wird bereits bearbeitet") + ELSE exec erase + FI +END PROC erase from que ; + +BOOL PROC exists in que (TEXT CONST title, TASK CONST origin) : + search que entry (title, origin) ; + index <> nil +END PROC exists in que ; + +PROC info (BOOL CONST b) : n ok := b ENDPROC info; + +THESAURUS PROC all in que (TASK CONST origin) : + + THESAURUS VAR result := empty thesaurus ; + to first que entry ; + WHILE index <> 0 REP + IF entry.origin = origin OR origin = niltask + THEN insert (result, entry.title) + FI ; + to next que entry + END REP ; + result + +END PROC all in que ; + +PROC enter into que (TEXT CONST title, TASK CONST origin, + DATASPACE CONST space ): + + IF next(last que entry) = first que entry + THEN errorstop ("Queue zu voll") + ELIF no permitted type (space) OR title = "" + THEN errorstop (user error, "Auftrag wird nicht angenommen") + ELSE last que entry := next(last que entry); + index := last que entry; + entry := ENTRY: + ( title, origin,task name, space, storage(space), used ) ; + IF first que entry = nil + THEN first que entry := 1 + FI ; + replace (status list,last que entry,used char); + FI. + +task name : + TEXT VAR name of task :: name (origin); + IF name of task = "stemmer" AND n ok THEN "stemmi" ELSE name of task FI. + +END PROC enter into que ; + +PROC get top of que (DATASPACE VAR top space) : + forget (top space) ; + IF que empty + THEN errorstop ("kein Auftrag vorhanden. /get") + ELSE erase last top of que; + top of que := first que entry; + IF que [top of que].acc code = blocked THEN + wrap around if necessary + ELSE top space := que [first que entry].space ; FI; + FI . + +wrap around if necessary : + + IF entry is allowed to be printed THEN + give it to spool manager + ELSE enter into end of queue FI. + +entry is allowed to be printed : + pos (status list,used char) = nil. + +give it to spool manager : + top space := que [first que entry].space; + que [first que entry].acc code := used. + +enter into end of queue : + top space := que [first que entry].space; + enter into que (que [first que entry].title,que [first que entry].origin + ,top space); + index := first que entry; + IF entry.acc code = blocked THEN block (index) FI; + get top of que (top space). + +END PROC get top of que ; + +PROC restore: + top of que := nil +END PROC restore ; + +BOOL PROC que empty: (* 'top of que' gilt nicht *) + first que entry = last que entry AND + top of que = last que entry. +END PROC que empty ; + +PROC que status (INT VAR size, TEXT VAR top title, + TASK VAR top origin, TEXT VAR top origin name ): + + size := last que entry - first que entry ; (* geloeschte Eintraege *) + IF size < 0 (* zaehlen mit !! *) + THEN size INCR que size (* (aber nicht 'top' ) *) + FI ; + IF top of que <> nil + THEN top title := que [top of que].title ; + top origin := que [top of que].origin ; + top origin name := que [top of que].origin name + ELSE size INCR 1 ; + top title := "" ; + top origin := niltask ; + top origin name := "" + FI +END PROC que status ; + +TEXT VAR sep :: 79 * "_", record :: "", + ask :: "editieren (e),kopieren (k),loeschen (l)," + + "vorziehen (v),duplizieren (d),"13""10"" + + "print --> quickprint (q),blockieren (b),freigeben (f)," + + "weiter (w) ? "; + +PROC info : + + to first que entry; + WHILE index <> nil REP + record := record of que entry; + WHILE index <> top of que REPEAT + ask user what to do; + out (input char); + exec command + UNTIL command index = 1 PER; + to next que entry; + PER. + +ask user what to do : + + out (""13""10"");out (sep);out (""13""10""13""10""); + out (record); + out (""13""10""10"");out (ask); + INT VAR command index; TEXT VAR input char; + REPEAT + inchar (input char); + command index := pos ("w eklvdqbf",input char); + UNTIL command index > 0 PER. + +exec command : + + SELECT command index OF + CASE 3 : INT VAR old dataspace type := type (entry.space); + type (entry.space,1003); + FILE VAR f :: sequentialfile (modify,entry.space); + edit (f); line (2); + type (entry.space,old dataspace type) + CASE 4 : forget (entry.title,quiet); + copy (entry.space,entry.title); + type (old (entry.title),1003) + CASE 5 : exec erase ;command index := 1 + CASE 6 : exec first ;command index := 1 + CASE 7 : INT VAR dummy no := index; + enter into que (que [dummy no].title,que [dummy no].origin, + que [dummy no].space) + CASE 8 : type (entry.space,1103) ;record := record of que entry; + CASE 9 : block (index) ;record := record of que entry; + CASE 10: unblock (index); record := record of que entry; + ENDSELECT. + +ENDPROC info; + +PROC list que (FILE VAR f, DATASPACE VAR ds) : + open listfile ; + to first que entry ; + WHILE index <> nil REP + TEXT VAR record :: record of que entry ; + IF index = top of que + THEN record := text(record,60) ; + record CAT ""15"wird bearbeitet"14"" + FI ; + putline (f,record) ; + to next que entry + END REP. + +open listfile: + + forget (ds) ; + ds := nilspace ; + f := sequentialfile (output,ds) ; + headline (f, name(myself) + " - Queue") ; + line (f) + +END PROC list que ; + +PROC killer : info ENDPROC killer; +PROC first : info ENDPROC first; + +END PACKET queue handler ; + +(***************************************************************************) +(* Programm zur Verwaltung einer Servertask *) +(* (benutzt 'queue handler') *) +(* Autor: A.Vox *) +(* Stand: 3.6.85 *) +(* *) +(***************************************************************************) +PACKET spool manager DEFINES server status, + server modus, + server task, + server channel, + server routine, + server fail msg, + + log edit, + logline, + logfilename, + check, + feed server if hungry, + check if server vanished, + + spool manager, + get title and origin, + + start, + stop, + pause, + spool info, + list, + spool maintenance: + + + LET user error = 99; + + LET { Status: } { Modus: } + init = 0, active = 0, + work = 1, paused = 1, + wait = 2, stopped = 2, + dead = 3; + + LET cmd form feed = ""12""; + +INT VAR status :: init, + modus :: stopped; + +TASK VAR server :: niltask; +TEXT VAR routine :: "", + fail msg:: ""; +INT VAR channel :: 0; +(************ Globale Variablen fuer alle 'que status'-Aufrufe ************) + +INT VAR que size; +TEXT VAR actual title, + actual origin name; +TASK VAR actual origin; + + +(*********** Zugriffsoperationen auf wichtige Paketvariablen **************) + +TASK PROC servertask : server END PROC servertask; +INT PROC serverstatus : status END PROC serverstatus; +INT PROC servermodus : modus END PROC servermodus; +TEXT PROC serverroutine : routine END PROC serverroutine; +TEXT PROC serverfailmsg : fail msg END PROC serverfailmsg; +INT PROC serverchannel : channel END PROC serverchannel; + +PROC serverroutine (TEXT CONST neu): + routine := neu +END PROC serverroutine; + +PROC serverfailmsg (TEXT CONST neu): + failmsg := neu +END PROC serverfailmsg; + +PROC serverchannel (INT CONST neu): + channel := neu +END PROC serverchannel; + +(************************* Basic Spool Routines ***************************) + +TEXT CONST logfilename :: "Vorkommnisse"; +FILE VAR logfile; + +TEXT VAR fail title :: "" ; +TASK VAR fail origin :: niltask ; +REAL VAR fail time :: 0.0 ; + +PROC logline (TEXT CONST mess): + logfile := sequential file(output, logfilename) ; + clear file if too large ; + put(logfile, date); + put(logfile, time of day); + put(logfile, " : "); + putline(logfile, mess) +END PROC logline ; + +PROC log edit: + enable stop ; + IF NOT exists(logfilename) + THEN errorstop ("keine Eintragungen vorhanden") + ELSE logfile := sequentialfile(modify,logfilename) ; + position to actual page; + edit(logfile); + line (2); + forget (logfilename); + FI. + +position to actual page: + + INT CONST begin of last page :: lines(logfile)-22 ; + logfile := sequential file(modify,logfilename); + IF begin of last page < 1 + THEN toline(logfile,1) + ELSE toline(logfile,begin of last page) + FI + +END PROC logedit; + +PROC clear file if too large: + IF lines(logfile) > 1000 + THEN modify (logfile) ; + toline (logfile, 900) ; + remove (logfile, 900) ; + clear removed (logfile) ; + output (logfile) + FI +END PROC clear file if too large ; + +PROC end server (TEXT CONST mess): + access catalogue; + IF exists (server) CAND son(myself) = server + THEN end(server) + FI; + failtime := clock(1); + que status (que size, fail title, fail origin, actual origin name) ; + logline (mess) ; + IF fail title <> "" + THEN logline(""""+fail title+""" von Task: "+actual origin name) + ELSE logline("kein Auftrag betroffen") + FI ; + status := dead ; + server := niltask +END PROC end server; + +PROC check (TEXT CONST title, TASK CONST origin): + check if server vanished ; + IF less than 3 days ago AND + was failure AND + title matches AND + origin matches + THEN fail origin := myself ; + errorstop (user error, """"+fail title+""" abgebrochen") + FI. + +less than 3 days ago: + clock(1) < fail time + 3.0 * day. + +origin matches: + (origin = fail origin OR origin = niltask). + +title matches: + (title = fail title OR title = ""). + +was failure: + fail title <> "" + +END PROC check ; + +PROC start server: + begin (PROC server start,server) ; + status := init +END PROC start server; + +PROC server start: + disable stop ; + IF channel <> 0 + THEN continue (channel) ; + FI ; + command dialogue (FALSE) ; + out (cmd form feed); + do (routine) ; + IF is error + THEN call(logline code, "Server-Fehler :",father); + call(logline code, error message, father) ; + call(logline code, "Zeile: " + text(errorline) + + " Code: " + text(errorcode) ,father) + ELSE call(logline code, "Ende des Server-Programms erreicht",father) + FI ; + IF online + THEN out (fail msg) + FI ; + call (terminate code,fail msg, father) ; + end (myself) +END PROC server start ; + +PROC check if server vanished: + IF NOT (server = nil task) CAND NOT exists (server) + THEN end server ("Server gestorben :") ; + start server + FI +END PROC check if server vanished; + + +(*************************** Manager Routines *****************************) + + LET ack = 0, + second phase ack = 5, + not existing nak = 6, + + begin code = 4, + fetch code = 11, + save code = 12, + exists code = 13, + erase code = 14, + list code = 15, + all code = 17, + clear code = 18, + release code = 20, + check code = 22, + + terminate code = 25, + logline code = 26, + get title code = 27, + + continue code = 100; + + +DATASPACE VAR packet space ; +INT VAR reply ; +BOUND STRUCT(TEXT f name,a,b) VAR msg ; +.f name: msg.f name. ; + +TEXT VAR save title :: ""; +FILE VAR listfile; + +PROC get title and origin (TEXT VAR title, origin): + forget (packet space) ; + packet space := nilspace ; + call (father, get title code, packet space, reply) ; + IF reply = ack + THEN msg := packet space ; + title := msg.f name ; + origin := msg.a ; + forget (packet space) + ELSE forget (packet space) ; + errorstop ("'get title' nicht erfolgreich. Antwort="+text(reply)) + FI +END PROC get title and origin; + +PROC feed server if hungry: + check if server vanished ; + IF status = wait AND NOT que empty + THEN get top of que (packet space) ; + send (server, ack, packet space, reply) ; + forget (packet space) ; + IF reply = ack + THEN status := work + ELSE restore ; + end server ("Server nimmt keinen Auftrag an") ; + start server + FI + FI +ENDPROC feed server if hungry; + +PROC server request (DATASPACE VAR ds, INT CONST order, phase) : + + enable stop ; + msg := ds ; + SELECT order OF + CASE terminate code: terminate + CASE logline code: logline (f name) ;send(server, ack, ds) + CASE get title code: send title + OTHERWISE + IF order = fetch code CAND f name = "-" + THEN send top of que + ELSE freemanager (ds,order,phase,server) + FI + END SELECT ; + forget(ds). + +terminate: + end server ("Server terminiert :") ; + start server. + +send title: + forget (ds) ; + ds := nilspace ; + msg := ds ; + que status (que size, msg.f name, actual origin, msg.a) ; + send (server, ack, ds). + +send top of que: + status := wait ; + erase last top of que ; + IF modus = active + THEN feed server if hungry + FI + +END PROC server request; + +PROC spool manager(DATASPACE VAR ds, INT CONST order, phase, + TASK CONST order task) : + + IF ordertask < myself + THEN server request (ds,order,phase) + ELIF ordertask = supervisor + THEN system request + ELSE spool command (ds,order,phase,order task) + FI; + check storage; + error protocol. + +check storage: + INT VAR size, used; + storage(size,used); + IF used > size + THEN logline("Speicher-Engpass :"); + initialize que; + logline("Queue geloescht !!"); + stop + FI. + +error protocol: + IF is error AND error code <> user error + THEN logline ("Spool-Fehler :") ; + logline (errormessage) ; + logline (" Zeile: " + text(errorline) + + " Code: " + text(errorcode) ) + FI. + +system request: + IF order > continue code + THEN call (supervisor,order,ds,reply) ; + forget(ds) ; + IF reply = ack + THEN spool maintenance + FI + FI + +END PROC spool manager; + +PROC spool command (DATASPACE VAR ds, INT CONST order, phase, + TASK CONST order task): + + enable stop ; + check if server vanished ; + msg := ds ; + SELECT order OF + CASE begin code : special begin + CASE fetch code: y get logfile + CASE save code : y save + CASE exists code: y exists + CASE erase code: y erase + CASE list code: y list + CASE all code: y all + CASE release code, + clear code: y restart + CASE check code: y check + OTHERWISE errorstop (user error, "Kein Kommando fuer SPOOLER") + END SELECT. + +special begin : + INT VAR dummy; + call (public,begin code,ds,dummy); + send (order task,ack,ds). + +y get logfile: + forget(ds) ; + ds := old(logfilename) ; + send (ordertask, ack, ds). + +y erase: + IF NOT exists in que (f name,ordertask) + THEN manager message(""""+f name+""" steht nicht in der Queue") + ELIF phase = 1 + THEN manager question (""""+f name+""" aus der Queue loeschen") + ELSE erase from que (f name,ordertask) ; + send (ordertask, ack, ds) + FI. + +y save: + IF phase = 1 + THEN save title := f name ; + send (order task,second phase ack,ds); + ELSE enter into que (save title, ordertask, ds) ; + IF modus = active + THEN feed server if hungry + FI ; + send (order task,ack,ds); + FI. + +y list: + list que (listfile,ds) ; + send (ordertask, ack, ds). + +y all: + forget(ds) ; + ds := nilspace ; + BOUND THESAURUS VAR all names := ds ; + all names := all in que (ordertask) ; + send (ordertask, ack, ds). + +y exists: + IF exists in que (f name,ordertask) + THEN send (ordertask, ack, ds) + ELSE send (ordertask, not existing nak, ds) + FI. + +y check: + check (f name,ordertask) ; + questatus (que size, actual title, actual origin, actual origin name) ; + IF there is a title AND + is actual origin AND + is actual title + THEN manager message (""""+f name+""" wird soeben bearbeitet") + ELIF exists in que (f name,ordertask) + THEN manager message (""""+f name+""" steht noch in der Queue") + ELSE errorstop (usererror, """"+f name+""" steht nicht in der Queue") + FI. + + there is a title: actual title <> "" . + is actual origin: ordertask = actual origin . + is actual title : (f name = "" OR f name = actual title) . + +y restart: + questatus (que size, actual title, actual origin, actual origin name) ; + IF actual origin = ordertask + THEN IF phase = 1 + THEN manager question (""""+actual title+""" unterbrechen") + ELSE end server ("unterbrochen durch Auftraggeber :") ; + start server ; + IF order = clear code + THEN restore + ELSE erase last top of que + FI ; + manager message ("Auftrag unterbrochen") + FI + ELSE errorstop (usererror, "kein eigener Auftrag") + FI + +END PROC spool command ; + +PROC start: + IF modus = stopped + THEN start server ; + modus := active; + message ("Server aktiviert") + ELIF modus = paused + THEN modus := active ; + message ("'Pause'-Modus zurueckgesetzt") ; + feed server if hungry + ELSE message ("Server bereits aktiv") + FI +END PROC start; + +PROC stop: + IF modus <> stopped + THEN end server ("Gestoppt :"); + modus := stopped ; + status := init ; + message ("Server gestoppt") + ELSE message ("Server bereits gestoppt") + FI +END PROC stop; + +PROC pause: + IF modus = active + THEN modus := paused ; + message ("'Pause'-Modus gesetzt") + ELIF modus = paused + THEN message ("'Pause'-Modus bereits gesetzt") + ELSE errorstop ("Server ist gestoppt") + FI +END PROC pause; + +PROC message (TEXT CONST mess): + say(""13""10"") ; + say(mess) ; + say(""13""10"") +END PROC message ; + +PROC list: + list que(listfile,packet space) ; + show(listfile) +END PROC list; + +PROC spool maintenance: + command dialogue (TRUE); + IF exists(logfilename) + THEN logedit + FI; + WHILE online REP + get command ("gib spool kommando :") ; + do command + END REP ; + command dialogue (FALSE) ; + break ; + set autonom +END PROC spool maintenance ; + +PROC spoolinfo: + check if server vanished ; + que status (que size, actual title, actual origin, actual origin name) ; + line(2) ; + putline("Queue :") ; + put("Auslastung :");put(que size); line; + IF actual title <> "" + THEN put("Aktueller Auftrag :");putline(actual title); + put(" von Task :");putline(actual origin name) + FI ; + line ; + putline("Server :"); + put("Status :"); + SELECT status OF + CASE init : putline("initialisiert") + CASE work : putline("arbeitet") + CASE wait : putline("wartet") + OTHERWISE putline("gestorben") + END SELECT ; + put("Modus :"); + SELECT modus OF + CASE active : putline("aktiv") + CASE paused : putline("pausierend") + OTHERWISE putline("gestoppt") + END SELECT ; + put("Kanal :");put(pcb(server,4)); + line(2) +END PROC spool info + +END PACKET spool manager; + diff --git a/system/base/unknown/src/STD.ELA b/system/base/unknown/src/STD.ELA new file mode 100644 index 0000000..047db9a --- /dev/null +++ b/system/base/unknown/src/STD.ELA @@ -0,0 +1,220 @@ +PACKET command dialogue DEFINES (* Autor: J.Liedtke *) + (* Stand: 26.04.82 *) + command dialogue , + say , + yes , + no , + param position , + last param : + + +LET up = ""3"" , + right = ""2"" , + param pre = " (""" , + param post = """)"13""10"" ; + +TEXT VAR std param := "" ; + +BOOL VAR dialogue flag := TRUE ; + +INT VAR param x := 0 ; + + +BOOL PROC command dialogue : + dialogue flag +ENDPROC command dialogue ; + +PROC command dialogue (BOOL CONST status) : + dialogue flag := status +ENDPROC command dialogue ; + + +BOOL PROC yes (TEXT CONST question) : + + IF dialogue flag + THEN ask question + ELSE TRUE + FI . + +ask question : + put (question) ; + skip previous input chars ; + put ("(j/n) ?") ; + get answer ; + IF correct answer + THEN putline (answer) ; + positive answer + ELSE out (""7"") ; + LENGTH question + 9 TIMESOUT ""8"" ; + yes (question) + FI . + +get answer : + TEXT VAR answer ; + inchar (answer) . + +correct answer : + pos ("jnyJNY", answer) > 0 . + +positive answer : + pos ("jyJY", answer) > 0 . + +skip previous input chars : + REP UNTIL incharety = "" PER . + +ENDPROC yes ; + +BOOL PROC no (TEXT CONST question) : + + NOT yes (question) + +ENDPROC no ; + +PROC say (TEXT CONST message) : + + IF dialogue flag + THEN out (message) + FI + +ENDPROC say ; + +PROC param position (INT CONST x) : + + param x := x + +ENDPROC param position ; + +TEXT PROC last param : + + IF param x > 0 + THEN out (up) ; + param x TIMESOUT right ; + out (param pre) ; + out (std param) ; + out (param post) + FI ; + std param + +ENDPROC last param ; + +PROC last param (TEXT CONST new) : + std param := new +ENDPROC last param ; + +ENDPACKET command dialogue ; + + +PACKET input DEFINES (* Stand: 01.05.81 *) + + get , + getline , + get secret line : + + +LET cr = ""13"" , + esc = ""27"" , + rubout = ""12"" , + bell = ""7"" , + back blank back = ""8" "8"" , + del line cr lf = ""5""13""10"" ; + +PROC get (TEXT VAR word) : + + REP + get (word, " ") + UNTIL word <> "" AND word <> " " PER ; + delete leading blanks . + +delete leading blanks : + WHILE (word SUB 1) = " " REP + word := subtext (word,2) + PER . + +ENDPROC get ; + +PROC get (TEXT VAR word, TEXT CONST separator) : + + word := "" ; + feldseparator (separator) ; + editget (word) ; + feldseparator ("") ; + echoe last char + +ENDPROC get ; + +PROC echoe last char : + + TEXT CONST last char := feldzeichen ; + IF last char = ""13"" + THEN out (""13""10"") + ELSE out (last char) + FI + +ENDPROC echoe last char ; + +PROC get (TEXT VAR word, INT CONST length) : + + word := "" ; + feldseparator ("") ; + editget (word, length, length) ; + echoe last char + +ENDPROC get ; + +PROC getline (TEXT VAR line ) : + + line := "" ; + feldseparator ("") ; + editget (line) ; + echoe last char + +ENDPROC getline ; + +PROC get secret line (TEXT VAR line) : + + TEXT VAR char ; + line := "" ; + get start cursor position ; + get line very secret ; + IF char = esc + THEN get line little secret + FI ; + cursor to start position ; + out (del line cr lf) . + +get line very secret : + REP + inchar (char) ; + IF char = esc OR char = cr + THEN LEAVE get line very secret + ELIF char = rubout + THEN delete last char + ELIF char >= " " + THEN line CAT char ; + out (".") + ELSE out (bell) + FI + PER . + +delete last char : + IF LENGTH line = 0 + THEN out (bell) + ELSE out (back blank back) ; + delete char (line, LENGTH line) + FI . + +get line little secret : + feldseparator ("") ; + cursor to start position ; + editget (line) . + +get start cursor position : + INT VAR x, y; + get cursor (x, y) . + +cursor to start position : + cursor (x, y) . + +ENDPROC get secret line ; + +ENDPACKET input ; diff --git a/system/base/unknown/src/STDPLOT.ELA b/system/base/unknown/src/STDPLOT.ELA new file mode 100644 index 0000000..be55e33 --- /dev/null +++ b/system/base/unknown/src/STDPLOT.ELA @@ -0,0 +1,365 @@ +PACKET std plot DEFINES (* J. Liedtke 06.02.81 *) + (* H.Indenbirken, 19.08.82 *) + transform, + set values, + + clear , + begin plot , + end plot , + dir move, + dir draw , + pen, + pen info : + +LET pen down = "*"8"" , + y raster = 43, + display hor = 78.0, + display vert = 43.0; + +INT CONST up := 1 , + right := 1 , + down := -1 , + left := -1 ; + +REAL VAR h min limit :: 0.0, h max limit :: display hor, + v min limit :: 0.0, v max limit :: display vert, + h :: display hor/2.0, v :: display vert/2.0, + size hor :: 23.5, size vert :: 15.5; + +ROW 5 ROW 5 REAL VAR p :: ROW 5 ROW 5 REAL : + (ROW 5 REAL : (1.0, 0.0, 0.0, 0.0, 0.0), + ROW 5 REAL : (0.0, 1.0, 0.0, 0.0, 0.0), + ROW 5 REAL : (0.0, 0.0, 1.0, 0.0, 0.0), + ROW 5 REAL : (0.0, 0.0, 0.0, 1.0, 0.0), + ROW 5 REAL : (0.0, 0.0, 0.0, 0.0, 1.0)); +ROW 5 ROW 5 REAL VAR result; +INT VAR i, j; + +ROW 5 ROW 5 REAL OP * (ROW 5 ROW 5 REAL CONST l, r) : + ROW 5 ROW 5 REAL VAR erg; + FOR i FROM 1 UPTO 5 + REP FOR j FROM 1 UPTO 5 + REP erg [i] [j] := zeile i mal spalte j + PER + PER; + erg . + +zeile i mal spalte j : + INT VAR k; + REAL VAR summe :: 0.0; + FOR k FROM 1 UPTO 5 + REP summe INCR zeile i * spalte j PER; + summe . + +zeile i : l [i] [k] . + +spalte j : r [k] [j] . + +END OP *; + +PROC set values (ROW 3 ROW 2 REAL CONST size, + ROW 2 ROW 2 REAL CONST limits, + ROW 3 REAL CONST angles, + ROW 2 REAL CONST oblique, + ROW 3 REAL CONST perspective) : + norm p; + set views; + calc two dim extrema; + calc limits; + calc result values . + +norm p : + p := ROW 5 ROW 5 REAL : + (ROW 5 REAL : (1.0/dx, 0.0, 0.0, 0.0, 0.0), + ROW 5 REAL : ( 0.0, 1.0/dy, 0.0, 0.0, 0.0), + ROW 5 REAL : ( 0.0, 0.0, 1.0/dz, 0.0, 0.0), + ROW 5 REAL : ( 0.0, 0.0, 0.0, 1.0, 0.0), + ROW 5 REAL : (size [1][1]/dx, size [2][1]/dy, + size [3][1]/dz, 0.0, 1.0)) . + +dx : size [1][2] - size [1][1] . +dy : size [2][2] - size [2][1] . +dz : size [3][2] - size [3][1] . + +set views : + REAL VAR sin a := sind (angles [1]), cos a := cosd (angles [1]), + sin p := sind (angles [2]), cos p := cosd (angles [2]), + sin t := sind (angles [3]), cos t := cosd (angles [3]), + norm a :: oblique [1] * p [1][1], + norm b :: oblique [2] * p [2][2], + norm cx :: perspective [1] * p [1][1], + norm cy :: perspective [2] * p [2][2], + norm cz :: perspective [3] * p [3][3]; + + result := ROW 5 ROW 5 REAL : + (ROW 5 REAL : (cos p*cos t, -sin p, cos p*sin t, 0.0, 0.0), + ROW 5 REAL : (sin p*cos t, cos p, sin p*sin t, 0.0, 0.0), + ROW 5 REAL : ( -sin t, 0.0, cos t, 0.0, 0.0), + ROW 5 REAL : ( 0.0, 0.0, 0.0, 1.0, 0.0), + ROW 5 REAL : ( 0.0, 0.0, 0.0, 0.0, 1.0)); + p := p*result; + + + result := ROW 5 ROW 5 REAL : + (ROW 5 REAL : ( 1.0, 0.0, 0.0, 0.0, 0.0), + ROW 5 REAL : ( 0.0, 1.0, 0.0, 0.0, 0.0), + ROW 5 REAL : ( norm a, norm b, 0.0, norm cz, 0.0), + ROW 5 REAL : (-norm cx, -norm cy, 0.0, 1.0, 0.0), + ROW 5 REAL : ( 0.0, 0.0, 0.0, 0.0, 1.0)); + p := p * result; + + result := ROW 5 ROW 5 REAL : + (ROW 5 REAL : (cos a,-sin a, 0.0, 0.0, 0.0), + ROW 5 REAL : (sin a, cos a, 0.0, 0.0, 0.0), + ROW 5 REAL : ( 0.0, 0.0, 1.0, 0.0, 0.0), + ROW 5 REAL : ( 0.0, 0.0, 0.0, 1.0, 0.0), + ROW 5 REAL : ( 0.0, 0.0, 0.0, 0.0, 1.0)); + p := p * result . + +calc two dim extrema : + REAL VAR max x :: - max real, min x :: max real, + max y :: - max real, min y :: max real, x, y; + + transform (size [1][1], size [2][1], size [3][1], x, y); + extrema; + transform (size [1][2], size [2][1], size [3][1], x, y); + extrema; + transform (size [1][2], size [2][2], size [3][1], x, y); + extrema; + transform (size [1][1], size [2][2], size [3][1], x, y); + extrema; + transform (size [1][1], size [2][1], size [3][2], x, y); + extrema; + transform (size [1][2], size [2][1], size [3][2], x, y); + extrema; + transform (size [1][2], size [2][2], size [3][2], x, y); + extrema; + transform (size [1][1], size [2][2], size [3][2], x, y); + extrema . + +extrema : + min x := min (min x, x); + max x := max (max x, x); + + min y := min (min y, y); + max y := max (max y, y) . + +calc limits : + IF all limits smaller than 2 + THEN prozente + ELSE zentimeter FI . + +all limits smaller than 2 : + limits [1][2] < 2.0 AND limits [2][2] < 2.0 . + +prozente : + h min limit := limits [1][1] * display hor * (size vert/size hor); + h max limit := limits [1][2] * display hor * (size vert/size hor); + + v min limit := limits [2][1] * display vert; + v max limit := limits [2][2] * display vert . + +zentimeter : + h min limit := display hor * (limits [1][1]/size hor); + h max limit := display hor * (limits [1][2]/size hor); + + v min limit := display vert * (limits [2][1]/size vert); + v max limit := display vert * (limits [2][2]/size vert) . + +calc result values : + REAL VAR sh := (h max limit - h min limit) / (max x - min x), + sv := (v max limit - v min limit) / (max y - min y), + dh := h min limit - min x*sh, + dv := v min limit - min y*sv; + + result := ROW 5 ROW 5 REAL : + (ROW 5 REAL : ( sh, 0.0, 0.0, 0.0, 0.0), + ROW 5 REAL : (0.0, sv, 0.0, 0.0, 0.0), + ROW 5 REAL : (0.0, 0.0, 1.0, 0.0, 0.0), + ROW 5 REAL : (0.0, 0.0, 0.0, 1.0, 0.0), + ROW 5 REAL : ( dh, dv, 0.0, 0.0, 1.0)); + p := p * result . + +END PROC set values; + +PROC transform (REAL CONST x, y, z, REAL VAR h, v) : + REAL CONST w :: 1.0/(x*p [1][4] + y*p [2][4] + z*p [3][4] + p [4][4]); + + h := (x*p [1][1]+y*p [2][1]+z*p [3][1]+p [4][1])*w + p [5][1]; + v := (x*p [1][2]+y*p [2][2]+z*p [3][2]+p [4][2])*w + p [5][2]; +END PROC transform; + +(************************** Eigentliches plot *************************) +INT VAR x pos := 0 , + y pos := 0 , + new x pos , + new y pos ; + +ROW 24 TEXT VAR display; +clear ; + +PROC clear : + + INT VAR i; + display (1) := 79 * " " ; + FOR i FROM 2 UPTO 24 + REP display [i] := display [1] + PER; + out (""6""2""0""4"") + +END PROC clear ; + +PROC begin plot : + + cursor (x pos + 1, 24 - (y pos) DIV 2 ) + +ENDPROC begin plot ; + +PROC end plot : + +ENDPROC end plot ; + +PROC dir move (REAL CONST x, y, z) : + transform (x, y, z, h, v); + move (round (h), round (v)) + +END PROC dir move; + +PROC move (INT CONST x val, y val) : + + x pos := x val; + y pos := y val + +ENDPROC move ; + +PROC dir draw (REAL CONST x, y, z) : + transform (x, y, z, h, v); + draw (round (h), round (v)) + +END PROC dir draw; + +PROC draw (INT CONST x val, y val) : + + new x pos := x val; + new y pos := y val; + + plot vector (new x pos - x pos, new y pos - y pos) ; + +END PROC draw ; + +PROC dir draw (TEXT CONST text, REAL CONST angle, height) : + out (""6""); + out (code (23 - (y pos DIV 2))); + out (code (x pos)); + + out (text) + +END PROC dir draw; + +INT VAR act no :: 1, act thickness :: 1, act line type :: 1; + +PROC pen (INT CONST no, thickness, line type) : + act no := no; + act thickness := thickness; + act line type := line type + +ENDPROC pen ; + +PROC pen info (INT VAR no, thickness, line type) : + no := act no; + thickness := act thickness; + line type := act line type + +END PROC pen info; + +PROC plot vector (INT CONST dx , dy) : + + IF dx >= 0 + THEN IF dy > dx THEN vector (y pos, x pos, dy, dx, up, right) + ELIF dy > 0 THEN vector (x pos, y pos, dx, dy, right, up) + + ELIF dy > -dx THEN vector (x pos, y pos, dx, -dy, right, down) + ELSE vector (y pos, x pos, -dy, dx, down, right) + FI + ELSE IF dy > -dx THEN vector (y pos, x pos, dy, -dx, up, left) + ELIF dy > 0 THEN vector (x pos, y pos, -dx, dy, left, up) + + ELIF dy > dx THEN vector (x pos, y pos, -dx, -dy, left, down) + ELSE vector (y pos, x pos, -dy, -dx, down, left) + FI + FI . + +ENDPROC plot vector ; + +PROC vector (INT VAR x pos, y pos; INT CONST dx, dy, right, up) : + + prepare first step ; + INT VAR i ; + FOR i FROM 1 UPTO dx REP + do one step + PER . + +prepare first step : + point; + INT VAR old error := 0 , + up right error := dy - dx , + right error := dy . + +do one step : + IF right is better + THEN do right step + ELSE do up right step + FI . + +right is better : + abs (old error + right error) < abs (old error + up right error) . + +do upright step : + x pos INCR right ; + y pos INCR up ; + point ; + old error INCR upright error . + +do right step : + x pos INCR right ; + point ; + old error INCR right error . + +ENDPROC vector ; + + +PROC point : + INT CONST line :: y pos DIV 2; + BOOL CONST above :: (y pos MOD 2) = 1; + TEXT CONST point :: display [line+1] SUB (x pos+1), + new point :: calculated point; + + replace (display [line+1], x pos+1, new point); + out (""6"") ; + out (code (23-line)) ; + out (code (x pos)) ; + out (new point) . + +calculated point : + IF above + THEN IF point = "," OR point = "|" + THEN "|" + ELSE "'" FI + ELSE IF point = "'" OR point = "|" + THEN "|" + ELSE "," FI + FI + +END PROC point; + +REAL CONST real max int := real (max int); +INT PROC round (REAL CONST x) : + IF x > real max int + THEN max int + ELIF x < 0.0 + THEN 0 + ELSE int (x + 0.5) FI + +END PROC round; + +ENDPACKET std plot ; diff --git a/system/base/unknown/src/bildeditor b/system/base/unknown/src/bildeditor new file mode 100644 index 0000000..c84a300 --- /dev/null +++ b/system/base/unknown/src/bildeditor @@ -0,0 +1,722 @@ + +PACKET b i l d e d i t o r DEFINES (* Autor: P.Heyderhoff *) + (*****************) (* Stand: 06.02.82 *) + (* Vers.: 1.6.0 *) + bildeditor, (* test des bildeditors, *) + schreiberlaubnis, + zeile unveraendert, + feldanfangsmarke, + bildmarksatz, + bildeinfuegen, + bildneu, + bildzeile, + bildmarke, + bildstelle, + bildlaenge, + bildmaxlaenge, + bildsatz, + bildrand : + + +LET anker = 2, freianker = 1, satzmax = 4075, + DATEI = ROW satzmax STRUCT (INT nachfolger, vorgaenger, index, + fortsetzung, TEXT inhalt); + +INT VAR stelle :: anker, marke :: 0, satz :: 1, zeile :: 1, + zeilen :: 0, maxlaenge :: 23, laenge :: maxlaenge, rand :: 0, + marksatz :: 0, alte feldstelle :: 1, alte feldmarke :: 0; + +TEXT VAR kommando :: "", teil :: "", zeichen :: ""; + +BOOL VAR neu :: TRUE, zeileneu :: TRUE, ueberschriftneu :: FALSE, + einfuegen :: FALSE, schreiben erlaubt :: TRUE; + +LET hop mark rubout up down cr = ""1""16""12""3""10""13"", + hop cr mark down up right rubin = ""1""13""16""10""3""2""11"", + hop rubin rubout down up cr tab esc = ""1""11""12""10""3""13""9""27"", + blank = " ", hop = ""1"", clear eop = ""4"", clear eol = ""5"", + left = ""8"", right = ""2"", up = ""3"", down = ""10"", bell = ""7"", + tab = ""9"", cr = ""13"", escape = ""27"", begin mark = ""15"", + end mark = ""14"", hoechstes steuerzeichen = ""31"", escape q = ""27"q", + rubin = ""11"", mark = ""16"", down clear eol = ""10""5""; + +(****************** z u g r i f f s p r o z e d u r e n ******************) + +BOOL PROC schreiberlaubnis : + schreiben erlaubt +END PROC schreiberlaubnis; + +PROC schreiberlaubnis (BOOL CONST b) : + schreiben erlaubt := b +END PROC schreiberlaubnis; + +BOOL PROC bildneu : + neu +END PROC bildneu; + +PROC bildneu (BOOL CONST b) : + neu := b +END PROC bildneu; + +PROC bildeinfuegen (BOOL CONST b): + einfuegen := b +END PROC bildeinfuegen; + +INT PROC bildmarke : + marke +END PROC bildmarke; + +PROC bildmarke (INT CONST i) : + marke := i +END PROC bildmarke; + +INT PROC feldanfangsmarke : + alte feldmarke +END PROC feldanfangsmarke; + +PROC feldanfangsmarke (INT CONST i) : + alte feldmarke := i +END PROC feldanfangsmarke; + +INT PROC bildstelle : + stelle +END PROC bildstelle; + +PROC bildstelle (INT CONST i) : + stelle := i +END PROC bildstelle; + +INT PROC bildmarksatz : + marksatz +END PROC bildmarksatz; + +PROC bildmarksatz (INT CONST i) : + marksatz := i +END PROC bildmarksatz; + +INT PROC bildsatz : + satz +END PROC bildsatz; + +PROC bildsatz (INT CONST i) : + satz := i +END PROC bildsatz; + +INT PROC bildzeile : + zeile +END PROC bildzeile; + +PROC bildzeile (INT CONST i) : + zeile := min (i, laenge) +END PROC bildzeile; + +INT PROC bildlaenge : + laenge +END PROC bildlaenge; + +PROC bildlaenge (INT CONST i) : + laenge := i +END PROC bildlaenge; + +PROC bildmaxlaenge (INT CONST i) : + maxlaenge := i +END PROC bildmaxlaenge; + +INT PROC bildrand : + rand +END PROC bildrand; + +PROC bildrand (INT CONST i) : + rand := i +END PROC bildrand; + +INT PROC max (INT CONST a, b) : + IF a > b THEN a ELSE b FI +END PROC max; + +PROC zeile unveraendert : + zeileneu := FALSE +END PROC zeile unveraendert; + + +(************************** b i l d e d i t o r **************************) + +PROC bildeditor (DATEI VAR datei) : + + INTERNAL 293 ; + + INT VAR j; + + kommando := feldkommando; + IF neu + THEN bild ausgeben (datei) + ELIF zeileneu + THEN satz ausgeben (datei); ueberschriftneu := TRUE + ELSE feldposition; zeileneu := TRUE + FI; + REPEAT + IF neu THEN bild ausgeben (datei) + ELIF ueberschriftneu THEN ueberschrift (datei) + FI ; + IF stelle = anker + THEN IF schreiben erlaubt + THEN satz erzeugen (datei, stelle); (* gestrichen z:=z *) + satz ausgeben (datei) + ELSE feldkommando (escape q); out(bell); LEAVE bildeditor + FI + FI ; + feldbearbeitung; + IF zeichen <> escape THEN kommandoausfuehrung FI + UNTIL zeichen = escape + END REPEAT; + feldkommando (kommando) . + +feldbearbeitung : + feldkommando (kommando); + IF schreiben erlaubt + THEN feldeditor (inhalt); kommando := feldkommando + ELSE teil := inhalt; feldeditor (teil); + IF teil <> inhalt + THEN kommando := escape q; kommando CAT teil + ELSE kommando := feldkommando + FI + FI; + zeichen := kommando SUB 1; + feldnachbehandlung . + + +feldnachbehandlung : + IF inhalt = "" + THEN IF schreiben erlaubt + THEN IF zeichen > hoechstes steuerzeichen + THEN inhalt := subtext (kommando, 1, feldlimit); + kommando := subtext (kommando, feldlimit+1); + feldout (inhalt); zeichen := cr + FI FI FI . + +kommandoausfuehrung : + delete char (kommando, 1); + IF marke > 0 + THEN bildmarkeditor (datei) + ELSE + SELECT pos (hop cr mark down up right rubin, zeichen) OF + CASE 1: + zeichen := kommando SUB 1; delete char (kommando, 1); + SELECT pos (hop rubin rubout down up cr tab esc, zeichen) OF + CASE 1: oben links + CASE 2: IF schreiben erlaubt + THEN zeilen einfuegen ELSE out (bell) FI + CASE 3: IF schreiben erlaubt + THEN zeile ausfuegen ELSE out (bell) FI + CASE 4: weiterblaettern + CASE 5: zurueckblaettern + CASE 6: neue seite + CASE 7: ueberschriftneu := TRUE + CASE 8: lernmodus umschalten + OTHERWISE zeichen := ""; out (bell) + END SELECT + CASE 2: neue zeile + CASE 3: markieren beginnen + CASE 4: naechster satz + CASE 5: vorgaenger (datei) + CASE 6: feldposition (feldanfang); naechster satz + CASE 7: ueberschriftneu := TRUE; + OTHERWISE + IF zeichen > hoechstes steuerzeichen + THEN IF schreiben erlaubt THEN ueberlauf FI + ELSE insert char (kommando, zeichen, 1); + insert char (kommando, escape, 1) + FI + END SELECT + FI . + +oben links : + ueberschriftneu := TRUE; + WHILE zeile > 1 REP vorgaenger (datei) PER; + feldposition (feldanfang) . + +zeile ausfuegen : + IF feldstelle = 1 + THEN satz loeschen (datei); + IF stelle = anker THEN vorgaenger (datei) FI + ELSE zeilen rekombinieren + FI . + +zeilen einfuegen : + ueberschriftneu := TRUE; + IF einfuegen + THEN einfuegen := FALSE; + IF inhalt = "" THEN satz loeschen (datei) FI; + IF zeilen < laenge THEN bild ausgeben (datei) FI + ELSE einfuegen := TRUE; + IF logischer satzanfang + THEN satz erzeugen (datei, stelle); + IF zeilen >= zeile THEN bildrest loeschen FI; + zeilen := zeile; satz ausgeben (datei) + ELSE IF feldstelle <= LENGTH inhalt + THEN zeile auftrennen + FI; + IF zeile < zeilen + THEN nachfolger (datei); bildrest loeschen; + vorgaenger (datei); zeilen := zeile + FI ; feldposition + FI + FI . + +logischer satzanfang : + FOR j FROM feldanfang UPTO feldstelle - 1 + REP IF (inhalt SUB j) = "" + THEN LEAVE logischer satzanfang WITH TRUE + ELIF (inhalt SUB j) <> " " + THEN LEAVE logischer satzanfang WITH FALSE + FI + END REP; TRUE . + +zeilen rekombinieren : + IF eof (datei) THEN + ELSE inhalt CAT (feldstelle-1-LENGTH inhalt) * " "; + inhalt CAT datei (datei (stelle).nachfolger).inhalt; + stelle := datei (stelle).nachfolger; + satz loeschen (datei, stelle); + stelle := datei (stelle).vorgaenger; + bildausgeben (datei) + FI . + +zeile auftrennen : + marke := stelle; (feldende-feldstelle+1) TIMESOUT " "; + stelle := datei (stelle).nachfolger; + satz erzeugen (datei, stelle); + inhalt := subtext (datei (datei (stelle).vorgaenger).inhalt, feldstelle); + stelle := marke; marke := 0; + inhalt := subtext (inhalt, 1, feldstelle-1) . + +weiterblaettern : + ueberschriftneu := TRUE; + IF eof (datei) + THEN out (bell) + ELSE IF zeile = laenge + THEN nachfolger (datei); zeile := 1; bild ausgeben (datei) + ELIF einfuegen + THEN IF zeile = zeilen THEN bild ausgeben (datei) FI + FI; + WHILE zeile < zeilen AND stelle <> anker + REP nachfolger (datei) END REP; + IF stelle = anker + THEN vorgaenger (datei) + FI FI . + +zurueckblaettern : + ueberschriftneu := TRUE; + IF satz > 1 + THEN IF zeile = 1 + THEN vorgaenger (datei); zeile := laenge + FI; + WHILE zeile > 1 AND satz > 1 + REP vorgaenger (datei) PER; + zeile := 1 + FI . + +ueberlauf : + insert char (kommando, zeichen, 1); + feldposition (feldanfang); feld einruecken (inhalt); nachfolger (datei); + satz erzeugen (datei, stelle); + inhalt := ""0"" ; (* 12.01.81 *) + IF zeile <= zeilen OR neu + THEN bild ausgeben (datei) ELSE satz ausgeben (datei) + FI ; + inhalt := "" . + +lernmodus umschalten : + feldlernmodus (NOT feldlernmodus); + ueberschriftneu := TRUE; + IF feldlernmodus + THEN feldaudit (""); zeichen := "" + ELSE insert char (kommando, escape, 1); + insert char (kommando, hop, 1) + FI. + +neue seite : + feldstelle (feldanfang); zeile := 1; neu := TRUE . + +neue zeile : + BOOL VAR wirklich einfuegen := einfuegen; + IF feldstelle > LENGTH inhalt OR feldstelle >= feldende + THEN feldposition (feldanfang); feld einruecken (inhalt); nachfolger(datei) + ELIF einfuegen AND logischer satzanfang + THEN feldposition (feldanfang); feldeinruecken (inhalt) + ELSE feldposition (feldanfang); nachfolger (datei); + wirklich einfuegen := FALSE + FI; + IF stelle = anker THEN + ELIF wirklich einfuegen + THEN satz erzeugen (datei, stelle); + IF zeile <= zeilen OR neu + THEN bild ausgeben (datei) + ELSE satz ausgeben (datei) + FI + ELIF neu THEN + ELSE IF zeile > zeilen + THEN satz ausgeben (datei) + FI; + FOR j FROM feldanfang UPTO min (feldstelle, LENGTH inhalt) + REP IF (inhalt SUB j) <> blank + THEN feldposition (j); LEAVE neue zeile FI + PER + FI . + +naechster satz : + nachfolger (datei); + IF neu + THEN IF stelle = anker + THEN IF datei (datei (stelle).vorgaenger).inhalt = "" + THEN stelle := datei (stelle).vorgaenger; satz DECR 1; + neu := FALSE + FI FI + ELIF zeile <= zeilen THEN + ELIF stelle = anker THEN + ELSE satz ausgeben (datei) + FI . + +markieren beginnen : + IF feldstelle <= min (LENGTH inhalt, feldende) + THEN feldmarke (feldstelle); marke := stelle; + marksatz := satz; satz ausgeben (datei); + alte feldmarke := feldmarke + ELSE out (bell) + FI . + +inhalt : + datei (stelle).inhalt . + +END PROC bildeditor; + + +(******************** b i l d - m a r k e d i t o r **********************) + +PROC bildmarkeditor (DATEI VAR datei) : + INT VAR j, k; + + IF zeichen = right OR zeichen = tab + THEN zeichen := down; + feldposition (feldanfang) + FI; + SELECT pos (hop mark rubout up down cr, zeichen) OF + CASE 1: zeichen := kommando SUB 1; delete char (kommando, 1); + IF zeichen = up + THEN rueckblaetternd demarkieren + ELIF zeichen = down + THEN weiterblaetternd markieren + ELSE out (bell) + FI; + zeichen := "" + CASE 2: markieren beenden + CASE 3: IF schreiben erlaubt + THEN markiertes loeschen + ELSE out (bell) + FI + CASE 4: zeile demarkieren + CASE 5,6: zeile markieren + OTHERWISE insert char (kommando, zeichen, 1); + insert char (kommando, escape, 1) + END SELECT; + IF marke > 0 + THEN IF stelle = marke + THEN feldmarke (alte feldmarke) + ELSE feldmarke (feldanfang) + FI + FI . + +markieren beenden : + feldmarke (0); alte feldmarke := 0; + IF marke = stelle + THEN satz ausgeben (datei); ueberschriftneu := TRUE; + marke := 0; + ELSE marke := 0; neu := TRUE + FI . + +markiertes loeschen : + IF stelle = marke + THEN satzausschnitt loeschen + ELSE letzten satz bis stelle loeschen; + ersten satz ab marke loeschen; + alle zwischensaetze loeschen; + IF zeile <= 1 + THEN zeile := 1 + FI; + feldstelle (feldanfang); feldmarke (0); + alte feldmarke := 0; marke := 0; neu := TRUE + FI . + +satzausschnitt loeschen : + inhalt := subtext (inhalt, 1, feldmarke-1) + subtext (inhalt, feldstelle); + feldstelle (feldmarke); feldmarke (0); marke := 0; + IF inhalt = "" + THEN satz loeschen (datei) + ELSE satz ausgeben (datei) + FI . + +letzten satz bis stelle loeschen : + IF feldstelle > LENGTH inhalt + THEN satz loeschen (datei, stelle) + ELIF feldstelle > feldanfang + THEN inhalt := subtext (inhalt, feldstelle) + FI . + +ersten satz ab marke loeschen : + INT CONST altstelle := stelle; + stelle := marke; + IF alte feldmarke = 1 + THEN satz loeschen (datei, stelle); + satz DECR 1; zeile DECR 1 + ELSE IF alte feldmarke <= LENGTH inhalt + THEN inhalt := text (inhalt, alte feldmarke-1) + FI; + stelle := datei (stelle).nachfolger + FI . + +alle zwischensaetze loeschen : + WHILE stelle <> altstelle + REP satzloeschen (datei, stelle); + satz DECR 1; zeile DECR 1 + PER . + +zeile markieren : + IF zeichen = cr + THEN feldstelle (feldanfang) + FI; + IF eof (datei) + THEN feldstelle (feldende) + ELSE nachfolger (datei) + FI; + markierung justieren (datei); + satz ausgeben (datei) . + +zeile demarkieren : + IF stelle = marke + THEN out (bell); LEAVE zeile demarkieren + FI; + feldmarke (0); satz ausgeben (datei); + vorgaenger (datei); + markierung justieren (datei); + satz ausgeben (datei) . + +weiterblaetternd markieren : + IF zeile >= laenge THEN zeile := 0 FI; out (hop); + WHILE NOT eof (datei) + REP nachfolger (datei) UNTIL zeile = laenge PER; + IF eof (datei) + THEN feldstelle (feldende); + FI; + neu := TRUE . + +rueckblaetternd demarkieren : + IF stelle = marke + THEN out (bell); LEAVE rueckblaetternd demarkieren + FI; + FOR j FROM 1 UPTO laenge + WHILE stelle <> marke + REP vorgaenger (datei) PER; + neu := TRUE . + +inhalt : + datei (stelle).inhalt . + +END PROC bildmarkeditor; + +PROC markierung justieren (DATEI CONST datei) : + IF feldstelle > LENGTH inhalt + THEN feldstelle (min (feldende, LENGTH inhalt) + 1) + FI; + IF stelle = marke + THEN feldmarke (alte feldmarke); + IF feldstelle < feldmarke + THEN feldstelle (feldmarke) + FI + ELSE feldmarke (feldanfang) + FI . + +inhalt : + datei (stelle).inhalt . + +END PROC markierung justieren; + +PROC vorgaenger (DATEI VAR datei) : + IF eof (datei) + THEN IF inhalt = "" THEN satz loeschen (datei) + FI FI ; + stelle := datei (stelle).vorgaenger; satz DECR 1; + IF stelle = anker + THEN out (bell); stelle := datei (anker).nachfolger; + satz := 1; zeile := 1 + ELIF zeile > 1 + THEN out (up); zeile DECR 1 + ELSE neu := TRUE + FI . + +inhalt : + datei (stelle).inhalt . + +END PROC vorgaenger; + +PROC nachfolger (DATEI CONST datei) : + stelle := datei (stelle).nachfolger; satz INCR 1; zeile INCR 1; + IF zeile <= laenge + THEN out (down) + ELIF laenge <> maxlaenge + THEN neu := TRUE ; zeile := laenge + FI +END PROC nachfolger; + +PROC bild ausgeben (DATEI VAR datei) : + + IF marke > 0 THEN markierung justieren (datei) FI; + alte feldstelle := feldstelle; feldstelle (feldende+1); + INT VAR altstelle :: stelle, altsatz :: satz, + altzeile :: zeile, altmarke :: feldmarke; + ueberschrift (datei); + IF marke > 0 OR neu + THEN zurueck zur ersten zeile; + cursor (1, rand+2) FI; + IF (rand+laenge) = maxlaenge THEN out (clear eop) FI; + WHILE zeile <= laenge AND stelle <> anker + REP zeile schreiben PER; + feldstelle (alte feldstelle); + feldmarke (altmarke); + zeilen := zeile - 1; + IF zeile > laenge + THEN zeile := laenge; feldposition + ELSE bildrest loeschen + FI; + (zeile - altzeile) TIMESOUT up; + zeile := altzeile; satz := altsatz; stelle := altstelle; + neu := FALSE . + +zurueck zur ersten zeile : + IF eof (datei) + THEN WHILE inhalt = "" AND datei(stelle).vorgaenger <> anker + REP vorgaenger (datei) END REP; + altstelle := stelle; altsatz := satz; altzeile := zeile; + FI; + WHILE zeile > 1 AND datei (stelle).vorgaenger <> anker + REP IF stelle = marke + THEN feldmarke (0) + FI; + vorgaenger (datei) + PER; + altzeile DECR (zeile-1); zeile := 1 . + +inhalt : + datei (stelle).inhalt . + +zeile schreiben : + IF stelle = marke THEN feldmarke (alte feldmarke) FI; + IF stelle = altstelle THEN feldstelle (alte feldstelle) FI; + feldout (inhalt); + IF stelle = altstelle + THEN feldmarke (0) + ELIF feldmarke > feldanfang + THEN feldmarke (feldanfang) + FI; + zeile INCR 1; + IF zeile <= laenge + THEN stelle := datei (stelle).nachfolger; + satz INCR 1; out (down) + FI . + +END PROC bild ausgeben; + +PROC ueberschrift (DATEI CONST datei) : + cursor (feldrand+1, rand+1); out(begin mark); + INT CONST punkte :: + (feldende-feldanfang-13-length(datei(anker).inhalt)) DIV 2; + punkte TIMESOUT "."; out (" ", datei(anker).inhalt, " ."); + cursor (feldrand+3, rand+1); + IF feldeinfuegen + THEN out ("RUBIN"2""2"") + ELSE out (""2""2""2""2""2""2""2"") FI; + IF einfuegen + THEN out ("INS") + ELSE out (""2""2""2"") FI; + IF feldlernmodus THEN out ("..LEARN.") FI; + cursor (feldrand+feldende-feldanfang-9-punkte, rand+1); + punkte TIMESOUT "."; + out (" zeile ", end mark, " "); + cursor (feldrand+feldende-feldanfang-2, rand+1) ; + IF satz <= zeile THEN out("1") + ELSE out (text (satz-zeile+1)) FI; + cursor (feldrand+2, rand+1); + feldtab (tabulator); + outsubtext (tabulator, feldanfang+1, min (feldende, LENGTH tabulator)); + cursor (1, rand+zeile+1); feldposition; + ueberschriftneu := FALSE + +END PROC ueberschrift; + +TEXT VAR tabulator; + +PROC satz ausgeben (DATEI VAR datei) : + IF zeile > laenge + THEN roll up + ELIF zeile > zeilen + THEN zeilen INCR 1 + FI; + feldout (datei (stelle).inhalt); feldposition . +roll up : + out (down); cursor (1, rand + zeile); zeile DECR 1 . +END PROC satz ausgeben; + +PROC satz loeschen (DATEI VAR datei) : + satz loeschen (datei, stelle); zeilen DECR 1; + IF zeile > zeilen + THEN bildrest loeschen; + IF stelle <> anker THEN satz ausgeben (datei) FI + ELSE bild ausgeben (datei) + FI +END PROC satz loeschen; + +PROC bildrest loeschen : + out (cr); feldrand TIMESOUT right; + IF (rand+laenge) = maxlaenge + THEN out (clear eop) + ELSE out (up); + (laenge-zeile+1) TIMESOUT (down clear eol); + (laenge-zeile) TIMESOUT up + FI; + feldposition +END PROC bildrest loeschen; + +BOOL PROC eof (DATEI CONST datei) : + datei (stelle).nachfolger = anker +END PROC eof; + +(*************************** schrott *************************************) + +PROC satz erzeugen (DATEI VAR datei, INT VAR satz): + EXTERNAL 291 ; +END PROC satz erzeugen; + +PROC satz loeschen (DATEI VAR datei, INT VAR satz): + EXTERNAL 292 ; +END PROC satz loeschen; + +(************************** testprogramm ***********************************) +(* +PROC test des bildeditors : + + IF NOT exists ("test") + THEN FILE VAR file 1 := sequential file (modify, "test"); close (file 1) + FI ; + DATASPACE VAR ds := old ("test"); + BOUND DATEI VAR datei := ds ; + feldwortweise (NOT feldwortweise); + bildneu (TRUE); bildmarke (0); + bildstelle (CONCR(datei) (anker).nachfolger); bildsatz (1); + feldmarke (0); feldseparator (""); feldstelle (1) ; + REP b i l d e d i t o r (CONCR (datei)); + out (""7""); feldkommando ("") + UNTIL (feldkommando SUB 1) = ""27"" + PER; + +END PROC test des bildeditors; +*) +END PACKET bildeditor; diff --git a/system/base/unknown/src/command handler b/system/base/unknown/src/command handler new file mode 100644 index 0000000..3e06280 --- /dev/null +++ b/system/base/unknown/src/command handler @@ -0,0 +1,239 @@ + +PACKET command handler DEFINES (* Autor: J.Liedtke *) + (* Stand: 29.02.82 *) + command handler , + do command , + command error , + set command : + + +LET esc = ""27"" , + esc k = ""27"k" , + cr lf = ""4""13""10"" , + command pre = ""4""13" " , + command post = ""13""10" " , + + tag type = 1 , + texttype = 4 , + eof type = 7 ; + + +TEXT VAR command line := "" , + previous command line := "" , + symbol , + procedure , + pattern , + error note := "" ; + +INT VAR symbol type , + allowed type := 0 ; + + +PROC set command (TEXT CONST command, INT CONST type) : + + param position (0) ; + command line := command ; + allowed type := type + +ENDPROC set command ; + +PROC do command : + + do (command line) + +ENDPROC do command ; + + +PROC command handler ( TEXT CONST command list, + INT VAR command index, number of params, + TEXT VAR param 1, param 2, + TEXT CONST command text ) : + +prepare and get command ; +command handler (command list,command index,number of params,param1,param2). + +prepare and get command : + set line nr (0) ; + error protocoll ; + get command from console . + +error protocoll : + IF is error + THEN put error ; + clear error + ELSE command line := "" ; + FI . + +get command from console : + INT VAR x, y; + out (crlf) ; + get cursor (x, y) ; + cursor (x, y) ; + REP + out (command pre) ; + out (command text) ; + out (command post) ; + editget command + UNTIL command line <> "" PER ; + param position (LENGTH command line) ; + out (command post) . + +editget command : + feldaudit ("") ; + feldlernmodus (FALSE) ; + REP + feldtabulator ("") ; + feldseparator (esc) ; + editget (command line) ; + ignore halt errors during editget ; + IF feldzeichen = esc k + THEN command line := previous command line + ELSE previous command line := command line ; + LEAVE editget command + FI + PER . + +ignore halt errors during editget : + IF is error + THEN clear error + FI . + +ENDPROC command handler ; + +PROC command handler ( TEXT CONST command list, + INT VAR command index, number of params, + TEXT VAR param 1, param 2) : + + scan (command line) ; + next symbol ; + IF pos (command list, symbol) > 0 + THEN procedure name ; + parameter list pack option ; + nothing else in command line ; + decode command + ELSE impossible command + FI . + +procedure name : + IF symbol type = tag type OR symbol = "?" + THEN procedure := symbol ; + next symbol + ELSE error ("incorrect procedure name") + FI . + +parameter list pack option : + number of params := 0 ; + param 1 := "" ; + param 2 := "" ; + IF symbol = "(" + THEN next symbol ; + parameter list ; + IF symbol <> ")" + THEN error (") expected") + FI + ELIF symbol type <> eof type + THEN error ("( expected") + FI . + +parameter list : + parameter (param 1, number of params) ; + IF symbol = "," + THEN next symbol ; + parameter (param 2, number of params) ; + FI ; + IF symbol <> ")" + THEN error (") expected") + FI . + +nothing else in command line : + next symbol ; + IF symbol <> "" + THEN error ("command too complex") + FI . + +decode command : + command index := index (command list, procedure, number of params) . + +impossible command : + command index := 0 . + +ENDPROC command handler ; + +PROC parameter (TEXT VAR param, INT VAR number of params) : + + IF symbol type = text type OR symbol type = allowed type + THEN param := symbol ; + number of params INCR 1 ; + next symbol + ELSE error ("parameter is no text denoter ("" missing!)") + FI + +ENDPROC parameter ; + +INT PROC index (TEXT CONST list, procedure, INT CONST params) : + + pattern := procedure ; + pattern CAT ":" ; + INT CONST index pos := pos (list, pattern) ; + IF procedure name found + THEN get colon pos ; + get dot pos ; + get end pos ; + get command index ; + get param index ; + IF param index >= 0 + THEN command index + param index + ELSE - command index + FI + ELSE 0 + FI . + +procedure name found : + index pos > 0 AND (list SUB index pos - 1) <= "9" . + +get param index : + INT CONST param index := + pos (list, text (params), dot pos, end pos) - dot pos - 1 . + +get command index : + INT CONST command index := + int ( subtext (list, colon pos + 1, dot pos - 1) ) . + +get colon pos : + INT CONST colon pos := pos (list, ":", index pos) . + +get dot pos : + INT CONST dot pos := pos (list, ".", index pos) . + +get end pos : + INT CONST end pos := dot pos + 4 . + +ENDPROC index ; + +PROC error (TEXT CONST message) : + + error note := message ; + scan ("") ; + procedure := "-" + +ENDPROC error ; + +PROC command error : + + disable stop ; + IF error note <> "" + THEN errorstop (error note) ; + error note := "" + FI ; + enable stop + +ENDPROC command error ; + + +PROC next symbol : + + next symbol (symbol, symbol type) + +ENDPROC next symbol ; + +iNDPACKET command handler ; diff --git a/system/base/unknown/src/dateieditorpaket b/system/base/unknown/src/dateieditorpaket new file mode 100644 index 0000000..8aedb2d --- /dev/null +++ b/system/base/unknown/src/dateieditorpaket @@ -0,0 +1,743 @@ + +PACKET d a t e i e d i t o r paket DEFINES (* Autor: P.Heyderhoff *) + (*******************) (* Stand: 19.02.82 *) + (* Vers.: 1.6.0 *) + define escape , + dateieditor : + +LET satzmax = 4075, dateianker = 2, left = ""8"", escape = ""27"", + hop = ""1"", right = ""2"", hoechstes steuerzeichen = ""31"", + clear = ""1""4"", hop and mark = ""1""15"", code f = "f", + clear line mark = ""5""14"", bell = ""7"", freianker = 1, down = ""10"", + begin mark = ""15"", end mark = ""14"", escape escape = ""27""27"", + clear eol and mark = ""5""15""; + +LET DATEI = ROW satzmax STRUCT (INT nachfolger, vorgaenger, index, + fortsetzung, TEXT inhalt); +FOR j FROM 1 UPTO 127 REP escapefkt (j) := "" PER; +INT VAR j, haltzeile :: satzmax, symboltyp, typ, + zahlwert, stelle, satz, marke, maxbildlaenge :: 23; +FILE VAR sekundaerfile ; +TEXT VAR zeichen :: "", ersatz :: "", kommando :: "", + symbol :: "", textwert :: "", lernsequenz::""; +BOOL VAR war fehler, boolwert; +LET op1namen = +";+;-;BEGIN;COL;GET;HALT;LIMIT;MARK;PUT;IF;NOT;REPEAT;WRITE;SIZE"; +LET b = 5, c = 11, g = 15, h = 19, l = 24, m = 30, + p = 35, i = 39, n = 42, r = 46, w = 53, s=59; +LET op2namen = "&+&-&*&/&;&CHANGETO;&OR"; +LET plus = 1, minus = 3, mal = 5, durch = 7, semicolon = 9, + changecode = 11, or = 21; +LET proznamen = ";col;row;halt;limit;mark;len;eof;"; +LET pcol = 1, prow = 5, phalt = 9, plimit = 14, pmark = 20, + plen = 25, peof = 29; +LET void = 0, (* keine angabe des typs *) + tag = 1, (* typ: lower case letter *) + bold = 2, (* typ: upper case letter *) + integer = 3, (* typ: digit *) + texttyp = 4, (* typ: quote *) + operator = 5, (* typ: operator +-*=<> ** := *) + delimiter = 6, (* typ: delimiter ( ) , ; . *) + eol = 7, (* typ: niltext, Zeilenende *) + bool = 8; (* typ: boolean *) +LET varimax = 10; +INT VAR freivar :: 1; +ROW varimax INT VAR varzahlwert, vartyp; +ROW varimax TEXT VAR vartextwert, varname; +FOR j FROM 1 UPTO varimax +REP vartextwert (j) := ""; varname (j) := "" PER; + +ROW 127 TEXT VAR escapefkt; + + +(************************* d a t e i e d i t o r *************************) + +PROC dateieditor (DATEI VAR datei) : + + INTERNAL 295 ; + + REP datei editieren + UNTIL (feldkommando SUB 1) <> escape + PER . + +datei editieren : + war fehler := FALSE ; + zeichen := feldkommando SUB 2; + IF zeichen = "q" OR zeichen = "w" + THEN LEAVE dateieditor + ELIF zeichen = escape + THEN kommando ermitteln + ELSE tastenkommando ermitteln ; (* Li 19.1.82 *) + abbruchtest; + feldkommando (subtext (feldkommando, 3)) + FI; + a u s f u e h r e n . + +tastenkommando ermitteln : + IF zeichen > ""0"" AND zeichen < ""128"" + THEN kommando := escapefkt (code (zeichen)) (* Li 06.01.82 *) + ELSE kommando := "" + FI . + +abbruchtest : + IF is incharety (escape) + THEN fehler bearbeiten + FI . + +kommando ermitteln : + IF (feldkommando SUB 1) = hop + THEN lernsequenz auf taste legen; + feldkommando (subtext (feldkommando, 4)); + LEAVE datei editieren + FI; + feldkommando (subtext (feldkommando, 3)); + kommando := ""; dialog; analysieren . + +dialog: + REP kommandodialog; + IF (feldzeichen SUB 1) <> escape OR kommando <> "?" + THEN LEAVE dialog + ELIF (feldzeichen SUB 2) > ""0"" THEN (* Li 19.02.82 *) + kommando := escapefkt (code (feldzeichen SUB 2) MOD 128 ) + ELSE kommando := "" + FI + PER . + +lernsequenz auf taste legen : + lernsequenz := feldaudit; + lernsequenz := subtext (lernsequenz, 1, LENGTH lernsequenz - 3); + INT CONST lerncode := code (feldkommando SUB 3) MOD 128 ; + escapefkt (lerncode) := "W""" ; + escapefkt (lerncode) CAT lernsequenz ; (* Li 5.1.81 *) + escapefkt (lerncode) CAT """" . + +kommandodialog : + INT CONST feldlaenge :: max (feldende-feldanfang-21, 6) ; + cursor (feldrand+1, bildrand+bildzeile+1); + out (begin mark, "gib editor kommando: "); + feldlaenge TIMESOUT "."; out(end mark); + bildneu (TRUE); + cursor (feldrand+23, bildrand+bildzeile+1); feldseparator (escape); + editget (kommando, 255, feldlaenge); feldseparator ("") . + +analysieren : + IF (feldzeichen SUB 1) = escape AND (feldzeichen SUB 2) > ""0"" (*02.82*) + THEN escapefkt (code (feldzeichen SUB 2) MOD 128) := kommando; (* Li 5.1.*) + LEAVE datei editieren + ELIF kommando = "" + THEN LEAVE datei editieren + ELIF (kommando SUB 1) = "?" + THEN kommandos erklaeren; + LEAVE datei editieren + ELIF pos ("quit", kommando) = 1 + THEN feldkommando (escape escape); + LEAVE dateieditor + ELSE escapefkt (code (code f)) := kommando + FI . + +ausfuehren : + haltzeile := satzmax; + IF kommando = "" + THEN zeile unveraendert + ELSE scan (kommando); nextsymbol; + IF a u s d r u c k (datei) + THEN IF symboltyp <> eol THEN fehler bearbeiten FI + FI; + IF war fehler THEN inchar (zeichen) (* warten *) FI + FI . + +kommandos erklaeren : + out (clear); + putline ("kommandos fuer den benutzer :"); line; + putline ("quit : beendet das editieren"); + putline (" n : positioniert auf zeile n"); + putline ("+ n : blaettert n zeilen vorwaerts"); + putline ("- n : blaettert n zeilen rueckwaerts"); + putline (" ""z"" : sucht angegebene zeichenkette "); + putline ("""muster"" CHANGETO ""ersatz"" :"); + putline (" muster wird durch ersatz ersetzt"); + putline ("HALT n : sieht anhalten des suchens in zeile n vor"); + putline ("GET ""d"" : kopiert datei d und markiert"); + putline ("PUT ""d"" : schreibt markierten abschnitt in datei d"); + putline ("LIMIT n : setzt schreibende auf spalte n"); + putline ("BEGIN n : setzt feldanfang auf spalte n"); + putline ("SIZE n : setzt bildlaenge auf n"); line; + putline ("?ESCx : zeigt kommando auf escapetaste x"); + inchar (zeichen) . + +END PROC dateieditor; + +PROC define escape (TEXT CONST cmd char, kommando) : + escapefkt (code (cmd char) MOD 128) := kommando +END PROC define escape ; + + +(******************** h i l f s - p r o z e d u r e n ********************) + +PROC fehler bearbeiten : + IF NOT war fehler + THEN war fehler := TRUE; bildneu (TRUE); + out (""2""2""2" kommandofehler bei ",symbol," erkannt."); + out (clear line mark) + FI +END PROC fehler bearbeiten; + +BOOL PROC fehler : fehler bearbeiten; FALSE END PROC fehler; + +BOOL PROC klammerzu : + IF symbol = ")" + THEN nextsymbol; TRUE + ELSE fehler + FI +END PROC klammerzu; + +PROC nextsymbol : + nextsymbol (symbol, symboltyp); + IF symboltyp = eol THEN symbol := "kommandoende" FI +END PROC nextsymbol; + +PROC eof (DATEI VAR datei) : + boolwert := (bildstelle = dateianker); typ := void +END PROC eof; + +PROC nachsatz (DATEI CONST datei) : + stelle := datei (stelle).nachfolger; + satz INCR 1; protokoll +END PROC nachsatz; + +PROC vorsatz (DATEI CONST datei) : + stelle := datei (stelle).vorgaenger; + satz DECR 1; protokoll +END PROC vorsatz; + + +PROC protokoll : + cout (satz) ; + IF is incharety (escape) + THEN fehler bearbeiten + FI . +END PROC protokoll; + + +(******************* s p r i n g e n und s u c h e n *******************) + +PROC row (DATEI VAR datei) : + IF ziel voraus THEN vorwaerts springen ELSE rueckwaerts springen FI; + bildsatz (satz); bildstelle (stelle); typ := void; bildneu (TRUE) . + +ziel voraus : + satz := bildsatz; stelle := bildstelle; + IF zahlwert > satz + THEN TRUE + ELIF zahlwert <= satz DIV 2 AND bildmarke = 0 + THEN stelle := datei (dateianker).nachfolger; satz := 1; TRUE + ELSE FALSE + FI . + +vorwaerts springen : + IF zahlwert <= 0 + THEN fehler bearbeiten + FI ; + WHILE stelle <> dateianker AND satz < zahlwert + REP nachsatz (datei) UNTIL war fehler PER; + IF stelle = dateianker AND satz > 1 + THEN vorsatz (datei); + feldstelle (LENGTH (datei (stelle).inhalt)+1) + FI . + +rueckwaerts springen : + WHILE stelle <> bildmarke AND satz > zahlwert + REP vorsatz (datei) UNTIL war fehler PER . + +END PROC row; + +PROC search (DATEI VAR datei) : + stelle := bildstelle; + IF textwert <> "" THEN contextadressierung FI; + typ := void . + +contextadressierung : + j := feldstelle - 1; satz := bildsatz; + WHILE noch nicht gefunden REP nachsatz (datei) UNTIL war fehler PER; + IF stelle = dateianker + THEN vorsatz (datei); + feldstelle (LENGTH (datei (stelle).inhalt)+1) + ELIF j > 0 + THEN feldstelle ((LENGTH textwert)+j) + FI; + IF bildstelle <> stelle + THEN bildstelle (stelle); bildsatz (satz); bildneu (TRUE) + FI . + +noch nicht gefunden : + j := pos (datei (stelle).inhalt, textwert, j+1); + j = 0 AND stelle <> dateianker AND satz < haltzeile . + +END PROC search; + + +(******************** vom file holen, in file bringen ********************) + +PROC vom file holen (DATEI VAR datei, TEXT VAR textwert) : + stelle := bildstelle; satz := bildsatz; + IF datei eroeffnung korrekt + THEN IF stelle = dateianker THEN satz erzeugen (datei, stelle) FI; + zeile auftrennen; file kopieren; kopiertes markieren; + bildstelle (stelle); bildsatz (satz); bildmarke (marke) + FI ; textwert := "" . + +datei eroeffnung korrekt : + IF textwert = "" + THEN sekundaerfile := sequential file (input); NOT eof (sekundaerfile) + ELIF exists (textwert) + THEN sekundaerfile := sequential file (input, textwert); + NOT eof (sekundaerfile) + ELSE FALSE + FI . + +file kopieren : + INT VAR altstelle; + FOR j FROM 0 UPTO satzmax WHILE NOT eof (sekundaerfile) + REP nachsatz (datei); altstelle := stelle; + satz erzeugen (datei, stelle); + IF stelle = altstelle THEN LEAVE file kopieren FI; + getline (sekundaerfile, inhalt) + UNTIL war fehler + PER . + +zeile auftrennen : + marke := stelle; bildmarksatz (satz); + nachsatz (datei); satz erzeugen (datei, stelle); + inhalt := subtext (datei (marke).inhalt, feldstelle); + vorsatz (datei); inhalt := text (inhalt, feldstelle-1) . + +kopiertes markieren : + nachsatz (datei); + IF inhalt = "" THEN satz loeschen (datei, stelle) FI; + vorsatz (datei); + IF datei (marke).inhalt = "" + THEN satz loeschen (datei, marke); satz DECR 1; + ELSE marke := datei (marke).nachfolger; bildmarksatz (bildmarksatz+1) + FI; + feldmarke (feldanfang); feldanfangsmarke (feldanfang); + feldstelle (1+LENGTH inhalt); bildneu (TRUE) . + +inhalt : + datei (stelle).inhalt . + +END PROC vom file holen; + +PROC in file bringen ( DATEI VAR datei, TEXT VAR textwert) : + neuen sekundaerfile erzeugen; + marke := bildstelle; stelle := bildmarke; satz := bildmarksatz; + IF stelle = marke + THEN IF feldmarke <> feldstelle + THEN putline (sekundaerfile, + subtext (inhalt, feldmarke, feldstelle-1)) + FI + ELSE IF feldanfangsmarke <= LENGTH inhalt + THEN putline (sekundaerfile, subtext (inhalt, feldanfangsmarke)) + FI; schreiben; + IF feldstelle > feldanfang + THEN putline (sekundaerfile, subtext (inhalt, 1, feldstelle-1)) + FI + FI . + +schreiben: + REP nachsatz (datei); + IF stelle = marke OR war fehler THEN LEAVE schreiben FI; + putline (sekundaerfile, inhalt) + PER . + +neuen sekundaerfile erzeugen : + IF textwert = "" + THEN sekundaerfile := sequential file (output) ; + ELSE IF exists (textwert) + THEN forget (textwert) + FI; + IF exists (textwert) + THEN LEAVE in file bringen + FI; + sekundaerfile := sequential file (output, textwert) + FI . + +inhalt : + datei (stelle).inhalt . + +END PROC in file bringen; + + +(************************* i n t e r p r e t e r *************************) + +BOOL PROC primary (DATEI VAR datei) : + + SELECT symboltyp OF + CASE integer : + IF LENGTH symbol <= 4 (* Li 20.01.82 *) + THEN zahlwert := int (symbol); + typ := symboltyp; + nextsymbol; TRUE + ELSE fehler + FI + CASE texttyp : + textwert := symbol; typ := symboltyp; nextsymbol; TRUE + CASE delimiter : + IF symbol = "(" + THEN nextsymbol; + IF ausdruck (datei) THEN klammerzu ELSE fehler FI + ELSE fehler + FI + CASE tag : + INT CONST pcode :: pos (proznamen, ";" + symbol + ";"); + IF pcode = 0 + THEN is variable + ELSE nextsymbol; prozedurieren + FI + CASE bold, operator : + INT CONST op1code :: pos (op1namen, ";" + symbol); + IF op1code = 0 + THEN fehler + ELIF op1code = r (* Li 12.01.81 *) + THEN wiederholung (datei) + ELSE nextsymbol ; + IF primary (datei) + THEN operieren + ELSE fehler + FI + FI + OTHERWISE : fehler + END SELECT . + +is variable : + INT VAR var :: 1; + WHILE varname (var) <> symbol AND var <> freivar REP var INCR 1 PER; + IF var = freivar + THEN varname (var) := symbol; nextsymbol; + IF symbol = ":=" + THEN deklarieren + ELSE LEAVE is variable WITH fehler + FI + ELSE nextsymbol + FI; + IF symbol = ":=" THEN nextsymbol; assignieren ELSE dereferenzieren FI . + +dereferenzieren : + typ := vartyp (var); zahlwert := varzahlwert (var); + textwert := vartextwert (var); TRUE . + +assignieren : + IF primary (datei) + THEN IF typ = integer + THEN varzahlwert (var) := zahlwert + ELIF typ = texttyp + THEN vartextwert (var) := textwert + ELSE fehler bearbeiten + FI; + vartyp (var) := typ; typ := void + ELSE fehler bearbeiten + FI; + NOT war fehler . + +deklarieren : + IF freivar = varimax + THEN fehler bearbeiten + ELSE freivar INCR 1 + FI . + +prozedurieren : + typ := integer; + SELECT pcode OF + CASE pcol : zahlwert := feldstelle + CASE plen : zahlwert := LENGTH (datei (bildstelle).inhalt) + CASE prow : zahlwert := bildsatz + CASE phalt : zahlwert := haltzeile + CASE plimit : zahlwert := feldlimit + CASE pmark : zahlwert := bildmarke + CASE peof : eof (datei) + OTHERWISE fehler bearbeiten + END SELECT; + NOT war fehler . + +operieren : + SELECT op1code OF + CASE plus : zahlwert INCR bildsatz; row (datei) + CASE minus : zahlwert := bildsatz - zahlwert; row (datei) + CASE b : begin + CASE c : col + CASE g : get + CASE h : halt + CASE l : limit + CASE m : mark + CASE p : put + CASE i : if + CASE w : write + CASE s : size + OTHERWISE fehler bearbeiten + END SELECT; + typ := void; TRUE . + +begin : + zahlwert := zahlwert MOD 180; + feldende (feldende+zahlwert-feldanfang); feldanfang (zahlwert) . + +col : + zahlwert := zahlwert MOD 256; feldstelle (zahlwert) . + +get : + IF bildmarke <= 0 AND schreiberlaubnis + THEN vom file holen (datei, textwert) + FI . + +halt : + haltzeile := zahlwert . + +limit : + zahlwert := zahlwert MOD 256; feldlimit (zahlwert) . + +mark : + IF zahlwert = 0 + THEN bildmarke (0); feldmarke (0); bildneu (TRUE) + ELSE bildmarke (bildstelle); feldmarke (feldstelle); + bildmarksatz (bildsatz) + FI . + +put : + IF bildmarke > 0 THEN in file bringen (datei, textwert) FI . + +if : + IF bedingung (datei) + THEN IF boolwert + THEN IF pos ("THEN", symbol) = 1 + THEN nextsymbol; + IF ausdruck (datei) + THEN skip elseteil + ELSE fehler bearbeiten + FI + ELSE fehler bearbeiten + FI + ELSE skip thenteil; + IF j = 1 + THEN elseteil + ELIF j <> 5 + THEN fehler bearbeiten + FI + FI + ELSE fehler bearbeiten + FI . + +elseteil : + IF ausdruck (datei) + THEN IF symbol = "FI" THEN nextsymbol ELSE fehler bearbeiten FI + FI . + +skip elseteil : + WHILE symboltyp <> eol AND pos ("FI", symbol) <> 1 REP nextsymbol PER; + nextsymbol . + +skip thenteil : + WHILE (symboltyp <> eol) AND nicht elsefi REP nextsymbol PER; + nextsymbol . + +nicht elsefi : + j := pos ("ELSEFI", symbol); j = 0 . + +write : + feldkommando (textwert); zeile unveraendert . + +size : + IF bildlaenge > maxbildlaenge + THEN maxbildlaenge := bildlaenge + FI; + bildlaenge (max (1, min (zahlwert, maxbildlaenge))); + bildzeile (min (bildzeile, bildlaenge)); + bildrand (0); bildneu (TRUE); page . + +END PROC primary; + + +(*********** w i e d e r h o l u n g , b e d i n g u n g ***************) + +BOOL PROC wiederholung (DATEI VAR datei) : + + fix scanner ; (* Li 12.01.81 *) + wiederholt interpretieren; + skip endrep; typ := void; + NOT war fehler . + +wiederholt interpretieren : + REP reset scanner; nextsymbol; (* 12.01.81 *) + WHILE ausdruck (datei) REP UNTIL until PER; abbruchtest + UNTIL ende der wiederholung + PER . + +until : + IF pos ("UNTIL", symbol) = 1 + THEN nextsymbol; + IF primary (datei) THEN FI; + IF bedingung (datei) + THEN IF boolwert + THEN LEAVE wiederholt interpretieren;TRUE + ELSE TRUE + FI + ELSE fehler + FI + ELSE TRUE + FI . + +ende der wiederholung : + IF war fehler + THEN TRUE + ELIF datei (stelle).nachfolger = dateianker + THEN feldstelle > LENGTH (datei (stelle).inhalt) + ELSE FALSE + FI . + +skip endrep : + WHILE pos ("ENDREPEAT", symbol) <> 1 AND symboltyp <> eol + REP nextsymbol PER; + nextsymbol . + +abbruchtest : + IF is incharety (escape) + THEN fehler bearbeiten + FI . + +END PROC wiederholung; + +BOOL PROC bedingung (DATEI VAR datei) : + INT VAR relator; + relator := pos ("=><<=>=<>", symbol); + IF relator = 0 + THEN fehler + ELSE IF typ = texttyp THEN relator INCR 8 FI; + nextsymbol; + INT VAR operandtyp :: typ, operandzahlwert :: zahlwert; + TEXT VAR operandtextwert :: textwert; + IF primary (datei) THEN FI; + IF operandtyp <> typ + THEN fehler + ELSE boolwert := vergleich; typ := bool; TRUE + FI + FI . + +vergleich : + SELECT relator OF + CASE 1 : operandzahlwert = zahlwert + CASE 2 : operandzahlwert > zahlwert + CASE 3 : operandzahlwert < zahlwert + CASE 4 : operandzahlwert <= zahlwert + CASE 6 : operandzahlwert >= zahlwert + CASE 8 : operandzahlwert <> zahlwert + CASE 9 : operandtextwert = textwert + CASE 10 : operandtextwert > textwert + CASE 11 : operandtextwert < textwert + CASE 12 : operandtextwert <= textwert + CASE 14 : operandtextwert >= textwert + CASE 16 : operandtextwert <> textwert + OTHERWISE fehler + END SELECT . + +END PROC bedingung; + +(**************************** a u s d r u c k ****************************) + +BOOL PROC ausdruck (DATEI VAR datei) : + INT VAR opcode, operandtyp, operandzahlwert; + TEXT VAR operandtextwert; + IF primary (datei) + THEN BOOL VAR war operation :: TRUE; + WHILE operator AND war operation + REP IF primary (datei) + THEN war operation := operator verarbeiten + ELSE war operation := FALSE + FI + PER; + war operation + ELSE fehler + FI . + +operator : + IF kommandoende + THEN IF typ = integer + THEN row (datei) + ELIF typ = texttyp + THEN search (datei) + FI + FI; + opcode := pos (op2namen, "&" + symbol); + IF opcode = 0 + THEN FALSE + ELSE nextsymbol; operandtyp := typ; + operandzahlwert := zahlwert; + operandtextwert := textwert; + NOT war fehler + FI . + +operator verarbeiten : + SELECT opcode OF + CASE plus : + IF typ = integer + THEN zahlwert := operandzahlwert + zahlwert + ELSE textwert := operandtextwert + textwert + FI + CASE minus : + zahlwert := operandzahlwert - zahlwert + CASE mal : + IF typ = integer + THEN zahlwert := operandzahlwert * zahlwert + ELSE textwert := operandzahlwert * textwert + FI + CASE durch : + zahlwert := operandzahlwert DIV zahlwert + CASE changecode : + change + CASE semicolon : + OTHERWISE fehler bearbeiten + END SELECT; + NOT war fehler . + +change : + IF bildmarke <= 0 AND schreiberlaubnis AND bildstelle <> dateianker + THEN ersatz := textwert; textwert := operandtextwert; search (datei); + INT VAR fstelle :: feldstelle; + IF textwert = "" AND ersatz <> "" AND fstelle > LENGTH inhalt + THEN inhalt := text (inhalt, fstelle-1) + FI; + IF subtext (inhalt, fstelle-LENGTH textwert, fstelle-1) = textwert + THEN fstelle := fstelle - LENGTH textwert; + FOR j FROM 1 UPTO LENGTH ersatz + REP IF j <= LENGTH textwert + THEN replace (inhalt, fstelle, ersatz SUB j) + ELSE insert char (inhalt, ersatz SUB j, fstelle) + FI; + fstelle INCR 1 + PER; + FOR j FROM 1+LENGTH ersatz UPTO LENGTH textwert + REP delete char (inhalt, fstelle) PER; + FI; + feldstelle (fstelle); typ := void + ELSE fehler bearbeiten + FI . + +inhalt : + datei (stelle).inhalt . + +kommandoende : + SELECT pos (";FIELSEENDREPEATUNTIL", symbol) OF + CASE 1,2,4,8,17 : TRUE + OTHERWISE symboltyp = eol + END SELECT . + +END PROC ausdruck; + +(************************** schrott ****************************************) + +PROC satz erzeugen (DATEI VAR datei, INT VAR satz): + EXTERNAL 291 ; +END PROC satz erzeugen; + +PROC satz loeschen (DATEI VAR datei, INT VAR satz): + EXTERNAL 292 ; +END PROC satz loeschen; + +END PACKET dateieditorpaket; diff --git a/system/base/unknown/src/editor b/system/base/unknown/src/editor new file mode 100644 index 0000000..55fbfb1 --- /dev/null +++ b/system/base/unknown/src/editor @@ -0,0 +1,210 @@ + +PACKET editor DEFINES (* Autor: P.Heyderhoff *) + (* Stand: 26.04.82 *) + edit , (* Vers.: 1.6.3 *) + show , + editmode : + +FILE VAR file 1, file 2 ; + +PROC edit (FILE VAR file) : + x edit (file) ; +ENDPROC edit ; + +PROC edit (FILE VAR file 1, file 2) : + x edit (file 1, file 2 ) +ENDPROC edit ; + +PROC edit (TEXT CONST file name) : + last param (file name) ; + IF exists (file name) + THEN edit 1 (file name) + ELIF yes ("neue datei einrichten") + THEN edit 1 (file name) + ELSE errorstop ("") + FI +ENDPROC edit ; + +PROC edit : + edit (last param) +ENDPROC edit ; + +PROC edit 1 (TEXT CONST name) : + file 1 := sequential file (modify, name) ; + IF NOT is error + THEN edit (file 1) + FI +ENDPROC edit 1 ; + +PROC edit (TEXT CONST file name 1, file name 2) : + IF exists (file name 1) + THEN edit 2 (file name 1, file name 2) + ELIF yes ("erste datei neu einrichten") + THEN edit 2 (file name 1, file name 2) + ELSE errorstop ("") + FI +ENDPROC edit ; + +PROC edit 2 (TEXT CONST file name 1, file name 2) : + file 1 := sequential file (modify, file name 1) ; + IF exists (file name 2) + THEN file 2 := sequential file (modify, file name 2) ; + edit (file 1, file 2) + ELIF yes ("zweite datei neu einrichten") + THEN file 2 := sequential file (modify, file name 2) ; + edit (file 1, file 2) + ELSE errorstop ("") + FI +ENDPROC edit 2 ; + +PROC show (FILE VAR file) : + schreiberlaubnis (FALSE) ; + edit (file) ; + schreiberlaubnis (TRUE) +ENDPROC show ; + +PROC show (TEXT CONST file name) : + IF exists (file name) + THEN file 1 := sequential file (modify, file name) ; + show (file 1) ; + ELSE errorstop ("file does not exist") + FI +ENDPROC show ; + +PROC editmode : + feldwortweise (NOT feldwortweise) ; + say (" ") ; + IF feldwortweise + THEN say ("Flietext"13""10"") + ELSE say ("kein Umbruch"13""10"") + FI . + +ENDPROC editmode ; + + +(****************************** e d i t o r ******************************) + +LET DATEI = ROW 4075 STRUCT (INT nachfolger, vorgaenger, index, + fortsetzung, TEXT inhalt), + freianker = 1, dateianker = 2, satzmax = 4075, + bottom = ""6""23""0"" , escape = ""27"", escape w = ""27"w"; + +BOOL VAR war kein wechsel ; +TEXT VAR tabulator :: 77*" "; + + +PROC editor (DATEI VAR datei) : + enable stop ; + grundzustand; + zustand aus datei holen ; + + REP b i l d e d i t o r (datei); + d a t e i e d i t o r (datei) + UNTIL (feldkommando SUB 1) = escape + PER; + war kein wechsel := (feldkommando SUB 2) <> "w"; + feldkommando (subtext (feldkommando, 3)); + + IF schreiberlaubnis THEN zustand in datei retten FI; + schreiberlaubnis (TRUE); + out (bottom) . + +grundzustand : + bildneu (TRUE); bildeinfuegen (FALSE); bildmarke (0); + feldmarke (0); feldseparator (""); feldstelle(1); + feldeinfuegen (FALSE). + +zustand in datei retten : + inhalt := text (bildstelle, 5); + inhalt CAT text (bildsatz, 5); + inhalt CAT text (bildzeile, 5); + inhalt CAT text (feldlimit, 5); + feldtab (tabulator); + inhalt CAT tabulator . + +zustand aus datei holen : + INT CONST satz nr := int (subtext (inhalt, 1, 5)) ; + IF satz nr > 0 + THEN bildstelle (satz nr) + ELSE bildstelle (datei (dateianker).nachfolger) + FI ; + bildsatz (int (subtext (inhalt, 6, 10))); + bildzeile (int (subtext (inhalt, 11, 15))); + feldlimit (int (subtext (inhalt, 16, 20))); + tabulator := subtext (inhalt, 21) ; + feldtabulator (tabulator) . + +inhalt : + datei (freianker).inhalt . + +END PROC editor; + +PROC y edit (DATEI VAR datei) : + editor (datei); + close +END PROC y edit; + +LET begin mark = ""15"", endmark blank = ""14" "; + +PROC y edit (DATEI VAR erste datei, zweite datei) : + INT CONST alte laenge := bildlaenge - 1; + INT VAR laenge := alte laenge DIV 2, flen := feldende - feldanfang + 2; + bildlaenge (laenge); feldkommando (escape w); + zweimal editieren; + bildlaenge (alte laenge + 1); bildrand (0); + close . + +zweimal editieren: + page; + REP cursor ( 1, laenge + 2); out (begin mark); + cursor(flen, laenge + 2); out (endmark blank); + bildrand (0); editor (erste datei); laenge anpassen; + IF war kein wechsel THEN LEAVE zweimal editieren FI; + bildrand (alte laenge + 1 - laenge); + editor (zweite datei); laenge anpassen + UNTIL war kein wechsel + PER . + +laenge anpassen : + laenge := bildlaenge; + IF laenge = 1 THEN laenge := 2 FI; + IF laenge <= alte laenge - 2 + THEN laenge := alte laenge - laenge + ELSE laenge := 2 + FI ; bildlaenge (laenge) . +END PROC y edit; + +(**************** schrott ***********************) + +PROC x edit (FILE VAR f) : + EXTERNAL 296 +ENDPROC x edit ; + +PROC x edit (FILE VAR f1, f2) : + EXTERNAL 297 +ENDPROC x edit ; + +LET FDATEI= STRUCT ( BOUND DATEI f , + INT index, pointer, line counter, + mode, max line length, max page length, + BOOL edit status unchanged) ; + +PROC x edit (FDATEI VAR f1) : + INTERNAL 296 ; + y edit (CONCR (f1.f)) +ENDPROC x edit ; + +PROC x edit (FDATEI VAR f1, f2) : + INTERNAL 297 ; + y edit (CONCR (f1.f), CONCR (f2.f)) +ENDPROC x edit ; + +PROC dateieditor (DATEI VAR d) : + EXTERNAL 295 +ENDPROC dateieditor ; + +PROC bildeditor (DATEI VAR d) : + EXTERNAL 293 +ENDPROC bildeditor ; + +ENDPACKET editor ; diff --git a/system/base/unknown/src/elan b/system/base/unknown/src/elan new file mode 100644 index 0000000..744003d --- /dev/null +++ b/system/base/unknown/src/elan @@ -0,0 +1,245 @@ + +PACKET local manager part 2 DEFINES (* Autor: J.Liedtke *) + (* Stand: 29.04.80 *) + list , + file names : + + +FILE VAR list file ; +TEXT VAR file name, status text; + +PROC list : + + list file := sequential file (output) ; + headline (list file, "list") ; + list (list file) ; + show (list file) ; + close + +ENDPROC list ; + +PROC list (FILE VAR f) : + + begin list ; + putline (f, "") ; + REP + get list entry (file name, status text) ; + IF file name = "" + THEN LEAVE list + FI ; + out (f, status text + " """ ) ; + out (f, file name) ; + out (f, """") ; + line (f) + PER + +ENDPROC list ; + +PROC file names (FILE VAR f) : + + begin list ; + REP + get list entry (file name, status text) ; + IF file name = "" + THEN LEAVE file names + FI ; + putline (f, file name) + PER + +ENDPROC file names ; + +ENDPACKET local manager part 2 ; + + +PACKET elan DEFINES (*Autor: J.Liedtke *) + (*Stand: 01.05.82 *) + do , + run , + run again , + insert , + prot , + prot off , + check on , + check off : + + +LET newinit option = FALSE , + ins = TRUE , + no ins = FALSE , + lst = TRUE , + no lst = FALSE , + compiler dump option = FALSE , + sys option = TRUE , + stop at first error = TRUE , + multiple error analysis = FALSE , + sermon = TRUE , + no sermon = FALSE , + + run again mode = 0 , + compile file mode = 1 , + compile line mode = 2 , + + error message = 4 ; + +BOOL VAR list option := FALSE , + check option := TRUE , + errors occurred ; + +INT VAR run again mod nr := 0 ; +DATASPACE VAR ds ; + +FILE VAR error file, source file ; + + +PROC do (TEXT CONST command) : + + INT VAR dummy mod ; + run again mod nr := 0 ; + errors occurred := FALSE ; + elan (compile line mode, ds, command, dummy mod, + newinit option, no ins, compiler dump option, no lst, sys option, + check option, stop at first error, no sermon) ; + IF errors occurred + THEN forget (ds) ; + errorstop ("") + FI + +ENDPROC do ; + + +PROC run (TEXT CONST file name) : + + last param (file name) ; + run elan (file name, no ins) + +END PROC run; + +PROC run : + + run (last param) + +ENDPROC run ; + +PROC run again : + + IF run again mod nr > 0 + THEN INT VAR mod := run again mod nr ; + elan (run again mode, ds, "", run again mod nr, + newinit option, no ins, compiler dump option, no lst, + sys option, check option, stop at first error, no sermon) + ELSE errorstop ("run again impossible") + FI + +ENDPROC run again ; + +PROC insert (TEXT CONST file name) : + + last param (file name) ; + run elan (file name, ins) + +ENDPROC insert ; + +PROC insert : + + insert (last param) + +ENDPROC insert ; + +PROC run elan (TEXT CONST file name, BOOL CONST insert option) : + + IF exists (file name) + THEN compile and execute + ELSE errorstop ("file does not exist") + FI . + +compile and execute : + disable stop ; + errors occurred := FALSE ; + elan (compile file mode, old (file name, 1002), "" , run again mod nr, + newinit option, insert option, compiler dump option, list option, + sys option, check option, multiple error analysis, sermon) ; + + IF errors occurred + THEN ignore halt during compiling ; + errors occurred := FALSE ; + enable stop ; + source file := sequential file (modify, file name) ; + modify (error file) ; + edit (error file, source file) ; + forget (ds) + FI . + +ignore halt during compiling : + IF is error + THEN put error ; + clear error ; + pause (5) + FI . + +ENDPROC run elan ; + +PROC elan (INT CONST mode, DATASPACE CONST source, TEXT CONST line, + INT VAR start module number, + BOOL CONST newinit, ins, dump, lst, sys, rt check, error1, ser) : + EXTERNAL 256 +ENDPROC elan ; + +PROC out text (TEXT CONST text, INT CONST out type) : + + INTERNAL 257 ; + out (text) ; + IF out type = error message + THEN access error file ; + out (error file, text) + FI . + +access error file : + IF NOT errors occurred + THEN open error file + FI . + +ENDPROC out text ; + +PROC out line (INT CONST out type) : + + INTERNAL 258 ; + out (""13""10"") ; + IF out type = error message + THEN access error file ; + line (error file) + FI . + +access error file : + IF NOT errors occurred + THEN open error file + FI . + +ENDPROC out line ; + +PROC open error file : + + errors occurred := TRUE ; + forget (ds) ; + ds := nilspace ; + error file := sequential file (output, ds) ; + headline (error file, "errors") + +ENDPROC open error file ; + +PROC prot : + list option := TRUE +ENDPROC prot ; + +PROC prot off : + list option := FALSE +ENDPROC prot off ; + +PROC check on : + check option := TRUE +ENDPROC check on ; + +PROC check off : + check option := FALSE +ENDPROC check off ; + +ENDPACKET elan ; diff --git a/system/base/unknown/src/feldeditor b/system/base/unknown/src/feldeditor new file mode 100644 index 0000000..4156111 --- /dev/null +++ b/system/base/unknown/src/feldeditor @@ -0,0 +1,747 @@ + +PACKET f e l d e d i t o r DEFINES (* Autor: P.Heyderhoff *) + (*****************) (* Stand: 12.04.82 *) + (* Vers.: 1.6.0 *) + editget, + feldeditor, + feldout, + feldposition, + feldeinruecken, + feldtab, + feldtabulator, + feldseparator, + feldmarke, + feldstelle, + feldwortweise, + feldanfang, + feldende, + feldrand, + feldlimit, + feldaudit, + feldzeichen, + feldkommando, + feldeinfuegen, + feldlernmodus, + is incharety, + getchar, + min : + + +TEXT VAR tabulator :: "", separator :: "", fzeichen ::"", + kommando :: "", audit :: ""; + +INT VAR fmarke :: 0, fstelle :: 1, frand :: 0, limit :: 77, + fanfang :: 1, dyn fanfang :: fanfang, flaenge, fj, + fende :: 77, dyn fende :: fende, dezimalen :: 0; + +BOOL VAR wortweise :: FALSE, feinfuegen :: FALSE, + blankseparator :: FALSE, lernmodus :: FALSE, + war absatz; + +LET blank = " ", hop=""1"", right=""2"", up=""3"", clear eop=""4"", + clear eol=""5"", bell=""7"", left=""8"", tab=""9"", down=""10"", + rubin=""11"", rubout=""12"", cr=""13"", mark=""16"", escape=""27"", + hoechstes steuerzeichen=""31"", dach=""94"", end mark=""14"", begin + mark=""15"", clear=""1""4"", hop tab=""1""9"", hop rubin=""1""11"", + hop rubout=""1""12"", hop cr=""1""13"", cr down=""13""10"", + right left tab rubout escape = ""2""8""9""12""27"", hop escape=""1""27"", + left left=""8""8"", left endmark=""8""14"", endmark left=""14""8"", + left right=""8""2"", blank left=" "8"", + blank left rubout=" "8""12"", absatzmarke=""15""14"", + hop esc right left tab rubin rubout cr = ""1""27""2""8""9""11""12""13"", + hop esc right left tab down cr = ""1""27""2""8""9""10""13""; + +(*************************** p r o z e d u r e n *************************) + +PROC editget (TEXT VAR editsatz, INT CONST editlimit, editfende): + + disable stop ; (* J.Liedtke 10.02.82 *) + + INT CONST altflaenge :: LENGTH editsatz, altfrand :: frand, + altfmarke :: fmarke, altfstelle :: fstelle, + altfanfang :: fanfang, altfende :: fende, altlimit :: limit; + BOOL CONST altwortweise :: wortweise, altfeinfuegen :: feinfuegen; + fmarke := 0; fstelle := 1; fanfang := 1; dyn fanfang := 1; + fende := editfende MOD 256; dyn fende := fende; + limit := editlimit MOD 256; wortweise := FALSE; + feinfuegen := FALSE; + INT VAR x, y; get cursor (x,y); frand := x-1; + out (editsatz); cursor (x,y); + REP + feldeditor (editsatz); + IF (kommando SUB 1) = escape OR (kommando SUB 1) = hop + THEN delete char (kommando, 1) + FI; + delete char (kommando, 1) + UNTIL fzeichen = cr OR (fzeichen SUB 1) = separator OR is error + PER; + cursor (x + 1 + editflaenge - dyn fanfang, y); + fmarke := altfmarke; fstelle := altfstelle; fanfang := altfanfang; + dyn fanfang := fanfang; fende := altfende; dyn fende := fende; + limit := altlimit; wortweise := altwortweise; frand := altfrand; + feinfuegen := altfeinfuegen . + +editflaenge : + min (dyn fende, flaenge) . + +END PROC editget; + +PROC editget (TEXT VAR editsatz) : + INT VAR x, y; get cursor (x,y); + editget (editsatz, 255, fende-fanfang+2+frand-x) +END PROC editget; + +PROC feldout (TEXT CONST satz) : + INT VAR x, y; + flaenge := min (fende, LENGTH satz); + out (cr); + frand TIMESOUT right; feldrest loeschen (fanfang); + IF fmarke > 0 + THEN outsubtext (satz, fanfang, fmarke-1); out (begin mark); + outsubtext (satz, fmarke, min (fstelle-1,flaenge)); + out (end mark); outsubtext (satz, fstelle, flaenge); + ELIF absatzmarke noetig (satz) + THEN get cursor (x,y); outsubtext (satz, fanfang, flaenge); + cursor (x + fende + 1 - fanfang, y); out (absatzmarke) + ELSE outsubtext (satz, fanfang, flaenge) + FI +END PROC feldout; + + +PROC feld einruecken (TEXT CONST satz) : + + IF fstelle = fanfang + THEN fstelle := neue einrueckposition; + (fstelle-fanfang) TIMESOUT right + FI . + +neue einrueckposition : + INT VAR suchindex; + FOR suchindex FROM fanfang UPTO min (LENGTH satz, fende) + REP IF (satz SUB suchindex) <> blank + THEN LEAVE neue einrueckposition WITH suchindex + FI + PER; + fanfang . + +END PROC feld einruecken; + +TEXT PROC feldzeichen : + fzeichen +END PROC feldzeichen; + +TEXT PROC feldkommando : + kommando +END PROC feldkommando; + +PROC feldkommando (TEXT CONST t) : + kommando := t +END PROC feldkommando; + +PROC feldtab (TEXT VAR t) : + t := tabulator +END PROC feldtab; + +PROC feldtabulator (TEXT CONST t) : + tabulator := t +END PROC feldtabulator; + +TEXT PROC feldseparator : + separator +END PROC feldseparator; + +PROC feldseparator (TEXT CONST t) : + separator := t; blankseparator := t = blank +END PROC feldseparator; + +TEXT PROC feldaudit : + audit +END PROC feldaudit; + +PROC feldaudit (TEXT CONST a) : + audit := a +END PROC feldaudit; + +BOOL PROC feldlernmodus : + lernmodus +END PROC feldlernmodus; + +PROC feldlernmodus (BOOL CONST b) : + lernmodus := b +END PROC feldlernmodus; + +BOOL PROC feldeinfuegen : + feinfuegen +END PROC feldeinfuegen; + +PROC feldeinfuegen (BOOL CONST b): + feinfuegen := b +END PROC feldeinfuegen; + +BOOL PROC feldwortweise : + wortweise +END PROC feldwortweise; + +PROC feldwortweise (BOOL CONST b) : + wortweise := b +END PROC feldwortweise; + +INT PROC feldmarke : + fmarke +END PROC feldmarke; + +PROC feldmarke (INT CONST i) : + fmarke := i MOD 256 +END PROC feldmarke; + +INT PROC feldstelle : + fstelle +END PROC feldstelle; + +PROC feldstelle (INT CONST i) : + fstelle := i MOD 256 +END PROC feldstelle; + +INT PROC feldanfang : + fanfang +END PROC feldanfang; + +PROC feldanfang (INT CONST i) : + fanfang := i MOD 256; dyn fanfang := fanfang +END PROC feldanfang; + +INT PROC feldende : + fende +END PROC feldende; + +PROC feldende (INT CONST i) : + fende := i MOD 256; dyn fende := fende +END PROC feldende; + +INT PROC feldrand : + frand +END PROC feldrand; + +PROC feldrand (INT CONST i) : + frand := i MOD 256 +END PROC feldrand; + +INT PROC feldlimit : + limit +END PROC feldlimit; + +PROC feldlimit (INT CONST i) : + limit := i MOD 256 +END PROC feldlimit; + +PROC feldposition : + INT VAR x, y; + IF fstelle <= fende + THEN IF fstelle < fanfang + THEN fstelle := fanfang; + IF fanfang > fende + THEN fende := fanfang; dyn fende := fanfang + FI + FI + ELSE fstelle := fende; + IF fanfang > fende + THEN fanfang := fende; dyn fanfang := fende + FI + FI; + get cursor(x,y); cursor(1+frand+fstelle-fanfang+fmarke oder fstelle, y). + +fmarke oder fstelle : + IF fmarke > 0 THEN 1 ELSE 0 FI . + +END PROC feldposition; + +PROC feldposition (INT CONST i) : + fstelle := i; feldposition +END PROC feldposition; + +BOOL PROC absatzmarke noetig (TEXT CONST satz) : + + IF wortweise + THEN (satz SUB LENGTH satz) = blank + ELSE FALSE + FI +END PROC absatzmarke noetig; + +PROC zeile neu schreiben (TEXT CONST satz) : + INT VAR x,y; get cursor (x,y); + flaenge := min (dyn fende, LENGTH satz); + cursor (1+frand, y); + feldrest loeschen (dyn fanfang); + outsubtext (satz, dyn fanfang, flaenge); + cursor (x,y) +END PROC zeile neu schreiben; + +PROC feldrest loeschen (INT CONST fstelle): + INT VAR x,y; + IF frand + fende <= 76 + THEN get cursor (x,y); (1 + dyn fende - fstelle) TIMESOUT blank; + cursor (x,y) + ELSE out (clear eol); war absatz := FALSE + FI +END PROC feldrest loeschen; + +TEXT OP SUBB (TEXT CONST t, INT CONST i) : + IF i <= LENGTH t THEN t SUB i ELSE blank FI +END OP SUBB; + +INT PROC min (INT CONST a, b): + IF a < b THEN a ELSE b FI +END PROC min; + +BOOL PROC is incharety (TEXT CONST muster) : + + fzeichen := incharety; + IF fzeichen = "" + THEN FALSE + ELSE IF lernmodus + THEN audit CAT fzeichen; + IF fzeichen = """" THEN audit CAT fzeichen + FI FI ; + IF fzeichen = muster + THEN kommando := ""; TRUE + ELSE kommando CAT fzeichen; FALSE + FI FI +END PROC is incharety; + +PROC getchar (TEXT VAR fzeichen) : + + IF kommando = "" + THEN inchar (fzeichen) + ELSE fzeichen := kommando SUB 1; + delete char (kommando, 1); + kommando CAT incharety + FI; + IF lernmodus + THEN audit CAT fzeichen; + IF fzeichen = """" + THEN audit CAT fzeichen + FI + FI . +END PROC getchar; + + +(************************** f e l d e d i t o r **************************) + +PROC feldeditor (TEXT VAR satz) : + + enable stop ; (* J. Liedtke 10.02.82 *) + + INT VAR x, y; + BOOL VAR inkompetent :: FALSE; war absatz := absatzmarke noetig (satz); + IF fstelle <= fende + THEN IF fstelle < fanfang THEN feldposition FI + ELSE feldposition + FI; + flaenge := min (fende, LENGTH satz); + + REP e i n g a b e UNTIL inkompetent PER; + + blanks abschneiden; + IF dyn fanfang <> fanfang THEN zurechtruecken FI; + IF NOT war absatz AND absatzmarke noetig (satz) + THEN absatzmarke schreiben + ELIF war absatz AND NOT absatzmarke noetig (satz) + THEN absatzmarke loeschen + FI . + +absatzmarke schreiben : + get cursor (x,y); cursor (frand+fende-fanfang+2, y); out (absatzmarke); + cursor (x,y) . + +absatzmarke loeschen : + get cursor (x,y); cursor (frand+fende-fanfang+2, y); out (" "); + cursor (x,y) . + +zurechtruecken : + fstelle DECR (dyn fanfang - fanfang); + dyn fanfang := fanfang; dyn fende := fende; + zeile neu schreiben (satz) . + +blanks abschneiden : + flaenge := LENGTH satz; + FOR fj FROM flaenge DOWNTO 0 WHILE (satz SUB fj) = blank + REP delete char (satz, fj) PER; + IF fj < flaenge THEN satz CAT blank FI . + +eingabe : + IF fmarke <= 0 + THEN s c h r e i b e d i t o r; + IF ueberlaufbedingung + THEN ueberlauf + ELSE a u s f u e h r e n + FI + ELSE m a r k e d i t o r + FI . + +ueberlaufbedingung : + IF fstelle <= dyn fende + THEN IF fstelle <= limit + THEN FALSE + ELSE fzeichen > hoechstes steuerzeichen + FI + ELSE TRUE + FI . + +ueberlauf : + IF fstelle > limit + THEN IF wortweise OR fstelle > LENGTH satz + THEN ueberlauf in naechste zeile; LEAVE ueberlauf + FI + FI; + IF fstelle > dyn fende + THEN fstelle := dyn fende; out (left); + zeile um eins nach links verschieben + FI . + +ueberlauf in naechste zeile : + IF wortweise + THEN umbrechen + ELSE out (bell); kommando := cr + FI; + inkompetent := TRUE . + +umbrechen : + IF LENGTH satz > limit + THEN kommando CAT subtext (satz, limit+1); + FOR fj FROM LENGTH satz DOWNTO fstelle + REP kommando CAT left PER; + satz := subtext (satz, 1, limit) + FI; + fj := limit; + zeichen zuruecknehmen; + (fstelle-fj) TIMESOUT left; fstelle := fj; feldrest loeschen (fstelle); + IF kommando = "" THEN kommando := blank left rubout FI; + blanks loeschen. + +blanks loeschen: + REP fj DECR 1; + IF (satz SUB fj) <> blank THEN LEAVE blanks loeschen FI; + delete char (satz, fj) + PER . + +zeichen zuruecknehmen: + REP fzeichen := satz SUB fj; delete char (satz, fj); + IF fzeichen = blank THEN LEAVE zeichen zuruecknehmen FI; + insert char (kommando, fzeichen, 1); + IF fj = fanfang THEN LEAVE zeichen zuruecknehmen FI; + fj DECR1 + PER. + +ausfuehren : + dezimalen := 0; + SELECT pos (hop esc right left tab rubin rubout cr, fzeichen) OF + CASE 1 : getchar (fzeichen); + SELECT pos (right left tab rubout escape, fzeichen) OF + CASE 1 : zum rechten frand + CASE 2 : zum linken frand + CASE 3 : tabulator setzen + CASE 4 : zeile loeschen + CASE 5 : bei lernmodus ein zeichen lesen + OTHERWISE hop return + END SELECT + CASE 2 : escape aktion + CASE 3 : nach rechts + CASE 4 : nach links + CASE 5 : nach tabulator + CASE 6 : feinfuegen umschalten + CASE 7 : ausfuegen + CASE 8 : ggf absatz erzeugen; return + OTHERWISE return + END SELECT . + +ggf absatz erzeugen : + IF wortweise + THEN IF fstelle > LENGTH satz + THEN IF (satz SUB LENGTH satz) <> blank + THEN satz CAT blank; fstelle INCR 1 + FI + FI + FI . + +nach rechts : + IF fstelle < dyn fende AND (fstelle < limit OR fstelle < flaenge) + THEN out (right); fstelle INCR1 + ELIF LENGTH satz > dyn fende + THEN zeile um eins nach links verschieben + ELSE return + FI . + +nach links : + IF fstelle > dyn fanfang + THEN out (left); fstelle DECR1 + ELIF dyn fanfang = fanfang + THEN out (bell) + ELSE zeile um eins nach rechts verschieben + FI . + +bei lernmodus ein zeichen lesen : + IF lernmodus + THEN getchar (fzeichen); return; + fzeichen := escape + FI; + hop return; fzeichen := hop escape . + +zeile um eins nach links verschieben : + dyn fanfang INCR 1; dyn fende INCR 1; + fstelle := dyn fende; zeile neu schreiben (satz) . + +zeile um eins nach rechts verschieben : + dyn fanfang DECR 1; dyn fende DECR 1; + fstelle := dyn fanfang; zeile neu schreiben (satz) . + +feinfuegen umschalten : + IF feinfuegen + THEN feinfuegen := FALSE + ELSE feinfuegen := TRUE; get cursor (x,y); out (dach); + outsubtext (satz, fstelle, flaenge); + cursor (x,y); pause (1); + feldrest loeschen (fstelle); + outsubtext (satz, fstelle, flaenge); + cursor (x,y) + FI; + return . + +ausfuegen : + IF flaenge < dyn fanfang OR fstelle > flaenge + THEN IF fstelle = flaenge + 1 AND fstelle > dyn fanfang + THEN fstelle := flaenge; out (left) + ELSE out (bell); + LEAVE ausfuegen + FI + FI; + ausfuegeoperation; delete char (satz, fstelle); + flaenge := min (dyn fende, LENGTH satz) . + +ausfuegeoperation : + get cursor (x,y); outsubtext (satz, fstelle+1, flaenge+1); + out (blank); cursor (x,y) . + +zum linken frand : + IF fstelle > fanfang + THEN get cursor (x,y); cursor (1+frand, y); + IF dyn fanfang = fanfang + THEN fstelle := fanfang + ELSE verschieben an linken frand + FI + FI . + +zum rechten frand : + fj := min (dyn fende, limit); get cursor (x,y); + IF LENGTH satz > fj + THEN IF fstelle >= LENGTH satz + THEN out (bell) + ELIF LENGTH satz > dyn fende + THEN verschieben an rechten frand + ELSE cursor (x + LENGTH satz - fstelle, y); + fstelle := LENGTH satz + FI + ELIF fstelle < fj + THEN cursor (x + fj-fstelle, y); fstelle := fj + FI . + +verschieben an linken frand : + dyn fanfang := fanfang; dyn fende := fende; + fstelle := fanfang; zeile neu schreiben (satz). + +verschieben an rechten frand : + (dyn fende - fstelle) TIMESOUT right; + dyn fanfang INCR (LENGTH satz - dyn fende); dyn fende := LENGTH satz; + fstelle := dyn fende; zeile neu schreiben (satz). + +nach tabulator : + fj := pos (tabulator, "^", fstelle+1); + IF fj = 0 + THEN IF (satz SUB fstelle) = blank AND fstelle = fanfang + THEN IF satz = blank + THEN fstelle INCR 1; out (right) + ELSE out (blank left); feld einruecken (satz); + FI; + LEAVE nach tabulator + ELIF flaenge < dyn fende AND fstelle <= flaenge + THEN fj := flaenge + 1 + FI + ELSE dezimalen := 1 + FI; + IF fj > 0 AND fj <= dyn fende + THEN outsubtext (satz, fstelle, fj-1); fstelle := fj + ELSE (fstelle-dyn fanfang) TIMESOUT left; + fstelle := dyn fanfang; insert char (kommando, down, 1) + FI . + +tabulator setzen : + IF (tabulator SUB fstelle) = "^" + THEN fzeichen := right + ELSE fzeichen := "^" + FI; + WHILE fstelle > LENGTH tabulator + REP tabulator CAT right PER; + replace (tabulator, fstelle, fzeichen); + insert char (kommando, tab, 1); + insert char (kommando, hop, 1); + inkompetent := TRUE . + +zeile loeschen : + IF fstelle = 1 + THEN satz := ""; feldrest loeschen (fstelle); hop return + ELIF fstelle <= flaenge + THEN REP delete char (satz, LENGTH satz) + UNTIL fstelle > LENGTH satz + PER; + flaenge := fstelle - 1; feldrest loeschen (fstelle) + ELSE hop return + FI . + +(*********************** s c h r e i b e d i t o r ***********************) + +schreibeditor : + REP getchar (fzeichen); + IF fzeichen <= hoechstes steuerzeichen THEN LEAVE schreibeditor + ELIF separator bedingung THEN LEAVE schreibeditor + ELSE f o r t s c h r e i b e n FI + PER . + +separatorbedingung : + IF blankseparator + THEN IF flaenge + 2 <= fstelle + THEN insert char (kommando, fzeichen, 1); + fzeichen := blank + FI + FI; + fzeichen = separator . + +fortschreiben : + IF dezimalen > 0 THEN dezimaltabulator FI; + out (fzeichen); + IF fstelle > flaenge + THEN anhaengen + ELIF dezimalen = 0 AND feinfuegen + THEN insert char (satz, fzeichen, fstelle) + ELSE replace (satz, fstelle, fzeichen) + FI; + flaenge := min (dyn fende, LENGTH satz); + fstelle INCR 1; + IF feinfuegen AND dezimalen = 0 AND fstelle <= flaenge + THEN zeilenrest neu schreiben + FI; + IF fstelle > dyn fende + OR fstelle > limit AND (wortweise OR fstelle > flaenge) + THEN LEAVE schreibeditor + FI . + +zeilenrest neu schreiben : + get cursor (x,y); outsubtext (satz, fstelle, flaenge); cursor (x,y) . + +dezimaltabulator : + IF fzeichen < "0" OR fzeichen > "9" + THEN dezimalen := 0 + ELIF dezimalen = 1 + THEN IF (satz SUB fstelle) = blank OR fstelle > flaenge + THEN dezimalen := 2 + ELSE dezimalen := 0 + FI + ELIF (satz SUB fstelle-dezimalen) = blank + THEN replace (satz, fstelle-dezimalen, + subtext (satz, fstelle-dezimalen+1, fstelle-1)) ; + dezimalen TIMESOUT left; + outsubtext (satz, fstelle-dezimalen, fstelle-2); + dezimalen INCR 1; fstelle DECR 1 + ELSE dezimalen := 0 + FI . + +anhaengen : + FOR fj FROM flaenge+2 UPTO fstelle + REP satz CAT blank PER; + satz CAT fzeichen . + + +(************************** m a r k e d i t o r **************************) + +markeditor : + getchar (fzeichen); + SELECT pos (hop esc right left tab down cr, fzeichen) OF + CASE 1 : getchar (fzeichen); + IF fzeichen = right THEN markierung maximal + ELIF fzeichen = left THEN markierung minimal + ELSE hop return + FI + CASE 2 : escape aktion + CASE 3 : markierung verlaengern + CASE 4 : markierung verkuerzen + CASE 5 : markierung bis tab verlaengern + CASE 6,7 : zeilenrest markieren + OTHERWISE IF fzeichen <= hoechstes steuerzeichen + THEN return + ELSE out (bell) + FI + END SELECT . + +markierung verlaengern : + IF fstelle <= flaenge + THEN out (satz SUB fstelle, end mark left); fstelle INCR 1 + ELSE return + FI . + +markierung maximal : + IF fstelle <= flaenge + THEN outsubtext (satz, fstelle, flaenge); out (end mark left); + fstelle := flaenge + 1 + FI . + +zeilenrest markieren : + IF fstelle <= flaenge + THEN outsubtext (satz, fstelle, flaenge); + out (end mark left); + (flaenge-fstelle+2) TIMESOUT left + FI; + return . + +markierung verkuerzen : + IF fstelle > fmarke + THEN fstelle DECR 1; + out (left end mark, satz SUBB fstelle, left left) + ELSE out (bell) + FI . + +markierung minimal : + IF fstelle > fmarke + THEN (fstelle-fmarke) TIMESOUT left; out (end mark); + outsubtext (satz, fmarke, fstelle-1); + (fstelle-fmarke+1) TIMESOUT left; fstelle := fmarke + FI . + +markierung bis tab verlaengern : + fj := pos (tabulator, "^", fstelle + 1); + IF fj = 0 + THEN fj := flaenge - fstelle + 1; IF fj <= 0 THEN return FI + ELSE fj DECR fstelle + FI; + IF fj > 0 + THEN outsubtext (satz, fstelle, min (fstelle+fj-1, flaenge)); + out (end mark left) + FI; + fstelle INCR fj; + IF fstelle > (dyn fende+1) THEN return FI . + + +(******************* allgemein verwendete refinements *********************) + +return : + insert char (kommando, fzeichen, 1); + inkompetent := TRUE . + +hop return : + return; insert char (kommando, hop, 1) . + +escape aktion : + getchar (fzeichen); return; + insert char (kommando, escape, 1); + insert char (fzeichen, escape, 1) . + +END PROC feldeditor; + +END PACKET feldeditor; diff --git a/system/base/unknown/src/file b/system/base/unknown/src/file new file mode 100644 index 0000000..e556bec --- /dev/null +++ b/system/base/unknown/src/file @@ -0,0 +1,810 @@ + +PACKET file DEFINES (* Autor: J.Liedtke *) + (* Stand: 30.04.82 *) + FILE , + := , + input , + output , + modify , + sequential file , + getline , + putline , + line , + reset , + eof , + put , + get , + page , + out , + eop , + close , + max line length , + max page length , + read record , + write record , + forward , + backward , + delete record , + insert record , + to first record , + to eof , + is first record , + headline , + copy attributes , + reorganize , + feldeditor , + feldout , + feldeinruecken , + pos , + change , + subtext , + sort : + + + +TYPE FILE = STRUCT ( BOUND DATEI f , + INT index, pointer, line counter, + mode, max line length, max page length, + BOOL edit status unchanged) ; + +TYPE TRANSPUTDIRECTION = INT ; + +LET closed = 1 , + in = 2 , + outp = 3 , + mod = 4 , + end = 5 , + escape = ""27"" , + + nullzustand = " 0 1 1" , + + max length = 15 000 ; (* < maxint/2 because 2 * maxlength possible*) + + +TRANSPUTDIRECTION PROC input : + TRANSPUTDIRECTION : ( in ) +ENDPROC input ; + +TRANSPUTDIRECTION PROC output : + TRANSPUTDIRECTION : ( outp ) +ENDPROC output ; + +TRANSPUTDIRECTION PROC modify : + TRANSPUTDIRECTION : ( mod ) +ENDPROC modify ; + +LET DATEI = ROW 4075 STRUCT ( + INT nachfolger, vorgaenger, index, fortsetzung, + TEXT inhalt ) ; + +LET anker = 2 , + freianker = 1 ; + +TEXT VAR number word ; + +FILE VAR result file ; + +DATASPACE VAR scratch space ; +close ; + + +FILE PROC sequential file (TRANSPUTDIRECTION CONST mode) : + + IF CONCR (mode) = outp + THEN close + FI ; + sequential file (mode, scratch space) + +ENDPROC sequential file ; + +FILE PROC sequential file (TRANSPUTDIRECTION CONST mode, + DATASPACE VAR ds) : + + IF type (ds) = 1002 + THEN result file.f := ds + ELIF type (ds) < 0 + THEN result file.f := ds ; + type (ds, 1002) ; + datei initialisieren (CONCR (result file.f)) + ELSE errorstop ("dataspace has wrong type") ; + result file.f := scratch space + FI ; + result file.mode := CONCR (mode) ; + reset (result file) ; + result file.max line length := max line length (result file) ; + result file.max page length := 0 ; + + result file . + +ENDPROC sequential file ; + + +FILE PROC sequential file (TRANSPUTDIRECTION CONST mode, + TEXT CONST name ) : + + IF exists (name) + THEN get dataspace if file + ELIF CONCR (mode) <> in + THEN get new file space + ELSE errorstop ("input file not existing") ; + result file.f := scratch space + FI ; + IF CONCR (mode) <> in + THEN status (name, "") ; + headline (result file, name) + FI ; + result file.mode := CONCR (mode) ; + reset (result file) ; + result file.max line length := max line length (result file) ; + result file.max page length := 0 ; + + result file . + +get new file space : + result file.f := new (name) ; + IF NOT is error + THEN type (old (name), 1002) ; + datei initialisieren ( CONCR (result file.f) ) + FI . + +get dataspace if file : + result file.f := old (name, 1002) . + +ENDPROC sequential file ; + +INT PROC max line length (FILE CONST file) : + + int (subtext (zustand, 16, 20)) . + +zustand : + CONCR (file.f) (freianker).inhalt . + +ENDPROC max line length ; + +PROC max line length (FILE VAR file, INT CONST length) : + + replace (zustand, 16, text (length,5)) . + +zustand : + CONCR (file.f) (freianker).inhalt . + +ENDPROC max line length ; + +PROC headline (FILE VAR file, TEXT CONST head) : + + CONCR (file.f)(anker).inhalt := head + +ENDPROC headline ; + +TEXT PROC headline (FILE VAR file) : + + CONCR (file.f)(anker).inhalt + +ENDPROC headline ; + +PROC copy attributes (FILE CONST source, FILE VAR dest) : + + dest attributes := source attributes ; + reset edit status (dest) ; + dest headline := source headline . + +dest attributes : CONCR (dest.f) (freianker).inhalt . +source attributes : CONCR (source.f) (freianker).inhalt . + +dest headline : CONCR (dest.f) (anker).inhalt . +source headline : CONCR (source.f) (anker).inhalt . + +ENDPROC copy attributes ; + + +PROC input (FILE VAR file) : + + file.mode := in ; + reset (file) + +ENDPROC input ; + +PROC output (FILE VAR file) : + + file.mode := outp ; + reset (file) + +ENDPROC output ; + +PROC modify (FILE VAR file) : + + file.mode := mod ; + reset (file) + +ENDPROC modify ; + + +PROC putline (FILE VAR file, TEXT CONST record) : + + check mode (file, outp) ; + line (file) ; + CONCR (file.f)(file.index).inhalt := record ; + file.pointer := max length + +ENDPROC putline ; + + +PROC getline (FILE VAR file, TEXT VAR record) : + + check mode (file, in) ; + line (file) ; + record := CONCR (file.f)(file.index).inhalt ; + file.pointer := max length + +ENDPROC getline ; + + +PROC line (FILE VAR file) : + + file.index := CONCR (file.f) (file.index).nachfolger ; + file.pointer := 0 ; + IF file.mode = in + THEN check eof + ELIF file.mode = outp + THEN satz erzeugen (CONCR (file.f), file.index) ; + CONCR (file.f)(file.index).inhalt := "" ; + perhaps implicit page feed + FI . + +check eof : + IF eof + THEN file.mode := end + FI . + +eof : CONCR (file.f)(file.index).nachfolger = anker . + +perhaps implicit page feed : + file.line counter INCR 1 ; + IF file.line counter = file.max page length + THEN page (file) + FI . + +ENDPROC line ; + +PROC check mode (FILE CONST file, INT CONST mode) : + + IF file.mode = mode + THEN LEAVE check mode + ELIF file.mode = closed + THEN errorstop ("file not open") + ELIF file.mode = mod + THEN errorstop ("operation not in transputdirection 'modify'") + ELIF mode = mod + THEN errorstop ("operation only in transputdirection 'modify'") + ELIF file.mode = end + THEN IF eof (file) THEN errorstop ("input after end of file") FI + ELIF mode = in + THEN errorstop ("input access to output file") + ELIF mode = outp + THEN errorstop ("output access to input file") + FI + +ENDPROC check mode ; + +PROC reset (FILE VAR file) : + + file.pointer := max length ; + file.line counter := 0 ; + file.edit status unchanged := TRUE ; + initialize file index ; + set correct file mode . + +initialize file index : + IF file.mode = outp + THEN file.index := last record + ELSE file.index := anker + FI . + +set correct file mode : + IF file.mode = end + THEN file.mode := in + FI ; + IF file.mode = in AND empty file + THEN file.mode := end + FI . + +last record : CONCR (file.f) (anker).vorgaenger . + +empty file : CONCR (file.f) (anker).nachfolger = anker . + +ENDPROC reset ; + +BOOL PROC eof (FILE CONST file) : + + IF file.mode = end + THEN end of record + ELIF file.mode = mod + THEN file.index = anker + ELSE FALSE + FI . + +end of record : + file.pointer >= length (CONCR (file.f)(file.index).inhalt) . + +ENDPROC eof ; + +PROC line (FILE VAR file, INT CONST lines) : + + check mode (file, outp) ; + INT VAR i ; + FOR i FROM 1 UPTO lines REP + line (file) + PER + +ENDPROC line ; + +PROC page (FILE VAR file) : + + file.line counter := 0 ; + putline (file, "#page") + +ENDPROC page ; + +BOOL PROC eop (FILE CONST file) : + + CONCR (file.f)(file.index).inhalt = "#page" + +ENDPROC eop ; + +PROC put (FILE VAR file, TEXT CONST word) : + + check mode (file, outp) ; + IF file.pointer + LENGTH word >= file.max line length + THEN line (file) + FI ; + put word (CONCR (file.f)(file.index).inhalt, word, file.pointer) + +ENDPROC put ; + +PROC put word (TEXT VAR record, TEXT CONST word, INT VAR pointer) : + + IF pointer > 0 + THEN record CAT " " ; + FI ; + record CAT word ; + pointer := LENGTH record + +ENDPROC put word ; + +PROC put (FILE VAR f, INT CONST value) : + + put (f, text (value) ) + +ENDPROC put ; + +PROC put (FILE VAR f, REAL CONST real) : + + put (f, text (real) ) + +ENDPROC put ; + +PROC out (FILE VAR file, TEXT CONST word) : + + check mode (file, outp) ; + IF file.pointer + LENGTH word >= file.max line length + THEN line (file) + FI ; + record CAT word ; + file.pointer INCR LENGTH word . + +record : CONCR (file.f)(file.index).inhalt . + +ENDPROC out ; + +PROC get (FILE VAR file, TEXT VAR word, TEXT CONST separator) : + + check mode (file, in) ; + get word (CONCR (file.f)(file.index).inhalt, word, + file.pointer, max length, separator) + +ENDPROC get ; + +PROC get (FILE VAR file, TEXT VAR word, INT CONST max length) : + + check mode (file, in) ; + get word (CONCR (file.f)(file.index).inhalt, word, + file.pointer, max length, "") + +ENDPROC get ; + +PROC get (FILE VAR file, TEXT VAR word) : + + check mode (file, in) ; + next word (file, CONCR (file.f)(file.index).inhalt, word) + +ENDPROC get ; + +PROC next word (FILE VAR file, TEXT CONST record, TEXT VAR word) : + + get next non blank char ; + IF char found + THEN get word (record, word, file.pointer, max length, " ") + ELIF last line of file + THEN word := "" ; + file.pointer := max length + ELSE line (file) ; + get (file, word) + FI . + +get next non blank char : + TEXT VAR char ; + REP + file.pointer INCR 1 ; + char := record SUB file.pointer + UNTIL char <> " " PER ; + file.pointer DECR 1 . + +char found : char <> "" . + +last line of file : + CONCR (file.f) (anker).nachfolger = anker . + +ENDPROC next word ; + +PROC get (FILE VAR f, INT VAR number) : + + get (f, number word) ; + number := int (number word) + +ENDPROC get ; + +PROC get (FILE VAR f, REAL VAR number) : + + get (f, number word) ; + number := real (number word) + +ENDPROC get ; + +PROC get word (TEXT CONST record, TEXT VAR word, INT VAR pointer, + INT CONST max length, TEXT CONST separator) : + + INT VAR end of word := pos (record, separator, pointer+1) - 1 ; + IF end of word < 0 + THEN end of word := pointer + max length + FI ; + word := subtext (record, pointer+1, end of word) ; + pointer := end of word + 1 + +ENDPROC get word ; + +PROC close (FILE VAR file) : + + file.mode := closed + +ENDPROC close ; + +PROC close : + + disable stop ; + forget (scratch space) ; + scratch space := nilspace + +ENDPROC close ; + +INT PROC max page length (FILE CONST file) : + file.max page length +ENDPROC max page length ; + +PROC max page length (FILE VAR file, INT CONST length) : + file.max page length := length +ENDPROC max page length + + +PROC read record (FILE CONST file, TEXT VAR record) : + + check mode (file, mod) ; + record := CONCR (file.f) (file.index).inhalt + +ENDPROC read record ; + +PROC write record (FILE VAR file, TEXT CONST record) : + + check mode (file, mod) ; + CONCR (file.f) (file.index).inhalt := record + +ENDPROC write record ; + +PROC forward (FILE VAR file) : + + check mode (file, mod) ; + IF file.index <> anker + THEN file.index := CONCR (file.f) (file.index).nachfolger + ELSE errorstop ("forward at eof") + FI + +ENDPROC forward ; + +PROC backward (FILE VAR file) : + + check mode (file, mod) ; + file.index := CONCR (file.f) (file.index).vorgaenger ; + IF file.index = anker + THEN to first record (file) ; + errorstop ("backward at first record") + FI + +ENDPROC backward ; + +PROC delete record (FILE VAR file) : + + check mode (file, mod) ; + IF file.edit status unchanged + THEN reset edit status (file) + FI ; + satz loeschen (CONCR (file.f), file.index) + +ENDPROC delete record ; + +PROC insert record (FILE VAR file) : + + check mode (file, mod) ; + IF file.edit status unchanged + THEN reset edit status (file) + FI ; + satz erzeugen (CONCR (file.f), file.index) + +ENDPROC insert record ; + +PROC to first record (FILE VAR file) : + + check mode (file, mod) ; + file.index := CONCR (file.f) (anker).nachfolger + +ENDPROC to first record ; + +PROC to eof (FILE VAR file) : + + check mode (file, mod) ; + file.index := anker + +ENDPROC to eof ; + +BOOL PROC is first record (FILE CONST file) : + + file.index = CONCR (file.f) (anker).nachfolger + +ENDPROC is first record ; + +PROC reset edit status (FILE VAR file) : + + replace (zustand, 1, nullzustand) ; + file.edit status unchanged := FALSE . + +zustand : CONCR (file.f)(freianker).inhalt . + +ENDPROC reset edit status ; + + +FILE VAR scratch , file ; +TEXT VAR record ; + +LET esc = ""27"" ; + +PROC reorganize (TEXT CONST file name) : + + IF exists (file name) + THEN last param (file name) ; + reorganize file + ELSE errorstop ("file does not exist") + FI . + +reorganize file : + scratch := sequential file (output) ; + headline (scratch, file name) ; + IF format 15 + THEN set to 16 file type ; + file := sequential file (input, file name) + ELSE file := sequential file (input, file name) ; + copy attributes (file, scratch) + FI ; + + disable stop ; + + INT VAR counter := 0 ; + WHILE NOT eof (file) REP + getline (file, record) ; + putline (scratch, record) ; + counter INCR 1 ; + cout (counter) ; + IF is incharety (escape) OR is error + THEN close ; + LEAVE reorganize + FI + PER ; + forget file ; + copy (scratch space, file name) ; + close . + +forget file : + BOOL CONST old status := command dialogue ; + command dialogue (FALSE) ; + forget (file name) ; + command dialogue (old status) . + +format 15 : type (old (file name)) = 1001 . + +set to 16 file type : + type (old (file name), 1002) . + +ENDPROC reorganize ; + +PROC reorganize : + + reorganize (last param) + +ENDPROC reorganize ; + +PROC feldout (FILE CONST file, TEXT CONST satz) : + + feldout ( CONCR (file.f) (file.index).inhalt ) + +ENDPROC feldout ; + +PROC feldeinruecken (FILE CONST file, TEXT CONST satz) : + + feldeinruecken ( CONCR (file.f) (file.index).inhalt ) + +ENDPROC feldeinruecken ; + +PROC feldeditor (FILE VAR file, TEXT CONST satz) : + + feldeditor ( CONCR (file.f) (file.index).inhalt ) + +ENDPROC feldeditor ; + +INT PROC pos (FILE CONST file, TEXT CONST pattern, INT CONST from) : + + pos ( CONCR (file.f) (file.index).inhalt, pattern, from ) + +ENDPROC pos ; + +PROC change (FILE VAR file, INT CONST from, to, TEXT CONST new) : + + change ( CONCR (file.f) (file.index).inhalt, from, to, new ) + +ENDPROC change ; + +TEXT PROC subtext (FILE CONST file, INT CONST from) : + + record := subtext ( CONCR (file.f) (file.index).inhalt, from ) ; + record + +ENDPROC subtext ; + +TEXT PROC subtext (FILE CONST file, INT CONST from, to) : + + record := subtext ( CONCR (file.f) (file.index).inhalt, from, to ) ; + record + +ENDPROC subtext ; + +(* sortieren sequentieller Dateien Autor: P.Heyderhoff *) + (* Stand: 14.11.80 *) + +BOUND DATEI VAR datei; +INT VAR sortierstelle, sortanker, byte; +TEXT VAR median, tausch ; + +PROC sort (TEXT CONST dateiname) : + sortierstelle := feldanfang; sort (dateiname, "") + END PROC sort; + +PROC sort (TEXT CONST dateiname, INT CONST sortieranfang) : + sortierstelle := sortieranfang; sort (dateiname, "") + END PROC sort; + +PROC sort (TEXT CONST dateiname, feldname) : + IF exists (dateiname) + THEN datei := old (dateiname); + IF CONCR(datei) (freianker).nachfolger <> freianker + THEN reorganize (dateiname) + FI ; + sortanker := 3; + IF feldname = "" + THEN byte := 0 + ELSE feldname in feldnummer uebersetzen + FI; + quicksort(sortanker, CONCR(datei)(freianker).fortsetzung-1) + FI . +feldname in feldnummer uebersetzen : + byte := pos (CONCR(datei) (sortanker).inhalt, feldname); + IF byte > 0 + THEN byte := pos (CONCR(datei) (sortanker).inhalt, code(255-byte)) + FI; + IF byte = 0 + THEN errorstop ("sort: feldname"); LEAVE sort + FI ; sortanker INCR 1 . + END PROC sort; + +PROC quicksort ( INT CONST anfang, ende ) : + IF anfang < ende + THEN INT VAR p,q; + spalte (anfang, ende, p, q); + quicksort (anfang, q); + quicksort (p, ende) FI + END PROC quicksort; + +PROC spalte (INT CONST anfang, ende, INT VAR p, q): + fange an der seite an und waehle den median; + ruecke p und q so dicht wie moeglich zusammen; + hole ggf median in die mitte . + + fange an der seite an und waehle den median : + p := anfang; q := ende ; + INT CONST m :: (p + q) DIV 2 ; + median := subtext(datei m, merkmal m) . + + ruecke p und q so dicht wie moeglich zusammen : + REP schiebe p und q so weit wie moeglich auf bzw ab; + IF p < q THEN vertausche die beiden FI + UNTIL p > q END REP . + + vertausche die beiden : + tausch := datei p; datei p := datei q; datei q := tausch; + p INCR 1; q DECR 1 . + + schiebe p und q so weit wie moeglich auf bzw ab : + WHILE p kann groesser werden REP p INCR 1 END REP; + WHILE q kann kleiner werden REP q DECR 1 END REP . + + p kann groesser werden : + IF p <= ende THEN subtext (datei p, merkmal p) <= median ELSE FALSE FI . + + q kann kleiner werden : + IF q >= anfang THEN subtext(datei q,merkmal q) >= median ELSE FALSE FI . + + hole ggf median in die mitte : + IF m < q THEN vertausche m und q + ELIF m > p THEN vertausche m und p FI . + + vertausche m und q : + tausch := datei m; datei m := datei q; datei q := tausch; q DECR 1 . + + vertausche m und p : + tausch := datei m; datei m := datei p; datei p := tausch; p INCR 1 . + + merkmal m : + IF byte = 0 THEN sortierstelle ELSE 255 - code (datei m SUB byte) FI . + + merkmal p : + IF byte = 0 THEN sortierstelle ELSE 255 - code (datei p SUB byte) FI . + + merkmal q : + IF byte = 0 THEN sortierstelle ELSE 255 - code (datei q SUB byte) FI . + + datei m : CONCR(datei)(m).inhalt . + datei p : CONCR(datei)(p).inhalt . + datei q : CONCR(datei)(q).inhalt . + +END PROC spalte; + + +(*********** schrott ************) + +OP := (FILE VAR a, FILE CONST b) : + EXTERNAL 294 +ENDOP := ; + +PROC becomes (ROW 8 INT VAR a, b) : + INTERNAL 294 ; + a := b +ENDPROC becomes ; + +PROC datei initialisieren (DATEI VAR datei) : + EXTERNAL 290 ; +END PROC datei initialisieren; + +PROC satz erzeugen (DATEI VAR datei, INT VAR satz): + EXTERNAL 291; +END PROC satz erzeugen; + +PROC satz loeschen (DATEI VAR datei, INT VAR satz): + EXTERNAL 292 ; +END PROC satz loeschen; + +ENDPACKET file ; diff --git a/system/base/unknown/src/init b/system/base/unknown/src/init new file mode 100644 index 0000000..02b8e74 --- /dev/null +++ b/system/base/unknown/src/init @@ -0,0 +1,250 @@ + " Compiler Error : " +" " +" |" +" Fehler entdeckt " +"Keine Fehler gefunden, " +" Sekunden CPU-Zeit verbraucht" +" ******* ENDE DER UEBERSETZUNG *******" +"FEHLER bei >> " +" << " +"weiter bei " +" (" ") " +"EOF im Programm" +"EOF beim Skippen" +"EOF im TEXT Denoter" +"EOF im Kommentar" +"' nach Bold fehlt" +"das MAIN PACKET muss das letzte sein" +"ungueltiger Name fuer ein Interface Objekt" +"':' fehlt" +"nach ENDPACKET folgt nicht der Paketname" +"ENDPACKET fehlt" +"CONST oder VAR fehlt" +"ungueltiger Name" +" ',' in Deklarationsliste fehlt" +"ist nicht der PROC Name" +"fehlerhaftes Endes des MAIN PACKET" +"ENDPROC fehlt" +"PROC/OP Schachtelung unzulaessig" +"OP darf kein Parameter sein" +"steht mehrfach im PACKET Interface" +"Mehrfachdeklaration" +"ist schon als Datenobjekt deklariert" +"ist schon als PROC/OP deklariert" +"')' nach Parameterliste erwartet" +"Standard-Schluesselwort kann nicht redefiniert werden" +"ungueltig als BOLD" +"'(' fehlt" +"CONST bzw VAR nicht bei Strukturfeldern" +"'=' fehlt" +"Schluesselwort wird im Paket schon andersartig verwandt" +"Dieser Typ ist schon definiert" +"ungueltiger Deklarierer" +"ungueltiger OP Name" +"OP muss monadisch oder dyadisch sein" +"ist nicht der OP Name" +"ENDOP fehlt" +"Name nach ENDPROC fehlt" +"Name nach ENDOP fehlt" +"END END ist Unsinn" +"Diese END... kenne ich nicht" +"ROW Groesse ist kein INT" +"ROW Groesse ist kein Denoter" +"Ein ROW muss mindestens ein Element haben" +"ROW Groesse fehlt" +"Parameter kann man nicht initialisieren" +"Konstanten muessen initialisert werden" +"'::' verwenden" +"')' fehlt" +"Nachkommastellen fehlen" +"Exponent fehlt" +"Undefinierter Typ" +"Rekursiv definierter Typ" +"Mehrfach definierter Selektor" +"VARs koennen aus dem Paket nicht herausgereicht werden" +"NO SHORTHAND DECLARATION IN THIS SCOPE FOR ROW SIZE DENOTER." +"Typ Deklarationen nur im Paketrumpf" +"CONST bzw. VAR ohne Zusammenhang" +"ist nicht deklariert, steht aber in der Paket-Schnittstelle" +"ist nicht deklariert" +"Typ ist schon deklariert" +"THIS IS NO CORRECT EXTERNAL NUMBER." +" EXTERNAL und INTERNAL unzulaessig" +"Name erwartet" +"Denoter erwartet" +"ENDPROC ohne Zusammenhang" +"ENDOP ohne Zusammenhang" +"Refinement ohne Zusammenhang" +"Delimiter zwischen Paket-Refinement und Deklaration fehlt" +"unzulaessiges Selektor-Symbol (kein Name)" +"BOUND Schachtelungen unzulaessig" +"Textende fehlt" + +"Denoter-Wert wird fuer diese Maschine zu gross" +"NOBODY SHOULD EVER WRITE THAT, Uli ! " +"ist ein zusammenhangloses Schluesselwort" +"'::' nur fuer Initialisierungen, sonst ':='" +"welches Objekt soll verlassen werden?" +"du bist gar nicht innerhalb dieses Refinements" +"nur die eigene PROC / OP kann verlassen werden" +"THEN fehlt" +"FI fehlt" +"BOOL - Ausdruck erwartet" +"ELSE - Teil ist notwendig, da ein Wert geliefert wird" +"Mit ELIF kann kein IF-Statement beginnen" +"INT - Ausdruck erwartet" +"OF fehlt" +"Keine Typanpassung moeglich" +"CASE - Label fehlt" +"CASE - Label ist zu gross (skipped)" +"mehrfach definiertes CASE-Label" +"ungueltiges Zeichen nach CASE-Label" +" OTHERWISE PART fehlt" +"END SELECT fehlt" +"DEAR USER, PLEASE BE REMINDED OF NOT CALLING REFINEMENTS RECURSIVLY !" +"Dieses Refinement wird nicht benutzt" +"Zwischen diesen Symbolen fehlt ein Operator oder ein ';'" +"undefinierter monadischer Operator" +"undefinierter dyadischer Operator" +"Operator vor '(' fehlt" +"kann nicht redefiniert werden" +"Auf die Feinstruktur des Typs kann man nicht mehr zugreifen" +"fuer diesen Typ nicht definierter Selektor" +"Primitive Typen koennen nicht selektiert werden" +"bei ROWs nur Subscription" +"ungueltiger Selectand" +"unzulaessiger Index fuer Subscription" +"'[' ohne Zusammenhang" +"']' ohne Zusammenhang" +"']' nach Subscription fehlt" +"',' ungueltig zwischen UNITs" +"':' ungueltig zwischen UNITs" +"';' fehlt" +"nur die letzte UNIT einer SECTION darf einen Wert liefern" +"Der Paketrumpf kann keinen Wert liefern" +"anstelle des letzten Symbols wurde ein Operand erwartet" +"Der Schleifenrumpf darf keinen Wert liefern" +"INT VAR erwartet" +"wird schon in einer aeusseren Schleife als Laufvariable benutzt" +"FROM erwartet" +"UPTO bzw DOWNTO fehlt" +"REPEAT fehlt" +"END REP fehlt" +"UNTIL ohne Zusammenhang" +"Die Konstante darf nicht mit ':=' veraendert werden" +"In einer FOR-Schleife darf die Laufvariable nicht veraendert werden" +"falscher Typ des Resultats" +"ist CONST, es wird aber ein VAR Parameter verlangt" +"unbekannte Prozedur" +"Parameter-Prozedur liefert falsches Resultat" +"Es gibt keine Prozedur mit diesen Parametern" +"unbekannte Parameter-Prozedur" +"VIRTUAL PARAM MODE INCONSISTENCE" +"INCONSISTENCE BETWEEN THE PARAMETERS OF THE ACTUAL AND THE FORMAL PARAM PROC +EDURE " +"nicht deklariertes Objekt" +"THIS OBJECT IS USED OUTSIDE IT'S RANGE" +"Kein TYPE DISPLAY moeglich, da die Feinstruktur hier unbekannt ist" +"zu wenig Felder angegeben" +"zu viele Felder angegeben" +"unzulaessiger Trenner zwischen Feldern" +"Dies Feld hat einen falschen Typ" +"THIS ROW DISPLAY DOES NOT HAVE THE CORRECT NUMBER OF ELEMENTS." +"Dieser Typ kann nicht noch mehr konkretisiert werden" + +"Warnung in Zeile" +" Zeile " +"in Zeile " +"<----+--->" +" TYPE undefiniert " +" MODE undefiniert " +"Parameter spezifiziert " +"Parameter Typ(en) sind " +" B Code, " +" B Paketdaten generiert" +"Operandentyp" +"Typ des linken Operanden " +"Typ des rechten Operanden " +"erwartet " +"gefunden " + "NULL 1TEST 1NOT 2INCR 1DECR + 1MOV2 2MOV8 2MOVS 2EQI 2LSEQI + 2EQR 2LSEQR 2COMPLI 2COMPLR 2ADDI + 3SUBI 3MULTI 3DIVI 3ADDR 3SUBR + 3MULTR 3DIVR 3AND 2OR 2BRANCH +8BTRUE 8BFALSE 8ACCDS 2ALIAS 5RETURN +0MOVE 3CASE 3SUBS 5SUBS2 4SUBS8 + 4SUBS16 4SEL 3BSTL 6ESTL 7HEAD + 1PACKET 1BOOL 1NBOOL 1" + +(*000 *) END INTERNAL BOUND +(*001 *) PACKET +(*002 *) ENDPACKET +(*003 *) DEFINES +(*003 A*) LET +(*004 *) PROCEDURE +(*005 *) PROC +(*006 *) ENDPROC +(*006A *) ENDPROCEDURE +(*007 *) OPERATOR +(*008 *) OP +(*009 *) ENDOP +(*009A *) ENDOPERATOR +(*010 *) TYPE +(*011 *) INT +(*012 *) REAL +(*013 *) DATASPACE +(*015 *) TEXT +(*016 *) BOOL +(*017 *) CONST +(*018 *) VAR +(* INIT CONTROL *) INTERNAL +(*019 *) ROW +(*0191 *) STRUCT CONCR +(*0193*) ACTUAL +(*020 *) REP +(*020A *) REPEAT +(*021 *) ENDREP +(*021A *) ENDREPEAT PER +(*022 *) SELECT +(*023 *) ENDSELECT +(*0235 *) EXTERNAL +(*024 *) IF (*024A *) ENDIF +(*021 *) THEN +(*022 *) ELIF +(*023 *) ELSE +(*024 *) FI +(*026 *) OF +(*026A *) CASE +(*027 *) OTHERWISE +(*029 *) FOR +(*030 *) FROM +(*031 *) UPTO +(*032 *) DOWNTO +(*034 *) UNTIL +(*035 *) WHILE +(*036 *) LEAVE WITH +(*0361 *) TRUE +(*362 *) FALSE +(*038 *) :: SBL = := INCR DECR +(*039 *) + - * / DIV MOD ** AND CAND OR COR NOT <> > >= < <= +(*040 *) MAIN +(*043*) ENDOFFILE + +PACKET a : + +PROC out (TEXT CONST t) : + EXTERNAL 60 +ENDPROC out ; + +PROC out text (TEXT CONST t, INT CONST typ) : + INTERNAL 257 ; + out (t) +ENDPROC out text ; + +PROC out line (INT CONST typ) : + INTERNAL 258 ; + out (""13""10"") +ENDPROC out line ; + +ENDPACKET a ; diff --git a/system/base/unknown/src/integer b/system/base/unknown/src/integer new file mode 100644 index 0000000..0e1d19d --- /dev/null +++ b/system/base/unknown/src/integer @@ -0,0 +1,134 @@ + +PACKET integer DEFINES + sign, SIGN, abs, ABS, **, min, max, maxint, + get, random, initialize random : + +INT PROC maxint : 32767 ENDPROC maxint ; + +INT PROC sign (INT CONST argument) : + + IF argument < 0 THEN -1 + ELIF argument > 0 THEN 1 + ELSE 0 + FI + +ENDPROC sign ; + +INT OP SIGN (INT CONST argument) : + sign (argument) +ENDOP SIGN ; + +INT PROC abs (INT CONST argument) : + + IF argument > 0 THEN argument + ELSE - argument + FI + +ENDPROC abs ; + +INT OP ABS (INT CONST argument) : + abs (argument) +ENDOP ABS ; + +INT OP ** (INT CONST arg, exp) : + + INT VAR x := arg , z := 1 , + counter := exp ; + + IF exp < 0 THEN errorstop ("INT OP ** : negative exponent") FI ; + IF arg = 0 AND exp = 0 + THEN errorstop (" 0 ** 0 is not defined") + FI ; + IF exp = 0 THEN x := 1 FI ; + + WHILE counter >= 2 REP + calculate new x and z ; + counter := counter DIV 2 ; + ENDREP ; + z * x . + +calculate new x and z : + IF counter is not even + THEN z := z * x + FI ; + x := x * x . + +counter is not even : + counter MOD 2 = 1 . + +ENDOP ** ; + +INT PROC min (INT CONST first, second) : + + IF first < second THEN first ELSE second FI + +ENDPROC min ; + +INT PROC max (INT CONST first, second) : + + IF first > second THEN first ELSE second FI + +ENDPROC max ; + + +PROC get (INT VAR number) : + + get (word) ; + number := int (word) + +ENDPROC get ; + +TEXT VAR word := "" ; + + + +(************************************************) +(*** ***) +(*** generator 32 650 ***) +(*** ***) +(************************************************) + +(* INT-Zufallsgenerator mit Periode 32650 *) (*Autor: Bake *) + (*Gymnasium Aspe *) + +INT VAR z1 :: 14, (* fuer den generator mit periode 25 *) + z2 :: 345; (* fuer den generator mit periode 1306 *) + + + INT PROCEDURE random (INT CONST ugrenze, ogrenze) : + (*******************************************************) + +generator 25; +generator 1306; +(zufallszahl MOD intervallgroesse) + ugrenze. + +(* Durch MOD wird bei grosser 'intervallgroesse' der vordere + Bereich doppelt ueberdeckt, also keine Gleichverteilung. heinrichs + 24.04.81 *) + + + generator 25 : +z1 := (11 * z1 + 18) MOD 25 +(* erster generator. liefert alle zahlen zwischen 0 und 24. *). + + generator 1306 : +z2 := (24 * z2 + 23) MOD 1307 +(* zweiter generator. liefert alle zahlen zwischen 0 und 1305. *). + + zufallszahl : +z1 + z2 * 25 (* diese zahl liegt zwischen 0 und 32 649 *). + + intervallgroesse : ogrenze - ugrenze + 1 + +END PROC random ; + + + PROCEDURE initialize random (INT CONST wert) : +(**************************************************) + +z1 := wert MOD 25; +z2 := wert MOD 1306 + +END PROC initialize random ; + +ENDPACKET integer ; diff --git a/system/base/unknown/src/mathlib b/system/base/unknown/src/mathlib new file mode 100644 index 0000000..be44ff6 --- /dev/null +++ b/system/base/unknown/src/mathlib @@ -0,0 +1,359 @@ + +PACKET mathlib DEFINES sqrt,**,exp,ln,log2,log10,sin,cos, + tan,arctan,sind,cosd,tand,arctand,e,pi, + random,initializerandom : + + +REAL VAR rdg::0.4711; + +REAL PROC pi: + 3.141592653589793. +END PROC pi; + +REAL PROC e: + 2.718281828459045. +END PROC e; + +REAL PROC ln(REAL CONST x): +LET ln2= 0.6931471805599453; +log2(x)*ln2. +END PROC ln; + +REAL PROC log2(REAL CONST z): +INT VAR k::0,p::0; +REAL VAR m::0.0,x::z,t::0.0,summe::0.0; +IF x>0.0 +THEN normal +ELSE errorstop("log2 mit negativer zahl");4711.4711 +FI. +normal: + IF x>=0.5 + THEN normalise downwards + ELSE normalise upwards + FI; + IF x>=0.1 AND x< 0.7071067811865475 THEN + t:=(x-0.5946035575013605)/(x+0.5946035575013605); + summe:=reihenentwicklung (t) - 0.75 + FI; + IF x>=0.7071067811865475 AND x < 1.0 THEN + t:=(x - 0.8408964152537145)/(x+0.8408964152537145); + summe:= reihenentwicklung(t)-0.25 + FI; + summe-real(p - 4*k). + + normalise downwards: + WHILE x>= 16.0 REP + x:=x/16.0;k:=k+1; + END REP; + WHILE x>=0.5 REP + x:=x/2.0;p:=p-1; + END REP. + + normalise upwards: + WHILE x<=0.0625 REP + x:=x*16.0;k:=k-1; + END REP; + WHILE x<= 0.5 REP + x:=x*2.0;p:=p+1; + END REP. + +END PROC log2; + +REAL PROC reihenentwicklung(REAL CONST x): + REAL VAR i::39.0,s::1.0/39.0; + LET ln2=0.6931471805599453; + WHILE i>1.0 REP + i:=i-2.0;s:=s*x*x + 1.0/i; + END REP; + s*2.0*x/ln2. +END PROC reihenentwicklung; + +REAL PROC log10(REAL CONST x): + LET lg2=0.301029995664; + log2(x)*lg2. +END PROC log10; + +REAL PROC sqrt(REAL CONST z): + REAL VAR y0,y1,x::z; + INT VAR p::0; + BOOL VAR q::FALSE; + IF x<0.0 + THEN errorstop("sqrt von negativer zahl");0.0 + ELSE correct + FI. + + correct: + IF x=0.0 + THEN 0.0 + ELSE nontrivial + FI. + + nontrivial: + IF x<0.01 + THEN small + ELSE notsmall + FI. + + + notsmall: + IF x>1.0 + THEN big + ELSE normal + FI. + + small: + WHILE x<0.01 REP + p:=p-1;x:=x*100.0; + END REP; + normal. + + big: + WHILE x>=1.0 REP + p:=p+1;x:=x/100.0; + END REP; + normal. + + normal: + IF x<0.1 + THEN x:=x*10.0;q:=TRUE + FI; + y0:=10.0**p*(1.681595-1.288973/(0.8408065+x)); + IF q + THEN y0:=y0/3.162278 + FI; + y1:=(y0+z/y0)/2.0; + y0:=(y1+z/y1)/2.0; + y1:=(y0+z/y0)/2.0; + (y1-z/y1)/2.0+z/y1. + +END PROC sqrt; + +REAL PROC exp(REAL CONST z): + REAL VAR c,d,x::z, a, b ; + IF x<-180.2187 + THEN 0.0 + ELIF x<0.0 + THEN 1.0/exp(-x) + ELIF x=0.0 + THEN 1.0 + ELSE x:=x/0.6931471805599453;approx + FI. + + approx: + a:=floor(x/4.0)+1.0; + b:=floor(4.0*a-x); + c:=(4.0*a-b-x)*16.0; + d:=(c -floor(c))/16.0; + d:=d*0.6931471805599453; + ( (16.0 POWER a) / (2.0 POWER b) / (1.044273782427419 POWER c ))* + ((((((0.135910788320380e-2*d-0.8331563191293753e-2)*d + +0.4166661437490328e-1)*d-0.1666666658727157)*d+0.4999999999942539)*d + - 0.9999999999999844)*d+1.0). + +ENDPROC exp ; + +REAL OP POWER (REAL CONST basis, exponent) : + + IF floor (exponent) = 0.0 + THEN 1.0 + ELSE power + FI . + +power : + REAL VAR counter := floor (abs (exponent)) - 1.0 , + result := basis ; + WHILE counter > 0.0 REP + result := result * basis ; + counter := counter - 1.0 + PER ; + IF exponent > 0.0 + THEN result + ELSE 1.0 / result + FI . + +ENDOP POWER ; + +REAL PROC tan (REAL CONST x): + REAL VAR p; + p:=1.273239544735168*ABSx; + tg(p)*sign(x). +END PROC tan; + +REAL PROC tand(REAL CONST x): + REAL VAR p; + p:=0.02222222222222222*ABSx; + tg(p)*sign(x). +END PROC tand; + +REAL PROC tg(REAL CONST x): + REAL VAR r,s,u,q; + q:=floor(x);r:=x-q; + IF q = floor(q/2.0) * 2.0 + THEN s:=r + ELSE s:=(1.0-r) + FI; + q:= q - floor(q/4.0) * 4.0 ; + u:=s*s; + s:=s*0.785398163397448; + s:=s/(((((((((-0.4018243865271481e-10*u-0.4404768172667185e-9)*u- + 0.748183650813680e-8)*u-0.119216115119129e-6)*u-0.1909255769212821e-5)*u- +0.3064200638849133e-4)*u-0.4967495424202482e-3)*u-0.8455650263333471e-2)*u- + 0.2056167583560294)*u+1.0); + IF q=0.0 + THEN s + ELIF q=3.0 + THEN -s + ELIF q=1.0 + THEN 1.0/s + ELSE -1.0/s + FI . + +END PROC tg; + +REAL PROC sin(REAL CONST x): + REAL VAR y,r; + INT VAR q; + y:=ABS x*1.273239544735168; + q:=int(y); + r:=y-real(q); + IF x<0.0 + THEN q:=q+4 + FI; + sincos(q,r). +END PROC sin; + +REAL PROC sind(REAL CONST x): + REAL VAR y,r; + INT VAR q; + y:=ABSx/45.0; + q:=int(y); + r:=y-real(q); + IF x<0.0 + THEN q:=q+4 + FI; + sincos(q,r). +END PROC sind; + + +REAL PROC cos(REAL CONST x): + REAL VAR y,r; + INT VAR q; + y:=ABS x*1.273239544735168; + q:=int(y); + r:=y-real(q); + q:=q+2; + sincos(q,r). +END PROC cos; + +REAL PROC cosd(REAL CONST x): + REAL VAR y,r; + INT VAR q; + y:=ABS x/45.0; + q:=int(y); + r:=y-real(q); + q:=q+2; + sincos(q,r). +END PROC cosd; + + +REAL PROC sincos(INT VAR q,REAL VAR r): + SELECT q MOD 8 + 1 OF + CASE 1 : sin approx(r) + CASE 2 : cos approx (1.0-r) + CASE 3 : cos approx(r) + CASE 4 : sin approx(1.0-r) + CASE 5 : - sin approx(r) + CASE 6 : - cos approx(1.0-r) + CASE 7 : - cos approx(r) + CASE 8 : - sin approx(1.0-r) + OTHERWISE 0.0 + END SELECT +END PROC sincos; + +REAL PROC sin approx(REAL CONST x): + REAL VAR z::x*x; + x*((((((0.6877101540593035e-11*z-0.1757149296873372e-8)*z+0.313361621667256 +8 +e-6)*z-0.3657620415845891e-4)*z+0.2490394570188737e-2)*z-0.807455121882e-1 +)*z+0.7853981633974483). +END PROC sin approx; + +REAL PROC cos approx(REAL CONST x): + REAL VAR z::x*x; + (((((( -0.3857761864560276e-12*z+0.115004970178141e-9)*z-0.246113638267419e +-7)*z+0.3590860445885748e-5)*z-0.3259918869266875e-3)*z+0.1585434424381541e-1 +)*z-0.3084251375340425)*z+1.0. +END PROC cos approx; + +REAL PROC arctan(REAL CONST x): +REAL VAR z::x*x; +IF x<0.0 THEN -arctan(-x) +ELIF x>1.0 THEN 3.141592653589792/2.0-arctan(1.0/x) +ELIF x*1.0e16>2.67949192431e15 THEN pi/6.0+arctan(1.732050807568877-4.0 +/(x+1.732050807568877)) +ELSE x/(((((((0.0107090276046822*z-0.01647757182108040)*z + +0.02177846332482151)*z-0.03019339673273880)*z+0.04656083561183398)*z + -0.0888888888888888)*z+0.3333333333333333)*z+1.0)FI. +END PROC arctan; + +REAL PROC arctand(REAL CONST x): + arctan(x)/3.1415926589793*180.0. +END PROC arctand; + + +BOOL PROC even(INT CONST number): + (number DIV 2)*2=number. +END PROC even; + +REAL OP **(REAL CONST base,exponent): + IF base<0.0 + THEN errorstop("hoch mit negativer basis") + FI; + IF base=0.0 + THEN test exponent + ELSE + exp(exponent*ln(base)) + FI. + + test exponent: + IF exponent=0.0 + THEN errorstop("0**0 geht nicht");4711.4711 + ELSE 0.0 + FI. + +END OP **; + + +REAL PROC sign(REAL CONST number): + IF number >0.0 THEN 1.0 + ELIF number <0.0 THEN -1.0 + ELSE 0.0 + FI. +END PROC sign ; + +REAL OP **(REAL CONST a,INT CONST b): +REAL VAR p::1.0,r::a;INT VAR n::ABS b; +WHILE n>0 REP + IF n MOD 2=0 + THEN n:=n DIV 2;r:=r*r + ELSE n DECR 1;p:=p*r + FI; +END REP; +IF b>0 +THEN p +ELSE 1.0/p +FI. +END OP **; + + + +REAL PROC random: +rdg:=rdg+pi;rdg:=rdg*rdg;rdg:=rdg*rdg;rdg:=rdg*rdg;rdg:=frac(rdg);rdg. +END PROC random; + + +PROC initializerandom(REAL CONST z): + rdg:=z; +END PROC initializerandom; + +END PACKET mathlib; diff --git a/system/base/unknown/src/real b/system/base/unknown/src/real new file mode 100644 index 0000000..a2ab9c3 --- /dev/null +++ b/system/base/unknown/src/real @@ -0,0 +1,378 @@ + +PACKET real DEFINES (* Autor: J.Liedtke *) + (* Stand: 30.04.80 *) + text , + int , + real , + round , + floor , + frac , + INCR , + DECR , + abs , + ABS , + sign , + SIGN , + MOD , + min , + max , + put , + get , + max real , + small real : + +LET mantissa length = 13 ; + +TEXT VAR mantissa ; + +ROW 10 REAL VAR real digit ; + +INT VAR i ; REAL VAR d := 0.0 ; +FOR i FROM 1 UPTO 10 REP + real digit (i) := d ; + d := d + 1.0 +PER ; + +REAL PROC max real : 9.999999999999e126 ENDPROC max real ; + +REAL PROC small real : 1.0e-12 ENDPROC small real ; + +PROC sld (INT CONST in, REAL VAR real, INT VAR out) : + EXTERNAL 96 +ENDPROC sld ; + +INT PROC decimal exponent (REAL CONST mantissa) : + EXTERNAL 97 +ENDPROC decimal exponent ; + +PROC set exp (INT CONST exponent, REAL VAR number) : + EXTERNAL 98 +ENDPROC set exp ; + +REAL PROC tenpower (INT CONST exponent) : + REAL VAR result := 1.0 ; + set exp (exponent, result) ; + result +ENDPROC tenpower ; + +REAL PROC floor (REAL CONST real) : + EXTERNAL 99 +ENDPROC floor ; + +REAL PROC round (REAL CONST real, INT CONST digits) : + + REAL VAR result := real ; + IF (real <> 0.0) CAND (decimal exponent (real) + digits < mantissa length) + THEN round result ; + FI ; + result . + +round result : + set exp (decimal exponent (result) + digits, result) ; + IF result >= 0.0 + THEN result := floor (result + 0.5) + ELSE result := floor (result - 0.5) + FI ; + set exp (decimal exponent (result) - digits, result) . + +ENDPROC round ; + +TEXT VAR result ; + +TEXT PROC text (REAL CONST real) : + + REAL VAR value := rounded to seven digits ; + IF value = 0.0 + THEN "0.0" + ELSE + process sign ; + get mantissa (value) ; + INT CONST exponent := decimal exponent (value) ; + get short mantissa ; + IF exponent > 7 OR exponent < LENGTH short mantissa - 7 + THEN scientific notation + ELSE short notation + FI + FI . + +rounded to seven digits : + round ( real * tenpower( -decimal exponent(real) ) , 6 ) + * tenpower ( decimal exponent(real) ) . + +process sign : + IF value < 0.0 + THEN result := "-" ; + value := - value + ELSE result := "" + FI . + +get short mantissa : + INT VAR i := 7 ; + WHILE (mantissa SUB i) = "0" REP + i DECR 1 + UNTIL i=1 END REP ; + TEXT CONST short mantissa := subtext (mantissa, 1, i) . + +scientific notation : + result CAT (mantissa SUB 1) ; + result CAT "." ; + result CAT subtext (mantissa, 2, 7) ; + result + "e" + text (exponent) . + +short notation : + result CAT subtext (short mantissa, 1, exponent+1) ; + result CAT (exponent+1 - LENGTH short mantissa) * "0" ; + result CAT "." ; + IF exponent < 0 + THEN result + (-exponent-1) * "0" + short mantissa + ELSE result + subtext (short mantissa, exponent+2) + FI . + +ENDPROC text ; + +PROC get mantissa (REAL CONST number) : + + REAL VAR real mantissa := number ; + mantissa := "" ; + INT VAR i , digit ; + FOR i FROM 1 UPTO mantissa length REP + sld (0, real mantissa, digit) ; + mantissa CAT code (digit + 48) + PER ; + +ENDPROC get mantissa ; + +PROC put (REAL CONST real) : + + put (text (real) ) + +ENDPROC put ; + +TEXT PROC text (REAL CONST real, INT CONST length, fracs) : + + REAL VAR value := round (real, fracs) ; + INT VAR exponent := decimal exponent (value) ; + IF value = 0.0 THEN exponent := 0 FI ; + INT VAR floors := exponent + 1 , + floor length := length - fracs - 1 ; + IF value < 0.0 THEN floor length DECR 1 FI ; + + IF value too big + THEN length * "*" + ELSE transformed value + FI . + +transformed value : + process leading blanks and sign ; + get mantissa (value) ; + result CAT subtext (mantissa, 1, floors) ; + IF LENGTH mantissa < floors + THEN result CAT (floors - LENGTH mantissa) * "0" + FI ; + result CAT "." ; + IF exponent < 0 + THEN result CAT (-floors) * "0" ; + result CAT subtext (mantissa, 1, length - LENGTH result) + ELSE result CAT subtext (mantissa, floors+1, floors + fracs) + FI ; + IF LENGTH result < length + THEN result CAT (length - LENGTH result) * "0" + FI ; + result . + +process leading blanks and sign : + result := (floor length - max(floors,0)) * " " ; + IF value < 0.0 + THEN result CAT "-" ; + value := - value + FI . + +value too big : + floors > floor length . + +ENDPROC text ; + +REAL PROC real (TEXT CONST text) : + + skip leading blanks ; + sign ; + mantissa part ; + exponent ; + check correct conversion ; + result . + +skip leading blanks : + INT VAR pos := 1 ; + skip blanks . + +skip blanks : + WHILE (text SUB pos) = " " REP + pos INCR 1 + PER . + +sign : + BOOL VAR negative ; + IF (text SUB pos) = "-" + THEN negative := TRUE ; + pos INCR 1 + ELIF (text SUB pos) = "+" + THEN negative := FALSE ; + pos INCR 1 + ELSE negative := FALSE + FI . + +mantissa part: + REAL VAR value := 0.0 ; + INT VAR exponent pos := 0 ; + WHILE pos <= LENGTH text REP + TEXT VAR digit := text SUB pos ; + IF digit <= "9" AND digit >= "0" + THEN value := value * 10.0 + real digit (code (digit) - 47) ; + pos INCR 1 + ELIF digit = "." + THEN pos INCR 1 ; + exponent pos := pos + ELSE LEAVE mantissa part + FI + END REP . + +exponent : + INT VAR exp ; + IF exponent pos > 0 + THEN exp := exponent pos - pos + ELSE exp := 0 + FI ; + IF (text SUB pos) = "e" + THEN exp INCR int (subtext(text,pos+1)) + FI . + +check correct conversion : + skip blanks ; + IF pos > LENGTH text + THEN set conversion (TRUE) + ELSE set conversion (FALSE) + FI . + +result : + value := value * tenpower (exp) ; + IF negative + THEN - value + ELSE value + FI . + +ENDPROC real ; + +TEXT VAR word ; + +PROC get (REAL VAR value) : + + get (word) ; + value := real (word) + +ENDPROC get ; + +REAL PROC abs (REAL CONST value) : + + IF value >= 0.0 + THEN value + ELSE -value + FI + +ENDPROC abs ; + +REAL OP ABS (REAL CONST value) : + + abs (value) + +ENDOP ABS ; + +INT PROC sign (REAL CONST value) : + + IF value < 0.0 THEN -1 + ELIF value = 0.0 THEN 0 + ELSE 1 + FI + +ENDPROC sign ; + +INT OP SIGN (REAL CONST value) : + + sign (value) + +ENDOP SIGN ; + +REAL OP MOD (REAL CONST left, right) : + + REAL VAR result := left - floor (left/right) * right ; + IF left < 0.0 + THEN result + abs (right) + ELSE result + FI + +ENDOP MOD ; + +REAL PROC frac (REAL CONST value) : + + value - floor (value) + +ENDPROC frac ; + +REAL PROC max (REAL CONST a, b) : + + IF a > b THEN a ELSE b FI + +ENDPROC max ; + +REAL PROC min (REAL CONST a, b) : + + IF a < b THEN a ELSE b FI + +ENDPROC min ; + +OP INCR (REAL VAR dest, REAL CONST increment) : + + dest := dest + increment + +ENDOP INCR ; + +OP DECR (REAL VAR dest, REAL CONST decrement) : + + dest := dest - decrement + +ENDOP DECR ; + +INT PROC int (REAL CONST value) : + + INT VAR result := 0, digit ,i ; + REAL VAR mantissa := value ; + + FOR i FROM 0 UPTO decimal exponent (value) REP + sld (0, mantissa, digit) ; + result := result * 10 + digit + PER ; + + IF value < 0.0 + THEN - result + ELSE result + FI + +ENDPROC int ; + +REAL PROC real (INT CONST value) : + + IF value < 0 + THEN - real (-value) + ELIF value < 10 + THEN real digit (value+1) + ELSE split value into head and last digit ; + real (head) * 10.0 + real digit (last digit+1) + FI . + +split value into head and last digit : + INT CONST + head := value DIV 10 , + last digit := value - head * 10 . + +ENDPROC real ; + +ENDPACKET real ; diff --git a/system/base/unknown/src/scanner b/system/base/unknown/src/scanner new file mode 100644 index 0000000..ed04699 --- /dev/null +++ b/system/base/unknown/src/scanner @@ -0,0 +1,255 @@ + +PACKET scanner DEFINES (* Autor: J.Liedtke *) + (* Stand: 30.12.81 *) + scan , + continue scan , + next symbol , + fix scanner , + reset scanner : + + +LET tag = 1 , + bold = 2 , + integer = 3 , + text = 4 , + operator= 5 , + delimiter = 6 , + end of file = 7 , + within comment = 8 , + within text = 9 ; + + +TEXT VAR line := "" , + char := "" ; + +INT VAR position := 0 , + reset position , + comment depth ; +BOOL VAR continue text ; + + +PROC scan (TEXT CONST scan text) : + + comment depth := 0 ; + continue text := FALSE ; + continue scan (scan text) + +ENDPROC scan ; + +PROC continue scan (TEXT CONST scan text) : + + line := scan text ; + position := 0 ; + next non blank char ; + reset position := position + +ENDPROC continue scan ; + +PROC fix scanner : + + reset position := position + +ENDPROC fix scanner ; + +PROC reset scanner : + + position := reset position ; + char := line SUB position + +ENDPROC reset scanner ; + +PROC next symbol (TEXT VAR symbol) : + + INT VAR type ; + next symbol (symbol, type) + +ENDPROC next symbol ; + +PROC next symbol (TEXT VAR symbol, INT VAR type) : + + skip blanks ; + symbol := "" ; + IF is niltext THEN eof + ELIF is comment THEN process comment + ELIF is text THEN process text + ELIF is lower case letter THEN process tag + ELIF is upper case letter THEN process bold + ELIF is digit THEN process integer + ELIF is delimiter THEN process delimiter + ELSE process operator + FI . + +skip blanks : + IF char = " " + THEN next non blank char + FI . + + +process comment : + read comment ; + IF comment depth = 0 + THEN next symbol (symbol, type) + ELSE type := within comment + FI . + +process tag : + type := tag ; + REP + symbol CAT char ; + next non blank char + UNTIL NOT (is lower case letter OR is digit) ENDREP . + +process bold : + type := bold ; + REP + symbol CAT char ; + next char + UNTIL NOT is upper case letter ENDREP . + +process integer : + type := integer ; + REP + symbol CAT char ; + next non blank char + UNTIL NOT (is digit OR char = ".") ENDREP . + +process text : + type := text ; + IF continue text + THEN continue text := FALSE + ELSE next char + FI ; + WHILE not end of text REP + symbol CAT char ; + next char + ENDREP . + +not end of text : + IF is niltext + THEN continue text := TRUE ; type := within text ; FALSE + ELIF is quote + THEN end of text or exception + ELSE TRUE + FI . + +end of text or exception : + next char ; + IF is quote + THEN TRUE + ELIF is digit + THEN get special char ; TRUE + ELSE FALSE + FI . + +get special char : + TEXT VAR special symbol ; + next symbol (special symbol) ; + char := code ( int (special symbol ) ) . + +process delimiter : + type := delimiter ; + symbol := char ; + next non blank char . + +process operator : + type := operator ; + symbol := char ; + nextchar ; + IF symbol = ":" + THEN IF char = "=" OR char = ":" + THEN symbol := ":=" ; + nextchar + ELSE type := delimiter + FI + ELIF is relational double char + THEN symbol CAT char ; + nextchar + ELIF symbol = "*" AND char = "*" + THEN symbol := "**" ; + next char + FI . + +eof : + type := end of file ; + symbol := "" . + +is lower case letter : char lies in (97, 122) . + +is upper case letter : char lies in (65, 90) . + +is digit : char lies in (48, 57) . + +is delimiter : pos ( "()[].,;" , char ) > 0 AND char <> "" . + +is relational double char : + TEXT VAR double := symbol + char ; + double = "<>" OR double = "<=" OR double = ">=" . + +is text : is quote OR continue text . + +is quote : char = """" . + +is niltext : char = "" . + +is comment : + IF comment depth = 0 + THEN char = "{" OR char = "(" AND ahead char = "*" + ELSE comment depth DECR 1 ; TRUE + FI . + +ENDPROC next symbol ; + +PROC next char : + + position INCR 1 ; + char := line SUB position + +ENDPROC next char ; + +PROC next non blank char : + + REP + position INCR 1 + UNTIL (line SUB position) <> " " ENDREP ; + char := line SUB position + +ENDPROC next non blank char ; + +TEXT PROC ahead char : + + line SUB position+1 + +ENDPROC ahead char ; + +BOOL PROC char lies in (INT CONST lower bound, upper bound) : + + lower bound <= code(char) AND code(char) <= upper bound + +ENDPROC char lies in ; + +PROC read comment : + + TEXT VAR last char ; + comment depth INCR 1 ; + REP + last char := char ; + nextchar ; + IF is begin comment + THEN read comment + FI ; + IF char = "" + THEN LEAVE read comment + FI + UNTIL is end comment PER ; + comment depth DECR 1 ; + next nonblank char . + +is end comment : + char = "}" OR char = ")" AND last char = "*" . + +is begin comment : + char = "{" OR char = "(" AND ahead char = "*" . + +ENDPROC read comment ; + +ENDPACKET scanner ; diff --git a/system/base/unknown/src/stdescapeset b/system/base/unknown/src/stdescapeset new file mode 100644 index 0000000..0c69ea7 --- /dev/null +++ b/system/base/unknown/src/stdescapeset @@ -0,0 +1,31 @@ +PACKET std escape set (* Autor: P.Heyderhoff *) + (************) (* Stand: 20.01.1981 *) + (* Vers.: 1.5.5 *) +DEFINES std escape set : + +PROC std escape set : + + define escape ("p", "IFmark>0THEN PUT"""";W""""12""""FI") ; + define escape ("g", "GET"""";M0") ; + define escape ("d", "IFmark>0THEN PUT"""";M0ELSE GET"""";M0FI"); + define escape ("B", "W""""194""""") ; + define escape ("A", "W""""193""""") ; + define escape ("O", "W""""207""""") ; + define escape ("U", "W""""213""""") ; + define escape ("a", "W""""225""""") ; + define escape ("o", "W""""239""""") ; + define escape ("u", "W""""245""""") ; + define escape ("z", "C1;""""C(((limit-len)/2)*"" "")") ; + define escape ("l", "i:=col;C1;M1;Ci;W""""12""""") ; + define escape ("h", "S11") ; + define escape ("v", "S23") ; + define escape ("1", "1;C1"); + define escape ("9", "9999;C(len+1)"); + define escape (""2"", """ """); + define escape (""10"","+1;R Clen;"" ""Ucol>lenE"); + define escape (""3"", "R-1;Hrow;Clen;"" ""Ucol>lenE"); + define escape (""8"", "COL(col-10)"); + +ENDPROC std escape set ; + +ENDPACKET std escape set ; diff --git a/system/dos/1986/doc/DSKDOS.ELA b/system/dos/1986/doc/DSKDOS.ELA new file mode 100644 index 0000000..69bc714 --- /dev/null +++ b/system/dos/1986/doc/DSKDOS.ELA @@ -0,0 +1,967 @@ +#type ("17.klein")# +prefix of extended fcb: + + offset size name + -7 1 flag byte 255 + -6 5 reserved + -1 1 attribute byte 2=hidden file, 4=system file + +normal fcb format: + + offset size name + 0 1 drive number 0=default (for open), 1=A, 2=B + 1 8 filename 8 chars, left aligned and padded + (if necessary) with blanks + 9 3 extension 3 chars, left aligned and padded + (if necessary) with blanks + 12 2 current block pointer to the block of 128 records + containing the current record + (0 after open) + 14 2 record size logical record size in bytes + (128 after open, changed eventually) + 16 4 file size file size in bytes (1. byte low) + 20 2 date of last write 20:mmmddddd 21:yyyyyyym + 22 2 time of last write 22:mmmsssss 23:hhhhhmmm + 24 8 reserved + 32 1 current record pointer to one of the 128 records in + the block (not initialized by open) + must be set before sequential read/write + 33 4 relative record pointer to selected record + (counting from the beginning of file by 0) + not initialized by open + must be set before sequential read/write + record size less than + 64 bytes: both words used + else only first 3 bytes + +fields of directory entry: + + offset size name + 0 8 filename 8 chars, left aligned and padded + (if necessary) with blanks + special use of first byte: + 0 : end of allocated directory + 229: free directory entry + 8 3 extension 3 chars, left aligned and padded + (if necessary) with blanks + 11 1 attributes 1: read only file + 2: hidden file + 4: system file + 8: entry is the volume's id + 16: entry is subdirectory's name + 32: archive bit (set, when written to) + 12 10 reserved + 22 2 time of last write 22:mmmsssss 23:hhhhhmmm + 24 2 date of last write 24:mmmddddd 25:yyyyyyym + 26 2 reserved + 28 4 file size file size in bytes (1. byte low) + +directory structure: + + - the root directory has a fixed number of entries + - entries that represent a subdirectory have a special attribute in their + entry set + - the subdirectories are themselves files which records are of the same type + as those in the root directory + - the number of entries in subdirectories are not limited + - the length of a path to a subdirectory is not limited + +application of the directory entry fields on subdirectory entries: + + volume id : present at root, only one entry has this attribute + directory : the directory entry represents itself an directory + read only : meaningless + archive : meaningless + hidden/system: prevents directories from beeing found, function $3B + will still work + +ms-dos interrupts: + + $20 : program terminate + call: + CS: segment address + terminates process, returns control to parent process, + file handles are closed, disk cache cleaned, file buffers flushed + programm terminate, alt-c and critical error addresses are restored + new programs should use function $4C + $21 : function request + call: + AH: function number + other registers dependent on function + $22 to $24 : + address locations for msdos use + can be changed by function $25 + $22 : terminate address + $23 : alt-c exit address + address of an alt-c routine + $24 : fatal error abort address + address of the error handler + BP:SI can contain further information + not called if error occurs during absolute disk operations (int $25,$26) + $25 : absolute disk read + call: + AL: drive number + DS:BX: disk transfer address + CX: number of sectors + DX: beginning relative sector + return: + CF: 0=successful + 1=unsuccessful + AL: error code if unsuccessful + $26 : absolute disk write + call: + AL: drive number + DS:BX: disk transfer address + CX: number of sectors + DX: beginning relative sector + return: + CF: 0=successful + 1=unsuccessful + AL: error code if unsuccessful + $27 : terminate but stay resident + call: + CS:DX: first byte following the code + new programms should use function $31 + +ms-dos function requests: + + $00 : terminate program + call: + AH: $00 + CS: segment of programm prefix + $01 : read keyboard and echo + call: + AH: $01 + return: + AL: character typed + waits for input, echos and returns it + alt-c will call interrupt + $02 : display character + call: + AH: $02 + DL: character to be displayed + alt-c will call interrupt + $03 : auxiliary input + call: + AH: $03 + return: + AL: character from auxiliary device + waits for input, alt-c will call interrupt + $04 : auxiliary output + call: + AH: $04 + DL: character to output + alt-c will call interrupt + $05 : print character + call: + AH: $05 + DL: character for printer + alt-c will call interrupt + $06 : direct console i/o + call: + AH: $06 + DL: $FF: check for keyboard input + otherwise: display DL on screen + return: + ZF: 0=no char available + 1=char was read + AL: char if read + $07 : direct konsole input + call: + AH: $07 + return: + AL: character from keyboard + waits for character + $08 : read keyboard + call: + AH: $08 + return: + AL: character from keyboard + waits for character, alt-c will call interrupt + $09 : display string + call: + AH: $09 + DS:DX: string, ending with '$' + $0A : buffered keyboard input + call: + AH: $0A + DS:DX: input buffer + byte 1: maximum number of chars in buffer (with CR) + 2: actual number of chars in buffer (set by function) + 3-n: must be at least as long as the max + waits for chars, allows editing, ignores overflow, + alt-c will call interrupt + $0B : check keyboard status + call: + AH: $0B + return: + AL: 0=no chars in type-ahead buffer + 255=chars available + $0C : flush buffer and read keyboard + call: + AH: $0C + AL: $01,$06,$07,$08 or $0A: corresponding function is called + other values: no further processing + return: + AL: 0=type ahead buffer was flushed, no processing performed + $0D : disk reset + call: + AH: $0D + all disk buffers are flushed, no directory updates performed + $0E : select disk + call: + AH: $0E + DL: drive number, 1=A, 2=B, .. + return: + AL: number of logical drives + $0F : open file + call: + AH: $0F + DS:DX: unopened fcb + return: + AL: 0=directory entry found + if drive code was 0, it is set to the default + current block is set to 0 + record size is set to 128 + file size, time and date of last modification are set + from directory + the default record size must be set, if not 128 + before performing a sequential (random) operation, + current record (relative record) field must be set + 255=no directory entry found + + $10 : close file + call: + AH: $10 + DS:DX: opened fcb + return: + AL: 0=directory entry found + 255=no directory entry found + $11 : search for first entry + call: + AH: $11 + DS:DX: unopened fcb + return: + 0=directory entry found + fcb (normal or extended) is created + at the disk transfer address + 255=no directory entry found + to search for hidden or system files, the fcb must be extended + see notes on search attributes + $12 : search for next entry + call: + AH: $12 + DS:DX: unopened fcb + return: + AL: 0=directory entry found + fcb (normal or extended) is created + at the disk transfer address + 255=no directory entry found + the fcb must be one used previously in a call to $11 + $13 : delete file + call: + AH: $13 + DS:DX: unopened fcb + return: + AL: 0=directory entry found + 255=no directory entry found + deletes all files with matching names + $14 : sequential read + call: + AH: $14 + DS:DX: opened fcb + return: + AL: 0=read completed successfully + 1=eof, no data in the record + 2=dta too small, not enough space to read without exceeding + the segment boundaries, read cancelled + 3=eof, partial record was read and padded to the record + length with zeros + the record pointed to by the current block and current record + is loaded to the disk transfer address and the fields are incremented + $15 : sequential write + call: + AH: $15 + DS:DX: opened fcb + return: + AL: 0=write completed successfully + 1=disk full, write canceled + 2=dta too small to write one record without exceeding the + segment boundaries, write canceled + the record pointed to by the current block and current record + are written from the disk transfer address and the fields are incremented + $16 : create file + call: + AH: $16 + DS:DX: unopened fcb + return: + AL: 0=empty directory entry found + 255=no empty entry available and file didn't exist before + if the file does already exist, it is made a zero length file + else it is created if an empty entry is found + $17 : rename file + call: + AH: $17 + DS:DX: modified fcb + return: + AL: 0=directory entry found + 255=no directory entry found or destination already exists + the fcb must contain the search file name and another file name + at offset $11 + $19 : current disk + call: + AH: $19 + return: + AL: selected drive (0=A, 1=B, .. ) + $1A : set disk transfer address + call: + AH: $1A + DS:DX: disk transfer address + default is $80 in the psp + $21 : random read + call: + AH: $21 + DS:DX: opened fcb + return: + 0=read completed successfully + 1=eof, no data read + 2=dta too small, read canceled + 3=eof, partial record, padded with zeros + the current block and current record fields are set to match the + relative record field, then the record is loaded + $22 : random write + call: + AH: $22 + DS:DX: opened fcb + return: + AL: 0=write completed successfully + 1=disk full + 2=dta too small, read canceled + $23 : file size + call: + AH: $23 + DS:DX: unopened fcb + return: + AL: 0=directory entry found + the relative record field is set to the number + of records in the file + 255=no directory entry found + the record size field must be set + $24 : set relative record + call: + AH: $24 + DS:DX: opened fcb + the relative record field is set to the same record as the current block + an the current record field + $25 : set vector + call: + AH: $25 + AL: interrupt number + DS:DX: interrupt handling routine + $27 : random block read + call: + AH: $27 + DS:DX: opened fcb + CX: number of blocks to read + return: + AL: 0=read completed successfully + 1=eof, no data read + 2=end of segment, read canceled + 3=eof, partial record, padded with zeros + CX: number of blocks read + the reading starts at the relative record + the current block, current record and relative record field are updated + $28 : random block write + call: + AH: $28 + DS:DX: opened fcb + CX: number of records to write + 0=set file size + the file size field of thedirectory entry is set to the number + of records specified by the relative record field + return: + AL: 0=write completed successfully + 1=disk full, no records written + 2=end of dta-segment, read canceled + CX: number of blocks written + the writing starts at the relative record + the current block, current record and relative record field are updated + $29 : parse file name + call: + AH: $29 + AL: controls parsing + bit 0: if file separators are encountered + (: . ; , = + / " [ ] \ < ] | blank tab) + 0: all parsing stops + 1: leading separators are ignored + bit 1: if the string does not contain a drive letter + 0: the fcb drive number is set to 0 (default) + 1: the fcb drive number is not changed + bit 2: if the string does not contain a filename + 0: the fcb filename is set to 8 blanks + 1: the fcb filename is not changed + bit 3: if the string does not contain an extension + 0: the fcb extension is set to three blanks + 1: the fcb extension is not changed + DS:SI: string to parse + filename terminators include all filename separators + plus any control character + ES:DI: if the string contained a valid filename, + it points to an unopened fcb + else ES:DI+1 points to a blank + return: + AL: 0=no wild card characters + 1=wild card characters used + 255=drive letter invalid + DS:SI: first byte past string that was parsed + if the filename contains an asterisk, + all folowing letters are set to question mark + ES:DI: unopened fcb + if filename is found, an unopened fcb is created here + $2A : get date + call: + AH: $2A + return: + CX: year (1980-2099) + DH: month (1-12) + DL: day (1-31) + AL: day of week (0=sun, .., 6=sat) + $2B : set date + call: + AH: $2B + CX: year (1980-2099) + DH: month (1-12) + DL: day (1-31) + return: + AL: 0=date was valid + 255=date was invalid + $2C : get time + call: + AH: $2C + return: + CH: hour (0-23) + CL: minutes (0-59) + DH: seconds (0-59) + DL: hundredths (0-99) + $2D : set time + call: + AH: $2D + CH: hour (0-23) + CL: minutes (0-59) + DH: seconds (0-59) + DL: hundredths (0-99) + return: + AL: 0=time was valid + 255=time was invalid + $2E : set/reset verify flag + call: + AH: $2E + AL: 0=do not verify + 1=verify + $2F : get disk transfer address + call: + AH: $2F + return: + ES:BX: points to disk transfer address + $30 : get dos version number + call: + AH: $30 + return: + AL: major version number + AH: minor version number + $31 : keep process + call: + AH: $31 + AL: exit code + DX: memory size in paragraphs + attemts to set the initial allocation block to a specific size + in paragraphs, will not free up other allocation blocks belonging + to that process, the exit code is available via function $4D + $33 : alt-c check + call: + AH: $33 + AL: function + 0=request current state + 1=set state + DL: if setting + 0=off + 1=on + return: + AL: 255=al parameter was not in range 0..1 + DL: if requesting current state + 0=off + 1=on + if check is on, every system call executes the check, + else only the device operations + $35 : get interrupt vector + call: + AH: $35 + AL: interrupt number + return: + ES:BX: pointer to interrupt routine + $36 : get disk free space + call: + AH: $36 + DL: drive (0=default, .....) + return: + BX: available clusters + DX: clusters per drive + CX: bytes per sector + AX: $FFFF=drive number invalid + otherwise sectors per cluster + $38 : return country-dependent information + call: + AH: $38 + DS:DX: pointer to 32 byte memory area + area format: + size name + 2 date/time format + 0=usa standard h:m:s m/d/y + 1=europe standard h:m:s d/m/y + 2=japan standard y/m/d h:m:s + 5 asciz currency symbol + 2 asciz thousands separator + 2 asciz decimal separator + 2 asciz date separator + 2 asciz time separator + 1 bit field + bit 0: 0=currency symbol precedes amount + 1=symbol comes after amount + bit 1: 0=symbol immediately precedes the amount + 1=space between symbol and amount + 1 currency places + figures after decimal point of currency amounts + 1 time format + 0=12 hour time + 1=24 hour time + 4 case mapping call + FAR procedure performs country-specific + lower- to uppercase mapping + 2 asciz data list separator + if dx=-1 and the country code in AL is found, + the current country is set accordingly + + AL: function code + 0=current country + or country code (usually international telephone prefix) + must be 0 in msdos 2.0 (only fully implemented after 2.01) + return: + CARRY: 1 + AX: 2=file not found + CARRY: 0 + DS:DX: filled with country data + $39 : create subdirectory + call: + AH: $39 + DS:DX: pointer to pathname (asciz) + return: + CARRY: 1 + AX: 3=path not found + 5=access denied + no room in parent, + directory already exists or device was specified + CARRY: 0=no error + $3A : remove a directory entry + call: + AH: $3A + DS:DX: pointer to pathname (asciz) + return: + CARRY: 1 + AX: 3=path not found + 5=access denied + directory not empty, not a directory, root directory + 16=current directory + CARRY: 0=no error + $3B : change the current directory + call: + AH: $3B + DS:DX: pointer to pathname (asciz) + return: + CARRY: 1 + AX: 3=path not found + CARRY: 0=no error + $3C : create a file + call: + AH: $3C + DS:DX: pointer to pathname + CX: file attribute + return: + CARRY: 1 + AX: 3=path not found + 4=too many open files + file was created, but no room for handle + 5=access denied + uncreatable attribute (directory or volume id), + a file with a more inklusive attribute set exists, + or a directory with the same name exists + CARRY: 0 + AX is handle number + handle is open for read/write + creates a new file or truncates existing to length 0 + $3D : open a file + call: + AH: $3D + DS:DX: pointer to pathname (asciz) + AL: access + 0=open for reading + 1=open for writing + 2=open for both + return: + CARRY: 1 + AX: 2=file not found + 4=too many open files + no file handles available + 5=access denied + attempted to open a directory, volume id or + a read only file for writing + 12=invalid access + AL was not in range 0..2 + CARRY: 0 + AX is handle number + read/write pointer is set to the first byte of the file + and the record size is set to 1 + the returned file handle must be used in subsequent operations + $3E : close a file handle + call: + AH: $3E + BX: file handle + return: + CARRY: 1 + 6=invalid handle (not currently open) + CARRY: 0=no error + the associated file is closed, buffers are flushed + $3F : read from file/device + call: + AH: $3F + DS:DX: pointer to buffer + CX: bytes to read + BX: file handle + return: + CARRY: 1 + AX: 5=access denied + not opened for read + 6=invalid handle (not currently open) + CARRY: 0 + AX: number of bytes read + 0=eof + $40 : write to file/device + call: + AH: $40 + DS:DX: pointer to buffer + CX: bytes to write + if 0, the file size is set to the current position + BX: file handle + return: + CARRY: 1 + AX: 5=access denied + 6=invalid handle + CARRY: 0 + AX: number of bytes written + is error if not the same number as requested + $41 : delete a directory entry + call: + AH: $41 + DS:DX: pointer to pathname + return: + CARRY: 1 + AX: 2=file not found + 5=access denied + directory or read only + CARRY: 0=no error + $42 : move file pointer + call: + AH: $42 + CX:DX: distance to move, in bytes + AL: method of moving + 0=move pointer to offset from beginning of file + 1=move to offset from current location + 2=move to offset from eof + BX: file handle + return: + CARRY: 1 + AX: 1=invalid function + AL not in range 0..2 + 6=invalid handle + CARRY 0: + DX:AX: new pointer location + moves the read/write file pointer + $43 : change attributes + call: + AH: $43 + DS:DX: pointer to pathname (asciz) + AL: function + 0=return in CX + 1=set to CX + CX: if AL=1 + attribute to be set + return: + CARRY: 1 + AX: 1=invalid function + AL not in range 0..1 + 3=path not found + 5=access denied + CX contained attributes that can not be changed + (directory, volume id) + CARRY: 0 + if AL=0 + CX: attributes + $44 : i/o control for devices + call: + AH: $44 + BX: handle + BL: (for calls AL=4, 5) drive: 0=default, .. + DS:DX: data or buffer + CX: bytes to read or write + AL: function code + calls 0,1: bits of DX (DH must be 0 on a set call) + 0: iscin + 1: iscot + 2: isnul + 3: isclk + 4: specl + 5: raw + 6: eof + 7: isdev + 8-13: reserved + 14: ctrl + 15: res + if isdev=0 then channel is a disk file + eof: 0=channel has been written + bits 0-5 are block device number for the channel + (0=a, 1=b, ..) + if isdev=1 then channel is device + eof : 0=end of file on input + raw : 0=this device is cooked + 1=device in raw mode + isclk: 1=clock + isnul: 1=nul + iscot: 1=console output + iscin: 1=console input + specl: 1=device is special + ctrl : 0=device can not do control strings + via calls 2,3 + 1=can do control + 0=get device information (returned in DX) + 1=set device information (according to DX) + calls 2,5: arbitrary control strings sent or received + to or from a device + call syntax is the same as in read/write calls, + except for 4 and 5, which take drive number in BL + instead of a handle in BX + an invalid function error is returned, if + the ctrl bit is 0 + 2=read CX number of bytes to DS:DX from device control channel + 3=write CX number of bytes from DS:DX to device control channel + 4=read CX number of bytes to DS:DX from device control channel + drive number in BL (0=default, ..) + 5=write CX number of bytes from DS:DX to device control channel + drive number in BL (0=default, ..) + calls 6,7: check, if a file handle is ready for i/o + intended for status of handles associated with + devices, but checks of file handles are allowed + and defined: input: always ready (255), until eof + then always not ready (0) + output: always ready + 6=get input status + 7=get output status + return: + CARRY: 1 + AX: 1=invalid function + 5=access denied + 6=invalid handle + 13=invalid data + CARRY: 0 + AL: 2,3,4,5 + AX: count transferred + AL: 6,7 + 0=not ready + 255=ready + sets or gets device information associated with an open handle + or sends or receives a control string to or from a device handle or device + if the function is used for files, only functions 0,6,7 are defined + $45 : duplicate a file handle + call: + AH: $45 + BX: file handle + return: + CARRY: 1 + AX: 4=too many files open + 6=invalid handle + CARRY: 0 + AX: new file handle + retruns a new handle that refers to the same file + $46 : force a duplicate of a handle + call: + AH: $46 + BX: existing file handle + CX: new file handle + return: + CARRY: 1 + AX: 4=too many open files + 6=invalid handle + CARRY: 0=no error + CX then refers to the same file as BX, eventually, CX is closed first + $47 : return text of current directory + call: + AH: $47 + DS:SI: pointer to 64 byte area + DL: drive number (0=default, ..) + return: + CARRY: 1 + AX: 15=invalid drive + CARRY: 0=no error + the path name does not contain the leading separators + $48 : allocate memory + call: + AH: $48 + BX: size of memory to be allocated + return: + CARRY: 1 + AX: 7=arena trashed + internal consistency has been destroyed + 8=not enough memory + BX: maximum size that could be allocated + CARRY: 0 + AX:0: pointer to the allocated memory + $49 : free allocated memory + call: + AH: $49 + ES: segment address of memory area to be freed + return: + CARRY: 1 + AX: 7=arena trashed + internal consistency has been destroyed + 9=invalid block + the block was not allocated by $49 + CARRY: 0=no error + returns a piece of memory to the system pool that was allocated with $49 + $4A : modify allocated memory blocks + call: + AH: $4A + ES: segment address of memory area + BX: requested memory area + return: + CARRY: 1 + AX: 7=arena trashed + internal consistency has been destroyed + 8=not enough memory + 9=invalid block + the block was not allocated by $49 + BX: maximum size possible + CARRY: 0=no error + attempts to grow or shrink an allocated block + $4B : load and execute a program + call: + AH: $4B + DS:DX: pointer to pathname (asciz) + ES:BX: pointer to parameter block + for AL=0: + size name + 2 segment address of environment + 4 pointer to command line at $80 + 4 pointer to default fcb to be passed at $5C + 4 pointer to default fcb to be passed at $6C + for AL=3: + size name + 2 segment address where file will be loaded + 2 relocation factor to be applied to the image + AL: 0=load and execute + 3=load (overlay) + return: + CARRY: 1 + AX: 1=invalid function + AL was not in range 0,3 + 2=file not found + 8=not enough memory + 10=bad environment + larger than 32K + 11=bad format + EXE file contained inconsistent information + CARRY: 0=no error + all open files of a parent are copied to the child process + also inherited is an environment (block of text strings less than 32K) + a zero environment address causes the child to inherit then parents + environment unchanged + $4C : terminate process + call: + AH: $4C + AL: return code + $4D : retrieve then return code of a child + call: + AH: $4D + return: + AX: exit code + high byte: 0=terminate/abort + 1=alt-c + 2=hard error + 3=terminate and stay resident + returns code only once + $4E : find match file + call: + AH: $4E + DS:DX: pointer to pathname + CX: search attributes + return: + CARRY: 1 + AX: 2=file not found + 18=no more files + CARRY: 0=no error + data block is written to current dma address: + size name + 21 reserved for subsequent calls + 1 attribute found + 2 time + 2 date + 2 low(size) + 2 high(size) + 13 packed name + subsequent calls: see $4F + $4F : step through a directory matching files + call: + AH: $4F + return: + CARRY: 1 + AX: 18=no more files + CARRY: 0=no error + only used for subsequent calls after $4E + dma address must point to the parablock + $54 : return current setting of verify after write flag + call: + AH: $54 + return: + current verify flag value + $56 : move a directory entry + call: + AH: $56 + DS:DX: pointer to pathname of existing file + ES:DI: pointer to new pathname + return: + CARRY: 1 + AX: 2=file not found + 5=access denied + path is directory or new file exists + or directory entry could not be created + 17=not same device + CARRY: 0=no error + attempts to rename a file in the directory of one device + $57 : get/set date/time of file + call: + AH: $57 + AL: 0=get date and time + 1=set date and time + BX: file handle + CX: if AL=1 + time to be set + DX: if AL=1 + date to be set + return: + CARRY: 1 + AX: 1=invalid function + 6=invalid handle + CARRY: 0=no error + CX: if AL=0 + time + DX: if AL=0 + date + date and time are not recorded until file is closed + diff --git a/system/dos/1986/src/252 b/system/dos/1986/src/252 new file mode 100644 index 0000000..b4369b6 Binary files /dev/null and b/system/dos/1986/src/252 differ diff --git a/system/dos/1986/src/253 b/system/dos/1986/src/253 new file mode 100644 index 0000000..c7a4494 Binary files /dev/null and b/system/dos/1986/src/253 differ diff --git a/system/dos/1986/src/254 b/system/dos/1986/src/254 new file mode 100644 index 0000000..f71eeb6 Binary files /dev/null and b/system/dos/1986/src/254 differ diff --git a/system/dos/1986/src/255 b/system/dos/1986/src/255 new file mode 100644 index 0000000..d21b649 Binary files /dev/null and b/system/dos/1986/src/255 differ diff --git a/system/dos/1986/src/COND.TXT b/system/dos/1986/src/COND.TXT new file mode 100644 index 0000000..02cb949 --- /dev/null +++ b/system/dos/1986/src/COND.TXT @@ -0,0 +1,5 @@ +FLOPPY = TRUE +HDU = FALSE +TEST = FALSE +DOS = TRUE +CPM = FALSE diff --git a/system/dos/1986/src/block i-o b/system/dos/1986/src/block i-o new file mode 100644 index 0000000..4336746 --- /dev/null +++ b/system/dos/1986/src/block i-o @@ -0,0 +1,104 @@ +PACKET disk block io DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + (* 25.03.86 *) + read disk block, + read disk cluster, + write disk block, + write disk cluster, + io error, + first non dummy ds page: + +INT CONST first non dummy ds page := 2; + +INT VAR error; + +PROC read disk block (DATASPACE VAR ds, + INT CONST ds page no, + INT CONST block no, + INT VAR error): + check rerun; + read block (ds, ds page no, eublock (block no), error). + +END PROC read disk block; + +PROC read disk block (DATASPACE VAR ds, + INT CONST ds page no, + INT CONST block no): + check rerun; + read block (ds, ds page no, eublock (block no), error); + IF error <> 0 + THEN io error (error) + FI. + +END PROC read disk block; + +PROC read disk block (DATASPACE VAR ds, + INT CONST block no): + read disk block (ds, first non dummy ds page, block no) + +END PROC read disk block; + +PROC read disk cluster (DATASPACE VAR ds, + INT CONST first ds page no, + INT CONST cluster no): + INT VAR i; + FOR i FROM 0 UPTO sectors per cluster - 1 REP + read disk block (ds, first ds page no + i, block no + i) + PER. + +block no: + first block no of cluster (cluster no). + +END PROC read disk cluster; + +PROC write disk block (DATASPACE CONST ds, + INT CONST ds page no, + INT CONST block no, + INT VAR error): + check rerun; + write block (ds, ds page no, 0,eu block (block no), error). + +END PROC write disk block; + +PROC write disk block (DATASPACE CONST ds, + INT CONST ds page no, + INT CONST block no): + check rerun; + write block (ds, ds page no, 0, eu block (block no), error); + IF error <> 0 + THEN io error (error) + FI. + +END PROC write disk block; + +PROC write disk block (DATASPACE CONST ds, + INT CONST block no): + write disk block (ds, first non dummy ds page, block no) + +END PROC write disk block; + +PROC write disk cluster (DATASPACE CONST ds, + INT CONST first ds page no, + INT CONST cluster no): + INT VAR i; + FOR i FROM 0 UPTO sectors per cluster - 1 REP + write disk block (ds, first ds page no + i, block no + i) + PER. + +block no: + first block no of cluster (cluster no). + +END PROC write disk cluster; + +PROC io error (INT CONST error code): + SELECT error code OF + CASE 1: errorstop ("Laufwerk nicht betriebsbereit") + CASE 2: errorstop ("Schreib-/Lesefehler") + CASE 3: errorstop ("Interner Fehler (Blocknummer zu hoch)") + CASE 4: errorstop ("Block nicht lesbar") + OTHERWISE errorstop ("Schreib-/Lesefehler " + text (error)) + END SELECT. + +END PROC io error; + +END PACKET disk block io; diff --git a/system/dos/1986/src/cluster b/system/dos/1986/src/cluster new file mode 100644 index 0000000..ef2720b --- /dev/null +++ b/system/dos/1986/src/cluster @@ -0,0 +1,109 @@ +PACKET cluster DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + (* 19.03.86 *) + + CLUSTER, + :=, + text, + text 32, (* typical dir entry *) + write text, + write text 32, + reduce cluster buffer: + +LET max cluster size = 8192; (* 8192 * 8 = 64 KB *) + +TYPE CLUSTER = BOUND STRUCT (ALIGN dummy, + ROW max cluster size REAL cluster row); + +TEXT VAR string; +INT VAR string length; + +INT VAR sector no, eight byte pos, index; + +reduce cluster buffer; + +.reals per sector: sector size DIV 8. +.reals per std eu sector: 512 DIV 8. + +PROC reduce cluster buffer: + string := 32 * "*"; + string length := 32. + +END PROC reduce cluster buffer; + +OP := (CLUSTER VAR cluster, DATASPACE VAR ds): + CONCR (cluster) := ds + +END OP :=; + +TEXT PROC text (CLUSTER CONST cluster, INT CONST from, to): + init string; + FOR sector no FROM 0 UPTO sectors per cluster - 1 REP + get text of sector + PER; + subtext (string, from, to). + +init string: + IF string length < cluster size + THEN string := cluster size * "*"; + string length := cluster size + FI. + +get text of sector: + FOR eight byte pos FROM 1 UPTO reals per sector REP + replace (string, string index, cluster.cluster row [row index]) + PER. + +string index: + reals per sector * sector no + eight byte pos. + +row index: + reals per std eu sector * sector no + eight byte pos. + +END PROC text; + +TEXT PROC text 32 (CLUSTER CONST cluster, INT CONST part): + FOR index FROM 1 UPTO 4 REP + replace (string, index, cluster.cluster row [index + 4 * part]) + PER; + subtext (string, 1, 32). + +END PROC text 32; + +PROC write text (CLUSTER VAR cluster, + TEXT CONST string): + IF LENGTH string < cluster size + THEN execute write text (cluster, text (string, cluster size)) + ELSE execute write text (cluster, string) + FI. + +END PROC write text; + +PROC execute write text (CLUSTER VAR cluster, + TEXT CONST string): + FOR sector no FROM 0 UPTO sectors per cluster - 1 REP + write text of sector + PER. + +write text of sector: + FOR eight byte pos FROM 1 UPTO reals per sector REP + cluster.cluster row [row index] := string RSUB (string index) + PER. + +row index: + reals per std eu sector * sector no + eight byte pos. + +string index: + reals per sector * sector no + eight byte pos. + + +END PROC execute write text; + +PROC write text 32 (CLUSTER VAR cluster, TEXT CONST string, INT CONST part): + FOR index FROM 1 UPTO 4 REP + cluster.cluster row [index + 4 * part] := string RSUB (index) + PER; + +END PROC write text 32; + +END PACKET cluster; diff --git a/system/dos/1986/src/disk descriptor.dos.fd b/system/dos/1986/src/disk descriptor.dos.fd new file mode 100644 index 0000000..660dd46 --- /dev/null +++ b/system/dos/1986/src/disk descriptor.dos.fd @@ -0,0 +1,290 @@ +PACKET dos disk DEFINES (* Copyright (C) 1985, 86 *) + (* Frank Klapper *) + first fat byte, (* 30.05.86 *) + begin of fat, + number of fat sectors, + number of fat entrys, + number of fat copies, + begin of dir, + number of dir sectors, + begin of data area, + sectors per cluster, + cluster size, + sector size, + + eublock, + first block no of cluster, + + reset disk attributes, + set disk attributes: + +LET dir entrys per block = 16, + first non dummy ds page = 2; + +LET DOSDISK = STRUCT (INT sectors per cluster, + number of reserved sectors, + number of fats, + number of dir sectors, + first fat byte, + number of fat sectors, + heads, + sectors per track, + tracks, + number of fat entrys, + REAL size); + +LET BLOCK = BOUND STRUCT (ALIGN dummy, ROW 64 REAL block row); + +INT CONST sector size :: 512; + +TEXT VAR bpb := 32 * " "; + +INITFLAG VAR bpb ds used := FALSE; + +DATASPACE VAR bpb ds; + +BLOCK VAR bpb block; + +DOSDISK VAR disk format; +BOUND DOSDISK VAR format table; + +INT VAR eu sectors, + xbegin of data area; + +INT PROC eublock (INT CONST nr): +(*COND FLOPPY*) + IF page format + THEN head * eu sectors per head + trac * eu sectors + sector + ELSE head * eu sectors + trac * abs (eu heads) * eu sectors + sector + FI. + +page format: + eu heads < 0. + +sector: + nr MOD disk format.sectors per track. + +trac: + (nr DIV disk format.sectors per track) DIV disk format.heads. + +head: + (nr DIV disk format.sectors per track) MOD disk format.heads. + +eu sectors per head: + eu sectors * eu tracks. + +(*ENDCOND*) +(*COND HDU + nr + +ENDCOND*) + +END PROC eublock; + +INT PROC first block no of cluster (INT CONST cluster no): + IF cluster no < 2 + THEN error stop ("interner Fehler") + FI; + begin of data area + (cluster no - 2) * sectors per cluster. + +END PROC first block no of cluster; + +INT PROC first fat byte: + disk format.first fat byte + +END PROC first fat byte; + +INT PROC number of fat copies: + disk format.number of fats + +END PROC number of fat copies; + +INT PROC number of fat sectors: + disk format.number of fat sectors + +END PROC number of fat sectors; + +INT PROC number of fat entrys: + disk format.number of fat entrys + +END PROC number of fat entrys; + +INT PROC number of dir sectors: + disk format.number of dir sectors + +END PROC number of dir sectors; + +INT PROC begin of fat (INT CONST no): + disk format.number of reserved sectors + no * disk format.number of fat sectors + +END PROC begin of fat; + +INT PROC begin of dir: + disk format.number of reserved sectors + + disk format.number of fats * disk format.number of fat sectors + +END PROC begin of dir; + +INT PROC begin of data area: + xbegin of data area + +END PROC begin of data area; + +INT PROC sectors per cluster: + disk format.sectors per cluster + +END PROC sectors per cluster; + +INT PROC cluster size: + disk format.sectors per cluster * 512 + +END PROC cluster size; + +PROC set disk attributes (INT CONST first fat byte): + enable stop; +(*COND FLOPPY*) + get bios parameter block; + IF is valid bpb + THEN load disk data from bpb + ELSE load disk disk data from ds + FI; + eu sectors := eu last sector - eu first sector +1; +(*ENDCOND*) + xbegin of data area := disk format.number of reserved sectors + + disk format.number of fats * disk format.number of fat sectors + + disk format.number of dir sectors; +(*COND FLOPPY*) + test compatibility + +.is valid bpb: + first fat byte < 252 OR code (bpb SUB 22) = first fat byte. + +load disk disk data from ds: + IF exists (text (first fat byte)) + THEN format table := old (text (first fat byte)); + copy values + ELSE error stop ("DOS-Diskettenformat nicht implementiert") + FI. + +copy values: + disk format.sectors per cluster := format table.sectors per cluster; + disk format.number of reserved sectors := format table.number of reserved sectors; + disk format.number of fats := format table.number of fats; + disk format.size := format table.size; + disk format.number of dir sectors := format table.number of dir sectors; + disk format.first fat byte := format table.first fat byte; + disk format.number of fat sectors := format table.number of fat sectors; + disk format.heads := format table.heads; + disk format.sectors per track := format table.sectors per track; + disk format.tracks := format table.tracks; + disk format.number of fat entrys := format table.number of fat entrys. + +test compatibility: + IF disk format.sectors per track > eu sectors + OR eu tracks <> disk format.tracks + OR abs (eu heads) < disk format.heads + OR disk format.number of reserved sectors <> 1 + THEN error stop ("DOS-Format auf diesem Diskettenlaufwerk nicht lesbar") + FI; +(*ENDCOND*) + +END PROC set disk attributes; + +PROC reset disk attributes: +(*COND FLOPPY*) + disk format.sectors per cluster := 1; + disk format.number of reserved sectors := 1; + disk format.number of fats := 1; + disk format.size := real (eu size); + disk format.number of dir sectors := 4; + disk format.first fat byte := 255; + disk format.number of fat sectors := 1; + disk format.heads := eu heads; + disk format.sectors per track := eu tracks; + disk format.tracks := eu sectors; + disk format.number of fat entrys := 100. + +(*ENDCOND*) +(*COND HDU + get bios parameter block; + load disk data from bpb (248). + +ENDCOND*) + +END PROC reset disk attributes; + +PROC get bios parameter block: + init bpb ds; + read bpb; + copy bpb block to bpb text. + +init bpb ds: + IF NOT initialized (bpb ds used) + THEN bpb ds := nilspace; + bpb block := bpb ds + FI. + +read bpb: + INT VAR error; + read block (bpb ds, first non dummy ds page, 0, error); + IF error <> 0 + THEN SELECT error OF + CASE 1: errorstop ("Floppylaufwerk nicht betriebsbereit") + CASE 2: errorstop ("Schreib-/Lesefehler") + CASE 3: errorstop ("Interner Fehler (Blocknummer zu hoch)") + OTHERWISE errorstop ("Schreib-/Lesefehler " + text (error)) + END SELECT + FI. + +copy bpb block to bpb text: + replace (bpb, 1, bpb block. block row [1]); + replace (bpb, 2, bpb block. block row [2]); + replace (bpb, 3, bpb block. block row [3]); + replace (bpb, 4, bpb block. block row [4]). + +END PROC get bios parameter block; + +PROC load disk data from bpb: + disable stop; + enable load disk data from bpb; + IF is error + THEN clear error; + enable stop; + error stop ("Bios-Parameterblock ungltig") + FI. + +END PROC load disk data from bpb; + +PROC enable load disk data from bpb: + disk format.sectors per cluster := code (bpb SUB 14); + disk format.number of reserved sectors := code (bpb SUB 16) * 256 + code (bpb SUB 15); + disk format.number of fats := code (bpb SUB 17); + disk format.number of dir sectors := dir entrys DIV dir entrys per block; + disk format.size := real (code (bpb SUB 21)) * 256.0 + real (code (bpb SUB 20)); + disk format.first fat byte := code (bpb SUB 22); + disk format.number of fat sectors := code (bpb SUB 24) * 256 + code (bpb SUB 23); + disk format.heads := dos heads; + disk format.sectors per track := code (bpb SUB 26) * 256 + code (bpb SUB 25); + disk format.tracks := + int(disk format.size / real(disk format.sectors per track * disk format.heads)); + disk format.number of fat entrys := fat entrys. + +dir entrys: + code (bpb SUB 19) * 256 + code (bpb SUB 18). + +dos heads: + code (bpb SUB 28) * 256 + code (bpb SUB 27). + +fat entrys: + data clusters + 2. + +data clusters: + int ((disk format.size - real (no of table sectors)) / real (sectors per cluster)). + +no of table sectors: + disk format.number of reserved sectors + disk format.number of fats * disk format.number of fat sectors + + disk format.number of dir sectors. + +END PROC enable load disk data from bpb; + +END PACKET dos disk; diff --git a/system/dos/1986/src/disk descriptor.dos.hd b/system/dos/1986/src/disk descriptor.dos.hd new file mode 100644 index 0000000..312b273 --- /dev/null +++ b/system/dos/1986/src/disk descriptor.dos.hd @@ -0,0 +1,290 @@ +PACKET dos disk DEFINES (* Copyright (C) 1985, 86 *) + (* Frank Klapper *) + first fat byte, (* 30.05.86 *) + begin of fat, + number of fat sectors, + number of fat entrys, + number of fat copies, + begin of dir, + number of dir sectors, + begin of data area, + sectors per cluster, + cluster size, + sector size, + + eublock, + first block no of cluster, + + reset disk attributes, + set disk attributes: + +LET dir entrys per block = 16, + first non dummy ds page = 2; + +LET DOSDISK = STRUCT (INT sectors per cluster, + number of reserved sectors, + number of fats, + number of dir sectors, + first fat byte, + number of fat sectors, + heads, + sectors per track, + tracks, + number of fat entrys, + REAL size); + +LET BLOCK = BOUND STRUCT (ALIGN dummy, ROW 64 REAL block row); + +INT CONST sector size :: 512; + +TEXT VAR bpb := 32 * " "; + +INITFLAG VAR bpb ds used := FALSE; + +DATASPACE VAR bpb ds; + +BLOCK VAR bpb block; + +DOSDISK VAR disk format; +BOUND DOSDISK VAR format table; + +INT VAR eu sectors, + xbegin of data area; + +INT PROC eublock (INT CONST nr): +(*COND FLOPPY + IF page format + THEN head * eu sectors per head + trac * eu sectors + sector + ELSE head * eu sectors + trac * abs (eu heads) * eu sectors + sector + FI. + +page format: + eu heads < 0. + +sector: + nr MOD disk format.sectors per track. + +trac: + (nr DIV disk format.sectors per track) DIV disk format.heads. + +head: + (nr DIV disk format.sectors per track) MOD disk format.heads. + +eu sectors per head: + eu sectors * eu tracks. + +ENDCOND*) +(*COND HDU*) + nr + +(*ENDCOND*) + +END PROC eublock; + +INT PROC first block no of cluster (INT CONST cluster no): + IF cluster no < 2 + THEN error stop ("interner Fehler") + FI; + begin of data area + (cluster no - 2) * sectors per cluster. + +END PROC first block no of cluster; + +INT PROC first fat byte: + disk format.first fat byte + +END PROC first fat byte; + +INT PROC number of fat copies: + disk format.number of fats + +END PROC number of fat copies; + +INT PROC number of fat sectors: + disk format.number of fat sectors + +END PROC number of fat sectors; + +INT PROC number of fat entrys: + disk format.number of fat entrys + +END PROC number of fat entrys; + +INT PROC number of dir sectors: + disk format.number of dir sectors + +END PROC number of dir sectors; + +INT PROC begin of fat (INT CONST no): + disk format.number of reserved sectors + no * disk format.number of fat sectors + +END PROC begin of fat; + +INT PROC begin of dir: + disk format.number of reserved sectors + + disk format.number of fats * disk format.number of fat sectors + +END PROC begin of dir; + +INT PROC begin of data area: + xbegin of data area + +END PROC begin of data area; + +INT PROC sectors per cluster: + disk format.sectors per cluster + +END PROC sectors per cluster; + +INT PROC cluster size: + disk format.sectors per cluster * 512 + +END PROC cluster size; + +PROC set disk attributes (INT CONST first fat byte): + enable stop; +(*COND FLOPPY + get bios parameter block; + IF is valid bpb + THEN load disk data from bpb + ELSE load disk disk data from ds + FI; + eu sectors := eu last sector - eu first sector +1; +ENDCOND*) + xbegin of data area := disk format.number of reserved sectors + + disk format.number of fats * disk format.number of fat sectors + + disk format.number of dir sectors; +(*COND FLOPPY + test compatibility + +.is valid bpb: + first fat byte < 252 OR code (bpb SUB 22) = first fat byte. + +load disk disk data from ds: + IF exists (text (first fat byte)) + THEN format table := old (text (first fat byte)); + copy values + ELSE error stop ("DOS-Diskettenformat nicht implementiert") + FI. + +copy values: + disk format.sectors per cluster := format table.sectors per cluster; + disk format.number of reserved sectors := format table.number of reserved sectors; + disk format.number of fats := format table.number of fats; + disk format.size := format table.size; + disk format.number of dir sectors := format table.number of dir sectors; + disk format.first fat byte := format table.first fat byte; + disk format.number of fat sectors := format table.number of fat sectors; + disk format.heads := format table.heads; + disk format.sectors per track := format table.sectors per track; + disk format.tracks := format table.tracks; + disk format.number of fat entrys := format table.number of fat entrys. + +test compatibility: + IF disk format.sectors per track > eu sectors + OR eu tracks <> disk format.tracks + OR abs (eu heads) < disk format.heads + OR disk format.number of reserved sectors <> 1 + THEN error stop ("DOS-Format auf diesem Diskettenlaufwerk nicht lesbar") + FI; +ENDCOND*) + +END PROC set disk attributes; + +PROC reset disk attributes: +(*COND FLOPPY + disk format.sectors per cluster := 1; + disk format.number of reserved sectors := 1; + disk format.number of fats := 1; + disk format.size := real (eu size); + disk format.number of dir sectors := 4; + disk format.first fat byte := 255; + disk format.number of fat sectors := 1; + disk format.heads := eu heads; + disk format.sectors per track := eu tracks; + disk format.tracks := eu sectors; + disk format.number of fat entrys := 100. + +ENDCOND*) +(*COND HDU*) + get bios parameter block; + load disk data from bpb. + +(*ENDCOND*) + +END PROC reset disk attributes; + +PROC get bios parameter block: + init bpb ds; + read bpb; + copy bpb block to bpb text. + +init bpb ds: + IF NOT initialized (bpb ds used) + THEN bpb ds := nilspace; + bpb block := bpb ds + FI. + +read bpb: + INT VAR error; + read block (bpb ds, first non dummy ds page, 0, error); + IF error <> 0 + THEN SELECT error OF + CASE 1: errorstop ("Floppylaufwerk nicht betriebsbereit") + CASE 2: errorstop ("Schreib-/Lesefehler") + CASE 3: errorstop ("Interner Fehler (Blocknummer zu hoch)") + OTHERWISE errorstop ("Schreib-/Lesefehler " + text (error)) + END SELECT + FI. + +copy bpb block to bpb text: + replace (bpb, 1, bpb block. block row [1]); + replace (bpb, 2, bpb block. block row [2]); + replace (bpb, 3, bpb block. block row [3]); + replace (bpb, 4, bpb block. block row [4]). + +END PROC get bios parameter block; + +PROC load disk data from bpb: + disable stop; + enable load disk data from bpb; + IF is error + THEN clear error; + enable stop; + error stop ("Bios-Parameterblock ungltig") + FI. + +END PROC load disk data from bpb; + +PROC enable load disk data from bpb: + disk format.sectors per cluster := code (bpb SUB 14); + disk format.number of reserved sectors := code (bpb SUB 16) * 256 + code (bpb SUB 15); + disk format.number of fats := code (bpb SUB 17); + disk format.number of dir sectors := dir entrys DIV dir entrys per block; + disk format.size := real (code (bpb SUB 21)) * 256.0 + real (code (bpb SUB 20)); + disk format.first fat byte := code (bpb SUB 22); + disk format.number of fat sectors := code (bpb SUB 24) * 256 + code (bpb SUB 23); + disk format.heads := dos heads; + disk format.sectors per track := code (bpb SUB 26) * 256 + code (bpb SUB 25); + disk format.tracks := + int(disk format.size / real(disk format.sectors per track * disk format.heads)); + disk format.number of fat entrys := fat entrys. + +dir entrys: + code (bpb SUB 19) * 256 + code (bpb SUB 18). + +dos heads: + code (bpb SUB 28) * 256 + code (bpb SUB 27). + +fat entrys: + data clusters + 2. + +data clusters: + int ((disk format.size - real (no of table sectors)) / real (sectors per cluster)). + +no of table sectors: + disk format.number of reserved sectors + disk format.number of fats * disk format.number of fat sectors + + disk format.number of dir sectors. + +END PROC enable load disk data from bpb; + +END PACKET dos disk; diff --git a/system/dos/1986/src/disk manager b/system/dos/1986/src/disk manager new file mode 100644 index 0000000..5711ee7 --- /dev/null +++ b/system/dos/1986/src/disk manager @@ -0,0 +1,245 @@ +PACKET disk manager DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + disk fetch, (* 07.05.86 *) + disk check, + disk save first phase, + disk save second phase, + disk clear, + disk format, + disk erase, + disk exists, + disk list, + disk all, + disk reserve, + disk free: + +LET ascii = 1, + ascii german = 2, + transparent = 3, + ebcdic = 4, + row text = 5, + ds = 6, + atari st = 10; + +TEXT VAR file name; + +INT VAR mode := 0; +TEXT VAR mode extension; + +REAL VAR last access time := 0.0; + +PROC disk fetch (TEXT CONST name, DATASPACE VAR file ds): + enable stop; + access disk; + file name := adapted name (name, TRUE); + IF dir contains (file name) + THEN do fetch + ELSE errorstop ("die Datei """ + file name + """ gibt es nicht") + FI; + last access time := clock (1). + +do fetch: + SELECT mode OF + CASE ascii, ascii german, atari st, ebcdic, transparent: fetch filemode (file ds, filename, mode) + CASE row text : fetch row textmode (file ds, filename) + CASE ds : fetch dsmode (file ds, filename) + OTHERWISE error stop ("Unzulssige Betriebsart") + END SELECT. + +END PROC disk fetch; + +PROC disk check (TEXT CONST name): + enable stop; + access disk; + file name := adapted name (name, TRUE); + IF dir contains (file name) + THEN disable stop; + check file (file name); + IF is error + THEN clear error; + error stop ("Fehler beim Prflesen der Datei """ + file name + """") + FI; + ELSE error stop ("""" + file name + """ gibt es nicht") + FI; + last access time := clock (1). + +END PROC disk check; + +PROC disk save first phase (TEXT CONST name, BOOL VAR overwrite question): + enable stop; + overwrite question := FALSE; + access disk; + file name := adapted name (name, FALSE); + IF dir contains (file name) + THEN overwrite question := TRUE + FI; + last access time := clock (1). + +END PROC disk save first phase; + +PROC disk save second phase (DATASPACE CONST file ds): + enable stop; + access disk; + erase file if necessary; + do save; + last access time := clock (1). + +erase file if necessary: + IF dir contains (file name) + THEN erase table entrys (file name) + FI. + +do save: + SELECT mode OF + CASE ascii, ascii german,atari st, ebcdic, transparent: save filemode (file ds, filename, mode) + CASE row text : save row textmode (file ds, filename) + CASE ds : save dsmode (file ds, filename) + OTHERWISE error stop ("Unzulssige Betriebsart") + END SELECT. + +END PROC disk save second phase; + +(* DOS bekommt die Tabellenparameter von der Diskette + CPM bekommt die Tabellenparameter ber 'reserve' *) + +PROC disk clear: + enable stop; +(*COND DOS*) + access disk; +(*ENDCOND*) +(*COND CPM + open eu disk; + open action; +ENDCOND*) + format disk; + last access time := clock (1). + +END PROC disk clear; + +PROC disk erase (TEXT CONST name): + enable stop; + access disk; + file name := adapted name (name, TRUE); + IF NOT dir contains (file name) + THEN errorstop ("die Datei """ + file name + """ gibt es nicht") + ELSE erase table entrys (file name); + FI; + last access time := clock (1). + +END PROC disk erase; + +BOOL PROC disk exists (TEXT CONST name): + enable stop; + access disk; + last access time := clock (1); + dir contains (adapted name (name, TRUE)). + +END PROC disk exists; + +PROC disk list (DATASPACE VAR list ds): + enable stop; + access disk; + dir list (list ds); + last access time := clock (1). + +END PROC disk list; + +THESAURUS PROC disk all: + enable stop; + access disk; + last access time := clock (1); + dir all. + +END PROC disk all; + +PROC disk format: + +(*COND DOS*) + error stop ("nicht implementiert") +(*ENDCOND*) + +(*COND CPM + enable stop; + open eu disk; + open action; + format archive (eu disk format no); + format disk; + last access time := clock (1). +ENDCOND*) + +END PROC disk format; + +PROC disk reserve (TEXT CONST reserve string): + enable stop; + close action; + last access time := clock (1); + get mode. + +get mode: + TEXT VAR mode text; + IF pos (reserve string, ":") = 0 + THEN mode text := reserve string; + mode extension := "" + ELSE mode text := subtext (reserve string, 1, pos (reserve string, ":") - 1); + mode extension := subtext (reserve string, pos (reserve string, ":") + 1) + FI; + prepare modetext; + IF mode text = "FILEASCII" + THEN mode := ascii + ELIF mode text = "FILEASCIIGERMAN" + THEN mode := asciigerman + ELIF mode text = "FILEATARIST" + THEN mode := atari st + ELIF modetext = "FILEEBCDIC" + THEN mode := ebcdic + ELIF modetext = "FILETRANSPARENT" + THEN mode := transparent + ELIF mode text = "ROWTEXT" + THEN mode := row text + ELIF mode text = "DS" + THEN mode := ds + ELSE error stop ("Unzulssige Betriebsart") + FI. + +prepare modetext: + change all (mode text, " ", ""); + INT VAR i; + FOR i FROM 1 UPTO LENGTH mode text REP + IF is lower case + THEN replace (mode text, i, upper case char) + FI + PER. + +is lower case: + code (mode text SUB i) > 96 AND code (mode text SUB i) < 123. + +upper case char: + code (code (mode text SUB i) - 32). + +END PROC disk reserve; + +PROC disk free: + disable stop; + close action; + close disk; + reduce cluster buffer. + +END PROC disk free; + +PROC access disk: + IF action closed COR (last access more than two seconds ago CAND disk changed) + THEN open disk archive + FI. + +open disk archive: + close action; + open eu disk; + open disk (mode extension); + open action. + +last access more than two seconds ago: + abs (clock (1) - last access time) > 2.0. + +END PROC access disk; + +END PACKET disk manager; diff --git a/system/dos/1986/src/eu disk descriptor.fd b/system/dos/1986/src/eu disk descriptor.fd new file mode 100644 index 0000000..c09c820 --- /dev/null +++ b/system/dos/1986/src/eu disk descriptor.fd @@ -0,0 +1,102 @@ +PACKET eu disk DEFINES (* Copyright (C) 1985 *) + (* Frank Klapper *) + (* 25.03.86 *) + load shard interface table, + open eu disk, + eu size, + eu heads, + eu tracks, + eu first sector, + eu last sector: + +LET table length = 15, + + size field = 1, + head field = 2, + track field = 3, + first sector field = 4, + last sector field = 5; + +ROW table length ROW 5 INT VAR format table; + +INT VAR table top, + table pointer; + +PROC open eu disk: + enable stop; + init check rerun; +(*COND FLOPPY*) + INT VAR blocks := archive blocks; + search format table entry; +(*ENDCOND*) +. + +(*COND FLOPPY*) +search format table entry: + table pointer := 1; + WHILE format table [table pointer][size field] <> blocks REP + table pointer INCR 1; + IF table pointer > table top + THEN error stop ("Diskettenformat nicht implementiert") + FI + PER. +(*ENDCOND*) + +END PROC open eu disk; + +PROC load shard interface table: + FILE VAR f := sequential file (input, "shard interface"); + TEXT VAR line; + table top := 0; + WHILE NOT eof (f) REP + get line (f, line); + IF (line SUB 1) <> ";" + THEN load line + FI + PER. + +load line: + table top INCR 1; + IF table top > table length + THEN error stop ("Shard Interface Tabelle zu gro") + FI; + INT VAR blank pos := 1; + format table [table top][size field] := next int; + format table [table top][head field] := next int; + format table [table top][track field] := next int; + format table [table top][first sector field] := next int; + format table [table top][last sector field] := next int. + +next int: + line := compress (subtext (line, blank pos)) + " "; + blank pos := pos (line, " "); + int (subtext (line, 1, blank pos - 1)). + +END PROC load shard interface table; + +INT PROC eu size: + format table [table pointer][size field] + +END PROC eu size; + +INT PROC eu heads: + format table [table pointer][head field] + +END PROC eu heads; + +INT PROC eu tracks: + format table [table pointer][track field] + +END PROC eu tracks; + +INT PROC eu first sector: + format table [table pointer][first sector field] + +END PROC eu first sector; + +INT PROC eu last sector: + format table [table pointer][last sector field] + +END PROC eu last sector; + +END PACKET eu disk; diff --git a/system/dos/1986/src/eu disk descriptor.hd b/system/dos/1986/src/eu disk descriptor.hd new file mode 100644 index 0000000..73179db --- /dev/null +++ b/system/dos/1986/src/eu disk descriptor.hd @@ -0,0 +1,102 @@ +PACKET eu disk DEFINES (* Copyright (C) 1985 *) + (* Frank Klapper *) + (* 25.03.86 *) + load shard interface table, + open eu disk, + eu size, + eu heads, + eu tracks, + eu first sector, + eu last sector: + +LET table length = 15, + + size field = 1, + head field = 2, + track field = 3, + first sector field = 4, + last sector field = 5; + +ROW table length ROW 5 INT VAR format table; + +INT VAR table top, + table pointer; + +PROC open eu disk: + enable stop; + init check rerun; +(*COND FLOPPY + INT VAR blocks := archive blocks; + search format table entry; +ENDCOND*) +. + +(*COND FLOPPY +search format table entry: + table pointer := 1; + WHILE format table [table pointer][size field] <> blocks REP + table pointer INCR 1; + IF table pointer > table top + THEN error stop ("Diskettenformat nicht implementiert") + FI + PER. +ENDCOND*) + +END PROC open eu disk; + +PROC load shard interface table: + FILE VAR f := sequential file (input, "shard interface"); + TEXT VAR line; + table top := 0; + WHILE NOT eof (f) REP + get line (f, line); + IF (line SUB 1) <> ";" + THEN load line + FI + PER. + +load line: + table top INCR 1; + IF table top > table length + THEN error stop ("Shard Interface Tabelle zu gro") + FI; + INT VAR blank pos := 1; + format table [table top][size field] := next int; + format table [table top][head field] := next int; + format table [table top][track field] := next int; + format table [table top][first sector field] := next int; + format table [table top][last sector field] := next int. + +next int: + line := compress (subtext (line, blank pos)) + " "; + blank pos := pos (line, " "); + int (subtext (line, 1, blank pos - 1)). + +END PROC load shard interface table; + +INT PROC eu size: + format table [table pointer][size field] + +END PROC eu size; + +INT PROC eu heads: + format table [table pointer][head field] + +END PROC eu heads; + +INT PROC eu tracks: + format table [table pointer][track field] + +END PROC eu tracks; + +INT PROC eu first sector: + format table [table pointer][first sector field] + +END PROC eu first sector; + +INT PROC eu last sector: + format table [table pointer][last sector field] + +END PROC eu last sector; + +END PACKET eu disk; diff --git a/system/dos/1986/src/eumel-ebcdic + sub b/system/dos/1986/src/eumel-ebcdic + sub new file mode 100644 index 0000000..5a571cb --- /dev/null +++ b/system/dos/1986/src/eumel-ebcdic + sub @@ -0,0 +1,550 @@ +PACKET eumel ebcdic DEFINES (* Copyright (c) 1986 *) + (* Frank Klapper *) + (* 19.02.86 *) + ebcdic to eumel with substitution, + eumel to ebcdic with substitution: + +TEXT VAR bild; + +PROC eumel to ebcdic with substitution (TEXT VAR string): + bild := ""; + INT VAR pos; + FOR pos FROM 1 UPTO LENGTH string REP + bild CAT conversion + PER; + string := bild. + +conversion: + SELECT code (string SUB pos) OF + CASE 0: "{"240""240""240"{" + CASE 1: "{"240""240""241"{" + CASE 2: "{"240""240""242"{" + CASE 3: "{"240""240""243"{" + CASE 4: "{"240""240""244"{" + CASE 5: "{"240""240""245"{" + CASE 6: "{"240""240""246"{" + CASE 7: "{"240""240""247"{" + CASE 8: "{"240""240""248"{" + CASE 9: "{"240""240""249"{" + CASE 10: "%" + CASE 11: "{"240""241""241"{" + CASE 12: ""12"" + CASE 13: ""13"" + CASE 14: "{"240""241""244"{" + CASE 15: "{"240""241""245"{" + CASE 16: "{"240""241""246"{" + CASE 17: "{"240""241""247"{" + CASE 18: "{"240""241""248"{" + CASE 19: "{"240""241""249"{" + CASE 20: "{"240""242""240"{" + CASE 21: "{"240""242""241"{" + CASE 22: "{"240""242""242"{" + CASE 23: "{"240""242""243"{" + CASE 24: "{"240""242""244"{" + CASE 25: "{"240""242""245"{" + CASE 26: "{"240""242""246"{" + CASE 27: "{"240""242""247"{" + CASE 28: "{"240""242""248"{" + CASE 29: "{"240""242""249"{" + CASE 30: "{"240""243""240"{" + CASE 31: "{"240""243""241"{" + CASE 32: "@" + CASE 33: "O" + CASE 34: "" + CASE 35: "{" + CASE 36: "{"240""243""246"{" + CASE 37: "l" + CASE 38: "P" + CASE 39: "}" + CASE 40: "M" + CASE 41: "]" + CASE 42: "\" + CASE 43: "N" + CASE 44: "k" + CASE 45: "`" + CASE 46: "K" + CASE 47: "a" + CASE 48: ""240"" + CASE 49: ""241"" + CASE 50: ""242"" + CASE 51: ""243"" + CASE 52: ""244"" + CASE 53: ""245"" + CASE 54: ""246"" + CASE 55: ""247"" + CASE 56: ""248"" + CASE 57: ""249"" + CASE 58: "z" + CASE 59: "^" + CASE 60: "L" + CASE 61: "~" + CASE 62: "n" + CASE 63: "o" + CASE 64: "|" + CASE 65: "" + CASE 66: "" + CASE 67: "" + CASE 68: "" + CASE 69: "" + CASE 70: "" + CASE 71: "" + CASE 72: "" + CASE 73: "" + CASE 74: "" + CASE 75: "" + CASE 76: "" + CASE 77: "" + CASE 78: "" + CASE 79: "" + CASE 80: "" + CASE 81: "" + CASE 82: "" + CASE 83: ""226"" + CASE 84: ""227"" + CASE 85: ""228"" + CASE 86: ""229"" + CASE 87: ""230"" + CASE 88: ""231"" + CASE 89: ""232"" + CASE 90: ""233"" + CASE 91: "J" + CASE 92: ""224"" + CASE 93: "Z" + CASE 94: "{"240""249""244"{" + CASE 95: "m" + CASE 96: "y" + CASE 97: "" + CASE 98: "" + CASE 99: "" + CASE 100: "" + CASE 101: "" + CASE 102: "" + CASE 103: "" + CASE 104: "" + CASE 105: "" + CASE 106: "" + CASE 107: "" + CASE 108: "" + CASE 109: "" + CASE 110: "" + CASE 111: "" + CASE 112: "" + CASE 113: "" + CASE 114: "" + CASE 115: "" + CASE 116: "" + CASE 117: "" + CASE 118: "" + CASE 119: "" + CASE 120: "" + CASE 121: "" + CASE 122: "" + CASE 123: "" + CASE 124: "{"241""242""244"{" + CASE 125: "" + CASE 126: "" + CASE 127: "{"241""242""247"{" + CASE 128: "{"241""242""248"{" + CASE 129: "{"241""242""249"{" + CASE 130: "{"241""243""240"{" + CASE 131: "{"241""243""241"{" + CASE 132: "{"241""243""242"{" + CASE 133: "{"241""243""243"{" + CASE 134: "{"241""243""244"{" + CASE 135: "{"241""243""245"{" + CASE 136: "{"241""243""246"{" + CASE 137: "{"241""243""247"{" + CASE 138: "{"241""243""248"{" + CASE 139: "{"241""243""249"{" + CASE 140: "{"241""244""240"{" + CASE 141: "{"241""244""241"{" + CASE 142: "{"241""244""242"{" + CASE 143: "{"241""244""243"{" + CASE 144: "{"241""244""244"{" + CASE 145: "{"241""244""245"{" + CASE 146: "{"241""244""246"{" + CASE 147: "{"241""244""247"{" + CASE 148: "{"241""244""248"{" + CASE 149: "{"241""244""249"{" + CASE 150: "{"241""245""240"{" + CASE 151: "{"241""245""241"{" + CASE 152: "{"241""245""242"{" + CASE 153: "{"241""245""243"{" + CASE 154: "{"241""245""244"{" + CASE 155: "{"241""245""245"{" + CASE 156: "{"241""245""246"{" + CASE 157: "{"241""245""247"{" + CASE 158: "{"241""245""248"{" + CASE 159: "{"241""245""249"{" + CASE 160: "{"241""246""240"{" + CASE 161: "{"241""246""241"{" + CASE 162: "{"241""246""242"{" + CASE 163: "{"241""246""243"{" + CASE 164: "{"241""246""244"{" + CASE 165: "{"241""246""245"{" + CASE 166: "{"241""246""246"{" + CASE 167: "{"241""246""247"{" + CASE 168: "{"241""246""248"{" + CASE 169: "{"241""246""249"{" + CASE 170: "{"241""247""240"{" + CASE 171: "{"241""247""241"{" + CASE 172: "{"241""247""242"{" + CASE 173: "{"241""247""243"{" + CASE 174: "{"241""247""244"{" + CASE 175: "{"241""247""245"{" + CASE 176: "{"241""247""246"{" + CASE 177: "{"241""247""247"{" + CASE 178: "{"241""247""248"{" + CASE 179: "{"241""247""249"{" + CASE 180: "{"241""248""240"{" + CASE 181: "{"241""248""241"{" + CASE 182: "{"241""248""242"{" + CASE 183: "{"241""248""243"{" + CASE 184: "{"241""248""244"{" + CASE 185: "{"241""248""245"{" + CASE 186: "{"241""248""246"{" + CASE 187: "{"241""248""247"{" + CASE 188: "{"241""248""248"{" + CASE 189: "{"241""248""249"{" + CASE 190: "{"241""249""240"{" + CASE 191: "{"241""249""241"{" + CASE 192: "{"241""249""242"{" + CASE 193: "{"241""249""243"{" + CASE 194: "{"241""249""244"{" + CASE 195: "{"241""249""245"{" + CASE 196: "{"241""249""246"{" + CASE 197: "{"241""249""247"{" + CASE 198: "{"241""249""248"{" + CASE 199: "{"241""249""249"{" + CASE 200: "{"242""240""240"{" + CASE 201: "{"242""240""241"{" + CASE 202: "{"242""240""242"{" + CASE 203: "{"242""240""243"{" + CASE 204: "{"242""240""244"{" + CASE 205: "{"242""240""245"{" + CASE 206: "{"242""240""246"{" + CASE 207: "{"242""240""247"{" + CASE 208: "{"242""240""248"{" + CASE 209: "{"242""240""249"{" + CASE 210: "{"242""241""240"{" + CASE 211: "{"242""241""241"{" + CASE 212: "{"242""241""242"{" + CASE 213: "{"242""241""243"{" + CASE 214: "{"242""241""244"{" + CASE 215: "{"242""241""245"{" + CASE 216: "{"242""241""246"{" + CASE 217: "{"242""241""247"{" + CASE 218: "{"242""241""248"{" + CASE 219: "{"242""241""249"{" + CASE 220: "" + CASE 221: "`" + CASE 222: "{" + CASE 223: "@" + CASE 224: "{"242""242""244"{" + CASE 225: "{"242""242""245"{" + CASE 226: "{"242""242""246"{" + CASE 227: "{"242""242""247"{" + CASE 228: "{"242""242""248"{" + CASE 229: "{"242""242""249"{" + CASE 230: "{"242""243""240"{" + CASE 231: "{"242""243""241"{" + CASE 232: "{"242""243""242"{" + CASE 233: "{"242""243""243"{" + CASE 234: "{"242""243""244"{" + CASE 235: "{"242""243""245"{" + CASE 236: "{"242""243""246"{" + CASE 237: "{"242""243""247"{" + CASE 238: "{"242""243""248"{" + CASE 239: "{"242""243""249"{" + CASE 240: "{"242""244""240"{" + CASE 241: "{"242""244""241"{" + CASE 242: "{"242""244""242"{" + CASE 243: "{"242""244""243"{" + CASE 244: "{"242""244""244"{" + CASE 245: "{"242""244""245"{" + CASE 246: "{"242""244""246"{" + CASE 247: "{"242""244""247"{" + CASE 248: "{"242""244""248"{" + CASE 249: "{"242""244""249"{" + CASE 250: "{"242""245""240"{" + CASE 251: "{"242""245""241"{" + CASE 252: "{"242""245""242"{" + CASE 253: "{"242""245""243"{" + CASE 254: "{"242""245""244"{" + CASE 255: "{"242""245""245"{" + OTHERWISE "" + END SELECT. + +END PROC eumel to ebcdic with substitution; + +PROC ebcdic to eumel with substitution (TEXT VAR string): + bild := ""; + INT VAR pos; + FOR pos FROM 1 UPTO LENGTH string REP + bild CAT conversion + PER; + string := bild. + +conversion: + SELECT code (string SUB pos) OF + CASE 0: "#000#" + CASE 1: "#001#" + CASE 2: "#002#" + CASE 3: "#003#" + CASE 4: "#004#" + CASE 5: "#005#" + CASE 6: "#006#" + CASE 7: "#007#" + CASE 8: "#008#" + CASE 9: "#009#" + CASE 10: "#010#" + CASE 11: "#011#" + CASE 12: "#012#" + CASE 13: "#013#" + CASE 14: "#014#" + CASE 15: "#015#" + CASE 16: "#016#" + CASE 17: "#017#" + CASE 18: "#018#" + CASE 19: "#019#" + CASE 20: "#020#" + CASE 21: "#021#" + CASE 22: "#022#" + CASE 23: "#023#" + CASE 24: "#024#" + CASE 25: "#025#" + CASE 26: "#026#" + CASE 27: "#027#" + CASE 28: "#028#" + CASE 29: "#029#" + CASE 30: "#030#" + CASE 31: "#031#" + CASE 32: "#032#" + CASE 33: "#033#" + CASE 34: "#034#" + CASE 35: "#035#" + CASE 36: "#036#" + CASE 37: "#037#" + CASE 38: "#038#" + CASE 39: "#039#" + CASE 40: "#040#" + CASE 41: "#041#" + CASE 42: "#042#" + CASE 43: "#043#" + CASE 44: "#044#" + CASE 45: "#045#" + CASE 46: "#046#" + CASE 47: "#047#" + CASE 48: "#048#" + CASE 49: "#049#" + CASE 50: "#050#" + CASE 51: "#051#" + CASE 52: "#052#" + CASE 53: "#053#" + CASE 54: "#054#" + CASE 55: "#055#" + CASE 56: "#056#" + CASE 57: "#057#" + CASE 58: "#058#" + CASE 59: "#059#" + CASE 60: "#060#" + CASE 61: "#061#" + CASE 62: "#062#" + CASE 63: "#063#" + CASE 64: "#064#" + CASE 65: "#065#" + CASE 66: "#066#" + CASE 67: "#067#" + CASE 68: "#068#" + CASE 69: "#069#" + CASE 70: "#070#" + CASE 71: "#071#" + CASE 72: "#072#" + CASE 73: "#073#" + CASE 74: "[" + CASE 75: "." + CASE 76: "<" + CASE 77: "(" + CASE 78: "+" + CASE 79: "!" + CASE 80: "&" + CASE 81: "#081#" + CASE 82: "#082#" + CASE 83: "#083#" + CASE 84: "#084#" + CASE 85: "#085#" + CASE 86: "#086#" + CASE 87: "#087#" + CASE 88: "#088#" + CASE 89: "#089#" + CASE 90: "]" + CASE 91: "$" + CASE 92: "*" + CASE 93: ")" + CASE 94: ";" + CASE 95: "^" + CASE 96: "-" + CASE 97: "/" + CASE 98: "#098#" + CASE 99: "#099#" + CASE 100: "#100#" + CASE 101: "#101#" + CASE 102: "#102#" + CASE 103: "#103#" + CASE 104: "#104#" + CASE 105: "#105#" + CASE 106: "|" + CASE 107: "," + CASE 108: "%" + CASE 109: "_" + CASE 110: ">" + CASE 111: "?" + CASE 112: "#112#" + CASE 113: "#113#" + CASE 114: "#114#" + CASE 115: "#115#" + CASE 116: "#116#" + CASE 117: "#117#" + CASE 118: "#118#" + CASE 119: "#119#" + CASE 120: "#120#" + CASE 121: "`" + CASE 122: ":" + CASE 123: "#" + CASE 124: "@" + CASE 125: "'" + CASE 126: "=" + CASE 127: """" + CASE 128: "#128#" + CASE 129: "a" + CASE 130: "b" + CASE 131: "c" + CASE 132: "d" + CASE 133: "e" + CASE 134: "f" + CASE 135: "g" + CASE 136: "h" + CASE 137: "i" + CASE 138: "#138#" + CASE 139: "#139#" + CASE 140: "#140#" + CASE 141: "#141#" + CASE 142: "#142#" + CASE 143: "#143#" + CASE 144: "#144#" + CASE 145: "j" + CASE 146: "k" + CASE 147: "l" + CASE 148: "m" + CASE 149: "n" + CASE 150: "o" + CASE 151: "p" + CASE 152: "q" + CASE 153: "r" + CASE 154: "#154#" + CASE 155: "#155#" + CASE 156: "#156#" + CASE 157: "#157#" + CASE 158: "#158#" + CASE 159: "#159#" + CASE 160: "#160#" + CASE 161: "~" + CASE 162: "s" + CASE 163: "t" + CASE 164: "u" + CASE 165: "v" + CASE 166: "w" + CASE 167: "x" + CASE 168: "y" + CASE 169: "z" + CASE 170: "#170#" + CASE 171: "#171#" + CASE 172: "#172#" + CASE 173: "#173#" + CASE 174: "#174#" + CASE 175: "#175#" + CASE 176: "#176#" + CASE 177: "#177#" + CASE 178: "#178#" + CASE 179: "#179#" + CASE 180: "#180#" + CASE 181: "#181#" + CASE 182: "#182#" + CASE 183: "#183#" + CASE 184: "#184#" + CASE 185: "#185#" + CASE 186: "#186#" + CASE 187: "#187#" + CASE 188: "#188#" + CASE 189: "#189#" + CASE 190: "#190#" + CASE 191: "#191#" + CASE 192: "{" + CASE 193: "A" + CASE 194: "B" + CASE 195: "C" + CASE 196: "D" + CASE 197: "E" + CASE 198: "F" + CASE 199: "G" + CASE 200: "H" + CASE 201: "I" + CASE 202: "#202#" + CASE 203: "#203#" + CASE 204: "#204#" + CASE 205: "#205#" + CASE 206: "#206#" + CASE 207: "#207#" + CASE 208: "}" + CASE 209: "J" + CASE 210: "K" + CASE 211: "L" + CASE 212: "M" + CASE 213: "N" + CASE 214: "O" + CASE 215: "P" + CASE 216: "Q" + CASE 217: "R" + CASE 218: "#218#" + CASE 219: "#219#" + CASE 220: "#220#" + CASE 221: "#221#" + CASE 222: "#222#" + CASE 223: "#223#" + CASE 224: "\" + CASE 225: "#225#" + CASE 226: "S" + CASE 227: "T" + CASE 228: "U" + CASE 229: "V" + CASE 230: "W" + CASE 231: "X" + CASE 232: "Y" + CASE 233: "Z" + CASE 234: "#234#" + CASE 235: "#235#" + CASE 236: "#236#" + CASE 237: "#237#" + CASE 238: "#238#" + CASE 239: "#239#" + CASE 240: "0" + CASE 241: "1" + CASE 242: "2" + CASE 243: "3" + CASE 244: "4" + CASE 245: "5" + CASE 246: "6" + CASE 247: "7" + CASE 248: "8" + CASE 249: "9" + CASE 250: "#250#" + CASE 251: "#251#" + CASE 252: "#252#" + CASE 253: "#253#" + CASE 254: "#254#" + CASE 255: "#255#" + OTHERWISE "" + END SELECT. +END PROC ebcdic to eumel with substitution; + +END PACKET eumel ebcdic; diff --git a/system/dos/1986/src/fat and dir.dos.fd b/system/dos/1986/src/fat and dir.dos.fd new file mode 100644 index 0000000..5a82655 --- /dev/null +++ b/system/dos/1986/src/fat and dir.dos.fd @@ -0,0 +1,1190 @@ +PACKET dos fat and dir DEFINES (* Copyright (C) 1985, 86 *) + (* Frank Klapper *) + open disk, (* 30.05.86 *) + close disk, + format disk, + disk changed, + open fetch, + next fetch cluster no, + open save, + next save cluster no, + close save, + erase table entrys, +(*COND TEST + dump fat, +ENDCOND*) + dir all, + dir list, + dir contains: + +LET fat row size = 16384, (* 32 KB *) + max fat blocks = 25, + first fat entry no = 2, + last entry of fat chain = 4088, + dir entrys per block = 16, + max dir entrys = 1600, (* 100 KB *) + archive byte = " "; + +LET FAT = BOUND STRUCT (ALIGN dummy, + ROW 256 INT block row, + ROW fat row size INT fat row); + +LET LOCATION = STRUCT (INT msdos block no, + block entry no), + + FILEENTRY = STRUCT (TEXT date and time, + REAL size, + INT first cluster, + LOCATION location), + + DIRENTRY = INT, + + FILELIST = STRUCT (THESAURUS thes, + ROW max dir entrys FILEENTRY entry, + INT no of entrys), + + DIRLIST = STRUCT (THESAURUS thes, + ROW max dir entrys DIRENTRY entry, + INT no of entrys), + + FREELIST = STRUCT (ROW max dir entrys LOCATION stack, + INT stacktop, + LOCATION begin of free area, + end of dir, + INT dir chain root), + + DIR = BOUND STRUCT (FILELIST filelist, + DIRLIST dirlist, + FREELIST freelist, + TEXT disklabel, + path); + +INITFLAG VAR this packet := FALSE; + +DATASPACE VAR fat space, + dir ds, + block ds; + +BOOL VAR dataspaces open; + +FAT VAR fat struct; +ROW max fat blocks BOOL VAR write access; +INT VAR first possible available fat entry; + +DIR VAR dir; + +CLUSTER VAR block; + +INT VAR akt file cluster no, + first file cluster no; +BOOL VAR no cluster saved; +TEXT VAR save name; + +INT VAR count; + +TEXT VAR convert buffer := " ", + name, + dir entry; + +.fat: + fat struct.fat row. + +PROC open disk (TEXT CONST subdir path): + disable stop; + enable open disk (subdir path); + IF is error + THEN close action + FI + +END PROC open disk; + +PROC enable open disk (TEXT CONST subdir path): + enable stop; + init dataspaces; + open fat; + open dir. + +open fat: + reset disk attributes; + read first fat block; + set disk attributes (fat byte (0)); + read other fat blocks; + define write access table (FALSE); + first possible available fat entry := first fat entry no. + +read first fat block: + read fat block (0, FALSE). + +read other fat blocks: + INT VAR block no; + FOR block no FROM 1 UPTO number of fat sectors - 1 REP + read fat block (block no, FALSE) + PER. + +open dir: + init dir struct (subdir path, -1); + load main dir blocks; + load subdirs if necessary. + +load main dir blocks: + BOOL VAR last block; + store end of dir (loc (end of main dir, dir entrys per block - 1)); + FOR block no FROM begin of dir UPTO end of main dir REP + load dir block (block no, last block); + UNTIL last block + PER. + +end of main dir: + begin of dir + number of dir sectors - 1. + +load subdirs if necessary: + TEXT VAR path := subdir path; + WHILE path <> "" REP + load next subdir if possible + PER. + +load next subdir if possible: + INT VAR cluster no; + get next subdir name; + get first cluster no of subdir table; + clear dir entrys (cluster no); + WHILE cluster no >= 0 REP + load subdir entrys of cluster; + cluster no := next fetch cluster no + UNTIL last block + PER. + +get next subdir name: + TEXT VAR subdir name; + IF (path SUB 1) <> "\" + THEN error stop ("ungltige Pfadbezeichnung") + FI; + INT VAR backslash pos := pos (path, "\", "\", 2); + IF backslash pos = 0 + THEN subdir name := subtext (path, 2); + path := "" + ELSE subdir name := subtext (path, 2, backslash pos - 1); + path := subtext (path, backslash pos) + FI; + subdir name := adapted name (subdir name, TRUE). + +get first cluster no of subdir table: + IF dir thes CONTAINS subdir name + THEN open fetch subdir (subdir name, cluster no); + ELSE error stop ("Subdirectory existiert nicht") + FI. + +load subdir entrys of cluster: + store end of dir (loc (last block no of cluster, dir entrys per block - 1)); + FOR block no FROM 0 UPTO (sectors per cluster - 1) REP + load dir block (first block no of cluster (cluster no) + block no, last block) + UNTIL last block + PER. + +last block no of cluster: + first block no of cluster (cluster no) + sectors per cluster - 1. + +END PROC enable open disk; + +PROC init dataspaces: + enable stop; + IF NOT initialized (this packet) + THEN dataspaces open := FALSE + FI; + IF NOT dataspaces open + THEN disable stop; + dataspaces open := TRUE; + fat space := nilspace; + dir ds := nilspace; + block ds := nilspace; + fat struct := fat space; + dir := dir ds; + block := block ds + FI. + +END PROC init dataspaces; + +PROC init dir struct (TEXT CONST path string, INT CONST root): + clear dir entrys (root); + dir.path := path string; + dir.disk label := "". + +END PROC init dir struct; + +PROC clear dir entrys (INT CONST root): + init file list; + init dir list; + init free list (root). + +init file list: + dir.file list.thes := empty thesaurus; + dir.file list.no of entrys := 0. + +init dir list: + dir.dir list.thes := empty thesaurus; + dir.dir list.no of entrys := 0. + +END PROC clear dir entrys; + +PROC close disk: + enable stop; + IF NOT initialized (this packet) + THEN dataspaces open := FALSE + FI; + IF dataspaces open + THEN forget (dir ds); + forget (block ds); + forget (fat space); + dataspaces open := FALSE + FI. + +END PROC close disk; + +(*COND FLOPPY*) +PROC format disk: + enable stop; + init dataspaces; + format fat; + format dir. + +format fat: + write first four fat bytes; + write other fat bytes; + define write access table (TRUE); + copy fat to disk. + +write first four fat bytes: + fat [1] := word (first fat byte, 255); + fat [2] := word (255, 0). + +write other fat bytes: + FOR count FROM 3 UPTO fat length REP + fat [count] := 0 + PER. + +fat length: + INT VAR len := number of fat entrys + number of fat entrys DIV 2 + + number of fat entrys MOD 2; + len DIV 2 + len MOD 2. + +format dir: + init dir struct ("", -1); + store begin of free area (loc (begin of dir, 0)); + store end of dir (loc (end of dir, dir entrys per block - 1)); + FOR count FROM 0 UPTO dir entrys per block - 1 REP + write text 32 (block, ""0"" + 31 * ""246"", count) + PER; + disable stop; + FOR count FROM begin of dir UPTO end of dir REP + write disk block (block ds, count); + PER. + +end of dir: + begin of dir + number of dir sectors - 1. + +END PROC format disk; +(*ENDCOND*) + +(*COND HDU +PROC disk clear: + error stop ("nicht implementiert") + +END PROC disk clear; + +PROC format disk: + error stop ("nicht implementiert") + +END PROC format disk; +ENDCOND*) + +INT PROC word (INT CONST low byte, high byte): + convert buffer := code (low byte) + code (high byte); + convert buffer ISUB 1. + +END PROC word; + +BOOL PROC disk changed: +(*COND FLOPPY*) + disable stop; + NOT first fat block ok COR is error (* must be COR *) +(*ENDCOND*) +(*COND HDU + FALSE +ENDCOND*) + +END PROC disk changed; + +BOOL PROC first fat block ok: + enable stop; + read fat block (0, TRUE); + FOR count FROM 1 UPTO 256 REP + compare word + PER; + TRUE. + +compare word: + IF fat struct.fat row [count] <> fat struct.block row [count] + THEN LEAVE first fat block ok WITH FALSE + FI. + +END PROC first fat block ok; + +PROC open fetch (TEXT CONST name, REAL VAR size, INT VAR first cluster no): + enable stop; + first cluster no := dir.file list.entry [link index].first cluster; + size := dir.file list.entry [link index].size; + IF first cluster no >= 4088 + THEN first cluster no := -1 + FI; + akt file cluster no := first cluster no. + +link index: + link (file thes, name). + +END PROC open fetch; + +PROC open fetch subdir (TEXT CONST subdir name, INT VAR first cluster no): + first cluster no := dir.dir list.entry [link index]; + IF first cluster no >= 4088 + THEN first cluster no := -1 + FI; + akt file cluster no := first cluster no. + +link index: + link (dir thes, subdir name). + +END PROC open fetch subdir; + +INT PROC next fetch cluster no: + enable stop; + akt file cluster no := fat entry (akt file cluster no); + IF akt file cluster no < 4088 (*ff8h *) + THEN akt file cluster no + ELSE -1 + FI. + +END PROC next fetch cluster no; + +PROC open save (TEXT CONST file name): + enable stop; + save name := file name; + IF dir full + THEN error stop ("Directory voll") + FI; + IF dir thes CONTAINS file name + THEN error stop ("Subdirectory mit gleichem Namen existiert bereits") + FI; + IF file thes CONTAINS file name + THEN error stop ("Datei mit gleichem Namen existiert bereits") + FI; + no cluster saved := TRUE. + +END PROC open save; + +INT PROC next save cluster no: + enable stop; + IF no cluster saved + THEN akt file cluster no := available fat entry; + first file cluster no := akt file cluster no; + no cluster saved := FALSE + ELSE INT VAR old cluster no := akt file cluster no; + akt file cluster no := available fat entry; + write fat entry (old cluster no, akt file cluster no) + FI; + write fat entry (akt file cluster no, last entry of fat chain); + akt file cluster no. + +END PROC next save cluster no; + +PROC close save (REAL CONST size): + enable stop; + IF no cluster saved + THEN insert dir entry (save name, 4088, 0.0) + ELSE copy fat to disk; + insert dir entry (save name, first file cluster no, size) + FI. + +END PROC close save; + +PROC erase table entrys (TEXT CONST name): + enable stop; + INT VAR first file cluster := first cluster; + delete dir entry (name); + erase fat chain (first file cluster); + copy fat to disk. + +first cluster: + dir.file list.entry [link index].first cluster. + +link index: + link (file thes, name). + +END PROC erase table entrys; + +INT PROC fat entry (INT CONST entry no): + fix bytes; + construct value. + +fix bytes: + INT VAR first byte no := entry no + entry no DIV 2. + +construct value: + IF entry no MOD 2 = 0 + THEN (right byte MOD 16) * 256 + left byte + ELSE right byte * 16 + left byte DIV 16 + FI. + +left byte: + fat byte (first byte no). + +right byte: + fat byte (first byte no + 1). + +END PROC fat entry; + +INT PROC available fat entry: + FOR count FROM first possible available fat entry UPTO number of fat entrys - 1 REP + IF is available entry (count) + THEN first possible available fat entry := count; + LEAVE available fat entry WITH count + FI; + PER; + close action; error stop ("MS-DOS Datentraeger voll"); maxint. + +END PROC available fat entry; + +BOOL PROC is available entry (INT CONST entry no): + is zero entry. + +is zero entry: + IF entry no MOD 2 = 0 + THEN (left byte = 0) CAND ((right byte MOD 16) = 0) + ELSE (right byte = 0) CAND ((left byte DIV 16) = 0) + FI. + +left byte: + fat byte (first byte no). + +right byte: + fat byte (first byte no + 1). + +first byte no: + entry no + entry no DIV 2. + +END PROC is available entry; + +PROC erase fat chain (INT CONST first entry): + INT VAR akt entry no := first entry, + entry := fat entry (akt entry no); + WHILE akt entry no not last chain entry no REP + erase akt entry; + akt entry no := entry; + entry := fat entry (akt entry no) + PER; + erase akt entry. + +akt entry no not last chain entry no: + (entry < last entry of fat chain) AND (entry > 1). + +erase akt entry: + write fat entry (akt entry no, 0). + +END PROC erase fat chain; + +PROC write fat entry (INT CONST entry no, value): + fix bytes; + remark write access (fat block of first byte); + remark write access (fat block of second byte); + write value; + update first possible available entry. + +fix bytes: + INT VAR first byte no := entry no + entry no DIV 2. + +fat block of first byte: + first byte no DIV 512. + +fat block of second byte: + second byte no DIV 512. + +write value: + IF even entry no + THEN write fat byte (first byte no, value MOD 256); + write fat byte (second byte no, + (right byte DIV 16) * 16 + value DIV 256) + ELSE write fat byte (first byte no, + (left byte MOD 16) + 16 * (value MOD 16)); + write fat byte (second byte no, value DIV 16) + FI. + +even entry no: + entry no MOD 2 = 0. + +second byte no: + first byte no + 1. + +left byte: + fat byte (first byte no). + +right byte: + fat byte (second byte no). + +update first possible available entry: + IF value = 0 + THEN first possible available fat entry := + min (first possible available fat entry, entry no) + FI. + +END PROC write fat entry; + +INT PROC fat byte (INT CONST no): + replace (convert buffer, 1, word); + IF even byte no + THEN code (convert buffer SUB 1) + ELSE code (convert buffer SUB 2) + FI. + +even byte no: + no MOD 2 = 0. + +word: + fat [no DIV 2 + 1]. + +END PROC fat byte; + +PROC write fat byte (INT CONST byte no, new value): + read old word; + change byte; + write new word. + +read old word: + replace (convert buffer, 1, word). + +write new word: + word := convert buffer ISUB 1. + +word: + fat [byte no DIV 2 + 1]. + +change byte: + replace (convert buffer, byte pos, code (new value)). + +byte pos: + byte no MOD 2 + 1. + +END PROC write fat byte; + +PROC copy fat to disk: + INT VAR block no; + FOR block no FROM 0 UPTO number of fat sectors - 1 REP + IF was write access (block no) + THEN write fat block (block no) + FI + PER. + +END PROC copy fat to disk; + +PROC write fat block (INT CONST fat block no): + INT VAR fat copy no; + INT VAR return code; + disable stop; + FOR fat copy no FROM 0 UPTO number of fat copies -1 REP + write disk block (fat space, ds page no, block no, return code); + IF return code > 0 + THEN close action + FI + PER; + remark no write access (block no); + enable stop. + +ds page no: + first non dummy ds page + fat block no + 1. + +block no: + begin of fat (fat copy no) + fat block no. + +END PROC write fat block; + +PROC read fat block (INT CONST fat block, BOOL CONST test block): + INT VAR fat copy no; + disable stop; + FOR fat copy no FROM 0 UPTO number of fat copies - 1 REP + clear error; + read disk block (fat space, ds page no, fat block no) + UNTIL NOT is error + PER; + IF is error + THEN close action + FI; + enable stop. + +ds page no: + IF test block + THEN first non dummy ds page + ELSE fat block + first non dummy ds page + 1 + FI. + +fat block no: + begin of fat (fat copy no) + fat block. + +END PROC read fat block; + +PROC define write access table (BOOL CONST status): + FOR count FROM 1 UPTO number of fat sectors REP + write access [count] := status + PER. + +END PROC define write access table; + +PROC remark write access (INT CONST fat block no): + write access [fat block no + 1] := TRUE + +END PROC remark write access; + +PROC remark no write access (INT CONST fat block no): + write access [fat block no + 1] := FALSE + +END PROC remark no write access; + +BOOL PROC was write access (INT CONST fat block no): + write access [fat block no + 1] + +END PROC was write access; + +(*COND TEST +PROC dump fat: + IF NOT exists ("fat dump") + THEN open file + FI; + DATASPACE VAR ds := nilspace; + FILE VAR in := sequential file (input, "fat dump"), + out := sequential file (output, ds); + INT VAR i; + TEXT VAR line; + FOR i FROM 0 UPTO number of fat entrys - 1 REP + dump fat entry + PER; + forget ("fat dump", quiet); + copy (ds, "fat dump"); + forget (ds). + +open file: + in := sequential file (output, "fat dump"); + FOR i FROM 0 UPTO number of fat entrys - 1 REP + putline (in, text (i, 4) + ": ") + PER. + +dump fat entry: + cout (i); + getline (in, line); + putline (out, line + " " + text (fat entry (i), 4)). + +END PROC dump fat; +ENDCOND*) + +PROC load dir block (INT CONST block no, BOOL VAR last block): + last block := FALSE; + INT VAR return code; + read disk block (block ds, first non dummy ds page, block no, return code); + IF return code > 0 + THEN close action; + io error (return code) + FI; + INT VAR entry no, + thes index; + FOR entry no FROM 0 UPTO dir entrys per block - 1 REP + dir entry := text 32 (block, entry no); + process entry + PER. + +process entry: + SELECT pos (""0"."229"", dir entry SUB 1) OF + CASE 1: end of dir search + CASE 2: main dir entry + CASE 3: free entry + OTHERWISE file entry + END SELECT. + +end of dir search: + last block := TRUE; + store begin of free area (loc (block no, entry no)); + LEAVE load dir block. + +main dir entry: + (* no operation *). + +free entry: + store in free list (loc (block no, entry no)). + +file entry: + SELECT code (dir entry SUB 12) OF + CASE 8: volume label + CASE 16: sub dir entry + OTHERWISE dos file entry + END SELECT. + +volume label: + dir.disk label := text (dir entry, 1, 11). + +sub dir entry: + dir.dir list.no of entrys INCR 1; + insert (dir thes, name, thes index); + dir list entry := first cluster no. + +dos file entry: + IF dir.file list.no of entrys >= max dir entrys + THEN error stop ("Directorytabelle voll") + FI; + dir.file list.no of entrys INCR 1; + insert (file thes, name, thes index); + file list entry.first cluster := first cluster no; + file list entry.date and time := dos date + " " + dos time; + file list entry.size := dos storage; + file list entry.location.msdos block no := block no; + file list entry.location.block entry no := entry no. + +name: + IF name post <> "" + THEN name pre + "." + name post + ELSE name pre + FI. + +name pre: + compress (subtext (dir entry, 1, 8)). + +name post: + compress (subtext (dir entry, 9, 11)). + +file list entry: + dir.file list.entry [thes index]. + +dir list entry: + dir.dir list.entry [thes index]. + +first cluster no: + code (dir entry SUB 27) + 256 * code (dir entry SUB 28). + +dos storage: + real (code (dir entry SUB 29)) + + real (code (dir entry SUB 30)) * 256.0 + + real (code (dir entry SUB 31)) * 65536.0 + + real (code (dir entry SUB 32)) * 16777216.0. + +dos date: + day + "." + month + "." + year. + +day: + IF code (dir entry SUB 25) MOD 32 < 10 + THEN "0" + text (code (dir entry SUB 25) MOD 32) + ELSE text (code (dir entry SUB 25) MOD 32) + FI. + +month: + INT VAR dummy := code (dir entry SUB 25) DIV 32 + 8 * (code (dir entry SUB 26) MOD 2); + IF dummy < 10 + THEN "0" + text (dummy) + ELSE text (dummy) + FI. + +year: + text (80 + code (dir entry SUB 26) DIV 2, 2). + +dos time: + hour + ":" + minute. + +hour: + dummy := code (dir entry SUB 24) DIV 8; + IF dummy < 10 + THEN "0" + text (dummy) + ELSE text (dummy) + FI. + +minute: + dummy := code (dir entry SUB 23) DIV 32 + 8 * (code (dir entry SUB 24) MOD 8); + IF dummy < 10 + THEN "0" + text (dummy) + ELSE text (dummy) + FI. + +END PROC load dir block; + +PROC insert dir entry (TEXT CONST name, INT CONST start cluster, REAL CONST used storage): + (* name must be a dos name *) + LOCATION VAR ins pos := free location; + TEXT VAR akt date := date (clock (1)), + akt time := time of day (clock (1)); + write disk entry; + write dir struct entry. + +write disk entry: + INT VAR return code; + read disk block (block ds, first non dummy ds page, ins pos.msdos block no, return code); + IF return code > 0 + THEN close action; + io error (return code) + FI; + prepare name; + dir entry := name pre + name post + archive byte + (10 * ""0"") + dos time + + dos date + starting cluster + storage; + write text 32 (block, dir entry, ins pos.block entry no); + write disk block (block ds, first non dummy ds page,ins pos.msdos block no, return code); + IF return code > 0 + THEN close action; + io error (return code) + FI. + +prepare name: + TEXT VAR name pre, name post; + IF point pos > 0 + THEN name pre := subtext (name, 1, point pos - 1); + name post := subtext (name, point pos + 1); + name pre CAT (8 - LENGTH name pre) * " "; + name post CAT (3 - LENGTH name post) * " " + ELSE name pre := name + (8 - LENGTH name) * " "; + name post := " " + FI. + +point pos: + pos (name, "."). + +dos time: + code ((minute MOD 8) * 32) + code (8 * hour + minute DIV 8). + +hour: + int (subtext (akt time, 1, 2)). + +minute: + int (subtext (akt time, 4, 5)). + +dos date: + code (32 * (month MOD 8) + day) + code ((year - 80) * 2 + month DIV 8). + +day: + int (subtext (akt date, 1, 2)). + +month: + int (subtext (akt date, 4, 5)). + +year: + int (subtext (akt date, 7, 8)). + +starting cluster: + code (start cluster MOD 256) + code (start cluster DIV 256). + +storage: + code (int (round (256.0 * frac (used storage / 256.0), 0))) + + code (int (round (frac (floor (used storage / 256.0) / 256.0) * 256.0, 0))) + + code (int (floor (used storage / 65536.0))) + + code (0). (* maximal 16384 K *********************************) + +write dir struct entry: + INT VAR thes link; + insert (file thes, name, thes link); + file list entry.location := ins pos; + file list entry.first cluster := start cluster; + file list entry.date and time := akt date + " " + akt time; + file list entry.size := used storage. + +file list entry: + dir.filelist.entry [thes link]. + +END PROC insert dir entry; + +PROC delete dir entry (TEXT CONST name): + LOCATION VAR del pos; + get del pos; + erase dir struct entry; + erase disk entry; + store in free list (del pos). + +get del pos: + del pos := dir.filelist.entry [link index].location. + +link index: + link (file thes, name). + +erase dir struct entry: + INT VAR i; + delete (file thes, name, i). + +erase disk entry: + INT VAR return code; + read disk block (block ds, first non dummy ds page, del pos.msdos block no, return code); + IF return code > 0 + THEN close action; + io error (return code) + FI; + dir entry := text 32 (block, del pos.block entry no); + replace (dir entry, 1, ""229""); + write text 32 (block, dir entry, del pos.block entry no); + write disk block (block ds, first non dummy ds page, del pos.msdos block no, return code); + IF return code > 0 + THEN close action; + io error (return code) + FI. + +END PROC delete dir entry; + +. +file thes: + dir.filelist.thes. + +dir thes: + dir.dir list.thes. + +(*********************** dir information ******************************) + +THESAURUS PROC dir all: + file thes. + +END PROC dir all; + +BOOL PROC dir contains (TEXT CONST name): + file thes CONTAINS name + +END PROC dir contains; + +PROC dir list (DATASPACE VAR ds): + enable stop; + open list file; + list files; + list dirs; + write list head. + +open list file: + forget (ds); + ds := nilspace; + FILE VAR list file := sequential file (output, ds); + putline (list file, ""). + +list files: + INT VAR number := 0; + get (file thes, name, number); + WHILE number > 0 REP + generate file list line; + get (file thes, name, number) + PER. + +generate file list line: + write (list file, centered name); + write (list file, " "); + write (list file, text (act file entry.size, 11, 0)); + write (list file, " Bytes belegt "); + write (list file, act file entry.date and time); +(*COND TEST + write (list file, " +++ "); + write (list file, text (act file entry.first cluster)); +ENDCOND*) + line (list file). + +list dirs: + number := 0; + get (dir thes, name, number); + WHILE number > 0 REP + generate dir list line; + get (dir thes, name, number) + PER. + +generate dir list line: + write (list file, centered name); + write (list file, " "); +(*COND TEST + write (list file, " +++ "); + write (list file, text (dir.dir list.entry [number])); +ENDCOND*) + line (list file). + +centered name: + INT VAR point pos := pos (name, "."); + IF point pos > 0 + THEN name pre + "." + name post + ELSE text (name, 12) + FI. + +name pre: + text (subtext (name, 1, point pos - 1), 8). + +name post: + text (subtext (name, point pos + 1, point pos + 4), 3). + +act file entry: + dir.file list.entry [number]. + +write list head: + head line (list file, head). + +head: + "DOS" + disk label string + path string. + +disk label string: + IF dir.disk label <> "" + THEN ": " + dir.disk label + ELSE "" + FI. + +path string: + IF dir.path <> "" + THEN " PATH: " + dir.path + ELSE "" + FI. + +END PROC dir list; + +(************ free list handling ******************************************) +LOCATION PROC loc (INT CONST block, entry): + LOCATION : (block, entry) + +END PROC loc; + +BOOL OP > (LOCATION CONST l, r): + l.msdos block no > r.msdos block no + OR ((l.msdos block no = r.msdos block no) AND + (l.block entry no > r.block entry no) ) + +END OP >; + +OP INCR (LOCATION VAR l): + IF l.block entry no = dir entrys per block -1 + THEN l.block entry no := 0; + l.msdos block no INCR 1 + ELSE l.block entry no INCR 1 + FI. + +END OP INCR; + +PROC init free list (INT CONST dir root): + dir.freelist.stacktop := 0; + dir.freelist.begin of free area.msdos block no := maxint; + dir.freelist.end of dir.msdos block no := -1; + dir.freelist.dir chain root := dir root. + +END PROC init free list; + +BOOL PROC dir full: + stack empty AND free area empty AND NOT expansion alloweded. + +stack empty: + dir.freelist.stacktop < 1. + +free area empty: + dir.freelist.begin of free area > dir.freelist.end of dir. + +expansion alloweded: + dir.freelist.dir chain root >= 0. + +END PROC dir full; + +PROC store in free list (LOCATION CONST free): + dir.freelist.stacktop INCR 1; + dir.freelist.stack [top] := free. + +top: + dir.freelist.stacktop. + +END PROC store in free list; + +PROC store begin of free area (LOCATION CONST begin): + dir.freelist.begin of free area := begin + +END PROC store begin of free area; + +PROC store end of dir (LOCATION CONST end): + dir.freelist.end of dir := end + +END PROC store end of dir; + +LOCATION PROC free location: + LOCATION VAR result; + IF dir.freelist.stacktop > 0 + THEN pop + ELIF NOT free area empty + THEN first of free area + ELIF expansion alloweded + THEN allocate new dir space; + result := free location + ELSE error stop ("Directorytabelle voll") + FI; + result. + +pop: + result := dir.freelist.stack [top]; + top DECR 1. + +top: + dir.freelist.stack top. + +free area empty: + dir.freelist.begin of free area > dir.freelist.end of dir. + +first of free area: + result := dir.freelist.begin of free area; + INCR dir.freelist.begin of free area. + +expansion alloweded: + dir.freelist.dir chain root >= 0. + +END PROC free location; + +PROC allocate new dir space: + enable stop; + INT VAR new cluster no := available fat entry; + IF new cluster no < 0 + THEN error stop ("MS-DOS Datentraeger voll") + FI; + INT VAR last entry no; + search last entry of fat chain; + write fat entry (new cluster no, 4095); + write fat entry (last entry no, new cluster no); + copy fat to disk; + store begin of free area (loc (first new block, 0)); + store end of dir (loc (last new block, dir entrys per block - 1)); + init new dir cluster. + +search last entry of fat chain: + last entry no := dir.freelist.dir chain root; + WHILE fat entry (last entry no) < last entry of fat chain REP + last entry no := fat entry (last entry no) + PER. + +init new dir cluster: + FOR count FROM 0 UPTO dir entrys per block - 1 REP + write text 32 (block, ""0"" + 31 * ""246"", count) + PER; + disable stop; + FOR count FROM first new block UPTO last new block REP + write disk block (block ds, count); + PER. + +first new block: + firstblock no of cluster (new cluster no). + +last new block: + first block no of cluster (new cluster no) + sectors per cluster - 1. + +END PROC allocate new dir space; + +(*COND TEST +PROC dump freelist: + command dialogue (FALSE); + FILE VAR f := sequential file (output, "freelistdump"); + INT VAR i; + putline (f, "STACKTOP: " + text (fl.stacktop)); + putline (f, "STACK:"); + FOR i FROM 1 UPTO 16 * number of dir sectors REP + putline (f, " " + text (i, 4) + ": " + + text (fl.stack [i].msdos block no) + ", " + + text (fl.stack [i].block entry no)) + PER; + line (f); + putline (f, "BEGIN OF FREE: " + text (fl.begin of free area.msdos block no) + + ", " + text (fl.begin of free area.block entry no)); + putline (f, "END OF DIR: " + text (fl.end of dir.msdos block no) + + ", " + text (fl.end of dir.block entry no)). + +fl: + dir.freelist. + +END PROC dump free list; +ENDCOND*) + +END PACKET dos fat and dir; diff --git a/system/dos/1986/src/fat and dir.dos.hd b/system/dos/1986/src/fat and dir.dos.hd new file mode 100644 index 0000000..7d53f41 --- /dev/null +++ b/system/dos/1986/src/fat and dir.dos.hd @@ -0,0 +1,1190 @@ +PACKET dos fat and dir DEFINES (* Copyright (C) 1985, 86 *) + (* Frank Klapper *) + open disk, (* 30.05.86 *) + close disk, + format disk, + disk changed, + open fetch, + next fetch cluster no, + open save, + next save cluster no, + close save, + erase table entrys, +(*COND TEST + dump fat, +ENDCOND*) + dir all, + dir list, + dir contains: + +LET fat row size = 16384, (* 32 KB *) + max fat blocks = 25, + first fat entry no = 2, + last entry of fat chain = 4088, + dir entrys per block = 16, + max dir entrys = 1600, (* 100 KB *) + archive byte = " "; + +LET FAT = BOUND STRUCT (ALIGN dummy, + ROW 256 INT block row, + ROW fat row size INT fat row); + +LET LOCATION = STRUCT (INT msdos block no, + block entry no), + + FILEENTRY = STRUCT (TEXT date and time, + REAL size, + INT first cluster, + LOCATION location), + + DIRENTRY = INT, + + FILELIST = STRUCT (THESAURUS thes, + ROW max dir entrys FILEENTRY entry, + INT no of entrys), + + DIRLIST = STRUCT (THESAURUS thes, + ROW max dir entrys DIRENTRY entry, + INT no of entrys), + + FREELIST = STRUCT (ROW max dir entrys LOCATION stack, + INT stacktop, + LOCATION begin of free area, + end of dir, + INT dir chain root), + + DIR = BOUND STRUCT (FILELIST filelist, + DIRLIST dirlist, + FREELIST freelist, + TEXT disklabel, + path); + +INITFLAG VAR this packet := FALSE; + +DATASPACE VAR fat space, + dir ds, + block ds; + +BOOL VAR dataspaces open; + +FAT VAR fat struct; +ROW max fat blocks BOOL VAR write access; +INT VAR first possible available fat entry; + +DIR VAR dir; + +CLUSTER VAR block; + +INT VAR akt file cluster no, + first file cluster no; +BOOL VAR no cluster saved; +TEXT VAR save name; + +INT VAR count; + +TEXT VAR convert buffer := " ", + name, + dir entry; + +.fat: + fat struct.fat row. + +PROC open disk (TEXT CONST subdir path): + disable stop; + enable open disk (subdir path); + IF is error + THEN close action + FI + +END PROC open disk; + +PROC enable open disk (TEXT CONST subdir path): + enable stop; + init dataspaces; + open fat; + open dir. + +open fat: + reset disk attributes; + read first fat block; + set disk attributes (fat byte (0)); + read other fat blocks; + define write access table (FALSE); + first possible available fat entry := first fat entry no. + + read first fat block: + read fat block (0, FALSE). + +read other fat blocks: + INT VAR block no; + FOR block no FROM 1 UPTO number of fat sectors - 1 REP + read fat block (block no, FALSE) + PER. + +open dir: + init dir struct (subdir path, -1); + load main dir blocks; + load subdirs if necessary. + +load main dir blocks: + BOOL VAR last block; + store end of dir (loc (end of main dir, dir entrys per block - 1)); + FOR block no FROM begin of dir UPTO end of main dir REP + load dir block (block no, last block); + UNTIL last block + PER. + +end of main dir: + begin of dir + number of dir sectors - 1. + +load subdirs if necessary: + TEXT VAR path := subdir path; + WHILE path <> "" REP + load next subdir if possible + PER. + +load next subdir if possible: + INT VAR cluster no; + get next subdir name; + get first cluster no of subdir table; + clear dir entrys (cluster no); + WHILE cluster no >= 0 REP + load subdir entrys of cluster; + cluster no := next fetch cluster no + UNTIL last block + PER. + +get next subdir name: + TEXT VAR subdir name; + IF (path SUB 1) <> "\" + THEN error stop ("ungltige Pfadbezeichnung") + FI; + INT VAR backslash pos := pos (path, "\", "\", 2); + IF backslash pos = 0 + THEN subdir name := subtext (path, 2); + path := "" + ELSE subdir name := subtext (path, 2, backslash pos - 1); + path := subtext (path, backslash pos) + FI; + subdir name := adapted name (subdir name, TRUE). + +get first cluster no of subdir table: + IF dir thes CONTAINS subdir name + THEN open fetch subdir (subdir name, cluster no); + ELSE error stop ("Subdirectory existiert nicht") + FI. + +load subdir entrys of cluster: + store end of dir (loc (last block no of cluster, dir entrys per block - 1)); + FOR block no FROM 0 UPTO (sectors per cluster - 1) REP + load dir block (first block no of cluster (cluster no) + block no, last block) + UNTIL last block + PER. + +last block no of cluster: + first block no of cluster (cluster no) + sectors per cluster - 1. + +END PROC enable open disk; + +PROC init dataspaces: + enable stop; + IF NOT initialized (this packet) + THEN dataspaces open := FALSE + FI; + IF NOT dataspaces open + THEN disable stop; + dataspaces open := TRUE; + fat space := nilspace; + dir ds := nilspace; + block ds := nilspace; + fat struct := fat space; + dir := dir ds; + block := block ds + FI. + +END PROC init dataspaces; + +PROC init dir struct (TEXT CONST path string, INT CONST root): + clear dir entrys (root); + dir.path := path string; + dir.disk label := "". + +END PROC init dir struct; + +PROC clear dir entrys (INT CONST root): + init file list; + init dir list; + init free list (root). + +init file list: + dir.file list.thes := empty thesaurus; + dir.file list.no of entrys := 0. + +init dir list: + dir.dir list.thes := empty thesaurus; + dir.dir list.no of entrys := 0. + +END PROC clear dir entrys; + +PROC close disk: + enable stop; + IF NOT initialized (this packet) + THEN dataspaces open := FALSE + FI; + IF dataspaces open + THEN forget (dir ds); + forget (block ds); + forget (fat space); + dataspaces open := FALSE + FI. + +END PROC close disk; + +(*COND FLOPPY +PROC format disk: + enable stop; + init dataspaces; + format fat; + format dir. + +format fat: + write first four fat bytes; + write other fat bytes; + define write access table (TRUE); + copy fat to disk. + +write first four fat bytes: + fat [1] := word (first fat byte, 255); + fat [2] := word (255, 0). + +write other fat bytes: + FOR count FROM 3 UPTO fat length REP + fat [count] := 0 + PER. + +fat length: + INT VAR len := number of fat entrys + number of fat entrys DIV 2 + + number of fat entrys MOD 2; + len DIV 2 + len MOD 2. + +format dir: + init dir struct ("", -1); + store begin of free area (loc (begin of dir, 0)); + store end of dir (loc (end of dir, dir entrys per block - 1)); + FOR count FROM 0 UPTO dir entrys per block - 1 REP + write text 32 (block, ""0"" + 31 * ""246"", count) + PER; + disable stop; + FOR count FROM begin of dir UPTO end of dir REP + write disk block (block ds, count); + PER. + +end of dir: + begin of dir + number of dir sectors - 1. + +END PROC format disk; +ENDCOND*) + +(*COND HDU*) +PROC disk clear: + error stop ("nicht implementiert") + +END PROC disk clear; + +PROC format disk: + error stop ("nicht implementiert") + +END PROC format disk; +(*ENDCOND*) + +INT PROC word (INT CONST low byte, high byte): + convert buffer := code (low byte) + code (high byte); + convert buffer ISUB 1. + +END PROC word; + +BOOL PROC disk changed: +(*COND FLOPPY + disable stop; + NOT first fat block ok COR is error (* must be COR *) +ENDCOND*) +(*COND HDU*) + FALSE +(*ENDCOND*) + +END PROC disk changed; + +BOOL PROC first fat block ok: + enable stop; + read fat block (0, TRUE); + FOR count FROM 1 UPTO 256 REP + compare word + PER; + TRUE. + +compare word: + IF fat struct.fat row [count] <> fat struct.block row [count] + THEN LEAVE first fat block ok WITH FALSE + FI. + +END PROC first fat block ok; + +PROC open fetch (TEXT CONST name, REAL VAR size, INT VAR first cluster no): + enable stop; + first cluster no := dir.file list.entry [link index].first cluster; + size := dir.file list.entry [link index].size; + IF first cluster no >= 4088 + THEN first cluster no := -1 + FI; + akt file cluster no := first cluster no. + +link index: + link (file thes, name). + +END PROC open fetch; + +PROC open fetch subdir (TEXT CONST subdir name, INT VAR first cluster no): + first cluster no := dir.dir list.entry [link index]; + IF first cluster no >= 4088 + THEN first cluster no := -1 + FI; + akt file cluster no := first cluster no. + +link index: + link (dir thes, subdir name). + +END PROC open fetch subdir; + +INT PROC next fetch cluster no: + enable stop; + akt file cluster no := fat entry (akt file cluster no); + IF akt file cluster no < 4088 (*ff8h *) + THEN akt file cluster no + ELSE -1 + FI. + +END PROC next fetch cluster no; + +PROC open save (TEXT CONST file name): + enable stop; + save name := file name; + IF dir full + THEN error stop ("Directory voll") + FI; + IF dir thes CONTAINS file name + THEN error stop ("Subdirectory mit gleichem Namen existiert bereits") + FI; + IF file thes CONTAINS file name + THEN error stop ("Datei mit gleichem Namen existiert bereits") + FI; + no cluster saved := TRUE. + +END PROC open save; + +INT PROC next save cluster no: + enable stop; + IF no cluster saved + THEN akt file cluster no := available fat entry; + first file cluster no := akt file cluster no; + no cluster saved := FALSE + ELSE INT VAR old cluster no := akt file cluster no; + akt file cluster no := available fat entry; + write fat entry (old cluster no, akt file cluster no) + FI; + write fat entry (akt file cluster no, last entry of fat chain); + akt file cluster no. + +END PROC next save cluster no; + +PROC close save (REAL CONST size): + enable stop; + IF no cluster saved + THEN insert dir entry (save name, 4088, 0.0) + ELSE copy fat to disk; + insert dir entry (save name, first file cluster no, size) + FI. + +END PROC close save; + +PROC erase table entrys (TEXT CONST name): + enable stop; + INT VAR first file cluster := first cluster; + delete dir entry (name); + erase fat chain (first file cluster); + copy fat to disk. + +first cluster: + dir.file list.entry [link index].first cluster. + +link index: + link (file thes, name). + +END PROC erase table entrys; + +INT PROC fat entry (INT CONST entry no): + fix bytes; + construct value. + +fix bytes: + INT VAR first byte no := entry no + entry no DIV 2. + +construct value: + IF entry no MOD 2 = 0 + THEN (right byte MOD 16) * 256 + left byte + ELSE right byte * 16 + left byte DIV 16 + FI. + +left byte: + fat byte (first byte no). + +right byte: + fat byte (first byte no + 1). + +END PROC fat entry; + +INT PROC available fat entry: + FOR count FROM first possible available fat entry UPTO number of fat entrys - 1 REP + IF is available entry (count) + THEN first possible available fat entry := count; + LEAVE available fat entry WITH count + FI; + PER; + close action; error stop ("MS-DOS Datentraeger voll"); maxint. + +END PROC available fat entry; + +BOOL PROC is available entry (INT CONST entry no): + is zero entry. + +is zero entry: + IF entry no MOD 2 = 0 + THEN (left byte = 0) CAND ((right byte MOD 16) = 0) + ELSE (right byte = 0) CAND ((left byte DIV 16) = 0) + FI. + +left byte: + fat byte (first byte no). + +right byte: + fat byte (first byte no + 1). + +first byte no: + entry no + entry no DIV 2. + +END PROC is available entry; + +PROC erase fat chain (INT CONST first entry): + INT VAR akt entry no := first entry, + entry := fat entry (akt entry no); + WHILE akt entry no not last chain entry no REP + erase akt entry; + akt entry no := entry; + entry := fat entry (akt entry no) + PER; + erase akt entry. + +akt entry no not last chain entry no: + (entry < last entry of fat chain) AND (entry > 1). + +erase akt entry: + write fat entry (akt entry no, 0). + +END PROC erase fat chain; + +PROC write fat entry (INT CONST entry no, value): + fix bytes; + remark write access (fat block of first byte); + remark write access (fat block of second byte); + write value; + update first possible available entry. + +fix bytes: + INT VAR first byte no := entry no + entry no DIV 2. + +fat block of first byte: + first byte no DIV 512. + +fat block of second byte: + second byte no DIV 512. + +write value: + IF even entry no + THEN write fat byte (first byte no, value MOD 256); + write fat byte (second byte no, + (right byte DIV 16) * 16 + value DIV 256) + ELSE write fat byte (first byte no, + (left byte MOD 16) + 16 * (value MOD 16)); + write fat byte (second byte no, value DIV 16) + FI. + +even entry no: + entry no MOD 2 = 0. + +second byte no: + first byte no + 1. + +left byte: + fat byte (first byte no). + +right byte: + fat byte (second byte no). + +update first possible available entry: + IF value = 0 + THEN first possible available fat entry := + min (first possible available fat entry, entry no) + FI. + +END PROC write fat entry; + +INT PROC fat byte (INT CONST no): + replace (convert buffer, 1, word); + IF even byte no + THEN code (convert buffer SUB 1) + ELSE code (convert buffer SUB 2) + FI. + +even byte no: + no MOD 2 = 0. + +word: + fat [no DIV 2 + 1]. + +END PROC fat byte; + +PROC write fat byte (INT CONST byte no, new value): + read old word; + change byte; + write new word. + +read old word: + replace (convert buffer, 1, word). + +write new word: + word := convert buffer ISUB 1. + +word: + fat [byte no DIV 2 + 1]. + +change byte: + replace (convert buffer, byte pos, code (new value)). + +byte pos: + byte no MOD 2 + 1. + +END PROC write fat byte; + +PROC copy fat to disk: + INT VAR block no; + FOR block no FROM 0 UPTO number of fat sectors - 1 REP + IF was write access (block no) + THEN write fat block (block no) + FI + PER. + +END PROC copy fat to disk; + +PROC write fat block (INT CONST fat block no): + INT VAR fat copy no; + INT VAR return code; + disable stop; + FOR fat copy no FROM 0 UPTO number of fat copies -1 REP + write disk block (fat space, ds page no, block no, return code); + IF return code > 0 + THEN close action + FI + PER; + remark no write access (block no); + enable stop. + +ds page no: + first non dummy ds page + fat block no + 1. + +block no: + begin of fat (fat copy no) + fat block no. + +END PROC write fat block; + +PROC read fat block (INT CONST fat block, BOOL CONST test block): + INT VAR fat copy no; + disable stop; + FOR fat copy no FROM 0 UPTO number of fat copies - 1 REP + clear error; + read disk block (fat space, ds page no, fat block no) + UNTIL NOT is error + PER; + IF is error + THEN close action + FI; + enable stop. + +ds page no: + IF test block + THEN first non dummy ds page + ELSE fat block + first non dummy ds page + 1 + FI. + +fat block no: + begin of fat (fat copy no) + fat block. + +END PROC read fat block; + +PROC define write access table (BOOL CONST status): + FOR count FROM 1 UPTO number of fat sectors REP + write access [count] := status + PER. + +END PROC define write access table; + +PROC remark write access (INT CONST fat block no): + write access [fat block no + 1] := TRUE + +END PROC remark write access; + +PROC remark no write access (INT CONST fat block no): + write access [fat block no + 1] := FALSE + +END PROC remark no write access; + +BOOL PROC was write access (INT CONST fat block no): + write access [fat block no + 1] + +END PROC was write access; + +(*COND TEST +PROC dump fat: + IF NOT exists ("fat dump") + THEN open file + FI; + DATASPACE VAR ds := nilspace; + FILE VAR in := sequential file (input, "fat dump"), + out := sequential file (output, ds); + INT VAR i; + TEXT VAR line; + FOR i FROM 0 UPTO number of fat entrys - 1 REP + dump fat entry + PER; + forget ("fat dump", quiet); + copy (ds, "fat dump"); + forget (ds). + +open file: + in := sequential file (output, "fat dump"); + FOR i FROM 0 UPTO number of fat entrys - 1 REP + putline (in, text (i, 4) + ": ") + PER. + +dump fat entry: + cout (i); + getline (in, line); + putline (out, line + " " + text (fat entry (i), 4)). + +END PROC dump fat; +ENDCOND*) + +PROC load dir block (INT CONST block no, BOOL VAR last block): + last block := FALSE; + INT VAR return code; + read disk block (block ds, first non dummy ds page, block no, return code); + IF return code > 0 + THEN close action; + io error (return code) + FI; + INT VAR entry no, + thes index; + FOR entry no FROM 0 UPTO dir entrys per block - 1 REP + dir entry := text 32 (block, entry no); + process entry + PER. + +process entry: + SELECT pos (""0"."229"", dir entry SUB 1) OF + CASE 1: end of dir search + CASE 2: main dir entry + CASE 3: free entry + OTHERWISE file entry + END SELECT. + +end of dir search: + last block := TRUE; + store begin of free area (loc (block no, entry no)); + LEAVE load dir block. + +main dir entry: + (* no operation *). + +free entry: + store in free list (loc (block no, entry no)). + +file entry: + SELECT code (dir entry SUB 12) OF + CASE 8: volume label + CASE 16: sub dir entry + OTHERWISE dos file entry + END SELECT. + +volume label: + dir.disk label := text (dir entry, 1, 11). + +sub dir entry: + dir.dir list.no of entrys INCR 1; + insert (dir thes, name, thes index); + dir list entry := first cluster no. + +dos file entry: + IF dir.file list.no of entrys >= max dir entrys + THEN error stop ("Directorytabelle voll") + FI; + dir.file list.no of entrys INCR 1; + insert (file thes, name, thes index); + file list entry.first cluster := first cluster no; + file list entry.date and time := dos date + " " + dos time; + file list entry.size := dos storage; + file list entry.location.msdos block no := block no; + file list entry.location.block entry no := entry no. + +name: + IF name post <> "" + THEN name pre + "." + name post + ELSE name pre + FI. + +name pre: + compress (subtext (dir entry, 1, 8)). + +name post: + compress (subtext (dir entry, 9, 11)). + +file list entry: + dir.file list.entry [thes index]. + +dir list entry: + dir.dir list.entry [thes index]. + +first cluster no: + code (dir entry SUB 27) + 256 * code (dir entry SUB 28). + +dos storage: + real (code (dir entry SUB 29)) + + real (code (dir entry SUB 30)) * 256.0 + + real (code (dir entry SUB 31)) * 65536.0 + + real (code (dir entry SUB 32)) * 16777216.0. + +dos date: + day + "." + month + "." + year. + +day: + IF code (dir entry SUB 25) MOD 32 < 10 + THEN "0" + text (code (dir entry SUB 25) MOD 32) + ELSE text (code (dir entry SUB 25) MOD 32) + FI. + +month: + INT VAR dummy := code (dir entry SUB 25) DIV 32 + 8 * (code (dir entry SUB 26) MOD 2); + IF dummy < 10 + THEN "0" + text (dummy) + ELSE text (dummy) + FI. + +year: + text (80 + code (dir entry SUB 26) DIV 2, 2). + +dos time: + hour + ":" + minute. + +hour: + dummy := code (dir entry SUB 24) DIV 8; + IF dummy < 10 + THEN "0" + text (dummy) + ELSE text (dummy) + FI. + +minute: + dummy := code (dir entry SUB 23) DIV 32 + 8 * (code (dir entry SUB 24) MOD 8); + IF dummy < 10 + THEN "0" + text (dummy) + ELSE text (dummy) + FI. + +END PROC load dir block; + +PROC insert dir entry (TEXT CONST name, INT CONST start cluster, REAL CONST used storage): + (* name must be a dos name *) + LOCATION VAR ins pos := free location; + TEXT VAR akt date := date (clock (1)), + akt time := time of day (clock (1)); + write disk entry; + write dir struct entry. + +write disk entry: + INT VAR return code; + read disk block (block ds, first non dummy ds page, ins pos.msdos block no, return code); + IF return code > 0 + THEN close action; + io error (return code) + FI; + prepare name; + dir entry := name pre + name post + archive byte + (10 * ""0"") + dos time + + dos date + starting cluster + storage; + write text 32 (block, dir entry, ins pos.block entry no); + write disk block (block ds, first non dummy ds page,ins pos.msdos block no, return code); + IF return code > 0 + THEN close action; + io error (return code) + FI. + +prepare name: + TEXT VAR name pre, name post; + IF point pos > 0 + THEN name pre := subtext (name, 1, point pos - 1); + name post := subtext (name, point pos + 1); + name pre CAT (8 - LENGTH name pre) * " "; + name post CAT (3 - LENGTH name post) * " " + ELSE name pre := name + (8 - LENGTH name) * " "; + name post := " " + FI. + +point pos: + pos (name, "."). + +dos time: + code ((minute MOD 8) * 32) + code (8 * hour + minute DIV 8). + +hour: + int (subtext (akt time, 1, 2)). + +minute: + int (subtext (akt time, 4, 5)). + +dos date: + code (32 * (month MOD 8) + day) + code ((year - 80) * 2 + month DIV 8). + +day: + int (subtext (akt date, 1, 2)). + +month: + int (subtext (akt date, 4, 5)). + +year: + int (subtext (akt date, 7, 8)). + +starting cluster: + code (start cluster MOD 256) + code (start cluster DIV 256). + +storage: + code (int (round (256.0 * frac (used storage / 256.0), 0))) + + code (int (round (frac (floor (used storage / 256.0) / 256.0) * 256.0, 0))) + + code (int (floor (used storage / 65536.0))) + + code (0). (* maximal 16384 K *********************************) + +write dir struct entry: + INT VAR thes link; + insert (file thes, name, thes link); + file list entry.location := ins pos; + file list entry.first cluster := start cluster; + file list entry.date and time := akt date + " " + akt time; + file list entry.size := used storage. + +file list entry: + dir.filelist.entry [thes link]. + +END PROC insert dir entry; + +PROC delete dir entry (TEXT CONST name): + LOCATION VAR del pos; + get del pos; + erase dir struct entry; + erase disk entry; + store in free list (del pos). + +get del pos: + del pos := dir.filelist.entry [link index].location. + +link index: + link (file thes, name). + +erase dir struct entry: + INT VAR i; + delete (file thes, name, i). + +erase disk entry: + INT VAR return code; + read disk block (block ds, first non dummy ds page, del pos.msdos block no, return code); + IF return code > 0 + THEN close action; + io error (return code) + FI; + dir entry := text 32 (block, del pos.block entry no); + replace (dir entry, 1, ""229""); + write text 32 (block, dir entry, del pos.block entry no); + write disk block (block ds, first non dummy ds page, del pos.msdos block no, return code); + IF return code > 0 + THEN close action; + io error (return code) + FI. + +END PROC delete dir entry; + +. +file thes: + dir.filelist.thes. + +dir thes: + dir.dir list.thes. + +(*********************** dir information ******************************) + +THESAURUS PROC dir all: + file thes. + +END PROC dir all; + +BOOL PROC dir contains (TEXT CONST name): + file thes CONTAINS name + +END PROC dir contains; + +PROC dir list (DATASPACE VAR ds): + enable stop; + open list file; + list files; + list dirs; + write list head. + +open list file: + forget (ds); + ds := nilspace; + FILE VAR list file := sequential file (output, ds); + putline (list file, ""). + +list files: + INT VAR number := 0; + get (file thes, name, number); + WHILE number > 0 REP + generate file list line; + get (file thes, name, number) + PER. + +generate file list line: + write (list file, centered name); + write (list file, " "); + write (list file, text (act file entry.size, 11, 0)); + write (list file, " Bytes belegt "); + write (list file, act file entry.date and time); +(*COND TEST + write (list file, " +++ "); + write (list file, text (act file entry.first cluster)); +ENDCOND*) + line (list file). + +list dirs: + number := 0; + get (dir thes, name, number); + WHILE number > 0 REP + generate dir list line; + get (dir thes, name, number) + PER. + +generate dir list line: + write (list file, centered name); + write (list file, " "); +(*COND TEST + write (list file, " +++ "); + write (list file, text (dir.dir list.entry [number])); +ENDCOND*) + line (list file). + +centered name: + INT VAR point pos := pos (name, "."); + IF point pos > 0 + THEN name pre + "." + name post + ELSE text (name, 12) + FI. + +name pre: + text (subtext (name, 1, point pos - 1), 8). + +name post: + text (subtext (name, point pos + 1, point pos + 4), 3). + +act file entry: + dir.file list.entry [number]. + +write list head: + head line (list file, head). + +head: + "DOS" + disk label string + path string. + +disk label string: + IF dir.disk label <> "" + THEN ": " + dir.disk label + ELSE "" + FI. + +path string: + IF dir.path <> "" + THEN " PATH: " + dir.path + ELSE "" + FI. + +END PROC dir list; + +(************ free list handling ******************************************) +LOCATION PROC loc (INT CONST block, entry): + LOCATION : (block, entry) + +END PROC loc; + +BOOL OP > (LOCATION CONST l, r): + l.msdos block no > r.msdos block no + OR ((l.msdos block no = r.msdos block no) AND + (l.block entry no > r.block entry no) ) + +END OP >; + +OP INCR (LOCATION VAR l): + IF l.block entry no = dir entrys per block -1 + THEN l.block entry no := 0; + l.msdos block no INCR 1 + ELSE l.block entry no INCR 1 + FI. + +END OP INCR; + +PROC init free list (INT CONST dir root): + dir.freelist.stacktop := 0; + dir.freelist.begin of free area.msdos block no := maxint; + dir.freelist.end of dir.msdos block no := -1; + dir.freelist.dir chain root := dir root. + +END PROC init free list; + +BOOL PROC dir full: + stack empty AND free area empty AND NOT expansion alloweded. + +stack empty: + dir.freelist.stacktop < 1. + +free area empty: + dir.freelist.begin of free area > dir.freelist.end of dir. + +expansion alloweded: + dir.freelist.dir chain root >= 0. + +END PROC dir full; + +PROC store in free list (LOCATION CONST free): + dir.freelist.stacktop INCR 1; + dir.freelist.stack [top] := free. + +top: + dir.freelist.stacktop. + +END PROC store in free list; + +PROC store begin of free area (LOCATION CONST begin): + dir.freelist.begin of free area := begin + +END PROC store begin of free area; + +PROC store end of dir (LOCATION CONST end): + dir.freelist.end of dir := end + +END PROC store end of dir; + +LOCATION PROC free location: + LOCATION VAR result; + IF dir.freelist.stacktop > 0 + THEN pop + ELIF NOT free area empty + THEN first of free area + ELIF expansion alloweded + THEN allocate new dir space; + result := free location + ELSE error stop ("Directorytabelle voll") + FI; + result. + +pop: + result := dir.freelist.stack [top]; + top DECR 1. + +top: + dir.freelist.stack top. + +free area empty: + dir.freelist.begin of free area > dir.freelist.end of dir. + +first of free area: + result := dir.freelist.begin of free area; + INCR dir.freelist.begin of free area. + +expansion alloweded: + dir.freelist.dir chain root >= 0. + +END PROC free location; + +PROC allocate new dir space: + enable stop; + INT VAR new cluster no := available fat entry; + IF new cluster no < 0 + THEN error stop ("MS-DOS Datentraeger voll") + FI; + INT VAR last entry no; + search last entry of fat chain; + write fat entry (new cluster no, 4095); + write fat entry (last entry no, new cluster no); + copy fat to disk; + store begin of free area (loc (first new block, 0)); + store end of dir (loc (last new block, dir entrys per block - 1)); + init new dir cluster. + +search last entry of fat chain: + last entry no := dir.freelist.dir chain root; + WHILE fat entry (last entry no) < last entry of fat chain REP + last entry no := fat entry (last entry no) + PER. + +init new dir cluster: + FOR count FROM 0 UPTO dir entrys per block - 1 REP + write text 32 (block, ""0"" + 31 * ""246"", count) + PER; + disable stop; + FOR count FROM first new block UPTO last new block REP + write disk block (block ds, count); + PER. + +first new block: + firstblock no of cluster (new cluster no). + +last new block: + first block no of cluster (new cluster no) + sectors per cluster - 1. + +END PROC allocate new dir space; + +(*COND TEST +PROC dump freelist: + command dialogue (FALSE); + FILE VAR f := sequential file (output, "freelistdump"); + INT VAR i; + putline (f, "STACKTOP: " + text (fl.stacktop)); + putline (f, "STACK:"); + FOR i FROM 1 UPTO 16 * number of dir sectors REP + putline (f, " " + text (i, 4) + ": " + + text (fl.stack [i].msdos block no) + ", " + + text (fl.stack [i].block entry no)) + PER; + line (f); + putline (f, "BEGIN OF FREE: " + text (fl.begin of free area.msdos block no) + + ", " + text (fl.begin of free area.block entry no)); + putline (f, "END OF DIR: " + text (fl.end of dir.msdos block no) + + ", " + text (fl.end of dir.block entry no)). + +fl: + dir.freelist. + +END PROC dump free list; +ENDCOND*) + +END PACKET dos fat and dir; diff --git a/system/dos/1986/src/fetch b/system/dos/1986/src/fetch new file mode 100644 index 0000000..ad00ab6 --- /dev/null +++ b/system/dos/1986/src/fetch @@ -0,0 +1,333 @@ +PACKET fetch DEFINES (* Copyright (C) 1985 *) + (* Frank Klapper *) + (* 07.05.86 *) + fetch filemode, + fetch rowtextmode, + fetch dsmode, + check file: + +LET ascii = 1, + ascii german = 2, + transparent = 3, + ebcdic = 4, + atari st = 10; + +LET row text mode length = 4000, + row text type = 1000, + + ctrl z = ""26"", + tab = ""9"", + page cmd = "#page#"; + +CLUSTER VAR cluster; + +DATASPACE VAR cluster space; + +BOUND STRUCT (INT size, + ROW row text mode length TEXT cluster row) VAR cluster struct; + +INT VAR next cluster no; +REAL VAR file rest; + +FILE VAR file; + +PROC fetch filemode (DATASPACE VAR file space, + TEXT CONST name, INT CONST code type): + disable stop; + cluster space := nilspace; + cluster := cluster space; + enabled fetch filemode (file space, name, code type); + forget (cluster space). + +END PROC fetch filemode; + +PROC enabled fetch filemode (DATASPACE VAR file space, + TEXT CONST name, + INT CONST code type): + enable stop; + initialize fetch filemode; + open fetch (name, file rest, next cluster no); + WHILE (next cluster no >= 0) AND (file rest > 0.0) REP + get text of act cluster; + write lines; +(***************************************) + IF lines (file) > 3950 + THEN putline (file, ">>> FREMDDATEI FUER EUMEL ZU LANG. ES KNNEN DATEN FEHLEN <<<"); + LEAVE enabled fetch filemode + FI; +(***************************************) + PER; + write last line if necessary. + +initialize fetch filemode: + REAL VAR real cluster size := real (cluster size); + TEXT VAR buffer := ""; + forget (file space); + file space := nilspace; + file := sequential file (output, file space); + init cr lf ff const. + +init cr lf ff const: + TEXT VAR cr, lf, ff; + SELECT codetype OF + CASE ascii, ascii german, atari st: cr := ""13""; lf := ""10""; ff := ""12"" + CASE transparent: cr := ""13""; lf := ""10""; ff := ""12"" + CASE ebcdic: cr := ""13""; lf := "%"; ff := ""12"" + END SELECT; + TEXT CONST select buffer := cr + lf + ff; + TEXT CONST min line end char := code (min (code (cr), min (code (lf), code (ff)))), + max line end char := code (max (code (cr), max (code (lf), code (ff)))). + +get text of act cluster: + fetch next cluster (cluster space, first non dummy ds page); + buffer CAT text (cluster, 1, valid buffer length); + file rest DECR real cluster size; + IF seven bit code + THEN cancel bit 8 + FI; + IF ctrl z end + THEN test ctrl z + FI; + INT CONST bufferlength := LENGTH buffer. + +ctrl z end: + (code type = ascii) OR (code type = ascii german). + +seven bit code: + code type = ascii OR code type = ascii german. + +valid buffer length: + int (min (file rest, real cluster size)). + +cancel bit 8: + INT VAR set pos := pos (buffer, "", ""255"", 1); + WHILE set pos > 0 REP + replace (buffer, set pos, seven bit char); + set pos := pos (buffer, "", ""255"", set pos + 1) + PER. + +seven bit char: + code (code (buffer SUB set pos) AND 127). + +test ctrl z: + IF pos (buffer, ctrl z) > 0 + THEN file rest := 0.0; + buffer := subtext (buffer, 1, pos (buffer, ctrl z) - 1) + FI. + +write lines: + INT VAR begin pos := 1, end pos; + next cr lf ff pos; + WHILE end pos > 0 REP + execute char and get new pos pointer; + next cr lf ff pos + PER; + compress buffer. + +next cr lf ff pos: + end pos := pos (buffer, min line end char, max line end char, begin pos); + WHILE no line end char REP + end pos := pos (buffer, min line end char, max line end char, end pos + 1) + PER. + +no line end char: + (end pos > 0) AND (pos (select buffer, buffer SUB end pos) = 0). + +compress buffer: + buffer := subtext (buffer, begin pos). + +execute char and get new pos pointer: + SELECT pos (select buffer, buffer SUB end pos) OF + CASE 1: execute cr + CASE 2: execute lf + CASE 3: execute ff + END SELECT. + +execute cr: + IF (end pos = bufferlength) AND (file rest > 0.0) + THEN compress buffer; + LEAVE write lines + FI; + write line (subtext (buffer, begin pos, end pos - 1), code type); + IF (buffer SUB (end pos + 1)) = lf + THEN begin pos := end pos + 2 + ELSE begin pos := end pos + 1 + FI. + +execute ff: + write line (subtext (buffer, begin pos, end pos - 1), code type); + putline (file, page cmd); + begin pos := end pos + 1. + +execute lf: + IF (end pos = bufferlength) AND (file rest > 0.0) + THEN compress buffer; + LEAVE write lines + FI; + write line (subtext (buffer, begin pos, end pos - 1), code type); + IF (buffer SUB (end pos + 1)) = cr + THEN begin pos := end pos + 2 + ELSE begin pos := end pos + 1 + FI. + +write last line if necessary: + IF buffer <> "" + THEN end pos := LENGTH buffer + 1; + write line (subtext (buffer, begin pos, end pos - 1), code type) + FI. + +END PROC enabled fetch filemode; + +PROC write line (TEXT CONST line, INT CONST code type): + TEXT VAR result; + SELECT code type OF + CASE ascii: ascii conversion + CASE ascii german: ascii german conversion + CASE atari st: atari st conversion + CASE transparent: putline (file, line) + CASE ebcdic: ebcdic conversion + END SELECT. + +ascii conversion: + expand tabs; + replace steuerzeichen; + putline (file, result). + +ascii german conversion: + expand tabs; + replace steuerzeichen; + replace ascii german umlaute; + putline (file, result). + +atari st conversion: + expand tabs; + replace steuerzeichen; + replace atari st umlaute; + putline (file, result). + +replace ascii german umlaute: + change all (result, "[", ""); + change all (result, "\", ""); + change all (result, "]", ""); + change all (result, "{", ""); + change all (result, "|", ""); + change all (result, "}", ""); + change all (result, "~", ""). + +replace atari st umlaute: + change all (result, ""142"", ""); + change all (result, ""153"", ""); + change all (result, ""154"", ""); + change all (result, ""132"", ""); + change all (result, ""148"", ""); + change all (result, ""129"", ""); + change all (result, ""158"", ""). + +expand tabs: + result := line; + INT VAR tab pos := pos (result, tab); + WHILE tab pos > 0 REP + expand tab; + tab pos := pos (result, tab) + PER. + +expand tab: + result := subtext (result, 1, tab pos - 1) + (8 - ((tab pos - 1)) MOD 8) * " " + + subtext (result, tab pos + 1). + +replace steuerzeichen: + INT VAR position := pos (result, ""0"", ""31"", 1); + WHILE position > 0 REP + TEXT VAR char := result SUB position; + change all (result, char, "#" + int code + "#"); + position := pos (result, ""0"", ""31"", position) + PER. + +ebcdic conversion: + result := line; + ebcdic to eumel with substitution (result); + putline (file, result). + +int code: + (3 - LENGTH text (code (char))) * "0" + text (code (char)). + +END PROC write line; + +PROC fetch rowtextmode (DATASPACE VAR file space, + TEXT CONST name): + disable stop; + cluster space := nilspace; + cluster := cluster space; + enabled fetch rowtextmode (file space, name); + forget (cluster space). + +END PROC fetch rowtextmode; + +PROC enabled fetch rowtextmode (DATASPACE VAR file space, + TEXT CONST name): + enable stop; + open fetch (name, file rest, next cluster no); + initialize fetch rowtext mode; + WHILE next cluster no >= 0 REP + fetch next cluster (cluster space, first non dummy ds page); + cluster struct.size INCR 1; + IF file rest < real cluster size + THEN cluster struct.cluster row [cluster struct.size] + := text (cluster, 1, int (file rest)); + file rest := 0.0 + ELSE cluster struct.cluster row [cluster struct.size] := text (cluster, 1, cluster size); + file rest DECR real cluster size + FI + PER. + +initialize fetch row text mode: + forget (file space); + file space := nilspace; + cluster struct := file space; + type (file space, row text type); + REAL VAR real cluster size := real (cluster size); + cluster struct.size := 0. + +END PROC enabled fetch rowtext mode; + +PROC fetch ds mode (DATASPACE VAR ds, TEXT CONST name): + enable stop; + open fetch (name, file rest, next cluster no); + init fetch dsmode; + WHILE next cluster no >= 0 REP + fetch next cluster (ds, ds block no); + ds block no INCR sectors per cluster; + PER. + +init fetch dsmode: + forget (ds); + ds := nilspace; + INT VAR ds block no := 2. + +END PROC fetch ds mode; + +PROC check file (TEXT CONST name): + disable stop; + cluster space := nilspace; + cluster := cluster space; + enabled check file (name); + forget (cluster space). + +END PROC check file; + +PROC enabled check file (TEXT CONST name): + enable stop; + open fetch (name, file rest, next cluster no); + WHILE next cluster no >= 0 REP + fetch next cluster (cluster space, first non dummy ds page) + PER. + +END PROC enabled check file; + +PROC fetch next cluster (DATASPACE VAR fetch space, INT CONST first page): + read disk cluster (fetch space, first page, next cluster no); + next cluster no := next fetch cluster no. + +END PROC fetch next cluster; + +END PACKET fetch; diff --git a/system/dos/1986/src/files.dos b/system/dos/1986/src/files.dos new file mode 100644 index 0000000..0dd792f --- /dev/null +++ b/system/dos/1986/src/files.dos @@ -0,0 +1,23 @@ +eumel-ebcdic + sub +open +block i/o +cluster +name conversion +eu disk descriptor.fd +disk descriptor.dos.fd +fat and dir.dos.fd +eu disk descriptor.hd +disk descriptor.dos.hd +fat and dir.dos.hd +fetch +save +disk manager +manager/M.dos.fd +manager/M.dos.hd +table thes.dos +252 +253 +254 +255 +shard interface + diff --git a/system/dos/1986/src/gen.dos b/system/dos/1986/src/gen.dos new file mode 100644 index 0000000..5493272 --- /dev/null +++ b/system/dos/1986/src/gen.dos @@ -0,0 +1,99 @@ +(* 28.02.88, DOS Inserter HD/FD *) +TASK VAR fd, hd ; +IF NOT exists ("files.dos") THEN fetch ("files.dos", archive) FI ; +IF highest entry (ALL "files.dos" - all) > 0 + THEN fetch (ALL "files.dos" - all, archive) ; +FI ; +forget ("files.dos", quiet) ; +forget ("gen.dos", quiet) ; +release (archive) ; +ins ("eumel-ebcdic + sub") ; +ins ("open") ; +ins ("name conversion") ; +begin ("FD", PROC fd start, fd) ; +begin ("HD", PROC hd start, hd) ; +globalmanager ; + +PROC ins (TEXT CONST name) : + insert (name) ; + forget (name, quiet) +ENDPROC ins ; + +PROC hd start : + command dialogue (FALSE) ; + + fetch ("eu disk descriptor.hd") ; + erase ("eu disk descriptor.hd") ; + fetch ("disk descriptor.dos.hd") ; + erase ("disk descriptor.dos.hd") ; + fetch ("cluster") ; + fetch ("block i/o") ; + fetch ("fat and dir.dos.hd") ; + erase ("fat and dir.dos.hd") ; + fetch ("fetch") ; + fetch ("save") ; + fetch ("disk manager") ; + fetch ("manager/M.dos.hd") ; + erase ("manager/M.dos.hd") ; (* fetch beendet signalieren *) + + IF NOT exists ("manager/M.dos.fd", father) (* FD auch fertig ? *) + THEN erase ("block i/o") ; + erase ("cluster") ; + erase ("fetch") ; + erase ("save") ; + erase ("disk manager") + FI ; + + ins ("eu disk descriptor.hd") ; + ins ("disk descriptor.dos.hd") ; + ins ("cluster") ; + ins ("block i/o") ; + ins ("fat and dir.dos.hd") ; + ins ("fetch") ; + ins ("save") ; + ins ("disk manager") ; + ins ("manager/M.dos.hd") ; + do ("dos manager") +ENDPROC hd start ; + +PROC fd start : + disablestop ; + command dialogue (FALSE) ; + fetch ("table thes.dos") ; + erase ("table thes.dos") ; + fetch (ALL "table thes.dos") ; + erase (ALL "table thes.dos") ; + fetch ("eu disk descriptor.fd") ; + erase ("eu disk descriptor.fd") ; + fetch ("disk descriptor.dos.fd") ; + erase ("disk descriptor.dos.fd") ; + fetch ("cluster") ; + fetch ("block i/o") ; + fetch ("fat and dir.dos.fd") ; + erase ("fat and dir.dos.fd") ; + fetch ("fetch") ; + fetch ("save") ; + fetch ("disk manager") ; + fetch ("manager/M.dos.fd") ; + erase ("manager/M.dos.fd") ; (* fetch beendet signalieren *) + + IF NOT exists ("manager/M.dos.hd", father) (* HD auch fertig ? *) + THEN erase ("block i/o") ; + erase ("cluster") ; + erase ("fetch") ; + erase ("save") ; + erase ("disk manager") + FI ; + + ins ("eu disk descriptor.fd") ; + ins ("disk descriptor.dos.fd") ; + ins ("cluster") ; + ins ("block i/o") ; + ins ("fat and dir.dos.fd") ; + ins ("fetch") ; + ins ("save") ; + ins ("disk manager") ; + ins ("manager/M.dos.fd") ; + do ("dos manager") +ENDPROC fd start ; + diff --git a/system/dos/1986/src/manager-M.dos.fd b/system/dos/1986/src/manager-M.dos.fd new file mode 100644 index 0000000..601d521 --- /dev/null +++ b/system/dos/1986/src/manager-M.dos.fd @@ -0,0 +1,198 @@ +PACKET dos manager multi DEFINES (* Copyright (C) 1985 *) + (* Frank Klapper *) + provide channel, (* 25.03.86 *) + dos manager: + +LET std archive channel = 31, + + ack = 0, + second phase ack = 5, + false code = 6, + + fetch code = 11, + save code = 12, + exists code = 13, + erase code = 14, + list code = 15, + all code = 17, + clear code = 18, + reserve code = 19, + free code = 20, + check read code = 22, + + quote = """"; + +BOUND STRUCT (TEXT name, pass) VAR msg; + +TASK VAR order task; + +INT VAR dos channel; + +REAL VAR last access time := 0.0; + +TASK VAR disk owner := niltask; + +PROC provide channel (INT CONST channel): + dos channel := channel + +END PROC provide channel; + +(*COND FLOPPY*) +provide channel (std archive channel); +(*ENDCOND*) + +(*COND HDU +provide channel (29) +ENDCOND*) + +PROC dos manager: + dos manager (dos channel) + +END PROC dos manager; + +PROC dos manager (INT CONST channel): +(*COND FLOPPY*) + load shard interface table; +(*ENDCOND*) + dos channel := channel; + task password ("-"); + global manager + (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) dos manager) + +END PROC dos manager; + +PROC dos manager (DATASPACE VAR ds, INT CONST order code, phase, + TASK CONST from task): + enable stop; + order task := from task; + msg := ds; + IF NOT (order task = disk owner) AND + order code <> free code AND order code <> reserve code + THEN errorstop ("DOS nicht angemeldet") + FI; + SELECT order code OF + CASE fetch code : fetch file + CASE save code : save file + CASE erase code : erase file + CASE clear code : clear disk + CASE exists code : exists file + CASE list code : list disk + CASE all code : deliver directory + CASE reserve code : reserve + CASE free code : free + CASE check read code: check + OTHERWISE errorstop ("unbekannter Auftrag fr Task: " + name (myself)) + END SELECT. + +fetch file: + disk fetch (msg.name, ds); + manager ok (ds). + +check: + disk check (msg.name); + manager message (expanded name (msg.name, TRUE) + " ohne Fehler gelesen"). + +save file: + IF phase = 1 + THEN save first phase + ELSE save second phase + FI. + +save first phase: + BOOL VAR overwrite question; + disk save first phase (msg.name, overwrite question); + IF overwrite question + THEN manager question (expanded name (msg.name, FALSE) + " auf der MS-DOS Disk ueberschreiben") + ELSE send (order task, second phase ack, ds) + FI. + +save second phase: + disable stop; + disk save second phase (ds); + forget (ds) ; + ds := nilspace ; + enable stop; + manager ok (ds). + +clear disk: + IF NOT (from task = disk owner) + THEN error stop ("DOS nicht angemeldet") + FI; + IF phase = 1 + THEN manager question ("Diskette loeschen") + ELSE disk clear; + manager ok (ds) + FI. + +erase file: + IF disk exists (msg.name) + THEN IF phase = 1 + THEN manager question (expanded name (msg.name, TRUE) + " auf der MS-DOS Disk loeschen") + ELSE disk erase (msg.name); + manager ok (ds) + FI + ELSE manager message ("die Datei " + expanded name (msg.name, TRUE) + " gibt es nicht auf der MS-DOS Disk") + FI. + +exists file: + IF disk exists (msg.name) + THEN manager ok (ds) + ELSE send (order task, false code, ds) + FI. + +list disk: + disk list (ds); + manager ok (ds). + +deliver directory: + forget (ds); + ds := nilspace; + BOUND THESAURUS VAR all names := ds; + all names := disk all; + manager ok (ds). + +reserve: + IF reserve or free permitted + THEN do continue channel; + disk owner := from task; + disk reserve (msg.name); + manager ok (ds) + ELSE errorstop ("Archivlaufwerk wird von Task """+ name (disk owner) + """ benutzt") + FI. + +do continue channel: + IF channel <> dos channel + THEN continue channel (dos channel) + FI. + +reserve or free permitted : + from task = disk owner OR last access more than five minutes ago + OR disk owner = niltask OR NOT + (exists (disk owner) OR station(disk owner) <> station (myself)). + +last access more than five minutes ago : + abs (last access time - clock (1)) > 300.0. + +free: + IF reserve or free permitted + THEN disk free; + disk owner := niltask; + break (quiet); + manager ok (ds) + ELSE manager message ("DOS nicht angemeldet") + FI. + +END PROC dos manager; + +PROC manager ok (DATASPACE VAR ds): + send (order task, ack, ds); + last access time := clock (1). + +END PROC manager ok; + +TEXT PROC expanded name (TEXT CONST name, BOOL CONST status): + text (quote + adapted name (name, status) + quote, 14) + +END PROC expanded name; + +END PACKET dos manager multi; diff --git a/system/dos/1986/src/manager-M.dos.hd b/system/dos/1986/src/manager-M.dos.hd new file mode 100644 index 0000000..5eb97c7 --- /dev/null +++ b/system/dos/1986/src/manager-M.dos.hd @@ -0,0 +1,198 @@ +PACKET dos manager multi DEFINES (* Copyright (C) 1985 *) + (* Frank Klapper *) + provide channel, (* 25.03.86 *) + dos manager: + +LET std archive channel = 31, + + ack = 0, + second phase ack = 5, + false code = 6, + + fetch code = 11, + save code = 12, + exists code = 13, + erase code = 14, + list code = 15, + all code = 17, + clear code = 18, + reserve code = 19, + free code = 20, + check read code = 22, + + quote = """"; + +BOUND STRUCT (TEXT name, pass) VAR msg; + +TASK VAR order task; + +INT VAR dos channel; + +REAL VAR last access time := 0.0; + +TASK VAR disk owner := niltask; + +PROC provide channel (INT CONST channel): + dos channel := channel + +END PROC provide channel; + +(*COND FLOPPY +provide channel (std archive channel); +ENDCOND*) + +(*COND HDU*) +provide channel (29) +(*ENDCOND*) + +PROC dos manager: + dos manager (dos channel) + +END PROC dos manager; + +PROC dos manager (INT CONST channel): +(*COND FLOPPY + load shard interface table; +ENDCOND*) + dos channel := channel; + task password ("-"); + global manager + (PROC (DATASPACE VAR, INT CONST, INT CONST, TASK CONST) dos manager) + +END PROC dos manager; + +PROC dos manager (DATASPACE VAR ds, INT CONST order code, phase, + TASK CONST from task): + enable stop; + order task := from task; + msg := ds; + IF NOT (order task = disk owner) AND + order code <> free code AND order code <> reserve code + THEN errorstop ("DOS nicht angemeldet") + FI; + SELECT order code OF + CASE fetch code : fetch file + CASE save code : save file + CASE erase code : erase file + CASE clear code : clear disk + CASE exists code : exists file + CASE list code : list disk + CASE all code : deliver directory + CASE reserve code : reserve + CASE free code : free + CASE check read code: check + OTHERWISE errorstop ("unbekannter Auftrag fr Task: " + name (myself)) + END SELECT. + +fetch file: + disk fetch (msg.name, ds); + manager ok (ds). + +check: + disk check (msg.name); + manager message (expanded name (msg.name, TRUE) + " ohne Fehler gelesen"). + +save file: + IF phase = 1 + THEN save first phase + ELSE save second phase + FI. + +save first phase: + BOOL VAR overwrite question; + disk save first phase (msg.name, overwrite question); + IF overwrite question + THEN manager question (expanded name (msg.name, FALSE) + " auf der MS-DOS Disk ueberschreiben") + ELSE send (order task, second phase ack, ds) + FI. + +save second phase: + disable stop; + disk save second phase (ds); + forget (ds) ; + ds := nilspace ; + enable stop; + manager ok (ds). + +clear disk: + IF NOT (from task = disk owner) + THEN error stop ("DOS nicht angemeldet") + FI; + IF phase = 1 + THEN manager question ("Diskette loeschen") + ELSE disk clear; + manager ok (ds) + FI. + +erase file: + IF disk exists (msg.name) + THEN IF phase = 1 + THEN manager question (expanded name (msg.name, TRUE) + " auf der MS-DOS Disk loeschen") + ELSE disk erase (msg.name); + manager ok (ds) + FI + ELSE manager message ("die Datei " + expanded name (msg.name, TRUE) + " gibt es nicht auf der MS-DOS Disk") + FI. + +exists file: + IF disk exists (msg.name) + THEN manager ok (ds) + ELSE send (order task, false code, ds) + FI. + +list disk: + disk list (ds); + manager ok (ds). + +deliver directory: + forget (ds); + ds := nilspace; + BOUND THESAURUS VAR all names := ds; + all names := disk all; + manager ok (ds). + +reserve: + IF reserve or free permitted + THEN do continue channel; + disk owner := from task; + disk reserve (msg.name); + manager ok (ds) + ELSE errorstop ("Archivlaufwerk wird von Task """+ name (disk owner) + """ benutzt") + FI. + +do continue channel: + IF channel <> dos channel + THEN continue channel (dos channel) + FI. + +reserve or free permitted : + from task = disk owner OR last access more than five minutes ago + OR disk owner = niltask OR NOT + (exists (disk owner) OR station(disk owner) <> station (myself)). + +last access more than five minutes ago : + abs (last access time - clock (1)) > 300.0. + +free: + IF reserve or free permitted + THEN disk free; + disk owner := niltask; + break (quiet); + manager ok (ds) + ELSE manager message ("DOS nicht angemeldet") + FI. + +END PROC dos manager; + +PROC manager ok (DATASPACE VAR ds): + send (order task, ack, ds); + last access time := clock (1). + +END PROC manager ok; + +TEXT PROC expanded name (TEXT CONST name, BOOL CONST status): + text (quote + adapted name (name, status) + quote, 14) + +END PROC expanded name; + +END PACKET dos manager multi; diff --git a/system/dos/1986/src/name conversion b/system/dos/1986/src/name conversion new file mode 100644 index 0000000..1f9a797 --- /dev/null +++ b/system/dos/1986/src/name conversion @@ -0,0 +1,77 @@ +PACKET name conversion DEFINES (* Copyright (C) 1985 *) + (* Frank Klapper *) + adapted name: (* 20.02.86 *) + +LET upper case chars = "ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789$#&@!(){}", + lower case chars = "abcdefghijklmnopqrstuvwxyz"; + +TEXT VAR name pre, + name post, + new, + char; + +INT VAR point pos, + count; + +TEXT PROC adapted name (TEXT CONST eu name, BOOL CONST read modus): + enable stop; + point pos := pos (eu name, "."); + IF name extension exists + THEN changed name with extension + ELSE changed name without extension + FI. + +name extension exists: + point pos > 0. + +changed name with extension: + name pre := compress (subtext (eu name, 1, point pos - 1)); + name post := compress (subtext (eu name, point pos + 1)); + IF LENGTH name pre = 0 OR LENGTH name pre > 8 OR LENGTH name post > 3 + THEN error + FI; + IF LENGTH name post = 0 + THEN new name (name pre, read modus) + ELSE new name (name pre, read modus) + "." + + new name (name post, read modus) + FI. + +changed name without extension: + IF LENGTH eu name > 8 OR LENGTH euname < 1 + THEN error + FI; + new name (eu name, read modus). + +error: + errorstop ("Unzulssiger Name"). + +END PROC adapted name; + +TEXT PROC new name (TEXT CONST old name, BOOL CONST read modus): + new := ""; + FOR count FROM 1 UPTO LENGTH old name REP + convert char + PER; + new. + +convert char: + char := old name SUB count; + IF is lower case char + THEN new CAT (upper case chars SUB string pos) + ELIF is upper case char OR read modus + THEN new CAT char + ELSE error stop ("Unzulssiger Name") + FI. + +is lower case char: + pos (lower case chars, char) > 0. + +is upper case char: + pos (upper case chars, char) > 0. + +string pos: + pos (lower case chars, char). + +END PROC new name; + +END PACKET name conversion; diff --git a/system/dos/1986/src/open b/system/dos/1986/src/open new file mode 100644 index 0000000..92e81e9 --- /dev/null +++ b/system/dos/1986/src/open @@ -0,0 +1,51 @@ +PACKET open DEFINES (* Copyright (C) 1986 *) + (* Frank Klapper *) + open action, (* 20.03.86 *) + close action, + action opened, + action closed, + init check rerun, + check rerun: + +BOOL VAR open; +INT VAR old session; + +INITFLAG VAR packet := FALSE; + +PROC open action: + open := TRUE + +END PROC open action; + +PROC close action: + open := FALSE + +END PROC close action; + +BOOL PROC action opened: + IF NOT initialized (packet) + THEN close action + FI; + open + +END PROC action opened; + +BOOL PROC action closed: + NOT action opened + +END PROC action closed; + +PROC init check rerun: + old session := session + +END PROC init check rerun; + +PROC check rerun: + IF session <> old session + THEN close action; + error stop ("Diskettenzugriff im RERUN") + FI. + +END PROC check rerun; + +END PACKET open; diff --git a/system/dos/1986/src/save b/system/dos/1986/src/save new file mode 100644 index 0000000..89d1108 --- /dev/null +++ b/system/dos/1986/src/save @@ -0,0 +1,273 @@ +PACKET save DEFINES (* Copyright (C) 1985 *) + (* Frank Klapper *) + (* 07.05.86 *) + save filemode, + save rowtextmode, + save dsmode: + +LET ascii = 1, + ascii german = 2, + transparent = 3, + ebcdic = 4, + atari st = 10; + +LET ascii ctrl z = ""26""; + +LET row text mode length = 4000; + +CLUSTER VAR cluster; + +DATASPACE VAR cluster space; + +BOUND STRUCT (INT size, + ROW row text mode length TEXT cluster row) VAR cluster struct; + +REAL VAR storage; +TEXT VAR cr lf, ff; +TEXT VAR buffer; + +PROC save filemode (DATASPACE CONST file space, + TEXT CONST name, + INT CONST code type): + disable stop; + cluster space := nilspace; + cluster := cluster space; + enable save filemode (file space, name, code type); + buffer := ""; + forget (cluster space). + +END PROC save filemode; + +PROC enable save filemode (DATASPACE CONST file space, + TEXT CONST name, + INT CONST code type): + enable stop; + open save (name); + init save filemode; + INT VAR line no; + FOR line no FROM 1 UPTO lines (file) REP + to line (file, line no); + buffer cat file line; + WHILE LENGTH buffer >= cluster size REP + copy buffer to cluster; + write disk cluster (cluster space, first non dummy ds page, next save cluster no); + remember rest + PER + PER; + cat ctrl z if necessary; + write rest; + close save (storage). + +init save filemode: + storage := 0.0; + FILE VAR file := sequential file (modify, file space); + SELECT code type OF + CASE ascii, ascii german, atari st, transparent: cr lf := ""13""10""; ff := ""12"" + CASE ebcdic: cr lf := ""13"%"; ff := ""12"" + END SELECT; + buffer := "". + +buffer cat file line: + exec (PROC (TEXT CONST, INT CONST) cat adapted line, file, code type). + +copy buffer to cluster: + write text (cluster, buffer); + storage INCR real (min (cluster size, LENGTH buffer)). + +remember rest: + buffer := subtext (buffer, cluster size + 1). + +write rest: + WHILE buffer <> "" + REP copy buffer to cluster; + write disk cluster (cluster space, first non dummy ds page, next save cluster no); + remember rest + PER. + +cat ctrl z if necessary: + IF code type <> ebcdic + THEN buffer CAT ascii ctrl z + FI. + +END PROC enable save filemode; + +PROC cat adapted line (TEXT VAR line, INT CONST code type): + IF subtext (line, 1, 6) = "#page#" + THEN buffer CAT ff; + LEAVE cat adapted line + FI; + SELECT code type OF + CASE transparent: (* no operation *) + CASE ascii: change eumel print chars; ascii change + CASE ascii german: change eumel print chars; ascii german change + CASE atari st: change eumel print chars; atari st change + CASE ebcdic: change eumel print chars; eumel to ebcdic with substitution (line) + END SELECT; + buffer CAT line; + buffer CAT cr lf. + +change eumel print chars: + INT VAR char pos := pos (line, ""220"", ""223"", 1); + WHILE char pos > 0 REP + replace (line, char pos, std char); + char pos := pos (line, ""220"", ""223"", char pos + 1) + PER. + +std char: + SELECT code (line SUB char pos) OF + CASE 220: "k" + CASE 221: "-" + CASE 222: "#" + CASE 223: " " + OTHERWISE "" + END SELECT. + +ascii change: + change all (line, ""251"", "#251#"); + char pos := pos (line, "", "", 1); + WHILE char pos > 0 REP + line := subtext (line, 1, char pos - 1) + ersatzdarstellung + subtext (line, char pos + 1); + char pos := pos (line, "", "", char pos + 1) + PER. + +ascii german change: + char pos := pos (line, "[", "]", 1); + WHILE char pos > 0 REP + line := subtext (line, 1, char pos - 1) + ersatzdarstellung + subtext (line, char pos + 1); + char pos := pos (line, "[", "]", char pos + 1) + PER; + char pos := pos (line, "{", "}", 1); + WHILE char pos > 0 REP + line := subtext (line, 1, char pos - 1) + ersatzdarstellung + subtext (line, char pos + 1); + char pos := pos (line, "{", "}", char pos + 1) + PER; + change all (line, ""251"", "~"); + char pos := pos (line, "", "", 1); + WHILE char pos > 0 REP + replace (line, char pos, umlaut in ascii german); + char pos := pos (line, "", "", char pos + 1) + PER. + +atari st change: + change all (line, "", ""158""); + char pos := pos (line, "", "", 1); + WHILE char pos > 0 REP + replace (line, char pos, umlaut in atari st); + char pos := pos (line, "", "", char pos + 1) + PER. + +ersatzdarstellung: + TEXT VAR char code := text (code (line SUB char pos)); + "#" + (3 - LENGTH char code) * "0" + char code + "#". + +umlaut in ascii german: + SELECT code (line SUB char pos) OF + CASE 214: "[" + CASE 215: "\" + CASE 216: "]" + CASE 217: "{" + CASE 218: "|" + CASE 219: "}" + OTHERWISE "" + END SELECT. + +umlaut in atari st: + SELECT code (line SUB char pos) OF + CASE 214: ""142"" + CASE 215: ""153"" + CASE 216: ""154"" + CASE 217: ""132"" + CASE 218: ""148"" + CASE 219: ""129"" + OTHERWISE "" + END SELECT. + +END PROC cat adapted line; + +PROC save rowtextmode (DATASPACE CONST space, + TEXT CONST name): + disable stop; + cluster space := nilspace; + cluster := cluster space; + enable save rowtext mode (space, name); + forget (cluster space). + +END PROC save rowtextmode; + +PROC enable save rowtextmode (DATASPACE CONST space, + TEXT CONST name): + enable stop; + open save (name); + init save row textmode; + WHILE line no < cluster struct.size REP + fill buffer; + copy buffer to cluster; + write disk cluster (cluster space, first non dummy ds page, next save cluster no); + remember rest + PER; + write rest; + close save (storage). + +init save rowtextmode: + storage := 0.0; + cluster struct := space; + INT VAR line no := 0; + TEXT VAR buffer := "". + +fill buffer: + WHILE line no < cluster struct.size AND NOT buffer full REP + line no INCR 1; + buffer CAT cluster struct.cluster row [line no] + PER. + +buffer full: + LENGTH buffer >= cluster size. + +copy buffer to cluster: + write text (cluster, buffer); + storage INCR real (min (cluster size, LENGTH buffer)). + +remember rest: + buffer := subtext (buffer, cluster size + 1). + +write rest: + WHILE buffer <> "" + REP copy buffer to cluster; + write disk cluster (cluster space, first non dummy ds page, next save cluster no); + remember rest + PER. + +END PROC enable save rowtextmode; + +PROC save ds mode (DATASPACE CONST ds, + TEXT CONST name): + disable stop; + enable save ds mode (ds, name). + +END PROC save ds mode; + +PROC enable save ds mode (DATASPACE CONST ds, + TEXT CONST name): + enable stop; + open save (name); + INT VAR page no := first non dummy ds page; + get last allocated ds page; + WHILE page no <= last allocated ds page REP + write disk cluster (ds, page no, next save cluster no); + page no INCR sectors per cluster + PER; + close save (size). + +get last allocated ds page: + INT VAR last allocated ds page := -1, + i; + FOR i FROM 1 UPTO ds pages (ds) REP + last allocated ds page := next ds page (ds, last allocated ds page) + PER. + +size: + real (last allocated ds page - first non dummy ds page + 1) * 512.0. + +END PROC enable save ds mode; + +END PACKET save; diff --git a/system/dos/1986/src/shard interface b/system/dos/1986/src/shard interface new file mode 100644 index 0000000..67bf654 --- /dev/null +++ b/system/dos/1986/src/shard interface @@ -0,0 +1,19 @@ +; ';' in Spalte 1 kennzeichnet eine Kommentarzeile +; alle Werte mssen durch Blanks getrennt werden +; +;heads: Anzahl der Kpfe, positiv fr cylinderorientiertes Lesen +; negativ fr seitenorientiertes Lesen +; +;size heads tracks first sectors last sector +;===================================================== +320 1 40 1 8 +360 1 40 1 9 +640 -2 40 1 8 +720 -2 40 1 9 +800 2 40 1 10 +1440 -2 80 1 9 +1600 2 80 1 10 +2400 -2 80 1 15 +1232 1 77 0 15 +2464 -2 77 0 15 +; END OF FILE diff --git a/system/dos/1986/src/table thes.dos b/system/dos/1986/src/table thes.dos new file mode 100644 index 0000000..8b254cf --- /dev/null +++ b/system/dos/1986/src/table thes.dos @@ -0,0 +1,5 @@ +shard interface +252 +253 +254 +255 diff --git a/system/eumel0-z80/data/EUMEL0.DS b/system/eumel0-z80/data/EUMEL0.DS new file mode 100644 index 0000000..8b53d98 Binary files /dev/null and b/system/eumel0-z80/data/EUMEL0.DS differ diff --git a/system/eumel0-z80/src/DISEUMEL.ELA b/system/eumel0-z80/src/DISEUMEL.ELA new file mode 100644 index 0000000..b1039dc --- /dev/null +++ b/system/eumel0-z80/src/DISEUMEL.ELA @@ -0,0 +1,607 @@ +PROC arith 16 : + + EXTERNAL 92 + +ENDPROC arith 16 ; + +BOOL OP ULSEQ (INT CONST left, right) : + + (left MINUS right) <= 0 + +ENDOP ULSEQ ; + +LET max words minus 1 = 32767 ; (* = max : 64K *) + +TEXT VAR source name , instr, parameter , t ; +INT VAR addr , start addr, end addr , file nr , laenge, i , offset ; +FILE VAR source file ; + +BOUND STRUCT (ALIGN align, ROW max words minus 1 INT word) VAR space ; + +TEXT VAR a, b, c; +BOOL VAR screen mode := yes ("Bildschirmausgabe zusaetzlich") ; +put ("Startaddr:") ; +getline (a) ; +put ("Endaddr :") ; +getline (b) ; +put ("Offset :") ; +getline (c) ; +resource ("eumel0", "eumel0.prt", a, b, c) ; +edit ("eumel0.prt") ; + + +PROC resource (TEXT CONST code space name, source file name, + TEXT CONST from, to, offs) : + + space := old (code space name) ; + start addr := integer (from) ; + end addr := integer (to) ; + offset := integer (offs) ; + source name := source file name ; + file nr := 1 ; + forget (source name, quiet) ; + source file := sequential file (output, source name) ; + + source putline ("ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT") ; + put tabs (source file, 40 * ""2"" + "^") ; + addr := start addr ; + line ; + WHILE addr ULSEQ end addr REP + IF online THEN out (hex16 (addr)) ; + out (""13"") ; + FI ; + source put (hex16 (addr)) ; + disass ; + FOR i FROM 1 UPTO laenge REP + source put (hex8 (zugriff (addr PLUS (i-1)))) + PER ; + FOR i FROM laenge UPTO 3 REP + source put (" ") + PER ; + t := "" ; + FOR i FROM 1 UPTO laenge REP + t CAT ascii (zugriff (addr PLUS (i-1))) + PER ; + source put (t, 5) ; + source put (instr, 5) ; + source put (parameter, 10) ; + source line ; + addr := addr PLUS laenge ; + PER ; +ENDPROC resource ; + +INT OP PLUS (INT CONST left, right) : + arith16 ; + left + right +ENDOP PLUS ; + +INT OP MINUS (INT CONST left, right) : + arith16 ; + left - right +ENDOP MINUS ; + +PROC source line : + check file overflow ; + line (source file) ; + IF screen mode AND online THEN line FI +ENDPROC source line ; + +PROC source put (TEXT CONST text) : + put (source file, text) ; + IF screen mode AND online THEN put (text) FI +ENDPROC source put ; + +PROC source out (TEXT CONST text) : + write (source file, text) ; + IF screen mode AND online THEN write (text) FI +ENDPROC source out ; + +PROC source putline (TEXT CONST text) : + check file overflow ; + putline (source file, text) ; + IF screen mode AND online THEN putline (text) FI +ENDPROC source putline ; + +PROC source put (TEXT CONST text, INT CONST laenge) : + source put (text + (laenge - length (text)) * " ") ; +ENDPROC source put ; + +PROC check file overflow : + TEXT VAR new name ; + IF lines (source file) > 4000 THEN + file nr INCR 1 ; + new name := source name + "." + text (file nr) ; + line (source file) ; + putline (source file," - Fortsetzung in Datei """ + new name + """ -"); + IF screen mode AND online THEN putline ("New FILE:" + new name) FI ; + modify (source file) ; + to first record (source file) ; + forget (new name, quiet) ; + source file := sequentialfile (output, new name) ; + source putline ("ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT") ; + put tabs (source file, 40 * ""2"" + "^") + FI +ENDPROC check file overflow ; + +TEXT PROC hex16 (INT CONST nr) : + INT VAR i, var := nr ; + TEXT VAR result := "" ; + FOR i FROM 1 UPTO 4 REP + rotate (var, 4) ; + result CAT hex4 (var AND 15) + PER ; + result +ENDPROC hex16 ; + +TEXT PROC hex8 (INT CONST nr) : + hex4 (nr DIV 16) + hex4 (nr AND 15) +ENDPROC hex8 ; + +TEXT PROC hex4 (INT CONST nr) : + "0123456789ABCDEF" SUB (nr+1) +ENDPROC hex4 ; + +TEXT PROC ascii (INT CONST nr) : + IF nr < 32 OR nr > 126 THEN "." + ELSE code (nr) + FI +ENDPROC ascii ; + +INT PROC zugriff (INT CONST adr) : + TEXT VAR t := " " ; + INT VAR index := offset PLUS adr MINUS startaddr ; + rotate (index, -1) ; (* Signed DIV 2 *) + index := index AND maxint ; + BOOL CONST low byte :: ((adr MINUS start addr) AND 1) = 0 ; + replace (t, 1, space.word (index PLUS 1)) ; + IF low byte THEN code (t SUB 1) + ELSE code (t SUB 2) + FI +ENDPROC zugriff ; + +INT PROC integer (TEXT CONST hex addr) : + INT VAR i, summe := 0 ; + FOR i FROM 1 UPTO length (hex addr) REP + rotate (summe, 4) ; + summe INCR digit + PER ; + summe . + +digit : + TEXT CONST char := hex addr SUB i ; + IF char >= "a" THEN code (char) - 87 + ELIF char >= "A" THEN code (char) - 55 + ELSE code (char) - 48 + FI +ENDPROC integer ; + +INT VAR byte, + div 8, + and 7, + and f, + div 10, + int addr ; + +TEXT VAR index, c byte ; + +TEXT PROC arith log : + SELECT div 8 OF + CASE 0 : "ADD" + CASE 1 : "ADC" + CASE 2 : "SUB" + CASE 3 : "SBC" + CASE 4 : "AND" + CASE 5 : "XOR" + CASE 6 : "OR" + CASE 7 : "CP" + OTHERWISE "???" + ENDSELECT + +ENDPROC arith log; + +TEXT PROC reg1 : + SELECT div8 OF + CASE 0 : "B" + CASE 1 : "C" + CASE 2 : "D" + CASE 3 : "E" + CASE 4 : "H" + CASE 5 : "L" + CASE 6 : "(HL)" + CASE 7 : "A" + OTHERWISE "???" + ENDSELECT + +ENDPROC reg1; + +TEXT PROC reg2 : + SELECT and7 OF + CASE 0 : "B" + CASE 1 : "C" + CASE 2 : "D" + CASE 3 : "E" + CASE 4 : "H" + CASE 5 : "L" + CASE 6 : "(HL)" + CASE 7 : "A" + OTHERWISE "???" + ENDSELECT + +ENDPROC reg2; + +TEXT PROC rp: + SELECT div10 AND 3 OF + CASE 0 : "BC" + CASE 1 : "DE" + CASE 2 : "HL" + CASE 3 : IF byte > 127 THEN "AF" + ELSE "SP" FI + OTHERWISE "???" + ENDSELECT + +ENDPROC rp; + + +PROC bitmanipulation : + parameter := text (div8) + "," + reg2 ; + laenge := 2 ; + SELECT byte DIV 64 OF + CASE 1 : instr := "BIT" + CASE 2 : instr := "RES" + CASE 3 : instr := "SET" + OTHERWISE laenge := 1 ; + parameter := "" + ENDSELECT + +ENDPROC bitmanipulation; + + +PROC disass : + laenge := 1 ; + instr := "" ; + parameter := "" ; + int addr := addr ; + byte := zugriff (int addr) ; + c byte := code (byte) ; + and 7 := byte AND 7 ; + and f := byte AND 15 ; + div 10:= byte DIV 16 ; + div 8 := (byte DIV 8) AND 7 ; + IF is special instruction + THEN disass special instruction + ELIF div 10 < 4 + THEN lower case instruction + ELIF byte < 128 + THEN ld instruction + ELIF byte < 192 + THEN arith log instruction + ELSE higher case instruction + FI. + +is special instruction : + pos (special instruction codes, c byte) > 0 . + +special instruction codes : + ""0""2""7""8""10""15""16""18""23""24""26""31""32""34""39""40""42""47""48""50 + ""55""56""58""63""118""195""198""201""203""205""206""211""214""217""219 + ""221""222""227""230""233""235""237""238""243""246""249""251""253""254"". + +arith log instruction : + instr := arith log ; + parameter := reg 2 . + +ld instruction : + instr := "LD" ; + parameter := reg 1 + "," + reg 2 . + +condition code : + SELECT div8 OF + CASE 0 : "NZ" + CASE 1 : "Z" + CASE 2 : "NC" + CASE 3 : "C" + CASE 4 : "PO" + CASE 5 : "PE" + CASE 6 : "P" + CASE 7 : "M" + OTHERWISE "??" + ENDSELECT. + +lower case instruction : + IF and f = 1 THEN instr := "LD" ; + parameter := rp + "," + next word ; + laenge := 3 + ELIF and f = 3 THEN instr := "INC" ; + parameter := rp ; + ELIF and 7 = 4 THEN instr := "INC" ; + parameter := reg1 + ELIF and 7 = 5 THEN instr := "DEC" ; + parameter := reg1 + ELIF and 7 = 6 THEN instr := "LD" ; + parameter := reg1 + "," + next byte ; + laenge := 2 + ELIF and f = 9 THEN instr := "ADD" ; + parameter := "HL," + rp ; + ELIF and f =11 THEN instr := "DEC" ; + parameter := rp + FI. + +higher case instruction : + SELECT and 7 OF + CASE 0 : instr := "RET" ; + parameter := condition code + CASE 1 : instr := "POP" ; + parameter := rp + CASE 2 : instr := "JP" ; + parameter := condition code + "," + next word ; + laenge := 3 + CASE 4 : instr := "CALL" ; + parameter := condition code + "," + next word ; + laenge := 3 + CASE 5 : instr := "PUSH" ; + parameter := rp + CASE 7 : instr := "RST" ; + parameter := hex8 (8 * div 8) + ENDSELECT. + + +branchaddress : + hex16 (addr PLUS displacement) . + +displacement : + IF zugriff (int addr PLUS 1) < 128 + THEN zugriff (int addr PLUS 1) + 2 + ELSE zugriff (int addr PLUS 1) - 254 + FI. + +cb instructions : + byte := zugriff (addr PLUS 1) ; + and 7 := byte AND 7 ; + and f := byte AND 15 ; + div 10:= byte DIV 16 ; + div 8 := (byte DIV 8) AND 7 ; + laenge := 2 ; + parameter := reg 2 ; + IF byte < 64 THEN + SELECT div 8 OF + CASE 0 : instr := "RLC" + CASE 1 : instr := "RRC" + CASE 2 : instr := "RL" + CASE 3 : instr := "RR" + CASE 4 : instr := "SLA" + CASE 5 : instr := "SRA" + CASE 6 : instr := "" ; parameter := "" ; laenge := 1 + CASE 7 : instr := "SLR" + OTHERWISE laenge := 1 ; parameter := "" + ENDSELECT + ELSE + bitmanipulation + FI . + + +disass special instruction : + SELECT byte OF + CASE 0 : instr := "NOP" + CASE 2 : instr := "LD" ; parameter := "(BC),A" + CASE 7 : instr := "RLCA" + CASE 8 : instr := "EX" ; parameter := "AF,AF'" + CASE 10 : instr := "LD" ; parameter := "A,(BC)" + CASE 15 : instr := "RRCA" + CASE 16 : instr := "DJNZ" ; parameter := branchaddress ; laenge:=2 + CASE 18 : instr := "LD" ; parameter := "(DE),A" + CASE 23 : instr := "RLA" + CASE 24 : instr := "JR" ; parameter := branchaddress ; laenge:=2 + CASE 26 : instr := "LD" ; parameter := "A,(DE)" + CASE 31 : instr := "RRA" + CASE 32 : instr := "JR" ; parameter := "NZ," + branchaddress;laenge:=2 + CASE 34 : instr := "LD" ; parameter := "("+nextword+"),HL"; laenge:=3 + CASE 39 : instr := "DAA" + CASE 40 : instr := "JR" ; parameter := "Z," + branchaddress; laenge:=2 + CASE 42 : instr := "LD" ; parameter := "HL,("+nextword+")"; laenge:=3 + CASE 47 : instr := "CPL" + CASE 48 : instr := "JR" ; parameter := "NC," + branchaddress;laenge:=2 + CASE 50 : instr := "LD" ; parameter := "("+nextword+"),A"; laenge:=3 + CASE 55 : instr := "SCF" + CASE 56 : instr := "JR" ; parameter := "C," + branchaddress; laenge:=2 + CASE 58 : instr := "LD" ; parameter := "A,("+nextword+")"; laenge:=3 + CASE 63 : instr := "CCF" + CASE 118: instr := "HALT" + CASE 195: instr := "JP" ; parameter := next word ; laenge:=3 + CASE 198: instr := "ADD" ; parameter := "A,"+next byte; laenge:=2 + CASE 201: instr := "RET" + CASE 203: cb instructions + CASE 205: instr := "CALL" ; parameter := next word; laenge := 3 + CASE 206: instr := "ADC" ; parameter := "A," + next byte ; laenge := 2 + CASE 211: instr := "OUT" ; parameter := "("+next byte+"),A";laenge:=2 + CASE 214: instr := "SUB" ; parameter := "A,"+next byte;laenge := 2 + CASE 217: instr := "EXX" + CASE 219: instr := "IN" ; parameter := "A,(" + next byte+")";laenge := 2 + CASE 221: index := "IX"; dd and fd instructions + CASE 222: instr := "SBC" ; parameter := "A," + next byte ;laenge := 2 + CASE 227: instr := "EX"; parameter := "(SP),HL" + CASE 230: instr := "AND" ; parameter := next byte; laenge := 2 + CASE 233: instr := "JP" ; parameter := "(HL)" + CASE 235: instr := "EX" ; parameter := "DE,HL" + CASE 237: ed instructions + CASE 238: instr := "XOR" ; parameter := next byte ; laenge := 2 + CASE 243: instr := "DI" + CASE 246: instr := "OR" ; parameter := next byte ; laenge := 2 + CASE 249: instr := "LD" ; parameter := "SP,HL" + CASE 251: instr := "EI" + CASE 253: index := "IY"; dd and fd instructions + CASE 254: instr := "CP" ; parameter := next byte ; laenge := 2 + ENDSELECT. + +ENDPROC disass ; + +PROC dd and fd instructions : + laenge := 2 ; + int addr := addr PLUS 1 ; + byte := zugriff (int addr) ; + c byte := code (byte) ; + and 7 := byte AND 7 ; + and f := byte AND 15 ; + div 10:= byte DIV 16 ; + div 8 := (byte DIV 8) AND 7 ; + SELECT byte OF + CASE 33 : instr := "LD" ; parameter := index+","+next word;laenge:=4 + CASE 34 : instr := "LD" ; parameter:="("+next word+"),"+index;laenge:=4 + CASE 35 : instr := "INC" ; parameter := index + CASE 42 : instr := "LD" ; parameter:=index+",("+next word+")";laenge:=4 + CASE 43 : instr := "DEC" ; parameter := index + CASE 52 : instr := "INC";parameter:="("+index+"+"+nextbyte+")";laenge:=3 + CASE 53 : instr := "DEC";parameter:="("+index+"+"+nextbyte+")";laenge:=3; + CASE 54 : instr := "LD" ; parameter :="("+index+"+"+next byte+"),"+ + hex8(zugriff (addr PLUS 3));laenge := 4 + CASE 203: dd and fd cb instructions + CASE 225: instr := "POP" ; parameter := index + CASE 227: instr := "EX" ; parameter := "(SP)," + index + CASE 229: instr := "PUSH" ; parameter := index + CASE 233: instr := "JP" ; parameter := "(" + index + ")" + CASE 249: instr := "LD" ; parameter := "SP," + index + OTHERWISE calculated dd and fd instructions + ENDSELECT. + +calculated dd and fd instructions : + parameter := "(" + index + "+" + next byte + ")" ; + laenge := 3 ; + IF andf = 9 THEN instr := "ADD" ; parameter := index+","+rp;laenge:=2 + ELIF and7 = 6 AND div 10 > 3 AND div 10 < 8 + THEN instr := "LD" ; parameter := reg1 + "," + parameter + ELIF div 10 = 7 AND byte <> 118 + THEN instr := "LD" ; parameter CAT "," + reg2 + ELIF and7 = 6 AND div 10 > 7 AND div 10 < 12 + THEN instr := arith log + ELSE laenge := 1 ; + parameter := "" + FI. + +dd and fd cb instructions : + int addr := addr PLUS 3 ; + byte := zugriff (int addr) ; + c byte := code (byte) ; + and 7 := byte AND 7 ; + and f := byte AND 15 ; + div 10:= byte DIV 16 ; + div 8 := (byte DIV 8) AND 7 ; + IF byte < 64 AND and7 = 6 THEN + laenge := 4 ; + parameter := "("+index + "+" + hex8 (zugriff (addr PLUS 2)) + ")" ; + SELECT div 8 OF + CASE 0 : instr := "RLC" + CASE 1 : instr := "RRC" + CASE 2 : instr := "RL" + CASE 3 : instr := "RR" + CASE 4 : instr := "SLA" + CASE 5 : instr := "SRA" + CASE 7 : instr := "SRL" + OTHERWISE instr := "" ; parameter := "" ;laenge := 1 + ENDSELECT + ELIF and7 = 6 THEN laenge := 4 ; parameter := "(" + index + "+" + + hex8 (zugriff (addr PLUS 2)) + ")" ; + dd and fd bitmanipulation + ELSE laenge := 1 ; + parameter := "" + FI. + +dd and fd bitmanipulation : + parameter := text (div8) + "," + parameter ; + SELECT byte DIV 64 OF + CASE 1 : instr := "BIT" + CASE 2 : instr := "RES" + CASE 3 : instr := "SET" + OTHERWISE laenge := 1 ; + parameter := "" + ENDSELECT. + +ENDPROC dd and fd instructions ; + +PROC ed instructions : + int addr := addr PLUS 1 ; + byte := zugriff (int addr) ; + c byte := code (byte) ; + and 7 := byte AND 7 ; + and f := byte AND 15 ; + div 10:= byte DIV 16 ; + div 8 := (byte DIV 8) AND 7 ; + laenge := 2 ; + SELECT byte OF + CASE 52 : instr := "TST" ; parameter := "(HL)" + CASE 68 : instr := "NEG" + CASE 69 : instr := "RETN" + CASE 70 : instr := "IM" ; parameter := "0" + CASE 71 : instr := "LD" ; parameter := "I,A" + CASE 77 : instr := "RETI" + CASE 79 : instr := "LD" ; parameter := "R,A" + CASE 86 : instr := "IM" ; parameter := "1" + CASE 87 : instr := "LD" ; parameter := "A,I" + CASE 94 : instr := "IM" ; parameter := "2" + CASE 95 : instr := "LD" ; parameter := "A,R" + CASE 100: instr := "TST" ; parameter := next byte ; laenge := 3 + CASE 103: instr := "RRD" + CASE 111: instr := "RLD" + CASE 116: instr := "TSTIO" ; parameter := next byte ; laenge := 3 + CASE 118: instr := "SLP" + CASE 131: instr := "OTIM" + CASE 139: instr := "OTDM" + CASE 147: instr := "OTIMR" + CASE 155: instr := "OTDMR" + CASE 171: instr := "OUTD" + CASE 163: instr := "OUTI" + CASE 179: instr := "OTIR" + CASE 187: instr := "OTDR" + OTHERWISE calculate ed instruction + ENDSELECT. + +calculate ed instruction : + IF is 40 to 7f THEN + IF and7 = 0 THEN instr := "IN" ; parameter := reg1 + ",(C)" + ELIF and7 = 1 THEN instr := "OUT" ; parameter := "(C)," + reg1 + ELIF andf = 2 THEN instr := "SBC" ; parameter := "HL," + rp + ELIF andf = 3 THEN instr := "LD" ; parameter := "("+nextword+"),"+rp; + laenge := 4 + ELIF andf =11 THEN instr := "LD" ; parameter := rp+",("+nextword+")"; + laenge := 4 + ELIF andf =10 THEN instr := "ADC" ; parameter := "HL," + rp + ELIF andf =12 THEN instr := "MLT" ; parameter := rp + ELSE laenge := 1 + FI + ELIF byte < 64 THEN + IF and7 = 0 THEN instr := "IN0" ; parameter := reg1 + ",(" + next + byte + ")" ; laenge := 3 + ELIF and7 = 1 THEN instr := "OUT0" ; parameter := "(" + next word + + ")," + reg1 ; laenge := 3 + ELIF and7 = 4 THEN instr := "TST" ; parameter := reg1 + ELSE laenge := 1 + FI + ELIF div10 = 10 OR div10 = 11 THEN + IF and7 = 0 THEN instr := "LD" + modification + ELIF and7 = 1 THEN instr := "CP" + modification + ELIF and7 = 2 THEN instr := "IN" + modification + ELSE laenge := 1 + FI + ELSE laenge := 1 + FI. + +is 40 to 7f : + div 10 < 8 AND div 10 > 3. + +modification : + SELECT div8 - 4 OF + CASE 0 : "I" + CASE 1 : "D" + CASE 2 : "IR" + CASE 3 : "DR" + OTHERWISE "???" + ENDSELECT. + +ENDPROC ed instructions ; + +TEXT PROC next word : + hex8 (zugriff (int addr PLUS 2)) + hex8 (zugriff (int addr PLUS 1)) +ENDPROC next word ; + +TEXT PROC next byte : + hex8 (zugriff (int addr PLUS 1)) +ENDPROC next byte + diff --git a/system/eumel0-z80/src/eumel0.prt.1 b/system/eumel0-z80/src/eumel0.prt.1 new file mode 100644 index 0000000..244dcbe --- /dev/null +++ b/system/eumel0-z80/src/eumel0.prt.1 @@ -0,0 +1,3948 @@ +ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT + +1400 45 E LD B,L ; "EUMEL " (16 chars) +1401 55 U LD D,L +1402 4D M LD C,L +1403 45 E LD B,L +1404 4C L LD C,H +1405 20 20 JR NZ,1427 +1407 20 20 JR NZ,1429 +1409 20 20 JR NZ,142B +140B 20 20 JR NZ,142D +140D 20 20 JR NZ,142F +140F 20 +1410 3A 00 ; eumel0blocks (58) +1412 D6 06 .. SUB A,06 ; mind. hgversion (1750) ID(0) +1414 01 00 ; cputype: z80 (1) ID(1) + ; 3=8086, 4=68000, 5=80286 +1416 65 00 ..e LD BC,6500 ; urladerversion (101) ID(2) +1418 00 00 ; reserviert (0) ID(3) +141A 05 00 ; mind shard version (5) +141C 08 00 . NOP ; max shard version (8) + ; ----------- 175 Leiste --------- +141E C3 D4 28 ..( JP 28D4 ; Systemstart 175 +1421 C3 71 1F .q. JP 1F71 ; inputinterrupt +1424 C3 35 6E .5n JP 6E35 ; timerinterrupt +1427 C3 E2 6D ..m JP 6DE2 ; EUMEL0 Warte aufruefen +142A C3 5B 5E .[^ JP 5E5B ; grab Blocks +142D C3 21 60 .!` JP 6021 ; free Blocks +1430 C3 1C 29 ..) JP 291C ; Shutup ausfuehren +1433 C3 09 29 ..) JP 2909 ; Info " shard" Ansprungaddresse +1436 00 . NOP ; 1500 00 7F FF +1437 15 . DEC D ; etc. wie 1.7.3 +1438 FF . RST 38 +1439 7F . LD A,A +143A 00 . NOP +143B 80 . ADD B +143C 15 . DEC D +143D 02 . LD (BC),A +143E 7F . LD A,A +143F 00 . NOP +1440 00 . NOP +1441 16 FD .. LD D,FD +1443 7F . LD A,A +1444 00 . NOP +1445 80 . ADD B +1446 16 FF .. LD D,FF +1448 7F . LD A,A +1449 00 . NOP +144A 00 . NOP +144B 17 . RLA +144C 00 . NOP +144D 7F . LD A,A +144E 01 80 18 ... LD BC,1880 +1451 FF . RST 38 +1452 7F . LD A,A +1453 00 . NOP +1454 00 . NOP +1455 19 . ADD HL,DE +1456 00 . NOP +1457 FF . RST 38 +1458 04 . INC B +1459 00 . NOP +145A 00 . NOP +145B 31 37 35 175 LD SP,3537 ; "175 hwtest 7 (!)" +145E 20 68 h JR NZ,14C8 +1460 77 w LD (HL),A +1461 74 t LD (HL),H +1462 65 e LD H,L +1463 73 s LD (HL),E +1464 74 t LD (HL),H +1465 20 20 JR NZ,1487 +1467 20 37 7 JR NZ,14A0 +1469 20 28 ( JR NZ,1493 +146B 21 29 !). LD HL,CD29 +146D CD EB 6D CALL 6DEB ;---- EUMEL0-Ram Tabellen init --- +1470 2A 36 14 *6. LD HL,(1436) +1473 E5 . PUSH HL +1474 21 36 14 !6. LD HL,1436 +1477 97 . SUB A +1478 5E ^ LD E,(HL) +1479 23 # INC HL +147A 56 V LD D,(HL) +147B 14 . INC D +147C 15 . DEC D +147D 28 09 (. JR Z,1488 +147F 23 # INC HL +1480 01 03 00 ... LD BC,0003 +1483 ED B0 .. LDIR +1485 3C < INC A +1486 18 F0 .. JR 1478 +1488 D1 . POP DE +1489 62 b LD H,D +148A 6B k LD L,E +148B 23 # INC HL +148C 4E N LD C,(HL) +148D 23 # INC HL +148E 46 F LD B,(HL) +148F 2B + DEC HL +1490 EB . EX DE,HL +1491 ED B0 .. LDIR +1493 3D = DEC A +1494 20 F3 . JR NZ,1489 ; Miniprozess endlosschleife +1496 C3 A0 6D ..m JP 6DA0 ; ====== Allgemeiner Systemstart === +1499 31 00 A1 1.. LD SP,A100 ; Stackpointer vorlaefig setzen +149C CD A0 28 ..( CALL 28A0 ; Limit holen +149F ED 53 3D 1D .S=. LD (1D3D),DE +14A3 ED 7B 3D 1D .{=. LD SP,(1D3D) +14A7 CD FE 6D ..m CALL 6DFE +14AA FB . EI +14AB 3A 6E 28 :n( LD A,(286E) ; Vortest durchfuehren ? +14AE CB 4F .O BIT 1,A +14B0 C2 BF 15 ... JP NZ,15BF +14B3 21 AF 82 !.. LD HL,82AF ; "EUMEL-Vortest" +14B6 CD CA 6E ..n CALL 6ECA ; Text ausgeben +14B9 3E 02 >. LD A,02 ; Terminalkanaele anzeigen +14BB F5 . PUSH AF +14BC CD 71 1E .q. CALL 1E71 ; Typ erfragen +14BF 38 16 8. JR C,14D7 +14C1 F1 . POP AF +14C2 F5 . PUSH AF +14C3 16 00 .. LD D,00 +14C5 5F _ LD E,A +14C6 21 1B 1D !.. LD HL,1D1B +14C9 FE 0A .. CP 0A +14CB 30 01 0. JR NC,14CE +14CD 23 # INC HL +14CE CD 00 4E ..N CALL 4E00 +14D1 21 19 1D !.. LD HL,1D19 +14D4 CD CA 6E ..n CALL 6ECA +14D7 F1 . POP AF +14D8 3C < INC A +14D9 FE 21 .! CP 21 ; 31 Kanaele +14DB 38 DE 8. JR C,14BB +14DD CD E0 1C ... CALL 1CE0 +14E0 CD 8A 28 ..( CALL 288A +14E3 22 11 1D ".. LD (1D11),HL +14E6 ED 43 0F 1D .C.. LD (1D0F),BC +14EA CB B8 .. RES 7,B +14EC CB 70 .p BIT 6,B +14EE 50 P LD D,B +14EF 59 Y LD E,C +14F0 28 03 (. JR Z,14F5 +14F2 01 00 00 ... LD BC,0000 +14F5 CB 21 .! SLA C +14F7 CB 10 .. RL B +14F9 ED 43 0D 1D .C.. LD (1D0D),BC +14FD CB B2 .. RES 6,D +14FF 21 40 00 !@. LD HL,0040 +1502 19 . ADD HL,DE +1503 EB . EX DE,HL +1504 21 00 85 !.. LD HL,8500 +1507 CD 00 4E ..N CALL 4E00 +150A 21 E8 84 !.. LD HL,84E8 +150D CD CA 6E ..n CALL 6ECA +1510 CD A0 28 ..( CALL 28A0 +1513 21 97 82 !.. LD HL,8297 +1516 EB . EX DE,HL +1517 B7 . OR A +1518 ED 52 .R SBC HL,DE +151A CB 3C .< SLR H +151C CB 3C .< SLR H +151E 5C \ LD E,H +151F 16 00 .. LD D,00 +1521 21 70 85 !p. LD HL,8570 +1524 CD 00 4E ..N CALL 4E00 +1527 21 57 85 !W. LD HL,8557 +152A CD CA 6E ..n CALL 6ECA +152D 97 . SUB A +152E 01 05 00 ... LD BC,0005 +1531 11 00 00 ... LD DE,0000 +1534 CD A8 28 ..( CALL 28A8 +1537 CB 28 .( SRA B +1539 CB 19 .. RR C +153B 59 Y LD E,C +153C 50 P LD D,B +153D 21 1F 85 !.. LD HL,851F +1540 3E E7 >. LD A,E7 +1542 93 . SUB E +1543 3E 03 >. LD A,03 +1545 9A . SBC D +1546 38 01 8. JR C,1549 +1548 23 # INC HL +1549 CD 00 4E ..N CALL 4E00 +154C 21 08 85 !.. LD HL,8508 +154F CD CA 6E ..n CALL 6ECA +1552 3A 6E 28 :n( LD A,(286E) +1555 CB 47 .G BIT 0,A +1557 20 0C . JR NZ,1565 +1559 21 DD 82 !.. LD HL,82DD +155C CD CA 6E ..n CALL 6ECA +155F CD F0 17 ... CALL 17F0 +1562 CD E0 1C ... CALL 1CE0 +1565 01 00 00 ... LD BC,0000 +1568 ED A1 .. CPI +156A EA 68 15 .h. JP PE,1568 +156D 3E 01 >. LD A,01 +156F CD 06 1F ... CALL 1F06 +1572 38 4B 8K JR C,15BF +1574 ED 7B 3D 1D .{=. LD SP,(1D3D) ; ----- Menue ausgeben -------- +1578 97 . SUB A +1579 32 30 1D 20. LD (1D30),A +157C 21 EE 82 !.. LD HL,82EE ; Menuetext +157F CD CA 6E ..n CALL 6ECA ; Ausgeben +1582 CD 9B 1C ... CALL 1C9B ; AUf Taste warten +1585 FE 31 .1 CP 31 ; "1" Systemstart +1587 28 36 (6 JR Z,15BF +1589 FE 32 .2 CP 32 ; "2" Neuen HG laden +158B CA 16 16 ... JP Z,1616 +158E FE 33 .3 CP 33 ; "3" Hardwaretest +1590 CA 9D 16 ... JP Z,169D +1593 FE 34 .4 CP 34 ; "4" neuen Urlader vom Archiv +1595 28 35 (5 JR Z,15CC +1597 FE 53 .S CP 53 ; "S" Systemstart ohne Block 0 +1599 CA 6D 14 .m. JP Z,146D ; Zur Miniprozess Schleife +159C FE 49 .I CP 49 ; "I" Info aufrufen +159E 20 D4 . JR NZ,1574 +15A0 DD 21 31 1D .!1. LD IX,1D31 +15A4 CD C0 1A ... CALL 1AC0 +15A7 21 46 A0 !F. LD HL,A046 +15AA 11 19 7D ..} LD DE,7D19 +15AD 01 0A 00 ... LD BC,000A +15B0 ED B0 .. LDIR +15B2 CD 1F 70 ..p CALL 701F ; Info aufrufen +15B5 18 06 .. JR 15BD ; " start" +15B7 20 73 s JR NZ,162C +15B9 74 t LD (HL),H +15BA 61 a LD H,C +15BB 72 r LD (HL),D +15BC 74 t LD (HL),H +15BD 18 B5 .. JR 1574 ; ------- Vortest Ende ----------- +15BF DD 21 31 1D .!1. LD IX,1D31 ; Systemstart +15C3 CD C0 1A ... CALL 1AC0 ; Block 0 laden +15C6 CD 66 1C .f. CALL 1C66 ; Etikett testen +15C9 C3 6D 14 .m. JP 146D ; Zur Miniprozess Schleife +15CC DD 21 36 1D .!6. LD IX,1D36 ;-- Neuen Urlader laden ------ +15D0 CD 9F 1A ... CALL 1A9F +15D3 21 0A 00 !.. LD HL,000A +15D6 22 32 1D "2. LD (1D32),HL +15D9 22 37 1D "7. LD (1D37),HL +15DC CD 03 16 ... CALL 1603 +15DF DD 21 31 1D .!1. LD IX,1D31 +15E3 CD 03 16 ... CALL 1603 +15E6 ED 4B 10 A0 .K.. LD BC,(A010) +15EA 21 3A 00 !:. LD HL,003A +15ED 37 7 SCF +15EE ED 42 .B SBC HL,BC +15F0 30 08 0. JR NC,15FA +15F2 21 44 00 !D. LD HL,0044 +15F5 22 3B 1D ";. LD (1D3B),HL +15F8 18 4E .N JR 1648 +15FA 21 D4 85 !.. LD HL,85D4 +15FD CD CA 6E ..n CALL 6ECA +1600 C3 74 15 .t. JP 1574 ; Zum Vortest Menue +1603 CD F2 1A ... CALL 1AF2 +1606 21 00 A0 !.. LD HL,A000 +1609 11 2A 1D .*. LD DE,1D2A +160C 01 05 00 ... LD BC,0005 +160F CD 92 1C ... CALL 1C92 +1612 C2 74 15 .t. JP NZ,1574 ; Zum Vortest Menue +1615 C9 . RET ;-------- Neuen HG vom ARchiv ---- +1616 21 C9 84 !.. LD HL,84C9 ; "ALten HG ueberschreiben (j/n) ?" +1619 CD CA 6E ..n CALL 6ECA +161C CD 9B 1C ... CALL 1C9B +161F FE 79 .y CP 79 ; "y" oder +1621 28 05 (. JR Z,1628 +1623 FE 6A .j CP 6A ; "j" erlaubt +1625 C2 74 15 .t. JP NZ,1574 +1628 DD 21 31 1D .!1. LD IX,1D31 ; Ueberschreiben +162C CD 9F 1A ... CALL 1A9F +162F CD C0 1A ... CALL 1AC0 +1632 DD 21 36 1D .!6. LD IX,1D36 +1636 CD 9F 1A ... CALL 1A9F +1639 CD C0 1A ... CALL 1AC0 +163C CD 66 1C .f. CALL 1C66 +163F 2A 24 A0 *$. LD HL,(A024) +1642 29 ) ADD HL,HL +1643 29 ) ADD HL,HL +1644 29 ) ADD HL,HL +1645 22 3B 1D ";. LD (1D3B),HL +1648 CD B6 1C ... CALL 1CB6 +164B DD 21 31 1D .!1. LD IX,1D31 +164F CD D1 1B ... CALL 1BD1 +1652 DD 21 36 1D .!6. LD IX,1D36 +1656 CD F2 1A ... CALL 1AF2 +1659 DD 21 31 1D .!1. LD IX,1D31 +165D CD 08 1C ... CALL 1C08 +1660 CD BA 1B ... CALL 1BBA +1663 2A 3B 1D *;. LD HL,(1D3B) +1666 ED 5B 32 1D .[2. LD DE,(1D32) +166A B7 . OR A +166B ED 52 .R SBC HL,DE +166D CA 8F 16 ... JP Z,168F +1670 DD 21 36 1D .!6. LD IX,1D36 +1674 CD BA 1B ... CALL 1BBA +1677 20 CF . JR NZ,1648 +1679 21 43 84 !C. LD HL,8443 +167C CD CA 6E ..n CALL 6ECA +167F CD 9B 1C ... CALL 1C9B +1682 FE 79 .y CP 79 ; "y" oder +1684 28 04 (. JR Z,168A +1686 FE 6A .j CP 6A ; "j" erlaubt +1688 20 EF . JR NZ,1679 +168A CD 9F 1A ... CALL 1A9F +168D 18 B9 .. JR 1648 +168F CD E0 1C ... CALL 1CE0 +1692 CD E0 1C ... CALL 1CE0 +1695 21 B5 84 !.. LD HL,84B5 +1698 CD CA 6E ..n CALL 6ECA +169B 18 FE .. JR 169B +169D 3E 01 >. LD A,01 ; ------ Hardwaretest +169F 32 30 1D 20. LD (1D30),A +16A2 21 6C 83 !l. LD HL,836C +16A5 CD CA 6E ..n CALL 6ECA ; Hardwaretest Menue +16A8 21 00 00 !.. LD HL,0000 +16AB 22 F3 1C ".. LD (1CF3),HL +16AE CD 9B 1C ... CALL 1C9B +16B1 FE 31 .1 CP 31 ; "1" Speichertest +16B3 CA C6 16 ... JP Z,16C6 +16B6 FE 32 .2 CP 32 ; "2" Kanaltest +16B8 CA 7C 17 .|. JP Z,177C +16BB FE 33 .3 CP 33 +16BD 28 12 (. JR Z,16D1 ; "3" HG Test +16BF FE 34 .4 CP 34 ; "4" Archivtest +16C1 28 14 (. JR Z,16D7 +16C3 C3 74 15 .t. JP 1574 +16C6 CD C2 1C ... CALL 1CC2 ; ----Speichertest +16C9 CD F0 17 ... CALL 17F0 +16CC CD B6 1C ... CALL 1CB6 +16CF 18 F5 .. JR 16C6 ; Wiederholen +16D1 DD 21 31 1D .!1. LD IX,1D31 ; ------- HG Test +16D5 18 04 .. JR 16DB +16D7 DD 21 36 1D .!6. LD IX,1D36 ; -------- Archivtest +16DB 21 C1 83 !.. LD HL,83C1 +16DE CD CA 6E ..n CALL 6ECA +16E1 CD 9B 1C ... CALL 1C9B +16E4 FE 31 .1 CP 31 ; "1" Lesetest +16E6 28 0C (. JR Z,16F4 +16E8 FE 32 .2 CP 32 ; "2" Schreiblesetest +16EA 28 21 (! JR Z,170D +16EC FE 33 .3 CP 33 ; "3" Positioniertest +16EE CA 60 17 .`. JP Z,1760 +16F1 C3 74 15 .t. JP 1574 ; Zum Vortest Menue +16F4 CD C2 1C ... CALL 1CC2 +16F7 CD E0 1C ... CALL 1CE0 +16FA CD 9F 1A ... CALL 1A9F +16FD CD B6 1C ... CALL 1CB6 +1700 CD D1 1B ... CALL 1BD1 +1703 CD F2 1A ... CALL 1AF2 +1706 CD BA 1B ... CALL 1BBA +1709 20 F2 . JR NZ,16FD +170B 18 E7 .. JR 16F4 +170D CD C2 1C ... CALL 1CC2 +1710 CD E0 1C ... CALL 1CE0 +1713 CD 9F 1A ... CALL 1A9F +1716 CD B6 1C ... CALL 1CB6 +1719 CD D1 1B ... CALL 1BD1 +171C CD F2 1A ... CALL 1AF2 +171F 21 00 A0 !.. LD HL,A000 +1722 11 00 A2 ... LD DE,A200 +1725 01 00 02 ... LD BC,0200 +1728 ED B0 .. LDIR +172A 3E 55 >U LD A,55 +172C CD 31 1C .1. CALL 1C31 +172F 3E AA >. LD A,AA +1731 CD 31 1C .1. CALL 1C31 +1734 21 00 A2 !.. LD HL,A200 +1737 11 00 A0 ... LD DE,A000 +173A 01 00 02 ... LD BC,0200 +173D ED B0 .. LDIR +173F CD 08 1C ... CALL 1C08 +1742 3E 55 >U LD A,55 +1744 CD 59 1C .Y. CALL 1C59 +1747 CD ED 1B ... CALL 1BED +174A 21 00 A0 !.. LD HL,A000 +174D 11 00 A2 ... LD DE,A200 +1750 01 00 02 ... LD BC,0200 +1753 CD 92 1C ... CALL 1C92 +1756 C4 27 1C .'. CALL NZ,1C27 +1759 CD BA 1B ... CALL 1BBA +175C 20 B8 . JR NZ,1716 +175E 18 AD .. JR 170D +1760 CD C2 1C ... CALL 1CC2 +1763 CD E0 1C ... CALL 1CE0 +1766 CD 9F 1A ... CALL 1A9F +1769 CD B6 1C ... CALL 1CB6 +176C CD C0 1A ... CALL 1AC0 +176F CD D1 1B ... CALL 1BD1 +1772 CD F2 1A ... CALL 1AF2 +1775 CD BA 1B ... CALL 1BBA +1778 20 EF . JR NZ,1769 +177A 18 E4 .. JR 1760 +177C CD C2 1C ... CALL 1CC2 +177F CD E0 1C ... CALL 1CE0 +1782 CD B6 1C ... CALL 1CB6 +1785 3E 20 > LD A,20 +1787 32 30 85 20. LD (8530),A +178A 3E 02 >. LD A,02 +178C F5 . PUSH AF +178D 5F _ LD E,A +178E CD 71 1E .q. CALL 1E71 +1791 38 53 8S JR C,17E6 +1793 F1 . POP AF +1794 F5 . PUSH AF +1795 CD 59 1E .Y. CALL 1E59 +1798 FE 1E .. CP 1E +179A 38 20 8 JR C,17BC +179C 16 00 .. LD D,00 +179E 21 31 85 !1. LD HL,8531 +17A1 36 20 6 LD (HL),20 +17A3 2B + DEC HL +17A4 CD 00 4E ..N CALL 4E00 +17A7 21 28 85 !(. LD HL,8528 +17AA 4E N LD C,(HL) +17AB 23 # INC HL +17AC 06 00 .. LD B,00 +17AE F1 . POP AF +17AF F5 . PUSH AF +17B0 59 Y LD E,C +17B1 CD 88 21 ..! CALL 2188 +17B4 38 06 8. JR C,17BC +17B6 09 . ADD HL,BC +17B7 7B { LD A,E +17B8 91 . SUB C +17B9 4F O LD C,A +17BA 18 F2 .. JR 17AE +17BC F1 . POP AF +17BD F5 . PUSH AF +17BE CD 06 1F ... CALL 1F06 +17C1 38 23 8# JR C,17E6 +17C3 5F _ LD E,A +17C4 16 00 .. LD D,00 +17C6 21 20 20 ! LD HL,2020 +17C9 22 55 85 "U. LD (8555),HL +17CC 21 54 85 !T. LD HL,8554 +17CF CD 00 4E ..N CALL 4E00 +17D2 F1 . POP AF +17D3 F5 . PUSH AF +17D4 5F _ LD E,A +17D5 16 00 .. LD D,00 +17D7 21 42 85 !B. LD HL,8542 +17DA 36 20 6 LD (HL),20 +17DC 2B + DEC HL +17DD CD 00 4E ..N CALL 4E00 +17E0 21 34 85 !4. LD HL,8534 +17E3 CD CA 6E ..n CALL 6ECA +17E6 F1 . POP AF +17E7 3C < INC A +17E8 FE 20 . CP 20 +17EA DA 8C 17 ... JP C,178C +17ED C3 7C 17 .|. JP 177C +17F0 CD A0 28 ..( CALL 28A0 +17F3 15 . DEC D +17F4 21 DE 85 !.. LD HL,85DE +17F7 22 E7 1C ".. LD (1CE7),HL +17FA EB . EX DE,HL +17FB B7 . OR A +17FC ED 52 .R SBC HL,DE +17FE 22 E9 1C ".. LD (1CE9),HL +1801 EB . EX DE,HL +1802 CB 3A .: SLR D +1804 CB 1B .. RR E +1806 21 03 00 !.. LD HL,0003 +1809 CD 3D 4D .=M CALL 4D3D +180C CB 23 .# SLA E +180E CB 12 .. RL D +1810 ED 53 EB 1C .S.. LD (1CEB),DE +1814 21 DE 85 !.. LD HL,85DE +1817 11 3F 1D .?. LD DE,1D3F +181A B7 . OR A +181B ED 52 .R SBC HL,DE +181D 22 ED 1C ".. LD (1CED),HL +1820 EB . EX DE,HL +1821 21 03 00 !.. LD HL,0003 +1824 CD 3D 4D .=M CALL 4D3D +1827 ED 53 EF 1C .S.. LD (1CEF),DE +182B 21 FF FF !.. LD HL,FFFF +182E 22 F1 1C ".. LD (1CF1),HL +1831 2A E7 1C *.. LD HL,(1CE7) +1834 CD 12 19 ... CALL 1912 +1837 21 00 00 !.. LD HL,0000 +183A 5C \ LD E,H +183B E5 . PUSH HL +183C CD C9 19 ... CALL 19C9 +183F 30 0D 0. JR NC,184E +1841 CD 12 19 ... CALL 1912 +1844 E1 . POP HL +1845 7C | LD A,H +1846 C6 40 .@ ADD A,40 +1848 67 g LD H,A +1849 30 01 0. JR NC,184C +184B 1C . INC E +184C 18 ED .. JR 183B +184E E1 . POP HL ; Testmuster fuer Speichertest +184F 11 01 55 ..U LD DE,5501 +1852 CD 22 19 .". CALL 1922 +1855 11 02 55 ..U LD DE,5502 +1858 CD 22 19 .". CALL 1922 +185B 11 00 AA ... LD DE,AA00 +185E CD 22 19 .". CALL 1922 +1861 11 01 55 ..U LD DE,5501 +1864 CD 7A 19 .z. CALL 197A +1867 11 01 AA ... LD DE,AA01 +186A CD 22 19 .". CALL 1922 +186D 11 02 55 ..U LD DE,5502 +1870 CD 7A 19 .z. CALL 197A +1873 11 00 AA ... LD DE,AA00 +1876 CD 7A 19 .z. CALL 197A +1879 11 01 AA ... LD DE,AA01 +187C CD 7A 19 .z. CALL 197A +187F 11 00 55 ..U LD DE,5500 +1882 CD 22 19 .". CALL 1922 +1885 11 00 55 ..U LD DE,5500 +1888 CD 7A 19 .z. CALL 197A +188B 11 02 AA ... LD DE,AA02 +188E CD 22 19 .". CALL 1922 +1891 11 02 AA ... LD DE,AA02 +1894 CD 7A 19 .z. CALL 197A +1897 2A E9 1C *.. LD HL,(1CE9) +189A ED 5B ED 1C .[.. LD DE,(1CED) +189E B7 . OR A +189F ED 52 .R SBC HL,DE +18A1 38 5D 8] JR C,1900 +18A3 F3 . DI +18A4 21 3F 1D !?. LD HL,1D3F +18A7 ED 5B E7 1C .[.. LD DE,(1CE7) +18AB CD 1B 1A ... CALL 1A1B +18AE 11 01 55 ..U LD DE,5501 +18B1 CD 07 1A ... CALL 1A07 +18B4 11 02 55 ..U LD DE,5502 +18B7 CD 07 1A ... CALL 1A07 +18BA 11 00 AA ... LD DE,AA00 +18BD CD 07 1A ... CALL 1A07 +18C0 11 01 55 ..U LD DE,5501 +18C3 CD 11 1A ... CALL 1A11 +18C6 11 01 AA ... LD DE,AA01 +18C9 CD 07 1A ... CALL 1A07 +18CC 11 02 55 ..U LD DE,5502 +18CF CD 11 1A ... CALL 1A11 +18D2 11 00 AA ... LD DE,AA00 +18D5 CD 11 1A ... CALL 1A11 +18D8 11 01 AA ... LD DE,AA01 +18DB CD 11 1A ... CALL 1A11 +18DE 11 00 55 ..U LD DE,5500 +18E1 CD 07 1A ... CALL 1A07 +18E4 11 00 55 ..U LD DE,5500 +18E7 CD 11 1A ... CALL 1A11 +18EA 11 02 AA ... LD DE,AA02 +18ED CD 07 1A ... CALL 1A07 +18F0 11 02 AA ... LD DE,AA02 +18F3 CD 11 1A ... CALL 1A11 +18F6 2A E7 1C *.. LD HL,(1CE7) +18F9 11 3F 1D .?. LD DE,1D3F +18FC CD 1B 1A ... CALL 1A1B +18FF FB . EI +1900 CD E0 1C ... CALL 1CE0 +1903 3A E6 1C :.. LD A,(1CE6) +1906 B7 . OR A +1907 C8 . RET Z +1908 ED 7B 3D 1D .{=. LD SP,(1D3D) +190C CD E0 1C ... CALL 1CE0 +190F C3 2B 18 .+. JP 182B +1912 06 05 .. LD B,05 +1914 97 . SUB A +1915 57 W LD D,A +1916 77 w LD (HL),A +1917 7E ~ LD A,(HL) +1918 BA . CP D +1919 C4 31 1A .1. CALL NZ,1A31 +191C 3C < INC A +191D 20 F6 . JR NZ,1915 +191F 10 F3 .. DJNZ 1914 +1921 C9 . RET +1922 2A E7 1C *.. LD HL,(1CE7) +1925 ED 4B EB 1C .K.. LD BC,(1CEB) +1929 CD 51 19 .Q. CALL 1951 +192C 26 00 &. LD H,00 +192E 6B k LD L,E +192F 1E 00 .. LD E,00 +1931 E5 . PUSH HL +1932 CD C9 19 ... CALL 19C9 +1935 30 0F 0. JR NC,1946 +1937 7D } LD A,L +1938 72 r LD (HL),D +1939 C6 03 .. ADD A,03 +193B 6F o LD L,A +193C 30 FA 0. JR NC,1938 +193E E1 . POP HL +193F 6F o LD L,A +1940 24 $ INC H +1941 20 EE . JR NZ,1931 +1943 1C . INC E +1944 18 EB .. JR 1931 +1946 CD 6D 19 .m. CALL 196D +1949 21 0B 1D !.. LD HL,1D0B +194C CD CA 6E ..n CALL 6ECA +194F E1 . POP HL +1950 C9 . RET +1951 D5 . PUSH DE +1952 79 y LD A,C +1953 B7 . OR A +1954 28 01 (. JR Z,1957 +1956 04 . INC B +1957 79 y LD A,C +1958 48 H LD C,B +1959 47 G LD B,A +195A 7A z LD A,D +195B 16 00 .. LD D,00 +195D 19 . ADD HL,DE +195E 11 03 00 ... LD DE,0003 +1961 77 w LD (HL),A +1962 19 . ADD HL,DE +1963 10 FC .. DJNZ 1961 +1965 0D . DEC C +1966 20 F9 . JR NZ,1961 +1968 D1 . POP DE +1969 CD 6D 19 .m. CALL 196D +196C C9 . RET +196D F5 . PUSH AF +196E C5 . PUSH BC +196F 3E 00 >. LD A,00 +1971 06 64 .d LD B,64 +1973 ED 4F .O LD R,A +1975 10 FC .. DJNZ 1973 +1977 C1 . POP BC +1978 F1 . POP AF +1979 C9 . RET +197A 2A E7 1C *.. LD HL,(1CE7) +197D ED 4B EB 1C .K.. LD BC,(1CEB) +1981 CD A1 19 ... CALL 19A1 +1984 26 00 &. LD H,00 +1986 6B k LD L,E +1987 5C \ LD E,H +1988 E5 . PUSH HL +1989 CD C9 19 ... CALL 19C9 +198C 30 B8 0. JR NC,1946 +198E 7E ~ LD A,(HL) +198F BA . CP D +1990 C4 31 1A .1. CALL NZ,1A31 +1993 7D } LD A,L +1994 C6 03 .. ADD A,03 +1996 6F o LD L,A +1997 30 F5 0. JR NC,198E +1999 E1 . POP HL +199A 6F o LD L,A +199B 24 $ INC H +199C 20 EA . JR NZ,1988 +199E 1C . INC E +199F 18 E7 .. JR 1988 +19A1 D5 . PUSH DE +19A2 79 y LD A,C +19A3 B7 . OR A +19A4 28 01 (. JR Z,19A7 +19A6 04 . INC B +19A7 79 y LD A,C +19A8 48 H LD C,B +19A9 47 G LD B,A +19AA 7A z LD A,D +19AB 16 00 .. LD D,00 +19AD 19 . ADD HL,DE +19AE 11 FF FF ... LD DE,FFFF +19B1 ED 53 F1 1C .S.. LD (1CF1),DE +19B5 57 W LD D,A +19B6 7E ~ LD A,(HL) +19B7 BA . CP D +19B8 C4 31 1A .1. CALL NZ,1A31 +19BB 7D } LD A,L +19BC C6 03 .. ADD A,03 +19BE 6F o LD L,A +19BF 30 01 0. JR NC,19C2 +19C1 24 $ INC H +19C2 10 F2 .. DJNZ 19B6 +19C4 0D . DEC C +19C5 20 EF . JR NZ,19B6 +19C7 D1 . POP DE +19C8 C9 . RET +19C9 E5 . PUSH HL +19CA 6C l LD L,H +19CB 63 c LD H,E +19CC 24 $ INC H +19CD 22 F1 1C ".. LD (1CF1),HL +19D0 25 % DEC H +19D1 D5 . PUSH DE +19D2 55 U LD D,L +19D3 CB 3C .< SLR H +19D5 CB 1D .. RR L +19D7 E5 . PUSH HL +19D8 ED 4B 0D 1D .K.. LD BC,(1D0D) +19DC B7 . OR A +19DD ED 42 .B SBC HL,BC +19DF E1 . POP HL +19E0 30 08 0. JR NC,19EA +19E2 CD EE 19 ... CALL 19EE +19E5 7A z LD A,D +19E6 E6 01 .. AND 01 +19E8 B4 . OR H +19E9 37 7 SCF +19EA D1 . POP DE +19EB E1 . POP HL +19EC 67 g LD H,A +19ED C9 . RET +19EE 3A 10 1D :.. LD A,(1D10) +19F1 CB 7F .. BIT 7,A +19F3 C2 8D 28 ..( JP NZ,288D +19F6 CB 3C .< SLR H +19F8 CB 1D .. RR L +19FA 7D } LD A,L +19FB 2A 11 1D *.. LD HL,(1D11) +19FE 30 02 0. JR NC,1A02 +1A00 CB CC .. SET 1,H +1A02 2E 00 .. LD L,00 +1A04 C3 8D 28 ..( JP 288D +1A07 21 3F 1D !?. LD HL,1D3F +1A0A ED 4B EF 1C .K.. LD BC,(1CEF) +1A0E C3 51 19 .Q. JP 1951 +1A11 21 3F 1D !?. LD HL,1D3F +1A14 ED 4B EF 1C .K.. LD BC,(1CEF) +1A18 C3 A1 19 ... JP 19A1 +1A1B ED 4B ED 1C .K.. LD BC,(1CED) +1A1F ED B0 .. LDIR +1A21 2B + DEC HL +1A22 1B . DEC DE +1A23 ED 4B ED 1C .K.. LD BC,(1CED) +1A27 1A . LD A,(DE) +1A28 ED A9 .. CPD +1A2A 20 FE . JR NZ,1A2A +1A2C 1B . DEC DE +1A2D EA 27 1A .'. JP PE,1A27 +1A30 C9 . RET +1A31 F5 . PUSH AF +1A32 C5 . PUSH BC +1A33 D5 . PUSH DE +1A34 E5 . PUSH HL +1A35 42 B LD B,D +1A36 4F O LD C,A +1A37 ED 5B F1 1C .[.. LD DE,(1CF1) +1A3B CB 7A .z BIT 7,D +1A3D 28 25 (% JR Z,1A64 +1A3F E5 . PUSH HL +1A40 EB . EX DE,HL +1A41 2A E7 1C *.. LD HL,(1CE7) +1A44 B7 . OR A +1A45 ED 52 .R SBC HL,DE +1A47 E1 . POP HL +1A48 38 16 8. JR C,1A60 +1A4A E5 . PUSH HL +1A4B C5 . PUSH BC +1A4C 11 3F 1D .?. LD DE,1D3F +1A4F 2A E7 1C *.. LD HL,(1CE7) +1A52 CD 1B 1A ... CALL 1A1B +1A55 C1 . POP BC +1A56 E1 . POP HL +1A57 FB . EI +1A58 3E 00 >. LD A,00 +1A5A CD 66 1A .f. CALL 1A66 +1A5D C3 08 19 ... JP 1908 +1A60 3E 00 >. LD A,00 +1A62 18 02 .. JR 1A66 +1A64 7A z LD A,D +1A65 63 c LD H,E +1A66 F5 . PUSH AF +1A67 3E 01 >. LD A,01 +1A69 32 E6 1C 2.. LD (1CE6),A +1A6C 11 D2 85 ... LD DE,85D2 +1A6F 79 y LD A,C +1A70 CD F5 1C ... CALL 1CF5 +1A73 11 CA 85 ... LD DE,85CA +1A76 78 x LD A,B +1A77 CD F5 1C ... CALL 1CF5 +1A7A F1 . POP AF +1A7B 11 BE 85 ... LD DE,85BE +1A7E CD F5 1C ... CALL 1CF5 +1A81 7C | LD A,H +1A82 CD F5 1C ... CALL 1CF5 +1A85 7D } LD A,L +1A86 CD F5 1C ... CALL 1CF5 +1A89 21 B0 85 !.. LD HL,85B0 +1A8C CD CA 6E ..n CALL 6ECA +1A8F 3E 01 >. LD A,01 +1A91 CD 06 1F ... CALL 1F06 +1A94 38 F9 8. JR C,1A8F +1A96 FE 0D .. CP 0D +1A98 20 F5 . JR NZ,1A8F +1A9A E1 . POP HL +1A9B D1 . POP DE +1A9C C1 . POP BC +1A9D F1 . POP AF +1A9E C9 . RET +1A9F DD 7E 00 .~. LD A,(IX+00) +1AA2 01 05 00 ... LD BC,0005 +1AA5 DD E5 .. PUSH IX +1AA7 D5 . PUSH DE +1AA8 11 00 00 ... LD DE,0000 +1AAB CD A8 28 ..( CALL 28A8 +1AAE D1 . POP DE +1AAF DD E1 .. POP IX +1AB1 DD 71 03 .q. LD (IX+03),C +1AB4 DD 70 04 .p. LD (IX+04),B +1AB7 DD 36 01 00 .6.. LD (IX+01),00 +1ABB DD 36 02 00 .6.. LD (IX+02),00 +1ABF C9 . RET +1AC0 21 00 A0 !.. LD HL,A000 +1AC3 11 00 00 ... LD DE,0000 +1AC6 01 00 00 ... LD BC,0000 +1AC9 DD 7E 00 .~. LD A,(IX+00) +1ACC DD E5 .. PUSH IX +1ACE CD 7E 28 .~( CALL 287E +1AD1 DD E1 .. POP IX +1AD3 0C . INC C +1AD4 0D . DEC C +1AD5 C8 . RET Z +1AD6 21 00 A0 !.. LD HL,A000 +1AD9 DD 7E 00 .~. LD A,(IX+00) +1ADC 01 00 00 ... LD BC,0000 +1ADF DD E5 .. PUSH IX +1AE1 CD 7E 28 .~( CALL 287E +1AE4 DD E1 .. POP IX +1AE6 0C . INC C +1AE7 0D . DEC C +1AE8 C8 . RET Z +1AE9 21 A4 84 !.. LD HL,84A4 +1AEC CD CA 6E ..n CALL 6ECA +1AEF C3 74 15 .t. JP 1574 +1AF2 21 00 A0 !.. LD HL,A000 +1AF5 06 40 .@ LD B,40 +1AF7 3E 1E >. LD A,1E +1AF9 77 w LD (HL),A +1AFA 23 # INC HL +1AFB 10 FC .. DJNZ 1AF9 +1AFD DD 5E 01 .^. LD E,(IX+01) +1B00 DD 56 02 .V. LD D,(IX+02) +1B03 3E 14 >. LD A,14 +1B05 F5 . PUSH AF +1B06 21 00 A0 !.. LD HL,A000 +1B09 01 00 00 ... LD BC,0000 +1B0C DD 7E 00 .~. LD A,(IX+00) +1B0F DD E5 .. PUSH IX +1B11 CD 7E 28 .~( CALL 287E +1B14 21 00 A0 !.. LD HL,A000 +1B17 06 40 .@ LD B,40 +1B19 3E 1E >. LD A,1E +1B1B BE . CP (HL) +1B1C 20 05 . JR NZ,1B23 +1B1E 23 # INC HL +1B1F 10 FA .. DJNZ 1B1B +1B21 0E 1E .. LD C,1E +1B23 DD E1 .. POP IX +1B25 F1 . POP AF +1B26 0D . DEC C +1B27 F2 32 1B .2. JP P,1B32 +1B2A FE 14 .. CP 14 +1B2C C8 . RET Z +1B2D 21 27 84 !'. LD HL,8427 +1B30 18 4C .L JR 1B7E +1B32 FE 0A .. CP 0A +1B34 20 14 . JR NZ,1B4A +1B36 D5 . PUSH DE +1B37 F5 . PUSH AF +1B38 21 00 A0 !.. LD HL,A000 +1B3B DD 7E 00 .~. LD A,(IX+00) +1B3E 11 00 00 ... LD DE,0000 +1B41 DD E5 .. PUSH IX +1B43 CD 7E 28 .~( CALL 287E +1B46 DD E1 .. POP IX +1B48 F1 . POP AF +1B49 D1 . POP DE +1B4A 3D = DEC A +1B4B 20 B8 . JR NZ,1B05 +1B4D 21 FD FF !.. LD HL,FFFD ; -3 ist Markierung f. defekten Bl. +1B50 22 00 A0 ".. LD (A000),HL +1B53 21 00 A0 !.. LD HL,A000 +1B56 11 02 A0 ... LD DE,A002 +1B59 01 FE 01 ... LD BC,01FE +1B5C ED B0 .. LDIR +1B5E 21 31 84 !1. LD HL,8431 +1B61 3A 30 1D :0. LD A,(1D30) +1B64 B7 . OR A +1B65 20 17 . JR NZ,1B7E +1B67 CD CA 6E ..n CALL 6ECA +1B6A 21 77 85 !w. LD HL,8577 +1B6D CD CA 6E ..n CALL 6ECA +1B70 CD 9B 1C ... CALL 1C9B +1B73 FE 6E .n CP 6E +1B75 CA 74 15 .t. JP Z,1574 +1B78 CD E0 1C ... CALL 1CE0 +1B7B C3 F2 1A ... JP 1AF2 +1B7E 3A 30 1D :0. LD A,(1D30) +1B81 B7 . OR A +1B82 28 1B (. JR Z,1B9F +1B84 CD A6 1B ... CALL 1BA6 +1B87 21 68 84 !h. LD HL,8468 +1B8A CD CA 6E ..n CALL 6ECA +1B8D CD 9B 1C ... CALL 1C9B +1B90 F5 . PUSH AF +1B91 CD E0 1C ... CALL 1CE0 +1B94 F1 . POP AF +1B95 FE 79 .y CP 79 +1B97 28 02 (. JR Z,1B9B +1B99 FE 6A .j CP 6A +1B9B CC 08 1C ... CALL Z,1C08 +1B9E C9 . RET +1B9F CD A6 1B ... CALL 1BA6 +1BA2 CD E0 1C ... CALL 1CE0 +1BA5 C9 . RET +1BA6 E5 . PUSH HL +1BA7 21 91 85 !.. LD HL,8591 +1BAA DD 7E 00 .~. LD A,(IX+00) +1BAD B7 . OR A +1BAE 28 03 (. JR Z,1BB3 +1BB0 21 95 85 !.. LD HL,8595 +1BB3 CD CA 6E ..n CALL 6ECA +1BB6 E1 . POP HL +1BB7 C3 CA 6E ..n JP 6ECA +1BBA DD 5E 01 .^. LD E,(IX+01) +1BBD DD 56 02 .V. LD D,(IX+02) +1BC0 DD 6E 03 .n. LD L,(IX+03) +1BC3 DD 66 04 .f. LD H,(IX+04) +1BC6 13 . INC DE +1BC7 DD 73 01 .s. LD (IX+01),E +1BCA DD 72 02 .r. LD (IX+02),D +1BCD B7 . OR A +1BCE ED 52 .R SBC HL,DE +1BD0 C9 . RET +1BD1 DD 5E 01 .^. LD E,(IX+01) +1BD4 DD 56 02 .V. LD D,(IX+02) +1BD7 21 20 20 ! LD HL,2020 +1BDA 22 26 1D "&. LD (1D26),HL +1BDD 22 28 1D "(. LD (1D28),HL +1BE0 21 25 1D !%. LD HL,1D25 +1BE3 CD 00 4E ..N CALL 4E00 +1BE6 21 22 1D !". LD HL,1D22 +1BE9 CD CA 6E ..n CALL 6ECA +1BEC C9 . RET +1BED DD 5E 01 .^. LD E,(IX+01) +1BF0 DD 56 02 .V. LD D,(IX+02) +1BF3 21 00 A0 !.. LD HL,A000 +1BF6 01 00 00 ... LD BC,0000 +1BF9 DD 7E 00 .~. LD A,(IX+00) +1BFC DD E5 .. PUSH IX +1BFE CD 7E 28 .~( CALL 287E +1C01 DD E1 .. POP IX +1C03 78 x LD A,B +1C04 B1 . OR C +1C05 20 20 JR NZ,1C27 +1C07 C9 . RET +1C08 06 05 .. LD B,05 +1C0A C5 . PUSH BC +1C0B 21 00 A0 !.. LD HL,A000 +1C0E DD 5E 01 .^. LD E,(IX+01) +1C11 DD 56 02 .V. LD D,(IX+02) +1C14 01 00 00 ... LD BC,0000 +1C17 DD 7E 00 .~. LD A,(IX+00) +1C1A DD E5 .. PUSH IX +1C1C CD 81 28 ..( CALL 2881 +1C1F DD E1 .. POP IX +1C21 79 y LD A,C +1C22 B0 . OR B +1C23 C1 . POP BC +1C24 C8 . RET Z +1C25 10 E3 .. DJNZ 1C0A +1C27 21 08 84 !.. LD HL,8408 +1C2A CD A6 1B ... CALL 1BA6 +1C2D CD E0 1C ... CALL 1CE0 +1C30 C9 . RET +1C31 F5 . PUSH AF +1C32 CD 59 1C .Y. CALL 1C59 +1C35 CD 08 1C ... CALL 1C08 +1C38 3E 0F >. LD A,0F +1C3A CD 59 1C .Y. CALL 1C59 +1C3D CD ED 1B ... CALL 1BED +1C40 F1 . POP AF +1C41 21 00 A0 !.. LD HL,A000 +1C44 01 00 02 ... LD BC,0200 +1C47 ED A1 .. CPI +1C49 20 04 . JR NZ,1C4F +1C4B EA 92 1C ... JP PE,1C92 +1C4E C9 . RET +1C4F 21 16 84 !.. LD HL,8416 +1C52 CD CA 6E ..n CALL 6ECA +1C55 CD E0 1C ... CALL 1CE0 +1C58 C9 . RET +1C59 21 00 A0 !.. LD HL,A000 +1C5C 11 01 A0 ... LD DE,A001 +1C5F 01 FF 01 ... LD BC,01FF +1C62 77 w LD (HL),A +1C63 ED B0 .. LDIR +1C65 C9 . RET ; ---- Korrekten Block 0 testen +1C66 21 00 A0 !.. LD HL,A000 +1C69 11 2A 1D .*. LD DE,1D2A ; "EUMEL-" +1C6C 01 06 00 ... LD BC,0006 +1C6F CD 92 1C ... CALL 1C92 +1C72 20 12 . JR NZ,1C86 ; "HG-ungueltig" +1C74 21 09 A0 !.. LD HL,A009 +1C77 11 86 82 ... LD DE,8286 ; +1C7A 01 02 00 ... LD BC,0002 +1C7D CD 92 1C ... CALL 1C92 ; Versionsnummer +1C80 C8 . RET Z +1C81 21 93 84 !.. LD HL,8493 ; "Falsche Version" +1C84 18 03 .. JR 1C89 +1C86 21 85 84 !.. LD HL,8485 +1C89 CD CA 6E ..n CALL 6ECA +1C8C CD 9B 1C ... CALL 1C9B +1C8F C3 74 15 .t. JP 1574 ; Zum Vortest Menue +1C92 1A . LD A,(DE) ; Zeichenkette vergleichen +1C93 13 . INC DE +1C94 ED A1 .. CPI +1C96 C0 . RET NZ +1C97 EA 92 1C ... JP PE,1C92 +1C9A C9 . RET ;----------- Auf Taste warten > A -- +1C9B 3E 01 >. LD A,01 ; Kanal 1 +1C9D CD 06 1F ... CALL 1F06 ; Auf Taste warten +1CA0 38 F9 8. JR C,1C9B ; Warten! +1CA2 FE 1B .. CP 1B ; ESC +1CA4 CA 74 15 .t. JP Z,1574 ; Zum Vortest Menue +1CA7 FE 20 . CP 20 ; +1CA9 D8 . RET C ; < Blank zurueck +1CAA 32 1E 1D 2.. LD (1D1E),A +1CAD F5 . PUSH AF +1CAE 21 1D 1D !.. LD HL,1D1D ; CRLF +1CB1 CD CA 6E ..n CALL 6ECA ; ausgeben +1CB4 F1 . POP AF +1CB5 C9 . RET ;----- incharety an Kanal 1 +1CB6 3E 01 >. LD A,01 +1CB8 CD 06 1F ... CALL 1F06 ; +1CBB D8 . RET C ; Wenn nichts da ist +1CBC FE 1B .. CP 1B +1CBE CA 74 15 .t. JP Z,1574 ; ESC --> Zum Vortest Menue +1CC1 C9 . RET ; -------- Zaehlpuffer loeschen +1CC2 21 20 20 ! LD HL,2020 +1CC5 22 AA 85 ".. LD (85AA),HL +1CC8 22 AC 85 ".. LD (85AC),HL +1CCB ED 5B F3 1C .[.. LD DE,(1CF3) +1CCF 13 . INC DE +1CD0 ED 53 F3 1C .S.. LD (1CF3),DE +1CD4 21 A9 85 !.. LD HL,85A9 +1CD7 CD 00 4E ..N CALL 4E00 ; Dezimal -- ASCII Konvertiereung +1CDA 21 9D 85 !.. LD HL,859D ; Puffer ausgeben +1CDD C3 CA 6E ..n JP 6ECA +1CE0 21 16 1D !.. LD HL,1D16 ; CRLF ausgeben +1CE3 C3 CA 6E ..n JP 6ECA +1CE6 00 . NOP +1CE7 00 . NOP +1CE8 00 . NOP +1CE9 00 . NOP +1CEA 00 . NOP +1CEB 00 . NOP +1CEC 00 . NOP +1CED 00 . NOP +1CEE 00 . NOP +1CEF 00 . NOP +1CF0 00 . NOP +1CF1 00 . NOP +1CF2 00 . NOP +1CF3 00 . NOP +1CF4 00 . NOP +1CF5 F5 . PUSH AF ;- Byte in A Hex --> (DE),(DE+1) +1CF6 0F . RRCA +1CF7 0F . RRCA +1CF8 0F . RRCA +1CF9 0F . RRCA +1CFA CD FE 1C ... CALL 1CFE +1CFD F1 . POP AF +1CFE E6 0F .. AND 0F +1D00 C6 30 .0 ADD A,30 +1D02 FE 3A .: CP 3A +1D04 38 02 8. JR C,1D08 +1D06 C6 07 .. ADD A,07 +1D08 12 . LD (DE),A +1D09 13 . INC DE +1D0A C9 . RET ; ------ Zeichentexte ------ +1D0B 01 2A 00 .*. LD BC,002A ; "*" Laenge 1 +1D0E 00 . NOP +1D0F 00 . NOP +1D10 00 . NOP +1D11 00 . NOP +1D12 00 . NOP +1D13 00 . NOP +1D14 01 20 02 . . LD BC,0220 ; Blank +1D17 0A . LD A,(BC) ; CRLF +1D18 0D . DEC C +1D19 03 . INC BC ; ", 1" +1D1A 2C , INC L +1D1B 20 31 1 JR NZ,1D4E +1D1D 04 . INC B ; Blank, CR, LF,LF +1D1E 20 0D . JR NZ,1D2D +1D20 0A . LD A,(BC) +1D21 0A . LD A,(BC) +1D22 07 . RLCA ; CR, "# " +1D23 0D . DEC C +1D24 23 # INC HL +1D25 20 20 JR NZ,1D47 +1D27 20 20 JR NZ,1D49 +1D29 20 45 E JR NZ,1D70 ; "EUMEL-" HG Kennzeichen +1D2B 55 U LD D,L +1D2C 4D M LD C,L +1D2D 45 E LD B,L +1D2E 4C L LD C,H +1D2F 2D - DEC L +1D30 00 . NOP +1D31 00 . NOP ; Harddisk Descriptor +1D32 00 . NOP +1D33 00 . NOP +1D34 00 . NOP +1D35 00 . NOP +1D36 1F . RRA ; Floppy Descriptor +1D37 00 . NOP +1D38 00 . NOP +1D39 00 . NOP +1D3A 00 . NOP +1D3B 00 . NOP +1D3C 00 . NOP +1D3D 00 . NOP +1D3E 00 . NOP +1D3F FF . RST 38 ; ====== Ende des nichtresidenten +1D40 FF . RST 38 ; EUMEL0 Teils ================== +1D41 FF . RST 38 +1D42 FF . RST 38 +1D43 FF . RST 38 +1D44 FF . RST 38 +1D45 FF . RST 38 +1D46 FF . RST 38 +1D47 FF . RST 38 +1D48 FF . RST 38 +1D49 FF . RST 38 +1D4A FF . RST 38 +1D4B FF . RST 38 +1D4C FF . RST 38 +1D4D FF . RST 38 +1D4E FF . RST 38 +1D4F FF . RST 38 +1D50 FF . RST 38 +1D51 FF . RST 38 +1D52 FF . RST 38 +1D53 FF . RST 38 +1D54 FF . RST 38 +1D55 FF . RST 38 +1D56 FF . RST 38 +1D57 FF . RST 38 +1D58 FF . RST 38 +1D59 FF . RST 38 +1D5A FF . RST 38 +1D5B FF . RST 38 +1D5C FF . RST 38 +1D5D FF . RST 38 +1D5E FF . RST 38 +1D5F FF . RST 38 +1D60 FF . RST 38 +1D61 FF . RST 38 +1D62 FF . RST 38 +1D63 FF . RST 38 +1D64 FF . RST 38 +1D65 FF . RST 38 +1D66 FF . RST 38 +1D67 FF . RST 38 +1D68 FF . RST 38 +1D69 FF . RST 38 +1D6A FF . RST 38 +1D6B FF . RST 38 +1D6C FF . RST 38 +1D6D FF . RST 38 +1D6E FF . RST 38 +1D6F FF . RST 38 +1D70 FF . RST 38 +1D71 FF . RST 38 +1D72 FF . RST 38 +1D73 FF . RST 38 +1D74 FF . RST 38 +1D75 FF . RST 38 +1D76 FF . RST 38 +1D77 FF . RST 38 +1D78 FF . RST 38 +1D79 FF . RST 38 +1D7A FF . RST 38 +1D7B FF . RST 38 +1D7C FF . RST 38 +1D7D FF . RST 38 +1D7E FF . RST 38 +1D7F FF . RST 38 +1D80 FF . RST 38 +1D81 FF . RST 38 +1D82 FF . RST 38 +1D83 FF . RST 38 +1D84 FF . RST 38 +1D85 FF . RST 38 +1D86 FF . RST 38 +1D87 FF . RST 38 +1D88 FF . RST 38 +1D89 FF . RST 38 +1D8A FF . RST 38 +1D8B FF . RST 38 +1D8C FF . RST 38 +1D8D FF . RST 38 +1D8E FF . RST 38 +1D8F FF . RST 38 +1D90 FF . RST 38 +1D91 FF . RST 38 +1D92 FF . RST 38 +1D93 FF . RST 38 +1D94 FF . RST 38 +1D95 FF . RST 38 +1D96 FF . RST 38 +1D97 FF . RST 38 +1D98 FF . RST 38 +1D99 FF . RST 38 +1D9A FF . RST 38 +1D9B FF . RST 38 +1D9C FF . RST 38 +1D9D FF . RST 38 +1D9E FF . RST 38 +1D9F FF . RST 38 +1DA0 FF . RST 38 +1DA1 FF . RST 38 +1DA2 FF . RST 38 +1DA3 FF . RST 38 +1DA4 FF . RST 38 +1DA5 FF . RST 38 +1DA6 FF . RST 38 +1DA7 FF . RST 38 +1DA8 FF . RST 38 +1DA9 FF . RST 38 +1DAA FF . RST 38 +1DAB FF . RST 38 +1DAC FF . RST 38 +1DAD FF . RST 38 +1DAE FF . RST 38 +1DAF FF . RST 38 +1DB0 FF . RST 38 +1DB1 FF . RST 38 +1DB2 FF . RST 38 +1DB3 FF . RST 38 +1DB4 FF . RST 38 +1DB5 FF . RST 38 +1DB6 FF . RST 38 +1DB7 FF . RST 38 +1DB8 FF . RST 38 +1DB9 FF . RST 38 +1DBA FF . RST 38 +1DBB FF . RST 38 +1DBC FF . RST 38 +1DBD FF . RST 38 +1DBE FF . RST 38 +1DBF FF . RST 38 +1DC0 FF . RST 38 +1DC1 FF . RST 38 +1DC2 FF . RST 38 +1DC3 FF . RST 38 +1DC4 FF . RST 38 +1DC5 FF . RST 38 +1DC6 FF . RST 38 +1DC7 FF . RST 38 +1DC8 FF . RST 38 +1DC9 FF . RST 38 +1DCA FF . RST 38 +1DCB FF . RST 38 +1DCC FF . RST 38 +1DCD FF . RST 38 +1DCE FF . RST 38 +1DCF FF . RST 38 +1DD0 FF . RST 38 +1DD1 FF . RST 38 +1DD2 FF . RST 38 +1DD3 FF . RST 38 +1DD4 FF . RST 38 +1DD5 FF . RST 38 +1DD6 FF . RST 38 +1DD7 FF . RST 38 +1DD8 FF . RST 38 +1DD9 FF . RST 38 +1DDA FF . RST 38 +1DDB FF . RST 38 +1DDC FF . RST 38 +1DDD FF . RST 38 +1DDE FF . RST 38 +1DDF FF . RST 38 +1DE0 FF . RST 38 +1DE1 FF . RST 38 +1DE2 FF . RST 38 +1DE3 FF . RST 38 +1DE4 FF . RST 38 +1DE5 FF . RST 38 +1DE6 FF . RST 38 +1DE7 FF . RST 38 +1DE8 FF . RST 38 +1DE9 FF . RST 38 +1DEA FF . RST 38 +1DEB FF . RST 38 +1DEC FF . RST 38 +1DED FF . RST 38 +1DEE FF . RST 38 +1DEF FF . RST 38 +1DF0 FF . RST 38 +1DF1 FF . RST 38 +1DF2 FF . RST 38 +1DF3 FF . RST 38 +1DF4 FF . RST 38 +1DF5 FF . RST 38 +1DF6 FF . RST 38 +1DF7 FF . RST 38 +1DF8 FF . RST 38 +1DF9 FF . RST 38 +1DFA FF . RST 38 +1DFB FF . RST 38 +1DFC FF . RST 38 +1DFD FF . RST 38 +1DFE FF . RST 38 +1DFF FF . RST 38 +1E00 FF . RST 38 ; ======= Residenter EUMEL0 ======= +1E01 FF . RST 38 ; DR EIntrag des DRDR +1E02 FF . RST 38 +1E03 FF . RST 38 +1E04 FF . RST 38 +1E05 FF . RST 38 +1E06 FF . RST 38 +1E07 FF . RST 38 +1E08 FF . RST 38 +1E09 FF . RST 38 +1E0A FF . RST 38 +1E0B FF . RST 38 +1E0C FF . RST 38 +1E0D FF . RST 38 +1E0E FF . RST 38 +1E0F FF . RST 38 ; ---------- 173 Leiste --------- +1E10 C3 DF 28 ..( JP 28DF ; systemstart 173 +1E13 C3 71 1F .q. JP 1F71 ; inputinterrupt +1E16 C3 35 6E .5n JP 6E35 ; timerinterrupt +1E19 C3 E2 6D ..m JP 6DE2 ; warte +1E1C C3 22 1E .". JP 1E22 ; frei eumel0 (nur 173) +1E1F C3 1F 70 ..p JP 701F ; info (Text uebergeben) +1E22 3A 6D 28 :m( LD A,(286D) ;----------- frei eumel0 --------- +1E25 CB C7 .. SET 0,A ; MODE Bit 0 setzen +1E27 32 6D 28 2m( LD (286D),A +1E2A C9 . RET ;-------------------------------- +1E2B FF . RST 38 +1E2C FF . RST 38 +1E2D FF . RST 38 +1E2E FF . RST 38 +1E2F FF . RST 38 +1E30 FF . RST 38 +1E31 FF . RST 38 +1E32 FF . RST 38 +1E33 FF . RST 38 +1E34 FF . RST 38 +1E35 FF . RST 38 +1E36 FF . RST 38 +1E37 FF . RST 38 +1E38 FF . RST 38 +1E39 FF . RST 38 +1E3A FF . RST 38 +1E3B FF . RST 38 +1E3C FF . RST 38 +1E3D FF . RST 38 +1E3E FF . RST 38 +1E3F FF . RST 38 +1E40 FF . RST 38 +1E41 FF . RST 38 +1E42 FF . RST 38 +1E43 FF . RST 38 +1E44 FF . RST 38 +1E45 FF . RST 38 +1E46 FF . RST 38 +1E47 FF . RST 38 +1E48 FF . RST 38 +1E49 FF . RST 38 +1E4A FF . RST 38 +1E4B 74 t LD (HL),H ; "trmnet 10 (!)" +1E4C 72 r LD (HL),D +1E4D 6D m LD L,L +1E4E 6E n LD L,(HL) +1E4F 65 e LD H,L +1E50 74 t LD (HL),H +1E51 20 20 JR NZ,1E73 +1E53 31 30 20 10 LD SP,2030 +1E56 28 21 (! JR Z,1E79 +1E58 29 ) ADD HL,HL ;---------- intern frout --------- +1E59 FE 11 .. CP 11 +1E5B D0 . RET NC +1E5C E5 . PUSH HL +1E5D CD EB 23 ..# CALL 23EB +1E60 CB 5E .^ BIT 3,(HL) +1E62 E1 . POP HL +1E63 28 02 (. JR Z,1E67 +1E65 97 . SUB A ; Ist Stop-Taste gedrueckt +1E66 C9 . RET +1E67 C5 . PUSH BC ; Weiter gedrueckt +1E68 01 02 00 ... LD BC,0002 ; IOCONTROL frout +1E6B CD A8 28 ..( CALL 28A8 +1E6E 79 y LD A,C +1E6F C1 . POP BC +1E70 C9 . RET ;-------- intern typ -------------- +1E71 32 B8 26 2.& LD (26B8),A +1E74 C5 . PUSH BC +1E75 01 01 00 ... LD BC,0001 ; IOCONTROL typ +1E78 CD A8 28 ..( CALL 28A8 +1E7B 79 y LD A,C +1E7C E6 03 .. AND 03 +1E7E FE 03 .. CP 03 +1E80 C1 . POP BC +1E81 3A B8 26 :.& LD A,(26B8) +1E84 C9 . RET ; ---------- cursorpos --> BC --- +1E85 FE 11 .. CP 11 +1E87 D0 . RET NC +1E88 E5 . PUSH HL +1E89 CD EB 23 ..# CALL 23EB ; Kanaltabellenaddresse +1E8C 01 02 00 ... LD BC,0002 +1E8F 09 . ADD HL,BC +1E90 4E N LD C,(HL) +1E91 23 # INC HL +1E92 46 F LD B,(HL) +1E93 E1 . POP HL +1E94 B7 . OR A +1E95 C9 . RET ;---------------------------------- +1E96 DD 7E 04 .~. LD A,(IX+04) ; Grosser Puffer leer ? +1E99 D6 01 .. SUB A,01 +1E9B 30 0B 0. JR NC,1EA8 +1E9D DD 7E 0B .~. LD A,(IX+0B) +1EA0 D6 01 .. SUB A,01 +1EA2 30 04 0. JR NC,1EA8 +1EA4 CD E4 1E ... CALL 1EE4 ; IOCONTROL weiter +1EA7 37 7 SCF +1EA8 C1 . POP BC +1EA9 DD E1 .. POP IX +1EAB E1 . POP HL +1EAC C9 . RET ;--------------------------------- +1EAD FE 11 .. CP 11 +1EAF 3F ? CCF +1EB0 D8 . RET C +1EB1 E5 . PUSH HL +1EB2 DD E5 .. PUSH IX +1EB4 C5 . PUSH BC +1EB5 32 AC 26 2.& LD (26AC),A +1EB8 CD FA 23 ..# CALL 23FA +1EBB 3A A9 26 :.& LD A,(26A9) +1EBE B7 . OR A +1EBF 28 11 (. JR Z,1ED2 +1EC1 F5 . PUSH AF +1EC2 97 . SUB A +1EC3 32 A9 26 2.& LD (26A9),A +1EC6 F1 . POP AF +1EC7 28 09 (. JR Z,1ED2 +1EC9 CD 1F 70 ..p CALL 701F +1ECC 18 04 .. JR 1ED2 +1ECE 20 69 i JR NZ,1F39 ; Info aufrufen +1ED0 6E n LD L,(HL) ; " int" +1ED1 74 t LD (HL),H +1ED2 DD 2A AD 26 .*.& LD IX,(26AD) +1ED6 CB 6E .n BIT 5,(HL) +1ED8 20 BC . JR NZ,1E96 ; Grosser Puffer +1EDA DD 7E 04 .~. LD A,(IX+04) ; Kleiner Puffer leer ? +1EDD FE 07 .. CP 07 +1EDF 28 15 (. JR Z,1EF6 +1EE1 B7 . OR A +1EE2 18 51 .Q JR 1F35 +1EE4 3A AC 26 :.& LD A,(26AC) ;---------- intern weiter -------- +1EE7 01 04 00 ... LD BC,0004 ; IOCONTROL weiter +1EEA C3 A8 28 ..( JP 28A8 +1EED C5 . PUSH BC ;---------- intern stop ----------- +1EEE 01 03 00 ... LD BC,0003 +1EF1 CD A8 28 ..( CALL 28A8 ; IOCONTORL stop +1EF4 C1 . POP BC +1EF5 C9 . RET ;---------------------------------- +1EF6 CD E4 1E ... CALL 1EE4 ; CALL weiter +1EF9 DD 7E 04 .~. LD A,(IX+04) ; +1EFC FE 07 .. CP 07 +1EFE 28 03 (. JR Z,1F03 ; Puffer leer ? +1F00 B7 . OR A +1F01 18 32 .2 JR 1F35 ; Routine mit CLC verlassen +1F03 37 7 SCF +1F04 18 2F ./ JR 1F35 ; ROutine mit SEC verlassen +1F06 CD AD 1E ... CALL 1EAD ;--------------------------------- +1F09 D8 . RET C +1F0A E5 . PUSH HL +1F0B DD E5 .. PUSH IX +1F0D C5 . PUSH BC +1F0E DD 2A AD 26 .*.& LD IX,(26AD) +1F12 DD 7E 07 .~. LD A,(IX+07) +1F15 DD CB 00 6E ...n BIT 5,(IX+00) +1F19 20 1F . JR NZ,1F3A +1F1B 2A AD 26 *.& LD HL,(26AD) +1F1E 01 07 00 ... LD BC,0007 +1F21 09 . ADD HL,BC +1F22 D5 . PUSH DE +1F23 54 T LD D,H +1F24 5D ] LD E,L +1F25 23 # INC HL +1F26 01 0F 00 ... LD BC,000F +1F29 F3 . DI +1F2A ED B0 .. LDIR +1F2C DD 35 .5 DEC (IX+04) +1F2E 04 . INC B +1F2F DD 35 .5 DEC (IX+05) +1F31 05 . DEC B +1F32 FB . EI +1F33 D1 . POP DE +1F34 B7 . OR A +1F35 C1 . POP BC +1F36 DD E1 .. POP IX +1F38 E1 . POP HL +1F39 C9 . RET +1F3A 67 g LD H,A ; Pufferaddresse +1F3B DD 6E 0C .n. LD L,(IX+0C) ; Pufferaddresse +1F3E CD 81 5A ..Z CALL 5A81 +1F41 DD 7E 05 .~. LD A,(IX+05) ; Lowbyte Schreibzeiger +1F44 3C < INC A +1F45 DD 77 05 .w. LD (IX+05),A +1F48 20 03 . JR NZ,1F4D +1F4A DD 34 .4 INC (IX+0A) ; Highbyte Schreibzeiger +1F4C 0A . LD A,(BC) +1F4D 6F o LD L,A +1F4E DD 7E 0A .~. LD A,(IX+0A) +1F51 E6 01 .. AND 01 +1F53 84 . ADD H +1F54 67 g LD H,A +1F55 7E ~ LD A,(HL) +1F56 F5 . PUSH AF +1F57 CD 8C 5A ..Z CALL 5A8C +1F5A F3 . DI +1F5B DD 6E 04 .n. LD L,(IX+04) ; Jetzt darf kein Inputinter. komm. +1F5E DD 66 0B .f. LD H,(IX+0B) +1F61 2B + DEC HL +1F62 DD 74 0B .t. LD (IX+0B),H +1F65 DD 75 04 .u. LD (IX+04),L +1F68 FB . EI +1F69 7D } LD A,L +1F6A B7 . OR A +1F6B CC E4 1E ... CALL Z,1EE4 ; CALL weiter +1F6E F1 . POP AF +1F6F 18 C3 .. JR 1F34 ;=========== inputinterrupt ======= +1F71 FE 11 .. CP 11 ; B=Eingabezeichen +1F73 D0 . RET NC ; C=Errorbits +1F74 DD E5 .. PUSH IX +1F76 E5 . PUSH HL +1F77 F5 . PUSH AF +1F78 CD EB 23 ..# CALL 23EB ; Kanaltabelleaddresse +1F7B E5 . PUSH HL +1F7C DD E1 .. POP IX +1F7E CB B9 .. RES 7,C ; +1F80 CB A9 .. RES 5,C ; Pufferoverflowbit +1F82 DD 7E 01 .~. LD A,(IX+01) +1F85 B1 . OR C ; Mit Bits vom Shard verodern +1F86 DD 77 01 .w. LD (IX+01),A +1F89 CB 7F .. BIT 7,A +1F8B 28 0A (. JR Z,1F97 +1F8D E5 . PUSH HL +1F8E DD CB 01 F6 .... SET 6,(IX+01) +1F92 21 A9 26 !.& LD HL,26A9 +1F95 34 4 INC (HL) +1F96 E1 . POP HL +1F97 DD CB 01 FE .... SET 7,(IX+01) +1F9B CB 6E .n BIT 5,(HL) ; Grosser Puffer ? +1F9D 28 6F (o JR Z,200E +1F9F DD 7E 0B .~. LD A,(IX+0B) ; ja +1FA2 FE 01 .. CP 01 +1FA4 38 0E 8. JR C,1FB4 ; < 1 (=0) : Nicht voll +1FA6 20 3A : JR NZ,1FE2 ; > 1 (=2) : Voll +1FA8 DD 7E 04 .~. LD A,(IX+04) ; = 180 , +1FAB FE 80 .. CP 80 ; Puffer 3/4b voll Hysterese Stop +1FAD 20 05 . JR NZ,1FB4 +1FAF F1 . POP AF +1FB0 F5 . PUSH AF +1FB1 CD ED 1E ... CALL 1EED ; CALL stop +1FB4 DD 34 .4 INC (IX+04) +1FB6 04 . INC B +1FB7 20 03 . JR NZ,1FBC +1FB9 DD 34 .4 INC (IX+0B) +1FBB 0B . DEC BC +1FBC DD 66 07 .f. LD H,(IX+07) +1FBF DD 6E 0C .n. LD L,(IX+0C) +1FC2 78 x LD A,B +1FC3 C5 . PUSH BC +1FC4 F5 . PUSH AF +1FC5 CD 81 5A ..Z CALL 5A81 +1FC8 DD 7E 08 .~. LD A,(IX+08) +1FCB 3C < INC A +1FCC DD 77 08 .w. LD (IX+08),A +1FCF 6F o LD L,A +1FD0 20 03 . JR NZ,1FD5 +1FD2 DD 34 .4 INC (IX+09) +1FD4 09 . ADD HL,BC +1FD5 DD 7E 09 .~. LD A,(IX+09) +1FD8 E6 01 .. AND 01 +1FDA 84 . ADD H +1FDB 67 g LD H,A +1FDC F1 . POP AF +1FDD 77 w LD (HL),A +1FDE CD 8C 5A ..Z CALL 5A8C +1FE1 C1 . POP BC +1FE2 DD CB 01 EE .... SET 5,(IX+01) ; Pufferoverflow setzen +1FE6 F1 . POP AF +1FE7 21 AB 26 !.& LD HL,26AB +1FEA CB B6 .. RES 6,(HL) +1FEC DD CB 01 BE .... RES 7,(IX+01) +1FF0 FB . EI +1FF1 DD CB 00 6E ...n BIT 5,(IX+00) ; Groer Puffer ? +1FF5 20 09 . JR NZ,2000 +1FF7 3E 17 >. LD A,17 ; Pufferende-Lesezeiger +1FF9 DD 96 04 ... SUB (IX+04) ; Platz im Puffer +1FFC E1 . POP HL +1FFD DD E1 .. POP IX +1FFF C9 . RET ;----------- Ende von inputinterr. +2000 DD 7E 0B .~. LD A,(IX+0B) +2003 B7 . OR A +2004 3E FF >. LD A,FF +2006 28 F4 (. JR Z,1FFC +2008 97 . SUB A +2009 DD 96 04 ... SUB (IX+04) +200C 18 EE .. JR 1FFC +200E F1 . POP AF ;------ kleiner Puffer ------------ +200F F5 . PUSH AF +2010 CD 95 26 ..& CALL 2695 ; Typtabellennummer +2013 FE 7E .~ CP 7E ; psi ? +2015 20 29 ) JR NZ,2040 +2017 78 x LD A,B ; info-Taste +2018 FE 04 .. CP 04 +201A 28 18 (. JR Z,2034 +201C FE 07 .. CP 07 ; SV-Call +201E 28 1A (. JR Z,203A +2020 FE 11 .. CP 11 ; Stop +2022 28 0A (. JR Z,202E +2024 FE 17 .. CP 17 ; Weiter +2026 20 18 . JR NZ,2040 +2028 DD CB 00 9E .... RES 3,(IX+00) ; Weiter gedrueckt +202C 18 B8 .. JR 1FE6 +202E DD CB 00 DE .... SET 3,(IX+00) ; Stop gedrueckt +2032 18 B2 .. JR 1FE6 +2034 F1 . POP AF ; info-taste gedrueckt +2035 CD 33 6F .3o CALL 6F33 +2038 18 AD .. JR 1FE7 +203A F1 . POP AF ; SV-Call gedrueckt +203B CD 93 4C ..L CALL 4C93 ; SV-Call zustellen +203E 18 A7 .. JR 1FE7 +2040 C5 . PUSH BC ; nicht psi als tabelle +2041 DD 7E 05 .~. LD A,(IX+05) ; Schreibzeiger >= 16H ? +2044 FE 16 .. CP 16 +2046 D2 F2 20 .. JP NC,20F2 ; Pufferoverflow setzen +2049 21 AB 26 !.& LD HL,26AB +204C CB F6 .. SET 6,(HL) +204E 4F O LD C,A +204F 06 00 .. LD B,00 +2051 DD E5 .. PUSH IX +2053 E1 . POP HL +2054 09 . ADD HL,BC +2055 C1 . POP BC +2056 70 p LD (HL),B +2057 23 # INC HL +2058 36 FF 6. LD (HL),FF +205A DD 34 .4 INC (IX+05) ; Schreibzeiger +205C 05 . DEC B +205D FE 0E .. CP 0E +205F 20 0E . JR NZ,206F +2061 F1 . POP AF +2062 F5 . PUSH AF +2063 CD 95 26 ..& CALL 2695 +2066 CB 7E .~ BIT 7,(HL) +2068 28 05 (. JR Z,206F +206A F1 . POP AF +206B F5 . PUSH AF +206C CD ED 1E ... CALL 1EED +206F F1 . POP AF +2070 F5 . PUSH AF +2071 CD 95 26 ..& CALL 2695 +2074 FE 7E .~ CP 7E +2076 D2 EB 20 .. JP NC,20EB +2079 CD 1F 24 ..$ CALL 241F +207C D5 . PUSH DE +207D C5 . PUSH BC +207E 01 80 01 ... LD BC,0180 +2081 09 . ADD HL,BC +2082 E5 . PUSH HL +2083 EB . EX DE,HL +2084 DD E5 .. PUSH IX +2086 E1 . POP HL +2087 DD 4E 04 .N. LD C,(IX+04) +208A 06 00 .. LD B,00 +208C 09 . ADD HL,BC +208D 1A . LD A,(DE) ; Zeichen an Lesezeigerposition holen +208E 13 . INC DE +208F 3C < INC A +2090 F5 . PUSH AF +2091 20 04 . JR NZ,2097 +2093 1A . LD A,(DE) ; Zeichen = FF ? +2094 3C < INC A +2095 28 38 (8 JR Z,20CF +2097 E5 . PUSH HL +2098 EB . EX DE,HL +2099 1A . LD A,(DE) +209A ED A1 .. CPI +209C 20 24 $ JR NZ,20C2 +209E 13 . INC DE +209F 3C < INC A +20A0 20 F7 . JR NZ,2099 +20A2 E1 . POP HL +20A3 F1 . POP AF +20A4 3D = DEC A +20A5 FE 11 .. CP 11 ; Weiter +20A7 CA 1C 21 ..! JP Z,211C +20AA FE 04 .. CP 04 ; Info +20AC 28 56 (V JR Z,2104 +20AE FE 07 .. CP 07 ; SV-Call +20B0 28 5E (^ JR Z,2110 +20B2 FE 17 .. CP 17 ; Stop +20B4 CA 22 21 ."! JP Z,2122 +20B7 77 w LD (HL),A ; Anderer Eingabecode +20B8 DD 34 .4 INC (IX+04) ; Lese-Zeiger weitersetzen +20BA 04 . INC B +20BB 23 # INC HL +20BC CD 2F 21 ./! CALL 212F +20BF E1 . POP HL +20C0 18 1B .. JR 20DD +20C2 3C < INC A +20C3 28 1C (. JR Z,20E1 +20C5 7E ~ LD A,(HL) +20C6 23 # INC HL +20C7 3C < INC A +20C8 20 FB . JR NZ,20C5 +20CA EB . EX DE,HL +20CB E1 . POP HL +20CC F1 . POP AF +20CD 18 BE .. JR 208D +20CF F1 . POP AF +20D0 E1 . POP HL +20D1 DD 34 .4 INC (IX+04) +20D3 04 . INC B +20D4 DD 7E 04 .~. LD A,(IX+04) ; Lesezeiger = Schreibzeiger ? +20D7 DD BE 05 ... CP (IX+05) +20DA C2 82 20 .. JP NZ,2082 +20DD C1 . POP BC +20DE D1 . POP DE +20DF 18 0D .. JR 20EE +20E1 3E 02 >. LD A,02 +20E3 32 AB 26 2.& LD (26AB),A +20E6 E1 . POP HL +20E7 F1 . POP AF +20E8 E1 . POP HL +20E9 18 F2 .. JR 20DD +20EB DD 34 .4 INC (IX+04) ; Zeiger weitersetzen +20ED 04 . INC B +20EE F1 . POP AF +20EF C3 E7 1F ... JP 1FE7 +20F2 DD CB 01 EE .... SET 5,(IX+01) ; Bit 5 : Puffer overflow +20F6 DD 7E 04 .~. LD A,(IX+04) ; Schreibzeiger := Lesezeiger +20F9 DD 77 05 .w. LD (IX+05),A +20FC 3E 03 >. LD A,03 +20FE 32 AB 26 2.& LD (26AB),A +2101 C1 . POP BC +2102 18 EA .. JR 20EE ;-------------- Info-Taste -------- +2104 CD 2F 21 ./! CALL 212F +2107 E1 . POP HL +2108 C1 . POP BC +2109 D1 . POP DE +210A F1 . POP AF +210B CD 33 6F .3o CALL 6F33 +210E 18 DF .. JR 20EF ;--------------- SV-Call --------- +2110 CD 2F 21 ./! CALL 212F +2113 E1 . POP HL +2114 C1 . POP BC +2115 D1 . POP DE +2116 F1 . POP AF +2117 CD 93 4C ..L CALL 4C93 +211A 18 D3 .. JR 20EF ;-------------- Weiter-Taste ------ +211C DD CB 00 DE .... SET 3,(IX+00) ; Weiterbit setzen +2120 18 04 .. JR 2126 ;-------------- Stop-Taste -------- +2122 DD CB 00 9E .... RES 3,(IX+00) ; +2126 CD 2F 21 ./! CALL 212F +2129 E1 . POP HL +212A C1 . POP BC +212B D1 . POP DE +212C F1 . POP AF +212D 18 C0 .. JR 20EF +212F DD 7E 04 .~. LD A,(IX+04) ; Schreibzeiger := Lesezeiger +2132 DD 77 05 .w. LD (IX+05),A +2135 3E FF >. LD A,FF ; Puffer bis zum Ende mit FF fuellen +2137 77 w LD (HL),A +2138 23 # INC HL +2139 7B { LD A,E +213A BD . CP L +213B 20 F8 . JR NZ,2135 +213D C9 . RET ; ------ Test ob Puffer overflow +213E F5 . PUSH AF +213F E5 . PUSH HL +2140 21 B2 26 !.& LD HL,26B2 +2143 CB 7E .~ BIT 7,(HL) +2145 28 02 (. JR Z,2149 +2147 86 . ADD (HL) +2148 77 w LD (HL),A +2149 3A AB 26 :.& LD A,(26AB) +214C 3D = DEC A +214D FA 85 21 ..! JP M,2185 +2150 32 AB 26 2.& LD (26AB),A +2153 20 30 0 JR NZ,2185 +2155 DD E5 .. PUSH IX +2157 D5 . PUSH DE +2158 C5 . PUSH BC +2159 11 18 00 ... LD DE,0018 +215C 3E 01 >. LD A,01 ; Beginne mit Kanal 1 +215E CD EB 23 ..# CALL 23EB ; Zeiger auf Kanaltabelle --> HL +2161 06 10 .. LD B,10 ; Fuer 16 Kanaele +2163 E5 . PUSH HL +2164 DD E1 .. POP IX +2166 DD CB 00 6E ...n BIT 5,(IX+00) ; Groer Puffer +216A 20 11 . JR NZ,217D ; kein overflow +216C F3 . DI +216D DD 7E 05 .~. LD A,(IX+05) ; Schreibzeiger >= 16H ? +2170 FE 16 .. CP 16 +2172 38 05 8. JR C,2179 +2174 3E 13 >. LD A,13 ; zuruecksetzen auf 13 +2176 DD 77 05 .w. LD (IX+05),A +2179 DD 77 04 .w. LD (IX+04),A +217C FB . EI +217D DD 19 .. ADD IX,DE ; Next entry +217F 10 E5 .. DJNZ 2166 +2181 C1 . POP BC +2182 D1 . POP DE +2183 DD E1 .. POP IX +2185 E1 . POP HL +2186 F1 . POP AF +2187 C9 . RET ;----------- OUTPUT ------------ +2188 FE 11 .. CP 11 +218A D2 7B 28 .{( JP NC,287B +218D F5 . PUSH AF +218E DD E5 .. PUSH IX +2190 32 AC 26 2.& LD (26AC),A +2193 E5 . PUSH HL +2194 CD 95 26 ..& CALL 2695 +2197 D2 3A 22 .:" JP NC,223A +219A 32 B1 26 2.& LD (26B1),A +219D 3A AC 26 :.& LD A,(26AC) +21A0 CD FA 23 ..# CALL 23FA +21A3 DD 2A AD 26 .*.& LD IX,(26AD) +21A7 7E ~ LD A,(HL) +21A8 E6 0B .. AND 0B +21AA 28 24 ($ JR Z,21D0 +21AC CB 5F ._ BIT 3,A +21AE 20 0C . JR NZ,21BC +21B0 CB 47 .G BIT 0,A +21B2 28 13 (. JR Z,21C7 +21B4 3A AC 26 :.& LD A,(26AC) +21B7 CD 59 1E .Y. CALL 1E59 +21BA 38 09 8. JR C,21C5 +21BC E1 . POP HL +21BD DD E1 .. POP IX +21BF F1 . POP AF +21C0 01 00 00 ... LD BC,0000 +21C3 B7 . OR A +21C4 C9 . RET +21C5 CB 86 .. RES 0,(HL) +21C7 3A B2 26 :.& LD A,(26B2) +21CA CB 7F .. BIT 7,A +21CC 20 EE . JR NZ,21BC +21CE CB 8E .. RES 1,(HL) +21D0 E1 . POP HL +21D1 D5 . PUSH DE +21D2 E5 . PUSH HL +21D3 3A B1 26 :.& LD A,(26B1) +21D6 CD 1F 24 ..$ CALL 241F +21D9 54 T LD D,H +21DA 5D ] LD E,L +21DB E1 . POP HL +21DC E5 . PUSH HL +21DD C5 . PUSH BC +21DE 78 x LD A,B +21DF B1 . OR C +21E0 20 08 . JR NZ,21EA +21E2 C1 . POP BC +21E3 E1 . POP HL +21E4 D1 . POP DE +21E5 DD E1 .. POP IX +21E7 F1 . POP AF +21E8 37 7 SCF +21E9 C9 . RET +21EA E5 . PUSH HL +21EB 7E ~ LD A,(HL) +21EC 2A AD 26 *.& LD HL,(26AD) +21EF CB 56 .V BIT 2,(HL) +21F1 28 0F (. JR Z,2202 +21F3 CB 66 .f BIT 4,(HL) +21F5 CA 07 23 ..# JP Z,2307 +21F8 CB A6 .. RES 4,(HL) +21FA 23 # INC HL +21FB 23 # INC HL +21FC 77 w LD (HL),A +21FD E1 . POP HL +21FE 23 # INC HL +21FF 0B . DEC BC +2200 18 DC .. JR 21DE +2202 E1 . POP HL +2203 E5 . PUSH HL +2204 C5 . PUSH BC +2205 3A B1 26 :.& LD A,(26B1) +2208 FE 7E .~ CP 7E +220A 28 35 (5 JR Z,2241 +220C E5 . PUSH HL +220D 6E n LD L,(HL) +220E 26 00 &. LD H,00 +2210 19 . ADD HL,DE +2211 7E ~ LD A,(HL) +2212 3C < INC A +2213 20 38 8 JR NZ,224D +2215 E1 . POP HL +2216 ED A1 .. CPI +2218 EA 0C 22 .." JP PE,220C +221B C1 . POP BC +221C E1 . POP HL +221D C5 . PUSH BC +221E 3A AC 26 :.& LD A,(26AC) +2221 CD 7B 28 .{( CALL 287B +2224 F5 . PUSH AF +2225 DD 7E 03 .~. LD A,(IX+03) ; xpos INCR C +2228 81 . ADD C +2229 DD 77 03 .w. LD (IX+03),A +222C F1 . POP AF +222D D2 CE 23 ..# JP NC,23CE +2230 09 . ADD HL,BC +2231 E3 . EX (SP),HL +2232 B7 . OR A +2233 ED 42 .B SBC HL,BC +2235 44 D LD B,H +2236 4D M LD C,L +2237 E1 . POP HL +2238 18 A4 .. JR 21DE +223A E1 . POP HL +223B DD E1 .. POP IX +223D F1 . POP AF +223E C3 7B 28 .{( JP 287B +2241 3E 0D >. LD A,0D +2243 BE . CP (HL) +2244 30 08 0. JR NC,224E +2246 ED A1 .. CPI +2248 EA 43 22 .C" JP PE,2243 +224B 18 CE .. JR 221B +224D E1 . POP HL +224E 7E ~ LD A,(HL) +224F E1 . POP HL +2250 E5 . PUSH HL +2251 B7 . OR A +2252 ED 42 .B SBC HL,BC +2254 28 06 (. JR Z,225C +2256 44 D LD B,H +2257 4D M LD C,L +2258 E1 . POP HL +2259 E3 . EX (SP),HL +225A 18 C2 .. JR 221E +225C F5 . PUSH AF +225D 3A AC 26 :.& LD A,(26AC) +2260 C5 . PUSH BC +2261 01 02 00 ... LD BC,0002 ; IOCONTROL frout +2264 CD A8 28 ..( CALL 28A8 +2267 79 y LD A,C +2268 C1 . POP BC +2269 FE 10 .. CP 10 +226B DA E6 23 ..# JP C,23E6 +226E F1 . POP AF +226F CD 79 22 .y" CALL 2279 +2272 C1 . POP BC +2273 E1 . POP HL +2274 0B . DEC BC +2275 23 # INC HL +2276 C3 DE 21 ..! JP 21DE ;-------- cursor mitfuehren ------ +2279 FE 06 .. CP 06 +227B CA FF 22 .." JP Z,22FF +227E 38 54 8T JR C,22D4 +2280 FE 08 .. CP 08 ; Left +2282 28 15 (. JR Z,2299 +2284 FE 07 .. CP 07 ; Bell: Keine Veraenderung +2286 28 5B ([ JR Z,22E3 +2288 FE 0A .. CP 0A ; LF +228A 28 12 (. JR Z,229E +228C DD 34 .4 INC (IX+03) ; Alles andere wie right +228E 03 . INC BC +228F FE 0D .. CP 0D ; CR +2291 20 50 P JR NZ,22E3 +2293 DD 36 03 00 .6.. LD (IX+03),00 +2297 18 4A .J JR 22E3 +2299 DD 35 .5 DEC (IX+03) +229B 03 . INC BC +229C 18 45 .E JR 22E3 +229E F5 . PUSH AF +229F DD 7E 02 .~. LD A,(IX+02) ; ypos des cursors +22A2 DD BE 06 ... CP (IX+06) ; max. ypos (wird mit ysize ges.) +22A5 28 03 (. JR Z,22AA +22A7 DD 34 .4 INC (IX+02) ; ypos +1 +22A9 02 . LD (BC),A +22AA F1 . POP AF +22AB 18 36 .6 JR 22E3 +22AD E5 . PUSH HL +22AE 23 # INC HL +22AF CD 5F 23 ._# CALL 235F +22B2 E1 . POP HL +22B3 7E ~ LD A,(HL) +22B4 B7 . OR A +22B5 C8 . RET Z +22B6 2A AD 26 *.& LD HL,(26AD) +22B9 CB C6 .. SET 0,(HL) +22BB CB CE .. SET 1,(HL) +22BD 3E 81 >. LD A,81 +22BF 32 B2 26 2.& LD (26B2),A +22C2 C3 E0 23 ..# JP 23E0 +22C5 DD 36 02 00 .6.. LD (IX+02),00 +22C9 DD 36 03 00 .6.. LD (IX+03),00 +22CD 18 14 .. JR 22E3 +22CF DD 34 .4 INC (IX+03) +22D1 03 . INC BC +22D2 18 0F .. JR 22E3 +22D4 FE 01 .. CP 01 ; Home ? +22D6 28 ED (. JR Z,22C5 +22D8 FE 02 .. CP 02 ; Right ? +22DA 28 F3 (. JR Z,22CF +22DC FE 03 .. CP 03 ; Up +22DE 20 03 . JR NZ,22E3 +22E0 DD 35 .5 DEC (IX+02) ; ypos-1 +22E2 02 . LD (BC),A +22E3 6F o LD L,A +22E4 3A B1 26 :.& LD A,(26B1) +22E7 FE 7E .~ CP 7E +22E9 20 04 . JR NZ,22EF +22EB 7D } LD A,L +22EC C3 B8 23 ..# JP 23B8 +22EF 26 00 &. LD H,00 +22F1 19 . ADD HL,DE +22F2 7E ~ LD A,(HL) +22F3 FE 80 .. CP 80 +22F5 DA B8 23 ..# JP C,23B8 +22F8 D6 80 .. SUB A,80 +22FA 62 b LD H,D +22FB 6F o LD L,A +22FC 24 $ INC H +22FD 18 AE .. JR 22AD ;---------- cursor (x,y) ---------- +22FF 2A AD 26 *.& LD HL,(26AD) +2302 CB D6 .. SET 2,(HL) +2304 CB E6 .. SET 4,(HL) +2306 C9 . RET ;--------------------------------- +2307 23 # INC HL +2308 23 # INC HL +2309 23 # INC HL +230A 77 w LD (HL),A +230B 3A B1 26 :.& LD A,(26B1) +230E FE 7E .~ CP 7E ; psi ? +2310 20 11 . JR NZ,2323 +2312 3E 06 >. LD A,06 ; Code 6 +2314 CD B8 23 ..# CALL 23B8 +2317 2B + DEC HL +2318 7E ~ LD A,(HL) ; y pos +2319 CD B8 23 ..# CALL 23B8 +231C 23 # INC HL +231D 7E ~ LD A,(HL) ; x pos +231E CD B8 23 ..# CALL 23B8 +2321 18 31 .1 JR 2354 +2323 14 . INC D +2324 1A . LD A,(DE) +2325 15 . DEC D +2326 3C < INC A +2327 20 0E . JR NZ,2337 +2329 DD 7E 03 .~. LD A,(IX+03) ; alte xpos +232C D6 50 .P SUB A,50 ; 80 Spalten Umbruch +232E 38 07 8. JR C,2337 +2330 DD CB 02 F6 .... SET 6,(IX+02) +2334 DD 77 03 .w. LD (IX+03),A +2337 C5 . PUSH BC +2338 21 06 00 !.. LD HL,0006 ; Cursorstringcode = 6 +233B 19 . ADD HL,DE +233C 7E ~ LD A,(HL) ; Ist immer ein outstring +233D CB BF .. RES 7,A +233F 24 $ INC H ; Outstringpage +2340 6F o LD L,A +2341 2C , INC L ; keine wartezeit +2342 CD 5F 23 ._# CALL 235F ; prestring ausgeben +2345 23 # INC HL +2346 CD 6C 23 .l# CALL 236C ; x/y pos ausgeben +2349 CD 5F 23 ._# CALL 235F ; midstring ausgeben +234C 23 # INC HL +234D CD 6C 23 .l# CALL 236C ; x/y pos ausgeben +2350 CD 5F 23 ._# CALL 235F ; poststring ausgeben +2353 C1 . POP BC ; naechstes zeichen interpretieren +2354 2A AD 26 *.& LD HL,(26AD) +2357 CB 96 .. RES 2,(HL) +2359 E1 . POP HL +235A 23 # INC HL +235B 0B . DEC BC +235C C3 DE 21 ..! JP 21DE ; string ausgeben (mit 0 am ende) +235F 06 46 .F LD B,46 ; max 70 zeichen +2361 7E ~ LD A,(HL) +2362 B7 . OR A +2363 28 06 (. JR Z,236B +2365 CD B8 23 ..# CALL 23B8 ; char out +2368 23 # INC HL +2369 10 F6 .. DJNZ 2361 +236B C9 . RET ;----------- x/y pos out --------- +236C 7E ~ LD A,(HL) ; zeichen "x" oder "y" +236D E5 . PUSH HL +236E 2A AD 26 *.& LD HL,(26AD) ; zeiger auf x pos (26ad)+2 +2371 23 # INC HL +2372 23 # INC HL +2373 FE 79 .y CP 79 ; "y" Kennzeichen +2375 28 01 (. JR Z,2378 +2377 23 # INC HL ; ypos +2378 46 F LD B,(HL) ; neue position --> B +2379 FD E5 .. PUSH IY +237B 14 . INC D ; +237C D5 . PUSH DE +237D FD E1 .. POP IY +237F 15 . DEC D +2380 FE 79 .y CP 79 ; "y" Kennzeichen +2382 28 02 (. JR Z,2386 +2384 FD 23 .# INC IY +2386 FD 7E 02 .~. LD A,(IY+02) ; Offset + pos +2389 80 . ADD B +238A FD CB 00 56 ...V BIT 2,(IY+00) ; Keine Konvertierung +238E 20 0C . JR NZ,239C +2390 FD CB 00 46 ...F BIT 0,(IY+00) ; Dezimale ASCII-Ausgabe +2394 20 0E . JR NZ,23A4 +2396 FE 0C .. CP 0C ; Elbit Cursor +2398 38 02 8. JR C,239C +239A C6 04 .. ADD A,04 ; ywert +239C CD B8 23 ..# CALL 23B8 ; Byte ausgeben +239F FD E1 .. POP IY +23A1 E1 . POP HL +23A2 23 # INC HL +23A3 C9 . RET ;--------- Dezimal ausgeben ------- +23A4 D5 . PUSH DE +23A5 5F _ LD E,A +23A6 16 00 .. LD D,00 +23A8 21 A4 26 !.& LD HL,26A4 ; Zwischenspeicheraddresse +23AB CD 00 4E ..N CALL 4E00 ; String uebertragen +23AE 41 A LD B,C ; Laengebyte +23AF 21 A4 26 !.& LD HL,26A4 ; Startaddresse des Strings +23B2 CD 61 23 .a# CALL 2361 ; String ausgeben +23B5 D1 . POP DE +23B6 18 E7 .. JR 239F ; Return +23B8 E5 . PUSH HL +23B9 C5 . PUSH BC +23BA 21 AA 26 !.& LD HL,26AA +23BD 77 w LD (HL),A +23BE 01 01 00 ... LD BC,0001 +23C1 3A AC 26 :.& LD A,(26AC) +23C4 CD 7B 28 .{( CALL 287B +23C7 78 x LD A,B +23C8 B1 . OR C +23C9 28 F3 (. JR Z,23BE +23CB C1 . POP BC +23CC E1 . POP HL +23CD C9 . RET +23CE E1 . POP HL +23CF B7 . OR A +23D0 ED 42 .B SBC HL,BC +23D2 E3 . EX (SP),HL +23D3 C1 . POP BC +23D4 B7 . OR A +23D5 ED 42 .B SBC HL,BC +23D7 44 D LD B,H +23D8 4D M LD C,L +23D9 E1 . POP HL +23DA D1 . POP DE +23DB DD E1 .. POP IX +23DD F1 . POP AF +23DE B7 . OR A +23DF C9 . RET +23E0 C1 . POP BC +23E1 E1 . POP HL +23E2 2B + DEC HL +23E3 C1 . POP BC +23E4 18 EC .. JR 23D2 +23E6 E1 . POP HL +23E7 E1 . POP HL +23E8 C1 . POP BC +23E9 18 E7 .. JR 23D2 ;----- Zeiger auf Kanaltabelle +23EB D5 . PUSH DE +23EC C5 . PUSH BC +23ED 21 B1 26 !.& LD HL,26B1 +23F0 47 G LD B,A +23F1 11 18 00 ... LD DE,0018 ; 24 Bytes lang ein entry +23F4 19 . ADD HL,DE +23F5 10 FD .. DJNZ 23F4 +23F7 C1 . POP BC +23F8 D1 . POP DE +23F9 C9 . RET +23FA CD EB 23 ..# CALL 23EB +23FD 22 AD 26 ".& LD (26AD),HL +2400 C9 . RET ;--------- Typtabellennummeraddr->HL +2401 FE 7E .~ CP 7E ; psi +2403 C8 . RET Z +2404 FE 05 .. CP 05 ; Tabellennummer >= 5 ? +2406 38 0E 8. JR C,2416 +2408 CD 1F 70 ..p CALL 701F ; Info aufrufen +240B 18 09 .. JR 2416 ; " lst ovfl" +240D 20 6C l JR NZ,247B +240F 73 s LD (HL),E +2410 74 t LD (HL),H +2411 20 6F o JR NZ,2482 +2413 76 v HALT +2414 66 f LD H,(HL) +2415 6C l LD L,H +2416 21 B3 26 !.& LD HL,26B3 +2419 85 . ADD L +241A 6F o LD L,A +241B 30 01 0. JR NC,241E +241D 24 $ INC H +241E C9 . RET ;------ Addresse der Typtabelle -- +241F CD 01 24 ..$ CALL 2401 +2422 66 f LD H,(HL) +2423 2E 00 .. LD L,00 +2425 C9 . RET ;--Typt.Block reservieren ------- +2426 E5 . PUSH HL +2427 D5 . PUSH DE +2428 CD 42 5E .B^ CALL 5E42 ; Block freimachen +242B 7D } LD A,L +242C 87 . ADD A ; * 2 +242D D1 . POP DE +242E E1 . POP HL +242F 77 w LD (HL),A ; Pufferaddresse (Block)eintragen +2430 C9 . RET +2431 F1 . POP AF +2432 01 FF FF ... LD BC,FFFF ; Returncode -1 +2435 C9 . RET ; ---- 173/175 Shard-IOCONTROL ----- +2436 F5 . PUSH AF +2437 3A 6B 28 :k( LD A,(286B) ; Shardversion +243A FE 06 .. CP 06 ; 173 Shard +243C 38 F3 8. JR C,2431 ; < 6 : control geht nicht +243E FE 08 .. CP 08 +2440 30 0A 0. JR NC,244C ; >= 8 : keine Registerverlagerung +2442 F1 . POP AF ; 173: Register umdrehen +2443 61 a LD H,C ; H = Schlssel (>=8: HL=Schlssel) +2444 42 B LD B,D ; BC = Funktionsnummer +2445 4B K LD C,E ; L war schon addressierter Kanal +2446 11 00 00 ... LD DE,0000 ; DE = Funktionscode 1 (nicht in <8) +2449 C3 A8 28 ..( JP 28A8 ; IOCONTROL an Shard geben +244C F1 . POP AF ; --- 175 Shard-IOCONTROL ---------- +244D C5 . PUSH BC +244E 42 B LD B,D ; Funktionsnummer nach BC +244F 4B K LD C,E +2450 54 T LD D,H ; Code 1 nach DE +2451 5D ] LD E,L +2452 E1 . POP HL ; Code 2 nach HL +2453 C3 A8 28 ..( JP 28A8 ; ---- CONTROL (DE,HL,BC,res BC) ---- +2456 CB 7A .z BIT 7,D +2458 20 F3 . JR NZ,244D +245A F5 . PUSH AF +245B 7B { LD A,E ; Control 6: flow (kanal. +245C FE 06 .. CP 06 +245E CA 24 25 .$% JP Z,2524 +2461 FE 08 .. CP 08 ; Control 8: baud (kanal,schlssl,res) +2463 28 D2 (. JR Z,2437 +2465 FE 09 .. CP 09 ; Control 9: bits (kanal,schlssl,res) +2467 28 CE (. JR Z,2437 +2469 FE 0A .. CP 0A ; Control 10: calendar (field,0,bcd) +246B 28 1B (. JR Z,2488 +246D FE 0C .. CP 0C ; Control 12: xmiterror (0,0,err) +246F 20 1E . JR NZ,248F ;--------- IOCONTROL 12 ---------- +2471 0E 3F .? LD C,3F +2473 3A 6B 28 :k( LD A,(286B) +2476 FE 08 .. CP 08 ; Shard Version >= 8 ? +2478 30 02 0. JR NC,247C +247A 0E 20 . LD C,20 ; Nur Puffer uebergelaufen +247C F1 . POP AF +247D CD EB 23 ..# CALL 23EB ; Zeiger auf Kanaltabelle +2480 23 # INC HL +2481 7E ~ LD A,(HL) +2482 A1 . AND C +2483 4F O LD C,A +2484 06 00 .. LD B,00 +2486 70 p LD (HL),B +2487 C9 . RET ; ----- IOCONTROL calendar --------- +2488 3A 6B 28 :k( LD A,(286B) +248B FE 08 .. CP 08 ; Shard Vers >= 8 ? +248D 38 A2 8. JR C,2431 ; nein, Return -1 +248F F1 . POP AF ; ------ +2490 FE 20 . CP 20 ; Parameterkanal ? +2492 28 0E (. JR Z,24A2 +2494 F5 . PUSH AF ; Kein Parameterkanal +2495 7B { LD A,E +2496 FE 05 .. CP 05 ; Funktion 5: size +2498 28 04 (. JR Z,249E +249A FE 07 .. CP 07 ; Funktion 7: format +249C 20 AE . JR NZ,244C +249E F1 . POP AF +249F C3 2A 64 .*d JP 642A ; bergeben an PROZ ARCH +24A2 7B { LD A,E ; Am Parameterkanal +24A3 FE 01 .. CP 01 ; Funktion 1: typtab(kanal,typnr,res) +24A5 28 65 (e JR Z,250C +24A7 FE 02 .. CP 02 ; Funktion 2: inbuffsize(kanal,size,res) +24A9 28 06 (. JR Z,24B1 +24AB FE 0B .. CP 0B ; Funktion 11: ysize(kanal,ysize,res) +24AD CA 3C 25 .<% JP Z,253C +24B0 C9 . RET ;--- CONTROL inputbuffersize ------ +24B1 7D } LD A,L ; Funktion 2 : +24B2 FE 11 .. CP 11 +24B4 D0 . RET NC ; Kanal < 17 ? +24B5 CD EB 23 ..# CALL 23EB ; Zeiger auf Kanaltabelle berechnen +24B8 78 x LD A,B ; > 255 ? +24B9 FE 01 .. CP 01 +24BB 30 22 0" JR NC,24DF +24BD CB 6E .n BIT 5,(HL) ; inputbuffersize < 256 +24BF C8 . RET Z ; schon eingestellt +24C0 DD E5 .. PUSH IX +24C2 E5 . PUSH HL +24C3 DD E1 .. POP IX +24C5 DD 66 07 .f. LD H,(IX+07) ; 7 = Blockaddresse +24C8 DD 6E 0C .n. LD L,(IX+0C) +24CB CD 0B 5E ..^ CALL 5E0B ; Alten Pufferblock freigeben +24CE F3 . DI +24CF DD 36 00 00 .6.. LD (IX+00),00 ; Jetzt kleiner Puffer ohne Flussk. +24D3 DD 36 04 07 .6.. LD (IX+04),07 ; Zeiger auf Pufferanfang +24D7 FB . EI +24D8 DD 36 05 07 .6.. LD (IX+05),07 +24DC DD E1 .. POP IX +24DE C9 . RET ;---- Grosser Puffer -------------- +24DF CB 6E .n BIT 5,(HL) +24E1 C0 . RET NZ ; war schon > 255 eingestellt +24E2 DD E5 .. PUSH IX +24E4 E5 . PUSH HL +24E5 CD 18 5E ..^ CALL 5E18 ; Block freimachen fuer Puffer +24E8 DD E1 .. POP IX +24EA F3 . DI +24EB DD CB 00 EE .... SET 5,(IX+00) ; Grosser Puffer +24EF DD 74 07 .t. LD (IX+07),H ; Pufferaddresse setzen +24F2 DD 75 0C .u. LD (IX+0C),L +24F5 97 . SUB A ; Puffer leeren +24F6 DD 77 04 .w. LD (IX+04),A ; Lese- und Schreibzeiger jetzt 16Bit +24F9 DD 77 08 .w. LD (IX+08),A ; Auf Blockanfang +24FC DD 77 05 .w. LD (IX+05),A +24FF DD 77 0B .w. LD (IX+0B),A +2502 DD 77 09 .w. LD (IX+09),A +2505 DD 77 0A .w. LD (IX+0A),A +2508 FB . EI +2509 DD E1 .. POP IX +250B C9 . RET ;------ CONTROL typtabelle ------- +250C 79 y LD A,C ; Typtabelle einstellen +250D FE FE .. CP FE ; >= 254: psi o. transparent +250F 30 05 0. JR NC,2516 ; +2511 FE 05 .. CP 05 +2513 D2 3F 26 .?& JP NC,263F ; >= 5: falsche Nummer +2516 7D } LD A,L +2517 FE 11 .. CP 11 +2519 D2 5A 26 .Z& JP NC,265A +251C CD 95 26 ..& CALL 2695 ; Kanaltyptabellenaddresse holen +251F 71 q LD (HL),C ; Nummer eintragen +2520 01 00 00 ... LD BC,0000 ; ok +2523 C9 . RET ;------ IOCONTROL flow ---------- +2524 F1 . POP AF ; Eigener Kanal +2525 C5 . PUSH BC +2526 E5 . PUSH HL +2527 CD 36 24 .6$ CALL 2436 ; Shard IOCONTROL flow +252A E1 . POP HL +252B D1 . POP DE +252C 7D } LD A,L ; Addressierter Kanal +252D FE 11 .. CP 11 ; > 16: fertig +252F D0 . RET NC +2530 CD 95 26 ..& CALL 2695 ; Tytabellennummer holen --> A +2533 CB BE .. RES 7,(HL) ; Erstmal keine Flukontrolle setzen +2535 7B { LD A,E +2536 B7 . OR A +2537 28 02 (. JR Z,253B ; Wenn Flukontrolle, dann in Typ- +2539 CB FE .. SET 7,(HL) ; tabellennummer vermerken +253B C9 . RET ;------- IOCONTROL ysize ----------- +253C 7D } LD A,L ; Addressierter Kanal +253D FE 11 .. CP 11 ; > 16: fertig +253F D0 . RET NC +2540 CD EB 23 ..# CALL 23EB ; Addresse der Kanaltabelle holen +2543 DD E5 .. PUSH IX +2545 E5 . PUSH HL +2546 DD E1 .. POP IX +2548 0D . DEC C ; ysize-1 (=ymax f. y=0..ymax) +2549 DD 46 06 .F. LD B,(IX+06) ; Return = alte ysize +254C 04 . INC B ; ymax + 1 = ysize +254D DD 71 06 .q. LD (IX+06),C +2550 DD E1 .. POP IX +2552 48 H LD C,B ; Nur Werte 0..255 +2553 06 00 .. LD B,00 +2555 C9 . RET ;---------------------------------- +2556 CB 7C .| BIT 7,H +2558 C2 DE 63 ..c JP NZ,63DE +255B 32 AC 26 2.& LD (26AC),A +255E 7C | LD A,H +255F B5 . OR L +2560 20 06 . JR NZ,2568 +2562 3A AC 26 :.& LD A,(26AC) +2565 C3 DE 63 ..c JP 63DE +2568 7C | LD A,H +2569 E6 FE .. AND FE +256B FE 02 .. CP 02 +256D 28 08 (. JR Z,2577 +256F C3 5E 26 .^& JP 265E +2572 01 01 02 ... LD BC,0201 +2575 E1 . POP HL +2576 C9 . RET +2577 78 x LD A,B +2578 B1 . OR C +2579 C8 . RET Z +257A 25 % DEC H +257B 25 % DEC H +257C E5 . PUSH HL +257D 09 . ADD HL,BC +257E 7C | LD A,H +257F D6 02 .. SUB A,02 +2581 38 05 8. JR C,2588 +2583 20 ED . JR NZ,2572 +2585 B5 . OR L +2586 20 EA . JR NZ,2572 +2588 3A AC 26 :.& LD A,(26AC) +258B CD FA 23 ..# CALL 23FA +258E E1 . POP HL +258F 19 . ADD HL,DE +2590 DD E5 .. PUSH IX +2592 DD 2A AD 26 .*.& LD IX,(26AD) +2596 DD CB 00 6E ...n BIT 5,(IX+00) +259A 28 5E (^ JR Z,25FA +259C C5 . PUSH BC +259D E5 . PUSH HL +259E DD 66 0B .f. LD H,(IX+0B) +25A1 DD 6E 04 .n. LD L,(IX+04) +25A4 B7 . OR A +25A5 ED 42 .B SBC HL,BC +25A7 DA 13 26 ..& JP C,2613 +25AA DD 66 07 .f. LD H,(IX+07) +25AD DD 6E 0C .n. LD L,(IX+0C) +25B0 CD 81 5A ..Z CALL 5A81 +25B3 ED 43 AF 26 .C.& LD (26AF),BC +25B7 DD 6E 05 .n. LD L,(IX+05) +25BA DD 7E 0A .~. LD A,(IX+0A) +25BD E6 01 .. AND 01 +25BF 84 . ADD H +25C0 67 g LD H,A +25C1 D1 . POP DE +25C2 C1 . POP BC +25C3 C5 . PUSH BC +25C4 23 # INC HL +25C5 7D } LD A,L +25C6 B7 . OR A +25C7 20 06 . JR NZ,25CF +25C9 CB 44 .D BIT 0,H +25CB 20 02 . JR NZ,25CF +25CD 25 % DEC H +25CE 25 % DEC H +25CF ED A0 .. LDI +25D1 EA C5 25 ..% JP PE,25C5 +25D4 2B + DEC HL +25D5 DD 75 05 .u. LD (IX+05),L +25D8 DD 74 0A .t. LD (IX+0A),H +25DB ED 4B AF 26 .K.& LD BC,(26AF) +25DF CD 8C 5A ..Z CALL 5A8C +25E2 C1 . POP BC +25E3 F3 . DI +25E4 DD 66 0B .f. LD H,(IX+0B) +25E7 DD 6E 04 .n. LD L,(IX+04) +25EA B7 . OR A +25EB ED 42 .B SBC HL,BC +25ED DD 74 0B .t. LD (IX+0B),H +25F0 DD 75 04 .u. LD (IX+04),L +25F3 FB . EI +25F4 01 00 00 ... LD BC,0000 +25F7 DD E1 .. POP IX +25F9 C9 . RET ;---------------------------------- +25FA 3A AC 26 :.& LD A,(26AC) +25FD CD AD 1E ... CALL 1EAD +2600 DC 1A 26 ..& CALL C,261A +2603 DD E1 .. POP IX +2605 3A AC 26 :.& LD A,(26AC) +2608 CD 06 1F ... CALL 1F06 +260B D8 . RET C +260C 77 w LD (HL),A +260D ED A1 .. CPI +260F EA 05 26 ..& JP PE,2605 +2612 C9 . RET +2613 CD 1A 26 ..& CALL 261A +2616 E1 . POP HL +2617 C1 . POP BC +2618 18 E9 .. JR 2603 +261A 2A AD 26 *.& LD HL,(26AD) +261D 7E ~ LD A,(HL) +261E EE 40 .@ XOR 40 +2620 77 w LD (HL),A +2621 CB 77 .w BIT 6,A +2623 C8 . RET Z +2624 21 00 00 !.. LD HL,0000 +2627 C3 1A 6C ..l JP 6C1A +262A CB 7C .| BIT 7,H +262C C2 25 64 .%d JP NZ,6425 +262F 32 AC 26 2.& LD (26AC),A +2632 F5 . PUSH AF +2633 7C | LD A,H +2634 B5 . OR L +2635 20 2B + JR NZ,2662 +2637 F1 . POP AF +2638 FE 20 . CP 20 +263A C2 25 64 .%d JP NZ,6425 +263D 18 04 .. JR 2643 +263F 01 02 00 ... LD BC,0002 ; Nummer der Typtabelle falsch +2642 C9 . RET +2643 79 y LD A,C +2644 FE 05 .. CP 05 +2646 30 F7 0. JR NC,263F +2648 CD 01 24 ..$ CALL 2401 +264B 7E ~ LD A,(HL) +264C B7 . OR A +264D CC 26 24 .&$ CALL Z,2426 +2650 67 g LD H,A +2651 2E 00 .. LD L,00 +2653 EB . EX DE,HL +2654 01 00 02 ... LD BC,0200 ; Typtabelle in Bereich uebertragen +2657 ED B0 .. LDIR +2659 C9 . RET +265A 01 03 00 ... LD BC,0003 +265D C9 . RET +265E 01 01 00 ... LD BC,0001 +2661 C9 . RET +2662 F1 . POP AF +2663 7C | LD A,H +2664 E6 FE .. AND FE +2666 FE 02 .. CP 02 +2668 28 02 (. JR Z,266C +266A 18 F2 .. JR 265E +266C 78 x LD A,B +266D B1 . OR C +266E C8 . RET Z +266F C5 . PUSH BC +2670 E5 . PUSH HL +2671 01 02 00 ... LD BC,0002 +2674 3A AC 26 :.& LD A,(26AC) +2677 CD A8 28 ..( CALL 28A8 ; IOCONTROL frout +267A 21 1C 00 !.. LD HL,001C ; 28 Zeichen +267D ED 42 .B SBC HL,BC ; Anzahl uebernommener Zeichen +267F D4 1A 26 ..& CALL NC,261A +2682 E1 . POP HL +2683 C1 . POP BC +2684 25 % DEC H +2685 25 % DEC H +2686 19 . ADD HL,DE +2687 C5 . PUSH BC +2688 3A AC 26 :.& LD A,(26AC) +268B CD 88 21 ..! CALL 2188 +268E E1 . POP HL +268F B7 . OR A +2690 ED 42 .B SBC HL,BC +2692 44 D LD B,H +2693 4D M LD C,L +2694 C9 . RET +2695 21 B8 26 !.& LD HL,26B8 +2698 C5 . PUSH BC +2699 4F O LD C,A +269A 06 00 .. LD B,00 +269C 09 . ADD HL,BC +269D C1 . POP BC +269E 7E ~ LD A,(HL) +269F CB BF .. RES 7,A +26A1 FE 7F .. CP 7F +26A3 C9 . RET +26A4 FF . RST 38 +26A5 FF . RST 38 +26A6 FF . RST 38 +26A7 FF . RST 38 +26A8 FF . RST 38 +26A9 00 . NOP +26AA 00 . NOP +26AB 00 . NOP +26AC 00 . NOP +26AD 00 . NOP +26AE 00 . NOP +26AF 00 . NOP +26B0 00 . NOP +26B1 00 . NOP +26B2 00 . NOP +26B3 00 . NOP +26B4 00 . NOP +26B5 00 . NOP +26B6 00 . NOP +26B7 00 . NOP +26B8 00 . NOP ; typtabellen nummern & Flusskontr. +26B9 7E ~ LD A,(HL) ; Kanal 1 : psi ohne flow +26BA FF . RST 38 ; kanal 2 : transparent mit flow +26BB FF . RST 38 ; (Bit 7 = 1: Mit Flukontrolle) +26BC FF . RST 38 +26BD FF . RST 38 +26BE FF . RST 38 +26BF FF . RST 38 +26C0 FF . RST 38 +26C1 FF . RST 38 +26C2 FF . RST 38 +26C3 FF . RST 38 +26C4 FF . RST 38 +26C5 FF . RST 38 +26C6 FF . RST 38 +26C7 FF . RST 38 +26C8 FF . RST 38 ; kanal 16 + ; kanaltabelle fuer kanal 1 +26C9 00 . NOP 0 ; Bit 0 : + ; Bit 3 : 1=Stoptaste gedrueckt + ; Bit 5 : 1=Grosser Puffer (>255Byte) +26CA 00 . NOP 1 ; Bits 0..5 : Errorbits +26CB FF . RST 38 2 ; Cursorpos y +26CC FF . RST 38 3 ; Cursorpos x +26CD 07 . RLCA 4 ; Pufferzeiger schreiben +26CE 07 . RLCA 5 ; Pufferzeiger lesen +26CF 17 . RLA 6 ; ysize = 23 +26D0 FF . RST 38 7 ; Ab hier Eingabezeichen ... +26D1 FF . RST 38 8 ; +26D2 FF . RST 38 9 ; +26D3 FF . RST 38 10 ; +26D4 FF . RST 38 11 ; +26D5 FF . RST 38 12 ; +26D6 FF . RST 38 +26D7 FF . RST 38 +26D8 FF . RST 38 +26D9 FF . RST 38 +26DA FF . RST 38 +26DB FF . RST 38 +26DC FF . RST 38 ; I.d.R bis hier +26DD FF . RST 38 +26DE FF . RST 38 +26DF FF . RST 38 +26E0 FF . RST 38 +26E1 00 . NOP ; kanal 2 +26E2 00 . NOP +26E3 FF . RST 38 +26E4 FF . RST 38 +26E5 07 . RLCA +26E6 07 . RLCA +26E7 17 . RLA +26E8 FF . RST 38 +26E9 FF . RST 38 +26EA FF . RST 38 +26EB FF . RST 38 +26EC FF . RST 38 +26ED FF . RST 38 +26EE FF . RST 38 +26EF FF . RST 38 +26F0 FF . RST 38 +26F1 FF . RST 38 +26F2 FF . RST 38 +26F3 FF . RST 38 +26F4 FF . RST 38 +26F5 FF . RST 38 +26F6 FF . RST 38 +26F7 FF . RST 38 +26F8 FF . RST 38 +26F9 00 . NOP ; kanal 3 +26FA 00 . NOP +26FB FF . RST 38 +26FC FF . RST 38 +26FD 07 . RLCA +26FE 07 . RLCA +26FF 17 . RLA +2700 FF . RST 38 +2701 FF . RST 38 +2702 FF . RST 38 +2703 FF . RST 38 +2704 FF . RST 38 +2705 FF . RST 38 +2706 FF . RST 38 +2707 FF . RST 38 +2708 FF . RST 38 +2709 FF . RST 38 +270A FF . RST 38 +270B FF . RST 38 +270C FF . RST 38 +270D FF . RST 38 +270E FF . RST 38 +270F FF . RST 38 +2710 FF . RST 38 +2711 00 . NOP ; kanal 4 +2712 00 . NOP +2713 FF . RST 38 +2714 FF . RST 38 +2715 07 . RLCA +2716 07 . RLCA +2717 17 . RLA +2718 FF . RST 38 +2719 FF . RST 38 +271A FF . RST 38 +271B FF . RST 38 +271C FF . RST 38 +271D FF . RST 38 +271E FF . RST 38 +271F FF . RST 38 +2720 FF . RST 38 +2721 FF . RST 38 +2722 FF . RST 38 +2723 FF . RST 38 +2724 FF . RST 38 +2725 FF . RST 38 +2726 FF . RST 38 +2727 FF . RST 38 +2728 FF . RST 38 +2729 00 . NOP ; kanal 5 +272A 00 . NOP +272B FF . RST 38 +272C FF . RST 38 +272D 07 . RLCA +272E 07 . RLCA +272F 17 . RLA +2730 FF . RST 38 +2731 FF . RST 38 +2732 FF . RST 38 +2733 FF . RST 38 +2734 FF . RST 38 +2735 FF . RST 38 +2736 FF . RST 38 +2737 FF . RST 38 +2738 FF . RST 38 +2739 FF . RST 38 +273A FF . RST 38 +273B FF . RST 38 +273C FF . RST 38 +273D FF . RST 38 +273E FF . RST 38 +273F FF . RST 38 +2740 FF . RST 38 +2741 00 . NOP ; kanal 6 +2742 00 . NOP +2743 FF . RST 38 +2744 FF . RST 38 +2745 07 . RLCA +2746 07 . RLCA +2747 17 . RLA +2748 FF . RST 38 +2749 FF . RST 38 +274A FF . RST 38 +274B FF . RST 38 +274C FF . RST 38 +274D FF . RST 38 +274E FF . RST 38 +274F FF . RST 38 +2750 FF . RST 38 +2751 FF . RST 38 +2752 FF . RST 38 +2753 FF . RST 38 +2754 FF . RST 38 +2755 FF . RST 38 +2756 FF . RST 38 +2757 FF . RST 38 +2758 FF . RST 38 +2759 00 . NOP ; kanal 7 +275A 00 . NOP +275B FF . RST 38 +275C FF . RST 38 +275D 07 . RLCA +275E 07 . RLCA +275F 17 . RLA +2760 FF . RST 38 +2761 FF . RST 38 +2762 FF . RST 38 +2763 FF . RST 38 +2764 FF . RST 38 +2765 FF . RST 38 +2766 FF . RST 38 +2767 FF . RST 38 +2768 FF . RST 38 +2769 FF . RST 38 +276A FF . RST 38 +276B FF . RST 38 +276C FF . RST 38 +276D FF . RST 38 +276E FF . RST 38 +276F FF . RST 38 +2770 FF . RST 38 +2771 00 . NOP ; kanal 8 +2772 00 . NOP +2773 FF . RST 38 +2774 FF . RST 38 +2775 07 . RLCA +2776 07 . RLCA +2777 17 . RLA +2778 FF . RST 38 +2779 FF . RST 38 +277A FF . RST 38 +277B FF . RST 38 +277C FF . RST 38 +277D FF . RST 38 +277E FF . RST 38 +277F FF . RST 38 +2780 FF . RST 38 +2781 FF . RST 38 +2782 FF . RST 38 +2783 FF . RST 38 +2784 FF . RST 38 +2785 FF . RST 38 +2786 FF . RST 38 +2787 FF . RST 38 +2788 FF . RST 38 +2789 00 . NOP ; kanal 9 +278A 00 . NOP +278B FF . RST 38 +278C FF . RST 38 +278D 07 . RLCA +278E 07 . RLCA +278F 17 . RLA +2790 FF . RST 38 +2791 FF . RST 38 +2792 FF . RST 38 +2793 FF . RST 38 +2794 FF . RST 38 +2795 FF . RST 38 +2796 FF . RST 38 +2797 FF . RST 38 +2798 FF . RST 38 +2799 FF . RST 38 +279A FF . RST 38 +279B FF . RST 38 +279C FF . RST 38 +279D FF . RST 38 +279E FF . RST 38 +279F FF . RST 38 +27A0 FF . RST 38 +27A1 00 . NOP ; kanal 10 +27A2 00 . NOP +27A3 FF . RST 38 +27A4 FF . RST 38 +27A5 07 . RLCA +27A6 07 . RLCA +27A7 17 . RLA +27A8 FF . RST 38 +27A9 FF . RST 38 +27AA FF . RST 38 +27AB FF . RST 38 +27AC FF . RST 38 +27AD FF . RST 38 +27AE FF . RST 38 +27AF FF . RST 38 +27B0 FF . RST 38 +27B1 FF . RST 38 +27B2 FF . RST 38 +27B3 FF . RST 38 +27B4 FF . RST 38 +27B5 FF . RST 38 +27B6 FF . RST 38 +27B7 FF . RST 38 +27B8 FF . RST 38 +27B9 00 . NOP ; kanal 11 +27BA 00 . NOP +27BB FF . RST 38 +27BC FF . RST 38 +27BD 07 . RLCA +27BE 07 . RLCA +27BF 17 . RLA +27C0 FF . RST 38 +27C1 FF . RST 38 +27C2 FF . RST 38 +27C3 FF . RST 38 +27C4 FF . RST 38 +27C5 FF . RST 38 +27C6 FF . RST 38 +27C7 FF . RST 38 +27C8 FF . RST 38 +27C9 FF . RST 38 +27CA FF . RST 38 +27CB FF . RST 38 +27CC FF . RST 38 +27CD FF . RST 38 +27CE FF . RST 38 +27CF FF . RST 38 +27D0 FF . RST 38 +27D1 00 . NOP ; kanal 12 +27D2 00 . NOP +27D3 FF . RST 38 +27D4 FF . RST 38 +27D5 07 . RLCA +27D6 07 . RLCA +27D7 17 . RLA +27D8 FF . RST 38 +27D9 FF . RST 38 +27DA FF . RST 38 +27DB FF . RST 38 +27DC FF . RST 38 +27DD FF . RST 38 +27DE FF . RST 38 +27DF FF . RST 38 +27E0 FF . RST 38 +27E1 FF . RST 38 +27E2 FF . RST 38 +27E3 FF . RST 38 +27E4 FF . RST 38 +27E5 FF . RST 38 +27E6 FF . RST 38 +27E7 FF . RST 38 +27E8 FF . RST 38 +27E9 00 . NOP ; kanal 13 +27EA 00 . NOP +27EB FF . RST 38 +27EC FF . RST 38 +27ED 07 . RLCA +27EE 07 . RLCA +27EF 17 . RLA +27F0 FF . RST 38 +27F1 FF . RST 38 +27F2 FF . RST 38 +27F3 FF . RST 38 +27F4 FF . RST 38 +27F5 FF . RST 38 +27F6 FF . RST 38 +27F7 FF . RST 38 +27F8 FF . RST 38 +27F9 FF . RST 38 +27FA FF . RST 38 +27FB FF . RST 38 +27FC FF . RST 38 +27FD FF . RST 38 +27FE FF . RST 38 +27FF FF . RST 38 +2800 FF . RST 38 +2801 00 . NOP ; kanal 14 +2802 00 . NOP +2803 FF . RST 38 +2804 FF . RST 38 +2805 07 . RLCA +2806 07 . RLCA +2807 17 . RLA +2808 FF . RST 38 +2809 FF . RST 38 +280A FF . RST 38 +280B FF . RST 38 +280C FF . RST 38 +280D FF . RST 38 +280E FF . RST 38 +280F FF . RST 38 +2810 FF . RST 38 +2811 FF . RST 38 +2812 FF . RST 38 +2813 FF . RST 38 +2814 FF . RST 38 +2815 FF . RST 38 +2816 FF . RST 38 +2817 FF . RST 38 +2818 FF . RST 38 +2819 00 . NOP ; kanal 15 +281A 00 . NOP +281B FF . RST 38 +281C FF . RST 38 +281D 07 . RLCA +281E 07 . RLCA +281F 17 . RLA +2820 FF . RST 38 +2821 FF . RST 38 +2822 FF . RST 38 +2823 FF . RST 38 +2824 FF . RST 38 +2825 FF . RST 38 +2826 FF . RST 38 +2827 FF . RST 38 +2828 FF . RST 38 +2829 FF . RST 38 +282A FF . RST 38 +282B FF . RST 38 +282C FF . RST 38 +282D FF . RST 38 +282E FF . RST 38 +282F FF . RST 38 +2830 FF . RST 38 +2831 00 . NOP ; kanal 16 +2832 00 . NOP +2833 FF . RST 38 +2834 FF . RST 38 +2835 07 . RLCA +2836 07 . RLCA +2837 17 . RLA +2838 FF . RST 38 +2839 FF . RST 38 +283A FF . RST 38 +283B FF . RST 38 +283C FF . RST 38 +283D FF . RST 38 +283E FF . RST 38 +283F FF . RST 38 +2840 FF . RST 38 +2841 FF . RST 38 +2842 FF . RST 38 +2843 FF . RST 38 +2844 FF . RST 38 +2845 FF . RST 38 +2846 FF . RST 38 +2847 FF . RST 38 +2848 FF . RST 38 +2849 73 s LD (HL),E ; "shdifc.z80 001 (!)" +284A 68 h LD L,B +284B 64 d LD H,H +284C 69 i LD L,C +284D 66 f LD H,(HL) +284E 63 c LD H,E +284F 2E 7A .z LD L,7A +2851 38 30 80 JR C,2883 +2853 20 30 0 JR NZ,2885 +2855 30 31 01 JR NC,2888 +2857 20 28 ( JR NZ,2881 +2859 21 29 +285B FF ;------ 69 Bytes von hier ------- +285C FF . RST 38 ; "SHARD " +285D FF . RST 38 +285E FF . RST 38 +285F FF . RST 38 +2860 FF . RST 38 +2861 FF . RST 38 +2862 FF . RST 38 +2863 FF . RST 38 +2864 FF . RST 38 +2865 FF . RST 38 +2866 FF . RST 38 +2867 FF . RST 38 +2868 FF . RST 38 +2869 FF . RST 38 +286A FF . RST 38 ; Shard Interface +286B 06 ; SHard versionnummer(wird veraendert +286C 00 ; " +286D 00 . NOP ; mode :BIT 0: 1=frei eumel0 +286E 00 . NOP ; bit 8:0=speichetest,9:0=vortest +286F 00 . NOP ; id4 +2870 00 . NOP +2871 00 . NOP ; id5 +2872 00 . NOP +2873 00 . NOP ; id6 +2874 00 . NOP +2875 00 . NOP ; id7 +2876 00 . NOP +2877 00 . NOP ; leer +2878 00 . NOP +2879 00 . NOP ; leer +287A 00 . NOP +287B C3 06 01 ... JP 0106 ; OUTPUT +287E C3 09 01 ... JP 0109 ; BLOCKIN +2881 C3 0C 01 ... JP 010C ; BLOCKOUT +2884 C3 0F 01 ... JP 010F ; IOCONTROL +2887 C3 12 01 ... JP 0112 ; SYSEND +288A C3 15 01 ... JP 0115 ; SCHINF +288D C3 18 01 ... JP 0118 ; SCHACC +2890 00 . NOP ; leer +2891 00 . NOP +2892 00 . NOP ; RAM-Limit low +2893 00 . NOP ; " high +2894 00 . NOP +2895 00 . NOP +2896 00 . NOP +2897 00 . NOP +2898 00 . NOP +2899 00 . NOP +289A 00 . NOP +289B 00 . NOP +289C 00 . NOP +289D 00 . NOP +289E 00 . NOP +289F 00 . NOP ;----------- bis hier --------- +28A0 ED 5B 92 28 .[.( LD DE,(2892) ; RAM-Limit laden +28A4 C9 . RET ;------------------------------- +28A5 ED B0 .. LDIR ; Longmove = LDIR (immer) +28A7 C9 . RET +28A8 B7 . OR A ; Intern IOCONTROL +28A9 20 D9 . JR NZ,2884 ; Fuer alle Kanale > 0: IOCONTROL +28AB 79 y LD A,C +28AC FE 05 .. CP 05 ; HG-Kanal Fkt. 5 : Size +28AE 28 03 (. JR Z,28B3 +28B0 97 . SUB A ; Alle anderen HG-Controls weiter +28B1 18 D1 .. JR 2884 ; IOCONTROL +28B3 97 . SUB A +28B4 CD 84 28 ..( CALL 2884 ; Anz. Bloecke DIV 65536 in A +28B7 E5 . PUSH HL +28B8 67 g LD H,A ; A retten +28B9 3A 6B 28 :k( LD A,(286B) ; Shard Version +28BC FE 07 .. CP 07 +28BE 30 02 0. JR NC,28C2 ; +28C0 26 00 &. LD H,00 ; Shard Version 6 : Hoechstens 65536 +28C2 7C | LD A,H ; Shard Version > 6 : Auch mehr als^ +28C3 B7 . OR A +28C4 20 08 . JR NZ,28CE +28C6 21 80 7E !.~ LD HL,7E80 ; +28C9 B7 . OR A ; CLC +28CA ED 42 .B SBC HL,BC +28CC E1 . POP HL +28CD D0 . RET NC +28CE E1 . POP HL +28CF 97 . SUB A ; Maximum an Bloecken: 32384 +28D0 01 80 7E ..~ LD BC,7E80 ; 15MB + 832 KB +28D3 C9 . RET ;========== 175 Systemstart ======= +28D4 11 5B 28 .[( LD DE,285B ; 69 Bytes uebertragen +28D7 01 45 00 .E. LD BC,0045 ; Von Shard Leiste --> EUMEL0 +28DA ED B0 .. LDIR ; 175 Systemstart +28DC C3 99 14 ... JP 1499 ;========= 173 Systemstart ======== +28DF 3A 1E 01 :.. LD A,(011E) ; Shardversion +28E2 32 6B 28 2k( LD (286B),A +28E5 FE 07 .. CP 07 ; >= 7 : falsche Leiste ! +28E7 30 0A 0. JR NC,28F3 +28E9 CD 03 01 ... CALL 0103 ; LIMIT erfragen +28EC ED 53 92 28 .S.( LD (2892),DE ; Eintragen +28F0 C3 99 14 ... JP 1499 ; Zum neuen Systemstart (175) +28F3 CD 1F 70 ..p CALL 701F ; Info aufrufen +28F6 18 0F .. JR 2907 +28F8 20 66 f JR NZ,2960 ; " falsche Leiste" +28FA 61 a LD H,C +28FB 6C l LD L,H +28FC 73 s LD (HL),E +28FD 63 c LD H,E +28FE 68 h LD L,B +28FF 65 e LD H,L +2900 20 4C L JR NZ,294E +2902 65 e LD H,L +2903 69 i LD L,C +2904 73 s LD (HL),E +2905 74 t LD (HL),H +2906 65 e LD H,L +2907 18 EA .. JR 28F3 ; Endlos +2909 F5 . PUSH AF ; Info Aufruf vom Shard +290A 3E F2 >. LD A,F2 +290C 32 19 7D 2.} LD (7D19),A +290F F1 . POP AF +2910 CD 1F 70 ..p CALL 701F +2913 18 06 .. JR 291B ; Info aufrufen +2915 20 73 s JR NZ,298A ; " shard" +2917 68 h LD L,B +2918 61 a LD H,C +2919 72 r LD (HL),D +291A 64 d LD H,H +291B C9 . RET ;--------------------------------- +291C 3E 04 >. LD A,04 ; shutup anfordern +291E C3 BB 81 ... JP 81BB +2921 3A 00 ; Task geht in Wartezustand-------- +2923 DD 77 06 LD (IX+6),A ; status pcb-Feld setzen +2926 DD CB 07 7E BIT 7,(IX+7) +292A C4 02 2A ..* CALL NZ,2A02 ; Speicherfelder --> pcb-felder +292D 31 13 6D 1.m LD SP,6D13 ; Schleifenanfang fuer offenen Warte +2930 CD 41 6B .Ak CALL 6B41 ; zustand +2933 3A 1A 6E :.n LD A,(6E1A) +2936 3D = DEC A +2937 CC 38 4C .8L CALL Z,4C38 ; Supervisor +293A DD 7E 06 .~. LD A,(IX+06) +293D CB 47 .G BIT 0,A ; geblockt, keine Aktion bis entblockt +293F 20 3D = JR NZ,297E +2941 E6 3C .< AND 3C ; Statusbist ausblenden +2943 FE 2C ., CP 2C +2945 D2 D8 29 ..) JP NC,29D8 +2948 32 51 29 2Q) LD (2951),A +294B FE 18 .. CP 18 ; 18 : Leitblockfelder --> Speicher +294D D4 46 2A .F* CALL NC,2A46 +2950 18 FE .. JR 2950 ; Sprung in Tabelle +2952 C3 CC 29 ..) JP 29CC ; 00 : Test, ob haltprocess +2955 FF . RST 38 +2956 C3 BE 29 ..) JP 29BE ; 04 : auf kanalankoppeln warten +2959 FF . RST 38 +295A C3 AA 29 ..) JP 29AA ; 08 : warten auf tastendruck +295D FF . RST 38 +295E C3 95 29 ..) JP 2995 ; 0C : pause (in mod) +2961 FF . RST 38 +2962 C3 7C 2E .|. JP 2E7C ; 10 : Busy, RET TRUE, test halt +2965 FF . RST 38 +2966 C3 81 2E ... JP 2E81 ; 14 : Busy, RET FALSE, test halt +2969 FF . RST 38 +296A C3 B5 2F ../ JP 2FB5 ; 18 : CALL PROC +296D FF . RST 38 +296E C3 38 3D .8= JP 3D38 ; 1C : EXTERNAL TERM +2971 FF . RST 38 +2972 C3 3D 4A .=J JP 4A3D ; 20 : anford. garbagecollect. +2975 FF . RST 38 +2976 C3 5D 4A .]J JP 4A5D ; 24 : garbage collect. 1. Teil +2979 FF . RST 38 +297A C3 09 4B ..K JP 4B09 ; 28 : garbage collect. 2 teil +297D FF . RST 38 +297E 3A 1A 6E :.n LD A,(6E1A) ; Supervisor +2981 FE 01 .. CP 01 +2983 20 0A . JR NZ,298F +2985 F3 . DI +2986 3A F9 4C :.L LD A,(4CF9) +2989 B7 . OR A +298A 3A 1A 6E :.n LD A,(6E1A) +298D 20 03 . JR NZ,2992 ; SV-Call angefordert ? +298F CD 74 6D .tm CALL 6D74 ; block SV +2992 FB . EI +2993 18 98 .. JR 292D +2995 2A F1 4C *.L LD HL,(4CF1) ; Pausenende abwarten +2998 DD 7E 0C .~. LD A,(IX+0C) +299B 95 . SUB L +299C DD 7E 0D .~. LD A,(IX+0D) +299F 9C . SBC H +29A0 FA CC 29 ..) JP M,29CC +29A3 DD 7E 26 .~& LD A,(IX+26) +29A6 B7 . OR A +29A7 CA 2D 29 .-) JP Z,292D +29AA DD CB 05 46 ...F BIT 0,(IX+05) +29AE 20 1C . JR NZ,29CC +29B0 DD 7E 26 .~& LD A,(IX+26) +29B3 B7 . OR A +29B4 28 C8 (. JR Z,297E +29B6 CD AD 1E ... CALL 1EAD ; taste gedrueckt ? +29B9 DA 2D 29 .-) JP C,292D +29BC 18 0E .. JR 29CC +29BE DD 7E 26 .~& LD A,(IX+26) +29C1 B7 . OR A +29C2 28 BA (. JR Z,297E +29C4 CD 59 1E .Y. CALL 1E59 +29C7 FE 1E .. CP 1E ; Mindestens 30 Zeichen uebernehmen +29C9 DA 2D 29 .-) JP C,292D +29CC DD 35 .5 DEC (IX+08) +29CE 08 . EX AF,AF' +29CF F2 2D 29 .-) JP P,292D +29D2 CD 7E 2A .~* CALL 2A7E ; Test, ob halt process +29D5 C3 A7 2A ..* JP 2AA7 ; zur interpreter schleife +29D8 DD CB 05 46 ...F BIT 0,(IX+05) +29DC 20 EE . JR NZ,29CC +29DE DD 7E 34 .~4 LD A,(IX+34) +29E1 B7 . OR A +29E2 20 9A . JR NZ,297E +29E4 DD 7E 26 .~& LD A,(IX+26) +29E7 B7 . OR A +29E8 28 94 (. JR Z,297E +29EA CD AD 1E ... CALL 1EAD ; taste gedrueckt ? +29ED DA 2D 29 .-) JP C,292D +29F0 DD 36 2C FC .6,. LD (IX+2C),FC ; msgcod := -4 +29F4 DD 36 2D FF .6-. LD (IX+2D),FF +29F8 DD 36 2E 01 .6.. LD (IX+2E),01 +29FC DD CB 07 DE .... SET 3,(IX+07) +2A00 18 CA .. JR 29CC ;--------------------------------- +2A02 CD F6 4B ..K CALL 4BF6 +2A05 DD CB 07 BE .... RES 7,(IX+07) ; Felder wurden uebertragen +2A09 ED 5B 1C 6E .[.n LD DE,(6E1C) +2A0D 1E 10 .. LD E,10 ; 10..17 +2A0F 21 C4 41 !.A LD HL,41C4 ; pcb Felder von Hauptspeicher +2A12 ED A0 .. LDI ; in Leitblock uebertragen +2A14 ED A0 .. LDI ; lbas +2A16 ED A0 .. LDI ; ltop +2A18 ED A0 .. LDI +2A1A ED A0 .. LDI ; ls_top +2A1C ED A0 .. LDI +2A1E ED A0 .. LDI ; hptop +2A20 ED A0 .. LDI +2A22 DD CB 07 6E ...n BIT 5,(IX+07) +2A26 C4 4D 45 .ME CALL NZ,454D +2A29 D9 . EXX ; pbas +2A2A DD 71 0E .q. LD (IX+0E),C +2A2D DD 7E 2A .~* LD A,(IX+2A) ; prio --> pricnt +2A30 DD 77 08 .w. LD (IX+08),A +2A33 08 . EX AF,AF' +2A34 DD CB 09 16 .... RL (IX+09) +2A38 1F . RRA +2A39 30 07 0. JR NC,2A42 +2A3B D6 80 .. SUB A,80 +2A3D 30 03 0. JR NC,2A42 +2A3F DD 35 .5 DEC (IX+0A) +2A41 0A . LD A,(BC) +2A42 DD 77 09 .w. LD (IX+09),A +2A45 C9 . RET ;-------------------------------- +2A46 CD 16 42 ..B CALL 4216 +2A49 DD 4E 0E .N. LD C,(IX+0E) ; pbas +2A4C 16 19 .. LD D,19 +2A4E D9 . EXX +2A4F 2A 1C 6E *.n LD HL,(6E1C) ; Leitblock Felder in Hauptspeicher +2A52 2E 10 .. LD L,10 ; uebertragen +2A54 11 C4 41 ..A LD DE,41C4 +2A57 ED A0 .. LDI +2A59 ED A0 .. LDI +2A5B ED A0 .. LDI +2A5D ED A0 .. LDI +2A5F ED A0 .. LDI +2A61 ED A0 .. LDI +2A63 ED A0 .. LDI +2A65 ED A0 .. LDI +2A67 CD AB 42 ..B CALL 42AB +2A6A DD 4E 09 .N. LD C,(IX+09) +2A6D CB 21 .! SLA C +2A6F 17 . RLA +2A70 47 G LD B,A +2A71 DD CB 07 FE .... SET 7,(IX+07) ; Felder wurden uebertragen +2A75 79 y LD A,C +2A76 08 . EX AF,AF' +2A77 CD DB 4B ..K CALL 4BDB ; millis verringern +2A7A CD 93 2A ..* CALL 2A93 +2A7D C9 . RET ;-------------------------------- +2A7E CD 46 2A .F* CALL 2A46 +2A81 DD 36 06 00 .6.. LD (IX+06),00 +2A85 DD CB 05 46 ...F BIT 0,(IX+05) ; halt process angefordert ? +2A89 C8 . RET Z +2A8A DD CB 05 86 .... RES 0,(IX+05) +2A8E 3E 01 >. LD A,01 +2A90 C3 0D 3D ..= JP 3D0D ; errorstop "halt from terminal" +2A93 21 E6 7C !.| LD HL,7CE6 ; AND 7C-------------------------- +2A96 22 AE 2A ".* LD (2AAE),HL +2A99 C9 . RET +2A9A 21 18 F1 !.. LD HL,F118 ; JR 2AA1 +2A9D 22 AE 2A ".* LD (2AAE),HL +2AA0 C9 . RET +2AA1 CD 93 2A ..* CALL 2A93 ; AND 7C Maske setzen +2AA4 C3 26 29 .&) JP 2926 ; Je nach Status reagieren +2AA7 79 y LD A,C ;---------------------------------- +2AA8 08 . EX AF,AF' +2AA9 0A . LD A,(BC) +2AAA 6F o LD L,A +2AAB 0C . INC C +2AAC 0A . LD A,(BC) +2AAD 67 g LD H,A ; HL := Codeword +2AAE E6 7C .| AND 7C ; Opcodebits ausmaskieren +2AB0 32 B6 2A 2.* LD (2AB6),A ; Opcode setzen +2AB3 AC . XOR H ; Datenbits in A +2AB4 0C . INC C ; BC zeigt auf naechsten Opcode +2AB5 20 FE . JR NZ,2AB5 ; Wird +2AB7 C3 8C 2C .., JP 2C8C ; Neue Seite, ggf neuen Block laden +2ABA FF . RST 38 ; und Restart (EUMEL0-Restart) +2ABB C3 F1 2C .., JP 2CF1 ; 0 LN (nr) +2ABE FF . RST 38 ; 1 LONGLN (nr-1024) +2ABF C3 FD 2C .., JP 2CFD ; 2 MOV1 (source, dest) +2AC2 FF . RST 38 +2AC3 C3 11 2D ..- JP 2D11 ; 3 INC1 (dest) +2AC6 FF . RST 38 +2AC7 C3 1F 2D ..- JP 2D1F ; 4 DEC1 (dest) +2ACA FF . RST 38 +2ACB C3 30 2D .0- JP 2D30 ; 5 INC (source, dest) +2ACE FF . RST 38 +2ACF C3 50 2D .P- JP 2D50 ; 6 DEC (source, dest) +2AD2 FF . RST 38 +2AD3 C3 65 2D .e- JP 2D65 ; 7 ADD (a, b, c) +2AD6 FF . RST 38 +2AD7 C3 82 2D ..- JP 2D82 ; 8 SUB (a, b, c) +2ADA FF . RST 38 +2ADB C3 D2 2D ..- JP 2DD2 ; 9 CLEAR (dest) +2ADE FF . RST 38 +2ADF C3 2B 2E .+. JP 2E2B ; 10 TEST (source) --> BOOL +2AE2 FF . RST 38 +2AE3 C3 60 2E .`. JP 2E60 ; 11 EQU (a, b) --> BOOL +2AE6 FF . RST 38 +2AE7 C3 35 2E .5. JP 2E35 ; 12 LSEQ (a, b) --> BOOL +2AEA FF . RST 38 +2AEB C3 04 35 ..5 JP 3504 ; 13 MOV8 (source, dest) +2AEE FF . RST 38 +2AEF C3 20 35 . 5 JP 3520 ; 14 FADD (a, b, c) +2AF2 FF . RST 38 +2AF3 C3 3B 35 .;5 JP 353B ; 15 FSUB (a, b, c) +2AF6 FF . RST 38 +2AF7 C3 41 35 .A5 JP 3541 ; 16 FMULT (a, b, c) +2AFA FF . RST 38 +2AFB C3 47 35 .G5 JP 3547 ; 17 FDIV (a, b, c) +2AFE FF . RST 38 +2AFF C3 5D 35 .]5 JP 355D ; 18 FLSEQ (a, b) --> BOOL +2B02 FF . RST 38 +2B03 C3 CD 30 ..0 JP 30CD ; 19 TMOV (source, dest) +2B06 FF . RST 38 +2B07 C3 0F 31 ..1 JP 310F ; 20 TEQU (a, b) --> BOOL +2B0A FF . RST 38 +2B0B C3 4E 2E .N. JP 2E4E ; 21 ULSEQU (a, b) --> BOOL +2B0E FF . RST 38 +2B0F C3 03 36 ..6 JP 3603 ; 22 ACCDS (dsid, refadr) +2B12 FF . RST 38 +2B13 C3 21 36 .!6 JP 3621 ; 23 REF (source, refadr) +2B16 FF . RST 38 +2B17 C3 43 36 .C6 JP 3643 ; 24 SUBS (limit-1, index, refadr) +2B1A FF . RST 38 +2B1B C3 27 36 .'6 JP 3627 ; 25 SEL (base, offset, refadr) +2B1E FF . RST 38 +2B1F C3 02 2F ../ JP 2F02 ; 26 PPV (source) +2B22 FF . RST 38 +2B23 C3 07 2F ../ JP 2F07 ; 27 PP (source) +2B26 FF . RST 38 +2B27 C3 8E 2E ... JP 2E8E ; 28 BR (lowadr) +2B2A FF . RST 38 +2B2B C3 A3 2E ... JP 2EA3 ; 29 LONGBR (lowadr-1024) +2B2E FF . RST 38 +2B2F C3 40 2F .@/ JP 2F40 ; 30 CALL (modnr) +2B32 FF . RST 38 +2B33 07 . RLCA ; 31 ... +2B34 07 . RLCA +2B35 07 . RLCA +2B36 32 3A 2B 2:+ LD (2B3A),A +2B39 18 FE .. JR 2B39 ; Sprung auf SPezial +2B3B C3 6E 36 .n6 JP 366E ; 0 : ISXCHAR (char) --> BOOL +2B3E FF . RST 38 +2B3F C3 80 36 ..6 JP 3680 ; 1 : STIM (byteval, dest) +2B42 FF . RST 38 +2B43 C3 8C 36 ..6 JP 368C ; 2 : MOVX (bytelen, source, dest) +2B46 FF . RST 38 +2B47 C3 D2 36 ..6 JP 36D2 ; 3 : PW (ds+segment, offs, value) +2B4A FF . RST 38 +2B4B C3 C9 36 ..6 JP 36C9 ; 4 : GW (ds+segment, offs, result) +2B4E FF . RST 38 +2B4F C3 DE 2F ../ JP 2FDE ; 5 : PENTER (highbyte) +2B52 FF . RST 38 +2B53 C3 76 2B .v+ JP 2B76 ; 6 : ESC (functionbyte) +2B56 FF . RST 38 +2B57 7D } LD A,L ; 7 : LONGA (opcodebyte) +2B58 32 B6 2A 2.* LD (2AB6),A +2B5B E6 83 .. AND 83 +2B5D 20 08 . JR NZ,2B67 +2B5F 0A . LD A,(BC) +2B60 6F o LD L,A +2B61 0C . INC C ; Zur Interpreterschleife mit Opcode +2B62 0A . LD A,(BC) +2B63 0C . INC C +2B64 C3 B5 2A ..* JP 2AB5 ; -------- +2B67 3E FD >. LD A,FD ; -3 = Block unlesbar +2B69 BD . CP L +2B6A C2 F4 3C ..< JP NZ,3CF4 +2B6D DD CB 0B B6 .... RES 6,(IX+0B) ; enablestop +2B71 3E 10 >. LD A,10 ; Errorstop Block unlesbar +2B73 C3 12 3D ..= JP 3D12 ;------------ ESC --------------- +2B76 7D } LD A,L +2B77 FE 82 .. CP 82 ; 129 ist Maximum ESC +2B79 D2 F4 3C ..< JP NC,3CF4 +2B7C 26 00 &. LD H,00 +2B7E 29 ) ADD HL,HL ; * 2 fuer Zugriff +2B7F 11 88 2B ..+ LD DE,2B88 ; Tabellen anfang +2B82 19 . ADD HL,DE +2B83 5E ^ LD E,(HL) +2B84 23 # INC HL +2B85 56 V LD D,(HL) ; Sprung addresse --> DE +2B86 EB . EX DE,HL +2B87 E9 . JP (HL) ; EXTERNAL aufrufen------------- +2B88 F3 2F 0 : RTN +2B8A F9 2F 1 : RTN FALSE --> BOOL +2B8C 0A 30 2 : RTN TRUE --> BOOL +2B8E F4 3C 3 : -------- +2B90 38 3D 4 : TERM +2B92 7F 30 5 : GOSUB (adr) +2B94 0E 37 6 : KE +2B96 AF 30 7 : GORET (adr) +2B98 CE 3A 8 : CRD (var, var) +2B9A DA 3A 9 : BCRD (var, var) +2B9C B3 3A 10 : CWR (var, char, int) +2B9E 79 3A 11 : ECWR (var, var, char) +2BA0 1B 3B 12 : CTT (int, refadr) +2BA2 26 3B 13 : GETC (text, posvar) +2BA4 54 3B 14 : FNONBL (charvar, text, posvar) --> BOOL +2BA6 A7 3B 15 : DREM256 (var, var) +2BA8 BC 3B 16 : AMUL256 (var, int) +2BAA F4 3C 17 : --------- +2BAC DF 3B 18 : ISDIG (char) --> BOOL +2BAE CC 3B 19 : ISLD (char) --> BOOL +2BB0 F1 3B 20 : ISLCAS (char) --> BOOL +2BB2 F6 3B 21 : ISUCAS (chasr) --> BOOL +2BB4 FB 3B 22 : GADDR (a, b, c) +2BB6 17 3C 23 : GCADDR (a, b, c) --> BOOL +2BB8 36 3C 24 : ISSHA (int) --> BOOL +2BBA 14 37 25 : SYSGEN +2BBC 42 3C 26 : GETTAB +2BBE 58 3C 27 : PUTTAB +2BC0 62 3C 28 : ERATAB +2BC2 3A 2F 29 : EXEC (modnr) +2BC4 E8 2E 30 : PPROC (modnr) +2BC6 33 2F 31 : PCALL (adr) +2BC8 CC 2E 32 : CASE (switch, limit) +2BCA 86 36 33 : MOVEXX (len, from, to) +2BCC 9A 38 34 : ALIAS (...,...) +2BCE 0C 2D 35 : MOVIM (...,...) +2BD0 4D 35 36 : FEQU (a, b) --> BOOL +2BD2 44 31 37 : TLSEQ (a, b) --> BOOL +2BD4 6E 35 38 : FCOMPL (source, dest) +2BD6 DC 2D 39 : COMPL (source, dest) +2BD8 C1 2D 40 : IMULT (a, b, c) +2BDA A0 2D 41 : MULT (a, b, c) +2BDC AC 2D 42 : DIV (a, b, c) +2BDE B8 2D 43 : MOD (a, b, c) +2BE0 9F 34 44 : ISUB (text, pos, result) +2BE2 8D 34 45 : replace (text, pos, int) +2BE4 A8 31 46 : CODE (text, result) +2BE6 B9 31 47 : ENCODE (int, text) +2BE8 C2 31 48 : SUB (text, pos, result) +2BEA CE 31 49 : subtext (source, from, to, result) +2BEC C8 31 50 : subtext (source, from, result) +2BEE 2F 32 51 : replace (text, pos, text) +2BF0 D4 31 52 : CAT (text, text) +2BF2 97 31 53 : LENGTH (text, result) +2BF4 81 32 54 : pos (source, pattern, result) +2BF6 89 32 55 : pos (source, pattern, from, result) +2BF8 92 32 56 : pos (source, pattern, from, to, result) +2BFA 93 33 57 : stranalyze (row256int, intv,int,text,intv,int,intv) +2BFC 42 33 58 : pos (source, low, high, from, result) +2BFE F4 3C 59 : ------------ +2C00 67 37 60 : out (text) +2C02 1A 37 61 : cout (int) +2C04 5D 37 62 : outsubtext (text, from) +2C06 62 37 63 : outsubtext (text, from, to) +2C08 9E 37 64 : inchar (result) +2C0A BD 37 65 : incharety (result) +2C0C D4 37 66 : pause (time) +2C0E F5 37 67 : getcursor (x, y) +2C10 10 38 68 : catinput (textv, escchar) +2C12 E5 38 69 : nilspace (result) +2C14 EB 38 70 : dscopy (dest, source) +2C16 19 39 71 : forget (ds) +2C18 47 39 72 : settype (ds, type) +2C1A 68 39 73 : gettype (ds, type) +2C1C 79 39 74 : heapsize (ds, size) +2C1E 4E 3D 75 : enablestop +2C20 5B 3D 76 : disablestop +2C22 62 3D 77 : seterrorstop (nr) +2C24 76 3D 78 : iserror --> BOOL +2C26 80 3D 79 : clearerror +2C28 9F 3D 80 : readpcb (field, result) +2C2A 87 41 81 : infopassword (alt, neu, ok) +2C2C E4 35 82 : setclock (task, value) +2C2E 0E 2E 83 : rotate (int, anzahl) +2C30 09 3A 84 : control (fkt, code1, code2, result) +2C32 B3 39 85 : blockout (ds, page, code1, code2, result) +2C34 E5 39 86 : blockin (ds, page, code1, code2, result) +2C36 3B 3A 87 : nextdspage (ds, page, result) +2C38 97 39 88 : pages (ds, task, result) +2C3A 7A 3C 89 : storage (size, used) ? +2C3C 8D 3C 90 : sysop (nr) +2C3E E5 2F 91 : arith15 +2C40 EC 2F 92 : arith16 +2C42 7A 34 93 : heapsize (result) +2C44 88 34 94 : collectheapgarbage +2C46 9D 3E 95 : ? (neues begin) +2C48 7C 35 96 : shiftleftdigits (in, real, out) +2C4A 98 35 97 : decimalexponent (real, result) +2C4C A1 35 98 : setexp (exp, real) +2C4E AE 35 99 : floor (source, dest) +2C50 A3 34 100 : RSUB (text, pos, result) +2C52 91 34 101 : replace (text, pos, real) +2C54 BC 35 102 : clock (nr, result) +2C56 F2 35 103 : setclock (value) +2C58 EB 3D 104 : readpcb (task, field, result) +2C5A F1 3D 105 : writepcb (task, field, value) +2C5C DC 35 106 : readclock (task, result) +2C5E 1E 3E 107 : status (task, result) +2C60 2E 3E 108 : unblock (task) +2C62 41 3E 109 : block (task) +2C64 63 3E 110 : halt process (task) +2C66 6C 3E 111 : create process (... +2C68 52 3F 112 : erase process (task) +2C6A B7 40 113 : send (... +2C6C BD 40 114 : wait (... +2C6E 06 41 115 : call (... +2C70 F7 3A 116 : cdb int (adr, result) +2C72 0E 3B 117 : cdb text (adr, result) +2C74 4F 3E 118 : nextactive (taskandresult) +2C76 EF 36 119 : putword (seg, adr, value) +2C78 E5 36 120 : getword (seg, adr, result) +2C7A 02 2E 121 : XOR (a, b, c) +2C7C 2B 41 122 : pingpong (... +2C7E 5B 3F 123 : exists (task) --> BOOL +2C80 EA 2D 124 : AND (a, b, c) +2C82 F6 2D 125 : OR (a, b, c) +2C84 67 41 126 : session (result) +2C86 96 40 127 : sendfromto (... +2C88 51 41 128 : define collector (task) +2C8A 6E 41 129 : id (field, result) + +2C8C C2 F3 2C .., JP NZ,2CF3 ; C <> 0: LN Befehl, kein Page +2C8F F5 . PUSH AF ; Neuen Block +2C90 3A B6 2A :.* LD A,(2AB6) ; Opcode BF oder LN +2C93 FE 70 .p CP 70 +2C95 28 02 (. JR Z,2C99 +2C97 FE 74 .t CP 74 +2C99 C4 87 42 ..B CALL NZ,4287 ; Neue Seite laden +2C9C F1 . POP AF +2C9D 04 . INC B +2C9E 05 . DEC B ; Flag B = 0 setzen +2C9F C3 B5 2A ..* JP 2AB5 ; Befehl nochmal aufsetzen +2CA2 CD 13 43 ..C CALL 4313 ;-------------------------------- +2CA5 5E ^ LD E,(HL) ; DE := 1. Codewort +2CA6 2C , INC L +2CA7 56 V LD D,(HL) +2CA8 CD 13 43 ..C CALL 4313 ; HL := 2. Codewort +2CAB 7E ~ LD A,(HL) +2CAC 2C , INC L +2CAD 66 f LD H,(HL) +2CAE 6F o LD L,A +2CAF C9 . RET ;----------- Bytemove ------------ +2CB0 04 . INC B +2CB1 05 . DEC B +2CB2 20 12 . JR NZ,2CC6 ; Weniger als 256 Bytes ? +2CB4 79 y LD A,C ; 256 Bytes in einem Schub per LDIR +2CB5 B7 . OR A +2CB6 C8 . RET Z ; Nichts moven +2CB7 85 . ADD L +2CB8 38 07 8. JR C,2CC1 +2CBA 79 y LD A,C +2CBB 83 . ADD E +2CBC 38 03 8. JR C,2CC1 +2CBE ED B0 .. LDIR +2CC0 C9 . RET +2CC1 3E 0D >. LD A,0D +2CC3 B9 . CP C +2CC4 30 0C 0. JR NC,2CD2 +2CC6 CD 78 45 .xE CALL 4578 ; Move in mehreren Teilen +2CC9 C8 . RET Z +2CCA ED B0 .. LDIR +2CCC D0 . RET NC +2CCD CD C1 45 ..E CALL 45C1 +2CD0 18 F4 .. JR 2CC6 +2CD2 7E ~ LD A,(HL) +2CD3 0D . DEC C +2CD4 28 19 (. JR Z,2CEF +2CD6 F5 . PUSH AF +2CD7 D5 . PUSH DE +2CD8 FD 21 85 46 .!.F LD IY,4685 +2CDC 2C , INC L +2CDD CC 1B 45 ..E CALL Z,451B +2CE0 EB . EX DE,HL +2CE1 FD 21 89 46 .!.F LD IY,4689 +2CE5 2C , INC L +2CE6 CC 1B 45 ..E CALL Z,451B +2CE9 EB . EX DE,HL +2CEA CD D2 2C .., CALL 2CD2 ; Teilmove +2CED D1 . POP DE +2CEE F1 . POP AF +2CEF 12 . LD (DE),A +2CF0 C9 . RET ;------------- LONGLN ------------ +2CF1 C6 04 .. ADD A,04 ; +2CF3 07 . RLCA ;------------- LN ---------------- +2CF4 DD 75 20 .u LD (IX+20),L +2CF7 DD 77 21 .w! LD (IX+21),A +2CFA C3 A7 2A ..* JP 2AA7 ;--------- MOV1 ----------------- +2CFD CD 1B 43 ..C CALL 431B ; fromaddresse --> HL +2D00 5E ^ LD E,(HL) +2D01 2C , INC L +2D02 56 V LD D,(HL) +2D03 CD 64 43 .dC CALL 4364 ; toaddresse --> HL +2D06 73 s LD (HL),E +2D07 2C , INC L +2D08 72 r LD (HL),D +2D09 C3 A7 2A ..* JP 2AA7 ;----------- MOVIM -------------- +2D0C CD 43 44 .CD CALL 4443 +2D0F 18 F2 .. JR 2D03 +2D11 CD 6C 43 .lC CALL 436C ;---------- INC1 ---------------- +2D14 34 4 INC (HL) +2D15 C2 A7 2A ..* JP NZ,2AA7 +2D18 2C , INC L +2D19 34 4 INC (HL) +2D1A E2 A7 2A ..* JP PO,2AA7 +2D1D 18 2B .+ JR 2D4A ;-------------- DEC1 ------------- +2D1F CD 6C 43 .lC CALL 436C +2D22 7E ~ LD A,(HL) +2D23 D6 01 .. SUB A,01 +2D25 77 w LD (HL),A +2D26 D2 A7 2A ..* JP NC,2AA7 +2D29 2C , INC L +2D2A 35 5 DEC (HL) +2D2B E2 A7 2A ..* JP PO,2AA7 +2D2E 18 1A .. JR 2D4A ;------------- INC --------------- +2D30 CD 1B 43 ..C CALL 431B +2D33 5E ^ LD E,(HL) +2D34 2C , INC L +2D35 56 V LD D,(HL) +2D36 CD 64 43 .dC CALL 4364 +2D39 7E ~ LD A,(HL) +2D3A 83 . ADD E +2D3B 77 w LD (HL),A +2D3C 2C , INC L +2D3D 7E ~ LD A,(HL) +2D3E 8A . ADC D +2D3F 77 w LD (HL),A +2D40 E2 A7 2A ..* JP PO,2AA7 +2D43 30 05 0. JR NC,2D4A +2D45 3E FF >. LD A,FF +2D47 77 w LD (HL),A +2D48 2D - DEC L +2D49 77 w LD (HL),A +2D4A CD FC 3C ..< CALL 3CFC +2D4D C3 A7 2A ..* JP 2AA7 ;------------- DEC ---------------- +2D50 CD 1B 43 ..C CALL 431B +2D53 5E ^ LD E,(HL) +2D54 2C , INC L +2D55 56 V LD D,(HL) +2D56 CD 64 43 .dC CALL 4364 +2D59 7E ~ LD A,(HL) +2D5A 93 . SUB E +2D5B 77 w LD (HL),A +2D5C 2C , INC L +2D5D 7E ~ LD A,(HL) +2D5E 9A . SBC D +2D5F 77 w LD (HL),A +2D60 E2 A7 2A ..* JP PO,2AA7 +2D63 18 DE .. JR 2D43 ;------------- ADD --------------- +2D65 CD 1B 43 ..C CALL 431B +2D68 5E ^ LD E,(HL) +2D69 2C , INC L +2D6A 56 V LD D,(HL) +2D6B CD 13 43 ..C CALL 4313 +2D6E 7E ~ LD A,(HL) +2D6F 2C , INC L +2D70 66 f LD H,(HL) +2D71 6F o LD L,A +2D72 B7 . OR A +2D73 ED 5A .Z ADC HL,DE +2D75 EC FC 3C ..< CALL PE,3CFC +2D78 EB . EX DE,HL +2D79 CD 64 43 .dC CALL 4364 +2D7C 73 s LD (HL),E +2D7D 2C , INC L +2D7E 72 r LD (HL),D +2D7F C3 A7 2A ..* JP 2AA7 ;------------ SUB ---------------- +2D82 CD 1B 43 ..C CALL 431B +2D85 5E ^ LD E,(HL) +2D86 2C , INC L +2D87 56 V LD D,(HL) +2D88 CD 13 43 ..C CALL 4313 +2D8B 7E ~ LD A,(HL) +2D8C 2C , INC L +2D8D 66 f LD H,(HL) +2D8E 6F o LD L,A +2D8F EB . EX DE,HL +2D90 B7 . OR A +2D91 ED 52 .R SBC HL,DE +2D93 EC FC 3C ..< CALL PE,3CFC +2D96 EB . EX DE,HL +2D97 CD 64 43 .dC CALL 4364 +2D9A 73 s LD (HL),E +2D9B 2C , INC L +2D9C 72 r LD (HL),D +2D9D C3 A7 2A ..* JP 2AA7 ;-------------- MULT ------------ +2DA0 CD A2 2C .., CALL 2CA2 ; Zwei Addressen holen --> HL, DE +2DA3 CD 0D 4D ..M CALL 4D0D ; MULT +2DA6 DC FC 3C ..< CALL C,3CFC ; Overflow, ggf +2DA9 C3 03 2D ..- JP 2D03 ;--------------- DIV ------------ +2DAC CD A2 2C .., CALL 2CA2 +2DAF CD 3D 4D .=M CALL 4D3D ; DIV +2DB2 DC CD 3C ..< CALL C,3CCD +2DB5 C3 03 2D ..- JP 2D03 ;--------------- MOD ------------- +2DB8 CD A2 2C .., CALL 2CA2 +2DBB CD 3D 4D .=M CALL 4D3D ; DIV +2DBE EB . EX DE,HL ; Rest davon +2DBF 18 F1 .. JR 2DB2 ;------------- IMULT ------------- +2DC1 CD A2 2C .., CALL 2CA2 +2DC4 CD 6D 4D .mM CALL 4D6D +2DC7 EB . EX DE,HL +2DC8 CE 00 .. ADC A,00 +2DCA 28 03 (. JR Z,2DCF +2DCC 11 FF FF ... LD DE,FFFF ; Overflow = -1 +2DCF C3 03 2D ..- JP 2D03 ;------------- CLEAR ------------- +2DD2 CD 6C 43 .lC CALL 436C +2DD5 97 . SUB A +2DD6 77 w LD (HL),A +2DD7 2C , INC L +2DD8 77 w LD (HL),A +2DD9 C3 A7 2A ..* JP 2AA7 ;------------- COMPL -------------- +2DDC CD A8 2C .., CALL 2CA8 +2DDF EB . EX DE,HL +2DE0 21 00 00 !.. LD HL,0000 +2DE3 B7 . OR A +2DE4 ED 52 .R SBC HL,DE +2DE6 EB . EX DE,HL +2DE7 C3 03 2D ..- JP 2D03 ;--------------- AND ------------- +2DEA CD A2 2C .., CALL 2CA2 +2DED 7B { LD A,E +2DEE A5 . AND L +2DEF 5F _ LD E,A +2DF0 7A z LD A,D +2DF1 A4 . AND H +2DF2 57 W LD D,A +2DF3 C3 03 2D ..- JP 2D03 ;-------------- OR -------------- +2DF6 CD A2 2C .., CALL 2CA2 +2DF9 7B { LD A,E +2DFA B5 . OR L +2DFB 5F _ LD E,A +2DFC 7A z LD A,D +2DFD B4 . OR H +2DFE 57 W LD D,A +2DFF C3 03 2D ..- JP 2D03 ;---------------- XOR ------------ +2E02 CD A2 2C .., CALL 2CA2 +2E05 7B { LD A,E +2E06 AD . XOR L +2E07 5F _ LD E,A +2E08 7A z LD A,D +2E09 AC . XOR H +2E0A 57 W LD D,A +2E0B C3 03 2D ..- JP 2D03 ;-------------- rotate ------------ +2E0E CD 64 43 .dC CALL 4364 +2E11 E5 . PUSH HL +2E12 5E ^ LD E,(HL) +2E13 2C , INC L +2E14 56 V LD D,(HL) +2E15 CD 13 43 ..C CALL 4313 +2E18 7E ~ LD A,(HL) +2E19 E6 0F .. AND 0F ; keine links/rechts Optimierung +2E1B 28 0A (. JR Z,2E27 +2E1D CB 23 .# SLA E +2E1F CB 12 .. RL D +2E21 30 01 0. JR NC,2E24 +2E23 1C . INC E +2E24 3D = DEC A +2E25 20 F6 . JR NZ,2E1D +2E27 E1 . POP HL +2E28 C3 06 2D ..- JP 2D06 ;------------- TEST --------------- +2E2B CD 1B 43 ..C CALL 431B +2E2E 7E ~ LD A,(HL) +2E2F 2C , INC L +2E30 B6 . OR (HL) +2E31 28 3E (> JR Z,2E71 ; Beide 0 ? +2E33 18 4F .O JR 2E84 ;------------- LSEQ -------------- +2E35 CD 1B 43 ..C CALL 431B +2E38 EB . EX DE,HL +2E39 CD 13 43 ..C CALL 4313 +2E3C EB . EX DE,HL +2E3D 1A . LD A,(DE) +2E3E 96 . SUB (HL) +2E3F 1C . INC E +2E40 2C , INC L +2E41 1A . LD A,(DE) +2E42 9E . SBC (HL) +2E43 E2 48 2E .H. JP PO,2E48 +2E46 EE 80 .. XOR 80 +2E48 F2 71 2E .q. JP P,2E71 +2E4B C3 84 2E ... JP 2E84 ;------------ ULSEQU -------------- +2E4E CD 1B 43 ..C CALL 431B +2E51 EB . EX DE,HL +2E52 CD 13 43 ..C CALL 4313 +2E55 EB . EX DE,HL +2E56 1A . LD A,(DE) +2E57 96 . SUB (HL) +2E58 1C . INC E +2E59 2C , INC L +2E5A 1A . LD A,(DE) +2E5B 9E . SBC (HL) +2E5C 30 13 0. JR NC,2E71 +2E5E 18 24 .$ JR 2E84 ;----------- EQU ----------------- +2E60 CD 1B 43 ..C CALL 431B +2E63 EB . EX DE,HL +2E64 CD 13 43 ..C CALL 4313 +2E67 1A . LD A,(DE) +2E68 BE . CP (HL) +2E69 20 19 . JR NZ,2E84 +2E6B 1C . INC E +2E6C 2C , INC L +2E6D 1A . LD A,(DE) +2E6E BE . CP (HL) +2E6F 20 13 . JR NZ,2E84 +2E71 0A . LD A,(BC) ; TRUE liefern +2E72 6F o LD L,A +2E73 0C . INC C +2E74 0A . LD A,(BC) +2E75 CB 77 .w BIT 6,A +2E77 20 4C L JR NZ,2EC5 +2E79 C3 8E 2E ... JP 2E8E ; zum Branch +2E7C CD 7E 2A .~* CALL 2A7E +2E7F 18 F0 .. JR 2E71 +2E81 CD 7E 2A .~* CALL 2A7E +2E84 0A . LD A,(BC) ; FALSE liefern +2E85 6F o LD L,A +2E86 0C . INC C +2E87 0A . LD A,(BC) +2E88 CB 77 .w BIT 6,A +2E8A 28 39 (9 JR Z,2EC5 ; Opcode veraendern +2E8C E6 87 .. AND 87 ; folgt immer Branch +2E8E B7 . OR A ;------------- BR ----------------- +2E8F 20 14 . JR NZ,2EA5 +2E91 78 x LD A,B +2E92 0F . RRCA +2E93 4D M LD C,L +2E94 CB 21 .! SLA C +2E96 8F . ADC A +2E97 90 . SUB B +2E98 CA A7 2A ..* JP Z,2AA7 +2E9B 80 . ADD B +2E9C 47 G LD B,A +2E9D DD 75 09 .u. LD (IX+09),L +2EA0 C3 A7 2A ..* JP 2AA7 ;------------ LONGBR -------------- +2EA3 C6 04 .. ADD A,04 +2EA5 07 . RLCA +2EA6 DD 86 0A ... ADD (IX+0A) +2EA9 DD BE 0F ... CP (IX+0F) +2EAC FA B1 2E ... JP M,2EB1 +2EAF D6 10 .. SUB A,10 +2EB1 DD 77 0A .w. LD (IX+0A),A +2EB4 7D } LD A,L +2EB5 DD 77 09 .w. LD (IX+09),A +2EB8 4F O LD C,A +2EB9 87 . ADD A +2EBA 08 . EX AF,AF' +2EBB CD AB 42 ..B CALL 42AB +2EBE CB 21 .! SLA C +2EC0 17 . RLA +2EC1 47 G LD B,A +2EC2 C3 A7 2A ..* JP 2AA7 +2EC5 0C . INC C +2EC6 CC A8 42 ..B CALL Z,42A8 +2EC9 C3 A7 2A ..* JP 2AA7 ;------------ CASE ---------------- +2ECC CD A8 2C .., CALL 2CA8 +2ECF CD 43 44 .CD CALL 4443 +2ED2 CB 7C .| BIT 7,H +2ED4 20 AE . JR NZ,2E84 +2ED6 7D } LD A,L +2ED7 93 . SUB E +2ED8 7C | LD A,H +2ED9 9A . SBC D +2EDA 30 A8 0. JR NC,2E84 +2EDC CB 38 .8 SLR B +2EDE CB 19 .. RR C +2EE0 DD 46 0A .F. LD B,(IX+0A) +2EE3 09 . ADD HL,BC +2EE4 23 # INC HL +2EE5 7C | LD A,H +2EE6 18 C9 .. JR 2EB1 ;-------------- PPROC ------------- +2EE8 CD 43 44 .CD CALL 4443 +2EEB EB . EX DE,HL +2EEC 11 02 00 ... LD DE,0002 ; D=0 +2EEF 7C | LD A,H +2EF0 FE 05 .. CP 05 ; Modnr < 1280 : Segment 2 +2EF2 38 01 8. JR C,2EF5 +2EF4 1C . INC E +2EF5 D5 . PUSH DE ; Segment in E auf Stack +2EF6 24 $ INC H ; +0200 = Moduletable +2EF7 24 $ INC H +2EF8 97 . SUB A +2EF9 CD 4D 44 .MD CALL 444D +2EFC 5E ^ LD E,(HL) ; Addresse +2EFD 2C , INC L +2EFE 56 V LD D,(HL) +2EFF D5 . PUSH DE ; REF-Addr auf Stack +2F00 18 0A .. JR 2F0C ;--------------- PPV ------------- +2F02 CD A8 2C .., CALL 2CA8 +2F05 18 03 .. JR 2F0A ;--------------- PP ------------- +2F07 CD C0 43 ..C CALL 43C0 +2F0A D5 . PUSH DE +2F0B E5 . PUSH HL +2F0C 2A C6 41 *.A LD HL,(41C6) ; REF-Addr auf Stack--------------- +2F0F 23 # INC HL +2F10 23 # INC HL +2F11 CB 7C .| BIT 7,H +2F13 C2 D1 3C ..< JP NZ,3CD1 +2F16 5C \ LD E,H +2F17 16 1A .. LD D,1A +2F19 1A . LD A,(DE) +2F1A 67 g LD H,A +2F1B 29 ) ADD HL,HL +2F1C D4 F9 42 ..B CALL NC,42F9 +2F1F D1 . POP DE +2F20 73 s LD (HL),E ; Low Word +2F21 2C , INC L +2F22 72 r LD (HL),D +2F23 2C , INC L +2F24 D1 . POP DE ; High Word +2F25 73 s LD (HL),E +2F26 2C , INC L +2F27 72 r LD (HL),D +2F28 2A C6 41 *.A LD HL,(41C6) ; Stackpointer +2F2B 23 # INC HL +2F2C 23 # INC HL +2F2D 22 C6 41 ".A LD (41C6),HL +2F30 C3 A7 2A ..* JP 2AA7 ;------------- PCALL -------------- +2F33 CD B8 43 ..C CALL 43B8 ; REF-Addr vom Stack +2F36 7B { LD A,E ; Segment +2F37 EB . EX DE,HL +2F38 18 27 .' JR 2F61 ;------------- EXEC --------------- +2F3A CD A8 2C .., CALL 2CA8 +2F3D 7C | LD A,H +2F3E 18 08 .. JR 2F48 ;-------------- CALL ------------- +2F40 CB 7F .. BIT 7,A +2F42 CB BF .. RES 7,A +2F44 28 02 (. JR Z,2F48 +2F46 CB D7 .. SET 2,A +2F48 F5 . PUSH AF +2F49 C6 02 .. ADD A,02 ; Addresse aus Module Addr Tabelle +2F4B 67 g LD H,A +2F4C 5F _ LD E,A +2F4D 16 19 .. LD D,19 +2F4F 1A . LD A,(DE) +2F50 67 g LD H,A +2F51 29 ) ADD HL,HL +2F52 B7 . OR A +2F53 CC E1 42 ..B CALL Z,42E1 +2F56 5E ^ LD E,(HL) +2F57 2C , INC L +2F58 56 V LD D,(HL) +2F59 F1 . POP AF +2F5A FE 05 .. CP 05 +2F5C 3E 02 >. LD A,02 +2F5E 38 01 8. JR C,2F61 +2F60 3C < INC A ; Call PROC +2F61 47 G LD B,A ;---- Segment in A, Addr in HL +2F62 D5 . PUSH DE ; call... + - Fortsetzung in Datei "eumel0.prt.2" - diff --git a/system/eumel0-z80/src/eumel0.prt.2 b/system/eumel0-z80/src/eumel0.prt.2 new file mode 100644 index 0000000..5dbb9b9 --- /dev/null +++ b/system/eumel0-z80/src/eumel0.prt.2 @@ -0,0 +1,3957 @@ +#type ("17.klein")# +ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT + +2F63 2A C8 41 *.A LD HL,(41C8) +2F66 5C \ LD E,H +2F67 16 1A .. LD D,1A +2F69 1A . LD A,(DE) +2F6A 67 g LD H,A +2F6B 29 ) ADD HL,HL +2F6C D4 F9 42 ..B CALL NC,42F9 +2F6F ED 5B C4 41 .[.A LD DE,(41C4) ; Stacktop auf Stack +2F73 73 s LD (HL),E +2F74 2C , INC L +2F75 72 r LD (HL),D +2F76 2C , INC L +2F77 DD CB 09 26 ...& SLA (IX+09) ; icount Felder auf Stack +2F7B CB 19 .. RR C +2F7D 71 q LD (HL),C +2F7E 2C , INC L +2F7F DD 7E 0A .~. LD A,(IX+0A) +2F82 77 w LD (HL),A +2F83 2C , INC L +2F84 DD 7E 0B .~. LD A,(IX+0B) +2F87 77 w LD (HL),A +2F88 2C , INC L +2F89 E6 FC .. AND FC ; Fehlerzustand vererbt sich +2F8B B0 . OR B +2F8C 47 G LD B,A +2F8D D9 . EXX +2F8E 79 y LD A,C +2F8F D9 . EXX +2F90 77 w LD (HL),A +2F91 2C , INC L +2F92 DD 7E 0F .~. LD A,(IX+0F) +2F95 77 w LD (HL),A +2F96 D1 . POP DE +2F97 7A z LD A,D +2F98 C6 10 .. ADD A,10 +2F9A DD 77 0F .w. LD (IX+0F),A +2F9D DD 36 06 18 .6.. LD (IX+06),18 +2FA1 DD 73 09 .s. LD (IX+09),E ; icount neu setzen +2FA4 DD 72 0A .r. LD (IX+0A),D +2FA7 DD 70 0B .p. LD (IX+0B),B +2FAA 4B K LD C,E +2FAB 7B { LD A,E +2FAC 87 . ADD A +2FAD 08 . EX AF,AF' +2FAE CD AB 42 ..B CALL 42AB +2FB1 CB 21 .! SLA C +2FB3 17 . RLA +2FB4 47 G LD B,A +2FB5 0A . LD A,(BC) +2FB6 5F _ LD E,A +2FB7 0C . INC C +2FB8 0A . LD A,(BC) +2FB9 57 W LD D,A +2FBA 0C . INC C +2FBB CC 87 42 ..B CALL Z,4287 +2FBE DD 36 06 00 .6.. LD (IX+06),00 +2FC2 2A C8 41 *.A LD HL,(41C8) +2FC5 22 C4 41 ".A LD (41C4),HL ; Stacktop neu setzen +2FC8 B7 . OR A +2FC9 ED 5A .Z ADC HL,DE +2FCB EA D1 3C ..< JP PE,3CD1 +2FCE 22 C8 41 ".A LD (41C8),HL +2FD1 23 # INC HL +2FD2 23 # INC HL +2FD3 22 C6 41 ".A LD (41C6),HL ; Stackpointer neu setzen +2FD6 CB 7C .| BIT 7,H +2FD8 CA A7 2A ..* JP Z,2AA7 ; Stackoverflow bei CALL +2FDB C3 D1 3C ..< JP 3CD1 ;------------ PENTER ------------- +2FDE 7D } LD A,L +2FDF D9 . EXX +2FE0 4F O LD C,A ; C' = Packetbase +2FE1 D9 . EXX +2FE2 C3 A7 2A ..* JP 2AA7 ;------------- arith15 ------------ +2FE5 DD CB 0B A6 .... RES 4,(IX+0B) +2FE9 C3 A7 2A ..* JP 2AA7 ;------------- arith16 ------------ +2FEC DD CB 0B E6 .... SET 4,(IX+0B) +2FF0 C3 A7 2A ..* JP 2AA7 ;------------- RTN ---------------- +2FF3 CD 35 30 .50 CALL 3035 ; LEAVE PROC +2FF6 C3 A7 2A ..* JP 2AA7 ;------------- RTN FALSE ---------- +2FF9 CD 1B 30 ..0 CALL 301B +2FFC DD 36 06 10 .6.. LD (IX+06),10 ; Status LEAVE PROC FALSE +3000 CD 38 30 .80 CALL 3038 +3003 DD 36 06 00 .6.. LD (IX+06),00 ; Status wieder busy, BR FALSEmodif. +3007 C3 71 2E .q. JP 2E71 ;-------------- RTN TRUE ---------- +300A CD 1B 30 ..0 CALL 301B +300D DD 36 06 14 .6.. LD (IX+06),14 ; Status LEAVE PROC TRUE +3011 CD 38 30 .80 CALL 3038 +3014 DD 36 06 00 .6.. LD (IX+06),00 ; Wieder Busy +3018 C3 84 2E ... JP 2E84 ; BR TRUE modif. +301B 2A C4 41 *.A LD HL,(41C4) ;-------- LEAVE PROC ------------- +301E 44 D LD B,H +301F 4D M LD C,L ; ALten Stacktop wiederherstellen +3020 22 C8 41 ".A LD (41C8),HL +3023 23 # INC HL +3024 23 # INC HL +3025 22 C6 41 ".A LD (41C6),HL ; +2 = Neuer Stacktop +3028 2B + DEC HL +3029 2B + DEC HL +302A 5C \ LD E,H +302B 16 1A .. LD D,1A +302D 1A . LD A,(DE) +302E 67 g LD H,A +302F 29 ) ADD HL,HL +3030 B7 . OR A +3031 C0 . RET NZ +3032 C3 E1 42 ..B JP 42E1 ;-------------------------------- +3035 CD 1B 30 ..0 CALL 301B ; LEAVE PROC +3038 5E ^ LD E,(HL) +3039 2C , INC L +303A 56 V LD D,(HL) +303B 7B { LD A,E +303C 91 . SUB C +303D 7A z LD A,D +303E 98 . SBC B +303F 30 37 07 JR NC,3078 ; Stack underflow, Harakiri +3041 2C , INC L +3042 ED 53 C4 41 .S.A LD (41C4),DE ; Stacktop +3046 4E N LD C,(HL) +3047 2C , INC L +3048 DD 71 09 .q. LD (IX+09),C ; icount wiederherstellen +304B 7E ~ LD A,(HL) +304C 2C , INC L +304D DD 77 0A .w. LD (IX+0A),A +3050 DD 7E 0B .~. LD A,(IX+0B) +3053 E6 80 .. AND 80 +3055 5E ^ LD E,(HL) +3056 CB BB .. RES 7,E +3058 B3 . OR E +3059 DD 77 0B .w. LD (IX+0B),A ; iserror uebernehmen +305C 2C , INC L +305D E6 C0 .. AND C0 +305F FE 80 .. CP 80 +3061 CA 2E 3D ..= JP Z,3D2E ; errorstop +3064 7E ~ LD A,(HL) +3065 2C , INC L +3066 D9 . EXX +3067 4F O LD C,A +3068 D9 . EXX +3069 7E ~ LD A,(HL) +306A DD 77 0F .w. LD (IX+0F),A +306D 79 y LD A,C +306E 87 . ADD A +306F 08 . EX AF,AF' +3070 CD AB 42 ..B CALL 42AB +3073 CB 21 .! SLA C +3075 17 . RLA +3076 47 G LD B,A +3077 C9 . RET +3078 DD 36 06 FF .6.. LD (IX+06),FF ; dead setzen. "Harakiri" +307C C3 26 29 .&) JP 2926 ;-------------- GOSUB ------------- +307F CD 43 44 .CD CALL 4443 ; Branchaddresse holen +3082 D5 . PUSH DE +3083 2A C8 41 *.A LD HL,(41C8) +3086 5C \ LD E,H +3087 16 1A .. LD D,1A +3089 1A . LD A,(DE) +308A 67 g LD H,A +308B 29 ) ADD HL,HL +308C D4 F9 42 ..B CALL NC,42F9 +308F DD 7E 09 .~. LD A,(IX+09) ; icount auf Stack (Seg.bleibt)! +3092 87 . ADD A +3093 CB 19 .. RR C +3095 71 q LD (HL),C +3096 2C , INC L +3097 DD 7E 0A .~. LD A,(IX+0A) +309A 77 w LD (HL),A +309B 2A C8 41 *.A LD HL,(41C8) ; Stackpointer INCR 4 +309E 23 # INC HL +309F 23 # INC HL +30A0 23 # INC HL +30A1 23 # INC HL +30A2 22 C8 41 ".A LD (41C8),HL +30A5 23 # INC HL +30A6 23 # INC HL +30A7 22 C6 41 ".A LD (41C6),HL ; stacktop +30AA E1 . POP HL +30AB 7C | LD A,H ; BRANCH +30AC C3 8E 2E ... JP 2E8E ;------------- GORET ------------- +30AF 2A C8 41 *.A LD HL,(41C8) ; Stackpointer vom Stack +30B2 2B + DEC HL +30B3 2B + DEC HL +30B4 22 C6 41 ".A LD (41C6),HL +30B7 2B + DEC HL +30B8 2B + DEC HL +30B9 22 C8 41 ".A LD (41C8),HL +30BC 5C \ LD E,H +30BD 16 1A .. LD D,1A +30BF 1A . LD A,(DE) +30C0 67 g LD H,A +30C1 29 ) ADD HL,HL +30C2 B7 . OR A +30C3 CC E1 42 ..B CALL Z,42E1 +30C6 2C , INC L +30C7 7E ~ LD A,(HL) +30C8 2D - DEC L +30C9 6E n LD L,(HL) ; BRANCH +30CA C3 B1 2E ... JP 2EB1 ;------------- TMOV -------------- +30CD CD 92 46 ..F CALL 4692 +30D0 FE 02 .. CP 02 +30D2 30 0F 0. JR NC,30E3 +30D4 B7 . OR A +30D5 28 01 (. JR Z,30D8 +30D7 56 V LD D,(HL) +30D8 CD 64 43 .dC CALL 4364 +30DB 2C , INC L +30DC 2C , INC L +30DD 73 s LD (HL),E +30DE 2C , INC L +30DF 72 r LD (HL),D +30E0 C3 A7 2A ..* JP 2AA7 +30E3 DD CB 07 DE .... SET 3,(IX+07) +30E7 E5 . PUSH HL +30E8 D5 . PUSH DE +30E9 CD AA 47 ..G CALL 47AA +30EC D1 . POP DE +30ED CD 68 48 .hH CALL 4868 +30F0 42 B LD B,D +30F1 4B K LD C,E +30F2 EB . EX DE,HL +30F3 E3 . EX (SP),HL +30F4 7B { LD A,E +30F5 95 . SUB L +30F6 7A z LD A,D +30F7 20 01 . JR NZ,30FA +30F9 94 . SUB H +30FA C4 B0 2C .., CALL NZ,2CB0 +30FD CD E8 45 ..E CALL 45E8 +3100 D1 . POP DE +3101 CD 92 48 ..H CALL 4892 +3104 DD CB 07 9E .... RES 3,(IX+07) +3108 ED 4B D0 41 .K.A LD BC,(41D0) +310C C3 A7 2A ..* JP 2AA7 ;------------ TEQU ---------------- +310F CD 92 46 ..F CALL 4692 +3112 FE 02 .. CP 02 +3114 30 09 0. JR NC,311F +3116 2D - DEC L +3117 E5 . PUSH HL +3118 CD 07 44 ..D CALL 4407 +311B D1 . POP DE +311C C3 67 2E .g. JP 2E67 +311F E5 . PUSH HL +3120 D5 . PUSH DE +3121 CD DD 46 ..F CALL 46DD +3124 E3 . EX (SP),HL +3125 B7 . OR A +3126 ED 52 .R SBC HL,DE +3128 20 15 . JR NZ,313F +312A ED 43 D0 41 .C.A LD (41D0),BC +312E 4B K LD C,E +312F 42 B LD B,D +3130 D1 . POP DE +3131 E1 . POP HL +3132 CD 7A 31 .z1 CALL 317A +3135 ED 4B D0 41 .K.A LD BC,(41D0) +3139 C2 84 2E ... JP NZ,2E84 +313C C3 71 2E .q. JP 2E71 +313F D1 . POP DE +3140 E1 . POP HL +3141 C3 84 2E ... JP 2E84 ;------------- TLSEQU ------------ +3144 CD 8D 46 ..F CALL 468D +3147 E5 . PUSH HL +3148 D5 . PUSH DE +3149 CD DD 46 ..F CALL 46DD +314C E3 . EX (SP),HL +314D 7B { LD A,E +314E 95 . SUB L +314F 7A z LD A,D +3150 9C . SBC H +3151 32 D3 41 2.A LD (41D3),A +3154 30 01 0. JR NC,3157 +3156 EB . EX DE,HL +3157 ED 43 D0 41 .C.A LD (41D0),BC +315B 44 D LD B,H +315C 4D M LD C,L +315D D1 . POP DE +315E E1 . POP HL +315F 78 x LD A,B +3160 B1 . OR C +3161 C4 7A 31 .z1 CALL NZ,317A +3164 ED 4B D0 41 .K.A LD BC,(41D0) +3168 28 06 (. JR Z,3170 +316A D2 71 2E .q. JP NC,2E71 +316D C3 84 2E ... JP 2E84 +3170 3A D3 41 :.A LD A,(41D3) +3173 B7 . OR A +3174 F2 71 2E .q. JP P,2E71 +3177 C3 84 2E ... JP 2E84 +317A CD 78 45 .xE CALL 4578 +317D 30 0B 0. JR NC,318A +317F CD 8A 31 ..1 CALL 318A +3182 C2 EC 45 ..E JP NZ,45EC +3185 CD C1 45 ..E CALL 45C1 +3188 18 F0 .. JR 317A +318A C8 . RET Z +318B 1A . LD A,(DE) +318C BE . CP (HL) +318D C0 . RET NZ +318E 2C , INC L +318F 1C . INC E +3190 0D . DEC C +3191 C2 8B 31 ..1 JP NZ,318B +3194 97 . SUB A +3195 47 G LD B,A +3196 C9 . RET ;------------- LENGTH ------------ +3197 CD 13 43 ..C CALL 4313 +319A 23 # INC HL +319B 23 # INC HL +319C 5E ^ LD E,(HL) +319D 16 00 .. LD D,00 +319F 7B { LD A,E +31A0 3C < INC A +31A1 C2 03 2D ..- JP NZ,2D03 +31A4 2C , INC L +31A5 C3 00 2D ..- JP 2D00 ;--------------- CODE ------------ +31A8 CD 8D 46 ..F CALL 468D +31AB 11 FF FF ... LD DE,FFFF ; Wenn Laenge <> 1 ==> -1 +31AE FE 01 .. CP 01 +31B0 C2 03 2D ..- JP NZ,2D03 +31B3 5E ^ LD E,(HL) ; sonst erstes Zeichen +31B4 16 00 .. LD D,00 +31B6 C3 03 2D ..- JP 2D03 ;-------------- ENCODE ----------- +31B9 CD 13 43 ..C CALL 4313 +31BC 1E 01 .. LD E,01 ; Laenge 1 +31BE 56 V LD D,(HL) +31BF C3 D8 30 ..0 JP 30D8 ;-------------- TSUB ------------- +31C2 CD 2C 47 .,G CALL 472C +31C5 C3 D4 30 ..0 JP 30D4 ;------------- subtext 1 --------- +31C8 CD 89 47 ..G CALL 4789 +31CB C3 D0 30 ..0 JP 30D0 ;------------- subtext 2 --------- +31CE CD 95 47 ..G CALL 4795 +31D1 C3 D0 30 ..0 JP 30D0 ;------------- CAT --------------- +31D4 CD B8 43 ..C CALL 43B8 +31D7 ED 53 CE 41 .S.A LD (41CE),DE +31DB E5 . PUSH HL +31DC CD 8D 46 ..F CALL 468D +31DF 2D - DEC L +31E0 7E ~ LD A,(HL) +31E1 32 D2 41 2.A LD (41D2),A +31E4 E3 . EX (SP),HL +31E5 D5 . PUSH DE +31E6 ED 5B CE 41 .[.A LD DE,(41CE) +31EA CD AD 47 ..G CALL 47AD +31ED ED 53 40 4B .S@K LD (4B40),DE +31F1 E3 . EX (SP),HL +31F2 EB . EX DE,HL +31F3 B7 . OR A +31F4 ED 5A .Z ADC HL,DE +31F6 FA 26 32 .&2 JP M,3226 +31F9 22 CC 41 ".A LD (41CC),HL +31FC EB . EX DE,HL +31FD E3 . EX (SP),HL +31FE CD AD 48 ..H CALL 48AD +3201 38 28 8( JR C,322B +3203 ED 5B 40 4B .[@K LD DE,(4B40) +3207 CD 0D 45 ..E CALL 450D +320A EB . EX DE,HL +320B C1 . POP BC +320C E1 . POP HL +320D 3A D2 41 :.A LD A,(41D2) +3210 BE . CP (HL) +3211 C2 26 29 .&) JP NZ,2926 +3214 2C , INC L +3215 CD B0 2C .., CALL 2CB0 +3218 ED 5B CC 41 .[.A LD DE,(41CC) +321C CD 92 48 ..H CALL 4892 +321F ED 4B D0 41 .K.A LD BC,(41D0) +3223 C3 A7 2A ..* JP 2AA7 +3226 3E 07 >. LD A,07 +3228 CD 0D 3D ..= CALL 3D0D +322B C1 . POP BC +322C E1 . POP HL +322D 18 F0 .. JR 321F ;------------ replace text ------- +322F CD AA 47 ..G CALL 47AA +3232 ED 4B D0 41 .K.A LD BC,(41D0) +3236 E5 . PUSH HL +3237 CD A8 2C .., CALL 2CA8 +323A EB . EX DE,HL +323B 1B . DEC DE +323C B7 . OR A +323D ED 52 .R SBC HL,DE +323F 38 21 8! JR C,3262 +3241 E3 . EX (SP),HL +3242 CD 0D 45 ..E CALL 450D +3245 E3 . EX (SP),HL +3246 E5 . PUSH HL +3247 CD 8D 46 ..F CALL 468D +324A ED 43 D0 41 .C.A LD (41D0),BC +324E C1 . POP BC +324F 79 y LD A,C +3250 93 . SUB E +3251 78 x LD A,B +3252 9A . SBC D +3253 38 02 8. JR C,3257 +3255 4B K LD C,E +3256 42 B LD B,D +3257 D1 . POP DE +3258 CD B0 2C .., CALL 2CB0 +325B ED 4B D0 41 .K.A LD BC,(41D0) +#25F C3 A7 2A ..* JP 2AA7 +3262 E1 . POP HL +3263 18 FA .. JR 325F +3265 CD 8D 46 ..F CALL 468D +3268 E3 . EX (SP),HL +3269 D5 . PUSH DE +326A E5 . PUSH HL +326B CD DD 46 ..F CALL 46DD +326E 7E ~ LD A,(HL) +326F 32 D4 41 2.A LD (41D4),A +3272 22 D8 41 ".A LD (41D8),HL +3275 3A 8A 46 :.F LD A,(468A) +3278 32 DA 41 2.A LD (41DA),A +327B 1B . DEC DE +327C ED 53 D6 41 .S.A LD (41D6),DE +3280 C9 . RET ;------------ pos 1 -------------- +3281 CD 65 32 .e2 CALL 3265 +3284 11 01 00 ... LD DE,0001 +3287 18 1E .. JR 32A7 ;----------- pos 2 --------------- +3289 CD 65 32 .e2 CALL 3265 +328C CD A8 2C .., CALL 2CA8 +328F EB . EX DE,HL +3290 18 15 .. JR 32A7 ;------------- pos 3 ------------- +3292 CD 65 32 .e2 CALL 3265 +3295 CD A8 2C .., CALL 2CA8 +3298 EB . EX DE,HL +3299 CD A8 2C .., CALL 2CA8 +329C EB . EX DE,HL +329D E3 . EX (SP),HL +329E 7B { LD A,E +329F 95 . SUB L +32A0 7A z LD A,D +32A1 9C . SBC H +32A2 30 01 0. JR NC,32A5 +32A4 EB . EX DE,HL +32A5 E3 . EX (SP),HL +32A6 EB . EX DE,HL +32A7 CD 64 43 .dC CALL 4364 +32AA 22 CC 41 ".A LD (41CC),HL +32AD ED 43 D0 41 .C.A LD (41D0),BC +32B1 C1 . POP BC +32B2 2A D6 41 *.A LD HL,(41D6) +32B5 24 $ INC H +32B6 25 % DEC H +32B7 20 3B ; JR NZ,32F4 +32B9 79 y LD A,C +32BA 95 . SUB L +32BB 4F O LD C,A +32BC 78 x LD A,B +32BD 9C . SBC H +32BE 47 G LD B,A +32BF E1 . POP HL +32C0 38 33 83 JR C,32F5 +32C2 CD 1D 46 ..F CALL 461D +32C5 38 2E 8. JR C,32F5 +32C7 CD 44 45 .DE CALL 4544 +32CA 28 29 () JR Z,32F5 +32CC F5 . PUSH AF +32CD 3A D4 41 :.A LD A,(41D4) +32D0 ED B1 .. CPIR +32D2 CC FA 32 ..2 CALL Z,32FA +32D5 28 0C (. JR Z,32E3 +32D7 78 x LD A,B +32D8 B1 . OR C +32D9 20 F2 . JR NZ,32CD +32DB F1 . POP AF +32DC 30 17 0. JR NC,32F5 +32DE CD C1 45 ..E CALL 45C1 +32E1 18 E4 .. JR 32C7 +32E3 F1 . POP AF +32E4 CD 33 46 .3F CALL 4633 +32E7 ED 4B D0 41 .K.A LD BC,(41D0) +32EB 2A CC 41 *.A LD HL,(41CC) +32EE 73 s LD (HL),E +32EF 2C , INC L +32F0 72 r LD (HL),D +32F1 C3 A7 2A ..* JP 2AA7 +32F4 E1 . POP HL +32F5 11 00 00 ... LD DE,0000 +32F8 18 ED .. JR 32E7 +32FA 3A D6 41 :.A LD A,(41D6) +32FD B7 . OR A +32FE C8 . RET Z +32FF C5 . PUSH BC +3300 03 . INC BC +3301 CD F1 45 ..E CALL 45F1 +3304 ED 5B 85 46 .[.F LD DE,(4685) +3308 D5 . PUSH DE +3309 E5 . PUSH HL +330A 3A D6 41 :.A LD A,(41D6) +330D 47 G LD B,A +330E 2B + DEC HL +330F ED 5B D8 41 .[.A LD DE,(41D8) +3313 3A DA 41 :.A LD A,(41DA) +3316 32 8A 46 2.F LD (468A),A +3319 2C , INC L +331A 20 07 . JR NZ,3323 +331C FD 21 85 46 .!.F LD IY,4685 +3320 CD 1B 45 ..E CALL 451B +3323 1C . INC E +3324 20 09 . JR NZ,332F +3326 FD 21 89 46 .!.F LD IY,4689 +332A EB . EX DE,HL +332B CD 1B 45 ..E CALL 451B +332E EB . EX DE,HL +332F 1A . LD A,(DE) +3330 BE . CP (HL) +3331 20 02 . JR NZ,3335 +3333 10 E4 .. DJNZ 3319 +3335 F5 . PUSH AF +3336 CD 12 46 ..F CALL 4612 +3339 F1 . POP AF +333A E1 . POP HL +333B D1 . POP DE +333C C1 . POP BC +333D ED 53 85 46 .S.F LD (4685),DE +3341 C9 . RET ;------------ pos high low ------- +3342 CD 8D 46 ..F CALL 468D +3345 D5 . PUSH DE +3346 E5 . PUSH HL +3347 CD 13 43 ..C CALL 4313 +334A 23 # INC HL +334B 23 # INC HL +334C 23 # INC HL +334D 5E ^ LD E,(HL) +334E CD 13 43 ..C CALL 4313 +3351 23 # INC HL +3352 23 # INC HL +3353 23 # INC HL +3354 56 V LD D,(HL) +3355 ED 53 D4 41 .S.A LD (41D4),DE +3359 CD A8 2C .., CALL 2CA8 +335C E5 . PUSH HL +335D CD 64 43 .dC CALL 4364 +3360 22 CC 41 ".A LD (41CC),HL +3363 ED 43 D0 41 .C.A LD (41D0),BC +3367 D1 . POP DE +3368 E1 . POP HL +3369 C1 . POP BC +336A CD 1D 46 ..F CALL 461D +336D DA F5 32 ..2 JP C,32F5 +3370 CD 44 45 .DE CALL 4544 +3373 CA F5 32 ..2 JP Z,32F5 +3376 F5 . PUSH AF +3377 ED 5B D4 41 .[.A LD DE,(41D4) +337B 0B . DEC BC +337C 7A z LD A,D +337D BE . CP (HL) +337E 38 05 8. JR C,3385 +3380 7E ~ LD A,(HL) +3381 BB . CP E +3382 D2 E3 32 ..2 JP NC,32E3 +3385 23 # INC HL +3386 78 x LD A,B +3387 B1 . OR C +3388 20 F1 . JR NZ,337B +338A F1 . POP AF +338B D2 F5 32 ..2 JP NC,32F5 +338E CD C1 45 ..E CALL 45C1 +3391 18 DD .. JR 3370 ;------------- stranalyze --------- +3393 CD B8 43 ..C CALL 43B8 ; REF-Addr vom Stack (HL,DE) +3396 FD 21 89 46 .!.F LD IY,4689 +339A FD 72 03 .r. LD (IY+03),D ; Dataspace +339D 7B { LD A,E ; Segment +339E CD CA 44 ..D CALL 44CA ; Block holen HL = Speicheraddr +33A1 CB 3C .< SLR H ; --> Wordaddr konvertieren +33A3 CB 1D .. RR L +33A5 22 DB 41 ".A LD (41DB),HL ; Block 1 Wortaddr +33A8 29 ) ADD HL,HL ; --> Byteaddr konv. +33A9 11 FE 01 ... LD DE,01FE ; Ende des Blocks auch lesen +33AC CD 0D 45 ..E CALL 450D ; (schlimmstenfalls also 2 Bloecke) +33AF CB 3C .< SLR H ; 2. Block Wortaddr +33B1 CB 1D .. RR L +33B3 22 DD 41 ".A LD (41DD),HL ; Block 2 Wortaddr +33B6 CD 64 43 .dC CALL 4364 ; Addresse d.INT VAR summe holen +33B9 22 DF 41 ".A LD (41DF),HL +33BC CD A8 2C .., CALL 2CA8 ; INT CONST maxbreite holen +33BF 22 E1 41 ".A LD (41E1),HL +33C2 CD 8D 46 ..F CALL 468D ; TEXT CONST zeile holen +33C5 E5 . PUSH HL +33C6 CD 64 43 .dC CALL 4364 ; INT VAR pos holen +33C9 E5 . PUSH HL +33CA CD A8 2C .., CALL 2CA8 ; INT CONST to-pos holen +33CD 7B { LD A,E +33CE 95 . SUB L +33CF 7A z LD A,D ; falls to < from beide vertauschen +33D0 9C . SBC H +33D1 38 01 8. JR C,33D4 +33D3 EB . EX DE,HL +33D4 CD 64 43 .dC CALL 4364 ; INT VAR exit addr holen +33D7 22 E3 41 ".A LD (41E3),HL ; exit addresse +33DA ED 43 D0 41 .C.A LD (41D0),BC ; BC retten +33DE 42 B LD B,D ; BC := to pos +33DF 4B K LD C,E +33E0 E1 . POP HL ; pos addresse +33E1 22 CC 41 ".A LD (41CC),HL +33E4 5E ^ LD E,(HL) ; poswert holen --> DE +33E5 2C , INC L +33E6 56 V LD D,(HL) +33E7 E1 . POP HL ; TEXT zeile +33E8 CD 1D 46 ..F CALL 461D ; TEXT Zugriff +33EB DA 56 34 .V4 JP C,3456 ; Fehlerausgang +33EE CD 44 45 .DE CALL 4544 ; Zeichenaddr (Text SUB pos)--> HL +33F1 CA 56 34 .V4 JP Z,3456 ; Fehlerausgang, wenn > TEXT-Laenge +33F4 F5 . PUSH AF ; Flag (C) merken +33F5 DD CB 07 5E ...^ BIT 3,(IX+07) ; Extension-Bit (Skip next char) +33F9 20 4D M JR NZ,3448 ; Res BIT 3 und bernaechstes zeichen +33FB 7E ~ LD A,(HL) ; A = ROW-Offset (Code) +33FC E5 . PUSH HL +33FD 2A DB 41 *.A LD HL,(41DB) ; Block 1 Wortaddr +3400 85 . ADD L +3401 30 03 0. JR NC,3406 +3403 2A DD 41 *.A LD HL,(41DD) ; Block 2 Wortaddr +3406 6F o LD L,A +3407 29 ) ADD HL,HL +3408 5E ^ LD E,(HL) ; DE := tabelle(A) +3409 2C , INC L +340A 56 V LD D,(HL) +340B ED 53 CE 41 .S.A LD (41CE),DE ; fuer exit merken +340F CB 7A .z BIT 7,D +3411 28 06 (. JR Z,3419 ; < 0 : Extensionchar (Skip next) +3413 CB BA .. RES 7,D ; Fr Summierung positiv machen +3415 DD CB 07 DE .... SET 3,(IX+07) ; merken, dass DE negativ war +3419 2A DF 41 *.A LD HL,(41DF) ; Addresse von 'summe' +341C 7E ~ LD A,(HL) ; DE INCR summe +341D 83 . ADD E +3477 C3 06 2D ..- JP 2D06 ;---------- task heapsize --------- +347A 3A CB 41 :.A LD A,(41CB) ; heaptop DIV 4 +1 +347D CB 3F .? SLR A +347F CB 3F .? SLR A +3481 3C < INC A +3482 5F _ LD E,A +3483 16 00 .. LD D,00 +3485 C3 03 2D ..- JP 2D03 ;----------- collect heap garbage - +3488 79 y LD A,C ; pbase ? +3489 08 . EX AF,AF' +348A C3 33 4A .3J JP 4A33 ;----------- replace int --------- +348D 3E 01 >. LD A,01 ; 1 Wort +348F 18 02 .. JR 3493 ;----------- replace real ------- +3491 3E 07 >. LD A,07 ; 7 Woerter +3493 32 D2 41 2.A LD (41D2),A +3496 CD AA 47 ..G CALL 47AA +3499 ED 4B D0 41 .K.A LD BC,(41D0) +349D 18 0C .. JR 34AB ;-------------- ISUB ------------- +349F 3E 01 >. LD A,01 +34A1 18 02 .. JR 34A5 ;------------- RSUB -------------- +34A3 3E 07 >. LD A,07 +34A5 32 D2 41 2.A LD (41D2),A +34A8 CD 8D 46 ..F CALL 468D +34AB E5 . PUSH HL +34AC CD A8 2C .., CALL 2CA8 +34AF 2B + DEC HL +34B0 CB 7C .| BIT 7,H +34B2 C4 D9 3C ..< CALL NZ,3CD9 +34B5 29 ) ADD HL,HL +34B6 3A D2 41 :.A LD A,(41D2) +34B9 FE 01 .. CP 01 +34BB 28 02 (. JR Z,34BF +34BD 29 ) ADD HL,HL +34BE 29 ) ADD HL,HL +34BF B5 . OR L +34C0 93 . SUB E +34C1 7C | LD A,H +34C2 9A . SBC D +34C3 D4 D9 3C ..< CALL NC,3CD9 +34C6 EB . EX DE,HL +34C7 E1 . POP HL +34C8 CD 0D 45 ..E CALL 450D +34CB EB . EX DE,HL +34CC FD CB 00 46 ...F BIT 0,(IY+00) +34D0 28 06 (. JR Z,34D8 +34D2 CD 64 43 .dC CALL 4364 +34D5 EB . EX DE,HL +34D6 18 03 .. JR 34DB +34D8 CD 13 43 ..C CALL 4313 +34DB C5 . PUSH BC +34DC 3A D2 41 :.A LD A,(41D2) +34DF 47 G LD B,A +34E0 4F O LD C,A +34E1 D5 . PUSH DE +34E2 11 F3 41 ..A LD DE,41F3 +34E5 7E ~ LD A,(HL) +34E6 12 . LD (DE),A +34E7 2C , INC L +34E8 CC 1B 45 ..E CALL Z,451B +34EB 13 . INC DE +34EC 10 F7 .. DJNZ 34E5 +34EE 7E ~ LD A,(HL) +34EF 12 . LD (DE),A +34F0 E1 . POP HL +34F1 11 F3 41 ..A LD DE,41F3 +34F4 41 A LD B,C +34F5 1A . LD A,(DE) +34F6 77 w LD (HL),A +34F7 2C , INC L +34F8 CC 1B 45 ..E CALL Z,451B +34FB 13 . INC DE +34FC 10 F7 .. DJNZ 34F5 +34FE 1A . LD A,(DE) +34FF 77 w LD (HL),A +3500 C1 . POP BC +3501 C3 A7 2A ..* JP 2AA7 ;----------- FMOV MOV8 ------------ +3504 CD 1B 43 ..C CALL 431B +3507 7D } LD A,L +3508 E6 F8 .. AND F8 +350A 5F _ LD E,A +350B 54 T LD D,H +350C CD 64 43 .dC CALL 4364 +350F 7D } LD A,L +3510 E6 F8 .. AND F8 +3512 6F o LD L,A +3513 EB . EX DE,HL +3514 C5 . PUSH BC +3515 01 08 00 ... LD BC,0008 +3518 F3 . DI +3519 ED B0 .. LDIR +351B FB . EI +351C C1 . POP BC +351D C3 A7 2A ..* JP 2AA7 ;-------------- FADD -------------- +3520 FD 21 2C 4F .!,O LD IY,4F2C +3524 CD AF 44 ..D CALL 44AF +3527 EB . EX DE,HL +3528 CD A7 44 ..D CALL 44A7 +352B CD 60 4E .`N CALL 4E60 +352E 30 DC 0. JR NC,350C +3530 3E 06 >. LD A,06 +3532 CD 0D 3D ..= CALL 3D0D +3535 CD 43 44 .CD CALL 4443 +3538 C3 A7 2A ..* JP 2AA7 ;------------- FSUB --------------- +353B FD 21 20 4F .! O LD IY,4F20 +353F 18 E3 .. JR 3524 ;------------- FMULT -------------- +3541 FD 21 E1 4F .!.O LD IY,4FE1 +3545 18 DD .. JR 3524 ;------------ FDIV ---------------- +3547 FD 21 59 50 .!YP LD IY,5059 +354B 18 D7 .. JR 3524 ;------------ FEQU -------------- +354D CD A7 44 ..D CALL 44A7 +3550 EB . EX DE,HL +3551 CD A7 44 ..D CALL 44A7 +3554 CD 83 4E ..N CALL 4E83 +3557 C2 84 2E ... JP NZ,2E84 +355A C3 71 2E .q. JP 2E71 ;----------- FLSEQ ---------------- +355D CD AF 44 ..D CALL 44AF +3560 EB . EX DE,HL +3561 CD A7 44 ..D CALL 44A7 +3564 EB . EX DE,HL +3565 CD 83 4E ..N CALL 4E83 +3568 DA 84 2E ... JP C,2E84 +356B C3 71 2E .q. JP 2E71 ;------------ FCOMPL ------------- +356E CD A7 44 ..D CALL 44A7 +3571 EB . EX DE,HL +3572 CD B7 44 ..D CALL 44B7 +3575 EB . EX DE,HL +3576 CD D2 4E ..N CALL 4ED2 +3579 C3 A7 2A ..* JP 2AA7 ;--------------- SLD -------------- +357C CD 13 43 ..C CALL 4313 +357F 56 V LD D,(HL) +3580 CD B7 44 ..D CALL 44B7 +3583 E5 . PUSH HL +3584 CD 64 43 .dC CALL 4364 +3587 E3 . EX (SP),HL +3588 97 . SUB A +3589 ED 67 .g RRD +358B 5F _ LD E,A +358C 7A z LD A,D +358D CD 1B 52 ..R CALL 521B +3590 E1 . POP HL +3591 73 s LD (HL),E +3592 2C , INC L +3593 36 00 6. LD (HL),00 +3595 C3 A7 2A ..* JP 2AA7 ;------------ decimalexponent ------ +3598 CD A7 44 ..D CALL 44A7 +359B CD E9 4E ..N CALL 4EE9 +359E C3 03 2D ..- JP 2D03 ;------------ setexp -------------- +35A1 CD 13 43 ..C CALL 4313 +35A4 5E ^ LD E,(HL) +35A5 CD B7 44 ..D CALL 44B7 +35A8 CD E0 4E ..N CALL 4EE0 +35AB C3 A7 2A ..* JP 2AA7 ;------------- floor -------------- +35AE CD A7 44 ..D CALL 44A7 +35B1 EB . EX DE,HL +35B2 CD B7 44 ..D CALL 44B7 +35B5 EB . EX DE,HL +35B6 CD F6 4E ..N CALL 4EF6 +35B9 C3 A7 2A ..* JP 2AA7 ;------------ clock (nr) ---------- +35BC CD 13 43 ..C CALL 4313 +35BF 7E ~ LD A,(HL) +35C0 E6 07 .. AND 07 +35C2 28 0F (. JR Z,35D3 ; clock(0) = Taskclock +35C4 3D = DEC A ; -1 +35C5 87 . ADD A ; *8 (REAL) +35C6 87 . ADD A +35C7 87 . ADD A +35C8 6F o LD L,A +35C9 26 00 &. LD H,00 +35CB 11 B9 4C ..L LD DE,4CB9 ; 4CB9 = clock (1) +35CE 19 . ADD HL,DE +35CF EB . EX DE,HL +35D0 C3 0C 35 ..5 JP 350C ; Move Real +35D3 ED 5B 1C 6E .[.n LD DE,(6E1C) ; Steht im Leitblock ab 38..3f +35D7 1E 38 .8 LD E,38 ; Move real +35D9 C3 0C 35 ..5 JP 350C ;------------ clock (task) -------- +35DC CD C2 3D ..= CALL 3DC2 ; Fremden Leitblock laden +35DF FD E5 .. PUSH IY ; Leitblock addr in IY +35E1 D1 . POP DE +35E2 18 F3 .. JR 35D7 ;----------- setclock task ------- +35E4 CD BA 3D ..= CALL 3DBA +35E7 CD 13 43 ..C CALL 4313 +35EA FD E5 .. PUSH IY +35EC D1 . POP DE +35ED 1E 38 .8 LD E,38 ; Move Real +35EF C3 14 35 ..5 JP 3514 ;---------- setclock ------------- +35F2 DD 7E 1D .~. LD A,(IX+1D) ; priv >= 1 +35F5 FE 01 .. CP 01 +35F7 DA E6 3C ..< JP C,3CE6 ; privilegierungsfehler +35FA CD A7 44 ..D CALL 44A7 ; +35FD 11 B9 4C ..L LD DE,4CB9 +3600 C3 14 35 ..5 JP 3514 ;------------ ACCDS --------------- +3603 CD 1B 43 ..C CALL 431B +3606 CD 11 36 ..6 CALL 3611 ; Test ob DSID > 4 +3609 1E 00 .. LD E,00 ; REF-Addr D=DSID, E=0 +360B D5 . PUSH DE +360C 21 04 01 !.. LD HL,0104 ; Wortaddresse 4 in Seite 1 i. Start +360F 18 23 .# JR 3634 ;------------ DSID > 4 ? ---------- +3611 56 V LD D,(HL) +3612 3E 04 >. LD A,04 +3614 BA . CP D +3615 D2 82 38 ..8 JP NC,3882 ; falscher DATASPACE Zugriff +3618 2C , INC L +3619 7E ~ LD A,(HL) +361A DD BE 30 ..0 CP (IX+30) +361D C2 82 38 ..8 JP NZ,3882 +3620 C9 . RET ;-------------- REF --------------- +3621 CD C0 43 ..C CALL 43C0 ; Wortaddr holen +3624 D5 . PUSH DE ; Zweiwortaddr auf Stack +3625 18 0D .. JR 3634 ;-------------- SEL --------------- +3627 CD C0 43 ..C CALL 43C0 +362A D5 . PUSH DE +362B CD 43 44 .CD CALL 4443 ; Offset holen +362E 19 . ADD HL,DE ; REF:=Base+Offset +362F 30 03 0. JR NC,3634 +3631 D1 . POP DE +3632 1C . INC E +3633 D5 . PUSH DE +3634 EB . EX DE,HL ;---------- REF-Adr auf Stack ----- +3635 CD 64 43 .dC CALL 4364 +3638 73 s LD (HL),E ; 4 Bytes auf Stack +3639 2C , INC L +363A 72 r LD (HL),D +363B 2C , INC L +363C D1 . POP DE +363D 73 s LD (HL),E +363E 2C , INC L +363F 72 r LD (HL),D +3640 C3 A7 2A ..* JP 2AA7 ;------------- SUBS --------------- +3643 67 g LD H,A +3644 E5 . PUSH HL +3645 CD 43 44 .CD CALL 4443 +3648 CD 13 43 ..C CALL 4313 +364B 7E ~ LD A,(HL) +364C 2C , INC L +364D 66 f LD H,(HL) +364E 6F o LD L,A +364F 2B + DEC HL +3650 7B { LD A,E +3651 95 . SUB L +3652 7A z LD A,D +3653 9C . SBC H +3654 DC D9 3C ..< CALL C,3CD9 +3657 EB . EX DE,HL +3658 E1 . POP HL +3659 CD 6D 4D .mM CALL 4D6D +365C DC D9 3C ..< CALL C,3CD9 +365F E5 . PUSH HL +3660 F5 . PUSH AF +3661 CD B8 43 ..C CALL 43B8 +3664 F1 . POP AF +3665 83 . ADD E +3666 5F _ LD E,A +3667 EB . EX DE,HL +3668 E3 . EX (SP),HL +3669 19 . ADD HL,DE +366A 30 C8 0. JR NC,3634 ; REF-Adr auf Stack +366C 18 C3 .. JR 3631 ;------------ EQUIM -------------- +366E EB . EX DE,HL +366F CD 13 43 ..C CALL 4313 +3672 7E ~ LD A,(HL) +3673 BB . CP E +3674 C2 84 2E ... JP NZ,2E84 ; Lowbyte vergleichen +3677 2C , INC L +3678 7E ~ LD A,(HL) ; Highbyte muss 0 sein +3679 B7 . OR A +367A C2 84 2E ... JP NZ,2E84 +367D C3 71 2E .q. JP 2E71 ;-------------- STIM ------------- +3680 EB . EX DE,HL +3681 16 00 .. LD D,00 ; Lowbyte uebernehmen, Highbyte 0 +3683 C3 03 2D ..- JP 2D03 ;-------------- MOVEXX ----------- +3686 CD 43 44 .CD CALL 4443 ; langer move +3689 D5 . PUSH DE +368A 18 03 .. JR 368F ;-------------- MOVX ------------- +368C 26 00 &. LD H,00 ; Highbyte 0 +368E E5 . PUSH HL +368F CD B8 43 ..C CALL 43B8 ; laenge holen +3692 FD 21 85 46 .!.F LD IY,4685 +3696 FD 36 00 01 .6.. LD (IY+00),01 +369A FD 72 03 .r. LD (IY+03),D +369D 7B { LD A,E +369E CD CA 44 ..D CALL 44CA ; from addr holen +36A1 E5 . PUSH HL +36A2 CD B8 43 ..C CALL 43B8 +36A5 FD 21 89 46 .!.F LD IY,4689 +36A9 FD 36 00 00 .6.. LD (IY+00),00 +36AD FD 72 03 .r. LD (IY+03),D +36B0 7B { LD A,E +36B1 CD CA 44 ..D CALL 44CA +36B4 EB . EX DE,HL +36B5 E1 . POP HL +36B6 ED 43 D0 41 .C.A LD (41D0),BC +36BA C1 . POP BC +36BB CB 21 .! SLA C ; Laenge * 2 in Bytes +36BD CB 10 .. RL B +36BF CD B0 2C .., CALL 2CB0 +36C2 ED 4B D0 41 .K.A LD BC,(41D0) +36C6 C3 A7 2A ..* JP 2AA7 ;--------------- GW -------------- +36C9 CD F9 36 ..6 CALL 36F9 ; segment und oofset +36CC CD 4D 44 .MD CALL 444D ; Wert auf Stack +36CF C3 00 2D ..- JP 2D00 ;-------------- PW --------------- +36D2 CD F9 36 ..6 CALL 36F9 ; segment und offset +36D5 CD 7D 44 .}D CALL 447D +36D8 EB . EX DE,HL +36D9 CD 13 43 ..C CALL 4313 +36DC 7E ~ LD A,(HL) +36DD 12 . LD (DE),A ; segment veraendern +36DE 2C , INC L +36DF 1C . INC E +36E0 7E ~ LD A,(HL) +36E1 12 . LD (DE),A +36E2 C3 A7 2A ..* JP 2AA7 ;----------- getword ------------- +36E5 CD 13 43 ..C CALL 4313 ; segment (Nur ein Byte) +36E8 5E ^ LD E,(HL) +36E9 CD A8 2C .., CALL 2CA8 ; wortaddr --> HL +36EC 7B { LD A,E ; Seg in A, addr in HL, Wert a.Stack +36ED 18 DD .. JR 36CC ;------------ putword ------------ +36EF CD 13 43 ..C CALL 4313 +36F2 5E ^ LD E,(HL) ; segment (nur ein byte) +36F3 CD A8 2C .., CALL 2CA8 +36F6 7B { LD A,E ; Segment +36F7 18 DC .. JR 36D5 ;-------------------------------- +36F9 5D ] LD E,L ; L ist Opcode Byte m. Seg und Offse +36FA CD 13 43 ..C CALL 4313 +36FD 7B { LD A,E +36FE 5E ^ LD E,(HL) ; Wortaddr holen +36FF 2C , INC L +3700 56 V LD D,(HL) +3701 67 g LD H,A +3702 E6 0F .. AND 0F ; Low digit = Offset zu Wortaddr +3704 6F o LD L,A +3705 AC . XOR H ; Low DIgit in A = 0 +3706 26 00 &. LD H,00 +3708 19 . ADD HL,DE +3709 0F . RRCA ; A 0 Segment +370A 0F . RRCA +370B 0F . RRCA +370C 0F . RRCA +370D C9 . RET ;------------- KE ---------------- +370E CD 2A 6F .*o CALL 6F2A ; Info " KE" +3711 C3 A7 2A ..* JP 2AA7 ;-------------- SYSGEN ------------ +3714 CD 05 53 ..S CALL 5305 ; RET, Keine Aktion +3717 C3 A7 2A ..* JP 2AA7 ;--------------- cout ------------ +371A CD 13 43 ..C CALL 4313 ; INT holen +371D 5E ^ LD E,(HL) +371E 2C , INC L +371F 56 V LD D,(HL) +3720 C5 . PUSH BC +3721 CB 7A .z BIT 7,D +3723 20 34 4 JR NZ,3759 +3725 DD 7E 26 .~& LD A,(IX+26) ; Am Kanal ? +3728 B7 . OR A +3729 28 2E (. JR Z,3759 ; Nur fuer positive Zahlen +372B CD 59 1E .Y. CALL 1E59 +372E FE 1E .. CP 1E ; Kanal genuegend frei +3730 38 27 8' JR C,3759 +3732 21 20 20 ! LD HL,2020 +3735 22 E9 41 ".A LD (41E9),HL +3738 22 EB 41 ".A LD (41EB),HL ; Puffer loeschen +373B 21 E8 41 !.A LD HL,41E8 +373E CD 00 4E ..N CALL 4E00 ; Konvertieren +3741 21 E7 41 !.A LD HL,41E7 +3744 01 0C 00 ... LD BC,000C ; Stringlaenge 12 +3747 59 Y LD E,C +3748 DD 7E 26 .~& LD A,(IX+26) ; immer noch frei ? +374B B7 . OR A +374C 28 0B (. JR Z,3759 +374E CD 88 21 ..! CALL 2188 ; OUTPUT +3751 38 06 8. JR C,3759 +3753 09 . ADD HL,BC +3754 7B { LD A,E +3755 91 . SUB C +3756 4F O LD C,A +3757 18 EE .. JR 3747 +3759 C1 . POP BC +375A C3 A7 2A ..* JP 2AA7 ;------------ outsubtext 1 -------- +375D CD 89 47 ..G CALL 4789 +3760 18 08 .. JR 376A ;------------ outsubtext 2 -------- +3762 CD 95 47 ..G CALL 4795 +3765 18 03 .. JR 376A ;--------------- out -------------- +3767 CD 8D 46 ..F CALL 468D +376A C5 . PUSH BC +376B 42 B LD B,D +376C 4B K LD C,E +376D CD 44 45 .DE CALL 4544 +3770 28 16 (. JR Z,3788 +3772 F5 . PUSH AF +3773 50 P LD D,B +3774 59 Y LD E,C +3775 DD 7E 26 .~& LD A,(IX+26) +3778 B7 . OR A +3779 28 11 (. JR Z,378C +377B CD 88 21 ..! CALL 2188 ; OUTPUT +377E 30 0F 0. JR NC,378F +3780 F1 . POP AF +3781 30 05 0. JR NC,3788 +3783 CD C1 45 ..E CALL 45C1 +3786 18 E5 .. JR 376D +3788 C1 . POP BC +3789 C3 A7 2A ..* JP 2AA7 +378C 01 00 00 ... LD BC,0000 +378F F1 . POP AF +3790 7B { LD A,E +3791 91 . SUB C +3792 4F O LD C,A +3793 7A z LD A,D +3794 98 . SBC B +3795 47 G LD B,A +3796 CD F1 45 ..E CALL 45F1 +3799 3E 44 >D LD A,44 +379B C3 23 29 .#) JP 2923 ;-------------- inchar ------------ +379E CD 64 43 .dC CALL 4364 +37A1 2C , INC L +37A2 2C , INC L +37A3 DD 7E 26 .~& LD A,(IX+26) ; AM Kanal ? +37A6 B7 . OR A +37A7 28 05 (. JR Z,37AE +37A9 CD 06 1F ... CALL 1F06 ; incharety +37AC 30 05 0. JR NC,37B3 +37AE 3E 48 >H LD A,48 ; Status: Auf Taste warten +37B0 C3 23 29 .#) JP 2923 +37B3 36 01 6. LD (HL),01 ; Text der laenge 1 +37B5 2C , INC L +37B6 77 w LD (HL),A +37B7 CD 29 4C .)L CALL 4C29 +37BA C3 A7 2A ..* JP 2AA7 ;------------- incharety --------- +37BD CD 64 43 .dC CALL 4364 +37C0 2C , INC L +37C1 2C , INC L +37C2 DD 7E 26 .~& LD A,(IX+26) +37C5 B7 . OR A +37C6 28 05 (. JR Z,37CD +37C8 CD 06 1F ... CALL 1F06 +37CB 30 E6 0. JR NC,37B3 ; Text der laenge 1 +37CD 97 . SUB A ; Niltext +37CE 77 w LD (HL),A +37CF 2C , INC L +37D0 77 w LD (HL),A +37D1 C3 A7 2A ..* JP 2AA7 ;-------------- pause ------------ +37D4 CD A8 2C .., CALL 2CA8 +37D7 DD 7E 26 .~& LD A,(IX+26) +37DA B7 . OR A +37DB 28 06 (. JR Z,37E3 +37DD CD AD 1E ... CALL 1EAD ; Taste gedrueckt ? +37E0 D2 A7 2A ..* JP NC,2AA7 +37E3 ED 5B F1 4C .[.L LD DE,(4CF1) +37E7 19 . ADD HL,DE +37E8 DD 75 0C .u. LD (IX+0C),L ; modi := time +37EB DD 74 0D .t. LD (IX+0D),H +37EE 79 y LD A,C +37EF 08 . EX AF,AF' +37F0 3E 4C >L LD A,4C ; Status: pause +37F2 C3 23 29 .#) JP 2923 ;------------ getcursor ----------- +37F5 C5 . PUSH BC +37F6 DD 7E 26 .~& LD A,(IX+26) +37F9 B7 . OR A +37FA C4 85 1E ... CALL NZ,1E85 ; getcursor --> BC +37FD 59 Y LD E,C +37FE 50 P LD D,B +37FF C1 . POP BC ; icount +3800 DA 26 29 .&) JP C,2926 +3803 1C . INC E ; x+1 , y+1 +3804 14 . INC D +3805 CD 64 43 .dC CALL 4364 ; Zwei Werte (wie REF-Adr) auf Stack +3808 72 r LD (HL),D ; Beide Highbytes 0 +3809 16 00 .. LD D,00 +380B 2C , INC L +380C 72 r LD (HL),D +380D C3 03 2D ..- JP 2D03 ;------------ catinput ------------ +3810 CD B8 43 ..C CALL 43B8 +3813 E5 . PUSH HL +3814 D5 . PUSH DE +3815 CD 64 43 .dC CALL 4364 +3818 2C , INC L +3819 2C , INC L +381A 22 CC 41 ".A LD (41CC),HL +381D 97 . SUB A +381E 77 w LD (HL),A +381F 2C , INC L +3820 77 w LD (HL),A +3821 DD 7E 26 .~& LD A,(IX+26) +3824 B7 . OR A +3825 28 44 (D JR Z,386B +3827 D1 . POP DE +3828 E1 . POP HL +3829 E5 . PUSH HL +382A D5 . PUSH DE +382B CD AD 47 ..G CALL 47AD +382E ED 53 40 4B .S@K LD (4B40),DE +3832 D5 . PUSH DE +3833 13 . INC DE +3834 CD AD 48 ..H CALL 48AD +3837 D1 . POP DE +3838 38 2A 8* JR C,3864 +383A CD 1D 4A ..J CALL 4A1D +383D CD 0D 45 ..E CALL 450D +3840 DD 7E 26 .~& LD A,(IX+26) +3843 CD 06 1F ... CALL 1F06 ; incharety +3846 38 1C 8. JR C,3864 +3848 FE 20 . CP 20 +384A 38 11 8. JR C,385D ; < Blank ? +384C 77 w LD (HL),A +384D 13 . INC DE +384E 2C , INC L +384F 7D } LD A,L ; alle 8 Zeichen unterbrechen +3850 E6 07 .. AND 07 +3852 20 EC . JR NZ,3840 +3854 CD 92 48 ..H CALL 4892 +3857 ED 4B D0 41 .K.A LD BC,(41D0) +385B 18 CA .. JR 3827 ; nochmal von vorne +385D 2A CC 41 *.A LD HL,(41CC) +3860 36 01 6. LD (HL),01 ; Text der Laenge 1 = escchar +3862 2C , INC L +3863 77 w LD (HL),A +3864 CD 92 48 ..H CALL 4892 ; Kein Zeichen mehr: CAT... +3867 ED 4B D0 41 .K.A LD BC,(41D0) +386B D1 . POP DE +386C E1 . POP HL +386D C3 A7 2A ..* JP 2AA7 ;------ korrekte DSID in HL ?----- +3870 DD 7E 30 .~0 LD A,(IX+30) ; eigener Taskindex +3873 BC . CP H +3874 20 0C . JR NZ,3882 +3876 7D } LD A,L ; DSnr > 4 +3877 FE 05 .. CP 05 +3879 38 07 8. JR C,3882 +387B C5 . PUSH BC +387C 4D M LD C,L ; exists (ds) ? +387D CD 77 69 .wi CALL 6977 +3880 C1 . POP BC +3881 D0 . RET NC +3882 3E 0B >. LD A,0B ; alias error +3884 CD 0D 3D ..= CALL 3D0D +3887 21 05 00 !.. LD HL,0005 ; Errorspace mit eienem Index +388A 55 U LD D,L +388B 37 7 SCF +388C C9 . RET ;--------------------------------- +388D 55 U LD D,L +388E 1E 00 .. LD E,00 +3890 21 02 01 !.. LD HL,0102 +3893 CD 5C 65 .\e CALL 655C +3896 0F . RRCA +3897 67 g LD H,A +3898 29 ) ADD HL,HL +3899 C9 . RET ;------------ ALIAS -------------- +389A CD 43 44 .CD CALL 4443 ; DSID holen +389D 21 0B 01 !.. LD HL,010B +38A0 19 . ADD HL,DE +38A1 38 0A 8. JR C,38AD +38A3 7D } LD A,L +38A4 E6 F8 .. AND F8 +38A6 6F o LD L,A +38A7 29 ) ADD HL,HL +38A8 30 01 0. JR NC,38AB +38AA 2C , INC L +38AB 18 03 .. JR 38B0 +38AD 21 04 00 !.. LD HL,0004 +38B0 22 CC 41 ".A LD (41CC),HL +38B3 CD A8 2C .., CALL 2CA8 +38B6 CD 70 38 .p8 CALL 3870 +38B9 E5 . PUSH HL +38BA CD 8D 38 ..8 CALL 388D +38BD 2D - DEC L +38BE 2D - DEC L +38BF 7E ~ LD A,(HL) +38C0 3C < INC A +38C1 20 1E . JR NZ,38E1 +38C3 21 00 01 !.. LD HL,0100 +38C6 CD 2C 66 .,f CALL 662C +38C9 0F . RRCA +38CA 67 g LD H,A +38CB 29 ) ADD HL,HL +38CC ED 5B CC 41 .[.A LD DE,(41CC) ; Liefert REF-Addr +38D0 73 s LD (HL),E +38D1 2C , INC L +38D2 72 r LD (HL),D +38D3 2C , INC L +38D4 73 s LD (HL),E +38D5 2C , INC L +38D6 72 r LD (HL),D +38D7 2C , INC L +38D8 CB 7E .~ BIT 7,(HL) +38DA 28 05 (. JR Z,38E1 +38DC 36 00 6. LD (HL),00 +38DE 2C , INC L +38DF 36 00 6. LD (HL),00 +38E1 D1 . POP DE +38E2 C3 03 2D ..- JP 2D03 ;---------- nilspace ------------- +38E5 11 00 00 ... LD DE,0000 +38E8 C3 03 2D ..- JP 2D03 ;----------- dscopy := ----------- +38EB CD 64 43 .dC CALL 4364 ; dest adr holen +38EE E5 . PUSH HL +38EF CD A8 2C .., CALL 2CA8 +38F2 7C | LD A,H +38F3 B5 . OR L +38F4 C4 70 38 .p8 CALL NZ,3870 ; source <> nilspace +38F7 EB . EX DE,HL +38F8 38 0F 8. JR C,3909 +38FA C5 . PUSH BC +38FB DD 46 30 .F0 LD B,(IX+30) ; eigener taskindex +38FE 4B K LD C,E +38FF 50 P LD D,B +3900 CD E8 68 ..h CALL 68E8 ; +3903 C1 . POP BC +3904 1C . INC E ; Anzahl Dataspaces +3905 1D . DEC E +3906 CC 10 39 ..9 CALL Z,3910 ; errorstop durhfuehren als SBRT. +3909 E1 . POP HL +390A 73 s LD (HL),E +390B 2C , INC L +390C 72 r LD (HL),D +390D C3 A7 2A ..* JP 2AA7 +3910 3E 08 >. LD A,08 ; errorstop zuviele DS +3912 CD 0D 3D ..= CALL 3D0D +3915 11 05 00 ... LD DE,0005 ; result ist errorspace +3918 C9 . RET ;------------- forget ------------ +3919 CD 64 43 .dC CALL 4364 +391C C5 . PUSH BC +391D 5E ^ LD E,(HL) +391E 2C , INC L +391F 56 V LD D,(HL) +3920 EB . EX DE,HL +3921 3E 05 >. LD A,05 ; Nur ds > 4 loeschen +3923 BD . CP L +3924 30 17 0. JR NC,393D +3926 CB 7C .| BIT 7,H +3928 28 06 (. JR Z,3930 +392A 7D } LD A,L +392B 84 . ADD H +392C 20 0F . JR NZ,393D +392E 18 06 .. JR 3936 +3930 DD 7E 30 .~0 LD A,(IX+30) +3933 BC . CP H +3934 20 07 . JR NZ,393D +3936 4D M LD C,L +3937 CD 77 69 .wi CALL 6977 +393A D4 97 69 ..i CALL NC,6997 +393D EB . EX DE,HL +393E 36 00 6. LD (HL),00 ; ergebnis 01 DS +3940 2D - DEC L +3941 36 01 6. LD (HL),01 +3943 C1 . POP BC +3944 C3 A7 2A ..* JP 2AA7 ;------------- settype ----------- +3947 CD A8 2C .., CALL 2CA8 +394A EB . EX DE,HL +394B CD A8 2C .., CALL 2CA8 +394E EB . EX DE,HL +394F CD 70 38 .p8 CALL 3870 +3952 38 11 8. JR C,3965 +3954 D5 . PUSH DE +3955 55 U LD D,L +3956 1E 00 .. LD E,00 +3958 21 02 01 !.. LD HL,0102 +395B CD 2C 66 .,f CALL 662C +395E 0F . RRCA +395F 67 g LD H,A +3960 29 ) ADD HL,HL +3961 D1 . POP DE +3962 73 s LD (HL),E ; type im ds ersetzen +3963 2C , INC L +3964 72 r LD (HL),D +3965 C3 A7 2A ..* JP 2AA7 ;------------- gettype ------------ +3968 CD A8 2C .., CALL 2CA8 +396B CD 70 38 .p8 CALL 3870 +396E 38 06 8. JR C,3976 +3970 CD 8D 38 ..8 CALL 388D +3973 5E ^ LD E,(HL) +3974 2C , INC L +3975 56 V LD D,(HL) +3976 C3 03 2D ..- JP 2D03 ;------------ heapsize ------------ +3979 CD A8 2C .., CALL 2CA8 +397C CD 70 38 .p8 CALL 3870 +397F 38 F5 8. JR C,3976 +3981 CD 8D 38 ..8 CALL 388D +3984 2E 00 .. LD L,00 +3986 7E ~ LD A,(HL) +3987 E6 0F .. AND 0F +3989 2C , INC L +398A 5E ^ LD E,(HL) +398B 0F . RRCA +398C CB 1B .. RR E +398E 0F . RRCA +398F CB 1B .. RR E +3991 E6 03 .. AND 03 +3993 57 W LD D,A +3994 C3 03 2D ..- JP 2D03 ;------------ pages task ---------- +3997 CD 13 43 ..C CALL 4313 +399A 5E ^ LD E,(HL) +399B CD 13 43 ..C CALL 4313 +399E 56 V LD D,(HL) +399F CD 7D 6A .}j CALL 6A7D +39A2 C3 03 2D ..- JP 2D03 ;---- Parameter fuer blockin/out--- +39A5 CD 13 43 ..C CALL 4313 ; DSnr +39A8 CD 11 36 ..6 CALL 3611 +39AB CD A8 2C .., CALL 2CA8 ; page --> HL +39AE 5C \ LD E,H +39AF 65 e LD H,L +39B0 2E 00 .. LD L,00 +39B2 C9 . RET ;----------------- blockout ------- +39B3 CD A5 39 ..9 CALL 39A5 +39B6 CD 5C 65 .\e CALL 655C +39B9 67 g LD H,A +39BA EB . EX DE,HL +39BB CD A8 2C .., CALL 2CA8 ; code1 --> HL +39BE E5 . PUSH HL +39BF CD A8 2C .., CALL 2CA8 ; code2 --> HL +39C2 E5 . PUSH HL +39C3 CD 64 43 .dC CALL 4364 ; result addr +39C6 ED 43 D0 41 .C.A LD (41D0),BC +39CA C1 . POP BC +39CB E3 . EX (SP),HL +39CC DD 7E 26 .~& LD A,(IX+26) +39CF B7 . OR A +39D0 28 05 (. JR Z,39D7 ; Kanal > 0 sein +39D2 CD 2A 26 .*& CALL 262A +39D5 18 03 .. JR 39DA +39D7 01 FF FF ... LD BC,FFFF ; Nicht fuer HG +39DA E1 . POP HL ; result liefern +39DB 71 q LD (HL),C +39DC 2C , INC L +39DD 70 p LD (HL),B +39DE ED 4B D0 41 .K.A LD BC,(41D0) +39E2 C3 A7 2A ..* JP 2AA7 ;------------ blockin ------------- +39E5 CD A5 39 ..9 CALL 39A5 +39E8 CD 2C 66 .,f CALL 662C +39EB 67 g LD H,A +39EC EB . EX DE,HL +39ED CD A8 2C .., CALL 2CA8 +39F0 E5 . PUSH HL +39F1 CD A8 2C .., CALL 2CA8 +39F4 E5 . PUSH HL +39F5 CD 64 43 .dC CALL 4364 +39F8 ED 43 D0 41 .C.A LD (41D0),BC +39FC C1 . POP BC +39FD E3 . EX (SP),HL +39FE DD 7E 26 .~& LD A,(IX+26) +3A01 B7 . OR A +3A02 28 D3 (. JR Z,39D7 +3A04 CD 56 25 .V% CALL 2556 +3A07 18 D1 .. JR 39DA ;------------ control ------------- +3A09 CD A8 2C .., CALL 2CA8 ; funktion +3A0C EB . EX DE,HL +3A0D CD A8 2C .., CALL 2CA8 ; code1 +3A10 E5 . PUSH HL +3A11 CD A8 2C .., CALL 2CA8 ; code2 +3A14 E5 . PUSH HL +3A15 CD 64 43 .dC CALL 4364 ; result +3A18 ED 43 D0 41 .C.A LD (41D0),BC ; DE = Funktion +3A1C C1 . POP BC ; BC = Code 2 +3A1D E3 . EX (SP),HL ; HL = Code 1 +3A1E 7B { LD A,E ; funktion=10 (calendar) +3A1F D6 0A .. SUB A,0A +3A21 B2 . OR D +3A22 28 0B (. JR Z,3A2F +3A24 DD 7E 26 .~& LD A,(IX+26) +3A27 B7 . OR A +3A28 28 AD (. JR Z,39D7 +3A2A CD 56 24 .V$ CALL 2456 ; IOCONTROL +3A2D 18 AB .. JR 39DA ; result in BC uebertragen +3A2F 3A 6B 28 :k( LD A,(286B) ; control (10,..) +3A32 FE 08 .. CP 08 ; shard >= 8? +3A34 30 F4 0. JR NC,3A2A ; nein: +3A36 01 FF FF ... LD BC,FFFF ; result -1 +3A39 18 9F .. JR 39DA ;-------------- nextdspage -------- +3A3B CD 13 43 ..C CALL 4313 ; dsnr holen +3A3E CD 11 36 ..6 CALL 3611 ; test, gueltigen ds +3A41 CD A8 2C .., CALL 2CA8 ; page holen +3A44 CD 5B 6A .[j CALL 6A5B ; nextdspage +3A47 EB . EX DE,HL +3A48 C3 03 2D ..- JP 2D03 ; nextpage auf stack +3A4B CB 7E .~ BIT 7,(HL) +3A4D 28 04 (. JR Z,3A53 +3A4F CB BE .. RES 7,(HL) +3A51 B7 . OR A +3A52 C9 . RET +3A53 1C . INC E +3A54 2D - DEC L +3A55 34 4 INC (HL) +3A56 20 03 . JR NZ,3A5B +3A58 2C , INC L +3A59 34 4 INC (HL) +3A5A 2D - DEC L +3A5B 2C , INC L +3A5C CB FE .. SET 7,(HL) +3A5E 37 7 SCF +3A5F C9 . RET +3A60 CB BC .. RES 7,H +3A62 5C \ LD E,H +3A63 16 1D .. LD D,1D +3A65 1A . LD A,(DE) +3A66 67 g LD H,A +3A67 29 ) ADD HL,HL +3A68 D8 . RET C +3A69 C3 F9 42 ..B JP 42F9 +3A6C CB BC .. RES 7,H +3A6E 5C \ LD E,H +3A6F 16 1D .. LD D,1D +3A71 1A . LD A,(DE) +3A72 67 g LD H,A +3A73 29 ) ADD HL,HL +3A74 B7 . OR A +3A75 C0 . RET NZ +3A76 C3 E1 42 ..B JP 42E1 ;---------------- ECWR ------------ +3A79 CD 64 43 .dC CALL 4364 +3A7C E5 . PUSH HL +3A7D CD 64 43 .dC CALL 4364 +3A80 5E ^ LD E,(HL) +3A81 2C , INC L +3A82 56 V LD D,(HL) +3A83 E5 . PUSH HL +3A84 EB . EX DE,HL +3A85 CD 60 3A .`: CALL 3A60 +3A88 EB . EX DE,HL +3A89 CD 13 43 ..C CALL 4313 +3A8C 7E ~ LD A,(HL) +3A8D E1 . POP HL +3A8E CD 4B 3A .K: CALL 3A4B +3A91 12 . LD (DE),A +3A92 38 04 8. JR C,3A98 +3A94 EB . EX DE,HL +3A95 2C , INC L +3A96 36 00 6. LD (HL),00 +3A98 E1 . POP HL +3A99 5E ^ LD E,(HL) +3A9A 2C , INC L +3A9B 56 V LD D,(HL) +3A9C EB . EX DE,HL +3A9D 29 ) ADD HL,HL +3A9E CB 54 .T BIT 2,H +3AA0 CB 94 .. RES 2,H +3AA2 28 01 (. JR Z,3AA5 +3AA4 2C , INC L +3AA5 85 . ADD L +3AA6 6F o LD L,A +3AA7 30 01 0. JR NC,3AAA +3AA9 24 $ INC H +3AAA CB 94 .. RES 2,H +3AAC EB . EX DE,HL +3AAD 72 r LD (HL),D +3AAE 2D - DEC L +3AAF 73 s LD (HL),E +3AB0 C3 A7 2A ..* JP 2AA7 ;--------------- CWR ------------- +3AB3 CD 64 43 .dC CALL 4364 +3AB6 E5 . PUSH HL +3AB7 CD 13 43 ..C CALL 4313 +3ABA 5E ^ LD E,(HL) +3ABB D5 . PUSH DE +3ABC CD A8 2C .., CALL 2CA8 +3ABF CD 60 3A .`: CALL 3A60 +3AC2 D1 . POP DE +3AC3 73 s LD (HL),E +3AC4 E1 . POP HL +3AC5 2C , INC L +3AC6 CD 4B 3A .K: CALL 3A4B +3AC9 CB BE .. RES 7,(HL) +3ACB C3 A7 2A ..* JP 2AA7 ;----------- CRD ------------------ +3ACE CD A8 2C .., CALL 2CA8 +3AD1 CD 6C 3A .l: CALL 3A6C +3AD4 5E ^ LD E,(HL) +3AD5 16 00 .. LD D,00 +3AD7 C3 03 2D ..- JP 2D03 ;------------- BCRD --------------- +3ADA CD 64 43 .dC CALL 4364 +3ADD E5 . PUSH HL +3ADE CD 64 43 .dC CALL 4364 +3AE1 5E ^ LD E,(HL) +3AE2 2C , INC L +3AE3 56 V LD D,(HL) +3AE4 E5 . PUSH HL +3AE5 EB . EX DE,HL +3AE6 CD 6C 3A .l: CALL 3A6C +3AE9 EB . EX DE,HL +3AEA E1 . POP HL +3AEB CD 4B 3A .K: CALL 3A4B +3AEE E1 . POP HL +3AEF 1A . LD A,(DE) +3AF0 77 w LD (HL),A +3AF1 2C , INC L +3AF2 36 00 6. LD (HL),00 +3AF4 C3 A7 2A ..* JP 2AA7 ;-------------- cdbint ----------- +3AF7 CD A8 2C .., CALL 2CA8 ; address holen +3AFA 3E 05 >. LD A,05 ; Segment 5 +3AFC FD 21 85 46 .!.F LD IY,4685 +3B00 FD 36 00 01 .6.. LD (IY+00),01 ; 1 Wort +3B04 FD 36 03 04 .6.. LD (IY+03),04 ; DS 4 +3B08 CD CA 44 ..D CALL 44CA +3B0B C3 00 2D ..- JP 2D00 ;-------------- cdbtext ----------- +3B0E CD A8 2C .., CALL 2CA8 ; Textaddress holen +3B11 2B + DEC HL +3B12 11 05 04 ... LD DE,0405 ; DS 4, Segment 5 +3B15 CD 95 46 ..F CALL 4695 +3B18 C3 D0 30 ..0 JP 30D0 ;--------------- CTT -------------- +3B1B CD A8 2C .., CALL 2CA8 ; Textaddr holen +3B1E 2B + DEC HL +3B1F 11 04 00 ... LD DE,0004 ; REF-Adr : DS 4, HL +3B22 D5 . PUSH DE +3B23 C3 34 36 .46 JP 3634 ;-------------- GETC -------------- +3B26 CD 8D 46 ..F CALL 468D +3B29 E5 . PUSH HL +3B2A CD 64 43 .dC CALL 4364 +3B2D 7B { LD A,E +3B2E 5E ^ LD E,(HL) +3B2F 93 . SUB E +3B30 2C , INC L +3B31 7A z LD A,D +3B32 56 V LD D,(HL) +3B33 9A . SBC D +3B34 38 18 8. JR C,3B4E +3B36 E3 . EX (SP),HL +3B37 1B . DEC DE +3B38 CD 0D 45 ..E CALL 450D +3B3B 5E ^ LD E,(HL) +3B3C CD 64 43 .dC CALL 4364 +3B3F 73 s LD (HL),E +3B40 2C , INC L +3B41 36 00 6. LD (HL),00 +3B43 E1 . POP HL +3B44 2D - DEC L +3B45 34 4 INC (HL) +3B46 C2 71 2E .q. JP NZ,2E71 +3B49 2C , INC L +3B4A 34 4 INC (HL) +3B4B C3 71 2E .q. JP 2E71 +3B4E CD 43 44 .CD CALL 4443 +3B51 C3 84 2E ... JP 2E84 ;------------ FNONBL -------------- +3B54 CD 64 43 .dC CALL 4364 +3B57 E5 . PUSH HL +3B58 CD 8D 46 ..F CALL 468D +3B5B E5 . PUSH HL +3B5C D5 . PUSH DE +3B5D CD 64 43 .dC CALL 4364 +3B60 22 CC 41 ".A LD (41CC),HL +3B63 ED 43 D0 41 .C.A LD (41D0),BC +3B67 C1 . POP BC +3B68 5E ^ LD E,(HL) +3B69 2C , INC L +3B6A 56 V LD D,(HL) +3B6B E1 . POP HL +3B6C CD 1D 46 ..F CALL 461D +3B6F CD 44 45 .DE CALL 4544 +3B72 28 2B (+ JR Z,3B9F +3B74 F5 . PUSH AF +3B75 3E 20 > LD A,20 +3B77 ED A1 .. CPI +3B79 20 0B . JR NZ,3B86 +3B7B EA 77 3B .w; JP PE,3B77 +3B7E F1 . POP AF +3B7F 30 1E 0. JR NC,3B9F +3B81 CD C1 45 ..E CALL 45C1 +3B84 18 E9 .. JR 3B6F +3B86 F1 . POP AF +3B87 2B + DEC HL +3B88 7E ~ LD A,(HL) +3B89 CD 33 46 .3F CALL 4633 +3B8C 13 . INC DE +3B8D 2A CC 41 *.A LD HL,(41CC) +3B90 73 s LD (HL),E +3B91 2C , INC L +3B92 72 r LD (HL),D +3B93 E1 . POP HL +3B94 77 w LD (HL),A +3B95 2C , INC L +3B96 36 00 6. LD (HL),00 +3B98 ED 4B D0 41 .K.A LD BC,(41D0) +3B9C C3 71 2E .q. JP 2E71 +3B9F E1 . POP HL +3BA0 ED 4B D0 41 .K.A LD BC,(41D0) +3BA4 C3 84 2E ... JP 2E84 ;-------------- DREM256 ----------- +3BA7 CD 64 43 .dC CALL 4364 +3BAA EB . EX DE,HL +3BAB CD 64 43 .dC CALL 4364 +3BAE 1A . LD A,(DE) +3BAF 77 w LD (HL),A +3BB0 97 . SUB A +3BB1 2C , INC L +3BB2 77 w LD (HL),A +3BB3 EB . EX DE,HL +3BB4 2C , INC L +3BB5 5E ^ LD E,(HL) +3BB6 77 w LD (HL),A +3BB7 2D - DEC L +3BB8 73 s LD (HL),E +3BB9 C3 A7 2A ..* JP 2AA7 ;------------- AMUL256 ------------ +3BBC CD 64 43 .dC CALL 4364 +3BBF EB . EX DE,HL +3BC0 CD 13 43 ..C CALL 4313 +3BC3 7E ~ LD A,(HL) +3BC4 EB . EX DE,HL +3BC5 5E ^ LD E,(HL) +3BC6 77 w LD (HL),A +3BC7 2C , INC L +3BC8 73 s LD (HL),E +3BC9 C3 A7 2A ..* JP 2AA7 ;------------ ISLD ---------------- +3BCC CD 13 43 ..C CALL 4313 +3BCF 7E ~ LD A,(HL) +3BD0 FE 7B .{ CP 7B +3BD2 D2 84 2E ... JP NC,2E84 +3BD5 FE 61 .a CP 61 +3BD7 D2 71 2E .q. JP NC,2E71 +3BDA 11 3A 30 .:0 LD DE,303A +3BDD 18 07 .. JR 3BE6 ;------------- ISDIG --------------- +3BDF 11 3A 30 .:0 LD DE,303A +3BE2 CD 13 43 ..C CALL 4313 +3BE5 7E ~ LD A,(HL) +3BE6 BB . CP E +3BE7 D2 84 2E ... JP NC,2E84 +3BEA BA . CP D +3BEB D2 71 2E .q. JP NC,2E71 +3BEE C3 84 2E ... JP 2E84 ;-------------- ISLCAS ------------ +3BF4 18 EC .. JR 3BE2 ;-------------- ISUCAS ----------- +3BF6 11 5B 41 .[A LD DE,415B +3BF9 18 E7 .. JR 3BE2 ;--------------- GADDR ------------ +3BFB CD A8 2C .., CALL 2CA8 +3BFE EB . EX DE,HL +3BFF CD A8 2C .., CALL 2CA8 +3C02 CB 7C .| BIT 7,H +3C04 28 0A (. JR Z,3C10 +3C06 29 ) ADD HL,HL +3C07 CB 7C .| BIT 7,H +3C09 28 01 (. JR Z,3C0C +3C0B 2C , INC L +3C0C CB FC .. SET 7,H +3C0E 18 03 .. JR 3C13 +3C10 B7 . OR A +3C11 ED 52 .R SBC HL,DE +3C13 EB . EX DE,HL +3C14 C3 03 2D ..- JP 2D03 ;------------- GCADDR ------------- +3C17 CD A8 2C .., CALL 2CA8 +3C1A EB . EX DE,HL +3C1B CD 13 43 ..C CALL 4313 +3C1E 2C , INC L +3C1F 7A z LD A,D +3C20 96 . SUB (HL) +3C21 30 02 0. JR NC,3C25 +3C23 C6 10 .. ADD A,10 +3C25 0F . RRCA +3C26 57 W LD D,A +3C27 CD 64 43 .dC CALL 4364 +3C2A 73 s LD (HL),E +3C2B 2C , INC L +3C2C 72 r LD (HL),D +3C2D 7A z LD A,D +3C2E E6 78 .x AND 78 +3C30 CA 71 2E .q. JP Z,2E71 +3C33 C3 84 2E ... JP 2E84 ;------------ ISSHA --------------- +3C36 CD A8 2C .., CALL 2CA8 +3C39 7C | LD A,H +3C3A E6 7C .| AND 7C +3C3C CA 71 2E .q. JP Z,2E71 +3C3F C3 84 2E ... JP 2E84 ;-------------- GETTAB ------------ +3C42 11 00 04 ... LD DE,0400 +3C45 21 00 05 !.. LD HL,0500 ; von Segment 5 nach segment 4 +3C48 3E 80 >. LD A,80 +3C4A C5 . PUSH BC +3C4B 47 G LD B,A +3C4C 0E 04 .. LD C,04 +3C4E CD B6 69 ..i CALL 69B6 +3C51 CD 16 42 ..B CALL 4216 +3C54 C1 . POP BC +3C55 C3 A7 2A ..* JP 2AA7 ;-------------- PUTTAB ------------ +3C58 11 00 05 ... LD DE,0500 ; von segment 4 nach segment 5 +3C5B 21 00 04 !.. LD HL,0400 +3C5E 3E 80 >. LD A,80 +3C60 18 E8 .. JR 3C4A ;------------- ERATAB ------------- +3C62 11 00 04 ... LD DE,0400 ; Segment 4 loeschen (6 ist leer) +3C65 21 00 06 !.. LD HL,0600 +3C68 E5 . PUSH HL +3C69 C5 . PUSH BC +3C6A 06 FE .. LD B,FE +3C6C 0E 04 .. LD C,04 +3C6E CD B6 69 ..i CALL 69B6 +3C71 C1 . POP BC +3C72 E1 . POP HL +3C73 11 00 07 ... LD DE,0700 ; neuerdings auch Segment 7 +3C76 3E FE >. LD A,FE ; loeschen +3C78 18 D0 .. JR 3C4A ;------------ storage ------------ +3C7A C5 . PUSH BC +3C7B CD CC 56 ..V CALL 56CC ; storage berechnen +3C7E 59 Y LD E,C +3C7F 50 P LD D,B +3C80 C1 . POP BC +3C81 EB . EX DE,HL +3C82 E5 . PUSH HL +3C83 CD 64 43 .dC CALL 4364 ; size-addresse holen +3C86 73 s LD (HL),E +3C87 2C , INC L +3C88 72 r LD (HL),D +3C89 D1 . POP DE ; used-auf stack +3C8A C3 03 2D ..- JP 2D03 ;------------- sysop ------------- +3C8D DD 7E 1D .~. LD A,(IX+1D) ; privilegierte operation +3C90 FE 01 .. CP 01 +3C92 DA E6 3C ..< JP C,3CE6 +3C95 CD A8 2C .., CALL 2CA8 ; nr holen +3C98 3E 0C >. LD A,0C +3C9A BD . CP L +3C9B 20 01 . JR NZ,3C9E ; savesystem ? +3C9D 2D - DEC L ; aus 12 wird 11 +3C9E 3A 17 82 :.. LD A,(8217) ; Musta +3CA1 B7 . OR A +3CA2 C2 26 29 .&) JP NZ,2926 ; Warten, bis Musta frei +3CA5 DD CB 07 5E ...^ BIT 3,(IX+07) ; restart +3CA9 20 1B . JR NZ,3CC6 +3CAB DD CB 07 DE .... SET 3,(IX+07) +3CAF 7D } LD A,L +3CB0 32 17 82 2.. LD (8217),A +3CB3 21 60 EA !`. LD HL,EA60 ; 6000.0 s = 100 Minuten +3CB6 22 B6 4C ".L LD (4CB6),HL +3CB9 FE 04 .. CP 04 ; < shutup ? +3CBB DA 26 29 .&) JP C,2926 +3CBE CD 02 2A ..* CALL 2A02 +3CC1 CD E2 6D ..m CALL 6DE2 ; Endlos warte +3CC4 18 FB .. JR 3CC1 +3CC6 DD CB 07 9E .... RES 3,(IX+07) +3CCA C3 A7 2A ..* JP 2AA7 ;-------------- DIV by 0 --------- +3CCD 3E 05 >. LD A,05 +3CCF 18 37 .7 JR 3D08 ;---------- Stackoverflow --------- +3CD1 DD CB 0B B6 .... RES 6,(IX+0B) ; enablestop +3CD5 3E 02 >. LD A,02 ; errorstop +3CD7 18 39 .9 JR 3D12 ; +3CD9 3E 09 >. LD A,09 ;---------- Subscript overflow ---- +3CDB CB 7C .| BIT 7,H +3CDD 28 02 (. JR Z,3CE1 +3CDF 3E 0A >. LD A,0A ;---------- Subscript underflow ---- +3CE1 21 00 00 !.. LD HL,0000 +3CE4 18 27 .' JR 3D0D ;----- error: privilegierte op -- +3CE6 DD 7E 30 .~0 LD A,(IX+30) ; Taskindex = Supervisor ? +3CE9 FE 01 .. CP 01 +3CEB 20 07 . JR NZ,3CF4 +3CED DD 36 1D 02 .6.. LD (IX+1D),02 ; privileged 2, offener wartezustand +3CF1 C3 26 29 .&) JP 2926 ;--------- Codefehler -------------- +3CF4 DD CB 0B B6 .... RES 6,(IX+0B) ; enablestop +3CF8 3E 11 >. LD A,11 +3CFA 18 16 .. JR 3D12 ; errorstop ("Codefehler") +3CFC 30 03 0. JR NC,3D01 ; ------ INT overflow, wenn arith15 +3CFE 21 FF FF !.. LD HL,FFFF +3D01 DD CB 0B 66 ...f BIT 4,(IX+0B) +3D05 C0 . RET NZ +3D06 3E 04 >. LD A,04 +3D08 11 01 00 ... LD DE,0001 +3D0B 62 b LD H,D +3D0C 6A j LD L,D +3D0D DD CB 0B 7E ...~ BIT 7,(IX+0B) ; nur wenn nicht schon iserror +3D11 C0 . RET NZ +3D12 DD 36 25 00 .6%. LD (IX+25),00 ;--------- errorstop +3D16 DD 77 24 .w$ LD (IX+24),A ; errorno +3D19 DD 7E 20 .~ LD A,(IX+20) ; errline := lineno +3D1C DD 77 22 .w" LD (IX+22),A +3D1F DD 7E 21 .~! LD A,(IX+21) +3D22 DD 77 23 .w# LD (IX+23),A +3D25 DD CB 0B FE .... SET 7,(IX+0B) ; iserror +3D29 DD CB 0B 76 ...v BIT 6,(IX+0B) +3D2D C0 . RET NZ +3D2E CD E8 45 ..E CALL 45E8 ; Return, wenn enablestop +3D31 DD CB 07 9E .... RES 3,(IX+07) +3D35 31 13 6D 1.m LD SP,6D13 +3D38 DD CB 0B 76 ...v BIT 6,(IX+0B) ;-------------- TERM -------------- +3D3C 20 09 . JR NZ,3D47 ; bis zum disablestop PROC zurueck +3D3E DD 36 06 1C .6.. LD (IX+06),1C ; Status LEAVE PROC +3D42 CD 35 30 .50 CALL 3035 ; EXEC LEAVE +3D45 18 F1 .. JR 3D38 ; Weiter LEAVEn +3D47 DD 36 06 00 .6.. LD (IX+06),00 ; Status Busy +3D4B C3 A7 2A ..* JP 2AA7 ;----------- enablestop --------- +3D4E DD CB 0B B6 .... RES 6,(IX+0B) +3D52 DD CB 0B 7E ...~ BIT 7,(IX+0B) +3D56 20 E0 . JR NZ,3D38 ; LEAVE PROC, if enablesto and iserr +3D58 C3 A7 2A ..* JP 2AA7 ;------------ disablestop -------- +3D5B DD CB 0B F6 .... SET 6,(IX+0B) +3D5F C3 A7 2A ..* JP 2AA7 ;----------- seterrorstop --------- +3D62 CD A8 2C .., CALL 2CA8 +3D65 DD CB 0B 7E ...~ BIT 7,(IX+0B) +3D69 C2 A7 2A ..* JP NZ,2AA7 +3D6C DD 74 25 .t% LD (IX+25),H ; errorcode high +3D6F 7D } LD A,L +3D70 CD 16 3D ..= CALL 3D16 ; errorstop +3D73 C3 A7 2A ..* JP 2AA7 ;------------- iserror ------------ +3D76 DD CB 0B 7E ...~ BIT 7,(IX+0B) +3D7A CA 84 2E ... JP Z,2E84 +3D7D C3 71 2E .q. JP 2E71 ;------------ clearerror ---------- +3D80 DD CB 0B 76 ...v BIT 6,(IX+0B) +3D84 CA A7 2A ..* JP Z,2AA7 ; war kein Fehler +3D87 C5 . PUSH BC +3D88 0E 05 .. LD C,05 +3D8A CD 97 69 ..i CALL 6997 +3D8D 3A 1A 6E :.n LD A,(6E1A) ; Aktueller Taskindex +3D90 47 G LD B,A +3D91 0E 00 .. LD C,00 +3D93 57 W LD D,A +3D94 CD E8 68 ..h CALL 68E8 +3D97 C1 . POP BC +3D98 DD CB 0B BE .... RES 7,(IX+0B) +3D9C C3 A7 2A ..* JP 2AA7 ;-------- readpcb myself ---------- +3D9F CD A5 3D ..= CALL 3DA5 ; +3DA2 C3 00 2D ..- JP 2D00 ; Wert auf Stack +3DA5 CD 13 43 ..C CALL 4313 ; Zwei Addressen holen +3DA8 7E ~ LD A,(HL) +3DA9 2A 1C 6E *.n LD HL,(6E1C) ; Leitblock aktueller +3DAC 87 . ADD A +3DAD C6 1E .. ADD A,1E ; pcb--> pcf konvertieren +3DAF E6 3F .? AND 3F +3DB1 6F o LD L,A +3DB2 C9 . RET ;----- test ob, supervisorson ---- +3DB3 DD 7E 1D .~. LD A,(IX+1D) ; priv Feld +3DB6 FE 01 .. CP 01 ; >= 1 : darf +3DB8 30 08 0. JR NC,3DC2 +3DBA DD 7E 1D .~. LD A,(IX+1D) ;------ test, ob supervisor ------- +3DBD FE 02 .. CP 02 +3DBF DA E6 3C ..< JP C,3CE6 ; < 2 : darf nicht +3DC2 CD 07 44 ..D CALL 4407 ; leitblock einer task laden------- +3DC5 FD 2A 1C 6E .*.n LD IY,(6E1C) +3DC9 1A . LD A,(DE) +3DCA 3D = DEC A +3DCB FE 7F .. CP 7F ; Taskindex >= 128 ? +3DCD D0 . RET NC +3DCE 1C . INC E +3DCF 1A . LD A,(DE) +3DD0 1D . DEC E +3DD1 DD BE 31 ..1 CP (IX+31) ; Stationsnummer (myself) +3DD4 20 07 . JR NZ,3DDD +3DD6 1A . LD A,(DE) +3DD7 CD 4D 6D .Mm CALL 6D4D +3DDA 1A . LD A,(DE) +3DDB 37 7 SCF +3DDC C9 . RET +3DDD B7 . OR A +3DDE C9 . RET ;------------ pcb-feld lesen ----- +3DDF CD C2 3D ..= CALL 3DC2 ; +3DE2 CD 13 43 ..C CALL 4313 +3DE5 7E ~ LD A,(HL) ; pcb-nummer +3DE6 FD E5 .. PUSH IY +3DE8 E1 . POP HL +3DE9 18 C1 .. JR 3DAC ;------------- readpcb task ------- +3DEB CD DF 3D ..= CALL 3DDF ; Readpcb und Wert auf Stack +3DEE C3 00 2D ..- JP 2D00 ;------------- writepcb task ------ +3DF1 CD DF 3D ..= CALL 3DDF ; Readpcb +3DF4 FD 7E 30 .~0 LD A,(IY+30) ; Eigener Taskindex = pcb-Taskindex +3DF7 DD BE 30 ..0 CP (IX+30) +3DFA 20 05 . JR NZ,3E01 ; Nein, kann nur Supervisor +3DFC 7D } LD A,L ; linenumber field +3DFD FE 20 . CP 20 ; pcf=32 kann beschrieben werden +3DFF 28 12 (. JR Z,3E13 ; von jeder task +3E01 DD 7E 1D .~. LD A,(IX+1D) +3E04 FE 02 .. CP 02 +3E06 30 0B 0. JR NC,3E13 ; priv >= 2 darf alle beschreiben +3E08 FE 01 .. CP 01 +3E0A DA E6 3C ..< JP C,3CE6 ; priv < 1 darf nur linenumber +3E0D 7D } LD A,L +3E0E FE 2A .* CP 2A ; priv = 1 darf nur prio beschreiben +3E10 C2 E6 3C ..< JP NZ,3CE6 +3E13 EB . EX DE,HL ; writepcb durchfuehren +3E14 CD A8 2C .., CALL 2CA8 ; value holen +3E17 EB . EX DE,HL +3E18 73 s LD (HL),E ; leitblock veraendern +3E19 2C , INC L +3E1A 72 r LD (HL),D +3E1B C3 A7 2A ..* JP 2AA7 ;-------------- status ------------ +3E1E CD C2 3D ..= CALL 3DC2 ; leitblock von task holen +3E21 FD 7E 06 .~. LD A,(IY+06) ; status feld +3E24 07 . RLCA +3E25 07 . RLCA +3E26 E6 0F .. AND 0F +3E28 5F _ LD E,A +3E29 16 00 .. LD D,00 +3E2B C3 03 2D ..- JP 2D03 ;--------------- unblock ---------- +3E2E CD B3 3D ..= CALL 3DB3 ; nur von supervisorsoehnen +3E31 DC 68 6D .hm CALL C,6D68 +3E34 FD CB 06 4E ...N BIT 1,(IY+06) +3E38 20 04 . JR NZ,3E3E +3E3A FD CB 06 86 .... RES 0,(IY+06) +3E3E C3 A7 2A ..* JP 2AA7 ;--------------- block ------------ +3E41 CD B3 3D ..= CALL 3DB3 ; nur von supervisorsoehnen +3E44 30 F8 0. JR NC,3E3E +3E46 FD CB 06 C6 .... SET 0,(IY+06) +3E4A CD 74 6D .tm CALL 6D74 +3E4D 18 EF .. JR 3E3E ;----------- nextactive ---------- +3E4F CD 64 43 .dC CALL 4364 ; task holen +3E52 7E ~ LD A,(HL) +3E53 CD 7E 6D .~m CALL 6D7E +3E56 F5 . PUSH AF +3E57 CD 4D 6D .Mm CALL 6D4D +3E5A F1 . POP AF +3E5B 77 w LD (HL),A +3E5C 2C , INC L +3E5D FD 7E 31 .~1 LD A,(IY+31) ; taskindex holen +3E60 77 w LD (HL),A +3E61 18 DB .. JR 3E3E ;------------ halt process -------- +3E63 CD BA 3D ..= CALL 3DBA ; nur vom supervisor +3E66 FD CB 05 C6 .... SET 0,(IY+05) +3E6A 18 D2 .. JR 3E3E ;------------- create process ----- +3E6C DD 7E 30 .~0 LD A,(IX+30) ; myself index +3E6F 32 13 42 2.B LD (4213),A +3E72 2A CA 41 *.A LD HL,(41CA) ; heaptop +3E75 22 14 42 ".B LD (4214),HL +3E78 CD BA 3D ..= CALL 3DBA ; supervisor ? +3E7B D2 4C 3F .L? JP NC,3F4C ; nicht moeglich +3E7E E5 . PUSH HL ; unprivilegiertes createprocess +3E7F D5 . PUSH DE +3E80 FD 36 00 00 .6.. LD (IY+00),00 ; wstate +3E84 FD 36 1D FF .6.. LD (IY+1D),FF ; priv +3E88 CD B8 43 ..C CALL 43B8 ; procadresse holen +3E8B FD 75 09 .u. LD (IY+09),L ; icount uebertragen +3E8E FD 74 0A .t. LD (IY+0A),H +3E91 FD 73 0B .s. LD (IY+0B),E +3E94 7C | LD A,H +3E95 C6 10 .. ADD A,10 +3E97 FD 77 0F .w. LD (IY+0F),A ; c8k, und allgemeiner create proc. +3E9A C3 D9 3E ..> JP 3ED9 ;------- create privileged process- +3E9D CD 13 43 ..C CALL 4313 +3EA0 7E ~ LD A,(HL) +3EA1 E6 7F .. AND 7F +3EA3 32 13 42 2.B LD (4213),A +3EA6 CD 4D 6D .Mm CALL 6D4D +3EA9 FD 6E 16 .n. LD L,(IY+16) ; hptop +3EAC FD 66 17 .f. LD H,(IY+17) +3EAF 22 14 42 ".B LD (4214),HL +3EB2 CD BA 3D ..= CALL 3DBA ; supervisor ? +3EB5 D2 49 3F .I? JP NC,3F49 ; nicht moeglich +3EB8 E5 . PUSH HL +3EB9 D5 . PUSH DE +3EBA FD 36 01 00 .6.. LD (IY+01),00 ; wstate +3EBE CD A8 2C .., CALL 2CA8 ; priv parameter +3EC1 FD 75 1D .u. LD (IY+1D),L +3EC4 CD 07 44 ..D CALL 4407 ; PROCAddresse holen --> DE, HL +3EC7 1A . LD A,(DE) +3EC8 FD 77 09 .w. LD (IY+09),A ; icount +3ECB 1C . INC E +3ECC 1A . LD A,(DE) +3ECD FD 77 0A .w. LD (IY+0A),A +3ED0 C6 10 .. ADD A,10 +3ED2 FD 77 0F .w. LD (IY+0F),A ; c8k +3ED5 7E ~ LD A,(HL) ; segment +3ED6 FD 77 0B .w. LD (IY+0B),A +3ED9 ED 43 D0 41 .C.A LD (41D0),BC ;-allgemeimer Teil von createproc. +3EDD FD E5 .. PUSH IY ; IY = Leitblockaddresse des +3EDF D1 . POP DE ; neuen Prozesses +3EE0 1E 30 .0 LD E,30 ; +3EE2 E1 . POP HL ; taskindex setzen +3EE3 ED A0 .. LDI +3EE5 ED A0 .. LDI +3EE7 E1 . POP HL ; version +3EE8 ED A0 .. LDI +3EEA ED A0 .. LDI +3EEC 1E 38 .8 LD E,38 ; clock +3EEE 06 08 .. LD B,08 +3EF0 97 . SUB A ; auf 0.0 setzen +3EF1 12 . LD (DE),A +3EF2 1C . INC E +3EF3 10 FC .. DJNZ 3EF1 +3EF5 FD 77 2A .w* LD (IY+2A),A ; prio auf 0 +3EF8 FD 77 2B .w+ LD (IY+2B),A +3EFB 3A 13 42 :.B LD A,(4213) +3EFE 47 G LD B,A +3EFF 0E 04 .. LD C,04 +3F01 FD 56 30 .V0 LD D,(IY+30) ; myself index +3F04 DD CB 07 5E ...^ BIT 3,(IX+07) ; war restart ? +3F08 CC E8 68 ..h CALL Z,68E8 ; +3F0B DD CB 07 DE .... SET 3,(IX+07) ; kein restart mehr +3F0F 0E 00 .. LD C,00 +3F11 CD E8 68 ..h CALL 68E8 +3F14 DD CB 07 9E .... RES 3,(IX+07) ; restart +3F18 2A 14 42 *.B LD HL,(4214) ; heaptop uebertragen +3F1B FD 75 16 .u. LD (IY+16),L +3F1E FD 74 17 .t. LD (IY+17),H +3F21 97 . SUB A +3F22 FD 77 26 .w& LD (IY+26),A ; channel 0 (break) +3F25 FD 77 27 .w' LD (IY+27),A +3F28 FD 77 04 .w. LD (IY+04),A ; millis, comflg +3F2B FD 77 05 .w. LD (IY+05),A +3F2E FD 77 07 .w. LD (IY+07),A ; restart war +3F31 FD 77 14 .w. LD (IY+14),A ls_top +3F34 FD 77 15 .w. LD (IY+15),A +3F37 FD 36 06 18 .6.. LD (IY+06),18 +3F3B 7A z LD A,D +3F3C CD 68 6D .hm CALL 6D68 +3F3F ED 4B D0 41 .K.A LD BC,(41D0) +3F43 CD 16 42 ..B CALL 4216 +3F46 C3 A7 2A ..* JP 2AA7 +3F49 CD 13 43 ..C CALL 4313 ;---------- kein createprocess --- +3F4C CD 13 43 ..C CALL 4313 +3F4F C3 A7 2A ..* JP 2AA7 ;--------- erase process ---------- +3F52 CD BA 3D ..= CALL 3DBA +3F55 DC 8B 68 ..h CALL C,688B +3F58 C3 A7 2A ..* JP 2AA7 ;------------ existstask ---------- +3F5B CD C2 3D ..= CALL 3DC2 ; leitblock holen +3F5E D2 84 2E ... JP NC,2E84 ; NC = FALSE +3F61 FD E5 .. PUSH IY +3F63 D1 . POP DE +3F64 1E 32 .2 LD E,32 ; version vergleichen +3F66 C3 67 2E .g. JP 2E67 ;------------ send ---------------- +3F69 11 0B 42 ..B LD DE,420B +3F6C DD E5 .. PUSH IX +3F6E E1 . POP HL +3F6F 2E 30 .0 LD L,30 ; myself index +3F71 CD 72 40 .r@ CALL 4072 +3F74 97 . SUB A ; msgds := nilspace +3F75 DD 77 2E .w. LD (IX+2E),A +3F78 DD 77 2F .w/ LD (IX+2F),A +3F7B CD C2 3D ..= CALL 3DC2 ; Leitblock der anderen task holen +3F7E F5 . PUSH AF +3F7F C5 . PUSH BC +3F80 D5 . PUSH DE +3F81 E5 . PUSH HL +3F82 01 0F 42 ..B LD BC,420F +3F85 CD 7A 40 .z@ CALL 407A +3F88 E1 . POP HL +3F89 D1 . POP DE +3F8A C1 . POP BC +3F8B F1 . POP AF +3F8C 38 1E 8. JR C,3FAC +3F8E 1A . LD A,(DE) +3F8F FE 02 .. CP 02 +3F91 DA 3D 40 .=@ JP C,403D +3F94 1C . INC E +3F95 1A . LD A,(DE) +3F96 DD BE 31 ..1 CP (IX+31) ; station +3F99 CA 3D 40 .=@ JP Z,403D ; gleiche +3F9C 3A 07 42 :.B LD A,(4207) +3F9F 3D = DEC A +3FA0 FE 7E .~ CP 7E +3FA2 D2 3D 40 .=@ JP NC,403D +3FA5 3C < INC A +3FA6 CD 4D 6D .Mm CALL 6D4D +3FA9 21 09 42 !.B LD HL,4209 +3FAC FD E5 .. PUSH IY +3FAE D1 . POP DE +3FAF 1E 32 .2 LD E,32 +3FB1 CD 6A 40 .j@ CALL 406A +3FB4 C2 3D 40 .=@ JP NZ,403D +3FB7 FD 7E 06 .~. LD A,(IY+06) +3FBA CB 87 .. RES 0,A +3FBC FE BC .. CP BC +3FBE C2 41 40 .A@ JP NZ,4041 +3FC1 1E 34 .4 LD E,34 ; fromid +3FC3 1A . LD A,(DE) +3FC4 B7 . OR A +3FC5 28 09 (. JR Z,3FD0 +3FC7 21 0B 42 !.B LD HL,420B +3FCA CD 66 40 .f@ CALL 4066 +3FCD C2 41 40 .A@ JP NZ,4041 +3FD0 CD A8 2C .., CALL 2CA8 +3FD3 E5 . PUSH HL +3FD4 CD 64 43 .dC CALL 4364 +3FD7 5E ^ LD E,(HL) +3FD8 2C , INC L +3FD9 56 V LD D,(HL) +3FDA EB . EX DE,HL +3FDB CD 70 38 .p8 CALL 3870 +3FDE DA 61 40 .a@ JP C,4061 +3FE1 E5 . PUSH HL +3FE2 CD 64 43 .dC CALL 4364 +3FE5 97 . SUB A +3FE6 77 w LD (HL),A +3FE7 2C , INC L +3FE8 77 w LD (HL),A +3FE9 E1 . POP HL +3FEA EB . EX DE,HL +3FEB C5 . PUSH BC +3FEC DD 46 30 .F0 LD B,(IX+30) +3FEF 4B K LD C,E +3FF0 FD 56 30 .V0 LD D,(IY+30) +3FF3 CD E5 68 ..h CALL 68E5 +3FF6 C1 . POP BC +3FF7 36 FF 6. LD (HL),FF +3FF9 FD 73 2E .s. LD (IY+2E),E +3FFC FD 7E 30 .~0 LD A,(IY+30) +3FFF FD 77 2F .w/ LD (IY+2F),A +4002 21 0F 42 !.B LD HL,420F +4005 DD E5 .. PUSH IX +4007 D1 . POP DE +4008 1E 34 .4 LD E,34 +400A CD 72 40 .r@ CALL 4072 +400D 21 0B 42 !.B LD HL,420B +4010 FD E5 .. PUSH IY +4012 D1 . POP DE +4013 1E 34 .4 LD E,34 +4015 CD 72 40 .r@ CALL 4072 +4018 FD CB 0B 7E ...~ BIT 7,(IY+0B) +401C 20 08 . JR NZ,4026 +401E 21 0F 42 !.B LD HL,420F +4021 1E 22 ." LD E,22 +4023 CD 72 40 .r@ CALL 4072 +4026 EB . EX DE,HL +4027 D1 . POP DE +4028 2E 2C ., LD L,2C +402A 73 s LD (HL),E +402B 2C , INC L +402C 72 r LD (HL),D +402D 2E 06 .. LD L,06 +402F 36 00 6. LD (HL),00 +4031 2E 07 .. LD L,07 +4033 CB DE .. SET 3,(HL) ; kein restart +4035 2E 30 .0 LD L,30 +4037 7E ~ LD A,(HL) +4038 CD 68 6D .hm CALL 6D68 +403B 97 . SUB A +403C C9 . RET +403D 1E FF .. LD E,FF +403F 18 11 .. JR 4052 +4041 3A 10 42 :.B LD A,(4210) +4044 DD BE 31 ..1 CP (IX+31) +4047 28 07 (. JR Z,4050 +4049 3A 07 42 :.B LD A,(4207) +404C B7 . OR A +404D C2 26 29 .&) JP NZ,2926 +4050 1E FE .. LD E,FE +4052 CD 13 43 ..C CALL 4313 +4055 CD 13 43 ..C CALL 4313 +4058 CD 64 43 .dC CALL 4364 +405B 7B { LD A,E +405C 77 w LD (HL),A +405D 2C , INC L +405E 36 FF 6. LD (HL),FF +4060 C9 . RET +4061 E1 . POP HL +4062 1E FD .. LD E,FD +4064 18 F2 .. JR 4058 +4066 CD 6A 40 .j@ CALL 406A +4069 C0 . RET NZ +406A 1A . LD A,(DE) +406B BE . CP (HL) +406C C0 . RET NZ +406D 23 # INC HL +406E 13 . INC DE +406F 1A . LD A,(DE) +4070 BE . CP (HL) +4071 C9 . RET +4072 C5 . PUSH BC +4073 01 04 00 ... LD BC,0004 +4076 ED B0 .. LDIR +4078 C1 . POP BC +4079 C9 . RET +407A 1A . LD A,(DE) +407B 02 . LD (BC),A +407C 1C . INC E +407D 03 . INC BC +407E 1A . LD A,(DE) +407F 02 . LD (BC),A +4080 03 . INC BC +4081 7E ~ LD A,(HL) +4082 02 . LD (BC),A +4083 2C , INC L +4084 03 . INC BC +4085 7E ~ LD A,(HL) +4086 02 . LD (BC),A +4087 C9 . RET +4088 CD 64 43 .dC CALL 4364 +408B 3A 1D 6E :.n LD A,(6E1D) +408E 57 W LD D,A +408F 1A . LD A,(DE) +4090 77 w LD (HL),A +4091 2C , INC L +4092 1C . INC E +4093 1A . LD A,(DE) +4094 77 w LD (HL),A +4095 C9 . RET ;----------- sendfromto ----------- +4096 DD 7E 1D .~. LD A,(IX+1D) +4099 FE 01 .. CP 01 +409B DA E6 3C ..< JP C,3CE6 ; nur supervisorsoehne +409E CD 07 44 ..D CALL 4407 +40A1 1C . INC E +40A2 1A . LD A,(DE) +40A3 1D . DEC E +40A4 DD BE 31 ..1 CP (IX+31) +40A7 28 0E (. JR Z,40B7 +40A9 C5 . PUSH BC +40AA 01 0B 42 ..B LD BC,420B ; andere station +40AD CD 7A 40 .z@ CALL 407A +40B0 C1 . POP BC +40B1 CD 74 3F .t? CALL 3F74 +40B4 C3 A7 2A ..* JP 2AA7 ;------------- send --------------- +40B7 CD 69 3F .i? CALL 3F69 +40BA C3 A7 2A ..* JP 2AA7 ;------------ wait ---------------- +40BD DD CB 07 5E ...^ BIT 3,(IX+07) +40C1 20 1E . JR NZ,40E1 +40C3 CD 29 4C .)L CALL 4C29 +40C6 97 . SUB A +40C7 DD 77 34 .w4 LD (IX+34),A +40CA DD 77 35 .w5 LD (IX+35),A +40CD DD 77 36 .w6 LD (IX+36),A +40D0 DD 77 37 .w7 LD (IX+37),A +40D3 DD 36 06 BC .6.. LD (IX+06),BC ; wait zustand +40D7 3A 1A 6E :.n LD A,(6E1A) +40DA 3D = DEC A +40DB CC 38 4C .8L CALL Z,4C38 +40DE C3 26 29 .&) JP 2926 +40E1 1E 2E .. LD E,2E +40E3 CD 88 40 ..@ CALL 4088 +40E6 1E 2C ., LD E,2C ; 4 Bytes auf Stack +40E8 CD 88 40 ..@ CALL 4088 +40EB 1E 34 .4 LD E,34 ; 4 Bytes auf stack +40ED D5 . PUSH DE +40EE CD 39 44 .9D CALL 4439 +40F1 E3 . EX (SP),HL +40F2 C5 . PUSH BC +40F3 ED A0 .. LDI +40F5 ED A0 .. LDI +40F7 C1 . POP BC +40F8 D1 . POP DE +40F9 C5 . PUSH BC +40FA ED A0 .. LDI +40FC ED A0 .. LDI +40FE C1 . POP BC +40FF DD CB 07 9E .... RES 3,(IX+07) ; restart +4103 C3 A7 2A ..* JP 2AA7 ;--------------- call ------------- +4106 DD CB 07 5E ...^ BIT 3,(IX+07) +410A 20 2E . JR NZ,413A +410C CD 69 3F .i? CALL 3F69 +410F B7 . OR A +4110 28 14 (. JR Z,4126 +4112 FE FE .. CP FE +4114 C2 A7 2A ..* JP NZ,2AA7 +4117 FD E5 .. PUSH IY +4119 E1 . POP HL +411A DD E5 .. PUSH IX +411C D1 . POP DE +411D B7 . OR A +411E ED 52 .R SBC HL,DE +4120 CA A7 2A ..* JP Z,2AA7 +4123 C3 26 29 .&) JP 2926 +4126 3E BC >. LD A,BC ; wait +4128 C3 23 29 .#) JP 2923 ;-------------- pingpong ---------- +412B DD CB 07 5E ...^ BIT 3,(IX+07) +412F 20 09 . JR NZ,413A +4131 CD 69 3F .i? CALL 3F69 +4134 B7 . OR A +4135 28 EF (. JR Z,4126 +4137 C3 A7 2A ..* JP 2AA7 +413A CD 43 44 .CD CALL 4443 +413D CD 43 44 .CD CALL 4443 +4140 1E 2E .. LD E,2E +4142 CD 88 40 ..@ CALL 4088 +4145 1E 2C ., LD E,2C +4147 CD 88 40 ..@ CALL 4088 +414A DD CB 07 9E .... RES 3,(IX+07) +414E C3 A7 2A ..* JP 2AA7 ;--------- define collector ------- +4151 DD 7E 1D .~. LD A,(IX+1D) ; nur von supervisorsoehnen +4154 FE 01 .. CP 01 +4156 DA E6 3C ..< JP C,3CE6 +4159 CD 07 44 ..D CALL 4407 +415C C5 . PUSH BC +415D 01 07 42 ..B LD BC,4207 +4160 CD 7A 40 .z@ CALL 407A +4163 C1 . POP BC +4164 C3 A7 2A ..* JP 2AA7 ;------------- session ------------ +4167 ED 5B 17 6B .[.k LD DE,(6B17) +416B C3 03 2D ..- JP 2D03 ;----------------- id ------------- +416E CD 13 43 ..C CALL 4313 +4171 7E ~ LD A,(HL) +4172 E6 07 .. AND 07 +4174 21 8F 82 !.. LD HL,828F +4177 5F _ LD E,A +4178 D6 04 .. SUB A,04 +417A 38 04 8. JR C,4180 +417C 21 6F 28 !o( LD HL,286F +417F 5F _ LD E,A +4180 16 00 .. LD D,00 +4182 19 . ADD HL,DE +4183 19 . ADD HL,DE +4184 C3 00 2D ..- JP 2D00 ;- infopassword ("alt","neu",ok) +4187 11 F3 41 ..A LD DE,41F3 +418A CD A9 41 ..A CALL 41A9 ; Wort --> 41F3 holen +418D 11 FD 41 ..A LD DE,41FD +4190 CD A9 41 ..A CALL 41A9 ; Wort --> 41FD holen +4193 CD 64 43 .dC CALL 4364 ; REF-addr holen +4196 C5 . PUSH BC +4197 E5 . PUSH HL +4198 21 F3 41 !.A LD HL,41F3 +419B 11 FD 41 ..A LD DE,41FD +419E CD 10 6F ..o CALL 6F10 ; 10 bytes invertieren und kopieren +41A1 E1 . POP HL +41A2 71 q LD (HL),C ; enthaelt 0, wenn ok +41A3 2C , INC L +41A4 70 p LD (HL),B +41A5 C1 . POP BC +41A6 C3 A7 2A ..* JP 2AA7 +41A9 D5 . PUSH DE +41AA CD 8D 46 ..F CALL 468D ; Word --> HL holen +41AD D1 . POP DE +41AE C5 . PUSH BC +41AF 06 0A .. LD B,0A ; 10 mal +41B1 7E ~ LD A,(HL) +41B2 12 . LD (DE),A +41B3 13 . INC DE +41B4 D5 . PUSH DE +41B5 11 01 00 ... LD DE,0001 +41B8 CD 0D 45 ..E CALL 450D ; HL INCR 1 +41BB D1 . POP DE +41BC 10 F3 .. DJNZ 41B1 +41BE C1 . POP BC +41BF C9 . RET ;========= EXTERNALS ENDE ======== +41C0 20 52 R JR NZ,4214 ; " REG" +41C2 45 E LD B,L +41C3 47 G LD B,A +41C4 00 . NOP +41C5 00 . NOP +41C6 00 . NOP +41C7 00 . NOP +41C8 00 . NOP +41C9 00 . NOP +41CA 00 . NOP +41CB 00 . NOP +41CC 00 . NOP +41CD 00 . NOP +41CE 00 . NOP +41CF 00 . NOP +41D0 00 . NOP +41D1 00 . NOP +41D2 00 . NOP +41D3 00 . NOP +41D4 00 . NOP +41D5 00 . NOP +41D6 00 . NOP +41D7 00 . NOP +41D8 00 . NOP +41D9 00 . NOP +41DA 00 . NOP +41DB 00 . NOP +41DC 00 . NOP +41DD 01 00 00 ... LD BC,0000 +41E0 00 . NOP +41E1 00 . NOP +41E2 00 . NOP +41E3 00 . NOP +41E4 00 . NOP +41E5 00 . NOP +41E6 00 . NOP +41E7 02 . LD (BC),A +41E8 20 20 JR NZ,420A +41EA 20 20 JR NZ,420C +41EC 20 08 . JR NZ,41F6 +41EE 08 . EX AF,AF' +41EF 08 . EX AF,AF' +41F0 08 . EX AF,AF' +41F1 08 . EX AF,AF' +41F2 08 . EX AF,AF' +41F3 00 . NOP +41F4 00 . NOP +41F5 00 . NOP +41F6 00 . NOP +41F7 00 . NOP +41F8 00 . NOP +41F9 00 . NOP +41FA 00 . NOP +41FB 00 . NOP +41FC 00 . NOP +41FD 00 . NOP +41FE 00 . NOP +41FF 00 . NOP +4200 00 . NOP +4201 00 . NOP +4202 00 . NOP +4203 00 . NOP +4204 00 . NOP +4205 00 . NOP +4206 00 . NOP +4207 00 . NOP +4208 00 . NOP +4209 00 . NOP +420A 00 . NOP +420B 00 . NOP +420C 00 . NOP +420D 00 . NOP +420E 00 . NOP +420F 00 . NOP +4210 00 . NOP +4211 00 . NOP +4212 00 . NOP +4213 00 . NOP +4214 00 . NOP +4215 00 . NOP +4216 97 . SUB A +4217 32 00 19 2.. LD (1900),A +421A 32 00 19 2.. LD (1900),A +421D 32 00 19 2.. LD (1900),A +4220 32 00 19 2.. LD (1900),A +4223 32 00 19 2.. LD (1900),A +4226 32 00 19 2.. LD (1900),A +4229 32 00 19 2.. LD (1900),A +422C 32 00 19 2.. LD (1900),A +422F 32 00 19 2.. LD (1900),A +4232 32 00 19 2.. LD (1900),A +4235 32 00 19 2.. LD (1900),A +4238 32 00 19 2.. LD (1900),A +423B 32 00 19 2.. LD (1900),A +423E 32 00 19 2.. LD (1900),A +4241 32 00 19 2.. LD (1900),A +4244 32 00 19 2.. LD (1900),A +4247 32 00 19 2.. LD (1900),A +424A 32 00 19 2.. LD (1900),A +424D 32 00 19 2.. LD (1900),A +4250 32 00 19 2.. LD (1900),A +4253 32 00 19 2.. LD (1900),A +4256 32 00 19 2.. LD (1900),A +4259 32 00 19 2.. LD (1900),A +425C 32 00 19 2.. LD (1900),A +425F 32 00 19 2.. LD (1900),A +4262 B7 . OR A +4263 21 00 00 !.. LD HL,0000 +4266 22 75 46 "uF LD (4675),HL +4269 21 18 42 !.B LD HL,4218 +426C 22 72 42 "rB LD (4272),HL +426F C9 . RET +4270 EB . EX DE,HL +4271 22 18 42 ".B LD (4218),HL +4274 2A 72 42 *rB LD HL,(4272) +4277 23 # INC HL +4278 23 # INC HL +4279 CB 7E .~ BIT 7,(HL) +427B 23 # INC HL +427C 22 72 42 "rB LD (4272),HL +427F EB . EX DE,HL +4280 C8 . RET Z +4281 CD 16 42 ..B CALL 4216 +4284 C3 26 29 .&) JP 2926 +4287 08 . EX AF,AF' +4288 F6 01 .. OR 01 +428A 08 . EX AF,AF' +428B CB 40 .@ BIT 0,B +428D 20 06 . JR NZ,4295 +428F 04 . INC B +4290 DD CB 09 FE .... SET 7,(IX+09) +4294 C9 . RET +4295 F5 . PUSH AF +4296 D5 . PUSH DE +4297 E5 . PUSH HL +4298 DD CB 09 BE .... RES 7,(IX+09) +429C DD 34 .4 INC (IX+0A) +429E 0A . LD A,(BC) +429F CD AB 42 ..B CALL 42AB +42A2 87 . ADD A +42A3 47 G LD B,A +42A4 E1 . POP HL +42A5 D1 . POP DE +42A6 F1 . POP AF +42A7 C9 . RET +42A8 97 . SUB A +42A9 18 DF .. JR 428A +42AB DD 66 0A .f. LD H,(IX+0A) +42AE DD 7E 0B .~. LD A,(IX+0B) +42B1 E6 03 .. AND 03 +42B3 5F _ LD E,A +42B4 FE 02 .. CP 02 +42B6 20 07 . JR NZ,42BF +42B8 CD 48 5F .H_ CALL 5F48 ; Segment 2 ist Ausnahme +42BB C0 . RET NZ +42BC DD 66 0A .f. LD H,(IX+0A) +42BF 7B { LD A,E +42C0 C6 19 .. ADD A,19 +42C2 57 W LD D,A +42C3 5C \ LD E,H +42C4 1A . LD A,(DE) +42C5 B7 . OR A +42C6 C0 . RET NZ +42C7 D5 . PUSH DE +42C8 7A z LD A,D +42C9 CD 70 42 .pB CALL 4270 +42CC D6 19 .. SUB A,19 +42CE 5F _ LD E,A +42CF 16 04 .. LD D,04 +42D1 FE 02 .. CP 02 +42D3 20 05 . JR NZ,42DA +42D5 CD 55 65 .Ue CALL 6555 +42D8 18 03 .. JR 42DD +42DA CD 5C 65 .\e CALL 655C +42DD 0F . RRCA +42DE E1 . POP HL +42DF 77 w LD (HL),A +42E0 C9 . RET +42E1 CB 1C .. RR H +42E3 CB 1D .. RR L +42E5 D5 . PUSH DE +42E6 63 c LD H,E +42E7 7A z LD A,D +42E8 CD 70 42 .pB CALL 4270 +42EB D6 19 .. SUB A,19 +42ED 5F _ LD E,A +42EE 16 04 .. LD D,04 +42F0 CD 5C 65 .\e CALL 655C +42F3 D1 . POP DE +42F4 0F . RRCA +42F5 12 . LD (DE),A +42F6 67 g LD H,A +42F7 29 ) ADD HL,HL +42F8 C9 . RET +42F9 CB 1C .. RR H +42FB CB 1D .. RR L +42FD D5 . PUSH DE +42FE 63 c LD H,E +42FF 7A z LD A,D +4300 CD 70 42 .pB CALL 4270 +4303 D6 19 .. SUB A,19 +4305 5F _ LD E,A +4306 16 04 .. LD D,04 +4308 CD 2C 66 .,f CALL 662C +430B D1 . POP DE +430C 0F . RRCA +430D 67 g LD H,A +430E F6 80 .. OR 80 +4310 12 . LD (DE),A +4311 29 ) ADD HL,HL +4312 C9 . RET ;--------------------------------- +4313 0A . LD A,(BC) ; Naechstes Codewort holen --> HL +4314 6F o LD L,A +4315 0C . INC C +4316 0A . LD A,(BC) +4317 0C . INC C +4318 CC 87 42 ..B CALL Z,4287 +431B B7 . OR A +431C FA 32 43 .2C JP M,4332 +431F D9 . EXX +4320 81 . ADD C +4321 5F _ LD E,A +4322 1A . LD A,(DE) +4323 D9 . EXX +4324 67 g LD H,A +4325 29 ) ADD HL,HL +4326 B7 . OR A +4327 C0 . RET NZ +4328 D5 . PUSH DE +4329 D9 . EXX +432A D5 . PUSH DE +432B D9 . EXX +432C D1 . POP DE +432D CD E1 42 ..B CALL 42E1 +4330 D1 . POP DE +4331 C9 . RET +4332 D5 . PUSH DE +4333 ED 5B C4 41 .[.A LD DE,(41C4) +4337 E6 7F .. AND 7F +4339 1F . RRA +433A CB 1D .. RR L +433C 67 g LD H,A +433D 38 0C 8. JR C,434B +433F 19 . ADD HL,DE +4340 5C \ LD E,H +4341 16 1A .. LD D,1A +4343 1A . LD A,(DE) +4344 67 g LD H,A +4345 29 ) ADD HL,HL +4346 B7 . OR A +4347 28 E4 (. JR Z,432D +4349 D1 . POP DE +434A C9 . RET +434B CD DE 43 ..C CALL 43DE +434E 20 0C . JR NZ,435C +4350 C6 19 .. ADD A,19 +4352 57 W LD D,A +4353 5C \ LD E,H +4354 1A . LD A,(DE) +4355 67 g LD H,A +4356 29 ) ADD HL,HL +4357 B7 . OR A +4358 28 D3 (. JR Z,432D +435A D1 . POP DE +435B C9 . RET +435C CD 5C 65 .\e CALL 655C +435F 0F . RRCA +4360 67 g LD H,A +4361 29 ) ADD HL,HL +4362 D1 . POP DE +4363 C9 . RET +4364 0A . LD A,(BC) +4365 6F o LD L,A +4366 0C . INC C +4367 0A . LD A,(BC) +4368 0C . INC C +4369 CC 87 42 ..B CALL Z,4287 +436C B7 . OR A +436D FA 82 43 ..C JP M,4382 +4370 D9 . EXX +4371 81 . ADD C +4372 5F _ LD E,A +4373 1A . LD A,(DE) +4374 D9 . EXX +4375 67 g LD H,A +4376 29 ) ADD HL,HL +4377 D8 . RET C +4378 D5 . PUSH DE +4379 D9 . EXX +437A D5 . PUSH DE +437B D9 . EXX +437C D1 . POP DE +437D CD F9 42 ..B CALL 42F9 +4380 D1 . POP DE +4381 C9 . RET +4382 D5 . PUSH DE +4383 ED 5B C4 41 .[.A LD DE,(41C4) +4387 E6 7F .. AND 7F +4389 1F . RRA +438A CB 1D .. RR L +438C 67 g LD H,A +438D 38 10 8. JR C,439F +438F 19 . ADD HL,DE +4390 5C \ LD E,H +4391 16 1A .. LD D,1A +4393 1A . LD A,(DE) +4394 67 g LD H,A +4395 29 ) ADD HL,HL +4396 7B { LD A,E +4397 D1 . POP DE +4398 D8 . RET C +4399 D5 . PUSH DE +439A 5F _ LD E,A +439B 16 1A .. LD D,1A +439D 18 DE .. JR 437D +439F CD DE 43 ..C CALL 43DE +43A2 20 0C . JR NZ,43B0 +43A4 C6 19 .. ADD A,19 +43A6 57 W LD D,A +43A7 5C \ LD E,H +43A8 1A . LD A,(DE) +43A9 67 g LD H,A +43AA 29 ) ADD HL,HL +43AB D4 F9 42 ..B CALL NC,42F9 +43AE D1 . POP DE +43AF C9 . RET +43B0 CD 2C 66 .,f CALL 662C +43B3 0F . RRCA +43B4 67 g LD H,A +43B5 29 ) ADD HL,HL +43B6 D1 . POP DE +43B7 C9 . RET ;------------ REF-Addr vom Stack +43B8 0A . LD A,(BC) ; --> HL, DE +43B9 6F o LD L,A +43BA 0C . INC C +43BB 0A . LD A,(BC) +43BC 0C . INC C +43BD CC 87 42 ..B CALL Z,4287 +43C0 B7 . OR A +43C1 FA CC 43 ..C JP M,43CC +43C4 D9 . EXX +43C5 81 . ADD C +43C6 D9 . EXX +43C7 67 g LD H,A +43C8 97 . SUB A +43C9 5F _ LD E,A +43CA 57 W LD D,A +43CB C9 . RET ;---------------------------------- +43CC ED 5B C4 41 .[.A LD DE,(41C4) +43D0 E6 7F .. AND 7F +43D2 1F . RRA +43D3 CB 1D .. RR L +43D5 67 g LD H,A +43D6 38 06 8. JR C,43DE +43D8 19 . ADD HL,DE +43D9 97 . SUB A +43DA 11 01 00 ... LD DE,0001 +43DD C9 . RET +43DE 19 . ADD HL,DE +43DF 16 1A .. LD D,1A +43E1 5C \ LD E,H +43E2 1A . LD A,(DE) +43E3 67 g LD H,A +43E4 29 ) ADD HL,HL +43E5 B7 . OR A +43E6 CC E1 42 ..B CALL Z,42E1 +43E9 5E ^ LD E,(HL) +43EA 2C , INC L +43EB 56 V LD D,(HL) +43EC 2C , INC L +43ED 7E ~ LD A,(HL) +43EE 2C , INC L +43EF 66 f LD H,(HL) +43F0 EB . EX DE,HL +43F1 14 . INC D +43F2 15 . DEC D +43F3 20 07 . JR NZ,43FC +43F5 FE 06 .. CP 06 +43F7 30 03 0. JR NC,43FC +43F9 5F _ LD E,A +43FA BF . CP A +43FB C9 . RET +43FC E6 07 .. AND 07 +43FE 5F _ LD E,A +43FF 7A z LD A,D +4400 FE 04 .. CP 04 +4402 7B { LD A,E +4403 D0 . RET NC +4404 16 05 .. LD D,05 +4406 C9 . RET ;---------------------------------- +4407 0A . LD A,(BC) +4408 6F o LD L,A +4409 0C . INC C +440A 0A . LD A,(BC) +440B CD 1B 43 ..C CALL 431B +440E 54 T LD D,H +440F 5D ] LD E,L +4410 2C , INC L +4411 2C , INC L +4412 28 05 (. JR Z,4419 +4414 0C . INC C +4415 C0 . RET NZ +4416 C3 87 42 ..B JP 4287 +4419 0D . DEC C +441A FD 21 85 46 .!.F LD IY,4685 +441E FD CB 00 C6 .... SET 0,(IY+00) +4422 CD B8 43 ..C CALL 43B8 +4425 7D } LD A,L +4426 32 86 46 2.F LD (4686),A +4429 ED 53 87 46 .S.F LD (4687),DE +442D 7B { LD A,E +442E CD CA 44 ..D CALL 44CA +4431 54 T LD D,H +4432 5D ] LD E,L +4433 2C , INC L +4434 2C , INC L +4435 CC 1B 45 ..E CALL Z,451B +4438 C9 . RET +4439 FD 21 85 46 .!.F LD IY,4685 +443D FD CB 00 86 .... RES 0,(IY+00) +4441 18 DF .. JR 4422 ;-------- Branchaddresse holen ----- +4443 0A . LD A,(BC) +4444 5F _ LD E,A +4445 0C . INC C +4446 0A . LD A,(BC) +4447 57 W LD D,A +4448 0C . INC C +4449 C0 . RET NZ +444A C3 87 42 ..B JP 4287 +444D FE 06 .. CP 06 +444F 30 0C 0. JR NC,445D +4451 C6 19 .. ADD A,19 +4453 57 W LD D,A +4454 5C \ LD E,H +4455 1A . LD A,(DE) +4456 67 g LD H,A +4457 29 ) ADD HL,HL +4458 B7 . OR A +4459 C0 . RET NZ +445A C3 E1 42 ..B JP 42E1 +445D ED 5B 75 46 .[uF LD DE,(4675) +4461 7C | LD A,H +4462 BA . CP D +4463 20 07 . JR NZ,446C +4465 7B { LD A,E +4466 B7 . OR A +4467 28 03 (. JR Z,446C +4469 63 c LD H,E +446A 29 ) ADD HL,HL +446B C9 . RET +446C 16 04 .. LD D,04 +446E 1E 07 .. LD E,07 +4470 CD 5C 65 .\e CALL 655C +4473 0F . RRCA +4474 5F _ LD E,A +4475 54 T LD D,H +4476 ED 53 75 46 .SuF LD (4675),DE +447A 63 c LD H,E +447B 29 ) ADD HL,HL +447C C9 . RET +447D FE 06 .. CP 06 +447F 30 0B 0. JR NC,448C +4481 C6 19 .. ADD A,19 +4483 57 W LD D,A +4484 5C \ LD E,H +4485 1A . LD A,(DE) +4486 67 g LD H,A +4487 29 ) ADD HL,HL +4488 D8 . RET C +4489 C3 F9 42 ..B JP 42F9 +448C ED 5B 75 46 .[uF LD DE,(4675) +4490 7C | LD A,H +4491 BA . CP D +4492 20 07 . JR NZ,449B +4494 7B { LD A,E +4495 87 . ADD A +4496 30 03 0. JR NC,449B +4498 63 c LD H,E +4499 29 ) ADD HL,HL +449A C9 . RET +449B 16 04 .. LD D,04 +449D 1E 07 .. LD E,07 +449F CD 2C 66 .,f CALL 662C +44A2 0F . RRCA +44A3 F6 80 .. OR 80 +44A5 18 CD .. JR 4474 +44A7 CD 13 43 ..C CALL 4313 +44AA 7D } LD A,L +44AB E6 F8 .. AND F8 +44AD 6F o LD L,A +44AE C9 . RET +44AF CD 1B 43 ..C CALL 431B +44B2 7D } LD A,L +44B3 E6 F8 .. AND F8 +44B5 6F o LD L,A +44B6 C9 . RET +44B7 CD 64 43 .dC CALL 4364 +44BA 7D } LD A,L +44BB E6 F8 .. AND F8 +44BD 6F o LD L,A +44BE C9 . RET +44BF 5D ] LD E,L +44C0 7D } LD A,L +44C1 E6 F0 .. AND F0 +44C3 6F o LD L,A +44C4 AB . XOR E +44C5 1F . RRA +44C6 CB 1C .. RR H +44C8 CB 1D .. RR L +44CA FD 74 01 .t. LD (IY+01),H +44CD FD 77 02 .w. LD (IY+02),A +44D0 5F _ LD E,A +44D1 FD 7E 03 .~. LD A,(IY+03) +44D4 B7 . OR A +44D5 20 15 . JR NZ,44EC ; Fremdatenraum +44D7 7B { LD A,E ; DS4 = 0 +44D8 C6 19 .. ADD A,19 +44DA 57 W LD D,A +44DB 5C \ LD E,H +44DC 1A . LD A,(DE) ; DE=1900+256*segment+AddrDIV256 +44DD 67 g LD H,A +44DE 29 ) ADD HL,HL ; In Byteaddresse wandeln +44DF D8 . RET C +44E0 FD CB 00 46 ...F BIT 0,(IY+00) +44E4 CA F9 42 ..B JP Z,42F9 +44E7 B7 . OR A +44E8 C0 . RET NZ +44E9 C3 E1 42 ..B JP 42E1 +44EC 57 W LD D,A +44ED FD CB 00 46 ...F BIT 0,(IY+00) +44F1 20 05 . JR NZ,44F8 +44F3 CD 2C 66 .,f CALL 662C +44F6 18 03 .. JR 44FB +44F8 CD 5C 65 .\e CALL 655C +44FB 0F . RRCA +44FC 67 g LD H,A +44FD 29 ) ADD HL,HL +44FE C9 . RET +44FF CB 3F .? SLR A +4501 CB 1C .. RR H +4503 CB 1D .. RR L +4505 F5 . PUSH AF +4506 CD CA 44 ..D CALL 44CA +4509 F1 . POP AF +450A D0 . RET NC +450B 2C , INC L +450C C9 . RET ;--------------------------------- +450D 7D } LD A,L +450E 83 . ADD E +450F 3E 00 >. LD A,00 +4511 8A . ADC D +4512 20 02 . JR NZ,4516 +4514 19 . ADD HL,DE +4515 C9 . RET +4516 3D = DEC A +4517 20 0D . JR NZ,4526 +4519 19 . ADD HL,DE +451A 25 % DEC H +451B 24 $ INC H +451C CB 44 .D BIT 0,H +451E C0 . RET NZ +451F 25 % DEC H +4520 D5 . PUSH DE +4521 11 00 01 ... LD DE,0100 +4524 18 01 .. JR 4527 +4526 D5 . PUSH DE +4527 97 . SUB A +4528 CB 1C .. RR H +452A FD 66 01 .f. LD H,(IY+01) +452D CB 14 .. RL H +452F 17 . RLA +4530 19 . ADD HL,DE +4531 CE 00 .. ADC A,00 +4533 1F . RRA +4534 CB 1C .. RR H +4536 CB 1D .. RR L +4538 F5 . PUSH AF +4539 FD 86 02 ... ADD (IY+02) +453C CD CA 44 ..D CALL 44CA +453F F1 . POP AF +4540 D1 . POP DE +4541 D0 . RET NC +4542 2C , INC L +4543 C9 . RET +4544 D5 . PUSH DE +4545 11 00 00 ... LD DE,0000 +4548 CD 78 45 .xE CALL 4578 +454B D1 . POP DE +454C C9 . RET +454D 2A 79 46 *yF LD HL,(4679) +4550 DD 75 0C .u. LD (IX+0C),L +4553 DD 74 0D .t. LD (IX+0D),H +4556 DD CB 07 AE .... RES 5,(IX+07) +455A DD CB 07 F6 .... SET 6,(IX+07) +455E C9 . RET +455F 69 i LD L,C +4560 60 ` LD H,B +4561 DD 4E 0C .N. LD C,(IX+0C) +4564 DD 46 0D .F. LD B,(IX+0D) +4567 B7 . OR A +4568 ED 42 .B SBC HL,BC +456A 22 7B 46 "{F LD (467B),HL +456D ED 43 79 46 .CyF LD (4679),BC +4571 CD C1 45 ..E CALL 45C1 +4574 DD CB 07 B6 .... RES 6,(IX+07) +4578 22 7D 46 "}F LD (467D),HL +457B ED 53 7F 46 .S.F LD (467F),DE +457F DD CB 07 76 ...v BIT 6,(IX+07) +4583 20 DA . JR NZ,455F +4585 7B { LD A,E +4586 BD . CP L +4587 30 01 0. JR NC,458A +4589 7D } LD A,L +458A ED 44 .D NEG +458C 28 0F (. JR Z,459D +458E 04 . INC B +458F 05 . DEC B +4590 20 12 . JR NZ,45A4 +4592 B9 . CP C +4593 38 0F 8. JR C,45A4 +4595 78 x LD A,B +4596 B1 . OR C +4597 C9 . RET +4598 2A 7D 46 *}F LD HL,(467D) +459B 18 F8 .. JR 4595 +459D 04 . INC B +459E 05 . DEC B +459F 28 F4 (. JR Z,4595 +45A1 37 7 SCF +45A2 18 01 .. JR 45A5 +45A4 B7 . OR A +45A5 69 i LD L,C +45A6 60 ` LD H,B +45A7 4F O LD C,A +45A8 3E 00 >. LD A,00 +45AA 8F . ADC A +45AB 47 G LD B,A +45AC B7 . OR A +45AD ED 42 .B SBC HL,BC +45AF 28 E7 (. JR Z,4598 +45B1 DD CB 07 EE .... SET 5,(IX+07) +45B5 ED 43 7B 46 .C{F LD (467B),BC +45B9 22 79 46 "yF LD (4679),HL +45BC 2A 7D 46 *}F LD HL,(467D) +45BF 37 7 SCF +45C0 C9 . RET +45C1 2A 7F 46 *.F LD HL,(467F) +45C4 7C | LD A,H +45C5 B5 . OR L +45C6 28 0C (. JR Z,45D4 +45C8 FD 21 89 46 .!.F LD IY,4689 +45CC ED 5B 7B 46 .[{F LD DE,(467B) +45D0 CD 0D 45 ..E CALL 450D +45D3 EB . EX DE,HL +45D4 D5 . PUSH DE +45D5 2A 7D 46 *}F LD HL,(467D) +45D8 FD 21 85 46 .!.F LD IY,4685 +45DC ED 5B 7B 46 .[{F LD DE,(467B) +45E0 CD 0D 45 ..E CALL 450D +45E3 D1 . POP DE +45E4 ED 4B 79 46 .KyF LD BC,(4679) +45E8 DD CB 07 B6 .... RES 6,(IX+07) +45EC DD CB 07 AE .... RES 5,(IX+07) +45F0 C9 . RET +45F1 DD CB 07 6E ...n BIT 5,(IX+07) +45F5 28 0D (. JR Z,4604 +45F7 E5 . PUSH HL +45F8 2A 79 46 *yF LD HL,(4679) +45FB 22 77 46 "wF LD (4677),HL +45FE 09 . ADD HL,BC +45FF 22 79 46 "yF LD (4679),HL +4602 E1 . POP HL +4603 C9 . RET +4604 3E FF >. LD A,FF +4606 32 78 46 2xF LD (4678),A +4609 DD CB 07 EE .... SET 5,(IX+07) +460D ED 43 79 46 .CyF LD (4679),BC +4611 C9 . RET +4612 2A 77 46 *wF LD HL,(4677) +4615 CB 7C .| BIT 7,H +4617 20 D3 . JR NZ,45EC +4619 22 79 46 "yF LD (4679),HL +461C C9 . RET +461D ED 43 81 46 .C.F LD (4681),BC +4621 1B . DEC DE +4622 7B { LD A,E +4623 B2 . OR D +4624 C8 . RET Z +4625 FD 21 85 46 .!.F LD IY,4685 +4629 CD 0D 45 ..E CALL 450D +462C 79 y LD A,C +462D 93 . SUB E ; BC DECR DE +462E 4F O LD C,A +462F 78 x LD A,B +4630 9A . SBC D +4631 47 G LD B,A +4632 C9 . RET ;----------------------------------- +4633 2A 81 46 *.F LD HL,(4681) +4636 B7 . OR A +4637 ED 42 .B SBC HL,BC +4639 DD CB 07 6E ...n BIT 5,(IX+07) +463D 28 07 (. JR Z,4646 +463F ED 4B 79 46 .KyF LD BC,(4679) +4643 B7 . OR A +4644 ED 42 .B SBC HL,BC +4646 EB . EX DE,HL +4647 18 A3 .. JR 45EC ; REST Bit 5 (IX+7) +4649 F5 . PUSH AF +464A E5 . PUSH HL +464B 3E 01 >. LD A,01 +464D CD 7D 44 .}D CALL 447D +4650 36 FF 6. LD (HL),FF +4652 54 T LD D,H +4653 5D ] LD E,L +4654 13 . INC DE +4655 97 . SUB A +4656 93 . SUB E +4657 4F O LD C,A +4658 06 00 .. LD B,00 +465A CB 44 .D BIT 0,H +465C 20 01 . JR NZ,465F +465E 04 . INC B +465F 78 x LD A,B +4660 B1 . OR C +4661 28 02 (. JR Z,4665 +4663 ED B0 .. LDIR +4665 D1 . POP DE +4666 F1 . POP AF +4667 92 . SUB D +4668 47 G LD B,A +4669 0E 04 .. LD C,04 +466B 5A Z LD E,D +466C 16 01 .. LD D,01 +466E 13 . INC DE +466F 21 00 06 !.. LD HL,0600 +4672 C3 B6 69 ..i JP 69B6 +4675 00 . NOP +4676 00 . NOP +4677 00 . NOP +4678 00 . NOP +4679 00 . NOP +467A 00 . NOP +467B 00 . NOP +467C 00 . NOP +467D 00 . NOP +467E 00 . NOP +467F 00 . NOP +4680 00 . NOP +4681 00 . NOP +4682 00 . NOP +4683 56 V LD D,(HL) ; "VR" - 8 Byte-Register +4684 52 R LD D,D +4685 00 . NOP +4686 00 . NOP +4687 00 . NOP +4688 00 . NOP +4689 00 . NOP +468A 00 . NOP +468B 00 . NOP +468C 00 . NOP +468D CD B8 43 ..C CALL 43B8 +4690 18 03 .. JR 4695 +4692 CD C0 43 ..C CALL 43C0 +4695 FD 21 85 46 .!.F LD IY,4685 +4699 22 85 46 ".F LD (4685),HL +469C ED 53 87 46 .S.F LD (4687),DE +46A0 FD CB 00 C6 .... SET 0,(IY+00) +46A4 20 4B K JR NZ,46F1 +46A6 23 # INC HL +46A7 7B { LD A,E +46A8 5C \ LD E,H +46A9 C6 19 .. ADD A,19 +46AB 57 W LD D,A +46AC 1A . LD A,(DE) +46AD 67 g LD H,A +46AE 29 ) ADD HL,HL +46AF B7 . OR A +46B0 CC E1 42 ..B CALL Z,42E1 +46B3 7E ~ LD A,(HL) +46B4 FE FF .. CP FF +46B6 28 05 (. JR Z,46BD +46B8 2C , INC L +46B9 5F _ LD E,A +46BA 16 00 .. LD D,00 +46BC C9 . RET +46BD 2C , INC L +46BE 5E ^ LD E,(HL) +46BF 2C , INC L +46C0 56 V LD D,(HL) +46C1 CB 7A .z BIT 7,D +46C3 C2 13 4A ..J JP NZ,4A13 +46C6 CB 95 .. RES 2,L +46C8 7E ~ LD A,(HL) +46C9 2C , INC L +46CA 66 f LD H,(HL) +46CB 6F o LD L,A +46CC D5 . PUSH DE +46CD CD BF 44 ..D CALL 44BF +46D0 D1 . POP DE +46D1 7E ~ LD A,(HL) +46D2 3C < INC A +46D3 C2 13 4A ..J JP NZ,4A13 +46D6 7D } LD A,L +46D7 C6 06 .. ADD A,06 +46D9 6F o LD L,A +46DA 3E FF >. LD A,FF +46DC C9 . RET +46DD CD B8 43 ..C CALL 43B8 +46E0 FD 21 89 46 .!.F LD IY,4689 +46E4 22 89 46 ".F LD (4689),HL +46E7 ED 53 8B 46 .S.F LD (468B),DE +46EB FD CB 00 C6 .... SET 0,(IY+00) +46EF 28 B5 (. JR Z,46A6 +46F1 23 # INC HL +46F2 CD ED 44 ..D CALL 44ED +46F5 7E ~ LD A,(HL) +46F6 FE FF .. CP FF +46F8 20 1A . JR NZ,4714 +46FA 23 # INC HL +46FB 23 # INC HL +46FC BE . CP (HL) +46FD 2B + DEC HL +46FE 2B + DEC HL +46FF 28 13 (. JR Z,4714 +4701 2C , INC L +4702 5E ^ LD E,(HL) +4703 2C , INC L +4704 56 V LD D,(HL) +4705 CB 95 .. RES 2,L +4707 7E ~ LD A,(HL) +4708 2C , INC L +4709 66 f LD H,(HL) +470A 6F o LD L,A +470B D5 . PUSH DE +470C CD BF 44 ..D CALL 44BF +470F D1 . POP DE +4710 2C , INC L +4711 2C , INC L +4712 18 C6 .. JR 46DA +4714 B7 . OR A +4715 F2 B8 46 ..F JP P,46B8 +4718 2D - DEC L +4719 56 V LD D,(HL) +471A 2D - DEC L +471B 5E ^ LD E,(HL) +471C 7B { LD A,E +471D E6 07 .. AND 07 +471F C2 13 4A ..J JP NZ,4A13 +4722 EB . EX DE,HL +4723 97 . SUB A +4724 CD FF 44 ..D CALL 44FF +4727 CB D5 .. SET 2,L +4729 7E ~ LD A,(HL) +472A 18 8C .. JR 46B8 +472C CD 8D 46 ..F CALL 468D +472F E5 . PUSH HL +4730 CD A8 2C .., CALL 2CA8 +4733 C5 . PUSH BC +4734 4D M LD C,L +4735 44 D LD B,H +4736 18 20 . JR 4758 +4738 DD CB 07 5E ...^ BIT 3,(IX+07) +473C 20 0E . JR NZ,474C +473E DD 75 18 .u. LD (IX+18),L ; hpv1 +4741 DD 74 19 .t. LD (IX+19),H +4744 DD 71 1A .q. LD (IX+1A),C ; hpv2 +4747 DD 70 1B .p. LD (IX+1B),B +474A 18 0C .. JR 4758 +474C DD 6E 18 .n. LD L,(IX+18) +474F DD 66 19 .f. LD H,(IX+19) +4752 DD 4E 1A .N. LD C,(IX+1A) +4755 DD 46 1B .F. LD B,(IX+1B) +4758 2B + DEC HL +4759 CB 7C .| BIT 7,H +475B 28 03 (. JR Z,4760 +475D 21 00 00 !.. LD HL,0000 +4760 CB 78 .x BIT 7,B +4762 20 1F . JR NZ,4783 +4764 7B { LD A,E +4765 91 . SUB C +4766 7A z LD A,D +4767 98 . SBC B +4768 30 02 0. JR NC,476C +476A 42 B LD B,D +476B 4B K LD C,E +476C EB . EX DE,HL +476D 69 i LD L,C +476E 60 ` LD H,B +476F B7 . OR A +4770 ED 52 .R SBC HL,DE +4772 28 0F (. JR Z,4783 +4774 38 0D 8. JR C,4783 +4776 C1 . POP BC +4777 E3 . EX (SP),HL +4778 CD 0D 45 ..E CALL 450D +477B D1 . POP DE +477C 7B { LD A,E +477D 14 . INC D +477E 15 . DEC D +477F C8 . RET Z +4780 3E FF >. LD A,FF +4782 C9 . RET +4783 C1 . POP BC +4784 E1 . POP HL +4785 97 . SUB A +4786 57 W LD D,A +4787 5F _ LD E,A +4788 C9 . RET +4789 CD 8D 46 ..F CALL 468D +478C E5 . PUSH HL +478D CD A8 2C .., CALL 2CA8 +4790 C5 . PUSH BC +4791 42 B LD B,D +4792 4B K LD C,E +4793 18 A3 .. JR 4738 +4795 CD 8D 46 ..F CALL 468D +4798 E5 . PUSH HL +4799 CD A8 2C .., CALL 2CA8 +479C 22 4A 4B "JK LD (4B4A),HL +479F CD A8 2C .., CALL 2CA8 +47A2 C5 . PUSH BC +47A3 44 D LD B,H +47A4 4D M LD C,L +47A5 2A 4A 4B *JK LD HL,(4B4A) +47A8 18 8E .. JR 4738 +47AA CD B8 43 ..C CALL 43B8 +47AD FD 21 89 46 .!.F LD IY,4689 +47B1 22 89 46 ".F LD (4689),HL +47B4 ED 53 8B 46 .S.F LD (468B),DE +47B8 ED 43 D0 41 .C.A LD (41D0),BC +47BC 3E 02 >. LD A,02 +47BE 32 89 46 2.F LD (4689),A +47C1 7B { LD A,E +47C2 32 3B 4B 2;K LD (4B3B),A +47C5 B5 . OR L +47C6 32 3C 4B 2. LD A,0D +47DF BB . CP E +47E0 30 1C 0. JR NC,47FE +47E2 FD CB 00 8E .... RES 1,(IY+00) +47E6 2A 38 4B *8K LD HL,(4B38) +47E9 36 00 6. LD (HL),00 +47EB 21 00 00 !.. LD HL,0000 +47EE 22 3E 4B ">K LD (4B3E),HL +47F1 2A 3A 4B *:K LD HL,(4B3A) +47F4 22 8A 46 ".F LD (468A),HL +47F7 2A 38 4B *8K LD HL,(4B38) +47FA 1E 00 .. LD E,00 +47FC 3E 0D >. LD A,0D +47FE 2C , INC L +47FF 16 00 .. LD D,00 +4801 42 B LD B,D +4802 4F O LD C,A +4803 C9 . RET +4804 FD CB 00 8E .... RES 1,(IY+00) +4808 2D - DEC L +4809 56 V LD D,(HL) +480A 2D - DEC L +480B 5E ^ LD E,(HL) +480C ED 53 3E 4B .S>K LD (4B3E),DE +4810 3A 8C 46 :.F LD A,(468C) +4813 B7 . OR A +4814 20 35 5 JR NZ,484B +4816 7B { LD A,E +4817 E6 0F .. AND 0F +4819 FE 03 .. CP 03 +481B 20 CE . JR NZ,47EB +481D EB . EX DE,HL +481E CD BF 44 ..D CALL 44BF +4821 7E ~ LD A,(HL) +4822 2C , INC L +4823 A6 . AND (HL) +4824 3C < INC A +4825 20 C4 . JR NZ,47EB +4827 2C , INC L +4828 3A 3C 4B :. LD A,FF +4862 12 . LD (DE),A +4863 FD CB 00 8E .... RES 1,(IY+00) +4867 D1 . POP DE +4868 7B { LD A,E +4869 FE 0E .. CP 0E +486B 30 0F 0. JR NC,487C +486D 14 . INC D +486E 15 . DEC D +486F 20 0B . JR NZ,487C +4871 2A 3A 4B *:K LD HL,(4B3A) +4874 22 8A 46 ".F LD (468A),HL +4877 2A 38 4B *8K LD HL,(4B38) +487A 2C , INC L +487B C9 . RET +487C 79 y LD A,C +487D 93 . SUB E +487E 78 x LD A,B +487F 9A . SBC D +4880 D0 . RET NC +4881 FD CB 00 4E ...N BIT 1,(IY+00) +4885 20 D0 . JR NZ,4857 +4887 CD 3F 49 .?I CALL 493F +488A FD CB 00 5E ...^ BIT 3,(IY+00) +488E C4 ED 49 ..I CALL NZ,49ED +4891 C9 . RET +4892 14 . INC D +4893 15 . DEC D +4894 20 0B . JR NZ,48A1 +4896 3E 0D >. LD A,0D +4898 BB . CP E +4899 38 06 8. JR C,48A1 +489B 2A 38 4B *8K LD HL,(4B38) +489E 73 s LD (HL),E +489F 2C , INC L +48A0 C9 . RET +48A1 E5 . PUSH HL +48A2 2A 38 4B *8K LD HL,(4B38) +48A5 36 FF 6. LD (HL),FF +48A7 2C , INC L +48A8 73 s LD (HL),E +48A9 2C , INC L +48AA 72 r LD (HL),D +48AB E1 . POP HL +48AC C9 . RET +48AD 3A 89 46 :.F LD A,(4689) +48B0 B7 . OR A +48B1 CA 13 4A ..J JP Z,4A13 +48B4 79 y LD A,C +48B5 93 . SUB E +48B6 78 x LD A,B +48B7 9A . SBC D +48B8 D0 . RET NC +48B9 D5 . PUSH DE +48BA 2A 85 46 *.F LD HL,(4685) +48BD E5 . PUSH HL +48BE 2A 87 46 *.F LD HL,(4687) +48C1 E5 . PUSH HL +48C2 2A 89 46 *.F LD HL,(4689) +48C5 2E 01 .. LD L,01 +48C7 22 85 46 ".F LD (4685),HL +48CA 2A 8B 46 *.F LD HL,(468B) +48CD 22 87 46 ".F LD (4687),HL +48D0 FD CB 00 4E ...N BIT 1,(IY+00) +48D4 20 3A : JR NZ,4910 +48D6 CD 3F 49 .?I CALL 493F +48D9 22 4A 4B "JK LD (4B4A),HL +48DC FD CB 00 5E ...^ BIT 3,(IY+00) +48E0 28 20 ( JR Z,4902 +48E2 ED 4B 40 4B .K@K LD BC,(4B40) +48E6 EB . EX DE,HL +48E7 2A 8A 46 *.F LD HL,(468A) +48EA E5 . PUSH HL +48EB 2A 42 4B *BK LD HL,(4B42) +48EE 2C , INC L +48EF 2C , INC L +48F0 CD B0 2C .., CALL 2CB0 +48F3 E1 . POP HL +48F4 22 8A 46 ".F LD (468A),HL +48F7 FD 21 89 46 .!.F LD IY,4689 +48FB FD CB 00 5E ...^ BIT 3,(IY+00) +48FF C4 ED 49 ..I CALL NZ,49ED +4902 E1 . POP HL +4903 22 87 46 ".F LD (4687),HL +4906 E1 . POP HL +4907 22 85 46 ".F LD (4685),HL +490A 2A 4A 4B *JK LD HL,(4B4A) +490D D1 . POP DE +490E B7 . OR A +490F C9 . RET +4910 D5 . PUSH DE +4911 2A 38 4B *8K LD HL,(4B38) +4914 CD 08 48 ..H CALL 4808 +4917 D1 . POP DE +4918 79 y LD A,C +4919 93 . SUB E +491A 78 x LD A,B +491B 9A . SBC D +491C DC 3F 49 .?I CALL C,493F +491F 22 4A 4B "JK LD (4B4A),HL +4922 ED 4B 40 4B .K@K LD BC,(4B40) +4926 EB . EX DE,HL +4927 2A 8A 46 *.F LD HL,(468A) +492A E5 . PUSH HL +492B 2A 38 4B *8K LD HL,(4B38) +492E 2C , INC L +492F CD B0 2C .., CALL 2CB0 +4932 2A 38 4B *8K LD HL,(4B38) +4935 7E ~ LD A,(HL) +4936 36 FF 6. LD (HL),FF +4938 2C , INC L +4939 77 w LD (HL),A +493A 2C , INC L +493B 36 00 6. LD (HL),00 +493D 18 B4 .. JR 48F3 +493F D5 . PUSH DE +4940 21 CA 41 !.A LD HL,41CA +4943 3A 8C 46 :.F LD A,(468C) +4946 B7 . OR A +4947 28 11 (. JR Z,495A +4949 D5 . PUSH DE +494A 57 W LD D,A +494B 21 00 01 !.. LD HL,0100 +494E 5D ] LD E,L +494F CD 2C 66 .,f CALL 662C +4952 0F . RRCA +4953 67 g LD H,A +4954 29 ) ADD HL,HL +4955 D1 . POP DE +4956 3E 02 >. LD A,02 +4958 18 02 .. JR 495C +495A 3E 06 >. LD A,06 +495C E5 . PUSH HL +495D 32 48 4B 2HK LD (4B48),A +4960 C6 0F .. ADD A,0F +4962 83 . ADD E +4963 30 01 0. JR NC,4966 +4965 14 . INC D +4966 E6 F0 .. AND F0 +4968 5F _ LD E,A +4969 2A 3E 4B *>K LD HL,(4B3E) +496C 09 . ADD HL,BC +496D ED 4B 48 4B .KHK LD BC,(4B48) +4971 09 . ADD HL,BC +4972 C1 . POP BC +4973 0A . LD A,(BC) +4974 BD . CP L +4975 20 23 # JR NZ,499A +4977 03 . INC BC +4978 0A . LD A,(BC) +4979 0B . DEC BC +497A BC . CP H +497B 20 1D . JR NZ,499A +497D 2A 3E 4B *>K LD HL,(4B3E) +4980 19 . ADD HL,DE +4981 DC D8 49 ..I CALL C,49D8 +4984 7D } LD A,L +4985 02 . LD (BC),A +4986 03 . INC BC +4987 7C | LD A,H +4988 02 . LD (BC),A +4989 2A 48 4B *HK LD HL,(4B48) +498C EB . EX DE,HL +498D B7 . OR A +498E ED 52 .R SBC HL,DE +4990 EB . EX DE,HL +4991 2A 42 4B *BK LD HL,(4B42) +4994 73 s LD (HL),E +4995 2C , INC L +4996 72 r LD (HL),D +4997 2C , INC L +4998 D1 . POP DE +4999 C9 . RET +499A ED 43 44 4B .CDK LD (4B44),BC +499E 0A . LD A,(BC) +499F 6F o LD L,A +49A0 03 . INC BC +49A1 0A . LD A,(BC) +49A2 67 g LD H,A +49A3 E5 . PUSH HL +49A4 19 . ADD HL,DE +49A5 DC D8 49 ..I CALL C,49D8 +49A8 22 46 4B "FK LD (4B46),HL +49AB 2A 48 4B *HK LD HL,(4B48) +49AE EB . EX DE,HL +49AF B7 . OR A +49B0 ED 52 .R SBC HL,DE +49B2 E3 . EX (SP),HL +49B3 22 3E 4B ">K LD (4B3E),HL +49B6 CD BF 44 ..D CALL 44BF +49B9 D1 . POP DE +49BA 3A 8C 46 :.F LD A,(468C) +49BD B7 . OR A +49BE 20 0E . JR NZ,49CE +49C0 36 FF 6. LD (HL),FF +49C2 2C , INC L +49C3 36 FF 6. LD (HL),FF +49C5 2C , INC L +49C6 ED 4B 3C 4B .K. LD A,03 +49E6 DD CB 0B B6 .... RES 6,(IX+0B) +49EA C3 0D 3D ..= JP 3D0D +49ED E5 . PUSH HL +49EE D5 . PUSH DE +49EF 2A 44 4B *DK LD HL,(4B44) +49F2 ED 5B 46 4B .[FK LD DE,(4B46) +49F6 73 s LD (HL),E +49F7 23 # INC HL +49F8 72 r LD (HL),D +49F9 2A 38 4B *8K LD HL,(4B38) +49FC 2D - DEC L +49FD 2D - DEC L +49FE ED 5B 3E 4B .[>K LD DE,(4B3E) +4A02 73 s LD (HL),E +4A03 2C , INC L +4A04 72 r LD (HL),D +4A05 2C , INC L +4A06 36 FF 6. LD (HL),FF +4A08 2C , INC L +4A09 ED 5B 40 4B .[@K LD DE,(4B40) +4A0D 73 s LD (HL),E +4A0E 2C , INC L +4A0F 72 r LD (HL),D +4A10 D1 . POP DE +4A11 E1 . POP HL +4A12 C9 . RET +4A13 3E 0E >. LD A,0E +4A15 CD 0D 3D ..= CALL 3D0D +4A18 97 . SUB A +4A19 57 W LD D,A +4A1A 5F _ LD E,A +4A1B 37 7 SCF +4A1C C9 . RET +4A1D 7A z LD A,D +4A1E B7 . OR A +4A1F C0 . RET NZ +4A20 7B { LD A,E +4A21 FE 0D .. CP 0D +4A23 C0 . RET NZ +4A24 4E N LD C,(HL) +4A25 2C , INC L +4A26 46 F LD B,(HL) +4A27 2D - DEC L +4A28 E5 . PUSH HL +4A29 2A 38 4B *8K LD HL,(4B38) +4A2C 77 w LD (HL),A +4A2D 2C , INC L +4A2E 71 q LD (HL),C +4A2F 2C , INC L +4A30 70 p LD (HL),B +4A31 E1 . POP HL +4A32 C9 . RET +4A33 DD CB 07 C6 .... SET 0,(IX+07) +4A37 18 04 .. JR 4A3D +4A39 DD CB 07 86 .... RES 0,(IX+07) +4A3D DD 36 06 20 .6. LD (IX+06),20 +4A41 2A C8 41 *.A LD HL,(41C8) +4A44 3E 7F >. LD A,7F +4A46 CD 49 46 .IF CALL 4649 +4A49 21 03 00 !.. LD HL,0003 +4A4C 22 CA 41 ".A LD (41CA),HL +4A4F DD 75 18 .u. LD (IX+18),L +4A52 DD 74 19 .t. LD (IX+19),H +4A55 DD 36 06 24 .6.$ LD (IX+06),24 +4A59 DD CB 07 A6 .... RES 4,(IX+07) +4A5D DD 6E 18 .n. LD L,(IX+18) +4A60 DD 66 19 .f. LD H,(IX+19) +4A63 FD 21 85 46 .!.F LD IY,4685 +4A67 FD CB 00 C6 .... SET 0,(IY+00) +4A6B FD 36 03 00 .6.. LD (IY+03),00 +4A6F CD BF 44 ..D CALL 44BF +4A72 22 4A 4B "JK LD (4B4A),HL +4A75 DD CB 07 66 ...f BIT 4,(IX+07) +4A79 20 40 @ JR NZ,4ABB +4A7B 2C , INC L +4A7C 2C , INC L +4A7D 5E ^ LD E,(HL) +4A7E 2C , INC L +4A7F 56 V LD D,(HL) +4A80 7B { LD A,E +4A81 A2 . AND D +4A82 3C < INC A +4A83 CA 09 4B ..K JP Z,4B09 +4A86 ED 53 C6 41 .S.A LD (41C6),DE +4A8A 2C , INC L +4A8B 7E ~ LD A,(HL) +4A8C DD 77 1A .w. LD (IX+1A),A +4A8F 2C , INC L +4A90 7E ~ LD A,(HL) +4A91 DD 77 1B .w. LD (IX+1B),A +4A94 7B { LD A,E +4A95 E6 01 .. AND 01 +4A97 CB 83 .. RES 0,E +4A99 EB . EX DE,HL +4A9A CD 4D 44 .MD CALL 444D +4A9D DD 7E 18 .~. LD A,(IX+18) +4AA0 BE . CP (HL) +4AA1 20 47 G JR NZ,4AEA +4AA3 2C , INC L +4AA4 DD 7E 19 .~. LD A,(IX+19) +4AA7 BE . CP (HL) +4AA8 20 40 @ JR NZ,4AEA +4AAA 2C , INC L +4AAB 7E ~ LD A,(HL) +4AAC 3C < INC A +4AAD 20 3B ; JR NZ,4AEA +4AAF 2C , INC L +4AB0 DD 7E 1A .~. LD A,(IX+1A) +4AB3 96 . SUB (HL) +4AB4 23 # INC HL +4AB5 DD 7E 1B .~. LD A,(IX+1B) +4AB8 9E . SBC (HL) +4AB9 38 2F 8/ JR C,4AEA +4ABB DD CB 07 E6 .... SET 4,(IX+07) +4ABF 2A C6 41 *.A LD HL,(41C6) +4AC2 16 00 .. LD D,00 +4AC4 7D } LD A,L +4AC5 E6 01 .. AND 01 +4AC7 5F _ LD E,A +4AC8 CB 85 .. RES 0,L +4ACA CD AD 47 ..G CALL 47AD +4ACD ED 53 40 4B .S@K LD (4B40),DE +4AD1 CD 3F 49 .?I CALL 493F +4AD4 FD CB 00 5E ...^ BIT 3,(IY+00) +4AD8 C4 ED 49 ..I CALL NZ,49ED +4ADB 42 B LD B,D +4ADC 4B K LD C,E +4ADD EB . EX DE,HL +4ADE 2A 4A 4B *JK LD HL,(4B4A) +4AE1 7D } LD A,L +4AE2 C6 06 .. ADD A,06 +4AE4 6F o LD L,A +4AE5 CD B0 2C .., CALL 2CB0 +4AE8 18 04 .. JR 4AEE +4AEA DD CB 07 C6 .... SET 0,(IX+07) +4AEE DD CB 07 A6 .... RES 4,(IX+07) +4AF2 DD 7E 18 .~. LD A,(IX+18) +4AF5 C6 06 .. ADD A,06 +4AF7 DD 86 1A ... ADD (IX+1A) +4AFA DD 77 18 .w. LD (IX+18),A +4AFD DD 7E 19 .~. LD A,(IX+19) +4B00 DD 8E 1B ... ADC (IX+1B) +4B03 DD 77 19 .w. LD (IX+19),A +4B06 D2 5D 4A .]J JP NC,4A5D +4B09 DD 36 06 28 .6.( LD (IX+06),28 +4B0D 2A C8 41 *.A LD HL,(41C8) +4B10 23 # INC HL +4B11 23 # INC HL +4B12 22 C6 41 ".A LD (41C6),HL +4B15 2A CA 41 *.A LD HL,(41CA) +4B18 37 7 SCF +4B19 CB 1C .. RR H +4B1B CB 1D .. RR L +4B1D CB 85 .. RES 0,L +4B1F 3E FF >. LD A,FF +4B21 CD 49 46 .IF CALL 4649 +4B24 DD 36 06 00 .6.. LD (IX+06),00 +4B28 DD CB 07 9E .... RES 3,(IX+07) +4B2C DD CB 07 46 ...F BIT 0,(IX+07) +4B30 C2 26 29 .&) JP NZ,2926 +4B33 C3 E4 49 ..I JP 49E4 +4B36 54 T LD D,H ; "TR" +4B37 52 R LD D,D +4B38 00 . NOP +4B39 00 . NOP +4B3A 00 . NOP +4B3B 00 . NOP +4B3C 00 . NOP +4B3D 00 . NOP +4B3E 00 . NOP +4B3F 00 . NOP +4B40 00 . NOP +4B41 00 . NOP +4B42 00 . NOP +4B43 00 . NOP +4B44 00 . NOP +4B45 00 . NOP +4B46 00 . NOP +4B47 00 . NOP +4B48 00 . NOP +4B49 00 . NOP +4B4A 00 . NOP +4B4B 00 . NOP +4B4C F5 . PUSH AF +4B4D C5 . PUSH BC +4B4E D5 . PUSH DE +4B4F E5 . PUSH HL +4B50 FD E5 .. PUSH IY +4B52 2A B6 4C *.L LD HL,(4CB6) +4B55 2B + DEC HL +4B56 7C | LD A,H +4B57 B5 . OR L +4B58 20 1D . JR NZ,4B77 +4B5A 21 17 82 !.. LD HL,8217 +4B5D 3A B8 4C :.L LD A,(4CB8) +4B60 FE 02 .. CP 02 +4B62 28 09 (. JR Z,4B6D +4B64 CB CE .. SET 1,(HL) +4B66 3E 02 >. LD A,02 +4B68 21 B8 0B !.. LD HL,0BB8 +4B6B 18 07 .. JR 4B74 +4B6D CB C6 .. SET 0,(HL) +4B6F 3E 01 >. LD A,01 +4B71 21 70 17 !p. LD HL,1770 +4B74 32 B8 4C 2.L LD (4CB8),A +4B77 22 B6 4C ".L LD (4CB6),HL +4B7A 2A F1 4C *.L LD HL,(4CF1) +4B7D 23 # INC HL +4B7E 22 F1 4C ".L LD (4CF1),HL +4B81 21 B9 4C !.L LD HL,4CB9 +4B84 CD 99 4E ..N CALL 4E99 +4B87 3A B5 4C :.L LD A,(4CB5) +4B8A B7 . OR A +4B8B 28 08 (. JR Z,4B95 +4B8D 2A B3 4C *.L LD HL,(4CB3) +4B90 65 e LD H,L +4B91 6F o LD L,A +4B92 22 B3 4C ".L LD (4CB3),HL +4B95 FD E1 .. POP IY +4B97 E1 . POP HL +4B98 D1 . POP DE +4B99 C1 . POP BC +4B9A F1 . POP AF +4B9B C9 . RET +4B9C F3 . DI +4B9D 2A B3 4C *.L LD HL,(4CB3) +4BA0 7D } LD A,L +4BA1 B7 . OR A +4BA2 28 35 (5 JR Z,4BD9 +4BA4 6C l LD L,H +4BA5 26 00 &. LD H,00 +4BA7 22 B3 4C ".L LD (4CB3),HL +4BAA FB . EI +4BAB FE 80 .. CP 80 +4BAD 28 24 ($ JR Z,4BD3 +4BAF CB 7F .. BIT 7,A +4BB1 C4 CA 4B ..K CALL NZ,4BCA +4BB4 21 D1 4C !.L LD HL,4CD1 +4BB7 06 03 .. LD B,03 +4BB9 0F . RRCA +4BBA F5 . PUSH AF +4BBB C5 . PUSH BC +4BBC E5 . PUSH HL +4BBD DC 99 4E ..N CALL C,4E99 +4BC0 E1 . POP HL +4BC1 C1 . POP BC +4BC2 F1 . POP AF +4BC3 11 08 00 ... LD DE,0008 +4BC6 19 . ADD HL,DE +4BC7 10 F0 .. DJNZ 4BB9 +4BC9 C9 . RET +4BCA F5 . PUSH AF +4BCB 21 C9 4C !.L LD HL,4CC9 +4BCE CD 99 4E ..N CALL 4E99 +4BD1 F1 . POP AF +4BD2 C9 . RET +4BD3 21 C1 4C !.L LD HL,4CC1 +4BD6 C3 99 4E ..N JP 4E99 +4BD9 FB . EI +4BDA C9 . RET +4BDB 3A F4 6E :.n LD A,(6EF4) +4BDE DD 96 04 ... SUB (IX+04) +4BE1 ED 44 .D NEG +4BE3 DD 77 04 .w. LD (IX+04),A +4BE6 21 B5 4C !.L LD HL,4CB5 +4BE9 DD 7E 2A .~* LD A,(IX+2A) +4BEC FE 05 .. CP 05 +4BEE 30 03 0. JR NC,4BF3 +4BF0 CB C6 .. SET 0,(HL) +4BF2 C9 . RET +4BF3 CB CE .. SET 1,(HL) +4BF5 C9 . RET +4BF6 3A F4 6E :.n LD A,(6EF4) +4BF9 DD 86 04 ... ADD (IX+04) +4BFC FE 64 .d CP 64 +4BFE 38 1E 8. JR C,4C1E +4C00 D6 64 .d SUB A,64 +4C02 F5 . PUSH AF +4C03 DD 35 .5 DEC (IX+1C) +4C05 1C . INC E +4C06 20 0B . JR NZ,4C13 +4C08 DD 7E 2A .~* LD A,(IX+2A) +4C0B 3C < INC A +4C0C FE 03 .. CP 03 +4C0E 30 03 0. JR NC,4C13 +4C10 DD 77 2A .w* LD (IX+2A),A +4C13 2A 1C 6E *.n LD HL,(6E1C) +4C16 2E 38 .8 LD L,38 +4C18 CD 99 4E ..N CALL 4E99 +4C1B F1 . POP AF +4C1C 18 DE .. JR 4BFC +4C1E DD 77 04 .w. LD (IX+04),A +4C21 21 B5 4C !.L LD HL,4CB5 +4C24 CB 86 .. RES 0,(HL) +4C26 CB 8E .. RES 1,(HL) +4C28 C9 . RET +4C29 DD 7E 2A .~* LD A,(IX+2A) +4C2C FE 03 .. CP 03 +4C2E D0 . RET NC +4C2F DD 36 2A 00 .6*. LD (IX+2A),00 +4C33 DD 36 1C 3C .6.< LD (IX+1C),3C +4C37 C9 . RET +4C38 3A F9 4C :.L LD A,(4CF9) +4C3B B7 . OR A +4C3C C8 . RET Z +4C3D 3E 01 >. LD A,01 +4C3F 32 F9 4C 2.L LD (4CF9),A +4C42 2A FA 4C *.L LD HL,(4CFA) +4C45 06 11 .. LD B,11 +4C47 23 # INC HL +4C48 7E ~ LD A,(HL) +4C49 FE 01 .. CP 01 +4C4B 28 0D (. JR Z,4C5A +4C4D 38 03 8. JR C,4C52 +4C4F 21 FB 4C !.L LD HL,4CFB +4C52 10 F3 .. DJNZ 4C47 +4C54 21 F9 4C !.L LD HL,4CF9 +4C57 CB 86 .. RES 0,(HL) +4C59 C9 . RET +4C5A DD 7E 26 .~& LD A,(IX+26) +4C5D B7 . OR A +4C5E 20 28 ( JR NZ,4C88 +4C60 22 FA 4C ".L LD (4CFA),HL +4C63 11 FC 4C ..L LD DE,4CFC +4C66 B7 . OR A +4C67 ED 52 .R SBC HL,DE +4C69 DD 7E 06 .~. LD A,(IX+06) +4C6C FE BC .. CP BC +4C6E C0 . RET NZ +4C6F DD 7E 34 .~4 LD A,(IX+34) +4C72 B7 . OR A +4C73 C0 . RET NZ +4C74 DD 36 06 00 .6.. LD (IX+06),00 +4C78 DD CB 07 DE .... SET 3,(IX+07) +4C7C DD 75 2C .u, LD (IX+2C),L +4C7F DD 74 2D .t- LD (IX+2D),H +4C82 2A FA 4C *.L LD HL,(4CFA) +4C85 36 00 6. LD (HL),00 +4C87 C9 . RET +4C88 DD CB 05 C6 .... SET 0,(IX+05) +4C8C 97 . SUB A +4C8D 32 F9 4C 2.L LD (4CF9),A +4C90 C9 . RET +4C91 F1 . POP AF +4C92 C9 . RET ;---------- SV-Call zustellen ----- +4C93 F5 . PUSH AF ; Kanalnummer +4C94 3A FC 6E :.n LD A,(6EFC) +4C97 B7 . OR A +4C98 20 F7 . JR NZ,4C91 +4C9A F1 . POP AF +4C9B F5 . PUSH AF +4C9C E5 . PUSH HL +4C9D 21 F9 4C !.L LD HL,4CF9 +4CA0 CB CE .. SET 1,(HL) ; irgendein Kanal hat SV-Call +4CA2 21 FC 4C !.L LD HL,4CFC ; 4CFC+Kanalnummer +4CA5 85 . ADD L +4CA6 6F o LD L,A +4CA7 30 01 0. JR NC,4CAA +4CA9 24 $ INC H +4CAA 3E 01 >. LD A,01 +4CAC 77 w LD (HL),A ; 1: SV-Call angefordert +4CAD CD 68 6D .hm CALL 6D68 ; unblock (supervisor) +4CB0 E1 . POP HL +4CB1 F1 . POP AF +4CB2 C9 . RET ;-------------------------------- +4CB3 00 . NOP +4CB4 00 . NOP +4CB5 00 . NOP +4CB6 70 p LD (HL),B +4CB7 17 . RLA +4CB8 01 +4CB9 00 00 ; clock (1) +4CBB 00 . NOP +4CBC 00 . NOP +4CBD 00 . NOP +4CBE 00 . NOP +4CBF 00 . NOP +4CC0 00 . NOP +4CC1 00 . NOP ; clock (2) +4CC2 00 . NOP +4CC3 00 . NOP +4CC4 00 . NOP +4CC5 00 . NOP +4CC6 00 . NOP +4CC7 00 . NOP +4CC8 00 . NOP +4CC9 00 . NOP ; clock (3) +4CCA 00 . NOP +4CCB 00 . NOP +4CCC 00 . NOP +4CCD 00 . NOP +4CCE 00 . NOP +4CCF 00 . NOP +4CD0 00 . NOP +4CD1 00 . NOP ; clock (4) +4CD2 00 . NOP +4CD3 00 . NOP +4CD4 00 . NOP +4CD5 00 . NOP +4CD6 00 . NOP +4CD7 00 . NOP +4CD8 00 . NOP +4CD9 00 . NOP ; clock (5) +4CDA 00 . NOP +4CDB 00 . NOP + - Fortsetzung in Datei "eumel0.prt.3" - diff --git a/system/eumel0-z80/src/eumel0.prt.3 b/system/eumel0-z80/src/eumel0.prt.3 new file mode 100644 index 0000000..2ae7eab --- /dev/null +++ b/system/eumel0-z80/src/eumel0.prt.3 @@ -0,0 +1,4004 @@ +ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT + +4CDC 00 . NOP +4CDD 00 . NOP +4CDE 00 . NOP +4CDF 00 . NOP +4CE0 00 . NOP +4CE1 00 . NOP ; clock (6) +4CE2 00 . NOP +4CE3 00 . NOP +4CE4 00 . NOP +4CE5 00 . NOP +4CE6 00 . NOP +4CE7 00 . NOP +4CE8 00 . NOP +4CE9 00 . NOP ; clock (7) +4CEA 00 . NOP +4CEB 00 . NOP +4CEC 00 . NOP +4CED 00 . NOP +4CEE 00 . NOP +4CEF 00 . NOP +4CF0 00 . NOP +4CF1 00 . NOP ; --- +4CF2 00 . NOP ; 4CF1/4CF2 = pausenzaehler akt.Task +4CF3 00 . NOP +4CF4 00 . NOP +4CF5 00 . NOP +4CF6 00 . NOP +4CF7 00 . NOP +4CF8 00 . NOP +4CF9 00 . NOP ;-- +4CFA FC 4C +4CFC 00 ; Tabelle der SV-Call anforderungen +4CFD 00 . NOP ; Kanal 1 +4CFE 00 . NOP ; Kanal 2 ... +4CFF 00 . NOP +4D00 00 . NOP +4D01 00 . NOP +4D02 00 . NOP +4D03 00 . NOP +4D04 00 . NOP +4D05 00 . NOP +4D06 00 . NOP +4D07 00 . NOP +4D08 00 . NOP +4D09 00 . NOP +4D0A 00 . NOP +4D0B 00 . NOP ; Kanal 16 +4D0C FF . RST 38 ; Tabellenende +4D0D CD 21 4D .!M CALL 4D21 +4D10 CD 6D 4D .mM CALL 4D6D +4D13 EB . EX DE,HL +4D14 D8 . RET C +4D15 1F . RRA +4D16 D8 . RET C +4D17 7A z LD A,D +4D18 17 . RLA +4D19 D8 . RET C +4D1A 3A 5A 4E :ZN LD A,(4E5A) +4D1D B7 . OR A +4D1E F0 . RET P +4D1F 18 13 .. JR 4D34 +4D21 7A z LD A,D +4D22 AC . XOR H +4D23 32 5A 4E 2ZN LD (4E5A),A +4D26 CB 7C .| BIT 7,H +4D28 28 07 (. JR Z,4D31 +4D2A 97 . SUB A +4D2B 95 . SUB L +4D2C 6F o LD L,A +4D2D 3E 00 >. LD A,00 +4D2F 9C . SBC H +4D30 67 g LD H,A +4D31 CB 7A .z BIT 7,D +4D33 C8 . RET Z +4D34 97 . SUB A +4D35 93 . SUB E +4D36 5F _ LD E,A +4D37 3E 00 >. LD A,00 +4D39 9A . SBC D +4D3A 57 W LD D,A +4D3B B7 . OR A +4D3C C9 . RET +4D3D CB 7A .z BIT 7,D +4D3F 20 0E . JR NZ,4D4F +4D41 CD 21 4D .!M CALL 4D21 +4D44 CD AD 4D ..M CALL 4DAD +4D47 30 D1 0. JR NC,4D1A +4D49 C9 . RET +4D4A CD AD 4D ..M CALL 4DAD +4D4D B7 . OR A +4D4E C9 . RET +4D4F DD CB 0B 66 ...f BIT 4,(IX+0B) +4D53 20 F5 . JR NZ,4D4A +4D55 CD 21 4D .!M CALL 4D21 +4D58 E5 . PUSH HL +4D59 CD AD 4D ..M CALL 4DAD +4D5C 38 0B 8. JR C,4D69 +4D5E 7C | LD A,H +4D5F B5 . OR L +4D60 28 07 (. JR Z,4D69 +4D62 EB . EX DE,HL +4D63 E3 . EX (SP),HL +4D64 ED 52 .R SBC HL,DE +4D66 D1 . POP DE +4D67 18 B1 .. JR 4D1A +4D69 33 3 INC SP +4D6A 33 3 INC SP +4D6B 18 AD .. JR 4D1A +4D6D 7A z LD A,D ; -------- 16 * 16 --> 24 Bit MULT --- +4D6E BC . CP H +4D6F 30 01 0. JR NC,4D72 +4D71 EB . EX DE,HL +4D72 C5 . PUSH BC +4D73 44 D LD B,H +4D74 4D M LD C,L +4D75 97 . SUB A +4D76 67 g LD H,A +4D77 6F o LD L,A +4D78 CB 38 .8 SLR B +4D7A CB 19 .. RR C +4D7C 30 01 0. JR NC,4D7F +4D7E 19 . ADD HL,DE +4D7F 18 1B .. JR 4D9C +4D81 CB 23 .# SLA E +4D83 CB 12 .. RL D +4D85 CE 00 .. ADC A,00 +4D87 19 . ADD HL,DE +4D88 CE 00 .. ADC A,00 +4D8A CB 38 .8 SLR B +4D8C CB 19 .. RR C +4D8E 38 F1 8. JR C,4D81 +4D90 20 04 . JR NZ,4D96 +4D92 04 . INC B +4D93 05 . DEC B +4D94 28 12 (. JR Z,4DA8 +4D96 CB 23 .# SLA E +4D98 CB 12 .. RL D +4D9A 38 0F 8. JR C,4DAB +4D9C CB 38 .8 SLR B +4D9E CB 19 .. RR C +4DA0 38 DF 8. JR C,4D81 +4DA2 20 F2 . JR NZ,4D96 +4DA4 04 . INC B +4DA5 05 . DEC B +4DA6 20 EE . JR NZ,4D96 +4DA8 FE 02 .. CP 02 +4DAA 3F ? CCF +4DAB C1 . POP BC +4DAC C9 . RET +4DAD 7C | LD A,H +4DAE B5 . OR L +4DAF 20 02 . JR NZ,4DB3 +4DB1 37 7 SCF +4DB2 C9 . RET +4DB3 7C | LD A,H +4DB4 B2 . OR D +4DB5 28 2B (+ JR Z,4DE2 +4DB7 C5 . PUSH BC +4DB8 97 . SUB A +4DB9 3C < INC A +4DBA ED 6A .j ADC HL,HL +4DBC F2 B9 4D ..M JP P,4DB9 + +4DC0 4D M LD C,L +4DC1 EB . EX DE,HL +4DC2 11 00 00 ... LD DE,0000 +4DC5 CB 23 .# SLA E +4DC7 CB 12 .. RL D +4DC9 22 5B 4E "[N LD (4E5B),HL +4DCC B7 . OR A +4DCD ED 42 .B SBC HL,BC +4DCF 30 03 0. JR NC,4DD4 +4DD1 2A 5B 4E *[N LD HL,(4E5B) +4DD4 38 01 8. JR C,4DD7 +4DD6 13 . INC DE +4DD7 CB 38 .8 SLR B +4DD9 CB 19 .. RR C +4DDB 3D = DEC A +4DDC F2 C5 4D ..M JP P,4DC5 +4DDF C1 . POP BC +4DE0 B7 . OR A +4DE1 C9 . RET +4DE2 CB 7D .} BIT 7,L +4DE4 20 06 . JR NZ,4DEC +4DE6 24 $ INC H +4DE7 CB 25 .% SLA L +4DE9 F2 E6 4D ..M JP P,4DE6 +4DEC 7B { LD A,E +4DED 1E 00 .. LD E,00 +4DEF CB 23 .# SLA E +4DF1 BD . CP L +4DF2 38 02 8. JR C,4DF6 +4DF4 95 . SUB L +4DF5 1C . INC E +4DF6 CB 3D .= SLR L +4DF8 25 % DEC H +4DF9 F2 EF 4D ..M JP P,4DEF +4DFC 6F o LD L,A +4DFD 97 . SUB A +4DFE 67 g LD H,A +4DFF C9 . RET +4E00 E5 . PUSH HL +4E01 EB . EX DE,HL +4E02 06 10 .. LD B,10 +4E04 11 00 00 ... LD DE,0000 +4E07 4A J LD C,D +4E08 29 ) ADD HL,HL +4E09 38 11 8. JR C,4E1C +4E0B 10 FB .. DJNZ 4E08 +4E0D 18 1C .. JR 4E2B +4E0F 7A z LD A,D +4E10 87 . ADD A +4E11 27 ' DAA +4E12 57 W LD D,A +4E13 7B { LD A,E +4E14 8F . ADC A +4E15 27 ' DAA +4E16 5F _ LD E,A +4E17 CB 11 .. RL C +4E19 29 ) ADD HL,HL +4E1A 30 0D 0. JR NC,4E29 +4E1C 7A z LD A,D +4E1D C6 01 .. ADD A,01 +4E1F 27 ' DAA +4E20 57 W LD D,A +4E21 7B { LD A,E +4E22 CE 00 .. ADC A,00 +4E24 27 ' DAA +4E25 5F _ LD E,A +4E26 30 01 0. JR NC,4E29 +4E28 0C . INC C +4E29 10 E4 .. DJNZ 4E0F +4E2B 21 5D 4E !]N LD HL,4E5D +4E2E 71 q LD (HL),C +4E2F ED 53 5E 4E .S^N LD (4E5E),DE +4E33 D1 . POP DE +4E34 06 06 .. LD B,06 +4E36 D5 . PUSH DE +4E37 0E 00 .. LD C,00 +4E39 3E 30 >0 LD A,30 +4E3B CD 53 4E .SN CALL 4E53 +4E3E FE 30 .0 CP 30 +4E40 20 08 . JR NZ,4E4A +4E42 10 F7 .. DJNZ 4E3B +4E44 04 . INC B +4E45 18 03 .. JR 4E4A +4E47 CD 53 4E .SN CALL 4E53 +4E4A 12 . LD (DE),A +4E4B 13 . INC DE +4E4C 0C . INC C +4E4D 10 F8 .. DJNZ 4E47 +4E4F 06 00 .. LD B,00 +4E51 D1 . POP DE +4E52 C9 . RET +4E53 ED 6F .o RLD +4E55 CB 40 .@ BIT 0,B +4E57 C8 . RET Z +4E58 23 # INC HL +4E59 C9 . RET +4E5A 00 . NOP +4E5B 00 . NOP +4E5C 00 . NOP +4E5D 20 20 JR NZ,4E7F +4E5F 20 08 . JR NZ,4E69 +4E61 F5 . PUSH AF +4E62 C5 . PUSH BC +4E63 CD 72 4E .rN CALL 4E72 +4E66 DD 2A 1C 6E .*.n LD IX,(6E1C) +4E6A 11 91 4E ..N LD DE,4E91 +4E6D C1 . POP BC +4E6E 08 . EX AF,AF' +4E6F F1 . POP AF +4E70 08 . EX AF,AF' +4E71 C9 . RET +4E72 E5 . PUSH HL +4E73 EB . EX DE,HL +4E74 11 91 4E ..N LD DE,4E91 +4E77 01 08 00 ... LD BC,0008 +4E7A ED B0 .. LDIR +4E7C DD 21 91 4E .!.N LD IX,4E91 +4E80 FD E3 .. EX (SP),IY +4E82 C9 . RET +4E83 C5 . PUSH BC +4E84 D5 . PUSH DE +4E85 DD E3 .. EX (SP),IX +4E87 E5 . PUSH HL +4E88 FD E1 .. POP IY +4E8A CD B3 51 ..Q CALL 51B3 +4E8D DD E1 .. POP IX +4E8F C1 . POP BC +4E90 C9 . RET +4E91 00 . NOP +4E92 00 . NOP +4E93 00 . NOP +4E94 00 . NOP +4E95 00 . NOP +4E96 00 . NOP +4E97 00 . NOP +4E98 00 . NOP +4E99 0E 01 .. LD C,01 +4E9B E5 . PUSH HL +4E9C FD E1 .. POP IY +4E9E FD 7E 07 .~. LD A,(IY+07) +4EA1 FE 8D .. CP 8D +4EA3 D0 . RET NC +4EA4 B7 . OR A +4EA5 FA AD 4E ..N JP M,4EAD +4EA8 3E 80 >. LD A,80 +4EAA FD 77 07 .w. LD (IY+07),A +4EAD D6 7F .. SUB A,7F +4EAF CB 3F .? SLR A +4EB1 47 G LD B,A +4EB2 5F _ LD E,A +4EB3 16 00 .. LD D,00 +4EB5 79 y LD A,C +4EB6 38 04 8. JR C,4EBC +4EB8 87 . ADD A +4EB9 87 . ADD A +4EBA 81 . ADD C +4EBB 87 . ADD A +4EBC 19 . ADD HL,DE +4EBD 04 . INC B +4EBE B7 . OR A +4EBF 8E . ADC (HL) +4EC0 27 ' DAA +4EC1 77 w LD (HL),A +4EC2 2B + DEC HL +4EC3 3E 00 >. LD A,00 +4EC5 10 F8 .. DJNZ 4EBF +4EC7 23 # INC HL +4EC8 7E ~ LD A,(HL) +4EC9 FE 10 .. CP 10 +4ECB D8 . RET C +4ECC 97 . SUB A +4ECD CD 3A 52 .:R CALL 523A +4ED0 34 4 INC (HL) +4ED1 C9 . RET +4ED2 C5 . PUSH BC +4ED3 D5 . PUSH DE +4ED4 CD 73 52 .sR CALL 5273 +4ED7 D1 . POP DE +4ED8 C1 . POP BC +4ED9 1A . LD A,(DE) +4EDA B7 . OR A +4EDB C8 . RET Z +4EDC EE 80 .. XOR 80 +4EDE 12 . LD (DE),A +4EDF C9 . RET +4EE0 7B { LD A,E +4EE1 11 07 00 ... LD DE,0007 +4EE4 19 . ADD HL,DE +4EE5 C6 81 .. ADD A,81 +4EE7 77 w LD (HL),A +4EE8 C9 . RET +4EE9 11 07 00 ... LD DE,0007 +4EEC 19 . ADD HL,DE +4EED 7E ~ LD A,(HL) +4EEE D6 81 .. SUB A,81 +4EF0 5F _ LD E,A +4EF1 16 00 .. LD D,00 +4EF3 D0 . RET NC +4EF4 15 . DEC D +4EF5 C9 . RET +4EF6 C5 . PUSH BC +4EF7 D5 . PUSH DE +4EF8 CD 73 52 .sR CALL 5273 +4EFB EB . EX DE,HL +4EFC D1 . POP DE +4EFD C1 . POP BC +4EFE 2B + DEC HL +4EFF 3E 8D >. LD A,8D +4F01 96 . SUB (HL) +4F02 D8 . RET C +4F03 FE 0D .. CP 0D +4F05 30 0F 0. JR NC,4F16 +4F07 2B + DEC HL +4F08 3D = DEC A +4F09 F8 . RET M +4F0A 28 05 (. JR Z,4F11 +4F0C 36 00 6. LD (HL),00 +4F0E 3D = DEC A +4F0F 18 F6 .. JR 4F07 +4F11 7E ~ LD A,(HL) +4F12 E6 F0 .. AND F0 +4F14 77 w LD (HL),A +4F15 C9 . RET +4F16 EB . EX DE,HL +4F17 3E 08 >. LD A,08 +4F19 36 00 6. LD (HL),00 +4F1B 23 # INC HL +4F1C 3D = DEC A +4F1D 20 FA . JR NZ,4F19 +4F1F C9 . RET +4F20 FD 7E 00 .~. LD A,(IY+00) +4F23 EE 80 .. XOR 80 +4F25 5F _ LD E,A +4F26 DD 56 00 .V. LD D,(IX+00) +4F29 C3 32 4F .2O JP 4F32 +4F2C DD 56 00 .V. LD D,(IX+00) +4F2F FD 5E 00 .^. LD E,(IY+00) +4F32 AF . XOR A +4F33 DD BE 07 ... CP (IX+07) +4F36 C2 49 4F .IO JP NZ,4F49 +4F39 FD BE 07 ... CP (IY+07) +4F3C C8 . RET Z +4F3D 7B { LD A,E +4F3E FD E5 .. PUSH IY +4F40 E1 . POP HL +4F41 CD 79 52 .yR CALL 5279 +4F44 DD 77 00 .w. LD (IX+00),A +4F47 B7 . OR A +4F48 C9 . RET +4F49 DD 72 00 .r. LD (IX+00),D +4F4C FD BE 07 ... CP (IY+07) +4F4F C8 . RET Z +4F50 D5 . PUSH DE +4F51 CB BA .. RES 7,D +4F53 CB BB .. RES 7,E +4F55 CD B9 51 ..Q CALL 51B9 +4F58 38 0D 8. JR C,4F67 +4F5A CD 7E 52 .~R CALL 527E +4F5D CD 96 52 ..R CALL 5296 +4F60 C1 . POP BC +4F61 78 x LD A,B +4F62 A9 . XOR C +4F63 78 x LD A,B +4F64 C3 71 4F .qO JP 4F71 +4F67 CD 86 52 ..R CALL 5286 +4F6A CD 82 52 ..R CALL 5282 +4F6D C1 . POP BC +4F6E 79 y LD A,C +4F6F A8 . XOR B +4F70 79 y LD A,C +4F71 08 . EX AF,AF' +4F72 3A BD 52 :.R LD A,(52BD) +4F75 21 C5 52 !.R LD HL,52C5 +4F78 96 . SUB (HL) +4F79 28 0F (. JR Z,4F8A +4F7B FE 0D .. CP 0D +4F7D D2 D8 4F ..O JP NC,4FD8 +4F80 47 G LD B,A +4F81 AF . XOR A +4F82 21 BE 52 !.R LD HL,52BE +4F85 CD 3A 52 .:R CALL 523A +4F88 10 F7 .. DJNZ 4F81 +4F8A 06 07 .. LD B,07 +4F8C 21 C4 52 !.R LD HL,52C4 +4F8F 11 BC 52 ..R LD DE,52BC +4F92 A7 . AND A +4F93 08 . EX AF,AF' +4F94 FA B8 4F ..O JP M,4FB8 +4F97 08 . EX AF,AF' +4F98 1A . LD A,(DE) +4F99 8E . ADC (HL) +4F9A 27 ' DAA +4F9B 12 . LD (DE),A +4F9C 1B . DEC DE +4F9D 2B + DEC HL +4F9E 10 F8 .. DJNZ 4F98 +4FA0 3A B6 52 :.R LD A,(52B6) +4FA3 E6 F0 .. AND F0 +4FA5 CA D8 4F ..O JP Z,4FD8 +4FA8 21 BD 52 !.R LD HL,52BD +4FAB 34 4 INC (HL) +4FAC CA B2 52 ..R JP Z,52B2 +4FAF 21 B6 52 !.R LD HL,52B6 +4FB2 CD 3A 52 .:R CALL 523A +4FB5 C3 D8 4F ..O JP 4FD8 +4FB8 08 . EX AF,AF' +4FB9 1A . LD A,(DE) +4FBA 9E . SBC (HL) +4FBB 27 ' DAA +4FBC 12 . LD (DE),A +4FBD 1B . DEC DE +4FBE 2B + DEC HL +4FBF 10 F8 .. DJNZ 4FB9 +4FC1 3A BD 52 :.R LD A,(52BD) +4FC4 4F O LD C,A +4FC5 21 B6 52 !.R LD HL,52B6 +4FC8 CD F6 51 ..Q CALL 51F6 +4FCB CA A6 52 ..R JP Z,52A6 +4FCE DA A6 52 ..R JP C,52A6 +4FD1 79 y LD A,C +4FD2 32 BD 52 2.R LD (52BD),A +4FD5 C3 D8 4F ..O JP 4FD8 +4FD8 21 B6 52 !.R LD HL,52B6 +4FDB CD 79 52 .yR CALL 5279 +4FDE C3 0B 51 ..Q JP 510B +4FE1 AF . XOR A +4FE2 DD BE 07 ... CP (IX+07) +4FE5 CA A6 52 ..R JP Z,52A6 +4FE8 FD BE 07 ... CP (IY+07) +4FEB CA A6 52 ..R JP Z,52A6 +4FEE DD 7E 00 .~. LD A,(IX+00) +4FF1 FD AE 00 ... XOR (IY+00) +4FF4 08 . EX AF,AF' +4FF5 DD E5 .. PUSH IX +4FF7 D1 . POP DE +4FF8 21 06 00 !.. LD HL,0006 +4FFB 19 . ADD HL,DE +4FFC 22 B4 52 ".R LD (52B4),HL +4FFF EB . EX DE,HL +5000 CD 93 51 ..Q CALL 5193 +5003 CD 86 52 ..R CALL 5286 +5006 FD 21 B6 52 .!.R LD IY,52B6 +500A CD A6 52 ..R CALL 52A6 +500D 06 07 .. LD B,07 +500F C3 1D 50 ..P JP 501D +5012 AF . XOR A +5013 CD 37 52 .7R CALL 5237 +5016 CD BD 50 ..P CALL 50BD +5019 AF . XOR A +501A CD 37 52 .7R CALL 5237 +501D FD 4E 06 .N. LD C,(IY+06) +5020 FD 2B .+ DEC IY +5022 CD BD 50 ..P CALL 50BD +5025 10 EB .. DJNZ 5012 +5027 05 . DEC B +5028 DD 7E 00 .~. LD A,(IX+00) +502B E6 F0 .. AND F0 +502D 28 05 (. JR Z,5034 +502F 04 . INC B +5030 AF . XOR A +5031 CD 37 52 .7R CALL 5237 +5034 3A CD 52 :.R LD A,(52CD) +5037 D6 80 .. SUB A,80 +5039 4F O LD C,A +503A FD 7E 0E .~. LD A,(IY+0E) +503D D6 80 .. SUB A,80 +503F 81 . ADD C +5040 E2 4A 50 .JP JP PO,504A +5043 80 . ADD B +5044 E2 AD 51 ..Q JP PO,51AD +5047 C3 4E 50 .NP JP 504E +504A 80 . ADD B +504B EA AD 51 ..Q JP PE,51AD +504E C6 80 .. ADD A,80 +5050 CA A6 52 ..R JP Z,52A6 +5053 DD 77 07 .w. LD (IX+07),A +5056 C3 0B 51 ..Q JP 510B +5059 AF . XOR A +505A FD BE 07 ... CP (IY+07) +505D CA B2 52 ..R JP Z,52B2 +5060 DD BE 07 ... CP (IX+07) +5063 CA A6 52 ..R JP Z,52A6 +5066 DD 7E 00 .~. LD A,(IX+00) +5069 FD AE 00 ... XOR (IY+00) +506C 08 . EX AF,AF' +506D FD E5 .. PUSH IY +506F E1 . POP HL +5070 CD 93 51 ..Q CALL 5193 +5073 DD E5 .. PUSH IX +5075 CD 7E 52 .~R CALL 527E +5078 01 01 07 ... LD BC,0701 +507B C5 . PUSH BC +507C 0E 0F .. LD C,0F +507E 21 C6 52 !.R LD HL,52C6 +5081 CD 5A 51 .ZQ CALL 515A +5084 30 18 0. JR NC,509E +5086 C1 . POP BC +5087 0D . DEC C +5088 C5 . PUSH BC +5089 C3 97 50 ..P JP 5097 +508C C5 . PUSH BC +508D 21 B6 52 !.R LD HL,52B6 +5090 AF . XOR A +5091 CD 1B 52 ..R CALL 521B +5094 CD 19 51 ..Q CALL 5119 +5097 21 B6 52 !.R LD HL,52B6 +509A AF . XOR A +509B CD 1B 52 ..R CALL 521B +509E CD 19 51 ..Q CALL 5119 +50A1 79 y LD A,C +50A2 2F / CPL +50A3 DD 77 00 .w. LD (IX+00),A +50A6 DD 23 .# INC IX +50A8 C1 . POP BC +50A9 10 E1 .. DJNZ 508C +50AB 41 A LD B,C +50AC 3A CD 52 :.R LD A,(52CD) +50AF D6 80 .. SUB A,80 +50B1 4F O LD C,A +50B2 3A BD 52 :.R LD A,(52BD) +50B5 D6 80 .. SUB A,80 +50B7 91 . SUB C +50B8 DD E1 .. POP IX +50BA C3 40 50 .@P JP 5040 +50BD 21 CC 52 !.R LD HL,52CC +50C0 CB 19 .. RR C +50C2 DC DE 50 ..P CALL C,50DE +50C5 21 D4 52 !.R LD HL,52D4 +50C8 CB 19 .. RR C +50CA DC DE 50 ..P CALL C,50DE +50CD 21 DC 52 !.R LD HL,52DC +50D0 CB 19 .. RR C +50D2 DC DE 50 ..P CALL C,50DE +50D5 21 E4 52 !.R LD HL,52E4 +50D8 CB 19 .. RR C +50DA DC DE 50 ..P CALL C,50DE +50DD C9 . RET +50DE ED 5B B4 52 .[.R LD DE,(52B4) +50E2 1A . LD A,(DE) +50E3 86 . ADD (HL) +50E4 27 ' DAA +50E5 12 . LD (DE),A +50E6 1B . DEC DE +50E7 2B + DEC HL +50E8 1A . LD A,(DE) +50E9 8E . ADC (HL) +50EA 27 ' DAA +50EB 12 . LD (DE),A +50EC 1B . DEC DE +50ED 2B + DEC HL +50EE 1A . LD A,(DE) +50EF 8E . ADC (HL) +50F0 27 ' DAA +50F1 12 . LD (DE),A +50F2 1B . DEC DE +50F3 2B + DEC HL +50F4 1A . LD A,(DE) +50F5 8E . ADC (HL) +50F6 27 ' DAA +50F7 12 . LD (DE),A +50F8 1B . DEC DE +50F9 2B + DEC HL +50FA 1A . LD A,(DE) +50FB 8E . ADC (HL) +50FC 27 ' DAA +50FD 12 . LD (DE),A +50FE 1B . DEC DE +50FF 2B + DEC HL +5100 1A . LD A,(DE) +5101 8E . ADC (HL) +5102 27 ' DAA +5103 12 . LD (DE),A +5104 1B . DEC DE +5105 2B + DEC HL +5106 1A . LD A,(DE) +5107 8E . ADC (HL) +5108 27 ' DAA +5109 12 . LD (DE),A +510A C9 . RET +510B DD 7E 00 .~. LD A,(IX+00) +510E E6 0F .. AND 0F +5110 47 G LD B,A +5111 08 . EX AF,AF' +5112 E6 80 .. AND 80 +5114 B0 . OR B +5115 DD 77 00 .w. LD (IX+00),A +5118 C9 . RET +5119 21 DE 52 !.R LD HL,52DE +511C CD 5A 51 .ZQ CALL 515A +511F 38 06 8. JR C,5127 +5121 21 E4 52 !.R LD HL,52E4 +5124 CD 67 51 .gQ CALL 5167 +5127 CB 11 .. RL C +5129 21 D6 52 !.R LD HL,52D6 +512C CD 5A 51 .ZQ CALL 515A +512F 38 06 8. JR C,5137 +5131 21 DC 52 !.R LD HL,52DC +5134 CD 67 51 .gQ CALL 5167 +5137 CB 11 .. RL C +5139 21 CE 52 !.R LD HL,52CE +513C CD 5A 51 .ZQ CALL 515A +513F 38 06 8. JR C,5147 +5141 21 D4 52 !.R LD HL,52D4 +5144 CD 67 51 .gQ CALL 5167 +5147 CB 11 .. RL C +5149 21 C6 52 !.R LD HL,52C6 +514C CD 5A 51 .ZQ CALL 515A +514F 38 06 8. JR C,5157 +5151 21 CC 52 !.R LD HL,52CC +5154 CD 67 51 .gQ CALL 5167 +5157 CB 11 .. RL C +5159 C9 . RET +515A 11 B6 52 ..R LD DE,52B6 +515D 06 07 .. LD B,07 +515F 1A . LD A,(DE) +5160 BE . CP (HL) +5161 C0 . RET NZ +5162 23 # INC HL +5163 13 . INC DE +5164 10 F9 .. DJNZ 515F +5166 C9 . RET +5167 11 BC 52 ..R LD DE,52BC +516A 1A . LD A,(DE) +516B 96 . SUB (HL) +516C 27 ' DAA +516D 12 . LD (DE),A +516E 1B . DEC DE +516F 2B + DEC HL +5170 1A . LD A,(DE) +5171 9E . SBC (HL) +5172 27 ' DAA +5173 12 . LD (DE),A +5174 1B . DEC DE +5175 2B + DEC HL +5176 1A . LD A,(DE) +5177 9E . SBC (HL) +5178 27 ' DAA +5179 12 . LD (DE),A +517A 1B . DEC DE +517B 2B + DEC HL +517C 1A . LD A,(DE) +517D 9E . SBC (HL) +517E 27 ' DAA +517F 12 . LD (DE),A +5180 1B . DEC DE +5181 2B + DEC HL +5182 1A . LD A,(DE) +5183 9E . SBC (HL) +5184 27 ' DAA +5185 12 . LD (DE),A +5186 1B . DEC DE +5187 2B + DEC HL +5188 1A . LD A,(DE) +5189 9E . SBC (HL) +518A 27 ' DAA +518B 12 . LD (DE),A +518C 1B . DEC DE +518D 2B + DEC HL +518E 1A . LD A,(DE) +518F 9E . SBC (HL) +5190 27 ' DAA +5191 12 . LD (DE),A +5192 C9 . RET +5193 11 C6 52 ..R LD DE,52C6 +5196 CD 73 52 .sR CALL 5273 +5199 21 C6 52 !.R LD HL,52C6 +519C CB BE .. RES 7,(HL) +519E 06 03 .. LD B,03 +51A0 78 x LD A,B +51A1 CD 73 52 .sR CALL 5273 +51A4 47 G LD B,A +51A5 A7 . AND A +51A6 CD 53 52 .SR CALL 5253 +51A9 23 # INC HL +51AA 10 F4 .. DJNZ 51A0 +51AC C9 . RET +51AD F2 A6 52 ..R JP P,52A6 +51B0 C3 B2 52 ..R JP 52B2 +51B3 DD 56 00 .V. LD D,(IX+00) +51B6 FD 5E 00 .^. LD E,(IY+00) +51B9 7A z LD A,D +51BA E6 80 .. AND 80 +51BC 20 13 . JR NZ,51D1 +51BE CB 7B .{ BIT 7,E +51C0 C0 . RET NZ +51C1 DD 7E 07 .~. LD A,(IX+07) +51C4 FD BE 07 ... CP (IY+07) +51C7 C0 . RET NZ +51C8 7A z LD A,D +51C9 BB . CP E +51CA C0 . RET NZ +51CB DD E5 .. PUSH IX +51CD FD E5 .. PUSH IY +51CF 18 11 .. JR 51E2 +51D1 AB . XOR E +51D2 17 . RLA +51D3 D8 . RET C +51D4 FD 7E 07 .~. LD A,(IY+07) +51D7 DD BE 07 ... CP (IX+07) +51DA C0 . RET NZ +51DB 7B { LD A,E +51DC BA . CP D +51DD C0 . RET NZ +51DE FD E5 .. PUSH IY +51E0 DD E5 .. PUSH IX +51E2 E1 . POP HL +51E3 D1 . POP DE +51E4 23 # INC HL +51E5 13 . INC DE +51E6 06 06 .. LD B,06 +51E8 1A . LD A,(DE) +51E9 BE . CP (HL) +51EA C0 . RET NZ +51EB 23 # INC HL +51EC 13 . INC DE +51ED 10 F9 .. DJNZ 51E8 +51EF C9 . RET +51F0 DD 4E 07 .N. LD C,(IX+07) +51F3 DD E5 .. PUSH IX +51F5 E1 . POP HL +51F6 7E ~ LD A,(HL) +51F7 A7 . AND A +51F8 20 10 . JR NZ,520A +51FA 06 0C .. LD B,0C +51FC AF . XOR A +51FD 0D . DEC C +51FE 28 0E (. JR Z,520E +5200 CD 1B 52 ..R CALL 521B +5203 23 # INC HL +5204 7E ~ LD A,(HL) +5205 A7 . AND A +5206 20 02 . JR NZ,520A +5208 10 F3 .. DJNZ 51FD +520A DD 71 07 .q. LD (IX+07),C +520D C9 . RET +520E 04 . INC B +520F CB 38 .8 SLR B +5211 23 # INC HL +5212 B6 . OR (HL) +5213 10 FC .. DJNZ 5211 +5215 C8 . RET Z +5216 37 7 SCF +5217 C9 . RET +5218 DD E5 .. PUSH IX +521A E1 . POP HL +521B C5 . PUSH BC +521C 01 06 00 ... LD BC,0006 +521F 09 . ADD HL,BC +5220 ED 6F .o RLD +5222 2B + DEC HL +5223 ED 6F .o RLD +5225 2B + DEC HL +5226 ED 6F .o RLD +5228 2B + DEC HL +5229 ED 6F .o RLD +522B 2B + DEC HL +522C ED 6F .o RLD +522E 2B + DEC HL +522F ED 6F .o RLD +5231 2B + DEC HL +5232 ED 6F .o RLD +5234 2B + DEC HL +5235 C1 . POP BC +5236 C9 . RET +5237 DD E5 .. PUSH IX +5239 E1 . POP HL +523A ED 67 .g RRD +523C 23 # INC HL +523D ED 67 .g RRD +523F 23 # INC HL +5240 ED 67 .g RRD +5242 23 # INC HL +5243 ED 67 .g RRD +5245 23 # INC HL +5246 ED 67 .g RRD +5248 23 # INC HL +5249 ED 67 .g RRD +524B 23 # INC HL +524C ED 67 .g RRD +524E 23 # INC HL +524F C9 . RET +5250 DD E5 .. PUSH IX +5252 E1 . POP HL +5253 C5 . PUSH BC +5254 01 06 00 ... LD BC,0006 +5257 09 . ADD HL,BC +5258 06 07 .. LD B,07 +525A 7E ~ LD A,(HL) +525B 8F . ADC A +525C 27 ' DAA +525D 77 w LD (HL),A +525E 2B + DEC HL +525F 10 F9 .. DJNZ 525A +5261 C1 . POP BC +5262 C9 . RET +5263 11 E6 52 ..R LD DE,52E6 +5266 18 08 .. JR 5270 +5268 11 EE 52 ..R LD DE,52EE +526B 18 03 .. JR 5270 +526D 11 F6 52 ..R LD DE,52F6 +5270 DD E5 .. PUSH IX +5272 E1 . POP HL +5273 01 08 00 ... LD BC,0008 +5276 ED B0 .. LDIR +5278 C9 . RET +5279 DD E5 .. PUSH IX +527B D1 . POP DE +527C 18 F5 .. JR 5273 +527E DD E5 .. PUSH IX +5280 18 06 .. JR 5288 +5282 DD E5 .. PUSH IX +5284 18 12 .. JR 5298 +5286 FD E5 .. PUSH IY +5288 E1 . POP HL +5289 11 B6 52 ..R LD DE,52B6 +528C CD 73 52 .sR CALL 5273 +528F 21 B6 52 !.R LD HL,52B6 +5292 56 V LD D,(HL) +5293 CB BE .. RES 7,(HL) +5295 C9 . RET +5296 FD E5 .. PUSH IY +5298 E1 . POP HL +5299 11 BE 52 ..R LD DE,52BE +529C CD 73 52 .sR CALL 5273 +529F 21 BE 52 !.R LD HL,52BE +52A2 5E ^ LD E,(HL) +52A3 CB BE .. RES 7,(HL) +52A5 C9 . RET +52A6 06 08 .. LD B,08 +52A8 DD E5 .. PUSH IX +52AA E1 . POP HL +52AB 36 00 6. LD (HL),00 +52AD 23 # INC HL +52AE 10 FB .. DJNZ 52AB +52B0 B7 . OR A +52B1 C9 . RET +52B2 37 7 SCF +52B3 C9 . RET +52B4 FF . RST 38 +52B5 FF . RST 38 +52B6 FF . RST 38 +52B7 FF . RST 38 +52B8 FF . RST 38 +52B9 FF . RST 38 +52BA FF . RST 38 +52BB FF . RST 38 +52BC FF . RST 38 +52BD FF . RST 38 +52BE FF . RST 38 +52BF FF . RST 38 +52C0 FF . RST 38 +52C1 FF . RST 38 +52C2 FF . RST 38 +52C3 FF . RST 38 +52C4 FF . RST 38 +52C5 FF . RST 38 +52C6 FF . RST 38 +52C7 FF . RST 38 +52C8 FF . RST 38 +52C9 FF . RST 38 +52CA FF . RST 38 +52CB FF . RST 38 +52CC FF . RST 38 +52CD FF . RST 38 +52CE FF . RST 38 +52CF FF . RST 38 +52D0 FF . RST 38 +52D1 FF . RST 38 +52D2 FF . RST 38 +52D3 FF . RST 38 +52D4 FF . RST 38 +52D5 FF . RST 38 +52D6 FF . RST 38 +52D7 FF . RST 38 +52D8 FF . RST 38 +52D9 FF . RST 38 +52DA FF . RST 38 +52DB FF . RST 38 +52DC FF . RST 38 +52DD FF . RST 38 +52DE FF . RST 38 +52DF FF . RST 38 +52E0 FF . RST 38 +52E1 FF . RST 38 +52E2 FF . RST 38 +52E3 FF . RST 38 +52E4 FF . RST 38 +52E5 FF . RST 38 +52E6 FF . RST 38 +52E7 FF . RST 38 +52E8 FF . RST 38 +52E9 FF . RST 38 +52EA FF . RST 38 +52EB FF . RST 38 +52EC FF . RST 38 +52ED FF . RST 38 +52EE FF . RST 38 +52EF FF . RST 38 +52F0 FF . RST 38 +52F1 FF . RST 38 +52F2 FF . RST 38 +52F3 FF . RST 38 +52F4 FF . RST 38 +52F5 FF . RST 38 +52F6 FF . RST 38 +52F7 FF . RST 38 +52F8 FF . RST 38 +52F9 FF . RST 38 +52FA FF . RST 38 +52FB FF . RST 38 +52FC FF . RST 38 +52FD FF . RST 38 +52FE 97 . SUB A +52FF CD 93 4C ..L CALL 4C93 +5302 C3 26 29 .&) JP 2926 +5305 C9 . RET +5306 31 37 35 175 LD SP,3537 ; "175 bitmap 2 (!)" +5309 20 62 b JR NZ,536D +530B 69 i LD L,C +530C 74 t LD (HL),H +530D 6D m LD L,L +530E 61 a LD H,C +530F 70 p LD (HL),B +5310 20 20 JR NZ,5332 +5312 20 32 2 JR NZ,5346 +5314 20 28 ( JR NZ,533E +5316 21 29 CD !). LD HL,CD29 +5319 9D . SBC L +531A 53 S LD D,E +531B ED 5B 46 53 .[FS LD DE,(5346) +531F 7B { LD A,E +5320 FE 14 .. CP 14 +5322 D0 . RET NC +5323 CD 41 5D .A] CALL 5D41 +5326 CB FD .. SET 7,L +5328 CB 8E .. RES 1,(HL) +532A CB BD .. RES 7,L +532C D5 . PUSH DE +532D 65 e LD H,L +532E CB 24 .$ SLA H +5330 2E 00 .. LD L,00 +5332 54 T LD D,H +5333 5D ] LD E,L +5334 13 . INC DE +5335 01 FF 01 ... LD BC,01FF +5338 36 FF 6. LD (HL),FF +533A ED B0 .. LDIR +533C D1 . POP DE +533D 1C . INC E +533E 1C . INC E +533F ED 53 46 53 .SFS LD (5346),DE +5343 C3 1F 53 ..S JP 531F +5346 04 . INC B +5347 00 . NOP +5348 C5 . PUSH BC +5349 E5 . PUSH HL +534A 42 B LD B,D +534B 4B K LD C,E +534C CB 38 .8 SLR B +534E CB 19 .. RR C +5350 CB 38 .8 SLR B +5352 CB 19 .. RR C +5354 CB 38 .8 SLR B +5356 CB 19 .. RR C +5358 CB 38 .8 SLR B +535A CB 19 .. RR C +535C FD 21 00 00 .!.. LD IY,0000 +5360 2A FD 56 *.V LD HL,(56FD) +5363 D5 . PUSH DE +5364 11 08 00 ... LD DE,0008 +5367 7E ~ LD A,(HL) +5368 B7 . OR A +5369 28 13 (. JR Z,537E +536B FE FF .. CP FF +536D 28 0D (. JR Z,537C +536F C5 . PUSH BC +5370 06 08 .. LD B,08 +5372 1F . RRA +5373 30 02 0. JR NC,5377 +5375 FD 23 .# INC IY +5377 10 F9 .. DJNZ 5372 +5379 C1 . POP BC +537A 18 02 .. JR 537E +537C FD 19 .. ADD IY,DE +537E ED A1 .. CPI +5380 EA 67 53 .gS JP PE,5367 +5383 D1 . POP DE +5384 7B { LD A,E +5385 1F . RRA +5386 E6 07 .. AND 07 +5388 28 09 (. JR Z,5393 +538A 47 G LD B,A +538B 7E ~ LD A,(HL) +538C 1F . RRA +538D 30 02 0. JR NC,5391 +538F FD 23 .# INC IY +5391 10 F9 .. DJNZ 538C +5393 FD 29 .) ADD IY,HL +5395 FD 23 .# INC IY +5397 E1 . POP HL +5398 C1 . POP BC +5399 FD E5 .. PUSH IY +539B D1 . POP DE +539C C9 . RET +539D 97 . SUB A +539E 01 05 00 ... LD BC,0005 +53A1 11 00 00 ... LD DE,0000 +53A4 CD A8 28 ..( CALL 28A8 +53A7 ED 43 0A 57 .C.W LD (570A),BC +53AB E5 . PUSH HL +53AC 60 ` LD H,B +53AD 69 i LD L,C +53AE 06 06 .. LD B,06 +53B0 CB 3C .< SLR H +53B2 CB 1D .. RR L +53B4 10 FA .. DJNZ 53B0 +53B6 7D } LD A,L +53B7 C6 28 .( ADD A,28 +53B9 6F o LD L,A +53BA 30 01 0. JR NC,53BD +53BC 24 $ INC H +53BD 22 10 57 ".W LD (5710),HL +53C0 E1 . POP HL +53C1 ED 4B 0A 57 .K.W LD BC,(570A) +53C5 CB 28 .( SRA B +53C7 CB 19 .. RR C +53C9 CB 28 .( SRA B +53CB CB 19 .. RR C +53CD CB 28 .( SRA B +53CF CB 19 .. RR C +53D1 ED 43 FB 56 .C.V LD (56FB),BC +53D5 C9 . RET +53D6 E5 . PUSH HL +53D7 2A FD 56 *.V LD HL,(56FD) +53DA CD DF 53 ..S CALL 53DF +53DD E1 . POP HL +53DE C9 . RET +53DF C5 . PUSH BC +53E0 E5 . PUSH HL +53E1 2A F9 56 *.V LD HL,(56F9) +53E4 B7 . OR A +53E5 ED 52 .R SBC HL,DE +53E7 20 10 . JR NZ,53F9 +53E9 CD 1F 70 ..p CALL 701F ; Info aufrufen +53EC 18 0B .. JR 53F9 ; " bnr gleich" +53EE 20 62 b JR NZ,5452 +53F0 6E n LD L,(HL) +53F1 72 r LD (HL),D +53F2 20 67 g JR NZ,545B +53F4 6C l LD L,H +53F5 65 e LD H,L +53F6 69 i LD L,C +53F7 63 c LD H,E +53F8 68 h LD L,B +53F9 E1 . POP HL +53FA ED 4B FB 56 .K.V LD BC,(56FB) +53FE F5 . PUSH AF +53FF D5 . PUSH DE +5400 CD 66 56 .fV CALL 5666 +5403 30 04 0. JR NC,5409 +5405 19 . ADD HL,DE +5406 2F / CPL +5407 A6 . AND (HL) +5408 77 w LD (HL),A +5409 D1 . POP DE +540A F1 . POP AF +540B C1 . POP BC +540C C9 . RET +540D E5 . PUSH HL +540E 2A FF 56 *.V LD HL,(56FF) +5411 CD DF 53 ..S CALL 53DF +5414 E1 . POP HL +5415 C9 . RET +5416 E5 . PUSH HL +5417 D5 . PUSH DE +5418 C5 . PUSH BC +5419 CD 9D 53 ..S CALL 539D +541C 78 x LD A,B +541D 3C < INC A +541E 3C < INC A +541F CD B1 5F .._ CALL 5FB1 +5422 22 FD 56 ".V LD (56FD),HL +5425 CD 3A 54 .:T CALL 543A +5428 22 FF 56 ".V LD (56FF),HL +542B 54 T LD D,H +542C 5D ] LD E,L +542D 13 . INC DE +542E 36 FF 6. LD (HL),FF +5430 ED 4B FB 56 .K.V LD BC,(56FB) +5434 ED B0 .. LDIR +5436 C1 . POP BC +5437 D1 . POP DE +5438 E1 . POP HL +5439 C9 . RET +543A 11 04 00 ... LD DE,0004 +543D ED 4B FB 56 .K.V LD BC,(56FB) +5441 C5 . PUSH BC +5442 D5 . PUSH DE +5443 E5 . PUSH HL +5444 CD 46 81 .F. CALL 8146 +5447 67 g LD H,A +5448 2E 00 .. LD L,00 +544A D1 . POP DE +544B 01 00 02 ... LD BC,0200 +544E ED B0 .. LDIR +5450 62 b LD H,D +5451 6B k LD L,E +5452 D1 . POP DE +5453 1C . INC E +5454 1C . INC E +5455 C1 . POP BC +5456 05 . DEC B +5457 05 . DEC B +5458 F2 41 54 .AT JP P,5441 +545B C9 . RET +545C E5 . PUSH HL +545D D5 . PUSH DE +545E C5 . PUSH BC +545F F5 . PUSH AF +5460 3A 13 57 :.W LD A,(5713) +5463 B7 . OR A +5464 C2 12 55 ..U JP NZ,5512 +5467 2A 08 57 *.W LD HL,(5708) +546A 22 0C 57 ".W LD (570C),HL +546D 21 04 00 !.. LD HL,0004 +5470 ED 4B FB 56 .K.V LD BC,(56FB) +5474 ED 5B FD 56 .[.V LD DE,(56FD) +5478 FD 21 00 00 .!.. LD IY,0000 +547C 3E 01 >. LD A,01 +547E 32 12 57 2.W LD (5712),A +5481 E5 . PUSH HL +5482 C5 . PUSH BC +5483 D5 . PUSH DE +5484 EB . EX DE,HL +5485 FD E5 .. PUSH IY +5487 CD 46 81 .F. CALL 8146 +548A FD E1 .. POP IY +548C 67 g LD H,A +548D 2E 00 .. LD L,00 +548F D1 . POP DE +5490 01 00 02 ... LD BC,0200 +5493 1A . LD A,(DE) +5494 AE . XOR (HL) +5495 77 w LD (HL),A +5496 87 . ADD A +5497 30 02 0. JR NC,549B +5499 FD 23 .# INC IY +549B 20 F9 . JR NZ,5496 +549D 13 . INC DE +549E ED A1 .. CPI +54A0 EA 93 54 ..T JP PE,5493 +54A3 C1 . POP BC +54A4 E1 . POP HL +54A5 2C , INC L +54A6 2C , INC L +54A7 05 . DEC B +54A8 05 . DEC B +54A9 F2 81 54 ..T JP P,5481 +54AC 2A 0C 57 *.W LD HL,(570C) +54AF ED 4B 08 57 .K.W LD BC,(5708) +54B3 B7 . OR A +54B4 ED 42 .B SBC HL,BC +54B6 FD E5 .. PUSH IY +54B8 C1 . POP BC +54B9 09 . ADD HL,BC +54BA 44 D LD B,H +54BB 4D M LD C,L +54BC 2A 0A 57 *.W LD HL,(570A) +54BF B7 . OR A +54C0 ED 42 .B SBC HL,BC +54C2 30 0C 0. JR NC,54D0 +54C4 CD 1F 70 ..p CALL 701F ; Info aufrufen +54C7 18 07 .. JR 54D0 ; " HGVOLL" +54C9 20 48 H JR NZ,5513 +54CB 47 G LD B,A +54CC 56 V LD D,(HL) +54CD 4F O LD C,A +54CE 4C L LD C,H +54CF 4C L LD C,H +54D0 ED 4B 10 57 .K.W LD BC,(5710) +54D4 ED 42 .B SBC HL,BC +54D6 22 08 57 ".W LD (5708),HL +54D9 B7 . OR A +54DA 01 14 00 ... LD BC,0014 +54DD ED 42 .B SBC HL,BC +54DF 3E 00 >. LD A,00 +54E1 DC FA 54 ..T CALL C,54FA +54E4 32 13 57 2.W LD (5713),A +54E7 CD CD 5F .._ CALL 5FCD +54EA 11 04 00 ... LD DE,0004 +54ED ED 53 0E 57 .S.W LD (570E),DE +54F1 97 . SUB A +54F2 32 12 57 2.W LD (5712),A +54F5 F1 . POP AF +54F6 C1 . POP BC +54F7 D1 . POP DE +54F8 E1 . POP HL +54F9 C9 . RET +54FA 2A 08 57 *.W LD HL,(5708) +54FD ED 4B 10 57 .K.W LD BC,(5710) +5501 09 . ADD HL,BC +5502 22 08 57 ".W LD (5708),HL +5505 21 81 18 !.. LD HL,1881 +5508 06 7D .} LD B,7D +550A CB CE .. SET 1,(HL) +550C 23 # INC HL +550D 10 FB .. DJNZ 550A +550F 3E 01 >. LD A,01 +5511 C9 . RET +5512 2A FD 56 *.V LD HL,(56FD) +5515 ED 4B FB 56 .K.V LD BC,(56FB) +5519 11 00 00 ... LD DE,0000 +551C 7E ~ LD A,(HL) +551D 87 . ADD A +551E 30 01 0. JR NC,5521 +5520 13 . INC DE +5521 20 FA . JR NZ,551D +5523 ED A1 .. CPI +5525 EA 1C 55 ..U JP PE,551C +5528 62 b LD H,D +5529 6B k LD L,E +552A B7 . OR A +552B ED 5B 10 57 .[.W LD DE,(5710) +552F ED 52 .R SBC HL,DE +5531 3E 00 >. LD A,00 +5533 CE 00 .. ADC A,00 +5535 32 13 57 2.W LD (5713),A +5538 20 0F . JR NZ,5549 +553A 21 17 82 !.. LD HL,8217 +553D 36 03 6. LD (HL),03 +553F 06 7D .} LD B,7D +5541 21 81 18 !.. LD HL,1881 +5544 CB 8E .. RES 1,(HL) +5546 23 # INC HL +5547 10 FB .. DJNZ 5544 +5549 CD CD 5F .._ CALL 5FCD +554C 18 A3 .. JR 54F1 +554E 21 12 57 !.W LD HL,5712 +5551 7E ~ LD A,(HL) +5552 B7 . OR A +5553 C2 1A 6C ..l JP NZ,6C1A +5556 D5 . PUSH DE +5557 C5 . PUSH BC +5558 2A 08 57 *.W LD HL,(5708) +555B 2B + DEC HL +555C CB 7C .| BIT 7,H +555E 28 07 (. JR Z,5567 +5560 CD 0E 6E ..n CALL 6E0E +5563 FE 4D .M CP 4D +5565 20 63 c JR NZ,55CA +5567 22 08 57 ".W LD (5708),HL +556A ED 5B 0E 57 .[.W LD DE,(570E) +556E CD 41 5D .A] CALL 5D41 +5571 CB FD .. SET 7,L +5573 CB 8E .. RES 1,(HL) +5575 65 e LD H,L +5576 2E 00 .. LD L,00 +5578 CB 24 .$ SLA H +557A 01 00 02 ... LD BC,0200 +557D CD F7 55 ..U CALL 55F7 +5580 30 22 0" JR NC,55A4 +5582 ED 5B 0E 57 .[.W LD DE,(570E) +5586 7B { LD A,E +5587 D6 04 .. SUB A,04 +5589 87 . ADD A +558A 87 . ADD A +558B 87 . ADD A +558C 87 . ADD A +558D 1E 00 .. LD E,00 +558F 57 W LD D,A +5590 19 . ADD HL,DE +5591 ED 5B 0A 57 .[.W LD DE,(570A) +5595 CB 23 .# SLA E +5597 CB 12 .. RL D +5599 B7 . OR A +559A E5 . PUSH HL +559B ED 52 .R SBC HL,DE +559D E1 . POP HL +559E 30 10 0. JR NC,55B0 +55A0 C1 . POP BC +55A1 D1 . POP DE +55A2 B7 . OR A +55A3 C9 . RET +55A4 ED 5B 0E 57 .[.W LD DE,(570E) +55A8 1C . INC E +55A9 1C . INC E +55AA ED 53 0E 57 .S.W LD (570E),DE +55AE 18 BA .. JR 556A +55B0 CD 0E 6E ..n CALL 6E0E +55B3 FE 4D .M CP 4D ; Muell-Prozess ? +55B5 20 04 . JR NZ,55BB +55B7 C1 . POP BC +55B8 D1 . POP DE +55B9 37 7 SCF +55BA C9 . RET +55BB CD 1F 70 ..p CALL 701F ; Info aufrufen +55BE 18 08 .. JR 55C8 ; " HG voll" +55C0 20 48 H JR NZ,560A +55C2 47 G LD B,A +55C3 20 76 v JR NZ,563B +55C5 6F o LD L,A +55C6 6C l LD L,H +55C7 6C l LD L,H +55C8 18 F1 .. JR 55BB +55CA 21 17 82 !.. LD HL,8217 +55CD 7E ~ LD A,(HL) +55CE B7 . OR A +55CF CB C6 .. SET 0,(HL) +55D1 20 03 . JR NZ,55D6 +55D3 3E 03 >. LD A,03 +55D5 77 w LD (HL),A +55D6 C3 1A 6C ..l JP 6C1A +55D9 D5 . PUSH DE +55DA E5 . PUSH HL +55DB EB . EX DE,HL +55DC 01 00 01 ... LD BC,0100 +55DF CD F7 55 ..U CALL 55F7 +55E2 44 D LD B,H +55E3 4D M LD C,L +55E4 E1 . POP HL +55E5 D1 . POP DE +55E6 C9 . RET +55E7 D5 . PUSH DE +55E8 C5 . PUSH BC +55E9 2A FF 56 *.V LD HL,(56FF) +55EC ED 4B FB 56 .K.V LD BC,(56FB) +55F0 03 . INC BC +55F1 CD F7 55 ..U CALL 55F7 +55F4 C1 . POP BC +55F5 D1 . POP DE +55F6 C9 . RET +55F7 E5 . PUSH HL +55F8 3E FF >. LD A,FF +55FA 03 . INC BC +55FB ED A1 .. CPI +55FD E2 2B 56 .+V JP PO,562B +5600 28 F9 (. JR Z,55FB +5602 2B + DEC HL +5603 06 08 .. LD B,08 +5605 CB 1E .. RR (HL) +5607 30 02 0. JR NC,560B +5609 10 FA .. DJNZ 5605 +560B 3E 08 >. LD A,08 +560D 90 . SUB B +560E 37 7 SCF +560F CB 1E .. RR (HL) +5611 10 FC .. DJNZ 560F +5613 C1 . POP BC +5614 B7 . OR A +5615 ED 42 .B SBC HL,BC +5617 CB 25 .% SLA L +5619 CB 14 .. RL H +561B CB 25 .% SLA L +561D CB 14 .. RL H +561F CB 25 .% SLA L +5621 CB 14 .. RL H +5623 B5 . OR L +5624 6F o LD L,A +5625 CB 25 .% SLA L +5627 CB 14 .. RL H +5629 37 7 SCF +562A C9 . RET +562B E1 . POP HL +562C B7 . OR A +562D C9 . RET +562E E5 . PUSH HL +562F 2A 08 57 *.W LD HL,(5708) +5632 CB 3C .< SLR H +5634 CB 1D .. RR L +5636 B7 . OR A +5637 ED 42 .B SBC HL,BC +5639 E1 . POP HL +563A D0 . RET NC +563B CD 20 6E . n CALL 6E20 +563E C5 . PUSH BC +563F 3A 17 82 :.. LD A,(8217) +5642 BA . CP D +5643 28 09 (. JR Z,564E +5645 D5 . PUSH DE +5646 CD C1 81 ... CALL 81C1 +5649 D1 . POP DE +564A 7A z LD A,D +564B 32 17 82 2.. LD (8217),A +564E CD C1 81 ... CALL 81C1 +5651 CD CC 56 ..V CALL 56CC +5654 B7 . OR A +5655 ED 42 .B SBC HL,BC +5657 C1 . POP BC +5658 ED 42 .B SBC HL,BC +565A 38 05 8. JR C,5661 +565C CD 2A 6E .*n CALL 6E2A +565F B7 . OR A +5660 C9 . RET +5661 CD 2A 6E .*n CALL 6E2A +5664 37 7 SCF +5665 C9 . RET +5666 CB 3A .: SLR D +5668 CB 1B .. RR E +566A 7B { LD A,E +566B E6 07 .. AND 07 +566D CB 3A .: SLR D +566F CB 1B .. RR E +5671 CB 3A .: SLR D +5673 CB 1B .. RR E +5675 CB 3A .: SLR D +5677 CB 1B .. RR E +5679 E5 . PUSH HL +567A 21 14 57 !.W LD HL,5714 +567D 85 . ADD L +567E 6F o LD L,A +567F 30 01 0. JR NC,5682 +5681 24 $ INC H +5682 7E ~ LD A,(HL) +5683 60 ` LD H,B +5684 69 i LD L,C +5685 B7 . OR A +5686 ED 52 .R SBC HL,DE +5688 30 1B 0. JR NC,56A5 +568A CD 1F 70 ..p CALL 701F +568D 18 10 .. JR 569F +568F 20 66 f JR NZ,56F7 ; Info aufrufen +5691 61 a LD H,C ; " falsches setbit" +5692 6C l LD L,H +5693 73 s LD (HL),E +5694 63 c LD H,E +5695 68 h LD L,B +5696 65 e LD H,L +5697 73 s LD (HL),E +5698 20 73 s JR NZ,570D +569A 65 e LD H,L +569B 74 t LD (HL),H +569C 62 b LD H,D +569D 69 i LD L,C +569E 74 t LD (HL),H +569F E1 . POP HL +56A0 11 00 00 ... LD DE,0000 +56A3 AF . XOR A +56A4 C9 . RET +56A5 E1 . POP HL +56A6 37 7 SCF +56A7 C9 . RET +56A8 E5 . PUSH HL +56A9 D5 . PUSH DE +56AA C5 . PUSH BC +56AB ED 4B FB 56 .K.V LD BC,(56FB) +56AF CD 66 56 .fV CALL 5666 +56B2 F5 . PUSH AF +56B3 D5 . PUSH DE +56B4 7A z LD A,D +56B5 C6 04 .. ADD A,04 +56B7 5F _ LD E,A +56B8 16 00 .. LD D,00 +56BA CD 46 81 .F. CALL 8146 +56BD 67 g LD H,A +56BE 2E 00 .. LD L,00 +56C0 D1 . POP DE +56C1 7A z LD A,D +56C2 E6 01 .. AND 01 +56C4 57 W LD D,A +56C5 F1 . POP AF +56C6 19 . ADD HL,DE +56C7 A6 . AND (HL) +56C8 C1 . POP BC +56C9 D1 . POP DE +56CA E1 . POP HL +56CB C9 . RET +56CC 2A 0A 57 *.W LD HL,(570A) +56CF ED 4B 10 57 .K.W LD BC,(5710) +56D3 B7 . OR A +56D4 ED 42 .B SBC HL,BC +56D6 ED 4B 08 57 .K.W LD BC,(5708) +56DA E5 . PUSH HL +56DB ED 42 .B SBC HL,BC +56DD 3A 13 57 :.W LD A,(5713) +56E0 B7 . OR A +56E1 28 05 (. JR Z,56E8 +56E3 ED 4B 10 57 .K.W LD BC,(5710) +56E7 09 . ADD HL,BC +56E8 44 D LD B,H +56E9 4D M LD C,L +56EA E1 . POP HL +56EB CB 3C .< SLR H +56ED CB 1D .. RR L +56EF CB 38 .8 SLR B +56F1 CB 19 .. RR C +56F3 C9 . RET +56F4 76 v HALT ; "vergl" +56F5 65 e LD H,L +56F6 72 r LD (HL),D +56F7 67 g LD H,A +56F8 6C l LD L,H +56F9 FF . RST 38 +56FA FF . RST 38 +56FB 00 . NOP +56FC 00 . NOP +56FD 00 . NOP +56FE 00 . NOP +56FF 00 . NOP +5700 00 . NOP +5701 68 h LD L,B ; "hgfrei" +5702 67 g LD H,A +5703 66 f LD H,(HL) +5704 72 r LD (HL),D +5705 65 e LD H,L +5706 69 i LD L,C +5707 20 00 . JR NZ,5709 +5709 00 . NOP +570A E8 . RET PE +570B 03 . INC BC +570C 00 . NOP +570D 00 . NOP +570E 04 . INC B +570F 00 . NOP +5710 2E 00 .. LD L,00 +5712 00 . NOP +5713 00 . NOP +5714 01 02 04 ... LD BC,0402 +5717 08 . EX AF,AF' +5718 10 20 . DJNZ 573A +571A 40 @ LD B,B +571B 80 . ADD B +571C 31 37 35 175 LD SP,3537 ; "175 lader 2 (!)" +571F 20 6C l JR NZ,578D +5721 61 a LD H,C +5722 64 d LD H,H +5723 65 e LD H,L +5724 72 r LD (HL),D +5725 20 20 JR NZ,5747 +5727 20 32 2 JR NZ,575B +5729 20 28 ( JR NZ,5753 +572B 21 29 3E !)> LD HL,3E29 +572E FE 32 .2 CP 32 +5730 27 ' DAA +5731 16 CD .. LD D,CD +5733 A0 . AND B +5734 28 CD (. JR Z,5703 +5736 78 x LD A,B +5737 82 . ADD D +5738 2B + DEC HL +5739 6C l LD L,H +573A 37 7 SCF +573B CB 1D .. RR L +573D 2C , INC L +573E 26 15 &. LD H,15 +5740 22 9F 60 ".` LD (609F),HL +5743 13 . INC DE +5744 7A z LD A,D +5745 37 7 SCF +5746 CB 1F .. RR A +5748 32 A1 60 2.` LD (60A1),A +574B 21 CF 15 !.. LD HL,15CF +574E CB C6 .. SET 0,(HL) +5750 21 00 14 !.. LD HL,1400 +5753 11 01 14 ... LD DE,1401 +5756 01 FF 00 ... LD BC,00FF +5759 36 80 6. LD (HL),80 +575B ED B0 .. LDIR +575D 21 7D 82 !}. LD HL,827D +5760 CD CA 6E ..n CALL 6ECA +5763 CD 8B 59 ..Y CALL 598B +5766 CD 85 64 ..d CALL 6485 +5769 C9 . RET +576A 50 P LD D,B ; "PROZ LADER" +576B 52 R LD D,D +576C 4F O LD C,A +576D 5A Z LD E,D +576E 20 4C L JR NZ,57BC +5770 41 A LD B,C +5771 44 D LD B,H +5772 45 E LD B,L +5773 52 R LD D,D +5774 42 B LD B,D +5775 58 X LD E,B +5776 C3 A5 5F .._ JP 5FA5 +5779 4C L LD C,H +577A FF . RST 38 +577B FF . RST 38 +577C FF . RST 38 +577D FF . RST 38 +577E FF . RST 38 +577F FF . RST 38 +5780 FF . RST 38 +5781 FF . RST 38 +5782 FF . RST 38 +5783 FF . RST 38 +5784 FF . RST 38 +5785 FF . RST 38 +5786 FF . RST 38 +5787 FF . RST 38 +5788 FF . RST 38 +5789 FF . RST 38 +578A FF . RST 38 +578B FF . RST 38 +578C FF . RST 38 +578D FF . RST 38 +578E FF . RST 38 +578F FF . RST 38 +5790 FF . RST 38 +5791 FF . RST 38 +5792 FF . RST 38 +5793 FF . RST 38 +5794 FF . RST 38 +5795 FF . RST 38 +5796 FF . RST 38 +5797 FF . RST 38 +5798 FF . RST 38 +5799 FF . RST 38 +579A FF . RST 38 +579B FF . RST 38 +579C FF . RST 38 +579D FF . RST 38 +579E FF . RST 38 +579F FF . RST 38 +57A0 FF . RST 38 +57A1 FF . RST 38 +57A2 FF . RST 38 +57A3 FF . RST 38 +57A4 FF . RST 38 +57A5 FF . RST 38 +57A6 FF . RST 38 +57A7 FF . RST 38 +57A8 FF . RST 38 +57A9 FF . RST 38 +57AA FF . RST 38 +57AB FF . RST 38 +57AC FF . RST 38 +57AD FF . RST 38 +57AE FF . RST 38 +57AF FF . RST 38 +57B0 FF . RST 38 +57B1 FF . RST 38 +57B2 FF . RST 38 +57B3 FF . RST 38 +57B4 FF . RST 38 +57B5 FF . RST 38 +57B6 FF . RST 38 +57B7 FF . RST 38 +57B8 FF . RST 38 +57B9 FF . RST 38 +57BA FF . RST 38 +57BB FF . RST 38 +57BC FF . RST 38 +57BD FF . RST 38 +57BE FF . RST 38 +57BF FF . RST 38 +57C0 FF . RST 38 +57C1 FF . RST 38 +57C2 FF . RST 38 +57C3 FF . RST 38 +57C4 FF . RST 38 +57C5 FF . RST 38 +57C6 FF . RST 38 +57C7 FF . RST 38 +57C8 FF . RST 38 +57C9 FF . RST 38 +57CA FF . RST 38 +57CB FF . RST 38 +57CC FF . RST 38 +57CD FF . RST 38 +57CE FF . RST 38 +57CF FF . RST 38 +57D0 FF . RST 38 +57D1 FF . RST 38 +57D2 FF . RST 38 +57D3 FF . RST 38 +57D4 FF . RST 38 +57D5 FF . RST 38 +57D6 FF . RST 38 +57D7 FF . RST 38 +57D8 FF . RST 38 +57D9 FF . RST 38 +57DA FF . RST 38 +57DB FF . RST 38 +57DC FF . RST 38 +57DD FF . RST 38 +57DE FF . RST 38 +57DF FF . RST 38 +57E0 FF . RST 38 +57E1 FF . RST 38 +57E2 FF . RST 38 +57E3 FF . RST 38 +57E4 FF . RST 38 +57E5 FF . RST 38 +57E6 FF . RST 38 +57E7 FF . RST 38 +57E8 FF . RST 38 +57E9 FF . RST 38 +57EA FF . RST 38 +57EB FF . RST 38 +57EC FF . RST 38 +57ED FF . RST 38 +57EE FF . RST 38 +57EF FF . RST 38 +57F0 FF . RST 38 +57F1 FF . RST 38 +57F2 FF . RST 38 +57F3 FF . RST 38 +57F4 FF . RST 38 +57F5 FF . RST 38 +57F6 FF . RST 38 +57F7 FF . RST 38 +57F8 FF . RST 38 +57F9 FF . RST 38 +57FA FF . RST 38 +57FB FF . RST 38 +57FC FF . RST 38 +57FD FF . RST 38 +57FE FF . RST 38 +57FF FF . RST 38 +5800 FF . RST 38 +5801 FF . RST 38 +5802 FF . RST 38 +5803 FF . RST 38 +5804 FF . RST 38 +5805 FF . RST 38 +5806 FF . RST 38 +5807 FF . RST 38 +5808 FF . RST 38 +5809 FF . RST 38 +580A FF . RST 38 +580B FF . RST 38 +580C FF . RST 38 +580D FF . RST 38 +580E FF . RST 38 +580F FF . RST 38 +5810 FF . RST 38 +5811 FF . RST 38 +5812 FF . RST 38 +5813 FF . RST 38 +5814 FF . RST 38 +5815 FF . RST 38 +5816 FF . RST 38 +5817 FF . RST 38 +5818 FF . RST 38 +5819 FF . RST 38 +581A FF . RST 38 +581B FF . RST 38 +581C FF . RST 38 +581D FF . RST 38 +581E FF . RST 38 +581F FF . RST 38 +5820 FF . RST 38 +5821 FF . RST 38 +5822 FF . RST 38 +5823 FF . RST 38 +5824 FF . RST 38 +5825 FF . RST 38 +5826 FF . RST 38 +5827 FF . RST 38 +5828 FF . RST 38 +5829 FF . RST 38 +582A FF . RST 38 +582B FF . RST 38 +582C FF . RST 38 +582D FF . RST 38 +582E FF . RST 38 +582F FF . RST 38 +5830 FF . RST 38 +5831 FF . RST 38 +5832 FF . RST 38 +5833 FF . RST 38 +5834 FF . RST 38 +5835 FF . RST 38 +5836 FF . RST 38 +5837 FF . RST 38 +5838 FF . RST 38 +5839 FF . RST 38 +583A FF . RST 38 +583B FF . RST 38 +583C FF . RST 38 +583D FF . RST 38 +583E FF . RST 38 +583F FF . RST 38 +5840 FF . RST 38 +5841 FF . RST 38 +5842 44 D LD B,H +5843 58 X LD E,B +5844 21 B5 4C !.L LD HL,4CB5 +5847 CB 96 .. RES 2,(HL) +5849 CD E2 6D ..m CALL 6DE2 +584C 3A 96 60 :.` LD A,(6096) +584F B7 . OR A +5850 28 15 (. JR Z,5867 +5852 FE 02 .. CP 02 +5854 28 2C (, JR Z,5882 +5856 2A 97 60 *.` LD HL,(6097) +5859 CB 46 .F BIT 0,(HL) +585B 20 0A . JR NZ,5867 +585D CD 1C 59 ..Y CALL 591C +5860 2A 97 60 *.` LD HL,(6097) +5863 CB CE .. SET 1,(HL) +5865 18 2A .* JR 5891 +5867 3A 99 60 :.` LD A,(6099) +586A B7 . OR A +586B 28 28 (( JR Z,5895 +586D 2A 9A 60 *.` LD HL,(609A) +5870 CB 46 .F BIT 0,(HL) +5872 20 21 ! JR NZ,5895 +5874 CD 1C 59 ..Y CALL 591C +5877 2A 9A 60 *.` LD HL,(609A) +587A CB CE .. SET 1,(HL) +587C 97 . SUB A +587D 32 99 60 2.` LD (6099),A +5880 18 13 .. JR 5895 +5882 3A 5B 60 :[` LD A,(605B) +5885 B7 . OR A +5886 28 09 (. JR Z,5891 +5888 CD 96 5C ..\ CALL 5C96 +588B 20 08 . JR NZ,5895 +588D 97 . SUB A +588E 32 B3 60 2.` LD (60B3),A +5891 97 . SUB A +5892 32 96 60 2.` LD (6096),A +5895 3A 1F 16 :.. LD A,(161F) +5898 FE FD .. CP FD +589A 28 14 (. JR Z,58B0 +589C 21 CE 15 !.. LD HL,15CE +589F CB 46 .F BIT 0,(HL) +58A1 20 0D . JR NZ,58B0 +58A3 57 W LD D,A +58A4 3A 1F 15 :.. LD A,(151F) +58A7 5F _ LD E,A +58A8 CD 45 59 .EY CALL 5945 +58AB 3E FD >. LD A,FD +58AD 32 1F 16 2.. LD (161F),A +58B0 3A A4 60 :.` LD A,(60A4) +58B3 B7 . OR A +58B4 28 2E (. JR Z,58E4 +58B6 3A 63 60 :c` LD A,(6063) +58B9 B7 . OR A +58BA CA 44 58 .DX JP Z,5844 +58BD CD F7 58 ..X CALL 58F7 +58C0 22 9D 60 ".` LD (609D),HL +58C3 21 B5 4C !.L LD HL,4CB5 +58C6 CB D6 .. SET 2,(HL) +58C8 2A B1 60 *.` LD HL,(60B1) +58CB 56 V LD D,(HL) +58CC 25 % DEC H +58CD 5E ^ LD E,(HL) +58CE ED 53 A7 60 .S.` LD (60A7),DE +58D2 2A 9D 60 *.` LD HL,(609D) +58D5 CD 45 59 .EY CALL 5945 +58D8 2A B1 60 *.` LD HL,(60B1) +58DB 36 FD 6. LD (HL),FD +58DD 21 63 60 !c` LD HL,6063 +58E0 35 5 DEC (HL) +58E1 C3 95 58 ..X JP 5895 +58E4 CD F4 5B ..[ CALL 5BF4 +58E7 20 03 . JR NZ,58EC +58E9 11 00 00 ... LD DE,0000 +58EC ED 53 A5 60 .S.` LD (60A5),DE +58F0 3E 02 >. LD A,02 +58F2 32 A4 60 2.` LD (60A4),A +58F5 18 B9 .. JR 58B0 +58F7 06 08 .. LD B,08 +58F9 2A 9D 60 *.` LD HL,(609D) +58FC CD 3C 5F .<_ CALL 5F3C +58FF CB 46 .F BIT 0,(HL) +5901 20 F9 . JR NZ,58FC +5903 CB 5E .^ BIT 3,(HL) +5905 28 02 (. JR Z,5909 +5907 10 F0 .. DJNZ 58F9 +5909 E5 . PUSH HL +590A 06 02 .. LD B,02 +590C CD 3C 5F .<_ CALL 5F3C +590F 10 FB .. DJNZ 590C +5911 06 08 .. LD B,08 +5913 CB 9E .. RES 3,(HL) +5915 CD 3C 5F .<_ CALL 5F3C +5918 10 F9 .. DJNZ 5913 +591A E1 . POP HL +591B C9 . RET +591C CB C6 .. SET 0,(HL) +591E CB 96 .. RES 2,(HL) +5920 CB 4E .N BIT 1,(HL) +5922 20 09 . JR NZ,592D +5924 C3 10 5B ..[ JP 5B10 +5927 3E 02 >. LD A,02 +5929 CB 4E .N BIT 1,(HL) +592B 28 02 (. JR Z,592F +592D 3E 03 >. LD A,03 +592F CB BD .. RES 7,L +5931 5E ^ LD E,(HL) +5932 24 $ INC H +5933 56 V LD D,(HL) +5934 65 e LD H,L +5935 CB 24 .$ SLA H +5937 2E 00 .. LD L,00 +5939 FE 03 .. CP 03 +593B C8 . RET Z +593C 7A z LD A,D +593D FE FD .. CP FD +593F D0 . RET NC +5940 3E 02 >. LD A,02 +5942 C3 82 5E ..^ JP 5E82 +5945 E5 . PUSH HL +5946 CB 96 .. RES 2,(HL) +5948 D5 . PUSH DE +5949 CD 1C 59 ..Y CALL 591C +594C D1 . POP DE +594D E3 . EX (SP),HL +594E 24 $ INC H +594F 36 FF 6. LD (HL),FF +5951 25 % DEC H +5952 E3 . EX (SP),HL +5953 7A z LD A,D +5954 FE FF .. CP FF +5956 20 16 . JR NZ,596E +5958 D5 . PUSH DE +5959 36 FF 6. LD (HL),FF +595B 54 T LD D,H +595C 5D ] LD E,L +595D 13 . INC DE +595E 01 FF 01 ... LD BC,01FF +5961 CD A5 28 ..( CALL 28A5 +5964 D1 . POP DE +5965 E1 . POP HL +5966 36 02 6. LD (HL),02 +5968 CB BD .. RES 7,L +596A 73 s LD (HL),E +596B 24 $ INC H +596C 72 r LD (HL),D +596D C9 . RET +596E CD E9 5A ..Z CALL 5AE9 +5971 28 F2 (. JR Z,5965 +5973 3E 01 >. LD A,01 +5975 CD 82 5E ..^ CALL 5E82 +5978 7C | LD A,H +5979 FE 9C .. CP 9C +597B 28 E8 (. JR Z,5965 +597D E1 . POP HL +597E E5 . PUSH HL +597F CD 68 59 .hY CALL 5968 +5982 E1 . POP HL +5983 E5 . PUSH HL +5984 CD 10 5B ..[ CALL 5B10 +5987 E1 . POP HL +5988 36 02 6. LD (HL),02 +598A C9 . RET +598B CD 8A 28 ..( CALL 288A +598E 22 AB 60 ".` LD (60AB),HL +5991 CB 78 .x BIT 7,B +5993 28 0D (. JR Z,59A2 +5995 3E C3 >. LD A,C3 ; JP ... +5997 32 95 5A 2.Z LD (5A95),A +599A 21 8D 28 !.( LD HL,288D ; SCHACC +599D 22 96 5A ".Z LD (5A96),HL +59A0 CB B8 .. RES 7,B +59A2 CB 70 .p BIT 6,B +59A4 28 22 (" JR Z,59C8 +59A6 21 FF FF !.. LD HL,FFFF +59A9 22 5C 60 "\` LD (605C),HL +59AC 3E C9 >. LD A,C9 ; RET +59AE 32 95 5A 2.Z LD (5A95),A +59B1 3E C3 >. LD A,C3 ; JP ... +59B3 32 A8 5A 2.Z LD (5AA8),A +59B6 21 8D 28 !.( LD HL,288D ; SCHACC +59B9 3A 6B 28 :k( LD A,(286B) +59BC FE 06 .. CP 06 +59BE 38 03 8. JR C,59C3 +59C0 21 BD 5A !.Z LD HL,5ABD +59C3 22 A9 5A ".Z LD (5AA9),HL +59C6 CB B0 .. RES 6,B +59C8 CB 21 .! SLA C +59CA CB 10 .. RL B +59CC 20 05 . JR NZ,59D3 +59CE 3E 50 >P LD A,50 +59D0 32 B4 60 2.` LD (60B4),A +59D3 ED 43 AE 60 .C.` LD (60AE),BC +59D7 78 x LD A,B +59D8 B1 . OR C +59D9 32 5B 60 2[` LD (605B),A +59DC 28 34 (4 JR Z,5A12 +59DE C5 . PUSH BC +59DF 3E 00 >. LD A,00 ; HG +59E1 01 05 00 ... LD BC,0005 ; Size +59E4 11 00 00 ... LD DE,0000 ; Schluessel 0 +59E7 CD A8 28 ..( CALL 28A8 +59EA E1 . POP HL +59EB B7 . OR A +59EC ED 42 .B SBC HL,BC +59EE 38 0F 8. JR C,59FF +59F0 3E 01 >. LD A,01 +59F2 CD 1D 5A ..Z CALL 5A1D +59F5 97 . SUB A +59F6 32 5B 60 2[` LD (605B),A +59F9 3C < INC A +59FA 32 AD 60 2.` LD (60AD),A +59FD 18 18 .. JR 5A17 +59FF 1E 00 .. LD E,00 +5A01 D5 . PUSH DE +5A02 CD A6 5A ..Z CALL 5AA6 +5A05 54 T LD D,H +5A06 5D ] LD E,L +5A07 13 . INC DE +5A08 36 FE 6. LD (HL),FE +5A0A ED B0 .. LDIR +5A0C D1 . POP DE +5A0D 1C . INC E +5A0E 1C . INC E +5A0F 20 F0 . JR NZ,5A01 +5A11 C9 . RET +5A12 3E C9 >. LD A,C9 ; RET +5A14 32 95 5A 2.Z LD (5A95),A +5A17 21 CF 15 !.. LD HL,15CF +5A1A CB 86 .. RES 0,(HL) +5A1C C9 . RET +5A1D 21 00 00 !.. LD HL,0000 +5A20 C5 . PUSH BC +5A21 F5 . PUSH AF +5A22 E5 . PUSH HL +5A23 CD 92 5A ..Z CALL 5A92 +5A26 D1 . POP DE +5A27 CB 23 .# SLA E +5A29 CB 12 .. RL D +5A2B F1 . POP AF +5A2C CD B0 5E ..^ CALL 5EB0 +5A2F CB 3A .: SLR D +5A31 CB 1B .. RR E +5A33 EB . EX DE,HL +5A34 C1 . POP BC +5A35 ED A1 .. CPI +5A37 EA 20 5A . Z JP PE,5A20 +5A3A C9 . RET +5A3B 3A AD 60 :.` LD A,(60AD) +5A3E B7 . OR A +5A3F C8 . RET Z +5A40 3E 00 >. LD A,00 +5A42 32 AD 60 2.` LD (60AD),A +5A45 01 05 00 ... LD BC,0005 +5A48 11 00 00 ... LD DE,0000 +5A4B CD A8 28 ..( CALL 28A8 +5A4E C5 . PUSH BC +5A4F 3E 02 >. LD A,02 +5A51 CD 1D 5A ..Z CALL 5A1D +5A54 C1 . POP BC +5A55 11 00 00 ... LD DE,0000 +5A58 C5 . PUSH BC +5A59 21 00 9E !.. LD HL,9E00 +5A5C 3E 00 >. LD A,00 +5A5E 01 00 00 ... LD BC,0000 +5A61 CD 7E 28 .~( CALL 287E +5A64 78 x LD A,B +5A65 B1 . OR C +5A66 20 08 . JR NZ,5A70 +5A68 C1 . POP BC +5A69 ED A1 .. CPI +5A6B 13 . INC DE +5A6C EA 58 5A .XZ JP PE,5A58 +5A6F C9 . RET +5A70 CD CA 6E ..n CALL 6ECA +5A73 62 b LD H,D +5A74 6B k LD L,E +5A75 CD 92 5A ..Z CALL 5A92 +5A78 01 00 00 ... LD BC,0000 +5A7B 97 . SUB A +5A7C CD 81 28 ..( CALL 2881 +5A7F 18 D8 .. JR 5A59 +5A81 7C | LD A,H +5A82 47 G LD B,A +5A83 FE 10 .. CP 10 +5A85 D0 . RET NC +5A86 ED 4B A2 60 .K.` LD BC,(60A2) +5A8A 18 06 .. JR 5A92 +5A8C 78 x LD A,B +5A8D FE 10 .. CP 10 +5A8F D0 . RET NC +5A90 60 ` LD H,B +5A91 69 i LD L,C +5A92 22 A2 60 ".` LD (60A2),HL +5A95 CB 3C .< SLR H +5A97 CB 1D .. RR L +5A99 7D } LD A,L +5A9A 2A AB 60 *.` LD HL,(60AB) +5A9D 30 02 0. JR NC,5AA1 +5A9F 24 $ INC H +5AA0 24 $ INC H +5AA1 2E 00 .. LD L,00 +5AA3 C3 8D 28 ..( JP 288D +5AA6 3E 03 >. LD A,03 +5AA8 FE 03 .. CP 03 +5AAA 28 1A (. JR Z,5AC6 +5AAC F5 . PUSH AF +5AAD EB . EX DE,HL +5AAE CD 92 5A ..Z CALL 5A92 +5AB1 F1 . POP AF +5AB2 01 00 02 ... LD BC,0200 +5AB5 3D = DEC A +5AB6 CA A5 28 ..( JP Z,28A5 +5AB9 EB . EX DE,HL +5ABA C3 A5 28 ..( JP 28A5 +5ABD FE 03 .. CP 03 +5ABF 30 02 0. JR NC,5AC3 +5AC1 EE 03 .. XOR 03 +5AC3 C3 8D 28 ..( JP 288D +5AC6 7B { LD A,E +5AC7 26 00 &. LD H,00 +5AC9 07 . RLCA +5ACA 07 . RLCA +5ACB 07 . RLCA +5ACC 07 . RLCA +5ACD F5 . PUSH AF +5ACE E6 0F .. AND 0F +5AD0 6F o LD L,A +5AD1 CD 92 5A ..Z CALL 5A92 +5AD4 F1 . POP AF +5AD5 17 . RLA +5AD6 30 01 0. JR NC,5AD9 +5AD8 24 $ INC H +5AD9 E6 C0 .. AND C0 +5ADB 6F o LD L,A +5ADC 01 14 00 ... LD BC,0014 +5ADF C9 . RET +5AE0 3A 5B 60 :[` LD A,(605B) +5AE3 B7 . OR A +5AE4 C0 . RET NZ +5AE5 F1 . POP AF +5AE6 F6 01 .. OR 01 +5AE8 C9 . RET +5AE9 CD E0 5A ..Z CALL 5AE0 +5AEC C5 . PUSH BC +5AED D5 . PUSH DE +5AEE E5 . PUSH HL +5AEF CD A6 5A ..Z CALL 5AA6 +5AF2 C5 . PUSH BC +5AF3 7A z LD A,D +5AF4 ED B1 .. CPIR +5AF6 C1 . POP BC +5AF7 20 13 . JR NZ,5B0C +5AF9 09 . ADD HL,BC +5AFA 2B + DEC HL +5AFB 7E ~ LD A,(HL) +5AFC CB EE .. SET 5,(HL) +5AFE 09 . ADD HL,BC +5AFF 6E n LD L,(HL) +5B00 E6 1F .. AND 1F +5B02 67 g LD H,A +5B03 D1 . POP DE +5B04 D5 . PUSH DE +5B05 EB . EX DE,HL +5B06 3E 01 >. LD A,01 +5B08 CD A8 5A ..Z CALL 5AA8 +5B0B 97 . SUB A +5B0C E1 . POP HL +5B0D D1 . POP DE +5B0E C1 . POP BC +5B0F C9 . RET +5B10 3A 5B 60 :[` LD A,(605B) +5B13 B7 . OR A +5B14 CA 27 59 .'Y JP Z,5927 +5B17 7E ~ LD A,(HL) +5B18 32 60 60 2`` LD (6060),A +5B1B CB BD .. RES 7,L +5B1D 5E ^ LD E,(HL) +5B1E 24 $ INC H +5B1F 56 V LD D,(HL) +5B20 65 e LD H,L +5B21 CB 24 .$ SLA H +5B23 2E 00 .. LD L,00 +5B25 7A z LD A,D +5B26 FE FD .. CP FD +5B28 D0 . RET NC +5B29 B7 . OR A +5B2A 20 06 . JR NZ,5B32 +5B2C 7B { LD A,E +5B2D FE 04 .. CP 04 +5B2F DA 87 5B ..[ JP C,5B87 +5B32 E5 . PUSH HL +5B33 CD A6 5A ..Z CALL 5AA6 +5B36 C5 . PUSH BC +5B37 7A z LD A,D +5B38 ED B1 .. CPIR +5B3A C1 . POP BC +5B3B 20 14 . JR NZ,5B51 +5B3D 09 . ADD HL,BC +5B3E 2B + DEC HL +5B3F CB B6 .. RES 6,(HL) +5B41 7E ~ LD A,(HL) +5B42 09 . ADD HL,BC +5B43 6E n LD L,(HL) +5B44 E6 1F .. AND 1F +5B46 67 g LD H,A +5B47 EB . EX DE,HL +5B48 E1 . POP HL +5B49 E5 . PUSH HL +5B4A 3E 02 >. LD A,02 +5B4C CD A8 5A ..Z CALL 5AA8 +5B4F E1 . POP HL +5B50 C9 . RET +5B51 3A 60 60 :`` LD A,(6060) +5B54 F5 . PUSH AF +5B55 B7 . OR A +5B56 ED 42 .B SBC HL,BC +5B58 3E FE >. LD A,FE +5B5A ED B1 .. CPIR +5B5C 20 24 $ JR NZ,5B82 +5B5E D5 . PUSH DE +5B5F CD F4 5B ..[ CALL 5BF4 +5B62 EB . EX DE,HL +5B63 D1 . POP DE +5B64 28 1C (. JR Z,5B82 +5B66 E5 . PUSH HL +5B67 CD A6 5A ..Z CALL 5AA6 +5B6A C5 . PUSH BC +5B6B 3E FE >. LD A,FE +5B6D ED B1 .. CPIR +5B6F C1 . POP BC +5B70 2B + DEC HL +5B71 72 r LD (HL),D +5B72 09 . ADD HL,BC +5B73 D1 . POP DE +5B74 72 r LD (HL),D +5B75 F1 . POP AF +5B76 CB 4F .O BIT 1,A +5B78 28 02 (. JR Z,5B7C +5B7A CB F6 .. SET 6,(HL) +5B7C CB EE .. SET 5,(HL) +5B7E 09 . ADD HL,BC +5B7F 73 s LD (HL),E +5B80 18 C6 .. JR 5B48 +5B82 F1 . POP AF +5B83 E1 . POP HL +5B84 CB 4F .O BIT 1,A +5B86 C0 . RET NZ +5B87 3E 02 >. LD A,02 +5B89 C3 82 5E ..^ JP 5E82 +5B8C 32 66 60 2f` LD (6066),A +5B8F 3A A8 5A :.Z LD A,(5AA8) +5B92 FE C3 .. CP C3 +5B94 CA CB 5B ..[ JP Z,5BCB +5B97 3A 5B 60 :[` LD A,(605B) +5B9A B7 . OR A +5B9B CA CB 5B ..[ JP Z,5BCB +5B9E C5 . PUSH BC +5B9F CD A6 5A ..Z CALL 5AA6 +5BA2 C5 . PUSH BC +5BA3 7A z LD A,D +5BA4 ED B1 .. CPIR +5BA6 C1 . POP BC +5BA7 C2 CA 5B ..[ JP NZ,5BCA +5BAA 09 . ADD HL,BC +5BAB 2B + DEC HL +5BAC CB 6E .n BIT 5,(HL) +5BAE 20 20 JR NZ,5BD0 +5BB0 3A 66 60 :f` LD A,(6066) +5BB3 CB 4F .O BIT 1,A +5BB5 20 02 . JR NZ,5BB9 +5BB7 CB B6 .. RES 6,(HL) +5BB9 7E ~ LD A,(HL) +5BBA 09 . ADD HL,BC +5BBB 6E n LD L,(HL) +5BBC E6 1F .. AND 1F +5BBE 67 g LD H,A +5BBF CD 92 5A ..Z CALL 5A92 +5BC2 C1 . POP BC +5BC3 6C l LD L,H +5BC4 CB 3D .= SLR L +5BC6 26 15 &. LD H,15 +5BC8 37 7 SCF +5BC9 C9 . RET +5BCA C1 . POP BC +5BCB CD 41 5D .A] CALL 5D41 +5BCE 18 09 .. JR 5BD9 +5BD0 22 B5 60 ".` LD (60B5),HL +5BD3 CD B6 5D ..] CALL 5DB6 +5BD6 38 15 8. JR C,5BED +5BD8 C1 . POP BC +5BD9 F5 . PUSH AF +5BDA CB FD .. SET 7,L +5BDC 3A 66 60 :f` LD A,(6066) +5BDF A6 . AND (HL) +5BE0 77 w LD (HL),A +5BE1 3A 5B 60 :[` LD A,(605B) +5BE4 B7 . OR A +5BE5 28 02 (. JR Z,5BE9 +5BE7 CB 9E .. RES 3,(HL) +5BE9 CB BD .. RES 7,L +5BEB F1 . POP AF +5BEC C9 . RET +5BED 2A B5 60 *.` LD HL,(60B5) +5BF0 CB AE .. RES 5,(HL) +5BF2 18 BC .. JR 5BB0 +5BF4 3A B0 60 :.` LD A,(60B0) +5BF7 B7 . OR A +5BF8 20 1F . JR NZ,5C19 +5BFA 2A 5C 60 *\` LD HL,(605C) +5BFD 23 # INC HL +5BFE 22 5C 60 "\` LD (605C),HL +5C01 ED 4B AE 60 .K.` LD BC,(60AE) +5C05 B7 . OR A +5C06 ED 42 .B SBC HL,BC +5C08 30 06 0. JR NC,5C10 +5C0A 09 . ADD HL,BC +5C0B 54 T LD D,H +5C0C 5D ] LD E,L +5C0D F6 01 .. OR 01 +5C0F C9 . RET +5C10 3E 01 >. LD A,01 +5C12 32 B0 60 2.` LD (60B0),A +5C15 97 . SUB A +5C16 32 5C 60 2\` LD (605C),A +5C19 ED 5B 5C 60 .[\` LD DE,(605C) +5C1D 1C . INC E +5C1E 1C . INC E +5C1F ED 53 5C 60 .S\` LD (605C),DE +5C23 CD A6 5A ..Z CALL 5AA6 +5C26 56 V LD D,(HL) +5C27 3E FE >. LD A,FE +5C29 BA . CP D +5C2A C8 . RET Z +5C2B 77 w LD (HL),A +5C2C 09 . ADD HL,BC +5C2D CB 7E .~ BIT 7,(HL) +5C2F 28 0C (. JR Z,5C3D +5C31 B7 . OR A +5C32 ED 42 .B SBC HL,BC +5C34 E5 . PUSH HL +5C35 C5 . PUSH BC +5C36 CD 50 5C .P\ CALL 5C50 +5C39 C1 . POP BC +5C3A E1 . POP HL +5C3B 18 E9 .. JR 5C26 +5C3D CD 66 5C .f\ CALL 5C66 +5C40 ED 5B 5C 60 .[\` LD DE,(605C) +5C44 CD A6 5A ..Z CALL 5AA6 +5C47 E5 . PUSH HL +5C48 09 . ADD HL,BC +5C49 7E ~ LD A,(HL) +5C4A E6 1F .. AND 1F +5C4C 57 W LD D,A +5C4D 09 . ADD HL,BC +5C4E 5E ^ LD E,(HL) +5C4F E1 . POP HL +5C50 D5 . PUSH DE +5C51 54 T LD D,H +5C52 5D ] LD E,L +5C53 23 # INC HL +5C54 C5 . PUSH BC +5C55 ED B0 .. LDIR +5C57 1B . DEC DE +5C58 3E FE >. LD A,FE +5C5A 12 . LD (DE),A +5C5B 13 . INC DE +5C5C C1 . POP BC +5C5D CB 21 .! SLA C +5C5F CB 10 .. RL B +5C61 ED B0 .. LDIR +5C63 D1 . POP DE +5C64 B7 . OR A +5C65 C9 . RET +5C66 CB 76 .v BIT 6,(HL) +5C68 C0 . RET NZ +5C69 CB F6 .. SET 6,(HL) +5C6B E5 . PUSH HL +5C6C 3A B3 60 :.` LD A,(60B3) +5C6F B7 . OR A +5C70 20 0B . JR NZ,5C7D +5C72 CD AE 5D ..] CALL 5DAE +5C75 38 06 8. JR C,5C7D +5C77 CB FD .. SET 7,L +5C79 CB 8E .. RES 1,(HL) +5C7B E1 . POP HL +5C7C C9 . RET +5C7D E1 . POP HL +5C7E D5 . PUSH DE +5C7F 7E ~ LD A,(HL) +5C80 E6 1F .. AND 1F +5C82 57 W LD D,A +5C83 09 . ADD HL,BC +5C84 5E ^ LD E,(HL) +5C85 21 00 9E !.. LD HL,9E00 +5C88 3E 01 >. LD A,01 +5C8A CD A8 5A ..Z CALL 5AA8 +5C8D 21 00 9E !.. LD HL,9E00 +5C90 D1 . POP DE +5C91 3E 02 >. LD A,02 +5C93 C3 82 5E ..^ JP 5E82 +5C96 ED 5B 5E 60 .[^` LD DE,(605E) +5C9A CD A6 5A ..Z CALL 5AA6 +5C9D 7D } LD A,L +5C9E 82 . ADD D +5C9F 6F o LD L,A +5CA0 30 01 0. JR NC,5CA3 +5CA2 24 $ INC H +5CA3 56 V LD D,(HL) +5CA4 7A z LD A,D +5CA5 FE FE .. CP FE +5CA7 28 06 (. JR Z,5CAF +5CA9 09 . ADD HL,BC +5CAA C5 . PUSH BC +5CAB CD 66 5C .f\ CALL 5C66 +5CAE C1 . POP BC +5CAF ED 5B 5E 60 .[^` LD DE,(605E) +5CB3 14 . INC D +5CB4 7A z LD A,D +5CB5 B9 . CP C +5CB6 20 04 . JR NZ,5CBC +5CB8 16 00 .. LD D,00 +5CBA 1C . INC E +5CBB 1C . INC E +5CBC ED 53 5E 60 .S^` LD (605E),DE +5CC0 C9 . RET +5CC1 E5 . PUSH HL +5CC2 2A 61 60 *a` LD HL,(6061) +5CC5 CD 92 5A ..Z CALL 5A92 +5CC8 E1 . POP HL +5CC9 C9 . RET +5CCA CD 20 6E . n CALL 6E20 +5CCD CD D4 5C ..\ CALL 5CD4 +5CD0 CD 2A 6E .*n CALL 6E2A +5CD3 C9 . RET +5CD4 32 9C 60 2.` LD (609C),A +5CD7 3A B4 60 :.` LD A,(60B4) +5CDA 3D = DEC A +5CDB C8 . RET Z +5CDC 32 B4 60 2.` LD (60B4),A +5CDF 3A A8 5A :.Z LD A,(5AA8) +5CE2 FE C3 .. CP C3 +5CE4 C8 . RET Z +5CE5 3A AD 60 :.` LD A,(60AD) +5CE8 B7 . OR A +5CE9 CC E0 5A ..Z CALL Z,5AE0 +5CEC 3A 9C 60 :.` LD A,(609C) +5CEF 26 15 &. LD H,15 +5CF1 6F o LD L,A +5CF2 CB 3D .= SLR L +5CF4 E5 . PUSH HL +5CF5 5E ^ LD E,(HL) +5CF6 24 $ INC H +5CF7 56 V LD D,(HL) +5CF8 3A AD 60 :.` LD A,(60AD) +5CFB B7 . OR A +5CFC 20 32 2 JR NZ,5D30 +5CFE CD A6 5A ..Z CALL 5AA6 +5D01 C5 . PUSH BC +5D02 7A z LD A,D +5D03 ED B1 .. CPIR +5D05 C1 . POP BC +5D06 20 30 0 JR NZ,5D38 +5D08 09 . ADD HL,BC +5D09 2B + DEC HL +5D0A 7E ~ LD A,(HL) +5D0B E6 1F .. AND 1F +5D0D CB FE .. SET 7,(HL) +5D0F 09 . ADD HL,BC +5D10 47 G LD B,A +5D11 4E N LD C,(HL) +5D12 E1 . POP HL +5D13 36 01 6. LD (HL),01 +5D15 24 $ INC H +5D16 CB FD .. SET 7,L +5D18 36 FF 6. LD (HL),FF +5D1A CB BD .. RES 7,L +5D1C 24 $ INC H +5D1D 24 $ INC H +5D1E 7E ~ LD A,(HL) +5D1F 87 . ADD A +5D20 21 B7 60 !.` LD HL,60B7 +5D23 30 01 0. JR NC,5D26 +5D25 24 $ INC H +5D26 85 . ADD L +5D27 6F o LD L,A +5D28 30 01 0. JR NC,5D2B +5D2A 24 $ INC H +5D2B 0D . DEC C +5D2C 71 q LD (HL),C +5D2D 23 # INC HL +5D2E 70 p LD (HL),B +5D2F C9 . RET +5D30 42 B LD B,D +5D31 4B K LD C,E +5D32 CB 28 .( SRA B +5D34 CB 19 .. RR C +5D36 18 DA .. JR 5D12 +5D38 21 B4 60 !.` LD HL,60B4 +5D3B 34 4 INC (HL) +5D3C E1 . POP HL +5D3D C9 . RET +5D3E C3 8C 5B ..[ JP 5B8C +5D41 21 B5 4C !.L LD HL,4CB5 +5D44 CB D6 .. SET 2,(HL) +5D46 CD B6 5D ..] CALL 5DB6 +5D49 D2 A6 5D ..] JP NC,5DA6 +5D4C 3A 5B 60 :[` LD A,(605B) +5D4F B7 . OR A +5D50 28 33 (3 JR Z,5D85 +5D52 CD A6 5A ..Z CALL 5AA6 +5D55 7A z LD A,D +5D56 ED B1 .. CPIR +5D58 20 2B + JR NZ,5D85 +5D5A CD F7 58 ..X CALL 58F7 +5D5D CB 4E .N BIT 1,(HL) +5D5F 20 16 . JR NZ,5D77 +5D61 D5 . PUSH DE +5D62 E5 . PUSH HL +5D63 CB BD .. RES 7,L +5D65 5E ^ LD E,(HL) +5D66 24 $ INC H +5D67 56 V LD D,(HL) +5D68 24 $ INC H +5D69 7E ~ LD A,(HL) +5D6A B7 . OR A +5D6B 28 16 (. JR Z,5D83 +5D6D CD A6 5A ..Z CALL 5AA6 +5D70 7A z LD A,D +5D71 ED B1 .. CPIR +5D73 E1 . POP HL +5D74 D1 . POP DE +5D75 20 0E . JR NZ,5D85 +5D77 22 9D 60 ".` LD (609D),HL +5D7A CD 45 59 .EY CALL 5945 +5D7D 21 00 00 !.. LD HL,0000 +5D80 C3 9C 5D ..] JP 5D9C +5D83 E1 . POP HL +5D84 D1 . POP DE +5D85 21 20 16 ! . LD HL,1620 +5D88 3E FD >. LD A,FD +5D8A ED A1 .. CPI +5D8C 20 0B . JR NZ,5D99 +5D8E 2B + DEC HL +5D8F 72 r LD (HL),D +5D90 25 % DEC H +5D91 73 s LD (HL),E +5D92 E5 . PUSH HL +5D93 21 63 60 !c` LD HL,6063 +5D96 34 4 INC (HL) +5D97 18 04 .. JR 5D9D +5D99 21 63 60 !c` LD HL,6063 +5D9C E5 . PUSH HL +5D9D 21 B5 4C !.L LD HL,4CB5 +5DA0 CB 96 .. RES 2,(HL) +5DA2 E1 . POP HL +5DA3 C3 1A 6C ..l JP 6C1A +5DA6 E5 . PUSH HL +5DA7 21 B5 4C !.L LD HL,4CB5 +5DAA CB 96 .. RES 2,(HL) +5DAC E1 . POP HL +5DAD C9 . RET +5DAE CD CD 5D ..] CALL 5DCD +5DB1 D8 . RET C +5DB2 7D } LD A,L +5DB3 FE 28 .( CP 28 +5DB5 C9 . RET +5DB6 CD CD 5D ..] CALL 5DCD +5DB9 D8 . RET C +5DBA 7D } LD A,L +5DBB FE 28 .( CP 28 +5DBD DA 1A 6C ..l JP C,6C1A +5DC0 CB FD .. SET 7,L +5DC2 CB 46 .F BIT 0,(HL) +5DC4 C2 1A 6C ..l JP NZ,6C1A +5DC7 CB DE .. SET 3,(HL) +5DC9 CB BD .. RES 7,L +5DCB B7 . OR A +5DCC C9 . RET +5DCD CB 83 .. RES 0,E +5DCF C5 . PUSH BC +5DD0 7B { LD A,E +5DD1 AA . XOR D +5DD2 6F o LD L,A +5DD3 26 14 &. LD H,14 +5DD5 6E n LD L,(HL) +5DD6 26 15 &. LD H,15 +5DD8 7B { LD A,E +5DD9 BE . CP (HL) +5DDA 20 09 . JR NZ,5DE5 +5DDC 24 $ INC H +5DDD 7A z LD A,D +5DDE BE . CP (HL) +5DDF 20 04 . JR NZ,5DE5 +5DE1 25 % DEC H +5DE2 B7 . OR A +5DE3 C1 . POP BC +5DE4 C9 . RET +5DE5 21 1F 15 !.. LD HL,151F +5DE8 01 62 00 .b. LD BC,0062 +5DEB 7B { LD A,E +5DEC ED B1 .. CPIR +5DEE E2 08 5E ..^ JP PO,5E08 +5DF1 7A z LD A,D +5DF2 24 $ INC H +5DF3 2D - DEC L +5DF4 BE . CP (HL) +5DF5 28 04 (. JR Z,5DFB +5DF7 2C , INC L +5DF8 25 % DEC H +5DF9 18 F0 .. JR 5DEB +5DFB 25 % DEC H +5DFC E5 . PUSH HL +5DFD 45 E LD B,L +5DFE 7B { LD A,E +5DFF AA . XOR D +5E00 6F o LD L,A +5E01 26 14 &. LD H,14 +5E03 70 p LD (HL),B +5E04 E1 . POP HL +5E05 C1 . POP BC +5E06 B7 . OR A +5E07 C9 . RET +5E08 C1 . POP BC +5E09 37 7 SCF +5E0A C9 . RET +5E0B 7C | LD A,H +5E0C FE 10 .. CP 10 +5E0E D8 . RET C +5E0F 37 7 SCF +5E10 CB 1C .. RR H +5E12 6C l LD L,H +5E13 26 15 &. LD H,15 +5E15 CB 86 .. RES 0,(HL) +5E17 C9 . RET +5E18 CD 8A 28 ..( CALL 288A +5E1B CB 70 .p BIT 6,B +5E1D 20 1A . JR NZ,5E39 +5E1F 3A 5B 60 :[` LD A,(605B) +5E22 B7 . OR A +5E23 28 14 (. JR Z,5E39 +5E25 21 A4 60 !.` LD HL,60A4 +5E28 CB 4E .N BIT 1,(HL) +5E2A 20 05 . JR NZ,5E31 +5E2C 36 00 6. LD (HL),00 +5E2E C3 1A 6C ..l JP 6C1A +5E31 36 01 6. LD (HL),01 +5E33 2A A5 60 *.` LD HL,(60A5) +5E36 7C | LD A,H +5E37 B5 . OR L +5E38 C0 . RET NZ +5E39 CD 42 5E .B^ CALL 5E42 +5E3C 65 e LD H,L +5E3D CB 24 .$ SLA H +5E3F 2E 00 .. LD L,00 +5E41 C9 . RET +5E42 2A 9F 60 *.` LD HL,(609F) +5E45 22 9D 60 ".` LD (609D),HL +5E48 11 18 FF ... LD DE,FF18 +5E4B CD 41 5D .A] CALL 5D41 +5E4E CB C6 .. SET 0,(HL) +5E50 CB FD .. SET 7,L +5E52 CB C6 .. SET 0,(HL) +5E54 CB BD .. RES 7,L +5E56 C9 . RET +5E57 01 01 00 ... LD BC,0001 +5E5A C9 . RET ;-------------------------------- +5E5B 7C | LD A,H +5E5C FE A0 .. CP A0 +5E5E 38 F7 8. JR C,5E57 +5E60 37 7 SCF +5E61 1F . RRA +5E62 41 A LD B,C +5E63 80 . ADD B +5E64 38 F1 8. JR C,5E57 +5E66 E5 . PUSH HL +5E67 21 A1 60 !.` LD HL,60A1 +5E6A 3D = DEC A +5E6B BE . CP (HL) +5E6C E1 . POP HL +5E6D 30 E8 0. JR NC,5E57 +5E6F CD 20 6E . n CALL 6E20 +5E72 6C l LD L,H +5E73 37 7 SCF +5E74 CB 1D .. RR L +5E76 26 15 &. LD H,15 +5E78 CD B9 5F .._ CALL 5FB9 +5E7B CD 2A 6E .*n CALL 6E2A +5E7E 01 00 00 ... LD BC,0000 +5E81 C9 . RET +5E82 E5 . PUSH HL +5E83 21 B5 4C !.L LD HL,4CB5 +5E86 CB FE .. SET 7,(HL) +5E88 CB 96 .. RES 2,(HL) +5E8A E1 . POP HL +5E8B 47 G LD B,A +5E8C 3A AD 60 :.` LD A,(60AD) +5E8F B7 . OR A +5E90 78 x LD A,B +5E91 20 0D . JR NZ,5EA0 +5E93 CD B0 5E ..^ CALL 5EB0 +5E96 E5 . PUSH HL +5E97 21 B5 4C !.L LD HL,4CB5 +5E9A CB BE .. RES 7,(HL) +5E9C CB D6 .. SET 2,(HL) +5E9E E1 . POP HL +5E9F C9 . RET +5EA0 E5 . PUSH HL +5EA1 D5 . PUSH DE +5EA2 CB 2A .* SRA D +5EA4 CB 1B .. RR E +5EA6 CD A8 5A ..Z CALL 5AA8 +5EA9 D1 . POP DE +5EAA E1 . POP HL +5EAB 18 E9 .. JR 5E96 +5EAD CD 2A 6E .*n CALL 6E2A +5EB0 06 32 .2 LD B,32 +5EB2 F5 . PUSH AF +5EB3 C5 . PUSH BC +5EB4 E5 . PUSH HL +5EB5 01 00 00 ... LD BC,0000 +5EB8 CB 3A .: SLR D +5EBA CB 1B .. RR E +5EBC FE 02 .. CP 02 +5EBE 3E 00 >. LD A,00 +5EC0 28 05 (. JR Z,5EC7 +5EC2 CD 7E 28 .~( CALL 287E +5EC5 18 03 .. JR 5ECA +5EC7 CD 81 28 ..( CALL 2881 +5ECA CB 23 .# SLA E +5ECC CB 12 .. RL D +5ECE 79 y LD A,C +5ECF B0 . OR B +5ED0 28 66 (f JR Z,5F38 +5ED2 22 A9 60 ".` LD (60A9),HL +5ED5 E1 . POP HL +5ED6 C1 . POP BC +5ED7 F1 . POP AF +5ED8 10 D8 .. DJNZ 5EB2 +5EDA CD 20 6E . n CALL 6E20 +5EDD 21 67 60 !g` LD HL,6067 +5EE0 CD CA 6E ..n CALL 6ECA +5EE3 2A A9 60 *.` LD HL,(60A9) +5EE6 CD CA 6E ..n CALL 6ECA +5EE9 21 6B 60 !k` LD HL,606B +5EEC CD CA 6E ..n CALL 6ECA ; noch ein Versuch (j) +5EEF CD 9E 6E ..n CALL 6E9E +5EF2 FE 64 .d CP 64 ; "d" Diskerror +5EF4 28 2D (- JR Z,5F23 +5EF6 FE 6A .j CP 6A ; "j" nochmal +5EF8 28 B3 (. JR Z,5EAD +5EFA FE 59 .Y CP 59 ; "Y" Mark +5EFC 20 DF . JR NZ,5EDD +5EFE 21 84 60 !.` LD HL,6084 +5F01 CD CA 6E ..n CALL 6ECA +5F04 CD 9E 6E ..n CALL 6E9E +5F07 FE 10 .. CP 10 +5F09 20 D2 . JR NZ,5EDD +5F0B CD 2A 6E .*n CALL 6E2A +5F0E CD 20 6E . n CALL 6E20 +5F11 01 FE 01 ... LD BC,01FE +5F14 23 # INC HL +5F15 54 T LD D,H +5F16 5D ] LD E,L +5F17 13 . INC DE +5F18 36 FF 6. LD (HL),FF +5F1A 2B + DEC HL +5F1B 36 FD 6. LD (HL),FD +5F1D ED B0 .. LDIR +5F1F CD 2A 6E .*n CALL 6E2A +5F22 C9 . RET +5F23 CD 2A 6E .*n CALL 6E2A +5F26 CD 1F 70 ..p CALL 701F ; Info aufrufen +5F29 18 0B .. JR 5F36 +5F2B 20 44 D JR NZ,5F71 ; " DISK ERROR" +5F2D 49 I LD C,C +5F2E 53 S LD D,E +5F2F 4B K LD C,E +5F30 20 45 E JR NZ,5F77 +5F32 52 R LD D,D +5F33 52 R LD D,D +5F34 4F O LD C,A +5F35 52 R LD D,D +5F36 18 A2 .. JR 5EDA +5F38 E1 . POP HL +5F39 C1 . POP BC +5F3A F1 . POP AF +5F3B C9 . RET +5F3C 2C , INC L +5F3D CB FD .. SET 7,L +5F3F 3A A1 60 :.` LD A,(60A1) +5F42 BD . CP L +5F43 C0 . RET NZ +5F44 2A 9F 60 *.` LD HL,(609F) +5F47 C9 . RET +5F48 7C | LD A,H +5F49 21 B7 60 !.` LD HL,60B7 +5F4C 87 . ADD A +5F4D 30 01 0. JR NC,5F50 +5F4F 24 $ INC H +5F50 85 . ADD L +5F51 6F o LD L,A +5F52 30 01 0. JR NC,5F55 +5F54 24 $ INC H +5F55 7E ~ LD A,(HL) +5F56 3C < INC A +5F57 C8 . RET Z +5F58 23 # INC HL +5F59 66 f LD H,(HL) +5F5A 6F o LD L,A +5F5B 22 61 60 "a` LD (6061),HL +5F5E CD 92 5A ..Z CALL 5A92 +5F61 7C | LD A,H +5F62 CB 3F .? SLR A +5F64 C9 . RET +5F65 CD 6B 5F .k_ CALL 5F6B +5F68 CB 86 .. RES 0,(HL) +5F6A C9 . RET +5F6B 3E 01 >. LD A,01 +5F6D C5 . PUSH BC +5F6E E5 . PUSH HL +5F6F 47 G LD B,A +5F70 CD 0E 6E ..n CALL 6E0E +5F73 FE 41 .A CP 41 +5F75 78 x LD A,B +5F76 28 09 (. JR Z,5F81 +5F78 22 97 60 ".` LD (6097),HL +5F7B 21 96 60 !.` LD HL,6096 +5F7E 77 w LD (HL),A +5F7F 18 07 .. JR 5F88 +5F81 22 9A 60 ".` LD (609A),HL +5F84 21 99 60 !.` LD HL,6099 +5F87 77 w LD (HL),A +5F88 E5 . PUSH HL +5F89 21 B5 4C !.L LD HL,4CB5 +5F8C CB 96 .. RES 2,(HL) +5F8E CD E2 6D ..m CALL 6DE2 +5F91 E1 . POP HL +5F92 7E ~ LD A,(HL) +5F93 B7 . OR A +5F94 20 F2 . JR NZ,5F88 +5F96 E1 . POP HL +5F97 C1 . POP BC +5F98 C9 . RET +5F99 E5 . PUSH HL +5F9A 21 00 00 !.. LD HL,0000 +5F9D 22 5E 60 "^` LD (605E),HL +5FA0 E1 . POP HL +5FA1 3E 02 >. LD A,02 +5FA3 18 C8 .. JR 5F6D +5FA5 CD 1F 70 ..p CALL 701F +5FA8 18 04 .. JR 5FAE +5FAA 20 52 R JR NZ,5FFE +5FAC 45 E LD B,L +5FAD 53 S LD D,E +5FAE C3 44 58 .DX JP 5844 +5FB1 21 D0 15 !.. LD HL,15D0 +5FB4 47 G LD B,A +5FB5 ED 43 64 60 .Cd` LD (6064),BC +5FB9 CD 6B 5F .k_ CALL 5F6B +5FBC 24 $ INC H +5FBD 36 FF 6. LD (HL),FF +5FBF 25 % DEC H +5FC0 CB BD .. RES 7,L +5FC2 CB C6 .. SET 0,(HL) +5FC4 CB FD .. SET 7,L +5FC6 2C , INC L +5FC7 10 F0 .. DJNZ 5FB9 +5FC9 21 00 A0 !.. LD HL,A000 +5FCC C9 . RET +5FCD 3A 17 82 :.. LD A,(8217) ; musta +5FD0 CB 67 .g BIT 4,A +5FD2 20 27 ' JR NZ,5FFB ; Bit 4 = System-Aufbau +5FD4 21 28 16 !(. LD HL,1628 +5FD7 7E ~ LD A,(HL) +5FD8 57 W LD D,A +5FD9 FE FD .. CP FD +5FDB 30 1A 0. JR NC,5FF7 +5FDD 25 % DEC H +5FDE 5E ^ LD E,(HL) +5FDF CD A8 56 ..V CALL 56A8 +5FE2 20 12 . JR NZ,5FF6 +5FE4 7B { LD A,E +5FE5 BE . CP (HL) +5FE6 20 0E . JR NZ,5FF6 +5FE8 24 $ INC H +5FE9 7A z LD A,D +5FEA BE . CP (HL) +5FEB 20 0A . JR NZ,5FF7 +5FED 25 % DEC H +5FEE CB C6 .. SET 0,(HL) +5FF0 CB FD .. SET 7,L +5FF2 36 02 6. LD (HL),02 +5FF4 CB BD .. RES 7,L +5FF6 24 $ INC H +5FF7 2C , INC L +5FF8 F2 D7 5F .._ JP P,5FD7 +5FFB 3A 5B 60 :[` LD A,(605B) +5FFE B7 . OR A +5FFF 28 12 (. JR Z,6013 +6001 1E 00 .. LD E,00 +6003 D5 . PUSH DE +6004 CD A6 5A ..Z CALL 5AA6 +6007 09 . ADD HL,BC +6008 41 A LD B,C +6009 CB EE .. SET 5,(HL) +600B 23 # INC HL +600C 10 FB .. DJNZ 6009 +600E D1 . POP DE +600F 1C . INC E +6010 1C . INC E +6011 20 F0 . JR NZ,6003 +6013 ED 4B 64 60 .Kd` LD BC,(6064) +6017 21 D0 15 !.. LD HL,15D0 +601A CB 86 .. RES 0,(HL) +601C 2C , INC L +601D C8 . RET Z +601E 10 FA .. DJNZ 601A +6020 C9 . RET ;------------------------------- +6021 E5 . PUSH HL +6022 41 A LD B,C +6023 6C l LD L,H +6024 37 7 SCF +6025 CB 1D .. RR L +6027 26 15 &. LD H,15 +6029 CD 1A 60 ..` CALL 601A +602C E1 . POP HL +602D C9 . RET +602E CD B6 5D ..] CALL 5DB6 +6031 30 18 0. JR NC,604B +6033 7A z LD A,D +6034 32 1F 16 2.. LD (161F),A +6037 7B { LD A,E +6038 32 1F 15 2.. LD (151F),A +603B C5 . PUSH BC +603C D5 . PUSH DE +603D CD E2 6D ..m CALL 6DE2 +6040 3A 1F 16 :.. LD A,(161F) +6043 FE FD .. CP FD +6045 20 F6 . JR NZ,603D +6047 D1 . POP DE +6048 C1 . POP BC +6049 18 E3 .. JR 602E +604B 65 e LD H,L +604C CB 24 .$ SLA H +604E 2E 00 .. LD L,00 +6050 C9 . RET +6051 3E 01 >. LD A,01 +6053 32 B3 60 2.` LD (60B3),A +6056 C9 . RET +6057 21 A8 15 !.. LD HL,15A8 +605A C9 . RET +605B 00 . NOP +605C 0F . RRCA +605D 00 . NOP +605E 00 . NOP +605F 00 . NOP +6060 00 . NOP +6061 00 . NOP +6062 00 . NOP +6063 00 . NOP +6064 01 01 FF ... LD BC,FF01 +6067 03 . INC BC +6068 06 17 .. LD B,17 +606A 00 . NOP +606B 18 20 . JR 608D +606D 6E n LD L,(HL) ; "noch ein Versuch" +606E 6F o LD L,A +606F 63 c LD H,E +6070 68 h LD L,B +6071 20 65 e JR NZ,60D8 +6073 69 i LD L,C +6074 6E n LD L,(HL) +6075 20 56 V JR NZ,60CD +6077 65 e LD H,L +6078 72 r LD (HL),D +6079 73 s LD (HL),E +607A 75 u LD (HL),L +607B 63 c LD H,E +607C 68 h LD L,B +607D 20 28 ( JR NZ,60A7 +607F 6A j LD L,D +6080 29 ) ADD HL,HL +6081 20 3F ? JR NZ,60C2 +6083 20 11 . JR NZ,6096 +6085 20 69 i JR NZ,60F0 ; "ignore (MARK) ?" +6087 67 g LD H,A +6088 6E n LD L,(HL) +6089 6F o LD L,A +608A 72 r LD (HL),D +608B 65 e LD H,L +608C 20 28 ( JR NZ,60B6 +608E 4D M LD C,L +608F 41 A LD B,C +6090 52 R LD D,D +6091 4B K LD C,E +6092 29 ) ADD HL,HL +6093 20 3F ? JR NZ,60D4 +6095 20 00 . JR NZ,6097 +6097 FF . RST 38 +6098 FF . RST 38 +6099 00 . NOP +609A FF . RST 38 +609B FF . RST 38 +609C 00 . NOP +609D DA 15 00 ... JP C,0015 +60A0 00 . NOP +60A1 00 . NOP +60A2 00 . NOP +60A3 00 . NOP +60A4 01 00 00 ... LD BC,0000 +60A7 00 . NOP +60A8 00 . NOP +60A9 00 . NOP +60AA 00 . NOP +60AB 00 . NOP +60AC 00 . NOP +60AD 00 . NOP +60AE 00 . NOP +60AF 00 . NOP +60B0 00 . NOP +60B1 20 16 . JR NZ,60C9 +60B3 00 . NOP +60B4 FF . RST 38 +60B5 00 . NOP +60B6 00 . NOP +60B7 FF . RST 38 +60B8 FF . RST 38 +60B9 FF . RST 38 +60BA FF . RST 38 +60BB FF . RST 38 +60BC FF . RST 38 +60BD FF . RST 38 +60BE FF . RST 38 +60BF FF . RST 38 +60C0 FF . RST 38 +60C1 FF . RST 38 +60C2 FF . RST 38 +60C3 FF . RST 38 +60C4 FF . RST 38 +60C5 FF . RST 38 +60C6 FF . RST 38 +60C7 FF . RST 38 +60C8 FF . RST 38 +60C9 FF . RST 38 +60CA FF . RST 38 +60CB FF . RST 38 +60CC FF . RST 38 +60CD FF . RST 38 +60CE FF . RST 38 +60CF FF . RST 38 +60D0 FF . RST 38 +60D1 FF . RST 38 +60D2 FF . RST 38 +60D3 FF . RST 38 +60D4 FF . RST 38 +60D5 FF . RST 38 +60D6 FF . RST 38 +60D7 FF . RST 38 +60D8 FF . RST 38 +60D9 FF . RST 38 +60DA FF . RST 38 +60DB FF . RST 38 +60DC FF . RST 38 +60DD FF . RST 38 +60DE FF . RST 38 +60DF FF . RST 38 +60E0 FF . RST 38 +60E1 FF . RST 38 +60E2 FF . RST 38 +60E3 FF . RST 38 +60E4 FF . RST 38 +60E5 FF . RST 38 +60E6 FF . RST 38 +60E7 FF . RST 38 +60E8 FF . RST 38 +60E9 FF . RST 38 +60EA FF . RST 38 +60EB FF . RST 38 +60EC FF . RST 38 +60ED FF . RST 38 +60EE FF . RST 38 +60EF FF . RST 38 +60F0 FF . RST 38 +60F1 FF . RST 38 +60F2 FF . RST 38 +60F3 FF . RST 38 +60F4 FF . RST 38 +60F5 FF . RST 38 +60F6 FF . RST 38 +60F7 FF . RST 38 +60F8 FF . RST 38 +60F9 FF . RST 38 +60FA FF . RST 38 +60FB FF . RST 38 +60FC FF . RST 38 +60FD FF . RST 38 +60FE FF . RST 38 +60FF FF . RST 38 +6100 FF . RST 38 +6101 FF . RST 38 +6102 FF . RST 38 +6103 FF . RST 38 +6104 FF . RST 38 +6105 FF . RST 38 +6106 FF . RST 38 +6107 FF . RST 38 +6108 FF . RST 38 +6109 FF . RST 38 +610A FF . RST 38 +610B FF . RST 38 +610C FF . RST 38 +610D FF . RST 38 +610E FF . RST 38 +610F FF . RST 38 +6110 FF . RST 38 +6111 FF . RST 38 +6112 FF . RST 38 +6113 FF . RST 38 +6114 FF . RST 38 +6115 FF . RST 38 +6116 FF . RST 38 +6117 FF . RST 38 +6118 FF . RST 38 +6119 FF . RST 38 +611A FF . RST 38 +611B FF . RST 38 +611C FF . RST 38 +611D FF . RST 38 +611E FF . RST 38 +611F FF . RST 38 +6120 FF . RST 38 +6121 FF . RST 38 +6122 FF . RST 38 +6123 FF . RST 38 +6124 FF . RST 38 +6125 FF . RST 38 +6126 FF . RST 38 +6127 FF . RST 38 +6128 FF . RST 38 +6129 FF . RST 38 +612A FF . RST 38 +612B FF . RST 38 +612C FF . RST 38 +612D FF . RST 38 +612E FF . RST 38 +612F FF . RST 38 +6130 FF . RST 38 +6131 FF . RST 38 +6132 FF . RST 38 +6133 FF . RST 38 +6134 FF . RST 38 +6135 FF . RST 38 +6136 FF . RST 38 +6137 FF . RST 38 +6138 FF . RST 38 +6139 FF . RST 38 +613A FF . RST 38 +613B FF . RST 38 +613C FF . RST 38 +613D FF . RST 38 +613E FF . RST 38 +613F FF . RST 38 +6140 FF . RST 38 +6141 FF . RST 38 +6142 FF . RST 38 +6143 FF . RST 38 +6144 FF . RST 38 +6145 FF . RST 38 +6146 FF . RST 38 +6147 FF . RST 38 +6148 FF . RST 38 +6149 FF . RST 38 +614A FF . RST 38 +614B FF . RST 38 +614C FF . RST 38 +614D FF . RST 38 +614E FF . RST 38 +614F FF . RST 38 +6150 FF . RST 38 +6151 FF . RST 38 +6152 FF . RST 38 +6153 FF . RST 38 +6154 FF . RST 38 +6155 FF . RST 38 +6156 FF . RST 38 +6157 FF . RST 38 +6158 FF . RST 38 +6159 FF . RST 38 +615A FF . RST 38 +615B FF . RST 38 +615C FF . RST 38 +615D FF . RST 38 +615E FF . RST 38 +615F FF . RST 38 +6160 FF . RST 38 +6161 FF . RST 38 +6162 FF . RST 38 +6163 FF . RST 38 +6164 FF . RST 38 +6165 FF . RST 38 +6166 FF . RST 38 +6167 FF . RST 38 +6168 FF . RST 38 +6169 FF . RST 38 +616A FF . RST 38 +616B FF . RST 38 +616C FF . RST 38 +616D FF . RST 38 +616E FF . RST 38 +616F FF . RST 38 +6170 FF . RST 38 +6171 FF . RST 38 +6172 FF . RST 38 +6173 FF . RST 38 +6174 FF . RST 38 +6175 FF . RST 38 +6176 FF . RST 38 +6177 FF . RST 38 +6178 FF . RST 38 +6179 FF . RST 38 +617A FF . RST 38 +617B FF . RST 38 +617C FF . RST 38 +617D FF . RST 38 +617E FF . RST 38 +617F FF . RST 38 +6180 FF . RST 38 +6181 FF . RST 38 +6182 FF . RST 38 +6183 FF . RST 38 +6184 FF . RST 38 +6185 FF . RST 38 +6186 FF . RST 38 +6187 FF . RST 38 +6188 FF . RST 38 +6189 FF . RST 38 +618A FF . RST 38 +618B FF . RST 38 +618C FF . RST 38 +618D FF . RST 38 +618E FF . RST 38 +618F FF . RST 38 +6190 FF . RST 38 +6191 FF . RST 38 +6192 FF . RST 38 +6193 FF . RST 38 +6194 FF . RST 38 +6195 FF . RST 38 +6196 FF . RST 38 +6197 FF . RST 38 +6198 FF . RST 38 +6199 FF . RST 38 +619A FF . RST 38 +619B FF . RST 38 +619C FF . RST 38 +619D FF . RST 38 +619E FF . RST 38 +619F FF . RST 38 +61A0 FF . RST 38 +61A1 FF . RST 38 +61A2 FF . RST 38 +61A3 FF . RST 38 +61A4 FF . RST 38 +61A5 FF . RST 38 +61A6 FF . RST 38 +61A7 FF . RST 38 +61A8 FF . RST 38 +61A9 FF . RST 38 +61AA FF . RST 38 +61AB FF . RST 38 +61AC FF . RST 38 +61AD FF . RST 38 +61AE FF . RST 38 +61AF FF . RST 38 +61B0 FF . RST 38 +61B1 FF . RST 38 +61B2 FF . RST 38 +61B3 FF . RST 38 +61B4 FF . RST 38 +61B5 FF . RST 38 +61B6 FF . RST 38 +61B7 FF . RST 38 +61B8 FF . RST 38 +61B9 FF . RST 38 +61BA FF . RST 38 +61BB FF . RST 38 +61BC FF . RST 38 +61BD FF . RST 38 +61BE FF . RST 38 +61BF FF . RST 38 +61C0 FF . RST 38 +61C1 FF . RST 38 +61C2 FF . RST 38 +61C3 FF . RST 38 +61C4 FF . RST 38 +61C5 FF . RST 38 +61C6 FF . RST 38 +61C7 FF . RST 38 +61C8 FF . RST 38 +61C9 FF . RST 38 +61CA FF . RST 38 +61CB FF . RST 38 +61CC FF . RST 38 +61CD FF . RST 38 +61CE FF . RST 38 +61CF FF . RST 38 +61D0 FF . RST 38 +61D1 FF . RST 38 +61D2 FF . RST 38 +61D3 FF . RST 38 +61D4 FF . RST 38 +61D5 FF . RST 38 +61D6 FF . RST 38 +61D7 FF . RST 38 +61D8 FF . RST 38 +61D9 FF . RST 38 +61DA FF . RST 38 +61DB FF . RST 38 +61DC FF . RST 38 +61DD FF . RST 38 +61DE FF . RST 38 +61DF FF . RST 38 +61E0 FF . RST 38 +61E1 FF . RST 38 +61E2 FF . RST 38 +61E3 FF . RST 38 +61E4 FF . RST 38 +61E5 FF . RST 38 +61E6 FF . RST 38 +61E7 FF . RST 38 +61E8 FF . RST 38 +61E9 FF . RST 38 +61EA FF . RST 38 +61EB FF . RST 38 +61EC FF . RST 38 +61ED FF . RST 38 +61EE FF . RST 38 +61EF FF . RST 38 +61F0 FF . RST 38 +61F1 FF . RST 38 +61F2 FF . RST 38 +61F3 FF . RST 38 +61F4 FF . RST 38 +61F5 FF . RST 38 +61F6 FF . RST 38 +61F7 FF . RST 38 +61F8 FF . RST 38 +61F9 FF . RST 38 +61FA FF . RST 38 +61FB FF . RST 38 +61FC FF . RST 38 +61FD FF . RST 38 +61FE FF . RST 38 +61FF FF . RST 38 +6200 FF . RST 38 +6201 FF . RST 38 +6202 FF . RST 38 +6203 FF . RST 38 +6204 FF . RST 38 +6205 FF . RST 38 +6206 FF . RST 38 +6207 FF . RST 38 +6208 FF . RST 38 +6209 FF . RST 38 +620A FF . RST 38 +620B FF . RST 38 +620C FF . RST 38 +620D FF . RST 38 +620E FF . RST 38 +620F FF . RST 38 +6210 FF . RST 38 +6211 FF . RST 38 +6212 FF . RST 38 +6213 FF . RST 38 +6214 FF . RST 38 +6215 FF . RST 38 +6216 FF . RST 38 +6217 FF . RST 38 +6218 FF . RST 38 +6219 FF . RST 38 +621A FF . RST 38 +621B FF . RST 38 +621C FF . RST 38 +621D FF . RST 38 +621E FF . RST 38 +621F FF . RST 38 +6220 FF . RST 38 +6221 FF . RST 38 +6222 FF . RST 38 +6223 FF . RST 38 +6224 FF . RST 38 +6225 FF . RST 38 +6226 FF . RST 38 +6227 FF . RST 38 +6228 FF . RST 38 +6229 FF . RST 38 +622A FF . RST 38 +622B FF . RST 38 +622C FF . RST 38 +622D FF . RST 38 +622E FF . RST 38 +622F FF . RST 38 +6230 FF . RST 38 +6231 FF . RST 38 +6232 FF . RST 38 +6233 FF . RST 38 +6234 FF . RST 38 +6235 FF . RST 38 +6236 FF . RST 38 +6237 FF . RST 38 +6238 FF . RST 38 +6239 FF . RST 38 +623A FF . RST 38 +623B FF . RST 38 +623C FF . RST 38 +623D FF . RST 38 +623E FF . RST 38 +623F FF . RST 38 +6240 FF . RST 38 +6241 FF . RST 38 +6242 FF . RST 38 +6243 FF . RST 38 +6244 FF . RST 38 +6245 FF . RST 38 +6246 FF . RST 38 +6247 FF . RST 38 +6248 FF . RST 38 +6249 FF . RST 38 +624A FF . RST 38 +624B FF . RST 38 +624C FF . RST 38 +624D FF . RST 38 +624E FF . RST 38 +624F FF . RST 38 +6250 FF . RST 38 +6251 FF . RST 38 +6252 FF . RST 38 +6253 FF . RST 38 +6254 FF . RST 38 +6255 FF . RST 38 +6256 FF . RST 38 +6257 FF . RST 38 +6258 FF . RST 38 +6259 FF . RST 38 +625A FF . RST 38 +625B FF . RST 38 +625C FF . RST 38 +625D FF . RST 38 +625E FF . RST 38 +625F FF . RST 38 +6260 FF . RST 38 +6261 FF . RST 38 +6262 FF . RST 38 +6263 FF . RST 38 +6264 FF . RST 38 +6265 FF . RST 38 +6266 FF . RST 38 +6267 FF . RST 38 +6268 FF . RST 38 +6269 FF . RST 38 +626A FF . RST 38 +626B FF . RST 38 +626C FF . RST 38 +626D FF . RST 38 +626E FF . RST 38 +626F FF . RST 38 +6270 FF . RST 38 +6271 FF . RST 38 +6272 FF . RST 38 +6273 FF . RST 38 +6274 FF . RST 38 +6275 FF . RST 38 +6276 FF . RST 38 +6277 FF . RST 38 +6278 FF . RST 38 +6279 FF . RST 38 +627A FF . RST 38 +627B FF . RST 38 +627C FF . RST 38 +627D FF . RST 38 +627E FF . RST 38 +627F FF . RST 38 +6280 FF . RST 38 +6281 FF . RST 38 +6282 FF . RST 38 +6283 FF . RST 38 +6284 FF . RST 38 +6285 FF . RST 38 +6286 FF . RST 38 +6287 FF . RST 38 +6288 FF . RST 38 +6289 FF . RST 38 +628A FF . RST 38 +628B FF . RST 38 +628C FF . RST 38 +628D FF . RST 38 +628E FF . RST 38 +628F FF . RST 38 +6290 FF . RST 38 +6291 FF . RST 38 +6292 FF . RST 38 +6293 FF . RST 38 +6294 FF . RST 38 +6295 FF . RST 38 +6296 FF . RST 38 +6297 FF . RST 38 +6298 FF . RST 38 +6299 FF . RST 38 +629A FF . RST 38 +629B FF . RST 38 +629C FF . RST 38 +629D FF . RST 38 +629E FF . RST 38 +629F FF . RST 38 +62A0 FF . RST 38 +62A1 FF . RST 38 +62A2 FF . RST 38 +62A3 FF . RST 38 +62A4 FF . RST 38 +62A5 FF . RST 38 +62A6 FF . RST 38 +62A7 FF . RST 38 +62A8 FF . RST 38 +62A9 FF . RST 38 +62AA FF . RST 38 +62AB FF . RST 38 +62AC FF . RST 38 +62AD FF . RST 38 +62AE FF . RST 38 +62AF FF . RST 38 +62B0 FF . RST 38 +62B1 FF . RST 38 +62B2 FF . RST 38 +62B3 FF . RST 38 +62B4 FF . RST 38 +62B5 FF . RST 38 +62B6 FF . RST 38 +62B7 61 a LD H,C ; "archiv 3 (!)" +62B8 72 r LD (HL),D +62B9 63 c LD H,E +62BA 68 h LD L,B +62BB 69 i LD L,C +62BC 76 v HALT +62BD 20 20 JR NZ,62DF +62BF 20 33 3 JR NZ,62F4 +62C1 20 28 ( JR NZ,62EB +62C3 21 29 50 !)P LD HL,5029 ; "PROZ ARCH" +62C6 52 R LD D,D +62C7 4F O LD C,A +62C8 5A Z LD E,D +62C9 20 41 A JR NZ,630C +62CB 52 R LD D,D +62CC 43 C LD B,E +62CD 48 H LD C,B +62CE 54 T LD D,H +62CF 63 c LD H,E +62D0 C3 DE 63 ..c JP 63DE +62D3 41 A LD B,C +62D4 FF . RST 38 +62D5 FF . RST 38 +62D6 FF . RST 38 +62D7 FF . RST 38 +62D8 FF . RST 38 +62D9 FF . RST 38 +62DA FF . RST 38 +62DB FF . RST 38 +62DC FF . RST 38 +62DD FF . RST 38 +62DE FF . RST 38 +62DF FF . RST 38 +62E0 FF . RST 38 +62E1 FF . RST 38 +62E2 FF . RST 38 +62E3 FF . RST 38 +62E4 FF . RST 38 +62E5 FF . RST 38 +62E6 FF . RST 38 +62E7 FF . RST 38 +62E8 FF . RST 38 +62E9 FF . RST 38 +62EA FF . RST 38 +62EB FF . RST 38 +62EC FF . RST 38 +62ED FF . RST 38 +62EE FF . RST 38 +62EF FF . RST 38 +62F0 FF . RST 38 +62F1 FF . RST 38 +62F2 FF . RST 38 +62F3 FF . RST 38 +62F4 FF . RST 38 +62F5 FF . RST 38 +62F6 FF . RST 38 +62F7 FF . RST 38 +62F8 FF . RST 38 +62F9 FF . RST 38 +62FA FF . RST 38 +62FB FF . RST 38 +62FC FF . RST 38 +62FD FF . RST 38 +62FE FF . RST 38 +62FF FF . RST 38 +6300 FF . RST 38 +6301 FF . RST 38 +6302 FF . RST 38 +6303 FF . RST 38 +6304 FF . RST 38 +6305 FF . RST 38 +6306 FF . RST 38 +6307 FF . RST 38 +6308 FF . RST 38 +6309 FF . RST 38 +630A FF . RST 38 +630B FF . RST 38 +630C FF . RST 38 +630D FF . RST 38 +630E FF . RST 38 +630F FF . RST 38 +6310 FF . RST 38 +6311 FF . RST 38 +6312 FF . RST 38 +6313 FF . RST 38 +6314 FF . RST 38 +6315 FF . RST 38 +6316 FF . RST 38 +6317 FF . RST 38 +6318 FF . RST 38 +6319 FF . RST 38 +631A FF . RST 38 +631B FF . RST 38 +631C FF . RST 38 +631D FF . RST 38 +631E FF . RST 38 +631F FF . RST 38 +6320 FF . RST 38 +6321 FF . RST 38 +6322 FF . RST 38 +6323 FF . RST 38 +6324 FF . RST 38 +6325 FF . RST 38 +6326 FF . RST 38 +6327 FF . RST 38 +6328 FF . RST 38 +6329 FF . RST 38 +632A FF . RST 38 +632B FF . RST 38 +632C FF . RST 38 +632D FF . RST 38 +632E FF . RST 38 +632F FF . RST 38 +6330 FF . RST 38 +6331 FF . RST 38 +6332 FF . RST 38 +6333 FF . RST 38 +6334 FF . RST 38 +6335 FF . RST 38 +6336 FF . RST 38 +6337 FF . RST 38 +6338 FF . RST 38 +6339 FF . RST 38 +633A FF . RST 38 +633B FF . RST 38 +633C FF . RST 38 +633D FF . RST 38 +633E FF . RST 38 +633F FF . RST 38 +6340 FF . RST 38 +6341 FF . RST 38 +6342 FF . RST 38 +6343 FF . RST 38 +6344 FF . RST 38 +6345 FF . RST 38 +6346 FF . RST 38 +6347 FF . RST 38 +6348 FF . RST 38 +6349 FF . RST 38 +634A FF . RST 38 +634B FF . RST 38 +634C FF . RST 38 +634D FF . RST 38 +634E FF . RST 38 +634F FF . RST 38 +6350 FF . RST 38 +6351 FF . RST 38 +6352 FF . RST 38 +6353 FF . RST 38 +6354 56 V LD D,(HL) +6355 63 c LD H,E +6356 21 B5 4C !.L LD HL,4CB5 +6359 CB 96 .. RES 2,(HL) +635B CD E2 6D ..m CALL 6DE2 +635E 3A 51 64 :Qd LD A,(6451) +6361 B7 . OR A +6362 28 F7 (. JR Z,635B +6364 FA 5B 63 .[c JP M,635B +6367 21 B5 4C !.L LD HL,4CB5 +636A CB D6 .. SET 2,(HL) +636C FE 0C .. CP 0C +636E DA 81 63 ..c JP C,6381 +6371 CD 1F 70 ..p CALL 701F +6374 18 04 .. JR 637A +6376 20 3F ? JR NZ,63B7 +6378 3F ? CCF +6379 3F ? CCF +637A 3E 00 >. LD A,00 +637C 32 51 64 2Qd LD (6451),A +637F 18 D5 .. JR 6356 +6381 2A 49 64 *Id LD HL,(6449) +6384 ED 5B 4D 64 .[Md LD DE,(644D) +6388 ED 4B 4B 64 .KKd LD BC,(644B) +638C FE 0A .. CP 0A +638E 28 1F (. JR Z,63AF +6390 FE 0B .. CP 0B +6392 3A 4F 64 :Od LD A,(644F) +6395 28 05 (. JR Z,639C +6397 CD 7E 28 .~( CALL 287E +639A 18 19 .. JR 63B5 +639C EB . EX DE,HL +639D ED 5B 4B 64 .[Kd LD DE,(644B) +63A1 ED 4B 49 64 .KId LD BC,(6449) +63A5 CD A8 28 ..( CALL 28A8 +63A8 ED 43 53 64 .CSd LD (6453),BC +63AC C3 7A 63 .zc JP 637A +63AF 3A 4F 64 :Od LD A,(644F) +63B2 CD 81 28 ..( CALL 2881 +63B5 ED 43 53 64 .CSd LD (6453),BC +63B9 2A 49 64 *Id LD HL,(6449) +63BC CD CC 63 ..c CALL 63CC +63BF C3 7A 63 .zc JP 637A +63C2 01 01 00 ... LD BC,0001 +63C5 ED 43 53 64 .CSd LD (6453),BC +63C9 C3 7A 63 .zc JP 637A +63CC 6C l LD L,H +63CD 37 7 SCF +63CE CB 1D .. RR L +63D0 26 15 &. LD H,15 +63D2 CB 86 .. RES 0,(HL) +63D4 C9 . RET +63D5 6C l LD L,H +63D6 37 7 SCF +63D7 CB 1D .. RR L +63D9 26 15 &. LD H,15 +63DB CB C6 .. SET 0,(HL) +63DD C9 . RET +63DE F5 . PUSH AF +63DF 3E 09 >. LD A,09 +63E1 F5 . PUSH AF +63E2 E5 . PUSH HL +63E3 21 51 64 !Qd LD HL,6451 +63E6 7E ~ LD A,(HL) +63E7 B7 . OR A +63E8 C2 1A 6C ..l JP NZ,6C1A +63EB 23 # INC HL +63EC 7E ~ LD A,(HL) +63ED B7 . OR A +63EE 28 11 (. JR Z,6401 +63F0 3A 1A 6E :.n LD A,(6E1A) +63F3 BE . CP (HL) +63F4 C2 1A 6C ..l JP NZ,6C1A +63F7 36 00 6. LD (HL),00 +63F9 ED 4B 53 64 .KSd LD BC,(6453) +63FD E1 . POP HL +63FE F1 . POP AF +63FF F1 . POP AF +6400 C9 . RET +6401 3A 1A 6E :.n LD A,(6E1A) +6404 77 w LD (HL),A +6405 E1 . POP HL +6406 ED 53 49 64 .SId LD (6449),DE +640A 22 4B 64 "Kd LD (644B),HL +640D ED 43 4D 64 .CMd LD (644D),BC +6411 F1 . POP AF +6412 EB . EX DE,HL +6413 32 51 64 2Qd LD (6451),A +6416 FE 0B .. CP 0B +6418 C4 D5 63 ..c CALL NZ,63D5 +641B F1 . POP AF +641C 32 4F 64 2Od LD (644F),A +641F 21 51 64 !Qd LD HL,6451 +6422 C3 1A 6C ..l JP 6C1A +6425 F5 . PUSH AF +6426 3E 0A >. LD A,0A +6428 18 B7 .. JR 63E1 +642A F5 . PUSH AF +642B 3E 0B >. LD A,0B +642D 18 B2 .. JR 63E1 +642F E5 . PUSH HL +6430 21 52 64 !Rd LD HL,6452 +6433 BE . CP (HL) +6434 20 02 . JR NZ,6438 +6436 36 00 6. LD (HL),00 +6438 E1 . POP HL +6439 C9 . RET +643A ED 4B 45 64 .KEd LD BC,(6445) +643E 21 00 00 !.. LD HL,0000 +6441 22 45 64 "Ed LD (6445),HL +6444 C9 . RET +6445 00 . NOP +6446 00 . NOP +6447 00 . NOP +6448 00 . NOP +6449 FF . RST 38 +644A FF . RST 38 +644B FF . RST 38 +644C FF . RST 38 +644D FF . RST 38 +644E FF . RST 38 +644F FF . RST 38 +6450 00 . NOP +6451 00 . NOP +6452 00 . NOP +6453 05 . DEC B +6454 00 . NOP +6455 00 . NOP +6456 00 . NOP +6457 00 . NOP +6458 00 . NOP +6459 00 . NOP +645A 00 . NOP +645B 00 . NOP +645C 00 . NOP +645D 00 . NOP +645E 00 . NOP +645F 00 . NOP +6460 00 . NOP +6461 00 . NOP +6462 00 . NOP +6463 00 . NOP +6464 00 . NOP +6465 00 . NOP +6466 00 . NOP +6467 00 . NOP +6468 00 . NOP +6469 00 . NOP +646A 00 . NOP +646B 31 37 35 175 LD SP,3537 ; "175---spver quelle 3 (!)" +646E 2D - DEC L +646F 2D - DEC L +6470 2D - DEC L +6471 73 s LD (HL),E +6472 70 p LD (HL),B +6473 76 v HALT +6474 65 e LD H,L +6475 72 r LD (HL),D +6476 2E 71 .q LD L,71 +6478 75 u LD (HL),L +6479 65 e LD H,L +647A 6C l LD L,H +647B 6C l LD L,H +647C 65 e LD H,L +647D 20 20 JR NZ,649F +647F 20 33 3 JR NZ,64B4 +6481 20 28 ( JR NZ,64AB +6483 21 29 01 !). LD HL,0129 +6486 38 00 8. JR C,6488 +6488 CD D8 81 ... CALL 81D8 +648B FD 2A FA 6E .*.n LD IY,(6EFA) +648F FD 46 04 .F. LD B,(IY+04) +6492 FD 4E 03 .N. LD C,(IY+03) +6495 C5 . PUSH BC +6496 ED 73 51 65 .sQe LD (6551),SP +649A 01 3B 65 .;e LD BC,653B +649D FD 70 04 .p. LD (IY+04),B +64A0 FD 71 03 .q. LD (IY+03),C +64A3 CD 48 65 .He CALL 6548 +64A6 11 00 00 ... LD DE,0000 ; Block 0 +64A9 CD 4E 6A .Nj CALL 6A4E ; In RAM holen (Adresse in HL) +64AC 67 g LD H,A ; Ettikettadresse (Highbyte in H) +64AD 97 . SUB A ; HG-Kanal +64AE 01 05 00 ... LD BC,0005 ; IOCONTROL 'size' +64B1 CD A8 28 ..( CALL 28A8 +64B4 2E 24 .$ LD L,24 ; 'aus historischen Grnden...' +64B6 CB 28 .( SRA B ; = HG-Blocks DIV 8 +64B8 CB 19 .. RR C +64BA CB 28 .( SRA B +64BC CB 19 .. RR C +64BE CB 28 .( SRA B +64C0 CB 19 .. RR C +64C2 71 q LD (HL),C ; eintragen +64C3 23 # INC HL +64C4 70 p LD (HL),B +64C5 2E 0E .. LD L,0E ; session INCR 1 +64C7 5E ^ LD E,(HL) +64C8 2C , INC L +64C9 56 V LD D,(HL) +64CA 13 . INC DE +64CB 72 r LD (HL),D +64CC 2D - DEC L +64CD 73 s LD (HL),E +64CE ED 53 17 6B .S.k LD (6B17),DE ; Ausserdem in 6B17 ablegen +64D2 2E 46 .F LD L,46 ; Infopassword +64D4 11 19 7D ..} LD DE,7D19 ; Lesen --> 7D19 +64D7 01 0A 00 ... LD BC,000A ; 10 Bytes +64DA ED B0 .. LDIR +64DC 2E 50 .P LD L,50 ; +64DE 7E ~ LD A,(HL) +64DF FE 01 .. CP 01 ; 1 = frisches System +64E1 20 17 . JR NZ,64FA +64E3 36 00 6. LD (HL),00 ; jetzt nicht frisch +64E5 3E 11 >. LD A,11 ; Funktion 17 +64E7 CD BB 81 ... CALL 81BB +64EA CD 26 65 .&e CALL 6526 +64ED 3E 12 >. LD A,12 ; Funktion 18 'System aufbauen' +64EF CD BB 81 ... CALL 81BB +64F2 21 1A 6B !.k LD HL,6B1A +64F5 CD CA 6E ..n CALL 6ECA +64F8 18 20 . JR 651A ; das wars +64FA 2E 0D .. LD L,0D ; 0 = shutup-Zustand +64FC CB 4E .N BIT 1,(HL) +64FE 28 08 (. JR Z,6508 +6500 21 00 6B !.k LD HL,6B00 ; Alte Werte benuzten 6B00.. +6503 CD CA 6E ..n CALL 6ECA +6506 18 02 .. JR 650A +6508 36 FF 6. LD (HL),FF ; FF = kein Shutup +650A CD 48 65 .He CALL 6548 +650D CD 18 53 ..S CALL 5318 +6510 3E 01 >. LD A,01 ; Funktion 1 +6512 CD BB 81 ... CALL 81BB +6515 CD 26 65 .&e CALL 6526 +6518 18 00 .. JR 651A +651A C1 . POP BC ; +651B FD 2A FA 6E .*.n LD IY,(6EFA) +651F FD 70 04 .p. LD (IY+04),B +6522 FD 71 03 .q. LD (IY+03),C +6525 C9 . RET +6526 CD 48 65 .He CALL 6548 ; Nchsten MINI +6529 11 02 00 ... LD DE,0002 ; Block "2" ist Systemanker +652C CD 36 6A .6j CALL 6A36 ; A ist Adresse (Highbyte) +652F 67 g LD H,A +6530 2E 00 .. LD L,00 +6532 11 2B 1E .+. LD DE,1E2B +6535 01 10 00 ... LD BC,0010 ; 16 Bytes (DR_DR) bertragen +6538 ED B0 .. LDIR +653A C9 . RET +653B ED 7B 51 65 .{Qe LD SP,(6551) +653F CD E2 6D ..m CALL 6DE2 +6542 FD 2A 53 65 .*Se LD IY,(6553) +6546 FD E9 .. JP (IY) +6548 E1 . POP HL +6549 ED 73 51 65 .sQe LD (6551),SP +654D 22 53 65 "Se LD (6553),HL +6550 E9 . JP (HL) +6551 00 . NOP ; MINI-Savestackpointer +6552 00 . NOP +6553 00 . NOP ; MINI IY Zeigt auf MINI-Descriptor +6554 00 . NOP +6555 CD 5C 65 .\e CALL 655C +6558 CD CA 5C ..\ CALL 5CCA +655B C9 . RET +655C 7A z LD A,D +655D FE 04 .. CP 04 +655F 30 02 0. JR NC,6563 ; Korrekte DSnr in D ? +6561 16 05 .. LD D,05 ; Nein 'errorspace' 5 +6563 C5 . PUSH BC +6564 E5 . PUSH HL +6565 3A 1A 6E :.n LD A,(6E1A) +6568 6F o LD L,A +6569 7D } LD A,L +656A 87 . ADD A +656B 8B . ADC E + - Fortsetzung in Datei "eumel0.prt.4" - + diff --git a/system/eumel0-z80/src/eumel0.prt.4 b/system/eumel0-z80/src/eumel0.prt.4 new file mode 100644 index 0000000..3eb9b03 --- /dev/null +++ b/system/eumel0-z80/src/eumel0.prt.4 @@ -0,0 +1,4001 @@ +ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT + +656C 8A . ADC D +656D 8C . ADC H +656E 4F O LD C,A +656F 06 14 .. LD B,14 +6571 0A . LD A,(BC) +6572 4F O LD C,A +6573 06 18 .. LD B,18 +6575 0A . LD A,(BC) +6576 BC . CP H +6577 20 15 . JR NZ,658E +6579 05 . DEC B +657A 0A . LD A,(BC) +657B BA . CP D +657C 20 10 . JR NZ,658E +657E CB F9 .. SET 7,C +6580 0A . LD A,(BC) +6581 BB . CP E +6582 20 0A . JR NZ,658E +6584 05 . DEC B +6585 0A . LD A,(BC) +6586 BD . CP L +6587 20 05 . JR NZ,658E +6589 79 y LD A,C +658A 87 . ADD A +658B E1 . POP HL +658C C1 . POP BC +658D C9 . RET +658E DD E5 .. PUSH IX +6590 FD E5 .. PUSH IY +6592 D5 . PUSH DE +6593 7D } LD A,L +6594 6C l LD L,H +6595 63 c LD H,E +6596 5A Z LD E,D +6597 57 W LD D,A +6598 E5 . PUSH HL +6599 7B { LD A,E +659A FE 20 . CP 20 +659C 38 36 86 JR C,65D4 +659E CD DA 66 ..f CALL 66DA +65A1 D1 . POP DE +65A2 CD E1 65 ..e CALL 65E1 +65A5 D1 . POP DE +65A6 FD E1 .. POP IY +65A8 DD E1 .. POP IX +65AA E1 . POP HL +65AB C1 . POP BC +65AC E5 . PUSH HL +65AD C5 . PUSH BC +65AE F5 . PUSH AF +65AF 3A 1A 6E :.n LD A,(6E1A) +65B2 6F o LD L,A +65B3 7D } LD A,L +65B4 87 . ADD A +65B5 8B . ADC E +65B6 8A . ADC D +65B7 8C . ADC H +65B8 4F O LD C,A +65B9 06 14 .. LD B,14 +65BB F1 . POP AF +65BC F5 . PUSH AF +65BD 0F . RRCA +65BE 02 . LD (BC),A +65BF 4F O LD C,A +65C0 06 18 .. LD B,18 +65C2 7C | LD A,H +65C3 02 . LD (BC),A +65C4 05 . DEC B +65C5 7A z LD A,D +65C6 02 . LD (BC),A +65C7 CB F9 .. SET 7,C +65C9 7B { LD A,E +65CA 02 . LD (BC),A +65CB 05 . DEC B +65CC 7D } LD A,L +65CD 02 . LD (BC),A +65CE F1 . POP AF +65CF C1 . POP BC +65D0 E1 . POP HL +65D1 C9 . RET +65D2 F1 . POP AF +65D3 C9 . RET +65D4 87 . ADD A +65D5 87 . ADD A +65D6 87 . ADD A +65D7 87 . ADD A +65D8 2A 1C 6E *.n LD HL,(6E1C) +65DB 6F o LD L,A +65DC 30 C3 0. JR NC,65A1 +65DE 24 $ INC H +65DF 18 C0 .. JR 65A1 +65E1 23 # INC HL +65E2 7E ~ LD A,(HL) +65E3 2B + DEC HL +65E4 3C < INC A +65E5 20 27 ' JR NZ,660E +65E7 7A z LD A,D +65E8 B7 . OR A +65E9 20 0C . JR NZ,65F7 +65EB 7B { LD A,E +65EC FE 03 .. CP 03 +65EE 38 0E 8. JR C,65FE +65F0 96 . SUB (HL) +65F1 38 04 8. JR C,65F7 +65F3 FE 05 .. CP 05 +65F5 38 11 8. JR C,6608 +65F7 11 FF FF ... LD DE,FFFF +65FA CD 36 6A .6j CALL 6A36 +65FD C9 . RET +65FE 87 . ADD A +65FF 28 F6 (. JR Z,65F7 +6601 85 . ADD L +6602 6F o LD L,A +6603 5E ^ LD E,(HL) +6604 23 # INC HL +6605 56 V LD D,(HL) +6606 18 F2 .. JR 65FA +6608 87 . ADD A +6609 C6 06 .. ADD A,06 +660B C3 01 66 ..f JP 6601 +660E 7A z LD A,D +660F E6 07 .. AND 07 +6611 87 . ADD A +6612 85 . ADD L +6613 6F o LD L,A +6614 D5 . PUSH DE +6615 5E ^ LD E,(HL) +6616 23 # INC HL +6617 56 V LD D,(HL) +6618 3E FF >. LD A,FF +661A CD 3F 6A .?j CALL 6A3F +661D E1 . POP HL +661E CB 25 .% SLA L +6620 CE 00 .. ADC A,00 +6622 67 g LD H,A +6623 5E ^ LD E,(HL) +6624 2C , INC L +6625 56 V LD D,(HL) +6626 CD C1 5C ..\ CALL 5CC1 +6629 C3 FA 65 ..e JP 65FA +662C 7A z LD A,D +662D FE 04 .. CP 04 ; drid < 4 +662F 30 13 0. JR NC,6644 +6631 CD 1F 70 ..p CALL 701F ; Info aufrufen +6634 18 0C .. JR 6642 +6636 20 75 u JR NZ,66AD ; " unzul. drid" +6638 6E n LD L,(HL) +6639 7A z LD A,D +663A 75 u LD (HL),L +663B 6C l LD L,H +663C 2E 20 . LD L,20 +663E 64 d LD H,H +663F 72 r LD (HL),D +6640 69 i LD L,C +6641 64 d LD H,H +6642 16 05 .. LD D,05 +6644 C5 . PUSH BC +6645 E5 . PUSH HL +6646 3A 1A 6E :.n LD A,(6E1A) +6649 6F o LD L,A +664A 7D } LD A,L +664B 87 . ADD A +664C 8B . ADC E +664D 8A . ADC D +664E 8C . ADC H +664F 4F O LD C,A +6650 06 14 .. LD B,14 +6652 0A . LD A,(BC) +6653 4F O LD C,A +6654 06 18 .. LD B,18 +6656 0A . LD A,(BC) +6657 BC . CP H +6658 20 1B . JR NZ,6675 +665A 05 . DEC B +665B 0A . LD A,(BC) +665C BA . CP D +665D 20 16 . JR NZ,6675 +665F CB F9 .. SET 7,C +6661 0A . LD A,(BC) +6662 BB . CP E +6663 20 10 . JR NZ,6675 +6665 05 . DEC B +6666 0A . LD A,(BC) +6667 BD . CP L +6668 20 0B . JR NZ,6675 +666A 05 . DEC B +666B 0A . LD A,(BC) +666C CB 57 .W BIT 2,A +666E 28 05 (. JR Z,6675 +6670 79 y LD A,C +6671 81 . ADD C +6672 E1 . POP HL +6673 C1 . POP BC +6674 C9 . RET +6675 DD E5 .. PUSH IX +6677 FD E5 .. PUSH IY +6679 D5 . PUSH DE +667A 7D } LD A,L +667B 6C l LD L,H +667C 63 c LD H,E +667D 5A Z LD E,D +667E 57 W LD D,A +667F E5 . PUSH HL +6680 7B { LD A,E +6681 FE 20 . CP 20 +6683 38 43 8C JR C,66C8 +6685 CD DE 66 ..f CALL 66DE +6688 D1 . POP DE +6689 CD 93 67 ..g CALL 6793 +668C 20 47 G JR NZ,66D5 +668E CD 48 6A .Hj CALL 6A48 +6691 F5 . PUSH AF +6692 CD C1 5C ..\ CALL 5CC1 +6695 F1 . POP AF +6696 D1 . POP DE +6697 FD E1 .. POP IY +6699 DD E1 .. POP IX +669B E1 . POP HL +669C C1 . POP BC +669D E5 . PUSH HL +669E C5 . PUSH BC +669F F5 . PUSH AF +66A0 3A 1A 6E :.n LD A,(6E1A) +66A3 6F o LD L,A +66A4 7D } LD A,L +66A5 87 . ADD A +66A6 8B . ADC E +66A7 8A . ADC D +66A8 8C . ADC H +66A9 4F O LD C,A +66AA 06 14 .. LD B,14 +66AC F1 . POP AF +66AD F5 . PUSH AF +66AE 0F . RRCA +66AF 02 . LD (BC),A +66B0 4F O LD C,A +66B1 06 18 .. LD B,18 +66B3 7C | LD A,H +66B4 02 . LD (BC),A +66B5 05 . DEC B +66B6 7A z LD A,D +66B7 02 . LD (BC),A +66B8 CB F9 .. SET 7,C +66BA 7B { LD A,E +66BB 02 . LD (BC),A +66BC 05 . DEC B +66BD 7D } LD A,L +66BE 02 . LD (BC),A +66BF 05 . DEC B +66C0 0A . LD A,(BC) +66C1 F6 0C .. OR 0C +66C3 02 . LD (BC),A +66C4 F1 . POP AF +66C5 C1 . POP BC +66C6 E1 . POP HL +66C7 C9 . RET +66C8 87 . ADD A +66C9 87 . ADD A +66CA 87 . ADD A +66CB 87 . ADD A +66CC 2A 1C 6E *.n LD HL,(6E1C) +66CF 6F o LD L,A +66D0 30 B3 0. JR NC,6685 +66D2 24 $ INC H +66D3 18 B0 .. JR 6685 +66D5 CD 35 68 .5h CALL 6835 +66D8 18 6A .j JR 6744 +66DA 3E 00 >. LD A,00 +66DC 18 02 .. JR 66E0 +66DE 3E 01 >. LD A,01 +66E0 32 12 6B 2.k LD (6B12),A +66E3 7B { LD A,E +66E4 FE 20 . CP 20 +66E6 30 1D 0. JR NC,6705 +66E8 6A j LD L,D +66E9 26 14 &. LD H,14 +66EB 6E n LD L,(HL) +66EC 26 17 &. LD H,17 +66EE 7E ~ LD A,(HL) +66EF B7 . OR A +66F0 20 13 . JR NZ,6705 +66F2 25 % DEC H +66F3 CB FD .. SET 7,L +66F5 7E ~ LD A,(HL) +66F6 BA . CP D +66F7 20 0C . JR NZ,6705 +66F9 25 % DEC H +66FA CB 56 .V BIT 2,(HL) +66FC 28 07 (. JR Z,6705 +66FE CB DE .. SET 3,(HL) +6700 7D } LD A,L +6701 87 . ADD A +6702 6B k LD L,E +6703 18 6C .l JR 6771 +6705 21 2B 1E !+. LD HL,1E2B +6708 D5 . PUSH DE +6709 CB 3A .: SLR D +670B CB 1B .. RR E +670D CB 3A .: SLR D +670F CB 1B .. RR E +6711 CB 3A .: SLR D +6713 CB 1B .. RR E +6715 CB 3A .: SLR D +6717 CB 1B .. RR E +6719 CB 3A .: SLR D +671B CB 1B .. RR E +671D 3A 12 6B :.k LD A,(6B12) +6720 B7 . OR A +6721 28 27 (' JR Z,674A +6723 CD 93 67 ..g CALL 6793 +6726 28 27 (' JR Z,674F +6728 CD 35 68 .5h CALL 6835 +672B D1 . POP DE +672C 7A z LD A,D +672D B7 . OR A +672E 28 14 (. JR Z,6744 +6730 2E 00 .. LD L,00 +6732 06 20 . LD B,20 +6734 7B { LD A,E +6735 FE 20 . CP 20 +6737 30 04 0. JR NC,673D +6739 2E 40 .@ LD L,40 +673B 06 1C .. LD B,1C +673D C5 . PUSH BC +673E CD 80 67 ..g CALL 6780 +6741 C1 . POP BC +6742 10 F9 .. DJNZ 673D +6744 21 00 00 !.. LD HL,0000 +6747 C3 1A 6C ..l JP 6C1A +674A CD E1 65 ..e CALL 65E1 +674D 18 03 .. JR 6752 +674F CD 48 6A .Hj CALL 6A48 +6752 E1 . POP HL +6753 F5 . PUSH AF +6754 7D } LD A,L +6755 FE 20 . CP 20 +6757 30 17 0. JR NC,6770 +6759 F1 . POP AF +675A F5 . PUSH AF +675B E5 . PUSH HL +675C CB 3F .? SLR A +675E 6F o LD L,A +675F 54 T LD D,H +6760 26 17 &. LD H,17 +6762 36 00 6. LD (HL),00 +6764 25 % DEC H +6765 CB FD .. SET 7,L +6767 72 r LD (HL),D +6768 25 % DEC H +6769 CB D6 .. SET 2,(HL) +676B 26 14 &. LD H,14 +676D 6A j LD L,D +676E 77 w LD (HL),A +676F E1 . POP HL +6770 F1 . POP AF +6771 CB 25 .% SLA L +6773 CB 25 .% SLA L +6775 CB 25 .% SLA L +6777 CB 25 .% SLA L +6779 CE 00 .. ADC A,00 +677B 67 g LD H,A +677C CD C1 5C ..\ CALL 5CC1 +677F C9 . RET +6780 06 08 .. LD B,08 +6782 23 # INC HL +6783 7E ~ LD A,(HL) +6784 2B + DEC HL +6785 FE FF .. CP FF +6787 20 03 . JR NZ,678C +6789 23 # INC HL +678A 23 # INC HL +678B 05 . DEC B +678C CB C6 .. SET 0,(HL) +678E 23 # INC HL +678F 23 # INC HL +6790 10 FA .. DJNZ 678C +6792 C9 . RET +6793 23 # INC HL +6794 7E ~ LD A,(HL) +6795 2B + DEC HL +6796 3C < INC A +6797 C2 0A 68 ..h JP NZ,680A +679A 7A z LD A,D +679B B7 . OR A +679C 20 1B . JR NZ,67B9 +679E 7B { LD A,E +679F FE 03 .. CP 03 +67A1 DA 01 68 ..h JP C,6801 +67A4 7E ~ LD A,(HL) +67A5 3C < INC A +67A6 20 08 . JR NZ,67B0 +67A8 7B { LD A,E +67A9 FE FB .. CP FB +67AB 38 02 8. JR C,67AF +67AD 3E FB >. LD A,FB +67AF 77 w LD (HL),A +67B0 7B { LD A,E +67B1 96 . SUB (HL) +67B2 38 05 8. JR C,67B9 +67B4 FE 05 .. CP 05 +67B6 DA FC 67 ..g JP C,67FC +67B9 E5 . PUSH HL +67BA 21 13 6B !.k LD HL,6B13 +67BD CD 35 68 .5h CALL 6835 +67C0 7C | LD A,H +67C1 ED 5B 13 6B .[.k LD DE,(6B13) +67C5 21 FF FF !.. LD HL,FFFF +67C8 22 13 6B ".k LD (6B13),HL +67CB E1 . POP HL +67CC 46 F LD B,(HL) +67CD 73 s LD (HL),E +67CE 23 # INC HL +67CF 72 r LD (HL),D +67D0 57 W LD D,A +67D1 1E 02 .. LD E,02 +67D3 23 # INC HL +67D4 78 x LD A,B +67D5 01 04 00 ... LD BC,0004 +67D8 ED B0 .. LDIR +67DA 01 0A 00 ... LD BC,000A +67DD 5F _ LD E,A +67DE 3C < INC A +67DF 20 03 . JR NZ,67E4 +67E1 09 . ADD HL,BC +67E2 18 08 .. JR 67EC +67E4 7A z LD A,D +67E5 CB 23 .# SLA E +67E7 CE 00 .. ADC A,00 +67E9 57 W LD D,A +67EA ED B0 .. LDIR +67EC 2B + DEC HL +67ED 01 0D 00 ... LD BC,000D +67F0 54 T LD D,H +67F1 5D ] LD E,L +67F2 1B . DEC DE +67F3 36 FF 6. LD (HL),FF +67F5 ED B8 .. LDDR +67F7 36 01 6. LD (HL),01 +67F9 C3 44 67 .Dg JP 6744 +67FC 87 . ADD A +67FD C6 06 .. ADD A,06 +67FF 18 04 .. JR 6805 +6801 87 . ADD A +6802 CA B9 67 ..g JP Z,67B9 +6805 85 . ADD L +6806 6F o LD L,A +6807 CB 46 .F BIT 0,(HL) +6809 C9 . RET +680A D5 . PUSH DE +680B 7A z LD A,D +680C E6 07 .. AND 07 +680E CB 27 .' SLA A +6810 85 . ADD L +6811 6F o LD L,A +6812 CB 46 .F BIT 0,(HL) +6814 20 11 . JR NZ,6827 +6816 5E ^ LD E,(HL) +6817 2C , INC L +6818 56 V LD D,(HL) +6819 3E FD >. LD A,FD +681B CD 3F 6A .?j CALL 6A3F +681E E1 . POP HL +681F CB 25 .% SLA L +6821 CE 00 .. ADC A,00 +6823 67 g LD H,A +6824 CB 46 .F BIT 0,(HL) +6826 C9 . RET +6827 CD 35 68 .5h CALL 6835 +682A 06 00 .. LD B,00 +682C CB C6 .. SET 0,(HL) +682E 23 # INC HL +682F 23 # INC HL +6830 10 FA .. DJNZ 682C +6832 C3 44 67 .Dg JP 6744 +6835 5E ^ LD E,(HL) +6836 23 # INC HL +6837 56 V LD D,(HL) +6838 2B + DEC HL +6839 E5 . PUSH HL +683A CD 41 5D .A] CALL 5D41 +683D E5 . PUSH HL +683E CB FD .. SET 7,L +6840 CB 96 .. RES 2,(HL) +6842 CB 4E .N BIT 1,(HL) +6844 28 28 (( JR Z,686E +6846 24 $ INC H +6847 36 FF 6. LD (HL),FF +6849 CD 4E 55 .NU CALL 554E +684C C1 . POP BC +684D D1 . POP DE +684E EB . EX DE,HL +684F CB 83 .. RES 0,E +6851 73 s LD (HL),E +6852 23 # INC HL +6853 72 r LD (HL),D +6854 2B + DEC HL +6855 6C l LD L,H +6856 26 15 &. LD H,15 +6858 37 7 SCF +6859 CB 1D .. RR L +685B CB 8E .. RES 1,(HL) +685D 60 ` LD H,B +685E 69 i LD L,C +685F 73 s LD (HL),E +6860 CB FD .. SET 7,L +6862 CB 8E .. RES 1,(HL) +6864 24 $ INC H +6865 CB BD .. RES 7,L +6867 72 r LD (HL),D +6868 65 e LD H,L +6869 CB 24 .$ SLA H +686B 2E 00 .. LD L,00 +686D C9 . RET +686E 24 $ INC H +686F 36 FF 6. LD (HL),FF +6871 11 F0 FF ... LD DE,FFF0 +6874 CD 41 5D .A] CALL 5D41 +6877 C1 . POP BC +6878 E5 . PUSH HL +6879 55 U LD D,L +687A 1E 00 .. LD E,00 +687C 61 a LD H,C +687D 2E 00 .. LD L,00 +687F 01 00 02 ... LD BC,0200 +6882 CB 24 .$ SLA H +6884 CB 22 ." SLA D +6886 CD A5 28 ..( CALL 28A5 +6889 18 BE .. JR 6849 +688B B7 . OR A +688C C8 . RET Z +688D CD 2F 64 ./d CALL 642F +6890 CD 20 6E . n CALL 6E20 +6893 CD 74 6D .tm CALL 6D74 +6896 F5 . PUSH AF +6897 1F . RRA +6898 1F . RRA +6899 1F . RRA +689A 1F . RRA +689B E6 06 .. AND 06 +689D 21 2B 1E !+. LD HL,1E2B +68A0 85 . ADD L +68A1 6F o LD L,A +68A2 5E ^ LD E,(HL) +68A3 23 # INC HL +68A4 56 V LD D,(HL) +68A5 CD 4E 6A .Nj CALL 6A4E +68A8 67 g LD H,A +68A9 F1 . POP AF +68AA E5 . PUSH HL +68AB 21 80 16 !.. LD HL,1680 +68AE 01 81 00 ... LD BC,0081 +68B1 ED B1 .. CPIR +68B3 E2 BC 68 ..h JP PO,68BC +68B6 2B + DEC HL +68B7 36 FF 6. LD (HL),FF +68B9 23 # INC HL +68BA 18 F5 .. JR 68B1 +68BC E1 . POP HL +68BD CB 27 .' SLA A +68BF CB 27 .' SLA A +68C1 CB 27 .' SLA A +68C3 CB 27 .' SLA A +68C5 6F o LD L,A +68C6 30 01 0. JR NC,68C9 +68C8 24 $ INC H +68C9 36 FF 6. LD (HL),FF +68CB 54 T LD D,H +68CC 5D ] LD E,L +68CD 13 . INC DE +68CE 01 0F 00 ... LD BC,000F +68D1 ED B0 .. LDIR +68D3 CD DA 68 ..h CALL 68DA +68D6 CD 2A 6E .*n CALL 6E2A +68D9 C9 . RET +68DA 3A 13 57 :.W LD A,(5713) +68DD B7 . OR A +68DE C8 . RET Z +68DF 21 17 82 !.. LD HL,8217 +68E2 CB C6 .. SET 0,(HL) +68E4 C9 . RET +68E5 7A z LD A,D +68E6 18 02 .. JR 68EA +68E8 3E FF >. LD A,FF +68EA 32 16 6B 2.k LD (6B16),A +68ED E5 . PUSH HL +68EE C5 . PUSH BC +68EF 1E 04 .. LD E,04 +68F1 D5 . PUSH DE +68F2 CD DA 66 ..f CALL 66DA +68F5 D1 . POP DE +68F6 23 # INC HL +68F7 7E ~ LD A,(HL) +68F8 23 # INC HL +68F9 A6 . AND (HL) +68FA 23 # INC HL +68FB A6 . AND (HL) +68FC 3C < INC A +68FD 28 06 (. JR Z,6905 +68FF 1C . INC E +6900 20 EF . JR NZ,68F1 +6902 C1 . POP BC +6903 E1 . POP HL +6904 C9 . RET +6905 D5 . PUSH DE +6906 CD DE 66 ..f CALL 66DE +6909 E5 . PUSH HL +690A 50 P LD D,B +690B 59 Y LD E,C +690C 7B { LD A,E +690D B7 . OR A +690E 28 0A (. JR Z,691A +6910 CD DE 66 ..f CALL 66DE +6913 E5 . PUSH HL +6914 CD 30 80 .0. CALL 8030 +6917 E1 . POP HL +6918 18 03 .. JR 691D +691A 21 26 6A !&j LD HL,6A26 +691D 3A 16 6B :.k LD A,(6B16) +6920 3C < INC A +6921 20 05 . JR NZ,6928 +6923 E5 . PUSH HL +6924 CD 80 67 ..g CALL 6780 +6927 E1 . POP HL +6928 D1 . POP DE +6929 01 10 00 ... LD BC,0010 +692C ED B0 .. LDIR +692E 3A 16 6B :.k LD A,(6B16) +6931 3C < INC A +6932 28 0B (. JR Z,693F +6934 01 0F 00 ... LD BC,000F +6937 2B + DEC HL +6938 36 FF 6. LD (HL),FF +693A 54 T LD D,H +693B 5D ] LD E,L +693C 1B . DEC DE +693D ED B8 .. LDDR +693F D1 . POP DE +6940 3E FF >. LD A,FF +6942 CD 53 69 .Si CALL 6953 +6945 C1 . POP BC +6946 D5 . PUSH DE +6947 59 Y LD E,C +6948 50 P LD D,B +6949 3E FF >. LD A,FF +694B CD 53 69 .Si CALL 6953 +694E 42 B LD B,D +694F 4B K LD C,E +6950 D1 . POP DE +6951 E1 . POP HL +6952 C9 . RET +6953 21 00 17 !.. LD HL,1700 +6956 01 81 00 ... LD BC,0081 +6959 F5 . PUSH AF +695A 7B { LD A,E +695B ED B1 .. CPIR +695D E2 75 69 .ui JP PO,6975 +6960 2B + DEC HL +6961 25 % DEC H +6962 CB FD .. SET 7,L +6964 7A z LD A,D +6965 BE . CP (HL) +6966 20 07 . JR NZ,696F +6968 F1 . POP AF +6969 77 w LD (HL),A +696A F5 . PUSH AF +696B 25 % DEC H +696C CB 96 .. RES 2,(HL) +696E 24 $ INC H +696F CB BD .. RES 7,L +6971 24 $ INC H +6972 23 # INC HL +6973 18 E5 .. JR 695A +6975 F1 . POP AF +6976 C9 . RET +6977 79 y LD A,C +6978 FE 04 .. CP 04 +697A D8 . RET C +697B D5 . PUSH DE +697C E5 . PUSH HL +697D C5 . PUSH BC +697E 59 Y LD E,C +697F 3A 1A 6E :.n LD A,(6E1A) +6982 57 W LD D,A +6983 CD DA 66 ..f CALL 66DA +6986 23 # INC HL +6987 7E ~ LD A,(HL) +6988 23 # INC HL +6989 A6 . AND (HL) +698A 23 # INC HL +698B A6 . AND (HL) +698C 3C < INC A +698D 28 05 (. JR Z,6994 +698F B7 . OR A +6990 C1 . POP BC +6991 E1 . POP HL +6992 D1 . POP DE +6993 C9 . RET +6994 37 7 SCF +6995 18 F9 .. JR 6990 +6997 D5 . PUSH DE +6998 E5 . PUSH HL +6999 C5 . PUSH BC +699A 79 y LD A,C +699B FE 04 .. CP 04 +699D 38 F1 8. JR C,6990 +699F 3A 1A 6E :.n LD A,(6E1A) +69A2 57 W LD D,A +69A3 59 Y LD E,C +69A4 CD DE 66 ..f CALL 66DE +69A7 54 T LD D,H +69A8 5D ] LD E,L +69A9 13 . INC DE +69AA 01 0F 00 ... LD BC,000F +69AD 36 FF 6. LD (HL),FF +69AF ED B0 .. LDIR +69B1 CD DA 68 ..h CALL 68DA +69B4 18 DA .. JR 6990 +69B6 78 x LD A,B +69B7 B7 . OR A +69B8 C8 . RET Z +69B9 85 . ADD L +69BA DC 0B 6A ..j CALL C,6A0B +69BD 78 x LD A,B +69BE 83 . ADD E +69BF DC 0B 6A ..j CALL C,6A0B +69C2 CD 20 6E . n CALL 6E20 +69C5 C5 . PUSH BC +69C6 E5 . PUSH HL +69C7 D5 . PUSH DE +69C8 3A 1A 6E :.n LD A,(6E1A) +69CB 57 W LD D,A +69CC 59 Y LD E,C +69CD 3E FF >. LD A,FF +69CF CD 53 69 .Si CALL 6953 +69D2 CD DE 66 ..f CALL 66DE +69D5 2C , INC L +69D6 7E ~ LD A,(HL) +69D7 2D - DEC L +69D8 3C < INC A +69D9 28 31 (1 JR Z,6A0C +69DB D1 . POP DE +69DC E5 . PUSH HL +69DD CD 93 67 ..g CALL 6793 +69E0 CD 1A 6A ..j CALL 6A1A +69E3 D1 . POP DE +69E4 E3 . EX (SP),HL +69E5 EB . EX DE,HL +69E6 CD 93 67 ..g CALL 6793 +69E9 CD 1A 6A ..j CALL 6A1A +69EC D1 . POP DE +69ED C1 . POP BC +69EE C5 . PUSH BC +69EF E5 . PUSH HL +69F0 CB C6 .. SET 0,(HL) +69F2 2C , INC L +69F3 2C , INC L +69F4 10 FA .. DJNZ 69F0 +69F6 E1 . POP HL +69F7 C1 . POP BC +69F8 48 H LD C,B +69F9 CB 21 .! SLA C +69FB 06 00 .. LD B,00 +69FD CB 10 .. RL B +69FF CD 14 80 ... CALL 8014 +6A02 ED B0 .. LDIR +6A04 CD C1 5C ..\ CALL 5CC1 +6A07 CD 2A 6E .*n CALL 6E2A +6A0A C9 . RET +6A0B C8 . RET Z +6A0C CD 1F 70 ..p CALL 701F ; Info aufrufen +6A0F 18 07 .. JR 6A18 +6A11 20 73 s JR NZ,6A86 ; " spmove" +6A13 70 p LD (HL),B +6A14 6D m LD L,L +6A15 6F o LD L,A +6A16 76 v HALT +6A17 65 e LD H,L +6A18 18 F2 .. JR 6A0C +6A1A 1F . RRA +6A1B CB 1D .. RR L +6A1D CD 4E 6A .Nj CALL 6A4E +6A20 CB 25 .% SLA L +6A22 CE 00 .. ADC A,00 +6A24 67 g LD H,A +6A25 C9 . RET +6A26 FF . RST 38 ; nilspace-Eintrag +6A27 FF . RST 38 +6A28 01 FF FF ... LD BC,FFFF +6A2B FF . RST 38 +6A2C FF . RST 38 +6A2D FF . RST 38 +6A2E FF . RST 38 +6A2F FF . RST 38 +6A30 FF . RST 38 +6A31 FF . RST 38 +6A32 FF . RST 38 +6A33 FF . RST 38 +6A34 FF . RST 38 +6A35 FF . RST 38 +6A36 E5 . PUSH HL +6A37 CD 41 5D .A] CALL 5D41 +6A3A 7D } LD A,L +6A3B CB 27 .' SLA A +6A3D E1 . POP HL +6A3E C9 . RET +6A3F E5 . PUSH HL +6A40 CD 3E 5D .>] CALL 5D3E +6A43 CB 25 .% SLA L +6A45 7D } LD A,L +6A46 E1 . POP HL +6A47 C9 . RET +6A48 E5 . PUSH HL +6A49 5E ^ LD E,(HL) +6A4A 23 # INC HL +6A4B 56 V LD D,(HL) +6A4C 18 01 .. JR 6A4F +6A4E E5 . PUSH HL +6A4F CD 41 5D .A] CALL 5D41 +6A52 CB FD .. SET 7,L +6A54 CB 8E .. RES 1,(HL) +6A56 7D } LD A,L +6A57 CB 27 .' SLA A +6A59 E1 . POP HL +6A5A C9 . RET +6A5B 7A z LD A,D +6A5C FE 04 .. CP 04 +6A5E 38 19 8. JR C,6A79 +6A60 23 # INC HL +6A61 7C | LD A,H +6A62 FE 08 .. CP 08 +6A64 30 13 0. JR NC,6A79 +6A66 E5 . PUSH HL +6A67 D5 . PUSH DE +6A68 5C \ LD E,H +6A69 65 e LD H,L +6A6A CD 5C 65 .\e CALL 655C +6A6D CB 3F .? SLR A +6A6F 6F o LD L,A +6A70 26 16 &. LD H,16 +6A72 7E ~ LD A,(HL) +6A73 3C < INC A +6A74 D1 . POP DE +6A75 E1 . POP HL +6A76 28 E8 (. JR Z,6A60 +6A78 C9 . RET +6A79 21 FF FF !.. LD HL,FFFF +6A7C C9 . RET +6A7D 7B { LD A,E +6A7E FE 04 .. CP 04 +6A80 38 26 8& JR C,6AA8 +6A82 E5 . PUSH HL +6A83 C5 . PUSH BC +6A84 D5 . PUSH DE +6A85 CD DA 66 ..f CALL 66DA +6A88 D1 . POP DE +6A89 23 # INC HL +6A8A 23 # INC HL +6A8B 7E ~ LD A,(HL) +6A8C 23 # INC HL +6A8D A6 . AND (HL) +6A8E 3C < INC A +6A8F 28 1B (. JR Z,6AAC +6A91 2B + DEC HL +6A92 2B + DEC HL +6A93 7E ~ LD A,(HL) +6A94 3C < INC A +6A95 20 1A . JR NZ,6AB1 +6A97 06 07 .. LD B,07 +6A99 11 00 00 ... LD DE,0000 +6A9C 2C , INC L +6A9D 2C , INC L +6A9E 7E ~ LD A,(HL) +6A9F 3C < INC A +6AA0 28 01 (. JR Z,6AA3 +6AA2 1C . INC E +6AA3 10 F7 .. DJNZ 6A9C +6AA5 C1 . POP BC +6AA6 E1 . POP HL +6AA7 C9 . RET +6AA8 11 FF FF ... LD DE,FFFF +6AAB C9 . RET +6AAC 11 FF FF ... LD DE,FFFF +6AAF 18 F4 .. JR 6AA5 +6AB1 06 08 .. LD B,08 +6AB3 FD E5 .. PUSH IY +6AB5 FD 21 00 00 .!.. LD IY,0000 +6AB9 C5 . PUSH BC +6ABA D5 . PUSH DE +6ABB CD DA 66 ..f CALL 66DA +6ABE 78 x LD A,B +6ABF 3D = DEC A +6AC0 87 . ADD A +6AC1 B5 . OR L +6AC2 6F o LD L,A +6AC3 5E ^ LD E,(HL) +6AC4 2C , INC L +6AC5 56 V LD D,(HL) +6AC6 14 . INC D +6AC7 28 23 (# JR Z,6AEC +6AC9 15 . DEC D +6ACA 3E FF >. LD A,FF +6ACC CD 3F 6A .?j CALL 6A3F +6ACF 67 g LD H,A +6AD0 2E 00 .. LD L,00 +6AD2 06 00 .. LD B,00 +6AD4 23 # INC HL +6AD5 7E ~ LD A,(HL) +6AD6 23 # INC HL +6AD7 3C < INC A +6AD8 28 02 (. JR Z,6ADC +6ADA FD 23 .# INC IY +6ADC 10 F6 .. DJNZ 6AD4 +6ADE CD C1 5C ..\ CALL 5CC1 +6AE1 D1 . POP DE +6AE2 C1 . POP BC +6AE3 10 D4 .. DJNZ 6AB9 +6AE5 FD E5 .. PUSH IY +6AE7 D1 . POP DE +6AE8 FD E1 .. POP IY +6AEA 18 B9 .. JR 6AA5 +6AEC D1 . POP DE +6AED C1 . POP BC +6AEE 2D - DEC L +6AEF 2D - DEC L +6AF0 7E ~ LD A,(HL) +6AF1 3C < INC A +6AF2 20 EF . JR NZ,6AE3 +6AF4 05 . DEC B +6AF5 18 F7 .. JR 6AEE +6AF7 45 E LD B,L ; "EUMEL-000" +6AF8 55 U LD D,L +6AF9 4D M LD C,L +6AFA 45 E LD B,L +6AFB 4C L LD C,H +6AFC 2D - DEC L +6AFD 30 30 00 JR NC,6B2F +6AFF 30 11 0. JR NC,6B12 +6B01 20 20 JR NZ,6B23 ; " *** RERUN ***CRLF" +6B03 2A 2A 2A *** LD HL,(2A2A) +6B06 20 52 R JR NZ,6B5A +6B08 45 E LD B,L +6B09 52 R LD D,D +6B0A 55 U LD D,L +6B0B 4E N LD C,(HL) +6B0C 20 2A * JR NZ,6B38 +6B0E 2A 2A 0A **. LD HL,(0A2A) +6B11 0D . DEC C +6B12 01 FF FF ... LD BC,FFFF +6B15 01 FF +6B17 FF FF ; session +6B19 78 x LD A,B +6B1A 13 . INC DE +6B1B 20 53 S JR NZ,6B70 ; " System aufgebaut." +6B1D 79 y LD A,C +6B1E 73 s LD (HL),E +6B1F 74 t LD (HL),H +6B20 65 e LD H,L +6B21 6D m LD L,L +6B22 20 61 a JR NZ,6B85 +6B24 75 u LD (HL),L +6B25 66 f LD H,(HL) +6B26 67 g LD H,A +6B27 65 e LD H,L +6B28 62 b LD H,D +6B29 61 a LD H,C +6B2A 75 u LD (HL),L +6B2B 74 t LD (HL),H +6B2C 2E 20 . LD L,20 +6B2E 31 37 35 175 LD SP,3537 ; "175 restart 2 (!)" +6B31 20 72 r JR NZ,6BA5 +6B33 65 e LD H,L +6B34 73 s LD (HL),E +6B35 74 t LD (HL),H +6B36 61 a LD H,C +6B37 72 r LD (HL),D +6B38 74 t LD (HL),H +6B39 20 20 JR NZ,6B5B +6B3B 20 32 2 JR NZ,6B6F +6B3D 20 28 ( JR NZ,6B67 +6B3F 21 29 +6B41 ED 5B 46 6C LD DE,(6C46) +6B45 ED 53 F7 6E .S.n LD (6EF7),DE +6B49 11 13 6C ..l LD DE,6C13 +6B4C ED 53 46 6C .SFl LD (6C46),DE +6B50 ED 73 F2 6E .s.n LD (6EF2),SP +6B54 3A F0 6E :.n LD A,(6EF0) +6B57 B7 . OR A +6B58 28 21 (! JR Z,6B7B +6B5A 06 00 .. LD B,00 +6B5C 97 . SUB A +6B5D 32 F0 6E 2.n LD (6EF0),A +6B60 CD 98 6E ..n CALL 6E98 +6B63 FE 69 .i CP 69 ; "i" und Info-Taste +6B65 28 09 (. JR Z,6B70 +6B67 C5 . PUSH BC +6B68 CD E2 6D ..m CALL 6DE2 +6B6B C1 . POP BC +6B6C 10 EE .. DJNZ 6B5C +6B6E 18 0B .. JR 6B7B ; Info aufrufen +6B70 CD 1F 70 ..p CALL 701F ; "-break" +6B73 18 06 .. JR 6B7B +6B75 2D - DEC L +6B76 62 b LD H,D +6B77 72 r LD (HL),D +6B78 65 e LD H,L +6B79 61 a LD H,C +6B7A 6B k LD L,E +6B7B CD 9C 4B ..K CALL 4B9C +6B7E 97 . SUB A +6B7F 32 F6 6E 2.n LD (6EF6),A +6B82 2A 1A 6E *.n LD HL,(6E1A) ; Aktuelle Task +6B85 CB FD .. SET 7,L +6B87 2C , INC L ; Nechste Task +6B88 01 FF FF ... LD BC,FFFF ; unendlich +6B8B 3E 01 >. LD A,01 ; aktive Task suchen +6B8D ED B1 .. CPIR +6B8F CB 7D .} BIT 7,L +6B91 20 0E . JR NZ,6BA1 ; 01 gefunden +6B93 21 81 18 !.. LD HL,1881 ; Auf Anfang +6B96 ED B1 .. CPIR ; naechste suchen +6B98 CB 7D .} BIT 7,L +6B9A 20 05 . JR NZ,6BA1 +6B9C CD E2 6D ..m CALL 6DE2 ; keine aktivierte Task gefunden +6B9F 18 B3 .. JR 6B54 ; Auf Info-Taste warten +6BA1 2D - DEC L +6BA2 CB BD .. RES 7,L +6BA4 22 1A 6E ".n LD (6E1A),HL ; Taskindex Merken +6BA7 CD E2 6D ..m CALL 6DE2 ; Prozess wechseln +6BAA 3A 1A 6E :.n LD A,(6E1A) +6BAD 57 W LD D,A ; DE= PCB (DS 0) +6BAE 1E 00 .. LD E,00 +6BB0 CD DE 66 ..f CALL 66DE +6BB3 22 1C 6E ".n LD (6E1C),HL +6BB6 2A F7 6E *.n LD HL,(6EF7) +6BB9 22 46 6C "Fl LD (6C46),HL +6BBC DD 2A 1C 6E .*.n LD IX,(6E1C) +6BC0 3A 1A 6E :.n LD A,(6E1A) ; Taskindex (Leitblock) <> Maxiproz +6BC3 DD BE 30 ..0 CP (IX+30) +6BC6 28 14 (. JR Z,6BDC +6BC8 CD 1F 70 ..p CALL 701F ; Info aufrufen +6BCB 18 0F .. JR 6BDC +6BCD 20 6B k JR NZ,6C3A ; " kein Leitblock" +6BCF 65 e LD H,L +6BD0 69 i LD L,C +6BD1 6E n LD L,(HL) +6BD2 20 4C L JR NZ,6C20 +6BD4 65 e LD H,L +6BD5 69 i LD L,C +6BD6 74 t LD (HL),H +6BD7 62 b LD H,D +6BD8 6C l LD L,H +6BD9 6F o LD L,A +6BDA 63 c LD H,E +6BDB 6B k LD L,E +6BDC DD 7E 01 .~. LD A,(IX+01) +6BDF B7 . OR A ; wstate = 00, Task nicht aktiv +6BE0 C8 . RET Z +6BE1 FE FE .. CP FE ; wstate = FE: Info-Stop +6BE3 20 17 . JR NZ,6BFC +6BE5 CD 1F 70 ..p CALL 701F ; Info aufrufen +6BE8 18 10 .. JR 6BFA ; " stop durch info" +6BEA 20 73 s JR NZ,6C5F +6BEC 74 t LD (HL),H +6BED 6F o LD L,A +6BEE 70 p LD (HL),B +6BEF 20 64 d JR NZ,6C55 +6BF1 75 u LD (HL),L +6BF2 72 r LD (HL),D +6BF3 63 c LD H,E +6BF4 68 h LD L,B +6BF5 20 69 i JR NZ,6C60 +6BF7 6E n LD L,(HL) +6BF8 66 f LD H,(HL) +6BF9 6F o LD L,A +6BFA 18 12 .. JR 6C0E ; wstate loword: addresse im Hauptsp. +6BFC 67 g LD H,A ; IX+1 +6BFD DD 6E 00 .n. LD L,(IX+00) ; wstate low +6C00 DD 7E 02 .~. LD A,(IX+02) ; wstate highword: (wstate lowword) +6C03 BE . CP (HL) +6C04 20 08 . JR NZ,6C0E ; highbyte wstate +6C06 24 $ INC H +6C07 DD 7E 03 .~. LD A,(IX+03) +6C0A BE . CP (HL) +6C0B CA 41 6B .Ak JP Z,6B41 ; wstate/wstate+256 = (wstate) +6C0E DD 36 01 00 .6.. LD (IX+01),00 ; Inhalt nicht gleich +6C12 C9 . RET +6C13 ED 7B F2 6E .{.n LD SP,(6EF2) +6C17 C3 54 6B .Tk JP 6B54 +6C1A FD 2A FA 6E .*.n LD IY,(6EFA) ; Prozess start +6C1E FD 23 .# INC IY +6C20 FD 23 .# INC IY +6C22 FD E9 .. JP (IY) +6C24 DD 2A 1C 6E .*.n LD IX,(6E1C) +6C28 DD 75 00 .u. LD (IX+00),L ; wstate neu setzen addresse +6C2B DD 74 01 .t. LD (IX+01),H +6C2E 7E ~ LD A,(HL) +6C2F DD 77 02 .w. LD (IX+02),A ; inhalt von wstate +6C32 24 $ INC H +6C33 7E ~ LD A,(HL) +6C34 DD 77 03 .w. LD (IX+03),A +6C37 C3 26 29 .&) JP 2926 ; wartezustand +6C3A 50 P LD D,B ; "PROZ ELAN" +6C3B 52 R LD D,D +6C3C 4F O LD C,A +6C3D 5A Z LD E,D +6C3E 20 45 E JR NZ,6C85 +6C40 4C L LD C,H +6C41 41 A LD B,C +6C42 4E N LD C,(HL) +6C43 11 6D C3 .m. LD DE,C36D +6C46 45 E LD B,L +6C47 6D m LD L,L +6C48 45 E LD B,L +6C49 FF . RST 38 +6C4A FF . RST 38 +6C4B FF . RST 38 +6C4C FF . RST 38 +6C4D FF . RST 38 +6C4E FF . RST 38 +6C4F FF . RST 38 +6C50 FF . RST 38 +6C51 FF . RST 38 +6C52 FF . RST 38 +6C53 FF . RST 38 +6C54 FF . RST 38 +6C55 FF . RST 38 +6C56 FF . RST 38 +6C57 FF . RST 38 +6C58 FF . RST 38 +6C59 FF . RST 38 +6C5A FF . RST 38 +6C5B FF . RST 38 +6C5C FF . RST 38 +6C5D FF . RST 38 +6C5E FF . RST 38 +6C5F FF . RST 38 +6C60 FF . RST 38 +6C61 FF . RST 38 +6C62 FF . RST 38 +6C63 FF . RST 38 +6C64 FF . RST 38 +6C65 FF . RST 38 +6C66 FF . RST 38 +6C67 FF . RST 38 +6C68 FF . RST 38 +6C69 FF . RST 38 +6C6A FF . RST 38 +6C6B FF . RST 38 +6C6C FF . RST 38 +6C6D FF . RST 38 +6C6E FF . RST 38 +6C6F FF . RST 38 +6C70 FF . RST 38 +6C71 FF . RST 38 +6C72 FF . RST 38 +6C73 FF . RST 38 +6C74 FF . RST 38 +6C75 FF . RST 38 +6C76 FF . RST 38 +6C77 FF . RST 38 +6C78 FF . RST 38 +6C79 FF . RST 38 +6C7A FF . RST 38 +6C7B FF . RST 38 +6C7C FF . RST 38 +6C7D FF . RST 38 +6C7E FF . RST 38 +6C7F FF . RST 38 +6C80 FF . RST 38 +6C81 FF . RST 38 +6C82 FF . RST 38 +6C83 FF . RST 38 +6C84 FF . RST 38 +6C85 FF . RST 38 +6C86 FF . RST 38 +6C87 FF . RST 38 +6C88 FF . RST 38 +6C89 FF . RST 38 +6C8A FF . RST 38 +6C8B FF . RST 38 +6C8C FF . RST 38 +6C8D FF . RST 38 +6C8E FF . RST 38 +6C8F FF . RST 38 +6C90 FF . RST 38 +6C91 FF . RST 38 +6C92 FF . RST 38 +6C93 FF . RST 38 +6C94 FF . RST 38 +6C95 FF . RST 38 +6C96 FF . RST 38 +6C97 FF . RST 38 +6C98 FF . RST 38 +6C99 FF . RST 38 +6C9A FF . RST 38 +6C9B FF . RST 38 +6C9C FF . RST 38 +6C9D FF . RST 38 +6C9E FF . RST 38 +6C9F FF . RST 38 +6CA0 FF . RST 38 +6CA1 FF . RST 38 +6CA2 FF . RST 38 +6CA3 FF . RST 38 +6CA4 FF . RST 38 +6CA5 FF . RST 38 +6CA6 FF . RST 38 +6CA7 FF . RST 38 +6CA8 FF . RST 38 +6CA9 FF . RST 38 +6CAA FF . RST 38 +6CAB FF . RST 38 +6CAC FF . RST 38 +6CAD FF . RST 38 +6CAE FF . RST 38 +6CAF FF . RST 38 +6CB0 FF . RST 38 +6CB1 FF . RST 38 +6CB2 FF . RST 38 +6CB3 FF . RST 38 +6CB4 FF . RST 38 +6CB5 FF . RST 38 +6CB6 FF . RST 38 +6CB7 FF . RST 38 +6CB8 FF . RST 38 +6CB9 FF . RST 38 +6CBA FF . RST 38 +6CBB FF . RST 38 +6CBC FF . RST 38 +6CBD FF . RST 38 +6CBE FF . RST 38 +6CBF FF . RST 38 +6CC0 FF . RST 38 +6CC1 FF . RST 38 +6CC2 FF . RST 38 +6CC3 FF . RST 38 +6CC4 FF . RST 38 +6CC5 FF . RST 38 +6CC6 FF . RST 38 +6CC7 FF . RST 38 +6CC8 FF . RST 38 +6CC9 FF . RST 38 +6CCA FF . RST 38 +6CCB FF . RST 38 +6CCC FF . RST 38 +6CCD FF . RST 38 +6CCE FF . RST 38 +6CCF FF . RST 38 +6CD0 FF . RST 38 +6CD1 FF . RST 38 +6CD2 FF . RST 38 +6CD3 FF . RST 38 +6CD4 FF . RST 38 +6CD5 FF . RST 38 +6CD6 FF . RST 38 +6CD7 FF . RST 38 +6CD8 FF . RST 38 +6CD9 FF . RST 38 +6CDA FF . RST 38 +6CDB FF . RST 38 +6CDC FF . RST 38 +6CDD FF . RST 38 +6CDE FF . RST 38 +6CDF FF . RST 38 +6CE0 FF . RST 38 +6CE1 FF . RST 38 +6CE2 FF . RST 38 +6CE3 FF . RST 38 +6CE4 FF . RST 38 +6CE5 FF . RST 38 +6CE6 FF . RST 38 +6CE7 FF . RST 38 +6CE8 FF . RST 38 +6CE9 FF . RST 38 +6CEA FF . RST 38 +6CEB FF . RST 38 +6CEC FF . RST 38 +6CED FF . RST 38 +6CEE FF . RST 38 +6CEF FF . RST 38 +6CF0 FF . RST 38 +6CF1 FF . RST 38 +6CF2 FF . RST 38 +6CF3 FF . RST 38 +6CF4 FF . RST 38 +6CF5 FF . RST 38 +6CF6 FF . RST 38 +6CF7 FF . RST 38 +6CF8 FF . RST 38 +6CF9 FF . RST 38 +6CFA FF . RST 38 +6CFB FF . RST 38 +6CFC FF . RST 38 +6CFD FF . RST 38 +6CFE FF . RST 38 +6CFF FF . RST 38 +6D00 FF . RST 38 +6D01 FF . RST 38 +6D02 FF . RST 38 +6D03 FF . RST 38 +6D04 FF . RST 38 +6D05 FF . RST 38 +6D06 FF . RST 38 +6D07 FF . RST 38 +6D08 FF . RST 38 +6D09 FF . RST 38 +6D0A FF . RST 38 +6D0B FF . RST 38 +6D0C FF . RST 38 +6D0D FF . RST 38 +6D0E FF . RST 38 +6D0F FF . RST 38 +6D10 FF . RST 38 +6D11 13 . INC DE +6D12 6D m LD L,L +6D13 CD 2D 57 .-W CALL 572D +6D16 11 00 00 ... LD DE,0000 ; Task 0, DS 0 laden (Aktiv.Tab.) +6D19 CD DA 66 ..f CALL 66DA +6D1C 11 80 18 ... LD DE,1880 ; 128 Bytes Akt.Tabelle +6D1F 01 80 00 ... LD BC,0080 +6D22 ED B0 .. LDIR +6D24 3A FF 18 :.. LD A,(18FF) ; 18FF = FF: SV und 18FF := 01 +6D27 3C < INC A ; sonst alten SV-Zustand lassen +6D28 20 07 . JR NZ,6D31 +6D2A 3C < INC A +6D2B 32 81 18 2.. LD (1881),A ; supervisor aktivieren +6D2E 32 FF 18 2.. LD (18FF),A +6D31 11 B9 4C ..L LD DE,4CB9 ; Systemclocks (7) +6D34 01 40 00 .@. LD BC,0040 +6D37 ED B0 .. LDIR +6D39 CD 41 6B .Ak CALL 6B41 +6D3C 21 24 6C !$l LD HL,6C24 +6D3F 22 46 6C "Fl LD (6C46),HL +6D42 C3 FE 52 ..R JP 52FE +6D45 31 13 6D 1.m LD SP,6D13 +6D48 CD E2 6D ..m CALL 6DE2 ; Prozess wechseln +6D4B 18 C9 .. JR 6D16 ; Aktivierungstabelle/Clocks laden +6D4D B7 . OR A +6D4E 20 0A . JR NZ,6D5A +6D50 CD 1F 70 ..p CALL 701F ; Info aufrufen " plac" +6D53 18 05 .. JR 6D5A +6D55 20 70 p JR NZ,6DC7 +6D57 6C l LD L,H +6D58 61 a LD H,C +6D59 63 c LD H,E +6D5A D5 . PUSH DE +6D5B E5 . PUSH HL +6D5C 57 W LD D,A +6D5D 1E 00 .. LD E,00 ; Leitblock der Task laden +6D5F CD DE 66 ..f CALL 66DE +6D62 E5 . PUSH HL +6D63 FD E1 .. POP IY ; Adresse --> IY +6D65 E1 . POP HL +6D66 D1 . POP DE +6D67 C9 . RET ; -------- unblock (A) ------------ +6D68 B7 . OR A +6D69 C8 . RET Z +6D6A E5 . PUSH HL +6D6B 26 18 &. LD H,18 ; Aktivierungstabelle 1880 .... +6D6D 6F o LD L,A +6D6E CB FD .. SET 7,L +6D70 36 01 6. LD (HL),01 ; Task aktivieren +6D72 E1 . POP HL +6D73 C9 . RET ;------------- block (A) --------- +6D74 E5 . PUSH HL +6D75 26 18 &. LD H,18 +6D77 6F o LD L,A +6D78 CB FD .. SET 7,L ; AKtivierungstabelle +6D7A 36 FF 6. LD (HL),FF ; Task deaktivieren +6D7C E1 . POP HL +6D7D C9 . RET ;---------------------------------- +6D7E C5 . PUSH BC +6D7F E5 . PUSH HL +6D80 01 FF FF ... LD BC,FFFF +6D83 26 18 &. LD H,18 +6D85 C6 81 .. ADD A,81 +6D87 6F o LD L,A +6D88 3E 01 >. LD A,01 +6D8A ED B1 .. CPIR +6D8C CB 7D .} BIT 7,L +6D8E 20 09 . JR NZ,6D99 +6D90 21 81 18 !.. LD HL,1881 +6D93 ED B1 .. CPIR +6D95 CB 7D .} BIT 7,L +6D97 28 03 (. JR Z,6D9C +6D99 2D - DEC L +6D9A CB BD .. RES 7,L +6D9C 7D } LD A,L +6D9D E1 . POP HL +6D9E C1 . POP BC +6D9F C9 . RET ; ====== Miniprozess-Schleife ====== +6DA0 21 43 6C !Cl LD HL,6C43 ; PROZ ELAN +6DA3 ED 7B 43 6C .{Cl LD SP,(6C43) +6DA7 CD DA 6D ..m CALL 6DDA ; +6DAA ED 73 43 6C .sCl LD (6C43),SP +6DAE 21 74 57 !tW LD HL,5774 ; PROZ LADER +6DB1 ED 7B 74 57 .{tW LD SP,(5774) +6DB5 CD DA 6D ..m CALL 6DDA +6DB8 ED 73 74 57 .stW LD (5774),SP +6DBC 21 5E 7D !^} LD HL,7D5E ; PROZ MUELL +6DBF ED 7B 5E 7D .{^} LD SP,(7D5E) +6DC3 CD DA 6D ..m CALL 6DDA +6DC6 ED 73 5E 7D .s^} LD (7D5E),SP +6DCA 21 CE 62 !.b LD HL,62CE ; PROZ ARCH +6DCD ED 7B CE 62 .{.b LD SP,(62CE) +6DD1 CD DA 6D ..m CALL 6DDA +6DD4 ED 73 CE 62 .s.b LD (62CE),SP +6DD8 18 C6 .. JR 6DA0 ; zum Schleifenanfang +6DDA 22 FA 6E ".n LD (6EFA),HL ;------- Prozess wechseln --------- +6DDD E1 . POP HL +6DDE 22 1E 6E ".n LD (6E1E),HL +6DE1 C9 . RET +6DE2 3A FC 6E :.n LD A,(6EFC) +6DE5 B7 . OR A +6DE6 C0 . RET NZ +6DE7 2A 1E 6E *.n LD HL,(6E1E) +6DEA E9 . JP (HL) +6DEB F5 . PUSH AF +6DEC 3A 0D 6E :.n LD A,(6E0D) +6DEF 3D = DEC A +6DF0 FA FC 6D ..m JP M,6DFC +6DF3 32 0D 6E 2.n LD (6E0D),A +6DF6 20 04 . JR NZ,6DFC +6DF8 97 . SUB A +6DF9 32 FC 6E 2.n LD (6EFC),A +6DFC F1 . POP AF +6DFD C9 . RET +6DFE F5 . PUSH AF +6DFF 3A 0D 6E :.n LD A,(6E0D) +6E02 3C < INC A +6E03 32 0D 6E 2.n LD (6E0D),A +6E06 3E 01 >. LD A,01 +6E08 32 FC 6E 2.n LD (6EFC),A +6E0B F1 . POP AF +6E0C C9 . RET +6E0D 00 . NOP +6E0E FD E5 .. PUSH IY +6E10 FD 2A FA 6E .*.n LD IY,(6EFA) +6E14 FD 7E 05 .~. LD A,(IY+05) +6E17 FD E1 .. POP IY +6E19 C9 . RET +6E1A 80 . ADD B +6E1B 18 00 .. JR 6E1D +6E1D 00 . NOP +6E1E 00 . NOP ; Miniprozess addresse +6E1F 00 . NOP +6E20 DD E3 .. EX (SP),IX +6E22 FD E5 .. PUSH IY ; warte +6E24 D5 . PUSH DE +6E25 C5 . PUSH BC +6E26 E5 . PUSH HL +6E27 F5 . PUSH AF +6E28 DD E9 .. JP (IX) +6E2A DD E1 .. POP IX +6E2C F1 . POP AF +6E2D E1 . POP HL +6E2E C1 . POP BC +6E2F D1 . POP DE +6E30 FD E1 .. POP IY +6E32 DD E3 .. EX (SP),IX +6E34 C9 . RET ;========= timerinterrupt ======= +6E35 F5 . PUSH AF +6E36 3A FC 6E :.n LD A,(6EFC) +6E39 B7 . OR A +6E3A 20 2C , JR NZ,6E68 +6E3C F1 . POP AF +6E3D FB . EI +6E3E CD 3E 21 .>! CALL 213E +6E41 F5 . PUSH AF +6E42 E5 . PUSH HL +6E43 2A F9 6E *.n LD HL,(6EF9) +6E46 2D - DEC L +6E47 28 1E (. JR Z,6E67 +6E49 F5 . PUSH AF +6E4A 21 F4 6E !.n LD HL,6EF4 +6E4D 86 . ADD (HL) +6E4E 77 w LD (HL),A +6E4F F1 . POP AF +6E50 F5 . PUSH AF +6E51 23 # INC HL +6E52 86 . ADD (HL) +6E53 77 w LD (HL),A +6E54 D6 64 .d SUB A,64 ; MOD 100 +6E56 38 04 8. JR C,6E5C +6E58 77 w LD (HL),A +6E59 CD 4C 4B .LK CALL 4B4C +6E5C F1 . POP AF +6E5D 21 F6 6E !.n LD HL,6EF6 +6E60 86 . ADD (HL) +6E61 77 w LD (HL),A +6E62 FE 64 .d CP 64 +6E64 D4 9A 2A ..* CALL NC,2A9A +6E67 E1 . POP HL +6E68 F1 . POP AF +6E69 C9 . RET ;------------ Info Taste ---------- +6E6A 32 F1 6E 2.n LD (6EF1),A ; Taste zweimal druecken +6E6D 3A F0 6E :.n LD A,(6EF0) +6E70 B7 . OR A +6E71 28 1F (. JR Z,6E92 +6E73 CD 8F 6E ..n CALL 6E8F +6E76 CD 1F 70 ..p CALL 701F ; Info aufrufen +6E79 18 0F .. JR 6E8A ; " Info erzwungen" +6E7B 20 49 I JR NZ,6EC6 +6E7D 6E n LD L,(HL) +6E7E 66 f LD H,(HL) +6E7F 6F o LD L,A +6E80 20 65 e JR NZ,6EE7 +6E82 72 r LD (HL),D +6E83 7A z LD A,D +6E84 77 w LD (HL),A +6E85 75 u LD (HL),L +6E86 6E n LD L,(HL) +6E87 67 g LD H,A +6E88 65 e LD H,L +6E89 6E n LD L,(HL) +6E8A 97 . SUB A +6E8B 32 F0 6E 2.n LD (6EF0),A +6E8E C9 . RET ;---------------------------------- +6E8F FB . EI +6E90 ED 4D .M RETI +6E92 3C < INC A +6E93 32 F0 6E 2.n LD (6EF0),A ; info tasten anzahl +6E96 97 . SUB A +6E97 C9 . RET +6E98 3A F1 6E :.n LD A,(6EF1) ; info kanal +6E9B C3 06 1F ... JP 1F06 ; auf taste warten +6E9E CD 98 6E ..n CALL 6E98 +6EA1 D0 . RET NC +6EA2 CD 20 6E . n CALL 6E20 +6EA5 CD E2 6D ..m CALL 6DE2 +6EA8 CD 2A 6E .*n CALL 6E2A +6EAB 18 F1 .. JR 6E9E +6EAD CD CA 6E ..n CALL 6ECA +6EB0 CD 9E 6E ..n CALL 6E9E +6EB3 CD B9 6E ..n CALL 6EB9 +6EB6 FE 6A .j CP 6A ; j +6EB8 C9 . RET +6EB9 32 C9 6E 2.n LD (6EC9),A +6EBC E5 . PUSH HL +6EBD 21 C8 6E !.n LD HL,6EC8 +6EC0 CD CA 6E ..n CALL 6ECA +6EC3 E1 . POP HL +6EC4 3A C9 6E :.n LD A,(6EC9) +6EC7 C9 . RET +6EC8 01 00 E5 ... LD BC,E500 +6ECB C5 . PUSH BC +6ECC 4E N LD C,(HL) ; Laenge am Stringanafng +6ECD 23 # INC HL +6ECE 06 00 .. LD B,00 +6ED0 3A F1 6E :.n LD A,(6EF1) +6ED3 C5 . PUSH BC +6ED4 CD 88 21 ..! CALL 2188 ; OUTPUT +6ED7 38 13 8. JR C,6EEC +6ED9 CD 20 6E . n CALL 6E20 +6EDC CD E2 6D ..m CALL 6DE2 +6EDF CD 2A 6E .*n CALL 6E2A +6EE2 09 . ADD HL,BC +6EE3 E3 . EX (SP),HL +6EE4 B7 . OR A +6EE5 ED 42 .B SBC HL,BC +6EE7 44 D LD B,H +6EE8 4D M LD C,L +6EE9 E1 . POP HL +6EEA 18 E4 .. JR 6ED0 +6EEC C1 . POP BC +6EED C1 . POP BC +6EEE E1 . POP HL +6EEF C9 . RET +6EF0 00 . NOP +6EF1 01 00 00 ... LD BC,0000 +6EF4 00 . NOP +6EF5 00 . NOP +6EF6 00 . NOP +6EF7 00 . NOP +6EF8 00 . NOP +6EF9 00 . NOP +6EFA 43 C LD B,E +6EFB 6C l LD L,H +6EFC 01 69 6E .in LD BC,6E69 ; "info quelle 3 (!)" +6EFF 66 f LD H,(HL) +6F00 6F o LD L,A +6F01 2E 71 .q LD L,71 +6F03 75 u LD (HL),L +6F04 65 e LD H,L +6F05 6C l LD L,H +6F06 6C l LD L,H +6F07 65 e LD H,L +6F08 20 20 JR NZ,6F2A +6F0A 20 33 3 JR NZ,6F3F +6F0C 20 28 ( JR NZ,6F36 +6F0E 21 29 +6F10 D5 PUSH DE ;------------------------------ +6F11 CD B1 7A ..z CALL 7AB1 ; Altes Password korrekt ? +6F14 D1 . POP DE +6F15 01 01 00 ... LD BC,0001 +6F18 C0 . RET NZ +6F19 21 19 7D !.} LD HL,7D19 +6F1C 06 0A .. LD B,0A ; 10 Bytes invertieren und uebetr. +6F1E 1A . LD A,(DE) ; Neues Password eintragen +6F1F 2F / CPL +6F20 77 w LD (HL),A +6F21 23 # INC HL +6F22 13 . INC DE +6F23 10 F9 .. DJNZ 6F1E +6F25 01 00 00 ... LD BC,0000 +6F28 C9 . RET +6F29 C9 . RET ;---------------------------------- +6F2A CD 1F 70 ..p CALL 701F ; Info aufrufen +6F2D 18 03 .. JR 6F32 +6F2F 20 4B K JR NZ,6F7C ; " KE" +6F31 45 E LD B,L +6F32 C9 . RET ;---------- info-taste gedrueckt --- +6F33 C3 6A 6E .jn JP 6E6A ; Info aufrufen +6F36 C3 CA 6E ..n JP 6ECA +6F39 7A z LD A,D +6F3A B7 . OR A +6F3B 28 14 (. JR Z,6F51 +6F3D FE FF .. CP FF +6F3F 20 04 . JR NZ,6F45 +6F41 7C | LD A,H +6F42 CB 27 .' SLA A +6F44 C9 . RET +6F45 CD 72 6F .ro CALL 6F72 +6F48 CD 5C 65 .\e CALL 655C +6F4B DD E1 .. POP IX +6F4D CD 10 70 ..p CALL 7010 +6F50 C9 . RET +6F51 E5 . PUSH HL +6F52 6C l LD L,H +6F53 63 c LD H,E +6F54 C5 . PUSH BC +6F55 ED 4B 9B 7C .K.| LD BC,(7C9B) +6F59 B7 . OR A +6F5A ED 42 .B SBC HL,BC +6F5C 30 68 0h JR NC,6FC6 +6F5E 09 . ADD HL,BC +6F5F C1 . POP BC +6F60 CD 92 5A ..Z CALL 5A92 +6F63 7C | LD A,H +6F64 E1 . POP HL +6F65 C9 . RET +6F66 CD 72 6F .ro CALL 6F72 +6F69 CD 36 6A .6j CALL 6A36 +6F6C DD E1 .. POP IX +6F6E CD 10 70 ..p CALL 7010 +6F71 C9 . RET +6F72 DD E1 .. POP IX +6F74 DD 22 8C 6F .".o LD (6F8C),IX +6F78 CD 20 6E . n CALL 6E20 +6F7B DD 2A 8C 6F .*.o LD IX,(6F8C) +6F7F DD E5 .. PUSH IX +6F81 ED 73 90 6F .s.o LD (6F90),SP +6F85 DD E9 .. JP (IX) +6F87 69 i LD L,C ; "ixsav" +6F88 78 x LD A,B +6F89 73 s LD (HL),E +6F8A 61 a LD H,C +6F8B 76 v HALT +6F8C 00 . NOP +6F8D 00 . NOP +6F8E 00 . NOP +6F8F 00 . NOP +6F90 00 . NOP +6F91 00 . NOP +6F92 00 . NOP +6F93 00 . NOP +6F94 3A 4B 7B :K{ LD A,(7B4B) +6F97 B7 . OR A +6F98 28 31 (1 JR Z,6FCB +6F9A ED 7B 90 6F .{.o LD SP,(6F90) +6F9E CD E2 6D ..m CALL 6DE2 ; Prozess wechseln +6FA1 DD E1 .. POP IX +6FA3 DD 22 8C 6F .".o LD (6F8C),IX +6FA7 DD E5 .. PUSH IX +6FA9 3A 1A 6E :.n LD A,(6E1A) ; Taskindex aktueller Prozess +6FAC E6 7F .. AND 7F +6FAE 28 0F (. JR Z,6FBF ; Task 0 ? +6FB0 57 W LD D,A ; PCB laden +6FB1 1E 00 .. LD E,00 +6FB3 CD DE 66 ..f CALL 66DE +6FB6 22 1C 6E ".n LD (6E1C),HL +6FB9 21 FF FF !.. LD HL,FFFF +6FBC 22 23 7D "#} LD (7D23),HL +6FBF DD E1 .. POP IX +6FC1 CD 2A 6E .*n CALL 6E2A +6FC4 18 B2 .. JR 6F78 +6FC6 21 BC 7C !.| LD HL,7CBC +6FC9 18 03 .. JR 6FCE +6FCB 21 A6 7C !.| LD HL,7CA6 +6FCE ED 7B 8E 6F .{.o LD SP,(6F8E) +6FD2 CD CA 6E ..n CALL 6ECA +6FD5 C3 D4 70 ..p JP 70D4 +6FD8 ED 7B 8E 6F .{.o LD SP,(6F8E) +6FDC C3 8A 71 ..q JP 718A +6FDF 7A z LD A,D +6FE0 B7 . OR A +6FE1 CA 51 6F .Qo JP Z,6F51 +6FE4 FE FF .. CP FF +6FE6 20 04 . JR NZ,6FEC +6FE8 7C | LD A,H +6FE9 CB 27 .' SLA A +6FEB C9 . RET +6FEC CD 72 6F .ro CALL 6F72 +6FEF CD 2C 66 .,f CALL 662C +6FF2 DD E1 .. POP IX +6FF4 CD 10 70 ..p CALL 7010 +6FF7 C9 . RET +6FF8 CD 72 6F .ro CALL 6F72 +6FFB CD DA 66 ..f CALL 66DA +6FFE DD E1 .. POP IX +7000 CD 10 70 ..p CALL 7010 +7003 C9 . RET +7004 CD 72 6F .ro CALL 6F72 +7007 CD DE 66 ..f CALL 66DE +700A DD E1 .. POP IX +700C CD 10 70 ..p CALL 7010 +700F C9 . RET +7010 DD E1 .. POP IX +7012 FD 21 08 00 .!.. LD IY,0008 +7016 FD 39 .9 ADD IY,SP +7018 FD F9 .. LD SP,IY +701A FD E1 .. POP IY +701C DD E3 .. EX (SP),IX +701E C9 . RET ; =============== Info =========== +701F E3 . EX (SP),HL +7020 F5 . PUSH AF +7021 23 # INC HL +7022 23 # INC HL +7023 7E ~ LD A,(HL) +7024 2B + DEC HL +7025 2B + DEC HL +7026 B7 . OR A +7027 20 03 . JR NZ,702C +7029 F1 . POP AF +702A E3 . EX (SP),HL +702B C9 . RET +702C E5 . PUSH HL +702D 3A 60 78 :`x LD A,(7860) +7030 B7 . OR A +7031 28 13 (. JR Z,7046 +7033 23 # INC HL +7034 CD 98 75 ..u CALL 7598 +7037 CD 0E 6E ..n CALL 6E0E +703A 21 D2 77 !.w LD HL,77D2 +703D BE . CP (HL) +703E CA 29 71 .)q JP Z,7129 +7041 CD E2 6D ..m CALL 6DE2 +7044 18 FB .. JR 7041 +7046 E1 . POP HL +7047 F1 . POP AF +7048 E3 . EX (SP),HL +7049 FD E5 .. PUSH IY +704B F5 . PUSH AF +704C 3A 17 82 :.. LD A,(8217) +704F 3D = DEC A +7050 F2 56 70 .Vp JP P,7056 +7053 32 17 82 2.. LD (8217),A +7056 FD 21 04 00 .!.. LD IY,0004 +705A FD 39 .9 ADD IY,SP +705C F1 . POP AF +705D FD E5 .. PUSH IY +705F DD E5 .. PUSH IX +7061 D9 . EXX +7062 E5 . PUSH HL +7063 D5 . PUSH DE +7064 C5 . PUSH BC +7065 D9 . EXX +7066 08 . EX AF,AF' +7067 F5 . PUSH AF +7068 08 . EX AF,AF' +7069 E5 . PUSH HL +706A D5 . PUSH DE +706B C5 . PUSH BC +706C F5 . PUSH AF +706D CD 8A 28 ..( CALL 288A +7070 CB 70 .p BIT 6,B +7072 20 08 . JR NZ,707C +7074 CB 21 .! SLA C +7076 CB 10 .. RL B +7078 ED 43 9B 7C .C.| LD (7C9B),BC +707C FD 21 00 00 .!.. LD IY,0000 +7080 FD 39 .9 ADD IY,SP +7082 FD E5 .. PUSH IY +7084 21 60 78 !`x LD HL,7860 +7087 CD 65 82 .e. CALL 8265 +708A CD FE 6D ..m CALL 6DFE +708D 3E 01 >. LD A,01 +708F 32 F9 6E 2.n LD (6EF9),A +7092 FD 2A FA 6E .*.n LD IY,(6EFA) +7096 FD 4E 03 .N. LD C,(IY+03) +7099 FD 46 04 .F. LD B,(IY+04) +709C ED 43 50 7B .CP{ LD (7B50),BC +70A0 01 94 6F ..o LD BC,6F94 +70A3 FD 70 04 .p. LD (IY+04),B +70A6 FD 71 03 .q. LD (IY+03),C +70A9 97 . SUB A +70AA 32 4B 7B 2K{ LD (7B4B),A +70AD FD E1 .. POP IY +70AF 21 39 7B !9{ LD HL,7B39 +70B2 36 00 6. LD (HL),00 +70B4 21 26 7B !&{ LD HL,7B26 +70B7 22 5C 7B "\{ LD (7B5C),HL +70BA FD 22 92 6F .".o LD (6F92),IY +70BE 11 D1 77 ..w LD DE,77D1 +70C1 CD B2 74 ..t CALL 74B2 +70C4 3E FF >. LD A,FF +70C6 32 54 7B 2T{ LD (7B54),A +70C9 97 . SUB A +70CA 32 18 7D 2.} LD (7D18),A +70CD ED 73 8E 6F .s.o LD (6F8E),SP +70D1 CD F2 74 ..t CALL 74F2 +70D4 CD B2 75 ..u CALL 75B2 +70D7 FE 67 .g CP 67 ; "g" Weiter +70D9 CA 41 71 .Aq JP Z,7141 +70DC FE 50 .P CP 50 ; "P" Password +70DE CA 8D 7A ..z JP Z,7A8D +70E1 F5 . PUSH AF +70E2 3A 18 7D :.} LD A,(7D18) +70E5 B7 . OR A +70E6 28 41 (A JR Z,7129 +70E8 F1 . POP AF +70E9 FE 0D .. CP 0D ; CR Dump +70EB CA 5A 72 .Zr JP Z,725A +70EE FE 77 .w CP 77 ; w Wordaddress setzen +70F0 CA 3E 72 .>r JP Z,723E +70F3 FE 7A .z CP 7A ; z Leitblock zeigen +70F5 CA BB 71 ..q JP Z,71BB +70F8 FE 73 .s CP 73 ; s Dataspace waehlen +70FA CA 26 72 .&r JP Z,7226 +70FD FE 70 .p CP 70 ; p Byteaddresse setzen +70FF CA 2D 72 .-r JP Z,722D +7102 FE 6C .l CP 6C ; l Dumplaenge setzen +7104 CA 54 72 .Tr JP Z,7254 +7107 FE 6B .k CP 6B ; k Block vom HG laden +7109 CA A9 73 ..s JP Z,73A9 +710C FE 78 .x CP 78 ; x Bytekette suchen +710E CA C0 73 ..s JP Z,73C0 +7111 FE 6F .o CP 6F ; o Naechste Seite dumpen +7113 CA 51 73 .Qs JP Z,7351 +7116 FE 72 .r CP 72 ; r Miniprozesse freigeben +7118 28 1A (. JR Z,7134 +711A FE 79 .y CP 79 ; y Spezielle Kommando +711C CA B3 78 ..x JP Z,78B3 +711F FE 71 .q CP 71 ; q Zur anderen Tas wechseln +7121 CA A4 71 ..q JP Z,71A4 +7124 FE 74 .t CP 74 ; t Register anzeigen +7126 CC 07 7B ..{ CALL Z,7B07 +7129 3E 07 >. LD A,07 ; Unbekannt beep +712B CD A4 75 ..u CALL 75A4 +712E ED 7B 8E 6F .{.o LD SP,(6F8E) +7132 18 A0 .. JR 70D4 +7134 22 4C 7B "L{ LD (7B4C),HL +7137 CD EB 6D ..m CALL 6DEB +713A 3E 01 >. LD A,01 +713C 32 4B 7B 2K{ LD (7B4B),A +713F 18 93 .. JR 70D4 +7141 97 . SUB A +7142 32 F9 6E 2.n LD (6EF9),A +7145 21 60 78 !`x LD HL,7860 +7148 CD 62 82 .b. CALL 8262 +714B 3A 17 82 :.. LD A,(8217) +714E B7 . OR A +714F F2 56 71 .Vq JP P,7156 +7152 3C < INC A +7153 32 17 82 2.. LD (8217),A +7156 CD EB 6D ..m CALL 6DEB +7159 ED 4B 50 7B .KP{ LD BC,(7B50) +715D FD 2A FA 6E .*.n LD IY,(6EFA) +7161 FD 71 03 .q. LD (IY+03),C +7164 FD 70 04 .p. LD (IY+04),B +7167 3A 4B 7B :K{ LD A,(7B4B) +716A B7 . OR A +716B 28 0A (. JR Z,7177 +716D 21 00 00 !.. LD HL,0000 +7170 3A 4C 7B :L{ LD A,(7B4C) +7173 B7 . OR A +7174 CA 1A 6C ..l JP Z,6C1A +7177 F1 . POP AF +7178 C1 . POP BC +7179 D1 . POP DE +717A E1 . POP HL +717B 08 . EX AF,AF' +717C F1 . POP AF +717D 08 . EX AF,AF' +717E D9 . EXX +717F C1 . POP BC +7180 D1 . POP DE +7181 E1 . POP HL +7182 D9 . EXX +7183 DD E1 .. POP IX +7185 FD E1 .. POP IY +7187 FD E1 .. POP IY +7189 C9 . RET +718A 21 60 78 !`x LD HL,7860 +718D CD 62 82 .b. CALL 8262 +7190 ED 4B 50 7B .KP{ LD BC,(7B50) +7194 FD 2A FA 6E .*.n LD IY,(6EFA) +7198 FD 71 03 .q. LD (IY+03),C +719B FD 70 04 .p. LD (IY+04),B +719E CD E2 6D ..m CALL 6DE2 +71A1 C3 7C 70 .|p JP 707C +71A4 7D } LD A,L +71A5 B7 . OR A +71A6 CA D4 70 ..p JP Z,70D4 +71A9 55 U LD D,L +71AA 1E 00 .. LD E,00 +71AC F5 . PUSH AF +71AD CD 04 70 ..p CALL 7004 +71B0 2E 01 .. LD L,01 +71B2 36 FE 6. LD (HL),FE +71B4 F1 . POP AF +71B5 CD 68 6D .hm CALL 6D68 +71B8 C3 D4 70 ..p JP 70D4 +71BB 7C | LD A,H +71BC B5 . OR L +71BD 28 08 (. JR Z,71C7 +71BF 55 U LD D,L +71C0 1E 00 .. LD E,00 +71C2 CD F8 6F ..o CALL 6FF8 +71C5 18 03 .. JR 71CA +71C7 2A 1C 6E *.n LD HL,(6E1C) +71CA FD E5 .. PUSH IY +71CC FD 21 72 7B .!r{ LD IY,7B72 +71D0 3E 00 >. LD A,00 +71D2 32 71 7B 2q{ LD (7B71),A +71D5 E5 . PUSH HL +71D6 21 39 7B !9{ LD HL,7B39 +71D9 CB 86 .. RES 0,(HL) +71DB 21 6B 7C !k| LD HL,7C6B +71DE CD CA 6E ..n CALL 6ECA +71E1 CD 1C 7B ..{ CALL 7B1C +71E4 E1 . POP HL +71E5 FD 7E 02 .~. LD A,(IY+02) +71E8 B7 . OR A +71E9 CA 21 72 .!r JP Z,7221 +71EC FD 5E 00 .^. LD E,(IY+00) +71EF 16 00 .. LD D,00 +71F1 E5 . PUSH HL +71F2 19 . ADD HL,DE +71F3 FD 46 01 .F. LD B,(IY+01) +71F6 CD 2D 75 .-u CALL 752D +71F9 FD E5 .. PUSH IY +71FB E1 . POP HL +71FC 23 # INC HL +71FD 23 # INC HL +71FE CD CA 6E ..n CALL 6ECA +7201 3A 71 7B :q{ LD A,(7B71) +7204 C6 14 .. ADD A,14 +7206 FE 50 .P CP 50 +7208 38 04 8. JR C,720E +720A CD 1C 7B ..{ CALL 7B1C +720D 97 . SUB A +720E 32 71 7B 2q{ LD (7B71),A +7211 CD 84 75 ..u CALL 7584 +7214 16 00 .. LD D,00 +7216 FD 5E 02 .^. LD E,(IY+02) +7219 13 . INC DE +721A 13 . INC DE +721B 13 . INC DE +721C FD 19 .. ADD IY,DE +721E E1 . POP HL +721F 18 C4 .. JR 71E5 +7221 FD E1 .. POP IY +7223 C3 CD 70 ..p JP 70CD +7226 7D } LD A,L +7227 32 54 7B 2T{ LD (7B54),A +722A C3 D4 70 ..p JP 70D4 +722D 22 5C 7B "\{ LD (7B5C),HL +7230 3A 71 78 :qx LD A,(7871) +7233 32 5E 7B 2^{ LD (7B5E),A +7236 3E 01 >. LD A,01 +7238 32 CD 77 2.w LD (77CD),A +723B C3 D4 70 ..p JP 70D4 +723E CB 25 .% SLA L +7240 CB 14 .. RL H +7242 22 5C 7B "\{ LD (7B5C),HL +7245 3A 71 78 :qx LD A,(7871) +7248 CB 17 .. RL A +724A 32 5E 7B 2^{ LD (7B5E),A +724D 97 . SUB A +724E 32 CD 77 2.w LD (77CD),A +7251 C3 D4 70 ..p JP 70D4 +7254 22 65 7B "e{ LD (7B65),HL +7257 C3 D4 70 ..p JP 70D4 +725A 2A 99 7C *.| LD HL,(7C99) +725D 7C | LD A,H +725E B5 . OR L +725F C2 D4 70 ..p JP NZ,70D4 +7262 CD 1C 7B ..{ CALL 7B1C +7265 21 61 78 !ax LD HL,7861 +7268 CD CA 6E ..n CALL 6ECA +726B 21 54 7B !T{ LD HL,7B54 +726E CD 3A 7A .:z CALL 7A3A +7271 21 5C 7B !\{ LD HL,7B5C +7274 CD 3A 7A .:z CALL 7A3A +7277 21 65 7B !e{ LD HL,7B65 +727A CD 3A 7A .:z CALL 7A3A +727D 2A 5C 7B *\{ LD HL,(7B5C) +7280 ED 4B 65 7B .Ke{ LD BC,(7B65) +7284 CD 8A 72 ..r CALL 728A +7287 C3 CD 70 ..p JP 70CD +728A 3E 00 >. LD A,00 +728C 32 3E 7B 2>{ LD (7B3E),A +728F 7D } LD A,L +7290 32 6C 78 2lx LD (786C),A +7293 E6 F0 .. AND F0 +7295 6F o LD L,A +7296 3A 5E 7B :^{ LD A,(7B5E) +7299 5F _ LD E,A +729A 78 x LD A,B +729B B7 . OR A +729C FA B3 72 ..r JP M,72B3 +729F CD B9 72 ..r CALL 72B9 +72A2 CD 20 6E . n CALL 6E20 +72A5 CD 98 6E ..n CALL 6E98 +72A8 38 04 8. JR C,72AE +72AA CD 2A 6E .*n CALL 6E2A +72AD C9 . RET +72AE CD 2A 6E .*n CALL 6E2A +72B1 18 E7 .. JR 729A +72B3 21 39 7B !9{ LD HL,7B39 +72B6 CB C6 .. SET 0,(HL) +72B8 C9 . RET +72B9 C5 . PUSH BC +72BA E5 . PUSH HL +72BB 22 73 78 "sx LD (7873),HL +72BE ED 53 75 78 .Sux LD (7875),DE +72C2 22 77 78 "wx LD (7877),HL +72C5 ED 53 79 78 .Syx LD (7879),DE +72C9 E5 . PUSH HL +72CA CD 88 78 ..x CALL 7888 +72CD CD 39 6F .9o CALL 6F39 +72D0 E1 . POP HL +72D1 CB 3C .< SLR H +72D3 CE 00 .. ADC A,00 +72D5 67 g LD H,A +72D6 E5 . PUSH HL +72D7 CD 1C 7B ..{ CALL 7B1C +72DA 21 3E 7B !>{ LD HL,7B3E +72DD 34 4 INC (HL) +72DE 3A CD 77 :.w LD A,(77CD) +72E1 B7 . OR A +72E2 20 0B . JR NZ,72EF +72E4 21 79 78 !yx LD HL,7879 +72E7 CB 3E .> SLR (HL) +72E9 2B + DEC HL +72EA CB 1E .. RR (HL) +72EC 2B + DEC HL +72ED CB 1E .. RR (HL) +72EF 21 79 78 !yx LD HL,7879 +72F2 CD 56 75 .Vu CALL 7556 +72F5 2B + DEC HL +72F6 CD 56 75 .Vu CALL 7556 +72F9 2B + DEC HL +72FA CD 56 75 .Vu CALL 7556 +72FD E1 . POP HL +72FE 22 73 78 "sx LD (7873),HL +7301 3E 3A >: LD A,3A +7303 CD A4 75 ..u CALL 75A4 +7306 3E 20 > LD A,20 +7308 CD A4 75 ..u CALL 75A4 +730B 06 08 .. LD B,08 +730D CD 2D 75 .-u CALL 752D +7310 3E 20 > LD A,20 +7312 CD A4 75 ..u CALL 75A4 +7315 06 08 .. LD B,08 +7317 CD 2D 75 .-u CALL 752D +731A 3E 20 > LD A,20 +731C CD A4 75 ..u CALL 75A4 +731F 2A 73 78 *sx LD HL,(7873) +7322 01 10 00 ... LD BC,0010 +7325 7E ~ LD A,(HL) +7326 FE 20 . CP 20 +7328 30 02 0. JR NC,732C +732A 3E 2E >. LD A,2E +732C FE 7E .~ CP 7E +732E 38 02 8. JR C,7332 +7330 3E 2E >. LD A,2E +7332 CD A4 75 ..u CALL 75A4 +7335 ED A1 .. CPI +7337 EA 25 73 .%s JP PE,7325 +733A E1 . POP HL +733B ED 4B 3A 7B .K:{ LD BC,(7B3A) +733F ED 5B 75 78 .[ux LD DE,(7875) +7343 B7 . OR A +7344 ED 4A .J ADC HL,BC +7346 30 01 0. JR NC,7349 +7348 1C . INC E +7349 C1 . POP BC +734A 79 y LD A,C +734B D6 10 .. SUB A,10 +734D 4F O LD C,A +734E D0 . RET NC +734F 05 . DEC B +7350 C9 . RET +7351 7C | LD A,H +7352 B5 . OR L +7353 28 04 (. JR Z,7359 +7355 54 T LD D,H +7356 5D ] LD E,L +7357 18 04 .. JR 735D +7359 ED 5B 65 7B .[e{ LD DE,(7B65) +735D 2A 5C 7B *\{ LD HL,(7B5C) +7360 B7 . OR A +7361 ED 5A .Z ADC HL,DE +7363 22 5C 7B "\{ LD (7B5C),HL +7366 30 04 0. JR NC,736C +7368 21 5E 7B !^{ LD HL,7B5E +736B 34 4 INC (HL) +736C C3 5A 72 .Zr JP 725A +736F 7C | LD A,H +7370 B5 . OR L +7371 20 0C . JR NZ,737F +7373 EB . EX DE,HL +7374 01 05 00 ... LD BC,0005 +7377 3E 1F >. LD A,1F +7379 CD A8 28 ..( CALL 28A8 +737C 21 00 00 !.. LD HL,0000 +737F 22 25 7D "%} LD (7D25),HL +7382 E5 . PUSH HL +7383 11 12 FF ... LD DE,FF12 +7386 CD 66 6F .fo CALL 6F66 +7389 D1 . POP DE +738A 67 g LD H,A +738B 2E 00 .. LD L,00 +738D 22 23 7D "#} LD (7D23),HL +7390 E5 . PUSH HL +7391 01 00 00 ... LD BC,0000 +7394 3E 1F >. LD A,1F +7396 CD 7E 28 .~( CALL 287E +7399 E1 . POP HL +739A 79 y LD A,C +739B B7 . OR A +739C 20 02 . JR NZ,73A0 +739E 18 10 .. JR 73B0 +73A0 3E 30 >0 LD A,30 +73A2 81 . ADD C +73A3 CD A4 75 ..u CALL 75A4 +73A6 C3 D4 70 ..p JP 70D4 +73A9 EB . EX DE,HL +73AA CD 66 6F .fo CALL 6F66 +73AD 67 g LD H,A +73AE 2E 00 .. LD L,00 +73B0 22 5C 7B "\{ LD (7B5C),HL +73B3 21 5E 7B !^{ LD HL,7B5E +73B6 36 00 6. LD (HL),00 +73B8 3E FF >. LD A,FF +73BA 32 54 7B 2T{ LD (7B54),A +73BD C3 5A 72 .Zr JP 725A +73C0 22 6F 7B "o{ LD (7B6F),HL +73C3 CD F1 79 ..y CALL 79F1 +73C6 FE 68 .h CP 68 +73C8 28 0C (. JR Z,73D6 +73CA FE 63 .c CP 63 +73CC 28 2D (- JR Z,73FB +73CE FE 0D .. CP 0D +73D0 CA 98 74 ..t JP Z,7498 +73D3 C3 29 71 .)q JP 7129 +73D6 CD A4 75 ..u CALL 75A4 +73D9 3E 20 > LD A,20 +73DB CD A4 75 ..u CALL 75A4 +73DE 11 FA 7C ..| LD DE,7CFA +73E1 06 00 .. LD B,00 +73E3 C5 . PUSH BC +73E4 D5 . PUSH DE +73E5 CD B2 75 ..u CALL 75B2 +73E8 D1 . POP DE +73E9 C1 . POP BC +73EA F5 . PUSH AF +73EB 7D } LD A,L +73EC 12 . LD (DE),A +73ED 13 . INC DE +73EE 04 . INC B +73EF F1 . POP AF +73F0 FE 0D .. CP 0D +73F2 20 EF . JR NZ,73E3 +73F4 ED 43 F8 7C .C.| LD (7CF8),BC +73F8 C3 98 74 ..t JP 7498 +73FB CD A4 75 ..u CALL 75A4 +73FE 3E 20 > LD A,20 +7400 CD A4 75 ..u CALL 75A4 +7403 11 FA 7C ..| LD DE,7CFA +7406 06 00 .. LD B,00 +7408 CD F1 79 ..y CALL 79F1 +740B CD A4 75 ..u CALL 75A4 +740E FE 0D .. CP 0D +7410 CA F4 73 ..s JP Z,73F4 +7413 12 . LD (DE),A +7414 13 . INC DE +7415 04 . INC B +7416 18 F0 .. JR 7408 +7418 2A 5C 7B *\{ LD HL,(7B5C) +741B 24 $ INC H +741C 2E 00 .. LD L,00 +741E 22 5C 7B "\{ LD (7B5C),HL +7421 20 04 . JR NZ,7427 +7423 21 5E 7B !^{ LD HL,7B5E +7426 34 4 INC (HL) +7427 2A 6F 7B *o{ LD HL,(7B6F) +742A 2B + DEC HL +742B 7C | LD A,H +742C B5 . OR L +742D CA 29 71 .)q JP Z,7129 +7430 CD 20 6E . n CALL 6E20 +7433 CD 98 6E ..n CALL 6E98 +7436 38 06 8. JR C,743E +7438 CD 2A 6E .*n CALL 6E2A +743B C3 29 71 .)q JP 7129 +743E CD 2A 6E .*n CALL 6E2A +7441 22 6F 7B "o{ LD (7B6F),HL +7444 2A 5C 7B *\{ LD HL,(7B5C) +7447 ED 5B 5E 7B .[^{ LD DE,(7B5E) +744B CD 88 78 ..x CALL 7888 +744E CD 39 6F .9o CALL 6F39 +7451 2A 5C 7B *\{ LD HL,(7B5C) +7454 CB 3C .< SLR H +7456 CE 00 .. ADC A,00 +7458 67 g LD H,A +7459 06 00 .. LD B,00 +745B 3E 00 >. LD A,00 +745D 95 . SUB L +745E 20 02 . JR NZ,7462 +7460 06 01 .. LD B,01 +7462 4F O LD C,A +7463 3A FA 7C :.| LD A,(7CFA) +7466 ED B1 .. CPIR +7468 C2 18 74 ..t JP NZ,7418 +746B 7D } LD A,L +746C 3D = DEC A +746D 32 5C 7B 2\{ LD (7B5C),A +7470 ED 4B F8 7C .K.| LD BC,(7CF8) +7474 05 . DEC B +7475 28 0E (. JR Z,7485 +7477 11 FB 7C ..| LD DE,7CFB +747A 1A . LD A,(DE) +747B BE . CP (HL) +747C 20 1A . JR NZ,7498 +747E 13 . INC DE +747F 2C , INC L +7480 CC A2 74 ..t CALL Z,74A2 +7483 10 F5 .. DJNZ 747A +7485 3A 54 7B :T{ LD A,(7B54) +7488 3C < INC A +7489 C2 5A 72 .Zr JP NZ,725A +748C 2A 5C 7B *\{ LD HL,(7B5C) +748F 01 FA 7C ..| LD BC,7CFA +7492 B7 . OR A +7493 ED 42 .B SBC HL,BC +7495 C2 5A 72 .Zr JP NZ,725A +7498 2A 5C 7B *\{ LD HL,(7B5C) +749B 23 # INC HL +749C 22 5C 7B "\{ LD (7B5C),HL +749F C3 44 74 .Dt JP 7444 +74A2 D5 . PUSH DE +74A3 2A 5C 7B *\{ LD HL,(7B5C) +74A6 24 $ INC H +74A7 CD 88 78 ..x CALL 7888 +74AA CD 39 6F .9o CALL 6F39 +74AD 67 g LD H,A +74AE 2E 00 .. LD L,00 +74B0 D1 . POP DE +74B1 C9 . RET +74B2 FD 6E 16 .n. LD L,(IY+16) +74B5 FD 66 17 .f. LD H,(IY+17) +74B8 23 # INC HL +74B9 7E ~ LD A,(HL) +74BA FE 3C .< CP 3C +74BC 38 02 8. JR C,74C0 +74BE 3E 3C >< LD A,3C +74C0 4F O LD C,A +74C1 C6 04 .. ADD A,04 +74C3 12 . LD (DE),A +74C4 13 . INC DE +74C5 CD 0E 6E ..n CALL 6E0E +74C8 12 . LD (DE),A +74C9 13 . INC DE +74CA 3A 1A 6E :.n LD A,(6E1A) +74CD E5 . PUSH HL +74CE 21 7F 78 !.x LD HL,787F +74D1 77 w LD (HL),A +74D2 3E 30 >0 LD A,30 +74D4 ED 6F .o RLD +74D6 FE 3A .: CP 3A +74D8 38 02 8. JR C,74DC +74DA C6 07 .. ADD A,07 +74DC 12 . LD (DE),A +74DD 3E 30 >0 LD A,30 +74DF 13 . INC DE +74E0 ED 6F .o RLD +74E2 FE 3A .: CP 3A +74E4 38 02 8. JR C,74E8 +74E6 C6 07 .. ADD A,07 +74E8 12 . LD (DE),A +74E9 13 . INC DE +74EA 13 . INC DE +74EB E1 . POP HL +74EC 23 # INC HL +74ED 06 00 .. LD B,00 +74EF ED B0 .. LDIR +74F1 C9 . RET +74F2 21 7B 78 !{x LD HL,787B +74F5 CD CA 6E ..n CALL 6ECA +74F8 21 D1 77 !.w LD HL,77D1 +74FB CD CA 6E ..n CALL 6ECA +74FE 21 6B 7C !k| LD HL,7C6B +7501 CD CA 6E ..n CALL 6ECA +7504 21 1C 6E !.n LD HL,6E1C +7507 06 02 .. LD B,02 +7509 CD 2D 75 .-u CALL 752D +750C CD 82 75 ..u CALL 7582 +750F 21 14 78 !.x LD HL,7814 +7512 CD CA 6E ..n CALL 6ECA +7515 2A 92 6F *.o LD HL,(6F92) +7518 06 18 .. LD B,18 +751A CD 2D 75 .-u CALL 752D +751D CD 1C 7B ..{ CALL 7B1C +7520 CD BE 79 ..y CALL 79BE +7523 CD 82 75 ..u CALL 7582 +7526 21 61 78 !ax LD HL,7861 +7529 CD CA 6E ..n CALL 6ECA +752C C9 . RET +752D 04 . INC B +752E 05 . DEC B +752F C8 . RET Z +7530 3A 6C 78 :lx LD A,(786C) +7533 BD . CP L +7534 20 0A . JR NZ,7540 +7536 3E 08 >. LD A,08 +7538 CD A4 75 ..u CALL 75A4 +753B 3E 2D >- LD A,2D +753D CD A4 75 ..u CALL 75A4 +7540 CD 56 75 .Vu CALL 7556 +7543 3A 6C 78 :lx LD A,(786C) +7546 BD . CP L +7547 20 04 . JR NZ,754D +7549 3E 2D >- LD A,2D +754B 18 02 .. JR 754F +754D 3E 20 > LD A,20 +754F CD A4 75 ..u CALL 75A4 +7552 23 # INC HL +7553 10 DB .. DJNZ 7530 +7555 C9 . RET +7556 E5 . PUSH HL +7557 4E N LD C,(HL) +7558 21 7F 78 !.x LD HL,787F +755B 71 q LD (HL),C +755C D5 . PUSH DE +755D 3E 30 >0 LD A,30 +755F ED 6F .o RLD +7561 5F _ LD E,A +7562 FE 3A .: CP 3A +7564 38 05 8. JR C,756B +7566 C6 07 .. ADD A,07 +7568 5F _ LD E,A +7569 3E 30 >0 LD A,30 +756B ED 6F .o RLD +756D 57 W LD D,A +756E FE 3A .: CP 3A +7570 38 03 8. JR C,7575 +7572 C6 07 .. ADD A,07 +7574 57 W LD D,A +7575 ED 53 CF 77 .S.w LD (77CF),DE +7579 21 CE 77 !.w LD HL,77CE +757C CD CA 6E ..n CALL 6ECA +757F D1 . POP DE +7580 E1 . POP HL +7581 C9 . RET +7582 3E 4F >O LD A,4F +7584 F5 . PUSH AF +7585 3A F1 6E :.n LD A,(6EF1) +7588 CD 85 1E ... CALL 1E85 +758B F1 . POP AF +758C 90 . SUB B +758D C8 . RET Z +758E D8 . RET C +758F 47 G LD B,A +7590 3E 20 > LD A,20 +7592 CD A4 75 ..u CALL 75A4 +7595 10 F9 .. DJNZ 7590 +7597 C9 . RET +7598 46 F LD B,(HL) +7599 05 . DEC B +759A 04 . INC B +759B C8 . RET Z +759C 23 # INC HL +759D 7E ~ LD A,(HL) +759E CD A4 75 ..u CALL 75A4 +75A1 10 F9 .. DJNZ 759C +75A3 C9 . RET ;---------------------------- +75A4 F5 . PUSH AF ; Zeichen in A ausgeben +75A5 32 6E 78 2nx LD (786E),A +75A8 E5 . PUSH HL +75A9 21 6D 78 !mx LD HL,786D +75AC CD CA 6E ..n CALL 6ECA +75AF E1 . POP HL +75B0 F1 . POP AF +75B1 C9 . RET +75B2 21 00 00 !.. LD HL,0000 +75B5 22 6F 78 "ox LD (786F),HL +75B8 22 71 78 "qx LD (7871),HL +75BB CD F1 79 ..y CALL 79F1 +75BE FE 03 .. CP 03 +75C0 CA 28 76 .(v JP Z,7628 +75C3 18 03 .. JR 75C8 +75C5 CD F1 79 ..y CALL 79F1 +75C8 CD A4 75 ..u CALL 75A4 ; Zeichen in A ausgeben +75CB 21 6F 78 !ox LD HL,786F +75CE FE 3C .< CP 3C +75D0 28 24 ($ JR Z,75F6 +75D2 FE 3E .> CP 3E +75D4 28 2A (* JR Z,7600 +75D6 FE 69 .i CP 69 +75D8 28 32 (2 JR Z,760C +75DA FE 30 .0 CP 30 +75DC 38 44 8D JR C,7622 +75DE FE 3A .: CP 3A +75E0 38 0A 8. JR C,75EC +75E2 FE 61 .a CP 61 +75E4 38 3C 8< JR C,7622 +75E6 FE 67 .g CP 67 +75E8 30 38 08 JR NC,7622 +75EA C6 D9 .. ADD A,D9 +75EC ED 6F .o RLD +75EE 23 # INC HL +75EF ED 6F .o RLD +75F1 23 # INC HL +75F2 ED 6F .o RLD +75F4 18 CF .. JR 75C5 +75F6 CB 26 .& SLA (HL) +75F8 23 # INC HL +75F9 CB 16 .. RL (HL) +75FB 23 # INC HL +75FC CB 16 .. RL (HL) +75FE 18 C5 .. JR 75C5 +7600 23 # INC HL +7601 23 # INC HL +7602 CB 3E .> SLR (HL) +7604 2B + DEC HL +7605 CB 1E .. RR (HL) +7607 2B + DEC HL +7608 CB 1E .. RR (HL) +760A 18 B9 .. JR 75C5 +760C 7E ~ LD A,(HL) +760D 32 71 78 2qx LD (7871),A +7610 2A 5C 7B *\{ LD HL,(7B5C) +7613 CD 8E 76 ..v CALL 768E +7616 22 6F 78 "ox LD (786F),HL +7619 18 AA .. JR 75C5 +761B 3E 07 >. LD A,07 +761D CD A4 75 ..u CALL 75A4 +7620 18 90 .. JR 75B2 +7622 CB 81 .. RES 0,C +7624 2A 6F 78 *ox LD HL,(786F) +7627 C9 . RET +7628 3A 39 7B :9{ LD A,(7B39) +762B CB 47 .G BIT 0,A +762D 28 EC (. JR Z,761B +762F FD E5 .. PUSH IY +7631 21 78 7C !x| LD HL,7C78 +7634 CD CA 6E ..n CALL 6ECA +7637 FD 21 52 7B .!R{ LD IY,7B52 +763B 3A 3E 7B :>{ LD A,(7B3E) +763E 47 G LD B,A +763F FD 70 00 .p. LD (IY+00),B +7642 3E 03 >. LD A,03 +7644 CD 93 78 ..x CALL 7893 +7647 2A 5C 7B *\{ LD HL,(7B5C) +764A CD 99 78 ..x CALL 7899 +764D ED 5B 5E 7B .[^{ LD DE,(7B5E) +7651 CD F1 79 ..y CALL 79F1 +7654 FE 03 .. CP 03 +7656 CA A2 76 ..v JP Z,76A2 +7659 FE 0A .. CP 0A +765B CA C0 76 ..v JP Z,76C0 +765E FE 02 .. CP 02 +7660 CA E7 76 ..v JP Z,76E7 +7663 FE 20 . CP 20 +7665 CA E7 76 ..v JP Z,76E7 +7668 FE 08 .. CP 08 +766A CA 3E 77 .>w JP Z,773E +766D FE 01 .. CP 01 +766F 28 C0 (. JR Z,7631 +7671 FE 30 .0 CP 30 +7673 38 0E 8. JR C,7683 +7675 FE 3A .: CP 3A +7677 DA 8F 77 ..w JP C,778F +767A FE 61 .a CP 61 +767C 38 05 8. JR C,7683 +767E FE 67 .g CP 67 +7680 DA 8D 77 ..w JP C,778D +7683 FD E1 .. POP IY +7685 22 4E 7B "N{ LD (7B4E),HL +7688 CD 8E 76 ..v CALL 768E +768B CB C1 .. SET 0,C +768D C9 . RET +768E F5 . PUSH AF +768F E5 . PUSH HL +7690 CD 88 78 ..x CALL 7888 +7693 CD 39 6F .9o CALL 6F39 +7696 E1 . POP HL +7697 CB 3C .< SLR H +7699 CE 00 .. ADC A,00 +769B 67 g LD H,A +769C 7E ~ LD A,(HL) +769D 23 # INC HL +769E 66 f LD H,(HL) +769F 6F o LD L,A +76A0 F1 . POP AF +76A1 C9 . RET +76A2 3A 3E 7B :>{ LD A,(7B3E) +76A5 FD BE 00 ... CP (IY+00) +76A8 28 34 (4 JR Z,76DE +76AA FD 34 .4 INC (IY+00) +76AC 00 . NOP +76AD 3E 03 >. LD A,03 +76AF CD A4 75 ..u CALL 75A4 +76B2 ED 4B 3A 7B .K:{ LD BC,(7B3A) +76B6 B7 . OR A +76B7 ED 42 .B SBC HL,BC +76B9 D2 51 76 .Qv JP NC,7651 +76BC 1D . DEC E +76BD C3 51 76 .Qv JP 7651 +76C0 3E 01 >. LD A,01 +76C2 FD BE 00 ... CP (IY+00) +76C5 CA DE 76 ..v JP Z,76DE +76C8 FD 35 .5 DEC (IY+00) +76CA 00 . NOP +76CB 3E 0A >. LD A,0A +76CD CD A4 75 ..u CALL 75A4 +76D0 ED 4B 3A 7B .K:{ LD BC,(7B3A) +76D4 B7 . OR A +76D5 ED 4A .J ADC HL,BC +76D7 D2 51 76 .Qv JP NC,7651 +76DA 1C . INC E +76DB C3 51 76 .Qv JP 7651 +76DE 3E 07 >. LD A,07 +76E0 CD A4 75 ..u CALL 75A4 +76E3 3E 0D >. LD A,0D +76E5 18 9C .. JR 7683 +76E7 E5 . PUSH HL +76E8 E5 . PUSH HL +76E9 D5 . PUSH DE +76EA CD 88 78 ..x CALL 7888 +76ED CD 39 6F .9o CALL 6F39 +76F0 D1 . POP DE +76F1 E1 . POP HL +76F2 CB 3C .< SLR H +76F4 CE 00 .. ADC A,00 +76F6 67 g LD H,A +76F7 CD 56 75 .Vu CALL 7556 +76FA 3E 20 > LD A,20 +76FC CD A4 75 ..u CALL 75A4 +76FF E1 . POP HL +7700 7D } LD A,L +7701 E6 0F .. AND 0F +7703 FE 0F .. CP 0F +7705 28 0D (. JR Z,7714 +7707 23 # INC HL +7708 FE 07 .. CP 07 +770A 20 05 . JR NZ,7711 +770C 3E 20 > LD A,20 +770E CD A4 75 ..u CALL 75A4 +7711 C3 51 76 .Qv JP 7651 +7714 3E 01 >. LD A,01 +7716 FD BE 00 ... CP (IY+00) +7719 28 C3 (. JR Z,76DE +771B FD 35 .5 DEC (IY+00) +771D 00 . NOP +771E E5 . PUSH HL +771F 21 40 7B !@{ LD HL,7B40 +7722 CD CA 6E ..n CALL 6ECA +7725 E1 . POP HL +7726 C5 . PUSH BC +7727 ED 4B 3A 7B .K:{ LD BC,(7B3A) +772B 03 . INC BC +772C 09 . ADD HL,BC +772D D2 31 77 .1w JP NC,7731 +7730 1C . INC E +7731 01 10 00 ... LD BC,0010 +7734 B7 . OR A +7735 ED 42 .B SBC HL,BC +7737 30 01 0. JR NC,773A +7739 1D . DEC E +773A C1 . POP BC +773B C3 51 76 .Qv JP 7651 +773E 7D } LD A,L +773F E6 0F .. AND 0F +7741 FE 00 .. CP 00 +7743 28 1A (. JR Z,775F +7745 2B + DEC HL +7746 FE 08 .. CP 08 +7748 28 0E (. JR Z,7758 +774A 3E 08 >. LD A,08 +774C CD A4 75 ..u CALL 75A4 +774F CD A4 75 ..u CALL 75A4 +7752 CD A4 75 ..u CALL 75A4 +7755 C3 51 76 .Qv JP 7651 +7758 3E 08 >. LD A,08 +775A CD A4 75 ..u CALL 75A4 +775D 18 EB .. JR 774A +775F 3A 3E 7B :>{ LD A,(7B3E) +7762 FD BE 00 ... CP (IY+00) +7765 CA DE 76 ..v JP Z,76DE +7768 FD 34 .4 INC (IY+00) +776A 00 . NOP +776B E5 . PUSH HL +776C 3E 03 >. LD A,03 +776E CD A4 75 ..u CALL 75A4 +7771 06 2E .. LD B,2E +7773 CD 91 78 ..x CALL 7891 +7776 E1 . POP HL +7777 C5 . PUSH BC +7778 ED 4B 3A 7B .K:{ LD BC,(7B3A) +777C B7 . OR A +777D ED 42 .B SBC HL,BC +777F 30 01 0. JR NC,7782 +7781 1D . DEC E +7782 01 0F 00 ... LD BC,000F +7785 09 . ADD HL,BC +7786 30 01 0. JR NC,7789 +7788 1C . INC E +7789 C1 . POP BC +778A C3 51 76 .Qv JP 7651 +778D C6 D9 .. ADD A,D9 +778F C5 . PUSH BC +7790 E6 0F .. AND 0F +7792 87 . ADD A +7793 87 . ADD A +7794 87 . ADD A +7795 87 . ADD A +7796 47 G LD B,A +7797 CD F1 79 ..y CALL 79F1 +779A FE 3A .: CP 3A +779C 38 0A 8. JR C,77A8 +779E FE 61 .a CP 61 +77A0 38 E7 8. JR C,7789 +77A2 FE 67 .g CP 67 +77A4 30 E3 0. JR NC,7789 +77A6 C6 D9 .. ADD A,D9 +77A8 E6 0F .. AND 0F +77AA B0 . OR B +77AB C1 . POP BC +77AC E5 . PUSH HL +77AD F5 . PUSH AF +77AE E5 . PUSH HL +77AF D5 . PUSH DE +77B0 CD 88 78 ..x CALL 7888 +77B3 CD DF 6F ..o CALL 6FDF +77B6 D1 . POP DE +77B7 E1 . POP HL +77B8 CB 3C .< SLR H +77BA CE 00 .. ADC A,00 +77BC 67 g LD H,A +77BD F1 . POP AF +77BE 77 w LD (HL),A +77BF CD 56 75 .Vu CALL 7556 +77C2 06 02 .. LD B,02 +77C4 3E 08 >. LD A,08 +77C6 CD 93 78 ..x CALL 7893 +77C9 E1 . POP HL +77CA C3 51 76 .Qv JP 7651 +77CD 01 02 00 ... LD BC,0002 +77D0 00 . NOP +77D1 00 . NOP +77D2 00 . NOP +77D3 20 20 JR NZ,77F5 +77D5 20 20 JR NZ,77F7 +77D7 20 FF . JR NZ,77D8 +77D9 FF . RST 38 +77DA FF . RST 38 +77DB FF . RST 38 +77DC FF . RST 38 +77DD FF . RST 38 +77DE FF . RST 38 +77DF FF . RST 38 +77E0 FF . RST 38 +77E1 FF . RST 38 +77E2 FF . RST 38 +77E3 FF . RST 38 +77E4 FF . RST 38 +77E5 FF . RST 38 +77E6 FF . RST 38 +77E7 FF . RST 38 +77E8 FF . RST 38 +77E9 FF . RST 38 +77EA FF . RST 38 +77EB FF . RST 38 +77EC FF . RST 38 +77ED FF . RST 38 +77EE FF . RST 38 +77EF FF . RST 38 +77F0 FF . RST 38 +77F1 FF . RST 38 +77F2 FF . RST 38 +77F3 FF . RST 38 +77F4 FF . RST 38 +77F5 FF . RST 38 +77F6 FF . RST 38 +77F7 FF . RST 38 +77F8 FF . RST 38 +77F9 FF . RST 38 +77FA FF . RST 38 +77FB FF . RST 38 +77FC FF . RST 38 +77FD FF . RST 38 +77FE FF . RST 38 +77FF FF . RST 38 +7800 FF . RST 38 +7801 FF . RST 38 +7802 FF . RST 38 +7803 FF . RST 38 +7804 FF . RST 38 +7805 FF . RST 38 +7806 FF . RST 38 +7807 FF . RST 38 +7808 FF . RST 38 +7809 FF . RST 38 +780A FF . RST 38 +780B FF . RST 38 +780C FF . RST 38 +780D FF . RST 38 +780E FF . RST 38 +780F FF . RST 38 +7810 FF . RST 38 +7811 FF . RST 38 +7812 FF . RST 38 +7813 FF . RST 38 +7814 4B K LD C,E +7815 01 0D 0A ... LD BC,0A0D +7818 20 46 F JR NZ,7860 +781A 20 20 JR NZ,783C +781C 41 A LD B,C +781D 20 20 JR NZ,783F +781F 43 C LD B,E +7820 20 20 JR NZ,7842 +7822 42 B LD B,D +7823 20 20 JR NZ,7845 +7825 45 E LD B,L +7826 20 20 JR NZ,7848 +7828 44 D LD B,H +7829 20 20 JR NZ,784B +782B 4C L LD C,H +782C 20 20 JR NZ,784E +782E 48 H LD C,B +782F 20 20 JR NZ,7851 +7831 46 F LD B,(HL) +7832 20 20 JR NZ,7854 +7834 41 A LD B,C +7835 20 20 JR NZ,7857 +7837 43 C LD B,E +7838 20 20 JR NZ,785A +783A 42 B LD B,D +783B 20 20 JR NZ,785D +783D 45 E LD B,L +783E 20 20 JR NZ,7860 +7840 44 D LD B,H +7841 20 20 JR NZ,7863 +7843 4C L LD C,H +7844 20 20 JR NZ,7866 +7846 48 H LD C,B +7847 20 20 JR NZ,7869 +7849 49 I LD C,C +784A 58 X LD E,B +784B 20 20 JR NZ,786D +784D 20 20 JR NZ,786F +784F 53 S LD D,E +7850 50 P LD D,B +7851 20 20 JR NZ,7873 +7853 20 20 JR NZ,7875 +7855 49 I LD C,C +7856 59 Y LD E,C +7857 20 20 JR NZ,7879 +7859 20 20 JR NZ,787B +785B 50 P LD D,B +785C 43 C LD B,E +785D 0D . DEC C +785E 0A . LD A,(BC) +785F 20 00 . JR NZ,7861 +7861 0A . LD A,(BC) +7862 06 16 .. LD B,16 +7864 00 . NOP +7865 0D . DEC C +7866 0A . LD A,(BC) +7867 69 i LD L,C +7868 6E n LD L,(HL) +7869 66 f LD H,(HL) +786A 6F o LD L,A +786B 3A 00 01 :.. LD A,(0100) +786E 00 . NOP +786F 00 . NOP +7870 00 . NOP +7871 00 . NOP +7872 00 . NOP +7873 00 . NOP +7874 00 . NOP +7875 00 . NOP +7876 00 . NOP +7877 00 . NOP +7878 00 . NOP +7879 00 . NOP +787A 00 . NOP +787B 03 . INC BC +787C 0A . LD A,(BC) +787D 01 0D 00 ... LD BC,000D +7880 03 . INC BC +7881 06 16 .. LD B,16 +7883 07 . RLCA +7884 2A 00 00 *.. LD HL,(0000) +7887 C9 . RET +7888 CB 3B .; SLR E +788A CB 1C .. RR H +788C 3A 54 7B :T{ LD A,(7B54) +788F 57 W LD D,A +7890 C9 . RET +7891 3E 02 >. LD A,02 +7893 CD A4 75 ..u CALL 75A4 +7896 10 FB .. DJNZ 7893 +7898 C9 . RET +7899 7D } LD A,L +789A E6 0F .. AND 0F +789C C5 . PUSH BC +789D 47 G LD B,A +789E CB 17 .. RL A +78A0 80 . ADD B +78A1 C6 08 .. ADD A,08 +78A3 FE 20 . CP 20 +78A5 38 01 8. JR C,78A8 +78A7 3C < INC A +78A8 47 G LD B,A +78A9 3E 0D >. LD A,0D +78AB CD A4 75 ..u CALL 75A4 +78AE CD 91 78 ..x CALL 7891 +78B1 C1 . POP BC +78B2 C9 . RET ;----- y - Infokommandos +78B3 E5 . PUSH HL +78B4 3E 20 > LD A,20 +78B6 CD A4 75 ..u CALL 75A4 +78B9 CD F1 79 ..y CALL 79F1 +78BC E1 . POP HL +78BD FE 0D .. CP 0D ; CR zum lernen +78BF CA 62 72 .br JP Z,7262 +78C2 FE 50 .P CP 50 ; P neues Passwort +78C4 CA DC 7A ..z JP Z,7ADC +78C7 FE 6C .l CP 6C ; l Lernmodus an +78C9 CA 86 79 ..y JP Z,7986 +78CC FE 65 .e CP 65 ; Lernmodus aus +78CE CA 8F 79 ..y JP Z,798F +78D1 FE 61 .a CP 61 ; Ausfuehren (gelerntes) +78D3 CA B5 79 ..y JP Z,79B5 +78D6 FE 69 .i CP 69 ; yi = increment beim dump setzen +78D8 CA 17 79 ..y JP Z,7917 +78DB FE 74 .t CP 74 ; t Block vom Archiv lesen +78DD CA 6F 73 .os JP Z,736F +78E0 FE 66 .f CP 66 ; yf lernmodus (zuruecksetzen?) +78E2 CA A4 79 ..y JP Z,79A4 +78E5 FE 62 .b CP 62 ; b Breakpoint 1 +78E7 CA 1D 79 ..y JP Z,791D +78EA FE 63 .c CP 63 ; c Breakpoint 2 +78EC CA 52 79 .Ry JP Z,7952 +78EF FE 77 .w CP 77 ; w Zum anderen Miniprozess +78F1 28 03 (. JR Z,78F6 +78F3 C3 29 71 .)q JP 7129 ; beep +78F6 7C | LD A,H +78F7 B5 . OR L +78F8 28 03 (. JR Z,78FD +78FA 22 25 7D "%} LD (7D25),HL +78FD ED 5B 25 7D .[%} LD DE,(7D25) +7901 2A 23 7D *#} LD HL,(7D23) +7904 7C | LD A,H +7905 3C < INC A +7906 CA 29 71 .)q JP Z,7129 +7909 3E 1F >. LD A,1F +790B 01 00 00 ... LD BC,0000 +790E CD 81 28 ..( CALL 2881 +7911 2A 23 7D *#} LD HL,(7D23) +7914 C3 B0 73 ..s JP 73B0 +7917 22 3A 7B ":{ LD (7B3A),HL +791A C3 D4 70 ..p JP 70D4 +791D CB 41 .A BIT 0,C +791F CA 25 79 .%y JP Z,7925 +7922 2A 4E 7B *N{ LD HL,(7B4E) +7925 E5 . PUSH HL +7926 21 53 7A !Sz LD HL,7A53 +7929 7E ~ LD A,(HL) +792A B7 . OR A +792B CA 37 79 .7y JP Z,7937 +792E ED 5B 56 7A .[Vz LD DE,(7A56) +7932 01 03 00 ... LD BC,0003 +7935 ED B0 .. LDIR +7937 E1 . POP HL +7938 22 56 7A "Vz LD (7A56),HL +793B 11 53 7A .Sz LD DE,7A53 +793E 01 03 00 ... LD BC,0003 +7941 ED B0 .. LDIR +7943 ED 5B 56 7A .[Vz LD DE,(7A56) +7947 21 50 7A !Pz LD HL,7A50 +794A 01 03 00 ... LD BC,0003 +794D ED B0 .. LDIR +794F C3 D4 70 ..p JP 70D4 +7952 CB 41 .A BIT 0,C +7954 CA 5A 79 .Zy JP Z,795A +7957 2A 4E 7B *N{ LD HL,(7B4E) +795A E5 . PUSH HL +795B ED 5B F1 7A .[.z LD DE,(7AF1) +795F 21 01 7B !.{ LD HL,7B01 +7962 01 03 00 ... LD BC,0003 +7965 ED B0 .. LDIR +7967 E1 . POP HL +7968 11 01 7B ..{ LD DE,7B01 +796B 22 F1 7A ".z LD (7AF1),HL +796E 01 03 00 ... LD BC,0003 +7971 ED B0 .. LDIR +7973 ED 5B F1 7A .[.z LD DE,(7AF1) +7977 21 F3 7A !.z LD HL,7AF3 +797A 01 03 00 ... LD BC,0003 +797D ED B0 .. LDIR +797F ED 53 05 7B .S.{ LD (7B05),DE +7983 C3 D4 70 ..p JP 70D4 +7986 21 CE 7C !.| LD HL,7CCE +7989 22 97 7C ".| LD (7C97),HL +798C C3 D4 70 ..p JP 70D4 +798F 2A 97 7C *.| LD HL,(7C97) +7992 7C | LD A,H +7993 B5 . OR L +7994 CA 29 71 .)q JP Z,7129 +7997 2B + DEC HL +7998 2B + DEC HL +7999 36 FF 6. LD (HL),FF +799B 21 00 00 !.. LD HL,0000 +799E 22 97 7C ".| LD (7C97),HL +79A1 C3 D4 70 ..p JP 70D4 +79A4 2A 99 7C *.| LD HL,(7C99) +79A7 7C | LD A,H +79A8 B5 . OR L +79A9 C2 29 71 .)q JP NZ,7129 +79AC 2A 9D 7C *.| LD HL,(7C9D) +79AF 22 99 7C ".| LD (7C99),HL +79B2 C3 D4 70 ..p JP 70D4 +79B5 21 CE 7C !.| LD HL,7CCE +79B8 22 99 7C ".| LD (7C99),HL +79BB C3 D4 70 ..p JP 70D4 +79BE 21 CE 7C !.| LD HL,7CCE +79C1 7E ~ LD A,(HL) +79C2 FE FF .. CP FF +79C4 C8 . RET Z +79C5 E5 . PUSH HL +79C6 ED 4B 99 7C .K.| LD BC,(7C99) +79CA 78 x LD A,B +79CB B1 . OR C +79CC 20 04 . JR NZ,79D2 +79CE ED 4B 9D 7C .K.| LD BC,(7C9D) +79D2 B7 . OR A +79D3 ED 42 .B SBC HL,BC +79D5 20 06 . JR NZ,79DD +79D7 21 9F 7C !.| LD HL,7C9F +79DA CD CA 6E ..n CALL 6ECA +79DD E1 . POP HL +79DE 7E ~ LD A,(HL) +79DF FE 20 . CP 20 +79E1 30 08 0. JR NC,79EB +79E3 3E 25 >% LD A,25 +79E5 CD A4 75 ..u CALL 75A4 +79E8 7E ~ LD A,(HL) +79E9 C6 40 .@ ADD A,40 +79EB CD A4 75 ..u CALL 75A4 +79EE 23 # INC HL +79EF 18 D0 .. JR 79C1 +79F1 E5 . PUSH HL +79F2 2A 99 7C *.| LD HL,(7C99) +79F5 7C | LD A,H +79F6 B5 . OR L +79F7 28 16 (. JR Z,7A0F +79F9 7E ~ LD A,(HL) +79FA FE FF .. CP FF +79FC 20 0B . JR NZ,7A09 +79FE 21 00 00 !.. LD HL,0000 +7A01 22 99 7C ".| LD (7C99),HL +7A04 22 9D 7C ".| LD (7C9D),HL +7A07 18 06 .. JR 7A0F +7A09 23 # INC HL +7A0A 22 99 7C ".| LD (7C99),HL +7A0D E1 . POP HL +7A0E C9 . RET +7A0F CD 9E 6E ..n CALL 6E9E +7A12 F5 . PUSH AF +7A13 2A 97 7C *.| LD HL,(7C97) +7A16 7C | LD A,H +7A17 B5 . OR L +7A18 28 1D (. JR Z,7A37 +7A1A B7 . OR A +7A1B 01 F7 7C ..| LD BC,7CF7 +7A1E ED 42 .B SBC HL,BC +7A20 38 0C 8. JR C,7A2E +7A22 21 7C 7C !|| LD HL,7C7C +7A25 CD CA 6E ..n CALL 6ECA +7A28 21 00 00 !.. LD HL,0000 +7A2B F1 . POP AF +7A2C 18 04 .. JR 7A32 +7A2E F1 . POP AF +7A2F 09 . ADD HL,BC +7A30 77 w LD (HL),A +7A31 23 # INC HL +7A32 22 97 7C ".| LD (7C97),HL +7A35 E1 . POP HL +7A36 C9 . RET +7A37 F1 . POP AF +7A38 E1 . POP HL +7A39 C9 . RET +7A3A E5 . PUSH HL +7A3B 2B + DEC HL +7A3C 4E N LD C,(HL) +7A3D 23 # INC HL +7A3E 06 00 .. LD B,00 +7A40 09 . ADD HL,BC +7A41 C5 . PUSH BC +7A42 CD CA 6E ..n CALL 6ECA +7A45 C1 . POP BC +7A46 E1 . POP HL +7A47 41 A LD B,C +7A48 CD 2D 75 .-u CALL 752D +7A4B 3E 20 > LD A,20 +7A4D C3 A4 75 ..u JP 75A4 +7A50 CD 58 7A .Xz CALL 7A58 +7A53 00 . NOP +7A54 00 . NOP +7A55 00 . NOP +7A56 00 . NOP +7A57 00 . NOP +7A58 CD 1F 70 ..p CALL 701F +7A5B 18 04 .. JR 7A61 +7A5D 74 t LD (HL),H ; "test" +7A5E 65 e LD H,L +7A5F 73 s LD (HL),E +7A60 74 t LD (HL),H +7A61 FD E5 .. PUSH IY +7A63 F5 . PUSH AF +7A64 FD 21 00 00 .!.. LD IY,0000 +7A68 FD 39 .9 ADD IY,SP +7A6A E5 . PUSH HL +7A6B D5 . PUSH DE +7A6C C5 . PUSH BC +7A6D FD 7E 04 .~. LD A,(IY+04) +7A70 D6 03 .. SUB A,03 +7A72 FD 77 04 .w. LD (IY+04),A +7A75 30 03 0. JR NC,7A7A +7A77 FD 35 .5 DEC (IY+05) +7A79 05 . DEC B +7A7A ED 5B 56 7A .[Vz LD DE,(7A56) +7A7E 21 53 7A !Sz LD HL,7A53 +7A81 01 03 00 ... LD BC,0003 +7A84 ED B0 .. LDIR +7A86 C1 . POP BC +7A87 D1 . POP DE +7A88 E1 . POP HL +7A89 F1 . POP AF +7A8A FD E1 .. POP IY +7A8C C9 . RET +7A8D 21 FA 7C !.| LD HL,7CFA +7A90 06 0A .. LD B,0A +7A92 CD F1 79 ..y CALL 79F1 +7A95 77 w LD (HL),A +7A96 23 # INC HL +7A97 FE 0D .. CP 0D +7A99 28 05 (. JR Z,7AA0 +7A9B 10 F5 .. DJNZ 7A92 +7A9D C3 29 71 .)q JP 7129 +7AA0 21 FA 7C !.| LD HL,7CFA +7AA3 CD B1 7A ..z CALL 7AB1 +7AA6 C2 29 71 .)q JP NZ,7129 +7AA9 3E 01 >. LD A,01 +7AAB 32 18 7D 2.} LD (7D18),A +7AAE C3 D4 70 ..p JP 70D4 +7AB1 E5 . PUSH HL +7AB2 21 19 7D !.} LD HL,7D19 +7AB5 11 1A 7D ..} LD DE,7D1A +7AB8 01 09 00 ... LD BC,0009 +7ABB 1A . LD A,(DE) +7ABC ED A1 .. CPI +7ABE 13 . INC DE +7ABF 20 05 . JR NZ,7AC6 +7AC1 EA BB 7A ..z JP PE,7ABB +7AC4 18 14 .. JR 7ADA +7AC6 D1 . POP DE +7AC7 21 19 7D !.} LD HL,7D19 +7ACA 1A . LD A,(DE) +7ACB 13 . INC DE +7ACC FE 0D .. CP 0D +7ACE 28 06 (. JR Z,7AD6 +7AD0 2F / CPL +7AD1 ED A1 .. CPI +7AD3 28 F5 (. JR Z,7ACA +7AD5 C9 . RET +7AD6 2F / CPL +7AD7 ED A1 .. CPI +7AD9 C9 . RET +7ADA E1 . POP HL +7ADB C9 . RET +7ADC 21 19 7D !.} LD HL,7D19 +7ADF 06 0A .. LD B,0A +7AE1 CD F1 79 ..y CALL 79F1 +7AE4 2F / CPL +7AE5 77 w LD (HL),A +7AE6 FE F2 .. CP F2 +7AE8 CA D4 70 ..p JP Z,70D4 +7AEB 23 # INC HL +7AEC 10 F3 .. DJNZ 7AE1 +7AEE C3 29 71 .)q JP 7129 +7AF1 01 7B C3 .{. LD BC,C37B +7AF4 F6 7A .z OR 7A +7AF6 CD 1F 70 ..p CALL 701F +7AF9 18 06 .. JR 7B01 +7AFB 20 74 t JR NZ,7B71 ; " test2" +7AFD 65 e LD H,L +7AFE 73 s LD (HL),E +7AFF 74 t LD (HL),H +7B00 32 21 00 2!. LD (0021),A +7B03 00 . NOP +7B04 C3 F6 7A ..z JP 7AF6 +7B07 CD 26 7B .&{ CALL 7B26 +7B0A E5 . PUSH HL +7B0B D5 . PUSH DE +7B0C C5 . PUSH BC +7B0D F5 . PUSH AF +7B0E 21 00 00 !.. LD HL,0000 +7B11 39 9 ADD HL,SP +7B12 06 08 .. LD B,08 +7B14 CD 2D 75 .-u CALL 752D +7B17 F1 . POP AF +7B18 C1 . POP BC +7B19 D1 . POP DE +7B1A E1 . POP HL +7B1B C9 . RET +7B1C 3E 0A >. LD A,0A +7B1E CD A4 75 ..u CALL 75A4 +7B21 3E 0D >. LD A,0D +7B23 C3 A4 75 ..u JP 75A4 +7B26 C9 . RET +7B27 C9 . RET +7B28 C9 . RET +7B29 C9 . RET +7B2A C9 . RET +7B2B C9 . RET +7B2C C9 . RET +7B2D C9 . RET +7B2E C9 . RET +7B2F C9 . RET +7B30 C9 . RET +7B31 C9 . RET +7B32 C9 . RET +7B33 C9 . RET +7B34 C9 . RET +7B35 C9 . RET +7B36 C9 . RET +7B37 C9 . RET +7B38 C9 . RET +7B39 00 . NOP +7B3A 10 00 .. DJNZ 7B3C +7B3C 00 . NOP +7B3D 00 . NOP +7B3E 00 . NOP +7B3F 00 . NOP +7B40 0A . LD A,(BC) ; info Dumpueberschrift +7B41 0A . LD A,(BC) +7B42 0D . DEC C +7B43 02 . LD (BC),A +7B44 02 . LD (BC),A +7B45 02 . LD (BC),A +7B46 02 . LD (BC),A +7B47 02 . LD (BC),A +7B48 02 . LD (BC),A +7B49 02 . LD (BC),A +7B4A 02 . LD (BC),A +7B4B 00 . NOP +7B4C 00 . NOP +7B4D 00 . NOP +7B4E 00 . NOP +7B4F 00 . NOP +7B50 00 . NOP +7B51 00 . NOP +7B52 00 . NOP +7B53 01 FF 05 ... LD BC,05FF +7B56 64 d LD H,H +7B57 73 s LD (HL),E +7B58 69 i LD L,C +7B59 64 d LD H,H +7B5A 3D = DEC A +7B5B 03 . INC BC +7B5C 00 . NOP +7B5D 00 . NOP +7B5E 00 . NOP +7B5F 04 . INC B +7B60 61 a LD H,C +7B61 64 d LD H,H +7B62 72 r LD (HL),D +7B63 3D = DEC A +7B64 02 . LD (BC),A +7B65 00 . NOP +7B66 00 . NOP +7B67 07 . RLCA +7B68 6C l LD L,H +7B69 61 a LD H,C +7B6A 65 e LD H,L +7B6B 6E n LD L,(HL) +7B6C 67 g LD H,A +7B6D 65 e LD H,L +7B6E 3D = DEC A +7B6F 00 . NOP +7B70 00 . NOP +7B71 00 . NOP +7B72 00 . NOP +7B73 04 . INC B ; Leitblock Ueberschrift +7B74 06 77 .w LD B,77 +7B76 73 s LD (HL),E +7B77 74 t LD (HL),H +7B78 61 a LD H,C +7B79 74 t LD (HL),H +7B7A 65 e LD H,L +7B7B 04 . INC B +7B7C 01 06 6D ..m LD BC,6D06 +7B7F 69 i LD L,C +7B80 6C l LD L,H +7B81 6C l LD L,H +7B82 69 i LD L,C +7B83 73 s LD (HL),E +7B84 05 . DEC B +7B85 01 06 63 ..c LD BC,6306 +7B88 6F o LD L,A +7B89 6D m LD L,L +7B8A 66 f LD H,(HL) +7B8B 6C l LD L,H +7B8C 67 g LD H,A +7B8D 06 01 .. LD B,01 +7B8F 06 72 .r LD B,72 +7B91 73 s LD (HL),E +7B92 74 t LD (HL),H +7B93 63 c LD H,E +7B94 6F o LD L,A +7B95 64 d LD H,H +7B96 07 . RLCA +7B97 01 06 72 ..r LD BC,7206 +7B9A 73 s LD (HL),E +7B9B 74 t LD (HL),H +7B9C 66 f LD H,(HL) +7B9D 6C l LD L,H +7B9E 67 g LD H,A +7B9F 08 . EX AF,AF' +7BA0 01 06 70 ..p LD BC,7006 +7BA3 72 r LD (HL),D +7BA4 69 i LD L,C +7BA5 63 c LD H,E +7BA6 6E n LD L,(HL) +7BA7 74 t LD (HL),H +7BA8 09 . ADD HL,BC +7BA9 03 . INC BC +7BAA 06 69 .i LD B,69 +7BAC 63 c LD H,E +7BAD 6F o LD L,A +7BAE 75 u LD (HL),L +7BAF 6E n LD L,(HL) +7BB0 74 t LD (HL),H +7BB1 0C . INC C +7BB2 02 . LD (BC),A +7BB3 04 . INC B +7BB4 6D m LD L,L +7BB5 6F o LD L,A +7BB6 64 d LD H,H +7BB7 69 i LD L,C +7BB8 0E 01 .. LD C,01 +7BBA 04 . INC B +7BBB 70 p LD (HL),B +7BBC 62 b LD H,D +7BBD 61 a LD H,C +7BBE 73 s LD (HL),E +7BBF 0F . RRCA +7BC0 01 03 63 ..c LD BC,6303 +7BC3 38 6B 8k JR C,7C30 +7BC5 10 02 .. DJNZ 7BC9 +7BC7 04 . INC B +7BC8 6C l LD L,H +7BC9 62 b LD H,D +7BCA 61 a LD H,C +7BCB 73 s LD (HL),E +7BCC 12 . LD (DE),A +7BCD 02 . LD (BC),A +7BCE 04 . INC B +7BCF 6C l LD L,H +7BD0 74 t LD (HL),H +7BD1 6F o LD L,A +7BD2 70 p LD (HL),B +7BD3 14 . INC D +7BD4 02 . LD (BC),A +7BD5 06 6C .l LD B,6C +7BD7 73 s LD (HL),E +7BD8 5F _ LD E,A +7BD9 74 t LD (HL),H +7BDA 6F o LD L,A +7BDB 70 p LD (HL),B +7BDC 16 02 .. LD D,02 +7BDE 05 . DEC B +7BDF 68 h LD L,B +7BE0 70 p LD (HL),B +7BE1 74 t LD (HL),H +7BE2 6F o LD L,A +7BE3 70 p LD (HL),B +7BE4 18 02 .. JR 7BE8 +7BE6 04 . INC B +7BE7 68 h LD L,B +7BE8 70 p LD (HL),B +7BE9 76 v HALT +7BEA 31 1A 02 1.. LD SP,021A +7BED 04 . INC B +7BEE 68 h LD L,B +7BEF 70 p LD (HL),B +7BF0 76 v HALT +7BF1 32 1C 01 2.. LD (011C),A +7BF4 06 70 .p LD B,70 +7BF6 72 r LD (HL),D +7BF7 69 i LD L,C +7BF8 63 c LD H,E +7BF9 6C l LD L,H +7BFA 6B k LD L,E +7BFB 1D . DEC E +7BFC 01 04 70 ..p LD BC,7004 +7BFF 72 r LD (HL),D +7C00 69 i LD L,C +7C01 76 v HALT +7C02 1E 02 .. LD E,02 +7C04 04 . INC B +7C05 66 f LD H,(HL) +7C06 72 r LD (HL),D +7C07 65 e LD H,L +7C08 65 e LD H,L +7C09 20 02 . JR NZ,7C0D +7C0B 04 . INC B +7C0C 6C l LD L,H +7C0D 69 i LD L,C +7C0E 6E n LD L,(HL) +7C0F 65 e LD H,L +7C10 22 02 07 ".. LD (0702),HL +7C13 65 e LD H,L +7C14 72 r LD (HL),D +7C15 72 r LD (HL),D +7C16 6C l LD L,H +7C17 69 i LD L,C +7C18 6E n LD L,(HL) +7C19 65 e LD H,L +7C1A 24 $ INC H +7C1B 02 . LD (BC),A +7C1C 06 65 .e LD B,65 +7C1E 72 r LD (HL),D +7C1F 72 r LD (HL),D +7C20 63 c LD H,E +7C21 6F o LD L,A +7C22 64 d LD H,H +7C23 26 02 &. LD H,02 +7C25 07 . RLCA +7C26 63 c LD H,E +7C27 68 h LD L,B +7C28 61 a LD H,C +7C29 6E n LD L,(HL) +7C2A 6E n LD L,(HL) +7C2B 65 e LD H,L +7C2C 6C l LD L,H +7C2D 28 02 (. JR Z,7C31 +7C2F 06 63 .c LD B,63 +7C31 68 h LD L,B +7C32 61 a LD H,C +7C33 6D m LD L,L +7C34 61 a LD H,C +7C35 70 p LD (HL),B +7C36 2A 02 04 *.. LD HL,(0402) +7C39 70 p LD (HL),B +7C3A 72 r LD (HL),D +7C3B 69 i LD L,C +7C3C 6F o LD L,A +7C3D 2C , INC L +7C3E 02 . LD (BC),A +7C3F 06 6D .m LD B,6D +7C41 73 s LD (HL),E +7C42 67 g LD H,A +7C43 63 c LD H,E +7C44 6F o LD L,A +7C45 64 d LD H,H +7C46 2E 02 .. LD L,02 +7C48 05 . DEC B +7C49 6D m LD L,L +7C4A 73 s LD (HL),E +7C4B 67 g LD H,A +7C4C 64 d LD H,H +7C4D 73 s LD (HL),E +7C4E 30 04 0. JR NC,7C54 +7C50 06 74 .t LD B,74 +7C52 61 a LD H,C +7C53 73 s LD (HL),E +7C54 6B k LD L,E +7C55 69 i LD L,C +7C56 64 d LD H,H +7C57 34 4 INC (HL) +7C58 04 . INC B +7C59 06 66 .f LD B,66 +7C5B 72 r LD (HL),D +7C5C 6F o LD L,A +7C5D 6D m LD L,L +7C5E 69 i LD L,C +7C5F 64 d LD H,H +7C60 38 08 8. JR C,7C6A +7C62 05 . DEC B +7C63 63 c LD H,E +7C64 6C l LD L,H +7C65 6F o LD L,A +7C66 63 c LD H,E +7C67 6B k LD L,E +7C68 00 . NOP +7C69 00 . NOP +7C6A 00 . NOP +7C6B 0C . INC C +7C6C 20 4C L JR NZ,7CBA ; " LEITBLOCK" +7C6E 45 E LD B,L +7C6F 49 I LD C,C +7C70 54 T LD D,H +7C71 42 B LD B,D +7C72 4C L LD C,H +7C73 4F O LD C,A +7C74 43 C LD B,E +7C75 4B K LD C,E +7C76 20 20 JR NZ,7C98 +7C78 03 . INC BC +7C79 06 17 .. LD B,17 +7C7B 46 F LD B,(HL) +7C7C 11 20 7A . z LD DE,7A20 ; "zuviel gelernt!" +7C7F 75 u LD (HL),L +7C80 76 v HALT +7C81 69 i LD L,C +7C82 65 e LD H,L +7C83 6C l LD L,H +7C84 20 67 g JR NZ,7CED +7C86 65 e LD H,L +7C87 6C l LD L,H +7C88 65 e LD H,L +7C89 72 r LD (HL),D +7C8A 6E n LD L,(HL) +7C8B 74 t LD (HL),H +7C8C 21 20 FF ! . LD HL,FF20 +7C8F FF . RST 38 +7C90 FF . RST 38 +7C91 FF . RST 38 +7C92 FF . RST 38 +7C93 FF . RST 38 +7C94 FF . RST 38 +7C95 00 . NOP +7C96 00 . NOP +7C97 00 . NOP +7C98 00 . NOP +7C99 00 . NOP +7C9A 00 . NOP +7C9B 00 . NOP +7C9C 00 . NOP +7C9D 00 . NOP +7C9E 00 . NOP +7C9F 06 20 . LD B,20 ; "<**> +7CA1 3C < INC A +7CA2 2A 2A 3E **> LD HL,(3E2A) +7CA5 20 15 . JR NZ,7CBC +7CA7 20 50 P JR NZ,7CF9 ; "Paging erforderlich" +7CA9 61 a LD H,C +7CAA 67 g LD H,A +7CAB 69 i LD L,C +7CAC 6E n LD L,(HL) +7CAD 67 g LD H,A +7CAE 20 65 e JR NZ,7D15 +7CB0 72 r LD (HL),D +7CB1 66 f LD H,(HL) +7CB2 6F o LD L,A +7CB3 72 r LD (HL),D +7CB4 64 d LD H,H +7CB5 65 e LD H,L +7CB6 72 r LD (HL),D +7CB7 6C l LD L,H +7CB8 69 i LD L,C +7CB9 63 c LD H,E +7CBA 68 h LD L,B +7CBB 20 11 . JR NZ,7CCE +7CBD 20 4E N JR NZ,7D0D ; "Nicht im Schatt" +7CBF 69 i LD L,C +7CC0 63 c LD H,E +7CC1 68 h LD L,B +7CC2 74 t LD (HL),H +7CC3 20 69 i JR NZ,7D2E +7CC5 6D m LD L,L +7CC6 20 53 S JR NZ,7D1B +7CC8 63 c LD H,E +7CC9 68 h LD L,B +7CCA 61 a LD H,C +7CCB 74 t LD (HL),H +7CCC 74 t LD (HL),H +7CCD 20 FF . JR NZ,7CCE +7CCF FF . RST 38 +7CD0 FF . RST 38 +7CD1 FF . RST 38 +7CD2 FF . RST 38 +7CD3 FF . RST 38 +7CD4 FF . RST 38 +7CD5 FF . RST 38 +7CD6 FF . RST 38 +7CD7 FF . RST 38 +7CD8 FF . RST 38 +7CD9 FF . RST 38 +7CDA FF . RST 38 +7CDB FF . RST 38 +7CDC FF . RST 38 +7CDD FF . RST 38 +7CDE FF . RST 38 +7CDF FF . RST 38 +7CE0 FF . RST 38 +7CE1 FF . RST 38 +7CE2 FF . RST 38 +7CE3 FF . RST 38 +7CE4 FF . RST 38 +7CE5 FF . RST 38 +7CE6 FF . RST 38 +7CE7 FF . RST 38 +7CE8 FF . RST 38 +7CE9 FF . RST 38 +7CEA FF . RST 38 +7CEB FF . RST 38 +7CEC FF . RST 38 +7CED FF . RST 38 +7CEE FF . RST 38 +7CEF FF . RST 38 +7CF0 FF . RST 38 +7CF1 FF . RST 38 +7CF2 FF . RST 38 +7CF3 FF . RST 38 +7CF4 FF . RST 38 +7CF5 FF . RST 38 +7CF6 FF . RST 38 +7CF7 FF . RST 38 +7CF8 00 . NOP +7CF9 00 . NOP +7CFA FF . RST 38 +7CFB FF . RST 38 +7CFC FF . RST 38 +7CFD FF . RST 38 +7CFE FF . RST 38 +7CFF FF . RST 38 +7D00 FF . RST 38 +7D01 FF . RST 38 +7D02 FF . RST 38 +7D03 FF . RST 38 +7D04 FF . RST 38 +7D05 FF . RST 38 +7D06 FF . RST 38 +7D07 FF . RST 38 +7D08 FF . RST 38 +7D09 FF . RST 38 +7D0A FF . RST 38 +7D0B FF . RST 38 +7D0C FF . RST 38 +7D0D FF . RST 38 +7D0E FF . RST 38 +7D0F FF . RST 38 +7D10 FF . RST 38 +7D11 FF . RST 38 +7D12 FF . RST 38 +7D13 FF . RST 38 +7D14 FF . RST 38 +7D15 FF . RST 38 +7D16 FF . RST 38 +7D17 FF . RST 38 +7D18 00 . NOP +7D19 FF . RST 38 +7D1A 00 . NOP +7D1B FF . RST 38 +7D1C FF . RST 38 +7D1D FF . RST 38 +7D1E FF . RST 38 +7D1F FF . RST 38 +7D20 FF . RST 38 +7D21 FF . RST 38 +7D22 FF . RST 38 +7D23 FF . RST 38 +7D24 FF . RST 38 +7D25 FF . RST 38 +7D26 FF . RST 38 +7D27 6D m LD L,L ; "muell 2 (!)" +7D28 75 u LD (HL),L +7D29 65 e LD H,L +7D2A 6C l LD L,H +7D2B 6C l LD L,H +7D2C 20 20 JR NZ,7D4E +7D2E 20 32 2 JR NZ,7D62 +7D30 20 28 ( JR NZ,7D5A +7D32 21 29 CD !). LD HL,CD29 +7D35 20 6E n JR NZ,7DA5 +7D37 21 80 18 !.. LD HL,1880 +7D3A 3E 01 >. LD A,01 +7D3C 01 80 00 ... LD BC,0080 +7D3F 57 W LD D,A +7D40 ED B1 .. CPIR +7D42 E2 48 7D .H} JP PO,7D48 +7D45 14 . INC D +7D46 18 F8 .. JR 7D40 +7D48 42 B LD B,D +7D49 C5 . PUSH BC +7D4A CD E2 6D ..m CALL 6DE2 +7D4D C1 . POP BC +7D4E 10 F9 .. DJNZ 7D49 +7D50 CD 2A 6E .*n CALL 6E2A +7D53 C9 . RET +7D54 50 P LD D,B ; "PROZ MUELL" +7D55 52 R LD D,D +7D56 4F O LD C,A +7D57 5A Z LD E,D +7D58 20 4D M JR NZ,7DA7 +7D5A 55 U LD D,L +7D5B 45 E LD B,L +7D5C 4C L LD C,H +7D5D 4C L LD C,H +7D5E EE 7D .} XOR 7D +7D60 C3 5A 81 .Z. JP 815A +7D63 4D M LD C,L +7D64 FF . RST 38 +7D65 FF . RST 38 +7D66 FF . RST 38 +7D67 FF . RST 38 +7D68 FF . RST 38 +7D69 FF . RST 38 +7D6A FF . RST 38 +7D6B FF . RST 38 +7D6C FF . RST 38 +7D6D FF . RST 38 +7D6E FF . RST 38 +7D6F FF . RST 38 +7D70 FF . RST 38 +7D71 FF . RST 38 +7D72 FF . RST 38 +7D73 FF . RST 38 +7D74 FF . RST 38 +7D75 FF . RST 38 +7D76 FF . RST 38 +7D77 FF . RST 38 +7D78 FF . RST 38 +7D79 FF . RST 38 +7D7A FF . RST 38 +7D7B FF . RST 38 +7D7C FF . RST 38 +7D7D FF . RST 38 +7D7E FF . RST 38 +7D7F FF . RST 38 +7D80 FF . RST 38 +7D81 FF . RST 38 +7D82 FF . RST 38 +7D83 FF . RST 38 +7D84 FF . RST 38 +7D85 FF . RST 38 +7D86 FF . RST 38 +7D87 FF . RST 38 +7D88 FF . RST 38 +7D89 FF . RST 38 +7D8A FF . RST 38 +7D8B FF . RST 38 +7D8C FF . RST 38 +7D8D FF . RST 38 +7D8E FF . RST 38 +7D8F FF . RST 38 +7D90 FF . RST 38 +7D91 FF . RST 38 +7D92 FF . RST 38 +7D93 FF . RST 38 +7D94 FF . RST 38 +7D95 FF . RST 38 +7D96 FF . RST 38 +7D97 FF . RST 38 +7D98 FF . RST 38 +7D99 FF . RST 38 +7D9A FF . RST 38 +7D9B FF . RST 38 +7D9C FF . RST 38 +7D9D FF . RST 38 +7D9E FF . RST 38 +7D9F FF . RST 38 +7DA0 FF . RST 38 +7DA1 FF . RST 38 +7DA2 FF . RST 38 +7DA3 FF . RST 38 +7DA4 FF . RST 38 +7DA5 FF . RST 38 +7DA6 FF . RST 38 +7DA7 FF . RST 38 +7DA8 FF . RST 38 +7DA9 FF . RST 38 +7DAA FF . RST 38 +7DAB FF . RST 38 +7DAC FF . RST 38 +7DAD FF . RST 38 +7DAE FF . RST 38 +7DAF FF . RST 38 +7DB0 FF . RST 38 +7DB1 FF . RST 38 +7DB2 FF . RST 38 +7DB3 FF . RST 38 +7DB4 FF . RST 38 +7DB5 FF . RST 38 +7DB6 FF . RST 38 +7DB7 FF . RST 38 +7DB8 FF . RST 38 +7DB9 FF . RST 38 +7DBA FF . RST 38 +7DBB FF . RST 38 +7DBC FF . RST 38 +7DBD FF . RST 38 +7DBE FF . RST 38 +7DBF FF . RST 38 +7DC0 FF . RST 38 +7DC1 FF . RST 38 +7DC2 FF . RST 38 +7DC3 FF . RST 38 +7DC4 FF . RST 38 +7DC5 FF . RST 38 +7DC6 FF . RST 38 +7DC7 FF . RST 38 +7DC8 FF . RST 38 +7DC9 FF . RST 38 +7DCA FF . RST 38 +7DCB FF . RST 38 +7DCC FF . RST 38 +7DCD FF . RST 38 +7DCE FF . RST 38 +7DCF FF . RST 38 +7DD0 FF . RST 38 +7DD1 FF . RST 38 +7DD2 FF . RST 38 +7DD3 FF . RST 38 +7DD4 FF . RST 38 +7DD5 FF . RST 38 +7DD6 FF . RST 38 +7DD7 FF . RST 38 +7DD8 FF . RST 38 +7DD9 FF . RST 38 +7DDA FF . RST 38 +7DDB FF . RST 38 +7DDC FF . RST 38 +7DDD FF . RST 38 +7DDE FF . RST 38 +7DDF FF . RST 38 +7DE0 FF . RST 38 +7DE1 FF . RST 38 +7DE2 FF . RST 38 +7DE3 FF . RST 38 +7DE4 FF . RST 38 +7DE5 FF . RST 38 +7DE6 FF . RST 38 +7DE7 FF . RST 38 +7DE8 FF . RST 38 +7DE9 FF . RST 38 +7DEA FF . RST 38 +7DEB FF . RST 38 +7DEC FF . RST 38 +7DED FF . RST 38 +7DEE F0 . RET P +7DEF 7D } LD A,L +7DF0 21 B5 4C !.L LD HL,4CB5 +7DF3 CB 96 .. RES 2,(HL) +7DF5 CD E2 6D ..m CALL 6DE2 +7DF8 3A 17 82 :.. LD A,(8217) ; "musta" Zelle +7DFB 3D = DEC A +7DFC FA F5 7D ..} JP M,7DF5 +7DFF 21 B5 4C !.L LD HL,4CB5 +7E02 CB D6 .. SET 2,(HL) +7E04 3C < INC A +7E05 CB 57 .W BIT 2,A ; shutup +7E07 20 1E . JR NZ,7E27 +7E09 CB 4F .O BIT 1,A ; fixpoint +7E0B 20 1A . JR NZ,7E27 +7E0D CB 47 .G BIT 0,A ; collect garbage +7E0F C2 FF 7E ..~ JP NZ,7EFF +7E12 CB 5F ._ BIT 3,A ; savesystem +7E14 C2 7C 80 .|. JP NZ,807C +7E17 97 . SUB A +7E18 32 17 82 2.. LD (8217),A +7E1B 18 D3 .. JR 7DF0 ; Warte bis Anforderung da +7E1D 3A 17 82 :.. LD A,(8217) ; Musta +7E20 CB 47 .G BIT 0,A +7E22 C2 FF 7E ..~ JP NZ,7EFF +7E25 18 C9 .. JR 7DF0 +7E27 3A 13 57 :.W LD A,(5713) +7E2A B7 . OR A +7E2B 20 F0 . JR NZ,7E1D +7E2D 21 17 82 !.. LD HL,8217 +7E30 CB 66 .f BIT 4,(HL) +7E32 CB A6 .. RES 4,(HL) +7E34 20 1E . JR NZ,7E54 +7E36 CD 88 81 ... CALL 8188 +7E39 11 00 00 ... LD DE,0000 +7E3C CD DE 66 ..f CALL 66DE +7E3F CD A4 81 ... CALL 81A4 +7E42 54 T LD D,H +7E43 5D ] LD E,L +7E44 01 80 00 ... LD BC,0080 +7E47 21 80 18 !.. LD HL,1880 +7E4A ED B0 .. LDIR +7E4C 21 B9 4C !.L LD HL,4CB9 +7E4F 01 40 00 .@. LD BC,0040 +7E52 ED B0 .. LDIR +7E54 CD 57 60 .W` CALL 6057 +7E57 CB 96 .. RES 2,(HL) +7E59 CB EE .. SET 5,(HL) +7E5B 2C , INC L +7E5C 20 F9 . JR NZ,7E57 +7E5E 21 2B 1E !+. LD HL,1E2B +7E61 CD 80 67 ..g CALL 6780 +7E64 21 2B 1E !+. LD HL,1E2B +7E67 11 18 82 ... LD DE,8218 +7E6A 01 10 00 ... LD BC,0010 +7E6D ED B0 .. LDIR +7E6F CD 51 60 .Q` CALL 6051 +7E72 06 64 .d LD B,64 +7E74 CD 20 6E . n CALL 6E20 +7E77 CD E2 6D ..m CALL 6DE2 +7E7A CD 2A 6E .*n CALL 6E2A +7E7D 10 F5 .. DJNZ 7E74 +7E7F CD 57 60 .W` CALL 6057 +7E82 CB 6E .n BIT 5,(HL) +7E84 28 0C (. JR Z,7E92 +7E86 CB AE .. RES 5,(HL) +7E88 CB 4E .N BIT 1,(HL) +7E8A 20 06 . JR NZ,7E92 +7E8C CD 65 5F .e_ CALL 5F65 +7E8F CD 34 7D .4} CALL 7D34 +7E92 2C , INC L +7E93 20 ED . JR NZ,7E82 +7E95 CD 99 5F .._ CALL 5F99 +7E98 11 02 00 ... LD DE,0002 +7E9B CD 46 81 .F. CALL 8146 +7E9E 57 W LD D,A +7E9F 1E EF .. LD E,EF +7EA1 62 b LD H,D +7EA2 2E DF .. LD L,DF +7EA4 01 E0 00 ... LD BC,00E0 +7EA7 ED B8 .. LDDR +7EA9 1E 00 .. LD E,00 +7EAB 21 18 82 !.. LD HL,8218 +7EAE 01 10 00 ... LD BC,0010 +7EB1 ED B0 .. LDIR +7EB3 6A j LD L,D +7EB4 CB 3D .= SLR L +7EB6 CB FD .. SET 7,L +7EB8 26 15 &. LD H,15 +7EBA CD 65 5F .e_ CALL 5F65 +7EBD 21 17 82 !.. LD HL,8217 +7EC0 CB 4E .N BIT 1,(HL) +7EC2 CB 8E .. RES 1,(HL) +7EC4 C2 F0 7D ..} JP NZ,7DF0 +7EC7 CD DF 7E ..~ CALL 7EDF +7ECA 3A AD 60 :.` LD A,(60AD) +7ECD B7 . OR A +7ECE 20 06 . JR NZ,7ED6 +7ED0 21 28 82 !(. LD HL,8228 +7ED3 CD CA 6E ..n CALL 6ECA +7ED6 CD 3B 5A .;Z CALL 5A3B +7ED9 CD 87 28 ..( CALL 2887 +7EDC C3 DC 7E ..~ JP 7EDC +7EDF 11 00 00 ... LD DE,0000 +7EE2 CD 46 81 .F. CALL 8146 +7EE5 67 g LD H,A +7EE6 2E 0D .. LD L,0D +7EE8 36 00 6. LD (HL),00 +7EEA 2E 46 .F LD L,46 +7EEC 11 19 7D ..} LD DE,7D19 +7EEF 01 0A 00 ... LD BC,000A +7EF2 EB . EX DE,HL +7EF3 ED B0 .. LDIR +7EF5 6F o LD L,A +7EF6 CB 3D .= SLR L +7EF8 CB FD .. SET 7,L +7EFA 26 15 &. LD H,15 +7EFC C3 65 5F .e_ JP 5F65 +7EFF CD 16 54 ..T CALL 5416 +7F02 3A 17 82 :.. LD A,(8217) ; Musta +7F05 CB 67 .g BIT 4,A +7F07 20 2B + JR NZ,7F34 +7F09 ED 4B 10 82 .K.. LD BC,(8210) +7F0D 11 00 00 ... LD DE,0000 +7F10 78 x LD A,B +7F11 B1 . OR C +7F12 28 08 (. JR Z,7F1C +7F14 CD D6 53 ..S CALL 53D6 +7F17 13 . INC DE +7F18 13 . INC DE +7F19 0B . DEC BC +7F1A 18 F4 .. JR 7F10 +7F1C 97 . SUB A +7F1D 32 0C 82 2.. LD (820C),A +7F20 32 0D 82 2.. LD (820D),A +7F23 21 2B 1E !+. LD HL,1E2B +7F26 CD B3 7F ... CALL 7FB3 +7F29 3E 01 >. LD A,01 +7F2B 32 0C 82 2.. LD (820C),A +7F2E 3A 13 57 :.W LD A,(5713) +7F31 B7 . OR A +7F32 20 17 . JR NZ,7F4B +7F34 11 02 00 ... LD DE,0002 +7F37 CD 46 81 .F. CALL 8146 +7F3A 67 g LD H,A +7F3B 2E 00 .. LD L,00 +7F3D 11 18 82 ... LD DE,8218 +7F40 01 10 00 ... LD BC,0010 +7F43 ED B0 .. LDIR +7F45 21 18 82 !.. LD HL,8218 +7F48 CD B3 7F ... CALL 7FB3 +7F4B CD 34 7D .4} CALL 7D34 +7F4E CD E7 55 ..U CALL 55E7 +7F51 30 27 0' JR NC,7F7A +7F53 EB . EX DE,HL +7F54 3A 17 82 :.. LD A,(8217) ; Musta +7F57 CB 67 .g BIT 4,A +7F59 28 50 (P JR Z,7FAB +7F5B CD B1 81 ... CALL 81B1 +7F5E E5 . PUSH HL +7F5F 6C l LD L,H +7F60 26 15 &. LD H,15 +7F62 CB 3D .= SLR L +7F64 CB FD .. SET 7,L +7F66 CB 8E .. RES 1,(HL) +7F68 E1 . POP HL +7F69 06 00 .. LD B,00 +7F6B 5E ^ LD E,(HL) +7F6C 23 # INC HL +7F6D 56 V LD D,(HL) +7F6E 14 . INC D +7F6F 28 04 (. JR Z,7F75 +7F71 15 . DEC D +7F72 CD 5F 80 ._. CALL 805F +7F75 23 # INC HL +7F76 10 F3 .. DJNZ 7F6B +7F78 18 D1 .. JR 7F4B +7F7A 3E 01 >. LD A,01 +7F7C 32 0D 82 2.. LD (820D),A +7F7F CD 5C 54 .\T CALL 545C +7F82 21 17 82 !.. LD HL,8217 +7F85 CB 86 .. RES 0,(HL) +7F87 CB 66 .f BIT 4,(HL) +7F89 CA F0 7D ..} JP Z,7DF0 +7F8C 36 01 6. LD (HL),01 +7F8E 11 02 00 ... LD DE,0002 +7F91 CD 46 81 .F. CALL 8146 +7F94 57 W LD D,A +7F95 1E 00 .. LD E,00 +7F97 21 18 82 !.. LD HL,8218 +7F9A 01 10 00 ... LD BC,0010 +7F9D ED B0 .. LDIR +7F9F CD 88 81 ... CALL 8188 +7FA2 CD 18 53 ..S CALL 5318 +7FA5 CD A4 81 ... CALL 81A4 +7FA8 C3 FF 7E ..~ JP 7EFF +7FAB CD D6 53 ..S CALL 53D6 +7FAE CD B1 81 ... CALL 81B1 +7FB1 18 B6 .. JR 7F69 +7FB3 06 04 .. LD B,04 +7FB5 0E 10 .. LD C,10 +7FB7 E5 . PUSH HL +7FB8 C5 . PUSH BC +7FB9 5E ^ LD E,(HL) +7FBA 23 # INC HL +7FBB 56 V LD D,(HL) +7FBC CD 67 80 .g. CALL 8067 +7FBF 69 i LD L,C +7FC0 CD CC 7F ... CALL 7FCC +7FC3 C1 . POP BC +7FC4 0E 00 .. LD C,00 +7FC6 E1 . POP HL +7FC7 23 # INC HL +7FC8 23 # INC HL +7FC9 10 EC .. DJNZ 7FB7 +7FCB C9 . RET +7FCC 14 . INC D +7FCD C8 . RET Z +7FCE 15 . DEC D +7FCF CD 0D 54 ..T CALL 540D +7FD2 D5 . PUSH DE +7FD3 CD 46 81 .F. CALL 8146 +7FD6 67 g LD H,A +7FD7 CD EA 7F ... CALL 7FEA +7FDA D1 . POP DE +7FDB 20 F5 . JR NZ,7FD2 +7FDD D5 . PUSH DE +7FDE CD 46 81 .F. CALL 8146 +7FE1 67 g LD H,A +7FE2 24 $ INC H +7FE3 CD EA 7F ... CALL 7FEA +7FE6 D1 . POP DE +7FE7 20 F4 . JR NZ,7FDD +7FE9 C9 . RET +7FEA 5E ^ LD E,(HL) +7FEB 2C , INC L +7FEC 56 V LD D,(HL) +7FED 14 . INC D +7FEE 28 22 (" JR Z,8012 + - Fortsetzung in Datei "eumel0.prt.5" - diff --git a/system/printer-9nadel/1986/doc/readme b/system/printer-9nadel/1986/doc/readme new file mode 100644 index 0000000..a7edd90 --- /dev/null +++ b/system/printer-9nadel/1986/doc/readme @@ -0,0 +1,323 @@ +#type("nlq10")##limit(18.0)##start(1.5,1.0)# +#head# +Treiber-Installations-Programm #right#Seite % +fr 9-Nadel-Matrixdrucker #right#23.06.1988 + + +#end# +#on("u")#Dokumentation zum Treiber-Installations-Programm fr 9-Nadel- +Matrixdrucker#off("u")# + +#on("u")#Inhalt:#off("u")# + +1. Installations- und Gebrauchsanleitung +2. Druckertreiber-Auswahl +3. Steuerungsmglichkeiten und Spezialfeatures +4. Weitere Hinweise + + +#on("b")#1. Installations- und Gebrauchsanleitung#off("b")# + +#on("u")#Einrichten#off("u")# +So wird das Treiber-Installationsprogramm eingerichtet: + + SV drcken + + nach 'gib supervisor kommando:' + + begin("PRINTER","SYSUR") + + in der Task "PRINTER" (nach 'gib kommando'): + + archive ("std.printer") + fetch ("printer.neun.nadel",archive) + check off + insert ("printer.neun.nadel") + +Das Programm wird dann insertiert. + +#on("u")#Druckerkanal#off("u")# +Hiernach wird die Kanalnummer des Druckers erfragt. Wenn der Drucker +ber Parallelschnittstelle betrieben wird, ist die Kanalnummer +meistens 15. + +#on("u")#Mensystem#off("u")# +Das Installationsprogramm zeigt nun eine Liste von Druckerherstellern. +Whlen Sie den Hersteller Ihres Druckers aus! Hiernach wird eine Liste +der untersttzten Drucker dieses Herstellers gezeigt. Whlen Sie hier +den passenden Typ aus! +Das Installationsprogramm zeigt nun einige Informationen zu dem ange- +whlten Drucker. Besonders zu beachten sind hierbei #on("u")#Angaben zur Konfi- +guration des Druckers#off("u")# (z.B. DIP-Schalter). Der Drucker mu unbedingt +wie angegeben konfiguriert werden, wenn er mit dem ausgewhlten Trei- +ber betrieben werden soll. + +Hinweise zu Konfigurationsangaben: +1. Die Angabe 'egal' bedeutet, da die Einstellung fr die Funktion + des Treibers keine Bedeutung hat. Dennoch solte der Anwender darauf + achten, welche Funktion die Schalter haben (Druckerhandbuch!). So + ist es zum Beispiel immer empfehlenswert, den Papierende-Sensor zu + aktivieren, damit der Drucker nach Papierende nicht auf der Walze + weiterdruckt. +2. Die Konfigurationsangaben beziehen sich immer auf genau den ausge- + whlten Druckertyp. Wenn Sie den Treiber mit einem anderen Drucker + als den ausgewhlten verwenden, dann beachten Sie folgende Regeln + fr die Konfiguration: + - Der Drucker mu auf eine passende Emulation konfiguriert werden. + - Der Drucker darf bei einem Carriage Return (Code 13) keinen Zei- + lenvorschub durchfhren. + - Der Drucker darf die Perforation #on("u")#nicht#off("u")# automatisch berspringen. + + - Auf Seitenlngen und internationale Zeichenstze mssen Sie nicht + achten. + +(Hinweise zur Auswahl des richtigen Treibers gibt Abschnitt 2) + +Nach den Konfigurationsangaben werden Steuerungsmglichkeiten des +ausgewhlten Treibers angezeigt. (Siehe hierzu Abschnitt 3) + +Falls der Treiber bestimmte grundstzliche Betriebsmglichkeiten er- +laubt (z.B. DRAFT/NLQ, Einzelblatteinzug), werden Sie danach gefragt, +welche Mglichkeit standardmig gewhlt werden soll. diese Vorein- +stellungen knnen nachtrglich in der Task "PRINTER" mit den entspre- +chenden Steuerprozeduren neu gesetzt werden. Auerdem knnen bestimmte +Einstellungen noch fr jedes einzelne Dokument (d.h. fr jede Druck- +datei) gewhlt ('material'-Anweisung) oder sogar innerhalb eines Doku- +ments verndert werden (direkte Druckeranweisung #"..."#). +ber die Steuerungsmglichkeiten informiert Abschnitt 3 ausfhrlicher. + + +#on("b")#2. Druckertreiber-Auswahl#off("b")# + +#on("u")#Verwendung nicht im Men enthaltener Drucker#off("u")# +Fr den Fall, da Sie genau Ihren Drucker im Men nicht finden, soll- +ten Sie zunchst versuchen, ob ein Treiber fr einen anderen Drucker +des gleichen Herstellers mit Ihrem Drucker korrekt arbeitet. +Falls dies nicht funktioniert oder der Hersteller berhaupt nicht im +Men erscheint, mssen Sie herausfinden (Druckerhandbuch, -hndler!), +welchen Drucker Ihr Drucker emuliert oder welchem er hnlich ist. +(Viele Drucker verfgen ber EPSON FX-85 bzw. FX-800-Emulationen oder +IBM Grafikdrucker bzw. Proprinter-Eumulationen.) +Eine der beiden Anpassungen 'EPSON MX' oder 'IBM-Grafikdrucker' mte +immer einen (Minimal-) Betrieb ermglichen. + +#on("u")#Hinweise zu den Treibern fr FX-80/85-kompatilble Drucker#off("u")# +Die Treiber fr FX-80-bzw. FX-85-kompatible Gerte, die oft auch IBM- +kompatibel sind, basieren blicherweise auf den Treibern fr EPSON- +Drucker, weil so einige Schrifttypen (z.B. Proportionalschrift) und +Modifikationen leichter ausgenutzt werden knnen. Ein Nachteil liegt +aber darin, da beim FX-80 und FX-85 noch die alten EPSON-Zeichenstze +benutzt werden, die nicht die IBM-blichen Grafik- und Sonderzeichen +enthalten. +Falls fr Sie die Benutzung dieser Zeichen vordringlich ist, sollten +Sie Ihren Drucker (nachdem er auf IBM-Emulation konfiguriert wurde) +zusammen mit dem Treiber fr IBM-Grafikdrucker bzw. -Proprinter ver- +wenden. + + +#on("b")#3. Steuerungsmglichkeiten und Spezialfeatures#off("b")# + +Einige Treiber bieten bestimmte Einstellungsmglichkeiten (z.B. +DRAFT/NLQ) und/oder Spezialfeatures (z.B. Farbdruck). +Die Einstellungen knnen ber +- Steuerprozeduren +- Materialanweisungen bzw. +- direkte Druckeranweisungen +vorgenommen werden. + +#on("u")#Steuerprozeduren#off("u")# +setzen Einstellungen, die fr alle Dokumente (Druckdateien) gelten +sollen. Die Prozeduren mssen in der Druckspooltask (meist: "PRINTER") +aufgerufen werden. #on("b")#Gltig werden die nderungen erst, wenn danach in +der Druckspooltask das Kommando 'start' gegeben wird!#off("b")# + +PROC papersize (REAL CONST breite, lnge) + Dient zur Einstellung der Gre der physikalisch beschreibbaren + Flche. + Beispiel: papersize (20.32, 30.48) + (Standardeinstellung fr Endlospapier 8 Zoll breit und + 12 Zoll lang) + +PROC papersize + Informationsprozedur + +PROC top margin (REAL CONST margin) + Falls der Drucker es nicht erlaubt, direkt am Blattanfang zu druk- + ken (zum Beispiel wegen eines Einzelblatteinzugs), mu mit dieser + Prozedur die Lnge des oberen Randes, den der Drucker nicht be- + drucken kann, in cm angegeben werden. + Beispiel: top margin (2.0) + (Teilt dem Druckertreiber mit, da die ersten 2 cm + nicht bedruckbar sind.) + +REAL PROC top margin + Informationsprozedur + +PROC std speed (TEXT CONST speed) + Parameter: slow, fast + Wahl zwischen Positionierung in Mikroschritten (slow) oder in + Blanks (fast). + Beispiel: std speed ("slow") + +TEXR PROC std speed + Informationsprozedur + +PROC std quality (TEXT CONST quality) + bliche Parameter: draft, nlq + Wahl zwischen Datenverarbeitungs-Qualitt und Schnschrift- + Qualitt + Beispiel: std quality ("draft") + +TEXT PROC std quality + Informationsprozedur + +PROC std typeface (TEXT CONST typeface) + bliche Parameter: roman, sansserif, courier + Wahl zwischen verschiedenen NLQ-Schriftarten (nur sichtbar im + NLQ-Modus, das heit 'std typeface' schaltet nicht auf NLQ). + Beispiel: std typeface ("roman") + +TEXT PROC std typeface + Informationsprozedur + +PROC paper feed (TEXT CONST name) + bliche Parameter: tractor, sheet, schacht1, schacht2 + Whlt Endlospapier oder Einzelblatteinzug und ggf. Schachtnummer. + Beispiel: paper feed ("sheet") + +TEXT PROC paper feed + Informationsprozedur + + +#on("u")#Materialanweisungen #material("...")##off("u")# +mssen in der Druckdatei vor dem ersten druckbaren Zeichen stehen und +setzen Einstellungen fr eine ganze Datei. (Materialanweisungen haben +fr die jeweilige Datei Vorrang vor den durch Steuerprozeduren einge- +stellten Standardwerten. Diese werden durch die Materialanweisung aber +nicht gendert.) + +Beispiel: #material("nlq")# + sorgt bei entsprechendem Treiber dafr, da das gesamte + Dokument in Schnschrift-Qualitt ausgedruckt wird, egal + wie 'std quality' eingestellt ist. + +#on("b")#Es darf in einer Datei nur eine Materialanweisung stehen!#off("b")# Sollen meh- +rere Einstellungen vorgenommen werden, mssen sie in einer Anweisung +erscheinen. Beispiel: #material("sheet;draft")# + + +#on("u")#direkte Druckeranweisungen #"..."##off("u")# +gelten ab der Position, an der sie in der Datei auftreten. Sie haben +(sofern sie erlaubt sind,) Vorrang vor Standardeinstellungen und +Materialeinstellungen. + +Beispiel: #"draft"# + schaltet (bei entsprechendem Treiber) auf Datenverar- + beitungs-Qualitt, egal welche Standardeinstellung vorliegt + und welche Materialanweisung gegeben wurde. + +#on("b")#In einer Druckeranweisung darf nur eine Einstellung vorgenommen +werden.#off("b")# Also: #"nlq"##"sansserif"# + + +#on("u")#Wichtig#off("u")# +- Achten Sie bei Materialanweisungen und direkten Druckeranweisungen + besonders auf korrekte Schreibweise! Es werden nur Kleinbuchstaben + bercksichtigt! Also: #"nlq"# und keinesfalls #"NLQ"#!!! +- Direkte Druckeranweisungen werden vom EUMEL-Drucker ignoriert und + nur vom Druckertreiber in eine Kommando-Sequenz umgesetzt. Es kann + daher vorkommen, da (z.B. bei Spaltendruck) unerwartete Ergebnisse + erscheinen, weil der EUMEL-Drucker dann den Text in einer anderen + Reihenfolge an den Drucker sendet, als er in der Datei steht, die + mit dem direkten Druckerkommando gesetzte Modifikation aber (z.B. + fr beide Spalten) unerwnscht erhalten bleibt. + + +#on("u")#Tabelle#off("u")# +Die Tabelle soll einen Anhaltspunkt dafr geben, wie welche Einstel- +lungen erfolgen knnen. + +#type("17")# + Steuerprozeduren Materialanweisungen direkte Druckeranweisungen + +#on("u")# #off("u")# + +Positionierung std speed slow, fast ------ + slow, fast + +Qualitt std quality z.B. draft, nlq z.B. draft, nlq + z.B. draft, nlq + +Schriftart std typeface z.B. roman, z.B. roman, +(nur bei NLQ) z.B. roman, sansserif, courier sansserif, courier + sansserif, courier + +Einzelblatt- paper feed z.B. schacht1, z.B. schacht1, +einzug z.B. tractor, schacht2 schacht2 + sheet, + schacht1, schacht2 + +Farbdruck ------ ------ z.B. schwarz, + rot, blau, + violett, gelb + orange, grn + + + +#type("nlq10")##on("b")#4. Weitere Hinweise#off("b")# + +#on("u")#Zeichensatznderungen gegenber frheren Versionen#off("u")# +In den Fonttabellen frherer Druckertreiber-Versionen wurden oberhalb +des Codes 127 einige internationale Zeichen zur Verfgung gestellt +(und zwar in Anlehnung an den Agfa-Laserdrucker-Zeichensatz). +Bei den Treibern der vorliegenden Version gilt folgendes: +- Wie bisher wird der volle im Benutzerhandbuch festgelegte EUMEL- + Zeichensatz (sofern mglich) untersttzt. +- Der Code 252 liefert das Paragraphzeichen. +- Alle brigen (vom EUMEL-Zeichensatz nicht definierten) Zeichencodes + oberhalb 127 liefern, sofern mglich, die entsprechenden Zeichen des + IBM-Grafikzeichensatzes. + + +#on("u")#Hinweis zu Proportionalschriften#off("u")# +Bei Proportionalschriften sollte die Modifikation #on("i")# nicht +benutzt werden, da die kursiven Zeichen andere Proportionalbreiten +haben. Stattdessen sollte auf den schrgen Typ umgeschaltet werden +(z.B. von "prop10" auf "prop10i"). + + +#on("u")#Hinweis zur Benutzung von Einzelblatteinzgen#off("u")# +Bei der Benutzung von Einzelblatteinzgen mssen folgende Einstel- +lungen vorgenommen werden (vgl. auch Abschnitt 3!): + + Am Drucker: +1. Sie mssen Ihren Drucker auf die Option Einzelblatteinzug konfigu- + rieren (siehe Druckerhandbuch!). + + In der Druckspooltask (meist 'PRINTER'): +2. Falls der Druckertreiber die Steuerprozedur 'paper feed' zur Verf- + gung stellt, mssen Sie mit 'paperfeed ("sheet")' oder (fr + 2-Schacht-Einzge) mit 'paperfeed ("schacht1")' bzw. 'paperfeed + ("schacht2")' den Druckertreiber auf Einzelblatteinzug umschalten. +3. Falls Sie eine andere Papierlnge als 12 Zoll (=30.48 cm) verwen- + den, mssen Sie die neuen Papiermae mit 'papersize' in cm einstel- + len. + Beispiel: papersize (21.0, 29.7) + (fr DIN A4-Bltter) +4. Falls der Drucker mit dem Einzelblatteinzug nicht direkt am Blatt- + anfang drucken kann, sondern ein gewisser oberer Rand bleibt, mu + mit 'top margin' die Lnge des nicht bedruckbaren Randes in cm dem + Druckertreiber mitgeteilt werden. + Beispiel: top margin (1.5) + (Wie gro der obere Rand ist, kann festgestellt werden, indem eine + Datei mit #start(0.0,0.0)# ausgedruckt wird.) + + Wurde mit 'top margin' dem Treiber die Gre der nicht bedruckbaren + Flche mitgeteilt, so ist darauf zu achten, da in den Druckdateien + ein gengend groer y-Wert fr die Startposition eingestellt wird + ('start'-Anweisung). Andernfalls kommt es bei der Ausgabe in der + ersten Zeile zu berschreibungen. + + +#on("b")#5. Die nderungen, die Sie in der Druckspooltask vorgenommen haben + werden erst wirksam, wenn das Spool-Kommando 'start' gegeben wird.#off("b")# diff --git a/system/printer-9nadel/1986/src/CHARED.ELA b/system/printer-9nadel/1986/src/CHARED.ELA new file mode 100644 index 0000000..a54679f --- /dev/null +++ b/system/printer-9nadel/1986/src/CHARED.ELA @@ -0,0 +1,47 @@ +PACKET chared DEFINES chared : + +PROC chared (TEXT VAR text denoter, BOOL CONST dens) : +FILE VAR f := editfile; +TEXT VAR t ; +ROW 30 INT VAR bytes ; +INT VAR i, zeile, max breite := 0 ; +FOR i FROM 1 UPTO 30 REP + bytes(i) := 0 +PER ; +input (f) ; +zeile := 7 ; +WHILE NOT eof (f) REP + getline (f, t) ; + convert line ; + zeile DECR 1 +UNTIL zeile < 0 PER ; +convert to text denoter . + + +convert line : + FOR i FROM 1 UPTO LENGTH t REP + IF (t SUB i) <> " " AND (t SUB i) <> "." + THEN setbit (bytes (i), zeile) ; + max breite := max (max breite, i) + FI + PER . + +convert to text denoter : + text denoter := """""27""K""" ; + IF dens + THEN text denoter CAT text (max breite) + ELSE text denoter CAT text (max breite DIV 2) + FI ; + text denoter CAT """""0""" ; + FOR i FROM 1 UPTO max breite REP + IF dens OR (i AND 1) = 1 + THEN text denoter CAT """" ; + text denoter CAT text (bytes (i)) ; + text denoter CAT """" + FI + PER ; + text denoter CAT """" . + +ENDPROC chared ; + +ENDPACKET chared diff --git a/system/printer-9nadel/1986/src/EPSONFX.ELA b/system/printer-9nadel/1986/src/EPSONFX.ELA new file mode 100644 index 0000000..3852122 --- /dev/null +++ b/system/printer-9nadel/1986/src/EPSONFX.ELA @@ -0,0 +1,575 @@ + FONTTABLE : "fonttab.epson.fx+"; + x unit = 47.24409; + y unit = 85.03937; + on string = ""27"-1", ""27"G", ""27"4", ""; + off string = ""27"-0", ""27"H", ""27"5", ""; + + ""127"", ""; + ""128"", "-"; + ""129"", "-"; + ""130"", "-"; + ""131"", "-"; + ""132"", "-"; + ""133"", "-"; + ""134"", "-"; + ""135"", "-"; + ""136"", "-"; + ""137"", "-"; + ""138"", "-"; + ""139"", "-"; + ""140"", "-"; + ""141"", "-"; + ""142"", "-"; + ""143"", "-"; + ""144"", "-"; + ""145"", "-"; + ""146"", "-"; + ""147"", "-"; + ""148"", "-"; + ""149"", "-"; + ""150"", "-"; + ""151"", "-"; + ""152"", "-"; + ""153"", "-"; + ""154"", "-"; + ""155"", "-"; + ""156"", "-"; + ""157"", "-"; + ""158"", "-"; + ""159"", "-"; + ""160"", "-"; + ""161"", "-"; + ""162"", "-"; + ""163"", "-"; + ""164"", "-"; + ""165"", "-"; + ""166"", "-"; + ""167"", "-"; + ""168"", "-"; + ""169"", "-"; + ""170"", "-"; + ""171"", "-"; + ""172"", "-"; + ""173"", "-"; + ""174"", "-"; + ""175"", "-"; + ""176"", "-"; + ""177"", "-"; + ""178"", "-"; + ""179"", "-"; + ""180"", "-"; + ""181"", "-"; + ""182"", "-"; + ""183"", "-"; + ""184"", "-"; + ""185"", "-"; +(*i`*) ""186"", ""27"%"0""0""4""27"%"1""0""; + ""187"", "-"; + ""188"", "-"; + ""189"", "-"; +(*a`*) ""190"", ""27"%"0""0""0""27"%"1""0""; + ""191"", "-"; + ""192"", "-"; +(*e'*) ""193"", ""27"R"1"{"27"R"0""; +(*e`*) ""194"", ""27"%"0""0""1""27"%"1""0""; + ""195"", "-"; + ""196"", "-"; + ""197"", "-"; +(*o`*) ""198"", ""27"%"0""0""3""27"%"1""0""; + ""199"", "-"; +(*c,*) ""200"", ""27"R"1"\"27"R"0""; + ""201"", "-"; +(*u`*) ""202"", ""27"%"0""0""2""27"%"1""0""; + ""203"", "-"; + ""204"", "-"; +(*grad*) ""205"", ""27"R"1"["27"R"0""; +(*A-grad*) ""206"", ""27"R"4"]"27"R"0""; +(*AE*) ""207"", ""27"R"4"]"27"R"0""; +(*E'*) ""208"", ""27"R"5"@"27"R"0""; +(*N~*) ""209"", ""27"R"7"\"27"R"0""; +(*a-punkt*)""210"", ""27"R"4"}"27"R"0""; +(*ae*) ""211"", ""27"R"4"{"27"R"0""; +(*n~*) ""212"", ""27"R"7"|"27"R"0""; +(*pound*) ""213"", ""27"R"3"#"27"R"0""; + (* *) ""214"", ""27"R"2"["27"R"0""; + (* *) ""215"", ""27"R"2"\"27"R"0""; + (* *) ""216"", ""27"R"2"]"27"R"0""; + (* *) ""217"", ""27"R"2"{"27"R"0""; + (* *) ""218"", ""27"R"2"|"27"R"0""; + (* *) ""219"", ""27"R"2"}"27"R"0""; + (* k *) ""220"", "k"; + (* - *) ""221"", "-"; + (* # *) ""222"", "#"; + (* *) ""223"", " "; + ""224"", "-"; + ""225"", "-"; + ""226"", "-"; + ""227"", "-"; + ""228"", "-"; + ""229"", "-"; + ""230"", "-"; + ""231"", "-"; + ""232"", "-"; + ""233"", "-"; + ""234"", "-"; + ""235"", "-"; + ""236"", "-"; + ""237"", "-"; + ""238"", "-"; + ""239"", "-"; + ""240"", "-"; + ""241"", "-"; + ""242"", "-"; + ""243"", "-"; + ""244"", "-"; + ""245"", "-"; + ""246"", "-"; + ""247"", "-"; + ""248"", "-"; + ""249"", "-"; + ""250"", "-"; + (* *) ""251"", ""27"R"2"~"27"R"0""; +(*paragr.*)""252"", ""27"R"2"@"27"R"0""; + ""253"", "-"; + ""254"", "-"; + ""255"", "-"; + + + FONT : "17", "micron", "elanlist"; + indentation pitch = 7; + font height = 36; + next smaller font = "17.klein"; + font string = ""27"!"4""27"5"27"T"; + + ""127"", 0; + + FONT : "17.klein", "micron.klein"; + indentation pitch = 7; + font height = 19; + font string = ""27"!"4""27"5"27"S"1""; + + ""127"", 0; + + FONT : "10", "pica"; + indentation pitch = 12; + font height = 36; + next smaller font = "10.klein"; + font string = ""27"!"0""27"5"27"T"; + + ""127"", 0; + + FONT : "10.klein", "pica.klein"; + indentation pitch = 12; + font height = 19; + font string = ""27"!"0""27"5"27"S"1""; + + ""127"", 0; + + FONT : "10b"; + indentation pitch = 12; + font height = 36; + next smaller font = "10b.klein"; + font string = ""27"!"8""27"5"27"T"; + + ""127"", 0; + + FONT : "10b.klein"; + indentation pitch = 12; + font height = 19; + font string = ""27"!"8""27"5"27"S"1""; + + ""127"", 0; + + FONT : "20"; + indentation pitch = 6; + font height = 36; + next smaller font = "10.klein"; + font string = ""27"!"5""27"5"27"T"; + + ""127"", 0; + + FONT : "20.klein"; + indentation pitch = 6; + font height = 19; + font string = ""27"!"5""27"5"27"S"1""; + + ""127"", 0; + + FONT : "12", "elite"; + indentation pitch = 10; + font height = 36; + next smaller font = "12.klein"; + font string = ""27"!"1""27"5"27"T"; + + ""127"", 0; + + FONT : "12.klein", "elite.klein"; + indentation pitch = 10; + font height = 19; + font string = ""27"!"1""27"5"27"S"1""; + + ""127"", 0; + + FONT : "8.5", "8"; + indentation pitch = 14; + font height = 36; + next smaller font = "8.5.klein"; + font string = ""27"!$"27"5"27"T"; + + ""127"", 0; + + FONT : "8.5.klein", "8.klein"; + indentation pitch = 14; + font height = 19; + font string = ""27"!$"27"5"27"S"1""; + + ""127"", 0; + + FONT : "5"; + indentation pitch = 24; + font height = 36; + next smaller font = "5.klein"; + font string = ""27"! "27"5"27"T"; + + ""127"", 0; + + FONT : "5.klein"; + indentation pitch = 24; + font height = 19; + font string = ""27"! "27"5"27"S"1""; + + ""127"", 0; + + FONT : "5b"; + indentation pitch = 24; + font height = 36; + next smaller font = "5b.klein"; + font string = ""27"!("27"5"27"T"; + + ""127"", 0; + + FONT : "5b.klein"; + indentation pitch = 24; + font height = 19; + font string = ""27"!("27"5"27"S"1""; + + ""127"", 0; + + FONT : "10-2"; + indentation pitch = 12; + font height = 36; + next smaller font = "10-2.klein"; + font string = ""27"!%"27"5"27"T"; + + ""127"", 0; + + FONT : "10-2.klein"; + indentation pitch = 12; + font height = 19; + font string = ""27"!%"27"5"27"S"1""; + + ""127"", 0; + + FONT : "6"; + indentation pitch = 20; + font height = 36; + next smaller font = "6.klein"; + font string = ""27"!!"27"5"27"T"; + + ""127"", 0; + + FONT : "6.klein"; + indentation pitch = 20; + font height = 19; + font string = ""27"!!"27"5"27"S"1""; + + ""127"", 0; + + FONT : "prop10"; + indentation pitch = 12; + font height = 36; + next smaller font = "prop10.klein"; + font string = ""27"!"0""27"5"27"T"27"p1"; + + (* ! *) ""033"", 5; (* " *) ""034"", 8; + (* ' *) ""039"", 5; (* ( *) ""040"", 6; + (* ) *) ""041"", 6; (* , *) ""044"", 7; + (* . *) ""046"", 6; (* / *) ""047"", 10; + (* 1 *) ""049"", 8; (* : *) ""058"", 6; + (* ; *) ""059"", 6; (* < *) ""060"", 10; + (* > *) ""062"", 10; (* I *) ""073"", 8; + (* J *) ""074"", 11; (* X *) ""088"", 10; + (* Z *) ""090"", 10; (* [ *) ""091"", 8; + (* \ *) ""092"", 10; (* ] *) ""093"", 8; + (* ` *) ""096"", 5; (* b *) ""098"", 11; + (* c *) ""099"", 11; (* d *) ""100"", 11; + (* f *) ""102"", 10; (* g *) ""103"", 11; + (* h *) ""104"", 11; (* i *) ""105"", 8; + (* j *) ""106"", 9; (* k *) ""107"", 10; + (* l *) ""108"", 8; (* n *) ""110"", 11; + (* p *) ""112"", 11; (* q *) ""113"", 11; + (* r *) ""114"", 11; (* t *) ""116"", 11; + (* x *) ""120"", 10; (* z *) ""122"", 10; + ""123"", 9; (* | *) ""124"", 5; + ""125"", 9; ""127"", 0; + ""186"", 6; ""198"", 10; + ""200"", 11; ""202"", 11; + ""205"", 8; ""212"", 11; + (* *) ""218"", 10; (* *) ""219"", 11; + (* k *) ""220"", 10; (* *) ""251"", 11; + ""252"", 10; + + FONT : "prop10.klein"; + indentation pitch = 12; + font height = 19; + next smaller font = "prop10"; + font string = ""27"!"0""27"5"27"S1"27"p1"; + + (* ! *) ""033"", 5; (* " *) ""034"", 8; + (* ' *) ""039"", 5; (* ( *) ""040"", 6; + (* ) *) ""041"", 6; (* , *) ""044"", 7; + (* . *) ""046"", 6; (* / *) ""047"", 10; + (* 1 *) ""049"", 8; (* : *) ""058"", 6; + (* ; *) ""059"", 6; (* < *) ""060"", 10; + (* > *) ""062"", 10; (* I *) ""073"", 8; + (* J *) ""074"", 11; (* X *) ""088"", 10; + (* Z *) ""090"", 10; (* [ *) ""091"", 8; + (* \ *) ""092"", 10; (* ] *) ""093"", 8; + (* ` *) ""096"", 5; (* b *) ""098"", 11; + (* c *) ""099"", 11; (* d *) ""100"", 11; + (* f *) ""102"", 10; (* g *) ""103"", 11; + (* h *) ""104"", 11; (* i *) ""105"", 8; + (* j *) ""106"", 9; (* k *) ""107"", 10; + (* l *) ""108"", 8; (* n *) ""110"", 11; + (* p *) ""112"", 11; (* q *) ""113"", 11; + (* r *) ""114"", 11; (* t *) ""116"", 11; + (* x *) ""120"", 10; (* z *) ""122"", 10; + ""123"", 9; (* | *) ""124"", 5; + ""125"", 9; ""127"", 0; + ""186"", 6; ""198"", 10; + ""200"", 11; ""202"", 11; + ""205"", 8; ""212"", 11; + (* *) ""218"", 10; (* *) ""219"", 11; + (* k *) ""220"", 10; (* *) ""251"", 11; + ""252"", 10; + + FONT : "prop10i"; + indentation pitch = 12; + font height = 36; + next smaller font = "prop10i.klein"; + font string = ""27"!"0""27"4"27"T"27"p1"; + + (* ! *) ""033"", 10; (* " *) ""034"", 10; + (* $ *) ""036"", 11; (* ' *) ""039"", 5; + (* ( *) ""040"", 8; (* ) *) ""041"", 8; + (* , *) ""044"", 8; (* . *) ""046"", 7; + (* / *) ""047"", 10; (* 1 *) ""049"", 9; + (* 6 *) ""054"", 11; (* 9 *) ""057"", 11; + (* : *) ""058"", 8; (* ; *) ""059"", 9; + (* < *) ""060"", 10; (* = *) ""061"", 11; + (* > *) ""062"", 9; (* ? *) ""063"", 11; + (* I *) ""073"", 10; (* L *) ""076"", 10; + (* V *) ""086"", 11; (* [ *) ""091"", 11; + (* \ *) ""092"", 7; (* ] *) ""093"", 11; + (* ^ *) ""094"", 10; (* ` *) ""096"", 5; + (* a *) ""097"", 11; (* b *) ""098"", 11; + (* c *) ""099"", 11; (* e *) ""101"", 11; + (* g *) ""103"", 11; (* h *) ""104"", 11; + (* i *) ""105"", 9; (* j *) ""106"", 10; + (* k *) ""107"", 11; (* l *) ""108"", 9; + (* m *) ""109"", 11; (* n *) ""110"", 10; + (* o *) ""111"", 11; (* p *) ""112"", 11; + (* q *) ""113"", 11; (* r *) ""114"", 10; + (* s *) ""115"", 11; (* t *) ""116"", 10; + (* u *) ""117"", 11; (* v *) ""118"", 10; + (* y *) ""121"", 11; ""123"", 10; + (* | *) ""124"", 9; ""125"", 10; + ""127"", 0; ""186"", 8; + ""190"", 11; ""193"", 11; + ""194"", 11; ""198"", 11; + ""200"", 11; ""202"", 11; + ""205"", 8; ""210"", 11; + (* *) ""217"", 11; (* *) ""218"", 11; + (* k *) ""220"", 11; (* *) ""251"", 11; + + FONT : "prop10i.klein"; + indentation pitch = 12; + font height = 19; + font string = ""27"!"0""27"4"27"S1"27"p1"; + + (* ! *) ""033"", 10; (* " *) ""034"", 10; + (* $ *) ""036"", 11; (* ' *) ""039"", 5; + (* ( *) ""040"", 8; (* ) *) ""041"", 8; + (* , *) ""044"", 8; (* . *) ""046"", 7; + (* / *) ""047"", 10; (* 1 *) ""049"", 9; + (* 6 *) ""054"", 11; (* 9 *) ""057"", 11; + (* : *) ""058"", 8; (* ; *) ""059"", 9; + (* < *) ""060"", 10; (* = *) ""061"", 11; + (* > *) ""062"", 9; (* ? *) ""063"", 11; + (* I *) ""073"", 10; (* L *) ""076"", 10; + (* V *) ""086"", 11; (* [ *) ""091"", 11; + (* \ *) ""092"", 7; (* ] *) ""093"", 11; + (* ^ *) ""094"", 10; (* ` *) ""096"", 5; + (* a *) ""097"", 11; (* b *) ""098"", 11; + (* c *) ""099"", 11; (* e *) ""101"", 11; + (* g *) ""103"", 11; (* h *) ""104"", 11; + (* i *) ""105"", 9; (* j *) ""106"", 10; + (* k *) ""107"", 11; (* l *) ""108"", 9; + (* m *) ""109"", 11; (* n *) ""110"", 10; + (* o *) ""111"", 11; (* p *) ""112"", 11; + (* q *) ""113"", 11; (* r *) ""114"", 10; + (* s *) ""115"", 11; (* t *) ""116"", 10; + (* u *) ""117"", 11; (* v *) ""118"", 10; + (* y *) ""121"", 11; ""123"", 10; + (* | *) ""124"", 9; ""125"", 10; + ""127"", 0; ""186"", 8; + ""190"", 11; ""193"", 11; + ""194"", 11; ""198"", 11; + ""200"", 11; ""202"", 11; + ""205"", 8; ""210"", 11; + (* *) ""217"", 11; (* *) ""218"", 11; + (* k *) ""220"", 11; (* *) ""251"", 11; + + FONT : "prop5"; + indentation pitch = 24; + font height = 36; + next smaller font = "prop5.klein"; + font string = ""27"! "27"5"27"T"27"p1"; + + (* ! *) ""033"", 10; (* " *) ""034"", 16; + (* ' *) ""039"", 10; (* ( *) ""040"", 12; + (* ) *) ""041"", 12; (* , *) ""044"", 14; + (* . *) ""046"", 12; (* / *) ""047"", 20; + (* 1 *) ""049"", 16; (* : *) ""058"", 12; + (* ; *) ""059"", 12; (* < *) ""060"", 20; + (* > *) ""062"", 20; (* I *) ""073"", 16; + (* J *) ""074"", 22; (* X *) ""088"", 20; + (* Z *) ""090"", 20; (* [ *) ""091"", 16; + (* \ *) ""092"", 20; (* ] *) ""093"", 16; + (* ` *) ""096"", 10; (* b *) ""098"", 22; + (* c *) ""099"", 22; (* d *) ""100"", 22; + (* f *) ""102"", 20; (* g *) ""103"", 22; + (* h *) ""104"", 22; (* i *) ""105"", 16; + (* j *) ""106"", 18; (* k *) ""107"", 20; + (* l *) ""108"", 16; (* n *) ""110"", 22; + (* p *) ""112"", 22; (* q *) ""113"", 22; + (* r *) ""114"", 22; (* t *) ""116"", 22; + (* x *) ""120"", 20; (* z *) ""122"", 20; + ""123"", 18; (* | *) ""124"", 10; + ""125"", 18; ""127"", 0; + ""186"", 12; ""198"", 20; + ""200"", 22; ""202"", 22; + ""205"", 16; ""212"", 22; + (* *) ""218"", 20; (* *) ""219"", 22; + (* k *) ""220"", 20; (* *) ""251"", 22; + ""252"", 20; + + FONT : "prop5.klein"; + indentation pitch = 24; + font height = 19; + font string = ""27"! "27"5"27"S1"27"p1"; + + (* ! *) ""033"", 10; (* " *) ""034"", 16; + (* ' *) ""039"", 10; (* ( *) ""040"", 12; + (* ) *) ""041"", 12; (* , *) ""044"", 14; + (* . *) ""046"", 12; (* / *) ""047"", 20; + (* 1 *) ""049"", 16; (* : *) ""058"", 12; + (* ; *) ""059"", 12; (* < *) ""060"", 20; + (* > *) ""062"", 20; (* I *) ""073"", 16; + (* J *) ""074"", 22; (* X *) ""088"", 20; + (* Z *) ""090"", 20; (* [ *) ""091"", 16; + (* \ *) ""092"", 20; (* ] *) ""093"", 16; + (* ` *) ""096"", 10; (* b *) ""098"", 22; + (* c *) ""099"", 22; (* d *) ""100"", 22; + (* f *) ""102"", 20; (* g *) ""103"", 22; + (* h *) ""104"", 22; (* i *) ""105"", 16; + (* j *) ""106"", 18; (* k *) ""107"", 20; + (* l *) ""108"", 16; (* n *) ""110"", 22; + (* p *) ""112"", 22; (* q *) ""113"", 22; + (* r *) ""114"", 22; (* t *) ""116"", 22; + (* x *) ""120"", 20; (* z *) ""122"", 20; + ""123"", 18; (* | *) ""124"", 10; + ""125"", 18; ""127"", 0; + ""186"", 12; ""198"", 20; + ""200"", 22; ""202"", 22; + ""205"", 16; ""212"", 22; + (* *) ""218"", 20; (* *) ""219"", 22; + (* k *) ""220"", 20; (* *) ""251"", 22; + ""252"", 20; + + FONT : "prop5i"; + indentation pitch = 24; + font height = 36; + next smaller font = "prop5i.klein"; + font string = ""27"! "27"4"27"T"27"p1"; + + (* ! *) ""033"", 20; (* " *) ""034"", 20; + (* $ *) ""036"", 22; (* ' *) ""039"", 10; + (* ( *) ""040"", 16; (* ) *) ""041"", 16; + (* , *) ""044"", 16; (* . *) ""046"", 14; + (* / *) ""047"", 20; (* 1 *) ""049"", 18; + (* 6 *) ""054"", 22; (* 9 *) ""057"", 22; + (* : *) ""058"", 16; (* ; *) ""059"", 18; + (* < *) ""060"", 20; (* = *) ""061"", 22; + (* > *) ""062"", 18; (* ? *) ""063"", 22; + (* I *) ""073"", 20; (* L *) ""076"", 20; + (* V *) ""086"", 22; (* [ *) ""091"", 22; + (* \ *) ""092"", 14; (* ] *) ""093"", 22; + (* ^ *) ""094"", 20; (* ` *) ""096"", 10; + (* a *) ""097"", 22; (* b *) ""098"", 22; + (* c *) ""099"", 22; (* e *) ""101"", 22; + (* g *) ""103"", 22; (* h *) ""104"", 22; + (* i *) ""105"", 18; (* j *) ""106"", 20; + (* k *) ""107"", 22; (* l *) ""108"", 18; + (* m *) ""109"", 22; (* n *) ""110"", 20; + (* o *) ""111"", 22; (* p *) ""112"", 22; + (* q *) ""113"", 22; (* r *) ""114"", 20; + (* s *) ""115"", 22; (* t *) ""116"", 20; + (* u *) ""117"", 22; (* v *) ""118"", 20; + (* y *) ""121"", 22; ""123"", 20; + (* | *) ""124"", 18; ""125"", 20; + ""127"", 0; ""186"", 16; + ""190"", 22; ""193"", 22; + ""194"", 22; ""198"", 22; + ""200"", 22; ""202"", 22; + ""205"", 16; ""210"", 22; + (* *) ""217"", 22; (* *) ""218"", 22; + (* k *) ""220"", 22; (* *) ""251"", 22; + + FONT : "prop5i.klein"; + indentation pitch = 24; + font height = 19; + font string = ""27"! "27"4"27"S1"27"p1"; + + (* ! *) ""033"", 20; (* " *) ""034"", 20; + (* $ *) ""036"", 22; (* ' *) ""039"", 10; + (* ( *) ""040"", 16; (* ) *) ""041"", 16; + (* , *) ""044"", 16; (* . *) ""046"", 14; + (* / *) ""047"", 20; (* 1 *) ""049"", 18; + (* 6 *) ""054"", 22; (* 9 *) ""057"", 22; + (* : *) ""058"", 16; (* ; *) ""059"", 18; + (* < *) ""060"", 20; (* = *) ""061"", 22; + (* > *) ""062"", 18; (* ? *) ""063"", 22; + (* I *) ""073"", 20; (* L *) ""076"", 20; + (* V *) ""086"", 22; (* [ *) ""091"", 22; + (* \ *) ""092"", 14; (* ] *) ""093"", 22; + (* ^ *) ""094"", 20; (* ` *) ""096"", 10; + (* a *) ""097"", 22; (* b *) ""098"", 22; + (* c *) ""099"", 22; (* e *) ""101"", 22; + (* g *) ""103"", 22; (* h *) ""104"", 22; + (* i *) ""105"", 18; (* j *) ""106"", 20; + (* k *) ""107"", 22; (* l *) ""108"", 18; + (* m *) ""109"", 22; (* n *) ""110"", 20; + (* o *) ""111"", 22; (* p *) ""112"", 22; + (* q *) ""113"", 22; (* r *) ""114"", 20; + (* s *) ""115"", 22; (* t *) ""116"", 20; + (* u *) ""117"", 22; (* v *) ""118"", 20; + (* y *) ""121"", 22; ""123"", 20; + (* | *) ""124"", 18; ""125"", 20; + ""127"", 0; ""186"", 16; + ""190"", 22; ""193"", 22; + ""194"", 22; ""198"", 22; + ""200"", 22; ""202"", 22; + ""205"", 16; ""210"", 22; + (* *) ""217"", 22; (* *) ""218"", 22; + (* k *) ""220"", 22; (* *) ""251"", 22; diff --git a/system/printer-9nadel/1986/src/EPSONRX.ELA b/system/printer-9nadel/1986/src/EPSONRX.ELA new file mode 100644 index 0000000..118cee8 --- /dev/null +++ b/system/printer-9nadel/1986/src/EPSONRX.ELA @@ -0,0 +1,171 @@ + FONTTABLE : "fonttab.epson.rx"; + x unit = 47.24409; + y unit = 85.03937; + on string = ""27"-1", ""27"G", ""27"4", ""; + off string = ""27"-0", ""27"H", ""27"5", ""; + + ""127"", ""; +(*Herz*) ""153"", ""146""; +(*Karo*) ""154"", ""147""; +(*Baum*) ""155"", ""148""; +(*Pik *) ""156"", ""145""; +(*Note*) ""157"", ""149""; +(*Telefon*)""158"", ""150""; +(*Flugzg.*)""159"", ""151""; +(*Auto*) ""160"", ""152""; +(*Glas*) ""161"", ""153""; +(*Mann*) ""162"", ""154""; +(*i`*) ""186"", ""27"R"6"~"27"R"0""; +(*a`*) ""190"", ""27"R"6"{"27"R"0""; +(*e'*) ""193"", ""27"R"6"]"27"R"0""; +(*e`*) ""194"", ""27"R"6"}"27"R"0""; +(*o`*) ""198"", ""27"R"6"|"27"R"0""; +(*c,*) ""200"", ""27"R"1"\"27"R"0""; +(*u`*) ""202"", ""27"R"6"`"27"R"0""; +(*grad*) ""205"", ""27"R"1"["27"R"0""; +(*A-grad*) ""206"", ""27"R"4"]"27"R"0""; +(*AE*) ""207"", ""27"R"4"["27"R"0""; +(*E'*) ""208"", ""27"R"5"@"27"R"0""; +(*N~*) ""209"", ""27"R"7"\"27"R"0""; +(*a-punkt*)""210"", ""27"R"4"}"27"R"0""; +(*ae*) ""211"", ""27"R"4"{"27"R"0""; +(*n~*) ""212"", ""27"R"7"|"27"R"0""; +(*pound*) ""213"", ""27"R"3"#"27"R"0""; + (* *) ""214"", ""27"R"2"["27"R"0""; + (* *) ""215"", ""27"R"2"\"27"R"0""; + (* *) ""216"", ""27"R"2"]"27"R"0""; + (* *) ""217"", ""27"R"2"{"27"R"0""; + (* *) ""218"", ""27"R"2"|"27"R"0""; + (* *) ""219"", ""27"R"2"}"27"R"0""; + (* k *) ""220"", "k"; + (* - *) ""221"", "-"; + (* # *) ""222"", "#"; + (* *) ""223"", " "; +(* +/- *) ""224"", ""159""; +(*uparrow*)""236"", ""155""; +(*downarr*)""238"", ""156""; +(*x-kreuz*)""245"", ""157""; +(*geteilt*)""246"", ""158""; + (* *) ""251"", ""27"R"2"~"27"R"0""; +(*paragr.*)""252"", ""27"R"2"@"27"R"0""; + + + FONT : "17", "micron"; + indentation pitch = 7; + font height = 36; + next smaller font = "17.klein"; + font string = ""27"P"15""27"W"0""27"F"27"T"; + + ""127"", 0; + + FONT : "17.klein", "micron.klein", "elanlist"; + indentation pitch = 7; + font height = 19; + font string = ""27"P"15""27"W"0""27"F"27"S"1""; + + ""127"", 0; + + FONT : "8"; + indentation pitch = 14; + font height = 36; + next smaller font = "8.klein"; + font string = ""27"P"15""27"W"1""27"F"27"T"; + + ""127"", 0; + + FONT : "8.klein"; + indentation pitch = 14; + font height = 19; + font string = ""27"P"15""27"W"1""27"F"27"S"1""; + + ""127"", 0; + + FONT : "10", "pica"; + indentation pitch = 12; + font height = 36; + next smaller font = "10.klein"; + font string = ""27"P"18""27"W"0""27"F"27"T"; + + ""127"", 0; + + FONT : "10.klein", "pica.klein"; + indentation pitch = 12; + font height = 19; + font string = ""27"P"18""27"W"0""27"F"27"S"1""; + + ""127"", 0; + + FONT : "10b"; + indentation pitch = 12; + font height = 36; + next smaller font = "10b.klein"; + font string = ""27"P"18""27"W"0""27"E"27"T"; + + ""127"", 0; + + FONT : "10b.klein"; + indentation pitch = 12; + font height = 19; + font string = ""27"P"18""27"W"0""27"E"27"S"1""; + + ""127"", 0; + + FONT : "12", "elite"; + indentation pitch = 10; + font height = 36; + next smaller font = "12.klein"; + font string = ""18""27"M"27"W"0""27"F"27"T"; + + ""127"", 0; + + FONT : "12.klein", "elite.klein"; + indentation pitch = 10; + font height = 19; + font string = ""18""27"M"27"W"0""27"F"27"S"1""; + + ""127"", 0; + + FONT : "5"; + indentation pitch = 24; + font height = 36; + next smaller font = "5.klein"; + font string = ""27"P"18""27"W"1""27"F"27"T"; + + ""127"", 0; + + FONT : "5.klein"; + indentation pitch = 24; + font height = 19; + font string = ""27"P"18""27"W"1""27"F"27"S"1""; + + ""127"", 0; + + FONT : "5b"; + indentation pitch = 24; + font height = 36; + next smaller font = "5b.klein"; + font string = ""27"P"18""27"W"1""27"E"27"T"; + + ""127"", 0; + + FONT : "5b.klein"; + indentation pitch = 24; + font height = 19; + font string = ""27"P"18""27"W"1""27"E"27"S"1""; + + ""127"", 0; + + FONT : "6"; + indentation pitch = 20; + font height = 36; + next smaller font = "6.klein"; + font string = ""18""27"M"27"W"1""27"F"27"T"; + + ""127"", 0; + + FONT : "6.klein"; + indentation pitch = 20; + font height = 19; + font string = ""18""27"M"27"W"1""27"F"27"S"1""; + + ""127"", 0; diff --git a/system/printer-9nadel/1986/src/FONTTAB.10A b/system/printer-9nadel/1986/src/FONTTAB.10A new file mode 100644 index 0000000..8a8cd59 Binary files /dev/null and b/system/printer-9nadel/1986/src/FONTTAB.10A differ diff --git a/system/printer-9nadel/1986/src/FONTTAB.12A b/system/printer-9nadel/1986/src/FONTTAB.12A new file mode 100644 index 0000000..ed08d88 Binary files /dev/null and b/system/printer-9nadel/1986/src/FONTTAB.12A differ diff --git a/system/printer-9nadel/1986/src/FONTTAB.S10 b/system/printer-9nadel/1986/src/FONTTAB.S10 new file mode 100644 index 0000000..90769b0 Binary files /dev/null and b/system/printer-9nadel/1986/src/FONTTAB.S10 differ diff --git a/system/printer-9nadel/1986/src/FONTTAB.S12 b/system/printer-9nadel/1986/src/FONTTAB.S12 new file mode 100644 index 0000000..e367bcc Binary files /dev/null and b/system/printer-9nadel/1986/src/FONTTAB.S12 differ diff --git a/system/printer-9nadel/1986/src/beschreibungen9 b/system/printer-9nadel/1986/src/beschreibungen9 new file mode 100644 index 0000000..692842e --- /dev/null +++ b/system/printer-9nadel/1986/src/beschreibungen9 @@ -0,0 +1,96 @@ + +(*************************************************************************) +(* Stand : 01.10.88 *) +(* Beschreibungen-Datei fr 9-Nadel-Drucker Version : 0.9 *) +(* Autoren : mov/hjh *) +(*************************************************************************) + +$fx85$ +head;hfx85;decl;speed;openh;opendoch;initspeed;opendocfx85;openpge;betwoc; +clpge;betwce;cmd;crs;moh;mofx85;ymodr;onoff;tyfx85;end + +$fx800$ +head;hfx800;decl;quality;typeface;openh;opendoch;opendocfx800;openpge;betwoc; +clpge;betwce;cmdfx800;crs;moh;mofx800;ymodr;onoff;tyfx800;end + +$mx$ +head;hmx;decl;speed;openh;opendoch;initspeed;opendocmx;openpge;betwoc;clpge; +betwce;cmd;crs;moh;modrmx;onoff;tymx;end + +$lx800$ +head;hlx800;decl;speed;quality;typeface;openh;opendoch;initspeed; +opendocfx800;openpge;betwoc;clpge;betwce;cmdfx800;crs;moh;mofx85;ymodr;onoff; +tyfx800;end + +$ibmgp$ +head;hgp;decl;speed;openh;opendoch;initspeed;opendocgp;openpge;betwoc; +clpge;betwce;cmd;crs;moh;mogp;ymodr;onoff;tyfx85;end + +$ibmpp$ +head;hpp;decl;speed;quality;openh;opendoch;initspeed;opendocpp;openpge; +betwoc;clpge;betwce;cmdpp;crs;moh;mofx85;ymodr;onoffpp;tyfx85;end + +$okiml182i$ +head;hml182i;decl;speed;quality;openh;opendoch;initspeed;opendocml182i; +opendocgp;openpge;betwoc;clpge;betwce;cmdml182i;crs;moh;mogp;ymodr;onoff; +tyohnesmall;end + +$okiml192el$ +head;hml192el;decl;speed;feed;openh;opendoch;initspeed;opendocml192el; +openpgemlsf;betwoc;clmlsf;betwce;cmd;crs;moh;moml192el;ymodr;onoff;tyml192el; +end + +$okiml292el$ +head;hml292el;decl;quality;typeface292;feed;openh;opendoch;opendocml292el; +openpgemlsf;betwoc;clmlsf;betwce;cmdml292el;crs;moh;mofx800;ymodr;onoff; +tyml292el;end + +$okiml294i$ +head;hml294i;decl;speed;quality;feed;openh;opendoch;initspeed;opendocml294i; +openpgemlsf;betwoc;clmlsf;betwce;cmdml294i;crs;moh;mofx85;ymodr;ontyml294i;end + +$okiml320$ +head;hml320;decl;speed;openh;opendoch;initspeed;opendocml320; +openpge;betwoc;clpge;betwce;cmd;crs;moh;moml192el;ymodr;onoff;tyml192el; +end + +$starlc10$ +head;hlc10;decl;quality;typefacelc10;openh;opendoch;opendoclc10;openpge; +betwoc;clpge;betwce;cmdlc10;crs;moh;mofx800;ymodr;onoff;tyfx800;end + +$dmp4000$ +head;hdmp4000;decl;speed;openh;opendoch;initspeed;opendocdmp4000;openpge; +betwoc;clpge;betwce;cmd;crs;moh;mofx85;ymodr;onoff;tyfx85;end + +$starnx15$ +head;hnx15;decl;speed;openh;opendoch;initspeed;opendocnx15;openpge;betwoc; +clpge;betwce;cmd;crs;moh;mofx85;ymodr;onoff;tyfx85;end + +$mt230$ +head;hmt230;decl;speed;feedschacht;openh;opendoch;initspeed;opendocmt; +openpgemtsf;betwoc;clmtsf;betwce;cmdmt230;crs;moh;mofx85;ymodr;onoff; +tyfx85;end + +$mt340$ +head;hmt340;decl;speed;feedschacht;openh;opendoch;initspeed;opendocmt; +openpgemtsf;betwoc;clmtsf;betwce;cmdmt230;crs;moh;moml192el;ymodr;onoff; +tyml192el;end + +$citi120d$ +head;h120d;decl;openh;opendoch;opendoc120d;openpge;betwoc; +clpge;betwce;cmd;crs;moh;mofx800;ymodr;onoff;tyfx85;end + +$citohc310cxp$ +head;hc310;decl;speed;feedschacht;openh;opendoch;initspeed;opendocc310; +openpgec310sf;betwoc;clc310sf;betwce;cmdc310;crs;moh;mofx85;ymodr;onoff; +tyfx85;end + +$citohci3500$ +head;hci3500;decl;speed;openh;opendoch;initspeed;opendocgp;openpge;betwoc; +clpge;betwce;cmd;crs;moh;mogp;ymodr;onoff;tyfx85;end + +$fujdx2100$ +head;hdx2100;decl;speed;feed;openh;opendoch;initspeed;opendocdx2100; +openpge;betwoc;clpge;betwce;cmddx2100;crs;moh;moml192el;ymodr;onoff;tyml192el; +end + diff --git a/system/printer-9nadel/1986/src/fonttab.1 b/system/printer-9nadel/1986/src/fonttab.1 new file mode 100644 index 0000000..c008441 Binary files /dev/null and b/system/printer-9nadel/1986/src/fonttab.1 differ diff --git a/system/printer-9nadel/1986/src/fonttab.10 b/system/printer-9nadel/1986/src/fonttab.10 new file mode 100644 index 0000000..cf79bc7 Binary files /dev/null and b/system/printer-9nadel/1986/src/fonttab.10 differ diff --git a/system/printer-9nadel/1986/src/fonttab.20 b/system/printer-9nadel/1986/src/fonttab.20 new file mode 100644 index 0000000..774029f Binary files /dev/null and b/system/printer-9nadel/1986/src/fonttab.20 differ diff --git a/system/printer-9nadel/1986/src/fonttab.20.lc b/system/printer-9nadel/1986/src/fonttab.20.lc new file mode 100644 index 0000000..030f9fa Binary files /dev/null and b/system/printer-9nadel/1986/src/fonttab.20.lc differ diff --git a/system/printer-9nadel/1986/src/fonttab.20.lx b/system/printer-9nadel/1986/src/fonttab.20.lx new file mode 100644 index 0000000..423cda1 Binary files /dev/null and b/system/printer-9nadel/1986/src/fonttab.20.lx differ diff --git a/system/printer-9nadel/1986/src/fonttab.7 b/system/printer-9nadel/1986/src/fonttab.7 new file mode 100644 index 0000000..c18f223 Binary files /dev/null and b/system/printer-9nadel/1986/src/fonttab.7 differ diff --git a/system/printer-9nadel/1986/src/fonttab.7.cxp b/system/printer-9nadel/1986/src/fonttab.7.cxp new file mode 100644 index 0000000..a2b833a Binary files /dev/null and b/system/printer-9nadel/1986/src/fonttab.7.cxp differ diff --git a/system/printer-9nadel/1986/src/fonttab.7.fuj b/system/printer-9nadel/1986/src/fonttab.7.fuj new file mode 100644 index 0000000..1244175 Binary files /dev/null and b/system/printer-9nadel/1986/src/fonttab.7.fuj differ diff --git a/system/printer-9nadel/1986/src/fonttab.7.mt b/system/printer-9nadel/1986/src/fonttab.7.mt new file mode 100644 index 0000000..a7eea47 Binary files /dev/null and b/system/printer-9nadel/1986/src/fonttab.7.mt differ diff --git a/system/printer-9nadel/1986/src/fonttab.epson.fx b/system/printer-9nadel/1986/src/fonttab.epson.fx new file mode 100644 index 0000000..ad68a4d Binary files /dev/null and b/system/printer-9nadel/1986/src/fonttab.epson.fx differ diff --git a/system/printer-9nadel/1986/src/fonttab.epson.lq b/system/printer-9nadel/1986/src/fonttab.epson.lq new file mode 100644 index 0000000..3e7dc5d Binary files /dev/null and b/system/printer-9nadel/1986/src/fonttab.epson.lq differ diff --git a/system/printer-9nadel/1986/src/fonttab.epson.mx b/system/printer-9nadel/1986/src/fonttab.epson.mx new file mode 100644 index 0000000..b813fe9 Binary files /dev/null and b/system/printer-9nadel/1986/src/fonttab.epson.mx differ diff --git a/system/printer-9nadel/1986/src/fonttab.epson.rx b/system/printer-9nadel/1986/src/fonttab.epson.rx new file mode 100644 index 0000000..7042102 Binary files /dev/null and b/system/printer-9nadel/1986/src/fonttab.epson.rx differ diff --git a/system/printer-9nadel/1986/src/module9 b/system/printer-9nadel/1986/src/module9 new file mode 100644 index 0000000..e25cea6 --- /dev/null +++ b/system/printer-9nadel/1986/src/module9 @@ -0,0 +1,1098 @@ + +(*************************************************************************) +(* Stand : 01.10.88 *) +(* Module-Datei fr 9-Nadel-Drucker Version : 0.9 *) +(* Autoren : mov/hjh *) +(*************************************************************************) + +$head$ +PACKET printer driver + + DEFINES printer, + open, + close, + execute, + paper size, + top margin, + +$hfx85$ std speed: +(* Treiber fr EPSON FX85/105, automatisch generiert *) + +$hfx800$ std quality, + std typeface: +(* Treiber fr EPSON FX800/1000, automatisch generiert *) +BOOL VAR was tall font; + +$hmx$ std speed: +(* Treiber fr EPSON MX80/100, Typ III *) +(* Treiber automatisch generiert *) +BOOL VAR is condensed, is small; + +$hlx800$ std speed, + std quality, + std typeface: +(* Treiber fr EPSON LX800/1000, automatisch generiert *) +BOOL VAR was tall font; + +$hgp$ std speed: +(* Treiber fr IBM-Grafikdrucker *) +(* Treiber automatisch generiert *) + +$hpp$ std speed, + std quality: +(* Treiber fr IBM-Proprinter *) +(* Treiber automatisch generiert *) + +$hml182i$ std speed, + std quality: +(* Treiber fr OKI ML182/183 IBM-kompatibel *) +(* Treiber automatisch generiert *) + +$hml192el$ paper feed, + std speed: +(* Treiber fr OKI ML192/193 Elite *) +(* Treiber automatisch generiert *) +BOOL VAR prop font; + +$hml292el$ std quality, + std typeface, + paper feed: +(* Treiber fr OKI ML292/293 Elite *) +(* Treiber automatisch generiert *) +BOOL VAR was tall font; + +$hml294i$ std speed, + paper feed, + std quality: +(* Treiber fr OKI ML294 IBM-kompatibel *) +(* Treiber automatisch generiert *) + +$hml320$ std speed: +(* Treiber fr OKI ML320 IBM/EPSON-kompatibel *) +(* Treiber automatisch generiert *) +BOOL VAR prop font; + +$hlc10$ std quality, + std typeface: +(* Treiber fr Star LC-10 oder LC-10 Colour *) +(* Treiber automatisch generiert *) +BOOL VAR was tall font; + +$hdmp4000$ std speed: +(* Treiber fr Schneider DMP4000, automatisch generiert *) + +$hnx15$ std speed: +(* Treiber fr Star NX-15, ND-10, ND-15, NR-10 und NR-15 *) +(* Treiber automatisch generiert *) + +$hmt230$ paper feed, + std speed: +(* Treiber fr Mannesmann-Tally MT 230 *) +(* Treiber automatisch generiert *) + +$hmt340$ paper feed, + std speed: +(* Treiber fr Mannesmann-Tally MT 340 *) +(* Treiber automatisch generiert *) +BOOL VAR prop font := FALSE; + +$h120d$ : +(* Treiber fr Citizen 120-D *) +(* Treiber automatisch generiert *) + +$hc310$ paper feed, + std speed: +(* Treiber fr C. Itoh C 310/315 CXP *) +(* Treiber automatisch generiert *) + +$hci3500$ std speed: +(* Treiber fr C. Itoh CI-3500 *) +(* Treiber automatisch generiert *) + +$hdx2100$ paper feed, + std speed: +(* Treiber fr Fujitsu DX 2100 *) +(* Treiber automatisch generiert *) +BOOL VAR prop font := FALSE ; + +$decl$ +INT VAR blankbreite, x rest, y rest, high, low, small, modifikations; +REAL VAR x size, y size, y margin; +TEXT VAR buffer :: ""; + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; +END PROC paper size; + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); +END PROC paper size; + +papersize (20.32, 30.48); + +PROC top margin (REAL CONST margin): + + y margin := margin +END PROC top margin; + +REAL PROC top margin: y margin END PROC top margin; + +top margin (0.0); + +$speed$ +BOOL VAR is slow; +TEXT VAR std speed name :: "slow"; + +PROC std speed (TEXT CONST speed) : + + IF speed = "fast" OR speed = "slow" + THEN std speed name := speed + ELSE errorstop ("unzulssige Geschwindigkeit") + FI +END PROC std speed; + +TEXT PROC std speed : std speed name END PROC std speed; + +$quality$ +TEXT VAR std quality name :: "draft"; + +PROC std quality (TEXT CONST quality) : + + IF quality = "nlq" OR quality = "draft" + THEN std quality name := quality + ELSE errorstop ("unzulssige Qualittsbezeichnung") + FI +END PROC std quality; + +TEXT PROC std quality : std quality name END PROC std quality; + +$typeface$ +TEXT VAR std typeface name :: ""; + +PROC std typeface (TEXT CONST typeface) : + + IF typeface = "" OR typeface = "roman" OR typeface = "sansserif" + THEN std typeface name := typeface + ELSE errorstop ("unzulssige Schriftart") + FI +END PROC std typeface; + +TEXT PROC std typeface : std typeface name END PROC std typeface; + +$typeface292$ +TEXT VAR std typeface name :: ""; + +PROC std typeface (TEXT CONST typeface) : + + IF typeface = "" OR typeface = "courier" OR typeface = "sansserif" + THEN std typeface name := typeface + ELSE errorstop ("unzulssige Schriftart") + FI +END PROC std typeface; + +TEXT PROC std typeface : std typeface name END PROC std typeface; + +$typefacelc10$ +TEXT VAR std typeface name :: ""; + +PROC std typeface (TEXT CONST typeface) : + + IF typeface = "" OR typeface = "courier" OR typeface = "sansserif" + OR typeface = "orator1" OR typeface = "orator2" + THEN std typeface name := typeface + ELSE errorstop ("unzulssige Schriftart") + FI +END PROC std typeface; + +TEXT PROC std typeface : std typeface name END PROC std typeface; + +$feed$ +TEXT VAR feeder name :: "tractor"; + +PROC paper feed (TEXT CONST feeder) : + + IF feeder = "sheet" OR feeder = "tractor" + THEN feeder name := feeder + ELSE errorstop ("unzulssige Einzugsart") + FI +END PROC paper feed; + +TEXT PROC paper feed: feeder name END PROC paper feed; + +$feedschacht$ +TEXT VAR act feeder :: "", + feeder name :: "tractor"; + +PROC paper feed (TEXT CONST feeder) : + + IF feeder = "tractor" OR feeder = "schacht1" OR feeder = "schacht2" + THEN feeder name := feeder + ELIF feeder = "sheet" + THEN feeder name := "schacht1" + ELSE errorstop ("unzulssige Einzugsart") + FI +END PROC paper feed; + +TEXT PROC paper feed: feeder name END PROC paper feed; + +$openh$ +PROC open (INT CONST op code, INT VAR param1, param2) : + +SELECT op code OF + CASE 1: open document + CASE 2: open page +END SELECT. + +$opendoch$ + open document : + modifikations := 0; + param 1 := x step conversion ( x size ); + param 2 := y step conversion ( y size ); +$initspeed$ + IF pos (material, "slow") <> 0 + THEN is slow := TRUE; + ELIF pos (material, "fast") <> 0 + THEN is slow := FALSE; + ELSE is slow := std speed name = "slow" + FI; +$opendocfx85$ + param 2 := (param 2 DIV 36) * 36; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"2"27"6"); + out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *) + +$opendocfx800$ + param 2 := (param 2 DIV 36) * 36; + was tall font := TRUE; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"t"1""27"6"); (* Zeichentabelle 4 (Grafik) *) + out (""27"R"0""27"9"27"O"27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + IF pos (material, "nlq") <> 0 + THEN out (""27"x"1"") + ELIF pos (material, "draft") <> 0 + THEN out (""27"x"0"") + ELIF std quality name = "nlq" + THEN out (""27"x"1"") + ELSE out (""27"x"0"") + FI; + IF pos (material, "roman") <> 0 + THEN out (""27"k"0"") + ELIF pos (material, "sansserif") <> 0 + THEN out (""27"k"1"") + ELIF std typeface name = "roman" + THEN out (""27"k"0"") + ELIF std typeface name = "sansserif" + THEN out (""27"k"1"") + FI. + +$opendocmx$ + param 2 := (param 2 DIV 36) * 36; + out (""27"R"0""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"9"27"O"). + +$opendocgp$ + param 2 := (param 2 DIV 36) * 36; + out (""27"6"); (* Zeichensatz 2 *) + out (""18""27"F"27"H"27"W"0""27"T"27"-"0""); (* Modifikationen rcksetzen *) + out (""27"9"27"O"27"A"12""27"2"); + out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *) + +$opendocpp$ + param 2 := (param 2 DIV 36) * 36; + out (""27"6"); (* Zeichensatz 2 *) + out (""18""27"F"27"W"0""27"T"27"-"0""); (* Modifikationen rcksetzen *) + out (""27"9"27"O"27"A"12""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + IF pos (material, "nlq") <> 0 + THEN out (""27"G") + ELIF pos (material, "draft") <> 0 + THEN out (""27"H") + ELIF std quality name = "nlq" + THEN out (""27"G") + ELSE out (""27"H") + FI. + +$opendocml182i$ + IF pos (material, "nlq") <> 0 + THEN out (""27"I3") + ELIF pos (material, "draft") <> 0 + THEN out (""27"I1") + ELIF std quality name = "nlq" + THEN out (""27"I3") + ELSE out (""27"I1") + FI; + out (""27"N"0""); (* Kein Sprung ber Perf. *) + +$opendocml192el$ + param 2 := (param 2 DIV 36) * 36; + prop font := FALSE; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"6"); (* Erweiterung des Zeichensatzes *) + out (""27"9"27"O"27"x"0""). + +$opendocml292el$ + param 2 := (param 2 DIV 36) * 36; + was tall font := TRUE; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"t"1""27"6"); (* Zeichentabelle 4 (Grafik) *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"9"27"O"27"r0"); + IF pos (material, "nlq") <> 0 + THEN out (""27"x"1"") + ELIF pos (material, "draft") <> 0 + THEN out (""27"x"0"") + ELIF std quality name = "nlq" + THEN out (""27"x"1"") + ELSE out (""27"x"0"") + FI; + IF pos (material, "courier") <> 0 + THEN out (""27"k"0"") + ELIF pos (material, "sansserif") <> 0 + THEN out (""27"k"1"") + ELIF std typeface name = "courier" + THEN out (""27"k"0"") + ELIF std typeface name = "sansserif" + THEN out (""27"k"1"") + FI. + +$opendocml294i$ + param 2 := (param 2 DIV 36) * 36; + out (""27"6"); (* Zeichensatz 2 *) + out (""18""27"F"27"W0"27"T"27"-0"27"%H"); (* Modifikationen rcksetzen *) + out (""27"9"27"O"27"A"12""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + IF pos (material, "nlq") <> 0 + THEN out (""27"G") + ELIF pos (material, "draft") <> 0 + THEN out (""27"H") + ELIF std quality name = "nlq" + THEN out (""27"G") + ELSE out (""27"H") + FI. + +$opendocml320$ + param 2 := (param 2 DIV 36) * 36; + prop font := FALSE; + out (""27"{"99""27"{"40""); (* Umschaltung auf EPSON-Emulation *) + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"6"); (* Erweiterung des Zeichensatzes *) + out (""27"9"27"O"27"x"0""). + +$opendoclc10$ + param 2 := (param 2 DIV 36) * 36; + was tall font := TRUE; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"t"1""27"6"); (* Zeichentabelle 4 (Grafik) *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"9"27"r"0""); + IF pos (material, "nlq") <> 0 + THEN out (""27"x"1"") + ELIF pos (material, "draft") <> 0 + THEN out (""27"x"0"") + ELIF std quality name = "nlq" + THEN out (""27"x"1"") + ELSE out (""27"x"0"") + FI; + IF pos (material, "courier") <> 0 + THEN out (""27"k"0"") + ELIF pos (material, "sansserif") <> 0 + THEN out (""27"k"1"") + ELIF pos (material, "orator1") <> 0 + THEN out (""27"k"2"") + ELIF pos (material, "orator2") <> 0 + THEN out (""27"k"3"") + ELIF std typeface name = "courier" + THEN out (""27"k"0"") + ELIF std typeface name = "sansserif" + THEN out (""27"k"1"") + ELIF std typeface name = "orator1" + THEN out (""27"k"2"") + ELIF std typeface name = "orator2" + THEN out (""27"k"3"") + FI. + +$opendocnx15$ + param 2 := (param 2 DIV 36) * 36; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"6"); (* Erweiterung des Zeichensatzes *) + out (""27"9"27"x"0""). + +$opendocdmp4000$ + param 2 := (param 2 DIV 36) * 36; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"m"0""27"R"0""27"9"27"O"27"2"27"6"); + out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *) + +$opendocmt$ + param 2 := (param 2 DIV 36) * 36; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"O"27"x"0""27"r"0""27"6"); + IF feeder name = "tractor" + THEN act feeder := feeder name; + out (""27"[5{") + ELSE out (""27"[0{"); + IF pos (material, "schacht1") <> 0 + THEN act feeder := "schacht1" + ELIF pos (material, "schacht2") <> 0 + THEN act feeder := "schacht2" + ELSE act feeder := feeder name + FI + FI. + +$opendocdx2100$ +param 2 := (param 2 DIV 36) * 36; +out (""24""27""64""); (* Reset des Druckers *) +out (""27"R"0""); (* US-Zeichensatz *) +out (""27"2" + ""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) +out (""27"N"0""); (* skip perforation *) +out (""27"x"0"" + ""27"r"0""). (* draft und black *) + + +$opendoc120d$ + param 2 := (param 2 DIV 36) * 36; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"9"27"O"27"x0"27"2"); + out (""27"C" + code (param 2 DIV 36)). (* Formularlaenge *) + +$opendocc310$ + param 2 := (param 2 DIV 36) * 36; + out (""27""64""27""64""); (* Reset des Druckers *) + out (""27"R"0""27"2"); + out (""27"C" + code (param 2 DIV 36)); (* Formularlaenge *) + out (""27"O"27"x"0""27"r"0""27"6"); + IF feeder name = "tractor" + THEN act feeder := feeder name; + ELSE IF pos (material, "schacht1") <> 0 + THEN act feeder := "schacht1" + ELIF pos (material, "schacht2") <> 0 + THEN act feeder := "schacht2" + ELSE act feeder := feeder name + FI + FI. + +$openpge$ + open page : + param 1 := 0; + param 2 := y step conversion (y margin); + x rest := 0; + y rest := 0; + small := 0; + out (""13""). +$openpgemlsf$ + open page : + param 1 := 0; + param 2 := 0; + x rest := 0; + y rest := 0; + small := 0; + IF feeder name = "sheet" THEN out (""12"") FI; + out (""13""). +$openpgemtsf$ + open page : + param 1 := 0; + param 2 := 0; + x rest := 0; + y rest := 0; + small := 0; + IF feeder name = "schacht1" + THEN out (""27"[21{"12"") + ELIF feeder name = "schacht2" + THEN out (""27"[22{"12"") + FI; + out (""13""). + +$openpgec310sf$ + open page : + param 1 := 0; + param 2 := 0; + x rest := 0; + y rest := 0; + small := 0; + IF feeder name = "schacht1" + THEN out (""27""25"1"12"") + ELIF feeder name = "schacht2" + THEN out (""27""25"2"12"") + FI; + out (""13""). + +$betwoc$ +END PROC open; + +PROC close (INT CONST op code, INT CONST param1) : + +SELECT op code OF + CASE 1: close document + CASE 2: close page +END SELECT. +close document : +$clpge$ +. close page : + IF param 1 > 0 THEN out (""12"") FI. +$clmlsf$ +.close page : + IF feeder name = "sheet" + THEN out (""27""25""3"") + ELIF param 1 > 0 + THEN out (""12"") + FI. +$clmtsf$ +.close page : + IF feeder name <> "tractor" + THEN out (""27"[2J") + ELIF param 1 > 0 + THEN out (""12"") + FI. +$clc310sf$ +.close page : + IF feeder name = "sheet" + THEN out (""27""25"R") + ELIF param 1 > 0 + THEN out (""12"") + FI. + +$betwce$ +END PROC close; + +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE 1: write text + CASE 2: write cmd + CASE 3: carriage return + CASE 4: move + CASE 5: draw + CASE 6: on + CASE 7: off + CASE 8: type +END SELECT. + +is underline: bit (modifikations, 0). +is bold : bit (modifikations, 1). +is italics : bit (modifikations, 2). + + write text : + out subtext (string, param 1, param 2). +$cmd$ + write cmd : + out subtext (string, param 1, param 2). +$cmdfx800$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF buffer = "draft" + THEN out (""27"x"0"") + ELIF buffer = "nlq" + THEN out (""27"x"1"") + ELIF buffer = "roman" + THEN out (""27"k"0"") + ELIF buffer = "sansserif" + THEN out (""27"k"1"") + ELSE out (buffer) + FI. +$cmdpp$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF buffer = "draft" + THEN out (""27"H") + ELIF buffer = "nlq" + THEN out (""27"G") + ELSE out (buffer) + FI. +$cmdml182i$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF buffer = "draft" + THEN out (""27"I1") + ELIF buffer = "nlq" + THEN out (""27"I3") + ELSE out (buffer) + FI. +$cmdml292el$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF buffer = "draft" + THEN out (""27"x"0"") + ELIF buffer = "nlq" + THEN out (""27"x"1"") + ELIF buffer = "courier" + THEN out (""27"k"0"") + ELIF buffer = "sansserif" + THEN out (""27"k"1"") + ELIF buffer = "schwarz" + THEN out (""27"r0") + ELIF buffer = "rot" + THEN out (""27"r1") + ELIF buffer = "blau" + THEN out (""27"r2") + ELIF buffer = "violett" + THEN out (""27"r3") + ELIF buffer = "gelb" + THEN out (""27"r4") + ELIF buffer = "orange" + THEN out (""27"r5") + ELIF buffer = "grn" + THEN out (""27"r6") + ELSE out (buffer) + FI. +$cmdml294i$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF buffer = "draft" + THEN out (""27"H") + ELIF buffer = "nlq" + THEN out (""27"G") + ELIF buffer = "schwarz" + THEN out (""27"r0") + ELIF buffer = "rot" + THEN out (""27"r1") + ELIF buffer = "blau" + THEN out (""27"r2") + ELIF buffer = "violett" + THEN out (""27"r3") + ELIF buffer = "gelb" + THEN out (""27"r4") + ELIF buffer = "orange" + THEN out (""27"r5") + ELIF buffer = "grn" + THEN out (""27"r6") + ELSE out (buffer) + FI. +$cmdlc10$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF buffer = "draft" + THEN out (""27"x"0"") + ELIF buffer = "nlq" + THEN out (""27"x"1"") + ELIF buffer = "courier" + THEN out (""27"k"0"") + ELIF buffer = "sansserif" + THEN out (""27"k"1"") + ELIF buffer = "orator1" + THEN out (""27"k"2"") + ELIF buffer = "orator2" + THEN out (""27"k"3"") + ELIF buffer = "schwarz" + THEN out (""27"r"0"") + ELIF buffer = "rot" + THEN out (""27"r"1"") + ELIF buffer = "blau" + THEN out (""27"r"2"") + ELIF buffer = "violett" + THEN out (""27"r"3"") + ELIF buffer = "gelb" + THEN out (""27"r"4"") + ELIF buffer = "orange" + THEN out (""27"r"5"") + ELIF buffer = "grn" + THEN out (""27"r"6"") + ELSE out (buffer) + FI. +$cmdmt230$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF feeder name <> "tractor" + THEN IF buffer = "schacht1" OR buffer = "schacht2" + THEN act feeder := buffer + FI + ELIF buffer = "schwarz" + THEN out (""27"r"0"") + ELIF buffer = "magenta" + THEN out (""27"r"1"") + ELIF buffer = "cyan" + THEN out (""27"r"2"") + ELIF buffer = "blau" + THEN out (""27"r"3"") + ELIF buffer = "gelb" + THEN out (""27"r"4"") + ELIF buffer = "rot" + THEN out (""27"r"5"") + ELIF buffer = "grn" + THEN out (""27"r"6"") + ELSE out (buffer) + FI. + +$cmdc310$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF feeder name <> "tractor" + THEN IF buffer = "schacht1" OR buffer = "schacht2" + THEN act feeder := buffer + FI + ELIF buffer = "schwarz" + THEN out (""27"r"0"") + ELIF buffer = "rot" + THEN out (""27"r"1"") + ELIF buffer = "blau" + THEN out (""27"r"2"") + ELIF buffer = "violett" + THEN out (""27"r"3"") + ELIF buffer = "gelb" + THEN out (""27"r"4"") + ELIF buffer = "orange" + THEN out (""27"r"5"") + ELIF buffer = "grn" + THEN out (""27"r"6"") + ELSE out (buffer) + FI. + +$cmddx2100$ + write cmd : + buffer := subtext (string, param 1, param 2); + IF buffer = "schwarz" + THEN out (""27"r"0"") + ELIF buffer = "rot" + THEN out (""27"r"1"") + ELIF buffer = "blau" + THEN out (""27"r"2"") + ELIF buffer = "violett" + THEN out (""27"r"3"") + ELIF buffer = "gelb" + THEN out (""27"r"4"") + ELIF buffer = "orange" + THEN out (""27"r"5"") + ELIF buffer = "grn" + THEN out (""27"r"6"") + ELSE out (buffer) + FI. + +$crs$ + carriage return : + y rest INCR small; + x rest := 0; + small := 0; + out (""13""). +$moh$ +x steps : param1. +y steps : param2. + +move : + IF x steps < 0 OR y steps < 0 THEN stop FI; + IF x steps > 0 THEN x move FI; + IF y steps > 0 THEN y move FI. + +$mofx85$ +x move : + high := (x steps + x rest) DIV blankbreite; + x rest := (x steps + x rest) MOD blankbreite; + IF high > 0 THEN high TIMESOUT " " FI; + IF x rest > 0 AND is slow + THEN IF is underline THEN out (" "8"") FI; + out (""27"Y"+ code (x rest) + ""0""); + x rest TIMESOUT ""0""; + x rest := 0 + FI. + + +$mofx800$ +x move : + IF is underline + THEN underline x move + ELSE simple x move + FI. + +underline x move: + high := (x steps + x rest) DIV blankbreite; + low := (x steps + x rest) MOD blankbreite; + IF high > 0 THEN high TIMESOUT " " FI; + IF low > 0 + THEN out (" "8""27"\"+ code (low) + ""0"") + FI. + +simple x move: + out (""27"\"); + out (code (x steps MOD 256)); + out (code (x steps DIV 256)). + +$modrmx$ +x move : + high := (x steps + x rest) DIV blankbreite; + low := (x steps + x rest) MOD blankbreite; + IF high > 0 THEN high TIMESOUT " " FI; + IF low > 0 AND is slow + THEN IF is underline THEN out ("_"8"") FI; + IF is condensed + THEN high := low; + low := 0; + out (""27"L"+ code (high) + ""0""); + ELSE high := low DIV 2; + low := low MOD 2; + out (""27"K"+ code (high) + ""0""); + FI; + high TIMESOUT ""0""; + IF is small + THEN out (""27"S"1""); + small DECR 1; + FI; + FI; + x rest := low. + +y move : + y rest INCR y steps; + IF y rest > 0 + THEN high := y rest DIV 255; + low := y rest MOD 255; + IF high > 0 THEN high TIMESOUT ""27"J"255"" FI; + IF low > 0 THEN out (""27"J"); out (code (low)) FI; + y rest := 0 + FI. + +draw : + IF x steps < 0 OR y steps <> 0 OR linetype <> 1 + THEN stop + ELIF x steps > 0 + THEN x draw + FI. + +x draw : + out (""27"L"); + out (code (x steps MOD 256)); + out (code (x steps DIV 256)); + x steps TIMESOUT ""1""; + IF is small THEN out (""27"S"1"") FI. + +$mogp$ +x move : + high := (x steps + x rest) DIV blankbreite; + x rest := (x steps + x rest) MOD blankbreite; + IF high > 0 THEN high TIMESOUT " " FI; + IF x rest > 0 AND is slow + THEN IF is underline + THEN out (" "13""27"Y"); + out (code (x pos MOD 256)); + out (code (x pos DIV 256)); + x pos TIMESOUT ""0"" + ELSE out (""27"Y"+ code (x rest) + ""0""); + x rest TIMESOUT ""0"" + FI; + x rest := 0 + FI. + +$moml192el$ +x move : + high := (x steps + x rest) DIV blankbreite; + x rest := (x steps + x rest) MOD blankbreite; + IF high > 0 THEN high TIMESOUT " " FI; + IF x rest > 0 AND is slow + THEN IF is underline THEN + IF prop font THEN + out (""27"p"0"" + " "8"" + ""27"p"1"") + ELSE + out (" "8"") + FI; + FI; + out (""27"Y"+ code (x rest) + ""0""); + x rest TIMESOUT ""0""; + x rest := 0 + FI. + +$ymodr$ +y move : + y rest INCR y steps; + IF y rest > 0 + THEN high := y rest DIV 255; + low := y rest MOD 255; + IF high > 0 THEN high TIMESOUT ""27"J"255"" FI; + IF low > 0 THEN out (""27"J"); out (code (low)) FI; + y rest := 0 + FI. + +draw : + IF x steps < 0 OR y steps <> 0 OR linetype <> 1 + THEN stop + ELIF x steps > 0 + THEN x draw + FI. + +x draw : + out (""27"Y"); + out (code (x steps MOD 256)); + out (code (x steps DIV 256)); + x steps TIMESOUT ""1"". + +$onoff$ + on : + IF on string (param 1) <> "" + THEN out (on string (param 1)); + modifikations := modifikations OR param 1 + ELSE stop + FI. + + off : + IF off string (param 1) <> "" + THEN out (off string (param 1)); + modifikations := modifikations AND (param 1 XOR -1) + ELSE stop + FI. + +$onoffpp$ + on : + IF on string (param 1) <> "" AND param 1 <> 2 + THEN out (on string (param 1)); + modifikations := modifikations OR param 1 + ELSE stop + FI. + + off : + IF off string (param 1) <> "" AND param 1 <> 2 + THEN out (off string (param 1)); + modifikations := modifikations AND (param 1 XOR -1) + ELSE stop + FI. + +$tyfx85$ + type : + buffer := font string (param 1); + out (buffer); + restore modifikations; + blankbreite := char pitch (param 1, " "); + IF pos (buffer, ""27"S") <> 0 THEN small DECR 1 FI. + +$tyfx800$ + type : + buffer := font string (param 1); + IF was tall font + THEN out (""27"w"0"") + FI; + out (buffer); + restore modifikations; + blankbreite := char pitch (param 1, " "); + was tall font := pos (buffer, ""27"w"1"") <> 0. + +$tymx$ + type : + buffer := font string (param 1); + blankbreite := char pitch (param 1, " "); + is condensed := pos (buffer, ""15"") <> 0; + IF pos (buffer, ""27"S") <> 0 + THEN small DECR 1; + is small := TRUE; + ELSE is small := FALSE; + FI; + out (buffer); + restore modifikations. + +$tyohnesmall$ + type : + buffer := font string (param 1); + out (buffer); + restore modifikations; + blankbreite := char pitch (param 1, " "). + +$tyml192el$ + type : + buffer := font string (param 1); + out (buffer); + restore modifikations; + blankbreite := char pitch (param 1, " "); + prop font := pos (buffer, ""27"p"1"") <> 0; + IF pos (buffer, ""27"S") <> 0 THEN small DECR 1 FI. + +$tyml292el$ + type : + buffer := font string (param 1); + IF was tall font + THEN out (""27""31"0"27"U0") + FI; + was tall font := pos (buffer, ""27"w"1"") <> 0; + change all (buffer, ""27"w"0"", ""27""31"0"27"U0"); + change all (buffer, ""27"w"1"", ""27""31"1"27"U1"); + out (buffer); + restore modifikations; + blankbreite := char pitch (param 1, " "). + +$ontyml294i$ + on : + IF on string (param 1) <> "" AND param 1 <> 2 + THEN out (on string (param 1)); + modifikations := modifikations OR param 1 + ELIF param 1 = 4 + THEN out (""27"%G"); + modifikations := modifikations OR param 1 + ELSE stop + FI. + + off : + IF off string (param 1) <> "" AND param 1 <> 2 + THEN out (off string (param 1)); + modifikations := modifikations AND (param 1 XOR -1) + ELIF param 1 = 4 + THEN out (""27"%H"); + modifikations := modifikations AND (param 1 XOR -1) + ELSE stop + FI. + + type : + buffer := font string (param 1); + out (buffer); + IF is underline THEN out (on string (1)) FI; + IF is bold THEN out (on string (2)) FI; + IF is italics THEN out (""27"%G") FI; + blankbreite := char pitch (param 1, " "); + IF pos (buffer, ""27"S") <> 0 THEN small DECR 1 FI. + +$end$ + restore modifikations: + IF is underline THEN out (on string (1)) FI; + IF is bold THEN out (on string (2)) FI; + IF is italics THEN out (on string (4)) FI. + +END PROC execute; + +INT VAR reply; DATASPACE VAR ds; FILE VAR file; + +PROC printer: + + disable stop; + continue (server channel); + check error (error message); + ds := nilspace; + REP forget (ds); + execute print; + IF is error AND online THEN put error; clear error; FI; + PER; +END PROC printer; + +PROC execute print: + + LET ack = 0, fetch code = 11, file type = 1003; + enable stop; + ds := nilspace; + call (father, fetch code, ds, reply); + IF reply = ack CAND type (ds) = file type + THEN file := sequential file (input, ds); + print (file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; +END PROC execute print; + +PROC check error(TEXT CONST message): + + IF is error + THEN clear error; rename myself (message); + IF is error THEN end(myself) FI; + pause (9000); end(myself); + FI; +END PROC check error; + +END PACKET printerdriver + diff --git a/system/printer-9nadel/1986/src/printer.epson.fx b/system/printer-9nadel/1986/src/printer.epson.fx new file mode 100644 index 0000000..6443bb0 --- /dev/null +++ b/system/printer-9nadel/1986/src/printer.epson.fx @@ -0,0 +1,505 @@ +PACKET epson fx printer + +(*************************************************************************) +(* Stand : 29.07.86 *) +(* EPSON FX-80 / FX-100 / FX-100+ Version : 4 *) +(* Autor : Rudolf Ruland *) +(*************************************************************************) + + DEFINES open, + close, + execute, + + paper size, + std speed : + +LET underline = 1, +(* bold = 2, *) + italics = 4, +(* reverse = 8, *) + + underline linetype = 1, + + c document = 1, + c page = 2, + + c write text = 1, + c write cmd = 2, + c carriage return = 3, + c move = 4, + c draw = 5, + c on = 6, + c off = 7, + c type = 8; + +INT VAR blankbreite, x rest, y rest, high, low, small; +BOOL VAR is slow, is underline, is italics, + double font, prop font, italics font; +REAL VAR x size, y size; +TEXT VAR std speed name; + +(*********************************************************************) + +(* paper size ( 8.0 * 2.54, 12.0 * 2.54); *) (* FX-80 *) + paper size (13.6 * 2.54, 12.0 * 2.54); (* FX-100 *) + std speed ("fast"); + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; + +END PROC paper size; + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); + +END PROC paper size; + + +PROC std speed (TEXT CONST speed) : + + IF speed = "fast" OR speed = "slow" + THEN std speed name := speed; + ELSE errorstop ("unzulaessige Geschwindigkeit") + FI; + +END PROC std speed; + +TEXT PROC std speed : std speed name END PROC std speed; + +(*********************************************************************) + +PROC open (INT CONST op code, INT VAR param1, param2) : + +SELECT op code OF + CASE c document : open document + CASE c page : open page +END SELECT; + + +. x steps : param1 +. y steps : param2 +. + open document : + IF pos (material, "slow") <> 0 + THEN is slow := TRUE; + ELIF pos (material, "fast") <> 0 + THEN is slow := FALSE; + ELSE is slow := std speed name = "slow" + FI; + is underline := FALSE; + is italics := FALSE; + x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + y steps := (y steps DIV 36) * 36; + out (""27""64""); (* Reset des Druckers *) + out (""27"R"0""); (* Amerikanischer Zeichensatz *) + out (""27"C" + code (y steps DIV 36)); (* Formularlaenge *) + out (""27"I1"27"6"); (* Erweiterung des Zeichensatzes *) + out (""27":"0""0""0""27"%"1""0""); (* Ladbarer Zeichensatz *) + (* Definieren von Zeichen der Breiten 5, 6, 7, 8 und 9 Mikroschritte *) + out (""27"&"0""000""000""4""0""0""0""0""0""0""0""0""0""0""0""); + out (""27"&"0""001""001""5""0""0""0""0""0""0""0""0""0""0""0""); + out (""27"&"0""002""002""6""0""0""0""0""0""0""0""0""0""0""0""); + out (""27"&"0""003""003""7""0""0""0""0""0""0""0""0""0""0""0""); + out (""27"&"0""004""004""8""0""0""0""0""0""0""0""0""0""0""0""); + + +. x start : param1 +. y start : param2 +. + open page : + x start := 0; + y start := 0; + x rest := 0; + y rest := 0; + small := 0; + out (""13""); + +END PROC open; + + +PROC close (INT CONST op code, INT CONST param1) : + +SELECT op code OF + CASE c document : close document + CASE c page : close page +END SELECT; + +. + close document : + + +. remaining y steps : param1 +. + close page : + IF remaining y steps > 0 THEN out (""12"") FI + +END PROC close; + + +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE c write text : write text + CASE c write cmd : write cmd + CASE c carriage return : carriage return + CASE c move : move + CASE c draw : draw + CASE c on : on + CASE c off : off + CASE c type : type +END SELECT + + +. from : param1 +. to : param2 +. + write text : + out subtext (string, from, to) + +. + write cmd : + out subtext (string, from, to) + + +(*. x steps to left margin : param1*) +. + carriage return : + y rest INCR small; + x rest := 0; + small := 0; + out (""13""); + + +. x steps : param1 +. y steps : param2 +. + move : + IF x steps < 0 OR y steps < 0 + THEN stop + ELIF x steps > 0 + THEN x move + ELIF y steps > 0 + THEN y move + FI; + + . x move : + IF prop font + THEN prop x move + ELSE fest x move + FI; + + . prop x move : + high := (x steps + x rest) DIV 5 - 1; + low := (x steps + x rest) MOD 5 + 5; + IF high < 0 + THEN x rest := low - 5; + ELSE IF double font THEN out (""27"W"0"") FI; + IF italics font OR is italics THEN out (""27"5") FI; + IF high > 0 THEN high TIMESOUT ""0"" FI; + IF low > 0 THEN out (code (low - 5)) FI; + IF double font THEN out (""27"W"1"") FI; + IF italics font OR is italics THEN out (""27"4") FI; + x rest := 0; + FI; + + . fest x move : + high := (x steps + x rest) DIV blankbreite; + x rest := (x steps + x rest) MOD blankbreite; + IF high > 0 THEN high TIMESOUT " " FI; + IF x rest > 0 AND is slow + THEN IF is underline THEN out (" "8"") FI; + out (""27"Y"+ code (x rest) + ""0""); + x rest TIMESOUT ""0""; + x rest := 0; + FI; + + . y move : + y rest INCR y steps; + IF y rest > 0 + THEN high := y rest DIV 255; + low := y rest MOD 255; + IF high > 0 THEN high TIMESOUT ""27"J"255"" FI; + IF low > 0 THEN out (""27"J"); out (code (low)) FI; + y rest := 0; + FI; + +. + draw : + IF x steps < 0 OR y steps <> 0 OR linetype <> underline linetype + THEN stop + ELIF x steps > 0 + THEN x draw + FI; + + . x draw : + high := x steps DIV 256; + low := x steps MOD 256; + out (""27"Y"); + out (code (low)); + out (code (high)); + x steps TIMESOUT ""1""; + + +. modification : param1 +. + on : + IF on string (modification) <> "" + THEN out (on string (modification)); + IF modification = underline THEN is underline := TRUE FI; + IF modification = italics THEN is italics := TRUE FI; + ELSE stop + FI; + +. + off : + IF off string (modification) <> "" + THEN out (off string (modification)); + IF modification = underline THEN is underline := FALSE FI; + IF modification = italics THEN is italics := FALSE FI; + ELSE stop + FI; + + +. font nr : param1 +. + type : + TEXT CONST buffer := font string (font nr); + out (buffer); + IF is italics THEN out (""27"4") FI; + blankbreite := char pitch (font nr, " "); + prop font := pos (buffer, ""27"p") <> 0; + italics font := pos (buffer, ""27"4") <> 0; + double font := blankbreite > 12; + IF pos (string, ""27"S") <> 0 THEN small DECR 1 FI; + +END PROC execute; + + +END PACKET epson fx printer; + + +PACKET print cmd for single user (* Autor : Rudolf Ruland *) + (* Stand : 18.02.86 *) + DEFINES print, + print channel : + +INT VAR pr channel; +TEXT VAR buffer; +FILE VAR print file; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + + +PROC print channel (INT CONST channel) : + + IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI; + pr channel := channel; + +END PROC print channel; + +INT PROC print channel : pr channel END PROC print channel; + + +PROC print : + + print (last param) + +ENDPROC print ; + +PROC print (TEXT CONST file name) : + + INT CONST myself channel := channel (myself); + last param (file name) ; + print file := sequential file (input, file name) ; + continue (print channel) ; + disable stop ; + execute print ; + remember error message if neccessary; + IF multi user THEN do ("break (quiet)") FI; + continue (myself channel); + clear error; + put error message if neccessary; + + . remember error message if neccessary : + IF is error + THEN buffer := error message; + clear error; + ELSE buffer := ""; + FI; + + . put error message if neccessary : + IF buffer <> "" THEN errorstop (buffer) FI; + +ENDPROC print ; + +PROC execute print : + + enable stop ; + print (print file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +ENDPROC execute print ; + +ENDPACKET print cmd for single user; + +#page# +(******************************************************************) +(*** ***) +(*** Generierung des Printers ***) +(*** ***) +(******************************************************************) + +LET printer name = "printer.epson.fx", + up = ""3""13""5""; + +TEXT VAR fonttab name := "fonttab.epson.fx"; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + +INT VAR pr channel; +TEXT VAR buffer; + +command dialogue (TRUE); +ask for print channel; +ask for printer type; +ask for positioning; +load font table; +forget (printer name, quiet); +IF multi user THEN generate printer spool FI; +check on; +. + ask for print channel : + line; + put ("gib Druckerkanal:"); + get (pr channel); + print channel (pr channel); + line; +. + ask for printer type : + line; + SELECT printer type OF + CASE 0 : papersize ( 8.0 * 2.54, 12.0 * 2.54); + CASE 1 : papersize (13.6 * 2.54, 12.0 * 2.54); + CASE 2 : papersize (13.6 * 2.54, 12.0 * 2.54); + fonttab name CAT "+"; + END SELECT; + + . printer type : + REP out (up); + IF yes ("Druckertyp : FX-80") + THEN LEAVE printer type WITH 0 FI; + out (up); + IF yes ("Druckertyp : FX-100") + THEN LEAVE printer type WITH 1 FI; + out (up); + IF yes ("Druckertyp : FX-100+") + THEN LEAVE printer type WITH 2 FI; + PER; + 0 +. + ask for positioning : + line; + std speed (positioning); + + . positioning : + REP out (up); + IF yes ("x - Positionierung : in Mikroschritten (genauer, aber langsamer)") + THEN LEAVE positioning WITH "slow" FI; + out (up); + IF yes ("x - Positionierung : in Blanks (schneller, aber ungenauer)") + THEN LEAVE positioning WITH "fast" FI; + PER; + "" +. + load font table : + IF NOT exists (fonttab name) + THEN command dialogue (TRUE); + REP line (2); + putline ("Bitte Archiv mit der Fonttabelle """ + + fonttab name + """ einlegen!"); + line; + UNTIL yes ("Archiv eingelegt") PER; + reserve archive; + fetch (fonttab name, archive); + release (archive); + FI; + font table (fonttab name); + IF multi user + THEN command dialogue (FALSE); + do ("save(""" + font tab name + """,task(""configurator""))") + FI; + forget (fonttab name, quiet); + + . reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop; + +. generate printer spool : + eumel must advertise; + cursor (1, 12); + putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - mu"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (4); + putline ("Generierung beendet, weiter mit 'SV'"); + generate printer server; + do (buffer); + +. generate printer server : + buffer := "break (quiet);"; + buffer CAT "spool manager (PROC printer);"; + buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;"; + buffer CAT "PROC printer:"; + buffer CAT " disable stop;"; + buffer CAT " continue (server channel);"; + buffer CAT " check error (error message);"; + buffer CAT " ds := nilspace;"; + buffer CAT " REP forget (ds);"; + buffer CAT " execute print;"; + buffer CAT " IF is error AND online THEN put error; clear error; FI;"; + buffer CAT " PER;"; + buffer CAT "END PROC printer;"; + buffer CAT "PROC execute print:"; + buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;"; + buffer CAT " enable stop;"; + buffer CAT " ds := nilspace;"; + buffer CAT " call (father, fetch code, ds, reply);"; + buffer CAT " IF reply = ack CAND type (ds) = file type"; + buffer CAT " THEN file := sequential file (input, ds);"; + buffer CAT " print (file,"; + buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,"; + buffer CAT " PROC (INT CONST, INT CONST) close,"; + buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);"; + buffer CAT " FI;"; + buffer CAT "END PROC execute print;"; + buffer CAT "PROC check error(TEXT CONST message):"; + buffer CAT " IF is error"; + buffer CAT " THEN clear error; rename myself (message);"; + buffer CAT " IF is error THEN end(myself) FI;"; + buffer CAT " pause (9000); end(myself);"; + buffer CAT " FI;"; + buffer CAT "END PROC check error;"; diff --git a/system/printer-9nadel/1986/src/printer.epson.lq b/system/printer-9nadel/1986/src/printer.epson.lq new file mode 100644 index 0000000..49d0624 --- /dev/null +++ b/system/printer-9nadel/1986/src/printer.epson.lq @@ -0,0 +1,501 @@ +PACKET epson lq printer + +(**************************************************************************) +(* Stand : 29.07.86 *) +(* EPSON LQ-1500 Version : 4 *) +(* Autor : Rudolf Ruland *) +(**************************************************************************) + + DEFINES open, + close, + execute, + + paper size, + std quality: + +LET +(* underline = 1, + bold = 2, + italics = 4, + reverse = 8, *) + + underline linetype = 1, + + c document = 1, + c page = 2, + + c write text = 1, + c write cmd = 2, + c carriage return = 3, + c move = 4, + c draw = 5, + c on = 6, + c off = 7, + c type = 8; + +INT VAR rest, high, low, factor; +BOOL VAR is nlq, factor was 6, condensed; +REAL VAR x size, y size; +TEXT VAR std quality name, buffer; + +(*********************************************************************) + +paper size (13.6 * 2.54, 12.0 * 2.54); +std quality ("draft"); + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; + +END PROC paper size; + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); + +END PROC paper size; + + +PROC std quality (TEXT CONST quality) : + + IF quality = "nlq" OR quality = "draft" + THEN std quality name := quality; + ELSE errorstop ("unzulaessige Betriebsart") + FI; + +END PROC std quality; + +TEXT PROC std quality : std quality name END PROC std quality; + +(*********************************************************************) + +PROC open (INT CONST op code, INT VAR param1, param2) : + +SELECT op code OF + CASE c document : open document + CASE c page : open page +END SELECT; + + +. x steps : param1 +. y steps : param2 +. + open document : + IF pos (material, "nlq") <> 0 + THEN is nlq := TRUE; + ELIF pos (material, "draft") <> 0 + THEN is nlq := FALSE; + ELSE is nlq := std quality = "nlq" + FI; + factor := 0; + factor was 6 := FALSE; + condensed := FALSE; + x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + y steps := (y steps DIV 30) * 30; + out (""27""64""); (* Reset des Druckers *) + out (""27"R"0""); (* Amerikanischer Zeichensatz *) + out (""27"C" + code (y steps DIV 30)); (* Formularlaenge *) + out (""27"x"0""); (* Entwurfsqualitt *) + + +. x start : param1 +. y start : param2 +. + open page : + x start := 0; + y start := 0; + rest := 0; + out (""13""); + +END PROC open; + + +PROC close (INT CONST op code, INT CONST param1) : + +SELECT op code OF + CASE c document : close document + CASE c page : close page +END SELECT; + +. + close document : + + +. remaining y steps : param1 +. + close page : + IF remaining y steps > 0 THEN out (""12"") FI + +END PROC close; + + +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE c write text : write text + CASE c write cmd : write cmd + CASE c carriage return : carriage return + CASE c move : move + CASE c draw : draw + CASE c on : on + CASE c off : off + CASE c type : type +END SELECT + + +. from : param1 +. to : param2 +. + write text : + out subtext (string, from, to) + +. + write cmd : + buffer := subtext (string, from, to); + IF buffer = "nlq" + THEN is nlq := TRUE; + near letter quality; + ELIF buffer = "draft" + THEN is nlq := FALSE; + draft quality; + ELSE out (buffer); + FI; + + . near letter quality : + IF factor = 6 + THEN factor was 6 := TRUE; + factor := 4; + ELSE factor was 6 := FALSE; + FI; + IF condensed + THEN out (""27"x"0"") + ELSE out (""27"x"1"") + FI; + + . draft quality : + IF factor was 6 + THEN factor was 6 := FALSE; + factor := 6; + FI; + out (""27"x"0""); + + +(*. x steps to left margin : param1*) +. + carriage return : + rest := 0; + out (""13""); + + +. x steps : param1 +. y steps : param2 +. + move : + IF x steps < 0 OR y steps < 0 + THEN stop + ELIF x steps > 0 + THEN x move + ELIF y steps > 0 + THEN y move + FI; + + . x move : + high := (x steps + rest) DIV factor; + rest := (x steps + rest) MOD factor; + out (""27"\"); + out (code (high MOD 256)); + out (code (high DIV 256)); + + . y move : + high := y steps DIV 255; + low := y steps MOD 255; + IF high > 0 THEN high TIMESOUT ""27"J"255"" FI; + IF low > 0 THEN out (""27"J"); out (code (low)) FI; + +. + draw : + IF x steps < 0 OR y steps <> 0 OR linetype <> underline linetype + THEN stop + ELIF x steps > 0 + THEN x draw + FI; + + . x draw : + high := (x steps + rest) DIV 6; + rest := (x steps + rest) MOD 6; + IF high > 0 + THEN low := high MOD 255; + high := high DIV 255; + out (""27"V"); + out (code (low)); + out (""27"*"1""1""0""1""27"V"0""); + FOR low FROM 1 UPTO high + REP out (""27"V"255""27"*"1""1""0""1""27"V"0"") PER; + FI; + + +. modification : param1 +. + on : + IF on string (modification) <> "" + THEN out (on string (modification)) + ELSE stop + FI + +. + off : + IF off string (modification) <> "" + THEN out (off string (modification)) + ELSE stop + FI + + +. font nr : param1 +. + type : + buffer := font string (font nr); + out (buffer); + factor := pitch factor; + IF is nlq THEN near letter quality FI; + + . pitch factor : (* Mikroschritt *) + INT CONST font bits := code (buffer SUB 3); + IF bit (font bits, 1) + THEN condensed := FALSE; 2 (* proportional 1/360 Inch *) + ELIF pos (buffer, ""27"x"1"") <> 0 + THEN condensed := FALSE; 4 (* near letter 1/180 Inch *) + ELIF bit (font bits, 2) + THEN condensed := TRUE; 3 (* condensed 1/240 Inch *) + ELIF bit (font bits, 0) + THEN condensed := FALSE; 4 (* elite 1/180 Inch *) + ELSE condensed := FALSE; 6 (* pica 1/120 Inch *) + FI + +END PROC execute; + + +END PACKET epson lq printer; + + +PACKET print cmd for single user (* Autor : Rudolf Ruland *) + (* Stand : 18.02.86 *) + DEFINES print, + print channel : + +INT VAR pr channel; +TEXT VAR buffer; +FILE VAR print file; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + + +PROC print channel (INT CONST channel) : + + IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI; + pr channel := channel; + +END PROC print channel; + +INT PROC print channel : pr channel END PROC print channel; + + +PROC print : + + print (last param) + +ENDPROC print ; + +PROC print (TEXT CONST file name) : + + INT CONST myself channel := channel (myself); + last param (file name) ; + print file := sequential file (input, file name) ; + continue (print channel) ; + disable stop ; + execute print ; + remember error message if neccessary; + IF multi user THEN do ("break (quiet)") FI; + continue (myself channel); + clear error; + put error message if neccessary; + + . remember error message if neccessary : + IF is error + THEN buffer := error message; + clear error; + ELSE buffer := ""; + FI; + + . put error message if neccessary : + IF buffer <> "" THEN errorstop (buffer) FI; + +ENDPROC print ; + +PROC execute print : + + enable stop ; + print (print file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +ENDPROC execute print ; + +ENDPACKET print cmd for single user; + +#page# +(******************************************************************) +(*** ***) +(*** Generierung des Printers ***) +(*** ***) +(******************************************************************) + +LET printer name = "printer.epson.lq", + up = ""3""13""5""; + +TEXT VAR fonttab name := "fonttab.epson.lq"; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + +INT VAR pr channel; +TEXT VAR buffer; + +command dialogue (TRUE); +ask for print channel; +ask for paper format; +ask for print quality; +load font table; +forget (printer name, quiet); +IF multi user THEN generate printer spool FI; +check on; +. + ask for print channel : + line; + put ("gib Druckerkanal:"); + get (pr channel); + print channel (pr channel); + line; +. + ask for paper format : + SELECT paper format OF + CASE 1 : papersize ( 8.0 * 2.54, 12.0 * 2.54) + CASE 2 : papersize (13.2 * 2.54, 12.0 * 2.54) + CASE 3 : papersize (21.0, 29.7) + END SELECT + + . paper format : + line; + REP out (up); + IF yes ("Papierformat : endlos, 8 Zoll breit") + THEN LEAVE paper format WITH 1 FI; + out (up); + IF yes ("Papierformat : endlos, 13.2 Zoll breit") + THEN LEAVE paper format WITH 2 FI; + out (up); + IF yes ("Papierformat : DINA 4") + THEN LEAVE paper format WITH 3 FI; + PER; + 0 +. + ask for print quality : + line; + std quality (quality); + + . quality : + REP out (up); + IF yes ("standardmige Druckqualitt : draft quality") + THEN LEAVE quality WITH "draft" FI; + out (up); + IF yes ("standardmige Druckqualitt : near letter quality") + THEN LEAVE quality WITH "nlq" FI; + PER; + "" +. + load font table : + IF NOT exists (fonttab name) + THEN command dialogue (TRUE); + REP line (2); + putline ("Bitte Archiv mit der Fonttabelle """ + + fonttab name + """ einlegen!"); + line; + UNTIL yes ("Archiv eingelegt") PER; + reserve archive; + fetch (fonttab name, archive); + release (archive); + FI; + font table (fonttab name); + IF multi user + THEN command dialogue (FALSE); + do ("save(""" + font tab name + """,task(""configurator""))") + FI; + forget (fonttab name, quiet); + + . reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop; + +. generate printer spool : + eumel must advertise; + cursor (1, 12); + putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - mu"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (4); + putline ("Generierung beendet, weiter mit 'SV'"); + generate printer server; + do (buffer); + +. generate printer server : + buffer := "break (quiet);"; + buffer CAT "spool manager (PROC printer);"; + buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;"; + buffer CAT "PROC printer:"; + buffer CAT " disable stop;"; + buffer CAT " continue (server channel);"; + buffer CAT " check error (error message);"; + buffer CAT " ds := nilspace;"; + buffer CAT " REP forget (ds);"; + buffer CAT " execute print;"; + buffer CAT " IF is error AND online THEN put error; clear error; FI;"; + buffer CAT " PER;"; + buffer CAT "END PROC printer;"; + buffer CAT "PROC execute print:"; + buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;"; + buffer CAT " enable stop;"; + buffer CAT " ds := nilspace;"; + buffer CAT " call (father, fetch code, ds, reply);"; + buffer CAT " IF reply = ack CAND type (ds) = file type"; + buffer CAT " THEN file := sequential file (input, ds);"; + buffer CAT " print (file,"; + buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,"; + buffer CAT " PROC (INT CONST, INT CONST) close,"; + buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);"; + buffer CAT " FI;"; + buffer CAT "END PROC execute print;"; + buffer CAT "PROC check error(TEXT CONST message):"; + buffer CAT " IF is error"; + buffer CAT " THEN clear error; rename myself (message);"; + buffer CAT " IF is error THEN end(myself) FI;"; + buffer CAT " pause (9000); end(myself);"; + buffer CAT " FI;"; + buffer CAT "END PROC check error;"; diff --git a/system/printer-9nadel/1986/src/printer.epson.mx b/system/printer-9nadel/1986/src/printer.epson.mx new file mode 100644 index 0000000..2d81d7a --- /dev/null +++ b/system/printer-9nadel/1986/src/printer.epson.mx @@ -0,0 +1,488 @@ +PACKET epson mx printer + +(**************************************************************************) +(* Stand : 29.07.86 *) +(* EPSON MX-80 TYPE III Version : 4 *) +(* Autor : Rudolf Ruland *) +(**************************************************************************) + + + DEFINES open, + close, + execute, + + paper size, + std speed : + +LET underline = 1, + bold = 2, +(* italics = 4, + reverse = 8, *) + + underline linetype = 1, + + c document = 1, + c page = 2, + + c write text = 1, + c write cmd = 2, + c carriage return = 3, + c move = 4, + c draw = 5, + c on = 6, + c off = 7, + c type = 8; + +INT VAR blankbreite, x rest, y rest, high, low, small; +BOOL VAR is underline, is bold, is condensed, is small, is slow; +REAL VAR x size, y size; +TEXT VAR std speed name; + +(*********************************************************************) + +paper size (8.0 * 2.54, 12.0 * 2.54); +std speed ("slow"); + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; + +END PROC paper size; + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); + +END PROC paper size; + + +PROC std speed (TEXT CONST speed) : + + IF speed = "fast" OR speed = "slow" + THEN std speed name := speed; + ELSE errorstop ("unzulaessige Geschwindigkeit") + FI; + +END PROC std speed; + +TEXT PROC std speed : std speed name END PROC std speed; + +(*********************************************************************) + +PROC open (INT CONST op code, INT VAR param1, param2) : + +SELECT op code OF + CASE c document : open document + CASE c page : open page +END SELECT; + + +. x steps : param1 +. y steps : param2 +. + open document : + IF pos (material, "slow") <> 0 + THEN is slow := TRUE; + ELIF pos (material, "fast") <> 0 + THEN is slow := FALSE; + ELSE is slow := std speed name = "slow" + FI; + is underline := FALSE; + is bold := FALSE; + x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + y steps := (y steps DIV 36) * 36; + out (""27"R"0""27""64""); (* Reset des Druckers *) + out (""27"R"0""); (* Amerikanischer Zeichensatz *) + out (""27"C" + code (y steps DIV 36)); (* Formularlaenge *) + + +. x start : param1 +. y start : param2 +. + open page : + x start := 0; + y start := 0; + x rest := 0; + y rest := 0; + small := 0; + out (""13""); + +END PROC open; + + +PROC close (INT CONST op code, INT CONST param1) : + +SELECT op code OF + CASE c document : close document + CASE c page : close page +END SELECT; + +. + close document : + + +. remaining y steps : param1 +. + close page : + IF remaining y steps > 0 THEN out (""12"") FI + +END PROC close; + + +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE c write text : write text + CASE c write cmd : write cmd + CASE c carriage return : carriage return + CASE c move : move + CASE c draw : draw + CASE c on : on + CASE c off : off + CASE c type : type +END SELECT + + +. from : param1 +. to : param2 +. + write text : + out subtext (string, from, to) + +. + write cmd : + out subtext (string, from, to) + + +(*. x steps to left margin : param1*) +. + carriage return : + y rest INCR small; + x rest := 0; + small := 0; + out (""13""); + + +. x steps : param1 +. y steps : param2 +. + move : + IF x steps < 0 OR y steps < 0 + THEN stop + ELIF x steps > 0 + THEN x move + ELIF y steps > 0 + THEN y move + FI; + + . x move : + high := (x steps + x rest) DIV blankbreite; + low := (x steps + x rest) MOD blankbreite; + IF high > 0 THEN high TIMESOUT " " FI; + IF low > 0 AND is slow + THEN IF is underline THEN out ("_"8"") FI; + IF is condensed + THEN high := low; + low := 0; + out (""27"L"+ code (high) + ""0""); + ELSE high := low DIV 2; + low := low MOD 2; + out (""27"K"+ code (high) + ""0""); + FI; + high TIMESOUT ""0""; + IF is small + THEN out (""27"S"1""); + small DECR 1; + FI; + FI; + x rest := low; + + . y move : + y rest INCR y steps; + IF y rest > 0 + THEN high := y rest DIV 255; + low := y rest MOD 255; + IF high > 0 THEN high TIMESOUT ""27"J"255"" FI; + IF low > 0 THEN out (""27"J"); out (code (low)) FI; + y rest := 0; + FI; + +. + draw : + IF x steps < 0 OR y steps <> 0 OR linetype <> underline linetype + THEN stop + ELIF x steps > 0 + THEN x draw + FI; + + . x draw : + high := x steps DIV 256; + low := x steps MOD 256; + out (""27"L"); + out (code (low)); + out (code (high)); + x steps TIMESOUT ""1""; + IF is small THEN out (""27"S"1"") FI; + + +. modification : param1 +. + on : + IF on string (modification) <> "" + THEN out (on string (modification)); + IF modification = underline THEN is underline := TRUE FI; + IF modification = bold THEN is bold := TRUE FI; + ELSE stop + FI; + +. + off : + IF off string (modification) <> "" + THEN out (off string (modification)); + IF modification = underline THEN is underline := FALSE FI; + IF modification = bold THEN is bold := FALSE FI; + ELSE stop + FI; + + +. font nr : param1 +. + type : + blankbreite := char pitch (font nr, " "); + is condensed := pos (font string (font nr), ""15"") <> 0; + IF pos (font string (font nr), ""27"S") <> 0 + THEN small DECR 1; + is small := TRUE; + ELSE is small := FALSE; + FI; + out (font string (font nr)); + IF is bold THEN out (on string (bold)) FI; + +END PROC execute; + + +END PACKET epson mx printer; + + +PACKET print cmd for single user (* Autor : Rudolf Ruland *) + (* Stand : 19.02.86 *) + DEFINES print, + print channel : + +INT VAR pr channel; +TEXT VAR buffer; +FILE VAR print file; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + + +PROC print channel (INT CONST channel) : + + IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI; + pr channel := channel; + +END PROC print channel; + +INT PROC print channel : pr channel END PROC print channel; + + +PROC print : + + print (last param) + +ENDPROC print ; + +PROC print (TEXT CONST file name) : + + INT CONST myself channel := channel (myself); + last param (file name) ; + print file := sequential file (input, file name) ; + continue (print channel) ; + disable stop ; + execute print ; + remember error message if neccessary; + IF multi user THEN do ("break (quiet)") FI; + continue (myself channel); + clear error; + put error message if neccessary; + + . remember error message if neccessary : + IF is error + THEN buffer := error message; + clear error; + ELSE buffer := ""; + FI; + + . put error message if neccessary : + IF buffer <> "" THEN errorstop (buffer) FI; + +ENDPROC print ; + +PROC execute print : + + enable stop ; + print (print file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +ENDPROC execute print ; + +ENDPACKET print cmd for single user; + +#page# +(******************************************************************) +(*** ***) +(*** Generierung des Printers ***) +(*** ***) +(******************************************************************) + +LET printer name = "printer.epson.mx", + up = ""3""13""5""; + +TEXT VAR fonttab name := "fonttab.epson.mx"; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + +INT VAR pr channel; +TEXT VAR buffer; + +command dialogue (TRUE); +ask for print channel; +ask for paper format; +ask for positioning; +load font table; +forget (printer name, quiet); +IF multi user THEN generate printer spool FI; +check on; +. + ask for print channel : + line; + put ("gib Druckerkanal:"); + get (pr channel); + print channel (pr channel); + line; +. + ask for paper format : + SELECT paper format OF + CASE 1 : papersize ( 8.0 * 2.54, 12.0 * 2.54) + CASE 2 : papersize (13.2 * 2.54, 12.0 * 2.54) + CASE 3 : papersize (21.0, 29.7) + END SELECT + + . paper format : + line; + REP out (up); + IF yes ("Papierformat : endlos, 8 Zoll breit") + THEN LEAVE paper format WITH 1 FI; + out (up); + IF yes ("Papierformat : endlos, 13.2 Zoll breit") + THEN LEAVE paper format WITH 2 FI; + out (up); + IF yes ("Papierformat : DINA 4") + THEN LEAVE paper format WITH 3 FI; + PER; + 0 +. + ask for positioning : + line; + std speed (positioning); + + . positioning : + REP out (up); + IF yes ("x - Positionierung : in Mikroschritten (genauer, aber langsamer)") + THEN LEAVE positioning WITH "slow" FI; + out (up); + IF yes ("x - Positionierung : in Blanks (schneller, aber ungenauer)") + THEN LEAVE positioning WITH "fast" FI; + PER; + "" +. + load font table : + IF NOT exists (fonttab name) + THEN command dialogue (TRUE); + REP line (2); + putline ("Bitte Archiv mit der Fonttabelle """ + + fonttab name + """ einlegen!"); + line; + UNTIL yes ("Archiv eingelegt") PER; + reserve archive; + fetch (fonttab name, archive); + release (archive); + FI; + font table (fonttab name); + IF multi user + THEN command dialogue (FALSE); + do ("save(""" + font tab name + """,task(""configurator""))") + FI; + forget (fonttab name, quiet); + + . reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop; + +. generate printer spool : + eumel must advertise; + cursor (1, 12); + putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - mu"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (4); + putline ("Generierung beendet, weiter mit 'SV'"); + generate printer server; + do (buffer); + +. generate printer server : + buffer := "break (quiet);"; + buffer CAT "spool manager (PROC printer);"; + buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;"; + buffer CAT "PROC printer:"; + buffer CAT " disable stop;"; + buffer CAT " continue (server channel);"; + buffer CAT " check error (error message);"; + buffer CAT " ds := nilspace;"; + buffer CAT " REP forget (ds);"; + buffer CAT " execute print;"; + buffer CAT " IF is error AND online THEN put error; clear error; FI;"; + buffer CAT " PER;"; + buffer CAT "END PROC printer;"; + buffer CAT "PROC execute print:"; + buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;"; + buffer CAT " enable stop;"; + buffer CAT " ds := nilspace;"; + buffer CAT " call (father, fetch code, ds, reply);"; + buffer CAT " IF reply = ack CAND type (ds) = file type"; + buffer CAT " THEN file := sequential file (input, ds);"; + buffer CAT " print (file,"; + buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,"; + buffer CAT " PROC (INT CONST, INT CONST) close,"; + buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);"; + buffer CAT " FI;"; + buffer CAT "END PROC execute print;"; + buffer CAT "PROC check error(TEXT CONST message):"; + buffer CAT " IF is error"; + buffer CAT " THEN clear error; rename myself (message);"; + buffer CAT " IF is error THEN end(myself) FI;"; + buffer CAT " pause (9000); end(myself);"; + buffer CAT " FI;"; + buffer CAT "END PROC check error;"; diff --git a/system/printer-9nadel/1986/src/printer.epson.rx b/system/printer-9nadel/1986/src/printer.epson.rx new file mode 100644 index 0000000..0d2326e --- /dev/null +++ b/system/printer-9nadel/1986/src/printer.epson.rx @@ -0,0 +1,446 @@ +PACKET epson rx printer + +(**************************************************************************) +(* Stand : 29.07.86 *) +(* EPSON RX-80 F/T + Version : 4 *) +(* Autor : Rudolf Ruland *) +(**************************************************************************) + + DEFINES open, + close, + execute, + + paper size, + std speed : + +LET underline = 1, +(* bold = 2, + italics = 4, + reverse = 8,*) + + underline linetype = 1, + + c document = 1, + c page = 2, + + c write text = 1, + c write cmd = 2, + c carriage return = 3, + c move = 4, + c draw = 5, + c on = 6, + c off = 7, + c type = 8; + +INT VAR blankbreite, x rest, y rest, high, low, small; +BOOL VAR is underline, is slow; +REAL VAR x size, y size; +TEXT VAR std speed name; + +(*********************************************************************) + +paper size (8.0 * 2.54, 12.0 * 2.54); +std speed ("slow"); + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; + +END PROC paper size; + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); + +END PROC paper size; + + +PROC std speed (TEXT CONST speed) : + + IF speed = "fast" OR speed = "slow" + THEN std speed name := speed; + ELSE errorstop ("unzulaessige Geschwindigkeit") + FI; + +END PROC std speed; + +TEXT PROC std speed : std speed name END PROC std speed; + +(*********************************************************************) + +PROC open (INT CONST op code, INT VAR param1, param2) : + +SELECT op code OF + CASE c document : open document + CASE c page : open page +END SELECT; + + +. x steps : param1 +. y steps : param2 +. + open document : + IF pos (material, "slow") <> 0 + THEN is slow := TRUE; + ELIF pos (material, "fast") <> 0 + THEN is slow := FALSE; + ELSE is slow := std speed name = "slow" + FI; + is underline := FALSE; + x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + y steps := (y steps DIV 36) * 36; + out (""27""64""); (* Reset des Druckers *) + out (""27"R"0""); (* Amerikanischer Zeichensatz *) + out (""27"C" + code (y steps DIV 36)); (* Formularlaenge *) + out (""27"m"4""); (* graphischer Zeichensatz *) + + +. x start : param1 +. y start : param2 +. + open page : + x start := 0; + y start := 0; + x rest := 0; + y rest := 0; + small := 0; + out (""13""); + +END PROC open; + + +PROC close (INT CONST op code, INT CONST param1) : + +SELECT op code OF + CASE c document : close document + CASE c page : close page +END SELECT; + +. + close document : + + +. remaining y steps : param1 +. + close page : + IF remaining y steps > 0 THEN out (""12"") FI + +END PROC close; + + +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE c write text : write text + CASE c write cmd : write cmd + CASE c carriage return : carriage return + CASE c move : move + CASE c draw : draw + CASE c on : on + CASE c off : off + CASE c type : type +END SELECT + + +. from : param1 +. to : param2 +. + write text : + out subtext (string, from, to) + +. + write cmd : + out subtext (string, from, to) + + +(*. x steps to left margin : param1*) +. + carriage return : + y rest INCR small; + x rest := 0; + small := 0; + out (""13""); + + +. x steps : param1 +. y steps : param2 +. + move : + IF x steps < 0 OR y steps < 0 + THEN stop + ELIF x steps > 0 + THEN x move + ELIF y steps > 0 + THEN y move + FI; + + . x move : + high := (x steps + x rest) DIV blankbreite; + low := (x steps + x rest) MOD blankbreite; + IF high > 0 THEN high TIMESOUT " " FI; + IF low > 0 AND is slow + THEN IF is underline THEN out (" "8"") FI; + out (""27"Y"+ code (low) + ""0""); + low TIMESOUT ""0""; + x rest := 0; + ELSE x rest := low; + FI; + + . y move : + y rest INCR y steps; + IF y rest > 0 + THEN high := y rest DIV 255; + low := y rest MOD 255; + IF high > 0 THEN high TIMESOUT ""27"J"255"" FI; + IF low > 0 THEN out (""27"J"); out (code (low)) FI; + y rest := 0; + FI; + +. + draw : + IF x steps < 0 OR y steps <> 0 OR linetype <> underline linetype + THEN stop + ELIF x steps > 0 + THEN x draw + FI; + + . x draw : + high := x steps DIV 256; + low := x steps MOD 256; + out (""27"Y"); + out (code (low)); + out (code (high)); + x steps TIMESOUT ""1""; + + +. modification : param1 +. + on : + IF on string (modification) <> "" + THEN out (on string (modification)); + IF modification = underline THEN is underline := TRUE FI; + ELSE stop + FI; + +. + off : + IF off string (modification) <> "" + THEN out (off string (modification)); + IF modification = underline THEN is underline := FALSE FI; + ELSE stop + FI; + + +. font nr : param1 +. + type : + blankbreite := char pitch (font nr, " "); + IF pos (font string (font nr), ""27"S") <> 0 THEN small DECR 1 FI; + out (font string (font nr)); + +END PROC execute; + + +END PACKET epson rx printer; + + +PACKET print cmd for single user (* Autor : Rudolf Ruland *) + (* Stand : 19.02.86 *) + DEFINES print, + print channel : + +INT VAR pr channel; +TEXT VAR buffer; +FILE VAR print file; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + + +PROC print channel (INT CONST channel) : + + IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI; + pr channel := channel; + +END PROC print channel; + +INT PROC print channel : pr channel END PROC print channel; + + +PROC print : + + print (last param) + +ENDPROC print ; + +PROC print (TEXT CONST file name) : + + INT CONST myself channel := channel (myself); + last param (file name) ; + print file := sequential file (input, file name) ; + continue (print channel) ; + disable stop ; + execute print ; + remember error message if neccessary; + IF multi user THEN do ("break (quiet)") FI; + continue (myself channel); + clear error; + put error message if neccessary; + + . remember error message if neccessary : + IF is error + THEN buffer := error message; + clear error; + ELSE buffer := ""; + FI; + + . put error message if neccessary : + IF buffer <> "" THEN errorstop (buffer) FI; + +ENDPROC print ; + +PROC execute print : + + enable stop ; + print (print file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +ENDPROC execute print ; + +ENDPACKET print cmd for single user; + +#page# +(******************************************************************) +(*** ***) +(*** Generierung des Printers ***) +(*** ***) +(******************************************************************) + +LET printer name = "printer.epson.rx", + up = ""3""13""5""; + +TEXT VAR fonttab name := "fonttab.epson.rx"; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + +INT VAR pr channel; +TEXT VAR buffer; + +command dialogue (TRUE); +ask for print channel; +ask for positioning; +load font table; +forget (printer name, quiet); +IF multi user THEN generate printer spool FI; +check on; +. + ask for print channel : + line; + put ("gib Druckerkanal:"); + get (pr channel); + print channel (pr channel); + line; +. + ask for positioning : + line; + std speed (positioning); + + . positioning : + REP out (up); + IF yes ("x - Positionierung : in Mikroschritten (genauer, aber langsamer)") + THEN LEAVE positioning WITH "slow" FI; + out (up); + IF yes ("x - Positionierung : in Blanks (schneller, aber ungenauer)") + THEN LEAVE positioning WITH "fast" FI; + PER; + "" +. + load font table : + IF NOT exists (fonttab name) + THEN command dialogue (TRUE); + REP line (2); + putline ("Bitte Archiv mit der Fonttabelle """ + + fonttab name + """ einlegen!"); + line; + UNTIL yes ("Archiv eingelegt") PER; + reserve archive; + fetch (fonttab name, archive); + release (archive); + FI; + font table (fonttab name); + IF multi user + THEN command dialogue (FALSE); + do ("save(""" + font tab name + """,task(""configurator""))") + FI; + forget (fonttab name, quiet); + + . reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop; + +. generate printer spool : + eumel must advertise; + cursor (1, 12); + putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - mu"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (4); + putline ("Generierung beendet, weiter mit 'SV'"); + generate printer server; + do (buffer); + +. generate printer server : + buffer := "break (quiet);"; + buffer CAT "spool manager (PROC printer);"; + buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;"; + buffer CAT "PROC printer:"; + buffer CAT " disable stop;"; + buffer CAT " continue (server channel);"; + buffer CAT " check error (error message);"; + buffer CAT " ds := nilspace;"; + buffer CAT " REP forget (ds);"; + buffer CAT " execute print;"; + buffer CAT " IF is error AND online THEN put error; clear error; FI;"; + buffer CAT " PER;"; + buffer CAT "END PROC printer;"; + buffer CAT "PROC execute print:"; + buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;"; + buffer CAT " enable stop;"; + buffer CAT " ds := nilspace;"; + buffer CAT " call (father, fetch code, ds, reply);"; + buffer CAT " IF reply = ack CAND type (ds) = file type"; + buffer CAT " THEN file := sequential file (input, ds);"; + buffer CAT " print (file,"; + buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,"; + buffer CAT " PROC (INT CONST, INT CONST) close,"; + buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);"; + buffer CAT " FI;"; + buffer CAT "END PROC execute print;"; + buffer CAT "PROC check error(TEXT CONST message):"; + buffer CAT " IF is error"; + buffer CAT " THEN clear error; rename myself (message);"; + buffer CAT " IF is error THEN end(myself) FI;"; + buffer CAT " pause (9000); end(myself);"; + buffer CAT " FI;"; + buffer CAT "END PROC check error;"; diff --git a/system/printer-9nadel/1986/src/printer.std b/system/printer-9nadel/1986/src/printer.std new file mode 100644 index 0000000..ec6bad6 --- /dev/null +++ b/system/printer-9nadel/1986/src/printer.std @@ -0,0 +1,431 @@ +PACKET std printer + +(************************************************************************) +(* Stand : 29.07.86 *) +(* STANDARD PRINTER Version : 4 *) +(* Autor : Rudolf Ruland *) +(************************************************************************) + + DEFINES open, + close, + execute, + + paper size : + +LET underline = 1, + bold = 2, + italics = 4, + reverse = 8, + + underline linetype = 1, + + c document = 1, + c page = 2, + + c write text = 1, + c write cmd = 2, + c carriage return = 3, + c move = 4, + c draw = 5, + c on = 6, + c off = 7, + c type = 8; + +INT VAR high, rest, blankbreite; +REAL VAR x size, y size; + +(*********************************************************************) + +paper size (8.0 * 2.54, 12.0 * 2.54); + +PROC paper size (REAL CONST x, y) : + + x size := x; + y size := y; + +END PROC paper size; + +PROC paper size : + + line; + putline ("Papierbreite = " + text (x size, 5, 2) + " cm = " + text (x size / 2.54, 5, 2) + " Zoll"); + putline ("Papierlaenge = " + text (y size, 5, 2) + " cm = " + text (y size / 2.54, 5, 2) + " Zoll"); + +END PROC paper size; + +(*********************************************************************) + +PROC open (INT CONST op code, INT VAR param1, param2) : + +SELECT op code OF + CASE c document : open document + CASE c page : open page +END SELECT; + + +. x steps : param1 +. y steps : param2 +. + open document : + x steps := x step conversion ( x size ); + y steps := y step conversion ( y size ); + out (off string (underline)); + out (off string (bold)); + out (off string (italics)); + out (off string (reverse)); + + +. x start : param1 +. y start : param2 +. + open page : + x start := 0; + y start := 0; + rest := 0; + out (""13""); + +END PROC open; + + +PROC close (INT CONST op code, INT CONST param1) : + +SELECT op code OF + CASE c document : close document + CASE c page : close page +END SELECT; + +. + close document : + + +. remaining y steps : param1 +. + close page : + remaining y steps TIMESOUT ""10"" + +END PROC close; + + +PROC execute (INT CONST op code, TEXT CONST string, INT CONST param1, param2) : + +SELECT op code OF + CASE c write text : write text + CASE c write cmd : write cmd + CASE c carriage return : carriage return + CASE c move : move + CASE c draw : draw + CASE c on : on + CASE c off : off + CASE c type : type +END SELECT + + +. from : param1 +. to : param2 +. + write text : + out subtext (string, from, to) + +. + write cmd : + out subtext (string, from, to) + + +(*. x steps to left margin : param1*) +. + carriage return : + rest := 0; + out (""13"") + + +. x steps : param1 +. y steps : param2 +. + move : + IF x steps < 0 OR y steps < 0 + THEN stop + ELIF x steps > 0 + THEN x move + ELIF y steps > 0 + THEN y move + FI; + + . x move : + high := (x steps + rest) DIV blankbreite; + rest := (x steps + rest) MOD blankbreite; + IF high > 0 THEN high TIMESOUT " " FI; + + . y move : + y steps TIMESOUT ""10"" + +. + draw : + IF x steps < 0 OR y steps <> 0 OR linetype <> underline linetype + THEN stop + ELSE x draw + FI + + . x draw : + high := (x steps + rest) DIV blankbreite; + rest := (x steps + rest) MOD blankbreite; + IF high > 0 THEN high TIMESOUT "_" FI; + + +. modification : param1 +. + on : + IF on string (modification) <> "" + THEN out (on string (modification)) + ELSE stop + FI + +. + off : + IF off string (modification) <> "" + THEN out (off string (modification)) + ELSE stop + FI + + +. font nr : param1 +. + type : + blankbreite := char pitch (font nr, " "); + out (font string (font nr)); + +END PROC execute; + + +END PACKET std printer; + + +PACKET print cmd for single user (* Autor : Rudolf Ruland *) + (* Stand : 18.02.86 *) + DEFINES print, + print channel : + +INT VAR pr channel; +TEXT VAR buffer; +FILE VAR print file; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + + +PROC print channel (INT CONST channel) : + + IF multi user THEN do ("serverchannel(" + text (channel) + ")" ) FI; + pr channel := channel; + +END PROC print channel; + +INT PROC print channel : pr channel END PROC print channel; + + +PROC print : + + print (last param) + +ENDPROC print ; + +PROC print (TEXT CONST file name) : + + INT CONST myself channel := channel (myself); + last param (file name) ; + print file := sequential file (input, file name) ; + continue (print channel) ; + disable stop ; + execute print ; + remember error message if neccessary; + IF multi user THEN do ("break (quiet)") FI; + continue (myself channel); + clear error; + put error message if neccessary; + + . remember error message if neccessary : + IF is error + THEN buffer := error message; + clear error; + ELSE buffer := ""; + FI; + + . put error message if neccessary : + IF buffer <> "" THEN errorstop (buffer) FI; + +ENDPROC print ; + +PROC execute print : + + enable stop ; + print (print file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +ENDPROC execute print ; + +ENDPACKET print cmd for single user; + +#page# +(******************************************************************) +(*** ***) +(*** Generierung des Printers ***) +(*** ***) +(******************************************************************) + +LET printer name = "printer.std", + up = ""3""13""5"" ; + +TEXT VAR fonttab name := "fonttab.std"; + +BOOL CONST multi user := (pcb (9) AND 255) <> 1; + +INT VAR pr channel; +TEXT VAR buffer; + +command dialogue (TRUE); +ask for print channel; +ask for paper format; +ask for font table; +load font table; +forget (printer name, quiet); +IF multi user THEN generate printer spool FI; +check on; +. + ask for print channel : + line; + put ("gib Druckerkanal:"); + get (pr channel); + print channel (pr channel); + line; +. + ask for paper format : + SELECT paper format OF + CASE 1 : papersize ( 8.0 * 2.54, 12.0 * 2.54) + CASE 2 : papersize (13.2 * 2.54, 12.0 * 2.54) + CASE 3 : papersize (21.0, 29.7) + END SELECT + + . paper format : + line; + REP out (up); + IF yes ("Papierformat : endlos, 8 Zoll breit") + THEN LEAVE paper format WITH 1 FI; + out (up); + IF yes ("Papierformat : endlos, 13.2 Zoll breit") + THEN LEAVE paper format WITH 2 FI; + out (up); + IF yes ("Papierformat : DINA 4") + THEN LEAVE paper format WITH 3 FI; + PER; + 0 +. + ask for font table : + line; + fonttab name CAT char pitch; + line; + fonttab name CAT language + + . char pitch : + REP out (up); + IF yes ("Zeichenbreite des Druckers : 10 Zeichen pro Zoll") + THEN LEAVE char pitch WITH "-10" FI; + out (up); + IF yes ("Zeichenbreite des Druckers : 12 Zeichen pro Zoll") + THEN LEAVE char pitch WITH "-12" FI; + PER; + "" + + . language : + REP out (up); + IF yes ("Zeichensatz des Druckers : deutsch") + THEN LEAVE language WITH "" FI; + out (up); + IF yes ("Zeichensatz des Druckers : ascii") + THEN LEAVE language WITH ".ascii" FI; + PER; + "" +. + load font table : + IF NOT exists (fonttab name) + THEN command dialogue (TRUE); + REP line (2); + putline ("Bitte Archiv mit der Fonttabelle """ + + fonttab name + """ einlegen!"); + line; + UNTIL yes ("Archiv eingelegt") PER; + reserve archive; + fetch (fonttab name, archive); + release (archive); + FI; + font table (fonttab name); + IF multi user + THEN command dialogue (FALSE); + do ("save(""" + font tab name + """,task(""configurator""))") + FI; + forget (fonttab name, quiet); + + . reserve archive : + INT VAR p1, p2; + archive (" "31" "); + disable stop; + list (archive); + IF is error + THEN buffer := errormessage; + p1 := pos (buffer, """", 1 ) + 1; + p2 := pos (buffer, """", p1) - 1; + IF p1 > 0 AND p2 > 0 + THEN clear error; + buffer := subtext (buffer, p1, p2); + archive (buffer); + FI; + FI; + enable stop; + +. generate printer spool : + eumel must advertise; + cursor (1, 12); + putline ("In allen bestehenden Tasks - insbesondere in der Task ""PUBLIC"" - mu"); + putline ("die Fonttabelle mit dem Kommando"); + line; + putline (" font table (""" + font tab name + """)"); + line; + putline ("eingestellt werden!!!"); + line (4); + putline ("Generierung beendet, weiter mit 'SV'"); + generate printer server; + do (buffer); + +. generate printer server : + buffer := "break (quiet);"; + buffer CAT "spool manager (PROC printer);"; + buffer CAT "INT VAR reply; DATASPACE VAR ds; FILE VAR file;"; + buffer CAT "PROC printer:"; + buffer CAT " disable stop;"; + buffer CAT " continue (server channel);"; + buffer CAT " check error (error message);"; + buffer CAT " ds := nilspace;"; + buffer CAT " REP forget (ds);"; + buffer CAT " execute print;"; + buffer CAT " IF is error AND online THEN put error; clear error; FI;"; + buffer CAT " PER;"; + buffer CAT "END PROC printer;"; + buffer CAT "PROC execute print:"; + buffer CAT " LET ack = 0, fetch code = 11, file type = 1003;"; + buffer CAT " enable stop;"; + buffer CAT " ds := nilspace;"; + buffer CAT " call (father, fetch code, ds, reply);"; + buffer CAT " IF reply = ack CAND type (ds) = file type"; + buffer CAT " THEN file := sequential file (input, ds);"; + buffer CAT " print (file,"; + buffer CAT " PROC (INT CONST, INT VAR, INT VAR) open,"; + buffer CAT " PROC (INT CONST, INT CONST) close,"; + buffer CAT " PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute);"; + buffer CAT " FI;"; + buffer CAT "END PROC execute print;"; + buffer CAT "PROC check error(TEXT CONST message):"; + buffer CAT " IF is error"; + buffer CAT " THEN clear error; rename myself (message);"; + buffer CAT " IF is error THEN end(myself) FI;"; + buffer CAT " pause (9000); end(myself);"; + buffer CAT " FI;"; + buffer CAT "END PROC check error;"; diff --git a/system/ruc-terminal/unknown/doc/BIOSINT.PRT b/system/ruc-terminal/unknown/doc/BIOSINT.PRT new file mode 100644 index 0000000..69006b6 --- /dev/null +++ b/system/ruc-terminal/unknown/doc/BIOSINT.PRT @@ -0,0 +1,281 @@ +#type ("17.klein")# +Interrupts/Traps/Exeptions (Bios) 29.04.87 + +Interrupt: IRQn (Durch Hardware ausgelst, werden auf Traps umgelenkt) +Trap : INTn (Durch Software ausgelst) +Exeption : INTn (Im Protected Mode vom Prozessor ausgelst) + +Traps | Funktion +--------+------------------------------------------------------------------ +INT 00H : Abort Program +INT 01H : +INT 02H : NMI-Routine (Parity-Check & Power-Fail & Redirected from INT 75H) +INT 03H : INT3 - Break +INT 04H : INTO - Overflow +INT 05H : Print Screen +INT 06H : +INT 07H : +INT 08H : IRQ0 System Interrupt +INT 09H : IRQ1 Keyboard Buffer full +INT 0AH : Software redirected from IRQ9 +INT 0BH : IRQ3 Serial Port 2 +INT 0CH : IRQ4 Serial Port 1 +INT 0DH : IRQ5 Parallel Port 2 +INT 0EH : IRQ6 Diskette Interrupt +INT 0FH : IRQ7 Parallel Port 1 + +INT 10H : Video Trap + ah = 00H : set mode (al = mode) + (Videoram: Herkules: B0000 + EGA : B8000) + al | Tx/Gr| Pixel | Zeichen | Monitor | Farbe | Seiten + ---+------+-------+---------+---------+-------+-------- + 00 | Text |640x200| 40 x 25 | Mono/Col| 16/64*| 8 + 01 | Text |640x200| 40 x 25 | Color | 16/64*| 8 + 02 | Text |640x200| 80 x 25 | Mono/Col| 16/64*| 8 + 03 | Text |640x200| 80 x 25 | Color | 16/64*| 8 + 04 | Graf |320x200| 40 x 25 | Mono/Col| 4 | 1 + 05 | Graf |320x200| 40 x 25 | Mono/Col| 4 | 1 + 06 | Graf |640x200| 80 x 25 | Mono/Col| 2 | 1 + 07 | Text |720x348| 80 x 25 | Mono | 4 | 8 + 08 | Graf |720x348| 90 x 48 | Mono | 2 | 1 + --------- ab hier nicht implementiert, nur EGA ------------------ + VideoRAM-Adresse A0000 + 0D | Graf |320x200| 40 x 25 | Color | 16 | 8 + 0E | Graf |640x350| 80 x 25 | Color | 16 | 4 + 0F | Graf |640x350| 80 x 25 | Mono | 4 | 2 + 10 | Graf |640x350| 80 x 25 | Enhanced| 16/64*| 2 + * mit EGA-Monitor + ah = 01H : set cursor type (Eingang: CH, CL Werte 0..31) + CH=Startzeile des Cursorblocks, CL=Endzeile des Cursorblocks + ah = 02H : set cursor pos (BH = Page, DL = Spalte, DH = Zeile) + ah = 03H : read cursor + Ausgang: BH=Page, DL=Spalte, DH=Zeile, CL=Starzeile des + Cursorblocks, CH=Endzeile des Cursorblocks + ah = 04H : read lightpen + Ausgang: AH=1 : Register sind gltig, AH=0: Taste nicht gedrckt + DH = Zeile, DL = Spalte des Lightpens + CH=Rasterlinie (1..199), CX=Rasterlinie (1..349) + BX = Rasterspalte (1..319/1..639) + ah = 05H : set actual display (AL = Neue Seite) + ah = 06H : scroll up + AL = 0: Fenster lschen, sonst Anzahl Zeilen zu scrollen + CH, CL = linke obere Ecke des Scroll-Windows + DH, DL = rechte untere Ecke des Scroll-Windows + BH = Attribut fuer die Leerzeilen + ah = 07H : scroll down + AL = 0: Fenster lschen, sonst Anzahl Zeilen zu scrollen + CH, CL = linke obere Ecke des Scroll-Windows + DH, DL = rechte untere Ecke des Scroll-Windows + BH = Attribut fuer die Leerzeilen + ah = 08H : read current attribute and char + Ausgang: BH=Anzeigeseite, AL=Zeichen, AH=Attribut (nur Alpha) + ah = 09H : write current attribute and char + BH=Anzeigeseite, CX=Anzahl Zeichen, AL=Zeichen, BL=Attribut/Farbe + ah = 0AH : write current attribute and char + BH=Anzeigeseite, CX=Anzahl Zeichen, AL=Zeichen + ah = 0BH : set color (BH=Palettenfarbe 0..127, BH=Farbwert) + ah = 0CH : write dot + BH=Seite, DX=Zeile, CX=Spalte, AL=Farbwert (falls Bit 7=1, wird + alte Farbe mit neuer Farbe geXORed) + ah = 0DH : read dot (BH=Seite, DX=Zeile, CX=Spalte, AL=Punktfarbwert) + ah = 0EH : write tty (Zeichen schreiben, AL=Zeichen, BL=Farbe) + ah = 0FH : video state (Ausgang: AL=Video-Mode (0..8), AH=Anzahl + Zeichenspalten, BH=Seite) + ah = 10H : reserved (EGA-Bios: Write Palette/Overscan/Intensity/Flash) + ax = 1142H: draw line (EGA-Bios: 12 Routinen fr den Charactergenerator) + CX=X-pos-from, DX= Y-pos-from, BP=X-pos-to, DI=Y-pos-to + ah = 12H : reserved (EGA-Bios: Alternate Characterset) + ah = 13H : write string + Allgemein: + ES:BP = Stringanfang + CX = Stringlnge + DL, DH = Cursorposition (Stringanfang) + BH = Seite + al = 0: BL=Attribut, String: CHAR, CHAR, CHAR,...,Cursor wird nicht + bewegt. + al = 1: BL=Attribut, String: CHAR, CHAR, CHAR,..., Cursor wird bewegt. + al = 2: String: CHAR, ATTR, CHAR, ATTR,..., Cursor wird nicht bewegt. + al = 3: String: CHAR, ATTR, CHAR, ATTR,..., Cursor wird bewegt. + +INT 11H : Equipment Trap (Ausgang: AX = Equipment Flag) + AX : + Bit 1 : 80287 installiert + Bit 3 : Herkules installiert + Bit 4/5 : 0 = No Primary Display set + 1 = Monochrome + 2 = Color 80 * 25 + 3 = EGA + Bit 6 : Drive B installiert + Bit 9..12 : Anzahl RS232 + Bit 14/15 : Anzahl Printer + +INT 12H : Memory Size Trap (Ausgang: AX = Memorysize in KB) + +INT 13H : Hardisk Trap + Allgemein: + DL = Drive (0, 1...) + AL = Sector count + CX = Bit 0... Bit 5 = Sector + Bit 6... Bit 15 = Cylinder + Exit: AH = 0 ok, <> 0 Fehler (z.b. in hf_error nachsehen) + ah = 0 reset diskette, wd1010, hdisks + ah = 1 return status + ah = 2 read + ah = 3 write + ah = 4 verify + ah = 5 format + ah = 8 drive params + ah = 9 init drive + ah = A read long + ah = B write long + ah = C seek + ah = D reset wd1010 (DL = Drive) + ah =10 ready test + ah =11 reclibrate + ah =14 check controller + ah =15 read dasd (stacktop 2 words: anzahl sektoren der platte) + +INT 14H : RS232C Trap + Allgemein: dx = port (>= 1FE0H : SCC = 8530) + ah = 0 : Init + al : Bit 5..7 = Baudrate + 000 = 110, + 001 = 150, + 010 = 300, + 011 = 600, + 100 = 1200, + 101 = 2400, + 110 = 4800, + 111 = 9600, + Bit 3..4 = Parity (no, odd, even) + Bit 2 = Stopbits (1, 2) + Bit 0..1 = Datenbits (5, 6, 7, 8) + ah = 1 : Send (al = Zeichen, Ausgang: ah=80H Timeout, Zeichen dann in al) + ah = 2 : Read (Ausgang: ah=80H:Timeout, sonst ah=Statusregister,al=Zeichen) + ah = 3 : Status (Ausgang: Nur 8250: al = Modemstatus) + ah : Bit 0 = 1 : Data available + Bit 1 = 1 : Receiver overrun + Bit 2 = 1 : Parity Error + Bit 3 = 1 : Framing Error + Bit 4 = 1 : Transmitter empty + Bit 5 = 1 : Break received + +INT 15H : Utility Trap + ah = 80H open device (nicht implementiert) + ah = 81H close device (nicht implementiert) + ah = 82H prog term (nicht implementiert) + ah = 83H event wait (Eingang: CX=RTCtmr high, DX=RTCtmr high, ES:BX=userflag) + Ausgang: CY=0, Event wait wurde aktiviert + CY=1, Noch kein RTC-Event aufgetreten + (INT 15H periodisch aufrufen zum pollen) + ah = 84H joy stick (Eingang: DX) + DX = 0: Ausgang: AL (Bits 4..7) = Buttons + DX = 1: Ausgang: AX=Xa, BX=Ya, CX=Xb, DX=Yb + ah = 85H sys request (nicht implementiert) + ah = 86H wait a moment (CX=RTCtimer high, DX=RTCtimer low) + ah = 87H block move (extended memory) (Eingang: CX: Words, ES:SI = Block + Descriptoren: 8 Bytes Source, 8 Bytes Destination) + ah = 88H extended memory (Ausgang: AX= KB extended Memory) + ah = 89H enter protected mode + ax = 8A42H run setup + ax = 8B42H error beep + ax = 8C42H usr-powerfail-shutdown-routine + (Benutzerdaten knnen von ES:0 bis ES:BACK_SYS abgelegt werden) + ax = 8D42H usr-powerfail-resume-routine + (Benutzerdaten knnen von ES:0 bis ES:BACK_SYS geholt werden) + ax = 8E42H set timer (Eingang: BL = Timer (0, 1, 2), CX = Countervalue + BH: Bit 0 = BCD, Bit 1..3 = Mode, + Bit 4..5 Write CMD, Bit 6/7 unused) + (Timer wird bei Resume wieder so initialisert) + ax = 8F42H hardcopy (Grafik & Mono) + ah = 90H device busy (nicht implementiert) + ah = 91H set int complete (nicht implementiert) + ah = 9242H backup memory (CX=Anzahl Bytes, DS:SI = Sourceadr, E000H:DI + = Destinationadr.) + ah = 9342H restore memory (CX=Anzahl Bytes, E000H:SI = Sourceadr, ES:DI = + Destinationadr.) +INT 16H : Keyboard Trap + ah = 00 Ascii read (Ausgnag: AX=Zeichen CY=1, sonst CY=0) + ah = 01 Ascii status (Ausgang: ZF = 0 : Zeichen in Queue) + ah = 02 Shift status (Ausgang: AL = KB_flag) + ax = 0342 set typematic (Ausgang: BL = Rate, BH = Delay) + ax = 0442 soft power down + +INT 17H : Printer Trap + Allgemein: dx = port + ah = 0 : print char (Eingang: al = Char, Ausgang: ah = Printer Status) + ah = 1 : init printer port + ah = 2 : ah = Status + +INT 18H : Basic (nicht implementiert) + +INT 19H : Bootstrap Trap + Block 0 von Harddisk oder Floppy --> ES:BX laden und starten (Booting...) + Der Block hat in Bytes 510/511 das Kennzeichen AA55H. + +INT 1AH : Time of day Trap + ah = 0 : Read Timer (Ausgang: CX=Timer low, DX=Timer high, AL<>0:Overflow) + ah = 1 : Set Timer (CS=Timer low, DX=Timer high) + ah = 2 : Read Clock (Ausgang: DH = Sec, CL = Min, CH = Std) + ah = 3 : Set Clock (DL=Sommerzeit (01), DH=sec, CL=Min, CH=Std) + ah = 4 : Read Date (DL=Day, DH=Month, CL=Year, CH=Century) + ah = 5 : Set Date (DL=Day, DH=Month, CL=Year, CH=Century) + ah = 6 : Set Alarm (DH=Sec, CL=Min, CH=Std) + ah = 7 : Reset Alarm + +INT 1BH : Dummy Return + +INT 1CH : User Timer Tic, wird einmal pro Sekunde aufgerufen. + +INT 1DH : Zeigt auf die Video Parameter +INT 1EH : Zeigt auf Disk_base (DF, 02, 25, 02, 0F, 1B, FF, 54, F6, 0F, 08) +INT 1FH : Pointer auf Zeichensatz mit Zeichen 128..255 + +INT 20H ... INT 3FH sind fr das Betriebssystem reserviert. + +INT 20H : DOS: Terminate Program +INT 21H : DOS: Function Call +INT 22H : DOS: +INT 23H : DOS: +INT 24H : DOS: +INT 25H : DOS: + +INT 40H : Diskette Trap + AH = 0 disk reset + AH = 1 disk status (ret) + AH = 2 disk read (ES:BP = Pointer auf Buffer, DI = Anzahl Sektoren, + DH = Head, DL = Drive, CL = Sektor, CH = Cylinder) + AH = 3 disk write " + AH = 4 disk verify " + AH = 5 disk format " + AH = 21 disk type (Ausgang: BL (Bit 0..3) 0=360K, 1/2 = 1.2MB) + AH = 22 disk change + AH = 23 format set + +INT 44H : Pointer auf weiteren Zeichensatz (Nur von EGA-Bios untersttzt) + +INT 4AH : Fr User software redirected from RTC-IRQ (Alarm, periodic) + +INT 60H + ... User +INT 6FH + +Hardware-Interrupts 8..15: +INT 70H : IRQ 8 RTC-Interrupt +INT 71H : IRQ 9 Software Redirected to INT 0AH +INT 72H : IRQ10 Frei +INT 73H : IRQ11 Frei +INT 74H : IRQ12 Frei +INT 75H : IRQ13 Coprozessor, Software Redirected to NMI (INT 02H) +INT 76H : IRQ14 Harddisk Interrupt +INT 77H : IRQ15 Frei + +INT 78H : User 0 +INT 79H : User 1 +INT 7AH : User 2 +INT 7BH : User 3 +INT 7CH : User 4 +INT 7DH : User 5 +INT 7EH : User 6 +INT 7FH : User 7 diff --git a/system/ruc-terminal/unknown/doc/MACROS.PRT b/system/ruc-terminal/unknown/doc/MACROS.PRT new file mode 100644 index 0000000..70961ce --- /dev/null +++ b/system/ruc-terminal/unknown/doc/MACROS.PRT @@ -0,0 +1,54 @@ +#*t ($1)# +#topage("$1")# +#*macroend# + + +#*linie ($1)# +#rpos($1)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# +#clearpos# +#*macroend# + + + +#*k ($1, $2)# +#type("8")##center##ib(3)#$1 $2#ie(3)##type("elite")# +#*macroend# + + + + + +#*h ($1, $2)# +#type("8")##center##on("i")##on("u")##ib(3)#$1 $2#ie(3)##off("u")##off("i")##type("elite")# +#headodd# +#center##on("b")#$1 $2#off("b")# + + + +#end# +#*macroend# + + + + + +#*kopf ($1)# +#headeven# +#center##on("b")#$1#off("b")# + + + +#end# +#bottomodd# + + + +#end# +#bottomeven# + + +#right# +#end# +#*macroend# diff --git a/system/ruc-terminal/unknown/doc/TDOC.PRT b/system/ruc-terminal/unknown/doc/TDOC.PRT new file mode 100644 index 0000000..f1595c8 --- /dev/null +++ b/system/ruc-terminal/unknown/doc/TDOC.PRT @@ -0,0 +1,3012 @@ +#type ("elite")##limit (16.2)##block# + +#type ("8")##center##on("b")##on("u")#Bedienungshandbuch zum ruc - Graphikterminal#off("u")##off("b")##type ("elite")# + +#center#Version 1.1 + +#center#Oktober 1986 +#free (16.0)# +ruc - Rolf Uhlig Computer +GmbH & Co Kommanditgesellschaft +Sendenhorster Strae 82 +D - 4406 Drensteinfurt 1 +Telefon 02508/8500 + +Michael Staubermann +Mornenstrae 29 +D - 4400 Mnster-Hiltrup +Telefon 02501/4320 +#pagenr (""224"", 1)##page (1)# +#kopf ("Bedienungshandbuch zum ruc - Graphikterminal")# +#h("1.", "Einige Worte zuvor")# + + +Dieses Terminalprogramm wird in zwei Versionen (fr den Basis 108 und den +Apple IIe) geliefert. Die Version ist in der Kommandozeile erkenntlich +(BASIS oder APPLE). + +Eigenschaften des Terminals: + +- Kommandozeilen fr schnelle Offline Parametereinstellung +- Statuszeile fr spezielle Betriebzustnde +- ber 70 programmierbare Funktionstasten +- Druckerspooler 32k (4 ganze Graphikhardcopys und noch mehr) +- 7935 Zeichen Empfangspuffer +- Verschiedene Hardcopy Modi fr Text und Graphik +- 192x280 Punkte auflsender Graphikmodus mit zwei Helligkeitsstufen +- Zwei Graphikseiten mit getrennter Anzeige/Bearbeitung +- Viele Graphikroutinen (Bogen, Flchenfllung, Kreis, Rechteck...) +- Graphikmodus fr Texte in verschieden Richtungen, Dicken, Grssen +- Griechische Graphikzeichen und Kursivschrift +- Graphikseiten Scrollen, Mischen, vom Host laden, zum Host schicken + + +Zum Handbuch + +Tasten werden durch Angabe ihres Aufdruckes in Grossbuchstaben angegeben und +in spitze Klammern gesetzt (z.B. ) in einigen Fllen auch durch ihren +Namen (z.B. oder ). Eine zustzlich zu bettigende Umschalt- +taste, wie SHIFT, CTRL, OPEN APPLE (kurz: OA) oder beide zusammen, wird in +der Klammer davorgestellt (z.B. ). + +Nicht druckbare Ascii-Codes (z.B. oder ), sowie Kommandopara- +meter (z.B. ) werden ebenfalls in spitze Klammern gesetzt. Komandopara- +meter werden mit Kleinbuchstaben bezeichnet. + +#page# +#h("2.", "Die Hardware")# + + +Untersttzt wird eine 80-Zeichen Textanzeige, ein Basiskeyboard oder ein +Applekeyboard mit Open-Apple Taste. Am Basis kann ein Drucker angeschlossen +werden. + + +#k("2.1", "Die serielle Schnittstelle")# + +Die Parameter der seriellen Schnittstelle knnen vom Host oder vom Terminal +(LOCAL) eingestellt werden (Siehe Kommando ). Es wer- +den alle 15 gngigen Baudrates zwischen 50 und 19200 Baud untersttzt. Pari- +tycheck kann mit gerader oder ungerader Paritt durchgefhrt werden. Flu- +kontrolle ist in allen Kombinationen aus RTS/CTS, DTR/DSR, XON/XOFF mglich. +Empfohlen wird DTR/DSR oder XON/XOFF. + + Bentigte Verdrahtung der seriellen Schnittstelle + + Pin Prioritt + 2 : TXD Sendedaten zum Host (RXD) 1 + 3 : RXD Empfangsdaten vom Host (TXD) 1 + 4 : RTS Ready To Send zum Host (CTS) 3 + 5 : CTS Clear To Send vom Host (RTS) 3 + 6 : DSR DataSet Ready vom Host (DTR) 2 + 7 : Masse an Host Masse 1 + 8 : DCD Eingang, nicht bentigt + 20 : DTR Data Terminal Ready zum Host (DSR) 2 + +Prioritt: + 1 : Mu verdrahtet werden + 2 : Ist bei DSR/DTR Flukontrolle zu verdrahten + 3 : Ist bei RTS/CTS Flukontrolle zu verdrahten + +Der Datentransfer geschieht in der Regel mit 8 Datenbits. Sollte der Host +nur ber 7 Bit Datentransfer verfgen, mssen einige Einschrnkungen bei der +Parameterbergabe von Uploads/Downloads gemacht werden (Kein Farbbit). Die +Anzahl der Datenbits kann auch in der Kommandozeile verndert werden. + + +#k("2.2", "Der Reset")# + +Ein Reset bringt das Terminal in einen definierten Zustand. Alle Bildschirm- +seiten und Puffer, sowie der Druckerspooler werden gelscht. Der Reset kann +vom Host durch + + #ib(1)# 0#ie(1)# (Hex 1B 30) + +initiiert werden, vom Basiskeyboard aus durch . Die Para- +meter in der Kommandozeile werden dem Setup entnommen. Nach dem Lschen +aller Bildschirmseiten, wird das Makro mit dem Code Hex EF aufgerufen. Dies +ist die Funktionstaste . + +#page# +#h("3.", "Die Kommandozeile")# + + +Die wichtigsten Parameter des Terminals knnen im laufenden Betrieb in den +beiden Kommandozeilen gendert werden. Die erste Kommandozeile erscheint +beim Basiskeyboard durch Drcken von und beim Apple durch . + +Im Graphikmodus ersetzt die Kommandozeile die untersten 32 Graphikzeilen +(entspricht vier Textzeilen). Man hat also auch im Graphikmodus die Mg- +lichkeit wichtige Parameter in der Kommandozeile zu ndern. + +Die angezeigten Einstellungen bieten auerdem eine Informationsmglichkeit +ber die aktuellen Parameter der seriellen Schnittstelle u.s.w. Die zweite +Kommandozeile enthlt die Parameter der seriellen Schnittstelle. + +Alle in den Kommandozeilen angezeigten Parameter (bis auf BELL ON/BELL OFF) +knnen auch durch ESC-Kommandos vom Host oder im Localmodus gendert wer- +den. +Ein laufender Druckvorgang wird unterbrochen, solange die Kommandozeilen +sichtbar sind. + + +#k("3.1", "Tastenfunktionen in der Kommandozeile")# + +Folgende Tasten haben in der Kommandozeile eine Wirkung: + +Taste Bedeutung +#linie ("16.2")# + oder Wechselt in die jeweils andere Kommandozeile + + Springt zum vorherigen (linken) Parameter ohne etwas zu + verndern. + + Springt zum nchsten (rechten) Parameter ohne etwas zu + verndern. + + ndert das selektierte Parameterfeld. Das selektierte + Parameterfeld ist durch Invertierung hervorgehoben. Die + mglichen Parameter wiederholen sich zyklisch. + + Die Kommandozeile wird verlassen. Es werden keine nde- + rungen durchgefhrt. + + Die Kommandozeile wird verlassen. Vorher werden alle + nderungen permanent auf die Diskette geschrieben. Wei- + tere Einzelheiten s.u. (Setup) + + Alle Parameter werden auf ihre Defaultwerte zurckge- + setzt. Die Kommandozeile wird noch nicht verlassen, daher + kann dieser 'Reset' durch wieder aufgehoben werden. + oder Die Kommandozeile wird verlassen. Die + nderungen werden nur im Speicher vermerkt. Nach dem + Ein-/Ausschalten des Rechners werden die alten Parameter + von der Diskette gelesen. Wird allerdings ein Hardware- + reset (s.o.) durchgefhrt, sind diese nderungen nicht + verloren. + + +#k("3.2", "Setup")# + +Beim Setup, der in der Kommandozeile durch ausgelst werden kann, +werden wichtige Parameter auf die Diskette geschrieben. Sie werden dann +'permanent' und mssen nach dem Einschalten des Terminals nicht neu einge- +stellt werden. Diese Parameter sind die +- Parameter der seriellen Schnittstelle (2. Kommandozeile) +- anderen Parameter der Kommandozeilen +- vom Benutzer programmierte Belegung der Funktionstasten +- Druckerspezifischen Hardcopyparameter + +Vor dem Setup ist zu prfen, ob der Diskettenschreibschutz entfernt wurde +(Klebeschildchen an der Diskettenseite entfernen). Der Schreibschutz sollte +nach dem Setup wieder angebracht werden. Wurde der Schreibschutz nicht ent- +fernt, wird eine Meldung 'Diskettenschreibschutz entfernen !' angezeigt. In +diesem Falle erscheint nach dem Drcken einer Taste wieder die Kommando- +zeile. +Wenn keine Diskette einliegt oder ein harter Schreibfehler auftritt, er- +scheint die Meldung 'Setup kann nicht geschrieben werden (Diskettenfeh- +ler)!'. Weitere Schreibversuche sind mglicherweise erfolgreich. + + +#k("3.3", "Die zweite Kommandozeile")# + +Beim Basis (erste Zeile zeigt Defaultwerte fr ) + +#type ("micron")# +GER|BASIS|MON OFF|PRT OFF|SCRN ON |KEY CLK|NORVID|SCROLL|BELL ON |CUR FLH|F STRG +USA TVI MON ON PRT ON SCRN OFF CLK OFF REVVID PAGE BELL OFF CUR STD F CODE +APL HEX ON CUR OFF +UNI +#type ("elite")# + +Beim Apple (erste Zeile zeigt Defaultwerte fr ) + +#type ("micron")# +USA|APPLE|MON OFF|PRT OFF|SCRN ON |KEY CLK|NORVID|SCROLL|BELL ON |CUR FLH|F STRG +FLH TVI MON ON PRT ON SCRN OFF CLK OFF REVVID PAGE BELL OFF CUR STD F CODE + HEX ON CUR OFF +#type ("elite")# + + +Default Andere Funktion +#linie ("16.2")# +Basis + GER USA Die Zeichensatzeinstellung ist fr die gebruchlichsten + APL vier Zeichenstze in der Kommandozeile mglich. + UNI GER = Deutsch Ascii, USA = US Ascii, APL = APL-Zeichensatz + UNI = Deutscher Zeichensatz mit inversen APL Zeichen. Der + APL-Zeichensatz enthlt auch die Zeichen [\]{|}~. ber + ESC-Kommandos lassen weitere Mglichkeiten einstellen. + + BASIS TVI Keyboard Emulation. BASIS sendet die Funktionstastencodes + mit Bit 7 = 1. TVI sendet fr jede Funktionstaste eine + Zeichenfolge x . Die Cursortasten sowie DEL CHAR, + INS CHAR, DEL LINE, INS LINE werden wie bei TVI blich + gesendet. Weiter Einzelheiten s.u. (TVI-Emulation) + +Apple + USA FLH USA = US Ascii, FLH = Voller Ascii Zeichensatz mit Blinken + und Invers. + + APPLE TVI Keyboard Emulation. APPLE fhrt keine Codeumsetzung durch. + Wird allerdings die -Taste mit einer anderen + Taste zusammen gedrckt, wird das Bit 7 im Code auf 1 ge- + setzt. Zur TVI-Emulation siehe oben. + +MON OFF MON ON Der Monitor Modus wird mit MON ON eingeschaltet. In diesem + HEX ON Modus werden alle Steuerzeichen auf dem Bildschirm mar- + kiert ausgegeben. Bis auf die Kommandos u oder + X (um den Monitormodus auszuschalten) werden keine Komman- + dos interpretiert. Alle anderen Zeichen werden unverndert + dargestellt. Der Monitormodus kann auch durch MON OFF aus- + geschaltet werden. + Im Hexmodus werden keine Zeichen, sondern deren Ascii- + Codes in Hexadezimaldarstellung ausgegeben. + +PRT OFF PRT ON Parallele Druckerausgabe. Ist PRT ON eingeschaltet, werden + alle Zeichen die von der seriellen Schnittstelle kommen, + auf dem Drucker ausgegeben bzw. in den Druckerspooler ge- + schrieben. Die Bildschirmausgabe wird hiervon nicht beein- + flut. + +SCRN ON SCR OFF Bildschirmausgabe an/aus. Ist SCRN ON eingeschaltet, wer- + den alle Zeichen die von der seriellen Schnittstelle kom- + men, auf dem Bildschirm ausgegeben. SCR OFF und PRT ON kann + zum Beispiel benutzt werden, um Daten nur an den Drucker zu + schicken, ohne da diese auch auf dem Bildschirm erschei- + nen. + +KEY CLK CLK OFF Tastaturklick an/aus. Ist KEY CLK eingeschaltet, gibt jede + Taste (bis auf SHIFT, CTRL) bei ihrer Bettigung einen Ton + (Klick) von sich. CLK OFF schaltet dies ab. + +NORVID REVVID Bildschirmdarstellung. NORVID stellt hellen Text auf + schwarzem Grund dar, REVVID stellt schwarzen Text auf hel- + lem Grund dar (Mglicherweise angenehmer fr die Augen). + +SCROLL PAGE Ist SCROLL eingeschaltet, wird der Bildschirm um eine Zeile + nach oben geschoben, sobald der Cursor in der letzten Bild- + schirmzeile steht und ein Zeilenvorschub ausgefhrt + werden soll. Die erste Bildschirmzeile verschwindet. Ist + PAGE eingeschaltet, springt der Cursor in einer solchen + Situation in die erste Bildschirmzeile. Die Cursorspalte + wird dabei nicht verndert. + +BELL ON BELL OFF Normalerweise erzeugt jedes empfangene einen kur- + zen Signalton. Wenn das strt, kann die Tonausgabe mit BELL + OFF abgeschaltet werden. + +CUR FLH CUR STD Cursordarstellung. CUR FLH zeigt einen blinkenden CUR OFF + Cursorblock. CUR STD zeigt einen nichtblinkenden Cursor- + block. CUR OFF schaltet den Cursor ab (unsichtbar). + +F STRG F CODE Funktionstastenbelegung. Ist F STRG eingeschaltet, erzeugt + eine programmierte (belegte) Funktionstaste keinen Tasten- + code, sondern sendet die programmierten Zeichen. Eine unbe- + legte Funktionstaste sendet ihren Tastencode. Ist F CODE + eingeschaltet, erzeugen auch belegte Funktionstasten einen + Tastencode und senden keine programmierten Zeichen. + + +#k("3.4", "Die zweite Kommandozeile")# + +Die erste Zeile zeigt Defaultwerte fr : + +#type ("micron")# +STATOFF|TXT| 9600|STOP 1|DATA 8|NO PAR|NO XONOFF|NO RTSCTS|NO DTRDSR +STAT ON GFX 19200 STOP 2 DATA 7 EVN PAR XON/XOFF RTS/CTS DTR/DSR + 50 ODD PAR + 75 + 109.9 + 134.6 + 150 + 300 + 600 + 1200 + 1800 + 2400 + 3600 + 4800 + 7200 +#type ("elite")# + +Default Andere Funktion +#linie ("16.2")# +STATOFF STAT ON Anzeige der Statuszeile. Der Arbeitsbereich des Bildschirms + betrgt zwar immer 24 Zeilen, allerdings ist bei STAT ON + anstelle der 24. Textzeile die Statuszeile sichtbar. Bei + STATOFF wird der aktuelle Inhalt der 24. Textzeile sicht- + bar. Einzelheiten s.u. (Die Statuszeile) + +TXT GFX Textmodus/Graphikmodus. TXT schaltet in die 80x24 Zeichen + Textdarstellung um. GFX schaltet auf die aktuelle Graphik- + seite um. + +9600 19200 Whlt die Baudrate fr die serielle Schnittstelle. + 50 Die Angabe erfolgt in Bits/Sekunde (Baud) + 75 + 109.9 + 134.6 + 150 + 300 + 600 + 1200 + 1800 + 2400 + 3600 + 4800 + 7200 + +STOP 1 STOP 2 Whlt die Anzahl der Stopbits fr die serielle Schnitt- + stelle. + +DATA 8 DATA 7 Whlt die Anzahl der Datenbits fr die serielle Schnitt- + stelle. + +NO PAR EVN PAR Whlt Parity Check Art. NO PAR = Kein Parittsbit, keine + ODD PAR Parittsprfung. EVN PAR = Gerade Paritt, ODD PAR = Unge- + rade Paritt. + +NO XONOFF Whlt XON (CTRL Q) und XOFF (CTRL S) als Protokoll fr die + XON/XOFF serielle Schnittstelle. Wird XOFF vom Host gesendet, kann + das Terminal noch 255 Zeichen empfangen, bis der Empfangs- + puffer berluft. Mit NO XONXOFF wird dieses Protokoll + ausgeschaltet. + +NO RTSCTS Whlt RTS/CTS als Protokoll fr die serielle Schnittstel- + RTS/CTS le. Mit NO RTSCTS wird dieses Protokoll ausgeschaltet. + +NO DTRDSR Whlt DTR/DSR als Protokoll fr die serielle Schnittstel- + DTR/DSR le. Mit NO DTRDSR wird dieses Protokoll ausgeschaltet. + +#page# +#h("4.", "Die Statuszeile")# + + +Die Statuszeile enthlt 5 Felder, die ber die wichtigsten Betriebszustnde +des Terminals Auskunft geben. Die Statuszeile ersetzt die (dann in den 'Hin- +tergrund' verlegte) 24. Zeile. Die Statuszeile kann in der Kommandozeile mit +STAT ON oder vom Host oder im Local Modus mit + + #ib(1)# }#ie(1)# (Hex 1B 7D) + +eingeschaltet werden. Ausschalten ebenso mit STATOFF oder + + #ib(1)# {#ie(1)# (Hex 1B 7B) + +Die Zuordnung der Felder: + +#type ("micron")# +Spooler | Empfngerpuffer | Senderpuffer | Bereit/Beschftigt | Local/Online +#type ("elite")# + +Kritische Zustnde werden invers markiert. Dies sind alle Flle, in denen +ein Puffer berluft. +Ist dies beim Empfangspuffer der Fall (RX FULL), gehen Daten verloren. +Sollte der Druckerpuffer voll sein (PR FULL) und das Terminal keine Eingabe +mehr annehmen, kann man durch lngeres Drcken von Zeichen aus +dem Druckerpuffer entfernen, damit wieder Platz frei wird. +Sollte der Senderpuffer voll sein (TX FULL), so liegt das wahrscheinlich +daran, da der Host kein XON gesendet hat oder dieses falsch bertragen +wurde. Durch Drcken von kann man den Transmitter wieder star- +ten. + + +#k("4.1", "Spoolerstatus")# + +- Ein leeres Feld bedeutet: Der Spooler (Druckerpuffer) ist leer, es ist + nichts zum Drucken im Puffer. + +- PRINT zeigt an: Der Spooler ist gefllt. Das Terminal ist druckwillig oder + der Drucker druckt. + +- PR FULL bedeutet: Der Druckerpuffer ist voll. Da das Terminal keine wei- + teren Zeichen annimmt bis wieder Platz im Druckerpuffer ist, kann man + einzelne Zeichen mit aus dem Druckerpuffer entfernen bis PRINT + im Feld erscheint. + + +#k("4.2", "Empfngerstatus")# + +- Ein leeres Feld bedeutet: Im Empfngerpuffer ist noch Platz. + +- RX FULL zeigt an: Es gehen Empfangsdaten verloren, da der Empfngerpuffer + voll ist. + + +#k("4.3", "Senderstatus")# + +- TX ON bedeutet: Der Sender ist eingeschaltet. Wenn jetzt ein Zeichen ge- + sendet werden mu, wird es sofort auf die serielle Schnittstelle ge- + schickt. + Ein > vor TX ON zeigt an, da das Terminal auf Freiwerden der seriellen + Schnittstelle wartet. + +- TX OFF bedeutet: Der Host hat entweder XOFF gesendet oder die Hardware- + flukontrolle aktiviert, um das Terminal zu stoppen. + +- TX FULL zeigt an: Der Senderpuffer ist voll. Das Terminal nimmt keine + Eingaben mehr an bis der Puffer wieder frei ist. Dies kann mit + erzwungen werden. + + +#k("4.4", "Busy - Anzeige")# + +- READY bedeutet: Der Empfnger ist empfangsbereit, d.h. im Empfangspuffer + sind noch mindestens 256 Zeichen frei und das Terminal hat den Host nicht + per Flukontrolle gestoppt. + +- BUSY bedeutet: Der Empfnger hat dem Host per Flukontrolle angezeigt, da + nicht mehr gengend Platz im Empfangspuffer war. Die Flukontrolle wird + wieder freigegeben, wenn nur noch 256 Bytes im Empfangspuffer sind. + (Warnung: Wenn BUSY angezeigt wird, eine Taste gedrckt wird und der Host + #on("u")#nicht#off("u")# empfangsbereit ist, gert das Terminal in eine + "Deadlock-Situation", die (mit Datenverlust) nur durch einen Hardwarereset + abgebrochen werden kann.) + + +#k("4.5", "Online/Local - Anzeige")# + +- ONLINE bedeutet: Das Terminal sendet Tasteneingaben an den Host und emp- + fngt Zeichen und Kommandos vom Host. + +- LOCAL bedeutet: Keyboardeingaben erscheinen auf dem Bildschirm bzw. blei- + ben innerhalb des Terminals. Escape-Kommandos wirken direkt auf das Ter- + minal. + +#page# +#h("5.", "Die Bedeutung der Tasten")# + + +Zustzlich zu den normalerweise von der Tastatur gesendeten Tastencodes sind +einige weitere zur Verfgung gestellt worden. Beim Apple senden fast alle +Tasten mit Open-Apple zusammen einen Code mit Bit 7 = 1. Diese werden vom +Terminal als Funktions- oder Steuertasten interpretiert. Beim Basis wurden +einige bisher nur einfach belegte Tasten wie , , , +und der Zehnerblock mit Doppelfunktionen ber versehen. + + +#k("5.1", "Die Funktions- und Steuertasten")# + +Zuerst werden die Tastenfunktionen erlutert fr ein nicht emulierendes +Terminal. Die TVI-Emulation kann in der Kommandozeile abgeschaltet werden +(1. Zeile, 2. Feld) oder mit dem Kommando + + #ib(1)# 0#ie(1)# (Hex 1B 20 30) + +Die Cursortasten liefern beim Basiskeyboard andere Tastencodes als beim +Applekeyboard. Wird das Bit 7 ignoriert (ausgeblendet), stimmen die Codes +berein. bezeichnet beim Basiskeyboard die linke obere Eckposi- +tion des Cursorblocks, die rechte obere etc. + +Basis-Taste Apple-Taste Hex-Code Bedeutung +#linie ("16.2")# + 09 Der Cursor wird an die nchste (re- + chte) Tabulatorposition gesetzt. + Tabulatorpositionen sind alle 8 Spal- + ten. Also 1, 9, 17, 25, 33, 41, 49, + 57, 65, 73. War der Cursor in Spalte + 73 bis 79, dann wird er in die erste + Spalte der nchst tieferen Bild- + schirmzeile gesetzt. War der Cursor + vorher auch noch in Zeile 24, dann + wird der Bildschirminhalt entweder + nach oben gescrollt (SCROLL) oder in + Homeposition gebracht (PAGE). + + 89 Back-Tab (Rckwrtstabulator). Der + Cursor wird in die nchste links vom + Cursor befindliche Tabulatorposition + gebracht. War der Cursor in Spalte 1, + dann steht er jetzt in Spalte 73 der + darberliegenden Zeile. War der Cur- + sor in Homeposition, dann ndert sich + seine Position nicht. + + - Kommandozeile aktivieren. Einzelhei- + ten zur Kommandozeile siehe Abschnitt + 3.: Die Kommandozeilen. + + 18 U.a. Kommandozeile verlassen. + + 0D Zum Zeilenanfang ohne Zeilenvorschub. + Der Cursor steht dann in der ersten + Spalte der Zeile. + + 8D Zum Anfang der nchsten Zeile. Falls + der Cursor in der letzten (24.) Bild- + schirmzeile war, wird der Bildschir- + minhalt entweder nach oben gescrollt + (SCROLL) oder in Homeposition ge- + bracht (PAGE). + + 8B/0B Cursor eine Zeile hher. War der + Cursor in der ersten Bildschirmzei- + le, ndert sich seine Position nicht. + + 8A/0A Cursor eine Zeile tiefer. War der + Cursor in Zeile 24, dann wird der + Bildschirminhalt entweder nach oben + gescrollt (SCROLL) oder der Cursor in + die erste Bildschirmzeile gesetzt + (PAGE). + + 16 Cursor eine Zeile tiefer. War der + Cursor in Zeile 24, dann ndert er + seine Position nicht. Die Spalte + ndert sich nicht. + + 88/08 Cursor eine Spalte nach links. War + der Cursor in der ersten Bildschirm- + spalte, dann steht er jetzt in der + letzten Spalte der darberliegenden + Bildschirmspalte. War der Cursor + allerdings in Homeposition, ndert + sich seine Position nicht. + + - 95 Cursor eine Spalte nach rechts. War + der Cursor in Spalte 79, dann steht + er jetzt in der ersten Spalte der + folgenden Zeile. War der Cursor in + der letzten Zeile, dann wird der + Bildschirminhalt um eine Zeile nach + oben gescrollt (SCROLL) oder der + Cursor in Homeposition gebracht + (PAGE). + + C0 Der Cursor wird in die linke obere + Bildschirmecke gebracht (Homeposi- + tion). + + D0 Bildschirm lschen und Cursor Home. + + 7F Dieses Zeichen wird auf dem Bild- + schirm als Punktraster dargestellt. + Der Host interpretiert es in der + Regel als Zeichenlschbefehl. + + 8E Zeichen bei Cursorposition einfgen. + Der Cursor ndert seine Position + nicht. Unter dem Cursor steht dann + ein Leerzeichen. Das Zeichen in Spal- + te 79 geht verloren. + + 82 Zeichen unter Cursorposition lschen. + In Spalte 79 steht dann ein Leerzei- + chen. + + 8F Zeile bei Cursorposition einfgen. + Die Cursorposition ndert sich nicht. + Der Inhalt der letzten Bildschirmzei- + le ist verloren. Die Zeile in der der + Cursor steht wird mit Leerzeichen + gefllt. + + 83 Zeile in der der Cursor steht l- + schen. Die Cursorposition ndert sich + nicht. Der Inhalt der gelschten + Zeile ist verloren. Die letzte Bild- + schirmzeile wird mit Leerzeichen + aufgefllt. + + 08 Cursor eine Spalte nach links. Die + Funktion ist mit der von iden- + tisch. + + 15 Apple: Cursor eine Spalte nach re- + chts. Die Funktion ist mit der von + identisch. + + EF Diese Taste ist eine programmierbare + Funktionstaste (siehe e). + + 81 Diese das liefert den + Makroparametercode (siehe e). + + 1B Leitet eine Escape-Sequenz ein. + + 9B Whrend der Funktionstastedefinition + wirkt diese Taste wie ein Local + Escape, sonst liefert sie den Code 9B. + (siehe e). + + - Local/Online umschalten. + + '00' Sendet V24-Break (Hexcode 00 mit + Rahmenfehler). Als Rahmenfehler wird + das Fehlen des oder der Stopbits + bezeichnet (Stopbitpegel ist norma- + lerweise 1, bei Break dagegen 0). + +#on("u")#Zehnerblock:#off("u")# + + ... ... E1 ... programmierbare Funktionstasten + E9 " " + EA " " + EB " " + EC " " + ED " " + + EF " " + (Dieser Code wird beim RESET des + Terminals ausgefhrt. Der Benut- + zer kann damit das Terminal nach + seinen Wnschen konfigurieren.) + + +#on("u")#Funktionstasten:#off("u")# + + ... ... C1 " " + CF " " + ... ... D1 " " + DF " " + ... ... A1 " " + AF " " +.. ... B1 " " + BF " " + +Die Programmierung der Funktionstasten geschieht mit #ib(1)# e#ie(1)#. + + +#k("5.2", "Die TVI-Emulation")# + +Wird das Terminal in den TVI-Emulationsmode gebracht, dann senden einige +Tasten andere Tastencodes oder Codesequenzen. Die Bedeutung der Escape- +Sequenzen ndert sich dadurch nicht. +Der TVI-Modus kann in der Kommandozeile eingeschaltet werden (1. Zeile, 2. +Feld) oder durch + + #ib(1)# 1#ie(1)# (Hex 1B 20 31) + +An dieser Stelle erscheinen nur noch die Tastenbezeichnungen des Basiskey- +boards. Die entsprechenden Tasten, die beim Applekeyboard zu drcken sind, +kann man im letzten Abschnitt nachlesen. + +Folgende Tasten senden andere Tastencodes: + +Taste TVI-Code(sequenz) Bemerkung +#linie ("16.2")# + 0C #ib(1)##ie(1)# Cursor nach rechts + + 1E #ib(1)##ie(1)# Cursor in Homeposition + + 1A #ib(1)##ie(1)# Durch Drcken von + Bildschirm lschen und Cursor Home + + 1B 57 #ib(1)# W#ie(1)# Durch Drcken von + Zeichen lschen + + 1B 52 #ib(1)# R#ie(1)# Durch Drcken von + Zeile lschen + + 1B 51 #ib(1)# Q#ie(1)# Durch Drcken von + Zeichen einfgen + + 1B 45 #ib(1)# E#ie(1)# Durch Drcken von + Zeile einfgen + + 08 #ib(1)##ie(1)# Cursor nach links + + 1B 49 #ib(1)# I#ie(1)# Durch Drcken von + Rckwrtstabulator + + 0A #ib(1)##ie(1)# Cursor nach unten + + 0B #ib(1)##ie(1)# Cursor nach oben + + 1F #ib(1)##ie(1)# Durch Drcken von + Waagenrcklauf und Zeilenvorschub + + +#on("u")#Funktionstasten:#off("u")# + +Fr jede Funktionstaste, die nicht belegt wurde wird eine Codesequenz der +Form also 01 0D gesendet. Fr gilt: + +Taste Hex-Code + ... @ ... 40 ... Diese Tasten sind auf fast allen + J 4A TVI-Terminals vorhanden. + ... ` ... 60 ... + c 63 + + ... K ... 4B ... + Y 59 + + +#on("u")#Zehnerblock:#off("u")# + + ... d ... 64 ... + l 6C + m 6D + n 6E + o 6F + p 70 + + r 72 + +Alle nicht in dieser Tabelle aufgefhrten Funktionstasten senden den Basis- +tastencode. + +#page# +#h("6.", "Der Graphikmodus")# + + +#k("6.1", "Allgemeines")# + +Der Graphikmodus kann in der 2. Kommandozeile ein- und ausgeschaltet (Gra- +phik: GFX, Text: TXT) oder mit dem Kommando + + #ib(1)# $#ie(1)# (Hex 1B 24) + +eingeschaltet und mit dem Kommando + + #ib(1)# %#ie(1)# (Hex 1B 25) + +ausgeschaltet. + +Die Auflsung betrgt in y-Richtung 280 Punkte und in x-Richtung 192 Punk- +te, das sind 53760 Punkte. + + +#k("6.2", "Koordinaten und Parameterbergabe")# + +Die Koordinaten fr die Graphikkommandos drfen den Bereich von -32768 bis +32767 berstreichen. Der sichtbare Bereich ist fr die X-Koordinate 0..279 +und fr die Y-Koordinate von 0..191. Der Ursprung (d.h. der Punkt (0,0) ) +des Koordinatensystems ist die linke untere Ecke. Die Graphikroutinen zeic- +hnen nur innerhalb des sichtbaren Bereichs (Clipping). + + +#k("6.2.1", "Cursorposition/Fadenkreuz")# + +Der Graphikcursor ist ein gedachter unsichtbarer Punkt, der sich im gesam- +ten (auch unsichtbaren) Bereich des Koordinatensystems befinden kann. Wenn +sich der Cursor im sichtbaren Bereich befindet, dann kann man an der Posi- +tion ein Fadenkreuz darstellen. Das Fadenkreuz kann mit + + #ib(1)##ie(1)# oder #ib(1)##ie(1)# (Hex 18) + +ein- und ausgeschaltet werden. Das Fadenkreuz wird Exklusiv-Oder (XOR) ge- +zeichnet. Das heit, da die Punkte an der Stelle des Fadenkreuzes inver- +tiert (umgedreht) werden. Das hat wiederum zur Folge, da an der Graphik- +seite nichts verndert wird, wenn zweimal gesendet wird. Solange +der Bereich oder die Position des Fadenkreuzes nicht verndert wird, knnen +zwischen den beiden Kommandos auch andere Graphikkommandos ausge- +fhrt werden. + + +#k("6.2.2", "Binre oder dezimale Parameter")# + +Die bergabe der x/y Koordinaten, eines Radius oder relativer Koordinaten +und in einigen Fllen auch anderer Parameter, kann auf zwei verschiedene +Arten erfolgen. Das Terminal erkennt die bergabeart am ersten Parameterby- +te: +Bei dezimalen Parametern ist dies entweder , +, - oder eine Zahl. Bei +Binren Parametern liegt das Hherwertige Byte (das erste!) im Bereich von +00..1F oder 3A..FF. Die Festlegung auf dezimale oder binre Parameter gilt +fr beide (X und Y) Koordinaten. + + +#k("6.2.2.1", "Binre Parameter")# + +Binre Parameter sind eine Folge von vier Bytes (mit 8 Bits). Die ersten +beiden Bytes stellen die X-Koordinate dar, die anderen beiden Bytes die +Y-Koordinate. Negative Koordinaten oder negative relative Koordinaten wer- +den durch Bilden des Zweierkomplements dargestellt. +Zu beachten ist, da zuerst das hherwertige (Highbyte) und dann das nie- +derwertige (Lowbyte) gesendet werden mu. + +Der Vorteil der binren Parameter ist, da die Parameterbergabe schneller +ist als bei dezimalen Parametern, da weder Host noch Terminal eine Konver- +tierung vornehmen mssen und die Anzahl der Parameterbytes in der Regel +geringer ist als bei dezimaler Parameterbergabe. + +Der Nachteil ist, da bei XON/XOFF Flukontrolle einige Zahlen als XON oder +XOFF interpretiert werden knnen und da diese Parameter nicht auf Funk- +tionstasten gelegt werden knnen, wenn sie Zeichen > Hex 7F enthalten. + + +#k("6.2.2.2", "Dezimale Parameter")# + +Dezimale Parameter bestehen aus einer Folge von ASCII-Zeichen. Die beiden +Koordinaten werden durch einen Separator (Komma, CR, Semikolon o..) ge- +trennt. Nach dem 2. Parameter steht ein weiterer Separator. An beliebiger +Stelle in und vor den Zahlen drfen Leerzeichen () oder Pluszeichen +(+) stehen, die keine nderung des Ergebnisses bewirken. Ein Minuszeichen +vor einer Zahl negiert sie. + +Der Vorteil der dezimalen Parameter ist, da sie in hheren Programmier- +sprachen bequem und lesbar in ein Programm geschrieben werden knnen und da +keine Steuerzeichen vorkommen, die die XON/XOFF - Flukontrolle stren knn- +ten. Auerdem knnen diese Parameter immer auf Funktionstasten gelegt wer- +den, da sie keine Codes > Hex 7F enthalten. + +Der Nachteil ist wie unter 6.2.2.1 geschrieben, die Zeitdauer der zweima- +liegen Konvertierung (Host, Terminal) und die in der Regel lngeren Parame- +ter. + + +#k("6.2.3", "Absolute oder relative Koordinaten")# + +Bei den Move- und Drawbefehlen hat man die Wahl zwischen relativen und abso- +luten Koordinaten. + +Absolute Koordinaten setzen den Graphikcursor direkt auf die als Parameter +angegebene Position. Z.B. v 200, 100; setzt den Cursor direkt auf die +Position X=200, Y=100. Die meisten Programme untersttzen nur absolute Koor- +dinaten. + +Relative Koordinaten werden zur aktuellen Position des Graphikcursors ad- +diert. Das hat den Vorteil, da eine Routine nicht zu wissen braucht, wo der +Graphikcursor gerade steht. Man kann sich zum Beispiel Folgen von relativen +Move's und Draw's auf Funktionstasten legen, die dann im Localmodus an der +aktuellen Cursorposition irgendwelche Symbole oder Sonderzeichen zeichnen. +Z.B. q -4, 3; bewegt den Graphikcursor 4 Punkte nach links und 3 Punk- +te nach oben. + + +#k("6.2.4", "Byteparameter")# + +Byteparameter sind solche, die nur aus einem Byte bestehen. Die Werte kn- +nen also normalerweise von 0 bis 255 oder Hex 00 bis Hex FF. In den Fllen, +in denen nicht der ganze Wertebereich genutzt wird, werden nur die nieder- +wertigsten Bits ausaskiert, die hherwertigen werden ignoriert, wenn nicht +ausdrcklich etwas anderes angegeben ist. Im Bereich von 0 bis 7 sind Wert +und ASCII-Ziffer identisch. Bei Werten groer als 9 geht das allerdings +nicht mehr. Sind zum Beispiel die Werte von 0 bis 15 erlaubt, dann kann man +folgende Tabelle benutzen: + +#on("u")#Wert ASCII (Hex) oder Binr#off("u")# + 0 0 30 00 + 1 1 31 01 + 2 2 32 02 + 3 3 33 03 + 4 4 34 04 + 5 5 35 05 + 6 6 36 06 + 7 7 37 07 + 8 8 38 08 + 9 9 39 09 + 10 : 3A 0A + 11 ; 3B 0B + 12 < 3C 0C + 13 = 3D 0D + 14 > 3E 0E + 15 ? 3F 0F + +Fr Werte zwischen 0 und 31 benutzt man dann besser die Buchstaben (Gro- +buchstaben und [\]^_ oder Kleinbuchstaben und {|}~ und ). Die Zuord- +nung entnimmt man der ASCII-Tabelle in Anhang A. + + +#k("6.3", "Die Graphikparameter")# + +Fr die Linien und Zeichen in der Graphik gibt es verschiedene Darstellungs- +weisen. Man kann die Strichdicke, die Farbe (auf einem Monochrommonitor die +Helligkeit), den Linientyp (durchgehend, gepunktet, gestrichelt etc.) und +die Bitverknpfungen (lschen, invertieren...) festlegen. Diese Parameter +werden mit einem Kommando O ... verndert. + +Mit dem Kommando + + #ib(1)# O 0#ie(1)# (Hex 1B 4F 30) + +werden all diese Parameter auf Defaultwerte zurckgesetzt. Diese Default- +werte sind: Strichdicke 1, durchgehende Linie, OR-Bitverknpfung (Punkte +setzen), helle Farbe (gelb). Ausserdem wird die Seite 0 als sichtbare und +als Arbeitsseite gewhlt. Es wird auf ganzseitige Graphik geschaltet (falls +im Graphikmodus). + + +#k("6.3.1", "Strichdicke")# + +Die Strichdicke einer Linie ist normalerweise 1. Die Strichdicke 2 zeichnet +parallel zur ursprnglichen Linie auf beiden Seiten jeweils eine weitere +Linie der gleichen Lnge. Die Strichdicke 3 zeichnet dann auf beiden Seiten +jeweils zwei parallele Linien usw. Die Strichdicke kann von 1 bis 15 ge- +whlt werden. Sie wird mit dem Kommando + + #ib(1)# O 1#ie(1)# (Hex 1B 4F 31 ) + +eingestellt. ist ein Byteparameter (Kapitel 6.2.4) mit dem Wertebe- +reich 1 bis 15. + + +#k("6.3.2", "Farbe/Helligkeit")# + +Normalerweise ist Gelb (hell) eingestellt. Die Alternative ist Violett (dun- +kel). Jeweils 7 nebeneinanderliegene Graphikpunkte haben die gleiche Farbe. +Auf einem Farbmonitor kann die Farbe auch noch durch den Inhalt dieser 7 +Graphikpunkte bestimmt werden. Der Farbmodus wird von diesem Terminalpro- +gramm allerdings nicht untersttzt, da sich dann die Auflsung in X-Richtung +halbiert (also nur noch 140 x 192 Punkte). + +Mit dem Kommando + + #ib(1)# O 2#ie(1)# (Hex 1B 4F 32 ) + +kann die Helligkeit eingestellt werden. ist ein Byteparameter bei dem +nur das Bit 0 wichtig ist: + +Bit 0 Bedeutung + 0 dunkel/Violett ist eine gerade Zahl + 1 hell/Gelb ist eine ungerade Zahl + + +#k("6.3.3", "Linientyp")# + +Der Linientyp ist das "Muster" der Striche. Es gibt 7 vordefinierte Strich- +muster und ein vom Benutzer definiertes. Der Linientyp (im folgenden auch +Pattern genannt) wird mit dem Kommando + + #ib(1)# O 3#ie(1)# (Hex 1B 4F 33 ) + +eingestellt. ist ein Byteparameter mit dem Wertebereich von 0 bis 7. Die +Strichtypen sind folgendermaen zugeordnet: + +#on("u")# Bitmuster (16 Bit) Name #off("u")# + 0 unsichtbare Linie + 1 ---------------- durchgehende Linie + 2 - - - - - - - - gepunktete Linie + 3 ---- ---- kurz gestrichelte Linie + 4 -------- lang gestrichelte Linie + 5 -------- - Strichpunktlinie + 6 - - ----- Strich-Punkt-Punkt Linie + 7 - - - - - - - - Benutzerdefinierte Linie + (Hier Defaultangabe) + +Die Bitmuster sind immer 16 Bit lang. Nach einem Movebefehl startet der +nchste Draw-Befehl mit dem linkesten (niederwertigsten!) Bit des Bitmu- +sters. Das Muster wiederholt sich bei lngeren Linien zyklisch. Wird zwi- +schen zwei Draw-Befehlen kein Move-Befehl gegeben, dann setzt der zweite +Draw-Befehl im Bitmuster nach der gleichen Stelle fort, an der der erste +Draw-Befehl aufgehrt hat. Auch dicke Linien behalten das Linienmuster bei, +man sollte dann allerdings von gepunkteter auf lang gestrichelte Linie ber- +gehen, wenn man eine gepunktete dicke Linie haben will. + + +#k("6.3.3.1", "Selbstdefinierte Linientypen (Pattern)")# + +Wie in 6.3.3 angemerkt kann ein Linientyp auch vom Benutzer selbst definiert +werden. Da die Lnge 16 Bit ist, kann man mit den relativen Move's und +Draw's zusammen gut kleine Bildchen (Icons) zusammenstellen. Eine Hilfe ist +dabei auch die Bitverknpfung COPY, die im nchsten Abschnitt erlutert +wird. Man legt dazu zuerst das 16 Bit-Pattern als jeweils eine Zeile des +Icons fest und zieht dann von links nach rechts eine 16 Punkte lange Linie +mit dem benutzerdefinierten Pattern. Nach einem relativen Move (-16, -1) +kann der Vorgang fr die nchste Zeile fortgesetzt werden. + +Das benutzerdefinierbare Pattern wird mit dem Kommando + + #ib(1)# O 6#ie(1)# (Hex 1B 4F 36 ) + +festgelegt. ist dabei das niederwertige (Lowbyte) des Bitmusters, +ist das hherwertige (Highbyte) des Bitmusters. Wenn das Pattern als Muster +fr Linien (und nicht fr Icons) benutzt wird, dann sollte man darauf ach- +ten, da das Bit 0 im Lowbyte 1 ist, damit man bei kurzen Linien, denen ein +Move vorangegangen ist, zumindestes einen Punkt sieht. + + +#k("6.3.4", "Bitverknpfungen")# + +ber Bitverknpfungen werden die Punkte auf der Graphikseite verndert. Das +Linienmuster wird dazu zyklisch punktweise abgetastet und jenachdem ob das +aktuelle Bit im Linienbitmuster 0 oder 1 ist eine Vernderung der Graphik- +seite durchgefhrt. +Bis auf die COPY-Funktion wirken die Bitverknpfungen nur auf die Graphik- +seite, wenn der aktuelle Punkt im Linientyp-Bitmuster 1 ist. + +- Das Zeichnen einer sichtbaren Linie mit weien Punkten geschieht zum Bei- + spiel durch eine OR- (Oder-) Verknpfung. + +- Das Lschen einer Linie (also das Zeichnen von "schwarzen" Punkten) ge- + schieht mit einer AND- (Und-) Verknpfung (Genau genommen eine NAND-, d.h. + negierte AND-Verknpfung). + +- Das Invertieren (d.h. Weier Punkt wird schwarz, schwarzer Punkt wird + wei) kann man mit einer XOR- (Exklusiv-Oder-) Verknpfung erreichen. + +- Fr Icons (siehe 6.3.3.1) und andere Zwecke, gibt es noch die COPY-Funk- + tion, die eigentlich keine einzelne Bitverknpfung ist. Ist im Linientyp + das aktuelle Bit 0, dann wird in der Graphikseite eine AND-Verknpfung + durchgefhrt (d.h. der Punkt wird gelscht) ist das aktuelle Bit im Li- + nientyp 1, dann wird eine OR-Verknpfung durchgefhrt (d.h. der Punkt wird + gelscht). Der Effekt ist, da genau das Bitmuster des Linientyps in der + Graphikseite erscheint ("kopiert" wird), egal was vorher da stand, wo die + Linie gezeichnet wurde. + +Die Bitverknpfung kann mit dem Kommando + + #ib(1)# O 4#ie(1)# (Hex 1B 4F 34 ) + +festgelegt werden. ist ein Byteparameter mit dem Wertebereich 0 bis 3. + hat folgende Bedeutung: + + Bitverknpfung Verwendung +#linie ("16.2")# + 0 OR (Oder) Wei (auf schwarzem Grund) zeichnen + 1 AND (Und) Schwarz (auf weiem Grund) zeichnen + 2 XOR (Exklusiv Oder) Schwarze und Weie Punkte umdrehen (invertie- + ren) + 3 COPY (kopieren) Icons zeichnen oder Bilduntergrund berschrei- + ben + + +#k("6.3.5", "Multiparametereinstellung")# + +Die obigen Parameter (bis auf Linientyp) knnen alle zugleich mit einem +Kommando gesetzt werden. Das Kommando lautet + + #ib(1)# O 5#ie(1)# (Hex 1B 4F 35 ) + + ist ein Byteparameter mit dem Wertebereich 0 bis 127. Die Bits sind +folgendermaen zugeordnet: + + Bit Bedeutung Werte +#linie ("16.2")# + 0 .. 3 : Strickdicke 1 .. 15 + 4 .. 5 : Bitverknpfung 0 = OR, 16 = AND, 32 = XOR, 48 = COPY + 6 : Farbe/Helligkeit 0 = Violett (dunkel), 64 = Gelb (hell) + +Standardeinstellung ist also ' O 5 A'. + + +#k("6.4", "Graphikseiten")# + +Das Terminal verwaltet zwei Graphikseiten mit einer Gre von jeweils 8k +Byte (d.h. 8192 Bytes). + + +#k("6.4.1", "Die sichtbare Seite und die Arbeitsseite")# + +Die beiden Graphikseiten knnen (mssen aber nicht) getrennt voneinander +angezeigt und bearbeitet werden. Das kann sinnvoll sein, wenn eine Seite "im +Hintergrund" aufbereitet werden soll, whrend die andere (schon aufbereite- +te) Seite angezeigt wird. Man kann auch die 80-Zeichen Textseite anzeigen +und eine oder beide Graphikseiten im Hintergrund aufbereiten. Durch abwec- +hselndes Umschalten der Arbeits- und Anzeigeseite kann dann der Eindruck +eines bewegten Bildes erzeugt werden. Um diesen Vorgang zu beschleunigen, +kann man die Graphikseiten auch auf dem Host vorbereiten und (im Hinter- +grund) an das Terminal senden (bei 19200 Baud dauert das pro Seite ca. 4.7 +Sekunden). + +Die sichtbare und die Arbeitsseite knnen mit dem Kommando + + #ib(1)# O 7#ie(1)# (Hex 1B 4F 37 ) + +gewhlt werden. ist ein Byteparameter mit dem Wertebereich 0 bis 7. + +Bit 0 von : Sichtbare Seite (0 oder 1) +Bit 1 von : Arbeitsseite (0 oder 1) +Bit 2 von : 1 = 80 Zeichen Textseite wird in den untersten 32 Graphik- + zeilen eingeblendet. 0 = Nur Graphikmode. + +#on("u")# Sichtbar Arbeitsseite Inhalt der untersten 32 Graphikzeilen#off("u")# + 0 Seite 0 Seite 0 Graphik (Seite 0) + 1 Seite 1 Seite 0 Graphik (Seite 1) + 2 Seite 0 Seite 1 Graphik (Seite 0) + 3 Seite 1 Seite 1 Graphik (Seite 1) + 4 Seite 0 Seite 0 Text + 5 Seite 1 Seite 0 Mll + 6 Seite 0 Seite 1 Text + 7 Seite 1 Seite 1 Mll + + +#k("6.4.1.1", "80-Zeichen Text und Graphik")# + +Mit dem in 6.4.1 beschriebenen Kommando knnen, wie beschrieben, die unter- +sten 4 Zeilen der Textzeile (d.h. ggf. auch die Statuszeile) statt der un- +tersten 32 Graphikzeilen dargestellt werden. Da es nur eine Textseite gibt +und jeder Graphikseite eine eigene Textseite zugeordnet ist, ist die Mi- +schung von Text und Graphik in der Graphikseite 1 auf diese Weise nicht +sinnvoll, da dann in den unstersten 32 Graphikzeilen nur Mll erscheint. Das +Einblenden wird vom Terminal z.B. genutzt, wenn die Kommandozeile aktiviert +wird. Man kann zum Beispiel Benutzerhinweise in die untersten 4 Zeilen der +Textseite schreiben. Zeichenbefehle arbeiten in dem unsichtbaren (ausgeblen- +deten) Teil der Graphikseite weiter. Das Ergebnis kann man sich beim Wieder- +-Einblenden ansehen. + + +#k("6.4.2", "Aufbau einer Graphikseite")# + +Eine Graphikseite besteht aus 8192 Bytes, von denen 7680 genutzt werden, 512 +sind somit (in der Graphikseite verstreut) ungenutzt. Jedes Byte besteht aus +einem Farbbit (Bit 7) und 7 angezeigten Graphikbits. Ein gesetztes Bit ent- +spricht einem sichtbaren Punkt auf dem Bildschirm. Das niederwertigste Bit +eines Bytes wird am weitesten links angezeigt. +Jede der 192 Graphikzeilen besteht also aus 40 Bytes. Jeweils 8 Graphikzei- +len sind zu Reihen zusammengefat. Es gibt also 24 Reihen. Jede erste Gra- +phikzeile einer Reihe hat eine Anfangsadresse, die in folgender Tabelle +aufgelistet ist: + +#on("u")#Reihe Adresse Hex | Reihe Adresse Hex | Reihe Adresse Hex#off("u")# + 0 0 000 | 8 40 028 | 16 80 050 + 1 128 080 | 9 168 0A8 | 17 208 0D0 + 2 256 100 | 10 296 128 | 18 336 150 + 3 384 180 | 11 424 1A8 | 19 464 1D0 + 4 512 200 | 12 552 228 | 20 592 250 + 5 640 280 | 13 680 2A8 | 21 720 2D0 + 6 768 300 | 14 808 328 | 22 848 350 + 7 896 380 | 15 936 3A8 | 23 976 3D0 + +Um den Offset den n. Graphikzeile in einer Reihe zu finden kann man folgen- +de Tabelle benutzen: + +#on("u")#n Offset (Hex)#off("u")# +0 0 0000 +1 1024 0400 +2 2048 0800 +3 3072 0C00 +4 4096 1000 +5 5120 1400 +6 6144 1800 +7 7168 1C00 + +Beispiel: + Die Adresse des Punktes (123, 45) soll bestimmt werden. + 45 DIV 8 = 5, d.h. Y liegt in Reihe 5 mit Adresse 640 (Dezimal). 45 MOD 8 + = 5, d.h. Y liegt in der n=5. Graphikzeile von Reihe 5. Der + Y-Offset also 5120. + 123 DIV 7 = 17 d.h. X liegt im Byte mit X-Offset 17. + Die Adresse des Punktes ist also im Byte 17 + 5120 + 640 = 5777. + 123 MOD 7 = 4 d.h. Bit 4 in Byte 5777 ist der gesuchte Punkt. + + +#k("6.4.3", "Operationen auf den Graphikseiten")# + +Hier sollen nur die Operationen erlutert werden, die nicht in andere Kate- +gorien (z.B. Lschen, Linien zeichnen etc.) passen. + +Es gibt ein universelles Kommando, mit dem zwei Graphikseiten invertiert, +kopiert, gemischt und miteinander logisch verknpft werden knnen. Vern- +dert wird bei diesem Kommando nur die Arbeitsseite. + +Das Kommando lautet + + #ib(1)# !#ie(1)# (Hex 1B 21 ) + + ist dabei ein Byteparameter mit dem Wertebereich 0 bis 15 und hat fol- +gende Bedeutung: + + Bedeutung +#linie ("16.2")# + 0 Keine Vernderung. Kopiert die Arbeitsseite in sich selbst (Frbt die + Arbeitsseite allerdings mit der aktuellen Farbe/Helligkeit). + 1 Die Arbeitsseite wird invertiert. + 2 Mischt beide Seiten zusammen (OR Verknpfung). + 3 Mischt beide Seiten zusammen (OR) und invertiert das Ergebnis. + 6 Bildet den Durchschnitt beider Seiten (AND Verknpfung). + 7 Bildet den Durchschnitt beider Seite (AND) und invertiert das Ergebnis +10 Es sind die Punkte gesetzt, die in beiden Seiten verschieden sind (XOR + Verknpfung). +11 Es sind die Punkte gesetzt, die in beiden Seiten gleich sind (d.h. das + Inverse von =10). +14 Kopiert die andere Seite in die Arbeitsseite. +15 Kopiert das Inverse von der anderen Seite in die Arbeitsseite. + +Andere Werte fr wiederholen sich in der Tabelle. Die ganze Arbeitssei- +te hat nach der Operation die gewhlte Farbe/Helligkeit. + + +#k("6.4.4", "Laden einer Graphikseite vom Host")# + +Graphikseiten knnen ganz oder teilweise vom Host geladen werden. Das kn- +nen auf dem Terminal erstellte und dann an den Host gesendete (Teil-) +Graphiken sein, aber auch auf dem Host erstellte. In diesem Fall ist das +Kapitel 6.4.2 (Aufbau einer Graphikseite) interessant. + +Mit dem Kommando + + #ib(1)# /#ie(1)# + (Hex 1B 2F ...) + +kann eine Seite oder ein Teil einer Seite in die Arbeitsseite geladen wer- +den. , , , und sind Byteparameter (8 Bits). und + bilden zusammen die binre Lnge, d.h. die Anzahl der Datenbytes +, die die Graphik enthalten. Die Lnge kann von 0 bis Hex 2000 (dezi- +mal 8192) reichen. Die Adresse, durch und gebildet, darf von 0 bis +Hex 1FFF reichen. Zustzlich gilt, da die Summe von Lnge und Adresse nicht +grer als Hex 2000 sein darf, da sonst auerhalb der Graphikseite geladen +wrde. In einem dieser Fehlerflle werden die folgenden Graphikdatenbytes +ignoriert. Die Datenbytes werden dann als Kommandos interpretiert, was zu +unvorhersehbaren Reaktionen des Terminals fhrt. + + +#k("6.4.5", "Graphik auf Diskette speichern/laden")# + +Um Graphikseiten, zum Besipiel fr Prsentationen, unabhngig vom Host auf +dem Bildschirm darstellen zu knnen, benutzt man das Kommando + + #ib(1)# S#ie(1)# (Hex 1B 53 ). + +Man kann bis zu 8 verschiedene Graphikseiten vorbereiten, auf Diskette spei- +chern und zu einem spteren Zeitpunkt wieder in das Terminal zurckladen. +Dieses Kommando wird auch verwendet, um eine Textseite auf Diskette zu +schreiben oder von Diskette zu lesen. ist ein Byteparameter mit dem +Wertebereich 0 bis 31, wobei die Bits folgendermaen belegt sind: + +Bit 0..2 : "Fachnummer" der Graphikseite auf der Diskette (0 bs 7) +Bit 3 : Bei Graphikseiten immer 1 (Bei Textseiten 0) +Bit 4 : 0 heit: die Graphikseite wird von der Diskette gelesen, + 1 heit: die Graphikseite wird auf die Diskette geschrieben. + +Wird die Graphikseite auf die Diskette geschrieben, dann wird eine eventuell +schon in diesem "Fach" vorhandene Graphikseite berschrieben. + +Wie bei allen Graphikkommandos, bezieht sich dieses Kommando nicht unbedingt +auf die sichtbare Graphikseite, sondern auf die Arbeitsseite. + +Beispiele: + S liest die Graphikseite in Fach 0 in die Arbeitsseite. + S schreibt die Arbeitsseite in Fach 0 der Diskette. + +Da das Lesen einer Graphikseite von Diskette mit ca. 1.1 Sekunden, um eini- +ges schneller als der Datentransfer vom Host ist, sollte man bewegte Graphi- +ken auf Diskette vorbereiten und sie dann mit verschrnkter Arbeits- und +Sichtbarkeitsseite anzeigen. +Z.B.: Seite 1 als Arbeitsseite whlen, Seite 0 als sichtbare Seite. Graphik + von Diskette laden (wird in Seite 1 (= Arbeitsseite) geladen) Seite 1 + als sichtbare Seite whlen, Seite 0 jetzt als Arbeitsseite whlen. Die + nchste Graphikseite wird von der Diskette in die Seite 1 geladen etc. + Bei dieser Vorgehensweise scheinen bergnge kontinuierlich zu sein. + +Fr Insider: Eine Graphikseite belegt zwei Tracks (8k). Die 8 Graphikseiten + befinden sich auf den Tracks 10 bis 25 in aufsteigender Reihen- + folge. + + +#k("6.5", "Textdarstellung im Graphikmodus")# + +Nicht nur auf der 80-Zeichen Textseite knnen Buchstaben und Zeichen darge- +stellt werden, sondern auch auf den Graphikseiten. Die Auflsung ist zwar +nicht so gro wie auf der reinen Textseite, aber die Anzahl der verschiede- +nen Darstellungsmglichkeiten ist sehr viel grer. Fast alle Kommandos, die +in der Textseite angewandt werden knnen, haben in der Graphikseite die +gleiche Funktion. + +Textdarstellung in der Graphikseite ist hauptschlich zum Beschriften von +Graphiken oder zum Drucken von berschriften etc. vorgesehen. Da aber fast +alle Textkommandos (Delete/Insert Line/Character fehlt) auch im Graphikmo- +dus zur Verfgung stehen, kann man auch im Graphikmodus Textverarbeitung +oder Editor benutzen. + + +#k("6.5.1", "Zeichendarstellung")# + +Die normale Gre eines Zeichens ist 6 x 10 Punkte (x * y), damit lassen +sich 46 x 19 Zeichen (874 Zeichen) voll auf dem Bildschirm darstellen. Wenn +die Gre mit einem Kommando auf 5 x 8 Punkte verringert wird, dann lassen +sich 56 x 24 Zeichen (1344 Zeichen) auf dem Bildschirm darstellen. Komfor- +table Textverarbeitung lt sich damit natrlich nicht machen, zumal die +Geschwindigkeit, mit der die Zeichen auf den Bildschirm geschrieben werden +gegenber der der reinen Textseite langsamer ist. + + +#k("6.5.1.1", "Zeichengre und Schreibrichtung")# + +Die Zeichen knnen in verschiedenen Gren und unter verschiedenen Winkeln +auf den Bildschirm geschrieben werden. Damit ist auch ein Schreiben von +rechts nach links mit auf dem Kopf stehenden Zeichen mglich. +Bei normaler Schreibrichtung (waagerecht von links nach rechts) befindet +sich die linke untere Ecke eines Zeichens an der Position des Graphikcur- +sors. Nach dem Zeichnen des Zeichens befindet sich der Graphikcursor hinter +der rechten unteren Ecke des Zeichens. Da sich die Zeichen aus Vektoren +(Linien) zusammensetzen und nicht aus einer festen Punktmatrix, knnen sie +schnell beliebig gedreht und vergrssert (und verkleinert) werden. Der Dreh- +winkel ist wie bei allen Graphikwinkelangaben in 5 Grad Schritten anzugeben. +Die Zuordnung der Winkel zu den Parameterwerten oder ASCII-Zeichen ist im +Anhang A angegeben. + +Das Kommando + + #ib(1)# N#ie(1)# (Hex 1B 4E ) + +stellt Breite, Hhe und Drehwinkel der Zeichen ein. Alle Parameter sind +Byteparameter mit dem Wertebereich 0 bis 255. Mit einem Parameter Hex 00 +kann der Defaultwert (Standardwert) fr den jeweiligen Parameter eingestellt +werden. + bezeichnet die Zeichenbreite in Punkten. Standardwert ist 6. + bezeichnet die Zeichenhhe in Punkten. Standardwert ist 10. + bezeichnet den Drehwinkel in 5 Grad Schritten. Standardwert ist 0. + +Einige ausgezeichnet Werte fr sind: + Richtung +#linie ("16.2")# + 0 Waagerecht von links nach rechts (Ost) + 9 Schrg nach unten rechts (Sd-Ost) +18 Senkrecht von oben nach unten (Sd) +27 Schrg nach unten links (Sd-West) +36 Waagerecht (auf dem Kopf stehend) von rechts nach links (West) +45 Schrg nach oben links (Nord-West) +54 Senkrecht von unten nach oben (Nord) +63 Schrg von nach oben rechts (Aufwrts) (Nord-Ost) +72... Wie 0 ... + + +#k("6.5.1.2", "Dicke, Farbe etc.")# + +Buchstaben werden mit Vektoren (Linien) gezeichnet. Die gleichen Parameter, +die fr Striche eingestellt werden, wirken dann auch auf die Zeichen. Mg- +liche Parameter sind Farbe, Linientyp, Strichdicke und Bitverknpfung. Mit +dem Kommando + + #ib(1)# O 0#ie(1)# (Hex 1B 4F 30) + +werden alle diese Parameter auf Standardwerte zurckgesetzt. Die Standard- +werte sind in Kapitel 6.3 erlutert. Die Beschreibung des Kommandos zur +Einstellung der Zeichenfarbe ist in Kapitel 6.3.2 beschrieben, das Einstel- +len der Zeichendicke in Kapitel 6.3.1, das Einstellen des Linientyps in +Kapitel 6.3.3 und das Einstellen der Bitverknpfung ist in Kapitel 6.3.4 +beschrieben. Auch fr die Zeichendarstellung knnen mehrere dieser Parame- +ter zugleich mit einem Kommando eingestellt werden. Das Multiparameterkom- +mando ist in Kapitel 6.3.5 beschrieben. + + +#k("6.5.1.3", "Zeichenstze und Attribute")# + +hnlich wie bei der 80-Zeichen Textdarstellung knnen Zeichensatz und Text- +attribute eingestellt werden. Mit dem Kommando + + #ib(1)# z#ie(1)# (Hex 1B 7A ) + +kann einer der beiden Zeichenstze USA oder GER (ASCII und Deutsch) gewhlt +werden. Ein griechischer Zeichensatz ist unabhngig von beiden immer vor- +handen. + ist ein Byteparameter mit dem Wertebereich 0 bis 15, im Graphikmodus +sind aber nur die beiden folgende Werte sinnvoll: + +#on("u")# Zeichensatz Abweichende Zeichen#off("u")# + 2 Deutsch + 4 Ascii [ \ ] { | } ~ + +Auerdem kann der Zeichensatz im ersten Feld der ersten Kommandozeile ein- +gestellt werden. Im amerikanischen Zeichensatz treten die deutschen Buch- +staben auerdem im Bereich von 214 bis 219 und 251 auf. Der Graphikzeichen- +satz ist im Anhang abgebildet. + +Wie im Textmodus knnen Attribute mit dem Kommando + + #ib(1)# G#ie(1)# (Hex 1B 47 ) + +eingestellt werden. ist ein Byteparameter mit dem Wertebereich 0, 1, 4 +und 5. Die Werte von sind folgendermaen zugeordnet: + +#on("u")# Bedeutung #off("u")# + 0 Normaler Text (sichtbar und aufrecht) + 1 Unsichtbarer Text (Nur der Cursor wird bewegt) + 4 Kursivschrift, die Zeichen werden schrggestellt + 5 Wie 1 (unsichtbarer Text) + +Das Kommando + + #ib(1)# )#ie(1)# (Hex 1B 29) + +hat wie im Textmodus die gleiche Bedeutung wie G 4. Damit wird im +Graphikmodus die Kursivschrift eingeschaltet. Mit dem Kommando + + #ib(1)# (#ie(1)# (hex 1B 28) + +wird die Kursivschrift wieder ausgeschaltet. Im Textmodus invers hervorge- +hobene Textstellen werden im Graphikmodus also durch Kursivschrift hervor- +gehoben. +Steht rechts neben der Zeichenspalte mit einem Kursivzeichen ein nicht kur- +sives Zeichen, dann wird das rechte Zeichen mglicherweise etwas berschrie- +ben, da es in den oberen Teil des Kursivzeichens hineinragt. Das kann ver- +mieden werden, wenn nach dem Ausschalten der Kursivschrift ein Leerzeichen +ausgegeben wird. + + +#k("6.5.1.4", "Zeichen berschreiben")# + +Im 80-Zeichen Textmodus kann man Zeichen einfach bereinandertippen, das +zweite Zeichen ersetzt dann das erste. Im Graphikmodus sollen Texte auch mit +in eine Zeichnung geschrieben werden knnen, ohne da Teile von Linien even- +tuell gelscht werden. Dieser Modus bringt auerdem eine etwas grere +Schreibgeschwindigkeit mit sich. Es ist aber auch mglich, da die Flche, +in die das Zeichen geschrieben werden soll, vorher gelscht wird, um ein +sauberes Schriftbild zu erzielen. Mit dem Kommando + + #ib(1)# &#ie(1)# (Hex 1B 26) + +kann man das vorherige Lschen einschalten, mit dem Kommando + + #ib(1)# '#ie(1)# (Hex 1B 27) + +wird der Modus des berschreibens ausgeschaltet. + +Bei Kursivzeichen wird eine rautenfrmige Flche gelscht oder gefllt (wenn +Bitverknpfung AND eingeschaltet ist). Bei normalen Zeichen wird eine re- +chteckige Flche, der mit #ib(1)# N#ie(1)# eingestellten Breite und Hhe, gelscht +oder gefllt. Zu beachten ist, da das Lschen/Fllen nur bei waagerechter +Schreibrichtung von links nach rechts funktioniert. + +Da die Gre der Zeichen in weiten Grenzen mit N eingestellt werden +kann, ist es auch mglich mit dem durch & eingeschalteten Ersetzungs- +modus schnell rechteckige Flchen zu fllen oder zu lschen, wenn nicht auf +das spter beschriebene Fllkommando fr beliebige Flchen zurckgegriffen +werden soll. Dazu schaltet man mit dem Kommando O 4 1 die Bitverkn- +pfung AND (fr Fllen) ein und gibt dann einfach ein Leerzeichen aus, das +dann invertiert dargestellt wird. + + +#k("6.5.2", "Textkommandos im Graphikmodus")# + +Fast alle Textkommandos des 80-Zeichen Textmodus wirken auch im Graphikmo- +dus. Einige Kommandos, wie Zeichen senden, Zeile senden, Cursorposition +senden, haben im Graphikmodus andere Funktionen und haben deshalb andere +Escape-Sequenzen. Textkommandos, die nicht im Graphikmodus vorhanden sind: + I (Backtab), j (Reverse Linefeed), E (Insert Line), +Q (Insert Character), R (Delete Line), W (Delete Character). + + +#k("6.5.2.1", "Die Cursorpositionierung")# + +Die Cursorpositionierungskommandos (UP, DOWN, LEFT, RIGHT) wirken im Gra- +phikmodus in die aktuelle Schreibrichtung. Beispiel: Wenn als Schreibwinkel +180 Grad eingestellt wurde (Winkel 36, also von rechts nach links auf dem +Kopf schreiben), dann mu man, um einen Backspace (d.h. ein Zeichen zurck) +auszufhren, nicht sondern wie bei normaler Schreibrichtung blich, + drcken. Die vier Cursorsteuertasten funktionieren fr beliebige +Schreibrichtungen. Alle anderen Steuertasten beziehen sich immer auf waage- +rechte Schreibrichtung von links nach rechts. + +Alle Steuertasten bercksichtigen die Zeichengre (Breite und Hhe). Auch +die Graphikseite wird am Ende der letzten Zeile um soviele Graphikzeilen +gescrollt, wie ein Zeichen hoch ist. + +Folgende Steuerkommandos/Tasten wirken im Graphikmodus: + +Basis-Taste Apple-Taste Hex-Code Bedeutung +#linie ("16.2")# +#ib(1)##ie(1)# 09 Der Cursor wird an die nchste (re- + chte) Tabulatorposition gesetzt. + Tabulatorpositionen sind alle 8 Spal- + ten (wie im Textmodus). Liegt die + nchste Tabulatorposition auerhalb + des sichtbaren Bereichs, dann steht + der Cursor jetzt da. + +#ib(1)##ie(1)# - Kommandozeile aktivieren. + Einzelheiten zur Kommandozeile siehe + Abschnitt 3.: Die Kommandozeilen. + +#ib(1)##ie(1)# 18 u.a. Kommandozeile verlassen. + +#ib(1)##ie(1)# 0D Zum Zeilenanfang ohne Zeilenvorschub. + Der Cursor steht dann in der ersten + Spalte der Zeile. + +#ib(1)##ie(1)# 8D Zum Anfang der nchsten Zeile. Falls + der Cursor in der letzten sichtbaren + Bildschirmzeile war, wird der Bild- + schirminhalt entweder nach oben ge- + scrollt (SCROLL) oder in Homeposition + gebracht (PAGE). + +#ib(1)##ie(1)# 8B/0B Cursor eine Zeile hher (bzw. ber + die Zeile). War der Cursor in der + ersten sichtbaren Bildschirmzeile, + dann steht er jetzt im unsichtbaren + Bereich. + +#ib(1)##ie(1)# 8A/0A Cursor eine Zeile tiefer (bzw. "un- + ter" die Zeile). War der Cursor in + der letzten sichtbaren Zeile, dann + wird der Inhalt des Graphikbild- + schirms nach oben gescrollt, d.h. die + obersten Zeilen werden gelscht (im + SCROLL-Modus) oder der Cursor in die + erste Zeile gesetzt (im PAGE-Modus). + +#ib(1)##ie(1)# 16 Cursor eine Zeile tiefer (bzw. "un- + ter" die Zeile). War der Cursor in + der letzten Zeile, dann ndert er + seine Position nicht. Die Spalte + ndert sich nicht. + +#ib(1)##ie(1)# 88/08 Cursor eine Spalte nach links (bzw. + entegegen der Schreibrichtung). War + der Cursor in der ersten sichtbaren + Bildschirmspalte, dann ist er jetzt + unsichtbar "links" davon. + +#ib(1)##ie(1)# - 95 Cursor eine Spalte nach rechts (bzw. + in Schreibrichtung). War der Cursor + in der letzten sichtbaren Spalte, + dann befindet er sich jetzt auer- + halb des Bildschirms. Im Gegensatz + zum Textmodus wird kein Linefeed oder + Scroll ausgefhrt. + +#ib(1)##ie(1)# C0 Der Cursor wird in die linke obere + Bildschirmecke gebracht (Homeposi- + tion). + +#ib(1)##ie(1)# D0 Bildschirm lschen und Cursor Home. + +#ib(1)##ie(1)# 7F Dieses Zeichen wird auf dem Bild- + schirm nicht dargestellt. Der Host + interpretiert es in der Regel als + Zeichenlschbefehl. + +#ib(1)##ie(1)# 08 Cursor eine Spalte nach links (bzw. + entgegen der Schreibrichtung). Die + Funktion ist mit der von iden- + tisch. + +#ib(1)##ie(1)# 15 Apple: Cursor eine Spalte nach re- + chts (bzw. in Schreibrichtung). Die + Funktion ist mit der von + identisch. + +#ib(1)##ie(1)# 1B Leitet eine Escape-Sequenz ein. + +#ib(1)##ie(1)# - Local/Online umschalten + +#ib(1)##ie(1)# '00' Sendet V24-Break (Hexcode 00 mit + Rahmenfehler). Als Rahmenfehler wird + das Fehlen des oder der Stopbits + bezeichnet (Stopbitpegel ist norma- + lerweise 1, bei Break dagegen 0). + +Unbelegte Funktionstasten erzeugen Graphikzeichen, die im Anhang A nachge- +sehen werden knnen. + + +#k("6.5.2.2", "Lschbefehle")# + +Das Kommando (Clear to End Of Line) + + #ib(1)# T#ie(1)# (Hex 1B 54) + +lscht ab der aktuellen Cursorposition bis zum Zeilenende. Die Hhe des +gelschten Balkens entspricht der Buchstabenhhe. Der Balken wird unabhn- +gig von der Bitverknpfung immer gelscht. Der Balken wird unabhngig von +der Schreibrichtung immer waagerecht gelscht. + +Das Kommando (Clear to End Of Page) + + #ib(1)# Y#ie(1)# (Hex 1B 59) + +lscht den Graphikbildschirm von der aktuellen Cursorposition an bis zum +Bildschirmende. Auch dieses Kommando lscht unabhngig von der gewhlten +Bitverknpfung und Schreibrichtung immer waagerecht. + +Die Kommandos + + #ib(1)# *#ie(1)# (Hex 1B 2A) + #ib(1)# ,#ie(1)# (Hex 1B 2C) + #ib(1)# +#ie(1)# (Hex 1B 2B) + #ib(1)# :#ie(1)# (Hex 1B 3A) + #ib(1)##ie(1)# (Hex 1A) + +lschen den Bildschirm und bringen den Graphikcursor in Homeposition, d.h. +eine Buchstabenhhe unter dem oberen Bildschirmrand. + +Das Kommando + + #ib(1)# y#ie(1)# (Hex 1B 79) + +lscht den Bildschirm und bringt den Graphikcursor in die linke untere Ecke, +d.h. den Ursprung des Koordinatensystems. + + +#k("6.6", "Die Graphikkommandos")# + + +#k("6.6.1", "Draw's und Move's")# + +Draw's sind Zeichenbefehle, die eine Linie zeichnen und den Cursor an den +Endpunkt der Linie positionieren. Move's positionieren nur den Cursor und +zeichnen nicht. Bei allen Draw's ist der Anfangspunkt der Linie die aktuel- +le Cursorposition. Die Endposition kann relativ, absolut oder mit einem +relativen Winkel angegeben werden. Der Befehl zum Setzen/Lschen eines Punk- +tes wurde mit in diese Befehlskategorie aufgenommen. + + +#k("6.6.1.1", "Punkt setzen")# + +Der Befehl zum Setzen eines Graphikpunktes ist ein absoluter Befehl, d.h. +die Koordinaten des Punktes folgen dem Kommando. Die Position des Graphik- +cursors wird durch diesen Befehl nicht verndert. + +Das Kommando + + #ib(1)# m#ie(1)# (Hex 1B 6D ) + +setzt einen Punkt an die Position x/y, wenn diese innerhalb des sichtbaren +Bereichs liegt. sind dezimale oder binre Koordinaten. Das Aussehen +des Punktes kann durch Farbe/Helligkeit oder Bitverknpfung festgelegt wer- +den. Mit einer AND-Bitverknpfung wird der angegebene Punkt gelscht, mit +einer OR oder COPY Bitverknpfung wird der angegebene Punkt gesetzt, mit +einer XOR Bitverknpfung wird sein Zustand umgedreht (invertiert). +Soll ein dicker Punkt gezeichnet werden, dann kann man den (relativen) +Draw-Befehl r 0, 0; benutzen, der an die Position des Graphikcursors, +einen Punkt der eingestellten Dicke zeichnet. + + +#k("6.6.1.2", "Move-Befehle")# + +Den Move-Befehl gibt es in zwei Versionen, einer relativen und einer abso- +luten. Das Kommando fr einen absoluten Move lautet + + #ib(1)# v#ie(1)# (Hex 1B 76 ) + +Dabei sind dezimale oder binre Koordinaten, die die neue Position +des Graphikcursors bezeichnen. Diese Position mu nicht im sichtbaren Be- +reich liegen, sondern kann auch auerhalb des Fensters liegen. Der Wertebe- +reich von und ist -32768 bis 32767. + +Das Kommando fr den relativen Move-Befehl lautet + + #ib(1)# q#ie(1)# (Hex 1B 71 ) + +Bei diesem Befehl werden die Werte von und , die auch den gesamten +Wertebereich von -32768 bis 32767 berstreichen drfen, zu den Koordinaten +des Graphikcursors addiert. Auch hier darf die neue Position des Graphik- +cursors auerhalb des sichtbaren Bereichs liegen. + +Die Move-Befehle setzen auerdem das Bitmuster fr den Linientyp wieder auf +den Startwert zurck, damit der nchste Draw-Befehl auch mit einem Punkt +beginnt. + + +#k("6.6.1.3", "Draw-Befehle")# + +Ebenso wie den Move-Befehl gibt es auch den Draw-Befehl in zwei Versionen, +einer relativen und einer absoluten. Das Kommando fr einen absoluten Draw +lautet + + #ib(1)# w#ie(1)# (Hex 1B 77 ) + +Dabei sind dezimale oder binre Koordinaten, die die Endposition der +Linie bezeichnen. Diese Position mu nicht im sichtbaren Bereich liegen, +sondern kann auch auerhalb des Fensters liegen. Der unsichtbare Teil der +Linie wird dann "geclippt". Der Wertebereich von und ist -32768 bis +32767. + +Das Kommando fr den relativen Draw-Befehl lautet + + #ib(1)# r#ie(1)# (Hex 1B 72 ) + +Bei diesem Befehl werden die Werte von und , die auch den gesamten +Wertebereich von -32768 bis 32767 berstreichen drfen, zu den Koordinaten +des Graphikcursors addiert, die dann die Endposition der Linie bilden. Auch +hier darf die Endposition der Linie auerhalb des sichtbaren Bereichs lie- +gen. + + +#k("6.6.1.4", "Turtle-Graphik")# + +Turtle-Graphik (Schildkrten-Graphik, obwohl hier keine Schildkrte sicht- +bar ist) wird zur Erzeugung von "rekursiven" Graphiken, die mit Lngen und +Winkelangaben, statt mit x/y-Koordinaten, arbeiten bentigt. Man stellt sich +dazu eine Schildkrte vor, die auf ihrem Weg ber den Bildschirm eine sicht- +bare Spur zurcklassen kann (aber nicht mu). Die Schildkrte kann einen Weg +bestimmter Lnge in ihre Blickrichtung gehen und bleibt dann stehen. Auer- +dem kann sie sich nach links oder rechts drehen, d.h. ihre Blickrichtung +ndert sich. Alles was man dazu braucht, ist ein Befehl, der die Richtung +der Schildkrte verndern kann und dann einen Weg bestimmter Lnge in dieser +Richtung zurcklegt. Auerdem wird noch ein Befehl bentigt, der das "Spur- +verhalten" der Schildkrte ndert, also von "Spur sichtbar" auf "Spur un- +sichtbar" umschaltet und umgekehrt. Natrlich ist die Zeichengeschwindigkeit +nicht mit der Fortbewegungsgeschwindigkeit von Schildkrten zu vergleichen. +Das erste Kommando lautet + + #ib(1)# n#ie(1)# (Hex 1B 6E ) + + und sind dezimale oder binre Parameter. ist die Lnge der Spur +mit einem Wertebereich von 0 bis 511. ist der relative Drehwinkel der +Schildkrte, also die nderung von der ursprnglichen Blickrichtung aus. +berstreicht den positiven und negativen Winkelbereich (0..71 entsprechen 0 +bis 355 in 5 Grad Schritten. -1 entspricht z.B. 355 Grad). + +Mit dem Kommando + + #ib(1)# o#ie(1)# (Hex 1B 6F) + +kann von 'Draw' einer Spur auf 'Move' umgeschaltet werden und umgekehrt. + +Um die Sichtbarkeit der Spur am Programmamfang auf einen definierten Wert zu +setzen, kann man das Kommando + + #ib(1)# O 8#ie(1)# (Hex 1B 4F 38 ) + +benutzen. ist ein Byteparameter mit dem Wertebereich 0 bis 3. + +#on("u")#Bit 0 hat folgende Bedeutung: #off("u")# + 0 Pendown. Die Schildkrte hinterlt eine sichtbare Spur + 1 Penup. Die Schildkrte hinterlt keine Spur + +#on("u")#Bit 1 hat folgende Bedeutung: #off("u")# + 0 Drawer. Es wird eine weie Linie gezeichnet. + 1 Eraser. Es wird eine schwarze Linie gezeichnet (gelscht) + + +Mit dem Kommando + + #ib(1)# O 9#ie(1)# (Hex 1B 4F 39) + +wird die Turtle-Graphik initialisiert. Dieses Kommando mu nicht aufgerufen +werden bevor die Turtle-Graphik benutzt wird, sollte aber nach Mglichkeit +am Anfang eines Turtle-Graphik-Programmes benutzt werden. Das Kommando setzt +die Schildkrte in die Mitte des Bildschirms (140, 96) mit Blickrichtung +nach oben. Der Drawer wird eingeschaltet (zeichnen) und eine sichtbare Linie +wird voreingestellt (Pendown). + + +#k("6.6.2", "Komplexere Zeichenkommandos")# + +Auer den Kommandos zum Zeichnen von Linien und zum Bewegen des Graphikcur- +sors gibt es noch verschiedene andere Zeichenkommandos. + + +#k("6.6.2.1", "Kreise und Kreissegmente")# + +Der Mittelpunkt eines Kreises liegt immer an der aktuellen Cursorposition. +Der Radius eines Kreises ist in weiten Grenzen von 0 bis ber 30000 Punkten +whlbar. Clipping wird ausserhalb des Bildschirmrandes durchgefhrt. Ein +Kreis kann in 8 Segmente unterteilt werden, von denen alle oder nur einzel- +ne gezeichnet werden knnen. Damit ist es dann auch mglich, Halb- oder +Viertelkreise zu Zeichnen. + +Mit dem Kommando + + #ib(1)# K#ie(1)# (Hex 1B 4B ) + +wird ein Kreis mit dem Radius um die aktuelle Cursorposition gezeichnet +(relative Kreise). legt fest, welche Segmente gezeichnet werden sollen. + sind dezimale oder binre Parameter. hat den Wertebereich von 0 +bis 255. +Jedes Bit in ist einem Kreissegment zugeordnet. Ist das Bit gesetzt (1), +dann wird das zugehrige Segment gezeichnet. Der Wert 0 entspricht dem Wert +255 (der ganze Kreis wird gezeichnet), ist aber etwas schneller, da keine +Abfrage der einzelnen Bits durchgefhrt wird. + +Die Segmente sind folgendermaen numeriert: + + 7 0 + 6 1 + 5 2 + 4 3 + +Beispiele fr : + +#on("u")# Bedeutung #off("u")# + 0 Zeichnet einen ganzen Kreis + 15 Zeichnet einen links offenen Halbkreis +240 Zeichnet einen rechts offenen Halbkreis +195 Zeichnet einen unten offenen Halbkreis + 60 Zeichnet einen oben offenen Halbkreis + 3 Zeichnet ein Kreisviertel rechts oben + 12 Zeichnet ein Kreisviertel rechts unten + 48 Zeichnet ein Kreisviertel links unten +192 Zeichnet ein Kreisviertel links oben +etc. + +Das Aussehen von Kreisen kann durch die Parameter Farbe/Helligkeit und die +Bitverknpfung verndert werden. Der Linientyp (Punkt-, Strichlinie) und die +Strickdicke haben keinen Einflu, d.h. der Kreis wird immer mit durchgehen- +der Linie und einfacher Dicke gezeichnet. Sollen diese beiden Parameter auch +verndert werden, sollte man den Befehl s fr Ellipsenbgen verwenden. + + +#k("6.6.2.2", "Rechtecke")# + +Rechtecke werden ebenso wie Kreise relativ gezeichnet, d.h. die aktuelle +Cursorposition bildet eine Ecke des Rechtecks. Die Seiten des Rechtecks +liegen parallel zur X- und Y-Achse, gedrehte Rechtecke knnen aber aus 4 +relativen Draw-Befehlen zusammengesetzt werden. + +Das Kommando + + #ib(1)# J#ie(1)# (Hex 1B 4A ) + +zeichnet ein leeres Rechteck (Rahmen) an der aktuellen Cursorposition. sind dezimale oder binre Parameter. ist die Breite des Rechtecks +und kann den ganzen Wertebereich von -32768 bis 32767 berstreichen, ist +die Hhe des Rechtecks und kann ebenfalls diesen Wertebereich berstreichen. +Je nach Vorzeichen von und wird das Rechteck links/ rechts und +oben/unten von der aktuelle Cursorposition gezeichnet. + + Cursorposition bildet die Ecke + + + unten links + + - oben links + - + unten rechts + - - oben rechts + + +#k("6.6.2.3", "Bgen und Ellipsen")# + +Um die Zeichengeschwindigkeit eines Kreises zu vergrern, wurde ein sepa- +rater Befehl fr Kreise eingefhrt (6.6.2.1). Da der Kreis ein Sonderfall +der Ellipse ist, kann man das in diesem Abschnitt beschriebene Kommando auch +benutzen, um Kreise mit anderen als den unter 6.6.2.1 beschriebenen Segmen- +ten oder Parametern (Dicke, Strichtyp) zu Zeichnen. + +Das Kommando + + #ib(1)# s#ie(1)# (Hex 1B 73 ...) + +zeichnet um die aktuelle Cursorposition (also relativ) einen Ellipsenbogen +mit Radius in X-Richtung und Radius in Y-Richtung, ausgehend vom +Anfangswinkel im Uhrzeigersinn, bis zum Endwinkel . Der Winkel 0 +Grad ist dabei oben (Norden). + +Alle Parameter sind dezimale oder binre Parameter. und haben den +Wertebereich von 0 bis 255, wobei eine ganze Ellipse einem Anfangswinkel von +0 und einem Endwinkel von 72 entspricht. Die Winkelangaben sind in 5 Grad +Schritten und knnen Anhang A entnommen werden.. und drfen den +vollen Wertebereich von -32768 bis 32767 berstreichen. + + +#k("6.6.2.4", "Gefllte Flchen")# + +Rechteckige oder rautenfrmige Flchen knnen, wie in Abschnitt 6.5.1.4 +beschrieben, schnell gefllt werden. Fr beliebig geformte Flchen kann das +Kommando + + #ib(1)# |#ie(1)# (Hex 1B 7C ) + +benutzt werden. Dies ist ein relatives Kommando, da um die aktuelle Cursor- +position herum gefllt wird. ist ein Byteparameter mit dem Wertebereich +0 bis 15, der die Nummer des Musters fr die Fllung angibt. Der Fill-Befehl +arbeitet auf der aktuellen Arbeitsseite und fllt eine sichtbar begrenzte +Flche mit einem angegebenen Muster aus. + +Ist die Bitverknpfung OR eingestellt darf der Cursor nicht auf einem weien +Punkt stehen und die Flche mu von einer durchgehenden weien Linie be- +grenzt sein. +Ist die Bitverknpfung AND eingestellt, darf der Cursor nicht auf einem +schwarzen Punkt stehen und die Flche mu von einer durchgehenden schwarzen +Linie begrenzt sein. + +Auer den Parametern Bitverknpfung und Helligkeit/Farbe werden keine be- +rcksichtigt. + +Bei sehr komplex geformten Figuren kann der Fall eintreten, da die Flche +nicht ganz gefllt ist. Dies liegt daran, da intern ein zu grer Spei- +cherplatz zum Merken von Rcksprungcursorpositionen bentigt wird (Stack- +berlauf). In diesem Fall sollte man den Cursor nocheinmal auf die nicht +gefllte Flche setzen und das Kommando erneut geben. + + kann folgende Werte annehmen (Werte Hexadezimal angegeben 0..F): + Bedeutung +#linie ("16.2")# + 0 Flche ganz gefllt + 1 Flche halb gefllt (grau) + 2 Jede 4. Zeile wird durchgezogen + 3 Jede 2. Zeile wird durchgezogen + 4 Jede 4. Spalte wird durchgezogen + 5 Jede 2. Spalte wird durchgezogen + 6 Jede 4. Zeile und jede 4. Spalte wird durchgezogen (grobes Raster) + 7 Jede 2. zeile und jede 2. Spalte wird durchgezogen (feines Raster) + 8 Schraffur von links unten nach rechts oben + 9 Schraffur von links oben nach rechts unten + A Schrges Raster (Links- und Rechtsschraffur) + B Feines Funktraster(jeder 2.Punkt in x- und y-Richtung wird gesetzt) + C Mauerwerk + D Feines Netzgeflecht + E Feine Zickzacklinie + F Benutzerdefinierbares Muster. Default: Grobe Zickzacklinie + +Ist die AND-Bitverknpfung eingeschaltet, dann sind die Punkte schwarz und +wei in den Mustern vertauscht und in der obigen Tabelle sind die Bezeich- +nungen 'gefllt' und 'gelscht' auszutauschen. + + +#k("6.6.2.4.1", "Definition des Musters")# + +Das benutzerdefinierbare Muster des Fill-Befehls (Muster 15) kann mit dem +Kommando + + #ib(1)# O :#ie(1)# (Hex 1B 4F 3A ) + +eingestellt werden. Das Defaultmuster wird dabei berschrieben, das neu +eingestellte Muster allerdings nicht beim Setup mitgesichert. + sind 8 Byteparameter mit dem gesamten Wertebereich 0 bis 255. Das +erste Byte wird im Fllmuster in Richtung der niedrigeren y-Positionen dar- +gestellt, das niederwertigste Bit jedes Bytes in Richtung der niedrigeren +x-Positionen. + + +#k("6.7", "Graphikdaten zum Host")# + +Bisher wurden nur Kommandos beschrieben, die der Host an das Terminal sen- +den kann. Damit der Host ber den Status des Terminals informiert werden +kann, sind auch Kommandos vorhanden, die Daten an den Host senden. Der Host +kann auch ganze Graphikseiten anfordern, so da die auf dem Terminal er- +zeugten Graphiken nach dem Ausschalten nicht verloren sind, sondern vom Host +gespeichert werden knnen. + + +#k("6.7.1", "Graphikseiten zum Host")# + +Graphikseiten knnen ganz oder teilweise bertragen werden. Da ein angefor- +dertes Datenpaket immer ganz bertragen wird, sollte der Host, wenn keine +Flukontrolle eingeschaltet ist, nur so groe Blcke anfordern, die er puf- +fern kann (z.B. 256 Bytes). Selektives Lesen von Graphikseiten kann auch +verwendet werden, um Teile einer Graphik vom Host (und nicht vom Terminal) +verndern zu lassen. Mit dem Kommando / ... kann der modifizierte Teil +dann wieder an das Terminal zurckgesendet werden. Zum Aufbau der Graphik- +seite findet man in Kapitel 6.4.2 Informationen. + +Mit dem Kommando + + #ib(1)# \#ie(1)# (Hex 1B 5C ...) + +kann eine Seite oder ein Teil einer Seite in an den Host gesendet werden. +, , und sind Byteparameter (8 Bits). und bilden +zusammen die binre Lnge, d.h. die Anzahl der Datenbytes, die zum Host +gesendet werden. Die Lnge kann von 0 bis Hex 2000 (dezimal 8192) reichen. +Die Adresse durch und gebildet, darf von 0 bis Hex 1FFF reichen. +Zustzlich gilt, da die Summe von Lnge und Adresse nicht grer als Hex +2000 sein darf, da sich die Endadresse dann ausserhalb der Graphikseite +befindet. In diesem Fehlerfall werden keine Daten gesendet. + + +#k("6.7.2", "Cursorposition zum Host")# + +Da die Graphikcursorposition einen anderen Wertebereich berstreicht als die +Position des Textcursors, wurde zum Senden der Graphikcursorposition ein +weiteres Kommando eingefhrt. Pro Koordinate werden dabei 2 Bytes, zusammen +also 4 Bytes, gesendet. Mit dem Kommando + + #ib(1)# ;#ie(1)# (Hex 1B 3B) + +kann der Host diese 4 Bytes anfordern. Die Reihenfolge der Bytes ist + . Im Gegensatz zu ? (fr die Textcursorposi- +tion) wird auch kein abschlieendes gesendet. + + +#k("6.7.3", "Einzelne Bits zum Host")# + +Auer ganzen Graphikseiten oder Blcken daraus, kann der Host auch einzelne +Bytes oder Bits selektieren und empfangen. Dazu stehen zwei Kommandos zur +Verfgung. Mit dem Kommando + + #ib(1)# _#ie(1)# (Hex 1B 5F) + +kann das Byte angefordert werden, in dem sich der Graphikcursor gerade be- +findet. Das Bit 7 ist das Farb- oder Helligkeitsbit, das Bit (xpos MOD 7) +ist das Bit, das durch den Graphikcursor addressiert wird. Wenn der Cursor +auerhalb des sichtbaren Bereichs ist, wird ein Byte Hex 00 geliefert. + +Mit dem Kommando + + #ib(1)# -#ie(1)# (Hex 1B 2D) + +kann das Bit, da durch die Graphikcursorposition addressiert wird, abge- +fragt werden. Dieses Kommando liefert ein Byte, in dem die Bits folgende +Bedeutung haben: + +#on("u")#Bit 0 Dezimal Bedeutung #off("u")# + 0 0 Das adressierte Bit ist nicht gesetzt + 1 1 Das adressierte Bit ist gesetzt + +#on("u")#Bit 1 Dezimal Bedeutung #off("u")# + 0 0 Die Farbe ist violett/dunkel + 1 2 Die Farbe ist gelb/hell + +Bit 2 Dezimal Bedeutung +#linie ("16.2")# + 0 0 Der Graphikcursor ist innerhalb des sichtabren Bereichs + 1 4 Der Graphikcursor ist auerhalb des sichtbaren Bereichs. + Bit 0 und Bit 1 sind dann 0. + +Bit 4 und Bit 5 sind immer 1. Es werden also die ASCII-Ziffern "0" bis "4" +geliefert. + + +#k("6.7.4", "Parameter zum Host")# + +Die eingestellten Draw-Parameter knnen auch abgefragt werden. Dazu exi- +stieren zwei Kommandos. Mit dem Kommando + + #ib(1)# 4#ie(1)# (Hex 1B 34) + +knnen die Nummer der sichtbaren und der Arbeitsseite, im gleichen Format +wie zum Einstellen der Seiten mit dem Kommando #ib(1)# O 7#ie(1)# , angefordert +werden. Es werden ASCII-Zeichen von "0" bis "?" geliefert. Die Bits 0 bis 2 +sind folgendermaen zugeordnet: + +#on("u")#Bit 0 Bedeutung #off("u")# + 0 Sichtbar ist Seite 0 + 1 Sichtbar ist Seite 1 + +#on("u")#Bit 1 Bedeutung #off("u")# + 0 Arbeitsseite ist Seite 0 + 1 Arbeitsseite ist Seite 1 + +#on("u")#Bit 2 Bedeutung #off("u")# + 0 Nur Graphik eingeschaltet + 1 In den letzten 32 Graphikzeilen + sind 4 Textzeilen eingeblendet + +#on("u")#Bit 3 Bedeutung #off("u")# + 0 Der Graphikmodus ist eingeschaltet + 1 Der Textmodus ist eingeschaltet + +Sinnvoll sind die Werte der Bits 0 bis 2 nur dann, wenn Bit 3 = 0 ist. + + +Mit dem Kommando + + #ib(1)# 5#ie(1)# (Hex 1B 35) + +knnen die Linienparameter abgefragt werden. Es wird ein Byte mit dem Wer- +tebereich von 1 bis 127 geliefert. Die einzelnen Bits sind folgendermaen +zugeordnet: + +Bit Bedeutung +#linie("16.2")# +Bit 0..3 : Strichdicke +Bit 4..5 : Bitverknpfung (0 = OR, 16 = AND, 32 = XOR, 48 = COPY) +Bit 6 : Aktuelle Farbe (0 = Violett/dunkel, 1 = Gelb/hell) + +Die Bitbelegung entspricht der des Parameters des Kommandos #ib(1)# O 5#ie(1)# . + + +#k("6.8", "Graphikhardcopy")# + +Wie von der Textseite kann auch von den Graphikseiten ein Ausdruck angefer- +tigt werden. Dabei knnen keine verschiedene Helligkeitsstufen oder Farben +dargestellt werden. + + +#k("6.8.1", "Der Druckertreiber")# + +Da das Ein- und Ausschalten des Graphikmodus nicht auf allen Druckern durch +gleiche Kommandos erreicht werden kann, mu das Terminal an den vorhandenen +Drucker angepat werden. Defaultmig werden die Epson-Modelle ab RX80 auf- +wrts, sowie kompatible (IBM, Panasonic etc.) untersttzt. Die Anpassung +wird in diesem Abschnitt beschrieben. + +Mit dem Kommando + + #ib(1)# ~#ie(1)# (Hex 1B 7E ) + +knnen Kommandosequenzen eingestellt werden, die folgende Aufgaben haben: + + Default (Hex) Aufgabe +#linie ("16.2")# + 0 0D Einleiten der gesamten Hardcopy (Waagenrcklauf) + 1 1B 2A 04 18 01 Einschalten des Graphikmodus. Es folgen 280 Graphikby- + tes (jeweils 8 Bit) + 2 0D 1B 4A 17 Ausschalten des Graphikmodus. Zeilenvorschub ohne Zwi- + schenraum (Zeilenabstand ca. 8 Punkte) und Waagenrck- + lauf. + 3 Nichts Dieses Kommando wird nach der kompletten Hardcopy zum + Drucker gesendet. + +Wenn doppelte Punktbreite eingeschaltet ist, oder zwei Seiten nebeneinander +gedruckt werden, wird die Kommandosequenz 1 auch mehrmals in einer Zeile +gegeben. + + ist dabei ein Byteparameter mit dem Wertebereich von 0 bis 3. ist +eine Folge von bis zu 16 Bytes. Das erste dieser 16 Bytes ist ein Lngenby- +te, das die Lnge der Kommandosequenz (oder die Anzahl der noch folgenden +Bytes) angibt. Fr die nach dem Lngenbyte folgenden Bytes sind alle Werte +von 0 bis 255 erlaubt. + +Die Druckertreiberstrings (Kommandosequenzen) werden beim Setup in der Kom- +mandozeile auch mit abgespeichert, so da sie nur einmal (wenn berhaupt) +und dann nie wieder eingestellt werden men. + + +#k("6.8.2", "Die Hardcopyparameter")# + +Im Gegensatz zur Hardcopy einer Textseite kann das Aussehen einer Graphik +beim Ausdruck noch verndert werden. Das Kommando + + #ib(1)# ^#ie(1)# (Hex 1B 5E ) + +druckt eine Hardcopy mit dem Parameter . ist ein Byteparameter mit +dem Wertebereich von 0 bis 15. Jedes Bit in legt eine Darstellungsweise +fest. Die Bits haben folgende Bedeutung: + +Invertieren: +Bit 0 Dezimal Bedeutung +#linie("16.2")# + 0 0 Helle Punkte auf dem Bildschirm werden auf dem Drucker schwarz + gedruckt, dunkle Punkte bleiben beim Ausdruck wei. + 1 1 Die Graphik wird invertiert, d.h. Ein dunkler Bildhintergrund + bleibt auf dem Drucker dunkel (schwarz). + +Doppelte Breite: +Bit 1 Dezimal Bedeutung +#linie("16.2")# + 0 0 Jeder Bildschirmpunkt wird in normaler Breite gedruckt. Es + werden also 280 Punkte nebeneinander gedruckt. + 1 2 Jeder Bildschirmpunkt wird in doppelter Breite gedruckt. In + diesem Fall werden auf dem Drucker 560 Punkte nebeneinander + gedruckt. + +Doppelte Hhe: +Bit 2 Dezimal Bedeutung +#linie("16.2")# + 0 0 Jeder Bildschirmpunkt wird in normaler Hhe gedruckt. Es wer- + den also 192 Punkte untereinander gedruckt. + 1 4 Jeder Bildschirmpunkt wird in doppelter Hhe gedruckt. In + diesem Fall werden also 384 Punkte untereinander gedruckt. + +Zwei Seiten nebeneinander drucken: +Bit 3 Dezimal Bedeutung +#linie("16.2")# + 0 0 Es wird nur eine Graphikseite (linksbndig) gedruckt. + 1 8 Die aktuelle (mit #ib(1)# O 7#ie(1)# eingestellte) Graphikseite + wird linksbndig und die andere Graphikseite nahtlos rechts + daneben gedruckt. + +Zur Kombination von Mglichkeiten (mehrere Bits sind gesetzt): + +- Eine Graphik mit doppelter Hhe und doppelter Breite hat ungefhr das + Format des Bildschirms. Ein Ausdruck besteht dann aus 560 x 384 = 215040 + Punkten. Zustzliches Invertieren macht die Graphik dem Bildschirmausse- + hen noch hnlicher. + +- Werden zwei Seiten mit doppelter Breite nebeneinander gedruckt, dann re- + icht die Anzahl der Graphikspalten auf dem Drucker mit dem Defaultgra- + phikmodus nicht mehr aus. In diesem Fall sollte man die Druckertreiber + Kommandosequenz 1 temporr auf eine hohe (4-fache) Dichte umschalten. + Solange kein Setup ausgefhrt wird, ist diese Dichte nur solange gltig, + bis das Terminal ausgeschaltet wird. + +#page# +#h("7.", "Die Parameter der seriellen Schnittstelle")# + + +Die Parameter der seriellen Schnittstelle knnen vom Host durch Escape- +Sequenzen gndert werden. Die nderung der Parameter wird erst durchgefhrt, +wenn die Parameterbergabe komplett ist (d.h das letzte Byte wurde bertra- +gen). Alle bertragungsparameter wie Stopbits, Datenbits, Paritt und Bau- +drate werden zusammen in einem 'Rutsch' eingestellt. Die Art der Flukon- +trolle wird mit separaten Escape-Sequenzen eingestellt. +Die Einstellung in der Kommandozeile ist im Kapitel 3 beschrieben. + + +#k("7.1", "Das bertragungsformat")# + +Das bertragunsformat eines Datenbytes sieht folgendermaen aus: +(Beispiel fr 8 Datenbits, 1 Parittsbit und 1 Stopbit) + + +---+---+---+---+---+---+---+---+---+---+---+ + ... |"0"| 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | P |"1"| ... + +---+---+---+---+---+---+---+---+---+---+---+ + Start- ---- D a t e n b i t s ---- Pari- Stop- + bit tts- bit + bit + --------> Zeit + +Bei 7 Datenbits ist das Bit 7 "0". P bezeichnet das Parittsbit. Wenn zwei +Stopbits bertragen werden steht an dieser Stelle das 1. Stopbit ("1"). + + +#k("7.2", "Die bertragungsparameter")# + +Alle vier Parameter werden zugleich verndert. Das Kommando lautet + + #ib(1)# #ie(1)# (Hex 1B 20 20 ) + + ist dabei ein Datenbyte, das wie folgt festgelegt wird: + + Bit 7 6 5 4 3 2 1 0 + +-------+-------+-------+-------+-------+-------+-------+-------+ + |Parity |Parity | Stop- | Daten-| Baudrate | + | even/ |on/off | bits | bits | | | | | + | odd | | | | | | | | + +-------+-------+-------+-------+-------+-------+-------+-------+ + + +#k("7.2.1", "Baudrate")# + +Baudrate = Anzahl der pro Sekunde bertragenen Bits (bertragungsgeschwin- +digkeit) . + + Bits +#on("u")#Dezimal 3 2 1 0 Neue Baudrate#off("u")# + 0 0 0 0 0 Alte Baudrate (nicht verndern) + 1 0 0 0 1 50 Baud + 2 0 0 1 0 75 Baud + 3 0 0 1 1 109.9 Baud + 4 0 1 0 0 134.58 Baud + 5 0 1 0 1 150 Baud + 6 0 1 1 0 300 Baud + 7 0 1 1 1 600 Baud + 8 1 0 0 0 1200 Baud + 9 1 0 0 1 1800 Baud + 10 1 0 1 0 2400 Baud + 11 1 0 1 1 3600 Baud + 12 1 1 0 0 4800 Baud + 13 1 1 0 1 7200 Baud + 14 1 1 1 0 9600 Baud + 15 1 1 1 1 19200 Baud + +Der Wert 0 kann gebraucht werden, wenn nur Datenbits, Stopbits und Pari- +ttsbit verndert werden sollen. + + +#k("7.2.2", "Datenbits")# + +Bit 4 legt die Anzahl der gesendeten und empfangenen Datenbits fest. + +#on("u")#Dezimal Bit 4 #off("u")# + 0 0 8 Datenbits + 16 1 7 Datenbits + +Mit einem anschliessenden Kommando + + #ib(1)# 6#ie(1)# (Hex 1B 20 36) + +kann das 8. Datenbit ausmaskiert (d.h auf "0" gesetzt) werden. Dies kann +notwendig sein, wenn der Host nur 7 Bit ASCII verarbeitet und auf ein ge- +setztes 8. Datenbit falsch reagiert (Steuerbit oder hnliches). + +Mit + + #ib(1)# 7#ie(1)# (Hex 1B 20 37) + +kann die Maskierung wieder aufgehoben werden. +Zu beachten ist, da bei 7 Bit Datentransfer zum Beispiel das Farbbit bei +Download einer Graphikseite nicht bertragen wird. + + +#k("7.2.3", "Stopbits")# + +Bit 5 legt die Anzahl der Stopbits fest. + +#on("u")#Dezimal Bit 5 #off("u")# + 0 0 1 Stopbit + 32 1 2 Stopbits + +Zu beachten ist, da bei eingeschaltetem Paritycheck und 8 Datenbits immer +ein Stopbit bertragen wird, auch wenn 2 Stopbits programmiert wurden. (Es +knnen maximal 11 Bits/Daten"byte" bertragen werden.) + + +#k("7.2.4", "Parittsbit")# + +Bit 6 legt fest, ob Parittskontrolle erfolgen soll und ob ein Parittsbit +vorhanden ist. + +Dezimal Bit 6 +#linie("16.2")# + 0 0 Keine Parittskontrolle/Kein Parittsbit + 64 1 Parittskontrolle eingeschaltet. Paritt mit Bit 7 gewhlt + +Wenn Bit 6 = 1 ist legt Bit 7 fest, ob gerade oder ungerade Paritt geprft +werden soll. + +#on("u")#Dezimal Bit 7 #off("u")# + 0 0 Ungerade Paritt + 128 1 Gerade Paritt + + +#k("7.2.5", "bertragungsfehler")# + +Wird ein Rahmenfehler (Stopbit fehlt) oder ein Parittsfehler (mindestens +ein Bit verflscht) entdeckt, dann wird statt des empfangenen Mlls ein Byte +Hex FF vom Terminal interpretiert. Steht dies im Text, kann man es als in- +vertiertes Punktraster erkennen. Dieses Zeichen richtet wenig Schaden an, +wenn es mitten in einer Escape-Sequenz empfangen wird. + + +#k("7.3", "Die Flukontrolle")# + +Damit keine Daten verloren gehen, wenn der Host oder das Terminal keine +solchen mehr empfangen kann, sollte eine Flukontrolle eingeschaltet wer- +den. Das Terminal hat zwar einen Empfangspuffer von 4K Byte (4096 Zeichen), +aber auch dieser kann einmal voll sein. Der Sendepuffer von 2K Byte (2048 +Zeichen) wird in Anspruch genommen, wenn der Host dem Terminal per Flukon- +trolle mitgeteilt hat, da er keine Zeichen mehr empfangen kann. Das Termi- +nal wartet dann nicht aktiv auf Freigabe vom Host, sondern kann weiter ar- +beiten (Spooler, Bildschirmausgabe, Localmodus etc.). + +Wenn das Terminal den Host "gestoppt" hat, kann man das an einem "B U S Y" +in der Statuszeile erkennen, sonst steht dort "R E A D Y". +Wenn der Host das Terminal "gestoppt" hat, kann man das an einem "T X O F F" +in der Statuszeile erkennen, sonst steht dort "T X O N". + +Da dieses Terminal einen groen Empfangspuffer hat, sollte man allerdings im +Notfall auch ohne Flukontrolle auskommen, wenn nicht gerade umfangreiche +Graphikoperationen ausgefhrt werden sollen, bei denen der Puffer nicht +schnell genug geleert werden kann. + + +#k("7.3.1", "XON/XOFF")# + +XON/XOFF ist eine Softwareflukontrolle. Als Stopzeichen wird + + #ib(1)#XOFF#ie(1)# (#ib(1)##ie(1)# Hex 13) + +verwendet. Als Startzeichen wird + + #ib(1)#XON#ie(1)# (#ib(1)##ie(1)# Hex 11) + +verwendet. Diese Flukontrolle sollte nur im Textmodus verwendet werden, da +Binrdaten mglicherweise Hex 11 oder Hex 13 enthalten, die dann nicht als +Protokollzeichen verwendet werden sollen. Der Vorteil dieser Art der Flu- +kontrolle ist, da man mit 3 Leitungen (Masse, TXD, RXD) an der seriellen +Schnittstelle auskommt. + +Das Terminal reagiert auf empfangene XON/XOFF-Zeichen sofort, d.h diese +Zeichen werden nicht in den Empfangspuffer gestellt. Diese beiden Zeichen +werden auch dann interpretiert, wenn das Terminal im Local-Modus ist. + +Die XON/XOFF Flukontrolle kann in der 2. Kommandozeile ein- und ausgeschal- +tet werden, sowie mit dem Kommando + + #ib(1)##ie(1)# (Hex 0F) + +eingeschaltet und mit + + #ib(1)##ie(1)# (Hex 0E) + +ausgeschaltet werden. + +Zu beachten ist, da der Sender vor dem Ausschalten noch im "TX OFF"- +Zustand sein kann. Man sollte deshalb direkt vor noch (Hex +11), also XON senden, um den Sender wieder einzuschalten. Dies wird vom +Terminal nicht automatisch gemacht, da sonst ein das im Datenstrom +vorkommt, auch noch ein Zeichen fr Flukontrolle wre. + + +#k("7.3.2", "DTR/DSR")# + +DTR/DSR ist eine Hardwareflukontrolle bei der die Leitungen Pin 20 (DTR) +und Pin 6 (DSR) (in der Regel berkreuzt) angeschloen sein mssen. +Bei dieser Art der Flukontrolle drfen alle Zeichen bertragen werden, ohne +da eines die Flukontrolle steuert. Ausnahme: Wenn zustzlich XON/ XOFF +Flukontrolle eingeschaltet ist werden natrlich XON/XOFF als Steuerzeichen +interpretiert. + +DTR (Data Terminal Ready)/DSR (DataSet Ready) Flukontrolle kann in der 2. +Kommandozeile ein- und ausgeschaltet werden. Der Host kann dies mit dem +Kommando + + #ib(1)# #ie(1)# (Hex 1B 20 ) + +erreichen. Die Werte von sind + +#on("u")# Hex Bedeutung #off("u")# + 2 32 Weder RTS/CTS noch DSR/DTR Flukontrolle + 3 33 RTS/CTS Flukontrolle, aber keine DSR/DTR Flukontrolle + 4 34 DSR/DTR Flukontrolle, aber keine RTS/CTS Fluskontrolle + 5 35 DSR/DTR und RTS/CTS Flukontrolle + +DTR/DSR Flukontrolle wird empfohlen, da hier alle Zeichen ohne Vernderung +empfangen werden knnen. RTS/CTS Flukontrolle kann, hardwaremig bedingt, +beim Einschalten von RTS ein Bit "umkippen". + + +#k("7.3.3", "RTS/CTS")# + +RTS/CTS ist eine Hardwareflukontrolle bei der die Leitungen Pin 4 (RTS) und +Pin 5 (CTS) (in der Regel berkreuzt) angeschloen sein mssen. +Bei dieser Art der Flukontrolle drfen alle Zeichen bertragen werden, ohne +da eines die Flukontrolle steuert. Ausnahme: Wenn zustzlich XON/ XOFF +Flukontrolle eingeschaltet ist werden natrlich XON/XOFF als Steuerzeichen +interpretiert. + +RTS (Ready To Send)/CTS (Clear To Send) Flukontrolle kann in der 2. Kom- +mandozeile ein- und ausgeschaltet werden. Der Host kann dies mit dem Kom- +mando erreichen. Die Werte von sind im letzten Ab- +schnitt (7.3.2 DTR/DSR) angegeben. + + +#k("7.4", "Echo und Local/Online")# + +In einigen Fllen verlangt der Host, da das vom Terminal empfangene Zei- +chen zurckgesendet (geechoed) wird, um eventuelle bertragungsfehler zu +erkennen. Dieser Modus wird mit dem Kommando + + #ib(1)# D E#ie(1)# (Hex 1B 44 45) + +eingeschaltet. Zustzlich wird hiermit der Localmodus ausgeschaltet (d.h der +Online-Modus eingeschaltet), falls das Kommando am Terminal im Local-Modus +gegeben wurde. + +Der Echo-Modus wird mit dem Kommando + + #ib(1)# D O#ie(1)# (Hex 1B 44 4F) + +ausgeschaltet. Das Terminal befindet sich dann im Fullduplex Online-Modus. +Der Local-Modus wird auch hierbei verlassen. + +Der Local-Modus kann vom Host mit dem Kommando + + #ib(1)# D L#ie(1)# (Hex 1B 44 4C) + +eingeschaltet werden. Dabei ist zu beachten, da der Host den Local-Modus +nicht ausschalten kann. Der Local-Modus kann vom Benutzer durch Drcken von +#ib(1)##ie(1)# am Keyboard verlassen werden. + +Im Local-Modus werden Keyboardeingabe nicht mehr an den Host geschickt, +sondern auf dem Bildschirm angezeigt bzw. durch das Terminal interpretiert. +Funktionstastensequenzen werden auch nicht an den Host geschickt. Escape- +Sequenzen die allerdings Daten senden (z.B Download von Text und Graphik +oder die Abfrage der Cursorposition), werden wie im Online-Modus ausgefhrt, +d.h. die Daten werden zum Host geschickt. + +#page# +#h("8.", "Spezielle Kommandos im Textmodus")# + + +In diesem Kapitel werden weitere Kommandos, die im Textmodus wirksam sind +und thematisch nicht in die anderen Kapitel passen, beschrieben. + + +#k("8.1", "Weitere Cursorpositionierungskommandos")# + +Zustzlich zu den im Graphikmodus und im Textmodus gltigen Cursorpositio- +nierungskommandos gibt es noch einige weitere. Die fnf Kommandos Zeile +lschen, Zeile einfgen, Zeichen lschen, Zeichen einfgen und Rckwrtsta- +bulator sind schon in Kapitel 5 beschrieben worden. + +Hier nur noch einmal die entsprechenden Kommandos: + +Funktion Escape-Sequenz +#linie("16.2")# +Zeile einfgen #ib(1)# E#ie(1)# oder #ib(1)# L#ie(1)# +Zeile lschen #ib(1)# R#ie(1)# oder #ib(1)# M#ie(1)# +Zeichen einfgen #ib(1)# Q#ie(1)# +Zeichen lschen #ib(1)# W#ie(1)# +Rckwrtstabulator #ib(1)# I#ie(1)# + +Mit dem Kommando + + #ib(1)# j#ie(1)# (Hex 1B 6A) + +kann ein umgekehrter Zeilenvorschub erreicht werden. Steht der Cursor in +Zeile 2 bis Zeile 24, dann wirkt dieses Kommando wie . Steht der Cursor +in Zeile 1, dann wird der Bildschirminhalt nach unten gescrollt und die +erste Bildschirmzeile gelscht. + +Mit dem Kommando + + #ib(1)# =#ie(1)# (Hex 1B 3D ...) + +kann der Cursor auf eine bestimmte Position auf dem Bildschirm gesetzt wer- +den. und sind dabei Byteparameter. hat den Wertebe- +reich 32 () bis 110 ("o"), hat den Wertebereich 32 () +bis 55 ("7"). ist dabei die gewnschte x-Position + 32 (gezhlt wird +von 0 bis 79), ist die gewnschte y-Position + 32 (gezhlt wird von 0 +bis 23). Die Zuordnungen der ASCII-Zeichen zu den Cursorpositionen kann man +auch im Anhang A unter "Cursor" nachlesen. + +Dieser Befehl hat im Graphikmodus die gleiche Wirkung! + + +#k("8.2", "Cursormodus")# + +Mit dem Kommando + + #ib(1)# .#ie(1)# (Hex 1B 2E ) + +kann die Darstellung des Cursors verndert werden. Fr sind ASCII-Zei- +chen "0", "1" und "2" zugelassen. hat folgende Bedeutung: + +#on("u")# Bedeutung #off("u")# + 0 Cursor blinkt nicht und ist unsichtbar + 1 Cursor blinkt und ist sichtbar + 2 Cursor blinkt nicht und ist sichtbar + +Mit dem Kommando + + #ib(1)# Z#ie(1)# (Hex 1B 5A) + +kann der Zustand des Cursors von sichtbar auf unsichtbar und umgekehrt umge- +schaltet werden. + + +#k("8.3", "Zeichensatz einstellen")# + +Da die Zeichenstze von Basis und Apple unterschiedlich sind, mu hier bei +den Parametern unterschieden werden. Das Kommando zur Einstellung des Zei- +chensatzes lautet in beiden Fllen + + #ib(1)# z#ie(1)# (Hex 1B 7A ) + +wobei ein Byteparameter ist. Beim Apple hat folgende Bedeutung: + + Zeichensatz +#linie("16.2")# + 1 Full Ascii: 128 Zeichen, ASCII, normale, inverse und blinkende Zei- + chen + 4 Ascii: 128 Zeichen, ASCII, normale und blinkende Zeichen + +Beim Basis hat folgende Bedeutung: + + Zeichensatz +#linie("16.2")# + 0 = Apple II: 64 Zeichen, ASCII, normale, inverse und blinkende Zeichen + 1 = Full Ascii: 128 Zeichen, ASCII, normale, inverse und blinkende Zeichen + 2 = Deutsch: 128 Zeichen, deutsch, normale und inverse Zeichen + 4 = Ascii: 128 Zeichen, ASCII, normale und inverse Zeichen + 6 = APL: 128 Zeichen, APL, normale und inverse Zeichen + + Und mit blinkenden statt inversen Zeichen: + 8 = Apple II: 64 Zeichen, ASCII, normale, blinkende und inverse Zeichen (!) + 9 = Full Ascii: 128 Zeichen, ASCII, normale, blinkende und inv. Zeichen (!) +10 = Deutsch: 128 Zeichen, deutsch, normale und blinkende Zeichen +12 = Ascii: 128 zeichen, ASCII, normale und blinkende Zeichen +14 = APL: 128 Zeichen, APL, normale und blinkende Zeichen + +Einige ausgewhlte Zeichenstze knnen auch in der Kommandozeile eingestellt +werden. + + +#k("8.4", "Texthardcopy")# + +Einen Ausdruck des Textbildschirminhaltes auf dem Drucker kann man mit dem +Kommando + + #ib(1)# P#ie(1)# (Hex 1B 50) + +erreichen. Der auf dem Drucker eingestellte Schrifttyp wird nicht vern- +dert. Es werden 24 Zeilen gedruckt, die Statuszeile wird nicht gedruckt, +sondern die "darunterliegende" 24. Textzeile. Nach jeder Zeile wird und + gedruckt, der Drucker sollte deshalb kein Autolinefeed bei durch- +fhren. + +Inverse Bildschirmzeichen (80..FF) werden durch Doppeldruck (dunkler) her- +vorgehoben, Controlcharacter (00..1F und 80..9F) werden unterstrichen dar- +gestellt, das Punktraster (7F und FF) wird als unterstrichenes # darge- +stellt. + + +#k("8.5", "Zeichen-Attribute")# + +Die Zeichenattribute werden mit dem Kommando + + #ib(1)# G#ie(1)# (Hex 1B 47 ) + +eingestellt. ist ein Byteparameter, der folgende Werte annehmen kann: + +#on("u")# Attribute #off("u")# + 0 Sichtbare, normale Zeichen + 1 Unsichtbare Zeichen, es werden Leerzeichen dargestellt + 4 Sichtbare, inverse Zeichen + 5 Unsichtbare Zeichen, es werden inverse Leerzeichen dargestellt. + +Mit dem Kommando + + #ib(1)# (#ie(1)# (Hex 1B 28) + +kann auf normale Darstellung umgeschaltet werden (wirkt hnlich G 0, +schaltet aber nicht auf sichtbare Darstellung, falls unsichtbar). + +Mit dem Kommando + + #ib(1)# )#ie(1)# (Hex 1B 29) + +kann auf inverse Darstellung umgeschaltet werden (wirkt hnlich G 4, +schaltet aber nicht auf sichtbare Darstellung, falls unsichtbar). + + +#k("8.6", "Bildhintergrund hell/dunkel")# + +Die Bildschirmdarstellung kann von heller Schrift auf dunklem Grund (be- +zglich eines gelschten Bildschirms) umgeschaltet werden auf dunkle Schrift +auf hellem Grund. Die Darstellung "schwarz auf wei" ist auf einigen Monito- +ren augenfreundlicher. + +Mit dem Kommando + + #ib(1)# b#ie(1)# (Hex 1B 62) + +kann die dunkle Schrift auf weiem Grund eingeschaltet werden. Die Darstel- +lung von inverser und normaler Schrift wird vertauscht. + +Mit dem Kommando + + #ib(1)# d#ie(1)# (Hex 1B 64) + +kann helle Schrift auf dunklem Grund eingeschaltet werden. + + +#k("8.7", "Zeichentransfer zum Host")# + +Der Host kann Teile oder den ganzen Bildschirm vom Terminal lesen. Alle +Zeichen werden als Bytes gesendet, bei denen ein gesetztes Bit 7 Invers- +schrift anzeigt. + + +#k("8.7.1", "Ein Zeichen senden")# + +Mit dem Kommando + + #ib(1)# 8#ie(1)# (Hex 1B 38) + +wird nur das Zeichen an der Cursorposition gesendet. Die Cursorposition +ndert sich nicht. Der Cursor mu nicht sichtbar sein. + + +#k("8.7.2", "Eine Zeile senden")# + +Mit dem Kommando + + #ib(1)# 6#ie(1)# (Hex 1B 36) + +wird die Zeile, in der der Cursor steht (genauer: die Zeile der Cursorrow, +falls der Cursor unsichtbar ist) an den Host gesendet. Falls der Cursor in +Zeile 24 steht, wird nicht die Stauszeile, sondern die 24. Textzeile gesen- +det. Im Anschlu an die Zeile werden eventuell ein oder zwei eingestellte +Zeilenbegrenzer gesendet (Lineterminator). Die Programmierung der Begrenzer +ist in Abschnitt 8.7.4 beschrieben. Es werden also 80 bis 82 Zeichen gesen- +det. Die Cursorposition ndert sich durch das Kommando nicht. + + +#k("8.7.3", "Eine Seite senden")# + +Mit dem Kommando + + #ib(1)# 7#ie(1)# (Hex 1B 37) + +wird die gesamte Bildschirmseite an den Host gesendet. Im Anschlu an jede +Zeile werden (falls eingestellt) Zeilenbegrenzer gesendet. Im Anschlu an +die gesamte Seite wird ein (eingestellter) Seitenbegrenzer (Pageterminator) +gesendet. Es werden also je nach Zeilen- und Seitenbegrenzer 1920 bis 1969 +Zeichen gesendet. Die Statuszeile wird nicht gesendet, sondern die "darun- +terliegende" 24. Textzeile. Die Programmierung der Zeilen- und Seitenbe- +grenzer ist in Abschnitt 8.7.4 beschrieben. Die Cursorposition ndert sich +durch dieses Kommando nicht. + + +#k("8.7.4", "Terminatorzeichen definieren")# + +Mit dem Kommando + + #ib(1)# x 1#ie(1)# (Hex 1B 78 31 ) + +knnen die Zeilenbegrenzer der Sendekommandos festgelegt werden. und + sind dabei Byteparameter, die den Wertebereich 0 bis 255 berstrei- +chen. Ist ein Parameter Hex 00, dann wird dieses Zeichen nicht gesendet. +Wenn man also das Kommando (Hex) 1B 78 31 00 00 sendet, wird kein Begren- +zerzeichen nach der Zeile gesendet. +Voreingestellt ist ein Begrenzerzeichen; und zwar US (Hex 1F). + +Mit dem Kommando + + #ib(1)# x 4#ie(1)#

(Hex 1B 78 34

) + +kann der Seitenbegrenzer des Kommandos #ib(1)# 7#ie(1)# festgelegt werden.

ist +ein Byteparameter, der den Wertebereich von 0 bis 255 berstreicht. Ist

+Hex 00, dann wird kein Seitenbegrenzer gesendet. +Voreingestellt ist

= (Hex 0D). + + +#k("8.7.5", "Cursorposition senden")# + +Mit dem Kommando + + #ib(1)# ?#ie(1)# (Hex 1B 3F) + +kann der Host die Position des Textcursors abfragen. Es wird eine Folge von +3 Bytes gesendet: + + ist die y-Position + 32, die x-Position + 32. Beide Parameter +knnen fr den Befehl #ib(1)# =#ie(1)# verwendet werden, da Sie den +gleichen Wertebereich berstreichen. + + +#k("8.8", "Textseite auf Diskette speichern/laden")# + +Genau wie Graphikseiten kann auch die Textseite auf Diskette geschrieben und +zu einem spteren Zeitpunkt wieder zurckgeladen werden. Bei der Textseite +wird auerdem noch die aktuelle Cursorposition geladen/geschrieben. Man kann +sich zum Beispiel eine Datei Seitenweise auf dem Bildschirm anzeigen lassen +und diese Seiten auf Diskette abspeichern. Spter kann man die Datei Offline +(im Localmodus) Seitenweise ansehen. + +Bis zu 8 Textseite lassen sich auf Diskette speichern und wieder abrufen. +Die "Fcher" fr die Textseiten sind unabhngig von denen fr die Graphik- +seiten. +Die Seiten werden unabhngig von REVVID (Schwarz auf Wei) immer NORVID +(also Wei auf Schwarz) abgespeichert. Beim Laden der Seite wird sie je nach +REVVID/NORVID dargestellt. + +Das Kommando fr diese Operationen lautet + + #ib(1)# S#ie(1)# (Hex 1B 53 ). + + ist ein Byteparameter mit dem Wertebereich 0 bis 31, wobei die Bits +folgendermaen belegt sind: +Bit 0..2 : "Fachnummer" der Textseite auf der Diskette (0 bis 7) +Bit 3 : Bei Textseiten immer 0 (Bei Graphikseiten immer 1) +Bit 4 : 0 heit: die Textseite wird von der Diskette gelesen, + 1 heit: die Textseite wird auf die Diskette geschrieben. + +Wird die Textseite auf die Diskette geschrieben, dann wird eine eventuell +schon in diesem "Fach" vorhandene Textseite berschrieben. + +Fr Insider: Jede Textseite belegt einen halben Track (2k). Die 8 Textseiten + befindenden auf den Tracks 6 bis 9 in aufsteigender Reihenfol- + ge. + + +#page# +#h("9.", "Verschiedene Steuerkommandos")# + + +#k("9.1", "Signalton")# + +Mit + #ib(1)##ie(1)# (Hex 07) + +wird ein kurzer Signalton ausgegeben. Ein Warnton des Terminals ist schr- +fer (heller). + + +#k("9.2", "Keyboardclick")# + +Der Tastaturclick wird fr fast alle Tasten erzeugt. Ausnahmen sind die + und die Tasten, sowie beim Apple die Apfeltasten. Der Tasta- +turclick kann in der ersten Kommandozeile abgeschaltet werden (CLK OFF) oder +mit dem Kommando + + #ib(1)# <#ie(1)# (Hex 1B 3C) + +vom Host. Mit dem Kommando + + #ib(1)# >#ie(1)# (Hex 1B 3E) + +kann der Keyboardclick wieder eingeschaltet werden. + + +#k("9.3", "Bildschirmausgabe/Druckerausgabe")# + +Die Bildschirmausgabe, die ja normalerweise eingeschaltet ist, kann in der +Kommandozeile abgeschaltet werden (SCRNOFF) oder vom Host mit dem Kommando + + #ib(1)# `#ie(1)# (Hex 1B 60) + +abgeschaltet werden. Bis auf das Kommando + + #ib(1)# a#ie(1)# (Hex 1B 61) + +werden keine Escape-Squenzen oder Control-Codes interpretiert. Mit a +wird die Bildschirmausgabe wieder zugelassen. + +Die Druckerausgabe kann mit dem Kommando + + #ib(1)# @#ie(1)# (Hex 1B 40) + +eingeschaltet werden. Man kann dann Texte parallel auf Drucker und Bild- +schirm ausgeben. In der ersten Kommandozeile kann die Druckerausgabe auch +ein- und ausgeschaltet werden. +Man kann zum Beispiel den Schrifttyp des Druckers im Local-Modus umschal- +ten, wenn man in der Kommandozeile die Druckerausgabe (PRT ON) einschaltet. +Dazu kann man sich auch eine Funktionstaste belegen, die Bildschirmausgabe +abschaltet, Druckerausgabe einschaltet, den Schrifttyp umschaltet, Drucker- +ausgabe wieder ausschaltet und Bildschirmausgabe wieder einschaltet. + +Abgeschaltet wird die Druckerausgabe mit dem Kommando + + #ib(1)# A#ie(1)# (Hex 1B 41) + + +#k("9.4", "Scroll/Page-Modus")# + +Steht der Cursor in der letzten Zeile und soll er in die nchst tiefere +gebracht werden (, , etc.), dann gibt es entweder die +Mglichkeit, da der Bildschirm nach oben gescrollt wird, d.h. die 1. Zeile +verschwindet und die 24. Zeile wird gelscht, oder da der Cursor in der +ersten Bildschirmzeile wieder auftaucht, ohne da der Bildschirminhalt ver- +ndert wird. Die erste Mglichkeit heit SCROLL-Modus, die zweite PAGE- +Modus. Die Umschaltung kann entweder in der ersten Kommandozeile erfolgen +oder mit dem Kommando + + #ib(1)# H#ie(1)# (Hex 1B 48). + +In der Kommandozeile hat man die Informationsmglichkeit, welcher Modus +gerade aktiv ist. + + +#k("9.5", "Belegung der Funktionstasten")# + +Eine ntzliche Angelegenheit sind die programmierbaren Funktionstasten. Die +Codes der Funktionstasten sind unter anderem in Anhang A zu finden. Funk- +tionstasten knnen im Local-Modus aufgerufen werden, zum Beispiel fr hu- +fig gebrauchte Terminalkommandos oder lngere Kommandosequenzen (Graphikmo- +dus). Im Online-Modus kann man z.B. Betriebssystemkommandos auf Funktion- +stasten legen. + +Die Lnge der Zeichen auf allen Funktionstasten darf zusammen nicht 4095 +Zeichen berschreiten. Ein akustisches Warnsignal ertnt, wenn die Funk- +tionstastentabelle voll ist. Soll die Funktionstastendefinition auch noch +nach dem Abschalten des Terminals erhalten bleiben, dann mu in der Komman- +dozeile gegeben werden, damit der Setup samt Funktionstastende- +finitionen auf die Diskette geschrieben wird. + +Mit dem Kommando + + #ib(1)# e#ie(1)# (Hex 1B 65 ) + +wird eine Taste belegt. und sind Byteparameter. ist eine +Folge von Datenbytes, deren Bit 7 = 0 sein mu. ist der Code der Funk- +tionstaste (Bit 7 = 1), auf die die Sequenz gelegt werden soll. Durch diese +Einschrnkung sind keine rekursiven (sich selbst aufrufenden) Tastenkomman- +dos mglich, man kann allerdings z.B. auch nicht alle binren Parameter auf +Tasten legen (Man sollte dezimale Parameter benutzen). Die Cursortasten etc. +knnen nicht belegt werden. +Um die Original-Tastencodes wieder zu benutzen, gibt es drei Mglichkeiten: + +- Die Tabelle der Tastendefinitionen wird ganz gelscht (Abschnitt 9.6). +- Die Definition auf einzelnen Tasten wird durch e gelscht. + ist dabei der Code einer zu lschenden Taste. +- In der ersten Kommandozeile wird F CODE eingeschaltet oder das Kommando + + #ib(1)# c#ie(1)# (Hex 1B 63) + + gegeben. Dieses Kommando schaltet um, ob immer Tastencodes (A1..EF) oder, + bei belegten Tasten, die programmierte Sequenz geliefert werden soll. Im + Graphikmodus mchte man eventuell die griechischen Sonderzeichen auf den + Funktionstasten benutzen (F CODE) und nicht die programmierten Tasten- + strings (F STRG). + + +#k("9.5.1", "Local-Escape")# + +Um Funktionstasten mit Terminalkommandos auch im Online-Modus benutzen zu +knnen (zum Beispiel ein Bildschirm Hardcopy) wird ein spezielles ESC-Zei- +chen statt (Hex 1B) verwendet. +Das Zeichen + + #ib(1)##ie(1)# (Hex 9B) + +teilt dem Terminal mit, da die nun folgende Escape-Sequenz nicht an den +Host gesendet wird (was bei der Fall wre), sondern vom Terminal in- +terpretiert werden mu. +Im Local-Modus wirkt ein wie ein normales , d.h. das Kommando +wird sowieso vom Terminal interpretiert. + + +#k("9.5.2", "Makrokommandos")# + +Ein Makrokommando hat (mindestens) drei Aufgaben: +- Der Host kann dem Terminal neue ESC-Sequenzen (mit Parametern) definieren, + z.B. um andere Terminals zu emulieren. +- Nicht nur das Terminal kann Funktionstasten aufrufen, sondern auch der + Host, wenn die Funkionstaste als Makro aufgerufen wird. +- Der Datentransfer vom Host zum Terminal kann durch Makros als Abkrzungen + hufig benutzter Zeichenfolgen beschleunigt werden. + +Ein Makro wird wie eine Funktionstaste mit dem Kommando + + + #ib(1)# e#ie(1)# (Hex 1B 65 ) + +definiert. und sind Byteparameter. ist eine Folge von +Datenbytes, deren Bit 7 = 0 sein mu. ist der Code der Funktionstaste +(Bit 7 = 1) oder mit anderen Worten der Makroname. +Es sind alle Codes fr zugelassen, die auch bei der Funktionstastende- +finition zugelassen sind. + +Ein Makro kann sowohl vom Terminal (auch im F CODE-Modus) als auch vom Host +mit + + #ib(1)# #ie(1)# (Hex 1B ) + +aufgerufen werden. Dem Terminal wird die Zeichensequenz des Makros so vorge- +setzt, als kme sie von der Tastatur im Local-Modus. Wird das Makro also +bereits im Local-Modus aufgerufen, hat das immer noch den Vorteil, da man +im F CODE-Modus weiterhin programmierte Funktionstasten benutzen kann. +Anmerkung: Wird das vor dem weggelassen, dann wird der + Code ohne Makroausfhrung an das Terminal gesendet + und i.d.R. als inverses Zeichen dargestellt. + +Sollen Byteparameter in die Zeichensequenz des Makros bernommen werden, die +zur Zeit der Makrodefinition noch nicht feststehen, dann kann man einen +Platzhalter mit dem Code Hex 81 an der Stelle einsetzen. Der Code Hex 81 +kann auf der Tastatur durch erzeugt werden. +Wird bei der Makroausfhrung ein solcher Code gefunden, wartet das Terminal +auf ein Byte von Tastatur, wenn das Makro im Local-Modus aufgerufen wurde, +oder vom Host, wenn das Makro vom Host aufgerufen wurde. Es drfen beliebig +viele Codes 81 in der Makrozeichensequenz vorhanden sein. Jeder Code wird +durch ein weiteres Zeichen von Host oder Tastatur ersetzt. + + +#k("9.5.3", "Startup-Makro")# + +Ein besonderes Makro hat den Code Hex EF. Dieser Code kann auf der Tastatur +durch (beim Apple ) erzeugt werden. + +Dieses Makro wird bei einem RESET des Terminals (Hardwarereset oder 0) +oder beim Einschalten des Terminals aufgerufen. Der Bildschirm und die Gra- +phikseiten werden vorher gelscht. + + +#k("9.6", "Tabellen und Puffer lschen")# + +Das Terminal enthlt den Empfangspuffer, den Sendepuffer, den Druckerspoo- +ler und die Tabelle der Tastendefinitionen. Um einen der Puffer oder die +Tabelle zu lschen, kann das Kommando + + #ib(1)# #ie(1)# (Hex 1B 7F ) + +verwendet werden. ist ein Byteparameter mit dem Wertebereich 0 bis 15 +und hat folgende Bedeutung: + +#on("u")# Gelschte Tabelle oder Puffer#off("u")# + 0 Keine + 1 Tastendefinitionen + 2 Druckerspooler + 3 Empfangspuffer + 4 Sendepuffer + +Zu beachten ist, da zwar der Sendepuffer gelscht wird, aber eine eventu- +ell gestoppte bertragung (TX OFF) nicht wider gestartet wird. + + +#k("9.7", "Zeitverzgerung")# + +Mit dem Kommando + + #ib(1)# 9#ie(1)# (Hex 1B 39 ) + +kann eine Zeitverzgerung aufgerufen werden. Man kann zum Beispiel ein Fa- +denkreuz darstellen, die Zeitverzgerung aufrufen und das Fadenkreuz wieder +lschen. ist ein Byteparameter mit dem Wertebereich von 0 bis 255. Die +Verzgerung betrgt ca. * 2 ms. + + +#k("9.8", "Transparentmodi")# + +Der Monitor- und der Hexadezimalmodus sind zum Test von unbekannten Emp- +fangsdaten oder zum Analysieren der Steuerzeichenausgabe von unbekannten +Programmen gedacht. + + +#k("9.8.1", "Monitor-Modus")# + +Im Monitor-Modus werden druckbare Zeichen wie normal dargestellt. Control- +zeichen (Hex 00..1F und 80..9F) werden invertiert dargestellt. Im APL-Zei- +chensatz kann man diese inversen Controlzeichen von den Zeichen mit Code Hex +A0..FF unterscheiden, die auch invers dargestellt werden. +Der Monitormode kann in der ersten Kommandozeile ein- und ausgeschaltet +werden. Mit dem Kommando + + #ib(1)# U#ie(1)# (Hex 1B 55) + +kann der Monitormode eingeschaltet werden. Alle Zeichen werden ohne Inter- +pretation ausgegeben, Ausnahmen sind + + #ib(1)# u#ie(1)# (Hex 1B 75) + +und + + #ib(1)# X#ie(1)# (Hex 1B 58) + +die den Monitormodus ausschalten. + + +#k("9.8.2", "Hexadezimal-Modus")# + +In diesem Modus werden nicht die Zeichen auf dem Bildschirm gedruckt, son- +dern ihr ASCII-Code in hexadezimaler Schreibweise mit zwei nachfolgenden +Blanks. Der Hexmode kann mit dem Kommando + + #ib(1)# u#ie(1)# (Hex 1B 75) + +ein- und ausgeschaltet werden. Alle Zeichen werden ohne Interpretation aus- +gegeben, auer #ib(1)# u#ie(1)# und + + #ib(1)# X#ie(1)# (Hex 1B 58), + +die den Hexmodus wieder ausschalten. Auch der Hexmode kann in der ersten +Kommandozeile ein- und ausgeschaltet werden. + + +#k("9.8.3", "Einzelne Control-Zeichen anzeigen")# + +Um nur einzelne Controlzeichen auf dem Bildschirm darzustellen, z.B. fr den +unteren Teil des APL-Zeichensatzes (Codes 0 bis 31 oder 128 bis 159), gibt +es das Kommando + + #ib(1)# F#ie(1)# (Hex 1B 46 ). + + ist dabei ein Byteparameter mit dem Wertebereich 0 bis 255, vorzugswei- +se 0 bis 31. wir mit invertiertem Bit 7 (normal/invers) in den Bild- +schirmspeicher an der aktuellen Cursorposition geschrieben. diff --git a/system/ruc-terminal/unknown/doc/TDOCP.PRT b/system/ruc-terminal/unknown/doc/TDOCP.PRT new file mode 100644 index 0000000..c3bdeb4 --- /dev/null +++ b/system/ruc-terminal/unknown/doc/TDOCP.PRT @@ -0,0 +1,4008 @@ +#type ("elite")##limit (16.2)##block# +#page##--------------------------------- Ende der Seite 0 -----------# +#text begin# + +#type ("8")##center##on("b")##on("u")#Bedienungshandbuch zum ruc - Graphikterminal#off("u")##off("b")##type ("elite")# + +#center#Version 1.1 + +#center#Oktober 1986 +#free (16.0)# +ruc - Rolf Uhlig Computer +GmbH & Co Kommanditgesellschaft +Sendenhorster Strae 82 +D - 4406 Drensteinfurt 1 +Telefon 02508/8500 + +Michael Staubermann +Mornenstrae 29 +D - 4400 Mnster-Hiltrup +Telefon 02501/4320 +#pagenr (""224"", 1)# +#text end# +#free(2.2225)# +#page##--------------------------------- Ende der Seite 1 -----------# +#center##on("b")#1. Einige Worte zuvor#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +#type("8")##center##on("i")##on("u")##ib(3)#1. Einige Worte zuvor#ie(3)##off("u")##off("i")##type("elite")# + + +Dieses Terminalprogramm wird in zwei Versionen (fr den Basis 108 und den +Apple IIe) geliefert. Die Version ist in der Kommandozeile erkenntlich +(BASIS oder APPLE). + +Eigenschaften des Terminals: + +- Kommandozeilen fr schnelle Offline Parametereinstellung +- Statuszeile fr spezielle Betriebzustnde +- ber 70 programmierbare Funktionstasten +- Druckerspooler 32k (4 ganze Graphikhardcopys und noch mehr) +- 7935 Zeichen Empfangspuffer +- Verschiedene Hardcopy Modi fr Text und Graphik +- 192x280 Punkte auflsender Graphikmodus mit zwei Helligkeitsstufen +- Zwei Graphikseiten mit getrennter Anzeige/Bearbeitung +- Viele Graphikroutinen (Bogen, Flchenfllung, Kreis, Rechteck...) +- Graphikmodus fr Texte in verschieden Richtungen, Dicken, Grssen +- Griechische Graphikzeichen und Kursivschrift +- Graphikseiten Scrollen, Mischen, vom Host laden, zum Host schicken + + +Zum Handbuch + +Tasten werden durch Angabe ihres Aufdruckes in Grossbuchstaben angegeben und +in spitze Klammern gesetzt (z.B. ) in einigen Fllen auch durch ihren +Namen (z.B. oder ). Eine zustzlich zu bettigende Umschalt- +taste, wie SHIFT, CTRL, OPEN APPLE (kurz: OA) oder beide zusammen, wird in +der Klammer davorgestellt (z.B. ). + +Nicht druckbare Ascii-Codes (z.B. oder ), sowie Kommandopara- +meter (z.B. ) werden ebenfalls in spitze Klammern gesetzt. Komandopara- +meter werden mit Kleinbuchstaben bezeichnet. + +#text end# +#free(7.220185)# + + + 1 +#page##--------------------------------- Ende der Seite 1 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +#type("8")##center##on("i")##on("u")##ib(3)#2. Die Hardware#ie(3)##off("u")##off("i")##type("elite")# + + +Untersttzt wird eine 80-Zeichen Textanzeige, ein Basiskeyboard oder ein +Applekeyboard mit Open-Apple Taste. Am Basis kann ein Drucker angeschlossen +werden. + + +#type("8")##center##ib(3)#2.1 Die serielle Schnittstelle#ie(3)##type("elite")# + +Die Parameter der seriellen Schnittstelle knnen vom Host oder vom Terminal +(LOCAL) eingestellt werden (Siehe Kommando ). Es wer- +den alle 15 gngigen Baudrates zwischen 50 und 19200 Baud untersttzt. Pari- +tycheck kann mit gerader oder ungerader Paritt durchgefhrt werden. Flu- +kontrolle ist in allen Kombinationen aus RTS/CTS, DTR/DSR, XON/XOFF mglich. +Empfohlen wird DTR/DSR oder XON/XOFF. + + Bentigte Verdrahtung der seriellen Schnittstelle + + Pin Prioritt + 2 : TXD Sendedaten zum Host (RXD) 1 + 3 : RXD Empfangsdaten vom Host (TXD) 1 + 4 : RTS Ready To Send zum Host (CTS) 3 + 5 : CTS Clear To Send vom Host (RTS) 3 + 6 : DSR DataSet Ready vom Host (DTR) 2 + 7 : Masse an Host Masse 1 + 8 : DCD Eingang, nicht bentigt + 20 : DTR Data Terminal Ready zum Host (DSR) 2 + +Prioritt: + 1 : Mu verdrahtet werden + 2 : Ist bei DSR/DTR Flukontrolle zu verdrahten + 3 : Ist bei RTS/CTS Flukontrolle zu verdrahten + +Der Datentransfer geschieht in der Regel mit 8 Datenbits. Sollte der Host +nur ber 7 Bit Datentransfer verfgen, mssen einige Einschrnkungen bei der +Parameterbergabe von Uploads/Downloads gemacht werden (Kein Farbbit). Die +Anzahl der Datenbits kann auch in der Kommandozeile verndert werden. + + +#type("8")##center##ib(3)#2.2 Der Reset#ie(3)##type("elite")# + +Ein Reset bringt das Terminal in einen definierten Zustand. Alle Bildschirm- +seiten und Puffer, sowie der Druckerspooler werden gelscht. Der Reset kann +vom Host durch + + #ib(1)# 0#ie(1)# (Hex 1B 30) + +initiiert werden, vom Basiskeyboard aus durch . Die Para- +meter in der Kommandozeile werden dem Setup entnommen. Nach dem Lschen +aller Bildschirmseiten, wird das Makro mit dem Code Hex EF aufgerufen. Dies +ist die Funktionstaste . +#text end# +#free(02.351852e-2)# + + +#right#2 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 2 -----------# +#center##on("b")#3. Die Kommandozeile#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +#type("8")##center##on("i")##on("u")##ib(3)#3. Die Kommandozeile#ie(3)##off("u")##off("i")##type("elite")# + + +Die wichtigsten Parameter des Terminals knnen im laufenden Betrieb in den +beiden Kommandozeilen gendert werden. Die erste Kommandozeile erscheint +beim Basiskeyboard durch Drcken von und beim Apple durch . + +Im Graphikmodus ersetzt die Kommandozeile die untersten 32 Graphikzeilen +(entspricht vier Textzeilen). Man hat also auch im Graphikmodus die Mg- +lichkeit wichtige Parameter in der Kommandozeile zu ndern. + +Die angezeigten Einstellungen bieten auerdem eine Informationsmglichkeit +ber die aktuellen Parameter der seriellen Schnittstelle u.s.w. Die zweite +Kommandozeile enthlt die Parameter der seriellen Schnittstelle. + +Alle in den Kommandozeilen angezeigten Parameter (bis auf BELL ON/BELL OFF) +knnen auch durch ESC-Kommandos vom Host oder im Localmodus gendert wer- +den. +Ein laufender Druckvorgang wird unterbrochen, solange die Kommandozeilen +sichtbar sind. + + +#type("8")##center##ib(3)#3.1 Tastenfunktionen in der Kommandozeile#ie(3)##type("elite")# + +Folgende Tasten haben in der Kommandozeile eine Wirkung: + +Taste Bedeutung +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + oder Wechselt in die jeweils andere Kommandozeile + + Springt zum vorherigen (linken) Parameter ohne etwas zu + verndern. + + Springt zum nchsten (rechten) Parameter ohne etwas zu + verndern. + + ndert das selektierte Parameterfeld. Das selektierte + Parameterfeld ist durch Invertierung hervorgehoben. Die + mglichen Parameter wiederholen sich zyklisch. + + Die Kommandozeile wird verlassen. Es werden keine nde- + rungen durchgefhrt. + + Die Kommandozeile wird verlassen. Vorher werden alle + nderungen permanent auf die Diskette geschrieben. Wei- + tere Einzelheiten s.u. (Setup) + +#text end# +#clear pos# +#free(1.716852)# + + + 3 +#page##--------------------------------- Ende der Seite 3 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")# +#text begin# + Alle Parameter werden auf ihre Defaultwerte zurckge- + setzt. Die Kommandozeile wird noch nicht verlassen, daher + kann dieser 'Reset' durch wieder aufgehoben werden. + oder Die Kommandozeile wird verlassen. Die + nderungen werden nur im Speicher vermerkt. Nach dem + Ein-/Ausschalten des Rechners werden die alten Parameter + von der Diskette gelesen. Wird allerdings ein Hardware- + reset (s.o.) durchgefhrt, sind diese nderungen nicht + verloren. + + +#type("8")##center##ib(3)#3.2 Setup#ie(3)##type("elite")# + +Beim Setup, der in der Kommandozeile durch ausgelst werden kann, +werden wichtige Parameter auf die Diskette geschrieben. Sie werden dann +'permanent' und mssen nach dem Einschalten des Terminals nicht neu einge- +stellt werden. Diese Parameter sind die +- Parameter der seriellen Schnittstelle (2. Kommandozeile) +- anderen Parameter der Kommandozeilen +- vom Benutzer programmierte Belegung der Funktionstasten +- Druckerspezifischen Hardcopyparameter + +Vor dem Setup ist zu prfen, ob der Diskettenschreibschutz entfernt wurde +(Klebeschildchen an der Diskettenseite entfernen). Der Schreibschutz sollte +nach dem Setup wieder angebracht werden. Wurde der Schreibschutz nicht ent- +fernt, wird eine Meldung 'Diskettenschreibschutz entfernen !' angezeigt. In +diesem Falle erscheint nach dem Drcken einer Taste wieder die Kommando- +zeile. +Wenn keine Diskette einliegt oder ein harter Schreibfehler auftritt, er- +scheint die Meldung 'Setup kann nicht geschrieben werden (Diskettenfeh- +ler)!'. Weitere Schreibversuche sind mglicherweise erfolgreich. + + +#type("8")##center##ib(3)#3.3 Die zweite Kommandozeile#ie(3)##type("elite")# + +Beim Basis (erste Zeile zeigt Defaultwerte fr ) + +#type ("micron")# +GER|BASIS|MON OFF|PRT OFF|SCRN ON |KEY CLK|NORVID|SCROLL|BELL ON |CUR FLH|F STRG +USA TVI MON ON PRT ON SCRN OFF CLK OFF REVVID PAGE BELL OFF CUR STD F CODE +APL HEX ON CUR OFF +UNI +#type ("elite")# + +Beim Apple (erste Zeile zeigt Defaultwerte fr ) + +#type ("micron")# +USA|APPLE|MON OFF|PRT OFF|SCRN ON |KEY CLK|NORVID|SCROLL|BELL ON |CUR FLH|F STRG +FLH TVI MON ON PRT ON SCRN OFF CLK OFF REVVID PAGE BELL OFF CUR STD F CODE + HEX ON CUR OFF +#type ("elite")# + + +#text end# +#clear pos# +#free(1.293519)# + + +#right#4 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 4 -----------# +#center##on("b")#3. Die Kommandozeile#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")# +#text begin# +Default Andere Funktion +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# +Basis + GER USA Die Zeichensatzeinstellung ist fr die gebruchlichsten + APL vier Zeichenstze in der Kommandozeile mglich. + UNI GER = Deutsch Ascii, USA = US Ascii, APL = APL-Zeichensatz + UNI = Deutscher Zeichensatz mit inversen APL Zeichen. Der + APL-Zeichensatz enthlt auch die Zeichen [\]{|}~. ber + ESC-Kommandos lassen weitere Mglichkeiten einstellen. + + BASIS TVI Keyboard Emulation. BASIS sendet die Funktionstastencodes + mit Bit 7 = 1. TVI sendet fr jede Funktionstaste eine + Zeichenfolge x . Die Cursortasten sowie DEL CHAR, + INS CHAR, DEL LINE, INS LINE werden wie bei TVI blich + gesendet. Weiter Einzelheiten s.u. (TVI-Emulation) + +Apple + USA FLH USA = US Ascii, FLH = Voller Ascii Zeichensatz mit Blinken + und Invers. + + APPLE TVI Keyboard Emulation. APPLE fhrt keine Codeumsetzung durch. + Wird allerdings die -Taste mit einer anderen + Taste zusammen gedrckt, wird das Bit 7 im Code auf 1 ge- + setzt. Zur TVI-Emulation siehe oben. + +MON OFF MON ON Der Monitor Modus wird mit MON ON eingeschaltet. In diesem + HEX ON Modus werden alle Steuerzeichen auf dem Bildschirm mar- + kiert ausgegeben. Bis auf die Kommandos u oder + X (um den Monitormodus auszuschalten) werden keine Komman- + dos interpretiert. Alle anderen Zeichen werden unverndert + dargestellt. Der Monitormodus kann auch durch MON OFF aus- + geschaltet werden. + Im Hexmodus werden keine Zeichen, sondern deren Ascii- + Codes in Hexadezimaldarstellung ausgegeben. + +PRT OFF PRT ON Parallele Druckerausgabe. Ist PRT ON eingeschaltet, werden + alle Zeichen die von der seriellen Schnittstelle kommen, + auf dem Drucker ausgegeben bzw. in den Druckerspooler ge- + schrieben. Die Bildschirmausgabe wird hiervon nicht beein- + flut. + +SCRN ON SCR OFF Bildschirmausgabe an/aus. Ist SCRN ON eingeschaltet, wer- + den alle Zeichen die von der seriellen Schnittstelle kom- + men, auf dem Bildschirm ausgegeben. SCR OFF und PRT ON kann + zum Beispiel benutzt werden, um Daten nur an den Drucker zu + schicken, ohne da diese auch auf dem Bildschirm erschei- + nen. + +KEY CLK CLK OFF Tastaturklick an/aus. Ist KEY CLK eingeschaltet, gibt jede + Taste (bis auf SHIFT, CTRL) bei ihrer Bettigung einen Ton + (Klick) von sich. CLK OFF schaltet dies ab. + +#text end# +#clear pos# +#free(02.351852e-2)# + + + 5 +#page##--------------------------------- Ende der Seite 5 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +NORVID REVVID Bildschirmdarstellung. NORVID stellt hellen Text auf + schwarzem Grund dar, REVVID stellt schwarzen Text auf hel- + lem Grund dar (Mglicherweise angenehmer fr die Augen). + +SCROLL PAGE Ist SCROLL eingeschaltet, wird der Bildschirm um eine Zeile + nach oben geschoben, sobald der Cursor in der letzten Bild- + schirmzeile steht und ein Zeilenvorschub ausgefhrt + werden soll. Die erste Bildschirmzeile verschwindet. Ist + PAGE eingeschaltet, springt der Cursor in einer solchen + Situation in die erste Bildschirmzeile. Die Cursorspalte + wird dabei nicht verndert. + +BELL ON BELL OFF Normalerweise erzeugt jedes empfangene einen kur- + zen Signalton. Wenn das strt, kann die Tonausgabe mit BELL + OFF abgeschaltet werden. + +CUR FLH CUR STD Cursordarstellung. CUR FLH zeigt einen blinkenden CUR OFF + Cursorblock. CUR STD zeigt einen nichtblinkenden Cursor- + block. CUR OFF schaltet den Cursor ab (unsichtbar). + +F STRG F CODE Funktionstastenbelegung. Ist F STRG eingeschaltet, erzeugt + eine programmierte (belegte) Funktionstaste keinen Tasten- + code, sondern sendet die programmierten Zeichen. Eine unbe- + legte Funktionstaste sendet ihren Tastencode. Ist F CODE + eingeschaltet, erzeugen auch belegte Funktionstasten einen + Tastencode und senden keine programmierten Zeichen. + + +#type("8")##center##ib(3)#3.4 Die zweite Kommandozeile#ie(3)##type("elite")# + +Die erste Zeile zeigt Defaultwerte fr : + +#type ("micron")# +STATOFF|TXT| 9600|STOP 1|DATA 8|NO PAR|NO XONOFF|NO RTSCTS|NO DTRDSR +STAT ON GFX 19200 STOP 2 DATA 7 EVN PAR XON/XOFF RTS/CTS DTR/DSR + 50 ODD PAR + 75 + 109.9 + 134.6 + 150 + 300 + 600 + 1200 + 1800 + 2400 + 3600 + 4800 + 7200 +#type ("elite")# + +#text end# +#clear pos# +#free(1.716852)# + + +#right#6 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 6 -----------# +#center##on("b")#3. Die Kommandozeile#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Default Andere Funktion +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# +STATOFF STAT ON Anzeige der Statuszeile. Der Arbeitsbereich des Bildschirms + betrgt zwar immer 24 Zeilen, allerdings ist bei STAT ON + anstelle der 24. Textzeile die Statuszeile sichtbar. Bei + STATOFF wird der aktuelle Inhalt der 24. Textzeile sicht- + bar. Einzelheiten s.u. (Die Statuszeile) + +TXT GFX Textmodus/Graphikmodus. TXT schaltet in die 80x24 Zeichen + Textdarstellung um. GFX schaltet auf die aktuelle Graphik- + seite um. + +9600 19200 Whlt die Baudrate fr die serielle Schnittstelle. + 50 Die Angabe erfolgt in Bits/Sekunde (Baud) + 75 + 109.9 + 134.6 + 150 + 300 + 600 + 1200 + 1800 + 2400 + 3600 + 4800 + 7200 + +STOP 1 STOP 2 Whlt die Anzahl der Stopbits fr die serielle Schnitt- + stelle. + +DATA 8 DATA 7 Whlt die Anzahl der Datenbits fr die serielle Schnitt- + stelle. + +NO PAR EVN PAR Whlt Parity Check Art. NO PAR = Kein Parittsbit, keine + ODD PAR Parittsprfung. EVN PAR = Gerade Paritt, ODD PAR = Unge- + rade Paritt. + +NO XONOFF Whlt XON (CTRL Q) und XOFF (CTRL S) als Protokoll fr die + XON/XOFF serielle Schnittstelle. Wird XOFF vom Host gesendet, kann + das Terminal noch 255 Zeichen empfangen, bis der Empfangs- + puffer berluft. Mit NO XONXOFF wird dieses Protokoll + ausgeschaltet. + +NO RTSCTS Whlt RTS/CTS als Protokoll fr die serielle Schnittstel- + RTS/CTS le. Mit NO RTSCTS wird dieses Protokoll ausgeschaltet. + +NO DTRDSR Whlt DTR/DSR als Protokoll fr die serielle Schnittstel- + DTR/DSR le. Mit NO DTRDSR wird dieses Protokoll ausgeschaltet. + +#text end# +#clear pos# +#free(1.293519)# + + + 7 +#page##--------------------------------- Ende der Seite 7 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##on("i")##on("u")##ib(3)#4. Die Statuszeile#ie(3)##off("u")##off("i")##type("elite")# + + +Die Statuszeile enthlt 5 Felder, die ber die wichtigsten Betriebszustnde +des Terminals Auskunft geben. Die Statuszeile ersetzt die (dann in den 'Hin- +tergrund' verlegte) 24. Zeile. Die Statuszeile kann in der Kommandozeile mit +STAT ON oder vom Host oder im Local Modus mit + + #ib(1)# }#ie(1)# (Hex 1B 7D) + +eingeschaltet werden. Ausschalten ebenso mit STATOFF oder + + #ib(1)# {#ie(1)# (Hex 1B 7B) + +Die Zuordnung der Felder: + +#type ("micron")# +Spooler | Empfngerpuffer | Senderpuffer | Bereit/Beschftigt | Local/Online +#type ("elite")# + +Kritische Zustnde werden invers markiert. Dies sind alle Flle, in denen +ein Puffer berluft. +Ist dies beim Empfangspuffer der Fall (RX FULL), gehen Daten verloren. +Sollte der Druckerpuffer voll sein (PR FULL) und das Terminal keine Eingabe +mehr annehmen, kann man durch lngeres Drcken von Zeichen aus +dem Druckerpuffer entfernen, damit wieder Platz frei wird. +Sollte der Senderpuffer voll sein (TX FULL), so liegt das wahrscheinlich +daran, da der Host kein XON gesendet hat oder dieses falsch bertragen +wurde. Durch Drcken von kann man den Transmitter wieder star- +ten. + + +#type("8")##center##ib(3)#4.1 Spoolerstatus#ie(3)##type("elite")# + +- Ein leeres Feld bedeutet: Der Spooler (Druckerpuffer) ist leer, es ist + nichts zum Drucken im Puffer. + +- PRINT zeigt an: Der Spooler ist gefllt. Das Terminal ist druckwillig oder + der Drucker druckt. + +- PR FULL bedeutet: Der Druckerpuffer ist voll. Da das Terminal keine wei- + teren Zeichen annimmt bis wieder Platz im Druckerpuffer ist, kann man + einzelne Zeichen mit aus dem Druckerpuffer entfernen bis PRINT + im Feld erscheint. + + +#type("8")##center##ib(3)#4.2 Empfngerstatus#ie(3)##type("elite")# + +- Ein leeres Feld bedeutet: Im Empfngerpuffer ist noch Platz. + +- RX FULL zeigt an: Es gehen Empfangsdaten verloren, da der Empfngerpuffer + voll ist. + + +#text end# +#clear pos# +#free(02.351852e-2)# + + +#right#8 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 8 -----------# +#center##on("b")#4. Die Statuszeile#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#4.3 Senderstatus#ie(3)##type("elite")# + +- TX ON bedeutet: Der Sender ist eingeschaltet. Wenn jetzt ein Zeichen ge- + sendet werden mu, wird es sofort auf die serielle Schnittstelle ge- + schickt. + Ein > vor TX ON zeigt an, da das Terminal auf Freiwerden der seriellen + Schnittstelle wartet. + +- TX OFF bedeutet: Der Host hat entweder XOFF gesendet oder die Hardware- + flukontrolle aktiviert, um das Terminal zu stoppen. + +- TX FULL zeigt an: Der Senderpuffer ist voll. Das Terminal nimmt keine + Eingaben mehr an bis der Puffer wieder frei ist. Dies kann mit + erzwungen werden. + + +#type("8")##center##ib(3)#4.4 Busy - Anzeige#ie(3)##type("elite")# + +- READY bedeutet: Der Empfnger ist empfangsbereit, d.h. im Empfangspuffer + sind noch mindestens 256 Zeichen frei und das Terminal hat den Host nicht + per Flukontrolle gestoppt. + +- BUSY bedeutet: Der Empfnger hat dem Host per Flukontrolle angezeigt, da + nicht mehr gengend Platz im Empfangspuffer war. Die Flukontrolle wird + wieder freigegeben, wenn nur noch 256 Bytes im Empfangspuffer sind. + (Warnung: Wenn BUSY angezeigt wird, eine Taste gedrckt wird und der Host + #on("u")#nicht#off("u")# empfangsbereit ist, gert das Terminal in eine + "Deadlock-Situation", die (mit Datenverlust) nur durch einen Hardwarereset + abgebrochen werden kann.) + + +#type("8")##center##ib(3)#4.5 Online/Local - Anzeige#ie(3)##type("elite")# + +- ONLINE bedeutet: Das Terminal sendet Tasteneingaben an den Host und emp- + fngt Zeichen und Kommandos vom Host. + +- LOCAL bedeutet: Keyboardeingaben erscheinen auf dem Bildschirm bzw. blei- + ben innerhalb des Terminals. Escape-Kommandos wirken direkt auf das Ter- + minal. + +#text end# +#clear pos# +#free(5.103519)# + + + 9 +#page##--------------------------------- Ende der Seite 9 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##on("i")##on("u")##ib(3)#5. Die Bedeutung der Tasten#ie(3)##off("u")##off("i")##type("elite")# + + +Zustzlich zu den normalerweise von der Tastatur gesendeten Tastencodes sind +einige weitere zur Verfgung gestellt worden. Beim Apple senden fast alle +Tasten mit Open-Apple zusammen einen Code mit Bit 7 = 1. Diese werden vom +Terminal als Funktions- oder Steuertasten interpretiert. Beim Basis wurden +einige bisher nur einfach belegte Tasten wie , , , +und der Zehnerblock mit Doppelfunktionen ber versehen. + + +#type("8")##center##ib(3)#5.1 Die Funktions- und Steuertasten#ie(3)##type("elite")# + +Zuerst werden die Tastenfunktionen erlutert fr ein nicht emulierendes +Terminal. Die TVI-Emulation kann in der Kommandozeile abgeschaltet werden +(1. Zeile, 2. Feld) oder mit dem Kommando + + #ib(1)# 0#ie(1)# (Hex 1B 20 30) + +Die Cursortasten liefern beim Basiskeyboard andere Tastencodes als beim +Applekeyboard. Wird das Bit 7 ignoriert (ausgeblendet), stimmen die Codes +berein. bezeichnet beim Basiskeyboard die linke obere Eckposi- +tion des Cursorblocks, die rechte obere etc. + +Basis-Taste Apple-Taste Hex-Code Bedeutung +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 09 Der Cursor wird an die nchste (re- + chte) Tabulatorposition gesetzt. + Tabulatorpositionen sind alle 8 Spal- + ten. Also 1, 9, 17, 25, 33, 41, 49, + 57, 65, 73. War der Cursor in Spalte + 73 bis 79, dann wird er in die erste + Spalte der nchst tieferen Bild- + schirmzeile gesetzt. War der Cursor + vorher auch noch in Zeile 24, dann + wird der Bildschirminhalt entweder + nach oben gescrollt (SCROLL) oder in + Homeposition gebracht (PAGE). + + 89 Back-Tab (Rckwrtstabulator). Der + Cursor wird in die nchste links vom + Cursor befindliche Tabulatorposition + gebracht. War der Cursor in Spalte 1, + dann steht er jetzt in Spalte 73 der + darberliegenden Zeile. War der Cur- + sor in Homeposition, dann ndert sich + seine Position nicht. + + - Kommandozeile aktivieren. Einzelhei- + ten zur Kommandozeile siehe Abschnitt + 3.: Die Kommandozeilen. + +#text end# +#clear pos# +#free(02.351852e-2)# + + +#right#10 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 10 -----------# +#center##on("b")#5. Die Bedeutung der Tasten#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# + 18 U.a. Kommandozeile verlassen. + + 0D Zum Zeilenanfang ohne Zeilenvorschub. + Der Cursor steht dann in der ersten + Spalte der Zeile. + + 8D Zum Anfang der nchsten Zeile. Falls + der Cursor in der letzten (24.) Bild- + schirmzeile war, wird der Bildschir- + minhalt entweder nach oben gescrollt + (SCROLL) oder in Homeposition ge- + bracht (PAGE). + + 8B/0B Cursor eine Zeile hher. War der + Cursor in der ersten Bildschirmzei- + le, ndert sich seine Position nicht. + + 8A/0A Cursor eine Zeile tiefer. War der + Cursor in Zeile 24, dann wird der + Bildschirminhalt entweder nach oben + gescrollt (SCROLL) oder der Cursor in + die erste Bildschirmzeile gesetzt + (PAGE). + + 16 Cursor eine Zeile tiefer. War der + Cursor in Zeile 24, dann ndert er + seine Position nicht. Die Spalte + ndert sich nicht. + + 88/08 Cursor eine Spalte nach links. War + der Cursor in der ersten Bildschirm- + spalte, dann steht er jetzt in der + letzten Spalte der darberliegenden + Bildschirmspalte. War der Cursor + allerdings in Homeposition, ndert + sich seine Position nicht. + + - 95 Cursor eine Spalte nach rechts. War + der Cursor in Spalte 79, dann steht + er jetzt in der ersten Spalte der + folgenden Zeile. War der Cursor in + der letzten Zeile, dann wird der + Bildschirminhalt um eine Zeile nach + oben gescrollt (SCROLL) oder der + Cursor in Homeposition gebracht + (PAGE). + + C0 Der Cursor wird in die linke obere + Bildschirmecke gebracht (Homeposi- + tion). + + D0 Bildschirm lschen und Cursor Home. +#text end# +#clear pos# +#free(02.351852e-2)# + + + 11 +#page##--------------------------------- Ende der Seite 11 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# + 7F Dieses Zeichen wird auf dem Bild- + schirm als Punktraster dargestellt. + Der Host interpretiert es in der + Regel als Zeichenlschbefehl. + + 8E Zeichen bei Cursorposition einfgen. + Der Cursor ndert seine Position + nicht. Unter dem Cursor steht dann + ein Leerzeichen. Das Zeichen in Spal- + te 79 geht verloren. + + 82 Zeichen unter Cursorposition lschen. + In Spalte 79 steht dann ein Leerzei- + chen. + + 8F Zeile bei Cursorposition einfgen. + Die Cursorposition ndert sich nicht. + Der Inhalt der letzten Bildschirmzei- + le ist verloren. Die Zeile in der der + Cursor steht wird mit Leerzeichen + gefllt. + + 83 Zeile in der der Cursor steht l- + schen. Die Cursorposition ndert sich + nicht. Der Inhalt der gelschten + Zeile ist verloren. Die letzte Bild- + schirmzeile wird mit Leerzeichen + aufgefllt. + + 08 Cursor eine Spalte nach links. Die + Funktion ist mit der von iden- + tisch. + + 15 Apple: Cursor eine Spalte nach re- + chts. Die Funktion ist mit der von + identisch. + + EF Diese Taste ist eine programmierbare + Funktionstaste (siehe e). + + 81 Diese das liefert den + Makroparametercode (siehe e). + + 1B Leitet eine Escape-Sequenz ein. + + 9B Whrend der Funktionstastedefinition + wirkt diese Taste wie ein Local + Escape, sonst liefert sie den Code 9B. + (siehe e). + + - Local/Online umschalten. + +#text end# +#clear pos# +#free(02.351852e-2)# + + +#right#12 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 12 -----------# +#center##on("b")#5. Die Bedeutung der Tasten#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# + '00' Sendet V24-Break (Hexcode 00 mit + Rahmenfehler). Als Rahmenfehler wird + das Fehlen des oder der Stopbits + bezeichnet (Stopbitpegel ist norma- + lerweise 1, bei Break dagegen 0). + +#on("u")#Zehnerblock:#off("u")# + + ... ... E1 ... programmierbare Funktionstasten + E9 " " + EA " " + EB " " + EC " " + ED " " + + EF " " + (Dieser Code wird beim RESET des + Terminals ausgefhrt. Der Benut- + zer kann damit das Terminal nach + seinen Wnschen konfigurieren.) + + +#on("u")#Funktionstasten:#off("u")# + + ... ... C1 " " + CF " " + ... ... D1 " " + DF " " + ... ... A1 " " + AF " " +.. ... B1 " " + BF " " + +Die Programmierung der Funktionstasten geschieht mit #ib(1)# e#ie(1)#. + + +#type("8")##center##ib(3)#5.2 Die TVI-Emulation#ie(3)##type("elite")# + +Wird das Terminal in den TVI-Emulationsmode gebracht, dann senden einige +Tasten andere Tastencodes oder Codesequenzen. Die Bedeutung der Escape- +Sequenzen ndert sich dadurch nicht. +Der TVI-Modus kann in der Kommandozeile eingeschaltet werden (1. Zeile, 2. +Feld) oder durch + + #ib(1)# 1#ie(1)# (Hex 1B 20 31) + +An dieser Stelle erscheinen nur noch die Tastenbezeichnungen des Basiskey- +boards. Die entsprechenden Tasten, die beim Applekeyboard zu drcken sind, +kann man im letzten Abschnitt nachlesen. + +#text end# +#clear pos# +#free(08.701852e-1)# + + + 13 +#page##--------------------------------- Ende der Seite 13 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Folgende Tasten senden andere Tastencodes: + +Taste TVI-Code(sequenz) Bemerkung +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 0C #ib(1)##ie(1)# Cursor nach rechts + + 1E #ib(1)##ie(1)# Cursor in Homeposition + + 1A #ib(1)##ie(1)# Durch Drcken von + Bildschirm lschen und Cursor Home + + 1B 57 #ib(1)# W#ie(1)# Durch Drcken von + Zeichen lschen + + 1B 52 #ib(1)# R#ie(1)# Durch Drcken von + Zeile lschen + + 1B 51 #ib(1)# Q#ie(1)# Durch Drcken von + Zeichen einfgen + + 1B 45 #ib(1)# E#ie(1)# Durch Drcken von + Zeile einfgen + + 08 #ib(1)##ie(1)# Cursor nach links + + 1B 49 #ib(1)# I#ie(1)# Durch Drcken von + Rckwrtstabulator + + 0A #ib(1)##ie(1)# Cursor nach unten + + 0B #ib(1)##ie(1)# Cursor nach oben + + 1F #ib(1)##ie(1)# Durch Drcken von + Waagenrcklauf und Zeilenvorschub + + +#on("u")#Funktionstasten:#off("u")# + +Fr jede Funktionstaste, die nicht belegt wurde wird eine Codesequenz der +Form also 01 0D gesendet. Fr gilt: + +Taste Hex-Code + ... @ ... 40 ... Diese Tasten sind auf fast allen + J 4A TVI-Terminals vorhanden. + ... ` ... 60 ... + c 63 + + ... K ... 4B ... + Y 59 + + +#text end# +#clear pos# +#free(04.468519e-1)# + + +#right#14 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 14 -----------# +#center##on("b")#5. Die Bedeutung der Tasten#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#on("u")#Zehnerblock:#off("u")# + + ... d ... 64 ... + l 6C + m 6D + n 6E + o 6F + p 70 + + r 72 + +Alle nicht in dieser Tabelle aufgefhrten Funktionstasten senden den Basis- +tastencode. + +#text end# +#clear pos# +#free(16.11019)# + + + 15 +#page##--------------------------------- Ende der Seite 15 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##on("i")##on("u")##ib(3)#6. Der Graphikmodus#ie(3)##off("u")##off("i")##type("elite")# + + +#type("8")##center##ib(3)#6.1 Allgemeines#ie(3)##type("elite")# + +Der Graphikmodus kann in der 2. Kommandozeile ein- und ausgeschaltet (Gra- +phik: GFX, Text: TXT) oder mit dem Kommando + + #ib(1)# $#ie(1)# (Hex 1B 24) + +eingeschaltet und mit dem Kommando + + #ib(1)# %#ie(1)# (Hex 1B 25) + +ausgeschaltet. + +Die Auflsung betrgt in y-Richtung 280 Punkte und in x-Richtung 192 Punk- +te, das sind 53760 Punkte. + + +#type("8")##center##ib(3)#6.2 Koordinaten und Parameterbergabe#ie(3)##type("elite")# + +Die Koordinaten fr die Graphikkommandos drfen den Bereich von -32768 bis +32767 berstreichen. Der sichtbare Bereich ist fr die X-Koordinate 0..279 +und fr die Y-Koordinate von 0..191. Der Ursprung (d.h. der Punkt (0,0) ) +des Koordinatensystems ist die linke untere Ecke. Die Graphikroutinen zeic- +hnen nur innerhalb des sichtbaren Bereichs (Clipping). + + +#type("8")##center##ib(3)#6.2.1 Cursorposition/Fadenkreuz#ie(3)##type("elite")# + +Der Graphikcursor ist ein gedachter unsichtbarer Punkt, der sich im gesam- +ten (auch unsichtbaren) Bereich des Koordinatensystems befinden kann. Wenn +sich der Cursor im sichtbaren Bereich befindet, dann kann man an der Posi- +tion ein Fadenkreuz darstellen. Das Fadenkreuz kann mit + + #ib(1)##ie(1)# oder #ib(1)##ie(1)# (Hex 18) + +ein- und ausgeschaltet werden. Das Fadenkreuz wird Exklusiv-Oder (XOR) ge- +zeichnet. Das heit, da die Punkte an der Stelle des Fadenkreuzes inver- +tiert (umgedreht) werden. Das hat wiederum zur Folge, da an der Graphik- +seite nichts verndert wird, wenn zweimal gesendet wird. Solange +der Bereich oder die Position des Fadenkreuzes nicht verndert wird, knnen +zwischen den beiden Kommandos auch andere Graphikkommandos ausge- +fhrt werden. + + +#text end# +#clear pos# +#free(2.140185)# + + +#right#16 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 16 -----------# +#center##on("b")#6. Der Graphikmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#6.2.2 Binre oder dezimale Parameter#ie(3)##type("elite")# + +Die bergabe der x/y Koordinaten, eines Radius oder relativer Koordinaten +und in einigen Fllen auch anderer Parameter, kann auf zwei verschiedene +Arten erfolgen. Das Terminal erkennt die bergabeart am ersten Parameterby- +te: +Bei dezimalen Parametern ist dies entweder , +, - oder eine Zahl. Bei +Binren Parametern liegt das Hherwertige Byte (das erste!) im Bereich von +00..1F oder 3A..FF. Die Festlegung auf dezimale oder binre Parameter gilt +fr beide (X und Y) Koordinaten. + + +#type("8")##center##ib(3)#6.2.2.1 Binre Parameter#ie(3)##type("elite")# + +Binre Parameter sind eine Folge von vier Bytes (mit 8 Bits). Die ersten +beiden Bytes stellen die X-Koordinate dar, die anderen beiden Bytes die +Y-Koordinate. Negative Koordinaten oder negative relative Koordinaten wer- +den durch Bilden des Zweierkomplements dargestellt. +Zu beachten ist, da zuerst das hherwertige (Highbyte) und dann das nie- +derwertige (Lowbyte) gesendet werden mu. + +Der Vorteil der binren Parameter ist, da die Parameterbergabe schneller +ist als bei dezimalen Parametern, da weder Host noch Terminal eine Konver- +tierung vornehmen mssen und die Anzahl der Parameterbytes in der Regel +geringer ist als bei dezimaler Parameterbergabe. + +Der Nachteil ist, da bei XON/XOFF Flukontrolle einige Zahlen als XON oder +XOFF interpretiert werden knnen und da diese Parameter nicht auf Funk- +tionstasten gelegt werden knnen, wenn sie Zeichen > Hex 7F enthalten. + + +#type("8")##center##ib(3)#6.2.2.2 Dezimale Parameter#ie(3)##type("elite")# + +Dezimale Parameter bestehen aus einer Folge von ASCII-Zeichen. Die beiden +Koordinaten werden durch einen Separator (Komma, CR, Semikolon o..) ge- +trennt. Nach dem 2. Parameter steht ein weiterer Separator. An beliebiger +Stelle in und vor den Zahlen drfen Leerzeichen () oder Pluszeichen +(+) stehen, die keine nderung des Ergebnisses bewirken. Ein Minuszeichen +vor einer Zahl negiert sie. + +Der Vorteil der dezimalen Parameter ist, da sie in hheren Programmier- +sprachen bequem und lesbar in ein Programm geschrieben werden knnen und da +keine Steuerzeichen vorkommen, die die XON/XOFF - Flukontrolle stren knn- +ten. Auerdem knnen diese Parameter immer auf Funktionstasten gelegt wer- +den, da sie keine Codes > Hex 7F enthalten. + +Der Nachteil ist wie unter 6.2.2.1 geschrieben, die Zeitdauer der zweima- +liegen Konvertierung (Host, Terminal) und die in der Regel lngeren Parame- +ter. + + +#text end# +#clear pos# +#free(04.468519e-1)# + + + 17 +#page##--------------------------------- Ende der Seite 17 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#6.2.3 Absolute oder relative Koordinaten#ie(3)##type("elite")# + +Bei den Move- und Drawbefehlen hat man die Wahl zwischen relativen und abso- +luten Koordinaten. + +Absolute Koordinaten setzen den Graphikcursor direkt auf die als Parameter +angegebene Position. Z.B. v 200, 100; setzt den Cursor direkt auf die +Position X=200, Y=100. Die meisten Programme untersttzen nur absolute Koor- +dinaten. + +Relative Koordinaten werden zur aktuellen Position des Graphikcursors ad- +diert. Das hat den Vorteil, da eine Routine nicht zu wissen braucht, wo der +Graphikcursor gerade steht. Man kann sich zum Beispiel Folgen von relativen +Move's und Draw's auf Funktionstasten legen, die dann im Localmodus an der +aktuellen Cursorposition irgendwelche Symbole oder Sonderzeichen zeichnen. +Z.B. q -4, 3; bewegt den Graphikcursor 4 Punkte nach links und 3 Punk- +te nach oben. + + +#type("8")##center##ib(3)#6.2.4 Byteparameter#ie(3)##type("elite")# + +Byteparameter sind solche, die nur aus einem Byte bestehen. Die Werte kn- +nen also normalerweise von 0 bis 255 oder Hex 00 bis Hex FF. In den Fllen, +in denen nicht der ganze Wertebereich genutzt wird, werden nur die nieder- +wertigsten Bits ausaskiert, die hherwertigen werden ignoriert, wenn nicht +ausdrcklich etwas anderes angegeben ist. Im Bereich von 0 bis 7 sind Wert +und ASCII-Ziffer identisch. Bei Werten groer als 9 geht das allerdings +nicht mehr. Sind zum Beispiel die Werte von 0 bis 15 erlaubt, dann kann man +folgende Tabelle benutzen: + +#on("u")#Wert ASCII (Hex) oder Binr#off("u")# + 0 0 30 00 + 1 1 31 01 + 2 2 32 02 + 3 3 33 03 + 4 4 34 04 + 5 5 35 05 + 6 6 36 06 + 7 7 37 07 + 8 8 38 08 + 9 9 39 09 + 10 : 3A 0A + 11 ; 3B 0B + 12 < 3C 0C + 13 = 3D 0D + 14 > 3E 0E + 15 ? 3F 0F + +Fr Werte zwischen 0 und 31 benutzt man dann besser die Buchstaben (Gro- +buchstaben und [\]^_ oder Kleinbuchstaben und {|}~ und ). Die Zuord- +nung entnimmt man der ASCII-Tabelle in Anhang A. + +#text end# +#clear pos# +#free(02.351852e-2)# + + +#right#18 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 18 -----------# +#center##on("b")#6. Der Graphikmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#6.3 Die Graphikparameter#ie(3)##type("elite")# + +Fr die Linien und Zeichen in der Graphik gibt es verschiedene Darstellungs- +weisen. Man kann die Strichdicke, die Farbe (auf einem Monochrommonitor die +Helligkeit), den Linientyp (durchgehend, gepunktet, gestrichelt etc.) und +die Bitverknpfungen (lschen, invertieren...) festlegen. Diese Parameter +werden mit einem Kommando O ... verndert. + +Mit dem Kommando + + #ib(1)# O 0#ie(1)# (Hex 1B 4F 30) + +werden all diese Parameter auf Defaultwerte zurckgesetzt. Diese Default- +werte sind: Strichdicke 1, durchgehende Linie, OR-Bitverknpfung (Punkte +setzen), helle Farbe (gelb). Ausserdem wird die Seite 0 als sichtbare und +als Arbeitsseite gewhlt. Es wird auf ganzseitige Graphik geschaltet (falls +im Graphikmodus). + + +#type("8")##center##ib(3)#6.3.1 Strichdicke#ie(3)##type("elite")# + +Die Strichdicke einer Linie ist normalerweise 1. Die Strichdicke 2 zeichnet +parallel zur ursprnglichen Linie auf beiden Seiten jeweils eine weitere +Linie der gleichen Lnge. Die Strichdicke 3 zeichnet dann auf beiden Seiten +jeweils zwei parallele Linien usw. Die Strichdicke kann von 1 bis 15 ge- +whlt werden. Sie wird mit dem Kommando + + #ib(1)# O 1#ie(1)# (Hex 1B 4F 31 ) + +eingestellt. ist ein Byteparameter (Kapitel 6.2.4) mit dem Wertebe- +reich 1 bis 15. + + +#type("8")##center##ib(3)#6.3.2 Farbe/Helligkeit#ie(3)##type("elite")# + +Normalerweise ist Gelb (hell) eingestellt. Die Alternative ist Violett (dun- +kel). Jeweils 7 nebeneinanderliegene Graphikpunkte haben die gleiche Farbe. +Auf einem Farbmonitor kann die Farbe auch noch durch den Inhalt dieser 7 +Graphikpunkte bestimmt werden. Der Farbmodus wird von diesem Terminalpro- +gramm allerdings nicht untersttzt, da sich dann die Auflsung in X-Richtung +halbiert (also nur noch 140 x 192 Punkte). + +Mit dem Kommando + + #ib(1)# O 2#ie(1)# (Hex 1B 4F 32 ) + +kann die Helligkeit eingestellt werden. ist ein Byteparameter bei dem +nur das Bit 0 wichtig ist: + +Bit 0 Bedeutung + 0 dunkel/Violett ist eine gerade Zahl + 1 hell/Gelb ist eine ungerade Zahl +#text end# +#clear pos# +#free(02.351852e-2)# + + + 19 +#page##--------------------------------- Ende der Seite 19 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#6.3.3 Linientyp#ie(3)##type("elite")# + +Der Linientyp ist das "Muster" der Striche. Es gibt 7 vordefinierte Strich- +muster und ein vom Benutzer definiertes. Der Linientyp (im folgenden auch +Pattern genannt) wird mit dem Kommando + + #ib(1)# O 3#ie(1)# (Hex 1B 4F 33 ) + +eingestellt. ist ein Byteparameter mit dem Wertebereich von 0 bis 7. Die +Strichtypen sind folgendermaen zugeordnet: + +#on("u")# Bitmuster (16 Bit) Name #off("u")# + 0 unsichtbare Linie + 1 ---------------- durchgehende Linie + 2 - - - - - - - - gepunktete Linie + 3 ---- ---- kurz gestrichelte Linie + 4 -------- lang gestrichelte Linie + 5 -------- - Strichpunktlinie + 6 - - ----- Strich-Punkt-Punkt Linie + 7 - - - - - - - - Benutzerdefinierte Linie + (Hier Defaultangabe) + +Die Bitmuster sind immer 16 Bit lang. Nach einem Movebefehl startet der +nchste Draw-Befehl mit dem linkesten (niederwertigsten!) Bit des Bitmu- +sters. Das Muster wiederholt sich bei lngeren Linien zyklisch. Wird zwi- +schen zwei Draw-Befehlen kein Move-Befehl gegeben, dann setzt der zweite +Draw-Befehl im Bitmuster nach der gleichen Stelle fort, an der der erste +Draw-Befehl aufgehrt hat. Auch dicke Linien behalten das Linienmuster bei, +man sollte dann allerdings von gepunkteter auf lang gestrichelte Linie ber- +gehen, wenn man eine gepunktete dicke Linie haben will. + + +#type("8")##center##ib(3)#6.3.3.1 Selbstdefinierte Linientypen (Pattern)#ie(3)##type("elite")# + +Wie in 6.3.3 angemerkt kann ein Linientyp auch vom Benutzer selbst definiert +werden. Da die Lnge 16 Bit ist, kann man mit den relativen Move's und +Draw's zusammen gut kleine Bildchen (Icons) zusammenstellen. Eine Hilfe ist +dabei auch die Bitverknpfung COPY, die im nchsten Abschnitt erlutert +wird. Man legt dazu zuerst das 16 Bit-Pattern als jeweils eine Zeile des +Icons fest und zieht dann von links nach rechts eine 16 Punkte lange Linie +mit dem benutzerdefinierten Pattern. Nach einem relativen Move (-16, -1) +kann der Vorgang fr die nchste Zeile fortgesetzt werden. + +Das benutzerdefinierbare Pattern wird mit dem Kommando + + #ib(1)# O 6#ie(1)# (Hex 1B 4F 36 ) + +festgelegt. ist dabei das niederwertige (Lowbyte) des Bitmusters, +ist das hherwertige (Highbyte) des Bitmusters. Wenn das Pattern als Muster +fr Linien (und nicht fr Icons) benutzt wird, dann sollte man darauf ach- +ten, da das Bit 0 im Lowbyte 1 ist, damit man bei kurzen Linien, denen ein +Move vorangegangen ist, zumindestes einen Punkt sieht. +#text end# +#clear pos# +#free(02.351852e-2)# + + +#right#20 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 20 -----------# +#center##on("b")#6. Der Graphikmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#6.3.4 Bitverknpfungen#ie(3)##type("elite")# + +ber Bitverknpfungen werden die Punkte auf der Graphikseite verndert. Das +Linienmuster wird dazu zyklisch punktweise abgetastet und jenachdem ob das +aktuelle Bit im Linienbitmuster 0 oder 1 ist eine Vernderung der Graphik- +seite durchgefhrt. +Bis auf die COPY-Funktion wirken die Bitverknpfungen nur auf die Graphik- +seite, wenn der aktuelle Punkt im Linientyp-Bitmuster 1 ist. + +- Das Zeichnen einer sichtbaren Linie mit weien Punkten geschieht zum Bei- + spiel durch eine OR- (Oder-) Verknpfung. + +- Das Lschen einer Linie (also das Zeichnen von "schwarzen" Punkten) ge- + schieht mit einer AND- (Und-) Verknpfung (Genau genommen eine NAND-, d.h. + negierte AND-Verknpfung). + +- Das Invertieren (d.h. Weier Punkt wird schwarz, schwarzer Punkt wird + wei) kann man mit einer XOR- (Exklusiv-Oder-) Verknpfung erreichen. + +- Fr Icons (siehe 6.3.3.1) und andere Zwecke, gibt es noch die COPY-Funk- + tion, die eigentlich keine einzelne Bitverknpfung ist. Ist im Linientyp + das aktuelle Bit 0, dann wird in der Graphikseite eine AND-Verknpfung + durchgefhrt (d.h. der Punkt wird gelscht) ist das aktuelle Bit im Li- + nientyp 1, dann wird eine OR-Verknpfung durchgefhrt (d.h. der Punkt wird + gelscht). Der Effekt ist, da genau das Bitmuster des Linientyps in der + Graphikseite erscheint ("kopiert" wird), egal was vorher da stand, wo die + Linie gezeichnet wurde. + +Die Bitverknpfung kann mit dem Kommando + + #ib(1)# O 4#ie(1)# (Hex 1B 4F 34 ) + +festgelegt werden. ist ein Byteparameter mit dem Wertebereich 0 bis 3. + hat folgende Bedeutung: + + Bitverknpfung Verwendung +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 0 OR (Oder) Wei (auf schwarzem Grund) zeichnen + 1 AND (Und) Schwarz (auf weiem Grund) zeichnen + 2 XOR (Exklusiv Oder) Schwarze und Weie Punkte umdrehen (invertie- + ren) + 3 COPY (kopieren) Icons zeichnen oder Bilduntergrund berschrei- + ben + + +#text end# +#clear pos# +#free(2.986852)# + + + 21 +#page##--------------------------------- Ende der Seite 21 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#6.3.5 Multiparametereinstellung#ie(3)##type("elite")# + +Die obigen Parameter (bis auf Linientyp) knnen alle zugleich mit einem +Kommando gesetzt werden. Das Kommando lautet + + #ib(1)# O 5#ie(1)# (Hex 1B 4F 35 ) + + ist ein Byteparameter mit dem Wertebereich 0 bis 127. Die Bits sind +folgendermaen zugeordnet: + + Bit Bedeutung Werte +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 0 .. 3 : Strickdicke 1 .. 15 + 4 .. 5 : Bitverknpfung 0 = OR, 16 = AND, 32 = XOR, 48 = COPY + 6 : Farbe/Helligkeit 0 = Violett (dunkel), 64 = Gelb (hell) + +Standardeinstellung ist also ' O 5 A'. + + +#type("8")##center##ib(3)#6.4 Graphikseiten#ie(3)##type("elite")# + +Das Terminal verwaltet zwei Graphikseiten mit einer Gre von jeweils 8k +Byte (d.h. 8192 Bytes). + + +#type("8")##center##ib(3)#6.4.1 Die sichtbare Seite und die Arbeitsseite#ie(3)##type("elite")# + +Die beiden Graphikseiten knnen (mssen aber nicht) getrennt voneinander +angezeigt und bearbeitet werden. Das kann sinnvoll sein, wenn eine Seite "im +Hintergrund" aufbereitet werden soll, whrend die andere (schon aufbereite- +te) Seite angezeigt wird. Man kann auch die 80-Zeichen Textseite anzeigen +und eine oder beide Graphikseiten im Hintergrund aufbereiten. Durch abwec- +hselndes Umschalten der Arbeits- und Anzeigeseite kann dann der Eindruck +eines bewegten Bildes erzeugt werden. Um diesen Vorgang zu beschleunigen, +kann man die Graphikseiten auch auf dem Host vorbereiten und (im Hinter- +grund) an das Terminal senden (bei 19200 Baud dauert das pro Seite ca. 4.7 +Sekunden). + +Die sichtbare und die Arbeitsseite knnen mit dem Kommando + + #ib(1)# O 7#ie(1)# (Hex 1B 4F 37 ) + +gewhlt werden. ist ein Byteparameter mit dem Wertebereich 0 bis 7. + +Bit 0 von : Sichtbare Seite (0 oder 1) +Bit 1 von : Arbeitsseite (0 oder 1) +Bit 2 von : 1 = 80 Zeichen Textseite wird in den untersten 32 Graphik- + zeilen eingeblendet. 0 = Nur Graphikmode. + +#text end# +#clear pos# +#free(1.293519)# + + +#right#22 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 22 -----------# +#center##on("b")#6. Der Graphikmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#on("u")# Sichtbar Arbeitsseite Inhalt der untersten 32 Graphikzeilen#off("u")# + 0 Seite 0 Seite 0 Graphik (Seite 0) + 1 Seite 1 Seite 0 Graphik (Seite 1) + 2 Seite 0 Seite 1 Graphik (Seite 0) + 3 Seite 1 Seite 1 Graphik (Seite 1) + 4 Seite 0 Seite 0 Text + 5 Seite 1 Seite 0 Mll + 6 Seite 0 Seite 1 Text + 7 Seite 1 Seite 1 Mll + + +#type("8")##center##ib(3)#6.4.1.1 80-Zeichen Text und Graphik#ie(3)##type("elite")# + +Mit dem in 6.4.1 beschriebenen Kommando knnen, wie beschrieben, die unter- +sten 4 Zeilen der Textzeile (d.h. ggf. auch die Statuszeile) statt der un- +tersten 32 Graphikzeilen dargestellt werden. Da es nur eine Textseite gibt +und jeder Graphikseite eine eigene Textseite zugeordnet ist, ist die Mi- +schung von Text und Graphik in der Graphikseite 1 auf diese Weise nicht +sinnvoll, da dann in den unstersten 32 Graphikzeilen nur Mll erscheint. Das +Einblenden wird vom Terminal z.B. genutzt, wenn die Kommandozeile aktiviert +wird. Man kann zum Beispiel Benutzerhinweise in die untersten 4 Zeilen der +Textseite schreiben. Zeichenbefehle arbeiten in dem unsichtbaren (ausgeblen- +deten) Teil der Graphikseite weiter. Das Ergebnis kann man sich beim Wieder- +-Einblenden ansehen. + + +#type("8")##center##ib(3)#6.4.2 Aufbau einer Graphikseite#ie(3)##type("elite")# + +Eine Graphikseite besteht aus 8192 Bytes, von denen 7680 genutzt werden, 512 +sind somit (in der Graphikseite verstreut) ungenutzt. Jedes Byte besteht aus +einem Farbbit (Bit 7) und 7 angezeigten Graphikbits. Ein gesetztes Bit ent- +spricht einem sichtbaren Punkt auf dem Bildschirm. Das niederwertigste Bit +eines Bytes wird am weitesten links angezeigt. +Jede der 192 Graphikzeilen besteht also aus 40 Bytes. Jeweils 8 Graphikzei- +len sind zu Reihen zusammengefat. Es gibt also 24 Reihen. Jede erste Gra- +phikzeile einer Reihe hat eine Anfangsadresse, die in folgender Tabelle +aufgelistet ist: + +#on("u")#Reihe Adresse Hex | Reihe Adresse Hex | Reihe Adresse Hex#off("u")# + 0 0 000 | 8 40 028 | 16 80 050 + 1 128 080 | 9 168 0A8 | 17 208 0D0 + 2 256 100 | 10 296 128 | 18 336 150 + 3 384 180 | 11 424 1A8 | 19 464 1D0 + 4 512 200 | 12 552 228 | 20 592 250 + 5 640 280 | 13 680 2A8 | 21 720 2D0 + 6 768 300 | 14 808 328 | 22 848 350 + 7 896 380 | 15 936 3A8 | 23 976 3D0 + +#text end# +#clear pos# +#free(1.716852)# + + + 23 +#page##--------------------------------- Ende der Seite 23 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Um den Offset den n. Graphikzeile in einer Reihe zu finden kann man folgen- +de Tabelle benutzen: + +#on("u")#n Offset (Hex)#off("u")# +0 0 0000 +1 1024 0400 +2 2048 0800 +3 3072 0C00 +4 4096 1000 +5 5120 1400 +6 6144 1800 +7 7168 1C00 + +Beispiel: + Die Adresse des Punktes (123, 45) soll bestimmt werden. + 45 DIV 8 = 5, d.h. Y liegt in Reihe 5 mit Adresse 640 (Dezimal). 45 MOD 8 + = 5, d.h. Y liegt in der n=5. Graphikzeile von Reihe 5. Der + Y-Offset also 5120. + 123 DIV 7 = 17 d.h. X liegt im Byte mit X-Offset 17. + Die Adresse des Punktes ist also im Byte 17 + 5120 + 640 = 5777. + 123 MOD 7 = 4 d.h. Bit 4 in Byte 5777 ist der gesuchte Punkt. + + +#type("8")##center##ib(3)#6.4.3 Operationen auf den Graphikseiten#ie(3)##type("elite")# + +Hier sollen nur die Operationen erlutert werden, die nicht in andere Kate- +gorien (z.B. Lschen, Linien zeichnen etc.) passen. + +Es gibt ein universelles Kommando, mit dem zwei Graphikseiten invertiert, +kopiert, gemischt und miteinander logisch verknpft werden knnen. Vern- +dert wird bei diesem Kommando nur die Arbeitsseite. + +Das Kommando lautet + + #ib(1)# !#ie(1)# (Hex 1B 21 ) + +#text end# +#clear pos# +#free(6.796852)# + + +#right#24 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 24 -----------# +#center##on("b")#6. Der Graphikmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# + ist dabei ein Byteparameter mit dem Wertebereich 0 bis 15 und hat fol- +gende Bedeutung: + + Bedeutung +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 0 Keine Vernderung. Kopiert die Arbeitsseite in sich selbst (Frbt die + Arbeitsseite allerdings mit der aktuellen Farbe/Helligkeit). + 1 Die Arbeitsseite wird invertiert. + 2 Mischt beide Seiten zusammen (OR Verknpfung). + 3 Mischt beide Seiten zusammen (OR) und invertiert das Ergebnis. + 6 Bildet den Durchschnitt beider Seiten (AND Verknpfung). + 7 Bildet den Durchschnitt beider Seite (AND) und invertiert das Ergebnis +10 Es sind die Punkte gesetzt, die in beiden Seiten verschieden sind (XOR + Verknpfung). +11 Es sind die Punkte gesetzt, die in beiden Seiten gleich sind (d.h. das + Inverse von =10). +14 Kopiert die andere Seite in die Arbeitsseite. +15 Kopiert das Inverse von der anderen Seite in die Arbeitsseite. + +Andere Werte fr wiederholen sich in der Tabelle. Die ganze Arbeitssei- +te hat nach der Operation die gewhlte Farbe/Helligkeit. + + +#type("8")##center##ib(3)#6.4.4 Laden einer Graphikseite vom Host#ie(3)##type("elite")# + +Graphikseiten knnen ganz oder teilweise vom Host geladen werden. Das kn- +nen auf dem Terminal erstellte und dann an den Host gesendete (Teil-) +Graphiken sein, aber auch auf dem Host erstellte. In diesem Fall ist das +Kapitel 6.4.2 (Aufbau einer Graphikseite) interessant. + +Mit dem Kommando + + #ib(1)# /#ie(1)# + (Hex 1B 2F ...) + +kann eine Seite oder ein Teil einer Seite in die Arbeitsseite geladen wer- +den. , , , und sind Byteparameter (8 Bits). und + bilden zusammen die binre Lnge, d.h. die Anzahl der Datenbytes +, die die Graphik enthalten. Die Lnge kann von 0 bis Hex 2000 (dezi- +mal 8192) reichen. Die Adresse, durch und gebildet, darf von 0 bis +Hex 1FFF reichen. Zustzlich gilt, da die Summe von Lnge und Adresse nicht +grer als Hex 2000 sein darf, da sonst auerhalb der Graphikseite geladen +wrde. In einem dieser Fehlerflle werden die folgenden Graphikdatenbytes +ignoriert. Die Datenbytes werden dann als Kommandos interpretiert, was zu +unvorhersehbaren Reaktionen des Terminals fhrt. + + +#text end# +#clear pos# +#free(2.140185)# + + + 25 +#page##--------------------------------- Ende der Seite 25 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#6.4.5 Graphik auf Diskette speichern/laden#ie(3)##type("elite")# + +Um Graphikseiten, zum Besipiel fr Prsentationen, unabhngig vom Host auf +dem Bildschirm darstellen zu knnen, benutzt man das Kommando + + #ib(1)# S#ie(1)# (Hex 1B 53 ). + +Man kann bis zu 8 verschiedene Graphikseiten vorbereiten, auf Diskette spei- +chern und zu einem spteren Zeitpunkt wieder in das Terminal zurckladen. +Dieses Kommando wird auch verwendet, um eine Textseite auf Diskette zu +schreiben oder von Diskette zu lesen. ist ein Byteparameter mit dem +Wertebereich 0 bis 31, wobei die Bits folgendermaen belegt sind: + +Bit 0..2 : "Fachnummer" der Graphikseite auf der Diskette (0 bs 7) +Bit 3 : Bei Graphikseiten immer 1 (Bei Textseiten 0) +Bit 4 : 0 heit: die Graphikseite wird von der Diskette gelesen, + 1 heit: die Graphikseite wird auf die Diskette geschrieben. + +Wird die Graphikseite auf die Diskette geschrieben, dann wird eine eventuell +schon in diesem "Fach" vorhandene Graphikseite berschrieben. + +Wie bei allen Graphikkommandos, bezieht sich dieses Kommando nicht unbedingt +auf die sichtbare Graphikseite, sondern auf die Arbeitsseite. + +Beispiele: + S liest die Graphikseite in Fach 0 in die Arbeitsseite. + S schreibt die Arbeitsseite in Fach 0 der Diskette. + +Da das Lesen einer Graphikseite von Diskette mit ca. 1.1 Sekunden, um eini- +ges schneller als der Datentransfer vom Host ist, sollte man bewegte Graphi- +ken auf Diskette vorbereiten und sie dann mit verschrnkter Arbeits- und +Sichtbarkeitsseite anzeigen. +Z.B.: Seite 1 als Arbeitsseite whlen, Seite 0 als sichtbare Seite. Graphik + von Diskette laden (wird in Seite 1 (= Arbeitsseite) geladen) Seite 1 + als sichtbare Seite whlen, Seite 0 jetzt als Arbeitsseite whlen. Die + nchste Graphikseite wird von der Diskette in die Seite 1 geladen etc. + Bei dieser Vorgehensweise scheinen bergnge kontinuierlich zu sein. + +Fr Insider: Eine Graphikseite belegt zwei Tracks (8k). Die 8 Graphikseiten + befinden sich auf den Tracks 10 bis 25 in aufsteigender Reihen- + folge. + + +#type("8")##center##ib(3)#6.5 Textdarstellung im Graphikmodus#ie(3)##type("elite")# + +Nicht nur auf der 80-Zeichen Textseite knnen Buchstaben und Zeichen darge- +stellt werden, sondern auch auf den Graphikseiten. Die Auflsung ist zwar +nicht so gro wie auf der reinen Textseite, aber die Anzahl der verschiede- +nen Darstellungsmglichkeiten ist sehr viel grer. Fast alle Kommandos, die +in der Textseite angewandt werden knnen, haben in der Graphikseite die +gleiche Funktion. + +#text end# +#clear pos# +#free(02.351852e-2)# + + +#right#26 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 26 -----------# +#center##on("b")#6. Der Graphikmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Textdarstellung in der Graphikseite ist hauptschlich zum Beschriften von +Graphiken oder zum Drucken von berschriften etc. vorgesehen. Da aber fast +alle Textkommandos (Delete/Insert Line/Character fehlt) auch im Graphikmo- +dus zur Verfgung stehen, kann man auch im Graphikmodus Textverarbeitung +oder Editor benutzen. + + +#type("8")##center##ib(3)#6.5.1 Zeichendarstellung#ie(3)##type("elite")# + +Die normale Gre eines Zeichens ist 6 x 10 Punkte (x * y), damit lassen +sich 46 x 19 Zeichen (874 Zeichen) voll auf dem Bildschirm darstellen. Wenn +die Gre mit einem Kommando auf 5 x 8 Punkte verringert wird, dann lassen +sich 56 x 24 Zeichen (1344 Zeichen) auf dem Bildschirm darstellen. Komfor- +table Textverarbeitung lt sich damit natrlich nicht machen, zumal die +Geschwindigkeit, mit der die Zeichen auf den Bildschirm geschrieben werden +gegenber der der reinen Textseite langsamer ist. + + +#type("8")##center##ib(3)#6.5.1.1 Zeichengre und Schreibrichtung#ie(3)##type("elite")# + +Die Zeichen knnen in verschiedenen Gren und unter verschiedenen Winkeln +auf den Bildschirm geschrieben werden. Damit ist auch ein Schreiben von +rechts nach links mit auf dem Kopf stehenden Zeichen mglich. +Bei normaler Schreibrichtung (waagerecht von links nach rechts) befindet +sich die linke untere Ecke eines Zeichens an der Position des Graphikcur- +sors. Nach dem Zeichnen des Zeichens befindet sich der Graphikcursor hinter +der rechten unteren Ecke des Zeichens. Da sich die Zeichen aus Vektoren +(Linien) zusammensetzen und nicht aus einer festen Punktmatrix, knnen sie +schnell beliebig gedreht und vergrssert (und verkleinert) werden. Der Dreh- +winkel ist wie bei allen Graphikwinkelangaben in 5 Grad Schritten anzugeben. +Die Zuordnung der Winkel zu den Parameterwerten oder ASCII-Zeichen ist im +Anhang A angegeben. + +Das Kommando + + #ib(1)# N#ie(1)# (Hex 1B 4E ) + +stellt Breite, Hhe und Drehwinkel der Zeichen ein. Alle Parameter sind +Byteparameter mit dem Wertebereich 0 bis 255. Mit einem Parameter Hex 00 +kann der Defaultwert (Standardwert) fr den jeweiligen Parameter eingestellt +werden. + bezeichnet die Zeichenbreite in Punkten. Standardwert ist 6. + bezeichnet die Zeichenhhe in Punkten. Standardwert ist 10. + bezeichnet den Drehwinkel in 5 Grad Schritten. Standardwert ist 0. + +#text end# +#clear pos# +#free(2.986852)# + + + 27 +#page##--------------------------------- Ende der Seite 27 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Einige ausgezeichnet Werte fr sind: + Richtung +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 0 Waagerecht von links nach rechts (Ost) + 9 Schrg nach unten rechts (Sd-Ost) +18 Senkrecht von oben nach unten (Sd) +27 Schrg nach unten links (Sd-West) +36 Waagerecht (auf dem Kopf stehend) von rechts nach links (West) +45 Schrg nach oben links (Nord-West) +54 Senkrecht von unten nach oben (Nord) +63 Schrg von nach oben rechts (Aufwrts) (Nord-Ost) +72... Wie 0 ... + + +#type("8")##center##ib(3)#6.5.1.2 Dicke, Farbe etc.#ie(3)##type("elite")# + +Buchstaben werden mit Vektoren (Linien) gezeichnet. Die gleichen Parameter, +die fr Striche eingestellt werden, wirken dann auch auf die Zeichen. Mg- +liche Parameter sind Farbe, Linientyp, Strichdicke und Bitverknpfung. Mit +dem Kommando + + #ib(1)# O 0#ie(1)# (Hex 1B 4F 30) + +werden alle diese Parameter auf Standardwerte zurckgesetzt. Die Standard- +werte sind in Kapitel 6.3 erlutert. Die Beschreibung des Kommandos zur +Einstellung der Zeichenfarbe ist in Kapitel 6.3.2 beschrieben, das Einstel- +len der Zeichendicke in Kapitel 6.3.1, das Einstellen des Linientyps in +Kapitel 6.3.3 und das Einstellen der Bitverknpfung ist in Kapitel 6.3.4 +beschrieben. Auch fr die Zeichendarstellung knnen mehrere dieser Parame- +ter zugleich mit einem Kommando eingestellt werden. Das Multiparameterkom- +mando ist in Kapitel 6.3.5 beschrieben. + + +#type("8")##center##ib(3)#6.5.1.3 Zeichenstze und Attribute#ie(3)##type("elite")# + +hnlich wie bei der 80-Zeichen Textdarstellung knnen Zeichensatz und Text- +attribute eingestellt werden. Mit dem Kommando + + #ib(1)# z#ie(1)# (Hex 1B 7A ) + +kann einer der beiden Zeichenstze USA oder GER (ASCII und Deutsch) gewhlt +werden. Ein griechischer Zeichensatz ist unabhngig von beiden immer vor- +handen. + ist ein Byteparameter mit dem Wertebereich 0 bis 15, im Graphikmodus +sind aber nur die beiden folgende Werte sinnvoll: + +#on("u")# Zeichensatz Abweichende Zeichen#off("u")# + 2 Deutsch + 4 Ascii [ \ ] { | } ~ + +#text end# +#clear pos# +#free(08.701852e-1)# + + +#right#28 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 28 -----------# +#center##on("b")#6. Der Graphikmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Auerdem kann der Zeichensatz im ersten Feld der ersten Kommandozeile ein- +gestellt werden. Im amerikanischen Zeichensatz treten die deutschen Buch- +staben auerdem im Bereich von 214 bis 219 und 251 auf. Der Graphikzeichen- +satz ist im Anhang abgebildet. + +Wie im Textmodus knnen Attribute mit dem Kommando + + #ib(1)# G#ie(1)# (Hex 1B 47 ) + +eingestellt werden. ist ein Byteparameter mit dem Wertebereich 0, 1, 4 +und 5. Die Werte von sind folgendermaen zugeordnet: + +#on("u")# Bedeutung #off("u")# + 0 Normaler Text (sichtbar und aufrecht) + 1 Unsichtbarer Text (Nur der Cursor wird bewegt) + 4 Kursivschrift, die Zeichen werden schrggestellt + 5 Wie 1 (unsichtbarer Text) + +Das Kommando + + #ib(1)# )#ie(1)# (Hex 1B 29) + +hat wie im Textmodus die gleiche Bedeutung wie G 4. Damit wird im +Graphikmodus die Kursivschrift eingeschaltet. Mit dem Kommando + + #ib(1)# (#ie(1)# (hex 1B 28) + +wird die Kursivschrift wieder ausgeschaltet. Im Textmodus invers hervorge- +hobene Textstellen werden im Graphikmodus also durch Kursivschrift hervor- +gehoben. +Steht rechts neben der Zeichenspalte mit einem Kursivzeichen ein nicht kur- +sives Zeichen, dann wird das rechte Zeichen mglicherweise etwas berschrie- +ben, da es in den oberen Teil des Kursivzeichens hineinragt. Das kann ver- +mieden werden, wenn nach dem Ausschalten der Kursivschrift ein Leerzeichen +ausgegeben wird. + + +#type("8")##center##ib(3)#6.5.1.4 Zeichen berschreiben#ie(3)##type("elite")# + +Im 80-Zeichen Textmodus kann man Zeichen einfach bereinandertippen, das +zweite Zeichen ersetzt dann das erste. Im Graphikmodus sollen Texte auch mit +in eine Zeichnung geschrieben werden knnen, ohne da Teile von Linien even- +tuell gelscht werden. Dieser Modus bringt auerdem eine etwas grere +Schreibgeschwindigkeit mit sich. Es ist aber auch mglich, da die Flche, +in die das Zeichen geschrieben werden soll, vorher gelscht wird, um ein +sauberes Schriftbild zu erzielen. Mit dem Kommando + + #ib(1)# &#ie(1)# (Hex 1B 26) + +kann man das vorherige Lschen einschalten, mit dem Kommando + + #ib(1)# '#ie(1)# (Hex 1B 27) +#text end# +#clear pos# +#free(02.351852e-2)# + + + 29 +#page##--------------------------------- Ende der Seite 29 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +wird der Modus des berschreibens ausgeschaltet. + +Bei Kursivzeichen wird eine rautenfrmige Flche gelscht oder gefllt (wenn +Bitverknpfung AND eingeschaltet ist). Bei normalen Zeichen wird eine re- +chteckige Flche, der mit #ib(1)# N#ie(1)# eingestellten Breite und Hhe, gelscht +oder gefllt. Zu beachten ist, da das Lschen/Fllen nur bei waagerechter +Schreibrichtung von links nach rechts funktioniert. + +Da die Gre der Zeichen in weiten Grenzen mit N eingestellt werden +kann, ist es auch mglich mit dem durch & eingeschalteten Ersetzungs- +modus schnell rechteckige Flchen zu fllen oder zu lschen, wenn nicht auf +das spter beschriebene Fllkommando fr beliebige Flchen zurckgegriffen +werden soll. Dazu schaltet man mit dem Kommando O 4 1 die Bitverkn- +pfung AND (fr Fllen) ein und gibt dann einfach ein Leerzeichen aus, das +dann invertiert dargestellt wird. + + +#type("8")##center##ib(3)#6.5.2 Textkommandos im Graphikmodus#ie(3)##type("elite")# + +Fast alle Textkommandos des 80-Zeichen Textmodus wirken auch im Graphikmo- +dus. Einige Kommandos, wie Zeichen senden, Zeile senden, Cursorposition +senden, haben im Graphikmodus andere Funktionen und haben deshalb andere +Escape-Sequenzen. Textkommandos, die nicht im Graphikmodus vorhanden sind: + I (Backtab), j (Reverse Linefeed), E (Insert Line), +Q (Insert Character), R (Delete Line), W (Delete Character). + + +#type("8")##center##ib(3)#6.5.2.1 Die Cursorpositionierung#ie(3)##type("elite")# + +Die Cursorpositionierungskommandos (UP, DOWN, LEFT, RIGHT) wirken im Gra- +phikmodus in die aktuelle Schreibrichtung. Beispiel: Wenn als Schreibwinkel +180 Grad eingestellt wurde (Winkel 36, also von rechts nach links auf dem +Kopf schreiben), dann mu man, um einen Backspace (d.h. ein Zeichen zurck) +auszufhren, nicht sondern wie bei normaler Schreibrichtung blich, + drcken. Die vier Cursorsteuertasten funktionieren fr beliebige +Schreibrichtungen. Alle anderen Steuertasten beziehen sich immer auf waage- +rechte Schreibrichtung von links nach rechts. + +Alle Steuertasten bercksichtigen die Zeichengre (Breite und Hhe). Auch +die Graphikseite wird am Ende der letzten Zeile um soviele Graphikzeilen +gescrollt, wie ein Zeichen hoch ist. + +#text end# +#clear pos# +#free(4.256852)# + + +#right#30 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 30 -----------# +#center##on("b")#6. Der Graphikmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Folgende Steuerkommandos/Tasten wirken im Graphikmodus: + +Basis-Taste Apple-Taste Hex-Code Bedeutung +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# +#ib(1)##ie(1)# 09 Der Cursor wird an die nchste (re- + chte) Tabulatorposition gesetzt. + Tabulatorpositionen sind alle 8 Spal- + ten (wie im Textmodus). Liegt die + nchste Tabulatorposition auerhalb + des sichtbaren Bereichs, dann steht + der Cursor jetzt da. + +#ib(1)##ie(1)# - Kommandozeile aktivieren. + Einzelheiten zur Kommandozeile siehe + Abschnitt 3.: Die Kommandozeilen. + +#ib(1)##ie(1)# 18 u.a. Kommandozeile verlassen. + +#ib(1)##ie(1)# 0D Zum Zeilenanfang ohne Zeilenvorschub. + Der Cursor steht dann in der ersten + Spalte der Zeile. + +#ib(1)##ie(1)# 8D Zum Anfang der nchsten Zeile. Falls + der Cursor in der letzten sichtbaren + Bildschirmzeile war, wird der Bild- + schirminhalt entweder nach oben ge- + scrollt (SCROLL) oder in Homeposition + gebracht (PAGE). + +#ib(1)##ie(1)# 8B/0B Cursor eine Zeile hher (bzw. ber + die Zeile). War der Cursor in der + ersten sichtbaren Bildschirmzeile, + dann steht er jetzt im unsichtbaren + Bereich. + +#ib(1)##ie(1)# 8A/0A Cursor eine Zeile tiefer (bzw. "un- + ter" die Zeile). War der Cursor in + der letzten sichtbaren Zeile, dann + wird der Inhalt des Graphikbild- + schirms nach oben gescrollt, d.h. die + obersten Zeilen werden gelscht (im + SCROLL-Modus) oder der Cursor in die + erste Zeile gesetzt (im PAGE-Modus). + +#ib(1)##ie(1)# 16 Cursor eine Zeile tiefer (bzw. "un- + ter" die Zeile). War der Cursor in + der letzten Zeile, dann ndert er + seine Position nicht. Die Spalte + ndert sich nicht. + +#text end# +#clear pos# +#free(08.701852e-1)# + + + 31 +#page##--------------------------------- Ende der Seite 31 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#ib(1)##ie(1)# 88/08 Cursor eine Spalte nach links (bzw. + entegegen der Schreibrichtung). War + der Cursor in der ersten sichtbaren + Bildschirmspalte, dann ist er jetzt + unsichtbar "links" davon. + +#ib(1)##ie(1)# - 95 Cursor eine Spalte nach rechts (bzw. + in Schreibrichtung). War der Cursor + in der letzten sichtbaren Spalte, + dann befindet er sich jetzt auer- + halb des Bildschirms. Im Gegensatz + zum Textmodus wird kein Linefeed oder + Scroll ausgefhrt. + +#ib(1)##ie(1)# C0 Der Cursor wird in die linke obere + Bildschirmecke gebracht (Homeposi- + tion). + +#ib(1)##ie(1)# D0 Bildschirm lschen und Cursor Home. + +#ib(1)##ie(1)# 7F Dieses Zeichen wird auf dem Bild- + schirm nicht dargestellt. Der Host + interpretiert es in der Regel als + Zeichenlschbefehl. + +#ib(1)##ie(1)# 08 Cursor eine Spalte nach links (bzw. + entgegen der Schreibrichtung). Die + Funktion ist mit der von iden- + tisch. + +#ib(1)##ie(1)# 15 Apple: Cursor eine Spalte nach re- + chts (bzw. in Schreibrichtung). Die + Funktion ist mit der von + identisch. + +#ib(1)##ie(1)# 1B Leitet eine Escape-Sequenz ein. + +#ib(1)##ie(1)# - Local/Online umschalten + +#ib(1)##ie(1)# '00' Sendet V24-Break (Hexcode 00 mit + Rahmenfehler). Als Rahmenfehler wird + das Fehlen des oder der Stopbits + bezeichnet (Stopbitpegel ist norma- + lerweise 1, bei Break dagegen 0). + +Unbelegte Funktionstasten erzeugen Graphikzeichen, die im Anhang A nachge- +sehen werden knnen. + + +#text end# +#clear pos# +#free(1.293519)# + + +#right#32 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 32 -----------# +#center##on("b")#6. Der Graphikmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#6.5.2.2 Lschbefehle#ie(3)##type("elite")# + +Das Kommando (Clear to End Of Line) + + #ib(1)# T#ie(1)# (Hex 1B 54) + +lscht ab der aktuellen Cursorposition bis zum Zeilenende. Die Hhe des +gelschten Balkens entspricht der Buchstabenhhe. Der Balken wird unabhn- +gig von der Bitverknpfung immer gelscht. Der Balken wird unabhngig von +der Schreibrichtung immer waagerecht gelscht. + +Das Kommando (Clear to End Of Page) + + #ib(1)# Y#ie(1)# (Hex 1B 59) + +lscht den Graphikbildschirm von der aktuellen Cursorposition an bis zum +Bildschirmende. Auch dieses Kommando lscht unabhngig von der gewhlten +Bitverknpfung und Schreibrichtung immer waagerecht. + +Die Kommandos + + #ib(1)# *#ie(1)# (Hex 1B 2A) + #ib(1)# ,#ie(1)# (Hex 1B 2C) + #ib(1)# +#ie(1)# (Hex 1B 2B) + #ib(1)# :#ie(1)# (Hex 1B 3A) + #ib(1)##ie(1)# (Hex 1A) + +lschen den Bildschirm und bringen den Graphikcursor in Homeposition, d.h. +eine Buchstabenhhe unter dem oberen Bildschirmrand. + +Das Kommando + + #ib(1)# y#ie(1)# (Hex 1B 79) + +lscht den Bildschirm und bringt den Graphikcursor in die linke untere Ecke, +d.h. den Ursprung des Koordinatensystems. + + +#type("8")##center##ib(3)#6.6 Die Graphikkommandos#ie(3)##type("elite")# + + +#type("8")##center##ib(3)#6.6.1 Draw's und Move's#ie(3)##type("elite")# + +Draw's sind Zeichenbefehle, die eine Linie zeichnen und den Cursor an den +Endpunkt der Linie positionieren. Move's positionieren nur den Cursor und +zeichnen nicht. Bei allen Draw's ist der Anfangspunkt der Linie die aktuel- +le Cursorposition. Die Endposition kann relativ, absolut oder mit einem +relativen Winkel angegeben werden. Der Befehl zum Setzen/Lschen eines Punk- +tes wurde mit in diese Befehlskategorie aufgenommen. + + +#text end# +#clear pos# +#free(04.468519e-1)# + + + 33 +#page##--------------------------------- Ende der Seite 33 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#6.6.1.1 Punkt setzen#ie(3)##type("elite")# + +Der Befehl zum Setzen eines Graphikpunktes ist ein absoluter Befehl, d.h. +die Koordinaten des Punktes folgen dem Kommando. Die Position des Graphik- +cursors wird durch diesen Befehl nicht verndert. + +Das Kommando + + #ib(1)# m#ie(1)# (Hex 1B 6D ) + +setzt einen Punkt an die Position x/y, wenn diese innerhalb des sichtbaren +Bereichs liegt. sind dezimale oder binre Koordinaten. Das Aussehen +des Punktes kann durch Farbe/Helligkeit oder Bitverknpfung festgelegt wer- +den. Mit einer AND-Bitverknpfung wird der angegebene Punkt gelscht, mit +einer OR oder COPY Bitverknpfung wird der angegebene Punkt gesetzt, mit +einer XOR Bitverknpfung wird sein Zustand umgedreht (invertiert). +Soll ein dicker Punkt gezeichnet werden, dann kann man den (relativen) +Draw-Befehl r 0, 0; benutzen, der an die Position des Graphikcursors, +einen Punkt der eingestellten Dicke zeichnet. + + +#type("8")##center##ib(3)#6.6.1.2 Move-Befehle#ie(3)##type("elite")# + +Den Move-Befehl gibt es in zwei Versionen, einer relativen und einer abso- +luten. Das Kommando fr einen absoluten Move lautet + + #ib(1)# v#ie(1)# (Hex 1B 76 ) + +Dabei sind dezimale oder binre Koordinaten, die die neue Position +des Graphikcursors bezeichnen. Diese Position mu nicht im sichtbaren Be- +reich liegen, sondern kann auch auerhalb des Fensters liegen. Der Wertebe- +reich von und ist -32768 bis 32767. + +Das Kommando fr den relativen Move-Befehl lautet + + #ib(1)# q#ie(1)# (Hex 1B 71 ) + +Bei diesem Befehl werden die Werte von und , die auch den gesamten +Wertebereich von -32768 bis 32767 berstreichen drfen, zu den Koordinaten +des Graphikcursors addiert. Auch hier darf die neue Position des Graphik- +cursors auerhalb des sichtbaren Bereichs liegen. + +Die Move-Befehle setzen auerdem das Bitmuster fr den Linientyp wieder auf +den Startwert zurck, damit der nchste Draw-Befehl auch mit einem Punkt +beginnt. + + +#text end# +#clear pos# +#free(2.140185)# + + +#right#34 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 34 -----------# +#center##on("b")#6. Der Graphikmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#6.6.1.3 Draw-Befehle#ie(3)##type("elite")# + +Ebenso wie den Move-Befehl gibt es auch den Draw-Befehl in zwei Versionen, +einer relativen und einer absoluten. Das Kommando fr einen absoluten Draw +lautet + + #ib(1)# w#ie(1)# (Hex 1B 77 ) + +Dabei sind dezimale oder binre Koordinaten, die die Endposition der +Linie bezeichnen. Diese Position mu nicht im sichtbaren Bereich liegen, +sondern kann auch auerhalb des Fensters liegen. Der unsichtbare Teil der +Linie wird dann "geclippt". Der Wertebereich von und ist -32768 bis +32767. + +Das Kommando fr den relativen Draw-Befehl lautet + + #ib(1)# r#ie(1)# (Hex 1B 72 ) + +Bei diesem Befehl werden die Werte von und , die auch den gesamten +Wertebereich von -32768 bis 32767 berstreichen drfen, zu den Koordinaten +des Graphikcursors addiert, die dann die Endposition der Linie bilden. Auch +hier darf die Endposition der Linie auerhalb des sichtbaren Bereichs lie- +gen. + + +#type("8")##center##ib(3)#6.6.1.4 Turtle-Graphik#ie(3)##type("elite")# + +Turtle-Graphik (Schildkrten-Graphik, obwohl hier keine Schildkrte sicht- +bar ist) wird zur Erzeugung von "rekursiven" Graphiken, die mit Lngen und +Winkelangaben, statt mit x/y-Koordinaten, arbeiten bentigt. Man stellt sich +dazu eine Schildkrte vor, die auf ihrem Weg ber den Bildschirm eine sicht- +bare Spur zurcklassen kann (aber nicht mu). Die Schildkrte kann einen Weg +bestimmter Lnge in ihre Blickrichtung gehen und bleibt dann stehen. Auer- +dem kann sie sich nach links oder rechts drehen, d.h. ihre Blickrichtung +ndert sich. Alles was man dazu braucht, ist ein Befehl, der die Richtung +der Schildkrte verndern kann und dann einen Weg bestimmter Lnge in dieser +Richtung zurcklegt. Auerdem wird noch ein Befehl bentigt, der das "Spur- +verhalten" der Schildkrte ndert, also von "Spur sichtbar" auf "Spur un- +sichtbar" umschaltet und umgekehrt. Natrlich ist die Zeichengeschwindigkeit +nicht mit der Fortbewegungsgeschwindigkeit von Schildkrten zu vergleichen. +Das erste Kommando lautet + + #ib(1)# n#ie(1)# (Hex 1B 6E ) + + und sind dezimale oder binre Parameter. ist die Lnge der Spur +mit einem Wertebereich von 0 bis 511. ist der relative Drehwinkel der +Schildkrte, also die nderung von der ursprnglichen Blickrichtung aus. +berstreicht den positiven und negativen Winkelbereich (0..71 entsprechen 0 +bis 355 in 5 Grad Schritten. -1 entspricht z.B. 355 Grad). + +#text end# +#clear pos# +#free(08.701852e-1)# + + + 35 +#page##--------------------------------- Ende der Seite 35 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Mit dem Kommando + + #ib(1)# o#ie(1)# (Hex 1B 6F) + +kann von 'Draw' einer Spur auf 'Move' umgeschaltet werden und umgekehrt. + +Um die Sichtbarkeit der Spur am Programmamfang auf einen definierten Wert zu +setzen, kann man das Kommando + + #ib(1)# O 8#ie(1)# (Hex 1B 4F 38 ) + +benutzen. ist ein Byteparameter mit dem Wertebereich 0 bis 3. + +#on("u")#Bit 0 hat folgende Bedeutung: #off("u")# + 0 Pendown. Die Schildkrte hinterlt eine sichtbare Spur + 1 Penup. Die Schildkrte hinterlt keine Spur + +#on("u")#Bit 1 hat folgende Bedeutung: #off("u")# + 0 Drawer. Es wird eine weie Linie gezeichnet. + 1 Eraser. Es wird eine schwarze Linie gezeichnet (gelscht) + + +Mit dem Kommando + + #ib(1)# O 9#ie(1)# (Hex 1B 4F 39) + +wird die Turtle-Graphik initialisiert. Dieses Kommando mu nicht aufgerufen +werden bevor die Turtle-Graphik benutzt wird, sollte aber nach Mglichkeit +am Anfang eines Turtle-Graphik-Programmes benutzt werden. Das Kommando setzt +die Schildkrte in die Mitte des Bildschirms (140, 96) mit Blickrichtung +nach oben. Der Drawer wird eingeschaltet (zeichnen) und eine sichtbare Linie +wird voreingestellt (Pendown). + + +#type("8")##center##ib(3)#6.6.2 Komplexere Zeichenkommandos#ie(3)##type("elite")# + +Auer den Kommandos zum Zeichnen von Linien und zum Bewegen des Graphikcur- +sors gibt es noch verschiedene andere Zeichenkommandos. + + +#type("8")##center##ib(3)#6.6.2.1 Kreise und Kreissegmente#ie(3)##type("elite")# + +Der Mittelpunkt eines Kreises liegt immer an der aktuellen Cursorposition. +Der Radius eines Kreises ist in weiten Grenzen von 0 bis ber 30000 Punkten +whlbar. Clipping wird ausserhalb des Bildschirmrandes durchgefhrt. Ein +Kreis kann in 8 Segmente unterteilt werden, von denen alle oder nur einzel- +ne gezeichnet werden knnen. Damit ist es dann auch mglich, Halb- oder +Viertelkreise zu Zeichnen. + +#text end# +#clear pos# +#free(1.293519)# + + +#right#36 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 36 -----------# +#center##on("b")#6. Der Graphikmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Mit dem Kommando + + #ib(1)# K#ie(1)# (Hex 1B 4B ) + +wird ein Kreis mit dem Radius um die aktuelle Cursorposition gezeichnet +(relative Kreise). legt fest, welche Segmente gezeichnet werden sollen. + sind dezimale oder binre Parameter. hat den Wertebereich von 0 +bis 255. +Jedes Bit in ist einem Kreissegment zugeordnet. Ist das Bit gesetzt (1), +dann wird das zugehrige Segment gezeichnet. Der Wert 0 entspricht dem Wert +255 (der ganze Kreis wird gezeichnet), ist aber etwas schneller, da keine +Abfrage der einzelnen Bits durchgefhrt wird. + +Die Segmente sind folgendermaen numeriert: + + 7 0 + 6 1 + 5 2 + 4 3 + +Beispiele fr : + +#on("u")# Bedeutung #off("u")# + 0 Zeichnet einen ganzen Kreis + 15 Zeichnet einen links offenen Halbkreis +240 Zeichnet einen rechts offenen Halbkreis +195 Zeichnet einen unten offenen Halbkreis + 60 Zeichnet einen oben offenen Halbkreis + 3 Zeichnet ein Kreisviertel rechts oben + 12 Zeichnet ein Kreisviertel rechts unten + 48 Zeichnet ein Kreisviertel links unten +192 Zeichnet ein Kreisviertel links oben +etc. + +Das Aussehen von Kreisen kann durch die Parameter Farbe/Helligkeit und die +Bitverknpfung verndert werden. Der Linientyp (Punkt-, Strichlinie) und die +Strickdicke haben keinen Einflu, d.h. der Kreis wird immer mit durchgehen- +der Linie und einfacher Dicke gezeichnet. Sollen diese beiden Parameter auch +verndert werden, sollte man den Befehl s fr Ellipsenbgen verwenden. + + +#type("8")##center##ib(3)#6.6.2.2 Rechtecke#ie(3)##type("elite")# + +Rechtecke werden ebenso wie Kreise relativ gezeichnet, d.h. die aktuelle +Cursorposition bildet eine Ecke des Rechtecks. Die Seiten des Rechtecks +liegen parallel zur X- und Y-Achse, gedrehte Rechtecke knnen aber aus 4 +relativen Draw-Befehlen zusammengesetzt werden. + +#text end# +#clear pos# +#free(1.716852)# + + + 37 +#page##--------------------------------- Ende der Seite 37 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Das Kommando + + #ib(1)# J#ie(1)# (Hex 1B 4A ) + +zeichnet ein leeres Rechteck (Rahmen) an der aktuellen Cursorposition. sind dezimale oder binre Parameter. ist die Breite des Rechtecks +und kann den ganzen Wertebereich von -32768 bis 32767 berstreichen, ist +die Hhe des Rechtecks und kann ebenfalls diesen Wertebereich berstreichen. +Je nach Vorzeichen von und wird das Rechteck links/ rechts und +oben/unten von der aktuelle Cursorposition gezeichnet. + + Cursorposition bildet die Ecke + + + unten links + + - oben links + - + unten rechts + - - oben rechts + + +#type("8")##center##ib(3)#6.6.2.3 Bgen und Ellipsen#ie(3)##type("elite")# + +Um die Zeichengeschwindigkeit eines Kreises zu vergrern, wurde ein sepa- +rater Befehl fr Kreise eingefhrt (6.6.2.1). Da der Kreis ein Sonderfall +der Ellipse ist, kann man das in diesem Abschnitt beschriebene Kommando auch +benutzen, um Kreise mit anderen als den unter 6.6.2.1 beschriebenen Segmen- +ten oder Parametern (Dicke, Strichtyp) zu Zeichnen. + +Das Kommando + + #ib(1)# s#ie(1)# (Hex 1B 73 ...) + +zeichnet um die aktuelle Cursorposition (also relativ) einen Ellipsenbogen +mit Radius in X-Richtung und Radius in Y-Richtung, ausgehend vom +Anfangswinkel im Uhrzeigersinn, bis zum Endwinkel . Der Winkel 0 +Grad ist dabei oben (Norden). + +Alle Parameter sind dezimale oder binre Parameter. und haben den +Wertebereich von 0 bis 255, wobei eine ganze Ellipse einem Anfangswinkel von +0 und einem Endwinkel von 72 entspricht. Die Winkelangaben sind in 5 Grad +Schritten und knnen Anhang A entnommen werden.. und drfen den +vollen Wertebereich von -32768 bis 32767 berstreichen. + + +#text end# +#clear pos# +#free(4.256852)# + + +#right#38 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 38 -----------# +#center##on("b")#6. Der Graphikmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#6.6.2.4 Gefllte Flchen#ie(3)##type("elite")# + +Rechteckige oder rautenfrmige Flchen knnen, wie in Abschnitt 6.5.1.4 +beschrieben, schnell gefllt werden. Fr beliebig geformte Flchen kann das +Kommando + + #ib(1)# |#ie(1)# (Hex 1B 7C ) + +benutzt werden. Dies ist ein relatives Kommando, da um die aktuelle Cursor- +position herum gefllt wird. ist ein Byteparameter mit dem Wertebereich +0 bis 15, der die Nummer des Musters fr die Fllung angibt. Der Fill-Befehl +arbeitet auf der aktuellen Arbeitsseite und fllt eine sichtbar begrenzte +Flche mit einem angegebenen Muster aus. + +Ist die Bitverknpfung OR eingestellt darf der Cursor nicht auf einem weien +Punkt stehen und die Flche mu von einer durchgehenden weien Linie be- +grenzt sein. +Ist die Bitverknpfung AND eingestellt, darf der Cursor nicht auf einem +schwarzen Punkt stehen und die Flche mu von einer durchgehenden schwarzen +Linie begrenzt sein. + +Auer den Parametern Bitverknpfung und Helligkeit/Farbe werden keine be- +rcksichtigt. + +Bei sehr komplex geformten Figuren kann der Fall eintreten, da die Flche +nicht ganz gefllt ist. Dies liegt daran, da intern ein zu grer Spei- +cherplatz zum Merken von Rcksprungcursorpositionen bentigt wird (Stack- +berlauf). In diesem Fall sollte man den Cursor nocheinmal auf die nicht +gefllte Flche setzen und das Kommando erneut geben. + + kann folgende Werte annehmen (Werte Hexadezimal angegeben 0..F): + Bedeutung +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 0 Flche ganz gefllt + 1 Flche halb gefllt (grau) + 2 Jede 4. Zeile wird durchgezogen + 3 Jede 2. Zeile wird durchgezogen + 4 Jede 4. Spalte wird durchgezogen + 5 Jede 2. Spalte wird durchgezogen + 6 Jede 4. Zeile und jede 4. Spalte wird durchgezogen (grobes Raster) + 7 Jede 2. zeile und jede 2. Spalte wird durchgezogen (feines Raster) + 8 Schraffur von links unten nach rechts oben + 9 Schraffur von links oben nach rechts unten + A Schrges Raster (Links- und Rechtsschraffur) + B Feines Funktraster(jeder 2.Punkt in x- und y-Richtung wird gesetzt) + C Mauerwerk + D Feines Netzgeflecht + E Feine Zickzacklinie + F Benutzerdefinierbares Muster. Default: Grobe Zickzacklinie + +#text end# +#clear pos# +#free(08.701852e-1)# + + + 39 +#page##--------------------------------- Ende der Seite 39 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Ist die AND-Bitverknpfung eingeschaltet, dann sind die Punkte schwarz und +wei in den Mustern vertauscht und in der obigen Tabelle sind die Bezeich- +nungen 'gefllt' und 'gelscht' auszutauschen. + + +#type("8")##center##ib(3)#6.6.2.4.1 Definition des Musters#ie(3)##type("elite")# + +Das benutzerdefinierbare Muster des Fill-Befehls (Muster 15) kann mit dem +Kommando + + #ib(1)# O :#ie(1)# (Hex 1B 4F 3A ) + +eingestellt werden. Das Defaultmuster wird dabei berschrieben, das neu +eingestellte Muster allerdings nicht beim Setup mitgesichert. + sind 8 Byteparameter mit dem gesamten Wertebereich 0 bis 255. Das +erste Byte wird im Fllmuster in Richtung der niedrigeren y-Positionen dar- +gestellt, das niederwertigste Bit jedes Bytes in Richtung der niedrigeren +x-Positionen. + + +#type("8")##center##ib(3)#6.7 Graphikdaten zum Host#ie(3)##type("elite")# + +Bisher wurden nur Kommandos beschrieben, die der Host an das Terminal sen- +den kann. Damit der Host ber den Status des Terminals informiert werden +kann, sind auch Kommandos vorhanden, die Daten an den Host senden. Der Host +kann auch ganze Graphikseiten anfordern, so da die auf dem Terminal er- +zeugten Graphiken nach dem Ausschalten nicht verloren sind, sondern vom Host +gespeichert werden knnen. + + +#type("8")##center##ib(3)#6.7.1 Graphikseiten zum Host#ie(3)##type("elite")# + +Graphikseiten knnen ganz oder teilweise bertragen werden. Da ein angefor- +dertes Datenpaket immer ganz bertragen wird, sollte der Host, wenn keine +Flukontrolle eingeschaltet ist, nur so groe Blcke anfordern, die er puf- +fern kann (z.B. 256 Bytes). Selektives Lesen von Graphikseiten kann auch +verwendet werden, um Teile einer Graphik vom Host (und nicht vom Terminal) +verndern zu lassen. Mit dem Kommando / ... kann der modifizierte Teil +dann wieder an das Terminal zurckgesendet werden. Zum Aufbau der Graphik- +seite findet man in Kapitel 6.4.2 Informationen. + +Mit dem Kommando + + #ib(1)# \#ie(1)# (Hex 1B 5C ...) + +kann eine Seite oder ein Teil einer Seite in an den Host gesendet werden. +, , und sind Byteparameter (8 Bits). und bilden +zusammen die binre Lnge, d.h. die Anzahl der Datenbytes, die zum Host +gesendet werden. Die Lnge kann von 0 bis Hex 2000 (dezimal 8192) reichen. +Die Adresse durch und gebildet, darf von 0 bis Hex 1FFF reichen. +#text end# +#clear pos# +#free(08.701852e-1)# + + +#right#40 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 40 -----------# +#center##on("b")#6. Der Graphikmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Zustzlich gilt, da die Summe von Lnge und Adresse nicht grer als Hex +2000 sein darf, da sich die Endadresse dann ausserhalb der Graphikseite +befindet. In diesem Fehlerfall werden keine Daten gesendet. + + +#type("8")##center##ib(3)#6.7.2 Cursorposition zum Host#ie(3)##type("elite")# + +Da die Graphikcursorposition einen anderen Wertebereich berstreicht als die +Position des Textcursors, wurde zum Senden der Graphikcursorposition ein +weiteres Kommando eingefhrt. Pro Koordinate werden dabei 2 Bytes, zusammen +also 4 Bytes, gesendet. Mit dem Kommando + + #ib(1)# ;#ie(1)# (Hex 1B 3B) + +kann der Host diese 4 Bytes anfordern. Die Reihenfolge der Bytes ist + . Im Gegensatz zu ? (fr die Textcursorposi- +tion) wird auch kein abschlieendes gesendet. + + +#type("8")##center##ib(3)#6.7.3 Einzelne Bits zum Host#ie(3)##type("elite")# + +Auer ganzen Graphikseiten oder Blcken daraus, kann der Host auch einzelne +Bytes oder Bits selektieren und empfangen. Dazu stehen zwei Kommandos zur +Verfgung. Mit dem Kommando + + #ib(1)# _#ie(1)# (Hex 1B 5F) + +kann das Byte angefordert werden, in dem sich der Graphikcursor gerade be- +findet. Das Bit 7 ist das Farb- oder Helligkeitsbit, das Bit (xpos MOD 7) +ist das Bit, das durch den Graphikcursor addressiert wird. Wenn der Cursor +auerhalb des sichtbaren Bereichs ist, wird ein Byte Hex 00 geliefert. + +Mit dem Kommando + + #ib(1)# -#ie(1)# (Hex 1B 2D) + +kann das Bit, da durch die Graphikcursorposition addressiert wird, abge- +fragt werden. Dieses Kommando liefert ein Byte, in dem die Bits folgende +Bedeutung haben: + +#on("u")#Bit 0 Dezimal Bedeutung #off("u")# + 0 0 Das adressierte Bit ist nicht gesetzt + 1 1 Das adressierte Bit ist gesetzt + +#on("u")#Bit 1 Dezimal Bedeutung #off("u")# + 0 0 Die Farbe ist violett/dunkel + 1 2 Die Farbe ist gelb/hell + +#text end# +#clear pos# +#free(1.716852)# + + + 41 +#page##--------------------------------- Ende der Seite 41 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Bit 2 Dezimal Bedeutung +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 0 0 Der Graphikcursor ist innerhalb des sichtabren Bereichs + 1 4 Der Graphikcursor ist auerhalb des sichtbaren Bereichs. + Bit 0 und Bit 1 sind dann 0. + +Bit 4 und Bit 5 sind immer 1. Es werden also die ASCII-Ziffern "0" bis "4" +geliefert. + + +#type("8")##center##ib(3)#6.7.4 Parameter zum Host#ie(3)##type("elite")# + +Die eingestellten Draw-Parameter knnen auch abgefragt werden. Dazu exi- +stieren zwei Kommandos. Mit dem Kommando + + #ib(1)# 4#ie(1)# (Hex 1B 34) + +knnen die Nummer der sichtbaren und der Arbeitsseite, im gleichen Format +wie zum Einstellen der Seiten mit dem Kommando #ib(1)# O 7#ie(1)# , angefordert +werden. Es werden ASCII-Zeichen von "0" bis "?" geliefert. Die Bits 0 bis 2 +sind folgendermaen zugeordnet: + +#on("u")#Bit 0 Bedeutung #off("u")# + 0 Sichtbar ist Seite 0 + 1 Sichtbar ist Seite 1 + +#on("u")#Bit 1 Bedeutung #off("u")# + 0 Arbeitsseite ist Seite 0 + 1 Arbeitsseite ist Seite 1 + +#on("u")#Bit 2 Bedeutung #off("u")# + 0 Nur Graphik eingeschaltet + 1 In den letzten 32 Graphikzeilen + sind 4 Textzeilen eingeblendet + +#on("u")#Bit 3 Bedeutung #off("u")# + 0 Der Graphikmodus ist eingeschaltet + 1 Der Textmodus ist eingeschaltet + +Sinnvoll sind die Werte der Bits 0 bis 2 nur dann, wenn Bit 3 = 0 ist. + + +Mit dem Kommando + + #ib(1)# 5#ie(1)# (Hex 1B 35) + +knnen die Linienparameter abgefragt werden. Es wird ein Byte mit dem Wer- +tebereich von 1 bis 127 geliefert. Die einzelnen Bits sind folgendermaen +zugeordnet: + +#text end# +#clear pos# +#free(08.701852e-1)# + + +#right#42 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 42 -----------# +#center##on("b")#6. Der Graphikmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Bit Bedeutung +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# +Bit 0..3 : Strichdicke +Bit 4..5 : Bitverknpfung (0 = OR, 16 = AND, 32 = XOR, 48 = COPY) +Bit 6 : Aktuelle Farbe (0 = Violett/dunkel, 1 = Gelb/hell) + +Die Bitbelegung entspricht der des Parameters des Kommandos #ib(1)# O 5#ie(1)# . + + +#type("8")##center##ib(3)#6.8 Graphikhardcopy#ie(3)##type("elite")# + +Wie von der Textseite kann auch von den Graphikseiten ein Ausdruck angefer- +tigt werden. Dabei knnen keine verschiedene Helligkeitsstufen oder Farben +dargestellt werden. + + +#type("8")##center##ib(3)#6.8.1 Der Druckertreiber#ie(3)##type("elite")# + +Da das Ein- und Ausschalten des Graphikmodus nicht auf allen Druckern durch +gleiche Kommandos erreicht werden kann, mu das Terminal an den vorhandenen +Drucker angepat werden. Defaultmig werden die Epson-Modelle ab RX80 auf- +wrts, sowie kompatible (IBM, Panasonic etc.) untersttzt. Die Anpassung +wird in diesem Abschnitt beschrieben. + +Mit dem Kommando + + #ib(1)# ~#ie(1)# (Hex 1B 7E ) + +knnen Kommandosequenzen eingestellt werden, die folgende Aufgaben haben: + + Default (Hex) Aufgabe +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 0 0D Einleiten der gesamten Hardcopy (Waagenrcklauf) + 1 1B 2A 04 18 01 Einschalten des Graphikmodus. Es folgen 280 Graphikby- + tes (jeweils 8 Bit) + 2 0D 1B 4A 17 Ausschalten des Graphikmodus. Zeilenvorschub ohne Zwi- + schenraum (Zeilenabstand ca. 8 Punkte) und Waagenrck- + lauf. + 3 Nichts Dieses Kommando wird nach der kompletten Hardcopy zum + Drucker gesendet. + +Wenn doppelte Punktbreite eingeschaltet ist, oder zwei Seiten nebeneinander +gedruckt werden, wird die Kommandosequenz 1 auch mehrmals in einer Zeile +gegeben. + + ist dabei ein Byteparameter mit dem Wertebereich von 0 bis 3. ist +eine Folge von bis zu 16 Bytes. Das erste dieser 16 Bytes ist ein Lngenby- +te, das die Lnge der Kommandosequenz (oder die Anzahl der noch folgenden +Bytes) angibt. Fr die nach dem Lngenbyte folgenden Bytes sind alle Werte +von 0 bis 255 erlaubt. + +#text end# +#clear pos# +#free(04.468519e-1)# + + + 43 +#page##--------------------------------- Ende der Seite 43 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Die Druckertreiberstrings (Kommandosequenzen) werden beim Setup in der Kom- +mandozeile auch mit abgespeichert, so da sie nur einmal (wenn berhaupt) +und dann nie wieder eingestellt werden men. + + +#type("8")##center##ib(3)#6.8.2 Die Hardcopyparameter#ie(3)##type("elite")# + +Im Gegensatz zur Hardcopy einer Textseite kann das Aussehen einer Graphik +beim Ausdruck noch verndert werden. Das Kommando + + #ib(1)# ^#ie(1)# (Hex 1B 5E ) + +druckt eine Hardcopy mit dem Parameter . ist ein Byteparameter mit +dem Wertebereich von 0 bis 15. Jedes Bit in legt eine Darstellungsweise +fest. Die Bits haben folgende Bedeutung: + +Invertieren: +Bit 0 Dezimal Bedeutung +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 0 0 Helle Punkte auf dem Bildschirm werden auf dem Drucker schwarz + gedruckt, dunkle Punkte bleiben beim Ausdruck wei. + 1 1 Die Graphik wird invertiert, d.h. Ein dunkler Bildhintergrund + bleibt auf dem Drucker dunkel (schwarz). + +Doppelte Breite: +Bit 1 Dezimal Bedeutung +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 0 0 Jeder Bildschirmpunkt wird in normaler Breite gedruckt. Es + werden also 280 Punkte nebeneinander gedruckt. + 1 2 Jeder Bildschirmpunkt wird in doppelter Breite gedruckt. In + diesem Fall werden auf dem Drucker 560 Punkte nebeneinander + gedruckt. + +Doppelte Hhe: +Bit 2 Dezimal Bedeutung +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 0 0 Jeder Bildschirmpunkt wird in normaler Hhe gedruckt. Es wer- + den also 192 Punkte untereinander gedruckt. + 1 4 Jeder Bildschirmpunkt wird in doppelter Hhe gedruckt. In + diesem Fall werden also 384 Punkte untereinander gedruckt. + +Zwei Seiten nebeneinander drucken: +Bit 3 Dezimal Bedeutung +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 0 0 Es wird nur eine Graphikseite (linksbndig) gedruckt. + 1 8 Die aktuelle (mit #ib(1)# O 7#ie(1)# eingestellte) Graphikseite + wird linksbndig und die andere Graphikseite nahtlos rechts + daneben gedruckt. + +#text end# +#clear pos# +#free(1.293519)# + + +#right#44 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 44 -----------# +#center##on("b")#6. Der Graphikmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Zur Kombination von Mglichkeiten (mehrere Bits sind gesetzt): + +- Eine Graphik mit doppelter Hhe und doppelter Breite hat ungefhr das + Format des Bildschirms. Ein Ausdruck besteht dann aus 560 x 384 = 215040 + Punkten. Zustzliches Invertieren macht die Graphik dem Bildschirmausse- + hen noch hnlicher. + +- Werden zwei Seiten mit doppelter Breite nebeneinander gedruckt, dann re- + icht die Anzahl der Graphikspalten auf dem Drucker mit dem Defaultgra- + phikmodus nicht mehr aus. In diesem Fall sollte man die Druckertreiber + Kommandosequenz 1 temporr auf eine hohe (4-fache) Dichte umschalten. + Solange kein Setup ausgefhrt wird, ist diese Dichte nur solange gltig, + bis das Terminal ausgeschaltet wird. + +#text end# +#clear pos# +#free(16.11019)# + + + 45 +#page##--------------------------------- Ende der Seite 45 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##on("i")##on("u")##ib(3)#7. Die Parameter der seriellen Schnittstelle#ie(3)##off("u")##off("i")##type("elite")# + + +Die Parameter der seriellen Schnittstelle knnen vom Host durch Escape- +Sequenzen gndert werden. Die nderung der Parameter wird erst durchgefhrt, +wenn die Parameterbergabe komplett ist (d.h das letzte Byte wurde bertra- +gen). Alle bertragungsparameter wie Stopbits, Datenbits, Paritt und Bau- +drate werden zusammen in einem 'Rutsch' eingestellt. Die Art der Flukon- +trolle wird mit separaten Escape-Sequenzen eingestellt. +Die Einstellung in der Kommandozeile ist im Kapitel 3 beschrieben. + + +#type("8")##center##ib(3)#7.1 Das bertragungsformat#ie(3)##type("elite")# + +Das bertragunsformat eines Datenbytes sieht folgendermaen aus: +(Beispiel fr 8 Datenbits, 1 Parittsbit und 1 Stopbit) + + +---+---+---+---+---+---+---+---+---+---+---+ + ... |"0"| 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | P |"1"| ... + +---+---+---+---+---+---+---+---+---+---+---+ + Start- ---- D a t e n b i t s ---- Pari- Stop- + bit tts- bit + bit + --------> Zeit + +Bei 7 Datenbits ist das Bit 7 "0". P bezeichnet das Parittsbit. Wenn zwei +Stopbits bertragen werden steht an dieser Stelle das 1. Stopbit ("1"). + + +#type("8")##center##ib(3)#7.2 Die bertragungsparameter#ie(3)##type("elite")# + +Alle vier Parameter werden zugleich verndert. Das Kommando lautet + + #ib(1)# #ie(1)# (Hex 1B 20 20 ) + + ist dabei ein Datenbyte, das wie folgt festgelegt wird: + + Bit 7 6 5 4 3 2 1 0 + +-------+-------+-------+-------+-------+-------+-------+-------+ + |Parity |Parity | Stop- | Daten-| Baudrate | + | even/ |on/off | bits | bits | | | | | + | odd | | | | | | | | + +-------+-------+-------+-------+-------+-------+-------+-------+ + + +#text end# +#clear pos# +#free(2.986852)# + + +#right#46 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 46 -----------# +#center##on("b")#7. Die Parameter der seriellen Schnittstelle#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#7.2.1 Baudrate#ie(3)##type("elite")# + +Baudrate = Anzahl der pro Sekunde bertragenen Bits (bertragungsgeschwin- +digkeit) . + + Bits +#on("u")#Dezimal 3 2 1 0 Neue Baudrate#off("u")# + 0 0 0 0 0 Alte Baudrate (nicht verndern) + 1 0 0 0 1 50 Baud + 2 0 0 1 0 75 Baud + 3 0 0 1 1 109.9 Baud + 4 0 1 0 0 134.58 Baud + 5 0 1 0 1 150 Baud + 6 0 1 1 0 300 Baud + 7 0 1 1 1 600 Baud + 8 1 0 0 0 1200 Baud + 9 1 0 0 1 1800 Baud + 10 1 0 1 0 2400 Baud + 11 1 0 1 1 3600 Baud + 12 1 1 0 0 4800 Baud + 13 1 1 0 1 7200 Baud + 14 1 1 1 0 9600 Baud + 15 1 1 1 1 19200 Baud + +Der Wert 0 kann gebraucht werden, wenn nur Datenbits, Stopbits und Pari- +ttsbit verndert werden sollen. + + +#type("8")##center##ib(3)#7.2.2 Datenbits#ie(3)##type("elite")# + +Bit 4 legt die Anzahl der gesendeten und empfangenen Datenbits fest. + +#on("u")#Dezimal Bit 4 #off("u")# + 0 0 8 Datenbits + 16 1 7 Datenbits + +Mit einem anschliessenden Kommando + + #ib(1)# 6#ie(1)# (Hex 1B 20 36) + +kann das 8. Datenbit ausmaskiert (d.h auf "0" gesetzt) werden. Dies kann +notwendig sein, wenn der Host nur 7 Bit ASCII verarbeitet und auf ein ge- +setztes 8. Datenbit falsch reagiert (Steuerbit oder hnliches). + +Mit + + #ib(1)# 7#ie(1)# (Hex 1B 20 37) + +kann die Maskierung wieder aufgehoben werden. +Zu beachten ist, da bei 7 Bit Datentransfer zum Beispiel das Farbbit bei +Download einer Graphikseite nicht bertragen wird. + +#text end# +#clear pos# +#free(02.351852e-2)# + + + 47 +#page##--------------------------------- Ende der Seite 47 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#7.2.3 Stopbits#ie(3)##type("elite")# + +Bit 5 legt die Anzahl der Stopbits fest. + +#on("u")#Dezimal Bit 5 #off("u")# + 0 0 1 Stopbit + 32 1 2 Stopbits + +Zu beachten ist, da bei eingeschaltetem Paritycheck und 8 Datenbits immer +ein Stopbit bertragen wird, auch wenn 2 Stopbits programmiert wurden. (Es +knnen maximal 11 Bits/Daten"byte" bertragen werden.) + + +#type("8")##center##ib(3)#7.2.4 Parittsbit#ie(3)##type("elite")# + +Bit 6 legt fest, ob Parittskontrolle erfolgen soll und ob ein Parittsbit +vorhanden ist. + +Dezimal Bit 6 +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 0 0 Keine Parittskontrolle/Kein Parittsbit + 64 1 Parittskontrolle eingeschaltet. Paritt mit Bit 7 gewhlt + +Wenn Bit 6 = 1 ist legt Bit 7 fest, ob gerade oder ungerade Paritt geprft +werden soll. + +#on("u")#Dezimal Bit 7 #off("u")# + 0 0 Ungerade Paritt + 128 1 Gerade Paritt + + +#type("8")##center##ib(3)#7.2.5 bertragungsfehler#ie(3)##type("elite")# + +Wird ein Rahmenfehler (Stopbit fehlt) oder ein Parittsfehler (mindestens +ein Bit verflscht) entdeckt, dann wird statt des empfangenen Mlls ein Byte +Hex FF vom Terminal interpretiert. Steht dies im Text, kann man es als in- +vertiertes Punktraster erkennen. Dieses Zeichen richtet wenig Schaden an, +wenn es mitten in einer Escape-Sequenz empfangen wird. + + +#type("8")##center##ib(3)#7.3 Die Flukontrolle#ie(3)##type("elite")# + +Damit keine Daten verloren gehen, wenn der Host oder das Terminal keine +solchen mehr empfangen kann, sollte eine Flukontrolle eingeschaltet wer- +den. Das Terminal hat zwar einen Empfangspuffer von 4K Byte (4096 Zeichen), +aber auch dieser kann einmal voll sein. Der Sendepuffer von 2K Byte (2048 +Zeichen) wird in Anspruch genommen, wenn der Host dem Terminal per Flukon- +trolle mitgeteilt hat, da er keine Zeichen mehr empfangen kann. Das Termi- +nal wartet dann nicht aktiv auf Freigabe vom Host, sondern kann weiter ar- +beiten (Spooler, Bildschirmausgabe, Localmodus etc.). + +#text end# +#clear pos# +#free(04.468519e-1)# + + +#right#48 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 48 -----------# +#center##on("b")#7. Die Parameter der seriellen Schnittstelle#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Wenn das Terminal den Host "gestoppt" hat, kann man das an einem "B U S Y" +in der Statuszeile erkennen, sonst steht dort "R E A D Y". +Wenn der Host das Terminal "gestoppt" hat, kann man das an einem "T X O F F" +in der Statuszeile erkennen, sonst steht dort "T X O N". + +Da dieses Terminal einen groen Empfangspuffer hat, sollte man allerdings im +Notfall auch ohne Flukontrolle auskommen, wenn nicht gerade umfangreiche +Graphikoperationen ausgefhrt werden sollen, bei denen der Puffer nicht +schnell genug geleert werden kann. + + +#type("8")##center##ib(3)#7.3.1 XON/XOFF#ie(3)##type("elite")# + +XON/XOFF ist eine Softwareflukontrolle. Als Stopzeichen wird + + #ib(1)#XOFF#ie(1)# (#ib(1)##ie(1)# Hex 13) + +verwendet. Als Startzeichen wird + + #ib(1)#XON#ie(1)# (#ib(1)##ie(1)# Hex 11) + +verwendet. Diese Flukontrolle sollte nur im Textmodus verwendet werden, da +Binrdaten mglicherweise Hex 11 oder Hex 13 enthalten, die dann nicht als +Protokollzeichen verwendet werden sollen. Der Vorteil dieser Art der Flu- +kontrolle ist, da man mit 3 Leitungen (Masse, TXD, RXD) an der seriellen +Schnittstelle auskommt. + +Das Terminal reagiert auf empfangene XON/XOFF-Zeichen sofort, d.h diese +Zeichen werden nicht in den Empfangspuffer gestellt. Diese beiden Zeichen +werden auch dann interpretiert, wenn das Terminal im Local-Modus ist. + +Die XON/XOFF Flukontrolle kann in der 2. Kommandozeile ein- und ausgeschal- +tet werden, sowie mit dem Kommando + + #ib(1)##ie(1)# (Hex 0F) + +eingeschaltet und mit + + #ib(1)##ie(1)# (Hex 0E) + +ausgeschaltet werden. + +Zu beachten ist, da der Sender vor dem Ausschalten noch im "TX OFF"- +Zustand sein kann. Man sollte deshalb direkt vor noch (Hex +11), also XON senden, um den Sender wieder einzuschalten. Dies wird vom +Terminal nicht automatisch gemacht, da sonst ein das im Datenstrom +vorkommt, auch noch ein Zeichen fr Flukontrolle wre. + + +#text end# +#clear pos# +#free(1.293519)# + + + 49 +#page##--------------------------------- Ende der Seite 49 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#7.3.2 DTR/DSR#ie(3)##type("elite")# + +DTR/DSR ist eine Hardwareflukontrolle bei der die Leitungen Pin 20 (DTR) +und Pin 6 (DSR) (in der Regel berkreuzt) angeschloen sein mssen. +Bei dieser Art der Flukontrolle drfen alle Zeichen bertragen werden, ohne +da eines die Flukontrolle steuert. Ausnahme: Wenn zustzlich XON/ XOFF +Flukontrolle eingeschaltet ist werden natrlich XON/XOFF als Steuerzeichen +interpretiert. + +DTR (Data Terminal Ready)/DSR (DataSet Ready) Flukontrolle kann in der 2. +Kommandozeile ein- und ausgeschaltet werden. Der Host kann dies mit dem +Kommando + + #ib(1)# #ie(1)# (Hex 1B 20 ) + +erreichen. Die Werte von sind + +#on("u")# Hex Bedeutung #off("u")# + 2 32 Weder RTS/CTS noch DSR/DTR Flukontrolle + 3 33 RTS/CTS Flukontrolle, aber keine DSR/DTR Flukontrolle + 4 34 DSR/DTR Flukontrolle, aber keine RTS/CTS Fluskontrolle + 5 35 DSR/DTR und RTS/CTS Flukontrolle + +DTR/DSR Flukontrolle wird empfohlen, da hier alle Zeichen ohne Vernderung +empfangen werden knnen. RTS/CTS Flukontrolle kann, hardwaremig bedingt, +beim Einschalten von RTS ein Bit "umkippen". + + +#type("8")##center##ib(3)#7.3.3 RTS/CTS#ie(3)##type("elite")# + +RTS/CTS ist eine Hardwareflukontrolle bei der die Leitungen Pin 4 (RTS) und +Pin 5 (CTS) (in der Regel berkreuzt) angeschloen sein mssen. +Bei dieser Art der Flukontrolle drfen alle Zeichen bertragen werden, ohne +da eines die Flukontrolle steuert. Ausnahme: Wenn zustzlich XON/ XOFF +Flukontrolle eingeschaltet ist werden natrlich XON/XOFF als Steuerzeichen +interpretiert. + +RTS (Ready To Send)/CTS (Clear To Send) Flukontrolle kann in der 2. Kom- +mandozeile ein- und ausgeschaltet werden. Der Host kann dies mit dem Kom- +mando erreichen. Die Werte von sind im letzten Ab- +schnitt (7.3.2 DTR/DSR) angegeben. + + +#text end# +#clear pos# +#free(3.833519)# + + +#right#50 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 50 -----------# +#center##on("b")#7. Die Parameter der seriellen Schnittstelle#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#7.4 Echo und Local/Online#ie(3)##type("elite")# + +In einigen Fllen verlangt der Host, da das vom Terminal empfangene Zei- +chen zurckgesendet (geechoed) wird, um eventuelle bertragungsfehler zu +erkennen. Dieser Modus wird mit dem Kommando + + #ib(1)# D E#ie(1)# (Hex 1B 44 45) + +eingeschaltet. Zustzlich wird hiermit der Localmodus ausgeschaltet (d.h der +Online-Modus eingeschaltet), falls das Kommando am Terminal im Local-Modus +gegeben wurde. + +Der Echo-Modus wird mit dem Kommando + + #ib(1)# D O#ie(1)# (Hex 1B 44 4F) + +ausgeschaltet. Das Terminal befindet sich dann im Fullduplex Online-Modus. +Der Local-Modus wird auch hierbei verlassen. + +Der Local-Modus kann vom Host mit dem Kommando + + #ib(1)# D L#ie(1)# (Hex 1B 44 4C) + +eingeschaltet werden. Dabei ist zu beachten, da der Host den Local-Modus +nicht ausschalten kann. Der Local-Modus kann vom Benutzer durch Drcken von +#ib(1)##ie(1)# am Keyboard verlassen werden. + +Im Local-Modus werden Keyboardeingabe nicht mehr an den Host geschickt, +sondern auf dem Bildschirm angezeigt bzw. durch das Terminal interpretiert. +Funktionstastensequenzen werden auch nicht an den Host geschickt. Escape- +Sequenzen die allerdings Daten senden (z.B Download von Text und Graphik +oder die Abfrage der Cursorposition), werden wie im Online-Modus ausgefhrt, +d.h. die Daten werden zum Host geschickt. + +#text end# +#clear pos# +#free(7.643519)# + + + 51 +#page##--------------------------------- Ende der Seite 51 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##on("i")##on("u")##ib(3)#8. Spezielle Kommandos im Textmodus#ie(3)##off("u")##off("i")##type("elite")# + + +In diesem Kapitel werden weitere Kommandos, die im Textmodus wirksam sind +und thematisch nicht in die anderen Kapitel passen, beschrieben. + + +#type("8")##center##ib(3)#8.1 Weitere Cursorpositionierungskommandos#ie(3)##type("elite")# + +Zustzlich zu den im Graphikmodus und im Textmodus gltigen Cursorpositio- +nierungskommandos gibt es noch einige weitere. Die fnf Kommandos Zeile +lschen, Zeile einfgen, Zeichen lschen, Zeichen einfgen und Rckwrtsta- +bulator sind schon in Kapitel 5 beschrieben worden. + +Hier nur noch einmal die entsprechenden Kommandos: + +Funktion Escape-Sequenz +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# +Zeile einfgen #ib(1)# E#ie(1)# oder #ib(1)# L#ie(1)# +Zeile lschen #ib(1)# R#ie(1)# oder #ib(1)# M#ie(1)# +Zeichen einfgen #ib(1)# Q#ie(1)# +Zeichen lschen #ib(1)# W#ie(1)# +Rckwrtstabulator #ib(1)# I#ie(1)# + +Mit dem Kommando + + #ib(1)# j#ie(1)# (Hex 1B 6A) + +kann ein umgekehrter Zeilenvorschub erreicht werden. Steht der Cursor in +Zeile 2 bis Zeile 24, dann wirkt dieses Kommando wie . Steht der Cursor +in Zeile 1, dann wird der Bildschirminhalt nach unten gescrollt und die +erste Bildschirmzeile gelscht. + +Mit dem Kommando + + #ib(1)# =#ie(1)# (Hex 1B 3D ...) + +kann der Cursor auf eine bestimmte Position auf dem Bildschirm gesetzt wer- +den. und sind dabei Byteparameter. hat den Wertebe- +reich 32 () bis 110 ("o"), hat den Wertebereich 32 () +bis 55 ("7"). ist dabei die gewnschte x-Position + 32 (gezhlt wird +von 0 bis 79), ist die gewnschte y-Position + 32 (gezhlt wird von 0 +bis 23). Die Zuordnungen der ASCII-Zeichen zu den Cursorpositionen kann man +auch im Anhang A unter "Cursor" nachlesen. + +Dieser Befehl hat im Graphikmodus die gleiche Wirkung! + + +#text end# +#clear pos# +#free(1.716852)# + + +#right#52 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 52 -----------# +#center##on("b")#8. Spezielle Kommandos im Textmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#8.2 Cursormodus#ie(3)##type("elite")# + +Mit dem Kommando + + #ib(1)# .#ie(1)# (Hex 1B 2E ) + +kann die Darstellung des Cursors verndert werden. Fr sind ASCII-Zei- +chen "0", "1" und "2" zugelassen. hat folgende Bedeutung: + +#on("u")# Bedeutung #off("u")# + 0 Cursor blinkt nicht und ist unsichtbar + 1 Cursor blinkt und ist sichtbar + 2 Cursor blinkt nicht und ist sichtbar + +Mit dem Kommando + + #ib(1)# Z#ie(1)# (Hex 1B 5A) + +kann der Zustand des Cursors von sichtbar auf unsichtbar und umgekehrt umge- +schaltet werden. + + +#type("8")##center##ib(3)#8.3 Zeichensatz einstellen#ie(3)##type("elite")# + +Da die Zeichenstze von Basis und Apple unterschiedlich sind, mu hier bei +den Parametern unterschieden werden. Das Kommando zur Einstellung des Zei- +chensatzes lautet in beiden Fllen + + #ib(1)# z#ie(1)# (Hex 1B 7A ) + +wobei ein Byteparameter ist. Beim Apple hat folgende Bedeutung: + + Zeichensatz +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 1 Full Ascii: 128 Zeichen, ASCII, normale, inverse und blinkende Zei- + chen + 4 Ascii: 128 Zeichen, ASCII, normale und blinkende Zeichen + +Beim Basis hat folgende Bedeutung: + + Zeichensatz +#rpos(16.2)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# + 0 = Apple II: 64 Zeichen, ASCII, normale, inverse und blinkende Zeichen + 1 = Full Ascii: 128 Zeichen, ASCII, normale, inverse und blinkende Zeichen + 2 = Deutsch: 128 Zeichen, deutsch, normale und inverse Zeichen + 4 = Ascii: 128 Zeichen, ASCII, normale und inverse Zeichen + 6 = APL: 128 Zeichen, APL, normale und inverse Zeichen + +#text end# +#clear pos# +#free(1.716852)# + + + 53 +#page##--------------------------------- Ende der Seite 53 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# + Und mit blinkenden statt inversen Zeichen: + 8 = Apple II: 64 Zeichen, ASCII, normale, blinkende und inverse Zeichen (!) + 9 = Full Ascii: 128 Zeichen, ASCII, normale, blinkende und inv. Zeichen (!) +10 = Deutsch: 128 Zeichen, deutsch, normale und blinkende Zeichen +12 = Ascii: 128 zeichen, ASCII, normale und blinkende Zeichen +14 = APL: 128 Zeichen, APL, normale und blinkende Zeichen + +Einige ausgewhlte Zeichenstze knnen auch in der Kommandozeile eingestellt +werden. + + +#type("8")##center##ib(3)#8.4 Texthardcopy#ie(3)##type("elite")# + +Einen Ausdruck des Textbildschirminhaltes auf dem Drucker kann man mit dem +Kommando + + #ib(1)# P#ie(1)# (Hex 1B 50) + +erreichen. Der auf dem Drucker eingestellte Schrifttyp wird nicht vern- +dert. Es werden 24 Zeilen gedruckt, die Statuszeile wird nicht gedruckt, +sondern die "darunterliegende" 24. Textzeile. Nach jeder Zeile wird und + gedruckt, der Drucker sollte deshalb kein Autolinefeed bei durch- +fhren. + +Inverse Bildschirmzeichen (80..FF) werden durch Doppeldruck (dunkler) her- +vorgehoben, Controlcharacter (00..1F und 80..9F) werden unterstrichen dar- +gestellt, das Punktraster (7F und FF) wird als unterstrichenes # darge- +stellt. + + +#type("8")##center##ib(3)#8.5 Zeichen-Attribute#ie(3)##type("elite")# + +Die Zeichenattribute werden mit dem Kommando + + #ib(1)# G#ie(1)# (Hex 1B 47 ) + +eingestellt. ist ein Byteparameter, der folgende Werte annehmen kann: + +#on("u")# Attribute #off("u")# + 0 Sichtbare, normale Zeichen + 1 Unsichtbare Zeichen, es werden Leerzeichen dargestellt + 4 Sichtbare, inverse Zeichen + 5 Unsichtbare Zeichen, es werden inverse Leerzeichen dargestellt. + +Mit dem Kommando + + #ib(1)# (#ie(1)# (Hex 1B 28) + +kann auf normale Darstellung umgeschaltet werden (wirkt hnlich G 0, +schaltet aber nicht auf sichtbare Darstellung, falls unsichtbar). + +#text end# +#clear pos# +#free(04.468519e-1)# + + +#right#54 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 54 -----------# +#center##on("b")#8. Spezielle Kommandos im Textmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Mit dem Kommando + + #ib(1)# )#ie(1)# (Hex 1B 29) + +kann auf inverse Darstellung umgeschaltet werden (wirkt hnlich G 4, +schaltet aber nicht auf sichtbare Darstellung, falls unsichtbar). + + +#type("8")##center##ib(3)#8.6 Bildhintergrund hell/dunkel#ie(3)##type("elite")# + +Die Bildschirmdarstellung kann von heller Schrift auf dunklem Grund (be- +zglich eines gelschten Bildschirms) umgeschaltet werden auf dunkle Schrift +auf hellem Grund. Die Darstellung "schwarz auf wei" ist auf einigen Monito- +ren augenfreundlicher. + +Mit dem Kommando + + #ib(1)# b#ie(1)# (Hex 1B 62) + +kann die dunkle Schrift auf weiem Grund eingeschaltet werden. Die Darstel- +lung von inverser und normaler Schrift wird vertauscht. + +Mit dem Kommando + + #ib(1)# d#ie(1)# (Hex 1B 64) + +kann helle Schrift auf dunklem Grund eingeschaltet werden. + + +#type("8")##center##ib(3)#8.7 Zeichentransfer zum Host#ie(3)##type("elite")# + +Der Host kann Teile oder den ganzen Bildschirm vom Terminal lesen. Alle +Zeichen werden als Bytes gesendet, bei denen ein gesetztes Bit 7 Invers- +schrift anzeigt. + + +#type("8")##center##ib(3)#8.7.1 Ein Zeichen senden#ie(3)##type("elite")# + +Mit dem Kommando + + #ib(1)# 8#ie(1)# (Hex 1B 38) + +wird nur das Zeichen an der Cursorposition gesendet. Die Cursorposition +ndert sich nicht. Der Cursor mu nicht sichtbar sein. + + +#text end# +#clear pos# +#free(2.563519)# + + + 55 +#page##--------------------------------- Ende der Seite 55 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#8.7.2 Eine Zeile senden#ie(3)##type("elite")# + +Mit dem Kommando + + #ib(1)# 6#ie(1)# (Hex 1B 36) + +wird die Zeile, in der der Cursor steht (genauer: die Zeile der Cursorrow, +falls der Cursor unsichtbar ist) an den Host gesendet. Falls der Cursor in +Zeile 24 steht, wird nicht die Stauszeile, sondern die 24. Textzeile gesen- +det. Im Anschlu an die Zeile werden eventuell ein oder zwei eingestellte +Zeilenbegrenzer gesendet (Lineterminator). Die Programmierung der Begrenzer +ist in Abschnitt 8.7.4 beschrieben. Es werden also 80 bis 82 Zeichen gesen- +det. Die Cursorposition ndert sich durch das Kommando nicht. + + +#type("8")##center##ib(3)#8.7.3 Eine Seite senden#ie(3)##type("elite")# + +Mit dem Kommando + + #ib(1)# 7#ie(1)# (Hex 1B 37) + +wird die gesamte Bildschirmseite an den Host gesendet. Im Anschlu an jede +Zeile werden (falls eingestellt) Zeilenbegrenzer gesendet. Im Anschlu an +die gesamte Seite wird ein (eingestellter) Seitenbegrenzer (Pageterminator) +gesendet. Es werden also je nach Zeilen- und Seitenbegrenzer 1920 bis 1969 +Zeichen gesendet. Die Statuszeile wird nicht gesendet, sondern die "darun- +terliegende" 24. Textzeile. Die Programmierung der Zeilen- und Seitenbe- +grenzer ist in Abschnitt 8.7.4 beschrieben. Die Cursorposition ndert sich +durch dieses Kommando nicht. + + +#type("8")##center##ib(3)#8.7.4 Terminatorzeichen definieren#ie(3)##type("elite")# + +Mit dem Kommando + + #ib(1)# x 1#ie(1)# (Hex 1B 78 31 ) + +knnen die Zeilenbegrenzer der Sendekommandos festgelegt werden. und + sind dabei Byteparameter, die den Wertebereich 0 bis 255 berstrei- +chen. Ist ein Parameter Hex 00, dann wird dieses Zeichen nicht gesendet. +Wenn man also das Kommando (Hex) 1B 78 31 00 00 sendet, wird kein Begren- +zerzeichen nach der Zeile gesendet. +Voreingestellt ist ein Begrenzerzeichen; und zwar US (Hex 1F). + +Mit dem Kommando + + #ib(1)# x 4#ie(1)#

(Hex 1B 78 34

) + +kann der Seitenbegrenzer des Kommandos #ib(1)# 7#ie(1)# festgelegt werden.

ist +ein Byteparameter, der den Wertebereich von 0 bis 255 berstreicht. Ist

+Hex 00, dann wird kein Seitenbegrenzer gesendet. +Voreingestellt ist

= (Hex 0D). +#text end# +#clear pos# +#free(02.351852e-2)# + + +#right#56 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 56 -----------# +#center##on("b")#8. Spezielle Kommandos im Textmodus#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#8.7.5 Cursorposition senden#ie(3)##type("elite")# + +Mit dem Kommando + + #ib(1)# ?#ie(1)# (Hex 1B 3F) + +kann der Host die Position des Textcursors abfragen. Es wird eine Folge von +3 Bytes gesendet: + + ist die y-Position + 32, die x-Position + 32. Beide Parameter +knnen fr den Befehl #ib(1)# =#ie(1)# verwendet werden, da Sie den +gleichen Wertebereich berstreichen. + + +#type("8")##center##ib(3)#8.8 Textseite auf Diskette speichern/laden#ie(3)##type("elite")# + +Genau wie Graphikseiten kann auch die Textseite auf Diskette geschrieben und +zu einem spteren Zeitpunkt wieder zurckgeladen werden. Bei der Textseite +wird auerdem noch die aktuelle Cursorposition geladen/geschrieben. Man kann +sich zum Beispiel eine Datei Seitenweise auf dem Bildschirm anzeigen lassen +und diese Seiten auf Diskette abspeichern. Spter kann man die Datei Offline +(im Localmodus) Seitenweise ansehen. + +Bis zu 8 Textseite lassen sich auf Diskette speichern und wieder abrufen. +Die "Fcher" fr die Textseiten sind unabhngig von denen fr die Graphik- +seiten. +Die Seiten werden unabhngig von REVVID (Schwarz auf Wei) immer NORVID +(also Wei auf Schwarz) abgespeichert. Beim Laden der Seite wird sie je nach +REVVID/NORVID dargestellt. + +Das Kommando fr diese Operationen lautet + + #ib(1)# S#ie(1)# (Hex 1B 53 ). + + ist ein Byteparameter mit dem Wertebereich 0 bis 31, wobei die Bits +folgendermaen belegt sind: +Bit 0..2 : "Fachnummer" der Textseite auf der Diskette (0 bis 7) +Bit 3 : Bei Textseiten immer 0 (Bei Graphikseiten immer 1) +Bit 4 : 0 heit: die Textseite wird von der Diskette gelesen, + 1 heit: die Textseite wird auf die Diskette geschrieben. + +Wird die Textseite auf die Diskette geschrieben, dann wird eine eventuell +schon in diesem "Fach" vorhandene Textseite berschrieben. + +Fr Insider: Jede Textseite belegt einen halben Track (2k). Die 8 Textseiten + befindenden auf den Tracks 6 bis 9 in aufsteigender Reihenfol- + ge. + + +#text end# +#clear pos# +#free(1.293519)# + + + 57 +#page##--------------------------------- Ende der Seite 57 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##on("i")##on("u")##ib(3)#9. Verschiedene Steuerkommandos#ie(3)##off("u")##off("i")##type("elite")# + + +#type("8")##center##ib(3)#9.1 Signalton#ie(3)##type("elite")# + +Mit + #ib(1)##ie(1)# (Hex 07) + +wird ein kurzer Signalton ausgegeben. Ein Warnton des Terminals ist schr- +fer (heller). + + +#type("8")##center##ib(3)#9.2 Keyboardclick#ie(3)##type("elite")# + +Der Tastaturclick wird fr fast alle Tasten erzeugt. Ausnahmen sind die + und die Tasten, sowie beim Apple die Apfeltasten. Der Tasta- +turclick kann in der ersten Kommandozeile abgeschaltet werden (CLK OFF) oder +mit dem Kommando + + #ib(1)# <#ie(1)# (Hex 1B 3C) + +vom Host. Mit dem Kommando + + #ib(1)# >#ie(1)# (Hex 1B 3E) + +kann der Keyboardclick wieder eingeschaltet werden. + + +#type("8")##center##ib(3)#9.3 Bildschirmausgabe/Druckerausgabe#ie(3)##type("elite")# + +Die Bildschirmausgabe, die ja normalerweise eingeschaltet ist, kann in der +Kommandozeile abgeschaltet werden (SCRNOFF) oder vom Host mit dem Kommando + + #ib(1)# `#ie(1)# (Hex 1B 60) + +abgeschaltet werden. Bis auf das Kommando + + #ib(1)# a#ie(1)# (Hex 1B 61) + +werden keine Escape-Squenzen oder Control-Codes interpretiert. Mit a +wird die Bildschirmausgabe wieder zugelassen. + +Die Druckerausgabe kann mit dem Kommando + + #ib(1)# @#ie(1)# (Hex 1B 40) + +eingeschaltet werden. Man kann dann Texte parallel auf Drucker und Bild- +schirm ausgeben. In der ersten Kommandozeile kann die Druckerausgabe auch +ein- und ausgeschaltet werden. +#text end# +#clear pos# +#free(1.293519)# + + +#right#58 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 58 -----------# +#center##on("b")#9. Verschiedene Steuerkommandos#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Man kann zum Beispiel den Schrifttyp des Druckers im Local-Modus umschal- +ten, wenn man in der Kommandozeile die Druckerausgabe (PRT ON) einschaltet. +Dazu kann man sich auch eine Funktionstaste belegen, die Bildschirmausgabe +abschaltet, Druckerausgabe einschaltet, den Schrifttyp umschaltet, Drucker- +ausgabe wieder ausschaltet und Bildschirmausgabe wieder einschaltet. + +Abgeschaltet wird die Druckerausgabe mit dem Kommando + + #ib(1)# A#ie(1)# (Hex 1B 41) + + +#type("8")##center##ib(3)#9.4 Scroll/Page-Modus#ie(3)##type("elite")# + +Steht der Cursor in der letzten Zeile und soll er in die nchst tiefere +gebracht werden (, , etc.), dann gibt es entweder die +Mglichkeit, da der Bildschirm nach oben gescrollt wird, d.h. die 1. Zeile +verschwindet und die 24. Zeile wird gelscht, oder da der Cursor in der +ersten Bildschirmzeile wieder auftaucht, ohne da der Bildschirminhalt ver- +ndert wird. Die erste Mglichkeit heit SCROLL-Modus, die zweite PAGE- +Modus. Die Umschaltung kann entweder in der ersten Kommandozeile erfolgen +oder mit dem Kommando + + #ib(1)# H#ie(1)# (Hex 1B 48). + +In der Kommandozeile hat man die Informationsmglichkeit, welcher Modus +gerade aktiv ist. + + +#type("8")##center##ib(3)#9.5 Belegung der Funktionstasten#ie(3)##type("elite")# + +Eine ntzliche Angelegenheit sind die programmierbaren Funktionstasten. Die +Codes der Funktionstasten sind unter anderem in Anhang A zu finden. Funk- +tionstasten knnen im Local-Modus aufgerufen werden, zum Beispiel fr hu- +fig gebrauchte Terminalkommandos oder lngere Kommandosequenzen (Graphikmo- +dus). Im Online-Modus kann man z.B. Betriebssystemkommandos auf Funktion- +stasten legen. + +Die Lnge der Zeichen auf allen Funktionstasten darf zusammen nicht 4095 +Zeichen berschreiten. Ein akustisches Warnsignal ertnt, wenn die Funk- +tionstastentabelle voll ist. Soll die Funktionstastendefinition auch noch +nach dem Abschalten des Terminals erhalten bleiben, dann mu in der Komman- +dozeile gegeben werden, damit der Setup samt Funktionstastende- +finitionen auf die Diskette geschrieben wird. + +#text end# +#clear pos# +#free(3.410185)# + + + 59 +#page##--------------------------------- Ende der Seite 59 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Mit dem Kommando + + #ib(1)# e#ie(1)# (Hex 1B 65 ) + +wird eine Taste belegt. und sind Byteparameter. ist eine +Folge von Datenbytes, deren Bit 7 = 0 sein mu. ist der Code der Funk- +tionstaste (Bit 7 = 1), auf die die Sequenz gelegt werden soll. Durch diese +Einschrnkung sind keine rekursiven (sich selbst aufrufenden) Tastenkomman- +dos mglich, man kann allerdings z.B. auch nicht alle binren Parameter auf +Tasten legen (Man sollte dezimale Parameter benutzen). Die Cursortasten etc. +knnen nicht belegt werden. +Um die Original-Tastencodes wieder zu benutzen, gibt es drei Mglichkeiten: + +- Die Tabelle der Tastendefinitionen wird ganz gelscht (Abschnitt 9.6). +- Die Definition auf einzelnen Tasten wird durch e gelscht. + ist dabei der Code einer zu lschenden Taste. +- In der ersten Kommandozeile wird F CODE eingeschaltet oder das Kommando + + #ib(1)# c#ie(1)# (Hex 1B 63) + + gegeben. Dieses Kommando schaltet um, ob immer Tastencodes (A1..EF) oder, + bei belegten Tasten, die programmierte Sequenz geliefert werden soll. Im + Graphikmodus mchte man eventuell die griechischen Sonderzeichen auf den + Funktionstasten benutzen (F CODE) und nicht die programmierten Tasten- + strings (F STRG). + + +#type("8")##center##ib(3)#9.5.1 Local-Escape#ie(3)##type("elite")# + +Um Funktionstasten mit Terminalkommandos auch im Online-Modus benutzen zu +knnen (zum Beispiel ein Bildschirm Hardcopy) wird ein spezielles ESC-Zei- +chen statt (Hex 1B) verwendet. +Das Zeichen + + #ib(1)##ie(1)# (Hex 9B) + +teilt dem Terminal mit, da die nun folgende Escape-Sequenz nicht an den +Host gesendet wird (was bei der Fall wre), sondern vom Terminal in- +terpretiert werden mu. +Im Local-Modus wirkt ein wie ein normales , d.h. das Kommando +wird sowieso vom Terminal interpretiert. + + +#type("8")##center##ib(3)#9.5.2 Makrokommandos#ie(3)##type("elite")# + +Ein Makrokommando hat (mindestens) drei Aufgaben: +- Der Host kann dem Terminal neue ESC-Sequenzen (mit Parametern) definieren, + z.B. um andere Terminals zu emulieren. +- Nicht nur das Terminal kann Funktionstasten aufrufen, sondern auch der + Host, wenn die Funkionstaste als Makro aufgerufen wird. +- Der Datentransfer vom Host zum Terminal kann durch Makros als Abkrzungen + hufig benutzter Zeichenfolgen beschleunigt werden. +#text end# +#clear pos# +#free(02.351852e-2)# + + +#right#60 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 60 -----------# +#center##on("b")#9. Verschiedene Steuerkommandos#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +Ein Makro wird wie eine Funktionstaste mit dem Kommando + + + #ib(1)# e#ie(1)# (Hex 1B 65 ) + +definiert. und sind Byteparameter. ist eine Folge von +Datenbytes, deren Bit 7 = 0 sein mu. ist der Code der Funktionstaste +(Bit 7 = 1) oder mit anderen Worten der Makroname. +Es sind alle Codes fr zugelassen, die auch bei der Funktionstastende- +finition zugelassen sind. + +Ein Makro kann sowohl vom Terminal (auch im F CODE-Modus) als auch vom Host +mit + + #ib(1)# #ie(1)# (Hex 1B ) + +aufgerufen werden. Dem Terminal wird die Zeichensequenz des Makros so vorge- +setzt, als kme sie von der Tastatur im Local-Modus. Wird das Makro also +bereits im Local-Modus aufgerufen, hat das immer noch den Vorteil, da man +im F CODE-Modus weiterhin programmierte Funktionstasten benutzen kann. +Anmerkung: Wird das vor dem weggelassen, dann wird der + Code ohne Makroausfhrung an das Terminal gesendet + und i.d.R. als inverses Zeichen dargestellt. + +Sollen Byteparameter in die Zeichensequenz des Makros bernommen werden, die +zur Zeit der Makrodefinition noch nicht feststehen, dann kann man einen +Platzhalter mit dem Code Hex 81 an der Stelle einsetzen. Der Code Hex 81 +kann auf der Tastatur durch erzeugt werden. +Wird bei der Makroausfhrung ein solcher Code gefunden, wartet das Terminal +auf ein Byte von Tastatur, wenn das Makro im Local-Modus aufgerufen wurde, +oder vom Host, wenn das Makro vom Host aufgerufen wurde. Es drfen beliebig +viele Codes 81 in der Makrozeichensequenz vorhanden sein. Jeder Code wird +durch ein weiteres Zeichen von Host oder Tastatur ersetzt. + + +#type("8")##center##ib(3)#9.5.3 Startup-Makro#ie(3)##type("elite")# + +Ein besonderes Makro hat den Code Hex EF. Dieser Code kann auf der Tastatur +durch (beim Apple ) erzeugt werden. + +Dieses Makro wird bei einem RESET des Terminals (Hardwarereset oder 0) +oder beim Einschalten des Terminals aufgerufen. Der Bildschirm und die Gra- +phikseiten werden vorher gelscht. + + +#text end# +#clear pos# +#free(2.986852)# + + + 61 +#page##--------------------------------- Ende der Seite 61 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +#type("8")##center##ib(3)#9.6 Tabellen und Puffer lschen#ie(3)##type("elite")# + +Das Terminal enthlt den Empfangspuffer, den Sendepuffer, den Druckerspoo- +ler und die Tabelle der Tastendefinitionen. Um einen der Puffer oder die +Tabelle zu lschen, kann das Kommando + + #ib(1)# #ie(1)# (Hex 1B 7F ) + +verwendet werden. ist ein Byteparameter mit dem Wertebereich 0 bis 15 +und hat folgende Bedeutung: + +#on("u")# Gelschte Tabelle oder Puffer#off("u")# + 0 Keine + 1 Tastendefinitionen + 2 Druckerspooler + 3 Empfangspuffer + 4 Sendepuffer + +Zu beachten ist, da zwar der Sendepuffer gelscht wird, aber eine eventu- +ell gestoppte bertragung (TX OFF) nicht wider gestartet wird. + + +#type("8")##center##ib(3)#9.7 Zeitverzgerung#ie(3)##type("elite")# + +Mit dem Kommando + + #ib(1)# 9#ie(1)# (Hex 1B 39 ) + +kann eine Zeitverzgerung aufgerufen werden. Man kann zum Beispiel ein Fa- +denkreuz darstellen, die Zeitverzgerung aufrufen und das Fadenkreuz wieder +lschen. ist ein Byteparameter mit dem Wertebereich von 0 bis 255. Die +Verzgerung betrgt ca. * 2 ms. + + +#type("8")##center##ib(3)#9.8 Transparentmodi#ie(3)##type("elite")# + +Der Monitor- und der Hexadezimalmodus sind zum Test von unbekannten Emp- +fangsdaten oder zum Analysieren der Steuerzeichenausgabe von unbekannten +Programmen gedacht. + + +#type("8")##center##ib(3)#9.8.1 Monitor-Modus#ie(3)##type("elite")# + +Im Monitor-Modus werden druckbare Zeichen wie normal dargestellt. Control- +zeichen (Hex 00..1F und 80..9F) werden invertiert dargestellt. Im APL-Zei- +chensatz kann man diese inversen Controlzeichen von den Zeichen mit Code Hex +A0..FF unterscheiden, die auch invers dargestellt werden. +Der Monitormode kann in der ersten Kommandozeile ein- und ausgeschaltet +werden. Mit dem Kommando + + #ib(1)# U#ie(1)# (Hex 1B 55) + +#text end# +#clear pos# +#free(02.351852e-2)# + + +#right#62 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 62 -----------# +#center##on("b")#9. Verschiedene Steuerkommandos#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#clearpos# +#rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")##rpos(16.2)##fillchar(" ")# +#text begin# +kann der Monitormode eingeschaltet werden. Alle Zeichen werden ohne Inter- +pretation ausgegeben, Ausnahmen sind + + #ib(1)# u#ie(1)# (Hex 1B 75) + +und + + #ib(1)# X#ie(1)# (Hex 1B 58) + +die den Monitormodus ausschalten. + + +#type("8")##center##ib(3)#9.8.2 Hexadezimal-Modus#ie(3)##type("elite")# + +In diesem Modus werden nicht die Zeichen auf dem Bildschirm gedruckt, son- +dern ihr ASCII-Code in hexadezimaler Schreibweise mit zwei nachfolgenden +Blanks. Der Hexmode kann mit dem Kommando + + #ib(1)# u#ie(1)# (Hex 1B 75) + +ein- und ausgeschaltet werden. Alle Zeichen werden ohne Interpretation aus- +gegeben, auer #ib(1)# u#ie(1)# und + + #ib(1)# X#ie(1)# (Hex 1B 58), + +die den Hexmodus wieder ausschalten. Auch der Hexmode kann in der ersten +Kommandozeile ein- und ausgeschaltet werden. + + +#type("8")##center##ib(3)#9.8.3 Einzelne Control-Zeichen anzeigen#ie(3)##type("elite")# + +Um nur einzelne Controlzeichen auf dem Bildschirm darzustellen, z.B. fr den +unteren Teil des APL-Zeichensatzes (Codes 0 bis 31 oder 128 bis 159), gibt +es das Kommando + + #ib(1)# F#ie(1)# (Hex 1B 46 ). + + ist dabei ein Byteparameter mit dem Wertebereich 0 bis 255, vorzugswei- +se 0 bis 31. wir mit invertiertem Bit 7 (normal/invers) in den Bild- +schirmspeicher an der aktuellen Cursorposition geschrieben. +#text end# +#clear pos# +#free(5.103519)# + + + 63 +#page##--------------------------------- Ende der Seite 63 -----------# diff --git a/system/ruc-terminal/unknown/doc/TINHALT.PRT b/system/ruc-terminal/unknown/doc/TINHALT.PRT new file mode 100644 index 0000000..cfb865c --- /dev/null +++ b/system/ruc-terminal/unknown/doc/TINHALT.PRT @@ -0,0 +1,120 @@ +#type ("elite")##limit (16.2)# +#kopf ("Bedienungshandbuch zum ruc - Graphikterminal")# +#h("", "Inhalt ")# + +1. Einige Worte zuvor ........................... 1 +2. Die Hardware ................................. 2 +2.1 Die serielle Schnittstelle .................. 2 +2.2 Der Reset ................................... 2 +3. Die Kommandozeile ............................ 3 +3.1 Tastenfunktionen in der Kommandozeile ....... 3 +3.2 Setup ....................................... 4 +3.3 Die zweite Kommandozeile .................... 4 +3.4 Die zweite Kommandozeile .................... 6 +4. Die Statuszeile .............................. 8 +4.1 Spoolerstatus ............................... 8 +4.2 Empfngerstatus ............................. 8 +4.3 Senderstatus ................................ 9 +4.4 Busy - Anzeige .............................. 9 +4.5 Online/Local - Anzeige ...................... 9 +5. Die Bedeutung der Tasten ..................... 10 +5.1 Die Funktions- und Steuertasten ............. 10 +5.2 Die TVI-Emulation ........................... 13 +6. Der Graphikmodus ............................. 16 +6.1 Allgemeines ................................. 16 +6.2 Koordinaten und Parameterbergabe ........... 16 +6.2.1 Cursorposition/Fadenkreuz ................. 16 +6.2.2 Binre oder dezimale Parameter ............ 17 +6.2.2.1 Binre Parameter ........................ 17 +6.2.2.2 Dezimale Parameter ...................... 17 +6.2.3 Absolute oder relative Koordinaten ........ 18 +6.2.4 Byteparameter ............................. 18 +6.3 Die Graphikparameter ........................ 19 +6.3.1 Strichdicke ............................... 19 +6.3.2 Farbe/Helligkeit .......................... 19 +6.3.3 Linientyp ................................. 20 +6.3.3.1 Selbstdefinierte Linientypen (Pattern) .. 20 +6.3.4 Bitverknpfungen .......................... 21 +6.3.5 Multiparametereinstellung ................. 22 +6.4 Graphikseiten ............................... 22 +6.4.1 Die sichtbare Seite und die Arbeitsseite .. 22 +6.4.1.1 80-Zeichen Text und Graphik ............. 23 +6.4.2 Aufbau einer Graphikseite ................. 23 +6.4.3 Operationen auf den Graphikseiten ......... 24 +6.4.4 Laden einer Graphikseite vom Host ......... 25 +6.4.5 Graphik auf Diskette speichern/laden ...... 26 +6.5 Textdarstellung im Graphikmodus ............. 26 +6.5.1 Zeichendarstellung ........................ 27 +6.5.1.1 Zeichengre und Schreibrichtung ........ 27 +6.5.1.2 Dicke, Farbe etc. ....................... 28 +6.5.1.3 Zeichenstze und Attribute .............. 28 +6.5.1.4 Zeichen berschreiben ................... 29 +6.5.2 Textkommandos im Graphikmodus ............. 30 +6.5.2.1 Die Cursorpositionierung ................ 30 +6.5.2.2 Lschbefehle ............................ 33 +6.6 Die Graphikkommandos ........................ 33 +6.6.1 Draw's und Move's ......................... 33 +6.6.1.1 Punkt setzen ............................ 34 +6.6.1.2 Move-Befehle ............................ 34 +6.6.1.3 Draw-Befehle ............................ 35 +6.6.1.4 Turtle-Graphik .......................... 35 +6.6.2 Komplexere Zeichenkommandos ............... 36 +6.6.2.1 Kreise und Kreissegmente ................ 36 +6.6.2.2 Rechtecke ............................... 37 +6.6.2.3 Bgen und Ellipsen ...................... 38 +6.6.2.4 Gefllte Flchen ........................ 39 +6.6.2.4.1 Definition des Musters ................ 40 +6.7 Graphikdaten zum Host ....................... 40 +6.7.1 Graphikseiten zum Host .................... 40 +6.7.2 Cursorposition zum Host ................... 41 +6.7.3 Einzelne Bits zum Host .................... 41 +6.7.4 Parameter zum Host ........................ 42 +6.8 Graphikhardcopy ............................. 43 +6.8.1 Der Druckertreiber ........................ 43 +6.8.2 Die Hardcopyparameter ..................... 44 +7. Die Parameter der seriellen Schnittstelle .... 46 +7.1 Das bertragungsformat ...................... 46 +7.2 Die bertragungsparameter ................... 46 +7.2.1 Baudrate .................................. 47 +7.2.2 Datenbits ................................. 47 +7.2.3 Stopbits .................................. 48 +7.2.4 Parittsbit ............................... 48 +7.2.5 bertragungsfehler ........................ 48 +7.3 Die Flukontrolle ........................... 48 +7.3.1 XON/XOFF .................................. 49 +7.3.2 DTR/DSR ................................... 50 +7.3.3 RTS/CTS ................................... 50 +7.4 Echo und Local/Online ....................... 51 +8. Spezielle Kommandos im Textmodus ............. 52 +8.1 Weitere Cursorpositionierungskommandos ...... 52 +8.2 Cursormodus ................................. 53 +8.3 Zeichensatz einstellen ...................... 53 +8.4 Texthardcopy ................................ 54 +8.5 Zeichen-Attribute ........................... 54 +8.6 Bildhintergrund hell/dunkel ................. 55 +8.7 Zeichentransfer zum Host .................... 55 +8.7.1 Ein Zeichen senden ........................ 55 +8.7.2 Eine Zeile senden ......................... 56 +8.7.3 Eine Seite senden ......................... 56 +8.7.4 Terminatorzeichen definieren .............. 56 +8.7.5 Cursorposition senden ..................... 57 +8.8 Textseite auf Diskette speichern/laden ...... 57 +9. Verschiedene Steuerkommandos ................. 58 +9.1 Signalton ................................... 58 +9.2 Keyboardclick ............................... 58 +9.3 Bildschirmausgabe/Druckerausgabe ............ 58 +9.4 Scroll/Page-Modus ........................... 59 +9.5 Belegung der Funktionstasten ................ 59 +9.5.1 Local-Escape .............................. 60 +9.5.2 Makrokommandos ............................ 60 +9.5.3 Startup-Makro ............................. 61 +9.6 Tabellen und Puffer lschen ................. 62 +9.7 Zeitverzgerung ............................. 62 +9.8 Transparentmodi ............................. 62 +9.8.1 Monitor-Modus ............................. 62 +9.8.2 Hexadezimal-Modus ......................... 63 +9.8.3 Einzelne Control-Zeichen anzeigen ......... 63 +Anhang A - ASCII Tabelle, Zeichenstze, Parameter. 64 +Anhang B - Befehlsbersicht ...................... 70 +Anhang C - Default Funktionstastenbelegungen ..... 74 +Stichwortverzeichnis ............................. 75 diff --git a/system/ruc-terminal/unknown/doc/TINHALTP.PRT b/system/ruc-terminal/unknown/doc/TINHALTP.PRT new file mode 100644 index 0000000..a41bbc1 --- /dev/null +++ b/system/ruc-terminal/unknown/doc/TINHALTP.PRT @@ -0,0 +1,157 @@ +#type ("elite")##limit (16.2)# +#page##--------------------------------- Ende der Seite 0 -----------# +#center##on("b")# Inhalt #off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +#type("8")##center##on("i")##on("u")##ib(3)# Inhalt #ie(3)##off("u")##off("i")##type("elite")# + +1. Einige Worte zuvor ........................... 1 +2. Die Hardware ................................. 2 +2.1 Die serielle Schnittstelle .................. 2 +2.2 Der Reset ................................... 2 +3. Die Kommandozeile ............................ 3 +3.1 Tastenfunktionen in der Kommandozeile ....... 3 +3.2 Setup ....................................... 4 +3.3 Die zweite Kommandozeile .................... 4 +3.4 Die zweite Kommandozeile .................... 6 +4. Die Statuszeile .............................. 8 +4.1 Spoolerstatus ............................... 8 +4.2 Empfngerstatus ............................. 8 +4.3 Senderstatus ................................ 9 +4.4 Busy - Anzeige .............................. 9 +4.5 Online/Local - Anzeige ...................... 9 +5. Die Bedeutung der Tasten ..................... 10 +5.1 Die Funktions- und Steuertasten ............. 10 +5.2 Die TVI-Emulation ........................... 13 +6. Der Graphikmodus ............................. 16 +6.1 Allgemeines ................................. 16 +6.2 Koordinaten und Parameterbergabe ........... 16 +6.2.1 Cursorposition/Fadenkreuz ................. 16 +6.2.2 Binre oder dezimale Parameter ............ 17 +6.2.2.1 Binre Parameter ........................ 17 +6.2.2.2 Dezimale Parameter ...................... 17 +6.2.3 Absolute oder relative Koordinaten ........ 18 +6.2.4 Byteparameter ............................. 18 +6.3 Die Graphikparameter ........................ 19 +6.3.1 Strichdicke ............................... 19 +6.3.2 Farbe/Helligkeit .......................... 19 +6.3.3 Linientyp ................................. 20 +6.3.3.1 Selbstdefinierte Linientypen (Pattern) .. 20 +6.3.4 Bitverknpfungen .......................... 21 +6.3.5 Multiparametereinstellung ................. 22 +6.4 Graphikseiten ............................... 22 +6.4.1 Die sichtbare Seite und die Arbeitsseite .. 22 +6.4.1.1 80-Zeichen Text und Graphik ............. 23 +6.4.2 Aufbau einer Graphikseite ................. 23 +6.4.3 Operationen auf den Graphikseiten ......... 24 +6.4.4 Laden einer Graphikseite vom Host ......... 25 +6.4.5 Graphik auf Diskette speichern/laden ...... 26 +6.5 Textdarstellung im Graphikmodus ............. 26 +6.5.1 Zeichendarstellung ........................ 27 +6.5.1.1 Zeichengre und Schreibrichtung ........ 27 +6.5.1.2 Dicke, Farbe etc. ....................... 28 +6.5.1.3 Zeichenstze und Attribute .............. 28 +6.5.1.4 Zeichen berschreiben ................... 29 +6.5.2 Textkommandos im Graphikmodus ............. 30 +6.5.2.1 Die Cursorpositionierung ................ 30 +6.5.2.2 Lschbefehle ............................ 33 +#text end# +#free(02.351852e-2)# + + + i +#page##--------------------------------- Ende der Seite 1 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +6.6 Die Graphikkommandos ........................ 33 +6.6.1 Draw's und Move's ......................... 33 +6.6.1.1 Punkt setzen ............................ 34 +6.6.1.2 Move-Befehle ............................ 34 +6.6.1.3 Draw-Befehle ............................ 35 +6.6.1.4 Turtle-Graphik .......................... 35 +6.6.2 Komplexere Zeichenkommandos ............... 36 +6.6.2.1 Kreise und Kreissegmente ................ 36 +6.6.2.2 Rechtecke ............................... 37 +6.6.2.3 Bgen und Ellipsen ...................... 38 +6.6.2.4 Gefllte Flchen ........................ 39 +6.6.2.4.1 Definition des Musters ................ 40 +6.7 Graphikdaten zum Host ....................... 40 +6.7.1 Graphikseiten zum Host .................... 40 +6.7.2 Cursorposition zum Host ................... 41 +6.7.3 Einzelne Bits zum Host .................... 41 +6.7.4 Parameter zum Host ........................ 42 +6.8 Graphikhardcopy ............................. 43 +6.8.1 Der Druckertreiber ........................ 43 +6.8.2 Die Hardcopyparameter ..................... 44 +7. Die Parameter der seriellen Schnittstelle .... 46 +7.1 Das bertragungsformat ...................... 46 +7.2 Die bertragungsparameter ................... 46 +7.2.1 Baudrate .................................. 47 +7.2.2 Datenbits ................................. 47 +7.2.3 Stopbits .................................. 48 +7.2.4 Parittsbit ............................... 48 +7.2.5 bertragungsfehler ........................ 48 +7.3 Die Flukontrolle ........................... 48 +7.3.1 XON/XOFF .................................. 49 +7.3.2 DTR/DSR ................................... 50 +7.3.3 RTS/CTS ................................... 50 +7.4 Echo und Local/Online ....................... 51 +8. Spezielle Kommandos im Textmodus ............. 52 +8.1 Weitere Cursorpositionierungskommandos ...... 52 +8.2 Cursormodus ................................. 53 +8.3 Zeichensatz einstellen ...................... 53 +8.4 Texthardcopy ................................ 54 +8.5 Zeichen-Attribute ........................... 54 +8.6 Bildhintergrund hell/dunkel ................. 55 +8.7 Zeichentransfer zum Host .................... 55 +8.7.1 Ein Zeichen senden ........................ 55 +8.7.2 Eine Zeile senden ......................... 56 +8.7.3 Eine Seite senden ......................... 56 +8.7.4 Terminatorzeichen definieren .............. 56 +8.7.5 Cursorposition senden ..................... 57 +8.8 Textseite auf Diskette speichern/laden ...... 57 +9. Verschiedene Steuerkommandos ................. 58 +9.1 Signalton ................................... 58 +9.2 Keyboardclick ............................... 58 +9.3 Bildschirmausgabe/Druckerausgabe ............ 58 +9.4 Scroll/Page-Modus ........................... 59 +#text end# +#free(02.351852e-2)# + + +#right#ii +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 2 -----------# +#center##on("b")# Inhalt #off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +9.5 Belegung der Funktionstasten ................ 59 +9.5.1 Local-Escape .............................. 60 +9.5.2 Makrokommandos ............................ 60 +9.5.3 Startup-Makro ............................. 61 +9.6 Tabellen und Puffer lschen ................. 62 +9.7 Zeitverzgerung ............................. 62 +9.8 Transparentmodi ............................. 62 +9.8.1 Monitor-Modus ............................. 62 +9.8.2 Hexadezimal-Modus ......................... 63 +9.8.3 Einzelne Control-Zeichen anzeigen ......... 63 +Anhang A - ASCII Tabelle, Zeichenstze, Parameter. 64 +Anhang B - Befehlsbersicht ...................... 70 +Anhang C - Default Funktionstastenbelegungen ..... 74 +Stichwortverzeichnis ............................. 75 +#text end# +#free(16.11019)# + + + iii +#page##--------------------------------- Ende der Seite 3 -----------# diff --git a/system/ruc-terminal/unknown/doc/TSTICHP.PRT b/system/ruc-terminal/unknown/doc/TSTICHP.PRT new file mode 100644 index 0000000..4f2a3e8 --- /dev/null +++ b/system/ruc-terminal/unknown/doc/TSTICHP.PRT @@ -0,0 +1,211 @@ +#type ("elite")##limit (16.2)# +#pagenr (""224"", 75)# +#page##--------------------------------- Ende der Seite 0 -----------# +#center##on("b")# Stichwortverzeichnis #off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +#type("8")##center##on("i")##on("u")##ib(3)# Stichwortverzeichnis #ie(3)##off("u")##off("i")##type("elite")# + + ...................................... 14 + ..................................... 32 + .................................... 32 + ............................................. 16 + ............................................. 31 + ......................................... 58 + ...................................... 32 + ......................................... 14 + ......................................... 14 + ......................................... 49 + ......................................... 49 + ................................... 14 + ................................... 14 + ......................................... 31 + ......................................... 16 + ......................................... 14 + ......................................... 33 + ......................................... 49 + ......................................... 49 + ......................................... 32 + ........................................... 31 + ! .......................................... 24 + $ .......................................... 16 + % .......................................... 16 + & .......................................... 29 + ' .......................................... 29 + ( .......................................... 29 + ( .......................................... 54 + ) .......................................... 29 + ) .......................................... 55 + * .......................................... 33 + + .......................................... 33 + , .......................................... 33 + - .......................................... 41 + . .......................................... 53 + ............................................ 32 + / .......................................... 25 + 0 .......................................... 2 + 4 .......................................... 42 + 5 .......................................... 42 + 6 .......................................... 56 + 7 .......................................... 56 + 7 .......................................... 56 + 8 .......................................... 55 + 9 .......................................... 62 + : .......................................... 33 + ; .......................................... 41 + < .......................................... 58 + ...................................... 62 + ................................ 61 +#text end# +#free(02.351852e-2)# + + + 75 +#page##--------------------------------- Ende der Seite 75 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# + .................................... 50 + 0 .................................. 10 + 1 .................................. 13 + 6 .................................. 47 + 7 .................................. 47 + ............................ 46 + = .......................................... 52 + = .......................................... 57 + > .......................................... 58 + ? .......................................... 57 + @ .......................................... 58 + A .......................................... 59 + D E ........................................ 51 + D L ........................................ 51 + D O ........................................ 51 + E .......................................... 14 + E .......................................... 52 + F .......................................... 63 + G .......................................... 29 + G .......................................... 54 + H .......................................... 59 + I .......................................... 14 + I .......................................... 52 + J .......................................... 38 + K .......................................... 37 + L .......................................... 52 + M .......................................... 52 + N .......................................... 27 + N .......................................... 30 + O 0 ........................................ 19 + O 0 ........................................ 28 + O 1 ........................................ 19 + O 2 ........................................ 19 + O 3 ........................................ 20 + O 4 ........................................ 21 + O 5 ........................................ 22 + O 5 ........................................ 43 + O 6 ........................................ 20 + O 7 ........................................ 22 + O 7 ........................................ 42 + O 7 ........................................ 44 + O 8 ........................................ 36 + O 9 ........................................ 36 + O : ........................................ 40 + P .......................................... 54 + Q .......................................... 14 + Q .......................................... 52 + R .......................................... 14 + R .......................................... 52 + S .......................................... 26 + S .......................................... 57 + T .......................................... 33 +#text end# +#free(02.351852e-2)# + + +#right#76 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 76 -----------# +#center##on("b")# Stichwortverzeichnis #off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# + U .......................................... 62 + W .......................................... 14 + W .......................................... 52 + X .......................................... 63 + X .......................................... 63 + Y .......................................... 33 + Z .......................................... 53 + \ .......................................... 40 + ^ .......................................... 44 + _ .......................................... 41 + ` .......................................... 58 + a .......................................... 58 + b .......................................... 55 + c .......................................... 60 + d .......................................... 55 + e .......................................... 13 + e .......................................... 60 + e .......................................... 61 + j .......................................... 52 + m .......................................... 34 + n .......................................... 35 + o .......................................... 36 + q .......................................... 34 + r .......................................... 35 + s .......................................... 38 + u .......................................... 63 + u .......................................... 63 + u .......................................... 63 + v .......................................... 34 + w .......................................... 35 + x 1 ........................................ 56 + x 4 ........................................ 56 + y .......................................... 33 + z .......................................... 28 + z .......................................... 53 + { .......................................... 8 + | .......................................... 39 + } .......................................... 8 + ~ .......................................... 43 + ........................................... 32 + ........................................... 32 + ............................................. 14 + ......................................... 60 + ......................................... 31 + .......................................... 32 + ....................................... 31 + ................................ 32 + ................................ 51 + ..................................... 32 + ................................... 31 + ............................................ 31 + ............................................. 31 +#text end# +#free(02.351852e-2)# + + + 77 +#page##--------------------------------- Ende der Seite 77 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +XOFF ............................................. 49 +XON .............................................. 49 +#text end# +#free(21.19019)# + + +#right#78 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 78 -----------# diff --git a/system/ruc-terminal/unknown/doc/TSTICHWO.PRT b/system/ruc-terminal/unknown/doc/TSTICHWO.PRT new file mode 100644 index 0000000..ac6f011 --- /dev/null +++ b/system/ruc-terminal/unknown/doc/TSTICHWO.PRT @@ -0,0 +1,161 @@ +#type ("elite")##limit (16.2)# +#pagenr (""224"", 75)##page (75)# +#kopf ("Bedienungshandbuch zum ruc - Graphikterminal")# +#h("", "Stichwortverzeichnis ")# + + ...................................... 14 + ..................................... 32 + .................................... 32 + ............................................. 16 + ............................................. 31 + ......................................... 58 + ...................................... 32 + ......................................... 14 + ......................................... 14 + ......................................... 49 + ......................................... 49 + ................................... 14 + ................................... 14 + ......................................... 31 + ......................................... 16 + ......................................... 14 + ......................................... 33 + ......................................... 49 + ......................................... 49 + ......................................... 32 + ........................................... 31 + ! .......................................... 24 + $ .......................................... 16 + % .......................................... 16 + & .......................................... 29 + ' .......................................... 29 + ( .......................................... 29 + ( .......................................... 54 + ) .......................................... 29 + ) .......................................... 55 + * .......................................... 33 + + .......................................... 33 + , .......................................... 33 + - .......................................... 41 + . .......................................... 53 + ............................................ 32 + / .......................................... 25 + 0 .......................................... 2 + 4 .......................................... 42 + 5 .......................................... 42 + 6 .......................................... 56 + 7 .......................................... 56 + 7 .......................................... 56 + 8 .......................................... 55 + 9 .......................................... 62 + : .......................................... 33 + ; .......................................... 41 + < .......................................... 58 + ...................................... 62 + ................................ 61 + .................................... 50 + 0 .................................. 10 + 1 .................................. 13 + 6 .................................. 47 + 7 .................................. 47 + ............................ 46 + = .......................................... 52 + = .......................................... 57 + > .......................................... 58 + ? .......................................... 57 + @ .......................................... 58 + A .......................................... 59 + D E ........................................ 51 + D L ........................................ 51 + D O ........................................ 51 + E .......................................... 14 + E .......................................... 52 + F .......................................... 63 + G .......................................... 29 + G .......................................... 54 + H .......................................... 59 + I .......................................... 14 + I .......................................... 52 + J .......................................... 38 + K .......................................... 37 + L .......................................... 52 + M .......................................... 52 + N .......................................... 27 + N .......................................... 30 + O 0 ........................................ 19 + O 0 ........................................ 28 + O 1 ........................................ 19 + O 2 ........................................ 19 + O 3 ........................................ 20 + O 4 ........................................ 21 + O 5 ........................................ 22 + O 5 ........................................ 43 + O 6 ........................................ 20 + O 7 ........................................ 22 + O 7 ........................................ 42 + O 7 ........................................ 44 + O 8 ........................................ 36 + O 9 ........................................ 36 + O : ........................................ 40 + P .......................................... 54 + Q .......................................... 14 + Q .......................................... 52 + R .......................................... 14 + R .......................................... 52 + S .......................................... 26 + S .......................................... 57 + T .......................................... 33 + U .......................................... 62 + W .......................................... 14 + W .......................................... 52 + X .......................................... 63 + X .......................................... 63 + Y .......................................... 33 + Z .......................................... 53 + \ .......................................... 40 + ^ .......................................... 44 + _ .......................................... 41 + ` .......................................... 58 + a .......................................... 58 + b .......................................... 55 + c .......................................... 60 + d .......................................... 55 + e .......................................... 13 + e .......................................... 60 + e .......................................... 61 + j .......................................... 52 + m .......................................... 34 + n .......................................... 35 + o .......................................... 36 + q .......................................... 34 + r .......................................... 35 + s .......................................... 38 + u .......................................... 63 + u .......................................... 63 + u .......................................... 63 + v .......................................... 34 + w .......................................... 35 + x 1 ........................................ 56 + x 4 ........................................ 56 + y .......................................... 33 + z .......................................... 28 + z .......................................... 53 + { .......................................... 8 + | .......................................... 39 + } .......................................... 8 + ~ .......................................... 43 + ........................................... 32 + ........................................... 32 + ............................................. 14 + ......................................... 60 + ......................................... 31 + .......................................... 32 + ....................................... 31 + ................................ 32 + ................................ 51 + ..................................... 32 + ................................... 31 + ............................................ 31 + ............................................. 31 +XOFF ............................................. 49 +XON .............................................. 49 diff --git a/system/ruc-terminal/unknown/doc/TTAB.PRT b/system/ruc-terminal/unknown/doc/TTAB.PRT new file mode 100644 index 0000000..5fdab0d --- /dev/null +++ b/system/ruc-terminal/unknown/doc/TTAB.PRT @@ -0,0 +1,510 @@ +#type ("elite")##limit (16.2)# +#pagenr (""224"", 64)##type ("elite")# +#page (64)# +#kopf ("Bedienungshandbuch zum ruc - Graphikterminal")# +#h("A.", "Anhang A - ASCII Tabelle, Zeichenstze, Parameter")# + + + Winkel Cur- Byteparameter +Dez Hex ASCII Grad sor 4 5 6 Taste(n) Graphikzeichen +#linie ("16.0")# + 0 00 NUL 0 0 0 0 + 1 01 SOH 5 1 1 1 + 2 02 STX 10 2 2 2 + 3 03 ETX 15 3 3 3 + 4 04 EOT 20 4 4 4 + 5 05 ENQ 25 5 5 5 + 6 06 ACK 30 6 6 6 + 7 07 BEL 35 7 7 7 + 8 08 BS 40 8 8 8 <== + 9 09 HT 45 9 9 9 + 10 0A LF 50 10 10 10 Apple: + 11 0B VT 55 11 11 11 Apple: + 12 0C FF 60 12 12 12 TVI: + 13 0D CR 65 13 13 13 + 14 0E SO 70 14 14 14 + 15 0F SI 75 15 15 15 + 16 10 DLE 80 0 16 16 + 17 11 DC1 XON 85 1 17 17 + 18 12 DC2 90 2 18 18 + 19 13 DC3 XOFF 95 3 19 19 + 20 14 DC4 100 4 20 20 + 21 15 NAK 105 5 21 21 ==> Apple: + 22 16 SYN 110 6 22 22 + 23 17 ETB 115 7 23 23 + 24 18 CAN 120 8 24 24 + 25 19 EM 125 9 25 25 + 26 1A SUB 130 10 26 26 TVI: + 27 1B ESC 135 11 27 27 + 28 1C FS 140 12 28 28 + 29 1D GS 145 13 29 29 + 30 1E RS 150 14 30 30 TVI: + 31 1F US 155 15 31 31 TVI: + 32 20 SPACE 160 0 0 0 32 + 33 21 ! 165 1 1 1 33 ! + 34 22 " 170 2 2 2 34 " + 35 23 # 175 3 3 3 35 # + 36 24 $ 180 4 4 4 36 $ + 37 25 % 185 5 5 5 37 % + 38 26 & 190 6 6 6 38 & + 39 27 ' 195 7 7 7 39 ' + 40 28 ( 200 8 8 8 40 ( + 41 29 ) 205 9 9 9 41 ) + 42 2A * 210 10 10 10 42 * + 43 2B + 215 11 11 11 43 + + 44 2C , 220 12 12 12 44 , + 45 2D - 225 13 13 13 45 - + 46 2E . 230 14 14 14 46 . + 47 2F / 235 15 15 15 47 / + 48 30 0 240 16 0 16 48 0 + 49 31 1 245 17 1 17 49 1 + 50 32 2 250 18 2 18 50 2 + 51 33 3 255 19 3 19 51 3 + 52 34 4 260 20 4 20 52 4 + 53 35 5 265 21 5 21 53 5 + 54 36 6 270 22 6 22 54 6 + 55 37 7 275 23 7 23 55 7 + 56 38 8 280 24 8 24 56 8 + 57 39 9 285 25 9 25 57 9 + 58 3A : 290 26 10 26 58 : + 59 3B ; 295 27 11 27 59 ; + 60 3C < 300 28 12 28 60 < + 61 3D = 305 29 13 29 61 = + 62 3E > 310 30 14 30 62 > + 63 3F ? 315 31 15 31 63 ? + 64 40 @ 320 32 0 0 0 @ + 65 41 A 325 33 1 1 1 A + 66 42 B 330 34 2 2 2 B + 67 43 C 335 35 3 3 3 C + 68 44 D 340 36 4 4 4 D + 69 45 E 345 37 5 5 5 E + 70 46 F 350 38 6 6 6 F + 71 47 G 355 39 7 7 7 G + 72 48 H 0 40 8 8 8 H + 73 49 I 5 41 9 9 9 I + 74 4A J 10 42 10 10 10 J + 75 4B K 15 43 11 11 11 K + 76 4C L 20 44 12 12 12 L + 77 4D M 25 45 13 13 13 M + 78 4E N 30 46 14 14 14 N + 79 4F O 35 47 15 15 15 O + 80 50 P 40 48 0 16 16 P + 81 51 Q 45 49 1 17 17 Q + 82 52 R 50 50 2 18 18 R + 83 53 S 55 51 3 19 19 S + 84 54 T 60 52 4 20 20 T + 85 55 U 65 53 5 21 21 U + 86 56 V 70 54 6 22 22 V + 87 57 W 75 55 7 23 23 W + 88 58 X 80 56 8 24 24 X + 89 59 Y 85 57 9 25 25 Y + 90 5A Z 90 58 10 26 26 Z + 91 5B [ 95 59 11 27 27 [ + 92 5C \ 100 60 12 28 28 \ + 93 5D ] 105 61 13 29 29 ] + 94 5E ^ 110 62 14 30 30 ^ + 95 5F _ 115 63 15 31 31 _ + 96 60 ` 120 64 0 0 32 ` + 97 61 a 125 65 1 1 33 a + 98 62 b 130 66 2 2 34 b + 99 63 c 135 67 3 3 35 c +100 64 d 140 68 4 4 36 d +101 65 e 145 69 5 5 37 e +102 66 f 150 70 6 6 38 f +103 67 g 155 71 7 7 39 g +104 68 h 160 72 8 8 40 h +105 69 i 165 73 9 9 41 i +106 6A j 170 74 10 10 42 j +107 6B k 175 75 11 11 43 k +108 6C l 180 76 12 12 44 l +109 6D m 185 77 13 13 45 m +110 6E n 190 78 14 14 46 n +111 6F o 195 79 15 15 47 o +112 70 p 200 0 16 48 p +113 71 q 205 1 17 49 q +114 72 r 210 2 18 50 r +115 73 s 215 3 19 51 s +116 74 t 220 4 20 52 t +117 75 u 225 5 21 53 u +118 76 v 230 6 22 54 v +119 77 w 235 7 23 55 w +120 78 x 240 8 24 56 x +121 79 y 245 9 25 57 y +122 7A z 250 10 26 58 z +123 7B { 255 11 27 59 { +124 7C | 260 12 28 60 | +125 7D } 265 13 29 61 } +126 7E ~ 270 14 30 62 ~ +127 7F DEL 275 15 31 63 +128 80 * NUL 280 0 0 0 +129 81 * SOH 285 1 1 1 +130 82 * STX 290 2 2 2 # +131 83 * ETX 295 3 3 3 # +132 84 * EOT 300 4 4 4 +133 85 * ENQ 305 5 5 5 +134 86 * ACK 310 6 6 6 +135 87 * BEL 315 7 7 7 +136 88 * BS 320 8 8 8 # +137 89 * HT 325 9 9 9 # +138 8A * LF 330 10 10 10 # +139 8B * VT 335 11 11 11 # +140 8C * FF 340 12 12 12 +141 8D * CR 345 13 13 13 # +142 8E * SO 350 14 14 14 # +143 8F * SI 355 15 15 15 # +144 90 * DLE 0 0 16 16 +145 91 * DC1 5 1 17 17 +146 92 * DC2 10 2 18 18 +147 93 * DC3 15 3 19 19 +148 94 * DC4 20 4 20 20 +149 95 * NAK 25 5 21 21 # +150 96 * SYN 30 6 22 22 +151 97 * ETB 35 7 23 23 +152 98 * CAN 40 8 24 24 +153 99 * EM 45 9 25 25 +154 9A * SUB 50 10 26 26 +155 9B * ESC 55 11 27 27 +156 9C * FS 60 12 28 28 +157 9D * GS 65 13 29 29 +158 9E * RS 70 14 30 30 +159 9F * US 75 15 31 31 +160 A0 * SPACE 80 0 0 32 +161 A1 * ! 85 1 1 33 +162 A2 * " 90 2 2 34 +163 A3 * # 95 3 3 35 +164 A4 * $ 100 4 4 36 +165 A5 * % 105 5 5 37 +166 A6 * & 110 6 6 38 +167 A7 * ' 115 7 7 39 +168 A8 * ( 120 8 8 40 +169 A9 * ) 125 9 9 41 +170 AA * * 130 10 10 42 +171 AB * + 135 11 11 43 +172 AC * , 140 12 12 44 +173 AD * - 145 13 13 45 +174 AE * . 150 14 14 46 +175 AF * / 155 15 15 47 +176 B0 * 0 160 0 16 48 +177 B1 * 1 165 1 17 49 +178 B2 * 2 170 2 18 50 +179 B3 * 3 175 3 19 51 +180 B4 * 4 180 4 20 52 +181 B5 * 5 185 5 21 53 +182 B6 * 6 190 6 22 54 +183 B7 * 7 195 7 23 55 +184 B8 * 8 200 8 24 56 +185 B9 * 9 205 9 25 57 +186 BA * : 210 10 26 58 +187 BB * ; 215 11 27 59 +188 BC * < 220 12 28 60 +189 BD * = 225 13 29 61 +190 BE * > 230 14 30 62 +191 BF * ? 235 15 31 63 +192 C0 * @ 240 0 0 0 +193 C1 * A 245 1 1 1 # +194 C2 * B 250 2 2 2 # +195 C3 * C 255 3 3 3 # +196 C4 * D 260 4 4 4 # +197 C5 * E 265 5 5 5 # +198 C6 * F 270 6 6 6 # +199 C7 * G 275 7 7 7 # +200 C8 * H 280 8 8 8 # +201 C9 * I 285 9 9 9 # +202 CA * J 290 10 10 10 # +203 CB * K 295 11 11 11 # +204 CC * L 300 12 12 12 # +205 CD * M 305 13 13 13 # +206 CE * N 310 14 14 14 # +207 CF * O 315 15 15 15 # +208 D0 * P 320 0 16 16 # +209 D1 * Q 325 1 17 17 # +210 D2 * R 330 2 18 18 # +211 D3 * S 335 3 19 19 # +212 D4 * T 340 4 20 20 # +213 D5 * U 345 5 21 21 # +214 D6 * V 350 6 22 22 # +215 D7 * W 355 7 23 23 # +216 D8 * X 0 8 24 24 # +217 D9 * Y 5 9 25 25 # +218 DA * Z 10 10 26 26 # +219 DB * [ * 15 11 27 27 # +220 DC * \ * 20 12 28 28 # +221 DD * ] * 25 13 29 29 # +222 DE * ^ 30 14 30 30 # +223 DF * _ 35 15 31 31 # +224 E0 * ` 40 0 0 32 +225 E1 * a 45 1 1 33 # +226 E2 * b 50 2 2 34 # +227 E3 * c 55 3 3 35 # +228 E4 * d 60 4 4 36 # +229 E5 * e 65 5 5 37 # +230 E6 * f 70 6 6 38 # +231 E7 * g 75 7 7 39 # +232 E8 * h 80 8 8 40 # +233 E9 * i 85 9 9 41 # +234 EA * j 90 10 10 42 # +235 EB * k 95 11 11 43 # +236 EC * l 100 12 12 44 # +237 ED * m 105 13 13 45 # +238 EE * n 110 14 14 46 +239 EF * o 115 15 15 47 # +240 F0 * p 120 0 16 48 +241 F1 * q 125 1 17 49 +242 F2 * r 130 2 18 50 +243 F3 * s 135 3 19 51 +244 F4 * t 140 4 20 52 +245 F5 * u 145 5 21 53 +246 F6 * v 150 6 22 54 +247 F7 * w 155 7 23 55 +248 F8 * x 160 8 24 56 +249 F9 * y 165 9 25 57 +250 FA * z 170 10 26 58 +251 FB * { * 175 11 27 59 +252 FC * | * 180 12 28 60 +253 FD * } * 185 13 29 61 +254 FE * ~ * 190 14 30 62 +255 FF * DEL 195 15 31 63 + +Beim Apple-Keyboard knnen alle Codes > 127 auch mit der Open-Apple Taste +und einem ASCII-Zeichen zusammen erzeugt werden. +Die mit # gekennzeichneten Tasten erzeugen im TVI-Modus nicht diesen Code. +Die mit * gekennzeichneten ASCII-Zeichen werden auf dem Bildschirm invers +dargestellt. + +#page# +#h("B.", "Anhang B - Befehlsbersicht")# + + +#on("u")#Controlkommandos:#off("u")# + +Hex ASCII Taste(n) Funktion +#linie ("16.0")# +07 BEL Signalton +08 BS <== Backspace, Cursor Left +09 HT Tabulator, 8 Spalten +0A LF Apple: Zeilenvorschub, ggf. Scroll/Page +0B VT Apple: Cursor hoch +0C FF TVI: Cursor rechts +0D CR Waagenrcklauf, ohne Linefeed +0E SO XON/XOFF Protokoll ausschalten +0F SI XON/XOFF Protokoll einschalten +11 DC1 XON +13 DC3 XOFF +15 NAK ==> Apple: Cursor rechts +16 SYN Cursor runter (ohne Scroll/Page) +17 CAN Graphikmodus: Fadenkreuz an/aus +1A SUB TVI: Bildschirm lschen & Cursor Home +1B ESC Escape-Sequenz einleiten +1E RS TVI: Cursor Home +1F US TVI: Zum nchsten Zeilenanfang, ggf. + Scroll/Page + + +Escape-Sequenzen, thematisch sortiert +------------------------------------- + +a.) Betriebsmodi: + +ESC $ Graphikmodus einschalten +ESC % Textmodus einschalten +ESC H Autoscroll/Pagemode +ESC U Monitormode einschalten +ESC X Monitormode/Hexmode ausschalten +ESC c Funktionstastencode/Funktionstastenstring +ESC u Hexmode ein-/ausschalten, Monitormode ausschalten + + +b.) Editkommandos + +ESC * Text oder Graphikbildschirm lschen und Cursor Home +ESC + " +ESC , " +ESC : " +ESC E Zeile einfgen (im Textmodus) +ESC I Rckwrtstabulator (8 Spalten, im Textmodus) +ESC L Zeile einfgen (im Textmodus) +ESC M Zeile lschen (im Textmodus) +ESC Q Zeichen einfgen (im Textmodus) +ESC R Zeile lschen (im Textmodus) +ESC T Zeile ab Cursorposition bis zum Zeilenende lschen +ESC W Zeichen lschen (im Textmodus) +ESC Y Seite ab Cursorposition bis zum Seitenende lschen +ESC j Umgekehrter Zeilenvorschub +ESC t Zeile ab Cursor bis Zeilenende lschen (im Textmodus) + + +c.) Sendekommandos + +ESC - Farbe, Zustand, In-Window-Bit bei Cursorpos senden +ESC 4 Nummer der sichtbaren und der Arbeitsseite senden +ESC 5 Graphikparameter (Dicke,Farbe,Bitverknpfung) senden +ESC 6 Aktuelle Textzeile senden +ESC 7 Ganze Textseite senden +ESC 8 Zeichen an der Cursorposition senden +ESC \ Aktuelle Graphikseite senden (oder Teile) +ESC ; Position des Graphikcursors senden +ESC ? Position des Textcursors senden +ESC _ Graphikbyte bei Graphikcursorposition senden +ESC x 1 Zeilenbegrenzer fr 6 und 7 einstellen +ESC x 4

Seitenbegrenzer fr 7 einstellen + + +d.) bertragungskommandos + +ESC SPACE SPACE

Baudrate, Stopbits, Datenbits, Parity einstellen +ESC SPACE 0 Basis/Apple Keyboardcodes, keine Emulation +ESC SPACE 1 TVI - Emulation +ESC SPACE 2 Keine Hardware Flukontrolle +ESC SPACE 3 RTS/CTS Flukontrolle +ESC SPACE 4 DTR/DSR Flukontrolle +ESC SPACE 5 RTS/CTS und DTR/DSR Flukontrolle +ESC SPACE 6 8. Datenbit ist 0 +ESC SPACE 7 8. Datenbit vorhanden +ESC D L Local-Modus +ESC D E Online-Modus mit Echo +ESC D O Online-Modus ohne Echo + + +e.) Bildschirm/Druckerausgabe + +ESC @ Empfangsdaten auf Drucker ausgeben +ESC A Empfangsdaten nicht auf Drucker ausgeben +ESC P Hardcopy der Textseite +ESC ^

Hardcopy der aktuellen Graphikseite +ESC ` Empfangsdaten nicht auf dem Bildschirm anzeigen +ESC a Empfangsdaten auf dem Bildschirm anzeigen +ESC ~ Definition d.Druckertreiberstrings f.Graphikhardcopy + + +f.) Cursor/Cursor Adressierung + +ESC . 0 Cursor aus +ESC . 1 Cursor blinkend +ESC . 2 Cursor an, nicht blinkend +ESC = Cursor auf Adresse positionieren +ESC Z Cursor an/aus + + +g.) Attribute + +ESC ( Normale Zeichen +ESC ) Textmodus: Inversschrift, Graphik: Kursivschrift +ESC G 0 Normale Schrift +ESC G 1 Unsichtbare Schrift, Leerzeichen +ESC G 4 Inverse Schrift +ESC G 5 Unsichtbare Schrift, inverse Leerzeichen +ESC b Schwarze Schrift auf hellem Grund (nur im Textmodus) +ESC d Helle Schrift auf dunklem Grund, (nur im Textmodus) +ESC z Zeichensatz einstellen + + +h.) Text in Graphiken + +ESC & Graphikzeichen ersetzen darunterliegende +ESC ' Graphikzeichen berschreiben darunterliegende +ESC N Zeichenbreite, -hhe und Schreibrichtung einstellen + + +i.) Graphikzeichenkommandos + +ESC J Relatives Rechteck zeichnen +ESC K Kreis(segmente) mit dem Radius zeichnen +ESC m Absoluten Punkt bei (x, y) zeichnen +ESC n Turtle Draw/Move ist Lnge, ist Winkel +ESC o Turtle Penup/Pendown +ESC q Relativer Move +ESC r Relativer Draw +ESC s Ellipsenbogen(Radien xr,yr) v. bis zeichnen +ESC v Absoluter Move nach (x, y) +ESC w Absoluter Draw nach (x, y) + + +j.) Verschiede Graphikkommandos + +ESC !

Graphikseiten mischen, kopieren, trennen, invertieren +ESC / Graphikseite vom Host laden +ESC O 0 Graphikparameter auf Default +ESC O 1 Strichdicke setzen +ESC O 2 Farbe/Helligkeit einstellen +ESC O 3

Linientyp (Punkt/Strichmuster) einstellen +ESC O 4

Bitverknpfung setzen (0=OR, 1=AND, 2=XOR, 3=COPY) +ESC O 5

Farbe, Dicke, Bitverknpfung zusammen einstellen +ESC O 6 Benutzerdefinierbares Linienmuster einstellen +ESC O 7

Arbeitsseite, sichtbare Seite u.Mixedmode einstellen +ESC O 8

Turtle Penup/Pendown und Eraser/Drawer einstellen +ESC O 9 Turtle Bildmitte, Richtung nach oben, Pendown, Drawer +ESC O : Benutzerdefinierbares Fllmuster einstellen +ESC y Graphikseite lschen und Cursor nach (0, 0) +ESC | Flche fllen/lschen mit dem Muster Nummer + + +k.) Verschiedene und spezielle Funktionen + +ESC 0 Terminalprogramm initialisieren (Softwarereset) +ESC 9 Zeitverzgerung ca. * 2 ms +ESC < Keyboardclick ausschalten +ESC > Keyboardclick einschalten +ESC F Controlcharacter darstellen +ESC e Funktionstaste mit Daten belegen +ESC { Statuszeile aus (24. Textzeile sichtbar) +ESC } Statuszeile an (24. Textzeile unsichtbar) +ESC S Graphik/Textseite von/auf Diskette laden/speichern +ESC DEL 1 Tastenbelegungen lschen +ESC DEL 2 Druckerpuffer lschen +ESC DEL 3 Empfangspuffer lschen +ESC DEL 4 Sendepuffer lschen + +#page# +#h("C.", "Anhang C - Default Funktionstastenbelegungen")# + + +Bemerkung zur Schreibweise: +<#40> bezeichnet den ASCII-Code fr '(', also den ASCII-Code 40 (dezimal). + bezeichnet den Code Hex 9B fr Local Escape, damit diese Tastenfunk- +tionen sowohl im Local- als auch im Onlinemodus ausgefhrt werden knnen. + +a.) Zehnerblock mit + +Die Anordnung der Zifferntasten entspricht einem "Cursorblock" mit acht +Richtungen. Die Taste zeigt nur das Fadenkreuz, d.h. die Position +des Graphikcursors bleibt unverndert. Bei allen anderen Zifferntasten n- +dert sich die Position des Graphikcursors und das Fadenkreuz wird kurz +sichtbar. Bis auf die Help-Taste knnen alle Tasten auch im On- +line-Modus aufgerufen werden. + +Die Tastenbelegungen im einzelnen: + +Taste Hex-Code Code-Sequenz +#linie ("16.0")# + E1 q-1,-1; 9 <#40> + E2 q0,-1; 9 <#40> + E3 q1,-1; 9 <#40> + E4 q-1,0; 9 <#40> + E5 9 <#127> + E6 q1,0; 9 <#40> + E7 q-1,1; 9 <#40> + E8 q0,1; 9 <#40> + E9 q1,1; 9 <#40> + +Terminalinitialisierung mit : + EF (Cursorpositionierung und Einschaltmeldung) + + +b.) Die Funktionstasten mit + +Taste Hex-Code Code-Sequenz Bedeutung +#linie ("16.0")# + D1 $ O70 Graphikseite 1 + D2 $ O73 Graphikseite 2 + D3 % Textseite + D4 SW<#26> H e l p s c r e e n (a..f): S<#81> + 9<#81> SG Help-Bilschirm anzeigen + D8 O41 Linien schwarz (lschen) + D9 O40 Linien wei (sichtbar) + DA O12 N <#12><#20><#0> Groe und dicke Schrift + DB O11 N <#0><#0><#0> Normal dnne Schrift + DC G4 Kursiv/Invers an + DD G0 Kursiv/Invers aus + DE ^0 Graphikhardcopy + DF P Texthardcopy + diff --git a/system/ruc-terminal/unknown/doc/TTABP.PRT b/system/ruc-terminal/unknown/doc/TTABP.PRT new file mode 100644 index 0000000..b562709 --- /dev/null +++ b/system/ruc-terminal/unknown/doc/TTABP.PRT @@ -0,0 +1,666 @@ +#type ("elite")##limit (16.2)# +#pagenr (""224"", 64)##type ("elite")# +#page##--------------------------------- Ende der Seite 0 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +#type("8")##center##on("i")##on("u")##ib(3)#A. Anhang A - ASCII Tabelle, Zeichenstze, Parameter#ie(3)##off("u")##off("i")##type("elite")# + + + Winkel Cur- Byteparameter +Dez Hex ASCII Grad sor 4 5 6 Taste(n) Graphikzeichen +#rpos(16.0)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# +#clearpos# + 0 00 NUL 0 0 0 0 + 1 01 SOH 5 1 1 1 + 2 02 STX 10 2 2 2 + 3 03 ETX 15 3 3 3 + 4 04 EOT 20 4 4 4 + 5 05 ENQ 25 5 5 5 + 6 06 ACK 30 6 6 6 + 7 07 BEL 35 7 7 7 + 8 08 BS 40 8 8 8 <== + 9 09 HT 45 9 9 9 + 10 0A LF 50 10 10 10 Apple: + 11 0B VT 55 11 11 11 Apple: + 12 0C FF 60 12 12 12 TVI: + 13 0D CR 65 13 13 13 + 14 0E SO 70 14 14 14 + 15 0F SI 75 15 15 15 + 16 10 DLE 80 0 16 16 + 17 11 DC1 XON 85 1 17 17 + 18 12 DC2 90 2 18 18 + 19 13 DC3 XOFF 95 3 19 19 + 20 14 DC4 100 4 20 20 + 21 15 NAK 105 5 21 21 ==> Apple: + 22 16 SYN 110 6 22 22 + 23 17 ETB 115 7 23 23 + 24 18 CAN 120 8 24 24 + 25 19 EM 125 9 25 25 + 26 1A SUB 130 10 26 26 TVI: + 27 1B ESC 135 11 27 27 + 28 1C FS 140 12 28 28 + 29 1D GS 145 13 29 29 + 30 1E RS 150 14 30 30 TVI: + 31 1F US 155 15 31 31 TVI: + 32 20 SPACE 160 0 0 0 32 + 33 21 ! 165 1 1 1 33 ! + 34 22 " 170 2 2 2 34 " + 35 23 # 175 3 3 3 35 # + 36 24 $ 180 4 4 4 36 $ + 37 25 % 185 5 5 5 37 % + 38 26 & 190 6 6 6 38 & + 39 27 ' 195 7 7 7 39 ' + 40 28 ( 200 8 8 8 40 ( + 41 29 ) 205 9 9 9 41 ) + 42 2A * 210 10 10 10 42 * + 43 2B + 215 11 11 11 43 + + 44 2C , 220 12 12 12 44 , + 45 2D - 225 13 13 13 45 - +#text end# +#free(02.351852e-2)# + + +#right#64 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 64 -----------# +#center##on("b")#A. Anhang A - ASCII Tabelle, Zeichenstze, Parameter#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# + 46 2E . 230 14 14 14 46 . + 47 2F / 235 15 15 15 47 / + 48 30 0 240 16 0 16 48 0 + 49 31 1 245 17 1 17 49 1 + 50 32 2 250 18 2 18 50 2 + 51 33 3 255 19 3 19 51 3 + 52 34 4 260 20 4 20 52 4 + 53 35 5 265 21 5 21 53 5 + 54 36 6 270 22 6 22 54 6 + 55 37 7 275 23 7 23 55 7 + 56 38 8 280 24 8 24 56 8 + 57 39 9 285 25 9 25 57 9 + 58 3A : 290 26 10 26 58 : + 59 3B ; 295 27 11 27 59 ; + 60 3C < 300 28 12 28 60 < + 61 3D = 305 29 13 29 61 = + 62 3E > 310 30 14 30 62 > + 63 3F ? 315 31 15 31 63 ? + 64 40 @ 320 32 0 0 0 @ + 65 41 A 325 33 1 1 1 A + 66 42 B 330 34 2 2 2 B + 67 43 C 335 35 3 3 3 C + 68 44 D 340 36 4 4 4 D + 69 45 E 345 37 5 5 5 E + 70 46 F 350 38 6 6 6 F + 71 47 G 355 39 7 7 7 G + 72 48 H 0 40 8 8 8 H + 73 49 I 5 41 9 9 9 I + 74 4A J 10 42 10 10 10 J + 75 4B K 15 43 11 11 11 K + 76 4C L 20 44 12 12 12 L + 77 4D M 25 45 13 13 13 M + 78 4E N 30 46 14 14 14 N + 79 4F O 35 47 15 15 15 O + 80 50 P 40 48 0 16 16 P + 81 51 Q 45 49 1 17 17 Q + 82 52 R 50 50 2 18 18 R + 83 53 S 55 51 3 19 19 S + 84 54 T 60 52 4 20 20 T + 85 55 U 65 53 5 21 21 U + 86 56 V 70 54 6 22 22 V + 87 57 W 75 55 7 23 23 W + 88 58 X 80 56 8 24 24 X + 89 59 Y 85 57 9 25 25 Y + 90 5A Z 90 58 10 26 26 Z + 91 5B [ 95 59 11 27 27 [ + 92 5C \ 100 60 12 28 28 \ + 93 5D ] 105 61 13 29 29 ] + 94 5E ^ 110 62 14 30 30 ^ + 95 5F _ 115 63 15 31 31 _ + 96 60 ` 120 64 0 0 32 ` + 97 61 a 125 65 1 1 33 a +#text end# +#free(02.351852e-2)# + + + 65 +#page##--------------------------------- Ende der Seite 65 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# + 98 62 b 130 66 2 2 34 b + 99 63 c 135 67 3 3 35 c +100 64 d 140 68 4 4 36 d +101 65 e 145 69 5 5 37 e +102 66 f 150 70 6 6 38 f +103 67 g 155 71 7 7 39 g +104 68 h 160 72 8 8 40 h +105 69 i 165 73 9 9 41 i +106 6A j 170 74 10 10 42 j +107 6B k 175 75 11 11 43 k +108 6C l 180 76 12 12 44 l +109 6D m 185 77 13 13 45 m +110 6E n 190 78 14 14 46 n +111 6F o 195 79 15 15 47 o +112 70 p 200 0 16 48 p +113 71 q 205 1 17 49 q +114 72 r 210 2 18 50 r +115 73 s 215 3 19 51 s +116 74 t 220 4 20 52 t +117 75 u 225 5 21 53 u +118 76 v 230 6 22 54 v +119 77 w 235 7 23 55 w +120 78 x 240 8 24 56 x +121 79 y 245 9 25 57 y +122 7A z 250 10 26 58 z +123 7B { 255 11 27 59 { +124 7C | 260 12 28 60 | +125 7D } 265 13 29 61 } +126 7E ~ 270 14 30 62 ~ +127 7F DEL 275 15 31 63 +128 80 * NUL 280 0 0 0 +129 81 * SOH 285 1 1 1 +130 82 * STX 290 2 2 2 # +131 83 * ETX 295 3 3 3 # +132 84 * EOT 300 4 4 4 +133 85 * ENQ 305 5 5 5 +134 86 * ACK 310 6 6 6 +135 87 * BEL 315 7 7 7 +136 88 * BS 320 8 8 8 # +137 89 * HT 325 9 9 9 # +138 8A * LF 330 10 10 10 # +139 8B * VT 335 11 11 11 # +140 8C * FF 340 12 12 12 +141 8D * CR 345 13 13 13 # +142 8E * SO 350 14 14 14 # +143 8F * SI 355 15 15 15 # +144 90 * DLE 0 0 16 16 +145 91 * DC1 5 1 17 17 +146 92 * DC2 10 2 18 18 +147 93 * DC3 15 3 19 19 +148 94 * DC4 20 4 20 20 +149 95 * NAK 25 5 21 21 # +#text end# +#free(02.351852e-2)# + + +#right#66 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 66 -----------# +#center##on("b")#A. Anhang A - ASCII Tabelle, Zeichenstze, Parameter#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +150 96 * SYN 30 6 22 22 +151 97 * ETB 35 7 23 23 +152 98 * CAN 40 8 24 24 +153 99 * EM 45 9 25 25 +154 9A * SUB 50 10 26 26 +155 9B * ESC 55 11 27 27 +156 9C * FS 60 12 28 28 +157 9D * GS 65 13 29 29 +158 9E * RS 70 14 30 30 +159 9F * US 75 15 31 31 +160 A0 * SPACE 80 0 0 32 +161 A1 * ! 85 1 1 33 +162 A2 * " 90 2 2 34 +163 A3 * # 95 3 3 35 +164 A4 * $ 100 4 4 36 +165 A5 * % 105 5 5 37 +166 A6 * & 110 6 6 38 +167 A7 * ' 115 7 7 39 +168 A8 * ( 120 8 8 40 +169 A9 * ) 125 9 9 41 +170 AA * * 130 10 10 42 +171 AB * + 135 11 11 43 +172 AC * , 140 12 12 44 +173 AD * - 145 13 13 45 +174 AE * . 150 14 14 46 +175 AF * / 155 15 15 47 +176 B0 * 0 160 0 16 48 +177 B1 * 1 165 1 17 49 +178 B2 * 2 170 2 18 50 +179 B3 * 3 175 3 19 51 +180 B4 * 4 180 4 20 52 +181 B5 * 5 185 5 21 53 +182 B6 * 6 190 6 22 54 +183 B7 * 7 195 7 23 55 +184 B8 * 8 200 8 24 56 +185 B9 * 9 205 9 25 57 +186 BA * : 210 10 26 58 +187 BB * ; 215 11 27 59 +188 BC * < 220 12 28 60 +189 BD * = 225 13 29 61 +190 BE * > 230 14 30 62 +191 BF * ? 235 15 31 63 +192 C0 * @ 240 0 0 0 +193 C1 * A 245 1 1 1 # +194 C2 * B 250 2 2 2 # +195 C3 * C 255 3 3 3 # +196 C4 * D 260 4 4 4 # +197 C5 * E 265 5 5 5 # +198 C6 * F 270 6 6 6 # +199 C7 * G 275 7 7 7 # +200 C8 * H 280 8 8 8 # +201 C9 * I 285 9 9 9 # +#text end# +#free(02.351852e-2)# + + + 67 +#page##--------------------------------- Ende der Seite 67 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +202 CA * J 290 10 10 10 # +203 CB * K 295 11 11 11 # +204 CC * L 300 12 12 12 # +205 CD * M 305 13 13 13 # +206 CE * N 310 14 14 14 # +207 CF * O 315 15 15 15 # +208 D0 * P 320 0 16 16 # +209 D1 * Q 325 1 17 17 # +210 D2 * R 330 2 18 18 # +211 D3 * S 335 3 19 19 # +212 D4 * T 340 4 20 20 # +213 D5 * U 345 5 21 21 # +214 D6 * V 350 6 22 22 # +215 D7 * W 355 7 23 23 # +216 D8 * X 0 8 24 24 # +217 D9 * Y 5 9 25 25 # +218 DA * Z 10 10 26 26 # +219 DB * [ * 15 11 27 27 # +220 DC * \ * 20 12 28 28 # +221 DD * ] * 25 13 29 29 # +222 DE * ^ 30 14 30 30 # +223 DF * _ 35 15 31 31 # +224 E0 * ` 40 0 0 32 +225 E1 * a 45 1 1 33 # +226 E2 * b 50 2 2 34 # +227 E3 * c 55 3 3 35 # +228 E4 * d 60 4 4 36 # +229 E5 * e 65 5 5 37 # +230 E6 * f 70 6 6 38 # +231 E7 * g 75 7 7 39 # +232 E8 * h 80 8 8 40 # +233 E9 * i 85 9 9 41 # +234 EA * j 90 10 10 42 # +235 EB * k 95 11 11 43 # +236 EC * l 100 12 12 44 # +237 ED * m 105 13 13 45 # +238 EE * n 110 14 14 46 +239 EF * o 115 15 15 47 # +240 F0 * p 120 0 16 48 +241 F1 * q 125 1 17 49 +242 F2 * r 130 2 18 50 +243 F3 * s 135 3 19 51 +244 F4 * t 140 4 20 52 +245 F5 * u 145 5 21 53 +246 F6 * v 150 6 22 54 +247 F7 * w 155 7 23 55 +248 F8 * x 160 8 24 56 +249 F9 * y 165 9 25 57 +250 FA * z 170 10 26 58 +251 FB * { * 175 11 27 59 +252 FC * | * 180 12 28 60 +253 FD * } * 185 13 29 61 +#text end# +#free(02.351852e-2)# + + +#right#68 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 68 -----------# +#center##on("b")#A. Anhang A - ASCII Tabelle, Zeichenstze, Parameter#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +254 FE * ~ * 190 14 30 62 +255 FF * DEL 195 15 31 63 + +Beim Apple-Keyboard knnen alle Codes > 127 auch mit der Open-Apple Taste +und einem ASCII-Zeichen zusammen erzeugt werden. +Die mit # gekennzeichneten Tasten erzeugen im TVI-Modus nicht diesen Code. +Die mit * gekennzeichneten ASCII-Zeichen werden auf dem Bildschirm invers +dargestellt. + +#text end# +#free(18.22685)# + + + 69 +#page##--------------------------------- Ende der Seite 69 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +#type("8")##center##on("i")##on("u")##ib(3)#B. Anhang B - Befehlsbersicht#ie(3)##off("u")##off("i")##type("elite")# + + +#on("u")#Controlkommandos:#off("u")# + +Hex ASCII Taste(n) Funktion +#rpos(16.0)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# +#clearpos# +07 BEL Signalton +08 BS <== Backspace, Cursor Left +09 HT Tabulator, 8 Spalten +0A LF Apple: Zeilenvorschub, ggf. Scroll/Page +0B VT Apple: Cursor hoch +0C FF TVI: Cursor rechts +0D CR Waagenrcklauf, ohne Linefeed +0E SO XON/XOFF Protokoll ausschalten +0F SI XON/XOFF Protokoll einschalten +11 DC1 XON +13 DC3 XOFF +15 NAK ==> Apple: Cursor rechts +16 SYN Cursor runter (ohne Scroll/Page) +17 CAN Graphikmodus: Fadenkreuz an/aus +1A SUB TVI: Bildschirm lschen & Cursor Home +1B ESC Escape-Sequenz einleiten +1E RS TVI: Cursor Home +1F US TVI: Zum nchsten Zeilenanfang, ggf. + Scroll/Page + + +Escape-Sequenzen, thematisch sortiert +------------------------------------- + +a.) Betriebsmodi: + +ESC $ Graphikmodus einschalten +ESC % Textmodus einschalten +ESC H Autoscroll/Pagemode +ESC U Monitormode einschalten +ESC X Monitormode/Hexmode ausschalten +ESC c Funktionstastencode/Funktionstastenstring +ESC u Hexmode ein-/ausschalten, Monitormode ausschalten + + +#text end# +#free(4.256852)# + + +#right#70 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 70 -----------# +#center##on("b")#B. Anhang B - Befehlsbersicht#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +b.) Editkommandos + +ESC * Text oder Graphikbildschirm lschen und Cursor Home +ESC + " +ESC , " +ESC : " +ESC E Zeile einfgen (im Textmodus) +ESC I Rckwrtstabulator (8 Spalten, im Textmodus) +ESC L Zeile einfgen (im Textmodus) +ESC M Zeile lschen (im Textmodus) +ESC Q Zeichen einfgen (im Textmodus) +ESC R Zeile lschen (im Textmodus) +ESC T Zeile ab Cursorposition bis zum Zeilenende lschen +ESC W Zeichen lschen (im Textmodus) +ESC Y Seite ab Cursorposition bis zum Seitenende lschen +ESC j Umgekehrter Zeilenvorschub +ESC t Zeile ab Cursor bis Zeilenende lschen (im Textmodus) + + +c.) Sendekommandos + +ESC - Farbe, Zustand, In-Window-Bit bei Cursorpos senden +ESC 4 Nummer der sichtbaren und der Arbeitsseite senden +ESC 5 Graphikparameter (Dicke,Farbe,Bitverknpfung) senden +ESC 6 Aktuelle Textzeile senden +ESC 7 Ganze Textseite senden +ESC 8 Zeichen an der Cursorposition senden +ESC \ Aktuelle Graphikseite senden (oder Teile) +ESC ; Position des Graphikcursors senden +ESC ? Position des Textcursors senden +ESC _ Graphikbyte bei Graphikcursorposition senden +ESC x 1 Zeilenbegrenzer fr 6 und 7 einstellen +ESC x 4

Seitenbegrenzer fr 7 einstellen + + +d.) bertragungskommandos + +ESC SPACE SPACE

Baudrate, Stopbits, Datenbits, Parity einstellen +ESC SPACE 0 Basis/Apple Keyboardcodes, keine Emulation +ESC SPACE 1 TVI - Emulation +ESC SPACE 2 Keine Hardware Flukontrolle +ESC SPACE 3 RTS/CTS Flukontrolle +ESC SPACE 4 DTR/DSR Flukontrolle +ESC SPACE 5 RTS/CTS und DTR/DSR Flukontrolle +ESC SPACE 6 8. Datenbit ist 0 +ESC SPACE 7 8. Datenbit vorhanden +ESC D L Local-Modus +ESC D E Online-Modus mit Echo +ESC D O Online-Modus ohne Echo + + +#text end# +#free(04.468519e-1)# + + + 71 +#page##--------------------------------- Ende der Seite 71 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +e.) Bildschirm/Druckerausgabe + +ESC @ Empfangsdaten auf Drucker ausgeben +ESC A Empfangsdaten nicht auf Drucker ausgeben +ESC P Hardcopy der Textseite +ESC ^

Hardcopy der aktuellen Graphikseite +ESC ` Empfangsdaten nicht auf dem Bildschirm anzeigen +ESC a Empfangsdaten auf dem Bildschirm anzeigen +ESC ~ Definition d.Druckertreiberstrings f.Graphikhardcopy + + +f.) Cursor/Cursor Adressierung + +ESC . 0 Cursor aus +ESC . 1 Cursor blinkend +ESC . 2 Cursor an, nicht blinkend +ESC = Cursor auf Adresse positionieren +ESC Z Cursor an/aus + + +g.) Attribute + +ESC ( Normale Zeichen +ESC ) Textmodus: Inversschrift, Graphik: Kursivschrift +ESC G 0 Normale Schrift +ESC G 1 Unsichtbare Schrift, Leerzeichen +ESC G 4 Inverse Schrift +ESC G 5 Unsichtbare Schrift, inverse Leerzeichen +ESC b Schwarze Schrift auf hellem Grund (nur im Textmodus) +ESC d Helle Schrift auf dunklem Grund, (nur im Textmodus) +ESC z Zeichensatz einstellen + + +h.) Text in Graphiken + +ESC & Graphikzeichen ersetzen darunterliegende +ESC ' Graphikzeichen berschreiben darunterliegende +ESC N Zeichenbreite, -hhe und Schreibrichtung einstellen + + +i.) Graphikzeichenkommandos + +ESC J Relatives Rechteck zeichnen +ESC K Kreis(segmente) mit dem Radius zeichnen +ESC m Absoluten Punkt bei (x, y) zeichnen +ESC n Turtle Draw/Move ist Lnge, ist Winkel +ESC o Turtle Penup/Pendown +ESC q Relativer Move +ESC r Relativer Draw +ESC s Ellipsenbogen(Radien xr,yr) v. bis zeichnen +ESC v Absoluter Move nach (x, y) +ESC w Absoluter Draw nach (x, y) +#text end# +#free(02.351852e-2)# + + +#right#72 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 72 -----------# +#center##on("b")#B. Anhang B - Befehlsbersicht#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +j.) Verschiede Graphikkommandos + +ESC !

Graphikseiten mischen, kopieren, trennen, invertieren +ESC / Graphikseite vom Host laden +ESC O 0 Graphikparameter auf Default +ESC O 1 Strichdicke setzen +ESC O 2 Farbe/Helligkeit einstellen +ESC O 3

Linientyp (Punkt/Strichmuster) einstellen +ESC O 4

Bitverknpfung setzen (0=OR, 1=AND, 2=XOR, 3=COPY) +ESC O 5

Farbe, Dicke, Bitverknpfung zusammen einstellen +ESC O 6 Benutzerdefinierbares Linienmuster einstellen +ESC O 7

Arbeitsseite, sichtbare Seite u.Mixedmode einstellen +ESC O 8

Turtle Penup/Pendown und Eraser/Drawer einstellen +ESC O 9 Turtle Bildmitte, Richtung nach oben, Pendown, Drawer +ESC O : Benutzerdefinierbares Fllmuster einstellen +ESC y Graphikseite lschen und Cursor nach (0, 0) +ESC | Flche fllen/lschen mit dem Muster Nummer + + +k.) Verschiedene und spezielle Funktionen + +ESC 0 Terminalprogramm initialisieren (Softwarereset) +ESC 9 Zeitverzgerung ca. * 2 ms +ESC < Keyboardclick ausschalten +ESC > Keyboardclick einschalten +ESC F Controlcharacter darstellen +ESC e Funktionstaste mit Daten belegen +ESC { Statuszeile aus (24. Textzeile sichtbar) +ESC } Statuszeile an (24. Textzeile unsichtbar) +ESC S Graphik/Textseite von/auf Diskette laden/speichern +ESC DEL 1 Tastenbelegungen lschen +ESC DEL 2 Druckerpuffer lschen +ESC DEL 3 Empfangspuffer lschen +ESC DEL 4 Sendepuffer lschen + +#text end# +#free(7.220185)# + + + 73 +#page##--------------------------------- Ende der Seite 73 -----------# +#center##on("b")#Bedienungshandbuch zum ruc - Graphikterminal#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +#type("8")##center##on("i")##on("u")##ib(3)#C. Anhang C - Default Funktionstastenbelegungen#ie(3)##off("u")##off("i")##type("elite")# + + +Bemerkung zur Schreibweise: +<#40> bezeichnet den ASCII-Code fr '(', also den ASCII-Code 40 (dezimal). + bezeichnet den Code Hex 9B fr Local Escape, damit diese Tastenfunk- +tionen sowohl im Local- als auch im Onlinemodus ausgefhrt werden knnen. + +a.) Zehnerblock mit + +Die Anordnung der Zifferntasten entspricht einem "Cursorblock" mit acht +Richtungen. Die Taste zeigt nur das Fadenkreuz, d.h. die Position +des Graphikcursors bleibt unverndert. Bei allen anderen Zifferntasten n- +dert sich die Position des Graphikcursors und das Fadenkreuz wird kurz +sichtbar. Bis auf die Help-Taste knnen alle Tasten auch im On- +line-Modus aufgerufen werden. + +Die Tastenbelegungen im einzelnen: + +Taste Hex-Code Code-Sequenz +#rpos(16.0)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# +#clearpos# + E1 q-1,-1; 9 <#40> + E2 q0,-1; 9 <#40> + E3 q1,-1; 9 <#40> + E4 q-1,0; 9 <#40> + E5 9 <#127> + E6 q1,0; 9 <#40> + E7 q-1,1; 9 <#40> + E8 q0,1; 9 <#40> + E9 q1,1; 9 <#40> + +Terminalinitialisierung mit : + EF (Cursorpositionierung und Einschaltmeldung) + + +b.) Die Funktionstasten mit + +Taste Hex-Code Code-Sequenz Bedeutung +#rpos(16.0)##fillchar(" ")##table# +#on("u")# #off("u")# +#table end# +#clearpos# + D1 $ O70 Graphikseite 1 + D2 $ O73 Graphikseite 2 + D3 % Textseite + D4 SW<#26> H e l p s c r e e n (a..f): S<#81> + 9<#81> SG Help-Bilschirm anzeigen + D8 O41 Linien schwarz (lschen) + D9 O40 Linien wei (sichtbar) + DA O12 N <#12><#20><#0> Groe und dicke Schrift + DB O11 N <#0><#0><#0> Normal dnne Schrift + DC G4 Kursiv/Invers an + DD G0 Kursiv/Invers aus + DE ^0 Graphikhardcopy + DF P Texthardcopy +#text end# +#free(02.351852e-2)# + + +#right#74 +#type("elite")##limit(16.2)##linefeed(01.0)# +#page##--------------------------------- Ende der Seite 74 -----------# +#center##on("b")#C. Anhang C - Default Funktionstastenbelegungen#off("b")# + + + +#type("elite")##limit(16.2)##linefeed(01.0)# +#text begin# +#text end# +#free(22.03685)# + + + 75 +#page##--------------------------------- Ende der Seite 75 -----------# diff --git a/system/ruc-terminal/unknown/src/SCCPARAM.ELA b/system/ruc-terminal/unknown/src/SCCPARAM.ELA new file mode 100644 index 0000000..2a6ab19 --- /dev/null +++ b/system/ruc-terminal/unknown/src/SCCPARAM.ELA @@ -0,0 +1,144 @@ +(* Uebertragungsparameter fuer Kanal 2 und 3 (SCC) setzen *) +(* Vers. 1.2 : 'setup'-Prozedur / 03.02.86, M.Staubermann *) + +PACKET scc DEFINES baudrate, + setup , + + channel a, + channel b, + no parity, + even parity, + odd parity, + + read port, + write port, + register, + quartz : + +BOOL CONSTchannel a :: TRUE , + channel b :: FALSE ; +INT CONST no parity :: 0, + even parity :: 3, + odd parity :: 1; + +REAL VAR clk frequency := 12288000.0 ; (* Oszillatorfrequenz *) +LET offset = 0 ; + +PROC quartz (REAL CONST wert) : + clk frequency := wert +ENDPROC quartz ; + +REAL PROC quartz : + clk frequency +ENDPROC quartz ; + +PROC setup (BOOL CONST channel, INT CONST parity, + REAL CONST stopbits, INT CONST bits, + BOOL CONST dtr, rts, auto dtr, auto cts) : + +(* Parameter mssen zusammen gesetzt werden, da die Register keine + Read-Register sind. Alte Werte mssen ausserhalb des SCC's gespeichert + werden. *) + + INT VAR value := 64 ; + value INCR parity value ; + value INCR stopbit value ; + + register (channel, 3, 0) ; + register (channel, 5, 32 * bits value) ; + register (channel,14, 2) ; + + register (channel, 4, value) ; + register (channel, 5, 8 + dtr value + rts value + 32 * bits value) ; + register (channel,14, 3 + auto dtr value) ; + register (channel, 3, 1 + 64 * bits value + auto cts value) . + +bits value : + IF bits <= 5 THEN 0 + ELIF bits >= 8 THEN 3 + ELIF bits = 6 THEN 2 + ELSE 1 + FI . + +parity value : + IF parity >= 0 AND parity <= 3 THEN parity ELSE 0 FI . + +stopbit value : + IF stopbits = 1.0 THEN 4 + ELIF stopbits = 1.5 THEN 8 + ELIF stopbits = 2.0 THEN 12 + ELSE 4 + FI . + +dtr value : + IF dtr THEN 128 ELSE 0 FI . + +rts value : + IF rts THEN 2 ELSE 0 FI . + +auto cts value : + IF auto cts THEN 32 ELSE 0 FI . + +auto dtr value : + IF auto dtr THEN 4 ELSE 0 FI . + +ENDPROC setup ; + +PROC baudrate (BOOL CONST channel, REAL CONST rate) : + INT CONST time constant :: int (clk frequency / (64.0 * rate) + 0.5) - 2 ; + register (channel, 13, time constant DIV 256) ; + register (channel, 12, time constant AND 255) +ENDPROC baudrate ; + +REAL PROC baudrate (BOOL CONST channel) : + INT CONST time constant :: + register (channel, 12) + 256 * register (channel, 13) ; + round (clk frequency / (real (time constant + 2) * 64.0), 1) +ENDPROC baudrate ; + + +(*********************************************************************) +(********* S C C - Z u g r i f f s p r o z e d u r e n ********) +(*********************************************************************) + + +INT PROC read port (INT CONST port) : + INT VAR value ; + control (-1, offset + port, -1, value) ; + IF value = -1 THEN errorstop ("SCC - Read failed") ; 0 + ELSE value +FI . + +ENDPROC read port ; + +PROC write port (INT CONST port, value) : + INT VAR rcode, my channel := channel ; + continue (32) ; + control (-1, offset + port, value, r code) ; + continue (my channel) ; + IF r code = -1 THEN errorstop ("SCC - Write failed") FI +ENDPROC write port ; + +INT PROC register (BOOL CONST is channel a, INT CONST register x) : + INT VAR value ; + IF is channel a + THEN write port (1, registerx) ; + read port (1) + ELSE write port (0, registerx) ; + read port (0) + FI +ENDPROC register ; + + +PROC register (BOOL CONST is channel a, INT CONST register x, wert): + IF is channel a + THEN write port (1, register x) ; + write port (1, wert) + ELSE write port (0, register x) ; + write port (0, wert) + FI +ENDPROC register ; + +ENDPACKET scc ; + + diff --git a/system/ruc-terminal/unknown/src/SETUP.ELA b/system/ruc-terminal/unknown/src/SETUP.ELA new file mode 100644 index 0000000..3e2f3e7 --- /dev/null +++ b/system/ruc-terminal/unknown/src/SETUP.ELA @@ -0,0 +1,257 @@ +PACKET setup DEFINES setup : (* 02.03.86, M.Staubermann *) + +LET separator = "|" , + old option mark = " " , (* ""16"" , *) + choice mark = ""15"" , + end mark = ""14"" , + left = ""8"" , + right = ""2"" , + bottom = ""6""21""0"" , + clr line = ""13""5"" , + home = ""1"" ; + +PROC selektor (TEXT CONST options, INT VAR option number,BOOL CONST warten) : + TEXT VAR zeichen ; + INT VAR i , + last separator pos , + new separator pos := 0 , + old option := option number , + max options := 0 ; + REP + new separator pos := pos (options, separator, new separator pos +1) ; + max options INCR 1 + UNTIL new separator pos = 0 PER ; + out (""13"") ; + REP + i := 0 ; + last separator pos := 0 ; + REP + i INCR 1 ; + new separator pos := pos (options, separator, last separator pos + 1) ; + IF new separator pos = 0 + THEN new separator pos := LENGTH options + 1 + FI ; + IF i = option number + THEN out (choice mark) + ELIF i = old option + THEN out (old option mark) + ELSE out (end mark) + FI ; + out subtext (options, last separator pos + 1, new separator pos - 1) ; + out (end mark) ; + last separator pos := new separator pos + UNTIL last separator pos = LENGTH options + 1 PER ; + out (""13"") ; + IF warten + THEN inchar (zeichen) ; + IF zeichen = ""27"" + THEN option number := old option + ELIF zeichen = left AND option number = 1 + THEN option number := max options + ELIF zeichen = left + THEN option number DECR 1 + ELIF zeichen = right AND option number = max options + THEN option number := 1 + ELIF zeichen = right + THEN option number INCR 1 + FI + ELSE zeichen := ""13"" + FI + UNTIL zeichen = ""13"" OR zeichen = ""27"" PER +ENDPROC selektor ; + +LET std datenbits = 4 , (* 8 *) + std stopbits = 1 , (* 1.0 *) + std flowmode = 1 , (* xon/xoff *) + std parity = 1 , (* no parity *) + std fixed = 4 , (* RTS ON, DTR ON *) + + setup text = "Ende|Kanal|Baudrate|Datenbits|Stopbits|Parity|Flukontrolle", + ende text = "ndern|Abbruch" , + kanal text = "2|3" , + datenbits text= "5|6|7|8" , + stopbits text = "1.0|1.5|2.0" , + parity text = "no|even|odd" , + fixed text = "DTR OFF/RTS OFF|DTR OFF/RTS ON|DTR ON/RTS OFF|DTR ON/RTS ON" , + flowmode text = "xon/xoff|dtr|rts/cts|dtr/rts/cts|fixed" ; + +INT VAR old session := 0 ; +ROW 2 INT VAR datenbits, stopbits, parity, flowmode , fixed ; +ROW 2 REAL VAR baudrates ; + +PROC init params : + datenbits := ROW 2 INT:(std datenbits , std datenbits) ; + stopbits := ROW 2 INT:(std stopbits , std stopbits) ; + parity := ROW 2 INT:(std parity , std parity) ; + flowmode := ROW 2 INT:(std flowmode , std flowmode) ; + fixed := ROW 2 INT:(std fixed, std fixed) ; + baudrates := ROW 2REAL:(baudrate (channelb), baudrate (channela)) ; +ENDPROC init params ; + +PROC setup : + INT VAR kanal := aktueller kanal , + setup choice := 1 ; + BOOL VAR x dtr, x rts, x auto dtr, x cts ; + page ; + init setup (kanal, setup choice) ; + select setup choice ; + cursor (1, 19) ; + setup choice := 2 ; + selektor (ende text, setup choice, TRUE) ; + out (bottom) ; + IF setup choice = 1 + THEN kanal := 1 ; + x flowmode ; + setup (kanal bool, x parity, x stopbits, x datenbits, + x dtr, x rts, x auto dtr, x cts) ; + baudrate (kanal bool, baudrates (kanal)) ; + kanal := 2 ; + x flowmode ; + setup (kanal bool, x parity, x stopbits, x datenbits, + x dtr, x rts, x auto dtr, x cts) ; + baudrate (kanal bool, baudrates (kanal)) + FI . + +x flowmode : + x dtr := FALSE ; + x rts := FALSE ; + SELECT flowmode (kanal) OF + CASE 1 : x auto dtr := FALSE ; (* XON/XOFF *) + x cts := FALSE + CASE 2 : x auto dtr := TRUE ; (* DTR *) + x cts := FALSE + CASE 3 : x auto dtr := FALSE ; (* RTS/CTS *) + x cts := TRUE + CASE 4 : x auto dtr := TRUE ; (* RTS/CTS/DTR *) + x cts := TRUE + CASE 5 : x auto dtr := FALSE ; (* fixed *) + x cts := FALSE ; + SELECT fixed (kanal) OF + CASE 1 : x dtr := FALSE ; (* wie XON/XOFF *) + x rts := FALSE + CASE 2 : x dtr := FALSE ; (* RTS=1 *) + x rts := TRUE + CASE 3 : x dtr := TRUE ; (* DTR=1 *) + x rts := FALSE + CASE 4 : x dtr := TRUE ; (* RTS=1,DTR=1 *) + x rts := TRUE + ENDSELECT +ENDSELECT. + +x parity : + SELECT parity (kanal) OF + CASE 2 : even parity + CASE 3 : odd parity + OTHERWISE no parity + ENDSELECT. + +x stopbits : + SELECT stopbits (kanal) OF + CASE 2 : 1.5 + CASE 3 : 2.0 + OTHERWISE 1.0 + ENDSELECT. + +x datenbits : + datenbits (kanal) + 4. + +select setup choice : + REP + cursor (1, 5) ; + selektor (setup text, setup choice, TRUE) ; + SELECT setup choice OF + CASE 1 : LEAVE select setup choice + CASE 2 : select kanal choice + CASE 3 : select baudrate choice + CASE 4 : select datenbits choice + CASE 5 : select stopbits choice + CASE 6 : select parity choice + CASE 7 : select flowmode choice + ENDSELECT + PER . + +select kanal choice : + INT VAR save kanal := kanal ; + cursor (1, 7) ; + selektor (kanal text, kanal, TRUE) ; + init setup (kanal, setup choice) . + +select baudrate choice : + cursor (1, 9) ; + TEXT VAR t := text (baudrates (kanal)) + " " ; + out (" ") ; + editget (t) ; + baudrates (kanal) := real (t) . + +select datenbits choice : + cursor (1, 11) ; + selektor (datenbits text, datenbits (kanal), TRUE) . + +select stopbits choice : + cursor (1, 13) ; + selektor (stopbits text, stopbits (kanal), TRUE) . + +select parity choice : + cursor (1, 15) ; + selektor (parity text, parity (kanal), TRUE). + +select flowmode choice : + cursor (1, 17) ; + selektor (flowmode text, flowmode (kanal), TRUE) ; + IF flowmode (kanal) = 5 + THEN cursor (1, 19) ; + selektor (fixed text, fixed (kanal), TRUE) ; + out (clr line) + FI . + +aktueller kanal : + IF channel = 2 THEN 1 + ELIF channel = 3 THEN 2 + ELSE 1 + FI . + +kanal bool : + IF kanal = 1 THEN channel b ELSE channel a FI . + +ENDPROC setup ; + +PROC init setup (INT VAR kanal, setup choice) : + IF session <> old session + THEN init params ; + old session := session + FI ; + out (home) ; + putline (" ----------------------------- V 2 4 - S E T U P ---------------------------") ; + line ; + putline (" Verlassen 'ESC', Aussuchen 'LEFT' und 'RIGHT', Einstellen 'RETURN'") ; + line ; + selektor (setup text, setup choice, FALSE) ; + line ; + line ; + selektor (kanal text, kanal, FALSE) ; + line ; + line ; + out (" ") ; put (baudrates (kanal)) ; out (" ") ; + line ; + line ; + selektor (datenbits text, datenbits (kanal), FALSE) ; + line ; + line ; + selektor (stopbits text, stopbits (kanal), FALSE) ; + line ; + line ; + selektor (parity text, parity (kanal), FALSE) ; + line ; + line ; + selektor (flowmode text, flowmode (kanal), FALSE) ; + line ; + line ; + line ; + line ; + putline (" --------------------------------------------------------------------------") ; + out (home) . +ENDPROC init setup ; + +ENDPACKET setup ; + + diff --git a/system/ruc-terminal/unknown/src/Terminal108(ascii) b/system/ruc-terminal/unknown/src/Terminal108(ascii) new file mode 100644 index 0000000..71e335c --- /dev/null +++ b/system/ruc-terminal/unknown/src/Terminal108(ascii) @@ -0,0 +1,121 @@ + (* Terminaltyp: Terminal108 *) + (* Keyboard : Deutsch *) + (* Zeichensatz: ASCII *) + (* Stand : 28.04.86 *) + +forget ("Terminal108(ascii)", quiet) ; +new type ("Terminal108(ascii)") ; + +cursor logic (32, ""30"", "", "") ; + +(* Nicht im EUMEL-Zeichensatz definierte Steuerzeichen *) +illegal (11, 12) ; +illegal (16, 31) ; +illegal (128, 213) ; +illegal (224, 250) ; +illegal (252, 255) ; + +enter outcode ( 1, 25) ; (* Cursor Home *) +enter outcode ( 2, 28) ; (* Cursor right *) +enter outcode ( 3, 31) ; (* Cursor up *) +enter outcode ( 4, 11) ; (* Clear EOP *) +enter outcode ( 5, 29) ; (* Clear EOL *) +enter outcode ( 7, 7) ; (* Bell *) +enter outcode (14, 0, " "14"") ; (* Norm Vid *) +enter outcode (15, 0, ""15" ") ; (* Inv Vid *) + +enter outcode (214, 193) ; (* Inv A *) +enter outcode (215, 207) ; (* Inv O *) +enter outcode (216, 213) ; (* Inv U *) +enter outcode (217, 225) ; (* Inv a *) +enter outcode (218, 239) ; (* Inv o *) +enter outcode (219, 245) ; (* Inv u *) +enter outcode (220, 235) ; (* Inv k *) +enter outcode (221, 173) ; (* Inv - *) +enter outcode (222, 163) ; (* Inv # *) +enter outcode (223, 160) ; (* Inv Blank *) +enter outcode (251, 194) ; (* Inv B *) + +enter outcode (64, 0, ""1"B"64"") ; (* ""1"B" = ASCII *) +enter outcode (91, 0, ""1"B"91"") ; +enter outcode (92, 0, ""1"B"92"") ; +enter outcode (93, 0, ""1"B"93"") ; +enter outcode (123,0, ""1"B"123"") ; +enter outcode (124,0, ""1"B"124"") ; +enter outcode (125,0, ""1"B"125"") ; +enter outcode (126,0, ""1"B"126"") ; +(* +enter outcode (12, 12) ; (* CLR SCRN *) +enter outcode (16, 2) ; (* Cursor Mode *) +enter outcode (17, 1) ; (* Zeichensatz : Bit 0..3 *) +enter outcode (18, 18) ; (* Insert Line *) +enter outcode (19, 26) ; (* Erase (nicht Delete) Line *) +enter outcode (20, 5) ; (* xpos := 80 *) +enter outcode (22, 22) ; (* Select Screen : Bit 0 *) +enter outcode (23, 23) ; (*SetWindow (+128)*) +*) +enter incode ( 1, ""192"") ; (* Home : Cursorblock mitte *) +enter incode ( 2, ""149"") ; (* Cursor right: Cursorblock mitte rechts *) +enter incode ( 3, ""139"") ; (* Cursor up : Cursorblock oben mitte *) +(*enter incode (4, ""21"") ; (* Info usw. : Cursorblock unten rechts*) *) +enter incode ( 7, ""194"") ; (* SV - Call : Funktionstaste F2 *) +enter incode ( 8, ""136"") ; (* Cursor left : Cursorblock mitte links *) +enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte *) +enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links *) +enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste *) +enter incode ( 16, ""143"") ; (* MARK : Cursorblock oben rechts *) +enter incode ( 17, ""193"") ; (* Stop : Funktionstaste F1 *) +enter incode ( 23, ""195"") ; (* Weiter : Funktionstaste F3 *) +enter incode ( 31, ""8"") ; (* Backspace : (2x) gerahmter Linkspfeil *) + +enter incode (214, ""91"") ; +enter incode (215, ""92"") ; +enter incode (216, ""93"") ; +enter incode (217, ""123"") ; +enter incode (218, ""124"") ; +enter incode (219, ""125"") ; +enter incode (251, ""126"") ; + +enter incode ( 0, ""24"") ; (* CE *) +enter incode ( 5, ""196"") ; (* F4 *) +enter incode ( 6, ""197"") ; (* F5 *) +enter incode (14, ""198"") ; (* F6 *) +enter incode (15, ""199"") ; (* F7 *) +enter incode (18, ""200"") ; (* F8 *) +enter incode (19, ""201"") ; (* F9 *) +enter incode (20, ""202"") ; (* F10 *) +enter incode (21, ""203"") ; (* F11 *) +enter incode (22, ""204"") ; (* F12 *) +enter incode (24, ""205"") ; (* F13 *) +enter incode (25, ""206"") ; (* F14 *) +enter incode (26, ""207"") ; (* F15 *) +enter incode (28, ""209"") ; (* SHIFT F1 *) +enter incode (29, ""210"") ; (* SHIFT F2 *) +enter incode (30, ""211"") ; (* SHIFT F3 *) + +enter incode (126,""165"") ; (* CTRL F5 *) +enter incode (91, ""166"") ; (* CTRL F6 *) +enter incode (92, ""167"") ; (* CTRL F7 *) +enter incode (93, ""168"") ; (* CTRL F8 *) +enter incode (123,""169"") ; (* CTRL F9 *) +enter incode (124,""170"") ; (* CTRL F10 *) +enter incode (125,""171"") ; (* CTRL F11 *) + +enter incode (251, ""213"") ; (* SHIFT F5 = *) + (* SHIFT F6 = +Andere incodes schon Hardware- SHIFT F7 = +mig implementiert: SHIFT F8 = + SHIFT F9 = + SHIFT F10= + SHIFT F11= + SHIFT F12= Trenn-k ( k ) + SHIFT F13= Trenn-Strich ( - ) + SHIFT F14= Geschtztes Fis ( # ) + SHIFT F15= Geschtztes Blank ( ) *) + +PROC illegal (INT CONST from, to) : + INT VAR i ; + FOR i FROM from UPTO to REP + enter outcode (i, 127) + PER +ENDPROC illegal ; diff --git a/system/ruc-terminal/unknown/src/Terminal108(deutsch) b/system/ruc-terminal/unknown/src/Terminal108(deutsch) new file mode 100644 index 0000000..b6fcfcf --- /dev/null +++ b/system/ruc-terminal/unknown/src/Terminal108(deutsch) @@ -0,0 +1,122 @@ + (* Terminaltyp: Terminal108 *) + (* Keyboard : Deutsch *) + (* Zeichensatz: Deutsch *) + (* Stand : 28.04.86 *) + +forget ("Terminal108(deutsch)", quiet) ; +new type ("Terminal108(deutsch)") ; + +cursor logic (32, ""30"", "", "") ; + +(* Nicht im EUMEL-Zeichensatz definierte Steuerzeichen *) +illegal (11, 12) ; +illegal (16, 31) ; +illegal (128, 213) ; +illegal (224, 250) ; +illegal (252, 255) ; + +enter outcode (91, 0, ""15"("14"") ; +enter outcode (92, 0, ""15"/"14"") ; +enter outcode (93, 0, ""15")"14"") ; +enter outcode (123, 0, ""15"<"14"") ; +enter outcode (124, 0, ""15"!"14"") ; +enter outcode (125, 0, ""15">"14"") ; +enter outcode (126, 0, ""15"`"14"") ; + +enter outcode (214, 0, ""1"D"91"") ; (* ""1"D" = Deutsch *) +enter outcode (215, 0, ""1"D"92"") ; +enter outcode (216, 0, ""1"D"93"") ; +enter outcode (217, 0, ""1"D"123"") ; +enter outcode (218, 0, ""1"D"124"") ; +enter outcode (219, 0, ""1"D"125"") ; +enter outcode (220, 235) ; (* Inv k *) +enter outcode (221, 173) ; (* Inv - *) +enter outcode (222, 163) ; (* Inv # *) +enter outcode (223, 160) ; (* Inv Blank *) +enter outcode (251, 0, ""1"D"126"") ; + +enter outcode ( 1, 25) ; (* Cursor Home *) +enter outcode ( 2, 28) ; (* Cursor right *) +enter outcode ( 3, 31) ; (* Cursor up *) +enter outcode ( 4, 11) ; (* Clear EOP *) +enter outcode ( 5, 29) ; (* Clear EOL *) +enter outcode ( 7, 7) ; (* Bell *) +enter outcode (14, 0, " "14"") ; (* Norm Vid *) +enter outcode (15, 0, ""15" ") ; (* Inv Vid *) +(* +enter outcode (12, 12) ; (* CLR SCRN *) +enter outcode (16, 2) ; (* Cursor Mode *) +enter outcode (17, 1) ; (* Zeichensatz : Bit 0..3 *) +enter outcode (18, 18) ; (* Insert Line *) +enter outcode (19, 26) ; (* Erase (nicht Delete) Line *) +enter outcode (20, 5) ; (* xpos := 80 *) +enter outcode (22, 22) ; (* Select Screen : Bit 0 *) +enter outcode (23, 23) ; (*SetWindow (+128)*) +*) +enter incode ( 1, ""192"") ; (* Home : Cursorblock mitte *) +enter incode ( 2, ""149"") ; (* Cursor right: Cursorblock mitte rechts *) +enter incode ( 3, ""139"") ; (* Cursor up : Cursorblock oben mitte *) +(*enter incode (4, ""21"") ; (* Info usw. : Cursorblock unten rechts*) *) +enter incode ( 7, ""194"") ; (* SV - Call : Funktionstaste F2 *) +enter incode ( 8, ""136"") ; (* Cursor left : Cursorblock mitte links *) +enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte *) +enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links *) +enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste *) +enter incode ( 16, ""143"") ; (* MARK : Cursorblock oben rechts *) +enter incode ( 17, ""193"") ; (* Stop : Funktionstaste F1 *) +enter incode ( 23, ""195"") ; (* Weiter : Funktionstaste F3 *) +enter incode ( 31, ""8"") ; (* Backspace : (2x) gerahmter Linkspfeil *) + +enter incode (214, ""91"") ; +enter incode (215, ""92"") ; +enter incode (216, ""93"") ; +enter incode (217, ""123"") ; +enter incode (218, ""124"") ; +enter incode (219, ""125"") ; +enter incode (251, ""126"") ; + +enter incode ( 0, ""24"") ; (* CE *) +enter incode ( 5, ""196"") ; (* F4 *) +enter incode ( 6, ""197"") ; (* F5 *) +enter incode (14, ""198"") ; (* F6 *) +enter incode (15, ""199"") ; (* F7 *) +enter incode (18, ""200"") ; (* F8 *) +enter incode (19, ""201"") ; (* F9 *) +enter incode (20, ""202"") ; (* F10 *) +enter incode (21, ""203"") ; (* F11 *) +enter incode (22, ""204"") ; (* F12 *) +enter incode (24, ""205"") ; (* F13 *) +enter incode (25, ""206"") ; (* F14 *) +enter incode (26, ""207"") ; (* F15 *) +enter incode (28, ""209"") ; (* SHIFT F1 *) +enter incode (29, ""210"") ; (* SHIFT F2 *) +enter incode (30, ""211"") ; (* SHIFT F3 *) + +enter incode (126,""165"") ; (* CTRL F5 *) +enter incode (91, ""166"") ; (* CTRL F6 *) +enter incode (92, ""167"") ; (* CTRL F7 *) +enter incode (93, ""168"") ; (* CTRL F8 *) +enter incode (123,""169"") ; (* CTRL F9 *) +enter incode (124,""170"") ; (* CTRL F10 *) +enter incode (125,""171"") ; (* CTRL F11 *) + +enter incode (251, ""213"") ; (* SHIFT F5 = *) + (* SHIFT F6 = +Andere incodes schon Hardware- SHIFT F7 = +mig implementiert: SHIFT F8 = + SHIFT F9 = + SHIFT F10= + SHIFT F11= + SHIFT F12= Trenn-k ( k ) + SHIFT F13= Trenn-Strich ( - ) + SHIFT F14= Geschtztes Fis ( # ) + SHIFT F15= Geschtztes Blank ( ) *) + +PROC illegal (INT CONST from, to) : + INT VAR i ; + FOR i FROM from UPTO to REP + enter outcode (i, 127) + PER +ENDPROC illegal ; + + diff --git a/system/ruc-terminal/unknown/src/ructerm.apl-german b/system/ruc-terminal/unknown/src/ructerm.apl-german new file mode 100644 index 0000000..9b4bdf1 --- /dev/null +++ b/system/ruc-terminal/unknown/src/ructerm.apl-german @@ -0,0 +1,125 @@ + (* Terminaltyp: ructerm *) + (* Keyboard : Deutsch *) + (* Zeichensatz: Universal*) + (* Stand : 08.10.86 *) + (* Mit 'info'-Taste auf => *) + +forget ("ructerm.apl/german", quiet) ; +new type ("ructerm.apl/german") ; + +enter outcode (11, 253) ; (* links Pfeil *) +enter outcode (12, 221) ; (* rechts Pfeil *) +enter outcode (16, 240) ; +enter outcode (17, 241) ; +enter outcode (18, 242) ; +enter outcode (19, 243) ; +enter outcode (20, 244) ; +enter outcode (21, 245) ; +enter outcode (22, 246) ; +enter outcode (23, 247) ; +enter outcode (24, 248) ; + +cursor logic (32, ""27"=", "", "") ; + +(* Ausgabe Codes : *) +enter outcode ( 1, 30) ; (* Cursor Home : *) +enter outcode ( 2, 12) ; (* Cursor right: *) +enter outcode ( 3, 11) ; (* Cursor up : *) +enter outcode ( 4, 0, ""27"Y"27"z7") ; (* CLEOP und Zeichensatz : Y *) +enter outcode ( 5, 0, ""27"T") ; (* CLEOL : T *) +enter outcode ( 8, 8) ; (* Cursor left : *) +enter outcode ( 10, 10) ; (* Cursor down : *) +enter outcode ( 13, 13) ; (* CR : *) +enter outcode ( 14, 175) ; (* END MARK : Spitz. Klammer zu *) +enter outcode ( 15, 192) ; (* BEGIN MARK : Spitz. Klammer auf *) + +enter outcode (214, 91) ; (* Ae *) +enter outcode (215, 92) ; (* Oe *) +enter outcode (216, 93) ; (* Ue *) +enter outcode (217, 123) ; (* ae *) +enter outcode (218, 124) ; (* oe *) +enter outcode (219, 125) ; (* ue *) +enter outcode (220, 235) ; (* Trenn-k *) +enter outcode (221, 191) ; (* Trennstrich *) +enter outcode (222, 188) ; (* Fest-# = Raute *) +enter outcode (223, 160) ; (* Fest-Blank *) +enter outcode (251, 126) ; (* sz *) +enter outcode (252, 64) ; (* paragraph *) + +enter outcode (64, 131) ; (* At-Sign *) +enter outcode (91, 252) ; (* Eck. Klammer auf *) +enter outcode (92, 223) ; (* Backslash *) +enter outcode (93, 251) ; (* Eck. Klammer zu *) +enter outcode (123, 167) ; (* Geschw. Klammer auf *) +enter outcode (124, 205) ; (* Senkr. Strich *) +enter outcode (125, 163) ; (* Geschw. Klammer zu *) +enter outcode (126, 212) ; (* Tilde *) + +enter outcode (144, 214) ; (* Zeichen mit Umlautcodes *) +enter outcode (145, 215) ; (* verlegen *) +enter outcode (146, 216) ; +enter outcode (147, 217) ; +enter outcode (148, 218) ; +enter outcode (149, 219) ; +enter outcode (150, 220) ; +enter outcode (151, 221) ; +enter outcode (152, 222) ; + +enter incode ( 1, ""192"") ; (* Home : Cursorblock mitte *) +enter incode ( 2, ""149"") ; (* Cursor right: Cursorblock mitte rechts *) +enter incode ( 3, ""139"") ; (* Cursor up : Cursorblock oben mitte *) +enter incode ( 4, ""21"") ; (* Info usw. : Cursorblock unten rechts *) +enter incode ( 7, ""194"") ; (* SV - Call : Funktionstaste F2 *) +enter incode ( 8, ""136"") ; (* Cursor left : Cursorblock mitte links *) +enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte *) +enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links *) +enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste *) +enter incode ( 16, ""143"") ; (* MARK : Cursorblock oben rechts *) +enter incode ( 17, ""193"") ; (* Stop : Funktionstaste F1 *) +enter incode ( 23, ""195"") ; (* Weiter : Funktionstaste F3 *) +enter incode ( 31, ""8"") ; (* Backspace : (2x) gerahmter Linkspfeil *) + +enter incode (214, ""91"") ; +enter incode (215, ""92"") ; +enter incode (216, ""93"") ; +enter incode (217, ""123"") ; +enter incode (218, ""124"") ; +enter incode (219, ""125"") ; +enter incode (251, ""126"") ; + +enter incode ( 0, ""24"") ; (* CE *) +enter incode ( 5, ""196"") ; (* F4 *) +enter incode ( 6, ""197"") ; (* F5 *) +enter incode (14, ""198"") ; (* F6 *) +enter incode (15, ""199"") ; (* F7 *) +enter incode (18, ""200"") ; (* F8 Insert Line *) +enter incode (19, ""201"") ; (* F9 *) +enter incode (20, ""202"") ; (* F10 *) +enter incode (21, ""203"") ; (* F11 *) +enter incode (22, ""204"") ; (* F12 *) +enter incode (24, ""205"") ; (* F13 *) +enter incode (25, ""206"") ; (* F14 *) +enter incode (26, ""207"") ; (* F15 *) +enter incode (28, ""209"") ; (* SHIFT F1 *) +enter incode (29, ""210"") ; (* SHIFT F2 *) +enter incode (30, ""211"") ; (* SHIFT F3 *) + +enter incode (126,""165"") ; (* CTRL F5 *) +enter incode (91, ""166"") ; (* CTRL F6 *) +enter incode (92, ""167"") ; (* CTRL F7 *) +enter incode (93, ""168"") ; (* CTRL F8 *) +enter incode (123,""169"") ; (* CTRL F9 *) +enter incode (124,""170"") ; (* CTRL F10 *) +enter incode (125,""171"") ; (* CTRL F11 *) + + (* SHIFT F6 = +Andere incodes schon Hardware- SHIFT F7 = +mig implementiert: SHIFT F8 = + SHIFT F9 = + SHIFT F10= + SHIFT F11= + SHIFT F12= Trenn-k ( k ) + SHIFT F13= Trenn-Strich ( - ) + SHIFT F14= Geschtztes Fis ( # ) + SHIFT F15= Geschtztes Blank ( ) *) + diff --git a/system/ruc-terminal/unknown/src/ructerm.ascii b/system/ruc-terminal/unknown/src/ructerm.ascii new file mode 100644 index 0000000..4b5cddd --- /dev/null +++ b/system/ruc-terminal/unknown/src/ructerm.ascii @@ -0,0 +1,94 @@ + (* Terminaltyp: ructerm *) + (* Keyboard : Deutsch *) + (* Zeichensatz: Ascii *) + (* Stand : 08.10.86 *) + (* Mit 'info'-Taste auf => *) + +forget ("ructerm.ascii", quiet) ; +new type ("ructerm.ascii") ; + +cursor logic (32, ""27"=", "", "") ; + +(* Ausgabe Codes : *) +enter outcode ( 1, 30) ; (* Cursor Home : *) +enter outcode ( 2, 12) ; (* Cursor right: *) +enter outcode ( 3, 11) ; (* Cursor up : *) +enter outcode ( 4, 0, ""27"Y") ; (* CLEOP : Y *) +enter outcode ( 5, 0, ""27"T") ; (* CLEOL : T *) +enter outcode ( 8, 8) ; (* Cursor left : *) +enter outcode ( 10, 10) ; (* Cursor down : *) +enter outcode ( 13, 13) ; (* CR : *) +enter outcode ( 14, 0, " "27"(") ; (* END MARK : ( *) +enter outcode ( 15, 0, ""27") ") ; (* BEGIN MARK : ) *) + +enter outcode (214, 193) ; (* Ae *) +enter outcode (215, 207) ; (* Oe *) +enter outcode (216, 213) ; (* Ue *) +enter outcode (217, 225) ; (* ae *) +enter outcode (218, 239) ; (* oe *) +enter outcode (219, 245) ; (* ue *) +enter outcode (220, 235) ; (* Trenn-k *) +enter outcode (221, 173) ; (* Trennstrich *) +enter outcode (222, 163) ; (* Fest-# *) +enter outcode (223, 160) ; (* Fest-Blank *) +enter outcode (251, 194) ; (* sz *) +enter outcode (252, 192) ; (* paragraph *) + +enter incode ( 1, ""192"") ; (* Home : Cursorblock mitte *) +enter incode ( 2, ""149"") ; (* Cursor right: Cursorblock mitte rechts *) +enter incode ( 3, ""139"") ; (* Cursor up : Cursorblock oben mitte *) +enter incode ( 4, ""21"") ; (* Info usw. : Cursorblock unten rechts *) +enter incode ( 7, ""194"") ; (* SV - Call : Funktionstaste F2 *) +enter incode ( 8, ""136"") ; (* Cursor left : Cursorblock mitte links *) +enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte *) +enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links *) +enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste *) +enter incode ( 16, ""143"") ; (* MARK : Cursorblock oben rechts *) +enter incode ( 17, ""193"") ; (* Stop : Funktionstaste F1 *) +enter incode ( 23, ""195"") ; (* Weiter : Funktionstaste F3 *) +enter incode ( 31, ""8"") ; (* Backspace : (2x) gerahmter Linkspfeil *) + +enter incode (214, ""91"") ; +enter incode (215, ""92"") ; +enter incode (216, ""93"") ; +enter incode (217, ""123"") ; +enter incode (218, ""124"") ; +enter incode (219, ""125"") ; +enter incode (251, ""126"") ; + +enter incode ( 0, ""24"") ; (* CE *) +enter incode ( 5, ""196"") ; (* F4 *) +enter incode ( 6, ""197"") ; (* F5 *) +enter incode (14, ""198"") ; (* F6 *) +enter incode (15, ""199"") ; (* F7 *) +enter incode (18, ""200"") ; (* F8 Insert Line *) +enter incode (19, ""201"") ; (* F9 *) +enter incode (20, ""202"") ; (* F10 *) +enter incode (21, ""203"") ; (* F11 *) +enter incode (22, ""204"") ; (* F12 *) +enter incode (24, ""205"") ; (* F13 *) +enter incode (25, ""206"") ; (* F14 *) +enter incode (26, ""207"") ; (* F15 *) +enter incode (28, ""209"") ; (* SHIFT F1 *) +enter incode (29, ""210"") ; (* SHIFT F2 *) +enter incode (30, ""211"") ; (* SHIFT F3 *) + +enter incode (126,""165"") ; (* CTRL F5 *) +enter incode (91, ""166"") ; (* CTRL F6 *) +enter incode (92, ""167"") ; (* CTRL F7 *) +enter incode (93, ""168"") ; (* CTRL F8 *) +enter incode (123,""169"") ; (* CTRL F9 *) +enter incode (124,""170"") ; (* CTRL F10 *) +enter incode (125,""171"") ; (* CTRL F11 *) + + (* SHIFT F6 = +Andere incodes schon Hardware- SHIFT F7 = +mig implementiert: SHIFT F8 = + SHIFT F9 = + SHIFT F10= + SHIFT F11= + SHIFT F12= Trenn-k ( k ) + SHIFT F13= Trenn-Strich ( - ) + SHIFT F14= Geschtztes Fis ( # ) + SHIFT F15= Geschtztes Blank ( ) *) + diff --git a/system/shard-x86-at/7/README.rst b/system/shard-x86-at/7/README.rst new file mode 100644 index 0000000..5d62c2e --- /dev/null +++ b/system/shard-x86-at/7/README.rst @@ -0,0 +1,5 @@ +AT SHard 7 +========== + +SHard for PC AT on 8086, version 7 (SHDVER) for Hintergrund 1.7.4.2 (hgver). + diff --git a/system/shard-x86-at/7/data/EXEMOD.EXE b/system/shard-x86-at/7/data/EXEMOD.EXE new file mode 100644 index 0000000..c52538b Binary files /dev/null and b/system/shard-x86-at/7/data/EXEMOD.EXE differ diff --git a/system/shard-x86-at/7/data/EXEPACK.EXE b/system/shard-x86-at/7/data/EXEPACK.EXE new file mode 100644 index 0000000..794b562 Binary files /dev/null and b/system/shard-x86-at/7/data/EXEPACK.EXE differ diff --git a/system/shard-x86-at/7/data/FSHARD.EXE b/system/shard-x86-at/7/data/FSHARD.EXE new file mode 100644 index 0000000..61b0eb6 Binary files /dev/null and b/system/shard-x86-at/7/data/FSHARD.EXE differ diff --git a/system/shard-x86-at/7/data/FSHGET.EXE b/system/shard-x86-at/7/data/FSHGET.EXE new file mode 100644 index 0000000..1f678ed Binary files /dev/null and b/system/shard-x86-at/7/data/FSHGET.EXE differ diff --git a/system/shard-x86-at/7/data/GENBOOT.EXE b/system/shard-x86-at/7/data/GENBOOT.EXE new file mode 100644 index 0000000..077be93 Binary files /dev/null and b/system/shard-x86-at/7/data/GENBOOT.EXE differ diff --git a/system/shard-x86-at/7/doc/8039.PRT b/system/shard-x86-at/7/doc/8039.PRT new file mode 100644 index 0000000..0981f6d --- /dev/null +++ b/system/shard-x86-at/7/doc/8039.PRT @@ -0,0 +1,569 @@ +0.ope ("12")##limit (15.5)# +#right#20.01.88 + +#center##ub#Beschreibung der Single-Chip-uP 8031/5/9/40/8/9/50#ue# + +1.) Pinning MCS-48, UPI-41, UPI-42 + + +----__----+ + T0 | 1 40 | Vcc +5V + Xtal1 | 2 39 | T1 (In) + Xtal2 | 3 38 | P27 -DACK =8x41/2 + -Reset (In) | 4 37 | P26 DRQ =8x41/2 + -SS (In) | 5 36 | P25 -IBF =8x41/2 + -Int (In) | 6 35 | P24 -OBF =8x41/2 + EA (In) | 7 34 | P17 + -RD (Out) | 8 33 | P16 + 8x41/2=A0 -PSEN (Out) | 9 32 | P15 + -WR (Out) | 10 31 | P14 + 8x41/2=SYNC ALE (Out) | 11 30 | P13 + D0 | 12 29 | P12 + D1 | 13 28 | P11 + D2 | 14 27 | P10 + D3 | 15 26 | Vdd/Vpp +5V/+21V bzw. 25V + D4 | 16 25 | PROG (O=8243 ioExpander,I=pulse) + D5 | 17 24 | P23 + D6 | 18 23 | P22 + D7 | 19 22 | P21 + GND | 20 21 | P20 + +----------+ +-SS : Single Step (zusammen mit ALE-Output) +-RESET: 10uF Kondensator nach GND +-INT : muss mind. 3 Zyklen lang low sein +PROG : Programmierpuls (+18V, +23V) bzw. + bzw. Output fuer 8243 I/O Expander +SYNC : Output Clock wie ALE +A0 : Input from Host: 0 = Datatransfer, 1 = Commandtransfer (kann in F1 + gelesen werden) +-IBF : Input buffer full +OBF : Outputbuffer full +-DACK : DMA Acknowledge +DRQ : DMA request + + +- Pinning MCS-51 + + +----__----+ +8x32/52=T2 P10 | 1 40 | Vcc +5V +8x32/52=T2EX P11 | 2 39 | P00/AD0 + P12 | 3 38 | P01/AD1 + P13 | 4 37 | P02/AD2 + P14 | 5 36 | P03/AD3 + P15 | 6 35 | P04/AD4 + P16 | 7 34 | P05/AD5 + P17 | 8 33 | P06/AD6 + Reset/Vpd | 9 32 | P07/AD7 + P30/RXD | 10 31 | -EA + P31/TXD | 11 30 | ALE + P32/-INT0 | 12 29 | -PSEN + P33/-INT1 | 13 28 | P27/A15 + P34/T0 | 14 27 | P26/A14 + P35/T1 | 15 26 | P25/A13 + P36/-WR | 16 25 | P24/A12 + P37/-RD | 17 24 | P23/A11 + Xtal2 | 18 23 | P22/A10 + Xtal1 | 19 22 | P21/A9 + GND | 20 21 | P20/A8 + +----------+ + +T2 = Timer 2 counter trigger input +T2EX = Timer 2 external input clock + +-Vdd : +5V im Betrieb, + 0V fuer Low Power Standby + +21V/+25V fuer Programmierspannung +-T0 : Test Input 0 bzw. + Clock-Output des Timers falls ENT0 CLK Befehl gegeben wurde. +-T1 : Test Input 1 bzw. + Counter/Timer Input if STRT CNT Befehl gegeben wurde +XTAL1 : Quartz, bzw. CLock Input +XTAL2 : Quartz +ALE : Adresse Latch enable output (einmal pro Zyklus aktiviert, d.h. + als Clockoutput zu gebrauchen) + Negative Flanke uebernimmt Adressen auf dem Bus in ext. Latch +-RD : Output-Strobe to read Data from the BUS into the CPU +-WR : Output-Strobe indicating a write into external Memory +-PSEN : Low if a fetch to external memory occurs (ROM -CE) +P10..P17 : I/O Port 1 quasi-bidirektional +P20..P27 : I/O Port 2 " + P20..P23 dienen als A8..A11 bei Programstore fetches bzw. + mit PROG & 8243 als 4Bit I/O Expander Adresse +EA : External Access input, If high, all internal Programm Memory + fetches reference external memory (debugging mode) +D0..D7 : Datenbus, I/O zus. mit -RD, -WR, ALE + Enthaelt A0..A7 zusammen mit PSEN fuer ext. Prog.mem.References + " A0..A7 " mit ALE, -RD, -WR fuer ext.RAM-References + + +2.) Vergleich der Single-Chip-CPUs + +UPI-41 : 8041, 8641, 8741 +UPI-42 : 8042, 8742 +MCS-48 Serie: 8035, 8039, 8040, 8048, 8049, 8050, 8748, 8749, (8243) +MCS-51 Serie: 8031, 8032, 8044, 8344, 8744, 8051, 8052 + +E = EPROM - Version +R = (Mask)-ROM Version +- = Kein ROM +X = External PROM +Buf=Buffered Port, Buffer-Full ber Pins rausgefhrt. + + CPU | RAM | ROM |E|Ports|Serial |Timer |INTs| Sonstiges +------+-----+-----+-+-----+-------+------+----+-------------------------- + 8031 | 64 | - |-| 4(3)|1 Async| 2x16 | 2 | 128k ext.mem., boolean-cpu + 8032 | 256 | - |-| 4(3)|1 Async| 3x16 | 2 | 128k ext.mem., boolean-cpu + 8035 | 64 | - |-| 2 | - | 1x 8 | 1 | Timer/Counter + 8039 | 128 | - |-| 2 | - | 1x 8 | 1 | " + 8040 | 256 | - |-| 2 | - | 1x 8 | 1 | " + 8041 | 64 | 1k |R|2xBuf| DMA | 1x 8 | - | 4 I/O Bits gempxt. + 8042 | 128 | 2k |R|2xBuf| DMA | 1x 8 | - | 4 I/O Bits gempxt. + 8044 | 192 | 4k |R| 4(3)|H/SDLC | 2x16 | 2 | 128k ext.,b-cpu,375kbaud-pll + 8048 | 64 | 1k |R| 2 | - | 1x 8 | 1 | Timer/Counter + 8049 | 128 | 2k |R| 2 | - | 1x 8 | 1 | " + 8050 | 256 | 4k |R| 2 | - | 1x 8 | 1 | " + 8051 | 128 | 4k |R| 4(3)|1 Async| 2x16 | 2 | 128k ext., boolean-cpu + 8052 | 256 | 8k |R| 4(3)|1 Async| 3x16 | 2 | 128k ext., boolean-cpu + 8243 | - | - |-|4x4B | - | - | - | I/O Expander f.MCS-48 Serie + 8344 | 192 | 4k |X| 4(3)|H/SDLC | 2x16 | 2 | 128k ext.,b-cpu,375kbaud-pll + 8741 | 64 | 1k |E|2xBuf| DMA | 1x 8 | - | 4 I/O Bits gempxt. + 8742 | 128 | 2k |E|2xBuf| DMA | 1x 8 | - | 4 I/O Bits gempxt. + 8744 ! 192 | 4k |E| 4(3)|H/SDLC | 2x16 | 2 | 128k ext.,b-cpu,375kbaud-pll + 8748 | 64 | 1k |E| 2 | - | 1x 8 | 1 | Timer/Counter + 8749 | 128 | 2k |E| 2 | - | 1x 8 | 1 | " + 8751 | 128 | 4k |E| 4(3)|1 Async| 2x16 | 2 | 128k ext., boolean-cpu + 8752 | 256 | 4k |E| 4(3)|1 Async| 3x16 | 2 | 128k ext., boolean-cpu + + +- Programmieren des 8748: + + 1.) Vdd = 5V, XTAL angeschlossen, -RESET = 0V, T0=5V, EA=5V + 2.) 8748 in Sockel setzen + 3.) T0=0V (* Program Mode select *) + 4.) EA=23V (* Program Mode activate *) + 5.) BUS (0..7) und P2.0..P2.3 (8..B) mit Adresse belegen + 6.) -RESET=5V (* Latch Adress *) + 7.) BUS := Databyte + 8.) Vdd=25V (* Programmierspannung *) + 9.) PROG=0V, dann 50ms PROG=23V (* Programmieren *) +10.) Vdd=5V (* Programmierspannung weg *) +11.) T0=5V (* Verify mode *) +12.) Read Data on BUS and compare (* Verify *) +13.) T0=0V (* Select Program Mode *) +14.) -RESET=0V, GOTO Step 5 (* Floating BUS *) +15.) Vdd=5V, -RESET=0V, EA=5V, 8748 aus Sockel nehmen + +3.) Memory-Map des 8039 + +RAM +Adresse Funktion +00..07 Registerbank 0 (r0..r7) +08..17 Stack (8 Ebenen) +18..1F Registerbank 1 (r0..r7) +20..7F Frei belegbar + +ROM +Adresse +000..0FF ROM-Page 0, Bank 0 (Bank 0 ist mb0) +... +700..7FF ROM-Page 7, Bank 0 +800..8FF ROM Page 0, Bank 1 (Adressen 800..FFF treten im Code nur +... als 000..7FF auf!) +F00..FFF ROM Page 7, Bank 1 (Bank 1 ist mb1) + +Bei Reset erfolgt ein Sprung nach 000 +Bei (Timer-)Interrupt erfolgt ein Sprung nach 007 + +Register +Bezeichn. Name +a Akkumulator (8 Bit) +r0..r7 Register 0 bis 7 (Im internen RAM) (je 8 Bit) +t Timer (8 Bit) +p1 Port 1 (8 Bit) +p2 Port 2 (8 Bit) + +Bits +i Interrupt-Leitung INT (1 Bit) +t0 Test-Eingang T0 (1 Bit) +t1 Test-Eingang T1 (91 Bit) +f0 Internes Flag 0 +f1 Internes Flag 1 + +Jump-Conditions +jtf Jump if Timer finished (Nulldurchgang) +jntf Jump if Timer not finished (zhlt noch) +jb0..jb7 Jump if Bit 0..7 in a is set +jt0 Jump if T0-Input is high +jnt0 Jump if T0-Input is low +jt1 Jump if T1-Input is high +jnt1 Jump if T1-Input is low +jf0 Jump if Flag 0 is set +jnf0 Jump if Flag 0 is cleared +jf1 Jump if Flag 1 is set +jnf1 Jump if Flag 1 is cleared +jz Jump if a is zero +jnz Jump if a is not zero +jc Jump if carry is set +jnc Jump if carry is cleared +jni Jump if Interrupt-Pin INT is low + +4.) Befehlssatz nach Opcode sortiert + +Symbolik (Beispiele) + +@r0 Inhalt der Speicherstelle, deren Adresse in Register 0 steht. +#xx Die (Byte-)Konstante xx +2xx Die Adressen 200..2FF (je nach xx), xx ist ein Offset zur Seite 2. +mb1 ROM-Bank 1 ('800..FFF') + +00 nop +01 +02 +03 xx add a,#xx +04 xx jmp 0xx +05 +06 xx jntf xx +07 dec a +08 +09 in a,p1 +0A in a,p2 +0B +0C +0D +0E +0F + +10 inc @r0 Memoryvalue incrementieren +11 inc @r1 +12 xx jb0 xx Jump if Bit 0 in a is high +13 +14 xx call 0xx +15 dis i Disable Interrupts +16 xx jtf xx +17 inc a +18 inc r0 +19 inc r1 +1A inc r2 +1B inc r3 +1C inc r4 +1D inc r5 +1E inc r6 +1F inc r7 + +20 xch a,@r0 a und Memoryinhalt bei @r0 austauschen +21 xch a,@r1 +22 +23 xx mov a,#xx a mit Konstante laden +24 xx jmp 1xx +25 en tcnti Enable Timer/Counter Interrupt +26 xx jnt0 xx +27 clr a a := 0 +28 xch a,r0 a und Register vertauschen +29 xch a,r1 +2A xch a,r2 +2B xch a,r3 +2C xch a,r4 +2D xch a,r5 +2E xch a,r6 +2F xch a,r7 + +30 +31 +32 xx jb1 xx +33 +34 xx call 1xx +35 dis tcnti Disable Timer/Counter Interrupt +36 xx jt0 xx +37 cpl a a := NOT a +38 +39 +3A +3B +3C +3D +3E +3F + +40 orl a,@r0 +41 orl a,@r1 +42 mov a,t Timervalue lesen nach a +43 xx orl a,#xx Logisches Oder +44 xx jmp 2xx +45 strt cnt Counter starten, Timer aus +46 xx jnt1 xx +47 +48 orl a,r0 +49 orl a,r1 +4A orl a,r2 +4B orl a,r3 +4C orl a,r4 +4D orl a,r5 +4E orl a,r6 +4F orl a,r7 + +50 anl a,@r0 +51 anl a,@r1 +52 xx jb2 xx +53 xx anl a,#xx Logisches Und +54 xx call 2xx +55 strt t Timer starten, Counter aus +56 xx jt1 xx +57 +58 anl a,r0 +59 anl a,r1 +5A anl a,r2 +5B anl a,r3 +5C anl a,r4 +5D anl a,r5 +5E anl a,r6 +5F anl a,r7 + +60 add a,@r0 +61 add a,@r1 +62 mov t,a Timervalue mit a laden +63 +64 xx jmp 3xx +65 stop tcnt Timer/Counter stoppen +66 xx jnf1 xx +67 rrc a a rechts rotieren (durchs Carry) +68 add a,r0 a := a + r0 +69 add a,r1 +6A add a,r2 +6B add a,r3 +6C add a,r4 +6D add a,r5 +6E add a,r6 +6F add a,r7 + +70 +71 +72 xx jb3 xx +73 +74 xx call 3xx +75 +76 xx jf1 xx +77 rr a a rechts rotieren (ohne Carry) +78 +79 +7A +7B +7C +7D +7E +7F + +80 +81 +82 +83 ret Unterprogrammruecksprung +84 xx jmp 4xx +85 clr f0 Flag 0 loeschen +86 xx jni xx +87 +88 +89 xx orl p1,#xx Bits im Outputport 1 setzen +8A xx orl p2,#xx dto. Port 2 +8B +8C +8D +8E +8F + +90 movx @r0,a Port (@r0) mit a beschreiben +91 movx @r1,a +92 xx jb4 xx +93 retr Return from Interrupt +94 xx call 4xx +95 cpl f0 Flag 0 umdrehen +96 xx jnz xx +97 clr c Carry loeschen +98 +99 xx anl p1,#xx Bit im Outputport 1 loeschen (mit NOT xx) +9A xx anl p2,#xx dto. Port 2 +9B +9C +9D +9E +9F + +A0 mov @r0,a Memory mit a beschreiben +A1 mov @r1,a +A2 +A3 movp a,@a a mit ROMinhalt (a) laden (aktuelle Page) +A4 xx jmp 5xx +A5 clr f1 +A6 +A7 cpl c Carry umdrehen +A8 mov r0,a +A9 mov r1,a +AA mov r2,a +AB mov r3,a +AC mov r4,a +AD mov r5,a +AE mov r6,a +AF mov r7,a + +B0 xx mov @r0,#xx Memoryzelle mit Konstante laden +B1 xx mov @r1,#xx +B2 xx jb5 xx +B3 +B4 xx call 5xx +B5 cpl f1 +B6 +B7 +B8 xx mov r0,#xx Register mit Konstante laden +B9 xx mov r1,#xx +BA xx mov r2,#xx +BB xx mov r3,#xx +BC xx mov r4,#xx +BD xx mov r5,#xx +BE xx mov r6,#xx +BF xx mov r7,#xx + +C0 dec @r0 +C1 dec @r1 +C2 +C3 +C4 xx jmp 6xx +C5 sel rb0 Registerbank 0 waehlen (RAM 00..07) +C6 xx jz xx +C7 +C8 dec r0 +C9 dec r1 +CA dec r2 +CB dec r3 +CC dec r4 +CD dec r5 +CE dec r6 +CF dec r7 + +D0 xrl a,@r0 +D1 xrl a,@r1 +D2 xx jb6 xx +D3 xx xrl a,#xx Logisches Exklusiv-Oder +D4 xx call 6xx +D5 sel rb1 Registerbank 1 waehlen (RAM 18..1F) +D6 +D7 +D8 xrl a,r0 +D9 xrl a,r1 +DA xrl a,r2 +DB xrl a,r3 +DC xrl a,r4 +DD xrl a,r5 +DE xrl a,r6 +DF xrl a,r7 + +E0 xx djnz @r0,xx +E1 xx djnz @r1,xx +E2 +E3 movp3 a,@a a mit Inhalt von (3aa) laden, aa = (a) +E4 xx jmp 7xx +E5 sel mb0 Memorybank 0 (ROM 000..7FF) waehlen +E6 xx jnc xx +E7 rl a a nicht durch c links rotieren +E8 xx djnz r0,xx Decrement r0, jump to xx if r0 is not zero +E9 xx djnz r1,xx +EA xx djnz r2,xx +EB xx djnz r3,xx +EC xx djnz r4,xx +ED xx djnz r5,xx +EE xx djnz r6,xx +EF xx djnz r7,xx + +F0 mov a,@r0 +F1 mov a,@r1 +F2 xx jb7 xx +F3 +F4 xx call 7xx +F5 sel mb1 Memorybank 1 (ROM 800..FFF) waehlen +F6 xx jc x +F7 rlc a a durch carry links rotieren +F8 mov a,r0 +F9 mov a,r1 +FA mov a,r2 +FB mov a,r3 +FC mov a,r4 +FD mov a,r5 +FE mov a,r6 +FF mov a,r7 + +5.) Befehlssatz nach Funktionsgruppen + +- Arithmetik + @r0 @r1 - #xx - - - a r0..r7 +dec c0 c1 - 07 C8..CF +inc 10 11 - 17 18..1F +clr - - - 27 - +cpl - - - 37 - +orl a,.. 40 41 43 - 48..4F +anl a,.. 50 51 53 - 58..5F +add a,.. 60 61 03 - 68..6F +rrc - - - 67 - +rr - - - 77 - +xrl a,.. D0 D1 D3 - D8..DF +rl - - - E7 - +rlc - - - F7 - + +- Flags + f0 f1 c +clr 85 A5 97 +cpl 95 B5 A7 + +- Transfer + @r0 @r1 - #xx - - - a r0..r7 +xch a,.. 20 21 - 28..2F +mov a,.. F0 F1 23 F8..FF +mov ..,a A0 A1 - A8..AF +mov ..,#xx B0 B1 23 B8..BF + +swap a +movp a,@a A3 +movp3 a,@a E3 + + +- I/O + i= 1 2 +in a,pi 09 0A +orl pi,#xx 89 8A +anl pi,#xx 99 9A +outl pi,a + +movx ..,a 90 91 +movx a,xx + + +- Timer + i tcnti +en 05 25 +dis 15 35 + + cnt t +strt 45 55 +stop 65 + +mov a,t 42 +mov t,a 62 + + +- Programmsteuerung + +ret 83 +retr 93 + + rr= @r0 @r1 r0..r7 +djnz rr,xx (E0 E1) E8..EF + + i= 0 1 2 3 4 5 6 7 +jmp $ixx 04 24 44 64 84 A4 C4 E4 +call $ixx 14 34 54 74 94 B4 D4 F4 + + i= 0 1 2 3 4 5 6 7 +jbi,xx 12 32 52 72 92 B2 D2 F2 + + cc= ntf tf nt0 t0 nt1 t1 nf1 f1 ni nz z nc c +jcc,xx 06 16 26 36 46 56 66 76 86 96 C6 E6 F6 + +- Sonstiges + rb0 rb1 mb0 mb1 +sel C5 D5 E5 F5 +nop 00 diff --git a/system/shard-x86-at/7/doc/BIOSINT.TXT b/system/shard-x86-at/7/doc/BIOSINT.TXT new file mode 100644 index 0000000..f31d5b6 --- /dev/null +++ b/system/shard-x86-at/7/doc/BIOSINT.TXT @@ -0,0 +1,305 @@ +#type ("17.klein")# +Interrupts/Traps/Exeptions (Bios) 03.06.87 + +Interrupt: IRQn (Durch Hardware ausgelst, werden auf Traps umgelenkt) +Trap : INTn (Durch Software ausgelst) +Exeption : INTn (Im Protected Mode vom Prozessor ausgelst) + +Traps | Funktion +--------+------------------------------------------------------------------ +INT 00H : Abort Program +INT 01H : +INT 02H : NMI-Routine (Parity-Check & Power-Fail & Redirected from INT 75H) +INT 03H : INT3 - Break +INT 04H : INTO - Overflow +INT 05H : Print Screen +INT 06H : +INT 07H : +INT 08H : IRQ0 System Interrupt +INT 09H : IRQ1 Keyboard Buffer full +INT 0AH : Software redirected from IRQ9 +INT 0BH : IRQ3 Serial Port 2 +INT 0CH : IRQ4 Serial Port 1 +INT 0DH : IRQ5 Parallel Port 2 +INT 0EH : IRQ6 Diskette Interrupt +INT 0FH : IRQ7 Parallel Port 1 + +INT 10H : Video Trap + ah = 00H : set mode (al = mode) + (Videoram: Herkules: B0000 + EGA : B8000) + al | Tx/Gr| Pixel | Zeichen | Monitor | Farbe | Seiten + ---+------+-------+---------+---------+-------+-------- + 00 | Text |640x200| 40 x 25 | Mono/Col| 16/64*| 8 + 01 | Text |640x200| 40 x 25 | Color | 16/64*| 8 + 02 | Text |640x200| 80 x 25 | Mono/Col| 16/64*| 8 + 03 | Text |640x200| 80 x 25 | Color | 16/64*| 8 + 04 | Graf |320x200| 40 x 25 | Mono/Col| 4 | 1 + 05 | Graf |320x200| 40 x 25 | Mono/Col| 4 | 1 + 06 | Graf |640x200| 80 x 25 | Mono/Col| 2 | 1 + 07 | Text |720x348| 80 x 25 | Mono | 4 | 8 + 08 | Graf |720x348| 90 x 48 | Mono | 2 | 1 + --------- ab hier nicht implementiert, nur EGA ------------------ + VideoRAM-Adresse A0000 + 0D | Graf |320x200| 40 x 25 | Color | 16 | 8 + 0E | Graf |640x350| 80 x 25 | Color | 16 | 4 + 0F | Graf |640x350| 80 x 25 | Mono | 4 | 2 + 10 | Graf |640x350| 80 x 25 | Enhanced| 16/64*| 2 + * mit EGA-Monitor + ah = 01H : set cursor type (Eingang: CH, CL Werte 0..31) + CH=Startzeile des Cursorblocks, CL=Endzeile des Cursorblocks + ah = 02H : set cursor pos (BH = Page, DL = Spalte, DH = Zeile) + ah = 03H : read cursor + Ausgang: BH=Page, DL=Spalte, DH=Zeile, CL=Starzeile des + Cursorblocks, CH=Endzeile des Cursorblocks + ah = 04H : read lightpen + Ausgang: AH=1 : Register sind gltig, AH=0: Taste nicht gedrckt + DH = Zeile, DL = Spalte des Lightpens + CH=Rasterlinie (1..199), CX=Rasterlinie (1..349) + BX = Rasterspalte (1..319/1..639) + ah = 05H : set actual display (AL = Neue Seite) + ah = 06H : scroll up + AL = 0: Fenster lschen, sonst Anzahl Zeilen zu scrollen + CH, CL = linke obere Ecke des Scroll-Windows + DH, DL = rechte untere Ecke des Scroll-Windows + BH = Attribut fuer die Leerzeilen + ah = 07H : scroll down + AL = 0: Fenster lschen, sonst Anzahl Zeilen zu scrollen + CH, CL = linke obere Ecke des Scroll-Windows + DH, DL = rechte untere Ecke des Scroll-Windows + BH = Attribut fuer die Leerzeilen + ah = 08H : read current attribute and char + Ausgang: BH=Anzeigeseite, AL=Zeichen, AH=Attribut (nur Alpha) + ah = 09H : write current attribute and char + BH=Anzeigeseite, CX=Anzahl Zeichen, AL=Zeichen, BL=Attribut/Farbe + ah = 0AH : write current attribute and char + BH=Anzeigeseite, CX=Anzahl Zeichen, AL=Zeichen + ah = 0BH : set color (BH=Palettenfarbe 0..127, BH=Farbwert) + ah = 0CH : write dot + BH=Seite, DX=Zeile, CX=Spalte, AL=Farbwert (falls Bit 7=1, wird + alte Farbe mit neuer Farbe geXORed) + ah = 0DH : read dot (BH=Seite, DX=Zeile, CX=Spalte, AL=Punktfarbwert) + ah = 0EH : write tty (Zeichen schreiben, AL=Zeichen, BL=Farbe) + ah = 0FH : video state (Ausgang: AL=Video-Mode (0..8), AH=Anzahl + Zeichenspalten, BH=Seite) + ah = 10H : reserved (EGA-Bios: Write Palette/Overscan/Intensity/Flash) + ax = 1142H: draw line (EGA-Bios: 12 Routinen fr den Charactergenerator) + CX=X-pos-from, DX= Y-pos-from, BP=X-pos-to, DI=Y-pos-to + ah = 12H : reserved (EGA-Bios: Alternate Characterset) + ah = 13H : write string + Allgemein: + ES:BP = Stringanfang + CX = Stringlnge + DL, DH = Cursorposition (Stringanfang) + BH = Seite + al = 0: BL=Attribut, String: CHAR, CHAR, CHAR,...,Cursor wird nicht + bewegt. + al = 1: BL=Attribut, String: CHAR, CHAR, CHAR,..., Cursor wird bewegt. + al = 2: String: CHAR, ATTR, CHAR, ATTR,..., Cursor wird nicht bewegt. + al = 3: String: CHAR, ATTR, CHAR, ATTR,..., Cursor wird bewegt. + +INT 11H : Equipment Trap (Ausgang: AX = Equipment Flag) + AX : + Bit 1 : 80287 installiert + Bit 3 : Herkules installiert + Bit 4/5 : 0 = No Primary Display set + 1 = Monochrome + 2 = Color 80 * 25 + 3 = EGA + Bit 6 : Drive B installiert + Bit 9..12 : Anzahl RS232 + Bit 14/15 : Anzahl Printer + +INT 12H : Memory Size Trap (Ausgang: AX = Memorysize in KB) + +INT 13H : Hardisk Trap + Allgemein: + DL = Drive (0, 1...) + AL = Sector count + CX = Bit 0... Bit 5 = Sector + Bit 6... Bit 15 = Cylinder + Exit: AH = 0 ok, <> 0 Fehler (z.b. in hf_error nachsehen) + ah = 0 reset diskette, wd1010, hdisks + ah = 1 return status + ah = 2 read + ah = 3 write + ah = 4 verify + ah = 5 format + ah = 8 drive params + ah = 9 init drive + ah = A read long + ah = B write long + ah = C seek + ah = D reset wd1010 (DL = Drive) + ah =10 ready test + ah =11 reclibrate + ah =14 check controller + ah =15 read dasd (stacktop 2 words: anzahl sektoren der platte) + +INT 14H : RS232C Trap + Allgemein: dx = port (>= 1FE0H : SCC = 8530) + ah = 0 : Init + al : Bit 5..7 = Baudrate + 000 = 110, + 001 = 150, + 010 = 300, + 011 = 600, + 100 = 1200, + 101 = 2400, + 110 = 4800, + 111 = 9600, + Bit 3..4 = Parity (no, odd, even) + Bit 2 = Stopbits (1, 2) + Bit 0..1 = Datenbits (5, 6, 7, 8) + ah = 1 : Send (al = Zeichen, Ausgang: ah=80H Timeout, Zeichen dann in al) + ah = 2 : Read (Ausgang: ah=80H:Timeout, sonst ah=Statusregister,al=Zeichen) + ah = 3 : Status (Ausgang: Nur 8250: al = Modemstatus) + ah : Bit 0 = 1 : Data available + Bit 1 = 1 : Receiver overrun + Bit 2 = 1 : Parity Error + Bit 3 = 1 : Framing Error + Bit 4 = 1 : Transmitter empty + Bit 5 = 1 : Break received + +INT 15H : Utility Trap + ah = 80H open device (nicht implementiert) + ah = 81H close device (nicht implementiert) + ah = 82H prog term (nicht implementiert) + ah = 83H event wait (Eingang: CX=RTCtmr high, DX=RTCtmr high, ES:BX=userflag) + Ausgang: CY=0, Event wait wurde aktiviert + CY=1, Noch kein RTC-Event aufgetreten + (INT 15H periodisch aufrufen zum pollen) + ah = 84H joy stick (Eingang: DX) + DX = 0: Ausgang: AL (Bits 4..7) = Buttons + DX = 1: Ausgang: AX=Xa, BX=Ya, CX=Xb, DX=Yb + ah = 85H sys request (nicht implementiert) + ah = 86H wait a moment (CX=RTCtimer high, DX=RTCtimer low) + ah = 87H block move (extended memory) (Eingang: CX: Words, ES:SI = Block + Descriptoren: 8 Bytes Source, 8 Bytes Destination) + ah = 88H extended memory (Ausgang: AX= KB extended Memory) + ah = 89H enter protected mode + ax = 8A42H run setup + ax = 8B42H error beep + ax = 8C42H usr-powerfail-shutdown-routine + (Benutzerdaten knnen von ES:0 bis ES:BACK_SYS abgelegt werden) + ax = 8D42H usr-powerfail-resume-routine + (Benutzerdaten knnen von ES:0 bis ES:BACK_SYS geholt werden) + ax = 8E42H set timer (Eingang: BL = Timer (0, 1, 2), CX = Countervalue + BH: Bit 0 = BCD, Bit 1..3 = Mode, + Bit 4..5 Write CMD, Bit 6/7 unused) + (Timer wird bei Resume wieder so initialisert) + ax = 8F42H hardcopy (Grafik & Mono) + ah = 90H device busy (nicht implementiert) + ah = 91H set int complete (nicht implementiert) + ah = 9242H backup memory (CX=Anzahl Bytes, DS:SI = Sourceadr, E000H:DI + = Destinationadr.) + ah = 9342H restore memory (CX=Anzahl Bytes, E000H:SI = Sourceadr, ES:DI = + Destinationadr.) +INT 16H : Keyboard Trap + ah = 00 Ascii read (Ausgnag: AX=Zeichen CY=1, sonst CY=0) + ah = 01 Ascii status (Ausgang: ZF = 0 : Zeichen in Queue) + ah = 02 Shift status (Ausgang: AL = KB_flag) + ax = 0342 set typematic (Ausgang: BL = Rate, BH = Delay) + ax = 0442 soft power down + +INT 17H : Printer Trap + Allgemein: dx = port + ah = 0 : print char (Eingang: al = Char, Ausgang: ah = Printer Status) + ah = 1 : init printer port + ah = 2 : ah = Status + +INT 18H : Basic (nicht implementiert) + +INT 19H : Bootstrap Trap + Block 0 von Harddisk oder Floppy --> ES:BX laden und starten (Booting...) + Der Block hat in Bytes 510/511 das Kennzeichen AA55H. + +INT 1AH : Time of day Trap + ah = 0 : Read Timer (Ausgang: CX=Timer low, DX=Timer high, AL<>0:Overflow) + ah = 1 : Set Timer (CS=Timer low, DX=Timer high) + ah = 2 : Read Clock (Ausgang: DH = Sec, CL = Min, CH = Std) + ah = 3 : Set Clock (DL=Sommerzeit (01), DH=sec, CL=Min, CH=Std) + ah = 4 : Read Date (DL=Day, DH=Month, CL=Year, CH=Century) + ah = 5 : Set Date (DL=Day, DH=Month, CL=Year, CH=Century) + ah = 6 : Set Alarm (DH=Sec, CL=Min, CH=Std) + ah = 7 : Reset Alarm + +INT 1BH : Dummy Return + +INT 1CH : User Timer Tic, wird einmal pro Sekunde aufgerufen. + +INT 1DH : Zeigt auf die Video Parameter +INT 1EH : Zeigt auf Disk_base (DF, 02, 25, 02, 0F, 1B, FF, 54, F6, 0F, 08) +INT 1FH : Pointer auf Zeichensatz mit Zeichen 128..255 + +INT 20H ... INT 3FH sind fr das Betriebssystem reserviert. + +INT 20H : DOS: Terminate Program +INT 21H : DOS: Function Call +INT 22H : DOS: +INT 23H : DOS: +INT 24H : DOS: +INT 25H : DOS: + +INT 40H : Diskette Trap + AH = 0 disk reset + AH = 1 disk status (ret) + AH = 2 disk read (ES:BP = Pointer auf Buffer, DI = Anzahl Sektoren, + DH = Head, DL = Drive, CL = Sektor, CH = Cylinder) + AH = 3 disk write " + AH = 4 disk verify " + AH = 5 disk format " + AH = 21 disk type (Ausgang: BL (Bit 0..3) 0=360K, 1/2 = 1.2MB) + AH = 22 disk change + AH = 23 format set + +INT 41H : Hardfile Table Vector +INT 44H : Pointer auf weiteren Zeichensatz (Nur von EGA-Bios untersttzt) +INT 46H : Hardfile 1 Table Vector + +INT 4AH : Fr User software redirected from RTC-IRQ (Alarm, periodic) + +INT 60H + ... User +INT 6FH + +Hardware-Interrupts 8..15: +INT 70H : IRQ 8 RTC-Interrupt +INT 71H : IRQ 9 Software Redirected to INT 0AH +INT 72H : IRQ10 Frei +INT 73H : IRQ11 Frei +INT 74H : IRQ12 Frei +INT 75H : IRQ13 Coprozessor, Software Redirected to NMI (INT 02H) +INT 76H : IRQ14 Harddisk Interrupt +INT 77H : IRQ15 Frei + +INT 78H : User 0 +INT 79H : User 1 +INT 7AH : User 2 +INT 7BH : User 3 +INT 7CH : User 4 +INT 7DH : User 5 +INT 7EH : User 6 +INT 7FH : User 7 + + +Exception | Bezeichnung | E-Code | Restart| Instr. +----------+-------------------------------------+--------+--------+---------- + 0 | Divide Error | - | Ja | DIV, IDIV + 1 | Single Step | - | Ja | Alle + 2 | NMI | - | Ja | Alle + 3 | Breakpoint | - | Ja | INT3 + 4 | INTO Overflow | - | Ja | INTO + 5 | BOUND Range | - | Ja | BOUND + 6 | Invalid Opcode | - | Ja | undef.Opc. + 7 | Processor Extension Not Available | - | Ja | ESC, WAIT + 8 | Double Exception / IDTL too small | 0 | Nein | LIDT + 9 | Processor Extension Segment Overrun | - | Nein | ESC + 10 | Invalid Task State Segment | Ja | Ja | TaskSwitch + 11 | Segment Not Present | Ja | Ja | Alle Mem. + 12 | Stack Segment Overrun or Not Present| Ja | Ja | Stackopc. + 13 | General Protection | Ja | Ja | Alle Mem. + 14 | - | - | - | - + 15 | - | - | - | - + 16 | Processor Extension Interrupt | - | - | ESC, WAIT + diff --git a/system/shard-x86-at/7/doc/CONTROLS.ELA b/system/shard-x86-at/7/doc/CONTROLS.ELA new file mode 100644 index 0000000..1ea4978 --- /dev/null +++ b/system/shard-x86-at/7/doc/CONTROLS.ELA @@ -0,0 +1,76 @@ +SHard-Spezifische 'control'-Funktionen (V2.7, AT-SHard) + +Kanal 32: + control (-3, x, mcr*256+kanal, r) : Modem-Control-Register setzen + mcr: Bit 0: DTR + Bit 1: RTS + Bit 2: OUT1 + Bit 3: OUT2 (Interrupt enable) muss 1 sein + Bit 4: Diagnostic-Mode (muss 0 sein) + Bit 5: - + Bit 6: - + Bit 7: - + control (-5, x, x, r) : Anforderung nach 'shutup' Systemreset. + blockin (clock, -4, x, r) : HW-Clock auslesen + clock (1) = jahrhundert + clock (2) = jahr + clock (3) = monat + clock (4) = tag + clock (5) = stunden + clock (6) = minuten + clock (7) = sekunden + +Kanal 2..13 (sofern vorhanden) : + control (-3, x, x, r) : 8250 Linestatusregister/Modemstatusregister lesen + Bit 1: 1 = Receiver overrun detected + 2: 1 = Parity Error detected + 3: 1 = Framing Error detected + 4: 1 = Break Interrupt Detected + Bit 8..15 nicht im Standard-SHard + (Bit 8: 1 = CTS changed + 9: 1 = DSR changed + 10: 1 = RI changed to inactive + 11: 1 = DCD changed + 12: CTS input + 13: DSR input + 14: RI input + 15: DCD input) + control (-4, x, x, r) ; r = Anzahl Eingabezeichen, seit letzter Abfrage + control (-5, x, x, r) ; r = Anzahl Ausgabezeichen, seit letzter Abfrage + control (-6, x, x, r) ; Break senden + control (-10, x, x, r) ; DTR+RTS inactive setzen (stop!) + control (-11, x, x, r) ; DTR+RTS active setzen (weiter) + +Kanal 14..16 (falls vorhanden): + control (-3, x, x, r) ; Printeroutput nicht mehr ueber SHard sondern BIOS + control (-4, 256 * retry + wartezeit, x, r) ; + Setzt fuer langsame Drucker retrys und Wartezeit + zwischen den Zeichen. + +Kanal 1 : + control (-3, attribut, x, r) ; Textattribut fuer Bildschirmausgaben setzen + control (-4, x, palette, r) ; Colorpalette fuer Farbkarte setzen. + control (-5, 256 * karte + mode, x, r) ; Videomodus einschalten + karte: 1 = tecmar(mode=0..5), 2 = hercules (mode=0) + karte: 0 = Bios (mode=0, 7, 8=graphik) + control (-6, xpos, ypos, r) ; Draw line to (xpos, ypos) + control (-7, xpos, ypos, r) ; Move to (xpos, ypos) + control (-8, maske, linetype, r) ; Set pen + control (-9, p1, p2, r) ; Set color pen 1 + control (-10, p1, p2, r) ; Set color pen 2 + control (-11, new mask count, mode, old mask count) ; Set Mask Mode + mode = 0 : Kein Mask mode + mode = 1 : Mask Mode einschalten. +Kanal 28, 29 (Harddisk): + control (-10, x, x, r) : r = Anzahl Cylinder-1 (Gesamte Platte) + control (-11, x, x, r) : r = Anzahl Sektoren + control (-12, x, x, r) : r = Anzahl Heads + +Kanal 30, 31 (Floppy) : + - + + + + + + diff --git a/system/shard-x86-at/7/doc/PORTS.PRT b/system/shard-x86-at/7/doc/PORTS.PRT new file mode 100644 index 0000000..b8d336d --- /dev/null +++ b/system/shard-x86-at/7/doc/PORTS.PRT @@ -0,0 +1,658 @@ +#type ("17.klein")# +System-Ports: + +Port | Funktion +-----+-------------------------------------------------------------------- + | DMA Controller 1 (8237A-5) fr Bytetransfers (Kanal 0..3) + 00 | Byteadresse (start/current) Kanal 0 (frei fr Memory-Memory Transfer) + 01 | Bytecount Kanal 0 (Pageregister 87H) (Sourcechannel) + 02 | Byteadresse (start/current) Kanal 1 (reserviert fr SDLC) + 03 | Bytecount Kanal 1 (Pageregister 83H) (Destinationchannel) + 04 | Byteadresse (start/current) Kanal 2 (Diskette) + 05 | Bytecount Kanal 2 (Pageregister 81H) + 06 | Byteadresse (start/current) Kanal 3 (XT: Harddisk) + 07 | Bytecount Kanal 3 (Pageregister 82H) + 08 | Read: DMA-Status (D4..D7:1 = DREQ liegt an, D0..D3:0 = Kanal Busy) + | Write: DMA-Command: + | D0 1 = memory<-->memory transfer enabled + | D1 Falls D0 = 1: 1 = Kanal 0 Adresse INCR/DECR, 0 = Adr. unverndert + | D2 1 = DMA-Control enabled + | D3 1 = R/W-Signal verkrzt + | D4 0 = Feste Kanalprios, 1 = Kanalprios rotieren + | D5 Falls D3 = 0, 1 = verzgertes R/W-Signal, 0 = verlngertes R/W + | D6 1 = DREQ active-low, 0 = DREQ active-high + | D7 1 = DACK active-high, 1 = DACK active-low + 09 | Read/Write: Anforderungsregister + | D1, D0 = Nummer des aktiven DMA-Kanals + | D2 1 = DMA-Transfer anstossen, (D0/D1 = Kanalnummer) + | 0 = DMA-Transfer wurde per Hardware angestossen + 0A | Read/Write : Single Mask Register Bit + | D0..D3 fr jeden Kanal: 1 = DREQ gesperrt, 0 = DREQ freigegeben + 0B | Write: Mode-Register + | D1, D0 bestimmen den Kanal auf den sich D2..D7 beziehen (0..3) + | D3, D2 (falls D6=D7=1 (Kaskade) ohne Bedeutung) + | 0 0 Prfzyklen + | 0 1 Write in Memory + | 1 0 Read aus Memory + | 1 1 Illegal + | D4 1 = Autorepeat + | D5 1 = DECR Adressen, 0 = INCR Adressen + | D7, D6 + | 0 0 Polling + | 0 1 Cycle Steal + | 1 0 Burst Mode + | 1 1 Kaskadierter Controller + 0C | Clear Byte Pointer Flip-Flop + 0D | Read: Temporary-Register, Write: Master Clear + 0E | Clear Mask Register + 0F | Write: All Mask Register + | + | Interrupt-Controller 1 (Master) 8259, siehe Datenblatt + 20 | Write: ICW1, OCW2, OCW3, Read: ISR, IRQ-Level (Je nach Zustand) + 21 | Write: ICW2, ICW3, ICW4, OCW1, Read: IMR (Je Nach Zustand) + | + | Intervall-Timer 8254.2 + 40 | Channel 0 Timeconstant (System Interrupt IRQ 0) + 41 | Channel 1 Timeconstant (Refesh Request) + 42 | Channel 2 Timeconstant (Speaker Output) + 43 | Control (Channel 0..2) + | + | KEYBOARD + 60 | Keyboard Data Read/Write + 61 | System Control Port (In/Out Port) + | Write: + | D0 = Speaker Gate + | D1 = Speaker Data + | D2 = Base Parity Check (<512k), 0 = Parity Check erlaubt + | D3 = Channel Parity Check (>=512k), 0 = Parity Check erlaubt + | Read: + | D4 = 1 = Refresh Detected + | D5 = 1 = Output Timer 2 + | D6 = 1 = IO-RAM Parity Error + | D7 = 1 = Base-RAM Parity Error + 64 | Keyboard Command/Status Port + | Write (Command): + | Command C0H liest Input Port, Byte im Datenregister ist dann: + | D4 : 0 = 2nd 256k Board-RAM disabled + | D5 : 0 = Manufacturing Jumper installed + | D6 : 1 = Primary Display is Monochrome, 0 = Color + | D7 : 0 = Keyboard is inhibited + | Command D0H liest Output Port, Byte im Datenregister ist dann: + | D0 : 0 = System Reset + | D1 : Gate A20 (AND-Verknpfung mit A20-Adressleitung) + | D4 : Output-Buffer full + | D5 : Input-Buffer empty + | D6 : Keyboard clock (output) + | D7 : Keyboard data (output) + | D1H schreibt Output Port, sonst wie D0H + | Read (Status): + | D0 : 1 = Outputbuffer is filled (Keyboard --> Computer) + | D1 : 0 = Inputbuffer is empty + | D2 : System-Flag + | D3 : Last Write: 1 = Command, 0 = Data + | D4 : 0 = keyboard is inhibited + | D5 : 1 = Transmit-Timeout Error + | D6 : 1 = Receive-Timeout Error + | D7 : 1 = Parity Error (Receive) + | + | RTC/RAM + 70 | CMOS-Adresse, NMI-Mask + | D0..D5 = CMOS-Adresse (0..63) + | D7 : 0 = NMI enabled, 1 = NMI disabled (Power-Fail, Parity-Check, NP) + | RTC-Adressen: + | 00 : Seconds + | 01 : Alarm Seconds + | 02 : Minutes + | 03 : Alarm Minutes + | 04 : Hours + | 05 : Alarm Hours + | 06 : Day of week (1..7) + | 07 : Date of Month + | 08 : Month + | 09 : Year (32H = Century) + | 0A : Status Register A : Bit 7 = 1 Update in progress + | 0B : Status Register B : Bit 5 = 1 Alarm Interrupt enabled + | Bit 0 = 1 Sommerzeit (Ende Mai..Ende Okt.!) + | 0C : Status register C : Bit 7 = 1 Interrupt occured + | 0D : (Read!) Bit 7 = 1 Power Good + | RAM-Adressen: + | 0E : Diagnostic Status Byte + | D7 : 1 = RTC lost power + | D6 : 1 = CMOS Checksum wrong + | D5 : 1 = Primary Display not set/No Diskette attached + | D4 : 1 = Memory Size miscompare (Vorhanden <> Setup-angegeben) + | D3 : 1 = Fixed Disk (Drive C) not ok + | D2 : 1 = RTC Time/Status nicht gltig + | 0F : Shutdown Status Byte (Restart Code) + | 0 = Power on Reset + | 9 = Enter Real Mode: + | TESTPORT = 32, Stack (SS=0469,SP=0467) RET-Adr., PUSHA, ES, DS + | 10 : Diskette configuration: + | D4..D7 : 0 = Not installed + | 1 = 48 tpi (double sided) Drive A + | 2 = 96 tpi (high capacity) + | D0..D3 : 0 = Not installed + | 1 = 48 tpi (double sided) Drive B + | 2 = 96 tpi (high capacity) + | 12 : Fixed Disk configuration: + | D4..D7 : 0 = Not installed + | 1..14 Tabelle Drive C + | 15 = Typ 16..47 spezifiziert + | D0..D3 : 0 = Not installed + | 1..14 Tabelle Drive D + | 15 = Typ 16..47 spezifiziert + | + | + | 14 : Equipment Byte (only for Power on Diagnostics) + | D6/D7 : 0 = 1 Floppy + | 1 = 2 Floppys + | D4/D5 : 0 = No Primary Display + | 1 = Color 40 Zeichen + | 2 = Color 80 Zeichen + | 3 = Monochrome + | D1 : 1 = Mathe Coprozessor installed + | D0 : 1 = Disk drives are installed + | + | 15/16 : Base Memory Size (in KB) + | 15 = low, 16 = high + | + | 17/18 : Expansion Memory Size (in KB) + | 17 = low, 18 = high + | + | 2E/2D Checksum der Adressen 10..20 + | 2E = high, 2F = low + | + | 30/31 : Expansion Memory Size (in KB ber ersten 1MB) + | 30 = low, 31 = high + | + | 32 : Date Century Byte (19) + | + | 33 : Information Flag + | + 71 | CMOS-Daten (Read/Write) + | + | Memory Mapper 74LS612 + 80 | Test-Port (Read/Write) Fehlerstatus der letzten Testoperation + 81 | Channel 2 DMA-Pageregister + 82 | Channel 3 DMA-Pageregister + 83 | Channel 1 DMA-Pageregister + 84 | frei + 85 | frei + 86 | frei + 87 | Channel 0 DMA-Pageregister + 88 | frei + 89 | Channel 6 DMA-Pageregister + 8A | Channel 7 DMA-Pageregister + 8B | Channel 5 DMA-Pageregister + 8C | frei + 8D | frei + 8E | frei + 8F | Refresh Register + | + | Interrupt-Controller 2 (Slave) 8259, siehe Datenblatt + A0 | Write: ICW1, OCW2, OCW3, Read: ISR, IRQ-Level (Je nach Zustand) + A1 | Write: ICW2, ICW3, ICW4, OCW1, Read: IMR (Je Nach Zustand) + | + | DMA Controller 2 (8237A-5) fr Wordtransfers (Kanal 5..7) + C0 | Wordadresse (start/current) Kanal 4 (Kaskade fr Controller 1) + C2 | Wordcount Kanal 4 + C4 | Wordadresse (start/current) Kanal 5 (frei) + C6 | Wordcount Kanal 5 (Pageregister 8BH) + C8 | Wordadresse (start/current) Kanal 6 (frei) + CA | Wordcount Kanal 6 (Pageregister 89H) + CC | Wordadresse (start/current) Kanal 7 (frei) + CE | Wordcount Kanal 7 (Pageregister 8AH) + D0 | Read: DMA-Status (D4..D7:1 = DREQ liegt an, D0..D3:0 = Kanal Busy) + | Write: DMA-Command: + | D0 1 = memory<-->memory transfer enabled + | D1 Falls D0 = 1: 1 = Kanal 4 Adresse INCR/DECR, 0 = Adr. unverndert + | D2 1 = DMA-Control enabled + | D3 1 = R/W-Signal verkrzt + | D4 0 = Feste Kanalprios, 1 = Kanalprios rotieren + | D5 Falls D3 = 0, 1 = verzgertes R/W-Signal, 0 = verlngertes R/W + | D6 1 = DREQ active-low, 0 = DREQ active-high + | D7 1 = DACK active-high, 1 = DACK active-low + D2 | Read/Write: Anforderungsregister + | D1, D0 = Nummer des aktiven DMA-Kanals + | D2 1 = DMA-Transfer anstossen, (D0/D1 = Kanalnummer) + | 0 = DMA-Transfer wurde per Hardware angestossen + D4 | Read/Write : Single Mask Register Bit + | D0..D3 fr jeden Kanal: 1 = DREQ gesperrt, 0 = DREQ freigegeben + D6 | Write: Mode-Register + | D1, D0 bestimmen den Kanal auf den sich D2..D7 beziehen (4..7) + | D3, D2 (falls D6=D7=1 (Kaskade) ohne Bedeutung) + | 0 0 Prfzyklen + | 0 1 Write in Memory + | 1 0 Read aus Memory + | 1 1 Illegal + | D4 1 = Autorepeat + | D5 1 = DECR Adressen, 0 = INCR Adressen + | D7, D6 + | 0 0 Polling + | 0 1 Cycle Steal + | 1 0 Burst Mode + | 1 1 Kaskadierter Controller + D8 | Clear Byte Pointer Flip-Flop + DA | Read: Temporary-Register, Write: Master Clear + DC | Clear Mask Register + DE | Write: All Mask Register + | + | Coprozessor + F0 | Clear Coprozessor Busy + F1 | Reset Coprozessor (mit D0..D7 = 0) und in Real Mode bringen) + | + F8 | Coprozessor Ports (vom 80286 vorgegeben) + ...| + FF | + | +-----+--------------------------------------------------------------------- + | + | Harddisk WD1010 +01F0 | Read/Write: Daten (am besten per DMA uebertragen) +01F1 | Write: Taskfile Byte 1 (Write Precomp DIV 4, 6 Bit) + | Read : Error Register + | D0..D7 <> 1 : Fehler aufgetreten +01F2 | Write: Taskfile Byte 2 (Sector Count 8 Bit) +01F3 | Write: Taskfile Byte 3 (Sector Number 6 Bit) +01F4 | Write: Taskfile Byte 4 (Cylinder low 8 Bit) +01F5 | Write: Taskfile Byte 5 (Cylinder high 2 Bit D6,D7) +01F6 | Write: Taskfile Byte 6 + | D0..D3 = Head + | D4 : 0 = Drive C, 1 = Drive D + | D5 : 1 = 512 Bytes/Sektor, 0 = 256 Bytes/Sektor + | D6 : + | D7 : 1 = ECC versuchen +01F7 | Write: Taskfile Byte 7 (Commandbyte, Retries) + | D0 : 1 = No Retries + | D1 : 1 = 4 ECC Bytes uebrtragen + | D2 : + | D3 : + | CMD: 7654 Funktion + | 0000 + | 0001 Recalibrate + | 0010 Read + | 0011 Write + | 0100 Verify + | 0101 Format Taskfile Byte 3: Gap + | 0110 + | 0111 Seek + | 1000 + | 1001 D0 = 1: Set Parameters, D0 = 0 : Diagnostics + | 1010 + | 1011 + | 1100 + | 1101 + | 1110 + | 1111 + | Read : Status Register + | D7 : 1 = BUSY + | D6 : 1 = Not ready + | D5 : Write fault + | D4 : Seek not complete + | D3 : 1 = Request Data + | D2 : 1 = Data corrected + | D1 : 1 = + | D0 : 1 = +01F8 | Datenport Read/Write +01F9 | Write: Reset + | Read: Statusport +01FA | Write: Select +01FB | Write: DMA/IRQ Maskenregister + | + | Game Connector +0200 | +0201 | Write: Start Monoflops + | Read: + | D0..D3 : Ausgnge der 4 Monoflops Zeit = (24.2 + 0.011 * R(kOhm))us. + | D4..D7 : Auslsetasten (nicht entprellt) +0202 | Nicht verwendet, aber ausdekodiert + ... | +0207 | + | + | Printer 2 (LPT2) +0278 | Write: Daten (Read latched write data) +0279 | Read/Write: + | D3 : -ERROR + | D4 : -SLCT in + | D5 : PE + | D6 : -ACK + | D7 : BUSY +027A | D0 : -STROBE + | D1 : -AUTOFEED + | D2 : INIT + | D3 : -SLCT out + | D4 : IRQ Mask +027B | N.C. + ... | +027F | + | +02F8 | RS232C Adapter (COM2) wie COM1 (03F8..03FF) +... | Generiert IRQ 3 +02FF | + | +0300 | Prototype Card + ... | +031F | + | + | Printer 1 (LPT1, wie 03B8..03BA) +0378 | Write: Daten (Read latched write data) +0379 | Read/Write: + | D3 : -ERROR + | D4 : -SLCT in + | D5 : PE + | D6 : -ACK + | D7 : BUSY +037A | D0 : -STROBE + | D1 : -AUTOFEED + | D2 : INIT + | D3 : -SLCT out + | D4 : IRQ Mask +037B | N.C. + ... | +037F | + | + | SDLC, bisync 2 + | 0380..0383 = 8255 : Parallel Ports +0380 | Port A - Read + | D0 : 0 = Rufzeichen liegt an (RI) + | D1 : 0 = Trgerfrequenzkennung liegt an (DCD) + | D2 : TXCLK (Diagnostic) + | D3 : 0 = Sendebereitschaft liegt an (CTS) + | D4 : RXCLK (Diagnostic) + | D5 : 1 = Modemstatusnderung (DSR changed) + | D6 : 1 = Timer 2 Output active + | D7 : 1 = Timer 1 Output active +0381 | Port B - Write + | D0 : 0 = Baudrateselektor ein + | D1 : 0 = Auswahlbereitschaft ein + | D2 : 0 = Prfung einschalten + | D3 : 1 = Reset Modemstatusnderungs Flip-Flop + | D4 : 1 = Reset 8273 + | D5 : 1 = Timer 2 durchschalten + | D6 : 1 = Timer 1 durchschalten + | D7 : 1 = IRQ 4 aktivieren +0382 | Port C - D0..D3 Write, D4..D6 Read, D7 N.C. + | D0 : 1 = Internen Takt durchschalten + | D1 : 1 = Externen Takt durchschalten + | D2 : 1 = Elektronischer Test + | D3 : 0 = IRQ 3 + 4 durchschalten + | D4 : RX Daten + | D5 : Timer 0 Output + | D6 : 0 = Prfanzeige aktiv +0383 | 8255 Modussteuerregister + | + | 0384..0387 = 8253: Timer +0384 | Timer 0 low/high. Ausgang ist Eingang von Timer 2 (Bit 5 in 0382) +0385 | Timer 1 low/high. Timeout Counter +0386 | Timer 2 low/high. Timeout Counter +0387 | 8254 Modusregister + | + | 0388..038C = 8273 SDLC Controller +0388 | Read: Statusregister + | Write: Befehlsregister +0389 | Read: Ergebnisregister + | Write: Parameterregister +038A | DMA/Interrupt Register fr Empfangen +038B | DMA/Interrupt Register fr Senden +038C | Datenport Read/Write + | 8273 Registerbeschreibung: + | Moderegister (Bit D6..D7 whlt Counter auf den sich D0..D5 beziehen) + | D0 : 0 = Counter 16 Bit Binr + | 1 = Counter 4 Dekad. BCD + | D1..D3 : Modus 0..5 (D7 = 1) + | D4..D5 : D54 + | 00 = Counter stop + | 01 = read/write highbyte + | 10 = read/write lowbyte + | 11 = erst low, dann highbyte read/write + | D6..D7 : Counter auswhlen (00=0, 01=1, 10=2, 11=3) + | + | Betriebsarten Register + | D0 : 1 = Kennzeichenmodus + | D1 : 1 = Sync fr 2. Header + | D2 : 1 = Buffer Modus + | D3 : 1 = Vorzeitigen Sendeinterrupt aktivieren + | D4 : 1 = EOP IRQ aktivieren + | D5 : 1 = MDLC Abbruch aktivieren + | + | Serial I/O Moderegister + | D0 = 1 : NRZI Modus + | D1 = 1 : Clock Loopback + | D2 = 1 : Data Loopback + | + | Transmit Moderegister + | D0 = 1 : Datenbertragung unterbrechen + | + | Singlebit Delay Modusregister + | D7 = 1 : Singlebit delay aktivieren + | +038D | N.C. + ... | +038F | + | + | +03A0 | bisync 1 + ... | wie 0380..038F +03AF | + | + | Hercules komp. Mono/Graphik Karte + | Mit * gekennzeichnete Bits sind nicht auf allen Karten verfgbar. +03B4 | Indexport 6845 (Videocontroller) + | Write: Register Nummer 0..17 +03B5 | Datenport 6845 : Register (Write only, sofern nichts anderes vermerkt) + | 0: D0..D7 = Anzahl Zeichen pro Zeile -1 (Horizontalfreq.) + | 1: D0..D7 = Anzahl dargestellte Zeichen pro Zeile + | 2: D0..D7 = Zeichenposition-1 des HSYNC Signals + | 3: D0..D3 = Breite-1 des HSYNC Signals in Zeichen + | 4: D0..D6 = Anzahl Zeichenzeilen (Vertikalfreq. 50/60 Hz) + | 5: D0..D4 = Bilddurchlauf Abgleich in Mikrozeilen + | 6: D0..D6 = Anzahl dargestellte Zeichenzeilen + | 7: D0..D6 = Zeichenzeile, bei der VSYNC Signal beginnt + | 8: D0 = 0 : Kein Zeilensprungverfahren + | = 1 und D1 = 0 : Zeilensprungverfahren, normale Dichte + | =1 und D1 = 1 : Zeilensprungverfahren, doppelte Dichte + | 9: D0..D4 = Mikrozeilen/Zeichen-1 + | 10: D0..D4 = Startmikrozeile des Cursors + | D5/D6 = 0 : Cursor normal, blinkend + | 1 : Cursor unsichtbar + | 2 : Cursor blinkt mit 1/16 der Vertikalfrequenz + | 3 : Cursor blinkt mit 1/32 der Vertikalfrequenz + | 11: D0..D4 = Endmikrozeile des Cursors + | 12: D0..D5 = Highbits der Speicherstartadresse + | 13: D0..D7 = Lowbits der Speicherstartadresse + | 14: D0..D5 = Highbits der aktuellen Cursorspeicheradresse (Read/Write) + | 15: D0..D7 = Lowbits der aktuellen Cursorspeicheradresse (Read/Write) + | 16: D0..D5 = Highbits der Speicherstelle, bei der LPSTB ausgelst + | 17: D0..D7 = Lowbits der Speicherstelle, bei der LPSTB ausgelst +03B8 | Write: Display Mode Control Port + | D1: 6845 muss nach einer nderung dieses Bits neu initialisiert werdem + | 0 : Text Mode (Zeichen 9 x 14, 0.5625us/Zeichen) + | 1 : Graphik Mode (Zeichen 4 x 16, 1us/Zeichen Horizontal) + | D3: 0 : Screen blanked (Bei Init 6845 auf 0 setzen) + | 1 : Screen activated + | D5: 0 : Textblinker (Attributbit 7 = 1) ausgeschaltet + | 1 : Textblinker angeschaltet + |*D6: 0 : 80 Spalten Modus (nur CT6040S) + | D7: 0 : Graphikpage 0 (B0000..B7FFF) + | 1 : Graphikpage 1 (B8000..BFFFF) +03B9 |*Write: Set Lightpen Flip-Flop (Eingang zum 6845 LPSTB) +03BA | Read: Display Status Port + | D0: 1 : HSYNC (Horizontal Retrace) luft gerade + |*D1: Ausgang des Lightpen Flip-Flop (LPSTB-Eingang 6845) + |*D2: 1 : Lightpen Taster gedrckt (Pin 3 des LP-Steckers) + | D3: Ausgang VIDEO zum Monitor (Dots on/off) + | D7: 1 : VSYNC (Vertical Retrace) luft gerade +03BB |*Write: Reset Lightpen Flip-Flop +03BC | Read: Latched Write Data + | Write: Printer Data D0..D7 (pin 2..9) +03BD | Read: Printer Status Port + | D3:0 : Printer Error (ERROR, pin 15) + | D4:0 : Printer deselected (SLCT, pin 13) + | D5:1 : Paper end (PE, pin 12) + | D6:1 : Ready for more (ACK, pin 10) + | D7:0 : Printer is busy (BUSY, pin 11) +03BE | Read (Latched Write Data) + | Write: Printer Control Port + | D0: Printer Strobe (0 = Strobe to Printer, 1 = Release Strobe) pin 1 + | D1: 0 = Autolinefeed after CR, 1 = CR, LF (Programm) pin 14 + | D2: 0 = Init Printer (pin 16), 1 = Release Init + | D3: 0 = Deselect Printer (SLCT, pin 17), 1 = Select Printer + | D4: 0 = Mask IRQ7 off, 1 = IRQ7 (ACK Flanke) mask on +03BF |*Read LPSTB extension Adress (Im Graphikmodus) + |*D0..D3 = xpos Dots MOD 16 + |*D4: Dotclk 74112 (U58) + |*D5..D6 = ypos Dots MOD 4 + |*D7: Aktive Graphikseite + | Write: Configuration Switch + | D0: Bit 1 03B8 AND-Mask (0: Kein Graphikmode einschaltbar) + | D1: Bit 7 03B8 AND-Mask (0: Keine Graphikseite 1 einschaltbar) + | (falls 0: B8000..BFFFF auf Graphikkarte abgeschaltet) + | + | + | CGA (Color Graphics Adapter) +03D4 | 6845 Index Register (siehe 03B4) +03D5 | 6845 Data Register (siehe 03B5) +03D8 | + | D0 : 1 = 80x25 + | 0 = 40x25 + | D1 : 1 = 320x200 Graphikmodus + | 0 = Alphanumerisch Text + | D2 : 1 = S/W + | 0 = Color + | D3 : 0 = Screen blanked + | D4 : 1 = 640x200 S/W Modus + | D5 : 1 = Blinken statt Intensittsbit (Bit 3) + | 0 = Intensittsbit fr 16 statt 8 Farben (2 Helligkeiten) +03D9 | Write: Paletteregister + | D0 : Blau + | D1 : Grn + | D2 : Rot + | D3 : Intensity + | D4 : 1 = Intensivfarbsatz im Graphikmodus + | D5 : 1 = Farbsatz 320x200 Modus aktivieren +03DA | Read: Statusregister + | D0 = HSYNC (Anzeige aktiviert) + | D1 = Lightpen Strobe Flip-Flop Ausgang + | D2 = Lightpentaster gedrckt + | D3 = VSYNC +03DB | Write: Reset Lightpen Flip-Flop +03DC | Write: Set Lightpen Flip-Flop + | + | + | Diskettencontroller uPD 765 +03F2 | DIGOR (Digital Output Register) - Write + | D0..D1 : Laufwerk 00 = A, 01 = B, 10 = C, 11 = D + | D2 : 0 = RESET Signal aktiviert, 1 = RESET aus + | D3 : 1 = DMA und IRQ aktivieren + | D4..D7 : 1 = Motor fr Laufwerk A..D einschalten +03F4 | Hauptstatusregister - Read + | D0..D3 : Laufwerk A..D seeked noch + | D4 : 1 = BUSY + | D5 : 1 = DMA nicht aktiv + | D6 : 1 = Prozessor liest Datenregister, 0 = Prozessor schreibt Datenr. + | D7 : 1 = Register bereit fr Datentransfer +03F5 | Diskettensteuerungsdatenregister - Write + | D0..D7 : Command + | C5 = write (hd+drv.b,cyl.b,frst_sec.b,byte_p_sec.b,last_sec.b, + | gap.b, dtl.b) + | E6 = read (hd+drv.b,cyl.b,frst_sec.b,byte_p_sec.b,last_sec.b, + | gap.b, dtl.b) + | 4D = format (byte_p_sec.b, last_sec.b, gap.b, dtl.b) + | hd+drv.b : D5..D2 = Head, D1..D0 = Drive + | Nach jedem Kommando kann solange BUSY=1 ist, ein Statusbyte bei + | 03F5 abgeholt werden (warten bis D6=1 und D7=1 in 03F4). + | Status: + | D7 = rnf, timeout + | D6 + | D5 = crc error + | D4 = dma error + | D3 + | D2 = rnf + | D1 = write protected + | D0 = bad addr mark + | +03F6 | Harddisk Control Register + | D7 : 1 = Disable Retries + | D6 : 1 = Kein ECC bei Fehler + | D5 : + | D4 : + | D3 : 1 = Falls anz. Heads > 8 + | D2 : 1 = RESET KONGO CARD (wieder auf 0 setzen) + | D1 : + | D0 : + | +03F7 | DIGIR (Digital Input Register) - Read + | D7 : 1 = Media changed + | + | + | RS232C Adapter 8250 (COM1) Generiert IRQ 4 +03F8 | DLAB = 0 + | Read: Receivebuffer (RBR = receive buffer register) + | Write: Transmitbuffer (THR = transmit holding register) + | DLAB = 1 : Read/Write: Divisor Latch LSB Read/Write +03F9 | DLAB = 1 : Read/Write: Divisor Latch MSB Read/Write + | Baud = 115200/divisor (clk = 1.8432 MHz DIV 16) + | DLAB = 0 : Interrupt Enable Register (IER) Read/Write + | Bit = 1: Interrupt enabled, Bit=0: Interrupt disabled + | D0: Receive Char Interrupt + | D1: Transmitter empty Interrupt + | D2: Receiver Line Status Interrupt (Framing, Parity, Overrun, Break) + | D3: Modem Status Interrupt (CTS, DSR, RI, DCD changed) + | D4..D7 = 0 +03FA | Interrupt Identification Register (IIR) Read/Write + | Prios: 1=Receiver Line Status, RX available, THR empty, 4=Modem Status + | D0 = 0: Interrupt pending + | D1..D2: Interrupt source (falls D0 = 0) + | Prio D21 Source Cleared by + | 1 01 Overrun, Parity, Framing, Break Read LSR + | 2 10 Receive data available Read RBR + | 3 11 THR empty Read IIR oder Write THR + | 4 00 CTS, DSR, RI, RLSD changed Read MSR +03FB | Line Control Register (LCR) Read/Write + | D0..D1 : Wordlength (00=5, 01=6, 10=7, 11=8 Datenbits) + | D2 : 0 = 1 Stopbit + | 1 = 1.5 Stopbits, falls 5 Datenbits, 2 Stopbits sonst + | D3 : 1 = Parity generate & check enabled + | D4 : Falls D3 = 1 : 0 = Odd Parity, 1 = Even Parity + | D5 : Falls D3 = 1 und D5 = 1: 0 = Parity Mark, 1 = Parity Space + | D543 Funktion + | 000 Kein Parity + | 001 Odd Parity + | 010 Kein Parity + | 011 Even Parity + | 100 Kein Parity + | 101 Parity stuck on (1 = Mark) + | 110 Kein Parity + | 111 Parity stuck off (0 = Space) + | D6 : 1 = Send Break (Muss wieder auf 0 gesetzt werden) + | D7 : DLAB = 1 : Baudrate Divisor Latch Access ueber 0XF8/0XF9 +03FC | Modem Control Register (MCR) + | D0: 1 = DTR aktiv + | D1: 1 = RTS aktiv + | D2: 1 = OUT1 aktiv (Pin 34) + | D3: 1 = OUT2 aktiv (Pin 31) + | D4: 1 = Diagnostic Mode: + | TX-Out --> RX-In (Local Loopback) + | RTS->CTS, DTR->DSR, OUT1->DCD, OUT2->RI internally connected + | Interupts lassen sich mit D0..D3 des MCR, bzw. D0..D5 des LSR + | auslsen (dann Bits wieder auf 0 und MCR auf 0). +03FD | Line Status Register (LSR) Read/Write + | D0: 1 = Character Received Interrupt 2 + | D1: 1 = Receiver Overrun Error Interrupt 1 + | D2: 1 = Parity Error Interrupt 1 + | D3: 1 = Framing Error Interrupt 1 + | D4: 1 = Break detected Interrupt 1 + | D5: 1 = Transmitter Holding register empty Interrupt 3 + | D6: 1 = Transmitter complete cleared (THR & TSR empty) + | D7: 0 +03FE | Modem Status Register (MSR) Read/Write + | D0: 1 = CTS changed since last MSR read Interrupt 4 + | D1: 1 = DSR changed since last MSR read Interrupt 4 + | D2: 1 = RI changed from active to inactive Interrupt 4 + | D3: 1 = DCD changed since last MSR read Interrupt 4 + | D4: CTS input (Diagnostic: RTS) + | D5: DSR input (Diagnostic: DTR) + | D6: RI input (Diagnostic: OUT1) + | D7: DCD input (Diagnostic: OUT2) +03FF | Reserviert + | diff --git a/system/shard-x86-at/7/src/ATSHARD.ASM b/system/shard-x86-at/7/src/ATSHARD.ASM new file mode 100644 index 0000000..f2f198c --- /dev/null +++ b/system/shard-x86-at/7/src/ATSHARD.ASM @@ -0,0 +1,156 @@ + page 80,132 +title AT-SHard, Copyright (C) 1985, 86 Martin Schoenbeck, Spenge +;****************************************************************************** +;* * +;* S H A R D - M O D U L * +;* * +;* fuer EUMEL auf 80286 Systemen * +;* * +;* SHard Version 7-PC/AT * +;* * +;* Copyright (C) 1985, 86 Martin Schoenbeck, Spenge * +;* * +;****************************************************************************** + +at equ 1 +gensys equ 0 +ramsys equ 0 +pcxt equ 0 +pcd equ 0 +kompatible equ 0 +romharddisk equ 0 +romfloppy equ 0 +limited_to_360 equ 0 +boot_size equ 0 + +hdsystem equ 1 +withhd equ 1 + +setup_channel equ 28 +dos_channel equ 29 + +shard group code +code segment word public 'code' + assume cs:shard, ds:shard, es:nothing, ss:nothing + +shstart: + jmp los_gehts + + even + + include MACROS.ASM + include MAC286.ASM + include DEVICE.ASM + include EUCONECT.ASM + org 0a0h ;bei wort 80 beginnen + include PATCHARE.ASM + + include SHMAIN.ASM + +IBMat equ 0fch +com1base equ 03f8h +com1irq equ 4 +com2base equ 02f8h +com2irq equ 3 +com3base equ 03e8h +com3irq equ 3 +com4base equ 82f8h +com4irq equ 7 +com4_1base equ 02c0h +com4_1irq equ 3 +com4_2base equ 02c8h +com4_2irq equ 3 com4_3base equ 02d0h +com4_3irq equ 3 +com4_4base equ 02d8h +com4_4irq equ 3 +com8_1base equ 02e0h +com8_1irq equ 3 +com8_2base equ 02e8h +com8_2irq equ 3 +com8_3base equ 02f0h +com8_3irq equ 3 +com8_4base equ 02f8h +com8_4irq equ 3 +para1base equ 3bch +para1irq equ 7 + +int_ctlr equ 20h +first_ictlr_int equ 8 + +channel macro number,dev,ccb +channels = channels+1 +selectentry = 5 + db number + dw offset ccb + if2 + dwb paramstart_,%&dev + else + dw 0 ;;weil in pass eins device evtl. unbekannt + endif + endm + +selecttable: + db channels ;anzahl kanaele hier setzen +channels = -1 ;nilchannel vorab abziehen + channel 32,shardchannel,0 + channel 0,fixdisk,hgccb0 +alterable_channels: + channel 1,pc,0 + channel 2,i8250,com1ccb + channel 3,i8250,com2ccb + channel 4,i8250,com4_1ccb + channel 5,i8250,com4_2ccb + channel 6,i8250,com4_3ccb + channel 7,i8250,com4_4ccb + channel 8,i8250,com8_1ccb + channel 9,i8250,com8_2ccb + channel 10,i8250,com8_3ccb + channel 12,parallel,para1ccb + channel 28,fixdisk,hgccb1 + channel 29,fixdisk,hgccb2 + channel 31,archive,archive_0 + channel 30,archive,archive_1 + channel -1,nilchannel,0 + include I8250.ASM + include PCPAR.ASM + include STREAM.ASM + include NILCHAN.ASM + include PCSCREEN.ASM + include PCPLOT.ASM + include PCSYS.ASM + include FIXDISK.ASM + include FLOPPY.ASM + include CLOCK.ASM + include WAIT.ASM + include HARDWARE.ASM + include BLOCKERR.ASM + + i8250_ccb com1,2 + i8250_ccb com2,3 + i8250_ccb com4_1,4 + i8250_ccb com4_2,5 + i8250_ccb com4_3,6 + i8250_ccb com4_4,7 + i8250_ccb com8_1,8 + i8250_ccb com8_2,9 + i8250_ccb com8_3,10 + para_ccb para1,12 + ;erlaubt drivetypen: highdensity, drive720 + archive_ccb 0,highdensity + archive_ccb 1,0 + fix_ccb 0 + fix_ccb 1 + fix_ccb 2 + +sysmove: + rep movsw + jmp systemstart + + include BOOT.ASM + +code ends + + end los_gehts + + + diff --git a/system/shard-x86-at/7/src/BLOCKERR.ASM b/system/shard-x86-at/7/src/BLOCKERR.ASM new file mode 100644 index 0000000..fb17016 --- /dev/null +++ b/system/shard-x86-at/7/src/BLOCKERR.ASM @@ -0,0 +1,82 @@ +;**************************************************************************** +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================* +;* * +;* Dieses Modul enthaelt Routinen zur Uebergabe von Fehlermeldungen * +;* nach Blockin/Blockout * +;* * +;* blockerr erwartet dabei folgende codes in ah: * +sense_fail equ 0ffh ; sense operation +blnrhigh equ 0feh ; block number to high +write_fault equ 0cch ; +not_rdy equ 0aah ; drive not ready +undef_err equ 0bbf ; undefined error occurred +time_out equ 80h ; attachment failed to respond +bad_seek equ 40h ; seek operation failed +bad_cntlr equ 20h ; controller has failed +data_corrected equ 11h ; ecc corrected data error +bad_ecc equ 10h ; bad ecc on disk read +bad_crc equ 10h ; crc error on sector +bad_track equ 0bh ; bad track flag detected +bad_sect equ 0ah ; sector marked bad +dma_boundary equ 9 ; attempt to dma across 64k +bad_dma equ 8 ; dma failed +init_fail equ 7 ; drive parameter activity failed +bad_reset equ 5 ; reset failed +record_not_fnd equ 4 ; requested sector not found +write_protect equ 3 ; disk write protected +bad_addr_mark equ 2 ; address mark not found +bad_cmd equ 1 ; bad command passed to disk i/o +;* * +;**************************************************************************** + +blockerr: + pop bp ;return adresse holen + pop dx ;ds:bx vom stack putzen + pop dx + mov bx,offset messagetable ;tabelle mit meldungen holen + mov dh,0 ;laengenangaben sind nur ein byte +err_loop: + mov al,byte ptr [bx] ;fehlerschluessel holen + inc bx + cmp al,ah ;war das der gesuchte + jz err_found ;ja + inc al ;oder ende der tabelle + jz err_found ;ja + inc bx ;auf laengenbyte + mov dl,byte ptr [bx] ;laenge holen + add bx,dx ;adresse des naechsten textes + inc bx ;und ueber laengenbyte rueber + jmp err_loop + +err_found: + mov cl,byte ptr [bx] + mov ch,0 ;nur ein byte fehlercodes + inc bx ;auf textlaenge gehen + push cs ;adresse fehlermeldung drauf + push bx + jmp bp + +highblock: + mov ah,blnrhigh ;meldung blocknummer zu hoch + jmp blockerr + +err_mess macro code,eucode,mess +local m_end + db code,eucode,m_end-$-1,mess +m_end: + endm + +messagetable: + err_mess blnrhigh,3,'blocknummer zu hoch' + err_mess not_rdy,1,'not ready' + err_mess bad_crc,2,'crc err' + err_mess bad_sect,2,'bad sect' + err_mess record_not_fnd,2,'rec not fnd' + err_mess dma_boundary,1,'dma boundary' + err_mess time_out,2,'timeout' + err_mess 0ffh,2,'undef_err_code' + + + + + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/BOOT.ASM b/system/shard-x86-at/7/src/BOOT.ASM new file mode 100644 index 0000000..e13c805 --- /dev/null +++ b/system/shard-x86-at/7/src/BOOT.ASM @@ -0,0 +1,426 @@ +;***************************************************************************** +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ===================* +;* * +;* Laden des EUMEL - Restsystems vom Archiv oder HG * +;* * +;***************************************************************************** + +; Versionsschluessel: +;2.2 enthaelt mehrere Partition, Floppy size = 0 bei start und fehler +;2.3 enhaelt Floppy mit Block 0 lesen immer erlaubt +;2.4 Drucker geht ueber rom, wenn adresse nicht ibmlike +; mehrere Drucker moeglich +; busy Abfrage kann verzoegert werden (Problem LQ1000) +; es werden nur die vorhandenen Schnittstellen angezeigt +; Lesezugriffe bis Block 6 auf Floppy werden immer erlaubt +;2.5 Hercules Karte wird unterstuetzt +; Bei AT werden schlechte sectoren statt spuren behandelt +;2.6 Fehler in Plattengre bei behoben (meldete immer al <> 0) +;2.7 Floppylogik fuer 1.7.3 restauriert, Floppy steht jetzt immer +; auf 360k, wenn keine Floppy erkannt wird, und der Urlader die +; HG-Version 1742 hat. +; die Schnittstellen der Addonics-Karte sind jetzt immer mit drin, +; wenn COM4 generiert sind. +; Die Druckerkanle liegen auf 15,14,16 +; Die Baudrateabfrage verneint auch 0 + +los_gehts: + cli +; achtung: es und si muessen bis zum einstellen der Festplatte +; unveraendert bleiben !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + mov ax,cs + mov ds,ax +; cs in vorlaeufige EUMEL Tabelle eintragen + mov bx,offset systemstart+2 + mov cx,eumel_cs_init_length +self_cs_init_loop: + mov word ptr [bx],ax + add bx,4 + loop self_cs_init_loop +; cs in SHard - Tabelle eintragen + mov bx,offset first_shard_cs_to_alter + mov cx,shard_cs_alter_length +shard_cs_init_loop: + mov word ptr [bx],cs ;put in my code segment + add bx,4 + loop shard_cs_init_loop +; berechnen, wohin der EUMEL spaeter soll + mov bx,offset lastbootbyte ;relativen paragraph ausrechnen + mov cl,4 + shr bx,cl + inc bx + add ax,bx ;hier soll spaeter der EUMEL hin + mov ss,ax + mov sp,0 + push si ;werte fuer plattensetup merken + push es +; warte routine fuer Platten und Floppytreiber eintragen + call device_init ;int 15 eintragen +; alle Kanaele initialisieren + mov dh,33 + mov al,0 +inilop: + mov cx,-2 + push ax + call control32 + pop ax + cli + inc al + dec dh + jnz inilop + sti ;interrupts sind erlaubt + mov bx,offset signon ;sag ihm, wer wir sind + call print +; alle kanaele fuer festplatte einstellen (falls vorhanden) + pop es + pop si ;zeiger auf partitiontabelle wiederholen + call setup_fix_disk +; EUMEL 0 laden +getagain: + ife gensys + mov al,31 ;zuerst von kanal 31 versuchen + mov bx,offset archtext + call geteumel + endif + mov al,0 + mov bx,offset hgtext + call geteumel + mov bx,offset noeutext + call print + call waitchar + jmp getagain + +geteumel: ;EUMEL 0 laden und bei Erfolg starten + push ax + mov cx,5 ;size + call cs:iocontrol + pop ax + push bx ;text fuer medium merken + mov cx,ss ;ausrechnen, wohin der urlader muss (ss:0) + add cx,31 ;damit wir nicht rueckwaerts gehen + and cx,0ffe0h ;auf 512 byte boundary + mov ds,cx ;segment nach ds + mov bx,0 ;bei 0 im segment laden wir zuerst + mov cx,0 ;auftrag + mov dx,10 ;erster urlader block ist 10 + mov ah,1 ;nur ein versuch + cmp al,0 + ifz ;hintergrund muss lesbar sein + push bx + push ds + call getblock + pop ds + pop bx + or cx,cx ;fehlerfrei? + jz firstok + pop bx ;text fuer medium vergessen + ret +firstok: + push ax + mov cx,5 ;text EUMEL hat 5 buchstaben + mov si,offset eutext ;text EUMEL + mov di,bx ;puffer +textloop: + lods byte ptr cs:[si] + cmp al,byte ptr ds:[di] + jz charok + pop ax ;stack saeubern + pop bx + ret ;nicht gleich, kein eumel urlader +charok: + inc di + loop textloop + pop ax ;kanal fuer urlader wiederholen + pop bx ;text fuer medium holen + call print ;ausgeben + mov bx,0 ;bx ist zerstoert, aber wir wissen, wohin + mov ah,8 ;ab hier mit acht versuchen +euloop: + mov cx,0 + inc dx + add bx,512 ;auf naechsten block schalten + push bx + push ds + call getblock + or cx,cx + jnz booterr + pop ds + pop bx + cmp dx,10+100 ;schon kompletten urlader gelesen + jnz euloop +; Sprungleiste vom EUMEL abholen + push cs + pop es ;ziel ist codesegment + mov si,0 + mov di,offset eumel0id + mov cx,eumel_leisten_laenge + cli + cld + rep movsb + mov ax,ds ;eumel codesegment nach ax + push cs ;datensegment wieder auf shard + pop ds +; und passendes cs eintragen + mov bx,offset systemstart+2 + mov cx,eumel_cs_init_length +eumel_cs_init_loop: + mov word ptr [bx],ax + add bx,4 + loop eumel_cs_init_loop + call paragraphs + sub dx,ax ;rest fuer eumel ausrechnen + if ramsys + urram equ 1000h + + sub dx,urram ;64k fuer urlader und paging + mov M3SIZE,dx + mov M0SIZE,urram + mov M0START,ax + add ax,urram + mov M3START,ax + else + mov M0SIZE,dx + mov M0START,ax ;eumel codesegment eintragen + endif + mov ax,31 ;allen floppies die chance geben +i173lop: ;sich auf 173 einzustellen + mov cx,-173 + push ax + call control32 + pop ax + dec al + jnz i173lop + mov bx,offset SHard_leiste + jmp systemstart + + +booterr: + push ds + push bx + mov bx,offset booterrtext + call print + pop bx + pop ds + call dsprint + jmp $ + +getblock: + push ax ;original ax merken +getloop: + push bx + push ds + push ax ;ax mit retry zaehler + mov cx,0 + call cs:blockin + pop ax + or cx,cx + jnz geterr + pop ds + pop bx + pop ax + ret +geterr: + dec ah ;genuegend retries + jnz getcontinue + pop ax ;kill ds + pop ax ;kill bx + pop ax ;altes ax holen + ret +getcontinue: + pop ds + pop bx + jmp getloop + +waitchar: + sti + mov byte ptr cs:waschar,0 +waitcloop: + cmp byte ptr cs:waschar,0 + jz waitcloop + ret + +iint proc far + cmp al,1 ;nur kanal 1 ist interessant + ifnz + mov byte ptr cs:waschar,1 + ret +iint endp + +waschar db 0 + +print: + push ds + push cs + pop ds + call dsprint + pop ds + ret + +dsprint: + push cx + push ax + mov cl,byte ptr [bx] ;laenge holen + inc bx ;auf text schalten + mov ch,0 + mov al,1 ;auf terminal 1 + call cs:output + pop ax + pop cx + ret + +setup_fix_disk: + if hdsystem + mov di,si ;si retten + mov dl,4 +eumel_partition_search_loop: + test byte ptr es:[si],80h ;aktivierte Partition + jnz eu_found + add si,10h + dec dl + jnz eumel_partition_search_loop +; keine EUMEL Partition, Sauerei +no_eu_part: + mov bx,offset no_eumel_partition_text + call print + sti + jmp $ + +eu_found: + cmp byte ptr es:[si+4],'E' ;EUMEL partition + jc no_eu_part + mov dx,es:[si+8] ;low word partition start holen + mov bx,es:[si+10] ;high word partition start holen + add dx,68 ;50k fuer shard etc. frei lassen + adc bl,0 + mov cx,-101 ;partition start einstellen + mov al,0 ;fuer HG + call control32 + mov cx,-100 ;dasselbe als groesse fuer Setup Kanal + mov al,setup_channel + call control32 + mov dx,es:[si+12] ;low word partition size holen + mov bx,es:[si+14] ;high word partition size holen + + if at + sub dx,68 ;platz fuer SHard + sbb bl,0 + sub dx,[bb_anz] ;platz fuer schlechte sectoren lassen + sbb bl,0 + else + sub dx,68+(2*68) ;das, was wir fuers SHard lassen, abziehen + ;und das, was fuer schlechte spuren bleiben muss + sbb bl,0 + endif + + mov cx,-100 ;size einstellen + mov al,0 ;fuer hg + call control32 +; DOS partition suchen + mov si,di ;si wieder holen + mov dl,4 +dos_partition_search_loop: + cmp byte ptr es:[si+4],1 ;DOS partition + jz dos_found + add si,10h + dec dl + jnz dos_partition_search_loop + xor dx,dx + mov bx,dx ;DOS Partition existiert nicht + jmp short dos_size +dos_found: + mov dx,es:[si+8] ;low word partition start holen + mov bx,es:[si+10] ;high word partition start holen + mov cx,-101 ;partition start einstellen + mov al,dos_channel ;fuer DOS + call control32 + mov dx,es:[si+12] ;low word partition size holen + mov bx,es:[si+14] ;high word partition size holen +dos_size: + mov cx,-100 ;size einstellen + mov al,dos_channel ;fuer DOS + call control32 + endif + ret + + if 0 + mov ax,0 + mov cx,5 + call cs:iocontrol ;get size of harddisk + if mit_msdos + mov bx,17068 + else + mov bx,100 ;50k freilassen + endif + sub cx,bx ;von size abziehen + cmp cx,0fd00h shr 1 ;bei mehr legt sich eumel auf den bauch + ifnc ;dann nur soviel, wie er kann + mov dx,cx ;in dx melden + mov cx,-100 ;set size + call control32 + ret + endif + +eutext: + db 'EUMEL' + +signon: + db booterrtext-$-1 + if pcd + db 1bh,5bh,'H',1bh,5bh,'2J' + db 13,10,10 + db 'Demo - SHard f',129,'r EUMEL auf Siemens PC-D, V 2.1' + db 13,10 + db 'Copyright (C) 1985,86 Martin Sch',148,'nbeck, Spenge' + db 13,10 + else + if gensys + db 13,10,10 + db 'Setup - SHard f',129,'r EUMEL' + db ' auf IBM PC,AT,XT und Kompatiblen V 2.7' + db 13,10 + db 'Copyright (C) 1985,86 Martin Sch',148,'nbeck, Spenge' + db 13,10 + else + if at + db 13,10,10 + db 'SHard f',129,'r EUMEL auf IBM PC/AT, V 2.7' + db 13,10 + db 'Copyright (C) 1985,86 Martin Sch',148,'nbeck, Spenge' + db 13,10 + else + db 13,10,10 + db 'ModSoft - SHard f',129,'r EUMEL' + db ' auf IBM-PC und Kompatiblen, Version 2.7' + db 13,10 + db 'Copyright (C) 1985,86 ModSoft, Martin Sch',148,'nbeck' + db 13,10 + endif + endif + endif + +booterrtext: + db archtext-$-1 + db 'Fehler beim Laden des Systems: ' + db 7 +archtext: + db hgtext-$-1 + db 'EUMEL wird vom Archiv geladen' + db 13,10 +hgtext: + db noeutext-$-1 + db 'EUMEL wird vom Hintergrund geladen' + db 13,10 +noeutext: + db no_eumel_partition_text-$-1 + db 'Kein EUMEL - System gefunden' + db 13,10 + db 'Bitte einlegen und Taste dr',129,'cken! ' +no_eumel_partition_text: + db endtext-$-1 + db 'Keine EUMEL Partition auf der Platte' + db 13,10 + db 'Bitte benutzen Sie Ihre Setup-Floppy zum Anlegen' +endtext: + +lastbootbyte: + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/CLOCK.ASM b/system/shard-x86-at/7/src/CLOCK.ASM new file mode 100644 index 0000000..b70f18e --- /dev/null +++ b/system/shard-x86-at/7/src/CLOCK.ASM @@ -0,0 +1,56 @@ +;**************************************************************************** +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================* +;* * +;* Lesen der Echtzeituhr des IBM PC-AT * +;* Schreiben dummy routine * +;* Aufruf: blockin/blockout mit code -4 ueber kanal 32 * +;* Puffer: ROW 7 INT VAR * +;* * +;**************************************************************************** + +clockread: + call hardware + cmp al,IBMat ;haben wir den IBM PC-AT + jnz no_clock + mov ah,4 ;read date + int 1ah + jc no_clock + mov al,ch ;jahrhundert + call putbcd ;ueber bx wegschreiben + mov al,cl ;jahr + call putbcd + mov al,dh ;monat + call putbcd + mov al,dl ;tag + call putbcd + mov ah,2 ;read time + int 1ah + jc no_clock + mov al,ch ;stunden + call putbcd + mov al,cl ;minuten + call putbcd + mov al,dh ;sekunden + call putbcd + mov cx,0 ;keine fehler + ret + +no_clock: + mov cx,-1 ;geht nicht + ret + +clockwrite: + mov cx,-1 + ret + +putbcd: + mov ah,al + and ah,0fh ;in al niedrige nibble behalten + ib shr al,4 ;rueberschieben + or ax,3030h ;ziffern draus machen + mov word ptr es:[bx],ax ;eintragen + inc bx + inc bx ;zum naechsten + ret + + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/DEVICE.ASM b/system/shard-x86-at/7/src/DEVICE.ASM new file mode 100644 index 0000000..0800a67 --- /dev/null +++ b/system/shard-x86-at/7/src/DEVICE.ASM @@ -0,0 +1,92 @@ +;*************************************************************************** +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================* +;* * +;* Macros zur Definition von devicetypecontrolblocks und * +;* bestimmten channelcontrolblock Eintraegen * +;* * +;*************************************************************************** + .xlist + +actualdevice = 0 + +device macro type + if1 + ifdef type + .printx * device type doppelt definiert * + endif + endif +actualdevice = actualdevice+1 +type = actualdevice + + endm + +routine macro code,execut + db code + dw offset execut + endm + +dtcbroutines macro type + ifidn , + buildlabel blockin_,%actualdevice + else + ifidn , + buildlabel blockout_,%actualdevice + else + ifidn , + buildlabel iocontrol_,%actualdevice + else + ifidn , + buildlabel control32_,%actualdevice + else + .printx * unbekannter routinentyp: '&type' in dctbroutine * + endif + endif + endif + endif + endm + +dtcbparams macro output,typ + buildlabel paramstart_,%actualdevice + dw offset output + dbbp blockin_,%actualdevice + dbbp blockout_,%actualdevice + dbbp iocontrol_,%actualdevice + dbbp control32_,%actualdevice +dtcbentry devtype + db typ + endm + +dtcbentry macro entry + xequat entry,%actualdevice + endm + +dwb macro first,second + dw offset first&second + endm + +dbbp macro first,second + db first&second-paramstart_&second + endm + +xequat macro entry,dev +entry = $-paramstart_&dev + endm + +buildlabel macro first,second +first&second: + endm + +startccb macro name,kanal +name: +actccb = $ +ccbentry channel_no + db kanal + endm + +ccbentry macro entry +entry = $-actccb + endm + + .list + + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/EUCONECT.ASM b/system/shard-x86-at/7/src/EUCONECT.ASM new file mode 100644 index 0000000..9d1133c --- /dev/null +++ b/system/shard-x86-at/7/src/EUCONECT.ASM @@ -0,0 +1,80 @@ +;======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ============= +;--------------------------------------------------------------------- + even + +eumel0id db 'EUMEL ' +eumel0blocks dw 100 +hgver dw 1742 +cputype dw 3 ; 8086 +urver dw 100 + dw 0 +shdvermin dw 7 +shdvermax dw 7 + dw 0 +systemstart dd dummy_ret +inputinterrupt dd iint +timerinterrupt dd dummy_ret +warte dd dummy_ret +grab dd dummy_ret +free dd dummy_ret +shutup dd dummy_ret +info dd dummy_ret +eumel_cs_init_length equ ($-systemstart)/4 +eumel_leisten_laenge equ $-eumel0id + +;--------------------------------------------------------------------- +; +; SHard-Leiste +; +;--------------------------------------------------------------------- + +SHard_leiste: +SHDID db 'SHard Schoenbeck' +SHDVER dw 7 + if withhd or at +MODE dw 0 + else +MODE dw 1 ;freieumel0 + endif +ID4 dw 4711 +ID5 dw 4712 +ID6 dw 0 +ID7 dw 0 + dw 0 + dw 0 +output label dword + dw offset i_output +first_shard_cs_to_alter: + dw 0 +blockin label dword + dw offset i_blockin + dw 0 +blockout label dword + dw offset i_blockout + dw 0 +iocontrol label dword + dw offset i_iocontrol + dw 0 +sysend label dword + dw offset i_sysend + dw 0 + dd 0 + dd 0 + dd 0 +shard_cs_alter_length equ ($-first_shard_cs_to_alter)/4 +M0START dw 0 +M0SIZE dw 0 +M1START dw 0 +M1SIZE dw 0 +M2START dw 0 +M2SIZE dw 0 +M3START dw 0 +M3SIZE dw 0 + +shdveclen equ offset shdid-offset m3size+2 + +dummy_ret proc far + sti + ret +dummy_ret endp + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/FDISK.ASM b/system/shard-x86-at/7/src/FDISK.ASM new file mode 100644 index 0000000..1ada045 --- /dev/null +++ b/system/shard-x86-at/7/src/FDISK.ASM @@ -0,0 +1,839 @@ +;----------------------------------------------------------------------- +; Disketten I/O +; Input: +; (ah)=0 Reset Diskette System +; hard reset to nec, prepare command, recal rquired +; on all drives +; (ah)=1 read the status of the system into (al) +; diskette_status from last operation is used +; +; Registers for read/write/verify/format +; (dl) drive number (0-3 allowed, vlue checked) +; (dh) head number (0-1 allowed, not value checked) +; (ch) track number (0-39, not value checked) +; (cl) sektor number (1-8, not value checked, +; not used for format) +; (al) number of sektors ( max = 8, not value checked, +; not used for format +; (es:bx) address of buffer (not required for verify) +; (ah)=2 read the desired sektors into memory +; =3 write +; =4 verify +; =5 format +; for the format operation, the buffer pointer (es,bx) +; must point to the collektion of desired address fields +; for the track. Each field is composed of 4 Bytes, +; (c,h,r,n) where c = track number, h=head number, +; r = sektor number, n = number of bytes per sektor +; (00=128, 01=256, 02=512, 03=1024). There must be one +; entry for every sektor on the track. This information +; is used to find the requested sektor during read/write +; access. +; +; Data Variable -- disk_pointer +; double word pointer to the current set of diskette parameters +; Output +; ah = status of Operation +; Status bits are defined in the equates for +; Diskette_status variable in the data segment of this +; module. +; cy = 0 successful operation (ah = 0 on return) +; cy = 1 failed operation (ah has error reason) +; for read/write/verify +; ds,bx,dx,ch,cl reserved +; al = number of sektors actually read +; ***** al may not be correkt if time out error occurs +; note: if an error is reported by the diskette code, the +; appropriate action is to reset the diskette, then retry +; the operation, on read access, no motor start delay +; is taken, so that three retries are required on reads +; to ensure that the problem is not due to motor +; start-up. +;----------------------------------------------------------------------- + + data segment at 40h + org 3eh +seek_status db ? +int_flag equ 80h +motor_status db ? +motor_count db ? +motor_wait equ 37 +diskette_status db ? +nec_status db 7 dup(?) + + data ends + + assume ds:data + + ife withhd +dma equ 0 ; dma address +dma_high equ 82h ; port for high 4 bits of dma + endif + + +diskette_io proc near + sti + push bx + push cx + push ds + push si + push di + push bp + push dx + mov bp,sp ; set up pointer to head parm + mov si,data + mov ds,si + call j1 ; call the rest to ensure ds restored + mov bx,4 ; get the motor wait parameter + call get_parm + mov motor_count,ah ; set the timer count for the motor + mov ah,diskette_status ; get status of operation + cmp ah,1 ; set the carry flag to indicate + cmc ; success or failure + pop dx + pop bp + pop di + pop si + pop ds + pop cx + pop bx + ret +diskette_io endp + +j1 proc near + mov dh,al + and motor_status,07fh + or ah,ah + jz disk_reset + dec ah + jz fdisk_status + mov diskette_status,0 + cmp dl,4 + jae j3 + dec ah + jz fdisk_read + dec ah + jnz j2 + jmp fdisk_write +j2: + dec ah + jz disk_verf + dec ah + jz disk_format +j3: + mov diskette_status,bad_cmd + ret +j1 endp + +;----- reset the diskette system + +disk_reset proc near + mov dx,03f2h + cli + mov al,motor_status + mov cl,4 + sal al,cl + test al,20h + jnz j5 + test al,40h + jnz j4 + test al,80h + jz j6 + inc al +j4: + inc al +j5: + inc al +j6: + or al,8 + out dx,al + mov seek_status,0 + mov diskette_status,0 + or al,4 + out dx,al + sti + call chk_stat_2 + + mov al,nec_status + cmp al,0c0h + jz j7 + or diskette_status,bad_cntlr + ret + +;----- send specific command to nec + +j7: + mov ah,3 + call nec_output + mov bx,1 + call get_parm + mov bx,3 + call get_parm +j8: + ret +disk_reset endp + + +;-----diskette status routine + +fdisk_status proc near + mov al,diskette_status + ret +fdisk_status endp + + +;-----diskette read + +fdisk_read proc near + mov al,046h +j9: + call dma_setup + mov ah,0e6h + jmp short rw_opn +fdisk_read endp + + +;----- diskette verify + +disk_verf proc near + mov al,042h + jmp j9 +disk_verf endp + + +;----- diskette format + +disk_format proc near + or motor_status,80h + mov al,04ah + call dma_setup + mov ah,04dh + jmp short rw_opn +j10: + mov bx,7 + call get_parm + mov bx,9 + call get_parm + mov bx,15 + call get_parm + mov bx,17 + jmp j16 +disk_format endp + + +;-----diskette write routine + +fdisk_write proc near + or motor_status,80h + mov al,04ah + call dma_setup + mov ah,0c5h +fdisk_write endp + +;-----allow write routine to fall into rw_opn + +;----------------------------------------------------------------------- +; rw_opn +; this routine performs the read/write/verify operation +;----------------------------------------------------------------------- + +rw_opn proc near + jnc j11 + mov diskette_status,dma_boundary + mov al,0 + ret +j11: + push ax + +;----- turn on the motor and select the drive + + push cx + mov cl,dl + mov al,1 + sal al,cl + cli + + mov motor_count,0ffh + test al,motor_status + jnz j14 + and motor_status,0f0h + or motor_status,al + sti + mov al,10h + sal al,cl + or al,dl + or al,0ch + push dx + mov dx,03f2h + out dx,al + pop dx + +;----- wait for motor if write operation + + test motor_status,80h + jz j14 + + clc + mov ax,090fdh + int 15h + jc j14 + + + mov bx,20 + call get_parm + or ah,ah +j12: + jz j14 + sub cx,cx +j13: + loop j13 + dec ah + jmp j12 +j14: + sti + pop cx + +;----- do the seek operation + + call seek + pop ax + mov bh,ah + mov dh,0 + jc j17 + mov si,offset j17 + push si + +;----- send out the parameters to the controller + + call nec_output + mov ah,[bp+1] + sal ah,1 + sal ah,1 + and ah,4 + or ah,dl + call nec_output + +;----- test for format command + + cmp bh,04dh + jne j15 + jmp j10 +j15: + mov ah,ch + call nec_output + mov ah,[bp+1] + call nec_output + mov ah,cl + call nec_output + mov bx,7 + call get_parm + mov bx,9 + call get_parm + mov bx,11 + call get_parm + mov bx,13 +j16: + call get_parm + pop si + +;----- let the operation happen + + call wait_int +j17: + jc j21 + call results + jc j20 + +;----- check the results returned by the controller + + cld + mov si,offset nec_status + lods nec_status + and al,0c0h + jz j22 + cmp al,040h + jnz j18 + +;----- abnormal termination, find out wy + + lods nec_status + sal al,1 + mov ah,record_not_fnd + jc j19 + sal al,1 + sal al,1 + mov ah,bad_crc + jc j19 + sal al,1 + mov ah,bad_dma + jc j19 + sal al,1 + sal al,1 + mov ah,record_not_fnd + jc j19 + sal al,1 + mov ah,write_protect + jc j19 + sal al,1 + mov ah,bad_addr_mark + jc j19 + +;----- nec must have failed + +j18: + mov ah,bad_cntlr +j19: + or diskette_status,ah + call num_trans ; how many were really transferred +j20: + ret +j21: + call results + ret + +;----- operation was successfull + +j22: + call num_trans + xor ah,ah + ret +rw_opn endp + +;----------------------------------------------------------------------- +; nec_output +; This routine sends a byte to the nec controller after testing +; for correct direction and controller ready. This routine will +; time out if the byte is not accepted within a reasonable +; amount of time, setting the diskette status on completion. +; Input +; (ah) byte to be output +; Output +; cy=0 success +; cy=1 failure -- diskette status updated +; If a failure has occured, the return is made one level +; higher than the caller of nec_output. (!Schweinkram) +; This removes the requirement of testing after every +; call of nec_output +; (al) destroyed +;----------------------------------------------------------------------- + +nec_output proc near + push dx + push cx + mov dx,03f4h + xor cx,cx +j23: + in al,dx + test al,040h + jz j25 + loop j23 +j24: + or diskette_status,time_out + pop cx + pop dx + pop ax ; discard the return address + stc + ret +j25: + xor cx,cx +j26: + in al,dx + test al,080h + jnz j27 + loop j26 + jmp j24 +j27: + mov al,ah + mov dl,0f5h + out dx,al + pop cx + pop dx + ret +nec_output endp + +;----------------------------------------------------------------------- +; get_parm +; This routine fetches the indext pointer from the disk_bas +; block pointed at by the data variable disk_pointer. A byte from +; that table is then moved into ah, the index of that byte being +; the parm in bx +; Input: +; bx index of byte to be fetched *2 +; if the low bit of bx is on, the byte is immediately output +; to the nec controller +; Exit +; am that byte from block +;----------------------------------------------------------------------- + +disk_pointer equ 1eh * 4 + +get_parm proc near + push ds + push si + sub ax,ax + mov ds,ax + + lds si,dword ptr ds:disk_pointer + shr bx,1 + + mov ah,[si+bx] + pop si + pop ds + jc nec_output + ret +get_parm endp + +;----------------------------------------------------------------------- +; seek +; Thi routine will move the head on the named drive to the +; named track. If the drive has not been accessed since the +; drive reset command was issued, the drive will be recalibrated. +; Input: +; (dl) = Drive to seek on +; (ch) = track t seek to +; Output: +; cy = 0 success +; cy = 1 failure -- diskette_status set accordingly +; (ax) destroyed +;----------------------------------------------------------------------- + +seek proc near + mov al,1 + push cx + mov cl,dl + rol al,cl + pop cx + test al,seek_status + jnz j28 + or seek_status,al + mov ah,07h + call nec_output + mov ah,dl + call nec_output + call chk_stat_2 + jc j32 + +;----- drive is in synch with controller, seek to track + +j28: + mov ah,0fh + call nec_output + mov ah,dl + call nec_output + mov ah,ch + call nec_output + call chk_stat_2 + +;----- wait for head settle + + pushf + mov bx,18 + call get_parm + push cx +j29: + mov cx,550 + or ah,ah + jz j31 +j30: + loop j30 + dec ah + jmp j29 +j31: + pop cx + popf +j32: + ret +seek endp + +;----------------------------------------------------------------------- +; dma_setup +; this routine sets up the dma for read/write/verify operations +; input: +; (al) = mode byte for the dma +; (es:bx) - address to read/write the data +; output: +; (ax) destroyed +;----------------------------------------------------------------------- + +dma_setup proc near + push cx + cli + out dma+12,al + push ax + pop ax + out dma+11,al + mov ax,es + mov cl,4 + rol ax,cl + mov ch,al + and al,0f0h + add ax,bx + jnc jj33 + inc ch +jj33: + push ax + out dma+4,al + mov al,ah + out dma+4,al + mov al,ch + and al,0fh + out 081h,al + +;----- determine count + + mov ah,dh + sub al,al + shr ax,1 + push ax + mov bx,6 + call get_parm + mov cl,ah + pop ax + shl ax,cl + dec ax + push ax + out dma+5,al + mov al,ah + out dma+5,al + sti + pop cx + pop ax + add ax,cx + pop cx + mov al,2 + out dma+10,al + ret +dma_setup endp + +;----------------------------------------------------------------------- +; chk_stat_2 +; This routine handles the interrupt received after a +; recalibrate, seek, or reset to the adapter. +; The interrupt is waited for, the interrupt sensed, +; and the result returned to the caller. +; input: +; none +; output: +; cy = 0 success +; cy = 1 failure -- error is in diskette_status +; (ax) destroyed +;----------------------------------------------------------------------- + +chk_stat_2 proc near + call wait_int + jc j34 + mov ah,08h + call nec_output + call results + jc j34 + mov al,nec_status + and al,060h + cmp al,060h + jz j35 + clc +j34: + ret +j35: + or diskette_status,bad_seek + stc + ret +chk_stat_2 endp + +;----------------------------------------------------------------------- +; wait_int +; This routine waits for an interrupt to occur. A time out +; routine takes place during the wait, so that an error may be +; returned if the drive is not ready. +; input: +; none +; output: +; cy = 0 success +; cy = 1 failure -- diskette_status is set accordingly +; (ax) destroyed +;----------------------------------------------------------------------- + +wait_int proc near + sti + push ax + push bx + push cx + clc + mov ax,09001h + int 15h + sti + jc j36a +; + mov bl,2 + xor cx,cx +j36: + test seek_status,int_flag + jnz j37 +; push cx +; push bx +; push ds +; push es +; push ax +; push dx +; push si +; push di +; push bp +; call cs:warte +; pop bp +; pop di +; pop si +; pop dx +; pop ax +; pop es +; pop ds +; pop bx +; pop cx + loop j36 + dec bl + jnz j36 + +j36a: or diskette_status, time_out + stc +j37: + pushf + and seek_status, not int_flag + popf + pop cx + pop bx + pop ax + ret +wait_int endp + +;----------------------------------------------------------------------- +; disk_int +; This routine handles the diskette interrupt +; Input +; none +; output: +; The interrupt flag is set is seek_status +;----------------------------------------------------------------------- + +;************** +;org 0ef57h +;************** +disk_int proc far + sti + push ds + push ax + push si + mov si,data + mov ds,si + or seek_status, int_flag + mov al,20h + out 20h,al + mov ax,09101h + int 15h + pop si + pop ax + pop ds + iret +disk_int endp + +;----------------------------------------------------------------------- +; results +; This routine will read anything that the nec controller has +; to say following an interrupt. +; input: +; none +; output: +; cy = 0 successful transfer +; cy = 1 failure -- time out in waiting for status +; nec_status area has status byte loaded into it +; (ah) destroyed +;----------------------------------------------------------------------- + +results proc near + cld + mov di,offset nec_status + push cx + push dx + push bx + mov bl,7 + +;-----wait for request for master + +j38: + xor cx,cx + mov dx,03f4h +j39: + in al,dx + test al,80h + jnz j40a + loop j39 + or diskette_status, time_out +j40: + stc + pop bx + pop dx + pop cx + ret + +;----- test the direction bit + +j40a: + in al,dx + test al,40h + jnz j42 +j41: + or diskette_status,bad_cntlr + jmp j40 + +;-----read in the status + +j42: + inc dx + in al,dx + mov [di],al + inc di + mov cx,10 +j43: loop j43 + dec dx + in al,dx + test al,10h + jz j44 + dec bl + jnz j38 + jmp j41 + +;----- result operation is done + +j44: + pop bx + pop dx + pop cx + ret + +;----------------------------------------------------------------------- +; num_trans +; This routine calculates the number of sectors that were +; actually transferred to/from the diskette +; input +; (ch) = cylinder of operation +; (cl) = start sector of operation +; output +; (al) = number actually transferred +; no other registers modified +;----------------------------------------------------------------------- + +num_trans proc near + mov al,nec_status+3 + cmp al,ch + mov al,nec_status+5 + jz j45 + mov bx,8 + call get_parm + mov al,ah + inc al +j45: + sub al,cl + ret +num_trans endp +results endp + + assume ds:shard + + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/FIXDISK.ASM b/system/shard-x86-at/7/src/FIXDISK.ASM new file mode 100644 index 0000000..520976a --- /dev/null +++ b/system/shard-x86-at/7/src/FIXDISK.ASM @@ -0,0 +1,307 @@ +;************************************************************************ +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==============* +;* * +;* Harddisk routinen * +;* * +;************************************************************************ + + device fixdisk + + dtcbroutines iocontrol + routine 5,fixed_size + routine -10,fixed_tracks + routine -11,fixed_sects + routine -12,fixed_heads + routine 1,devicetype + routine -1,unknowncontrol + dtcbroutines control32 + routine -2,fixed_init + routine -100,fixed_size_set + routine -101,fixed_start_set + routine -102,fixed_landing_zone + routine -1,no_channel_setup + dtcbroutines blockin + routine -1,fixed_read + dtcbroutines blockout + routine -1,fixed_write + dtcbparams nil_output,0ch ;kein output, blockio device + + +heads equ 4 +sects equ 17 + + if pcxt + if at + bitte nicht at und pcxt gleichzeitig + endif + endif + + if pcd +romhd equ 1 + else + if at +romhd equ 1 + else +romhd equ romharddisk + endif + endif + +fix_ccb macro kanal +startccb hgccb&kanal,kanal +ccbentry fix_size + dw 0 + db 0 +ccbentry fix_firstblock + dw 0 + db 0 +ccbentry fix_sects + db 0 +ccbentry fix_cylsize + dw 0 + endm + +fixed_size_set: + mov [di+fix_size],dx + mov [di+fix_size+2],bl + ret + +fixed_start_set: + mov [di+fix_firstblock],dx + mov [di+fix_firstblock+2],bl + ret + +fixed_init: + mov ax,0801h ;return drive type + mov dl,80h ;drive 0 + int 13h + mov al,cl ;anzahl sects holen + and al,3fh ;nur sector anzahl + mov [di+fix_sects],al ;eintragen + inc dh ;anzahl koepfe (statt hoechste nummer) + mul dh ;sects pro cylinder + mov [di+fix_cylsize],ax ;eintragen + mov dl,cl ;cylinder anzahl nach dx packen + shl dx,1 + shl dx,1 + and dh,3 ;nur unterste zwei bits behalten + mov dl,ch ;rest cylindernummer holen + inc dx ;anzahl draus machen + mul dx ;anzahl bloecke ausrechnen + mov [di+fix_size],ax + mov [di+fix_size+2],dl + ret + +fixed_tracks: + call fix_drive + rol cl,1 ;trackzahl in cx melden + rol cl,1 + and cl,3 ;nur zwei bits sind noch track + xchg cl,ch + inc cx ;meldet hoechste nummer, anzahl draus + ret + +fixed_sects: + call fix_drive + and cl,03fh ;nur sectorenzahl behalten + mov ch,0 ;high byte 0 + ret + +fixed_heads: + call fix_drive + mov cl,dh + mov ch,0 + inc cx ;hoechsten head -> anzahl umrechnen + ret + +fix_drive: + mov ax,0801h ;return drive type + mov dl,80h ;drive 0 + int 13h + ret + +fixed_landing_zone: + mov bx,0 + call device_free ;auf freigabe warten + call hardware ;pruefen, ob at + cmp al,IBMat + jz fixed_at_landing + call fix_drive + mov ax,0c01h ;seek + mov dl,80h ;immer auf erstem drive + inc ch ;auf naechste spur + ifz ;hoeherwertigen bits auch zaehlen + int 13h + ret + +fixed_at_landing: + sub ax,ax + mov ds,ax + les bx,dword ptr ds:[(41h*4)] + mov ax,es:[bx+12] ;landing zone + mov ch,al ;unterste byte der cylinder number + and ax,0300h ;obersten zwei bits + shr ax,1 + shr ax,1 + or al,1 ;immer sector 1 + mov cl,al + mov dx,80h ;drive und head 0 + mov ax,0c01h ;seek + int 13h + ret ;device nicht wieder freigeben + ;aendern, wenn zwei laufwerke + +fix_highblock: + pop bx + jmp highblock + +fixed_write: + push bx + if romhd + mov bl,3 + else + mov bl,0 ;auftrag schreiben nach bl + endif + jmp short fixed_rw +fixed_read: + push bx + if romhd + mov bl,2 ;lesen nach bl + else + mov bl,1 + endif +fixed_rw: + cmp ch,0 ;wirklich read oder write + ifnz + cmp cl,[di+fix_size+2] + ifz ;blocknummer zu hoch? + jnc fix_highblock + push bx + mov bx,0 + call device_free + + pop bx + mov ax,dx ;blocknummer nach ax + add ax,[di+fix_firstblock] ;offset fuer ersten block dazu + adc cl,[di+fix_firstblock+2] + mov dx,cx ;high byte muss nach dx + + if at ;translate bad blocks if at +; jetzt erstmal schlechte sectoren suchen + push es + push ds + pop es + push di + mov di,offset bb_table + cld + mov cx,[bb_anz] ;anzahl schlechte sectoren +fix_search_bb: + jcxz fix_no_translate + repnz scasw ;sieh mal nach + jnz fix_no_translate + cmp dl,byte ptr [di+max_bb*2-2] ;obere byte ebenfalls pruefen + jnz fix_search_bb +; schlechten sector gefunden + pop di + mov ax,[di+fix_firstblock] ;direkt hinter letzten block + mov dl,[di+fix_firstblock+2] + add ax,[di+fix_size] + adc dl,[di+fix_size+2] + add ax,cx + adc dl,0 + push di +fix_no_translate: + pop di + pop es + endif + + div word ptr (di+fix_cylsize) ;dxax / sectoren pro zylinder + ;der rest passt immer in 32 bit + mov ch,al ;low byte tracknummer nach ch + ror ah,1 + ror ah,1 + mov cl,ah ;high bits der cylindernummer nach cl + mov ax,dx ;rest nach ax + div byte ptr (di+fix_sects) + + if at + mov dh,al ;kopf nach dh + else +; jetzt erstmal schlechte spuren suchen + or cl,al ;kopf zur spur dazu + push ax ;retten + mov ax,cx ;zum suchen da rueber + push di + push es + push ds + pop es + mov di,offset bt_table + mov cx,8 ;8 moegliche schlechte spuren + cld + repnz scasw ;sieh mal nach + ifz ersatzwert holen + pop es + pop di + mov cx,ax ;zurueckgeben + and cl,0c0h ;nur cylinderbits behalten + and al,03fh ;nur kopf bits + mov dh,al ;head nach dh + pop ax + endif + + mov dl,080h ;drive nach dl + or cl,ah ;sector nach cl reinbasteln + mov al,1 ;einen sector + mov ah,bl ;auftrag nach ah + pop bx + if romhd + inc cl + push es + int 13h + pop es + jc diskerr + else + push bx + mov bx,0 + call device_lock + pop bx + mov byte ptr [cmd_block+1],dh ;kopfnummer + mov byte ptr [cmd_block+2],cl ;cylinder + sect + mov byte ptr [cmd_block+3],ch ;cylinder + push es + call hard_dsk + pop es + xor bx,bx ;device 0 freigeben + call device_unlock + mov ah,byte ptr [disk_status] ;haben wir fehler + or ah,ah + jnz diskerr + endif + mov byte ptr fix_err,0 ;ein aufruf war ohne fehler + mov cx,0 + ret + +diskerr: + inc byte ptr fix_err + cmp byte ptr fix_err,4 ;schon viermal hintereinander fehler + jnz fix_blockerr + mov byte ptr fix_err,0 + push ax + mov ah,13 ;nur harddisk zuruecksetzen + mov dl,80h ;disk reset + int 13h + pop ax +fix_blockerr: + jmp blockerr + +fixed_size: + mov al,[di+fix_size+2] + mov cx,[di+fix_size] + ret + +fix_err db 0 + + + ife romhd + include HDISK.ASM + endif + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/FLOPPY.ASM b/system/shard-x86-at/7/src/FLOPPY.ASM new file mode 100644 index 0000000..861d06f --- /dev/null +++ b/system/shard-x86-at/7/src/FLOPPY.ASM @@ -0,0 +1,454 @@ +;************************************************************************ +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==============* +;* * +;* Floppydisk archiv routinen * +;* * +;************************************************************************ + + device archive + + dtcbroutines iocontrol + routine 5,archive_size + routine 1,devicetype + routine 7,archive_format + routine -1,unknowncontrol + dtcbroutines control32 + ife pcd + routine -2,archive_init + endif + routine -173,set173size + routine -1,no_channel_setup + dtcbroutines blockin + routine 0,archive_read + dtcbroutines blockout + routine 0,archive_write + routine -1,unknowncontrol + if pcd + dtcbparams nil_output,0ch ;kein output, blockio device + else + dtcbparams nil_output,1ch ;kein output, blockio device, format erlaubt + endif + +IBM equ 0 +OLI equ 1 +IBM_BIG equ 2 +IBMsize equ 360*2 +OLIsize equ 400*2 +IBM_BIGsize equ 15*80*2 + +if pcd +romfd equ 1 + else + if at +romfd equ 1 + else +romfd equ romfloppy + endif + endif + +floppyio macro + if romfd + if withhd + int 40h + else + int 13h ;disketten routine aufrufen + endif + else + call diskette_io + endif + endm + +archive_ccb macro drive,drive_type + startccb archive_&drive,0 ;kanalnummer ist uninterressant +ccbentry arch_typ + db IBM ;standardmaessig IBM annehmen +ccbentry arch_size + dw 0 +ccbentry arch_drive + db drive +ccbentry arch_drive_type + db drive_type +ccbentry arch_default_format + if drive_type eq highdensity + db 3 + else + if drive_type eq drive720 + db 2 + else + db 1 + endif + endif + endm + +highdensity equ 1 ;bit 0 ist highdensity bit +with_boot_on_it equ 2 ;bit 1 sagt, dass boot auf der floppy ist (fuer hg) +drive720 equ 4 ;bit 2 sagt, dass 80 track double density +eighty_tracks equ 8 ;bit 3 sagt, wir formatieren gerade 80 spuren +no_floppy equ 16 ;bit 4 sagt, hier ist kein laufwerk + +diskvector equ 01eh*4 +diskinterrupt equ 0eh*4 + +archive_init: + mov ax,0 + mov es,ax ;auf int vektoren zeigen + mov word ptr es:[diskvector],offset nineblockvector + mov word ptr es:[diskvector+2],cs + ife romfd ;wenn nicht at + mov word ptr es:[diskinterrupt],offset disk_int + mov word ptr es:[diskinterrupt+2],cs + endif + ret + +oliinout: + mov ax,dx ;blocknummer nach ax + mov dl,20 ;20 sectoren pro cylinder + div dl ;ax/dl + mov ch,al ;track nach ch + mov al,ah ;rest nach al + mov ah,0 ;obere haelfte loeschen + mov dl,10 ;10 sects pro spur + div dl + mov dh,al ;head nach dh + mov dl,(di+arch_drive) ;drive nach dl + mov cl,ah ;sector nach cl + inc cl ;beginnt mit eins + mov al,1 ;einen sector + mov ah,bl ;auftrag nach ah + pop bx + push es + floppyio + pop es + jc archive_diskerr + mov cx,0 + ret + + +archive_write: + push bx + mov bl,3 ;auftrag schreiben nach bl + jmp short archive_rw + +archive_read: + push bx + mov bl,2 ;lesen nach bl + +archive_rw: + push bx + mov bx,1 ;floppy ist device 1 + call device_free ;warten, bis frei + pop bx + test byte ptr (di+arch_drive_type),with_boot_on_it ;ist der boot mit drauf + ifnz + jc archive_highblock + cmp dx,word ptr (di+arch_size) ;blocknummer zu hoch + jnc archive_highblock + cmp byte ptr (di+arch_typ),OLI ;haben wir ein olivetti archiv + jz oliinout + mov ax,dx + mov dh,0 ;erste seite annehmen + mov cx,(di+arch_size) ;gesamtgroesse + shr cx,1 ;halbieren + cmp ax,cx ;schon zweite seite + jc notsecond + mov dh,1 ;zweiten kopf + sub ax,cx +notsecond: + mov dl,9 + cmp byte ptr (di+arch_typ),IBM_BIG + ifz ;15 sectoren pro spur + div dl ;9 sectoren pro spur + mov ch,al ;track nach ch + mov dl,(di+arch_drive) ;drive nach dl + mov cl,ah ;sector nach cl + inc cl ;beginnt mit eins + mov al,1 ;einen sector + mov ah,bl ;auftrag nach ah + pop bx + push es + floppyio + pop es + jc archive_diskerr + mov cx,0 + ret + +archive_diskerr: + push ax + mov ah,0 + floppyio ;reset disk system + pop ax + jmp blockerr +archive_highblock: + pop bx + jmp highblock + +set173size: + cmp word ptr [hgver],1742 + ifz + ret + +;************************************************************************ +;* archive_size liefert die groesse einer aktuell eingelegten floppy +;* +;* und zwar wird unterschieden zwischen IBM-Format (9 Sectoren pro Spur) +;* und Olivetti (M20) Format mit 10 Sectoren pro Spur sowie IBM Format mit +;* 15 Sectoren pro Spur +archive_size: + mov bx,1 ;floppy ist device 1 + call device_free + mov word ptr (di+arch_size),0 ;annehmen, dass keine floppy da +; falls noch version 1.7.3, dann in diesem Fall 360K annehmen + cmp word ptr [hgver],1742 + ifz + if pcd + and byte ptr (di+arch_drive),0ffh-20h ;96 tpi ausschalten + endif + + mov dl,(di+arch_drive) ;drive nummer holen + mov dh,0 ;head 0 + mov cx,1 ;track 0, sector 1 + mov ax,0401h ;verify, ein sector + floppyio ;ist ueberhaupt ne floppy da + jnc arch_det_size + mov dl,(di+arch_drive) ;drive nummer holen + mov dh,0 ;head 0 + mov cx,1 ;track 0, sector 1 + mov ax,0401h ;verify, ein sector + floppyio ;ist ueberhaupt ne floppy da + jc arch_size_end ;fertig +arch_det_size: + mov dl,(di+arch_drive) ;drive nummer holen + mov dh,0 ;head 0 + mov cx,14 ;track 0, sector 14 + mov ax,0401h ;verify, ein sector + floppyio + mov byte ptr (di+arch_typ),IBM_BIG + mov word ptr (di+arch_size),IBM_BIGsize + jnc arch_size_end ;wir sind fertig + + mov dl,(di+arch_drive) ;drive nummer holen + mov dh,0 ;head 0 + mov cx,10 ;track 0, sector 10 + mov ax,0401h ;verify, ein sector + floppyio + mov byte ptr (di+arch_typ),OLI + mov word ptr (di+arch_size),OLIsize + jnc arch_is_oli + mov byte ptr (di+arch_typ),IBM ;konnten nicht finden, dann IBM Format + mov word ptr (di+arch_size),IBMsize +arch_is_oli: + mov dl,(di+arch_drive) ;drive nummer holen + if pcd + or dl,20h ;96 tpi floppy? + endif + test byte ptr (di+arch_drive_type),highdensity ;high density laufwerk + jnz arch_test_720k + ife limited_to_360 + mov dh,0 ;head 0 + mov cx,2901h ;track 41, sector 1 + mov ax,0401h ;verify, ein sector + floppyio + jc arch_size_end + mov bx,word ptr (di+arch_size) + add bx,bx ;doppelte kapazitaet + mov word ptr (di+arch_size),bx + if pcd + or byte ptr (di+arch_drive),20h ;96 tpi einstellen + endif + endif +arch_size_end: + mov al,0 + mov cx,word ptr (di+arch_size) + test byte ptr (di+arch_drive_type),with_boot_on_it ;ist der boot mit drauf + ifnz + ret + +arch_test_720k: + mov dh,0 ;head 0 + mov cx,0201h ;spur 2, sector 1 + mov ax,0401h + floppyio + mov al,0 ;annehmen, muss nicht gewechselt werden + jnc arch_skip_flip ;erkannt, groesse setzen + mov dl,(di+arch_drive) + mov dh,0 ;zurueck auf spur 0 + mov cx,1 ;spur 0, sector 1 + mov ax,0401h + floppyio + mov al,20h ;muss gewechselt werden +arch_skip_flip: + mov bx,40h ;auf datensegment gehen + mov es,bx + mov bx,90h + add bl,byte ptr (di+arch_drive) + xor byte ptr es:[bx],al ;ggf. flag flippen + test byte ptr es:[bx],20h ;wenn double step stimmt groesse + jnz arch_size_end + mov bx,word ptr (di+arch_size) + add bx,bx ;doppelte kapazitaet + mov word ptr (di+arch_size),bx + jmp arch_size_end + + +arch_form_unallowed: + mov cx,3 + ret + +;********************************************************************* +; formatieren einer floppy mit 9 oder 15 sects pro spur +archive_format: + mov bx,1 ;floppy ist device 1 + call device_free + and byte ptr (di+arch_drive_type),0ffh-eighty_tracks + cmp dx,0 + ifz + cmp dx,1 + jz arch_form_1 + or byte ptr (di+arch_drive_type),eighty_tracks + cmp dx,2 + jz arch_form_2 + cmp dx,3 + jnz arch_form_unallowed +;format 3 + test byte ptr (di+arch_drive_type),highdensity ;high density laufwerk + jz arch_form_unallowed ;nur bei highdensity geht 3 + mov ax,1703h ;1.2M in 1.2M laufwerk + mov dl,(di+arch_drive) + floppyio + mov dx,offset fifteenblockvector + mov bx,offset archive_format_buffer15 + jmp short arch_form_go + +;format 2 +arch_form_2: + test byte ptr (di+arch_drive_type),drive720+highdensity ;kann es 720k + jz arch_form_unallowed ;weder highdensity noch 720k, da geht nur 1 + test byte ptr (di+arch_drive_type),highdensity + jz arch_form_1 ;wie 1, 80 track bit steht schon + mov ax,1702h ;low density in high density drive + mov dl,(di+arch_drive) + floppyio + mov bx,40h ;auf datensegment gehen + mov es,bx + mov bx,90h ;zur state variablen + add bl,byte ptr (di+arch_drive) + and byte ptr es:[bx],0ffh-20h ;double step flag loeschen + jmp short arch_form_low_density + +;format 1 +arch_form_1: + mov ax,1701h ;normal drive + mov dl,(di+arch_drive) + floppyio + test byte ptr (di+arch_drive_type),highdensity + jz arch_form_low_density ;kein highdensity laufwerk, einstellung bleibt + mov ax,1702h ;low density in high density drive + mov dl,(di+arch_drive) + floppyio + +arch_form_low_density: + mov dx,offset nineblockvector + mov bx,offset archive_format_buffer +arch_form_go: + push es + mov ax,0 + mov es,ax ;auf int vektoren zeigen + mov word ptr es:[diskvector],dx + mov word ptr es:[diskvector+2],cs + pop es + mov dl,(di+arch_drive) ;drive nummer holen + mov ch,0 ;bei track 0 anfangen +archive_form_track_loop: + mov dh,0 +archive_form_head_loop: + push cs + pop es ;buffer liegt in cs + mov al,15 + mov bp,bx ;wir muessen was eintragen +arch_track_set_loop: + mov byte ptr cs:[bp],ch ;track + inc bp + mov byte ptr cs:[bp],dh ;head + inc bp + inc bp + inc bp + dec al + jnz arch_track_set_loop + mov ax,0501h ;format + floppyio + jnc arch_form_cont + mov cx,2 ;fehler melden + ret +arch_form_cont: + if romfd + push bx + push cx + push dx + push di + push si + call warte + call warte + pop si + pop di + pop dx + pop cx + pop bx + endif + inc dh ;naechste kopf + cmp dh,2 ;fertig + jnz archive_form_head_loop + inc ch ;naechste track + cmp ch,40 + jc archive_form_track_loop + test byte ptr (di+arch_drive_type),eighty_tracks ;80 spuren ? + jz arch_form_end + cmp ch,80 + jnz archive_form_track_loop +arch_form_end: + mov cx,0 ;ok + ret + +archive_format_buffer: + irp x,<1,6,2,7,3,8,4,9,5,10> + db 0,0,x,2 ;;track und head wird per programm eingetragen + endm +;;achtung: hier nichts einfuegen, da beim initialisieren vom ersten buffer +;;auch ein teil vom zweiten initialisiert wird +archive_format_buffer15: + irp x,<1,9,2,10,3,11,4,12,5,13,6,14,7,15,8> + db 0,0,x,2 ;;track und head wird per programm eingetragen + endm + +nineblockvector: + db 11011111b ;step rate und hut + db 2 ;hd load = 1 + db 37 ;let motor run 37 seconds + db 2 ;512 byte per sector + db 9 ;last sector is 9 + db 42 ;gap length + db 0ffh ;dtl + db 80 ;gap length format + db 0f6h ;fill byte fuer format + db 15 ;head settle time + db 2 ;motor start time + +fifteenblockvector: + db 11011111b ;step rate und hut + db 2 ;hd load = 1 + db 37 ;let motor run 37 seconds + db 2 ;512 byte per sector + db 15 ;last sector is 15 + db 01bh ;gap length + db 0ffh ;dtl + db 054h ;gap length format + db 0f6h ;fill byte fuer format + db 15 ;head settle time + db 8 ;motor start time (1/8 sekunden) + + + ife romfd + include FDISK.ASM + endif + + + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/FSHARD.ASM b/system/shard-x86-at/7/src/FSHARD.ASM new file mode 100644 index 0000000..da8f6a1 --- /dev/null +++ b/system/shard-x86-at/7/src/FSHARD.ASM @@ -0,0 +1,223 @@ + page 80,132 +;****************************************************************************** +;* * +;* S H A R D - M O D U L * +;* * +;* fuer EUMEL auf 8086/8088 Systemen * +;* * +;* SHard Version 6-PC/Floppy * +;* * +;* Copyright (C) Martin Schoenbeck, Spenge * +;* * +;****************************************************************************** + +com2wrongirq equ 0 +add4 equ 0 +ast equ 0 + +at equ 0 +pcxt equ 1 +pcd equ 0 +romfloppy equ 0 +ramsys equ 0 +limited_to_360 equ 0 +mit_msdos equ 0 +withhd equ 0 +hdsystem equ 0 +boot_size equ 0 +gensys equ 0 + +shard group code +code segment word public 'code' + assume cs:shard, ds:shard, es:nothing, ss:nothing + org 100h +shstart: + jmp los_gehts + + include MACROS.ASM + include MAC286.ASM + include DEVICE.ASM + include EUCONECT.ASM + include SHMAIN.ASM + +IBMat equ 0fch +com1base equ 03f8h +com1irq equ 4 +com2base equ 02f8h + if com2wrongirq + com2irq equ 5 + else + com2irq equ 3 + endif + if add4 +com4_1base equ 03e8h +com4_1irq equ 3 +com4_2base equ 03e0h +com4_2irq equ 3 com4_3base equ 02f0h +com4_3irq equ 3 +com4_4base equ 02e8h +com4_4irq equ 3 +com8_1base equ 02e0h +com8_1irq equ 3 +com8_2base equ 0260h +com8_2irq equ 3 +com8_3base equ 02d8h +com8_3irq equ 3 + else +com4_1base equ 02c0h +com4_1irq equ 3 +com4_2base equ 02c8h +com4_2irq equ 3 com4_3base equ 02d0h +com4_3irq equ 3 +com4_4base equ 02d8h +com4_4irq equ 3 +com8_1base equ 02e0h +com8_1irq equ 3 +com8_2base equ 02e8h +com8_2irq equ 3 +com8_3base equ 02f0h +com8_3irq equ 3 +com8_4base equ 02f8h +com8_4irq equ 3 +add4_3base equ 03e8h +add4_3irq equ 3 +add4_4base equ 03e0h +add4_4irq equ 3 add4_8base equ 0260h +add4_8irq equ 3 + endif +ast0_1base equ 01a0h +ast0_1irq equ 5 +ast0_2base equ 01a8h +ast0_2irq equ 5 +ast0_3base equ 01b0h +ast0_3irq equ 5 +ast0_4base equ 01b8h +ast0_4irq equ 5 +ast1_1base equ 02a0h +ast1_1irq equ 5 +ast1_2base equ 02a8h +ast1_2irq equ 5 +ast1_3base equ 02b0h +ast1_3irq equ 5 +ast1_4base equ 02b8h +ast1_4irq equ 5 + + +int_ctlr equ 20h +first_ictlr_int equ 8 + +channel macro number,dev,ccb +channels = channels+1 +selectentry = 5 + db number + dw offset ccb + if2 + dwb paramstart_,%&dev + else + dw 0 ;;weil in pass eins device evtl. unbekannt + endif + endm + +selecttable: + db channels ;anzahl kanaele hier setzen +channels = -1 ;nilchannel vorab abziehen + channel 32,shardchannel,0 + if at + channel 0,archive,archive_0 + else + channel 0,archive,archive_1 + endif +alterable_channels: + channel 1,pc,0 + channel 2,i8250,com1ccb + channel 3,i8250,com2ccb + if ast + channel 4,i8250,ast0_1ccb + channel 5,i8250,ast0_2ccb + channel 6,i8250,ast0_3ccb + channel 7,i8250,ast0_4ccb + channel 8,i8250,ast1_1ccb + channel 9,i8250,ast1_2ccb + channel 10,i8250,ast1_3ccb + channel 11,i8250,ast1_4ccb + else + channel 4,i8250,com4_1ccb + channel 5,i8250,com4_2ccb + channel 6,i8250,com4_3ccb + channel 7,i8250,com4_4ccb + channel 8,i8250,com8_1ccb + channel 9,i8250,com8_2ccb + channel 10,i8250,com8_3ccb + ife add4 ;wenn nicht extra fuer add4, trotzdem vorsehen + channel 11,i8250,add4_3ccb + channel 12,i8250,add4_4ccb + channel 13,i8250,add4_8ccb + endif + endif + channel 15,parallel,para0ccb + channel 14,parallel,para1ccb + channel 16,parallel,para2ccb + if at and not ramsys + channel 31,archive,archive_1 + else + channel 31,archive,archive_0 + endif + channel -1,nilchannel,0 + + + include I8250.ASM + include PCPAR.ASM + include STREAM.ASM + include NILCHAN.ASM + include PCSCREEN.ASM + include PCPLOT.ASM + include PCSYS.ASM +; include FIXDISK.ASM + include FLOPPY.ASM + include CLOCK.ASM + include WAIT.ASM + include HARDWARE.ASM + include BLOCKERR.ASM + + i8250_ccb com1,2 + i8250_ccb com2,3 + if ast + i8250_ccb ast0_1,4 + i8250_ccb ast0_2,5 + i8250_ccb ast0_3,6 + i8250_ccb ast0_4,7 + i8250_ccb ast1_1,8 + i8250_ccb ast1_2,9 + i8250_ccb ast1_3,10 + i8250_ccb ast1_4,11 + else + i8250_ccb com4_1,4 + i8250_ccb com4_2,5 + i8250_ccb com4_3,6 + i8250_ccb com4_4,7 + i8250_ccb com8_1,8 + i8250_ccb com8_2,9 + i8250_ccb com8_3,10 + ife add4 ;wenn nicht extra fuer add4, trotzdem vorsehen + i8250_ccb add4_3,11 + i8250_ccb add4_4,12 + i8250_ccb add4_8,13 + endif + endif + para_ccb 0,15 + para_ccb 1,14 + para_ccb 2,16 + archive_ccb 0,0 + archive_ccb 1,0 +sysmove: + rep movsw + jmp systemstart + + include BOOT.ASM + +code ends + + end los_gehts + + + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/HARDWARE.ASM b/system/shard-x86-at/7/src/HARDWARE.ASM new file mode 100644 index 0000000..df89fdf --- /dev/null +++ b/system/shard-x86-at/7/src/HARDWARE.ASM @@ -0,0 +1,17 @@ +;**************************************************************************** +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================* +;* * +;* Lesen des Hardware Kennzeichen-Bytes * +;* * +;**************************************************************************** + +hardware: + push es + mov ax,0ffffh + mov es,ax + mov al,byte ptr es:14 ;hardware byte holen + pop es + ret + + + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/HDISK.ASM b/system/shard-x86-at/7/src/HDISK.ASM new file mode 100644 index 0000000..67044d4 --- /dev/null +++ b/system/shard-x86-at/7/src/HDISK.ASM @@ -0,0 +1,482 @@ +;shard segment +; assume cs: shard +; assume ds: shard, es:nothing, ss:nothing + +;================================================================ +; modul hdisk.asm +; hard - disk - treiber +; +; Status: +; 0.0 13.11.84 erste Testversion +;================================================================ + +TIMEOUT1 equ 20h ; warten auf Disk-Interrupt + ; (20.0000h Tests) + +;-------------------------------------------------------; +; Fehlercodes +; Bem: 11h ist eigentlich k e i n Fehler ! +;-------------------------------------------------------; + +;sense_fail equ 0ffh ; sense operation +;undef_err equ 0bbf ; undefined error occurred +;time_out equ 80h ; attachment failed to respond +;bad_seek equ 40h ; seek operation failed +;bad_cntlr equ 20h ; controller has failed +;data_corrected equ 11h ; ecc corrected data error +;bad_ecc equ 10h ; bad ecc on disk read +;bad_track equ 0bh ; bad track flag detected +;dma_boundary equ 9 ; attempt to dma across 64k +;init_fail equ 7 ; drive parameter activity failed +;bad_reset equ 5 ; reset failed +;record_not_fnd equ 4 ; requested sector not found +;bad_addr_mark equ 2 ; address mark not found +;bad_cmd equ 1 ; bad command passed to disk i/o + +;-------------------------------------------------------; +; interrrupt and status area ; +;-------------------------------------------------------; + +dummy segment at 0 + + org 0dh *4 +hdisk_int label dword + + org 13h * 4 +org_vector label dword + org 19h *4 +hf_tbl_vec label dword +dummy ends + +;-----------------------------------------------------------------------; +; cmd_block +; +; +0 Kommando +; +1 Kopfnummer Aufrufparameter 1 +; +2 2-Bit Zylinder & Rest Sektor Aufrufparameter 2 +; +3 Zylinder Aufrufparameter 3 +; +4 Block - Count (ist immer 1 ) +; +5 Control-Byte (Step - Option) +;-----------------------------------------------------------------------; + +cmd_block label byte +hd_error db 7 dup(?) +disk_status db ? + +;-------------------------------------------------------; +; hardware specific values ; +; ; +; - Controller i/o port ; +; > when ready from: ; +; hf_port+0 - read data (from controller to cpu ; +; hf_port+1 - read controller hardware status ; +; (controller to cpu) ; +; hf_port+2 - read configuration switches ; +; hf_port+3 - not used ; +; < when written to: ; +; hf_port+0 - write data (from cpu to controller) ; +; hf_port+1 - controller reset ; +; hf_port+2 - generate controller select pulse ; +; hf_port+3 - write pattern to dma and interrupt ; +; mask register ; +;-------------------------------------------------------; + +hf_port equ 320h ; disk port +r1_busy equ 00001000b ; disk port 1 busy bit +r1_bus equ 00000100b ; command/data bit +r1_iomode equ 00000010b ; mode bit +r1_req equ 00000001b ; request bit + +dma_read equ 01000111b ; channel 3 (47h) +dma_write equ 01001011b ; channel 3 (4bh) +dma equ 0 ; dma address +dma_high equ 82h ; port for high 4 bits of dma + +tst_rdy_cmd equ 0 ; cntrl ready (00h) +recal_cmd equ 00000001b ; recal (01h) +sense_cmd equ 00000011b ; sense (03h) +fmtdrv_cmd equ 00000100b ; drive (04h) +chk_trk_cmd equ 00000101b ; t chk (05h) +fmttrk_cmd equ 00000110b ; track (06h) +fmtbad_cmd equ 00000111b ; bad (07h) +read_cmd equ 00001000b ; read (08h) +write_cmd equ 00001010b ; write (0ah) +seek_cmd equ 00001011b ; seek (0bh) +init_drv_cmd equ 00001100b ; init (0ch) +rd_ecc_cmd equ 00001101b ; burst (00h) +rd_buff_cmd equ 00001110b ; buffr (0eh) +wr_buff_cmd equ 00001111b ; buffr (0fh) +ram_diag_cmd equ 11100000b ; ram (e0h) +chk_drv_cmd equ 11100011b ; drv (e3h) +cntrl_diag_cmd equ 11100100b ; cntlr (e4h) +rd_long_cmd equ 11100101b ; rlong (e5h) +wr_long_cmd equ 11100110b ; wlong (e6h) + +int_ctl_port equ 20h ; 8259 control port +eoi equ 20h ; end of interrupt command + + page + +;===============================================================; +; MAIN - Routine +; Input: +; ah - 0 write disk +; - 1 read disk +; (es:bx) - Datenadresse +; cmd_block +; Output: +; disk_status 0 - alles OK +;===============================================================; + +hard_dsk proc +; mov ax,0 ; interrupt initiieren +; mov es,ax +; mov word ptr es:[hdisk_int+2],cs +; mov word ptr es:[hdisk_int],offset hd_int + + sti ; enable interrupts + mov disk_status,0 ; noch alles ok ! + mov cmd_block+5,5 ; 70 ysec steprate + cmp ah,0 ; ah = 0 --> write disk + jz a4 ; ah <> 0 --> read disk + call disk_read + jmp short dsbl +a4: call disk_write + +;-------------------------------------------------------; +; dsbl +; make shure that all housekeeping is done +; before exit +;-------------------------------------------------------; + +dsbl: + mov dx,hf_port+3 + sub al,al + out dx,al ; reset int/dma mask + mov al,7 + out dma+10,al ; set dma - mode to disable + cli ; disable interrupts + in al,21h + or al,20h + out 21h,al ; disable interrupt 5 + sti ; enable interrupts + ret + +hard_dsk endp + +;======================================================== +; disk read routine +; Input: +; (es:bx) - Datenadresse +; cmd_block +;======================================================== + +disk_read proc near + mov al,dma_read ; mode byte for dma read + mov cmd_block+0,read_cmd + jmp do_io +disk_read endp + +;======================================================== +; disk write routine +; Input: +; (es:bx) - Datenadresse +; cmd_block +;======================================================== + +disk_write proc near + mov al,dma_write ; mode byte for dma write + mov cmd_block+0, write_cmd + jmp do_io +disk_write endp + page +;======================================================== +; do_io +; gemeinsame Routine fuer alle Kommandos +; Input: +; (es:bx) - Datenadresse +; al - mode (dma_read/dma_write) +; cmd_block +;======================================================== + +do_io proc near + + mov cmd_block+4,1 ; Blockzahl immer 1 + +;-------------------------------------------------------; +; DMA_SETUP +; diese Routine dressiert den DMA +;-------------------------------------------------------; + + cli ; keine Interrupts mehr + out dma+12,al ; first/last ff setzen + push ax ; warten ? + pop ax + out dma+11,al ; mode setzen + +;-----phys. Adresse zum DMA ausgeben: + + mov ax,es + mov cl,4 + rol ax,cl ; h - nibble von es nach al + mov ch,al + and al,0f0h + add ax,bx + jnc j33 + inc ch ; Uebertrag notieren +j33: out dma+6,al ; a0 - a7 ausgeben + push ax ; fuer Ueberlauftest merken + mov al,ah + out dma+6,al ; a8 - a15 ausgeben + mov al,ch + and al,0fh + out dma_high,al ; a16 - a19 ausgeben + +;-----Blocklaenge zum DMA ausgeben: + + mov ax,511 ; Blocklaenge + out dma+7,al ; Blocklaenge ausgeben + mov al,ah + out dma+7,al + sti ; Interrupts scharfmachen + pop ax + add ax,511 ; 64k Overflow testen + jnc gx ; wenn kein Overflow + mov disk_status, dma_boundary + ret + +gx: call command + jc error_chk ; wenn was schiefgelaufen ist + + mov al,3 ; controller dma/interrupt register mask + out dma+10,al ; initialize the disk channel +g3: + in al,21h + and al,0dfh + out 21h,al + +;-------------------------------------------------------; +; wait_int +; this routine waits for the fixed disk +; controller to signal, that an interrupt +; has occured +;-------------------------------------------------------; + + sti ; muss das nochmal sein ??? + push es + push si + +;----- set timeout values + sub bh,bh + mov bl,TIMEOUT1 ; timout Zaehler setzen (high word) + sub cx,cx + +;----- wait for interrupt +w1: + push ds + push bx + push cx + call cs:warte ; nicht dumm rumloopen, sondern + pop cx ; arbeiten !! + pop bx + pop ds + + mov dx,hf_port+1 + in al,dx + and al,20h + cmp al,20h + jz w2 + loop w1 + dec bx + jnz w1 + mov disk_status,time_out + +w2: mov dx, hf_port + in al,dx + and al,2 + or disk_status,al ; Fehler merken + mov dx,hf_port+3 + xor al,al + out dx,al + pop si + pop es + +;-----------------------------------------------; +; error_chk ; +;-----------------------------------------------; + +error_chk: + ret ; zunaechst keine Fehler- Auswertung + mov al,disk_status + or al,al + jnz g21 + ret + +;-----perform sense status + +g21: mov ax, shard + mov es,ax + sub ax,ax + mov di,ax + mov cmd_block+0, sense_cmd + sub al,al + call command + jc sense_abort + mov cx,4 +g22: + call hd_wait_req + jc g24 + mov dx,hf_port + in al,dx + mov hd_error[di],al + inc di + mov dx,hf_port+1 + loop g22 + call hd_wait_req + jc g24 + mov dx,hf_port + in al,dx + test al,2 + jz stat_err +sense_abort: + mov disk_status, sense_fail +g24: + stc + ret +do_io endp + +;======================================================== +; command +; erklaert dem controller, was zu tun ist +; input +; cmd_block +;======================================================== + +command proc near + + mov dx,hf_port+2 + out dx,al ; controller select pulse ausgeben + mov dx,hf_port+3 + mov al,3 ; controller dma/interrupt register mask + out dx,al ; DMA und Interrupt-Maske setzen + +; eigentlich ist es nicht normal, wenn der Controller an dieser +; Stelle beschaeftigt ist, aber wer weiss ... + + sub cx,cx ; timeout - Zaehler setzen + mov dx,hf_port+1 +wait_busy: + in al,dx ; status lesen + and al,0fh + cmp al,r1_busy or r1_bus or r1_req + je weiter_gehts ; weiter, wenn controller frei + loop wait_busy ; warten... + mov disk_status, time_out ; is nix + stc + ret + +weiter_gehts: + cld ; clear direction flag + mov cx,6 ; Blocklaenge fuer move + mov si, offset cmd_block + +cm3: mov dx,hf_port ; Command-Block ausgeben + lodsb ; + out dx,al + loop cm3 + + inc dx ; weiter nach hf_port+1 + in al,dx ; status lesen + test al,r1_req + jz cm7 ; wenn alles ok + mov disk_status, bad_cntlr ; war nix + stc +cm7: + ret +command endp + + +;================================================================ +; hd_int +;================================================================ + +hd_int proc near + push ax + mov al,eoi ; end of interrupt + out int_ctl_port,al + mov al,7 ; set dma mode to disable + out dma+10,al + in al,21h + or al,20h + out 21h,al + pop ax + iret +hd_int endp + + +t_0 dw type_0 +t_1 dw type_1 +t_2 dw type_2 +t_3 dw type_3 + + +stat_err: + mov bl,es:hd_error ; get error byte + mov al,bl + and al,0fh + and bl,00110000b + sub bh,bh + mov cl,3 + shr bx,cl + jmp word ptr cs:[bx + offset t_0] + +type0_table label byte + db 0, bad_cntlr, bad_seek, bad_cntlr, time_out, 0, bad_cntlr + db 0, bad_seek +type0_len equ $-type0_table + +type1_table label byte + db bad_ecc, bad_ecc, bad_addr_mark, 0, record_not_fnd + db bad_seek, 0, 0, data_corrected, bad_track +type1_len equ $-type1_table + +type2_table label byte + db bad_cmd, bad_addr_mark +type2_len equ $-type2_table + +type3_table label byte + db bad_cntlr, bad_cntlr, bad_ecc +type3_len equ $-type3_table + +type_0: + ret +type_1: + ret +type_2: + ret +type_3: + ret + +;================================================================ +; hd_wait_req +;================================================================ + +hd_wait_req proc near + push cx + sub cx,cx ; timeout - Zaehler setzen + mov dx,hf_port + 1 +l1: + in al,dx + test al,r1_req + jnz l2 ; wenn ok + loop l1 + mov disk_status, time_out + stc +l2: + pop cx + ret +hd_wait_req endp + + +; end + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/HSHARD.ASM b/system/shard-x86-at/7/src/HSHARD.ASM new file mode 100644 index 0000000..c21b572 --- /dev/null +++ b/system/shard-x86-at/7/src/HSHARD.ASM @@ -0,0 +1,242 @@ + page 80,132 +;****************************************************************************** +;* * +;* S H A R D - M O D U L * +;* * +;* fuer EUMEL auf 80286, 8086, 8088 Systemen * +;* * +;* SHard Version 7-PC/XT, PC/AT * +;* * +;* Copyright (C) 1985, 86 Martin Schoenbeck, Spenge * +;* * +;****************************************************************************** + + +com2wrongirq equ 0 +add4 equ 0 +ast equ 0 + +at equ 0 +gensys equ 0 +ramsys equ 0 +pcxt equ 1 +pcd equ 0 +romharddisk equ 0 +romfloppy equ 0 +limited_to_360 equ 0 +boot_size equ 0 + +hdsystem equ 1 +withhd equ 1 + +setup_channel equ 28 +dos_channel equ 29 + +shard group code +code segment word public 'code' + assume cs:shard, ds:shard, es:nothing, ss:nothing + +shstart: + jmp los_gehts + + even + + include MACROS.ASM + include MAC286.ASM + include DEVICE.ASM + include EUCONECT.ASM + org 0a0h ;bei wort 80 beginnen + include PATCHARE.ASM + + include SHMAIN.ASM + +IBMat equ 0fch +com1base equ 03f8h +com1irq equ 4 +com2base equ 02f8h + if com2wrongirq + com2irq equ 5 + else + com2irq equ 3 + endif + if add4 +com4_1base equ 03e8h +com4_1irq equ 3 +com4_2base equ 03e0h +com4_2irq equ 3 com4_3base equ 02f0h +com4_3irq equ 3 +com4_4base equ 02e8h +com4_4irq equ 3 +com8_1base equ 02e0h +com8_1irq equ 3 +com8_2base equ 0260h +com8_2irq equ 3 +com8_3base equ 02d8h +com8_3irq equ 3 + else +com4_1base equ 02c0h +com4_1irq equ 3 +com4_2base equ 02c8h +com4_2irq equ 3 com4_3base equ 02d0h +com4_3irq equ 3 +com4_4base equ 02d8h +com4_4irq equ 3 +com8_1base equ 02e0h +com8_1irq equ 3 +com8_2base equ 02e8h +com8_2irq equ 3 +com8_3base equ 02f0h +com8_3irq equ 3 +com8_4base equ 02f8h +com8_4irq equ 3 +add4_3base equ 03e8h +add4_3irq equ 3 +add4_4base equ 03e0h +add4_4irq equ 3 add4_8base equ 0260h +add4_8irq equ 3 + endif +ast0_1base equ 01a0h +ast0_1irq equ 5 +ast0_2base equ 01a8h +ast0_2irq equ 5 +ast0_3base equ 01b0h +ast0_3irq equ 5 +ast0_4base equ 01b8h +ast0_4irq equ 5 +ast1_1base equ 02a0h +ast1_1irq equ 5 +ast1_2base equ 02a8h +ast1_2irq equ 5 +ast1_3base equ 02b0h +ast1_3irq equ 5 +ast1_4base equ 02b8h +ast1_4irq equ 5 + +int_ctlr equ 20h +first_ictlr_int equ 8 + +channel macro number,dev,ccb +channels = channels+1 +selectentry = 5 + db number + dw offset ccb + if2 + dwb paramstart_,%&dev + else + dw 0 ;;weil in pass eins device evtl. unbekannt + endif + endm + +selecttable: + db channels ;anzahl kanaele hier setzen +channels = -1 ;nilchannel vorab abziehen + channel 32,shardchannel,0 + channel 0,fixdisk,hgccb0 +alterable_channels: + channel 1,pc,0 + channel 2,i8250,com1ccb + channel 3,i8250,com2ccb + if ast + channel 4,i8250,ast0_1ccb + channel 5,i8250,ast0_2ccb + channel 6,i8250,ast0_3ccb + channel 7,i8250,ast0_4ccb + channel 8,i8250,ast1_1ccb + channel 9,i8250,ast1_2ccb + channel 10,i8250,ast1_3ccb + channel 11,i8250,ast1_4ccb + else + channel 4,i8250,com4_1ccb + channel 5,i8250,com4_2ccb + channel 6,i8250,com4_3ccb + channel 7,i8250,com4_4ccb + channel 8,i8250,com8_1ccb + channel 9,i8250,com8_2ccb + channel 10,i8250,com8_3ccb + ife add4 ;wenn nicht extra fuer add4, trotzdem vorsehen + channel 11,i8250,add4_3ccb + channel 12,i8250,add4_4ccb + channel 13,i8250,add4_8ccb + endif + endif +; channel 4,i8250,com3ccb +; channel 5,i8250,com4ccb + channel 15,parallel,para0ccb + channel 14,parallel,para1ccb + channel 16,parallel,para2ccb + channel 28,fixdisk,hgccb1 + channel 29,fixdisk,hgccb2 + if 0 + channel 30,archive,archive_0 + channel 31,archive,archive_1 + else + channel 31,archive,archive_0 + channel 30,archive,archive_1 + endif + channel -1,nilchannel,0 + include I8250.ASM + include PCPAR.ASM + include STREAM.ASM + include NILCHAN.ASM + include PCSCREEN.ASM + include PCPLOT.ASM + include PCSYS.ASM + include FIXDISK.ASM + include FLOPPY.ASM + include CLOCK.ASM + include WAIT.ASM + include HARDWARE.ASM + include BLOCKERR.ASM + + i8250_ccb com1,2 + i8250_ccb com2,3 + if ast + i8250_ccb ast0_1,4 + i8250_ccb ast0_2,5 + i8250_ccb ast0_3,6 + i8250_ccb ast0_4,7 + i8250_ccb ast1_1,8 + i8250_ccb ast1_2,9 + i8250_ccb ast1_3,10 + i8250_ccb ast1_4,11 + else + i8250_ccb com4_1,4 + i8250_ccb com4_2,5 + i8250_ccb com4_3,6 + i8250_ccb com4_4,7 + i8250_ccb com8_1,8 + i8250_ccb com8_2,9 + i8250_ccb com8_3,10 + ife add4 ;wenn nicht extra fuer add4, trotzdem vorsehen + i8250_ccb add4_3,11 + i8250_ccb add4_4,12 + i8250_ccb add4_8,13 + endif + endif + para_ccb 0,15 + para_ccb 1,14 + para_ccb 2,16 + ;erlaubt drivetypen: highdensity, drive720 + if at + archive_ccb 0,highdensity + archive_ccb 1,0 ;drive720 + else + archive_ccb 0,0 + archive_ccb 1,0 + endif + fix_ccb 0 + fix_ccb 1 + fix_ccb 2 + +sysmove: + rep movsw + jmp systemstart + + include BOOT.ASM + +code ends + + end los_gehts + + + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/I8250.ASM b/system/shard-x86-at/7/src/I8250.ASM new file mode 100644 index 0000000..19f584d --- /dev/null +++ b/system/shard-x86-at/7/src/I8250.ASM @@ -0,0 +1,437 @@ +;*************************************************************************** +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================* +;* * +;* Routinen fuer 8250 UART im EUMEL - System * +;* * +;* * +;*************************************************************************** + +i8250_data equ 0 +i8250_ier equ 1 ;interrupt enable register +i8250_iir equ 2 ;interrupt indicator register +i8250_lcr equ 3 ;line control register +i8250_mcr equ 4 ;modem control register +i8250_lsr equ 5 ;line status register +i8250_msr equ 6 ;modem status register + + device i8250 + + dtcbroutines iocontrol + routine 1,i8250_devicetype + routine 2,frout + routine 3,i8250_stop + routine 4,i8250_weiter + routine 5,nil_size + routine 6,priv_op_question + routine 8,priv_op_question + routine 9,priv_op_question + routine -2,frout + routine -3,i8250_status + routine -4,stream_in_count + routine -5,stream_out_count + routine -6,i8250_sendbreak + routine -10,i8250_i_stop + routine -11,i8250_i_weiter + routine -1,unknowncontrol + + dtcbroutines control32 + routine 6,i8250_flow + routine 8,i8250_baud + routine 9,i8250_bits + routine -2,i8250_init + routine -3,i8250_test + routine -1,no_channel_setup + + dtcbroutines blockin + dtcbroutines blockout + routine -1,unknowncontrol + + dtcbparams i8250_output,3 ;typ = nur stream io + + +;****************************************************************** +;* der macro i8250_ccb muss fuer jeden 8250 im system einmal +;* aufgerufen werden +;* +;* parameter: + +i8250_ccb macro i8250,kanal +i8250&buf db 100 DUP (0ffh) + startccb i8250&ccb,kanal + stream 100,i8250&buf ;;die 8250 routinen benutzen stream routinen +ccbentry i8250_stat + db 0 +ccbentry i8250_statusandmask + db 0 ;;keine statusleitungen abfragen +ccbentry i8250_statusxormask + db 0 +ccbentry i8250_errmask + db 0 ;;keine fehler auswerten +ccbentry i8250_errflags + db 0 +ccbentry i8250_irq_line + db i8250&irq +ccbentry i8250_base + dw i8250&base +ccbentry i8250_next_ccb + dw 0 +ccbentry i8250_int_entry + call i8250_interrupt + endm + +;*** bits in i8250_stat: +i8250_rtscts equ 1 +i8250_exists equ 2 + +i8250_baud_table: + dw 2304 ;50 + dw 1536 ;75 + dw 1047 ;110 + dw 857 ;134.5 + dw 768 ;150 + dw 384 ;300 + dw 192 ;600 + dw 96 ;1200 + dw 64 ;1800 + dw 48 ;2400 + dw 32 ;3600 + dw 24 ;4800 + dw 16 ;7200 + dw 12 ;9600 + + +i8250_devicetype: + mov cx,0 ;erstmal 0 setzen + test byte ptr [di+i8250_stat],i8250_exists ;ist da einer + ifnz ;type dazu + ret + + + + +i8250_test: + cmp bh,0 ;abfrage + ifnz + mov dx,(di+i8250_base) + add dx,i8250_iir ;auf interrupt indicator register + in al,(dx) + mov cl,al + mov ch,1 + ret + +i8250_init: + mov ax,0 + mov es,ax +; pruefen, ob ueberhaupt vorhanden + mov dx,(di+i8250_base) + add dx,i8250_iir ;interrupt indicate register holen + jmp short $+2 + in al,dx + nop ;der in befehl erwischt einen von diesen + nop ;codes, wenn auf der adresse kein port ist + nop + nop + nop + test al,0f8h ;alle bits weg, die nicht da sein koennen + ifnz ;keine schnittstelle da + or byte ptr [di+i8250_stat],i8250_exists ;da ist einer + + mov bx,first_ictlr_int + add bl,(di+i8250_irq_line) ;an welchem pin des controllers haengt er + ;carry kann hier nicht auftreten + mov byte ptr i8250_initint,bl ;fuer passenden initialisierungsint basteln + add bx,bx ;*2 als wortadresse + mov dx,word ptr (i8250_i_tab-((3+first_ictlr_int)*2))[bx] ;letzten ccb holen + mov word ptr (i8250_i_tab-((3+first_ictlr_int)*2))[bx],di ;neuen eintragen + mov (di+i8250_next_ccb),dx ;alten selbst merken + add bx,bx ;*4 + mov word ptr es:[bx+2],cs + mov dx,di ;adresse ccb holen + add dx,i8250_int_entry ;adresse interrupt routine errechnen + mov word ptr es:[bx],dx ;eintragen + mov cl,(di+i8250_irq_line) ;nochmal bit im controller + inc cl ;mindestens einmal shiften + stc + mov ch,0 ;mit nichts anfangen + rcl ch,cl + in al,int_ctlr+1 ;interrupt enable register holen + or al,ch ;bit fuer i8250 setzen + xor al,ch ;und freigeben + out int_ctlr+1,al + mov dx,(di+i8250_base) + add dx,i8250_ier ;auf interrupt enable register + mov al,0fh ;alle interrupts an + out dx,al ;interrupt enable + add dx,i8250_mcr-i8250_ier ;auf modem control register + mov al,0bh ;rts, dtr, int enable + out dx,al +; ret +i8250_initint = $+1 + int 12 + ret + +i8250_i_tab: + dw 0 ;int 3 + dw 0 ;int 4 + dw 0 ;int 5 + dw 0 ;int 6 + dw 0 ;int 7 + +i8250_interrupt: + push ds + push cx + push di + push bx + push dx + push ax + mov ax,cs + mov ds,ax ;ds = cs setzen + mov bx,sp ;auf stack zeigen + mov di,ss:[bx+12] ;return adresse im ccb holen + sub di,i8250_int_entry+3 ;auf anfang ccb rechnen +i8250_to_first_ccb: + push di ;ersten ccb merken + mov ah,1 ;bis jetzt keinen port gefunden +i8250_check_same_int: + mov dx,(di+i8250_base) + add dx,i8250_iir ;interrupt indicate register lesen + in al,(dx) + test al,1 ;war interrupt auf diesem kanal + jnz i8250_int_end + mov ah,0 ;ax als index, gleichzeitig ah loeschen + push ax + mov bx,ax + call word ptr i8250_int_table[bx] ;passende service routine aufrufen + pop ax + jmp i8250_check_same_int + +i8250_int_end: + mov di,(di+i8250_next_ccb) ;naechsten port fuer diesen vektor holen + or di,di ;ende eintrag? + jnz i8250_check_same_int + pop di ;ersten ccb holen + or ah,ah ;haben wir im letzten durchlauf einen gefunden + jz i8250_to_first_ccb ;ja, dann weiter suchen + mov al,20h ;end of interrupt + out int_ctlr,al + pop ax + pop dx + pop bx + pop di + pop cx + pop ds + pop cs:[i8250_ret_dummy] ;return adresse im ccb vergessen + iret ;fertig + +i8250_ret_dummy dw 0 + +i8250_int_table: + dw offset i8250_out_restart ;bei ext. status wechsel oder bei tx empty + dw offset i8250_out_restart ;nur output ggf. neu starten + dw offset i8250_rec_int + dw offset i8250_error_int + + +i8250_baud: + cmp bh,15 ;negativer wert oder > 15 + jnc i8250_not_ok + cmp bh,0 + jz i8250_not_ok + test bl,1 ;abfage? + jnz i8250_ok ;ja, wir koennen alles + mov dx,(di+i8250_base) + add dx,i8250_lcr ;line control register + cli ;nichts dazwischen lassen + in al,dx ;alten wert holen + push ax + mov al,80h + out dx,al ;auf baudrate register schalten + sub dx,i8250_lcr ;wieder auf base + mov bl,bh ;baudrate schluessel nach bx ausdehnen + mov bh,0 + sal bx,1 ;ein baudrate eintrag ist zwei byte + mov ax,word ptr i8250_baud_table-2[bx] ;passenden baudrate eintrag holen + out dx,al ;low byte raus + mov al,ah + inc dx + out dx,al ;high byte raus + pop ax + add dx,i8250_lcr-1 ;wieder auf lcr + out dx,al ;alte lcr wieder setzen + sti ;jetzt darf er wieder + jmp short i8250_ok ;alles klar + ret + +i8250_bits: + test bh,0a0h ;negativer wert oder 1.5 Stopbits + jnz i8250_not_ok + test bh,4 ;bitzahl >= 5 + jz i8250_not_ok ;nein, muss aber + test bl,1 ;abfrage + jnz i8250_ok + mov al,bh ;anfoderung nach al + test al,10h ;gerade paritaet? + jz i8250_not_even + or al,8 ;dann paritaet auch enablen +i8250_not_even: + test al,40h ;2 stopbits + jnz i8250_not_two ;nein, das bit steht schon + and al,0ffh-4 ;bit ausknipsen +i8250_not_two: + and al,1fh ;alle unbenutzten loeschen + mov dx,(di+i8250_base) + add dx,i8250_lcr ;auf line control register + out dx,al + mov cl,bh ;anzahl bits nach cl + and cl,7 ;ausblenden + inc cl ;aus 0-7 1-8 machen + mov dx,0ffh ;von 0 bits ausgehen + shl dl,cl ;bits anzahl nullen reinziehen + xor dl,0ffh ;und 1 und 0 tauschen + call set_out_mask + call set_inp_mask + call set_inp_errmask +i8250_ok: + mov cx,0 + ret + +i8250_not_ok: + mov cx,1 + ret + +i8250_flow: + test bh,80h ;negativer wert? + jnz i8250_not_ok + cmp bh,3 + jnc i8250_not_ok ;oder > 2 + test bl,1 ;abfrage + jnz i8250_ok ;ja + cli + mov byte ptr (di+i8250_statusxormask),0 ;beim status nichts abfragen + mov byte ptr (di+i8250_statusandmask),0 + and byte ptr (di+i8250_stat),0ffh-i8250_rtscts ;handshake ausschalten + dec bh + jnz i8250_not_xonxoff + call enablexon + jmp i8250_flow_end +i8250_not_xonxoff: + call disablexon + dec bh + jnz i8250_flow_end + mov byte ptr (di+i8250_statusandmask),10h ;cts abfragen + mov byte ptr (di+i8250_statusxormask),10h ;auf gesetzt + or byte ptr (di+i8250_stat),i8250_rtscts +i8250_flow_end: + call i8250_out_restart ;immer probieren, ob jetzt output moeglich + sti + jmp i8250_ok + +i8250_output: + call fillbuffer + pushf + jz i8250_no_orest + call i8250_out_restart +i8250_no_orest: + popf + ret + +;* out_restart kann jederzeit aufgerufen werden, da der status jedesmal +;* abgefragt wird +i8250_out_restart: + mov dx,(di+i8250_base) ;commandport laden + add dx,i8250_lsr ;adresse line status register + cli + in al,(dx) ;status holen + test al,20h ;tx buffer empty + lahf ;modem status register immer lesen + inc dx ;auf modem status register + in al,(dx) ;holen + sahf + jz i8250_stiret ;nein, sti und zurueck + and al,(di+i8250_statusandmask) ;gewuenschte bits ausblenden + xor al,(di+i8250_statusxormask) + jnz i8250_stiret + call getnextchar ;zeichen holen, xon/xoff etc. abhandeln + mov dx,(di+i8250_base) ;port holen + ifnz ;wenn was da, ausgeben +i8250_stiret: + sti + ret ;fertig + +i8250_rec_int: + mov dx,(di+i8250_base) + in al,(dx) ;zeichen holen + call input ;zeichen uebergeben, xon/xoff etc. abhandeln + jz i8250_out_restart ;ggf. output neu starten + ret + +i8250_error_int: + mov dx,(di+i8250_base) + add dx,i8250_lsr ;line status register holen + in al,(dx) + or (di+i8250_errflags),al ;alte errorflags dazu + test al,10h ;break detected + jnz i8250_break + and al,(di+i8250_errmask) ;welche fehlerbits sollen behandelt werden + jz i8250_rec_int ;keine, normal einlesen + mov dx,(di+i8250_base) + in al,(dx) ;zeichen holen + call errorinput ;uebergeben + jz i8250_out_restart + ret + +i8250_break: + call breakinput ;break zeichen uebergeben + jz i8250_out_restart + ret + +i8250_stop: + call stream_stop + ifnz ;output ggf neu starten + test byte ptr (di+i8250_stat),i8250_rtscts + jz i8250_stop_end +i8250_i_stop: + mov dx,(di+i8250_base) + add dx,i8250_mcr ;auf modem control register + mov al,9 ;rts wegnehmen + out (dx),al +i8250_stop_end: + ret + +i8250_weiter: + call stream_weiter + ifnz ;output ggf. neu starten + test byte ptr (di+i8250_stat),i8250_rtscts + jz i8250_stop_end +i8250_i_weiter: + mov dx,(di+i8250_base) + add dx,i8250_mcr ;auf modem control register + mov al,0bh ;rts wieder setzen + out (dx),al + ret + +i8250_status: + cli + mov cl,(di+i8250_errflags) ;fehler holen + mov byte ptr (di+i8250_errflags),0 ;loeschen + mov dx,(di+i8250_base) + add dx,i8250_lsr + in al,dx + mov ch,al + sti + ret + +i8250_sendbreak: + cli + mov dx,(di+i8250_base) + add dx,i8250_lcr + in al,dx + and al,10111111b ;switch breakbit off + and bl,1 ;nur ein bit behalten + ror bl,1 + ror bl,1 ;auf bit 6 position + or al,bl ;send break or not + out dx,al + sti + ret + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/MAC286.ASM b/system/shard-x86-at/7/src/MAC286.ASM new file mode 100644 index 0000000..3a1f164 --- /dev/null +++ b/system/shard-x86-at/7/src/MAC286.ASM @@ -0,0 +1,23 @@ +iw macro op,reg,count + local fbyte,cbyte +fbyte: + op reg,1 +cbyte: + org cs:fbyte + db 0c1h + org cs:cbyte + db count + endm + +ib macro op,reg,count + local fbyte,cbyte +fbyte: + op reg,1 +cbyte: + org cs:fbyte + db 0c0h + org cs:cbyte + db count + endm + + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/MACROS.ASM b/system/shard-x86-at/7/src/MACROS.ASM new file mode 100644 index 0000000..710ef4c --- /dev/null +++ b/system/shard-x86-at/7/src/MACROS.ASM @@ -0,0 +1,80 @@ +;************************************************************************* +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ===============* +;* * +;* M A C R O s fuer E U M E L - U R L A D E R * +;* * +;************************************************************************* + + .XLIST +on equ 0ffh +off equ 0 + +test equ off + +deft macro text +local textend + db (textend-$-1) + db &text +textend label byte + endm + +ke macro text + local teend + call info + jmp teend + db '&text' +teend: + endm + +trcpas macro name + local trcfield,endtrc + if trcswitch + push hl + ld hl,(trcfield) + inc hl + ld (trcfield),hl + pop hl + jr endtrc + db '&name' +trcfield: + dw 0 +endtrc: + endif + endm + + +ifz macro op +local false + jnz false + op +false: + endm + +ifnz macro op +local false + jz false + op +false: + endm + +ifc macro op +local false + jnc false + op +false: + endm + +ifnc macro op +local false + jc false + op +false: + endm + +popff macro + push cs + call x_iret + endm + + .LIST + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/NILCHAN.ASM b/system/shard-x86-at/7/src/NILCHAN.ASM new file mode 100644 index 0000000..70caad6 --- /dev/null +++ b/system/shard-x86-at/7/src/NILCHAN.ASM @@ -0,0 +1,54 @@ +;*************************************************************************** +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================* +;* * +;* Dieses Modul definiert alle Routinen, die benoetigt werden, wenn * +;* ein Kanal nicht existiert oder bestimmte Funktionen nicht durch- * +;* fuehren kann. * +;* * +;*************************************************************************** + + device nilchannel + + dtcbroutines iocontrol + routine 1,devicetype + routine 2,frout_ok + routine 5,nil_size + routine -1,unknowncontrol + dtcbroutines control32 + routine -1,no_channel_setup + dtcbroutines blockin + dtcbroutines blockout + routine -1,no_blockinout + dtcbparams nil_output,0 ;output; niltype + +nil_size: + mov al,0 + mov cx,0 + ret + +unknowncontrol: +no_blockinout: + mov cx,-1 + ret + +frout_ok: + mov cx,200 ;200 bytes frei + stc ;puffer leer + ret + +no_baud: +no_bits: +no_flow: +no_channel_setup: + mov cx,1 + ret + +nil_output: + stc + ret ;alle zeichen uebernommen + +devicetype: + mov ch,0 ;hoeherwertige teil immer null + mov cl,shard:(si+devtype) ;type dazu + ret + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/PATCH.ELA b/system/shard-x86-at/7/src/PATCH.ELA new file mode 100644 index 0000000..539a674 --- /dev/null +++ b/system/shard-x86-at/7/src/PATCH.ELA @@ -0,0 +1,500 @@ +(* SHard-Patcher fuer Schoenbeck AT-Shard V2.7: + - Vortest/Speichertest + - Keyboard Repeatfrequenz + - Baudrates 19200/38400 werden angeboten + - Refresh-Intervall nderbar (bis zu 5% mehr Leistung) + - control (-3,,,r) liefert im Highbyte das Modemstatusregister (RI etc.) + - control (-5,8,,r) geht in ruc-Bios-Graphikmodus (mit Textausgabe: + Text mit 'out', 'put' etc. schreiben, cursor (x, y) mit y:1..43, + Codes ""4"", ""5"", Scroll lschen jetzt vernnftig (Attribut von 7 auf + 0 gendert), + Achtung: getcursor (x, y) im 'begin plot' einbauen. + cursor (x,y) im 'end plot' einbauen, wegen y<25 im Textmodus!) + - Kanal 30 (Archiv 1) jetzt fr MF-Laufwerke (5.25" bzw. 3.5"), Default- + Size ist 1.2MB (Achtung bei Formatieren von 3.5"-Floppys!) + - Mit control (-10/-11,...) ("stop", "weiter") wird an den RS232-Kanlen + jetzt nicht nur RTS active/inactive gesetzt sondern auch DTR (Modem). + - An Kanal 32: + Mit control (-3, x, mcr*32+kanal, r) (mcr ist Modemcontrolregister Wert, + x egal) knnen RTS, DTR explizit gesetzt werden. + - id (6) > 0 : SHard wurde gepatcht. + + Michael Staubermann, Version 2: 09.10.87, Keyboardrepeat, Baudrates + Version 3: 04.11.87, Graphikcursor & Graphikmodi + Version 3.1: 20.11.87, >32MB Partitionen f. M+ + Version 4: 04.12.87, TX-Interrupt restart + Version 4.1: 10.01.88, Refresh-Intervall nderbar + Version 5: 21.02.88, Kanal 30 1.2MB-Format (3.5") + Version 5.1: 22.02.88, +*) + +LET setup channel = 28 ; + +LET max partitions = 4 , + patch version = 5 , + shard bloecke = 18 ; + + +patch shard ; + +ROW shard bloecke ROW 256 INT VAR block ; +ROW shard bloecke BOOL VAR modified ; +INT VAR old session := 0 ; +REAL VAR partition size := 0.0, partition start 1 := 256.0 * 65536.0 -1.0 ; +INT VAR i ; +FOR i FROM 1 UPTO shard bloecke REP + modified (i) := FALSE +PER ; + +ROW 256 INT VAR partition table ; + + +INT OP & (TEXT CONST hex) : + INT VAR i, h := 0 ; + IF LENGTH hex > 4 THEN errorstop ("OP &: LENGTH > 4") FI ; + FOR i FROM 1 UPTO LENGTH hex REP + rotate (h, 4) ; + INT CONST c :: code (hex SUB i) ; + IF c >= 97 AND c <= 102 + THEN h := h OR (c-87) + ELIF c >= 65 AND c <= 70 + THEN h := h OR (c-55) + ELIF c >= 48 AND c <= 57 + THEN h := h OR (c-48) + ELSE errorstop ("OP &: ungltiges Hexdigit ("+code(c)+")") + FI ; + PER ; + h +ENDOP & ; + +TEXT OP % (INT CONST int) : + LET hex = "0123456789ABCDEF" ; + TEXT VAR t := "" ; + INT VAR i, r := int ; + FOR i FROM 1 UPTO 4 REP + rotate (r, 4) ; + t CAT (hex SUB ((r AND 15)+1)) ; + PER ; + t +ENDOP % ; + +PROC poke (INT CONST shard adr, INT CONST byte) : + (* Der Shard beginnt bei 1280 d.h. 0500H, EUCONECT bei 504H (='EUMEL') *) + INT VAR block no, block offset ; + IF shard adr < 256 + THEN errorstop ("poke: Adresse < 256") ; + LEAVE poke + FI ; + block offset := shard adr-256 ; + rotate (block offset, -1) ; + block offset := (block offset AND 255) + 1 ; + block no := shard adr - 256 ; + rotate (block no, -9) ; + block no := (block no AND 63) + 1 ; + IF block no < 1 OR block no > shard bloecke + THEN errorstop ("poke: falsche Adresse") ; + LEAVE poke + FI ; + TEXT VAR t := " " ; + replace (t, 1, block (block no)(block offset)) ; + replace (t, (shard adr AND 1) + 1, code (byte AND 255)) ; + modified (block no) := TRUE ; + block (block no)(block offset) := t ISUB 1 ; +ENDPROC poke ; + +PROC poke2 (INT CONST shard adr, INT CONST word) : + INT VAR r := word ; + poke (shard adr, r) ; + rotate (r, 8) ; + poke (shard adr+1, r) ; +ENDPROC poke2 ; + +PROC poken (INT CONST shard adr, TEXT CONST str) : + INT VAR i, adr := shard adr ; + i := 1 ; + WHILE i <= LENGTH str REP + IF (str SUB i+2) = " " OR (str SUB i+2) = "" + THEN poke (adr, &subtext (str, i, i+1)) ; + i INCR 3 ; + adr INCR 1 + ELIF (str SUB i+4) = " " OR (str SUB i+4) = "" + THEN poke2 (adr, &subtext (str, i, i+3)) ; + i INCR 5 ; + adr INCR 2 + ELSE errorstop ("poken: Zuviele zusammenhngende Bytes") + FI ; + PER ; +ENDPROC poken ; + +INT PROC peek (INT CONST shard adr) : + INT VAR block no, block offset ; + block offset := shard adr ; + IF shard adr < 256 + THEN errorstop ("peek: Adresse < 256") ; + LEAVE peek WITH 0 + FI ; + block offset := shard adr-256 ; + rotate (block offset, -1) ; + block offset := (block offset AND 255) + 1 ; + block no := shard adr-256 ; + rotate (block no, -9) ; + block no := (block no AND 63) + 1 ; + IF block no < 1 OR block no > shard bloecke + THEN errorstop ("peek: falsche Adresse") ; + LEAVE peek WITH 0 + FI ; + TEXT VAR t := " " ; + replace (t, 1, block (block no)(block offset)) ; + code (t SUB ((shard adr AND 1) + 1)) +ENDPROC peek ; + + +INT PROC peek2 (INT CONST shard adr) : + INT VAR r := peek (shard adr + 1) ; + rotate (r, 8) ; + r + peek (shard adr) +ENDPROC peek2 ; + + +PROC get partition : + INT VAR partition, cyls, heads, secs ; + get media size (setup channel, cyls, heads, secs) ; + get partition table ; + get partition number from user ; + line ; + IF (partition size high AND -256) <> 0 OR + (partition start high AND -256) <> 0 + THEN errorstop ("Sorry, Partitionsangaben zu hoch") + FI ; + line ; + partition start1 := real24 (partition start high, partition start low)-1.0; + partition size := real24 (partition size high, partition size low) ; + putline ("Platte hat " + text (cyls) + " Cylinder, " + text (heads) + + " Heads, " + text (secs) + " Sektoren = " + + text (real(cyls)*real(heads)*real(secs)/2048.0, 5, 1) + " MB") ; + putline ("Partionsanfang: " + + text ((partition start 1+1.0)/2.0, 6, 0) + " KB = Cylinder " + + text (int ((partition start 1+1.0)/real(secs)/real(heads)))) ; + putline ("Partionsgrsse: " + text (partition size/2.0, 6, 0) + " KB = " + + text (int (partition size/real(secs)/real(heads))) + " Cylinder"); + put ("Diese Partition ist") ; + IF NOT partition active + THEN put (""15"nicht"14"") + FI ; + putline ("aktiviert.") ; + line . + +get partition table : + blockin (setup channel, partition table, 0.0) . + +get partition number from user : + FOR partition FROM 1 UPTO max partitions REP + IF eumel partition CAND yes ("EUMEL-Partiton " + + text (partition type) + " patchen") + THEN LEAVE get partition number from user + FI + PER ; + partition := 0 ; + errorstop ("Keine EUMEL Partition gefunden") . + + +eumel partition : + partition type >= 69 AND partition type <= 72 . + +entry : 216 + partition * 8 . +partition active : bit (partition table (entry), 7) . +partition type : partition table (entry + 2) AND 255 . +partition start low : partition table (entry + 4) . +partition start high: partition table (entry + 5) . +partition size low : partition table (entry + 6) . +partition size high: partition table (entry + 7) . + +ENDPROC get partition ; + +PROC read shard : + INT VAR i ; + old session := session ; + FOR i FROM 1 UPTO shard bloecke REP + cout (i) ; + modified (i) := FALSE ; + blockin (setup channel, block (i), partition start1 + real(i-1)) + PER ; +ENDPROC read shard ; + + +PROC write shard : + INT VAR i ; + FOR i FROM 1 UPTO shard bloecke REP + IF modified (i) + THEN IF session <> old session + THEN errorstop ("RERUN whrend patch") + FI ; + blockout (setup channel, block (i), partition start1+real(i-1)) ; + modified (i) := FALSE + FI ; + cout (i) + PER +ENDPROC write shard ; + +REAL PROC real24 (INT CONST high, low) : + real (high) * 65536.0 + low real . + +low real : + IF low < 0 + THEN real (low) + 65536.0 + ELSE real (low) + FI +ENDPROC real24 ; + +PROC split real24 (REAL CONST r, INT VAR high, low) : + high := int (r/65536.0) ; + low := (code (int (r MOD 256.0)) + + code (int ((r MOD 65536.0)/256.0))) ISUB1 +ENDPROC split real24 ; + +PROC patch shard : + get partition ; + read shard ; + check if patch possible ; + patch baudrate ; + patch id and mode ; + patch typematic ; + patch refresh ; + patch modem status ; + patch cursor maxima ; + patch attribute bytes ; + patch out restart ; + patch dtr inactive ; + patch mcr set routine ; + patch archive 1 format ; + IF yes ("nderungen permanent machen") + THEN write shard ; + putline ("nderungen durchgefhrt, System neu booten.") ; + ELSE putline ("Keine nderungen durchgefhrt.") ; + FI . + +check if patch possible : + IF peek2 (&"0300") <> &"05EA" + THEN errorstop ("Partition enthaelt keinen SHard") + ELSE IF peek2 (shard ver) <> 7 + THEN errorstop ("Dies ist die falsche SHard-Version") + ELIF peek2 (id6) = patch version + THEN putline ("Hinweis: Dieser SHard wurde bereits gepatcht") + ELIF peek2 (id6) <> 0 + THEN putline ("Der SHard-Patch wird upgedated") + FI + FI . + +shard ver: &"0554" . +mode: &"0556" . +id 6: &"055C" . + +patch baudrate : + putline ("Baudrates 50, 75 entfernt, 19200, 38400 eingefgt.") ; + poke2 (&"07E8", 1047) ; (* 3: 110 *) + poke2 (&"07EA", 857) ; (* 4: 134.5 *) + poke2 (&"07EC", 768) ; (* 5: 150 *) + poke2 (&"07EE", 384) ; (* 6: 300 *) + poke2 (&"07F0", 192) ; (* 7: 600 *) + poke2 (&"07F2", 96) ; (* 8: 1200 *) + poke2 (&"07F4", 64) ; (* 9: 1800 *) + poke2 (&"07F6", 48) ; (* 10: 2400 *) + poke2 (&"07F8", 32) ; (* 11: 3600 *) + poke2 (&"07FA", 24) ; (* 12: 4800 *) + poke2 (&"07FC", 16) ; (* 13: 7200 *) + poke2 (&"07FE", 12) ; (* 14: 9600 *) + poke2 (&"0800", 6) ; (* 15: 19200 *) + poke2 (&"0802", 3) ; (* 16: 38400 *) + + (* Korrektur der Adressoffsetberechnung auf Baudtable *) + (* Maschinencode nicht veraendern! + 08F4: + i8250_baud: + CMP BH,17 + JNC i8250_not_ok + CMP BH,3 + JC i8250_not_ok + .... + 0918: + MOV AX,WORD PTR i8250_baud_table-6[BX] +*) + poken (&"08F4", "17 73 75 80 FF 03 72 70") ; + poken (&"0918", "87 E2") . + +patch id and mode : + poke2 (id6, patch version) ; (* Update Patch Version *) + IF yes ("Soll ein Vortest durchgefhrt werden") + THEN IF yes ("Soll ein Speichertest durchgefuehrt werden") + THEN poke2 (mode, 0) + ELSE poke2 (mode, 256) + FI + ELSE poke2 (mode, 512) + FI . + +patch modem status: + poke (&"0A5D", 6) . (* Modem Status Register Offset = 6 *) + +patch typematic: (* Nur mit ruc-Bios *) + INT VAR typematic ; + IF yes ("Schneller Keyboardrepeat") + THEN typematic := 4 (* Fast *) + ELSE typematic := 2 * 256 + 12 (* Standard *) + FI ; + (* Maschinencode, nicht veraendern! + 0E20: + XOR AX,AX ; Set Default Video Mode + INT 10H + MOV AX,0342 ; Set Typematic + Marwin + MOV BX,typematic ; BH = Delay (0..3), BL = Rate (0..31) + INT 16H + 0E2C: + MOV AL,54H ; Ab hier in 'patch refresh' + OUT [43H],AL ; + JMP $+2 ; + MOV AL,interval ; interval = 1.19 * us + OUT [41H],AL ; + RET ; End pc_init +*) + poken (&"0E20", "33 C0 CD 10 B8 42 03 BB " + %typematic + " CD 16 C3") . + (* RET wird ueberschrieben von Refresh *) + +patch refresh: + INT VAR refresh ; + TEXT VAR ref := "15.126" ; + line ; + putline ("215us Refresh-Intervall bringen 5% mehr RAM-Performance.") ; + putline ("Achtung: Nicht bei allen RAMs moeglich (z.B. 120ns Toshiba nicht).") ; + put ("RAM-Refresh Intervall (in us):") ; + editget (ref) ; line ; + refresh := int (1.19 * real (ref) + 0.5) ; + IF refresh < 1 + THEN refresh := 1 + ELIF refresh > 255 + THEN refresh := 256 + FI ; + put (real (refresh) / 1.19) ; + putline ("us Refresh-Intervall eingestellt.") ; + IF refresh = 256 THEN refresh := 0 FI ; + poken (&"0E2C", "B0 54 E6 43 EB 00 B0 " + subtext (%refresh, 3, 4) + + " E6 41 C3") . + +patch cursor maxima: +(* Es werden nur die Maxima bei CURSOR(,) veraendert, CLEOL, CLEOP,SCROLL + etc. arbeiten weiter mit 24 Zeilen, 80 Spalten *) + (* CURSOR y:0..43, x:0..89 EUMEL lsst allerdings nur 0..79 zu *) + poke (&"0EFF", 43) ; + poke (&"0F16", 89) . + +patch attribute bytes: + poke (&"0FD4", 0) ; poke (&"0FE8", 0) ; (* CLEOP *) + poke (&"1002", 0) ; (* CLREOL *) + poke (&"1027", 0) . (* SCROLL *) + +patch out restart : + poke (&"09BA", 0) . (* out_restart immer: JP $+0 *) + +patch dtr inactive : + poke (&"0A30", 8) . (* RTS + DTR inaktiv, OUT2 muss an bleiben *) + +patch mcr set routine : + (* + 0812: 20 Bytes zur Verfgung + MOV DX,(DI+i8250_base) + ADD DX,i8250_mcr + MOV AL,BH ; Highbyte 2. IOCONTROL Parameter + OUT [DX],AL + MOV CX,0 + RET + *) + poken (&"0812", "8B 95 1B 00 83 C2 04 88 F8 EE B9 00 00 C3") . + +patch archive 1 format : + line ; + putline ("Archiv-Kanal 30-Laufwerk (bitte Typnummer angeben):") ; + putline (" 0: Nicht vorhanden") ; + putline (" 1: 360K (Standard/Doublestep)") ; + putline (" 2: 720K (Standard/Singlestep)") ; + putline (" 3: 1.2MB (Multifunction)") ; + putline ("ESC: Nichts verndern") ; + put ("Typ:") ; + TEXT VAR t ; + REP inchar (t) UNTIL t >= "0" AND t <= "3" OR t = ""27"" PER ; + putline (t) ; + line ; + IF t = "0" OR t = "1" + THEN poken (&"21DE", "00 01") + ELIF t = "2" + THEN poken (&"21DE", "04 02") + ELIF t = "3" + THEN poken (&"21DE", "01 03") + FI . + +ENDPROC patch shard ; + +PROC blockin (INT CONST kanal, ROW 256 INT VAR block, REAL CONST blockno) : + INT VAR r, my channel :: channel, high, low ; + split real24 (blockno, high, low) ; + continue (kanal) ; + blockin (block, high AND 255, low, r) ; + continue (my channel) ; + SELECT r OF + CASE 0 : + CASE 1 : errorstop ("Harddisk kann nicht gelesen werden") + CASE 2 : errorstop ("Lesefehler bei Block " + text (blockno)) + CASE 3 : errorstop ("Block " + text(blockno) + " zu hoch") + OTHERWISE errorstop ("unbekannter Lesefehler auf Harddisk") + ENDSELECT . + +ENDPROC blockin ; + +PROC blockout (INT CONST kanal, ROW 256 INT VAR block, REAL CONST blockno): + INT VAR r, my channel :: channel, high, low ; + split real24 (blockno, high, low) ; + continue (kanal) ; + blockout (block, high AND 255, low, r) ; + continue (my channel) ; + SELECT r OF + CASE 0 : + CASE 1 : errorstop ("Harddisk kann nicht beschrieben werden") + CASE 2 : errorstop ("Schreibfehler bei Block " + text (blockno)) + CASE 3 : errorstop ("Block " + text (blockno) + " zu hoch") + OTHERWISE errorstop ("unbekannter Schreibfehler auf Harddisk") + ENDSELECT . + +ENDPROC blockout ; + +PROC get media size (INT CONST kanal, INT VAR cyls, heads, secs) : + INT CONST old channel :: channel ; + continue (kanal) ; + control (-10, 0, 0, cyls) ; cyls INCR 1 ; + control (-11, 0, 0, secs) ; + control (-12, 0, 0, heads) ; + continue (old channel) +ENDPROC get media size ; +(* +PROC dump block (INT CONST adr) : +TEXT VAR t ; +FOR i FROM adr UPTO adr+511 REP + IF (i AND 15) = 0 + THEN line ; + put (%i+":") ; + t := "" ; + FI ; + INT CONST j :: peek (i) ; + IF j < 32 OR j > 126 THEN t CAT "." + ELSE t CAT code (j) FI ; + outsubtext (%j, 3, 4) ; + out (" ") ; + IF (i AND 15) = 15 + THEN out (t) + FI +PER ; +line +ENDPROC dump block ; + +putline ("Partitionstabelle lesen...") ; +get partition ; +putline ("SHard lesen...") ; +read shard ; +put (%peek (1364)) ; +*) diff --git a/system/shard-x86-at/7/src/PATCHARE.ASM b/system/shard-x86-at/7/src/PATCHARE.ASM new file mode 100644 index 0000000..eb837e0 --- /dev/null +++ b/system/shard-x86-at/7/src/PATCHARE.ASM @@ -0,0 +1,17 @@ +;******************************************************** +;*==== Copyright (C) 1985,86 Martin Schoenbeck, Spenge =* +;* * +;* Bereich, der vom setup-Programm gepatcht wird * +;* * +;******************************************************** + + if at +bb_table dw 32 DUP (-1) + dw 32 DUP (-1) +max_bb equ 32 +bb_anz dw 0 + else +bt_table dw 8 DUP (-1) ;diese kopf/spur Kombination ist unmoeglich +bt_replace dw 8 DUP (-1) ;ersatz + endif + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/PCPAR.ASM b/system/shard-x86-at/7/src/PCPAR.ASM new file mode 100644 index 0000000..9ac1ebf --- /dev/null +++ b/system/shard-x86-at/7/src/PCPAR.ASM @@ -0,0 +1,226 @@ +;*************************************************************************** +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================* +;* * +;* Routinen fuer IBM - PC Parallel - Schnittstelle im EUMEL - System * +;* * +;* * +;*************************************************************************** + + device parallel + + dtcbroutines iocontrol + routine 1,para_devicetype + routine 2,para_frout + routine 5,nil_size + routine -3,para_force_rom_output + routine -4,para_set_wait + routine -1,no_channel_setup + + dtcbroutines control32 + routine -2,para_init + routine -1,no_channel_setup + + dtcbroutines blockin + dtcbroutines blockout + routine -1,unknowncontrol + + dtcbparams para_output,3 ;typ = nur stream io + + +;****************************************************************** +;* der macro para_ccb muss fuer jede parallelschnittstelle im system +;* einmal aufgerufen werden +;* +;* parameter: + +para_ccb macro par,kanal + startccb para&par&ccb,kanal +ccbentry para_number + dw par +ccbentry para_stat + db 0 +ccbentry para_statusandmask + db 80h ;;busy abfragen +ccbentry para_statusxormask + db 80h ;;active high +ccbentry para_wait ;;wie lange vor busy warten + db 1 +ccbentry para_retry + db 30 ;;> 100 usec minimum + endm + +para_rom_mode equ 1 + +para_devicetype: + mov cx,0 ;erstmal 0 setzen + call para_get_port + ifnz ;type dazu + ret + +para_init: + call para_get_port + ifz + test dx,0fc03h ;ist die adresse ibm like + jnz para_rom_init + inc dx + inc dx ;auf status ausgabe zeigen + mov al,8 ;init leitung aktivieren + out (dx),al + mov ax,4000 +para_ini_loop: + dec ax + jnz para_ini_loop ;warte ein weilchen + mov al,0ch ;kein auto lf, init high + out (dx),al + ret + +para_rom_init: + mov ah,1 + mov dx,[di+para_number] + int 17h + ;es passt noch + mov bx,dx ;nummer nach bx + mov byte ptr es:[078h+bx],1 ;timeout wert,falls er doch mal busy kriegt + ret + +para_set_wait: + inc dl + mov [di+para_wait],dl + inc dh + mov [di+para_retry],dh + ret + +para_force_rom_output: + or byte ptr [di+para_stat],para_rom_mode + ret + +para_output: + jcxz para_all + push es + push bx + call para_get_port + pop bx + pop es + jz para_all ;kein port, dann wegwerfen + test dx,0fc03h ;ist die adresse ibm like + jnz para_rom_output ;nein, ueber rom raus + test byte ptr [di+para_stat],para_rom_mode + jnz para_rom_output + push cx + inc dx ;auf status gehen +para_out_loop: + push cx + mov cl,[di+para_wait] + sub ch,ch ;0 nach ch + loop $ ;pause fuer langsame drucker + mov cl,[di+para_retry] + ;ch ist 0 +para_ow_loop: ;warten, bis output erlaubt + in al,dx ;status holen + and al,(di+para_statusandmask) ;welche bits interessieren uns + xor al,(di+para_statusxormask) ;und wie sollen sie stehen + jz para_ready ;passt, ausgeben + loop para_ow_loop + pop dx ;restlaenge holen + pop cx ;gesamtlaenge holen + sub cx,dx ;uebernommene laenge melden + ;carry ist geloescht + ret + +para_ready: + pop cx ;zeichenzaehler zurueckholen + dec dx ;auf port direkt gehen + mov al,byte ptr es:[bx] ;zeichen holen + inc bx ;auf naechstes zeichen + out (dx),al ;zeichen ausgeben + inc dx + inc dx ;auf port fuer strobe zeigen + mov al,0dh ;strobe ist bit 0 + out (dx),al + jmp short $+2 + mov al,0ch ;und strobe zuruecknehmen + out (dx),al + dec dx ;auf status port gehen + loop para_out_loop ;naechstes ausgeben + pop cx ;alles ausgegeben +para_all: + stc + ret + +para_rom_output: + push cx + mov dx,[di+para_number] +para_rom_out_loop: + push cx + mov cl,[di+para_wait] + sub ch,ch + loop $ ;pause fuer langsame drucker + mov cl,[di+para_retry] + shr cl,1 ;durch 16 + shr cl,1 + shr cl,1 + shr cl,1 + inc cl ;aber nie 65000 mal +para_rom_ow_loop: ;warten, bis output erlaubt + mov ah,2 ;status holen + int 17h + and ah,(di+para_statusandmask) ;welche bits interessieren uns + xor ah,(di+para_statusxormask) ;und wie sollen sie stehen + jz para_rom_ready ;passt, ausgeben + loop para_rom_ow_loop + pop dx ;restlaenge holen + pop cx ;gesamtlaenge holen + sub cx,dx ;uebernommene laenge melden + ;carry ist geloescht + ret + +para_rom_ready: + pop cx ;zeichenzaehler zurueckholen + mov al,byte ptr es:[bx] ;zeichen holen + inc bx ;auf naechstes zeichen + mov ah,0 ;zeichen ausgeben + int 17h + loop para_rom_out_loop ;naechstes ausgeben + pop cx ;alles ausgegeben + stc + ret + +para_frout: + call para_get_port + jz para_frout_ok + test dx,0fc03h ;ist die adresse ibm like + jnz para_rom_frout ;nein, ueber rom fragen + test byte ptr [di+para_stat],para_rom_mode + jnz para_rom_frout + inc dx ;auf status gehen + in al,dx ;status holen + and al,(di+para_statusandmask) ;welche bits interessieren uns + xor al,(di+para_statusxormask) ;und wie sollen sie stehen + jnz para_frout_not_ok ;passt nicht, melden +para_frout_ok: + mov cx,50 ;kann ausgeben + stc ;puffer leer + ret + +para_rom_frout: + mov dx,[di+para_number] + mov ah,2 ;status holen + int 17h + and ah,(di+para_statusandmask) ;welche bits interessieren uns + xor ah,(di+para_statusxormask) ;und wie sollen sie stehen + jz para_frout_ok ;passt, melden +para_frout_not_ok: + mov cx,0 ;nichts passt + clc ;puffer nicht leer + ret + +para_get_port: + ;setzt zero flag, wenn port = 0 + mov ax,40h ;ins pc datensegment + mov es,ax + mov bx,[di+para_number] ;welcher printer + shl bx,1 ;fuer basis adresse passend + mov dx,es:[8+bx] ;printer basis adresse holen + or dx,dx ;0? + ret + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/PCPLOT.ASM b/system/shard-x86-at/7/src/PCPLOT.ASM new file mode 100644 index 0000000..6718e12 --- /dev/null +++ b/system/shard-x86-at/7/src/PCPLOT.ASM @@ -0,0 +1,430 @@ +;**************************************************************************** +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================* +;* * +;* Graphikroutinen fuer IBM - PC * +;* * +;* * +;**************************************************************************** + +gr_base dw 03d0h ;default grahpic adress + +gr_pointer equ 4 ;pointer register of 6845 +gr_data equ 5 ;data register of 6845 +gr_msr equ 8 ;mode select register +gr_csr equ 9 ;color select register +gr_status equ 10 ;status register +gr_xmsr equ 10 ;extended mode select register +gr_cfgswitch equ 15 ;hercules config switch + +switch_mode: + cmp dh,1 + jz gm_switch ;tecmar graphics master + cmp dh,2 ;hercules + jz herc_switch + push dx + push ax + mov dx,[gr_base] + add dx,gr_xmsr ;tecmar auf normal mode setzen + mov al,0 + out (dx),al + jmp short $+2 ;io pause machen + add dx,gr_cfgswitch-gr_xmsr ;hercules configswitch + out (dx),al + pop ax + pop dx + mov byte ptr [plot_mode],0 ;kein mode, den wir direkt auswerten + mov al,dl + mov ah,0 + int 10h ;auf gewuenschten mode schalten + mov cx,0 + jnc mode_ok +unallowed_mode: + mov cx,-1 +mode_ok: + ret + +herc_switch: + mov word ptr [gr_base],03b0h + cmp dl,1 ;mode 0 ist erlaubt + jnc unallowed_mode + add dl,6 ;da steht der erste herculesmode + jmp short all_allowed +gm_switch: ;tecmar graphics master + cmp dl,6 ;werte 0 bis 5 erlaubt + jnc unallowed_mode + push dx + mov dx,[gr_base] + add dx,gr_status ;statusregister holen + in al,dx + pop dx + test al,80h ;schalter auf monochrom + jnz all_allowed ;nein, alle modi erlaubt + cmp dh,2 ;nur 0 und 1 + jnc unallowed_mode +all_allowed: + mov byte ptr [plot_mode],1 ;merken, dass in erweitertem mode + mov dh,0 + mov ax,offset mod_tb_length ;laenge einer tabelle + mul dx ;auf passende tabelle zeigen + mov bx,ax + add bx,offset mod_tables ;auf erstes byte der tabelle +; + mov ah,13 ;vierzehn register muessen ausgegeben werden + mov dx,[gr_base] + add dx,gr_msr ;da ist mode select register unserer graphik + mov al,0 ;disable screen output + out (dx),al + jmp short $+2 + add dx,gr_cfgswitch-gr_msr ;hercules einschalten (wenn da) + mov al,3 + out (dx),al + sub dx,gr_cfgswitch-gr_pointer + +set_6845: + mov al,ah + out (dx),al ;in dieses register wollen wir schreiben + inc dx ;und hier muss der wert hin + mov al,byte ptr [bx] + inc bx ;auf naechstes feld + out (dx),al + dec dx ;wieder auf zeiger_register + dec ah + jns set_6845 ;bis nummer negativ +; + cld + mov cx,08000h ;fill 64k + mov ax,0a000h + mov es,ax + xor ax,ax ;fill with 0 + xor di,di ;start at 0 in area + rep stosw + mov cx,08000h + mov ax,0b000h ;next 64k + mov es,ax + xor ax,ax ;fill with 0 + xor di,di ;start at 0 in area + rep stosw +; + mov al,byte ptr[bx] ;csr wert holen + inc bx + add dx,gr_csr-gr_pointer + out (dx),al +; + inc dx ;to xmsr + mov al,byte ptr [bx] + inc bx + out (dx),al +; + sub dx,gr_xmsr-gr_msr ;to msr + mov al,byte ptr [bx] + inc bx + out (dx),al +; + mov ax,word ptr [bx] ;laenge einer graphik zeile + inc bx + inc bx + mov word ptr [gr_linelength],ax +; + mov al,byte ptr [bx] ;maske, um ein pixel zu behalten + push ds + pop es + mov cx,16 + mov di,offset color_tab + rep stosb ;farbtabelle auf 3 initalisieren + mov ah,0 + inc bx + mov word ptr [gr_pixel_mask],ax + xor al,0ffh ;maske erzeugen, die ein pixel loescht + mov byte ptr [gr_pixel_inv_mask],al +; + mov word ptr [first_shift],9090h ;ersten shift wegnoppen + test byte ptr [bx],1 ;vier segmente ? + ifnz ;shift wieder eintragen + inc bx +; + mov al,byte ptr [bx] ;mask fuer pixel_pro_byte holen + inc bx + mov byte ptr [gr_pixel_per_byte_mask],al + mov word ptr [shift_count_shift],0c902h ;volles shift annehmen + mov word ptr [shift_count_shift+2],0c902h ;add cl,cl + mov ah,1 ;anzahl shifts, um byteoffset zu kriegen + shr al,1 ;bei mehr als zwei pixel ein shift weniger + jz shifts_nopped + inc ah + mov word ptr [shift_count_shift],09090h ;nops + shr al,1 ;bei acht pixel gar kein shift + jz shifts_nopped + inc ah + mov word ptr [shift_count_shift+2],09090h ;nops +shifts_nopped: + mov byte ptr [gr_byte_calc_shift],ah +; + mov si,bx + mov di,offset gr_segtable + mov cx,4 + rep movsw ;segmentwerte uebertragen + add bx,8 + mov cx,0 + ret + +pen: + mov word ptr [maske],dx + mov byte ptr [linetype],bl + ret + +new_pen1: + mov cx,bx ;bx merken + mov bx,offset color_tab + call set4 + mov cx,dx + call set4 + ret + +new_pen2: + mov cx,bx ;bx merken + mov bx,offset color_tab+8 ;zweite haelfte der tabelle + call set4 + mov cx,dx + call set4 + ret + +set4: + call set2 + mov cl,ch +set2: + mov al,cl + and al,15 ;nur untersten 4 bits behalten + mov byte ptr [bx],al + inc bx + mov al,cl + mov cl,4 + shr al,cl ;obersten 4 bits + mov byte ptr [bx],al + inc bx + ret + +mask_mode: + mov word ptr [jmp_or_not],9090h ;set mask mode + mov cx,word ptr [mask_count] ;alten mask_count zurueckliefern + mov word ptr [mask_count],bx + cmp dx,0 ;wirklich mask_mode gewuenscht + ifz ;nein, sprung wieder einbauen + ret + +move: + mov word ptr [altx],dx ;neuen x wert + mov word ptr [alty],bx ;und y wert setzen + ret + +draw: + mov byte ptr [stepx],46h ;inc si + mov byte ptr [stepy],47h ;inc di + mov cx,dx ;in welche richtung wie weit gehen + sub cx,word ptr [altx] + jns positiv_x + neg cx ;negative richtung, positiv machen und + mov byte ptr [stepx],4eh ;dec si zum ausgleich +positiv_x: + mov dx,bx ;y wert holen + sub dx,word ptr [alty] ;wie weit und welche richtung + jns positiv_y + neg dx ;negative richtung, positiv rechnen und + mov byte ptr [stepy],4fh ;dec di zur korrektur +positiv_y: + cmp dx,cx ;hauptrichtung entlang des groesseren + ;offsets + jc direction_ok ;hauptrichtung war entlang si + mov bx,word ptr [stepy] ;richtungen tauschen + xchg bh,bl + mov word ptr [stepy],bx + xchg cx,dx ;und richtungslaengen tauschen + ;hauptrichtung ist jetzt entlang di +direction_ok: + ;der wert fuer die hauptrichtung ist + ;in cx, fuer die nebenrichtung in dx + ;der fehlerwert der nebenrichtung in + ;1/abs(hauptrichtung) - einheiten ist in bx + mov bx,0 ;fehlerwert ist im moment 0 + mov word ptr [delta_x],cx ;wert fuer hauptrichtung merken + mov si,word ptr [altx] ;alte werte holen + mov di,word ptr [alty] +paint: + jcxz paint_done ;fertig, letzten punkt noch malen + sub bx,dx ;ist gerader fehler schon negativ + jns stepx ;nur hauptrichtung nehmen + mov ax,bx ;geraden fehler nach ax + add ax,ax ; + add ax,word ptr [delta_x] ; + jns stepx ;nur hauptrichtung + add bx,word ptr [delta_x] +stepy: + inc di +stepx: + inc si + +; errechneten punkt setzen + + call punkt + + loop paint + +paint_done: + call punkt ;letzten punkt setzen + mov word ptr [alty],di + mov word ptr [altx],si + ret + + +punkt: + test byte ptr [plot_mode],0ffh + jnz new_punkt + push cx + push dx + mov dx,di + mov cx,si + ror word ptr maske,1 +linetype equ $+1 + mov ax,0c01h ;write dot + and al,byte ptr [maske] ;linie einbauen + int 10h + pop dx + pop cx + ret + +new_punkt: + push ax + push bx + push cx + push dx + push es + mov bx,di + and bx,3 + add bx,bx ; *2 + mov es,[bx+gr_segtable] ;in diesem segment liegt unser punkt +gr_linelength equ $+1 + mov ax,720/4 ;bytes pro zeile horizontal + mov bx,di ;y wert wieder holen +first_shift: ;dieser shift faellt bei zwei segmenten aus + shr bx,1 + shr bx,1 ;di / 4 + mul bx ;mal anzahl bytes pro graphikzeile + mov bx,si ;byte in zeile ausrechnen +gr_byte_calc_shift equ $+1 + mov cl,2 ;so oft si shiften, fuer byte in zeile + shr bx,cl + add bx,ax ;dies byte enthaelt unseren punkt + mov cx,si ;untersten bits geben shiftfaktor an + inc cx ;einmal mehr shiften (oder gar nicht) +gr_pixel_per_byte_mask equ $+2 + and cl,3 ;vier pixel pro byte (15 fuer zwei pixel etc +shift_count_shift: + add cl,cl ;shiftfaktor verdoppeln + add cl,cl ;oder vervierfachen + mov al,byte ptr es:[bx] ;byte holen + rol al,cl ;pixel nach 0 holen + mov bp,ax ;evtl. wird pixelwert als index benutzt +gr_pixel_mask equ $+2 + and bp,3 ;die pixel bits behalten +jmp_or_not: + jmp short punkt_no_mask +mask_count equ $+1 ;zaehler fuer maske + mov bp,0 + and bp,15 ;maskenzaehler MOD 16 nehmen +punkt_no_mask: +gr_pixel_inv_mask equ $+1 + and al,0fch ;rest behalten + or al,byte ptr ds:[bp+color_tab] ;pixel setzen + ror al,cl ;zurueckdrehen + mov byte ptr es:[bx],al ;wieder eintragen + inc word ptr ds:[mask_count] + pop es + pop dx + pop cx + pop bx + pop ax + ret + + even + +maske dw 0ffffh +altx dw 0 +alty dw 0 +delta_x dw 0 +;gr_pixel_mask dw 3 ;maske, welche bits zum pixel gehoeren +;mask_count dw 0 ;zaehler fuer maskiertes schreiben + +gr_segtable dw 0a000h ;tabelle der graphik segmente + dw 0a800h + dw 0b000h + dw 0b800h + + +;gr_linelength dw 720/4 ;laenge einer graphikzeile +;mask_mod db 0 ;nicht 0, wenn mit maske +color_tab db 16 DUP (3) ;farbtabelle + +plot_mode db 0 + +;gr_pixel_inv_mask db 0fch ;invertiert, nur byte + + + +mod_tables equ $ +;mode 0 +; 6845 regs 13 - 0,csr,xmsr,msr + db 0,0,0,32,3,2,88,86,1,91,14,90,90,109, 0, 191, 11 + dw 720/4 ;laenge einer graphikzeile + db 3 ;maske, um ein pixel zu behalten + db 1 ;1 = 4 segmente, 0 = 2 segmente + db 3 ;maske, um si MOD pixel_pro_byte zu machen + dw 0a000h,0a800h,0b000h,0b800h ;die vier segmente +mod_tb_length equ $-mod_tables +;mode 1 +; 6845 regs 13 - 0,csr,xmsr,msr + db 0,0,0,32,3,3,88,86,1,91,14,90,90,109, 0, 191, 11 + dw 720/4 ;laenge einer graphikzeile + db 3 ;maske, um ein pixel zu behalten + db 1 ;1 = 4 segmente, 0 = 2 segmente + db 3 ;maske, um si MOD pixel_pro_byte zu machen + dw 0a000h,0a800h,0b000h,0b800h ;die vier segmente +;mode 2 +; 6845 regs 13 - 0,csr,xmsr,msr + db 0,0,0,32,1,2,112,100,6,127,15,184,160,227, 0, 31, 24 + dw 640/2 ;laenge einer graphikzeile + db 15 ;maske, um ein pixel zu behalten + db 0 ;1 = 4 segmente, 0 = 2 segmente + db 1 ;maske, um si MOD pixel_pro_byte zu machen + dw 0a000h,0a800h,0a000h,0a800h ;die vier segmente +;mode 3 +; 6845 regs 13 - 0,csr,xmsr,msr + db 0,0,0,32,3,3,56,50,1,64,15,184,160,227, 0, 31, 24 + dw 640/2 ;laenge einer graphikzeile + db 15 ;maske, um ein pixel zu behalten + db 1 ;1 = 4 segmente, 0 = 2 segmente + db 1 ;maske, um si MOD pixel_pro_byte zu machen + dw 0a000h,0a800h,0b000h,0b800h ;die vier segmente +;mode 4 +; 6845 regs 13 - 0,csr,xmsr,msr + db 0,0,0,32,1,2,112,100,7,127,15,98,90,128, 0, 63, 11 + dw 720/4 ;laenge einer graphikzeile + db 3 ;maske, um ein pixel zu behalten + db 0 ;1 = 4 segmente, 0 = 2 segmente + db 3 ;maske, um si MOD pixel_pro_byte zu machen + dw 0a000h,0a800h,0a000h,0a800h ;die vier segmente +;mode 5 +; 6845 regs 13 - 0,csr,xmsr,msr + db 0,0,0,32,3,3,56,50,3,64,15,98,90,128, 0, 63, 11 + dw 720/4 ;laenge einer graphikzeile + db 3 ;maske, um ein pixel zu behalten + db 1 ;1 = 4 segmente, 0 = 2 segmente + db 3 ;maske, um si MOD pixel_pro_byte zu machen + dw 0a000h,0a800h,0b000h,0b800h ;die vier segmente +;mode 6 (hercules) +; 6845 regs 13 - 0,csr,xmsr,msr + db 0,0,0,0,3,2,87,87,2,91,7,46,45,53, 0, 0, 10 + dw 720/8 ;laenge einer graphikzeile + db 1 ;maske, um ein pixel zu behalten + db 1 ;1 = 4 segmente, 0 = 2 segmente + db 7 ;maske, um si MOD pixel_pro_byte zu machen + dw 0b000h,0b200h,0b400h,0b600h ;die vier segmente +  \ No newline at end of file diff --git a/system/shard-x86-at/7/src/PCSCREEN.ASM b/system/shard-x86-at/7/src/PCSCREEN.ASM new file mode 100644 index 0000000..9fe7d9e --- /dev/null +++ b/system/shard-x86-at/7/src/PCSCREEN.ASM @@ -0,0 +1,438 @@ +;*************************************************************************** +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================* +;* * +;* Behandlung des PC Bildschirms und der Tastatur * +;* * +;*************************************************************************** + + device pc + + dtcbroutines iocontrol + routine 1,devicetype + routine 2,frout_ok + routine 5,nil_size + routine 6,priv_op_question + routine 8,priv_op_question + routine 9,priv_op_question + routine -3,set_attribute + routine -4,set_palette + routine -5,switch_mode + routine -6,draw + routine -7,move + routine -8,pen + routine -9,new_pen1 + routine -10,new_pen2 + routine -11,mask_mode + + routine -1,unknowncontrol + + dtcbroutines control32 + routine -2,pc_init + routine -1,no_channel_setup + + dtcbroutines blockin + dtcbroutines blockout + routine -1,unknowncontrol + + dtcbparams pc_output,3 ;typ = nur stream io + + +;*************************************************************************** + +pc_init: +breakaddress equ 01bh*4 ;tastatur break adresse + mov bx,0 + mov es,bx ;in die interrupt vektoren zeigen + mov word ptr es:[breakaddress+2],cs + mov word ptr es:[breakaddress],offset breakint + mov dx,0 ;cursor in die obere ecke + mov bh,0 + mov ah,2 ;cursor setzen + int 10h + mov ax,0600h ;clear entire window + mov cx,0 ;von oben + mov dx,25*256+80 ;bis unten + mov bh,7 ;attribut + int 10h + ret + +; +breakint: + push cx + push ax + push ds + push cs + pop ds +; mov al,1 +; mov ch,'i' +; call inputinterrupt + mov al,1 + mov ch,2 ;sv + call inputinterrupt + pop ds + pop ax + pop cx + iret +; +; +; +REVERS EQU 01110000B ;ATTRIBUT FUER REVERS-VIDEO +NORMAL EQU 00000111B ;ATTRIBUT FUER NORMAL-VIDEO +HOME EQU 1 +RECHTS EQU 2 +OBEN EQU 3 +CLEOP EQU 4 ;CLEAR TO END OF PAGE +CLEOL EQU 5 ;CLEAR TO END OF LINE +CPOS EQU 6 ;CURSOR-POSITIONIERUNG +; ES FOLGEN X- UND Y-KOORDINATE +BELL EQU 7 +LINKS EQU 8 +UNTEN EQU 10 +RETURN EQU 13 +BEGMARK EQU 15 +ENDMARK EQU 14 +MAXCOLS EQU 79 +MAXLINES EQU 23 +ATTRIBUT DB NORMAL +CURFLAG DB 0 +YPOS DB 0 +; +;*********************************************************************** +;* output auf bildschirm des pc +;* +pc_output: + PUSH CX ;RETTE ORIGINALLAENGE DES STRINGS + CLD ;DIRECTION FLAG : INCREM. SI + MOV SI,BX +OUT: mov al,es:[si] ;HOLE ZEICHEN + inc si + MOV AH,CURFLAG + CMP AH,0 + JNZ s0 + CMP AL,HOME + JZ s1 ;CURSOR HOME VERLANGT ? + CMP AL,RECHTS + JZ s2 ;CURSOR NACH RECHTS ? + CMP AL,OBEN + JZ s3 ;CURSOR NACH OBEN ? + CMP AL,CLEOP + JZ s4 ;LOESCHEN BIS BILDSCHIRMENDE ? + CMP AL,CLEOL + JZ s5 ;LOESCHEN BIS ZEILENENDE ? + CMP AL,CPOS + JZ s6 ;CURSOR POSITIONIEREN ? + CMP AL,LINKS + JZ s7 ;CURSOR NACH LINKS? + CMP AL,UNTEN + JZ s8 ;CURSOR NACH UNTEN ? + CMP AL,RETURN + JZ s9 ;CURSOR AN DEN ANFANG DER AKT. ZEILE ? + CMP AL,BEGMARK + JZ s10 ;AB JETZT REVERS ? + CMP AL,ENDMARK + JZ s11 ;WIEDER NORMALE VIDEO-DARSTELLUNG ? + CMP AL,BELL + JZ s12 ;KLINGELN ? +; + PUSH CX + PUSH BX + PUSH SI + PUSH AX ;AKTUELLES ATTRIBUT + MOV AL,ATTRIBUT + MOV BL,AL + POP AX + MOV AH,9 ;SCHREIBEN MIT ATTRIBUT + MOV BH,0 ;PAGE # + MOV CX,1 + INT 010H ;CALL BIOS + MOV AH,3 ;GET CURRENT CURSOR-POSITION + MOV BH,0 ;PAGE # + INT 010H ;CALL BIOS + INC DL ;COL = COL + 1 + CMP DL,MAXCOLS+1 + JNZ SAME_LINE + MOV DL,0 + CMP DH,MAXLINES + JZ SCROLL_UP + INC DH +SAME_LINE: MOV AH,2 + mov bh,0 ;page number + INT 010H + POP SI + POP BX + POP CX + JMP DONE +; +SCROLL_UP: CALL SCROLL + JMP SAME_LINE +; +DONE: DEC CX ;ANZAHL ZEICHEN = ANZAHL ZEICHEN - 1 + JNZ OUT ;WEITER ? + POP CX ;ANZAHL UEBERNOMMENE ZEICHEN (S.O.) + RET +; +s0: JMP CUR1 +s1: JMP CURHOME +s2: JMP RIGHT +s3: JMP UP +s4: JMP CLEAREOP +s5: JMP CLEAREOL +s6: JMP CURPOS +s7: JMP LEFT +s8: JMP DOWN +s9: JMP ENTER +s10: JMP MARK +s11: JMP UNMARK +s12: JMP KLINGELN +; +; +CURPOS:MOV AL,2 + MOV CURFLAG,AL + JMP DONE +; +CUR1: CMP AH,1 + JZ CURX + cmp al,maxlines + jc cur1ok + mov al,maxlines +cur1ok: + MOV YPOS,AL + DEC CURFLAG + JMP DONE + +CURX: DEC CURFLAG + MOV DH,YPOS;Y-KOORDINATE + cmp al,maxcols + jc curxok + mov al,maxcols +curxok: + MOV DL,AL ;X-KOORDINATE + PUSH BX + PUSH CX + PUSH SI + MOV BH,0 ;PAGE # + MOV AH,2 ;SET CURSOR POSITION + INT 010H ;CALL BIOS + POP SI + POP CX + POP BX + JMP DONE +; +CURHOME: PUSH BX + PUSH CX + PUSH SI + MOV BH,0 ;PAGE # + MOV DX,0000H ;POSITION (0,0) + MOV AH,2 + INT 010H ;CALL BIOS + POP SI + POP CX + POP BX + JMP DONE +; +RIGHT: PUSH BX + PUSH CX + PUSH SI + MOV AH,3 ;GET CURRENT CURSOR-POSITION + MOV BH,0 ;PAGE # + INT 010H ;CALL BIOS + CMP DL,MAXCOLS ;X-POSITION DES CURSOR ZU GROSS? + JZ RUNTER + INC DL ;COL = COL + 1 + MOV AH,2 + INT 010H + POP SI + POP CX + POP BX + JMP DONE +RUNTER:MOV DL,0 + MOV BH,0 + mov ah,2 + INT 010H + JMP down1 +; +LEFT: PUSH BX ;KOMMENTARE : S.O. + PUSH CX + PUSH SI + MOV AH,3 + MOV BH,0 + INT 010H + DEC DL + MOV AH,2 + INT 010H + POP SI + POP CX + POP BX + JMP DONE +; +UP: PUSH BX + PUSH CX + PUSH SI + MOV AH,3 + MOV BH,0 + INT 010H + DEC DH + MOV AH,2 + INT 010H + POP SI + POP CX + POP BX + JMP DONE +; +DOWN: PUSH BX + PUSH CX + PUSH SI +down1: MOV AH,3 + MOV BH,0 + INT 010H + CMP DH,MAXLINES + JZ SCRL + INC DH + MOV AH,2 + INT 010H + POP SI + POP CX + POP BX + JMP DONE +SCRL: CALL SCROLL + POP SI + POP CX + POP BX + JMP DONE +; +; +ENTER: PUSH BX + PUSH CX + PUSH SI + MOV AH,3 + MOV BH,0 + INT 010H + MOV DL,0 + MOV AH,2 + INT 010H + POP SI + POP CX + POP BX + JMP DONE +; +; +CLEAREOP: PUSH BX + PUSH CX + PUSH SI + MOV AH,3 ;GET CURRENT CURSOR-POSITION + MOV BH,0 ;PAGE # + INT 010H ;CALL BIOS + MOV CX,DX ;CURRENT CURS.POS = UPPER LEFT CORNER + MOV DL,maxcols ;END OF LINE + MOV AX,600H;AH=6 : SCROLL AL=0 : BLANK WINDOW + MOV BH,7 ;ATTRIBUTE FOR CLS + INT 010H ;CLEAR TO END OF LINE + MOV CL,0 + CMP DH,MAXLINES + JZ FERTIG + INC CH + MOV DH,MAXLINES ;NEW LOWER RIGHT CORNER + MOV DL,MAXCOLS + MOV AX,600H + MOV BH,7 ;ATTRIBUTE FOR CLS + INT 010H +FERTIG:POP SI + POP CX + POP BX + JMP DONE +; +CLEAREOL: PUSH BX + PUSH CX + PUSH SI + MOV AH,3 ;GET CURRENT CURSOR-POSITION + MOV BH,0 ;PAGE # + INT 010H ;CALL BIOS + MOV CX,DX ;CURRENT CURS.POS = UPPER LEFT CORNER + MOV DL,maxcols ;END OF LINE + MOV AX,600H;AH=6 : SCROLL AL=0 : BLANK WINDOW + MOV BH,7 ;ATTRIBUTE FOR CLS + INT 010H ;CLEAR TO END OF LINE + POP SI + POP CX + POP BX + JMP DONE +; +MARK: + MOV ATTRIBUT,revers + JMP DONE +; +UNMARK: + MOV ATTRIBUT,normal + JMP DONE +; +SCROLL:MOV AH,6 + MOV AL,1 ;SCROLL WINDOW ONE LINE UP + MOV CX,0000H ;UPPER LEFT CORNER : (0,0) + MOV DH,MAXLINES + MOV DL,MAXCOLS + mov bh,7 ;attribute for scroll + INT 010H + MOV DH,MAXLINES + MOV DL,0 + MOV BH,0 ;PAGE # + RET +; +; +KLINGELN: PUSH BX + PUSH CX + PUSH SI + MOV AH,14 + MOV BH,0 + INT 010H ;PIEEPS + POP SI + POP CX + POP BX + JMP DONE +; +set_attribute: + mov attribut,dl + ret + +set_palette: + mov ah,11 ;set color palette + int 10h + ret + +; +; +; +;********************************************************************** +;* +;* checkkey prueft ob ein zeichen auf der tastatur eingegeben wurde +;* und uebergibt dies ggf. dem EUMEL; +;* muss regelmaessig (z.B. aus timerinterrupt aufgerufen werden +; +checkkey: + push ax +checkagain: + MOV AH,1 ;Z-FLAG GESETZT : ZEICHEN ! + cli + INT 016H ;INPUT FROM KEYBOARD + JZ NO_KEY ;NEIN,KEINE TASTE GEDRUECKT + MOV AH,0 + INT 016H ;JA, ZEICHEN ABHOLEN + cmp ax,0 ;kommt von 'break' + jz no_key + cmp al,0 ;extended code + jnz normal_key + mov al,ah ;mit bit acht kennzeichnen + or al,80h +normal_key: + push cx + MOV CH,AL + MOV AL,1 ;KANAL-NUMMER + CALL inputinterrupt + pop cx + sti + jmp checkagain +NO_KEY: + sti + pop ax + ret +; + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/PCSYS.ASM b/system/shard-x86-at/7/src/PCSYS.ASM new file mode 100644 index 0000000..6bc457f --- /dev/null +++ b/system/shard-x86-at/7/src/PCSYS.ASM @@ -0,0 +1,131 @@ +;************************************************************************** +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ================* +;* * +;* PC spezifische, deviceunabhaengige routinen * +;* * +;************************************************************************** + +limit: + mov dx,0FFFh + push ax + push cx + int 12h ;Speichergroesse abholen + mov cl,6h + shl ax,cl + dec ax + mov dx,ax + mov ax,cs + sub dx,ax ;must be relativ to cs + pop cx + pop ax + ret + +paragraphs: + mov dx,0FFFh + push ax + push cx + int 12h ;Speichergroesse abholen + mov cl,6h + shl ax,cl + dec ax + mov dx,ax + pop cx + pop ax + ret + + +;************************************************************************** +timerint equ 08*4 +timercont equ 018h*4 ;resident basic ist ueberfluessig +timer_init: + mov ax,0 + mov es,ax + mov bx,word ptr es:[timerint+2] + mov word ptr es:[timercont+2],bx + mov bx,word ptr es:[timerint] + mov word ptr es:[timercont],bx + mov word ptr es:[timerint+2],cs + mov word ptr es:[timerint],offset timer_tick + ret +; +timer_tick: + int 18h + push ax + push ds + push cs ;ds := cs + pop ds + sti + call checkkey ;keybord abfragen + if pcd + mov al,50 + else + mov al,55 ;ungefaehr 55 millisekunden + endif + cli + call timerinterrupt + inc tickcount + cmp tickcount,1000/55 ;schon eine sekunde um + jnc sec_tick + pop ds + pop ax + iret +; +;************************************************************************** +;* +;* Die Initialisierung der einzelnen Kanaele kann in der Zelle sec_entry +;* eine Routine eintragen, die im Sekundentack (ungefaehr) aufgerufen +;* werden soll. Diese Routine muss dann die vorher dort eingetragene +;* Routine aufrufen. Ebenfalls kann ein di und si registerinhalt +;* eingetragen werden, der beim aufruf gegeben sein soll. Dann ist dafuer +;* Sorge zu tragen, dass die nachfolgenden Routine den jeweils vorher +;* dort eingetragenen Wert erhaelt. Alle Register ausser di, si und !!ds!! +;* duerfen beliebig zerstoert werden. +;* ds ist immer auf das datensegment (momentan = cs) gesetzt. +sec_tick: + mov tickcount,0 ;wieder vorn anfangen zu zaehlen + push si + push di + push bp + push bx + push cx + push dx + push es + mov di,word ptr sec_di + mov si,word ptr sec_si + jmp word ptr sec_entry +sec_cont: + pop es + pop dx + pop cx + pop bx + pop bp + pop di + pop si + pop ds + pop ax + iret + +sec_entry dw offset sec_cont +sec_di dw 0 ;hier koennen routinen das di und das si +sec_si dw 0 ;ablegen, mit dem sie aufgerufen werden wollen + +tickcount db 0 + +;**************************************************************************** +;* neuen bootvorgang einleiten +reboot: + if hdsystem + mov ax,0401h ;sector verify + mov cx,1 ;spur 0, sector 1 + mov dx,80h ;drive 0, head 0 + int 13h + endif + mov ax,40h + mov ds,ax ;auf datensegment + mov word ptr ds:[0072h],1234h ;reset flag + db 0eah ;jmp 0ffffh:0 + dw 0 + dw 0ffffh + + + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/SHMAIN.ASM b/system/shard-x86-at/7/src/SHMAIN.ASM new file mode 100644 index 0000000..b7b618f --- /dev/null +++ b/system/shard-x86-at/7/src/SHMAIN.ASM @@ -0,0 +1,241 @@ +;**************************************************************************** +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================* +;* * +;* Routinen zur Verteilung der Auftraege auf verschiedene Kanaele * +;* und Kanal 32 * +;* * +;**************************************************************************** + +;****************************************************************************** +; routinen, die das restsystem vom SHard erwartet +;****************************************************************************** +; routinen im restsystem, die SHard benutzen kann +;systemstart = cs:1e10h +;inputinterrupt = cs:1e13h +;timerinterrupt = cs:1e16h +;warte = cs:1e19h +;freieumel0 = cs:1e1ch +;info = cs:1e1fh +; +;****************************************************************************** +;****************************************************************************** +; kanalspezifische funktionen +i_output proc far + push bp + push si + push di + push bx + push dx + push ax + push es + push ds ;bis hierhin nach funktion restaurieren + mov si,ds ;wir brauchen den alten wert von ds in es + mov es,si + mov si,cs ;wir brauchen ds = cs + mov ds,si + push bx ;fuer versorgung der funktion sichern + call select + pop bx + call shard:[si] ;routine anspringen + pop ds ;register wieder herstellen + pop es + pop ax + pop dx + pop bx + pop di + pop si + pop bp + ret +i_output endp + +i_blockin label far + push bp + mov bp,2 ;kennung blockin + jmp short dispatch + +i_blockout label far + push bp + mov bp,3 ;kennung blockout + jmp short dispatch + +i_iocontrol label far + push bp + mov bp,4 ;kennung iocontrol + jmp short dispatch + +control32: ;spezialaufrufe indirekt ueber kanal 32 gekommen + push cs + call i_control32 + ret + +i_control32: + push bp + mov bp,5 ;kennung control32 + jmp short dispatch + +;****************************************************************************** +; dispatch routine um aufrufe auf die kanalspezifischen treiber zu verteilen +; +; in: al = kanal +; bp auf dem stack +; bp = 2 bei blockin +; 3 bei blockout +; 4 bei iocontrol +; 5 bei control ueber kanal 32 +; aufruf mit jmp dispatch +; +; funktion: aufruf der entsprechenden funktion des kanaltreibers mit +; si = devicetypecontrolblock +; di = channelcontrolblock +; auf dem stack: bp, si, di, dx, es, ds, bx, returnadresse +; +; die routinen muessen deshalb keine register sichern. +; soll in ds:bx etwas zurueckgeliefert werden, so ist dies ueber den +; stack zu tun. +; +; out: die gewuenschte funktion wurde ausgefuehrt +; bp, si, di, dx, bx unveraendert, ausnahme: bx in bestimmten faellen wo dies +; ausdruecklich verlangt wird. flags, cx (ggf. bx) wie von der funktion geliefert. +dispatch proc far + push si ;register sichern um sie nach ende der Funktion + push di + push dx ;zu restaurieren + push es + push ds + push bx + mov si,ds ;wir brauchen den alten wert von ds in es + mov es,si + mov si,cs ;wir brauchen ds = cs + mov ds,si + call dispexecute ;fuehre dispatch aus + pop bx ;register wieder herstellen + pop ds + pop es + pop dx + pop di + pop si + pop bp + ret ;fertig, funktion ausgefuehrt +dispatch endp + +dispexecute: + push bx ;sichern, um versorgung der funktion durchfuehren + push dx ;zu koennen + call select ;adressen fuer diesen kanal laden + add bp,si ;adresse fuer offset der funktionstabelle in dtcb ausrechnen + mov bl,shard:[bp] ;offset nach bl + mov bh,0ffh ;maximal 255 byte grosse tabelle +;bx enthaelt jetzt negativen offset + add bx,si ;start der tabelle fuer funktionswerte ausrechnen +; +; als funktionswert wird derzeit nur der bereich von -128 bis +127 akzeptiert. +; -1 dient dabei als tabellenendekennzeichnung und wird fuer alle undefinierten +; funktionswerte aufgerufen +; +; die tabelle besteht aus jeweils einem byte funktionsschluessel +; im bereich -128 - +127 und zwei byte funktionsadresse. + mov dl,cl ;niederwertigen teil nach dl + mov al,ch ;hoeheren bits von cx muessen 0 oder 0ffh sein + or al,al ;ist es 0 + jz dispfunctloop ;ja, ok + inc al ;oder -1 + ifnz ;nein, dann -1 als funktionswert +dispfunctloop: + mov al,shard:[bx] ;aktuellen tabelleneintrag suchen + inc bx ;und auf dazugehoerige adresse + cmp al,dl ;gefunden + jz dispfuncfound ;ja + inc al ;oder -1 + jz dispfuncfound + inc bx ;adresse ueberspringen + inc bx + jmp dispfunctloop +dispfuncfound: + mov bp,bx ;adresse der routine nach bp + pop dx ;dx wieder herstellen + pop bx ;bx wiederherstellen + jmp shard:[bp] ;jmp funktion + +;*************************************************************************** +; select routine, um die tabellen eines bestimmten kanals zu adressieren +; +; in: al = kanalnummer +; +; out: si = dtcb adresse +; di = ccb adresse +; bx, dx zerstoert +select: + push cx + mov dx,offset selectentry ;laenge eines eintrags in selecttabelle + mov bx,offset selecttable + mov cl,shard:[bx] ;anzahl kanaele laden + mov ch,0 + inc bx ;auf eigentliche tabelle +selectloop: + cmp al,shard:[bx] ;kanal gefunden + jz selectfound + add bx,dx ;auf naechsten kanal + loop selectloop +; hier haben wir einen unbekannten kanal +; bx zeigt jetzt auf den 'nilkanal' +selectfound: +; hier wurde der passende kanal gefunden + mov di,shard:[bx]+1 ;adresse channelcontrolblock + mov si,shard:[bx]+3 ;adresse devicetypecontrolblock + pop cx + ret + +;******************************************************************************** +;* definition des typs 'shardkanal' fuer operation ueber kanal 32 + device shardchannel + + dtcbroutines iocontrol + routine 1,devicetype + routine 2,frout_ok + routine 5,nil_size + routine 6,priv_operation + routine 8,priv_operation + routine 9,priv_operation + routine -3,priv_operation + routine -4,priv_operation + routine -5,reboot_request + routine -1,unknowncontrol + dtcbroutines control32 + routine -2,timer_init + routine -1,no_channel_setup + dtcbroutines blockin + routine -4,clockread + dtcbroutines blockout + routine -4,clockwrite + routine -1,no_blockinout + dtcbparams nil_output,0 ;output,no in_out + +priv_operation: + mov al,bl ;kanalnummer nach al + mov bl,0 ;vermerken: privilegiert + jmp control32 + +priv_op_question: + mov al,bl ;kanalnummer nach al + mov bl,1 ;vermerken: abfrage + jmp control32 + +reboot_request: + mov byte ptr reboot_byte,1 + ret + +reboot_byte db 0 + +longmove: + rep movsw + ret + +i_sysend proc far + cmp byte ptr cs:reboot_byte,1 + ifz + mov al,0 + mov cx,-102 + call control32 ;laufwerk parken, wenn implementiert + ret +i_sysend endp + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/STREAM.ASM b/system/shard-x86-at/7/src/STREAM.ASM new file mode 100644 index 0000000..3bc1797 --- /dev/null +++ b/system/shard-x86-at/7/src/STREAM.ASM @@ -0,0 +1,290 @@ +;*************************************************************************** +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge =================* +;* * +;* Pufferverwaltung fuer Stream-I/O-Kanaele * +;* und allgemeine Stream-I/O-Routinen * +;* * +;*************************************************************************** + +;****************************************************************************** +; macro zur definition der fuer 'stream' notwendigen daten im ccb +stream macro bufsiz,bufadr +ccbentry stream_stat +;;definition der bits in stream_stat +outrestart = 1 ;;output war fertig, muss neu gestartet werden +wasxon = 2 ;;es wurde bereits xon empfangen +out_xon_xoff = 4 ;;ausgabeseitig findet xon/xoff handshake statt +in_xon_xoff = 8 ;;eingabeseitig findet xon/xoff handshake statt +sendxon_xoff = 10h ;;xon oder xoff muss gesendet werden +sendxon = 20h ;;xon senden (in verbindung mit sendxon_xoff verwendet) +in_xoff_send = 40h ;;xoff wurde ausgesendet -> nur dann xon senden + db outrestart + wasxon + in_xoff_send +ccbentry buffersize + db bufsiz +ccbentry content + db 0 ;;puffer ist anfangs leer +ccbentry inpointer + db 0 ;;wir fuellen den puffer vom anfang an +ccbentry outpointer + db 0 ;;und leeren ihn auch von da +ccbentry buffer + dw offset bufadr ;;pufferadresse +ccbentry andmask + db 0ffh ;;high bit loeschen +ccbentry xormask + db 0 ;;keine bits kippen +ccbentry errorandmask + db 0ffh ;;high bit loeschen +ccbentry errorxormask + db 0 ;;keine bits kippen +ccbentry outandmask + db 0ffh ;;high bit loeschen +ccbentry outxormask + db 0 ;;keine bits kippen +ccbentry breakchar + db '?' ;;nach ? umsetzen +ccbentry xoffchar + db 'S'-40h ;;ctrl-s ist xoff +ccbentry xonchar + db 'Q'-40h ;;ctrl-q ist xon +ccbentry stream_icount + dw 0 +ccbentry stream_ocount + dw 0 + endm + + +fillbuffer: +; di zeigt auf ccb +; das z-flag ist rueckgesetzt, wenn der output neu gestartet werden muss + or cx,cx ;falls laenge null: alles uebernommen melden + jnz fillit + stc ;'alles uebernommen' setzen + ret ;war null, nichts zu tun +fillit: + push cx ;gewuenschte laenge merken fuer rueckmeldung +fillagain: + mov al,shard:(di+buffersize) ;puffergroesse holen + sub al,shard:(di+content) ;belegte abziehen + jz bufferfull ;nichts mehr frei + push cx ;noch zu uebernehmende merken + or ch,ch ;nachsehen, ob laenge > 255 + ifnz ;nein, dann bis zu 255 byte uebernehmen + cmp al,cl ;kleinere von freien und gewuenschten nehmen + ifc ;anzahl freie ist kleiner + mov al,shard:(di+buffersize) ;groesse holen + sub al,shard:(di+inpointer) ;zeiger abziehen -> abstand vom pufferende + jnz takeminimum + mov byte ptr shard:(di+inpointer),0 ;ist am ende, vorne anfangen + mov al,cl ;von daher volle groesse +takeminimum: ;minimum (abstand vom ende, max moegliche) -> c + cmp al,cl ;welches ist groesser + ifc ;a ist kleiner, nehmen wir das + mov ch,0 ;laenge fuer movsb + push cx ;merken + mov dx,shard:(di+buffer) + add dl,shard:(di+inpointer) + ifc ;zielstartadresse nach dx +;es:bx enthaelt quellenstart +;ds:dx enthaelt zieladresse + push es + push ds + pop es ;es / ds vertauschen + pop ds + xchg bx,si ;bx als source + xchg dx,di ;dx als destination + cld + rep movsb ;uebertragen + xchg bx,si ;register zuruecktauschen + xchg dx,di + push es + push ds + pop es + pop ds + pop cx ;uebernommene laenge nach cx + add shard:(di+inpointer),cl ;neuen inpointer errechnen + add shard:(di+content),cl ;neuen inhalt + pop bp ;gewuenschte laenge nach bp + sub bp,cx ;restlaenge ausrechnen + mov cx,bp ;restlaenge nach cx + jnz fillagain ;ok, fertig + pop cx ;alles uebernommen + test byte ptr shard:(di+stream_stat),outrestart ;output neu starten? + stc ;carry setzen + ret + +bufferfull: ;nicht alles uebernommen + pop bx ;gewuenschte laenge vom stack holen + sub bx,cx ;uebernommene laenge errechnen + mov cx,bx ;uebernommene nach bc + test byte ptr shard:(di+stream_stat),outrestart ;output neu starten? + ret ;carry ist geloescht + +frout: +;* meldet anzahl freie im puffer und carry, wenn puffer leer + mov al,shard:(di+buffersize) ;groesse + mov ch,al ;merken + sub al,shard:(di+content) ;minus inhalt gibt freie + cmp al,ch ;volle puffergroesse? + cmc ;carry ist genau dann gesetzt, wenn bl>al + mov ch,0 + mov cl,al ;laenge melden + ret + +getnextchar: +;* diese routine muss im disable interrupt aufgerufen werden und wird so verlassen +;* z-flag -> kein zeichen mehr gefunden +;* dx,ax,f werden zerstoert + test byte ptr (di+stream_stat),sendxon_xoff ;muessen wir xon/xoff senden + jnz getxon_xoff + test byte ptr shard:(di+stream_stat),wasxon ;war schon xon + jz getret ;nein, z sagt: kein zeichen mehr da + or byte ptr shard:(di+stream_stat),outrestart ;puffer leer, neustart erforderlich + cmp byte ptr shard:(di+content),0 ;noch was im puffer + jz getret ;ja + and byte ptr shard:(di+stream_stat),not outrestart ;kein neustart erforderlich + dec byte ptr shard:(di+content) ;einen vom inhalt abziehen + mov dx,shard:(di+buffer) ;buffer adresse + outpointer nach cx + mov al,shard:(di+outpointer) + cmp al,shard:(di+buffersize) ;sind wir am ende angelangt + ifz ;ja, dann auf den anfang setzen + inc al ;auf naechstes zeigen + mov shard:(di+outpointer),al ;neuen outpointer setzen + dec al ;alten outpointer wiederherstellen + xor ah,ah ;ah loeschen + add dx,ax ;byte im puffer errechnen + xchg bx,dx + mov al,shard:[bx] ;zeichen holen + xchg bx,dx + and al,(di+outandmask) ;unerwuenschte bits blenden + xor al,(di+outxormask) ;andere evtl. kippen + inc word ptr (di+stream_ocount) ;zeichen zaehlen + inc dx ;puffer steht nie auf 0 + ;nz => zeigt an, dass zeichen da +getret: + ret + +getxon_xoff: + and byte ptr (di+stream_stat),not sendxon_xoff ;jetzt senden wirs + test byte ptr (di+stream_stat),sendxon ;sollen wir xon senden + jz getxoff ;nein, dann wars xoff + and byte ptr (di+stream_stat),not sendxon ;muss jetzt auch weg + or al,1 ;nz => zeichen da + mov al,(di+xonchar) ;xon holen + ret + +getxoff: + or al,1 ;nz => zeichen + mov al,(di+xoffchar) ;xoff holen + ret + +xonfound: + test byte ptr shard:(di+stream_stat),wasxon ;warten wir auf xon + lahf + or byte ptr shard:(di+stream_stat),wasxon ;jetzt war auf jeden fall eins da + sahf + ret ;z => output wieder starten + +xofffound: + and byte ptr shard:(di+stream_stat),not wasxon ;ab sofort auf xon warten + ret ;nz => output nicht wieder starten + +input: + and al,shard:(di+andmask) ;evtl. bits ausblenden + xor al,shard:(di+xormask) ;oder kippen +allinput: + test byte ptr shard:(di+stream_stat),out_xon_xoff + jz directinput + cmp al,shard:(di+xonchar) + jz xonfound + cmp al,shard:(di+xoffchar) + jz xofffound +directinput: ;input ohne xon/xoff + mov ch,al ;zeichen nach ch + mov al,shard:(di+channel_no) ;kanal nach al + inc word ptr shard:(di+stream_icount) ;zeichen zaehlen + call inputinterrupt + or al,1 ;nz => kein output restart + ret + +errorinput: + and al,shard:(di+errorandmask) ;evtl. bits ausblenden + xor al,shard:(di+errorxormask) ;oder kippen + jmp allinput + +breakinput: + mov al,shard:(di+breakchar) + jmp allinput + +stream_weiter: + cli + mov al,(di+stream_stat) ;aktuellen status holen + test al,in_xon_xoff ;ueberhaupt xon_xoff handshake + jz stream_weiter_end ;nein, ei und zurueck + test al,in_xoff_send ;habe ich ein xoff gesendet + jz stream_weiter_end ;nichts liefern + or al,sendxon+sendxon_xoff ;bitte schick ein xon + and al,0ffh-in_xoff_send ;das xoff ist erledigt + mov (di+stream_stat),al ;neuen status setzen + test byte ptr (di+stream_stat),outrestart ;nz => output neu starten +stream_weiter_end: + sti + ret + +stream_stop: + cli + mov al,(di+stream_stat) ;aktuellen status holen + test al,in_xon_xoff ;ueberhaupt xon_xoff handshake + jz stream_stop_end ;nein, ei und zurueck + or al,in_xoff_send+sendxon_xoff ;bitte schick ein xoff und merk dirs + and al,0ffh-sendxon ;auf keinen fall mehr xon schicken + mov (di+stream_stat),al ;neuen status setzen + test byte ptr (di+stream_stat),outrestart ;nz => output neu starten +stream_stop_end: + sti + ret + +enablexon: + or byte ptr shard:(di+stream_stat),in_xon_xoff ;ab sofort xon/xoff handshake +enableoutxon: + or byte ptr (di+stream_stat),out_xon_xoff ;auch ausgabe seitig + ret + + +disablexon: + and byte ptr (di+stream_stat),not in_xon_xoff ;ab sofort eingabe und +disablexoff: + and byte ptr (di+stream_stat),not out_xon_xoff ;ausgabe wieder ohne xon/xoff + test byte ptr shard:(di+stream_stat),wasxon ;warten wir noch auf xon + lahf + or byte ptr shard:(di+stream_stat),wasxon ;dann haben wir jetzt eins + sahf + ret ;z => outputrestart + +set_out_mask: + mov (di+outandmask),dx + ret + +set_inp_mask: + mov (di+andmask),dx + ret + +set_inp_errmask: + mov (di+errorandmask),dx + ret + +stream_in_count: + cli + mov cx,(di+stream_icount) + mov word ptr (di+stream_icount),0 + sti + ret + +stream_out_count: + cli + mov cx,(di+stream_ocount) + mov word ptr (di+stream_ocount),0 + sti + ret + + \ No newline at end of file diff --git a/system/shard-x86-at/7/src/WAIT.ASM b/system/shard-x86-at/7/src/WAIT.ASM new file mode 100644 index 0000000..28153aa --- /dev/null +++ b/system/shard-x86-at/7/src/WAIT.ASM @@ -0,0 +1,176 @@ +;**************************************************************************** +;*======= Copyright (C) 1985,86 Martin Schoenbeck, Spenge ==================* +;* * +;* Support fuer die Wartelogik des IBM PC-AT ueber int 15h * +;* * +;* * +;**************************************************************************** + +int15 proc far + sti + push ax + cmp ah,90h ;hat ein treiber nichts zu tun + jz device_is_busy + cmp ah,91h ;oder ist er gerade fertig + jz device_ready +not_for_me: ;hab ich nichts mit am hut + pop ax + jmp dword ptr cs:[int15_cont] + +device_ready: + cmp al,2 ;0 (platte) oder 1 (floppy) + jnc not_for_me + mov ah,0 + push bx + mov bx,ax + mov byte ptr cs:device_busy[bx],2 ;device ist fertig geworden + pop bx + pop ax + iret + +device_is_busy: + mov ah,8 ;annahme: 6 sekunden fuer platte + cmp al,0 ;ist es platte + jz device_wait ;ja + mov ah,3 ;annahme: 2 sekunden fuer floppy + cmp al,1 + jz device_wait ;ist floppy + cmp al,0fdh ;warten auf floppy_motor + jnz not_for_me ;mit allem anderen haben wir nichts am hut + mov ax,0301h ;zwei sekunden warten; device floppy +device_wait: + push bx ;den ganzen ramsch sichern + push cx + push dx + push bp + push di + push si + push es + push ds + mov bl,al + mov bh,0 + cli + mov byte ptr cs:device_table[bx],1 ;device busy setzen + mov byte ptr cs:device_timeout_table[bx],ah ;anzahl sekunden eintragen + sti +device_wait_loop: + cmp byte ptr cs:device_busy[bx],0 ;noch kein interrupt gekommen + jnz device_wait_end + push bx + call cs:warte + pop bx + jmp device_wait_loop +device_wait_end: + cmp byte ptr cs:device_busy[bx],2 ;normales ende + ifnz ;nicht normal, war timeout + mov byte ptr cs:device_table[bx],0 ;device ist wieder frei + mov byte ptr cs:device_busy[bx],0 ;device kann wieder auf int warten +; jnc devcont +; call cs:info +; jmp short devcont +; db ' timeout' +devcont: + pop ds + pop es + pop si + pop di + pop bp + pop dx + pop cx + pop bx + pop ax + ret 2 ;kill flags on stack + +int15 endp + +device_timing: + mov bx,-1 ;mit 0 fangen wir an + mov cx,2 ;zwei durchlaeufe +device_timing_loop: + inc bx + mov al,byte ptr device_timeout_table[bx] ;timeout zaehler holen + cmp al,0ffh ;schon fertig mit zaehlen + jz device_timing_end + dec al + mov byte ptr device_timeout_table[bx],al ;timeout zaehler neu setzen + jns device_timing_end + cmp byte ptr device_table[bx],1 ;noch aktiv? + ifz ;und noch kein endeinterrupt + ifz ;timeout aufgetreten +device_timing_end: + loop device_timing_loop + jmp word ptr device_cont + +;*********************************************************************** +;* warten, bis das in bx uebergebene device frei ist +;* ds = cs ist bedingung, alle register (ausser flags) bleiben erhalten + db 'device free' +device_free: + cmp byte ptr device_table[bx],0 ;ist das device frei + jnz device_not_free + mov byte ptr device_busy[bx],0 ;evtl. nachgeklapperte ints loeschen + ret ;device kann benutzt werden +device_not_free: + push ax + push bx + push cx + push dx + push si + push di + push bp + push ds + push es + call warte + pop es + pop ds + pop bp + pop di + pop si + pop dx + pop cx + pop bx + pop ax + jmp device_free + +device_lock: + mov byte ptr device_table[bx],1 ;device sperren + ret + +device_unlock: + mov byte ptr device_table[bx],0 ;device freigeben + ret + +device_init: + mov ax,0 + mov es,ax + mov bx,word ptr es:[15h*4] ;int routine holen + mov cx,word ptr es:[15h*4+2] ;int segment holen + mov word ptr es:[15h*4],offset int15 + mov word ptr es:[15h*4+2],cs + mov word ptr [int15_cont],bx + mov word ptr [int15_cont+2],cx + mov ax,word ptr [sec_entry] ;alte adresse fuer sec_tick holen + mov word ptr [device_cont],ax ;eintragen fuer weitergabe + mov word ptr [sec_entry],offset device_timing ;unseren aufruf eintragen + ret + +int15_cont: + dw 0 + dw 0 + +device_cont: + dw 0 + +device_table: + db 0 + db 0 + +device_busy: + db 0 + db 0 + +device_timeout_table: + db 0 + db 0 + + \ No newline at end of file diff --git a/system/shard-z80-altos/6/src/ALTOSSHD.ASM b/system/shard-z80-altos/6/src/ALTOSSHD.ASM new file mode 100644 index 0000000..5df69fb --- /dev/null +++ b/system/shard-z80-altos/6/src/ALTOSSHD.ASM @@ -0,0 +1,1786 @@ +ADDR B1 B2 B3 B4 ASCII INSTR PARAMETER COMMENT +0100 C3 F9 01 ... JP 01F9 ; Init Shard + Start EUMEL0 +0103 C3 8C 0B ... JP 0B8C ; LIMIT +0106 C3 2A 01 .*. JP 012A ; OUTPUT +0109 C3 4B 01 .K. JP 014B ; BLOCKIN +010C C3 53 01 .S. JP 0153 ; BLOCKOUT +010F C3 5B 01 .[. JP 015B ; IOCONTROL +0112 C3 AC 0B ... JP 0BAC ; SYSEND +0115 C3 90 0B ... JP 0B90 ; SCHINF +0118 C3 94 0B ... JP 0B94 ; SCHACC +011B C3 89 0B ... JP 0B89 ; LONGMOVE +011E 06 ; SHDVER = 6 +011F 00 00 ; ID 4 +0121 00 00 ; ID 5 +0123 00 00 ; ID 6 +0125 00 00 ; ID 7 +0127 C3 63 01 .c. JP 0163 ; I/O-Setzen fuer 'putboot' +012A DD E5 .. PUSH IX ; OUTPUT (Kanal A, Length BC, +012C FD E5 .. PUSH IY ; Addr HL, Ausgegeben BC, +012E E5 . PUSH HL ; Carry SET : Alles raus) +012F D5 . PUSH DE +0130 F5 . PUSH AF +0131 E5 . PUSH HL +0132 CD A6 01 ... CALL 01A6 ; Zugriff auf Kanaltabelle --> IY/DE +0135 D5 . PUSH DE ; DE --> IX (Addr. von Startaddr.) +0136 DD E1 .. POP IX +0138 EB . EX DE,HL +0139 5E ^ LD E,(HL) ; (Startaddresse) --> DE +013A 23 # INC HL +013B 56 V LD D,(HL) +013C E1 . POP HL ; Textstartaddresse +013D CD 49 01 .I. CALL 0149 ; = JP (DE) Routine starten +0140 D1 . POP DE ; ehem. Returnaddresse loeschen +0141 7A z LD A,D +0142 D1 . POP DE +0143 E1 . POP HL +0144 FD E1 .. POP IY +0146 DD E1 .. POP IX +0148 C9 . RET +0149 D5 . PUSH DE +014A C9 . RET ;----------------------------------- +014B DD E5 .. PUSH IX ; BLOCKIN +014D DD 21 02 00 .!.. LD IX,0002 ; Aufgabe 2 +0151 18 18 .. JR 016B ;---------------------------------- +0153 DD E5 .. PUSH IX ; BLOCKOUT +0155 DD 21 03 00 .!.. LD IX,0003 ; Aufgabe 3 +0159 18 10 .. JR 016B ;---------------------------------- +015B DD E5 .. PUSH IX ; IOCONTROL +015D DD 21 04 00 .!.. LD IX,0004 ; Aufgabe 4 +0161 18 08 .. JR 016B ;---------putboot Aufg. 5---------- +0163 DD E5 .. PUSH IX ; +0165 DD 21 05 00 .!.. LD IX,0005 ; Aufgabe 5 +0169 18 00 .. JR 016B ;--------------------------------- +016B FD E5 .. PUSH IY ; Je nach IX Kanal-Aufgabe (I/O) +016D D5 . PUSH DE +016E E5 . PUSH HL +016F CD 79 01 .y. CALL 0179 ; Register wurden gerettet +0172 E1 . POP HL +0173 D1 . POP DE +0174 FD E1 .. POP IY +0176 DD E1 .. POP IX +0178 C9 . RET ;----------------------------------- +0179 E5 . PUSH HL +017A D5 . PUSH DE +017B CD A6 01 ... CALL 01A6 ; Kanaladdr --> DE, IY +017E DD 19 .. ADD IX,DE ; DE = 4. + 5. Byte + Aufgabennummer +0180 DD 6E 00 .n. LD L,(IX+00) ; Byte zur Aufgabe +0183 26 FF &. LD H,FF +0185 D5 . PUSH DE +0186 DD E1 .. POP IX ; IX = Addresse des tabellenentries +0188 19 . ADD HL,DE ; +0189 59 Y LD E,C ; BC = code1 +018A 78 x LD A,B +018B B7 . OR A +018C 28 05 (. JR Z,0193 ; EUMEL-Funktion 0<=code1<256 +018E 3C < INC A +018F 28 02 (. JR Z,0193 ; Shard-Funktion -256<=code1<0 +0191 1E FF .. LD E,FF ; -1 = Illegale Funktion +0193 7E ~ LD A,(HL) +0194 23 # INC HL +0195 BB . CP E ; Addresse mit der Funktionsnummer +0196 28 07 (. JR Z,019F ; suchen +0198 3C < INC A ; FF=Tabellenende +0199 28 04 (. JR Z,019F +019B 23 # INC HL +019C 23 # INC HL +019D 18 F4 .. JR 0193 ; naechste Funktionsnummer +019F 5E ^ LD E,(HL) +01A0 23 # INC HL +01A1 56 V LD D,(HL) ; Sprung zur Addresse, die in der +01A2 EB . EX DE,HL ; Tabelle steht +01A3 D1 . POP DE ; DE= code2 (Eingang HL) +01A4 E3 . EX (SP),HL +01A5 C9 . RET ; --------------------------------- +01A6 C5 . PUSH BC ; Kanalinfos aus Tabelle --> IY/DE +01A7 11 05 00 ... LD DE,0005 ; Entrylaenge in der Tabelle +01AA 21 12 02 !.. LD HL,0212 ; Tabellenanfang (Kanaele) +01AD 46 F LD B,(HL) ; Erstes Byte ist Tabellenlaenge +01AE 23 # INC HL +01AF BE . CP (HL) ; Erstes Entrybyte ist Kanalnummer +01B0 28 03 (. JR Z,01B5 ; Bis Kanal gefunden +01B2 19 . ADD HL,DE +01B3 10 FA .. DJNZ 01AF +01B5 23 # INC HL ; 2. u. 3. Byte --> DE +01B6 5E ^ LD E,(HL) +01B7 23 # INC HL +01B8 56 V LD D,(HL) +01B9 D5 . PUSH DE ; 2. u. 3. Byte --> IY +01BA FD E1 .. POP IY +01BC 23 # INC HL ; 4. u. 5. Byte --> DE +01BD 5E ^ LD E,(HL) +01BE 23 # INC HL +01BF 56 V LD D,(HL) +01C0 C1 . POP BC ; gerettetes BC zurueck +01C1 C9 . RET ;---------------------------------- +;============================= Parameterkanal ============================== +01C2 01 5F 06 ; 1, IOCONTROL "typ" +01C5 02 50 06 ; 2, IOCONTROL "frout" +01C8 05 46 06 ; 5, IOCONTROL "size" +01CB 06 ED 01 ; 6, IOCONTROL "flow" +01CE 08 ED 01 ; 8, IOCONTROL "baud" +01D1 09 ED 01 ; 9, IOCONTROL "bits" +01D4 E2 ED 01 ; -30, IOCONTROL maske f. busystatus +01D7 E1 ED 01 ; -31, IOCONTROL maske f. strobe setz. +01DA FF 4C 06 ; -1, IOCONTROL ill. +01DD FE 86 0B ; -2, Aufg. 5 : kanal init +01E0 FF 55 06 ; -1, Aufg. 5 : BC = 1 +01E3 FF 4C 06 ; BLOCKIO ill. +01E6 59 ; Parameterkanal : OUTPUT: 0659 ill. +01E7 06 ; +01E8 FD ; BLOCKIN : 01E3 +01E9 FD ; BLOCKOUT : 01E3 +01EA DC ; IOCONTROL : 01C2 +01EB F7 ; Aufg. 5 : 01DD +01EC 00 ; Keine I/O moeglich + ; ----- set "flow","bits","baud" --- +01ED 7D } LD A,L ; Kanal = addressierter kanal +01EE 2E 00 .. LD L,00 ; 0 = Parameter setzen (code2) +01F0 C3 63 01 .c. JP 0163 ; Aufgabe 5, L = 0 +01F3 7D } LD A,L ; kanal = addressierter Kanal +01F4 2E 01 .. LD L,01 ; 1 = Parameter lesen (code2) +01F6 C3 63 01 .c. JP 0163 ; Aufgabe 5, L = 1 +01F9 F3 . DI ;---------- Init Shard ------------- +01FA 3E 00 >. LD A,00 ; Page 0 = Interruptvektoren +01FC ED 47 .G LD I,A +01FE 31 00 B0 1.. LD SP,B000 +0201 3E 21 >! LD A,21 ; Kanal 0..32 +0203 01 FE FF ... LD BC,FFFE ; Funktion -2 = Kanalinit +0206 3D = DEC A +0207 F5 . PUSH AF +0208 CD 63 01 .c. CALL 0163 ; Kanaele initialisieren (IRQ's) +020B F1 . POP AF +020C B7 . OR A +020D 20 F4 . JR NZ,0203 +020F C3 10 1E ... JP 1E10 ; Systemstart EUMEL0 bzw. 'putboot' + ----------------------------------- Entry : Kanal, Puffer, ROUTINETBL +0212 0C ; Tabelle mit 12 Kanaelen +0213 20 00 00 E6 01 ; Parameterkanal, Kein Puffer +0218 00 64 0C 0C 07 ; Hintergrund +021D 01 CD 0C 7B 02 ; Kanal 1 .. 6 = seriell +0222 02 5B 0D 7B 02 ; +0227 03 E9 0D 7B 02 +022C 04 77 0E 7B 02 +0231 05 05 0F 7B 02 +0236 06 93 0F 7B 02 +023B 07 BD 0F EA 0A ; printer +0240 08 C3 0F EA 0A ; parallel 1 +0245 09 C9 0F EA 0A ; parallel 2 +024A 1F CF 0F 7D 06 ; floppy +024F FF 00 00 3F 06 ; illegal Kanal +;======================== Serielle Kanaele ================================= +0254 01 5F 06 ; 1, IOCONTROL "typ" +0257 02 36 05 ; 2, IOCONTROL "frout" +025A 05 46 06 ; 5, IOCONTROL "size" +025D 06 F3 01 ; 6, IOCONTROL "flow" +0260 08 F3 01 ; 8, IOCONTROL "baud" +0263 09 F3 01 ; 9, IOCONTROL "bits" +0266 FD D6 02 ; -3, IOCONTROL "portinfo" +0269 FF 4C 06 ; -1 ill. +026C 06 2A 03 ; 6, Aufg .5 : "flow" setzen/info +026F 08 F2 02 ; 8, Aufg. 5 : "baud" setzen/info +0272 09 AA 03 ; 9, Aufg. 5 : "bits" setzen/info +0275 FE A2 02 ; -2, Aufg. 5 : Kanal init +0278 FF 4C 06 ; BLOCKIN/BLOCKOUT ill. +027B 31 ; Seriell : 0431 = OUTPUT +027C 04 +027D FD ; BLOCKIN : 0278 +027E FD ; BLOCKOUT : 0278 +027F D9 ; IOCONTROL : 0251 +0280 F1 ; Aufg. 5 : 026C +0281 03 ; Typ : Stream I/O + ; Baudratetabelle : 1. Byte: Bit 7+6 = Vorteiler (Register4) + ; Bit 4 = DIV 256, DIV 16,Bit 5 : Mode (CTC) + ; 2. Byte: CTC-Zeitkonstante +0282 40 9C ; 50 Baud +0284 40 68 ; 75 Baud +0286 40 47 ; 110 baud +0288 E0 E8 ; 134.5 Baud +028A E0 D0 ; 150 Baud +028C A0 D0 ; 300 Baud +028E 60 D0 ; 600 Baud +0290 60 68 ; 1200 baud +0292 60 45 ; 1800 Baud +0294 60 34 ; 2400 Baud +0296 60 23 ; 3600 Baud +0298 60 1A ; 4800 Baud +029A 60 11 ; 7200 Baud +029C 60 0D ; 9600 Baud +029E 60 07 ; 19200 Baud +02A0 60 03 ; 38400 Baud +02A2 FD 4E 1A .N. LD C,(IY+1A) ;------------- "kanal init" -------- +02A5 06 0D .. LD B,0D ; Commandport in (IY+1A) +02A7 21 C9 02 !.. LD HL,02C9 ; 13 Bytes ausgeben +02AA ED B3 .. OTIR ; An den Commandport schicken +02AC FD 5E 1D .^. LD E,(IY+1D) ; Interruptvektor des Kanals +02AF ED 57 .W LD A,I ; Vektortabellenaddresse High +02B1 57 W LD D,A +02B2 ED 59 .Y OUT (C),E ; Interruptvektor fuer Kanal +02B4 0E 1E .. LD C,1E ; Serviceroutine am Pufferende +02B6 06 00 .. LD B,00 ; (IY+1E) +02B8 FD E5 .. PUSH IY +02BA E1 . POP HL +02BB 09 . ADD HL,BC +02BC 06 04 .. LD B,04 ; 4 Interrupt (Vector+Status) +02BE EB . EX DE,HL ; DE= Serviceroutinenaddresse +02BF 73 s LD (HL),E ; HL = Interruptvektoraddresse +02C0 23 # INC HL ; Serviceroutine eintragen +02C1 72 r LD (HL),D +02C2 23 # INC HL ; Fuer alle 4 Interrupts einen +02C3 13 . INC DE ; Interrupthandler +02C4 13 . INC DE +02C5 13 . INC DE +02C6 10 F7 .. DJNZ 02BF +02C8 C9 . RET ;-------- Inittabelle Serielle ----- +02C9 14 44 ; reset ext status IRQs, Clock x16, 1 Stopbit,noparity +02CB 03 61 ; Rx 7 Bits, Autoenables (CTS), Receiver enable +02CD 05 EA ; Tx 8 Bits, DTR = 1, RTS = 1, Transmitter enable +02CF 11 1F ; kein WAIT/RDY, Vektor incl. Status, alle IRQs an +02D1 03 C1 ; Rx 8 Bits, Keine Autoenables, Receiver enable +02D3 11 1F ; s.o. +02D5 02 ; Interruptvektor folgt als naechstes Byte +02D6 FD 4E 1A .N. LD C,(IY+1A) ;------"IOCONTROL portinfo -3"------ +02D9 06 01 .. LD B,01 ; ^ Status/Commandport +02DB 3E 30 >0 LD A,30 +02DD F3 . DI +02DE ED 41 .A OUT (C),B ; Read-Register 1 waehlen +02E0 ED 40 .@ IN B,(C) ; Einlesen +02E2 ED 79 .y OUT (C),A ; Error Reset = 30H +02E4 ED 78 .x IN A,(C) ; Statusregister (0) lesen +02E6 FB . EI +02E7 E6 AC .. AND AC ; DCD,CTS,... durchlassen +02E9 4F O LD C,A ; Lowbyte = Read-Register 1 Bits +02EA 78 x LD A,B ; Highbyte = Read-Register 0 Bits +02EB E6 70 .p AND 70 ; Nur Error-Bits durchlassen +02ED DD B6 15 ... OR (IX+15) ; Schon vorhandene Fehler dazu +02F0 47 G LD B,A +02F1 C9 . RET ;----------- "baud" -------------- +02F2 01 01 00 ... LD BC,0001 ; Rueckmeldung "nicht moeglich" +02F5 CB 7C .| BIT 7,H ; Keine Shard-spezifischen Baudrates +02F7 C0 . RET NZ +02F8 7C | LD A,H ; Schluessel --> A +02F9 B7 . OR A +02FA C8 . RET Z ; 0 ist ungueltiger Schluessel +02FB FD CB 11 4E ...N BIT 1,(IY+11) ; Baudrateeinstellung moeglich ? +02FF C8 . RET Z ; nein +0300 0E 00 .. LD C,00 ; Rueckmeldung "ok" +0302 CB 45 .E BIT 0,L ; 0 = Lesen, 1 = parameter setzen +0304 C0 . RET NZ ; Nur Information, dann fertig +0305 11 80 02 ... LD DE,0280 ; Tabelle der Baudrates/Timeconsts +0308 6C l LD L,H +0309 CB 25 .% SLA L +030B 26 00 &. LD H,00 ; Schluessel * 2 + Tabellenanfang +030D 19 . ADD HL,DE +030E 7E ~ LD A,(HL) ; Timeconst +030F E6 C0 .. AND C0 ; Taktvorteiler (1,16,32,64) waehlen +0311 4F O LD C,A ; fuer SIO/DART-Register 4 +0312 3E 3F >? LD A,3F ; Nur Clock-Bits (6,7) veraendern +0314 CD 1E 04 ... CALL 041E ; Clock x1, x16 +0317 7E ~ LD A,(HL) ; +0318 E6 30 .0 AND 30 ; CTC Vorteiler (DIV16,DIV256) +031A 07 . RLCA +031B F6 05 .. OR 05 ; Modus = Timer, Kein IRQ, Timeconst +031D FD 4E 1C .N. LD C,(IY+1C) ; CTC-Port fuer Baudrategenerator +0320 ED 79 .y OUT (C),A ; An CTC ausgeben +0322 23 # INC HL +0323 7E ~ LD A,(HL) ; Timeconst fuer CTC +0324 ED 79 .y OUT (C),A +0326 01 00 00 ... LD BC,0000 ; "ok" +0329 C9 . RET ;-------------- "flow" ------------- +032A CB 7C .| BIT 7,H ; Keine Shard-spezifischen "flow"s +032C C2 55 06 .U. JP NZ,0655 ; BC = 1 liefern +032F CB 45 .E BIT 0,L ; NZ, wenn nur Information +0331 C2 5B 06 .[. JP NZ,065B ; "alles moeglich" melden +0334 CD 07 06 ... CALL 0607 ; Flowmodebits loeschen +0337 F3 . DI +0338 FD CB 11 86 .... RES 0,(IY+11) ; Kein RTS/CTS +033C FD CB 17 AE .... RES 5,(IY+17) ; Autoenables (CTS) loeschen +0340 FD 36 12 04 .6.. LD (IY+12),04 ; AND-maske Statusport Tx-Full +0344 FD 36 13 04 .6.. LD (IY+13),04 ; XOR-maske Statusport Tx-Full +0348 25 % DEC H ; H=0, oder H>1 +0349 20 03 . JR NZ,034E +034B CD FE 05 ... CALL 05FE ; H=1 : XON/XOFF setzen +034E 25 % DEC H +034F 20 14 . JR NZ,0365 ; H=0 : keine Flusskontrolle +0351 FD CB 11 C6 .... SET 0,(IY+11) ; H=2 : RTS/CTS +0355 FD CB 17 EE .... SET 5,(IY+17) ; Autoenables (CTS) moeglich +0359 FD 36 12 2C .6., LD (IY+12),2C ; TxDfull, CTS on, DCD on +035D FD 36 13 2C .6., LD (IY+13),2C ; Alle obigen Bits invertieren +0361 FD 36 14 82 .6.. LD (IY+14),82 ; ? +0365 FD 7E 17 .~. LD A,(IY+17) ; Writeregister 3 +0368 06 03 .. LD B,03 ; Register 3 +036A FD 4E 1A .N. LD C,(IY+1A) ; Commanndport +036D ED 41 .A OUT (C),B ; Neuen Autoenableswert ausgeben +036F ED 79 .y OUT (C),A +0371 FB . EI +0372 CD 3C 04 .<. CALL 043C ; ggf. XON/XOFF je nach Status ausg. +0375 01 00 00 ... LD BC,0000 ; "ok" +0378 C9 . RET ;----- RTS/DTR o.XON/XOFF set/reset +0379 CD E9 05 ... CALL 05E9 ; testet BIT 0 (IY0+0) +037C C4 3C 04 .<. CALL NZ,043C ; ggf XON/XOFF ausgeben +037F FD CB 11 46 ...F BIT 0,(IY+11) ; NZ, wenn RTS/CTS eingestellt +0383 C8 . RET Z +0384 F3 . DI ; RTS/CTS ist eingestellt +0385 FD 7E 14 .~. LD A,(IY+14) ; Bits, die bei RTS/CTS veraendert +0388 4F O LD C,A ; werden: RTS/DTR +0389 FD B6 19 ... OR (IY+19) ; Register 5 Wert +038C A9 . XOR C ; RTS/DTR ggf loeschen +038D FD 77 19 .w. LD (IY+19),A ; Wieder zurueckschreiben +0390 FD 4E 1A .N. LD C,(IY+1A) ; Commandport +0393 06 05 .. LD B,05 ; Register 5 beschreiben +0395 ED 41 .A OUT (C),B +0397 ED 79 .y OUT (C),A ; Neuen Wert laden +0399 FB . EI +039A C9 . RET ;----------------------------------- +039B CD D6 05 ... CALL 05D6 ; Wenn XON/XOFF, +039E C4 3C 04 .<. CALL NZ,043C ; XON oder XOFF ausgeben +03A1 F3 . DI +03A2 FD 7E 14 .~. LD A,(IY+14) ; RTS/DTR ggf. setzen +03A5 FD B6 19 ... OR (IY+19) ; weiter wie oben +03A8 18 E3 .. JR 038D ;------------ "bits" -------------- +03AA CB 7C .| BIT 7,H ; Keine Shard-Spezifischen "bits" +03AC C2 55 06 .U. JP NZ,0655 +03AF CB 45 .E BIT 0,L ; Info: "alles moeglich" melden +03B1 C2 5B 06 .[. JP NZ,065B +03B4 7C | LD A,H ; H = stop * 32 + par * 8 + (bit-1) +03B5 C6 20 . ADD A,20 ; Stopbits + 1 : 1..3, parity +03B7 1F . RRA ; Bit 0,1 = parity +03B8 1F . RRA ; Bit 2,3 = stopbits +03B9 1F . RRA +03BA E6 0F .. AND 0F ; restregister ausblenden +03BC CB 4F .O BIT 1,A ; +03BE 28 02 (. JR Z,03C2 ; Wenn gerader Parity: +03C0 CB C7 .. SET 0,A ; Parity enablen +03C2 4F O LD C,A ; C enthaelt OR-Wert fuer Register 4 +03C3 3E F0 >. LD A,F0 ; Nur Stopbits und Parity veraendern +03C5 CD 1E 04 ... CALL 041E ; SIO-Register 4 veraendern +03C8 7C | LD A,H ; Datenbits ausblenden +03C9 E6 07 .. AND 07 +03CB 47 G LD B,A ; + 1 = Anzahl Datenbits +03CC 04 . INC B +03CD 3E 00 >. LD A,00 +03CF 16 F8 .. LD D,F8 ; 11111000 +03D1 37 7 SCF ; Maskenbits "AND" fuer ungueltige +03D2 17 . RLA ; Datenbits links reinrotieren +03D3 CB 22 ." SLA D ; Bei weniger als 5 Bits zusaetzl. 1 +03D5 10 FA .. DJNZ 03D1 +03D7 5F _ LD E,A +03D8 CD 18 06 ... CALL 0618 ; Datenbitsmasken setzen +03DB 16 00 .. LD D,00 ; Keine Bits invertieren +03DD CD 1F 06 ... CALL 061F ; Datenbitmasken setzen AND/XOR +03E0 CD 26 06 .&. CALL 0626 +03E3 06 00 .. LD B,00 +03E5 CB 54 .T BIT 2,H +03E7 28 0C (. JR Z,03F5 ; 1,2,3,4,5 datenbits : 00 +03E9 CB 44 .D BIT 0,H ; 6 datenbits : 80H +03EB 28 02 (. JR Z,03EF ; 7 datenbits : 40H +03ED CB F8 .. SET 7,B ; 8 datenbits : C0H +03EF CB 4C .L BIT 1,H +03F1 28 02 (. JR Z,03F5 +03F3 CB F0 .. SET 6,B +03F5 FD 7E 17 .~. LD A,(IY+17) ; Register 3 Wert +03F8 E6 3F .? AND 3F ; Bits, die nicht veraendert werden +03FA B0 . OR B +03FB FD 77 17 .w. LD (IY+17),A ; Register 3 Wert setzen +03FE 16 03 .. LD D,03 +0400 FD 4E 1A .N. LD C,(IY+1A) ; Command-Port +0403 F3 . DI +0404 ED 51 .Q OUT (C),D ; Register 3 selektieren +0406 ED 79 .y OUT (C),A ; Neuen Register 3 Wert +0408 CB 38 .8 SLR B ; Register 5 Bits "tiefer" +040A FD 7E 19 .~. LD A,(IY+19) ; Alten Registerwert +040D E6 9F .. AND 9F ; unbenoetigte Bits ausblenden +040F B0 . OR B +0410 FD 77 19 .w. LD (IY+19),A ; abspeichern +0413 16 05 .. LD D,05 ; +0415 ED 51 .Q OUT (C),D ; Register 5 selektieren +0417 ED 79 .y OUT (C),A ; Wert in das Register schreiben +0419 FB . EI +041A 01 00 00 ... LD BC,0000 ; "ok" +041D C9 . RET ;---------- Register 4 setzen ----- +041E F3 . DI ; A enthaelt Maske fuer alte Bits +041F FD A6 18 ... AND (IY+18) ; Register 4 Maske +0422 B1 . OR C ; Neuer Clock/Parity/Stopbit Wert +0423 FD 77 18 .w. LD (IY+18),A ; In der Tabelle setzen +0426 06 04 .. LD B,04 ; +0428 FD 4E 1A .N. LD C,(IY+1A) ; Am Kommandoport ausgeben +042B ED 41 .A OUT (C),B ; Register 4 waehlen +042D ED 79 .y OUT (C),A ; Neuen Wert des Registers setzen +042F FB . EI +0430 C9 . RET ; ---------------------------------- +0431 CD CD 04 ... CALL 04CD ; Serieller OUTPUT:String in Puffer +0434 F5 . PUSH AF ; schreiben fuer IRQ-Ausgabe +0435 C5 . PUSH BC +0436 C4 3C 04 .<. CALL NZ,043C ; NZ, wenn Puffer gefuellt +0439 C1 . POP BC +043A F1 . POP AF +043B C9 . RET ;--------- ggf. XON/XOFF ausgeben-- +043C FD 4E 1A .N. LD C,(IY+1A) ; Statusportaddresse +043F F3 . DI +0440 ED 78 .x IN A,(C) ; Statusbyte +0442 FD A6 12 ... AND (IY+12) ;"Transmitter full"-Bit ausmaskieren +0445 FD AE 13 ... XOR (IY+13) ; Umdrehen, falls high-Aktiv +0448 20 0A . JR NZ,0454 ; NZ=Puffer noch voll +044A CD 45 05 .E. CALL 0545 ; Flusskontrolle pruefen(XON/XOFF-->A +044D FD 4E 1B .N. LD C,(IY+1B) ; Addresse des Datenports seriell +0450 28 02 (. JR Z,0454 ; Nichtausgeben, weil Flusskontrolle +0452 ED 79 .y OUT (C),A ; Zeichen aus Akku ausgeben +0454 FB . EI +0455 C9 . RET ;--------Transmitbuffer empty IRQ- +0456 FD E3 .. EX (SP),IY ; Ruecksprungaddresse -31 +0458 C5 . PUSH BC ; = Anfang der Kanalinfotabelle +0459 F5 . PUSH AF +045A 01 DF FF ... LD BC,FFDF ; -31 +045D FD 09 .. ADD IY,BC +045F FD 4E 1A .N. LD C,(IY+1A) ; Kommandoport des Kanals +0462 3E 28 >( LD A,28 ; reset interrupt pending +0464 ED 79 .y OUT (C),A ; Kommando ausgeben +0466 CD 3F 04 .?. CALL 043F ; Flusskontrolle durchfuehren +0469 18 48 .H JR 04B3 ; Interruptende +046B FD E3 .. EX (SP),IY ;------- External/Status Change IRQ +046D C5 . PUSH BC +046E F5 . PUSH AF +046F 01 DC FF ... LD BC,FFDC ; IY := Kanaltabelleninfo +0472 FD 09 .. ADD IY,BC +0474 FD 4E 1A .N. LD C,(IY+1A) ; Statusportaddresse +0477 ED 78 .x IN A,(C) ; Status einlesen +0479 06 10 .. LD B,10 ; reset Ext/Status Interrupts +047B ED 41 .A OUT (C),B +047D FC D1 05 ... CALL M,05D1 ; break empfangen : bit 7 = 1 +0480 CD 3C 04 .<. CALL 043C ; Flusskontrolle durchfuehren +0483 18 2E .. JR 04B3 ; interrupt ende +0485 FD E3 .. EX (SP),IY ;--------special receive cond. IRQ +0487 C5 . PUSH BC +0488 F5 . PUSH AF +0489 01 D6 FF ... LD BC,FFD6 ; IY := Kanaltabelleninfo +048C FD 09 .. ADD IY,BC +048E FD 4E 1A .N. LD C,(IY+1A) ; Status- u. Kommandoport +0491 3E 01 >. LD A,01 ; Read-Register 1 +0493 06 30 .0 LD B,30 +0495 ED 79 .y OUT (C),A ; Reg.selekt +0497 ED 78 .x IN A,(C) ; Status einlesen +0499 ED 41 .A OUT (C),B ; Error-reset +049B 47 G LD B,A +049C FD B6 15 ... OR (IY+15) +049F FD 77 15 .w. LD (IY+15),A ; Fehler vermerken +04A2 78 x LD A,B +04A3 FD A6 16 ... AND (IY+16) ; Zulaessige Fehler maskieren +04A6 28 1B (. JR Z,04C3 ; keine Fehler, normale Eingabe +04A8 FD 4E 1B .N. LD C,(IY+1B) ; Zeichen vom Datenport einlesen +04AB ED 78 .x IN A,(C) +04AD CD C9 05 ... CALL 05C9 ; Zeichen per Inputinterrupt melden +04B0 CC 3C 04 .<. CALL Z,043C ; Flusskontrolle durchfuehren +04B3 F1 . POP AF +04B4 C1 . POP BC +04B5 FD E1 .. POP IY +04B7 FB . EI +04B8 ED 4D .M RETI ;-------Receive Character avil. IRQ +04BA FD E3 .. EX (SP),IY +04BC C5 . PUSH BC +04BD F5 . PUSH AF +04BE 01 D9 FF ... LD BC,FFD9 ; IY := Pufferanfang +04C1 FD 09 .. ADD IY,BC +04C3 FD 4E 1B .N. LD C,(IY+1B) ; Datenport +04C6 ED 78 .x IN A,(C) ; Zeichen einlesen +04C8 CD A9 05 ... CALL 05A9 ; Zeichen per inputinterrupt melden +04CB 18 E3 .. JR 04B0 ; Interrupt mit Flusskontroller ende +04CD 78 x LD A,B ;--------String in Puffer schreiben +04CE B1 . OR C ; Nichts Auszugeben --> SCF RET +04CF 37 7 SCF +04D0 C8 . RET Z +04D1 C5 . PUSH BC ; String (HL/BC) in Puffer schreiben +04D2 FD 7E 02 .~. LD A,(IY+02) ; IY - Kanaldescriptor +04D5 FD 96 03 ... SUB (IY+03) ; Puffergroesse - Pufferzeigerwrite +04D8 28 51 (Q JR Z,052B ; puffer ist voll +04DA C5 . PUSH BC +04DB 5F _ LD E,A ; freier Platz +04DC 78 x LD A,B ; Highbyte > 0 ? Laenge +04DD B7 . OR A +04DE 28 02 (. JR Z,04E2 +04E0 0E FF .. LD C,FF ; Mehr als 255 Bytes Laenge +04E2 7B { LD A,E ; +04E3 B9 . CP C +04E4 30 01 0. JR NC,04E7 ; Nicht genuegend Platz ? +04E6 4F O LD C,A +04E7 FD 7E 02 .~. LD A,(IY+02) ; Puffergroesse- Pufferreadzeiger +04EA FD 96 04 ... SUB (IY+04) +04ED 20 05 . JR NZ,04F4 ; Noch Platz +04EF FD 36 04 00 .6.. LD (IY+04),00 ; Lesezeiger auf Anfang +04F3 79 y LD A,C +04F4 B9 . CP C +04F5 30 01 0. JR NC,04F8 +04F7 4F O LD C,A +04F8 06 00 .. LD B,00 +04FA C5 . PUSH BC +04FB FD 56 07 .V. LD D,(IY+07) ; Pufferanfang + Pufferzeiger +04FE FD 7E 06 .~. LD A,(IY+06) +0501 FD 86 04 ... ADD (IY+04) +0504 30 01 0. JR NC,0507 +0506 14 . INC D ; --> DE bringen +0507 5F _ LD E,A ; und String von HL --> DE bringen +0508 ED B0 .. LDIR +050A C1 . POP BC +050B FD 7E 04 .~. LD A,(IY+04) +050E 81 . ADD C ; Pufferzeiger erhoehen +050F FD 77 04 .w. LD (IY+04),A +0512 F3 . DI +0513 FD 7E 03 .~. LD A,(IY+03) ; Pufferzeigerwrite erhoehen +0516 81 . ADD C ; darf kein IRQ auftreten +0517 FD 77 03 .w. LD (IY+03),A +051A FB . EI +051B E3 . EX (SP),HL ; Stringlaenge (auf Stack) --> HL +051C B7 . OR A +051D ED 42 .B SBC HL,BC ; Reststringlaenge +051F 44 D LD B,H +0520 4D M LD C,L +0521 E1 . POP HL +0522 20 AE . JR NZ,04D2 ; Reststring ggf. ausgeben +0524 C1 . POP BC ; Alle Zeichen uebernommen +0525 37 7 SCF +0526 FD CB 01 46 ...F BIT 0,(IY+01) +052A C9 . RET ;---------------------------------- +052B E1 . POP HL +052C B7 . OR A +052D ED 42 .B SBC HL,BC +052F 44 D LD B,H +0530 4D M LD C,L +0531 FD CB 01 46 ...F BIT 0,(IY+01) +0535 C9 . RET ;----------- "frout" -------------- +0536 F3 . DI ; keine zeichen annehmen +0537 FD 7E 02 .~. LD A,(IY+02) ; Puffergroesse - Pufferzeigerwrite +053A 47 G LD B,A ; Pufferzeiger Write = anzahl Z. +053B FD 96 03 ... SUB (IY+03) +053E FB . EI +053F B8 . CP B ; SCF, wenn Puffer leer +0540 3F ? CCF +0541 06 00 .. LD B,00 +0543 4F O LD C,A +0544 C9 . RET ;---------------------------------- +0545 FD CB 01 66 ...f BIT 4,(IY+01) ; Flusskontrolle ? +0549 20 37 7 JR NZ,0582 ; ja +054B FD CB 01 4E ...N BIT 1,(IY+01) +054F C8 . RET Z +0550 FD CB 01 C6 .... SET 0,(IY+01) ; Zeichen aus Puffer lesen (IY+05) +0554 FD 7E 03 .~. LD A,(IY+03) +0557 B7 . OR A ; Writezeiger am Anfang (leer) +0558 C8 . RET Z ; Zurueck +0559 FD CB 01 86 .... RES 0,(IY+01) +055D FD 35 .5 DEC (IY+03) ; Writezeiger DEC 1 +055F 03 . INC BC +0560 FD 46 07 .F. LD B,(IY+07) ; Pufferanfang High +0563 FD 7E 05 .~. LD A,(IY+05) +0566 FD BE 02 ... CP (IY+02) +0569 20 02 . JR NZ,056D +056B 3E 00 >. LD A,00 +056D 3C < INC A +056E FD 77 05 .w. LD (IY+05),A +0571 3D = DEC A +0572 FD 86 06 ... ADD (IY+06) ; Pufferanfang low +0575 30 01 0. JR NC,0578 +0577 04 . INC B ; BC = Pufferzeiger +0578 4F O LD C,A +0579 0A . LD A,(BC) ; Zeichen aus Puffer (zeiger) +057A FD A6 0C ... AND (IY+0C) ; Bit 8 ggf ausblenden +057D FD AE 0D ... XOR (IY+0D) ; +0580 04 . INC B +0581 C9 . RET ; Flusskontrolle +0582 FD CB 01 A6 .... RES 4,(IY+01) +0586 FD CB 01 6E ...n BIT 5,(IY+01) ; XON oder XOFF ? +058A 28 08 (. JR Z,0594 +058C FD CB 01 AE .... RES 5,(IY+01) +0590 FD 7E 10 .~. LD A,(IY+10) ; XON (CTRL-Q) stattdessen ausgeben +0593 C9 . RET ;----------------------------------- +0594 F6 01 .. OR 01 +0596 FD 7E 0F .~. LD A,(IY+0F) ; XOFF stattdessen ausgeben +0599 C9 . RET ;---------------------------------- +059A FD CB 01 4E ...N BIT 1,(IY+01) ; XON empfangen +059E FD CB 01 CE .... SET 1,(IY+01) +05A2 C9 . RET ;--------------------------------- +05A3 FD CB 01 8E .... RES 1,(IY+01) ; XOFF-empfangen +05A7 18 1D .. JR 05C6 +05A9 FD A6 08 ... AND (IY+08) ;------- Zeichen per 'inputinterrupt' +05AC FD AE 09 ... XOR (IY+09) ; masken fuer fehlerfreien receive +05AF FD CB 01 56 ...V BIT 2,(IY+01) ; XON/XOFF ? +05B3 28 0A (. JR Z,05BF +05B5 FD BE 10 ... CP (IY+10) ; XON-Zeichen ? +05B8 28 E0 (. JR Z,059A +05BA FD BE 0F ... CP (IY+0F) ; XOFF-Zeichen ? +05BD 28 E4 (. JR Z,05A3 +05BF 47 G LD B,A ; Zeichen in B verlangt +05C0 FD 7E 00 .~. LD A,(IY+00) ; Kanalnummer +05C3 CD 13 1E ... CALL 1E13 ; Inputinterrupt aufrufen +05C6 F6 01 .. OR 01 +05C8 C9 . RET ;-------- fehlerhafter receive +05C9 FD A6 0A ... AND (IY+0A) ; masken fuer fehlerhaften receive +05CC FD AE 0B ... XOR (IY+0B) +05CF 18 DE .. JR 05AF ; weiter wie normal +05D1 FD 7E 0E .~. LD A,(IY+0E) ;--------- fehlerhafter receive ---- +05D4 18 D9 .. JR 05AF ; '?' ausgeben +05D6 F3 . DI ;---------------------------------- +05D7 FD 7E 01 .~. LD A,(IY+01) +05DA CB 5F ._ BIT 3,A +05DC 28 09 (. JR Z,05E7 +05DE F6 30 .0 OR 30 ; Bit 4 + 5 setzen (XON/XOFF) +05E0 FD 77 01 .w. LD (IY+01),A +05E3 FD CB 01 46 ...F BIT 0,(IY+01) +05E7 FB . EI +05E8 C9 . RET ;---------------------------------- +05E9 F3 . DI ; von RTS/DTR - XON/XOFF Routine +05EA FD 7E 01 .~. LD A,(IY+01) ; aufgerufen +05ED CB 5F ._ BIT 3,A +05EF 28 0B (. JR Z,05FC ; Unbekannte Flusskontrolle +05F1 F6 10 .. OR 10 +05F3 E6 DF .. AND DF +05F5 FD 77 01 .w. LD (IY+01),A +05F8 FD CB 01 46 ...F BIT 0,(IY+01) +05FC FB . EI +05FD C9 . RET ;----------- XON/XOFF setzen -------- +05FE FD CB 01 DE .... SET 3,(IY+01) +0602 FD CB 01 D6 .... SET 2,(IY+01) +0606 C9 . RET ;--------- IO-Stop d. Flow loeschen +0607 FD CB 01 9E .... RES 3,(IY+01) ; XON/XOFF loeschen +060B FD CB 01 96 .... RES 2,(IY+01) +060F FD CB 01 4E ...N BIT 1,(IY+01) ; XON Modus ? +0613 FD CB 01 CE .... SET 1,(IY+01) ; XON-setzen +0617 C9 . RET ;--------- Datenbitmasken --------- +0618 FD 73 0C .s. LD (IY+0C),E ; AND-maske fuer Datenbits setzen +061B FD 72 0D .r. LD (IY+0D),D ; Bei weniger als 5 Bits links 1er +061E C9 . RET ;--------- Datenbitmasken setzen-- +061F FD 73 08 .s. LD (IY+08),E ; AND fuer fehlerfreien reiceive +0622 FD 72 09 .r. LD (IY+09),D ; XOR +0625 C9 . RET ;--------- Datenbitmasken setzen +0626 FD 73 0A .s. LD (IY+0A),E ; AND fuer fehlerhaften receive +0629 FD 72 0B .r. LD (IY+0B),D ; XOR +062C C9 . RET ;----------------------------------- +;======================== Illegaler Kanal ================================= +062D 01 5F 06 ; 1, IOCONTROL "typ" +0630 02 50 06 ; 2, IOCONTROL "frout" +0633 05 46 06 ; 5, IOCONTROL "size" +0636 FF 4C 06 ; -1, IOCONTROL ill. +0639 FF 55 06 ; -1, Aufg. 5 Nicht moeglich +063C FF 4C 06 ; -1, BLOCKIN/BLOCKOUT nicht moegl. +063F 59 06 ; Illegaler Kanal : OUTPUT 0659 +0641 FD ; BLOCKIN : 063C +0642 FD ; BLOCKOUT : 063C +0643 EE ; IOCONTROL : 062D +0644 FA ; Aufg. 5 : 0636 +0645 00 ; Keine I/O moeglich +0646 3E 00 >. LD A,00 ; ---------- "size" -------------- +0648 01 00 00 ... LD BC,0000 ; Null Bloecke +064B C9 . RET ;----------- "illegal" -1 --------- +064C 01 FF FF ... LD BC,FFFF ; Kann nicht ausgefuehrt werden +064F C9 . RET ;------------ "frout" ------------- +0650 01 C8 00 ... LD BC,00C8 ; kann 200 zeichen uebernehmen +0653 37 7 SCF ; Puffer leer +0654 C9 . RET ;---------- "nicht moegl" ---------- +0655 01 01 00 ... LD BC,0001 ; Liefert 1 +0658 C9 . RET ;---------- "OUTPUT" -------------- +0659 37 7 SCF ; Alle Zeichen uebernommen +065A C9 . RET ;------------- "ok" ---------------- +065B 01 00 00 ... LD BC,0000 +065E C9 . RET ; -------- "typ" ------------------ +065F 06 00 .. LD B,00 ; Type aus Parameterblock d. Kanals +0661 DD 4E 06 .N. LD C,(IX+06) +0664 C9 . RET ;---------------------------------- +;=========================== Floppykanal ================================== +0665 05 95 06 ; 5, IOCONTROL "size" +0668 01 5F 06 ; 1, IOCONTROL "typ" +066B FF 4C 06 ; -1, IOCONTROL ill. +066E FE 85 06 ; -2, Aufg. 5 : Kanal init +0671 FF 55 06 ; -1, Aufg. 5 : Geht nicht +0674 00 9D 06 ; 0, BLOCKIN : 069D +0677 00 99 06 ; 0, BLOCKOUT : 0699 +067A FF 4C 06 ; -1, BLOCKOUT ill. +067D 59 06 ; Floppy: OUTPUT 0659 +067F F7 ; BLOCKIN : 0674 +0680 FA ; BLOCKOUT : 0677 +0681 E8 ; IOCONTROL : 0665 +0682 F1 ; Aufg. 5 : 066E +0683 0C ; Typ : BLOCKIO ohne format +0684 04 +0685 3E 70 >p LD A,70 ; ----------- Floppyinit ----------- +0687 D3 0A .. OUT (0A),A ; Interruptvektor PIOA Floppy = $70 +0689 11 58 09 .X. LD DE,0958 ; Interruptroutine FDC +068C ED 57 .W LD A,I ; In die Interruptvektortabelle +068E 67 g LD H,A ; eintragen +068F 2E 70 .p LD L,70 +0691 73 s LD (HL),E +0692 23 # INC HL +0693 72 r LD (HL),D +0694 C9 . RET ;------------ "size" --------------- +0695 01 D0 04 ... LD BC,04D0 ; 1232 Bloecke = 616K +0698 C9 . RET ;----------- "BLOCKOUT" ----------- +0699 3E 01 >. LD A,01 ; A=1 : Write +069B 18 01 .. JR 069E ; BLOCKIO +069D AF . XOR A ;------------ "BLOCKIN" ---------- +069E E5 . PUSH HL ; Hauptspeicheraddresse +069F 21 CF 04 !.. LD HL,04CF ; Mit Max. Blocknummer +06A2 B7 . OR A +06A3 ED 52 .R SBC HL,DE +06A5 E1 . POP HL +06A6 DA C9 0B ... JP C,0BC9 ; Block zu hoch = 3 +06A9 E5 . PUSH HL +06AA 21 11 08 !.. LD HL,0811 ; Floppysemaphor reservieren +06AD CD 47 0C .G. CALL 0C47 +06B0 E1 . POP HL +06B1 EB . EX DE,HL ; DE = Hauptspeicheraddresse +06B2 4F O LD C,A ; A= Read/Write,HL = Blocknummer +06B3 7D } LD A,L +06B4 E6 0F .. AND 0F ; A = Sektornummer 0..15 +06B6 CB 25 .% SLA L +06B8 CB 14 .. RL H ; HL = Tracknummer +06BA CB 25 .% SLA L ; Track = (Blocknr * 16) DIV 256 +06BC CB 14 .. RL H ; = Blocknr DIV 16 +06BE CB 25 .% SLA L +06C0 CB 14 .. RL H +06C2 CB 25 .% SLA L +06C4 CB 14 .. RL H +06C6 6F o LD L,A ; L = Sektor, H = Track +06C7 79 y LD A,C ; A = Read/Write +06C8 B7 . OR A +06C9 FD 7E 08 .~. LD A,(IY+08) +06CC 28 05 (. JR Z,06D3 ; Z, wenn Read +06CE CD CA 09 ... CALL 09CA ; Write Floppy (Interrupt anstossen) +06D1 18 03 .. JR 06D6 ; Skip +06D3 CD BE 09 ... CALL 09BE ; Read Floppy (Interrupt anstossen) +06D6 FD E5 .. PUSH IY +06D8 CD 19 1E ... CALL 1E19 ; Zur Sicherheit einmal 'warte' +06DB FD E1 .. POP IY +06DD FD 7E 05 .~. LD A,(IY+05) ; Return von Floppy-IRQ-Routine +06E0 3C < INC A +06E1 28 F3 (. JR Z,06D6 ; FF = Busy, IRQ noch nicht beendet +06E3 21 11 08 !.. LD HL,0811 ; Semaphor wieder freigeben +06E6 CD 61 0C .a. CALL 0C61 +06E9 3D = DEC A ; Muss = 0 sein, sonst fehler +06EA C2 AE 0B ... JP NZ,0BAE ; Fehler ggf. melden +06ED 01 00 00 ... LD BC,0000 ; Return: ok +06F0 C9 . RET ;----------------------------------- +;========================= Hintergrundkanal (Harddisk) ===================== +06F1 05 34 07 ; 5, IOCONTROL "size" +06F4 01 5F 06 ; 1, IOCONTROL "typ" +06F7 FF 4C 06 ; -1, IOCONTROL ill. +06FA FE 19 07 ; -2, Aufg. 5 : kanal Init +06FD 9C 3C 07 ; -100, Aufg.5:Anz.HG-Bloecke setzen +0700 FF 55 06 ; -1, Aufg. 5 : BC = 1 +0703 00 4D 07 ; 0, BLOCKIN +0706 00 49 07 ; 0, BLOCKOUT +0709 FF 4C 06 ; -1, BLOCKIO illg. +070C 59 ; Hintergrund : OUTPUT 0659 +070D 06 +070E F7 ; BLOCKIN : 0703 +070F FA ; BLOCKOUT : 0706 +0710 E5 ; IOCONTROL : 06F1 +0711 EE ; Aufg. 5 : 06FA +0712 0C ; Typ : BLOCKIN/BLOCKOUT +0713 00 . NOP +0714 01 00 00 ... LD BC,0000 +0717 00 . NOP +0718 FF . RST 38 ;----------"HD-Init" --------------- +0719 21 DA 0F !.. LD HL,0FDA ; Bei Floppy (0FDA) = 46H +071C 22 0F 08 ".. LD (080F),HL ; Harddisktransferbufferaddresse +071F DD 7E 0A .~. LD A,(IX+0A) ; New Cylinder Number +0722 D3 22 ." OUT (22),A +0724 3E 70 >p LD A,70 ; Interruptvektor FDC+HDC +0726 D3 0A .. OUT (0A),A +0728 11 58 09 .X. LD DE,0958 ; Interruptserviceroutinenaddresse +072B ED 57 .W LD A,I +072D 67 g LD H,A +072E 2E 70 .p LD L,70 +0730 73 s LD (HL),E +0731 23 # INC HL +0732 72 r LD (HL),D +0733 C9 . RET ;------------ "size" --------------- +0734 FD 4E 01 .N. LD C,(IY+01) ; HG-Maxblock Low +0737 FD 46 02 .F. LD B,(IY+02) ; High +073A 03 . INC BC ; +1 = Anzahl Bloecke +073B C9 . RET ;------ Anzahl-HG-Bloecke setzen --- +073C FD 75 01 .u. LD (IY+01),L ; Letzter HD-Block +073F FD 74 02 .t. LD (IY+02),H +0742 FD 73 03 .s. LD (IY+03),E ; Erster HD-Block +0745 FD 72 04 .r. LD (IY+04),D +0748 C9 . RET ;-------- Hintergrund-Write --------- +0749 3E 01 >. LD A,01 ; +074B 18 01 .. JR 074E ;--------- Hintergrund-Read -------- +074D AF . XOR A +074E E5 . PUSH HL ; Blocknummer in DE +074F FD 6E 01 .n. LD L,(IY+01) ; Anzahl Hintergrundbloecke +0752 FD 66 02 .f. LD H,(IY+02) +0755 B7 . OR A +0756 ED 52 .R SBC HL,DE +0758 E1 . POP HL +0759 DA C9 0B ... JP C,0BC9 ; Block zu hoch +075C E5 . PUSH HL +075D 21 11 08 !.. LD HL,0811 ; Harddisksemaphor reservieren +0760 CD 47 0C .G. CALL 0C47 +0763 FD 6E 03 .n. LD L,(IY+03) ; Erster Harddiskblock +0766 FD 66 04 .f. LD H,(IY+04) +0769 19 . ADD HL,DE ; + Blocknummer +076A EB . EX DE,HL +076B E1 . POP HL ; DE=Blocknummer neu +076C E5 . PUSH HL ; HL=Hauptspeicherzieladdresse +076D F5 . PUSH AF ; Wird spaeter als BC gepopt +076E B7 . OR A +076F 20 03 . JR NZ,0774 ; NZ=Write +0771 2A 0F 08 *.. LD HL,(080F) ; Harddiskbufferaddresse +0774 CD A5 07 ... CALL 07A5 ; HDC fuer Transfer anstossen +0777 DD E5 .. PUSH IX +0779 CD 19 1E ... CALL 1E19 ; 'warte' EUMEL0 aufrufen +077C DD E1 .. POP IX +077E DD 7E 07 .~. LD A,(IX+07) ; Harddisk ready ? +0781 3C < INC A ; FF = not ready +0782 28 F3 (. JR Z,0777 ; weiter warten +0784 21 11 08 !.. LD HL,0811 ; Semaphor freigeben +0787 CD 61 0C .a. CALL 0C61 +078A 3D = DEC A ; Fehlercode +078B C1 . POP BC +078C E1 . POP HL +078D C2 AE 0B ... JP NZ,0BAE ; Bei Fehler melden +0790 78 x LD A,B ; A=1 : Write +0791 B7 . OR A +0792 20 0C . JR NZ,07A0 ; Bei Write kein Transfer mehr +0794 EB . EX DE,HL ; DE = Hauptspeicherzieladdresse +0795 2A 0F 08 *.. LD HL,(080F) ; Hauptspeicher fuer HD-Transfer +0798 23 # INC HL ; Vorweg Status etc. +0799 23 # INC HL +079A 23 # INC HL +079B 01 00 02 ... LD BC,0200 ; Vom HD-Buffer --> EUMEL-Block +079E ED B0 .. LDIR +07A0 01 00 00 ... LD BC,0000 ; "ok" +07A3 C9 . RET ;---------------------------------- +07A4 C9 . RET +07A5 E5 . PUSH HL ;----------- HD-Transfer anstoss. -- +07A6 F5 . PUSH AF ; A=1:Write,0=Read,HL=Mem.Addresse +07A7 D5 . PUSH DE ; DE=Blocknummer +07A8 06 00 .. LD B,00 ; Cachesize = 21 max. +07AA 3A 05 00 :.. LD A,(0005) ; (5) = Cachegroesse +07AD B7 . OR A +07AE 28 26 (& JR Z,07D6 ; Nicht in Cache, neu berechnen +07B0 4F O LD C,A +07B1 7A z LD A,D ; D = Blocknummer High zum suchen +07B2 21 05 00 !.. LD HL,0005 ; Tabellenanfang = 6 +07B5 09 . ADD HL,BC ; + Cachegroesse +07B6 ED B9 .. CPDR ; Blocknummerhigh suchen +07B8 20 1C . JR NZ,07D6 ; Nicht gefunden, Tabelle durch +07BA F5 . PUSH AF ; gefunden, test, ob Blocknummerlow +07BB E5 . PUSH HL ; auch stimmt +07BC 21 1A 00 !.. LD HL,001A ; Tabellenanfang = 27 +07BF 09 . ADD HL,BC +07C0 7B { LD A,E ; Blocknummer Low +07C1 BE . CP (HL) +07C2 28 07 (. JR Z,07CB ; Ja, Block gefunden in Cache +07C4 E1 . POP HL +07C5 F1 . POP AF +07C6 EA B6 07 ... JP PE,07B6 ; Noch nicht die ganze Tabelle durch +07C9 18 0B .. JR 07D6 ; Ganz durch, neu berechnen +07CB E1 . POP HL ; Aus Cache entnehmen +07CC F1 . POP AF +07CD 21 44 00 !D. LD HL,0044 +07D0 09 . ADD HL,BC +07D1 C1 . POP BC +07D2 EB . EX DE,HL +07D3 C3 A7 07 ... JP 07A7 ;---------------------------------- +07D6 E1 . POP HL +07D7 F1 . POP AF +07D8 D1 . POP DE +07D9 01 40 04 .@. LD BC,0440 ; 1088 Bloecke subtrahieren +07DC F5 . PUSH AF ; fuer Cylindernrhigh +07DD AF . XOR A +07DE ED 42 .B SBC HL,BC ; 1088 = 17(sektoren)*4(heads)*16 +07E0 3C < INC A +07E1 30 FB 0. JR NC,07DE ; cylindernrh = blocknr DIV 1088 +07E3 09 . ADD HL,BC +07E4 3D = DEC A ; restbloecke in HL +07E5 07 . RLCA ; ins hoeherwertige Nibble bringen +07E6 07 . RLCA ; (*16) +07E7 07 . RLCA +07E8 07 . RLCA +07E9 F5 . PUSH AF +07EA 01 44 00 .D. LD BC,0044 ; Cylindernummerlow +07ED AF . XOR A ; restblocknr DIV 68 = cylindernrl +07EE ED 42 .B SBC HL,BC +07F0 3C < INC A +07F1 30 FB 0. JR NC,07EE +07F3 09 . ADD HL,BC +07F4 3D = DEC A +07F5 67 g LD H,A ; Cylinder = cylinderl*16+cylinderh +07F6 F1 . POP AF +07F7 B4 . OR H +07F8 67 g LD H,A ; H = Cylinder +07F9 7D } LD A,L ; Head = Blocknr MOD 4 +07FA E6 03 .. AND 03 +07FC 07 . RLCA ; Head ins Highnibble bringen +07FD 07 . RLCA +07FE 07 . RLCA +07FF 07 . RLCA +0800 CB 3D .= SLR L ; Sektor = restblocknr DIV 4 +0802 CB 3D .= SLR L ; 17. Sektor ist ungenutzt +0804 4F O LD C,A +0805 F1 . POP AF +0806 FE 01 .. CP 01 +0808 79 y LD A,C +0809 CA 6B 08 .k. JP Z,086B ; Z, wenn Write +080C C3 5C 08 .\. JP 085C ; Read +080F 00 . NOP ; HD-Transferpuffer +0810 00 . NOP +0811 00 . NOP +;=============================== Timerinterrupt =========================== +0812 11 2D 08 .-. LD DE,082D ;-------- Timer Init ---------------- +0815 ED 57 .W LD A,I +0817 67 g LD H,A +0818 2E C6 .. LD L,C6 ; HL = 00C6 Interruptserviceroutine +081A 3E 33 >3 LD A,33 ; Fuer alle Kanaele einen programm. +081C E6 FC .. AND FC ; C0=0, C2=1, C4=2, C6=3(timer) +081E 4F O LD C,A +081F ED 69 .i OUT (C),L ; Interruptvektor setzen +0821 73 s LD (HL),E ; Addresse der Serviceroutine +0822 23 # INC HL ; --> (00C6) fuer CTC-Kanal 3 +0823 72 r LD (HL),D +0824 3E B5 >. LD A,B5 ; IRQ,Timer,DIV256,pos.flanke,kein +0826 D3 33 .3 OUT (33),A ; externer trigger, timeconst folgt +0828 3E FA >. LD A,FA ; 250 = Zeitkonstante: +082A D3 33 .3 OUT (33),A ; Hz=4000000/256/250=62.5 ^ 16ms +082C C9 . RET ;------ Timer-Service-IRQ --------- +082D F5 . PUSH AF +082E 3E 10 >. LD A,10 ; Alle 16ms Interrupt +0830 CD 16 1E ... CALL 1E16 ; "timerinterrupt" +0833 3A 5B 08 :[. LD A,(085B) +0836 3C < INC A +0837 FE 3E .> CP 3E ; Alle 62 Timerdurchlaeufe ~ 1s +0839 28 07 (. JR Z,0842 +083B 32 5B 08 2[. LD (085B),A ; Zaehler INCR 1 +083E F1 . POP AF +083F FB . EI +0840 ED 4D .M RETI ;-------------IRQ-Ende-------------- +0842 AF . XOR A ; Sekundenzaehler auf 0 +0843 32 5B 08 2[. LD (085B),A +0846 DD E5 .. PUSH IX +0848 FD E5 .. PUSH IY +084A E5 . PUSH HL +084B D5 . PUSH DE +084C C5 . PUSH BC +084D C3 50 08 .P. JP 0850 ; Wird jede Sekunde aufgerufen +0850 C1 . POP BC +0851 D1 . POP DE +0852 E1 . POP HL +0853 FD E1 .. POP IY +0855 DD E1 .. POP IX +0857 F1 . POP AF +0858 FB . EI +0859 ED 4D .M RETI ;-----------IRQ-Ende---------------- +085B 00 . NOP ; Sekundenzaehler +;============================= Harddisk I/O =============================== +085C 0E 01 .. LD C,01 ;----------- HD-Read-Routine-------- +085E DD 36 09 01 .6.. LD (IX+09),01 ; Read-Kommando fuer HDC +0862 ED 53 AB 09 .S.. LD (09AB),DE ; Zieladdresse +0866 11 02 02 ... LD DE,0202 ; 515 Bytes +0869 18 0D .. JR 0878 +086B 0E 05 .. LD C,05 ;---------- HD-Write-Routine ------- +086D DD 36 09 02 .6.. LD (IX+09),02 ; (09BA) = Track(High),Sektor(Low) +0871 ED 53 AB 09 .S.. LD (09AB),DE ; Sourceaddresse, 02 = WriteCMD HDC +0875 11 FF 01 ... LD DE,01FF ; 512 Bytes +0878 DD 22 BC 09 .".. LD (09BC),IX ; IX retten +087C ED 53 AD 09 .S.. LD (09AD),DE ; Anzahl Bytes zu uebertragen +0880 DD 36 0C 05 .6.. LD (IX+0C),05 +0884 22 BA 09 ".. LD (09BA),HL +0887 DD 36 07 FF .6.. LD (IX+07),FF +088B 2A BA 09 *.. LD HL,(09BA) +088E F6 01 .. OR 01 ; HD-Drive 1 auswaehlen +0890 D3 20 . OUT (20),A ; Head und Drive selektieren +0892 57 W LD D,A +0893 79 y LD A,C +0894 32 B7 09 2.. LD (09B7),A ; Read or Write 01/05 +0897 DB 23 .# IN A,(23) ; Status einlesen +0899 CB 77 .w BIT 6,A +089B 28 07 (. JR Z,08A4 +089D 3E 02 >. LD A,02 ; NZ = "write fault" +089F D3 20 . OUT (20),A ; Drive 2 selektieren +08A1 7A z LD A,D ; Headnummer setzen +08A2 D3 20 . OUT (20),A +08A4 7C | LD A,H ; Cylindernummer +08A5 DD BE 0A ... CP (IX+0A) ; = Alter Cylinder +08A8 CA C4 08 ... JP Z,08C4 ; ja, kein neuer Cylinderseek +08AB DD 7E 0A .~. LD A,(IX+0A) ; alten Cylinder holen --> HDC +08AE D3 21 .! OUT (21),A ; last significant Bits of CYL +08B0 AF . XOR A ; most significant Bits of CYL = 0 +08B1 D3 21 .! OUT (21),A +08B3 7C | LD A,H ; Neue Cylindernummer +08B4 D3 22 ." OUT (22),A ; ausgeben und +08B6 DD 77 0A .w. LD (IX+0A),A ; vermerken +08B9 AF . XOR A ; Most significant Bits = 0 +08BA D3 22 ." OUT (22),A +08BC 3E 10 >. LD A,10 ; Seek-Kommando an HDC +08BE CD 5B 09 .[. CALL 095B +08C1 2A BA 09 *.. LD HL,(09BA) ; Sektornummer +08C4 7D } LD A,L ; ausgeben +08C5 D3 21 .! OUT (21),A +08C7 21 A9 09 !.. LD HL,09A9 ; DMA-Init-Tabelle +08CA C5 . PUSH BC +08CB 01 00 11 ... LD BC,1100 ; DMA-Transfer vorbereiten +08CE ED B3 .. OTIR ; 17 Bytes an DMA-Controller +08D0 C1 . POP BC +08D1 DD 7E 09 .~. LD A,(IX+09) ; 01=Read, 02=Write +08D4 CD 5B 09 .[. CALL 095B ; An HDC-Controller schicken +08D7 DD 36 0C FF .6.. LD (IX+0C),FF ; Status in A +08DB 21 40 09 !@. LD HL,0940 ; Fehlernummer (in L) --> IX+07 +08DE E5 . PUSH HL +08DF 21 58 09 !X. LD HL,0958 ; HD-IRQ-Serviceroutine +08E2 22 70 00 "p. LD (0070),HL ; in Vektortabelle eintragen +08E5 2E 00 .. LD L,00 +08E7 E6 5D .] AND 5D ; HD-Status in A +08E9 CA 46 09 .F. JP Z,0946 ; "ok" +08EC CB 5F ._ BIT 3,A ; NZ, wenn "Record not found" +08EE C2 11 09 ... JP NZ,0911 ; +08F1 CB 67 .g BIT 4,A ; NZ, wenn "CRC error" +08F3 28 03 (. JR Z,08F8 +08F5 2E 02 .. LD L,02 ; 2 = "crc err" +08F7 C9 . RET ;------------------------------- +08F8 CB 57 .W BIT 2,A ; NZ, wenn "bad sector" +08FA 28 03 (. JR Z,08FF +08FC 2E 03 .. LD L,03 ; "bad sect" +08FE C9 . RET ;------------------------------- +08FF CB 77 .w BIT 6,A ; NZ, wenn "write fault" +0901 28 0B (. JR Z,090E +0903 2E 04 .. LD L,04 ; "write fault" +0905 3E 02 >. LD A,02 ; Drive 2 selektieren +0907 D3 20 . OUT (20),A +0909 E6 3F .? AND 3F +090B D3 20 . OUT (20),A ; Heads 4..15 gibt es nicht +090D C9 . RET ;------------------------------- +090E 2E 05 .. LD L,05 ; "write fault" +0910 C9 . RET ;------------------------------ +0911 2E 07 .. LD L,07 ; "rec not fnd" +0913 DD 35 .5 DEC (IX+08) ; Noch einmal +0915 08 . EX AF,AF' +0916 C0 . RET NZ ; Nach 8 Versuchen: +0917 E1 . POP HL +0918 DD 36 0B 07 .6.. LD (IX+0B),07 ; Register fuer Cylinderpos etc. +091C DD 36 08 08 .6.. LD (IX+08),08 +0920 DD 36 07 FF .6.. LD (IX+07),FF +0924 DD 36 0C FF .6.. LD (IX+0C),FF +0928 DD 36 0A 00 .6.. LD (IX+0A),00 +092C 3E 20 > LD A,20 ; Recalibrate Head +092E CD 5B 09 .[. CALL 095B ; Kommando ausgeben +0931 DD 7E 0B .~. LD A,(IX+0B) +0934 DD 77 07 .w. LD (IX+07),A +0937 21 58 09 !X. LD HL,0958 ; Dummy-IRQ-Vektor (EI, RETI) +093A 22 70 00 "p. LD (0070),HL +093D C3 A4 07 ... JP 07A4 ; RET +0940 DD 75 07 .u. LD (IX+07),L +0943 C3 A4 07 ... JP 07A4 ; NOP oder RET (i.d.R RET) +0946 3E BB >. LD A,BB ; Lesemaske setzen +0948 D3 00 .. OUT (00),A ; DMA-Kommando +094A 3E 01 >. LD A,01 ; BIT0 = Register 0 wird gelesen +094C D3 00 .. OUT (00),A ; Register 0 ist Statusregister +094E DB 00 .. IN A,(00) ; DMA-Status einlesen (Readregister0) +0950 E6 21 .! AND 21 ; Test, ob DMA laeuft +0952 EE 01 .. XOR 01 ; Kein Blockende und DMA erhielt BCK +0954 C8 . RET Z ; DMA- angestossen = 0 +0955 36 06 6. LD (HL),06 ; DMA-failed +0957 C9 . RET +0958 FB . EI +0959 ED 4D .M RETI ;--------- Kommando an HDC -------- +095B E1 . POP HL ; in A +095C 22 7F 09 ".. LD (097F),HL ; Returnaddresse --> CALL Fehler +095F 21 68 09 !h. LD HL,0968 ; Interruptserviceroutine +0962 22 70 00 "p. LD (0070),HL +0965 D3 23 .# OUT (23),A ; Kommando ausgeben +0967 C9 . RET ;-------- IRQ-Serviceroutine HDC----- +0968 F5 . PUSH AF +0969 DD E5 .. PUSH IX +096B DD 2A BC 09 .*.. LD IX,(09BC) +096F E5 . PUSH HL +0970 DB 08 .. IN A,(08) ; HDC-IRQ ? +0972 CB 7F .. BIT 7,A +0974 F5 . PUSH AF +0975 DB 23 .# IN A,(23) ; Status lesen (wird geloescht) +0977 67 g LD H,A +0978 3E 00 >. LD A,00 +097A D3 23 .# OUT (23),A ; Null (quiescent state) Kommando +097C F1 . POP AF +097D 7C | LD A,H +097E C4 67 09 .g. CALL NZ,0967 ; Fehler --> L bringen +0981 DB 04 .. IN A,(04) ; Drive/Controller Status FDC +0983 E1 . POP HL +0984 DD E1 .. POP IX +0986 F1 . POP AF +0987 FB . EI +0988 ED 4D .M RETI ;----------------------------------- +098A F5 . PUSH AF +098B E5 . PUSH HL +098C DD E5 .. PUSH IX +098E DB 23 .# IN A,(23) ; Status einlesen (dummy) +0990 DD 2A BC 09 .*.. LD IX,(09BC) +0994 3E 40 >@ LD A,40 ; Welches Kommando ist das ???!!! +0996 D3 23 .# OUT (23),A +0998 DB 04 .. IN A,(04) ; FDC-Status einlesen +099A DD 36 07 08 .6.. LD (IX+07),08 +099E 21 58 09 !X. LD HL,0958 ; Dummy-IRQ-Vektor +09A1 22 70 00 "p. LD (0070),HL +09A4 DD E1 .. POP IX +09A6 E1 . POP HL +09A7 F1 . POP AF +09A8 C9 . RET ; DMA-Initialisierungstabelle -HDC- + ;-DMA-Register 6 (Kommandoregister) "RESET" +09A9 C3 ; Softreset an DMA-Controller + ;-DMA-Register 0 (Port A Addressregister) +09AA 7D ; A --> B uebertragen, BL & Adr folgt +09AB 00 00 ; Startaddresse Port A +09AD FF 01 ; Anzahl Bytes -1 (Bytecount) + ;-DMA-Register 1 (Port A Modus) +09AF 14 ; Port A ist Speicher, INCR Adress + ;-DMA-Register 2 (Port B Modus) +09B0 28 ; Port B ist IO-Port, Adr. konstant + ;-DMA-Register 4 (Betriebsart & Port B Adr.reg.) +09B1 A5 ; Blockmodus, IO-Port B folgt +09B2 21 ; 21 = Data I/O-Port fuer HDC + ;-DMA-Register 5 (Pin-Control) +09B3 8A ; Stop am Blockende,Pin16=-CE,RDYakt1 + ;-DMA-Register 6 (Kommando) "LOAD" +09B4 CF ; Adresse & BL aus WR0/WR4 laden +09B5 01 ; Wegen Maskenfehler: Direction umk. +09B6 CF ; " Kommando "LOAD" +09B7 01 ; 01 : B-->A, 05 : A-->B +09B8 CF ; Kommando : "LOAD" +09B9 87 ; DMA-Freigabe ------ bis hier +09BA 00 . NOP ; Bereich fuer IX (retten) +09BB 00 . NOP +09BC 00 . NOP ; Sektornummer, 09BD = Tracknummer +09BD 00 . NOP ;------- Floppy-Read anstoss.------ +;============================= Floppy I/O ================================== +09BE FD 36 01 9F .6.. LD (IY+01),9F ; AND-Maske fuer FDC-Status-ready +09C2 0E 01 .. LD C,01 ; DMA-Read-Kommando +09C4 FD 36 02 88 .6.. LD (IY+02),88 ; FDC-Kommando read +09C8 18 0A .. JR 09D4 +09CA FD 36 01 FF .6.. LD (IY+01),FF ;------- Floppy-Write anstoss.------ +09CE 0E 05 .. LD C,05 ; AND-Maske fuer FDC-Status-ready +09D0 FD 36 02 A8 .6.. LD (IY+02),A8 ; ^ DMA-Write-Kommando,FDC-Kommandowrite +09D4 FD 22 B1 0A .".. LD (0AB1),IY ; IY retten +09D8 FB . EI +09D9 E5 . PUSH HL +09DA 21 C1 0A !.. LD HL,0AC1 ; DMA-Direction-Byte +09DD 71 q LD (HL),C +09DE E1 . POP HL +09DF FD 36 0A 46 .6.F LD (IY+0A),46 +09E3 ED 53 B5 0A .S.. LD (0AB5),DE ; Zieladdresse fuer DMA +09E7 FD 36 05 FF .6.. LD (IY+05),FF +09EB CB BF .. RES 7,A +09ED DD BE 07 ... CP (IX+07) +09F0 28 1C (. JR Z,0A0E +09F2 DD 77 07 .w. LD (IX+07),A +09F5 22 C4 0A ".. LD (0AC4),HL ; track/sektor retten +09F8 FD 7E 06 .~. LD A,(IY+06) +09FB D3 05 .. OUT (05),A ; Tracknummer +09FD D3 07 .. OUT (07),A ; Output to FDC +09FF 3E 12 >. LD A,12 ; FDC-Kommando +0A01 CD 76 0A .v. CALL 0A76 +0A04 FD 7E 09 .~. LD A,(IY+09) ; Floppydrive (Headselect) +0A07 CB C7 .. SET 0,A ; Single Density +0A09 D3 08 .. OUT (08),A ; Floppy Format + Headselect +0A0B 2A C4 0A *.. LD HL,(0AC4) ; geretteter Sektor +0A0E 7D } LD A,L ; Sektornumber +0A0F D3 06 .. OUT (06),A +0A11 7C | LD A,H ; Tracknummer +0A12 FD BE 06 ... CP (IY+06) +0A15 28 0A (. JR Z,0A21 +0A17 FD 77 06 .w. LD (IY+06),A +0A1A D3 07 .. OUT (07),A ; Outputdatabyte Track setzen +0A1C 3E 1A >. LD A,1A ; FDC-Kommando +0A1E CD 76 0A .v. CALL 0A76 +0A21 DB 08 .. IN A,(08) ; Headloadinput testen +0A23 CB 4F .O BIT 1,A +0A25 FD 7E 02 .~. LD A,(IY+02) ; Read/Write-Kommando an FDC +0A28 20 02 . JR NZ,0A2C ; Head ist auf der Floppy +0A2A CB D7 .. SET 2,A ; Head muss noch auf Floppy +0A2C 21 B3 0A !.. LD HL,0AB3 ; DMA-Tabelle +0A2F 01 00 11 ... LD BC,1100 ; 17 Bytes in DMA schreiben +0A32 ED B3 .. OTIR +0A34 CD 76 0A .v. CALL 0A76 ; FDC-Kommando ausgeben (starten) +0A37 FD 36 0A FF .6.. LD (IY+0A),FF +0A3B 21 AE 0A !.. LD HL,0AAE +0A3E 22 70 00 "p. LD (0070),HL +0A41 DB 04 .. IN A,(04) ; FDC - Status +0A43 FD A6 01 ... AND (IY+01) ; maske fuer 'fehler' +0A46 CB 7F .. BIT 7,A +0A48 20 11 . JR NZ,0A5B ; ist noch busy +0A4A B7 . OR A ; Irgendwelche Fehler ? +0A4B 20 05 . JR NZ,0A52 +0A4D FD 36 05 00 .6.. LD (IY+05),00 ; Kein Fehler, "ok" +0A51 C9 . RET +0A52 CB 67 .g BIT 4,A ; CRC ? +0A54 20 0A . JR NZ,0A60 +0A56 FD 36 05 02 .6.. LD (IY+05),02 ; Fehler "crc err" +0A5A C9 . RET +0A5B FD 36 05 01 .6.. LD (IY+05),01 ; Fehler 1 : "busy" +0A5F C9 . RET +0A60 FD 36 05 FF .6.. LD (IY+05),FF ; Interrupt noch nicht beendet setz. +0A64 3E 0A >. LD A,0A ; Kommando 10 an FDC +0A66 CD 76 0A .v. CALL 0A76 +0A69 FD 36 05 02 .6.. LD (IY+05),02 ; Fehler 2 : "crc err" +0A6D DB 04 .. IN A,(04) ; FDC-Status +0A6F 21 AE 0A !.. LD HL,0AAE ; Dummy-IRQ Vektor (EI, RETI) +0A72 22 70 00 "p. LD (0070),HL ; eintragen +0A75 C9 . RET ;----------FDC Kommandoausgeben---- +0A76 E1 . POP HL ; Returnaddresse = Fehlernr.laden +0A77 22 A5 0A ".. LD (0AA5),HL +0A7A 21 96 0A !.. LD HL,0A96 +0A7D 22 70 00 "p. LD (0070),HL ; Floppy IRQ-Vektor setzen +0A80 D3 04 .. OUT (04),A ; 1797 FDC Command +0A82 C9 . RET ;---------------------------------- +0A83 F5 . PUSH AF +0A84 FD 2A B1 0A .*.. LD IY,(0AB1) ; geretteter IY +0A88 FD 36 05 02 .6.. LD (IY+05),02 ; "crc err" +0A8C E5 . PUSH HL +0A8D 21 AE 0A !.. LD HL,0AAE ; Dummy-Interrupt-Vektor +0A90 22 70 00 "p. LD (0070),HL +0A93 E1 . POP HL +0A94 F1 . POP AF +0A95 C9 . RET ;----- IRQ-Service-Routine --------- +0A96 FB . EI ; +0A97 FD E5 .. PUSH IY +0A99 E5 . PUSH HL +0A9A C5 . PUSH BC +0A9B F5 . PUSH AF +0A9C FD 2A B1 0A .*.. LD IY,(0AB1) ; geretteter IY +0AA0 DB 08 .. IN A,(08) ; IRQ-Anford.Register +0AA2 CB 77 .w BIT 6,A ; BIT6=FDC IRQ aufgetreten +0AA4 C4 82 0A ... CALL NZ,0A82 ; Returnaddresse in CALL-Addresse +0AA7 DB 23 .# IN A,(23) ; Statusbyte Harddisk loeschen +0AA9 F1 . POP AF +0AAA C1 . POP BC +0AAB E1 . POP HL +0AAC FD E1 .. POP IY +0AAE FB . EI +0AAF ED 4D .M RETI ;----------------------------------- +0AB1 00 . NOP ; Platz zum retten von IY +0AB2 00 . NOP ;- DMA-Initialisierung fuer FDC --- +0AB3 C3 ; Softreset an DMA-Controller + ;-DMA-Register 0 (Port A Addressregister) +0AB4 7D ; A --> B uebertragen, BL & Adr folgt +0AB5 00 00 ; Startaddresse Port A +0AB7 FF 01 ; Anzahl Bytes -1 (Bytecount) + ;-DMA-Register 1 (Port A Modus) +0AB9 14 ; Port A ist Speicher, INCR Adress + ;-DMA-Register 2 (Port B Modus) +0ABA 28 ; Port B ist IO-Port, Adr. konstant + ;-DMA-Register 4 (Betriebsart & Port B Adr.reg.) +0ABB 85 ; Einzelbytemodus(!) IO-Port B folgt +0ABC 07 ; 01 = Data I/O-Port fuer FDC + ;-DMA-Register 5 (Pin-Control) +0ABD 8A ; Stop am Blockende,Pin16=-CE,RDYakt1 + ;-DMA-Register 6 (Kommando) "LOAD" +0ABE CF ; Adresse & BL aus WR0/WR4 laden +0ABF 01 ; Wegen Maskenfehler: Direction umk. +0AC0 CF ; " Kommando "LOAD" +0AC1 01 ; 01 : B-->A, 05 : A-->B +0AC2 CF ; Kommando : "LOAD" +0AC3 87 ; DMA-Freigabe ------ bis hier +0AC4 00 00 ;---------------------------------- +;=========================== Parallel Kanaele ============================= +0AC6 01 5F 06 ; 1 IOCONTROL "typ" +0AC9 02 7B 0B ; 2 IOCONTROL "frout" +0ACC 05 46 06 ; 5 IOCONTROL "size" +0ACF FD 07 0B ; -3 IOCONTROL "Printerstat --> BC" +0AD2 FC FF 0A ; -4 IOCONTROL"code2 --> Printerport" +0AD5 FB 03 0B ; -5 IOCONTROL"code2 --> Pstatusport" +0AD8 FF 4C 06 ; -1 IOCONTROL ill. +0ADB E2 0D 0B ; -30 Aufg. 5, Maske fuer Busy-Status +0ADE E1 14 0B ; -31 Aufg. 5, Maske fuer Printerstb. +0AE1 FE F1 0A ; -2 Aufg. 5 = Kanal init +0AE4 FF 55 06 ; -1, Aufg. 5 --> BC = 1 +0AE7 FF 4C 06 ; -1, BLOCKIN, BLOCKOUT ill. +0AEA 1E ; Parallel 0B1E = OUTPUT +0AEB 0B . DEC BC +0AEC FD . ; BLOCKIN : 0AE7 +0AED FD . ; BLOCKOUT : 0AE7 +0AEE DC ; IOCONTROL : 0AC6 +0AEF F1 ; Aufg. 5 : 0ADB +0AF0 03 ; Typ : Input/Ouput (Stream) +0AF1 DB 10 .. IN A,(10) ;-------- Kanal Init --------------- +0AF3 FD A6 03 ... AND (IY+03) ; Printer selektieren +0AF6 FD AE 04 ... XOR (IY+04) +0AF9 FD AE 05 ... XOR (IY+05) +0AFC D3 10 .. OUT (10),A ; Ausgabe an Printerstatusport +0AFE C9 . RET ;----------- "IOCONTROL -4" -------- +0AFF 7B { LD A,E ; Printerdata direkt ausgeben +0B00 D3 11 .. OUT (11),A +0B02 C9 . RET ;---------- "IOCONTROL -5"- -------- +0B03 7B { LD A,E ; datastrobe, input prime, control +0B04 D3 10 .. OUT (10),A ; An Statusport (printer) ausgeben +0B06 C9 . RET ;-------- "IOCONTROL -3" ----------- +0B07 DB 10 .. IN A,(10) ; Liest der Printerstatus ein +0B09 4F O LD C,A +0B0A 06 00 .. LD B,00 +0B0C C9 . RET ;----- Aufg. 5, "-14" -------------- +0B0D FD 73 01 .s. LD (IY+01),E ; code2 --> AND/XOR Masken "Busy" +0B10 FD 72 02 .r. LD (IY+02),D +0B13 C9 . RET ;----- Aufg. 5, "-15" ------------- +0B14 FD 73 03 .s. LD (IY+03),E ; code2, code3 --> Maske "selekt" +0B17 FD 72 04 .r. LD (IY+04),D +0B1A FD 74 05 .t. LD (IY+05),H +0B1D C9 . RET ;--------- "OUTPUT" --------------- +0B1E 78 x LD A,B ; Nichts auszugeben ? +0B1F B1 . OR C +0B20 37 7 SCF +0B21 C8 . RET Z +0B22 C5 . PUSH BC +0B23 DB 10 .. IN A,(10) ; Status einelsen +0B25 FD A6 03 ... AND (IY+03) ; Printerselekt. +0B28 FD AE 04 ... XOR (IY+04) +0B2B 57 W LD D,A +0B2C FD AE 05 ... XOR (IY+05) +0B2F 5F _ LD E,A +0B30 E5 . PUSH HL +0B31 09 . ADD HL,BC ; Ende des Textes +0B32 E3 . EX (SP),HL +0B33 41 A LD B,C ; Textlaenge Low (Pbuffersize < 256) +0B34 0E 11 .. LD C,11 ; Dataport = 11H +0B36 DB 10 .. IN A,(10) ; Printer busy ? +0B38 FD A6 01 ... AND (IY+01) +0B3B FD AE 02 ... XOR (IY+02) +0B3E 20 1B . JR NZ,0B5B ; testen, ob printer da +0B40 ED A3 .. OUTI ; Ein Zeichen ausgeben +0B42 7A z LD A,D +0B43 D3 10 .. OUT (10),A ; Printer Strobe an +0B45 7B { LD A,E +0B46 D3 10 .. OUT (10),A ; printer Strobe aus +0B48 20 EC . JR NZ,0B36 ; Naechstes Zeichen +0B4A 44 D LD B,H +0B4B 4D M LD C,L +0B4C E1 . POP HL +0B4D E5 . PUSH HL +0B4E B7 . OR A ; Anzahl Restzeichen --> BC +0B4F ED 42 .B SBC HL,BC +0B51 E5 . PUSH HL +0B52 C5 . PUSH BC +0B53 E1 . POP HL +0B54 C1 . POP BC +0B55 20 DC . JR NZ,0B33 ; Nochmal mit dem rest aufrufen +0B57 E1 . POP HL +0B58 C1 . POP BC +0B59 37 7 SCF ; Alles uebernommen +0B5A C9 . RET ;---------- +0B5B CD 72 0B .r. CALL 0B72 ; test,. ob printer bereit +0B5E 28 E0 (. JR Z,0B40 +0B60 CD 72 0B .r. CALL 0B72 +0B63 28 DB (. JR Z,0B40 +0B65 54 T LD D,H +0B66 5D ] LD E,L +0B67 E1 . POP HL +0B68 B7 . OR A +0B69 ED 52 .R SBC HL,DE +0B6B EB . EX DE,HL +0B6C E1 . POP HL +0B6D ED 52 .R SBC HL,DE ; Nicht alles uebernommen +0B6F 44 D LD B,H +0B70 4D M LD C,L +0B71 C9 . RET ; ----------- "printerstatus" ----- +0B72 DB 10 .. IN A,(10) ; Status einlesen +0B74 FD A6 01 ... AND (IY+01) ; Maskieren +0B77 FD AE 02 ... XOR (IY+02) ; Kanal 7..9 selektieren +0B7A C9 . RET ;-------------- "frout" ------------ +0B7B CD 72 0B .r. CALL 0B72 ; Puffer voll ? +0B7E CA 50 06 .P. JP Z,0650 ; Nein, kann 200 Zeichen uebernehmen +0B81 B7 . OR A +0B82 01 00 00 ... LD BC,0000 ; Druckerpuffer voll --> 0 Zeichen +0B85 C9 . RET ;--------- Aufg. 5 -2 ------------- +;================== Sonstige Shard-Routinen (Non I/O) ===================== +0B86 C3 12 08 ... JP 0812 ; Init Parameterkanal = Timerinit +0B89 ED B0 .. LDIR ;------------ "LONGMOVE" ----------- +0B8B C9 . RET ;------------- "LIMIT" ------------- +0B8C 11 FF FF ... LD DE,FFFF ; Geht bis zum RAM-Ende +0B8F C9 . RET ;------------ "SCHINF" ------------- +0B90 01 00 00 ... LD BC,0000 ; Kein Schattenspeicher vorhanden ? +0B93 C9 . RET ;------------ "SCHACC" -------------- +0B94 F5 . PUSH AF +0B95 E5 . PUSH HL +0B96 CB 2C ., SRA H +0B98 CB 1D .. RR L +0B9A 7D } LD A,L +0B9B CD AD 0B ... CALL 0BAD +0B9E E1 . POP HL ? +0B9F 7D } LD A,L +0BA0 21 00 FC !.. LD HL,FC00 +0BA3 CB 47 .G BIT 0,A +0BA5 28 03 (. JR Z,0BAA +0BA7 21 00 FE !.. LD HL,FE00 +0BAA F1 . POP AF +0BAB C9 . RET +0BAC C9 . RET ; -----------"SYSEND"-------------- +0BAD C9 . RET ; ----- SHARD-fehler melden ------ +0BAE E1 . POP HL ; Ruecksprungaddresse +0BAF E3 . EX (SP),HL +0BB0 21 CD 0B !.. LD HL,0BCD ; Tabellenanfang Fehlernummer + text +0BB3 16 00 .. LD D,00 +0BB5 4E N LD C,(HL) ; Textnummer aus Tabelle +0BB6 23 # INC HL +0BB7 B9 . CP C ; gesucht und gefunden ? +0BB8 28 09 (. JR Z,0BC3 ; Ja, gefunden. Nummer melden +0BBA 0C . INC C ; Naechste Fehlernummer +0BBB 28 06 (. JR Z,0BC3 +0BBD 23 # INC HL +0BBE 5E ^ LD E,(HL) +0BBF 23 # INC HL +0BC0 19 . ADD HL,DE +0BC1 18 F2 .. JR 0BB5 ; Naechsten nehmen +0BC3 4E N LD C,(HL) ; Fehlernummer in BC +0BC4 06 00 .. LD B,00 +0BC6 23 # INC HL +0BC7 E3 . EX (SP),HL ; Zur Rueckspungaddresse +0BC8 E9 . JP (HL) +0BC9 3E 09 >. LD A,09 ; Block zu hoch +0BCB 18 E1 .. JR 0BAE ; melden ------------------------ +0BCD 01 01 09 ... LD BC,0901 ; #1 : "not ready", Typ 1 +0BD0 6E n LD L,(HL) +0BD1 6F o LD L,A +0BD2 74 t LD (HL),H +0BD3 20 72 r JR NZ,0C47 +0BD5 65 e LD H,L +0BD6 61 a LD H,C +0BD7 64 d LD H,H +0BD8 79 y LD A,C +0BD9 02 . LD (BC),A ; #2 : "crc err". Typ 2 +0BDA 02 . LD (BC),A +0BDB 07 . RLCA +0BDC 63 c LD H,E +0BDD 72 r LD (HL),D +0BDE 63 c LD H,E +0BDF 20 65 e JR NZ,0C46 +0BE1 72 r LD (HL),D +0BE2 72 r LD (HL),D +0BE3 03 . INC BC ; #3 : "bad sect". Typ 2 +0BE4 02 . LD (BC),A +0BE5 08 . EX AF,AF' +0BE6 62 b LD H,D +0BE7 61 a LD H,C +0BE8 64 d LD H,H +0BE9 20 73 s JR NZ,0C5E +0BEB 65 e LD H,L +0BEC 63 c LD H,E +0BED 74 t LD (HL),H +0BEE 04 . INC B ; #4 : "write fault". Typ 2 +0BEF 02 . LD (BC),A +0BF0 0B . DEC BC +0BF1 77 w LD (HL),A +0BF2 72 r LD (HL),D +0BF3 69 i LD L,C +0BF4 74 t LD (HL),H +0BF5 65 e LD H,L +0BF6 20 66 f JR NZ,0C5E +0BF8 61 a LD H,C +0BF9 75 u LD (HL),L +0BFA 6C l LD L,H +0BFB 74 t LD (HL),H +0BFC 05 . DEC B ; #5 : "busy". Typ 2 +0BFD 02 . LD (BC),A +0BFE 04 . INC B +0BFF 62 b LD H,D +0C00 75 u LD (HL),L +0C01 73 s LD (HL),E +0C02 79 y LD A,C +0C03 06 02 .. LD B,02 ; #6 : "dma failed". Typ 2 +0C05 0A . LD A,(BC) +0C06 64 d LD H,H +0C07 6D m LD L,L +0C08 61 a LD H,C +0C09 20 66 f JR NZ,0C71 +0C0B 61 a LD H,C +0C0C 69 i LD L,C +0C0D 6C l LD L,H +0C0E 65 e LD H,L +0C0F 64 d LD H,H +0C10 07 . RLCA ; #7 : "rec not fnd". Typ 2 +0C11 02 . LD (BC),A +0C12 0B . DEC BC +0C13 72 r LD (HL),D +0C14 65 e LD H,L +0C15 63 c LD H,E +0C16 20 6E n JR NZ,0C86 +0C18 6F o LD L,A +0C19 74 t LD (HL),H +0C1A 20 66 f JR NZ,0C82 +0C1C 6E n LD L,(HL) +0C1D 64 d LD H,H +0C1E 08 . EX AF,AF' ; #8 : "timeout". Typ 2 +0C1F 02 . LD (BC),A +0C20 07 . RLCA +0C21 74 t LD (HL),H +0C22 69 i LD L,C +0C23 6D m LD L,L +0C24 65 e LD H,L +0C25 6F o LD L,A +0C26 75 u LD (HL),L +0C27 74 t LD (HL),H +0C28 09 . ADD HL,BC ; #9 : "block zu hoch". Typ 3 +0C29 03 . INC BC +0C2A 0D . DEC C +0C2B 62 b LD H,D +0C2C 6C l LD L,H +0C2D 6F o LD L,A +0C2E 63 c LD H,E +0C2F 6B k LD L,E +0C30 20 7A z JR NZ,0CAC +0C32 75 u LD (HL),L +0C33 20 68 h JR NZ,0C9D +0C35 6F o LD L,A +0C36 63 c LD H,E +0C37 68 h LD L,B +0C38 FF . RST 38 ; #255 : "wrg err code". Typ 1 +0C39 01 0C 77 ..w LD BC,770C +0C3C 72 r LD (HL),D +0C3D 67 g LD H,A +0C3E 20 65 e JR NZ,0CA5 +0C40 72 r LD (HL),D +0C41 72 r LD (HL),D +0C42 20 63 c JR NZ,0CA7 +0C44 6F o LD L,A +0C45 64 d LD H,H +0C46 65 e LD H,L +;=============================== Semaphorhandler =========================== +0C47 35 5 DEC (HL) ; --- Semaphor (HL) testen, warte -- +0C48 34 4 INC (HL) +0C49 36 01 6. LD (HL),01 ; Semaphor belegen +0C4B C8 . RET Z ; unbeleget, return +0C4C E5 . PUSH HL ; Register fuer 'warte' retten +0C4D DD E5 .. PUSH IX +0C4F FD E5 .. PUSH IY +0C51 C5 . PUSH BC +0C52 D5 . PUSH DE +0C53 F5 . PUSH AF +0C54 CD 19 1E ... CALL 1E19 ; "warte" bis Semaphor frei +0C57 F1 . POP AF +0C58 D1 . POP DE +0C59 C1 . POP BC +0C5A FD E1 .. POP IY +0C5C DD E1 .. POP IX +0C5E E1 . POP HL +0C5F 18 E6 .. JR 0C47 ; Semaphor jetzt frei ? +0C61 36 00 6. LD (HL),00 ; -------- Sempahor freigeben ------ +0C63 C9 . RET +;=========================== Kanalpuffer + Kanalstatusbytes ================ + +;----------------------------- Hintergrund Kanal 0 ------------------------ +0C64 00 ; Hintergrund +0C65 FF 43 ; letzter EUMEL-Block (8,5MB) +0C67 00 00 ; erster EUMEL-Block + +;----------------------------- Serieller Kanal 1 ------------------------- +0C69 FF ; 100 Bytes Puffer fuer Kanal 1 + ... +0CCC FF +0CCD 01 IY+00 ; Kanal 1 +0CCE 03 01 ; Flusskontrollen Bits + BIT 0 : + BIT 1 : 0 = XOFF-Status, 1=XON + BIT 2 : XON/XOFF bei receive + BIT 3 : XON/XOFF bei transmit +0CCF 64 02 ; Puffergroesse = 100 +0CD0 00 03 ; Pufferzeiger Write +0CD1 00 04 ; Pufferzeiger Read +0CD2 00 05 ; +0CD3 69 0C 06 ; 0C69 = Pufferanfang +0CD5 7F 08 ; AND-maske f. fehlerfreien receive +0CD6 00 09 ; Datenbitmaske XOR " +0CD7 7F 0A ; AND-maske f. fehlerhaften reiceive +0CD8 00 0B ; Datenbitmaske XOR " +0CD9 7F 0C ; Maske fuer Read aus Puffer AND +0CDA 00 0D ; " XOR +0CDB 3F ? 0E ; Zeichen fuer Fehlerhaften Receive +0CDC 13 0F ; 19 = Stop (XOFF) +0CDD 11 10 ; 17 = Weiter (XON) +0CDE 02 11 ; BIT 1 = 1 : Baudrateeinst. moegl. + ; BIT 0 = 1 : RTS/CTS +0CDF 04 12 ; AND-Maske Test Statusport (TxDfull) +0CE0 04 13 ; XOR-Maske f. TxDfull (ggf invert.) +0CE1 00 14 ; DTR/RTS - Bits im Register 5 (82H) +0CE2 00 15 ; OR-Register fuer V24-Errors +0CE3 00 16 ; AND-Maske fuer zulaessige Fehler +0CE4 C1 17 ; Register 3 (Rxbits, Autoenables) +0CE5 44 18 ; Register 4 (Stopb., Clock, parity) +0CE6 EA 19 ; Register 5 (Txbits, RTS, DTR) +0CE7 1D 1A ; Port Kanal 1 Status/Command +0CE8 1C 1B ; Datenport Kanal 1 : DART Channel A +0CE9 0C 1C ; BR-Generatorport: CTC1 - Kanal 0 +0CEA 88 1D ; Interruptvektor Kanal 1 +0CEB CD 56 04 CALL 0456 ; Transmitbuffer empty IRQ +0CEE CD 6B 04 CALL 046B ; External/Status Change IRQ +0CF1 CD BA 04 CALL 04BA ; Receive Character available IRQ +0CF4 CD 85 04 CALL 0485 ; Special Receive condition IRQ + +;----------------------------- Serieller Kanal 2 -------------------------- +0CF7 FF ; 100 Bytes Puffer Kanal 2 + ... +0D5A FF +0D5B 02 ; Kanal 2 +0D5C 03 ; Flusskontrollenbits +0D5D 64 ; 100 = Puffergroesse +0D5E 00 00 00 ; Pufferzeiger +0D61 F7 0C ; 0CF7 = Pufferanfang Kanal 2 +0D63 7F 00 ; Masken fuer fehlerfreiene Receive +0D65 7F 00 ; " fehlerhaften Receive +0D67 7F 00 ; Masken fuer read aus Puffer +0D69 3F ? ; Zeichen fuer fehlerhaften receive +0D6A 13 11 ; XOFF/XON Zeichen +0D6C 02 ; Baudrateeinstellung moeglich +0D6D 04 04 ; Masken fuer Test Statusport:TxDfull +0D6F 00 ; DTR/RTS Bits in Register 5 +0D70 00 00 ; Masken fuer zulaessige Fehler +0D72 C1 44 EA ; Register 3, 4, 5 Werte +0D75 1F ; Port Kanal 2 Status / Command +0D76 1E ; Datenport Kanal 2 : DART Channel B +0D77 0E ; BR-Generatorport: CTC1 - Kanal 1 +0D78 80 ; Interruptvektor Kanal 2 +0D79 CD 56 04 CALL 0456 ; Interruptroutinen +0D7C CD 6B 04 CALL 046B +0D7F CD BA 04 CALL 04BA +0D82 CD 85 04 CALL 0485 + +;------------------------------ Serieller kanal 3 ------------------------- +0D85 FF ; 100 Byte Datenpuffer (Senden) + ... +0DE8 FF +0DE9 03 ; Kanal 3 +0DEA 03 ; Flusskontrollenbits +0DEB 64 ; Puffergroesse +0DEC 00 00 00 ; Pufferzeiger +0DEF 85 0D ; Pufferanfang Kanal 3 : 0D85 +0DF1 7F 00 ; Datenbitsmasken s.o +0DF3 7F 00 ; " +0DF5 7F 00 ; " +0DF7 3F ? ; Zeichen bei fehlerhaftem Receive +0DF8 13 11 ; XOFF/XON Zeichen +0DFA 02 ; Baudrateeinstellung moeglich +0DFB 04 04 ; Masken fuer Test Statusport:TxDfull +0DFD 00 ; DTR/RTS Bits in register 5 (82H) +0DFE 00 00 ; Masken fuer zulaessige Fehler +0E00 C1 44 EA ; Register 3, 4, 5 Werte +0E03 29 ; Port Kanal 3 Status / Command +0E04 28 ; Datenport Kanal 3 : SIO 1 Channel A +0E05 32 ; BR-generatorport: CTC2 - Kanal 2 +0E06 98 ; Interruptvektor Kanal 3 +0E07 CD 56 04 CALL 0456 ; Interruptroutinen +0E0A CD 6B 04 CALL 046B +0E0D CD BA 04 CALL 04BA +0E10 CD 85 04 CALL 0485 + +;--------------------------------- Serieller Kanal 4 ----------------------- +0E13 FF ; 100 Bytes Kanalpuffer + ... +0E76 FF +0E77 04 ; Kanal 4 +0E78 03 ; Flusskontrollenbits +0E79 64 ; Puffergroesse +0E7A 00 00 00 ; Pufferzeiger +0E7D 13 0E ; Pufferanfang Kanal 4 : 0E13 +0E7F 7F 00 ; Datenbitmasken s.o. +0E81 7F 00 +0E83 7F 00 +0E85 3F ? ; Zeichen bei fehlerhaften Receive +0E86 13 11 ; XOFF/XON Zeichen +0E88 02 ; Baudrateeinstellung moeglich +0E89 04 04 ; Masken fuer TxDfull Status +0E8B 00 ; RTS/DTR Bits (82H) +0E8C 00 00 ; Masken fuer zulaessige Fehler +0E8E C1 44 EA ; Register 3, 4, 5 Werter +0E91 2B ; Port Kanal 4 Status/Command +0E92 2A ; Datenport kanal 4 : SIO 1 Channel B +0E93 31 ; BR-Generatorport: CTC2 - Kanal 1 +0E94 90 ; Interruptvektor Kanal 4 +0E95 CD 56 04 CALL 0456 ; Interruptroutinen +0E98 CD 6B 04 CALL 046B +0E9B CD BA 04 CALL 04BA +0E9E CD 85 04 CALL 0485 + +;-------------------------------- Serieller Kanal 5 ----------------------- +0EA1 FF ; 100 Bytes Ausgabepuffer + ... +0F04 FF +0F05 05 ; Kanal 5 +0F06 03 ; Flusskontrollenbits +0F07 64 ; Puffergroesse +0F08 00 00 00 ; Pufferzeiger +0F0B A1 0E ; Pufferanfang : 0EA1 +0F0D 7F 00 ; Datenbitmasken s.o. +0F0F 7F 00 ; " +0F11 7F 00 ; " +0F13 3F ? ; Zeichen fuer fehlerhaften Receive +0F14 13 11 ; XOFF/XON Zeichen +0F16 02 ; Baudrateeinstellung moeglich +0F17 04 04 ; Maskenbits fuer Status TxDfull +0F19 00 ; RTS/DTR Bits (82H) +0F1A 00 00 ; Masken fuer zulaessige fehler +0F1C C1 44 EA ; Register 3, 4, 5 Werte +0F1F 2D ; Port Kanal 5 Status / Command +0F20 2C ; Datenport kanal 5 : SIO 2 Channel A +0F21 30 ; BR-Generatorport: CTC2 - Kanal 0 +0F22 A8 ; Interruptvektor Kanal 5 +0F23 CD 56 04 CALL 0456 ; Interruptroutinen +0F26 CD 6B 04 CALL 046B +0F29 CD BA 04 CALL 04BA +0F2C CD 85 04 CALL 0485 + +;--------------------------- Serieller kanal 6 ---------------------------- +0F2F FF ; 100 Bytes ausgabepuffer + ... +0F92 FF +0F93 06 ; Kanal 6 +0F94 03 ; Flusskontrollenbits +0F95 64 ; Puffergroesse +0F96 00 00 00 ; Pufferzeiger +0F99 2F 0F ; Pufferanfang Kanal 6 : 0F2F +0F9B 7F 00 ; Datenbitmasken s.o. +0F9D 7F 00 ; " +0F9F 7F 00 ; " +0FA1 3F ? ; Zeichen fuer fehlerhaften Receive +0FA2 13 11 ; XOFF/XON Zeichen +0FA4 02 ; Baudrateeinstellung moeglich +0FA5 04 04 ; Maskenbits Status TxDfull +0FA7 00 ; RTS/DTR Bits in Register 5 +0FA8 00 00 ; Masken fuer zulaessige Fehler +0FAA C1 44 EA ; Register 3, 4, 5 Werte +0FAD 2F ; Port Kanal 6 : Status / Command +0FAE 2E ; Datenport kanal 6 : SIO 2 Channel B +0FAF 31 ; BR-Generatorport : CTC2 - Kanal 1 +0FB0 A0 ; Interruptvektor kanal 6 +0FB1 CD 56 04 CALL 0456 ; Interruptroutinen +0FB4 CD 6B 04 CALL 046B +0FB7 CD BA 04 CALL 04BA +0FBA CD 85 04 CALL 0485 + +;------------------------------- Parallelkanal 7 -------------------------- +0FBD 07 ; Kanal 7 +0FBE 20 ; AND-Maske fuer Printerbusy +0FBF 00 ; XOR-Maske f. Printer 0 busy +0FC0 FE ; AND-Maske fuer Printerstrobe +0FC1 00 ; XOR-Maske1 fuer Printerstrobe an +0FC2 01 ; XOR-Maske2 fuer Printerstrobe aus + +;------------------------------- Parallel Kanal 8 ------------------------- +0FC3 08 ; Kanal 8 +0FC4 40 ; AND-Maske fuer Printerbusy +0FC5 00 ; XOR-Maske fuer Printer 1 busy +0FC6 FD ; AND-Maske fuer Printerstrobe +0FC7 00 ; XOR-Maske1 fuer Printerstrobe an +0FC8 02 ; XOR-Maske2 fuer Printerstrobe aus + +;------------------------------ Parallel kanal 9 -------------------------- +0FC9 09 ; Kanal 9 +0FCA 80 ; AND-Maske f. Printerbusy +0FCB 00 ; XOR-Maske f. Printer 2 busy +0FCC FB ; AND-Maske fuer Printerstrobe +0FCD 00 ; XOR-Maske1 fuer Printerstrobe an +0FCE 04 ; XOR-maske2 fuer Printerstrobe aus + +;----------------------------- Floppy Kanal 31 ---------------------------- +0FCF 1F ; Kanal 31 +0FD0 00 ; IY+00 +0FD1 00 ; IY+01 FDC-AND-Maske Status-ready +0FD2 00 ; 02 FDC-Kommando Read/Write +0FD3 00 ; 03 +0FD4 00 ; 04 +0FD5 00 ; 05 : Returncode aus Floppy-IRQ +0FD6 00 ; 06 : Alter Sektor +0FD7 00 ; 07 +0FD8 04 ; 08 +0FD9 FF ; 09 Floppydrive (f. Headselect) +0FDA 00 ; 0A - 46H = "F" +;============================== SHARD ENDE ================================= diff --git a/system/shard-z80-ruc-64180/1.5/doc/SHARD.PRT b/system/shard-z80-ruc-64180/1.5/doc/SHARD.PRT new file mode 100644 index 0000000..5fed997 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/doc/SHARD.PRT @@ -0,0 +1,584 @@ +#type ("12")##limit (16.0)##block##pageblock# +#head# +#center#Dokumentation zum EUMEL-SHard + + +#end# +#bottom# + + +#center#- % - +#end# +************************************************************************ +* * +* D o k u m e n t a t i o n z u m S H a r d (8) * +* * +* Stand der Dokumentation: 26.06.87 * +* Stand der Implementation: 26.06.87, Version 1.5 * +* * +* Michael Staubermann * +* Mornenstrae 29 * +* 44 Mnster-Hiltrup * +************************************************************************ + + + +1. Allgemeines +1.1 Neuheiten +1.2 Logische und physische Kanle + +2. Block I/O +2.1 Harddisk (Kanal 0) +2.2 SCSI-Floppy (Kanal 31) +2.3 Harddisk-Volume (Kanal 28) +2.4 160k/640k-Floppys (Kanal 29, 30) +2.5 Graphikmemory (Kanal 1) + +3. Stream I/O +3.1 Konsole (Kanal 1) +3.2 6551-Seriell (Kanal 5) +3.3 SCCs (Kanal 2, 3) +3.4 CIO-Drucker (Kanal 4) +3.5 Motherboard-Drucker (Kanal 6) + +4. Graphik +4.1 CTRL +4.2 MOVE +4.3 DRAW +4.4 TEST +4.5 CLR +4.6 FILL +4.7 TRANS + +5. Hardware +5.1 Zugriff auf die Hardware-Uhr +5.2 Zugriff auf die Analog-Ports +5.3 Zugriff auf die I/O-Ports +5.4 ID-Felder + +6. Installation +6.1 Vortest/Speichertest +6.2 Konsole +6.3 SCSI-Floppy +6.4 Harddisk Volume +6.5 Logische Kanle zuordnen +6.6 Installation auf Harddisk +6.7 Installation auf Floppy + +#page# +#ub#1 Allgemeines#ue# + +#ub#1.1 Neuheiten#ue# + +Neu in Version 1.2: 40% hherer CPU-Durchsatz. + +Neu in Version 1.4: Texthardcopy mit SHIFT CTRL F12. + +Neu in Version 1.5: Beide Printer-Spooler lschbar mit control (-10,...). +Korrektur in 1.5: Kanal 4 - Printer darf auch whrend des Betriebs aus- + und eingeschaltet werden (luft automatisch wieder an). + + +#ub#1.2 Logische und physische Kanle#ue# + +Die Unterscheidung zwischen logischen und physischen Kanlen bringt Vortei- +le: + +- Der Systemstart mu nicht mehr an der Konsole erfolgen (jetzt z.B. an + einem externen Terminal). +- Systemfehler/Hardwarefehler und Info werden damit auch an einem anderen + physischen Kanal ausgegeben. +- Das Hintergrundmedium mu nicht mehr unbedingt die Harddisk sein. Eine + SCSI-Floppy (720k) wre denkbar, oder ein anderes Harddisk-Volume. +- Das Archivmedium mu nicht mehr unbedingt die SCSI-Floppy sein. Ein Hard- + diskvolume oder eine 640k-Floppy wren denkbar. +- Fr einen anderen SHard geschriebene Software (z.B. alter Druckertrei- + ber/Graphiktreiber) mu nicht gendert werden. + +#page# +#ub#2. Block I/O#ue# + +#ub#2.1 Harddisk (Kanal 0)#ue# + +Keine Recalibrates (wg. Timeout/DMA-Fehler) mehr! +Das beste Sektor-Interleave ist 5. + + +#ub#2.2 SCSI-Floppy (Kanal 31)#ue# + +- Falls keine Floppy im Schacht liegt, werden keine Retries mehr gemacht. + Bei Write-Protect auch nicht. +- Harddisk und Floppy arbeiten jetzt auch bei intensiver Benutzung gut + nebeneinander. +- Mit 'size (schluessel)' kann vom EUMEL aus das Format eingestellt werden. + Interpretiert wird 0 und 2 als 720k-Format und 1 als 360k-Format, sowie + der analytische Schlssel (lt. Portierungshandbuch). +- 'format (schluessel)' formatiert eine Floppy im 720k-Format. Der Control- + ler wird allerdings wie bei 'size (schluessel)' vorher initialisiert, da + EUMEL das nicht macht. +- Falls gewnscht kann auch SCSI-Floppy #1 ber Kanal 31 angesprochen wer- + den. Die entsprechende Frage wird im Installationsprogramm gestellt. + + +#ub#2.3 Harddisk-Volume (Kanal 28)#ue# + +Mit diesem Kanal ist es mglich, ein anderes Harddisk-Volume, dessen Anfang +und Gre auf der Platte mit dem Installationsprogramm ausgewhlt wurde, +anzusprechen. Ein CP/M-Volume kann z.B. auch durch EUMEL genutzt werden +oder das Harddisk-Volume wird als Archiv-Kanal genutzt. + + +#ub#2.4 160k/640k Floppys (Kanal 29, 30)#ue# + +- Kanal 29 spricht Disk #1 in Slot 6 an, +- Kanal 30 spricht Disk #0 in Slot 6 an. +- Da sich beide Disks einen Controller und Datenbereich (4k-Cache) teilen, + kann Block I/O nicht auf beiden Kanen parallel ablaufen. Blockweise Ab- + wechslung ist allerdings mglich (Wird durch Semaphor geregelt). +- Formatieren ist auf diesen Kanlen nicht mglich. +- Das Format (160k/640k) wird mit 'size (schluessel)' im EUMEL eingestellt. + Auer dem analytischen Schlssel wird noch 0 und 2 fr 2 * 80 Tracks + (640k) und 1 fr 1 * 40 Tracks (160k) interpretiert. +- Ein (CP/M-) Interleave von 3 Sektoren ist eingestellt. +- Daten werden jeweils Trackweise in einen Puffer gelesen und in 512-Byte + Blcken an EUMEL bergeben. Bei 'blockout' wird der Block (512-Bytes) + sofort auf die Floppy geschrieben. +- Writeprotection wird erkannt. +- Media-Mangel wird nicht erkannt, sondern als Lesefehler interpretiert bei + dem Retries versucht werden. (SHard fhrt von sich aus 1 Recalibrate aus, + den Rest mu EUMEL machen). + + +#ub#2.5 Graphikmemory (Kanal 1)#ue# + +- Dieser flchtige Speicher hat eine Gre von 32KB (64 Blcke) +- 4 Graphikseiten zu jeweils 8KB sind linear angeordnet. +- Seiten 0 und 1 knnen als Grahikbitmap angezeigt werden +- Seiten 2 und 3 knnen dienen als Hilfsspeicherseiten + +#page# +#ub#3. Stream I/O#ue# + +#ub#3.1 Konsole (Kanal 1)#ue# + +- Die Blinkfrequenz des Cursors kann nicht mehr mit 'control' eingestellt + werden, sondern vor dem Systemstart mit dem Installationsprogramm. +- Zustzlich kann die Tonhhe des Steuercodes ""7"" bestimmt werden (Im + Installationsprogramm). +- Der Zeichensatz wird nicht mehr mit 'control' eingestellt. Da jetzt Steu- + ercodes benutzt werden, kann der Zeichensatz in der Typtabelle festgelegt + werden. +- Zeichencodes 128..255 werden ohne Umsetzung auf den Bildschirm geschrie- + ben. +- Folgenden Steuercodes sind definiert: + 0 - Keine Aktion + 1 - Cursor Home + 2 - Cursor right + 3 - Cursor up + 4 - Clear to end of Page + 5 - Clear to end of Line + 6 - Cursor Positionierung (Row, Column) (ohne Offset!) + 7 - Bell + 8 - Cursor left + 9 - Clear Screen + 10 - Cursor down + 11 - Insert Line + 12 - Delete Line + 13 - Carriage Return + 14 - End Mark + 15 - Begin Mark + 16 - Deutscher Zeichensatz (German ASCII) + 17 - ASCII Zeichensatz + 18 - APL Zeichensatz + 19 - Universal Zeichensatz (German ASCII + APL) + 20 - Mode einschalten: Inverse Zeichen blinken nicht + 21 - Mode einschalten: Inverse Zeichen blinken + +- Es werden keine Eingabeumcodierungen gemacht, dies soll in der Typtabelle + geschehen. +- Falls EUMEL keine Eingabezeichen mehr puffern kann, werden diese im Ta- + staturpuffer gespeichert. Damit ist es mglich bis zu 270 Tastendrcke im + voraus zu tippen. Werden noch mehr Tasten gedrckt, ertnt ein Signal, da + weitere Tastendrcke verlorengehen. EUMEL wird beim nchsten Inputinter- + rupt ein Overrun-Error gemeldet. + +- Einige Funktionstasten haben eine besondere Bedeutung: + F2 = SV-Call: Diese Taste wird auch dann weitergeleitet, wenn EUMEL keine + weiteren Zeichen puffern kann, damit Tasks, die nicht auf + Eingabe warten, abgebrochen werden knnen. + SHIFT CTRL F12 = Texthardcopy: Durch Drcken dieser Tasten wird der In- + halt des Textbildschirms auf einem Drucker an der paralle- + len Basisschnittstelle ausgedruckt. Achtung: Dies funktio- + niert nur, wenn der Spooler leer ist. Falls ein Druckauf- + trag luft, sollte keine Hardcopy gemacht werden (Falls der + Spooler nmlich kurzfristig leer ist, wird die Hardcopy + gedruckt den Druckauftrag ruinieren.) + SHIFT CTRL F13 = Weiter: Durch Drcken dieser Tasten wird der Tastatur- + puffer ohne Rcksicht darauf, ob EUMEL noch Zeichen puffern + kann, zeichenweise entleert. (Wird wohl kaum benutzt werden + men). + SHIFT CTRL F14 = Shutup: Durch Drcken dieser Tasten wird das System + kontrolliert heruntergefahren. + SHIFT CTRL F15 = Reset: Falls verdrahtet lst die Software einen Hard- + warereset aus. + + +#ub#3.2 6551-Seriell (Kanal 5)#ue# + +Dieser Kanal wurde erweitert: +- Auer Baudrate knnen jetzt auch Stopbits, Datenbits, Parity und Flu- + kontrolle eingestellt werden (CTS, DSR/DTR, XON/XOFF). +- Ein Empfangspuffer von 2300 Zeichen wurde eingebaut und der Ausgabepuffer + auf 1k erweitert. +- Ein- und Ausgabe luft jetzt Interruptgetrieben, kann also auch whrend + einer Floppyoperation stattfinden. +- bertragungsfehler (Parity, Framing, Overrun) werden beim Inputinterrupt + an EUMEL gemeldet. Die Fehler werden in dem Moment, in dem sie bemerkt + werden gemeldet, d.h. i.d.R. nicht passend zum gleichzeitig bermittelten + Zeichen. +- Ein Break-Kommando wird interpretiert und ggf. an EUMEL gemeldet. Folgt + auf das Break-Kommando ('00' + Framing Error) ein 'Kommandozeichen', dann + wird dieses Remote-Kommando ausgefhrt, anderenfalls wird das auf 'Break' + folgende Zeichen in den Empfangspuffer geschrieben und 'Break' an EUMEL + gemeldet. +- Folgende Break-Komandos werden interpretiert: + : SV-Call ohne Rcksicht auf Verluste an EUMEL leiten. + W : Wie SHIFT CTRL F13 bei Keyboard. + S : Shutup, System kontrolliert herunterfahren. + R : Software lst, falls verdrahtet, einen Hardarereset + aus. + + +#ub#3.3 SCCs (Kanal 2, 3)#ue# + +- Auer der Baudrate kann man jetzt auch Stopbits, Datenbits, Parity und + Flukontrolle (RTS+DTR /CTS) einstellen. XON/XOFF wird nicht empfohlen. +- bertragungsfehler (Overrun, Parity und Break) werden EUMEL gemeldet. +- Beide Kanle besitzen einen Ausgabepuffer von jeweils 2KB. + + +#ub#3.4 CIO-Drucker (Kanal 4)#ue# + +- Der Drucker wird mit Strobe/-ACK - Protokoll angeschloen. +- Dieser Kanal besitzt einen Ausgabepuffer von 4KB (Interruptgetrieben). +- Der Druckerpuffer kann mit 'control (-10, 0, 0, r)' an Kanal 4 gelscht + werden. + + +#ub#3.5 Motherboard-Drucker (Kanal 6)#ue# + +- Der Drucker wird mit Strobe/-ACK - Protokoll angeschloen. +- Dieser Kanal besitzt einen 4KB Ausgabepuffer (Polling). +- Der Druckerpuffer kann mit 'control (-10, 0, 0, r)' an Kanal 6 gelscht + werden. + +#page# +#ub#4. Graphik#ue# + +#ub#4.1 CTRL#ue# + +control (-8, flags, linienmuster, r) +Setzt verschiedene Graphikmodi. + +Die Bits im Parameter 'flags' sind folgendermaen zugeordnet: + +Bit 0 : + 0 = Textmodus einschalten, Graphikmodus ausschalten + 1 = Graphikmodus einschalten, Textmodus ausschalten + +Bit 1 : + 0 = Seite 0 als sichtbare Seite whlen + 1 = Seite 1 als sichtbare Seite whlen + +Bit 2 : + 0 = Seite 0 als bearbeitete Seite whlen + 1 = Seite 1 als bearbeitete Seite whlen + +Bit 3, 4 : Verknpfung Patternbit: 0 1 + 0 OR setzen unverndert + 1 NAND lschen unverndert + 2 XOR invertieren unverndert + 3 COPY lschen setzen + +Bit 5 : + 0 = Der gesamte Bildschirm zeigt die Graphikseite ('full screen') + 1 = In den letzten 32 Graphikzeilen erscheint die Textseite ('mixed') + +Bit 6 : + 0 = Das im zweiten Parameter bergebene Wort wird als 16-Bit + Linienmuster eingestellt. Modus siehe Bit 3/4. + 1 = Das alte (bzw. voreingestellte) Linienmuster wird benutzt + +Bit 7 : + 0 = Als Punkthelligkeit wird 'dunkel' (bzw. Violett) eingestellt + 1 = Als Punkthelligkeit word 'hell' (bzw. Gelb) eingestellt + +Bit 8..11 : + 0 = Default-Strichdicke (1) + 1..15 = Strichdicke (Es werden 2*s-1 Linien parallel gezeichnet.) + +Der zweite Parameter enthlt das 16-Bit Linienmuster. Dieses wird beim +Zeichnen einer Linie zyklisch Bitweise abgetastet. Je nach Status des Bits +im Linienmuster wird eine Punktaktion ausgefhrt, deren Wirkung in 'flags' +mit den Bits 3 und 4 spezifiziert wird. + + +#ub#4.2 MOVE#ue# + +control (-5, x pos, y pos, r) +Setzt den (unsichtbaren) Graphikcursor auf xpos/ypos. + +Der nchste 'draw' zeichnet eine Linie beginnend bei xpos/ypos. + + +#ub#4.3 DRAW#ue# + +control (-6, x pos, y pos, r) +Zeichnet eine Linie zur angegebenen Position xpos/ypos. + +Die eingestellten Parameter Helligkeit, Linientyp, Bitverknpfung und Dicke +werden beachtet. Der nchste 'draw' zeichnet eine Linie beginnend bei +xpos/ypos. + + +#ub#4.4 TEST#ue# + +control (-7, x pos, y pos, result) +Testet den Status eines bestimmten Pixels. + +Die Pixelposition wird mit xpos/ypos beschrieben. +Als 'result' wird zurckgeliefert: + 255, falls xpos/ypos auerhalb des sichtbaren Fensters liegt. + Bit 0 = 1: Pixel sichtbar + Bit 0 = 0: Pixel unsichtbar + Bit 7 = 1: Pixelfarbe ist hell (gelb) + Bit 7 = 0: Pixelfarbe ist dunkel (violett) + + +#ub#4.5 CLR#ue# + +control (-3, seite, muster, r) +Fllt die angegebene Seite mit dem angegebenen Muster. + +Bit 7 des Musters bestimmt die Farbe (0 = dunkel, 1 = hell). Das Muster +wird zyklisch Spalten- und Zeilenweise wiederholt. muster=128 lscht z.B. +die Graphikseite. + + +#ub#4.6 FILL#ue# + +control (-4, muster nummer, 0, return) +Fllt eine beliebig durchgehend begrenzte Flche mit dem angegebenen Mu- +ster. + +Das Muster ist eine 8 x 8 Matrix, die sich auf allen (pos MOD 8)-Pixel- +adressen wiederholt. Im NAND-Modus wird mit dem inversen Muster gefllt. +Die Flche mu dann aber mit unsichtbaren Pixeln begrenzt werden. + +Folgende Muster sind mglich: + 0 = 'solid' (alles gefllt) + 1 = 'lrs2' (jeder zweite Punkt, Zeilenweise versetzt) + 2 = 'row4' (jede 4. Zeile wird gefllt) + 3 = 'row2' (jede 2. Zeile wird gefllt) + 4 = 'col4' (jede 4. Spalte wird gefllt) + 5 = 'col2' (jede 2. Spalte wird gefllt) + 6 = 'grid4' (jede 4. Spalte/Zeile wird gefllt) + 7 = 'grid2' (jede 2. Spalte/Zeile wird gefllt) + 8 = 'ls4' (Schraffur links unten --> rechts oben, jede 4.) + 9 = 'rs4' (Schraffur rechts unten --> links oben, jede 4.) + 10 = 'lrs4' (Schrges Gitter wie 8 und 9 zusammen) + 11 = 'point2'(In jeder 2. Zeile jeder 2. Punkt) + 12 = 'wall4' (Mauer, ein Ziegelstein 4 Pixel hoch) + 13 = 'basket'(Korb/Netz) + 14 = 'wave4' (Wellenlinie 4 Pixel hoch) + 15 = 'wave8' (Wellenlinie 8 Pixel hoch) + +Falls die zu fllende Flche zu komplex wird, kann es vorkommen, da der +interne Stack berluft. In diesem Fall wird nicht die gesamte Flche ge- +fllt. + + +#ub#4.7 TRANS#ue# + +control (-9, from page, to page, r) +Kopiert den Inhalt der Graphikseite 'from page' in die Seite 'to page'. + +Folgende Seitennummern sind mglich: + 0 : Seite 0 kann mit 'visible page (0)' angezeigt werden + 1 : Seite 1 kann mit 'visible page (1)' angezeigt werden + 2 : Seite 2 kann nicht sichtbar werden (Hilfsspeicher-Seite) + 3 : hnlich Seite 2, wird aber bei 'FILL' noch als Arbeitsseite benutzt + (wird dann berschrieben!) + +#page# +#ub#5. Hardware#ue# + +#ub#5.1 Zugriff auf die Hardware-Uhr#ue# + +Mit 'TEXT PROC calendar (INT CONST feld)' kann in Shnen von SYSUR die +Hardware-Uhr gelesen werden. Fr 'feld' sind folgende Werte zugeordnet: + + 0 Sekunden (0..59) + 1 Minuten (0..59) + 2 Stunden (0..23) + 3 Tag des Monats (1..31) + 4 Monat (1..12) + 5 Jahr (87..99) + +Ist die Uhr richtig gestellt (das ist aus CP/M mit 'date set' mglich), +liefert jeder Aufruf von 'calendar' eine Zahl, anderenfalls wird immer +'niltext' geliefert und EUMEL fragt nach dem Systemstart nach dem Datum. +Dabei wird die Hardware-Uhr jedoch #ub#nicht#ue# gestellt. +In diesem Fall ist der Akku wahrscheinlich entladen (Abhilfe: Rechner eini- +ge Stunden laufen lassen) oder die Uhr ist noch nicht gestellt worden (Ab- +hilfe: 'date set' im CP/M). + +In Tasks, die keine Shne von SYSUR sind, kann die Hardware-Uhr mit + + TEXT PROC calendar (INT CONST feld) : + INT VAR r ; + control (10, feld, 0, r) ; + text (r DIV 256 * 10 + (r AND 15)) + ENDPROC calendar ; + +abgefragt werden. + + +#ub#5.2 Zugriff auf die Analog-Ports#ue# + +Die 4 Analog-Ports auf dem Motherboard knnen mit + + control (-2, port, 0, r) + +abgefragt werden. 'port' kann 1..4 sein, in 'r' werden Werte von 1..255 +zurckgemeldet. Dieser Wert ist proportional dem Widerstandswert zwischen ++5V und Analogeingang. + +Fr Hardwarefreaks : + + Port Connectorpin + ------------------ + 1 6 + 2 10 + 3 7 + 4 11 + +5V 1 + +Da der Mewertaufnehmer ein 'LS123 mit C#d#t#e#=68nF, R#d#t#e#=0.27+R#d#x#e# kOhm ist, gilt: +t#d#w#e#=0.45 * R#d#t#e# * C#d#t#e# = (30.6 * R#d#x#e# + 8.262) [us]. t#d#w#e# wird gemessen. (t#d#w#e# = 11 +Zyklen * r + 5 Zyklen bei 1.023 MHz) + ==> 30.6 * R#d#x#e# + 8.262 = (11 * r + 5) / 1.023 [us] +<==> R#d#x#e# = ((11 * r - 5) / 1.023 -8.262) / 30.6 [kOhm] +(Damit ist auch klar, warum der Wert 0 nicht geliefert wird.) + +R#d#x#e# [kOhm] = 0.351 * r + 0.43 +r = 2.846 * R#d#x#e# + 1.221 + + +#ub#5.3 Zugriff auf die I/O-Ports#ue# + +Das Schreiben #ub#und#ue# Lesen der I/O-Ports der CPU ist jetzt nur an privilegier- +ten Kanlen (25..32) mglich. + + control (-1, port, -1, r) + +kann der angegebene Port 'port' (0..255) gelesen werden. Das Resultat (By- +te) steht dann in 'r'. Falls der aufrufende Kanal ungltig war, wird -1 +geliefert. Mit + + control (-1, port, wert, r) + +kann der angegebene Port 'port' (0..255) beschrieben werden. Der Bytewert +steht in 'wert', die Erfolgsmeldung in 'r' (0 = ok). + + +#ub#5.4 ID-Felder#ue# + +Mit 'INT PROC id (INT CONST feld nr)' knnen Systemkonstanten abgefragt +werden. Fr 'feld nr' sind folgende Werte zugeordnet: + +0 Minimale Hintergrundversion (175) +1 Urladertyp (1 = Z80) +2 Urladerversion (101 = Version 1.1) +3 Reserviert +4 Lizenznummer des SHards +5 Installationsnummer +6 Reserviert +7 Versionsnummer des SHards: 1000 * Interfaceversion + SHard Version (ent- + hlt z.Zt. 8105, d.h. Interface 8, Version 1.5) + +#page# +#ub#6. Installation#ue# + +#ub#6.1 Vortest/Speichertest#ue# + +Vortest und Speichertest sollten normalerweise durchgefhrt werden. (Beide +Fragen mit 'j' beantworten). Wird kein Vortest gewnscht, wird automatisch +auch kein Speichertest durchgefhrt und es besteht keine Mglichkeit, das +Hardwaretest-Menue aufzurufen. + + +#ub#6.2 Konsole#ue# + +Die Blinkperiode des Cursor und die Tonhhe des Steuercodes ""7"" kann +verndert werden (Sekunden bzw. Hertz). Defaults sind 0.8s und 500Hz. + + +#ub#6.3 SCSI-Floppy#ue# + +Falls nicht SCSI-Floppy #0 sondern, falls vorhanden, SCSI-Floppy #1 als +Kanal 31 angesprochen werden soll, wird diese Frage mit 'n' beantwortet. + + +#ub#6.4 Harddisk Volume#ue# + +Als Kanal 28 kann ein Harddisk-Volume angesprochen werden. Alle verfgbaren +Volumes werden angeboten und ein ausgewhltes wird im SHard als Kanal 28 +installiert. Achtung: Sollte dieses Volume gelscht, vergrert oder ver- +schoben werden (durch CP/M) dann wei SHard noch nichts davon. Deshalb +sollte der SHard nach einer solchen Aktion noch einmal installiert werden. +Aus Sicherheitsgrnden wird empfohlen, ein spezielles Volume einzurichten, +ber das dann der Datenaustauch CP/M <--> EUMEL luft. + + +#ub#6.5 Logische Kanle zuordnen#ue# + +Als logische Kanle stehen Kanal 0..31 zur Verfgung, als physiche Kanle +0..6 und 28..31. Den logischen Kanlen knnen fast beliebig physische Kan- +le zugeordnet werden. +Ausnahmen: +- Der log. Kanal 0 (Hintergrund) mu als Blockkanal definiert werden (d.h. + die physischen Kanle 0, 28, 29, 30, 31 knnen zugeordnet werden.) +- Der log. Kanal 1 (Systemkanal) mu als Stream-I/O-Kanal definiert werden + (d.h. die physischen Kanle 1, 2, 3, 5 knnen zugeordnet werden.) +- Der log. Kanal 31 (Archiv) sollte definiert werden, dann aber als Block- + kanal (d.h. die physischen Kanle 0, 28, 29, 30, 31) knnen zugeorndet + werden.) +- Nicht jeder physische Kanal mu zugeordnet werden. +- Jeder physische Kanal darf hchstens einmal zugeordnet werden. + +Hinweis: + EUMEL verwaltet Kanal 1..16 als (unprivilegierte) Stream-Kanle, + Kanal 17..24 als unprivilegierte Block-Kanle, + Kanal 25..31 als privillegierte Block-Kanle. + + +#ub#6.6 Installation auf Harddisk#ue# + +Wie frher kann der SHard auf einem Harddisk-Volume installiert werden. +Dazu werden alle vorhandenen EUMEL-Volumes angeboten und das gewnschte +ausgesucht. Falls kein EUMEL-Volume (mehr) vorhanden ist, werden alle ande- +ren Volumes angeboten. Dadurch ist es mglich ein neues EUMEL-Volume einzu- +richten (mit 'dmgr' unter CP/M). Der SHard belegt 2 Tracks (16k) auf der +Harddisk. + + +#ub#6.7 Installation auf Floppy#ue# + +Um ganz auf eine Harddisk verzichten zu knnen oder falls der Harddisk- +SHard zerstrt wurde, kann EUMEL jetzt auch ber eine Boot-Diskette hochge- +fahren werden. Eine Bootdiskette (160k oder 640k) enthlt auf den ersten 4 +Tracks den SHard, kann deshalb nicht mehr als CP/M-Datendiskette verwendet +werden. +Die Floppy kann mit dem Installationsprogramm bootfhig gemacht werden. + diff --git a/system/shard-z80-ruc-64180/1.5/src/65.SUB b/system/shard-z80-ruc-64180/1.5/src/65.SUB new file mode 100644 index 0000000..0588113 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/65.SUB @@ -0,0 +1,2 @@ +M80=DISK/M + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/BOOT.INC b/system/shard-z80-ruc-64180/1.5/src/BOOT.INC new file mode 100644 index 0000000..ac28df8 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/BOOT.INC @@ -0,0 +1,122 @@ + +; +;**************************************************************** +; +; EUMEL Initialisierung fuer 6502 Teil +; +; Version 0.4 vom 25. 11. 1985 +; Version 0.5 vom 24.12.86 +; Version 0.6 vom 14.01.87 +; +;**************************************************************** +; + .6502 + + .radix 16 + +main_ROM equ 0C082 +lc_RAM equ 0C083 +lc_lock equ 0C00F + +RESET EQU $FA62 +BREAK EQU $FA4C +VECTBL EQU $FFFA + +;................................................................ +; +init65: + sei + lda lc_RAM + lda lc_RAM ; LC-RAM write enable + lda lc_lock ; verriegeln + +; + ldx #0 ; pointer initialisieren + stx task + stx INTPAR1 + stx IFLG ; "Weiter" Kanal 5 Receiveinterrupt + stx E_FLG ; Keine Eingabeflusskontrolle + stx A_FLG ; Keine Ausgabeflusskontrolle + stx SerFlg ; Kein Ausgabestop + stx Wait_flg ; 64180 darf auf Pufferdescriptor zugreifen + stx bus_locked ; Inteerupt an 64180 erlaubt, da kein Bus-Lock + stx err1_bits + stx err5_bits ; Keine Uebertragungs-Fehler aufgetreten + stx KeyIn ; Tastaturpuffer leer + stx KeyOut + stx param1+1 + + dex ; X := FF + stx param2 + stx param2+1 + stx last_track + + lda #0 ; Physische Addresse der Sektoren + tax ; bestimmen (ueber Interleave) +interlv_1: + sta ilv_tble,x + inx + clc + adc #3 ; interleave + and #0F ; MOD 16 + cpx #10 + bne interlv_1 + + ldx #80 + stx param1 + jsr GCTRL ; Grafik initialisieren + + jsr init_pbuf + + ldx #initab_len +rloop: lda rbuf_ini,x + sta rbuf,x + dex + bpl rloop + + ldx #initab_len +tloop: lda tbuf_ini,x + sta tbuf,x + dex + bpl tloop + + ldx #6 +vecloop: + lda vector,x + sta vectbl,x ; Vektoren ins RAM kopieren + dex + bne vecloop + + sta KeyStr ; Tastatur ruecksetzen + sta 0C009 ; auf Interrupt schalten + +; serielle Schnittstelle initialisieren +; + lda #1E ; 9600 Bd, 8 Bits/Char., 1 Stopbit + sta SER_CTR + lda #09 ; no parity, rx/tx irq's enabled + sta SER_COM + + ldx SLT180 + stx SLOT180 + cli ; Interrupt enable + + jmp task_loop ; Jump in die Task_Loop_Routine + +vector: + dw resvec ; NMI + dw resvec ; RESET + dw irqvec ; IRQ & BRK + +tbuf_ini: + DW (SBUFEND - SBUFBEG) * 100H, 0 + DW SBUFBEG * 100H, SBUFBEG * 100H + DB SBUFBEG, SBUFEND + +rbuf_ini: + DW (RBUFEND - RBUFBEG) * 100H, 0 + DW RBUFBEG * 100H, RBUFBEG * 100H + DB RBUFBEG, RBUFEND + + ds $100-(*-start) + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/CONOUT.MAC b/system/shard-z80-ruc-64180/1.5/src/CONOUT.MAC new file mode 100644 index 0000000..adf815a --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/CONOUT.MAC @@ -0,0 +1,124 @@ + TITLE Basis 108 Console Ausgabe +; + INCLUDE HD64180.LIB +; + .LIST +; +;**************************************************************** +; +; C O N O U T +; +; Direkte BASIS 80 Zeichen Ausgabe +; +; Version 1.0 - 16. 9. 1985 +; Version 1.1 - 28. 10. 1985 (Invers korrigiert) +; Version 1.2 - 30.12.86 (Zeichensatzeinstellung, Stringausgabe) +; +; Teil des EUMEL SHARD fuer RUC 64180 +; +;**************************************************************** +; +; Globale Adressen +; + GLOBAL CRTOUT, SWICUR, STROUT +; +;................................................................ +; +; Externe Variable +; + EXTERNAL TO6502, ZGERL, BEEPFRQ +; +;---------------------------------------------------------------- +; +; Konstanten fuer MMU +; +BIOSBANK EQU 0F2H ;CBAR fuer 6502 Zugriff +AR6502 EQU 5EH ;BBR-Wert fuer 6502 Zugriff +BASE EQU 2000H ;6502 Adressoffset +; +; 6502 Softswitches +; +STRAM1 EQU BASE+0C00CH ;Umschalten auf Videobank 0 +STRAM2 EQU STRAM1+1 ;Umschalten auf Videobank 1 + +SWINV EQU BASE+0C000H ; > 127: Invers +SWFLSH EQU SWINV+1 ; > 127: Flash +SW2OFF EQU SWFLSH+1 ; Zeichensatzswitch 2 +SW2ON EQU SW2OFF+1 +SW1OFF EQU SW2ON+1 +SW1ON EQU SW1OFF+1 +SW0OFF EQU SW1ON+1 +SW0ON EQU SW0OFF+1 +; +; andere 6502 Adressen +; +SCREEN EQU BASE+400H ;Anfang Video RAM +; +;---------------------------------------------------------------- +; + DSEG +; +; lokale Daten +; +GOTOCNT: DEFB 0 +GOTOX: DEFB 0 ;Reihenfolge GOTOX, GOTOY festgelegt !! +GOTOY: DEFB 0 +SCRADR: DEFW SCREEN +SCRXY: DEFW 0 +INVMOD: DEFB 80H +CURCHR: DEFB 0 +CURINV: DEFB 80H +; +OLDCBAR: DEFB 0 ;Zwischenspeicher fuer CBAR +OLDBBR: DEFB 0 ;Zwischenspeicher fuer BBR +STKSAV: DEFW 0 ;Stackpointer Zwischenspeicher + DEFS 20 +STACK: +; +;---------------------------------------------------------------- +; + CSEG +; + +;---------------------------------------------------------------- +; +; S T R O U T +; Zeichenkette auf Masterconsole-Bildschirm ausgeben +; +; Eingang: HL = Startadresse der Zeichenkette +; BC = Laenge der Zeichenkette +; Ausgang: HL und Akku veraendert +; +STROUT: + PUSH BC + PUSH DE + PUSH IX + + PUSH HL ; Stringadresse --> IX + POP IX + +OUTLOOP: + LD A,B + OR C + JR Z,POPRET + + PUSH BC + LD C,(IX+0) + CALL CRTOUT + POP BC + INC IX + DEC BC + JR OUTLOOP + +POPRET: + POP IX + POP DE + POP BC + RET + +;----------------------------------------------------------------- + + INCLUDE CONOUT4.INC +; + END + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/CONOUT4.INC b/system/shard-z80-ruc-64180/1.5/src/CONOUT4.INC new file mode 100644 index 0000000..89120f8 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/CONOUT4.INC @@ -0,0 +1,467 @@ + +; +; CONOUT4.INC +; +; Character auf BASIS 108 80-Zeichen ausgeben +; +; Copyright (c) 1985 by Joerg Stattaus +; +; Modified for psi by R. Ellerbrake +; +; C=char +; +; Version 17.09.85 +; Stand: 22.12.86, mit Zeichensatzeinstellung (M.St) +; 31.12.86, Mod. fuer 6502-Teil > 0C00 +; + +crtout: + ld hl,gotocnt ; GotoXY in Aktion ? + ld a,(hl) + or a + jr z,crt2 + + dec (hl) + ld a,c + jr z,crt1 ; Get X-Value + + ld (gotoy),a ; Y storen + ret + +crt1: ld (gotox),a + + ld b,7 ; Gotoxy is Function 7 + jr conq + +crt2: + ld b,a + ld a,c + +crt3: cp ' ' + jr nc,conq ; normales Zeichen + +crt4: ld hl,scrfen ; In Tabelle nach Zeichen suchen + ld b,22 +crt5: cp (hl) + jr z,crtfnd ; Sequenz erkannt + + dec hl + djnz crt5 + + ret ; nicht in der Tabelle enthalten + +crtfnd: ld a,b ; Found + cp 7 + jr nz,conq +; + ld a,2 + ld (gotocnt),a ; next 2 Bytes sind Koordinaten + RET + +SWICUR: + LD B,23 ; Cursor invertieren +conq: + LD A,I ; IEF2 retten + PUSH AF + DI ; keine Interrupts zulassen +; + in0 a,(cbar) ; Set CommonBaseAreaRegister for Video + ld (oldcbar),a + ld a,biosbank + out0 (cbar),a +; + IN0 A,(BBR) ; Set Bank Base Register + LD (OLDBBR),A + LD A,AR6502 + OUT0 (BBR),A +; + LD (STKSAV),SP ; alten SP retten (im umgeschalteten Bereich) + LD SP,STACK +; + CALL CONQ1 ; Print Char. on screen +; + LD SP,(STKSAV) ; alten Stack zurueckholen +; + LD A,(OLDBBR) ; restore old BBR + OUT0 (BBR),A + ld a,(oldcbar) ; and CBAR + out0 (cbar),a + POP AF ; IEF2 zurueckholen + RET PO ; vorher kein EI -> +; + EI ;reenable Interrupts + RET + +; B=Sequenz / C=Char + +conq1: ld hl,(scradr) + ld de,(scrxy) + ld a,e + rra + + CALL ZGERL ; Zugriff erlaubt ? + ld (stram1),a ; Dyn./Static RAM + jr nc,conq2 + ld (stram2),a +conq2: + ld a,b + or a + jr nz,scrfkt ; Screen-Function + + ld a,(invmod) ; schreibe Zeichen auf Bildschirm + or c + ld (hl),a +adv0: ex de,hl + inc hl + ld a,l + cp 80 + jp c,onlinc + + ld l,0 + inc h + ld a,h + cp 24 + jp c,calc + + ; scroll noetig + + ld l,0 +scroll: dec h + push hl + ld d,0 + call del0 ; delete Zeile 0 + + pop hl +calc: ld (scrxy),hl + ld e,l + ld a,h + call basclc + ld a,e ; hl=lineadr / a=scrxyr + srl a + + ld (stram1),a + jr nc,calc3 + ld (stram2),a +calc3: + add a,l + ld l,a +calc4: ld (scradr),hl +calc5: ld a,(hl) ; get char on cursor adr + ld (curchr),a + ld a,(curinv) + xor (hl) + ld (hl),a ; invers zurueck + ld (stram1),a + +crtret: ret + +onlinc: ld (scrxy),a ; normales increment des scr.poi. + ex de,hl ; HL wieder = scradr + rra + + ld (stram2),a + jr c,calc5 ; selbe Adresse, 2. Seite + ld (stram1),a + inc hl + jr calc4 + +scrfkt: ld a,(curchr) ; Restore Char on Screen + ld (hl),a + ld a,b + ld hl,scrtab-2 + add a,a + add a,l + ld l,a + LD A,H ; cross page boundary ? + ADC A,0 + LD H,A + ld a,(hl) + inc hl + ld h,(hl) + ld l,a + jp (hl) + +; Screen-Functions + +advanc: ld hl,(scradr) + jr adv0 + +schome: ld hl,0 + jr tocalc + +gotoxy: ld hl,(gotox) ; H=Y / L=X +got0: ld a,h + cp 24 + jr c,got1 + + ld h,0 +got1: ld a,l + cp 80 + jr c,tocalc + +got2: ld l,0 + jr tocalc + +up: ex de,hl + dec h + jr got0 + +carret: ex de,hl + jr got2 + +backsp: ex de,hl + dec hl + ld a,l + cp 80 + jr c,tocalc + + ld l,79 + jr got0 + +linefd: ex de,hl + inc h + ld a,h + cp 24 + jr c,tocalc + + jp scroll + +erapag: push de + call erap0 + pop hl +tocalc: jp calc + +eralin: push de + call eral2 + pop hl + jr tocalc + +insert: push de + ld a,d ; korrigiert + ld de,SCREEN+003d0h ; Zeile 23 + cp 23 + jr z,ins1 ; kein Verschieben + + ld b,23 +ins0: dec b + call linmov + ld a,(scrxy+1) ; Vertikal Adresse + cp b + jr nz,ins0 + +ins1: call blank + pop hl + jr got2 + +delete: push de + call del0 + pop hl + jr got2 + +normal: ld a,80h + jr inv1 + +invers: xor a +inv1: ld (invmod),a +; +inv2: ex de,hl + jr tocalc + +chacur: ld hl,curinv + ld a,(hl) + xor 80h + ld (hl),a + jr inv2 + +clear: call schome + ld de,0 + push de + call erap0 + pop hl + jr tocalc + +bell: push hl + ld a,(BEEPFRQ) + ld h,a + ld l,2 ; task beep + call to6502 + pop hl ; transport scrxy to HL + ret + +eral2: ld hl,(scradr) + push hl + ld (stram1),a + ld a,e + srl a + jr nc,eral3 + + inc a + inc hl +eral3: call erablk + + ld (stram2),a + pop hl + ld a,e + srl a +erablk: sub 41 + cpl + ld b,0a0h +erabl1: or a + ret z + ld (hl),b + inc hl + dec a + jr erabl1 + +erap0: call eral2 + ld a,(scrxy+1) +erap1: inc a + cp 24 + ret nc + + push af + call basclc + + ex de,hl + call blank + pop af + jr erap1 + +del0: ld a,d + cp 23 + ld de,SCREEN+003d0h ; Zeile 23 + jr z,blank + + push af + call basclc + pop bc ; Vert. Adr. von D -> A -> B + + ex de,hl +del1: inc b + call linmov + ld a,b + cp 23 + jr c,del1 + +blank: ld (stram1),a + ld a,' '+80h + push de + call blank1 + pop de + ld (stram2),a + +blank1: ld b,40 +blank2: ld (de),a + inc de + djnz blank2 + + ret + +linmov: push bc + ld a,b + call basclc + ld (stram1),a + push hl + push de + ld bc,40 + ldir ; eine Zeile + pop de + pop hl + push hl + ld (stram2),a + ld bc,40 + ldir + pop de ; HL nun in DE = neues Ziel + pop bc + ret + +basclc: ld c,a + ld l,0 + rra + rr l + and 3 + add a,HIGH SCREEN ; screen - start + ld h,a + ld a,c + and 18h + ld c,a + add a,a + add a,a + add a,c ; * 5 = 40 + add a,l + ld l,a + ret ; HL = Line adress + +ger: ; German ASCII + ld (sw0off),a + ld (sw1on),a + ld (sw2off),a + ret + +usa: ; ASCII + ld (sw0off),a + ld (sw1off),a + ld (sw2on),a + ret + +apl: ; APL + ld (sw0off),a + ld (sw1on),a + ld (sw2on),a + ret + +uni: ; ASCII und Inv. APL + ld (sw0on),a + ld (sw1on),a + ld (sw2on),a + ret + +invsw: + ld (swinv),a + ret + +flshsw: + ld (swflsh),a + ret + +; Screen-Command-Definition-Table + +;leadsf:db 1bh +; db 0aah,0d9h,0d4h,0a9h,0a8h,1eh,0bdh,0bh,0ch +; db 0ah,08h,0dh,0cch,0cdh,0dah,07h +; +; EUMEL psi-Terminal Definition +; + DEFB 9 ;Clear Screen (bei psi undefiniert) + DEFB 4 ;Clear to End of Page + DEFB 5 ;Erase to End-of-Line + DEFB 14 ;Endmark (Normal Video) + DEFB 15 ;Beginmark (Invers Video) + DEFB 1 ;Home + DEFB 6 ;Cursor Positionierung + DEFB 3 ;Cursor 1 Zeile nach oben + DEFB 2 ;Cursor nach rechts + DEFB 10 ;Line feed + DEFB 8 ;Backspace + DEFB 13 ;Carriage Return + DEFB 11 ;Insert Line (bei psi undefiniert) + DEFB 12 ;Delete Line (bei psi undefiniert) + DEFB 0 ;NULL (nichts tun) + DEFB 7 ;BELL + DEFB 16 ;GER, Zeichensatz + DEFB 17 ;USA, " + DEFB 18 ;APL, " + DEFB 19 ;UNI, " + DEFB 20 ;Invers > 127 + DEFB 21 ;Flash > 127 + +scrfen equ $-1 + +scrtab: dw clear,erapag,eralin,normal,invers,schome,gotoxy,up,advanc + dw linefd,backsp,carret,insert,delete,CRTRET,bell + dw ger,usa,apl,uni,invsw,flshsw,chacur +; +; CRTRET anstelle von chacur + +; Ende von CONOUT3.INC + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/CREF.COM b/system/shard-z80-ruc-64180/1.5/src/CREF.COM new file mode 100644 index 0000000..e449ce9 Binary files /dev/null and b/system/shard-z80-ruc-64180/1.5/src/CREF.COM differ diff --git a/system/shard-z80-ruc-64180/1.5/src/DB.COM b/system/shard-z80-ruc-64180/1.5/src/DB.COM new file mode 100644 index 0000000..63b3afb Binary files /dev/null and b/system/shard-z80-ruc-64180/1.5/src/DB.COM differ diff --git a/system/shard-z80-ruc-64180/1.5/src/DISK.MAC b/system/shard-z80-ruc-64180/1.5/src/DISK.MAC new file mode 100644 index 0000000..56bf2f3 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/DISK.MAC @@ -0,0 +1,1658 @@ +; + TITLE EUMEL fuer RUC 64180, 6502 Teil & Diskroutinen +; +;**************************************************************** +; +; EUMEL 1.8.0 with RUC180-Card on BASIS 108 +; +; 6502 DISK-Driver und Motherboard I/O +; +; Stand (1.8) : 14.01.87, mit neuem Puffer-Handling +; : 27.05.87, mit Hardcopy auf SHIFT CTRL F12 +; : 26.06.87, Druckerspooler loeschen mit Task 8 +; Version 23.09.85 ./. 22.11.85 +; +;**************************************************************** +; + .6502 + .radix 16 +; +;---------------------------------------------------------------- +; +; Globale Variable +; + GLOBAL DES6502, PRG6502, LEN65, ST6502 +; +;---------------------------------------------------------------- +; +; Konstanten +; +XOFF EQU 13 ; CTRL-S +XON EQU 11 ; CTRL-Q +; +; Adressen +; +KeyBoard equ 0C000 +Keyext equ 0C008 +KeyStr equ 0C010 + +VIDBNK equ 0C00C + +prackn equ 0C1C1 +prport equ 0C090 + +speaker equ 0C030 + +serial_stat equ 0C099 +SER_DAT EQU 0C098H ;Serial Interface Data +SER_COM EQU 0C09AH ;Serial Command Register +SER_CTR EQU 0C09BH ;Serial Control Register + +analog_1 EQU $C063 +analogreset EQU $C070 + +; Floppy Hardware + +phase0 equ 0C080 +phase1 equ 0C082 +phase2 equ 0C084 +phase3 equ 0C086 +mtroff equ 0C088 +mtron equ 0C089 +drive0 equ 0C08A +Q6off equ 0C08C +Q6on equ 0C08D +Rstate equ 0C08E +Wstate equ 0C08F +; + INCLUDE ZPAGE.INC ;Zero Page Adressen +; +; sonstiges +; +bit_z equ 24 + +fast_step equ $0E ; etwas weniger als 3 ms Track-Wechselzeit + +pagerr macro adr + if high(*-start) ne high(adr-start) + .printx 'Page-Error' + endif + endm + + cseg +PRG6502: + .phase 0C00 +DES6502: ; 6502-Startadresse zum kopieren + +start: ; Label fuer Pageboundcheck +nible1: ; Anfang des Nibble-Buffers + defm '6502-Teil' + +ST6502: ; Startadresse 6502-Teil Initialisierung + include BOOT.INC + + include NIBLE.INC + +write_data + SEC + LDA Q6on,X + LDA Rstate,X + BMI wrdat99 + LDA nible2 + STA temp2 + LDA #0FF + STA Wstate,X ; 5 + ORA Q6off,X ; 4 + PHA ; 3 + PLA ; 4 [sta..sta[ + NOP ; 2 + LDY #04 ; 2 +wrdat1 PHA ; 3 3 + PLA ; 4 4 + JSR wrt_nibl1 ;+13 15 13 + DEY ;--- 2 + BNE wrdat1 ; 40 + 3 + ; --- --- + ; 20+ 20 = 40 + + pagerr wrdat1 + + ; -1 + LDA #0D5 ; 2 + JSR wrt_nibl ; 15 +15 + LDA #0AA ; 2 --- + JSR wrt_nibl ;+15 36 + LDA #0AD ;--- + JSR wrt_nibl ; 32 15 + TYA ; 2 + LDY #56 ; 2 +wrdat11 BNE wrdat3 ; 3 +wrdat2 LDA nible2,Y ; 0 4 +wrdat3 EOR nible2-1,Y ; 5 5 + TAX ; 2 2 + LDA to_nibble,X ; 4 4 + LDX slot10z ; 3 3 + ; --- --- + ; 36 18 + + STA Q6on,X ; 5 + LDA Q6off,X ; 4 + DEY ; 2 + BNE wrdat2 ; 3 + ; --- + ; 14 + 18 = 32 + ; -1 + LDA temp2 ; 3 + NOP ; 2 +wrdat4 EOR nible1,Y ; 4 4 + TAX ; 2 2 + LDA to_nibble,X ; 4 4 + LDX slot10 ; 4 4 + ; --- --- + ; 32 14 + + STA Q6on,X ; 5 + LDA Q6off,X ; 4 + LDA nible1,Y ; 4 + INY ; 2 + BNE wrdat4 ; 3 + ; --- + ; 18+ 14 = 32 + + pagerr wrdat11 + + TAX ; 2 + LDA to_nibble,X ; 4 + LDX slot10z ; 3 + JSR wrt_nibl2 ; 6 15 + LDA #0DE ; --- 2 + JSR wrt_nibl ; 32 15 + LDA #0AA ; --- + JSR wrt_nibl ; 32 + LDA #0EB + JSR wrt_nibl + LDA #0FF + JSR wrt_nibl + LDA Rstate,X +wrdat99 + LDA Q6off,X +wrdat999 + dey + bne wrdat999 ; PostErase-Delay 1 ms + + RTS + +read_hdr + sei + LDY #0FC + STY temp2 +rdhdr0 + INY + BNE rdhdr1 + INC temp2 + BEQ fail +rdhdr1 + LDA Q6off,X + BPL rdhdr1 +rdhdr11 CMP #0D5 + BNE rdhdr0 + + NOP +rdhdr2 LDA Q6off,X + BPL rdhdr2 + CMP #0AA + BNE rdhdr11 + + LDY #03 +rdhdr3 LDA Q6off,X + BPL rdhdr3 + CMP #96 + BNE rdhdr11 + + pagerr rdhdr1 + + + LDA #00 +nxthByte STA chk_sum +rdhdr4 LDA Q6off,X + BPL rdhdr4 + ROL A + STA temp2 +rdhdr5 LDA Q6off,X + BPL rdhdr5 + AND temp2 + STA chk_in_hdr,Y + EOR chk_sum + DEY + BPL nxthbyte + + TAY + BNE fail + +rdhdr6 LDA Q6off,X + bpl rdhdr6 + cmp #0DE + BNE fail + + NOP +rdhdr7 LDA Q6off,X + BPL rdhdr7 + CMP #0AA + BNE fail + + CLC + RTS +fail + SEC + RTS + +moving + LDY #0 +mov0 LDA Q6off,X + JSR mov1 + PHA ; 3 + PLA ; 4 + CMP Q6off,X ; 4 + BNE mov1 ;---- + DEY ; 21 uS + BNE mov0 +mov1 RTS + + +read_data + TXA + ORA #8C + STA ld1+1 + STA ld2+1 + STA ld3+1 + STA ld4+1 + STA ld5+1 + LDA user_data + LDY user_data+1 + STA st5+1 + STY st5+2 + SEC + SBC #54 + BCS rddat1 + DEY + SEC +rddat1 + STA st3+1 + STY st3+2 + SBC #57 + BCS rddat2 + DEY +rddat2 + STA st2+1 + STY st2+2 + + LDY #20 +nxt_begin + DEY + BEQ fail +wait_begin +waitb0 LDA Q6off,X + BPL waitb0 +waitb00 EOR #0D5 + BNE nxt_begin + NOP +waitb1 LDA Q6off,X + BPL waitb1 + CMP #0AA + BNE waitb00 + NOP +waitb2 LDA Q6off,X + BPL waitb2 + CMP #0AD + BNE waitb00 + + LDY #0AA + LDA #0 +rloop1 STA temp2 +ld1 LDX Q6off+60 ; addr modified by read init ! + BPL ld1 + LDA to_bits-96,X + STA nible2-0AA,Y + EOR temp2 + INY + BNE rloop1 + +; +; read nible from disk and convert to user data +; + LDY #0AA + BNE ld2 +rloop2 +st2 STA 1000,Y +ld2 LDX Q6off+60 ; modified by read init + BPL ld2 + EOR to_bits-96,X + LDX nible2-0AA,Y + EOR to_bytes+0,X + INY + BNE rloop2 + + PHA + AND #0FC + LDY #0AA +ld3 LDX Q6off+60 ; modified by read init + BPL ld3 + EOR to_bits-96,X + LDX nible2-0AA,Y + EOR to_bytes+1,X +st3 STA 1000,Y + INY + BNE ld3 + +ld4 LDX Q6off+60 ; modified by read init + BPL ld4 + AND #0FC + LDY #0AC +rloop5 EOR to_bits-96,X + LDX nible2-0AC,Y + EOR to_bytes+2,X +st5 STA 1000,Y +ld5 LDX Q6off+60 ; modified by read init + BPL ld5 + INY + BNE rloop5 + AND #0FC + EOR to_bits-96,X + LDX slot10z + TAY + BNE chk_fail +rloop6 LDA Q6off,X + BPL rloop6 + CMP #0DE + BEQ read_ok + + pagerr wait_begin +chk_fail + SEC + db bit_z +read_ok + clc + PLA + LDY #55 + STA (user_data),Y + RTS + +seekT lda iob_trk +seekL + jsr trk_to_ph + cmp phase0,X + cmp phase1,X + cmp phase2,X + cmp phase3,X + LDY disk_no + LDA head_table,y ; da steht der Kopf jetzt + STA head_pos + lda dest_phase + sta head_table,y ; da soll er nachher stehen + +seekH + cmp head_pos + BEQ seek_rts + LDA #0 + STA temp2 +seekh0 LDA head_pos + STA phase + SEC + SBC dest_phase + BEQ seekh5 + BCS seekh1 + EOR #0FF + INC head_pos + BCC seekh2 +seekh1 ADC #0FE + DEC head_pos +seekh2 CMP temp2 + BCC seekh3 + LDA temp2 +seekh3 CMP #8 + BCS seekh4 + TAY +seekh4 SEC + JSR step + LDA time0,Y + JSR step_wait + LDA phase + CLC + JSR step1 + LDA time1,Y + JSR step_wait + INC temp2 + BNE seekh0 + +seekh5 JSR step_wait + CLC +step LDA head_pos +step1 AND #3 + ROL A + ORA slot10z + TAX + LDA phase0,X + LDX slot10z +seek_rts RTS + +;-------------------------------; + +make_nibl + LDY #56 + LDA #0 +maken0 STA nible2-1,Y + DEY + BNE maken0 +maken1 LDX #55 +maken2 LDA (user_data),Y + AND #0FC + STA nible1,Y + EOR (user_data),Y + INY + CMP #02 + ORA nible2,X + ROR A + ROR A + STA nible2,X + DEX + BPL maken2 + CPY #02 + BNE maken1 + RTS + +; ds 10 + +Dsk_RW + ldx #0A9 ; LDA #xx + lda def_byte + and #$20 ; Bit 5 ? + bne rw_0 ; Fast Step - use abs. value + + ; Slow Step - use MotorOn/Off-Tables + ldx #0C9 ; CMP #xx +rw_0: stx step_wait + + lda #fast_step ; Set Step Rate + bit def_byte + bmi rw_1 ; Bit7: Controller-Typ + ; Bit7=0 => Ehring + lsr a ; bei Ehring 2-fache Phases => halbe Steprate + +rw_1: sta step_wait+1 ; Steprate + + lda disk_no + LSR A + TAY + LDA slotn,Y + STA slot10 + sta slot10z + adc #0 + STA iob_drv + + include TRACK.INC + +trk_to_ph: ; IN: A = track / OUT: A,dest_phase = phase + sta dest_phase + +; Select Side 0 + + bit def_byte ; Bit7: 1=Erphi-Controller + ; Bit6: 1=Erphi-Format + + bvc ehring_format ; Bit6 = 0 => Ehring-Format + + lsr dest_phase ; Erphi-Format + bcc side0 + +; Select Side 1 +; Erphi: mtroff, Q6on, mtron +; Ehring: mtroff,mtron + +side1: lda mtroff,x + bit def_byte + bpl side1_2 + ; Erphi-Side-1-Select + lda Q6on,x +side1_2: + lda mtron,x + jmp ph_mult + +ehring_format: + cmp #$50 ; Track >= 80 ? + bcc side0 ; nein: Select Side 0 + + sbc #$50 + sta dest_phase + jmp side1 + +; Select Side 0 +; Ehring: lda cn00,x +; Erphi : mtroff, Q6off, mtron + +side0: bit def_byte + bmi erphi_s0 ; Bit7 = 1 => Erphi-Controller + + txa ; Ehring-Side-0-Select + lsr a + lsr a + lsr a + lsr a + ora #$C0 + sta ehr_sel+2 + +ehr_sel:lda $C600 + jmp ph_mult + +erphi_s0: ; Erphi-Side-0-Select + cmp mtroff,x + cmp Q6off,x + cmp mtron,x + +ph_mult: + lda def_byte ; Bit 0..1: 0 = 1 Step/Track + and #03 ; 1 = 2 Steps/Track + tay ; 2 = 4 Steps/Track + beq ph_mult2 + +ph_mult1: + asl dest_phase + dey + bne ph_mult1 + +ph_mult2: + lda dest_phase + rts + +;--------------------------------------------------------------------------- +; +; D I S K R W +; Eingang: iob_trk, sektor, def_byte, disk_no, param, last_track +; dma, ilv_tbl, +; Ausgang: iob_err +; Daten: x000..xFFF (Ein Track, Sektoren in log. Reihenfolge) +; 64180 darf nicht auf den Applebus, Aufruf mit JSR +; +;--------------------------------------------------------------------------- + +DISKRW: + jsr lock_bus + + lda iob_trk ; Track fuer Read/Write + bit param ; 0 = Write, FF = Read + bpl writecmd + cmp last_track ; Muss auf neuen Track positioniert + bne readtrack ; werden ? + + ldy sektor + ldx ilv_tble,y + lda sec_tble,x + beq readtrack ; Sektor nicht ok + ldx ilv_tble+1,y + lda sec_tble,x + beq readtrack + + lda #00 ; Nein, somit auch kein Lesefehler + sta iob_err + jmp unlock_bus + +readtrack: + sei + lda #10 ; Track muss ganz neu gelesen werden + sta sec_cnt ; das sind 16 Sektoren a 256 Byte + lda #00 ; Kennzeichen fuer Einlesen + ldx #0F +sec_1_loop: sta sec_tble,x ; Sektortabelle = Kennzeichen setzen + dex + bpl sec_1_loop + bmi readwrite + +writecmd: + sei + ldx #02 ; Bei Write nur 512 Byte schreiben + stx sec_cnt + ldx #0F + lda #$FF ; Kennzeichen fuer 'nicht Einlesen' +sec_2_loop: sta sec_tble,x + dex + bpl sec_2_loop + + ldy sektor ; gewuenschter 1. Sektor + ldx ilv_tble,y ; logisch --> physisch umrechnen + lda #00 ; Kennzeichen 'Sektor schreiben' + sta sec_tble,x + ldx ilv_tble+1,y ; 2. Sektor logisch --> physisch + sta sec_tble,x ; Auch schreiben + + lda last_track + cmp iob_trk ; Anderer Track als der letzte ? + beq readwrite + jsr readwrite ; Ja + lda #$FF ; Muss bei Read neu eingelesen werden, + ; da die anderen 14 Sektoren zum + ; letzen Track gehoeren + sta last_track + rts + +readwrite: + + lda #00 + tay + tax +interlv_2: + ora #dma_4k ; Cachebereich (4k) fuer Track + sty dma,x + inx + sta dma,x + inx + clc + adc #0B ; Interleave 3 + and #0F ; MOD 16 + cpx #20 ; 16 Sektoren + bne interlv_2 + + lda #0F ; Step Rate + sta iob_err + jsr dsk_rw ; Disk Operation + lda iob_err ; Fehlerkennzeichen + beq no_err + + ldy sektor + ldx ilv_tble,y + lda sec_tble,x + beq is_err ; Fehler im 1. Teil des Blocks ? + ldx ilv_tble+1,y + lda sec_tble,x + beq is_err ; Fehler im 2. Teil des Blocks ? + ; nein, + lda #0 + sta iob_err ; Zumindest dieser Block ok + beq no_err ; Always + +is_err: + lda #$FF ; Track muss neu gelesen werden + db bit_a ; Skip 2 Bytes +no_err: lda iob_trk ; last_track := track + sta last_track + jmp unlock_bus + +;---------------------------------------------------------------------------- +; +; A N A L 6 5 +; Eingang: param = 1..4 (Analogschalternummer) +; Ausgang: analogwert = 0..255 +; +;--------------------------------------------------------------------------- + +ANAL65: + sei + jsr lock_bus + ldx param ; Nummer des Analogports + lda analogreset ; Timer starten + ldy #00 + nop + nop +readanalog: + lda analog_1,x ; Analogwert lesen + bpl anaready + iny + bne readanalog ; Bis Bit 7 auf 0 + pagerr readanalog + dey ; Maximum 255 + +anaready: sty analogwert + cli + jmp unlock_bus + +; + INCLUDE GRAFIK65.MAC +; +irqvec: + sta Asave ; Akku retten + pla + pha + and #10 ; BRK -Bit ? + bne brkirq + lda Asave + jmp irq ; Interrupt ausfuehren + +brkirq: + lda main_ROM + lda Asave + jmp BREAK ; Alte BREAK-Routine + +resvec: + lda main_ROM ; ROM einschalten + jmp RESET ; Alte RESET-Routine + +;**************************************************************** +; +; B E L L +; +; => Akustisches Signal + +beep sei + jsr lock_bus + lda #$32 ; Laenge + ; Frequenz = 5000/X Hz + +beep1 ldx param ; 3 +beep2 ldy #$12 ; 2 +beep3 dey ; 2 + bne beep3 ; + 3 + ; ---- + ; 89 = 5 * 18 - 1 + nop ; 2 + nop ; 2 + nop ; 2 + dex ; 2 + bne beep2 ; 3 + ; ---- + ; 102 * X * 0.9775 us + ; = 99.7ms (f ~ 10kHz/X) + ; -1 (Branch) + bit speaker ; 4 + sec ; 2 + sbc #1 ; 2 + bne beep1 ; 3 + ; ----- + ; (14 + 102 * X) * A States Dauer + ; 0.9775 * (14 + 102 * X) * A us + cli + jmp unlock_bus + +;******************************************************************* +; +; Zugriffskontrolle fuer 64180 auf 6502-Bus +; +lock_bus: + lda #$FF + sta bus_locked + ldx SLOT180 + lda wait180,x + rts + +unlock_bus: + lda #$00 + sta bus_locked + ldx SLOT180 + lda start180,x + rts + +;******************************************************************* +; +; Input-Buffer Handler +; +; Der Buffer darf nicht voll sein! +; Interrupts bei Receive-Buffer disabled +; Eingang: A = Zeichen +; X = Bufferdescriptor Offset +; Ausgang: X intakt +; A veraendert +; SEC, wenn Puffer voll war +putbuf: + sei +putbuf0: + pha + lda free,x ; Test, ob Puffer voll + ora free+1,x + beq putbuf4 + pla + + sta (in,x) ; Zeichen in Puffer schreiben + + inc in,x ; Schreibzeiger erhoehen + bne putbuf1 + inc in+1,x + + lda in+1,x ; Puffer-Ende ? + cmp end,x + bcc putbuf1 + lda beg,x ; Ringpuffer, wieder auf Pufferanfang setzen + sta in+1,x + +putbuf1: + dec wait_flg ; Warten, bis update vorbei + inc full,x ; Belegten Platz vergroessern + bne putbuf2 + inc full+1,x + +putbuf2: ; Dieser Wert wird auch von FROUT benutzt! + lda free,x ; Freiplatz verringern + bne putbuf3 + dec free+1,x +putbuf3: + dec free,x + inc wait_flg ; Update gelaufen + clc ; Zeichen uebernommen + rts + +putbuf4: + pla + sec + rts ; Puffer war voll + +;******************************************************************* +; +; Output-Buffer Handler +; +; Interrupts bei Transmit-Buffer disabled +; Der Buffer darf nicht leer sein! +; Eingang: X = Bufferdescriptor Offset +; Ausgang: X intakt +; A = Zeichen +; SEC, wenn Puffer leer war +getbuf: + sei +getbuf0: + sec + lda full,x + ora full+1,x + beq getbuf4 ; Test, ob Puffer leer ist + + lda (out,x) ; Zeichen aus Puffer lesen + pha + + inc out,x + bne getbuf1 + inc out+1,x ; Lesezeiger erhoehen + + lda out+1,x + cmp end,x + bne getbuf1 + lda beg,x + sta out+1,x ; Ringpuffer, Zeiger wieder auf Pufferanfang + +getbuf1: + dec wait_flg ; Warten, bis Update vorbei + inc free,x + bne getbuf2 + inc free+1,x ; Freien Platz vergroessern +getbuf2: + + lda full,x + bne getbuf3 + dec full+1,x +getbuf3: + dec full,x ; Belegten Platz verringern + inc wait_flg ; Update vorbei + + pla + clc + +getbuf4: ; A enthaelt 00, wenn Puffer leer war + rts + +;**************************************************************** +; +; => Drucker-Spooler +; +;------------------------------------------------------------------ +; +; Zeichen aus Druckerspooler an Drucker senden +; +spochc: + lda prackn + bmi chcend ; Printer ready ? + + ldx #pbuf ; Printer Buffer + jsr getbuf0 ; Ohne SEI + bcs chcend ; Nichts auszugeben, fertig + + sta prport ; Zeichen ausgeben + jmp spochc ; Bis nichts mehr moeglich ist + +chcend: + rts + +;-------------------------------------------------------------------- +; +; Zeichen in Druckerpuffer schreiben + +bufin: + ldx #pbuf ; Zeichen geht verloren, wenn Puffer voll + jmp putbuf0 ; Zeichen in Puffer schreiben + + +;**************************************************************** +; +; => Ausgabe Spooler fuer serielle Schnittstelle +; +;----------------------------------------------------------------- +; +; Zeichen aus dem Transmitbuffer senden +; +;spsero: +; LDA serial_stat +; AND #10 ; Transmit Data Register empty ? +; BEQ schend ; serielles Interface nicht bereit + +spserok: ; Einsprung fuer Transmitinterrupt + + LDA SerFlg ; Ausgabe Stop ? + BMI dis_tx ; Ja -> nichts ausgeben + + ldx #tbuf ; Transmitbuffer + jsr getbuf ; Zeichen aus Puffer lesen + bcs dis_tx ; Transmitter disabled, wenn Puffer leer + + sta SER_DAT ; Zeichen ausgeben +schend: + rts + +dis_tx: + lda ser_com + and #$F3 + ora #$08 ; Transmit Interrupt aus + sta ser_com + rts + +;--------------------------------------------------------------------- +; +; Zeichen in den Transmitbuffer schreiben +sbufin: + ldx #tbuf ; Zeichen in Transmitbuffer schreiben + jsr putbuf ; Zeichen geht verloren, wenn Puffer voll + cli ; Wird nicht in Interruptrotinen aufgerufen + + lda ser_com + and #$F3 + cmp #$04 ; War Transmitinterrupt enabled ? + beq sbufin1 + + ora #$04 ; Enable Transmit Interrupt + sta ser_com +sbufin1: + rts + +;**************************************************************** +; +; Eingabe Spooler fuer serielle Schnittstelle +; +;----------------------------------------------------------------- +; +; Zeichen in A in den Receivebuffer schreiben +rxser: + bit A_FLG ; Ausgabeflusskontrolle + bpl rxser3 ; XON/XOFF interpretieren ? + + cmp #XON + bne rxser4 + + lda #$7F + and SerFlg ; Transmitter starten + sta SerFlg ; Bit 7 := 0 + + lda ser_com + and #$F3 + ora #$04 + sta ser_com + rts + +rxser4: + cmp #XOFF + bne rxser3 ; war weder XON noch XOFF + + lda #80 + ora SerFlg ; Transmit-IRQ schaltet sich selbst aus + sta SerFlg ; Bit 7 := 1 + rts + +rxser3: + ldx #rbuf + jsr putbuf ; Zeichen geht verloren, wenn Puffer voll + bcs rx_rts + + lda free+1+rbuf + bne rx_rts ; Noch genug Platz + lda free+rbuf + cmp #10 + bne rx_rts ; Mehr als 16 Zeichen frei + ; Flusskontrolle durchfuehren + bit E_FLG ; Eingabeflusskontrolle + bpl rxser1 + ; XOFF senden + lda #XOFF + jsr DSerOut + +rxser1: + bit E_FLG + bvc rx_rts + ; DTR low legen + lda ser_com + and #$FE + sta ser_com + +rx_rts: rts + + + +;-------------------------------------------------------------------- +; +; Zeichen aus Receivepuffer lesen an 64180 senden +; +rxout: + lda INTPAR1 + bne rxout_rts ; Letzer Interrupt noch nicht quittiert + + bit bus_locked + bmi rxout_rts ; 64180 darf nicht auf den Bus + + bit IFLG ; "stop" - Zustand + bmi rxout_rts ; Kein Inputinterrupt + + ldx #rbuf + jsr getbuf ; Zeichen lesen + bcs rxout_rts ; Puffer ist leer + + ldx #5 ; Kanal 5: serielle Schnittstelle + ldy err5_bits ; Fehlerbits (passen nicht zum Zeichen) + jsr TO180 ; Zeichen im Akku + + ldy #0 + sty err5_bits ; loeschen + + lda full+1+rbuf + bne rxout_rts ; Noch zuviel im Puffer + lda full+rbuf + cmp #10 + bne rxout_rts ; Noch mehr als 16 Zeichen im Puffer + + bit E_FLG + bpl rxout2 + + lda #XON ; XON senden + jsr DSerOut + +rxout2: + bit E_FLG + bvc rxout_rts + ; DTR high legen + lda ser_com + ora #01 + sta ser_com + +rxout_rts: + rts + + +;------------------------------------------------------------------- +; +; Direkte Ausgabe auf der seriellen Schnittstelle +; +DSerOut: + pha + + lda ser_com + and #$F3 + ora #08 ; Transmitter on, Tx_IRQ off + sta ser_com + +Wai_empty: + LDA serial_stat + AND #10 ; Transmit Data Register empty ? + BEQ Wai_empty ; warten bis Transmitter empty -> + + pla + STA SER_DAT + + lda ser_com + and #$F3 + ora #$04 + sta ser_com ; Transmitter on, TX_IRQ on + + RTS + + +;************************************************************************ +; +; => Interrupt: Tastatur/V24 +; +;------------------------------------------------------------------------- +; +; Interrupt-Handler +; +IRQ: + sta ASave + stx XSave + sty YSave + + bit keyboard ; Taste gedrueckt ? + bpl irq_1 + + jsr keyIRQ + +irq_1: + lda serial_stat + bpl irqret + + pha + and #08 ; Receive Data Register full ? + beq irq_2 + + pla + pha + jsr receive_irq + +irq_2: + pla + pha + and #10 ; Transmit Data Register empty ? + beq irq_3 + + jsr spserok ; Zeichen aus Transmitbuffer senden + +irq_3: + pla + pha + and #18 + bne irq_4 + ; External Status Change IRQ + pla + pha + jsr status_irq + +irq_4: + pla +IRQret: + ldy YSave + ldx XSave + lda ASave + rti ; Pull Old Status and Return + +;------------------------------------------------------------------- +; +; Status Change - Interrupt +; +; Eingang: A = serial_stat +; +status_irq: + bit A_FLG ; Ausgabe Flusskontrolle (DSR beachten) + bvc status1 + + and #40 ; DSR beobachten + beq status2 ; -DSR low, Transmitter starten + + lda #$7F ; Bit 7 := 0 + and SerFlg + sta SerFlg + + lda ser_com + and #$F3 + ora #$04 ; Transmitter on, Tx_IRQ on + sta ser_com +status1: + rts + +status2: ; -DSR high, Transmitter stoppen + lda #80 + ora SerFlg ; Transmitter stoppt sich selbst + sta SerFlg + rts + +;------------------------------------------------------------------- +; +; Receiver - Interrupt +; Eingang: Y = ser_dat +; A = serial_stat +; +receive_irq: + and #7 ; Fehlerbits ausmaskieren + ldy ser_dat ; Zeichen einlesen + + bit SerFlg ; Letztes Zeichen war Break + bvc receive1 + + pha + lda #2 ; Break + ora err5_bits + sta err5_bits ; Break empfangen + + lda #$BF + and SerFlg ; Break Bit 6 := 0 + sta SerFlg + pla + + cpy #2 ; SV-Call + beq sv_call + cpy #'W' ; BREAK - W = control ('weiter') simulieren + beq weiter ; WEITER + cpy #'R' ; BREAK - R = RESET + beq reset_sys ; RESET + cpy #'S' ; BREAK - S = Shutup + bne receive1 ; SHUTUP + + pha + ldx #'S' ; Shutup-Kennzeichen + tay + jsr TO180 ; Shutup - Interrupt + pla + +receive1: + cmp #2 ; Framing Error ? + bne receive2 + cpy #0 ; und Zeichen 00 = Break + bne receive2 + + lda #$40 + ora SerFlg ; Break vermerken + sta SerFlg + rts + +sv_call: + jsr weiter + ldy #0 + ldx #5 + lda #2 ; CTRL-B + jmp TO180 + +weiter: + lda #0 + sta INTPAR1 ; Interrupt als quittiert ansehen + lda #7F + and IFLG + sta IFLG + rts + +receive2: + tax + lda errbit_tab,x ; ACIA-Fehlerbits --> EUMEL Fehlerbits + ora err5_bits + sta err5_bits ; Fehler vermerken + + tya ; Zeichen war in Y + jsr rxser ; Zeichen in Receivepuffer schreiben + + jmp rxout ; Versuchen an 64180 zu senden + +;------------------------------------------------------------------------- +; +; Fehlerbits +; +errbit_tab: + db 0, 4, 4, 4, 1, 5, 5, 5 + ; EUMEL: Bit 0= Overrun, Bit 1= Break, Bit 2= Parity/Framing + +;******************************************************************* +; +; Remote - Reset +; +reset_sys: + sei + ldx #rescodelen-1 +resetsysa: + lda rescode,x + sta 0,x + dex + bpl resetsysa + + ldx SLOT180 + lda stop180,x + nop + lda start180,x + nop + lda stop180,x + jmp resvec + +rescode: + db $AF, $F3, $ED, $39, $00, $ED, $39, $00, $ED, $76 +rescodelen equ $-rescode + + ; SYSEND: + ; XOR A + ; DI + ; OUT0 (CNTLA0),A + ; OUT0 (CNTLA0),A + ; SLP + +;------------------------------------------------------------------ +; +; Keyboard - Interrupt +; +keyIRQ: + lda KeyBoard + asl a + + tax ; X = 6543 210O + lda KeyExt + asl a ; Carry = Bit 7 + txa + ror a + sta KeyStr ; Strobe loeschen + + bit bus_locked + bmi readkey0 ; Nur SHUTUP/RESET erlaubt + + cmp #$C2 ; F2 = SV-CALL + bne readkey0a + jsr readkey0b + + lda #$C2 + ldx #1 + jmp TO180 + +readkey0a: + cmp #$BC ; SHIFT CTRL F12 = HCOPY-KEY + bne readkey0c + jmp HCOPY + +readkey0c: + cmp #$BD ; SHIFT CTRL F13 = WEITER-KEY + bne readkey0 +readkey0b: + lda #0 + sta INTPAR1 ; Interrupt als quittiert ansehen + lda #$BF ; Bit 6 loeschen + and IFLG + sta IFLG + rts + +readkey0: + cmp #$BE ; SHIFT CTRL F14 = SHUTUP-KEY + bne readkey1 + ldx #'S' ; Kennzeichen fuer Shutup + jmp TO180 ; Shutup-Interrupt + +readkey1: + cmp #$BF ; SHIFT CTRL F15 = RESET-KEY + bne readkey2 + jmp reset_sys ; Keine Rueckkehr + +readkey2: + ldx KeyIn + inx + cpx KeyOut + bne readkey3 + ; Tastaturpuffer Overflow + lda err1_bits ; Kanal 1 Fehlerbits + ora #1 + sta err1_bits ; Overrun-Error + + ldx #$0A ; Kurzer Beep: Buffer full + ldy #$10 + jmp beep1 + +readkey3: + dex + sta KeyBuf,x + inc KeyIn + ; Versuchen an 64180 zu senden + +;---------------------------------------------------------------- +; +; Zeichen aus Keyboard-Buffer holen +; +getkey: + ldx INTPAR1 ; letzter Interrupt quittiert ? + bne Getret + + bit bus_locked + bmi Getret + + bit IFLG ; "stop" - Zustand ? + bvs Getret ; Kein Inputinterrupt + + sei + ldx KeyOut + cpx KeyIn + beq GetRet ; Puffer leer + + lda KeyBuf,x + inc KeyOut + + ldx #1 ; Kanal 1, Zeichen muss da sein + ldy err1_bits ; Overrun Bit + jsr TO180 ; 64180 Interrupt + + ldy #0 + sty err1_bits + +GetRet: + rts + +;**************************************************************** +; +; Texthardcopy auf Basis-Parallel +; (Interrupt muessen disabled sein) +; (Nur moeglich, wenn Druckerspooler leer, 64180 wird gestoppt) +; +HCOPY: + lda pbuf+full + ora pbuf+full+1 + bne getret ; Kein Hardcopy, da Spooler nicht leer ist. + + jsr lock_bus ; 64180 vom Dienst suspendieren + lda #$0D + jsr bufin ; CR an Drucker + + ldx #0 +hcopy2: + ldy #0 ; 1. Spalte +hcopy1: + txa + pha + tya + pha + jsr bascalc ; Zeichen an der Position lesen + and #$7F ; Inversbit ausblenden + jsr bufin ; Zeichen an Drucker + pla + tay + pla + tax + + iny + cpy #$50 ; 80. Spalte ? + bne hcopy1 + + txa + pha + + lda #$0D ; CRLF an Drucker + jsr bufin + lda #$0A + jsr bufin + jsr spochc ; Spooler erstmal leeren + + pla + tax + inx + cpx #$18 ; 24. Zeile ? + bne hcopy2 + + jmp unlock_bus ; 64180 darf wieder arbeiten + +;------------------------------------------------------------------------ +; +; Berechnet Adresse der Bildschirmposition (A,X) nach basl/bash +; Holt Zeichen --> A +; Static/Dynamic - Switch ggf. veraendert +; +bascalc: + lsr a + tay ; Y DIV 2 + sta VIDBNK ; default even Y + bcc bascalc1 + sta VIDBNK+1 ; odd Y +bascalc1: + txa + lsr a + and #3 + ora #4 ; Page 0400..0BFF + sta bash ; High + txa + and #$18 + bcc bascalc2 + ora #$80 +bascalc2: + sta basl ; Low + asl a + asl a + ora basl + sta basl + lda (basl),y + rts + +;**************************************************************** +; +; Interrupts zum 64180 (Inputinterrupts) +; moeglich von Tastatur (Kanal 1) und seriellem Interface (Kanal 5) +; Shutup-Interrupt mit X = 'S' +; Ausgang: X veraendert +; +TO180: + php + sei + STA intpar2 ; Zeichen + STY intpar3 ; Fehlerbits + STX intpar1 ; Kanalnr. + LDX SLOT180 + LDA INT180,X ; 64180 Interrupt erzeugen + LDA intpar2 + plp ; Interrupt Flag + RTS + +;**************************************************************** +; +; Drucker Spooler loeschen +; +init_pbuf: + ldx #initab_len +ploop: lda pbuf_ini,x + sta pbuf,x + dex + bpl ploop + rts + +pbuf_ini: + DW (DBUFEND - DBUFBEG) * 100H, 0 + DW DBUFBEG * 100H, DBUFBEG * 100H + DB DBUFBEG, DBUFEND +initab_len EQU *-pbuf_ini-1 ; Alle gleich Lang + + +;**************************************************************** +; +; Puffer pollen +; +polling: + jsr spochc ; Zeichen aus Printer Spooler ? + +; lda full+tbuf +; ora full+tbuf+1 +; beq polling2 + +; jsr spsero ; Zeichen aus Transmitbuffer senden +; cli + +;polling2: + lda INTPAR1 ; letzter Interrupt quittiert ? + bne polling1 ; Puffer garnicht erst testen + ; Polling: Interrupts an 64180 + + jsr getkey ; Zeichen aus Tastatur-Buffer + cli + + lda full+rbuf + ora full+rbuf+1 + beq polling1 + + jsr rxout ; Zeichen aus Receive-Buffer + cli + +polling1: + rts + + +;**************************************************************** +; +; Hauptschleife des 6502: wartet auf Tasks +; +; Task 1 : Disk R/W +; 2 : Bell +; 3 : Char zum Drucker(spooler) +; 4 : Char zum seriell Spooler +; 5 : Direktausgabe auf serieller Schnittstelle +; 6 : Analog I/O +; 7 : Grafik +; +task_end: +; 8 : Druckerspooler loeschen + + lda #0 + sta task + sta bus_locked ; Nicht mehr gesperrt + + +task_loop: + cli + jsr polling ; Puffer pollen + + lda task + beq task_loop + + cmp #1 + bne task_lp1 + + jsr DISKRW ; Disk I/O + jmp task_end + +task_lp1: + cmp #2 + bne task_lp2 + + jsr Beep + jmp task_end + +task_lp2: + cmp #3 + bne task_lp3 + + lda param + jsr bufin ; in Spooler-Buffer + jmp task_end + +task_lp3: + cmp #4 + bne task_lp4 + + lda param + jsr sbufin ; Output to serial Interface + jmp task_end + +task_lp4: + cmp #5 + bne task_lp5 + + lda param + jsr DSerOut ; direkte Ausgabe auf ser. Schnittstelle + jmp task_end + +task_lp5: + cmp #6 + bne task_lp6 + + jsr ANAL65 ; Analog I/O + jmp task_end + +task_lp6: + cmp #7 + bne task_lp7 + + JSR GRAFIK ; Grafik I/O + jmp task_end + +task_lp7: + cmp #8 + bne task_end + + jsr init_pbuf ; Drucker Spooler loeschen + jmp task_end + + + defm 'Ende vom SHard' +LEN65 EQU $-start + IF $ GE 2000 + .printx '6502-Modul in Grafikseite 1!' + ENDIF + end + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/DISK80.MAC b/system/shard-z80-ruc-64180/1.5/src/DISK80.MAC new file mode 100644 index 0000000..8afb780 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/DISK80.MAC @@ -0,0 +1,302 @@ + TITLE 64180-Teil fuer EUMEL-SHard Apple-Disk Unterstuetzung + +; 24.05.86, M. Staubermann +; Ueberarbeitet: 04.01.87 + + INCLUDE HD64180.LIB + .LIST + CSEG +; +;---------------------------------------------------------------- +; +; Globale Adressen +; + GLOBAL ANALOG, DISKBK, INIDISK +; +;---------------------------------------------------------------- +; +; Externe Adressen +; + EXTERNAL TO6502, WTEND, TO65WA, ZGERL, RD6502 + EXTERNAL HGOP, WARTE, MEMDMA + +;--------------------------------------------------------------------------- +; +; K O N S T A N T E +; +;--------------------------------------------------------------------------- + +SEKTOR EQU 0F00CH +LASTTRACK EQU 0F00DH +ANALOGWERT EQU 0F00FH +TASK EQU 0F080H +PARAM EQU 0F081H +DEFBYTE EQU 0F082H +DISKNO EQU 0F083H +TRACK EQU 0F084H +DISKERR EQU 0F086H + +BUFPAGE EQU 0E0H ; Erste Page des Trackpuffers + +SEMA: DEFB 0 ; Semaphor fuer Apple-Disk +LASTDISK: DEFB 0FFH +DEFBYTE0: DEFB 0E0H ; Drive 0 +DEFBYTE1: DEFB 0E0H ; Drive 1 + +;--------------------------------------------------------------------------- +; +; A N A L O G +; Eingang: E = Nummer des Analogschalters (1..4) +; Ausgang: BC = Analogwert (0..255) +; +;--------------------------------------------------------------------------- + +ANALOG: + LD A,E ; An jedem Kanal moeglich + AND A + JR Z,ILLEGAL ; Nur Analogschalter 1..4 + + CP 5 + JR NC,ILLEGAL + + LD H,E ; Parameter ist Analogschalternr. + LD L,6 ; Analogport abfragen + CALL TO6502 ; Auf Taskende warten + + CALL WTEND ; Auf Ergebnis warten + + LD HL,LOW ANALOGWERT + CALL RD6502 + LD C,A + + LD B,0 ; Ergebnis in BC + POP HL + RET + +ILLEGAL: + LD BC,-1 + POP HL + RET + +;--------------------------------------------------------------------------- +; +; C H K A C C +; Semaphorhandler fuer Apple-Disks +; +; Akku veraendert, warte wird aufgerufen +; +CHKACC: + LD A,(SEMA) ; Disk-Zugriffssemaphor + AND A ; 0=frei + JR Z,ISFREE ; Ja -> + CALL WARTE + JR CHKACC + +ISFREE: + DEC A + LD (SEMA),A ;Semaphor sperren + RET + +;--------------------------------------------------------------------------- +; +; I N I D I S K +; Eingang: A = Kanalnummer (29, 30) +; DE = Schluessel von control 'size' +; Ausgang: BC = Anzahl 512-Byte Bloecke, die auf die Disk passen +; +;-------------------------------------------------------------------------- + +INIDISK: + PUSH HL + PUSH AF + + CALL CHKACC + + LD A,0FFH ; Nach der naechsten Operation + LD (LASTDISK),A ; Track neu laden + + LD C,081H + LD A,D + AND A + JR Z,INIDISK3 ; DE = 0, 1, 2 + ; Format ueber Schluessel + AND 10000010B ; Bit 7 und Bit 1 ausblenden + JR Z,INIDISK4 ; 0: Erphi, 160k + + LD C,0E0H + CP 10B ; 2: Erphi, 640k + JR Z,INIDISK4 + + LD C,0A1H + CP 10000000B ; 128: Ehring, 160k + JR Z,INIDISK4 + + DEC C ; 130: Ehring 640k + JR INIDISK4 + +INIDISK3: + LD A,E ; Kein analytischer Schluessel + CP 1 + JR Z,INIDISK4 ; 1: 40 Tracks + + LD C,0E0H ; 2 * 80 Tracks +INIDISK4: + POP AF + + LD HL,DEFBYTE0 + CP 30 + JR Z,INIDISK5 + INC HL +INIDISK5: LD (HL),C ; Defbyte eintragen + LD HL,SEMA + LD (HL),0 ; Semaphor freigeben + + POP HL + + BIT 0,C ; 160k oder 640k ? + LD BC,640*2 + RET Z + LD BC,160*2 + RET + +;--------------------------------------------------------------------------- +; +; D I S K B K +; Blockio auf Apple-Drives +; +; Eingang: A = Kanal (29, 30) +; DE = Blocknummer +; HL = Hauptspeicheraddresse des Blocks +; (HGOP) : 1 = BLOCKOUT, 0 = BLOCKIN +; Ausgang: BC = Fehlercode (0, 1, 2) +; +;-------------------------------------------------------------------------- + +DISKBK: + PUSH DE + PUSH AF ; Kanal merken + + CALL CHKACC ; Auf freie Diskroutinen warten + + XOR A ; A := 0 + LD B,3 +DIVLOOP: SRL D ; DE DIV 8 (Blocks/Track) + RR E + RRA + DJNZ DIVLOOP ; E = Tracknummer + ; D = 0 + RRA + RRA + RRA + RRA ; A = Sektornummer + LD D,E + LD E,A ; DE = Track/Sektor + + LD A,(HGOP) ; BLOCKIN oder BLOCKOUT ? + DEC A + CALL Z,TRANSPORT ; BLOCKOUT: 180-RAM --> 6502-RAM + + DI + IN0 B,(CBR) + LD C,51H ; Zeropage 6502 einblenden + OUT0 (CBR),C + + CALL ZGERL + + POP AF ; Kanal zurueck + AND 1 ; Diskno in A + LD C,A + LD A,(LASTDISK) + CP C + JR Z,DISKBK2 + LD A,0FFH + LD (LASTTRACK),A ; Track muss neu geladen werden +DISKBK2: + PUSH HL + + LD HL,TRACK + LD (HL),D ; Track + + LD A,C + LD (LASTDISK),A + DEC HL + LD (HL),C + + LD A,(DEFBYTE0) + DEC C + INC C + JR Z,DISKBK3 + LD A,(DEFBYTE1) +DISKBK3: + DEC HL + LD (HL),A ; Defbyte + + LD A,(HGOP) + DEC A ; Read/Write Param + DEC HL + LD (HL),A + + LD A,E ; Sektor + LD (SEKTOR),A + + DEC HL + LD (HL),1 ; Task: Disk R/W starten + + OUT0 (CBR),B + EI + + CALL TO65WA ; Auf Beendigung der Task warten + ; EUMEL-'warte' wird aufgerufen! + LD HL,LOW DISKERR + CALL RD6502 + POP HL + + PUSH AF + LD A,(HGOP) + DEC A + CALL NZ,TRANSPORT + POP AF + LD BC,2 + DEC A + JR Z,DISKBK1 ; 2 = Diskettenfehler + DEC BC + DEC A + JR Z,DISKBK1 ; 1 = Writeprotected + DEC BC ; 0 = ok +DISKBK1: + XOR A + LD (SEMA),A + POP DE + RET + + +;............................................................................ +; +; Falls HGOP = 0: +; 2 Sektoren (E, E+1) aus Basisspeicher --> 64180 (HL) +; Falls HGOP = 1: +; 2 Sektoren aus 64180-RAM (HL) --> Basisspeicher (E, E+1) +; +; Eingang: E = Sektornummer (muss gerade sein) +; HL = Hauptspeicheradresse +; Ausgang: A, BC, HL veraendert + +TRANSPORT: PUSH HL + PUSH DE + LD A,E ; Sektor + EX DE,HL ; HL (log. Adr.) --> DE + + AND 0FH ; 0..15 + OR BUFPAGE ; Highbyte des Trackbuffers 6502 + LD H,A ; phys. Adr. berechnen + LD L,0 + LD BC,512 ; 512 Bytes uebertragen + LD A,(HGOP) ; Transferrichtung + + CALL MEMDMA ; DMA-Transfer + POP DE + POP HL + RET + + END + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/DUMP.COM b/system/shard-z80-ruc-64180/1.5/src/DUMP.COM new file mode 100644 index 0000000..d425dbf Binary files /dev/null and b/system/shard-z80-ruc-64180/1.5/src/DUMP.COM differ diff --git a/system/shard-z80-ruc-64180/1.5/src/EBOOT.COM b/system/shard-z80-ruc-64180/1.5/src/EBOOT.COM new file mode 100644 index 0000000..134ccc5 Binary files /dev/null and b/system/shard-z80-ruc-64180/1.5/src/EBOOT.COM differ diff --git a/system/shard-z80-ruc-64180/1.5/src/EBOOT.MAC b/system/shard-z80-ruc-64180/1.5/src/EBOOT.MAC new file mode 100644 index 0000000..281713a --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/EBOOT.MAC @@ -0,0 +1,339 @@ + TITLE EBOOT - Eumel Bootstrap Schreibprogramm +; +;**************************************************************** +; +; E B O O T +; +; Version 1.3 - 29.12.1986 +; +; Copyright (C) 1985 by R. Ellerbrake +; +;**************************************************************** +; + INCLUDE HD64180.LIB +; + .LIST +; +BDOS EQU 5 +EUMEL EQU 6 ;Volume Directory Typ +BOTLNG EQU 3FH ; Nicht 40H +BOTPA1 EQU 10H +BOTPA2 EQU 10H +DEFFCB EQU 5CH +; + EXTERNAL INITS, HDIO, FDIO, SCSIIO + GLOBAL EBOOT +; + CSEG +; +;**************************************************************** +; +; Meldungen +; +STARTUP: + DEFB 0DH, 0AH + DEFM '**** E U M E L Harddisk Bootstrap Installationsprogramm ****' + DEFB 0DH, 0AH + DEFM ' Version 1.3 - 29.12.1986 - (C) by R. Ellerbrake (RUC)$' +; +NOBOOT: + DEFB 0DH, 0AH, 7 + DEFM 'Datei EUMEL.COM nicht gefunden, leer oder fehlerhaft!$' +; +ERRSTR: + DEFB 0DH, 0AH, 7 + DEFM 'Harddisk E/A Fehler: ' +ERRNR: DEFM '00$' +; +ENDMSG: + DEFB 0DH, 0AH, 7 + DEFM 'Kein (weiteres) EUMEL Volume vorhanden!$' +; +QSTR: + DEFB 0DH, 0AH + DEFM 'EUMEL Bootstrap Lader auf Harddisk Volume ' +QSTRN: + DEFM ' $' +; +LSTR: + DEFB ' installieren (J/N): $' +; +ILLSTR: + DEFB 0DH, 0AH, 7 + DEFM 'Unzulaessige Eingabe !!!$' +; +RDYSTR: + DEFB 0DH, 0AH + DEFM 'EUMEL Bootstraplader erfolgreich installiert.$' +; +;**************************************************************** +; +EBOOT:: + LD SP,STACK +; + LD DE,STARTUP + LD C,9 + CALL BDOS +; + LD A,(DEFFCB) + LD DE,EUMELFI + LD (DE),A ;ggf. Drive aus Kommandozeile verwenden + LD C,15 ;Open File + CALL BDOS + INC A ;Fehler ? + JR NZ,FIOK ;Nein -> +; +ILLFI: + LD DE,NOBOOT ;Bootstrap Lader Datei nicht gefunden + LD C,9 + CALL BDOS + JP 0 +; +FIOK: + LD A,(EUMELFI+16) ;1. BLock vorhanden ? + AND A + JR Z,ILLFI ;Nein -> Fehler +; + CALL INITS + CALL INITS +; +; Warten bis Harddisk hochgelaufen ist +; +WRTHRD: + LD DE,TESTRD + LD BC,0 + CALL SCSIIO + CP 4 ;Drive not Ready ? + JR Z,WRTHRD ;Ja -> warten +; + LD HL,DATAR + LD BC,PARBLK + LD A,0 ;Superdirectory lesen + LD DE,0 + CALL HDIO + AND A + JR Z,SDOK +; +HDIOER: + LD DE,ERRNR ; Fehlernummer in A + CALL HEX1 + LD DE,ERRSTR + LD C,9 + CALL BDOS + JP 0 + +HEX1: + PUSH AF + RRCA + RRCA + RRCA + RRCA + CALL HEX2 + POP AF +HEX2: + AND 0FH + CP 0AH + JR C,HEX3 + ADD 7 +HEX3: + ADD 30H + LD (DE),A + INC DE + RET +; +; 64180 Bootvolume mit EUMEL Kennung suchen +; +SDOK: + LD HL,DATAR + LD E,(HL) ;Byte 0 = Anfangsoffset + LD D,0 ;DE = Volume Eintrag Laenge + ADD HL,DE + LD A,(DATAR+20H) ;Volume Anzahl + LD B,A +; +SRCLOP: + PUSH HL + POP IX + LD A,(IX+23H) ;Directory Typ + CP EUMEL ;EUMEL Diretory ? + JR Z,ISEDIR ;Ja -> +; +NXVOL: + ADD HL,DE + DJNZ SRCLOP +; +; Alle Volumes durchsucht +; + LD DE,ENDMSG + LD C,9 + CALL BDOS + JP 0 +; +; EUMEL Volume gefunden +; +ISEDIR: + PUSH HL + PUSH DE + PUSH BC + PUSH IX + LD B,0 + LD C,(IX+10H) ;Laenge des Volumenamens + LD DE,11H + ADD HL,DE ;auf Volumename + LD DE,QSTRN + LDIR + LD A,'$' + LD (DE),A ;Stringende eintragen +; + LD DE,QSTR + LD C,9 + CALL BDOS ;anfragen + LD DE,LSTR + LD C,9 + CALL BDOS +; + LD C,1 ;1 Zeichen einlesen + CALL BDOS + AND 05FH +; + CP 'Y' ;Ja -> + JR Z,PUTBOT +; + CP 'J' ;Ja -> + JR Z,PUTBOT +; + CP 'N' ;Nein -> + JR Z,NOBOT +; +; Falsche Eingabe: nochmal anfragen +; + LD DE,ILLSTR + LD C,9 + CALL BDOS +; + POP IX + POP BC + POP DE + POP HL + JR ISEDIR +; +NOBOT: + POP IX + POP BC + POP DE + POP HL + JR NXVOL +; +; Bootstrap installieren +; + +PUTBOT: + XOR A + LD HL,BOTBUF + LD (HL),A + LD DE,BOTBUF+1 + LD B,BOTLNG + LD C,0 + LDIR ; Bereich loeschen + + LD HL,BOTBUF ;EUMEL Bootstrap Datei einlesen + LD B,BOTLNG*2 ;max. Recordanzahl + LD DE,EUMELFI +; +RDLOP: + PUSH BC + PUSH DE + LD C,26 + EX DE,HL + PUSH DE + CALL BDOS ;DMA-Adresse setzen + POP HL + LD DE,128 ;und hochzaehlen + ADD HL,DE + POP DE + PUSH HL + PUSH DE + LD C,20 ;Read sequential + CALL BDOS ;Record lesen + POP DE + POP HL + POP BC + CP 1 + JR Z,READY + DJNZ RDLOP ;Nicht fertig -> +; +; Bootstrap Lader im Speicher +; +READY: + POP IX + POP BC + POP DE + POP HL + + LD (HL),40H ;EUMEL Bootkennung eintragen + LD (IX+20H),BOTPA1 ;EUMEL Bootparameter eintragen + LD (IX+21H),BOTPA2 + LD (IX+22H),BOTLNG + INC HL + PUSH HL ;Bootvolume +; + LD HL,DATAR + LD BC,PARBLK + LD A,1 ;Superdirectory schreiben + LD DE,0 + CALL HDIO +; +; Bootstrap Lader schreiben +; + LD HL,BOTBUF ;Datenbereich + LD DE,0 ;Blocknummer +; +WRLOP: + POP BC + PUSH BC + PUSH DE + PUSH HL + LD A,1 + CALL HDIO +; + JP NZ,HDIOER +; + POP HL + LD DE,512 ;Adresse hochzaehlen + ADD HL,DE + POP DE + INC DE + LD A,E + CP BOTLNG/2 ;fertig ? + JR NZ,WRLOP ;Nein -> +; + POP BC + LD DE,RDYSTR + LD C,9 + CALL BDOS + JP 0 +; +;**************************************************************** +; +EUMELFI: + DEFB 0 ;auf Default Drive + DEFM 'EUMEL COM' + DEFB 0,0,0,0,0 + DEFB 0,0,0,0,0,0,0,0 + DEFB 0,0,0,0,0,0,0,0,0 +; +PARBLK: + DEFB 0,0,2,0 +; +TESTRD: + DEFB 0,0,0,0,0,0 ;Test Ready +; + DEFS 200 +STACK: DEFW 0 +; +DATAR: DEFS 512 +; +BOTBUF: +; + END + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/EBOOT.SUB b/system/shard-z80-ruc-64180/1.5/src/EBOOT.SUB new file mode 100644 index 0000000..5d806a1 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/EBOOT.SUB @@ -0,0 +1,3 @@ +SLR EBOOT +L80 /P:0100, START, SCSI, EBOOT, EBOOT/N/E + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/EINST.COM b/system/shard-z80-ruc-64180/1.5/src/EINST.COM new file mode 100644 index 0000000..1fdd334 Binary files /dev/null and b/system/shard-z80-ruc-64180/1.5/src/EINST.COM differ diff --git a/system/shard-z80-ruc-64180/1.5/src/EINST.PAS b/system/shard-z80-ruc-64180/1.5/src/EINST.PAS new file mode 100644 index 0000000..3b466da --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/EINST.PAS @@ -0,0 +1,509 @@ +PROGRAM installieren_des_eumel_shards ; +{$U-} + +CONST vers = '2.1 vom 22.01.87' ; + shard_file = 'EUMEL.COM' ; + floppy_boot_file = 'FBOOT.COM' ; + conf_offset = $37 ; { Anfang ohne LOAD-Modul (phys.-Adr $00000) } + +{ 2.1: 22.01.87 mit Pascal SCSI-Routinen & Konfiguration } + +{$I SCSI.PAS} + +TYPE SECTOR = ARRAY[0..255] OF BYTE ; + + FLAGTYPE = SET OF (x0, x1, x2, x3, autoboot, curvol, b64180, b6502) ; + + IDTYPE = (free, ucsd, dos, cpm, prodos, id5, eumel, id7, + id8, id9, id10, id11, id12, id13, id14, spare) ; + + STRING15 = STRING[15] ; + + LUN = RECORD + drive, high, low : BYTE + END ; + + DISKENTRYTYPE = RECORD + entrylength : BYTE ; + first_block : LUN ; + reserved : BYTE ; + last_block : LUN ; { exclusiv } + params : ARRAY [0..7] OF BYTE ; + name : STRING15 ; + volumes : BYTE ; { Anzahl Volumes } + autoboot : CHAR ; { Volumekennzeichen fuer Autoboot } + waittime : INTEGER ; { Wartezeit vor Autoboot in 1.46ms } + END ; + + VOLUMEENTRYTYPE = RECORD + flags : FLAGTYPE ; + first : LUN ; + kz : CHAR ; { Kennzeichen in der VOLTAB } + last : LUN ; { Letzer Block exclusiv } + params: ARRAY[0..7] OF BYTE ; + name : STRING15 ; + loadpage : BYTE ; { Highbyte Ladeadresse im 6502-Memory } + jumppage : BYTE ; { Highbyte Startadresse im 6502-Memory } + pages : BYTE ; { Anzahl zu ladender Seiten } + volid : IDTYPE ; + END ; + +VAR f : FILE ; + floppy_version : BOOLEAN ; + shard_size, volume : INTEGER ; + volume_name, scsi_floppy : STRING15 ; + buffer : ARRAY[0..$3F] OF SECTOR ; + boot_buffer: ARRAY[0..15] OF SECTOR ; + conf : RECORD + offset : ARRAY[1..conf_offset] OF BYTE ; + umsch : ARRAY[1..8] OF BYTE ; + blinkp : BYTE ; { Cursor Blinkfrequenz in 50ms } + beepfreq: BYTE ; { Kanal 1: Beepfrequenz } + arc31 : LUN ; { SCSI-Floppy LUN } + mode : INTEGER ; { EUMEL-MODE-Word } + id4 : INTEGER ; { Lizenznummer des SHards } + id5 : INTEGER ; { Installationsnummer des SHards } + id6 : INTEGER ; { Reserviert fuer SHard } + urlk1 : BYTE ; { Primaerer Urladerkanal } + urlk2 : BYTE ; { Sekundaerer Urladerkanal } + free : BYTE ; + irqvecs : ARRAY[1..$40] OF BYTE ; { Interruptvektoren } + ikantab : ARRAY[0..7] OF BYTE ; { phys. --> log. Kanalnr. } + kantab : ARRAY[0..32] OF BYTE ; { log. --> phys. Kanalnr. } + ioftb : ARRAY[0..31] OF BYTE ; { 'typ'-Bits der Kanaele } + cpmofs : LUN ; { LUN & Anfangs-Adr. eines CP/M-Volumes } + cpmlast : LUN ; { LUN & Endadr. (excl.) eines CP/M-Volumes } + END ABSOLUTE buffer ; + + superdirectory : + RECORD + diskentry : DISKENTRYTYPE ; + volumeentry : ARRAY[1..26] OF VOLUMEENTRYTYPE ; + END ; + + + +PROCEDURE errorstop (message : STRING77) ; + BEGIN + writeln ; + writeln (#7, 'FEHLER: ', message) ; + halt + END { errorstop } ; + + +FUNCTION yes (question : STRING77) : BOOLEAN ; + VAR zeichen : CHAR ; + CONST answer : SET OF CHAR = ['y', 'Y', 'n', 'N', 'j', 'J'] ; + BEGIN + WHILE keypressed DO read (KBD, zeichen) ; { empty buffer } + write (question, ' (j/n) ? ') ; + REPEAT + read (KBD, zeichen) ; + IF zeichen = #27 THEN errorstop ('Abbruch mit ESC') ; + IF NOT (zeichen IN answer) + THEN write (#7) + ELSE writeln (zeichen) + UNTIL zeichen IN answer ; + yes := zeichen IN ['y', 'Y', 'j', 'J'] + END { yes } ; + + +FUNCTION txt (nr : INTEGER) : STRING15 ; + VAR result : STRING15 ; + BEGIN + str (nr, result) ; + txt := result + END { txt } ; + + +PROCEDURE shard_lesen ; + BEGIN + fillchar (buffer, sizeof (buffer), 0) ; + assign (f, shard_file) ; + reset (f) ; + shard_size := filesize (f) ; + blockread (f, buffer, shard_size) ; + close (f) ; + IF (shard_size < 3) OR (shard_size > 2 * $3F) + THEN errorstop ('Die Datei ' + shard_file + ' ist inkonsistent!') + END { shard_lesen } ; + + +PROCEDURE shard_schreiben ; + VAR eumel_track : INTEGER ; + BEGIN + WITH superdirectory.volumeentry[volume].first DO BEGIN + eumel_track := low DIV 32 + high * 8 + (drive AND $3F) * 2048 + END ; + hd_write (buffer, eumel_track * 32, 32) ; + hd_write (buffer[32], succ (eumel_track) * 32, 32) + END { shard_schreiben } ; + + +PROCEDURE eumel_volume_suchen ; + VAR name : STRING[255] ; + BEGIN + volume := 1 ; + WITH superdirectory DO BEGIN + + WHILE volume <= diskentry.volumes DO BEGIN + IF volumeentry[volume].volid = eumel + THEN IF yes ('SHard auf Volume "' + volumeentry[volume].name + + '" installieren') + THEN exit ; + volume := succ (volume) ; + END { WHILE } ; + writeln ('Kein (weiteres) EUMEL-Volume gefunden.') ; + + IF yes ('Soll ein anderes Volume zu einem EUMEL-Volume werden') + THEN BEGIN + volume := 1 ; + WHILE volume <= diskentry.volumes DO BEGIN + IF volumeentry[volume].volid <> spare + THEN IF yes ('SHard auf Volume "' + volumeentry[volume].name + + '" installieren') + THEN BEGIN + IF yes ('Volumename aendern') + THEN BEGIN + write ('Neuer Volumename: ') ; + REPEAT + readln (name) ; + IF length (name) > 15 + THEN writeln ('Zu lang!') + UNTIL (name <> '') AND (length (name) < 16) ; + volumeentry[volume].name := name ; + END ; + exit ; + END ; + volume := succ (volume) + END { WHILE } ; + writeln ('Kein (weiteres) Volume gefunden.') ; + END { IF } ; + writeln ('Installation abgebrochen.') ; + halt + + END { WITH } + END { eumel_volume_suchen } ; + + +PROCEDURE superdirectory_lesen ; + BEGIN + hd_read (superdirectory, 2, 4) ; + END { superdirectory_lesen } ; + + +PROCEDURE superdirectory_schreiben ; + BEGIN + WITH superdirectory.volumeentry[volume] DO BEGIN + flags := [b64180] ; (* Boot in 64180-Code geschrieben *) + loadpage := $10 ; + jumppage := loadpage ; + pages := $3F ; (* Da $40 nicht geht (Timeout auf Cylindergrenze) *) + volid := eumel ; + END ; + + hd_write (superdirectory, 2, 4) + END { superdirectory_schreiben } ; + + +FUNCTION sector_write (trk, sec, adr : INTEGER) : BOOLEAN ; +BEGIN + bios (9, trk) ; + bios (10, sec) ; + bios (11, adr) ; + sector_write := (bios (13, 0) = 0) ; +END ; + + +PROCEDURE shard_auf_floppy_schreiben ; + VAR trk, sec, curdrv, drive : INTEGER ; + zeichen : CHAR ; + BEGIN + fillchar (boot_buffer, sizeof (boot_buffer), 0) ; + assign (f, floppy_boot_file) ; + reset (f) ; + blockread (f, boot_buffer, filesize (f)) ; { max. 4k Boot } + close (f) ; + + boot_buffer[0][$FF] := 0 ; + WHILE boot_buffer[0][$FF] = 0 DO BEGIN + IF yes ('2 * 80 Track (Erphi) Format') THEN boot_buffer[0][$FF] := $E0 + ELSE IF yes ('1 * 35 Track (Apple) Format') THEN boot_buffer[0][$FF] := $81 + ELSE IF yes ('2 * 80 Track (Ehring) Format')THEN boot_buffer[0][$FF] := $A0 ; + END ; + + curdrv := bdos (25, 0) ; { current_drive } + drive := curdrv ; + + write ('Floppy-Drive (Abbruch mit ESC): ', chr (drive + 65), #8) ; + REPEAT + read (KBD, zeichen) ; + IF zeichen = #27 + THEN errorstop ('Abbruch mit ESC') ; + zeichen := upcase (zeichen) ; + IF NOT (zeichen IN ['A'..'P']) + THEN write (#7) + ELSE writeln (zeichen) + UNTIL zeichen IN ['A'..'P'] ; + drive := ord (zeichen) - 65 ; + + IF drive = curdrv + THEN REPEAT UNTIL yes ('(Leere) Destinationdiskette eingelegt') ; + + writeln ; + bios (8, drive) ; { Select Floppy Drive } + + FOR sec := 0 TO 15 DO { Floppy-Boot/Taskloop schreiben } + IF NOT sector_write (0, sec, addr (boot_buffer [sec])) + THEN BEGIN + bios (8, curdrv) ; + errorstop ('Schreibfehler auf Drive ' + zeichen + + ':, Track 0, Sektor ' + txt (sec)) + END ; + FOR trk := 1 TO 4 DO { SHard schreiben } + FOR sec := 0 TO 15 DO + IF NOT sector_write (trk, sec, addr (buffer [sec + pred(trk) * 16])) + THEN BEGIN + bios (8, curdrv) ; + errorstop ('Schreibfehler auf Drive ' + zeichen + ':, Track ' + + txt (trk) + ', Sektor ' + txt (sec)) + END ; + + bios (8, curdrv) ; { Select previous Drive } + + END ; + + +PROCEDURE cpm_volume_suchen ; + BEGIN + WITH superdirectory DO BEGIN + REPEAT + volume := 1 ; + WHILE volume < diskentry.volumes DO BEGIN + IF volumeentry[volume].volid = cpm + THEN IF yes (volumeentry[volume].name) + THEN exit ; + volume := succ (volume) ; + END + UNTIL yes ('Kein (weiteres) Volume gefunden, erstes Volume nehmen') ; + volume := 1 ; + writeln ('Volume "', volumeentry[volume].name, '" wird angenommen.') ; + END +END { cpm_volume_suchen } ; + + +PROCEDURE kanalzuordnungen ; + VAR i, j, channel : INTEGER ; + ok : BOOLEAN ; + +FUNCTION kanal_erfragen (log : INTEGER) : INTEGER ; + VAR channel : INTEGER ; + BEGIN + REPEAT + channel := 255 ; + write (' ':77, #13) ; + write ('Logischer Kanal ', log:2, ' ---> physischer Kanal: -'#8) ; + buflen := 2 ; + read (channel) ; + write (#13) ; + UNTIL ((channel >= 0) AND (channel < 7)) OR + ((channel >= 28) AND (channel < 32)) OR + (channel = 255) ; + kanal_erfragen := channel + END ; + +PROCEDURE message (msg : STRING77) ; + VAR zeichen : CHAR ; + BEGIN + write (#13, ' ', msg, ' - Taste -'#13) ; + read (KBD, zeichen) + END { message } ; + + BEGIN { kanalzuordnungen } + REPEAT + clrscr ; + writeln ('--- Zuordnung der logischen/physischen Kanaele ---') ; + writeln ; + writeln ('Den logischen Kanaelen werden physische Kanaele zugeordnet,') ; + writeln ('dabei sind folgende Einschraenkungen zu beachten:') ; + writeln ('- Kanal 0 und 31 muessen als Blockkanal definiert werden.') ; + writeln ('- Kanal 1 muss als Streamkanal definiert werden (Systemstart).') ; + writeln ('- Kein physischer Kanal darf mehrfach zugeordnet werden.') ; + writeln ; + writeln ('Folgende physische Kanaele stehen zur Verfuegung:') ; + writeln ; + writeln ('Streamkanaele: Blockkanaele:') ; + writeln ('-------------- -------------') ; + writeln ('1 ... Basis - Konsole 0 ... SCSI - Harddisk #0') ; + writeln ('2 ... ruc180 - Serielle B ( 1 ... Basis - Graphikkonsole)') ; + writeln ('3 ... ruc180 - Serielle A 28 ... SCSI - Volume "', volume_name, '"') ; + writeln ('4 ... ruc180 - Centronics 29 ... Basis - Diskdrive 1') ; + writeln ('5 ... Basis - Serielle 30 ... Basis - Diskdrive 0') ; + writeln ('6 ... Basis - Centronics 31 ... SCSI - ', scsi_floppy) ; + writeln ; + conf.kantab[32] := 32 ; { Parameterkanal } + writeln ; + FOR i:= 0 TO 31 DO BEGIN + REPEAT + REPEAT + channel := kanal_erfragen (i) ; + ok := FALSE ; + IF channel = 255 + THEN IF (i = 0) OR (i = 1) OR (i = 31) + THEN message ('Kanal 0, 1 und 31 muessen definiert werden!') + ELSE ok := TRUE + ELSE IF ((i = 0) OR (i = 31)) AND + ((conf.ioftb[channel] AND 12) <> 12) + THEN message ('Kanal ' + txt (i) + ' muss ein Blockkanal (0, 28..31) sein!') + ELSE IF (i = 1) AND ((conf.ioftb[channel] AND 3) <> 3) + THEN message ('Kanal 1 muss ein Stream I/O-Kanal sein!') + ELSE ok := TRUE + UNTIL ok ; + IF channel <> 255 + THEN BEGIN + j := 0 ; + WHILE (j < i) AND (conf.kantab[j] <> channel) DO j := succ (j) ; + IF j < i + THEN message ('Der phys. Kanal ' + txt(channel) + + ' wurde schon dem log. Kanal ' + txt (j) + + ' zugeordnet!') ; + END ; + UNTIL (j = i) OR (channel = 255) ; + conf.kantab[i] := channel ; { Zuordnung log. --> phys. } + IF channel < 7 + THEN conf.ikantab[channel] := i ; { Zuordnung phys. --> log. } + END ; + + clrscr ; + writeln ('So sind die physischen Kanaele den logischen Kanaelen zugeordnet:') ; + FOR i:= 0 TO 31 DO BEGIN + gotoxy (succ ((i DIV 16) * 40), 3 + (i MOD 16)) ; + write (i:2, ': ') ; + CASE conf.kantab[i] OF + 0 : write ('SCSI - Harddisk #0') ; + 1 : write ('Basis - Konsole') ; + 2 : write ('ruc180 - Serielle B') ; + 3 : write ('ruc180 - Serielle A') ; + 4 : write ('ruc180 - Centronics') ; + 5 : write ('Basis - Serielle') ; + 6 : write ('Basis - Centronics') ; + 28 : write ('SCSI - Volume "', volume_name, '"') ; + 29 : write ('Basis - Diskdrive 1') ; + 30 : write ('Basis - Diskdrive 0') ; + 31 : write ('SCSI - ', scsi_floppy) ; + 255 : write (' -') + END { CASE } ; + END ; + writeln ; + writeln ; + + UNTIL yes ('Alle Kanal-Zuordnungen korrekt') ; +END { kanalzuordnungen } ; + + +PROCEDURE konfigurieren ; + VAR freq : REAL ; + BEGIN + writeln ; + writeln ('************************* Systemstart - Parameter ************************') ; + writeln ; + + IF yes ('EUMEL-Vortest beim Systemstart') + THEN IF NOT yes ('Speichertest durchfuehren') + THEN conf.mode := $0100 + ELSE conf.mode := 0 + ELSE conf.mode := $0200 ; + writeln ; + + conf.urlk1 := 31 ; + conf.urlk2 := 0 ; + IF NOT yes ('Soll der Urlader zuerst auf dem Archivkanal gesucht werden') + THEN BEGIN + conf.urlk1 := 0 ; + conf.urlk2 := 31 + END ; + writeln ; + + writeln ('**************** Parameter der Konsole (phys. Kanal 1) ******************') ; + writeln ; + + freq := conf.blinkp * 0.1 ; + write ('Cursor Blinkperiode (s) : ', freq:2:1, #8#8#8#8) ; + REPEAT + readln (freq) + UNTIL (freq >= 0.05) AND (freq <= 25.5) ; + conf.blinkp := round (freq * 10.0) ; + writeln ; + + freq := int (5000.0/conf.beepfreq + 0.5) ; + write ('Tonfrequenz bei Bell (Hz): ', freq:4:0, #8#8#8#8) ; + REPEAT + readln (freq) + UNTIL freq >= 1.0 ; + conf.beepfreq := round (5000.0/freq) ; + writeln ; + + IF NOT floppy_version + THEN BEGIN + writeln ('********** Parameter fuer Harddisk-Volume (phys. Kanal 28) **************') ; + writeln ; + + writeln ('Welches CP/M-Volume soll angesprochen werden ?') ; + cpm_volume_suchen ; + conf.cpmofs := superdirectory.volumeentry[volume].first ; + conf.cpmlast := superdirectory.volumeentry[volume].last ; + volume_name := superdirectory.volumeentry[volume].name ; + END + ELSE volume_name := '(1. Volume)' ; + + writeln ; + writeln ('************* Parameter fuer SCSI-Floppy (phys. Kanal 31) ****************') ; + writeln ; + conf.arc31.drive := $60 ; + scsi_floppy := 'Floppy #1' ; + IF yes ('SCSI-Floppy #0 statt SCSI-Floppy #1') + THEN BEGIN + conf.arc31.drive := $40 ; + scsi_floppy := 'Floppy #0' + END ; + + writeln ; + IF yes ('Zuordnung der logischen/physischen Kanaele aendern') + THEN kanalzuordnungen ; + + writeln ; + writeln ; + END { konfigurieren } ; + + +BEGIN { MAIN } + clrscr ; + writeln (' EUMEL-SHard Installation') ; + writeln (' Version ', vers) ; + writeln (' (c) M. Staubermann (ruc)') ; + writeln ; + writeln ; + + IF yes ('SHard auf der Harddisk installieren') + THEN BEGIN + floppy_version := FALSE ; + shard_lesen ; + superdirectory_lesen ; + IF yes ('SHard-Defaults aendern') + THEN konfigurieren ; + eumel_volume_suchen ; + shard_schreiben ; + superdirectory_schreiben ; + writeln ('SHard erfolgreich auf Harddisk installiert.') + END + ELSE IF yes ('SHard auf einer (CP/M-)Floppy installieren') + THEN BEGIN + floppy_version := TRUE ; + shard_lesen ; + IF yes ('SHard-Defaults aendern') + THEN konfigurieren ; + shard_auf_floppy_schreiben ; + writeln ('SHard erfolgreich auf Floppy installiert.') + END + ELSE writeln ('Kein SHard installiert.') +END. \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/EUMEL.COM b/system/shard-z80-ruc-64180/1.5/src/EUMEL.COM new file mode 100644 index 0000000..3d0a00c Binary files /dev/null and b/system/shard-z80-ruc-64180/1.5/src/EUMEL.COM differ diff --git a/system/shard-z80-ruc-64180/1.5/src/FBOOT.COM b/system/shard-z80-ruc-64180/1.5/src/FBOOT.COM new file mode 100644 index 0000000..6cddfa2 Binary files /dev/null and b/system/shard-z80-ruc-64180/1.5/src/FBOOT.COM differ diff --git a/system/shard-z80-ruc-64180/1.5/src/FBOOT.MAC b/system/shard-z80-ruc-64180/1.5/src/FBOOT.MAC new file mode 100644 index 0000000..db2d03e --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/FBOOT.MAC @@ -0,0 +1,714 @@ + +;--------------------------------------------------------------------------- +; +; SHard 1.8.0 - Schneller Boot von Floppy +; =========== +; +; (C) Copyright 1987, Michael Staubermann (ruc) +; +; Version 0.2, 22.01.87 +; +;--------------------------------------------------------------------------- +; + .6502 + .RADIX 16 + SUBTTL Floppyboot + +slot equ 6 +load_sec equ $C65C +p_data equ 27 +sector equ 3D +ROM equ slot*100+0C000 + +vpoint EQU $10 ; Zeigt auf Volumetabelle +VOLTAB EQU $B800 + +DMA equ 50 ; 50..6F +sec_tble equ 70 ; 70..7F +task equ 80 ; 80 +param equ 81 +def_byte equ 82 +disk_no equ 83 +iob_trk equ 84 +sec_cnt equ 85 +iob_err equ 86 + +; work space + +wait_Cnt equ 87 +user_data equ 89 +dest_phase equ 8B +chk_in_hdr equ 8C +sec_in_hdr equ 8D +trk_in_hdr equ 8E +vol_in_hdr equ 8F +slot10z equ 90 ; slot #: s0 +iob_drv equ 91 +phase equ 92 +iob_sec equ 93 +chk_sum equ 94 +temp2 equ 95 +head_pos equ 96 +tktry_cnt equ 97 +hdtry_cnt equ 98 +recal_cnt equ 99 + +; Floppy Hardware + +phase0 equ 0C080 +phase1 equ 0C082 +phase2 equ 0C084 +phase3 equ 0C086 +mtroff equ 0C088 +mtron equ 0C089 +drive0 equ 0C08A +Q6off equ 0C08C +Q6on equ 0C08D +Rstate equ 0C08E +Wstate equ 0C08F + +bit_z equ 24 + +fast_step equ $0E ; etwas weniger als 3 ms Track-Wechselzeit + +start180 EQU $C087 ; 64180 startet bei 0000 + +;---------------------------------------------------------------------------- + +pagerr macro adr + if high(*-start) ne high(adr-start) + .printx 'Page-Error' + endif + endm + + .phase 0800 + +start: +nible1: + + DB 0 ; Nur einen Sektor + cpx #60 + beq slotok + jmp booterr +slotok: + lda sector + cmp #8 ; Alle Sektoren gewesen ? + beq loader + cmp #$0F + bne next_sec + lda #8 + sta p_data + lda #0 + sta sector ; Mit Sektor 1 nach 0900 weiter +next_sec: + inc p_data + inc sector + jmp load_sec ; Sector laden und --> 0801 springen + +loader: + lda $03F3 + sta $03F4 ; Reboot + + lda def + sta def_byte + + jmp load_shard + +booterr: + jsr $FE84 + jsr $FB2F + jsr $FE93 + jsr $FE89 + jsr $FC58 ; Init Video, KBD, CLRSCR... + ldy #0 +err1: lda errtxt,y + eor #$80 + jsr $FDED ; Auf Bildschirm ausgeben + iny + cmp #$8D ; RETURN als Abschluss + bne err1 + jmp $FF65 ; Sprung in Monitor + + +errtxt: DB 'Boot error!', 0D + + + ds $FF-(*-start) + +def: db $E0 + + include NIBLE.INC + +write_data + SEC + LDA Q6on,X + LDA Rstate,X + BMI wrdat99 + LDA nible2 + STA temp2 + LDA #0FF + STA Wstate,X ; 5 + ORA Q6off,X ; 4 + PHA ; 3 + PLA ; 4 [sta..sta[ + NOP ; 2 + LDY #04 ; 2 +wrdat1 PHA ; 3 3 + PLA ; 4 4 + JSR wrt_nibl1 ;+13 15 13 + DEY ;--- 2 + BNE wrdat1 ; 40 + 3 + ; --- --- + ; 20+ 20 = 40 + + pagerr wrdat1 + + ; -1 + LDA #0D5 ; 2 + JSR wrt_nibl ; 15 +15 + LDA #0AA ; 2 --- + JSR wrt_nibl ;+15 36 + LDA #0AD ;--- + JSR wrt_nibl ; 32 15 + TYA ; 2 + LDY #56 ; 2 +wrdat11 BNE wrdat3 ; 3 +wrdat2 LDA nible2,Y ; 0 4 +wrdat3 EOR nible2-1,Y ; 5 5 + TAX ; 2 2 + LDA to_nibble,X ; 4 4 + LDX slot10z ; 3 3 + ; --- --- + ; 36 18 + + STA Q6on,X ; 5 + LDA Q6off,X ; 4 + DEY ; 2 + BNE wrdat2 ; 3 + ; --- + ; 14 + 18 = 32 + ; -1 + LDA temp2 ; 3 + NOP ; 2 +wrdat4 EOR nible1,Y ; 4 4 + TAX ; 2 2 + LDA to_nibble,X ; 4 4 + LDX slot10 ; 4 4 + ; --- --- + ; 32 14 + + STA Q6on,X ; 5 + LDA Q6off,X ; 4 + LDA nible1,Y ; 4 + INY ; 2 + BNE wrdat4 ; 3 + ; --- + ; 18+ 14 = 32 + + pagerr wrdat11 + + TAX ; 2 + LDA to_nibble,X ; 4 + LDX slot10z ; 3 + JSR wrt_nibl2 ; 6 15 + LDA #0DE ; --- 2 + JSR wrt_nibl ; 32 15 + LDA #0AA ; --- + JSR wrt_nibl ; 32 + LDA #0EB + JSR wrt_nibl + LDA #0FF + JSR wrt_nibl + LDA Rstate,X +wrdat99 + LDA Q6off,X +wrdat999 + dey + bne wrdat999 ; PostErase-Delay 1 ms + + RTS + +read_hdr + sei + LDY #0FC + STY temp2 +rdhdr0 + INY + BNE rdhdr1 + INC temp2 + BEQ fail +rdhdr1 + LDA Q6off,X + BPL rdhdr1 +rdhdr11 CMP #0D5 + BNE rdhdr0 + + NOP +rdhdr2 LDA Q6off,X + BPL rdhdr2 + CMP #0AA + BNE rdhdr11 + + LDY #03 +rdhdr3 LDA Q6off,X + BPL rdhdr3 + CMP #96 + BNE rdhdr11 + + pagerr rdhdr1 + + + LDA #00 +nxthByte STA chk_sum +rdhdr4 LDA Q6off,X + BPL rdhdr4 + ROL A + STA temp2 +rdhdr5 LDA Q6off,X + BPL rdhdr5 + AND temp2 + STA chk_in_hdr,Y + EOR chk_sum + DEY + BPL nxthbyte + + TAY + BNE fail + +rdhdr6 LDA Q6off,X + bpl rdhdr6 + cmp #0DE + BNE fail + + NOP +rdhdr7 LDA Q6off,X + BPL rdhdr7 + CMP #0AA + BNE fail + + CLC + RTS +fail + SEC + RTS + +moving + LDY #0 +mov0 LDA Q6off,X + JSR mov1 + PHA ; 3 + PLA ; 4 + CMP Q6off,X ; 4 + BNE mov1 ;---- + DEY ; 21 uS + BNE mov0 +mov1 RTS + + +read_data + TXA + ORA #8C + STA ld1+1 + STA ld2+1 + STA ld3+1 + STA ld4+1 + STA ld5+1 + LDA user_data + LDY user_data+1 + STA st5+1 + STY st5+2 + SEC + SBC #54 + BCS rddat1 + DEY + SEC +rddat1 + STA st3+1 + STY st3+2 + SBC #57 + BCS rddat2 + DEY +rddat2 + STA st2+1 + STY st2+2 + + LDY #20 +nxt_begin + DEY + BEQ fail +wait_begin +waitb0 LDA Q6off,X + BPL waitb0 +waitb00 EOR #0D5 + BNE nxt_begin + NOP +waitb1 LDA Q6off,X + BPL waitb1 + CMP #0AA + BNE waitb00 + NOP +waitb2 LDA Q6off,X + BPL waitb2 + CMP #0AD + BNE waitb00 + + LDY #0AA + LDA #0 +rloop1 STA temp2 +ld1 LDX Q6off+60 ; addr modified by read init ! + BPL ld1 + LDA to_bits-96,X + STA nible2-0AA,Y + EOR temp2 + INY + BNE rloop1 + +; +; read nible from disk and convert to user data +; + LDY #0AA + BNE ld2 +rloop2 +st2 STA 1000,Y +ld2 LDX Q6off+60 ; modified by read init + BPL ld2 + EOR to_bits-96,X + LDX nible2-0AA,Y + EOR to_bytes+0,X + INY + BNE rloop2 + + PHA + AND #0FC + LDY #0AA +ld3 LDX Q6off+60 ; modified by read init + BPL ld3 + EOR to_bits-96,X + LDX nible2-0AA,Y + EOR to_bytes+1,X +st3 STA 1000,Y + INY + BNE ld3 + +ld4 LDX Q6off+60 ; modified by read init + BPL ld4 + AND #0FC + LDY #0AC +rloop5 EOR to_bits-96,X + LDX nible2-0AC,Y + EOR to_bytes+2,X +st5 STA 1000,Y +ld5 LDX Q6off+60 ; modified by read init + BPL ld5 + INY + BNE rloop5 + AND #0FC + EOR to_bits-96,X + LDX slot10z + TAY + BNE chk_fail +rloop6 LDA Q6off,X + BPL rloop6 + CMP #0DE + BEQ read_ok + + pagerr wait_begin +chk_fail + SEC + db bit_z +read_ok + clc + PLA + LDY #55 + STA (user_data),Y + RTS + +seekT lda iob_trk +seekL + jsr trk_to_ph + cmp phase0,X + cmp phase1,X + cmp phase2,X + cmp phase3,X + LDY disk_no + LDA head_table,y ; da steht der Kopf jetzt + STA head_pos + lda dest_phase + sta head_table,y ; da soll er nachher stehen + +seekH + cmp head_pos + BEQ seek_rts + LDA #0 + STA temp2 +seekh0 LDA head_pos + STA phase + SEC + SBC dest_phase + BEQ seekh5 + BCS seekh1 + EOR #0FF + INC head_pos + BCC seekh2 +seekh1 ADC #0FE + DEC head_pos +seekh2 CMP temp2 + BCC seekh3 + LDA temp2 +seekh3 CMP #8 + BCS seekh4 + TAY +seekh4 SEC + JSR step + LDA time0,Y + JSR step_wait + LDA phase + CLC + JSR step1 + LDA time1,Y + JSR step_wait + INC temp2 + BNE seekh0 + +seekh5 JSR step_wait + CLC +step LDA head_pos +step1 AND #3 + ROL A + ORA slot10z + TAX + LDA phase0,X + LDX slot10z +seek_rts RTS + +;-------------------------------; + +make_nibl + LDY #56 + LDA #0 +maken0 STA nible2-1,Y + DEY + BNE maken0 +maken1 LDX #55 +maken2 LDA (user_data),Y + AND #0FC + STA nible1,Y + EOR (user_data),Y + INY + CMP #02 + ORA nible2,X + ROR A + ROR A + STA nible2,X + DEX + BPL maken2 + CPY #02 + BNE maken1 + RTS + +; ds 10 + +Dsk_RW + ldx #0A9 ; LDA #xx + lda def_byte + and #$20 ; Bit 5 ? + bne rw_0 ; Fast Step - use abs. value + + ; Slow Step - use MotorOn/Off-Tables + ldx #0C9 ; CMP #xx +rw_0: stx step_wait + + lda #fast_step ; Set Step Rate + bit def_byte + bmi rw_1 ; Bit7: Controller-Typ + ; Bit7=0 => Ehring + lsr a ; bei Ehring 2-fache Phases => halbe Steprate + +rw_1: sta step_wait+1 ; Steprate + + lda disk_no + LSR A + TAY + LDA slotn,Y + STA slot10 + sta slot10z + adc #0 + STA iob_drv + + include TRACK.INC + +trk_to_ph: ; IN: A = track / OUT: A,dest_phase = phase + sta dest_phase + +; Select Side 0 + + bit def_byte ; Bit7: 1=Erphi-Controller + ; Bit6: 1=Erphi-Format + + bvc ehring_format ; Bit6 = 0 => Ehring-Format + + lsr dest_phase ; Erphi-Format + bcc side0 + +; Select Side 1 +; Erphi: mtroff, Q6on, mtron +; Ehring: mtroff,mtron + +side1: lda mtroff,x + bit def_byte + bpl side1_2 + ; Erphi-Side-1-Select + lda Q6on,x +side1_2: + lda mtron,x + jmp ph_mult + +ehring_format: + cmp #$50 ; Track >= 80 ? + bcc side0 ; nein: Select Side 0 + + sbc #$50 + sta dest_phase + jmp side1 + +; Select Side 0 +; Ehring: lda cn00,x +; Erphi : mtroff, Q6off, mtron + +side0: bit def_byte + bmi erphi_s0 ; Bit7 = 1 => Erphi-Controller + + txa ; Ehring-Side-0-Select + lsr a + lsr a + lsr a + lsr a + ora #$C0 + sta ehr_sel+2 + +ehr_sel:lda $C600 + jmp ph_mult + +erphi_s0: ; Erphi-Side-0-Select + cmp mtroff,x + cmp Q6off,x + cmp mtron,x + +ph_mult: + lda def_byte ; Bit 0..1: 0 = 1 Step/Track + and #03 ; 1 = 2 Steps/Track + tay ; 2 = 4 Steps/Track + beq ph_mult2 + +ph_mult1: + asl dest_phase + dey + bne ph_mult1 + +ph_mult2: + lda dest_phase + rts + +load_shard: + +load_0: lda #$10 + ldx #1 ; Track 1 + jsr loadtrack + bne load_0 + +load_1: lda #$20 + ldx #2 ; Track 2 + jsr loadtrack + bne load_1 + +load_2: lda #$30 + ldx #3 ; Track 3 + jsr loadtrack + bne load_2 + +load_3: lda #$40 + ldx #4 ; Track 4 + jsr loadtrack + bne load_3 + + + lda #HIGH VOLTAB + sta vpoint+1 + lda #LOW VOLTAB + sta vpoint + ldx #8 +loop2: lda eumel_vol,x + sta VOLTAB,x + dex + bpl loop2 + + lda #$C3 + sta 0 + lda #$00 + sta 1 + lda #$10 + sta 2 ; JP $1000 - 64180 + lda #0 + sta task + sei + ldx #leng1-1 +lp1: + lda codp,x + sta 8000,x + dex + bpl lp1 + jmp 8000 + +codp: + ldx #$70 ; Karte in Slot 7 + stx $04F8 + lda start180,x ; Start 64180 +loop: + lda task + cmp #4 + bne loop ; Auf Adress-Task warten + + jmp (1) ; Neue Taskloop anspringen +leng1 equ $-codp + +loadtrack: + stx iob_trk + tax + dex + txa + ldx #0 + ldy #0 +boot31: pha + lda #0 + sta sec_tble,y + sta DMA,x + pla + clc + adc #1 + sta DMA+1,x + inx + inx + iny + cpy #10 + bne boot31 +; +; Steprate einstellen und andere Disk Voreinstellungen +; + sty sec_cnt ; := 10 read track, sector 0..F + ldx #0f + stx iob_err ; StepRate + ldx #0 + stx disk_no ; := 0 + dex + stx param ; := FF (read) + jsr dsk_rw + lda iob_err + rts + + +eumel_vol: + 40H, 00H, 4AH, 60H, 00H, 00H, 0B3H, 00H, 0FFH + ; Default, ggf. Aendern + + END + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/FBOOT.SYM b/system/shard-z80-ruc-64180/1.5/src/FBOOT.SYM new file mode 100644 index 0000000..7939c68 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/FBOOT.SYM @@ -0,0 +1,2 @@ + + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/GRAFIK65.MAC b/system/shard-z80-ruc-64180/1.5/src/GRAFIK65.MAC new file mode 100644 index 0000000..fa89db3 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/GRAFIK65.MAC @@ -0,0 +1,1636 @@ +; +;**************************************************************** +; +; EUMEL-SHard Graphikroutinen fuer 6502-Teil. +; Anfang: 20.05.86, Michael Staubermann +; Version 1.2, Mit Incremental-Fill, dicke Striche, COPY-Modus +; Stand: 12.01.87 +; + .printx 'GRAFIK65.MAC' + +;---------------------------------------------------------------------------- +; V A R I A B L E +;---------------------------------------------------------------------------- +; +; Konstante + +bit_a EQU 2C ; Skip 2 Bytes + +; Switches + +graphic_mode EQU $C050 +text_mode EQU $C051 +full_graphics EQU $C052 +page_1 EQU $C054 +hires_mode EQU $C057 +lc_00 EQU $C083 +lc_01 EQU $C08B + +;---------------------------------------------------------------------------- +; +; G R A P H I K Einsprung fuer alle Graphiksubtasks +; +; Eingang: $81 Subtasknummer +; 0 = Move (x, y) +; 1 = Draw (x, y) +; 2 = Testbit (x, y) --> $81 +; 3 = Control (on/off, bank, page, or/and/xor, +; patternsource, colour, pattern) +; 4 = Clear (page) +; 5 = Fill (muster) +; 6 = Trans (page a) to (page b) +; +; Ausgang: $81 (Nur bei Testbit) +; +;---------------------------------------------------------------------------- + +GRAFIK: + lda subtask ; 0 - 6 + cmp #7 + bcc grafik1 + rts ; unerlaubt + +grafik1: + asl a + tax + lda gfunct,x + sta 1 + lda gfunct+1,x + sta 2 ; 1/2 Sprungadressen + jmp (1) ; Funktion aurufen + +gfunct: + dw gmove, gdraw, gtest, gctrl, gclr, gfill, gtrans + +;--------------------------------------------------------------------- +; +; G M O V E +; Graphikcursor auf Position (x, y) setzen +; +; Eingang: param1 = xpos +; param2 = ypos +; +GMOVE: + lda param1 + sta xpos ; LOW xpos + lda param1+1 + sta xpos+1 ; HIGH xpos + lda param2 + sta ypos ; LOW ypos + lda param2+1 + sta ypos+1 ; HIGH ypos + +move_x: + lda savepattern + sta pattern + lda savepattern+1 + sta pattern+1 ; Linetypepattern auf Anfangswert + rts + +;--------------------------------------------------------------------- +; +; G D R A W +; Linie zur Position (x, y) zeichen +; +; Eingang: param1 = xpos +; param2 = ypos +; +GDRAW: + IF 0 + lda param1 + pha ; 'to' Parameter retten + lda param1+1 + pha + lda param2 + pha + lda param2+1 + pha + ENDIF + jsr draw ; draw (xpos,ypos TO param1,param2) + IF 0 + pla + sta ypos+1 + pla + sta ypos + pla + sta xpos+1 + pla + sta xpos + ENDIF + rts + +;--------------------------------------------------------------------- +; +; G T E S T +; Punkt (x, y) testen +; +; Eingang: param1 = xpos +; param2 = ypos +; Ausgang: param = result = Flags +; +GTEST: + lda param2+1 ; HIGH y + bne ytohigh ; Carry is set + lda param1+1 ; HIGH x + ldx param1 ; LOW x + ldy param2 ; LOW y + jsr calcaddr ; Byteaddresse des Punktes berechnen +ytohigh: lda #$FF ; 255 = Falsche Punktposition + bcs testrts ; Return mit Ergebnis + ldy #00 + lda (address),y + php ; Farbbit merken + and bitmask,x ; Pixel ausmaskieren + beq testcolor + lda #01 ; Bit 0 : Zustand des gesuchten Pixels +testcolor: plp + bpl testrts + ora #80 ; Bit 7 : Farbe +testrts: sta result + rts + +;--------------------------------------------------------------------- +; +; G C T R L +; Verschiede Steuerfunktionen +; +; Eingang: param1 s.u. +; Steuerbits: +; 0: 0 = graphik off +; 1 = graphik on +; 1: 0 = Sichtbare Seite 0 +; 1 = Sichtbare Seite 1 +; 2: 0 = Bearbeitete Seite 0 (2000..3FFF) +; 1 = Bearbeitete Seite 1 (4000..5FFF) +; 3,4: 0 = OR (Setzen) +; 1 = AND (Loeschen) +; 2 = XOR (Invertieren) +; 3 = COPY (kopieren = loeschen/setzen) +; 5: 0 = Full Graphics display +; 1 = Mixed Graphics display (4 Zeilen Text) +; 6: 0 = param2 ist Linetypepattern +; 1 = savepattern ist Linetypepatt. +; 7: 0 = Violett +; 1 = Gelb +; 8..11 = Strichdicke +; +; param2 ist 16Bit Pattern (falls Bit 6 = 0) +; +GCTRL: + lda param1 ; Steuerbits + and #80 ; Bit 7 = Farbe + sta colormask + + lsr param1 ; Bit 0 = Graphik on/off + bcs graphon + + lda text_mode + lda page_1 + bcc bit12 + +graphon: lda graphic_mode + lda hires_mode + + lda param1 ; Bit 2 = Page + and #01 + tax + sta page_1,x ; Page Select + +bit12: lsr param1 ; Bit 1 ins Carry + lsr param1 ; Bit 2 ins Carry + bcs page2sel + lda #20 + db bit_a +page2sel: lda #40 + sta pagebase + + lda param1 + and #03 ; Bit 3,4 = Bitmode + sta bitmode + lsr param1 ; Bit 3 ins Carry + lsr param1 ; Bit 4 ins Carry + + lda param1+1 + and #0F + bne setthick + lda #1 ; Default 0: 1 Strich +setthick: + sta thick ; Strichdicke in 8..11 + + lda param1 ; Bit 5 = full (0) or mixed (1) Graph. + and #01 + tax + sta full_graphics,x + lsr param1 ; Bit 5 ins Carry + + lsr param1 ; Bit 6 ins Carry + bcs saved + + lda param2 ; Parameter 2 (Word) Pattern + sta pattern ; in interne Linepattern kopieren + sta savepattern + lda param2+1 + sta pattern+1 + sta savepattern+1 + bcc ctrlret + +saved: + lda pattern ; Internes Savepattern als Workpattern + sta savepattern ; benutzen + lda pattern+1 + sta savepattern+1 + +ctrlret: rts + +;--------------------------------------------------------------------- +; +; G C L R +; Graphikseite loeschen, bzw. mit einem Bitmuster fuellen +; +; Eingang: param1 = Seite (0..3) +; param2 = Byte (0..255) +; +GCLR: + lda param1 + jsr page_addr ; Anfangsaddresse der Page --> A + ; y := 0 + sta address+1 + sty address + ldx #20 ; 32 Pages + lda param2 +gclr1: + sta (address),y + iny + bne gclr1 + inc address+1 + dex + bne gclr1 + rts + +page_addr: + and #3 + asl a + asl a + asl a + asl a + asl a + adc #20 ; + Offset fuer erste Grafikseite + ldy #0 + rts + +;--------------------------------------------------------------------- +; +; G F I L L +; Umrandete Flaeche Fuellen +; +; Eingang: param1 = Nummer des Fuellmusters +; +GFILL: + lda lc_01 + lda lc_01 ; Select Page 1 D000..DFFF (Stack) + lda param1 + jsr fill + lda lc_00 + lda lc_00 ; Select Page 0 D000..DFFF (Spooler) + rts + + +;--------------------------------------------------------------------- +; +; G T R A N S +; Graphikseite in eine andere Grafikseite kopieren +; +; Eingang: param1 = 'from'-Page (0..3) +; param2 = 'to'-Page (0..3) +; +GTRANS: + lda param1 + jsr page_addr + sta address+1 ; 'from' - Pagebase + sty address + + lda param2 + jsr page_addr + sta param1+1 + sty param ; 'to' - Pagebase + ldx #20 ; 32 Pages + +gtrans1: + lda (address),y + sta (param1),y + iny + bne gtrans1 + inc address+1 + inc param1+1 + dex + bne gtrans1 + rts + +;-------------------------------------------------------------------------- +; Umrandete Graphikflaeche (xpos, ypos) ausfuellen +; Musternummer in A + +FILL: + and #0F ; 16 Muster a 64 Bit + asl a ; *8 (8 Bytes pro Muster) + asl a + asl a ; Offset auf Muster + sta olderror+1 + lda pagebase + sta olderror ; Merken + lda #wrkpage ; Workpage (alter Inhalt geloescht!) + sta pagebase + jsr fill1 ; ggf POP Returnaddress + lda olderror + sta pagebase ; restoren + rts + +fill1: + lda bitmode + and #1 + sta creg + + + lda #2 + sta areg+1 ; stackpointer + lda ypos+1 + bne fill1d ; Out of Window + ldx xpos + stx xa ; xpos low (fuer Muster) + lda xpos+1 + sta xb + ldy ypos + sty ya ; yposlow (fuer Muster) + jsr startxy + bcc fill1c +fill1d: rts ; Ausserhalb oder auf Punkt + +fill1c: + ldx #wrkpage + stx address+1 + ldx olderror ; Echte Seite + stx link+1 + ldx #20 ; 8k + ldy #0 + sty address + sty link +fill1b: lda (link),y ; Echte Seite in Arbeitsseite kopieren + sta (address),y ; Arbeitsseite loeschen + iny + bne fill1b + inc address+1 + inc link+1 + dex + bne fill1b + lda xpos+1 + ldx xpos + ldy ypos + jsr startxy + +fill2: + ldy creg+1 ; Byte Offset + ldx breg+1 ; Bit Offset + jsr testquick ; Bei (x,y) Punkt gesetzt ? + bcc fill2h ; Punkt gesetzt + jsr poppos + jmp fill2 + ; (x-1, y) testen +fill2h: lda breg+1 + sta dx + lda creg+1 + sta dx+1 + lda xa + sta xa+1 ; Save xpos + lda xb + sta xb+1 + + lda xa + bne fill2d2 + dec xb +fill2d2: dec xa + jsr decx ; x-1, y bleibt + bcs fill2d + jsr testquick + bcc fill2h + +fill2d: lda dx ; Altes x wiederherstellen + sta breg+1 ; (Der letzte Punkt vorm linken + lda dx+1 ; Rand) + sta creg+1 + lda xa+1 + sta xa + lda xb+1 + sta xb + +fill4: ; (x, y-1) testen + lda address ; ypos retten + sta dy + lda address+1 + sta dy+1 + lda breg + sta yb + lda ya ; ypos low + sta ya+1 + + dec ya + jsr decy ; y-1 + bcs fill2a + jsr testquick + bcs fill2a + jsr clrstack ; Hier auch 'pushpos' + +fill2a: ; (x, y+1) testen + jsr incy + bcs fill2e + jsr incy + bcs fill2e + inc ya + inc ya + jsr testquick + bcs fill2e + jsr clrstack ; Hier auch 'pushpos' +fill2e: ; Altes y wiederherstellen + lda dy + sta address ; ypos widerherstellen + lda dy+1 + sta address+1 + lda yb + sta breg + lda ya+1 + sta ya + + jsr pointquick + + inc xa + bne fill2g + inc xb +fill2g: jsr incx + bcs fill2i + jsr testquick + bcc fill4 ; Punkt bei (x+1, y) ? +fill2i: jsr poppos ; Gerettete x/y Pos vom Stack + jmp fill2 ; Damit nochmal (pseudorekursion) + +;-------------------------------------------------------------------------- +; Hilfsroutinen fuer 'GFILL' + +testquick: + lda (address),y + and bitmask,x + beq testquick1 ; Kein Punkt gesetzt + lda #1 +testquick1: eor creg ; umdrehen, falls AND/COPY + lsr a ; SEC/CLC + rts + +pointquick: + lda ya ; ypos low + and #7 + ora olderror+1 ; Offset auf Muster + tay + lda xa + and #7 + tax + lda bitmask,x ; xpos Bit + and muster,y ; ypos Byte + sta yb+1 ; 0, wenn kein Punkt gesetzt + + ldx breg+1 + ldy creg+1 + lda (address),y + eor bitmask,x ; Bei OR loeschen, bei AND setzen! + sta (address),y ; Zum Merken in Workpage + ; Test, ob auch in echter Seite Punkt + lda yb+1 + beq pointquick1 ; Nicht mehr in echter Seite setzen + lda address+1 + pha + and #$1F ; Nur 8k Bits + ora olderror ; Echte pagebase + sta address+1 + lda (address),y + and #$7F + ora colormask + eor bitmask,x + sta (address),y ; In echter Seite setzen + pla + sta address+1 + +pointquick1: rts + +poppos: ; x/y Pos vom Stack holen + ldx areg+1 ; stackpointer + cpx #2 + beq poppos1 + dex ; ? ggf beq poppos1 + beq poppos1 + + lda stack+000,x ; xpos + sta breg+1 + lda stack+100,x + sta creg+1 + + lda stack+200,x ; ypos + sta address + lda stack+300,x + sta address+1 + lda stack+400,x + sta breg + + lda stack+500,x ; xpos low + sta xa + lda stack+600,x ; xpos high + sta xb + lda stack+700,x ; ypos low + sta ya + stx areg+1 ; stackpointer + rts +poppos1: + pla + pla + rts ; Fill verlassen + + +clrstack: ; Stack aufraeumen und pushpos + ldx #$FE ; creg+1, da Neues startxy gegeben wird + stx yb+1 ; Flag, ob zweites mal clrstack + ldx areg+1 ; stackpointer +clrstack4: dex + lda stack+700,x + cmp ya + bne clrstack3 + lda stack+600,x ; (stack)+1 --> temp (in A/Y) + ldy stack+500,x + iny + bne clrstack2 + clc + adc #1 +clrstack2: cmp xb ; Stacktop = xpos-1 ? + bne clrstack3 + cpy xa + bne clrstack3 + + lda breg+1 ; xpos replacen + sta stack+000,x + lda creg+1 + sta stack+100,x + lda xa + sta stack+500,x + lda xb + sta stack+600,x + rts + +clrstack3: inc yb+1 ; Flag fuer 2. Durchlauf + bne clrstack4 + +pushpos: ; xpos/ypos auf Stack bringen + ldx areg+1 ; stackpointer + lda breg+1 + sta stack+000,x + lda creg+1 + sta stack+100,x + lda address + sta stack+200,x + lda address+1 + sta stack+300,x + lda breg + sta stack+400,x + lda xa + sta stack+500,x + lda xb + sta stack+600,x + lda ya + sta stack+700,x + inx + beq pushpos1 ; Stackoverflow + stx areg+1 ; stackpointer +pushpos1: rts + +;=========================================================================== +; Incremental Adresses +; Belegt breg = rowstartoffset, breg+1 = x-reg = bitoffset +; creg+1 = y-reg = xbyte offset, +; address/address+1 = Byteaddresse +; +; Fuer jede Routine gilt: +; Ausgang: X = Bitoffset, Y = Byteoffset, SEC = Out of Window +; Trat SEC auf, ist die aktuelle Position unveraendert (!) +; Beispiel: jsr incy +; bcs fehler +; lda (address),y +; and bitmask,x + +;--------------------------------------------------------------------------- +; Start Scan +; +; Eingang: A: HIGH xpos +; X: LOW xpos +; Y: LOW ypos + +STARTXY: + cmp #02 ; xpos >= 512 ? + bcc startxy1 +startxy2: rts ; Carry is Set +startxy1: cmp #01 + bne startxy3 ; xpos < 256 + cpx #18 ; xpos >= 280 ? + bcs startxy2 ; Bereichsfehler +startxy3: cpy #$C0 ; ypos >= 192 ? + bcs startxy2 + + pha ; xpos (HIGH) retten + tya + pha + +; adr := rowstart [ypos DIV 8] + (ypos MOD 8) * 1024 + xpos DIV 7 + + lsr a ; ypos DIV 8 + lsr a + lsr a + asl a ; Fuer Tabellenzugriff * 2 (Bit 0 = 0) + tay + sty breg ; rowstart Offset + lda rowstart,y ; Tabelle der Zeilenanfaenge + sta address + lda rowstart+1,y + clc + adc pagebase + sta address+1 + pla ; ypos + and #07 ; MOD 8 + eor #07 ; y = 0 ist unten links + asl a ; * 4 (* 256) + asl ; Carry is cleared + adc address+1 ; Mikrozeile addieren + sta address+1 + pla ; xpos (HIGH) --> Y + tay + txa ; xpos (LOW) --> A + jsr divide7 ; A/Y --> A (Quotient), X (Remainder) + sta creg+1 + tay ; y-reg = Byteoffset + stx breg+1 ; Bitoffset + clc ; Carry cleared = ok + rts + +;------------------------------------------------------------------------- +; Increment actual y + +INCY: + lda address+1 + and #1C + beq incy1 ; naechste Mikrozeile + lda address+1 + sec + sbc #4 + sta address+1 + clc ; ok +incy2: ldy creg+1 + ldx breg+1 + rts + +incy1: ldy breg + iny + iny ; naechste Makrozeile + cpy #30 ; tabellenende ? + bcs incy2 ; Fehler, nichts veraendert + sty breg + lda rowstart,y + sta address ; Carry war cleared + lda rowstart+1,y + adc pagebase + adc #1C ; 7. Mikrozeile + sta address+1 + bcc incy2 ; Always + +;-------------------------------------------------------------------------- +; Decrement actual y + +DECY: + lda address+1 + and #1C + cmp #1C ; 7. Mikrozeile ? + beq decy1 ; naechste Mikrozeile + lda address+1 + adc #4 + sta address+1 +decy2: ldy creg+1 + ldx breg+1 + rts + +decy1: ldy breg ; naechste Makrozeile + sec + beq decy2 ; Out of Window ? + dey + dey + sty breg + lda rowstart,y + sta address + clc + lda rowstart+1,y + adc pagebase + sta address+1 + bcc decy2 ; Always + +;------------------------------------------------------------------------- +; Increment actual x + +INCX: + ldy creg+1 + ldx breg+1 + cpx #6 + bcs incx1 + inx + clc +incx2: stx breg+1 ; y schon = creg+1 + rts + +incx1: inc creg+1 + iny + ldx creg+1 + cpx #28 ; Out of Window ? + ldx #0 + bcc incx2 ; CLC: ok + dec creg+1 ; Wieder Rueckgaengig + rts + +;----------------------------------------------------------------------- +; Decrement actual x + +DECX: + ldy creg+1 + ldx breg+1 + beq decx1 + dex +decx2: stx breg+1 ; y schon creg+1 + rts + +decx1: ldx #6 + dec creg+1 + dey + clc + bpl decx2 ; < 0 ? + sec ; Out of Window ! + inc creg+1 ; Alter Zustand + rts + + +;========================================================================== +; Absolute Adresses + +;-------------------------------------------------------------------------- +; +; C A L C A D D R +; Berechnet die Addresse eines Pixels +; +; Eingang: A: HIGH xpos +; X: LOW xpos +; Y: ypos +; Ausgang: address,address+1: Addresse des Bytes mit Pixel +; Carry: Set = Pixelpos ausserhalb des Fensters +; X: Bitnummer im addressierten Byte (0..6) +;--------------------------------------------------------------------------- + +CALCADDR: + cmp #02 ; xpos >= 512 ? + bcc less512 +rangeerr: rts ; Carry is Set +less512: cmp #01 + bne xposok ; xpos < 256 + cpx #18 ; xpos >= 280 ? + bcs rangeerr ; Bereichsfehler +xposok: cpy #$C0 ; ypos >= 192 ? + bcs rangeerr + + pha ; xpos (HIGH) retten + tya + pha + +; adr := rowstart [ypos DIV 8] + (ypos MOD 8) * 1024 + xpos DIV 7 + + lsr ; ypos DIV 8 + lsr + lsr + asl ; Fuer Tabellenzugriff * 2 (Bit 0 = 0) + tay + lda rowstart,y ; Tabelle der Zeilenanfaenge + sta address + lda rowstart+1,y + clc + adc pagebase + sta address+1 + pla ; ypos + and #07 ; MOD 8 + eor #07 ; y = 0 ist unten links + asl ; * 4 (* 256) + asl ; Carry is cleared + adc address+1 + sta address+1 + pla ; xpos (HIGH) --> Y + tay + txa ; xpos (LOW) --> A + jsr divide7 ; A/Y --> A (Quotient), X (Remainder) + clc + adc address + sta address + bcc calcret + inc address+1 + clc ; Carry cleared = ok +calcret: rts + +;----------------------------------------------------------------------------- +; +; N E G +; Vorzeichenwechsel +; Eingang/Ausgang: A/X (HIGH/LOW) +;----------------------------------------------------------------------------- + +NEG: pha + txa + eor #$FF + clc + adc #01 + tax + pla + eor #$FF + adc #00 + rts + +;--------------------------------------------------------------------------- +; +; D I V I D E 7 +; Division durch 7 mit Rest +; Eingang: A: Low, Y: High (Nur 0 oder 1) +; Ausgang: A: Quotient (Auch in quotient) +; X: Rest +;-------------------------------------------------------------------------- + +DIVIDE7: + ldx #00 ; Quotient Schieberegister loeschen + stx quotient + ldx #$E0 ; 224 = 7 * 2^5 als Startwert + stx divmask + ldx #06 ; Anzahl Verschiebungen + cpy #01 ; Zahl > 255 ? + bne shiftloop ; Carry is set + inc quotient + adc #1F ; (Zahl MOD 256) + 32 + bne shift2loop ; Erste Subtraktion ueberspringen + +shiftloop: sec + sbc divmask ; Probeweise subtrahieren + php ; Borrow merken + rol quotient ; Borrow in quotient rotieren + plp + bcs shift2loop + adc divmask ; Falls zuviel subtrahiert wieder add. +shift2loop: lsr divmask ; Dann nur noch die Haelfte subtr. + dex + bne shiftloop + tax ; Rest der Division + lda quotient ; Quotient + rts + +;---------------------------------------------------------------------------- +; +; P O I N T +; Setzt/Loescht Punkt an bestimmter Position +; Eingang: Position in xpos/ypos +; Linepattern in pattern +; Farbmaske in colormask +; Bitmodus in bitmode +;--------------------------------------------------------------------------- + +;DOPOINT: +; ldy bitmode +; bpl patternres ; Always + +POINT: + ldy bitmode + asl pattern + rol pattern+1 + bcs patternset + cpy #03 ; Copymodus + bne pointret ; Keine Aktion + ldy #01 ; Loeschen + bne patternres ; Always + +patternset: inc pattern ; 1 links im pattern setzen +patternres: sty tempmode + lda ypos+1 + bne pointret + lda xpos+1 + ldx xpos + ldy ypos +;MAKEDOT: + jsr calcaddr ; Punktaddresse berechnen + bcs pointret ; Ausserhalb des Bildschirms + ldy #00 + lda (address),y + ldy tempmode + bne mode1 + +mode0: ora bitmask,x ; Modus 0 = setzen + bcc setcolor + +mode1: dey + bne mode2 + and notbitmask,x ; Modus 1 = loeschen + bcc setcolor + +mode2: dey + bne mode0 ; Modus 3 (copy) wie Modus 0 + eor bitmask,x ; Modus 2 = invertieren + bcc setcolor + +setcolor: ldy #00 + and #7F ; Altes Farbbit loeschen + ora colormask ; Farbbit neu setzen + sta (address),y ; Graphikbyte zurueckschreiben +pointret: rts + + +;----------------------------------------------------------------------------- +; Drawthick zeichnet eine dicke Linie + +drawthick: + lda param1 + pha + lda param1+1 + pha ; to-pos retten + lda param2 + pha + lda param2+1 + pha + + lda savepattern + pha + lda savepattern+1 + pha + lda pattern ; Linetype auf Startwert + sta savepattern + lda pattern+1 + sta savepattern+1 + + dec thick + +; x- oder y- Richtung feststellen: +; x direction := abs (xto - xfrom) > abs (yto - yfrom) + + lda param1 + sec + sbc xpos + tax + lda param1+1 + sbc xpos+1 + bcs drawthick1 + jsr NEG ; Absolutwert (A/X) +drawthick1: sta dx+1 + stx dx + + lda param2 + sec + sbc ypos + tax + lda param2+1 + sbc ypos+1 + bcs drawthick2 + jsr NEG ; Absolutwert (A/X) +drawthick2: pha + txa + sec + sbc dx + pla + sbc dx+1 ; Nur das Vorzeichen wichtig + pha ; xdirection, wenn A < 0 + +; Start- und Endpunkt der mittleren Linie berechnen + + bpl drawthick3 ; y direction + +; start.x := xfrom - thick x ; to.x := xto + thick x +; start.y := yfrom ; to.y := yto +; thick x : IF xto < xfrom THEN -thick ELSE +thick FI + + lda param1 + sec + sbc xpos ; xto - xfrom + lda param1+1 + sbc xpos+1 + bcs drawthick4 ; xto >= xfrom (xto-xfrom >= 0) + ; xto < xfrom + lda xpos ; Carry is cleared + adc thick + sta xa ; start.x + lda xpos+1 + adc #0 + sta xa+1 + + lda param1 ; to.x + sec + sbc thick + sta xb + lda param1+1 + sbc #0 + sta xb+1 + jmp drawthick5 + +drawthick4: + lda xpos ; Carry is set + sbc thick + sta xa + lda xpos+1 + sbc #0 + sta xa+1 + + lda param1 + clc + adc thick + sta xb + lda param1+1 + adc #0 + sta xb+1 + +drawthick5: +; start.y := ypos ; to.y := param2 + lda ypos + sta ya + lda ypos+1 + sta ya+1 + lda param2 + sta yb + lda param2+1 + sta yb+1 + jmp drawthick8 + +drawthick3: ; x direction + +; start.x := xfrom ; to.x := xto +; start.y := yfrom - thick y ; to.y := yto + thick y +; thick y : IF yto < yfrom THEN -thick ELSE +thick FI + + lda param2 + sec + sbc ypos ; yto - yfrom + lda param2+1 + sbc ypos+1 + bcs drawthick6 ; yto >= yfrom (yto-yfrom >= 0) + ; yto < yfrom + lda ypos ; Carry is cleared + adc thick + sta ya ; start.y + lda ypos+1 + adc #0 + sta ya+1 + + lda param2 ; to.y + sec + sbc thick + sta yb + lda param2+1 + sbc #0 + sta yb+1 + jmp drawthick7 + +drawthick6: + lda ypos ; Carry is set + sbc thick + sta ya + lda ypos+1 + sbc #0 + sta ya+1 + + lda param2 + clc + adc thick + sta yb + lda param2+1 + adc #0 + sta yb+1 + +drawthick7: +; start.x := xpos ; to.x := param1 + lda xpos + sta xa + lda xpos+1 + sta xa+1 + lda param1 + sta xb + lda param1+1 + sta xb+1 + +;------ +; FOR diff FROM -thick TO thick REP drawsingl PER + +drawthick8: + ldx thick + lda #0 + jsr NEG ; -thick + sta areg+1 + stx areg ; = diff + +drawthick11: + ldx areg + lda areg+1 + bne drawthick9 + cpx thick ; > +thick ? + beq drawthick9 + bcc drawthick9 + +; PER ; restore pattern + + pla ; x direction + inc thick + pla + sta savepattern+1 + sta pattern+1 + pla + sta savepattern + sta pattern + pla + sta param2+1 ; To-Pos restoren + pla + sta param2 + pla + sta param1+1 + pla + sta param1 + lda param1 + sta xpos + lda param1+1 + sta xpos+1 + lda param2 + sta ypos + lda param2+1 + sta ypos+1 + rts + +; singlevector: + +drawthick9: + pla + pha ; xdirection ? + bpl drawthick10 ; y direction + +; move (start.x, start.y-diff) ; +; draw (to.x, to.y-diff) ; + + lda xa + sta xpos + lda xa+1 + sta xpos+1 ; xpos := start.x + lda ya + sec + sbc areg + sta ypos + lda ya+1 + sbc areg+1 + sta ypos+1 ; ypos := start.y - diff + jsr move_x + + lda xb ; xto := to.x + sta param1 + lda xb+1 + sta param1+1 + lda yb ; yto := to.y - diff + sec + sbc areg + sta param2 + lda yb+1 + sbc areg+1 + sta param2+1 + jsr drawsglvec ; Linie von x/ypos nach param1/2 + jmp drawthick12 + +drawthick10: + +; move (start.x + diff, start.y) ; +; draw (to.x + diff, to.y) ; + + lda xa + clc + adc areg + sta xpos ; xpos := start.x + diff + lda xa+1 + adc areg+1 + sta xpos+1 + lda ya ; ypos := start.y + sta ypos + lda ya+1 + sta ypos+1 + jsr move_x + + lda xb + clc + adc areg ; xto := to.x + diff + sta param1 + lda xb+1 + adc areg+1 + sta param1+1 + + lda yb + sta param2 + lda yb+1 ; yto := to.y + sta param2+1 + jsr drawsglvec ; Linie von x/ypos nach param1/2 + +; NEXT diff + +drawthick12: + inc areg + bne drawthick13 + inc areg+1 +drawthick13: jmp drawthick11 ; diff INCR 1 + + +;----------------------------------------------------------------------------- +; +; D R A W +; Linie zwischen zwei Punkten zeichnen +; Eingang: FROM-Position in xpos/ypos +; TO-Position in param1/param2 +; Attribute in bitmode,pattern,colormask +;----------------------------------------------------------------------------- + +DRAW: + +; X-Vektorrichtung bestimmen +; dx := xto - xfrom ; right := sign (dx) ; dx := ABS dx + + lda thick + bne draw1 + rts ; Unsichtbare Linie +draw1: + cmp #1 + beq drawsglvec ; Eine Linie Zeichnen + jmp drawthick + +drawsglvec: + ldy #00 ; Vorzeichen fuer right: positiv + lda param1 ; xto (LOW) + sec + sbc xpos ; xfrom (LOW) + tax + lda param1+1 ; xto (HIGH) + sbc xpos+1 ; xfrom (HIGH) + bpl dxpositiv + jsr NEG ; dx := -dx + dey ; Vorzeichen fuer right: negativ +dxpositiv: sta dx+1 + stx dx + sty right + +; Y-Vektorrichtung bestimmen +; dy := yto - yfrom ; up := sign (dy) ; dy := ABS dy + + ldy #00 ; Vorzeichen fuer up: positiv + lda param2 ; yto + sec + sbc ypos ; yfrom + tax + lda param2+1 + sbc ypos+1 + bpl dypositiv + jsr NEG ; dy := -dy + dey ; Vorzeichen fuer up: negativ +dypositiv: sta dy+1 + stx dy + sty up + +; init vectorloop + + ldx #00 + stx olderror + stx olderror+1 ; olderror := 0 + ldx #xpos ; xpointer zeigt auf xpos + stx xpointer + ldx #ypos + stx ypointer ; ypointer zeigt auf ypos + +; dy > dx ==> dx - dy < 0 ==> Parameter vertauschen + + lda dx + sec + sbc dy ; Ergebnis unwichtig, nur Carry + lda dx+1 ; dx (HIGH) + sbc dy+1 ; dy (HIGH) + bpl dy_lsequal_dx + +; Parameter vertauschen + + lda xpointer ; xpointer und ypointer vertauschen + ldx ypointer + stx xpointer + sta ypointer + + lda up ; up und right vertauschen + ldx right + stx up + sta right + + lda dx ; dx (LOW) und dy (LOW) vertauschen + ldx dy + stx dx + sta dy + + lda dx+1 ; dx (HIGH) und dy (HIGH) vertauschen + ldx dy+1 + stx dx+1 + sta dy+1 + +dy_lsequal_dx: ; vector(xpos, ypos, dx, dy, right, up) + +; uprighterror := dy - dx ; righterror = dy + + lda dy + sec + sbc dx + sta uprighterror + lda dy+1 + sbc dx+1 + sta uprighterror+1 + +; Schleife: dx DECR 1 + +nextpixel: jsr POINT ; POINT (xpos, ypos) + lda dx ; dx = counter = 0 ? + ora dx+1 + bne do_one_step + rts ; Ende der Vektorloop + +do_one_step: + ldx xpointer ; Referenz auf xpos oder ypos + bit right ; right < 0 ? + bpl rightstep ; sonst leftstep +;leftstep: + lda 0,x ; xpos-Referenz DEC 1 + bne xposdec1 + dec 1,x ; Highbyte von xpos +xposdec1: dec 0,x ; Lowbyte von xpos + jmp detdirection +rightstep: + inc 0,x + bne detdirection + inc 1,x + +detdirection: + +; IF abs (olderror + righterror) < abs (olderror + uprighterror) +; THEN do_right_step ELSE do_upright_step FI + +; abs (olderror + uprighterror) = abs1 + + lda olderror + clc + adc uprighterror + tax + lda olderror+1 + adc uprighterror+1 + bpl abs1positiv + jsr NEG ; abs1 := -abs1 (A=HIGH, Y=LOW) +abs1positiv: stx temporary ; Fuer spaetere Subtraktion merken + sta temporary+1 + +; abs (olderror + righterror) = abs2 + + lda olderror + clc + adc righterror + tax + lda olderror+1 + adc righterror+1 + bpl abs2positiv + jsr NEG ; abs2 := -abs2 (A=HIGH, X=LOW) +abs2positiv: + tay ; abs2 (HIGH) retten + txa ; abs2 (LOW) --> A + sec + sbc temporary ; abs1 (LOW) + tya ; Nur Carrybit wesentlich + sbc temporary+1 ; abs1 (HIGH) + bmi do_right_step + +;do_upright_step: + +; ypos INCR up + + ldx ypointer + bit up ; Vorzeichen von up + bpl yposinc1 + + lda 0,x ; ypointer enthaelt Offset ab xpos + bne yposdec1 + dec 1,x +yposdec1: dec 0,x + jmp xyerror + +yposinc1: inc 0,x + bne xyerror + inc 1,x + +xyerror: + +; olderror INCR uprighterror + + lda olderror + clc + adc uprighterror + sta olderror + lda olderror+1 + adc uprighterror+1 + sta olderror+1 + jmp dxdec1 + +do_right_step: + +; olderror INCR righterror + + lda olderror + clc + adc righterror + sta olderror + lda olderror+1 + adc righterror+1 + sta olderror+1 + +dxdec1: + lda dx + bne dxdec + dec dx+1 +dxdec: dec dx + + jmp nextpixel ; zum Schleifenanfang + +;-------------------------------------------------------------------------- +; Muster fuer GFILL: + +muster: + .RADIX 2 + DB 11111111 ; 0: gefuellt + DB 11111111 + DB 11111111 + DB 11111111 + DB 11111111 + DB 11111111 + DB 11111111 + DB 11111111 + + DB 10101010 ; 1: Halb + DB 01010101 + DB 10101010 + DB 01010101 + DB 10101010 + DB 01010101 + DB 10101010 + DB 01010101 + + DB 11111111 ; 2: Waagerecht (grob) + DB 00000000 + DB 00000000 + DB 00000000 + DB 11111111 + DB 00000000 + DB 00000000 + DB 00000000 + + DB 11111111 ; 3: Waagerecht (fein) + DB 00000000 + DB 11111111 + DB 00000000 + DB 11111111 + DB 00000000 + DB 11111111 + DB 00000000 + + DB 10001000 ; 4: Senkrecht (grob) + DB 10001000 + DB 10001000 + DB 10001000 + DB 10001000 + DB 10001000 + DB 10001000 + DB 10001000 + + DB 10101010 ; 5: Senkrecht (fein) + DB 10101010 + DB 10101010 + DB 10101010 + DB 10101010 + DB 10101010 + DB 10101010 + DB 10101010 + + DB 11111111 ; 6: Gerades Raster (grob) + DB 10001000 + DB 10001000 + DB 10001000 + DB 11111111 + DB 10001000 + DB 10001000 + DB 10001000 + + DB 11111111 ; 7: Gerades Raster (fein) + DB 10101010 + DB 11111111 + DB 10101010 + DB 11111111 + DB 10101010 + DB 11111111 + DB 10101010 + + DB 10001000 ; 8: Links Schraffur + DB 00010001 + DB 00100010 + DB 01000100 + DB 10001000 + DB 00010001 + DB 00100010 + DB 01000100 + + DB 10001000 ; 9: Rechts Schraffur + DB 01000100 + DB 00100010 + DB 00010001 + DB 10001000 + DB 01000100 + DB 00100010 + DB 00010001 + + DB 10001000 ; 10: Schraeges Gitter + DB 01010101 + DB 00100010 + DB 01010101 + DB 10001000 + DB 01010101 + DB 00100010 + DB 01010101 + + DB 10101010 ; 11: Punktraster + DB 00000000 + DB 10101010 + DB 00000000 + DB 10101010 + DB 00000000 + DB 10101010 + DB 00000000 + + DB 11111111 ; 12: Mauer + DB 01000000 + DB 01000000 + DB 01000000 + DB 11111111 + DB 00000100 + DB 00000100 + DB 00000100 + + DB 00100010 ; 13: Korb + DB 01010101 + DB 10001000 + DB 10001000 + DB 10001000 + DB 01010101 + DB 00100010 + DB 00100010 + + DB 00000000 ; 14: Wellenlinie + DB 00100010 + DB 01010101 + DB 10001000 + DB 00000000 + DB 00100010 + DB 01010101 + DB 10001000 + +;usermuster: + DB 10000000 ; 15: User (Default: Zickzack) + DB 01000001 + DB 00100010 + DB 00010100 + DB 00001000 + DB 00000000 + DB 00000000 + DB 00000000 + + .RADIX 16 + +;---------------------------------------------------------------------------- +; T A B E L L E N +;---------------------------------------------------------------------------- + +bitmask: db $01, $02, $04, $08, $10, $20, $40, $80 +notbitmask: db $FE, $FD, $FB, $F7, $EF, $DF, $BF, $7F + +; Graphikzeilenanfaenge, Ypos 0 ist unten + +rowstart: + dw 03D0, 0350, 02D0, 0250 + dw 01D0, 0150, 00D0, 0050 + + dw 03A8, 0328, 02A8, 0228 + dw 01A8, 0128, 00A8, 0028 + + dw 0380, 0300, 0280, 0200 + dw 0180, 0100, 0080, 0000 + + .printx 'Ende' + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/GRAFIK80.MAC b/system/shard-z80-ruc-64180/1.5/src/GRAFIK80.MAC new file mode 100644 index 0000000..9850479 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/GRAFIK80.MAC @@ -0,0 +1,203 @@ + TITLE EUMEL-SHard Graphikroutinen, 64180-Teil + +; RUC64180 auf Basis108 +; 19.05.86, Michael Staubermann +; Ueberarbeitet: 11.01.87 + + GLOBAL GMOVE, GDRAW, GTEST, GCTRL + GLOBAL GTRANS, GCLR, GFILL, GRAFIO +; + EXTERNAL WTEND, MEMDMA, HGOP + + INCLUDE HD64180.LIB + .LIST + CSEG + +CTRLMOVE EQU 0 +CTRLDRAW EQU 1 +CTRLTEST EQU 2 +CTRLCTRL EQU 3 +CTRLCLR EQU 4 +CTRLFILL EQU 5 +CTRLTRANS EQU 6 + + +TASK EQU 0F080H ; Task fuer 6502 +RESULT EQU 0F081H ; Subtask und Ergebnis +PARAM1 EQU 0F082H ; xpos oder Parameter +PARAM2 EQU 0F084H ; ypos oder Linepattern + +;........................................................................... +; +; M O V E +; +; Startposition fuer DRAW setzen +; Es findet keine Bereichspruefung statt +; +; Eingang: A = Terminalnummer (Kanal 1) +; DE = xpos (0..279) +; HL = ypos (0..191) +; +GMOVE: + LD B,CTRLMOVE + JR GRAPHIK + +;............................................................................ +; +; D R A W +; +; Linie von Startposition bis zur uebergebenen Position zeichnen +; Ausserhalb des Bildschirms wird nicht gezeichnet +; +; Eingang: A = Terminalnummer (Kanal 1) +; DE = xpos (0..279) +; HL = ypos (0..191) +; +GDRAW: + LD B,CTRLDRAW + JR GRAPHIK + +;............................................................................ +; +; T E S T B I T +; +; Pruefen, ob Punkt gesetzt +; +; Eingang: A = Terminalnummer (Kanal 1) +; DE = xpos (0..279) +; HL = ypos (0..191) +; +; Ausgang: BC = 255 : Position ausserhalb des gueltigen Bereichs +; sonst: Bit 0 = Zustand (0 = geloescht, 1 = gesetzt) +; Bit 7 = Farbe (1 = Gelb, 0 = Violett) +; +GTEST: + LD B,CTRLTEST + JR GRAPHIK + +;........................................................................... +; +; C T R L +; +; Graphikparameter setzen +; +; Eingang: DE = Steuerbits: +; Bit 0: 0 = Textmode, 1 = Graphikmode +; Bit 1: 0 = Sichtbare Seite 0, 1 = Sichtbare Seite 1 +; Bit 2: 0 = Bearbeitete Seite 0, 1 = Bearbeitete Seite 1 +; Bit 3,4: 0 = OR, 1 = NAND, 2 = XOR Zeichnen +; Bit 5: 0 = Full Graphics, 1 = Mixed Graphics +; Bit 6: 0 = Pattern in HL, 1 = Letztes DRAW Pattern +; fuer Linetype benutzen +; Bit 7: 1 = Gelb, 0 = Violett +; HL = Linetype Pattern, wenn Bit 6 = 0 +; +GCTRL: + LD B,CTRLCTRL + JR GRAPHIK + +;............................................................................ +; +; C L E A R +; +; Graphikseite mit einem Fuellzeichen loeschen +; +; Eingang: DE = Page (0..3) +; HL = Fuellzeichen (Byte in L) +; +GCLR: + LD B,CTRLCLR + JR GRAPHIK + +;............................................................................ +; +; F I L L +; +; Umrandete Flaeche fuellen +; +; Eingang: DE = xpos +; HL = ypos +GFILL: + LD B,CTRLFILL + JR GRAPHIK + +;............................................................................ +; +; T R A N S +; +; Transportiert (kopiert) eine Graphikseite in eine andere +; +; Eingang: DE = 'from'-Page (0..3) +; HL = 'to'-Page (0..3) +GTRANS: + LD B,CTRLTRANS + +GRAPHIK: + LD A,B ; Subtasknummer + CALL WTEND ; Busy warten, da in IOCONTROL + POP HL + PUSH HL ; Zweiter Parameter + + DI + IN0 B,(CBR) ; Alte MMU-Einstellung merken + LD C,51H ; Basisspeicher Page 0 + OUT0 (CBR),C + + LD (PARAM1),DE ; 1. Parameter + LD (PARAM2),HL ; 2. Parameter + + LD L,7 ; 6502-Task: Graphik + LD H,A ; Subtask + LD (TASK),HL + LD C,0 ; Als 'ok' vorbesetzen + CP CTRLTEST ; Muss auf Resultat gewartet werden ? + JR NZ,TASKEND + +WAITTEND: LD A,(TASK) ; Darf intensiv auf Taskende warten + AND A + JR NZ,WAITTEND + LD A,(RESULT) + LD C,A + +TASKEND: OUT0 (CBR),B ; Alte MMU-Einstellung wiederherstellen + EI + POP HL + LD B,0 + RET + +;.............................................................................. +; +; G R A F I O +; Blockin/Blockout fuer Graphikpage +; +; Eingang: DE = Blocknummer : 0..15= Page 0 (ggf. sichtbar) +; 16..31= Page 1 (ggf. sichtbar) +; 32..47= Page 2 (nur durch Transfer) +; 48..63= Page 3 (nur durch Transfer) +; +; HL = Hauptspeicheraddresse +; (HGOP) = 1 : Graphikseite --> Hauptspeicher +; (HGOP) = 0 : Hauptspeicher --> Graphikseite +; +GRAFIO: + PUSH AF + PUSH DE + + EX DE,HL ; DE = log. Hauptspeicheradresse + LD A,L + ADD A ; HL * 512 + 2000H + ADD A,20H + LD H,A + LD L,0 + LD BC,512 ; Blockgroesse + LD A,(HGOP) ; Transferrichtung + + CALL MEMDMA ; Block tranportieren + + POP DE + POP AF + LD BC,0 ; Transfer fehlerfrei + RET + + END + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/HD64180.LIB b/system/shard-z80-ruc-64180/1.5/src/HD64180.LIB new file mode 100644 index 0000000..9fed3f4 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/HD64180.LIB @@ -0,0 +1,160 @@ + +; HD64180-Macro-Library - 14.04.85 + + .z80 + .xlist + +CNTLA0 equ 00h +CNTLA1 equ 01h +CNTLB0 equ 02h +CNTLB1 equ 03h +STAT0 equ 04h +STAT1 equ 05h +TDR0 equ 06h +TDR1 equ 07h +TSR0 equ 08h +TSR1 equ 09h +CNTR equ 0ah +TRDR equ 0bh +TMDROL equ 0ch +TMDROH equ 0dh +RLDROL equ 0eh +RLDROH equ 0fh +TCR equ 10h +TMDR1L equ 14h +TMDR1H equ 15h +RLDR1L equ 16h +RLDR1H equ 17h +SAR0L equ 20h +SAR0H equ 21h +SAR0B equ 22h +DAR0L equ 23h +DAR0H equ 24h +DAR0B equ 25h +BCR0L equ 26h +BCR0H equ 27h +MAR1L equ 28h +MAR1H equ 29h +MAR1B equ 2ah +IAR1L equ 2bh +IAR1H equ 2ch +BCR1L equ 2eh +BCR1H equ 2fh +DSTAT equ 30h +DMODE equ 31h +DCNTL equ 32h +IL equ 33h +ITC equ 34h +RCR equ 36h +CBR equ 38h +BBR equ 39h +CBAR equ 3ah +ICR equ 3fh + +hdword macro x + if '&X' eq 'BC' or '&X' eq 'bc' +ww defl 0 ; INIT mit 0, BC=0 + else + if '&X' eq 'DE' or '&X' eq 'de' +ww defl 1 + else + if '&X' eq 'HL' or '&X' eq 'hl' +ww defl 2 + else + if '&X' eq 'SP' or '&X' eq 'sp' +ww defl 3 + else + .printx 'HD-Word-Error' + endif + endif + endif + endif + endm + + +hdreg macro x + ifidn ,<(hl)> +reg defl 6 + else + ifidn ,<(HL)> +reg defl 6 + else + if '&X' eq 'B' or '&X' eq 'b' +reg defl 0 + else + if '&X' eq 'C' or '&X' eq 'c' +reg defl 1 + else + if '&X' eq 'D' or '&X' eq 'd' +reg defl 2 + else + if '&X' eq 'E' or '&X' eq 'e' +reg defl 3 + else + if '&X' eq 'H' or '&X' eq 'h' +reg defl 4 + else + if '&X' eq 'L' or '&X' eq 'l' +reg defl 5 + else + if '&X' eq 'A' or '&X' eq 'a' +reg defl 7 + else + .printx 'HD-Reg Error' + endif + endif + endif + endif + endif + endif + endif + endif + endif + endm + +mlt macro x + hdword x + db 0edh,4ch+ww*10h + endm + +slp macro + db 0edh,076h + endm + +in0 macro x,y + hdreg x + db 0edh,reg*8,y + endm + +out0 macro y,x + hdreg x + db 0edh,reg*8+1,y + endm + +tst macro x ; Test register + hdreg x + db 0edh,reg*8+4 + endm + +otim macro + db 0edh,83h + endm + +otimr macro + db 0edh,93h + endm + +otdm macro + db 0edh,8bh + endm + +otdmr macro + db 0edh,9bh + endm + +tstio macro x + db 0edh,074h,x + endm + +; ENDE der HD64180-Macros + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/IINST.COM b/system/shard-z80-ruc-64180/1.5/src/IINST.COM new file mode 100644 index 0000000..332f731 Binary files /dev/null and b/system/shard-z80-ruc-64180/1.5/src/IINST.COM differ diff --git a/system/shard-z80-ruc-64180/1.5/src/IINST.PAS b/system/shard-z80-ruc-64180/1.5/src/IINST.PAS new file mode 100644 index 0000000..708a10b --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/IINST.PAS @@ -0,0 +1,21 @@ +PROGRAM installationsnummer_setzen ; + { M. Staubermann, 8.2.87 } + +VAR f : FILE ; + buffer : ARRAY[0..63] OF INTEGER ; +BEGIN + assign (f, 'EUMEL.COM') ; + reset (f) ; + blockread (f, buffer, 1) ; + writeln ; + write ('Lizenznummer (GMD) : ', buffer[$23], #13) ; + write ('Lizenznummer (GMD) : ') ; + readln (buffer[$23]) ; + buffer[$24] := succ (buffer[$24]) ; + write ('Installationsnummer: ', buffer[$24], #13) ; + write ('Installationsnummer: ') ; + readln (buffer[$24]) ; + seek (f, 0) ; + blockwrite (f, buffer, 1) ; + close (f) ; +END. \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/INIMOD.MAC b/system/shard-z80-ruc-64180/1.5/src/INIMOD.MAC new file mode 100644 index 0000000..4127c88 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/INIMOD.MAC @@ -0,0 +1,637 @@ + TITLE INIMOD - Hardwareinitialisierung fuer EUMEL 1.8 auf RUC 180 +; + INCLUDE HD64180.LIB +; + .LIST + CSEG +; +;**************************************************************** +; +; INIMOD: Initialisierung fuer EUMEL 1.8 -> RUC 64180 Karte +; +; Version 1.2 - 05.01.87 +; 1.2 mit logischen und physischen Kanaelen +; Version 1.3 - 08.02.87 +; 1.4 - 27.05.87 Console-Texthardcopy m. SHIFT CTRl F12 +; 1.5 - CIO-Printer Haenger beseitigt +vers equ 105 +; +; Copyright (C) 1985, 86, 87 by ruc: +; 1.7.3:Rainer Ellerbrake +; Eggeberger Str. 12 +; 4802 Halle (Westf.) +; +; 1.8.: Michael Staubermann +; Moraenenstr. 29 +; 4400 Muenster-Hiltrup +; +;**************************************************************** +; +; Globale Variable +; + GLOBAL START, ZZZZZZ, ZZZZZD +; +;................................................................ +; +; Externe Variable +; + EXTERNAL SHEND, SHSINF, SHSACC, SHIOCNT, SHOUT, SHBIN, SHBOUT + EXTERNAL INITS, SCCINIT + EXTERNAL RTCOK, TRAP, MEMDMA, SENDMSG + EXTERNAL ADLEISTE, MODECONF, URLK1, URLK2 + EXTERNAL HDOFS, HDLAST, HGBLKS, CPMOFS, CPMLAST, CPMBLKS + EXTERNAL DES6502, PRG6502, LEN65, ST6502 + EXTERNAL TIMER, CENTR, I6502, ERROR + EXTERNAL SCCKA, SCCKB, SCCAER, SCCBER, SCCATX, SCCBTX +; +;................................................................ +; +; Konstanten +; +; Eumel Systemadressen +; +VECBASE EQU 0A000H ; Basisadresse fuer JP-Vektoren +; +EU0BLKS EQU VECBASE+10H +; +ESTART EQU VECBASE+1EH ; EUMEL Systemstart +; +ELEISTE EQU VECBASE+21H +; +ELLEN EQU VECBASE+36H-ELEISTE +; +;................................................................ +; +; andere Adressen +; +WINDOW EQU 0F000H ; Anfangsadresse des 4K Windows +LIMIT EQU WINDOW-1 ; Obergrenze fuer EUMEL-Pufferbereich +;SHUG EQU 0100H ; SHard Code Anfang +SHOG EQU 1400H ; EUMEL 0 Anfang +RESVEC EQU 0F3F4H ; Pruefsumme Reset Vektor (CBR=51H) +VPOINT EQU 0F010H ; Pointer auf Hintergrund Volume +; +; Adressen +; +BASE EQU WINDOW +; +STADR EQU BASE+01H +TSK65 EQU BASE+80H ;Task fuer 6502 +; +; Zeichen +; +CR EQU 0DH ;Carriage Return +LF EQU 0AH ;Line Feed +; +; sonstige Konstanten +; +CB1 EQU 0F0H ;Anfang Common Base 1 und Bank Base (log.) +BOTLNG EQU 40H ; Laenge des Bootstrapladers in Bloecken +; +CMN1T0 EQU 51H ;Common Area 1 auf 6502 Adr. 0 +CMN1T1 EQU 52H ;Common Area 1 auf 6502 Adr. $1000 +; + INCLUDE PORTS.MAC +; +;----------------------------------------------------------------------- +; Bereich ab hier darf NACH dem Systemstart ueberschrieben werden +; +KANAL: DEFB 0 ; log. Kanal, der Systemstarturlader enthaelt + +SLEISTE: + DEFB 'SHARD ' ; Identifikationstext + DEFW 8 ; SHard-Interface-Version +MODE: DEFW 0 ; Vortest-Modus, wird ueberschrieben +ID4: DEFW 0 ; Lizenznummer des SHards, " +ID5: DEFW 0 ; Installationsnummer des SHards, " +ID6: DEFW 0 ; Reserviert f. SHard, " +ID7: DEFW 8000+vers ; Frei f. SHard: SHard-Version + DEFW 0 ; - + DEFW 0 ; - + JP SHOUT + JP SHBIN + JP SHBOUT + JP SHIOCNT + JP SHEND + JP SHSINF + JP SHSACC + DEFW 0 ; - + DEFW LIMIT ; obere Hauptspeicher-Grenze fuer EUMEL + +;---------------------------------------------------------------- +; +; System laden +; +SYSRD: + LD HL,SHOG + LD DE,10 +; +RDSLOP: + PUSH HL + PUSH DE ;Adresse + Block retten +; + LD A,(KANAL) + CALL SHBIN +; + POP DE + POP HL + LD A,C + AND A + JR NZ,RDSLOP ;Fehler -> Retry +; + INC H ;Adresse erhoehen + INC H + INC DE ;Blocknummer erhoehen + LD A,(EU0BLKS) + ADD 10 + CP E ; Alle gelesen ? + JR NC,RDSLOP ;Nein -> weiterlesen + +; System wurde geladen +; + +; SHard muss sich die benoetigten Teile der EUMEL-Linkleiste retten +; + DI + + LD HL,ELEISTE + LD DE,ADLEISTE + LD BC,ELLEN ; EUMEL-Linkleiste kopieren + LDIR +; +; EUMEL starten +; + LD HL,SLEISTE ; SHard-Linkleiste + JP ESTART ;EUMEL Lader starten +; +ZZZZZZ EQU $ +; +;**************************************************************** +; +; S T A R T +; +; SHARD Initialisierung und Systemstart +; +; 1. Treiber initialisieren +; 2. Startup Meldung ausgeben +; 3. Interruptadressen setzen, Interrupt Modus setzen +; 4. Urlader laden +; 5. Systemstart +; +; Bereich ab hier darf schon VOR dem Systemstart ueberschrieben werden +; (darf vom Urlader ueberschrieben werden) + +START: + DI + LD SP,LIMIT ;obere Speichergrenze +; +; Speicherkonfiguration setzen +; + XOR A ;Bank Area ab 0 + OUT0 (BBR),A +; + LD A,CB1 ;Common Area 1 ab log. F000, Bank Area ab 0 + OUT0 (CBAR),A +; + LD A,83H ; Refresh Zyklus 2 Takte, alle 80 States + OUT0 (RCR),A +; +; Startvektor deaktivieren +; + + LD A,0C3H ; JP-Code + LD (0),A ; JP-Code eintragen bei RESET/TRAP-Adr + LD HL,TRAP ; Falls RESET oder TRAP: Info ' shard' 'TRAP' + LD (1),HL ; Kein START, dieses Modul wird ueberschrieben + + LD A,51H ;Common Area 1 auf Apple Speicher setzen + OUT0 (CBR),A +; +; Durch Veraenderung der Pruefsumme des Reset-Vektors wird erreicht, +; dass bei Betaetigen von Reset immer ein Kaltstart ausgefuehrt wird +; + LD (RESVEC),A ;veraendert + +; +; Anfang und Ende des Harddisk Volumes (HG) eintragen +; + LD HL,(VPOINT) ;Pointer auf Tabelle + LD A,H + AND 0F0H ;4K-Bereich bestimmen + RRCA + RRCA + RRCA + RRCA + ADD A,51H ;Apple Speicher Anfangsoffset + OUT0 (CBR),A ;in MMU eintragen +; + LD A,H + OR 0F0H ;im 64180 Speicher ab F000H + LD H,A +; + LD BC,3 ;3 Byte kopieren + INC HL + LD DE,HDOFS + LDIR ;Anfang +; +; Laenge des Bootstrapladers (SHARD) hinzuaddieren +; + DEC DE + LD A,(DE) + ADD A,BOTLNG ;Laenge in 256-Byte Pages + LD (DE),A + DEC DE + LD A,(DE) + ADC A,0 + LD (DE),A + DEC DE + LD A,(DE) + ADC A,0 + LD (DE),A +; + INC HL + LD C,3 + LD DE,HDLAST + LDIR ;Ende +; + LD A,51H + OUT0 (CBR),A +; +; Hintergrund Blockanzahl bestimmen +; + LD HL,HDOFS+2 + LD DE,HDLAST+2 ;Last-First ausrechnen + CALL CALCSIZ + LD (HGBLKS),HL ;Groesse eintragen, max. 32MB +; +; CP/M-Volume Blockanzahl bestimmen +; + LD HL,CPMOFS+2 + LD DE,CPMLAST+2 + CALL CALCSIZ + LD (CPMBLKS),HL +; + CALL INICIO ; CIO, incl. Interrupts initialisieren + + CALL INIINT ; Interrupt System starten + + CALL INITS ; SCSI-Controller initialisieren +; + CALL CHKRTC ; Flag fuer gueltige RTC-Werte setzen +; +; Mode, ID laden +; + LD HL,MODECONF + LD DE,MODE + LD BC,8 ; 3 ID-Felder, 1 Mode-Feld + LDIR + + LD HL,STARTUP ; Startupmeldung ausgeben + CALL SENDMSG +; +; Block 10 lesen (enthaelt EUMEL0-Linkleiste) +; + + LD A,(URLK1) ; Kanal, auf dem der Urlader zuerst + CALL NEXTKAN ; gesucht wird + JP Z,SYSRD ; System von diesem Kanal laden + + LD A,(URLK2) ; Kanal, auf dem der Uralder dann gesucht + CALL NEXTKAN ; wird + JP Z,SYSRD ; von diesem Kanal laden + + LD HL,NOURL ;kein EUMEL Urlader + CALL SENDMSG + DI + HALT + +NEXTKAN: + LD (KANAL),A + LD DE,0 ; Default Typ + LD BC,5 ; IOCONTROL 'size' + CALL SHIOCNT ; zum initialisieren + LD A,B ; 0 Bloecke, Fehler + OR C + JR NZ,NEXTOK + INC A ; NZ setzen, da vorher 0 + RET + +NEXTOK: + LD A,(KANAL) + LD HL,VECBASE ; Hauptspeicher-Adresse + LD DE,10 ; Block 10 lesen + CALL SHBIN + + LD A,C ; Fehlerrueckmeldung + AND A ;erfolgreich ? + RET NZ + + JP CKEUMEL ;Eumel Urlader ? + +;................................................................ +; +; Berechnung der Groesse eines Volumes +; Eingang: HL = Zeiger auf letztes der 3 Byte Anfangs LUN/Adresse +; DE = Zeiger auf letztes der 3 Byte Ende+1 LUN/Adresse +; Ausgang: HL = Anzahl 512-Byte Bloecke dieses Volumes +; DE und A werden veraendert! +; +CALCSIZ: + LD A,(DE) + SUB (HL) + LD C,A +; + DEC DE + DEC HL + LD A,(DE) + SBC A,(HL) + LD H,A + LD L,C + SRL H ;256 -> 512 Byte Bloecke + RR L + RET +; +;................................................................ +; +; Ueberpruefen ob Block 10 den Text EUMEL enthaelt +; +; Exit: B=0! bei F=Zero +; +CKEUMEL: + LD HL,VECBASE + LD DE,EUMTXT + LD B,5 +; +CKLP: + LD A,(DE) + CP (HL) + INC HL + INC DE + RET NZ + DJNZ CKLP + + RET +; +;................................................................ +; +STARTUP: + DEFB STUPLEN, 9, CR, LF, LF + DEFB ' EUMEL auf HD64180 & 6502', CR, LF + DEFB ' SHard-Interfaceversion 8', CR, LF + DEFB ' Version 1.5 vom 26.06.87', CR, LF + DEFB ' (c) 1985, 86, 87 by ruc', CR, LF + DEFB ' ' +STUPLEN EQU $-STARTUP-1 +; +NOURL: + DEFB NOURLEN, CR, LF + DEFB 'EUMEL-Urlader nicht gefunden', CR, LF +NOURLEN EQU $-NOURL-1 +; +EUMTXT: + DEFB 'EUMEL' +; +;----------------------------------------------------------------- +; +; C H K R T C +; +; RTC-Werte auf Gueltigkeit ueberpruefen +; + +CHKRTC: + LD A,20H ; 2 (programmierte) eff. 3 Uhrenwaitstates + OUT (DCNTL),A + + ; Testen, ob vernuenftige Werte vorhanden + ; (BCD, Uhr laeuft, 24h-Modus, Bereiche ok) + XOR A + LD (RTCOK),A ; 'Nicht ok' vorbesetzen + + IN0 A,(RTCRA) ; Register A der Uhr + AND 7FH + CP 20H ; + JR NZ,CALEND ; falscher Wert + + IN0 A,(RTCRB) ; Register B der Uhr + CP 2 + JR NZ,CALEND ; falscher Wert + + IN0 A,(RTCYR) ; Jahr < 87 ? + CP 87H + JR C,CALEND + + IN0 A,(RTCDY) ; Tag > 31 + CP 32H ; + JR NC,CALEND + LD H,A + + IN0 A,(RTCMO) ; Monat > 12 ? + CP 13H + JR NC,CALEND + + OR H + JR Z,CALEND ; Monat oder Tag = 0 ? + + IN0 A,(RTCM) + CP 60H + JR NC,CALEND ; Minuten > 59 ? + + IN0 A,(RTCH) + CP 24H + JR NC,CALEND ; Stunden > 23 ? + + LD A,0FFH + LD (RTCOK),A + +CALEND: + XOR A + OUT0 (DCNTL),A ; 0 (prog.) I/O Waitstates, 0 Memory Waitst. + RET + +;................................................................ +; +; I N I C I O +; +INICIO: + +; CIO initialisieren + + IN0 C,(CIOCTL) ;Dummy Read + LD B,INILNG + LD HL,INITAB ;CIO Initialisierungstabelle + +INILOP: + LD C,(HL) ;Wert holen + OUT0 (CIOCTL),C ;und ausgeben + INC HL + DJNZ INILOP + RET + +;...................................................................... +; +; I N I I N T +; +; Interrupt System starten +; +INIINT: + CALL SCCINIT ;SCC initialisieren +; +; 6502-Programmstueck verschieben +; + LD A,1 ; Transferrichtung 64180 --> 6502 + LD BC,LEN65 ; Laenge des Programmstuecks + LD DE,PRG6502 ; Startadresse im log. 64180-Speicher + LD HL,DES6502 ; Destinationadresse im Basisspeicher + CALL MEMDMA ; Bytes transferieren +; + LD B,(CBR) ; CBR merken + + LD A,CMN1T0 + OUT0 (CBR),A + + LD HL,ST6502 ;Startadresse 6502-Routinen + LD (STADR),HL + LD A,4 ;6502 Teil starten + LD (TSK65),A +; + OUT0 (CBR),B ;CBR wieder zuruecksetzen +; + LD HL,VECTAB ; Interrupttabelle + LD DE,18H ; Destination + LD BC,ITABLEN ; Transferlaenge + LDIR + + XOR A ;interne Interrupts ab Vektor 0040 + LD I,A ;externe Interrupts ab 0018H + LD A,40H + OUT0 (IL),A +; + IM 2 ; Fuer INT0 Interrupt Modus 2 benutzen + LD A,3 ;Enable Interrupt 0 and 1 + OUT0 (ITC),A +; +; +; 6502 Interrupts hardwaremaessig freigeben +; + LD A,0B0H ;CIO PC2 auf Low setzen + OUT0 (CIOCD),A + LD A,0B4H ;CIO PC2 auf High setzen + OUT0 (CIOCD),A + + EI + + RET + +;........................................................................... +; +; CIO Initialisierungs Tabelle +; + +INITAB: +;* DEFB 0,1 ;Set Reset Bit (raus: kein Recalibrate mehr) + DEFB 0,0 ;Reset Reset Bit + DEFB 1,0 ;Master configuration control + +; SCSI-Interface-Leitungen + + DEFB 20H,00000010B ;Port A Mode Reg. + DEFB 22H,01000010B ;Port A Data Path Polarity Reg. + DEFB 23H,10111101B ;Port A Data Direction Reg. + DEFB 24H,0 ;Port A Special I/O Control + DEFB 25H,10101100B ;Port A Pattern Polarity + DEFB 26H,0 ;Port A Pattern Transition + DEFB 27H,10101100B ;Port A Pattern Mask + DEFB 0DH,0 ;Port A Data + DEFB 02H,18H ;Port A Interrupt Vector (** TEST **) + DEFB 08H,11100000B ;Port A Command: Clear IE + DEFB 08H,00100000B ;Port A Command: Clear IUS & IP + +; General Purpose Port (Centronics, SCSI, 6502-IRQ-Maske) + + DEFB 06H,00000001B ;Port C Data Direction Reg. + DEFB 05H,00001000B ;Port C Data Path Polarity Reg. + DEFB 07H,0 ;Port C Special I/O Control + DEFB 0FH,4 ;Port C Data Register + +; Centronics Interface + + DEFB 28H,10010000B ;Port B Mode + DEFB 29H,01000000B ;Port B Handshake: Strobed + DEFB 09H,00100000B ;Port B Command: Clear IUS & IP + DEFB 2AH,0 ;Port B Data Path Polarity + DEFB 2CH,0 ;Port B Special I/O Control + DEFB 03H,30H ;Port B Interrupt Vektor + +; Deskew Timer + +; DEFB 1EH,00000010B ;Counter 3 Mode Specification +; DEFB 0CH,00100000B ;Counter 3 Command and Status +; DEFB 1AH,0 ;Counter 3 Time Constant MSB +; DEFB 1BH,7 ;Counter 3 Time Constant LSB (2,268 us) +; DEFB 0CH,11100100B ;Counter 3 Gate Enable + +; Timer + + DEFB 1CH,10000000B ;Counter/Timer 1 Mode Spec. Reg. + DEFB 1DH,10000000B ;Counter/Timer 2 Mode Spec. Reg. + DEFB 0AH,00100000B ;Counter/Timer 1 Command: Clear IP & IUS + DEFB 0BH,00100000B ;Counter/Timer 2 Command: Clear IP & IUS + DEFB 16H,HIGH 38400 ;Time Constant 1 MSB + DEFB 17H,LOW 38400 ;Time Constant 1 LSB + DEFB 18H,0 ;Time Constant 2 MSB, mit Timer 1 zus. 50ms + DEFB 19H,4 ;Time Constant 2 LSB + DEFB 04H,18H ;Interrupt Vector Counters + +; CIO-Interrupts freigeben + + DEFB 01H,11110111B ;Master Config. Register + DEFB 00H,10000010B ;Master Interrupt Enable + + DEFB 09H,11000000B ;Port B Command: Set IE + + DEFB 0BH,11000110B ;Counter/Timer 2 Command: Set IE + DEFB 0AH,11100110B ;Counter/Timer 1 Command: Clear IE + +INILNG EQU $-INITAB + +;**************************************************************** +; +; Interrupt Vektor Tabelle, wird kopiert +; +VECTAB: + DEFW TIMER ;18 Timer Interrupt (CIO Counter 2) + DEFW ERROR ;1A + DEFW ERROR ;1C + DEFW ERROR ;1E + DEFW SCCBTX ;20 SCC Transmitter Interrupt (Kanal B) + DEFW ERROR ;22 SCC EXT/Status Interrupt (Kanal B) + DEFW SCCKB ;24 SCC Receive Char. available (Kanal B) + DEFW SCCBER ;26 SCC Special Receive Condition (Kanal B) + DEFW SCCATX ;28 SCC Transmitter Interrupt (Kanal A) + DEFW ERROR ;2A SCC EXT/Status Interrupt (Kanal A) + DEFW SCCKA ;2C SCC Receive Char. available (Kanal A) + DEFW SCCAER ;2E SCC Special Receive Condition (Kanal A) + DEFW CENTR ;30 Centronics Interface + DEFW ERROR ;32 + DEFW ERROR ;34 + DEFW ERROR ;36 + DEFW ERROR ;38 + DEFW ERROR ;3A + DEFW ERROR ;3C + DEFW ERROR ;3E + DEFW I6502 ;40 INT1 = 6502 Interrupt + DEFW ERROR ;42 INT2 = unbenutzt + DEFW ERROR ;44 Timer Channel 0 = unbenutzt + DEFW ERROR ;46 Timer Channel 1 = unbenutzt + DEFW ERROR ;48 DMA Channel 0 = unbenutzt + DEFW ERROR ;4A DMA Channel 1 = unbenutzt + DEFW ERROR ;4C CSI/O = unbenutzt + DEFW ERROR ;4E ASCI Channel 0 = unbenutzt + DEFW ERROR ;50 ASCI Channel 1 = unbenutzt + +ITABLEN EQU $-VECTAB +; +;..................................................................... + +ZZZZZD: END + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/INT65.MAC b/system/shard-z80-ruc-64180/1.5/src/INT65.MAC new file mode 100644 index 0000000..f47d45c --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/INT65.MAC @@ -0,0 +1,412 @@ + TITLE INT65 - Interface 6502 <-> 64180 +; + INCLUDE HD64180.LIB +; + .LIST + CSEG +; +;**************************************************************** +; +; INT65: Interface BASIS 6502 <-> 64180, Einstellungen fuer +; serielle Schnittstelle im BASIS 108 +; +; Version 0.4 - 25.11.85 / 11:00 +; Version 0.5 - 23.12.86, M.Staubermann +; Version 0.6 - 14.01.86, Kanal 5 Flusskontrolle durch 6502 +; +; Copyright (C) 1985 by Rainer Ellerbrake +; Eggeberger Str. 12 +; 4802 Halle (Westf.) +; +;**************************************************************** +; +; Globale Variable +; + GLOBAL ZGERL, TO6502, TO65WA, WTEND, RD6502 + GLOBAL BAUBAS, BITBAS, AFLOW5, EFLOW5, FRE65 +; +;................................................................ +; +; Externe Variable +; + EXTERNAL WARTE +; +;................................................................ +; +; Konstanten +; +P065 EQU 51H ;Page 0 des 6502 einblenden +PC65 EQU 5DH ;I/O-Bereich des 6502 +; +TASK EQU 0F080H +PARAM EQU TASK+1 +; +AFLG EQU 0F09AH ; XON/XOFF - Ausgabeseitig: Bit 7 = 1 +EFLG EQU 0F09BH ; Ausgabeseitiger Stopzustand: Bit 7 = 1 +;SFLG EQU 0F09CH ; Stopzustand des Transmitters +WAITFLG EQU 0F09DH ; 6502 - Update-Synchro +; +PFREE EQU 0F0E0H ; Word: Anzahl freie Bytes im Druckerspooler +TFREE EQU 0F0F0H ; Word: Anzahl freie Bytes im Transmitbuffer +; +SER_CMD EQU 0F09AH ; Command Register 6551 BASIS +SER_CTR EQU 0F09BH ; Control Register 6551 BASIS +; +; + INCLUDE PORTS.MAC +; +;**************************************************************** +; +; T O 6 5 0 2 +; +; 6502 Task Aufruf +; +; Eingang: L - Task-Nummer +; H - Parameter +; +TO6502: + PUSH AF + LD A,I + PUSH AF + DI + IN0 A,(CBR) + PUSH AF +; + LD A,P065 + OUT0 (CBR),A +; +; Warten bis vorherige Task beendet ist +; +WRTTAS: + CALL ZGERL + LD A,(TASK) ;Task = 0: beendet + AND A + JR NZ,WRTTAS +; + LD A,H + LD (PARAM),A +; + LD A,L + LD (TASK),A ;Task aufrufen +; +; auf Ende wird erst beim naechsten Aufruf gewartet +; + POP AF + OUT0 (CBR),A ;zurueckschalten + POP AF + JP PO,NOEI +; + EI +NOEI: + POP AF + RET +; +;---------------------------------------------------------------- +; +; T O 6 5 W A +; +; Warten auf Beendigung des Task Aufrufs +; (EUMEL WARTE wird aufgerufen!!) +; +TO65WA: + PUSH AF +; +; Warten bis Task beendet ist +; + +WTTAS: + IN0 A,(CIOAD) + BIT 0,A + JR Z,WTTA1 ;Zugriff nicht erlaubt -> warten +; + PUSH HL + LD HL,LOW TASK + CALL RD6502 ; Task-Byte in A + POP HL + + AND A + JR NZ,WTTA1 + POP AF + RET + +WTTA1: + CALL WARTE +; + JR WTTAS +; +;---------------------------------------------------------------- +; +; W T E N D +; +; Warten auf Beendigung des Task Aufrufs +; +WTEND: + PUSH AF +; +; Warten bis Task beendet ist +; +WTTAS1: + CALL ZGERL +; + PUSH HL + LD HL,LOW TASK + CALL RD6502 + POP HL + + AND A + JR NZ,WTTAS1 +; + POP AF + RET + +; +;---------------------------------------------------------------- +; +; Z G E R L +; +; Auf Zugriffserlaubnis warten +; +; keine Register veraendert +; +; +; Zugriff auf 6502-Speicher zulaessig ? +; +ZGERL: + PUSH AF +WAI65: + IN0 A,(CIOAD) + BIT 0,A + JR Z,WAI65 ;nicht erlaubt -> warten +; + POP AF + RET +; +;--------------------------------------------------------------- +; +; R D 6 5 0 2 +; Byte aus 6520-Memory Adresse HL nach A lesen +; +; Eingang: HL = Zeropage- oder I/O-Page-Adresse im 6502-Memory +; Ausgang: In A steht der Inhalt der Adresse +; +RD6502: + PUSH BC + LD B,A + LD A,I + DI + PUSH AF + + IN0 A,(CBR) + LD C,P065 ; Bit 7 nicht gesetzt: Zeropage + BIT 7,H + JR Z,RD6502B + LD C,PC65 ; Bit 7 gesetzt: I/O-Adresse +RD6502B: ; Achtung: Nicht eindeutig! + OUT0 (CBR),C + + LD C,H + LD H,0F0H + LD B,(HL) + LD H,C + + OUT0 (CBR),A + + POP AF + JP PO,RD6502A + EI +RD6502A: + LD A,B + POP BC + RET + +;---------------------------------------------------------------- +; +; Baudrateneinstellung fuer BASIS serielle Schnittstelle +; +; Eingang: A - Kanalnummer (immer 5) +; HL - Schluessel (s. Tabelle) (1..15) +; Es werden korrekte Parameter vorausgesetzt +; +; Ausgang: Register duerfen nicht veraendert werden +; +BAUBAS: + PUSH AF + DI + ; Da nur I/O Zugriffe gemacht werden, braucht + ; nicht auf Zugriffserlaubnis gewartet werden + IN0 A,(CBR) + PUSH AF ;alte Einstellung retten + LD A,PC65 ;I/O-Bereich einblenden + OUT0 (CBR),A + LD A,(SER_CTR) ;Control Register lesen + AND 0F0H ;Baudratenbits ausblenden + OR L ;und neue Einstellung einfuegen + LD (SER_CTR),A + + POP AF + OUT0 (CBR),A ;alten Bereich wieder einblenden +EIRET: + EI + POP AF + RET +; +; +;------------------------------------------------------------------ +; +; F R E 6 5 +; Freiplatz eines 6502-Ausgabepuffers erfragen +; +; Eingang: A = Kanal (5, 6) +; Ausgang: HL veraendert, A veraendert +; BC = Free Bytes +; Carry set, Puffer leer +; +FRE65: + CP 5 ; BASIS serielle Schnittstelle + LD HL,TFREE ; Transmitbuffer + JR Z,BASER + LD HL,PFREE ; Druckerpuffer + +BASER: + DI + IN0 A,(CBR) + PUSH AF + LD A,51H + OUT0 (CBR),A ; Zeropage + +WAIUPD: + LD A,(WAITFLG) + AND A + JR NZ,WAIUPD ; Warten, bis Update zuende + + LD C,(HL) ; Lowbyte Free + INC HL + LD B,(HL) ; Highbyte Free + INC HL + LD A,(HL) ; Lowbyte Size + INC HL + OR (HL) + LD L,A + + POP AF + OUT0 (CBR),A + EI + LD A,L + AND A + RET NZ ; Carry cleared, Puffer nicht leer + SCF ; Carry set, Puffer leer + RET + +;---------------------------------------------------------------- +; +; Stopbits, Datenbits, Parity fuer BASIS serielle Schnittstelle +; +; Eingang: A - Kanalnummer (immer 5) +; L - Schluessel +; Es werden korrekte Parameter vorrausgesetzt +; +; Ausgang: Register duerfen nicht veraendert werden +; +BITBAS: + PUSH AF + DI + ; Da nur I/O Zugriffe gemacht werden, braucht + ; nicht auf Zugriffserlaubnis gewartet werden + PUSH HL + IN0 H,(CBR) + LD A,PC65 ; I/O-Bereich einblenden + OUT0 (CBR),A + ; Stopbits und Datenbits setzen + LD A,(SER_CTR) ; Control Register lesen + AND 1FH ; Datenbits Stopbits ausblenden + BIT 6,L ; 2 Stopbits ? + JR Z,BITBAS1 + SET 7,A +BITBAS1: + BIT 0,L ; Bit 0 = 0, wenn 7 Datenbits (7-1 = 6) + JR NZ,BITBAS2 + SET 5,A ; 01 = 7 Datenbits, 00 = 8 Datenbits +BITBAS2: + LD (SER_CTR),A + ; Parity setzen + LD A,L + RLCA + RLCA + AND 01100000B + BIT 6,A + JR Z,BITBAS3 ; 00 = No, 01 = Odd, 10 = Even + SET 5,A +BITBAS3: ; 00 = No, 01 = Odd, 11 = Even + LD L,A + LD A,(SER_CMD) + AND 0FH + OR L ; Neue Parity Bits + LD (SER_CMD),A + + OUT0 (CBR),H ;alten Bereich wieder einblenden + POP HL + JR EIRET +; +;----------------------------------------------------------------- +; +; A F L O W 5 +; Ausgabeflusskontrolle einstellen +; +; Eingang: (HL) : Bit 0 = XON/XOFF, Bit 1 = DSR/DTR +; +AFLOW5: + PUSH AF + PUSH HL + XOR A + BIT 2,(HL) ; Ausgabeflusskontrolle ? + JR Z,AFLOW5A + CALL CALCF +AFLOW5A: + LD HL,AFLG +EAFLOW: + PUSH BC + DI + IN0 B,(CBR) + LD C,51H + OUT0 (CBR),C + LD (HL),A + OUT0 (CBR),B + EI + POP BC + POP HL + POP AF + RET + +CALCF: + BIT 0,(HL) + JR Z,CALCF1 + SET 7,A ; XON/XOFF +CALCF1: + BIT 1,(HL) + JR Z,CALCF2 + SET 6,A ; DSR/DTR +CALCF2: + RET + +;----------------------------------------------------------------- +; +; E F L O W 5 +; Eingabeflusskontrolle einstellen +; +; Eingang: (HL) : Bit 0 = XON/XOFF, Bit 1 = DSR/DTR +; +EFLOW5: + PUSH AF + PUSH HL + XOR A + BIT 3,(HL) ; EIngabeflusskontrolle ? + JR Z,EFLOW5A + CALL CALCF ; EUMEL --> 6502 Format +EFLOW5A: + LD HL,EFLG + JR EAFLOW + +;------------------------------------------------------------------- + + END + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/INTMOD.MAC b/system/shard-z80-ruc-64180/1.5/src/INTMOD.MAC new file mode 100644 index 0000000..9e419ce --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/INTMOD.MAC @@ -0,0 +1,1293 @@ + + TITLE Interrrupts fuer SHARD +; + INCLUDE HD64180.LIB +; + .LIST +; +;**************************************************************** +; +; Interruptmodul fuer EUMEL SHARD +; +; Timer Handling, SCC Interrupts, 6502 Interrupts +; Buffer Manager +; +; Version 0.9 vom 10.01.87 (Transmittinterrupts) +; Version 1.0, getestet (Ringpuffer korrigiert, +; 20.01.87 - keine Interrupthaenger an Kanal 1/5 mehr) +; 1.1 (27.05.87) Verlorener Timerinterrupt im Info/Vortest +; durch Korrektur von CHKINT (weniger oft aufgerufen) +; 1.2 (26.06.87) Wieder rausgebaut, da bei mehr als 16 Zeichen im +; Eingabepuffer die Puffer-Auslesegeschwindigkeit stark +; sinkt. +; +; Copyright (C) 1985 by R. Ellerbrake +; 86/87, M. Staubermann +; +;**************************************************************** +; +; Globale Adressen +; + GLOBAL BAUSCC, BITSCC, SCCINIT, CLRCBUF + GLOBAL ESTOP, EGO, AFLOW + GLOBAL I6502, TIMER, CENTR + GLOBAL SCCKA, SCCKB, SCCAER, SCCBER, SCCATX, SCCBTX + GLOBAL PUTBUF, FREEBUF, DRUCK, SCCATAB, SCCBTAB + +; +;---------------------------------------------------------------- +; +; Externe Adressen +; + EXTERNAL TIMEAD, IINTAD, SHUTUPAD + EXTERNAL IKANTAB, BLINKP, SWICUR, MEMDMA, FLWTYP + EXTERNAL AFLOW5, RD6502 +; +; +;---------------------------------------------------------------- +; + CSEG +; +; Konstanten +; +CMN1T0 EQU 51H ;Common Area 1 auf 6502 Adr. 0 +CMN1T1 EQU 52H ;Common Area 1 auf 6502 Adr. $1000 +; +XON EQU 11H ; CTRL-Q +XOFF EQU 13H ; CTRL-S + + ; Bereich fuer Transmitbuffer im 6502-Speicher +DBUF EQU 0A000H +SABUF EQU DBUF+1000H +SBBUF EQU SABUF+0800H ; SABUF+SBBUF zusammen max. 4k in einem Window + ; Offsets auf Kanal-Buffer-Tabellen +SIZE EQU 0 ; aktuelle Groesse (Belegung) des Puffers +BEG EQU 2 ; Pufferanfang (fest) +READ EQU 3 ; Adresse des naechsten Out-Buffer-Zeichens +WRITE EQU 5 ; Adresse des naechsten In-Buffer-Zeichens +ENDE EQU 7 ; excl. Pufferende (fest) + +CPORT EQU 8 ; Controlport mit Statusregister +XFLAG EQU 9 ; Bit 7 = 1: Transmitter stoppen + ; Bit 6 = 1: XON/XOFF ausgabeseitig + + INCLUDE PORTS.MAC + + +;---------------------------------------------------------------- +; +; 6502-Adressen +; + +BASE EQU 0F000H ;Anfangsadresse 6502 Bereich +IFLG EQU BASE+09EH ; Start/Stop Flag fuer 6502 +INTPAR1 EQU BASE+0EAH ;Interrupt Parameter 1 (Kanal) +INTPAR2 EQU INTPAR1+1 ;Interrupt Parameter 2 (Eingabezeichen) +INTPAR3 EQU INTPAR2+1 ;Interrupt Parameter 3 (Fehlerbits) + + +;----------------------------------------------------------------- +; +; P H Y S L O G +; Umrechnung der physischen Kanalnummer in eine logische +; +; Eingang: A = phys. Kanalnummer +; Ausgang: A = log. Kanalnummer +; keine anderen Register veraendert +; +PHYSLOG: + PUSH HL + ADD A,IKANTAB ; Kanal phys. --> log. Umrechnen + LD L,A + LD H,0 + LD A,(HL) + POP HL + RET + +;................................................................ +; +; Timer Interrupt Handler +; +; wird durch CIO Timer 2 Interrupt aufgerufen +; +TIMER: + PUSH AF +; + LD A,50 ;50 ms pro Timerinterrupt + CALL TIMEAD ;EUMEL timerinterrupt +; + DI + LD A,(CCOUNT) ;Cursor invertieren ? + DEC A + JR NZ,TIMER1 +; + IN0 A,(CIOAD) ; Cursor invertieren, wenn Zugriff erlaubt + BIT 0,A + JR Z,TIMER2 + + PUSH HL + PUSH DE + PUSH BC + CALL SWICUR ; Cursor invertieren + POP BC + POP DE + POP HL + +TIMER2: + LD A,(BLINKP) +TIMER1: + LD (CCOUNT),A + + LD A,0BH + OUT0 (CIOCTL),A ;Counter/Timer 2 Command + LD A,00100100B ;Clear IP & IUS + OUT0 (CIOCTL),A + + PUSH IX + LD IX,DRUCK + CALL TXHANDLER ; Testen, ob Drucker haengt + POP IX + +EINT: + POP AF +EINT1: + EI + RETI +; +;................................................................ +; +; I 6 5 0 2 +; +; 6502 Interrupt Handler +; +I6502: + PUSH AF + PUSH BC + CALL INT6502 + POP BC + JR EINT + +INT6502: + PUSH DE + + LD A,0B0H ; Reset Interrupt FF (Keine IRQ's mehr) + OUT0 (CIOCD),A + + IN0 A,(CBR) ;Common Area 1 retten + PUSH AF + + LD A,CMN1T0 + OUT0 (CBR),A +; + LD BC,(INTPAR1) ; C = Kanalnummer, B = Eingabezeichen + LD DE,(INTPAR3) ; E = Fehlerbits + + XOR A ; Interrupt quitieren + LD (INTPAR1),A + + POP AF + OUT0 (CBR),A ;Common Area 1 zurueckschalten + + LD A,C + AND A ;kein Auftrag -> + JR Z,RET6502I + + CP 40H + JR NC,BREAK ; Sonderbehandlung + + LD C,E ; Fehlerbits + + PUSH AF + + CALL PHYSLOG + CALL IINTAD ; EUMEL Inputinterrupt + DI + + POP BC ; Kanal in B + CP 1 + JR NZ,RET6502I ; noch Platz im Puffer + + LD A,B + CALL ESTOP ; Eingabestop, reagiert sofort + +RET6502I: + POP DE +RET6502J: + LD C,0B4H ; Reseteingang des 6502-IRQ-FF wieder auf High + OUT0 (CIOCD),C + RET + + +BREAK: + POP DE + CALL RET6502J + + CP 'S' ; Shutup ? (53H) + RET NZ + + CALL EINT1 ; Interrupts freigeben + JP SHUTUPAD + +;------------------------------------------------------------------- +; +; E F L W 5 +; Kanal 5 Interrupt an 64180 stoppen/starten +; Reagiert sofort +; +; Eingang: Bit 7(HL) = 1: Stop, = 0: Start +; Ausgang: BC veraendert +; +EFLW5: + LD BC,7F80H ; B = AND-resetmaske, C = OR-setmaske + JR EFLW15 ; Bit 7 ist Flag + +;------------------------------------------------------------------- +; +; E F L W 1 +; Kanal 1 Interrupt an 64180 stoppen/starten +; Reagiert sofort +; +; Eingang: Bit 7(HL) = 1: Stop, = 0: Start +; Ausgang: BC veraendert +; +EFLW1: + LD BC,0BF40H ; Bit 6 ist Flag + +EFLW15: + PUSH AF + LD A,I + DI + IN0 A,(CBR) + PUSH AF + + LD A,51H + OUT0 (CBR),A + + LD A,(IFLG) + AND B ; "weiter" + BIT 7,(HL) + JR Z,EFLWA + OR C ; "stop" setzen +EFLWA: LD (IFLG),A ; Stop/Weiter an 6502 weitergeben + + POP AF + OUT0 (CBR),A + JP PO,EFLWB + EI +EFLWB: + POP AF + RET + +;******************************************************************** +; +; Ringpuffer - Verwaltung +; +;---------------------------------------------------------------- +; +; F R E E B U F +; freien Platz im Puffer berechnen +; (dies ist nicht immer die Anzahl der uebernehmbaren Zeichen!) +; +; Eingang: IX = Zeiger auf Kanal-Puffer-Tabelle +; Ausgang: BC = Anzahl Bytes, die noch in den Puffer passen +; Carry gesetzt: Puffer leer, sonst Puffer gefuellt +; A veraendert +; +FREEBUF: + PUSH HL + LD A,(IX+ENDE) ; Konstante + SUB (IX+BEG) + LD H,A + LD L,0 + + DI + LD B,(IX+SIZE+1) + LD C,(IX+SIZE) + EI + + LD A,B + OR C + SCF ; Set carry, Puffer leer + JR Z,FREEBUF1 + AND A + SBC HL,BC ; Carry is cleared +FREEBUF1: + LD B,H + LD C,L + POP HL + RET + +;---------------------------------------------------------------- +; +; P U T B U F +; Zeichenkette in Ausgabepuffer schreiben +; +; Eingang: HL = Anfangsadresse der Zeichenkette +; BC = Laenge der Zeichenkette +; IX = Zeiger auf Kanal-Puffer-Tabelle +; Ausgang: BC = Anzahl der uebernommenen Zeichen +; Carry set, alles uebernommen +; HL, A veraendert +; +PUTBUF: + PUSH BC + CALL FREEBUF + DI + LD A,B + OR C + JR NZ,PUTBUF1 + + PUSH AF + CALL TXHANDLER + POP AF + EI + + INC SP ; POP BC, nichts uebernommen, Clear carry + INC SP + RET + +PUTBUF1: + POP BC + + PUSH DE + PUSH HL ; Stringanfang im Hauptspeicher in HL + + LD H,(IX+READ+1) ; Lesezeiger in HL + LD L,(IX+READ) + LD D,(IX+WRITE+1) ; Schreibzeiger in DE + LD E,(IX+WRITE) + + LD A,(IX+SIZE) ; Puffer leer ? + OR (IX+SIZE+1) + JR NZ,PUTBUF3 + + LD D,(IX+BEG) + LD E,0 ; Beide Zeiger auf Pufferstart + LD (IX+READ+1),D + LD (IX+READ),E + LD (IX+WRITE+1),D + LD (IX+WRITE),E ; Weiter, ohne zu splitten + LD L,E ; L := 0 + LD H,(IX+ENDE) + +PUTBUF3: + ; DE, erste Position fuer String + ; HL, letzte Position (excl.) fuer String + AND A ; falls nicht HL = Pufferende + SBC HL,DE + JR C,PUTBUF2 ; C, wenn Read < Write: String splitten + ; Z kann nicht auftreten, da Puffer nicht voll + +PUTBUF9: ; BC := min (BC, HL) + LD A,L ; HL enthaelt max. uebernehmbare Size + SUB C ; BC enthaelt Eingangs-Stringlaenge + LD A,H + SBC B + JR NC,PUTBUF4 ; NC, alles uebernommen + LD B,H ; C --> nur Puffersize uebernommen + LD C,L + +PUTBUF4: + CCF ; Carry fuer EUMEL umdrehen + + POP HL ; Stringanfang in HL + + PUSH AF + CALL PUTBUFA + CALL TXHANDLER ; Ein Zeichen ausgeben, IP wird gesetzt + EI + POP AF + POP DE + RET + +PUTBUF2: ; String muss ggf. gesplittet werden + LD H,(IX+ENDE) + XOR A + LD L,A + SBC HL,DE ; HL enthaelt Size (immer > 0) + JR PUTBUF9 + +;---------------------------------------------------------------------- +; +; Teilstring in Puffer schreiben +; Eingang: Interrupts disabled +; HL = Teilstringanfang +; DE = Schreibzeiger +; BC = Stringlaenge, die uebernommen werden soll +; (BC muss ok sein!) +; Ausgang: Nur BC ok +; (DE = Schreibzeiger (korrigiert)) +; (HL = Teilstring + uebernommene Stringlaenge) +; BC unveraendert +; +PUTBUFA: + PUSH HL + EX DE,HL ; DE = Hauptspeicher, HL = 6502-Speicher + PUSH BC ; merken fuer Ausgang + PUSH HL ; Stringanfang in DE, Schreibzeiger in HL + LD A,1 ; Von DE (log.) nach HL(6502) kopieren + CALL MEMDMA + POP HL ; Schreibzeiger + POP BC ; uebernommene Stringlaenge + + ADD HL,BC ; Stringlaenge addieren + + LD A,H + CP (IX+ENDE) + JR NZ,PUTBUFA2 + LD H,(IX+BEG) ; Schreibzeiger auf Pufferanfang setzen + ; L war schon 0 +PUTBUFA2: + LD (IX+WRITE+1),H + LD (IX+WRITE),L ; Schreibzeiger neu setzen +; EX DE,HL ; Schreibzeiger in DE + + LD L,(IX+SIZE) + LD H,(IX+SIZE+1) + ADD HL,BC ; Stringlaenge addieren + LD (IX+SIZE+1),H ; eintragen + LD (IX+SIZE),L + + POP HL ; Stringanfang + RET + +;................................................................ +; +; SCCA Output Interrupt +; +SCCATX: + PUSH IX + LD IX,SCCATAB + JR TXCHAR + +;................................................................ +; +; SCCB Output Interrupt +; +SCCBTX: + PUSH IX + LD IX,SCCBTAB +TXCHAR: + PUSH AF + CALL TXHANDLER + + LD A,00111000B ; Reset highest IUS + OUT0 (SCCBC),A + + JR EOFTX + + +;................................................................ +; +; Centronics Output Interrupt +; +CENTR: + PUSH IX + LD IX,DRUCK + PUSH AF + CALL TXHANDLER + + LD A,9 ; Statusregister + OUT0 (CIOCTL),A + LD A,00100000B ; Reset IP & IUS + OUT0 (CIOCTL),A +EOFTX: + POP AF + POP IX + EI + RETI +; +;------------------------------------------------------------------------ +; Output Interrupt Handler +; fuer Centronics und SCC +; +; Eingang: IX = Zeiger auf Descriptortabelle des Kanals +; Interrupts disabled +; Ausgang: Nur AF veraendert +; +TXHANDLER: + PUSH HL + PUSH DE + PUSH BC + + IN0 A,(CIOAD) ; Zugriff auf Puffer erlaubt ? + BIT 0,A + JP Z,REGRET + + PUSH IX + POP HL + LD A,L + CP LOW DRUCK + JR Z,CENTRIRQ + + LD B,0 + + BIT 7,(IX+XFLAG) ; Transmitter gestoppt ? + JR NZ,REGRET ; Keine Interruptbehandlung + + LD E,(IX+SIZE) + LD D,(IX+SIZE+1) + LD L,(IX+READ) + LD H,(IX+READ+1) + +TX1: + LD C,(IX+CPORT) + + LD A,D + OR E + JR Z,TX5 ; Puffer ist leer + + TSTIO 0100B + JR Z,TX4 ; Output-Buffer voll + + IN0 A,(CBR) + PUSH AF + + LD A,51H+(SABUF/1000H); MMU-Wert fuer Pufferwindow (max. 4k) + OUT0 (CBR),A + + PUSH HL + + LD A,H + AND 0FH + OR 0F0H ; Ins Window F000H... + LD H,A + + LD A,(HL) ; Zeichen ausgeben + INC C ; Aus Controlport wird Datenport + INC C + OUT (C),A ; B bleibt 0! + + POP HL + INC HL + + POP AF + OUT0 (CBR),A ; MMU zurueckschalten + + LD A,H + CP (IX+ENDE) + JR NZ,TX2 ; Carry set: Lesezeiger < Pufferende, ok + + LD H,(IX+BEG) ; L war schon 0 +TX2: + DEC DE ; Puffergroesse DECR 1 + JR TX1 ; Falls moeglich naechstes Zeichen ausgeben + +TX5: + LD A,00101000B ; Reset TxIP (B ist 0!) + OUT (C),A + +TX4: + LD (IX+SIZE),E + LD (IX+SIZE+1),D + LD (IX+READ),L + LD (IX+READ+1),H + +REGRET: + POP BC + POP DE + POP HL + RET + +CENTRIRQ: + LD C,CIOCTL + LD DE,(DRUCK+SIZE) + LD HL,(DRUCK+READ) + +CENTR3: + LD A,D + OR E + JR Z,TX4 ; Puffer ist leer + + LD A,9 ; Statusregister + OUT0 (CIOCTL),A ; Statusregister + TSTIO 1000B + JR Z,TX4 ; Output-Buffer voll + + IN0 B,(CBR) + + LD A,51H+(DBUF/1000H) ; MMU-Wert fuer Pufferwindow (max. 4k) + OUT0 (CBR),A + + PUSH HL + + LD A,H + AND 0FH + OR 0F0H ; Ins Window F000H... + LD H,A + + LD A,(HL) ; Byte aus Puffer lesen + OUT0 (CIOBD),A ; und ausgeben + + OUT0 (CBR),B ; MMU zurueckschalten + + POP HL + INC HL + + LD A,H ; Pufferende ? + CP (IX+ENDE) + JR NZ,CENTR2 + + LD H,(IX+BEG) ; L war schon 0 +CENTR2: + + DEC DE ; Puffergroesse DECR 1 + JR CENTR3 ; Falls moeglich naechstes Zeichen ausgeben + + +;************************************************************************* +; +; CLRCBUF +; +; 64180-Centronics Buffer loeschen +; Ausgang: HL veraendert, Flags unveraendert +; +CLRCBUF: + LD HL,DBUF + LD (DRUCK+READ),HL + LD (DRUCK+WRITE),HL + LD HL,0 + LD (DRUCK+SIZE),HL + RET + +;................................................................ +; +; SCC Input Interrupt Handler + +;-------------------------------------------------------------------- +; Zeichen mit Fehler empfangen + +SCCAER: ; von SCC-Kanal A + PUSH BC + LD C,SCCAC + JR SCCERR + +SCCBER: ; von SCC-Kanal B + PUSH BC + LD C,SCCBC + +SCCERR: + PUSH AF + + LD B,0 + LD A,00010000B ; Reset EXT/Status Interrupts + OUT (C),A + LD A,00110000B ; Error Reset + OUT (C),A + + LD A,1 + OUT (C),A ; Read-Register 1 + IN B,(C) + + BIT 5,B ; Overrun Error ? + JR Z,SCCER1 + SET 0,A +SCCER1: + BIT 4,B ; Parity Error ? + JR Z,SCCER2 + SET 2,A +SCCER2: + BIT 6,B ; Framing Error (mit 0 = Break) + JR Z,SCCER3 + SET 1,A +SCCER3: + JR SCC1 + +;----------------------------------------------------------------------- +; Zeichen ohne Fehler empfangen + +SCCKA: + PUSH BC + LD C,SCCAC + JR SCCOK + +SCCKB: + PUSH BC + LD C,SCCBC + +SCCOK: + PUSH AF + XOR A ; Keine Fehler + +; Interrupt weiterleiten und Flusskontrolle auswerten +; Eingang: A = Fehlerbits +; C = Contollportadresse des Kanals + +SCC1: + LD (ERRBIT),A + LD A,C + SUB A,3EH + LD (KANAL),A + + LD B,0 + PUSH BC + + TSTIO 1 ; Statusregister + JR Z,IRET ; Receive Character available ? + + INC C ; Aus Controlport wird Datenport + INC C + IN B,(C) ; Zeichen einlesen + + LD A,11111101B ; Maske zur XON/XOFF Erkennung + AND B ; mit Eingabezeichen verknuepfen + CP 00010001B ; = XON oder XOFF ? + JR NZ,SCC2 ; Nein, normaler Inputinterrupt + + PUSH HL + + LD HL,XFLGB + LD A,(KANAL) + CP 2 + JR Z,SCC3 + LD HL,XFLGA +SCC3: + BIT 6,(HL) ; Bit 6: Ausgabeseitig XON/XOFF + JR Z,SCC5 ; 0: An Inputinterrupt weiterleiten + + BIT 1,B ; XOFF : Bit 1 = 1, XON: Bit 1 = 0 + JR Z,SCC4 + + SET 7,(HL) ; Transmitter stoppen + POP HL + JR IRET +SCC4: + RES 7,(HL) ; Transmitter starten + + POP HL + POP BC + + CP 2 ; Flag setzen + + CALL NZ,SCCATX ; Flags werden nicht veraendert! + CALL Z,SCCBTX ; enthaelt u.a. EI und RETI + ; und Reset highest IUS + POP AF + POP BC + RET + +SCC5: + POP HL +SCC2: + LD A,(ERRBIT) ; Fehlerbits + LD C,A + LD A,(KANAL) ; Kanalnummer + CALL PHYSLOG ; phys. Kanalnummer --> log. Kanalnummer + + CALL IINTAD + + CP 3 ; Weniger als 3 Zeichen Platz ? + JR NC,IRET + + LD A,(KANAL) + CALL ESTOP ; Eingabestop fuer Kanal 2 oder 3 + +IRET: + POP BC + + LD A,00111000B ; Reset highest IUS + OUT (C),A +; + POP AF + POP BC + EI + RETI + +;................................................................ +; +; SCC Initialisierung +; HL, BC veraendert +; +SCCINIT: + LD HL,SCCAINI ;SCC Kanal A initialisieren + LD BC,(SCCALG+1)*100H+SCCAC+1 +INILP1: + DEC C + OTIM + JR NZ,INILP1 +; ; SCC Kanal B initialisieren + LD BC,(SCCBLG+1)*100H+SCCBC+1 +INILP2: + DEC C + OTIM + JR NZ,INILP2 +; + RET +; +;................................................................. +; +; B A U S C C +; Baudrateneinstellung fuer SCC-Kanaele +; +; Eingang: A - Kanalnummer (2 oder 3) +; HL - Schluessel (s. Tabelle) (1..16) +; Es werden korrekte Parameter vorrausgesetzt +; +; Ausgang: Register duerfen nicht veraendert werden +; +BAUSCC: + PUSH AF + PUSH HL + LD BC,BDSCCA+1 + CP 3 ;Kanal A ? + JR Z,CHABD ;Ja -> +; + LD BC,BDSCCB+1 ;Tab. fuer Kanal B +; +CHABD: + PUSH BC + LD BC,BDTAB-2 ;Tabelle mit Baudratenteilfaktoren + ADD HL,HL ;Tab.-Offset + ADD HL,BC + POP BC ;Baudrate eintragen + LD A,(HL) + LD (BC),A ;LSB eintragen + INC HL + INC BC + INC BC + LD A,(HL) ;MSB eintragen + LD (BC),A + +INISCC: + CALL SCCINIT + POP HL + POP AF + RET +; +;................................................................. +; +; B I T S C C +; Stopbits, Parity, Datenbits fuer SCC-Kanaele einstellen +; +; Eingang: A = Kanal (2 oder 3) +; L = Schluessel : +; Bit 0..2 : Datenbits - 1 (Nur 7 oder 8 erlaubt) +; Bit 3..4 : 00 = No Parity, 01 = Odd , 10 = Even +; Bit 5..6 : 00 = 1 Stop, 01 = 1.5 Stop, 10 = 2 Stop +; +; Es werden korrekte Parameter vorausgesetzt +; +; Ausgang: Register unveraendert +; +BITSCC: + PUSH AF + PUSH HL + LD BC,BTSCCA+1 + CP 3 ;Kanal A ? + JR Z,CHABT ;Ja -> +; + LD BC,BTSCCB+1 ;Tab. fuer Kanal B +; +CHABT: + LD A,L + RRA + RRA + RRA ; Paritybits (0, 1), Stopbits (2, 3) + AND 0FH + ADD 4 ; Stopbits korrigieren + BIT 1,A ; Wenn even Parity noch Bit 0 setzen + JR Z,NOEVN ; 00 = No Parity, 01 = Odd, 11 = Even + SET 0,A +NOEVN: OR 01000000B ; Clock x16 Mode + LD (BC),A ; eintragen + INC BC ; Zeigt auf Register 3 + INC BC + + LD A,L + AND 7 + CP 7-1 + LD A,01000001B ; Receiver Enable, 7 Datenbits + JR Z,CHABT1 + LD A,11000001B ; dgl., 8 Datenbits +CHABT1: + LD (BC),A ; Eintragen + INC BC ; Zeigt auf Register 5 + INC BC + LD A,10101010B ; Enable Transmitter, 7 Datenbits + JR Z,CHABT2 ; Compare-Flag noch nicht veraendert! + LD A,11101010B ; dgl. 8 Datenbits +CHABT2: + LD (BC),A ; eintragen + JR INISCC + +;.................................................................. +; +; X F L W 2 3 +; XON/XOFF - Eingabeflusskontrolle auf SCC-Kanaelen +; +; Eingang: A = Kanal (2, 3) +; BIT 7 (HL), Stop/Weiter +; +; Ausgang: alle Register unveraendert +; +XFLW23: + PUSH AF + PUSH BC + + LD B,0 + ADD A,3EH ; Kanal --> Controlport + LD C,A ; Transmitinterrupt kann nicht durchkommen + +XFLW23B: + TSTIO 0100B ; Transmitbuffer empty ? + JR Z,XFLW23B + + LD A,XON + BIT 7,(HL) + JR Z,XFLW23A + LD A,XOFF +XFLW23A: + INC C ; Controlport --> Datenport + INC C + OUT (C),A + + POP BC + POP AF + RET + +;................................................................. +; +; C F L O W 2 3 +; CTS - Ausgabeflusskontrolle auf SCC-Kanaelen +; +; Eingang: A = Kanal (2, 3) +; BIT 1(HL), BIT 2(HL) beide 1 : Mit CTS-Flusskontrolle +; sonst ohne Flusskontrolle +; Ausgang: Nur HL darf veraendert werden +; +CFLOW23: + PUSH AF + PUSH BC + + LD B,0 + + ADD A,3EH ; Controlport + LD C,A + + CP 40H ; SCCA ? + + LD A,(HL) ; Bit 1 und 2 relevant + + LD HL,CTSA+1 + JR Z,CFLOW2 + LD HL,CTSB+1 +CFLOW2: + RES 5,(HL) ; erstmal keine Auto-Enables + AND 0110B ; Bit 1 und 2 ausblenden + CP 0110B + JR NZ,CFLOW3 + + SET 5,(HL) ; Auto-Enables einschalten +CFLOW3: + LD A,3 + OUT (C),A ; Write-Register 3 + LD A,(HL) + OUT (C),A + + POP BC + POP AF + RET + + +;...................................................................... +; +; R F L W 2 3 +; RTS/DTR - Eingabeflusskontrolle auf SCC-Kanaelen +; +; Eingang: A = Kanal (2, 3) +; Bit 7 (HL), Stop/Weiter +; +; Ausgang: Nur Register HL darf veraendert werden +; +RFLW23: + PUSH AF + PUSH BC + + LD B,0 + + ADD A,3EH ; Controlport + LD C,A + + CP 40H ; SCCA ? + LD A,(RTSA+1) + JR Z,RFLW2 + LD A,(RTSB+1) +RFLW2: + AND 01111101B ; RTS und DTR ausblenden + BIT 7,(HL) + JR NZ,RFLW3 ; Stop: RTS = 0 und DTR = 0 + OR 10000010B ; Go : RTS = 1 und DTR = 1 +RFLW3: + PUSH AF + + LD A,5 + OUT (C),A ; Write-Register 5 + POP AF + OUT (C),A + + POP BC + POP AF + RET + +;........................................................................ +; +; X F L O W 2 3 +; XON/XOFF - Ausgabeflusskontrolle fuer SCC-Kanaele +; +; Eingang: A = Kanal (2, 3) +; Bit 0, 2 (HL) = 1 : XON/XOFF gewuenscht sonst nicht +; Ausgang: Nur HL veraendert +; +XFLOW23: + PUSH AF + LD A,(HL) + AND 0101B + CP 0101B ; einstellen, wenn 0101 + LD L,0 + JR NZ,XFLOW2 + SET 6,L ; Bit 6 = 1 : mit Flusskontrolle +XFLOW2: + POP AF + PUSH AF + CP 2 ; Kanal 2 = SCCB + LD A,L + JR Z,XFLOW1 + + LD (XFLGA),A + POP AF + RET + +XFLOW1: + LD (XFLGB),A + POP AF + RET + +;........................................................................ +; +; A F L O W +; Ausgabeflusskontrolle einstellen +; +; Eingang: A = phys. Kanalnummer +; Bit 0, 1, 2(HL) = Flusskontrolmodus +; +; Ausgang: Nur HL darf veraendert werden +; +AFLOW: + CP 5 + JP Z,AFLOW5 ; Kanal 5: Ausgabeseitig ist immer CTS + ; Flusskontrolle eingestellt, Software- + ; Flusskontrolle mit XON/XOFF ist einschalt- + ; bar, zusaetzlich einstellbar DSR-Flussk. + CP 2 + RET C ; Kanal 1 hat keine Ausgabeflusskontrolle + CP 4 + RET NC ; > 3 : --> + + PUSH HL + CALL XFLOW23 ; XON/XOFF-Flusskontrolle einstellen + POP HL + JP CFLOW23 ; Auto-Enables on, wenn Bit 1(HL)=1 und 2(HL)=1 + +;.................................................................. +; +; Eingabestop +; +; Eingang: A = phys. Kanalnummer (2, 3, 5) +; +ESTOP: + CP 7 + RET NC ; Nicht existenter Kanal + + PUSH HL + CALL FLWTYP ; Zeiger auf Flowmode - Tabelle berechnen + + BIT 3,(HL) + JR Z,POPRET ; Keine Eingabeflusskontrolle erwuenscht + + BIT 7,(HL) ; War der Kanal schon gestoppt ? + JR NZ,POPRET + + SET 7,(HL) ; Stopflag setzen + +ESTPGO: ; Ab hier Stop/Go identisch + + CP 2 + JR Z,ESTOP23 + CP 3 + JR Z,ESTOP23 + + PUSH BC + CP 5 + CALL Z,EFLW5 ; AF wird nicht veraendert + CP 1 + CALL Z,EFLW1 + POP BC + +POPRET: + POP HL + RET + +ESTOP23: + BIT 0,(HL) ; XOFF senden ? + CALL NZ,XFLW23 ; Bit 7 unterscheidet XON/XOFF + BIT 1,(HL) ; DTR/RTS low setzen? + CALL NZ,RFLW23 ; Bit 7 unterscheidet + JR POPRET + +;.................................................................. +; +; Eingabe Weiter +; +; Eingang: A = Kanalnummer (2, 3, 5) +; +EGO: + CP 7 + RET NC ; Nicht existenter Kanal + + PUSH HL + + PUSH AF + AND 1011B ; Kanal 1 oder 5 + CP 1 + CALL Z,CHKINT + POP AF + + CALL FLWTYP ; Zeiger auf Flowmode - Tabelle berechnen + + BIT 3,(HL) + JR Z,POPRET ; Keine Eingabeflusskontrolle erwuenscht + + BIT 7,(HL) ; War der Kanal gestoppt ? + JR Z,POPRET ; Nein, return + + RES 7,(HL) ; Goflag setzen + JR ESTPGO ; Wie Stop weiter + +;----------------------------------------------------------------- +; +; C H K I N T +; ggf. Inputinterrupt aufrufen, falls 6502-IRQ nicht quittiert +; +; HL, A veraendert +; +CHKINT: +; LD HL,DCOUNT ; Nicht immer CHKINT +; DEC (HL) ; Korr. 1.1 +; RET NZ +; LD (HL),100 + + PUSH BC + LD HL,LOW INTPAR1 + CALL RD6502 ; Byte aus Zeropage lesen + AND A + CALL NZ,INT6502 + POP BC + RET + +;---------------------------------------------------------------- +; +; SCC Kanal A Initialisierung +; +SCCAINI: + DEFB 9,0C0H ; Force Hardware Reset (beide Kanaele) + ; Master Interrupts disabled + DEFB 2,20H ; Interrupt Vektor (beide Kanaele) + + DEFB 11,01010110B ; use Baudrategenerator Output +BDSCCA: + DEFB 12,18 ; Baud Rate Low, Default 9600 Baud + DEFB 13,0 ; Baud Rate High + DEFB 14,00000010B ; Baud Rate Gen. Source = PCLK +BTSCCA: + DEFB 4,01001100B ; No Parity, 2 Stopbits +CTSA: + DEFB 3,11000001B ; Enable Receiver, Datenbits +RTSA: + DEFB 5,11101010B ; Enable Transmitter, Datenbits +; + DEFB 14,00000011B ; Enable Baudrategenerator + DEFB 17,00010110B ; Receive/Transmit Interrupts Enable + ; Reset Ext./STatus-Interrupts + +SCCALG EQU $-SCCAINI +; +; SCC Kanal B Initialisierung +; +SCCBINI: + DEFB 11,01010110B ; use Baudrategenerator Output +BDSCCB: + DEFB 12,18 ; Baud Rate Low, Default 9600 Baud + DEFB 13,0 ; Baud Rate High + DEFB 14,00000010B ; Baud Rate Gen. Source = PCLK +BTSCCB: + DEFB 4,01001100B ; No Parity, 2 Stopbits +CTSB: + DEFB 3,11000001B ; Enable Receiver, Datenbits +RTSB: + DEFB 5,11101010B ; Enable Transmitter, Datenbits +; + DEFB 14,00000011B ; Enable Baudrategenerator + DEFB 17,00010110B ; Receive/Transmit Interrupts Enable + ; Reset Ext./Status-Interrupts + DEFB 9,00001001B ; Master Interrupt Enable +; +SCCBLG EQU $-SCCBINI +; +; Baudratentabelle fuer beide SCC-Kanaele +; +BDTAB: + DEFW 3838 ;50 Baud + DEFW 2558 ;75 Baud + DEFW 1743 ;110 Baud + DEFW 1426 ;134.5 Baud + DEFW 1278 ;150 Baud + DEFW 638 ;300 Baud + DEFW 318 ;600 Baud + DEFW 158 ;1200 Baud + DEFW 105 ;1800 Baud + DEFW 78 ;2400 Baud + DEFW 51 ;3600 Baud + DEFW 38 ;4800 Baud + DEFW 25 ;7200 Baud + DEFW 18 ;9600 Baud + DEFW 8 ;19200 Baud + DEFW 3 ;38400 Baud +; +; Datenbereich +; + +ERRBIT: DEFB 0 ; Fehlerbits +KANAL: DEFB 0 ; Kanal mit Eingabezeichen + +CCOUNT: DEFB 8 ; Cursorinvertier Zaehler +;DCOUNT: DEFB 0 ; CHKINT - Weiter Zaehler + +DRUCK: + DEFW 0 ; aktuelle Groesse des Puffers + DEFB HIGH DBUF ; Drucker-Pufferanfang + DEFW DBUF ; Lesezeiger + DEFW DBUF ; Schreibzeiger + DEFB HIGH (DBUF+1000H); Druckerpufferende (excl.) + +SCCATAB: + DEFW 0 ; Aktuelle Groesse des Puffers + DEFB HIGH SABUF ; SCCA-Transmitbuffer Anfang im Basisspeicher + DEFW SABUF ; Lesezeiger + DEFW SABUF ; Schreibzeiger + DEFB HIGH (SABUF+0800H); SCCA-Transmitbufferende (excl.) + DEFB SCCAC ; Controlport +XFLGA: DEFB 0 ; XON/XOFF auf SCCA ausgabeseitig ? + +SCCBTAB: + DEFW 0 ; aktuelle Groesse des Puffers + DEFB HIGH SBBUF ; SCCB-Transmitbuffer Anfang im Basispeicher + DEFW SBBUF ; Lesezeiger + DEFW SBBUF ; Schreibzeiger + DEFB HIGH (SBBUF+0800H); SCCB-Transmitbufferende (excl.) + DEFB SCCBC ; Controlport +XFLGB: DEFB 0 ; XON/XOFF auf SCCB ausgabeseitig ? + +;**************************************************************** + + END + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/L80.COM b/system/shard-z80-ruc-64180/1.5/src/L80.COM new file mode 100644 index 0000000..c9d5c84 Binary files /dev/null and b/system/shard-z80-ruc-64180/1.5/src/L80.COM differ diff --git a/system/shard-z80-ruc-64180/1.5/src/LOAD.MAC b/system/shard-z80-ruc-64180/1.5/src/LOAD.MAC new file mode 100644 index 0000000..5e457e4 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/LOAD.MAC @@ -0,0 +1,170 @@ + TITLE LOADER - SHARD Loader fuer EUMEL System +; + INCLUDE HD64180.LIB +; + .LIST +; +;**************************************************************** +; +; Lader fuer SHARD, wird vom Harddisk Boot aufgerufen +; +; Version 1.0 - 22. 10. 1985 - R. Ellerbrake +; Version 1.2 - 09.01.1987 - M. Staubermann, Konfigurationsblock +; +;**************************************************************** +; + +; Konstanten +; +BASE EQU 1000H ;Lader-Startadresse + .PHASE BASE +DEST EQU 8000H ;Zieladresse fuer SHARD +BOTLNG EQU 40H +SHARD EQU 100H ;SHARD Anfangsadresse +; +; +; Lader wird ab Adresse 1000H im Apple Speicher gestartet +; und kopiert den SHard in den 64180 Speicher +; + +LOAD: + LD A,080H ;0..7FFF:Apple, 8000..FFFF:64180 RAM + OUT0 (CBAR),A +; +; Speicherverwaltung umschalten, log. Adr. 0..7FFFH im unteren +; Bereich des Apple Speichers liegen lassen, Adresse 8000..FFFFH +; auf phys. Adresse 00000H..07FFFH abbilden +; + LD A,0F8H + OUT0 (CBR),A ;F8+8=0! (00000... Phys. = 8000H log.) +; + LD A,60H ; Jetzt offiziell 60000... = 0000H log. + OUT0 (BBR),A ; Wird beim ersten Zugriff auf 180-Memory aktiv +; +; Umschaltroutine kopieren +; + LD HL,UMSCH-LOAD+BASE + LD DE,DEST + LD BC,CONFLG ; Page bis zum Ende uebertragen + LDIR +; + LD A,2 ; Burst Mode, Memory <--> Memory Transfer + OUT0 (DMODE),A + + LD BC,8*0100H+SAR0L; 8 Bytes in DMA-Register transportieren + LD HL,DMATAB + OTIMR + + LD A,01000011B ; DMA Kanal 0 starten + OUT0 (DSTAT),A + + JP DEST ; im 64180-Memory starten (noch 8000H) + +DMATAB: + DEFW SHARD+BASE ; SHard liegt noch ab 1100H + DEFB 6 ; im Basis-Speicher + DEFW SHARD ; soll nach 0100H + DEFB 0 ; im 64180-Speicher + DEFW (BOTLNG-1)*100H ; Bis auf LOAD-Modul (dieses) alles kopieren +; +; Programmstueck zur RAM-Umschaltung phys. 0 = log. 0 +; +UMSCH: + XOR A + OUT0 (BBR),A ; 0000.7FFF log. = 8000..FFFF log = 00000 phys. + JP SHARD ; von 81xx --> 01xx springen + NOP + +CONF: ; Konfigurationsblock + +;-------------------------------------------------------------------------- +NOVTST EQU 200H ; Kein Vortest, kein Speichertest +NOSTST EQU 100H ; Vortest, aber kein Speichertest +FREEU0 EQU 1 ; EUMEL0 auf HG freigeben (loeschen!) +VORTST EQU 0 ; Vortest, Speichertest, (Normalfall) + +BLINKP: + DEFB 8 ; Blinkdauer des Cursors +BEEPFRQ: + DEFB 10 ; Tonfrequenz bei Bell (f = 10kHz/beepfrq) +ARC31: + DEFB 40H, 0, 0 ; LUN der SCSI-Floppy +MODECONF: + DEFW VORTST +ID4: + DEFW 0 ; Lizenznummer des SHards +ID5: + DEFW 0 ; Installationsnummer des SHards +ID6: + DEFW 0 ; reserviert +URLK1: + DEFB 31 ; Archiv +URLK2: + DEFB 0 ; HG + + DEFS 1 ; free + +;-------------------------------------------------------------------------- + + DEFS 40H ; Interrupttabelle + ;ORG BASE+UMSCH-LOAD+58H ; Nach der Interrupttabelle weiter + + +IKANTAB: ; Zuordnungstabelle fuer phys. --> log. + ; Kanaele mit Inputinterrupt + DEFB 0, 1, 2, 3, 4, 5, 6, 7 + +KANTAB: ; Zuordnungstabelle fuer log. --> phys. + ; fuer alle Kanaele + DEFB 0, 1, 2, 3, 4, 5, 6, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH + DEFB 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH, 0FFH + DEFB 0FFH, 0FFH, 0FFH, 0FFH, 28, 29, 30, 31, 32 + +IOFTB: ; Kan. def.Funktionen Beschreibung + DEFB 0CH ; 0 blockin/out Hintergrund + ; Stream I/O & Block I/O + DEFB 0FH ; 1 blockin/out,iint/outvar Konsole-Terminal + DEFB 03H ; 2 iint/outvar SCCB-Terminal + DEFB 03H ; 3 iint/outvar SCCA-Terminal + DEFB 02H ; 4 outvar Drucker 180-Card + DEFB 03H ; 5 iint/outvar Terminal Motherb. + DEFB 02H ; 6 outvar Drucker Motherb. + DEFB 00H ; 7 ----------- nicht definiert + DEFB 00H ; 8 ----------- nicht definiert + DEFB 00H ; 9 ----------- nicht definiert + DEFB 00H ; 10 ----------- nicht definiert + DEFB 00H ; 11 ----------- nicht definiert + DEFB 00H ; 12 ----------- nicht definiert + DEFB 00H ; 13 ----------- nicht definiert + DEFB 00H ; 14 ----------- nicht definiert + DEFB 00H ; 15 ----------- nicht definiert + DEFB 00H ; 16 ----------- nicht definiert + ; Block I/O + DEFB 00H ; 17 ----------- nicht definiert + DEFB 00H ; 18 ----------- nicht definiert + DEFB 00H ; 19 ----------- nicht definiert + DEFB 00H ; 20 ----------- nicht definiert + DEFB 00H ; 21 ----------- nicht definiert + DEFB 00H ; 22 ----------- nicht definiert + DEFB 00H ; 23 ----------- nicht definiert + ; Privilegierte Block I/O + DEFB 00H ; 24 ----------- nicht definiert + DEFB 00H ; 25 ----------- nicht definiert + DEFB 00H ; 26 ----------- nicht definiert + DEFB 00H ; 27 ----------- nicht definiert + DEFB 0CH ; 28 blockin/blockout CP/M-Harddisk-Volume + DEFB 0CH ; 29 blockin/blockout Apple-Drive 1 + DEFB 0CH ; 30 blockin/blockout Apple-Drive 0 + DEFB 1CH ; 31 format,blockin/out SCSI-Floppy + +CPMOFS: DEFB 00H, 0AH, 60H ; Anfang eines CP/M Volumes +CPMLAST:DEFB 00H, 2AH, 60H ; Ende+1 des CP/M Volumes + +CONFLG EQU $-UMSCH + .DEPHASE +; +;**************************************************************** +; + END + + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/M80.COM b/system/shard-z80-ruc-64180/1.5/src/M80.COM new file mode 100644 index 0000000..d575728 Binary files /dev/null and b/system/shard-z80-ruc-64180/1.5/src/M80.COM differ diff --git a/system/shard-z80-ruc-64180/1.5/src/NIBLE.INC b/system/shard-z80-ruc-64180/1.5/src/NIBLE.INC new file mode 100644 index 0000000..25971bc --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/NIBLE.INC @@ -0,0 +1,113 @@ + +; NIBLE.INC for RUC180-Card on BASIS 108 +; +; Version 08.09.85 + + +nible2 ds 57 + +slot10 db 0 + +iob_old_S db 60 +iob_old_D db 60 + +head_table db 0,60,60,60,60,60 + +slotn db 60,50,40 + +time0 db 01,30,28,24,20,1E,1D,1C +time1 db 70,2C,26,22,1F,1E,1D,1C + + +step_wait: + lda #00 ; wird gepatcht +wait + LDX #11 +wait0 DEX + BNE wait0 + INC wait_Cnt + BNE wait1 + INC wait_Cnt+1 +wait1 SEC + SBC #01 + BNE wait + RTS + + ds 96-low(*-start) + +to_bits + db 000,004 + db 098,099,008,00C,09C,010,014,018 + db 0A0,0A1,0A2,0A3,0A4,0A5,01C,020 + db 0A8,0A9,0AA,024,028,02C,030,034 + db 0B0,0B1,038,03C,040,044,048,04C + db 0B8,050,054,058,05C,060,064,068 + + ;LDA #xx 2 + ;JSR wrtnibl 6 6 +wrt_nibl ; len=10 + CLC ; 2 +wrt_nibl1 + PHA ; 3 3 + PLA ; 4 4 +wrt_nibl2 + STA Q6on,X ; 5 5 + ORA Q6off,X ; 4 4 + RTS ; + 6 + 6 + ; ---- --- + ; 32 28 uS + + db 0CA,06C,0CC,070,074,078 + db 0D0,0D1,0D2,07C,0D4,0D5,080,084 + db 0D8,088,08C,090,094,098,09C,0A0 + db 0E0,0E1,0E2,0E3,0E4,0A4,0A8,0AC + db 0E8,0B0,0B4,0B8,0BC,0C0,0C4,0C8 + db 0F0,0F1,0CC,0D0,0D4,0D8,0DC,0E0 + db 0F8,0E4,0E8,0EC,0F0,0F4,0F8,0FC + + if low(*-start) ne 0 + .printx 'Missing bytes !' + endif + +to_bytes + db 000,000,000 +to_nibble + db 096,002,000,000,097 + db 001,000,000,09A,003,000,000,09B + db 000,002,000,09D,002,002,000,09E + db 001,002,000,09F,003,002,000,0A6 + db 000,001,000,0A7,002,001,000,0AB + db 001,001,000,0AC,003,001,000,0AD + db 000,003,000,0AE,002,003,000,0AF + db 001,003,000,0B2,003,003,000,0B3 + db 000,000,002,0B4,002,000,002,0B5 + db 001,000,002,0B6,003,000,002,0B7 + db 000,002,002,0B9,002,002,002,0BA + db 001,002,002,0BB,003,002,002,0BC + db 000,001,002,0BD,002,001,002,0BE + db 001,001,002,0BF,003,001,002,0CB + db 000,003,002,0CD,002,003,002,0CE + db 001,003,002,0CF,003,003,002,0D3 + db 000,000,001,0D6,002,000,001,0D7 + db 001,000,001,0D9,003,000,001,0DA + db 000,002,001,0DB,002,002,001,0DC + db 001,002,001,0DD,003,002,001,0DE + db 000,001,001,0DF,002,001,001,0E5 + db 001,001,001,0E6,003,001,001,0E7 + db 000,003,001,0E9,002,003,001,0EA + db 001,003,001,0EB,003,003,001,0EC + db 000,000,003,0ED,002,000,003,0EE + db 001,000,003,0EF,003,000,003,0F2 + db 000,002,003,0F3,002,002,003,0F4 + db 001,002,003,0F5,003,002,003,0F6 + db 000,001,003,0F7,002,001,003,0F9 + db 001,001,003,0FA,003,001,003,0FB + db 000,003,003,0FC,002,003,003,0FD + db 001,003,003,0FE,003,003,003,0FF + + if low (*-start) ne 0 + .printx 'Missing bytes' + endif + +; Ende von NIBLE.INC + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/PORTS.MAC b/system/shard-z80-ruc-64180/1.5/src/PORTS.MAC new file mode 100644 index 0000000..e90484b --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/PORTS.MAC @@ -0,0 +1,38 @@ +; +;---------------------------------------------------------------- +; +; Port-Adressen +; +SCCAC EQU 41H ;Z8530 (SCC) Kanal A Control +SCCAD EQU 43H ;Z8530 (SCC) Kanal A Daten +SCCBC EQU 40H ;Z8530 (SCC) Kanal B Control +SCCBD EQU 42H ;Z8530 (SCC) Kanal B Daten +; +CIOAD EQU 52H ;Z8536 (CIO) Kanal A Daten +CIOBD EQU 51H ;Z8536 (CIO) Kanal B Daten +CIOCD EQU 50H ;Z8536 (CIO) Kanal C Daten +CIOCTL EQU 53H ;Z8536 (CIO) Control Register +; +SCSIP EQU 80H ;SCSI-Daten-Port +; +RTCS EQU 0C0H ; Sekunden RTC +RTCSA EQU 0C1H ; Sekunden Alarm +RTCM EQU 0C2H ; Minuten RTC +RTCMA EQU 0C3H ; Minuten Alarm +RTCH EQU 0C4H ; Stunden RTC +RTCHA EQU 0C5H ; Stunden Alarm + +RTCDW EQU 0C6H ; Day of Week RTC 1..7 +RTCDY EQU 0C7H ; Day of Month 1..31 +RTCMO EQU 0C8H ; Month 1..12 +RTCYR EQU 0C9H ; Year 0..99 + +RTCRA EQU 0CAH ; Register A, Devider... +RTCRB EQU 0CBH ; Register B, Mode-Flags +RTCRC EQU 0CCH ; Register C, Interrupt-Flags +RTCRD EQU 0CDH ; Register D, VRT-Bit + +RTCRAM EQU 0CEH ; Ab hier bis 0FFH Batary-RAM +; +;---------------------------------------------------------------- + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/SC.COM b/system/shard-z80-ruc-64180/1.5/src/SC.COM new file mode 100644 index 0000000..49872e0 Binary files /dev/null and b/system/shard-z80-ruc-64180/1.5/src/SC.COM differ diff --git a/system/shard-z80-ruc-64180/1.5/src/SCSI.MAC b/system/shard-z80-ruc-64180/1.5/src/SCSI.MAC new file mode 100644 index 0000000..d77778c --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/SCSI.MAC @@ -0,0 +1,1478 @@ + + TITLE SCSI Interface fuer RUC 180 Karte + + INCLUDE HD64180.LIB + + .LIST + +;**************************************************************** +; +; S C S I +; +; Elementare Ein- und Ausgaben auf dem SCSI Interface +; +; Version 0.7, R. Ellerbrake +; Version 0.8 vom 31.12.86, M.Staubermann +; +; Copyright (C) 1985 by R. Ellerbrake +; +; Vers. 0.2: Kommando Transfer per DMA wieder eingebaut +; Vers. 0.3: Reset Signal implementiert +; Vers. 0.4: automatische Erkennung 40/80 Spuren Archiv +; +;**************************************************************** + +; Conditional Switches + +FALSE EQU 0 +TRUE EQU NOT FALSE + +DMA EQU TRUE ;-1 = Daten nur per DMA ausgeben +EUMEL EQU TRUE ;EUMEL Version +SEC8 EQU FALSE ;-1 = 8 Sektor Floppy +TRK40 EQU FALSE ;-1 = Voreinst. 2x40 Spuren +DEBUG EQU FALSE ; Retries bei DMA/Hardwarefehler + +;---------------------------------------------------------------- + +; Globale Adressen + + GLOBAL SCSIIO, PHYSADR, INITS + GLOBAL HDIO, FDIO, INIFLP, INITS1, PARKHD +; +;---------------------------------------------------------------- + +; Externe Adressen + + IF EUMEL + + EXTERNAL WARTE + + ENDIF + +;---------------------------------------------------------------- + +; Port-Adressen + +CIOAD EQU 52H ;Z8536 (CIO) Kanal A Daten +CIOCD EQU 50H ;Z8536 (CIO) Kanal C Daten +CIOCTL EQU 53H ;Z8536 (CIO) Control Register + +SCSIP EQU 80H ;SCSI I/O Port + +;................................................................ + +; Masken und Bits fuer CIO + +MBUSY EQU 08H ;BUSY-Signal von SCSI Schnittstelle +MMSG EQU 10H ;Message-Signal von SCSI Schnittstelle +MDC EQU 20H ;Data(0)/Command(1) Sig. von SCSI +MREQ EQU 80H ;REQ-Signal vom SCSI-Controller +MIO EQU 04H ;I/O Signal von SCSI (0=Tr. Host -> SCSI) +MSELS EQU 02H ;Select Signal zum SCSI Interface + +BSELS EQU 1 ;Bitnummern +BIO EQU 2 +BBUSY EQU 3 +BMSG EQU 4 +BDC EQU 5 +BREQ EQU 7 + +BRESS EQU 3 ;Reset-Signal fuer SCSI Controller +MRESS EQU 78H ;Maske zum Bit setzen (Bit 3) + +PCOMA EQU 8 ;Port A Command and Status + +;................................................................ + +; SCSI-Kommandos + +TST_RDY EQU 0 ;Drive Ready pruefen +RECALIBR EQU 1 ;Drive recalibrieren +REQ_STAT EQU 3 ;Fehlerstatus holen +FORMAT EQU 4 ;Diskette oder Harddisk formatieren +CHK_FORM EQU 5 ;Harddisk Format kontrollieren +FRM_TRKS EQU 6 ;Spuren formatieren +SREAD EQU 8 ;Sektoren lesen (1 od. mehrere) +SVREAD EQU 9 ;Read Verify +SWRITE EQU 10 ;Sektoren schreiben (") +SEEK EQU 11 ;Auf Block positionieren +WBUFFER EQU 15 ;Write Controller Buffer +INITDRV EQU 17 ;Disk Parameter setzen +RINIT EQU 18 ;Disk Parameter lesen +FD48TPI EQU 6*32+4 ;Floppy im Doppelstepmodus betreiben +FD96TPI EQU 6*32+3 ;Floppy im Singlestepmodus betreiben + +FDDRIV EQU 0 ;Floppy Laufwerk Nr. + +;................................................................ + +; Werte fuer SCSIIO-Aufruf + +DMATRA EQU 4000H ;Datentransfer per DMA +;DMATRA EQU 0 ;** TEST ** +RDDAT EQU 8000H ;Lesen vom Controller + +;................................................................ + +; DMA-Controller Werte + +ENABDMA EQU 90H ;Enable Kanal 1 DMA (keine Interrupts) +DISDMA EQU 10H ;Disable Kanal 1 DMA (-> DSTAT) +DE1 EQU 7 ;Bitnummer in DSTAT + +CH1MSK EQU 0F4H ;Nicht fuer Kanal 1 wichtige Bits maskieren +CHGDIR EQU 2 ;Aenderung der Transferrichtung (-> DCNTL) + +;................................................................ + +; Fehlernummern + +WPROTE EQU 13H ; Diskette Schreibgeschuetzt +TSNF EQU 14H ; Target Sector not found + +HARD EQU 0F0H ;Kennung Hardware bzw. Kommandofehler + +NOCONT EQU 0 ;SCSI-Controller nicht angeschlossen +TIMOUT EQU 1 ;Timeout Fehler bei SCSI I/O +ENDERR EQU 2 ;Falsches Kommandoende +ILLD EQU 3 ;Falsche Datenrichtung +EARLYE EQU 4 ;vorzeitiges Kommandoende +ILLCOM EQU 5 ;Fehler bei Kommandoausgabe +STRERR EQU 6 ;Fehler beim Status lesen +DMAERR EQU 7 ;Fehler beim DMA Transfer +UNKNOWN EQU 8 ;undefinierte Fehlerfaelle +MULCNT EQU 10 ; Reset nach 10 hardwarefehlern + +;---------------------------------------------------------------- + +; Lokale Daten + + DSEG + +SCSIST: DEFS 4 ;4 Byte Stati +CODALN: DEFW 0 ;Datenlaenge +SEMA: DEFB 0 ;Zugriffs-Semaphor +TOFLG: DEFB 0 ;Timeoutflag + + IF DEBUG +RETRCN: DEFB 4 ;Retry Flag +HERCNT: DEFB 10 ;Hardwarefehlerzaehler + ENDIF + + CSEG + +;**************************************************************** +; +; SCSIIO +; +; Elementare Ausgabe auf SCSI-Interface +; +; Entry: HL = Zeiger auf Datenbereich (falls vorhanden) +; DE = Zeiger auf Kommandobereich (immer 6 Byte) +; BC = Groesse des Datenbereichs (0=nicht vorhanden) +; B Bit 7: 1 = Lesen vom SCSI-Controller +; 0 = Schreiben auf SCSI-Controller +; B Bit 6: 1 = Datentransfer per DMA +; 0 = Datentransfer per Programm +; +; Exit: A = Status (0 = ok, <>0 = Fehlercode) +; alle anderen Register (ausser AF) unveraendert +; +SCSIIO: + IF DEBUG + LD A,3 ;Retries bei Unknown Error + ENDIF + +NRETSC: + IF DEBUG + LD (RETRCN),A + ENDIF + + PUSH HL + PUSH BC + PUSH DE + + CALL SCSI2 ;Kommando ausfuehren + LD L,A + AND 9FH ;Drive Code ausmaskieren + JR Z,EOCOM ;Kein Fehler -> + + CP 2 ;SCSI-Fehler ? + LD A,L + JR NZ,EOCOM ;Nein -> fertig + + POP HL ;Kommandotab.-Adr. + PUSH HL + LD A,(HL) ;altes Kommando retten + PUSH AF + LD A,HARD+STRERR ;Fehler beim Status lesen annehmen + LD (SCSIST),A + LD (HL),REQ_STAT ;Kommando 3: Request Status + EX DE,HL + LD BC,4+RDDAT ;4 Byte Status Informationen + LD HL,SCSIST ;Statusbereich + CALL SCSI2 + POP AF + POP HL + LD (HL),A ;altes Kommando zurueckschreiben + PUSH HL + LD A,(SCSIST) + RES 7,A + AND A ;Meldung: kein Fehler ? + JR NZ,EOCOM + +; kein Fehler: falsche Meldung da vorher einer aufgetreten war !! + + LD A,HARD+UNKNOWN ;unbekannnter Fehler melden + +EOCOM: + POP DE + POP BC + POP HL + + IF DEBUG + CP HARD+ENDERR + JR C,RETSCSI + + LD A,(RETRCN) + DEC A + JR NZ,NRETSC ;Retries bei "Unknown Error" + + LD A,HARD+UNKNOWN +RETSCSI: + PUSH HL + LD HL,HERCNT ;Hardware Fehler Zaehler + CP HARD ;Hardware Fehler ? + JR C,NOHER ;Nein -> + + DEC (HL) + JR NZ,EOHER ;nicht mehrere Hardwarefehler hintereinander + + LD (HL),MULCNT + PUSH AF + PUSH DE + PUSH BC + CALL INITS1 ;Schnittstelle neu initialisieren + POP BC + POP DE + POP AF + JR EOHER + +NOHER: + LD (HL),MULCNT + +EOHER: + POP HL + ENDIF + + AND A + RET + +;................................................................ +; +; SCSI2 +; +; Kommandoausgabe auf dem SCSI-Interface +; +; Entry-Parameter wie SCSIIO +; +; Exit: A = 0: alles ok +; A = 2: Fehler ist aufgetreten +; A >= F0H: Hardware oder Bedienungsfehler +; +SCSI2: + PUSH BC ;Laenge retten + +; Pruefen ob letzter DMA beendet wurde + + IN0 A,(DSTAT) ;DMA beendet ? + BIT DE1,A + JR Z,DMAOK ;Ja -> + + LD A,DISDMA ;Reset Kanal 1 DMA + OUT0 (DSTAT),A + +DMAOK: + LD BC,CIOAD ;B=0 ! + JR TENDLP + +; "Bus free", Controller selektieren + +BUSYOK: + IN A,(C) + SET BSELS,A ;Select Leitung aktivieren + OUT (C),A + RES BSELS,A ;und wieder zuruecknehmen + OUT (C),A + +; "Command Phase" + + XOR A + +WAIREQ: + PUSH AF ;Auf Kommandoanforderung warten + IN A,(C) + AND MDC+MREQ+MIO+MMSG + CP MDC+MREQ + JR Z,RDYCOM ;Ok -> + + POP AF + DEC A + JR NZ,WAIREQ + +; keine Reaktion der Schnittstelle: Versuchen Restbytes einzulesen falls +; dies nicht der 2. Timeout ist. + + LD A,(TOFLG) ;Timeoutflag gesetzt ? + AND A + LD A,HARD+TIMOUT ;Timeout Fehler + JP NZ,POPRET ;bereits gesetzt -> + + LD (TOFLG),A ;Timeoutflag setzen + +; ggf. letztes Kommando abschliessen + +TENDLP: + IN0 A,(CIOAD) ;"Bus free" ? + BIT BBUSY,A + JR Z,BUSYOK ;Ja -> neu selektieren + + CALL CHKREQ + BIT BIO,A + JR NZ,INPU + + XOR A + OUT0 (SCSIP),A + JR TENDLP + +INPU: + IN0 A,(SCSIP) + JR TENDLP + +ILLMOD: + LD A,HARD+ILLCOM ;Fehler bei Kommandoausgabe + JP POPRET + +; Kommando Ausgabe + +RDYCOM: + POP AF ;Clear Stack + LD BC,SCSIP+6*256 ;6 Bytes ausgeben + EX DE,HL + +CMNON: + CALL CHKREQ + CP MDC + JR NZ,ILLMOD ;keine Kommandoausgabe -> Fehler + + DI + OTIM ;Kommando ausgeben + EI + JR NZ,CMNON ;Nicht fertig -> + +; "Data Phase" + + POP HL ;B=0! + PUSH HL + LD A,H ;Datenlaenge = 0 ? + AND 3FH ;Bit 6 und 7 ausblenden + OR L + JP Z,NODAT ;Ja -> keine Datenphase + + IF NOT DMA + + BIT 6,H ;Datentransfer per DMA ? + JR Z,DTAPROG ;Nein -> per Programm + + ENDIF + +; CIO Pattern Match Logik aktivieren + + DI + LD C,CIOCTL ;CIO Control Register + LD A,PCOMA ;Port A Command Register + OUT (C),A + LD A,20H ;Clear IP & IUS + OUT (C),A + EI + +;* IF DMA AND EUMEL + +;* BIT 7,H ;schreiben ? +;* JR Z,POLWRIT + +;* ENDIF + +; DMA-Kanal 1 initialisieren (I/O Adresse wird in SCINIT gesetzt) + + CALL DMASTUP ;DMA-Adressen eintragen + +;* IF NOT EUMEL + + BIT 7,H ;lesen ? + JR Z,ISWRITE ;Nein -> + +;* ENDIF + + OR CHGDIR ;Richtung aendern (I/O -> Memory) + +ISWRITE: + OUT0 (DCNTL),A + LD A,ENABDMA ;DMA aktivieren + OUT0 (DSTAT),A + +; Auf Kommandoende warten +; Die CIO ist so initialisiert dass der SCSI-Status "Status lesen" +; einen Pattern Match Zustand erzeugt + +WEND2: + LD C,CIOCTL ;auf Pattern Match warten + +WAIEND: + + IN0 L,(DSTAT) ;DMA Status pruefen + DI + LD A,PCOMA ;Port A Command Register + OUT (C),A + IN A,(C) ;CIO Status lesen (Port A Statusregister) + BIT 5,A ;Interrupt pending ? + JR NZ,DATRDY ;Ja -> Datentransfer beendet + + EI + IN0 A,(CIOAD) + BIT BBUSY,A ;steht Busy noch an ? + JR Z,ILLEND + + BIT DE1,L ;DMA beendet ? + JR Z,DMAEND + +NOEND: + IF EUMEL + CALL WARTE ;andere Tasks zulassen + ENDIF + + JR WAIEND + +; Pruefen ob ein DMA-Fehler aufgetreten ist + +DMAEND: + IN0 A,(CIOAD) + + BIT BREQ,A ;Anforderung ? + JR Z,NOEND ;Nein -> warten + + AND MDC+MIO+MMSG + CP MDC+MIO ;Statusanforderung ? + JR Z,CMNST ;Ja -> alles in Ordnung + +; Fehler beim DMA-Transfer + + LD L,HARD+DMAERR + JR WENDLP + +DATRDY: + IN A,(C) ;Pattern match testen + EI + BIT 1,A + JR Z,ENDKL ;Nein -> DMA hat Status geklaut + +CMNST: + + IN0 L,(SCSIP) ;Status holen + +; Letztes Statusbyte holen (Kommandoende) + + CALL CHKREQ + IN0 H,(SCSIP) ;letzten Status einlesen (Dummy Read) + CP MDC+MIO+MMSG ;wirklich letzter Status ? + JR Z,ENDOK ;Ja -> + +ILLEND: + LD L,HARD+ENDERR + +ENDOK: + LD A,L ;Status in A + +POPRET: + POP BC + +; Interrupt Daisy Chain der CIO freigeben + + DI + LD L,PCOMA ;Port A Command + OUT0 (CIOCTL),L + LD L,20H ;Clear IP & IUS + OUT0 (CIOCTL),L + EI + RET + +ENDKL: + +; DMA anhalten falls dieser nicht beendet wurde + + LD L,DISDMA ;Reset Kanal 1 DMA + OUT0 (DSTAT),L + LD L,2 ;Error Status + +WENDLP: + IN0 A,(CIOAD) ;"Bus free" ? + BIT BBUSY,A + JR Z,ENDOK ;Ja -> fertig + + CALL CHKREQ + BIT BIO,A + JR NZ,INPU2 + + XOR A + OUT0 (SCSIP),A + JR WENDLP + +INPU2: + IN0 A,(SCSIP) ;Dummy Read + JR WENDLP + + IF NOT DMA + +; Datentransfer bei Schreiben per Programm + +POLWRIT: + CALL CHKREQ + JR NZ,NODAT ;Kein Datentransfer -> Fehler + + BIT BIO,A ;Lesen von SCSI ? + JR NZ,DIRERR ;Ja -> falsche Richtung + + LD A,(DE) ;Daten holen + OUT0 (SCSIP),A ;und ausgeben + + INC DE ;Datenadresse inkrementieren + DEC HL ;Datenlaenge dekrementieren + LD A,H ;Fertig ? + AND 3FH + OR L + JR NZ,POLWRIT ;Nein -> naechstes Byte holen + + JP WEND2 + +; Falsche Datenrichtung (falsches Kommando) + +DIRERR: + LD A,HARD+ILLD + JR POPRET + +; Datentransfer per Programm + +DTAPROG: + CALL CHKREQ + JR NZ,NODAT ;Kein Datentransfer -> Fehler + + BIT BIO,A ;Lesen von SCSI ? + JR NZ,RDSCSI ;Ja -> + + BIT 7,H ;Schreiben definiert ? + JR NZ,DIRERR ;Nein -> falsche Richtung !! + + LD A,(DE) ;Daten holen + OUT0 (SCSIP),A ;und ausgeben + + JR CMDIO + +RDSCSI: + BIT 7,H ;Lesen definiert ? + JR NZ,RDSOK ;Ja -> + +; Falsche Datenrichtung (falsches Kommando) + +DIRERR: + LD A,HARD+ILLD + JR POPRET + +RDSOK: + IN0 A,(SCSIP) ;Daten holen + LD (DE),A + +CMDIO: + INC DE ;Datenadresse inkrementieren + DEC HL ;Datenlaenge dekrementieren + LD A,H ;Fertig ? + AND 3FH + OR L + JR NZ,DTAPROG ;Nein -> naechstes Byte holen + + ENDIF + +; Status lesen + +NODAT: + CALL CHKREQ + CP MDC+MIO ;Status Anforderung ? + JR NZ,ILLEND ;Nein -> Fehler + JR CMNST + +;................................................................ +; +; Pruefen ob Busy und Request anstehen +; +; Exit: A = CIO Port A SCSI-Status Leitungen (ohne BUSY und REQ) +; F = Z: Datentransfer +; +CHKREQ: + IN0 A,(CIOAD) + BIT BBUSY,A ;Busy aktiv ? + JR Z,INCOMPL ;Nein -> vorzeitiges Kommandoende + + BIT BREQ,A ;Anforderung ? + JR Z,CHKREQ ;Nein -> warten + + AND MDC+MIO+MMSG + BIT BDC,A + RET + +INCOMPL: + POP HL ;Skip Return Adresse + LD A,HARD+EARLYE ;vorzeitiges Ende + JR POPRET + +;................................................................ +; +; DMASTUP +; +; Adressen des DMA-Kanals 1 eintragen +; +; Entry: DE = log. Adresse +; DE = 0: auf 6502 Bereich FC00 schalten +; +; Exit: A = (DCNTL) Kanal 1 +; +DMASTUP: + DI + LD A,D + OR E + JR NZ,DOCHG + + LD A,6 + LD D,0FDH ; 6FD00..6FEFF ist SCSI-Puffer + JR NOCHG + +DOCHG: + CALL PHYSADR ;Physikalische Adresse bestimmen (in ADE) + +NOCHG: + LD C,MAR1L ;Adressen eintragen + OUT (C),E ;Speicheradresse eintragen (LSB) + INC C + OUT (C),D ;mittleres Byte + INC C + OUT (C),A ;upper Byte + LD C,BCR1L + OUT (C),L ;Byte Zaehler (LSB) + INC C + LD A,H + AND 3FH + OUT (C),A ;MSB + + IN0 A,(DCNTL) ;DMA-Richtung setzen + AND CH1MSK ;nur DMA-Kanal 1 Bits veraendern ! + EI + RET + +;................................................................ +; +; P H Y S A D R +; +; Umrechnung der logischen in eine physikalische Adresse +; +; Entry: DE = logische Adresse im 64K Adressraum +; +; Exit: DE = niederwertiger Teil der phys. Adr. im 512K Adr.-raum +; A = hoechstwertiges Nibble der phys. Adr. +; alle anderen Register bleiben unveraendert +; +PHYSADR: + INC D ;Fuer Vergleiche + IN0 A,(CBAR) ;Common Bank Area Register + PUSH AF + AND 0F0H ;Common Area Teil ausmaskieren + CP D ;D >= Common Area 1 Anfang ? + JR C,COMA1 ;Ja -> (Stack!!) + + POP AF + AND 0FH ;Bank Area Teil ausmaskieren + RLCA + RLCA + RLCA + RLCA ;und ins MSN schieben + CP D ;D >= Bank Area Anfang ? + JR C,BAR ;Ja -> + +; Common Area 0 (unveraenderte Adresse) + + DEC D ;D wieder korrigieren + XOR A + RET + +; Bank Area + +BAR: + DEC D + IN0 A,(BBR) ;Bank Base Register + +CMND: + PUSH BC + LD B,0 + SLA A + RL B + SLA A + RL B + SLA A + RL B + SLA A + RL B ;B = MSN Phys. Adr., A = mittleres MSB + + ADD A,D ;+ Offset zum Area Anfang + LD D,A ;wieder in D (mittleres MSB der phys. Adr.) + LD A,B ;A = MSN + ADC A,0 ;ggf. 64K-Uebertrag beruecksichtigen + POP BC + RET + +; Common Area 1 + +COMA1: + DEC D ;D wieder korrigieren + POP AF ;Clear Stack + IN0 A,(CBR) + JR CMND + + IF EUMEL + +;................................................................ +; +; C H K A C C +; +; Auf Freiwerden des SCSI-Controllers warten +; +CHKACC: + LD A,(SEMA) ;SCSI-Zugriffssemaphor + AND A ;0=frei + JR Z,ISFREE ;Ja -> + CALL WARTE + JR CHKACC + +ISFREE: + DEC A + LD (SEMA),A ;Semaphor sperren + RET + + ENDIF + +;................................................................ +; +; I N I T S +; +; Initialisierung der SCSI-Schnittstelle +; +; CIO und DMA Kanal 1 werden initialisiert +; Floppy Parameter werden gesetzt +; +; Exit: AF', BC, DE und HL werden veraendert +; AF = Status des Floppy Parameters setzens +; +INITS1: + IF NOT EUMEL + CALL INICIO + ENDIF + +INITS: + IF EUMEL + XOR A + LD (SEMA),A ;Semaphor initialisieren + ENDIF + + LD C,DISDMA + OUT0 (DSTAT),C ;Kanal 1 stoppen, beide Kanaele keine + ; Interrupts zulassen + +; DMA - Kanal 0 intialisieren (Memory <--> Memory Transfer) + + LD C,2 ; Memory <--> Memory im Burst Mode + OUT0 (DMODE),C + +; DMA - Kanal 1 initialisieren (Memory <--> SCSI I/O - Transfer) + + LD BC,SCSIP ;DMA-Kanal 1 I/O Adresse auf SCSI setzen + OUT0 (IAR1L),C + OUT0 (IAR1H),B + +; Warten bis Harddisk hochgelaufen ist + + IF NOT EUMEL +WRTHRD: + LD DE,TESTRD + LD BC,0 + CALL SCSIIO + AND A ;Drive not Ready ? + JR NZ,WRTHRD ;Ja -> warten + + ENDIF + +; Teil der bei Controller RESET neu initialisert werden muss + +SCINIT: + +; Floppy Parameter setzen + + LD DE,FLPINI ;Initialize Kommando + LD HL,FLPDAT ;Parameter + LD BC,PARALNG ;Anzahl der Parameter Bytes + CALL SCSIIO + + LD L,A + LD A,(FLPTRKS) + CP 40 ;40 Tracks ? + LD A,L + LD BC,0 + LD DE,SGLSTEP ; Floppy im Doppelstep Modus + JR NZ,NODBLS ;Nein -> kein Double Step + LD DE,DBLSTEP +NODBLS: + JP SCSIIO + +;................................................................ +; +; I N I C I O +; + IF NOT EUMEL +INICIO: + DI + +; CIO initialisieren + + IN0 C,(CIOCTL) ;Dummy Read + LD B,INILNG + LD HL,INITAB ;CIO Initialisierungstabelle + +INILOP: + LD C,(HL) ;Wert holen + OUT0 (CIOCTL),C ;und ausgeben + INC HL + DJNZ INILOP + RET + ENDIF + +;................................................................ +; +; P A R K H D +; +; Harddisk in Parkposition fahren +; +PARKHD: + + LD BC,0 + LD DE,PARSEK ; seek (0) + CALL SCSIIO + LD DE,RECAL ; Recalibrate + JP SCSIIO + + IF 0 + LD HL,INIHDT + LD DE,RDINI + LD BC,RDDAT+PARALNG + + CALL SCSIIO ;Harddisk Konfiguration lesen + + LD HL,(INIHDT) ;Spuranzahl (H=LSB!) + PUSH HL + INC H ;um 1 erhoehen + JR NZ,INCOK + + INC L +INCOK: + LD (INIHDT),HL + LD HL,RDINI + LD DE,INIHDT + LD (HL),INITDRV ;Init-Schreibkommando eintragen + EX DE,HL + LD BC,PARALNG + + CALL SCSIIO ;neue, groessere, Konfiguration setzen + + POP HL + + LD D,L + LD L,H + LD H,D ;Spuranzahl richtig + LD A,(INIHDT+2) ;Kopfanzahl + LD E,L + +HDLOP: + DEC A + JR Z,HDAOK + + ADD HL,DE + JR HDLOP + +HDAOK: + XOR A + ADC HL,HL + RLCA + ADC HL,HL ;*4 + RLCA + ADC HL,HL ;*8 + RLCA + ADC HL,HL ;*16 + RLCA + ADC HL,HL ;*32 + RLCA + +; max. Blocknr. in AHL + + DEC HL ;-1: 1.Block hinter formatiertem Bereich + + LD (BKNR),A + LD A,L + LD L,H + LD H,A + + LD (BKNR+1),HL ;Blocknr. eintragen + LD BC,0 ;keine Daten + LD DE,PARSEK + + JP SCSIIO ;Drive parken + + ENDIF + +;................................................................ +; +; H D I O +; +; Lesen / Schreiben eines Blocks (512 Byte) auf der Harddisk +; +; Entry: A = Kommandocode (0 = Lesen, 1 = Schreiben) +; HL = Hauptspeicheradresse +; BC = Pointer auf Drive und Offset (256 Byte Bloecke) +; DE = (512 Byte-) Blocknummer (ohne Offset) +; +; BC + 2 -> Low (Block Offset) +; BC + 1 -> Middle (Block Offset) +; BC + 0 -> High (BLock Offset) + Drive * 32 +; +; Exit: A = Status (0=ok, sonst SCSIIO-Fehlercode) +; BC, DE, HL, AF' = veraendert +; +FDIO: +HDIO: + PUSH AF + XOR A + LD (TOFLG),A ;Timeoutflag ruecksetzen + + IF EUMEL + + CALL CHKACC ;Pruefen ob SCSI-Controller bereits belegt ist + + ENDIF + + LD A,(BC) + BIT 6,A ;Floppy Drive ? + JP NZ,FDIO1 ;Ja -> + + POP AF + + CP 2 + JR C,COMOK1 + + LD A,20H ;illegal Command Code + RET + +COMOK1: + PUSH HL + PUSH BC + CALL CMSCOM ;Kommandonr. umrechnen + LD (HDIOTB),A ;Kommando eintragen + POP BC + LD HL,(CODALN) ;Datenlaenge + PUSH HL + LD HL,HDIOTB+3 ;Harddisk Read Command + + SLA E ;Blocknummer * 2 (256 Byte Bloecke) + RL D + +CMFDIO: + INC BC + INC BC + LD A,(BC) ;Low Offset + ADD A,E ;+ Low Block No. + LD (HL),A ;eintragen + DEC HL + DEC BC + LD A,(BC) ;Middle Offset + ADC A,D ;+ Block No. + LD (HL),A + DEC HL + DEC BC + LD A,(BC) + LD (HL),A ;Drive + High Blocknr. + DEC HL + EX DE,HL ;DE = Read Command Adresse + POP BC ;Datenlaenge + POP HL ;Hauptspeicheradresse + CALL SCSIIO + + IF EUMEL + + PUSH AF + XOR A + LD (SEMA),A ;Semaphor freigeben + POP AF + + ENDIF + + RET + +;................................................................ +; +; I N I F L P +; +; Blockanzahl der Floppy ermitteln (nur BC, A und HL veraendern !!) +; +; Eingang:A = Anzahl Spuren, Voreinstellung (40 oder 80) +; Exit: BC = Blockanzahl der Floppy (in 512 Byte Bloecken) +; A = 0 = ok, <> 0 = SCSI-Fehlercode +; +INIFLP: + PUSH AF ; Anzahl Spuren Voreinstellung (40, 80) + + IF EUMEL + CALL CHKACC ;keine Doppelzugriffe !! + ENDIF + + XOR A + LD (TOFLG),A ;Timeoutflag ruecksetzen + POP AF + + PUSH HL + PUSH DE + + LD (FLPTRKS),A ;Spuren eintragen + CALL SCINIT ;Floppy Parameter setzen + + LD A,2 ;Retry-Anzahl +RETR1: + PUSH AF + + LD DE,SEK18 ; Auf Block 18 (Track 2) + LD BC,RDDAT+512 + LD HL,0 + LD A,1 + CALL NRETSC ;Read ohne Retries + + AND 7FH + LD C,A + JR Z,OKA ; Format ok + + CP TSNF ; Target Sector not found ? + CALL Z,TOB ; anderes Format (B) versuchen + + POP AF ; Anderer Floppy Fehler, Retries + DEC A + JR NZ,RETR1 + + XOR A + LD (SEMA),A + + LD A,C ; permanenter Fehler + + LD BC,0 + POP DE + POP HL + RET + +; auf B Spuren umschalten + +TOB: + LD A,(FLPTRKS) + XOR 01111000B ; aus 40 wird 80, aus 80 wird 40 + LD (FLPTRKS),A + CALL SCINIT ;Floppy Parameter setzen + LD C,TSNF + RET + +OKA: + POP AF + POP DE + POP HL + + LD BC,(FLPTRKS) + + IF SEC8 + LD B,8 + ELSE + LD B,9 + ENDIF + + MLT BC + SLA C ;*2: 2 Seiten + RL B + XOR A + + IF EUMEL + LD (SEMA),A ;Sempahor wieder freigeben + ENDIF + + RET + +;................................................................ +; +; F D I O +; +; Lesen oder Schreiben eines Blocks (512 Byte) auf der Floppy Disk +; +; Entry: A = Kommandocode (0=Lesen, 1=Schreiben, 2=Formatieren) +; HL = Hauptspeicheradresse +; BC = Pointer auf Drive und Offset (512 Byte Bloecke) +; DE = (512 Byte-) Blocknummer (ohne Offset) +; +; BC + 2 -> Low (Block Offset) +; BC + 1 -> Middle (Block Offset) +; BC + 0 -> High (BLock Offset) + Drive * 32 +; +; Exit: A = Status (0=ok, sonst SCSIIO-Fehlercode) +; BC, DE, HL, AF' = veraendert +; +FDIO1: + POP AF + CP 3 + JR C,COMOK + + LD A,20H ;illegal Command Code + RET + +COMOK: + PUSH HL + PUSH BC + CP 2 + + CALL Z,SW80 ;Beim Formatieren immer 2x80 Spuren + + CALL CMSCOM ;Kommando und Datenlaenge best. + LD (FDIOTB),A ;Kommandocode eintragen + + LD A,C + LD (FDIOTB+4),A ;Block Count / Skew Faktor eintragen + +; DE enthaelt Blocknummer x aus EUMEL-Sicht. +; Block x meint die 512 Bytes ab 512*x auf Floppy. +; +; Aus Blocknummer: Spur, Sector, Seite berechnen +; +; EUMEL behandelt, im Gegensatz zum SCSI-Controller, +; zunaechst die Oberseite der Floppy und erst dann die Unterseite. + + LD H,D + LD L,E + XOR A + + IF SEC8 + LD DE,8 + ELSE + LD DE,9 ;Anzahl der Sektoren pro Spur + ENDIF + +DIVLOP: + AND A + SBC HL,DE + JR C,DIVDON + INC A + JR DIVLOP + +DIVDON: + ADD HL,DE + +; A = Spurnummer; HL = sector/seite + + LD BC,(FLPTRKS) ;Spuren pro Seite (B undefiniert !) + CP C ;Rueckseite ? + JR C,NOBACK ;Nein -> alles ok + +; Rueckseite: Spurnummer := Spurnummer - Spuranzahl +; Sektornummer := Sektornummer + Sektoranzahl (9) + + SUB C ;tatsaechliche Spurnummer + ADD HL,DE ;HL = sector (cylinder) + +; SCSI Blocknummer aus Spur und Sektor ausrechnen + +NOBACK: + LD D,A + + IF SEC8 + LD E,16 + ELSE + LD E,18 + ENDIF + + MLT DE ;DE = Spur * 18 + ADD HL,DE ;HL = Spur * 18 + Sektor (cylinder) + EX DE,HL + +; SCSI Blocknummer in DE + + POP BC ;Offsetadresse wiederherstellen + + LD HL,(CODALN) + PUSH HL + LD HL,FDIOTB+3 ;Floppy Read Command + JP CMFDIO + +SW80: + PUSH AF + PUSH BC + PUSH DE + PUSH HL + + LD A,80 ; 80 Tracks + LD (FLPTRKS),A + CALL SCINIT + + POP HL + POP DE + POP BC + POP AF + RET + +;................................................................ +; +; C M S C O M +; +; Entry: A = Funktionsnr. +; +; Exit: A = SCSI-Kommandonr. +; C = Block Count / Skew Faktor +; HL = veraendert +; B = veraendert +; (CODALN) = Datenlaenge +; +CMSCOM: + LD BC,LGTAB ;Datenlaenge ermitteln + LD L,A + LD H,0 + ADD HL,HL ;16 Bit Werte + ADD HL,BC + LD C,(HL) + INC HL + LD B,(HL) + LD (CODALN),BC + + LD HL,COMTB ;Kommandonr. umrechnen + ADD A,L + LD L,A + LD A,H + ADC A,0 + LD H,A + LD A,(HL) ;SCSI-Kommando holen + + LD BC,BCSKTB-COMTB + ADD HL,BC + LD C,(HL) ;Block Count ./. Skew Faktor holen + + RET + +;**************************************************************** +; +; SCSI-Kommandotabellen +; +; Achtung: Die Schreib- und Lesetabellen werden vom Programm +; geaendert (muessen im RAM stehen) +; +COMTB: + DEFB SREAD ;Lesekommando + DEFB SWRITE ;Schreibkommando + DEFB FORMAT ;Formatierkommando + +LGTAB: + DEFW 512+DMATRA+RDDAT ;Datenlaenge Lesen + DEFW 512+DMATRA ;Datenlaenge schreiben + DEFW 0 ;Datenlaenge formatieren + +BCSKTB: + DEFB 1 ;1 Block lesen (nur Floppy) + DEFB 1 ;1 Block schreiben (") + DEFB 4 ;Skew 4 (nur Floppy) + +;................................................................ +; + IF NOT EUMEL +TESTRD: + DEFB 0,0,0,0,0,0 ;Test Ready (Harddisk) + ENDIF + + +FDIOTB: ;Lesen / Schreiben auf Floppy Disk + DEFB SREAD ;Lesekommando (wird ueberschrieben) + DEFB FDDRIV*32+40H ;Floppy Drive (wird ueberschrieben) + DEFB 0, 0 ;Block Middle und Low (") + DEFB 1 ;Block Count / Interleave (Format) + DEFB 80H ;keine Retries + + +HDIOTB: ;Lesen / Schreiben auf Harddisk + DEFB SREAD ;Lesekommando (wird ueberschrieben) + DEFB 0 ;Harddisk Drive (wird ueberschrieben) + DEFB 0, 0 ;Block Middle und Low (") + DEFB 2 ;Block Count + DEFB 0H ;Retries + + IF 0 +RDINI: + DEFB RINIT ;Harddisk Konfiguration lesen + DEFB 0 ;Harddisk Drive + DEFB 0,0,0,0 +INIHDT: + DEFB 0,0,0,0,0 + DEFB 0,0,0,0,0 + ENDIF + + +RECAL: + DEFB RECALIBR ;Drive recalibrieren + DEFB 0 ; Harddisk + DEFB 0,0,0,80H ; keine Retries + + +PARSEK: + DEFB SEEK + DEFB 0 ;Harddisk + DEFB 0,0,0 + DEFB 80H ;keine Retries + + +FLPINI: ;Setze Floppy Parameter + DEFB INITDRV ;Initialize Kommando + DEFB FDDRIV*32+40H ;Floppy Drive + DEFB 0, 0, 0, 0 ;nicht benutzt +FLPDAT: ;Floppy Disk Parameter zu INIFLP + DEFB 0 +FLPTRKS: + IF TRK40 + DEFB 40 ;Spuranzahl + ELSE + DEFB 80 + ENDIF + + DEFB 2 ;2 Koepfe (doppelseitig) + DEFB 1*16+3 ;4 ms Steprate, MFM + DEFB 3 ;512 Byte/Sektor + DEFB 15 ;Head Unload Time (240ms) + DEFB 10 ;Motor Start Time (0.1 s) + DEFB 23 ;Head Load Time (46 ms) + DEFB 3 ;Motor off time (3 s) + IF SEC8 + DEFB 0 ;8 Sektoren/Spur + ELSE + DEFB 1 ;9 Sektoren/Spur + ENDIF + +PARALNG EQU $-FLPDAT + + +DBLSTEP: + DEFB FD48TPI ;Doppel Step aktivieren + DEFB FDDRIV*32+40H ;Floppy Drive + DEFB 0, 0, 0, 0 ;nicht benutzt + + +SGLSTEP: + DEFB FD96TPI ;auf Single Step zurueckschalten + DEFB FDDRIV*32+40H + DEFB 0, 0, 0, 0 ;nicht benutzt + + +SEK18: + DEFB SREAD ;auf Block positionieren + DEFB FDDRIV*32+40H ;Floppy Drive + DEFB 0,18,1,80H ;Track 2, ein Block, keine Retries + + +;........................................................................... +; +; CIO Initialisierungs Tabelle +; + + IF NOT EUMEL + +INITAB: +;* DEFB 0,1 ;Set Reset Bit + DEFB 0,0 ;Reset Reset Bit + DEFB 1,0 ;Master configuration control + +; SCSI-Interface-Leitungen + + DEFB 20H,00000010B ;Port A Mode Reg. + DEFB 22H,01000010B ;Port A Data Path Polarity Reg. + DEFB 23H,10111101B ;Port A Data Direction Reg. + DEFB 24H,0 ;Port A Special I/O Control + DEFB 25H,10101100B ;Port A Pattern Polarity + DEFB 26H,0 ;Port A Pattern Transition + DEFB 27H,10101100B ;Port A Pattern Mask + DEFB 0DH,0 ;Port A Data + DEFB 02H,18H ;Port A Interrupt Vector (** TEST **) + DEFB PCOMA,11100000B ;Port A Command: Clear IE + DEFB PCOMA,00100000B ;Port A Command: Clear IUS & IP + +; General Purpose Port (Centronics, SCSI, 6502-IRQ-Maske) + + DEFB 06H,00000001B ;Port C Data Direction Reg. + DEFB 05H,00001000B ;Port C Data Path Polarity Reg. + DEFB 07H,0 ;Port C Special I/O Control + DEFB 0FH,4 ;Port C Data Register + +; Centronics Interface + + DEFB 28H,10010000B ;Port B Mode + DEFB 29H,01000000B ;Port B Handshake: Strobed + DEFB 09H,00100000B ;Port B Command: Clear IUS & IP + DEFB 2AH,0 ;Port B Data Path Polarity + DEFB 2CH,0 ;Port B Special I/O Control + DEFB 03H,30H ;Port B Interrupt Vektor + +; Deskew Timer + + IF 0 + DEFB 1EH,00000010B ;Counter 3 Mode Specification + DEFB 0CH,00100000B ;Counter 3 Command and Status + DEFB 1AH,0 ;Counter 3 Time Constant MSB + DEFB 1BH,7 ;Counter 3 Time Constant LSB (2,268 us) + DEFB 0CH,11100100B ;Counter 3 Gate Enable + ENDIF + +; Timer + + DEFB 1CH,10000000B ;Counter/Timer 1 Mode Spec. Reg. + DEFB 1DH,10000000B ;Counter/Timer 2 Mode Spec. Reg. + DEFB 0AH,00100000B ;Counter/Timer 1 Command: Clear IP & IUS + DEFB 0BH,00100000B ;Counter/Timer 2 Command: Clear IP & IUS + DEFB 16H,HIGH 38400 ;Time Constant 1 MSB + DEFB 17H,LOW 38400 ;Time Constant 1 LSB + DEFB 18H,0 ;Time Constant 2 MSB, mit Timer 1 zus. 50ms + DEFB 19H,4 ;Time Constant 2 LSB + DEFB 04H,18H ;Interrupt Vector Counters + +; CIO-Interrupts freigeben + + DEFB 01H,11110111B ;Master Config. Register + DEFB 00H,10000010B ;Master Interrupt Enable + + DEFB 09H,11000000B ;Port B Command: Set IE + + DEFB 0BH,11000110B ;Counter/Timer 2 Command: Set IE + DEFB 0AH,11100110B ;Counter/Timer 1 Command: Clear IE + +INILNG EQU $-INITAB + ENDIF + + +;**************************************************************** + + END + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/SCSI.PAS b/system/shard-z80-ruc-64180/1.5/src/SCSI.PAS new file mode 100644 index 0000000..e3c298e --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/SCSI.PAS @@ -0,0 +1,272 @@ +{---------------------- Include File fuer SCSI-Routinen --------------------- + Michael Staubermann, 27.06.86, Version 1.1, ohne DMA + + Die CIO (Kanal A) muss fuer SCSI initialiert worden sein (BIOS macht das) + + Prozeduren/Funktionen : + + FUNCTION port0 (portnr : INTEGER) : BYTE ; + Liest des Port mit Addressbits A8..A15 = 0 + + PROCEDURE port0out (portnr, wert : INTEGER) ; + Schreibt den 'wert' in den Port mit A8..A15 = 0 + + PROCEDURE scsiio (VAR datenbereich ; kommando : KOMMANDOTYPE ; + datenlaenge : INTEGER) ; + SCSI-Controller fuehrt das Kommando aus, Je nach Eingabe oder Ausgabe + wird der Datenbereich gelesen oder beschrieben. Es ist sichergestellt, + das nicht mehr als 'datenlaenge' Bytes in 'datenbereich' geschrieben + werden. + + PROCEDURE floppy_init ; + Initialisiert den Controller fuer 512 Byte/Sektor, 9 Sektoren, 2*80 Track + Floppy-Format (720K, grosses IBM-Format) + + PROCEDURE fd_read (VAR datenbereich ; blocknummer, sektoren : INTEGER) ; + Liest mehrere ('sektoren') 512-Byte Sektoren ab der (SCSI-) Blocknummer + von der Floppy. Der 'datenbereich' muss 512 * 'sektoren' Bytes fassen koennen. + + PROCEDURE fd_write (VAR datenbereich ; blocknummer, sektoren : INTEGER) ; + Wie fd_read, schreibt aber auf die Floppy. + + PROCEDURE hd_read (VAR datenbereich ; blocknummer, sektoren : INTEGER) ; + Wie fd_read, liest aber 256-Byte Sektoren von der Harddisk. Der + 'datenbereich' muss 256 * 'sektoren' Bytes fassen koennen. + + PROCEDURE hd_write (VAR datenbereich ; blocknummer, sektoren : INTEGER) ; + Wie hd_read, schreibt aber auf die Harddisk. + + FUNCTION scsi_blocknummer (eumel_blocknummer : INTEGER) : INTEGER ; + Aus der EUMEL-Blocknummer wird die SCSI-Blocknummer berechnet. EUMEL + behandelt im Gegensatz zum SCSI-Controller, erst die Oberseite und dann + die Unterseite der Floppy. Da die EUMEL-Sektoren nicht SCSI-physisch + hintereinander zu liegen brauchen, sollte man mehrere Sektoren nicht + mit einer 'sektoren'-Angabe groesser '1' lesen, sondern in einer Schleife + jede Blocknummer neu berechnen und dann einlesen. + + +-----------------------------------------------------------------------------} + + +TYPE KOMMANDOTYPE = ARRAY[1..6] OF BYTE ; + STRING77 = STRING[77] ; + +FUNCTION port0 (portnr : INTEGER) : BYTE ; + BEGIN + INLINE (6/0) ; { B-Register 0 } + port0 := port[portnr] + END ; + + +PROCEDURE port0out (portnr, wert : INTEGER) ; + BEGIN + INLINE (6/0) ; + port[portnr] := wert + END ; + + +PROCEDURE scsiio (VAR datenbereich ; kommandobereich : KOMMANDOTYPE ; + datenlaenge : INTEGER) ; + VAR i, status : INTEGER ; + statusbereich : ARRAY[1..4] OF BYTE ; + request_status : KOMMANDOTYPE ; + + +PROCEDURE fehler (meldung : STRING77) ; + BEGIN + writeln ('SCSI-Fehler: ', meldung) ; + halt + END ; + + +procedure writehex(b:byte); +var b1:byte; +procedure writenibble(b:byte); + begin + b:=b+$30; + if(b>$39) then b:=b+7; + write(chr(b)) + end; +begin + b1:=b shr 4; writenibble(b1); + b1:=b and $0f;writenibble(b1); +end; + +FUNCTION scsi2 (VAR datenbereich ; kommandobereich : KOMMANDOTYPE ; + datenlaenge : INTEGER) : INTEGER ; +CONST scsiport = $80 ; + cioad = $52 ; + dstat = $30 ; + +VAR addresse, ciowert : INTEGER ; + + + PROCEDURE check_request ; { Auf Busyende warten } + BEGIN + REPEAT + ciowert := port0 (cioad) ; +{ IF (ciowert AND 8) = 0 + THEN fehler ('vorzeitiges Ende') } + UNTIL (ciowert AND $80) = $80 ; + ciowert := ciowert AND $34 + END ; + + +PROCEDURE scsitrans (address, datenlaenge : INTEGER) ; + BEGIN + INLINE($ED/$4B/datenlaenge/ { LD BC,(datenlaenge) } + $ED/$6B/address/ { LD HL,(address) } + $ED/$38/$52/ { IN0 A,(CIOAD) } + $CB/$7F/ { BIT 7,A } + $28/$F9/ { JR Z,F9H } + $E6/$34/ { AND 34H } + $CB/$6F/ { BIT 5,A } + $C0/ { RET NZ } + $CB/$57/ { BIT 2,A } + $20/$06/ { JR NZ,rdscsi } + $7E/ { LD A,(HL) } + $ED/$39/$80/ { OUT0 (SCSIP),A } + $18/$04/ { JR cmdio } + $ED/$38/$80/ { rdscsi:IN0 A,(SCSIP)} + $77/ { LD (HL),A } + $ED/$A1/ { cmdio: CPI = DEC BC, INC HL PE:BC=0 } + $EA/*-$1D) { JP PE,*- } + { nodat: RET } + END { scsitrans } ; + + +BEGIN { scsi2 } + + { Controller selektieren } + ciowert := port0 (cioad) ; + port0out (cioad, ciowert OR 2) ; + port0out (cioad, ciowert AND $FB) ; + + { Auf Kommandoanforderung warten } + WHILE (port0 (cioad) AND $B4) <> $A0 DO ; { warten, ggf Timeout testen } + + { Kommando ausgeben } + FOR i := 1 TO 6 DO + BEGIN + check_request ; + port0out (scsiport, kommandobereich[i]) + END ; + + { Datenphase ohne DMA } + scsitrans (addr (datenbereich), datenlaenge) ; + + { Status abholen } + check_request ; + IF ciowert <> $24 + THEN BEGIN + REPEAT + ciowert := port0 (scsiport) ; + check_request ; + UNTIL ciowert <> $04 ; + scsi2 := $FF ; { SCSI-Fehler } + END + ELSE scsi2 := port0 (scsiport) ; { Status } + check_request ; + i := port0 (scsiport) ; { zweites Statusbyte immer 00 } + +END { scsi2 } ; + + + BEGIN { scsiio } + status := scsi2 (datenbereich, kommandobereich, datenlaenge) ; + IF (status AND $9F) = $02 + THEN BEGIN + fillchar (request_status, sizeof(request_status), 0) ; + request_status [1] := 3 ; + request_status [2] := status AND $60 ; + status := scsi2 (statusbereich, request_status, sizeof (statusbereich)) ; + write ('SCSI-Fehler: ') ; + FOR i := 1 TO sizeof (statusbereich) DO + BEGIN + writehex (statusbereich[i]) ; + write (' ') + END ; + halt + END + ELSE IF (status AND $9F) <> 0 + THEN fehler ('Daten nicht ganz uebertragen') + END ; + + +TYPE INITDATATYPE = ARRAY[1..10] OF BYTE ; +CONST floppy_write : KOMMANDOTYPE = ($0A, $40, 0, 0, 0, 0) ; + floppy_read : KOMMANDOTYPE = ($08, $40, 0, 0, 0, 0) ; + harddisk_write: KOMMANDOTYPE = ($0A, $00, 0, 0, 0, 0) ; + harddisk_read : KOMMANDOTYPE = ($08, $00, 0, 0, 0, 0) ; + fd_initialize : KOMMANDOTYPE = ($0B, $40, 0, 0, 0, 0) ; + + floppy_daten : INITDATATYPE = (0, 80, 2, $13, 3, 30, 50, 23, 50, 1) ; + { 9 Sektoren/Track, 80 Tracks, 512 Byte/Sektor } + +PROCEDURE floppy_init ; + VAR init_daten : INITDATATYPE ; + BEGIN + init_daten := floppy_daten ; + scsiio (init_daten, fd_initialize, sizeof (init_daten)) + END ; + + +PROCEDURE fd_write (VAR datenbereich ; blocknummer, sektoren : INTEGER) ; + VAR command : KOMMANDOTYPE ; + BEGIN + command := floppy_write ; + command[3] := hi (blocknummer) ; + command[4] := lo (blocknummer) ; + command[5] := sektoren ; + scsiio (datenbereich, command, sektoren * 512) ; + END ; + + +PROCEDURE hd_write (VAR datenbereich ; blocknummer, sektoren : INTEGER) ; + VAR command : KOMMANDOTYPE ; + BEGIN + command := harddisk_write ; + command[3] := hi (blocknummer) ; + command[4] := lo (blocknummer) ; + command[5] := sektoren ; + scsiio (datenbereich, command, sektoren * 256) ; + END ; + + +PROCEDURE fd_read (VAR datenbereich ; blocknummer, sektoren : INTEGER) ; + VAR command : KOMMANDOTYPE ; + BEGIN + command := floppy_read ; + command[3] := hi (blocknummer) ; + command[4] := lo (blocknummer) ; + command[5] := sektoren ; + scsiio (datenbereich, command, sektoren * 512) + END ; + + +PROCEDURE hd_read (VAR datenbereich ; blocknummer, sektoren : INTEGER) ; + VAR command : KOMMANDOTYPE ; + BEGIN + command := harddisk_read ; + command[3] := hi (blocknummer) ; + command[4] := lo (blocknummer) ; + command[5] := sektoren ; + scsiio (datenbereich, command, sektoren * 256) + END ; + + +FUNCTION floppy_blocknummer (eumel_blocknummer : INTEGER) : INTEGER ; + VAR track, sektor : INTEGER ; + BEGIN + track := eumel_blocknummer DIV 9 ; + sektor := eumel_blocknummer MOD 9 ; + IF track >= 80 { Rueckseite } + THEN BEGIN + track := track - 80 ; + sektor := sektor + 9 + END ; + floppy_blocknummer := track * 18 + sektor + END ; + + + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/SETDEF.COM b/system/shard-z80-ruc-64180/1.5/src/SETDEF.COM new file mode 100644 index 0000000..c198640 Binary files /dev/null and b/system/shard-z80-ruc-64180/1.5/src/SETDEF.COM differ diff --git a/system/shard-z80-ruc-64180/1.5/src/SHARD.AEX b/system/shard-z80-ruc-64180/1.5/src/SHARD.AEX new file mode 100644 index 0000000..432b781 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/SHARD.AEX @@ -0,0 +1,15 @@ +SLR LOAD +SLR SHARD +SLR SCSI +SLR CONOUT +SLR DISK80 +SLR GRAFIK80 +SLR INTMOD +SLR INT65 +SLR INIMOD +M80=DISK/M +L80 + RUC 64180 Karte +; +; Version 1.3 - 05.01.87 +; 1.3 mit log. und phys. Kanaelen +; 1.4 - 26.06.87, Code gekuerzt, IOCONTROL clear_spooler +; +; Copyright (C) 1985, 86, 87 by ruc: +; 1.7.3: Rainer Ellerbrake +; Eggeberger Str. 12 +; 4802 Halle (Westf.) +; +; 1.8: Michael Staubermann +; Moraenenstr. 29 +; 4400 Muenster-Hiltrup +; +;**************************************************************** +; +; Globale Variable +; + GLOBAL SHEND, SHSINF, SHSACC, SHIOCNT, SHOUT, SHBIN, SHBOUT + GLOBAL WARTE, SENDMSG, FLWTYP, MEMDMA + GLOBAL RTCOK, HGOP + GLOBAL HDOFS, HDLAST, CPMOFS, CPMLAST + GLOBAL D0BLKS, D1BLKS, HGBLKS, CPMBLKS + GLOBAL ADLEISTE, IINTAD, TIMEAD, INFOAD, SHUTUPAD, ERROR, TRAP + GLOBAL MODECONF, ARC31, BEEPFRQ, BLINKP, IKANTAB, URLK1, URLK2 + +;................................................................ +; +; Externe Variable +; + EXTERNAL INIFLP, HDIO, PARKHD, PHYSADR, START, FRE65 + EXTERNAL PUTBUF, FREEBUF, DRUCK, SCCATAB, SCCBTAB, EFLOW5 + EXTERNAL BAUSCC, BAUBAS, TO6502, ZGERL, STROUT, AFLOW, CLRCBUF + EXTERNAL BITSCC, BITBAS, EGO, ESTOP, DISKBK, INIDISK, ANALOG + EXTERNAL GMOVE, GDRAW, GTEST, GCTRL, GCLR, GFILL, GTRANS, GRAFIO +; +;................................................................ +; +; andere Adressen +; +WINDOW EQU 0F000H ;Anfangsadresse des 4K Windows +; +; Konstanten +; +SCHGR EQU 196 ;Groesse des Schattenspeichers in KByte +MINFUN EQU -10 ;iocontrol: unterste Funktionsnummer +; +; Harddisk / Floppy Kommandos +; +SREAD EQU 0 +SWRITE EQU 1 +SFORMAT EQU 2 +; + INCLUDE PORTS.MAC +; +;***************************************************************************** +; +; Konfigurationsblock, wird im Load-Modul festgelegt +; +BLINKP EQU 8 ; 1 Byte +BEEPFRQ EQU 9 ; 1 Byte +ARC31 EQU 10 ; 3 Bytes SCSI-Floppy LUN +MODECONF EQU 13 ; 4 Words: Mode, ID 4, 5, 6 +URLK1 EQU 21 ; 1 Byte log. Kanal f.1.Urladertest +URLK2 EQU 22 ; 1 Byte log. Kanal f.2.Urladertest +FREE EQU 23 ; 1 Byte +; +IKANTAB EQU 58H ; 8 Bytes Kanalzuordung phys. --> log. +KANTAB EQU 60H ; 33 Bytes Kanalzuordnung log. --> phys +IOFTB EQU 81H ; 32 Bytes I/O 'typ'-Tabelle +CPMOFS EQU 0A1H ; Anfang eines CP/M-Volumes +CPMLAST EQU 0A4H ; Ende+1 des CP/M-Volumes + +;***************************************************************************** +; +; EUMEL - Linkleiste +; + JP START ; Beginn der Initialisierung, starten + +ADLEISTE: ; Beginn der EUMEL-Linkleiste (kopiert) + +IINTAD: JP DEFRET ; Inputinterrupt + +TIMEAD: JP DEFRET ; Timerinterrupt + +WARTAD: JP DEFRET ; EUMEL 'warte' + +GRABAD: JP DEFRET ; (BC) 512-Byte Kacheln ab (HL) fuer SHard + ; reservieren +FREEAD: JP DEFRET ; (BC) 512-Byte Kacheln ab (HL) (wie bei + ; 'grab'!) freigeben +SHUTUPAD: + JP DEFRET ; Shutup anfordern + +INFOAD: JP DEFRET ; Info ' shard' + +DEFRET: RET + +;---------------------------------------------------------------- +; +; W A R T E +; +; Aufruf der EUMEL Warte Routine +; +WARTE: + PUSH BC ;Register, ausser AF, retten + PUSH DE + PUSH HL + PUSH IX + PUSH IY +; EX AF,AF' +; PUSH AF +; EXX +; PUSH BC +; PUSH DE +; PUSH HL +; + CALL WARTAD ;zunaechst auf RET-Befehl +; +; POP HL +; POP DE +; POP BC +; EXX +; POP AF +; EX AF,AF' + POP IY + POP IX + POP HL + POP DE + POP BC + RET + +;................................................................ +; +; T R A P +; +; Behandlung einer TRAP-Exception +; Einsprung bei JP 0 + +TRAP: + LD (SAVSTP),SP ; Stackpointer retten + PUSH AF + PUSH HL + PUSH DE + IN0 A,(ITC) ; Trap ? + BIT 7,A + RES 7,A ; Auf jeden Fall loeschen + OUT0 (ITC),A + JR Z,RESV ; War kein TRAP, sondern Reset: PC undefiniert + LD HL,(SAVSTP) + LD E,(HL) + INC HL + LD D,(HL) ; DE = PC bei Trapadresse + DEC DE ; PC-1 + BIT 6,A ; UFO ? (Undefined Fetch Object) + JR Z,TRAP1 + DEC DE ; PC-2 +TRAP1: + LD HL,TRPADR + CALL HEXDEHL ; Nach Hex konvertieren + +RESV: + LD HL,TRPTXT ; Vor Infoaufruf ausgeben (in Zeile 6) +SENDERR: + CALL SENDMSG + CALL INFOAD + POP DE + POP HL + POP AF + RET + +TRPTXT: DEFB TRPLEN, 7, 6, 4, 1, 15, 'TRAP:' +TRPADR: DEFB 'RES ', 5, 14 +TRPLEN EQU $-TRPTXT-1 + +;................................................................... +; +; Falscher Interrupt +; +ERROR: + PUSH AF + PUSH HL + PUSH DE + + LD A,00111000B ; Reset SCC highest IUS + OUT0 (SCCAC),A + OUT0 (SCCBC),A + CALL EIRET + + LD HL,INTTXT ; Message 'Ghost Interrupt' + JR SENDERR + +INTTXT: DEFB INTXTLEN, 6, 4, 1, 15, 'Wrong Int', 5, 14 +INTXTLEN EQU $-INTTXT-1 + +EIRET: + EI + RETI + +;---------------------------------------------------------------- +; +; S Y S E N D +; +; Kaltstart ausfuehren +; +; Eingang: - +; Ausgang: (Keine Rueckkehr) +; +SHEND: + CALL PARKHD ; Harddisk in Parkposition fahren + DI + XOR A + OUT0 (CNTLA0),A ; Falls verdrahtet, Hardwarereset (RTS-Pin) + OUT0 (CNTLA0),A ; sicherheitshalber + SLP ; Kein Refresh mehr, I/O bleibt aktiv + +; +;---------------------------------------------------------------- +; +; S H S I N F +; +; Groesse und Ansprechmodus des Schattenspeichers bestimmen +; +; Ausgang: BC = Groesse des Schattenspeichers in k (0..8191) +; Bit 15: 1=Fenstermodus, Bit 14: 1=Transportmodus +; +; In diesem SHARD werden die 1. 256 KByte RAM des HD 64180, soweit +; diese nicht vom SHARD und EUMEL0 belegt sind, als Schattenspeicher +; im Fenstermodus benutzt. +; +; Der Speicher wird im einzelnen wie folgt verwendet: +; +; 00000 - 013FF SHARD +; 01400 - 0EFFF EUMEL0 und Pagingbereich +; 0F000 - 3FFFF Schattenspeicher +; 40000 - 5FFFF reserviert fuer Grafikkarte (nicht benutzt) +; 60000 - 6FFFF BASIS bzw. Apple Hauptspeicher (6502 Treiber) +; 70000 - 7FFFF wie 60000 - 6FFFF +; +SHSINF: + LD BC,SCHGR+8000H ;Fenstermodus + RET +; +;---------------------------------------------------------------- +; +; S C H A C C +; +; Ein-/ Ausgabe auf den Schattenspeicher +; +; Eingang: HL = Nummer der 1/2K-Seite, die in das 4K Fenster +; zu schalten ist. +; +; Ausgang: HL = Anfangsadresse (im Normaladressraum) des aktuellen +; Fensters +; +; Das Fenster befindet sich innerhalb eines 4K Bereichs ab 0F000H +; in der Common Area 1 +; +SHSACC: + PUSH AF ;Akku retten + + LD A,L ;Offset im 4K Fenster berechnen + SLA A ;auf 256 Byte Grenze (MSB) +; AND 0FH ;nicht noetig, da MSB=F + OR HIGH WINDOW ;MSB der Anfangsadresse im Fenster +; + SRL H ;512 Byte Block -> 4 K Offset (/8) + RR L + SRL H + RR L + SRL L ;nicht mehr als 512 K !! + OUT0 (CBR),L ;4K Blockanf. (- F000) in MMU eintragen + + LD H,A ;MSB der Anfangsadr. retten + LD L,0 ;HL = Anfangsadresse im log. Adr.-raum + POP AF ;AF wieder herstellen + RET +; +;------------------------------------------------------------------- +; +; L O G P H Y S +; Umrechnung der log. Kanalnummer in eine phys. Kanalnummer +; +; Eingang: A = logische Kanalnummer (0..32) +; Ausgang: A = physische Kanalnummer (0..6, 28..32) +; alle anderen Register bleiben unveraendert +; +LOGPHYS: + PUSH HL + ADD A,KANTAB + LD L,A + LD H,0 + LD A,(HL) + POP HL + RET + +;---------------------------------------------------------------- +; +; B L O C K O U T +; +; Block (512 Byte) Ausgabe +; +; Der 512 Byte grosse in DE angegebene Block wird ab der in HL +; angegebenen Hauptspeicheradresse auf das durch Kanalnummer angewaehlte +; Geraet uebertragen. +; +; Eingang: A = Kanalnummer (log.) +; BC = Funktionscode (immer 0) +; HL = Adresse des Hauptspeicherbereichs +; DE = 2. Funktionscode (Blocknummer) +; +; Ausgang: A = veraendert +; BC = Rueckmeldecode (0=ok, -1=unzulaessiger Aufruf) +; HL = Adresse des Rueckmeldetextes (1 Byte , +; Bytes Text) +; +SHBOUT: + PUSH AF + LD A,SWRITE ;Schreiboperation + JR BLKCOM +; +;---------------------------------------------------------------- +; +; B L O C K I N +; +; Block (512 Byte) Eingabe +; +; Der 512 Byte grosse in DE angegebene Block wird ab der in HL +; angegebenen Adresse vom durch Kanalnummer angewaehlten Geraet +; in den Hauptspeicher uebertragen. +; +; Eingang: A = Kanalnummer (log.) +; BC = Funktionscode (immer 0) +; HL = Adresse des Hauptspeicherbereichs +; DE = 2. Funktionscode (Blocknummer) +; +; Ausgang: A = veraendert +; BC = Rueckmeldecode (0=ok, -1=unzulaessiger Aufruf) +; HL = Adresse des Rueckmeldetextes (1 Byte , +; Bytes Text) +; DE = unveraendert +; +; Folgende physischen Kanaele sind fuer Block I/O definiert: +; +; 0 = Harddisk 0 am SCSI-Controller +; 1 = Graphikmemory (Apple) +; +; 28 = Harddisk CP/M-Volume +; 29 = Apple-Drive 1 +; 30 = Apple-Drive 0 +; 31 = Floppy 0 am SCSI-Controller +; +;................................................................ + +SHBIN: + PUSH AF + LD A,SREAD +BLKCOM: + LD (HGOP),A ;0=lesen, 1=schreiben, 2=formatieren +; + POP AF + CALL LOGPHYS ; Umrechnen log. --> phys. + PUSH AF + +;FDHDIO: + CALL BLOCKS ; Anzahl Blocks des Kanals erfragen + + LD A,B ; 0 Bloecke: Nochmal initialisieren + OR C + JR NZ,BLKCOM1 + + POP AF + PUSH AF + + PUSH DE + LD D,B ; DE = 0 : Standardformat + LD E,B + CALL SIZEX + POP DE + +BLKCOM1: + POP AF ; A = Kanal + + PUSH HL + LD H,D ; HL = Blocknummer + LD L,E + AND A + SBC HL,BC ; Falls HL >= BC : Block zu hoch + POP HL + + JR NC,TRKERR + + LD BC,HDOFS + AND A + JR Z,SCSIBK ; Hintergrund + + LD BC,ARC31 + CP 31 + JR Z,SCSIBK ; SCSI-Floppy + + LD BC,CPMOFS + CP 28 + JR Z,SCSIBK ; CP/M-Volume auf der Harddisk + + ; Kein SCSI-blockio + JP NC,DISKBK ; Kanal 29, 30 ist Apple-Drive + + CP 1 ; Grafikspeicher ? + JP Z,GRAFIO + ; Andere Kanaele nicht erlaubt + LD BC,-1 ; Falscher Kanal + RET + + +SCSIBK: + LD A,(HGOP) + PUSH DE + CALL HDIO ;I/O ausfuehren + POP DE +; + LD BC,0 + AND A + RET Z ; Transfer ok + + INC BC ; Fehler, bei dem Retries sinnlos sind + CP 13H ; Writeprotected (Floppy) + RET Z + CP 14H ; Target sector not found (kein Medium) + RET Z + + INC BC ; Retries sinnvoll + LD HL,ERRNR ; Bufferaddress fuer Hexbyte-Fehlernummer + CALL HEXAHL ; Konvertieren + LD HL,BLKNR1 ; Blocknr + CALL HEXDEHL ; Blocknummer in Puffer schreiben + + LD HL,RWERR + RET +; +TRKERR: + LD HL,BLKNR2 ; Bufferadresse fuer Konvertierung + CALL HEXDEHL ; DE ab HL schreiben + LD BC,3 ; Versorgungsfehler (Spur zu gross) + LD HL,BLKZHOCH + RET +; + ; Word in DE als 4 Byte ASCII ab HL ablegen +HEXDEHL: + LD A,D ; Highbyte + CALL HEXAHL + LD A,E ; Lowbyte dahinter + ; Byte in A als 2 ASCII-Zeichen ab HL ablegen +HEXAHL: + PUSH AF + RRCA + RRCA + RRCA + RRCA + CALL HEXAHL1 + POP AF + +HEXAHL1: + AND 0FH + CP 0AH ; A..F ? + JR C,HEXAHL2 + ADD A,7 +HEXAHL2: + ADD A,30H + LD (HL),A + INC HL + RET +; +; Fehlermeldungen, die mit 'noch ein Versuch ?' ausgegeben werden +; +RWERR: + DEFB RWERRLN + DEFM 'Fehler ' +ERRNR: DEFM '00H auf Block ' +BLKNR1: DEFM '0000H,' +RWERRLN EQU $-RWERR-1 + +; +BLKZHOCH: + DEFB BLKZLN + DEFM 'Block ' +BLKNR2: DEFM '0000H zu hoch,' +BLKZLN EQU $-BLKZHOCH-1 + +; +;---------------------------------------------------------------- +; +; M E M D M A +; DMA-Transfer zwischen 64180-Speicher (log.) und Basisspeicher +; +; Darf auch in Interruptroutinen benutzt werden! +; +; Eingang: BC = Anzahl der zu transportierenden Bytes +; DE = log.Hauptspeicheradresse (64k) +; HL = phys. Adresse im Basisspeicher +; A = 0 : Basis --> 64180 +; A = 1 : 64180 --> Basis +; Ausgang: alle Register (A, BC, DE, HL) moeglicherweise veraendert +; +MEMDMA: + RRA ; Bit 0 (A) ins Carry + LD A,I + DI + PUSH AF ; Carry und IEF1 merken + + OUT0 (BCR0L),C ; Transferlaenge programmieren + OUT0 (BCR0H),B + + CALL PHYSADR ; Bank in A + LD B,6 ; Basis Bank + + POP AF + PUSH AF ; Carryflag holen: Set : 64180 --> Basis + + JR NC,MEMDMA1 + + EX DE,HL ; Source <--> Dest vertauschen + LD B,A ; Bank auch vertauschen + LD A,6 + +MEMDMA1: + OUT0 (SAR0L),L ; Source-Adresse + OUT0 (SAR0H),H + OUT0 (SAR0B),B + OUT0 (DAR0L),E ; Destination-Adresse + OUT0 (DAR0H),D + OUT0 (DAR0B),A + + CALL ZGERL ; Auf 6502-Speicher Zugriffserlaubnis warten + + LD A,01100011B ; DMA-Transfer starten + OUT0 (DSTAT),A + + POP AF + RET PO + EI + RET + +;---------------------------------------------------------------- +; +; I O C O N T R O L +; +; Steuerung und Zustandsabfragen fuer alle Kanaele +; +; Eingang: A = Kanalnummer (log.) +; BC = Funktionsnummer +; negative Codes siehe Funktionsadresstabelle +; 1 = 'typ' (fuer alle Kanaele (0..32)) +; 2 = 'frout' (fuer Kanal 1..6) +; 3 = 'stop' (fuer Kanal 1..6) +; 4 = 'weiter' (fuer Kanal 1..6) +; 5 = 'size' (fuer Kanal 0, 1, 30, 31) +; 6 = 'flow' (fuer Kanal 1..6) +; 7 = 'format' (fuer Kanal 30, 31) +; 8 = 'baud' (fuer Kanal 2, 3, 5) +; 9 = 'bits' (fuer Kanal 2, 3, 5) +; 10 = 'calendar' (1.8) +; +; DE = 2. Parameter +; HL = 3. Parameter +; +; Ausgang: s. Einzelfunktion +; A, BC und Flags duerfen veraendert sein (manchmal definiert!) +; +SHIOCNT: + CALL LOGPHYS ; Kanalnummer log. --> phys. umrechnen + + PUSH HL ;3. Funktionscode retten + LD HL,-MINFUN ;unterste Funktionsnummer + AND A + ADC HL,BC ;auf 0 normierte Funktionsnummer + JP M,ILLFUN ;unzulaessige Funktion -> + + LD B,H + LD C,L + LD HL,MAXFUN ;Funktionsanzahl + AND A + SBC HL,BC + JR C,ILLFUN ;Funktionsnummer zu gross -> + + LD HL,FUNTAB ;Sprungadresstabelle fuer alle Funktionen + ADD HL,BC + ADD HL,BC ;+ Funktionsnummer * 2 + PUSH AF + LD A,(HL) ;LSB (Funktionsadresse) + INC HL + LD H,(HL) ;MSB (Funktionsadresse) + LD L,A + POP AF + JP (HL) ; (TOS)=(HL), Funktion anspringen +; +ILLFUN: + POP HL + LD BC,-2 + RET +; +;................................................................ +; +; Funktionsadresstabelle +; +FUNTAB: + DEFW CLRBUF ;-10 Printerspooler loeschen + DEFW GTRANS ;-9 Grafik: Grafikseiten transportieren + DEFW GCTRL ;-8 Grafik: Verschiedene Steuerfunktionen + DEFW GTEST ;-7 Grafik: Test, ob Pixel (x, y) gesetzt + DEFW GDRAW ;-6 Grafik: Draw Line to (x, y) + DEFW GMOVE ;-5 Grafik: Move to (x, y) + DEFW GFILL ;-4 Grafik: Umrandete Flaeche fuellen + DEFW GCLR ;-3 Grafik: Seite loeschen (fuellen) + DEFW ANALOG ;-2 Analog I/O + DEFW IOACC ;-1 64180-Card I/O-Ports (privilegiert) + DEFW ILLFUN ; 0 - + DEFW TYP ; 1 + DEFW FROUT ; 2 + DEFW STOP ; 3 + DEFW WEITER ; 4 + DEFW SIZE ; 5 + DEFW FLOW ; 6 + DEFW FORMAT ; 7 + DEFW BAUD ; 8 + DEFW BITS ; 9 + DEFW CALENDAR ;10 +; +MAXFUN EQU (($-FUNTAB)/2)-1 ;FUNKTIONSANZAHL +; +;................................................................ +; +; T Y P +; +; Information welche I/O fuer welchen Kanal sinnvoll ist liefern +; +; Eingang: A = Kanalnummer (phys.) +; +; Ausgang: Information in BC +; C Bit 0 gesetzt: 'iint' kann kommen (Zeicheneingabe) +; C Bit 1 gesetzt: 'output' ist sinnvoll (Zeichenausgabe) +; C Bit 2 gesetzt: 'blockin' ist sinnvoll (Blockeingabe) +; C Bit 3 gesetzt: 'blockout' ist sinnvoll (Blockausgabe) +; C Bit 4 gesetzt: 'IOCONTROL format' ist sinnvoll +; +TYP: + LD BC,0 + CP 32 + JR NC,TYP1 + LD C,A ;BC = Kanalnummer + LD HL,IOFTB + ADD HL,BC + LD C,(HL) ;Information aus IO-Funktionstab. holen +TYP1: + POP HL + RET +; +;................................................................ +; +; F R O U T +; +; Information, wieviel Zeichen der naechst 'outvar' uebernehmen +; kann. +; +; Eingang: A = Kanalnummer (phys.) +; +; Ausgang: BC = Anzahl Zeichen die der naechste 'outvar' uebernehmen +; kann +; C-Flag gesetzt: Puffer ist leer +; +FROUT: + CP 1 ; Console ? + JR Z,FROUTOK + CP 2 ; SCCB + JR Z,SCCBFROUT + CP 3 ; SCCA + JR Z,SCCAFROUT + CP 4 + JR Z,OBDRU ; 64180-Card Parallel + + CP 7 ; Basis-Schnittstellen ? + JR NC,FROUTOK ; Nein -> falscher Kanal + + ; Basis serielle/parallele Schnittstellen + CALL FRE65 + JR FRCORR ; BC korrigieren auf Bytewert +; +OBDRU: + PUSH IX + LD IX,DRUCK +FREBUF: + CALL FREEBUF + POP IX + +FRCORR: + POP HL + + INC B ; Carry unveraendert + DEC B + RET Z ; weniger als 256 Zeichen frei + LD BC,255 ; mehr als 255 frei, Korrektur wegen EUMEL0! + RET + +FROUTOK: + SCF + LD BC,200 + POP HL + RET + +SCCAFROUT: + PUSH IX + LD IX,SCCATAB + JR FREBUF + +SCCBFROUT: + PUSH IX + LD IX,SCCBTAB + JR FREBUF + + +;................................................................ +; +; S T O P +; +; Weitere Eingaben sperren +; +; Eingang: A = Kanalnummer (phys.) +; +STOP: + CALL ESTOP + POP HL + RET +; +;................................................................ +; +; W E I T E R +; +; Weitere Eingaben wieder zulassen +; +; Eingang: A = Kanalnummer (phys.) +; +WEITER: + CALL EGO + POP HL + RET +; +;................................................................ +; +; S I Z E +; +; Groesse in Bloecken eines Block I/O Kanals erfragen +; +; Eingang: A = Kanalnummer (phys.) +; DE = Schluessel: +; Alle Formate haben 512-Bytes/Sektor und 5.25 Zoll +; 0 = Standardformat des Laufwerks +; 1, 0101010110101001B = 55A9H = 360k, 2 * 40 Tracks +; 2, 0101011110101001B = 57A9H = 720k, 2 * 80 Tracks +; 0101011110001111B = 578FH = 640k-Erphi, 2 * 80 Trks +; 1101011110001111B = D78FH = 640k-Ehring, 2 * 80 Trks +; 0100000110001111B = 418FH = 160k-Apple, 1 * 40 Trks +; Ausgang: BC = Blockanzahl low +; A = Blockanzahl high +SIZEX: + PUSH HL + +SIZE: + CP 31 + JR NZ,SIZE1 + + LD B,80 ; Default 80 Tracks + INC D + DEC D ; D = 0 ? + JR NZ,SIZE3 ; Nein, Schluessel auswerten + LD A,E + CP 1 + JR C,SIZE2 ; 0: Default 80 Tracks + JR NZ,SIZE2 ; > 1 : 80 Tracks +SIZE4: + LD B,40 ; 1: 40 Tracks +SIZE2: + LD A,B + CALL INIFLP ; Archivtyp bestimmen + LD (ARBLKS),BC + JR ZRET + +SIZE3: + BIT 1,D ; Bit 9 (DE) unterscheidet 40/80 Tracks + JR Z,SIZE4 + JR SIZE2 + +SIZE1: + CP 29 ; Apple-Drive 0 oder 1 ? + JR C,BRET ; Keine Formaterkennung auf anderen Kanaelen + CP 32 + JR NC,BRET ; Kanal >= 32 ? + + CALL INIDISK + + LD HL,D0BLKS ; HL darf veraendert werden + CP 30 + JR Z,SIZE5 + LD HL,D1BLKS +SIZE5: + LD (HL),C ; Fuer Blockio eintragen + INC HL + LD (HL),B + JR ZRET ; Groesse in BC + +BRET: + CALL BLOCKS ; Groesse erfragen + +ZRET: + XOR A ; Immer weniger als 65536 Bloecke + POP HL + RET + +;................................................................ +; +; B L O C K S +; Erfragt die Anzahl der 512-Byte Bloecke, die ein phys. Kanal +; fassen kann. +; +; Eingang: A = Kanalnummer (0, 1, 27..31) +; Ausgang: BC = Anzahl 512-Byte Blocks +; keine anderen Register veraendert +; +BLOCKS: + PUSH AF + CP 28 + JR NC,BLOCKS1 + ADD A,32 ; 0 --> 32, 1 --> 33 +BLOCKS1: + LD BC,0 + + CP 34 + JR NC,BLOCKS2 ; Kanal existiert nicht + + SUB 28 ; Auf 0 normieren + + PUSH HL + ADD A ; * 2 + LD C,A + LD HL,BLKTAB + ADD HL,BC + LD C,(HL) + INC HL + LD B,(HL) + POP HL +BLOCKS2: + POP AF + RET + +;................................................................ +; +; B A U D +; +; Einstellung der Baudrate fuer serielle Schnittstellen +; andere Funktionen nicht implementiert +; +; Eingang: A = eigener Kanal +; DE = adressierter Kanal +; TOS= Schluessel +; +; +; Ausgang: BC = 0=ok, 1=nicht moeglich +; +BAUD: + POP HL + PUSH AF + LD A,H + OR D + JR NZ,BITERR + + LD A,E ; addressierter Kanal + CALL LOGPHYS ; Kanalnummer umrechnen + LD E,A + + CP 5 + JR Z,BASSER + CP 2 + JR Z,ONBDSR + CP 3 + JR NZ,BITERR + +ONBDSR: + LD A,L + CP 17 + JR NC,BITERR ; Keine SHardspezifischen Baudrates + POP AF + PUSH AF + CP 32 + LD A,E + CALL Z,BAUSCC ;serielle Schnittstellen on board + JR ISPO +; +BASSER: + LD A,L ;serielle Schnittstelle BASIS + CP 16 ;38400 Baud nicht moeglich, kein SHardspez. + JR NC,BITERR + POP AF + PUSH AF + CP 32 ;einstellend ? + CALL Z,BAUBAS ;Ja -> + JR ISPO +; +;................................................................ +; +; B I T S +; +; Eingang: A = eigener Kanal +; DE = adressierter Kanal +; TOS= Schluessel +; +; Unterstuetzt: 1, 1.5, 2 Stopbits +; 7 oder 8 Datenbits +; No, Even, Odd Parity +; +; Ausgang: BC = 0=ok, 1=nicht moeglich +; +BITS: + POP HL + PUSH AF + LD A,H + OR D + JR NZ,BITERR + + LD A,E ; addressierter Kanal + CALL LOGPHYS ; umrechnen + LD E,A + + CP 5 + JR Z,TBASS + CP 2 + JR Z,TSSER + CP 3 ;serielle Kanaele ? + JR NZ,BITERR ;Nein -> + +TSSER: + LD A,L + AND 7 ; Weniger als 7 Datenbits ? + CP 7-1 + JR C,BITERR +; + POP AF + PUSH AF + CP 32 + LD A,E + CALL Z,BITSCC +ISPO: + POP AF + LD BC,0 ;sonst moeglich melden + RET +; +TBASS: + LD A,L + AND 7 + CP 7-1 + JR C,BITERR ; Weniger als 7 Datenbits + BIT 5,L ; 1.5 Stopbits nicht moeglich + JR NZ,BITERR + LD A,L + CP 00101111B ; 8 Datenbits, 2 Stopbits und Parity nicht + JR Z,BITERR + CP 00110111B ; dgl. even Parity nicht moeglich + JR Z,BITERR + + POP AF + PUSH AF + CP 32 ; Werte einstellen ? + CALL Z,BITBAS + JR ISPO +; +BITERR: + POP AF + LD BC,1 ;nicht moeglich + RET +; +;................................................................ +; +; F L O W +; +; Flusskontrolle einstellen +; +; Eingang: A = eigener Kanal +; DE = adressierter Kanal +; TOS= Schluessel +; +; +; Ausgang: BC = 0=ok, 1=nicht moeglich +; +FLOW: + POP HL + PUSH AF + LD A,D + OR H ; Modus > 255 oder Kanal > 255 --> geht nicht + JR NZ,BITERR + + LD A,E ; adressierter Kanal + CALL LOGPHYS ; umrechnen + LD E,A + CP CHNUM + JR NC,BITERR ;falscher Kanal -> nicht moeglich + CP 1 + JR Z,BITERR + + LD A,L + AND A ; Keine Flusskontrolle ? + JR Z,FLOW1 ; ja, 0 eintragen + + CP 11 + JR NC,BITERR ; Modus > 11 geht nicht + + CP 4 ; Eingabe-/Ausgabeseitig ? (1, 2, 3) + JR NC,FLOW1 ; nein, Bits bleiben so + OR 1100B ; Bit 2 und 3 setzen +FLOW1: + LD C,A + LD HL,FLMOD + ADD HL,DE + AND (HL) ; Und-Verknuepfen + CP C ; Immer noch gleich Modus ? ja, erlaubt + JR NZ,BITERR ; sonst nicht erlaubt + + POP AF + PUSH AF + CP 32 + JR NZ,ISPO ; ok melden, wenn nicht einstellend + +; Flusskontrolle einstellen + + LD A,E ; Adressierter Kanal in A + CALL EGO ; 'Weiter' aufrufen mit alter Einstellung + + CALL FLWTYP + LD (HL),C ; gewuenschten Modus eintragen + + CP 5 + CALL Z,EFLOW5 ; Eingabeflusskontrolle fuer Kanal 5 + ; DTR, XON/XOFF einstellbar + + ; Da RTS-Fluskontrolle hardwaremaessig bedingt + ; nicht wie gewuenscht arbeitet (Uebertragungs- + ; fehler und Transmitter disabled), wird DTR- + ; Flusskontrolle verwendet. ggf. muss die RTS- + ; Leitung des Fremdrechners mit der DTR- + ; Leitung (Pin 20) des Basis verbunden werden. + CALL AFLOW ; Ausgabe-Flusskontrolle einstellen + JR ISPO + +;........................................................................... +; +; F L W T Y P +; +; Zeiger auf Tabelle mit aktuellem Flusskontrollmodus berechnen +; +; Eingang: A = gewuenschter Kanal (1..15) +; +; Ausgang: HL = Zeiger auf Eintrag in der Flowtabelle +; andere Register nicht veraendert +; +FLWTYP: + LD HL,FLTAB + CP CHNUM ; Zeigt auf Dummyeintrag + RET NC + + PUSH DE + LD D,0 + LD E,A + ADD HL,DE + POP DE + RET + +; +; +; Flowtabelle +; +; Bit 0 : 1 = XON/XOFF +; Bit 1 : 1 = RTS/CTS (bzw. DTR/CTS bei Basis) +; Bit 2 : 1 = Ausgabeseitige Flusskontrolle +; Bit 3 : 1 = Eingabeseitige Flusskontrolle +; Bit 7 : 1 = Eingabeseitig im Stopzustand +; +FLTAB:: + DEFB 0 ; - + DEFB 1000B ; Kanal 1, Eingabeflusskontrolle + DEFB 0 ; Kanal 2 + DEFB 0 ; Kanal 3 + DEFB 0 ; Kanal 4 + DEFB 0 ; Kanal 5 + DEFB 0 ; Kanal 6 +; +CHNUM EQU $-FLTAB ;Kanalanzahl + +; Tabelle mit Flowmoeglichkeiten der Kanaele +; Bit 0 : 1 = XON/XOFF moeglich +; Bit 1 : 1 = RTS/CTS (bzw. DTR/CTS bei Basis) moeglich +; Bit 2 : 1 = Ausgabeseitige Flusskontrolle moeglich +; Bit 3 : 1 = Eingabeseitige Flusskontrolle moeglich +; Bit 2 und 3 duerfen gleichzeitig 1 sein. +; Bit 0 und 1 duerfen gleichzeitig 0 und 1 sein. + +FLMOD: + DEFB 0 ; - + DEFB 0 ; Kanal 1, nicht einstellbar + DEFB 1111B ; Kanal 2 + DEFB 1111B ; Kanal 3 + DEFB 0 ; Kanal 4 + DEFB 1111B ; Kanal 5 + DEFB 0 ; Kanal 6 +; +;................................................................ +; +; F O R M A T +; +; Archiv formatieren +; +; Eingang: A = Kanalnummer +; DE = Schluessel, wie SIZE +; Ausgang: BC = Rueckmeldung, wie BLOCKIO +; +FORMAT: + POP HL + LD BC,-1 + CP 31 ; SCSI-Floppy ? + RET NZ ; Kein formatieren moeglich + + PUSH AF + + CALL SIZEX + LD A,SFORMAT + LD (HGOP),A + LD BC,ARC31 + CALL SCSIBK + POP AF + RET +; +;**************************************************************** +; +; C A L E N D A R +; +; Entry: DE = (1:Min, 2:Std, 3: Tag, 4:Mon, 5:Jahr) +; Ausgang:BC = Rueckmeldung +; BC = -1 : Keine Uhr oder falsche Parameter +; sonst: gewuenschter BCD(!)-Wert +; +; + +CALENDAR: + PUSH AF + DI + LD BC,-1 + LD A,D + JR NZ,CALEND ; fehlerhafter Aufruf + LD A,E + CP 6 + JR NC,CALEND ; ebenfalls + LD A,(RTCOK) ; Flag fuer Time ok + AND A + JR Z,CALEND ; 0= Nicht ok + + LD A,20H ; 2 (programmierte) eff. 3 Uhrenwaitstates + OUT0 (DCNTL),A + + LD BC,RTCRA ; B=0 ! + +CAL1: TSTIO 80H ; UIP (Update in progress) testen + JR NZ,CAL1 ; warten bis beendet + + LD HL,CALPORTS ; Tabelle mit Registerzuordnung + ADD HL,DE ; D ist 0, E ist Offset + LD C,(HL) + IN C,(C) ; BC = BCD-Wert + LD B,C ; High-Digit ins Highbyte + SRL B + SRL B + SRL B + SRL B + +CALEND: + XOR A + OUT0 (DCNTL),A ; 0 (prog.) I/O Waitstates + EI + POP AF + POP HL + RET + +CALPORTS: + DEFB RTCS, RTCM, RTCH, RTCDY, RTCMO, RTCYR +; Sec, Min, Std, Day, Mon, Year + + +;**************************************************************** +; +; I O A C C +; +; Entry: HL = -1 = Read, sonst Value +; DE = I/O-Addr. (0..FF) real + 40H +; (Prozessor I/O: C0..FF) +; A = aufrufender Kanal (Write nur 32!) +; +; Exit: BC = -1 = Error +; sonst Value +; +; +IOACC: + POP HL + CP 25 ; Nur an privilegierten Kanaelen + LD BC,-1 ; Kanal 25..32 + RET C + INC B ; B := 0 + + LD A,E + ADD A,040H ; I/O-Adresse umrechnen + LD C,A +; +; 2 zusaetzliche I/O Wait States einbauen (fuer Uhrenzugriff) +; + CP 0C0H ; Uhrenzugriff ? + JR C,NCLK ; Nein -> keine extra Wait States + + DI + + LD A,20H + OUT0 (DCNTL),A +; +NCLK: + LD A,L + AND H + INC A ; HL = -1 ? + JR Z,RDVAL ; Ja -> +; + OUT (C),L ; Wert eintragen + LD C,B ; C := 0 + JR IOAEND +; +RDVAL: + IN C,(C) +; +IOAEND: + XOR A ; Keine Waitstates mehr + OUT0 (DCNTL),A + EI + RET + +;*********************************************************************** +; +; C L R B U F +; +; Drucker-Spooler des Kanals loeschen +; +; Eingang: A = Kanalnummer (4, 6) +; +CLRBUF: + CALL LOGPHYS + LD L,8 ; Task 8 : Clear Spooler + CP A,6 + CALL Z,TO6502 ; A nicht veraendert + CP A,4 + CALL Z,CLRCBUF + POP HL + RET + +;---------------------------------------------------------------- +; +; O U T V A R +; +; Ausgabe einer Zeichenkette +; +; Eingang: A = Terminalnummer (1=Arbeitsconsole, 2=Drucker) +; HL = Adresse der Zeichenkette +; BC = Anzahl der Zeichen +; Ausgang: BC = Anzahl der uebernommenen Zeichen. +; c-Flag gesetzt <=> alles uebernommem. +; +; Hinweis: SHOUT darf auf keinen Fall WARTE aufrufen !! +; +SHOUT: + + CALL LOGPHYS ; Kanalnummer log. --> phys. umrechnen + LD (KANAL),A + LD A,B + OR C + JR Z,OUTEA ; Nix auszugeben + + PUSH DE + PUSH HL + + LD A,(KANAL) + CP 1 + JR Z,OUT1 + CP 5 + JR Z,OUT5 + CP 6 + JR C,OUT234 + JR Z,OUT6 + +OVDON: + SCF ; Alles uebernommen +RETREG: + POP HL + POP DE +OUTEA: LD A,(KANAL) + RET + +OUT1: ; Master Console + CALL STROUT + JR OVDON ; Alles uebernommen +; +; +OUT5: ; BASIS serielle Schnittstelle + LD E,4 + JR OUT56 + +OUT6: ; BASIS parallele Schnittstelle + LD E,3 +OUT56: + ; Anzahl uebernehmbarer Zeichen berechnen + PUSH BC + CALL FRE65 ; Kanal in A, HL veraendert BC = Size-Free + LD H,B + LD L,C + POP BC + + LD A,L + SUB C + LD A,H + SBC B ; NC : HL (free) >= BC (length) + JR NC,OUT56A ; NC: Alles uebernommen + LD B,H + LD C,L ; uebernommene Laenge +OUT56A: + POP HL + PUSH HL + CCF ; Carry Flag, fuer "Alles uebernommen" + PUSH BC + PUSH AF + ; fuer Ausgang merken +OUT56B: + LD A,B + OR C + JR Z,OUT56C ; fertig + + PUSH HL + LD H,(HL) ; Zu sendendes Zeichen + LD L,E ; Task 3 oder 4 + CALL TO6502 + POP HL + + INC HL + DEC BC + JR OUT56B + +OUT56C: + POP AF ; Carry Flag + POP BC + JR RETREG + +OUT234: ; 64180-Card Kanaele (SCCA, SCCB, Centronics) + PUSH IX + LD IX,DRUCK ; Zeiger auf Centronics Kanaltabelle + CP 4 + JR Z,PUTBUFF + LD IX,SCCATAB + CP 3 + JR Z,PUTBUFF + LD IX,SCCBTAB + +PUTBUFF: + CALL PUTBUF ; Falls Puffer voll, nichts uebernommen + POP IX + JR RETREG + +; +; +;**************************************************************** +; +; Meldungen ausgeben auf System-Kanal +; String beginnt mit Laengenbyte (!) +; Ausser HL keine Register verandert +; +SENDMSG: + PUSH AF + PUSH BC + LD C,(HL) + INC HL + LD B,0 + LD A,1 ; System-Kanal + CALL SHOUT ; String ab HL an Kanal in A ausgeben + POP BC + POP AF + RET +; +;**************************************************************** +; +; Variable +; +HDOFS: DEFB 0 ;Harddisk 0 + DEFB 30H, 00H +HDLAST: DEFB 0 + DEFB 0B2H, 0 +; +SAVSTP: DEFW 0 ; gesicherter Stackpointer bei TRAP-Interrupt +RTCOK: DEFB 0 ; FF, wenn RTC-Werte gueltig +HGOP: DEFB 0 +KANAL: DEFB 1 ; Kanal merken + +;------------------------------------------------------------------------ +; Anzahl 512-Byte Bloecke, die ein Blockkanal fassen kann +; Wird bei control-size abgefragt und vorher bestimmt + +BLKTAB: + +CPMBLKS:DEFW 0 ; Kanal 28 CP/M-Harddisk-Volume +D1BLKS: DEFW 0 ; Kanal 29 Apple-Floppy 1 +D0BLKS: DEFW 0 ; Kanal 30 Apple-Floppy 0 +ARBLKS: DEFW 1440 ; Kanal 31 SCSI-Floppy 0 +HGBLKS: DEFW 0 ; Kanal 0 (Hintergrund) +CONBLKS:DEFW 2*4*8 ; Kanal 1 (Graphikspeicher) 4 * 8k Seiten +; +; +;**************************************************************** +; + END + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/SHARD.SUB b/system/shard-z80-ruc-64180/1.5/src/SHARD.SUB new file mode 100644 index 0000000..fca80b9 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/SHARD.SUB @@ -0,0 +1,7 @@ +L80 +=10 then crash... + LDA sec_tble,Y + bne nxt_sec +;need_sec + TYA ; physical sector # + ASL A ; + TAY + lda DMA,y + sta user_data + lda DMA+1,y + STA user_data+1 ; pointer to user's buffer + bit param + bmi read_it + JSR make_nibl + LDX slot10z + LDA sec_in_hdr + STA iob_sec +j_nxt_sec + JMP nxt_sec +read_it + JSR read_data + BCS j_nxt_sec +mark_sec + LDY sec_in_hdr + LDA #0FF + STA sec_tble,Y + STA iob_sec + DEC sec_cnt + BNE j_nxt_sec +;track_ok + lda #0 +track_fail + sta iob_err + lda mtroff,X + cli + rts +write_it + JSR write_data + BCC mark_sec + LDA #2 ; write protected ! + BCS track_fail ; bra + + .printx 'Ende' + +; Ende von NIBLE.INC + \ No newline at end of file diff --git a/system/shard-z80-ruc-64180/1.5/src/ZPAGE.INC b/system/shard-z80-ruc-64180/1.5/src/ZPAGE.INC new file mode 100644 index 0000000..43e51a3 --- /dev/null +++ b/system/shard-z80-ruc-64180/1.5/src/ZPAGE.INC @@ -0,0 +1,155 @@ + ; 05..09 GRAFIK +basl EQU 0A ; DISK (HCOPY im IRQ) +bash EQU 0B ; DISK (HCOPY im IRQ) + +sektor EQU 0C ; DISK65 +last_track EQU 0D ; DISK65 +bus_locked EQU 0E ; DISK65 ; Interrupt Flag +analogwert EQU 0F ; DISK65 + +rbuf EQU 10 ; 10 Bytes Receive-Buffer Descriptor + +keyin EQU 1A ; DISK +keyout EQU 1B ; DISK + +err1_bits EQU 1C ; DISK +err5_bits EQU 1D ; DISk + +quotient EQU 1E ; GRAFIK +divmask EQU 1F ; GRAFIK + +temporary EQU 1E ; +1F GRAFIK + +; Paket Variable (duerfen Global NICHT veraendert werden!) + +thick EQU 05 ; GRAFIK +colormask EQU 06 ; GRAFIK +bitmode EQU 07 ; GRAFIK +savepattern EQU 08 ; +09 GRAFIK +pattern EQU 24 ; +25 GRAFIK +pagebase EQU 2A ; GRAFIK +xpos EQU 2B ; +2C GRAFIK +ypos EQU 2D ; +2E GRAFIK + +; Workspace + +xpointer EQU 26 ; GRAFIK +ypointer EQU 27 ; GRAFIK + +olderror EQU 28 ; +29 GRAFIK + +right EQU 3D ; GRAFIK +up EQU 3E ; GRAFIK + +uprighterror EQU 3F ; +40 GRAFIK +; +ASave equ 45 ; DISK +XSave equ 46 ; DISK +YSave equ 47 ; DISK + +; + ; Basis-Schnittstellen: +KeyBuf equ 0200 ; Page 2 fuer KeyBuf +wrkpage EQU 080 ; 8k Workpage fuer Fill-Routine +dma_4k EQU 0E0 ; DISK65 +DBUFBEG EQU 0D0 ;Printer Spooler Grenzen (4k) +DBUFEND EQU 0E0 ; DISK (LC00) +stack EQU 0D000 ; GRAFIK (LC01) +SBUFBEG EQU 0F0 ;Seriell Ausgabe-Spooler Grenzen (1k) +SBUFEND EQU 0F4 ; DISK +RBUFBEG EQU 0F4 ; Serieller Empfangspuffer (2.25k) +RBUFEND EQU 0FD ; DISK + + ; Dummy-Block-Buffer fuer SCSI: FD00..FEFF + ; 64180-Card-Schnittstellen: + ; DBUF (Centronics): A000..AFFF + ; SCCA : B000..B7FF + ; SCCB : B800..BFFF + + +; 64180 interface + +DMA equ 50 ; 50..6F DISK, DISK65 +address equ 50 ; +51 GRAFIK +dx equ 52 ; +53 GRAFIK +dy equ 54 ; +55 GRAFIK +righterror equ 54 ; +55 GRAFIK (wie dy!) +tempmode equ 56 ; GRAFIK + +sec_tble equ 70 ; 70..7F DISK, DISK65 +areg equ 70 ; +71 GRAFIK +breg equ 72 ; +72 GRAFIK +creg equ 74 ; +75 GRAFIK +xa equ 76 ; +77 GRAFIK +xb equ 78 ; +79 GRAFIK +ya equ 7A ; +7B GRAFIK +yb equ 7C ; +7D GRAFIK +link equ 7E ; +7F GRAFIK + +task equ 80 ; 80 DISK, DISK65 +subtask EQU 81 ; GRAFIK +result EQU 81 ; GRAFIK +param equ 81 ; DISK, DISK65 +param1 EQU 82 ; +83 GRAFIK +def_byte equ 82 ; DISK, DISK65 +disk_no equ 83 ; DISK, DISK65 +param2 EQU 84 ; +85 GRAFIK +iob_trk equ 84 ; DISK, DISK65 +sec_cnt equ 85 ; DISK, DISK65 +iob_err equ 86 ; DISK, DISK65 + +; work space + +wait_Cnt equ 87 ; DISK +user_data equ 89 ; DISK +dest_phase equ 8B ; DISK +chk_in_hdr equ 8C ; DISK +sec_in_hdr equ 8D ; DISK +trk_in_hdr equ 8E ; DISK +vol_in_hdr equ 8F ; DISK +slot10z equ 90 ; slot #: s0 DISK +iob_drv equ 91 ; DISK +phase equ 92 ; DISK +iob_sec equ 93 ; DISK +chk_sum equ 94 ; DISK +temp2 equ 95 ; DISK +head_pos equ 96 ; DISK +tktry_cnt equ 97 ; DISK +hdtry_cnt equ 98 ; DISK +recal_cnt equ 99 ; DISK +A_FLG EQU 9A ; Flags fuer Ausgabeflusskontrolle +E_FLG EQU 9B ; Flags fuer Eingabeflusskontrolle +SerFLG EQU 9C ; Break/Ausgabestopflags +Wait_Flg EQU 9D ; 64180 muss auf Update warten +IFLG EQU 9E ; Bit 7 = 1: Keine Inputinterrupt Kanal 5 +SLOT180 EQU 9F ; Bootslot (Kopie) +; +ilv_tble EQU $A0 ; A0..AF DISK, DISK65 + +; Offset auf Buffer-Descriptor + +free equ 0 ; Freiplatz in Bytes +full equ 2 ; Anzahl Zeichen im Puffer +in equ 4 ; Schreibzeiger +out equ 6 ; Lesezeiger +beg equ 8 ; Highbyte Pufferanfang +end equ 9 ; Highbyte Pufferende + +pbuf equ 0E0 ; 10 Bytes Spooler Descriptor +; +; Interruptparameter zum 64180 +; +INTPAR1 EQU 0EA ; Interrupt Kanalnr. und Sync. +INTPAR2 EQU 0EB ; DISK +INTPAR3 EQU 0EC ; Fehlerbits DISK + +tbuf EQU 0F0 ; 10 Bytes Transmit-Buffer Descrptor + +SLT180 EQU 04F8 ; Bootslot DISK + +start180 equ 0C087 ; DISK +wait180 equ 0C086 ; DISK +STOP180 equ 0C084 ; DISK +INT180 EQU 0C083 ; DISK + + \ No newline at end of file diff --git a/system/std.zusatz/1.7.3/src/17CHARS.ELA b/system/std.zusatz/1.7.3/src/17CHARS.ELA new file mode 100644 index 0000000..160997a --- /dev/null +++ b/system/std.zusatz/1.7.3/src/17CHARS.ELA @@ -0,0 +1,44 @@ +PACKET special 17 chars DEFINES chars 17 : + +TEXT VAR rec , schar ; +FILE VAR f ; + +PROC chars 17 : + + REP + down ("""") ; + get schar ; + UNTIL perhaps schar ("225", "217") + COR perhaps schar ("239", "218") + COR perhaps schar ("245", "219") + COR perhaps schar ("193", "214") + COR perhaps schar ("207", "215") + COR perhaps schar ("213", "216") + COR perhaps schar ("235", "220") + COR perhaps schar ("173", "221") + COR perhaps schar ("163", "222") + COR perhaps schar ("160", "223") + COR perhaps schar ("194", "251") + COR eof + PER ; + zeile neu . + +get schar : + f := editfile ; + read record (f, rec) ; + schar := subtext (rec, col + 1, col + 3) . + +ENDPROC chars 17 ; + +BOOL PROC perhaps schar (TEXT CONST old, new) : + + IF schar = old + THEN change (rec, col + 4, col + 3, new) ; + write record (f, rec) ; + TRUE + ELSE FALSE + FI . + +ENDPROC perhaps schar ; + +ENDPACKET special 17 chars ; diff --git a/system/std.zusatz/1.7.3/src/EMU16.ELA b/system/std.zusatz/1.7.3/src/EMU16.ELA new file mode 100644 index 0000000..a8e1292 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/EMU16.ELA @@ -0,0 +1,109 @@ +PACKET emulator 16 DEFINES (* Autor: J.Liedtke *) + (* Stand: 11.10.83 *) + killer , (* F. Klapper, 26.03.84 *) + command handler , + set command , + to archive, + from archive, + load archive, + save archive, + list archive, + release archive: + +PROC list archive: + list (archive) + +END PROC list archive; + +PROC release archive: + release (archive) + +END PROC release archive; + +PROC to archive: + save (last param, archive) + +END PROC to archive; + +PROC to archive (TEXT CONST t): + save (t, archive) + +END PROC to archive; + +PROC from archive (TEXT CONST t): + fetch (t, archive) + +END PROC from archive; + +PROC load archive: + fetch all (archive) + +END PROC load archive; + +PROC save to archive (THESAURUS CONST thes): + disable stop; + all to archive (thes); + IF is error + THEN put error; + line; + clear error; + IF yes ("naechste Archivfloppy eingelegt") + THEN save to archive (remainder) + FI + FI; + enable stop + +END PROC save to archive; + +PROC all to archive (THESAURUS CONST thes): + enable stop; + save (thes, archive) + +END PROC all to archive; + +PROC save archive: + save to archive (ALL myself) + +END PROC save archive; + +PROC save archive (TEXT CONST liste): + save to archive (ALL liste) + +END PROC save archive; + +PROC killer : + forget (ALL myself) + +ENDPROC killer ; + +TEXT VAR command line; +INT VAR permitted type := 0 ; + +PROC set command (TEXT CONST command text, INT CONST type) : + + command line := command text; + permitted type := type + +ENDPROC set command ; + +PROC command handler (TEXT CONST command list, + INT VAR command index , number of params , + TEXT VAR param 1, param 2) : + + analyze command (command list, command line, permitted type, command index, + number of params, param 1, param 2) + +ENDPROC command handler ; + +PROC command handler (TEXT CONST command list, + INT VAR command index , number of params , + TEXT VAR param 1, param 2, + TEXT CONST command text) : + + get command (command text, command line) ; + analyze command (command list, command line, 0, + command index, number of params, param 1, param 2) + +ENDPROC command handler ; + +ENDPACKET emulator 16 ; diff --git a/system/std.zusatz/1.7.3/src/EMU16M.ELA b/system/std.zusatz/1.7.3/src/EMU16M.ELA new file mode 100644 index 0000000..ed8cff4 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/EMU16M.ELA @@ -0,0 +1,162 @@ +PACKET emulator 16 multi DEFINES (* Autor: J.Liedtke *) + (* Stand: 11.10.83 *) + killer , (* F. Klapper, 16.05.84 *) + file names , + out , + command handler , + set command , + call , + read , + to archive, + from archive, + load archive, + save archive, + list archive, + release archive, + forward, + backward, + to eof, + to first record, + is first record: + +PROC list archive: + list (archive) +END PROC list archive; + +PROC release archive: + release (archive) +END PROC release archive; + +PROC to archive: + save (last param, archive) +END PROC to archive; + +PROC to archive (TEXT CONST t): + save (t, archive) +END PROC to archive; + +PROC from archive (TEXT CONST t): + fetch (t, archive) +END PROC from archive; + +PROC load archive: + fetch all (archive) +END PROC load archive; + +PROC save to archive (THESAURUS CONST thes): + disable stop; + all to archive (thes); + IF is error + THEN put error; + line; + clear error; + IF yes ("naechste Archivfloppy eingelegt") + THEN save to archive (remainder) + FI + FI; + enable stop +END PROC save to archive; + +PROC all to archive (THESAURUS CONST thes): + enable stop; + save (thes, archive) +END PROC all to archive; + +PROC save archive: + save to archive (ALL myself) +END PROC save archive; + +PROC save archive (TEXT CONST liste): + save to archive (ALL liste) +END PROC save archive; + +PROC killer : + forget (ALL myself) +ENDPROC killer ; + +THESAURUS VAR cat ; +TEXT VAR file name ; + +PROC file names (FILE VAR f) : + file names (f, name (myself)) +ENDPROC file names ; + +PROC file names (FILE VAR f, TEXT CONST manager name) : + INT VAR index := 0 ; + cat := ALL task (manager name) ; + REP + get (cat, file name, index) ; + IF file name = "" + THEN LEAVE file names + FI ; + putline (f, file name) + PER +ENDPROC file names ; + +PROC out (FILE VAR f, TEXT CONST t) : + write (f,t) +ENDPROC out ; + +TEXT VAR command line; +INT VAR permitted type := 0 ; + +PROC set command (TEXT CONST command text, INT CONST type) : + command line := command text; + permitted type := type +ENDPROC set command ; + +PROC command handler (TEXT CONST command list, + INT VAR command index , number of params , + TEXT VAR param 1, param 2) : + + analyze command (command list, command line, permitted type, command index, + number of params, param 1, param 2) + +ENDPROC command handler ; + +PROC command handler (TEXT CONST command list, + INT VAR command index , number of params , + TEXT VAR param 1, param 2, + TEXT CONST command text) : + + get command (command text, command line) ; + analyze command (command list, command line, 0, + command index, number of params, param 1, param 2) + +ENDPROC command handler ; + +PROC call (TEXT CONST dest name, INT CONST order code, + DATASPACE VAR ds, INT VAR reply code) : + + call (task (dest name), order code, ds, reply code) + +ENDPROC call ; + +PROC read (TEXT CONST file name) : + fetch (file name) +ENDPROC read ; + +PROC read (TEXT CONST file name, manager name) : + fetch (file name, task(manager name)) +ENDPROC read ; + +PROC forward (FILE VAR f): + down (f) +END PROC forward; + +PROC backward (FILE VAR f): + up (f) +END PROC backward; + +PROC to first record (FILE VAR f): + to line (f, 1) +END PROC to first record; + +BOOL PROC is first record (FILE VAR f): + line no (f) = 1 +END PROC is first record; + +PROC to eof (FILE VAR f): + to line (f, lines (f)) +END PROC to eof; +ENDPACKET emulator 16 multi ; diff --git a/system/std.zusatz/1.7.3/src/FONTR16.ELA b/system/std.zusatz/1.7.3/src/FONTR16.ELA new file mode 100644 index 0000000..91acfe0 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/FONTR16.ELA @@ -0,0 +1,360 @@ +PACKET fonts routines +(************************************************************************** +***** Verwaltung der Schriftfontstabelle ** Author : R. Nolting ***** +***** Benoetigt von allen Druckertreibern ** Version: 0.1 / 3.5.82 ***** +***** ** Version: 1.0 / 8.6.82 ***** +***** ** Version: 2.0 / 1. 8. 82 ***** +***** Schrittweite in x und y in Tabelle ** Version: 3.0 / 1. 9. 83 ***** +***** Zeilenhoehe in cm ** Version: 3.1 / 2. 4. 84 ***** +**************************************************************************) + + DEFINES + load font table, + get font, + list fonts, + inch, + current font number, + lf height of current font, + x factor per inch, + y factor per inch: + +LET max fonts = 8; +LET max nr points = 4; +LET PRINTTYPE = STRUCT (INT x steps per inch, y steps per inch, + ROW max nr points INT point size, + TEXT name, pitch table, codetable); +ROW max fonts PRINTTYPE VAR font; +FILE VAR font file; +INT VAR font number := 1, point number := 1; +TEXT VAR record := " ", + symb; +INT VAR i; +REAL CONST inch := 2.54; + +INT PROC x factor per inch: + x step +END PROC x factor per inch; + +INT PROC y factor per inch: + lf +END PROC y factor per inch; + +REAL PROC lf height of current font: + real(point (point number)) * inch / real (lf) (* 9.1.84 Nolting *) +END PROC lf height of current font; + +INT PROC current font number: + font number +END PROC current font number; +(******************************************************************* +********* Setzen und Liefern von Schriftsaetzen ****** +*******************************************************************) +PROC init font: +FOR font number FROM 1 UPTO max fonts REP; + lf := 1; + x step := 1; + FOR point number FROM 1 UPTO max nr points REP + point(point number) := 1; + PER; + kode := ""; + name := ""; + pitch:= ""; + PER; +END PROC init font; +(******************************************************************) + +PROC list fonts: + line; + FOR font number FROM 1 UPTO max fonts REP + IF name <> "" AND name <> " " + THEN put typ name + FI; + line; + PER; + font number := 1; point number := 1; +. +put typ name: + put (font number); put ("."); + put ("'"); put (name); put ("'"); + IF length (pitch) > 1 + THEN put ("proportional mit Blankbreite"); put (code (pitch SUB 32)) + ELSE put ("fest mit Blankbreite"); put (code (pitch)); + FI; + put ("und Zeilenhoehe"); put (point (1)); +END PROC list fonts; + +BOOL PROC font is in table (TEXT CONST name of font): + record := name of font; + changeall (record, " ",""); + IF record = "" + THEN font number := 1; TRUE + ELSE search through the table + FI +. +search through the table: +(* der Name des gewuenschten Types darf noch ein angehaengtes Attribut haben *) + FOR font number FROM 1 UPTO max fonts REPEAT + IF pos (record, name) = 1 + THEN LEAVE search through the table WITH TRUE + FI; + PER; + font number := 1; + FALSE +ENDPROC font is in table; + +PROC get font (TEXT VAR name of font, + TEXT VAR font pitch table, font code table, + BOOL VAR success): +INT VAR lf size := 0; + get font (name of font, lf size, + font pitch table, font code table, success); + replace (font pitch table, 10, code(lfsize)); +END PROC get font; + +PROC get font (TEXT VAR name of font, INT VAR size, + TEXT VAR font pitch table, font code table, + BOOL VAR success): + success := font is in table (name of font); + name of font := name; + (* hiermit wird eine Ueberpruefung 'alter Typ = neuer Typ' + im aufrufenden Programm ermoeglicht *) + font code table := kode; + font pitch table := pitch; + point number := max nr points; + WHILE point (point number) <> size REP + point number DECR 1; + UNTIL point number = 1 PER; + size := point (point number); + IF size = point (1) + THEN font pitch table := pitch; + LEAVE get font + ELSE font pitch table := "" + FI; + INT VAR j := point (1); + FOR i FROM 1 UPTO length (pitch) REP + font pitch table CAT code(code (pitch SUB i) * size DIV j) + PER; + +END PROC get font; + +LET tag = 1 , + bold = 2 , + number = 3 , + string = 4 , (* = text; aber PROC text wird benoetigt *) + operator = 5 , + delimiter = 6 , + end of file = 7 , + within comment = 8 , + within text = 9 ; + +PROC load font table (TEXT CONST font file name): +BOOL VAR prop font; +INT VAR type of symbol := 0; +REAL VAR blank in cm , + lf in cm; +REAL VAR width, inch factor; +INT VAR factor width; + +enable stop; +IF NOT exists (font file name) + THEN errorstop ("Fontdatei nicht vorhanden") + FI; +font file := sequential file (input, font file name); + init font; + font number := 0; + getline (font file, record); + protline (record); + WHILE NOT eof (font file) REP + font number INCR 1; + get font name and parameters; + get char width and output function; + UNTIL eof (font file) COR font number >= max fonts PER; + font number := 1; point number := 1; +. +get font name and parameters: + get font name; + get fixed or prop; + get blank width; + get linefeed height; + get pointsizes; + get optional x steps per inch; + fill pitch and code table with default; +. +get font name: + next entry; prot (symb); + IF (symb SUB 1) = "#" + THEN symb := subtext (symb, 2); + WHILE (symb SUB length(symb)) <> "#" REP + name CAT symb; + next entry; prot (symb); + IF symb = "" + THEN errorstop ("# fehlt beim Fontnamen"); + FI; + PER; + name CAT subtext (symb, 1, length (symb)-1) + ELSE error stop ("1. Symbol kein Fontname") + FI; +. +get fixed or prop: + next entry; + prop font := (symb SUB 1) = "p" OR (symb SUB 1) = "P"; + prot (symb); +. +get blank width: + next entry; + blank in cm := real (symb); + IF NOT last conversion ok COR blank in cm < 0.01 + THEN errorstop ("Blankbreite falsch") + FI; + prot ("Blank=");prot (symb); +. +get linefeed height: + next entry; + lf in cm := real (symb); + IF NOT last conversion ok COR lf in cm < 0.01 + THEN errorstop ("Linefeedhoehe falsch") + FI; + prot ("lf="); prot(symb); +. +get pointsizes: + next entry; + IF symb <> "(" + THEN protline ("alle Pointgroessen = 1 per Voreinstellung") ; + LEAVE get pointsizes + FI; + protline(" "); prot ("lf in punkten="); + get one lf size; + lf := int (inch * real (point (1))/ lf in cm + 0.5); +. +get one lf size: + FOR i FROM 1 UPTO max nr points REP + next entry; + IF symb = ")" + THEN LEAVE get one lf size + ELIF symb = "" + THEN errorstop ("Pointangaben unvollstaendig") + FI; + point(i) := int (symb); + IF NOT last conversion ok COR point (i) < 1 + THEN errorstop ("Pointgroesse falsch") + FI; + prot (symb); prot (","); + PER; +. +get optional x steps per inch: + IF symb = ")" + THEN next entry FI; + IF symb = "" + THEN width := 1.0 + ELSE width := real (symb) + FI; + x step := int (inch * width / blank in cm + 0.5); + factor width := int (width + 0.5); + IF NOT last conversion ok COR x step < 1 + THEN errorstop ("minimale Schritte falsch") + FI; + protline(" "); prot ("Schritte pro Inch="); prot (text(x step)); prot(","); prot (text(lf)); protline(" "); +. +fill pitch and code table with default: + IF prop font + THEN pitch := 255 * code (factor width) + ELSE pitch := code (factor width) + FI; + kode := 31 * ""0""; + kode CAT 224 * ""1""; (* print all *) + inch factor := real (x step) +. +get char width and output function: + WHILE NOT eof (font file) REP + getline (font file, record); + protline (record); + IF (record SUB 1) = "#" AND pos (record, "#", 2, length (record)) > 2 + THEN LEAVE get char width and output function + FI; + get internal code for char; + IF char code > 0 AND char code <= 255 + THEN IF prop font + THEN get char width; + prot (text(factor width)); + replace (pitch, char code, code (factor width)) + FI; + get output function + FI; + PER; +. +get internal code for char: +INT VAR char code; + next entry; prot (symb); + IF length(symb) = 1 + THEN char code := code (symb SUB 1) + ELIF symb >= "000" AND symb <= "255" + THEN char code := int (symb); + IF NOT last conversion ok + THEN errorstop ("Zeichen falsch") + FI + ELSE errorstop ("Zeichen falsch") + FI; + +. +get char width: + next entry; + IF pos (symb, ".") > 0 + THEN width := real (symb); + factor width := int (round(((width * inch factor) / inch), 0)) + ELSE factor width := int (symb) + FI; + IF NOT last conversion ok + THEN errorstop ("Breitenangabe falsch") + FI +. +get output function: + next entry; prot (symb); protline(" "); + IF symb = "" + THEN symb := "1" + FI; + replace (kode, char code, code (int (symb))); + IF NOT last conversion ok + THEN errorstop ("Ausgabefunktion falsch") + FI; +END PROC load font table; + +PROC next entry: +INT VAR next blank pos; +WHILE (record SUB 1) = " " REP + record := subtext (record, 2, length (record)) PER; +next blank pos := pos (record, " "); +IF next blank pos >= 1 + THEN symb := subtext (record, 1, next blank pos - 1); + record := subtext (record, next blank pos + 1) + ELSE symb := record; + record := "" + FI; +END PROC next entry; + +PROC prot (TEXT CONST t): + IF online + THEN put (t) + FI; +END PROC prot; + +PROC protline (TEXT CONST t): + IF online + THEN putline (t) + FI; +END PROC protline; + +init font; (* PACKET Initialisierung ******************************) +. +name: font[font number].name +. +pitch: font[font number].pitch table +. +kode: font [font number].code table +. +lf: font [fontnumber].y steps per inch +. +x step: font [font number].x steps per inch +. +point: font [font number].point size +. +END PACKET fonts routines; diff --git a/system/std.zusatz/1.7.3/src/MINPRINT.ELA b/system/std.zusatz/1.7.3/src/MINPRINT.ELA new file mode 100644 index 0000000..a0bd44a --- /dev/null +++ b/system/std.zusatz/1.7.3/src/MINPRINT.ELA @@ -0,0 +1,94 @@ +PACKET minimal font routines DEFINES lf height of current font, + x factor per inch, + y factor per inch: + +REAL CONST lf height of current font :: 2.54 / 6.0; +INT CONST x factor per inch :: 10, + y factor per inch :: 6; + +END PACKET minimal font routines; + +PACKET minimal printer (* 25.04.84 *) + DEFINES material, + start, + new page, + reset printer, + line, + print text , + printer cmd, + on, + off, + x pos, + y pos, + papersize, + limit, + change type: + + +PROC change type (TEXT CONST name of type): ENDPROC change type; + +PROC material (TEXT CONST value): END PROC material; + +PROC start (REAL CONST x,y): END PROC start; + +PROC papersize (REAL CONST x,y): END PROC papersize; + +PROC limit (REAL CONST l): END PROC limit; + +PROC on (TEXT CONST cmd): END PROC on; + +PROC off (TEXT CONST cmd): END PROC off; + +PROC xpos (REAL CONST cm): END PROC xpos; + +PROC ypos (REAL CONST cm): END PROC ypos; + +PROC printer cmd (TEXT CONST cmd): + out (buffer); buffer := ""; + out(cmd) +END PROC printer cmd; + +INT VAR actual line ; + +TEXT VAR buffer; + +PROC reset printer: + buffer := ""; + actual line := 0 +ENDPROC reset printer; + +PROC print text (TEXT CONST content, INT CONST mode): + buffer CAT content +ENDPROC print text; + +PROC new page: + IF buffer <> "" + THEN line (1.0) + FI; + actual line := actual line MOD 72 ; + IF actual line > 0 + THEN page feed + FI . + +page feed : + INT VAR i ; + FOR i FROM actual line UPTO 71 REP + out(" "13""10"") + PER ; + actual line := 0 + +ENDPROC new page; + +PROC line (REAL CONST lf): + out (buffer); buffer := ""; + IF lf > 0.0 + THEN REAL VAR ist := 0.0 ; + REP + out (""13""10"") ; + actual line INCR 1 ; + ist INCR 1.0 + UNTIL ist >= floor (lf) PER + FI +ENDPROC line; + +ENDPACKET minimal printer; diff --git a/system/std.zusatz/1.7.3/src/TO16.ELA b/system/std.zusatz/1.7.3/src/TO16.ELA new file mode 100644 index 0000000..94cfc73 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/TO16.ELA @@ -0,0 +1,102 @@ +PACKET to 16 DEFINES to 16 : + + +LET OLDRECORD = STRUCT (INT succ, pred, x, y, TEXT line) , + OLDFILE = BOUND ROW 4075 OLDRECORD ; + +LET free root = 1 , + used root = 2 ; + +LET file type 16 = 1002 ; + + +FILE VAR file 17 ; +OLDFILE VAR file 16 ; +DATASPACE VAR file space ; + + +PROC to 16 : + to 16 (last param) +ENDPROC to 16 ; + +PROC to 16 (TEXT CONST file name) : + + last param (file name) ; + file 17 := sequential file (input, file name) ; + disable stop ; + file space := nilspace ; + file 16 := file space ; + type (file space, file type 16) ; + copy 17 to 16 ; + IF NOT is error + THEN replace 17 by 16 file + FI ; + forget (file space) . + +replace 17 by 16 file : + forget (file name, quiet) ; + copy (file space, file name) . + +ENDPROC to 16 ; + +PROC copy 17 to 16 : + + enable stop ; + build used record chain ; + build free record chain . + +build used record chain : + copy all records ; + construct used chains head and circular links . + +copy all records : + INT VAR line ; + FOR line FROM 1 UPTO lines (file 17) REP + copy one record ; + cout (line) + PER . + +copy one record : + INT VAR index := line + 2 ; + TEXT VAR line 17; + record.pred := index - 1 ; + record.succ := index + 1 ; + getline (file 17, line 17) ; + change special 17 chars; + record.line := line 17. + +change special 17 chars: + change all (line 17, ""217"", ""225""); + change all (line 17, ""218"", ""239""); + change all (line 17, ""219"", ""245""); + change all (line 17, ""214"", ""193""); + change all (line 17, ""215"", ""207""); + change all (line 17, ""216"", ""213""); + change all (line 17, ""220"", ""235""); + change all (line 17, ""221"", ""173""); + change all (line 17, ""222"", ""163""); + change all (line 17, ""223"", ""160""); + change all (line 17, ""251"", ""194""). + +construct used chains head and circular links : + record.succ := used root ; + used root record.pred := index ; + used root record.succ := used root + 1 ; + used root record.line := headline (file 17) . + +build free record chain : + free root record.pred := free root ; + free root record.succ := free root ; + free root record.y := index + 1 ; + free root record.line := " 0 1 1" ; + free root record.line CAT text (maxlinelength (file 17), 5) . + +record : CONCR (file 16) (index) . + +used root record : CONCR (file 16) (used root) . + +free root record : CONCR (file 16) (free root) . + +ENDPROC copy 17 to 16 ; + +ENDPACKET to 16 ; diff --git a/system/std.zusatz/1.7.3/src/complex b/system/std.zusatz/1.7.3/src/complex new file mode 100644 index 0000000..d62085b --- /dev/null +++ b/system/std.zusatz/1.7.3/src/complex @@ -0,0 +1,133 @@ + +PACKET complex DEFINES COMPLEX,:=,complex zero,complex one,complex i, + complex,realpart,imagpart,CONJ,+,-,*,/,=,<>, + put,get, ABS, sqrt, phi, dphi : + +TYPE COMPLEX = STRUCT(REAL re,im); +COMPLEX PROC complex zero: COMPLEX :(0.0,0.0). END PROC complex zero; +COMPLEX PROC complex one : COMPLEX :(1.0,0.0). END PROC complex one; +COMPLEX PROC complex i : COMPLEX :(0.0,1.0). END PROC complex i; + +OP := (COMPLEX VAR dest, COMPLEX CONST source) : + + CONCR (dest) := CONCR (source) + +ENDOP := ; + +COMPLEX PROC complex(REAL CONST re,im): + COMPLEX :(re,im). +END PROC complex; + +REAL PROC realpart(COMPLEX CONST number): + number.re. +END PROC realpart; + +REAL PROC imagpart(COMPLEX CONST number): + number.im. +END PROC imagpart ; + +COMPLEX OP CONJ(COMPLEX CONST number): + COMPLEX :( number.re,- number.im). +END OP CONJ; + +BOOL OP =(COMPLEX CONST a,b): + IF a.re=b.re + THEN a.im=b.im + ELSE FALSE + FI. +END OP =; + +BOOL OP <>(COMPLEX CONST a,b): + IF a.re=b.re + THEN a.im<>b.im + ELSE TRUE + FI. +END OP <>; + +COMPLEX OP +(COMPLEX CONST a,b): + COMPLEX :(a.re+b.re,a.im+b.im). +END OP +; + +COMPLEX OP -(COMPLEX CONST a,b): + COMPLEX :(a.re-b.re,a.im-b.im). +END OP -; + +COMPLEX OP *(COMPLEX CONST a,b): + REAL VAR re of a::a.re,im of a ::a.im, + re of b::b.re,im of b ::b.im; + COMPLEX :(re of a*re of b- im of a *im of b, + re of a*im of b+ im of a*re of b). +END OP *; + +COMPLEX OP /(COMPLEX CONST a,b): + REAL VAR re of a::a.re,im of a::a.im, + re of b::b.re,im of b::b.im; + REAL VAR sqare sum of re and im ::b.re*b.re+b.im*b.im; + COMPLEX :( (re of a * re of b + im of a * im of b)/sqare sum of re and im, + (im of a *re of b - re of a*im of b)/sqare sum of re and im). +END OP /; + +PROC get(COMPLEX VAR a): + REAL VAR realpart,imagpart; + get(realpart);get(imagpart); + a:= COMPLEX :(realpart,imagpart); +END PROC get; + +PROC put(COMPLEX CONST a): + put(a.re);put(" ");put(a.im); +END PROC put; + +REAL PROC dphi(COMPLEX CONST x): + IF imagpart(x)=0.0 THEN reell + ELIF realpart(x)=0.0 THEN imag + ELIF realpart(x)>0.0 THEN realpositiv + ELSE realnegativ + FI. +reell: IF sign(realpart(x)) < 0 THEN 180.0 ELSE 0.0 FI. +imag: IF imagpart(x)>0.0 THEN 90.0 ELSE 270.0 FI. +realpositiv:IF imagpart(x)>0.0 THEN arctand(realpart(x)/imagpart(x)) + ELSE +arctand(realpart(x)/imagpart(x))+360.0 FI. +realnegativ: arctand(realpart(x)/imagpart(x))+180.0. +END PROC dphi; + +REAL PROC phi(COMPLEX CONST x): +dphi(x)*3.141592653689793/180.0. +END PROC phi; + +REAL PROC dphi(COMPLEX CONST x): + IF imagpart(x)=0.0 THEN reell + ELIF realpart(x)=0.0 THEN imag + ELIF realpart(x)>0.0 THEN realpositiv + ELSE realnegativ + FI. +reell: IF sign(realpart(x)) < 0 THEN 180.0 ELSE 0.0 FI. +imag: IF imagpart(x)>0.0 THEN 90.0 ELSE 270.0 FI. +realpositiv:IF imagpart(x)>0.0 THEN arctand(realpart(x)/imagpart(x)) + ELSE +arctand(realpart(x)/imagpart(x))+360.0 FI. +realnegativ: arctand(realpart(x)/imagpart(x))+180.0. +END PROC dphi; + + +REAL PROC phi(COMPLEX CONST x): +dphi(x)*3.141592653689793/180.0. +END PROC phi; + +COMPLEX PROC sqrt(COMPLEX CONST x): +IF x=complex zero THEN x +ELIF realpart(x)<0.0 THEN +complex(imagpart(x)/(2.0*real(sign(imagpart(x))) + *sqrt((ABSx-realpart(x))/2.0)), + real(sign(imagpart(x)))*sqrt((ABS x-realpart(x))/2.0)) +ELSE complex(sqrt((ABS x+realpart(x))/2.0), + imagpart(x)/(2.0*sqrt((ABS x+realpart(x))/2.0))) +FI. + +END PROC sqrt; + +REAL OP ABS(COMPLEX CONST x): + sqrt(realpart(x)*realpart(x)+imagpart(x)*imagpart(x)). +END OP ABS; + +END PACKET complex; diff --git a/system/std.zusatz/1.7.3/src/crypt b/system/std.zusatz/1.7.3/src/crypt new file mode 100644 index 0000000..f6711fa --- /dev/null +++ b/system/std.zusatz/1.7.3/src/crypt @@ -0,0 +1,139 @@ +PACKET cryptograf DEFINES (* Autor: J.Liedtke *) + (* Stand: 01.10.80 *) + crypt , + decrypt : + +TEXT VAR char , in buffer, out buffer ; +INT VAR in pos , key index ; +DATASPACE VAR scratch space := nilspace ; +FILE VAR in, out; + +PROC crypt (TEXT CONST file, key) : + + open (file) ; + initialize crypt (key) ; + WHILE NOT eof REP + read char ; + crypt char ; + write char + PER ; + close (file) . + +crypt char : + char := code (( character + random char + key char ) MOD 250) ; + IF key index = LENGTH key + THEN key index := 1 + ELSE key index INCR 1 + FI . + +character : code (char) . + +random char : random (0,250). + +key char : code (key SUB key index) . + +ENDPROC crypt ; + +PROC decrypt (TEXT CONST file, key) : + + open (file) ; + initialize crypt (key) ; + WHILE NOT eof REP + read char ; + decrypt char ; + write char + PER ; + close (file) . + +decrypt char : + char := code (( character - random char - key char ) MOD 250) ; + IF key index = LENGTH key + THEN key index := 1 + ELSE key index INCR 1 + FI . + +character : code (char) . + +random char : random (0,250) . + +key char : code (key SUB key index) . + +ENDPROC decrypt ; + +PROC initialize crypt (TEXT CONST key) : + + INT VAR random key := 0 ; + FOR key index FROM 1 UPTO LENGTH key REP + random key := (random key + code (key SUB key index)) MOD 32000 + PER ; + initialize random (random key) ; + key index := 1 + +ENDPROC initialize crypt ; + +PROC open (TEXT CONST source file) : + + in := sequential file (input, source file) ; + getline (in, in buffer) ; + in pos := 1 ; + out := sequential file (output, scratch space) ; + out buffer := "" . + +ENDPROC open ; + +PROC close (TEXT CONST source file) : + + IF out buffer <> "" + THEN putline (out, out buffer) + FI ; + forget (source file, quiet) ; + copy (scratch space, source file) ; + forget (scratch space) . + +ENDPROC close ; + +BOOL PROC eof : + + IF in pos > LENGTH in buffer + THEN eof (in) + ELSE FALSE + FI + +ENDPROC eof ; + +PROC read char : + + IF in pos > 250 + THEN getline (in, in buffer) ; + in pos := 1 ; + read char + ELIF in pos > LENGTH in buffer + THEN in pos := 1 ; + getline (in, in buffer) ; + char := ""13"" + ELSE char := in buffer SUB in pos ; + in pos INCR 1 + FI . + +ENDPROC read char ; + +PROC write char : + + IF char = ""13"" + THEN putline (out, out buffer) ; + out buffer := "" + ELSE out buffer CAT char + FI ; + IF LENGTH out buffer = 250 + THEN putline (out, out buffer) ; + out buffer := "" + FI . + +ENDPROC write char ; + +ENDPACKET cryptograf ; + + + + + diff --git a/system/std.zusatz/1.7.3/src/elan lister b/system/std.zusatz/1.7.3/src/elan lister new file mode 100644 index 0000000..dc34176 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/elan lister @@ -0,0 +1,263 @@ +PACKET elan lister DEFINES (* Autor: J.Liedtke *) + (* Stand: 22.03.84 *) + is elan source , + elan list : + + +LET source lines per page = 64 , + x start = 1 , + y start = 2 , + + tag = 1 , + bold = 2 , + + linelength = 120 , + struct comment length = 32 , + max name length = 25 , + struct comment blanks = " " , + refinement layout line = " |" , + headline pre = + " Zeile ***** E L A N EUMEL 1.7 ***** " ; + +INT VAR symbol type , + line nr , + page nr , + line at page ; + +BOOL VAR within defines list ; + +TEXT VAR record, + list pre , + source name , + source prefix , + symbol, + ahead symbol , + bottom blanks := (linelength) * " " ; + + +PROC elan list (FILE VAR source) : + + initialize listing ; + within defines list := FALSE ; + WHILE NOT eof (source) REP + list one source line ; + line nr INCR 1 + PER ; + page bottom ; + start (0.0,0.0) ; + new page . + +initialize listing : + reset printer ; + construct source name and prefix ; + print first page head ; + line nr := 1 . + +construct source name and prefix : + source name := headline (source) ; + INT CONST slash pos := pos (source name, "/") ; + IF slash pos = 0 + THEN source prefix := "" + ELSE source prefix := subtext (source name, slash pos+1) + "/" ; + source name := subtext (source name, 1, slash pos-1) + FI . + +list one source line : + getline (source, record) ; + print list pre ; + printline (record) ; + page if necessary . + +print list pre : + list pre := text (line nr, 5) ; + IF pos (record, "P") = 0 AND pos (record, ":") = 0 + THEN empty layout + ELSE analyze source line + FI ; + list pre CAT ("|") ; + print text (list pre, 0) . + +empty layout : + list pre CAT struct comment blanks . + +analyze source line : + scan (record) ; + next symbol (symbol, symbol type) ; + next symbol (ahead symbol) ; + IF begin of packet THEN packet layout + ELIF within defines list THEN check end of defines part + ELIF begin of proc op THEN proc op layout + ELIF begin of refinement THEN refinement layout + ELSE empty layout + FI . + +begin of packet : + symbol = "PACKET" . + +begin of proc op : + IF is proc or op (symbol) + THEN TRUE + ELIF (symbol <> "END") AND is proc or op (ahead symbol) + THEN symbol := ahead symbol ; + next symbol (ahead symbol) ; TRUE + ELSE FALSE + FI . + +begin of refinement : + symbol type = tag AND ahead symbol = ":" AND NOT within defines list . + +packet layout : + IF not at page head + THEN page bottom ; + page head + FI ; + layout (" ", ahead symbol, "*") ; + within defines list := TRUE . + +check end of defines part : + empty layout ; + scan (record) ; + REP + nextsymbol (symbol) ; + IF symbol = ":" + THEN within defines list := FALSE + FI + UNTIL symbol = "" PER . + +proc op layout : +(*printline ("") ;*) + printline ("") ; + printline ("") ; + IF not two free lines + THEN page bottom ; + page head + FI ; + layout (" ", ahead symbol, ".") . + +refinement layout : +(*print line (refinement layout line) ;*) + print line (refinement layout line) ; + IF not two free lines THEN page bottom; page head FI; + layout (" ", symbol, " ") . + + +print first page head : + page nr := 1 ; + page head . + +page if necessary : + IF line at page > source lines per page + THEN page bottom ; + page head + FI . + +not two free lines : + line at page >= source lines per page - 2 . + +not at page head : + line at page > 5 . + +ENDPROC elan list ; + +BOOL PROC is proc or op (TEXT CONST symbol) : + + symbol = "PROC" OR symbol = "PROCEDURE" + OR symbol = "OP" OR symbol = "OPERATOR" + +ENDPROC is proc or op ; + +PROC layout (TEXT CONST pre, TEXT VAR name, TEXT CONST post) : + + list pre CAT pre ; + name := subtext (name, 1, max name length) ; + list pre CAT name ; + list pre CAT " " ; + generate remaining struct comment . + +generate remaining struct comment : + INT VAR i ; + FOR i FROM 1 UPTO remaining struct comment length REP + list pre CAT post + PER . + +remaining struct comment length : + struct comment length - LENGTH pre - min(LENGTH name,max name length) - 1. + +ENDPROC layout ; + +PROC print line (TEXT CONST line text) : + + print text (line text, 0) ; + line (1.0) ; + line at page INCR 1 + +ENDPROC print line ; + +PROC printtext (TEXT CONST t, BOOL CONST b) : + out (t) +ENDPROC printtext ; (*** sonst im Hardwaretreiber *********) + +PROC page head : + + new page ; + print text (headline pre, 0) ; + print text (date, 0); (* R. Nolting 27.10.83 *) + print text (" ***** ",0); + print text (source name, 0) ; + line (4.0) ; + line at page := 1 + +ENDPROC page head ; + +PROC page bottom : + + WHILE line at page < source lines per page REP + line (1.0) ; + line at page INCR 1 + PER ; + line (1.0) ; + printtext (text (source prefix + text (page nr), 8), FALSE) ; + printtext (bottom blanks, FALSE) ; + printtext (source prefix + text (page nr), FALSE) ; + line (1.0) ; + page nr INCR 1 . + +ENDPROC page bottom ; + +BOOL PROC is elan source (FILE VAR source) : + + input (source) ; + get first symbol ; + symbol type = tag COR is bold begin of program COR is comment . + +is bold begin of program : + symbol type = bold CAND is elan bold . + +is elan bold : + symbol = "PACKET" COR is proc or op (symbol) COR is data declaration . + +is data declaration : + next symbol (symbol) ; + symbol = "VAR" OR symbol = "CONST" . + +is comment : + pos (record, "(*") > 0 OR pos (record, "{") > 0 . + + +get first symbol : + get first non blank record ; + scan (record) ; + next symbol (symbol, symbol type) ; + reset (source) . + +get first non blank record : + REP + getline (source, record) + UNTIL record contains non blank OR eof (source) PER . + +record contains non blank : + pos (record, ""33"",""254"", 1) > 0 . + +ENDPROC is elan source ; + +ENDPACKET elan lister ; diff --git a/system/std.zusatz/1.7.3/src/eumel printer b/system/std.zusatz/1.7.3/src/eumel printer new file mode 100644 index 0000000..79a4b2c --- /dev/null +++ b/system/std.zusatz/1.7.3/src/eumel printer @@ -0,0 +1,369 @@ +PACKET eumel printer DEFINES +(*************************************************************************** +***** EUMEL - DRUCKER ** Author: A. Reichpietch ** +***** ** R. Nolting ** +***** ** Date: 30.09.81 Vers. 0 ** +***** ** 15.03.82 Vers. 1.0 ** +***** ** 22.07.82 Vers. 1.1 ** +***** ** 01.10.82 Vers. 1.2 ** +***** reelle Werte fuer limit etc. ** 15.01.83 Vers. 2.0 ** +***** direkte Druckerkommandos (Hardware) ** 15.08.83 Vers. 2.1 ** +***** ** 15.12.83 Vers. 2.2 ** +***** alle Zeilen-/Spaltenprocs entfernt ** 9.1.84 Vers. 2.3 ** +***** neue 'print text' prozedur ** 04.03.84 Vers. 2.4 ** +***************************************************************************) + + print, + reset print, + print line, + pages printed, + + is elan source , (* dummy Prozeduren , koennen von *) + elan list : (* 'elan lister' ueberdeckt werden *) + + +LET blank = " " , + backspace = ""8"" , + begin mark underline = ""15"" , + end mark underline = ""14"" ; +LET paragraph end = " "; +TEXT VAR inline := blank, + outline := blank, + type := blank, + command char, + help := blank; +TEXT VAR command, + par 1, par 2, + skip end text; +REAL VAR y position, y step, y max, y factor; +INT VAR pagenr, from, to; +INT VAR printed pages; +BOOL VAR not skipped, lines to be skipped, + first text line, end of paragraph, + linefeed needed; +LET std pagelength = 25.4; + +INT VAR print mode set := left adj, collumn print possible; +LET left adj= 0; +LET right adj= 1; +LET centre adj= 2; +LET block line= 3; +LET left col= 4; +LET right col= 5; +LET centre col= 6; +LET block col= 7; +LET collumn print = 4; + + +PROC print (FILE VAR f): + enable stop; + reset printer; + reset print; + print (f, from, to); +END PROC print; + +PROC print (FILE VAR f, INT CONST first page, last page): + enable stop; + from := first page; + to := last page; + IF from > 1 THEN not skipped := FALSE FI; + WHILE (NOT eof(f)) AND (pagenr <= to) REP + getline (f, inline); + print input line; + ENDREP; + start(0.0, 0.0); make page; +ENDPROC print; + +PROC reset print: + first text line := TRUE; + not skipped := TRUE; + lines to be skipped := FALSE; + command char := "#"; + print mode set := left adj; + end of paragraph := TRUE; + inline := ""; + y max := stdpagelength ; + y position := 10000.0; + y step := lf height of current font; + y factor := 1.0; + pagenr := 0; + from := 1; to := maxint; + printed pages := -1; (* move to top of first page will set to 0 *) +ENDPROC reset print; + +INT PROC pages printed: + printed pages +END PROC pages printed; + +PROC print line (TEXT CONST in): + inline := in; + print input line; +END PROC print line; + +PROC print input line: +(* debug out ("print line:"); out (in); out (""10""13""); debug *) +INT VAR compos; +INT VAR endpos := 0, tpos := 1; +IF lines to be skipped + THEN IF pos (inline, skip end text) > 1 AND (inline SUB 1) = command char + THEN lines to be skipped := FALSE + FI; + LEAVE print input line + FI; + linefeed needed := FALSE; +IF end of paragraph + THEN collumn print possible := collumn print + ELSE collumn print possible := 0 + FI; +compos := LENGTH inline; +IF (inline SUB compos) = paragraph end + THEN end of paragraph := TRUE; + inline := subtext (inline, 1, compos -1) + ELSE end of paragraph := FALSE; + FI; + compos := pos (inline, command char); + IF compos <= 0 + THEN print the line (inline); + new line; + LEAVE print input line + FI; + outline := ""; + extract commands from input; + IF outline <> "" + THEN print the line (outline); new line + ELIF linefeed needed + THEN new line FI; +. +extract commands from input: +WHILE compos > 0 REP + outline CAT subtext (inline, tpos, compos-1); + endpos := pos ( inline, command char, compos +1); + IF endpos <= compos + THEN endpos := compos - 1; + compos := 0 + ELSE command := subtext ( inline, compos +1, endpos -1); + analyze command ( command); + tpos := endpos +1; + compos := pos(inline, command char, tpos); + FI; + PER; +outline CAT subtext (inline, endpos + 1); + +ENDPROC print input line; + + +TEXT VAR comlist:="ub:1.0ue:2.0type:4.1linefeed:5.1limit:6.1free:7.1page:8.01 +pagenr:9.2pagelength:10.1start:11.2foot:12.0end:13.0head:15.0headeven:16.0 +headodd:17.0bottom:19.0bottomeven:20.0bottomodd:21.0" +LET com list 2 = +"on:22.1off:23.1block:24.0left:25.0right:26.0centre:27.0center:28.0material:31.1papersize:32.2print:33.2"; +comlist CAT comlist 2; + +PROC analyze command (TEXT CONST command): +(* debug out ("analyze command:"); out (command); out (""10""13""); debug *) +IF pos (command, "-") = 1 + THEN LEAVE analyze command + ELIF pos (command, "/") = 1 + THEN help := subtext (command, 2); + print line so far; + printer cmd (help); + LEAVE analyze command + FI; +INT VAR comindex := -1, number := 0; + par 1 := ""; par 2 := ""; + disable stop; + analyze command ( com list, command, 3, comindex, number, par 1, par 2); + IF is error + THEN clear error + ELSE select command + FI; + enable stop; +. +select command : + SELECT comindex OF + CASE 1 : print line so far; on ("u"); + CASE 2 : print line so far; off ("u"); + CASE 4 : print line so far; set type (par 1) + CASE 5 : set linefeed ( par 1) + CASE 6 : set limit (par 1) + CASE 7 : print line so far; free (par 1) + CASE 8 : print line so far; make page + CASE 9 : + CASE 10 : set pagelength (par 1) + CASE 11 : set start (par 1, par 2) + CASE 12 : (* skip text ("end") *) + CASE 15,16,17 : (* skip text ("end") *) + CASE 19,20,21 : (* skip text ("end") *) + CASE 22 : print line so far; on (par1) + CASE 23 : print line so far; off (par1) + CASE 24 : print line so far; print mode set := block line; + CASE 25 : print line so far; print mode set := left adj; + CASE 26 : print line so far; print mode set := right adj + CASE 27 : print line so far; print mode set := centre adj + CASE 28 : comindex := print mode set MOD 4; + IF comindex = block line + THEN inline CAT "#block#" + ELIF comindex = left adj + THEN inline CAT "#left#" + ELIF comindex = right adj + THEN inline CAT "#right#" + FI; + print mode set := centre adj; +(* the following commands must appear before any text *) + CASE 31 : IF first text line THEN material (par1) FI + CASE 32 : IF first text line THEN do papersize (par1, par2) FI + CASE 33 : IF first text line THEN print from page till page (par1, par2) FI + OTHERWISE + END SELECT ; +. +print line so far: + IF outline <> "" + THEN print the line (outline); + outline := ""; + linefeed needed := TRUE + FI; + +ENDPROC analyze command; + +PROC do papersize (TEXT CONST s, t): +REAL VAR w, l; + IF ok (par1, w) AND ok (par2, l) + THEN papersize (w, l) + FI; +END PROC do papersize; + +PROC print from page till page(TEXT VAR s, t): +INT VAR i, j; + IF ok (par1, i) AND ok (par2, j) + THEN from := i; + to := j; + FI; +END PROC print from page till page; + +PROC set type (TEXT CONST new type): + change type (new type); + y step := lf height of current font; +ENDPROC set type; + +PROC make page : + IF y position > 0.0 CAND NOT first text line + THEN y position := y max + 1.0; new line + FI; + end of paragraph := TRUE; + inline := ""; (* this stops further processing of the input line *) +ENDPROC make page; + +PROC skip text (TEXT CONST endword): + lines to be skipped := TRUE; + skip end text := endword; + inline := ""; (* possible rest of the line is not examined *) +END PROC skip text; + +PROC set linefeed ( TEXT CONST lf): +REAL VAR l:= real (lf); + IF last conversion ok THEN y factor := l FI; +ENDPROC set linefeed; + +PROC set limit ( TEXT CONST l): + REAL VAR len; + IF ok (l, len) + THEN limit (len) + FI; +ENDPROC set limit; + +BOOL PROC ok ( TEXT CONST param, INT VAR number): + number := int (param) ; + last conversion ok +ENDPROC ok; + +BOOL PROC ok ( TEXT CONST param, REAL VAR number): + number := real (param) ; + last conversion ok +ENDPROC ok; + +PROC set pagelength (TEXT CONST y): +REAL VAR iy ; + IF ok (y, iy ) + THEN y max := iy; +FI; +ENDPROC set pagelength; + +PROC set start (TEXT CONST x, y): +REAL VAR rx, ry; + IF ok (x, rx) AND ok (y, ry) + THEN start (rx, ry) + FI; +ENDPROC set start; + +PROC free (TEXT CONST p): +REAL VAR x, y := y factor; + IF ok (p, x) + THEN advance + FI; +y factor := y; +end of paragraph := TRUE; + inline := ""; (* this stops further processing of the input line *) +. +advance: + y factor := x / y step; + IF outline <> "" + THEN print the line (outline); + outline := "" + FI; + IF first text line + THEN new line FI; +new line; +END PROC free; + +PROC print the line ( TEXT CONST in): +(* debug out ("print the line:"); out (in); out (print mode set); +out (""10""13""); debug *) +IF first text line + THEN first text line := FALSE; new line FI; +IF not skipped + THEN IF print mode set = blockline + THEN IF end of paragraph + THEN print text (in, left adj + collumn print possible) + ELSE print text (in, blockline + collumn print possible) + FI + ELSE print text (in, print mode set + collumn print possible) + FI + FI; +ENDPROC print the line; + +PROC new line: +(* debug out ("new line: lf="); out (text(yfactor)); out (""10""13""); debug *) +IF page is full + THEN pagenr INCR 1; + IF not skipped + THEN printed pages INCR 1; + new page + FI; + check printmodes; + y position := 0.0 + ELSE IF not skipped + THEN line (y factor) + FI; + y position INCR yfactor * y step + FI; +ENDPROC new line; + +PROC check printmodes: + not skipped := ( pagenr >= from) AND ( pagenr <= to); +ENDPROC check printmodes; + +BOOL PROC page is full: + y position + yfactor * y step > y max +ENDPROC page is full; + +(********** dummys ************) + +BOOL PROC is elan source (FILE VAR source) : + FALSE +ENDPROC is elan source ; + +PROC elan list (FILE VAR source) : + print (source) +ENDPROC elan list ; + +ENDPACKET eumel printer; diff --git a/system/std.zusatz/1.7.3/src/eumelmeter b/system/std.zusatz/1.7.3/src/eumelmeter new file mode 100644 index 0000000..24f5833 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/eumelmeter @@ -0,0 +1,130 @@ + (* Author: J.Liedtke*) +PACKET eumelmeter DEFINES (* Stand: 11.10.83 *) + + init log , + log : + + +LET snapshot interval = 590.0 ; + +REAL VAR next snapshot time , + time , timex , + paging wait , paging wait x , + paging busy , paging busy x , + fore cpu , fore cpu x , + back cpu , back cpu x , + system cpu , system cpu x , + delta t ; +INT VAR storage max, used ; +TEXT VAR record ; + +PROC init log : + + time := clock (1) ; + paging wait := clock (2) ; + paging busy := clock (3) ; + fore cpu := clock (4) ; + back cpu := clock (5) ; + system cpu := clock (6) ; + next snapshot time := time + snapshot interval + +ENDPROC init log ; + +PROC log (INT CONST active terminals, active background) : + + new snapshot time if was clock reset ; + IF clock (1) >= next snapshot time + THEN save values ; + get new values ; + create stat record ; + put log (record) ; + define next snapshot time + FI . + +new snapshot time if was clock reset : + IF clock (1) < next snapshot time - snapshot interval + THEN next snapshot time := clock (1) + FI . + +save values : + time x := time ; + paging wait x := paging wait ; + paging busy x := paging busy ; + fore cpu x := fore cpu ; + back cpu x := back cpu ; + system cpu x := system cpu . + +get new values : + time := clock (1) ; + paging wait := clock (2) ; + paging busy := clock (3) ; + fore cpu := clock (4) ; + back cpu := clock (5) ; + system cpu := clock (6) ; + storage (storage max, used) . + +create stat record : + record := text (used, 5) ; + record CAT text (active terminals,3) ; + record CAT text (active background,3) ; + delta t := (time - time x) ; + percent (paging wait, paging wait x) ; + percent (paging busy, paging busy x) ; + percent (fore cpu, fore cpu x) ; + percent (back cpu, back cpu x) ; + percent (system cpu, system cpu x) ; + percent (last, 0.0) ; + percent (nutz, 0.0) . + +last : paging wait + paging busy + fore cpu + back cpu + system cpu + - paging waitx - paging busyx - fore cpux - back cpux - system cpux . + +nutz : time - paging wait - system cpu + - timex + paging waitx + system cpux . + +define next snapshot time : + next snapshot time := time + snapshot interval . + +ENDPROC log ; + +PROC percent (REAL CONST neu, alt ) : + + record CAT text ( (neu-alt) / delta t * 100.0, 6,1) + "%" + +ENDPROC percent ; + +ENDPACKET eumelmeter ; + +INT VAR active terminals , active background ; + +task password ("-") ; +break ; +command dialogue (FALSE) ; +forget ("eumelmeter") ; +init log ; +REP + pause (6000) ; + count active processes (active terminals, active background) ; + log (active terminals, active background) +PER ; + +PROC count active processes (INT VAR active terminals, active background) : + + active terminals := 0 ; + active background := 0 ; + TASK VAR process := myself ; + REP + next active (process) ; + IF user process + THEN IF process at terminal + THEN active terminals INCR 1 + ELSE active background INCR 1 + FI + FI + UNTIL process = myself PER . + +user process : NOT (process < supervisor) . + +process at terminal : channel (process) >= 0 . + +ENDPROC count active processes ; diff --git a/system/std.zusatz/1.7.3/src/free channel b/system/std.zusatz/1.7.3/src/free channel new file mode 100644 index 0000000..89f7ce0 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/free channel @@ -0,0 +1,292 @@ +PACKET free channel DEFINES (* Autor: J.Liedtke *) + (* Stand: 05.10.82 *) + FCHANNEL , + := , + free channel , + open , + close , + out , + in , + dialogue : + + + +LET ack = 0 , + nak = 1 , + break code = 6 , + empty message code = 256 , + long message code = 257 , + file message code = 1024 , + open code = 1000 , + close code = 1001 , + + cr = ""13"" ; + +INT CONST task not existing := - 1 ; + + +TYPE FCHANNEL = STRUCT (TASK server, TEXT input buffer, server name) ; + +INT VAR message code , response code ; +TASK VAR partner , used by ; +DATASPACE VAR ds ; + +BOUND TEXT VAR msg ; +TEXT VAR response, char, esc char , record ; + +FILE VAR file ; + + +OP := (FCHANNEL VAR dest, FCHANNEL CONST source) : + + dest.server := source.server ; + dest.input buffer := "" ; + dest.server name := source.server name ; + open (dest) + +ENDOP := ; + +FCHANNEL PROC free channel (TEXT CONST channel name) : + + FCHANNEL:(niltask,"", channel name) + +ENDPROC free channel ; + +PROC open (FCHANNEL VAR channel) : + + TASK VAR task id ; + INT VAR receipt ; + + initialize message dataspace ; + send open code ; + IF receipt <> ack + THEN errorstop ("channel not free") + FI . + +initialize message dataspace : + forget (ds) ; + ds := nilspace . + +send open code : + ping pong (channel.server, open code, ds, receipt) ; + IF receipt = task not existing + THEN channel.server := task (channel.server name) ; + ping pong (channel.server, open code, ds, receipt) + FI . + +ENDPROC open ; + +PROC close (FCHANNEL VAR channel) : + + call (channel.server, close code, ds, response code) + +ENDPROC close ; + +PROC close (TEXT CONST channel server) : + + call (task (channel server), close code, ds, response code) + +ENDPROC close ; + + +PROC out (FCHANNEL VAR channel, TEXT CONST message) : + + send message ; + get response . + +send message : + IF message = "" + THEN call (channel.server, empty message code, ds, response code) + ELSE msg := ds ; + CONCR (msg) := message ; + call (channel.server, long message code, ds, response code) + FI . + +get response : + IF response code < 0 + THEN errorstop ("channel not ready") + ELIF response code < 256 + THEN channel.input buffer CAT code (response code) + ELIF response code = long message code + THEN msg := ds ; + channel.input buffer CAT CONCR (msg) + FI . + +ENDPROC out ; + +PROC in (FCHANNEL VAR channel, TEXT VAR response) : + + out (channel, "") ; + response := channel.input buffer ; + channel.input buffer := "" + +ENDPROC in ; + +PROC out (FCHANNEL VAR channel, DATASPACE CONST file space) : + + out (channel, file space, ""0"") + +ENDPROC out ; + +PROC out (FCHANNEL VAR channel, DATASPACE CONST file space, + TEXT CONST handshake char) : + + forget (ds) ; + ds := file space ; + call (channel.server, file message code + code (handshake char) , + ds, response code) ; + forget (ds) ; + ds := nilspace + +ENDPROC out ; + + +PROC dialogue (FCHANNEL CONST channel, TEXT CONST esc) : + + forget (ds) ; + ds := nilspace ; + partner := channel.server ; + esc char := esc ; + enable stop ; + + response code := empty message code ; + REP + get and send message charety ; + out response option + PER . + +get and send message charety : + IF response code = empty message code + THEN char := incharety (10) + ELSE char := incharety + FI ; + IF char = "" + THEN call (partner, empty message code, ds, response code) + ELIF char = esc char + THEN LEAVE dialogue + ELSE call (partner, code (char), ds, response code) + FI . + +out response option : + IF response code < 256 + THEN out (code (response code)) + ELIF response code = long message code + THEN msg := ds ; + out (CONCR (msg)) + FI . + +ENDPROC dialogue ; + +PROC free channel (INT CONST nr) : + + INT CONST my channel := nr ; + break ; + disable stop ; + REP + wait (ds, message code, partner) ; + IF message code = open code + THEN connect to my channel ; + use channel ; + break without advertise ; + send handshake ack + ELSE send (partner, nak, ds) + FI + PER . + +use channel : + ping pong (partner, ack, ds, message code) ; + REP + execute message ; + response option + PER . + +execute message : + IF message code < 0 + THEN LEAVE use channel + ELIF message code < 256 + THEN out (code (message code)) + ELIF message code = long message code + THEN msg := ds ; + out (CONCR (msg)) + ELIF message code >= file message code + THEN send file ; + clear error + ELIF message code = close code + THEN LEAVE use channel + FI . + +response option : + response := incharety (1) ; + IF response = "" + THEN ping pong (partner, empty message code, ds, message code) + ELSE short or long response + FI . + +short or long response : + char := incharety ; + IF char = "" + THEN short response + ELSE long response + FI . + +short response : + ping pong (partner, code (response), ds, message code) . + +long response : + msg := ds ; + response CAT char ; + REP + char := incharety ; + response CAT char + UNTIL char = "" PER ; + CONCR (msg) := response ; + ping pong (partner, long message code, ds, message code) . + +connect to my channel : + continue (my channel) ; + WHILE is error REP + clear error ; + pause (100) ; + continue (my channel) + PER . + +break without advertise : + INT VAR receipt ; + call (supervisor, break code, ds, receipt) . + +send handshake ack : + send (partner, ack, ds) . + +ENDPROC free channel ; + +PROC send file : + + enable stop ; + get handshake ; + file := sequential file (input,ds) ; + REP + getline (file, record) ; + out (record) ; + out (cr) ; + handshake option + UNTIL eof (file) PER . + +get handshake : + TEXT CONST handshake char := code (message code - file message code) . + +handshake option : + IF handshake char <> ""0"" + THEN wait for handshake or time out + FI . + +wait for handshake or time out : + REP + char := incharety (300) + UNTIL char = handshake char OR char = "" PER ; + IF char = "" + THEN LEAVE send file + FI . + +ENDPROC send file ; + +ENDPACKET free channel ; diff --git a/system/std.zusatz/1.7.3/src/longint b/system/std.zusatz/1.7.3/src/longint new file mode 100644 index 0000000..ac3dad5 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/longint @@ -0,0 +1,422 @@ +PACKET longint DEFINES LONGINT, (* Autoren: S.Baumann,A.Bentrup *) + :=, (* T.Sillke *) + <, (* Stand: 17.03.81 *) + >, + <=, + >=, + <>, + =, + -, + +, + *, + **, + ABS, + abs, + DECR, + DIV, + get, + INCR, + int, + (*last rest,*) + longint, + max, + max longint, + min, + MOD, + put, + random, + SIGN, + sign, + text, + zero: + +TYPE LONGINT = TEXT; + +LONGINT VAR result,aleft,aright; +TEXT VAR ergebnis,x,y,z,h; +INT VAR v byte,slr,sll; +INT CONST snull :: code("0"), mtl :: 300 ; +TEXT CONST negativ :: code(127),max digit :: code(99),null :: code(0), + overflow :: "LONGINT overflow",eins :: code(1); +BOOL VAR vorl,vorr,vleft,vright; + +OP := (LONGINT VAR left, LONGINT CONST right) : + CONCR(left) := CONCR(right) +END OP :=; + +BOOL OP < (LONGINT CONST left,right) : + slr := sign(right)*length(right); + sll := sign(left )*length(left ); + IF slr <> sll THEN + IF slr > sll THEN TRUE ELSE FALSE FI + ELSE IF slr>0 + THEN CONCR(left) < CONCR(right) + ELSE CONCR(left) > CONCR(right) FI + FI +END OP < ; + +BOOL OP > (LONGINT CONST left,right) : + slr := sign(right)*length(right); + sll := sign(left )*length(left ); + IF slr <> sll THEN + IF slr < sll THEN TRUE ELSE FALSE FI + ELSE IF slr>0 + THEN CONCR(left) > CONCR(right) + ELSE CONCR(left) < CONCR(right) FI + FI +END OP > ; + +BOOL OP <= (LONGINT CONST left,right) : + NOT (left > right) +END OP <=; + +BOOL OP >= (LONGINT CONST left,right) : + NOT (left < right) +END OP >=; + +BOOL OP <> (LONGINT CONST left,right) : + CONCR (left) <> CONCR (right) +END OP <>; + +BOOL OP = (LONGINT CONST left,right) : + CONCR (left) = CONCR (right) +END OP = ; + +LONGINT OP - (LONGINT CONST arg) : + SELECT code(CONCR(arg)SUB1) OF + CASE 0 : zero + CASE 127: LONGINT : (subtext(CONCR(arg),2)) + OTHERWISE LONGINT : (negativ + CONCR(arg)) + END SELECT +END OP -; + +LONGINT OP + (LONGINT CONST arg) : arg END OP +; + +LONGINT OP - (LONGINT CONST left,right) : + IF CONCR(left ) = null THEN LEAVE - WITH -right + ELIF CONCR(right) = null THEN LEAVE - WITH left + ELIF sign(left) <> sign(right) THEN LEAVE - WITH left + (-right) FI; + betrag(left,right); + BOOL CONST betrag max :: aleft > aright; + IF betrag max + THEN result := LONGINT : (CONCR(aleft ) SUB CONCR(aright)) + ELSE result := LONGINT : (CONCR(aright) SUB CONCR(aleft )) FI; + kuerze fuehrende nullen(CONCR(result),null); + IF vleft XOR betrag max THEN -result ELSE result FI +END OP -; + +LONGINT OP + (LONGINT CONST left,right) : + IF sign(left) <> sign(right) THEN LEAVE + WITH left - (-right) FI; + betrag(left,right); + IF aleft > aright + THEN result := LONGINT : (CONCR(aleft ) ADD CONCR(aright)) + ELSE result := LONGINT : (CONCR(aright) ADD CONCR(aleft )) FI; + IF vleft THEN result ELSE -result FI +END OP +; + +LONGINT OP * (LONGINT CONST left,right) : + IF CONCR(left) = null OR CONCR(right) = null THEN LEAVE * WITH zero + ELIF length(left) + length(right) > mtl THEN errorstop (overflow) FI; + betrag(left,right); + IF aleft < aright + THEN result := LONGINT : (CONCR(aright) MUL CONCR(aleft )) + ELSE result := LONGINT : (CONCR(aleft ) MUL CONCR(aright)) FI; + IF length(CONCR(result)) = mtl THEN errorstop(overflow) FI; + IF vleft XOR vright THEN -result ELSE result FI +END OP *; + +LONGINT OP ** (LONGINT CONST arg,exp) : + IF exp > longint(max int) THEN errorstop (overflow) FI; + arg ** int(exp) +END OP **; + +LONGINT OP ** (LONGINT CONST arg,INT CONST exp) : + IF exp < 0 THEN errorstop ("LONGINT OP ** : negativ exp") + ELIF CONCR(arg)=null AND exp=0 THEN errorstop(text(0 ** 0)) FI; + IF exp = 0 THEN one + ELIF exp = 1 THEN arg + ELIF sign(arg) = -1 AND exp MOD 2 <> 0 + THEN -LONGINT:(CONCR(abs(arg))EXPexp) + ELSE LONGINT:(CONCR(abs(arg))EXPexp) FI +END OP **; + +LONGINT OP ABS (LONGINT CONST arg) : abs(arg) END OP ABS; + +LONGINT PROC abs (LONGINT CONST a) : + IF (CONCR(a)SUB1)=negativ THEN LONGINT:(subtext(CONCR(a),2)) ELSE a FI +END PROC abs; + +OP DECR (LONGINT VAR result,LONGINT CONST ab) : + result := result - ab; +END OP DECR; + +LONGINT OP DIV (LONGINT CONST left,right) : + IF CONCR(right) = null THEN error stop("LONGINT OP DIV by zero") FI; + betrag(left,right); h := CONCR(aright); + y := null + CONCR(aleft ); vorl := vleft; + z := null + CONCR(aright); vorr := vright; + IF aleft < aright THEN y:=CONCR(aleft); LEAVE DIV WITH zero FI; + INT VAR try,i,cr1 :: code(z SUB 2),cr2,cr3,zw; + BOOL VAR sh :: length(z) <> 2; + IF sh THEN cr3:=code(zSUB3); cr2:=10*cr1+cr3DIV10; cr3:=100*cr1+cr3 FI; + CONCR(result) := ""; + FOR i FROM 0 UPTO length(y)-length(z) REP + laufe eine abschaetzung durch; + CONCR (result) CAT code(try) + PER; kuerze fuehrende nullen(y,null); + IF(CONCR(result)SUB1)=nullTHEN CONCR(result):=subtext(CONCR(result),2)FI; + IF vleft XOR vright THEN -result ELSE result FI. + + laufe eine abschaetzung durch : + zw := 100*code(y SUB i+1) + code(y SUB i+2); + IF zw < 3276 AND sh THEN IF zw < 327 + THEN try := min((100*zw + code(ySUBi+3)) DIV cr3, 99) + ELSE try := min(( 10*zw + code(ySUBi+3)DIV10)DIV cr2, 99) FI + ELSE try := min( zw DIV cr1, 99) FI; + x := z MUL code(try); + WHILE x > subtext(y,i+1,i+length(x)) REP + try DECR 1; x := x SUB z PER; + replace(y,i + 1,subtext(y,i + 1,i + length(x)) SUB x) +END OP DIV; + +PROC get (LONGINT VAR result) : + get (ergebnis); + result := longint(ergebnis); +END PROC get; + +PROC get (FILE VAR file,LONGINT VAR result) : + get(file,ergebnis); + result := longint(ergebnis); +END PROC get; + +OP INCR (LONGINT VAR result,LONGINT CONST dazu) : + result := result + dazu; +END OP INCR; + +INT PROC int (LONGINT CONST longint) : + IF length(longint) > 3 + THEN max int + 1 + ELSE ergebnis := (3-length(longint))*null + CONCR(abs(longint)); + (code(ergebnis SUB 1) * 10000 + + code(ergebnis SUB 2) * 100 + + code(ergebnis SUB 3)) * sign(longint) + FI +END PROC int; + +LONGINT PROC longint (INT CONST int) : + CONCR(result) := code( abs(int) DIV 10000) + + code((abs(int) MOD 10000) DIV 100) + + code( abs(int) MOD 100); + kuerze fuehrende nullen (CONCR(result),null); + IF int < 1 THEN -result ELSE result FI +END PROC longint; + +LONGINT PROC longint (TEXT CONST text) : + INT VAR i; + ergebnis := compress(text); + BOOL VAR minus :: (ergebnisSUB1) = "-"; + IF (ergebnisSUB1)="+" OR minus THEN ergebnis:=subtext(ergebnis,2) FI; + kuerze fuehrende nullen(ergebnis,"0"); + kuerze die unzulaessigen zeichen aus ergebnis; + schreibe ergebnis im hundertersystem in result; + result mit vorzeichen. + + kuerze die unzulaessigen zeichen aus ergebnis : + ergebnis := subtext(ergebnis,1,letztes zulaessiges zeichen). + letztes zulaessiges zeichen : + FOR i FROM 1 UPTO length(ergebnis) REP + UNTIL pos("0123456789", ergebnis SUB i) = 0 PER; + i - 1. + schreibe ergebnis im hundertersystem in result : + sll := length(ergebnis); + IF sll MOD 2 <> 0 THEN ergebnis := "0"+ergebnis; sll INCR 1 FI; + i := 1; CONCR(result) := ""; + REP schreibe ein zeichen im hundertersystem in result; + i INCR 2 + UNTIL i >= sll PER. + schreibe ein zeichen im hundertersystem in result : + CONCR(result) CAT code((code(ergebnis SUB i ) - snull) * 10 + + code(ergebnis SUB i + 1) - snull). + result mit vorzeichen : + IF ergebnis="" THEN zero ELIF minus THEN -result ELSE result FI +END PROC longint; + +LONGINT PROC max (LONGINT CONST left,right) : + IF left > right THEN left ELSE right FI +END PROC max; + +LONGINT PROC max longint : + LONGINT : ((mtl - 1) * max digit) +END PROC max longint; + +LONGINT PROC min (LONGINT CONST left,right) : + IF left < right THEN left ELSE right FI +END PROC min; + +LONGINT OP MOD (LONGINT CONST left,right) : + IF CONCR(right) = null THEN errorstop("LONGINT OP MOD by zero") FI; + result := left DIV right; last rest +END OP MOD; + +PROC put (LONGINT CONST longint) : + INT VAR i :: 1,zwei ziffern; + IF sign(longint) = -1 THEN out("-"); i:=2 FI; + out(text(code(CONCR(longint) SUB i))); + FOR i FROM i + 1 UPTO length(CONCR(longint)) REP + zwei ziffern := code(CONCR(longint) SUB i); + out(code(zwei ziffern DIV 10 + snull)); + out(code(zwei ziffern MOD 10 + snull)); + PER;out(" ") +END PROC put; + +PROC put (FILE VAR file,LONGINT CONST longint) : + put(file,text(longint)); +END PROC put; + +LONGINT PROC random (LONGINT CONST lower bound,upper bound) : + INT VAR i; x := CONCR(upper bound - lower bound - one); y := ""; + FOR i FROM 1 UPTO length(x) REP y CAT code(random(0,99)) PER; + upper bound - (LONGINT : (y) MOD LONGINT : (x)) +END PROC random; + +INT OP SIGN (LONGINT CONST arg) : sign(arg) END OP SIGN; + +INT PROC sign (LONGINT CONST arg) : + SELECT code(CONCR(arg) SUB 1) OF + CASE 0 : 0 + CASE 127 : -1 + OTHERWISE 1 + END SELECT +END PROC sign; + +TEXT PROC text (LONGINT CONST longint) : + INT VAR i::1,zwei ziffern; ergebnis := ""; + IF sign(longint) = -1 THEN ergebnis := "-"; i:=2 FI; + ergebnis CAT text (code (CONCR (longint) SUB i ) ) ; + FOR i FROM i+1 UPTO length(CONCR(longint)) REP + zwei ziffern := code(CONCR(longint) SUB i); + ergebnis CAT code(zwei ziffern DIV 10 + snull); + ergebnis CAT code(zwei ziffern MOD 10 + snull) + PER; ergebnis +END PROC text; + +TEXT PROC text (LONGINT CONST longint,INT CONST length) : + x := text(longint); sll := LENGTH x; + IF sll > length THEN length * "*" ELSE (length - sll)*" " + x FI +END PROC text; + +LONGINT PROC last rest : + IF y=null THEN LEAVE last rest WITH zero FI; + IF vorl XOR vorr THEN y := h SUB y; kuerze fuehrende nullen(y,null); + vorl := TRUE FI; + IF NOTvorr THEN y:=negativ+y; vorr := TRUE FI; LONGINT:(y) +END PROC last rest; + +LONGINT PROC zero : LONGINT : (null) END PROC zero; +LONGINT PROC one : LONGINT : (""1"") END PROC one; + + +(* ----------------------- INTERNE HILFSPROZEDUREN ----------------------- *) + +TEXT OP ADD (TEXT CONST left,right) : + INT VAR carrybit :: 0,i,dif :: length(left) - length(right); + ergebnis := left; + FOR i FROM length(left) DOWNTO dif + 1 REP + replace(ergebnis,i,das result der addition) + PER; + IF carrybit = 1 THEN addiere den uebertrag FI; + ergebnis. + + das result der addition : + v byte := (code(left SUB i) + code(right SUB i - dif) + carrybit); + IF v byte > 99 + THEN carrybit := 1; code(v byte - 100) + ELSE carrybit := 0; code(v byte) + FI. + addiere den uebertrag : + FOR i FROM i DOWNTO 1 + WHILE (ergebnis SUB i) >= max digit REP + replace(ergebnis,i,null) + PER; + IF (ergebnis SUB 1) = null OR dif = 0 + THEN pruefe auf longint overflow + ELSE replace(ergebnis,i,code(code(ergebnis SUB i) + 1)) + FI. + pruefe auf longint overflow : + IF length(ergebnis) = mtl - 1 THEN errorstop(overflow) FI; + ergebnis := eins + ergebnis +END OP ADD; + +PROC betrag (LONGINT CONST a, b) : + vleft := (CONCR(a)SUB1)<>negativ; vright := (CONCR(b)SUB1)<>negativ; + IF vleft THEN aleft :=a ELSE CONCR(aleft ):=subtext(CONCR(a),2) FI; + IF vright THEN aright:=b ELSE CONCR(aright):=subtext(CONCR(b),2) FI +END PROC betrag; + +TEXT OP EXP (TEXT CONST arg,INT CONST exp) : + INT VAR zaehler :: exp; + x := arg; z := eins; + REP IF zaehler MOD 2 = 1 THEN z := z MUL x FI; + zaehler := zaehler DIV 2; x := x MUL x + UNTIL zaehler = 1 PER; + x MUL z +END OP EXP; + +PROC kuerze fuehrende nullen ( TEXT VAR text,TEXT CONST snull) : + INT VAR i; + text := subtext(text,erste nicht snull). + + erste nicht snull : + FOR i FROM 1 UPTO length (text) - 1 REP + UNTIL (text SUB i) <> snull PER; + i +END PROC kuerze fuehrende nullen; + +INT PROC length (LONGINT CONST a) : + IF (CONCR(a)SUB1)=negativ THEN length(CONCR(a))-1 ELSE length(CONCR(a)) FI +END PROC length; + +TEXT OP MUL (TEXT CONST left,right) : + INT VAR i,j,carrybit,v,w; + ergebnis := (length(left) + length(right) - 1) * null; + FOR i FROM length(ergebnis) DOWNTO length(left) REP + v := i - length(left); w := length(right) - length(ergebnis) + i; + carrybit := 0; + FOR j FROM length(left) DOWNTO 1 REP + replace(ergebnis,v + j,result der addition) + PER; + replace(ergebnis,v,code(code(ergebnis SUB v) + carrybit)); + PER; + IF carrybit = 0 THEN ergebnis ELSE code(carrybit) + ergebnis FI. + + result der addition : + v byte := code(right SUB w) * code(left SUB j) + carrybit + + code(ergebnis SUB v + j); + carrybit := v byte DIV 100; + code(v byte MOD 100) +END OP MUL; + +TEXT OP SUB (TEXT CONST left,right) : + INT VAR carrybit :: 0,i,dif :: length(left) - length(right); + ergebnis := left; + FOR i FROM length(left) DOWNTO dif + 1 REP + replace(ergebnis,i,das result der subtraktion); + PER; + IF carrybit = 1 THEN subtrahiere den uebertrag FI; + ergebnis. + + das result der subtraktion : + v byte := (code(left SUB i) - code(right SUB i - dif) - carrybit); + IF v byte < 0 + THEN carrybit := 1;code(v byte + 100) + ELSE carrybit := 0;code(v byte) + FI. + subtrahiere den uebertrag : + FOR i FROM i DOWNTO 2 + WHILE (ergebnis SUB i) = null REP + replace(ergebnis,i,max digit) + PER; + replace(ergebnis,i,code(code(ergebnis SUB i) - 1)) +END OP SUB; + +END PACKET longint; diff --git a/system/std.zusatz/1.7.3/src/matrix b/system/std.zusatz/1.7.3/src/matrix new file mode 100644 index 0000000..fbc5ffc --- /dev/null +++ b/system/std.zusatz/1.7.3/src/matrix @@ -0,0 +1,470 @@ +PACKET matrix DEFINES MATRIX, matrix, idn, (* Stand : 21.10.83 *) + :=, sub, (* Autor : H.Indenbirken *) + row, column, + COLUMNS, + ROWS, + DET, + INV, + TRANSP, + transp, + replace row, replace column, + replace element, + get, put, + =, <>, + +, -, * : + +TYPE MATRIX = STRUCT (INT rows, columns, VECTOR elems); +TYPE INITMATRIX = STRUCT (INT rows, columns, REAL value, BOOL idn); + +MATRIX VAR a :: idn (1); +INT VAR i; + +(**************************************************************************** +PROC dump (MATRIX CONST m) : + put line (text (m.rows) + " Reihen, " + text (m.columns) + " Spalten."); + dump (m.elems) . + +END PROC dump; +****************************************************************************) + +OP := (MATRIX VAR l, MATRIX CONST r) : + CONCR (l) := CONCR (r); +END OP :=; + +OP := (MATRIX VAR l, INITMATRIX CONST r) : + l.rows := r.rows; + l.columns := r.columns; + l.elems := vector (r.rows*r.columns, r.value); + IF r.idn + THEN idn FI . + +idn : + INT VAR i; + FOR i FROM 1 UPTO r.rows + REP replace (l.elems, calc pos (l.columns, i, i), 1.0) PER + +END OP :=; + +INITMATRIX PROC matrix (INT CONST rows, columns, REAL CONST value) : + IF rows <= 0 + THEN errorstop ("PROC matrix : rows <= 0") + ELIF columns <= 0 + THEN errorstop ("PROC matrix : columns <= 0") FI; + + INITMATRIX : (rows, columns, value, FALSE) + +END PROC matrix; + +INITMATRIX PROC matrix (INT CONST rows, columns) : + matrix (rows, columns, 0.0) + +END PROC matrix; + +INITMATRIX PROC idn (INT CONST size) : + IF size <= 0 + THEN errorstop ("MATRIX PROC idn : size <= 0") FI; + + INITMATRIX : (size, size, 0.0, TRUE) + +END PROC idn; + +VECTOR PROC row (MATRIX CONST m, INT CONST i) : + VECTOR VAR v :: vector (m.columns); + INT VAR j, k :: 1, pos :: (i-1) * m.columns; + FOR j FROM pos+1 UPTO pos + m.columns + REP replace (v, k, m.elems SUB j); + k INCR 1 + PER; + v + +END PROC row; + +VECTOR PROC column (MATRIX CONST m, INT CONST j) : + VECTOR VAR v :: vector (m.rows); + INT VAR i, k :: j; + FOR i FROM 1 UPTO m.rows + REP replace (v, i, m.elems SUB k); + k INCR m.columns + PER; + v + +END PROC column; + +INT OP COLUMNS (MATRIX CONST m) : + m.columns + +END OP COLUMNS; + +INT OP ROWS (MATRIX CONST m) : + m.rows + +END OP ROWS; + +REAL PROC sub (MATRIX CONST a, INT CONST row, column) : + a.elems SUB calc pos (a.columns, row, column) + +END PROC sub; + +PROC replace row (MATRIX VAR m, INT CONST rowindex, VECTOR CONST rowvalue) : + test ("PROC replace row : ", "LENGTH rowvalue", "COLUMNS m", + LENGTH rowvalue, m.columns); + test ("PROC replace row : row ", rowindex, m.rows); + + INT VAR i, pos :: (rowindex-1) * m.columns; + FOR i FROM 1 UPTO m.columns + REP replace (m.elems, pos+i, rowvalue SUB i) PER + +END PROC replace row; + +PROC replace column (MATRIX VAR m, INT CONST columnindex, + VECTOR CONST columnvalue) : + test ("PROC replace column : ", "LENGTH columnvalue", "ROWS m", + LENGTH columnvalue, m.rows); + test ("PROC replace column : column ", columnindex, m.columns); + + INT VAR i; + FOR i FROM 1 UPTO m.rows + REP replace (m.elems, calc pos (m.columns, i, columnindex), + columnvalue SUB i) PER + +END PROC replace column; + +PROC replace element (MATRIX VAR a, INT CONST row, column, REAL CONST x) : + test ("PROC replace element : row ", row, a.rows); + test ("PROC replace element : column ", column, a.columns); + replace (a.elems, calc pos (a.columns, row, column), x) + +END PROC replace element; + +BOOL OP = (MATRIX CONST l, r) : + IF l.rows <> r.rows + THEN FALSE + ELIF l.columns <> r.columns + THEN FALSE + ELSE l.elems = r.elems FI + +END OP =; + +BOOL OP <> (MATRIX CONST l, r) : + IF l.rows <> r.rows + THEN TRUE + ELIF l.columns <> r.columns + THEN TRUE + ELSE l.elems <> r.elems FI + +END OP <>; + +INT PROC calc pos (INT CONST columns, z, s) : + (z-1) * columns + s +END PROC calc pos; + +MATRIX OP + (MATRIX CONST m) : + m + +END OP +; + +MATRIX OP + (MATRIX CONST l, r) : + test ("MATRIX OP + : ", "ROWS l", "ROWS r", l.rows, r.rows); + test ("MATRIX OP + : ", "COLUMNS l", "COLUMNS r", l.columns, r.columns); + + a := l; + INT VAR i; + FOR i FROM 1 UPTO l.rows * l.columns + REP replace (a.elems, i, (l.elems SUB i) + (r.elems SUB i)) + PER; + a + +END OP +; + +MATRIX OP - (MATRIX CONST m) : + a := m; + INT VAR i; + FOR i FROM 1 UPTO m.rows * m.columns + REP replace (a.elems, i, -a.elems SUB i) + PER; + a + +END OP -; + +MATRIX OP - (MATRIX CONST l, r) : + test ("MATRIX OP - : ", "ROWS l", "ROWS r", l.rows, r.rows); + test ("MATRIX OP - : ", "COLUMNS l", "COLUMNS r", l.columns, r.columns); + + a := l; + INT VAR i; + FOR i FROM 1 UPTO l.rows * l.columns + REP replace (a.elems, i, (l.elems SUB i) - (r.elems SUB i)) + PER; + a + +END OP -; + +MATRIX OP * (REAL CONST x, MATRIX CONST m) : + m*x + +END OP *; + +MATRIX OP * (MATRIX CONST m, REAL CONST x) : + a := m; + INT VAR i; + FOR i FROM 1 UPTO m.rows * m.columns + REP replace (a.elems, i, x*m.elems SUB i) PER; + a + +END OP *; + +VECTOR OP * (VECTOR CONST v, MATRIX CONST m) : + test ("VECTOR OP * : ", "LENGTH v", "ROWS m", LENGTH v, m.rows); + VECTOR VAR result :: vector (m.rows); + INT VAR i; + FOR i FROM 1 UPTO m.rows + REP replace (result, i, v * column (m, i)) PER; + result . + +END OP *; + +VECTOR OP * (MATRIX CONST m, VECTOR CONST v) : + test ("VECTOR OP * : ", "COLUMNS m", "LENGTH v", COLUMNS m, LENGTH v); + VECTOR VAR result :: vector (m.columns); + INT VAR i; + FOR i FROM 1 UPTO m.columns + REP replace (result, i, row (m, i) * v) PER; + result . + +END OP *; + +MATRIX OP * (MATRIX CONST l, r) : + test ("MATRIX OP * : ","COLUMNS l","ROWS r", l.columns, r.rows); + + a.rows := l.rows; + a.columns := r.columns; + a.elems := vector (a.rows*a.columns) + INT VAR i, j; + FOR i FROM 1 UPTO a.rows + REP FOR j FROM 1 UPTO a.columns + REP VECTOR VAR rl :: row (l, i), cr :: column (r, j); + replace (a.elems, calc pos (a.columns, i, j), rl * cr) + PER + PER; + a . + +END OP *; + +PROC get (MATRIX VAR a, INT CONST rows, columns) : + + a := matrix (rows,columns); + INT VAR i, j; + VECTOR VAR v; + FOR i FROM 1 UPTO rows + REP get (v, columns); + store row + PER . + +store row : + FOR j FROM 1 UPTO a.columns + REP replace (a.elems, calc pos (a.columns, i, j), v SUB j) + PER . + +END PROC get; + +PROC put (MATRIX CONST a, INT CONST length, fracs) : + INT VAR i, j; + FOR i FROM 1 UPTO a.rows + REP FOR j FROM 1 UPTO a.columns + REP put (text (sub (a, i, j), length, fracs)) PER; + line (2); + PER + +END PROC put; + +PROC put (MATRIX CONST a) : + INT VAR i, j; + FOR i FROM 1 UPTO a.rows + REP FOR j FROM 1 UPTO a.columns + REP TEXT CONST number :: " " + text (sub (a, i, j)); + put (subtext (number, LENGTH number - 15)) + PER; + line (2); + PER + +END PROC put; + +TEXT VAR error :: ""; +PROC test (TEXT CONST proc, l text, r text, INT CONST left, right) : + IF left <> right + THEN error := proc; + error CAT l text; + error CAT " ("; + error CAT text (left); + error CAT ") <> "; + error CAT r text; + error CAT " ("; + error CAT text (right); + error CAT ")"; + errorstop (error) + FI . + +END PROC test; + +PROC test (TEXT CONST proc, INT CONST i, n) : + IF i < 1 + THEN error := proc; + error CAT "subscript underflow ("; + error CAT text (i); + error CAT ")"; + errorstop (error) + ELIF i > n + THEN error := proc; + error CAT "subscript overflow (i="; + error CAT text (i); + error CAT ", max="; + IF n <= 0 + THEN error CAT "undefined" + ELSE error CAT text (n) FI; + error CAT ")"; + errorstop (error) + FI + +END PROC test; + + +MATRIX OP TRANSP (MATRIX CONST m) : + MATRIX VAR a :: m; + transp (a); + a + +END OP TRANSP; + +PROC transp (MATRIX VAR m) : + INT VAR k :: 1, n :: m.rows*m.columns; + a := m; + FOR i FROM 2 UPTO n + REP replace (m.elems, i, a.elems SUB position) PER; + a := idn (1); + i := m.rows; + m.rows := m.columns; + m.columns := i . + +position : + k INCR m.columns; + IF k > n + THEN k DECR (n-1) FI; + k . +END PROC transp; + +MATRIX OP INV (MATRIX CONST m) : + a := m; + ROW 32 INT VAR pivots; + INT VAR i, j, k :: ROWS a, n :: COLUMNS a, pos; + + IF n <> k + THEN errorstop ("MATRIX OP INV : no square matrix") FI; + + initialisiere die pivotpositionen; + + FOR j FROM 1 UPTO n + REP pivotsuche (a, j, pos); + IF sub (a, pos, pos) = 0.0 + THEN errorstop ("MATRIX OP INV : singular matrix") FI; + zeilentausch (a, j, pos); + merke dir die vertauschung; + transformiere die matrix + PER; + + spaltentausch; + a . + +initialisiere die pivotpositionen : + FOR i FROM 1 UPTO n + REP pivots [i] := i PER . + +merke dir die vertauschung : + IF pos > j + THEN INT VAR hi :: pivots [j]; + pivots [j] := pivots [pos]; + pivots [pos] := hi + FI . + +transformiere die matrix : + REAL VAR h := 1.0/sub (a, j, j); + + FOR k FROM 1 UPTO n + REP IF k <> j + THEN FOR i FROM 1 UPTO n + REP IF i <> j + THEN replace element (a, i, k, sub (a, i, k) - + sub (a, i, j)*sub (a, j, k)*h); + FI + PER; + FI + PER; + + FOR k FROM 1 UPTO n + REP replace element (a, j, k, -h*sub (a, j, k)); + replace element (a, k, j, h*sub (a, k, j)) + PER; + replace element (a, j, j, h) . + +spaltentausch : + VECTOR VAR v :: vector (n); + FOR i FROM 1 UPTO n + REP FOR k FROM 1 UPTO n + REP replace (v, pivots [k], sub (a, i, k)) PER; + replace row (a, i, v) + PER . + +END OP INV; + +REAL OP DET (MATRIX CONST m) : + IF COLUMNS m <> ROWS m + THEN errorstop ("REAL OP DET : no square matrix") FI; + + a := m; + INT VAR i, j, k, n :: COLUMNS m, pos; + FOR j FROM 1 UPTO n + REP pivotsuche (a, j, pos); + zeilentausch (a, j, pos); + transformiere die matrix + PER; + produkt der pivotelemente . + +transformiere die matrix : + REAL VAR h := 1.0/sub (a, j, j); + FOR i FROM j+1 UPTO n + REP FOR k FROM j+1 UPTO n + REP replace element (a, i, k, sub (a, i, k) - + sub (a, i, j)*h*sub (a, j, k)) + PER + PER . + +produkt der pivotelemente : + REAL VAR produkt :: sub (a, 1, 1); + FOR j FROM 2 UPTO n + REP produkt := produkt * sub (a, j, j) PER; + a := idn (1); + produkt . + +END OP DET; + +PROC pivotsuche (MATRIX CONST a, INT CONST start pos, INT VAR pos) : + REAL VAR max :: abs (sub (a, start pos, start pos)); + INT VAR i; + pos := start pos; + + FOR i FROM start pos+1 UPTO COLUMNS a + REP IF abs (sub (a, i, start pos)) > max + THEN max := abs (sub (a, i, start pos)); + pos := i + FI + PER . + +END PROC pivotsuche; + +PROC zeilentausch (MATRIX VAR a, INT CONST old pos, pos) : + VECTOR VAR v := row (a, pos); + replace row (a, pos, row (a, old pos)); + replace row (a, old pos, v) . + +END PROC zeilentausch; + +END PACKET matrix; diff --git a/system/std.zusatz/1.7.3/src/minimal fonts routines b/system/std.zusatz/1.7.3/src/minimal fonts routines new file mode 100644 index 0000000..adcfc66 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/minimal fonts routines @@ -0,0 +1,9 @@ +PACKET minimal fonts routines DEFINES lf height of current font, + x factor per inch, + y factor per inch: + +REAL CONST lf height of current font :: 2.54 / 6.0; +INT CONST x factor per inch :: 10, + y factor per inch :: 6; + +END PACKET minimal fonts routines; diff --git a/system/std.zusatz/1.7.3/src/printer-M b/system/std.zusatz/1.7.3/src/printer-M new file mode 100644 index 0000000..45b1381 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/printer-M @@ -0,0 +1,69 @@ +PACKET multi user printer : + +INT VAR printer channel ; + + put ("Druckerkanal:") ; + get (printer channel) ; + server channel (printer channel); + + command dialogue (FALSE) ; + spool manager (PROC printer) ; + + +LET ack = 0 , + fetch code = 11 , + file type = 1003 ; + +INT VAR reply , old heap size ; + +DATASPACE VAR ds ; + +FILE VAR file ; + +PROC printer : + + disable stop ; + continue (server channel) ; + IF is error + THEN clear error ; + end + FI ; + + old heap size := heap size ; + REP + forget (ds) ; + execute print ; + IF is error AND online + THEN put error + FI ; + clear error ; + IF heap size > old heap size + 4 + THEN collect heap garbage ; + old heap size := heap size + FI + PER + +ENDPROC printer ; + +PROC execute print : + + enable stop ; + REP + ds := nilspace ; + call (father, fetch code, ds, reply) ; + IF reply = ack CAND type (ds) = file type + THEN print file + FI ; + forget (ds) + PER . + +print file : + file := sequential file (input, ds) ; + IF is elan source (file) + THEN elan list (file) + ELSE print (file) + FI . + +ENDPROC execute print ; + +ENDPACKET multi user printer ; diff --git a/system/std.zusatz/1.7.3/src/printer-S b/system/std.zusatz/1.7.3/src/printer-S new file mode 100644 index 0000000..5124cc4 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/printer-S @@ -0,0 +1,36 @@ +PACKET single user print cmd DEFINES print : + +INT VAR print channel ; +FILE VAR print file ; + +put ("Druckerkanal:") ; +get (print channel) ; + +PROC print : + + print (last param) + +ENDPROC print ; + +PROC print (TEXT CONST file name) : + + last param (file name) ; + print file := sequential file (input, file name) ; + continue (print channel) ; + disable stop ; + execute print ; + continue (0) + +ENDPROC print ; + +PROC execute print : + + enable stop ; + IF is elan source (print file) + THEN elan list (print file) + ELSE print (print file) + FI + +ENDPROC execute print ; + +ENDPACKET single user print cmd ; diff --git a/system/std.zusatz/1.7.3/src/purge b/system/std.zusatz/1.7.3/src/purge new file mode 100644 index 0000000..e325646 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/purge @@ -0,0 +1,85 @@ + +PACKET purge DEFINES purge : + + +TEXT VAR task name, record, file name, dummy ; + +FILE VAR permit ; + + +PROC purge : + + IF exists ("permitted tasks") + THEN access catalogue ; + permit := sequential file (input, "permitted tasks") ; + say (""10""13"TASKS :"10""10""13"") ; + IF myself < supervisor + THEN purge son tasks (brother (supervisor)) + ELSE purge son tasks (myself) + FI + FI ; + IF exists ("permitted files") + THEN permit := sequential file (input, "permitted files") ; + say (""10""13"DATEIEN :"10""10""13"") ; + purge files + FI + +ENDPROC purge ; + +PROC purge son tasks (TASK CONST father task) : + + TASK VAR actual task := son (father task) ; + WHILE NOT is niltask (actual task) REP + purge son tasks (actual task) ; + IF NOT actual task permitted + THEN erase actual task + FI ; + actual task := brother (actual task) + END REP . + +erase actual task : + say ("""") ; say (task name) ; say ("""") ; + IF yes (" loeschen") + THEN end (actual task) + FI . + +actual task permitted : + task name := name (actual task) ; + reset (permit) ; + WHILE NOT eof (permit) REP + getline (permit, record) ; + IF task name = record + THEN LEAVE actual task permitted WITH TRUE + FI + END REP ; + FALSE . + +ENDPROC purge son tasks ; + +PROC purge files : + + begin list ; + get list entry (file name, dummy) ; + WHILE file name <> "" REP + IF NOT file permitted + THEN forget (file name) + FI ; + get list entry (file name, dummy) + END REP . + +file permitted : + IF file name = "permitted tasks" OR file name = "permitted files" + THEN LEAVE file permitted WITH TRUE + FI ; + reset (permit) ; + WHILE NOT eof (permit) REP + getline (permit, record) ; + IF file name = record + THEN LEAVE file permitted WITH TRUE + FI + END REP ; + FALSE . + +ENDPROC purge files ; + +ENDPACKET purge ; diff --git a/system/std.zusatz/1.7.3/src/referencer b/system/std.zusatz/1.7.3/src/referencer new file mode 100644 index 0000000..5606e4c --- /dev/null +++ b/system/std.zusatz/1.7.3/src/referencer @@ -0,0 +1,1077 @@ +PACKET referencer errors DEFINES report referencer error: + +(* Programm zur Fehlerbehandlung des referencers. + Autor: Rainer Hahn + Stand: 04.05.83 +*) +TEXT VAR fehlerdummy, + message; + +PROC report referencer error (INT CONST error nr, + INT CONST line nr, + TEXT CONST addition): + + einfache fehlermeldung aufbauen; + diese auf terminal ausgeben; + fehlermeldung in fehlerdatei ausgeben. + +einfache fehlermeldung aufbauen: + message := "WARNUNG in Zeile "; + message CAT text (line nr); + message CAT " : "; + message CAT simple message. + +diese auf terminal ausgeben: + line; + out (message); + line. + +fehlermeldung in fehlerdatei ausgeben: + note (message); + note line; + fehlerdummy := " >>> "; + fehlerdummy CAT zusatz; + note (fehlerdummy); + note line. + +simple message: + SELECT error nr OF + CASE 1: "Text Denoter ueber mehr als eine Zeile" + CASE 2: "Nicht beendeter Text Denoter bei Programmende" + CASE 3: "Kommentar ueber mehr als eine Zeile" + CASE 4: "Nicht beendeter Kommentar bei Programmende" + CASE 5: "Ueberdeckung" + CASE 6, 9: "Refinement mehrmals eingesetzt" + CASE 7, 10: "Refinement wird nicht aufgerufen" + CASE 8: "Objekt wird nicht angesprochen" + OTHERWISE "" + ENDSELECT. + +zusatz: + SELECT error nr OF + CASE 1, 2, 3, 4: "Ueber " + addition + " Zeilen" + CASE 5: addition + CASE 6, 7, 8: addition + CASE 9, 10: addition + " in mindestens einer Prozedur" + OTHERWISE "interner Fehler: HRZ Bielefeld benachrichtigen!" + END SELECT. +END PROC report referencer error +END PACKET referencer errors; +(************************************************************************) + +PACKET name table handling + DEFINES NAMETABLE, + empty name table, + put name, + get name, + dump table: + +(* Programm zur Speicherung von Namen. + Autor: Rainer Hahn + Stand: 04.05.83 +*) +LET hash table length = 1024, + hash table length minus one = 1023, + start of name table = 255, + name table length = 2000; + +TYPE NAMETABLE = STRUCT (INT number of entries, + ROW hash table length INT hash table, + ROW name table length INT next, + ROW name table length TEXT name table); + +TEXT VAR dummy, f; + +PROC put name (NAMETABLE VAR n, TEXT CONST name, INT VAR pointer): + INT VAR errechneter index; + hash (name, errechneter index); + IF noch kein eintrag + THEN gaenzlich neuer eintrag + ELSE name in vorhandener kette + FI. + +noch kein eintrag: + n . hash table [errechneter index] = 0. + +gaenzlich neuer eintrag: + n . hash table [errechneter index] := n . number of entries; + neuer eintrag (n, name, pointer). + +name in vorhandener kette: + INT VAR dieser eintrag :: n. hash table [errechneter index]; + REP + IF name ist vorhanden + THEN pointer := dieser eintrag; + LEAVE put name + ELIF kette zu ende + THEN neuer eintrag an vorhandene kette anketten; + neuer eintrag (n, name, pointer); + LEAVE put name + ELSE naechster eintrag in der kette + FI + END REP. + +name ist vorhanden: + n . name table [dieser eintrag] = name. + +kette zu ende: + n . next [dieser eintrag] = 0. + +neuer eintrag an vorhandene kette anketten: + n . next [dieser eintrag] := n . number of entries. + +naechster eintrag in der kette: + dieser eintrag := n . next [dieser eintrag]. +END PROC put name; + +PROC neuer eintrag (NAMETABLE VAR n, TEXT CONST name, INT VAR pointer): + n . name table [n . number of entries] := name; + n . next [n . number of entries] := 0; + pointer := n . number of entries; + n . number of entries INCR 1; + IF n . number of entries > name table length + THEN errorstop ("volle Namenstabelle") + FI +END PROC neuer eintrag; + +PROC hash (TEXT CONST name, INT VAR index) : + INT VAR i; + index := code (name SUB 1); + FOR i FROM 2 UPTO length (name) REP + addmult cyclic + ENDREP. + +addmult cyclic : + index INCR index ; + IF index > hash table length minus one + THEN wrap around + FI; + index := (index + code (name SUB i)) MOD hash table length. + +wrap around : + index DECR hash table length minus one +ENDPROC hash ; + +PROC get name (NAMETABLE CONST n, INT CONST index, TEXT VAR t): + IF index < n . number of entries AND index >= start of name table + THEN t := n . name table [index] + ELSE errorstop ("Interner Fehler 1") + FI +END PROC get name; + +PROC empty name table (NAMETABLE VAR n): +INT VAR i; + n . number of entries := start of name table; + FOR i FROM 1 UPTO hash table length REP + n . hash table [i] := 0 + END REP +END PROC empty name table; + +PROC dump table (NAMETABLE CONST n): + line; + put ("Bitte Name der Datei, in die die Namenstabelle gehen soll:"); + getline (f); + line; + file assoziieren; + dump namens ketten; + zusammenfassung. + +file assoziieren: + FILE VAR file :: sequential file (output, f). + +dump namens ketten: + INT VAR i, + anz hash eintraege :: 0, + kette 3 eintraege :: 0; + FOR i FROM 1 UPTO hash table length REP + IF n . hash table [i] <> 0 + THEN anz hash eintraege INCR 1; + INT VAR naechster eintrag :: n . hash table [i]; + dump hash eintrag; + ketten eintraege + FI + END REP. + +dump hash eintrag: + dummy := text (i); + WHILE length (dummy) < 4 REP dummy CAT " " END REP; + dummy CAT ": ". + +ketten eintraege: + INT VAR anz eintraege pro kette :: 0; + WHILE naechster eintrag > 0 REP + anz eintraege pro kette INCR 1; + dummy CAT " "; + dummy CAT text (naechster eintrag); + dummy CAT " -> "; + dummy CAT n . name table [naechster eintrag]; + naechster eintrag := n . next [naechster eintrag]; + END REP; + IF anz eintraege pro kette > 2 + THEN kette 3 eintraege INCR 1 + FI; + putline (file, dummy). + +zusammenfassung: + statistik ueberschrift; + anzahl hash eintraege; + anzahl namens eintraege; + verkettungsfaktor; + anzahl laengerer ketten. + +statistik ueberschrift: + line (file, 2); + dummy := " ---------- "; + dummy CAT "S T A T I S T I K:"; + dummy CAT " ---------- "; + putline (file, dummy); + line (file, 2). + +anzahl hash eintraege: + dummy := "Anzahl Hash-Eintraege (max. "; + dummy CAT text (hash table length); + dummy CAT "): "; + dummy CAT text (anz hash eintraege); + putline (file, dummy). + +anzahl namens eintraege: + dummy := "Anzahl Namen (max. "; + dummy CAT text (name table length - start of name table + 1); + dummy CAT "): "; + dummy CAT text (n . number of entries - start of name table); + putline (file, dummy). + +verkettungsfaktor: + dummy := "Verkettungsfaktor (Anzahl Namen / Anzahl Ketten): "; + dummy CAT text (real (n . number of entries - start of name table) / + real (anz hash eintraege)); + putline (file, dummy). + +anzahl laengerer ketten: + dummy := "Anzahl Ketten > 2 Eintraege: "; + dummy CAT text (kette 3 eintraege); + putline (file, dummy). +END PROC dump table; +END PACKET name table handling; +(***************************************************************************) + +PACKET scanner DEFINES init scanning, + init name table with, + dump name table, + get name, + end scanning, + line number, + symbol: + +(* Programm zum scannen von ELAN-Programmen. + Autor: Rainer Hahn + Stand: 04.05.83 +*) +FILE VAR eingabe; + +DATASPACE VAR ds alt := nilspace, + ds neu := nilspace; + +BOUND NAMETABLE VAR tabelle; + +TEXT VAR zeile, + zeichen, + dummy; + +LET end of program = ""30"", + eop = 1, + identifier = 2, + keyword = 3, + delimiter = 4, + klammer auf = 40, + punkt = 46, + doppelpunkt = 58, + init symbol = 30, + assign symbol = 31; + +INT VAR zeilen nr, + zeichen pos; + +PROC init name table with (TEXT CONST worte): +INT VAR index; + forget (ds alt); + ds alt := nilspace; + tabelle := dsalt; + empty name table (CONCR (tabelle)); + INT VAR anf :: 1, + ende :: pos (worte, ",", 1); + WHILE ende > 0 REP + dummy := subtext (worte, anf, ende - 1); + put name (CONCR (tabelle), dummy, index); + anf := ende + 1; + ende := pos (worte, ",", ende + 1) + END REP; + dummy := subtext (worte, anf); + put name (CONCR (tabelle), dummy, index) +END PROC init name table with; + +PROC init scanning (TEXT CONST f): + IF exists (f) + THEN namenstabelle holen; + erste zeile lesen + ELSE errorstop ("Datei existiert nicht") + FI. + +namenstabelle holen: + forget (ds neu); + ds neu := ds alt; + tabelle := ds neu. + +erste zeile lesen: + eingabe := sequential file (input, f); + IF eof (eingabe) + THEN errorstop ("Datei ist leer") + ELSE zeile := ""; + zeilen nr := 0; + zeile lesen; + naechstes non blank zeichen + FI +END PROC init scanning; + +PROC dump name table: + dump table (CONCR (tabelle)) +END PROC dump name table; + +PROC end scanning (TEXT CONST f): + IF anything noted + THEN eingabe := sequential file (modify, f); + note edit (eingabe) + FI +END PROC end scanning; + +PROC get name (INT CONST index, TEXT VAR t): + get name (CONCR (tabelle), index, t) +END PROC get name; + +PROC zeile lesen: + getline (eingabe, zeile); + zeilen nr INCR 1; + cout (zeilen nr); + zeichen pos := 0 +END PROC zeile lesen; + +PROC naechstes non blank zeichen: + REP + zeichen pos := pos (zeile, ""33"", ""254"", zeichen pos + 1); + IF zeichen pos <> 0 + THEN zeichen := (zeile SUB zeichen pos); + LEAVE naechstes non blank zeichen + ELIF eof (eingabe) + THEN zeichen := end of program; + LEAVE naechstes non blank zeichen + ELSE zeile lesen + FI + END REP. +END PROC naechstes non blank zeichen; + +PROC naechstes zeichen: + IF zeichen pos > length (zeile) + THEN IF eof (eingabe) + THEN zeichen := end of program; + LEAVE naechstes zeichen + ELSE zeile lesen + FI + FI; + zeichenpos INCR 1; + zeichen := zeile SUB zeichenpos +END PROC naechstes zeichen; + +INT PROC line number: + IF zeichenpos = pos (zeile, ""33"", ""254"", 1) + THEN zeilen nr - 1 + ELSE zeilen nr + FI +END PROC line number; + +PROC symbol (INT VAR symb, type): + REP + suche naechstes checker symbol + END REP. + +suche naechstes checker symbol: + SELECT code (zeichen) OF + CASE 30: (* end of programn *) + symb := eop; + type := eop; + LEAVE symbol + CASE 97, 98, 99, 100, 101, 102, 103, 104, 105, 106, 107, 108, 109, 110, + 111, 112, 113, 114, 115, 116, 117, 118, 119, 120, 121, 122: + (* small letters *) + identifier aufsammeln; + put name (CONCR (tabelle), dummy, symb); + type := identifier; + LEAVE symbol + CASE 65, 66, 67, 68, 69, 70, 71, 72, 73, 74, 75, 76, 77, 78, 79, 80, 81, + 82, 83, 84, 85, 86, 87, 88, 89, 90: (* large letters *) + schluesselwort aufsammeln; + put name (CONCR (tabelle), dummy, symb); + type := keyword; + LEAVE symbol + CASE 34: (* " *) + skip text denoter + CASE 40: (* ( *) + IF (zeile SUB zeichen pos + 1) = "*" + THEN skip comment + ELSE symb := code (zeichen); + type := delimiter; + naechstes non blank zeichen; + LEAVE symbol; + FI + CASE 58: (* : *) + IF (zeile SUB zeichenpos + 1) = "=" + THEN symb := assign symbol; + zeichenpos INCR 1 + ELIF (zeile SUB zeichenpos + 1) = ":" + THEN symb := init symbol; + zeichenpos INCR 1 + ELSE symb := doppelpunkt + FI; + type := delimiter; + naechstes non blank zeichen; + LEAVE symbol + CASE 48, 49, 50, 51, 52, 53, 54, 55, 56, 57: (* 0 - 9 *) + int denoter skippen; + IF zeichen = "." + THEN naechstes non blank zeichen; + IF digit + THEN real denoter skippen + ELSE symb := punkt; + type := delimiter; + LEAVE symbol + FI + FI + CASE 41, 44, 46, 59, 61: (* ) , . ; = *) + symb := code (zeichen); + type := delimiter; + naechstes non blank zeichen; + LEAVE symbol + OTHERWISE naechstes non blank zeichen + END SELECT. +END PROC symbol; + +PROC real denoter skippen: + int denoter skippen; + IF zeichen = "e" + THEN naechstes non blank zeichen; + int denoter skippen + FI +END PROC real denoter skippen; + +PROC int denoter skippen: + naechstes non blank zeichen; + WHILE zeichen >= "0" AND zeichen <= "9" REP + naechstes non blank zeichen + ENDREP; + zeichenpos DECR 1; + naechstes non blank zeichen +END PROC int denoter skippen; + +PROC identifier aufsammeln: + dummy := zeichen; + REP + naechstes non blank zeichen; + IF small letter or digit + THEN dummy CAT zeichen + ELSE LEAVE identifier aufsammeln + FI + END REP +END PROC identifier aufsammeln; + +PROC schluesselwort aufsammeln: + dummy := ""; + sammle schluesselwort; + IF dummy = "END" + THEN noch einmal + FI. + +sammle schluesselwort: + WHILE large letter REP + dummy CAT zeichen; + naechstes zeichen + END REP; + IF zeichen = " " + THEN naechstes non blank zeichen + FI. + +noch einmal: + sammle schluesselwort +END PROC schluesselwort aufsammeln; + +PROC skip text denoter: + INT VAR anz zeilen :: 0; + zeichen pos := pos (zeile, """", zeichenpos + 1); + WHILE zeichen pos = 0 REP + naechste zeile einlesen; + zeichen pos := pos (zeile, """"); + END REP; + ende text denoter. + +ende text denoter: + IF anz zeilen > 1 + THEN report referencer error (1, zeilen nr, text (anz zeilen)) + FI; + naechstes non blank zeichen. + +naechste zeile einlesen: + IF eof (eingabe) + THEN report referencer error (2, zeilen nr, text (anz zeilen)); + zeichen := end of program; + LEAVE skip text denoter + ELSE zeile lesen; + anz zeilen INCR 1 + FI. +END PROC skip text denoter; + +PROC skip comment: + INT VAR anz zeilen :: 0; + zeichen pos := pos (zeile, "*)", zeichenpos + 2); + WHILE zeichen pos = 0 REP + naechste zeile einlesen; + zeichen pos := pos (zeile, "*)"); + END REP; + ende comment. + +ende comment: + IF anz zeilen > 1 + THEN report referencer error (3, zeilen nr, text (anz zeilen)) + FI; + zeichen pos INCR 2; + naechstes non blank zeichen. + +naechste zeile einlesen: + IF eof (eingabe) + THEN report referencer error (4, zeilen nr, text (anz zeilen)); + zeichen := end of program; + LEAVE skip comment + ELSE zeile lesen; + anz zeilen INCR 1 + FI. +END PROC skip comment; + +BOOL PROC small letter or digit: + (zeichen >= "0" AND zeichen <= "9") OR (zeichen >= "a" AND zeichen <= "z") +END PROC small letter or digit; + +BOOL PROC small letter: + zeichen >= "a" AND zeichen <= "z" +END PROC small letter; + +BOOL PROC large letter: + zeichen >= "A" AND zeichen <= "Z" +END PROC large letter; + +BOOL PROC digit: + zeichen >= "0" AND zeichen <= "9" +END PROC digit; +END PACKET scanner; +(*************************************************************************) +PACKET referencer2 DEFINES referencer: + +(* Programm fuer den 'referencer' + Autor: Rainer Hahn + Stand: 19.03.84 +*) +INT VAR symb, + typ, + max index; + +TEXT VAR dummy, + dummy2, + name; + +DATASPACE VAR ds; + +BOUND ROW max TEXT VAR liste; + +FILE VAR f; + +BOOL VAR initialisiert :: FALSE, + symbol bereits geholt, + globale deklarationen; + +LET max = 1751, + global text = "<--G", + local text = "<--L", + refinement text = "<--R", + procedure text = "<--P", + eop = 1, + identifier = 2, + keyword = 3, + init symbol = 30, + assign symbol = 31, + klammer auf = 40, + klammer zu = 41, + komma = 44, + punkt = 46, + doppelpunkt = 58, + semikolon = 59, + proc symbol = 255, + end proc symbol = 256, + packet symbol = 257, + end packet symbol = 258, + type symbol = 259, + var symbol = 260, + const symbol = 261, + let symbol = 262, + leave symbol = 263, + op symbol = 264, + endop symbol = 265, + endif symbol = 266, + fi symbol = 266; + +PROC referencer: + referencer (last param) +END PROC referencer; + +PROC referencer (TEXT CONST check file): + referencer (check file, check file + ".r") +END PROC referencer; + +PROC referencer (TEXT CONST check file, dump file): + IF exists (check file) + THEN dump file ueberpruefen + ELSE errorstop ("Eingabe-Datei nicht vorhanden") + FI. + +dump file ueberpruefen: + IF exists (dump file) + THEN errorstop ("Ausgabe-Datei existiert bereits") + ELSE disable stop; + start referencing (check file, dump file); + forget (ds); + enable stop; + FI +END PROC referencer; + +PROC start referencing (TEXT CONST check file, dump file): + enable stop; + ueberschrift; + initialisierung; + verkuerzte syntax analyse; + line; + in dump file kopieren (dump file); + line; + end scanning (check file). + +ueberschrift: + page; + put ("REFERENCER:"); + put (check file); + put ("->"); + put (dump file); + line. + +initialisierung: + IF NOT initialisiert + THEN init name table with +("PROC,ENDPROC,PACKET,ENDPACKET,TYPE,VAR,CONST,LET,LEAVE,OP,ENDOP,ENDIF,FI"); + initialisiert := TRUE + FI; + ds := nilspace; + liste := ds; + maxindex := endop symbol; + dummy := checkfile. + +verkuerzte syntax analyse: + globale deklarationen := TRUE; + line; + init scanning (dummy); + symbol bereits geholt := FALSE; + REP + IF symbol bereits geholt + THEN symbol bereits geholt := FALSE + ELSE symbol (symb, typ) + FI; + IF typ = keyword + THEN nach schluesselwort verarbeiten + ELIF symb = punkt + THEN ggf refinement aufnehmen + ELIF typ = identifier + THEN identifier aufnehmen und ggf aktuelle parameter liste + FI + UNTIL typ = eop ENDREP. + +identifier aufnehmen und ggf aktuelle parameter liste: + in die liste (symb, ""); + symbol (symb, typ); + IF symb = klammer auf + THEN aktuelle parameter aufnehmen + ELSE symbol bereits geholt := TRUE + FI. + +nach schluesselwort verarbeiten: + SELECT symb OF + CASE let symbol: + let deklarationen aufsammeln + CASE packet symbol: + namen des interface aufsammeln + CASE end packet symbol: + skip naechstes symbol + CASE var symbol, const symbol: + datenobjekt deklaration aufnehmen + CASE proc symbol: + globale deklarationen := FALSE; + prozedur name und ggf parameter aufsammeln + CASE end proc symbol: + globale deklarationen := TRUE; + skip naechstes symbol + CASE op symbol: + globale deklarationen := FALSE; + operatornamen skippen und ggf parameter aufsammeln + CASE end op symbol: + globale deklarationen := TRUE; + skip until (semikolon) + CASE type symbol: + namen der typ definition aufsammeln + CASE leave symbol: + skip naechstes symbol + OTHERWISE: + ENDSELECT. + +skip naechstes symbol: + symbol (symb, typ). +END PROC start referencing; + +PROC aktuelle parameter aufnehmen: + REP + symbol (symb, typ); + IF typ = identifier + THEN in die liste (symb, "") + FI + UNTIL symb = klammer zu END REP. +END PROC aktuelle parameter aufnehmen; + +PROC ggf refinement aufnehmen: + symbol (symb, typ); + symbol bereits geholt := TRUE; + WHILE typ = identifier REP + doppelpunkt oder selektor + END REP. + +doppelpunkt oder selektor: + INT CONST letzter id :: symb; + symbol (symb, typ); + IF symb = doppelpunkt + THEN in die liste (letzter id, refinement text); + LEAVE ggf refinement aufnehmen + ELSE in die liste (letzter id, ""); + IF symb = punkt + THEN symbol (symb, typ) + ELSE LEAVE ggf refinement aufnehmen + FI + FI +END PROC ggf refinement aufnehmen; + +PROC namen des interface aufsammeln: + packet name ueberspringen; + namen der schnittstelle aufsammeln. + +packet name ueberspringen: + symbol (symb, typ). + +namen der schnittstelle aufsammeln: + REP + symbol (symb, typ); + IF typ = identifier + THEN in die liste (symb, "") + FI + UNTIL symb = doppelpunkt END REP. +END PROC namen des interface aufsammeln; + +PROC let deklarationen aufsammeln: + REP + symbol (symb, typ); + IF typ = identifier + THEN let name aufnehmen + ELIF typ = keyword + THEN bis zum komma oder semikolon + FI; + UNTIL symb = semikolon END REP. + +let name aufnehmen: + IF globale deklarationen + THEN in die liste (symb, global text) + ELSE in die liste (symb, "") + FI; + REP + symbol (symb, typ); + IF typ = identifier + THEN in die liste (symb, "") + FI + UNTIL symb = komma OR symb = semikolon END REP. +END PROC let deklarationen aufsammeln; + +PROC namen der typ definition aufsammeln: + REP + symbol (symb, typ); + bis zum komma oder semikolon + UNTIL symb = semikolon END REP +END PROC namen der typ definition aufsammeln; + +PROC bis zum komma oder semikolon: + INT VAR anz klammern :: 0; + REP + symbol (symb, typ); + (* fields aufnehmen weggelassen *) + IF symb = klammer auf + THEN anz klammern INCR 1 + ELIF symb = klammer zu + THEN anz klammern DECR 1 + FI + UNTIL (symb = komma AND anz klammern = 0) OR symb = semikolon ENDREP. +END PROC bis zum komma oder semikolon; + +PROC datenobjekt deklaration aufnehmen: + symbol (symb, typ); + REP + IF globale deklarationen + THEN in die liste (symb, global text) + ELSE in die liste (symb, local text) + FI; + skip ggf initialisierung; + IF symb = komma + THEN symbol (symb, typ) + FI + UNTIL symb = semikolon END REP. + +skip ggf initialisierung: + symbol (symb, typ); + IF symb = init symbol OR symb = assign symbol + THEN initialisierung skippen + FI. + +initialisierung skippen: + INT VAR anz klammern :: 0; + REP + INT CONST vorheriges symbol :: symb, + vorheriger typ :: typ; + symbol (symb, typ); + IF symb = klammer auf + THEN anz klammern INCR 1; + IF vorheriger typ = identifier + THEN in die liste (vorheriges symbol, "") + FI + ELIF symb = klammer zu + THEN anz klammern DECR 1; + IF vorheriger typ = identifier + THEN in die liste (vorheriges symbol, "") + FI + ELIF vorheriger typ = identifier AND symb = doppelpunkt + THEN in die liste (vorheriges symbol, refinement text); + LEAVE datenobjekt deklaration aufnehmen + ELIF vorheriger typ = identifier + THEN in die liste (vorheriges symbol, "") + FI + UNTIL (symb = komma AND anz klammern = 0) + OR symb = semikolon OR symb = end proc symbol OR + symb = end op symbol OR symb = endif symbol OR symb = fi symbol + END REP. +END PROC datenobjekt deklaration aufnehmen; + +PROC prozedur name und ggf parameter aufsammeln: + prozedurname aufsammeln; + symbol (symb, typ); + IF symb <> doppelpunkt + THEN formale parameter aufsammeln + FI. + +prozedurname aufsammeln: + symbol (symb, typ); + in die liste (symb, procedure text). +END PROC prozedurname und ggf parameter aufsammeln; + +PROC operatornamen skippen und ggf parameter aufsammeln: + symbol (symb, typ); + IF symb <> doppelpunkt + THEN formale parameter aufsammeln + FI +END PROC operatornamen skippen und ggf parameter aufsammeln; + +PROC formale parameter aufsammeln: + REP + symbol (symb, typ); + IF typ = identifier + THEN in die liste (symb, local text); + FI + UNTIL symb = doppelpunkt END REP +END PROC formale parameter aufsammeln; + +PROC skip until (INT CONST zeichencode): + skip until (zeichencode, 0) +END PROC skip until; + +PROC skip until (INT CONST z1, z2): + REP + symbol (symb, typ) + UNTIL symb = z1 OR symb = z2 END REP +END PROC skip until; + +PROC in die liste (INT CONST index, TEXT CONST zusatz): + IF index > max index + THEN listenelemente initialisieren; + FI; + IF aktueller eintrag = "" + THEN namens eintrag + FI; + aktueller eintrag CAT " "; + aktueller eintrag CAT text (line number); + aktueller eintrag CAT zusatz. + +aktueller eintrag: + liste [index]. + +listenelemente initialisieren: + INT VAR i; + FOR i FROM max index + 1 UPTO index REP + liste [i] := "" + END REP; + max index := index. + +namens eintrag: + get name (index, aktueller eintrag); + WHILE length (aktueller eintrag) < 15 REP + aktueller eintrag CAT " " + END REP; + aktueller eintrag CAT ":". +END PROC in die liste; + +TEXT VAR zeile; + +PROC in dump file kopieren (TEXT CONST dump file): + put ("Ausgabedatei erstellen"); + line; + f := sequential file (output, dump file); + INT VAR i; + kopieren und ggf fehlermeldung; + modify (f); + ggf sortieren; + zeile ggf aufspalten. + +kopieren und ggf fehlermeldung: + FOR i FROM fi symbol UPTO max index REP + cout (i); + zeile := liste [i]; + IF zeile <> "" + THEN ausgabe der referenz und ggf fehlermeldung + FI + ENDREP. + +ausgabe der referenz und ggf fehlermeldung: + putline (f, zeile); + ggf referencer fehlermeldung. + +ggf sortieren: + IF yes (dump file + " sortieren") + THEN sort (dump file); + FI. + +zeile ggf aufspalten: + i := 0; + to line (f, 1); + WHILE NOT eof (f) REP + i INCR 1; + cout (i); + read record (f, zeile); + ggf aufspalten + END REP. + +ggf aufspalten: +INT VAR anf :: 1, ende :: pos (zeile, " ", 72); + IF ende > 0 + THEN dummy := subtext (zeile, 1, ende - 1); + write record (f, dummy); + spalte bis restzeile auf; + dummy CAT subtext (zeile, anf); + write record (f, dummy); + FI; + down (f). + +spalte bis restzeile auf: + REP + dummy := " "; + anf := ende + 1; + ende := pos (zeile, " ", ende + 55); + down (f); + insert record (f); + IF ende <= 0 + THEN LEAVE spalte bis restzeile auf + FI; + dummy CAT subtext (zeile, anf, ende - 1); + write record (f, dummy); + END REP. +END PROC in dump file kopieren; + +PROC ggf referencer fehlermeldung: + name := subtext (zeile, 1, min( pos(zeile, " "), pos(zeile, ":")) - 1); + dummy := subtext (zeile, pos (zeile, ": ") + 2); + ueberdeckungs ueberpruefung; + not used ueberpruefung; + IF pos (dummy, "R") > 0 + THEN refinement mehr als zweimal verwendet + FI. + +ueberdeckungs ueberpruefung: + IF pos (dummy, global text) > 0 AND pos (dummy, local text) > 0 + THEN dummy2 := "und Zeile "; + dummy2 CAT text (nr (pos (dummy, local text))); + dummy2 CAT ": "; + dummy2 CAT name; + report referencer error + (5, nr (pos (dummy, global text)), dummy2) + FI. + +not used ueberpruefung: + IF pos (dummy, " ") = 0 AND + (pos (dummy, global text) > 0 OR pos (dummy, local text) > 0 OR + pos (dummy, refinement text) > 0) + THEN not used fehlermeldung + FI. + +not used fehlermeldung: + report referencer error + (8, nr (length (dummy) - length (local text) + 1), name). + +refinement mehr als zweimal verwendet: + INT VAR refinement deklarationen :: 0, + refinement aufrufe :: 0, + anf :: 1; + WHILE pos (dummy,"R", anf) > 0 REP + refinement deklarationen INCR 1; + anf := pos (dummy, "R", anf) + 1 + END REP; + anf := 1; + WHILE pos (dummy, " ", anf) > 0 REP + refinement aufrufe INCR 1; + anf := pos (dummy, " ", anf) + 1 + END REP; + IF refinement deklarationen = 1 + THEN IF refinement aufrufe > 1 + THEN report referencer error + (6, nr (pos (dummy, refinement text)), name) + ELIF refinement aufrufe = 0 + THEN report referencer error + (7, nr (pos (dummy, refinement text)), name) + FI + ELIF refinement deklarationen > 1 + THEN IF 2 * refinement deklarationen - 1 > refinement aufrufe + THEN report referencer error (9, 0, name) + ELIF 2 * refinement deklarationen - 1 < refinement aufrufe + THEN report referencer error (10, 0, name) + FI + FI. +END PROC ggf referencer fehlermeldung; + +INT PROC nr (INT CONST ende): + INT VAR von :: ende - 1; + WHILE von > 0 AND ((dummy SUB von) >= "0" AND (dummy SUB von) <= "9") REP + von DECR 1 + END REP; + int (subtext (dummy, von + 1, ende - 1)) +END PROC nr; + +END PACKET referencer2; diff --git a/system/std.zusatz/1.7.3/src/reporter b/system/std.zusatz/1.7.3/src/reporter new file mode 100644 index 0000000..13e76b5 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/reporter @@ -0,0 +1,479 @@ +PACKET reporter routines DEFINES generate counts, + count on, + count off, + generate reports, + eliminate reports, + assert, + report on, + report off, + report: + +(* Programm zur Ablaufverfolgung von ELAN Programmen. Das Programm + verfolgt Prozedur- und Refinementaufrufe ('trace') und erstellt + eine Haeufigkeitszaehlung ('frequency count') und beachtet 'assertions'. + + Autor: Rainer Hahn + Letzte Aenderung: 11.01.84 + Ausgabe der Gesamtaufrufe (Jan. 84) +*) + +FILE VAR input file; + +INT VAR zeilen nr, + type; + +TEXT VAR zeile, + dummy, + dummy1, + symbol; + +LET quadro fis = "####", + triple fis = "###", + double fis = "##", + + tag = 1 ; + +DATASPACE VAR ds := nilspace; +BOUND ROW max STRUCT (INT anzahl, BOOL proc) VAR zaehlwerk; + +LET max = 2000; + +(******************* gen report-Routinen ******************************) + +PROC generate reports: + generate reports (last param) +END PROC generate reports; + +PROC generate reports (TEXT CONST name): + disable stop; + gen trace statements (name); + IF is error AND error message = "ende" + THEN clear error + FI; + last param (name); + enable stop. +END PROC generate reports; + +PROC gen trace statements (TEXT CONST name): + enable stop; + IF exists (name) + THEN input file := sequential file (modify, name) + ELSE errorstop ("input file does not exist") + FI; + input file modifizieren +END PROC gen trace statements; + +(*************************** Test file modifizieren *****************) + +PROC input file modifizieren: + zeilen nr := 1; + to first record (input file); + WHILE NOT eof (input file) REP + lese zeile; + IF triple fis symbol + THEN wandele in quadro fis + FI; + IF proc oder op symbol + THEN verarbeite operator oder prozedurkopf + ELIF refinement symbol + THEN verarbeite ggf refinements + FI; + down (input file) + END REP. + +triple fis symbol: + pos (zeile, triple fis) > 0 AND + (pos (zeile, triple fis) <> pos (zeile, quadro fis)). + +wandele in quadro fis: + change all (zeile, triple fis, quadro fis); + write record (input file, zeile). + +proc oder op symbol: + pos (zeile, "PROC") > 0 OR pos (zeile, "OP") > 0. + +verarbeite operator oder prozedurkopf: + IF NOT (pos (zeile, "END") > 0) + THEN scanne kopf; + insertiere trace anweisung + FI. + +scanne kopf: + scan (zeile); + REP + next symbol (symbol, type); + IF ende der zeile gescannt + THEN vorwaerts; + lese zeile; + continue scan (zeile); + next symbol (symbol, type) + FI + UNTIL symbol = "PROC" OR symbol = "OP" END REP; + baue trace statement fuer kopf auf. + +baue trace statement fuer kopf auf: + dummy := double fis; + dummy CAT "report("""; + dummy CAT symbol; + dummy CAT " "; + IF ende der zeile gescannt + THEN vorwaerts; + lese zeile; + continue scan (zeile) + FI; + next symbol (symbol, type); + dummy CAT symbol; + dummy CAT " "; + next symbol (symbol, type); + IF type = tag + THEN dummy CAT symbol + FI. + +ende der zeile gescannt: + type >= 7. + +insertiere trace anweisung: + WHILE pos (zeile, ":") = 0 REP + vorwaerts; + lese zeile + END REP; + schreibe zeile mit report statement. + +refinement symbol: + INT CONST point pos := pos (zeile, ".") ; + point pos > 0 AND point pos >= length (zeile) - 1. + +verarbeite ggf refinements: + ueberlies leere zeilen ; + IF ist wirklich refinement + THEN insertiere report fuer refinement + FI . + +ueberlies leere zeilen : + REP + vorwaerts; + lese zeile + UNTIL pos (zeile, ""33"", ""254"", 1) > 0 PER . + +ist wirklich refinement : + scan (zeile) ; + next symbol (symbol, type) ; + next symbol (symbol) ; + symbol = ":" AND type = tag . + +insertiere report fuer refinement: + dummy := double fis; + dummy CAT "report("""; + dummy1 := subtext (zeile, 1, pos (zeile, ":") - 1); + dummy CAT dummy1; + schreibe zeile mit report statement +END PROC input file modifizieren; + +PROC schreibe zeile mit report statement: + dummy CAT """);"; + dummy CAT double fis; + IF doppelpunkt steht am ende der zeile + THEN (********** bei neuer Compiler-Version aendern: + fuelle zeile ggf auf 75 spalten auf; + zeile CAT dummy + die naechste drei zeilen dann loeschen **************) + down (input file); + insert record (input file); + write record (input file, dummy) + ELSE insert char (dummy, ":", 1); + change (zeile, ":", dummy); + write record (input file, zeile) + FI. + +doppelpunkt steht am ende der zeile: + pos (zeile, ":") >= length (zeile) - 1. + +(* Kommentarklammern beineuer Compiler Version hier weg: +fuelle zeile ggf auf 75 spalten auf: + IF length (zeile) < 75 + THEN dummy1 := (75 - length (zeile)) * " "; + zeile CAT dummy1 + FI.*) +END PROC schreibe zeile mit report statement; + +PROC vorwaerts: + down (input file); + IF eof (input file) + THEN errorstop ("ende") + FI +END PROC vorwaerts; + +PROC lese zeile: + read record (input file, zeile); + cout (zeilen nr); + zeilen nr INCR 1 +END PROC lese zeile; + +(************************ eliminate reports-Routinen ******************) + +PROC eliminate reports: + eliminate reports (last param) +END PROC eliminate reports; + +PROC eliminate reports (TEXT CONST name): + disable stop; + eliminate statements (name); + IF is error AND error message = "ende" + THEN clear error + FI; + last param (name); + enable stop. +END PROC eliminate reports; + +PROC eliminate statements (TEXT CONST name): + enable stop; + IF exists (name) + THEN input file := sequential file (modify, name) + ELSE errorstop ("input file does not exist") + FI; + statements entfernen. + +statements entfernen: + to first record (input file); + zeilen nr := 1; + WHILE NOT eof (input file) REP + lese zeile; + IF pos (zeile, double fis) > 0 + THEN eliminiere zeichenketten in dieser zeile + ELSE down (input file) + FI + END REP. + +eliminiere zeichenketten in dieser zeile: + INT VAR anfang := pos (zeile, double fis); + WHILE es ist noch etwas zu eliminieren REP + IF es ist ein quadro fis + THEN wandele es in ein triple fis + ELIF es ist ein triple fis + THEN lass diese sequenz stehen + ELSE entferne zeichenkette + FI + END REP; + IF zeile ist jetzt leer + THEN delete record (input file) + ELSE write record (input file, zeile); + down (input file) + FI. + +es ist noch etwas zu eliminieren: + anfang > 0. + +es ist ein quadro fis: + pos (zeile, quadro fis, anfang) = anfang. + +wandele es in ein triple fis: + delete char (zeile, anfang); + anfang := pos (zeile, double fis, anfang + 3). + +es ist ein triple fis: + pos (zeile, triple fis, anfang) = anfang. + +lass diese sequenz stehen: + anfang := pos (zeile, triple fis, anfang + 1) + 3. + +entferne zeichenkette: + INT VAR end := pos (zeile, double fis, anfang+2) ; + IF end > 0 + THEN change (zeile, anfang, end + 1, ""); + anfang := pos (zeile, double fis, anfang) + ELSE anfang := pos (zeile, double fis, anfang+2) + FI . + +zeile ist jetzt leer: + pos (zeile, ""33"", ""254"", 1) = 0. +END PROC eliminate statements; + +(********************** Trace-Routinen *******************************) + +FILE VAR trace file; + +BOOL VAR trace on, haeufigkeit on; + +PROC report (TEXT CONST message): + IF NOT exists ("TRACE") + THEN trace file := sequential file (output, "TRACE"); + trace on := TRUE; + haeufigkeit on := FALSE; + FI; + BOOL CONST ist prozedur :: + (pos (message, "PROC") > 0 OR pos (message, "OP") > 0); + IF trace on + THEN ablauf verfolgung + FI; + IF haeufigkeit on + THEN haeufigkeits zaehlung (ist prozedur) + FI. + +ablauf verfolgung: + dummy := text (pcb (1)); + dummy CAT ": "; + IF NOT ist prozedur + THEN dummy CAT " " + FI; + dummy CAT message; + putline (trace file, dummy). +END PROC report; + +PROC report (TEXT CONST message, INT CONST value): + report (message, text (value)) +END PROC report; + +PROC report (TEXT CONST message, REAL CONST value): + report (message, text (value)) +END PROC report; + +PROC report (TEXT CONST message, TEXT CONST value): + dummy1 := message; + dummy1 CAT ": "; + dummy1 CAT value; + report (dummy1) +END PROC report; + +PROC report (TEXT CONST message, BOOL CONST value): + dummy1 := message; + dummy1 CAT ": "; + IF value + THEN dummy1 CAT "TRUE" + ELSE dummy1 CAT "FALSE" + FI; + report (dummy1) +END PROC report; + +PROC report on: + trace on := TRUE; + dummy1 := "REPORT ---> ON"; + report (dummy1) +END PROC report on; + +PROC report off: + dummy1 := "REPORT ---> OFF"; + report (dummy1); + trace on := FALSE; +END PROC report off; + +PROC assert (BOOL CONST value): + assert ("", value) +END PROC assert; + +PROC assert (TEXT CONST message, BOOL CONST value): + dummy1 := "ASSERTION:"; + dummy1 CAT message; + dummy1 CAT " ---> "; + IF value + THEN dummy1 CAT "TRUE" + ELSE line; + put ("ASSERTION:"); + put (message); + put ("---> FALSE"); + line; + IF yes ("weiter") + THEN dummy1 CAT "FALSE" + ELSE errorstop ("assertion failed") + FI + FI; + report (dummy1) +END PROC assert; + +(************************** haeufigkeits-zaehlung ****************) + +PROC count on: + report ("COUNT ---> ON"); + haeufigkeit on := TRUE; + initialisiere haeufigkeit. + +initialisiere haeufigkeit: + INT VAR i; + forget (ds); + ds := nilspace; + zaehlwerk := ds; + FOR i FROM 1 UPTO max REP + zaehlwerk [i] . anzahl := 0 + END REP +END PROC count on; + +PROC count off: + report ("COUNT ---> OFF"); + haeufigkeit on := FALSE +END PROC count off; + +PROC haeufigkeits zaehlung (BOOL CONST ist prozedur): + IF pcb (1) <= max + THEN zaehlwerk [pcb (1)]. anzahl INCR 1; + zaehlwerk [pcb (1)] . proc := ist prozedur +FI +END PROC haeufigkeits zaehlung; + +PROC generate counts: + generate counts (last param) +END PROC generate counts; + +PROC generate counts (TEXT CONST name): + disable stop; + insert counts (name); + last param (name); + enable stop. +END PROC generate counts; + +PROC insert counts (TEXT CONST name): + enable stop; + IF exists (name) + THEN input file := sequential file (modify, name) + ELSE errorstop ("input file does not exist") + FI; + counts insertieren; + dataspace loeschen; + statistik ausgeben. + +counts insertieren: + REAL VAR gesamt aufrufe :: 0.0, + proc aufrufe :: 0.0, + andere aufrufe :: 0.0; + zeilen nr := 1; + WHILE zeilennr <= lines (input file) REP + cout (zeilen nr); + IF zaehlwerk [zeilen nr] . anzahl > 0 + THEN anzahl aufrufe in die eingabe zeile einfuegen; + aufrufe mitzaehlen + FI; + zeilen nr INCR 1 + END REP. + +anzahl aufrufe in die eingabe zeile einfuegen: + to line (input file, zeilen nr); + read record (input file, zeile); + dummy := double fis; + dummy1 := text (zaehlwerk [zeilen nr] . anzahl); + dummy CAT dummy1; + dummy CAT double fis; + change (zeile, 1, 0, dummy); + write record (input file, zeile). + +aufrufe mitzaehlen: + gesamt aufrufe INCR real (zaehlwerk [zeilen nr] . anzahl); + IF zaehlwerk [zeilen nr] . proc + THEN proc aufrufe INCR real (zaehlwerk [zeilen nr] . anzahl) + ELSE andere aufrufe INCR real (zaehlwerk [zeilen nr] . anzahl) + FI. + +dataspace loeschen: + forget (ds). + +statistik ausgeben: + line (2); + put ("Anzahl der Gesamtaufrufe:"); + put (gesamt aufrufe); + line; + put ("davon:"); + line; + put (proc aufrufe); put ("Prozeduren oder Operatoren"); + line; + put (andere aufrufe); put ("Refinements und andere"); + line. +END PROC insert counts; + +END PACKET reporter routines; diff --git a/system/std.zusatz/1.7.3/src/scheduler b/system/std.zusatz/1.7.3/src/scheduler new file mode 100644 index 0000000..7a76f10 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/scheduler @@ -0,0 +1,419 @@ + +PACKET std schedule strategy DEFINES (* Autor: J.Liedtke *) + (* Stand: 15.10.82 *) + strategic decision : + + +PROC strategic decision + (INT CONST foreground workers, background workers, + REAL CONST fore cpu load, back cpu load, paging load, + INT VAR lowest activation prio, max background tasks) : + + IF no background permitted + THEN lowest activation prio := 0 ; + max background tasks := 0 + ELSE lowest activation prio := 10 ; + select max background tasks + FI . + +no background permitted : + foreground workers > 0 AND fore cpu load > 0.03 . + +select max background tasks : + IF fore cpu load > 0.01 + THEN max background tasks := 1 + ELIF paging load < 0.07 + THEN max background tasks := 3 + ELIF paging load < 0.15 + THEN max background tasks := 2 + ELSE max background tasks := 1 + FI . + +ENDPROC strategic decision ; + +ENDPACKET std schedule strategy ; + + + (* Autor: J.Liedtke*) +PACKET eumelmeter DEFINES (* Stand: 11.10.83 *) + + init log , + log : + + +LET snapshot interval = 590.0 ; + +REAL VAR next snapshot time , + time , timex , + paging wait , paging wait x , + paging busy , paging busy x , + fore cpu , fore cpu x , + back cpu , back cpu x , + system cpu , system cpu x , + delta t ; +INT VAR storage max, used ; +TEXT VAR record ; + +PROC init log : + + time := clock (1) ; + paging wait := clock (2) ; + paging busy := clock (3) ; + fore cpu := clock (4) ; + back cpu := clock (5) ; + system cpu := clock (6) ; + next snapshot time := time + snapshot interval + +ENDPROC init log ; + +PROC log (INT CONST active terminals, active background) : + + new snapshot time if was clock reset ; + IF clock (1) >= next snapshot time + THEN save values ; + get new values ; + create stat record ; + put log (record) ; + define next snapshot time + FI . + +new snapshot time if was clock reset : + IF clock (1) < next snapshot time - snapshot interval + THEN next snapshot time := clock (1) + FI . + +save values : + time x := time ; + paging wait x := paging wait ; + paging busy x := paging busy ; + fore cpu x := fore cpu ; + back cpu x := back cpu ; + system cpu x := system cpu . + +get new values : + time := clock (1) ; + paging wait := clock (2) ; + paging busy := clock (3) ; + fore cpu := clock (4) ; + back cpu := clock (5) ; + system cpu := clock (6) ; + storage (storage max, used) . + +create stat record : + record := text (used, 5) ; + record CAT text (active terminals,3) ; + record CAT text (active background,3) ; + delta t := (time - time x) ; + percent (paging wait, paging wait x) ; + percent (paging busy, paging busy x) ; + percent (fore cpu, fore cpu x) ; + percent (back cpu, back cpu x) ; + percent (system cpu, system cpu x) ; + percent (last, 0.0) ; + percent (nutz, 0.0) . + +last : paging wait + paging busy + fore cpu + back cpu + system cpu + - paging waitx - paging busyx - fore cpux - back cpux - system cpux . + +nutz : time - paging wait - system cpu + - timex + paging waitx + system cpux . + +define next snapshot time : + next snapshot time := time + snapshot interval . + +ENDPROC log ; + +PROC percent (REAL CONST neu, alt ) : + + record CAT text ( (neu-alt) / delta t * 100.0, 6,1) + "%" + +ENDPROC percent ; + +ENDPACKET eumelmeter ; + + + +PACKET background que manager DEFINES (* Autor: J.Liedtke *) + (* Stand: 15.10.82 *) + into background que , + delete from background que , + get first from background que , + get next from background que : + +LET que size = 100 , + ENTRY = STRUCT (TASK task, INT class) ; + +INT VAR end of que := 0 , + actual entry pos ; + +ROW que size ENTRY VAR que ; + + +PROC into background que (TASK CONST task) : + + INT VAR class := prio (task) ; + IF end of que = que size + THEN delete all not existing tasks + FI ; + check whether already in que ; + IF already in que + THEN IF in same class + THEN LEAVE into background que + ELSE delete from background que (task) ; + into background que (task) + FI + ELSE insert new entry + FI . + +check whether already in que : + INT VAR entry pos := 1 ; + WHILE entry pos <= end of que REP + IF que (entry pos).task = task + THEN LEAVE check whether already in que + FI ; + entry pos INCR 1 + PER . + +already in que : entry pos <= end of que . + +in same class : que (entry pos).class = class . + +insert new entry : + end of que INCR 1 ; + que (end of que) := ENTRY:( task, class ) . + +delete all not existing tasks : + INT VAR j ; + FOR j FROM 1 UPTO end of que REP + TASK VAR examined := que (j).task ; + IF NOT exists (examined) + THEN delete from background que (examined) + FI + PER . + +ENDPROC into background que ; + +PROC delete from background que (TASK CONST task) : + + search for entry ; + IF entry found + THEN delete entry ; + update actual entry pos + FI . + +search for entry : + INT VAR entry pos := 1 ; + WHILE entry pos <= end of que REP + IF que (entry pos).task = task + THEN LEAVE search for entry + FI ; + entry pos INCR 1 + PER . + +entry found : entry pos <= end of que . + +delete entry : + INT VAR i ; + FOR i FROM entry pos UPTO end of que - 1 REP + que (i) := que (i+1) + PER ; + end of que DECR 1 . + +update actual entry pos : + IF actual entry or following one deleted + THEN actual entry pos DECR 1 + FI . + +actual entry or following one deleted : + entry pos >= actual entry pos . + +ENDPROC delete from background que ; + +PROC get first from background que (TASK VAR task, INT CONST lowest class) : + + actual entry pos := 0 ; + get next from background que (task, lowest class) + +ENDPROC get first from background que ; + +PROC get next from background que (TASK VAR task, INT CONST lowest class) : + + search next entry of permitted class ; + IF actual entry pos <= end of que + THEN task := que (actual entry pos).task + ELSE task := niltask + FI . + +search next entry of permitted class : + REP + actual entry pos INCR 1 + UNTIL actual entry pos > end of que + COR que (actual entry pos).class <= lowest class PER. + +ENDPROC get next from background que ; + +ENDPACKET background que manager ; + + + +PACKET scheduler DEFINES (* Autor: J.Liedtke *) + (* Stand: 09.12.82 *) + scheduler : + + +LET std background prio = 7 , + highest background prio = 5 , + long slice = 6000 , + short slice = 600 , + blocked busy = 4 ; + +INT VAR slice , + foreground workers , + background workers ; + +BOOL VAR is logging ; + +REAL VAR fore cpu load , back cpu load , paging load ; + + +access catalogue ; +TASK CONST ur task := brother (supervisor) ; + +TASK VAR actual task ; + + +PROC scheduler : + IF yes ("mit eumelmeter") + THEN is logging := TRUE + ELSE is logging := FALSE + FI ; + task password ("-") ; + break ; + set autonom ; + command dialogue (FALSE) ; + forget ("scheduler", quiet) ; + disable stop; + REP scheduler operation; + clear error + PER; + +END PROC scheduler; + +PROC scheduler operation: + enable stop; + IF is logging + THEN init log + FI; + slice := short slice ; + init system load moniting ; + REP + pause (slice) ; + monit system load ; + look at all active user tasks and block background workers ; + activate next background workers if possible ; + IF is logging + THEN log (foreground workers, background workers) + FI + PER . + +init system load moniting : + REAL VAR + time x := clock (1) , + fore cpu x := clock (4) , + back cpu x := clock (5) , + paging x := clock (2) + clock (3) . + +monit system load : + REAL VAR interval := clock (1) - time x ; + fore cpu load := (clock (4) - fore cpu x) / interval ; + back cpu load := (clock (5) - back cpu x) / interval ; + paging load := (clock (2) + clock (3) - paging x) / interval ; + time x := clock (1) ; + fore cpu x := clock (4) ; + back cpu x := clock (5) ; + paging x := clock (2) + clock (3) . + +ENDPROC scheduler operation; + +PROC look at all active user tasks and block background workers : + + foreground workers := 0 ; + background workers := 0 ; + actual task := myself ; + next active (actual task) ; + WHILE NOT (actual task = myself) REP + IF actual task < ur task + THEN look at this task + FI ; + next active (actual task) + END REP . + +look at this task : + IF channel (actual task) >= 0 + THEN foreground workers INCR 1 + ELSE background workers INCR 1 ; + block actual task if simple worker + FI . + +block actual task if simple worker : + IF son (actual task) = niltask + THEN pause (5) ; + block (actual task) ; + IF status (actual task) = blocked busy + THEN set background prio ; + into background que (actual task) + ELIF prio (actual task) < highest background prio + THEN unblock (actual task) + FI + FI . + +set background prio : + IF prio (actual task) < highest background prio + THEN prio (actual task, std background prio) + FI . + +ENDPROC look at all active user tasks and block background workers ; + +PROC activate next background workers if possible : + + INT VAR lowest activation prio , + max background workers , + active background workers := 0 ; + + strategic decision (foreground workers, background workers, + fore cpu load, back cpu load, paging load, + lowest activation prio, max background workers) ; + + IF background permitted + THEN try to activate background workers + FI ; + IF active background workers > 0 + THEN slice := short slice + ELSE slice := long slice + FI . + +background permitted : max background workers > 0 . + +try to activate background workers : + get first from background que (actual task, lowest activation prio) ; + IF NOT is niltask (actual task) + THEN delete from background que (actual task) + FI ; + + WHILE active background workers < max background workers REP + IF is niltask (actual task) + THEN LEAVE try to activate background workers + ELIF status (actual task) <> blocked busy + THEN delete from background que (actual task) + ELSE + unblock (actual task) ; + active background workers INCR 1 + FI ; + get next from background que (actual task, lowest activation prio) + PER . + +ENDPROC activate next background workers if possible ; + +ENDPACKET scheduler ; + +scheduler; diff --git a/system/std.zusatz/1.7.3/src/spool manager b/system/std.zusatz/1.7.3/src/spool manager new file mode 100644 index 0000000..8f9ab9f --- /dev/null +++ b/system/std.zusatz/1.7.3/src/spool manager @@ -0,0 +1,377 @@ +PACKET spool manager DEFINES (* Autor: J. Liedtke *) + spool manager, server channel: (* 21.05.84 *) + + +LET que size = 100 , + + ack = 0 , + nak = 1 , + error nak = 2 , + second phase ack = 5 , + + fetch code = 11 , + save code = 12 , + erase code = 14 , + list code = 15 , + all code = 17 , + continue code = 100, + + empty = 0 , + used = 1 ; + +TASK VAR order task , waiting server , from task , server ; +INT VAR order code , reply , first , last , list index ; + +DATASPACE VAR ds ; + +TEXT VAR from title ; + +BOUND STRUCT (TEXT name, write pass, read pass) VAR msg ; +BOUND TEXT VAR error msg ; +BOUND STRUCT (TEXT tname, tpass, TASK task) VAR sv msg ; + +FILE VAR list file ; +TEXT VAR entry name, entry task; + +INT VAR command index , params ; +TEXT VAR command line, param 1, param 2 ; + +LET spool command list = +"break:1.0start:2.01stop:4.0first:5.0killer:6.0 " ; + + +LET ENTRY = STRUCT (TEXT title, TASK origin, DATASPACE space, INT status) ; + +ROW que size ENTRY VAR que ; + + +INT VAR server chan := 0; + +PROC server channel (INT CONST ch): + server chan := ch + +END PROC server channel; + +INT PROC server channel: + server chan + +END PROC server channel; + +PROC spool manager (PROC server start) : + INT VAR old heap size := heap size; + begin (PROC server start, server) ; + set autonom ; + break ; + disable stop ; + first := 1 ; + last := 1 ; + from task := niltask ; + waiting server := niltask ; + spool ; + clear error ; + forget all dataspaces. + +forget all dataspaces : + INT VAR i ; + FOR i FROM 1 UPTO que size REP + forget (que (i).space) + PER . + +spool: + REP + wait (ds, order code, order task) ; + IF order code = fetch code THEN out of que + ELIF order code = save code THEN prepare into que + ELIF order code = second phase ack THEN into que + ELIF order code = erase code THEN delete que entry + ELIF order code = list code THEN list spool + ELIF order code = all code THEN y all + ELIF order code >= continue code + AND order task = supervisor THEN spool command (PROC server start) + FI; + clear error + PER; + collect heap garbage if necessary. + +collect heap garbage if necessary: + IF heap size > old heap size + 2 + THEN collect heap garbage; + old heap size := heap size + FI. + +ENDPROC spool manager ; + +PROC out of que : + + forget (ds) ; + IF NOT (order task < myself) + THEN error ("not parent") + ELIF que empty + THEN waiting server := order task + ELSE send (order task, ack, que (first).space) ; + inc first + FI . + +que empty : first = last . + +ENDPROC out of que ; + +PROC inc first : + + que (first).status := empty ; + REP + first := first MOD que size + 1 ; + UNTIL first = last OR que (first).status <> empty PER + +ENDPROC inc first ; + +PROC dec first : + + first DECR 1 ; + IF first = 0 + THEN first := que size + FI + +ENDPROC dec first ; + +PROC prepare into que : + + msg := ds ; + from task := order task ; + from title := CONCR (msg).name ; + send (order task, second phase ack, ds) . + +ENDPROC prepare into que ; + +PROC into que : + + IF order task = from task + THEN try entry into spool + ELSE send (order task, nak, ds) + FI . + +try entry into spool : + IF que full + THEN error ("spool overflow") + ELSE entry (que (last)) ; + last := next (last) ; + send (order task, ack, ds) ; + awake server if necessary + FI . + +awake server if necessary : + IF NOT is niltask (waiting server) + THEN send (waiting server, ack, que (first).space , reply) ; + IF reply = ack + THEN waiting server := niltask ; + inc first + FI + FI . + +que full : first = next (last) . + +ENDPROC into que ; + +PROC entry (ENTRY VAR que entry) : + + que entry.title := from title ; + que entry.origin := from task ; + que entry.space := ds ; + que entry.status := used ; + +ENDPROC entry ; + +INT PROC next (INT CONST index) : + + index MOD que size + 1 + +ENDPROC next ; + + +PROC delete que entry : + + msg := ds ; + INT VAR index := first ; + WHILE index <> last REP + IF entry found + THEN erase entry (index) ; + send (order task, ack, ds) ; + LEAVE delete que entry + FI ; + index := next (index) + PER ; + error ("your file does not exist") . + +entry found : + entry.status = used CAND entry.origin = order task + CAND entry.title = CONCR (msg).name . + +entry : que (index) . + +ENDPROC delete que entry ; + +PROC erase entry (INT CONST index) : + + entry.status := empty ; + forget (entry.space) ; + IF index = first + THEN inc first + FI . + +entry : que (index) . + +ENDPROC erase entry ; + +PROC list spool : + + forget (ds) ; + ds := nilspace ; + list file := sequential file (output, ds) ; + to first que entry ; + get next que entry (entry name, entry task) ; + WHILE entry name <> "" REP + putline (list file, text (entry task, 15) + " : " + entry name); + get next que entry (entry name, entry task) + PER; + send (order task, ack, ds) . + +ENDPROC list spool ; + +BOUND THESAURUS VAR all thesaurus; + +PROC y all: + forget (ds); + ds := nilspace; + all thesaurus := ds; + all thesaurus := empty thesaurus; + to first que entry; + get next que entry (entry name, entry task); (* hier erster Eintrag *) + WHILE entryname <> "" REP + IF entry task = name (order task) + AND NOT (all thesaurus CONTAINS entry name) + THEN insert (all thesaurus, entry name) + FI; + get next que entry (entry name, entry task) + PER; + send (order task, ack, ds) + +END PROC y all; + +PROC to first que entry : + + list index := first - 1 + +ENDPROC to first que entry ; + +PROC get next que entry (TEXT VAR entry name, origin task name): + + WHILE list index <> last REP + list index := next (list index) + UNTIL que (list index).status <> empty PER ; + IF que (list index).status = used + THEN origin task name := name (que (list index).origin) ; + entry name := que (list index).title + ELSE entry name := ""; + origin task name := "" + FI . + +ENDPROC get next que entry ; + +PROC error (TEXT CONST error text) : + + forget (ds) ; + ds := nilspace ; + error msg := ds ; + CONCR (error msg) := error text ; + send (order task, error nak, ds) + +ENDPROC error ; + +PROC spool command (PROC server start) : + + enable stop ; + continue (order code - continue code) ; + command dialogue (TRUE) ; + disable stop ; + REP + get command ("gib spoolkommando :", command line); + analyze command (spool command list, command line, 3, + command index, params, param1, param2); + execute command + PER . + +execute command : + SELECT command index OF + CASE 1 : break cmd + CASE 2 : start cmd + CASE 3 : start channel cmd + CASE 4 : stop cmd + CASE 5 : first cmd + CASE 6 : killer cmd + OTHERWISE do (command line) END SELECT . + +start channel cmd: + server channel (int (param1)); + start cmd; + break cmd. + +break cmd: + break; set autonom ; LEAVE spool command. + +start cmd : + IF is niltask (server) + THEN begin (PROC server start, server) + FI . + +stop cmd : + IF NOT is niltask (server) + THEN command dialogue (FALSE) ; + end (server) ; + server := niltask + FI . + +first cmd : + line ; + to first que entry ; + get next que entry (entry name, entry task); + IF entry name = "" + THEN LEAVE first cmd + FI ; + REP + get next que entry (entry name, entry task) ; + IF entry name = "" + THEN LEAVE first cmd + FI; + say (text (entry task, 15) + " : " + entry name) ; + IF yes (" als erstes") + THEN make to first entry ; + LEAVE first cmd + FI + PER . + +make to first entry : + IF first = next (last) + THEN errorstop ("spool overflow") + ELSE dec first ; + que (first) := que (list index) ; + erase entry (list index) + FI . + + +killer cmd : + line ; + to first que entry ; + REP + get next que entry (entry name, entry task) ; + IF entry name = "" + THEN LEAVE killer cmd + FI ; + say (text (entry task, 15) + " : " + entry name) ; + IF yes (" loeschen") + THEN erase entry (list index) + FI + PER . + +ENDPROC spool command ; + +ENDPACKET spool manager ; diff --git a/system/std.zusatz/1.7.3/src/std printer b/system/std.zusatz/1.7.3/src/std printer new file mode 100644 index 0000000..f00fa80 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/std printer @@ -0,0 +1,434 @@ +PACKET std printer DEFINES reset printer, (* F. Klapper *) + new page, (* 21.05.84 *) + start, + printer cmd, + on, + off, + material, + papersize, + limit, + change type, + print text, + x pos, + y pos, + line: + +LET begin mark cmd = ""15"", (* Kommandos fr 'output buffer' *) + end mark cmd = ""14"", + bsp cmd = ""8"" , + printercmd cmd = ""16"", + begin mark code = 15, + end mark code = 14, + bsp code = 8, + printercmd code = 16, + + cr = ""13"", (* Steuerzeichen fr die Ausgabe *) + lf = ""10"", + underline char = "_", + + inch = 2.54, (* Konstanten *) + max printer cmds per line = 10; + +INT CONST std length of paper :: 12 * y factor per inch, + std width of paper :: cm to x steps (13.2 * inch), + std limit :: cm to x steps (12.0 * inch), + std first line :: 5, + std first collumn :: cm to x steps (inch), + + no xpos :: - 10; (* beliebige negative ganze Zahl *) + +INT VAR first collumn, + first line, + xlimit, + actual line, + x pos steps, + width of paper, + length of paper, + x pos mode; + +BOOL VAR block mode, + underline on, (* gibt durch on / off gesetzten Zustand an *) + underline out; (* gibt Zustand an der bis jetzt durch output buffer + ausgegebenen Stelle an *) +TEXT VAR buffer, + x pos buffer, + left margin; + +ROW max printer cmds per line TEXT VAR cmd arry; +INT VAR cmd pointer; + + length of paper := std length of paper; + first line := std first line; + actual line := 0; + buffer := ""; + reset printer; + +INT PROC cm to x steps (REAL CONST cm): + int ((abs (cm) * real (x factor per inch) / inch) + 0.5) +END PROC cm to x steps; + +INT PROC cm to y steps (REAL CONST cm): + int ((abs (cm) * real (y factor per inch) / inch) + 0.5) +END PROC cm to y steps; + +PROC start (REAL CONST x, y): + first collumn := cm to x steps (x); + first line := cm to y steps (y); + left margin := first collumn * " " +END PROC start; + +PROC papersize (REAL CONST w, l): + width of paper := cm to x steps (w); + length of paper := cm to y steps (l); +END PROC papersize; + +PROC limit (REAL CONST x): + xlimit := cm to x steps (x); +END PROC limit; + +PROC on (TEXT CONST attribute): + IF (attribute SUB 1) = "u" + THEN underline on := TRUE; + buff CAT begin mark cmd + FI. + +buff: + IF xpos steps >= 0 + THEN x pos buffer + ELSE buffer + FI. +END PROC on; + +PROC off (TEXT CONST attribute): + IF (attribute SUB 1) = "u" + THEN underline on := FALSE; + buff CAT end mark cmd + FI. + +buff: + IF xpos steps >= 0 + THEN x pos buffer + ELSE buffer + FI. +END PROC off; + +PROC printer cmd (TEXT CONST cmd): + IF cmd pointer < max printer cmds per line + THEN cmd pointer INCR 1; + cmd arry (cmd pointer) := cmd; + buff CAT printercmd cmd + FI. + +buff: + IF xpos steps >= 0 + THEN x pos buffer + ELSE buffer + FI. +END PROC printer cmd; + +PROC material (TEXT CONST name of material): +END PROC material; + +PROC change type (TEXT CONST name of type): +ENDPROC change type; + +PROC reset printer : + new page; (* actual line := 0 *) + width of paper := std width of paper; + length of paper := std length of paper; + first line := std first line; + first collumn := std first collumn; + xlimit := std limit; + xpos mode := 0; + cmd pointer := 0; + x pos steps := no x pos; + buffer := ""; + xpos buffer := ""; + left margin := first collumn * " "; + block mode := FALSE; + underline on := FALSE; + underline out := FALSE; +ENDPROC reset printer; + +PROC print text (TEXT CONST content, INT CONST mode): + IF x pos steps >= 0 + THEN x pos buffer CAT content; + x pos mode := mode MOD 4; + block mode := FALSE + ELSE buffer CAT content ; + block mode := (mode MOD 4) = 3 + FI. +END PROC print text; + +PROC tab and print: + SELECT x pos mode OF + CASE 0: fill (buffer, " ", x pos steps); + CASE 1: fill (buffer, " ", x pos steps - outputlength (x pos buffer)); + CASE 2: fill (buffer, " ", + x pos steps - outputlength (xpos buffer) DIV 2); + CASE 3: fill (buffer, " ", x pos steps); + block (x pos buffer, xlimit - x pos steps); + OTHERWISE + END SELECT; + buffer CAT x pos buffer; + x pos buffer := ""; + x pos steps := no x pos. +END PROC tab and print; + +INT PROC outputlength (TEXT CONST buff): + length (buff) - chars (buff, printercmd cmd) - chars (buff, begin mark cmd) + - chars (buff, end mark cmd) - chars (buff, bsp cmd) * 2 +END PROC outputlength; + +PROC x pos (REAL CONST cm): + IF x pos steps >= 0 + THEN tab and print + FI; + IF underline on + THEN buffer CAT end mark cmd; + x pos buffer CAT begin mark cmd + FI; + x pos steps := cm to x steps (cm) +END PROC x pos; + +PROC y pos (REAL CONST cm): + IF actual line = 0 + THEN output linefeed (first line - actual line); + actual line := first line + FI; + output buffer; + INT VAR y lf steps := cm to y steps (cm); + output linefeed (y lf steps + first line - actual line); + actual line := first line + y lf steps. +END PROC y pos; + +PROC line (REAL CONST proposed lf) : + IF actual line = 0 + THEN output linefeed (first line - actual line); + actual line := first line + FI; + output buffer; + INT VAR done lf; + convert into min y steps (proposed lf, done lf); + output line feed (done lf); + actual line INCR done lf; +END PROC line; + +PROC convert into min y steps (REAL CONST in, INT VAR out): + IF in < 0.001 + THEN out := 0 + ELSE out := int (in); + IF out < 1 THEN out := 1 FI + FI; +ENDPROC convert into min y steps; + +PROC new page: + IF buffer <> "" + THEN line (1.0) + FI; + actual line := actual line MOD length of paper; + IF actual line > first line + THEN output pagefeed (length of paper - actual line); + actual line := 0 + FI; +END PROC new page; + +PROC output buffer: + IF x pos steps >= 0 + THEN tab and print + ELIF block mode + THEN block (buffer, xlimit) + FI ; + TEXT VAR bsp buffer := "", + underline buffer := ""; + INT VAR cmd pos := pos (buffer, ""1"", ""31"", 1), + akt cmd pointer := 0, + soon out := 0; + out (left margin); + put leading blanks not underlined; + WHILE cmd pos > 0 + REP analyze cmd; + cmd pos := pos (buffer, ""1"", ""31"", cmd pos) + PER; + IF underline out + THEN fill (underline buffer, underline char, LENGTH buffer) + FI; + out buffer; + out bsp buffer; + out underline buffer; + buffer := ""; + cmd pointer := 0. + +put leading blanks not underlined: + IF underline out + THEN INT VAR first non blank pos := pos (buffer, ""33"", ""254"", 1); + IF cmd pos > 0 CAND first non blank pos > 0 + THEN fill (underline buffer, " ", + min (first non blank pos, cmd pos) - 1) + ELIF cmd pos > 0 + THEN fill (underline buffer, " ", cmd pos - 1) + ELSE fill (underline buffer, " ", first non blank pos -1) + FI; + FI. + +analyze cmd: + SELECT code (buffer SUB cmd pos) OF + CASE bsp code : do bsp cmd + CASE begin mark code : do begin mark cmd + CASE end mark code : do end mark cmd + CASE printercmd code : do printercmd cmd + OTHERWISE + END SELECT. + +do bsp cmd: + fill (bsp buffer, " ", cmd pos - 2); + cmd pos DECR 1; + bsp buffer CAT (buffer SUB cmd pos); + delete char (buffer, cmd pos); + delete char (buffer, cmd pos). + +do begin mark cmd: + IF NOT underline out + THEN underline out := TRUE; + fill (underline buffer, " ", cmd pos -1); + delete char (buffer, cmd pos) + FI. + +do end mark cmd: + IF underline out + THEN underline out := FALSE; + fill (underline buffer, underline char, cmd pos - 1); + delete char (buffer, cmd pos) + FI. + +do printercmd cmd: + IF akt cmd pointer < cmd pointer + THEN akt cmd pointer INCR 1; + out subtext (buffer, soon out + 1, cmd pos - 1); + soon out := cmd pos - 1; + delete char (buffer, cmd pos); + out (cmd arry (akt cmd pointer)) + FI. + +out buffer: + (* out (left margin) steht schon weiter oben *) + outsubtext (buffer, soon out + 1). + +out bsp buffer: + IF bsp buffer <> "" + THEN out (cr); + out (left margin); + out (bsp buffer) + FI. + +out underline buffer: + IF underline buffer <> "" + THEN out (cr); + out (left margin); + out (underline buffer) + FI. +END PROC output buffer; + +PROC fill (TEXT VAR buff, TEXT CONST char, INT CONST len): + buff CAT (len - outputlength (buff)) * char +END PROC fill; + +PROC output linefeed (INT CONST min y steps): + IF min y steps > 0 + THEN out (cr); + out (min y steps * lf) + FI +ENDPROC output linefeed ; + +PROC output pagefeed (INT CONST rest) : + out (cr) ; + rest TIMESOUT lf +ENDPROC output pagefeed ; + +(********************* B L O C K **********************************) +LET blank = " " , + enumeration list = "-).:" ; + +INT VAR to insert, + nr of blanks , + nr of big spaces , + begin ; + +TEXT VAR small space , + big space ; + +BOOL VAR right := TRUE ; + +PROC block (TEXT VAR blockline, INT CONST len): + to insert := len - outputlength (blockline); + nr of blanks := 0; begin:=0; + IF to insert <= 0 THEN LEAVE block FI; + IF to insert > (xlimit DIV 3 ) THEN LEAVE block FI; + mark the variable blanks; + IF nr of blanks <= 0 THEN LEAVE block FI; + right := NOT right; + compute spaces; + insert spaces. + +mark the variable blanks: + skip blanks ; + begin := pos(blockline,blank,begin+1); + IF (pos (enumeration list, (blockline SUB (begin-1))) > 0 ) + THEN skip blanks ; + begin := pos(blockline,blank,begin+1); + FI; + WHILE begin > 0 REP + IF single blank gap + THEN change (blockline,begin,begin,""0""); + nr of blanks INCR 1; + ELSE skip blanks + FI; + begin := pos(blockline,blank,begin+1); + ENDREP. + +single blank gap : + ((blockline SUB (begin+1)) <> blank). + +skip blanks : + begin := pos (blockline, ""33"", ""254"", begin+1) . + +compute spaces: + INT VAR steps := to insert ; + INT VAR small := steps DIV nr of blanks; + nr of big spaces := steps MOD nr of blanks; + small space := (small+1) * blank ; + big space := small space ; + big space CAT blank . + +insert spaces: + IF right THEN insert big spaces on right side + ELSE insert big spaces on left side + FI. + +insert big spaces on right side: + INT VAR nr of small spaces := nr of blanks - nr of big spaces; + INT VAR i; + FOR i FROM 1 UPTO nr of small spaces REP + change (blockline, ""0"",small space) + ENDREP; + changeall (blockline,""0"",big space). + +insert big spaces on left side: + INT VAR j; + FOR j FROM 1 UPTO nr of big spaces REP + change (blockline,""0"",big space) + ENDREP; + changeall (blockline,""0"",small space). +ENDPROC block; + +INT PROC chars (TEXT CONST text, char) : + INT VAR how many := 0 , + cmd pos := pos (text, char) ; + WHILE cmd pos > 0 REP + how many INCR 1 ; + cmd pos := pos (text, char, cmd pos+1) + PER ; + how many +ENDPROC chars ; + +ENDPACKET std printer ; diff --git a/system/std.zusatz/1.7.3/src/std printer generator-M b/system/std.zusatz/1.7.3/src/std printer generator-M new file mode 100644 index 0000000..f07d31c --- /dev/null +++ b/system/std.zusatz/1.7.3/src/std printer generator-M @@ -0,0 +1,22 @@ +forget ("std printer generator/M", quiet) ; +check off ; + +fetch ("minimal fonts routines", archive); +fetch ("std printer", archive); +fetch ("eumel printer", archive); +fetch ("elan lister", archive); +fetch ("spool manager", archive); +fetch ("printer/M", archive); + +ins ("minimal fonts routines"); +ins ("std printer"); +ins ("eumel printer"); +ins ("elan lister"); +ins ("spool manager"); +run ("printer/M"); + +PROC ins (TEXT CONST name): + insert (name); + forget (name, quiet) +END PROC ins; + diff --git a/system/std.zusatz/1.7.3/src/std printer generator-S b/system/std.zusatz/1.7.3/src/std printer generator-S new file mode 100644 index 0000000..067df88 --- /dev/null +++ b/system/std.zusatz/1.7.3/src/std printer generator-S @@ -0,0 +1,15 @@ +forget ("std printer generator/S", quiet) ; +check off ; + +ins ("minimal fonts routines"); +ins ("std printer"); +ins ("eumel printer"); +ins ("elan lister"); +ins ("printer/S"); + +PROC ins (TEXT CONST name): + fetch (name, archive); + insert (name); + forget (name, quiet) +END PROC ins; + diff --git a/system/std.zusatz/1.7.3/src/vector b/system/std.zusatz/1.7.3/src/vector new file mode 100644 index 0000000..fd1b0ef --- /dev/null +++ b/system/std.zusatz/1.7.3/src/vector @@ -0,0 +1,213 @@ +PACKET vector DEFINES VECTOR, :=, vector, (* Autor : H.Indenbirken *) + SUB, LENGTH, length, norm, (* Stand : 21.10.83 *) + nilvector, replace, =, <>, + +, -, *, /, + get, put : + +LET n = 4000; + +TYPE VECTOR = STRUCT (INT lng, TEXT elem); +TYPE INITVECTOR = STRUCT (INT lng, REAL value); + +INT VAR i; +TEXT VAR t :: "12345678"; +VECTOR VAR v :: nilvector; + +(**************************************************************************** +PROC dump (VECTOR CONST v) : + put line (text (v.lng) + " Elemente :"); + FOR i FROM 1 UPTO v.lng + REP put line (text (i) + ": " + text (element i)) PER . + +element i : + v.elem RSUB i . + +END PROC dump; +****************************************************************************) + +OP := (VECTOR VAR l, VECTOR CONST r) : + l.lng := r.lng; + l.elem := r.elem + +END OP :=; + +OP := (VECTOR VAR l, INITVECTOR CONST r) : + l.lng := r.lng; + replace (t, 1, r.value); + l.elem := r.lng * t + +END OP :=; + +INITVECTOR PROC nilvector : + vector (1, 0.0) + +END PROC nilvector; + +INITVECTOR PROC vector (INT CONST lng, REAL CONST value) : + IF lng <= 0 + THEN errorstop ("PROC vector : lng <= 0") FI; + INITVECTOR : (lng, value) + +END PROC vector; + +INITVECTOR PROC vector (INT CONST lng) : + vector (lng, 0.0) + +END PROC vector; + +REAL OP SUB (VECTOR CONST v, INT CONST i) : + test ("REAL OP SUB : ", v, i); + v.elem RSUB i + +END OP SUB; + +INT OP LENGTH (VECTOR CONST v) : + v.lng + +END OP LENGTH; + +INT PROC length (VECTOR CONST v) : + v.lng + +END PROC length; + +REAL PROC norm (VECTOR CONST v) : + REAL VAR result :: 0.0; + FOR i FROM 1 UPTO v.lng + REP result INCR ((v.elem RSUB i)**2) PER; + sqrt (result) . + +END PROC norm; + +PROC replace (VECTOR VAR v, INT CONST i, REAL CONST r) : + test ("PROC replace : ", v, i); + replace (v.elem, i, r) + +END PROC replace; + +BOOL OP = (VECTOR CONST l, r) : + l.elem = r.elem +END OP =; + +BOOL OP <> (VECTOR CONST l, r) : + l.elem <> r.elem +END OP <>; + +VECTOR OP + (VECTOR CONST v) : + v +END OP +; + +VECTOR OP + (VECTOR CONST l, r) : + test ("VECTOR OP + : ", l, r); + v := l; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, (l.elem RSUB i) + (r.elem RSUB i)) PER; + v + +END OP +; + +VECTOR OP - (VECTOR CONST a) : + v := a; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, - (a.elem RSUB i)) PER; + v + +END OP -; + +VECTOR OP - (VECTOR CONST l, r) : + test ("VECTOR OP - : ", l, r); + v := l; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, (l.elem RSUB i) - (r.elem RSUB i)) PER; + v +END OP -; + +REAL OP * (VECTOR CONST l, r) : + test ("REAL OP * : ", l, r); + REAL VAR x :: 0.0; + FOR i FROM 1 UPTO l.lng + REP x INCR ((l.elem RSUB i) * (r.elem RSUB i)) PER; + x + +END OP *; + +VECTOR OP * (VECTOR CONST v, REAL CONST r) : + r*v + +END OP *; + +VECTOR OP * (REAL CONST r, VECTOR CONST a) : + v := a; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, r*(a.elem RSUB i)) PER; + v + +END OP *; + +VECTOR OP / (VECTOR CONST a, REAL CONST r) : + v := a; + FOR i FROM 1 UPTO v.lng + REP replace (v.elem, i, (a.elem RSUB i)/r) PER; + v + +END OP /; + +TEXT VAR error :: ""; +PROC test (TEXT CONST proc, VECTOR CONST v, INT CONST i) : + IF i > v.lng + THEN error := proc; + error CAT "subscript overflow (LENGTH v="; + error CAT text (v.lng); + error CAT ", i="; + error CAT text (i); + error CAT ")"; + errorstop (error) + ELIF i < 1 + THEN error := proc; + error CAT "subscript underflow (i = "; + error CAT text (i); + error CAT ")"; + errorstop (error) + FI . + +END PROC test; + +PROC test (TEXT CONST proc, VECTOR CONST a, b) : + IF a.lng <> b.lng + THEN error := proc; + error CAT "LENGTH a ("; + IF a.lng <= 0 + THEN error CAT "undefined" + ELSE error CAT text (a.lng) FI; + error CAT ") <> LENGTH b ("; + error CAT text (b.lng); + error CAT ")"; + errorstop (error) + FI + +END PROC test; + +PROC get (VECTOR VAR v, INT CONST lng) : + v.lng := lng; + v.elem := lng * "12345678"; + REAL VAR x; + FOR i FROM 1 UPTO lng + REP get (x); + replace (v.elem, i, x) + PER . + +END PROC get; + +PROC put (VECTOR CONST v, INT CONST length, fracs) : + FOR i FROM 1 UPTO v.lng + REP put (text (v.elem RSUB i, length, fracs)) PER + +END PROC put; + +PROC put (VECTOR CONST v) : + FOR i FROM 1 UPTO v.lng + REP put (text (v.elem RSUB i)) PER + +END PROC put; + +END PACKET vector; diff --git a/system/std.zusatz/1.7.5/src/eumel printer b/system/std.zusatz/1.7.5/src/eumel printer new file mode 100644 index 0000000..2fd3f38 --- /dev/null +++ b/system/std.zusatz/1.7.5/src/eumel printer @@ -0,0 +1,3067 @@ +PACKET eumel printer (* Autor : Rudolf Ruland *) + (* Version : 4 *) + (* Stand : 07.08.86 *) + DEFINES print, + with elan listings, + is elan source, + bottom label for elan listings, + x pos, + y pos, + y offset index, + line type, + material, + pages printed : + + +LET std x wanted = 2.54, + std y wanted = 2.35, + std limit = 16.0, + std pagelength = 25.0, + std linefeed faktor = 1.0, + std material = ""; + +LET blank = " ", + blank code 1 = 33, + geschuetztes blank = ""223"", + keine blankanalyse = 0, + einfach blank = 1, + doppel blank = 2, + + anweisungszeichen = "#", + anweisungszeichen code 1 = 36, + geschuetztes anweisungszeichen = ""222"", + druckerkommando zeichen = "/", + quote = """", + + erweiterungs ausgang = 32767, + blank ausgang = 32766, + anweisungs ausgang = 32765, + d code ausgang = 32764, + max breite = 32763, + + punkt = ".", + + leer = 0, + + kommando token = 0, + text token = 1, + + underline linetype = 1, + underline bit = 0, + bold bit = 1, + italics bit = 2, + modifikations liste = "ubir", + anzahl modifikationen = 4, + + document = 1, + page = 2, + + write text = 1, + write cmd = 2, + carriage return = 3, + move = 4, + draw = 5, + on = 6, + off = 7, + type = 8, + + tag type = 1, + bold type = 2, + number type = 3, + text type = 4, + delimiter type = 6, + eof type = 7; + + +INT CONST null ausgang := -32767-1; + +ROW anzahl modifikationen INT CONST modifikations werte := + ROW anzahl modifikationen INT : (1, 2, 4, 8); + +TEXT CONST anweisungsliste := + "type:1.1on:2.1off:3.1center:4.0right:5.0u:6.0d:7.0e:8.0b:9.0" + + "fillchar:10.1mark:11.2markend:12.0" + + "ub:13.0ue:14.0fb:15.0fe:16.0" + + "block:20.0columns:21.2columnsend:22.0free:23.1limit:24.1linefeed:25.1" + + "material:26.1page:27.01pagelength:29.1start:30.2" + + "table:31.0tableend:32.0clearpos:33.01" + + "lpos:35.1rpos:36.1cpos:37.1dpos:38.2bpos:39.2" + + "textbegin:40.02textend:42.0" + + "indentation:43.1ytab:44.1"; + +LET a type = 1, a block = 20, + a on = 2, a columns = 21, + a off = 3, a columnsend = 22, + a center = 4, a free = 23, + a right = 5, a limit = 24, + a up = 6, a linefeed = 25, + a down = 7, a material = 26, + a end up or down = 8, a page0 = 27, + a bsp = 9, a page1 = 28, + a fill char = 10, a pagelength = 29, + a mark = 11, a start = 30, + a markend = 12, a table = 31, + a ub = 13, a tableend = 32, + a ue = 14, a clearpos0 = 33, + a fb = 15, a clearpos1 = 34, + a fe = 16, a lpos = 35, + a rpos = 36, + a cpos = 37, + a dpos = 38, + a bpos = 39, + a textbegin0 = 40, + a textbegin2 = 41, + a textend = 42, + a indentation = 43, + a y tab = 44; + +INT VAR a xpos, a breite, a font, a modifikationen, + a modifikationen fuer x move, a ypos, aktuelle ypos, + letzter font, letzte modifikationen, + d ypos, d xpos, d font, d modifikationen, + + zeilenpos, alte zeilenpos, zeilen laenge, anzahl zeichen, ausgang, + anzahl einrueck blanks, blankbreite, + einrueckbreite, aktuelle einrueckbreite, alte einrueckbreite, + font durchschuss, fonthoehe, font tiefe, + groesste fonthoehe, aktuelle zeilenhoehe, letzte zeilenhoehe, + blankmodus, alter blankmodus, + token zeiger, erstes token der zeile, + + erstes tab token, tab anfang, anzahl blanks, + d code 1, d pitch, fuell zeichen breite, erstes fuell token, + letztes fuell token, + + x size, y size, x wanted, y wanted, x start, y start, + pagelength, limit, indentation, + left margin, top margin, seitenlaenge, + papierlaenge, papierbreite, + luecke, anzahl spalten, aktuelle spalte, + + verschiebung, rest, neue modifikationen, modifikations modus, pass, + + int param, anweisungs index, anzahl params, index, + + gedruckte seiten; + +BOOL VAR zeile ist absatzzeile, letzte zeile war absatzzeile, + zeile muss geblockt werden, rechts, a block token, offsets, + tabellen modus, block modus, center modus, right modus, + seite ist offen, vor erster seite; + +REAL VAR linefeed faktor, real param; + +TEXT VAR zeile, anweisung, par1, par2, material wert, replacements, + fuell zeichen, d string, font offsets; + +ROW 256 INT VAR zeichenbreiten, replacement tabelle, zeichen zaehler; + +INITFLAG VAR in dieser task := FALSE; + +. zeile ist zu ende : zeilenpos > zeilen laenge + +. zeilen breite : a xpos - left margin + +. neue zeilenhoehe : int (linefeed faktor * real (fonthoehe) + 0.5) + +. naechstes zeichen ist blank : pos (zeile, blank, zeilenpos + 1, zeilenpos + 1) <> 0 + +. naechstes nicht blankes zeichen : pos (zeile, ""33"", ""255"", zeilenpos) + +. in letzter spalte : aktuelle spalte >= anzahl spalten + +. anfangs blankmodus : + INT VAR dummy; + IF center modus OR right modus + THEN dummy + ELIF index zaehler = 0 + THEN blankmodus + ELSE alter blankmodus + FI + +. initialisiere tab variablen : + erstes tab token := token index f + 1; + tab anfang := zeilen breite; + anzahl blanks := 0; +.; + +(******************************************************************) + +LET zeilen nr laenge = 4, + teil einrueckung = 5, + + headline pre = "Zeile **** E L A N EUMEL 1.7.5 **** ", + headline post = " **** "; + +INT VAR zeilen nr, rest auf seite, + max zeichen zeile, max zeichen fuss, layout laenge, layout laenge name, + symbol type, naechster symbol type; + +BOOL VAR vor erstem packet, innerhalb der define liste; + +TEXT VAR bottom label, dateiname, layout blanks, refinement layout zeile; + + +. symbol : fuell zeichen +. naechstes symbol : d string +. elan text : d token. text +.; + +(******************************************************************) +(*** tokenspeicher ***) + +LET max token = 3000, + max ypos = 1000, + + TOKEN = STRUCT (TEXT text, + INT xpos, breite, font, modifikationen, + modifikationen fuer x move, + offset index, naechster token index, + BOOL block token ), + + YPOS = STRUCT (INT ypos, vorheriger ypos index, naechster ypos index, + erster token index, letzter token index ), + + TOKENLISTE = STRUCT (ROW max token TOKEN token liste, + ROW max ypos YPOS ypos liste ); + +DATASPACE VAR ds; + +BOUND TOKENLISTE VAR tokenspeicher; + +TOKEN VAR d token, offset token; + +INT VAR erster ypos index a, letzter ypos index a, + erster ypos index d, letzter ypos index d, + ypos index, ypos index f, ypos index a, ypos index d, + token index, token index f; + +. t : tokenspeicher. token liste (token index) +. tf : tokenspeicher. token liste (token index f) + +. y : tokenspeicher. ypos liste (ypos index) +. yf : tokenspeicher. ypos liste (ypos index f) +. ya : tokenspeicher. ypos liste (ypos index a) +. yd : tokenspeicher. ypos liste (ypos index d) + +. loesche druckspeicher : + erster ypos index d := 0; + ypos index f := 0; + token index f := 0; + +. druckspeicher ist nicht leer : + erster ypos index d <> 0 + +. loesche analysespeicher : + erster ypos index a := 0; + +. analysespeicher ist nicht leer : + erster ypos index a <> 0 +.; + +(******************************************************************) +(*** anweisungsspeicher ***) + +INT VAR anweisungszaehler; +TEXT VAR anweisungs indizes, params1 zeiger, params2 zeiger; +THESAURUS VAR params1, params2; + +PROC loesche anweisungsspeicher : + + anweisungs zaehler := 0; + anweisungs indizes := ""; + params1 zeiger := ""; + params2 zeiger := ""; + params1 := empty thesaurus; + params2 := empty thesaurus; + +END PROC loesche anweisungsspeicher; + +(******************************************************************) +(*** indexspeicher ***) + +INT VAR index zaehler; +TEXT VAR grosse fonts, verschiebungen; + +PROC loesche indexspeicher : + + index zaehler := 0; + grosse fonts := ""; + verschiebungen := ""; + +END PROC loesche indexspeicher; + + +(******************************************************************) +(*** tabellenspeicher ***) + +LET max tabs = 30, + TABELLENEINTRAG = STRUCT (INT tab typ, tab position, tab param); + +TEXT VAR tab liste, fill char; +THESAURUS VAR d strings; +ROW max tabs TABELLENEINTRAG VAR tabspeicher; + +INT VAR tab index; + +. tab typ : tab speicher (tab liste ISUB tab index). tab typ +. tab position : tab speicher (tab liste ISUB tab index). tab position +. tab param : tab speicher (tab liste ISUB tab index). tab param +. anzahl tabs : LENGTH tab liste DIV 2 +.; + +PROC loesche tabellenspeicher : + + fill char := " "; + tabliste := ""; + d strings := empty thesaurus; + FOR tab index FROM 1 UPTO max tabs + REP tab speicher (tab index). tab typ := leer PER; + +END PROC loesche tabellenspeicher; + +(******************************************************************) +(*** markierungsspeicher ***) + +INT VAR mark index l, mark index r, alter mark index l, alter mark index r; + +ROW 4 TOKEN VAR mark token; + +. markierung links : mark index l > 0 +. markierung rechts : mark index r > 0 +.; + +PROC loesche markierung : + + mark index l := 0; + mark index r := 0; + +END PROC loesche markierung; + + +PROC loesche alte markierung : + + alter mark index l := 0; + alter mark index r := 0; + +END PROC loesche alte markierung; + + +PROC initialisiere markierung : + + FOR mark index l FROM 1 UPTO 4 + REP mark token (mark index l). modifikationen fuer x move := 0; + mark token (mark index l). offset index := text token; + mark token (mark index l). block token := FALSE; + mark token (mark index l). naechster token index := 0; + PER; + +END PROC initialisiere markierung; + +(******************************************************************) +(*** durchschuss ***) + +INT VAR durchschuss 1, durchschuss 2, anzahl durchschuss 1, + anzahl durchschuss, zeilen zaehler; + +BOOL VAR wechsel := TRUE; + +INT PROC durchschuss : + + zeilen zaehler INCR 1; + IF zeilen zaehler <= anzahl durchschuss 1 + THEN durchschuss 1 + ELIF zeilen zaehler <= anzahl durchschuss + THEN durchschuss 2 + ELSE 0 + FI + +END PROC durchschuss; + + +PROC neuer durchschuss (INT CONST anzahl, rest) : + + zeilen zaehler := 0; + anzahl durchschuss := anzahl; + IF anzahl > 0 + THEN IF wechsel + THEN durchschuss 1 := rest DIV anzahl durchschuss; + durchschuss 2 := durchschuss 1 + sign (rest); + anzahl durchschuss 1 := anzahl durchschuss - + abs (rest) MOD anzahl durchschuss; + wechsel := FALSE; + ELSE durchschuss 2 := rest DIV anzahl durchschuss; + durchschuss 1 := durchschuss 2 + sign (rest); + anzahl durchschuss 1 := abs (rest) MOD anzahl durchschuss; + wechsel := TRUE; + FI; + ELSE loesche durchschuss + FI; + +END PROC neuer durchschuss; + + +PROC loesche durchschuss : + + durchschuss 1 := 0; + durchschuss 2 := 0; + anzahl durchschuss 1 := 0; + anzahl durchschuss := 0; + zeilen zaehler := 0; + +END PROC loesche durchschuss; + +(****************************************************************) + +PROC initialisierung : + + forget (ds); + ds := nilspace; tokenspeicher := ds; + loesche druckspeicher; + loesche anweisungsspeicher; + loesche indexspeicher; + initialisiere markierung; + right modus := FALSE; + center modus := FALSE; + seite ist offen := FALSE; + pass := 0; + a breite := 0; + a block token := FALSE; + a modifikationen fuer x move := 0; + d code 1 := leer; + erstes fuell token := leer; + IF two bytes + THEN FOR index FROM 1 UPTO 129 REP zeichen zaehler (index) := 1 PER; + FOR index FROM 130 UPTO 160 REP zeichen zaehler (index) := - maxint PER; + FOR index FROM 161 UPTO 224 REP zeichen zaehler (index) := 1 PER; + FOR index FROM 225 UPTO 240 REP zeichen zaehler (index) := - maxint PER; + FOR index FROM 241 UPTO 256 REP zeichen zaehler (index) := 1 PER; + ELSE FOR index FROM 1 UPTO 256 REP zeichen zaehler (index) := 1 PER; + FI; + +END PROC initialisierung; + +(****************************************************************) +(*** print - Kommando ***) + +BOOL VAR elan listings erlaubt; +FILE VAR eingabe; + +with elan listings (TRUE); + +PROC with elan listings (BOOL CONST flag) : + elan listings erlaubt := flag; +END PROC with elan listings; + +BOOL PROC with elan listings : elan listings erlaubt END PROC with elan listings; + + +PROC print (PROC (TEXT VAR) next line, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute ): + + print (PROC (TEXT VAR) next line, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + FALSE, ""); + +END PROC print; + + +PROC print (FILE VAR file, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + eingabe := file; + input (eingabe); + print (PROC (TEXT VAR) lese zeile, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + elan listings erlaubt CAND is elan source (eingabe), + headline (eingabe) ); + +END PROC print; + +PROC lese zeile (TEXT VAR zeile) : getline (eingabe, zeile) END PROC lese zeile; + +BOOL PROC eof : eof (eingabe) END PROC eof; + +BOOL PROC is elan source (FILE VAR eingabe) : + +hole erstes symbol; +elan programm tag COR elan programm bold COR kommentar + +. elan programm tag : + symbol type = tag type CAND pos (zeile, ";") > 0 + +. elan programm bold : + symbol type = bold type CAND is elan bold + + . is elan bold : + symbol = "PACKET" COR symbol = "LET" + COR proc oder op (symbol) COR deklaration + COR proc oder op (naechstes symbol) + + . deklaration : + next symbol (naechstes symbol); + naechstes symbol = "VAR" OR naechstes symbol = "CONST" + +. kommentar : + pos (zeile, "(*") > 0 OR pos (zeile, "{") > 0 + +. + hole erstes symbol : + hole erstes nicht blankes symbol; + scan (zeile); + next symbol (symbol, symbol type); + + . hole erstes nicht blankes symbol : + IF eof (eingabe) THEN LEAVE is elan source WITH FALSE FI; + REP getline (eingabe, zeile); + UNTIL pos (zeile, ""33"",""254"", 1) > 0 OR eof (eingabe) PER; + reset (eingabe); + +END PROC is elan source; + +(****************************************************************) + +bottom label for elan listings (""); + +PROC bottom label for elan listings (TEXT CONST label) : + bottom label := label; +END PROC bottom label for elan listings; + +TEXT PROC bottom label for elan listings : bottom label END PROC bottom label for elan listings; + + +PROC print (PROC (TEXT VAR) next line, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + BOOL CONST elan listing, TEXT CONST file name) : + +disable stop; +gedruckte seiten := 0; +drucke datei (PROC (TEXT VAR) next line, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + elan listing, file name ); +IF is error THEN behandle fehlermeldung FI; + +. behandle fehlermeldung : + par1 := error message; + int param := error line; + clear error; + IF NOT vor erster seite + THEN IF seite ist offen + THEN schliesse seite ab (PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute ) + FI; + clear error; + close (document, 0); + clear error; + FI; + initialisierung; + errorstop (par1 (* + " -> " + text (int param) *) ); + +END PROC print; + +INT PROC x pos : d xpos END PROC x pos; +INT PROC y pos : d ypos END PROC y pos; +INT PROC y offset index : d token. offset index END PROC y offset index; +INT PROC linetype : underline linetype END PROC linetype; +TEXT PROC material : material wert END PROC material; +INT PROC pages printed : gedruckte seiten END PROC pages printed; + +(****************************************************************) + +PROC drucke datei (PROC (TEXT VAR) next line, BOOL PROC eof, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute, + BOOL CONST elan listing, TEXT CONST file name ) : + + +enable stop; +IF elan listing + THEN dateiname := file name; + drucke elan listing; + ELSE drucke text datei; +FI; + +. + drucke text datei : + initialisiere druck; + WHILE NOT eof + REP next line (zeile); + analysiere zeile; + drucke token soweit wie moeglich; + werte anweisungsspeicher aus; + PER; + schliesse druck ab; + +. + initialisiere druck : + IF NOT initialized (in dieser task) + THEN ds := nilspace; + initialisierung + FI; + vor erster seite := TRUE; + tabellen modus := FALSE; + block modus := FALSE; + zeile ist absatzzeile := TRUE; + x wanted := x step conversion (std x wanted); + y wanted := y step conversion (std y wanted); + limit := x step conversion (std limit); + pagelength := y step conversion (std pagelength); + linefeed faktor := std linefeed faktor; + material wert := std material; + indentation := 0; + modifikations modus := maxint; + seitenlaenge := maxint; + papierlaenge := maxint; + left margin := 0; + top margin := 0; + a ypos := top margin; + a font := -1; + a modifikationen := 0; + aktuelle spalte := 1; + anzahl spalten := 1; + stelle neuen font ein (1); + loesche tabellenspeicher; + loesche markierung; + loesche alte markierung; + loesche durchschuss; + +. + schliesse druck ab : + IF NOT vor erster seite + THEN IF seite ist offen + THEN schliesse seite ab (PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute ) + FI; + close (document, 0); + FI; + +. + drucke token soweit wie moeglich : + IF analysespeicher ist nicht leer + THEN letztes token bei gleicher ypos; + IF NOT seite ist offen + THEN eroeffne seite (x wanted, y wanted, + PROC (INT CONST, INT VAR, INT VAR) open); + FI; + gehe zur letzten neuen ypos; + IF seitenlaenge ueberschritten OR papierlaenge ueberschritten + THEN neue seite oder spalte; + analysiere zeile nochmal; + ELSE sortiere neue token ein; + IF in letzter spalte + THEN drucke tokenspeicher (a ypos, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + FI; + FI; + + . gehe zur letzten neuen ypos : + ypos index a := letzter ypos index a + + . seitenlaenge ueberschritten : + ya. ypos > seitenlaenge + + . papierlaenge ueberschritten : + ya. ypos > papierlaenge + + . neue seite oder spalte : + IF in letzter spalte + THEN schliesse seite ab (PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + eroeffne seite (x wanted, aktuelles y wanted, + PROC (INT CONST, INT VAR, INT VAR) open); + ELSE neue spalte; + FI; + + . aktuelles y wanted : + IF seitenlaenge ueberschritten + THEN y wanted + ELSE 0 + FI + + . analysiere zeile nochmal : + setze auf alte werte zurueck; + loesche anweisungsspeicher; + analysiere zeile; + letztes token bei gleicher ypos; + sortiere neue token ein; + + . setze auf alte werte zurueck : + zeile ist absatzzeile := letzte zeile war absatzzeile; + a modifikationen := letzte modifikationen; + stelle neuen font ein (letzter font); + +. + werte anweisungsspeicher aus : + INT VAR index; + FOR index FROM 1 UPTO anweisungszaehler + REP + SELECT anweisungs indizes ISUB index OF + CASE a block : block anweisung + CASE a columns : columns anweisung + CASE a columnsend : columnsend anweisung + CASE a free : free anweisung + CASE a limit : limit anweisung + CASE a linefeed : linefeed anweisung + CASE a material : material anweisung + CASE a page0, a page1 : page anweisung + CASE a pagelength : pagelength anweisung + CASE a start : start anweisung + CASE a table : table anweisung + CASE a tableend : tableend anweisung + CASE a clearpos0 : clearpos0 anweisung + CASE a clearpos1 : clearpos1 anweisung + CASE a lpos, a rpos, a cpos, a dpos + : lpos rpos cpos dpos anweisung + CASE a bpos : bpos anweisung + CASE a fillchar : fillchar anweisung + CASE a textbegin0 : textbegin0 anweisung + CASE a textbegin2 : textbegin2 anweisung + CASE a textend : textend anweisung + CASE a indentation : indentation anweisung + CASE a y tab : y tab anweisung + END SELECT + PER; + loesche anweisungsspeicher; + + . block anweisung : + blockmodus := TRUE; + + . columns anweisung : + IF anzahl spalten = 1 AND int conversion ok (param1) + AND real conversion ok (param2) + THEN anzahl spalten := max (1, int param); + luecke := x step conversion (real param); + FI; + + . columnsend anweisung : + anzahl spalten := 1; + aktuelle spalte := 1; + left margin := x wanted - x start + indentation; + + . free anweisung : + IF real conversion ok (param1) THEN a ypos INCR y step conversion (real param) FI; + + . limit anweisung : + IF real conversion ok (param1) THEN limit := x step conversion (real param) FI; + + . linefeed anweisung : + IF real conversion ok (param1) + THEN linefeed faktor := real param; + letzte zeilenhoehe := neue zeilenhoehe; + FI; + + . material anweisung : + material wert := param1; + + . page anweisung : + IF seite ist offen + THEN IF NOT in letzter spalte + THEN neue spalte + ELSE schliesse seite ab (PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + papier laenge := maxint; + FI; + ELSE a ypos := top margin; + papier laenge := maxint; + FI; + + . pagelength anweisung : + IF real conversion ok (param1) + THEN pagelength := y step conversion (real param); + FI; + + . start anweisung : + IF real conversion ok (param1) THEN x wanted := x step conversion (real param) FI; + IF real conversion ok (param2) THEN y wanted := y step conversion (real param) FI; + + . table anweisung : + tabellenmodus := TRUE; + + . tableend anweisung : + tabellenmodus := FALSE; + + . clearpos0 anweisung : + loesche tabellenspeicher; + + . clearpos1 anweisung : + IF real conversion ok (param1) + THEN int param := x step conversion (real param); + FOR tab index FROM 1 UPTO anzahl tabs + REP IF tab position = int param + THEN tab typ := leer; + delete int (tab liste, tab index); + LEAVE clearpos1 anweisung; + FI; + PER; + FI; + + . lpos rpos cpos dpos anweisung : + IF real conversion ok (param1) + THEN neuer tab eintrag (anweisungs indizes ISUB index, param2) FI; + + . bpos anweisung : + IF real conversion ok (param2) CAND real conversion ok (param1) + CAND real (param2) > real param + THEN neuer tab eintrag (a bpos, param2) FI; + + . fillchar anweisung : + fill char := param1; + + . textbegin0 anweisung : + aktuelle einrueckbreite := alte einrueckbreite; + mark index l := alter mark index l; + mark index r := alter mark index r; + loesche alte markierung; + + . textbegin2 anweisung : + aktuelle einrueckbreite := alte einrueckbreite; + mark index l := alter mark index l; + mark index r := alter mark index r; + loesche alte markierung; + neuer durchschuss (int (param1), y step conversion (real (param 2))); + + . textend anweisung : + alte einrueckbreite := aktuelle einrueckbreite; + alter mark index l := mark index l; + alter mark index r := mark index r; + loesche markierung; + loesche durchschuss; + + . indentation anweisung : +(* IF real conversion ok (param1) + THEN int param := x step conversion (real param); + left margin INCR (int param - indentation); + indentation := int param; + FI; + *) + . y tab anweisung : +(* IF real conversion ok (param1) + THEN int param := y step conversion (real param); + IF int param <= seitenlaenge THEN a ypos := int param FI; + FI; + *) + . param1 : + IF (params1 zeiger ISUB index) <> 0 + THEN name (params1, params1 zeiger ISUB index) + ELSE "" + FI + + . param2 : + IF (params2 zeiger ISUB index) <> 0 + THEN name (params2, params2 zeiger ISUB index) + ELSE "" + FI + + +. + drucke elan listing : + initialisiere elan listing; + WHILE NOT eof + REP next line (zeile); + zeilen nr INCR 1; + drucke elan zeile; + PER; + schliesse elan listing ab; + +. + initialisiere elan listing : + open document cmd; + hole elan list font; + initialisiere variablen; + elan fuss und kopf (1, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + + . open document cmd : + material wert := ""; + d token. offset index := 1; + erster ypos index d := 0; + vor erster seite := FALSE; + seite ist offen := FALSE; + open (document, x size, y size); + vor erster seite := TRUE; + + . hole elan list font : + d font := max (1, font ("elanlist")); + get replacements (d font, replacements, replacement tabelle); + einrueckbreite := indentation pitch (d font) ; + font hoehe := font lead (d font) + font height (d font) + font depth (d font); + + . initialisiere variablen : + innerhalb der define liste := FALSE; + vor erstem packet := TRUE; + zeilen nr := 0; + y wanted := y size DIV 23; + pagelength := y size - y wanted - y wanted; + x wanted := (min (x size DIV 10, x step conversion (2.54)) + DIV einrueckbreite) * einrueckbreite; + max zeichen zeile := (x size - x wanted - (x wanted DIV 3)) DIV einrueckbreite; + max zeichen fuss := fusszeilenbreite; + layout laenge := min (38, max zeichen zeile DIV 3); + layout laenge name := layout laenge - zeilen nr laenge - 8; + layout blanks := (layout laenge - zeilen nr laenge - 1) * " "; + refinement layout zeile := (layout laenge - 1) * " " ; + refinement layout zeile CAT "|" ; + IF pagelength DIV fonthoehe - 6 < 35 OR max zeichen zeile < 65 + THEN errorstop ("Schreibfeld fuer 'elan listing' zu klein") FI; + + . fusszeilenbreite : + INT CONST dina 4 breite := x step conversion (21.0); + IF x size <= dina 4 breite + THEN (x size - 2 * x wanted) DIV einrueckbreite + ELIF 120 * einrueckbreite <= dina 4 breite - 2 * x wanted + THEN (dina 4 breite - 2 * x wanted) DIV einrueckbreite + ELSE min (120, (x size - 2 * x wanted) DIV einrueckbreite) + FI + +. + schliesse elan listing ab : + elan fuss und kopf (-1, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + close (document, 0); + +. + drucke elan zeile : + IF pos (zeile, "#page#") = 1 + THEN IF nicht am seiten anfang THEN seiten wechsel FI; + ELSE bestimme elan layout; + bestimme elan zeile; + gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + seitenwechsel wenn noetig; + FI; + + . nicht am seitenanfang : + rest auf seite < pagelength - 3 * font hoehe + + . seiten wechsel : + elan fuss und kopf (0, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +. + bestimme elan layout : + IF pos (zeile, "P") = 0 AND pos (zeile, ":") = 0 + THEN leeres layout + ELSE analysiere elan zeile + FI; + elan text CAT "|"; + + . leeres layout : + elan text := text (zeilen nr, zeilen nr laenge); + elan text CAT layout blanks; + + . analysiere elan zeile : + scan (zeile); + next symbol (symbol, symbol type); + next symbol (naechstes symbol, naechster symbol type) ; + IF packet anfang THEN packet layout + ELIF innerhalb der define liste THEN leeres layout; pruefe ende der define liste + ELIF proc op anfang THEN proc op layout + ELIF refinement anfang THEN refinement layout + ELSE leeres layout + FI; + + . packet anfang : + symbol = "PACKET" + + . proc op anfang : + IF proc oder op (symbol) + THEN naechster symbol type <> delimiter type + ELIF (symbol <> "END") AND proc oder op (naechstes symbol) + THEN symbol := naechstes symbol; + next symbol (naechstes symbol, naechster symbol type) ; + naechster symbol type <> delimiter type + ELSE FALSE + FI + + . refinement anfang : + symbol type = tag type AND naechstes symbol = ":" + AND NOT innerhalb der define liste + + . packet layout : + IF nicht am seiten anfang AND + (NOT vor erstem packet OR gedruckte seiten > 1) + THEN seiten wechsel FI; + layout (" ", naechstes symbol, "*") ; + vor erstem packet := FALSE ; + innerhalb der define liste := TRUE; + pruefe ende der define liste; + + . pruefe ende der define liste : + IF pos (zeile, ":") <> 0 + THEN scan (zeile); + WHILE innerhalb der define liste + REP next symbol (symbol); + IF symbol = ":" THEN innerhalb der define liste := FALSE FI; + UNTIL symbol = "" PER; + FI; + + . proc op layout : + IF keine vier zeilen mehr + THEN seiten wechsel + ELIF nicht am seitenanfang + THEN cr plus lf (2, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI ; + layout (" ", naechstes symbol, "."); + + . keine vier zeilen mehr : + rest auf seite <= 8 * font hoehe + + . refinement layout : + IF keine drei zeilen mehr + THEN seiten wechsel + ELIF nicht am seitenanfang + THEN elan text := refinement layout zeile; + gib elan text aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI ; + layout (" ", symbol, " "); + + . keine drei zeilen mehr : + rest auf seite <= 7 * font hoehe + +. + bestimme elan zeile : + IF zeile ist nicht zu lang + THEN elan text CAT zeile; + ELSE drucke zeile in teilen + FI; + + . zeile ist nicht zu lang : + zeilen laenge := LENGTH zeile; + zeilen laenge <= rest auf zeile + + . rest auf zeile : + max zeichen zeile - LENGTH elan text + + . drucke zeile in teilen : + zeilen pos := 1; + bestimme einrueckung; + WHILE zeile noch nicht ganz gedruckt REP teil layout PER; + + . bestimme einrueckung : + anzahl einrueck blanks := naechstes nicht blankes zeichen - 1; + IF anzahl einrueck blanks > rest auf zeile - 20 + THEN anzahl einrueck blanks := 0 FI; + + . zeile noch nicht ganz gedruckt : + bestimme zeilenteil; + NOT zeile ist zu ende + + . bestimme zeilenteil : + bestimme laenge; + zeilen teil := subtext (zeile, zeilen pos, zeilen pos + laenge - 1); + elan text CAT zeilen teil; + zeilen pos INCR laenge; + + . zeilen teil : par1 + + . bestimme laenge : + INT VAR laenge := zeilen laenge - zeilen pos + 1; + IF laenge > rest auf zeile + THEN laenge := rest auf zeile; + WHILE (zeile SUB (zeilen pos + laenge - 1)) <> " " + REP laenge DECR 1 UNTIL laenge = 0 PER; + IF laenge = 0 THEN laenge := rest auf zeile FI; + FI; + + . teil layout : + gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + elan text := (zeilen nr laenge - 1) * " "; + elan text CAT "+"; + elan text CAT layout blanks; + elan text CAT "|"; + elan text cat blanks (anzahl einrueck blanks + teil einrueckung); + +. + seiten wechsel wenn noetig : + IF keine zeilen mehr AND NOT eof THEN seiten wechsel FI; + + . keine zeilen mehr : + rest auf seite <= 4 * font hoehe + +END PROC drucke datei; + + +BOOL PROC real conversion ok (TEXT CONST param) : + real param := real (param); + last conversion ok AND real param >= 0.0 +END PROC real conversion ok; + + +BOOL PROC int conversion ok (TEXT CONST param) : + int param := int (param); + last conversion ok AND int param >= 0 +END PROC int conversion ok; + + +PROC neuer tab eintrag (INT CONST typ, TEXT CONST param) : + + suche neuen eintrag; + sortiere neue tab position ein; + tab typ := typ; + tab position := neue tab position; + tab param := eventueller parameter; + + . suche neuen eintrag : + INT VAR index := 0; + REP index INCR 1; + IF tab speicher (index). tab typ = leer + THEN LEAVE suche neuen eintrag FI; + UNTIL index = max tabs PER; + LEAVE neuer tab eintrag; + + . sortiere neue tab position ein : + INT VAR neue tab position := x step conversion (real param); + FOR tab index FROM 1 UPTO anzahl tabs + REP IF tab position = neue tab position + THEN LEAVE neuer tab eintrag + ELIF tab position > neue tab position + THEN insert int (tab liste, tab index, index); + LEAVE sortiere neue tab position ein; + FI; + PER; + tab liste CAT index; + tab index := anzahl tabs; + + . eventueller parameter : + INT VAR link; + SELECT typ OF + CASE a dpos : insert (d strings, param, link); link + CASE a bpos : x step conversion (real(param)) + OTHERWISE : 0 + END SELECT + +END PROC neuer tab eintrag; + + +PROC neue spalte : + a ypos := top margin; + left margin INCR (limit + luecke); + aktuelle spalte INCR 1; +END PROC neue spalte ; + + +BOOL PROC proc oder op (TEXT CONST symbol) : + + symbol = "PROC" OR symbol = "PROCEDURE" + OR symbol = "OP" OR symbol = "OPERATOR" + +ENDPROC proc oder op ; + + +PROC layout (TEXT CONST pre, TEXT VAR name, TEXT CONST post) : + +name := subtext (name, 1, layout laenge name) ; +elan text := text (zeilen nr, zeilen nr laenge); +elan text CAT pre; +elan text CAT name; +elan text CAT " "; +generiere strukturiertes layout; + +. generiere strukturiertes layout : + INT VAR index; + FOR index FROM 1 UPTO layout laenge - LENGTH elan text - 1 + REP elan text CAT post PER; + +ENDPROC layout ; + + +PROC elan text cat blanks (INT CONST anzahl) : + + par2 := anzahl * " "; + elan text CAT par2; + +END PROC elan text cat blanks; + + +(***********************************************************************) + +PROC analysiere zeile : + +loesche analysespeicher; +behandle fuehrende blanks; +pruefe ob anweisungszeile; +pruefe ob markierung links; + +IF tabellen modus + THEN analysiere tabellenzeile +ELIF letzte zeile war absatzzeile + THEN analysiere zeile nach absatzzeile + ELSE analysiere zeile nach blockzeile +FI; + +pruefe center und right modus; +pruefe ob tabulation vorliegt; +werte indexspeicher aus; +berechne zeilenhoehe; +pruefe ob markierung rechts; + +. + analysiere zeile nach absatzzeile : + test auf aufzaehlung; + IF zeile muss geblockt werden + THEN analysiere blockzeile nach absatzzeile + ELSE analysiere absatzzeile nach absatzzeile + FI; +. + analysiere zeile nach blockzeile : + IF zeile muss geblockt werden + THEN analysiere blockzeile nach blockzeile + ELSE analysiere absatzzeile nach blockzeile + FI; + + +. + behandle fuehrende blanks : + zeilenpos := 1; + zeilenpos := naechstes nicht blankes zeichen; + IF zeilenpos = 0 + THEN behandle leerzeile; + LEAVE analysiere zeile; + ELSE letzte zeile war absatzzeile := zeile ist absatzzeile; + IF letzte zeile war absatzzeile THEN neue einrueckung FI; + initialisiere analyse; + FI; + + . behandle leerzeile : + a ypos INCR (letzte zeilenhoehe + durchschuss); + zeile ist absatzzeile := LENGTH zeile > 0; + pruefe ob markierung links; + pruefe ob markierung rechts; + + . neue einrueckung : + aktuelle einrueckbreite := einrueckbreite; + + . initialisiere analyse : + zeile ist absatzzeile := (zeile SUB LENGTH zeile) = blank; + zeile muss geblockt werden := block modus AND NOT zeile ist absatzzeile; + erstes token der zeile := token index f + 1; + groesste fonthoehe := fonthoehe; + aktuelle zeilenhoehe := letzte zeilenhoehe; + zeilen laenge := laenge der zeile; + anzahl einrueck blanks := zeilen pos - 1; + anzahl zeichen := anzahl einrueck blanks; + a xpos := left margin + anzahl zeichen * aktuelle einrueckbreite; + a modifikationen fuer x move := 0; + letzter font := a font; + letzte modifikationen := a modifikationen; + IF zeile muss geblockt werden THEN initialisiere tab variablen FI; + + . laenge der zeile : + IF zeile ist absatzzeile + THEN LENGTH zeile - 1 + ELSE LENGTH zeile + FI +. + pruefe ob anweisungszeile : + IF erstes zeichen ist anweisungszeichen + THEN REP analysiere anweisung; + IF zeile ist zu ende THEN LEAVE analysiere zeile FI; + UNTIL zeichen ist kein anweisungs zeichen PER; + FI; + + . erstes zeichen ist anweisungszeichen : + pos (zeile, anweisungszeichen, 1, 1) <> 0 + + . zeichen ist kein anweisungszeichen : + pos (zeile, anweisungszeichen, zeilen pos, zeilen pos) = 0 + +. + pruefe ob markierung links : + IF markierung links + THEN mark token (mark index l). xpos := + left margin - mark token (mark index l). breite; + lege markierungs token an (mark index l); + erstes token der zeile := token index f + 1; + initialisiere tab variablen; + FI; + +. + analysiere tabellenzeile : + anfangs blankmodus := doppel blank; + alte zeilenpos := zeilen pos; + a xpos := 0; + FOR tab index FROM 1 UPTO anzahl tabs + REP lege fuell token an wenn noetig; + initialisiere tab variablen; + SELECT tab typ OF + CASE a lpos : linksbuendige spalte + CASE a rpos : rechtsbuendige spalte + CASE a cpos : zentrierte spalte + CASE a dpos : dezimale spalte + CASE a bpos : geblockte spalte + END SELECT; + berechne fuell token wenn noetig; + tabulation; + PER; + analysiere rest der zeile; + + . lege fuell token an wenn noetig : + IF fill char <> blank + THEN fuellzeichen := fill char; + fuellzeichen breite := string breite (fuellzeichen); + token zeiger := zeilen pos; + erstes fuell token := token index f + 1; + lege text token an; + letztes fuell token := token index f; + a modifikationen fuer x move := a modifikationen + FI; + + . berechne fuell token wenn noetig : + IF erstes fuell token <> leer + THEN IF letztes fuell token <> token index f + THEN berechne fuell token; + ELSE loesche letzte token; + FI; + erstes fuell token := leer + FI; + + . berechne fuell token : + INT VAR anzahl fuellzeichen, fuell breite; + token index := erstes fuell token; + anzahl fuellzeichen := (tab anfang - t. xpos + left margin) + DIV fuellzeichen breite; + rest := (tab anfang - t. xpos + left margin) + MOD fuellzeichen breite; + IF anzahl fuell zeichen > 0 + THEN fuell text := anzahl fuellzeichen * fuellzeichen; + fuell breite := anzahl fuellzeichen * fuellzeichen breite; + FOR token index FROM erstes fuell token UPTO letztes fuell token + REP t. text := fuell text; + t. breite := fuell breite; + IF erstes fuell token <> erstes token der zeile + THEN t. xpos INCR rest DIV 2; + t. modifikationen fuer x move := t. modifikationen; + FI; + PER; + FI; + + . fuell text : par1 + + . loesche letzte token : + FOR token index FROM letztes fuell token DOWNTO erstes fuell token + REP loesche letztes token PER; + + . tabulation : + alte zeilenpos := zeilenpos; + zeilenpos := naechstes nicht blankes zeichen; + IF zeilenpos = 0 + THEN zeilenpos := zeilenlaenge + 1; + LEAVE analysiere tabellenzeile; + FI; + anzahl zeichen INCR zeilenpos - alte zeilenpos; + + . linksbuendige spalte : + a xpos := left margin + tab position; + tab anfang := tab position; + bestimme token bis terminator oder zeilenende; + + . rechtsbuendige spalte : + bestimme token bis terminator oder zeilenende; + schreibe zeile rechtsbuendig (tab position); + + . zentrierte spalte : + bestimme token bis terminator oder zeilenende; + zentriere zeile (tab position); + + . dezimale spalte : + d string := name (d strings, tab param); + d code 1 := code (d string SUB 1) + 1; + d pitch := zeichenbreiten (d code 1); + zeichenbreiten (d code 1) := d code ausgang; + bestimme token bis terminator oder zeilenende; + zeichenbreiten (d code 1) := d pitch; + d code 1 := leer; + schreibe zeile rechtsbuendig (tab position); + IF zeichen ist dezimal zeichen + THEN IF tab position <> zeilen breite + THEN a xpos := left margin + tab position; + tab anfang := tab position; + FI; + bestimme token bis terminator oder zeilenende + FI; + + . zeichen ist dezimal zeichen : + pos (zeile, d string, zeilen pos) = zeilen pos + + . geblockte spalte : + blankmodus := einfach blank; + a xpos := left margin + tab position; + tab anfang := tab position; + REP bestimme token bis terminator oder zeilenende; + IF zeile ist zu ende OR naechstes zeichen ist blank + THEN blocke spalte wenn noetig; + LEAVE geblockte spalte; + ELSE dehnbares blank gefunden; + FI; + PER; + + . blocke spalte wenn noetig : + IF letztes zeichen ist kein geschuetztes blank + THEN blocke zeile (tab param) FI; + blank modus := doppel blank; + + . letztes zeichen ist kein geschuetztes blank : + pos (zeile, geschuetztes blank, zeilen pos - 1, zeilen pos - 1) = 0 + AND NOT within kanji (zeile, zeilen pos - 2) + + . analysiere rest der zeile : + blankmodus := keine blankanalyse; + zeilen pos := alte zeilenpos; + bestimme token bis terminator oder zeilenende; + +. + test auf aufzaehlung : + anfangs blankmodus := einfach blank; + bestimme token bis terminator oder zeilenende; + IF zeile ist zu ende + THEN LEAVE analysiere zeile nach absatzzeile + ELSE aufzaehlung moeglich + FI; + + . aufzaehlung moeglich : + bestimme letztes zeichen; + IF (anzahl zeichen bei aufzaehlung < 2 AND letztes zeichen = "-") + OR (anzahl zeichen bei aufzaehlung < 20 AND letztes zeichen = ":") + OR (anzahl zeichen bei aufzaehlung < 7 + AND pos (".)", letztes zeichen) <> 0) + OR naechstes zeichen ist blank + THEN tabulator position gefunden; + ELIF zeile muss geblockt werden + THEN dehnbares blank gefunden; + FI; + + . bestimme letztes zeichen : + token index := token index f; + WHILE token index >= erstes token der zeile + REP IF token ist text token + THEN letztes zeichen := t. text SUB LENGTH t. text; + LEAVE bestimme letztes zeichen; + FI; + token index DECR 1; + PER; + letztes zeichen := ""; + + . letztes zeichen : par1 + + . anzahl zeichen bei aufzaehlung : + anzahl zeichen - anzahl einrueck blanks + + . token ist text token : + t. offset index >= text token +. + analysiere blockzeile nach absatzzeile : + REP bestimme token bis terminator oder zeilenende; + IF zeile ist zu ende + THEN blocke zeile (limit); + LEAVE analysiere blockzeile nach absatzzeile + ELSE analysiere blank in blockzeile nach absatzzeile + FI; + PER; + + . analysiere blank in blockzeile nach absatzzeile : + IF naechstes zeichen ist blank + THEN tabulator position gefunden; + ELSE dehnbares blank gefunden; + FI; + +. + analysiere absatzzeile nach absatzzeile : + blankmodus := doppel blank; + REP bestimme token bis terminator oder zeilenende; + IF zeile ist zu ende + THEN LEAVE analysiere absatzzeile nach absatzzeile + ELSE tabulator position gefunden + FI; + PER; + +. + analysiere blockzeile nach blockzeile : + anfangs blankmodus := einfach blank; + REP bestimme token bis terminator oder zeilenende; + IF zeile ist zu ende + THEN blocke zeile (limit); + LEAVE analysiere blockzeile nach blockzeile + ELSE dehnbares blank gefunden + FI; + PER; + +. + analysiere absatzzeile nach blockzeile : + anfangs blankmodus := keine blankanalyse; + bestimme token bis terminator oder zeilenende; + +. + dehnbares blank gefunden : + anzahl zeichen INCR 1; + zeilenpos INCR 1; + a xpos INCR blankbreite; + a modifikationen fuer x move := a modifikationen; + IF NOT a block token + THEN anzahl blanks INCR 1; + a block token := TRUE; + FI; +. + tabulator position gefunden : + alte zeilenpos := zeilenpos; + zeilenpos := naechstes nicht blankes zeichen; + IF zeilenpos = 0 + THEN zeilenpos := zeilen laenge + 1; + ELSE IF erstes token der zeile > token index f + THEN token zeiger := zeilen pos; + lege text token an; + FI; + anzahl zeichen INCR (zeilenpos - alte zeilenpos); + a xpos := left margin + anzahl zeichen * aktuelle einrueckbreite; + a modifikationen fuer x move := a modifikationen; + IF zeile muss geblockt werden THEN initialisiere tab variablen FI; + FI; + +. + pruefe center und right modus : + IF center modus THEN zentriere zeile (limit DIV 2) FI; + IF right modus THEN schreibe zeile rechtsbuendig (limit) FI; +. + pruefe ob tabulation vorliegt: + IF analyse speicher ist nicht leer CAND a xpos > tf. xpos + tf. breite + THEN a modifikationen fuer x move := a modifikationen; + token zeiger := zeilen pos; + lege text token an; + FI; +. + werte indexspeicher aus : + INT VAR index; + IF index zaehler > 0 + THEN FOR index FROM index zaehler DOWNTO 1 + REP a ypos DECR (verschiebungen ISUB index) PER; + stelle neuen font ein (grosse fonts ISUB 1); + loesche index speicher; + FI; +. + berechne zeilenhoehe : + verschiebung := aktuelle zeilenhoehe + durchschuss; + a ypos INCR verschiebung; + verschiebe token ypos (verschiebung); + +. + pruefe ob markierung rechts : + IF markierung rechts + THEN mark token (mark index r). xpos := left margin + limit; + lege markierungs token an (mark index r); + FI; + +END PROC analysiere zeile; + + +PROC blocke zeile (INT CONST rechter rand) : + +rest := rechter rand - zeilen breite; +IF rest > 0 AND anzahl blanks > 0 + THEN INT CONST schmaler schritt := rest DIV anzahl blanks, + breiter schritt := schmaler schritt + 1, + anzahl breite schritte := rest MOD anzahl blanks; + IF rechts + THEN blocke token xpos (breiter schritt, schmaler schritt, + anzahl breite schritte); + rechts := FALSE; + ELSE blocke token xpos (schmaler schritt, breiter schritt, + anzahl blanks - anzahl breite schritte); + rechts := TRUE; + FI; + a xpos INCR ( breiter schritt * anzahl breite schritte + + schmaler schritt * (anzahl blanks - anzahl breite schritte) ); +FI; + +END PROC blocke zeile; + + +PROC zentriere zeile (INT CONST zentrier pos) : + +IF erstes tab token <= token index f + THEN verschiebung := zentrier pos - tab anfang - + (zeilen breite - tab anfang) DIV 2; + verschiebe token xpos (verschiebung); + a xpos INCR verschiebung; + tab anfang INCR verschiebung; +FI; +center modus := FALSE; + +END PROC zentriere zeile; + + +PROC schreibe zeile rechtsbuendig (INT CONST rechte pos) : + +IF erstes tab token <= token index f + THEN verschiebung := rechte pos - zeilen breite; + verschiebe token xpos (verschiebung); + a xpos INCR verschiebung; + tab anfang INCR verschiebung; +FI; +right modus := FALSE; + + +END PROC schreibe zeile rechtsbuendig; + + +PROC bestimme token bis terminator oder zeilenende : + +token zeiger := zeilen pos; +REP stranalyze (zeichenbreiten, a breite, max breite, + zeile, zeilen pos, zeilen laenge, + ausgang); + zeilen pos INCR 1; + IF ausgang = blank ausgang + THEN analysiere blank + ELIF ausgang = anweisungs ausgang + THEN anweisung gefunden + ELIF ausgang = d code ausgang + THEN analysiere d string + ELIF ausgang = erweiterungs ausgang + THEN erweiterung gefunden + ELSE terminator oder zeilenende gefunden + FI; +PER; + +. analysiere blank : + IF blankmodus = einfach blank OR + (blankmodus = doppel blank AND naechstes zeichen ist blank) + THEN terminator oder zeilenende gefunden + ELSE a breite INCR blankbreite; + zeilenpos INCR 1; + FI; + +. analysiere d string : + IF pos (zeile, d string, zeilen pos) = zeilen pos + THEN terminator oder zeilenende gefunden + ELSE IF d pitch = maxint + THEN erweiterung gefunden + ELIF d pitch < 0 + THEN a breite INCR (d pitch XOR - maxint - 1); + zeilen pos INCR 2; + ELSE a breite INCR d pitch; + zeilenpos INCR 1; + FI; + FI; + +. erweiterung gefunden : + a breite INCR extended char pitch (a font, zeile SUB zeilen pos, + zeile SUB zeilen pos + 1); + zeilen pos INCR 2; + +. anweisung gefunden : + gegebenfalls neues token gefunden; + analysiere anweisung; + IF zeile ist zu ende + THEN LEAVE bestimme token bis terminator oder zeilenende FI; + token zeiger := zeilenpos; + +. terminator oder zeilenende gefunden : + IF ausgang = null ausgang THEN zeilen laenge DECR 1 FI; + gegebenfalls neues token gefunden; + LEAVE bestimme token bis terminator oder zeilenende; + + . gegebenfalls neues token gefunden : + IF token zeiger < zeilenpos THEN lege text token an FI; + +END PROC bestimme token bis terminator oder zeilen ende; + + +PROC analysiere anweisung : + + bestimme anweisung; + IF anweisung ist kommando + THEN lege kommando token an; + ELSE werte anweisung aus; + FI; + + . anweisungsanfang : token zeiger + + . anweisungsende : zeilen pos - 2 + + . erstes zeichen : par1 + +. bestimme anweisung : + anweisungsanfang := zeilenpos + 1; + zeilen pos := pos (zeile, anweisungszeichen, anweisungsanfang, zeilenlaenge); + IF zeilenpos = 0 + THEN zeilenpos := anweisungsanfang - 1; + replace (zeile, zeilenpos, geschuetztes anweisungszeichen); + LEAVE analysiere anweisung; + FI; + zeilen pos INCR 1; + anweisung := subtext (zeile, anweisungsanfang, anweisungsende); + erstes zeichen := anweisung SUB 1; + +. anweisung ist kommando : + IF erstes zeichen = quote + THEN scan (anweisung); + next symbol (anweisung, symbol type); + next symbol (par2, naechster symbol type); + IF symbol type <> text type OR naechster symbol type <> eof type + THEN LEAVE analysiere anweisung FI; + TRUE + ELIF erstes zeichen = druckerkommando zeichen + THEN delete char (anweisung, 1); + TRUE + ELSE FALSE + FI + +. + werte anweisung aus : + analyze command (anweisungs liste, anweisung, number type, + anweisungs index, anzahl params, par1, par2); + SELECT anweisungs index OF + CASE a type : type anweisung + CASE a on : on anweisung + CASE a off : off anweisung + CASE a ub, a fb : ub fb anweisung + CASE a ue, a fe : ue fe anweisung + CASE a center : center anweisung + CASE a right : right anweisung + CASE a up, a down : index anweisung + CASE a end up or down : end index anweisung + CASE a bsp : bsp anweisung + CASE a fillchar : fillchar anweisung + CASE a mark : mark anweisung + CASE a markend : markend anweisung + OTHERWISE : IF anweisungs index > 0 THEN speichere anweisung FI; + END SELECT; + + . type anweisung : + change all (par1, " ", ""); + stelle neuen font ein (font (par1)); + groesste fonthoehe := max (groesste fonthoehe, fonthoehe); + a modifikationen := 0; + IF nicht innerhalb eines indexes THEN berechne aktuelle zeilenhoehe FI; + + . nicht innerhalb eines indexes : + index zaehler = 0 + + . berechne aktuelle zeilenhoehe : + IF linefeed faktor >= 1.0 + THEN aktuelle zeilenhoehe := max (groesste fonthoehe, + letzte zeilenhoehe); + ELSE aktuelle zeilenhoehe := max (aktuelle zeilenhoehe, + letzte zeilenhoehe); + FI; + + . on anweisung : + par1 := par1 SUB 1; + IF pos (modifikations liste, par1) > 0 + THEN set bit (a modifikationen, pos (modifikations liste, par1) - 1 ); + FI; + + . off anweisung : + par1 := par1 SUB 1; + IF pos (modifikations liste, par1) > 0 + THEN reset bit (a modifikationen, pos (modifikations liste, par1) - 1 ); + FI; + + . ub fb anweisung : + IF anweisungs index = a ub + THEN par1 := "u" + ELSE par1 := "b" + FI; + on anweisung; + + . ue fe anweisung : + IF anweisungs index = a ue + THEN par1 := "u" + ELSE par1 := "b" + FI; + off anweisung; + + . center anweisung : + IF NOT zeile muss geblockt werden AND NOT tabellen modus + AND NOT right modus + THEN center modus := TRUE; + blankmodus := keine blankanalyse; + initialisiere tab variablen; + FI; + + . right anweisung : + IF NOT zeile muss geblockt werden AND NOT tabellen modus + THEN IF center modus THEN zentriere zeile (limit DIV 2) FI; + right modus := TRUE; + blankmodus := keine blankanalyse; + initialisiere tab variablen; + FI; + + . index anweisung : + INT CONST grosser font := a font, grosse fonthoehe := fonthoehe; + INT VAR kleiner font; + IF next smaller font exists (grosser font, kleiner font) + THEN stelle neuen font ein (kleiner font) FI; + IF font hoehe < grosse fonthoehe + THEN berechne verschiebung fuer kleinen font + ELSE berechne verschiebung fuer grossen font + FI; + a ypos INCR verschiebung; + merke grossen font und verschiebung; + + . berechne verschiebung fuer kleinen font : + IF anweisungs index = a down + THEN verschiebung := 15 PROZENT grosse fonthoehe; + ELSE verschiebung := - ( 9 PROZENT grosse fonthoehe ) + - (grosse fonthoehe - fonthoehe); + FI; + + . berechne verschiebung fuer grossen font : + IF anweisungs index = a down + THEN verschiebung := 25 PROZENT fonthoehe; + ELSE verschiebung := - (50 PROZENT fonthoehe); + FI; + + . merke grossen font und verschiebung : + index zaehler INCR 1; + grosse fonts CAT grosser font; + verschiebungen CAT verschiebung; + IF index zaehler = 1 + THEN alter blankmodus := blankmodus; + blankmodus := keine blankanalyse; + FI; + + . end index anweisung : + IF index zaehler > 0 + THEN schalte auf groesseren font zurueck; + FI; + + . schalte auf groesseren font zurueck : + a ypos DECR (verschiebungen ISUB index zaehler); + stelle neuen font ein (grosse fonts ISUB index zaehler); + IF index zaehler = 1 + THEN blankmodus := alter blankmodus; + FI; + index zaehler DECR 1; + verschiebungen := subtext (verschiebungen, 1, 2 * index zaehler); + grosse fonts := subtext (grosse fonts, 1, 2 * index zaehler); + + . bsp anweisung : + INT VAR breite davor, breite dahinter; + IF anweisungs anfang - 2 >= 1 AND anweisungs ende + 2 <= zeilen laenge + THEN IF is kanji esc (zeile SUB anweisungs anfang - 3) + THEN zeichen davor := subtext (zeile, anweisungs anfang - 3, + anweisungs anfang - 2); + ELSE zeichen davor := zeile SUB anweisungs anfang - 2; + FI; + IF is kanji esc (zeile SUB anweisungs ende + 2) + THEN zeichen dahinter := subtext (zeile, anweisungs ende + 2, + anweisungs ende + 3 ); + ELSE zeichen dahinter := zeile SUB anweisungs ende + 2; + FI; + IF pos (" #", zeichen davor) = 0 AND pos (" #", zeichen dahinter) = 0 + THEN breite davor := char pitch (a font, zeichen davor); + breite dahinter := char pitch (a font, zeichen dahinter); + IF breite davor < breite dahinter THEN vertausche zeichen FI; + lege token fuer zeichen dahinter an; + a xpos INCR (breite davor - breite dahinter) DIV 2; + FI; + FI; + + . zeichen davor : par1 + . zeichen dahinter : par2 + + . vertausche zeichen : + change (zeile, anweisungs anfang - 2 - LENGTH zeichen davor + 1, + anweisungs anfang - 2, zeichen dahinter); + change (zeile, anweisungs ende + 2, + anweisungs ende + 2 + LENGTH zeichen dahinter - 1, zeichen davor); + change (tf. text, LENGTH tf. text - LENGTH zeichen davor + 1, + LENGTH tf. text, zeichen dahinter); + tf. breite INCR (breite dahinter - breite davor); + a xpos INCR (breite dahinter - breite davor); + int param := breite davor; + breite davor := breite dahinter; + breite dahinter := int param; + + . lege token fuer zeichen dahinter an : + token zeiger := zeilen pos; + a breite := breite dahinter; + zeilen pos INCR LENGTH zeichen dahinter; + a xpos DECR (breite davor + breite dahinter) DIV 2; + lege text token an; + anzahl zeichen DECR 1; + + . fillchar anweisung : + IF par1 = "" THEN par1 := " " FI; + fill char := par1; + speichere anweisung; + + . mark anweisung : + IF par1 <> "" + THEN mark index l := (alter mark index l MOD 2) + 1; + neue markierung (par1, mark index l); + ELSE mark index l := 0; + FI; + IF par2 <> "" + THEN mark index r := (alter mark index r MOD 2) + 3; + neue markierung (par2, mark index r); + ELSE mark index r := 0; + FI; + + . markend anweisung : + loesche markierung; + + . speichere anweisung : + anweisungs zaehler INCR 1; + anweisungs indizes CAT anweisungs index; + IF par1 <> "" + THEN insert (params1, par1); + params1 zeiger CAT highest entry (params1); + ELSE params1 zeiger CAT 0; + FI; + IF par2 <> "" + THEN insert (params2, par2); + params2 zeiger CAT highest entry (params2); + ELSE params2 zeiger CAT 0; + FI; + +END PROC analysiere anweisung; + + +PROC stelle neuen font ein (INT CONST font nr ) : + + IF font nr <> a font THEN neuer font FI; + + . neuer font : + a font := max (1, font nr); + get font (a font, einrueckbreite, font durchschuss, font hoehe, font tiefe, + zeichenbreiten); + font hoehe INCR (font durchschuss + font tiefe); + letzte zeilenhoehe := neue zeilenhoehe; + blankbreite := zeichenbreiten (blank code 1); + zeichenbreiten (blank code 1) := blank ausgang; + zeichenbreiten (anweisungs zeichen code 1) := anweisungs ausgang; + font offsets := y offsets (a font); + offsets := LENGTH font offsets > 2; + IF d code 1 <> leer + THEN d pitch := zeichenbreiten (d code 1); + zeichenbreiten (d code 1) := d code ausgang; + FI; + +END PROC stelle neuen font ein; + + +INT OP PROZENT (INT CONST prozent, wert) : + + (wert * prozent + 99) DIV 100 + +END OP PROZENT; + + +PROC neue markierung (TEXT CONST text, INT CONST mark index) : + + mark token (mark index). text := text; + mark token (mark index). breite := string breite (text); + mark token (mark index). font := a font; + mark token (mark index). modifikationen := a modifikationen; + +END PROC neue markierung; + + +INT PROC string breite (TEXT CONST string) : + + INT VAR summe := 0, pos := 1; + REP stranalyze (zeichenbreiten, summe, max breite, string, pos, maxint, ausgang); + IF ausgang = erweiterungs ausgang + THEN summe INCR extended char pitch (a font, + string SUB pos+1, string SUB pos+2); + pos INCR 3; + ELIF ausgang = blank ausgang + THEN summe INCR blankbreite; + pos INCR 2; + ELIF ausgang = anweisungs ausgang + THEN summe INCR char pitch (a font, anweisungszeichen); + pos INCR 2; + ELSE LEAVE string breite WITH summe + FI; + PER; + 0 + +END PROC string breite; + +(*******************************************************************) + +PROC lege text token an : + + aktuelle ypos := a ypos + (font offsets ISUB 1); + neuer token index; + uebertrage text token (tf); + IF offsets THEN lege offsets an (font offsets) FI; + stranalyze (zeichen zaehler, anzahl zeichen, max int, + zeile, token zeiger, zeilen pos - 1, ausgang); + a xpos INCR a breite; + a breite := 0; + a modifikationen fuer x move := 0; + a block token := FALSE; + +END PROC lege text token an; + + +PROC uebertrage text token (TOKEN VAR tf) : + + tf. text := subtext (zeile, token zeiger, zeilenpos - 1); + tf. xpos := a xpos; + tf. breite := a breite; + tf. font := a font; + tf. modifikationen := a modifikationen; + tf. modifikationen fuer x move := a modifikationen fuer x move; + tf. offset index := text token; + tf. block token := a block token; + +END PROC uebertrage text token; + + +PROC lege kommando token an : + + aktuelle ypos := a ypos + (font offsets ISUB 1); + neuer token index; + uebertrage kommando token (tf); + a modifikationen fuer x move := 0; + a block token := FALSE; + +END PROC lege kommando token an; + + +PROC uebertrage kommando token (TOKEN VAR tf) : + + tf. text := anweisung; + tf. breite := 0; + tf. xpos := a xpos; + tf. font := a font; + tf. modifikationen := a modifikationen; + tf. modifikationen fuer x move := a modifikationen fuer x move; + tf. offset index := kommando token; + tf. block token := a block token; + +END PROC uebertrage kommando token; + + +PROC lege markierungs token an (INT CONST mark index) : + + aktuelle ypos := a ypos + (mark font offsets ISUB 1); + neuer token index; + tf := mark token (mark index); + IF mark offsets THEN lege offsets an (mark font offsets) FI; + + . mark font offsets : y offsets (mark token (mark index). font) + + . mark offsets : LENGTH mark font offsets > 2 + +END PROC lege markierungs token an; + + +PROC lege offsets an (TEXT CONST offsets) : + + INT CONST anzahl offsets := LENGTH offsets DIV 2; + offset token := tf; + offset token. block token := FALSE; + reset bit (offset token. modifikationen, underline bit); + FOR index FROM 2 UPTO anzahl offsets + REP aktuelle ypos := a ypos + (offsets ISUB index); + neuer token index; + tf := offset token; + tf. offset index := index; + PER; + +END PROC lege offsets an; + + +PROC neuer token index : + +IF erster ypos index a = 0 + THEN erste ypos +ELIF ya. ypos = aktuelle ypos + THEN neues token bei gleicher ypos + ELSE fuege neue ypos ein +FI; + + . erste ypos : + ypos index f INCR 1; + erster ypos index a := ypos index f; + letzter ypos index a := ypos index f; + yf. vorheriger ypos index := 0; + yf. naechster ypos index := 0; + erstes token bei neuer ypos; + + . fuege neue ypos ein : + letztes token bei gleicher ypos; + IF ya. ypos > aktuelle ypos + THEN richtige ypos ist oberhalb + ELSE richtige ypos ist unterhalb + FI; + + . richtige ypos ist oberhalb : + REP ypos index a := ya. vorheriger ypos index; + IF ypos index a = 0 + THEN fuege ypos vor erstem ypos index ein; + LEAVE richtige ypos ist oberhalb; + ELIF ya. ypos = aktuelle ypos + THEN neues token bei neuer ypos; + LEAVE richtige ypos ist oberhalb; + ELIF ya. ypos < aktuelle ypos + THEN fuege ypos nach ypos index ein; + LEAVE richtige ypos ist oberhalb; + FI; + PER; + + . richtige ypos ist unterhalb : + REP ypos index a := ya. naechster ypos index; + IF ypos index a = 0 + THEN fuege ypos nach letztem ypos index ein; + LEAVE richtige ypos ist unterhalb; + ELIF ya. ypos = aktuelle ypos + THEN neues token bei neuer ypos; + LEAVE richtige ypos ist unterhalb; + ELIF ya. ypos > aktuelle ypos + THEN fuege ypos vor ypos index ein; + LEAVE richtige ypos ist unterhalb; + FI; + PER; + + . fuege ypos vor erstem ypos index ein : + ypos index f INCR 1; + yf. vorheriger ypos index := 0; + yf. naechster ypos index := erster ypos index a; + erster ypos index a := ypos index f; + ypos index a := yf. naechster ypos index; + ya. vorheriger ypos index := ypos index f; + erstes token bei neuer ypos; + + . fuege ypos nach ypos index ein : + ypos index f INCR 1; + yf. vorheriger ypos index := ypos index a; + yf. naechster ypos index := ya. naechster ypos index; + ya. naechster ypos index := ypos index f; + ypos index a := yf. naechster ypos index; + ya. vorheriger ypos index := ypos index f; + erstes token bei neuer ypos; + + . fuege ypos vor ypos index ein : + ypos index f INCR 1; + yf. naechster ypos index := ypos index a; + yf. vorheriger ypos index := ya. vorheriger ypos index; + ya. vorheriger ypos index := ypos index f; + ypos index a := yf. vorheriger ypos index; + ya. naechster ypos index := ypos index f; + erstes token bei neuer ypos; + + . fuege ypos nach letztem ypos index ein : + ypos index f INCR 1; + yf. naechster ypos index := 0; + yf. vorheriger ypos index := letzter ypos index a; + letzter ypos index a := ypos index f; + ypos index a := yf. vorheriger ypos index; + ya. naechster ypos index := ypos index f; + erstes token bei neuer ypos; + +END PROC neuer token index; + + +PROC erstes token bei neuer ypos : + token index f INCR 1; + ypos index a := ypos index f; + ya. erster token index := token index f; + ya. ypos := aktuelle ypos; +END PROC erstes token bei neuer ypos; + + +PROC neues token bei neuer ypos : + token index f INCR 1; + ya. ypos := aktuelle ypos; + token index := ya. letzter token index; + t. naechster token index := token index f; +END PROC neues token bei neuer ypos; + + +PROC neues token bei gleicher ypos : + tf. naechster token index := token index f + 1; + token index f INCR 1; +END PROC neues token bei gleicher ypos; + + +PROC letztes token bei gleicher ypos : + tf. naechster token index := 0; + ya. letzter token index := token index f; +END PROC letztes token bei gleicher ypos; + + +PROC loesche letztes token : + + IF token index f = ya. erster token index + THEN loesche ypos + ELSE token index f DECR 1; + FI; + + . loesche ypos : + kette vorgaenger um; + kette nachfolger um; + bestimme letzten ypos index; + + . kette vorgaenger um : + ypos index := ya. vorheriger ypos index; + IF ypos index = 0 + THEN erster ypos index a := ya. naechster ypos index; + ELSE y. naechster ypos index := ya. naechster ypos index; + FI; + + . kette nachfolger um : + ypos index := ya. naechster ypos index; + IF ypos index = 0 + THEN letzter ypos index a := ya. vorheriger ypos index; + ELSE y. vorheriger ypos index := ya. vorheriger ypos index; + FI; + + . bestimme letzten ypos index : + IF ypos index a = ypos index f THEN ypos index f DECR 1 FI; + token index f DECR 1; + ypos index a := letzter ypos index a; + WHILE ypos index a <> 0 + CAND ya. letzter token index <> token index f + REP ypos index a := ya. vorheriger ypos index PER; + +END PROC loesche letztes token; + + +PROC blocke token xpos (INT CONST dehnung 1, dehnung 2, + anzahl dehnungen fuer dehnung 1 ) : + + INT VAR dehnung := 0, anzahl dehnungen := 0; + token index := erstes tab token; + WHILE token index <= token index f + REP erhoehe token xpos bei block token; + t. xpos INCR dehnung; + token index INCR 1; + PER; + + . erhoehe token xpos bei block token : + IF t. block token + THEN IF anzahl dehnungen < anzahl dehnungen fuer dehnung 1 + THEN anzahl dehnungen INCR 1; + dehnung INCR dehnung 1; + ELSE dehnung INCR dehnung 2; + FI; + FI; + +END PROC blocke token xpos; + + +PROC verschiebe token xpos (INT CONST verschiebung) : + + token index := erstes tab token; + WHILE token index <= token index f + REP t. xpos INCR verschiebung; + token index INCR 1; + PER; + +END PROC verschiebe token xpos; + + +PROC verschiebe token ypos (INT CONST verschiebung) : + + ypos index := erster ypos index a; + WHILE ypos index <> 0 + REP y. ypos INCR verschiebung; + ypos index := y. naechster ypos index; + PER; + +END PROC verschiebe token ypos; + + +PROC sortiere neue token ein : + +IF analysespeicher ist nicht leer + THEN IF druckspeicher ist nicht leer + THEN sortiere neue token in sortierte liste ein + ELSE sortierte liste ist leer + FI; +FI; + +. sortierte liste ist leer : + IF erster ypos index a <> 0 + THEN erster ypos index d := erster ypos index a; + letzter ypos index d := letzter ypos index a; + ypos index d := letzter ypos index a; + FI; + +. sortiere neue token in sortierte liste ein : + gehe zum ersten neuen token; + bestimme erste einsortierposition; + WHILE es gibt noch neue token + REP IF ypos index d = 0 + THEN haenge neue token ans ende der sortierten liste + ELIF ya. ypos > yd. ypos + THEN naechste ypos der sortierten liste + ELIF ya. ypos = yd. ypos + THEN neues token auf gleicher ypos + ELSE neue token vor ypos + FI; + PER; + + . gehe zum ersten neuen token : + ypos index a := erster ypos index a; + + . bestimme erste einsortierposition : + WHILE ypos index d <> 0 CAND ya. ypos < yd. ypos + REP ypos index d := yd. vorheriger ypos index PER; + IF ypos index d = 0 THEN erste neue token vor listen anfang FI; + + . erste neue token vor listen anfang : + ypos index d := erster ypos index d; + erster ypos index d := erster ypos index a; + REP ypos index a := ya. naechster ypos index; + IF ypos index a = 0 + THEN verkette letztes ya mit yd; + LEAVE sortiere neue token in sortierte liste ein + ELIF ya. ypos = yd. ypos + THEN verkette ya mit yd; + LEAVE erste neue token vor listen anfang + ELIF ya. ypos > yd. ypos + THEN verkette vorheriges ya mit yd; + ypos index d := yd. naechster ypos index; + LEAVE erste neue token vor listen anfang + FI; + PER; + + . es gibt noch neue token : + ypos index a <> 0 + + . haenge neue token ans ende der sortierten liste : + ypos index d := letzter ypos index d; + yd. naechster ypos index := ypos index a; + ya. vorheriger ypos index := ypos index d; + letzter ypos index d := letzter ypos index a; + ypos index d := letzter ypos index a; + ypos index a := 0; + + . naechste ypos der sortierten liste : + ypos index d := yd. naechster ypos index; + + . neues token auf gleicher ypos : + token index := yd. letzter token index; + t . naechster token index := ya. erster token index; + yd. letzter token index := ya. letzter token index; + ypos index a := ya. naechster ypos index; + ypos index d := yd. naechster ypos index; + IF ypos index d = 0 THEN ypos index d := letzter ypos index d FI; + + . neue token vor ypos : + verkette ya mit vorherigem yd; + REP ypos index a := ya. naechster ypos index; + IF ypos index a = 0 + THEN verkette letztes ya mit yd; + LEAVE sortiere neue token in sortierte liste ein + ELIF ya. ypos = yd. ypos + THEN verkette ya mit yd; + LEAVE neue token vor ypos + ELIF ya. ypos > yd. ypos + THEN verkette vorheriges ya mit yd; + ypos index d := yd. naechster ypos index; + LEAVE neue token vor ypos + FI; + PER; + + +. verkette ya mit vorherigem yd : + index := ypos index d; + ypos index d := yd. vorheriger ypos index; + yd. naechster ypos index := ypos index a; + ya. vorheriger ypos index := ypos index d; + ypos index d := index; + +. verkette letztes ya mit yd : + ypos index a := letzter ypos index a; + yd. vorheriger ypos index := ypos index a; + ya. naechster ypos index := ypos index d; + ypos index a := 0; + +. verkette vorheriges ya mit yd : + index := ypos index a; + ypos index a := ya. vorheriger ypos index; + yd. vorheriger ypos index := ypos index a; + ya. naechster ypos index := ypos index d; + ypos index a := index; + +. verkette ya mit yd : + verkette vorheriges ya mit yd; + neues token auf gleicher ypos; + +END PROC sortiere neue token ein; + +(***************************************************************) + +PROC drucke tokenspeicher + (INT CONST max ypos, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + +IF druckspeicher ist nicht leer + THEN gehe zur ersten ypos; + WHILE yd. ypos <= max ypos + REP drucke token bei ypos; + gehe zur naechsten ypos; + PER; + loesche gedruckte token; +FI; + +. gehe zur ersten ypos : + ypos index d := erster ypos index d; + +. drucke token bei ypos : + IF yd. ypos >= - y start + THEN druck durchgang; + IF bold pass THEN fett durchgang FI; + IF underline pass THEN unterstreich durchgang FI; + FI; + + . bold pass : bit (pass, bold bit) + + . underline pass : bit (pass, underline bit) + +. gehe zur naechsten ypos : + IF ypos index d = letzter ypos index d + THEN loesche druckspeicher; + LEAVE drucke tokenspeicher; + FI; + ypos index d := yd. naechster ypos index; + +. loesche gedruckte token : + erster ypos index d := ypos index d; + yd. vorheriger ypos index := 0; + +. + druck durchgang : + verschiebung := yd. ypos - d ypos; + y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + gehe zum ersten token dieser ypos; + REP drucke token UNTIL kein token mehr vorhanden PER; + gib cr aus; + + . drucke token : + IF NOT token passt in zeile THEN berechne token teil FI; + font wechsel wenn noetig; + x move mit modifikations ueberpruefung; + IF token ist text token + THEN gib text token aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + ELSE gib kommando token aus + FI; + + . gib kommando token aus : + execute (write cmd, d token. text, 1, LENGTH d token. text) + + . berechne token teil : + INT CONST fuenf punkte := 5 * char pitch (d token. font, punkt); + INT VAR token pos, token breite, anzahl punkte, zeichen laenge, zeichen breite; + IF d token. xpos < - x start + AND d token. xpos + d token. breite > - x start + THEN berechne token teil von links + ELIF d token. xpos < papierbreite + AND d token. xpos + d token. breite > papierbreite + THEN berechne token teil nach rechts + ELSE LEAVE drucke token + FI; + + . berechne token teil von links : + rest := min (x size, d token. xpos + d token. breite + x start); + d token. xpos := - x start; + IF rest <= fuenf punkte + THEN anzahl punkte := rest DIV char pitch (d token. font, punkt); + d token. text := anzahl punkte * punkt; + d token. breite := anzahl punkte * char pitch (d token. font, punkt); + ELSE token pos := LENGTH d token. text + 1; + token breite := fuenf punkte; + berechne token teil breite von hinten; + change (d token. text, 1, token pos - 1, 5 * punkt); + d token. breite := token breite; + FI; + + . berechne token teil breite von hinten : + WHILE naechstes zeichen passt noch davor + REP token breite INCR zeichen breite; + token pos DECR zeichen laenge; + PER; + + . naechstes zeichen passt noch davor : + IF within kanji (d token. text, token pos - 1) + THEN zeichen laenge := 2 + ELSE zeichen laenge := 1 + FI; + zeichen breite := char pitch (d token. font, + subtext (d token. text, token pos - zeichen laenge, token pos - 1)); + token breite + zeichen breite < rest + + . berechne token teil nach rechts : + rest := papier breite - d token. xpos; + IF rest <= fuenf punkte + THEN anzahl punkte := rest DIV char pitch (d token. font, punkt); + d token. text := anzahl punkte * punkt; + d token. breite := anzahl punkte * char pitch (d token. font, punkt); + ELSE token pos := 0; + token breite := fuenf punkte; + berechne token teil breite von vorne; + change (d token. text, token pos + 1, LENGTH d token. text, 5 * punkt); + d token. breite := token breite; + FI; + + . berechne token teil breite von vorne : + WHILE naechstes zeichen passt noch dahinter + REP token breite INCR zeichen breite; + token pos INCR zeichen laenge; + PER; + + . naechstes zeichen passt noch dahinter : + IF is kanji esc (d token. text SUB token pos + 1) + THEN zeichen laenge := 2 + ELSE zeichen laenge := 1 + FI; + zeichen breite := char pitch (d token. font, + subtext (d token. text, token pos + 1, token pos + zeichen laenge)); + token breite + zeichen breite < rest + +. + fett durchgang : + reset bit (pass, bold bit); + gehe zum ersten token dieser ypos; + REP gib token nochmal aus UNTIL kein token mehr vorhanden PER; + schalte modifikationen aus wenn noetig; + gib cr aus; + + . gib token nochmal aus : + INT CONST min verschiebung := bold offset (d token. font); + d token. xpos INCR min verschiebung; + IF bit (d token. modifikationen, bold bit) AND + token passt in zeile AND token ist text token + THEN verschiebung := d token. xpos - d xpos; + font wechsel wenn noetig; + schalte italics ein wenn noetig; + x move wenn noetig; + gib text token aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + d token. xpos DECR min verschiebung; + + . schalte italics ein wenn noetig : + IF bit (d token. modifikationen, italics bit) + THEN neue modifikationen := modifikations werte (italics bit + 1); + schalte modifikationen ein wenn noetig; + ELSE schalte modifikationen aus wenn noetig; + FI; + +. + unterstreich durchgang : + INT VAR l xpos := 0; + reset bit (pass, underline bit); + schalte modifikationen aus wenn noetig; + gehe zum ersten token dieser ypos; + REP unterstreiche token UNTIL kein token mehr vorhanden PER; + gib cr aus; + + . unterstreiche token : + IF token muss unterstrichen werden AND + token passt in zeile AND token ist text token + THEN font wechsel wenn noetig; + berechne x move laenge; + x move wenn noetig; + berechne unterstreich laenge; + unterstreiche; + FI; + l xpos := d token. xpos + d token. breite; + + . token muss unterstrichen werden : + bit (d token. modifikationen, underline bit) OR + bit (d token. modifikationen fuer x move, underline bit) + + . berechne x move laenge : + IF bit (d token. modifikationen fuer x move, underline bit) + THEN verschiebung := l xpos - d xpos + ELSE verschiebung := d token. xpos - d xpos + FI; + + . berechne unterstreich laenge : + INT VAR unterstreich verschiebung; + IF bit (d token. modifikationen, underline bit) + THEN unterstreich verschiebung := d token. xpos + + d token. breite - d xpos + ELSE unterstreich verschiebung := d token. xpos - d xpos + FI; + + +. gehe zum ersten token dieser ypos : + token index := yd. erster token index; + d token := t; + +. kein token mehr vorhanden : + token index := d token. naechster token index; + IF token index = 0 + THEN TRUE + ELSE d token := t; + FALSE + FI + +. token ist text token : + d token. offset index >= text token + +. token passt in zeile : + d token. xpos >= - x start AND + d token. xpos + d token. breite <= papier breite + +. font wechsel wenn noetig : + IF d token. font <> d font + THEN font wechsel (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; + +. schalte modifikationen ein wenn noetig : + IF d modifikationen <> neue modifikationen + THEN schalte modifikationen ein (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; + +. schalte modifikationen aus wenn noetig : + IF d modifikationen <> 0 + THEN schalte modifikationen aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; + +. x move wenn noetig : + IF verschiebung <> 0 + THEN x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) FI; + +. gib cr aus : + execute (carriage return, "", d xpos, 0); + d xpos := 0; + +. + x move mit modifikations ueberpruefung : + verschiebung := d token. xpos - d xpos; + IF verschiebung <> 0 + THEN neue modifikationen := d token. modifikationen fuer x move; + schalte modifikationen ein wenn noetig; + x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + neue modifikationen := d token. modifikationen; + schalte modifikationen ein wenn noetig; + +. + unterstreiche : + IF unterstreich verschiebung > 0 + THEN disable stop; + d xpos INCR unterstreich verschiebung; + execute (draw, "", unterstreich verschiebung, 0); + IF is error + THEN unterstreiche nach cr; + FI; + enable stop; + FI; + + . unterstreiche nach cr : + clear error; + d xpos DECR unterstreich verschiebung; + verschiebung := d xpos; + gib cr aus; + x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + d xpos INCR unterstreich verschiebung; + execute (draw, "", unterstreich verschiebung, 0); + IF is error + THEN clear error; + d xpos DECR unterstreich verschiebung; + gib cr aus; + LEAVE unterstreich durchgang; + FI; + +END PROC drucke tokenspeicher; + +PROC y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + IF verschiebung <> 0 + THEN disable stop; + d ypos INCR verschiebung; + execute (move, "", 0, verschiebung); + IF is error + THEN clear error; + d ypos DECR verschiebung; + verschiebung := 0; + FI; + enable stop; + FI; + +END PROC y move; + + +PROC x move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + disable stop; + d xpos INCR verschiebung; + execute (move, "", verschiebung, 0); + IF is error + THEN fuehre x move nach cr aus + FI; + + . fuehre x move nach cr aus : + clear error; + schalte modifikationen aus wenn noetig; + gib cr aus; + IF d xpos <> 0 + THEN execute (move, "", d xpos, 0); + IF is error + THEN clear error; + d xpos := 0; + FI + FI; + schalte modifikationen ein wenn noetig; + + . gib cr aus : + execute (carriage return, "", d xpos - verschiebung, 0); + + . schalte modifikationen aus wenn noetig : + neue modifikationen := d modifikationen; + IF d modifikationen <> 0 + THEN schalte modifikationen aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + + . schalte modifikationen ein wenn noetig : + IF d modifikationen <> neue modifikationen + THEN schalte modifikationen ein + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + +END PROC x move; + + +PROC schalte modifikationen ein + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + disable stop; + INT VAR index; + IF d modifikationen <> 0 + THEN schalte modifikationen aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + d modifikationen := neue modifikationen; + FOR index FROM 1 UPTO anzahl modifikationen + REP IF bit (d modifikationen, modifikations bit) + THEN modifikation muss eingeschaltet werden + FI; + PER; + + . modifikations bit : index - 1 + + . modifikation muss eingeschaltet werden : + IF bit (modifikations modus, modifikations bit) + THEN execute (on, "", modifikations werte (index), 0); + IF is error + THEN clear error; + reset bit (modifikations modus, modifikations bit); + set bit (pass, modifikations bit); + FI; + ELSE set bit (pass, modifikations bit); + FI; + +END PROC schalte modifikationen ein; + + +PROC schalte modifikationen aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + disable stop; + INT VAR index; + FOR index FROM 1 UPTO anzahl modifikationen + REP IF bit (d modifikationen, modifikations bit) + THEN modifikation muss ausgeschaltet werden + FI; + PER; + d modifikationen := 0; + + . modifikations bit : index - 1 + + . modifikation muss ausgeschaltet werden : + IF bit (modifikations modus, modifikations bit) + THEN execute (off, "", modifikations werte (index), 0); + IF is error THEN clear error FI; + FI; + +END PROC schalte modifikationen aus; + + +PROC font wechsel + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + disable stop; + d font := d token. font; + get replacements (d font, replacements, replacement tabelle); + execute (type, "", d font, 0); + IF is error THEN font wechsel nach cr FI; + enable stop; + + . font wechsel nach cr : + clear error; + verschiebung := d xpos; + gib cr aus; + execute (type, "", d font, 0); + IF NOT is error + THEN schalte modifikationen aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + x move + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + + . gib cr aus : + execute (carriage return, "", d xpos, 0); + d xpos := 0; + +END PROC font wechsel; + + +PROC gib text token aus + (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + + INT CONST token laenge := LENGTH d token. text; + INT VAR token pos := 1, alte token pos, summe := 0; + IF token laenge > 0 + THEN REP alte token pos := token pos; + stranalyze (replacement tabelle, summe, 0, + d token. text, token pos, token laenge, + ausgang); + IF ausgang = 0 + THEN gib token rest aus; + ELSE gib token teil aus; + gib ersatzdarstellung aus; + FI; + PER; + FI; + + . gib token rest aus : + IF token laenge >= alte token pos + THEN execute (write text, d token. text, alte token pos, token laenge) FI; + d xpos INCR d token. breite; + LEAVE gib text token aus; + + . gib token teil aus : + IF token pos >= alte token pos + THEN execute (write text, d token. text, alte token pos, token pos) FI; + + . gib ersatzdarstellung aus : + IF ausgang = maxint + THEN ersatzdarstellung := extended replacement (d token. font, + d token. text SUB token pos + 1, d token. text SUB token pos + 2); + execute (write text, ersatzdarstellung, 1, LENGTH ersatzdarstellung); + tokenpos INCR 3; + ELSE IF ausgang < 0 + THEN ausgang := ausgang XOR (-32767-1); + token pos INCR 1; + FI; + execute (write text, replacements, ausgang + 1, ausgang + code (replacements SUB ausgang)); + token pos INCR 2; + FI; + + . ersatzdarstellung : par1 + +END PROC gib text token aus; + + +PROC schliesse seite ab (PROC (INT CONST, INT CONST) close, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + +enable stop; +gebe restliche token aus; +seiten ende kommando; + +. gebe restliche token aus : + IF erster ypos index d <> 0 + THEN drucke tokenspeicher (maxint, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + FI; + rest := papier laenge - d ypos; + +. seiten ende kommando : + seite ist offen := FALSE; + a ypos := top margin; + aktuelle spalte := 1; + close (page, rest); + +END PROC schliesse seite ab; + + +PROC eroeffne seite (INT CONST x wanted, y wanted, + PROC (INT CONST, INT VAR, INT VAR) open ) : + +IF vor erster seite THEN eroeffne druck FI; +seiten anfang kommando; +initialisiere neue seite; + +. eroeffne druck : + open (document, x size, y size); + vor erster seite := FALSE; + d font := -1; + d modifikationen := 0; + +. seiten anfang kommando : + x start := x wanted; + y start := y wanted; + open (page, x start, y start); + gedruckte seiten INCR 1; + seite ist offen := TRUE; + +. initialisiere neue seite : + INT CONST dif left margin := x wanted - x start - left margin + indentation, + dif top margin := y wanted - y start - top margin; + IF dif left margin <> 0 + THEN erstes tab token := 1; + verschiebe token xpos (dif left margin); + a xpos INCR dif left margin; + left margin INCR dif left margin; + FI; + IF dif top margin <> 0 + THEN verschiebe token ypos (dif top margin); + a ypos INCR dif top margin; + top margin INCR dif top margin; + FI; + d xpos := 0; + d ypos := 0; + IF seitenlaenge <= papierlaenge + THEN seitenlaenge := top margin + pagelength; + ELSE seitenlaenge DECR papierlaenge; + FI; + papierlaenge := y size - y start; + papierbreite := x size - x start; + +END PROC eroeffne seite; + +(****************************************************************) + +PROC elan fuss und kopf (INT CONST fuss oder kopf, + PROC (INT CONST, INT CONST) close, + PROC (INT CONST, INT VAR, INT VAR) open, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + +IF fuss oder kopf <= 0 THEN elan fuss FI; +IF fuss oder kopf >= 0 THEN elan kopf FI; + +. + elan fuss : + y move zur fusszeile; + drucke elan fuss; + close page cmd; + +. y move zur fusszeile : + execute (carriage return, "", d xpos, 0); + d xpos := 0; + verschiebung := rest auf seite - font hoehe; + y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +. drucke elan fuss : + IF bottom label = "" + THEN seiten nr := "" + ELSE seiten nr := bottom label; + seiten nr CAT "/"; + FI; + seiten nr CAT text (gedruckte seiten); + elan text := seiten nr; + elan text CAT " "; + elan text cat blanks ((max zeichen fuss - LENGTH dateiname) DIV 2 - LENGTH elan text); + elan text CAT dateiname; + elan text cat blanks (max zeichen fuss - LENGTH seiten nr - LENGTH elan text - 3); + elan text CAT " "; + elan text CAT seiten nr; + IF LENGTH elan text > max zeichen zeile + THEN elan text := subtext (elan text, 1, max zeichen zeile) FI; + gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + + . seiten nr : par1 + +. close page cmd : + close (page, papierlaenge - d ypos); + seite ist offen := FALSE; + +. + elan kopf : + open page cmd ; + y move zur kopfzeile; + drucke elan kopf; + +. open page cmd : + x start := x wanted; + y start := y wanted; + open (page, x start, y start); + IF fuss oder kopf = 1 THEN execute (type, "", d font, 0) FI; + gedruckte seiten INCR 1; + seite ist offen := TRUE; + top margin := y wanted - y start; + left margin := x wanted - x start; + rest auf seite := pagelength; + papierlaenge := y size - y start; + d ypos := 0; + d xpos := 0; + +. y move zur kopf zeile : + verschiebung := top margin; + y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + IF verschiebung = 0 THEN rest auf seite INCR top margin FI; + +. drucke elan kopf : + elan text := headline pre; + elan text CAT date; + elan text CAT headline post; + elan text CAT datei name; + IF LENGTH elan text > max zeichen zeile + THEN elan text := subtext (elan text, 1, max zeichen zeile) FI; + gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + cr plus lf (2, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +ENDPROC elan fuss und kopf; + + +PROC gib elan text aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + +cr plus lf (1, PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); +linker rand wenn noetig; +d token. breite := LENGTH elan text * einrueckbreite; +gib text token aus (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +. linker rand wenn noetig : + IF left margin > 0 + THEN disable stop; + d xpos := left margin; + execute (move, "", left margin, 0); + IF is error + THEN clear error; + d xpos := 0; + FI; + enable stop; + FI; + +END PROC gib elan text aus; + + +PROC cr plus lf (INT CONST anzahl, + PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute) : + +gib cr aus; +gib lf aus; +rest auf seite DECR verschiebung; + +. gib cr aus : + execute (carriage return, "", d xpos, 0); + d xpos := 0; + +. gib lf aus : + verschiebung := anzahl * font hoehe; + y move (PROC (INT CONST, TEXT CONST, INT CONST, INT CONST) execute); + +END PROC cr plus lf ; + + +END PACKET eumel printer; diff --git a/system/std.zusatz/1.7.5/src/font convertor 9 b/system/std.zusatz/1.7.5/src/font convertor 9 new file mode 100644 index 0000000..22ce9af --- /dev/null +++ b/system/std.zusatz/1.7.5/src/font convertor 9 @@ -0,0 +1,1065 @@ +PACKET font convertor (* Autor : Rudolf Ruland *) + (* Stand : 11.07.86 *) + DEFINES create font table , (* Version 9 *) + add fonts, + create font file : + + +LET t tag = 1, + t bold = 2, + t number = 3, + t text = 4, + t operator = 5, + t delimiter = 6, + t end of file = 7, + + nil modus = 0, + font table modus = 1, + font modus = 2, + extension modus = 3, + + x unit = 1, + y unit = 2, + on string = 3, + off string = 4, + indentation pitch = 5, + font lead = 6, + font height = 7, + font depth = 8, + larger font = 9, + smaller font = 10, + font string = 11, + y off sets = 12, + bold off set = 13; + +THESAURUS VAR names, english identification := empty thesaurus, + german identification := empty thesaurus; + +insert (english identification, "xunit"); +insert (english identification, "yunit"); +insert (english identification, "onstring"); +insert (english identification, "offstring"); +insert (english identification, "indentationpitch"); +insert (english identification, "fontlead"); +insert (english identification, "fontheight"); +insert (english identification, "fontdepth"); +insert (english identification, "nextlargerfont"); +insert (english identification, "nextsmallerfont"); +insert (english identification, "fontstring"); +insert (english identification, "yoffsets"); +insert (english identification, "boldoffset"); + +insert (german identification, "xeinheit"); +insert (german identification, "yeinheit"); +insert (german identification, "onsequenz"); +insert (german identification, "offsequenz"); +insert (german identification, "einrueckbreite"); +insert (german identification, "durchschuss"); +insert (german identification, "fonthoehe"); +insert (german identification, "fonttiefe"); +insert (german identification, "groessererfont"); +insert (german identification, "kleinererfont"); +insert (german identification, "fontsequenz"); +insert (german identification, "yverschiebungen"); +insert (german identification, "boldverschiebung"); + +INT VAR modus, last modus, symbol type, int symbol, pitch, + identification nr, link nr, extension code 1, + char code 1, char code, char pos, vorzeichen, + replacements length, index; +TEXT VAR symbol, font table name, replacement, char, buffer, z; +BOOL VAR english; +FILE VAR file, font file; + +(*****************************************************************) + +LET max fonts = 50, + max extensions = 120, + font table type = 3009, + + FONTTABLE = STRUCT ( + + THESAURUS font names, + + TEXT replacements, font name links, + extension chars, extension indexes, + + ROW 4 TEXT on strings, off strings, + + REAL x unit, y unit, + + ROW 256 INT replacements table, + + INT last font, last extension + + ROW max fonts STRUCT ( + TEXT font string, font name indexes, replacements, + extension chars, extension indexes, y offsets, + ROW 256 INT pitch table, replacements table, + INT indentation pitch, font lead, font height, font depth, + next larger font, next smaller font, bold offset ) fonts , + + ROW max extensions STRUCT ( + TEXT replacements, + ROW 256 INT pitch table, replacements table, + INT std pitch ) extensions , + + ); + +BOUND FONTTABLE VAR font table; + +DATASPACE VAR ds; + +INT VAR font nr, extension nr; + +. font : font table. fonts (font nr) +. extension : font table. extensions (extension nr) +. line nr : line no (file) - 1 +.; + +(*****************************************************************) + + +PROC create font table : + + create font table (last param) + +END PROC create font table; + + +PROC create font table (TEXT CONST font file) : + +file := sequential file (input, font file); +disable stop; +ds := nilspace; +modus := nil modus; +load; +IF is error THEN error (errormessage) FI; +forget (ds); + +END PROC create font table; + + +PROC add fonts (TEXT CONST font tab name, font file) : + +file := sequential file (input, font file); +font table name := font tab name; +change all (font table name, " ", ""); +IF NOT exists (font table name) COR type (old (font table name)) <> font table type + THEN errorstop ("Fonttabelle """ + font table name + """ gibt es nicht") +FI; +disable stop; +ds := old (font table name); +fonttable := ds; +modus := font modus; +font nr := fonttable. last font; +extension nr := fonttable. last extension; +load; +IF is error THEN error (errormessage) FI; +forget (ds); + +END PROC add fonts; + + +PROC load : + +enable stop; +initialize loading; +REP get kennung; + get identification; + get char specifications; +UNTIL eof (file) OR symbol type = t end of file PER; +font table found; + +. initialize loading : + scan (file); + get next symbol; + +. font table found : + IF font nr = 0 + THEN errorstop ("Fonts zur Fonttabelle """ + + font table name + """ fehlen"); + ELSE font table. last font := font nr; + font table. last extension := extension nr; + forget (font table name, quiet); + copy (ds, font table name); + type (old (font table name), font table type); + forget (ds); ds := nilspace; + FI; + +. get next symbol : + next symbol (file, symbol, symbol type); + +. get semicolon : + get next symbol; + IF symbol <> ";" OR symbol type <> t delimiter + THEN errorstop ("';' erwartet") FI; + +. + get kennung : + cout (line nr); + IF symbol type <> t bold + THEN errorstop ("Kennung erwartet") FI; + IF symbol = "FONTTABLE" OR symbol = "FONTTABELLE" + THEN initialize font table; + get font table name; + ELIF symbol = "FONT" + THEN initialize font; + get font names; + ELIF symbol = "EXTENSION" OR symbol = "ERWEITERUNG" + THEN get extension char; + initialize extension; + ELIF modus = nil modus + THEN errorstop ("Kennung 'FONTTABLE' oder 'FONTTABELLE' zu Beginn der Datei erwartet") + ELSE errorstop ("unzulaessige Kennung") + FI; + + . initialize font table : + IF modus <> nil modus THEN font table found FI; + modus := font table modus; + font nr := 0; + extension nr := 0; + font table := ds; + font table. font names := empty thesaurus; + font table. replacements := ""; + font table. font name links := ""; + font table. extension chars := ""; + font table. extension indexes := ""; + font table. x unit := 10.0/2.54; + font table. y unit := 6.0/2.54; + font table. replacements table := 0; + FOR index FROM 1 UPTO 4 + REP font table. on strings (index) := ""; + font table. off strings (index) := ""; + PER; + + . get font table name : + get name list; + symbol type := t text; + symbol := name (names, 1); + IF exists (symbol) + THEN forget (symbol); + IF exists (symbol) + THEN errorstop ("Fonttabelle existiert schon") FI; + FI; + font table name := symbol; + + . initialize font : + IF font nr = max fonts + THEN errorstop ("zu viele Fonts") FI; + font nr INCR 1; + modus := font modus; + replacements length := LENGTH font table. replacements; + font. font string := ""; + font. font name indexes := ""; + font. replacements := ""; + font. extension chars := ""; + font. extension indexes := ""; + font. y offsets := ""0""0""; + font. indentation pitch := int (font table. x unit * 2.54 / 10.0); + font. font lead := 0; + font. font height := int (font table. y unit * 2.54 / 6.0); + font. font depth := 0; + font. next larger font := 0; + font. next smaller font := 0; + font. bold offset := 0; + font. pitch table := font. indentation pitch; + font. replacements table := font table. replacements table; + FOR index FROM 1 UPTO LENGTH font table. extension chars + REP font. replacements table + ( code (font table. extension chars SUB index) + 1 ) := maxint; + PER; + + . get font names : + get name list; + index := 0; + symbol type := t text; + WHILE next font name + REP link nr := link (font table. font names, symbol); + IF link nr = 0 + THEN insert (font table. font names, symbol, link nr); + font table. font name links CAT font nr; + ELIF (font table. font name links ISUB link nr) = 0 + THEN replace (font table. font name links, link nr, font nr); + ELSE errorstop ("Font existiert in Fonttabelle """ + + font table name + """ schon") + FI; + font. font name indexes CAT link nr; + PER; + + . next font name : + get (names, symbol, index); + symbol <> "" + + . get extension char : + get name list; + symbol type := t text; + symbol := name (names, 1); + IF LENGTH symbol <> 1 + THEN errorstop ("nur ein Zeichen bei Erweiterung erlaubt") FI; + extension code 1 := code (symbol) + 1; + IF NOT is kanji esc (symbol) + THEN errorstop ("ESC-Zeichen erwartet") FI; + + . initialize extension : + IF NOT two bytes + THEN errorstop ("Erweiterungen nur im zwei-Byte-Modus erlaubt") FI; + IF extension nr = max extensions + THEN errorstop ("zu viele Erweiterungen") FI; + extension nr INCR 1; + IF modus <> extension modus THEN last modus := modus FI; + modus := extension modus; + IF last modus = font table modus + THEN initalize font table extension + ELSE initalize font extension + FI; + + . initalize font table extension : + IF pos (font table. extension chars, symbol) <> 0 + THEN errorstop ("Erweiterung wurde schon definiert") FI; + extension. replacements := ""; + extension. std pitch := 0; + extension. pitch table := 0; + extension. replacements table := 0; + font table. extension chars CAT symbol; + font table. extension indexes CAT extension nr; + font table. replacements table (extension code 1) := max int; + replacements length := 0; + + . initalize font extension : + IF pos (font. extension chars, symbol) <> 0 + THEN errorstop ("Erweiterung wurde schon definiert") FI; + extension. replacements := ""; + extension. std pitch := font. pitch table (extension code 1) XOR (-maxint-1); + extension. pitch table := extension. std pitch; + font. extension chars CAT symbol; + font. extension indexes CAT extension nr; + char pos := pos (font table. extension chars, symbol); + IF char pos <> 0 + THEN index := font table. extension indexes ISUB char pos; + extension. replacements table := + font table. extensions (index). replacements table; + replacements length := + LENGTH font table. extensions (index). replacements; + font. replacements table (extension code 1) := max int; + ELSE extension. replacements table := 0; + replacements length := 0; + FI; + +. + get identification : + WHILE identification found + REP cout (line nr); + determine identification link nr; + select identification; + PER; + + . identification found : + get next symbol; + symbol type = t tag + + . determine identification link nr : + identification nr := link (english identification, symbol); + english := TRUE; + IF identification nr = 0 + THEN identification nr := link (german identification, symbol); + english := FALSE; + IF identification nr = 0 + THEN errorstop ("unzulaesige Identifikation") FI; + FI; + + . select identification : + get next symbol; + IF symbol <> "=" OR symbol type <> t operator + THEN errorstop ("'=' nach Identifikation fehlt") FI; + get next symbol; + SELECT identification nr OF + CASE x unit : x unit found + CASE y unit : y unit found + CASE on string : on string found + CASE off string : off string found + CASE indentation pitch : indentation pitch found + CASE font lead : font lead found + CASE font height : font height found + CASE font depth : font depth found + CASE larger font : larger font found + CASE smaller font : smaller font found + CASE font string : font string found + CASE y offsets : y offsets found + CASE bold offset : bold offset found + END SELECT; + + . x unit found : + check modus (font table modus); + font table. x unit := real (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("REAL-Denoter nach 'x unit' erwartet") + ELSE errorstop ("REAL-Denoter nach 'x einheit' erwartet") + FI; + FI; + get semicolon; + + . y unit found : + check modus (font table modus); + font table. y unit := real (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("REAL-Denoter nach 'y unit' erwartet") + ELSE errorstop ("REAL-Denoter nach 'y einheit' erwartet") + FI; + FI; + get semicolon; + + . on string found : + check modus (font table modus); + FOR index FROM 1 UPTO 4 + REP IF symbol type <> t text + THEN IF english + THEN errorstop ("TEXT-Denoter nach 'on string' erwartet") + ELSE errorstop ("TEXT-Denoter nach 'on sequenz' erwartet") + FI; + FI; + font table. on strings (index) := symbol; + get next symbol; + IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter + THEN errorstop ("',' oder ';' in Liste erwartet") FI; + IF symbol = ";" THEN LEAVE on string found FI; + IF index = 4 THEN errorstop ("';' erwartet") FI; + get next symbol; + PER; + + . off string found : + check modus (font table modus); + FOR index FROM 1 UPTO 4 + REP IF symbol type <> t text + THEN IF english + THEN errorstop ("TEXT-Denoter nach 'off string' erwartet") + ELSE errorstop ("TEXT-Denoter nach 'off sequenz' erwartet") + FI; + FI; + font table. off strings (index) := symbol; + get next symbol; + IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter + THEN errorstop ("',' oder ';' in Liste erwartet") FI; + IF symbol = ";" THEN LEAVE off string found FI; + IF index = 4 THEN errorstop ("';' erwartet") FI; + get next symbol; + PER; + + . indentation pitch found : + check modus (font modus); + font. indentation pitch := int (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("INT-Denoter nach 'indentation pitch' erwartet") + ELSE errorstop ("INT-Denoter nach 'einrueckbreite' erwartet") + FI; + FI; + font. pitch table := font. indentation pitch; + get semicolon; + + . font lead found : + check modus (font modus); + font. font lead := int (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("INT-Denoter nach 'font lead' erwartet") + ELSE errorstop ("INT-Denoter nach 'durchschuss' erwartet") + FI; + FI; + get semicolon; + + . font height found : + check modus (font modus); + font. font height := int (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("INT-Denoter nach 'font height' erwartet") + ELSE errorstop ("INT-Denoter nach 'fonthoehe' erwartet") + FI; + FI; + get semicolon; + + . font depth found : + check modus (font modus); + font. font depth := int (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("INT-Denoter nach 'font depth' erwartet") + ELSE errorstop ("INT-Denoter nach 'fonttiefe' erwartet") + FI; + FI; + get semicolon; + + . larger font found : + check modus (font modus); + IF symbol type <> t text + THEN IF english + THEN errorstop ("TEXT-Denoter nach 'next larger font' erwartet") + ELSE errorstop ("TEXT-Denoter nach 'groesserer font' erwartet") + FI; + FI; + determine link nr; + font. next larger font := link nr; + get semicolon; + + . smaller font found : + check modus (font modus); + IF symbol type <> t text + THEN IF english + THEN errorstop ("TEXT-Denoter nach 'next smaller font' erwartet") + ELSE errorstop ("TEXT-Denoter nach 'kleinerer font' erwartet") + FI; + FI; + determine link nr; + font. next smaller font := link nr; + get semicolon; + + . determine link nr : + change all (symbol, " ", ""); + IF symbol = "" + THEN link nr := 0 + ELSE link nr := link (font table. font names, symbol); + IF link nr = 0 + THEN insert (font table. font names, symbol, link nr); + font table. font name links CAT 0; + FI; + FI; + + . font string found : + check modus (font modus); + IF symbol type <> t text + THEN IF english + THEN errorstop ("TEXT-Denoter nach 'font string' erwartet") + ELSE errorstop ("TEXT-Denoter nach 'fontsequenz' erwartet") + FI; + FI; + font. font string := symbol; + get semicolon; + + . y offsets found : + check modus (font modus); + font. y offsets := ""; + REP IF symbol = "-" AND symbol type = t operator + THEN vorzeichen := -1; + get next symbol; + ELSE vorzeichen := 1; + FI; + int symbol := vorzeichen * int (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("INT-Denoter nach 'y offsets' erwartet") + ELSE errorstop ("INT-Denoter nach 'y verschiebungen' erwartet") + FI; + FI; + font. y offsets CAT int symbol; + get next symbol; + IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter + THEN errorstop ("',' oder ';' in Liste erwartet") FI; + IF symbol = ";" THEN LEAVE y offsets found FI; + get next symbol; + PER; + + . bold offset found : + check modus (font modus); + IF symbol = "-" AND symbol type = t operator + THEN vorzeichen := -1; + get next symbol; + ELSE vorzeichen := 1; + FI; + font. bold offset := vorzeichen * int (symbol); + IF NOT last conversion ok + THEN IF english + THEN errorstop ("INT-Denoter nach 'bold offset' erwartet") + ELSE errorstop ("INT-Denoter nach 'bold verschiebungen' erwartet") + FI; + FI; + get semicolon; + +. + get char specifications : + WHILE char found + REP cout (line nr); + char specification; + get next symbol; + PER; + + . char found : + symbol type = t text + + . char specification : + IF LENGTH symbol <> 1 + THEN errorstop ("nur ein Zeichen bei Zeichenangabe erlaubt") FI; + char := symbol; + char code 1 := code (char) + 1; + look for specification; + look for specification; + get semicolon; + + . look for specification : + get next symbol; + IF symbol = ";" AND symbol type = t delimiter + THEN LEAVE char specification + ELIF symbol = "," AND symbol type = t delimiter + THEN get specification + ELSE errorstop ("',' oder ';' bei Zeichenspezifikation erwartet") + FI; + + . get specification : + get next symbol; + IF symbol type = t number + THEN pitch specification; + ELIF symbol type = t text + THEN replacement specification + ELSE errorstop ("unzulaessiger Wert bei Zeichenspezifikation") + FI; + + . pitch specification : + int symbol := int (symbol); + IF NOT last conversion ok + THEN errorstop ("INT-Denoter bei Breitenangabe erwartet") FI; + IF modus = font modus + THEN font. pitch table (char code 1) := int symbol; + IF is kanji esc (char) + THEN set bit (font. pitch table (char code 1), 15) FI; + ELIF modus = extension modus + THEN IF last modus = font modus AND + font. pitch table (extension code 1) <> max int + THEN font. pitch table (extension code 1) := max int FI; + extension. pitch table (char code 1) := int symbol; + FI; + + . replacement specification : + IF LENGTH symbol > 255 + THEN errorstop ("Ersatzdarstellungen duerfen nur 255 Zeichen haben") FI; + IF modus = font table modus + THEN font table. replacements table (char code 1) := + (LENGTH font table. replacements + 1); + font table. replacements CAT code (LENGTH symbol); + font table. replacements CAT symbol; + IF is kanji esc (char) + THEN set bit (font table. replacements table (char code 1), 15) FI; + ELIF modus = font modus + THEN font. replacements table (char code 1) := + (replacements length + LENGTH font. replacements + 1); + font. replacements CAT code (LENGTH symbol); + font. replacements CAT symbol; + IF is kanji esc (char) + THEN set bit (font. replacements table (char code 1), 15) FI; + ELIF modus = extension modus + THEN IF last modus = font modus AND + font. replacements table (extension code 1) <> max int + THEN font. replacements table (extension code 1) := max int FI; + extension. replacements table (char code 1) := + (replacements length + LENGTH extension. replacements + 1); + extension. replacements CAT code (LENGTH symbol); + extension. replacements CAT symbol; + FI; + +END PROC load; + + +PROC get name list : + + names := empty thesaurus; + get next symbol; + IF symbol <> ":" OR symbol type <> t delimiter + THEN errorstop ("':' nach Kennung erwartet") FI; + REP get next symbol; + change all (symbol, " ", ""); + IF symbol type <> t text + THEN errorstop ("TEXT-Denoter in Namesliste erwartet") FI; + IF symbol = "" + THEN errorstop ("'niltext' als Name nicht erlaubt") FI; + insert (names, symbol); + get next symbol; + IF (symbol <> "," AND symbol <> ";") OR symbol type <> t delimiter + THEN errorstop ("',' oder ';' in Liste erwartet") FI; + UNTIL symbol = ";" PER; + + . get next symbol : + next symbol (file, symbol, symbol type); + +END PROC get name list; + + +OP := (ROW 256 INT VAR l, INT CONST r) : + +INT VAR i; +IF modus = extension modus OR NOT two bytes + THEN FOR i FROM 1 UPTO 256 REP l (i) := r PER; + ELSE FOR i FROM 1 UPTO 129 REP l (i) := r PER; + FOR i FROM 130 UPTO 160 REP l (i) := r - maxint - 1 PER; + FOR i FROM 161 UPTO 224 REP l (i) := r PER; + FOR i FROM 225 UPTO 240 REP l (i) := r - maxint - 1 PER; + FOR i FROM 241 UPTO 256 REP l (i) := r PER; +FI; + +END OP :=; + + +PROC check modus (INT CONST mod) : + + IF mod <> modus THEN errorstop ("unzulaessige Identifikation") FI; + +END PROC check modus; + + +PROC error (TEXT CONST message) : + +(*INT CONST l := error line;*) + clear error; + errorstop ("Zeile " + text (line nr) + " bei " + letztes symbol + + " : " + message (* + errorline if neccessary *) ); + + . letztes symbol : + IF symbol type <> t text + THEN symbol + ELSE decode (symbol); + """" + symbol + """" + FI +(* + . errorline if neccessary : + IF l = 0 + THEN "" + ELSE " -> " + text (l) + FI +*) +END PROC error; + + +(*******************************************************************) + + +PROC create font file (TEXT CONST font table name, font file name) : + +enable stop; +connect font table; +put font table in font file; + +. + connect font table : + buffer := font table name; + change all (buffer, " ", ""); + IF NOT exists (buffer) COR type (old (buffer)) <> font table type + THEN errorstop ("Fonttabelle """ + buffer + """ gibt es nicht") + FI; + font table := old (buffer); + +. + put font table in font file : + enable stop; + font file := sequential file (output, font file name); + z := " "; + max line length (font file, 1000); + put font table; + FOR font nr FROM 1 UPTO font table. last font REP put font PER; + +. put font table : + z CAT "FONTTABLE : """; z CAT buffer; z CAT """;"; put z; + z CAT " x unit = "; z CAT text (font table. x unit); z CAT ";"; put z; + z CAT " y unit = "; z CAT text (font table. y unit); z CAT ";"; put z; + z CAT " on string = """; z cat on strings; z CAT """;"; put z; + z CAT " off string = """; z cat off strings; z CAT """;"; put z; + put font table replacements; + put font table extensions; + put z; + + . z cat on strings : + FOR index FROM 1 UPTO 4 + REP buffer := font table. on strings (index); + decode (buffer); + z CAT buffer; + IF index <> 4 THEN z CAT """, """ FI; + PER; + + . z cat off strings : + FOR index FROM 1 UPTO 4 + REP buffer := font table. off strings (index); + decode (buffer); + z CAT buffer; + IF index <> 4 THEN z CAT """, """ FI; + PER; + + . put font table replacements : + put z; + FOR char code FROM 0 UPTO 255 + REP char code 1 := char code + 1; + link nr := font table. replacements table (char code 1); + reset bit (link nr, 15); + IF link nr > 0 AND link nr <> maxint + THEN z CAT " "; + put char code; + put font table replacement; + put z; + FI; + PER; + + . put font table replacement : + replacement := subtext (font table. replacements, link nr + 1, + link nr + code (font table. replacements SUB link nr) ); + put replacement; + + . put font table extensions : + IF font table. extension chars <> "" + THEN FOR index FROM 1 UPTO LENGTH font table. extension chars + REP put font table extension PER; + FI; + + . put font table extension : + put z; + z CAT " EXTENSION : """""; + z CAT text 3 (code (font table. extension chars SUB index)); + z CAT """"";"; + put z; put z; + replacements length := 0; + extension nr := font table. extension indexes ISUB index; + FOR char code FROM 0 UPTO 255 + REP char code 1 := char code + 1; + link nr := extension. replacements table (char code 1); + IF link nr > 0 + THEN z CAT " "; + put char code; + put extension replacement; + put z; + FI; + PER; + +. put font : + put z; + z CAT " FONT : "; z cat font names; z CAT ";"; put z; + z CAT " indentation pitch = "; + z CAT text(font. indentation pitch); + z CAT ";"; put z; + IF font. font lead <> 0 + THEN z CAT " font lead = "; + z CAT text(font. font lead); + z CAT ";"; put z; + FI; + z CAT " font height = "; + z CAT text(font. font height); + z CAT ";"; put z; + IF font. font depth <> 0 + THEN z CAT " font depth = "; + z CAT text(font. font depth); + z CAT ";"; put z; + FI; + IF next larger <> "" + THEN z CAT " next larger font = """; + z CAT next larger; + z CAT """;"; put z; + FI; + IF next smaller <> "" + THEN z CAT " next smaller font = """; + z CAT next smaller; + z CAT """;"; put z; + FI; + IF font. font string <> "" + THEN z CAT " font string = """; + z CAT font string; + z CAT """;"; put z; + FI; + IF (font. y offsets ISUB 1) <> 0 OR LENGTH font. y offsets > 2 + THEN z CAT " y offsets = "; + z cat y offsets; + z CAT ";"; put z; + FI; + IF font. bold offset <> 0 + THEN z CAT " bold offset = "; + z CAT text(font. bold offset); + z CAT ";"; put z; + FI; + put font pitches and replacements; + put font extensions; + + . next larger : name (font table. font names, font. next larger font) + . next smaller : name (font table. font names, font. next smaller font) + . font string : buffer := font. font string; decode (buffer); buffer + + . z cat font names : + z CAT """"; + z CAT name (font table. font names, font. font name indexes ISUB 1); + z CAT """"; + FOR index FROM 2 UPTO LENGTH font. font name indexes DIV 2 + REP z CAT ", """; + z CAT name (font table. font names, font. font name indexes ISUB index); + z CAT """"; + PER; + + . z cat y offsets : + z CAT text (font. y offsets ISUB 1); + FOR index FROM 2 UPTO LENGTH font. y offsets DIV 2 + REP z CAT ", "; + z CAT text (font. y offsets ISUB index); + PER; + + . put font pitches and replacements : + BOOL VAR ausgabe := FALSE; + replacements length := LENGTH font table. replacements; + put z; + z CAT " "; + FOR char code FROM 0 UPTO 255 + REP char code 1 := char code + 1; + pitch := font. pitch table (char code 1); + reset bit (pitch, 15); + link nr := font. replacements table (char code 1); + reset bit (link nr, 15); + IF (pitch <> font. indentation pitch) OR + (link nr > replacements length AND link nr <> maxint) + THEN put font char pitch and replacement; + IF ausgabe + THEN put z; + ausgabe := FALSE; + ELSE ausgabe := TRUE; + FI; + z CAT " "; + FI; + PER; + IF ausgabe THEN put z ELSE z := " " FI; + + . put font char pitch and replacement : + put char code; + put font char pitch; + IF link nr > replacements length AND link nr <> maxint + THEN put font replacement; + IF NOT ausgabe THEN z CAT (6 - LENGTH replacement) * " " FI; + ELIF ausgabe + THEN z CAT ";" + ELSE z CAT "; "; + FI; + + . put font char pitch : + IF pitch = max int + THEN char pos := pos (font. extension chars, code (char code)); + IF char pos <> 0 + THEN pitch := font table. extensions + (font. extension indexes ISUB char pos). std pitch + FI; + FI; + put char pitch; + + . put font replacement : + link nr DECR replacements length; + replacement := subtext (font. replacements, link nr + 1, + link nr + code (font. replacements SUB link nr) ); + put replacement; + + . put font extensions : + IF font. extension chars <> "" + THEN FOR index FROM 1 UPTO LENGTH font. extension chars + REP put font extension PER; + FI; + + . put font extension : + put z; + z CAT " ERWEITERUNG : """""; + z CAT text 3 (code (font. extension chars SUB index)); + z CAT """"";"; + put z; put z; z CAT " "; + detemine replacements length; + extension nr := font. extension indexes ISUB index; + ausgabe := FALSE; + FOR char code FROM 0 UPTO 255 + REP char code 1 := char code + 1; + pitch := extension. pitch table (char code 1); + link nr := extension. replacements table (char code 1); + IF pitch <> extension. std pitch OR link nr > replacements length + THEN put extension char pitch and replacement; + IF ausgabe + THEN put z; + ausgabe := FALSE; + ELSE ausgabe := TRUE; + FI; + z CAT " "; + FI; + PER; + IF ausgabe THEN put z ELSE z := " " FI; + + . detemine replacements length : + char pos := pos (font table. extension chars, + font. extension chars SUB index); + IF char pos <> 0 + THEN replacements length := LENGTH font table. extensions + (font table. extension indexes ISUB char pos). replacements; + ELSE replacements length := 0; + FI; + + . put extension char pitch and replacement : + put char code; + put char pitch; + IF link nr > replacements length + THEN put extension replacement; + IF NOT ausgabe THEN z CAT (6 - LENGTH replacement) * " " FI; + ELIF ausgabe + THEN z CAT ";" + ELSE z CAT "; "; + FI; + +. put extension replacement : + link nr DECR replacements length; + replacement := subtext (extension. replacements, link nr + 1, + link nr + code (extension. replacements SUB link nr) ); + put replacement; + +. put char code : + IF (char code >= 32 AND char code <= 122) OR + (char code >= 214 AND char code <= 223) OR + char code = 124 OR char code = 126 OR char code = 251 + THEN z CAT "(* "; + z CAT code (char code); + z CAT " *) """""; + ELSE z CAT " """""; + FI; + z CAT text 3 (char code); + z CAT """"""; + +. put char pitch : + z CAT ","; + z CAT text (pitch, 5); + +. put replacement : + decode (replacement); + z CAT ", """; + z CAT replacement; + z CAT """;" + +END PROC create font file; + + +PROC put z : + + putline (font file, z); + cout (lines (font file)); + z := " "; + +END PROC put z; + + +PROC decode (TEXT VAR string) : + + INT VAR p; + change all (string, """", """"""); + p := pos (string, ""0"", ""31"", 1); + WHILE p <> 0 + REP change (string, p, p, """" + text (code(string SUB p)) + """"); + p := pos (string, ""0"", ""31"", p); + PER; + p := pos (string, ""127"", ""255"", 1); + WHILE p <> 0 + REP change (string, p, p, """" + text (code(string SUB p)) + """"); + p := pos (string, ""127"", ""255"", p); + PER; + +END PROC decode; + + +TEXT PROC text 3 (INT CONST value) : + + buffer := text (value, 3); + change all (buffer, " ", "0"); + buffer + +END PROC text 3; + +END PACKET font convertor; diff --git a/system/terminal-codes/1.8.2/src/AT.ascii(SHard>=4.5) b/system/terminal-codes/1.8.2/src/AT.ascii(SHard>=4.5) new file mode 100644 index 0000000..ca9ba3d --- /dev/null +++ b/system/terminal-codes/1.8.2/src/AT.ascii(SHard>=4.5) @@ -0,0 +1,74 @@ +(*************************************************) +(* Typtabelle : AT.ascii(SHard>=4.5) *) +(* Generiert am : 26.07.88 *) +(* Version/Typ : 1.8.2/32001 *) +(*************************************************) + +forget ("AT.ascii(SHard>=4.5)", quiet) ; +new type ("AT.ascii(SHard>=4.5)") ; + +enter xsize (80) ; +enter ysize (24) ; +cursor logic (0, ""6"", "", "") ; + +(* Ausgabe Codes : *) +enter outcode ( 0, 0, "") ; +enter outcode ( 1, 1) ; (* Cursor Home : *) +enter outcode ( 2, 2) ; (* Cursor right: *) +enter outcode ( 3, 3) ; (* Cursor up : *) +enter outcode ( 4, 4) ; (* CLEOP : *) +enter outcode ( 5, 5) ; (* CLEOL : *) +enter outcode ( 8, 8) ; (* Cursor left : *) +enter outcode ( 10, 10) ; (* Cursor down : *) +enter outcode ( 13, 13) ; (* CR : *) +enter outcode ( 14, 0, ""14" ") ; (* END MARK : *) +enter outcode ( 15, 0, ""15" ") ; (* BEGIN MARK : *) +enter outcode (220, 0, ""15"k"14"") ; (* Trenn-k : k +*) +enter outcode (221, 0, ""15"-"14"") ; (* Trennstrich : - +*) +enter outcode (222, 0, ""15"#"14"") ; (* Fest-# : # +*) +enter outcode (223, 0, ""15" "14"") ; (* Fest-Blank : + *) +enter outcode (251, 0, ""225"") ; (* sz : <225> *) +enter outcode (252, 21) ; (* *) + + +(* Eingabe Codes : *) +enter incode ( 7, ""7"") ; (* SV - Call : *) +enter incode ( 4, ""4"") ; (* Info : *) +enter incode ( 1, ""1"") ; (* HOP : *) +enter incode ( 18, ""18"") ; (* Insert line : *) +enter incode ( 96, "<") ; (* < *) +enter incode (126, ">") ; (* > *) +enter incode ( 64, """") ; (* " *) +enter incode ( 35, ""252"") ; (* <252> *) +enter incode ( 94, "&") ; (* & *) +enter incode ( 38, "/") ; (* / *) +enter incode ( 42, "(") ; (* ( *) +enter incode ( 40, ")") ; (* ) *) +enter incode ( 41, "=") ; (* = *) +enter incode ( 45, "") ; (* <251> *) +enter incode ( 95, "?") ; (* ? *) +enter incode ( 61, "'") ; (* ' *) +enter incode ( 43, "`") ; (* ` *) +enter incode (121, "z") ; (* z *) +enter incode ( 89, "Z") ; (* Z *) +enter incode (122, "y") ; (* y *) +enter incode ( 90, "Y") ; (* Y *) +enter incode ( 60, ";") ; (* ; *) +enter incode ( 62, ":") ; (* : *) +enter incode ( 47, "-") ; (* - *) +enter incode ( 63, "_") ; (* _ *) +enter incode ( 59, "") ; (* <218> *) +enter incode ( 58, ""215"") ; (* <215> *) +enter incode ( 39, "") ; (* <217> *) +enter incode ( 34, ""214"") ; (* <214> *) +enter incode ( 91, "") ; (* <219> *) +enter incode ( 93, "+") ; (* + *) +enter incode (123, ""216"") ; (* <216> *) +enter incode (125, "*") ; (* * *) +enter incode ( 92, "#") ; (* # *) +enter incode (124, "^") ; (* ^ *) + diff --git a/system/terminal-codes/1.8.2/src/GEN182.ELA b/system/terminal-codes/1.8.2/src/GEN182.ELA new file mode 100644 index 0000000..43c3acf --- /dev/null +++ b/system/terminal-codes/1.8.2/src/GEN182.ELA @@ -0,0 +1,245 @@ +(* Typtabellengenerierungsprogramm, Stand : 26.11.85 *) + +page ; +putline ("- Erzeugen einer .gen Datei aus einer Typtabelle -") ; +line ; +BOUND STRUCT (INT maxx, maxy, + ROW 248 INT align, + ROW 128 INT outcodes, + ROW 128 INT instrings, + ROW 128 INT outstrings) VAR x ; + +TEXT VAR t , filename ; +INT VAR i , laenge , position , eumel code ; +FILE VAR f ; +put ("Name der Tabelle:") ; +getline (t) ; +IF exists (t+".gen") THEN forget (t+".gen") FI ; +IF exists (t+".gen") +THEN filename := t + ".new.gen" +ELSE filename := t + ".gen" +FI ; +f := sequentialfile (output, filename) ; +putline (f, "(" + 49 * "*" + ")") ; +putline (f, "(* Typtabelle : " + text (t, 30) + " *)") ; +putline (f, "(* Generiert am : " + text (date, 30) + " *)") ; +putline (f, "(* Version/Typ : " + text ("1.8.2/32001", 30) + " *)") ; +putline (f, "(" + 49 * "*" + ")") ; +line (f) ; +putline (f, "forget (""" + t + """, quiet) ;") ; +putline (f, "new type (""" + t + """) ;") ; +line (f) ; +x := old (t, 32001) ; +putline (f, "enter xsize ("+text (x.maxx)+") ;") ; +putline (f, "enter ysize ("+text (x.maxy)+") ;") ; +t := " " ; +IF (x.outstrings (1) AND 255) = 2 + THEN putline (f, "elbit cursor ;") ; + line (f) ; + ELSE write (f, "cursor logic (") ; + position := x.outstrings(2) ; + put (f, text (position AND 255) + ",") ; + position := (x.outcodes (4) AND 127) * 8+1 ; + put (f, denoter (x.outstrings, position, 0) + ",") ; + position INCR (laenge + 2) ; + put (f, denoter (x.outstrings, position, 0) + ",") ; + position INCR (laenge + 2) ; + putline (f, denoter (x.outstrings, position, 0) + ") ;") ; + line (f) +FI ; +putline (f, "(* Ausgabe Codes : *)") ; +FOR i FROM 1 UPTO 128 REP + cout (lineno (f)) ; + replace (t, 1, x.outcodes (i)) ; + IF i <> 4 + THEN IF code (t SUB 1) <> 255 + THEN eumel code := (i-1) * 2 ; + put (f, "enter outcode (" + text (eumel code, 3) + ",") ; + IF code (t SUB 1) > 127 + THEN outstring ((code (t SUB 1)-128)*8) + ELSE numberput (code (t SUB 1)) + FI ; + line (f) + FI + FI ; + IF code (t SUB 2) <> 255 + THEN eumel code := (i-1) * 2 + 1 ; + put (f, "enter outcode (" + text (eumel code, 3) + ",") ; + IF code (t SUB 2) > 127 + THEN outstring ((code (t SUB 2)-128)*8) + ELSE numberput (code (t SUB 2)) + FI ; + line (f) + FI ; +PER ; +line (f) ; +line (f) ; + +putline (f, "(* Eingabe Codes : *)") ; +i := 0 ; +WHILE i < 256 CAND incode (i) <> 255 REP + cout (lineno (f)) ; + eumel code := incode (i) ; + put (f, "enter incode (" + text (eumel code,3) + ",") ; + write (f, denoter (x.instrings, i + 1, 255)) ; + put (f, ") ; (*") ; + i INCR 1 ; + IF in bezeichnung (eumel code) <> "" + THEN put (f, in bezeichnung (eumel code) + ":") + FI ; + WHILE i < 256 CAND incode (i) <> 255 REP + charput (incode (i)) ; + i INCR 1 + PER ; + i INCR 1 ; + putline (f, "*)") +PER ; + +edit (filename) ; + +INT PROC incode (INT CONST element) : + TEXT VAR t := " " ; + replace (t, 1, x.instrings (element DIV 2 + 1)); + IF (element MOD 2) = 0 THEN code (t SUB 1) + ELSE code (t SUB 2) + FI +ENDPROC incode ; + + +TEXT PROC in bezeichnung (INT CONST code) : + SELECT code OF + CASE 1 : "HOP " + CASE 2 : "Cursor right" + CASE 3 : "Cursor up " + CASE 4 : "Info " + CASE 7 : "SV - Call " + CASE 8 : "Cursor left " + CASE 9 : "TAB " + CASE 10: "Cursor down " + CASE 11: "RUBIN " + CASE 12: "RUBOUT " + CASE 13: "CR " + CASE 16: "MARK " + CASE 17: "Stop " + CASE 18: "Insert line " + CASE 23: "Weiter " + CASE 27: "Escape " + CASE 214:"ae-Taste " + CASE 215:"oe-Taste " + CASE 216:"ue-Taste " + CASE 217:"Ae-Taste " + CASE 218:"Oe-Taste " + CASE 219:"Ue-Taste " + CASE 220:"Trenn-k " + CASE 221:"Trennstrich " + CASE 222:"Fest-# " + CASE 223:"Fest-Blank " + CASE 251:"sz-Taste " + OTHERWISE IF code < 32 THEN "Funct.-Taste" + ELSE "" + FI + ENDSELECT +ENDPROC in bezeichnung ; + +TEXT PROC out bezeichnung (INT CONST code) : + SELECT code OF + CASE 1 : "Cursor Home " + CASE 2 : "Cursor right" + CASE 3 : "Cursor up " + CASE 4 : "CLEOP " + CASE 5 : "CLEOL " + CASE 6 : "Cursor (YX) " + CASE 7 : "Beep " + CASE 8 : "Cursor left " + CASE 10: "Cursor down " + CASE 13: "CR " + CASE 14: "END MARK " + CASE 15: "BEGIN MARK " + CASE 214:"ae " + CASE 215:"oe " + CASE 216:"ue " + CASE 217:"Ae " + CASE 218:"Oe " + CASE 219:"Ue " + CASE 220:"Trenn-k " + CASE 221:"Trennstrich " + CASE 222:"Fest-# " + CASE 223:"Fest-Blank " + CASE 251:"sz " + OTHERWISE "" + ENDSELECT +ENDPROC out bezeichnung ; + +PROC charput (INT CONST nr) : + IF nr = 27 THEN put (f, "") + ELIF nr = 10 THEN put (f, "") + ELIF nr = 13 THEN put (f, "") + ELIF nr = 32 THEN put (f, "") + ELIF nr = 127 THEN put (f, "") + ELIF nr > 127 THEN put (f, "<" + text (nr) + ">") + ELIF nr > 32 THEN put (f, code (nr)) + ELSE put (f, "") + FI +ENDPROC charput ; + +PROC numberput (INT CONST nr) : + put (f, text (nr,3 ) + ") ; (*") ; + IF out bezeichnung (eumel code) <> "" + THEN put (f, out bezeichnung (eumel code) + ":") + FI ; + charput (nr) ; + put (f, "*)") ; +ENDPROC numberput ; + +TEXT PROC denoter (ROW 128 INT VAR y, INT CONST pos, ende) : + INT VAR i := pos ; + TEXT VAR t := " " , zeile := """" ; + laenge := 0 ; + WHILE i < 256 AND zugriff <> ende REP + IF zugriff > 31 AND zugriff < 127 THEN zeile CAT code (zugriff) + ELIF zugriff = 34 THEN zeile CAT """""" + ELIF zugriff = 251 THEN zeile CAT "" + ELIF zugriff > 216 AND zugriff < 224 THEN zeile CAT code (zugriff) + ELSE zeile CAT """" ; + zeile CAT text (zugriff) ; + zeile CAT """" + FI ; + i INCR 1 ; + laenge INCR 1 + PER ; + zeile CAT """" ; + zeile. + + +zugriff : + replace (t, 1, y (i DIV 2 + 1)) ; + IF (i MOD 2) = 0 THEN code (t SUB 1) + ELSE code (t SUB 2) + FI +ENDPROC denoter ; + + +PROC outstring (INT CONST element) : + INT VAR i := element ; + put (f, text (zugriff) + ",") ; + put (f, denoter (x.outstrings, i + 1, 0) + ") ; (*") ; + IF out bezeichnung (eumel code) <> "" + THEN put (f, out bezeichnung (eumel code) + ":") + FI ; + i INCR 1 ; + WHILE zugriff <> 0 REP + charput (zugriff) ; + i INCR 1 + PER ; + put (f, "*)") . + + +zugriff : + TEXT VAR t := " " ; + replace (t, 1, x.outstrings (i DIV 2 + 1)) ; + IF (i MOD 2) = 0 THEN code (t SUB 1) + ELSE code (t SUB 2) + FI +ENDPROC outstring + + diff --git a/system/terminal-codes/unknown/src/A210 b/system/terminal-codes/unknown/src/A210 new file mode 100644 index 0000000..4b63b40 --- /dev/null +++ b/system/terminal-codes/unknown/src/A210 @@ -0,0 +1,78 @@ +(*************************************************) +(* Typtabelle : A210 *) +(* Zeichensatz : ASCII *) +(* Keyboard : ASCII *) +(* Erstellt am : 07.12.85 *) +(*************************************************) + +forget ("A210", quiet) ; +new type ("A210") ; + +enter outcode (127, 0, ""27"F"127"") ; (* Erster Outstring ! *) +INT VAR i ; +FOR i FROM 128 UPTO 254 REP + link outcode (i, 4) (* first outstring *) +PER ; + +cursor logic (32, ""27"=", "", "") ; + +(* Ausgabe Codes : *) +enter outcode ( 1, 30) ; (* Cursor Home : *) +enter outcode ( 2, 12) ; (* Cursor right: *) +enter outcode ( 3, 11) ; (* Cursor up : *) +enter outcode ( 4, 0, ""27"Y") ; (* CLEOP : Y *) +enter outcode ( 5, 0, ""27"T") ; (* CLEOL : T *) +enter outcode ( 8, 8) ; (* Cursor left : *) +enter outcode ( 10, 10) ; (* Cursor down : *) +enter outcode ( 13, 13) ; (* CR : *) +enter outcode ( 14, 0, ""27"G0") ;(* END MARK : G 0 *) +enter outcode ( 15, 0, ""27"G4") ;(* BEGIN MARK : G 4 *) +enter outcode ( 16, 0, ""27"G8") ;(* UNDERLINE : G 8 *) +enter outcode ( 17, 0, ""27"G2") ;(* FLASH : G 2 *) + +(* Low Video on = ) , High Video on = ( *) +enter outcode (214, 0, ""27")A"27"(") ; (* ae : ) A ( *) +enter outcode (215, 0, ""27")O"27"(") ; (* oe : ) O ( *) +enter outcode (216, 0, ""27")U"27"(") ; (* ue : ) U ( *) +enter outcode (217, 0, ""27")a"27"(") ; (* Ae : ) a ( *) +enter outcode (218, 0, ""27")o"27"(") ; (* Oe : ) o ( *) +enter outcode (219, 0, ""27")u"27"(") ; (* Ue : ) u ( *) +enter outcode (220, 0, ""27")k"27"(") ; (* Trenn-k : k *) +enter outcode (221, 0, ""27")-"27"(") ; (* Trennstrich : - *) +enter outcode (222, 0, ""27")#"27"(") ; (* Fest-# : # *) +enter outcode (223, 0, ""27")_"27"(") ; (* Fest-Blank : *) +enter outcode (251, 0, ""27")B"27"(") ; (* sz : ) B ( *) + +(* Eingabecodes : *) +enter incode ( 0, ""0"") ; (* Wird beim Einschalten dreimal gesendet *) +enter incode ( 1, ""30"") ; (* HOP : *) +enter incode ( 2, ""12"") ; (* Cursor right: *) +enter incode ( 3, ""11"") ; (* Cursor up : *) +enter incode ( 7, ""1"A"13"") ; (* SV - Call : A *) +enter incode ( 7, ""2"") ; (* SV - Call : *) +enter incode ( 8, ""8"") ; +enter incode ( 9, ""9"") ; (* TAB : *) +enter incode ( 10, ""22"") ; (* Cursor down : *) +enter incode ( 11, ""27"Q") ; (* RUBIN : Q *) +enter incode ( 12, ""127"") ; (* RUBOUT : *) +enter incode ( 12, ""27"W") ; (* RUBOUT : W *) +enter incode ( 16, ""27"E") ; (* MARK : E *) +enter incode ( 17, ""19"") ; (* Stop : *) +enter incode ( 17, ""1"@"13"") ; (* Stop : @ *) +enter incode ( 23, ""17"") ; (* Weiter : *) +enter incode ( 23, ""1"B"13"") ; (* Weiter : B *) +enter incode ( 4, ""1"C"13"") ; (* Funct.-Taste: C *) +enter incode ( 20, ""1"D"13"") ; (* Funct.-Taste: D *) +enter incode ( 21, ""1"E"13"") ; (* Funct.-Taste: E *) +enter incode ( 22, ""1"F"13"") ; (* Funct.-Taste: F *) +enter incode ( 24, ""1"G"13"") ; (* Funct.-Taste: G *) +enter incode ( 25, ""1"H"13"") ; (* Funct.-Taste: H *) +enter incode ( 26, ""1"I"13"") ; (* Funct.-Taste: I *) +enter incode ( 28, ""1"J"13"") ; (* Funct.-Taste: J *) +enter incode ( 29, ""1"`"13"") ; (* Funct.-Taste: ` *) +enter incode ( 30, ""1"a"13"") ; (* Funct.-Taste: a *) +enter incode ( 31, ""1"b"13"") ; (* Weiter : b *) + +PROC link outcode (INT CONST eumelcode, begin of string) : + enter outcode (eumelcode, begin of string -128) +ENDPROC link outcode ; diff --git a/system/terminal-codes/unknown/src/A210.german b/system/terminal-codes/unknown/src/A210.german new file mode 100644 index 0000000..656ad31 --- /dev/null +++ b/system/terminal-codes/unknown/src/A210.german @@ -0,0 +1,87 @@ +(*************************************************) +(* Typtabelle : A210 - Emulation QT102! *) +(* Zeichensatz : German *) +(* Keyboard : German *) +(* Erstellt am : 04.02.87 *) +(*************************************************) + +forget ("A210.german", quiet) ; +new type ("A210.german") ; + +enter outcode (127, 0, ""27"F"127"") ; (* Erster Outstring ! *) +INT VAR i ; +FOR i FROM 128 UPTO 254 REP + link outcode (i, 4) (* first outstring *) +PER ; + +cursor logic (32, ""27"=", "", "") ; + +(* Ausgabe Codes : *) +enter outcode ( 1, 30) ; (* Cursor Home : *) +enter outcode ( 2, 12) ; (* Cursor right: *) +enter outcode ( 3, 11) ; (* Cursor up : *) +enter outcode ( 4, 0, ""27"Y") ; (* CLEOP : Y *) +enter outcode ( 5, 0, ""27"T") ; (* CLEOL : T *) +enter outcode ( 8, 8) ; (* Cursor left : *) +enter outcode ( 10, 10) ; (* Cursor down : *) +enter outcode ( 13, 13) ; (* CR : *) +enter outcode ( 14, 0, ""27"G0") ;(* END MARK : G 0 *) +enter outcode ( 15, 0, ""27"G4") ;(* BEGIN MARK : G 4 *) +enter outcode ( 16, 0, ""27"G8") ;(* UNDERLINE : G 8 *) +enter outcode ( 17, 0, ""27"G2") ;(* FLASH : G 2 *) + +(* Low Video on = ) , High Video on = ( *) +enter outcode (214, "[") ; (* Ae : [ *) +enter outcode (215, "\") ; (* Oe : \ *) +enter outcode (216, "]") ; (* Ue : ] *) +enter outcode (217, "{") ; (* ae : { } *) +enter outcode (218, "|") ; (* oe : | *) +enter outcode (219, "}") ; (* ue : } { *) +enter outcode (220, ""27")k"27"(") ; (* Trenn-k : k *) +enter outcode (221, ""27")-"27"(") ; (* Trennstrich : - *) +enter outcode (222, ""27")#"27"(") ; (* Fest-# : # *) +enter outcode (223, ""27")_"27"(") ; (* Fest-Blank : *) +enter outcode (251, "~") ; (* sz : ~ *) +enter outcode (252, "@") ; (* Paragraph: @ *) + +(* Eingabecodes : *) +(* Achtung: Tabelle ist randvoll! *) +enter incode ( 0, ""0"") ; (* Wird beim Einschalten dreimal gesendet *) +enter incode ( 1, ""30"") ; (* HOP : *) +enter incode ( 2, ""12"") ; (* Cursor right: *) +enter incode ( 3, ""11"") ; (* Cursor up : *) +enter incode ( 7, ""1"A"13"") ; (* SV - Call : F2 *) +enter incode ( 7, ""2"") ; (* SV - Call : *) +enter incode ( 9, ""9"") ; (* TAB : *) +enter incode ( 10, ""22"") ; (* Cursor down : *) +enter incode ( 11, ""27"Q") ; (* RUBIN : Q *) +enter incode ( 12, ""127"") ; (* RUBOUT : *) +enter incode ( 12, ""27"W") ; (* RUBOUT : W *) +enter incode ( 16, ""27"E") ; (* MARK : E *) +enter incode ( 17, ""19"") ; (* Stop : *) +enter incode ( 23, ""17"") ; (* Weiter : *) +enter incode ( 23, ""3"") ; (* Weiter : *) +enter incode ( 4, ""1"C"13"") ; (* Funct.-Taste F4 : C *) +enter incode ( 20, ""1"D"13"") ; (* Funct.-Taste F5 : D *) +enter incode ( 21, ""1"E"13"") ; (* Funct.-Taste F6 : E *) +enter incode ( 22, ""1"F"13"") ; (* Funct.-Taste F7 : F *) +enter incode ( 24, ""1"G"13"") ; (* Funct.-Taste F8 : G *) +enter incode ( 25, ""1"H"13"") ; (* Funct.-Taste F9 : H *) +enter incode ( 26, ""1"I"13"") ; (* Funct.-Taste F10: I *) +enter incode ( 28, ""1"J"13"") ; (* Funct.-Taste F11: J *) +enter incode ( 29, ""1"`"13"") ; (* Funct.-Taste F12: ` *) +enter incode ( 30, ""1"a"13"") ; (* Funct.-Taste F13: a *) +enter incode ( 31, ""1"b"13"") ; (* Funct.-Taste F14: b *) +enter incode (214, "[") ; +enter incode (215, "\") ; +enter incode (216, "]") ; +enter incode (217, "{") ; +enter incode (218, "|") ; +enter incode (219, "}") ; +enter incode (251, "~") ; +enter incode (252, "@") ; + + +PROC link outcode (INT CONST eumelcode, begin of string) : + enter outcode (eumelcode, begin of string -128) +ENDPROC link outcode ; diff --git a/system/terminal-codes/unknown/src/A230+ b/system/terminal-codes/unknown/src/A230+ new file mode 100644 index 0000000..89dcb79 --- /dev/null +++ b/system/terminal-codes/unknown/src/A230+ @@ -0,0 +1,61 @@ +TEXT VAR name :="A230+"; +command dialogue (FALSE); forget (name, quiet) ; +new type (name); +cursor logic (32,""27"=","",""); +enter outcode (1 ,0,""30""); +enter outcode (2 ,0,""12""); +enter outcode (3 ,0,""11""); +enter outcode (4 ,40,""27"Y"); +enter outcode (5 ,0,""27"T"); +enter outcode (14,0,""27"G0 "); +enter outcode (15,0,""27"G4 "); + +enter outcode ( 91,0,">"); +enter outcode ( 92,0,"/"); +enter outcode ( 93,0,">"); +enter outcode (123,0,"("); +enter outcode (124,0,"!"); +enter outcode (125,0,")"); + +INT VAR i ; +FOR i FROM 127 UPTO 255 REP + enter outcode (i, "?") +PER ; + +enter outcode (214,91); +enter outcode (215,92); +enter outcode (216,93); +enter outcode (217,123); +enter outcode (218,124); +enter outcode (219,125); +enter outcode (220,"k") ; +enter outcode (221,"-") ; +enter outcode (222,"#") ; +enter outcode (223,"_") ; +enter outcode (251,126); + +enter incode (214,""91""); +enter incode (215,""92""); +enter incode (216,""93""); +enter incode (217,""123""); +enter incode (218,""124""); +enter incode (219,""125""); +enter incode (251,""126""); + +enter incode (63,""0"") ; +enter incode ( 1,""30""); (* HOP *) +enter incode ( 2,""12""); (* up *) +enter incode ( 3,""11""); (* right *) +enter incode (10,""22""); (* down *) +enter incode ( 8,""8""); (* left *) +enter incode (11,""27"Q");enter incode (11,""26""); (* rubin *) +enter incode (12,""27"W");enter incode (12,""127""); (* rubout *) +enter incode (12,""27"E"); (* " *) +enter incode (16,""16""); (* mark *) +enter incode (16,""27"T"); (* mark *) +enter incode (7,""2""); (* sv *) +enter incode (7, ""1""64""13""); (* F1 = SV *) +enter incode (17,""1""66""13""); (* F2 = stop *) +enter incode (23,""3""); (* weiter *) +enter incode (23,""1""65""13""); (* F3 = weiter *) + diff --git a/system/terminal-codes/unknown/src/DEC.VT220.ascii b/system/terminal-codes/unknown/src/DEC.VT220.ascii new file mode 100644 index 0000000..c83f9b9 --- /dev/null +++ b/system/terminal-codes/unknown/src/DEC.VT220.ascii @@ -0,0 +1,49 @@ +TEXT VAR name :="DEC.VT220.ascii"; +new type (name); +cursor logic ( 1, 1, ""155"",";","H"); +enter outcode ( 1, 0, ""155"1;1H"); (* home *) +enter outcode ( 2, 0, ""155"C"); (* right *) +enter outcode ( 3, 0, ""155"A"); (* up *) +enter outcode ( 4, 40, ""155"J"); (* clear eop *) +enter outcode ( 5, 0, ""155"K"); (* clear eol *) +enter outcode (10, 0, ""132""); (* down *) +enter outcode (14, 0, ""155"27m "); (* end mark *) +enter outcode (15, 0, ""155"7m "); (* begin mark *) + +INT VAR i ; +FOR i FROM 127 UPTO 255 REP + enter outcode (i, "?") +PER ; + +enter outcode (214, ""196""); (* AE *) +enter outcode (215, ""214""); (* OE *) +enter outcode (216, ""220""); (* UE *) +enter outcode (217, ""228""); (* ae *) +enter outcode (218, ""246""); (* oe *) +enter outcode (219, ""252""); (* ue *) +enter outcode (220, "k"); (* Trenn-k *) +enter outcode (221, "-"); (* Trenn- *) +enter outcode (222, "#"); (* Pseudo-# *) +enter outcode (223, " "); (* gesch. Blank *) +enter outcode (251, ""223""); (* sz *) + +enter incode ( 1, ""155"4"126""); (* hop *) +enter incode ( 2, ""155"C"); (* right *) +enter incode ( 3, ""155"A"); (* up *) +enter incode ( 4, ""4""); (* info *) +enter incode ( 7, ""2""); (* sv *) +enter incode ( 7, ""254""); (* sv *) +enter incode ( 8, ""155"D"); (* left *) +enter incode (10, ""155"B"); (* down *) +enter incode (11, ""155"2"126""); (* rubin *) +enter incode (12, ""155"3"126""); (* rubout *) +enter incode (12, ""127""); (* rubout *) +enter incode (16, ""155"1"126""); (* mark *) +enter incode (17, ""1""); (* stop *) +enter incode (23, ""3""); (* weiter *) +enter incode (27, ""96""); (* esc *) + +enter incode (25, ""155""50""56""126""); (* help *) +enter incode (26, ""155""50""57""126""); (* do *) +enter incode (28, ""155"5"126""); (* prev screen *) +enter incode (29, ""155"6"126""); (* next screen *) diff --git a/system/terminal-codes/unknown/src/DEC.VT220.german b/system/terminal-codes/unknown/src/DEC.VT220.german new file mode 100644 index 0000000..e45114b --- /dev/null +++ b/system/terminal-codes/unknown/src/DEC.VT220.german @@ -0,0 +1,66 @@ +TEXT VAR name :="DEC.VT220.german"; +new type (name); +cursor logic ( 1, 1, ""155"",";","H"); +enter outcode ( 1, 0, ""155"1;1H"); (* home *) +enter outcode ( 2, 0, ""155"C"); (* right *) +enter outcode ( 3, 0, ""155"A"); (* up *) +enter outcode ( 4, 40, ""155"J"); (* clear eop *) +enter outcode ( 5, 0, ""155"K"); (* clear eol *) +enter outcode (10, 0, ""132""); (* newline *) +enter outcode (14, 0, ""155"27m "); (* end mark *) +enter outcode (15, 0, ""155"7m "); (* begin mark *) + +INT VAR i ; +FOR i FROM 127 UPTO 255 REP + enter outcode (i, "?") +PER ; + +enter outcode (214, ""196""); (* AE *) +enter outcode (215, ""214""); (* OE *) +enter outcode (216, ""220""); (* UE *) +enter outcode (217, ""228""); (* ae *) +enter outcode (218, ""246""); (* oe *) +enter outcode (219, ""252""); (* ue *) +enter outcode (220, "k"); (* Trenn-k *) +enter outcode (221, "-"); (* Trenn- *) +enter outcode (222, "#"); (* Pseudo-# *) +enter outcode (223, " "); (* gesch. Blank *) +enter outcode (251, ""223""); (* sz *) + + +enter incode (27, ""155"5"126""); (* esc *) +enter incode ( 1, ""155"4"126""); (* hop *) +enter incode ( 2, ""155"C"); (* right *) +enter incode ( 3, ""155"A"); (* up *) +enter incode ( 4, ""4""); (* info *) +enter incode ( 7, ""2""); (* sv *) +enter incode ( 7, ""254""); (* sv *) +enter incode ( 8, ""155"D"); (* left *) +enter incode (10, ""155"B"); (* down *) +enter incode (11, ""155"2"126""); (* rubin *) +enter incode (12, ""155"3"126""); (* rubout *) +enter incode (12, ""127""); (* rubout *) +enter incode (16, ""155"1"126""); (* mark *) +enter incode (17, ""1""); (* stop *) +enter incode (23, ""3""); (* weiter *) +enter incode (27, ""155"23~"); (* esc *) +enter incode (214, ""196""); (* AE *) +enter incode (215, ""214""); (* OE *) +enter incode (216, ""220""); (* UE *) +enter incode (217, ""228""); (* ae *) +enter incode (218, ""246""); (* oe *) +enter incode (219, ""252""); (* ue *) +enter incode (251, ""223""); (* sz *) + +enter incode (25, ""155""50""56""126""); (* help *) +enter incode (26, ""155""50""57""126""); (* do *) +enter incode (28, ""155"5"126""); (* prev screen *) +enter incode (29, ""155"6"126""); (* next screen *) + + + + + + + + diff --git a/system/terminal-codes/unknown/src/DM5 b/system/terminal-codes/unknown/src/DM5 new file mode 100644 index 0000000..a672698 --- /dev/null +++ b/system/terminal-codes/unknown/src/DM5 @@ -0,0 +1,53 @@ +LET name = "DM5"; + + forget (name,quiet); + new type (name); + +cursor logic (32,""27"F","",""); + +(*************************************************) +(**** Tasten des Beehive Standard Terminals : ****) +(*************************************************) +(** ae -> 24 Ae -> 20 home -> esc H **) +(** oe -> 25 Oe -> 21 hop -> 1 **) +(** ue -> 26 Ue -> 22 mark -> 4 **) +(** sz -> 30 rubin -> 5 **) +(** cursor r -> 12 weiter -> 15 **) +(** cursor u -> 11 sv -> 14 **) +(** halt -> 6 **) +(*************************************************) + +(* Ein- und Ausgabe-Steuerzeichen: *) +enter incode (1, ""27"H"); (* home *) enter outcode (1, 0, ""27"H"); +enter incode (16, ""4""); (* mark *) enter outcode (15, 0, ""27"dP "); +enter incode (11, ""5""); enter outcode (14, 0, ""27"m "); +enter incode (12, ""127""); +enter incode (7, ""14""); (* sv *) +enter incode (17, ""15""); (* halt *) +enter incode (23, ""6""); (* weiter *) + +enter outcode (5, 0, ""27"K"); enter incode (3, ""11""); +enter outcode (4, 40, ""27"J"); enter incode (2, ""12""); +enter outcode (3, ""11""); +enter outcode (2, 0, ""27"C"); + +(* Umlaute *) +(* Ae *) enter incode (214, ""20""); enter outcode (214, 0, ""27"dQA"27"m"); +(* Oe *) enter incode (215, ""21""); enter outcode (215, 0, ""27"dQO"27"m"); +(* Ue *) enter incode (216, ""22""); enter outcode (216, 0, ""27"dQU"27"m"); +(* ae *) enter incode (217, ""24""); enter outcode (217, 0, ""27"dQa"27"m"); +(* oe *) enter incode (218, ""25""); enter outcode (218, 0, ""27"dQo"27"m"); +(* ue *) enter incode (219, ""26""); enter outcode (219, 0, ""27"dQu"27"m"); +(* ss *) enter incode (251, ""30""); enter outcode (251, 0, ""27"dQB"27"m"); +(* paragraph *) + enter incode (252, ""64""); enter outcode (252, 0, ""27"dQ$"27"m"); + +(* Textkosmetik *) +enter outcode (124, 0, ""27"Rd"27"S") ; +enter outcode (220, "k") ; +enter outcode (221, 0, ""27"dA-"27"m") ; +enter outcode (222, 0, ""27"dQ#"27"m") ; +enter outcode (223, "_") ; + +enter outcode (255, "%"); + diff --git a/system/terminal-codes/unknown/src/ELBIT.ascii b/system/terminal-codes/unknown/src/ELBIT.ascii new file mode 100644 index 0000000..3957ee8 --- /dev/null +++ b/system/terminal-codes/unknown/src/ELBIT.ascii @@ -0,0 +1,32 @@ +TEXT VAR name :="ELBIT.ascii"; +new type (name); +elbit cursor; +enter outcode (1,12); +enter outcode (2 ,21 ); +enter outcode (3 ,26 ); +enter outcode (5 ,22 ); +enter outcode (4,64,""20""); +enter incode (1,""12""); +enter incode (2 ,""21"" ); +enter incode (3 ,""26"" ); +enter incode (4,""4""); (* info *) +enter incode (7,""2""); (* sv *) +enter incode (17,""1""); (* stop *) +enter incode (23,""3""); (* weiter *) + +enter outcode (214,"A"); +enter outcode (215,"O"); +enter outcode (216,"U"); +enter outcode (217,"a"); +enter outcode (218,"o"); +enter outcode (219,"u"); +enter outcode (251,"B"); + +enter outcode (220, "k"); (* Trenn-k *) +enter outcode (221, "-"); (* Trenn- *) +enter outcode (222, "#"); +enter outcode (223,"_") ; + +enter incode (11,""126""); (* rubin *) +enter incode (12,""127""); (* rubout *) +enter incode (16,"^") ; (* mark *) diff --git a/system/terminal-codes/unknown/src/ELBIT.german b/system/terminal-codes/unknown/src/ELBIT.german new file mode 100644 index 0000000..17d5454 --- /dev/null +++ b/system/terminal-codes/unknown/src/ELBIT.german @@ -0,0 +1,47 @@ +TEXT VAR name :="ELBIT.german"; +new type (name); +elbit cursor; +enter outcode (1,12); +enter outcode (2 ,21 ); +enter outcode (3 ,26 ); +enter outcode (5 ,22 ); +enter outcode (4,64,""20""); +enter incode (1,""12""); +enter incode (2 ,""21"" ); +enter incode (3 ,""26"" ); +enter incode (4,""4""); (* info *) +enter incode (7,""2""); (* sv *) +enter incode (17,""1""); (* stop *) +enter incode (23,""3""); (* weiter *) + +enter incode (214,""91""); +enter incode (215,""92""); +enter incode (216,""93""); +enter incode (217,""123""); +enter incode (218,""124""); +enter incode (219,""125""); +enter incode (251,""64""); + +enter outcode ( 91,"("); +enter outcode ( 92,"/"); +enter outcode ( 93,")"); +enter outcode (123,"<"); +enter outcode (124,"!"); +enter outcode (125,">"); +enter outcode (126,"^"); +enter outcode (214,91); +enter outcode (215,92); +enter outcode (216,93); +enter outcode (217,123); +enter outcode (218,124); +enter outcode (219,125); +enter outcode (251,64); + +enter outcode (220, "k"); (* Trenn-k *) +enter outcode (221, "-"); (* Trenn- *) +enter outcode (222, "#"); +enter outcode (223,"_") ; + +enter incode (11,""126""); (* rubin *) +enter incode (12,""127""); (* rubout *) +enter incode (16,"^") ; (* mark *) diff --git a/system/terminal-codes/unknown/src/FT10-20.ascii b/system/terminal-codes/unknown/src/FT10-20.ascii new file mode 100644 index 0000000..7f26910 --- /dev/null +++ b/system/terminal-codes/unknown/src/FT10-20.ascii @@ -0,0 +1,75 @@ + (* Autor : Rudolf Ruland *) + (* Stand : 14.07.86 *) + +INT VAR i; +TEXT VAR table :="FT10/20.ascii"; +forget (table, quiet); +new type (table); + +(****************** Steuerzeichen *************************************) + +enter incode ( 1, ""27"H"); (* HOP *) +enter incode ( 2, ""27"C"); (* RECHTS *) +enter incode ( 3, ""27"A"); (* OBEN *) +enter incode ( 4, ""4""); (* CNTL D *) (* INFO *) +enter incode ( 7, ""2""); (* CNTL B *) (* SV *) +enter incode ( 7, ""7""); (* CNTL G *) (* SV *) +enter incode ( 8, ""27"D"); (* LINKS *) +enter incode ( 9, ""27">"); (* BACKTAB *) (* TAB *) +enter incode (10, ""27"B"); (* UNTEN *) +enter incode (11, ""27"K"); (* RUBIN *) +enter incode (12, ""27"E"); (* RUBOUT *) +enter incode (12, ""127""); (* DEL *) (* RUBOUT *) +enter incode (16, ""27"J"); (* MARK *) +enter incode (17, ""1""); (* CNTL A *) (* STOP *) +enter incode (23, ""3""); (* CNTL C *) (* WEITER *) +enter incode (24, ""0"") ; (* BREAK *) (* weitere ESC-Zeichen *) +enter incode (25, ""27"N") ; (* LOCAL *) (* *) +enter incode (26, ""27"V") ; (* UNLOCK *) (* *) +enter incode (28, ""27"I") ; (* SEND PAGE *) (* *) + +FOR i FROM 0 UPTO 31 REP enter outcode (i, "S") PER; + +enter outcode ( 0, ""); (* NULL *) +enter outcode ( 1, 0, ""27"H"); (* HOME *) +enter outcode ( 2, 12); (* RECHTS *) +enter outcode ( 3, 11); (* OBEN *) +enter outcode ( 4, 40, ""27"J"); (* CL EOP *) +enter outcode ( 5, 0, ""27"K"); (* CL EOL *) +enter outcode ( 7, 7); (* BELL *) +enter outcode ( 8, 8); (* LINKS *) +enter outcode (10, 10); (* UNTEN *) +enter outcode (13, 13); (* RETURN *) +enter outcode (14, 0, ""27"d@ "); (* END MARK *) +enter outcode (15, 0, ""27"dP "); (* BEGIN MARK *) + +enter outcode (27, 27); (* ESC *) + +enter outcode (20, 14); (* shift out - grafic on *) +enter outcode (24, 14); +enter outcode (21, 15); (* shift in - grafic off*) +enter outcode (25, 15); +enter outcode (26, 5); (* answer back message *) + +cursor logic (32,""27"F","",""); + +(******************** Textzeichen *************************************) + +enter incode ( 92, ""27"/"); (* backslash *) + +FOR i FROM 127 UPTO 255 REP enter outcode (i, "?") PER; +FOR i FROM 129 UPTO 159 REP enter outcode (i, "E") PER; (* japanische *) +FOR i FROM 224 UPTO 239 REP enter outcode (i, "E") PER; (* ESC-Zeichen *) + +enter outcode (214, 0, ""27" 1"14""034""15""); (* *) +enter outcode (215, 0, ""27" 1"14""046""15""); (* *) +enter outcode (216, 0, ""27" 1"14""052""15""); (* *) +enter outcode (217, 0, ""27" 1"14""066""15""); (* *) +enter outcode (218, 0, ""27" 1"14""078""15""); (* *) +enter outcode (219, 0, ""27" 1"14""084""15""); (* *) +enter outcode (220, "k"); (* Trenn-k *) +enter outcode (221, 0, ""27" 3"14""077""15""); (* Trenn-Strich *) +enter outcode (222, 0, ""27" 4"14""069""15""); (* gesch. Nummerkreuz *) +enter outcode (223, 0, ""27" 2"14""110""15""); (* gesch. Blank *) +enter outcode (251, 0, ""27" 1"14""062""15""); (* *) +enter outcode (252, 0, ""27" 1"14""063""15""); (* *) diff --git a/system/terminal-codes/unknown/src/FT10-20.german b/system/terminal-codes/unknown/src/FT10-20.german new file mode 100644 index 0000000..09d4337 --- /dev/null +++ b/system/terminal-codes/unknown/src/FT10-20.german @@ -0,0 +1,94 @@ + (* Autor : Rudolf Ruland *) + (* Stand : 14.07.86 *) + +INT VAR i; +TEXT VAR table :="FT10/20.german"; +forget (table, quiet); +new type (table); + +(****************** Steuerzeichen *************************************) + +enter incode ( 1, ""27"H"); (* HOP *) +enter incode ( 2, ""27"C"); (* RECHTS *) +enter incode ( 3, ""27"A"); (* OBEN *) +enter incode ( 4, ""4""); (* CNTL D *) (* INFO *) +enter incode ( 7, ""2""); (* CNTL B *) (* SV *) +enter incode ( 7, ""7""); (* CNTL G *) (* SV *) +enter incode ( 8, ""27"D"); (* LINKS *) +enter incode ( 9, ""27">"); (* BACKTAB *) (* TAB *) +enter incode (10, ""27"B"); (* UNTEN *) +enter incode (11, ""27"K"); (* RUBIN *) +enter incode (12, ""27"E"); (* RUBOUT *) +enter incode (12, ""127""); (* DEL *) (* RUBOUT *) +enter incode (16, ""27"J"); (* MARK *) +enter incode (17, ""1""); (* CNTL A *) (* STOP *) +enter incode (23, ""3""); (* CNTL C *) (* WEITER *) +enter incode (24, ""0"") ; (* BREAK *) (* weitere ESC-Zeichen *) +enter incode (25, ""27"N") ; (* LOCAL *) (* *) +enter incode (26, ""27"V") ; (* UNLOCK *) (* *) +enter incode (28, ""27"I") ; (* SEND PAGE *) (* *) + +FOR i FROM 0 UPTO 31 REP enter outcode (i, "S") PER; + +enter outcode ( 0, ""); (* NULL *) +enter outcode ( 1, 0, ""27"H"); (* HOME *) +enter outcode ( 2, 12); (* RECHTS *) +enter outcode ( 3, 11); (* OBEN *) +enter outcode ( 4, 40, ""27"J"); (* CL EOP *) +enter outcode ( 5, 0, ""27"K"); (* CL EOL *) +enter outcode ( 7, 7); (* BELL *) +enter outcode ( 8, 8); (* LINKS *) +enter outcode (10, 10); (* UNTEN *) +enter outcode (13, 13); (* RETURN *) +enter outcode (14, 0, ""27"d@ "); (* END MARK *) +enter outcode (15, 0, ""27"dP "); (* BEGIN MARK *) + +enter outcode (27, 27); (* ESC *) + +enter outcode (20, 14); (* shift out - grafic on *) +enter outcode (24, 14); +enter outcode (21, 15); (* shift in - grafic off*) +enter outcode (25, 15); +enter outcode (26, 5); (* answer back message *) + +cursor logic (32,""27"F","",""); + +(******************** Textzeichen *************************************) + +enter incode ( 39, "/"); (* ' *) +enter incode ( 47, "'"); (* / *) +enter incode ( 92, ""27"/"); (* backslash *) +enter incode (214, ""91""); (* *) +enter incode (215, ""92""); (* *) +enter incode (216, ""93""); (* *) +enter incode (217, ""123""); (* *) +enter incode (218, ""124""); (* *) +enter incode (219, ""125""); (* *) +enter incode (251, ""126""); (* *) +enter incode (252, ""064""); (* *) + +FOR i FROM 127 UPTO 255 REP enter outcode (i, "?") PER; +FOR i FROM 129 UPTO 159 REP enter outcode (i, "E") PER; (* japanische *) +FOR i FROM 224 UPTO 239 REP enter outcode (i, "E") PER; (* ESC-Zeichen *) + + +enter outcode ( 64, 0, ""27" 0"14""064""15""); (* @ *) +enter outcode ( 91, 0, ""27" 0"14""091""15""); (* [ *) +enter outcode ( 92, 0, ""27" 0"14""092""15""); (* \ *) +enter outcode ( 93, 0, ""27" 0"14""093""15""); (* ] *) +enter outcode (123, 0, ""27" 0"14""123""15""); (* geschw. Klammer auf *) +enter outcode (124, 0, ""27" 0"14""124""15""); (* | *) +enter outcode (125, 0, ""27" 0"14""125""15""); (* geschw. Klammer zu *) +enter outcode (126, 0, ""27" 0"14""126""15""); (* ~ *) +enter outcode (214, 91); (* *) +enter outcode (215, 92); (* *) +enter outcode (216, 93); (* *) +enter outcode (217, 123); (* *) +enter outcode (218, 124); (* *) +enter outcode (219, 125); (* *) +enter outcode (220, "k"); (* Trenn-k *) +enter outcode (221, 0, ""27" 3"14""077""15""); (* Trenn-Strich *) +enter outcode (222, 0, ""27" 4"14""069""15""); (* gesch. Nummerkreuz *) +enter outcode (223, 0, ""27" 2"14""110""15""); (* gesch. Blank *) +enter outcode (251, 126); (* *) +enter outcode (252, 64); (* *) diff --git a/system/terminal-codes/unknown/src/GENGEN.ELA b/system/terminal-codes/unknown/src/GENGEN.ELA new file mode 100644 index 0000000..ca88fd7 --- /dev/null +++ b/system/terminal-codes/unknown/src/GENGEN.ELA @@ -0,0 +1,244 @@ +(* Typtabellengenerierungsprogramm, Stand : 26.11.85 *) + +page ; +putline ("- Erzeugen einer .gen Datei aus einer Typtabelle -") ; +line ; +BOUND STRUCT (ALIGN space, ROW 128 INT outcodes, + ROW 64 INT outstrings, + ROW 64 INT instrings) VAR x ; + +TEXT VAR t , filename ; +INT VAR i , laenge , position , eumel code ; +FILE VAR f ; +put ("Name der Tabelle:") ; +getline (t) ; +IF exists (t+".gen") THEN forget (t+".gen") FI ; +IF exists (t+".gen") +THEN filename := t + ".new.gen" +ELSE filename := t + ".gen" +FI ; +f := sequentialfile (output, filename) ; +putline (f, "(" + 49 * "*" + ")") ; +putline (f, "(* Typtabelle : " + text (t, 30) + " *)") ; +putline (f, "(* Generiert am : " + text (date, 30) + " *)") ; +putline (f, "(" + 49 * "*" + ")") ; +line (f) ; +putline (f, "forget (""" + t + """, quiet) ;") ; +putline (f, "new type (""" + t + """) ;") ; +line (f) ; +x := old (t) ; +t := " " ; +IF (x.outstrings (1) AND 255) = 2 + THEN putline (f, "elbit cursor ;") ; + line (f) ; + ELSE write (f, "cursor logic (") ; + put (f, text (x.outstrings (2) AND 255) + ",") ; + position := (x.outcodes (4) AND 127) + 1 ; + put (f, denoter (x.outstrings, position, 0) + ",") ; + position INCR (laenge + 2) ; + put (f, denoter (x.outstrings, position, 0) + ",") ; + position INCR (laenge + 2) ; + putline (f, denoter (x.outstrings, position, 0) + ") ;") ; + line (f) +FI ; +putline (f, "(* Ausgabe Codes : *)") ; +FOR i FROM 1 UPTO 128 REP + cout (lineno (f)) ; + replace (t, 1, x.outcodes (i)) ; + IF i <> 4 + THEN IF code (t SUB 1) <> 255 + THEN eumel code := (i-1) * 2 ; + put (f, "enter outcode (" + text (eumel code, 3) + ",") ; + IF code (t SUB 1) > 127 + THEN outstring (code (t SUB 1)-128) + ELSE numberput (code (t SUB 1)) + FI ; + line (f) + FI + FI ; + IF code (t SUB 2) <> 255 + THEN eumel code := (i-1) * 2 + 1 ; + put (f, "enter outcode (" + text (eumel code, 3) + ",") ; + IF code (t SUB 2) > 127 + THEN outstring (code (t SUB 2) - 128) + ELSE numberput (code (t SUB 2)) + FI ; + line (f) + FI ; +PER ; +line (f) ; +line (f) ; + +putline (f, "(* Eingabe Codes : *)") ; +i := 0 ; +WHILE i < 128 CAND incode (i) <> 255 REP + cout (lineno (f)) ; + eumel code := incode (i) ; + put (f, "enter incode (" + text (eumel code,3) + ",") ; + write (f, denoter (x.instrings, i + 1, 255)) ; + put (f, ") ; (*") ; + i INCR 1 ; + IF in bezeichnung (eumel code) <> "" + THEN put (f, in bezeichnung (eumel code) + ":") + FI ; + WHILE i < 128 CAND incode (i) <> 255 REP + charput (incode (i)) ; + i INCR 1 + PER ; + i INCR 1 ; + putline (f, "*)") +PER ; + +edit (filename) ; + +INT PROC incode (INT CONST element) : + TEXT VAR t := " " ; + replace (t, 1, x.instrings (element DIV 2 + 1)); + IF (element MOD 2) = 0 THEN code (t SUB 1) + ELSE code (t SUB 2) + FI +ENDPROC incode ; + + +TEXT PROC in bezeichnung (INT CONST code) : + SELECT code OF + CASE 1 : "HOP " + CASE 2 : "Cursor right" + CASE 3 : "Cursor up " + CASE 7 : "SV - Call " + CASE 8 : "Cursor left " + CASE 9 : "TAB " + CASE 10: "Cursor down " + CASE 11: "RUBIN " + CASE 12: "RUBOUT " + CASE 13: "CR " + CASE 16: "MARK " + CASE 17: "Stop " + CASE 23: "Weiter " + CASE 27: "Escape " + CASE 214:"ae-Taste " + CASE 215:"oe-Taste " + CASE 216:"ue-Taste " + CASE 217:"Ae-Taste " + CASE 218:"Oe-Taste " + CASE 219:"Ue-Taste " + CASE 220:"Trenn-k " + CASE 221:"Trennstrich " + CASE 222:"Fest-# " + CASE 223:"Fest-Blank " + CASE 251:"sz-Taste " + OTHERWISE IF code < 32 THEN "Funct.-Taste" + ELSE "" + FI + ENDSELECT +ENDPROC in bezeichnung ; + +TEXT PROC out bezeichnung (INT CONST code) : + SELECT code OF + CASE 1 : "Cursor Home " + CASE 2 : "Cursor right" + CASE 3 : "Cursor up " + CASE 4 : "CLEOP " + CASE 5 : "CLEOL " + CASE 6 : "Cursor (YX) " + CASE 7 : "Beep " + CASE 8 : "Cursor left " + CASE 10: "Cursor down " + CASE 13: "CR " + CASE 14: "END MARK " + CASE 15: "BEGIN MARK " + CASE 214:"ae " + CASE 215:"oe " + CASE 216:"ue " + CASE 217:"Ae " + CASE 218:"Oe " + CASE 219:"Ue " + CASE 220:"Trenn-k " + CASE 221:"Trennstrich " + CASE 222:"Fest-# " + CASE 223:"Fest-Blank " + CASE 251:"sz " + OTHERWISE "" + ENDSELECT +ENDPROC out bezeichnung ; + +PROC charput (INT CONST nr) : + IF nr = 27 THEN put (f, "") + ELIF nr = 10 THEN put (f, "") + ELIF nr = 13 THEN put (f, "") + ELIF nr = 32 THEN put (f, "") + ELIF nr = 127 THEN put (f, "") + ELIF nr > 127 THEN put (f, "<" + text (nr) + ">") + ELIF nr > 32 THEN put (f, code (nr)) + ELSE put (f, "") + FI +ENDPROC charput ; + +PROC numberput (INT CONST nr) : + put (f, text (nr,3 ) + ") ; (*") ; + IF out bezeichnung (eumel code) <> "" + THEN put (f, out bezeichnung (eumel code) + ":") + FI ; + charput (nr) ; + put (f, "*)") ; +ENDPROC numberput ; + +TEXT PROC denoter (ROW 64 INT VAR y, INT CONST pos, ende) : + INT VAR i := pos ; + TEXT VAR t := " " , zeile := """" ; + laenge := 0 ; + WHILE i < 128 AND zugriff <> ende REP + IF zugriff > 31 AND zugriff < 127 THEN zeile CAT code (zugriff) + ELIF zugriff = 34 THEN zeile CAT """""" + ELIF zugriff = 251 THEN zeile CAT "" + ELIF zugriff > 216 AND zugriff < 224 THEN zeile CAT code (zugriff) + ELSE zeile CAT """" ; + zeile CAT text (zugriff) ; + zeile CAT """" + FI ; + i INCR 1 ; + laenge INCR 1 + PER ; + zeile CAT """" ; + zeile. + + +zugriff : + replace (t, 1, y (i DIV 2 + 1)) ; + IF (i MOD 2) = 0 THEN code (t SUB 1) + ELSE code (t SUB 2) + FI +ENDPROC denoter ; + + +PROC outstring (INT CONST element) : + INT VAR i := element ; + put (f, text (zugriff) + ",") ; + put (f, denoter (x.outstrings, i + 1, 0) + ") ; (*") ; + IF out bezeichnung (eumel code) <> "" + THEN put (f, out bezeichnung (eumel code) + ":") + FI ; + i INCR 1 ; + WHILE zugriff <> 0 REP + charput (zugriff) ; + i INCR 1 + PER ; + put (f, "*)") . + + +zugriff : + TEXT VAR t := " " ; + replace (t, 1, x.outstrings (i DIV 2 + 1)) ; + IF (i MOD 2) = 0 THEN code (t SUB 1) + ELSE code (t SUB 2) + FI +ENDPROC outstring + + + + + + + + + diff --git a/system/terminal-codes/unknown/src/GT100 b/system/terminal-codes/unknown/src/GT100 new file mode 100644 index 0000000..c366d09 --- /dev/null +++ b/system/terminal-codes/unknown/src/GT100 @@ -0,0 +1,44 @@ +TEXT VAR name :="GT100"; +new type (name); +cursor logic (32,""27"=","",""); +enter outcode (1 ,0,""27"H"); +enter outcode (2 ,0,""27"C"); +enter outcode (3 ,0,""27"A"); +enter outcode (4 ,40,""27"Y"); +enter outcode (5 ,0,""27"T"); +enter outcode (14,0,""126""); +enter outcode (15,0,""126""); + + +INT VAR i ; +FOR i FROM 127 UPTO 255 REP + enter outcode (i, "?") +PER ; + +enter outcode (220, "k"); (* Trenn-k *) +enter outcode (221, "-"); (* Trenn- *) +enter outcode (222, "#"); + +enter outcode (214,91); +enter outcode (215,92); +enter outcode (216,93); +enter outcode (217,123); +enter outcode (218,124); +enter outcode (219,125); +enter outcode (223,"_") ; +enter outcode (251,"B"); + + +enter incode ( 1,""30""); +enter incode ( 2,""12""); +enter incode ( 3,""11""); +enter incode (10,""10""); +enter incode ( 8,""8""); +enter incode (11,""6""); +enter incode (12,""127""); +enter incode (16,""26""); +enter incode (4,""4""); (* info *) +enter incode (7,""27"z"); (* sv *) +enter incode (17,""1""); (* stop *) +enter incode (23,""17""); (* weiter *) + diff --git a/system/terminal-codes/unknown/src/IBM.PC.AT b/system/terminal-codes/unknown/src/IBM.PC.AT new file mode 100644 index 0000000..37bf015 --- /dev/null +++ b/system/terminal-codes/unknown/src/IBM.PC.AT @@ -0,0 +1,63 @@ +LET name = "IBM.PC.AT"; +forget (name, quiet); +new type (name); + +cursor logic (0, ""6"", "", ""); + +enter outcode ( 14, 0, ""14" "); (* end mark *) +enter outcode ( 15, 0, ""15" "); (* begin mark *) +enter outcode (214, 142); (* *) +enter outcode (215, 153); (* *) +enter outcode (216, 154); (* *) +enter outcode (217, 132); (* *) +enter outcode (218, 148); (* *) +enter outcode (219, 129); (* *) +enter outcode (220, 0, ""15""107""14""); (* druck k *) +enter outcode (221, 0, ""15""45""14""); (* druck - *) +enter outcode (222, 0, ""15""35""14""); (* druck # *) +enter outcode (223, 0, ""15""32""14""); (* druck *) +enter outcode (251, 225); (* *) + +enter incode ( 1, ""199""); (* HOP *) +enter incode ( 2, ""205""); (* RECHTS *) +enter incode ( 3, ""200""); (* OBEN *) +enter incode ( 4, ""4""); (* INFO *) +enter incode ( 7, ""2""); (* SV *) +enter incode ( 7, ""187""); (* SV *) +enter incode ( 8, ""203""); (* LINKS *) +enter incode ( 10, ""208""); (* UNTEN *) +enter incode ( 11, ""210""); (* RUBIN *) +enter incode ( 12, ""211""); (* RUBOUT *) +enter incode ( 16, ""201""); (* MARK *) +enter incode ( 17, ""1""); (* STOP *) +enter incode ( 18, ""209""); (* NEWLINE *) +enter incode ( 23, ""3""); (* WEITER *) +enter incode ( 27, ""96""); (* ESC *) +enter incode ( 34, ""64""); (* " *) +enter incode ( 38, ""94""); (* & *) +enter incode ( 39, ""61""); (* ' *) +enter incode ( 40, ""42""); (* ( *) +enter incode ( 41, ""40""); (* ) *) +enter incode ( 42, ""125""); (* * *) +enter incode ( 43, ""93""); (* + *) +enter incode ( 45, ""47""); (* - *) +enter incode ( 47, ""38""); (* / *) +enter incode ( 58, ""62""); (* : *) +enter incode ( 59, ""60""); (* ; *) +enter incode ( 60, ""92""); (* < *) +enter incode ( 61, ""41""); (* = *) +enter incode ( 62, ""124""); (* > *) +enter incode ( 63, ""95""); (* ? *) +enter incode ( 89, ""90""); (* Y *) +enter incode ( 90, ""89""); (* Z *) +enter incode ( 95, ""63""); (* _ *) +enter incode ( 96, ""43""); (* ` *) +enter incode (121, ""122""); (* y *) +enter incode (122, ""121""); (* z *) +enter incode (214, ""34""); (* *) +enter incode (215, ""58""); (* *) +enter incode (216, ""123""); (* *) +enter incode (217, ""39""); (* *) +enter incode (218, ""59""); (* *) +enter incode (219, ""91""); (* *) +enter incode (251, ""45""); (* *) diff --git a/system/terminal-codes/unknown/src/M20 b/system/terminal-codes/unknown/src/M20 new file mode 100644 index 0000000..6de575a --- /dev/null +++ b/system/terminal-codes/unknown/src/M20 @@ -0,0 +1,10 @@ +TEXT VAR name :="M20"; +command dialogue (FALSE); forget (name); +new type (name); +cursor logic (0,""6"","",""); + +enter incode (7,""7""); (* sv *) + + +enter outcode (14,""14""); +enter outcode (15,""15""); diff --git a/system/terminal-codes/unknown/src/M20.original b/system/terminal-codes/unknown/src/M20.original new file mode 100644 index 0000000..31bb7c4 --- /dev/null +++ b/system/terminal-codes/unknown/src/M20.original @@ -0,0 +1,27 @@ +TEXT VAR name := "M20.original"; +command dialogue (FALSE); forget (name); +new type (name); +cursor logic (0,""6"","",""); + +enter outcode (14, ""14""); +enter outcode (15, ""15""); + +enter incode (7,""7""); (* sv *) +enter incode ( code ( ";" ), "!"); +enter incode ( code ( "=" ), "@"); +enter incode ( code ( "%" ), "$"); +enter incode ( code ( "&" ), "%"); +enter incode ( code ( "(" ), "&"); +enter incode ( code ( ")" ), "/"); +enter incode ( code ( "_" ), "("); +enter incode ( code ( "@" ), ")"); +enter incode ( code ( "/" ), "="); +enter incode ( code ( ":" ), "?"); +enter incode ( code ( "^" ), ""); +enter incode ( code ( "!" ), ":"); +enter incode ( code ( "" ), "_"); +enter incode ( code ( "$" ), "#"); +enter incode ( code ( "#" ), "^"); +enter incode ( code ( "?" ), ";"); + +command dialogue (TRUE); diff --git a/system/terminal-codes/unknown/src/M24 b/system/terminal-codes/unknown/src/M24 new file mode 100644 index 0000000..bf8cae3 --- /dev/null +++ b/system/terminal-codes/unknown/src/M24 @@ -0,0 +1,63 @@ +LET name = "M24"; +forget (name, quiet); +new type (name); + +cursor logic (0, ""6"", "", ""); + +enter outcode ( 14, 0, ""14" "); (* end mark *) +enter outcode ( 15, 0, ""15" "); (* begin mark *) +enter outcode (214, 142); (* *) +enter outcode (215, 153); (* *) +enter outcode (216, 154); (* *) +enter outcode (217, 132); (* *) +enter outcode (218, 148); (* *) +enter outcode (219, 129); (* *) +enter outcode (220, 0, ""15""107""14""); (* druck k *) +enter outcode (221, 0, ""15""45""14""); (* druck - *) +enter outcode (222, 0, ""15""35""14""); (* druck # *) +enter outcode (223, 0, ""15""32""14""); (* druck *) +enter outcode (251, 225); (* *) + +enter incode ( 4, ""4""); (* INFO *) +enter incode ( 7, ""7""); (* SV *) +enter incode ( 7, ""206""); (* SV *) +enter incode ( 17, ""17""); (* STOP *) +enter incode ( 17, ""208""); (* STOP *) +enter incode ( 23, ""23""); (* WEITER *) +enter incode ( 23, ""207""); (* WEITER *) + +enter incode ( 34, ""64""); (* " *) +enter incode ( 35, ""96""); (* # *) +enter incode ( 38, ""94""); (* & *) +enter incode ( 39, ""61""); (* ' *) +enter incode ( 40, ""42""); (* ( *) +enter incode ( 41, ""40""); (* ) *) +enter incode ( 42, ""125""); (* * *) +enter incode ( 42, ""201""); (* * *) +enter incode ( 43, ""93""); (* + *) +enter incode ( 43, ""203""); (* + *) +enter incode ( 45, ""47""); (* - *) +enter incode ( 45, ""202""); (* - *) +enter incode ( 47, ""38""); (* / *) +enter incode ( 47, ""200""); (* / *) +enter incode ( 58, ""62""); (* : *) +enter incode ( 59, ""60""); (* ; *) +enter incode ( 60, ""92""); (* < *) +enter incode ( 61, ""41""); (* = *) +enter incode ( 62, ""124""); (* > *) +enter incode ( 63, ""95""); (* ? *) +enter incode ( 64, ""35""); (* @ *) +enter incode ( 89, ""90""); (* Y *) +enter incode ( 90, ""89""); (* Z *) +enter incode ( 94, ""126""); (* ^ *) +enter incode ( 95, ""63""); (* _ *) +enter incode ( 96, ""43""); (* ` *) +enter incode (121, ""122""); (* y *) +enter incode (122, ""121""); (* z *) +enter incode (214, ""34""); (* *) +enter incode (215, ""58""); (* *) +enter incode (216, ""123""); (* *) +enter incode (217, ""39""); (* *) +enter incode (218, ""59""); (* *) +enter incode (219, ""91""); (* *) +enter incode (251, ""45""); (* *) diff --git a/system/terminal-codes/unknown/src/M24.keybfr1 b/system/terminal-codes/unknown/src/M24.keybfr1 new file mode 100644 index 0000000..33949d4 --- /dev/null +++ b/system/terminal-codes/unknown/src/M24.keybfr1 @@ -0,0 +1,64 @@ + +LET name = "M24.keybfr1"; +forget(name,quiet); +new type (name); + +cursor logic (0, ""6"", "", ""); + +enter outcode ( 14, 0, ""14" "); (* end mark *) +enter outcode ( 15, 0, ""15" "); (* begin mark *) +enter outcode (214, 142); (* *) +enter outcode (215, 153); (* *) +enter outcode (216, 154); (* *) +enter outcode (217, 132); (* *) +enter outcode (218, 148); (* *) +enter outcode (219, 129); (* *) +enter outcode (220, 0, ""15""107""14""); (* druck k *) +enter outcode (221, 0, ""15""45""14""); (* druck - *) +enter outcode (222, 0, ""15""35""14""); (* druck # *) +enter outcode (223, 0, ""15""32""14""); (* druck *) +enter outcode (251, 225); +enter incode ( 4, ""4""); (* INFO *) +enter incode ( 7, ""7""); (* SV *) +enter incode ( 7, ""206""); (* SV *) +enter incode ( 17, ""17""); (* STOP *) +enter incode ( 17, ""208""); (* STOP *) +enter incode ( 23, ""23""); (* WEITER *) +enter incode ( 23, ""207""); (* WEITER *) +enter incode ( 45, ""61""); (* - *) +enter incode (125, ""96""); (* *) +enter incode ( 41, ""95""); (* ) *) +enter incode ( 35, ""45""); (* # *) +enter incode ( 38, ""33""); (* & *) +enter incode (130, ""64""); (* *) +enter incode ( 34, ""35""); (* " *) +enter incode ( 39, ""36""); (* ' *) +enter incode ( 40, ""37""); (* ( *) +enter incode (151, ""39""); (* *) +enter incode (138, ""38""); (* *) +enter incode ( 33, ""42""); (* ! *) +enter incode (135, ""40""); (* *) +enter incode (133, ""41""); (* *) +enter incode ( 97, ""113""); (* a *) +enter incode ( 65, ""81""); (* A *) +enter incode ( 122,""119""); (* z *) +enter incode ( 90, ""87""); (* Z *) +enter incode ( 42, ""125""); (* * *) +enter incode (113, ""97""); (* q *) +enter incode ( 81, ""65""); (* Q *) +enter incode (109, ""59""); (* m *) +enter incode ( 77, ""58""); (* M *) +enter incode ( 37, ""34""); (* % *) +enter incode ( 60, ""92""); (* < *) +enter incode ( 62, ""124""); (* > *) +enter incode (119, ""122""); (* w *) +enter incode ( 87, ""90""); (* W *) +enter incode ( 44, ""109""); (* , *) +enter incode ( 63, ""77""); (* ? *) +enter incode ( 59, ""44""); (* ; *) +enter incode ( 46, ""60""); (* . *) +enter incode ( 58, ""46""); (* : *) +enter incode ( 61, ""47""); (* = *) +enter incode ( 43, ""63""); (* + *) +enter incode ( 47, ""62""); (* / *) + diff --git a/system/terminal-codes/unknown/src/PC.KB2 b/system/terminal-codes/unknown/src/PC.KB2 new file mode 100644 index 0000000..8b673a8 --- /dev/null +++ b/system/terminal-codes/unknown/src/PC.KB2 @@ -0,0 +1,79 @@ +LET type = "PC.KB2"; +IF exists (type) THEN forget (type, quiet) FI; +new type (type); +cursor logic (0, ""6"", "", ""); + +enter outcode ( 14, 0, ""14" "); {end mark} +enter outcode ( 15, 0, ""15" "); {begin mark} +enter outcode (214, ""142""); {} +enter outcode (215, ""153""); {} +enter outcode (216, ""154""); {} +enter outcode (217, ""132""); {} +enter outcode (218, ""148""); {} +enter outcode (219, ""129""); {} +enter outcode (220, 0, ""15"k"14""); {trenn-k} +enter outcode (221, 0, ""15"-"14""); {trenn-strich} +enter outcode (222, 0, ""15"#"14""); {pseudo-fis} +enter outcode (223, 0, ""15" "14""); {pseudo-blank} +enter outcode (251, ""225""); {} + +enter incode ( 1, ""199""); {hop} +enter incode ( 2, ""205""); {rechts} +enter incode ( 3, ""200""); {oben} +enter incode ( 7, ""2""); {sv: ctrl b} +enter incode ( 7, ""187""); {sv: f1} +enter incode ( 8, ""203""); {links} +enter incode ( 10, ""208""); {unten} +enter incode ( 11, ""210""); {rubin: ins} +enter incode ( 12, ""211""); {rubout: del} +enter incode ( 16, ""201""); {mark: pg up} +enter incode ( 17, ""1""); {stop: ctrl a} + +(* +enter incode ( 18, ""190""); {""18"": f2} +enter incode ( 19, ""191""); {""19"": f3} +enter incode ( 20, ""192""); {""20"": f4} +enter incode ( 21, ""193""); {""21"": f5} +enter incode ( 22, ""194""); {""22"": f6} +*) + +enter incode ( 23, ""3""); {start: ctrl b} +enter incode ( 23, "00"); {start: 00} + +(* +enter incode ( 24, ""195""); {""24"": f7} +enter incode ( 25, ""196""); {""25"": f8} +enter incode ( 26, ""212""); {""26"": f9} +enter incode ( 28, ""213""); {""28"": f10} +enter incode ( 29, ""214""); {""29"": f11} +enter incode ( 30, ""215""); {""30"": f12} +enter incode ( 31, ""216""); {""31"": f13} +*) + +enter incode ( 35, ""93""); {#} +enter incode ( 39, ""94""); {'} +enter incode ( 42, ""123""); {*} +enter incode ( 43, ""91""); {+} +enter incode ( 45, ""47""); {-} +enter incode ( 47, ""39""); {/} +enter incode ( 58, ""62""); {:} +enter incode ( 59, ""60""); {;} +enter incode ( 60, ""92""); {<} +enter incode ( 61, ""95""); {=} +enter incode ( 62, ""124""); {>} +enter incode ( 63, ""61""); {?} +enter incode ( 64, ""35""); {@} +enter incode ( 89, ""90""); {Y} +enter incode ( 90, ""89""); {Z} +enter incode ( 94, ""125""); {^} +enter incode ( 95, ""63""); {_} +enter incode ( 96, ""126""); {\} +enter incode (121, ""122""); {y} +enter incode (122, ""121""); {z} +enter incode (214, ""42""); {} +enter incode (215, ""43""); {} +enter incode (216, ""96""); {} +enter incode (217, ""58""); {} +enter incode (218, ""59""); {} +enter incode (219, ""64""); {} +enter incode (251, ""45""); {} diff --git a/system/terminal-codes/unknown/src/PC.french b/system/terminal-codes/unknown/src/PC.french new file mode 100644 index 0000000..6a1675c --- /dev/null +++ b/system/terminal-codes/unknown/src/PC.french @@ -0,0 +1,68 @@ +LET name = "PC.french"; +forget (name, quiet); +new type (name); + +cursor logic (0, ""6"", "", ""); + +enter outcode ( 14, 0, ""14" "); (* end mark *) +enter outcode ( 15, 0, ""15" "); (* begin mark *) +enter outcode (214, 142); (* *) +enter outcode (215, 153); (* *) +enter outcode (216, 154); (* *) +enter outcode (217, 132); (* *) +enter outcode (218, 148); (* *) +enter outcode (219, 129); (* *) +enter outcode (220, 0, ""15""107""14""); (* druck k *) +enter outcode (221, 0, ""15""45""14""); (* druck - *) +enter outcode (222, 0, ""15""35""14""); (* druck # *) +enter outcode (223, 0, ""15""32""14""); (* druck *) +enter outcode (251, 225); (* *) + +enter incode ( 1, ""199""); (* HOP *) +enter incode ( 2, ""205""); (* RECHTS *) +enter incode ( 3, ""200""); (* OBEN *) +enter incode ( 4, ""4""); (* INFO *) +enter incode ( 7, ""2""); (* SV *) +enter incode ( 8, ""203""); (* LINKS *) +enter incode ( 10, ""208""); (* UNTEN *) +enter incode ( 11, ""210""); (* RUBIN *) +enter incode ( 12, ""211""); (* RUBOUT *) +enter incode ( 16, ""201""); (* MARK *) +enter incode ( 17, ""1""); (* STOP *) +enter incode ( 18, ""209""); (* NEWLINE *) +enter incode ( 23, ""3""); (* WEITER *) +enter incode ( 45, ""61""); (* - *) +enter incode ( 41, ""95""); (* ) *) +enter incode ( 35, ""45""); (* # *) +enter incode ( 38, ""33""); (* & *) +enter incode ( 34, ""35""); (* " *) +enter incode ( 40, ""37""); (* ( *) +enter incode ( 33, ""42""); (* ! *) +enter incode ( 97, ""113""); (* a *) +enter incode ( 65, ""81""); (* A *) +enter incode ( 122,""119""); (* z *) +enter incode ( 90, ""87""); (* Z *) +enter incode ( 42, ""125""); (* * *) +enter incode (113, ""97""); (* q *) +enter incode ( 81, ""65""); (* Q *) +enter incode (109, ""59""); (* m *) +enter incode ( 77, ""58""); (* M *) +enter incode ( 37, ""34""); (* % *) +enter incode ( 60, ""92""); (* < *) +enter incode ( 62, ""124""); (* > *) +enter incode (119, ""122""); (* w *) +enter incode ( 87, ""90""); (* W *) +enter incode ( 44, ""109""); (* , *) +enter incode ( 63, ""77""); (* ? *) +enter incode ( 59, ""44""); (* ; *) +enter incode ( 46, ""60""); (* . *) +enter incode ( 58, ""46""); (* : *) +enter incode ( 61, ""47""); (* = *) +enter incode ( 43, ""63""); (* + *) +enter incode ( 47, ""62""); (* / *) +enter incode (125, ""96""); (* } *) + + + + + diff --git a/system/terminal-codes/unknown/src/PC.german b/system/terminal-codes/unknown/src/PC.german new file mode 100644 index 0000000..0634cb8 --- /dev/null +++ b/system/terminal-codes/unknown/src/PC.german @@ -0,0 +1,63 @@ +LET name = "PC.german"; +forget (name, quiet); +new type (name); + +cursor logic (0, ""6"", "", ""); + +enter outcode ( 14, 0, ""14" "); (* end mark *) +enter outcode ( 15, 0, ""15" "); (* begin mark *) +enter outcode (214, 142); (* *) +enter outcode (215, 153); (* *) +enter outcode (216, 154); (* *) +enter outcode (217, 132); (* *) +enter outcode (218, 148); (* *) +enter outcode (219, 129); (* *) +enter outcode (220, 0, ""15""107""14""); (* druck k *) +enter outcode (221, 0, ""15""45""14""); (* druck - *) +enter outcode (222, 0, ""15""35""14""); (* druck # *) +enter outcode (223, 0, ""15""32""14""); (* druck *) +enter outcode (251, 225); (* *) + +enter incode ( 1, ""199""); (* HOP *) +enter incode ( 2, ""205""); (* RECHTS *) +enter incode ( 3, ""200""); (* OBEN *) +enter incode ( 4, ""4""); (* INFO *) +enter incode ( 7, ""2""); (* SV *) +enter incode ( 8, ""203""); (* LINKS *) +enter incode ( 10, ""208""); (* UNTEN *) +enter incode ( 11, ""210""); (* RUBIN *) +enter incode ( 12, ""211""); (* RUBOUT *) +enter incode ( 16, ""201""); (* MARK *) +enter incode ( 17, ""1""); (* STOP *) +enter incode ( 18, ""209""); (* NEWLINE *) +enter incode ( 23, ""3""); (* WEITER *) +enter incode ( 34, ""64""); (* " *) +enter incode ( 35, ""96""); (* # *) +enter incode ( 38, ""94""); (* & *) +enter incode ( 39, ""61""); (* ' *) +enter incode ( 40, ""42""); (* ( *) +enter incode ( 41, ""40""); (* ) *) +enter incode ( 42, ""125""); (* * *) +enter incode ( 43, ""93""); (* + *) +enter incode ( 45, ""47""); (* - *) +enter incode ( 47, ""38""); (* / *) +enter incode ( 58, ""62""); (* : *) +enter incode ( 59, ""60""); (* ; *) +enter incode ( 60, ""92""); (* < *) +enter incode ( 61, ""41""); (* = *) +enter incode ( 62, ""124""); (* > *) +enter incode ( 63, ""95""); (* ? *) +enter incode ( 64, ""249""); (* @ *) +enter incode ( 89, ""90""); (* Y *) +enter incode ( 90, ""89""); (* Z *) +enter incode ( 95, ""63""); (* _ *) +enter incode ( 96, ""43""); (* ` *) +enter incode (121, ""122""); (* y *) +enter incode (122, ""121""); (* z *) +enter incode (214, ""34""); (* *) +enter incode (215, ""58""); (* *) +enter incode (216, ""123""); (* *) +enter incode (217, ""39""); (* *) +enter incode (218, ""59""); (* *) +enter incode (219, ""91""); (* *) +enter incode (251, ""45""); (* *) diff --git a/system/terminal-codes/unknown/src/Qume.german b/system/terminal-codes/unknown/src/Qume.german new file mode 100644 index 0000000..850a15b --- /dev/null +++ b/system/terminal-codes/unknown/src/Qume.german @@ -0,0 +1,77 @@ +(* + Typdefinition: Qume deutsch 12.10.84 +*) +TEXT VAR name :="Qume.german"; +command dialogue (FALSE);forget (name); +new type (name); +cursor logic (32,""27"=","",""); +enter outcode (1 ,0,""30""); +enter outcode (2 ,0,""12""); +enter outcode (3 ,0,""11""); +enter outcode (4 ,0,""27"Y"); +enter outcode (5 ,0,""27"T"); +enter outcode (7,7); +enter outcode (8,8); +enter outcode (10,10); +enter outcode (13,13); +enter outcode (14,0,""27"G0"); +enter outcode (15,0,""27"G4"); +enter outcode (130,0,"-"); +enter outcode (131,0,"-"); +enter outcode (132,0,"-"); +enter outcode (133,0,"-"); +enter outcode (134,0,"-"); +enter outcode (135,0,"I"); +enter outcode (136,0,"I"); +enter outcode (137,0,"-"); +enter outcode (138,0,"-"); +enter outcode (139,0,"I"); +enter outcode (140,0,"I"); + +enter outcode (214,""91""); +enter outcode (215,""92""); +enter outcode (216,""93""); +enter outcode (217,""123""); +enter outcode (218,""124""); +enter outcode (219,""125""); + +enter outcode (220,"k") ; +enter outcode (221,"-") ; +enter outcode (222,"#") ; +enter outcode (223," ") ; +enter outcode (251,""126""); + +enter incode (214,""91""); +enter incode (215,""92""); +enter incode (216,""93""); +enter incode (217,""123""); +enter incode (218,""124""); +enter incode (219,""125""); +enter incode (251,""126""); + +enter incode ( 1,""26""); +enter incode ( 1,""30""); +enter incode ( 2,""12""); +enter incode ( 3,""11""); +enter incode (10,""10""); +enter incode ( 8,""8""); +enter incode (9,""9""); +enter incode (11,""01""67""13""); +enter incode (11,""01""71""13""); +enter incode (11,""01""75""13""); +enter incode (12,""127""); +enter incode (13,""13""); +enter incode (16,""01""66""13""); +enter incode (16,""01""70""13""); +enter incode (16,""01""74""13""); +enter incode (17,""01""64""13""); (* stop *) +enter incode (17,""01""68""13""); +enter incode (17,""01""72""13""); +enter incode (23,""01""65""13""); (* weiter *) +enter incode (23,""01""69""13""); +enter incode (23,""01""73""13""); + +enter incode (4,""4""); (* info *) +enter incode (7,""0""); (* sv *) + +command dialogue (TRUE); (* 12.10.84 *) diff --git a/system/terminal-codes/unknown/src/REGENT25 b/system/terminal-codes/unknown/src/REGENT25 new file mode 100644 index 0000000..25955d6 --- /dev/null +++ b/system/terminal-codes/unknown/src/REGENT25 @@ -0,0 +1,34 @@ +TEXT VAR name :="REGENT25"; +new type (name); +cursor logic (32,""27"Y","",""); +enter outcode (1,0,""27"Y "); +enter outcode (2 ,6 ); +enter outcode (3 ,26 ); +enter outcode (5 ,0,""27"K" ); +enter outcode (4,120,""27"k"); + +enter outcode (220, "k"); (* Trenn-k *) +enter outcode (221, "-"); (* Trenn- *) +enter outcode (222, "#"); +enter outcode (223, "_"); + +enter outcode (214,"A"); (* Umlaute *) +enter outcode (215,"O"); +enter outcode (216,"U"); +enter outcode (217,"a"); +enter outcode (218,"o"); +enter outcode (219,"u"); +enter outcode (251,"B"); + +enter incode (2 ,""6"" ); +enter incode (3 ,""26"" ); +enter incode (8 ,""21"" ); (* backspace *) +enter incode (4,""4""); (* info *) +enter incode (7,""29""); (* sv *) +enter incode (17,""3""); (* stop *) +enter incode (23,""0""); (* weiter *) + + +enter incode (11,"^"); (* rubin *) +enter incode (12,""127""); (* rubout *) +enter incode (16,""126"") ; (* mark *) diff --git a/system/terminal-codes/unknown/src/REGENT40 b/system/terminal-codes/unknown/src/REGENT40 new file mode 100644 index 0000000..4f6323a --- /dev/null +++ b/system/terminal-codes/unknown/src/REGENT40 @@ -0,0 +1,37 @@ +TEXT VAR name :="REGENT40"; +new type (name); +cursor logic (32,""27"Y","",""); +enter outcode (1,0,""27"Y "); +enter outcode (2 ,6 ); +enter outcode (3 ,26 ); +enter outcode (5 ,0,""27"K" ); +enter outcode (4,120,""27"k"); + + enter outcode (15,0,""27"0@"); (* invers video ein = begin mark*) + enter outcode (14,0,""27"0P"); (* invers video aus = end mark*) + +enter outcode (220, "k"); (* Trenn-k *) +enter outcode (221, "-"); (* Trenn- *) +enter outcode (222, "#"); +enter outcode (223, "_"); + +enter outcode (214,"A"); (* Umlaute *) +enter outcode (215,"O"); +enter outcode (216,"U"); +enter outcode (217,"a"); +enter outcode (218,"o"); +enter outcode (219,"u"); +enter outcode (251,"B"); + +enter incode (2 ,""6"" ); +enter incode (3 ,""26"" ); +enter incode (8 ,""21"" ); (* backspace *) +enter incode (4,""4""); (* info *) +enter incode (7,""29""); (* sv *) +enter incode (17,""3""); (* stop *) +enter incode (23,""0""); (* weiter *) + + +enter incode (11,"^"); (* rubin *) +enter incode (12,""127""); (* rubout *) +enter incode (16,""126"") ; (* mark *) diff --git a/system/terminal-codes/unknown/src/RUC.AT.ascii b/system/terminal-codes/unknown/src/RUC.AT.ascii new file mode 100644 index 0000000..cad3c5b --- /dev/null +++ b/system/terminal-codes/unknown/src/RUC.AT.ascii @@ -0,0 +1,75 @@ +(*************************************************) +(* Typtabelle : RUC.AT.ascii *) +(* Generiert am : 21.03.87 *) +(*************************************************) + +forget ("RUC.AT.ascii", quiet) ; +new type ("RUC.AT.ascii") ; + +cursor logic (0, ""6"", "", "") ; + +(* Ausgabe Codes : *) +enter outcode ( 1, 1) ; (* Cursor Home : *) +enter outcode ( 2, 2) ; (* Cursor right: *) +enter outcode ( 3, 3) ; (* Cursor up : *) +enter outcode ( 4, 4) ; (* CLEOP : *) +enter outcode ( 5, 5) ; (* CLEOL : *) +enter outcode ( 8, 8) ; (* Cursor left : *) +enter outcode ( 10, 10) ; (* Cursor down : *) +enter outcode ( 13, 13) ; (* CR : *) +enter outcode ( 14, 0, " "14"") ; (* END MARK : *) +enter outcode ( 15, 0, ""15" ") ; (* BEGIN MARK : *) +enter outcode (214, 0, ""142"") ; (* Ae : <142> *) +enter outcode (215, 0, ""153"") ; (* Oe : <153> *) +enter outcode (216, 0, ""154"") ; (* Ue : <154> *) +enter outcode (217, 0, ""132"") ; (* ae : <132> *) +enter outcode (218, 0, ""148"") ; (* oe : <148> *) +enter outcode (219, 0, ""129"") ; (* ue : <129> *) +enter outcode (220, 0, ""15"k"14"") ; (* Trenn-k : k *) +enter outcode (221, 0, ""15"-"14"") ; (* Trennstrich: - *) +enter outcode (222, 0, ""15"#"14"") ; (* Fest-# : # *) +enter outcode (223, 0, ""15" "14"") ; (* Fest-Blank:*) +enter outcode (251, 0, ""225"") ; (* sz : <225> *) +enter outcode (252, 21) ; (* paragraph : <21> *) + + +(* Eingabe Codes : *) +enter incode ( 17, ""1"") ; (* Stop : *) +enter incode ( 7, ""2"") ; (* SV - Call : *) +enter incode ( 7, ""187""); (* SV - Call : F1 *) +enter incode ( 23, ""3"") ; (* Weiter : *) +enter incode ( 4, ""4"") ; (* INFO : *) +enter incode ( 1, ""199"") ; (* HOP : POS1 *) +enter incode ( 2, ""205"") ; (* Cursor right: <205> *) +enter incode ( 3, ""200"") ; (* Cursor up : <200> *) +enter incode ( 8, ""203"") ; (* Cursor left : <203> *) +enter incode ( 10, ""208"") ; (* Cursor down : <208> *) +enter incode ( 11, ""210"") ; (* RUBIN : INSERT *) +enter incode ( 12, ""211"") ; (* RUBOUT : DELETE *) +enter incode ( 16, ""201"") ; (* MARK : Page up *) + (* AE-Taste : F13 = SHIFT F3 *) + (* OE-Taste : F14 = SHIFT F4 *) + (* UE-Taste : F15 = SHIFT F5 *) + (* ae-Taste : F16 = SHIFT F6 *) + (* oe-Taste : F17 = SHIFT F7 *) + (* ue-Taste : F18 = SHIFT F8 *) + (* trenn-k : F19 = SHIFT F9 *) + (* trenn - : F20 = SHIFT F10 *) + (* fix # : F21 = CTRL F1 *) + (* fix blank : F22 = CTRL F2 *) +enter incode (252, ""224"") ; (* paragraph : F23 = CTRL F3 *) +enter incode (251, ""225"") ; (* sz-Taste : F24 = CTRL F4 *) +enter incode ( 14, ""207"") ; (* Funct.-Taste: END *) +enter incode ( 15, ""204"") ; (* Funct.-Taste: Num-5 *) +enter incode ( 18, ""209"") ; (* NEWLINE : Page down *) +enter incode ( 19, ""188"") ; (* Funct.-Taste: F2 *) +enter incode ( 20, ""189"") ; (* Funct.-Taste: F3 *) +enter incode ( 21, ""190"") ; (* Funct.-Taste: F4 *) +enter incode ( 22, ""191"") ; (* Funct.-Taste: F5 *) +enter incode ( 24, ""192"") ; (* Funct.-Taste: F6 *) +enter incode ( 25, ""193"") ; (* Funct.-Taste: F7 *) +enter incode ( 26, ""194"") ; (* Funct.-Taste: F8 *) +enter incode ( 28, ""195"") ; (* Funct.-Taste: F9 *) +enter incode ( 29, ""196"") ; (* Funct.-Taste: F10 *) +enter incode ( 30, ""212"") ; (* Funct.-Taste: F11 = SHIFT F1 *) +enter incode ( 31, ""213"") ; (* Funct.-Taste: F12 = SHIFT F2 *) diff --git a/system/terminal-codes/unknown/src/SIEMENS.PC-D b/system/terminal-codes/unknown/src/SIEMENS.PC-D new file mode 100644 index 0000000..133b0b3 --- /dev/null +++ b/system/terminal-codes/unknown/src/SIEMENS.PC-D @@ -0,0 +1,88 @@ + (* Autor : Rudolf Ruland *) + (* Stand : 13.05.86 *) + +LET csi = ""27"["; + +TEXT VAR table :="SIEMENS.PC-D"; +forget (table, quiet); +new type (table); + +(****************** Steuerzeichen *************************************) + +enter incode ( 1, ""182""); (* HOP *) +enter incode ( 1, ""181""); (* HOP *) +enter incode ( 2, ""205""); (* RECHTS *) +enter incode ( 2, ""207""); (* RECHTS *) +enter incode ( 3, ""200""); (* OBEN *) +enter incode ( 3, ""201""); (* OBEN *) +enter incode ( 4, ""004""); (* CTRL d *) (* INFO *) +enter incode ( 7, ""187""); (* F1 *) (* SV *) +enter incode ( 7, ""002""); (* CTRL b *) (* SV *) +enter incode ( 8, ""199""); (* LINKS *) +enter incode ( 8, ""203""); (* LINKS *) +enter incode ( 9, ""143""); (* BACKTAB *) (* TAB *) +enter incode ( 10, ""208""); (* UNTEN *) +enter incode ( 10, ""209""); (* UNTEN *) +enter incode ( 11, ""169""); (* EINFGEN *) (* RUBIN *) +enter incode ( 11, ""210""); (* RUBIN *) +enter incode ( 12, ""008""); (* BACK F1 *) +enter incode ( 7, ""2"" ) ; (* SV *) +enter incode ( 8, ""203"" ) ; (* left *) +enter incode ( 9, ""143"" ) ; (* tab *) +enter incode ( 10, ""208"" ) ; (* down *) +enter incode ( 11, ""210"" ) ; (* rubin *) +enter incode ( 12, ""211"" ) ; (* rubout *) +enter incode ( 16, ""198"" ) ; (* mark *) +enter incode ( 17, ""1"" ) ; (* stop *) +enter incode ( 23, ""3"" ) ; (* start *) + +enter incode ( 187, ""136"") ; (* F1 *) + diff --git a/system/terminal-codes/unknown/src/TVI.german b/system/terminal-codes/unknown/src/TVI.german new file mode 100644 index 0000000..c24f063 --- /dev/null +++ b/system/terminal-codes/unknown/src/TVI.german @@ -0,0 +1,57 @@ +TEXT VAR name :="TVI.german"; +command dialogue (FALSE); forget (name, quiet) ; +new type (name); +cursor logic (32,""27"=","",""); +enter outcode (1 ,0,""30""); +enter outcode (2 ,0,""12""); +enter outcode (3 ,0,""11""); +enter outcode (4 ,40,""27"Y"); +enter outcode (5 ,0,""27"T"); +enter outcode (14,0,""27"G0"); +enter outcode (15,0,""27"G4"); + +enter outcode ( 91,0,"<"); +enter outcode ( 92,0,"/"); +enter outcode ( 93,0,">"); +enter outcode (123,0,"("); +enter outcode (124,0,"!"); +enter outcode (125,0,")"); + +INT VAR i ; +FOR i FROM 127 UPTO 255 REP + enter outcode (i, "?") +PER ; + +enter outcode (214,91); +enter outcode (215,92); +enter outcode (216,93); +enter outcode (217,123); +enter outcode (218,124); +enter outcode (219,125); +enter outcode (220,"k") ; +enter outcode (221,"-") ; +enter outcode (222,"#") ; +enter outcode (223,"_") ; +enter outcode (251,126); + +enter incode (214,""91""); +enter incode (215,""92""); +enter incode (216,""93""); +enter incode (217,""123""); +enter incode (218,""124""); +enter incode (219,""125""); +enter incode (251,""126""); + +enter incode (63,""0"") ; +enter incode ( 1,""30""); +enter incode ( 2,""12""); +enter incode ( 3,""11""); +enter incode (10,""22""); +enter incode ( 8,""8""); +enter incode (11,""27"Q");enter incode (11,""26""); +enter incode (12,""27"W");enter incode (12,""127""); +enter incode (16,""16""); +enter incode (4,""4""); (* info *) +enter incode (7,""2""); (* sv *) +enter incode (17,""1""); (* stop *) +enter incode (23,""3""); (* weiter *) diff --git a/system/terminal-codes/unknown/src/TVI914.ascii b/system/terminal-codes/unknown/src/TVI914.ascii new file mode 100644 index 0000000..4909462 --- /dev/null +++ b/system/terminal-codes/unknown/src/TVI914.ascii @@ -0,0 +1,43 @@ +TEXT VAR name :="TVI914.ascii"; +command dialogue (FALSE); forget (name, quiet) ; +new type (name); +cursor logic (32,""27"=","",""); +enter outcode (1 ,0,""30""); +enter outcode (2 ,0,""12""); +enter outcode (3 ,0,""11""); +enter outcode (4 ,40,""27"Y"); +enter outcode (5 ,0,""27"T"); +enter outcode (14,0,""27"G0 "); +enter outcode (15,0,""27"G4 "); + + +INT VAR i ; +FOR i FROM 127 UPTO 255 REP + enter outcode (i, "?") +PER ; + +enter outcode (214,"A"); +enter outcode (215,"O"); +enter outcode (216,"U"); +enter outcode (217,"a"); +enter outcode (218,"o"); +enter outcode (219,"u"); +enter outcode (220,"k") ; +enter outcode (221,"-") ; +enter outcode (222,"#") ; +enter outcode (223,"_") ; +enter outcode (251,"B"); + +enter incode (63,""0"") ; +enter incode ( 1,""30""); +enter incode ( 2,""12""); +enter incode ( 3,""11""); +enter incode (10,""22""); +enter incode ( 8,""8""); +enter incode (11,""27"Q");enter incode (11,""26""); +enter incode (12,""27"W");enter incode (12,""127""); +enter incode (16,""23""); +enter incode (4,""4""); (* info *) +enter incode (7,""2""); (* sv *) +enter incode (17,""1""); (* stop *) +enter incode (23,""3""); (* weiter *) diff --git a/system/terminal-codes/unknown/src/VC404.ascii b/system/terminal-codes/unknown/src/VC404.ascii new file mode 100644 index 0000000..614e26d --- /dev/null +++ b/system/terminal-codes/unknown/src/VC404.ascii @@ -0,0 +1,61 @@ + (* Autor : Rudolf Ruland *) + (* Stand : 06.05.86 *) + +INT VAR i; +TEXT VAR table :="VC404.ascii"; +forget (table, quiet); +new type (table); + +(****************** Steuerzeichen *************************************) + +enter incode ( 1, ""025""); (* HOP *) +enter incode ( 2, ""021""); (* -> *) +enter incode ( 3, ""026""); (* UP *) +enter incode ( 4, ""004""); (* INFO *) +enter incode ( 7, ""002""); (* SV *) +enter incode ( 7, ""007""); (* SV *) +enter incode ( 8, ""008""); (* <- *) +enter incode ( 9, ""009""); (* TAB *) +enter incode (10, ""010""); (* DOWN *) +enter incode (11, ""096""); (* RUBIN *) +enter incode (12, ""127""); (* RUBOUT *) +enter incode (13, ""013""); (* RETURN *) +enter incode (16, ""126""); (* MARK *) +enter incode (17, ""001""); (* STOP *) +enter incode (23, ""003""); (* WEITER *) + +FOR i FROM 0 UPTO 31 REP enter outcode (i, "S") PER; + +enter outcode ( 0, ""); (* NULL *) +enter outcode ( 1, 25); (* HOME *) +enter outcode ( 2, 21); (* RECHTS *) +enter outcode ( 3, 26); (* OBEN *) +enter outcode ( 4, 120, ""23""); (* CL EOP *) +enter outcode ( 5, 22); (* CL EOL *) +enter outcode ( 7, 7); (* BELL *) +enter outcode ( 8, 8); (* LINKS *) +enter outcode (10, 10); (* UNTEN *) +enter outcode (13, 13); (* RETURN *) +enter outcode (14, 126); (* END MARK *) +enter outcode (15, 126); (* BEGIN MARK *) + +cursor logic (32,""16"","",""); + +(******************** Textzeichen *************************************) + +FOR i FROM 127 UPTO 255 REP enter outcode (i, "?") PER; +FOR i FROM 129 UPTO 159 REP enter outcode (i, "E") PER; (* japanische *) +FOR i FROM 224 UPTO 239 REP enter outcode (i, "E") PER; (* ESC-Zeichen *) + + +enter outcode (214, "A"); (* *) +enter outcode (215, "O"); (* *) +enter outcode (216, "U"); (* *) +enter outcode (217, "a"); (* *) +enter outcode (218, "o"); (* *) +enter outcode (219, "u"); (* *) +enter outcode (220, "k"); (* Trenn-k *) +enter outcode (221, "-"); (* Trenn-Strich *) +enter outcode (222, "#"); (* gesch. Nummerkreuz *) +enter outcode (223, "_"); (* gesch. Blank *) +enter outcode (251, "B"); (* *) diff --git a/system/terminal-codes/unknown/src/VC404.german b/system/terminal-codes/unknown/src/VC404.german new file mode 100644 index 0000000..0c84d8e --- /dev/null +++ b/system/terminal-codes/unknown/src/VC404.german @@ -0,0 +1,75 @@ + (* Autor : Rudolf Ruland *) + (* Stand : 06.05.86 *) + +INT VAR i; +TEXT VAR table :="VC404.german"; +forget (table, quiet); +new type (table); + +(****************** Steuerzeichen *************************************) + +enter incode ( 1, ""025""); (* HOP *) +enter incode ( 2, ""021""); (* -> *) +enter incode ( 3, ""026""); (* UP *) +enter incode ( 4, ""004""); (* INFO *) +enter incode ( 7, ""002""); (* SV *) +enter incode ( 7, ""007""); (* SV *) +enter incode ( 8, ""008""); (* <- *) +enter incode ( 9, ""009""); (* TAB *) +enter incode (10, ""010""); (* DOWN *) +enter incode (11, ""096""); (* RUBIN *) +enter incode (12, ""127""); (* RUBOUT *) +enter incode (13, ""013""); (* RETURN *) +enter incode (16, ""126""); (* MARK *) +enter incode (17, ""001""); (* STOP *) +enter incode (23, ""003""); (* WEITER *) + +FOR i FROM 0 UPTO 31 REP enter outcode (i, "S") PER; + +enter outcode ( 0, ""); (* NULL *) +enter outcode ( 1, 25); (* HOME *) +enter outcode ( 2, 21); (* RECHTS *) +enter outcode ( 3, 26); (* OBEN *) +enter outcode ( 4, 120, ""23""); (* CL EOP *) +enter outcode ( 5, 22); (* CL EOL *) +enter outcode ( 7, 7); (* BELL *) +enter outcode ( 8, 8); (* LINKS *) +enter outcode (10, 10); (* UNTEN *) +enter outcode (13, 13); (* RETURN *) +enter outcode (14, 126); (* END MARK *) +enter outcode (15, 126); (* BEGIN MARK *) + +cursor logic (32,""16"","",""); + +(******************** Textzeichen *************************************) + +enter incode (214, ""091""); (* *) +enter incode (215, ""092""); (* *) +enter incode (216, ""093""); (* *) +enter incode (217, ""123""); (* *) +enter incode (218, ""124""); (* *) +enter incode (219, ""125""); (* *) +enter incode (251, ""064""); (* *) + +FOR i FROM 127 UPTO 255 REP enter outcode (i, "?") PER; +FOR i FROM 129 UPTO 159 REP enter outcode (i, "E") PER; (* japanische *) +FOR i FROM 224 UPTO 239 REP enter outcode (i, "E") PER; (* ESC-Zeichen *) + + +enter outcode ( 91, "("); (* [ *) +enter outcode ( 92, "/"); (* \ *) +enter outcode ( 93, ")"); (* ] *) +enter outcode (123, "<"); (* geschw. Klammer auf *) +enter outcode (124, "!"); (* | *) +enter outcode (125, ">"); (* geschw. Klammer zu *) +enter outcode (214, 91); (* *) +enter outcode (215, 92); (* *) +enter outcode (216, 93); (* *) +enter outcode (217, 123); (* *) +enter outcode (218, 124); (* *) +enter outcode (219, 125); (* *) +enter outcode (220, "k"); (* Trenn-k *) +enter outcode (221, "-"); (* Trenn-Strich *) +enter outcode (222, "#"); (* gesch. Nummerkreuz *) +enter outcode (223, "_"); (* gesch. Blank *) +enter outcode (251, 64); (* *) diff --git a/system/terminal-codes/unknown/src/VC404.hrz b/system/terminal-codes/unknown/src/VC404.hrz new file mode 100644 index 0000000..3f270c5 --- /dev/null +++ b/system/terminal-codes/unknown/src/VC404.hrz @@ -0,0 +1,67 @@ + (* Autor : Rudolf Ruland *) + (* Stand : 06.05.86 *) + +INT VAR i; +TEXT VAR table :="VC404.hrz"; +forget (table, quiet); +new type (table); + +(****************** Steuerzeichen *************************************) + +enter incode ( 1, ""025""); (* HOP *) +enter incode ( 2, ""021""); (* -> *) +enter incode ( 3, ""026""); (* UP *) +enter incode ( 4, ""004""); (* INFO *) +enter incode ( 7, ""002""); (* SV *) +enter incode ( 7, ""007""); (* SV *) +enter incode ( 8, ""008""); (* <- *) +enter incode ( 9, ""009""); (* TAB *) +enter incode (10, ""010""); (* DOWN *) +enter incode (11, ""096""); (* RUBIN *) +enter incode (12, ""127""); (* RUBOUT *) +enter incode (13, ""013""); (* RETURN *) +enter incode (16, ""126""); (* MARK *) +enter incode (17, ""001""); (* STOP *) +enter incode (23, ""003""); (* WEITER *) + +FOR i FROM 0 UPTO 31 REP enter outcode (i, "S") PER; + +enter outcode ( 0, ""); (* NULL *) +enter outcode ( 1, 25); (* HOME *) +enter outcode ( 2, 21); (* RECHTS *) +enter outcode ( 3, 26); (* OBEN *) +enter outcode ( 4, 120, ""23""); (* CL EOP *) +enter outcode ( 5, 22); (* CL EOL *) +enter outcode ( 7, 7); (* BELL *) +enter outcode ( 8, 8); (* LINKS *) +enter outcode (10, 10); (* UNTEN *) +enter outcode (13, 13); (* RETURN *) +enter outcode (14, 126); (* END MARK *) +enter outcode (15, 126); (* BEGIN MARK *) + +cursor logic (32,""16"","",""); + +(******************** Textzeichen *************************************) + +FOR i FROM 127 UPTO 255 REP enter outcode (i, "?") PER; +FOR i FROM 129 UPTO 159 REP enter outcode (i, "E") PER; (* japanische *) +FOR i FROM 224 UPTO 239 REP enter outcode (i, "E") PER; (* ESC-Zeichen *) + +enter outcode ( 91, "("); (* [ *) +enter outcode ( 92, "/"); (* \ *) +enter outcode ( 93, ")"); (* ] *) +enter outcode (123, "<"); (* geschw. Klammer auf *) +enter outcode (124, "!"); (* | *) +enter outcode (125, ">"); (* geschw. Klammer zu *) +enter outcode (214, 91); (* *) +enter outcode (215, 92); (* *) +enter outcode (216, 93); (* *) +enter outcode (217, 123); (* *) +enter outcode (218, 124); (* *) +enter outcode (219, 125); (* *) +enter outcode (220, "k"); (* Trenn-k *) +enter outcode (221, "-"); (* Trenn-Strich *) +enter outcode (222, "#"); (* gesch. Nummerkreuz *) +enter outcode (223, "_"); (* gesch. Blank *) +enter outcode (251, 64); (* *) + diff --git a/system/terminal-codes/unknown/src/VIDEOSTAR b/system/terminal-codes/unknown/src/VIDEOSTAR new file mode 100644 index 0000000..bead5b9 --- /dev/null +++ b/system/terminal-codes/unknown/src/VIDEOSTAR @@ -0,0 +1,52 @@ +# +  VIDEOSTAR CONFIGURATIONS-PROGRAMM, VERSION 25.06.1985 +  Terminal = REGENT40 Emulation, deutscher Zeichensatz  +# +TEXT VAR name :="VIDEOSTAR"; +forget(name, quiet); +new type (name); +cursor logic (32,""27"Y","",""); +enter outcode (1 ,0,""27"Y "); +enter outcode (2 ,6 ); +enter outcode (3 ,26 ); +enter outcode (5 ,0,""27"K" ); +enter outcode (4,0,""27"k"); +enter outcode (14,0,""27"0@ "); (* invers video ein = begin mark*) +enter outcode (15,0,""27"0P "); (* invers video aus = end mark*) + +enter outcode (220,"k"); (* Trenn-k *) +enter outcode (221,"-"); (* Trenn- *) +enter outcode (222,"#"); +enter outcode (223,"_"); +enter outcode (140,""12""); (* Clear fuer Graphik *) + +enter outcode (214, 0, ""27"9B"91""27"9A"); (* ASCII Klammern *) +enter outcode (215, 0, ""27"9B"92""27"9A"); +enter outcode (216, 0, ""27"9B"93""27"9A"); +enter outcode (217, 0, ""27"9B"123""27"9A"); +enter outcode (218, 0, ""27"9B"124""27"9A"); +enter outcode (219, 0, ""27"9B"125""27"9A"); +enter outcode (251, 0, ""27"9B"126""27"9A"); + +enter incode (1 ,""30""); (* hop *) +enter incode (2 ,""6"" ); +enter incode (3 ,""26"" ); +enter incode (8 ,""21"" ); (* backspace *) +enter incode (4,""4""); (* info *) +enter incode (7,""2""); (* sv *) +enter incode (17,""1""); (* stop *) +enter incode (23,""3""); (* weiter *) +enter incode (18, ""27"M"); (* Insert Line *) +enter incode (11,""25""); (* rubin *) +enter incode (12,""127""); (* rubout *) +enter incode (16,""12"") ; (* mark *) + + +enter incode (214,""91""); (* Umlaute *) +enter incode (215,""92""); +enter incode (216,""93""); +enter incode (217,""123""); +enter incode (218,""124""); +enter incode (219,""125""); +enter incode (251,""126""); + diff --git a/system/terminal-codes/unknown/src/basis108(ascii) b/system/terminal-codes/unknown/src/basis108(ascii) new file mode 100644 index 0000000..8df50f2 --- /dev/null +++ b/system/terminal-codes/unknown/src/basis108(ascii) @@ -0,0 +1,90 @@ + (* Terminaltyp: Basis108 *) + (* Keyboard : ASCII *) + (* Zeichensatz: ASCII *) + (* Stand : 28.04.86 *) + +forget ("basis108(ascii)", quiet) ; +new type ("basis108(ascii)") ; + +cursor logic (0, ""6"", "", "") ; + +(* Nicht im EUMEL-Zeichensatz definierte Steuerzeichen *) +illegal (11, 12) ; +illegal (16, 31) ; +illegal (128, 213) ; +illegal (224, 250) ; +illegal (252, 255) ; + +enter outcode (14, 0, " "14"") ; +enter outcode (15, 0, ""15" ") ; + +enter outcode (214, 0, ""15"A"14"") ; +enter outcode (215, 0, ""15"O"14"") ; +enter outcode (216, 0, ""15"U"14"") ; +enter outcode (217, 0, ""15"a"14"") ; +enter outcode (218, 0, ""15"o"14"") ; +enter outcode (219, 0, ""15"u"14"") ; +enter outcode (251, 0, ""15"B"14"") ; + +enter outcode (220, 0, ""15"k"14"") ; +enter outcode (221, 0, ""15"-"14"") ; +enter outcode (222, 0, ""15"#"14"") ; +enter outcode (223, 0, ""15" "14"") ; + +enter incode ( 1, ""192"") ; (* Home : Cursorblock mitte *) +enter incode ( 2, ""149"") ; (* Cursor right: Cursorblock mitte rechts *) +enter incode ( 3, ""139"") ; (* Cursor up : Cursorblock oben mitte *) +(*enter incode( 4, ""21"") ; (* Info usw. : Cursorblock unten rechts*) *) +enter incode ( 7, ""194"") ; (* SV - Call : Funktionstaste F2 *) +enter incode ( 8, ""136"") ; (* Cursor left : Cursorblock mitte links *) +enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte *) +enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links *) +enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste *) +enter incode ( 16, ""143"") ; (* MARK : Cursorblock oben rechts *) +enter incode ( 17, ""193"") ; (* Stop : Funktionstaste F1 *) +enter incode ( 23, ""195"") ; (* Weiter : Funktionstaste F3 *) +enter incode ( 31, ""8"") ; (* Backspace : (2x) gerahmter Linkspfeil *) + +enter incode ( 0, ""24"") ; (* CE *) +enter incode ( 5, ""196"") ; (* F4 *) +enter incode ( 6, ""197"") ; (* F5 *) +enter incode (14, ""198"") ; (* F6 *) +enter incode (15, ""199"") ; (* F7 *) +enter incode (18, ""200"") ; (* F8 *) +enter incode (19, ""201"") ; (* F9 *) +enter incode (20, ""202"") ; (* F10 *) +enter incode (21, ""203"") ; (* F11 *) +enter incode (22, ""204"") ; (* F12 *) +enter incode (24, ""205"") ; (* F13 *) +enter incode (25, ""206"") ; (* F14 *) +enter incode (26, ""207"") ; (* F15 *) +enter incode (28, ""209"") ; (* SHIFT F1 *) +enter incode (29, ""210"") ; (* SHIFT F2 *) +enter incode (30, ""211"") ; (* SHIFT F3 *) + +enter incode (126,""165"") ; (* CTRL F5 *) +enter incode (91, ""166"") ; (* CTRL F6 *) +enter incode (92, ""167"") ; (* CTRL F7 *) +enter incode (93, ""168"") ; (* CTRL F8 *) +enter incode (123,""169"") ; (* CTRL F9 *) +enter incode (124,""170"") ; (* CTRL F10 *) +enter incode (125,""171"") ; (* CTRL F11 *) + +enter incode (251, ""213"") ; (* SHIFT F5 = *) + (* SHIFT F6 = +Andere incodes schon Hardware- SHIFT F7 = +mig implementiert: SHIFT F8 = + SHIFT F9 = + SHIFT F10= + SHIFT F11= + SHIFT F12= Trenn-k ( k ) + SHIFT F13= Trenn-Strich ( - ) + SHIFT F14= Geschtztes Fis ( # ) + SHIFT F15= Geschtztes Blank ( ) *) + +PROC illegal (INT CONST from, to) : + INT VAR i ; + FOR i FROM from UPTO to REP + enter outcode (i, 127) + PER +ENDPROC illegal ; diff --git a/system/terminal-codes/unknown/src/basis108(deutsch) b/system/terminal-codes/unknown/src/basis108(deutsch) new file mode 100644 index 0000000..9213cbe --- /dev/null +++ b/system/terminal-codes/unknown/src/basis108(deutsch) @@ -0,0 +1,106 @@ + (* Terminaltyp: Basis108 *) + (* Keyboard : Deutsch *) + (* Zeichensatz: Deutsch *) + (* Stand : 28.04.86 *) + +forget ("basis108(deutsch)", quiet) ; +new type ("basis108(deutsch)") ; + +cursor logic (0, ""6"", "", "") ; + +(* Nicht im EUMEL-Zeichensatz definierte Steuerzeichen *) +illegal (11, 12) ; +illegal (16, 31) ; +illegal (128, 213) ; +illegal (224, 250) ; +illegal (252, 255) ; + +enter outcode (14, 0, " "14"") ; +enter outcode (15, 0, ""15" ") ; + +enter outcode (91, 0, ""15"("14"") ; +enter outcode (92, 0, ""15"/"14"") ; +enter outcode (93, 0, ""15")"14"") ; +enter outcode (123, 0, ""15"<"14"") ; +enter outcode (124, 0, ""15"!"14"") ; +enter outcode (125, 0, ""15">"14"") ; +enter outcode (126, 0, ""15"`"14"") ; + +enter outcode (214, 91) ; +enter outcode (215, 92) ; +enter outcode (216, 93) ; +enter outcode (217, 123) ; +enter outcode (218, 124) ; +enter outcode (219, 125) ; +enter outcode (251, 126) ; + +enter outcode (220, 0, ""15"k"14"") ; +enter outcode (221, 0, ""15"-"14"") ; +enter outcode (222, 0, ""15"#"14"") ; +enter outcode (223, 0, ""15" "14"") ; + +enter incode ( 1, ""192"") ; (* Home : Cursorblock mitte *) +enter incode ( 2, ""149"") ; (* Cursor right: Cursorblock mitte rechts *) +enter incode ( 3, ""139"") ; (* Cursor up : Cursorblock oben mitte *) +(*enter incode( 4, ""21"") ; (* Info usw. : Cursorblock unten rechts*) *) +enter incode ( 7, ""194"") ; (* SV - Call : Funktionstaste F2 *) +enter incode ( 8, ""136"") ; (* Cursor left : Cursorblock mitte links *) +enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte *) +enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links *) +enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste *) +enter incode ( 16, ""143"") ; (* MARK : Cursorblock oben rechts *) +enter incode ( 17, ""193"") ; (* Stop : Funktionstaste F1 *) +enter incode ( 23, ""195"") ; (* Weiter : Funktionstaste F3 *) +enter incode ( 31, ""8"") ; (* Backspace : (2x) gerahmter Linkspfeil *) + +enter incode (214, ""91"") ; +enter incode (215, ""92"") ; +enter incode (216, ""93"") ; +enter incode (217, ""123"") ; +enter incode (218, ""124"") ; +enter incode (219, ""125"") ; +enter incode (251, ""126"") ; + +enter incode ( 0, ""24"") ; (* CE *) +enter incode ( 5, ""196"") ; (* F4 *) +enter incode ( 6, ""197"") ; (* F5 *) +enter incode (14, ""198"") ; (* F6 *) +enter incode (15, ""199"") ; (* F7 *) +enter incode (18, ""200"") ; (* F8 *) +enter incode (19, ""201"") ; (* F9 *) +enter incode (20, ""202"") ; (* F10 *) +enter incode (21, ""203"") ; (* F11 *) +enter incode (22, ""204"") ; (* F12 *) +enter incode (24, ""205"") ; (* F13 *) +enter incode (25, ""206"") ; (* F14 *) +enter incode (26, ""207"") ; (* F15 *) +enter incode (28, ""209"") ; (* SHIFT F1 *) +enter incode (29, ""210"") ; (* SHIFT F2 *) +enter incode (30, ""211"") ; (* SHIFT F3 *) + +enter incode (126,""165"") ; (* CTRL F5 *) +enter incode (91, ""166"") ; (* CTRL F6 *) +enter incode (92, ""167"") ; (* CTRL F7 *) +enter incode (93, ""168"") ; (* CTRL F8 *) +enter incode (123,""169"") ; (* CTRL F9 *) +enter incode (124,""170"") ; (* CTRL F10 *) +enter incode (125,""171"") ; (* CTRL F11 *) + +enter incode (251, ""213"") ; (* SHIFT F5 = *) + (* SHIFT F6 = +Andere incodes schon Hardware- SHIFT F7 = +mig implementiert: SHIFT F8 = + SHIFT F9 = + SHIFT F10= + SHIFT F11= + SHIFT F12= Trenn-k ( k ) + SHIFT F13= Trenn-Strich ( - ) + SHIFT F14= Geschtztes Fis ( # ) + SHIFT F15= Geschtztes Blank ( ) *) + +PROC illegal (INT CONST from, to) : + INT VAR i ; + FOR i FROM from UPTO to REP + enter outcode (i, 127) + PER +ENDPROC illegal ; diff --git a/system/terminal-codes/unknown/src/basis108(info) b/system/terminal-codes/unknown/src/basis108(info) new file mode 100644 index 0000000..421c803 --- /dev/null +++ b/system/terminal-codes/unknown/src/basis108(info) @@ -0,0 +1,107 @@ + (* Terminaltyp: Basis108 *) + (* Keyboard : Deutsch *) + (* Zeichensatz: Deutsch *) + (* Stand : 19.06.86 *) + (* Mit 'info'-Taste auf => *) + (* Ohne sz auf SHIFT F5 *) + +forget ("basis108(info)", quiet) ; +new type ("basis108(info)") ; + +cursor logic (0, ""6"", "", "") ; + +(* Nicht im EUMEL-Zeichensatz definierte Steuerzeichen *) +illegal (11, 12) ; +illegal (16, 31) ; +illegal (128, 213) ; +illegal (224, 250) ; +illegal (252, 255) ; + +enter outcode (14, 0, " "14"") ; +enter outcode (15, 0, ""15" ") ; + +enter outcode (91, 0, ""15"("14"") ; +enter outcode (92, 0, ""15"/"14"") ; +enter outcode (93, 0, ""15")"14"") ; +enter outcode (123, 0, ""15"<"14"") ; +enter outcode (124, 0, ""15"!"14"") ; +enter outcode (125, 0, ""15">"14"") ; +enter outcode (126, 0, ""15"`"14"") ; + +enter outcode (214, 91) ; +enter outcode (215, 92) ; +enter outcode (216, 93) ; +enter outcode (217, 123) ; +enter outcode (218, 124) ; +enter outcode (219, 125) ; +enter outcode (251, 126) ; + +enter outcode (220, 0, ""15"k"14"") ; +enter outcode (221, 0, ""15"-"14"") ; +enter outcode (222, 0, ""15"#"14"") ; +enter outcode (223, 0, ""15" "14"") ; + +enter incode ( 1, ""192"") ; (* Home : Cursorblock mitte *) +enter incode ( 2, ""149"") ; (* Cursor right: Cursorblock mitte rechts *) +enter incode ( 3, ""139"") ; (* Cursor up : Cursorblock oben mitte *) +enter incode ( 4, ""21"") ; (* Info usw. : Cursorblock unten rechts *) +enter incode ( 7, ""194"") ; (* SV - Call : Funktionstaste F2 *) +enter incode ( 8, ""136"") ; (* Cursor left : Cursorblock mitte links *) +enter incode ( 10, ""138"") ; (* Cursor down : Cursorblock unten mitte *) +enter incode ( 11, ""142"") ; (* RUBIN/Insert: Cursorblock oben links *) +enter incode ( 12, ""127"") ; (* RUBOUT/Delete:DELETE-Taste *) +enter incode ( 16, ""143"") ; (* MARK : Cursorblock oben rechts *) +enter incode ( 17, ""193"") ; (* Stop : Funktionstaste F1 *) +enter incode ( 23, ""195"") ; (* Weiter : Funktionstaste F3 *) +enter incode ( 31, ""8"") ; (* Backspace : (2x) gerahmter Linkspfeil *) + +enter incode (214, ""91"") ; +enter incode (215, ""92"") ; +enter incode (216, ""93"") ; +enter incode (217, ""123"") ; +enter incode (218, ""124"") ; +enter incode (219, ""125"") ; +enter incode (251, ""126"") ; + +enter incode ( 0, ""24"") ; (* CE *) +enter incode ( 5, ""196"") ; (* F4 *) +enter incode ( 6, ""197"") ; (* F5 *) +enter incode (14, ""198"") ; (* F6 *) +enter incode (15, ""199"") ; (* F7 *) +enter incode (18, ""200"") ; (* F8 *) +enter incode (19, ""201"") ; (* F9 *) +enter incode (20, ""202"") ; (* F10 *) +enter incode (21, ""203"") ; (* F11 *) +enter incode (22, ""204"") ; (* F12 *) +enter incode (24, ""205"") ; (* F13 *) +enter incode (25, ""206"") ; (* F14 *) +enter incode (26, ""207"") ; (* F15 *) +enter incode (28, ""209"") ; (* SHIFT F1 *) +enter incode (29, ""210"") ; (* SHIFT F2 *) +enter incode (30, ""211"") ; (* SHIFT F3 *) + +enter incode (126,""165"") ; (* CTRL F5 *) +enter incode (91, ""166"") ; (* CTRL F6 *) +enter incode (92, ""167"") ; (* CTRL F7 *) +enter incode (93, ""168"") ; (* CTRL F8 *) +enter incode (123,""169"") ; (* CTRL F9 *) +enter incode (124,""170"") ; (* CTRL F10 *) +enter incode (125,""171"") ; (* CTRL F11 *) + + (* SHIFT F6 = +Andere incodes schon Hardware- SHIFT F7 = +mig implementiert: SHIFT F8 = + SHIFT F9 = + SHIFT F10= + SHIFT F11= + SHIFT F12= Trenn-k ( k ) + SHIFT F13= Trenn-Strich ( - ) + SHIFT F14= Geschtztes Fis ( # ) + SHIFT F15= Geschtztes Blank ( ) *) + +PROC illegal (INT CONST from, to) : + INT VAR i ; + FOR i FROM from UPTO to REP + enter outcode (i, 127) + PER +ENDPROC illegal ; diff --git a/system/terminal-codes/unknown/src/ws580 b/system/terminal-codes/unknown/src/ws580 new file mode 100644 index 0000000..2a2c0dd --- /dev/null +++ b/system/terminal-codes/unknown/src/ws580 @@ -0,0 +1,62 @@ +TEXT VAR name :="ws580"; +command dialogue (FALSE); forget (name); +new type (name); +cursor logic (32,""27"Y","",""); + +enter incode ( 2, ""6""); (* rechts *) +enter incode ( 3, ""26""); (* oben *) +enter incode ( 7, ""2""); (* sv *) +enter incode ( 8, ""21""); (* links *) +enter incode ( 11, ""94""); (* rubin *) +enter incode ( 12, ""8""); (* rubout *) +enter incode ( 16, ""96""); (* mark *) +enter incode ( 23, ""19""); (* weiter *) + +enter incode ( 214, ""91""); (* *) +enter incode ( 215, ""92""); (* *) +enter incode ( 216, ""93""); (* *) +enter incode ( 217, ""123""); (* *) +enter incode ( 218, ""124""); (* *) +enter incode ( 219, ""125""); (* *) +enter incode ( 251, ""126""); (* *) + +enter outcode ( 1, 0, ""27"Y "); (* home *) +enter outcode ( 2, 0, ""6""); (* rechts *) +enter outcode ( 3, 0, ""26""); (* oben *) +enter outcode ( 4, 0, ""27"k"); (* cleop *) +enter outcode ( 5, 0, ""27"K"); (* cleoln *) +enter outcode ( 14, 0, ""47""); (* endmrk *) +enter outcode ( 15, 0, ""47""); (* mark *) + +clear all 8 bit chars; + +enter outcode ( 91, "("); (* [ *) +enter outcode ( 92, "!"); (* \ *) +enter outcode ( 93, ")"); (* ] *) +enter outcode (123, "("); (* *) +enter outcode (124, "!"); (* | *) +enter outcode (125, ")"); (* *) +enter outcode (126, "-"); (* ~ *) + +enter outcode (214, ""91""); (* *) +enter outcode (215, ""92""); (* *) +enter outcode (216, ""93""); (* *) +enter outcode (217, ""123""); (* *) +enter outcode (218, ""124""); (* *) +enter outcode (219, ""125""); (* *) +enter outcode (251, ""126""); (* *) + +enter outcode (220, "k"); (* trenn k *) +enter outcode (221, "-"); (* trenn - *) +enter outcode (222, "#"); (* kdo # *) +enter outcode (223, " "); (* trenn *) + +command dialogue (TRUE). + + +clear all 8 bit chars : + INT VAR i; + + FOR i FROM 128 UPTO 255 REP + enter outcode (i, " "); + PER. -- cgit v1.2.3