ADDED .fossil-settings/binary-glob Index: .fossil-settings/binary-glob ================================================================== --- /dev/null +++ .fossil-settings/binary-glob @@ -0,0 +1,10 @@ +doc/*.png +examples/*.pt +labels/*.pdf +media/*/*.bin +media/*/*.dsk +media/*/*.pt +media/*/*.rk05 +media/*/*.tu56 +pics/*/*.jpg +pics/*/*.png ADDED .fossil-settings/crlf-glob Index: .fossil-settings/crlf-glob ================================================================== --- /dev/null +++ .fossil-settings/crlf-glob @@ -0,0 +1,5 @@ +src/scp.* +src/sim_*.[ch] +src/sim_*.in +src/PDP8/pdp8_*.[ch] +src/PDP8/pidp8i.c.in ADDED .fossil-settings/ignore-glob Index: .fossil-settings/ignore-glob ================================================================== --- /dev/null +++ .fossil-settings/ignore-glob @@ -0,0 +1,1 @@ +doc/simh/*.doc ADDED AUTHORS.md Index: AUTHORS.md ================================================================== --- /dev/null +++ AUTHORS.md @@ -0,0 +1,62 @@ +# Creators and Major Contributors to the PiDP-8/I Project + +* **Oscar Vermeulen **: + + - Creator of the project (both hardware and software) + + - Author of the modifications to the SimH PDP-8 simulator + necessary to make it use the PiDP-8/I front panel hardware + + - Curator of the default set of binary demo media + + - Author of the simulator setup scripts + + - Initiator of much else in the project + + - Author of the bulk of the documentation + + - Host and major contributor to the PiDP-8/I support forum on + Google Groups + + - Hardware kit assembler and distributor + +* **Robert M Supnik** Primary author of the SimH PDP-8 simulator upon + which this project is based. + +* **Mike Barnes** Ported Oscar Vermeulen's SimH 3.9 based PiDP-8/I + simulator to the new SimH 4.0 code base. + +* **Dylan McNamee** Creator of the "buildroot" feature used in the + creation of the official 2015.12.15 release versions. + +* **Mark G. Thomas** Creator of the installation scripts for the + 2015.12.15 release, which were folded into the `make install` + handler within `Makefile.in`. Also wrote the version of the SysV + init script that came with that release as `rc.pidp8`, shipped here + as `pidp8i-init`. + +* **Ian Schofield ** Modified the LED lamp driving + code in the simulator to better simulate the incandescent lamps in + the original PDP-8/I hardware. + +* **Henk Gooijen ** Pushed the PDP-8 + simulator's internal EAE step counter value down into the PiDP-8/I's + LED manipulation code, without which the step counter LEDs remain + dark even when using the EAE. + +* **Paul R. Bernard ** wrote `src/test.c` and the + core of what now appears as `README-test.md`. (The program builds + and installs `pidp8i-test`.) He also provided a one-line fix that + completes the work of Henk Gooijen's step counter patch. + +* **Rick Murphy ** optimized the `pep001.pal` * + example so that it fits into a single page of PDP-8 core, and + provided several useful files in his OS/8 disk images that have + managed to land in this software distribution's OS/8 disk image. + +* **Tony Hill ** Merged all the upstream SIMH + changes between late September 2015 and late December 2016 into the + PiDP-8/I simulator. + +* **Warren Young ** Did everything listed in + `ChangeLog.md` that is not attributed to anyone else. ADDED COPYING.md Index: COPYING.md ================================================================== --- /dev/null +++ COPYING.md @@ -0,0 +1,68 @@ +# Licenses + +The PiDP-8/I software distribution is an agglomeration of software from +multiple sources. Several different licenses apply to its parts. This +file guides you to those individual licenses. + + +## SIMH License + +Most of the files in this software distribution are released under the +terms of the SIMH license, a copy of which typically appears at the top +of each file it applies to. This includes not only SIMH proper but also +several files written by PiDP-8/I software project contributors who +chose to license their contributions under the same license. + +For a few files, textual inclusion of the license inside the file itself +was impractical, so this license is applied by reference to [a file +included with the distribution][sl]. + +[sl]: https://tangentsoft.com/pidp8i/doc/trunk/SIMH-LICENSE.md + + +## autosetup License + +The `configure` script and the contents of the `autosetup` directory are +released under the FreeBSD license given in [`autosetup/LICENSE`][as]. + +[as]: https://tangentsoft.com/pidp8i/doc/trunk/autosetup/LICENSE + + +## palbart License + +The `palbart` program and its manual page are released under the terms +of the license given in [`palbart/LICENSE.md`][pl]. + +[pl]: https://tangentsoft.com/pidp8i/doc/trunk/palbart/LICENSE.md + + +## OS/8 License + +The OS/8 media images included with this software distribution are +released under the Digital License Agreement presented in +[`media/os8/LICENSE.md`][dla]. + +[dla]: https://tangentsoft.com/pidp8i/doc/trunk/media/os8/LICENSE.md + + +## Other DEC Software + +The other files in the [`media`][md] and [`examples`][ed] directories +that originate from Digital Equipment Corporation are believed to fall +under the [public domain license][pdp8pd] DEC released all their PDP-8 +software under after it stopped being ecomonmically viable. Documented +releases for specific software (e.g. TSS/8) may be difficult to come by, +however. + +[md]: https://tangentsoft.com/pidp8i/dir?ci=trunk&name=media +[ed]: https://tangentsoft.com/pidp8i/dir?ci=trunk&name=examples + + +## ETOS License + +ETOS was a commercial product produced outside of DEC. No public +documented declaration of license is known to be available for it, but +we have [a third-hand report][el] that its creators are fine with ETOS +being redistributed. + +[el]: http://mailman.trailing-edge.com/pipermail/simh/2017-January/016169.html ADDED ChangeLog.md Index: ChangeLog.md ================================================================== --- /dev/null +++ ChangeLog.md @@ -0,0 +1,577 @@ +# PiDP-8/I Changes + +## Version 2017.01.23 + +* When any program that talks to the PiDP-8/I front panel starts up, + it now prints out a banner modeled on the [Erlang configuration + line][ecl]. For example, when I run the software in the development + tree on my PiDP-8/I, I get the following: + + PiDP-8/I trunk:i49cd065c [pi3b] [ils] [serpcb] [gpio] + + It tells me that: + + * I'm running code built from Fossil checkin ID 49cd065c on the + trunk branch, as opposed to a release version, which would be + marked `release:v20170123` or similar. (The `i` here is a tag + standing for "ID", as in Fossil checkin ID. Contrast `v` used + to tag release version numbers.) + + * I'm running it on a Raspberry Pi 3 Model B with Ian Schofield's + incandescent lamp simulator (ILS) feature enabled. + + * The software is built to expect that the PiDP-8/I PCB and the Pi + board attached to it have had the serial mods made to them. + + * The GPIO module found the GPIO hardware and was able to attach + to it. + +* I get a very different result when running it on my desktop machine: + + PiDP-8/I trunk:id8536d91 [cake] [nls] [nopcb] [rt] + + This tells me: + + * I'm running a different version of the development branch (i.e. + the "trunk") of the code than what's running on the Pi. + + * It's not running on a Pi at all. (Cake ≠ pi.) + + * I've disabled the ILS feature, so it's running with the "no lamp + simulator" (NLS) GPIO module. + + * Which is all to the good, because there's no point burning CPU + power running the ILS code on a host machine that doesn't have a + PiDP-8/I PCB attached. + + * The GPIO thread is running with real-time privileges. + +* The ILS feature can now be disabled at `configure` time via the new + `--no-lamp-simulator` flag. This option is automatically set when + building on a single-core Raspberry Pi. (The flag is there only to + allow someone building the software on a multi-core host machine to + disable the ILS.) + +* Tweaked the ILS decay constants to be asymmetric, better mimicking + the way real incandescent lamps work: they heat up to full + brightness faster than they fade to perceptively "off." + +* The LED values used by the GPIO thread were being recalculated way + too often. + + In the ILS case, it was updating the values approximately at the + same rate as the ILS's PWM core frequency, roughly 7,500 times per + second, which is far higher than the human persistence of vision + limit. While the PWM rate does need to be that fast to do its job, + the underlying LED state values do not need to change nearly that + often to fool the human into seeing instantaneous updates. + + The NLS case was actually worse, recalculating the LED values on + every instruction executed by the PDP-8 CPU simulator, which even on + a Pi 1 is likely to be a few MHz. + + In both the ILS and NLS cases, we now update the LED values about + 100 times a second, maintaining that rate dynamically based on the + current execution speed of the simulator. + +* In prior versions, the ILS was only updating at its intended rate + when the PDP-8 simulator was running flat-out on a current + multi-core Raspberry Pi. If you throttled the SIMH simulator to a + slower execution rate, the display quality would start to degrade + noticeably below about 1 MIPS. + +* With the prior fix, we now ship 5.script (i.e. the handler for + starting the simulator with IF=5, or restarting it with IF=5 + + `SING_STEP`) set to a throttle value of 30 kIPS, which allows the + human to see each AC/MQ modification. The built-in delay loops are + still there, else we'd have to drop this to well under 1 kIPS. + +* The `SING_INST` switch now immediately puts the processor into + single instruction mode, not requiring a separate press of the + `STOP` key, as in prior versions. This is the correct behavior + according to the 1967-1968 edition of DEC's Small Computer Handbook + for the PDP-8/I. + +* Greatly simplified the way single-instruction mode, processor + stoppage, and the `CONT` key work. The prior implementation was + error-prone and difficult to understand. This fixes a particularly + bad interaction between the way `HLT` instructions and `CONT` key + presses were handled, causing the processor to not resume correctly + from `HLT` state. + +* Consolidated and cleaned up the bulk of the PiDP-8/I switch handling + code so that it is not so intimately tied into the guts of the PDP-8 + CPU emulator. This will greatly increase the chance that future + updates to the upstream SIMH code will apply cleanly to our version. + +* Fixed a bug in `examples/bit-rotate.pal` which caused it to skip the + actual bit rotation step. We were trying to microcode two + instructions into one that the PDP-8 won't accept together, and we + didn't catch it until now because the HLT bug masked it, and the + `palbart` assembler we ship isn't smart enough to notice the bug. + +* Fully generalized the mechanism for generating `obj/*.lst`, + `bin/*.pt`, and `boot/*.script` from `examples/*.pal`. You can now + drop any PAL assembly language program into the `examples` directory + and type `make` to build these various output forms automatically + using the shipped version of `palbart`. This effectively turns this + PiDP-8/I software distribution into a PDP-8 assembly language + development environment: rapidly build, test, and debug your PAL + programs on your PC before you deploy them to real hardware. Or, + write PAL programs to debug the hardware or simulator, as we did + with `examples/bit-rotate.pal`. + +* Fixed a sorting bug in the tool that generates `boot/*.script` from + `obj/*.lst`, resulting in `dep` instructions that weren't sorted by + core address. This didn't cause any real problem, but it made + tracing the execution of a PAL assembly program difficult if you + were trying to refer to the `boot/*.script` file to check that the + PiDP-8/I's front panel is showing the correct register values. + +* Updated SIMH to the latest upstream version and shipping a subset of + the SIMH docs as unversioned files from tangentsoft.com. + +* The `configure` script now aborts the build if it sees that you're + trying to build the software as root, since that means it generates + the init script and the pidp8i script expecting to run the installed + software as root, not as your normal user. The most common way this + happens is that you have a configured source tree, then change one + of the `*.in` files and say `sudo make install`, thinking to build + and install the change in one step. This fixes that. + +* Several improvements to the build system. + +[ecl]: http://stackoverflow.com/q/1182025/142454 + + +## Version 2017.01.16 + +* Prior releases did not include proper licensing for many of the + included files. This project was, therefore, not a proper Open + Source Software project. This problem has been fixed. + + In this release, many files that were previously technically only + under standard copyright due to having no grant of license now have + an explicit license, typically the same as SIMH itself. (Thank you + to all of the authors who allowed me to apply this license to their + contributions!) + + For several other files, I was able to trace down some prior license + and include its text here for the first time. + + There remain a few "gray" items: the TSS/8 and ETOS disk images. + See the [`COPYING.md` file][copying] for more on the current status + of these OS images. If the legal status of these files clarifies in + the future, this software distribution will react accordingly, even + if that means removing these files from the distribution if we learn + that these files are not freely-redistributable, as we currently + believe them to be today. + +* The Step Counter LEDs on the front panel weren't being lit properly + when EAE instructions were being used. Thanks for this patch go to + Henk Gooijen and Paul R. Bernard. + +* The prior `boot/1.script` and `boot/5.script` files are no longer + simply opaque lists of octal addresses and machine code. They are + generated from PAL assembly files provided in the `examples` + directory, so that you can now modify the assembly code and type + `make` to rebuild these boot scripts. + +* The mechanism behind the prior item is fully general-purpose, not + something that only works with `1.script` and `5.script`. Any + `examples/*.pal` file found at `make` time is transformed into a + SIMH boot script named after the PAL file and placed in the `boot` + directory. This gives you an easier way to run PDP-8 assembly code + inside the simulator. After saying `make` to transform `*.pal` into + `*.script` files, you can run the program with `bin/pidp8i-sim + boot/my-program.script` to poke your program's octal values into + core and run it. This round-trip edit-and-run process is far faster + than any of the options given in the [examples' `README.md` + file][ex]. + +* Disassembled both versions of the RIM loader to commented, labeled + PAL assembly language files. If you ever wanted to know what those + 16 mysterious instructions printed on the front panel of your + PiDP-8/I did, you can now read my pidgin interpretation of these + programs in `examples/*-rim.loader.pal` and become just as confused + as I am now. :) + +* The two RIM loader implementations now start with a nonstandard + `HLT` instruction so that when you fire up the simulator with IF=1 to + start the high-speed RIM loader, it automatically halts for you, so + you don't have to remember to STOP the processor manually. + + There is currently [a bug][hltbug] in the way the simulator handles + `HLT` instructions which prevents you from simply pressing START or + CONT to enter the RIM loader after you've attached your paper tape, + so you still have to manually toggle in the 7756 starting address + and press START to load the tape into core. (I hope to fix this + before the next release, but no promises.) + +* Added the `configure --throttle` feature for making the simulator + run at a different speed than it normally does. See + [`README-throttle.md`][rmth] for details. + +* The build system now reacts differently when building the PiDP-8/I + software on a single-core Raspberry Pi: + + * If you're building the trunk or release branch, you'll get a + configure error because it knows you can't run the current + implementation of the incandescent lamp simulator on a + single-core Pi. (Not enough spare CPU power, even with heavy + amounts of throttling.) + + * If you're building the no-lamp-simulator branch, it inserts a + throttle value into the generated `boot/*.script` files that do + not already contain a throttle value so that the simulator + doesn't hog 100% of the lone core, leaving some spare cycles for + background tasks. The above `--throttle` feature overrides + this. + + These features effectively replace the manual instructions in the + old `README-single-core.md` file, which is no longer included with + this software distribution, starting with this release. + +* Lowered the real-time priority of the GPIO thread from 98 to 4. + This should not result in a user-visible change in behavior, but it + is called out here in case it does. (In our testing, such high + values simply aren't necessary to get the necessary performance, + even on the trunk branch with the incandescent lamp simulator.) + +* Since v20161128, when you `make install` on a system with an + existing PiDP-8/I software installation, the binary OS media images + were not being overwritten, on purpose, since you may have modified + them locally, so the installer chose not to overwrite your versions. + + With this release, the same principle applies to the SIMH boot + scripts (e.g. `$prefix/share/boot/0.script`) since those are also + things the user might want to modify. + + This release and prior ones do have important changes to some of + these files, so if you do not wish to overwrite your local changes + with a `make mediainstall` command, you might want to diff the two + versions and decide which changes to copy over or merge into your + local files. + +[hltbug]: https://tangentsoft.com/pidp8i/info/f961906a5c24f5de +[copying]: https://tangentsoft.com/pidp8i/doc/trunk/COPYING.md +[rmth]: https://tangentsoft.com/pidp8i/doc/trunk/README-throttle.md + + +## Version 2017.01.05 + +* Automated the process for merging in new SIMH updates. From within + the PiDP-8/I software build directory, simply say `make simh-update` + and it will do its best to merge in the latest upstream changes. + + This process is more for the PiDP-8/I software maintainers than for + the end users of that software, but if you wish to update your SIMH + software without waiting for a new release of *this* software, you + now have a nice automated system for doing that. + +* Updated SIMH using that new process. The changes relevant to the + PiDP-8/I since the prior update in release v20161226 are: + + * Many more improvements to the simulator's internal timer system. + This should make deliberate underclocking more accurate. + + * It is now possible to get hex debug logs for the simulator console + port by cranking up the simulator's debug level. + +* The simulator now reports the upstream Git commit ID it is based on + in its version string, so that if you report bugs upstream to the + SIMH project, you can give them a version number that will be + meaningful to them. (They don't care about our vYYYYMMDD release + numbers or our Fossil checkin IDs.) + + +## Version 2016.12.26 (The Boxing Day release) + +* Tony Hill updated SIMH to the latest upstream version. + + This change represents about 15 months worth of work in the + [upstream project][simh] — plus a fair bit of work by Tony to merge + it all — so I will only summarize the improvements affecting the + PDP-8 simulator here: + + * Many improvements to the internal handling of timers. + + The most user-visible improvement is that you can now clock your + emulated PDP-8 down to well below the performance of a real + PDP-8 via `SET THROTTLE`, which can be useful for making + blinkenlights demos run at human speeds without adding huge + delay loops to the PDP-8 code implementing that demo. + + * Increased the number of supported terminals from four to either + twelve or sixteen, depending on how you look at it. Eight of + the additional supported terminal devices are conflict-free, + while the final four variously conflict with one or more of the + other features of the simulated PDP-8. If you want to use all + 16, you will be unable to use the FPP, CT, MT and TSC features + of the system. + + This limitation reflects the way the PDP-8 worked. It is not an + arbitrary limitation of SIMH. + + * Added support for the LS8E printer interface option used by the + WPS8 word processing system. + + * The simulator's command console now shows the FPP register + descriptions when using it as a PDP-8 debugger. + + * Added the `SHOW TTIX/TTOX DEVNO` SIMH command to display the + device numbers used for TTIX and TTOX. + + * The `SHOW TTIX SUMMARY` SIMH command is now case-insensitive. + + * Upstream improvements to host OS/compiler compatibility. This + increases the chances that this software will build out of the + box on random non-Raspbian systems such as your development + laptop running some uncommon operating system. + +* When you `make install`, we now disable Deeper Thought 2 and the + legacy `pidp8` service if we find them, since they conflict with our + `pidp8i` service. + +* Added the install user to the `gpio` group if you `make install` if + that group is present at install time. This is useful when building + and installing the software on an existing Raspbian SD card while + logged in as a user other than `pi` or `pidp8i`. + +[simh]: https://github.com/simh/simh/ + + +## Version 2016.12.18 + +* The entire software stack now runs without explicit root privileges. + It now runs under the user and group of the one who built the + software. + + For the few instances where it does need elevated privileges, a + limited-scope set of sudo rules are installed that permit the + simulator to run the necessary helper programs. + +* The power down and reboot front panel switch combinations are no + longer sensitive to the order you flip the switches. + +* Changed the powerdown front panel switch combination to the more + mnemonically sensible `Sing_Step` + `Sing_Inst` + `Stop`. + + Its prior switch combo — `Sing_Step` + `Sing_Inst` + `Start` — is + now the reboot sequence, with the mnemomic "restart." + +* Removed the USB stick mount/unmount front panel switch combos. The + automount feature precludes a need for a manual mount command, and + unmount isn't necessary for paper tape images on FAT sticks. + +* The simulator now runs correctly on systems where the GPIO setup + process fails. (Basically, anything that isn't a Raspberry Pi.) + Prior to this, this failure was just blithely ignored, causing + subsequent code to behave as though all switches were being pressed + at the same time, causing utter havoc. + + The practical benefit of this is that you can now work with the + software on your non-Pi desktop machine, losing out only on the + front panel LEDs and switches. Everything else works just as on the + Pi. You no longer need a separate vanilla SimH setup. + +* Added a locking mechanism that prevents `pidpi8-test` and + `pidp8i-sim` from fighting over the front panel LEDs. While + one of the two is running, the other refuses to run. + +* Added `examples/ac-mq-blinker.pal`, the PAL8 assembly code for the + `boot/5.script` demo. + +* Fixed two unrelated problems with OS/8's FORTRAN IV implementation + which prevented it from a) building new software; and b) running + already-built binaries. Thanks go to Rick Murphy for providing the + working OS/8 images from which the files needed to fix these two + problems were extracted. + +* Added the VT100-patched `VTEDIT` TECO macro from Rick Murphy's OS/8 + images, and made it automatically run when you run TECO from the + OS/8 disk pack. Also added documentation for it in `VTEDIT.DC` on + the disk pack as well as [in the wiki][vteditdoc]. + +* The default user name on the binary OS images is now `pidp8i` + instead of `pi`, its password has changed to `edsonDeCastro1968`, + and it demands a password change on first login. I realize it's a + hassle, but I decided I didn't want to contribute to the plague of + open-to-the-world IoT boxes. + +* Many build system and documentation improvements. + +[vteditdoc][https://tangentsoft.com/pidp8i/wiki?name=Using+VTEDIT] + + +## Version 2016.12.06 + +* The `pidp8i-test` program's LED test routines did not work correctly + when built against the incandescent lamp simulator version of the + GPIO module. Reworked the build so that this test program builds + against the no-lamp-simulator version instead so that you don't have + to choose between having the lamp simulator or having a working + `pidp8i-test` program. + +* More improvements to `examples/pep001.pal`. + +* Extracted improved `PRINTS` routine from that example as + `examples/routines/prints.pal`. + + +## Version 2016.12.05 + +* This release marks the first binary SD card image released under my + maintainership of the software. As such, the major user-visible + features in this release of the Fossil tree simply support that: + + * The `pidp8i-init` script now understands that the OS's SSH host + keys may be missing, and re-generates them. Without this + security measure, anyone who downloads that binary OS image + could impersonate the SSH server on *your* PiDP-8/I. + + * Added a `RELEASE-PROCESS.md` document. This is primarily for my + own benefit, to ensure that I don't miss a step, particularly + given the complexity of producing the binary OS image. However, + you may care to look into it to see what goes on over here on + the other side of the Internet. :) + +* Added an OS/8 BASIC solution to Project Euler Problem #1, so you can + see how much simpler it is compared to the PAL8 assembly language + version added in the prior release. + +* Updated the PAL8 assembly version with several clever optimizations + by Rick Murphy, the primary effect of which is that it now fits into + a single page of PDP-8 core memory. + + +## Version 2016.12.03 + +* Debounced the switches. See [the mailing list post][cdb] announcing + this fix for details. + +* Merged the [`pidp8i-test` program][testpg] from the mailing list. + The LED testing portion of this program [currently][gpiols] only works + correctly without the incandescent lamp simulation patch applied. + +* Added a solution to [Project Euler Problem #1][pep001] in PAL8 + assembly language and wrote the [saga of my battle][p1saga] with + this problem into the wiki. This also adds a couple of useful PAL8 + routines in `examples/routines`. + +* Integrated David Gesswein's latest `palbart` program (v2.13) into + the source distribution so that we don't have to: + + 1. ship pre-built RIM format paper tapes for the examples; and + + 2. put up with the old versions that OS package repos tend to have + (Ubuntu is still shipping v2.4, from 6 years ago!) + +* Fixed a bug in the `make install` script that caused it to skip + installing `screen` and `usbmount` from the OS's package repo when + they are found to be missing. + +* Fixed a related bug that prevented it from disabling the serial + console if you configure the software without `--serial-mod` and + then install it, causing the serial console and the GPIO code in the + PiDP-8/I simulator to fight over GPIO pins 14 and 15. + +* Removed the last of the duplicate binary media entries. This makes + the zip files for this version well under half the size of those for + the 2015.12.15 upstream release despite having more features. + +[cdb]: https://groups.google.com/d/msg/pidp-8/Fg9I8OFTXHU/VjamSoFxDAAJ +[testpg]: https://groups.google.com/d/msg/pidp-8/UmIaBv2L9Ts/wB1CVeGDAwAJ +[gpiols]: https://tangentsoft.com/pidp8i/tktview?name=9843cab968 +[pep001]: https://projecteuler.net/problem=1 +[p1saga]: https://tangentsoft.com/pidp8i/wiki?name=PEP001.PA + + +## Version 2016.11.28 + +* Added an intelligent, powerful build system, replacing the + bare-bones `Makefile` based build system in the upstream version. + See [`README.md`][readme] for more info on this. + +* The installation is now completely relocatable via `./configure + --prefix=/some/other/place`. The upstream version would not work if + installed somewhere other than `/opt/pidp8` due to many hard-coded + absolute paths. (This is enabled by the new build system, but + fixing it was not simply a matter of swapping out the build system.) + +* Changed all of the various "PDP," "PDP-8", and "PiDP-8" strings to + variants on "PiDP-8/I", partly for consistency and partly because it + seems unlikely that this software will ever be used with anything + other than the PiDP-8/I project. + + Part of this renaming means that the default installation location + is now `/opt/pidp8i`, which has the nice side benefit that + installing this version of the software will not overwrite an + existing installation of the upstream version in `/opt/pidp8`. + + Another user-visible aspect of this change is that the upstream + version's `pdp.sh` script to [re]enter the simulator is now called + `pidp8i`. + +* Merged Ian Schofield's [Display update for the PiDP8][dupatch] + patch. Currently it is not optional, but there is [a plan][dudis] to + allow this feature to be disabled via a `configure` script option. + +* The scripts that control the startup sequence of the PiDP-8/I + simulator now include helpful header comments and emit useful + status messages to the console. Stare no more at opaque lists + of SimH commands, wondering what each script does! + +* Merged `scanswitch` into the top-level `src` directory, since the + only thing keeping it in a separate directory was the redundant + `gpio.h` file. There were minor differences between the two `gpio.h` + files, but their differences do not matter. + +* Installing multiple times no longer overwrites the binary OS/program + media, since the disk images in particular may contain local + changes. If you want your media images overwritten, you can insist + on it via `make mediainstall`. + +* The installation tree follows the Linux Filesystem Hierarchy + Standard, so that files are in locations an experienced Linux user + would expect to find them. The biggest changes are that the content + of the upstream `bootscripts` tree is now installed into + `$prefix/share/boot`, and the OS/program media images which used to + be in `imagefiles` are now in `$prefix/share/media`. + +* Added a bunch of ancillary material: [wiki articles][wiki], + [USB stick label artwork][art], a PAL8 assembly [example program][ex] + for you to toggle in, etc. Also filed a bunch of [tickets][tix] + detailing feature proposals, known bugs and weaknesses, etc. If you + were looking for ways to contribute to the development effort, these + new resources provide a bunch of ideas. + +* Made some efforts toward portability. + + While this project will always center around Raspbian and the + PiDP-8/I add-on board, the intent is that you should be able to + unpack the project on any other Unix type system and at least get + the simulator up and running with the normal SimH manual control + over execution instead of the nice front panel controls provided by + the PiDP-8/I board. + + In particular, the software now builds under Mac OS X, though it + does not yet run properly. (The modified SimH PDP-8 simulator + currently misbehaves if the PiDP-8/I panel is not present. Fixing + this is on the radar.) + +* Fixed a bunch of bugs! + +[readme]: https://tangentsoft.com/pidp8i/doc/trunk/README.md +[dupatch]: https://groups.google.com/forum/#!topic/pidp-8/fmjt7AD1gIA +[dudis]: https://tangentsoft.com/pidp8i/tktview?name=e06f8ae936 +[wiki]: https://tangentsoft.com/pidp8i/wcontent +[ex]: https://tangentsoft.com/pidp8i/doc/trunk/examples/README.md +[art]: https://tangentsoft.com/pidp8i/dir?c=trunk&name=labels +[tix]: https://tangentsoft.com/pidp8i/tickets + + +## Version 2015.12.15 + +* The official upstream release of the software, still current as of + late 2016, at least. ADDED HACKERS.md Index: HACKERS.md ================================================================== --- /dev/null +++ HACKERS.md @@ -0,0 +1,495 @@ +Hacking on the PiDP-8/I Software +==== + +If you are going to make any changes to the PiDP-8/I software, here are +some rules and hints to keep in mind while you work. + + +Getting Started with Fossil +---- + +The PiDP-8/I software project is hosted using the [Fossil][fossil] +[distributed version control system][dvcs]. Fossil provides most of the +features of GitHub under a simpler operating model than Subversion +without tying you to a proprietary web service. + +This guide will introduce you to some of the basics, but you should also +at least read the [Fossil Quick Start Guide][fqsd]. For a more thorough +introduction, I recommend [the Schimpf book][fbook]. If you have +questions, it is best to ask them on [its low-volumn mailing list][fml], +though you may also ask me, either on [the PiDP-8/I mailing list][ggml] +or via private email. + +Most Raspberry Pi OS distributions include Fossil in their package +repository, and it is also available for all common desktop platforms. +If you started with one of the binary OS images downloaded from +tangentsoft.com, Fossil is already installed. If you don't like any of +those options, you can also use [the official binaries][fbin]. + + +[fbin]: http://fossil-scm.org/index.html/uv/download.html +[dvcs]: http://en.wikipedia.org/wiki/Distributed_revision_control +[fbook]: http://www.fossil-scm.org/schimpf-book/home +[fml]: http://mailinglists.sqlite.org/cgi-bin/mailman/listinfo/fossil-users +[fossil]: http://fossil-scm.org/ +[fqsg]: http://fossil-scm.org/index.html/doc/trunk/www/quickstart.wiki +[ggml]: https://groups.google.com/forum/#!forum/pidp-8 + + +Fossil Anonymous Access +---- + +To clone the code repository anonymously, say: + + $ mkdir ~/museum # because where else do you store fossils? + $ fossil clone https://tangentsoft.com/pidp8i ~/museum/pidp8i.fossil + $ mkdir -p ~/src/pidp8i/trunk + $ cd ~/src/pidp8i/trunk + $ fossil open ~/museum/pidp8i.fossil + +The second command gets you a file called `pidp8i.fossil` containing the +full history of PiDP-8/I from the upstream 2015.12.15 release onward. +You can call that clone file anything you like and put it in any +directory you like. Even the `.fossil` extension is just a convention, +not a requirement. (There is one feature of Fossil that requires that +file extension, but you probably won't use that feature.) + + +Working With Existing Tags and Branches +---- + +The directory structure shown in the commands above is more complicated +than strictly necessary, but it has a number of nice properties. + +First, it collects other software projects under a common top-level +directory, which I'm calling `~/src`, but you are free to use any scheme +you like. + +Second, the top-level project directory stores multiple separate +checkouts, one for each branch or tag I'm actively working with at the +moment. So, to add a few other checkouts, you could say: + + $ cd ~/src/pidp8i + $ mkdir -p release # another branch + $ mkdir -p v20151215 # a tag this time, not a branch + ...etc... + $ cd release + $ fossil open ~/museum/pidp8i.fossil release + $ cd ../v20151215 + $ fossil open ~/museum/pidp8i.fossil v20151215 + ...etc... + +This gives you multiple independent checkouts. The branch checkouts +remain pinned to the tip of that branch, so that if someone else checks +changes in on that branch and you say `fossil update`, those changes +appear in your checkout of that branch. The tag checkouts behave +differently, always showing a specific checkout with the given tag name. + +(In Fossil, tags and branches are related, but the details are beyond +our scope here. See the [Fossil Quick Start Guide][fqsg] and the +documents it links to for more details.) + +This directory scheme shows an important difference between Fossil and +Git: with Git, the checkout and the clone are intermingled in the same +directory tree, but in Fossil, they are strictly separate. Git can +emulate Fossil's normal working style through its [worktree][gitwt] +feature, but it's a kind of lash-up using symlinks and such, whereas +with Fossil, there is no confusion: the repository clone is a single +SQLite database file — here, `pidp8i.fossil` — and the checkouts are +made from the contents of that database. + +Another important difference relative to Git is that with Fossil, local +checkins attempt to automatically sync checked-in changes back to the +repository you cloned from. (This only works if you have a login on the +remote repository, the subject of the next section.) This solves a +number of problems with Git, all stemming from the fact that Git almost +actively tries to make sure every clone differs from every other in some +important way. + +While Fossil does allow offline operation and local independent clones, +its default mode of operation is to try and keep the clones in sync as +much as possible. Git works the way it does because it was designed to +meet the needs of the Linux kernel development project, which is +inherently federated, so Git tries to operate in a federated model as +well. Fossil is better for smaller, more coherent teams, where there is +a single, clear goal for the project and a single source for its +official code. Fossil helps remote developers cooperate, whereas Git +helps remote developers go off on their own tangents for extended +periods of time and optionally sync back up with each other +occasionally. + +Fossil is a better match for the way the PiDP-8/I software project +works: we want you to cooperate closely with us, not go off on wild +tangents. + +[gitwt]: https://git-scm.com/docs/git-worktree + + +Fossil Developer Access +---- + +If you have a developer account on tangentsoft.com's Fossil instance, just +add your username to the URL like so: + + $ fossil clone http://username@tangentsoft.com/pidp8i pidp8i.fossil + +Fossil will ask you for the password for `username` on the remote Fossil +instance, and it will offer to remember it for you. If you let it +remember the password, operation from then on is scarcely different from +working with an anonymous clone, except that on checkin, your changes +will be sync'd back to the repository on tangentsoft.com if you're +online at the time. + +If you're working offline, Fossil will still do the checkin, but you'll +be able to sync with the central repoisitory once you get back online. +It is best to work on a branch when unable to use Fossil's autosync +feature, as you are less likely to have a sync conflict when attempting +to send a new branch to the central server than in attempting to merge +your changes to the tip of trunk into the current upstream trunk, which +may well have changed since you went offline. + +You can purposely work offline by disabling autosync mode: + + $ fossil set autosync 0 + +Until you re-enable it (`autosync 1`) Fossil will stop trying to sync +your local changes back to the central repo. In this mode, Fossil works +more like Git's default mode, buying you many of the same problems that +go along with that working style. I recommend disabling autosync mode +only when you are truly going to be offline, and don't want Fossil +attempting to sync when you know it will fail. + + +Getting Developer Access +---- + +The administrator of this repository is Warren Young, whose email you +can find on the [official PiDP-8/I project mailing list][ggml]. +Developer access is available to anyone who makes a reasonable request. + + +Creating Branches +---- + +Creating a branch in Fossil is scary-simple, to the point that those +coming from other version control systems may ask, "Is that really all +there is to it?" Yes, really, this is it: + + $ fossil ci --branch new-branch-name + +That is to say, you make your changes as you normally would; then when +you go to check them in, you give the `--branch` option to the +`ci/checkin` command to put the changes on a new branch, rather than add +them to the same branch the changes were made against. + +While developers with login rights to the PiDP-8/I Fossil instance are +allowed to check in on the trunk at any time, we recommend using +branches whenever you're working on something experimental, or where you +can't make the necessary changes in a single coherent checkin. +Basically, `trunk` should always build without error, and it should +always function correctly. Branches are for isolating work until it is +ready to merge into the trunk. + +Here again we have a difference with Git: because Fossil normally syncs +your work back to the central repository, this means we get to see the +branches you are still working on. This is a *good thing*. Do not fear +committing broken or otherwise bad code to a branch. [You are not your +code.][daff] We are software developers, too: we understand that +software development is an iterative process, and that not all ideas +spring forth perfect and production-ready from the fingers of its +developers. These public branches let your collaborators see what +you're up to, and maybe lend advice or a hand in the work, but mostly +public branches let your collaborators see what you're up to, so they're +not surprised when the change finally lands in trunk. + +This is part of what I mean about Fossil fostering close cooperation +rather than fostering wild tangents. + +Jim McCarthy (author of [Dynamics of Software Development][dosd]) has a +presentation on YouTube that touches on this topic at a couple of +points: + +* [Don't go dark](https://www.youtube.com/watch?v=9OJ9hplU8XA) +* [Beware of a guy in a room](https://www.youtube.com/watch?v=oY6BCHqEbyc) + +Fossil's sync-by-default behavior fights these negative tendencies. + +[daff]: http://www.hanselman.com/blog/YouAreNotYourCode.aspx +[dosd]: http://amzn.to/2iEVoBL + + +Debug Builds +---- + +By default, the build system creates a release build, but you can force +it to produce a binary without as much optimization and with debug +symbols included: + + $ ./configure --debug-mode + + +Manipulating the Build System Source Files +---- + +The [autosetup build system][asbs] is composed of these files and +directories: + + auto.def + autosetup/ + configure + Makefile.in + +Unlike with GNU Autoconf, which you may be familiar with, the +`configure` script is not output from some other tool. It is just a +driver for the Tcl and C code under the `autosetup` directory. If you +have to modify any of these files to get some needed effect, you should +try to get that change into the upstream project, then merge that change +down into the local copy when it lands upstream. + +The bulk of the customization to the build system is in `auto.def`, +which is a Tcl script run by `autosetup` via the `configure` script. +Some knowledge of [Tcl syntax][tcldoc] will therefore be helpful in +modifying it. + +If you do not have Tcl installed on your system, `configure` builds a +minimal Tcl interpreter called `jimsh0`, based on the [Jim Tcl][jim] +project. Developers working on the build system are encoruaged to use +this stripped-down version of Tcl rather than "real" Tcl because Jim Tcl +is more or less a strict subset of Tcl, so any changes you make that +work with the `jimsh0` interpreter should also work with "real" Tcl, but +not vice versa. If you have Tcl installed and don't really need it, +consider uninstalling it to force `autosetup` to build and use `jimsh0`. + +The `Makefile.in` file is largely a standard [GNU `make`][gmake] file +excepting only that it has variables substituted into it by +[`autosetup`][asbs] using its `@VARIABLE@` syntax. At this time, we do +not attempt to achieve compatibility with other `make` programs, though +in the future we may need it to work with [BSD `make`][bmake] as well, +so if you are adding features, you might want to stick to the common +subset of features implemented by both the GNU and BSD flavors of +`make`. We do not anticpate any need to support any other `make` +flavors. + +(This, by the way, is why we're not using some heavy-weight build system +such as the GNU Autotools, CMake, etc. The primary advantage of GNU +Autotools is that you can generate source packages that will configure +and build on weird and ancient flavors of Unix; we don't need that. +Cross-platform build systems such as CMake ease building the same +software on multiple disparate platforms straightforward, but the +PiDP-8/I software is built primarily on and for a single operating +system, Rasbpian Linux. It also happens to build and run on other +modern Unix and Linux systems, for which we also do not need the full +power of something like CMake. `autosetup` and GNU `make` suffice for +our purposes here.) + +[asbs]: http://msteveb.github.io/autosetup/ +[bmake]: https://www.freebsd.org/doc/en/books/developers-handbook/tools-make.html +[gmake]: https://www.gnu.org/software/make/ +[jim]: http://jim.tcl.tk/ +[tcldoc]: http://wiki.tcl.tk/11485 + + +Submitting Patches +---- + +If you do not have a developer login on the PiDP-8/I software +repository, you can still send changes to the project. + +The simplest way is to say this after developing your change against the +trunk of PiDP-8/I: + + $ fossil diff > my-changes.patch + +Then attach that file to a new [PiDP-8/I mailing list][ggml] message +along with a declaration of the license you wish to contribute your +changes under. We suggest using the [SIMH license][simhl], but any +[non-viral][viral] [OSI-approved license][osil] should suffice. + +If your change is more than a small patch, `fossil diff` might not +incorporate all of the changes you have made. The old unified `diff` +format can't encode branch names, file renamings, file deletions, tags, +checkin comments, and other Fossil-specific information. For such +changes, it is better to send a Fossil bundle: + + $ fossil set autosync 0 # disable autosync + $ fossil checkin --branch my-changes + ...followed by more checkins on that branch... + $ fossil bundle export --branch my-changes my-changes.bundle + +After that first `fossil checkin --branch ...` command, any subsequent +changes will also be made on that branch without needing a `--branch` +option until you explicitly switch to some other branch. This lets you +build up a larger change on a private branch until you're ready to +submit the whole thing as a bundle. + +Because you are working on a branch on your private copy of the +PiDP-8/I Fossil repository, you are free to make as many checkins as +you like on the new branch before giving the `bundle export` command. + +Once you are done with the bundle, send it to the mailing list just as +with the patch. + +If you provide a quality patch, we are likely to offer you a developer +login on [the repository][repo] so you don't have to continue with the +patch or bundle methods. + +Please make your patches or experimental branch bundles against the tip +of the current trunk. PiDP-8/I often drifts enough during development +that a patch against a stable release may not apply to the trunk cleanly +otherwise. + +[osil]: https://opensource.org/licenses +[repo]: http://tangentsoft.com/pidp8i/ +[simhl]: https://tangentsoft.com/pidp8i/doc/trunk/SIMH-LICENSE.md +[viral]: https://en.wikipedia.org/wiki/Viral_license + + +The PiDP-8/I Software Project Code Style Rules +---- + +Every code base should have a common code style. Love it or +hate it, here are PiDP-8/I's current code style rules: + +**C Source Code** + +File types: `c`, `h`, `c.in` + +We follow the SIMH project's pre-existing code style when modifying one +of its source files: + +* Spaces for indents, size 4 + +* DOS line endings. (Yes, even though this is a Linux-based project! + All decent Linux text editors can cope with this.) + +* Function, structure, type, and variable names are all lowercase, + with underscores separating words + +* Macro names are in `ALL_UPPERCASE_WITH_UNDERSCORES` + +* Whitespace in the SIMH C files is of a style I have never seen + anywhere else in my decades of software development. This example + shows the important features: + + int some_function (char some_parameter) + { + int some_variable = 0; + + if (some_parameter != '\0') { + int nbytes = sizeof (some_parameter); + char *buffer = malloc (4 * nbytes); + + switch (some_parameter) { + case 'a': + do_something_with_buffer ((char *)buffer); + default: + do_something_else (); + } + } + else { + some_other_function (with_a_large, "number of parameters", + wraps_with_a_single, "indent level"); + printf (stderr, "Failed to allocate buffer.\n"); + } + } + + It is vaguely like K&R C style except that: + + - The top level of statements in a function are not indented + + - The closing curly brace is indented to the same level as the + statement(s) it contains + + - There is a space before all opening parentheses, not just those + used in `if`, `while`, and similar flow control statements. + + Nested open parentheses do not have extra spaces, however. Only + the outer opening parenthesis has a space separating it from + what went before. + + - Multiple variables declared together don't have their types and + variable names aligned in columns. + +I find that this style is mostly sensible, but with two serious problems: +I find the indented closing curly braces confusing, and I find that the +loss of the first indent level for the statements inside a function makes +functions all visually run together in a screenful of code. Therefore, +when we have the luxury to be working on a file separate from SIMH, +we use a variant of its style with these two changes, which you can +produce with this command: + + $ indent -kr -nce -cli4 -nlp -pcs -di1 -i4 -l100 \ + -ncs -ss -nbbo FILES... + +That is, start with K&R, then: + +- nce: don't cuddle else +- cli4: indent case statement labels 4 spaces +- nlp: don't align continued statements at the opening parenthesis +- pcs: put a space before the opening parenthesis of a function call +- di1: don't line up variable types and names in separate columns +- i4: use 4-space indents +- l100: allow lines up to 100 columns before forcibly breaking them +- ncs: don't put a space between a cast and its operand +- ss: add a space before semicolon with empty loop body +- nbbo: don't break long lines before || and && operators + +That gives the following, when applied to the above example: + + int some_function (char some_parameter) + { + int some_variable = 0; + + if (some_parameter != '\0') { + int nbytes = sizeof (some_parameter); + char *buffer = malloc (4 * nbytes); + + switch (some_parameter) { + case 'a': + do_something_with_buffer ((char *)buffer); + default: + do_something_else (); + } + } + else { + some_other_function (with_a_large, "number of parameters", + wraps_with_a_single, "indent level"); + printf (stderr, "Failed to allocate buffer.\n"); + } + } + +If that looks greatly different, realize that it is just two indenting +level differences: add one indent at function level, except for the +closing braces, which we leave at their previous position. + +SIMH occasionally exceeds 100-column lines. I recommend breaking +long lines at 72 columns. Call me an 80-column traditionalist. + +BSD `indent` does't understand the `-kr` option, so you can use this +alternative on BSD and macOS systems: + + $ indent -nce -cli4 -nlp -pcs -di1 -i4 -l100 \ + -bap -ncdb -nfc1 -npsl -nsc FILES... + +When in doubt, mimic what you see in the current code. When still in +doubt, ask on the mailing list. + +[indent]: http://linux.die.net/man/1/indent + + +**Plain Text Files** + +File types: `md`, `txt` + +* Spaces for indents, size 4. + +* Unix line endings. The only common text editor I'm aware of that + has a problem with this is Notepad, and people looking at these + files anywhere other than unpacked on a Raspberry Pi box are + probably looking at them through the Fossil web interface on + tangentsoft.com. + +* Markdown files must follow the syntax flavor understood by + [Fossil's Markdown interpreter][fmd]. + +[fmd]: https://tangentsoft.com/pidp8i/md_rules ADDED Makefile.in Index: Makefile.in ================================================================== --- /dev/null +++ Makefile.in @@ -0,0 +1,317 @@ +######################################################################## +# Makefile.in - Processed by autosetup's configure script to generate +# the GNU make(1) file for building the PiDP-8/I software. +# +# If you are seeing this at the top of a file called Makefile and you +# intend to make edits, do that in Makefile.in. Saying "make" will then +# re-build Makefile from that modified Makefile.in before proceeding to +# do the "make" operation. +# +# Copyright © 2015-2017 Oscar Vermeulen, Warren Young +# +# Permission is hereby granted, free of charge, to any person obtaining +# a copy of this software and associated documentation files (the +# "Software"), to deal in the Software without restriction, including +# without limitation the rights to use, copy, modify, merge, publish, +# distribute, sublicense, and/or sell copies of the Software, and to +# permit persons to whom the Software is furnished to do so, subject to +# the following conditions: +# +# The above copyright notice and this permission notice shall be +# included in all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +# IN NO EVENT SHALL THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, +# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT +# OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE +# OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +# +# Except as contained in this notice, the names of the authors above +# shall not be used in advertising or otherwise to promote the sale, +# use or other dealings in this Software without prior written +# authorization from those authors. +######################################################################## + +# Git commit ID of the latest version of the SIMH 4 project on GitHub +# that has been merged into this source base. +SGCID=0046905f72e2372a8bf5dfc90425fd5214b0ba8a + +CFLAGS = @CFLAGS@ -Wno-unused-result -Wno-parentheses @BUILDMODE@ \ + -DUSE_READER_THREAD -DHAVE_DLOPEN=so -DPIDP8I -DSIM_ASYNCH_IO \ + -DHAVE_REGEX_H -DHAVE_GLOB -DSIM_GIT_COMMIT_ID=$(SGCID) \ + -U__STRICT_ANSI__ \ + -I @srcdir@/src -I @srcdir@/src/PDP8 -I @builddir@/src + +SIM = bin/pidp8i-sim +BINS = bin/palbart $(SIM) bin/pidp8i-test libexec/scanswitch + +BUILDDIRS = bin libexec obj/PDP8 + +INSTDIRS = bin etc libexec share/boot share/media share/man/man1 + +OBJS = \ + obj/gpio-common.o \ + obj/sim_console.o \ + obj/PDP8/pdp8_df.o \ + obj/PDP8/pdp8_cpu.o \ + obj/PDP8/pdp8_clk.o \ + obj/PDP8/pdp8_ct.o \ + obj/PDP8/pdp8_dt.o \ + obj/PDP8/pdp8_fpp.o \ + obj/PDP8/pdp8_lp.o \ + obj/PDP8/pdp8_mt.o \ + obj/PDP8/pdp8_pt.o \ + obj/PDP8/pdp8_rf.o \ + obj/PDP8/pdp8_rk.o \ + obj/PDP8/pdp8_rl.o \ + obj/PDP8/pdp8_rx.o \ + obj/PDP8/pdp8_sys.o \ + obj/PDP8/pdp8_td.o \ + obj/PDP8/pdp8_tsc.o \ + obj/PDP8/pdp8_tt.o \ + obj/PDP8/pdp8_ttx.o \ + obj/PDP8/pidp8i.o \ + obj/scp.o \ + obj/sim_disk.o \ + obj/sim_ether.o \ + obj/sim_fio.o \ + obj/sim_serial.o \ + obj/sim_sock.o \ + obj/sim_tape.o \ + obj/sim_timer.o \ + obj/sim_tmxr.o + +LIBS = -lm -ldl -lpthread + +EXAMPLES := $(wildcard @srcdir@/examples/*.pal) +EXAMPLES := $(subst @srcdir@/examples,bin,$(EXAMPLES)) +EXAMPLES := $(EXAMPLES:.pal=.pt) +LISTINGS := $(EXAMPLES:.pt=.lst) +LISTINGS := $(subst bin/,obj/,$(LISTINGS)) +BOOTSCRIPTS := $(LISTINGS:.lst=.script) +BOOTSCRIPTS := $(subst obj/,boot/,$(BOOTSCRIPTS)) \ + boot/1.script \ + boot/5.script + +# List of *.in files from auto.def file, except for this present file +# (Makefile.in) which is handled separately. This list should only +# change when the list of "make-template" calls in auto.def changes. +# +# If the first file listed below changes, change the AUTOREBUILD rule +# near the end of this file to match! +INFILES = \ + @srcdir@/bin/pidp8i.in \ + @srcdir@/boot/0.script.in \ + @srcdir@/boot/2.script.in \ + @srcdir@/boot/3.script.in \ + @srcdir@/boot/4.script.in \ + @srcdir@/boot/6.script.in \ + @srcdir@/boot/7.script.in \ + @srcdir@/etc/pidp8i-init.in \ + @srcdir@/etc/sudoers.in \ + @srcdir@/examples/Makefile.in \ + @srcdir@/src/Makefile.in \ + @srcdir@/src/gpio-common.c.in \ + @srcdir@/src/PDP8/Makefile.in \ + @srcdir@/src/PDP8/pidp8i.c.in \ + @srcdir@/src/scp.c.in \ + @srcdir@/tools/simh-update.in +OUTFILES := $(subst @srcdir@/,,$(INFILES)) +OUTFILES := $(subst .in,,$(OUTFILES)) + +CLTXT = /boot/cmdline.txt + +.PHONY: tags + +all: $(OUTFILES) $(BUILDDIRS) $(BINS) $(BOOTSCRIPTS) $(LISTINGS) $(EXAMPLES) + @chmod 755 @builddir@/bin/pidp8i + +clean: + @rm -f $(BINS) $(BOOTSCRIPTS) $(EXAMPLES) $(LISTINGS) $(OBJS) \ + @builddir@/tags \ + @builddir@/obj/*.d \ + @builddir@/obj/*.o \ + @builddir@/obj/PDP8/*.d \ + @srcdir@/examples/*.err + @for f in $(OUTFILES) ; do test "$$f" = "$${f/Makefile//}" && rm $$f ; done + @-rmdir -p $(BUILDDIRS) 2> /dev/null || true + +distclean: clean + @rm -f \ + @builddir@/config.log \ + @builddir@/Makefile \ + @builddir@/autosetup/jimsh0 \ + @builddir@/examples/Makefile \ + @builddir@/src/Makefile \ + @builddir@/src/config.h \ + @builddir@/src/PDP8/Makefile + +ctags tags: + ctags -R @srcdir@ + +install: all + @echo Installing to @prefix@... + + @# Create any missing install tree directories + for d in $(INSTDIRS) ; do @INSTALL@ -m 755 -d @prefix@/$$d ; done + + @# Install files into those dirs and set their perms + for f in $(BINS) ; do @INSTALL@ -m 755 -D -s $$f @prefix@/$$f ; done + @INSTALL@ -m 755 @srcdir@/bin/pidp8i @prefix@/bin + -for f in @prefix@/bin/pidp8i-* ; do setcap 'cap_sys_nice=eip' $$f ; done || true + test -e @MEDIADIR@/os8/os8.rk05 || $(MAKE) mediainstall + + @# If this is a Debian-type system, install needed helper programs + @test -x /usr/bin/apt-get -a ! -h /media/usb && apt-get -y install usbmount || true + @test -x /usr/bin/apt-get -a ! -x /usr/bin/screen && apt-get -y install screen || true + + @# Disable competing services if this is a Raspberry Pi + @(test -x /bin/systemctl && /bin/systemctl disable deeper || true) + @(test -x /bin/systemctl && /bin/systemctl disable pidp8 || true) + + @# Install the init script if this system is systemd based. + @INSTALL@ -m 750 @srcdir@/etc/pidp8i-init @prefix@/etc + @( test -w /etc/init.d -a -x /bin/systemctl && \ + ln -sf @ABSPREFIX@/etc/pidp8i-init /etc/init.d/pidp8i && \ + /bin/systemctl enable pidp8i \ + ) || true + + @# Give the install user permission to use GPIO if done on a Pi + @grep -q '^gpio:' /etc/group && usermod -a -G gpio @INSTUSR@ || true + + @# Give the install user permission to shut down and reboot the Pi + @# if this is a systemd/sudo based system. + @( test -d /etc/sudoers.d -a -w /etc/sudoers.d -a -x /bin/systemctl && \ + @INSTALL@ -m 440 -o root -g root @srcdir@/etc/sudoers \ + /etc/sudoers.d/099_pidp8i \ + ) || true + + @# Add installation bin dir to the non-root user's PATH unless it's + @# already in there or we aren't running under sudo. + @(for p in .profile .bash_profile ; do \ + test -n "$$SUDO_USER" -a -w "/home/$$SUDO_USER/$$p" && \ + ! grep -qF "@ABSPREFIX@/bin" "/home/$$SUDO_USER/$$p" && \ + echo "export PATH=\$$PATH:@ABSPREFIX@/bin" >> "/home/$$SUDO_USER/$$p" ; \ + done) || true + + @# Ditto for MANPATH + @(for p in .profile .bash_profile ; do \ + test -n "$$SUDO_USER" -a -w "/home/$$SUDO_USER/$$p" && \ + ! grep -qF "@ABSPREFIX@/share/man" "/home/$$SUDO_USER/$$p" && \ + echo "export MANPATH=\$$MANPATH:@ABSPREFIX@/share/man" >> "/home/$$SUDO_USER/$$p" ; \ + done) || true + + @# If serial mod is disabled, turn off serial console and kgdb stuff + @# in case they were enabled previously, else they will fight with + @# our use of GPIO. + @( test -z "@PCB_SERIAL_MOD@" -a -r $(CLTXT) && ! -w $(CLTXT) && \ + cp -p $(CLTXT) "$(CLTXT)"_orig && \ + sed -e 's/console\=[a-zA-Z0-9]+,[0-9]+ //' \ + -e 's/kgdboc\=[a-zA-Z0-9]+,[0-9]+ //' -i $(CLTXT) \ + ) || true + + @# Install palbart stuff + @INSTALL@ -m 755 @builddir@/bin/palbart @prefix@/bin + @INSTALL@ -m 644 @srcdir@/palbart/palbart.1 @prefix@/share/man/man1 + +mediainstall: + @echo "[Re]installing OS and program media..." + @cd @srcdir@ ; \ + find media \( \ + -name \*.bin -o \ + -name \*.dsk -o \ + -name \*.rk05 -o \ + -name \*.tu56 \ + \) -exec @INSTALL@ -D -m 664 -g @INSTGRP@ {} @ABSPREFIX@/share/{} \; + @INSTALL@ -m 664 -g @INSTGRP@ @builddir@/boot/*.script @BOOTDIR@ + +os8test: + @builddir@/$(SIM) @srcdir@/boot/0.script + +reconfig: + @AUTOREMAKE@ + +release: all + @srcdir@/tools/mkrel + +simh-update simh-update-f: + @@builddir@/tools/simh-update $(subst simh-update,,$@) + + +# Rule for compiling *.c to *.o and autogenerating dependency info. +# Explained at http://scottmcpeak.com/autodepend/autodepend.html +# +# Reflect any changes here into near-duplicate below! +obj/%.o: @srcdir@/src/%.c + $(CC) -c $(CFLAGS) @srcdir@/src/$*.c -o obj/$*.o + $(CC) -MM $(CFLAGS) @srcdir@/src/$*.c > obj/$*.d + @mv -f obj/$*.d obj/$*.d.tmp + @sed -e 's|.*:|obj/$*.o:|' < obj/$*.d.tmp > obj/$*.d + @sed -e 's/.*://' -e 's/\\$$//' < obj/$*.d.tmp | fmt -1 | \ + sed -e 's/^ *//' -e 's/$$/:/' >> obj/$*.d + @rm -f obj/$*.d.tmp + +# Near-duplicate of above rule for those *.c files generated from *.c.in +# files in the srcdir. Needed when building out-of-tree. +obj/%.o: @builddir@/src/%.c + $(CC) -c $(CFLAGS) @builddir@/src/$*.c -o obj/$*.o + $(CC) -MM $(CFLAGS) @builddir@/src/$*.c > obj/$*.d + @mv -f obj/$*.d obj/$*.d.tmp + @sed -e 's|.*:|obj/$*.o:|' < obj/$*.d.tmp > obj/$*.d + @sed -e 's/.*://' -e 's/\\$$//' < obj/$*.d.tmp | fmt -1 | \ + sed -e 's/^ *//' -e 's/$$/:/' >> obj/$*.d + @rm -f obj/$*.d.tmp + +# Rule for building example PAL assembly language programs. +obj/%.lst bin/%.pt: @srcdir@/examples/%.pal bin/palbart + @builddir@/bin/palbart -lr $< || cat @srcdir@/examples/$*.err + mv @srcdir@/examples/$*.lst @builddir@/obj/$*.lst + mv @srcdir@/examples/$*.rim @builddir@/bin/$*.pt + +# Rule for translating PAL assembly language program listings to SIMH +# boot scripts. +boot/%.script: obj/%.lst + @srcdir@/tools/mkbootscript $< + +# Rules for making aliases of named example programs translated to boot +# scripts as special numbered boot scripts +boot/1.script: boot/hs-rim-loader.script + ln -f $< $@ +boot/5.script: boot/ac-mq-blinker.script + ln -f $< $@ + +bin/palbart: @srcdir@/palbart/palbart.c + $(CC) -Wall -Wno-strict-prototypes @BUILDMODE@ $< -o $@ + $(CC) -MM $< -o obj/$*.d + +$(BUILDDIRS): + mkdir -p $@ + +$(SIM): $(OBJS) obj/gpio-@LED_DRIVER_MODULE@ls.o + $(CC) -o $@ $^ $(LIBS) + +bin/pidp8i-test: obj/test.o obj/gpio-nls.o obj/gpio-common.o + $(CC) -o $@ $^ $(LIBS) + +libexec/scanswitch: obj/scanswitch.o obj/gpio-nls.o obj/gpio-common.o + $(CC) -o $@ $^ + +ifeq ($(findstring clean,$(MAKECMDGOALS)),) +Makefile: @srcdir@/Makefile.in @srcdir@/auto.def $(INFILES) @AUTODEPS@ + @AUTOREMAKE@ && $(MAKE) + +# If you simply make $(OUTFILES) depend on $(INFILES), make(1) thinks it +# can build all of $(OUTFILES) in parallel if given -jN, which causes +# ./configure --args to run N times in parallel, which blows shit up +# right good and proper. We purposely list only the first file in +# $(INFILES) here to prevent that. The other files in $(INFILES) will +# also be built, which confuses make(1) somewhat, but it figures things +# out on the subsequent $(MAKE) call. +bin/pidp8i: @srcdir@/bin/pidp8i.in + @AUTOREMAKE@ && $(MAKE) +endif + +-include $(OBJS:.o=.d) obj/scanswitch.d + ADDED README-test.md Index: README-test.md ================================================================== --- /dev/null +++ README-test.md @@ -0,0 +1,99 @@ +# PCB Test Program + + +## Compiling and Installing + +`pidp8i-test` is a simple program to test [Oscar Vermeulen's PiDP-8/I +Kit][project] during construction. It is built and installed alongside +the other software with the normal `make` process. + + +## Running It + +If you are building the software on the Pi for the first time, log out +of your user account after installing it, then back in so that the +install script's changes to your user's `PATH` take effect. + +Thereafter, simply give these commands: + + $ sudo systemctl stop pidp8i + $ pidp8i-test + +The first command ensures that the modified PDP-8 simulator is stopped +during the test, since only one program can be talking to the switch and +LED array at a given time. (This also applies to other programs like +[Deeper Thought 2][dt2].) + + +## Test Procedure + +You can at any time hit Ctrl-C to stop the test. + +The test proceeds as follows: + +* All On test: + + It turns on all LEDs for 5 seconds. + +* All Off test: + + It turns off all LEDs for 5 seconds. + +* Row test: + + It turns on one full row of LEDs and pauses for 5 seconds, then + switches to the next row. There are eight rows of LEDs of up to 12 + LEDs each. + +* Column test: + + It then turns on one full column of LEDs and pauses for 5 seconds, + then switches to the next column. There are 12 columns of LEDs with + up to 8 LEDs each. (Some of the LEDs positions in a column are + sometimes rather chaotic, it will require intimate knowledge of the + schematic to verify. It's somewhat of a useless test but it might + turn up an assembly error for someone.) + +* Switch test: + + It then goes into a single LED chase pattern and starts looking at + switches. This loop is infinite. Every time it detects a change in + the switch positions it prints out the full Octal bit pattern for + the three switch banks. No attempt is made to name the actual + switch that has been flipped. The goal is to verify switch + functionality, not to debug the design of the circuit or the driver. + + When running this test, if you get a new line printed with a single + bit change when you flip a single switch, the switch in question is + working. If you get no output printed or multiple bits changed in + the output printed something is wrong. + + If for some reason you need to decode the output bits to physical + switches they appear as follows: + + | A | B | C + |------------------- + | 4000 | 0000 | 0000 + + The first twelve bits (labelled A) is the Switch Register. The bits + left to right correspond to the SR switches also left to right. So + above the SR1 switch is toggled down, ie 1. Every other SR switch + is up, ie 0. + + The leftmost 6 bits (labelled B) are the 3 DF switches followed by + the 3 IF switches. Again left to right. The rest of the bits are + unused in the B section. + + The leftmost 8 bits (labelled C) are the remaining 8 switches + starting at "START" and ending at "SING INST". Again Left to right. + + +## License + +This document is licensed under the same terms as the associated +[`src/test.c` program][program]. + + +[project]: http://obsolescence.wix.com/obsolescence#!pidp-8 +[dt2]: https://github.com/VentureKing/Deeper-Thought-2 +[program]: https://tangentsoft.com/pidp8i/doc/trunk/src/test.c ADDED README-throttle.md Index: README-throttle.md ================================================================== --- /dev/null +++ README-throttle.md @@ -0,0 +1,151 @@ +# Throttling the Simulator + +When you do not give the `--throttle` option to the `configure` script, +the simulator's speed is set based on the number of CPU cores detected +by the `tools/corecount` script. + + +## Multi-Core Default + +If `corecount` detects a multi-core system, the default behavior is to +not throttle the simulator at all, since there are only 2 threads in the +software that take substantial amounts of CPU power. + +The most hungry thread is the PDP-8 simulator proper, which runs flat-out, +taking an entire core's available power by default. + +The other hungry thread is the one that drives the front panel LEDs, +which takes about 15% of a single core's power on a Raspberry Pi 3 when +you build the software with the incandescent lamp simulator enabled. + +This leaves over 2 cores worth of CPU power untapped on multi-core +Raspberry Pis, so the system performance remains snappy even with the +simulator running. + +You can force this behavior with `--throttle=none`. + + +## Single-Core Default + +If the `configure` script decides that you're building this on a +single-core system, it purposely throttles the PDP-8 simulator so that +it takes about 75% of a single core's worth of power on the slowest +Raspberry Pi supported by this software. This leaves enough CPU power +for some background tasks on a single-core Pi. + +This default assumes you are building without the incandescent lamp +simulator feature enabled, as that currently takes so much CPU power to +run that the simulator runs slower than even a PDP-8/S! (We're working +on ways to improve the speed of that lamp simulator to let it run on +single-core raspberry Pis.) Indeed, the build system will actively try +to prevent you from building the incandescent lamp simulator feature on +a single-core Pi. + +You can force the build system to select this throttle value even on a +multi-core Pi with `--throttle=single-core`. + +You will erroneously get this single-core behavior if you run the +`configure` script on a system where `tools/corecount` has no built-in +way to count the CPU cores in your system correctly, so it returns 1, +forcing a single-core build. That script currently only returns the +correct value on Linux, BSD, and macOS systems. To fix it, you can +either say `--throttle=none` or you can patch `tools/corecount` to +properly report the number of cores on your system. If you choose the +latter path, please send the patch to the mailing list so it can be +integrated into the next release of the software. + + +## Underclocking + +If you want the software to run even slower, there are additional +`configure --throttle` option values available to achieve that: + +* `--throttle=STRING`: any value not otherwise understood is passed + directly to SIMH in `SET THROTTLE` commands inserted into the + generated `boot/*.script` files. You can use any string here that + SIMH itself supports; RTFM. + +* `--throttle=CPUTYPE`: if you give a value referencing one of the + many PDP-8 family members, it selects a value based on the execution + time of `TAD` in direct access mode on that processor: + + | Value | Alias For | Memory Cycle Time + --------------------------------------------------- + | `pdp8e` | 416k | 1.2 µs + | `pdp8i`, `pdp8a` | 333k | 1.5 µs + | `pdp8l`, `pdp8` | 313k | 1.6 µs + | `ha6120` | 182k | 2.7 µs + | `im6100a` | 200k | 2.5 µs + | `im6100` | 100k | 5 µs + | `im6100c` | 83k | 6 µs + | `pdp8s` | 63k | 8 µs + + I chose `TAD` because it's a typical instruction for the processor, + and its execution speed is based on the memory cycle time for the + processor, an easy specification to find. Other instructions (e.g. + most OPR instructions) execute faster than this, while others (e.g. + IOT) execute far slower. (See the processor's manual for details.) + + SIMH, on the other hand, does not discriminate. When you say + `--throttle=pdp8i`, causing the build system to insert `SET THROTTLE + 333k` commands into the SIMH boot scripts, the SIMH PDP-8 simulator + does its best to execute exactly 333,000 instructions per second, + regardless of the instruction type. Consequently, if you were to + benchmark this simulator configured with one of the options above, + there would doubtless be some difference in execution speed, + depending on the mix of instructions executed. + + (See the I/O Matters section below for a further complication.) + + The values for the Intersil and Harris CMOS microprocessors are for + the fastest clock speed supported for that particular chip. Use the + `STRING` form of this option if you wish to emulate an underclocked + microprocessor. + +* `--throttle=human`: Causes the computer to throttle the human. + + "I'm sorry, Dave, but you are not worthy to run this software." + + "Aaackkthhhpptt..." + + No, wait, that can't be right. + + Let's see here...ah, yes, what it *actually* does is slows the + processor down to 10 instructions per second, about the fastest that + allows the human eye to easily discern LED state changes as + separate. If you increase it very much above this, the eye starts + seeing the LED state changes as a blur. + + This mode is useful for running otherwise-useful software as a + "blinkenlights" demo. + +* `--throttle=trace`: Alias for `--throttle=1`, causing the simulator + to act more or less like it's in single-instruction mode and you're + pressing the `CONT` button once a second to step through a program. + + +## I/O Matters + +The throttle mechanism discussed above only affects the speed of the +PDP-8 CPU simulator. It does not affect the speed of I/O operations. + +The only I/O channel you can throttle in the same way is a serial +terminal by purposely choosing a slower bit rate for it than the maximum +value. If you set it to 110 bps, it runs at the speed of a Teletype +Model 33 ASR, the most common terminal type used for the PDP-8/I, and +most other early PDP-8 flavors. Later PDP-8s were often paired with (or +integrated into!) glass TTYs such as the VT05, which flew along at 2400 +bps. Then things got really fancy with the VT52, which screamed along at +9600 bps. Wowee! + +I'm not aware of a way to make SIMH slow the other I/O operations, such +as disk access speeds, in order to emulate the speed of the actual +hardware. + + +## License + +Copyright © 2017 by Warren Young. This document is licensed under +the terms of [the SIMH license][sl]. + +[sl]: https://tangentsoft.com/pidp8i/doc/trunk/SIMH-LICENSE.md ADDED README.md Index: README.md ================================================================== --- /dev/null +++ README.md @@ -0,0 +1,198 @@ +# Getting Started with the PiDP-8/I Software + +## Prerequisites + +* A Raspberry Pi with the 40-pin GPIO connector. That rules out the + first-generation Raspberry Pi model A and B boards which had a + 26-pin GPIO connector. + +* An SD card containing Raspbian or something sufficiently close. + This software is currently tested with the Jessie Lite distribution. + + Ideally, you will install a fresh OS image onto an unused SD card + rather than use this software to modify an existing OS installation, + but there is currently no known hard incompatibilty that prevents + you from integrating this software into an existing OS. + +* This software distribution, unpacked somewhere convenient within the + Raspberry Pi filesystem. + + Unlike with the [upstream 2015.12.15 release][upst], this present + release of the software should *not* be unpacked into `/opt/pidp8`. + I recommend that you unpack it into `$HOME/src`, `/usr/local/src` or + similar, but it really doesn't matter where you put it, as long as + your user has full write access to that directory. + +* A working C compiler and other standard Linux build tools, such as + `make(1)`. On Debian type systems — including Raspbian — you can + install such tools with `sudo apt install build-essential` + + +## Configuring, Building and Installing + +This software distribution builds and installs in the same way as most +other Linux/Unix software these days. The short-and-sweet is: + + $ ./configure && make && sudo make install + + +### Configure Script Options + +You can change a few things about the way the software is built and +installed by giving options to the `configure` script: + + +#### --prefix + +Perhaps the most widely useful `configure` script option is `--prefix`, +which lets you override the default installation directory, +`/opt/pidp8i`. You could make it install the software under your home +directory on the Pi with this command: + + $ ./configure --prefix=$HOME/pidp8i && sudo make install + +Although this is installing to a directory your user has write access +to, you still need to install via `sudo` because the installation +process does other things that do require `root` access. + + +#### --no-lamp-simulator + +If you build the software on a multi-core host, the PDP-8/I simulator is +normally built with Ian Schofield's incandescent lamp simulator feature, +which drives the LEDs in a way that mimics the incandescent lamps used +in the original PDP-8/I. This feature currently takes too much CPU +power to run on anything but a multi-core Raspberry Pi, currently +limited to the Pi 2 and Pi 3 series. + +If you configure the software on a single-core Pi — models A+, B+, and +Zero — the simulator uses the original low-CPU-usage LED driving method +instead. + +Those on a multi-core host who want this low-CPU-usage LED driving +method can give the `--no-lamp-simulator` option to `configure`. + + +#### --serial-mod + +If you have done the [serial mod][smod] to your PiDP-8/I PCB and the +Raspberry Pi you have connected to it, add `--serial-mod` to the +`configure` command above. + +If you do not give this flag at `configure` time with these hardware +modifications in place, the front panel will not work correctly, and +trying to run the software may even crash the Pi. + +If you give this flag and your PCBs are *not* modified, most of the +hardware will work correctly, but several lights and switches will not +work correctly. + + +#### --throttle + +See [`README-throttle.md`][thro] for the values this option takes. If +you don't give this option, the simulator runs as fast as possible, more +or less. + + +#### --help + +Run `./configure --help` for more information on your options here. + + +### Installing + +The `sudo make install` step in the command above does what most people +want. + +That step will not overwrite the operating system and program media +(e.g. the OS/8 RK05 disk cartridge image) when installing multiple times +to the same location, but you can demand an overwrite with: + + $ sudo make mediainstall + +This can be helpful if you have damaged your OS/program media or simply +want to return to the pristine versions as distributed. + +This will also overwrite the boot scripts in `$prefix/share/boot` with +fresh versions from the source distribution. + + +## Testing + +You can test your PiDP-8/I LED and switch functions with these commands: + + $ sudo systemctl stop pidp8i + $ pidp8i-test + +You may have to log out and back in before the second command will work, +since the installation script modifies your normal user's `PATH` the +first time you install onto a given system. + +It is important to stop the PiDP-8/I simulator before running the test +program, since both programs need exclusive access to the LEDs and +switches on the front panel. After you are done testing, you can start +the PiDP-8/I simulator back up with: + + $ sudo systemctl start pidp8i + +See [`README-test.md`][test] for more details. + + +## Using the Software + +For the most part, this software distribution works like the upstream +[2015.12.15 distribution][usd]. Its [documentation][prj] therefore +describes this software too, for the most part. + +The largest user-visible difference between the two software +distributions is that all of the shell commands affecting the software +were renamed to include `pidp8i` in their name: + +1. To start the simulator: + + $ sudo systemctl start pidp8i + + This will happen automatically on reboot unless you disable the + service, such as in order to run one of the various [forks of Deeper + Thought][dt2]. + +2. To attach the terminal you're working on to the simulator: + + $ pidp8i + +3. To detach from the simulator's terminal interface while leaving the + PiDP-8/I simulator running, type Ctrl-A d. You can + re-attach to it later with a `pidp8i` command. + +4. To shut the simulator down while attached to its terminal interface, + type Ctrl-E to pause the simulator, then at the `simh>` + prompt type `quit`. Type `help` at that prompt to get some idea of + what else you can do with the simulator command language, or read + the [SIMH Users' Guide][sdoc]. + +5. To shut the simulator down from the Raspbian command line: + + $ sudo systemctl stop pidp8i + +There are [other major differences][mdif] between the upstream +distribution and this one. See that linked wiki article for details. + + +## License + +Copyright © 2016-2017 by Warren Young. This document is licensed under +the terms of [the SIMH license][sl]. + + +[prj]: https://tangentsoft.com/pidp8i/ +[upst]: http://obsolescence.wixsite.com/obsolescence/pidp-8 +[smod]: http://obsolescence.wixsite.com/obsolescence/2016-pidp-8-building-instructions +[usd]: http://obsolescence.wixsite.com/obsolescence/pidp-8-details +[dt2]: https://github.com/VentureKing/Deeper-Thought-2 +[sdoc]: http://simh.trailing-edge.com/pdf/simh_doc.pdf +[prj]: http://obsolescence.wixsite.com/obsolescence/pidp-8 +[test]: https://tangentsoft.com/pidp8i/doc/trunk/README-test.md +[thro]: https://tangentsoft.com/pidp8i/doc/trunk/README-throttle.md +[mdif]: https://tangentsoft.com/pidp8i/wiki?name=Major+Differences +[sl]: https://tangentsoft.com/pidp8i/doc/trunk/SIMH-LICENSE.md ADDED RELEASE-PROCESS.md Index: RELEASE-PROCESS.md ================================================================== --- /dev/null +++ RELEASE-PROCESS.md @@ -0,0 +1,117 @@ +# PiDP-8/I Software Release Process + +If you are just a user of this software, you need read no further. This +document is for those producing release versions of the software, or for +those curious about what goes into doing so. + + +## Update ChangeLog.md + +Trawl the Fossil timeline for user-visible changes since the last +release, and write them up in user-focused form into the `ChangeLog.md` +file. If a regular user of the software cannot see a given change, it +shouldn't go in the `ChangeLog.md`; let it be documented via the +timeline only. + + +## Update the Release Branch + +Run `make release` to check the `ChangeLog.md` file changes in, tagging +that checkin with a release version tag of the form vYYYYMMDD and merge +those changes into the `release` branch. + +It runs entirely automatically unless an error occurs, in which case it +stops immediately, so check its output for errors before continuing. + + +## Update the Home Page Links + +The zip and tarball links on the front page produce files named after +the date of the release. Those dates need to be updated immediately +after tagging the release, since they point at the "release" tag applied +by the previous step, so they begin shipping the new release immediately +after tagging it. + + +## Produce the Normal Binary OS Image + +Start with the latest [Raspbian Lite OS image][os]. + +1. If the version of the base OS has changed since the last binary OS + image was created, download the new one and blast it onto an SD card + used for no other purpose. Boot it up. + +2. After logging in, retreive and initialize the BOSI process: + + $ wget https://tangentsoft.com/bosi + $ chmod +x bosi + $ ./bosi init + + It will either reboot the system after completing its tasks + successfully or exit early, giving the reason it failed. + +3. Test that the software starts up as it should. + +4. Reset the OS configuration: + + $ exec sudo ./bosi reset + + The `exec` bit is required so that the `bosi` invocation is run as + root without any processes running as `pi` in case the `init` step + sees that user `pi` hasn't been changed to `pidp8i` here: the + `usermod` command we give to make that change will refuse to do what + we ask if there are any running processes owned by user `pi`. + +5. Move the SD card to a USB reader plugged into the Pi, boot the Pi + from its prior SD card, and shrink the OS image: + + $ wget https://tangentsoft.com/bosi + $ chmod +x bosi + $ ./bosi shrink + +6. Move the USB reader to the Mac,¹ then say: + + $ bosi image[-nls] BLOCKS + + `BLOCKS` is the value output at the end of the `shrink` step. + +7. The prior step rewrote the SD card with the image file it created. + Boot it up and make sure it still works. If you're happy with it: + + $ bosi finish[-nls] + +8. While the OS image uploads, compose the announcement message, and + modify the front page to point to the new images. Post the + announcement message and new front page once the uploads complete. + +[os]: https://www.raspberrypi.org/downloads/raspbian/ + + +## Produce the "No Lamp Simulator" Binary OS Image + +Log into the SD card from which you made the regular image above, then +say `./bosi init --no-lamp-simulator`, and continue from step 3 above. + +When you get down to the `image` and `test` steps, give `image-nls` and +`test-nls` instead. + + +---------------------- + +### Footnotes + +1. The image production steps could just as well be done on a Linux box + or on a Windows box via Cygwin or WSL, but the commands in that + final stage change due to OS differences. Since this document + exists primarily for use by the one who uses it, there is little + point in having alternatives for other desktop OSes above. Should + someone else take over maintainership, they can translate the above + commands for their own desktop PC. + + +### License + +Copyright © 2016-2017 by Warren Young. This document is licensed under +the terms of [the SIMH license][sl]. + +[sl]: https://tangentsoft.com/pidp8i/doc/trunk/SIMH-LICENSE.md ADDED SIMH-LICENSE.md Index: SIMH-LICENSE.md ================================================================== --- /dev/null +++ SIMH-LICENSE.md @@ -0,0 +1,25 @@ +Copyright © 2015-2017 by various authors + +Permission is hereby granted, free of charge, to any person obtaining a +copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS +OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, +DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR +OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR +THE USE OR OTHER DEALINGS IN THE SOFTWARE. + +Except as contained in this notice, the names of the authors above shall +not be used in advertising or otherwise to promote the sale, use or +other dealings in this Software without prior written authorization from +those authors. ADDED auto.def Index: auto.def ================================================================== --- /dev/null +++ auto.def @@ -0,0 +1,214 @@ +######################################################################## +# auto.def - Configure file for the PiDP-8/I software build system, +# based on autosetup. +# +# Copyright © 2016-2017 Warren Young +# +# Permission is hereby granted, free of charge, to any person obtaining +# a copy of this software and associated documentation files (the +# "Software"), to deal in the Software without restriction, including +# without limitation the rights to use, copy, modify, merge, publish, +# distribute, sublicense, and/or sell copies of the Software, and to +# permit persons to whom the Software is furnished to do so, subject to +# the following conditions: +# +# The above copyright notice and this permission notice shall be +# included in all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +# IN NO EVENT SHALL THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, +# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT +# OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE +# OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +# +# Except as contained in this notice, the names of the authors above +# shall not be used in advertising or otherwise to promote the sale, +# use or other dealings in this Software without prior written +# authorization from those authors. +######################################################################## + +define defaultprefix /opt/pidp8i + +use cc +use cc-lib + +options { + debug-mode => "create a debug build (default is release)" + no-lamp-simulator => "use simple LED driver instead of incandescent lamp simulator" + serial-mod => "build simulator to expect the PCB serial mods" + throttle: => "override the throttle values in the boot scripts" +} + +if {[opt-bool serial-mod]} { + msg-result "The simulator will expect the serial mods to the Pi and PiDP-8/I PCBs." + define PCB_SERIAL_MOD +} + +if {[opt-bool debug-mode]} { + msg-result "Creating a debuggable build." + define BUILDMODE {-O0 -g} +} else { + msg-result "Creating a release build." + define BUILDMODE {-O2} +} + +# Swap the incandescent lamp simulator feature out for the original LED +# driving method on single-core hosts. The user can force this on +# multi-core hosts via --no-lamp-simulator. +set cores [exec tools/corecount] +if {($cores < 2) || [opt-bool no-lamp-simulator]} { + msg-result "Driving PiDP-8/I front panel LEDs using low-CPU-usage method." + define LED_DRIVER_MODULE n + define ILS_MODE 0 +} else { + msg-result "Driving PiDP-8/I front panel LEDs using incandescent lamp simulator." + define LED_DRIVER_MODULE i + define ILS_MODE 1 +} + +# Translate --throttle value to a SIMH command +set tv [opt-val throttle] +set tvsl [string length $tv] +if {($tvsl == 0 && $cores > 1) || $tv == "none"} { + define SET_THROTTLE {set nothrottle} + set tv "unlimited" +} else { + # Rewrite symbolic values with values SIMH can understand. See + # README-throttle.md for the justification of these values. + if {$tv == "single-core" || $tvsl == 0} { + # value for ~75% CPU usage on a Pi Model B+ with the simple + # LED driving code; conveniently, 4x the speed of a real PDP-8/I + set tv "1332k" + } elseif {$tv == "pdp8e"} { + set tv "416k" + } elseif {$tv == "pdp8i" || $tv == "pdp8a"} { + set tv "333k" + } elseif {$tv == "pdp8l" || $tv == "pdp8"} { + set tv "313k" + } elseif {$tv == "ha6120"} { + set tv "182k" + } elseif {$tv == "im6100a"} { + set tv "200k" + } elseif {$tv == "im6100"} { + set tv "100k" + } elseif {$tv == "im6100c"} { + set tv "83k" + } elseif {$tv == "pdp8s"} { + set tv "63k" + } elseif {$tv == "human"} { + set tv "10/1000" + } elseif {$tv == "trace"} { + set tv "1/1000" + } + # else, assume --throttle was given a legal SIMH throttle value + + define SET_THROTTLE "set throttle $tv" +} +msg-result "Simulator CPU throttle set to $tv IPS" + +# Compiler and header checks +cc-check-includes time.h +cc-check-functions clock_nanosleep nanosleep usleep +cc-check-functions sched_yield + +# We need to find an install(1) type program that supports -D. The +# Raspberry Pi OSes typically used with the PiDB-8/I board do have this, +# but this package also runs on non-Linux OSes (e.g. for testing on a +# desktop Mac) so make sure we've got a suitable implementation. The +# ginstall name is typical on non-Linux systems where GNU Coreutils was +# installed alongside the core OS utilities. +if {[cc-check-progs ginstall]} { + define INSTALL ginstall +} elseif {[cc-check-progs install]} { + if {[catch {exec install -D -d . >& /dev/null} result] == 0} { + define INSTALL install + } else { + user-error "install(1) does not support -D; install GNU Coreutils." + } +} else { + user-error "No install(1) type program found; install GNU Coreutils." +} +msg-result "Found GNU install(1) program as [get-define INSTALL]." + +# Also find GNU readlink in the same way +if {[cc-check-progs greadlink]} { + set rlprg greadlink +} elseif {[cc-check-progs readlink]} { + if {[catch {exec readlink -f . >& /dev/null} result] == 0} { + set rlprg readlink + } else { + user-error "readlink(1) does not support -D; install GNU Coreutils." + } +} else { + user-error "No readlink(1) type program found; install GNU Coreutils." +} +msg-result "Found GNU readlink(1) as $rlprg." + +# Canonicalize some paths which may be relative and generate others from them +define ABSPREFIX [exec $rlprg -f [get-define prefix]] +define BOOTDIR "[get-define ABSPREFIX]/share/boot" +define MEDIADIR "[get-define ABSPREFIX]/share/media" + +# Remember the name and primary group of the user who installed this, since +# we want to give that group write privileges to some files when they're +# installed, and we want them to own the screen(1) session. +set instgrp [exec id -grn] +set instusr [exec id -urn] +if {$instusr == "root"} { + msg-result "Error: This software will not install and run as root." + user-error "Reconfigure without sudo!" +} +define INSTGRP $instgrp +define INSTUSR $instusr +msg-result "Install group for user-writeable files will be $instgrp." +msg-result "Owner of screen(1) session will be $instusr." + +# Can we use any nonstandard flags here? We don't bother including +# flags that both GCC and Clang support. The ones inside the "if" +# block are those that Clang will accept in an autosetup test but +# then will yell about if you try to use them. The test checks for +# an -f sub-option that Clang doesn't currently support even enough +# to fool autosetup. +cc-check-standards c99 +if {![opt-bool debug-mode]} { + cc-check-flags -fipa-cp-clone + cc-check-flags -fno-strict-overflow + cc-check-flags -fpredictive-commoning + if ([get-define HAVE_CFLAG_FIPA_CP_CLONE]) { + cc-check-flags -fgcse-after-reload + cc-check-flags -finline-functions + cc-check-flags -fno-unsafe-loop-optimizations + define-append CFLAGS "-D_GNU_SOURCE" + } +} + +# Embed this software's Fossil-based version string into gpio-common.c +define VERSION [exec "[get-define srcdir]/tools/version"] + +# Write outputs. +# +# NOTE: If you change the list of files here, change INFILES in +# Makefile.in, too. +make-config-header src/config.h \ + -auto {ENABLE_* HAVE_* PACKAGE_* SIZEOF_*} \ + -bare {ILS_MODE PCB_SERIAL_MOD} +make-template Makefile.in +make-template bin/pidp8i.in +make-template boot/0.script.in +make-template boot/2.script.in +make-template boot/3.script.in +make-template boot/4.script.in +make-template boot/6.script.in +make-template boot/7.script.in +make-template etc/pidp8i-init.in +make-template etc/sudoers.in +make-template examples/Makefile.in +make-template src/Makefile.in +make-template src/gpio-common.c.in +make-template src/PDP8/Makefile.in +make-template src/PDP8/pidp8i.c.in +make-template src/scp.c.in +make-template tools/simh-update.in +exec chmod +x "[get-define builddir]/tools/simh-update" ADDED autosetup/LICENSE Index: autosetup/LICENSE ================================================================== --- /dev/null +++ autosetup/LICENSE @@ -0,0 +1,35 @@ +Unless explicitly stated, all files which form part of autosetup +are released under the following license: + +--------------------------------------------------------------------- +autosetup - A build environment "autoconfigurator" + +Copyright (c) 2010-2011, WorkWare Systems + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: + +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials + provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE WORKWARE SYSTEMS ``AS IS'' AND ANY +EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, +THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL WORKWARE +SYSTEMS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, +INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, +STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) +ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF +ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +The views and conclusions contained in the software and documentation +are those of the authors and should not be interpreted as representing +official policies, either expressed or implied, of WorkWare Systems. ADDED autosetup/README.autosetup Index: autosetup/README.autosetup ================================================================== --- /dev/null +++ autosetup/README.autosetup @@ -0,0 +1,1 @@ +This is autosetup v0.6.6. See http://msteveb.github.com/autosetup/ ADDED autosetup/autosetup Index: autosetup/autosetup ================================================================== --- /dev/null +++ autosetup/autosetup @@ -0,0 +1,1985 @@ +#!/bin/sh +# Copyright (c) 2006-2011 WorkWare Systems http://www.workware.net.au/ +# All rights reserved +# vim:se syntax=tcl: +# \ +dir=`dirname "$0"`; exec "`$dir/find-tclsh`" "$0" "$@" + +set autosetup(version) 0.6.6 + +# Can be set to 1 to debug early-init problems +set autosetup(debug) 0 + +################################################################## +# +# Main flow of control, option handling +# +proc main {argv} { + global autosetup define + + # There are 3 potential directories involved: + # 1. The directory containing autosetup (this script) + # 2. The directory containing auto.def + # 3. The current directory + + # From this we need to determine: + # a. The path to this script (and related support files) + # b. The path to auto.def + # c. The build directory, where output files are created + + # This is also complicated by the fact that autosetup may + # have been run via the configure wrapper ([getenv WRAPPER] is set) + + # Here are the rules. + # a. This script is $::argv0 + # => dir, prog, exe, libdir + # b. auto.def is in the directory containing the configure wrapper, + # otherwise it is in the current directory. + # => srcdir, autodef + # c. The build directory is the current directory + # => builddir, [pwd] + + # 'misc' is needed before we can do anything, so set a temporary libdir + # in case this is the development version + set autosetup(libdir) [file dirname $::argv0]/lib + use misc + + # (a) + set autosetup(dir) [realdir [file dirname [realpath $::argv0]]] + set autosetup(prog) [file join $autosetup(dir) [file tail $::argv0]] + set autosetup(exe) [getenv WRAPPER $autosetup(prog)] + if {$autosetup(installed)} { + set autosetup(libdir) $autosetup(dir) + } else { + set autosetup(libdir) [file join $autosetup(dir) lib] + } + autosetup_add_dep $autosetup(prog) + + # (b) + if {[getenv WRAPPER ""] eq ""} { + # Invoked directly + set autosetup(srcdir) [pwd] + } else { + # Invoked via the configure wrapper + set autosetup(srcdir) [file-normalize [file dirname $autosetup(exe)]] + } + set autosetup(autodef) [relative-path $autosetup(srcdir)/auto.def] + + # (c) + set autosetup(builddir) [pwd] + + set autosetup(argv) $argv + set autosetup(cmdline) {} + # options is a list of known options + set autosetup(options) {} + # optset is a dictionary of option values set by the user based on getopt + set autosetup(optset) {} + # optdefault is a dictionary of default values for options + set autosetup(optdefault) {} + set autosetup(optionhelp) {} + set autosetup(showhelp) 0 + + # Parse options + use getopt + + # At the is point we don't know what is a valid option + # We simply parse anything that looks like an option + set autosetup(getopt) [getopt argv] + + #"=Core Options:" + options-add { + help:=local => "display help and options. Optionally specify a module name, such as --help=system" + version => "display the version of autosetup" + ref:=text manual:=text + reference:=text => "display the autosetup command reference. 'text', 'wiki', 'asciidoc' or 'markdown'" + debug => "display debugging output as autosetup runs" + install:=. => "install autosetup to the current or given directory (in the 'autosetup/' subdirectory)" + force init:=help => "create initial auto.def, etc. Use --init=help for known types" + # Undocumented options + option-checking=1 + nopager + quiet + timing + conf: + } + + if {[opt-bool version]} { + puts $autosetup(version) + exit 0 + } + + # autosetup --conf=alternate-auto.def + if {[opt-val conf] ne ""} { + set autosetup(autodef) [opt-val conf] + } + + # Debugging output (set this early) + incr autosetup(debug) [opt-bool debug] + incr autosetup(force) [opt-bool force] + incr autosetup(msg-quiet) [opt-bool quiet] + incr autosetup(msg-timing) [opt-bool timing] + + # If the local module exists, source it now to allow for + # project-local customisations + if {[file exists $autosetup(libdir)/local.tcl]} { + use local + } + + # Now any auto-load modules + foreach file [glob -nocomplain $autosetup(libdir)/*.auto $autosetup(libdir)/*/*.auto] { + automf_load source $file + } + + if {[opt-val help] ne ""} { + incr autosetup(showhelp) + use help + autosetup_help [opt-val help] + } + + if {[opt-val {manual ref reference}] ne ""} { + use help + autosetup_reference [opt-val {manual ref reference}] + } + + # Allow combining --install and --init + set earlyexit 0 + if {[opt-val install] ne ""} { + use install + autosetup_install [opt-val install] + incr earlyexit + } + + if {[opt-val init] ne ""} { + use init + autosetup_init [opt-val init] + incr earlyexit + } + + if {$earlyexit} { + exit 0 + } + + if {![file exists $autosetup(autodef)]} { + # Check for invalid option first + options {} + user-error "No auto.def found in \"$autosetup(srcdir)\" (use [file tail $::autosetup(exe)] --init to create one)" + } + + # Parse extra arguments into autosetup(cmdline) + foreach arg $argv { + if {[regexp {([^=]*)=(.*)} $arg -> n v]} { + dict set autosetup(cmdline) $n $v + define $n $v + } else { + user-error "Unexpected parameter: $arg" + } + } + + autosetup_add_dep $autosetup(autodef) + + define CONFIGURE_OPTS "" + foreach arg $autosetup(argv) { + define-append CONFIGURE_OPTS [quote-if-needed $arg] + } + define AUTOREMAKE [file-normalize $autosetup(exe)] + define-append AUTOREMAKE [get-define CONFIGURE_OPTS] + + + # Log how we were invoked + configlog "Invoked as: [getenv WRAPPER $::argv0] [quote-argv $autosetup(argv)]" + + # Note that auto.def is *not* loaded in the global scope + source $autosetup(autodef) + + # Could warn here if options {} was not specified + + show-notices + + if {$autosetup(debug)} { + msg-result "Writing all defines to config.log" + configlog "================ defines ======================" + foreach n [lsort [array names define]] { + configlog "define $n $define($n)" + } + } + + exit 0 +} + +# @opt-bool ?-nodefault? option ... +# +# Check each of the named, boolean options and if any have been explicitly enabled +# or disabled by the user, return 1 or 0 accordingly. +# +# If the option was specified more than once, the last value wins. +# e.g. With --enable-foo --disable-foo, [opt-bool foo] will return 0 +# +# If no value was specified by the user, returns the default value for the +# first option. If -nodefault is given, this behaviour changes and +# -1 is returned instead. +# +proc opt-bool {args} { + set nodefault 0 + if {[lindex $args 0] eq "-nodefault"} { + set nodefault 1 + set args [lrange $args 1 end] + } + option-check-names {*}$args + + foreach opt $args { + if {[dict exists $::autosetup(optset) $opt]} { + return [dict get $::autosetup(optset) $opt] + } + } + + if {$nodefault} { + return -1 + } + # Default value is the default for the first option + return [dict get $::autosetup(optdefault) [lindex $args 0]] +} + +# @opt-val option-list ?default=""? +# +# Returns a list containing all the values given for the non-boolean options in 'option-list'. +# There will be one entry in the list for each option given by the user, including if the +# same option was used multiple times. +# If only a single value is required, use something like: +# +## lindex [opt-val $names] end +# +# If no options were set, $default is returned (exactly, not as a list). +# +proc opt-val {names {default ""}} { + option-check-names {*}$names + + foreach opt $names { + if {[dict exists $::autosetup(optset) $opt]} { + lappend result {*}[dict get $::autosetup(optset) $opt] + } + } + if {[info exists result]} { + return $result + } + return $default +} + +proc option-check-names {args} { + foreach o $args { + if {$o ni $::autosetup(options)} { + autosetup-error "Request for undeclared option --$o" + } + } +} + +# Parse the option definition in $opts and update +# ::autosetup(setoptions) and ::autosetup(optionhelp) appropriately +# +proc options-add {opts {header ""}} { + global autosetup + + # First weed out comment lines + set realopts {} + foreach line [split $opts \n] { + if {![string match "#*" [string trimleft $line]]} { + append realopts $line \n + } + } + set opts $realopts + + for {set i 0} {$i < [llength $opts]} {incr i} { + set opt [lindex $opts $i] + if {[string match =* $opt]} { + # This is a special heading + lappend autosetup(optionhelp) $opt "" + set header {} + continue + } + + #puts "i=$i, opt=$opt" + regexp {^([^:=]*)(:)?(=)?(.*)$} $opt -> name colon equal value + if {$name in $autosetup(options)} { + autosetup-error "Option $name already specified" + } + + #puts "$opt => $name $colon $equal $value" + + # Find the corresponding value in the user options + # and set the default if necessary + if {[string match "-*" $opt]} { + # This is a documentation-only option, like "-C " + set opthelp $opt + } elseif {$colon eq ""} { + # Boolean option + lappend autosetup(options) $name + + if {$value eq "1"} { + set opthelp "--disable-$name" + } else { + set opthelp "--$name" + } + + # Set the default + if {$value eq ""} { + set value 0 + } + dict set autosetup(optdefault) $name $value + + if {[dict exists $autosetup(getopt) $name]} { + # The option was specified by the user. Look at the last value. + lassign [lindex [dict get $autosetup(getopt) $name] end] type setvalue + if {$type eq "str"} { + # Can we convert the value to a boolean? + if {$setvalue in {1 enabled yes}} { + set setvalue 1 + } elseif {$setvalue in {0 disabled no}} { + set setvalue 0 + } else { + user-error "Boolean option $name given as --$name=$setvalue" + } + } + dict set autosetup(optset) $name $setvalue + #puts "Found boolean option --$name=$setvalue" + } + } else { + # String option. + lappend autosetup(options) $name + + if {$equal eq "="} { + # String option with optional value + set opthelp "--$name?=$value?" + } else { + # String option with required value + set opthelp "--$name=$value" + } + dict set autosetup(optdefault) $name $value + + # Get the values specified by the user + if {[dict exists $autosetup(getopt) $name]} { + set listvalue {} + + foreach pair [dict get $autosetup(getopt) $name] { + lassign $pair type setvalue + if {$type eq "bool" && $setvalue} { + if {$equal ne "="} { + user-error "Option --$name requires a value" + } + # If given as a boolean, use the default value + set setvalue $value + } + lappend listvalue $setvalue + } + + #puts "Found string option --$name=$listvalue" + dict set autosetup(optset) $name $listvalue + } + } + + # Now create the help for this option if appropriate + if {[lindex $opts $i+1] eq "=>"} { + set desc [lindex $opts $i+2] + #string match \n* $desc + if {$header ne ""} { + lappend autosetup(optionhelp) $header "" + set header "" + } + # A multi-line description + lappend autosetup(optionhelp) $opthelp $desc + incr i 2 + } + } +} + +# @module-options optionlist +# +# Like 'options', but used within a module. +proc module-options {opts} { + set header "" + if {$::autosetup(showhelp) > 1 && [llength $opts]} { + set header "Module Options:" + } + options-add $opts $header + + if {$::autosetup(showhelp)} { + # Ensure that the module isn't executed on --help + # We are running under eval or source, so use break + # to prevent further execution + #return -code break -level 2 + return -code break + } +} + +proc max {a b} { + expr {$a > $b ? $a : $b} +} + +proc options-wrap-desc {text length firstprefix nextprefix initial} { + set len $initial + set space $firstprefix + foreach word [split $text] { + set word [string trim $word] + if {$word == ""} { + continue + } + if {$len && [string length $space$word] + $len >= $length} { + puts "" + set len 0 + set space $nextprefix + } + incr len [string length $space$word] + puts -nonewline $space$word + set space " " + } + if {$len} { + puts "" + } +} + +proc options-show {} { + # Determine the max option width + set max 0 + foreach {opt desc} $::autosetup(optionhelp) { + if {[string match =* $opt] || [string match \n* $desc]} { + continue + } + set max [max $max [string length $opt]] + } + set indent [string repeat " " [expr $max+4]] + set cols [getenv COLUMNS 80] + catch { + lassign [exec stty size] rows cols + } + incr cols -1 + # Now output + foreach {opt desc} $::autosetup(optionhelp) { + if {[string match =* $opt]} { + puts [string range $opt 1 end] + continue + } + puts -nonewline " [format %-${max}s $opt]" + if {[string match \n* $desc]} { + puts $desc + } else { + options-wrap-desc [string trim $desc] $cols " " $indent [expr $max + 2] + } + } +} + +# @options options-spec +# +# Specifies configuration-time options which may be selected by the user +# and checked with opt-val and opt-bool. The format of options-spec follows. +# +# A boolean option is of the form: +# +## name[=0|1] => "Description of this boolean option" +# +# The default is name=0, meaning that the option is disabled by default. +# If name=1 is used to make the option enabled by default, the description should reflect +# that with text like "Disable support for ...". +# +# An argument option (one which takes a parameter) is of the form: +# +## name:[=]value => "Description of this option" +# +# If the name:value form is used, the value must be provided with the option (as --name=myvalue). +# If the name:=value form is used, the value is optional and the given value is used as the default +# if it is not provided. +# +# Undocumented options are also supported by omitting the "=> description. +# These options are not displayed with --help and can be useful for internal options or as aliases. +# +# For example, --disable-lfs is an alias for --disable=largefile: +# +## lfs=1 largefile=1 => "Disable large file support" +# +proc options {optlist} { + # Allow options as a list or args + options-add $optlist "Local Options:" + + if {$::autosetup(showhelp)} { + options-show + exit 0 + } + + # Check for invalid options + if {[opt-bool option-checking]} { + foreach o [dict keys $::autosetup(getopt)] { + if {$o ni $::autosetup(options)} { + user-error "Unknown option --$o" + } + } + } +} + +proc config_guess {} { + if {[file-isexec $::autosetup(dir)/config.guess]} { + exec-with-stderr sh $::autosetup(dir)/config.guess + if {[catch {exec-with-stderr sh $::autosetup(dir)/config.guess} alias]} { + user-error $alias + } + return $alias + } else { + configlog "No config.guess, so using uname" + string tolower [exec uname -p]-unknown-[exec uname -s][exec uname -r] + } +} + +proc config_sub {alias} { + if {[file-isexec $::autosetup(dir)/config.sub]} { + if {[catch {exec-with-stderr sh $::autosetup(dir)/config.sub $alias} alias]} { + user-error $alias + } + } + return $alias +} + +# @define name ?value=1? +# +# Defines the named variable to the given value. +# These (name, value) pairs represent the results of the configuration check +# and are available to be checked, modified and substituted. +# +proc define {name {value 1}} { + set ::define($name) $value + #dputs "$name <= $value" +} + +# @undefine name +# +# Undefine the named variable +# +proc undefine {name} { + unset -nocomplain ::define($name) + #dputs "$name <= " +} + +# @define-append name value ... +# +# Appends the given value(s) to the given 'defined' variable. +# If the variable is not defined or empty, it is set to $value. +# Otherwise the value is appended, separated by a space. +# Any extra values are similarly appended. +# If any value is already contained in the variable (as a substring) it is omitted. +# +proc define-append {name args} { + if {[get-define $name ""] ne ""} { + # Make a token attempt to avoid duplicates + foreach arg $args { + if {[string first $arg $::define($name)] == -1} { + append ::define($name) " " $arg + } + } + } else { + set ::define($name) [join $args] + } + #dputs "$name += [join $args] => $::define($name)" +} + +# @get-define name ?default=0? +# +# Returns the current value of the 'defined' variable, or $default +# if not set. +# +proc get-define {name {default 0}} { + if {[info exists ::define($name)]} { + #dputs "$name => $::define($name)" + return $::define($name) + } + #dputs "$name => $default" + return $default +} + +# @is-defined name +# +# Returns 1 if the given variable is defined. +# +proc is-defined {name} { + info exists ::define($name) +} + +# @all-defines +# +# Returns a dictionary (name value list) of all defined variables. +# +# This is suitable for use with 'dict', 'array set' or 'foreach' +# and allows for arbitrary processing of the defined variables. +# +proc all-defines {} { + array get ::define +} + + +# @get-env name default +# +# If $name was specified on the command line, return it. +# If $name was set in the environment, return it. +# Otherwise return $default. +# +proc get-env {name default} { + if {[dict exists $::autosetup(cmdline) $name]} { + return [dict get $::autosetup(cmdline) $name] + } + getenv $name $default +} + +# @env-is-set name +# +# Returns 1 if the $name was specified on the command line or in the environment. +# Note that an empty environment variable is not considered to be set. +# +proc env-is-set {name} { + if {[dict exists $::autosetup(cmdline) $name]} { + return 1 + } + if {[getenv $name ""] ne ""} { + return 1 + } + return 0 +} + +# @readfile filename ?default=""? +# +# Return the contents of the file, without the trailing newline. +# If the file doesn't exist or can't be read, returns $default. +# +proc readfile {filename {default_value ""}} { + set result $default_value + catch { + set f [open $filename] + set result [read -nonewline $f] + close $f + } + return $result +} + +# @writefile filename value +# +# Creates the given file containing $value. +# Does not add an extra newline. +# +proc writefile {filename value} { + set f [open $filename w] + puts -nonewline $f $value + close $f +} + +proc quote-if-needed {str} { + if {[string match {*[\" ]*} $str]} { + return \"[string map [list \" \\" \\ \\\\] $str]\" + } + return $str +} + +proc quote-argv {argv} { + set args {} + foreach arg $argv { + lappend args [quote-if-needed $arg] + } + join $args +} + +# @suffix suf list +# +# Takes a list and returns a new list with $suf appended +# to each element +# +## suffix .c {a b c} => {a.c b.c c.c} +# +proc suffix {suf list} { + set result {} + foreach p $list { + lappend result $p$suf + } + return $result +} + +# @prefix pre list +# +# Takes a list and returns a new list with $pre prepended +# to each element +# +## prefix jim- {a.c b.c} => {jim-a.c jim-b.c} +# +proc prefix {pre list} { + set result {} + foreach p $list { + lappend result $pre$p + } + return $result +} + +# @find-executable name +# +# Searches the path for an executable with the given name. +# Note that the name may include some parameters, e.g. "cc -mbig-endian", +# in which case the parameters are ignored. +# Returns 1 if found, or 0 if not. +# +proc find-executable {name} { + # Ignore any parameters + set name [lindex $name 0] + if {$name eq ""} { + # The empty string is never a valid executable + return 0 + } + foreach p [split-path] { + dputs "Looking for $name in $p" + set exec [file join $p $name] + if {[file-isexec $exec]} { + dputs "Found $name -> $exec" + return 1 + } + } + return 0 +} + +# @find-an-executable ?-required? name ... +# +# Given a list of possible executable names, +# searches for one of these on the path. +# +# Returns the name found, or "" if none found. +# If the first parameter is '-required', an error is generated +# if no executable is found. +# +proc find-an-executable {args} { + set required 0 + if {[lindex $args 0] eq "-required"} { + set args [lrange $args 1 end] + incr required + } + foreach name $args { + if {[find-executable $name]} { + return $name + } + } + if {$required} { + if {[llength $args] == 1} { + user-error "failed to find: [join $args]" + } else { + user-error "failed to find one of: [join $args]" + } + } + return "" +} + +# @configlog msg +# +# Writes the given message to the configuration log, config.log +# +proc configlog {msg} { + if {![info exists ::autosetup(logfh)]} { + set ::autosetup(logfh) [open config.log w] + } + puts $::autosetup(logfh) $msg +} + +# @msg-checking msg +# +# Writes the message with no newline to stdout. +# +proc msg-checking {msg} { + if {$::autosetup(msg-quiet) == 0} { + maybe-show-timestamp + puts -nonewline $msg + set ::autosetup(msg-checking) 1 + } +} + +# @msg-result msg +# +# Writes the message to stdout. +# +proc msg-result {msg} { + if {$::autosetup(msg-quiet) == 0} { + maybe-show-timestamp + puts $msg + set ::autosetup(msg-checking) 0 + show-notices + } +} + +# @msg-quiet command ... +# +# msg-quiet evaluates it's arguments as a command with output +# from msg-checking and msg-result suppressed. +# +# This is useful if a check needs to run a subcheck which isn't +# of interest to the user. +proc msg-quiet {args} { + incr ::autosetup(msg-quiet) + set rc [uplevel 1 $args] + incr ::autosetup(msg-quiet) -1 + return $rc +} + +# Will be overridden by 'use misc' +proc error-stacktrace {msg} { + return $msg +} + +proc error-location {msg} { + return $msg +} + +################################################################## +# +# Debugging output +# +proc dputs {msg} { + if {$::autosetup(debug)} { + puts $msg + } +} + +################################################################## +# +# User and system warnings and errors +# +# Usage errors such as wrong command line options + +# @user-error msg +# +# Indicate incorrect usage to the user, including if required components +# or features are not found. +# autosetup exits with a non-zero return code. +# +proc user-error {msg} { + show-notices + puts stderr "Error: $msg" + puts stderr "Try: '[file tail $::autosetup(exe)] --help' for options" + exit 1 +} + +# @user-notice msg +# +# Output the given message to stderr. +# +proc user-notice {msg} { + lappend ::autosetup(notices) $msg +} + +# Incorrect usage in the auto.def file. Identify the location. +proc autosetup-error {msg} { + autosetup-full-error [error-location $msg] +} + +# Like autosetup-error, except $msg is the full error message. +proc autosetup-full-error {msg} { + show-notices + puts stderr $msg + exit 1 +} + +proc show-notices {} { + if {$::autosetup(msg-checking)} { + puts "" + set ::autosetup(msg-checking) 0 + } + flush stdout + if {[info exists ::autosetup(notices)]} { + puts stderr [join $::autosetup(notices) \n] + unset ::autosetup(notices) + } +} + +proc maybe-show-timestamp {} { + if {$::autosetup(msg-timing) && $::autosetup(msg-checking) == 0} { + puts -nonewline [format {[%6.2f] } [expr {([clock millis] - $::autosetup(start)) % 10000 / 1000.0}]] + } +} + +proc autosetup_version {} { + return "autosetup v$::autosetup(version)" +} + +################################################################## +# +# Directory/path handling +# + +proc realdir {dir} { + set oldpwd [pwd] + cd $dir + set pwd [pwd] + cd $oldpwd + return $pwd +} + +# Follow symlinks until we get to something which is not a symlink +proc realpath {path} { + while {1} { + if {[catch { + set path [file readlink $path] + }]} { + # Not a link + break + } + } + return $path +} + +# Convert absolute path, $path into a path relative +# to the given directory (or the current dir, if not given). +# +proc relative-path {path {pwd {}}} { + set diff 0 + set same 0 + set newf {} + set prefix {} + set path [file-normalize $path] + if {$pwd eq ""} { + set pwd [pwd] + } else { + set pwd [file-normalize $pwd] + } + + if {$path eq $pwd} { + return . + } + + # Try to make the filename relative to the current dir + foreach p [split $pwd /] f [split $path /] { + if {$p ne $f} { + incr diff + } elseif {!$diff} { + incr same + } + if {$diff} { + if {$p ne ""} { + # Add .. for sibling or parent dir + lappend prefix .. + } + if {$f ne ""} { + lappend newf $f + } + } + } + if {$same == 1 || [llength $prefix] > 3} { + return $path + } + + file join [join $prefix /] [join $newf /] +} + +# Add filename as a dependency to rerun autosetup +# The name will be normalised (converted to a full path) +# +proc autosetup_add_dep {filename} { + lappend ::autosetup(deps) [file-normalize $filename] +} + +################################################################## +# +# Library module support +# + +# @use module ... +# +# Load the given library modules. +# e.g. 'use cc cc-shared' +# +# Note that module 'X' is implemented in either 'autosetup/X.tcl' +# or 'autosetup/X/init.tcl' +# +# The latter form is useful for a complex module which requires additional +# support file. In this form, '$::usedir' is set to the module directory +# when it is loaded. +# +proc use {args} { + foreach m $args { + if {[info exists ::libmodule($m)]} { + continue + } + set ::libmodule($m) 1 + if {[info exists ::modsource($m)]} { + automf_load eval $::modsource($m) + } else { + set sources [list $::autosetup(libdir)/${m}.tcl $::autosetup(libdir)/${m}/init.tcl] + set found 0 + foreach source $sources { + if {[file exists $source]} { + incr found + break + } + } + if {$found} { + # For the convenience of the "use" source, point to the directory + # it is being loaded from + set ::usedir [file dirname $source] + automf_load source $source + autosetup_add_dep $source + } else { + autosetup-error "use: No such module: $m" + } + } + } +} + +# Load module source in the global scope by executing the given command +proc automf_load {args} { + if {[catch [list uplevel #0 $args] msg opts] ni {0 2 3}} { + autosetup-full-error [error-dump $msg $opts $::autosetup(debug)] + } +} + +# Initial settings +set autosetup(exe) $::argv0 +set autosetup(istcl) 1 +set autosetup(start) [clock millis] +set autosetup(installed) 0 +set autosetup(msg-checking) 0 +set autosetup(msg-quiet) 0 + +# Embedded modules are inserted below here +set autosetup(installed) 1 +# ----- module asciidoc-formatting ----- + +set modsource(asciidoc-formatting) { +# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# Module which provides text formatting +# asciidoc format + +use formatting + +proc para {text} { + regsub -all "\[ \t\n\]+" [string trim $text] " " +} +proc title {text} { + underline [para $text] = + nl +} +proc p {text} { + puts [para $text] + nl +} +proc code {text} { + foreach line [parse_code_block $text] { + puts " $line" + } + nl +} +proc codelines {lines} { + foreach line $lines { + puts " $line" + } + nl +} +proc nl {} { + puts "" +} +proc underline {text char} { + regexp "^(\[ \t\]*)(.*)" $text -> indent words + puts $text + puts $indent[string repeat $char [string length $words]] +} +proc section {text} { + underline "[para $text]" - + nl +} +proc subsection {text} { + underline "$text" ~ + nl +} +proc bullet {text} { + puts "* [para $text]" +} +proc indent {text} { + puts " :: " + puts [para $text] +} +proc defn {first args} { + set sep "" + if {$first ne ""} { + puts "${first}::" + } else { + puts " :: " + } + set defn [string trim [join $args \n]] + regsub -all "\n\n" $defn "\n ::\n" defn + puts $defn +} +} + +# ----- module formatting ----- + +set modsource(formatting) { +# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# Module which provides common text formatting + +# This is designed for documenation which looks like: +# code {...} +# or +# code { +# ... +# ... +# } +# In the second case, we need to work out the indenting +# and strip it from all lines but preserve the remaining indenting. +# Note that all lines need to be indented with the same initial +# spaces/tabs. +# +# Returns a list of lines with the indenting removed. +# +proc parse_code_block {text} { + # If the text begins with newline, take the following text, + # otherwise just return the original + if {![regexp "^\n(.*)" $text -> text]} { + return [list [string trim $text]] + } + + # And trip spaces off the end + set text [string trimright $text] + + set min 100 + # Examine each line to determine the minimum indent + foreach line [split $text \n] { + if {$line eq ""} { + # Ignore empty lines for the indent calculation + continue + } + regexp "^(\[ \t\]*)" $line -> indent + set len [string length $indent] + if {$len < $min} { + set min $len + } + } + + # Now make a list of lines with this indent removed + set lines {} + foreach line [split $text \n] { + lappend lines [string range $line $min end] + } + + # Return the result + return $lines +} +} + +# ----- module getopt ----- + +set modsource(getopt) { +# Copyright (c) 2006 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# Simple getopt module + +# Parse everything out of the argv list which looks like an option +# Everything which doesn't look like an option, or is after --, is left unchanged +# Understands --enable-xxx and --with-xxx as synonyms for --xxx to enable the boolean option xxx. +# Understands --disable-xxx and --without-xxx to disable the boolean option xxx. +# +# The returned value is a dictionary keyed by option name +# Each value is a list of {type value} ... where type is "bool" or "str". +# The value for a boolean option is 0 or 1. The value of a string option is the value given. +proc getopt {argvname} { + upvar $argvname argv + set nargv {} + + set opts {} + + for {set i 0} {$i < [llength $argv]} {incr i} { + set arg [lindex $argv $i] + + #dputs arg=$arg + + if {$arg eq "--"} { + # End of options + incr i + lappend nargv {*}[lrange $argv $i end] + break + } + + if {[regexp {^--([^=][^=]+)=(.*)$} $arg -> name value]} { + # --name=value + dict lappend opts $name [list str $value] + } elseif {[regexp {^--(enable-|disable-|with-|without-)?([^=]*)$} $arg -> prefix name]} { + if {$prefix in {enable- with- ""}} { + set value 1 + } else { + set value 0 + } + dict lappend opts $name [list bool $value] + } else { + lappend nargv $arg + } + } + + #puts "getopt: argv=[join $argv] => [join $nargv]" + #array set getopt $opts + #parray getopt + + set argv $nargv + + return $opts +} +} + +# ----- module help ----- + +set modsource(help) { +# Copyright (c) 2010 WorkWare Systems http://workware.net.au/ +# All rights reserved + +# Module which provides usage, help and the command reference + +proc autosetup_help {what} { + use_pager + + puts "Usage: [file tail $::autosetup(exe)] \[options\] \[settings\]\n" + puts "This is [autosetup_version], a build environment \"autoconfigurator\"" + puts "See the documentation online at http://msteveb.github.com/autosetup/\n" + + if {$what eq "local"} { + if {[file exists $::autosetup(autodef)]} { + # This relies on auto.def having a call to 'options' + # which will display options and quit + source $::autosetup(autodef) + } else { + options-show + } + } else { + incr ::autosetup(showhelp) + if {[catch {use $what}]} { + user-error "Unknown module: $what" + } else { + options-show + } + } + exit 0 +} + +# If not already paged and stdout is a tty, pipe the output through the pager +# This is done by reinvoking autosetup with --nopager added +proc use_pager {} { + if {![opt-bool nopager] && [getenv PAGER ""] ne "" && [isatty? stdin] && [isatty? stdout]} { + if {[catch { + exec [info nameofexecutable] $::argv0 --nopager {*}$::argv |& {*}[getenv PAGER] >@stdout <@stdin 2>@stderr + } msg opts] == 1} { + if {[dict get $opts -errorcode] eq "NONE"} { + # an internal/exec error + puts stderr $msg + exit 1 + } + } + exit 0 + } +} + +# Outputs the autosetup references in one of several formats +proc autosetup_reference {{type text}} { + + use_pager + + switch -glob -- $type { + wiki {use wiki-formatting} + ascii* {use asciidoc-formatting} + md - markdown {use markdown-formatting} + default {use text-formatting} + } + + title "[autosetup_version] -- Command Reference" + + section {Introduction} + + p { + See http://msteveb.github.com/autosetup/ for the online documentation for 'autosetup' + } + + p { + 'autosetup' provides a number of built-in commands which + are documented below. These may be used from 'auto.def' to test + for features, define variables, create files from templates and + other similar actions. + } + + automf_command_reference + + exit 0 +} + +proc autosetup_output_block {type lines} { + if {[llength $lines]} { + switch $type { + code { + codelines $lines + } + p { + p [join $lines] + } + list { + foreach line $lines { + bullet $line + } + nl + } + } + } +} + +# Generate a command reference from inline documentation +proc automf_command_reference {} { + lappend files $::autosetup(prog) + lappend files {*}[lsort [glob -nocomplain $::autosetup(libdir)/*.tcl]] + + section "Core Commands" + set type p + set lines {} + set cmd {} + + foreach file $files { + set f [open $file] + while {![eof $f]} { + set line [gets $f] + + # Find lines starting with "# @*" and continuing through the remaining comment lines + if {![regexp {^# @(.*)} $line -> cmd]} { + continue + } + + # Synopsis or command? + if {$cmd eq "synopsis:"} { + section "Module: [file rootname [file tail $file]]" + } else { + subsection $cmd + } + + set lines {} + set type p + + # Now the description + while {![eof $f]} { + set line [gets $f] + + if {![regexp {^#(#)? ?(.*)} $line -> hash cmd]} { + break + } + if {$hash eq "#"} { + set t code + } elseif {[regexp {^- (.*)} $cmd -> cmd]} { + set t list + } else { + set t p + } + + #puts "hash=$hash, oldhash=$oldhash, lines=[llength $lines], cmd=$cmd" + + if {$t ne $type || $cmd eq ""} { + # Finish the current block + autosetup_output_block $type $lines + set lines {} + set type $t + } + if {$cmd ne ""} { + lappend lines $cmd + } + } + + autosetup_output_block $type $lines + } + close $f + } +} +} + +# ----- module init ----- + +set modsource(init) { +# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# Module to help create auto.def and configure + +proc autosetup_init {type} { + set help 0 + if {$type in {? help}} { + incr help + } elseif {![dict exists $::autosetup(inittypes) $type]} { + puts "Unknown type, --init=$type" + incr help + } + if {$help} { + puts "Use one of the following types (e.g. --init=make)\n" + foreach type [lsort [dict keys $::autosetup(inittypes)]] { + lassign [dict get $::autosetup(inittypes) $type] desc + # XXX: Use the options-show code to wrap the description + puts [format "%-10s %s" $type $desc] + } + return + } + lassign [dict get $::autosetup(inittypes) $type] desc script + + puts "Initialising $type: $desc\n" + + # All initialisations happens in the top level srcdir + cd $::autosetup(srcdir) + + uplevel #0 $script +} + +proc autosetup_add_init_type {type desc script} { + dict set ::autosetup(inittypes) $type [list $desc $script] +} + +# This is for in creating build-system init scripts +# +# If the file doesn't exist, create it containing $contents +# If the file does exist, only overwrite if --force is specified. +# +proc autosetup_check_create {filename contents} { + if {[file exists $filename]} { + if {!$::autosetup(force)} { + puts "I see $filename already exists." + return + } else { + puts "I will overwrite the existing $filename because you used --force." + } + } else { + puts "I don't see $filename, so I will create it." + } + writefile $filename $contents +} +} + +# ----- module install ----- + +set modsource(install) { +# Copyright (c) 2006-2010 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# Module which can install autosetup + +proc autosetup_install {dir} { + if {[catch { + cd $dir + file mkdir autosetup + + set f [open autosetup/autosetup w] + + set publicmodules [glob $::autosetup(libdir)/*.auto] + + # First the main script, but only up until "CUT HERE" + set in [open $::autosetup(dir)/autosetup] + while {[gets $in buf] >= 0} { + if {$buf ne "##-- CUT HERE --##"} { + puts $f $buf + continue + } + + # Insert the static modules here + # i.e. those which don't contain @synopsis: + puts $f "set autosetup(installed) 1" + foreach file [lsort [glob $::autosetup(libdir)/*.tcl]] { + set buf [readfile $file] + if {[string match "*\n# @synopsis:*" $buf]} { + lappend publicmodules $file + continue + } + set modname [file rootname [file tail $file]] + puts $f "# ----- module $modname -----" + puts $f "\nset modsource($modname) \{" + puts $f $buf + puts $f "\}\n" + } + } + close $in + close $f + exec chmod 755 autosetup/autosetup + + # Install public modules + foreach file $publicmodules { + autosetup_install_file $file autosetup + } + + # Install support files + foreach file {config.guess config.sub jimsh0.c find-tclsh test-tclsh LICENSE} { + autosetup_install_file $::autosetup(dir)/$file autosetup + } + exec chmod 755 autosetup/config.sub autosetup/config.guess autosetup/find-tclsh + + writefile autosetup/README.autosetup \ + "This is [autosetup_version]. See http://msteveb.github.com/autosetup/\n" + + } error]} { + user-error "Failed to install autosetup: $error" + } + puts "Installed [autosetup_version] to autosetup/" + + # Now create 'configure' if necessary + autosetup_create_configure +} + +proc autosetup_create_configure {} { + if {[file exists configure]} { + if {!$::autosetup(force)} { + # Could this be an autosetup configure? + if {![string match "*\nWRAPPER=*" [readfile configure]]} { + puts "I see configure, but not created by autosetup, so I won't overwrite it." + puts "Remove it or use --force to overwrite." + return + } + } else { + puts "I will overwrite the existing configure because you used --force." + } + } else { + puts "I don't see configure, so I will create it." + } + writefile configure \ +{#!/bin/sh +dir="`dirname "$0"`/autosetup" +WRAPPER="$0"; export WRAPPER; exec "`$dir/find-tclsh`" "$dir/autosetup" "$@" +} + catch {exec chmod 755 configure} +} + +# Append the contents of $file to filehandle $f +proc autosetup_install_append {f file} { + set in [open $file] + puts $f [read $in] + close $in +} + +proc autosetup_install_file {file dir} { + if {![file exists $file]} { + error "Missing installation file '$file'" + } + writefile [file join $dir [file tail $file]] [readfile $file]\n +} + +if {$::autosetup(installed)} { + user-error "autosetup can only be installed from development source, not from installed copy" +} +} + +# ----- module markdown-formatting ----- + +set modsource(markdown-formatting) { +# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# Module which provides text formatting +# markdown format (kramdown syntax) + +use formatting + +proc para {text} { + regsub -all "\[ \t\n\]+" [string trim $text] " " text + regsub -all {([^a-zA-Z])'([^']*)'} $text {\1**`\2`**} text + regsub -all {^'([^']*)'} $text {**`\1`**} text + regsub -all {(http[^ \t\n]*)} $text {[\1](\1)} text + return $text +} +proc title {text} { + underline [para $text] = + nl +} +proc p {text} { + puts [para $text] + nl +} +proc codelines {lines} { + puts "~~~~~~~~~~~~" + foreach line $lines { + puts $line + } + puts "~~~~~~~~~~~~" + nl +} +proc code {text} { + puts "~~~~~~~~~~~~" + foreach line [parse_code_block $text] { + puts $line + } + puts "~~~~~~~~~~~~" + nl +} +proc nl {} { + puts "" +} +proc underline {text char} { + regexp "^(\[ \t\]*)(.*)" $text -> indent words + puts $text + puts $indent[string repeat $char [string length $words]] +} +proc section {text} { + underline "[para $text]" - + nl +} +proc subsection {text} { + puts "### `$text`" + nl +} +proc bullet {text} { + puts "* [para $text]" +} +proc defn {first args} { + puts "^" + set defn [string trim [join $args \n]] + if {$first ne ""} { + puts "**${first}**" + puts -nonewline ": " + regsub -all "\n\n" $defn "\n: " defn + } + puts "$defn" +} +} + +# ----- module misc ----- + +set modsource(misc) { +# Copyright (c) 2007-2010 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# Module containing misc procs useful to modules +# Largely for platform compatibility + +set autosetup(istcl) [info exists ::tcl_library] +set autosetup(iswin) [string equal windows $tcl_platform(platform)] + +if {$autosetup(iswin)} { + # mingw/windows separates $PATH with semicolons + # and doesn't have an executable bit + proc split-path {} { + split [getenv PATH .] {;} + } + proc file-isexec {exec} { + # Basic test for windows. We ignore .bat + if {[file isfile $exec] || [file isfile $exec.exe]} { + return 1 + } + return 0 + } +} else { + # unix separates $PATH with colons and has and executable bit + proc split-path {} { + split [getenv PATH .] : + } + proc file-isexec {exec} { + file executable $exec + } +} + +# Assume that exec can return stdout and stderr +proc exec-with-stderr {args} { + exec {*}$args 2>@1 +} + +if {$autosetup(istcl)} { + # Tcl doesn't have the env command + proc getenv {name args} { + if {[info exists ::env($name)]} { + return $::env($name) + } + if {[llength $args]} { + return [lindex $args 0] + } + return -code error "environment variable \"$name\" does not exist" + } + proc isatty? {channel} { + dict exists [fconfigure $channel] -xchar + } +} else { + if {$autosetup(iswin)} { + # On Windows, backslash convert all environment variables + # (Assume that Tcl does this for us) + proc getenv {name args} { + string map {\\ /} [env $name {*}$args] + } + } else { + # Jim on unix is simple + alias getenv env + } + proc isatty? {channel} { + set tty 0 + catch { + # isatty is a recent addition to Jim Tcl + set tty [$channel isatty] + } + return $tty + } +} + +# In case 'file normalize' doesn't exist +# +proc file-normalize {path} { + if {[catch {file normalize $path} result]} { + if {$path eq ""} { + return "" + } + set oldpwd [pwd] + if {[file isdir $path]} { + cd $path + set result [pwd] + } else { + cd [file dirname $path] + set result [file join [pwd] [file tail $path]] + } + cd $oldpwd + } + return $result +} + +# If everything is working properly, the only errors which occur +# should be generated in user code (e.g. auto.def). +# By default, we only want to show the error location in user code. +# We use [info frame] to achieve this, but it works differently on Tcl and Jim. +# +# This is designed to be called for incorrect usage in auto.def, via autosetup-error +# +proc error-location {msg} { + if {$::autosetup(debug)} { + return -code error $msg + } + # Search back through the stack trace for the first error in a .def file + for {set i 1} {$i < [info level]} {incr i} { + if {$::autosetup(istcl)} { + array set info [info frame -$i] + } else { + lassign [info frame -$i] info(caller) info(file) info(line) + } + if {[string match *.def $info(file)]} { + return "[relative-path $info(file)]:$info(line): Error: $msg" + } + #puts "Skipping $info(file):$info(line)" + } + return $msg +} + +# If everything is working properly, the only errors which occur +# should be generated in user code (e.g. auto.def). +# By default, we only want to show the error location in user code. +# We use [info frame] to achieve this, but it works differently on Tcl and Jim. +# +# This is designed to be called for incorrect usage in auto.def, via autosetup-error +# +proc error-stacktrace {msg} { + if {$::autosetup(debug)} { + return -code error $msg + } + # Search back through the stack trace for the first error in a .def file + for {set i 1} {$i < [info level]} {incr i} { + if {$::autosetup(istcl)} { + array set info [info frame -$i] + } else { + lassign [info frame -$i] info(caller) info(file) info(line) + } + if {[string match *.def $info(file)]} { + return "[relative-path $info(file)]:$info(line): Error: $msg" + } + #puts "Skipping $info(file):$info(line)" + } + return $msg +} + +# Given the return from [catch {...} msg opts], returns an appropriate +# error message. A nice one for Jim and a less-nice one for Tcl. +# If 'fulltrace' is set, a full stack trace is provided. +# Otherwise a simple message is provided. +# +# This is designed for developer errors, e.g. in module code or auto.def code +# +# +proc error-dump {msg opts fulltrace} { + if {$::autosetup(istcl)} { + if {$fulltrace} { + return "Error: [dict get $opts -errorinfo]" + } else { + return "Error: $msg" + } + } else { + lassign $opts(-errorinfo) p f l + if {$f ne ""} { + set result "$f:$l: Error: " + } + append result "$msg\n" + if {$fulltrace} { + append result [stackdump $opts(-errorinfo)] + } + + # Remove the trailing newline + string trim $result + } +} +} + +# ----- module text-formatting ----- + +set modsource(text-formatting) { +# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# Module which provides text formatting + +use formatting + +proc wordwrap {text length {firstprefix ""} {nextprefix ""}} { + set len 0 + set space $firstprefix + foreach word [split $text] { + set word [string trim $word] + if {$word == ""} { + continue + } + if {$len && [string length $space$word] + $len >= $length} { + puts "" + set len 0 + set space $nextprefix + } + incr len [string length $space$word] + + # Use man-page conventions for highlighting 'quoted' and *quoted* + # single words. + # Use x^Hx for *bold* and _^Hx for 'underline'. + # + # less and more will both understand this. + # Pipe through 'col -b' to remove them. + if {[regexp {^'(.*)'([^a-zA-Z0-9_]*)$} $word -> bareword dot]} { + regsub -all . $bareword "_\b&" word + append word $dot + } elseif {[regexp {^[*](.*)[*]([^a-zA-Z0-9_]*)$} $word -> bareword dot]} { + regsub -all . $bareword "&\b&" word + append word $dot + } + puts -nonewline $space$word + set space " " + } + if {$len} { + puts "" + } +} +proc title {text} { + underline [string trim $text] = + nl +} +proc p {text} { + wordwrap $text 80 + nl +} +proc codelines {lines} { + foreach line $lines { + puts " $line" + } + nl +} +proc nl {} { + puts "" +} +proc underline {text char} { + regexp "^(\[ \t\]*)(.*)" $text -> indent words + puts $text + puts $indent[string repeat $char [string length $words]] +} +proc section {text} { + underline "[string trim $text]" - + nl +} +proc subsection {text} { + underline "$text" ~ + nl +} +proc bullet {text} { + wordwrap $text 76 " * " " " +} +proc indent {text} { + wordwrap $text 76 " " " " +} +proc defn {first args} { + if {$first ne ""} { + underline " $first" ~ + } + foreach p $args { + if {$p ne ""} { + indent $p + } + } +} +} + +# ----- module wiki-formatting ----- + +set modsource(wiki-formatting) { +# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# Module which provides text formatting +# wiki.tcl.tk format output + +use formatting + +proc joinlines {text} { + set lines {} + foreach l [split [string trim $text] \n] { + lappend lines [string trim $l] + } + join $lines +} +proc p {text} { + puts [joinlines $text] + puts "" +} +proc title {text} { + puts "*** [joinlines $text] ***" + puts "" +} +proc codelines {lines} { + puts "======" + foreach line $lines { + puts " $line" + } + puts "======" +} +proc code {text} { + puts "======" + foreach line [parse_code_block $text] { + puts " $line" + } + puts "======" +} +proc nl {} { +} +proc section {text} { + puts "'''$text'''" + puts "" +} +proc subsection {text} { + puts "''$text''" + puts "" +} +proc bullet {text} { + puts " * [joinlines $text]" +} +proc indent {text} { + puts " : [joinlines $text]" +} +proc defn {first args} { + if {$first ne ""} { + indent '''$first''' + } + + foreach p $args { + p $p + } +} +} + + +################################################################## +# +# Entry/Exit +# +if {$autosetup(debug)} { + main $argv +} +if {[catch {main $argv} msg opts] == 1} { + show-notices + autosetup-full-error [error-dump $msg $opts $::autosetup(debug)] + if {!$autosetup(debug)} { + puts stderr "Try: '[file tail $autosetup(exe)] --debug' for a full stack trace" + } + exit 1 +} ADDED autosetup/cc-db.tcl Index: autosetup/cc-db.tcl ================================================================== --- /dev/null +++ autosetup/cc-db.tcl @@ -0,0 +1,15 @@ +# Copyright (c) 2011 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# @synopsis: +# +# The 'cc-db' module provides a knowledge based of system idiosyncrasies +# In general, this module can always be included + +use cc + +module-options {} + +# openbsd needs sys/types.h to detect some system headers +cc-include-needs sys/socket.h sys/types.h +cc-include-needs netinet/in.h sys/types.h ADDED autosetup/cc-lib.tcl Index: autosetup/cc-lib.tcl ================================================================== --- /dev/null +++ autosetup/cc-lib.tcl @@ -0,0 +1,191 @@ +# Copyright (c) 2011 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# @synopsis: +# +# Provides a library of common tests on top of the 'cc' module. + +use cc + +module-options {} + +# @cc-check-lfs +# +# The equivalent of the AC_SYS_LARGEFILE macro +# +# defines 'HAVE_LFS' if LFS is available, +# and defines '_FILE_OFFSET_BITS=64' if necessary +# +# Returns 1 if 'LFS' is available or 0 otherwise +# +proc cc-check-lfs {} { + cc-check-includes sys/types.h + msg-checking "Checking if -D_FILE_OFFSET_BITS=64 is needed..." + set lfs 1 + if {[msg-quiet cc-with {-includes sys/types.h} {cc-check-sizeof off_t}] == 8} { + msg-result no + } elseif {[msg-quiet cc-with {-includes sys/types.h -cflags -D_FILE_OFFSET_BITS=64} {cc-check-sizeof off_t}] == 8} { + define _FILE_OFFSET_BITS 64 + msg-result yes + } else { + set lfs 0 + msg-result none + } + define-feature lfs $lfs + return $lfs +} + +# @cc-check-endian +# +# The equivalent of the AC_C_BIGENDIAN macro +# +# defines 'HAVE_BIG_ENDIAN' if endian is known to be big, +# or 'HAVE_LITTLE_ENDIAN' if endian is known to be little. +# +# Returns 1 if determined, or 0 if not. +# +proc cc-check-endian {} { + cc-check-includes sys/types.h sys/param.h + set rc 0 + msg-checking "Checking endian..." + cc-with {-includes {sys/types.h sys/param.h}} { + if {[cctest -code { + #if !defined(BIG_ENDIAN) || !defined(BYTE_ORDER) + #error unknown + #elif BYTE_ORDER != BIG_ENDIAN + #error little + #endif + }]} { + define-feature big-endian + msg-result "big" + set rc 1 + } elseif {[cctest -code { + #if !defined(LITTLE_ENDIAN) || !defined(BYTE_ORDER) + #error unknown + #elif BYTE_ORDER != LITTLE_ENDIAN + #error big + #endif + }]} { + define-feature little-endian + msg-result "little" + set rc 1 + } else { + msg-result "unknown" + } + } + return $rc +} + +# @cc-check-flags flag ?...? +# +# Checks whether the given C/C++ compiler flags can be used. Defines feature +# names prefixed with 'HAVE_CFLAG' and 'HAVE_CXXFLAG' respectively, and +# appends working flags to '-cflags' and 'CFLAGS' or 'CXXFLAGS'. +proc cc-check-flags {args} { + set result 1 + array set opts [cc-get-settings] + switch -exact -- $opts(-lang) { + c++ { + set lang C++ + set prefix CXXFLAG + } + c { + set lang C + set prefix CFLAG + } + default { + autosetup-error "cc-check-flags failed with unknown language: $opts(-lang)" + } + } + foreach flag $args { + msg-checking "Checking whether the $lang compiler accepts $flag..." + if {[cctest -cflags $flag]} { + msg-result yes + define-feature $prefix$flag + cc-with [list -cflags [list $flag]] + define-append ${prefix}S $flag + } else { + msg-result no + set result 0 + } + } + return $result +} + +# @cc-check-standards ver ?...? +# +# Checks whether the C/C++ compiler accepts one of the specified '-std=$ver' +# options, and appends the first working one to '-cflags' and 'CFLAGS' or +# 'CXXFLAGS'. +proc cc-check-standards {args} { + array set opts [cc-get-settings] + foreach std $args { + if {[cc-check-flags -std=$std]} { + return $std + } + } + return "" +} + +# Checks whether $keyword is usable as alignof +proc cctest_alignof {keyword} { + msg-checking "Checking for $keyword..." + if {[cctest -code [subst -nobackslashes { + printf("minimum alignment is %d == %d\n", ${keyword}(char), ${keyword}('x')); + }]]} then { + msg-result ok + define-feature $keyword + } else { + msg-result "not found" + } +} + +# @cc-check-c11 +# +# Checks for several C11/C++11 extensions and their alternatives. Currently +# checks for '_Static_assert', '_Alignof', '__alignof__', '__alignof'. +proc cc-check-c11 {} { + msg-checking "Checking for _Static_assert..." + if {[cctest -code { + _Static_assert(1, "static assertions are available"); + }]} then { + msg-result ok + define-feature _Static_assert + } else { + msg-result "not found" + } + + cctest_alignof _Alignof + cctest_alignof __alignof__ + cctest_alignof __alignof +} + +# @cc-check-alloca +# +# The equivalent of the AC_FUNC_ALLOCA macro +# +# Checks for the existence of alloca +# defines HAVE_ALLOCA and returns 1 if it exists +proc cc-check-alloca {} { + cc-check-some-feature alloca { + cctest -includes alloca.h -code { alloca (2 * sizeof (int)); } + } +} + +# @cc-signal-return-type +# +# The equivalent of the AC_TYPE_SIGNAL macro +# +# defines RETSIGTYPE to int or void +proc cc-signal-return-type {} { + msg-checking "Checking return type of signal handlers..." + cc-with {-includes {sys/types.h signal.h}} { + if {[cctest -code {return *(signal (0, 0)) (0) == 1;}]} { + set type int + } else { + set type void + } + define RETSIGTYPE $type + msg-result $type + } +} ADDED autosetup/cc-shared.tcl Index: autosetup/cc-shared.tcl ================================================================== --- /dev/null +++ autosetup/cc-shared.tcl @@ -0,0 +1,117 @@ +# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# @synopsis: +# +# The 'cc-shared' module provides support for shared libraries and shared objects. +# It defines the following variables: +# +## SH_CFLAGS Flags to use compiling sources destined for a shared library +## SH_LDFLAGS Flags to use linking (creating) a shared library +## SH_SOPREFIX Prefix to use to set the soname when creating a shared library +## SH_SOEXT Extension for shared libs +## SH_SOEXTVER Format for versioned shared libs - %s = version +## SHOBJ_CFLAGS Flags to use compiling sources destined for a shared object +## SHOBJ_LDFLAGS Flags to use linking a shared object, undefined symbols allowed +## SHOBJ_LDFLAGS_R - as above, but all symbols must be resolved +## SH_LINKFLAGS Flags to use linking an executable which will load shared objects +## LD_LIBRARY_PATH Environment variable which specifies path to shared libraries +## STRIPLIBFLAGS Arguments to strip a dynamic library + +module-options {} + +# Defaults: gcc on unix +define SHOBJ_CFLAGS -fpic +define SHOBJ_LDFLAGS -shared +define SH_CFLAGS -fpic +define SH_LDFLAGS -shared +define SH_LINKFLAGS -rdynamic +define SH_SOEXT .so +define SH_SOEXTVER .so.%s +define SH_SOPREFIX -Wl,-soname, +define LD_LIBRARY_PATH LD_LIBRARY_PATH +define STRIPLIBFLAGS --strip-unneeded + +# Note: This is a helpful reference for identifying the toolchain +# http://sourceforge.net/apps/mediawiki/predef/index.php?title=Compilers + +switch -glob -- [get-define host] { + *-*-darwin* { + define SHOBJ_CFLAGS "-dynamic -fno-common" + define SHOBJ_LDFLAGS "-bundle -undefined dynamic_lookup" + define SHOBJ_LDFLAGS_R -bundle + define SH_CFLAGS -dynamic + define SH_LDFLAGS -dynamiclib + define SH_LINKFLAGS "" + define SH_SOEXT .dylib + define SH_SOEXTVER .%s.dylib + define SH_SOPREFIX -Wl,-install_name, + define LD_LIBRARY_PATH DYLD_LIBRARY_PATH + define STRIPLIBFLAGS -x + } + *-*-ming* - *-*-cygwin - *-*-msys { + define SHOBJ_CFLAGS "" + define SHOBJ_LDFLAGS -shared + define SH_CFLAGS "" + define SH_LDFLAGS -shared + define SH_LINKFLAGS "" + define SH_SOEXT .dll + define SH_SOEXTVER .dll + define SH_SOPREFIX "" + define LD_LIBRARY_PATH PATH + } + sparc* { + if {[msg-quiet cc-check-decls __SUNPRO_C]} { + msg-result "Found sun stdio compiler" + # sun stdio compiler + # XXX: These haven't been fully tested. + define SHOBJ_CFLAGS -KPIC + define SHOBJ_LDFLAGS "-G" + define SH_CFLAGS -KPIC + define SH_LINKFLAGS -Wl,-export-dynamic + define SH_SOPREFIX -Wl,-h, + } else { + # sparc has a very small GOT table limit, so use -fPIC + define SH_CFLAGS -fPIC + define SHOBJ_CFLAGS -fPIC + } + } + *-*-solaris* { + if {[msg-quiet cc-check-decls __SUNPRO_C]} { + msg-result "Found sun stdio compiler" + # sun stdio compiler + # XXX: These haven't been fully tested. + define SHOBJ_CFLAGS -KPIC + define SHOBJ_LDFLAGS "-G" + define SH_CFLAGS -KPIC + define SH_LINKFLAGS -Wl,-export-dynamic + define SH_SOPREFIX -Wl,-h, + } + } + *-*-hpux { + # XXX: These haven't been tested + define SHOBJ_CFLAGS "+O3 +z" + define SHOBJ_LDFLAGS -b + define SH_CFLAGS +z + define SH_LINKFLAGS -Wl,+s + define LD_LIBRARY_PATH SHLIB_PATH + } + *-*-haiku { + define SHOBJ_CFLAGS "" + define SHOBJ_LDFLAGS -shared + define SH_CFLAGS "" + define SH_LDFLAGS -shared + define SH_LINKFLAGS "" + define SH_SOPREFIX "" + define LD_LIBRARY_PATH LIBRARY_PATH + } + microblaze* { + # Microblaze generally needs -fPIC rather than -fpic + define SHOBJ_CFLAGS -fPIC + define SH_CFLAGS -fPIC + } +} + +if {![is-defined SHOBJ_LDFLAGS_R]} { + define SHOBJ_LDFLAGS_R [get-define SHOBJ_LDFLAGS] +} ADDED autosetup/cc.tcl Index: autosetup/cc.tcl ================================================================== --- /dev/null +++ autosetup/cc.tcl @@ -0,0 +1,705 @@ +# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# @synopsis: +# +# The 'cc' module supports checking various 'features' of the C or C++ +# compiler/linker environment. Common commands are cc-check-includes, +# cc-check-types, cc-check-functions, cc-with, make-autoconf-h and make-template. +# +# The following environment variables are used if set: +# +## CC - C compiler +## CXX - C++ compiler +## CCACHE - Set to "none" to disable automatic use of ccache +## CFLAGS - Additional C compiler flags +## CXXFLAGS - Additional C++ compiler flags +## LDFLAGS - Additional compiler flags during linking +## LIBS - Additional libraries to use (for all tests) +## CROSS - Tool prefix for cross compilation +# +# The following variables are defined from the corresponding +# environment variables if set. +# +## CPPFLAGS +## LINKFLAGS +## CC_FOR_BUILD +## LD + +use system + +module-options {} + +# Note that the return code is not meaningful +proc cc-check-something {name code} { + uplevel 1 $code +} + +# Checks for the existence of the given function by linking +# +proc cctest_function {function} { + cctest -link 1 -declare "extern void $function\(void);" -code "$function\();" +} + +# Checks for the existence of the given type by compiling +proc cctest_type {type} { + cctest -code "$type _x;" +} + +# Checks for the existence of the given type/structure member. +# e.g. "struct stat.st_mtime" +proc cctest_member {struct_member} { + # split at the first dot + regexp {^([^.]+)[.](.*)$} $struct_member -> struct member + cctest -code "static $struct _s; return sizeof(_s.$member);" +} + +# Checks for the existence of the given define by compiling +# +proc cctest_define {name} { + cctest -code "#ifndef $name\n#error not defined\n#endif" +} + +# Checks for the existence of the given name either as +# a macro (#define) or an rvalue (such as an enum) +# +proc cctest_decl {name} { + cctest -code "#ifndef $name\n(void)$name;\n#endif" +} + +# @cc-check-sizeof type ... +# +# Checks the size of the given types (between 1 and 32, inclusive). +# Defines a variable with the size determined, or "unknown" otherwise. +# e.g. for type 'long long', defines SIZEOF_LONG_LONG. +# Returns the size of the last type. +# +proc cc-check-sizeof {args} { + foreach type $args { + msg-checking "Checking for sizeof $type..." + set size unknown + # Try the most common sizes first + foreach i {4 8 1 2 16 32} { + if {[cctest -code "static int _x\[sizeof($type) == $i ? 1 : -1\] = { 1 };"]} { + set size $i + break + } + } + msg-result $size + set define [feature-define-name $type SIZEOF_] + define $define $size + } + # Return the last result + get-define $define +} + +# Checks for each feature in $list by using the given script. +# +# When the script is evaluated, $each is set to the feature +# being checked, and $extra is set to any additional cctest args. +# +# Returns 1 if all features were found, or 0 otherwise. +proc cc-check-some-feature {list script} { + set ret 1 + foreach each $list { + if {![check-feature $each $script]} { + set ret 0 + } + } + return $ret +} + +# @cc-check-includes includes ... +# +# Checks that the given include files can be used +proc cc-check-includes {args} { + cc-check-some-feature $args { + set with {} + if {[dict exists $::autosetup(cc-include-deps) $each]} { + set deps [dict keys [dict get $::autosetup(cc-include-deps) $each]] + msg-quiet cc-check-includes {*}$deps + foreach i $deps { + if {[have-feature $i]} { + lappend with $i + } + } + } + if {[llength $with]} { + cc-with [list -includes $with] { + cctest -includes $each + } + } else { + cctest -includes $each + } + } +} + +# @cc-include-needs include required ... +# +# Ensures that when checking for 'include', a check is first +# made for each 'required' file, and if found, it is #included +proc cc-include-needs {file args} { + foreach depfile $args { + dict set ::autosetup(cc-include-deps) $file $depfile 1 + } +} + +# @cc-check-types type ... +# +# Checks that the types exist. +proc cc-check-types {args} { + cc-check-some-feature $args { + cctest_type $each + } +} + +# @cc-check-defines define ... +# +# Checks that the given preprocessor symbol is defined +proc cc-check-defines {args} { + cc-check-some-feature $args { + cctest_define $each + } +} + +# @cc-check-decls name ... +# +# Checks that each given name is either a preprocessor symbol or rvalue +# such as an enum. Note that the define used is HAVE_DECL_xxx +# rather than HAVE_xxx +proc cc-check-decls {args} { + set ret 1 + foreach name $args { + msg-checking "Checking for $name..." + set r [cctest_decl $name] + define-feature "decl $name" $r + if {$r} { + msg-result "ok" + } else { + msg-result "not found" + set ret 0 + } + } + return $ret +} + +# @cc-check-functions function ... +# +# Checks that the given functions exist (can be linked) +proc cc-check-functions {args} { + cc-check-some-feature $args { + cctest_function $each + } +} + +# @cc-check-members type.member ... +# +# Checks that the given type/structure members exist. +# A structure member is of the form "struct stat.st_mtime" +proc cc-check-members {args} { + cc-check-some-feature $args { + cctest_member $each + } +} + +# @cc-check-function-in-lib function libs ?otherlibs? +# +# Checks that the given function can be found in one of the libs. +# +# First checks for no library required, then checks each of the libraries +# in turn. +# +# If the function is found, the feature is defined and lib_$function is defined +# to -l$lib where the function was found, or "" if no library required. +# In addition, -l$lib is prepended to the LIBS define. +# +# If additional libraries may be needed for linking, they should be specified +# as $extralibs as "-lotherlib1 -lotherlib2". +# These libraries are not automatically added to LIBS. +# +# Returns 1 if found or 0 if not. +# +proc cc-check-function-in-lib {function libs {otherlibs {}}} { + msg-checking "Checking libs for $function..." + set found 0 + cc-with [list -libs $otherlibs] { + if {[cctest_function $function]} { + msg-result "none needed" + define lib_$function "" + incr found + } else { + foreach lib $libs { + cc-with [list -libs -l$lib] { + if {[cctest_function $function]} { + msg-result -l$lib + define lib_$function -l$lib + # prepend to LIBS + define LIBS "-l$lib [get-define LIBS]" + incr found + break + } + } + } + } + } + if {$found} { + define [feature-define-name $function] + } else { + msg-result "no" + } + return $found +} + +# @cc-check-tools tool ... +# +# Checks for existence of the given compiler tools, taking +# into account any cross compilation prefix. +# +# For example, when checking for "ar", first AR is checked on the command +# line and then in the environment. If not found, "${host}-ar" or +# simply "ar" is assumed depending upon whether cross compiling. +# The path is searched for this executable, and if found AR is defined +# to the executable name. +# Note that even when cross compiling, the simple "ar" is used as a fallback, +# but a warning is generated. This is necessary for some toolchains. +# +# It is an error if the executable is not found. +# +proc cc-check-tools {args} { + foreach tool $args { + set TOOL [string toupper $tool] + set exe [get-env $TOOL [get-define cross]$tool] + if {[find-executable {*}$exe]} { + define $TOOL $exe + continue + } + if {[find-executable {*}$tool]} { + msg-result "Warning: Failed to find $exe, falling back to $tool which may be incorrect" + define $TOOL $tool + continue + } + user-error "Failed to find $exe" + } +} + +# @cc-check-progs prog ... +# +# Checks for existence of the given executables on the path. +# +# For example, when checking for "grep", the path is searched for +# the executable, 'grep', and if found GREP is defined as "grep". +# +# If the executable is not found, the variable is defined as false. +# Returns 1 if all programs were found, or 0 otherwise. +# +proc cc-check-progs {args} { + set failed 0 + foreach prog $args { + set PROG [string toupper $prog] + msg-checking "Checking for $prog..." + if {![find-executable $prog]} { + msg-result no + define $PROG false + incr failed + } else { + msg-result ok + define $PROG $prog + } + } + expr {!$failed} +} + +# Adds the given settings to $::autosetup(ccsettings) and +# returns the old settings. +# +proc cc-add-settings {settings} { + if {[llength $settings] % 2} { + autosetup-error "settings list is missing a value: $settings" + } + + set prev [cc-get-settings] + # workaround a bug in some versions of jimsh by forcing + # conversion of $prev to a list + llength $prev + + array set new $prev + + foreach {name value} $settings { + switch -exact -- $name { + -cflags - -includes { + # These are given as lists + lappend new($name) {*}$value + } + -declare { + lappend new($name) $value + } + -libs { + # Note that new libraries are added before previous libraries + set new($name) [list {*}$value {*}$new($name)] + } + -link - -lang - -nooutput { + set new($name) $value + } + -source - -sourcefile - -code { + # XXX: These probably are only valid directly from cctest + set new($name) $value + } + default { + autosetup-error "unknown cctest setting: $name" + } + } + } + + cc-store-settings [array get new] + + return $prev +} + +proc cc-store-settings {new} { + set ::autosetup(ccsettings) $new +} + +proc cc-get-settings {} { + return $::autosetup(ccsettings) +} + +# Similar to cc-add-settings, but each given setting +# simply replaces the existing value. +# +# Returns the previous settings +proc cc-update-settings {args} { + set prev [cc-get-settings] + cc-store-settings [dict merge $prev $args] + return $prev +} + +# @cc-with settings ?{ script }? +# +# Sets the given 'cctest' settings and then runs the tests in 'script'. +# Note that settings such as -lang replace the current setting, while +# those such as -includes are appended to the existing setting. +# +# If no script is given, the settings become the default for the remainder +# of the auto.def file. +# +## cc-with {-lang c++} { +## # This will check with the C++ compiler +## cc-check-types bool +## cc-with {-includes signal.h} { +## # This will check with the C++ compiler, signal.h and any existing includes. +## ... +## } +## # back to just the C++ compiler +## } +# +# The -libs setting is special in that newer values are added *before* earlier ones. +# +## cc-with {-libs {-lc -lm}} { +## cc-with {-libs -ldl} { +## cctest -libs -lsocket ... +## # libs will be in this order: -lsocket -ldl -lc -lm +## } +## } +proc cc-with {settings args} { + if {[llength $args] == 0} { + cc-add-settings $settings + } elseif {[llength $args] > 1} { + autosetup-error "usage: cc-with settings ?script?" + } else { + set save [cc-add-settings $settings] + set rc [catch {uplevel 1 [lindex $args 0]} result info] + cc-store-settings $save + if {$rc != 0} { + return -code [dict get $info -code] $result + } + return $result + } +} + +# @cctest ?settings? +# +# Low level C compiler checker. Compiles and or links a small C program +# according to the arguments and returns 1 if OK, or 0 if not. +# +# Supported settings are: +# +## -cflags cflags A list of flags to pass to the compiler +## -includes list A list of includes, e.g. {stdlib.h stdio.h} +## -declare code Code to declare before main() +## -link 1 Don't just compile, link too +## -lang c|c++ Use the C (default) or C++ compiler +## -libs liblist List of libraries to link, e.g. {-ldl -lm} +## -code code Code to compile in the body of main() +## -source code Compile a complete program. Ignore -includes, -declare and -code +## -sourcefile file Shorthand for -source [readfile [get-define srcdir]/$file] +## -nooutput 1 Treat any compiler output (e.g. a warning) as an error +# +# Unless -source or -sourcefile is specified, the C program looks like: +# +## #include /* same for remaining includes in the list */ +## +## declare-code /* any code in -declare, verbatim */ +## +## int main(void) { +## code /* any code in -code, verbatim */ +## return 0; +## } +# +# Any failures are recorded in 'config.log' +# +proc cctest {args} { + set src conftest__.c + set tmp conftest__ + + # Easiest way to merge in the settings + cc-with $args { + array set opts [cc-get-settings] + } + + if {[info exists opts(-sourcefile)]} { + set opts(-source) [readfile [get-define srcdir]/$opts(-sourcefile) "#error can't find $opts(-sourcefile)"] + } + if {[info exists opts(-source)]} { + set lines $opts(-source) + } else { + foreach i $opts(-includes) { + if {$opts(-code) ne "" && ![feature-checked $i]} { + # Compiling real code with an unchecked header file + # Quickly (and silently) check for it now + + # Remove all -includes from settings before checking + set saveopts [cc-update-settings -includes {}] + msg-quiet cc-check-includes $i + cc-store-settings $saveopts + } + if {$opts(-code) eq "" || [have-feature $i]} { + lappend source "#include <$i>" + } + } + lappend source {*}$opts(-declare) + lappend source "int main(void) {" + lappend source $opts(-code) + lappend source "return 0;" + lappend source "}" + + set lines [join $source \n] + } + + # Build the command line + set cmdline {} + lappend cmdline {*}[get-define CCACHE] + switch -exact -- $opts(-lang) { + c++ { + lappend cmdline {*}[get-define CXX] {*}[get-define CXXFLAGS] + } + c { + lappend cmdline {*}[get-define CC] {*}[get-define CFLAGS] + } + default { + autosetup-error "cctest called with unknown language: $opts(-lang)" + } + } + + if {$opts(-link)} { + lappend cmdline {*}[get-define LDFLAGS] + } else { + set tmp conftest__.o + lappend cmdline -c + } + lappend cmdline {*}$opts(-cflags) {*}[get-define cc-default-debug ""] + lappend cmdline $src -o $tmp {*}$opts(-libs) + if {$opts(-link)} { + lappend cmdline {*}[get-define LIBS] + } + + # At this point we have the complete command line and the + # complete source to be compiled. Get the result from cache if + # we can + if {[info exists ::cc_cache($cmdline,$lines)]} { + msg-checking "(cached) " + set ok $::cc_cache($cmdline,$lines) + if {$::autosetup(debug)} { + configlog "From cache (ok=$ok): [join $cmdline]" + configlog "============" + configlog $lines + configlog "============" + } + return $ok + } + + writefile $src $lines\n + + set ok 1 + set err [catch {exec-with-stderr {*}$cmdline} result errinfo] + if {$err || ($opts(-nooutput) && [string length $result])} { + configlog "Failed: [join $cmdline]" + configlog $result + configlog "============" + configlog "The failed code was:" + configlog $lines + configlog "============" + set ok 0 + } elseif {$::autosetup(debug)} { + configlog "Compiled OK: [join $cmdline]" + configlog "============" + configlog $lines + configlog "============" + } + file delete $src + file delete $tmp + + # cache it + set ::cc_cache($cmdline,$lines) $ok + + return $ok +} + +# @make-autoconf-h outfile ?auto-patterns=HAVE_*? ?bare-patterns=SIZEOF_*? +# +# Deprecated - see make-config-header +proc make-autoconf-h {file {autopatterns {HAVE_*}} {barepatterns {SIZEOF_* HAVE_DECL_*}}} { + user-notice "*** make-autoconf-h is deprecated -- use make-config-header instead" + make-config-header $file -auto $autopatterns -bare $barepatterns +} + +# @make-config-header outfile ?-auto patternlist? ?-bare patternlist? ?-none patternlist? ?-str patternlist? ... +# +# Examines all defined variables which match the given patterns +# and writes an include file, $file, which defines each of these. +# Variables which match '-auto' are output as follows: +# - defines which have the value "0" are ignored. +# - defines which have integer values are defined as the integer value. +# - any other value is defined as a string, e.g. "value" +# Variables which match '-bare' are defined as-is. +# Variables which match '-str' are defined as a string, e.g. "value" +# Variables which match '-none' are omitted. +# +# Note that order is important. The first pattern which matches is selected +# Default behaviour is: +# +# -bare {SIZEOF_* HAVE_DECL_*} -auto HAVE_* -none * +# +# If the file would be unchanged, it is not written. +proc make-config-header {file args} { + set guard _[string toupper [regsub -all {[^a-zA-Z0-9]} [file tail $file] _]] + file mkdir [file dirname $file] + set lines {} + lappend lines "#ifndef $guard" + lappend lines "#define $guard" + + # Add some defaults + lappend args -bare {SIZEOF_* HAVE_DECL_*} -auto HAVE_* + + foreach n [lsort [dict keys [all-defines]]] { + set value [get-define $n] + set type [calc-define-output-type $n $args] + switch -exact -- $type { + -bare { + # Just output the value unchanged + } + -none { + continue + } + -str { + set value \"[string map [list \\ \\\\ \" \\\"] $value]\" + } + -auto { + # Automatically determine the type + if {$value eq "0"} { + lappend lines "/* #undef $n */" + continue + } + if {![string is integer -strict $value]} { + set value \"[string map [list \\ \\\\ \" \\\"] $value]\" + } + } + "" { + continue + } + default { + autosetup-error "Unknown type in make-config-header: $type" + } + } + lappend lines "#define $n $value" + } + lappend lines "#endif" + set buf [join $lines \n] + write-if-changed $file $buf { + msg-result "Created $file" + } +} + +proc calc-define-output-type {name spec} { + foreach {type patterns} $spec { + foreach pattern $patterns { + if {[string match $pattern $name]} { + return $type + } + } + } + return "" +} + +# Initialise some values from the environment or commandline or default settings +foreach i {LDFLAGS LIBS CPPFLAGS LINKFLAGS {CFLAGS "-g -O2"}} { + lassign $i var default + define $var [get-env $var $default] +} + +if {[env-is-set CC]} { + # Set by the user, so don't try anything else + set try [list [get-env CC ""]] +} else { + # Try some reasonable options + set try [list [get-define cross]cc [get-define cross]gcc] +} +define CC [find-an-executable {*}$try] +if {[get-define CC] eq ""} { + user-error "Could not find a C compiler. Tried: [join $try ", "]" +} + +define CPP [get-env CPP "[get-define CC] -E"] + +# XXX: Could avoid looking for a C++ compiler until requested +# Note that if CXX isn't found, we just set it to "false". It might not be needed. +if {[env-is-set CXX]} { + define CXX [find-an-executable -required [get-env CXX ""]] +} else { + define CXX [find-an-executable [get-define cross]c++ [get-define cross]g++ false] +} + +# CXXFLAGS default to CFLAGS if not specified +define CXXFLAGS [get-env CXXFLAGS [get-define CFLAGS]] + +# May need a CC_FOR_BUILD, so look for one +define CC_FOR_BUILD [find-an-executable [get-env CC_FOR_BUILD ""] cc gcc false] + +if {[get-define CC] eq ""} { + user-error "Could not find a C compiler. Tried: [join $try ", "]" +} + +define CCACHE [find-an-executable [get-env CCACHE ccache]] + +# Initial cctest settings +cc-store-settings {-cflags {} -includes {} -declare {} -link 0 -lang c -libs {} -code {} -nooutput 0} +set autosetup(cc-include-deps) {} + +msg-result "C compiler...[get-define CCACHE] [get-define CC] [get-define CFLAGS]" +if {[get-define CXX] ne "false"} { + msg-result "C++ compiler...[get-define CCACHE] [get-define CXX] [get-define CXXFLAGS]" +} +msg-result "Build C compiler...[get-define CC_FOR_BUILD]" + +# On Darwin, we prefer to use -g0 to avoid creating .dSYM directories +# but some compilers may not support it, so test here. +switch -glob -- [get-define host] { + *-*-darwin* { + if {[cctest -cflags {-g0}]} { + define cc-default-debug -g0 + } + } +} + +if {![cc-check-includes stdlib.h]} { + user-error "Compiler does not work. See config.log" +} ADDED autosetup/config.guess Index: autosetup/config.guess ================================================================== --- /dev/null +++ autosetup/config.guess @@ -0,0 +1,1421 @@ +#! /bin/sh +# Attempt to guess a canonical system name. +# Copyright 1992-2014 Free Software Foundation, Inc. + +timestamp='2014-11-04' + +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, see . +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). +# +# Originally written by Per Bothner; maintained since 2000 by Ben Elliston. +# +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.guess;hb=HEAD +# +# Please send patches to . + + +me=`echo "$0" | sed -e 's,.*/,,'` + +usage="\ +Usage: $0 [OPTION] + +Output the configuration name of the system \`$me' is run on. + +Operation modes: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to ." + +version="\ +GNU config.guess ($timestamp) + +Originally written by Per Bothner. +Copyright 1992-2014 Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" >&2 + exit 1 ;; + * ) + break ;; + esac +done + +if test $# != 0; then + echo "$me: too many arguments$help" >&2 + exit 1 +fi + +trap 'exit 1' 1 2 15 + +# CC_FOR_BUILD -- compiler used by this script. Note that the use of a +# compiler to aid in system detection is discouraged as it requires +# temporary files to be created and, as you can see below, it is a +# headache to deal with in a portable fashion. + +# Historically, `CC_FOR_BUILD' used to be named `HOST_CC'. We still +# use `HOST_CC' if defined, but it is deprecated. + +# Portable tmp directory creation inspired by the Autoconf team. + +set_cc_for_build=' +trap "exitcode=\$?; (rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null) && exit \$exitcode" 0 ; +trap "rm -f \$tmpfiles 2>/dev/null; rmdir \$tmp 2>/dev/null; exit 1" 1 2 13 15 ; +: ${TMPDIR=/tmp} ; + { tmp=`(umask 077 && mktemp -d "$TMPDIR/cgXXXXXX") 2>/dev/null` && test -n "$tmp" && test -d "$tmp" ; } || + { test -n "$RANDOM" && tmp=$TMPDIR/cg$$-$RANDOM && (umask 077 && mkdir $tmp) ; } || + { tmp=$TMPDIR/cg-$$ && (umask 077 && mkdir $tmp) && echo "Warning: creating insecure temp directory" >&2 ; } || + { echo "$me: cannot create a temporary directory in $TMPDIR" >&2 ; exit 1 ; } ; +dummy=$tmp/dummy ; +tmpfiles="$dummy.c $dummy.o $dummy.rel $dummy" ; +case $CC_FOR_BUILD,$HOST_CC,$CC in + ,,) echo "int x;" > $dummy.c ; + for c in cc gcc c89 c99 ; do + if ($c -c -o $dummy.o $dummy.c) >/dev/null 2>&1 ; then + CC_FOR_BUILD="$c"; break ; + fi ; + done ; + if test x"$CC_FOR_BUILD" = x ; then + CC_FOR_BUILD=no_compiler_found ; + fi + ;; + ,,*) CC_FOR_BUILD=$CC ;; + ,*,*) CC_FOR_BUILD=$HOST_CC ;; +esac ; set_cc_for_build= ;' + +# This is needed to find uname on a Pyramid OSx when run in the BSD universe. +# (ghazi@noc.rutgers.edu 1994-08-24) +if (test -f /.attbin/uname) >/dev/null 2>&1 ; then + PATH=$PATH:/.attbin ; export PATH +fi + +UNAME_MACHINE=`(uname -m) 2>/dev/null` || UNAME_MACHINE=unknown +UNAME_RELEASE=`(uname -r) 2>/dev/null` || UNAME_RELEASE=unknown +UNAME_SYSTEM=`(uname -s) 2>/dev/null` || UNAME_SYSTEM=unknown +UNAME_VERSION=`(uname -v) 2>/dev/null` || UNAME_VERSION=unknown + +case "${UNAME_SYSTEM}" in +Linux|GNU|GNU/*) + # If the system lacks a compiler, then just pick glibc. + # We could probably try harder. + LIBC=gnu + + eval $set_cc_for_build + cat <<-EOF > $dummy.c + #include + #if defined(__UCLIBC__) + LIBC=uclibc + #elif defined(__dietlibc__) + LIBC=dietlibc + #else + LIBC=gnu + #endif + EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^LIBC' | sed 's, ,,g'` + ;; +esac + +# Note: order is significant - the case branches are not exclusive. + +case "${UNAME_MACHINE}:${UNAME_SYSTEM}:${UNAME_RELEASE}:${UNAME_VERSION}" in + *:NetBSD:*:*) + # NetBSD (nbsd) targets should (where applicable) match one or + # more of the tuples: *-*-netbsdelf*, *-*-netbsdaout*, + # *-*-netbsdecoff* and *-*-netbsd*. For targets that recently + # switched to ELF, *-*-netbsd* would select the old + # object file format. This provides both forward + # compatibility and a consistent mechanism for selecting the + # object file format. + # + # Note: NetBSD doesn't particularly care about the vendor + # portion of the name. We always set it to "unknown". + sysctl="sysctl -n hw.machine_arch" + UNAME_MACHINE_ARCH=`(/sbin/$sysctl 2>/dev/null || \ + /usr/sbin/$sysctl 2>/dev/null || echo unknown)` + case "${UNAME_MACHINE_ARCH}" in + armeb) machine=armeb-unknown ;; + arm*) machine=arm-unknown ;; + sh3el) machine=shl-unknown ;; + sh3eb) machine=sh-unknown ;; + sh5el) machine=sh5le-unknown ;; + *) machine=${UNAME_MACHINE_ARCH}-unknown ;; + esac + # The Operating System including object format, if it has switched + # to ELF recently, or will in the future. + case "${UNAME_MACHINE_ARCH}" in + arm*|i386|m68k|ns32k|sh3*|sparc|vax) + eval $set_cc_for_build + if echo __ELF__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ELF__ + then + # Once all utilities can be ECOFF (netbsdecoff) or a.out (netbsdaout). + # Return netbsd for either. FIX? + os=netbsd + else + os=netbsdelf + fi + ;; + *) + os=netbsd + ;; + esac + # The OS release + # Debian GNU/NetBSD machines have a different userland, and + # thus, need a distinct triplet. However, they do not need + # kernel version information, so it can be replaced with a + # suitable tag, in the style of linux-gnu. + case "${UNAME_VERSION}" in + Debian*) + release='-gnu' + ;; + *) + release=`echo ${UNAME_RELEASE}|sed -e 's/[-_].*/\./'` + ;; + esac + # Since CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM: + # contains redundant information, the shorter form: + # CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM is used. + echo "${machine}-${os}${release}" + exit ;; + *:Bitrig:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/Bitrig.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-bitrig${UNAME_RELEASE} + exit ;; + *:OpenBSD:*:*) + UNAME_MACHINE_ARCH=`arch | sed 's/OpenBSD.//'` + echo ${UNAME_MACHINE_ARCH}-unknown-openbsd${UNAME_RELEASE} + exit ;; + *:ekkoBSD:*:*) + echo ${UNAME_MACHINE}-unknown-ekkobsd${UNAME_RELEASE} + exit ;; + *:SolidBSD:*:*) + echo ${UNAME_MACHINE}-unknown-solidbsd${UNAME_RELEASE} + exit ;; + macppc:MirBSD:*:*) + echo powerpc-unknown-mirbsd${UNAME_RELEASE} + exit ;; + *:MirBSD:*:*) + echo ${UNAME_MACHINE}-unknown-mirbsd${UNAME_RELEASE} + exit ;; + alpha:OSF1:*:*) + case $UNAME_RELEASE in + *4.0) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $3}'` + ;; + *5.*) + UNAME_RELEASE=`/usr/sbin/sizer -v | awk '{print $4}'` + ;; + esac + # According to Compaq, /usr/sbin/psrinfo has been available on + # OSF/1 and Tru64 systems produced since 1995. I hope that + # covers most systems running today. This code pipes the CPU + # types through head -n 1, so we only detect the type of CPU 0. + ALPHA_CPU_TYPE=`/usr/sbin/psrinfo -v | sed -n -e 's/^ The alpha \(.*\) processor.*$/\1/p' | head -n 1` + case "$ALPHA_CPU_TYPE" in + "EV4 (21064)") + UNAME_MACHINE="alpha" ;; + "EV4.5 (21064)") + UNAME_MACHINE="alpha" ;; + "LCA4 (21066/21068)") + UNAME_MACHINE="alpha" ;; + "EV5 (21164)") + UNAME_MACHINE="alphaev5" ;; + "EV5.6 (21164A)") + UNAME_MACHINE="alphaev56" ;; + "EV5.6 (21164PC)") + UNAME_MACHINE="alphapca56" ;; + "EV5.7 (21164PC)") + UNAME_MACHINE="alphapca57" ;; + "EV6 (21264)") + UNAME_MACHINE="alphaev6" ;; + "EV6.7 (21264A)") + UNAME_MACHINE="alphaev67" ;; + "EV6.8CB (21264C)") + UNAME_MACHINE="alphaev68" ;; + "EV6.8AL (21264B)") + UNAME_MACHINE="alphaev68" ;; + "EV6.8CX (21264D)") + UNAME_MACHINE="alphaev68" ;; + "EV6.9A (21264/EV69A)") + UNAME_MACHINE="alphaev69" ;; + "EV7 (21364)") + UNAME_MACHINE="alphaev7" ;; + "EV7.9 (21364A)") + UNAME_MACHINE="alphaev79" ;; + esac + # A Pn.n version is a patched version. + # A Vn.n version is a released version. + # A Tn.n version is a released field test version. + # A Xn.n version is an unreleased experimental baselevel. + # 1.2 uses "1.2" for uname -r. + echo ${UNAME_MACHINE}-dec-osf`echo ${UNAME_RELEASE} | sed -e 's/^[PVTX]//' | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` + # Reset EXIT trap before exiting to avoid spurious non-zero exit code. + exitcode=$? + trap '' 0 + exit $exitcode ;; + Alpha\ *:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # Should we change UNAME_MACHINE based on the output of uname instead + # of the specific Alpha model? + echo alpha-pc-interix + exit ;; + 21064:Windows_NT:50:3) + echo alpha-dec-winnt3.5 + exit ;; + Amiga*:UNIX_System_V:4.0:*) + echo m68k-unknown-sysv4 + exit ;; + *:[Aa]miga[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-amigaos + exit ;; + *:[Mm]orph[Oo][Ss]:*:*) + echo ${UNAME_MACHINE}-unknown-morphos + exit ;; + *:OS/390:*:*) + echo i370-ibm-openedition + exit ;; + *:z/VM:*:*) + echo s390-ibm-zvmoe + exit ;; + *:OS400:*:*) + echo powerpc-ibm-os400 + exit ;; + arm:RISC*:1.[012]*:*|arm:riscix:1.[012]*:*) + echo arm-acorn-riscix${UNAME_RELEASE} + exit ;; + arm*:riscos:*:*|arm*:RISCOS:*:*) + echo arm-unknown-riscos + exit ;; + SR2?01:HI-UX/MPP:*:* | SR8000:HI-UX/MPP:*:*) + echo hppa1.1-hitachi-hiuxmpp + exit ;; + Pyramid*:OSx*:*:* | MIS*:OSx*:*:* | MIS*:SMP_DC-OSx*:*:*) + # akee@wpdis03.wpafb.af.mil (Earle F. Ake) contributed MIS and NILE. + if test "`(/bin/universe) 2>/dev/null`" = att ; then + echo pyramid-pyramid-sysv3 + else + echo pyramid-pyramid-bsd + fi + exit ;; + NILE*:*:*:dcosx) + echo pyramid-pyramid-svr4 + exit ;; + DRS?6000:unix:4.0:6*) + echo sparc-icl-nx6 + exit ;; + DRS?6000:UNIX_SV:4.2*:7* | DRS?6000:isis:4.2*:7*) + case `/usr/bin/uname -p` in + sparc) echo sparc-icl-nx7; exit ;; + esac ;; + s390x:SunOS:*:*) + echo ${UNAME_MACHINE}-ibm-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4H:SunOS:5.*:*) + echo sparc-hal-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4*:SunOS:5.*:* | tadpole*:SunOS:5.*:*) + echo sparc-sun-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + i86pc:AuroraUX:5.*:* | i86xen:AuroraUX:5.*:*) + echo i386-pc-auroraux${UNAME_RELEASE} + exit ;; + i86pc:SunOS:5.*:* | i86xen:SunOS:5.*:*) + eval $set_cc_for_build + SUN_ARCH="i386" + # If there is a compiler, see if it is configured for 64-bit objects. + # Note that the Sun cc does not turn __LP64__ into 1 like gcc does. + # This test works for both compilers. + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __amd64'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + SUN_ARCH="x86_64" + fi + fi + echo ${SUN_ARCH}-pc-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4*:SunOS:6*:*) + # According to config.sub, this is the proper way to canonicalize + # SunOS6. Hard to guess exactly what SunOS6 will be like, but + # it's likely to be more like Solaris than SunOS4. + echo sparc-sun-solaris3`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + sun4*:SunOS:*:*) + case "`/usr/bin/arch -k`" in + Series*|S4*) + UNAME_RELEASE=`uname -v` + ;; + esac + # Japanese Language versions have a version number like `4.1.3-JL'. + echo sparc-sun-sunos`echo ${UNAME_RELEASE}|sed -e 's/-/_/'` + exit ;; + sun3*:SunOS:*:*) + echo m68k-sun-sunos${UNAME_RELEASE} + exit ;; + sun*:*:4.2BSD:*) + UNAME_RELEASE=`(sed 1q /etc/motd | awk '{print substr($5,1,3)}') 2>/dev/null` + test "x${UNAME_RELEASE}" = "x" && UNAME_RELEASE=3 + case "`/bin/arch`" in + sun3) + echo m68k-sun-sunos${UNAME_RELEASE} + ;; + sun4) + echo sparc-sun-sunos${UNAME_RELEASE} + ;; + esac + exit ;; + aushp:SunOS:*:*) + echo sparc-auspex-sunos${UNAME_RELEASE} + exit ;; + # The situation for MiNT is a little confusing. The machine name + # can be virtually everything (everything which is not + # "atarist" or "atariste" at least should have a processor + # > m68000). The system name ranges from "MiNT" over "FreeMiNT" + # to the lowercase version "mint" (or "freemint"). Finally + # the system name "TOS" denotes a system which is actually not + # MiNT. But MiNT is downward compatible to TOS, so this should + # be no problem. + atarist[e]:*MiNT:*:* | atarist[e]:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; + atari*:*MiNT:*:* | atari*:*mint:*:* | atarist[e]:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; + *falcon*:*MiNT:*:* | *falcon*:*mint:*:* | *falcon*:*TOS:*:*) + echo m68k-atari-mint${UNAME_RELEASE} + exit ;; + milan*:*MiNT:*:* | milan*:*mint:*:* | *milan*:*TOS:*:*) + echo m68k-milan-mint${UNAME_RELEASE} + exit ;; + hades*:*MiNT:*:* | hades*:*mint:*:* | *hades*:*TOS:*:*) + echo m68k-hades-mint${UNAME_RELEASE} + exit ;; + *:*MiNT:*:* | *:*mint:*:* | *:*TOS:*:*) + echo m68k-unknown-mint${UNAME_RELEASE} + exit ;; + m68k:machten:*:*) + echo m68k-apple-machten${UNAME_RELEASE} + exit ;; + powerpc:machten:*:*) + echo powerpc-apple-machten${UNAME_RELEASE} + exit ;; + RISC*:Mach:*:*) + echo mips-dec-mach_bsd4.3 + exit ;; + RISC*:ULTRIX:*:*) + echo mips-dec-ultrix${UNAME_RELEASE} + exit ;; + VAX*:ULTRIX*:*:*) + echo vax-dec-ultrix${UNAME_RELEASE} + exit ;; + 2020:CLIX:*:* | 2430:CLIX:*:*) + echo clipper-intergraph-clix${UNAME_RELEASE} + exit ;; + mips:*:*:UMIPS | mips:*:*:RISCos) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c +#ifdef __cplusplus +#include /* for printf() prototype */ + int main (int argc, char *argv[]) { +#else + int main (argc, argv) int argc; char *argv[]; { +#endif + #if defined (host_mips) && defined (MIPSEB) + #if defined (SYSTYPE_SYSV) + printf ("mips-mips-riscos%ssysv\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_SVR4) + printf ("mips-mips-riscos%ssvr4\n", argv[1]); exit (0); + #endif + #if defined (SYSTYPE_BSD43) || defined(SYSTYPE_BSD) + printf ("mips-mips-riscos%sbsd\n", argv[1]); exit (0); + #endif + #endif + exit (-1); + } +EOF + $CC_FOR_BUILD -o $dummy $dummy.c && + dummyarg=`echo "${UNAME_RELEASE}" | sed -n 's/\([0-9]*\).*/\1/p'` && + SYSTEM_NAME=`$dummy $dummyarg` && + { echo "$SYSTEM_NAME"; exit; } + echo mips-mips-riscos${UNAME_RELEASE} + exit ;; + Motorola:PowerMAX_OS:*:*) + echo powerpc-motorola-powermax + exit ;; + Motorola:*:4.3:PL8-*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:*:*:PowerMAX_OS | Synergy:PowerMAX_OS:*:*) + echo powerpc-harris-powermax + exit ;; + Night_Hawk:Power_UNIX:*:*) + echo powerpc-harris-powerunix + exit ;; + m88k:CX/UX:7*:*) + echo m88k-harris-cxux7 + exit ;; + m88k:*:4*:R4*) + echo m88k-motorola-sysv4 + exit ;; + m88k:*:3*:R3*) + echo m88k-motorola-sysv3 + exit ;; + AViiON:dgux:*:*) + # DG/UX returns AViiON for all architectures + UNAME_PROCESSOR=`/usr/bin/uname -p` + if [ $UNAME_PROCESSOR = mc88100 ] || [ $UNAME_PROCESSOR = mc88110 ] + then + if [ ${TARGET_BINARY_INTERFACE}x = m88kdguxelfx ] || \ + [ ${TARGET_BINARY_INTERFACE}x = x ] + then + echo m88k-dg-dgux${UNAME_RELEASE} + else + echo m88k-dg-dguxbcs${UNAME_RELEASE} + fi + else + echo i586-dg-dgux${UNAME_RELEASE} + fi + exit ;; + M88*:DolphinOS:*:*) # DolphinOS (SVR3) + echo m88k-dolphin-sysv3 + exit ;; + M88*:*:R3*:*) + # Delta 88k system running SVR3 + echo m88k-motorola-sysv3 + exit ;; + XD88*:*:*:*) # Tektronix XD88 system running UTekV (SVR3) + echo m88k-tektronix-sysv3 + exit ;; + Tek43[0-9][0-9]:UTek:*:*) # Tektronix 4300 system running UTek (BSD) + echo m68k-tektronix-bsd + exit ;; + *:IRIX*:*:*) + echo mips-sgi-irix`echo ${UNAME_RELEASE}|sed -e 's/-/_/g'` + exit ;; + ????????:AIX?:[12].1:2) # AIX 2.2.1 or AIX 2.1.1 is RT/PC AIX. + echo romp-ibm-aix # uname -m gives an 8 hex-code CPU id + exit ;; # Note that: echo "'`uname -s`'" gives 'AIX ' + i*86:AIX:*:*) + echo i386-ibm-aix + exit ;; + ia64:AIX:*:*) + if [ -x /usr/bin/oslevel ] ; then + IBM_REV=`/usr/bin/oslevel` + else + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${UNAME_MACHINE}-ibm-aix${IBM_REV} + exit ;; + *:AIX:2:3) + if grep bos325 /usr/include/stdio.h >/dev/null 2>&1; then + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include + + main() + { + if (!__power_pc()) + exit(1); + puts("powerpc-ibm-aix3.2.5"); + exit(0); + } +EOF + if $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` + then + echo "$SYSTEM_NAME" + else + echo rs6000-ibm-aix3.2.5 + fi + elif grep bos324 /usr/include/stdio.h >/dev/null 2>&1; then + echo rs6000-ibm-aix3.2.4 + else + echo rs6000-ibm-aix3.2 + fi + exit ;; + *:AIX:*:[4567]) + IBM_CPU_ID=`/usr/sbin/lsdev -C -c processor -S available | sed 1q | awk '{ print $1 }'` + if /usr/sbin/lsattr -El ${IBM_CPU_ID} | grep ' POWER' >/dev/null 2>&1; then + IBM_ARCH=rs6000 + else + IBM_ARCH=powerpc + fi + if [ -x /usr/bin/lslpp ] ; then + IBM_REV=`/usr/bin/lslpp -Lqc bos.rte.libc | + awk -F: '{ print $3 }' | sed s/[0-9]*$/0/` + else + IBM_REV=${UNAME_VERSION}.${UNAME_RELEASE} + fi + echo ${IBM_ARCH}-ibm-aix${IBM_REV} + exit ;; + *:AIX:*:*) + echo rs6000-ibm-aix + exit ;; + ibmrt:4.4BSD:*|romp-ibm:BSD:*) + echo romp-ibm-bsd4.4 + exit ;; + ibmrt:*BSD:*|romp-ibm:BSD:*) # covers RT/PC BSD and + echo romp-ibm-bsd${UNAME_RELEASE} # 4.3 with uname added to + exit ;; # report: romp-ibm BSD 4.3 + *:BOSX:*:*) + echo rs6000-bull-bosx + exit ;; + DPX/2?00:B.O.S.:*:*) + echo m68k-bull-sysv3 + exit ;; + 9000/[34]??:4.3bsd:1.*:*) + echo m68k-hp-bsd + exit ;; + hp300:4.4BSD:*:* | 9000/[34]??:4.3bsd:2.*:*) + echo m68k-hp-bsd4.4 + exit ;; + 9000/[34678]??:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + case "${UNAME_MACHINE}" in + 9000/31? ) HP_ARCH=m68000 ;; + 9000/[34]?? ) HP_ARCH=m68k ;; + 9000/[678][0-9][0-9]) + if [ -x /usr/bin/getconf ]; then + sc_cpu_version=`/usr/bin/getconf SC_CPU_VERSION 2>/dev/null` + sc_kernel_bits=`/usr/bin/getconf SC_KERNEL_BITS 2>/dev/null` + case "${sc_cpu_version}" in + 523) HP_ARCH="hppa1.0" ;; # CPU_PA_RISC1_0 + 528) HP_ARCH="hppa1.1" ;; # CPU_PA_RISC1_1 + 532) # CPU_PA_RISC2_0 + case "${sc_kernel_bits}" in + 32) HP_ARCH="hppa2.0n" ;; + 64) HP_ARCH="hppa2.0w" ;; + '') HP_ARCH="hppa2.0" ;; # HP-UX 10.20 + esac ;; + esac + fi + if [ "${HP_ARCH}" = "" ]; then + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + + #define _HPUX_SOURCE + #include + #include + + int main () + { + #if defined(_SC_KERNEL_BITS) + long bits = sysconf(_SC_KERNEL_BITS); + #endif + long cpu = sysconf (_SC_CPU_VERSION); + + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1"); break; + case CPU_PA_RISC2_0: + #if defined(_SC_KERNEL_BITS) + switch (bits) + { + case 64: puts ("hppa2.0w"); break; + case 32: puts ("hppa2.0n"); break; + default: puts ("hppa2.0"); break; + } break; + #else /* !defined(_SC_KERNEL_BITS) */ + puts ("hppa2.0"); break; + #endif + default: puts ("hppa1.0"); break; + } + exit (0); + } +EOF + (CCOPTS= $CC_FOR_BUILD -o $dummy $dummy.c 2>/dev/null) && HP_ARCH=`$dummy` + test -z "$HP_ARCH" && HP_ARCH=hppa + fi ;; + esac + if [ ${HP_ARCH} = "hppa2.0w" ] + then + eval $set_cc_for_build + + # hppa2.0w-hp-hpux* has a 64-bit kernel and a compiler generating + # 32-bit code. hppa64-hp-hpux* has the same kernel and a compiler + # generating 64-bit code. GNU and HP use different nomenclature: + # + # $ CC_FOR_BUILD=cc ./config.guess + # => hppa2.0w-hp-hpux11.23 + # $ CC_FOR_BUILD="cc +DA2.0w" ./config.guess + # => hppa64-hp-hpux11.23 + + if echo __LP64__ | (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | + grep -q __LP64__ + then + HP_ARCH="hppa2.0w" + else + HP_ARCH="hppa64" + fi + fi + echo ${HP_ARCH}-hp-hpux${HPUX_REV} + exit ;; + ia64:HP-UX:*:*) + HPUX_REV=`echo ${UNAME_RELEASE}|sed -e 's/[^.]*.[0B]*//'` + echo ia64-hp-hpux${HPUX_REV} + exit ;; + 3050*:HI-UX:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #include + int + main () + { + long cpu = sysconf (_SC_CPU_VERSION); + /* The order matters, because CPU_IS_HP_MC68K erroneously returns + true for CPU_PA_RISC1_0. CPU_IS_PA_RISC returns correct + results, however. */ + if (CPU_IS_PA_RISC (cpu)) + { + switch (cpu) + { + case CPU_PA_RISC1_0: puts ("hppa1.0-hitachi-hiuxwe2"); break; + case CPU_PA_RISC1_1: puts ("hppa1.1-hitachi-hiuxwe2"); break; + case CPU_PA_RISC2_0: puts ("hppa2.0-hitachi-hiuxwe2"); break; + default: puts ("hppa-hitachi-hiuxwe2"); break; + } + } + else if (CPU_IS_HP_MC68K (cpu)) + puts ("m68k-hitachi-hiuxwe2"); + else puts ("unknown-hitachi-hiuxwe2"); + exit (0); + } +EOF + $CC_FOR_BUILD -o $dummy $dummy.c && SYSTEM_NAME=`$dummy` && + { echo "$SYSTEM_NAME"; exit; } + echo unknown-hitachi-hiuxwe2 + exit ;; + 9000/7??:4.3bsd:*:* | 9000/8?[79]:4.3bsd:*:* ) + echo hppa1.1-hp-bsd + exit ;; + 9000/8??:4.3bsd:*:*) + echo hppa1.0-hp-bsd + exit ;; + *9??*:MPE/iX:*:* | *3000*:MPE/iX:*:*) + echo hppa1.0-hp-mpeix + exit ;; + hp7??:OSF1:*:* | hp8?[79]:OSF1:*:* ) + echo hppa1.1-hp-osf + exit ;; + hp8??:OSF1:*:*) + echo hppa1.0-hp-osf + exit ;; + i*86:OSF1:*:*) + if [ -x /usr/sbin/sysversion ] ; then + echo ${UNAME_MACHINE}-unknown-osf1mk + else + echo ${UNAME_MACHINE}-unknown-osf1 + fi + exit ;; + parisc*:Lites*:*:*) + echo hppa1.1-hp-lites + exit ;; + C1*:ConvexOS:*:* | convex:ConvexOS:C1*:*) + echo c1-convex-bsd + exit ;; + C2*:ConvexOS:*:* | convex:ConvexOS:C2*:*) + if getsysinfo -f scalar_acc + then echo c32-convex-bsd + else echo c2-convex-bsd + fi + exit ;; + C34*:ConvexOS:*:* | convex:ConvexOS:C34*:*) + echo c34-convex-bsd + exit ;; + C38*:ConvexOS:*:* | convex:ConvexOS:C38*:*) + echo c38-convex-bsd + exit ;; + C4*:ConvexOS:*:* | convex:ConvexOS:C4*:*) + echo c4-convex-bsd + exit ;; + CRAY*Y-MP:*:*:*) + echo ymp-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*[A-Z]90:*:*:*) + echo ${UNAME_MACHINE}-cray-unicos${UNAME_RELEASE} \ + | sed -e 's/CRAY.*\([A-Z]90\)/\1/' \ + -e y/ABCDEFGHIJKLMNOPQRSTUVWXYZ/abcdefghijklmnopqrstuvwxyz/ \ + -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*TS:*:*:*) + echo t90-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*T3E:*:*:*) + echo alphaev5-cray-unicosmk${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + CRAY*SV1:*:*:*) + echo sv1-cray-unicos${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + *:UNICOS/mp:*:*) + echo craynv-cray-unicosmp${UNAME_RELEASE} | sed -e 's/\.[^.]*$/.X/' + exit ;; + F30[01]:UNIX_System_V:*:* | F700:UNIX_System_V:*:*) + FUJITSU_PROC=`uname -m | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz'` + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | sed -e 's/ /_/'` + echo "${FUJITSU_PROC}-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + 5000:UNIX_System_V:4.*:*) + FUJITSU_SYS=`uname -p | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/\///'` + FUJITSU_REL=`echo ${UNAME_RELEASE} | tr 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' 'abcdefghijklmnopqrstuvwxyz' | sed -e 's/ /_/'` + echo "sparc-fujitsu-${FUJITSU_SYS}${FUJITSU_REL}" + exit ;; + i*86:BSD/386:*:* | i*86:BSD/OS:*:* | *:Ascend\ Embedded/OS:*:*) + echo ${UNAME_MACHINE}-pc-bsdi${UNAME_RELEASE} + exit ;; + sparc*:BSD/OS:*:*) + echo sparc-unknown-bsdi${UNAME_RELEASE} + exit ;; + *:BSD/OS:*:*) + echo ${UNAME_MACHINE}-unknown-bsdi${UNAME_RELEASE} + exit ;; + *:FreeBSD:*:*) + UNAME_PROCESSOR=`/usr/bin/uname -p` + case ${UNAME_PROCESSOR} in + amd64) + echo x86_64-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + *) + echo ${UNAME_PROCESSOR}-unknown-freebsd`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` ;; + esac + exit ;; + i*:CYGWIN*:*) + echo ${UNAME_MACHINE}-pc-cygwin + exit ;; + *:MINGW64*:*) + echo ${UNAME_MACHINE}-pc-mingw64 + exit ;; + *:MINGW*:*) + echo ${UNAME_MACHINE}-pc-mingw32 + exit ;; + *:MSYS*:*) + echo ${UNAME_MACHINE}-pc-msys + exit ;; + i*:windows32*:*) + # uname -m includes "-pc" on this system. + echo ${UNAME_MACHINE}-mingw32 + exit ;; + i*:PW*:*) + echo ${UNAME_MACHINE}-pc-pw32 + exit ;; + *:Interix*:*) + case ${UNAME_MACHINE} in + x86) + echo i586-pc-interix${UNAME_RELEASE} + exit ;; + authenticamd | genuineintel | EM64T) + echo x86_64-unknown-interix${UNAME_RELEASE} + exit ;; + IA64) + echo ia64-unknown-interix${UNAME_RELEASE} + exit ;; + esac ;; + [345]86:Windows_95:* | [345]86:Windows_98:* | [345]86:Windows_NT:*) + echo i${UNAME_MACHINE}-pc-mks + exit ;; + 8664:Windows_NT:*) + echo x86_64-pc-mks + exit ;; + i*:Windows_NT*:* | Pentium*:Windows_NT*:*) + # How do we know it's Interix rather than the generic POSIX subsystem? + # It also conflicts with pre-2.0 versions of AT&T UWIN. Should we + # UNAME_MACHINE based on the output of uname instead of i386? + echo i586-pc-interix + exit ;; + i*:UWIN*:*) + echo ${UNAME_MACHINE}-pc-uwin + exit ;; + amd64:CYGWIN*:*:* | x86_64:CYGWIN*:*:*) + echo x86_64-unknown-cygwin + exit ;; + p*:CYGWIN*:*) + echo powerpcle-unknown-cygwin + exit ;; + prep*:SunOS:5.*:*) + echo powerpcle-unknown-solaris2`echo ${UNAME_RELEASE}|sed -e 's/[^.]*//'` + exit ;; + *:GNU:*:*) + # the GNU system + echo `echo ${UNAME_MACHINE}|sed -e 's,[-/].*$,,'`-unknown-${LIBC}`echo ${UNAME_RELEASE}|sed -e 's,/.*$,,'` + exit ;; + *:GNU/*:*:*) + # other systems with GNU libc and userland + echo ${UNAME_MACHINE}-unknown-`echo ${UNAME_SYSTEM} | sed 's,^[^/]*/,,' | tr '[A-Z]' '[a-z]'``echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'`-${LIBC} + exit ;; + i*86:Minix:*:*) + echo ${UNAME_MACHINE}-pc-minix + exit ;; + aarch64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + aarch64_be:Linux:*:*) + UNAME_MACHINE=aarch64_be + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + alpha:Linux:*:*) + case `sed -n '/^cpu model/s/^.*: \(.*\)/\1/p' < /proc/cpuinfo` in + EV5) UNAME_MACHINE=alphaev5 ;; + EV56) UNAME_MACHINE=alphaev56 ;; + PCA56) UNAME_MACHINE=alphapca56 ;; + PCA57) UNAME_MACHINE=alphapca56 ;; + EV6) UNAME_MACHINE=alphaev6 ;; + EV67) UNAME_MACHINE=alphaev67 ;; + EV68*) UNAME_MACHINE=alphaev68 ;; + esac + objdump --private-headers /bin/sh | grep -q ld.so.1 + if test "$?" = 0 ; then LIBC="gnulibc1" ; fi + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + arc:Linux:*:* | arceb:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + arm*:Linux:*:*) + eval $set_cc_for_build + if echo __ARM_EABI__ | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_EABI__ + then + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + else + if echo __ARM_PCS_VFP | $CC_FOR_BUILD -E - 2>/dev/null \ + | grep -q __ARM_PCS_VFP + then + echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabi + else + echo ${UNAME_MACHINE}-unknown-linux-${LIBC}eabihf + fi + fi + exit ;; + avr32*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + cris:Linux:*:*) + echo ${UNAME_MACHINE}-axis-linux-${LIBC} + exit ;; + crisv32:Linux:*:*) + echo ${UNAME_MACHINE}-axis-linux-${LIBC} + exit ;; + frv:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + hexagon:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + i*86:Linux:*:*) + echo ${UNAME_MACHINE}-pc-linux-${LIBC} + exit ;; + ia64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + m32r*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + m68*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + mips:Linux:*:* | mips64:Linux:*:*) + eval $set_cc_for_build + sed 's/^ //' << EOF >$dummy.c + #undef CPU + #undef ${UNAME_MACHINE} + #undef ${UNAME_MACHINE}el + #if defined(__MIPSEL__) || defined(__MIPSEL) || defined(_MIPSEL) || defined(MIPSEL) + CPU=${UNAME_MACHINE}el + #else + #if defined(__MIPSEB__) || defined(__MIPSEB) || defined(_MIPSEB) || defined(MIPSEB) + CPU=${UNAME_MACHINE} + #else + CPU= + #endif + #endif +EOF + eval `$CC_FOR_BUILD -E $dummy.c 2>/dev/null | grep '^CPU'` + test x"${CPU}" != x && { echo "${CPU}-unknown-linux-${LIBC}"; exit; } + ;; + openrisc*:Linux:*:*) + echo or1k-unknown-linux-${LIBC} + exit ;; + or32:Linux:*:* | or1k*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + padre:Linux:*:*) + echo sparc-unknown-linux-${LIBC} + exit ;; + parisc64:Linux:*:* | hppa64:Linux:*:*) + echo hppa64-unknown-linux-${LIBC} + exit ;; + parisc:Linux:*:* | hppa:Linux:*:*) + # Look for CPU level + case `grep '^cpu[^a-z]*:' /proc/cpuinfo 2>/dev/null | cut -d' ' -f2` in + PA7*) echo hppa1.1-unknown-linux-${LIBC} ;; + PA8*) echo hppa2.0-unknown-linux-${LIBC} ;; + *) echo hppa-unknown-linux-${LIBC} ;; + esac + exit ;; + ppc64:Linux:*:*) + echo powerpc64-unknown-linux-${LIBC} + exit ;; + ppc:Linux:*:*) + echo powerpc-unknown-linux-${LIBC} + exit ;; + ppc64le:Linux:*:*) + echo powerpc64le-unknown-linux-${LIBC} + exit ;; + ppcle:Linux:*:*) + echo powerpcle-unknown-linux-${LIBC} + exit ;; + s390:Linux:*:* | s390x:Linux:*:*) + echo ${UNAME_MACHINE}-ibm-linux-${LIBC} + exit ;; + sh64*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + sh*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + sparc:Linux:*:* | sparc64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + tile*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + vax:Linux:*:*) + echo ${UNAME_MACHINE}-dec-linux-${LIBC} + exit ;; + x86_64:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + xtensa*:Linux:*:*) + echo ${UNAME_MACHINE}-unknown-linux-${LIBC} + exit ;; + i*86:DYNIX/ptx:4*:*) + # ptx 4.0 does uname -s correctly, with DYNIX/ptx in there. + # earlier versions are messed up and put the nodename in both + # sysname and nodename. + echo i386-sequent-sysv4 + exit ;; + i*86:UNIX_SV:4.2MP:2.*) + # Unixware is an offshoot of SVR4, but it has its own version + # number series starting with 2... + # I am not positive that other SVR4 systems won't match this, + # I just have to hope. -- rms. + # Use sysv4.2uw... so that sysv4* matches it. + echo ${UNAME_MACHINE}-pc-sysv4.2uw${UNAME_VERSION} + exit ;; + i*86:OS/2:*:*) + # If we were able to find `uname', then EMX Unix compatibility + # is probably installed. + echo ${UNAME_MACHINE}-pc-os2-emx + exit ;; + i*86:XTS-300:*:STOP) + echo ${UNAME_MACHINE}-unknown-stop + exit ;; + i*86:atheos:*:*) + echo ${UNAME_MACHINE}-unknown-atheos + exit ;; + i*86:syllable:*:*) + echo ${UNAME_MACHINE}-pc-syllable + exit ;; + i*86:LynxOS:2.*:* | i*86:LynxOS:3.[01]*:* | i*86:LynxOS:4.[02]*:*) + echo i386-unknown-lynxos${UNAME_RELEASE} + exit ;; + i*86:*DOS:*:*) + echo ${UNAME_MACHINE}-pc-msdosdjgpp + exit ;; + i*86:*:4.*:* | i*86:SYSTEM_V:4.*:*) + UNAME_REL=`echo ${UNAME_RELEASE} | sed 's/\/MP$//'` + if grep Novell /usr/include/link.h >/dev/null 2>/dev/null; then + echo ${UNAME_MACHINE}-univel-sysv${UNAME_REL} + else + echo ${UNAME_MACHINE}-pc-sysv${UNAME_REL} + fi + exit ;; + i*86:*:5:[678]*) + # UnixWare 7.x, OpenUNIX and OpenServer 6. + case `/bin/uname -X | grep "^Machine"` in + *486*) UNAME_MACHINE=i486 ;; + *Pentium) UNAME_MACHINE=i586 ;; + *Pent*|*Celeron) UNAME_MACHINE=i686 ;; + esac + echo ${UNAME_MACHINE}-unknown-sysv${UNAME_RELEASE}${UNAME_SYSTEM}${UNAME_VERSION} + exit ;; + i*86:*:3.2:*) + if test -f /usr/options/cb.name; then + UNAME_REL=`sed -n 's/.*Version //p' /dev/null >/dev/null ; then + UNAME_REL=`(/bin/uname -X|grep Release|sed -e 's/.*= //')` + (/bin/uname -X|grep i80486 >/dev/null) && UNAME_MACHINE=i486 + (/bin/uname -X|grep '^Machine.*Pentium' >/dev/null) \ + && UNAME_MACHINE=i586 + (/bin/uname -X|grep '^Machine.*Pent *II' >/dev/null) \ + && UNAME_MACHINE=i686 + (/bin/uname -X|grep '^Machine.*Pentium Pro' >/dev/null) \ + && UNAME_MACHINE=i686 + echo ${UNAME_MACHINE}-pc-sco$UNAME_REL + else + echo ${UNAME_MACHINE}-pc-sysv32 + fi + exit ;; + pc:*:*:*) + # Left here for compatibility: + # uname -m prints for DJGPP always 'pc', but it prints nothing about + # the processor, so we play safe by assuming i586. + # Note: whatever this is, it MUST be the same as what config.sub + # prints for the "djgpp" host, or else GDB configury will decide that + # this is a cross-build. + echo i586-pc-msdosdjgpp + exit ;; + Intel:Mach:3*:*) + echo i386-pc-mach3 + exit ;; + paragon:*:*:*) + echo i860-intel-osf1 + exit ;; + i860:*:4.*:*) # i860-SVR4 + if grep Stardent /usr/include/sys/uadmin.h >/dev/null 2>&1 ; then + echo i860-stardent-sysv${UNAME_RELEASE} # Stardent Vistra i860-SVR4 + else # Add other i860-SVR4 vendors below as they are discovered. + echo i860-unknown-sysv${UNAME_RELEASE} # Unknown i860-SVR4 + fi + exit ;; + mini*:CTIX:SYS*5:*) + # "miniframe" + echo m68010-convergent-sysv + exit ;; + mc68k:UNIX:SYSTEM5:3.51m) + echo m68k-convergent-sysv + exit ;; + M680?0:D-NIX:5.3:*) + echo m68k-diab-dnix + exit ;; + M68*:*:R3V[5678]*:*) + test -r /sysV68 && { echo 'm68k-motorola-sysv'; exit; } ;; + 3[345]??:*:4.0:3.0 | 3[34]??A:*:4.0:3.0 | 3[34]??,*:*:4.0:3.0 | 3[34]??/*:*:4.0:3.0 | 4400:*:4.0:3.0 | 4850:*:4.0:3.0 | SKA40:*:4.0:3.0 | SDS2:*:4.0:3.0 | SHG2:*:4.0:3.0 | S7501*:*:4.0:3.0) + OS_REL='' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; + 3[34]??:*:4.0:* | 3[34]??,*:*:4.0:*) + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4; exit; } ;; + NCR*:*:4.2:* | MPRAS*:*:4.2:*) + OS_REL='.3' + test -r /etc/.relid \ + && OS_REL=.`sed -n 's/[^ ]* [^ ]* \([0-9][0-9]\).*/\1/p' < /etc/.relid` + /bin/uname -p 2>/dev/null | grep 86 >/dev/null \ + && { echo i486-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep entium >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } + /bin/uname -p 2>/dev/null | /bin/grep pteron >/dev/null \ + && { echo i586-ncr-sysv4.3${OS_REL}; exit; } ;; + m68*:LynxOS:2.*:* | m68*:LynxOS:3.0*:*) + echo m68k-unknown-lynxos${UNAME_RELEASE} + exit ;; + mc68030:UNIX_System_V:4.*:*) + echo m68k-atari-sysv4 + exit ;; + TSUNAMI:LynxOS:2.*:*) + echo sparc-unknown-lynxos${UNAME_RELEASE} + exit ;; + rs6000:LynxOS:2.*:*) + echo rs6000-unknown-lynxos${UNAME_RELEASE} + exit ;; + PowerPC:LynxOS:2.*:* | PowerPC:LynxOS:3.[01]*:* | PowerPC:LynxOS:4.[02]*:*) + echo powerpc-unknown-lynxos${UNAME_RELEASE} + exit ;; + SM[BE]S:UNIX_SV:*:*) + echo mips-dde-sysv${UNAME_RELEASE} + exit ;; + RM*:ReliantUNIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + RM*:SINIX-*:*:*) + echo mips-sni-sysv4 + exit ;; + *:SINIX-*:*:*) + if uname -p 2>/dev/null >/dev/null ; then + UNAME_MACHINE=`(uname -p) 2>/dev/null` + echo ${UNAME_MACHINE}-sni-sysv4 + else + echo ns32k-sni-sysv + fi + exit ;; + PENTIUM:*:4.0*:*) # Unisys `ClearPath HMP IX 4000' SVR4/MP effort + # says + echo i586-unisys-sysv4 + exit ;; + *:UNIX_System_V:4*:FTX*) + # From Gerald Hewes . + # How about differentiating between stratus architectures? -djm + echo hppa1.1-stratus-sysv4 + exit ;; + *:*:*:FTX*) + # From seanf@swdc.stratus.com. + echo i860-stratus-sysv4 + exit ;; + i*86:VOS:*:*) + # From Paul.Green@stratus.com. + echo ${UNAME_MACHINE}-stratus-vos + exit ;; + *:VOS:*:*) + # From Paul.Green@stratus.com. + echo hppa1.1-stratus-vos + exit ;; + mc68*:A/UX:*:*) + echo m68k-apple-aux${UNAME_RELEASE} + exit ;; + news*:NEWS-OS:6*:*) + echo mips-sony-newsos6 + exit ;; + R[34]000:*System_V*:*:* | R4000:UNIX_SYSV:*:* | R*000:UNIX_SV:*:*) + if [ -d /usr/nec ]; then + echo mips-nec-sysv${UNAME_RELEASE} + else + echo mips-unknown-sysv${UNAME_RELEASE} + fi + exit ;; + BeBox:BeOS:*:*) # BeOS running on hardware made by Be, PPC only. + echo powerpc-be-beos + exit ;; + BeMac:BeOS:*:*) # BeOS running on Mac or Mac clone, PPC only. + echo powerpc-apple-beos + exit ;; + BePC:BeOS:*:*) # BeOS running on Intel PC compatible. + echo i586-pc-beos + exit ;; + BePC:Haiku:*:*) # Haiku running on Intel PC compatible. + echo i586-pc-haiku + exit ;; + x86_64:Haiku:*:*) + echo x86_64-unknown-haiku + exit ;; + SX-4:SUPER-UX:*:*) + echo sx4-nec-superux${UNAME_RELEASE} + exit ;; + SX-5:SUPER-UX:*:*) + echo sx5-nec-superux${UNAME_RELEASE} + exit ;; + SX-6:SUPER-UX:*:*) + echo sx6-nec-superux${UNAME_RELEASE} + exit ;; + SX-7:SUPER-UX:*:*) + echo sx7-nec-superux${UNAME_RELEASE} + exit ;; + SX-8:SUPER-UX:*:*) + echo sx8-nec-superux${UNAME_RELEASE} + exit ;; + SX-8R:SUPER-UX:*:*) + echo sx8r-nec-superux${UNAME_RELEASE} + exit ;; + Power*:Rhapsody:*:*) + echo powerpc-apple-rhapsody${UNAME_RELEASE} + exit ;; + *:Rhapsody:*:*) + echo ${UNAME_MACHINE}-apple-rhapsody${UNAME_RELEASE} + exit ;; + *:Darwin:*:*) + UNAME_PROCESSOR=`uname -p` || UNAME_PROCESSOR=unknown + eval $set_cc_for_build + if test "$UNAME_PROCESSOR" = unknown ; then + UNAME_PROCESSOR=powerpc + fi + if test `echo "$UNAME_RELEASE" | sed -e 's/\..*//'` -le 10 ; then + if [ "$CC_FOR_BUILD" != 'no_compiler_found' ]; then + if (echo '#ifdef __LP64__'; echo IS_64BIT_ARCH; echo '#endif') | \ + (CCOPTS= $CC_FOR_BUILD -E - 2>/dev/null) | \ + grep IS_64BIT_ARCH >/dev/null + then + case $UNAME_PROCESSOR in + i386) UNAME_PROCESSOR=x86_64 ;; + powerpc) UNAME_PROCESSOR=powerpc64 ;; + esac + fi + fi + elif test "$UNAME_PROCESSOR" = i386 ; then + # Avoid executing cc on OS X 10.9, as it ships with a stub + # that puts up a graphical alert prompting to install + # developer tools. Any system running Mac OS X 10.7 or + # later (Darwin 11 and later) is required to have a 64-bit + # processor. This is not true of the ARM version of Darwin + # that Apple uses in portable devices. + UNAME_PROCESSOR=x86_64 + fi + echo ${UNAME_PROCESSOR}-apple-darwin${UNAME_RELEASE} + exit ;; + *:procnto*:*:* | *:QNX:[0123456789]*:*) + UNAME_PROCESSOR=`uname -p` + if test "$UNAME_PROCESSOR" = "x86"; then + UNAME_PROCESSOR=i386 + UNAME_MACHINE=pc + fi + echo ${UNAME_PROCESSOR}-${UNAME_MACHINE}-nto-qnx${UNAME_RELEASE} + exit ;; + *:QNX:*:4*) + echo i386-pc-qnx + exit ;; + NEO-?:NONSTOP_KERNEL:*:*) + echo neo-tandem-nsk${UNAME_RELEASE} + exit ;; + NSE-*:NONSTOP_KERNEL:*:*) + echo nse-tandem-nsk${UNAME_RELEASE} + exit ;; + NSR-?:NONSTOP_KERNEL:*:*) + echo nsr-tandem-nsk${UNAME_RELEASE} + exit ;; + *:NonStop-UX:*:*) + echo mips-compaq-nonstopux + exit ;; + BS2000:POSIX*:*:*) + echo bs2000-siemens-sysv + exit ;; + DS/*:UNIX_System_V:*:*) + echo ${UNAME_MACHINE}-${UNAME_SYSTEM}-${UNAME_RELEASE} + exit ;; + *:Plan9:*:*) + # "uname -m" is not consistent, so use $cputype instead. 386 + # is converted to i386 for consistency with other x86 + # operating systems. + if test "$cputype" = "386"; then + UNAME_MACHINE=i386 + else + UNAME_MACHINE="$cputype" + fi + echo ${UNAME_MACHINE}-unknown-plan9 + exit ;; + *:TOPS-10:*:*) + echo pdp10-unknown-tops10 + exit ;; + *:TENEX:*:*) + echo pdp10-unknown-tenex + exit ;; + KS10:TOPS-20:*:* | KL10:TOPS-20:*:* | TYPE4:TOPS-20:*:*) + echo pdp10-dec-tops20 + exit ;; + XKL-1:TOPS-20:*:* | TYPE5:TOPS-20:*:*) + echo pdp10-xkl-tops20 + exit ;; + *:TOPS-20:*:*) + echo pdp10-unknown-tops20 + exit ;; + *:ITS:*:*) + echo pdp10-unknown-its + exit ;; + SEI:*:*:SEIUX) + echo mips-sei-seiux${UNAME_RELEASE} + exit ;; + *:DragonFly:*:*) + echo ${UNAME_MACHINE}-unknown-dragonfly`echo ${UNAME_RELEASE}|sed -e 's/[-(].*//'` + exit ;; + *:*VMS:*:*) + UNAME_MACHINE=`(uname -p) 2>/dev/null` + case "${UNAME_MACHINE}" in + A*) echo alpha-dec-vms ; exit ;; + I*) echo ia64-dec-vms ; exit ;; + V*) echo vax-dec-vms ; exit ;; + esac ;; + *:XENIX:*:SysV) + echo i386-pc-xenix + exit ;; + i*86:skyos:*:*) + echo ${UNAME_MACHINE}-pc-skyos`echo ${UNAME_RELEASE}` | sed -e 's/ .*$//' + exit ;; + i*86:rdos:*:*) + echo ${UNAME_MACHINE}-pc-rdos + exit ;; + i*86:AROS:*:*) + echo ${UNAME_MACHINE}-pc-aros + exit ;; + x86_64:VMkernel:*:*) + echo ${UNAME_MACHINE}-unknown-esx + exit ;; +esac + +cat >&2 < in order to provide the needed +information to handle your system. + +config.guess timestamp = $timestamp + +uname -m = `(uname -m) 2>/dev/null || echo unknown` +uname -r = `(uname -r) 2>/dev/null || echo unknown` +uname -s = `(uname -s) 2>/dev/null || echo unknown` +uname -v = `(uname -v) 2>/dev/null || echo unknown` + +/usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null` +/bin/uname -X = `(/bin/uname -X) 2>/dev/null` + +hostinfo = `(hostinfo) 2>/dev/null` +/bin/universe = `(/bin/universe) 2>/dev/null` +/usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null` +/bin/arch = `(/bin/arch) 2>/dev/null` +/usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null` +/usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null` + +UNAME_MACHINE = ${UNAME_MACHINE} +UNAME_RELEASE = ${UNAME_RELEASE} +UNAME_SYSTEM = ${UNAME_SYSTEM} +UNAME_VERSION = ${UNAME_VERSION} +EOF + +exit 1 + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: ADDED autosetup/config.sub Index: autosetup/config.sub ================================================================== --- /dev/null +++ autosetup/config.sub @@ -0,0 +1,1807 @@ +#! /bin/sh +# Configuration validation subroutine script. +# Copyright 1992-2014 Free Software Foundation, Inc. + +timestamp='2014-12-03' + +# This file is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, see . +# +# As a special exception to the GNU General Public License, if you +# distribute this file as part of a program that contains a +# configuration script generated by Autoconf, you may include it under +# the same distribution terms that you use for the rest of that +# program. This Exception is an additional permission under section 7 +# of the GNU General Public License, version 3 ("GPLv3"). + + +# Please send patches to . +# +# Configuration subroutine to validate and canonicalize a configuration type. +# Supply the specified configuration type as an argument. +# If it is invalid, we print an error message on stderr and exit with code 1. +# Otherwise, we print the canonical config type on stdout and succeed. + +# You can get the latest version of this script from: +# http://git.savannah.gnu.org/gitweb/?p=config.git;a=blob_plain;f=config.sub;hb=HEAD + +# This file is supposed to be the same for all GNU packages +# and recognize all the CPU types, system types and aliases +# that are meaningful with *any* GNU software. +# Each package is responsible for reporting which valid configurations +# it does not support. The user should be able to distinguish +# a failure to support a valid configuration from a meaningless +# configuration. + +# The goal of this file is to map all the various variations of a given +# machine specification into a single specification in the form: +# CPU_TYPE-MANUFACTURER-OPERATING_SYSTEM +# or in some cases, the newer four-part form: +# CPU_TYPE-MANUFACTURER-KERNEL-OPERATING_SYSTEM +# It is wrong to echo any other type of specification. + +me=`echo "$0" | sed -e 's,.*/,,'` + +usage="\ +Usage: $0 [OPTION] CPU-MFR-OPSYS + $0 [OPTION] ALIAS + +Canonicalize a configuration name. + +Operation modes: + -h, --help print this help, then exit + -t, --time-stamp print date of last modification, then exit + -v, --version print version number, then exit + +Report bugs and patches to ." + +version="\ +GNU config.sub ($timestamp) + +Copyright 1992-2014 Free Software Foundation, Inc. + +This is free software; see the source for copying conditions. There is NO +warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." + +help=" +Try \`$me --help' for more information." + +# Parse command line +while test $# -gt 0 ; do + case $1 in + --time-stamp | --time* | -t ) + echo "$timestamp" ; exit ;; + --version | -v ) + echo "$version" ; exit ;; + --help | --h* | -h ) + echo "$usage"; exit ;; + -- ) # Stop option processing + shift; break ;; + - ) # Use stdin as input. + break ;; + -* ) + echo "$me: invalid option $1$help" + exit 1 ;; + + *local*) + # First pass through any local machine types. + echo $1 + exit ;; + + * ) + break ;; + esac +done + +case $# in + 0) echo "$me: missing argument$help" >&2 + exit 1;; + 1) ;; + *) echo "$me: too many arguments$help" >&2 + exit 1;; +esac + +# Separate what the user gave into CPU-COMPANY and OS or KERNEL-OS (if any). +# Here we must recognize all the valid KERNEL-OS combinations. +maybe_os=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\2/'` +case $maybe_os in + nto-qnx* | linux-gnu* | linux-android* | linux-dietlibc | linux-newlib* | \ + linux-musl* | linux-uclibc* | uclinux-uclibc* | uclinux-gnu* | kfreebsd*-gnu* | \ + knetbsd*-gnu* | netbsd*-gnu* | \ + kopensolaris*-gnu* | \ + storm-chaos* | os2-emx* | rtmk-nova*) + os=-$maybe_os + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'` + ;; + android-linux) + os=-linux-android + basic_machine=`echo $1 | sed 's/^\(.*\)-\([^-]*-[^-]*\)$/\1/'`-unknown + ;; + *) + basic_machine=`echo $1 | sed 's/-[^-]*$//'` + if [ $basic_machine != $1 ] + then os=`echo $1 | sed 's/.*-/-/'` + else os=; fi + ;; +esac + +### Let's recognize common machines as not being operating systems so +### that things like config.sub decstation-3100 work. We also +### recognize some manufacturers as not being operating systems, so we +### can provide default operating systems below. +case $os in + -sun*os*) + # Prevent following clause from handling this invalid input. + ;; + -dec* | -mips* | -sequent* | -encore* | -pc532* | -sgi* | -sony* | \ + -att* | -7300* | -3300* | -delta* | -motorola* | -sun[234]* | \ + -unicom* | -ibm* | -next | -hp | -isi* | -apollo | -altos* | \ + -convergent* | -ncr* | -news | -32* | -3600* | -3100* | -hitachi* |\ + -c[123]* | -convex* | -sun | -crds | -omron* | -dg | -ultra | -tti* | \ + -harris | -dolphin | -highlevel | -gould | -cbm | -ns | -masscomp | \ + -apple | -axis | -knuth | -cray | -microblaze*) + os= + basic_machine=$1 + ;; + -bluegene*) + os=-cnk + ;; + -sim | -cisco | -oki | -wec | -winbond) + os= + basic_machine=$1 + ;; + -scout) + ;; + -wrs) + os=-vxworks + basic_machine=$1 + ;; + -chorusos*) + os=-chorusos + basic_machine=$1 + ;; + -chorusrdb) + os=-chorusrdb + basic_machine=$1 + ;; + -hiux*) + os=-hiuxwe2 + ;; + -sco6) + os=-sco5v6 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco5) + os=-sco3.2v5 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco4) + os=-sco3.2v4 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco3.2.[4-9]*) + os=`echo $os | sed -e 's/sco3.2./sco3.2v/'` + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco3.2v[4-9]*) + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco5v6*) + # Don't forget version if it is 3.2v4 or newer. + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -sco*) + os=-sco3.2v2 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -udk*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -isc) + os=-isc2.2 + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -clix*) + basic_machine=clipper-intergraph + ;; + -isc*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-pc/'` + ;; + -lynx*178) + os=-lynxos178 + ;; + -lynx*5) + os=-lynxos5 + ;; + -lynx*) + os=-lynxos + ;; + -ptx*) + basic_machine=`echo $1 | sed -e 's/86-.*/86-sequent/'` + ;; + -windowsnt*) + os=`echo $os | sed -e 's/windowsnt/winnt/'` + ;; + -psos*) + os=-psos + ;; + -mint | -mint[0-9]*) + basic_machine=m68k-atari + os=-mint + ;; +esac + +# Decode aliases for certain CPU-COMPANY combinations. +case $basic_machine in + # Recognize the basic CPU types without company name. + # Some are omitted here because they have special meanings below. + 1750a | 580 \ + | a29k \ + | aarch64 | aarch64_be \ + | alpha | alphaev[4-8] | alphaev56 | alphaev6[78] | alphapca5[67] \ + | alpha64 | alpha64ev[4-8] | alpha64ev56 | alpha64ev6[78] | alpha64pca5[67] \ + | am33_2.0 \ + | arc | arceb \ + | arm | arm[bl]e | arme[lb] | armv[2-8] | armv[3-8][lb] | armv7[arm] \ + | avr | avr32 \ + | be32 | be64 \ + | bfin \ + | c4x | c8051 | clipper \ + | d10v | d30v | dlx | dsp16xx \ + | epiphany \ + | fido | fr30 | frv \ + | h8300 | h8500 | hppa | hppa1.[01] | hppa2.0 | hppa2.0[nw] | hppa64 \ + | hexagon \ + | i370 | i860 | i960 | ia64 \ + | ip2k | iq2000 \ + | k1om \ + | le32 | le64 \ + | lm32 \ + | m32c | m32r | m32rle | m68000 | m68k | m88k \ + | maxq | mb | microblaze | microblazeel | mcore | mep | metag \ + | mips | mipsbe | mipseb | mipsel | mipsle \ + | mips16 \ + | mips64 | mips64el \ + | mips64octeon | mips64octeonel \ + | mips64orion | mips64orionel \ + | mips64r5900 | mips64r5900el \ + | mips64vr | mips64vrel \ + | mips64vr4100 | mips64vr4100el \ + | mips64vr4300 | mips64vr4300el \ + | mips64vr5000 | mips64vr5000el \ + | mips64vr5900 | mips64vr5900el \ + | mipsisa32 | mipsisa32el \ + | mipsisa32r2 | mipsisa32r2el \ + | mipsisa32r6 | mipsisa32r6el \ + | mipsisa64 | mipsisa64el \ + | mipsisa64r2 | mipsisa64r2el \ + | mipsisa64r6 | mipsisa64r6el \ + | mipsisa64sb1 | mipsisa64sb1el \ + | mipsisa64sr71k | mipsisa64sr71kel \ + | mipsr5900 | mipsr5900el \ + | mipstx39 | mipstx39el \ + | mn10200 | mn10300 \ + | moxie \ + | mt \ + | msp430 \ + | nds32 | nds32le | nds32be \ + | nios | nios2 | nios2eb | nios2el \ + | ns16k | ns32k \ + | open8 | or1k | or1knd | or32 \ + | pdp10 | pdp11 | pj | pjl \ + | powerpc | powerpc64 | powerpc64le | powerpcle \ + | pyramid \ + | riscv32 | riscv64 \ + | rl78 | rx \ + | score \ + | sh | sh[1234] | sh[24]a | sh[24]aeb | sh[23]e | sh[34]eb | sheb | shbe | shle | sh[1234]le | sh3ele \ + | sh64 | sh64le \ + | sparc | sparc64 | sparc64b | sparc64v | sparc86x | sparclet | sparclite \ + | sparcv8 | sparcv9 | sparcv9b | sparcv9v \ + | spu \ + | tahoe | tic4x | tic54x | tic55x | tic6x | tic80 | tron \ + | ubicom32 \ + | v850 | v850e | v850e1 | v850e2 | v850es | v850e2v3 \ + | visium \ + | we32k \ + | x86 | xc16x | xstormy16 | xtensa \ + | z8k | z80) + basic_machine=$basic_machine-unknown + ;; + c54x) + basic_machine=tic54x-unknown + ;; + c55x) + basic_machine=tic55x-unknown + ;; + c6x) + basic_machine=tic6x-unknown + ;; + leon|leon[3-9]) + basic_machine=sparc-$basic_machine + ;; + m6811 | m68hc11 | m6812 | m68hc12 | m68hcs12x | nvptx | picochip) + basic_machine=$basic_machine-unknown + os=-none + ;; + m88110 | m680[12346]0 | m683?2 | m68360 | m5200 | v70 | w65 | z8k) + ;; + ms1) + basic_machine=mt-unknown + ;; + + strongarm | thumb | xscale) + basic_machine=arm-unknown + ;; + xgate) + basic_machine=$basic_machine-unknown + os=-none + ;; + xscaleeb) + basic_machine=armeb-unknown + ;; + + xscaleel) + basic_machine=armel-unknown + ;; + + # We use `pc' rather than `unknown' + # because (1) that's what they normally are, and + # (2) the word "unknown" tends to confuse beginning users. + i*86 | x86_64) + basic_machine=$basic_machine-pc + ;; + # Object if more than one company name word. + *-*-*) + echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 + exit 1 + ;; + # Recognize the basic CPU types with company name. + 580-* \ + | a29k-* \ + | aarch64-* | aarch64_be-* \ + | alpha-* | alphaev[4-8]-* | alphaev56-* | alphaev6[78]-* \ + | alpha64-* | alpha64ev[4-8]-* | alpha64ev56-* | alpha64ev6[78]-* \ + | alphapca5[67]-* | alpha64pca5[67]-* | arc-* | arceb-* \ + | arm-* | armbe-* | armle-* | armeb-* | armv*-* \ + | avr-* | avr32-* \ + | be32-* | be64-* \ + | bfin-* | bs2000-* \ + | c[123]* | c30-* | [cjt]90-* | c4x-* \ + | c8051-* | clipper-* | craynv-* | cydra-* \ + | d10v-* | d30v-* | dlx-* \ + | elxsi-* \ + | f30[01]-* | f700-* | fido-* | fr30-* | frv-* | fx80-* \ + | h8300-* | h8500-* \ + | hppa-* | hppa1.[01]-* | hppa2.0-* | hppa2.0[nw]-* | hppa64-* \ + | hexagon-* \ + | i*86-* | i860-* | i960-* | ia64-* \ + | ip2k-* | iq2000-* \ + | k1om-* \ + | le32-* | le64-* \ + | lm32-* \ + | m32c-* | m32r-* | m32rle-* \ + | m68000-* | m680[012346]0-* | m68360-* | m683?2-* | m68k-* \ + | m88110-* | m88k-* | maxq-* | mcore-* | metag-* \ + | microblaze-* | microblazeel-* \ + | mips-* | mipsbe-* | mipseb-* | mipsel-* | mipsle-* \ + | mips16-* \ + | mips64-* | mips64el-* \ + | mips64octeon-* | mips64octeonel-* \ + | mips64orion-* | mips64orionel-* \ + | mips64r5900-* | mips64r5900el-* \ + | mips64vr-* | mips64vrel-* \ + | mips64vr4100-* | mips64vr4100el-* \ + | mips64vr4300-* | mips64vr4300el-* \ + | mips64vr5000-* | mips64vr5000el-* \ + | mips64vr5900-* | mips64vr5900el-* \ + | mipsisa32-* | mipsisa32el-* \ + | mipsisa32r2-* | mipsisa32r2el-* \ + | mipsisa32r6-* | mipsisa32r6el-* \ + | mipsisa64-* | mipsisa64el-* \ + | mipsisa64r2-* | mipsisa64r2el-* \ + | mipsisa64r6-* | mipsisa64r6el-* \ + | mipsisa64sb1-* | mipsisa64sb1el-* \ + | mipsisa64sr71k-* | mipsisa64sr71kel-* \ + | mipsr5900-* | mipsr5900el-* \ + | mipstx39-* | mipstx39el-* \ + | mmix-* \ + | mt-* \ + | msp430-* \ + | nds32-* | nds32le-* | nds32be-* \ + | nios-* | nios2-* | nios2eb-* | nios2el-* \ + | none-* | np1-* | ns16k-* | ns32k-* \ + | open8-* \ + | or1k*-* \ + | orion-* \ + | pdp10-* | pdp11-* | pj-* | pjl-* | pn-* | power-* \ + | powerpc-* | powerpc64-* | powerpc64le-* | powerpcle-* \ + | pyramid-* \ + | rl78-* | romp-* | rs6000-* | rx-* \ + | sh-* | sh[1234]-* | sh[24]a-* | sh[24]aeb-* | sh[23]e-* | sh[34]eb-* | sheb-* | shbe-* \ + | shle-* | sh[1234]le-* | sh3ele-* | sh64-* | sh64le-* \ + | sparc-* | sparc64-* | sparc64b-* | sparc64v-* | sparc86x-* | sparclet-* \ + | sparclite-* \ + | sparcv8-* | sparcv9-* | sparcv9b-* | sparcv9v-* | sv1-* | sx?-* \ + | tahoe-* \ + | tic30-* | tic4x-* | tic54x-* | tic55x-* | tic6x-* | tic80-* \ + | tile*-* \ + | tron-* \ + | ubicom32-* \ + | v850-* | v850e-* | v850e1-* | v850es-* | v850e2-* | v850e2v3-* \ + | vax-* \ + | visium-* \ + | we32k-* \ + | x86-* | x86_64-* | xc16x-* | xps100-* \ + | xstormy16-* | xtensa*-* \ + | ymp-* \ + | z8k-* | z80-*) + ;; + # Recognize the basic CPU types without company name, with glob match. + xtensa*) + basic_machine=$basic_machine-unknown + ;; + # Recognize the various machine names and aliases which stand + # for a CPU type and a company and sometimes even an OS. + 386bsd) + basic_machine=i386-unknown + os=-bsd + ;; + 3b1 | 7300 | 7300-att | att-7300 | pc7300 | safari | unixpc) + basic_machine=m68000-att + ;; + 3b*) + basic_machine=we32k-att + ;; + a29khif) + basic_machine=a29k-amd + os=-udi + ;; + abacus) + basic_machine=abacus-unknown + ;; + adobe68k) + basic_machine=m68010-adobe + os=-scout + ;; + alliant | fx80) + basic_machine=fx80-alliant + ;; + altos | altos3068) + basic_machine=m68k-altos + ;; + am29k) + basic_machine=a29k-none + os=-bsd + ;; + amd64) + basic_machine=x86_64-pc + ;; + amd64-*) + basic_machine=x86_64-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + amdahl) + basic_machine=580-amdahl + os=-sysv + ;; + amiga | amiga-*) + basic_machine=m68k-unknown + ;; + amigaos | amigados) + basic_machine=m68k-unknown + os=-amigaos + ;; + amigaunix | amix) + basic_machine=m68k-unknown + os=-sysv4 + ;; + apollo68) + basic_machine=m68k-apollo + os=-sysv + ;; + apollo68bsd) + basic_machine=m68k-apollo + os=-bsd + ;; + aros) + basic_machine=i386-pc + os=-aros + ;; + aux) + basic_machine=m68k-apple + os=-aux + ;; + balance) + basic_machine=ns32k-sequent + os=-dynix + ;; + blackfin) + basic_machine=bfin-unknown + os=-linux + ;; + blackfin-*) + basic_machine=bfin-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + bluegene*) + basic_machine=powerpc-ibm + os=-cnk + ;; + c54x-*) + basic_machine=tic54x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c55x-*) + basic_machine=tic55x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c6x-*) + basic_machine=tic6x-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + c90) + basic_machine=c90-cray + os=-unicos + ;; + cegcc) + basic_machine=arm-unknown + os=-cegcc + ;; + convex-c1) + basic_machine=c1-convex + os=-bsd + ;; + convex-c2) + basic_machine=c2-convex + os=-bsd + ;; + convex-c32) + basic_machine=c32-convex + os=-bsd + ;; + convex-c34) + basic_machine=c34-convex + os=-bsd + ;; + convex-c38) + basic_machine=c38-convex + os=-bsd + ;; + cray | j90) + basic_machine=j90-cray + os=-unicos + ;; + craynv) + basic_machine=craynv-cray + os=-unicosmp + ;; + cr16 | cr16-*) + basic_machine=cr16-unknown + os=-elf + ;; + crds | unos) + basic_machine=m68k-crds + ;; + crisv32 | crisv32-* | etraxfs*) + basic_machine=crisv32-axis + ;; + cris | cris-* | etrax*) + basic_machine=cris-axis + ;; + crx) + basic_machine=crx-unknown + os=-elf + ;; + da30 | da30-*) + basic_machine=m68k-da30 + ;; + decstation | decstation-3100 | pmax | pmax-* | pmin | dec3100 | decstatn) + basic_machine=mips-dec + ;; + decsystem10* | dec10*) + basic_machine=pdp10-dec + os=-tops10 + ;; + decsystem20* | dec20*) + basic_machine=pdp10-dec + os=-tops20 + ;; + delta | 3300 | motorola-3300 | motorola-delta \ + | 3300-motorola | delta-motorola) + basic_machine=m68k-motorola + ;; + delta88) + basic_machine=m88k-motorola + os=-sysv3 + ;; + dicos) + basic_machine=i686-pc + os=-dicos + ;; + djgpp) + basic_machine=i586-pc + os=-msdosdjgpp + ;; + dpx20 | dpx20-*) + basic_machine=rs6000-bull + os=-bosx + ;; + dpx2* | dpx2*-bull) + basic_machine=m68k-bull + os=-sysv3 + ;; + ebmon29k) + basic_machine=a29k-amd + os=-ebmon + ;; + elxsi) + basic_machine=elxsi-elxsi + os=-bsd + ;; + encore | umax | mmax) + basic_machine=ns32k-encore + ;; + es1800 | OSE68k | ose68k | ose | OSE) + basic_machine=m68k-ericsson + os=-ose + ;; + fx2800) + basic_machine=i860-alliant + ;; + genix) + basic_machine=ns32k-ns + ;; + gmicro) + basic_machine=tron-gmicro + os=-sysv + ;; + go32) + basic_machine=i386-pc + os=-go32 + ;; + h3050r* | hiux*) + basic_machine=hppa1.1-hitachi + os=-hiuxwe2 + ;; + h8300hms) + basic_machine=h8300-hitachi + os=-hms + ;; + h8300xray) + basic_machine=h8300-hitachi + os=-xray + ;; + h8500hms) + basic_machine=h8500-hitachi + os=-hms + ;; + harris) + basic_machine=m88k-harris + os=-sysv3 + ;; + hp300-*) + basic_machine=m68k-hp + ;; + hp300bsd) + basic_machine=m68k-hp + os=-bsd + ;; + hp300hpux) + basic_machine=m68k-hp + os=-hpux + ;; + hp3k9[0-9][0-9] | hp9[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hp9k2[0-9][0-9] | hp9k31[0-9]) + basic_machine=m68000-hp + ;; + hp9k3[2-9][0-9]) + basic_machine=m68k-hp + ;; + hp9k6[0-9][0-9] | hp6[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hp9k7[0-79][0-9] | hp7[0-79][0-9]) + basic_machine=hppa1.1-hp + ;; + hp9k78[0-9] | hp78[0-9]) + # FIXME: really hppa2.0-hp + basic_machine=hppa1.1-hp + ;; + hp9k8[67]1 | hp8[67]1 | hp9k80[24] | hp80[24] | hp9k8[78]9 | hp8[78]9 | hp9k893 | hp893) + # FIXME: really hppa2.0-hp + basic_machine=hppa1.1-hp + ;; + hp9k8[0-9][13679] | hp8[0-9][13679]) + basic_machine=hppa1.1-hp + ;; + hp9k8[0-9][0-9] | hp8[0-9][0-9]) + basic_machine=hppa1.0-hp + ;; + hppa-next) + os=-nextstep3 + ;; + hppaosf) + basic_machine=hppa1.1-hp + os=-osf + ;; + hppro) + basic_machine=hppa1.1-hp + os=-proelf + ;; + i370-ibm* | ibm*) + basic_machine=i370-ibm + ;; + i*86v32) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv32 + ;; + i*86v4*) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv4 + ;; + i*86v) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-sysv + ;; + i*86sol2) + basic_machine=`echo $1 | sed -e 's/86.*/86-pc/'` + os=-solaris2 + ;; + i386mach) + basic_machine=i386-mach + os=-mach + ;; + i386-vsta | vsta) + basic_machine=i386-unknown + os=-vsta + ;; + iris | iris4d) + basic_machine=mips-sgi + case $os in + -irix*) + ;; + *) + os=-irix4 + ;; + esac + ;; + isi68 | isi) + basic_machine=m68k-isi + os=-sysv + ;; + leon-*|leon[3-9]-*) + basic_machine=sparc-`echo $basic_machine | sed 's/-.*//'` + ;; + m68knommu) + basic_machine=m68k-unknown + os=-linux + ;; + m68knommu-*) + basic_machine=m68k-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + m88k-omron*) + basic_machine=m88k-omron + ;; + magnum | m3230) + basic_machine=mips-mips + os=-sysv + ;; + merlin) + basic_machine=ns32k-utek + os=-sysv + ;; + microblaze*) + basic_machine=microblaze-xilinx + ;; + mingw64) + basic_machine=x86_64-pc + os=-mingw64 + ;; + mingw32) + basic_machine=i686-pc + os=-mingw32 + ;; + mingw32ce) + basic_machine=arm-unknown + os=-mingw32ce + ;; + miniframe) + basic_machine=m68000-convergent + ;; + *mint | -mint[0-9]* | *MiNT | *MiNT[0-9]*) + basic_machine=m68k-atari + os=-mint + ;; + mips3*-*) + basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'` + ;; + mips3*) + basic_machine=`echo $basic_machine | sed -e 's/mips3/mips64/'`-unknown + ;; + monitor) + basic_machine=m68k-rom68k + os=-coff + ;; + morphos) + basic_machine=powerpc-unknown + os=-morphos + ;; + moxiebox) + basic_machine=moxie-unknown + os=-moxiebox + ;; + msdos) + basic_machine=i386-pc + os=-msdos + ;; + ms1-*) + basic_machine=`echo $basic_machine | sed -e 's/ms1-/mt-/'` + ;; + msys) + basic_machine=i686-pc + os=-msys + ;; + mvs) + basic_machine=i370-ibm + os=-mvs + ;; + nacl) + basic_machine=le32-unknown + os=-nacl + ;; + ncr3000) + basic_machine=i486-ncr + os=-sysv4 + ;; + netbsd386) + basic_machine=i386-unknown + os=-netbsd + ;; + netwinder) + basic_machine=armv4l-rebel + os=-linux + ;; + news | news700 | news800 | news900) + basic_machine=m68k-sony + os=-newsos + ;; + news1000) + basic_machine=m68030-sony + os=-newsos + ;; + news-3600 | risc-news) + basic_machine=mips-sony + os=-newsos + ;; + necv70) + basic_machine=v70-nec + os=-sysv + ;; + next | m*-next ) + basic_machine=m68k-next + case $os in + -nextstep* ) + ;; + -ns2*) + os=-nextstep2 + ;; + *) + os=-nextstep3 + ;; + esac + ;; + nh3000) + basic_machine=m68k-harris + os=-cxux + ;; + nh[45]000) + basic_machine=m88k-harris + os=-cxux + ;; + nindy960) + basic_machine=i960-intel + os=-nindy + ;; + mon960) + basic_machine=i960-intel + os=-mon960 + ;; + nonstopux) + basic_machine=mips-compaq + os=-nonstopux + ;; + np1) + basic_machine=np1-gould + ;; + neo-tandem) + basic_machine=neo-tandem + ;; + nse-tandem) + basic_machine=nse-tandem + ;; + nsr-tandem) + basic_machine=nsr-tandem + ;; + op50n-* | op60c-*) + basic_machine=hppa1.1-oki + os=-proelf + ;; + openrisc | openrisc-*) + basic_machine=or32-unknown + ;; + os400) + basic_machine=powerpc-ibm + os=-os400 + ;; + OSE68000 | ose68000) + basic_machine=m68000-ericsson + os=-ose + ;; + os68k) + basic_machine=m68k-none + os=-os68k + ;; + pa-hitachi) + basic_machine=hppa1.1-hitachi + os=-hiuxwe2 + ;; + paragon) + basic_machine=i860-intel + os=-osf + ;; + parisc) + basic_machine=hppa-unknown + os=-linux + ;; + parisc-*) + basic_machine=hppa-`echo $basic_machine | sed 's/^[^-]*-//'` + os=-linux + ;; + pbd) + basic_machine=sparc-tti + ;; + pbb) + basic_machine=m68k-tti + ;; + pc532 | pc532-*) + basic_machine=ns32k-pc532 + ;; + pc98) + basic_machine=i386-pc + ;; + pc98-*) + basic_machine=i386-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentium | p5 | k5 | k6 | nexgen | viac3) + basic_machine=i586-pc + ;; + pentiumpro | p6 | 6x86 | athlon | athlon_*) + basic_machine=i686-pc + ;; + pentiumii | pentium2 | pentiumiii | pentium3) + basic_machine=i686-pc + ;; + pentium4) + basic_machine=i786-pc + ;; + pentium-* | p5-* | k5-* | k6-* | nexgen-* | viac3-*) + basic_machine=i586-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentiumpro-* | p6-* | 6x86-* | athlon-*) + basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentiumii-* | pentium2-* | pentiumiii-* | pentium3-*) + basic_machine=i686-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pentium4-*) + basic_machine=i786-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + pn) + basic_machine=pn-gould + ;; + power) basic_machine=power-ibm + ;; + ppc | ppcbe) basic_machine=powerpc-unknown + ;; + ppc-* | ppcbe-*) + basic_machine=powerpc-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppcle | powerpclittle | ppc-le | powerpc-little) + basic_machine=powerpcle-unknown + ;; + ppcle-* | powerpclittle-*) + basic_machine=powerpcle-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppc64) basic_machine=powerpc64-unknown + ;; + ppc64-*) basic_machine=powerpc64-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ppc64le | powerpc64little | ppc64-le | powerpc64-little) + basic_machine=powerpc64le-unknown + ;; + ppc64le-* | powerpc64little-*) + basic_machine=powerpc64le-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + ps2) + basic_machine=i386-ibm + ;; + pw32) + basic_machine=i586-unknown + os=-pw32 + ;; + rdos | rdos64) + basic_machine=x86_64-pc + os=-rdos + ;; + rdos32) + basic_machine=i386-pc + os=-rdos + ;; + rom68k) + basic_machine=m68k-rom68k + os=-coff + ;; + rm[46]00) + basic_machine=mips-siemens + ;; + rtpc | rtpc-*) + basic_machine=romp-ibm + ;; + s390 | s390-*) + basic_machine=s390-ibm + ;; + s390x | s390x-*) + basic_machine=s390x-ibm + ;; + sa29200) + basic_machine=a29k-amd + os=-udi + ;; + sb1) + basic_machine=mipsisa64sb1-unknown + ;; + sb1el) + basic_machine=mipsisa64sb1el-unknown + ;; + sde) + basic_machine=mipsisa32-sde + os=-elf + ;; + sei) + basic_machine=mips-sei + os=-seiux + ;; + sequent) + basic_machine=i386-sequent + ;; + sh) + basic_machine=sh-hitachi + os=-hms + ;; + sh5el) + basic_machine=sh5le-unknown + ;; + sh64) + basic_machine=sh64-unknown + ;; + sparclite-wrs | simso-wrs) + basic_machine=sparclite-wrs + os=-vxworks + ;; + sps7) + basic_machine=m68k-bull + os=-sysv2 + ;; + spur) + basic_machine=spur-unknown + ;; + st2000) + basic_machine=m68k-tandem + ;; + stratus) + basic_machine=i860-stratus + os=-sysv4 + ;; + strongarm-* | thumb-*) + basic_machine=arm-`echo $basic_machine | sed 's/^[^-]*-//'` + ;; + sun2) + basic_machine=m68000-sun + ;; + sun2os3) + basic_machine=m68000-sun + os=-sunos3 + ;; + sun2os4) + basic_machine=m68000-sun + os=-sunos4 + ;; + sun3os3) + basic_machine=m68k-sun + os=-sunos3 + ;; + sun3os4) + basic_machine=m68k-sun + os=-sunos4 + ;; + sun4os3) + basic_machine=sparc-sun + os=-sunos3 + ;; + sun4os4) + basic_machine=sparc-sun + os=-sunos4 + ;; + sun4sol2) + basic_machine=sparc-sun + os=-solaris2 + ;; + sun3 | sun3-*) + basic_machine=m68k-sun + ;; + sun4) + basic_machine=sparc-sun + ;; + sun386 | sun386i | roadrunner) + basic_machine=i386-sun + ;; + sv1) + basic_machine=sv1-cray + os=-unicos + ;; + symmetry) + basic_machine=i386-sequent + os=-dynix + ;; + t3e) + basic_machine=alphaev5-cray + os=-unicos + ;; + t90) + basic_machine=t90-cray + os=-unicos + ;; + tile*) + basic_machine=$basic_machine-unknown + os=-linux-gnu + ;; + tx39) + basic_machine=mipstx39-unknown + ;; + tx39el) + basic_machine=mipstx39el-unknown + ;; + toad1) + basic_machine=pdp10-xkl + os=-tops20 + ;; + tower | tower-32) + basic_machine=m68k-ncr + ;; + tpf) + basic_machine=s390x-ibm + os=-tpf + ;; + udi29k) + basic_machine=a29k-amd + os=-udi + ;; + ultra3) + basic_machine=a29k-nyu + os=-sym1 + ;; + v810 | necv810) + basic_machine=v810-nec + os=-none + ;; + vaxv) + basic_machine=vax-dec + os=-sysv + ;; + vms) + basic_machine=vax-dec + os=-vms + ;; + vpp*|vx|vx-*) + basic_machine=f301-fujitsu + ;; + vxworks960) + basic_machine=i960-wrs + os=-vxworks + ;; + vxworks68) + basic_machine=m68k-wrs + os=-vxworks + ;; + vxworks29k) + basic_machine=a29k-wrs + os=-vxworks + ;; + w65*) + basic_machine=w65-wdc + os=-none + ;; + w89k-*) + basic_machine=hppa1.1-winbond + os=-proelf + ;; + xbox) + basic_machine=i686-pc + os=-mingw32 + ;; + xps | xps100) + basic_machine=xps100-honeywell + ;; + xscale-* | xscalee[bl]-*) + basic_machine=`echo $basic_machine | sed 's/^xscale/arm/'` + ;; + ymp) + basic_machine=ymp-cray + os=-unicos + ;; + z8k-*-coff) + basic_machine=z8k-unknown + os=-sim + ;; + z80-*-coff) + basic_machine=z80-unknown + os=-sim + ;; + none) + basic_machine=none-none + os=-none + ;; + +# Here we handle the default manufacturer of certain CPU types. It is in +# some cases the only manufacturer, in others, it is the most popular. + w89k) + basic_machine=hppa1.1-winbond + ;; + op50n) + basic_machine=hppa1.1-oki + ;; + op60c) + basic_machine=hppa1.1-oki + ;; + romp) + basic_machine=romp-ibm + ;; + mmix) + basic_machine=mmix-knuth + ;; + rs6000) + basic_machine=rs6000-ibm + ;; + vax) + basic_machine=vax-dec + ;; + pdp10) + # there are many clones, so DEC is not a safe bet + basic_machine=pdp10-unknown + ;; + pdp11) + basic_machine=pdp11-dec + ;; + we32k) + basic_machine=we32k-att + ;; + sh[1234] | sh[24]a | sh[24]aeb | sh[34]eb | sh[1234]le | sh[23]ele) + basic_machine=sh-unknown + ;; + sparc | sparcv8 | sparcv9 | sparcv9b | sparcv9v) + basic_machine=sparc-sun + ;; + cydra) + basic_machine=cydra-cydrome + ;; + orion) + basic_machine=orion-highlevel + ;; + orion105) + basic_machine=clipper-highlevel + ;; + mac | mpw | mac-mpw) + basic_machine=m68k-apple + ;; + pmac | pmac-mpw) + basic_machine=powerpc-apple + ;; + *-unknown) + # Make sure to match an already-canonicalized machine name. + ;; + *) + echo Invalid configuration \`$1\': machine \`$basic_machine\' not recognized 1>&2 + exit 1 + ;; +esac + +# Here we canonicalize certain aliases for manufacturers. +case $basic_machine in + *-digital*) + basic_machine=`echo $basic_machine | sed 's/digital.*/dec/'` + ;; + *-commodore*) + basic_machine=`echo $basic_machine | sed 's/commodore.*/cbm/'` + ;; + *) + ;; +esac + +# Decode manufacturer-specific aliases for certain operating systems. + +if [ x"$os" != x"" ] +then +case $os in + # First match some system type aliases + # that might get confused with valid system types. + # -solaris* is a basic system type, with this one exception. + -auroraux) + os=-auroraux + ;; + -solaris1 | -solaris1.*) + os=`echo $os | sed -e 's|solaris1|sunos4|'` + ;; + -solaris) + os=-solaris2 + ;; + -svr4*) + os=-sysv4 + ;; + -unixware*) + os=-sysv4.2uw + ;; + -gnu/linux*) + os=`echo $os | sed -e 's|gnu/linux|linux-gnu|'` + ;; + # First accept the basic system types. + # The portable systems comes first. + # Each alternative MUST END IN A *, to match a version number. + # -sysv* is not here because it comes later, after sysvr4. + -gnu* | -bsd* | -mach* | -minix* | -genix* | -ultrix* | -irix* \ + | -*vms* | -sco* | -esix* | -isc* | -aix* | -cnk* | -sunos | -sunos[34]*\ + | -hpux* | -unos* | -osf* | -luna* | -dgux* | -auroraux* | -solaris* \ + | -sym* | -kopensolaris* | -plan9* \ + | -amigaos* | -amigados* | -msdos* | -newsos* | -unicos* | -aof* \ + | -aos* | -aros* \ + | -nindy* | -vxsim* | -vxworks* | -ebmon* | -hms* | -mvs* \ + | -clix* | -riscos* | -uniplus* | -iris* | -rtu* | -xenix* \ + | -hiux* | -386bsd* | -knetbsd* | -mirbsd* | -netbsd* \ + | -bitrig* | -openbsd* | -solidbsd* \ + | -ekkobsd* | -kfreebsd* | -freebsd* | -riscix* | -lynxos* \ + | -bosx* | -nextstep* | -cxux* | -aout* | -elf* | -oabi* \ + | -ptx* | -coff* | -ecoff* | -winnt* | -domain* | -vsta* \ + | -udi* | -eabi* | -lites* | -ieee* | -go32* | -aux* \ + | -chorusos* | -chorusrdb* | -cegcc* \ + | -cygwin* | -msys* | -pe* | -psos* | -moss* | -proelf* | -rtems* \ + | -mingw32* | -mingw64* | -linux-gnu* | -linux-android* \ + | -linux-newlib* | -linux-musl* | -linux-uclibc* \ + | -uxpv* | -beos* | -mpeix* | -udk* | -moxiebox* \ + | -interix* | -uwin* | -mks* | -rhapsody* | -darwin* | -opened* \ + | -openstep* | -oskit* | -conix* | -pw32* | -nonstopux* \ + | -storm-chaos* | -tops10* | -tenex* | -tops20* | -its* \ + | -os2* | -vos* | -palmos* | -uclinux* | -nucleus* \ + | -morphos* | -superux* | -rtmk* | -rtmk-nova* | -windiss* \ + | -powermax* | -dnix* | -nx6 | -nx7 | -sei* | -dragonfly* \ + | -skyos* | -haiku* | -rdos* | -toppers* | -drops* | -es* | -tirtos*) + # Remember, each alternative MUST END IN *, to match a version number. + ;; + -qnx*) + case $basic_machine in + x86-* | i*86-*) + ;; + *) + os=-nto$os + ;; + esac + ;; + -nto-qnx*) + ;; + -nto*) + os=`echo $os | sed -e 's|nto|nto-qnx|'` + ;; + -sim | -es1800* | -hms* | -xray | -os68k* | -none* | -v88r* \ + | -windows* | -osx | -abug | -netware* | -os9* | -beos* | -haiku* \ + | -macos* | -mpw* | -magic* | -mmixware* | -mon960* | -lnews*) + ;; + -mac*) + os=`echo $os | sed -e 's|mac|macos|'` + ;; + -linux-dietlibc) + os=-linux-dietlibc + ;; + -linux*) + os=`echo $os | sed -e 's|linux|linux-gnu|'` + ;; + -sunos5*) + os=`echo $os | sed -e 's|sunos5|solaris2|'` + ;; + -sunos6*) + os=`echo $os | sed -e 's|sunos6|solaris3|'` + ;; + -opened*) + os=-openedition + ;; + -os400*) + os=-os400 + ;; + -wince*) + os=-wince + ;; + -osfrose*) + os=-osfrose + ;; + -osf*) + os=-osf + ;; + -utek*) + os=-bsd + ;; + -dynix*) + os=-bsd + ;; + -acis*) + os=-aos + ;; + -atheos*) + os=-atheos + ;; + -syllable*) + os=-syllable + ;; + -386bsd) + os=-bsd + ;; + -ctix* | -uts*) + os=-sysv + ;; + -nova*) + os=-rtmk-nova + ;; + -ns2 ) + os=-nextstep2 + ;; + -nsk*) + os=-nsk + ;; + # Preserve the version number of sinix5. + -sinix5.*) + os=`echo $os | sed -e 's|sinix|sysv|'` + ;; + -sinix*) + os=-sysv4 + ;; + -tpf*) + os=-tpf + ;; + -triton*) + os=-sysv3 + ;; + -oss*) + os=-sysv3 + ;; + -svr4) + os=-sysv4 + ;; + -svr3) + os=-sysv3 + ;; + -sysvr4) + os=-sysv4 + ;; + # This must come after -sysvr4. + -sysv*) + ;; + -ose*) + os=-ose + ;; + -es1800*) + os=-ose + ;; + -xenix) + os=-xenix + ;; + -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) + os=-mint + ;; + -aros*) + os=-aros + ;; + -zvmoe) + os=-zvmoe + ;; + -dicos*) + os=-dicos + ;; + -nacl*) + ;; + -none) + ;; + *) + # Get rid of the `-' at the beginning of $os. + os=`echo $os | sed 's/[^-]*-//'` + echo Invalid configuration \`$1\': system \`$os\' not recognized 1>&2 + exit 1 + ;; +esac +else + +# Here we handle the default operating systems that come with various machines. +# The value should be what the vendor currently ships out the door with their +# machine or put another way, the most popular os provided with the machine. + +# Note that if you're going to try to match "-MANUFACTURER" here (say, +# "-sun"), then you have to tell the case statement up towards the top +# that MANUFACTURER isn't an operating system. Otherwise, code above +# will signal an error saying that MANUFACTURER isn't an operating +# system, and we'll never get to this point. + +case $basic_machine in + score-*) + os=-elf + ;; + spu-*) + os=-elf + ;; + *-acorn) + os=-riscix1.2 + ;; + arm*-rebel) + os=-linux + ;; + arm*-semi) + os=-aout + ;; + c4x-* | tic4x-*) + os=-coff + ;; + c8051-*) + os=-elf + ;; + hexagon-*) + os=-elf + ;; + tic54x-*) + os=-coff + ;; + tic55x-*) + os=-coff + ;; + tic6x-*) + os=-coff + ;; + # This must come before the *-dec entry. + pdp10-*) + os=-tops20 + ;; + pdp11-*) + os=-none + ;; + *-dec | vax-*) + os=-ultrix4.2 + ;; + m68*-apollo) + os=-domain + ;; + i386-sun) + os=-sunos4.0.2 + ;; + m68000-sun) + os=-sunos3 + ;; + m68*-cisco) + os=-aout + ;; + mep-*) + os=-elf + ;; + mips*-cisco) + os=-elf + ;; + mips*-*) + os=-elf + ;; + or32-*) + os=-coff + ;; + *-tti) # must be before sparc entry or we get the wrong os. + os=-sysv3 + ;; + sparc-* | *-sun) + os=-sunos4.1.1 + ;; + *-be) + os=-beos + ;; + *-haiku) + os=-haiku + ;; + *-ibm) + os=-aix + ;; + *-knuth) + os=-mmixware + ;; + *-wec) + os=-proelf + ;; + *-winbond) + os=-proelf + ;; + *-oki) + os=-proelf + ;; + *-hp) + os=-hpux + ;; + *-hitachi) + os=-hiux + ;; + i860-* | *-att | *-ncr | *-altos | *-motorola | *-convergent) + os=-sysv + ;; + *-cbm) + os=-amigaos + ;; + *-dg) + os=-dgux + ;; + *-dolphin) + os=-sysv3 + ;; + m68k-ccur) + os=-rtu + ;; + m88k-omron*) + os=-luna + ;; + *-next ) + os=-nextstep + ;; + *-sequent) + os=-ptx + ;; + *-crds) + os=-unos + ;; + *-ns) + os=-genix + ;; + i370-*) + os=-mvs + ;; + *-next) + os=-nextstep3 + ;; + *-gould) + os=-sysv + ;; + *-highlevel) + os=-bsd + ;; + *-encore) + os=-bsd + ;; + *-sgi) + os=-irix + ;; + *-siemens) + os=-sysv4 + ;; + *-masscomp) + os=-rtu + ;; + f30[01]-fujitsu | f700-fujitsu) + os=-uxpv + ;; + *-rom68k) + os=-coff + ;; + *-*bug) + os=-coff + ;; + *-apple) + os=-macos + ;; + *-atari*) + os=-mint + ;; + *) + os=-none + ;; +esac +fi + +# Here we handle the case where we know the os, and the CPU type, but not the +# manufacturer. We pick the logical manufacturer. +vendor=unknown +case $basic_machine in + *-unknown) + case $os in + -riscix*) + vendor=acorn + ;; + -sunos*) + vendor=sun + ;; + -cnk*|-aix*) + vendor=ibm + ;; + -beos*) + vendor=be + ;; + -hpux*) + vendor=hp + ;; + -mpeix*) + vendor=hp + ;; + -hiux*) + vendor=hitachi + ;; + -unos*) + vendor=crds + ;; + -dgux*) + vendor=dg + ;; + -luna*) + vendor=omron + ;; + -genix*) + vendor=ns + ;; + -mvs* | -opened*) + vendor=ibm + ;; + -os400*) + vendor=ibm + ;; + -ptx*) + vendor=sequent + ;; + -tpf*) + vendor=ibm + ;; + -vxsim* | -vxworks* | -windiss*) + vendor=wrs + ;; + -aux*) + vendor=apple + ;; + -hms*) + vendor=hitachi + ;; + -mpw* | -macos*) + vendor=apple + ;; + -*mint | -mint[0-9]* | -*MiNT | -MiNT[0-9]*) + vendor=atari + ;; + -vos*) + vendor=stratus + ;; + esac + basic_machine=`echo $basic_machine | sed "s/unknown/$vendor/"` + ;; +esac + +echo $basic_machine$os +exit + +# Local variables: +# eval: (add-hook 'write-file-hooks 'time-stamp) +# time-stamp-start: "timestamp='" +# time-stamp-format: "%:y-%02m-%02d" +# time-stamp-end: "'" +# End: ADDED autosetup/default.auto Index: autosetup/default.auto ================================================================== --- /dev/null +++ autosetup/default.auto @@ -0,0 +1,25 @@ +# Copyright (c) 2012 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# Auto-load module for 'make' build system integration + +use init + +autosetup_add_init_type make {Simple "make" build system} { + autosetup_check_create auto.def \ +{# Initial auto.def created by 'autosetup --init=make' + +use cc + +# Add any user options here +options { +} + +make-config-header config.h +make-template Makefile.in +} + + if {![file exists Makefile.in]} { + puts "Note: I don't see Makefile.in. You will probably need to create one." + } +} ADDED autosetup/find-tclsh Index: autosetup/find-tclsh ================================================================== --- /dev/null +++ autosetup/find-tclsh @@ -0,0 +1,16 @@ +#!/bin/sh +# Looks for a suitable tclsh or jimsh in the PATH +# If not found, builds a bootstrap jimsh from source +d=`dirname "$0"` +{ "$d/jimsh0" "$d/test-tclsh"; } 2>/dev/null && exit 0 +PATH="$PATH:$d"; export PATH +for tclsh in jimsh tclsh tclsh8.5 tclsh8.6; do + { $tclsh "$d/test-tclsh"; } 2>/dev/null && exit 0 +done +echo 1>&2 "No installed jimsh or tclsh, building local bootstrap jimsh0" +for cc in ${CC_FOR_BUILD:-cc} gcc; do + { $cc -o "$d/jimsh0" "$d/jimsh0.c"; } 2>/dev/null || continue + "$d/jimsh0" "$d/test-tclsh" && exit 0 +done +echo 1>&2 "No working C compiler found. Tried ${CC_FOR_BUILD:-cc} and gcc." +echo false ADDED autosetup/jimsh0.c Index: autosetup/jimsh0.c ================================================================== --- /dev/null +++ autosetup/jimsh0.c @@ -0,0 +1,22229 @@ +/* This is single source file, bootstrap version of Jim Tcl. See http://jim.tcl.tk/ */ +#define _GNU_SOURCE +#define JIM_TCL_COMPAT +#define JIM_REFERENCES +#define JIM_ANSIC +#define JIM_REGEXP +#define HAVE_NO_AUTOCONF +#define _JIMAUTOCONF_H +#define TCL_LIBRARY "." +#define jim_ext_bootstrap +#define jim_ext_aio +#define jim_ext_readdir +#define jim_ext_regexp +#define jim_ext_file +#define jim_ext_glob +#define jim_ext_exec +#define jim_ext_clock +#define jim_ext_array +#define jim_ext_stdlib +#define jim_ext_tclcompat +#if defined(_MSC_VER) +#define TCL_PLATFORM_OS "windows" +#define TCL_PLATFORM_PLATFORM "windows" +#define TCL_PLATFORM_PATH_SEPARATOR ";" +#define HAVE_MKDIR_ONE_ARG +#define HAVE_SYSTEM +#elif defined(__MINGW32__) +#define TCL_PLATFORM_OS "mingw" +#define TCL_PLATFORM_PLATFORM "windows" +#define TCL_PLATFORM_PATH_SEPARATOR ";" +#define HAVE_MKDIR_ONE_ARG +#define HAVE_SYSTEM +#define HAVE_SYS_TIME_H +#define HAVE_DIRENT_H +#define HAVE_UNISTD_H +#else +#define TCL_PLATFORM_OS "unknown" +#define TCL_PLATFORM_PLATFORM "unix" +#define TCL_PLATFORM_PATH_SEPARATOR ":" +#define HAVE_VFORK +#define HAVE_WAITPID +#define HAVE_ISATTY +#define HAVE_MKSTEMP +#define HAVE_LINK +#define HAVE_SYS_TIME_H +#define HAVE_DIRENT_H +#define HAVE_UNISTD_H +#endif +#define JIM_VERSION 76 +#ifndef JIM_WIN32COMPAT_H +#define JIM_WIN32COMPAT_H + + + +#ifdef __cplusplus +extern "C" { +#endif + + +#if defined(_WIN32) || defined(WIN32) + +#define HAVE_DLOPEN +void *dlopen(const char *path, int mode); +int dlclose(void *handle); +void *dlsym(void *handle, const char *symbol); +char *dlerror(void); + + +#if defined(__MINGW32__) + #define JIM_SPRINTF_DOUBLE_NEEDS_FIX +#endif + +#ifdef _MSC_VER + + +#if _MSC_VER >= 1000 + #pragma warning(disable:4146) +#endif + +#include +#define jim_wide _int64 +#ifndef LLONG_MAX + #define LLONG_MAX 9223372036854775807I64 +#endif +#ifndef LLONG_MIN + #define LLONG_MIN (-LLONG_MAX - 1I64) +#endif +#define JIM_WIDE_MIN LLONG_MIN +#define JIM_WIDE_MAX LLONG_MAX +#define JIM_WIDE_MODIFIER "I64d" +#define strcasecmp _stricmp +#define strtoull _strtoui64 +#define snprintf _snprintf + +#include + +struct timeval { + long tv_sec; + long tv_usec; +}; + +int gettimeofday(struct timeval *tv, void *unused); + +#define HAVE_OPENDIR +struct dirent { + char *d_name; +}; + +typedef struct DIR { + long handle; + struct _finddata_t info; + struct dirent result; + char *name; +} DIR; + +DIR *opendir(const char *name); +int closedir(DIR *dir); +struct dirent *readdir(DIR *dir); + +#elif defined(__MINGW32__) + +#include +#define strtod __strtod + +#endif + +#endif + +#ifdef __cplusplus +} +#endif + +#endif +#ifndef UTF8_UTIL_H +#define UTF8_UTIL_H + +#ifdef __cplusplus +extern "C" { +#endif + + + +#define MAX_UTF8_LEN 4 + +int utf8_fromunicode(char *p, unsigned uc); + +#ifndef JIM_UTF8 +#include + + +#define utf8_strlen(S, B) ((B) < 0 ? strlen(S) : (B)) +#define utf8_tounicode(S, CP) (*(CP) = (unsigned char)*(S), 1) +#define utf8_getchars(CP, C) (*(CP) = (C), 1) +#define utf8_upper(C) toupper(C) +#define utf8_title(C) toupper(C) +#define utf8_lower(C) tolower(C) +#define utf8_index(C, I) (I) +#define utf8_charlen(C) 1 +#define utf8_prev_len(S, L) 1 + +#else + +#endif + +#ifdef __cplusplus +} +#endif + +#endif + +#ifndef __JIM__H +#define __JIM__H + +#ifdef __cplusplus +extern "C" { +#endif + +#include +#include +#include +#include +#include + + +#ifndef HAVE_NO_AUTOCONF +#endif + + + +#ifndef jim_wide +# ifdef HAVE_LONG_LONG +# define jim_wide long long +# ifndef LLONG_MAX +# define LLONG_MAX 9223372036854775807LL +# endif +# ifndef LLONG_MIN +# define LLONG_MIN (-LLONG_MAX - 1LL) +# endif +# define JIM_WIDE_MIN LLONG_MIN +# define JIM_WIDE_MAX LLONG_MAX +# else +# define jim_wide long +# define JIM_WIDE_MIN LONG_MIN +# define JIM_WIDE_MAX LONG_MAX +# endif + + +# ifdef HAVE_LONG_LONG +# define JIM_WIDE_MODIFIER "lld" +# else +# define JIM_WIDE_MODIFIER "ld" +# define strtoull strtoul +# endif +#endif + +#define UCHAR(c) ((unsigned char)(c)) + + +#define JIM_OK 0 +#define JIM_ERR 1 +#define JIM_RETURN 2 +#define JIM_BREAK 3 +#define JIM_CONTINUE 4 +#define JIM_SIGNAL 5 +#define JIM_EXIT 6 + +#define JIM_EVAL 7 + +#define JIM_MAX_CALLFRAME_DEPTH 1000 +#define JIM_MAX_EVAL_DEPTH 2000 + + +#define JIM_PRIV_FLAG_SHIFT 20 + +#define JIM_NONE 0 +#define JIM_ERRMSG 1 +#define JIM_ENUM_ABBREV 2 +#define JIM_UNSHARED 4 +#define JIM_MUSTEXIST 8 + + +#define JIM_SUBST_NOVAR 1 +#define JIM_SUBST_NOCMD 2 +#define JIM_SUBST_NOESC 4 +#define JIM_SUBST_FLAG 128 + + +#define JIM_CASESENS 0 +#define JIM_NOCASE 1 + + +#define JIM_PATH_LEN 1024 + + +#define JIM_NOTUSED(V) ((void) V) + +#define JIM_LIBPATH "auto_path" +#define JIM_INTERACTIVE "tcl_interactive" + + +typedef struct Jim_Stack { + int len; + int maxlen; + void **vector; +} Jim_Stack; + + +typedef struct Jim_HashEntry { + void *key; + union { + void *val; + int intval; + } u; + struct Jim_HashEntry *next; +} Jim_HashEntry; + +typedef struct Jim_HashTableType { + unsigned int (*hashFunction)(const void *key); + void *(*keyDup)(void *privdata, const void *key); + void *(*valDup)(void *privdata, const void *obj); + int (*keyCompare)(void *privdata, const void *key1, const void *key2); + void (*keyDestructor)(void *privdata, void *key); + void (*valDestructor)(void *privdata, void *obj); +} Jim_HashTableType; + +typedef struct Jim_HashTable { + Jim_HashEntry **table; + const Jim_HashTableType *type; + void *privdata; + unsigned int size; + unsigned int sizemask; + unsigned int used; + unsigned int collisions; + unsigned int uniq; +} Jim_HashTable; + +typedef struct Jim_HashTableIterator { + Jim_HashTable *ht; + Jim_HashEntry *entry, *nextEntry; + int index; +} Jim_HashTableIterator; + + +#define JIM_HT_INITIAL_SIZE 16 + + +#define Jim_FreeEntryVal(ht, entry) \ + if ((ht)->type->valDestructor) \ + (ht)->type->valDestructor((ht)->privdata, (entry)->u.val) + +#define Jim_SetHashVal(ht, entry, _val_) do { \ + if ((ht)->type->valDup) \ + (entry)->u.val = (ht)->type->valDup((ht)->privdata, (_val_)); \ + else \ + (entry)->u.val = (_val_); \ +} while(0) + +#define Jim_FreeEntryKey(ht, entry) \ + if ((ht)->type->keyDestructor) \ + (ht)->type->keyDestructor((ht)->privdata, (entry)->key) + +#define Jim_SetHashKey(ht, entry, _key_) do { \ + if ((ht)->type->keyDup) \ + (entry)->key = (ht)->type->keyDup((ht)->privdata, (_key_)); \ + else \ + (entry)->key = (void *)(_key_); \ +} while(0) + +#define Jim_CompareHashKeys(ht, key1, key2) \ + (((ht)->type->keyCompare) ? \ + (ht)->type->keyCompare((ht)->privdata, (key1), (key2)) : \ + (key1) == (key2)) + +#define Jim_HashKey(ht, key) ((ht)->type->hashFunction(key) + (ht)->uniq) + +#define Jim_GetHashEntryKey(he) ((he)->key) +#define Jim_GetHashEntryVal(he) ((he)->u.val) +#define Jim_GetHashTableCollisions(ht) ((ht)->collisions) +#define Jim_GetHashTableSize(ht) ((ht)->size) +#define Jim_GetHashTableUsed(ht) ((ht)->used) + + +typedef struct Jim_Obj { + char *bytes; + const struct Jim_ObjType *typePtr; + int refCount; + int length; + + union { + + jim_wide wideValue; + + int intValue; + + double doubleValue; + + void *ptr; + + struct { + void *ptr1; + void *ptr2; + } twoPtrValue; + + struct { + struct Jim_Var *varPtr; + unsigned long callFrameId; + int global; + } varValue; + + struct { + struct Jim_Obj *nsObj; + struct Jim_Cmd *cmdPtr; + unsigned long procEpoch; + } cmdValue; + + struct { + struct Jim_Obj **ele; + int len; + int maxLen; + } listValue; + + struct { + int maxLength; + int charLength; + } strValue; + + struct { + unsigned long id; + struct Jim_Reference *refPtr; + } refValue; + + struct { + struct Jim_Obj *fileNameObj; + int lineNumber; + } sourceValue; + + struct { + struct Jim_Obj *varNameObjPtr; + struct Jim_Obj *indexObjPtr; + } dictSubstValue; + + struct { + void *compre; + unsigned flags; + } regexpValue; + struct { + int line; + int argc; + } scriptLineValue; + } internalRep; + struct Jim_Obj *prevObjPtr; + struct Jim_Obj *nextObjPtr; +} Jim_Obj; + + +#define Jim_IncrRefCount(objPtr) \ + ++(objPtr)->refCount +#define Jim_DecrRefCount(interp, objPtr) \ + if (--(objPtr)->refCount <= 0) Jim_FreeObj(interp, objPtr) +#define Jim_IsShared(objPtr) \ + ((objPtr)->refCount > 1) + +#define Jim_FreeNewObj Jim_FreeObj + + +#define Jim_FreeIntRep(i,o) \ + if ((o)->typePtr && (o)->typePtr->freeIntRepProc) \ + (o)->typePtr->freeIntRepProc(i, o) + + +#define Jim_GetIntRepPtr(o) (o)->internalRep.ptr + + +#define Jim_SetIntRepPtr(o, p) \ + (o)->internalRep.ptr = (p) + + +struct Jim_Interp; + +typedef void (Jim_FreeInternalRepProc)(struct Jim_Interp *interp, + struct Jim_Obj *objPtr); +typedef void (Jim_DupInternalRepProc)(struct Jim_Interp *interp, + struct Jim_Obj *srcPtr, Jim_Obj *dupPtr); +typedef void (Jim_UpdateStringProc)(struct Jim_Obj *objPtr); + +typedef struct Jim_ObjType { + const char *name; + Jim_FreeInternalRepProc *freeIntRepProc; + Jim_DupInternalRepProc *dupIntRepProc; + Jim_UpdateStringProc *updateStringProc; + int flags; +} Jim_ObjType; + + +#define JIM_TYPE_NONE 0 +#define JIM_TYPE_REFERENCES 1 + + + +typedef struct Jim_CallFrame { + unsigned long id; + int level; + struct Jim_HashTable vars; + struct Jim_HashTable *staticVars; + struct Jim_CallFrame *parent; + Jim_Obj *const *argv; + int argc; + Jim_Obj *procArgsObjPtr; + Jim_Obj *procBodyObjPtr; + struct Jim_CallFrame *next; + Jim_Obj *nsObj; + Jim_Obj *fileNameObj; + int line; + Jim_Stack *localCommands; + struct Jim_Obj *tailcallObj; + struct Jim_Cmd *tailcallCmd; +} Jim_CallFrame; + +typedef struct Jim_Var { + Jim_Obj *objPtr; + struct Jim_CallFrame *linkFramePtr; +} Jim_Var; + + +typedef int Jim_CmdProc(struct Jim_Interp *interp, int argc, + Jim_Obj *const *argv); +typedef void Jim_DelCmdProc(struct Jim_Interp *interp, void *privData); + + + +typedef struct Jim_Cmd { + int inUse; + int isproc; + struct Jim_Cmd *prevCmd; + union { + struct { + + Jim_CmdProc *cmdProc; + Jim_DelCmdProc *delProc; + void *privData; + } native; + struct { + + Jim_Obj *argListObjPtr; + Jim_Obj *bodyObjPtr; + Jim_HashTable *staticVars; + int argListLen; + int reqArity; + int optArity; + int argsPos; + int upcall; + struct Jim_ProcArg { + Jim_Obj *nameObjPtr; + Jim_Obj *defaultObjPtr; + } *arglist; + Jim_Obj *nsObj; + } proc; + } u; +} Jim_Cmd; + + +typedef struct Jim_PrngState { + unsigned char sbox[256]; + unsigned int i, j; +} Jim_PrngState; + +typedef struct Jim_Interp { + Jim_Obj *result; + int errorLine; + Jim_Obj *errorFileNameObj; + int addStackTrace; + int maxCallFrameDepth; + int maxEvalDepth; + int evalDepth; + int returnCode; + int returnLevel; + int exitCode; + long id; + int signal_level; + jim_wide sigmask; + int (*signal_set_result)(struct Jim_Interp *interp, jim_wide sigmask); + Jim_CallFrame *framePtr; + Jim_CallFrame *topFramePtr; + struct Jim_HashTable commands; + unsigned long procEpoch; /* Incremented every time the result + of procedures names lookup caching + may no longer be valid. */ + unsigned long callFrameEpoch; /* Incremented every time a new + callframe is created. This id is used for the + 'ID' field contained in the Jim_CallFrame + structure. */ + int local; + Jim_Obj *liveList; + Jim_Obj *freeList; + Jim_Obj *currentScriptObj; + Jim_Obj *nullScriptObj; + Jim_Obj *emptyObj; + Jim_Obj *trueObj; + Jim_Obj *falseObj; + unsigned long referenceNextId; + struct Jim_HashTable references; + unsigned long lastCollectId; /* reference max Id of the last GC + execution. It's set to -1 while the collection + is running as sentinel to avoid to recursive + calls via the [collect] command inside + finalizers. */ + time_t lastCollectTime; + Jim_Obj *stackTrace; + Jim_Obj *errorProc; + Jim_Obj *unknown; + int unknown_called; + int errorFlag; + void *cmdPrivData; /* Used to pass the private data pointer to + a command. It is set to what the user specified + via Jim_CreateCommand(). */ + + struct Jim_CallFrame *freeFramesList; + struct Jim_HashTable assocData; + Jim_PrngState *prngState; + struct Jim_HashTable packages; + Jim_Stack *loadHandles; +} Jim_Interp; + +#define Jim_InterpIncrProcEpoch(i) (i)->procEpoch++ +#define Jim_SetResultString(i,s,l) Jim_SetResult(i, Jim_NewStringObj(i,s,l)) +#define Jim_SetResultInt(i,intval) Jim_SetResult(i, Jim_NewIntObj(i,intval)) + +#define Jim_SetResultBool(i,b) Jim_SetResultInt(i, b) +#define Jim_SetEmptyResult(i) Jim_SetResult(i, (i)->emptyObj) +#define Jim_GetResult(i) ((i)->result) +#define Jim_CmdPrivData(i) ((i)->cmdPrivData) + +#define Jim_SetResult(i,o) do { \ + Jim_Obj *_resultObjPtr_ = (o); \ + Jim_IncrRefCount(_resultObjPtr_); \ + Jim_DecrRefCount(i,(i)->result); \ + (i)->result = _resultObjPtr_; \ +} while(0) + + +#define Jim_GetId(i) (++(i)->id) + + +#define JIM_REFERENCE_TAGLEN 7 /* The tag is fixed-length, because the reference + string representation must be fixed length. */ +typedef struct Jim_Reference { + Jim_Obj *objPtr; + Jim_Obj *finalizerCmdNamePtr; + char tag[JIM_REFERENCE_TAGLEN+1]; +} Jim_Reference; + + +#define Jim_NewEmptyStringObj(i) Jim_NewStringObj(i, "", 0) +#define Jim_FreeHashTableIterator(iter) Jim_Free(iter) + +#define JIM_EXPORT + + +JIM_EXPORT void *Jim_Alloc (int size); +JIM_EXPORT void *Jim_Realloc(void *ptr, int size); +JIM_EXPORT void Jim_Free (void *ptr); +JIM_EXPORT char * Jim_StrDup (const char *s); +JIM_EXPORT char *Jim_StrDupLen(const char *s, int l); + + +JIM_EXPORT char **Jim_GetEnviron(void); +JIM_EXPORT void Jim_SetEnviron(char **env); +JIM_EXPORT int Jim_MakeTempFile(Jim_Interp *interp, const char *template); + + +JIM_EXPORT int Jim_Eval(Jim_Interp *interp, const char *script); + + +JIM_EXPORT int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script); + +#define Jim_Eval_Named(I, S, F, L) Jim_EvalSource((I), (F), (L), (S)) + +JIM_EXPORT int Jim_EvalGlobal(Jim_Interp *interp, const char *script); +JIM_EXPORT int Jim_EvalFile(Jim_Interp *interp, const char *filename); +JIM_EXPORT int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename); +JIM_EXPORT int Jim_EvalObj (Jim_Interp *interp, Jim_Obj *scriptObjPtr); +JIM_EXPORT int Jim_EvalObjVector (Jim_Interp *interp, int objc, + Jim_Obj *const *objv); +JIM_EXPORT int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listObj); +JIM_EXPORT int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, + int objc, Jim_Obj *const *objv); +#define Jim_EvalPrefix(i, p, oc, ov) Jim_EvalObjPrefix((i), Jim_NewStringObj((i), (p), -1), (oc), (ov)) +JIM_EXPORT int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj); +JIM_EXPORT int Jim_SubstObj (Jim_Interp *interp, Jim_Obj *substObjPtr, + Jim_Obj **resObjPtrPtr, int flags); + + +JIM_EXPORT void Jim_InitStack(Jim_Stack *stack); +JIM_EXPORT void Jim_FreeStack(Jim_Stack *stack); +JIM_EXPORT int Jim_StackLen(Jim_Stack *stack); +JIM_EXPORT void Jim_StackPush(Jim_Stack *stack, void *element); +JIM_EXPORT void * Jim_StackPop(Jim_Stack *stack); +JIM_EXPORT void * Jim_StackPeek(Jim_Stack *stack); +JIM_EXPORT void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc)(void *ptr)); + + +JIM_EXPORT int Jim_InitHashTable (Jim_HashTable *ht, + const Jim_HashTableType *type, void *privdata); +JIM_EXPORT void Jim_ExpandHashTable (Jim_HashTable *ht, + unsigned int size); +JIM_EXPORT int Jim_AddHashEntry (Jim_HashTable *ht, const void *key, + void *val); +JIM_EXPORT int Jim_ReplaceHashEntry (Jim_HashTable *ht, + const void *key, void *val); +JIM_EXPORT int Jim_DeleteHashEntry (Jim_HashTable *ht, + const void *key); +JIM_EXPORT int Jim_FreeHashTable (Jim_HashTable *ht); +JIM_EXPORT Jim_HashEntry * Jim_FindHashEntry (Jim_HashTable *ht, + const void *key); +JIM_EXPORT void Jim_ResizeHashTable (Jim_HashTable *ht); +JIM_EXPORT Jim_HashTableIterator *Jim_GetHashTableIterator + (Jim_HashTable *ht); +JIM_EXPORT Jim_HashEntry * Jim_NextHashEntry + (Jim_HashTableIterator *iter); + + +JIM_EXPORT Jim_Obj * Jim_NewObj (Jim_Interp *interp); +JIM_EXPORT void Jim_FreeObj (Jim_Interp *interp, Jim_Obj *objPtr); +JIM_EXPORT void Jim_InvalidateStringRep (Jim_Obj *objPtr); +JIM_EXPORT Jim_Obj * Jim_DuplicateObj (Jim_Interp *interp, + Jim_Obj *objPtr); +JIM_EXPORT const char * Jim_GetString(Jim_Obj *objPtr, + int *lenPtr); +JIM_EXPORT const char *Jim_String(Jim_Obj *objPtr); +JIM_EXPORT int Jim_Length(Jim_Obj *objPtr); + + +JIM_EXPORT Jim_Obj * Jim_NewStringObj (Jim_Interp *interp, + const char *s, int len); +JIM_EXPORT Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, + const char *s, int charlen); +JIM_EXPORT Jim_Obj * Jim_NewStringObjNoAlloc (Jim_Interp *interp, + char *s, int len); +JIM_EXPORT void Jim_AppendString (Jim_Interp *interp, Jim_Obj *objPtr, + const char *str, int len); +JIM_EXPORT void Jim_AppendObj (Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj *appendObjPtr); +JIM_EXPORT void Jim_AppendStrings (Jim_Interp *interp, + Jim_Obj *objPtr, ...); +JIM_EXPORT int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr); +JIM_EXPORT int Jim_StringMatchObj (Jim_Interp *interp, Jim_Obj *patternObjPtr, + Jim_Obj *objPtr, int nocase); +JIM_EXPORT Jim_Obj * Jim_StringRangeObj (Jim_Interp *interp, + Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, + Jim_Obj *lastObjPtr); +JIM_EXPORT Jim_Obj * Jim_FormatString (Jim_Interp *interp, + Jim_Obj *fmtObjPtr, int objc, Jim_Obj *const *objv); +JIM_EXPORT Jim_Obj * Jim_ScanString (Jim_Interp *interp, Jim_Obj *strObjPtr, + Jim_Obj *fmtObjPtr, int flags); +JIM_EXPORT int Jim_CompareStringImmediate (Jim_Interp *interp, + Jim_Obj *objPtr, const char *str); +JIM_EXPORT int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, + Jim_Obj *secondObjPtr, int nocase); +JIM_EXPORT int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, + Jim_Obj *secondObjPtr, int nocase); +JIM_EXPORT int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr); + + +JIM_EXPORT Jim_Obj * Jim_NewReference (Jim_Interp *interp, + Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr); +JIM_EXPORT Jim_Reference * Jim_GetReference (Jim_Interp *interp, + Jim_Obj *objPtr); +JIM_EXPORT int Jim_SetFinalizer (Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr); +JIM_EXPORT int Jim_GetFinalizer (Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr); + + +JIM_EXPORT Jim_Interp * Jim_CreateInterp (void); +JIM_EXPORT void Jim_FreeInterp (Jim_Interp *i); +JIM_EXPORT int Jim_GetExitCode (Jim_Interp *interp); +JIM_EXPORT const char *Jim_ReturnCode(int code); +JIM_EXPORT void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...); + + +JIM_EXPORT void Jim_RegisterCoreCommands (Jim_Interp *interp); +JIM_EXPORT int Jim_CreateCommand (Jim_Interp *interp, + const char *cmdName, Jim_CmdProc *cmdProc, void *privData, + Jim_DelCmdProc *delProc); +JIM_EXPORT int Jim_DeleteCommand (Jim_Interp *interp, + const char *cmdName); +JIM_EXPORT int Jim_RenameCommand (Jim_Interp *interp, + const char *oldName, const char *newName); +JIM_EXPORT Jim_Cmd * Jim_GetCommand (Jim_Interp *interp, + Jim_Obj *objPtr, int flags); +JIM_EXPORT int Jim_SetVariable (Jim_Interp *interp, + Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr); +JIM_EXPORT int Jim_SetVariableStr (Jim_Interp *interp, + const char *name, Jim_Obj *objPtr); +JIM_EXPORT int Jim_SetGlobalVariableStr (Jim_Interp *interp, + const char *name, Jim_Obj *objPtr); +JIM_EXPORT int Jim_SetVariableStrWithStr (Jim_Interp *interp, + const char *name, const char *val); +JIM_EXPORT int Jim_SetVariableLink (Jim_Interp *interp, + Jim_Obj *nameObjPtr, Jim_Obj *targetNameObjPtr, + Jim_CallFrame *targetCallFrame); +JIM_EXPORT Jim_Obj * Jim_MakeGlobalNamespaceName(Jim_Interp *interp, + Jim_Obj *nameObjPtr); +JIM_EXPORT Jim_Obj * Jim_GetVariable (Jim_Interp *interp, + Jim_Obj *nameObjPtr, int flags); +JIM_EXPORT Jim_Obj * Jim_GetGlobalVariable (Jim_Interp *interp, + Jim_Obj *nameObjPtr, int flags); +JIM_EXPORT Jim_Obj * Jim_GetVariableStr (Jim_Interp *interp, + const char *name, int flags); +JIM_EXPORT Jim_Obj * Jim_GetGlobalVariableStr (Jim_Interp *interp, + const char *name, int flags); +JIM_EXPORT int Jim_UnsetVariable (Jim_Interp *interp, + Jim_Obj *nameObjPtr, int flags); + + +JIM_EXPORT Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, + Jim_Obj *levelObjPtr); + + +JIM_EXPORT int Jim_Collect (Jim_Interp *interp); +JIM_EXPORT void Jim_CollectIfNeeded (Jim_Interp *interp); + + +JIM_EXPORT int Jim_GetIndex (Jim_Interp *interp, Jim_Obj *objPtr, + int *indexPtr); + + +JIM_EXPORT Jim_Obj * Jim_NewListObj (Jim_Interp *interp, + Jim_Obj *const *elements, int len); +JIM_EXPORT void Jim_ListInsertElements (Jim_Interp *interp, + Jim_Obj *listPtr, int listindex, int objc, Jim_Obj *const *objVec); +JIM_EXPORT void Jim_ListAppendElement (Jim_Interp *interp, + Jim_Obj *listPtr, Jim_Obj *objPtr); +JIM_EXPORT void Jim_ListAppendList (Jim_Interp *interp, + Jim_Obj *listPtr, Jim_Obj *appendListPtr); +JIM_EXPORT int Jim_ListLength (Jim_Interp *interp, Jim_Obj *objPtr); +JIM_EXPORT int Jim_ListIndex (Jim_Interp *interp, Jim_Obj *listPrt, + int listindex, Jim_Obj **objPtrPtr, int seterr); +JIM_EXPORT Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx); +JIM_EXPORT int Jim_SetListIndex (Jim_Interp *interp, + Jim_Obj *varNamePtr, Jim_Obj *const *indexv, int indexc, + Jim_Obj *newObjPtr); +JIM_EXPORT Jim_Obj * Jim_ConcatObj (Jim_Interp *interp, int objc, + Jim_Obj *const *objv); +JIM_EXPORT Jim_Obj *Jim_ListJoin(Jim_Interp *interp, + Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen); + + +JIM_EXPORT Jim_Obj * Jim_NewDictObj (Jim_Interp *interp, + Jim_Obj *const *elements, int len); +JIM_EXPORT int Jim_DictKey (Jim_Interp *interp, Jim_Obj *dictPtr, + Jim_Obj *keyPtr, Jim_Obj **objPtrPtr, int flags); +JIM_EXPORT int Jim_DictKeysVector (Jim_Interp *interp, + Jim_Obj *dictPtr, Jim_Obj *const *keyv, int keyc, + Jim_Obj **objPtrPtr, int flags); +JIM_EXPORT int Jim_SetDictKeysVector (Jim_Interp *interp, + Jim_Obj *varNamePtr, Jim_Obj *const *keyv, int keyc, + Jim_Obj *newObjPtr, int flags); +JIM_EXPORT int Jim_DictPairs(Jim_Interp *interp, + Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len); +JIM_EXPORT int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr); +JIM_EXPORT int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObj); +JIM_EXPORT int Jim_DictValues(Jim_Interp *interp, Jim_Obj *dictObjPtr, Jim_Obj *patternObjPtr); +JIM_EXPORT int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr); +JIM_EXPORT int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr); + + +JIM_EXPORT int Jim_GetReturnCode (Jim_Interp *interp, Jim_Obj *objPtr, + int *intPtr); + + +JIM_EXPORT int Jim_EvalExpression (Jim_Interp *interp, + Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr); +JIM_EXPORT int Jim_GetBoolFromExpr (Jim_Interp *interp, + Jim_Obj *exprObjPtr, int *boolPtr); + + +JIM_EXPORT int Jim_GetWide (Jim_Interp *interp, Jim_Obj *objPtr, + jim_wide *widePtr); +JIM_EXPORT int Jim_GetLong (Jim_Interp *interp, Jim_Obj *objPtr, + long *longPtr); +#define Jim_NewWideObj Jim_NewIntObj +JIM_EXPORT Jim_Obj * Jim_NewIntObj (Jim_Interp *interp, + jim_wide wideValue); + + +JIM_EXPORT int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, + double *doublePtr); +JIM_EXPORT void Jim_SetDouble(Jim_Interp *interp, Jim_Obj *objPtr, + double doubleValue); +JIM_EXPORT Jim_Obj * Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue); + + +JIM_EXPORT void Jim_WrongNumArgs (Jim_Interp *interp, int argc, + Jim_Obj *const *argv, const char *msg); +JIM_EXPORT int Jim_GetEnum (Jim_Interp *interp, Jim_Obj *objPtr, + const char * const *tablePtr, int *indexPtr, const char *name, int flags); +JIM_EXPORT int Jim_ScriptIsComplete(Jim_Interp *interp, + Jim_Obj *scriptObj, char *stateCharPtr); + +JIM_EXPORT int Jim_FindByName(const char *name, const char * const array[], size_t len); + + +typedef void (Jim_InterpDeleteProc)(Jim_Interp *interp, void *data); +JIM_EXPORT void * Jim_GetAssocData(Jim_Interp *interp, const char *key); +JIM_EXPORT int Jim_SetAssocData(Jim_Interp *interp, const char *key, + Jim_InterpDeleteProc *delProc, void *data); +JIM_EXPORT int Jim_DeleteAssocData(Jim_Interp *interp, const char *key); + + + +JIM_EXPORT int Jim_PackageProvide (Jim_Interp *interp, + const char *name, const char *ver, int flags); +JIM_EXPORT int Jim_PackageRequire (Jim_Interp *interp, + const char *name, int flags); + + +JIM_EXPORT void Jim_MakeErrorMessage (Jim_Interp *interp); + + +JIM_EXPORT int Jim_InteractivePrompt (Jim_Interp *interp); +JIM_EXPORT void Jim_HistoryLoad(const char *filename); +JIM_EXPORT void Jim_HistorySave(const char *filename); +JIM_EXPORT char *Jim_HistoryGetline(const char *prompt); +JIM_EXPORT void Jim_HistoryAdd(const char *line); +JIM_EXPORT void Jim_HistoryShow(void); + + +JIM_EXPORT int Jim_InitStaticExtensions(Jim_Interp *interp); +JIM_EXPORT int Jim_StringToWide(const char *str, jim_wide *widePtr, int base); +JIM_EXPORT int Jim_IsBigEndian(void); + +#define Jim_CheckSignal(i) ((i)->signal_level && (i)->sigmask) + + +JIM_EXPORT int Jim_LoadLibrary(Jim_Interp *interp, const char *pathName); +JIM_EXPORT void Jim_FreeLoadHandles(Jim_Interp *interp); + + +JIM_EXPORT FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *command); + + +JIM_EXPORT int Jim_IsDict(Jim_Obj *objPtr); +JIM_EXPORT int Jim_IsList(Jim_Obj *objPtr); + +#ifdef __cplusplus +} +#endif + +#endif + +#ifndef JIM_SUBCMD_H +#define JIM_SUBCMD_H + + +#ifdef __cplusplus +extern "C" { +#endif + + +#define JIM_MODFLAG_HIDDEN 0x0001 +#define JIM_MODFLAG_FULLARGV 0x0002 + + + +typedef int jim_subcmd_function(Jim_Interp *interp, int argc, Jim_Obj *const *argv); + +typedef struct { + const char *cmd; + const char *args; + jim_subcmd_function *function; + short minargs; + short maxargs; + unsigned short flags; +} jim_subcmd_type; + +const jim_subcmd_type * +Jim_ParseSubCmd(Jim_Interp *interp, const jim_subcmd_type *command_table, int argc, Jim_Obj *const *argv); + +int Jim_SubCmdProc(Jim_Interp *interp, int argc, Jim_Obj *const *argv); + +int Jim_CallSubCmd(Jim_Interp *interp, const jim_subcmd_type *ct, int argc, Jim_Obj *const *argv); + +#ifdef __cplusplus +} +#endif + +#endif +#ifndef JIMREGEXP_H +#define JIMREGEXP_H + + +#ifdef __cplusplus +extern "C" { +#endif + +#include + +typedef struct { + int rm_so; + int rm_eo; +} regmatch_t; + + +typedef struct regexp { + + int re_nsub; + + + int cflags; + int err; + int regstart; + int reganch; + int regmust; + int regmlen; + int *program; + + + const char *regparse; + int p; + int proglen; + + + int eflags; + const char *start; + const char *reginput; + const char *regbol; + + + regmatch_t *pmatch; + int nmatch; +} regexp; + +typedef regexp regex_t; + +#define REG_EXTENDED 0 +#define REG_NEWLINE 1 +#define REG_ICASE 2 + +#define REG_NOTBOL 16 + +enum { + REG_NOERROR, + REG_NOMATCH, + REG_BADPAT, + REG_ERR_NULL_ARGUMENT, + REG_ERR_UNKNOWN, + REG_ERR_TOO_BIG, + REG_ERR_NOMEM, + REG_ERR_TOO_MANY_PAREN, + REG_ERR_UNMATCHED_PAREN, + REG_ERR_UNMATCHED_BRACES, + REG_ERR_BAD_COUNT, + REG_ERR_JUNK_ON_END, + REG_ERR_OPERAND_COULD_BE_EMPTY, + REG_ERR_NESTED_COUNT, + REG_ERR_INTERNAL, + REG_ERR_COUNT_FOLLOWS_NOTHING, + REG_ERR_TRAILING_BACKSLASH, + REG_ERR_CORRUPTED, + REG_ERR_NULL_CHAR, + REG_ERR_NUM +}; + +int regcomp(regex_t *preg, const char *regex, int cflags); +int regexec(regex_t *preg, const char *string, size_t nmatch, regmatch_t pmatch[], int eflags); +size_t regerror(int errcode, const regex_t *preg, char *errbuf, size_t errbuf_size); +void regfree(regex_t *preg); + +#ifdef __cplusplus +} +#endif + +#endif +int Jim_bootstrapInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "bootstrap", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + return Jim_EvalSource(interp, "bootstrap.tcl", 1, +"\n" +"\n" +"proc package {cmd pkg} {\n" +" if {$cmd eq \"require\"} {\n" +" foreach path $::auto_path {\n" +" if {[file exists $path/$pkg.tcl]} {\n" +" uplevel #0 [list source $path/$pkg.tcl]\n" +" return\n" +" }\n" +" }\n" +" }\n" +"}\n" +); +} +int Jim_initjimshInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "initjimsh", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + return Jim_EvalSource(interp, "initjimsh.tcl", 1, +"\n" +"\n" +"\n" +"proc _jimsh_init {} {\n" +" rename _jimsh_init {}\n" +" global jim::exe jim::argv0 tcl_interactive auto_path tcl_platform\n" +"\n" +"\n" +" if {[exists jim::argv0]} {\n" +" if {[string match \"*/*\" $jim::argv0]} {\n" +" set jim::exe [file join [pwd] $jim::argv0]\n" +" } else {\n" +" foreach path [split [env PATH \"\"] $tcl_platform(pathSeparator)] {\n" +" set exec [file join [pwd] [string map {\\\\ /} $path] $jim::argv0]\n" +" if {[file executable $exec]} {\n" +" set jim::exe $exec\n" +" break\n" +" }\n" +" }\n" +" }\n" +" }\n" +"\n" +"\n" +" lappend p {*}[split [env JIMLIB {}] $tcl_platform(pathSeparator)]\n" +" if {[exists jim::exe]} {\n" +" lappend p [file dirname $jim::exe]\n" +" }\n" +" lappend p {*}$auto_path\n" +" set auto_path $p\n" +"\n" +" if {$tcl_interactive && [env HOME {}] ne \"\"} {\n" +" foreach src {.jimrc jimrc.tcl} {\n" +" if {[file exists [env HOME]/$src]} {\n" +" uplevel #0 source [env HOME]/$src\n" +" break\n" +" }\n" +" }\n" +" }\n" +" return \"\"\n" +"}\n" +"\n" +"if {$tcl_platform(platform) eq \"windows\"} {\n" +" set jim::argv0 [string map {\\\\ /} $jim::argv0]\n" +"}\n" +"\n" +"_jimsh_init\n" +); +} +int Jim_globInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "glob", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + return Jim_EvalSource(interp, "glob.tcl", 1, +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"package require readdir\n" +"\n" +"\n" +"proc glob.globdir {dir pattern} {\n" +" if {[file exists $dir/$pattern]} {\n" +"\n" +" return [list $pattern]\n" +" }\n" +"\n" +" set result {}\n" +" set files [readdir $dir]\n" +" lappend files . ..\n" +"\n" +" foreach name $files {\n" +" if {[string match $pattern $name]} {\n" +"\n" +" if {[string index $name 0] eq \".\" && [string index $pattern 0] ne \".\"} {\n" +" continue\n" +" }\n" +" lappend result $name\n" +" }\n" +" }\n" +"\n" +" return $result\n" +"}\n" +"\n" +"\n" +"\n" +"\n" +"proc glob.explode {pattern} {\n" +" set oldexp {}\n" +" set newexp {\"\"}\n" +"\n" +" while 1 {\n" +" set oldexp $newexp\n" +" set newexp {}\n" +" set ob [string first \\{ $pattern]\n" +" set cb [string first \\} $pattern]\n" +"\n" +" if {$ob < $cb && $ob != -1} {\n" +" set mid [string range $pattern 0 $ob-1]\n" +" set subexp [lassign [glob.explode [string range $pattern $ob+1 end]] pattern]\n" +" if {$pattern eq \"\"} {\n" +" error \"unmatched open brace in glob pattern\"\n" +" }\n" +" set pattern [string range $pattern 1 end]\n" +"\n" +" foreach subs $subexp {\n" +" foreach sub [split $subs ,] {\n" +" foreach old $oldexp {\n" +" lappend newexp $old$mid$sub\n" +" }\n" +" }\n" +" }\n" +" } elseif {$cb != -1} {\n" +" set suf [string range $pattern 0 $cb-1]\n" +" set rest [string range $pattern $cb end]\n" +" break\n" +" } else {\n" +" set suf $pattern\n" +" set rest \"\"\n" +" break\n" +" }\n" +" }\n" +"\n" +" foreach old $oldexp {\n" +" lappend newexp $old$suf\n" +" }\n" +" list $rest {*}$newexp\n" +"}\n" +"\n" +"\n" +"\n" +"proc glob.glob {base pattern} {\n" +" set dir [file dirname $pattern]\n" +" if {$pattern eq $dir || $pattern eq \"\"} {\n" +" return [list [file join $base $dir] $pattern]\n" +" } elseif {$pattern eq [file tail $pattern]} {\n" +" set dir \"\"\n" +" }\n" +"\n" +"\n" +" set dirlist [glob.glob $base $dir]\n" +" set pattern [file tail $pattern]\n" +"\n" +"\n" +" set result {}\n" +" foreach {realdir dir} $dirlist {\n" +" if {![file isdir $realdir]} {\n" +" continue\n" +" }\n" +" if {[string index $dir end] ne \"/\" && $dir ne \"\"} {\n" +" append dir /\n" +" }\n" +" foreach name [glob.globdir $realdir $pattern] {\n" +" lappend result [file join $realdir $name] $dir$name\n" +" }\n" +" }\n" +" return $result\n" +"}\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"proc glob {args} {\n" +" set nocomplain 0\n" +" set base \"\"\n" +" set tails 0\n" +"\n" +" set n 0\n" +" foreach arg $args {\n" +" if {[info exists param]} {\n" +" set $param $arg\n" +" unset param\n" +" incr n\n" +" continue\n" +" }\n" +" switch -glob -- $arg {\n" +" -d* {\n" +" set switch $arg\n" +" set param base\n" +" }\n" +" -n* {\n" +" set nocomplain 1\n" +" }\n" +" -ta* {\n" +" set tails 1\n" +" }\n" +" -- {\n" +" incr n\n" +" break\n" +" }\n" +" -* {\n" +" return -code error \"bad option \\\"$arg\\\": must be -directory, -nocomplain, -tails, or --\"\n" +" }\n" +" * {\n" +" break\n" +" }\n" +" }\n" +" incr n\n" +" }\n" +" if {[info exists param]} {\n" +" return -code error \"missing argument to \\\"$switch\\\"\"\n" +" }\n" +" if {[llength $args] <= $n} {\n" +" return -code error \"wrong # args: should be \\\"glob ?options? pattern ?pattern ...?\\\"\"\n" +" }\n" +"\n" +" set args [lrange $args $n end]\n" +"\n" +" set result {}\n" +" foreach pattern $args {\n" +" set escpattern [string map {\n" +" \\\\\\\\ \\x01 \\\\\\{ \\x02 \\\\\\} \\x03 \\\\, \\x04\n" +" } $pattern]\n" +" set patexps [lassign [glob.explode $escpattern] rest]\n" +" if {$rest ne \"\"} {\n" +" return -code error \"unmatched close brace in glob pattern\"\n" +" }\n" +" foreach patexp $patexps {\n" +" set patexp [string map {\n" +" \\x01 \\\\\\\\ \\x02 \\{ \\x03 \\} \\x04 ,\n" +" } $patexp]\n" +" foreach {realname name} [glob.glob $base $patexp] {\n" +" incr n\n" +" if {$tails} {\n" +" lappend result $name\n" +" } else {\n" +" lappend result [file join $base $name]\n" +" }\n" +" }\n" +" }\n" +" }\n" +"\n" +" if {!$nocomplain && [llength $result] == 0} {\n" +" set s $(([llength $args] > 1) ? \"s\" : \"\")\n" +" return -code error \"no files matched glob pattern$s \\\"[join $args]\\\"\"\n" +" }\n" +"\n" +" return $result\n" +"}\n" +); +} +int Jim_stdlibInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "stdlib", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + return Jim_EvalSource(interp, "stdlib.tcl", 1, +"\n" +"\n" +"\n" +"proc lambda {arglist args} {\n" +" tailcall proc [ref {} function lambda.finalizer] $arglist {*}$args\n" +"}\n" +"\n" +"proc lambda.finalizer {name val} {\n" +" rename $name {}\n" +"}\n" +"\n" +"\n" +"proc curry {args} {\n" +" alias [ref {} function lambda.finalizer] {*}$args\n" +"}\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"proc function {value} {\n" +" return $value\n" +"}\n" +"\n" +"\n" +"\n" +"\n" +"proc stacktrace {{skip 0}} {\n" +" set trace {}\n" +" incr skip\n" +" foreach level [range $skip [info level]] {\n" +" lappend trace {*}[info frame -$level]\n" +" }\n" +" return $trace\n" +"}\n" +"\n" +"\n" +"proc stackdump {stacktrace} {\n" +" set lines {}\n" +" foreach {l f p} [lreverse $stacktrace] {\n" +" set line {}\n" +" if {$p ne \"\"} {\n" +" append line \"in procedure '$p' \"\n" +" if {$f ne \"\"} {\n" +" append line \"called \"\n" +" }\n" +" }\n" +" if {$f ne \"\"} {\n" +" append line \"at file \\\"$f\\\", line $l\"\n" +" }\n" +" if {$line ne \"\"} {\n" +" lappend lines $line\n" +" }\n" +" }\n" +" join $lines \\n\n" +"}\n" +"\n" +"\n" +"\n" +"proc errorInfo {msg {stacktrace \"\"}} {\n" +" if {$stacktrace eq \"\"} {\n" +"\n" +" set stacktrace [info stacktrace]\n" +"\n" +" lappend stacktrace {*}[stacktrace 1]\n" +" }\n" +" lassign $stacktrace p f l\n" +" if {$f ne \"\"} {\n" +" set result \"$f:$l: Error: \"\n" +" }\n" +" append result \"$msg\\n\"\n" +" append result [stackdump $stacktrace]\n" +"\n" +"\n" +" string trim $result\n" +"}\n" +"\n" +"\n" +"\n" +"proc {info nameofexecutable} {} {\n" +" if {[exists ::jim::exe]} {\n" +" return $::jim::exe\n" +" }\n" +"}\n" +"\n" +"\n" +"proc {dict with} {&dictVar {args key} script} {\n" +" set keys {}\n" +" foreach {n v} [dict get $dictVar {*}$key] {\n" +" upvar $n var_$n\n" +" set var_$n $v\n" +" lappend keys $n\n" +" }\n" +" catch {uplevel 1 $script} msg opts\n" +" if {[info exists dictVar] && ([llength $key] == 0 || [dict exists $dictVar {*}$key])} {\n" +" foreach n $keys {\n" +" if {[info exists var_$n]} {\n" +" dict set dictVar {*}$key $n [set var_$n]\n" +" } else {\n" +" dict unset dictVar {*}$key $n\n" +" }\n" +" }\n" +" }\n" +" return {*}$opts $msg\n" +"}\n" +"\n" +"\n" +"proc {dict update} {&varName args script} {\n" +" set keys {}\n" +" foreach {n v} $args {\n" +" upvar $v var_$v\n" +" if {[dict exists $varName $n]} {\n" +" set var_$v [dict get $varName $n]\n" +" }\n" +" }\n" +" catch {uplevel 1 $script} msg opts\n" +" if {[info exists varName]} {\n" +" foreach {n v} $args {\n" +" if {[info exists var_$v]} {\n" +" dict set varName $n [set var_$v]\n" +" } else {\n" +" dict unset varName $n\n" +" }\n" +" }\n" +" }\n" +" return {*}$opts $msg\n" +"}\n" +"\n" +"\n" +"\n" +"proc {dict merge} {dict args} {\n" +" foreach d $args {\n" +"\n" +" dict size $d\n" +" foreach {k v} $d {\n" +" dict set dict $k $v\n" +" }\n" +" }\n" +" return $dict\n" +"}\n" +"\n" +"proc {dict replace} {dictionary {args {key value}}} {\n" +" if {[llength ${key value}] % 2} {\n" +" tailcall {dict replace}\n" +" }\n" +" tailcall dict merge $dictionary ${key value}\n" +"}\n" +"\n" +"\n" +"proc {dict lappend} {varName key {args value}} {\n" +" upvar $varName dict\n" +" if {[exists dict] && [dict exists $dict $key]} {\n" +" set list [dict get $dict $key]\n" +" }\n" +" lappend list {*}$value\n" +" dict set dict $key $list\n" +"}\n" +"\n" +"\n" +"proc {dict append} {varName key {args value}} {\n" +" upvar $varName dict\n" +" if {[exists dict] && [dict exists $dict $key]} {\n" +" set str [dict get $dict $key]\n" +" }\n" +" append str {*}$value\n" +" dict set dict $key $str\n" +"}\n" +"\n" +"\n" +"proc {dict incr} {varName key {increment 1}} {\n" +" upvar $varName dict\n" +" if {[exists dict] && [dict exists $dict $key]} {\n" +" set value [dict get $dict $key]\n" +" }\n" +" incr value $increment\n" +" dict set dict $key $value\n" +"}\n" +"\n" +"\n" +"proc {dict remove} {dictionary {args key}} {\n" +" foreach k $key {\n" +" dict unset dictionary $k\n" +" }\n" +" return $dictionary\n" +"}\n" +"\n" +"\n" +"proc {dict values} {dictionary {pattern *}} {\n" +" dict keys [lreverse $dictionary] $pattern\n" +"}\n" +"\n" +"\n" +"proc {dict for} {vars dictionary script} {\n" +" if {[llength $vars] != 2} {\n" +" return -code error \"must have exactly two variable names\"\n" +" }\n" +" dict size $dictionary\n" +" tailcall foreach $vars $dictionary $script\n" +"}\n" +); +} +int Jim_tclcompatInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "tclcompat", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + return Jim_EvalSource(interp, "tclcompat.tcl", 1, +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"set env [env]\n" +"\n" +"\n" +"if {[info commands stdout] ne \"\"} {\n" +"\n" +" foreach p {gets flush close eof seek tell} {\n" +" proc $p {chan args} {p} {\n" +" tailcall $chan $p {*}$args\n" +" }\n" +" }\n" +" unset p\n" +"\n" +"\n" +"\n" +" proc puts {{-nonewline {}} {chan stdout} msg} {\n" +" if {${-nonewline} ni {-nonewline {}}} {\n" +" tailcall ${-nonewline} puts $msg\n" +" }\n" +" tailcall $chan puts {*}${-nonewline} $msg\n" +" }\n" +"\n" +"\n" +"\n" +"\n" +"\n" +" proc read {{-nonewline {}} chan} {\n" +" if {${-nonewline} ni {-nonewline {}}} {\n" +" tailcall ${-nonewline} read {*}${chan}\n" +" }\n" +" tailcall $chan read {*}${-nonewline}\n" +" }\n" +"\n" +" proc fconfigure {f args} {\n" +" foreach {n v} $args {\n" +" switch -glob -- $n {\n" +" -bl* {\n" +" $f ndelay $(!$v)\n" +" }\n" +" -bu* {\n" +" $f buffering $v\n" +" }\n" +" -tr* {\n" +"\n" +" }\n" +" default {\n" +" return -code error \"fconfigure: unknown option $n\"\n" +" }\n" +" }\n" +" }\n" +" }\n" +"}\n" +"\n" +"\n" +"proc fileevent {args} {\n" +" tailcall {*}$args\n" +"}\n" +"\n" +"\n" +"\n" +"\n" +"proc parray {arrayname {pattern *} {puts puts}} {\n" +" upvar $arrayname a\n" +"\n" +" set max 0\n" +" foreach name [array names a $pattern]] {\n" +" if {[string length $name] > $max} {\n" +" set max [string length $name]\n" +" }\n" +" }\n" +" incr max [string length $arrayname]\n" +" incr max 2\n" +" foreach name [lsort [array names a $pattern]] {\n" +" $puts [format \"%-${max}s = %s\" $arrayname\\($name\\) $a($name)]\n" +" }\n" +"}\n" +"\n" +"\n" +"proc {file copy} {{force {}} source target} {\n" +" try {\n" +" if {$force ni {{} -force}} {\n" +" error \"bad option \\\"$force\\\": should be -force\"\n" +" }\n" +"\n" +" set in [open $source rb]\n" +"\n" +" if {[file exists $target]} {\n" +" if {$force eq \"\"} {\n" +" error \"error copying \\\"$source\\\" to \\\"$target\\\": file already exists\"\n" +" }\n" +"\n" +" if {$source eq $target} {\n" +" return\n" +" }\n" +"\n" +"\n" +" file stat $source ss\n" +" file stat $target ts\n" +" if {$ss(dev) == $ts(dev) && $ss(ino) == $ts(ino) && $ss(ino)} {\n" +" return\n" +" }\n" +" }\n" +" set out [open $target wb]\n" +" $in copyto $out\n" +" $out close\n" +" } on error {msg opts} {\n" +" incr opts(-level)\n" +" return {*}$opts $msg\n" +" } finally {\n" +" catch {$in close}\n" +" }\n" +"}\n" +"\n" +"\n" +"\n" +"proc popen {cmd {mode r}} {\n" +" lassign [socket pipe] r w\n" +" try {\n" +" if {[string match \"w*\" $mode]} {\n" +" lappend cmd <@$r &\n" +" set pids [exec {*}$cmd]\n" +" $r close\n" +" set f $w\n" +" } else {\n" +" lappend cmd >@$w &\n" +" set pids [exec {*}$cmd]\n" +" $w close\n" +" set f $r\n" +" }\n" +" lambda {cmd args} {f pids} {\n" +" if {$cmd eq \"pid\"} {\n" +" return $pids\n" +" }\n" +" if {$cmd eq \"close\"} {\n" +" $f close\n" +"\n" +" foreach p $pids { os.wait $p }\n" +" return\n" +" }\n" +" tailcall $f $cmd {*}$args\n" +" }\n" +" } on error {error opts} {\n" +" $r close\n" +" $w close\n" +" error $error\n" +" }\n" +"}\n" +"\n" +"\n" +"local proc pid {{channelId {}}} {\n" +" if {$channelId eq \"\"} {\n" +" tailcall upcall pid\n" +" }\n" +" if {[catch {$channelId tell}]} {\n" +" return -code error \"can not find channel named \\\"$channelId\\\"\"\n" +" }\n" +" if {[catch {$channelId pid} pids]} {\n" +" return \"\"\n" +" }\n" +" return $pids\n" +"}\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"\n" +"proc try {args} {\n" +" set catchopts {}\n" +" while {[string match -* [lindex $args 0]]} {\n" +" set args [lassign $args opt]\n" +" if {$opt eq \"--\"} {\n" +" break\n" +" }\n" +" lappend catchopts $opt\n" +" }\n" +" if {[llength $args] == 0} {\n" +" return -code error {wrong # args: should be \"try ?options? script ?argument ...?\"}\n" +" }\n" +" set args [lassign $args script]\n" +" set code [catch -eval {*}$catchopts {uplevel 1 $script} msg opts]\n" +"\n" +" set handled 0\n" +"\n" +" foreach {on codes vars script} $args {\n" +" switch -- $on \\\n" +" on {\n" +" if {!$handled && ($codes eq \"*\" || [info returncode $code] in $codes)} {\n" +" lassign $vars msgvar optsvar\n" +" if {$msgvar ne \"\"} {\n" +" upvar $msgvar hmsg\n" +" set hmsg $msg\n" +" }\n" +" if {$optsvar ne \"\"} {\n" +" upvar $optsvar hopts\n" +" set hopts $opts\n" +" }\n" +"\n" +" set code [catch {uplevel 1 $script} msg opts]\n" +" incr handled\n" +" }\n" +" } \\\n" +" finally {\n" +" set finalcode [catch {uplevel 1 $codes} finalmsg finalopts]\n" +" if {$finalcode} {\n" +"\n" +" set code $finalcode\n" +" set msg $finalmsg\n" +" set opts $finalopts\n" +" }\n" +" break\n" +" } \\\n" +" default {\n" +" return -code error \"try: expected 'on' or 'finally', got '$on'\"\n" +" }\n" +" }\n" +"\n" +" if {$code} {\n" +" incr opts(-level)\n" +" return {*}$opts $msg\n" +" }\n" +" return $msg\n" +"}\n" +"\n" +"\n" +"\n" +"proc throw {code {msg \"\"}} {\n" +" return -code $code $msg\n" +"}\n" +"\n" +"\n" +"proc {file delete force} {path} {\n" +" foreach e [readdir $path] {\n" +" file delete -force $path/$e\n" +" }\n" +" file delete $path\n" +"}\n" +); +} + + +#include +#include +#include +#include +#ifdef HAVE_UNISTD_H +#include +#include +#endif + + +#if defined(HAVE_SYS_SOCKET_H) && defined(HAVE_SELECT) && defined(HAVE_NETINET_IN_H) && defined(HAVE_NETDB_H) && defined(HAVE_ARPA_INET_H) +#include +#include +#include +#include +#ifdef HAVE_SYS_UN_H +#include +#endif +#else +#define JIM_ANSIC +#endif + +#if defined(JIM_SSL) +#include +#include +#endif + + +#define AIO_CMD_LEN 32 +#define AIO_BUF_LEN 256 + +#ifndef HAVE_FTELLO + #define ftello ftell +#endif +#ifndef HAVE_FSEEKO + #define fseeko fseek +#endif + +#define AIO_KEEPOPEN 1 + +#if defined(JIM_IPV6) +#define IPV6 1 +#else +#define IPV6 0 +#ifndef PF_INET6 +#define PF_INET6 0 +#endif +#endif + +#define JimCheckStreamError(interp, af) af->fops->error(af) + + +struct AioFile; + +typedef struct { + int (*writer)(struct AioFile *af, const char *buf, int len); + int (*reader)(struct AioFile *af, char *buf, int len); + const char *(*getline)(struct AioFile *af, char *buf, int len); + int (*error)(const struct AioFile *af); + const char *(*strerror)(struct AioFile *af); + int (*verify)(struct AioFile *af); +} JimAioFopsType; + +typedef struct AioFile +{ + FILE *fp; + Jim_Obj *filename; + int type; + int openFlags; + int fd; + Jim_Obj *rEvent; + Jim_Obj *wEvent; + Jim_Obj *eEvent; + int addr_family; + void *ssl; + const JimAioFopsType *fops; +} AioFile; + +static int stdio_writer(struct AioFile *af, const char *buf, int len) +{ + return fwrite(buf, 1, len, af->fp); +} + +static int stdio_reader(struct AioFile *af, char *buf, int len) +{ + return fread(buf, 1, len, af->fp); +} + +static const char *stdio_getline(struct AioFile *af, char *buf, int len) +{ + return fgets(buf, len, af->fp); +} + +static int stdio_error(const AioFile *af) +{ + if (!ferror(af->fp)) { + return JIM_OK; + } + clearerr(af->fp); + + if (feof(af->fp) || errno == EAGAIN || errno == EINTR) { + return JIM_OK; + } +#ifdef ECONNRESET + if (errno == ECONNRESET) { + return JIM_OK; + } +#endif +#ifdef ECONNABORTED + if (errno != ECONNABORTED) { + return JIM_OK; + } +#endif + return JIM_ERR; +} + +static const char *stdio_strerror(struct AioFile *af) +{ + return strerror(errno); +} + +static const JimAioFopsType stdio_fops = { + stdio_writer, + stdio_reader, + stdio_getline, + stdio_error, + stdio_strerror, + NULL +}; + + +static int JimAioSubCmdProc(Jim_Interp *interp, int argc, Jim_Obj *const *argv); +static AioFile *JimMakeChannel(Jim_Interp *interp, FILE *fh, int fd, Jim_Obj *filename, + const char *hdlfmt, int family, const char *mode); + + +static const char *JimAioErrorString(AioFile *af) +{ + if (af && af->fops) + return af->fops->strerror(af); + + return strerror(errno); +} + +static void JimAioSetError(Jim_Interp *interp, Jim_Obj *name) +{ + AioFile *af = Jim_CmdPrivData(interp); + + if (name) { + Jim_SetResultFormatted(interp, "%#s: %s", name, JimAioErrorString(af)); + } + else { + Jim_SetResultString(interp, JimAioErrorString(af), -1); + } +} + +static void JimAioDelProc(Jim_Interp *interp, void *privData) +{ + AioFile *af = privData; + + JIM_NOTUSED(interp); + + Jim_DecrRefCount(interp, af->filename); + +#ifdef jim_ext_eventloop + + Jim_DeleteFileHandler(interp, af->fp, JIM_EVENT_READABLE | JIM_EVENT_WRITABLE | JIM_EVENT_EXCEPTION); +#endif + +#if defined(JIM_SSL) + if (af->ssl != NULL) { + SSL_free(af->ssl); + } +#endif + + if (!(af->openFlags & AIO_KEEPOPEN)) { + fclose(af->fp); + } + + Jim_Free(af); +} + +static int aio_cmd_read(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + char buf[AIO_BUF_LEN]; + Jim_Obj *objPtr; + int nonewline = 0; + jim_wide neededLen = -1; + + if (argc && Jim_CompareStringImmediate(interp, argv[0], "-nonewline")) { + nonewline = 1; + argv++; + argc--; + } + if (argc == 1) { + if (Jim_GetWide(interp, argv[0], &neededLen) != JIM_OK) + return JIM_ERR; + if (neededLen < 0) { + Jim_SetResultString(interp, "invalid parameter: negative len", -1); + return JIM_ERR; + } + } + else if (argc) { + return -1; + } + objPtr = Jim_NewStringObj(interp, NULL, 0); + while (neededLen != 0) { + int retval; + int readlen; + + if (neededLen == -1) { + readlen = AIO_BUF_LEN; + } + else { + readlen = (neededLen > AIO_BUF_LEN ? AIO_BUF_LEN : neededLen); + } + retval = af->fops->reader(af, buf, readlen); + if (retval > 0) { + Jim_AppendString(interp, objPtr, buf, retval); + if (neededLen != -1) { + neededLen -= retval; + } + } + if (retval != readlen) + break; + } + + if (JimCheckStreamError(interp, af)) { + Jim_FreeNewObj(interp, objPtr); + return JIM_ERR; + } + if (nonewline) { + int len; + const char *s = Jim_GetString(objPtr, &len); + + if (len > 0 && s[len - 1] == '\n') { + objPtr->length--; + objPtr->bytes[objPtr->length] = '\0'; + } + } + Jim_SetResult(interp, objPtr); + return JIM_OK; +} + +AioFile *Jim_AioFile(Jim_Interp *interp, Jim_Obj *command) +{ + Jim_Cmd *cmdPtr = Jim_GetCommand(interp, command, JIM_ERRMSG); + + + if (cmdPtr && !cmdPtr->isproc && cmdPtr->u.native.cmdProc == JimAioSubCmdProc) { + return (AioFile *) cmdPtr->u.native.privData; + } + Jim_SetResultFormatted(interp, "Not a filehandle: \"%#s\"", command); + return NULL; +} + +FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *command) +{ + AioFile *af; + + af = Jim_AioFile(interp, command); + if (af == NULL) { + return NULL; + } + + return af->fp; +} + +static int aio_cmd_copy(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + jim_wide count = 0; + jim_wide maxlen = JIM_WIDE_MAX; + AioFile *outf = Jim_AioFile(interp, argv[0]); + + if (outf == NULL) { + return JIM_ERR; + } + + if (argc == 2) { + if (Jim_GetWide(interp, argv[1], &maxlen) != JIM_OK) { + return JIM_ERR; + } + } + + while (count < maxlen) { + char ch; + + if (af->fops->reader(af, &ch, 1) != 1) { + break; + } + if (outf->fops->writer(outf, &ch, 1) != 1) { + break; + } + count++; + } + + if (JimCheckStreamError(interp, af) || JimCheckStreamError(interp, outf)) { + return JIM_ERR; + } + + Jim_SetResultInt(interp, count); + + return JIM_OK; +} + +static int aio_cmd_gets(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + char buf[AIO_BUF_LEN]; + Jim_Obj *objPtr; + int len; + + errno = 0; + + objPtr = Jim_NewStringObj(interp, NULL, 0); + while (1) { + buf[AIO_BUF_LEN - 1] = '_'; + + if (af->fops->getline(af, buf, AIO_BUF_LEN) == NULL) + break; + + if (buf[AIO_BUF_LEN - 1] == '\0' && buf[AIO_BUF_LEN - 2] != '\n') { + Jim_AppendString(interp, objPtr, buf, AIO_BUF_LEN - 1); + } + else { + len = strlen(buf); + + if (len && (buf[len - 1] == '\n')) { + + len--; + } + + Jim_AppendString(interp, objPtr, buf, len); + break; + } + } + + if (JimCheckStreamError(interp, af)) { + + Jim_FreeNewObj(interp, objPtr); + return JIM_ERR; + } + + if (argc) { + if (Jim_SetVariable(interp, argv[0], objPtr) != JIM_OK) { + Jim_FreeNewObj(interp, objPtr); + return JIM_ERR; + } + + len = Jim_Length(objPtr); + + if (len == 0 && feof(af->fp)) { + + len = -1; + } + Jim_SetResultInt(interp, len); + } + else { + Jim_SetResult(interp, objPtr); + } + return JIM_OK; +} + +static int aio_cmd_puts(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + int wlen; + const char *wdata; + Jim_Obj *strObj; + + if (argc == 2) { + if (!Jim_CompareStringImmediate(interp, argv[0], "-nonewline")) { + return -1; + } + strObj = argv[1]; + } + else { + strObj = argv[0]; + } + + wdata = Jim_GetString(strObj, &wlen); + if (af->fops->writer(af, wdata, wlen) == wlen) { + if (argc == 2 || af->fops->writer(af, "\n", 1) == 1) { + return JIM_OK; + } + } + JimAioSetError(interp, af->filename); + return JIM_ERR; +} + +static int aio_cmd_isatty(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ +#ifdef HAVE_ISATTY + AioFile *af = Jim_CmdPrivData(interp); + Jim_SetResultInt(interp, isatty(fileno(af->fp))); +#else + Jim_SetResultInt(interp, 0); +#endif + + return JIM_OK; +} + + +static int aio_cmd_flush(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + if (fflush(af->fp) == EOF) { + JimAioSetError(interp, af->filename); + return JIM_ERR; + } + return JIM_OK; +} + +static int aio_cmd_eof(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + Jim_SetResultInt(interp, feof(af->fp)); + return JIM_OK; +} + +static int aio_cmd_close(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc == 3) { +#if !defined(JIM_ANSIC) && defined(HAVE_SHUTDOWN) + static const char * const options[] = { "r", "w", NULL }; + enum { OPT_R, OPT_W, }; + int option; + AioFile *af = Jim_CmdPrivData(interp); + + if (Jim_GetEnum(interp, argv[2], options, &option, NULL, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + if (shutdown(af->fd, option == OPT_R ? SHUT_RD : SHUT_WR) == 0) { + return JIM_OK; + } + JimAioSetError(interp, NULL); +#else + Jim_SetResultString(interp, "async close not supported", -1); +#endif + return JIM_ERR; + } + + return Jim_DeleteCommand(interp, Jim_String(argv[0])); +} + +static int aio_cmd_seek(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + int orig = SEEK_SET; + jim_wide offset; + + if (argc == 2) { + if (Jim_CompareStringImmediate(interp, argv[1], "start")) + orig = SEEK_SET; + else if (Jim_CompareStringImmediate(interp, argv[1], "current")) + orig = SEEK_CUR; + else if (Jim_CompareStringImmediate(interp, argv[1], "end")) + orig = SEEK_END; + else { + return -1; + } + } + if (Jim_GetWide(interp, argv[0], &offset) != JIM_OK) { + return JIM_ERR; + } + if (fseeko(af->fp, offset, orig) == -1) { + JimAioSetError(interp, af->filename); + return JIM_ERR; + } + return JIM_OK; +} + +static int aio_cmd_tell(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + Jim_SetResultInt(interp, ftello(af->fp)); + return JIM_OK; +} + +static int aio_cmd_filename(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + Jim_SetResult(interp, af->filename); + return JIM_OK; +} + +#ifdef O_NDELAY +static int aio_cmd_ndelay(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + int fmode = fcntl(af->fd, F_GETFL); + + if (argc) { + long nb; + + if (Jim_GetLong(interp, argv[0], &nb) != JIM_OK) { + return JIM_ERR; + } + if (nb) { + fmode |= O_NDELAY; + } + else { + fmode &= ~O_NDELAY; + } + (void)fcntl(af->fd, F_SETFL, fmode); + } + Jim_SetResultInt(interp, (fmode & O_NONBLOCK) ? 1 : 0); + return JIM_OK; +} +#endif + +#ifdef HAVE_FSYNC +static int aio_cmd_sync(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + fflush(af->fp); + fsync(af->fd); + return JIM_OK; +} +#endif + +static int aio_cmd_buffering(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + static const char * const options[] = { + "none", + "line", + "full", + NULL + }; + enum + { + OPT_NONE, + OPT_LINE, + OPT_FULL, + }; + int option; + + if (Jim_GetEnum(interp, argv[0], options, &option, NULL, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + switch (option) { + case OPT_NONE: + setvbuf(af->fp, NULL, _IONBF, 0); + break; + case OPT_LINE: + setvbuf(af->fp, NULL, _IOLBF, BUFSIZ); + break; + case OPT_FULL: + setvbuf(af->fp, NULL, _IOFBF, BUFSIZ); + break; + } + return JIM_OK; +} + +#ifdef jim_ext_eventloop +static void JimAioFileEventFinalizer(Jim_Interp *interp, void *clientData) +{ + Jim_Obj **objPtrPtr = clientData; + + Jim_DecrRefCount(interp, *objPtrPtr); + *objPtrPtr = NULL; +} + +static int JimAioFileEventHandler(Jim_Interp *interp, void *clientData, int mask) +{ + Jim_Obj **objPtrPtr = clientData; + + return Jim_EvalObjBackground(interp, *objPtrPtr); +} + +static int aio_eventinfo(Jim_Interp *interp, AioFile * af, unsigned mask, Jim_Obj **scriptHandlerObj, + int argc, Jim_Obj * const *argv) +{ + if (argc == 0) { + + if (*scriptHandlerObj) { + Jim_SetResult(interp, *scriptHandlerObj); + } + return JIM_OK; + } + + if (*scriptHandlerObj) { + + Jim_DeleteFileHandler(interp, af->fp, mask); + } + + + if (Jim_Length(argv[0]) == 0) { + + return JIM_OK; + } + + + Jim_IncrRefCount(argv[0]); + *scriptHandlerObj = argv[0]; + + Jim_CreateFileHandler(interp, af->fp, mask, + JimAioFileEventHandler, scriptHandlerObj, JimAioFileEventFinalizer); + + return JIM_OK; +} + +static int aio_cmd_readable(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + return aio_eventinfo(interp, af, JIM_EVENT_READABLE, &af->rEvent, argc, argv); +} + +static int aio_cmd_writable(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + return aio_eventinfo(interp, af, JIM_EVENT_WRITABLE, &af->wEvent, argc, argv); +} + +static int aio_cmd_onexception(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + AioFile *af = Jim_CmdPrivData(interp); + + return aio_eventinfo(interp, af, JIM_EVENT_EXCEPTION, &af->eEvent, argc, argv); +} +#endif + + +static const jim_subcmd_type aio_command_table[] = { + { "read", + "?-nonewline? ?len?", + aio_cmd_read, + 0, + 2, + + }, + { "copyto", + "handle ?size?", + aio_cmd_copy, + 1, + 2, + + }, + { "gets", + "?var?", + aio_cmd_gets, + 0, + 1, + + }, + { "puts", + "?-nonewline? str", + aio_cmd_puts, + 1, + 2, + + }, + { "isatty", + NULL, + aio_cmd_isatty, + 0, + 0, + + }, + { "flush", + NULL, + aio_cmd_flush, + 0, + 0, + + }, + { "eof", + NULL, + aio_cmd_eof, + 0, + 0, + + }, + { "close", + "?r(ead)|w(rite)?", + aio_cmd_close, + 0, + 1, + JIM_MODFLAG_FULLARGV, + + }, + { "seek", + "offset ?start|current|end", + aio_cmd_seek, + 1, + 2, + + }, + { "tell", + NULL, + aio_cmd_tell, + 0, + 0, + + }, + { "filename", + NULL, + aio_cmd_filename, + 0, + 0, + + }, +#ifdef O_NDELAY + { "ndelay", + "?0|1?", + aio_cmd_ndelay, + 0, + 1, + + }, +#endif +#ifdef HAVE_FSYNC + { "sync", + NULL, + aio_cmd_sync, + 0, + 0, + + }, +#endif + { "buffering", + "none|line|full", + aio_cmd_buffering, + 1, + 1, + + }, +#ifdef jim_ext_eventloop + { "readable", + "?readable-script?", + aio_cmd_readable, + 0, + 1, + + }, + { "writable", + "?writable-script?", + aio_cmd_writable, + 0, + 1, + + }, + { "onexception", + "?exception-script?", + aio_cmd_onexception, + 0, + 1, + + }, +#endif + { NULL } +}; + +static int JimAioSubCmdProc(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return Jim_CallSubCmd(interp, Jim_ParseSubCmd(interp, aio_command_table, argc, argv), argc, argv); +} + +static int JimAioOpenCommand(Jim_Interp *interp, int argc, + Jim_Obj *const *argv) +{ + const char *mode; + + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "filename ?mode?"); + return JIM_ERR; + } + + mode = (argc == 3) ? Jim_String(argv[2]) : "r"; + +#ifdef jim_ext_tclcompat + { + const char *filename = Jim_String(argv[1]); + + + if (*filename == '|') { + Jim_Obj *evalObj[3]; + + evalObj[0] = Jim_NewStringObj(interp, "::popen", -1); + evalObj[1] = Jim_NewStringObj(interp, filename + 1, -1); + evalObj[2] = Jim_NewStringObj(interp, mode, -1); + + return Jim_EvalObjVector(interp, 3, evalObj); + } + } +#endif + return JimMakeChannel(interp, NULL, -1, argv[1], "aio.handle%ld", 0, mode) ? JIM_OK : JIM_ERR; +} + + +static AioFile *JimMakeChannel(Jim_Interp *interp, FILE *fh, int fd, Jim_Obj *filename, + const char *hdlfmt, int family, const char *mode) +{ + AioFile *af; + char buf[AIO_CMD_LEN]; + int openFlags = 0; + + snprintf(buf, sizeof(buf), hdlfmt, Jim_GetId(interp)); + + if (fh) { + openFlags = AIO_KEEPOPEN; + } + + snprintf(buf, sizeof(buf), hdlfmt, Jim_GetId(interp)); + if (!filename) { + filename = Jim_NewStringObj(interp, buf, -1); + } + + Jim_IncrRefCount(filename); + + if (fh == NULL) { +#if !defined(JIM_ANSIC) + if (fd >= 0) { + fh = fdopen(fd, mode); + } + else +#endif + fh = fopen(Jim_String(filename), mode); + + if (fh == NULL) { + JimAioSetError(interp, filename); +#if !defined(JIM_ANSIC) + if (fd >= 0) { + close(fd); + } +#endif + Jim_DecrRefCount(interp, filename); + return NULL; + } + } + + + af = Jim_Alloc(sizeof(*af)); + memset(af, 0, sizeof(*af)); + af->fp = fh; + af->fd = fileno(fh); + af->filename = filename; +#ifdef FD_CLOEXEC + if ((openFlags & AIO_KEEPOPEN) == 0) { + (void)fcntl(af->fd, F_SETFD, FD_CLOEXEC); + } +#endif + af->openFlags = openFlags; + af->addr_family = family; + af->fops = &stdio_fops; + af->ssl = NULL; + + Jim_CreateCommand(interp, buf, JimAioSubCmdProc, af, JimAioDelProc); + + Jim_SetResult(interp, Jim_MakeGlobalNamespaceName(interp, Jim_NewStringObj(interp, buf, -1))); + + return af; +} + +#if defined(HAVE_PIPE) || (defined(HAVE_SOCKETPAIR) && defined(HAVE_SYS_UN_H)) +static int JimMakeChannelPair(Jim_Interp *interp, int p[2], Jim_Obj *filename, + const char *hdlfmt, int family, const char *mode[2]) +{ + if (JimMakeChannel(interp, NULL, p[0], filename, hdlfmt, family, mode[0])) { + Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0); + Jim_ListAppendElement(interp, objPtr, Jim_GetResult(interp)); + + if (JimMakeChannel(interp, NULL, p[1], filename, hdlfmt, family, mode[1])) { + Jim_ListAppendElement(interp, objPtr, Jim_GetResult(interp)); + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + } + + + close(p[0]); + close(p[1]); + JimAioSetError(interp, NULL); + return JIM_ERR; +} +#endif + + +int Jim_MakeTempFile(Jim_Interp *interp, const char *template) +{ +#ifdef HAVE_MKSTEMP + int fd; + mode_t mask; + Jim_Obj *filenameObj; + + if (template == NULL) { + const char *tmpdir = getenv("TMPDIR"); + if (tmpdir == NULL || *tmpdir == '\0' || access(tmpdir, W_OK) != 0) { + tmpdir = "/tmp/"; + } + filenameObj = Jim_NewStringObj(interp, tmpdir, -1); + if (tmpdir[0] && tmpdir[strlen(tmpdir) - 1] != '/') { + Jim_AppendString(interp, filenameObj, "/", 1); + } + Jim_AppendString(interp, filenameObj, "tcl.tmp.XXXXXX", -1); + } + else { + filenameObj = Jim_NewStringObj(interp, template, -1); + } + +#if defined(S_IRWXG) && defined(S_IRWXO) + mask = umask(S_IXUSR | S_IRWXG | S_IRWXO); +#else + + mask = umask(S_IXUSR); +#endif + + + fd = mkstemp(filenameObj->bytes); + umask(mask); + if (fd < 0) { + JimAioSetError(interp, filenameObj); + Jim_FreeNewObj(interp, filenameObj); + return -1; + } + + Jim_SetResult(interp, filenameObj); + return fd; +#else + Jim_SetResultString(interp, "platform has no tempfile support", -1); + return -1; +#endif +} + + +int Jim_aioInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "aio", "1.0", JIM_ERRMSG)) + return JIM_ERR; + +#if defined(JIM_SSL) + Jim_CreateCommand(interp, "load_ssl_certs", JimAioLoadSSLCertsCommand, NULL, NULL); +#endif + + Jim_CreateCommand(interp, "open", JimAioOpenCommand, NULL, NULL); +#ifndef JIM_ANSIC + Jim_CreateCommand(interp, "socket", JimAioSockCommand, NULL, NULL); +#endif + + + JimMakeChannel(interp, stdin, -1, NULL, "stdin", 0, "r"); + JimMakeChannel(interp, stdout, -1, NULL, "stdout", 0, "w"); + JimMakeChannel(interp, stderr, -1, NULL, "stderr", 0, "w"); + + return JIM_OK; +} + +#include +#include +#include + + +#ifdef HAVE_DIRENT_H +#include +#endif + +int Jim_ReaddirCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *dirPath; + DIR *dirPtr; + struct dirent *entryPtr; + int nocomplain = 0; + + if (argc == 3 && Jim_CompareStringImmediate(interp, argv[1], "-nocomplain")) { + nocomplain = 1; + } + if (argc != 2 && !nocomplain) { + Jim_WrongNumArgs(interp, 1, argv, "?-nocomplain? dirPath"); + return JIM_ERR; + } + + dirPath = Jim_String(argv[1 + nocomplain]); + + dirPtr = opendir(dirPath); + if (dirPtr == NULL) { + if (nocomplain) { + return JIM_OK; + } + Jim_SetResultString(interp, strerror(errno), -1); + return JIM_ERR; + } + else { + Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0); + + while ((entryPtr = readdir(dirPtr)) != NULL) { + if (entryPtr->d_name[0] == '.') { + if (entryPtr->d_name[1] == '\0') { + continue; + } + if ((entryPtr->d_name[1] == '.') && (entryPtr->d_name[2] == '\0')) + continue; + } + Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, entryPtr->d_name, -1)); + } + closedir(dirPtr); + + Jim_SetResult(interp, listObj); + + return JIM_OK; + } +} + +int Jim_readdirInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "readdir", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + Jim_CreateCommand(interp, "readdir", Jim_ReaddirCmd, NULL, NULL); + return JIM_OK; +} + +#include +#include + +#if defined(JIM_REGEXP) +#else + #include +#endif + +static void FreeRegexpInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + regfree(objPtr->internalRep.regexpValue.compre); + Jim_Free(objPtr->internalRep.regexpValue.compre); +} + +static const Jim_ObjType regexpObjType = { + "regexp", + FreeRegexpInternalRep, + NULL, + NULL, + JIM_TYPE_NONE +}; + +static regex_t *SetRegexpFromAny(Jim_Interp *interp, Jim_Obj *objPtr, unsigned flags) +{ + regex_t *compre; + const char *pattern; + int ret; + + + if (objPtr->typePtr == ®expObjType && + objPtr->internalRep.regexpValue.compre && objPtr->internalRep.regexpValue.flags == flags) { + + return objPtr->internalRep.regexpValue.compre; + } + + + + + pattern = Jim_String(objPtr); + compre = Jim_Alloc(sizeof(regex_t)); + + if ((ret = regcomp(compre, pattern, REG_EXTENDED | flags)) != 0) { + char buf[100]; + + regerror(ret, compre, buf, sizeof(buf)); + Jim_SetResultFormatted(interp, "couldn't compile regular expression pattern: %s", buf); + regfree(compre); + Jim_Free(compre); + return NULL; + } + + Jim_FreeIntRep(interp, objPtr); + + objPtr->typePtr = ®expObjType; + objPtr->internalRep.regexpValue.flags = flags; + objPtr->internalRep.regexpValue.compre = compre; + + return compre; +} + +int Jim_RegexpCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int opt_indices = 0; + int opt_all = 0; + int opt_inline = 0; + regex_t *regex; + int match, i, j; + int offset = 0; + regmatch_t *pmatch = NULL; + int source_len; + int result = JIM_OK; + const char *pattern; + const char *source_str; + int num_matches = 0; + int num_vars; + Jim_Obj *resultListObj = NULL; + int regcomp_flags = 0; + int eflags = 0; + int option; + enum { + OPT_INDICES, OPT_NOCASE, OPT_LINE, OPT_ALL, OPT_INLINE, OPT_START, OPT_END + }; + static const char * const options[] = { + "-indices", "-nocase", "-line", "-all", "-inline", "-start", "--", NULL + }; + + if (argc < 3) { + wrongNumArgs: + Jim_WrongNumArgs(interp, 1, argv, + "?-switch ...? exp string ?matchVar? ?subMatchVar ...?"); + return JIM_ERR; + } + + for (i = 1; i < argc; i++) { + const char *opt = Jim_String(argv[i]); + + if (*opt != '-') { + break; + } + if (Jim_GetEnum(interp, argv[i], options, &option, "switch", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { + return JIM_ERR; + } + if (option == OPT_END) { + i++; + break; + } + switch (option) { + case OPT_INDICES: + opt_indices = 1; + break; + + case OPT_NOCASE: + regcomp_flags |= REG_ICASE; + break; + + case OPT_LINE: + regcomp_flags |= REG_NEWLINE; + break; + + case OPT_ALL: + opt_all = 1; + break; + + case OPT_INLINE: + opt_inline = 1; + break; + + case OPT_START: + if (++i == argc) { + goto wrongNumArgs; + } + if (Jim_GetIndex(interp, argv[i], &offset) != JIM_OK) { + return JIM_ERR; + } + break; + } + } + if (argc - i < 2) { + goto wrongNumArgs; + } + + regex = SetRegexpFromAny(interp, argv[i], regcomp_flags); + if (!regex) { + return JIM_ERR; + } + + pattern = Jim_String(argv[i]); + source_str = Jim_GetString(argv[i + 1], &source_len); + + num_vars = argc - i - 2; + + if (opt_inline) { + if (num_vars) { + Jim_SetResultString(interp, "regexp match variables not allowed when using -inline", + -1); + result = JIM_ERR; + goto done; + } + num_vars = regex->re_nsub + 1; + } + + pmatch = Jim_Alloc((num_vars + 1) * sizeof(*pmatch)); + + if (offset) { + if (offset < 0) { + offset += source_len + 1; + } + if (offset > source_len) { + source_str += source_len; + } + else if (offset > 0) { + source_str += offset; + } + eflags |= REG_NOTBOL; + } + + if (opt_inline) { + resultListObj = Jim_NewListObj(interp, NULL, 0); + } + + next_match: + match = regexec(regex, source_str, num_vars + 1, pmatch, eflags); + if (match >= REG_BADPAT) { + char buf[100]; + + regerror(match, regex, buf, sizeof(buf)); + Jim_SetResultFormatted(interp, "error while matching pattern: %s", buf); + result = JIM_ERR; + goto done; + } + + if (match == REG_NOMATCH) { + goto done; + } + + num_matches++; + + if (opt_all && !opt_inline) { + + goto try_next_match; + } + + + j = 0; + for (i += 2; opt_inline ? j < num_vars : i < argc; i++, j++) { + Jim_Obj *resultObj; + + if (opt_indices) { + resultObj = Jim_NewListObj(interp, NULL, 0); + } + else { + resultObj = Jim_NewStringObj(interp, "", 0); + } + + if (pmatch[j].rm_so == -1) { + if (opt_indices) { + Jim_ListAppendElement(interp, resultObj, Jim_NewIntObj(interp, -1)); + Jim_ListAppendElement(interp, resultObj, Jim_NewIntObj(interp, -1)); + } + } + else { + int len = pmatch[j].rm_eo - pmatch[j].rm_so; + + if (opt_indices) { + Jim_ListAppendElement(interp, resultObj, Jim_NewIntObj(interp, + offset + pmatch[j].rm_so)); + Jim_ListAppendElement(interp, resultObj, Jim_NewIntObj(interp, + offset + pmatch[j].rm_so + len - 1)); + } + else { + Jim_AppendString(interp, resultObj, source_str + pmatch[j].rm_so, len); + } + } + + if (opt_inline) { + Jim_ListAppendElement(interp, resultListObj, resultObj); + } + else { + + result = Jim_SetVariable(interp, argv[i], resultObj); + + if (result != JIM_OK) { + Jim_FreeObj(interp, resultObj); + break; + } + } + } + + try_next_match: + if (opt_all && (pattern[0] != '^' || (regcomp_flags & REG_NEWLINE)) && *source_str) { + if (pmatch[0].rm_eo) { + offset += pmatch[0].rm_eo; + source_str += pmatch[0].rm_eo; + } + else { + source_str++; + offset++; + } + if (*source_str) { + eflags = REG_NOTBOL; + goto next_match; + } + } + + done: + if (result == JIM_OK) { + if (opt_inline) { + Jim_SetResult(interp, resultListObj); + } + else { + Jim_SetResultInt(interp, num_matches); + } + } + + Jim_Free(pmatch); + return result; +} + +#define MAX_SUB_MATCHES 50 + +int Jim_RegsubCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int regcomp_flags = 0; + int regexec_flags = 0; + int opt_all = 0; + int offset = 0; + regex_t *regex; + const char *p; + int result; + regmatch_t pmatch[MAX_SUB_MATCHES + 1]; + int num_matches = 0; + + int i, j, n; + Jim_Obj *varname; + Jim_Obj *resultObj; + const char *source_str; + int source_len; + const char *replace_str; + int replace_len; + const char *pattern; + int option; + enum { + OPT_NOCASE, OPT_LINE, OPT_ALL, OPT_START, OPT_END + }; + static const char * const options[] = { + "-nocase", "-line", "-all", "-start", "--", NULL + }; + + if (argc < 4) { + wrongNumArgs: + Jim_WrongNumArgs(interp, 1, argv, + "?-switch ...? exp string subSpec ?varName?"); + return JIM_ERR; + } + + for (i = 1; i < argc; i++) { + const char *opt = Jim_String(argv[i]); + + if (*opt != '-') { + break; + } + if (Jim_GetEnum(interp, argv[i], options, &option, "switch", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { + return JIM_ERR; + } + if (option == OPT_END) { + i++; + break; + } + switch (option) { + case OPT_NOCASE: + regcomp_flags |= REG_ICASE; + break; + + case OPT_LINE: + regcomp_flags |= REG_NEWLINE; + break; + + case OPT_ALL: + opt_all = 1; + break; + + case OPT_START: + if (++i == argc) { + goto wrongNumArgs; + } + if (Jim_GetIndex(interp, argv[i], &offset) != JIM_OK) { + return JIM_ERR; + } + break; + } + } + if (argc - i != 3 && argc - i != 4) { + goto wrongNumArgs; + } + + regex = SetRegexpFromAny(interp, argv[i], regcomp_flags); + if (!regex) { + return JIM_ERR; + } + pattern = Jim_String(argv[i]); + + source_str = Jim_GetString(argv[i + 1], &source_len); + replace_str = Jim_GetString(argv[i + 2], &replace_len); + varname = argv[i + 3]; + + + resultObj = Jim_NewStringObj(interp, "", 0); + + if (offset) { + if (offset < 0) { + offset += source_len + 1; + } + if (offset > source_len) { + offset = source_len; + } + else if (offset < 0) { + offset = 0; + } + } + + + Jim_AppendString(interp, resultObj, source_str, offset); + + + n = source_len - offset; + p = source_str + offset; + do { + int match = regexec(regex, p, MAX_SUB_MATCHES, pmatch, regexec_flags); + + if (match >= REG_BADPAT) { + char buf[100]; + + regerror(match, regex, buf, sizeof(buf)); + Jim_SetResultFormatted(interp, "error while matching pattern: %s", buf); + return JIM_ERR; + } + if (match == REG_NOMATCH) { + break; + } + + num_matches++; + + Jim_AppendString(interp, resultObj, p, pmatch[0].rm_so); + + + for (j = 0; j < replace_len; j++) { + int idx; + int c = replace_str[j]; + + if (c == '&') { + idx = 0; + } + else if (c == '\\' && j < replace_len) { + c = replace_str[++j]; + if ((c >= '0') && (c <= '9')) { + idx = c - '0'; + } + else if ((c == '\\') || (c == '&')) { + Jim_AppendString(interp, resultObj, replace_str + j, 1); + continue; + } + else { + Jim_AppendString(interp, resultObj, replace_str + j - 1, (j == replace_len) ? 1 : 2); + continue; + } + } + else { + Jim_AppendString(interp, resultObj, replace_str + j, 1); + continue; + } + if ((idx < MAX_SUB_MATCHES) && pmatch[idx].rm_so != -1 && pmatch[idx].rm_eo != -1) { + Jim_AppendString(interp, resultObj, p + pmatch[idx].rm_so, + pmatch[idx].rm_eo - pmatch[idx].rm_so); + } + } + + p += pmatch[0].rm_eo; + n -= pmatch[0].rm_eo; + + + if (!opt_all || n == 0) { + break; + } + + + if ((regcomp_flags & REG_NEWLINE) == 0 && pattern[0] == '^') { + break; + } + + + if (pattern[0] == '\0' && n) { + + Jim_AppendString(interp, resultObj, p, 1); + p++; + n--; + } + + regexec_flags |= REG_NOTBOL; + } while (n); + + Jim_AppendString(interp, resultObj, p, -1); + + + if (argc - i == 4) { + result = Jim_SetVariable(interp, varname, resultObj); + + if (result == JIM_OK) { + Jim_SetResultInt(interp, num_matches); + } + else { + Jim_FreeObj(interp, resultObj); + } + } + else { + Jim_SetResult(interp, resultObj); + result = JIM_OK; + } + + return result; +} + +int Jim_regexpInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "regexp", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + Jim_CreateCommand(interp, "regexp", Jim_RegexpCmd, NULL, NULL); + Jim_CreateCommand(interp, "regsub", Jim_RegsubCmd, NULL, NULL); + return JIM_OK; +} + +#include +#include +#include +#include +#include +#include + + +#ifdef HAVE_UTIMES +#include +#endif +#ifdef HAVE_UNISTD_H +#include +#elif defined(_MSC_VER) +#include +#define F_OK 0 +#define W_OK 2 +#define R_OK 4 +#define S_ISREG(m) (((m) & S_IFMT) == S_IFREG) +#define S_ISDIR(m) (((m) & S_IFMT) == S_IFDIR) +#endif + +# ifndef MAXPATHLEN +# define MAXPATHLEN JIM_PATH_LEN +# endif + +#if defined(__MINGW32__) || defined(_MSC_VER) +#define ISWINDOWS 1 +#else +#define ISWINDOWS 0 +#endif + + +static const char *JimGetFileType(int mode) +{ + if (S_ISREG(mode)) { + return "file"; + } + else if (S_ISDIR(mode)) { + return "directory"; + } +#ifdef S_ISCHR + else if (S_ISCHR(mode)) { + return "characterSpecial"; + } +#endif +#ifdef S_ISBLK + else if (S_ISBLK(mode)) { + return "blockSpecial"; + } +#endif +#ifdef S_ISFIFO + else if (S_ISFIFO(mode)) { + return "fifo"; + } +#endif +#ifdef S_ISLNK + else if (S_ISLNK(mode)) { + return "link"; + } +#endif +#ifdef S_ISSOCK + else if (S_ISSOCK(mode)) { + return "socket"; + } +#endif + return "unknown"; +} + +static void AppendStatElement(Jim_Interp *interp, Jim_Obj *listObj, const char *key, jim_wide value) +{ + Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, key, -1)); + Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, value)); +} + +static int StoreStatData(Jim_Interp *interp, Jim_Obj *varName, const struct stat *sb) +{ + + Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0); + + AppendStatElement(interp, listObj, "dev", sb->st_dev); + AppendStatElement(interp, listObj, "ino", sb->st_ino); + AppendStatElement(interp, listObj, "mode", sb->st_mode); + AppendStatElement(interp, listObj, "nlink", sb->st_nlink); + AppendStatElement(interp, listObj, "uid", sb->st_uid); + AppendStatElement(interp, listObj, "gid", sb->st_gid); + AppendStatElement(interp, listObj, "size", sb->st_size); + AppendStatElement(interp, listObj, "atime", sb->st_atime); + AppendStatElement(interp, listObj, "mtime", sb->st_mtime); + AppendStatElement(interp, listObj, "ctime", sb->st_ctime); + Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, "type", -1)); + Jim_ListAppendElement(interp, listObj, Jim_NewStringObj(interp, JimGetFileType((int)sb->st_mode), -1)); + + + if (varName) { + Jim_Obj *objPtr = Jim_GetVariable(interp, varName, JIM_NONE); + if (objPtr) { + if (Jim_DictSize(interp, objPtr) < 0) { + + Jim_SetResultFormatted(interp, "can't set \"%#s(dev)\": variable isn't array", varName); + Jim_FreeNewObj(interp, listObj); + return JIM_ERR; + } + + if (Jim_IsShared(objPtr)) + objPtr = Jim_DuplicateObj(interp, objPtr); + + + Jim_ListAppendList(interp, objPtr, listObj); + Jim_DictSize(interp, objPtr); + Jim_InvalidateStringRep(objPtr); + + Jim_FreeNewObj(interp, listObj); + listObj = objPtr; + } + Jim_SetVariable(interp, varName, listObj); + } + + + Jim_SetResult(interp, listObj); + + return JIM_OK; +} + +static int file_cmd_dirname(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *path = Jim_String(argv[0]); + const char *p = strrchr(path, '/'); + + if (!p && path[0] == '.' && path[1] == '.' && path[2] == '\0') { + Jim_SetResultString(interp, "..", -1); + } else if (!p) { + Jim_SetResultString(interp, ".", -1); + } + else if (p == path) { + Jim_SetResultString(interp, "/", -1); + } + else if (ISWINDOWS && p[-1] == ':') { + + Jim_SetResultString(interp, path, p - path + 1); + } + else { + Jim_SetResultString(interp, path, p - path); + } + return JIM_OK; +} + +static int file_cmd_rootname(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *path = Jim_String(argv[0]); + const char *lastSlash = strrchr(path, '/'); + const char *p = strrchr(path, '.'); + + if (p == NULL || (lastSlash != NULL && lastSlash > p)) { + Jim_SetResult(interp, argv[0]); + } + else { + Jim_SetResultString(interp, path, p - path); + } + return JIM_OK; +} + +static int file_cmd_extension(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *path = Jim_String(argv[0]); + const char *lastSlash = strrchr(path, '/'); + const char *p = strrchr(path, '.'); + + if (p == NULL || (lastSlash != NULL && lastSlash >= p)) { + p = ""; + } + Jim_SetResultString(interp, p, -1); + return JIM_OK; +} + +static int file_cmd_tail(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *path = Jim_String(argv[0]); + const char *lastSlash = strrchr(path, '/'); + + if (lastSlash) { + Jim_SetResultString(interp, lastSlash + 1, -1); + } + else { + Jim_SetResult(interp, argv[0]); + } + return JIM_OK; +} + +static int file_cmd_normalize(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ +#ifdef HAVE_REALPATH + const char *path = Jim_String(argv[0]); + char *newname = Jim_Alloc(MAXPATHLEN + 1); + + if (realpath(path, newname)) { + Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, newname, -1)); + return JIM_OK; + } + else { + Jim_Free(newname); + Jim_SetResultFormatted(interp, "can't normalize \"%#s\": %s", argv[0], strerror(errno)); + return JIM_ERR; + } +#else + Jim_SetResultString(interp, "Not implemented", -1); + return JIM_ERR; +#endif +} + +static int file_cmd_join(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + char *newname = Jim_Alloc(MAXPATHLEN + 1); + char *last = newname; + + *newname = 0; + + + for (i = 0; i < argc; i++) { + int len; + const char *part = Jim_GetString(argv[i], &len); + + if (*part == '/') { + + last = newname; + } + else if (ISWINDOWS && strchr(part, ':')) { + + last = newname; + } + else if (part[0] == '.') { + if (part[1] == '/') { + part += 2; + len -= 2; + } + else if (part[1] == 0 && last != newname) { + + continue; + } + } + + + if (last != newname && last[-1] != '/') { + *last++ = '/'; + } + + if (len) { + if (last + len - newname >= MAXPATHLEN) { + Jim_Free(newname); + Jim_SetResultString(interp, "Path too long", -1); + return JIM_ERR; + } + memcpy(last, part, len); + last += len; + } + + + if (last > newname + 1 && last[-1] == '/') { + + if (!ISWINDOWS || !(last > newname + 2 && last[-2] == ':')) { + *--last = 0; + } + } + } + + *last = 0; + + + + Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, newname, last - newname)); + + return JIM_OK; +} + +static int file_access(Jim_Interp *interp, Jim_Obj *filename, int mode) +{ + Jim_SetResultBool(interp, access(Jim_String(filename), mode) != -1); + + return JIM_OK; +} + +static int file_cmd_readable(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return file_access(interp, argv[0], R_OK); +} + +static int file_cmd_writable(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return file_access(interp, argv[0], W_OK); +} + +static int file_cmd_executable(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ +#ifdef X_OK + return file_access(interp, argv[0], X_OK); +#else + + Jim_SetResultBool(interp, 1); + return JIM_OK; +#endif +} + +static int file_cmd_exists(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return file_access(interp, argv[0], F_OK); +} + +static int file_cmd_delete(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int force = Jim_CompareStringImmediate(interp, argv[0], "-force"); + + if (force || Jim_CompareStringImmediate(interp, argv[0], "--")) { + argc++; + argv--; + } + + while (argc--) { + const char *path = Jim_String(argv[0]); + + if (unlink(path) == -1 && errno != ENOENT) { + if (rmdir(path) == -1) { + + if (!force || Jim_EvalPrefix(interp, "file delete force", 1, argv) != JIM_OK) { + Jim_SetResultFormatted(interp, "couldn't delete file \"%s\": %s", path, + strerror(errno)); + return JIM_ERR; + } + } + } + argv++; + } + return JIM_OK; +} + +#ifdef HAVE_MKDIR_ONE_ARG +#define MKDIR_DEFAULT(PATHNAME) mkdir(PATHNAME) +#else +#define MKDIR_DEFAULT(PATHNAME) mkdir(PATHNAME, 0755) +#endif + +static int mkdir_all(char *path) +{ + int ok = 1; + + + goto first; + + while (ok--) { + + { + char *slash = strrchr(path, '/'); + + if (slash && slash != path) { + *slash = 0; + if (mkdir_all(path) != 0) { + return -1; + } + *slash = '/'; + } + } + first: + if (MKDIR_DEFAULT(path) == 0) { + return 0; + } + if (errno == ENOENT) { + + continue; + } + + if (errno == EEXIST) { + struct stat sb; + + if (stat(path, &sb) == 0 && S_ISDIR(sb.st_mode)) { + return 0; + } + + errno = EEXIST; + } + + break; + } + return -1; +} + +static int file_cmd_mkdir(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + while (argc--) { + char *path = Jim_StrDup(Jim_String(argv[0])); + int rc = mkdir_all(path); + + Jim_Free(path); + if (rc != 0) { + Jim_SetResultFormatted(interp, "can't create directory \"%#s\": %s", argv[0], + strerror(errno)); + return JIM_ERR; + } + argv++; + } + return JIM_OK; +} + +static int file_cmd_tempfile(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int fd = Jim_MakeTempFile(interp, (argc >= 1) ? Jim_String(argv[0]) : NULL); + + if (fd < 0) { + return JIM_ERR; + } + close(fd); + + return JIM_OK; +} + +static int file_cmd_rename(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *source; + const char *dest; + int force = 0; + + if (argc == 3) { + if (!Jim_CompareStringImmediate(interp, argv[0], "-force")) { + return -1; + } + force++; + argv++; + argc--; + } + + source = Jim_String(argv[0]); + dest = Jim_String(argv[1]); + + if (!force && access(dest, F_OK) == 0) { + Jim_SetResultFormatted(interp, "error renaming \"%#s\" to \"%#s\": target exists", argv[0], + argv[1]); + return JIM_ERR; + } + + if (rename(source, dest) != 0) { + Jim_SetResultFormatted(interp, "error renaming \"%#s\" to \"%#s\": %s", argv[0], argv[1], + strerror(errno)); + return JIM_ERR; + } + + return JIM_OK; +} + +#if defined(HAVE_LINK) && defined(HAVE_SYMLINK) +static int file_cmd_link(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int ret; + const char *source; + const char *dest; + static const char * const options[] = { "-hard", "-symbolic", NULL }; + enum { OPT_HARD, OPT_SYMBOLIC, }; + int option = OPT_HARD; + + if (argc == 3) { + if (Jim_GetEnum(interp, argv[0], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + argv++; + argc--; + } + + dest = Jim_String(argv[0]); + source = Jim_String(argv[1]); + + if (option == OPT_HARD) { + ret = link(source, dest); + } + else { + ret = symlink(source, dest); + } + + if (ret != 0) { + Jim_SetResultFormatted(interp, "error linking \"%#s\" to \"%#s\": %s", argv[0], argv[1], + strerror(errno)); + return JIM_ERR; + } + + return JIM_OK; +} +#endif + +static int file_stat(Jim_Interp *interp, Jim_Obj *filename, struct stat *sb) +{ + const char *path = Jim_String(filename); + + if (stat(path, sb) == -1) { + Jim_SetResultFormatted(interp, "could not read \"%#s\": %s", filename, strerror(errno)); + return JIM_ERR; + } + return JIM_OK; +} + +#ifdef HAVE_LSTAT +static int file_lstat(Jim_Interp *interp, Jim_Obj *filename, struct stat *sb) +{ + const char *path = Jim_String(filename); + + if (lstat(path, sb) == -1) { + Jim_SetResultFormatted(interp, "could not read \"%#s\": %s", filename, strerror(errno)); + return JIM_ERR; + } + return JIM_OK; +} +#else +#define file_lstat file_stat +#endif + +static int file_cmd_atime(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + + if (file_stat(interp, argv[0], &sb) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResultInt(interp, sb.st_atime); + return JIM_OK; +} + +static int file_cmd_mtime(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + + if (argc == 2) { +#ifdef HAVE_UTIMES + jim_wide newtime; + struct timeval times[2]; + + if (Jim_GetWide(interp, argv[1], &newtime) != JIM_OK) { + return JIM_ERR; + } + + times[1].tv_sec = times[0].tv_sec = newtime; + times[1].tv_usec = times[0].tv_usec = 0; + + if (utimes(Jim_String(argv[0]), times) != 0) { + Jim_SetResultFormatted(interp, "can't set time on \"%#s\": %s", argv[0], strerror(errno)); + return JIM_ERR; + } +#else + Jim_SetResultString(interp, "Not implemented", -1); + return JIM_ERR; +#endif + } + if (file_stat(interp, argv[0], &sb) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResultInt(interp, sb.st_mtime); + return JIM_OK; +} + +static int file_cmd_copy(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return Jim_EvalPrefix(interp, "file copy", argc, argv); +} + +static int file_cmd_size(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + + if (file_stat(interp, argv[0], &sb) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResultInt(interp, sb.st_size); + return JIM_OK; +} + +static int file_cmd_isdirectory(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + int ret = 0; + + if (file_stat(interp, argv[0], &sb) == JIM_OK) { + ret = S_ISDIR(sb.st_mode); + } + Jim_SetResultInt(interp, ret); + return JIM_OK; +} + +static int file_cmd_isfile(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + int ret = 0; + + if (file_stat(interp, argv[0], &sb) == JIM_OK) { + ret = S_ISREG(sb.st_mode); + } + Jim_SetResultInt(interp, ret); + return JIM_OK; +} + +#ifdef HAVE_GETEUID +static int file_cmd_owned(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + int ret = 0; + + if (file_stat(interp, argv[0], &sb) == JIM_OK) { + ret = (geteuid() == sb.st_uid); + } + Jim_SetResultInt(interp, ret); + return JIM_OK; +} +#endif + +#if defined(HAVE_READLINK) +static int file_cmd_readlink(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *path = Jim_String(argv[0]); + char *linkValue = Jim_Alloc(MAXPATHLEN + 1); + + int linkLength = readlink(path, linkValue, MAXPATHLEN); + + if (linkLength == -1) { + Jim_Free(linkValue); + Jim_SetResultFormatted(interp, "couldn't readlink \"%#s\": %s", argv[0], strerror(errno)); + return JIM_ERR; + } + linkValue[linkLength] = 0; + Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, linkValue, linkLength)); + return JIM_OK; +} +#endif + +static int file_cmd_type(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + + if (file_lstat(interp, argv[0], &sb) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResultString(interp, JimGetFileType((int)sb.st_mode), -1); + return JIM_OK; +} + +#ifdef HAVE_LSTAT +static int file_cmd_lstat(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + + if (file_lstat(interp, argv[0], &sb) != JIM_OK) { + return JIM_ERR; + } + return StoreStatData(interp, argc == 2 ? argv[1] : NULL, &sb); +} +#else +#define file_cmd_lstat file_cmd_stat +#endif + +static int file_cmd_stat(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct stat sb; + + if (file_stat(interp, argv[0], &sb) != JIM_OK) { + return JIM_ERR; + } + return StoreStatData(interp, argc == 2 ? argv[1] : NULL, &sb); +} + +static const jim_subcmd_type file_command_table[] = { + { "atime", + "name", + file_cmd_atime, + 1, + 1, + + }, + { "mtime", + "name ?time?", + file_cmd_mtime, + 1, + 2, + + }, + { "copy", + "?-force? source dest", + file_cmd_copy, + 2, + 3, + + }, + { "dirname", + "name", + file_cmd_dirname, + 1, + 1, + + }, + { "rootname", + "name", + file_cmd_rootname, + 1, + 1, + + }, + { "extension", + "name", + file_cmd_extension, + 1, + 1, + + }, + { "tail", + "name", + file_cmd_tail, + 1, + 1, + + }, + { "normalize", + "name", + file_cmd_normalize, + 1, + 1, + + }, + { "join", + "name ?name ...?", + file_cmd_join, + 1, + -1, + + }, + { "readable", + "name", + file_cmd_readable, + 1, + 1, + + }, + { "writable", + "name", + file_cmd_writable, + 1, + 1, + + }, + { "executable", + "name", + file_cmd_executable, + 1, + 1, + + }, + { "exists", + "name", + file_cmd_exists, + 1, + 1, + + }, + { "delete", + "?-force|--? name ...", + file_cmd_delete, + 1, + -1, + + }, + { "mkdir", + "dir ...", + file_cmd_mkdir, + 1, + -1, + + }, + { "tempfile", + "?template?", + file_cmd_tempfile, + 0, + 1, + + }, + { "rename", + "?-force? source dest", + file_cmd_rename, + 2, + 3, + + }, +#if defined(HAVE_LINK) && defined(HAVE_SYMLINK) + { "link", + "?-symbolic|-hard? newname target", + file_cmd_link, + 2, + 3, + + }, +#endif +#if defined(HAVE_READLINK) + { "readlink", + "name", + file_cmd_readlink, + 1, + 1, + + }, +#endif + { "size", + "name", + file_cmd_size, + 1, + 1, + + }, + { "stat", + "name ?var?", + file_cmd_stat, + 1, + 2, + + }, + { "lstat", + "name ?var?", + file_cmd_lstat, + 1, + 2, + + }, + { "type", + "name", + file_cmd_type, + 1, + 1, + + }, +#ifdef HAVE_GETEUID + { "owned", + "name", + file_cmd_owned, + 1, + 1, + + }, +#endif + { "isdirectory", + "name", + file_cmd_isdirectory, + 1, + 1, + + }, + { "isfile", + "name", + file_cmd_isfile, + 1, + 1, + + }, + { + NULL + } +}; + +static int Jim_CdCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *path; + + if (argc != 2) { + Jim_WrongNumArgs(interp, 1, argv, "dirname"); + return JIM_ERR; + } + + path = Jim_String(argv[1]); + + if (chdir(path) != 0) { + Jim_SetResultFormatted(interp, "couldn't change working directory to \"%s\": %s", path, + strerror(errno)); + return JIM_ERR; + } + return JIM_OK; +} + +static int Jim_PwdCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + char *cwd = Jim_Alloc(MAXPATHLEN); + + if (getcwd(cwd, MAXPATHLEN) == NULL) { + Jim_SetResultString(interp, "Failed to get pwd", -1); + Jim_Free(cwd); + return JIM_ERR; + } + else if (ISWINDOWS) { + + char *p = cwd; + while ((p = strchr(p, '\\')) != NULL) { + *p++ = '/'; + } + } + + Jim_SetResultString(interp, cwd, -1); + + Jim_Free(cwd); + return JIM_OK; +} + +int Jim_fileInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "file", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + Jim_CreateCommand(interp, "file", Jim_SubCmdProc, (void *)file_command_table, NULL); + Jim_CreateCommand(interp, "pwd", Jim_PwdCmd, NULL, NULL); + Jim_CreateCommand(interp, "cd", Jim_CdCmd, NULL, NULL); + return JIM_OK; +} + +#include +#include + + +#if (!defined(HAVE_VFORK) || !defined(HAVE_WAITPID)) && !defined(__MINGW32__) +static int Jim_ExecCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *cmdlineObj = Jim_NewEmptyStringObj(interp); + int i, j; + int rc; + + + for (i = 1; i < argc; i++) { + int len; + const char *arg = Jim_GetString(argv[i], &len); + + if (i > 1) { + Jim_AppendString(interp, cmdlineObj, " ", 1); + } + if (strpbrk(arg, "\\\" ") == NULL) { + + Jim_AppendString(interp, cmdlineObj, arg, len); + continue; + } + + Jim_AppendString(interp, cmdlineObj, "\"", 1); + for (j = 0; j < len; j++) { + if (arg[j] == '\\' || arg[j] == '"') { + Jim_AppendString(interp, cmdlineObj, "\\", 1); + } + Jim_AppendString(interp, cmdlineObj, &arg[j], 1); + } + Jim_AppendString(interp, cmdlineObj, "\"", 1); + } + rc = system(Jim_String(cmdlineObj)); + + Jim_FreeNewObj(interp, cmdlineObj); + + if (rc) { + Jim_Obj *errorCode = Jim_NewListObj(interp, NULL, 0); + Jim_ListAppendElement(interp, errorCode, Jim_NewStringObj(interp, "CHILDSTATUS", -1)); + Jim_ListAppendElement(interp, errorCode, Jim_NewIntObj(interp, 0)); + Jim_ListAppendElement(interp, errorCode, Jim_NewIntObj(interp, rc)); + Jim_SetGlobalVariableStr(interp, "errorCode", errorCode); + return JIM_ERR; + } + + return JIM_OK; +} + +int Jim_execInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "exec", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + Jim_CreateCommand(interp, "exec", Jim_ExecCmd, NULL, NULL); + return JIM_OK; +} +#else + + +#include +#include + +#if defined(__MINGW32__) + + #ifndef STRICT + #define STRICT + #endif + #define WIN32_LEAN_AND_MEAN + #include + #include + + typedef HANDLE fdtype; + typedef HANDLE pidtype; + #define JIM_BAD_FD INVALID_HANDLE_VALUE + #define JIM_BAD_PID INVALID_HANDLE_VALUE + #define JimCloseFd CloseHandle + + #define WIFEXITED(STATUS) 1 + #define WEXITSTATUS(STATUS) (STATUS) + #define WIFSIGNALED(STATUS) 0 + #define WTERMSIG(STATUS) 0 + #define WNOHANG 1 + + static fdtype JimFileno(FILE *fh); + static pidtype JimWaitPid(pidtype pid, int *status, int nohang); + static fdtype JimDupFd(fdtype infd); + static fdtype JimOpenForRead(const char *filename); + static FILE *JimFdOpenForRead(fdtype fd); + static int JimPipe(fdtype pipefd[2]); + static pidtype JimStartWinProcess(Jim_Interp *interp, char **argv, char *env, + fdtype inputId, fdtype outputId, fdtype errorId); + static int JimErrno(void); +#else + #include + #include + #include + #include + + typedef int fdtype; + typedef int pidtype; + #define JimPipe pipe + #define JimErrno() errno + #define JIM_BAD_FD -1 + #define JIM_BAD_PID -1 + #define JimFileno fileno + #define JimReadFd read + #define JimCloseFd close + #define JimWaitPid waitpid + #define JimDupFd dup + #define JimFdOpenForRead(FD) fdopen((FD), "r") + #define JimOpenForRead(NAME) open((NAME), O_RDONLY, 0) + + #ifndef HAVE_EXECVPE + #define execvpe(ARG0, ARGV, ENV) execvp(ARG0, ARGV) + #endif +#endif + +static const char *JimStrError(void); +static char **JimSaveEnv(char **env); +static void JimRestoreEnv(char **env); +static int JimCreatePipeline(Jim_Interp *interp, int argc, Jim_Obj *const *argv, + pidtype **pidArrayPtr, fdtype *inPipePtr, fdtype *outPipePtr, fdtype *errFilePtr); +static void JimDetachPids(Jim_Interp *interp, int numPids, const pidtype *pidPtr); +static int JimCleanupChildren(Jim_Interp *interp, int numPids, pidtype *pidPtr, Jim_Obj *errStrObj); +static fdtype JimCreateTemp(Jim_Interp *interp, const char *contents, int len); +static fdtype JimOpenForWrite(const char *filename, int append); +static int JimRewindFd(fdtype fd); + +static void Jim_SetResultErrno(Jim_Interp *interp, const char *msg) +{ + Jim_SetResultFormatted(interp, "%s: %s", msg, JimStrError()); +} + +static const char *JimStrError(void) +{ + return strerror(JimErrno()); +} + +static void Jim_RemoveTrailingNewline(Jim_Obj *objPtr) +{ + int len; + const char *s = Jim_GetString(objPtr, &len); + + if (len > 0 && s[len - 1] == '\n') { + objPtr->length--; + objPtr->bytes[objPtr->length] = '\0'; + } +} + +static int JimAppendStreamToString(Jim_Interp *interp, fdtype fd, Jim_Obj *strObj) +{ + char buf[256]; + FILE *fh = JimFdOpenForRead(fd); + int ret = 0; + + if (fh == NULL) { + return -1; + } + + while (1) { + int retval = fread(buf, 1, sizeof(buf), fh); + if (retval > 0) { + ret = 1; + Jim_AppendString(interp, strObj, buf, retval); + } + if (retval != sizeof(buf)) { + break; + } + } + fclose(fh); + return ret; +} + +static char **JimBuildEnv(Jim_Interp *interp) +{ + int i; + int size; + int num; + int n; + char **envptr; + char *envdata; + + Jim_Obj *objPtr = Jim_GetGlobalVariableStr(interp, "env", JIM_NONE); + + if (!objPtr) { + return Jim_GetEnviron(); + } + + + + num = Jim_ListLength(interp, objPtr); + if (num % 2) { + + num--; + } + size = Jim_Length(objPtr) + 2; + + envptr = Jim_Alloc(sizeof(*envptr) * (num / 2 + 1) + size); + envdata = (char *)&envptr[num / 2 + 1]; + + n = 0; + for (i = 0; i < num; i += 2) { + const char *s1, *s2; + Jim_Obj *elemObj; + + Jim_ListIndex(interp, objPtr, i, &elemObj, JIM_NONE); + s1 = Jim_String(elemObj); + Jim_ListIndex(interp, objPtr, i + 1, &elemObj, JIM_NONE); + s2 = Jim_String(elemObj); + + envptr[n] = envdata; + envdata += sprintf(envdata, "%s=%s", s1, s2); + envdata++; + n++; + } + envptr[n] = NULL; + *envdata = 0; + + return envptr; +} + +static void JimFreeEnv(char **env, char **original_environ) +{ + if (env != original_environ) { + Jim_Free(env); + } +} + +#ifndef jim_ext_signal + +const char *Jim_SignalId(int sig) +{ + static char buf[10]; + snprintf(buf, sizeof(buf), "%d", sig); + return buf; +} + +const char *Jim_SignalName(int sig) +{ + return Jim_SignalId(sig); +} +#endif + +static int JimCheckWaitStatus(Jim_Interp *interp, pidtype pid, int waitStatus, Jim_Obj *errStrObj) +{ + Jim_Obj *errorCode; + + if (WIFEXITED(waitStatus) && WEXITSTATUS(waitStatus) == 0) { + return JIM_OK; + } + errorCode = Jim_NewListObj(interp, NULL, 0); + + if (WIFEXITED(waitStatus)) { + Jim_ListAppendElement(interp, errorCode, Jim_NewStringObj(interp, "CHILDSTATUS", -1)); + Jim_ListAppendElement(interp, errorCode, Jim_NewIntObj(interp, (long)pid)); + Jim_ListAppendElement(interp, errorCode, Jim_NewIntObj(interp, WEXITSTATUS(waitStatus))); + } + else { + const char *type; + const char *action; + + if (WIFSIGNALED(waitStatus)) { + type = "CHILDKILLED"; + action = "killed"; + } + else { + type = "CHILDSUSP"; + action = "suspended"; + } + + Jim_ListAppendElement(interp, errorCode, Jim_NewStringObj(interp, type, -1)); + + if (errStrObj) { + Jim_AppendStrings(interp, errStrObj, "child ", action, " by signal ", Jim_SignalId(WTERMSIG(waitStatus)), "\n", NULL); + } + + Jim_ListAppendElement(interp, errorCode, Jim_NewIntObj(interp, (long)pid)); + Jim_ListAppendElement(interp, errorCode, Jim_NewStringObj(interp, Jim_SignalId(WTERMSIG(waitStatus)), -1)); + Jim_ListAppendElement(interp, errorCode, Jim_NewStringObj(interp, Jim_SignalName(WTERMSIG(waitStatus)), -1)); + } + Jim_SetGlobalVariableStr(interp, "errorCode", errorCode); + + return JIM_ERR; +} + + +struct WaitInfo +{ + pidtype pid; + int status; + int flags; +}; + +struct WaitInfoTable { + struct WaitInfo *info; + int size; + int used; +}; + + +#define WI_DETACHED 2 + +#define WAIT_TABLE_GROW_BY 4 + +static void JimFreeWaitInfoTable(struct Jim_Interp *interp, void *privData) +{ + struct WaitInfoTable *table = privData; + + Jim_Free(table->info); + Jim_Free(table); +} + +static struct WaitInfoTable *JimAllocWaitInfoTable(void) +{ + struct WaitInfoTable *table = Jim_Alloc(sizeof(*table)); + table->info = NULL; + table->size = table->used = 0; + + return table; +} + +static int Jim_ExecCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + fdtype outputId; + fdtype errorId; + pidtype *pidPtr; + int numPids, result; + int child_siginfo = 1; + Jim_Obj *childErrObj; + Jim_Obj *errStrObj; + + if (argc > 1 && Jim_CompareStringImmediate(interp, argv[argc - 1], "&")) { + Jim_Obj *listObj; + int i; + + argc--; + numPids = JimCreatePipeline(interp, argc - 1, argv + 1, &pidPtr, NULL, NULL, NULL); + if (numPids < 0) { + return JIM_ERR; + } + + listObj = Jim_NewListObj(interp, NULL, 0); + for (i = 0; i < numPids; i++) { + Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, (long)pidPtr[i])); + } + Jim_SetResult(interp, listObj); + JimDetachPids(interp, numPids, pidPtr); + Jim_Free(pidPtr); + return JIM_OK; + } + + numPids = + JimCreatePipeline(interp, argc - 1, argv + 1, &pidPtr, NULL, &outputId, &errorId); + + if (numPids < 0) { + return JIM_ERR; + } + + result = JIM_OK; + + errStrObj = Jim_NewStringObj(interp, "", 0); + + + if (outputId != JIM_BAD_FD) { + if (JimAppendStreamToString(interp, outputId, errStrObj) < 0) { + result = JIM_ERR; + Jim_SetResultErrno(interp, "error reading from output pipe"); + } + } + + + childErrObj = Jim_NewStringObj(interp, "", 0); + Jim_IncrRefCount(childErrObj); + + if (JimCleanupChildren(interp, numPids, pidPtr, childErrObj) != JIM_OK) { + result = JIM_ERR; + } + + if (errorId != JIM_BAD_FD) { + int ret; + JimRewindFd(errorId); + ret = JimAppendStreamToString(interp, errorId, errStrObj); + if (ret < 0) { + Jim_SetResultErrno(interp, "error reading from error pipe"); + result = JIM_ERR; + } + else if (ret > 0) { + + child_siginfo = 0; + } + } + + if (child_siginfo) { + + Jim_AppendObj(interp, errStrObj, childErrObj); + } + Jim_DecrRefCount(interp, childErrObj); + + + Jim_RemoveTrailingNewline(errStrObj); + + + Jim_SetResult(interp, errStrObj); + + return result; +} + +static void JimReapDetachedPids(struct WaitInfoTable *table) +{ + struct WaitInfo *waitPtr; + int count; + int dest; + + if (!table) { + return; + } + + waitPtr = table->info; + dest = 0; + for (count = table->used; count > 0; waitPtr++, count--) { + if (waitPtr->flags & WI_DETACHED) { + int status; + pidtype pid = JimWaitPid(waitPtr->pid, &status, WNOHANG); + if (pid == waitPtr->pid) { + + table->used--; + continue; + } + } + if (waitPtr != &table->info[dest]) { + table->info[dest] = *waitPtr; + } + dest++; + } +} + +static pidtype JimWaitForProcess(struct WaitInfoTable *table, pidtype pid, int *statusPtr) +{ + int i; + + + for (i = 0; i < table->used; i++) { + if (pid == table->info[i].pid) { + + JimWaitPid(pid, statusPtr, 0); + + + if (i != table->used - 1) { + table->info[i] = table->info[table->used - 1]; + } + table->used--; + return pid; + } + } + + + return JIM_BAD_PID; +} + +static void JimDetachPids(Jim_Interp *interp, int numPids, const pidtype *pidPtr) +{ + int j; + struct WaitInfoTable *table = Jim_CmdPrivData(interp); + + for (j = 0; j < numPids; j++) { + + int i; + for (i = 0; i < table->used; i++) { + if (pidPtr[j] == table->info[i].pid) { + table->info[i].flags |= WI_DETACHED; + break; + } + } + } +} + +static FILE *JimGetAioFilehandle(Jim_Interp *interp, const char *name) +{ + FILE *fh; + Jim_Obj *fhObj; + + fhObj = Jim_NewStringObj(interp, name, -1); + Jim_IncrRefCount(fhObj); + fh = Jim_AioFilehandle(interp, fhObj); + Jim_DecrRefCount(interp, fhObj); + + return fh; +} + +static int +JimCreatePipeline(Jim_Interp *interp, int argc, Jim_Obj *const *argv, pidtype **pidArrayPtr, + fdtype *inPipePtr, fdtype *outPipePtr, fdtype *errFilePtr) +{ + pidtype *pidPtr = NULL; /* Points to malloc-ed array holding all + * the pids of child processes. */ + int numPids = 0; /* Actual number of processes that exist + * at *pidPtr right now. */ + int cmdCount; /* Count of number of distinct commands + * found in argc/argv. */ + const char *input = NULL; /* Describes input for pipeline, depending + * on "inputFile". NULL means take input + * from stdin/pipe. */ + int input_len = 0; + +#define FILE_NAME 0 +#define FILE_APPEND 1 +#define FILE_HANDLE 2 +#define FILE_TEXT 3 + + int inputFile = FILE_NAME; /* 1 means input is name of input file. + * 2 means input is filehandle name. + * 0 means input holds actual + * text to be input to command. */ + + int outputFile = FILE_NAME; /* 0 means output is the name of output file. + * 1 means output is the name of output file, and append. + * 2 means output is filehandle name. + * All this is ignored if output is NULL + */ + int errorFile = FILE_NAME; /* 0 means error is the name of error file. + * 1 means error is the name of error file, and append. + * 2 means error is filehandle name. + * All this is ignored if error is NULL + */ + const char *output = NULL; /* Holds name of output file to pipe to, + * or NULL if output goes to stdout/pipe. */ + const char *error = NULL; /* Holds name of stderr file to pipe to, + * or NULL if stderr goes to stderr/pipe. */ + fdtype inputId = JIM_BAD_FD; + fdtype outputId = JIM_BAD_FD; + fdtype errorId = JIM_BAD_FD; + fdtype lastOutputId = JIM_BAD_FD; + fdtype pipeIds[2]; + int firstArg, lastArg; /* Indexes of first and last arguments in + * current command. */ + int lastBar; + int i; + pidtype pid; + char **save_environ; + struct WaitInfoTable *table = Jim_CmdPrivData(interp); + + + char **arg_array = Jim_Alloc(sizeof(*arg_array) * (argc + 1)); + int arg_count = 0; + + JimReapDetachedPids(table); + + if (inPipePtr != NULL) { + *inPipePtr = JIM_BAD_FD; + } + if (outPipePtr != NULL) { + *outPipePtr = JIM_BAD_FD; + } + if (errFilePtr != NULL) { + *errFilePtr = JIM_BAD_FD; + } + pipeIds[0] = pipeIds[1] = JIM_BAD_FD; + + cmdCount = 1; + lastBar = -1; + for (i = 0; i < argc; i++) { + const char *arg = Jim_String(argv[i]); + + if (arg[0] == '<') { + inputFile = FILE_NAME; + input = arg + 1; + if (*input == '<') { + inputFile = FILE_TEXT; + input_len = Jim_Length(argv[i]) - 2; + input++; + } + else if (*input == '@') { + inputFile = FILE_HANDLE; + input++; + } + + if (!*input && ++i < argc) { + input = Jim_GetString(argv[i], &input_len); + } + } + else if (arg[0] == '>') { + int dup_error = 0; + + outputFile = FILE_NAME; + + output = arg + 1; + if (*output == '>') { + outputFile = FILE_APPEND; + output++; + } + if (*output == '&') { + + output++; + dup_error = 1; + } + if (*output == '@') { + outputFile = FILE_HANDLE; + output++; + } + if (!*output && ++i < argc) { + output = Jim_String(argv[i]); + } + if (dup_error) { + errorFile = outputFile; + error = output; + } + } + else if (arg[0] == '2' && arg[1] == '>') { + error = arg + 2; + errorFile = FILE_NAME; + + if (*error == '@') { + errorFile = FILE_HANDLE; + error++; + } + else if (*error == '>') { + errorFile = FILE_APPEND; + error++; + } + if (!*error && ++i < argc) { + error = Jim_String(argv[i]); + } + } + else { + if (strcmp(arg, "|") == 0 || strcmp(arg, "|&") == 0) { + if (i == lastBar + 1 || i == argc - 1) { + Jim_SetResultString(interp, "illegal use of | or |& in command", -1); + goto badargs; + } + lastBar = i; + cmdCount++; + } + + arg_array[arg_count++] = (char *)arg; + continue; + } + + if (i >= argc) { + Jim_SetResultFormatted(interp, "can't specify \"%s\" as last word in command", arg); + goto badargs; + } + } + + if (arg_count == 0) { + Jim_SetResultString(interp, "didn't specify command to execute", -1); +badargs: + Jim_Free(arg_array); + return -1; + } + + + save_environ = JimSaveEnv(JimBuildEnv(interp)); + + if (input != NULL) { + if (inputFile == FILE_TEXT) { + inputId = JimCreateTemp(interp, input, input_len); + if (inputId == JIM_BAD_FD) { + goto error; + } + } + else if (inputFile == FILE_HANDLE) { + + FILE *fh = JimGetAioFilehandle(interp, input); + + if (fh == NULL) { + goto error; + } + inputId = JimDupFd(JimFileno(fh)); + } + else { + inputId = JimOpenForRead(input); + if (inputId == JIM_BAD_FD) { + Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", input, JimStrError()); + goto error; + } + } + } + else if (inPipePtr != NULL) { + if (JimPipe(pipeIds) != 0) { + Jim_SetResultErrno(interp, "couldn't create input pipe for command"); + goto error; + } + inputId = pipeIds[0]; + *inPipePtr = pipeIds[1]; + pipeIds[0] = pipeIds[1] = JIM_BAD_FD; + } + + if (output != NULL) { + if (outputFile == FILE_HANDLE) { + FILE *fh = JimGetAioFilehandle(interp, output); + if (fh == NULL) { + goto error; + } + fflush(fh); + lastOutputId = JimDupFd(JimFileno(fh)); + } + else { + lastOutputId = JimOpenForWrite(output, outputFile == FILE_APPEND); + if (lastOutputId == JIM_BAD_FD) { + Jim_SetResultFormatted(interp, "couldn't write file \"%s\": %s", output, JimStrError()); + goto error; + } + } + } + else if (outPipePtr != NULL) { + if (JimPipe(pipeIds) != 0) { + Jim_SetResultErrno(interp, "couldn't create output pipe"); + goto error; + } + lastOutputId = pipeIds[1]; + *outPipePtr = pipeIds[0]; + pipeIds[0] = pipeIds[1] = JIM_BAD_FD; + } + + if (error != NULL) { + if (errorFile == FILE_HANDLE) { + if (strcmp(error, "1") == 0) { + + if (lastOutputId != JIM_BAD_FD) { + errorId = JimDupFd(lastOutputId); + } + else { + + error = "stdout"; + } + } + if (errorId == JIM_BAD_FD) { + FILE *fh = JimGetAioFilehandle(interp, error); + if (fh == NULL) { + goto error; + } + fflush(fh); + errorId = JimDupFd(JimFileno(fh)); + } + } + else { + errorId = JimOpenForWrite(error, errorFile == FILE_APPEND); + if (errorId == JIM_BAD_FD) { + Jim_SetResultFormatted(interp, "couldn't write file \"%s\": %s", error, JimStrError()); + goto error; + } + } + } + else if (errFilePtr != NULL) { + errorId = JimCreateTemp(interp, NULL, 0); + if (errorId == JIM_BAD_FD) { + goto error; + } + *errFilePtr = JimDupFd(errorId); + } + + + pidPtr = Jim_Alloc(cmdCount * sizeof(*pidPtr)); + for (i = 0; i < numPids; i++) { + pidPtr[i] = JIM_BAD_PID; + } + for (firstArg = 0; firstArg < arg_count; numPids++, firstArg = lastArg + 1) { + int pipe_dup_err = 0; + fdtype origErrorId = errorId; + + for (lastArg = firstArg; lastArg < arg_count; lastArg++) { + if (arg_array[lastArg][0] == '|') { + if (arg_array[lastArg][1] == '&') { + pipe_dup_err = 1; + } + break; + } + } + + arg_array[lastArg] = NULL; + if (lastArg == arg_count) { + outputId = lastOutputId; + } + else { + if (JimPipe(pipeIds) != 0) { + Jim_SetResultErrno(interp, "couldn't create pipe"); + goto error; + } + outputId = pipeIds[1]; + } + + + if (pipe_dup_err) { + errorId = outputId; + } + + + +#ifdef __MINGW32__ + pid = JimStartWinProcess(interp, &arg_array[firstArg], save_environ ? save_environ[0] : NULL, inputId, outputId, errorId); + if (pid == JIM_BAD_PID) { + Jim_SetResultFormatted(interp, "couldn't exec \"%s\"", arg_array[firstArg]); + goto error; + } +#else + pid = vfork(); + if (pid < 0) { + Jim_SetResultErrno(interp, "couldn't fork child process"); + goto error; + } + if (pid == 0) { + + + if (inputId != -1) dup2(inputId, 0); + if (outputId != -1) dup2(outputId, 1); + if (errorId != -1) dup2(errorId, 2); + + for (i = 3; (i <= outputId) || (i <= inputId) || (i <= errorId); i++) { + close(i); + } + + + (void)signal(SIGPIPE, SIG_DFL); + + execvpe(arg_array[firstArg], &arg_array[firstArg], Jim_GetEnviron()); + + + fprintf(stderr, "couldn't exec \"%s\"\n", arg_array[firstArg]); + _exit(127); + } +#endif + + + + if (table->used == table->size) { + table->size += WAIT_TABLE_GROW_BY; + table->info = Jim_Realloc(table->info, table->size * sizeof(*table->info)); + } + + table->info[table->used].pid = pid; + table->info[table->used].flags = 0; + table->used++; + + pidPtr[numPids] = pid; + + + errorId = origErrorId; + + + if (inputId != JIM_BAD_FD) { + JimCloseFd(inputId); + } + if (outputId != JIM_BAD_FD) { + JimCloseFd(outputId); + } + inputId = pipeIds[0]; + pipeIds[0] = pipeIds[1] = JIM_BAD_FD; + } + *pidArrayPtr = pidPtr; + + + cleanup: + if (inputId != JIM_BAD_FD) { + JimCloseFd(inputId); + } + if (lastOutputId != JIM_BAD_FD) { + JimCloseFd(lastOutputId); + } + if (errorId != JIM_BAD_FD) { + JimCloseFd(errorId); + } + Jim_Free(arg_array); + + JimRestoreEnv(save_environ); + + return numPids; + + + error: + if ((inPipePtr != NULL) && (*inPipePtr != JIM_BAD_FD)) { + JimCloseFd(*inPipePtr); + *inPipePtr = JIM_BAD_FD; + } + if ((outPipePtr != NULL) && (*outPipePtr != JIM_BAD_FD)) { + JimCloseFd(*outPipePtr); + *outPipePtr = JIM_BAD_FD; + } + if ((errFilePtr != NULL) && (*errFilePtr != JIM_BAD_FD)) { + JimCloseFd(*errFilePtr); + *errFilePtr = JIM_BAD_FD; + } + if (pipeIds[0] != JIM_BAD_FD) { + JimCloseFd(pipeIds[0]); + } + if (pipeIds[1] != JIM_BAD_FD) { + JimCloseFd(pipeIds[1]); + } + if (pidPtr != NULL) { + for (i = 0; i < numPids; i++) { + if (pidPtr[i] != JIM_BAD_PID) { + JimDetachPids(interp, 1, &pidPtr[i]); + } + } + Jim_Free(pidPtr); + } + numPids = -1; + goto cleanup; +} + + +static int JimCleanupChildren(Jim_Interp *interp, int numPids, pidtype *pidPtr, Jim_Obj *errStrObj) +{ + struct WaitInfoTable *table = Jim_CmdPrivData(interp); + int result = JIM_OK; + int i; + + + for (i = 0; i < numPids; i++) { + int waitStatus = 0; + if (JimWaitForProcess(table, pidPtr[i], &waitStatus) != JIM_BAD_PID) { + if (JimCheckWaitStatus(interp, pidPtr[i], waitStatus, errStrObj) != JIM_OK) { + result = JIM_ERR; + } + } + } + Jim_Free(pidPtr); + + return result; +} + +int Jim_execInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "exec", "1.0", JIM_ERRMSG)) + return JIM_ERR; + +#ifdef SIGPIPE + (void)signal(SIGPIPE, SIG_IGN); +#endif + + Jim_CreateCommand(interp, "exec", Jim_ExecCmd, JimAllocWaitInfoTable(), JimFreeWaitInfoTable); + return JIM_OK; +} + +#if defined(__MINGW32__) + + +static SECURITY_ATTRIBUTES *JimStdSecAttrs(void) +{ + static SECURITY_ATTRIBUTES secAtts; + + secAtts.nLength = sizeof(SECURITY_ATTRIBUTES); + secAtts.lpSecurityDescriptor = NULL; + secAtts.bInheritHandle = TRUE; + return &secAtts; +} + +static int JimErrno(void) +{ + switch (GetLastError()) { + case ERROR_FILE_NOT_FOUND: return ENOENT; + case ERROR_PATH_NOT_FOUND: return ENOENT; + case ERROR_TOO_MANY_OPEN_FILES: return EMFILE; + case ERROR_ACCESS_DENIED: return EACCES; + case ERROR_INVALID_HANDLE: return EBADF; + case ERROR_BAD_ENVIRONMENT: return E2BIG; + case ERROR_BAD_FORMAT: return ENOEXEC; + case ERROR_INVALID_ACCESS: return EACCES; + case ERROR_INVALID_DRIVE: return ENOENT; + case ERROR_CURRENT_DIRECTORY: return EACCES; + case ERROR_NOT_SAME_DEVICE: return EXDEV; + case ERROR_NO_MORE_FILES: return ENOENT; + case ERROR_WRITE_PROTECT: return EROFS; + case ERROR_BAD_UNIT: return ENXIO; + case ERROR_NOT_READY: return EBUSY; + case ERROR_BAD_COMMAND: return EIO; + case ERROR_CRC: return EIO; + case ERROR_BAD_LENGTH: return EIO; + case ERROR_SEEK: return EIO; + case ERROR_WRITE_FAULT: return EIO; + case ERROR_READ_FAULT: return EIO; + case ERROR_GEN_FAILURE: return EIO; + case ERROR_SHARING_VIOLATION: return EACCES; + case ERROR_LOCK_VIOLATION: return EACCES; + case ERROR_SHARING_BUFFER_EXCEEDED: return ENFILE; + case ERROR_HANDLE_DISK_FULL: return ENOSPC; + case ERROR_NOT_SUPPORTED: return ENODEV; + case ERROR_REM_NOT_LIST: return EBUSY; + case ERROR_DUP_NAME: return EEXIST; + case ERROR_BAD_NETPATH: return ENOENT; + case ERROR_NETWORK_BUSY: return EBUSY; + case ERROR_DEV_NOT_EXIST: return ENODEV; + case ERROR_TOO_MANY_CMDS: return EAGAIN; + case ERROR_ADAP_HDW_ERR: return EIO; + case ERROR_BAD_NET_RESP: return EIO; + case ERROR_UNEXP_NET_ERR: return EIO; + case ERROR_NETNAME_DELETED: return ENOENT; + case ERROR_NETWORK_ACCESS_DENIED: return EACCES; + case ERROR_BAD_DEV_TYPE: return ENODEV; + case ERROR_BAD_NET_NAME: return ENOENT; + case ERROR_TOO_MANY_NAMES: return ENFILE; + case ERROR_TOO_MANY_SESS: return EIO; + case ERROR_SHARING_PAUSED: return EAGAIN; + case ERROR_REDIR_PAUSED: return EAGAIN; + case ERROR_FILE_EXISTS: return EEXIST; + case ERROR_CANNOT_MAKE: return ENOSPC; + case ERROR_OUT_OF_STRUCTURES: return ENFILE; + case ERROR_ALREADY_ASSIGNED: return EEXIST; + case ERROR_INVALID_PASSWORD: return EPERM; + case ERROR_NET_WRITE_FAULT: return EIO; + case ERROR_NO_PROC_SLOTS: return EAGAIN; + case ERROR_DISK_CHANGE: return EXDEV; + case ERROR_BROKEN_PIPE: return EPIPE; + case ERROR_OPEN_FAILED: return ENOENT; + case ERROR_DISK_FULL: return ENOSPC; + case ERROR_NO_MORE_SEARCH_HANDLES: return EMFILE; + case ERROR_INVALID_TARGET_HANDLE: return EBADF; + case ERROR_INVALID_NAME: return ENOENT; + case ERROR_PROC_NOT_FOUND: return ESRCH; + case ERROR_WAIT_NO_CHILDREN: return ECHILD; + case ERROR_CHILD_NOT_COMPLETE: return ECHILD; + case ERROR_DIRECT_ACCESS_HANDLE: return EBADF; + case ERROR_SEEK_ON_DEVICE: return ESPIPE; + case ERROR_BUSY_DRIVE: return EAGAIN; + case ERROR_DIR_NOT_EMPTY: return EEXIST; + case ERROR_NOT_LOCKED: return EACCES; + case ERROR_BAD_PATHNAME: return ENOENT; + case ERROR_LOCK_FAILED: return EACCES; + case ERROR_ALREADY_EXISTS: return EEXIST; + case ERROR_FILENAME_EXCED_RANGE: return ENAMETOOLONG; + case ERROR_BAD_PIPE: return EPIPE; + case ERROR_PIPE_BUSY: return EAGAIN; + case ERROR_PIPE_NOT_CONNECTED: return EPIPE; + case ERROR_DIRECTORY: return ENOTDIR; + } + return EINVAL; +} + +static int JimPipe(fdtype pipefd[2]) +{ + if (CreatePipe(&pipefd[0], &pipefd[1], NULL, 0)) { + return 0; + } + return -1; +} + +static fdtype JimDupFd(fdtype infd) +{ + fdtype dupfd; + pidtype pid = GetCurrentProcess(); + + if (DuplicateHandle(pid, infd, pid, &dupfd, 0, TRUE, DUPLICATE_SAME_ACCESS)) { + return dupfd; + } + return JIM_BAD_FD; +} + +static int JimRewindFd(fdtype fd) +{ + return SetFilePointer(fd, 0, NULL, FILE_BEGIN) == INVALID_SET_FILE_POINTER ? -1 : 0; +} + +#if 0 +static int JimReadFd(fdtype fd, char *buffer, size_t len) +{ + DWORD num; + + if (ReadFile(fd, buffer, len, &num, NULL)) { + return num; + } + if (GetLastError() == ERROR_HANDLE_EOF || GetLastError() == ERROR_BROKEN_PIPE) { + return 0; + } + return -1; +} +#endif + +static FILE *JimFdOpenForRead(fdtype fd) +{ + return _fdopen(_open_osfhandle((int)fd, _O_RDONLY | _O_TEXT), "r"); +} + +static fdtype JimFileno(FILE *fh) +{ + return (fdtype)_get_osfhandle(_fileno(fh)); +} + +static fdtype JimOpenForRead(const char *filename) +{ + return CreateFile(filename, GENERIC_READ, FILE_SHARE_READ | FILE_SHARE_WRITE, + JimStdSecAttrs(), OPEN_EXISTING, 0, NULL); +} + +static fdtype JimOpenForWrite(const char *filename, int append) +{ + return CreateFile(filename, append ? FILE_APPEND_DATA : GENERIC_WRITE, FILE_SHARE_READ | FILE_SHARE_WRITE, + JimStdSecAttrs(), append ? OPEN_ALWAYS : CREATE_ALWAYS, 0, (HANDLE) NULL); +} + +static FILE *JimFdOpenForWrite(fdtype fd) +{ + return _fdopen(_open_osfhandle((int)fd, _O_TEXT), "w"); +} + +static pidtype JimWaitPid(pidtype pid, int *status, int nohang) +{ + DWORD ret = WaitForSingleObject(pid, nohang ? 0 : INFINITE); + if (ret == WAIT_TIMEOUT || ret == WAIT_FAILED) { + + return JIM_BAD_PID; + } + GetExitCodeProcess(pid, &ret); + *status = ret; + CloseHandle(pid); + return pid; +} + +static HANDLE JimCreateTemp(Jim_Interp *interp, const char *contents, int len) +{ + char name[MAX_PATH]; + HANDLE handle; + + if (!GetTempPath(MAX_PATH, name) || !GetTempFileName(name, "JIM", 0, name)) { + return JIM_BAD_FD; + } + + handle = CreateFile(name, GENERIC_READ | GENERIC_WRITE, 0, JimStdSecAttrs(), + CREATE_ALWAYS, FILE_ATTRIBUTE_TEMPORARY | FILE_FLAG_DELETE_ON_CLOSE, + NULL); + + if (handle == INVALID_HANDLE_VALUE) { + goto error; + } + + if (contents != NULL) { + + FILE *fh = JimFdOpenForWrite(JimDupFd(handle)); + if (fh == NULL) { + goto error; + } + + if (fwrite(contents, len, 1, fh) != 1) { + fclose(fh); + goto error; + } + fseek(fh, 0, SEEK_SET); + fclose(fh); + } + return handle; + + error: + Jim_SetResultErrno(interp, "failed to create temp file"); + CloseHandle(handle); + DeleteFile(name); + return JIM_BAD_FD; +} + +static int +JimWinFindExecutable(const char *originalName, char fullPath[MAX_PATH]) +{ + int i; + static char extensions[][5] = {".exe", "", ".bat"}; + + for (i = 0; i < (int) (sizeof(extensions) / sizeof(extensions[0])); i++) { + snprintf(fullPath, MAX_PATH, "%s%s", originalName, extensions[i]); + + if (SearchPath(NULL, fullPath, NULL, MAX_PATH, fullPath, NULL) == 0) { + continue; + } + if (GetFileAttributes(fullPath) & FILE_ATTRIBUTE_DIRECTORY) { + continue; + } + return 0; + } + + return -1; +} + +static char **JimSaveEnv(char **env) +{ + return env; +} + +static void JimRestoreEnv(char **env) +{ + JimFreeEnv(env, Jim_GetEnviron()); +} + +static Jim_Obj * +JimWinBuildCommandLine(Jim_Interp *interp, char **argv) +{ + char *start, *special; + int quote, i; + + Jim_Obj *strObj = Jim_NewStringObj(interp, "", 0); + + for (i = 0; argv[i]; i++) { + if (i > 0) { + Jim_AppendString(interp, strObj, " ", 1); + } + + if (argv[i][0] == '\0') { + quote = 1; + } + else { + quote = 0; + for (start = argv[i]; *start != '\0'; start++) { + if (isspace(UCHAR(*start))) { + quote = 1; + break; + } + } + } + if (quote) { + Jim_AppendString(interp, strObj, "\"" , 1); + } + + start = argv[i]; + for (special = argv[i]; ; ) { + if ((*special == '\\') && (special[1] == '\\' || + special[1] == '"' || (quote && special[1] == '\0'))) { + Jim_AppendString(interp, strObj, start, special - start); + start = special; + while (1) { + special++; + if (*special == '"' || (quote && *special == '\0')) { + + Jim_AppendString(interp, strObj, start, special - start); + break; + } + if (*special != '\\') { + break; + } + } + Jim_AppendString(interp, strObj, start, special - start); + start = special; + } + if (*special == '"') { + if (special == start) { + Jim_AppendString(interp, strObj, "\"", 1); + } + else { + Jim_AppendString(interp, strObj, start, special - start); + } + Jim_AppendString(interp, strObj, "\\\"", 2); + start = special + 1; + } + if (*special == '\0') { + break; + } + special++; + } + Jim_AppendString(interp, strObj, start, special - start); + if (quote) { + Jim_AppendString(interp, strObj, "\"", 1); + } + } + return strObj; +} + +static pidtype +JimStartWinProcess(Jim_Interp *interp, char **argv, char *env, fdtype inputId, fdtype outputId, fdtype errorId) +{ + STARTUPINFO startInfo; + PROCESS_INFORMATION procInfo; + HANDLE hProcess, h; + char execPath[MAX_PATH]; + pidtype pid = JIM_BAD_PID; + Jim_Obj *cmdLineObj; + + if (JimWinFindExecutable(argv[0], execPath) < 0) { + return JIM_BAD_PID; + } + argv[0] = execPath; + + hProcess = GetCurrentProcess(); + cmdLineObj = JimWinBuildCommandLine(interp, argv); + + + ZeroMemory(&startInfo, sizeof(startInfo)); + startInfo.cb = sizeof(startInfo); + startInfo.dwFlags = STARTF_USESTDHANDLES; + startInfo.hStdInput = INVALID_HANDLE_VALUE; + startInfo.hStdOutput= INVALID_HANDLE_VALUE; + startInfo.hStdError = INVALID_HANDLE_VALUE; + + if (inputId == JIM_BAD_FD) { + if (CreatePipe(&startInfo.hStdInput, &h, JimStdSecAttrs(), 0) != FALSE) { + CloseHandle(h); + } + } else { + DuplicateHandle(hProcess, inputId, hProcess, &startInfo.hStdInput, + 0, TRUE, DUPLICATE_SAME_ACCESS); + } + if (startInfo.hStdInput == JIM_BAD_FD) { + goto end; + } + + if (outputId == JIM_BAD_FD) { + startInfo.hStdOutput = CreateFile("NUL:", GENERIC_WRITE, 0, + JimStdSecAttrs(), OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, NULL); + } else { + DuplicateHandle(hProcess, outputId, hProcess, &startInfo.hStdOutput, + 0, TRUE, DUPLICATE_SAME_ACCESS); + } + if (startInfo.hStdOutput == JIM_BAD_FD) { + goto end; + } + + if (errorId == JIM_BAD_FD) { + + startInfo.hStdError = CreateFile("NUL:", GENERIC_WRITE, 0, + JimStdSecAttrs(), OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, NULL); + } else { + DuplicateHandle(hProcess, errorId, hProcess, &startInfo.hStdError, + 0, TRUE, DUPLICATE_SAME_ACCESS); + } + if (startInfo.hStdError == JIM_BAD_FD) { + goto end; + } + + if (!CreateProcess(NULL, (char *)Jim_String(cmdLineObj), NULL, NULL, TRUE, + 0, env, NULL, &startInfo, &procInfo)) { + goto end; + } + + + WaitForInputIdle(procInfo.hProcess, 5000); + CloseHandle(procInfo.hThread); + + pid = procInfo.hProcess; + + end: + Jim_FreeNewObj(interp, cmdLineObj); + if (startInfo.hStdInput != JIM_BAD_FD) { + CloseHandle(startInfo.hStdInput); + } + if (startInfo.hStdOutput != JIM_BAD_FD) { + CloseHandle(startInfo.hStdOutput); + } + if (startInfo.hStdError != JIM_BAD_FD) { + CloseHandle(startInfo.hStdError); + } + return pid; +} +#else + +static int JimOpenForWrite(const char *filename, int append) +{ + return open(filename, O_WRONLY | O_CREAT | (append ? O_APPEND : O_TRUNC), 0666); +} + +static int JimRewindFd(int fd) +{ + return lseek(fd, 0L, SEEK_SET); +} + +static int JimCreateTemp(Jim_Interp *interp, const char *contents, int len) +{ + int fd = Jim_MakeTempFile(interp, NULL); + + if (fd != JIM_BAD_FD) { + unlink(Jim_String(Jim_GetResult(interp))); + if (contents) { + if (write(fd, contents, len) != len) { + Jim_SetResultErrno(interp, "couldn't write temp file"); + close(fd); + return -1; + } + lseek(fd, 0L, SEEK_SET); + } + } + return fd; +} + +static char **JimSaveEnv(char **env) +{ + char **saveenv = Jim_GetEnviron(); + Jim_SetEnviron(env); + return saveenv; +} + +static void JimRestoreEnv(char **env) +{ + JimFreeEnv(Jim_GetEnviron(), env); + Jim_SetEnviron(env); +} +#endif +#endif + + +#ifndef _XOPEN_SOURCE +#define _XOPEN_SOURCE 500 +#endif + +#include +#include +#include +#include + + +#ifdef HAVE_SYS_TIME_H +#include +#endif + +static int clock_cmd_format(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + + char buf[100]; + time_t t; + long seconds; + + const char *format = "%a %b %d %H:%M:%S %Z %Y"; + + if (argc == 2 || (argc == 3 && !Jim_CompareStringImmediate(interp, argv[1], "-format"))) { + return -1; + } + + if (argc == 3) { + format = Jim_String(argv[2]); + } + + if (Jim_GetLong(interp, argv[0], &seconds) != JIM_OK) { + return JIM_ERR; + } + t = seconds; + + if (strftime(buf, sizeof(buf), format, localtime(&t)) == 0) { + Jim_SetResultString(interp, "format string too long", -1); + return JIM_ERR; + } + + Jim_SetResultString(interp, buf, -1); + + return JIM_OK; +} + +#ifdef HAVE_STRPTIME +static int clock_cmd_scan(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + char *pt; + struct tm tm; + time_t now = time(0); + + if (!Jim_CompareStringImmediate(interp, argv[1], "-format")) { + return -1; + } + + + localtime_r(&now, &tm); + + pt = strptime(Jim_String(argv[0]), Jim_String(argv[2]), &tm); + if (pt == 0 || *pt != 0) { + Jim_SetResultString(interp, "Failed to parse time according to format", -1); + return JIM_ERR; + } + + + Jim_SetResultInt(interp, mktime(&tm)); + + return JIM_OK; +} +#endif + +static int clock_cmd_seconds(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_SetResultInt(interp, time(NULL)); + + return JIM_OK; +} + +static int clock_cmd_micros(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct timeval tv; + + gettimeofday(&tv, NULL); + + Jim_SetResultInt(interp, (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec); + + return JIM_OK; +} + +static int clock_cmd_millis(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + struct timeval tv; + + gettimeofday(&tv, NULL); + + Jim_SetResultInt(interp, (jim_wide) tv.tv_sec * 1000 + tv.tv_usec / 1000); + + return JIM_OK; +} + +static const jim_subcmd_type clock_command_table[] = { + { "seconds", + NULL, + clock_cmd_seconds, + 0, + 0, + + }, + { "clicks", + NULL, + clock_cmd_micros, + 0, + 0, + + }, + { "microseconds", + NULL, + clock_cmd_micros, + 0, + 0, + + }, + { "milliseconds", + NULL, + clock_cmd_millis, + 0, + 0, + + }, + { "format", + "seconds ?-format format?", + clock_cmd_format, + 1, + 3, + + }, +#ifdef HAVE_STRPTIME + { "scan", + "str -format format", + clock_cmd_scan, + 3, + 3, + + }, +#endif + { NULL } +}; + +int Jim_clockInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "clock", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + Jim_CreateCommand(interp, "clock", Jim_SubCmdProc, (void *)clock_command_table, NULL); + return JIM_OK; +} + +#include +#include +#include +#include +#include + + +static int array_cmd_exists(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + + Jim_SetResultInt(interp, Jim_GetVariable(interp, argv[0], 0) != 0); + return JIM_OK; +} + +static int array_cmd_get(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE); + Jim_Obj *patternObj; + + if (!objPtr) { + return JIM_OK; + } + + patternObj = (argc == 1) ? NULL : argv[1]; + + + if (patternObj == NULL || Jim_CompareStringImmediate(interp, patternObj, "*")) { + if (Jim_IsList(objPtr) && Jim_ListLength(interp, objPtr) % 2 == 0) { + + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + } + + + return Jim_DictValues(interp, objPtr, patternObj); +} + +static int array_cmd_names(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE); + + if (!objPtr) { + return JIM_OK; + } + + return Jim_DictKeys(interp, objPtr, argc == 1 ? NULL : argv[1]); +} + +static int array_cmd_unset(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + int len; + Jim_Obj *resultObj; + Jim_Obj *objPtr; + Jim_Obj **dictValuesObj; + + if (argc == 1 || Jim_CompareStringImmediate(interp, argv[1], "*")) { + + Jim_UnsetVariable(interp, argv[0], JIM_NONE); + return JIM_OK; + } + + objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE); + + if (objPtr == NULL) { + + return JIM_OK; + } + + if (Jim_DictPairs(interp, objPtr, &dictValuesObj, &len) != JIM_OK) { + return JIM_ERR; + } + + + resultObj = Jim_NewDictObj(interp, NULL, 0); + + for (i = 0; i < len; i += 2) { + if (!Jim_StringMatchObj(interp, argv[1], dictValuesObj[i], 0)) { + Jim_DictAddElement(interp, resultObj, dictValuesObj[i], dictValuesObj[i + 1]); + } + } + Jim_Free(dictValuesObj); + + Jim_SetVariable(interp, argv[0], resultObj); + return JIM_OK; +} + +static int array_cmd_size(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr; + int len = 0; + + + objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE); + if (objPtr) { + len = Jim_DictSize(interp, objPtr); + if (len < 0) { + return JIM_ERR; + } + } + + Jim_SetResultInt(interp, len); + + return JIM_OK; +} + +static int array_cmd_stat(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr = Jim_GetVariable(interp, argv[0], JIM_NONE); + if (objPtr) { + return Jim_DictInfo(interp, objPtr); + } + Jim_SetResultFormatted(interp, "\"%#s\" isn't an array", argv[0], NULL); + return JIM_ERR; +} + +static int array_cmd_set(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + int len; + Jim_Obj *listObj = argv[1]; + Jim_Obj *dictObj; + + len = Jim_ListLength(interp, listObj); + if (len % 2) { + Jim_SetResultString(interp, "list must have an even number of elements", -1); + return JIM_ERR; + } + + dictObj = Jim_GetVariable(interp, argv[0], JIM_UNSHARED); + if (!dictObj) { + + return Jim_SetVariable(interp, argv[0], listObj); + } + else if (Jim_DictSize(interp, dictObj) < 0) { + return JIM_ERR; + } + + if (Jim_IsShared(dictObj)) { + dictObj = Jim_DuplicateObj(interp, dictObj); + } + + for (i = 0; i < len; i += 2) { + Jim_Obj *nameObj; + Jim_Obj *valueObj; + + Jim_ListIndex(interp, listObj, i, &nameObj, JIM_NONE); + Jim_ListIndex(interp, listObj, i + 1, &valueObj, JIM_NONE); + + Jim_DictAddElement(interp, dictObj, nameObj, valueObj); + } + return Jim_SetVariable(interp, argv[0], dictObj); +} + +static const jim_subcmd_type array_command_table[] = { + { "exists", + "arrayName", + array_cmd_exists, + 1, + 1, + + }, + { "get", + "arrayName ?pattern?", + array_cmd_get, + 1, + 2, + + }, + { "names", + "arrayName ?pattern?", + array_cmd_names, + 1, + 2, + + }, + { "set", + "arrayName list", + array_cmd_set, + 2, + 2, + + }, + { "size", + "arrayName", + array_cmd_size, + 1, + 1, + + }, + { "stat", + "arrayName", + array_cmd_stat, + 1, + 1, + + }, + { "unset", + "arrayName ?pattern?", + array_cmd_unset, + 1, + 2, + + }, + { NULL + } +}; + +int Jim_arrayInit(Jim_Interp *interp) +{ + if (Jim_PackageProvide(interp, "array", "1.0", JIM_ERRMSG)) + return JIM_ERR; + + Jim_CreateCommand(interp, "array", Jim_SubCmdProc, (void *)array_command_table, NULL); + return JIM_OK; +} +int Jim_InitStaticExtensions(Jim_Interp *interp) +{ +extern int Jim_bootstrapInit(Jim_Interp *); +extern int Jim_aioInit(Jim_Interp *); +extern int Jim_readdirInit(Jim_Interp *); +extern int Jim_regexpInit(Jim_Interp *); +extern int Jim_fileInit(Jim_Interp *); +extern int Jim_globInit(Jim_Interp *); +extern int Jim_execInit(Jim_Interp *); +extern int Jim_clockInit(Jim_Interp *); +extern int Jim_arrayInit(Jim_Interp *); +extern int Jim_stdlibInit(Jim_Interp *); +extern int Jim_tclcompatInit(Jim_Interp *); +Jim_bootstrapInit(interp); +Jim_aioInit(interp); +Jim_readdirInit(interp); +Jim_regexpInit(interp); +Jim_fileInit(interp); +Jim_globInit(interp); +Jim_execInit(interp); +Jim_clockInit(interp); +Jim_arrayInit(interp); +Jim_stdlibInit(interp); +Jim_tclcompatInit(interp); +return JIM_OK; +} +#define JIM_OPTIMIZATION + +#include +#include + +#include +#include +#include +#include +#include +#include +#include +#include + + +#ifdef HAVE_SYS_TIME_H +#include +#endif +#ifdef HAVE_BACKTRACE +#include +#endif +#ifdef HAVE_CRT_EXTERNS_H +#include +#endif + + +#include + + + + + +#ifndef TCL_LIBRARY +#define TCL_LIBRARY "." +#endif +#ifndef TCL_PLATFORM_OS +#define TCL_PLATFORM_OS "unknown" +#endif +#ifndef TCL_PLATFORM_PLATFORM +#define TCL_PLATFORM_PLATFORM "unknown" +#endif +#ifndef TCL_PLATFORM_PATH_SEPARATOR +#define TCL_PLATFORM_PATH_SEPARATOR ":" +#endif + + + + + + + +#ifdef JIM_MAINTAINER +#define JIM_DEBUG_COMMAND +#define JIM_DEBUG_PANIC +#endif + + + +#define JIM_INTEGER_SPACE 24 + +const char *jim_tt_name(int type); + +#ifdef JIM_DEBUG_PANIC +static void JimPanicDump(int fail_condition, const char *fmt, ...); +#define JimPanic(X) JimPanicDump X +#else +#define JimPanic(X) +#endif + + +static char JimEmptyStringRep[] = ""; + +static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action); +static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int listindex, Jim_Obj *newObjPtr, + int flags); +static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands); +static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr); +static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr); +static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len); +static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype, + const char *prefix, const char *const *tablePtr, const char *name); +static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv); +static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr); +static int JimSign(jim_wide w); +static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr); +static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen); +static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len); + + + +#define JimWideValue(objPtr) (objPtr)->internalRep.wideValue + +#define JimObjTypeName(O) ((O)->typePtr ? (O)->typePtr->name : "none") + +static int utf8_tounicode_case(const char *s, int *uc, int upper) +{ + int l = utf8_tounicode(s, uc); + if (upper) { + *uc = utf8_upper(*uc); + } + return l; +} + + +#define JIM_CHARSET_SCAN 2 +#define JIM_CHARSET_GLOB 0 + +static const char *JimCharsetMatch(const char *pattern, int c, int flags) +{ + int not = 0; + int pchar; + int match = 0; + int nocase = 0; + + if (flags & JIM_NOCASE) { + nocase++; + c = utf8_upper(c); + } + + if (flags & JIM_CHARSET_SCAN) { + if (*pattern == '^') { + not++; + pattern++; + } + + + if (*pattern == ']') { + goto first; + } + } + + while (*pattern && *pattern != ']') { + + if (pattern[0] == '\\') { +first: + pattern += utf8_tounicode_case(pattern, &pchar, nocase); + } + else { + + int start; + int end; + + pattern += utf8_tounicode_case(pattern, &start, nocase); + if (pattern[0] == '-' && pattern[1]) { + + pattern += utf8_tounicode(pattern, &pchar); + pattern += utf8_tounicode_case(pattern, &end, nocase); + + + if ((c >= start && c <= end) || (c >= end && c <= start)) { + match = 1; + } + continue; + } + pchar = start; + } + + if (pchar == c) { + match = 1; + } + } + if (not) { + match = !match; + } + + return match ? pattern : NULL; +} + + + +static int JimGlobMatch(const char *pattern, const char *string, int nocase) +{ + int c; + int pchar; + while (*pattern) { + switch (pattern[0]) { + case '*': + while (pattern[1] == '*') { + pattern++; + } + pattern++; + if (!pattern[0]) { + return 1; + } + while (*string) { + + if (JimGlobMatch(pattern, string, nocase)) + return 1; + string += utf8_tounicode(string, &c); + } + return 0; + + case '?': + string += utf8_tounicode(string, &c); + break; + + case '[': { + string += utf8_tounicode(string, &c); + pattern = JimCharsetMatch(pattern + 1, c, nocase ? JIM_NOCASE : 0); + if (!pattern) { + return 0; + } + if (!*pattern) { + + continue; + } + break; + } + case '\\': + if (pattern[1]) { + pattern++; + } + + default: + string += utf8_tounicode_case(string, &c, nocase); + utf8_tounicode_case(pattern, &pchar, nocase); + if (pchar != c) { + return 0; + } + break; + } + pattern += utf8_tounicode_case(pattern, &pchar, nocase); + if (!*string) { + while (*pattern == '*') { + pattern++; + } + break; + } + } + if (!*pattern && !*string) { + return 1; + } + return 0; +} + +static int JimStringCompare(const char *s1, int l1, const char *s2, int l2) +{ + if (l1 < l2) { + return memcmp(s1, s2, l1) <= 0 ? -1 : 1; + } + else if (l2 < l1) { + return memcmp(s1, s2, l2) >= 0 ? 1 : -1; + } + else { + return JimSign(memcmp(s1, s2, l1)); + } +} + +static int JimStringCompareLen(const char *s1, const char *s2, int maxchars, int nocase) +{ + while (*s1 && *s2 && maxchars) { + int c1, c2; + s1 += utf8_tounicode_case(s1, &c1, nocase); + s2 += utf8_tounicode_case(s2, &c2, nocase); + if (c1 != c2) { + return JimSign(c1 - c2); + } + maxchars--; + } + if (!maxchars) { + return 0; + } + + if (*s1) { + return 1; + } + if (*s2) { + return -1; + } + return 0; +} + +static int JimStringFirst(const char *s1, int l1, const char *s2, int l2, int idx) +{ + int i; + int l1bytelen; + + if (!l1 || !l2 || l1 > l2) { + return -1; + } + if (idx < 0) + idx = 0; + s2 += utf8_index(s2, idx); + + l1bytelen = utf8_index(s1, l1); + + for (i = idx; i <= l2 - l1; i++) { + int c; + if (memcmp(s2, s1, l1bytelen) == 0) { + return i; + } + s2 += utf8_tounicode(s2, &c); + } + return -1; +} + +static int JimStringLast(const char *s1, int l1, const char *s2, int l2) +{ + const char *p; + + if (!l1 || !l2 || l1 > l2) + return -1; + + + for (p = s2 + l2 - 1; p != s2 - 1; p--) { + if (*p == *s1 && memcmp(s1, p, l1) == 0) { + return p - s2; + } + } + return -1; +} + +#ifdef JIM_UTF8 +static int JimStringLastUtf8(const char *s1, int l1, const char *s2, int l2) +{ + int n = JimStringLast(s1, utf8_index(s1, l1), s2, utf8_index(s2, l2)); + if (n > 0) { + n = utf8_strlen(s2, n); + } + return n; +} +#endif + +static int JimCheckConversion(const char *str, const char *endptr) +{ + if (str[0] == '\0' || str == endptr) { + return JIM_ERR; + } + + if (endptr[0] != '\0') { + while (*endptr) { + if (!isspace(UCHAR(*endptr))) { + return JIM_ERR; + } + endptr++; + } + } + return JIM_OK; +} + +static int JimNumberBase(const char *str, int *base, int *sign) +{ + int i = 0; + + *base = 10; + + while (isspace(UCHAR(str[i]))) { + i++; + } + + if (str[i] == '-') { + *sign = -1; + i++; + } + else { + if (str[i] == '+') { + i++; + } + *sign = 1; + } + + if (str[i] != '0') { + + return 0; + } + + + switch (str[i + 1]) { + case 'x': case 'X': *base = 16; break; + case 'o': case 'O': *base = 8; break; + case 'b': case 'B': *base = 2; break; + default: return 0; + } + i += 2; + + if (str[i] != '-' && str[i] != '+' && !isspace(UCHAR(str[i]))) { + + return i; + } + + *base = 10; + return 0; +} + +static long jim_strtol(const char *str, char **endptr) +{ + int sign; + int base; + int i = JimNumberBase(str, &base, &sign); + + if (base != 10) { + long value = strtol(str + i, endptr, base); + if (endptr == NULL || *endptr != str + i) { + return value * sign; + } + } + + + return strtol(str, endptr, 10); +} + + +static jim_wide jim_strtoull(const char *str, char **endptr) +{ +#ifdef HAVE_LONG_LONG + int sign; + int base; + int i = JimNumberBase(str, &base, &sign); + + if (base != 10) { + jim_wide value = strtoull(str + i, endptr, base); + if (endptr == NULL || *endptr != str + i) { + return value * sign; + } + } + + + return strtoull(str, endptr, 10); +#else + return (unsigned long)jim_strtol(str, endptr); +#endif +} + +int Jim_StringToWide(const char *str, jim_wide * widePtr, int base) +{ + char *endptr; + + if (base) { + *widePtr = strtoull(str, &endptr, base); + } + else { + *widePtr = jim_strtoull(str, &endptr); + } + + return JimCheckConversion(str, endptr); +} + +int Jim_StringToDouble(const char *str, double *doublePtr) +{ + char *endptr; + + + errno = 0; + + *doublePtr = strtod(str, &endptr); + + return JimCheckConversion(str, endptr); +} + +static jim_wide JimPowWide(jim_wide b, jim_wide e) +{ + jim_wide i, res = 1; + + if ((b == 0 && e != 0) || (e < 0)) + return 0; + for (i = 0; i < e; i++) { + res *= b; + } + return res; +} + +#ifdef JIM_DEBUG_PANIC +static void JimPanicDump(int condition, const char *fmt, ...) +{ + va_list ap; + + if (!condition) { + return; + } + + va_start(ap, fmt); + + fprintf(stderr, "\nJIM INTERPRETER PANIC: "); + vfprintf(stderr, fmt, ap); + fprintf(stderr, "\n\n"); + va_end(ap); + +#ifdef HAVE_BACKTRACE + { + void *array[40]; + int size, i; + char **strings; + + size = backtrace(array, 40); + strings = backtrace_symbols(array, size); + for (i = 0; i < size; i++) + fprintf(stderr, "[backtrace] %s\n", strings[i]); + fprintf(stderr, "[backtrace] Include the above lines and the output\n"); + fprintf(stderr, "[backtrace] of 'nm ' in the bug report.\n"); + } +#endif + + exit(1); +} +#endif + + +void *Jim_Alloc(int size) +{ + return size ? malloc(size) : NULL; +} + +void Jim_Free(void *ptr) +{ + free(ptr); +} + +void *Jim_Realloc(void *ptr, int size) +{ + return realloc(ptr, size); +} + +char *Jim_StrDup(const char *s) +{ + return strdup(s); +} + +char *Jim_StrDupLen(const char *s, int l) +{ + char *copy = Jim_Alloc(l + 1); + + memcpy(copy, s, l + 1); + copy[l] = 0; + return copy; +} + + + +static jim_wide JimClock(void) +{ + struct timeval tv; + + gettimeofday(&tv, NULL); + return (jim_wide) tv.tv_sec * 1000000 + tv.tv_usec; +} + + + +static void JimExpandHashTableIfNeeded(Jim_HashTable *ht); +static unsigned int JimHashTableNextPower(unsigned int size); +static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace); + + + + +unsigned int Jim_IntHashFunction(unsigned int key) +{ + key += ~(key << 15); + key ^= (key >> 10); + key += (key << 3); + key ^= (key >> 6); + key += ~(key << 11); + key ^= (key >> 16); + return key; +} + +unsigned int Jim_GenHashFunction(const unsigned char *buf, int len) +{ + unsigned int h = 0; + + while (len--) + h += (h << 3) + *buf++; + return h; +} + + + + +static void JimResetHashTable(Jim_HashTable *ht) +{ + ht->table = NULL; + ht->size = 0; + ht->sizemask = 0; + ht->used = 0; + ht->collisions = 0; +#ifdef JIM_RANDOMISE_HASH + ht->uniq = (rand() ^ time(NULL) ^ clock()); +#else + ht->uniq = 0; +#endif +} + +static void JimInitHashTableIterator(Jim_HashTable *ht, Jim_HashTableIterator *iter) +{ + iter->ht = ht; + iter->index = -1; + iter->entry = NULL; + iter->nextEntry = NULL; +} + + +int Jim_InitHashTable(Jim_HashTable *ht, const Jim_HashTableType *type, void *privDataPtr) +{ + JimResetHashTable(ht); + ht->type = type; + ht->privdata = privDataPtr; + return JIM_OK; +} + +void Jim_ResizeHashTable(Jim_HashTable *ht) +{ + int minimal = ht->used; + + if (minimal < JIM_HT_INITIAL_SIZE) + minimal = JIM_HT_INITIAL_SIZE; + Jim_ExpandHashTable(ht, minimal); +} + + +void Jim_ExpandHashTable(Jim_HashTable *ht, unsigned int size) +{ + Jim_HashTable n; + unsigned int realsize = JimHashTableNextPower(size), i; + + if (size <= ht->used) + return; + + Jim_InitHashTable(&n, ht->type, ht->privdata); + n.size = realsize; + n.sizemask = realsize - 1; + n.table = Jim_Alloc(realsize * sizeof(Jim_HashEntry *)); + + n.uniq = ht->uniq; + + + memset(n.table, 0, realsize * sizeof(Jim_HashEntry *)); + + n.used = ht->used; + for (i = 0; ht->used > 0; i++) { + Jim_HashEntry *he, *nextHe; + + if (ht->table[i] == NULL) + continue; + + + he = ht->table[i]; + while (he) { + unsigned int h; + + nextHe = he->next; + + h = Jim_HashKey(ht, he->key) & n.sizemask; + he->next = n.table[h]; + n.table[h] = he; + ht->used--; + + he = nextHe; + } + } + assert(ht->used == 0); + Jim_Free(ht->table); + + + *ht = n; +} + + +int Jim_AddHashEntry(Jim_HashTable *ht, const void *key, void *val) +{ + Jim_HashEntry *entry; + + entry = JimInsertHashEntry(ht, key, 0); + if (entry == NULL) + return JIM_ERR; + + + Jim_SetHashKey(ht, entry, key); + Jim_SetHashVal(ht, entry, val); + return JIM_OK; +} + + +int Jim_ReplaceHashEntry(Jim_HashTable *ht, const void *key, void *val) +{ + int existed; + Jim_HashEntry *entry; + + entry = JimInsertHashEntry(ht, key, 1); + if (entry->key) { + if (ht->type->valDestructor && ht->type->valDup) { + void *newval = ht->type->valDup(ht->privdata, val); + ht->type->valDestructor(ht->privdata, entry->u.val); + entry->u.val = newval; + } + else { + Jim_FreeEntryVal(ht, entry); + Jim_SetHashVal(ht, entry, val); + } + existed = 1; + } + else { + + Jim_SetHashKey(ht, entry, key); + Jim_SetHashVal(ht, entry, val); + existed = 0; + } + + return existed; +} + + +int Jim_DeleteHashEntry(Jim_HashTable *ht, const void *key) +{ + unsigned int h; + Jim_HashEntry *he, *prevHe; + + if (ht->used == 0) + return JIM_ERR; + h = Jim_HashKey(ht, key) & ht->sizemask; + he = ht->table[h]; + + prevHe = NULL; + while (he) { + if (Jim_CompareHashKeys(ht, key, he->key)) { + + if (prevHe) + prevHe->next = he->next; + else + ht->table[h] = he->next; + Jim_FreeEntryKey(ht, he); + Jim_FreeEntryVal(ht, he); + Jim_Free(he); + ht->used--; + return JIM_OK; + } + prevHe = he; + he = he->next; + } + return JIM_ERR; +} + + +int Jim_FreeHashTable(Jim_HashTable *ht) +{ + unsigned int i; + + + for (i = 0; ht->used > 0; i++) { + Jim_HashEntry *he, *nextHe; + + if ((he = ht->table[i]) == NULL) + continue; + while (he) { + nextHe = he->next; + Jim_FreeEntryKey(ht, he); + Jim_FreeEntryVal(ht, he); + Jim_Free(he); + ht->used--; + he = nextHe; + } + } + + Jim_Free(ht->table); + + JimResetHashTable(ht); + return JIM_OK; +} + +Jim_HashEntry *Jim_FindHashEntry(Jim_HashTable *ht, const void *key) +{ + Jim_HashEntry *he; + unsigned int h; + + if (ht->used == 0) + return NULL; + h = Jim_HashKey(ht, key) & ht->sizemask; + he = ht->table[h]; + while (he) { + if (Jim_CompareHashKeys(ht, key, he->key)) + return he; + he = he->next; + } + return NULL; +} + +Jim_HashTableIterator *Jim_GetHashTableIterator(Jim_HashTable *ht) +{ + Jim_HashTableIterator *iter = Jim_Alloc(sizeof(*iter)); + JimInitHashTableIterator(ht, iter); + return iter; +} + +Jim_HashEntry *Jim_NextHashEntry(Jim_HashTableIterator *iter) +{ + while (1) { + if (iter->entry == NULL) { + iter->index++; + if (iter->index >= (signed)iter->ht->size) + break; + iter->entry = iter->ht->table[iter->index]; + } + else { + iter->entry = iter->nextEntry; + } + if (iter->entry) { + iter->nextEntry = iter->entry->next; + return iter->entry; + } + } + return NULL; +} + + + + +static void JimExpandHashTableIfNeeded(Jim_HashTable *ht) +{ + if (ht->size == 0) + Jim_ExpandHashTable(ht, JIM_HT_INITIAL_SIZE); + if (ht->size == ht->used) + Jim_ExpandHashTable(ht, ht->size * 2); +} + + +static unsigned int JimHashTableNextPower(unsigned int size) +{ + unsigned int i = JIM_HT_INITIAL_SIZE; + + if (size >= 2147483648U) + return 2147483648U; + while (1) { + if (i >= size) + return i; + i *= 2; + } +} + +static Jim_HashEntry *JimInsertHashEntry(Jim_HashTable *ht, const void *key, int replace) +{ + unsigned int h; + Jim_HashEntry *he; + + + JimExpandHashTableIfNeeded(ht); + + + h = Jim_HashKey(ht, key) & ht->sizemask; + + he = ht->table[h]; + while (he) { + if (Jim_CompareHashKeys(ht, key, he->key)) + return replace ? he : NULL; + he = he->next; + } + + + he = Jim_Alloc(sizeof(*he)); + he->next = ht->table[h]; + ht->table[h] = he; + ht->used++; + he->key = NULL; + + return he; +} + + + +static unsigned int JimStringCopyHTHashFunction(const void *key) +{ + return Jim_GenHashFunction(key, strlen(key)); +} + +static void *JimStringCopyHTDup(void *privdata, const void *key) +{ + return Jim_StrDup(key); +} + +static int JimStringCopyHTKeyCompare(void *privdata, const void *key1, const void *key2) +{ + return strcmp(key1, key2) == 0; +} + +static void JimStringCopyHTKeyDestructor(void *privdata, void *key) +{ + Jim_Free(key); +} + +static const Jim_HashTableType JimPackageHashTableType = { + JimStringCopyHTHashFunction, + JimStringCopyHTDup, + NULL, + JimStringCopyHTKeyCompare, + JimStringCopyHTKeyDestructor, + NULL +}; + +typedef struct AssocDataValue +{ + Jim_InterpDeleteProc *delProc; + void *data; +} AssocDataValue; + +static void JimAssocDataHashTableValueDestructor(void *privdata, void *data) +{ + AssocDataValue *assocPtr = (AssocDataValue *) data; + + if (assocPtr->delProc != NULL) + assocPtr->delProc((Jim_Interp *)privdata, assocPtr->data); + Jim_Free(data); +} + +static const Jim_HashTableType JimAssocDataHashTableType = { + JimStringCopyHTHashFunction, + JimStringCopyHTDup, + NULL, + JimStringCopyHTKeyCompare, + JimStringCopyHTKeyDestructor, + JimAssocDataHashTableValueDestructor +}; + +void Jim_InitStack(Jim_Stack *stack) +{ + stack->len = 0; + stack->maxlen = 0; + stack->vector = NULL; +} + +void Jim_FreeStack(Jim_Stack *stack) +{ + Jim_Free(stack->vector); +} + +int Jim_StackLen(Jim_Stack *stack) +{ + return stack->len; +} + +void Jim_StackPush(Jim_Stack *stack, void *element) +{ + int neededLen = stack->len + 1; + + if (neededLen > stack->maxlen) { + stack->maxlen = neededLen < 20 ? 20 : neededLen * 2; + stack->vector = Jim_Realloc(stack->vector, sizeof(void *) * stack->maxlen); + } + stack->vector[stack->len] = element; + stack->len++; +} + +void *Jim_StackPop(Jim_Stack *stack) +{ + if (stack->len == 0) + return NULL; + stack->len--; + return stack->vector[stack->len]; +} + +void *Jim_StackPeek(Jim_Stack *stack) +{ + if (stack->len == 0) + return NULL; + return stack->vector[stack->len - 1]; +} + +void Jim_FreeStackElements(Jim_Stack *stack, void (*freeFunc) (void *ptr)) +{ + int i; + + for (i = 0; i < stack->len; i++) + freeFunc(stack->vector[i]); +} + + + +#define JIM_TT_NONE 0 +#define JIM_TT_STR 1 +#define JIM_TT_ESC 2 +#define JIM_TT_VAR 3 +#define JIM_TT_DICTSUGAR 4 +#define JIM_TT_CMD 5 + +#define JIM_TT_SEP 6 +#define JIM_TT_EOL 7 +#define JIM_TT_EOF 8 + +#define JIM_TT_LINE 9 +#define JIM_TT_WORD 10 + + +#define JIM_TT_SUBEXPR_START 11 +#define JIM_TT_SUBEXPR_END 12 +#define JIM_TT_SUBEXPR_COMMA 13 +#define JIM_TT_EXPR_INT 14 +#define JIM_TT_EXPR_DOUBLE 15 + +#define JIM_TT_EXPRSUGAR 16 + + +#define JIM_TT_EXPR_OP 20 + +#define TOKEN_IS_SEP(type) (type >= JIM_TT_SEP && type <= JIM_TT_EOF) + +struct JimParseMissing { + int ch; + int line; +}; + +struct JimParserCtx +{ + const char *p; + int len; + int linenr; + const char *tstart; + const char *tend; + int tline; + int tt; + int eof; + int inquote; + int comment; + struct JimParseMissing missing; +}; + +static int JimParseScript(struct JimParserCtx *pc); +static int JimParseSep(struct JimParserCtx *pc); +static int JimParseEol(struct JimParserCtx *pc); +static int JimParseCmd(struct JimParserCtx *pc); +static int JimParseQuote(struct JimParserCtx *pc); +static int JimParseVar(struct JimParserCtx *pc); +static int JimParseBrace(struct JimParserCtx *pc); +static int JimParseStr(struct JimParserCtx *pc); +static int JimParseComment(struct JimParserCtx *pc); +static void JimParseSubCmd(struct JimParserCtx *pc); +static int JimParseSubQuote(struct JimParserCtx *pc); +static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc); + +static void JimParserInit(struct JimParserCtx *pc, const char *prg, int len, int linenr) +{ + pc->p = prg; + pc->len = len; + pc->tstart = NULL; + pc->tend = NULL; + pc->tline = 0; + pc->tt = JIM_TT_NONE; + pc->eof = 0; + pc->inquote = 0; + pc->linenr = linenr; + pc->comment = 1; + pc->missing.ch = ' '; + pc->missing.line = linenr; +} + +static int JimParseScript(struct JimParserCtx *pc) +{ + while (1) { + if (!pc->len) { + pc->tstart = pc->p; + pc->tend = pc->p - 1; + pc->tline = pc->linenr; + pc->tt = JIM_TT_EOL; + pc->eof = 1; + return JIM_OK; + } + switch (*(pc->p)) { + case '\\': + if (*(pc->p + 1) == '\n' && !pc->inquote) { + return JimParseSep(pc); + } + pc->comment = 0; + return JimParseStr(pc); + case ' ': + case '\t': + case '\r': + case '\f': + if (!pc->inquote) + return JimParseSep(pc); + pc->comment = 0; + return JimParseStr(pc); + case '\n': + case ';': + pc->comment = 1; + if (!pc->inquote) + return JimParseEol(pc); + return JimParseStr(pc); + case '[': + pc->comment = 0; + return JimParseCmd(pc); + case '$': + pc->comment = 0; + if (JimParseVar(pc) == JIM_ERR) { + + pc->tstart = pc->tend = pc->p++; + pc->len--; + pc->tt = JIM_TT_ESC; + } + return JIM_OK; + case '#': + if (pc->comment) { + JimParseComment(pc); + continue; + } + return JimParseStr(pc); + default: + pc->comment = 0; + return JimParseStr(pc); + } + return JIM_OK; + } +} + +static int JimParseSep(struct JimParserCtx *pc) +{ + pc->tstart = pc->p; + pc->tline = pc->linenr; + while (isspace(UCHAR(*pc->p)) || (*pc->p == '\\' && *(pc->p + 1) == '\n')) { + if (*pc->p == '\n') { + break; + } + if (*pc->p == '\\') { + pc->p++; + pc->len--; + pc->linenr++; + } + pc->p++; + pc->len--; + } + pc->tend = pc->p - 1; + pc->tt = JIM_TT_SEP; + return JIM_OK; +} + +static int JimParseEol(struct JimParserCtx *pc) +{ + pc->tstart = pc->p; + pc->tline = pc->linenr; + while (isspace(UCHAR(*pc->p)) || *pc->p == ';') { + if (*pc->p == '\n') + pc->linenr++; + pc->p++; + pc->len--; + } + pc->tend = pc->p - 1; + pc->tt = JIM_TT_EOL; + return JIM_OK; +} + + +static void JimParseSubBrace(struct JimParserCtx *pc) +{ + int level = 1; + + + pc->p++; + pc->len--; + while (pc->len) { + switch (*pc->p) { + case '\\': + if (pc->len > 1) { + if (*++pc->p == '\n') { + pc->linenr++; + } + pc->len--; + } + break; + + case '{': + level++; + break; + + case '}': + if (--level == 0) { + pc->tend = pc->p - 1; + pc->p++; + pc->len--; + return; + } + break; + + case '\n': + pc->linenr++; + break; + } + pc->p++; + pc->len--; + } + pc->missing.ch = '{'; + pc->missing.line = pc->tline; + pc->tend = pc->p - 1; +} + +static int JimParseSubQuote(struct JimParserCtx *pc) +{ + int tt = JIM_TT_STR; + int line = pc->tline; + + + pc->p++; + pc->len--; + while (pc->len) { + switch (*pc->p) { + case '\\': + if (pc->len > 1) { + if (*++pc->p == '\n') { + pc->linenr++; + } + pc->len--; + tt = JIM_TT_ESC; + } + break; + + case '"': + pc->tend = pc->p - 1; + pc->p++; + pc->len--; + return tt; + + case '[': + JimParseSubCmd(pc); + tt = JIM_TT_ESC; + continue; + + case '\n': + pc->linenr++; + break; + + case '$': + tt = JIM_TT_ESC; + break; + } + pc->p++; + pc->len--; + } + pc->missing.ch = '"'; + pc->missing.line = line; + pc->tend = pc->p - 1; + return tt; +} + +static void JimParseSubCmd(struct JimParserCtx *pc) +{ + int level = 1; + int startofword = 1; + int line = pc->tline; + + + pc->p++; + pc->len--; + while (pc->len) { + switch (*pc->p) { + case '\\': + if (pc->len > 1) { + if (*++pc->p == '\n') { + pc->linenr++; + } + pc->len--; + } + break; + + case '[': + level++; + break; + + case ']': + if (--level == 0) { + pc->tend = pc->p - 1; + pc->p++; + pc->len--; + return; + } + break; + + case '"': + if (startofword) { + JimParseSubQuote(pc); + continue; + } + break; + + case '{': + JimParseSubBrace(pc); + startofword = 0; + continue; + + case '\n': + pc->linenr++; + break; + } + startofword = isspace(UCHAR(*pc->p)); + pc->p++; + pc->len--; + } + pc->missing.ch = '['; + pc->missing.line = line; + pc->tend = pc->p - 1; +} + +static int JimParseBrace(struct JimParserCtx *pc) +{ + pc->tstart = pc->p + 1; + pc->tline = pc->linenr; + pc->tt = JIM_TT_STR; + JimParseSubBrace(pc); + return JIM_OK; +} + +static int JimParseCmd(struct JimParserCtx *pc) +{ + pc->tstart = pc->p + 1; + pc->tline = pc->linenr; + pc->tt = JIM_TT_CMD; + JimParseSubCmd(pc); + return JIM_OK; +} + +static int JimParseQuote(struct JimParserCtx *pc) +{ + pc->tstart = pc->p + 1; + pc->tline = pc->linenr; + pc->tt = JimParseSubQuote(pc); + return JIM_OK; +} + +static int JimParseVar(struct JimParserCtx *pc) +{ + + pc->p++; + pc->len--; + +#ifdef EXPRSUGAR_BRACKET + if (*pc->p == '[') { + + JimParseCmd(pc); + pc->tt = JIM_TT_EXPRSUGAR; + return JIM_OK; + } +#endif + + pc->tstart = pc->p; + pc->tt = JIM_TT_VAR; + pc->tline = pc->linenr; + + if (*pc->p == '{') { + pc->tstart = ++pc->p; + pc->len--; + + while (pc->len && *pc->p != '}') { + if (*pc->p == '\n') { + pc->linenr++; + } + pc->p++; + pc->len--; + } + pc->tend = pc->p - 1; + if (pc->len) { + pc->p++; + pc->len--; + } + } + else { + while (1) { + + if (pc->p[0] == ':' && pc->p[1] == ':') { + while (*pc->p == ':') { + pc->p++; + pc->len--; + } + continue; + } + if (isalnum(UCHAR(*pc->p)) || *pc->p == '_' || UCHAR(*pc->p) >= 0x80) { + pc->p++; + pc->len--; + continue; + } + break; + } + + if (*pc->p == '(') { + int count = 1; + const char *paren = NULL; + + pc->tt = JIM_TT_DICTSUGAR; + + while (count && pc->len) { + pc->p++; + pc->len--; + if (*pc->p == '\\' && pc->len >= 1) { + pc->p++; + pc->len--; + } + else if (*pc->p == '(') { + count++; + } + else if (*pc->p == ')') { + paren = pc->p; + count--; + } + } + if (count == 0) { + pc->p++; + pc->len--; + } + else if (paren) { + + paren++; + pc->len += (pc->p - paren); + pc->p = paren; + } +#ifndef EXPRSUGAR_BRACKET + if (*pc->tstart == '(') { + pc->tt = JIM_TT_EXPRSUGAR; + } +#endif + } + pc->tend = pc->p - 1; + } + if (pc->tstart == pc->p) { + pc->p--; + pc->len++; + return JIM_ERR; + } + return JIM_OK; +} + +static int JimParseStr(struct JimParserCtx *pc) +{ + if (pc->tt == JIM_TT_SEP || pc->tt == JIM_TT_EOL || + pc->tt == JIM_TT_NONE || pc->tt == JIM_TT_STR) { + + if (*pc->p == '{') { + return JimParseBrace(pc); + } + if (*pc->p == '"') { + pc->inquote = 1; + pc->p++; + pc->len--; + + pc->missing.line = pc->tline; + } + } + pc->tstart = pc->p; + pc->tline = pc->linenr; + while (1) { + if (pc->len == 0) { + if (pc->inquote) { + pc->missing.ch = '"'; + } + pc->tend = pc->p - 1; + pc->tt = JIM_TT_ESC; + return JIM_OK; + } + switch (*pc->p) { + case '\\': + if (!pc->inquote && *(pc->p + 1) == '\n') { + pc->tend = pc->p - 1; + pc->tt = JIM_TT_ESC; + return JIM_OK; + } + if (pc->len >= 2) { + if (*(pc->p + 1) == '\n') { + pc->linenr++; + } + pc->p++; + pc->len--; + } + else if (pc->len == 1) { + + pc->missing.ch = '\\'; + } + break; + case '(': + + if (pc->len > 1 && pc->p[1] != '$') { + break; + } + + case ')': + + if (*pc->p == '(' || pc->tt == JIM_TT_VAR) { + if (pc->p == pc->tstart) { + + pc->p++; + pc->len--; + } + pc->tend = pc->p - 1; + pc->tt = JIM_TT_ESC; + return JIM_OK; + } + break; + + case '$': + case '[': + pc->tend = pc->p - 1; + pc->tt = JIM_TT_ESC; + return JIM_OK; + case ' ': + case '\t': + case '\n': + case '\r': + case '\f': + case ';': + if (!pc->inquote) { + pc->tend = pc->p - 1; + pc->tt = JIM_TT_ESC; + return JIM_OK; + } + else if (*pc->p == '\n') { + pc->linenr++; + } + break; + case '"': + if (pc->inquote) { + pc->tend = pc->p - 1; + pc->tt = JIM_TT_ESC; + pc->p++; + pc->len--; + pc->inquote = 0; + return JIM_OK; + } + break; + } + pc->p++; + pc->len--; + } + return JIM_OK; +} + +static int JimParseComment(struct JimParserCtx *pc) +{ + while (*pc->p) { + if (*pc->p == '\\') { + pc->p++; + pc->len--; + if (pc->len == 0) { + pc->missing.ch = '\\'; + return JIM_OK; + } + if (*pc->p == '\n') { + pc->linenr++; + } + } + else if (*pc->p == '\n') { + pc->p++; + pc->len--; + pc->linenr++; + break; + } + pc->p++; + pc->len--; + } + return JIM_OK; +} + + +static int xdigitval(int c) +{ + if (c >= '0' && c <= '9') + return c - '0'; + if (c >= 'a' && c <= 'f') + return c - 'a' + 10; + if (c >= 'A' && c <= 'F') + return c - 'A' + 10; + return -1; +} + +static int odigitval(int c) +{ + if (c >= '0' && c <= '7') + return c - '0'; + return -1; +} + +static int JimEscape(char *dest, const char *s, int slen) +{ + char *p = dest; + int i, len; + + for (i = 0; i < slen; i++) { + switch (s[i]) { + case '\\': + switch (s[i + 1]) { + case 'a': + *p++ = 0x7; + i++; + break; + case 'b': + *p++ = 0x8; + i++; + break; + case 'f': + *p++ = 0xc; + i++; + break; + case 'n': + *p++ = 0xa; + i++; + break; + case 'r': + *p++ = 0xd; + i++; + break; + case 't': + *p++ = 0x9; + i++; + break; + case 'u': + case 'U': + case 'x': + { + unsigned val = 0; + int k; + int maxchars = 2; + + i++; + + if (s[i] == 'U') { + maxchars = 8; + } + else if (s[i] == 'u') { + if (s[i + 1] == '{') { + maxchars = 6; + i++; + } + else { + maxchars = 4; + } + } + + for (k = 0; k < maxchars; k++) { + int c = xdigitval(s[i + k + 1]); + if (c == -1) { + break; + } + val = (val << 4) | c; + } + + if (s[i] == '{') { + if (k == 0 || val > 0x1fffff || s[i + k + 1] != '}') { + + i--; + k = 0; + } + else { + + k++; + } + } + if (k) { + + if (s[i] == 'x') { + *p++ = val; + } + else { + p += utf8_fromunicode(p, val); + } + i += k; + break; + } + + *p++ = s[i]; + } + break; + case 'v': + *p++ = 0xb; + i++; + break; + case '\0': + *p++ = '\\'; + i++; + break; + case '\n': + + *p++ = ' '; + do { + i++; + } while (s[i + 1] == ' ' || s[i + 1] == '\t'); + break; + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + + { + int val = 0; + int c = odigitval(s[i + 1]); + + val = c; + c = odigitval(s[i + 2]); + if (c == -1) { + *p++ = val; + i++; + break; + } + val = (val * 8) + c; + c = odigitval(s[i + 3]); + if (c == -1) { + *p++ = val; + i += 2; + break; + } + val = (val * 8) + c; + *p++ = val; + i += 3; + } + break; + default: + *p++ = s[i + 1]; + i++; + break; + } + break; + default: + *p++ = s[i]; + break; + } + } + len = p - dest; + *p = '\0'; + return len; +} + +static Jim_Obj *JimParserGetTokenObj(Jim_Interp *interp, struct JimParserCtx *pc) +{ + const char *start, *end; + char *token; + int len; + + start = pc->tstart; + end = pc->tend; + if (start > end) { + len = 0; + token = Jim_Alloc(1); + token[0] = '\0'; + } + else { + len = (end - start) + 1; + token = Jim_Alloc(len + 1); + if (pc->tt != JIM_TT_ESC) { + + memcpy(token, start, len); + token[len] = '\0'; + } + else { + + len = JimEscape(token, start, len); + } + } + + return Jim_NewStringObjNoAlloc(interp, token, len); +} + +static int JimParseListSep(struct JimParserCtx *pc); +static int JimParseListStr(struct JimParserCtx *pc); +static int JimParseListQuote(struct JimParserCtx *pc); + +static int JimParseList(struct JimParserCtx *pc) +{ + if (isspace(UCHAR(*pc->p))) { + return JimParseListSep(pc); + } + switch (*pc->p) { + case '"': + return JimParseListQuote(pc); + + case '{': + return JimParseBrace(pc); + + default: + if (pc->len) { + return JimParseListStr(pc); + } + break; + } + + pc->tstart = pc->tend = pc->p; + pc->tline = pc->linenr; + pc->tt = JIM_TT_EOL; + pc->eof = 1; + return JIM_OK; +} + +static int JimParseListSep(struct JimParserCtx *pc) +{ + pc->tstart = pc->p; + pc->tline = pc->linenr; + while (isspace(UCHAR(*pc->p))) { + if (*pc->p == '\n') { + pc->linenr++; + } + pc->p++; + pc->len--; + } + pc->tend = pc->p - 1; + pc->tt = JIM_TT_SEP; + return JIM_OK; +} + +static int JimParseListQuote(struct JimParserCtx *pc) +{ + pc->p++; + pc->len--; + + pc->tstart = pc->p; + pc->tline = pc->linenr; + pc->tt = JIM_TT_STR; + + while (pc->len) { + switch (*pc->p) { + case '\\': + pc->tt = JIM_TT_ESC; + if (--pc->len == 0) { + + pc->tend = pc->p; + return JIM_OK; + } + pc->p++; + break; + case '\n': + pc->linenr++; + break; + case '"': + pc->tend = pc->p - 1; + pc->p++; + pc->len--; + return JIM_OK; + } + pc->p++; + pc->len--; + } + + pc->tend = pc->p - 1; + return JIM_OK; +} + +static int JimParseListStr(struct JimParserCtx *pc) +{ + pc->tstart = pc->p; + pc->tline = pc->linenr; + pc->tt = JIM_TT_STR; + + while (pc->len) { + if (isspace(UCHAR(*pc->p))) { + pc->tend = pc->p - 1; + return JIM_OK; + } + if (*pc->p == '\\') { + if (--pc->len == 0) { + + pc->tend = pc->p; + return JIM_OK; + } + pc->tt = JIM_TT_ESC; + pc->p++; + } + pc->p++; + pc->len--; + } + pc->tend = pc->p - 1; + return JIM_OK; +} + + + +Jim_Obj *Jim_NewObj(Jim_Interp *interp) +{ + Jim_Obj *objPtr; + + + if (interp->freeList != NULL) { + + objPtr = interp->freeList; + interp->freeList = objPtr->nextObjPtr; + } + else { + + objPtr = Jim_Alloc(sizeof(*objPtr)); + } + + objPtr->refCount = 0; + + + objPtr->prevObjPtr = NULL; + objPtr->nextObjPtr = interp->liveList; + if (interp->liveList) + interp->liveList->prevObjPtr = objPtr; + interp->liveList = objPtr; + + return objPtr; +} + +void Jim_FreeObj(Jim_Interp *interp, Jim_Obj *objPtr) +{ + + JimPanic((objPtr->refCount != 0, "!!!Object %p freed with bad refcount %d, type=%s", objPtr, + objPtr->refCount, objPtr->typePtr ? objPtr->typePtr->name : "")); + + + Jim_FreeIntRep(interp, objPtr); + + if (objPtr->bytes != NULL) { + if (objPtr->bytes != JimEmptyStringRep) + Jim_Free(objPtr->bytes); + } + + if (objPtr->prevObjPtr) + objPtr->prevObjPtr->nextObjPtr = objPtr->nextObjPtr; + if (objPtr->nextObjPtr) + objPtr->nextObjPtr->prevObjPtr = objPtr->prevObjPtr; + if (interp->liveList == objPtr) + interp->liveList = objPtr->nextObjPtr; +#ifdef JIM_DISABLE_OBJECT_POOL + Jim_Free(objPtr); +#else + + objPtr->prevObjPtr = NULL; + objPtr->nextObjPtr = interp->freeList; + if (interp->freeList) + interp->freeList->prevObjPtr = objPtr; + interp->freeList = objPtr; + objPtr->refCount = -1; +#endif +} + + +void Jim_InvalidateStringRep(Jim_Obj *objPtr) +{ + if (objPtr->bytes != NULL) { + if (objPtr->bytes != JimEmptyStringRep) + Jim_Free(objPtr->bytes); + } + objPtr->bytes = NULL; +} + + +Jim_Obj *Jim_DuplicateObj(Jim_Interp *interp, Jim_Obj *objPtr) +{ + Jim_Obj *dupPtr; + + dupPtr = Jim_NewObj(interp); + if (objPtr->bytes == NULL) { + + dupPtr->bytes = NULL; + } + else if (objPtr->length == 0) { + + dupPtr->bytes = JimEmptyStringRep; + dupPtr->length = 0; + dupPtr->typePtr = NULL; + return dupPtr; + } + else { + dupPtr->bytes = Jim_Alloc(objPtr->length + 1); + dupPtr->length = objPtr->length; + + memcpy(dupPtr->bytes, objPtr->bytes, objPtr->length + 1); + } + + + dupPtr->typePtr = objPtr->typePtr; + if (objPtr->typePtr != NULL) { + if (objPtr->typePtr->dupIntRepProc == NULL) { + dupPtr->internalRep = objPtr->internalRep; + } + else { + + objPtr->typePtr->dupIntRepProc(interp, objPtr, dupPtr); + } + } + return dupPtr; +} + +const char *Jim_GetString(Jim_Obj *objPtr, int *lenPtr) +{ + if (objPtr->bytes == NULL) { + + JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name)); + objPtr->typePtr->updateStringProc(objPtr); + } + if (lenPtr) + *lenPtr = objPtr->length; + return objPtr->bytes; +} + + +int Jim_Length(Jim_Obj *objPtr) +{ + if (objPtr->bytes == NULL) { + + JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name)); + objPtr->typePtr->updateStringProc(objPtr); + } + return objPtr->length; +} + + +const char *Jim_String(Jim_Obj *objPtr) +{ + if (objPtr->bytes == NULL) { + + JimPanic((objPtr->typePtr == NULL, "UpdateStringProc called against typeless value.")); + JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name)); + objPtr->typePtr->updateStringProc(objPtr); + } + return objPtr->bytes; +} + +static void JimSetStringBytes(Jim_Obj *objPtr, const char *str) +{ + objPtr->bytes = Jim_StrDup(str); + objPtr->length = strlen(str); +} + +static void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr); +static void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); + +static const Jim_ObjType dictSubstObjType = { + "dict-substitution", + FreeDictSubstInternalRep, + DupDictSubstInternalRep, + NULL, + JIM_TYPE_NONE, +}; + +static void FreeInterpolatedInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr); +} + +static const Jim_ObjType interpolatedObjType = { + "interpolated", + FreeInterpolatedInternalRep, + NULL, + NULL, + JIM_TYPE_NONE, +}; + +static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); +static int SetStringFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); + +static const Jim_ObjType stringObjType = { + "string", + NULL, + DupStringInternalRep, + NULL, + JIM_TYPE_REFERENCES, +}; + +static void DupStringInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + JIM_NOTUSED(interp); + + dupPtr->internalRep.strValue.maxLength = srcPtr->length; + dupPtr->internalRep.strValue.charLength = srcPtr->internalRep.strValue.charLength; +} + +static int SetStringFromAny(Jim_Interp *interp, Jim_Obj *objPtr) +{ + if (objPtr->typePtr != &stringObjType) { + + if (objPtr->bytes == NULL) { + + JimPanic((objPtr->typePtr->updateStringProc == NULL, "UpdateStringProc called against '%s' type.", objPtr->typePtr->name)); + objPtr->typePtr->updateStringProc(objPtr); + } + + Jim_FreeIntRep(interp, objPtr); + + objPtr->typePtr = &stringObjType; + objPtr->internalRep.strValue.maxLength = objPtr->length; + + objPtr->internalRep.strValue.charLength = -1; + } + return JIM_OK; +} + +int Jim_Utf8Length(Jim_Interp *interp, Jim_Obj *objPtr) +{ +#ifdef JIM_UTF8 + SetStringFromAny(interp, objPtr); + + if (objPtr->internalRep.strValue.charLength < 0) { + objPtr->internalRep.strValue.charLength = utf8_strlen(objPtr->bytes, objPtr->length); + } + return objPtr->internalRep.strValue.charLength; +#else + return Jim_Length(objPtr); +#endif +} + + +Jim_Obj *Jim_NewStringObj(Jim_Interp *interp, const char *s, int len) +{ + Jim_Obj *objPtr = Jim_NewObj(interp); + + + if (len == -1) + len = strlen(s); + + if (len == 0) { + objPtr->bytes = JimEmptyStringRep; + } + else { + objPtr->bytes = Jim_Alloc(len + 1); + memcpy(objPtr->bytes, s, len); + objPtr->bytes[len] = '\0'; + } + objPtr->length = len; + + + objPtr->typePtr = NULL; + return objPtr; +} + + +Jim_Obj *Jim_NewStringObjUtf8(Jim_Interp *interp, const char *s, int charlen) +{ +#ifdef JIM_UTF8 + + int bytelen = utf8_index(s, charlen); + + Jim_Obj *objPtr = Jim_NewStringObj(interp, s, bytelen); + + + objPtr->typePtr = &stringObjType; + objPtr->internalRep.strValue.maxLength = bytelen; + objPtr->internalRep.strValue.charLength = charlen; + + return objPtr; +#else + return Jim_NewStringObj(interp, s, charlen); +#endif +} + +Jim_Obj *Jim_NewStringObjNoAlloc(Jim_Interp *interp, char *s, int len) +{ + Jim_Obj *objPtr = Jim_NewObj(interp); + + objPtr->bytes = s; + objPtr->length = (len == -1) ? strlen(s) : len; + objPtr->typePtr = NULL; + return objPtr; +} + +static void StringAppendString(Jim_Obj *objPtr, const char *str, int len) +{ + int needlen; + + if (len == -1) + len = strlen(str); + needlen = objPtr->length + len; + if (objPtr->internalRep.strValue.maxLength < needlen || + objPtr->internalRep.strValue.maxLength == 0) { + needlen *= 2; + + if (needlen < 7) { + needlen = 7; + } + if (objPtr->bytes == JimEmptyStringRep) { + objPtr->bytes = Jim_Alloc(needlen + 1); + } + else { + objPtr->bytes = Jim_Realloc(objPtr->bytes, needlen + 1); + } + objPtr->internalRep.strValue.maxLength = needlen; + } + memcpy(objPtr->bytes + objPtr->length, str, len); + objPtr->bytes[objPtr->length + len] = '\0'; + + if (objPtr->internalRep.strValue.charLength >= 0) { + + objPtr->internalRep.strValue.charLength += utf8_strlen(objPtr->bytes + objPtr->length, len); + } + objPtr->length += len; +} + +void Jim_AppendString(Jim_Interp *interp, Jim_Obj *objPtr, const char *str, int len) +{ + JimPanic((Jim_IsShared(objPtr), "Jim_AppendString called with shared object")); + SetStringFromAny(interp, objPtr); + StringAppendString(objPtr, str, len); +} + +void Jim_AppendObj(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *appendObjPtr) +{ + int len; + const char *str = Jim_GetString(appendObjPtr, &len); + Jim_AppendString(interp, objPtr, str, len); +} + +void Jim_AppendStrings(Jim_Interp *interp, Jim_Obj *objPtr, ...) +{ + va_list ap; + + SetStringFromAny(interp, objPtr); + va_start(ap, objPtr); + while (1) { + const char *s = va_arg(ap, const char *); + + if (s == NULL) + break; + Jim_AppendString(interp, objPtr, s, -1); + } + va_end(ap); +} + +int Jim_StringEqObj(Jim_Obj *aObjPtr, Jim_Obj *bObjPtr) +{ + if (aObjPtr == bObjPtr) { + return 1; + } + else { + int Alen, Blen; + const char *sA = Jim_GetString(aObjPtr, &Alen); + const char *sB = Jim_GetString(bObjPtr, &Blen); + + return Alen == Blen && memcmp(sA, sB, Alen) == 0; + } +} + +int Jim_StringMatchObj(Jim_Interp *interp, Jim_Obj *patternObjPtr, Jim_Obj *objPtr, int nocase) +{ + return JimGlobMatch(Jim_String(patternObjPtr), Jim_String(objPtr), nocase); +} + +int Jim_StringCompareObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase) +{ + int l1, l2; + const char *s1 = Jim_GetString(firstObjPtr, &l1); + const char *s2 = Jim_GetString(secondObjPtr, &l2); + + if (nocase) { + + return JimStringCompareLen(s1, s2, -1, nocase); + } + return JimStringCompare(s1, l1, s2, l2); +} + +int Jim_StringCompareLenObj(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *secondObjPtr, int nocase) +{ + const char *s1 = Jim_String(firstObjPtr); + const char *s2 = Jim_String(secondObjPtr); + + return JimStringCompareLen(s1, s2, Jim_Utf8Length(interp, firstObjPtr), nocase); +} + +static int JimRelToAbsIndex(int len, int idx) +{ + if (idx < 0) + return len + idx; + return idx; +} + +static void JimRelToAbsRange(int len, int *firstPtr, int *lastPtr, int *rangeLenPtr) +{ + int rangeLen; + + if (*firstPtr > *lastPtr) { + rangeLen = 0; + } + else { + rangeLen = *lastPtr - *firstPtr + 1; + if (rangeLen) { + if (*firstPtr < 0) { + rangeLen += *firstPtr; + *firstPtr = 0; + } + if (*lastPtr >= len) { + rangeLen -= (*lastPtr - (len - 1)); + *lastPtr = len - 1; + } + } + } + if (rangeLen < 0) + rangeLen = 0; + + *rangeLenPtr = rangeLen; +} + +static int JimStringGetRange(Jim_Interp *interp, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, + int len, int *first, int *last, int *range) +{ + if (Jim_GetIndex(interp, firstObjPtr, first) != JIM_OK) { + return JIM_ERR; + } + if (Jim_GetIndex(interp, lastObjPtr, last) != JIM_OK) { + return JIM_ERR; + } + *first = JimRelToAbsIndex(len, *first); + *last = JimRelToAbsIndex(len, *last); + JimRelToAbsRange(len, first, last, range); + return JIM_OK; +} + +Jim_Obj *Jim_StringByteRangeObj(Jim_Interp *interp, + Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr) +{ + int first, last; + const char *str; + int rangeLen; + int bytelen; + + str = Jim_GetString(strObjPtr, &bytelen); + + if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, bytelen, &first, &last, &rangeLen) != JIM_OK) { + return NULL; + } + + if (first == 0 && rangeLen == bytelen) { + return strObjPtr; + } + return Jim_NewStringObj(interp, str + first, rangeLen); +} + +Jim_Obj *Jim_StringRangeObj(Jim_Interp *interp, + Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr) +{ +#ifdef JIM_UTF8 + int first, last; + const char *str; + int len, rangeLen; + int bytelen; + + str = Jim_GetString(strObjPtr, &bytelen); + len = Jim_Utf8Length(interp, strObjPtr); + + if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) { + return NULL; + } + + if (first == 0 && rangeLen == len) { + return strObjPtr; + } + if (len == bytelen) { + + return Jim_NewStringObj(interp, str + first, rangeLen); + } + return Jim_NewStringObjUtf8(interp, str + utf8_index(str, first), rangeLen); +#else + return Jim_StringByteRangeObj(interp, strObjPtr, firstObjPtr, lastObjPtr); +#endif +} + +Jim_Obj *JimStringReplaceObj(Jim_Interp *interp, + Jim_Obj *strObjPtr, Jim_Obj *firstObjPtr, Jim_Obj *lastObjPtr, Jim_Obj *newStrObj) +{ + int first, last; + const char *str; + int len, rangeLen; + Jim_Obj *objPtr; + + len = Jim_Utf8Length(interp, strObjPtr); + + if (JimStringGetRange(interp, firstObjPtr, lastObjPtr, len, &first, &last, &rangeLen) != JIM_OK) { + return NULL; + } + + if (last < first) { + return strObjPtr; + } + + str = Jim_String(strObjPtr); + + + objPtr = Jim_NewStringObjUtf8(interp, str, first); + + + if (newStrObj) { + Jim_AppendObj(interp, objPtr, newStrObj); + } + + + Jim_AppendString(interp, objPtr, str + utf8_index(str, last + 1), len - last - 1); + + return objPtr; +} + +static void JimStrCopyUpperLower(char *dest, const char *str, int uc) +{ + while (*str) { + int c; + str += utf8_tounicode(str, &c); + dest += utf8_getchars(dest, uc ? utf8_upper(c) : utf8_lower(c)); + } + *dest = 0; +} + +static Jim_Obj *JimStringToLower(Jim_Interp *interp, Jim_Obj *strObjPtr) +{ + char *buf; + int len; + const char *str; + + SetStringFromAny(interp, strObjPtr); + + str = Jim_GetString(strObjPtr, &len); + +#ifdef JIM_UTF8 + len *= 2; +#endif + buf = Jim_Alloc(len + 1); + JimStrCopyUpperLower(buf, str, 0); + return Jim_NewStringObjNoAlloc(interp, buf, -1); +} + +static Jim_Obj *JimStringToUpper(Jim_Interp *interp, Jim_Obj *strObjPtr) +{ + char *buf; + const char *str; + int len; + + if (strObjPtr->typePtr != &stringObjType) { + SetStringFromAny(interp, strObjPtr); + } + + str = Jim_GetString(strObjPtr, &len); + +#ifdef JIM_UTF8 + len *= 2; +#endif + buf = Jim_Alloc(len + 1); + JimStrCopyUpperLower(buf, str, 1); + return Jim_NewStringObjNoAlloc(interp, buf, -1); +} + +static Jim_Obj *JimStringToTitle(Jim_Interp *interp, Jim_Obj *strObjPtr) +{ + char *buf, *p; + int len; + int c; + const char *str; + + str = Jim_GetString(strObjPtr, &len); + if (len == 0) { + return strObjPtr; + } +#ifdef JIM_UTF8 + len *= 2; +#endif + buf = p = Jim_Alloc(len + 1); + + str += utf8_tounicode(str, &c); + p += utf8_getchars(p, utf8_title(c)); + + JimStrCopyUpperLower(p, str, 0); + + return Jim_NewStringObjNoAlloc(interp, buf, -1); +} + +static const char *utf8_memchr(const char *str, int len, int c) +{ +#ifdef JIM_UTF8 + while (len) { + int sc; + int n = utf8_tounicode(str, &sc); + if (sc == c) { + return str; + } + str += n; + len -= n; + } + return NULL; +#else + return memchr(str, c, len); +#endif +} + +static const char *JimFindTrimLeft(const char *str, int len, const char *trimchars, int trimlen) +{ + while (len) { + int c; + int n = utf8_tounicode(str, &c); + + if (utf8_memchr(trimchars, trimlen, c) == NULL) { + + break; + } + str += n; + len -= n; + } + return str; +} + +static const char *JimFindTrimRight(const char *str, int len, const char *trimchars, int trimlen) +{ + str += len; + + while (len) { + int c; + int n = utf8_prev_len(str, len); + + len -= n; + str -= n; + + n = utf8_tounicode(str, &c); + + if (utf8_memchr(trimchars, trimlen, c) == NULL) { + return str + n; + } + } + + return NULL; +} + +static const char default_trim_chars[] = " \t\n\r"; + +static int default_trim_chars_len = sizeof(default_trim_chars); + +static Jim_Obj *JimStringTrimLeft(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr) +{ + int len; + const char *str = Jim_GetString(strObjPtr, &len); + const char *trimchars = default_trim_chars; + int trimcharslen = default_trim_chars_len; + const char *newstr; + + if (trimcharsObjPtr) { + trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen); + } + + newstr = JimFindTrimLeft(str, len, trimchars, trimcharslen); + if (newstr == str) { + return strObjPtr; + } + + return Jim_NewStringObj(interp, newstr, len - (newstr - str)); +} + +static Jim_Obj *JimStringTrimRight(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr) +{ + int len; + const char *trimchars = default_trim_chars; + int trimcharslen = default_trim_chars_len; + const char *nontrim; + + if (trimcharsObjPtr) { + trimchars = Jim_GetString(trimcharsObjPtr, &trimcharslen); + } + + SetStringFromAny(interp, strObjPtr); + + len = Jim_Length(strObjPtr); + nontrim = JimFindTrimRight(strObjPtr->bytes, len, trimchars, trimcharslen); + + if (nontrim == NULL) { + + return Jim_NewEmptyStringObj(interp); + } + if (nontrim == strObjPtr->bytes + len) { + + return strObjPtr; + } + + if (Jim_IsShared(strObjPtr)) { + strObjPtr = Jim_NewStringObj(interp, strObjPtr->bytes, (nontrim - strObjPtr->bytes)); + } + else { + + strObjPtr->bytes[nontrim - strObjPtr->bytes] = 0; + strObjPtr->length = (nontrim - strObjPtr->bytes); + } + + return strObjPtr; +} + +static Jim_Obj *JimStringTrim(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *trimcharsObjPtr) +{ + + Jim_Obj *objPtr = JimStringTrimLeft(interp, strObjPtr, trimcharsObjPtr); + + + strObjPtr = JimStringTrimRight(interp, objPtr, trimcharsObjPtr); + + + if (objPtr != strObjPtr && objPtr->refCount == 0) { + + Jim_FreeNewObj(interp, objPtr); + } + + return strObjPtr; +} + + +#ifdef HAVE_ISASCII +#define jim_isascii isascii +#else +static int jim_isascii(int c) +{ + return !(c & ~0x7f); +} +#endif + +static int JimStringIs(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *strClass, int strict) +{ + static const char * const strclassnames[] = { + "integer", "alpha", "alnum", "ascii", "digit", + "double", "lower", "upper", "space", "xdigit", + "control", "print", "graph", "punct", + NULL + }; + enum { + STR_IS_INTEGER, STR_IS_ALPHA, STR_IS_ALNUM, STR_IS_ASCII, STR_IS_DIGIT, + STR_IS_DOUBLE, STR_IS_LOWER, STR_IS_UPPER, STR_IS_SPACE, STR_IS_XDIGIT, + STR_IS_CONTROL, STR_IS_PRINT, STR_IS_GRAPH, STR_IS_PUNCT + }; + int strclass; + int len; + int i; + const char *str; + int (*isclassfunc)(int c) = NULL; + + if (Jim_GetEnum(interp, strClass, strclassnames, &strclass, "class", JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { + return JIM_ERR; + } + + str = Jim_GetString(strObjPtr, &len); + if (len == 0) { + Jim_SetResultBool(interp, !strict); + return JIM_OK; + } + + switch (strclass) { + case STR_IS_INTEGER: + { + jim_wide w; + Jim_SetResultBool(interp, JimGetWideNoErr(interp, strObjPtr, &w) == JIM_OK); + return JIM_OK; + } + + case STR_IS_DOUBLE: + { + double d; + Jim_SetResultBool(interp, Jim_GetDouble(interp, strObjPtr, &d) == JIM_OK && errno != ERANGE); + return JIM_OK; + } + + case STR_IS_ALPHA: isclassfunc = isalpha; break; + case STR_IS_ALNUM: isclassfunc = isalnum; break; + case STR_IS_ASCII: isclassfunc = jim_isascii; break; + case STR_IS_DIGIT: isclassfunc = isdigit; break; + case STR_IS_LOWER: isclassfunc = islower; break; + case STR_IS_UPPER: isclassfunc = isupper; break; + case STR_IS_SPACE: isclassfunc = isspace; break; + case STR_IS_XDIGIT: isclassfunc = isxdigit; break; + case STR_IS_CONTROL: isclassfunc = iscntrl; break; + case STR_IS_PRINT: isclassfunc = isprint; break; + case STR_IS_GRAPH: isclassfunc = isgraph; break; + case STR_IS_PUNCT: isclassfunc = ispunct; break; + default: + return JIM_ERR; + } + + for (i = 0; i < len; i++) { + if (!isclassfunc(str[i])) { + Jim_SetResultBool(interp, 0); + return JIM_OK; + } + } + Jim_SetResultBool(interp, 1); + return JIM_OK; +} + + + +static const Jim_ObjType comparedStringObjType = { + "compared-string", + NULL, + NULL, + NULL, + JIM_TYPE_REFERENCES, +}; + +int Jim_CompareStringImmediate(Jim_Interp *interp, Jim_Obj *objPtr, const char *str) +{ + if (objPtr->typePtr == &comparedStringObjType && objPtr->internalRep.ptr == str) { + return 1; + } + else { + const char *objStr = Jim_String(objPtr); + + if (strcmp(str, objStr) != 0) + return 0; + + if (objPtr->typePtr != &comparedStringObjType) { + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &comparedStringObjType; + } + objPtr->internalRep.ptr = (char *)str; + return 1; + } +} + +static int qsortCompareStringPointers(const void *a, const void *b) +{ + char *const *sa = (char *const *)a; + char *const *sb = (char *const *)b; + + return strcmp(*sa, *sb); +} + + + +static void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr); +static void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); + +static const Jim_ObjType sourceObjType = { + "source", + FreeSourceInternalRep, + DupSourceInternalRep, + NULL, + JIM_TYPE_REFERENCES, +}; + +void FreeSourceInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + Jim_DecrRefCount(interp, objPtr->internalRep.sourceValue.fileNameObj); +} + +void DupSourceInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + dupPtr->internalRep.sourceValue = srcPtr->internalRep.sourceValue; + Jim_IncrRefCount(dupPtr->internalRep.sourceValue.fileNameObj); +} + +static void JimSetSourceInfo(Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj *fileNameObj, int lineNumber) +{ + JimPanic((Jim_IsShared(objPtr), "JimSetSourceInfo called with shared object")); + JimPanic((objPtr->typePtr != NULL, "JimSetSourceInfo called with typed object")); + Jim_IncrRefCount(fileNameObj); + objPtr->internalRep.sourceValue.fileNameObj = fileNameObj; + objPtr->internalRep.sourceValue.lineNumber = lineNumber; + objPtr->typePtr = &sourceObjType; +} + +static const Jim_ObjType scriptLineObjType = { + "scriptline", + NULL, + NULL, + NULL, + JIM_NONE, +}; + +static Jim_Obj *JimNewScriptLineObj(Jim_Interp *interp, int argc, int line) +{ + Jim_Obj *objPtr; + +#ifdef DEBUG_SHOW_SCRIPT + char buf[100]; + snprintf(buf, sizeof(buf), "line=%d, argc=%d", line, argc); + objPtr = Jim_NewStringObj(interp, buf, -1); +#else + objPtr = Jim_NewEmptyStringObj(interp); +#endif + objPtr->typePtr = &scriptLineObjType; + objPtr->internalRep.scriptLineValue.argc = argc; + objPtr->internalRep.scriptLineValue.line = line; + + return objPtr; +} + +static void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr); +static void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); + +static const Jim_ObjType scriptObjType = { + "script", + FreeScriptInternalRep, + DupScriptInternalRep, + NULL, + JIM_TYPE_REFERENCES, +}; + +typedef struct ScriptToken +{ + Jim_Obj *objPtr; + int type; +} ScriptToken; + +typedef struct ScriptObj +{ + ScriptToken *token; + Jim_Obj *fileNameObj; + int len; + int substFlags; + int inUse; /* Used to share a ScriptObj. Currently + only used by Jim_EvalObj() as protection against + shimmering of the currently evaluated object. */ + int firstline; + int linenr; + int missing; +} ScriptObj; + +static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); +static int JimParseCheckMissing(Jim_Interp *interp, int ch); +static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr); + +void FreeScriptInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + int i; + struct ScriptObj *script = (void *)objPtr->internalRep.ptr; + + if (--script->inUse != 0) + return; + for (i = 0; i < script->len; i++) { + Jim_DecrRefCount(interp, script->token[i].objPtr); + } + Jim_Free(script->token); + Jim_DecrRefCount(interp, script->fileNameObj); + Jim_Free(script); +} + +void DupScriptInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + JIM_NOTUSED(interp); + JIM_NOTUSED(srcPtr); + + dupPtr->typePtr = NULL; +} + +typedef struct +{ + const char *token; + int len; + int type; + int line; +} ParseToken; + +typedef struct +{ + + ParseToken *list; + int size; + int count; + ParseToken static_list[20]; +} ParseTokenList; + +static void ScriptTokenListInit(ParseTokenList *tokenlist) +{ + tokenlist->list = tokenlist->static_list; + tokenlist->size = sizeof(tokenlist->static_list) / sizeof(ParseToken); + tokenlist->count = 0; +} + +static void ScriptTokenListFree(ParseTokenList *tokenlist) +{ + if (tokenlist->list != tokenlist->static_list) { + Jim_Free(tokenlist->list); + } +} + +static void ScriptAddToken(ParseTokenList *tokenlist, const char *token, int len, int type, + int line) +{ + ParseToken *t; + + if (tokenlist->count == tokenlist->size) { + + tokenlist->size *= 2; + if (tokenlist->list != tokenlist->static_list) { + tokenlist->list = + Jim_Realloc(tokenlist->list, tokenlist->size * sizeof(*tokenlist->list)); + } + else { + + tokenlist->list = Jim_Alloc(tokenlist->size * sizeof(*tokenlist->list)); + memcpy(tokenlist->list, tokenlist->static_list, + tokenlist->count * sizeof(*tokenlist->list)); + } + } + t = &tokenlist->list[tokenlist->count++]; + t->token = token; + t->len = len; + t->type = type; + t->line = line; +} + +static int JimCountWordTokens(ParseToken *t) +{ + int expand = 1; + int count = 0; + + + if (t->type == JIM_TT_STR && !TOKEN_IS_SEP(t[1].type)) { + if ((t->len == 1 && *t->token == '*') || (t->len == 6 && strncmp(t->token, "expand", 6) == 0)) { + + expand = -1; + t++; + } + } + + + while (!TOKEN_IS_SEP(t->type)) { + t++; + count++; + } + + return count * expand; +} + +static Jim_Obj *JimMakeScriptObj(Jim_Interp *interp, const ParseToken *t) +{ + Jim_Obj *objPtr; + + if (t->type == JIM_TT_ESC && memchr(t->token, '\\', t->len) != NULL) { + + int len = t->len; + char *str = Jim_Alloc(len + 1); + len = JimEscape(str, t->token, len); + objPtr = Jim_NewStringObjNoAlloc(interp, str, len); + } + else { + objPtr = Jim_NewStringObj(interp, t->token, t->len); + } + return objPtr; +} + +static void ScriptObjAddTokens(Jim_Interp *interp, struct ScriptObj *script, + ParseTokenList *tokenlist) +{ + int i; + struct ScriptToken *token; + + int lineargs = 0; + + ScriptToken *linefirst; + int count; + int linenr; + +#ifdef DEBUG_SHOW_SCRIPT_TOKENS + printf("==== Tokens ====\n"); + for (i = 0; i < tokenlist->count; i++) { + printf("[%2d]@%d %s '%.*s'\n", i, tokenlist->list[i].line, jim_tt_name(tokenlist->list[i].type), + tokenlist->list[i].len, tokenlist->list[i].token); + } +#endif + + + count = tokenlist->count; + for (i = 0; i < tokenlist->count; i++) { + if (tokenlist->list[i].type == JIM_TT_EOL) { + count++; + } + } + linenr = script->firstline = tokenlist->list[0].line; + + token = script->token = Jim_Alloc(sizeof(ScriptToken) * count); + + + linefirst = token++; + + for (i = 0; i < tokenlist->count; ) { + + int wordtokens; + + + while (tokenlist->list[i].type == JIM_TT_SEP) { + i++; + } + + wordtokens = JimCountWordTokens(tokenlist->list + i); + + if (wordtokens == 0) { + + if (lineargs) { + linefirst->type = JIM_TT_LINE; + linefirst->objPtr = JimNewScriptLineObj(interp, lineargs, linenr); + Jim_IncrRefCount(linefirst->objPtr); + + + lineargs = 0; + linefirst = token++; + } + i++; + continue; + } + else if (wordtokens != 1) { + + token->type = JIM_TT_WORD; + token->objPtr = Jim_NewIntObj(interp, wordtokens); + Jim_IncrRefCount(token->objPtr); + token++; + if (wordtokens < 0) { + + i++; + wordtokens = -wordtokens - 1; + lineargs--; + } + } + + if (lineargs == 0) { + + linenr = tokenlist->list[i].line; + } + lineargs++; + + + while (wordtokens--) { + const ParseToken *t = &tokenlist->list[i++]; + + token->type = t->type; + token->objPtr = JimMakeScriptObj(interp, t); + Jim_IncrRefCount(token->objPtr); + + JimSetSourceInfo(interp, token->objPtr, script->fileNameObj, t->line); + token++; + } + } + + if (lineargs == 0) { + token--; + } + + script->len = token - script->token; + + JimPanic((script->len >= count, "allocated script array is too short")); + +#ifdef DEBUG_SHOW_SCRIPT + printf("==== Script (%s) ====\n", Jim_String(script->fileNameObj)); + for (i = 0; i < script->len; i++) { + const ScriptToken *t = &script->token[i]; + printf("[%2d] %s %s\n", i, jim_tt_name(t->type), Jim_String(t->objPtr)); + } +#endif + +} + +int Jim_ScriptIsComplete(Jim_Interp *interp, Jim_Obj *scriptObj, char *stateCharPtr) +{ + ScriptObj *script = JimGetScript(interp, scriptObj); + if (stateCharPtr) { + *stateCharPtr = script->missing; + } + return (script->missing == ' '); +} + +static int JimParseCheckMissing(Jim_Interp *interp, int ch) +{ + const char *msg; + + switch (ch) { + case '\\': + case ' ': + return JIM_OK; + + case '[': + msg = "unmatched \"[\""; + break; + case '{': + msg = "missing close-brace"; + break; + case '"': + default: + msg = "missing quote"; + break; + } + + Jim_SetResultString(interp, msg, -1); + return JIM_ERR; +} + +static void SubstObjAddTokens(Jim_Interp *interp, struct ScriptObj *script, + ParseTokenList *tokenlist) +{ + int i; + struct ScriptToken *token; + + token = script->token = Jim_Alloc(sizeof(ScriptToken) * tokenlist->count); + + for (i = 0; i < tokenlist->count; i++) { + const ParseToken *t = &tokenlist->list[i]; + + + token->type = t->type; + token->objPtr = JimMakeScriptObj(interp, t); + Jim_IncrRefCount(token->objPtr); + token++; + } + + script->len = i; +} + +static void JimSetScriptFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) +{ + int scriptTextLen; + const char *scriptText = Jim_GetString(objPtr, &scriptTextLen); + struct JimParserCtx parser; + struct ScriptObj *script; + ParseTokenList tokenlist; + int line = 1; + + + if (objPtr->typePtr == &sourceObjType) { + line = objPtr->internalRep.sourceValue.lineNumber; + } + + + ScriptTokenListInit(&tokenlist); + + JimParserInit(&parser, scriptText, scriptTextLen, line); + while (!parser.eof) { + JimParseScript(&parser); + ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt, + parser.tline); + } + + + ScriptAddToken(&tokenlist, scriptText + scriptTextLen, 0, JIM_TT_EOF, 0); + + + script = Jim_Alloc(sizeof(*script)); + memset(script, 0, sizeof(*script)); + script->inUse = 1; + if (objPtr->typePtr == &sourceObjType) { + script->fileNameObj = objPtr->internalRep.sourceValue.fileNameObj; + } + else { + script->fileNameObj = interp->emptyObj; + } + Jim_IncrRefCount(script->fileNameObj); + script->missing = parser.missing.ch; + script->linenr = parser.missing.line; + + ScriptObjAddTokens(interp, script, &tokenlist); + + + ScriptTokenListFree(&tokenlist); + + + Jim_FreeIntRep(interp, objPtr); + Jim_SetIntRepPtr(objPtr, script); + objPtr->typePtr = &scriptObjType; +} + +static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script); + +static ScriptObj *JimGetScript(Jim_Interp *interp, Jim_Obj *objPtr) +{ + if (objPtr == interp->emptyObj) { + + objPtr = interp->nullScriptObj; + } + + if (objPtr->typePtr != &scriptObjType || ((struct ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags) { + JimSetScriptFromAny(interp, objPtr); + } + + return (ScriptObj *)Jim_GetIntRepPtr(objPtr); +} + +static int JimScriptValid(Jim_Interp *interp, ScriptObj *script) +{ + if (JimParseCheckMissing(interp, script->missing) == JIM_ERR) { + JimAddErrorToStack(interp, script); + return 0; + } + return 1; +} + + +static void JimIncrCmdRefCount(Jim_Cmd *cmdPtr) +{ + cmdPtr->inUse++; +} + +static void JimDecrCmdRefCount(Jim_Interp *interp, Jim_Cmd *cmdPtr) +{ + if (--cmdPtr->inUse == 0) { + if (cmdPtr->isproc) { + Jim_DecrRefCount(interp, cmdPtr->u.proc.argListObjPtr); + Jim_DecrRefCount(interp, cmdPtr->u.proc.bodyObjPtr); + Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj); + if (cmdPtr->u.proc.staticVars) { + Jim_FreeHashTable(cmdPtr->u.proc.staticVars); + Jim_Free(cmdPtr->u.proc.staticVars); + } + } + else { + + if (cmdPtr->u.native.delProc) { + cmdPtr->u.native.delProc(interp, cmdPtr->u.native.privData); + } + } + if (cmdPtr->prevCmd) { + + JimDecrCmdRefCount(interp, cmdPtr->prevCmd); + } + Jim_Free(cmdPtr); + } +} + + +static void JimVariablesHTValDestructor(void *interp, void *val) +{ + Jim_DecrRefCount(interp, ((Jim_Var *)val)->objPtr); + Jim_Free(val); +} + +static const Jim_HashTableType JimVariablesHashTableType = { + JimStringCopyHTHashFunction, + JimStringCopyHTDup, + NULL, + JimStringCopyHTKeyCompare, + JimStringCopyHTKeyDestructor, + JimVariablesHTValDestructor +}; + +static void JimCommandsHT_ValDestructor(void *interp, void *val) +{ + JimDecrCmdRefCount(interp, val); +} + +static const Jim_HashTableType JimCommandsHashTableType = { + JimStringCopyHTHashFunction, + JimStringCopyHTDup, + NULL, + JimStringCopyHTKeyCompare, + JimStringCopyHTKeyDestructor, + JimCommandsHT_ValDestructor +}; + + + +#ifdef jim_ext_namespace +static Jim_Obj *JimQualifyNameObj(Jim_Interp *interp, Jim_Obj *nsObj) +{ + const char *name = Jim_String(nsObj); + if (name[0] == ':' && name[1] == ':') { + + while (*++name == ':') { + } + nsObj = Jim_NewStringObj(interp, name, -1); + } + else if (Jim_Length(interp->framePtr->nsObj)) { + + nsObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj); + Jim_AppendStrings(interp, nsObj, "::", name, NULL); + } + return nsObj; +} + +Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr) +{ + Jim_Obj *resultObj; + + const char *name = Jim_String(nameObjPtr); + if (name[0] == ':' && name[1] == ':') { + return nameObjPtr; + } + Jim_IncrRefCount(nameObjPtr); + resultObj = Jim_NewStringObj(interp, "::", -1); + Jim_AppendObj(interp, resultObj, nameObjPtr); + Jim_DecrRefCount(interp, nameObjPtr); + + return resultObj; +} + +static const char *JimQualifyName(Jim_Interp *interp, const char *name, Jim_Obj **objPtrPtr) +{ + Jim_Obj *objPtr = interp->emptyObj; + + if (name[0] == ':' && name[1] == ':') { + + while (*++name == ':') { + } + } + else if (Jim_Length(interp->framePtr->nsObj)) { + + objPtr = Jim_DuplicateObj(interp, interp->framePtr->nsObj); + Jim_AppendStrings(interp, objPtr, "::", name, NULL); + name = Jim_String(objPtr); + } + Jim_IncrRefCount(objPtr); + *objPtrPtr = objPtr; + return name; +} + + #define JimFreeQualifiedName(INTERP, OBJ) Jim_DecrRefCount((INTERP), (OBJ)) + +#else + + #define JimQualifyName(INTERP, NAME, DUMMY) (((NAME)[0] == ':' && (NAME)[1] == ':') ? (NAME) + 2 : (NAME)) + #define JimFreeQualifiedName(INTERP, DUMMY) (void)(DUMMY) + +Jim_Obj *Jim_MakeGlobalNamespaceName(Jim_Interp *interp, Jim_Obj *nameObjPtr) +{ + return nameObjPtr; +} +#endif + +static int JimCreateCommand(Jim_Interp *interp, const char *name, Jim_Cmd *cmd) +{ + Jim_HashEntry *he = Jim_FindHashEntry(&interp->commands, name); + if (he) { + + Jim_InterpIncrProcEpoch(interp); + } + + if (he && interp->local) { + + cmd->prevCmd = Jim_GetHashEntryVal(he); + Jim_SetHashVal(&interp->commands, he, cmd); + } + else { + if (he) { + + Jim_DeleteHashEntry(&interp->commands, name); + } + + Jim_AddHashEntry(&interp->commands, name, cmd); + } + return JIM_OK; +} + + +int Jim_CreateCommand(Jim_Interp *interp, const char *cmdNameStr, + Jim_CmdProc *cmdProc, void *privData, Jim_DelCmdProc *delProc) +{ + Jim_Cmd *cmdPtr = Jim_Alloc(sizeof(*cmdPtr)); + + + memset(cmdPtr, 0, sizeof(*cmdPtr)); + cmdPtr->inUse = 1; + cmdPtr->u.native.delProc = delProc; + cmdPtr->u.native.cmdProc = cmdProc; + cmdPtr->u.native.privData = privData; + + JimCreateCommand(interp, cmdNameStr, cmdPtr); + + return JIM_OK; +} + +static int JimCreateProcedureStatics(Jim_Interp *interp, Jim_Cmd *cmdPtr, Jim_Obj *staticsListObjPtr) +{ + int len, i; + + len = Jim_ListLength(interp, staticsListObjPtr); + if (len == 0) { + return JIM_OK; + } + + cmdPtr->u.proc.staticVars = Jim_Alloc(sizeof(Jim_HashTable)); + Jim_InitHashTable(cmdPtr->u.proc.staticVars, &JimVariablesHashTableType, interp); + for (i = 0; i < len; i++) { + Jim_Obj *objPtr, *initObjPtr, *nameObjPtr; + Jim_Var *varPtr; + int subLen; + + objPtr = Jim_ListGetIndex(interp, staticsListObjPtr, i); + + subLen = Jim_ListLength(interp, objPtr); + if (subLen == 1 || subLen == 2) { + nameObjPtr = Jim_ListGetIndex(interp, objPtr, 0); + if (subLen == 1) { + initObjPtr = Jim_GetVariable(interp, nameObjPtr, JIM_NONE); + if (initObjPtr == NULL) { + Jim_SetResultFormatted(interp, + "variable for initialization of static \"%#s\" not found in the local context", + nameObjPtr); + return JIM_ERR; + } + } + else { + initObjPtr = Jim_ListGetIndex(interp, objPtr, 1); + } + if (JimValidName(interp, "static variable", nameObjPtr) != JIM_OK) { + return JIM_ERR; + } + + varPtr = Jim_Alloc(sizeof(*varPtr)); + varPtr->objPtr = initObjPtr; + Jim_IncrRefCount(initObjPtr); + varPtr->linkFramePtr = NULL; + if (Jim_AddHashEntry(cmdPtr->u.proc.staticVars, + Jim_String(nameObjPtr), varPtr) != JIM_OK) { + Jim_SetResultFormatted(interp, + "static variable name \"%#s\" duplicated in statics list", nameObjPtr); + Jim_DecrRefCount(interp, initObjPtr); + Jim_Free(varPtr); + return JIM_ERR; + } + } + else { + Jim_SetResultFormatted(interp, "too many fields in static specifier \"%#s\"", + objPtr); + return JIM_ERR; + } + } + return JIM_OK; +} + +static void JimUpdateProcNamespace(Jim_Interp *interp, Jim_Cmd *cmdPtr, const char *cmdname) +{ +#ifdef jim_ext_namespace + if (cmdPtr->isproc) { + + const char *pt = strrchr(cmdname, ':'); + if (pt && pt != cmdname && pt[-1] == ':') { + Jim_DecrRefCount(interp, cmdPtr->u.proc.nsObj); + cmdPtr->u.proc.nsObj = Jim_NewStringObj(interp, cmdname, pt - cmdname - 1); + Jim_IncrRefCount(cmdPtr->u.proc.nsObj); + + if (Jim_FindHashEntry(&interp->commands, pt + 1)) { + + Jim_InterpIncrProcEpoch(interp); + } + } + } +#endif +} + +static Jim_Cmd *JimCreateProcedureCmd(Jim_Interp *interp, Jim_Obj *argListObjPtr, + Jim_Obj *staticsListObjPtr, Jim_Obj *bodyObjPtr, Jim_Obj *nsObj) +{ + Jim_Cmd *cmdPtr; + int argListLen; + int i; + + argListLen = Jim_ListLength(interp, argListObjPtr); + + + cmdPtr = Jim_Alloc(sizeof(*cmdPtr) + sizeof(struct Jim_ProcArg) * argListLen); + memset(cmdPtr, 0, sizeof(*cmdPtr)); + cmdPtr->inUse = 1; + cmdPtr->isproc = 1; + cmdPtr->u.proc.argListObjPtr = argListObjPtr; + cmdPtr->u.proc.argListLen = argListLen; + cmdPtr->u.proc.bodyObjPtr = bodyObjPtr; + cmdPtr->u.proc.argsPos = -1; + cmdPtr->u.proc.arglist = (struct Jim_ProcArg *)(cmdPtr + 1); + cmdPtr->u.proc.nsObj = nsObj ? nsObj : interp->emptyObj; + Jim_IncrRefCount(argListObjPtr); + Jim_IncrRefCount(bodyObjPtr); + Jim_IncrRefCount(cmdPtr->u.proc.nsObj); + + + if (staticsListObjPtr && JimCreateProcedureStatics(interp, cmdPtr, staticsListObjPtr) != JIM_OK) { + goto err; + } + + + + for (i = 0; i < argListLen; i++) { + Jim_Obj *argPtr; + Jim_Obj *nameObjPtr; + Jim_Obj *defaultObjPtr; + int len; + + + argPtr = Jim_ListGetIndex(interp, argListObjPtr, i); + len = Jim_ListLength(interp, argPtr); + if (len == 0) { + Jim_SetResultString(interp, "argument with no name", -1); +err: + JimDecrCmdRefCount(interp, cmdPtr); + return NULL; + } + if (len > 2) { + Jim_SetResultFormatted(interp, "too many fields in argument specifier \"%#s\"", argPtr); + goto err; + } + + if (len == 2) { + + nameObjPtr = Jim_ListGetIndex(interp, argPtr, 0); + defaultObjPtr = Jim_ListGetIndex(interp, argPtr, 1); + } + else { + + nameObjPtr = argPtr; + defaultObjPtr = NULL; + } + + + if (Jim_CompareStringImmediate(interp, nameObjPtr, "args")) { + if (cmdPtr->u.proc.argsPos >= 0) { + Jim_SetResultString(interp, "'args' specified more than once", -1); + goto err; + } + cmdPtr->u.proc.argsPos = i; + } + else { + if (len == 2) { + cmdPtr->u.proc.optArity++; + } + else { + cmdPtr->u.proc.reqArity++; + } + } + + cmdPtr->u.proc.arglist[i].nameObjPtr = nameObjPtr; + cmdPtr->u.proc.arglist[i].defaultObjPtr = defaultObjPtr; + } + + return cmdPtr; +} + +int Jim_DeleteCommand(Jim_Interp *interp, const char *name) +{ + int ret = JIM_OK; + Jim_Obj *qualifiedNameObj; + const char *qualname = JimQualifyName(interp, name, &qualifiedNameObj); + + if (Jim_DeleteHashEntry(&interp->commands, qualname) == JIM_ERR) { + Jim_SetResultFormatted(interp, "can't delete \"%s\": command doesn't exist", name); + ret = JIM_ERR; + } + else { + Jim_InterpIncrProcEpoch(interp); + } + + JimFreeQualifiedName(interp, qualifiedNameObj); + + return ret; +} + +int Jim_RenameCommand(Jim_Interp *interp, const char *oldName, const char *newName) +{ + int ret = JIM_ERR; + Jim_HashEntry *he; + Jim_Cmd *cmdPtr; + Jim_Obj *qualifiedOldNameObj; + Jim_Obj *qualifiedNewNameObj; + const char *fqold; + const char *fqnew; + + if (newName[0] == 0) { + return Jim_DeleteCommand(interp, oldName); + } + + fqold = JimQualifyName(interp, oldName, &qualifiedOldNameObj); + fqnew = JimQualifyName(interp, newName, &qualifiedNewNameObj); + + + he = Jim_FindHashEntry(&interp->commands, fqold); + if (he == NULL) { + Jim_SetResultFormatted(interp, "can't rename \"%s\": command doesn't exist", oldName); + } + else if (Jim_FindHashEntry(&interp->commands, fqnew)) { + Jim_SetResultFormatted(interp, "can't rename to \"%s\": command already exists", newName); + } + else { + + cmdPtr = Jim_GetHashEntryVal(he); + JimIncrCmdRefCount(cmdPtr); + JimUpdateProcNamespace(interp, cmdPtr, fqnew); + Jim_AddHashEntry(&interp->commands, fqnew, cmdPtr); + + + Jim_DeleteHashEntry(&interp->commands, fqold); + + + Jim_InterpIncrProcEpoch(interp); + + ret = JIM_OK; + } + + JimFreeQualifiedName(interp, qualifiedOldNameObj); + JimFreeQualifiedName(interp, qualifiedNewNameObj); + + return ret; +} + + +static void FreeCommandInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + Jim_DecrRefCount(interp, objPtr->internalRep.cmdValue.nsObj); +} + +static void DupCommandInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + dupPtr->internalRep.cmdValue = srcPtr->internalRep.cmdValue; + dupPtr->typePtr = srcPtr->typePtr; + Jim_IncrRefCount(dupPtr->internalRep.cmdValue.nsObj); +} + +static const Jim_ObjType commandObjType = { + "command", + FreeCommandInternalRep, + DupCommandInternalRep, + NULL, + JIM_TYPE_REFERENCES, +}; + +Jim_Cmd *Jim_GetCommand(Jim_Interp *interp, Jim_Obj *objPtr, int flags) +{ + Jim_Cmd *cmd; + + if (objPtr->typePtr != &commandObjType || + objPtr->internalRep.cmdValue.procEpoch != interp->procEpoch +#ifdef jim_ext_namespace + || !Jim_StringEqObj(objPtr->internalRep.cmdValue.nsObj, interp->framePtr->nsObj) +#endif + ) { + + + + const char *name = Jim_String(objPtr); + Jim_HashEntry *he; + + if (name[0] == ':' && name[1] == ':') { + while (*++name == ':') { + } + } +#ifdef jim_ext_namespace + else if (Jim_Length(interp->framePtr->nsObj)) { + + Jim_Obj *nameObj = Jim_DuplicateObj(interp, interp->framePtr->nsObj); + Jim_AppendStrings(interp, nameObj, "::", name, NULL); + he = Jim_FindHashEntry(&interp->commands, Jim_String(nameObj)); + Jim_FreeNewObj(interp, nameObj); + if (he) { + goto found; + } + } +#endif + + + he = Jim_FindHashEntry(&interp->commands, name); + if (he == NULL) { + if (flags & JIM_ERRMSG) { + Jim_SetResultFormatted(interp, "invalid command name \"%#s\"", objPtr); + } + return NULL; + } +#ifdef jim_ext_namespace +found: +#endif + cmd = Jim_GetHashEntryVal(he); + + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &commandObjType; + objPtr->internalRep.cmdValue.procEpoch = interp->procEpoch; + objPtr->internalRep.cmdValue.cmdPtr = cmd; + objPtr->internalRep.cmdValue.nsObj = interp->framePtr->nsObj; + Jim_IncrRefCount(interp->framePtr->nsObj); + } + else { + cmd = objPtr->internalRep.cmdValue.cmdPtr; + } + while (cmd->u.proc.upcall) { + cmd = cmd->prevCmd; + } + return cmd; +} + + + +#define JIM_DICT_SUGAR 100 + +static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); + +static const Jim_ObjType variableObjType = { + "variable", + NULL, + NULL, + NULL, + JIM_TYPE_REFERENCES, +}; + +static int JimValidName(Jim_Interp *interp, const char *type, Jim_Obj *nameObjPtr) +{ + + if (nameObjPtr->typePtr != &variableObjType) { + int len; + const char *str = Jim_GetString(nameObjPtr, &len); + if (memchr(str, '\0', len)) { + Jim_SetResultFormatted(interp, "%s name contains embedded null", type); + return JIM_ERR; + } + } + return JIM_OK; +} + +static int SetVariableFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) +{ + const char *varName; + Jim_CallFrame *framePtr; + Jim_HashEntry *he; + int global; + int len; + + + if (objPtr->typePtr == &variableObjType) { + framePtr = objPtr->internalRep.varValue.global ? interp->topFramePtr : interp->framePtr; + if (objPtr->internalRep.varValue.callFrameId == framePtr->id) { + + return JIM_OK; + } + + } + else if (objPtr->typePtr == &dictSubstObjType) { + return JIM_DICT_SUGAR; + } + else if (JimValidName(interp, "variable", objPtr) != JIM_OK) { + return JIM_ERR; + } + + + varName = Jim_GetString(objPtr, &len); + + + if (len && varName[len - 1] == ')' && strchr(varName, '(') != NULL) { + return JIM_DICT_SUGAR; + } + + if (varName[0] == ':' && varName[1] == ':') { + while (*++varName == ':') { + } + global = 1; + framePtr = interp->topFramePtr; + } + else { + global = 0; + framePtr = interp->framePtr; + } + + + he = Jim_FindHashEntry(&framePtr->vars, varName); + if (he == NULL) { + if (!global && framePtr->staticVars) { + + he = Jim_FindHashEntry(framePtr->staticVars, varName); + } + if (he == NULL) { + return JIM_ERR; + } + } + + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &variableObjType; + objPtr->internalRep.varValue.callFrameId = framePtr->id; + objPtr->internalRep.varValue.varPtr = Jim_GetHashEntryVal(he); + objPtr->internalRep.varValue.global = global; + return JIM_OK; +} + + +static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *ObjPtr, Jim_Obj *valObjPtr); +static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *ObjPtr, int flags); + +static Jim_Var *JimCreateVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr) +{ + const char *name; + Jim_CallFrame *framePtr; + int global; + + + Jim_Var *var = Jim_Alloc(sizeof(*var)); + + var->objPtr = valObjPtr; + Jim_IncrRefCount(valObjPtr); + var->linkFramePtr = NULL; + + name = Jim_String(nameObjPtr); + if (name[0] == ':' && name[1] == ':') { + while (*++name == ':') { + } + framePtr = interp->topFramePtr; + global = 1; + } + else { + framePtr = interp->framePtr; + global = 0; + } + + + Jim_AddHashEntry(&framePtr->vars, name, var); + + + Jim_FreeIntRep(interp, nameObjPtr); + nameObjPtr->typePtr = &variableObjType; + nameObjPtr->internalRep.varValue.callFrameId = framePtr->id; + nameObjPtr->internalRep.varValue.varPtr = var; + nameObjPtr->internalRep.varValue.global = global; + + return var; +} + + +int Jim_SetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, Jim_Obj *valObjPtr) +{ + int err; + Jim_Var *var; + + switch (SetVariableFromAny(interp, nameObjPtr)) { + case JIM_DICT_SUGAR: + return JimDictSugarSet(interp, nameObjPtr, valObjPtr); + + case JIM_ERR: + if (JimValidName(interp, "variable", nameObjPtr) != JIM_OK) { + return JIM_ERR; + } + JimCreateVariable(interp, nameObjPtr, valObjPtr); + break; + + case JIM_OK: + var = nameObjPtr->internalRep.varValue.varPtr; + if (var->linkFramePtr == NULL) { + Jim_IncrRefCount(valObjPtr); + Jim_DecrRefCount(interp, var->objPtr); + var->objPtr = valObjPtr; + } + else { + Jim_CallFrame *savedCallFrame; + + savedCallFrame = interp->framePtr; + interp->framePtr = var->linkFramePtr; + err = Jim_SetVariable(interp, var->objPtr, valObjPtr); + interp->framePtr = savedCallFrame; + if (err != JIM_OK) + return err; + } + } + return JIM_OK; +} + +int Jim_SetVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr) +{ + Jim_Obj *nameObjPtr; + int result; + + nameObjPtr = Jim_NewStringObj(interp, name, -1); + Jim_IncrRefCount(nameObjPtr); + result = Jim_SetVariable(interp, nameObjPtr, objPtr); + Jim_DecrRefCount(interp, nameObjPtr); + return result; +} + +int Jim_SetGlobalVariableStr(Jim_Interp *interp, const char *name, Jim_Obj *objPtr) +{ + Jim_CallFrame *savedFramePtr; + int result; + + savedFramePtr = interp->framePtr; + interp->framePtr = interp->topFramePtr; + result = Jim_SetVariableStr(interp, name, objPtr); + interp->framePtr = savedFramePtr; + return result; +} + +int Jim_SetVariableStrWithStr(Jim_Interp *interp, const char *name, const char *val) +{ + Jim_Obj *nameObjPtr, *valObjPtr; + int result; + + nameObjPtr = Jim_NewStringObj(interp, name, -1); + valObjPtr = Jim_NewStringObj(interp, val, -1); + Jim_IncrRefCount(nameObjPtr); + Jim_IncrRefCount(valObjPtr); + result = Jim_SetVariable(interp, nameObjPtr, valObjPtr); + Jim_DecrRefCount(interp, nameObjPtr); + Jim_DecrRefCount(interp, valObjPtr); + return result; +} + +int Jim_SetVariableLink(Jim_Interp *interp, Jim_Obj *nameObjPtr, + Jim_Obj *targetNameObjPtr, Jim_CallFrame *targetCallFrame) +{ + const char *varName; + const char *targetName; + Jim_CallFrame *framePtr; + Jim_Var *varPtr; + + + switch (SetVariableFromAny(interp, nameObjPtr)) { + case JIM_DICT_SUGAR: + + Jim_SetResultFormatted(interp, "bad variable name \"%#s\": upvar won't create a scalar variable that looks like an array element", nameObjPtr); + return JIM_ERR; + + case JIM_OK: + varPtr = nameObjPtr->internalRep.varValue.varPtr; + + if (varPtr->linkFramePtr == NULL) { + Jim_SetResultFormatted(interp, "variable \"%#s\" already exists", nameObjPtr); + return JIM_ERR; + } + + + varPtr->linkFramePtr = NULL; + break; + } + + + + varName = Jim_String(nameObjPtr); + + if (varName[0] == ':' && varName[1] == ':') { + while (*++varName == ':') { + } + + framePtr = interp->topFramePtr; + } + else { + framePtr = interp->framePtr; + } + + targetName = Jim_String(targetNameObjPtr); + if (targetName[0] == ':' && targetName[1] == ':') { + while (*++targetName == ':') { + } + targetNameObjPtr = Jim_NewStringObj(interp, targetName, -1); + targetCallFrame = interp->topFramePtr; + } + Jim_IncrRefCount(targetNameObjPtr); + + if (framePtr->level < targetCallFrame->level) { + Jim_SetResultFormatted(interp, + "bad variable name \"%#s\": upvar won't create namespace variable that refers to procedure variable", + nameObjPtr); + Jim_DecrRefCount(interp, targetNameObjPtr); + return JIM_ERR; + } + + + if (framePtr == targetCallFrame) { + Jim_Obj *objPtr = targetNameObjPtr; + + + while (1) { + if (strcmp(Jim_String(objPtr), varName) == 0) { + Jim_SetResultString(interp, "can't upvar from variable to itself", -1); + Jim_DecrRefCount(interp, targetNameObjPtr); + return JIM_ERR; + } + if (SetVariableFromAny(interp, objPtr) != JIM_OK) + break; + varPtr = objPtr->internalRep.varValue.varPtr; + if (varPtr->linkFramePtr != targetCallFrame) + break; + objPtr = varPtr->objPtr; + } + } + + + Jim_SetVariable(interp, nameObjPtr, targetNameObjPtr); + + nameObjPtr->internalRep.varValue.varPtr->linkFramePtr = targetCallFrame; + Jim_DecrRefCount(interp, targetNameObjPtr); + return JIM_OK; +} + +Jim_Obj *Jim_GetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags) +{ + switch (SetVariableFromAny(interp, nameObjPtr)) { + case JIM_OK:{ + Jim_Var *varPtr = nameObjPtr->internalRep.varValue.varPtr; + + if (varPtr->linkFramePtr == NULL) { + return varPtr->objPtr; + } + else { + Jim_Obj *objPtr; + + + Jim_CallFrame *savedCallFrame = interp->framePtr; + + interp->framePtr = varPtr->linkFramePtr; + objPtr = Jim_GetVariable(interp, varPtr->objPtr, flags); + interp->framePtr = savedCallFrame; + if (objPtr) { + return objPtr; + } + + } + } + break; + + case JIM_DICT_SUGAR: + + return JimDictSugarGet(interp, nameObjPtr, flags); + } + if (flags & JIM_ERRMSG) { + Jim_SetResultFormatted(interp, "can't read \"%#s\": no such variable", nameObjPtr); + } + return NULL; +} + +Jim_Obj *Jim_GetGlobalVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags) +{ + Jim_CallFrame *savedFramePtr; + Jim_Obj *objPtr; + + savedFramePtr = interp->framePtr; + interp->framePtr = interp->topFramePtr; + objPtr = Jim_GetVariable(interp, nameObjPtr, flags); + interp->framePtr = savedFramePtr; + + return objPtr; +} + +Jim_Obj *Jim_GetVariableStr(Jim_Interp *interp, const char *name, int flags) +{ + Jim_Obj *nameObjPtr, *varObjPtr; + + nameObjPtr = Jim_NewStringObj(interp, name, -1); + Jim_IncrRefCount(nameObjPtr); + varObjPtr = Jim_GetVariable(interp, nameObjPtr, flags); + Jim_DecrRefCount(interp, nameObjPtr); + return varObjPtr; +} + +Jim_Obj *Jim_GetGlobalVariableStr(Jim_Interp *interp, const char *name, int flags) +{ + Jim_CallFrame *savedFramePtr; + Jim_Obj *objPtr; + + savedFramePtr = interp->framePtr; + interp->framePtr = interp->topFramePtr; + objPtr = Jim_GetVariableStr(interp, name, flags); + interp->framePtr = savedFramePtr; + + return objPtr; +} + +int Jim_UnsetVariable(Jim_Interp *interp, Jim_Obj *nameObjPtr, int flags) +{ + Jim_Var *varPtr; + int retval; + Jim_CallFrame *framePtr; + + retval = SetVariableFromAny(interp, nameObjPtr); + if (retval == JIM_DICT_SUGAR) { + + return JimDictSugarSet(interp, nameObjPtr, NULL); + } + else if (retval == JIM_OK) { + varPtr = nameObjPtr->internalRep.varValue.varPtr; + + + if (varPtr->linkFramePtr) { + framePtr = interp->framePtr; + interp->framePtr = varPtr->linkFramePtr; + retval = Jim_UnsetVariable(interp, varPtr->objPtr, JIM_NONE); + interp->framePtr = framePtr; + } + else { + const char *name = Jim_String(nameObjPtr); + if (nameObjPtr->internalRep.varValue.global) { + name += 2; + framePtr = interp->topFramePtr; + } + else { + framePtr = interp->framePtr; + } + + retval = Jim_DeleteHashEntry(&framePtr->vars, name); + if (retval == JIM_OK) { + + framePtr->id = interp->callFrameEpoch++; + } + } + } + if (retval != JIM_OK && (flags & JIM_ERRMSG)) { + Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such variable", nameObjPtr); + } + return retval; +} + + + +static void JimDictSugarParseVarKey(Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj **varPtrPtr, Jim_Obj **keyPtrPtr) +{ + const char *str, *p; + int len, keyLen; + Jim_Obj *varObjPtr, *keyObjPtr; + + str = Jim_GetString(objPtr, &len); + + p = strchr(str, '('); + JimPanic((p == NULL, "JimDictSugarParseVarKey() called for non-dict-sugar (%s)", str)); + + varObjPtr = Jim_NewStringObj(interp, str, p - str); + + p++; + keyLen = (str + len) - p; + if (str[len - 1] == ')') { + keyLen--; + } + + + keyObjPtr = Jim_NewStringObj(interp, p, keyLen); + + Jim_IncrRefCount(varObjPtr); + Jim_IncrRefCount(keyObjPtr); + *varPtrPtr = varObjPtr; + *keyPtrPtr = keyObjPtr; +} + +static int JimDictSugarSet(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *valObjPtr) +{ + int err; + + SetDictSubstFromAny(interp, objPtr); + + err = Jim_SetDictKeysVector(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, + &objPtr->internalRep.dictSubstValue.indexObjPtr, 1, valObjPtr, JIM_MUSTEXIST); + + if (err == JIM_OK) { + + Jim_SetEmptyResult(interp); + } + else { + if (!valObjPtr) { + + if (Jim_GetVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, JIM_NONE)) { + Jim_SetResultFormatted(interp, "can't unset \"%#s\": no such element in array", + objPtr); + return err; + } + } + + Jim_SetResultFormatted(interp, "can't %s \"%#s\": variable isn't array", + (valObjPtr ? "set" : "unset"), objPtr); + } + return err; +} + +static Jim_Obj *JimDictExpandArrayVariable(Jim_Interp *interp, Jim_Obj *varObjPtr, + Jim_Obj *keyObjPtr, int flags) +{ + Jim_Obj *dictObjPtr; + Jim_Obj *resObjPtr = NULL; + int ret; + + dictObjPtr = Jim_GetVariable(interp, varObjPtr, JIM_ERRMSG); + if (!dictObjPtr) { + return NULL; + } + + ret = Jim_DictKey(interp, dictObjPtr, keyObjPtr, &resObjPtr, JIM_NONE); + if (ret != JIM_OK) { + Jim_SetResultFormatted(interp, + "can't read \"%#s(%#s)\": %s array", varObjPtr, keyObjPtr, + ret < 0 ? "variable isn't" : "no such element in"); + } + else if ((flags & JIM_UNSHARED) && Jim_IsShared(dictObjPtr)) { + + Jim_SetVariable(interp, varObjPtr, Jim_DuplicateObj(interp, dictObjPtr)); + } + + return resObjPtr; +} + + +static Jim_Obj *JimDictSugarGet(Jim_Interp *interp, Jim_Obj *objPtr, int flags) +{ + SetDictSubstFromAny(interp, objPtr); + + return JimDictExpandArrayVariable(interp, + objPtr->internalRep.dictSubstValue.varNameObjPtr, + objPtr->internalRep.dictSubstValue.indexObjPtr, flags); +} + + + +void FreeDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr); + Jim_DecrRefCount(interp, objPtr->internalRep.dictSubstValue.indexObjPtr); +} + +void DupDictSubstInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + JIM_NOTUSED(interp); + + dupPtr->internalRep.dictSubstValue.varNameObjPtr = + srcPtr->internalRep.dictSubstValue.varNameObjPtr; + dupPtr->internalRep.dictSubstValue.indexObjPtr = srcPtr->internalRep.dictSubstValue.indexObjPtr; + dupPtr->typePtr = &dictSubstObjType; +} + + +static void SetDictSubstFromAny(Jim_Interp *interp, Jim_Obj *objPtr) +{ + if (objPtr->typePtr != &dictSubstObjType) { + Jim_Obj *varObjPtr, *keyObjPtr; + + if (objPtr->typePtr == &interpolatedObjType) { + + + varObjPtr = objPtr->internalRep.dictSubstValue.varNameObjPtr; + keyObjPtr = objPtr->internalRep.dictSubstValue.indexObjPtr; + + Jim_IncrRefCount(varObjPtr); + Jim_IncrRefCount(keyObjPtr); + } + else { + JimDictSugarParseVarKey(interp, objPtr, &varObjPtr, &keyObjPtr); + } + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &dictSubstObjType; + objPtr->internalRep.dictSubstValue.varNameObjPtr = varObjPtr; + objPtr->internalRep.dictSubstValue.indexObjPtr = keyObjPtr; + } +} + +static Jim_Obj *JimExpandDictSugar(Jim_Interp *interp, Jim_Obj *objPtr) +{ + Jim_Obj *resObjPtr = NULL; + Jim_Obj *substKeyObjPtr = NULL; + + SetDictSubstFromAny(interp, objPtr); + + if (Jim_SubstObj(interp, objPtr->internalRep.dictSubstValue.indexObjPtr, + &substKeyObjPtr, JIM_NONE) + != JIM_OK) { + return NULL; + } + Jim_IncrRefCount(substKeyObjPtr); + resObjPtr = + JimDictExpandArrayVariable(interp, objPtr->internalRep.dictSubstValue.varNameObjPtr, + substKeyObjPtr, 0); + Jim_DecrRefCount(interp, substKeyObjPtr); + + return resObjPtr; +} + +static Jim_Obj *JimExpandExprSugar(Jim_Interp *interp, Jim_Obj *objPtr) +{ + Jim_Obj *resultObjPtr; + + if (Jim_EvalExpression(interp, objPtr, &resultObjPtr) == JIM_OK) { + + resultObjPtr->refCount--; + return resultObjPtr; + } + return NULL; +} + + +static Jim_CallFrame *JimCreateCallFrame(Jim_Interp *interp, Jim_CallFrame *parent, Jim_Obj *nsObj) +{ + Jim_CallFrame *cf; + + if (interp->freeFramesList) { + cf = interp->freeFramesList; + interp->freeFramesList = cf->next; + + cf->argv = NULL; + cf->argc = 0; + cf->procArgsObjPtr = NULL; + cf->procBodyObjPtr = NULL; + cf->next = NULL; + cf->staticVars = NULL; + cf->localCommands = NULL; + cf->tailcallObj = NULL; + cf->tailcallCmd = NULL; + } + else { + cf = Jim_Alloc(sizeof(*cf)); + memset(cf, 0, sizeof(*cf)); + + Jim_InitHashTable(&cf->vars, &JimVariablesHashTableType, interp); + } + + cf->id = interp->callFrameEpoch++; + cf->parent = parent; + cf->level = parent ? parent->level + 1 : 0; + cf->nsObj = nsObj; + Jim_IncrRefCount(nsObj); + + return cf; +} + +static int JimDeleteLocalProcs(Jim_Interp *interp, Jim_Stack *localCommands) +{ + + if (localCommands) { + Jim_Obj *cmdNameObj; + + while ((cmdNameObj = Jim_StackPop(localCommands)) != NULL) { + Jim_HashEntry *he; + Jim_Obj *fqObjName; + Jim_HashTable *ht = &interp->commands; + + const char *fqname = JimQualifyName(interp, Jim_String(cmdNameObj), &fqObjName); + + he = Jim_FindHashEntry(ht, fqname); + + if (he) { + Jim_Cmd *cmd = Jim_GetHashEntryVal(he); + if (cmd->prevCmd) { + Jim_Cmd *prevCmd = cmd->prevCmd; + cmd->prevCmd = NULL; + + + JimDecrCmdRefCount(interp, cmd); + + + Jim_SetHashVal(ht, he, prevCmd); + } + else { + Jim_DeleteHashEntry(ht, fqname); + Jim_InterpIncrProcEpoch(interp); + } + } + Jim_DecrRefCount(interp, cmdNameObj); + JimFreeQualifiedName(interp, fqObjName); + } + Jim_FreeStack(localCommands); + Jim_Free(localCommands); + } + return JIM_OK; +} + + +#define JIM_FCF_FULL 0 +#define JIM_FCF_REUSE 1 +static void JimFreeCallFrame(Jim_Interp *interp, Jim_CallFrame *cf, int action) + { + JimDeleteLocalProcs(interp, cf->localCommands); + + if (cf->procArgsObjPtr) + Jim_DecrRefCount(interp, cf->procArgsObjPtr); + if (cf->procBodyObjPtr) + Jim_DecrRefCount(interp, cf->procBodyObjPtr); + Jim_DecrRefCount(interp, cf->nsObj); + if (action == JIM_FCF_FULL || cf->vars.size != JIM_HT_INITIAL_SIZE) + Jim_FreeHashTable(&cf->vars); + else { + int i; + Jim_HashEntry **table = cf->vars.table, *he; + + for (i = 0; i < JIM_HT_INITIAL_SIZE; i++) { + he = table[i]; + while (he != NULL) { + Jim_HashEntry *nextEntry = he->next; + Jim_Var *varPtr = Jim_GetHashEntryVal(he); + + Jim_DecrRefCount(interp, varPtr->objPtr); + Jim_Free(Jim_GetHashEntryKey(he)); + Jim_Free(varPtr); + Jim_Free(he); + table[i] = NULL; + he = nextEntry; + } + } + cf->vars.used = 0; + } + cf->next = interp->freeFramesList; + interp->freeFramesList = cf; +} + + +#ifdef JIM_REFERENCES + +static void JimReferencesHTValDestructor(void *interp, void *val) +{ + Jim_Reference *refPtr = (void *)val; + + Jim_DecrRefCount(interp, refPtr->objPtr); + if (refPtr->finalizerCmdNamePtr != NULL) { + Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr); + } + Jim_Free(val); +} + +static unsigned int JimReferencesHTHashFunction(const void *key) +{ + + const unsigned long *widePtr = key; + unsigned int intValue = (unsigned int)*widePtr; + + return Jim_IntHashFunction(intValue); +} + +static void *JimReferencesHTKeyDup(void *privdata, const void *key) +{ + void *copy = Jim_Alloc(sizeof(unsigned long)); + + JIM_NOTUSED(privdata); + + memcpy(copy, key, sizeof(unsigned long)); + return copy; +} + +static int JimReferencesHTKeyCompare(void *privdata, const void *key1, const void *key2) +{ + JIM_NOTUSED(privdata); + + return memcmp(key1, key2, sizeof(unsigned long)) == 0; +} + +static void JimReferencesHTKeyDestructor(void *privdata, void *key) +{ + JIM_NOTUSED(privdata); + + Jim_Free(key); +} + +static const Jim_HashTableType JimReferencesHashTableType = { + JimReferencesHTHashFunction, + JimReferencesHTKeyDup, + NULL, + JimReferencesHTKeyCompare, + JimReferencesHTKeyDestructor, + JimReferencesHTValDestructor +}; + + + +#define JIM_REFERENCE_SPACE (35+JIM_REFERENCE_TAGLEN) + +static int JimFormatReference(char *buf, Jim_Reference *refPtr, unsigned long id) +{ + const char *fmt = ".%020lu>"; + + sprintf(buf, fmt, refPtr->tag, id); + return JIM_REFERENCE_SPACE; +} + +static void UpdateStringOfReference(struct Jim_Obj *objPtr); + +static const Jim_ObjType referenceObjType = { + "reference", + NULL, + NULL, + UpdateStringOfReference, + JIM_TYPE_REFERENCES, +}; + +static void UpdateStringOfReference(struct Jim_Obj *objPtr) +{ + char buf[JIM_REFERENCE_SPACE + 1]; + + JimFormatReference(buf, objPtr->internalRep.refValue.refPtr, objPtr->internalRep.refValue.id); + JimSetStringBytes(objPtr, buf); +} + +static int isrefchar(int c) +{ + return (c == '_' || isalnum(c)); +} + +static int SetReferenceFromAny(Jim_Interp *interp, Jim_Obj *objPtr) +{ + unsigned long value; + int i, len; + const char *str, *start, *end; + char refId[21]; + Jim_Reference *refPtr; + Jim_HashEntry *he; + char *endptr; + + + str = Jim_GetString(objPtr, &len); + + if (len < JIM_REFERENCE_SPACE) + goto badformat; + + start = str; + end = str + len - 1; + while (*start == ' ') + start++; + while (*end == ' ' && end > start) + end--; + if (end - start + 1 != JIM_REFERENCE_SPACE) + goto badformat; + + if (memcmp(start, "references, &value); + if (he == NULL) { + Jim_SetResultFormatted(interp, "invalid reference id \"%#s\"", objPtr); + return JIM_ERR; + } + refPtr = Jim_GetHashEntryVal(he); + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &referenceObjType; + objPtr->internalRep.refValue.id = value; + objPtr->internalRep.refValue.refPtr = refPtr; + return JIM_OK; + + badformat: + Jim_SetResultFormatted(interp, "expected reference but got \"%#s\"", objPtr); + return JIM_ERR; +} + +Jim_Obj *Jim_NewReference(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *tagPtr, Jim_Obj *cmdNamePtr) +{ + struct Jim_Reference *refPtr; + unsigned long id; + Jim_Obj *refObjPtr; + const char *tag; + int tagLen, i; + + + Jim_CollectIfNeeded(interp); + + refPtr = Jim_Alloc(sizeof(*refPtr)); + refPtr->objPtr = objPtr; + Jim_IncrRefCount(objPtr); + refPtr->finalizerCmdNamePtr = cmdNamePtr; + if (cmdNamePtr) + Jim_IncrRefCount(cmdNamePtr); + id = interp->referenceNextId++; + Jim_AddHashEntry(&interp->references, &id, refPtr); + refObjPtr = Jim_NewObj(interp); + refObjPtr->typePtr = &referenceObjType; + refObjPtr->bytes = NULL; + refObjPtr->internalRep.refValue.id = id; + refObjPtr->internalRep.refValue.refPtr = refPtr; + interp->referenceNextId++; + tag = Jim_GetString(tagPtr, &tagLen); + if (tagLen > JIM_REFERENCE_TAGLEN) + tagLen = JIM_REFERENCE_TAGLEN; + for (i = 0; i < JIM_REFERENCE_TAGLEN; i++) { + if (i < tagLen && isrefchar(tag[i])) + refPtr->tag[i] = tag[i]; + else + refPtr->tag[i] = '_'; + } + refPtr->tag[JIM_REFERENCE_TAGLEN] = '\0'; + return refObjPtr; +} + +Jim_Reference *Jim_GetReference(Jim_Interp *interp, Jim_Obj *objPtr) +{ + if (objPtr->typePtr != &referenceObjType && SetReferenceFromAny(interp, objPtr) == JIM_ERR) + return NULL; + return objPtr->internalRep.refValue.refPtr; +} + +int Jim_SetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *cmdNamePtr) +{ + Jim_Reference *refPtr; + + if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL) + return JIM_ERR; + Jim_IncrRefCount(cmdNamePtr); + if (refPtr->finalizerCmdNamePtr) + Jim_DecrRefCount(interp, refPtr->finalizerCmdNamePtr); + refPtr->finalizerCmdNamePtr = cmdNamePtr; + return JIM_OK; +} + +int Jim_GetFinalizer(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj **cmdNamePtrPtr) +{ + Jim_Reference *refPtr; + + if ((refPtr = Jim_GetReference(interp, objPtr)) == NULL) + return JIM_ERR; + *cmdNamePtrPtr = refPtr->finalizerCmdNamePtr; + return JIM_OK; +} + + + +static const Jim_HashTableType JimRefMarkHashTableType = { + JimReferencesHTHashFunction, + JimReferencesHTKeyDup, + NULL, + JimReferencesHTKeyCompare, + JimReferencesHTKeyDestructor, + NULL +}; + + +int Jim_Collect(Jim_Interp *interp) +{ + int collected = 0; + return collected; +} + +#define JIM_COLLECT_ID_PERIOD 5000 +#define JIM_COLLECT_TIME_PERIOD 300 + +void Jim_CollectIfNeeded(Jim_Interp *interp) +{ + unsigned long elapsedId; + int elapsedTime; + + elapsedId = interp->referenceNextId - interp->lastCollectId; + elapsedTime = time(NULL) - interp->lastCollectTime; + + + if (elapsedId > JIM_COLLECT_ID_PERIOD || elapsedTime > JIM_COLLECT_TIME_PERIOD) { + Jim_Collect(interp); + } +} +#endif + +int Jim_IsBigEndian(void) +{ + union { + unsigned short s; + unsigned char c[2]; + } uval = {0x0102}; + + return uval.c[0] == 1; +} + + +Jim_Interp *Jim_CreateInterp(void) +{ + Jim_Interp *i = Jim_Alloc(sizeof(*i)); + + memset(i, 0, sizeof(*i)); + + i->maxCallFrameDepth = JIM_MAX_CALLFRAME_DEPTH; + i->maxEvalDepth = JIM_MAX_EVAL_DEPTH; + i->lastCollectTime = time(NULL); + + Jim_InitHashTable(&i->commands, &JimCommandsHashTableType, i); +#ifdef JIM_REFERENCES + Jim_InitHashTable(&i->references, &JimReferencesHashTableType, i); +#endif + Jim_InitHashTable(&i->assocData, &JimAssocDataHashTableType, i); + Jim_InitHashTable(&i->packages, &JimPackageHashTableType, NULL); + i->emptyObj = Jim_NewEmptyStringObj(i); + i->trueObj = Jim_NewIntObj(i, 1); + i->falseObj = Jim_NewIntObj(i, 0); + i->framePtr = i->topFramePtr = JimCreateCallFrame(i, NULL, i->emptyObj); + i->errorFileNameObj = i->emptyObj; + i->result = i->emptyObj; + i->stackTrace = Jim_NewListObj(i, NULL, 0); + i->unknown = Jim_NewStringObj(i, "unknown", -1); + i->errorProc = i->emptyObj; + i->currentScriptObj = Jim_NewEmptyStringObj(i); + i->nullScriptObj = Jim_NewEmptyStringObj(i); + Jim_IncrRefCount(i->emptyObj); + Jim_IncrRefCount(i->errorFileNameObj); + Jim_IncrRefCount(i->result); + Jim_IncrRefCount(i->stackTrace); + Jim_IncrRefCount(i->unknown); + Jim_IncrRefCount(i->currentScriptObj); + Jim_IncrRefCount(i->nullScriptObj); + Jim_IncrRefCount(i->errorProc); + Jim_IncrRefCount(i->trueObj); + Jim_IncrRefCount(i->falseObj); + + + Jim_SetVariableStrWithStr(i, JIM_LIBPATH, TCL_LIBRARY); + Jim_SetVariableStrWithStr(i, JIM_INTERACTIVE, "0"); + + Jim_SetVariableStrWithStr(i, "tcl_platform(engine)", "Jim"); + Jim_SetVariableStrWithStr(i, "tcl_platform(os)", TCL_PLATFORM_OS); + Jim_SetVariableStrWithStr(i, "tcl_platform(platform)", TCL_PLATFORM_PLATFORM); + Jim_SetVariableStrWithStr(i, "tcl_platform(pathSeparator)", TCL_PLATFORM_PATH_SEPARATOR); + Jim_SetVariableStrWithStr(i, "tcl_platform(byteOrder)", Jim_IsBigEndian() ? "bigEndian" : "littleEndian"); + Jim_SetVariableStrWithStr(i, "tcl_platform(threaded)", "0"); + Jim_SetVariableStr(i, "tcl_platform(pointerSize)", Jim_NewIntObj(i, sizeof(void *))); + Jim_SetVariableStr(i, "tcl_platform(wordSize)", Jim_NewIntObj(i, sizeof(jim_wide))); + + return i; +} + +void Jim_FreeInterp(Jim_Interp *i) +{ + Jim_CallFrame *cf, *cfx; + + Jim_Obj *objPtr, *nextObjPtr; + + + for (cf = i->framePtr; cf; cf = cfx) { + cfx = cf->parent; + JimFreeCallFrame(i, cf, JIM_FCF_FULL); + } + + Jim_DecrRefCount(i, i->emptyObj); + Jim_DecrRefCount(i, i->trueObj); + Jim_DecrRefCount(i, i->falseObj); + Jim_DecrRefCount(i, i->result); + Jim_DecrRefCount(i, i->stackTrace); + Jim_DecrRefCount(i, i->errorProc); + Jim_DecrRefCount(i, i->unknown); + Jim_DecrRefCount(i, i->errorFileNameObj); + Jim_DecrRefCount(i, i->currentScriptObj); + Jim_DecrRefCount(i, i->nullScriptObj); + Jim_FreeHashTable(&i->commands); +#ifdef JIM_REFERENCES + Jim_FreeHashTable(&i->references); +#endif + Jim_FreeHashTable(&i->packages); + Jim_Free(i->prngState); + Jim_FreeHashTable(&i->assocData); + +#ifdef JIM_MAINTAINER + if (i->liveList != NULL) { + objPtr = i->liveList; + + printf("\n-------------------------------------\n"); + printf("Objects still in the free list:\n"); + while (objPtr) { + const char *type = objPtr->typePtr ? objPtr->typePtr->name : "string"; + + if (objPtr->bytes && strlen(objPtr->bytes) > 20) { + printf("%p (%d) %-10s: '%.20s...'\n", + (void *)objPtr, objPtr->refCount, type, objPtr->bytes); + } + else { + printf("%p (%d) %-10s: '%s'\n", + (void *)objPtr, objPtr->refCount, type, objPtr->bytes ? objPtr->bytes : "(null)"); + } + if (objPtr->typePtr == &sourceObjType) { + printf("FILE %s LINE %d\n", + Jim_String(objPtr->internalRep.sourceValue.fileNameObj), + objPtr->internalRep.sourceValue.lineNumber); + } + objPtr = objPtr->nextObjPtr; + } + printf("-------------------------------------\n\n"); + JimPanic((1, "Live list non empty freeing the interpreter! Leak?")); + } +#endif + + + objPtr = i->freeList; + while (objPtr) { + nextObjPtr = objPtr->nextObjPtr; + Jim_Free(objPtr); + objPtr = nextObjPtr; + } + + + for (cf = i->freeFramesList; cf; cf = cfx) { + cfx = cf->next; + if (cf->vars.table) + Jim_FreeHashTable(&cf->vars); + Jim_Free(cf); + } + + + Jim_Free(i); +} + +Jim_CallFrame *Jim_GetCallFrameByLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr) +{ + long level; + const char *str; + Jim_CallFrame *framePtr; + + if (levelObjPtr) { + str = Jim_String(levelObjPtr); + if (str[0] == '#') { + char *endptr; + + level = jim_strtol(str + 1, &endptr); + if (str[1] == '\0' || endptr[0] != '\0') { + level = -1; + } + } + else { + if (Jim_GetLong(interp, levelObjPtr, &level) != JIM_OK || level < 0) { + level = -1; + } + else { + + level = interp->framePtr->level - level; + } + } + } + else { + str = "1"; + level = interp->framePtr->level - 1; + } + + if (level == 0) { + return interp->topFramePtr; + } + if (level > 0) { + + for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) { + if (framePtr->level == level) { + return framePtr; + } + } + } + + Jim_SetResultFormatted(interp, "bad level \"%s\"", str); + return NULL; +} + +static Jim_CallFrame *JimGetCallFrameByInteger(Jim_Interp *interp, Jim_Obj *levelObjPtr) +{ + long level; + Jim_CallFrame *framePtr; + + if (Jim_GetLong(interp, levelObjPtr, &level) == JIM_OK) { + if (level <= 0) { + + level = interp->framePtr->level + level; + } + + if (level == 0) { + return interp->topFramePtr; + } + + + for (framePtr = interp->framePtr; framePtr; framePtr = framePtr->parent) { + if (framePtr->level == level) { + return framePtr; + } + } + } + + Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr); + return NULL; +} + +static void JimResetStackTrace(Jim_Interp *interp) +{ + Jim_DecrRefCount(interp, interp->stackTrace); + interp->stackTrace = Jim_NewListObj(interp, NULL, 0); + Jim_IncrRefCount(interp->stackTrace); +} + +static void JimSetStackTrace(Jim_Interp *interp, Jim_Obj *stackTraceObj) +{ + int len; + + + Jim_IncrRefCount(stackTraceObj); + Jim_DecrRefCount(interp, interp->stackTrace); + interp->stackTrace = stackTraceObj; + interp->errorFlag = 1; + + len = Jim_ListLength(interp, interp->stackTrace); + if (len >= 3) { + if (Jim_Length(Jim_ListGetIndex(interp, interp->stackTrace, len - 2)) == 0) { + interp->addStackTrace = 1; + } + } +} + +static void JimAppendStackTrace(Jim_Interp *interp, const char *procname, + Jim_Obj *fileNameObj, int linenr) +{ + if (strcmp(procname, "unknown") == 0) { + procname = ""; + } + if (!*procname && !Jim_Length(fileNameObj)) { + + return; + } + + if (Jim_IsShared(interp->stackTrace)) { + Jim_DecrRefCount(interp, interp->stackTrace); + interp->stackTrace = Jim_DuplicateObj(interp, interp->stackTrace); + Jim_IncrRefCount(interp->stackTrace); + } + + + if (!*procname && Jim_Length(fileNameObj)) { + + int len = Jim_ListLength(interp, interp->stackTrace); + + if (len >= 3) { + Jim_Obj *objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 3); + if (Jim_Length(objPtr)) { + + objPtr = Jim_ListGetIndex(interp, interp->stackTrace, len - 2); + if (Jim_Length(objPtr) == 0) { + + ListSetIndex(interp, interp->stackTrace, len - 2, fileNameObj, 0); + ListSetIndex(interp, interp->stackTrace, len - 1, Jim_NewIntObj(interp, linenr), 0); + return; + } + } + } + } + + Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewStringObj(interp, procname, -1)); + Jim_ListAppendElement(interp, interp->stackTrace, fileNameObj); + Jim_ListAppendElement(interp, interp->stackTrace, Jim_NewIntObj(interp, linenr)); +} + +int Jim_SetAssocData(Jim_Interp *interp, const char *key, Jim_InterpDeleteProc * delProc, + void *data) +{ + AssocDataValue *assocEntryPtr = (AssocDataValue *) Jim_Alloc(sizeof(AssocDataValue)); + + assocEntryPtr->delProc = delProc; + assocEntryPtr->data = data; + return Jim_AddHashEntry(&interp->assocData, key, assocEntryPtr); +} + +void *Jim_GetAssocData(Jim_Interp *interp, const char *key) +{ + Jim_HashEntry *entryPtr = Jim_FindHashEntry(&interp->assocData, key); + + if (entryPtr != NULL) { + AssocDataValue *assocEntryPtr = Jim_GetHashEntryVal(entryPtr); + return assocEntryPtr->data; + } + return NULL; +} + +int Jim_DeleteAssocData(Jim_Interp *interp, const char *key) +{ + return Jim_DeleteHashEntry(&interp->assocData, key); +} + +int Jim_GetExitCode(Jim_Interp *interp) +{ + return interp->exitCode; +} + +static void UpdateStringOfInt(struct Jim_Obj *objPtr); +static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags); + +static const Jim_ObjType intObjType = { + "int", + NULL, + NULL, + UpdateStringOfInt, + JIM_TYPE_NONE, +}; + +static const Jim_ObjType coercedDoubleObjType = { + "coerced-double", + NULL, + NULL, + UpdateStringOfInt, + JIM_TYPE_NONE, +}; + + +static void UpdateStringOfInt(struct Jim_Obj *objPtr) +{ + char buf[JIM_INTEGER_SPACE + 1]; + jim_wide wideValue = JimWideValue(objPtr); + int pos = 0; + + if (wideValue == 0) { + buf[pos++] = '0'; + } + else { + char tmp[JIM_INTEGER_SPACE]; + int num = 0; + int i; + + if (wideValue < 0) { + buf[pos++] = '-'; + i = wideValue % 10; + tmp[num++] = (i > 0) ? (10 - i) : -i; + wideValue /= -10; + } + + while (wideValue) { + tmp[num++] = wideValue % 10; + wideValue /= 10; + } + + for (i = 0; i < num; i++) { + buf[pos++] = '0' + tmp[num - i - 1]; + } + } + buf[pos] = 0; + + JimSetStringBytes(objPtr, buf); +} + +static int SetIntFromAny(Jim_Interp *interp, Jim_Obj *objPtr, int flags) +{ + jim_wide wideValue; + const char *str; + + if (objPtr->typePtr == &coercedDoubleObjType) { + + objPtr->typePtr = &intObjType; + return JIM_OK; + } + + + str = Jim_String(objPtr); + + if (Jim_StringToWide(str, &wideValue, 0) != JIM_OK) { + if (flags & JIM_ERRMSG) { + Jim_SetResultFormatted(interp, "expected integer but got \"%#s\"", objPtr); + } + return JIM_ERR; + } + if ((wideValue == JIM_WIDE_MIN || wideValue == JIM_WIDE_MAX) && errno == ERANGE) { + Jim_SetResultString(interp, "Integer value too big to be represented", -1); + return JIM_ERR; + } + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &intObjType; + objPtr->internalRep.wideValue = wideValue; + return JIM_OK; +} + +#ifdef JIM_OPTIMIZATION +static int JimIsWide(Jim_Obj *objPtr) +{ + return objPtr->typePtr == &intObjType; +} +#endif + +int Jim_GetWide(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr) +{ + if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_ERRMSG) == JIM_ERR) + return JIM_ERR; + *widePtr = JimWideValue(objPtr); + return JIM_OK; +} + + +static int JimGetWideNoErr(Jim_Interp *interp, Jim_Obj *objPtr, jim_wide * widePtr) +{ + if (objPtr->typePtr != &intObjType && SetIntFromAny(interp, objPtr, JIM_NONE) == JIM_ERR) + return JIM_ERR; + *widePtr = JimWideValue(objPtr); + return JIM_OK; +} + +int Jim_GetLong(Jim_Interp *interp, Jim_Obj *objPtr, long *longPtr) +{ + jim_wide wideValue; + int retval; + + retval = Jim_GetWide(interp, objPtr, &wideValue); + if (retval == JIM_OK) { + *longPtr = (long)wideValue; + return JIM_OK; + } + return JIM_ERR; +} + +Jim_Obj *Jim_NewIntObj(Jim_Interp *interp, jim_wide wideValue) +{ + Jim_Obj *objPtr; + + objPtr = Jim_NewObj(interp); + objPtr->typePtr = &intObjType; + objPtr->bytes = NULL; + objPtr->internalRep.wideValue = wideValue; + return objPtr; +} + +#define JIM_DOUBLE_SPACE 30 + +static void UpdateStringOfDouble(struct Jim_Obj *objPtr); +static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr); + +static const Jim_ObjType doubleObjType = { + "double", + NULL, + NULL, + UpdateStringOfDouble, + JIM_TYPE_NONE, +}; + +#ifndef HAVE_ISNAN +#undef isnan +#define isnan(X) ((X) != (X)) +#endif +#ifndef HAVE_ISINF +#undef isinf +#define isinf(X) (1.0 / (X) == 0.0) +#endif + +static void UpdateStringOfDouble(struct Jim_Obj *objPtr) +{ + double value = objPtr->internalRep.doubleValue; + + if (isnan(value)) { + JimSetStringBytes(objPtr, "NaN"); + return; + } + if (isinf(value)) { + if (value < 0) { + JimSetStringBytes(objPtr, "-Inf"); + } + else { + JimSetStringBytes(objPtr, "Inf"); + } + return; + } + { + char buf[JIM_DOUBLE_SPACE + 1]; + int i; + int len = sprintf(buf, "%.12g", value); + + + for (i = 0; i < len; i++) { + if (buf[i] == '.' || buf[i] == 'e') { +#if defined(JIM_SPRINTF_DOUBLE_NEEDS_FIX) + char *e = strchr(buf, 'e'); + if (e && (e[1] == '-' || e[1] == '+') && e[2] == '0') { + + e += 2; + memmove(e, e + 1, len - (e - buf)); + } +#endif + break; + } + } + if (buf[i] == '\0') { + buf[i++] = '.'; + buf[i++] = '0'; + buf[i] = '\0'; + } + JimSetStringBytes(objPtr, buf); + } +} + +static int SetDoubleFromAny(Jim_Interp *interp, Jim_Obj *objPtr) +{ + double doubleValue; + jim_wide wideValue; + const char *str; + + str = Jim_String(objPtr); + +#ifdef HAVE_LONG_LONG + +#define MIN_INT_IN_DOUBLE -(1LL << 53) +#define MAX_INT_IN_DOUBLE -(MIN_INT_IN_DOUBLE + 1) + + if (objPtr->typePtr == &intObjType + && JimWideValue(objPtr) >= MIN_INT_IN_DOUBLE + && JimWideValue(objPtr) <= MAX_INT_IN_DOUBLE) { + + + objPtr->typePtr = &coercedDoubleObjType; + return JIM_OK; + } + else +#endif + if (Jim_StringToWide(str, &wideValue, 10) == JIM_OK) { + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &coercedDoubleObjType; + objPtr->internalRep.wideValue = wideValue; + return JIM_OK; + } + else { + + if (Jim_StringToDouble(str, &doubleValue) != JIM_OK) { + Jim_SetResultFormatted(interp, "expected floating-point number but got \"%#s\"", objPtr); + return JIM_ERR; + } + + Jim_FreeIntRep(interp, objPtr); + } + objPtr->typePtr = &doubleObjType; + objPtr->internalRep.doubleValue = doubleValue; + return JIM_OK; +} + +int Jim_GetDouble(Jim_Interp *interp, Jim_Obj *objPtr, double *doublePtr) +{ + if (objPtr->typePtr == &coercedDoubleObjType) { + *doublePtr = JimWideValue(objPtr); + return JIM_OK; + } + if (objPtr->typePtr != &doubleObjType && SetDoubleFromAny(interp, objPtr) == JIM_ERR) + return JIM_ERR; + + if (objPtr->typePtr == &coercedDoubleObjType) { + *doublePtr = JimWideValue(objPtr); + } + else { + *doublePtr = objPtr->internalRep.doubleValue; + } + return JIM_OK; +} + +Jim_Obj *Jim_NewDoubleObj(Jim_Interp *interp, double doubleValue) +{ + Jim_Obj *objPtr; + + objPtr = Jim_NewObj(interp); + objPtr->typePtr = &doubleObjType; + objPtr->bytes = NULL; + objPtr->internalRep.doubleValue = doubleValue; + return objPtr; +} + +static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec); +static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr); +static void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr); +static void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); +static void UpdateStringOfList(struct Jim_Obj *objPtr); +static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); + +static const Jim_ObjType listObjType = { + "list", + FreeListInternalRep, + DupListInternalRep, + UpdateStringOfList, + JIM_TYPE_NONE, +}; + +void FreeListInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + int i; + + for (i = 0; i < objPtr->internalRep.listValue.len; i++) { + Jim_DecrRefCount(interp, objPtr->internalRep.listValue.ele[i]); + } + Jim_Free(objPtr->internalRep.listValue.ele); +} + +void DupListInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + int i; + + JIM_NOTUSED(interp); + + dupPtr->internalRep.listValue.len = srcPtr->internalRep.listValue.len; + dupPtr->internalRep.listValue.maxLen = srcPtr->internalRep.listValue.maxLen; + dupPtr->internalRep.listValue.ele = + Jim_Alloc(sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.maxLen); + memcpy(dupPtr->internalRep.listValue.ele, srcPtr->internalRep.listValue.ele, + sizeof(Jim_Obj *) * srcPtr->internalRep.listValue.len); + for (i = 0; i < dupPtr->internalRep.listValue.len; i++) { + Jim_IncrRefCount(dupPtr->internalRep.listValue.ele[i]); + } + dupPtr->typePtr = &listObjType; +} + +#define JIM_ELESTR_SIMPLE 0 +#define JIM_ELESTR_BRACE 1 +#define JIM_ELESTR_QUOTE 2 +static unsigned char ListElementQuotingType(const char *s, int len) +{ + int i, level, blevel, trySimple = 1; + + + if (len == 0) + return JIM_ELESTR_BRACE; + if (s[0] == '"' || s[0] == '{') { + trySimple = 0; + goto testbrace; + } + for (i = 0; i < len; i++) { + switch (s[i]) { + case ' ': + case '$': + case '"': + case '[': + case ']': + case ';': + case '\\': + case '\r': + case '\n': + case '\t': + case '\f': + case '\v': + trySimple = 0; + + case '{': + case '}': + goto testbrace; + } + } + return JIM_ELESTR_SIMPLE; + + testbrace: + + if (s[len - 1] == '\\') + return JIM_ELESTR_QUOTE; + level = 0; + blevel = 0; + for (i = 0; i < len; i++) { + switch (s[i]) { + case '{': + level++; + break; + case '}': + level--; + if (level < 0) + return JIM_ELESTR_QUOTE; + break; + case '[': + blevel++; + break; + case ']': + blevel--; + break; + case '\\': + if (s[i + 1] == '\n') + return JIM_ELESTR_QUOTE; + else if (s[i + 1] != '\0') + i++; + break; + } + } + if (blevel < 0) { + return JIM_ELESTR_QUOTE; + } + + if (level == 0) { + if (!trySimple) + return JIM_ELESTR_BRACE; + for (i = 0; i < len; i++) { + switch (s[i]) { + case ' ': + case '$': + case '"': + case '[': + case ']': + case ';': + case '\\': + case '\r': + case '\n': + case '\t': + case '\f': + case '\v': + return JIM_ELESTR_BRACE; + break; + } + } + return JIM_ELESTR_SIMPLE; + } + return JIM_ELESTR_QUOTE; +} + +static int BackslashQuoteString(const char *s, int len, char *q) +{ + char *p = q; + + while (len--) { + switch (*s) { + case ' ': + case '$': + case '"': + case '[': + case ']': + case '{': + case '}': + case ';': + case '\\': + *p++ = '\\'; + *p++ = *s++; + break; + case '\n': + *p++ = '\\'; + *p++ = 'n'; + s++; + break; + case '\r': + *p++ = '\\'; + *p++ = 'r'; + s++; + break; + case '\t': + *p++ = '\\'; + *p++ = 't'; + s++; + break; + case '\f': + *p++ = '\\'; + *p++ = 'f'; + s++; + break; + case '\v': + *p++ = '\\'; + *p++ = 'v'; + s++; + break; + default: + *p++ = *s++; + break; + } + } + *p = '\0'; + + return p - q; +} + +static void JimMakeListStringRep(Jim_Obj *objPtr, Jim_Obj **objv, int objc) +{ + #define STATIC_QUOTING_LEN 32 + int i, bufLen, realLength; + const char *strRep; + char *p; + unsigned char *quotingType, staticQuoting[STATIC_QUOTING_LEN]; + + + if (objc > STATIC_QUOTING_LEN) { + quotingType = Jim_Alloc(objc); + } + else { + quotingType = staticQuoting; + } + bufLen = 0; + for (i = 0; i < objc; i++) { + int len; + + strRep = Jim_GetString(objv[i], &len); + quotingType[i] = ListElementQuotingType(strRep, len); + switch (quotingType[i]) { + case JIM_ELESTR_SIMPLE: + if (i != 0 || strRep[0] != '#') { + bufLen += len; + break; + } + + quotingType[i] = JIM_ELESTR_BRACE; + + case JIM_ELESTR_BRACE: + bufLen += len + 2; + break; + case JIM_ELESTR_QUOTE: + bufLen += len * 2; + break; + } + bufLen++; + } + bufLen++; + + + p = objPtr->bytes = Jim_Alloc(bufLen + 1); + realLength = 0; + for (i = 0; i < objc; i++) { + int len, qlen; + + strRep = Jim_GetString(objv[i], &len); + + switch (quotingType[i]) { + case JIM_ELESTR_SIMPLE: + memcpy(p, strRep, len); + p += len; + realLength += len; + break; + case JIM_ELESTR_BRACE: + *p++ = '{'; + memcpy(p, strRep, len); + p += len; + *p++ = '}'; + realLength += len + 2; + break; + case JIM_ELESTR_QUOTE: + if (i == 0 && strRep[0] == '#') { + *p++ = '\\'; + realLength++; + } + qlen = BackslashQuoteString(strRep, len, p); + p += qlen; + realLength += qlen; + break; + } + + if (i + 1 != objc) { + *p++ = ' '; + realLength++; + } + } + *p = '\0'; + objPtr->length = realLength; + + if (quotingType != staticQuoting) { + Jim_Free(quotingType); + } +} + +static void UpdateStringOfList(struct Jim_Obj *objPtr) +{ + JimMakeListStringRep(objPtr, objPtr->internalRep.listValue.ele, objPtr->internalRep.listValue.len); +} + +static int SetListFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) +{ + struct JimParserCtx parser; + const char *str; + int strLen; + Jim_Obj *fileNameObj; + int linenr; + + if (objPtr->typePtr == &listObjType) { + return JIM_OK; + } + + if (Jim_IsDict(objPtr) && objPtr->bytes == NULL) { + Jim_Obj **listObjPtrPtr; + int len; + int i; + + listObjPtrPtr = JimDictPairs(objPtr, &len); + for (i = 0; i < len; i++) { + Jim_IncrRefCount(listObjPtrPtr[i]); + } + + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &listObjType; + objPtr->internalRep.listValue.len = len; + objPtr->internalRep.listValue.maxLen = len; + objPtr->internalRep.listValue.ele = listObjPtrPtr; + + return JIM_OK; + } + + + if (objPtr->typePtr == &sourceObjType) { + fileNameObj = objPtr->internalRep.sourceValue.fileNameObj; + linenr = objPtr->internalRep.sourceValue.lineNumber; + } + else { + fileNameObj = interp->emptyObj; + linenr = 1; + } + Jim_IncrRefCount(fileNameObj); + + + str = Jim_GetString(objPtr, &strLen); + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &listObjType; + objPtr->internalRep.listValue.len = 0; + objPtr->internalRep.listValue.maxLen = 0; + objPtr->internalRep.listValue.ele = NULL; + + + if (strLen) { + JimParserInit(&parser, str, strLen, linenr); + while (!parser.eof) { + Jim_Obj *elementPtr; + + JimParseList(&parser); + if (parser.tt != JIM_TT_STR && parser.tt != JIM_TT_ESC) + continue; + elementPtr = JimParserGetTokenObj(interp, &parser); + JimSetSourceInfo(interp, elementPtr, fileNameObj, parser.tline); + ListAppendElement(objPtr, elementPtr); + } + } + Jim_DecrRefCount(interp, fileNameObj); + return JIM_OK; +} + +Jim_Obj *Jim_NewListObj(Jim_Interp *interp, Jim_Obj *const *elements, int len) +{ + Jim_Obj *objPtr; + + objPtr = Jim_NewObj(interp); + objPtr->typePtr = &listObjType; + objPtr->bytes = NULL; + objPtr->internalRep.listValue.ele = NULL; + objPtr->internalRep.listValue.len = 0; + objPtr->internalRep.listValue.maxLen = 0; + + if (len) { + ListInsertElements(objPtr, 0, len, elements); + } + + return objPtr; +} + +static void JimListGetElements(Jim_Interp *interp, Jim_Obj *listObj, int *listLen, + Jim_Obj ***listVec) +{ + *listLen = Jim_ListLength(interp, listObj); + *listVec = listObj->internalRep.listValue.ele; +} + + +static int JimSign(jim_wide w) +{ + if (w == 0) { + return 0; + } + else if (w < 0) { + return -1; + } + return 1; +} + + +struct lsort_info { + jmp_buf jmpbuf; + Jim_Obj *command; + Jim_Interp *interp; + enum { + JIM_LSORT_ASCII, + JIM_LSORT_NOCASE, + JIM_LSORT_INTEGER, + JIM_LSORT_REAL, + JIM_LSORT_COMMAND + } type; + int order; + int index; + int indexed; + int unique; + int (*subfn)(Jim_Obj **, Jim_Obj **); +}; + +static struct lsort_info *sort_info; + +static int ListSortIndexHelper(Jim_Obj **lhsObj, Jim_Obj **rhsObj) +{ + Jim_Obj *lObj, *rObj; + + if (Jim_ListIndex(sort_info->interp, *lhsObj, sort_info->index, &lObj, JIM_ERRMSG) != JIM_OK || + Jim_ListIndex(sort_info->interp, *rhsObj, sort_info->index, &rObj, JIM_ERRMSG) != JIM_OK) { + longjmp(sort_info->jmpbuf, JIM_ERR); + } + return sort_info->subfn(&lObj, &rObj); +} + + +static int ListSortString(Jim_Obj **lhsObj, Jim_Obj **rhsObj) +{ + return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 0) * sort_info->order; +} + +static int ListSortStringNoCase(Jim_Obj **lhsObj, Jim_Obj **rhsObj) +{ + return Jim_StringCompareObj(sort_info->interp, *lhsObj, *rhsObj, 1) * sort_info->order; +} + +static int ListSortInteger(Jim_Obj **lhsObj, Jim_Obj **rhsObj) +{ + jim_wide lhs = 0, rhs = 0; + + if (Jim_GetWide(sort_info->interp, *lhsObj, &lhs) != JIM_OK || + Jim_GetWide(sort_info->interp, *rhsObj, &rhs) != JIM_OK) { + longjmp(sort_info->jmpbuf, JIM_ERR); + } + + return JimSign(lhs - rhs) * sort_info->order; +} + +static int ListSortReal(Jim_Obj **lhsObj, Jim_Obj **rhsObj) +{ + double lhs = 0, rhs = 0; + + if (Jim_GetDouble(sort_info->interp, *lhsObj, &lhs) != JIM_OK || + Jim_GetDouble(sort_info->interp, *rhsObj, &rhs) != JIM_OK) { + longjmp(sort_info->jmpbuf, JIM_ERR); + } + if (lhs == rhs) { + return 0; + } + if (lhs > rhs) { + return sort_info->order; + } + return -sort_info->order; +} + +static int ListSortCommand(Jim_Obj **lhsObj, Jim_Obj **rhsObj) +{ + Jim_Obj *compare_script; + int rc; + + jim_wide ret = 0; + + + compare_script = Jim_DuplicateObj(sort_info->interp, sort_info->command); + Jim_ListAppendElement(sort_info->interp, compare_script, *lhsObj); + Jim_ListAppendElement(sort_info->interp, compare_script, *rhsObj); + + rc = Jim_EvalObj(sort_info->interp, compare_script); + + if (rc != JIM_OK || Jim_GetWide(sort_info->interp, Jim_GetResult(sort_info->interp), &ret) != JIM_OK) { + longjmp(sort_info->jmpbuf, rc); + } + + return JimSign(ret) * sort_info->order; +} + +static void ListRemoveDuplicates(Jim_Obj *listObjPtr, int (*comp)(Jim_Obj **lhs, Jim_Obj **rhs)) +{ + int src; + int dst = 0; + Jim_Obj **ele = listObjPtr->internalRep.listValue.ele; + + for (src = 1; src < listObjPtr->internalRep.listValue.len; src++) { + if (comp(&ele[dst], &ele[src]) == 0) { + + Jim_DecrRefCount(sort_info->interp, ele[dst]); + } + else { + + dst++; + } + ele[dst] = ele[src]; + } + + ele[++dst] = ele[src]; + + + listObjPtr->internalRep.listValue.len = dst; +} + + +static int ListSortElements(Jim_Interp *interp, Jim_Obj *listObjPtr, struct lsort_info *info) +{ + struct lsort_info *prev_info; + + typedef int (qsort_comparator) (const void *, const void *); + int (*fn) (Jim_Obj **, Jim_Obj **); + Jim_Obj **vector; + int len; + int rc; + + JimPanic((Jim_IsShared(listObjPtr), "ListSortElements called with shared object")); + SetListFromAny(interp, listObjPtr); + + + prev_info = sort_info; + sort_info = info; + + vector = listObjPtr->internalRep.listValue.ele; + len = listObjPtr->internalRep.listValue.len; + switch (info->type) { + case JIM_LSORT_ASCII: + fn = ListSortString; + break; + case JIM_LSORT_NOCASE: + fn = ListSortStringNoCase; + break; + case JIM_LSORT_INTEGER: + fn = ListSortInteger; + break; + case JIM_LSORT_REAL: + fn = ListSortReal; + break; + case JIM_LSORT_COMMAND: + fn = ListSortCommand; + break; + default: + fn = NULL; + JimPanic((1, "ListSort called with invalid sort type")); + return -1; + } + + if (info->indexed) { + + info->subfn = fn; + fn = ListSortIndexHelper; + } + + if ((rc = setjmp(info->jmpbuf)) == 0) { + qsort(vector, len, sizeof(Jim_Obj *), (qsort_comparator *) fn); + + if (info->unique && len > 1) { + ListRemoveDuplicates(listObjPtr, fn); + } + + Jim_InvalidateStringRep(listObjPtr); + } + sort_info = prev_info; + + return rc; +} + +static void ListInsertElements(Jim_Obj *listPtr, int idx, int elemc, Jim_Obj *const *elemVec) +{ + int currentLen = listPtr->internalRep.listValue.len; + int requiredLen = currentLen + elemc; + int i; + Jim_Obj **point; + + if (requiredLen > listPtr->internalRep.listValue.maxLen) { + if (requiredLen < 2) { + + requiredLen = 4; + } + else { + requiredLen *= 2; + } + + listPtr->internalRep.listValue.ele = Jim_Realloc(listPtr->internalRep.listValue.ele, + sizeof(Jim_Obj *) * requiredLen); + + listPtr->internalRep.listValue.maxLen = requiredLen; + } + if (idx < 0) { + idx = currentLen; + } + point = listPtr->internalRep.listValue.ele + idx; + memmove(point + elemc, point, (currentLen - idx) * sizeof(Jim_Obj *)); + for (i = 0; i < elemc; ++i) { + point[i] = elemVec[i]; + Jim_IncrRefCount(point[i]); + } + listPtr->internalRep.listValue.len += elemc; +} + +static void ListAppendElement(Jim_Obj *listPtr, Jim_Obj *objPtr) +{ + ListInsertElements(listPtr, -1, 1, &objPtr); +} + +static void ListAppendList(Jim_Obj *listPtr, Jim_Obj *appendListPtr) +{ + ListInsertElements(listPtr, -1, + appendListPtr->internalRep.listValue.len, appendListPtr->internalRep.listValue.ele); +} + +void Jim_ListAppendElement(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *objPtr) +{ + JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendElement called with shared object")); + SetListFromAny(interp, listPtr); + Jim_InvalidateStringRep(listPtr); + ListAppendElement(listPtr, objPtr); +} + +void Jim_ListAppendList(Jim_Interp *interp, Jim_Obj *listPtr, Jim_Obj *appendListPtr) +{ + JimPanic((Jim_IsShared(listPtr), "Jim_ListAppendList called with shared object")); + SetListFromAny(interp, listPtr); + SetListFromAny(interp, appendListPtr); + Jim_InvalidateStringRep(listPtr); + ListAppendList(listPtr, appendListPtr); +} + +int Jim_ListLength(Jim_Interp *interp, Jim_Obj *objPtr) +{ + SetListFromAny(interp, objPtr); + return objPtr->internalRep.listValue.len; +} + +void Jim_ListInsertElements(Jim_Interp *interp, Jim_Obj *listPtr, int idx, + int objc, Jim_Obj *const *objVec) +{ + JimPanic((Jim_IsShared(listPtr), "Jim_ListInsertElement called with shared object")); + SetListFromAny(interp, listPtr); + if (idx >= 0 && idx > listPtr->internalRep.listValue.len) + idx = listPtr->internalRep.listValue.len; + else if (idx < 0) + idx = 0; + Jim_InvalidateStringRep(listPtr); + ListInsertElements(listPtr, idx, objc, objVec); +} + +Jim_Obj *Jim_ListGetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx) +{ + SetListFromAny(interp, listPtr); + if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) || + (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) { + return NULL; + } + if (idx < 0) + idx = listPtr->internalRep.listValue.len + idx; + return listPtr->internalRep.listValue.ele[idx]; +} + +int Jim_ListIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, Jim_Obj **objPtrPtr, int flags) +{ + *objPtrPtr = Jim_ListGetIndex(interp, listPtr, idx); + if (*objPtrPtr == NULL) { + if (flags & JIM_ERRMSG) { + Jim_SetResultString(interp, "list index out of range", -1); + } + return JIM_ERR; + } + return JIM_OK; +} + +static int ListSetIndex(Jim_Interp *interp, Jim_Obj *listPtr, int idx, + Jim_Obj *newObjPtr, int flags) +{ + SetListFromAny(interp, listPtr); + if ((idx >= 0 && idx >= listPtr->internalRep.listValue.len) || + (idx < 0 && (-idx - 1) >= listPtr->internalRep.listValue.len)) { + if (flags & JIM_ERRMSG) { + Jim_SetResultString(interp, "list index out of range", -1); + } + return JIM_ERR; + } + if (idx < 0) + idx = listPtr->internalRep.listValue.len + idx; + Jim_DecrRefCount(interp, listPtr->internalRep.listValue.ele[idx]); + listPtr->internalRep.listValue.ele[idx] = newObjPtr; + Jim_IncrRefCount(newObjPtr); + return JIM_OK; +} + +int Jim_ListSetIndex(Jim_Interp *interp, Jim_Obj *varNamePtr, + Jim_Obj *const *indexv, int indexc, Jim_Obj *newObjPtr) +{ + Jim_Obj *varObjPtr, *objPtr, *listObjPtr; + int shared, i, idx; + + varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG | JIM_UNSHARED); + if (objPtr == NULL) + return JIM_ERR; + if ((shared = Jim_IsShared(objPtr))) + varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr); + for (i = 0; i < indexc - 1; i++) { + listObjPtr = objPtr; + if (Jim_GetIndex(interp, indexv[i], &idx) != JIM_OK) + goto err; + if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_ERRMSG) != JIM_OK) { + goto err; + } + if (Jim_IsShared(objPtr)) { + objPtr = Jim_DuplicateObj(interp, objPtr); + ListSetIndex(interp, listObjPtr, idx, objPtr, JIM_NONE); + } + Jim_InvalidateStringRep(listObjPtr); + } + if (Jim_GetIndex(interp, indexv[indexc - 1], &idx) != JIM_OK) + goto err; + if (ListSetIndex(interp, objPtr, idx, newObjPtr, JIM_ERRMSG) == JIM_ERR) + goto err; + Jim_InvalidateStringRep(objPtr); + Jim_InvalidateStringRep(varObjPtr); + if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) + goto err; + Jim_SetResult(interp, varObjPtr); + return JIM_OK; + err: + if (shared) { + Jim_FreeNewObj(interp, varObjPtr); + } + return JIM_ERR; +} + +Jim_Obj *Jim_ListJoin(Jim_Interp *interp, Jim_Obj *listObjPtr, const char *joinStr, int joinStrLen) +{ + int i; + int listLen = Jim_ListLength(interp, listObjPtr); + Jim_Obj *resObjPtr = Jim_NewEmptyStringObj(interp); + + for (i = 0; i < listLen; ) { + Jim_AppendObj(interp, resObjPtr, Jim_ListGetIndex(interp, listObjPtr, i)); + if (++i != listLen) { + Jim_AppendString(interp, resObjPtr, joinStr, joinStrLen); + } + } + return resObjPtr; +} + +Jim_Obj *Jim_ConcatObj(Jim_Interp *interp, int objc, Jim_Obj *const *objv) +{ + int i; + + for (i = 0; i < objc; i++) { + if (!Jim_IsList(objv[i])) + break; + } + if (i == objc) { + Jim_Obj *objPtr = Jim_NewListObj(interp, NULL, 0); + + for (i = 0; i < objc; i++) + ListAppendList(objPtr, objv[i]); + return objPtr; + } + else { + + int len = 0, objLen; + char *bytes, *p; + + + for (i = 0; i < objc; i++) { + len += Jim_Length(objv[i]); + } + if (objc) + len += objc - 1; + + p = bytes = Jim_Alloc(len + 1); + for (i = 0; i < objc; i++) { + const char *s = Jim_GetString(objv[i], &objLen); + + + while (objLen && isspace(UCHAR(*s))) { + s++; + objLen--; + len--; + } + + while (objLen && isspace(UCHAR(s[objLen - 1]))) { + + if (objLen > 1 && s[objLen - 2] == '\\') { + break; + } + objLen--; + len--; + } + memcpy(p, s, objLen); + p += objLen; + if (i + 1 != objc) { + if (objLen) + *p++ = ' '; + else { + len--; + } + } + } + *p = '\0'; + return Jim_NewStringObjNoAlloc(interp, bytes, len); + } +} + +Jim_Obj *Jim_ListRange(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *firstObjPtr, + Jim_Obj *lastObjPtr) +{ + int first, last; + int len, rangeLen; + + if (Jim_GetIndex(interp, firstObjPtr, &first) != JIM_OK || + Jim_GetIndex(interp, lastObjPtr, &last) != JIM_OK) + return NULL; + len = Jim_ListLength(interp, listObjPtr); + first = JimRelToAbsIndex(len, first); + last = JimRelToAbsIndex(len, last); + JimRelToAbsRange(len, &first, &last, &rangeLen); + if (first == 0 && last == len) { + return listObjPtr; + } + return Jim_NewListObj(interp, listObjPtr->internalRep.listValue.ele + first, rangeLen); +} + +static void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr); +static void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); +static void UpdateStringOfDict(struct Jim_Obj *objPtr); +static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); + + +static unsigned int JimObjectHTHashFunction(const void *key) +{ + int len; + const char *str = Jim_GetString((Jim_Obj *)key, &len); + return Jim_GenHashFunction((const unsigned char *)str, len); +} + +static int JimObjectHTKeyCompare(void *privdata, const void *key1, const void *key2) +{ + return Jim_StringEqObj((Jim_Obj *)key1, (Jim_Obj *)key2); +} + +static void *JimObjectHTKeyValDup(void *privdata, const void *val) +{ + Jim_IncrRefCount((Jim_Obj *)val); + return (void *)val; +} + +static void JimObjectHTKeyValDestructor(void *interp, void *val) +{ + Jim_DecrRefCount(interp, (Jim_Obj *)val); +} + +static const Jim_HashTableType JimDictHashTableType = { + JimObjectHTHashFunction, + JimObjectHTKeyValDup, + JimObjectHTKeyValDup, + JimObjectHTKeyCompare, + JimObjectHTKeyValDestructor, + JimObjectHTKeyValDestructor +}; + +static const Jim_ObjType dictObjType = { + "dict", + FreeDictInternalRep, + DupDictInternalRep, + UpdateStringOfDict, + JIM_TYPE_NONE, +}; + +void FreeDictInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + JIM_NOTUSED(interp); + + Jim_FreeHashTable(objPtr->internalRep.ptr); + Jim_Free(objPtr->internalRep.ptr); +} + +void DupDictInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + Jim_HashTable *ht, *dupHt; + Jim_HashTableIterator htiter; + Jim_HashEntry *he; + + + ht = srcPtr->internalRep.ptr; + dupHt = Jim_Alloc(sizeof(*dupHt)); + Jim_InitHashTable(dupHt, &JimDictHashTableType, interp); + if (ht->size != 0) + Jim_ExpandHashTable(dupHt, ht->size); + + JimInitHashTableIterator(ht, &htiter); + while ((he = Jim_NextHashEntry(&htiter)) != NULL) { + Jim_AddHashEntry(dupHt, he->key, he->u.val); + } + + dupPtr->internalRep.ptr = dupHt; + dupPtr->typePtr = &dictObjType; +} + +static Jim_Obj **JimDictPairs(Jim_Obj *dictPtr, int *len) +{ + Jim_HashTable *ht; + Jim_HashTableIterator htiter; + Jim_HashEntry *he; + Jim_Obj **objv; + int i; + + ht = dictPtr->internalRep.ptr; + + + objv = Jim_Alloc((ht->used * 2) * sizeof(Jim_Obj *)); + JimInitHashTableIterator(ht, &htiter); + i = 0; + while ((he = Jim_NextHashEntry(&htiter)) != NULL) { + objv[i++] = Jim_GetHashEntryKey(he); + objv[i++] = Jim_GetHashEntryVal(he); + } + *len = i; + return objv; +} + +static void UpdateStringOfDict(struct Jim_Obj *objPtr) +{ + + int len; + Jim_Obj **objv = JimDictPairs(objPtr, &len); + + + JimMakeListStringRep(objPtr, objv, len); + + Jim_Free(objv); +} + +static int SetDictFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) +{ + int listlen; + + if (objPtr->typePtr == &dictObjType) { + return JIM_OK; + } + + if (Jim_IsList(objPtr) && Jim_IsShared(objPtr)) { + Jim_String(objPtr); + } + + + listlen = Jim_ListLength(interp, objPtr); + if (listlen % 2) { + Jim_SetResultString(interp, "missing value to go with key", -1); + return JIM_ERR; + } + else { + + Jim_HashTable *ht; + int i; + + ht = Jim_Alloc(sizeof(*ht)); + Jim_InitHashTable(ht, &JimDictHashTableType, interp); + + for (i = 0; i < listlen; i += 2) { + Jim_Obj *keyObjPtr = Jim_ListGetIndex(interp, objPtr, i); + Jim_Obj *valObjPtr = Jim_ListGetIndex(interp, objPtr, i + 1); + + Jim_ReplaceHashEntry(ht, keyObjPtr, valObjPtr); + } + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &dictObjType; + objPtr->internalRep.ptr = ht; + + return JIM_OK; + } +} + + + +static int DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr) +{ + Jim_HashTable *ht = objPtr->internalRep.ptr; + + if (valueObjPtr == NULL) { + return Jim_DeleteHashEntry(ht, keyObjPtr); + } + Jim_ReplaceHashEntry(ht, keyObjPtr, valueObjPtr); + return JIM_OK; +} + +int Jim_DictAddElement(Jim_Interp *interp, Jim_Obj *objPtr, + Jim_Obj *keyObjPtr, Jim_Obj *valueObjPtr) +{ + JimPanic((Jim_IsShared(objPtr), "Jim_DictAddElement called with shared object")); + if (SetDictFromAny(interp, objPtr) != JIM_OK) { + return JIM_ERR; + } + Jim_InvalidateStringRep(objPtr); + return DictAddElement(interp, objPtr, keyObjPtr, valueObjPtr); +} + +Jim_Obj *Jim_NewDictObj(Jim_Interp *interp, Jim_Obj *const *elements, int len) +{ + Jim_Obj *objPtr; + int i; + + JimPanic((len % 2, "Jim_NewDictObj() 'len' argument must be even")); + + objPtr = Jim_NewObj(interp); + objPtr->typePtr = &dictObjType; + objPtr->bytes = NULL; + objPtr->internalRep.ptr = Jim_Alloc(sizeof(Jim_HashTable)); + Jim_InitHashTable(objPtr->internalRep.ptr, &JimDictHashTableType, interp); + for (i = 0; i < len; i += 2) + DictAddElement(interp, objPtr, elements[i], elements[i + 1]); + return objPtr; +} + +int Jim_DictKey(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj *keyPtr, + Jim_Obj **objPtrPtr, int flags) +{ + Jim_HashEntry *he; + Jim_HashTable *ht; + + if (SetDictFromAny(interp, dictPtr) != JIM_OK) { + return -1; + } + ht = dictPtr->internalRep.ptr; + if ((he = Jim_FindHashEntry(ht, keyPtr)) == NULL) { + if (flags & JIM_ERRMSG) { + Jim_SetResultFormatted(interp, "key \"%#s\" not known in dictionary", keyPtr); + } + return JIM_ERR; + } + *objPtrPtr = he->u.val; + return JIM_OK; +} + + +int Jim_DictPairs(Jim_Interp *interp, Jim_Obj *dictPtr, Jim_Obj ***objPtrPtr, int *len) +{ + if (SetDictFromAny(interp, dictPtr) != JIM_OK) { + return JIM_ERR; + } + *objPtrPtr = JimDictPairs(dictPtr, len); + + return JIM_OK; +} + + + +int Jim_DictKeysVector(Jim_Interp *interp, Jim_Obj *dictPtr, + Jim_Obj *const *keyv, int keyc, Jim_Obj **objPtrPtr, int flags) +{ + int i; + + if (keyc == 0) { + *objPtrPtr = dictPtr; + return JIM_OK; + } + + for (i = 0; i < keyc; i++) { + Jim_Obj *objPtr; + + int rc = Jim_DictKey(interp, dictPtr, keyv[i], &objPtr, flags); + if (rc != JIM_OK) { + return rc; + } + dictPtr = objPtr; + } + *objPtrPtr = dictPtr; + return JIM_OK; +} + +int Jim_SetDictKeysVector(Jim_Interp *interp, Jim_Obj *varNamePtr, + Jim_Obj *const *keyv, int keyc, Jim_Obj *newObjPtr, int flags) +{ + Jim_Obj *varObjPtr, *objPtr, *dictObjPtr; + int shared, i; + + varObjPtr = objPtr = Jim_GetVariable(interp, varNamePtr, flags); + if (objPtr == NULL) { + if (newObjPtr == NULL && (flags & JIM_MUSTEXIST)) { + + return JIM_ERR; + } + varObjPtr = objPtr = Jim_NewDictObj(interp, NULL, 0); + if (Jim_SetVariable(interp, varNamePtr, objPtr) != JIM_OK) { + Jim_FreeNewObj(interp, varObjPtr); + return JIM_ERR; + } + } + if ((shared = Jim_IsShared(objPtr))) + varObjPtr = objPtr = Jim_DuplicateObj(interp, objPtr); + for (i = 0; i < keyc; i++) { + dictObjPtr = objPtr; + + + if (SetDictFromAny(interp, dictObjPtr) != JIM_OK) { + goto err; + } + + if (i == keyc - 1) { + + if (Jim_DictAddElement(interp, objPtr, keyv[keyc - 1], newObjPtr) != JIM_OK) { + if (newObjPtr || (flags & JIM_MUSTEXIST)) { + goto err; + } + } + break; + } + + + Jim_InvalidateStringRep(dictObjPtr); + if (Jim_DictKey(interp, dictObjPtr, keyv[i], &objPtr, + newObjPtr ? JIM_NONE : JIM_ERRMSG) == JIM_OK) { + if (Jim_IsShared(objPtr)) { + objPtr = Jim_DuplicateObj(interp, objPtr); + DictAddElement(interp, dictObjPtr, keyv[i], objPtr); + } + } + else { + if (newObjPtr == NULL) { + goto err; + } + objPtr = Jim_NewDictObj(interp, NULL, 0); + DictAddElement(interp, dictObjPtr, keyv[i], objPtr); + } + } + + Jim_InvalidateStringRep(objPtr); + Jim_InvalidateStringRep(varObjPtr); + if (Jim_SetVariable(interp, varNamePtr, varObjPtr) != JIM_OK) { + goto err; + } + Jim_SetResult(interp, varObjPtr); + return JIM_OK; + err: + if (shared) { + Jim_FreeNewObj(interp, varObjPtr); + } + return JIM_ERR; +} + +static void UpdateStringOfIndex(struct Jim_Obj *objPtr); +static int SetIndexFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); + +static const Jim_ObjType indexObjType = { + "index", + NULL, + NULL, + UpdateStringOfIndex, + JIM_TYPE_NONE, +}; + +static void UpdateStringOfIndex(struct Jim_Obj *objPtr) +{ + if (objPtr->internalRep.intValue == -1) { + JimSetStringBytes(objPtr, "end"); + } + else { + char buf[JIM_INTEGER_SPACE + 1]; + if (objPtr->internalRep.intValue >= 0) { + sprintf(buf, "%d", objPtr->internalRep.intValue); + } + else { + + sprintf(buf, "end%d", objPtr->internalRep.intValue + 1); + } + JimSetStringBytes(objPtr, buf); + } +} + +static int SetIndexFromAny(Jim_Interp *interp, Jim_Obj *objPtr) +{ + int idx, end = 0; + const char *str; + char *endptr; + + + str = Jim_String(objPtr); + + + if (strncmp(str, "end", 3) == 0) { + end = 1; + str += 3; + idx = 0; + } + else { + idx = jim_strtol(str, &endptr); + + if (endptr == str) { + goto badindex; + } + str = endptr; + } + + + if (*str == '+' || *str == '-') { + int sign = (*str == '+' ? 1 : -1); + + idx += sign * jim_strtol(++str, &endptr); + if (str == endptr || *endptr) { + goto badindex; + } + str = endptr; + } + + while (isspace(UCHAR(*str))) { + str++; + } + if (*str) { + goto badindex; + } + if (end) { + if (idx > 0) { + idx = INT_MAX; + } + else { + + idx--; + } + } + else if (idx < 0) { + idx = -INT_MAX; + } + + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &indexObjType; + objPtr->internalRep.intValue = idx; + return JIM_OK; + + badindex: + Jim_SetResultFormatted(interp, + "bad index \"%#s\": must be integer?[+-]integer? or end?[+-]integer?", objPtr); + return JIM_ERR; +} + +int Jim_GetIndex(Jim_Interp *interp, Jim_Obj *objPtr, int *indexPtr) +{ + + if (objPtr->typePtr == &intObjType) { + jim_wide val = JimWideValue(objPtr); + + if (val < 0) + *indexPtr = -INT_MAX; + else if (val > INT_MAX) + *indexPtr = INT_MAX; + else + *indexPtr = (int)val; + return JIM_OK; + } + if (objPtr->typePtr != &indexObjType && SetIndexFromAny(interp, objPtr) == JIM_ERR) + return JIM_ERR; + *indexPtr = objPtr->internalRep.intValue; + return JIM_OK; +} + + + +static const char * const jimReturnCodes[] = { + "ok", + "error", + "return", + "break", + "continue", + "signal", + "exit", + "eval", + NULL +}; + +#define jimReturnCodesSize (sizeof(jimReturnCodes)/sizeof(*jimReturnCodes)) + +static const Jim_ObjType returnCodeObjType = { + "return-code", + NULL, + NULL, + NULL, + JIM_TYPE_NONE, +}; + +const char *Jim_ReturnCode(int code) +{ + if (code < 0 || code >= (int)jimReturnCodesSize) { + return "?"; + } + else { + return jimReturnCodes[code]; + } +} + +static int SetReturnCodeFromAny(Jim_Interp *interp, Jim_Obj *objPtr) +{ + int returnCode; + jim_wide wideValue; + + + if (JimGetWideNoErr(interp, objPtr, &wideValue) != JIM_ERR) + returnCode = (int)wideValue; + else if (Jim_GetEnum(interp, objPtr, jimReturnCodes, &returnCode, NULL, JIM_NONE) != JIM_OK) { + Jim_SetResultFormatted(interp, "expected return code but got \"%#s\"", objPtr); + return JIM_ERR; + } + + Jim_FreeIntRep(interp, objPtr); + objPtr->typePtr = &returnCodeObjType; + objPtr->internalRep.intValue = returnCode; + return JIM_OK; +} + +int Jim_GetReturnCode(Jim_Interp *interp, Jim_Obj *objPtr, int *intPtr) +{ + if (objPtr->typePtr != &returnCodeObjType && SetReturnCodeFromAny(interp, objPtr) == JIM_ERR) + return JIM_ERR; + *intPtr = objPtr->internalRep.intValue; + return JIM_OK; +} + +static int JimParseExprOperator(struct JimParserCtx *pc); +static int JimParseExprNumber(struct JimParserCtx *pc); +static int JimParseExprIrrational(struct JimParserCtx *pc); + + + + +enum +{ + + + JIM_EXPROP_MUL = JIM_TT_EXPR_OP, + JIM_EXPROP_DIV, + JIM_EXPROP_MOD, + JIM_EXPROP_SUB, + JIM_EXPROP_ADD, + JIM_EXPROP_LSHIFT, + JIM_EXPROP_RSHIFT, + JIM_EXPROP_ROTL, + JIM_EXPROP_ROTR, + JIM_EXPROP_LT, + JIM_EXPROP_GT, + JIM_EXPROP_LTE, + JIM_EXPROP_GTE, + JIM_EXPROP_NUMEQ, + JIM_EXPROP_NUMNE, + JIM_EXPROP_BITAND, + JIM_EXPROP_BITXOR, + JIM_EXPROP_BITOR, + + + JIM_EXPROP_LOGICAND, + JIM_EXPROP_LOGICAND_LEFT, + JIM_EXPROP_LOGICAND_RIGHT, + + + JIM_EXPROP_LOGICOR, + JIM_EXPROP_LOGICOR_LEFT, + JIM_EXPROP_LOGICOR_RIGHT, + + + + JIM_EXPROP_TERNARY, + JIM_EXPROP_TERNARY_LEFT, + JIM_EXPROP_TERNARY_RIGHT, + + + JIM_EXPROP_COLON, + JIM_EXPROP_COLON_LEFT, + JIM_EXPROP_COLON_RIGHT, + + JIM_EXPROP_POW, + + + JIM_EXPROP_STREQ, + JIM_EXPROP_STRNE, + JIM_EXPROP_STRIN, + JIM_EXPROP_STRNI, + + + JIM_EXPROP_NOT, + JIM_EXPROP_BITNOT, + JIM_EXPROP_UNARYMINUS, + JIM_EXPROP_UNARYPLUS, + + + JIM_EXPROP_FUNC_FIRST, + JIM_EXPROP_FUNC_INT = JIM_EXPROP_FUNC_FIRST, + JIM_EXPROP_FUNC_WIDE, + JIM_EXPROP_FUNC_ABS, + JIM_EXPROP_FUNC_DOUBLE, + JIM_EXPROP_FUNC_ROUND, + JIM_EXPROP_FUNC_RAND, + JIM_EXPROP_FUNC_SRAND, + + + JIM_EXPROP_FUNC_SIN, + JIM_EXPROP_FUNC_COS, + JIM_EXPROP_FUNC_TAN, + JIM_EXPROP_FUNC_ASIN, + JIM_EXPROP_FUNC_ACOS, + JIM_EXPROP_FUNC_ATAN, + JIM_EXPROP_FUNC_SINH, + JIM_EXPROP_FUNC_COSH, + JIM_EXPROP_FUNC_TANH, + JIM_EXPROP_FUNC_CEIL, + JIM_EXPROP_FUNC_FLOOR, + JIM_EXPROP_FUNC_EXP, + JIM_EXPROP_FUNC_LOG, + JIM_EXPROP_FUNC_LOG10, + JIM_EXPROP_FUNC_SQRT, + JIM_EXPROP_FUNC_POW, +}; + +struct JimExprState +{ + Jim_Obj **stack; + int stacklen; + int opcode; + int skip; +}; + + +typedef struct Jim_ExprOperator +{ + const char *name; + int (*funcop) (Jim_Interp *interp, struct JimExprState * e); + unsigned char precedence; + unsigned char arity; + unsigned char lazy; + unsigned char namelen; +} Jim_ExprOperator; + +static void ExprPush(struct JimExprState *e, Jim_Obj *obj) +{ + Jim_IncrRefCount(obj); + e->stack[e->stacklen++] = obj; +} + +static Jim_Obj *ExprPop(struct JimExprState *e) +{ + return e->stack[--e->stacklen]; +} + +static int JimExprOpNumUnary(Jim_Interp *interp, struct JimExprState *e) +{ + int intresult = 1; + int rc = JIM_OK; + Jim_Obj *A = ExprPop(e); + double dA, dC = 0; + jim_wide wA, wC = 0; + + if ((A->typePtr != &doubleObjType || A->bytes) && JimGetWideNoErr(interp, A, &wA) == JIM_OK) { + switch (e->opcode) { + case JIM_EXPROP_FUNC_INT: + case JIM_EXPROP_FUNC_WIDE: + case JIM_EXPROP_FUNC_ROUND: + case JIM_EXPROP_UNARYPLUS: + wC = wA; + break; + case JIM_EXPROP_FUNC_DOUBLE: + dC = wA; + intresult = 0; + break; + case JIM_EXPROP_FUNC_ABS: + wC = wA >= 0 ? wA : -wA; + break; + case JIM_EXPROP_UNARYMINUS: + wC = -wA; + break; + case JIM_EXPROP_NOT: + wC = !wA; + break; + default: + abort(); + } + } + else if ((rc = Jim_GetDouble(interp, A, &dA)) == JIM_OK) { + switch (e->opcode) { + case JIM_EXPROP_FUNC_INT: + case JIM_EXPROP_FUNC_WIDE: + wC = dA; + break; + case JIM_EXPROP_FUNC_ROUND: + wC = dA < 0 ? (dA - 0.5) : (dA + 0.5); + break; + case JIM_EXPROP_FUNC_DOUBLE: + case JIM_EXPROP_UNARYPLUS: + dC = dA; + intresult = 0; + break; + case JIM_EXPROP_FUNC_ABS: + dC = dA >= 0 ? dA : -dA; + intresult = 0; + break; + case JIM_EXPROP_UNARYMINUS: + dC = -dA; + intresult = 0; + break; + case JIM_EXPROP_NOT: + wC = !dA; + break; + default: + abort(); + } + } + + if (rc == JIM_OK) { + if (intresult) { + ExprPush(e, Jim_NewIntObj(interp, wC)); + } + else { + ExprPush(e, Jim_NewDoubleObj(interp, dC)); + } + } + + Jim_DecrRefCount(interp, A); + + return rc; +} + +static double JimRandDouble(Jim_Interp *interp) +{ + unsigned long x; + JimRandomBytes(interp, &x, sizeof(x)); + + return (double)x / (unsigned long)~0; +} + +static int JimExprOpIntUnary(Jim_Interp *interp, struct JimExprState *e) +{ + Jim_Obj *A = ExprPop(e); + jim_wide wA; + + int rc = Jim_GetWide(interp, A, &wA); + if (rc == JIM_OK) { + switch (e->opcode) { + case JIM_EXPROP_BITNOT: + ExprPush(e, Jim_NewIntObj(interp, ~wA)); + break; + case JIM_EXPROP_FUNC_SRAND: + JimPrngSeed(interp, (unsigned char *)&wA, sizeof(wA)); + ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp))); + break; + default: + abort(); + } + } + + Jim_DecrRefCount(interp, A); + + return rc; +} + +static int JimExprOpNone(Jim_Interp *interp, struct JimExprState *e) +{ + JimPanic((e->opcode != JIM_EXPROP_FUNC_RAND, "JimExprOpNone only support rand()")); + + ExprPush(e, Jim_NewDoubleObj(interp, JimRandDouble(interp))); + + return JIM_OK; +} + +#ifdef JIM_MATH_FUNCTIONS +static int JimExprOpDoubleUnary(Jim_Interp *interp, struct JimExprState *e) +{ + int rc; + Jim_Obj *A = ExprPop(e); + double dA, dC; + + rc = Jim_GetDouble(interp, A, &dA); + if (rc == JIM_OK) { + switch (e->opcode) { + case JIM_EXPROP_FUNC_SIN: + dC = sin(dA); + break; + case JIM_EXPROP_FUNC_COS: + dC = cos(dA); + break; + case JIM_EXPROP_FUNC_TAN: + dC = tan(dA); + break; + case JIM_EXPROP_FUNC_ASIN: + dC = asin(dA); + break; + case JIM_EXPROP_FUNC_ACOS: + dC = acos(dA); + break; + case JIM_EXPROP_FUNC_ATAN: + dC = atan(dA); + break; + case JIM_EXPROP_FUNC_SINH: + dC = sinh(dA); + break; + case JIM_EXPROP_FUNC_COSH: + dC = cosh(dA); + break; + case JIM_EXPROP_FUNC_TANH: + dC = tanh(dA); + break; + case JIM_EXPROP_FUNC_CEIL: + dC = ceil(dA); + break; + case JIM_EXPROP_FUNC_FLOOR: + dC = floor(dA); + break; + case JIM_EXPROP_FUNC_EXP: + dC = exp(dA); + break; + case JIM_EXPROP_FUNC_LOG: + dC = log(dA); + break; + case JIM_EXPROP_FUNC_LOG10: + dC = log10(dA); + break; + case JIM_EXPROP_FUNC_SQRT: + dC = sqrt(dA); + break; + default: + abort(); + } + ExprPush(e, Jim_NewDoubleObj(interp, dC)); + } + + Jim_DecrRefCount(interp, A); + + return rc; +} +#endif + + +static int JimExprOpIntBin(Jim_Interp *interp, struct JimExprState *e) +{ + Jim_Obj *B = ExprPop(e); + Jim_Obj *A = ExprPop(e); + jim_wide wA, wB; + int rc = JIM_ERR; + + if (Jim_GetWide(interp, A, &wA) == JIM_OK && Jim_GetWide(interp, B, &wB) == JIM_OK) { + jim_wide wC; + + rc = JIM_OK; + + switch (e->opcode) { + case JIM_EXPROP_LSHIFT: + wC = wA << wB; + break; + case JIM_EXPROP_RSHIFT: + wC = wA >> wB; + break; + case JIM_EXPROP_BITAND: + wC = wA & wB; + break; + case JIM_EXPROP_BITXOR: + wC = wA ^ wB; + break; + case JIM_EXPROP_BITOR: + wC = wA | wB; + break; + case JIM_EXPROP_MOD: + if (wB == 0) { + wC = 0; + Jim_SetResultString(interp, "Division by zero", -1); + rc = JIM_ERR; + } + else { + int negative = 0; + + if (wB < 0) { + wB = -wB; + wA = -wA; + negative = 1; + } + wC = wA % wB; + if (wC < 0) { + wC += wB; + } + if (negative) { + wC = -wC; + } + } + break; + case JIM_EXPROP_ROTL: + case JIM_EXPROP_ROTR:{ + + unsigned long uA = (unsigned long)wA; + unsigned long uB = (unsigned long)wB; + const unsigned int S = sizeof(unsigned long) * 8; + + + uB %= S; + + if (e->opcode == JIM_EXPROP_ROTR) { + uB = S - uB; + } + wC = (unsigned long)(uA << uB) | (uA >> (S - uB)); + break; + } + default: + abort(); + } + ExprPush(e, Jim_NewIntObj(interp, wC)); + + } + + Jim_DecrRefCount(interp, A); + Jim_DecrRefCount(interp, B); + + return rc; +} + + + +static int JimExprOpBin(Jim_Interp *interp, struct JimExprState *e) +{ + int intresult = 1; + int rc = JIM_OK; + double dA, dB, dC = 0; + jim_wide wA, wB, wC = 0; + + Jim_Obj *B = ExprPop(e); + Jim_Obj *A = ExprPop(e); + + if ((A->typePtr != &doubleObjType || A->bytes) && + (B->typePtr != &doubleObjType || B->bytes) && + JimGetWideNoErr(interp, A, &wA) == JIM_OK && JimGetWideNoErr(interp, B, &wB) == JIM_OK) { + + + + switch (e->opcode) { + case JIM_EXPROP_POW: + case JIM_EXPROP_FUNC_POW: + wC = JimPowWide(wA, wB); + break; + case JIM_EXPROP_ADD: + wC = wA + wB; + break; + case JIM_EXPROP_SUB: + wC = wA - wB; + break; + case JIM_EXPROP_MUL: + wC = wA * wB; + break; + case JIM_EXPROP_DIV: + if (wB == 0) { + Jim_SetResultString(interp, "Division by zero", -1); + rc = JIM_ERR; + } + else { + if (wB < 0) { + wB = -wB; + wA = -wA; + } + wC = wA / wB; + if (wA % wB < 0) { + wC--; + } + } + break; + case JIM_EXPROP_LT: + wC = wA < wB; + break; + case JIM_EXPROP_GT: + wC = wA > wB; + break; + case JIM_EXPROP_LTE: + wC = wA <= wB; + break; + case JIM_EXPROP_GTE: + wC = wA >= wB; + break; + case JIM_EXPROP_NUMEQ: + wC = wA == wB; + break; + case JIM_EXPROP_NUMNE: + wC = wA != wB; + break; + default: + abort(); + } + } + else if (Jim_GetDouble(interp, A, &dA) == JIM_OK && Jim_GetDouble(interp, B, &dB) == JIM_OK) { + intresult = 0; + switch (e->opcode) { + case JIM_EXPROP_POW: + case JIM_EXPROP_FUNC_POW: +#ifdef JIM_MATH_FUNCTIONS + dC = pow(dA, dB); +#else + Jim_SetResultString(interp, "unsupported", -1); + rc = JIM_ERR; +#endif + break; + case JIM_EXPROP_ADD: + dC = dA + dB; + break; + case JIM_EXPROP_SUB: + dC = dA - dB; + break; + case JIM_EXPROP_MUL: + dC = dA * dB; + break; + case JIM_EXPROP_DIV: + if (dB == 0) { +#ifdef INFINITY + dC = dA < 0 ? -INFINITY : INFINITY; +#else + dC = (dA < 0 ? -1.0 : 1.0) * strtod("Inf", NULL); +#endif + } + else { + dC = dA / dB; + } + break; + case JIM_EXPROP_LT: + wC = dA < dB; + intresult = 1; + break; + case JIM_EXPROP_GT: + wC = dA > dB; + intresult = 1; + break; + case JIM_EXPROP_LTE: + wC = dA <= dB; + intresult = 1; + break; + case JIM_EXPROP_GTE: + wC = dA >= dB; + intresult = 1; + break; + case JIM_EXPROP_NUMEQ: + wC = dA == dB; + intresult = 1; + break; + case JIM_EXPROP_NUMNE: + wC = dA != dB; + intresult = 1; + break; + default: + abort(); + } + } + else { + + + + int i = Jim_StringCompareObj(interp, A, B, 0); + + switch (e->opcode) { + case JIM_EXPROP_LT: + wC = i < 0; + break; + case JIM_EXPROP_GT: + wC = i > 0; + break; + case JIM_EXPROP_LTE: + wC = i <= 0; + break; + case JIM_EXPROP_GTE: + wC = i >= 0; + break; + case JIM_EXPROP_NUMEQ: + wC = i == 0; + break; + case JIM_EXPROP_NUMNE: + wC = i != 0; + break; + default: + rc = JIM_ERR; + break; + } + } + + if (rc == JIM_OK) { + if (intresult) { + ExprPush(e, Jim_NewIntObj(interp, wC)); + } + else { + ExprPush(e, Jim_NewDoubleObj(interp, dC)); + } + } + + Jim_DecrRefCount(interp, A); + Jim_DecrRefCount(interp, B); + + return rc; +} + +static int JimSearchList(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_Obj *valObj) +{ + int listlen; + int i; + + listlen = Jim_ListLength(interp, listObjPtr); + for (i = 0; i < listlen; i++) { + if (Jim_StringEqObj(Jim_ListGetIndex(interp, listObjPtr, i), valObj)) { + return 1; + } + } + return 0; +} + +static int JimExprOpStrBin(Jim_Interp *interp, struct JimExprState *e) +{ + Jim_Obj *B = ExprPop(e); + Jim_Obj *A = ExprPop(e); + + jim_wide wC; + + switch (e->opcode) { + case JIM_EXPROP_STREQ: + case JIM_EXPROP_STRNE: + wC = Jim_StringEqObj(A, B); + if (e->opcode == JIM_EXPROP_STRNE) { + wC = !wC; + } + break; + case JIM_EXPROP_STRIN: + wC = JimSearchList(interp, B, A); + break; + case JIM_EXPROP_STRNI: + wC = !JimSearchList(interp, B, A); + break; + default: + abort(); + } + ExprPush(e, Jim_NewIntObj(interp, wC)); + + Jim_DecrRefCount(interp, A); + Jim_DecrRefCount(interp, B); + + return JIM_OK; +} + +static int ExprBool(Jim_Interp *interp, Jim_Obj *obj) +{ + long l; + double d; + + if (Jim_GetLong(interp, obj, &l) == JIM_OK) { + return l != 0; + } + if (Jim_GetDouble(interp, obj, &d) == JIM_OK) { + return d != 0; + } + return -1; +} + +static int JimExprOpAndLeft(Jim_Interp *interp, struct JimExprState *e) +{ + Jim_Obj *skip = ExprPop(e); + Jim_Obj *A = ExprPop(e); + int rc = JIM_OK; + + switch (ExprBool(interp, A)) { + case 0: + + e->skip = JimWideValue(skip); + ExprPush(e, Jim_NewIntObj(interp, 0)); + break; + + case 1: + + break; + + case -1: + + rc = JIM_ERR; + } + Jim_DecrRefCount(interp, A); + Jim_DecrRefCount(interp, skip); + + return rc; +} + +static int JimExprOpOrLeft(Jim_Interp *interp, struct JimExprState *e) +{ + Jim_Obj *skip = ExprPop(e); + Jim_Obj *A = ExprPop(e); + int rc = JIM_OK; + + switch (ExprBool(interp, A)) { + case 0: + + break; + + case 1: + + e->skip = JimWideValue(skip); + ExprPush(e, Jim_NewIntObj(interp, 1)); + break; + + case -1: + + rc = JIM_ERR; + break; + } + Jim_DecrRefCount(interp, A); + Jim_DecrRefCount(interp, skip); + + return rc; +} + +static int JimExprOpAndOrRight(Jim_Interp *interp, struct JimExprState *e) +{ + Jim_Obj *A = ExprPop(e); + int rc = JIM_OK; + + switch (ExprBool(interp, A)) { + case 0: + ExprPush(e, Jim_NewIntObj(interp, 0)); + break; + + case 1: + ExprPush(e, Jim_NewIntObj(interp, 1)); + break; + + case -1: + + rc = JIM_ERR; + break; + } + Jim_DecrRefCount(interp, A); + + return rc; +} + +static int JimExprOpTernaryLeft(Jim_Interp *interp, struct JimExprState *e) +{ + Jim_Obj *skip = ExprPop(e); + Jim_Obj *A = ExprPop(e); + int rc = JIM_OK; + + + ExprPush(e, A); + + switch (ExprBool(interp, A)) { + case 0: + + e->skip = JimWideValue(skip); + + ExprPush(e, Jim_NewIntObj(interp, 0)); + break; + + case 1: + + break; + + case -1: + + rc = JIM_ERR; + break; + } + Jim_DecrRefCount(interp, A); + Jim_DecrRefCount(interp, skip); + + return rc; +} + +static int JimExprOpColonLeft(Jim_Interp *interp, struct JimExprState *e) +{ + Jim_Obj *skip = ExprPop(e); + Jim_Obj *B = ExprPop(e); + Jim_Obj *A = ExprPop(e); + + + if (ExprBool(interp, A)) { + + e->skip = JimWideValue(skip); + + ExprPush(e, B); + } + + Jim_DecrRefCount(interp, skip); + Jim_DecrRefCount(interp, A); + Jim_DecrRefCount(interp, B); + return JIM_OK; +} + +static int JimExprOpNull(Jim_Interp *interp, struct JimExprState *e) +{ + return JIM_OK; +} + +enum +{ + LAZY_NONE, + LAZY_OP, + LAZY_LEFT, + LAZY_RIGHT +}; + +#define OPRINIT(N, P, A, F) {N, F, P, A, LAZY_NONE, sizeof(N) - 1} +#define OPRINIT_LAZY(N, P, A, F, L) {N, F, P, A, L, sizeof(N) - 1} + +static const struct Jim_ExprOperator Jim_ExprOperators[] = { + OPRINIT("*", 110, 2, JimExprOpBin), + OPRINIT("/", 110, 2, JimExprOpBin), + OPRINIT("%", 110, 2, JimExprOpIntBin), + + OPRINIT("-", 100, 2, JimExprOpBin), + OPRINIT("+", 100, 2, JimExprOpBin), + + OPRINIT("<<", 90, 2, JimExprOpIntBin), + OPRINIT(">>", 90, 2, JimExprOpIntBin), + + OPRINIT("<<<", 90, 2, JimExprOpIntBin), + OPRINIT(">>>", 90, 2, JimExprOpIntBin), + + OPRINIT("<", 80, 2, JimExprOpBin), + OPRINIT(">", 80, 2, JimExprOpBin), + OPRINIT("<=", 80, 2, JimExprOpBin), + OPRINIT(">=", 80, 2, JimExprOpBin), + + OPRINIT("==", 70, 2, JimExprOpBin), + OPRINIT("!=", 70, 2, JimExprOpBin), + + OPRINIT("&", 50, 2, JimExprOpIntBin), + OPRINIT("^", 49, 2, JimExprOpIntBin), + OPRINIT("|", 48, 2, JimExprOpIntBin), + + OPRINIT_LAZY("&&", 10, 2, NULL, LAZY_OP), + OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndLeft, LAZY_LEFT), + OPRINIT_LAZY(NULL, 10, 2, JimExprOpAndOrRight, LAZY_RIGHT), + + OPRINIT_LAZY("||", 9, 2, NULL, LAZY_OP), + OPRINIT_LAZY(NULL, 9, 2, JimExprOpOrLeft, LAZY_LEFT), + OPRINIT_LAZY(NULL, 9, 2, JimExprOpAndOrRight, LAZY_RIGHT), + + OPRINIT_LAZY("?", 5, 2, JimExprOpNull, LAZY_OP), + OPRINIT_LAZY(NULL, 5, 2, JimExprOpTernaryLeft, LAZY_LEFT), + OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT), + + OPRINIT_LAZY(":", 5, 2, JimExprOpNull, LAZY_OP), + OPRINIT_LAZY(NULL, 5, 2, JimExprOpColonLeft, LAZY_LEFT), + OPRINIT_LAZY(NULL, 5, 2, JimExprOpNull, LAZY_RIGHT), + + OPRINIT("**", 250, 2, JimExprOpBin), + + OPRINIT("eq", 60, 2, JimExprOpStrBin), + OPRINIT("ne", 60, 2, JimExprOpStrBin), + + OPRINIT("in", 55, 2, JimExprOpStrBin), + OPRINIT("ni", 55, 2, JimExprOpStrBin), + + OPRINIT("!", 150, 1, JimExprOpNumUnary), + OPRINIT("~", 150, 1, JimExprOpIntUnary), + OPRINIT(NULL, 150, 1, JimExprOpNumUnary), + OPRINIT(NULL, 150, 1, JimExprOpNumUnary), + + + + OPRINIT("int", 200, 1, JimExprOpNumUnary), + OPRINIT("wide", 200, 1, JimExprOpNumUnary), + OPRINIT("abs", 200, 1, JimExprOpNumUnary), + OPRINIT("double", 200, 1, JimExprOpNumUnary), + OPRINIT("round", 200, 1, JimExprOpNumUnary), + OPRINIT("rand", 200, 0, JimExprOpNone), + OPRINIT("srand", 200, 1, JimExprOpIntUnary), + +#ifdef JIM_MATH_FUNCTIONS + OPRINIT("sin", 200, 1, JimExprOpDoubleUnary), + OPRINIT("cos", 200, 1, JimExprOpDoubleUnary), + OPRINIT("tan", 200, 1, JimExprOpDoubleUnary), + OPRINIT("asin", 200, 1, JimExprOpDoubleUnary), + OPRINIT("acos", 200, 1, JimExprOpDoubleUnary), + OPRINIT("atan", 200, 1, JimExprOpDoubleUnary), + OPRINIT("sinh", 200, 1, JimExprOpDoubleUnary), + OPRINIT("cosh", 200, 1, JimExprOpDoubleUnary), + OPRINIT("tanh", 200, 1, JimExprOpDoubleUnary), + OPRINIT("ceil", 200, 1, JimExprOpDoubleUnary), + OPRINIT("floor", 200, 1, JimExprOpDoubleUnary), + OPRINIT("exp", 200, 1, JimExprOpDoubleUnary), + OPRINIT("log", 200, 1, JimExprOpDoubleUnary), + OPRINIT("log10", 200, 1, JimExprOpDoubleUnary), + OPRINIT("sqrt", 200, 1, JimExprOpDoubleUnary), + OPRINIT("pow", 200, 2, JimExprOpBin), +#endif +}; +#undef OPRINIT +#undef OPRINIT_LAZY + +#define JIM_EXPR_OPERATORS_NUM \ + (sizeof(Jim_ExprOperators)/sizeof(struct Jim_ExprOperator)) + +static int JimParseExpression(struct JimParserCtx *pc) +{ + + while (isspace(UCHAR(*pc->p)) || (*(pc->p) == '\\' && *(pc->p + 1) == '\n')) { + if (*pc->p == '\n') { + pc->linenr++; + } + pc->p++; + pc->len--; + } + + + pc->tline = pc->linenr; + pc->tstart = pc->p; + + if (pc->len == 0) { + pc->tend = pc->p; + pc->tt = JIM_TT_EOL; + pc->eof = 1; + return JIM_OK; + } + switch (*(pc->p)) { + case '(': + pc->tt = JIM_TT_SUBEXPR_START; + goto singlechar; + case ')': + pc->tt = JIM_TT_SUBEXPR_END; + goto singlechar; + case ',': + pc->tt = JIM_TT_SUBEXPR_COMMA; +singlechar: + pc->tend = pc->p; + pc->p++; + pc->len--; + break; + case '[': + return JimParseCmd(pc); + case '$': + if (JimParseVar(pc) == JIM_ERR) + return JimParseExprOperator(pc); + else { + + if (pc->tt == JIM_TT_EXPRSUGAR) { + return JIM_ERR; + } + return JIM_OK; + } + break; + case '0': + case '1': + case '2': + case '3': + case '4': + case '5': + case '6': + case '7': + case '8': + case '9': + case '.': + return JimParseExprNumber(pc); + case '"': + return JimParseQuote(pc); + case '{': + return JimParseBrace(pc); + + case 'N': + case 'I': + case 'n': + case 'i': + if (JimParseExprIrrational(pc) == JIM_ERR) + return JimParseExprOperator(pc); + break; + default: + return JimParseExprOperator(pc); + break; + } + return JIM_OK; +} + +static int JimParseExprNumber(struct JimParserCtx *pc) +{ + char *end; + + + pc->tt = JIM_TT_EXPR_INT; + + jim_strtoull(pc->p, (char **)&pc->p); + + if (strchr("eENnIi.", *pc->p) || pc->p == pc->tstart) { + if (strtod(pc->tstart, &end)) { } + if (end == pc->tstart) + return JIM_ERR; + if (end > pc->p) { + + pc->tt = JIM_TT_EXPR_DOUBLE; + pc->p = end; + } + } + pc->tend = pc->p - 1; + pc->len -= (pc->p - pc->tstart); + return JIM_OK; +} + +static int JimParseExprIrrational(struct JimParserCtx *pc) +{ + const char *irrationals[] = { "NaN", "nan", "NAN", "Inf", "inf", "INF", NULL }; + int i; + + for (i = 0; irrationals[i]; i++) { + const char *irr = irrationals[i]; + + if (strncmp(irr, pc->p, 3) == 0) { + pc->p += 3; + pc->len -= 3; + pc->tend = pc->p - 1; + pc->tt = JIM_TT_EXPR_DOUBLE; + return JIM_OK; + } + } + return JIM_ERR; +} + +static int JimParseExprOperator(struct JimParserCtx *pc) +{ + int i; + int bestIdx = -1, bestLen = 0; + + + for (i = 0; i < (signed)JIM_EXPR_OPERATORS_NUM; i++) { + const char * const opname = Jim_ExprOperators[i].name; + const int oplen = Jim_ExprOperators[i].namelen; + + if (opname == NULL || opname[0] != pc->p[0]) { + continue; + } + + if (oplen > bestLen && strncmp(opname, pc->p, oplen) == 0) { + bestIdx = i + JIM_TT_EXPR_OP; + bestLen = oplen; + } + } + if (bestIdx == -1) { + return JIM_ERR; + } + + + if (bestIdx >= JIM_EXPROP_FUNC_FIRST) { + const char *p = pc->p + bestLen; + int len = pc->len - bestLen; + + while (len && isspace(UCHAR(*p))) { + len--; + p++; + } + if (*p != '(') { + return JIM_ERR; + } + } + pc->tend = pc->p + bestLen - 1; + pc->p += bestLen; + pc->len -= bestLen; + + pc->tt = bestIdx; + return JIM_OK; +} + +static const struct Jim_ExprOperator *JimExprOperatorInfoByOpcode(int opcode) +{ + static Jim_ExprOperator dummy_op; + if (opcode < JIM_TT_EXPR_OP) { + return &dummy_op; + } + return &Jim_ExprOperators[opcode - JIM_TT_EXPR_OP]; +} + +const char *jim_tt_name(int type) +{ + static const char * const tt_names[JIM_TT_EXPR_OP] = + { "NIL", "STR", "ESC", "VAR", "ARY", "CMD", "SEP", "EOL", "EOF", "LIN", "WRD", "(((", ")))", ",,,", "INT", + "DBL", "$()" }; + if (type < JIM_TT_EXPR_OP) { + return tt_names[type]; + } + else { + const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(type); + static char buf[20]; + + if (op->name) { + return op->name; + } + sprintf(buf, "(%d)", type); + return buf; + } +} + +static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr); +static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); +static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr); + +static const Jim_ObjType exprObjType = { + "expression", + FreeExprInternalRep, + DupExprInternalRep, + NULL, + JIM_TYPE_REFERENCES, +}; + + +typedef struct ExprByteCode +{ + ScriptToken *token; + int len; + int inUse; +} ExprByteCode; + +static void ExprFreeByteCode(Jim_Interp *interp, ExprByteCode * expr) +{ + int i; + + for (i = 0; i < expr->len; i++) { + Jim_DecrRefCount(interp, expr->token[i].objPtr); + } + Jim_Free(expr->token); + Jim_Free(expr); +} + +static void FreeExprInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + ExprByteCode *expr = (void *)objPtr->internalRep.ptr; + + if (expr) { + if (--expr->inUse != 0) { + return; + } + + ExprFreeByteCode(interp, expr); + } +} + +static void DupExprInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + JIM_NOTUSED(interp); + JIM_NOTUSED(srcPtr); + + + dupPtr->typePtr = NULL; +} + + +static int ExprCheckCorrectness(ExprByteCode * expr) +{ + int i; + int stacklen = 0; + int ternary = 0; + + for (i = 0; i < expr->len; i++) { + ScriptToken *t = &expr->token[i]; + const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type); + + stacklen -= op->arity; + if (stacklen < 0) { + break; + } + if (t->type == JIM_EXPROP_TERNARY || t->type == JIM_EXPROP_TERNARY_LEFT) { + ternary++; + } + else if (t->type == JIM_EXPROP_COLON || t->type == JIM_EXPROP_COLON_LEFT) { + ternary--; + } + + + stacklen++; + } + if (stacklen != 1 || ternary != 0) { + return JIM_ERR; + } + return JIM_OK; +} + +static int ExprAddLazyOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t) +{ + int i; + + int leftindex, arity, offset; + + + leftindex = expr->len - 1; + + arity = 1; + while (arity) { + ScriptToken *tt = &expr->token[leftindex]; + + if (tt->type >= JIM_TT_EXPR_OP) { + arity += JimExprOperatorInfoByOpcode(tt->type)->arity; + } + arity--; + if (--leftindex < 0) { + return JIM_ERR; + } + } + leftindex++; + + + memmove(&expr->token[leftindex + 2], &expr->token[leftindex], + sizeof(*expr->token) * (expr->len - leftindex)); + expr->len += 2; + offset = (expr->len - leftindex) - 1; + + expr->token[leftindex + 1].type = t->type + 1; + expr->token[leftindex + 1].objPtr = interp->emptyObj; + + expr->token[leftindex].type = JIM_TT_EXPR_INT; + expr->token[leftindex].objPtr = Jim_NewIntObj(interp, offset); + + + expr->token[expr->len].objPtr = interp->emptyObj; + expr->token[expr->len].type = t->type + 2; + expr->len++; + + + for (i = leftindex - 1; i > 0; i--) { + const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(expr->token[i].type); + if (op->lazy == LAZY_LEFT) { + if (JimWideValue(expr->token[i - 1].objPtr) + i - 1 >= leftindex) { + JimWideValue(expr->token[i - 1].objPtr) += 2; + } + } + } + return JIM_OK; +} + +static int ExprAddOperator(Jim_Interp *interp, ExprByteCode * expr, ParseToken *t) +{ + struct ScriptToken *token = &expr->token[expr->len]; + const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type); + + if (op->lazy == LAZY_OP) { + if (ExprAddLazyOperator(interp, expr, t) != JIM_OK) { + Jim_SetResultFormatted(interp, "Expression has bad operands to %s", op->name); + return JIM_ERR; + } + } + else { + token->objPtr = interp->emptyObj; + token->type = t->type; + expr->len++; + } + return JIM_OK; +} + +static int ExprTernaryGetColonLeftIndex(ExprByteCode *expr, int right_index) +{ + int ternary_count = 1; + + right_index--; + + while (right_index > 1) { + if (expr->token[right_index].type == JIM_EXPROP_TERNARY_LEFT) { + ternary_count--; + } + else if (expr->token[right_index].type == JIM_EXPROP_COLON_RIGHT) { + ternary_count++; + } + else if (expr->token[right_index].type == JIM_EXPROP_COLON_LEFT && ternary_count == 1) { + return right_index; + } + right_index--; + } + + + return -1; +} + +static int ExprTernaryGetMoveIndices(ExprByteCode *expr, int right_index, int *prev_right_index, int *prev_left_index) +{ + int i = right_index - 1; + int ternary_count = 1; + + while (i > 1) { + if (expr->token[i].type == JIM_EXPROP_TERNARY_LEFT) { + if (--ternary_count == 0 && expr->token[i - 2].type == JIM_EXPROP_COLON_RIGHT) { + *prev_right_index = i - 2; + *prev_left_index = ExprTernaryGetColonLeftIndex(expr, *prev_right_index); + return 1; + } + } + else if (expr->token[i].type == JIM_EXPROP_COLON_RIGHT) { + if (ternary_count == 0) { + return 0; + } + ternary_count++; + } + i--; + } + return 0; +} + +static void ExprTernaryReorderExpression(Jim_Interp *interp, ExprByteCode *expr) +{ + int i; + + for (i = expr->len - 1; i > 1; i--) { + int prev_right_index; + int prev_left_index; + int j; + ScriptToken tmp; + + if (expr->token[i].type != JIM_EXPROP_COLON_RIGHT) { + continue; + } + + + if (ExprTernaryGetMoveIndices(expr, i, &prev_right_index, &prev_left_index) == 0) { + continue; + } + + tmp = expr->token[prev_right_index]; + for (j = prev_right_index; j < i; j++) { + expr->token[j] = expr->token[j + 1]; + } + expr->token[i] = tmp; + + JimWideValue(expr->token[prev_left_index-1].objPtr) += (i - prev_right_index); + + + i++; + } +} + +static ExprByteCode *ExprCreateByteCode(Jim_Interp *interp, const ParseTokenList *tokenlist, Jim_Obj *fileNameObj) +{ + Jim_Stack stack; + ExprByteCode *expr; + int ok = 1; + int i; + int prevtt = JIM_TT_NONE; + int have_ternary = 0; + + + int count = tokenlist->count - 1; + + expr = Jim_Alloc(sizeof(*expr)); + expr->inUse = 1; + expr->len = 0; + + Jim_InitStack(&stack); + + for (i = 0; i < tokenlist->count; i++) { + ParseToken *t = &tokenlist->list[i]; + const struct Jim_ExprOperator *op = JimExprOperatorInfoByOpcode(t->type); + + if (op->lazy == LAZY_OP) { + count += 2; + + if (t->type == JIM_EXPROP_TERNARY) { + have_ternary = 1; + } + } + } + + expr->token = Jim_Alloc(sizeof(ScriptToken) * count); + + for (i = 0; i < tokenlist->count && ok; i++) { + ParseToken *t = &tokenlist->list[i]; + + + struct ScriptToken *token = &expr->token[expr->len]; + + if (t->type == JIM_TT_EOL) { + break; + } + + switch (t->type) { + case JIM_TT_STR: + case JIM_TT_ESC: + case JIM_TT_VAR: + case JIM_TT_DICTSUGAR: + case JIM_TT_EXPRSUGAR: + case JIM_TT_CMD: + token->type = t->type; +strexpr: + token->objPtr = Jim_NewStringObj(interp, t->token, t->len); + if (t->type == JIM_TT_CMD) { + + JimSetSourceInfo(interp, token->objPtr, fileNameObj, t->line); + } + expr->len++; + break; + + case JIM_TT_EXPR_INT: + case JIM_TT_EXPR_DOUBLE: + { + char *endptr; + if (t->type == JIM_TT_EXPR_INT) { + token->objPtr = Jim_NewIntObj(interp, jim_strtoull(t->token, &endptr)); + } + else { + token->objPtr = Jim_NewDoubleObj(interp, strtod(t->token, &endptr)); + } + if (endptr != t->token + t->len) { + + Jim_FreeNewObj(interp, token->objPtr); + token->type = JIM_TT_STR; + goto strexpr; + } + token->type = t->type; + expr->len++; + } + break; + + case JIM_TT_SUBEXPR_START: + Jim_StackPush(&stack, t); + prevtt = JIM_TT_NONE; + continue; + + case JIM_TT_SUBEXPR_COMMA: + + continue; + + case JIM_TT_SUBEXPR_END: + ok = 0; + while (Jim_StackLen(&stack)) { + ParseToken *tt = Jim_StackPop(&stack); + + if (tt->type == JIM_TT_SUBEXPR_START) { + ok = 1; + break; + } + + if (ExprAddOperator(interp, expr, tt) != JIM_OK) { + goto err; + } + } + if (!ok) { + Jim_SetResultString(interp, "Unexpected close parenthesis", -1); + goto err; + } + break; + + + default:{ + + const struct Jim_ExprOperator *op; + ParseToken *tt; + + + if (prevtt == JIM_TT_NONE || prevtt >= JIM_TT_EXPR_OP) { + if (t->type == JIM_EXPROP_SUB) { + t->type = JIM_EXPROP_UNARYMINUS; + } + else if (t->type == JIM_EXPROP_ADD) { + t->type = JIM_EXPROP_UNARYPLUS; + } + } + + op = JimExprOperatorInfoByOpcode(t->type); + + + while ((tt = Jim_StackPeek(&stack)) != NULL) { + const struct Jim_ExprOperator *tt_op = + JimExprOperatorInfoByOpcode(tt->type); + + + + if (op->arity != 1 && tt_op->precedence >= op->precedence) { + if (ExprAddOperator(interp, expr, tt) != JIM_OK) { + ok = 0; + goto err; + } + Jim_StackPop(&stack); + } + else { + break; + } + } + Jim_StackPush(&stack, t); + break; + } + } + prevtt = t->type; + } + + + while (Jim_StackLen(&stack)) { + ParseToken *tt = Jim_StackPop(&stack); + + if (tt->type == JIM_TT_SUBEXPR_START) { + ok = 0; + Jim_SetResultString(interp, "Missing close parenthesis", -1); + goto err; + } + if (ExprAddOperator(interp, expr, tt) != JIM_OK) { + ok = 0; + goto err; + } + } + + if (have_ternary) { + ExprTernaryReorderExpression(interp, expr); + } + + err: + + Jim_FreeStack(&stack); + + for (i = 0; i < expr->len; i++) { + Jim_IncrRefCount(expr->token[i].objPtr); + } + + if (!ok) { + ExprFreeByteCode(interp, expr); + return NULL; + } + + return expr; +} + + +static int SetExprFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr) +{ + int exprTextLen; + const char *exprText; + struct JimParserCtx parser; + struct ExprByteCode *expr; + ParseTokenList tokenlist; + int line; + Jim_Obj *fileNameObj; + int rc = JIM_ERR; + + + if (objPtr->typePtr == &sourceObjType) { + fileNameObj = objPtr->internalRep.sourceValue.fileNameObj; + line = objPtr->internalRep.sourceValue.lineNumber; + } + else { + fileNameObj = interp->emptyObj; + line = 1; + } + Jim_IncrRefCount(fileNameObj); + + exprText = Jim_GetString(objPtr, &exprTextLen); + + + ScriptTokenListInit(&tokenlist); + + JimParserInit(&parser, exprText, exprTextLen, line); + while (!parser.eof) { + if (JimParseExpression(&parser) != JIM_OK) { + ScriptTokenListFree(&tokenlist); + invalidexpr: + Jim_SetResultFormatted(interp, "syntax error in expression: \"%#s\"", objPtr); + expr = NULL; + goto err; + } + + ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt, + parser.tline); + } + +#ifdef DEBUG_SHOW_EXPR_TOKENS + { + int i; + printf("==== Expr Tokens (%s) ====\n", Jim_String(fileNameObj)); + for (i = 0; i < tokenlist.count; i++) { + printf("[%2d]@%d %s '%.*s'\n", i, tokenlist.list[i].line, jim_tt_name(tokenlist.list[i].type), + tokenlist.list[i].len, tokenlist.list[i].token); + } + } +#endif + + if (JimParseCheckMissing(interp, parser.missing.ch) == JIM_ERR) { + ScriptTokenListFree(&tokenlist); + Jim_DecrRefCount(interp, fileNameObj); + return JIM_ERR; + } + + + expr = ExprCreateByteCode(interp, &tokenlist, fileNameObj); + + + ScriptTokenListFree(&tokenlist); + + if (!expr) { + goto err; + } + +#ifdef DEBUG_SHOW_EXPR + { + int i; + + printf("==== Expr ====\n"); + for (i = 0; i < expr->len; i++) { + ScriptToken *t = &expr->token[i]; + + printf("[%2d] %s '%s'\n", i, jim_tt_name(t->type), Jim_String(t->objPtr)); + } + } +#endif + + + if (ExprCheckCorrectness(expr) != JIM_OK) { + ExprFreeByteCode(interp, expr); + goto invalidexpr; + } + + rc = JIM_OK; + + err: + + Jim_DecrRefCount(interp, fileNameObj); + Jim_FreeIntRep(interp, objPtr); + Jim_SetIntRepPtr(objPtr, expr); + objPtr->typePtr = &exprObjType; + return rc; +} + +static ExprByteCode *JimGetExpression(Jim_Interp *interp, Jim_Obj *objPtr) +{ + if (objPtr->typePtr != &exprObjType) { + if (SetExprFromAny(interp, objPtr) != JIM_OK) { + return NULL; + } + } + return (ExprByteCode *) Jim_GetIntRepPtr(objPtr); +} + +#ifdef JIM_OPTIMIZATION +static Jim_Obj *JimExprIntValOrVar(Jim_Interp *interp, const ScriptToken *token) +{ + if (token->type == JIM_TT_EXPR_INT) + return token->objPtr; + else if (token->type == JIM_TT_VAR) + return Jim_GetVariable(interp, token->objPtr, JIM_NONE); + else if (token->type == JIM_TT_DICTSUGAR) + return JimExpandDictSugar(interp, token->objPtr); + else + return NULL; +} +#endif + +#define JIM_EE_STATICSTACK_LEN 10 + +int Jim_EvalExpression(Jim_Interp *interp, Jim_Obj *exprObjPtr, Jim_Obj **exprResultPtrPtr) +{ + ExprByteCode *expr; + Jim_Obj *staticStack[JIM_EE_STATICSTACK_LEN]; + int i; + int retcode = JIM_OK; + struct JimExprState e; + + expr = JimGetExpression(interp, exprObjPtr); + if (!expr) { + return JIM_ERR; + } + +#ifdef JIM_OPTIMIZATION + { + Jim_Obj *objPtr; + + + switch (expr->len) { + case 1: + objPtr = JimExprIntValOrVar(interp, &expr->token[0]); + if (objPtr) { + Jim_IncrRefCount(objPtr); + *exprResultPtrPtr = objPtr; + return JIM_OK; + } + break; + + case 2: + if (expr->token[1].type == JIM_EXPROP_NOT) { + objPtr = JimExprIntValOrVar(interp, &expr->token[0]); + + if (objPtr && JimIsWide(objPtr)) { + *exprResultPtrPtr = JimWideValue(objPtr) ? interp->falseObj : interp->trueObj; + Jim_IncrRefCount(*exprResultPtrPtr); + return JIM_OK; + } + } + break; + + case 3: + objPtr = JimExprIntValOrVar(interp, &expr->token[0]); + if (objPtr && JimIsWide(objPtr)) { + Jim_Obj *objPtr2 = JimExprIntValOrVar(interp, &expr->token[1]); + if (objPtr2 && JimIsWide(objPtr2)) { + jim_wide wideValueA = JimWideValue(objPtr); + jim_wide wideValueB = JimWideValue(objPtr2); + int cmpRes; + switch (expr->token[2].type) { + case JIM_EXPROP_LT: + cmpRes = wideValueA < wideValueB; + break; + case JIM_EXPROP_LTE: + cmpRes = wideValueA <= wideValueB; + break; + case JIM_EXPROP_GT: + cmpRes = wideValueA > wideValueB; + break; + case JIM_EXPROP_GTE: + cmpRes = wideValueA >= wideValueB; + break; + case JIM_EXPROP_NUMEQ: + cmpRes = wideValueA == wideValueB; + break; + case JIM_EXPROP_NUMNE: + cmpRes = wideValueA != wideValueB; + break; + default: + goto noopt; + } + *exprResultPtrPtr = cmpRes ? interp->trueObj : interp->falseObj; + Jim_IncrRefCount(*exprResultPtrPtr); + return JIM_OK; + } + } + break; + } + } +noopt: +#endif + + expr->inUse++; + + + + if (expr->len > JIM_EE_STATICSTACK_LEN) + e.stack = Jim_Alloc(sizeof(Jim_Obj *) * expr->len); + else + e.stack = staticStack; + + e.stacklen = 0; + + + for (i = 0; i < expr->len && retcode == JIM_OK; i++) { + Jim_Obj *objPtr; + + switch (expr->token[i].type) { + case JIM_TT_EXPR_INT: + case JIM_TT_EXPR_DOUBLE: + case JIM_TT_STR: + ExprPush(&e, expr->token[i].objPtr); + break; + + case JIM_TT_VAR: + objPtr = Jim_GetVariable(interp, expr->token[i].objPtr, JIM_ERRMSG); + if (objPtr) { + ExprPush(&e, objPtr); + } + else { + retcode = JIM_ERR; + } + break; + + case JIM_TT_DICTSUGAR: + objPtr = JimExpandDictSugar(interp, expr->token[i].objPtr); + if (objPtr) { + ExprPush(&e, objPtr); + } + else { + retcode = JIM_ERR; + } + break; + + case JIM_TT_ESC: + retcode = Jim_SubstObj(interp, expr->token[i].objPtr, &objPtr, JIM_NONE); + if (retcode == JIM_OK) { + ExprPush(&e, objPtr); + } + break; + + case JIM_TT_CMD: + retcode = Jim_EvalObj(interp, expr->token[i].objPtr); + if (retcode == JIM_OK) { + ExprPush(&e, Jim_GetResult(interp)); + } + break; + + default:{ + + e.skip = 0; + e.opcode = expr->token[i].type; + + retcode = JimExprOperatorInfoByOpcode(e.opcode)->funcop(interp, &e); + + i += e.skip; + continue; + } + } + } + + expr->inUse--; + + if (retcode == JIM_OK) { + *exprResultPtrPtr = ExprPop(&e); + } + else { + for (i = 0; i < e.stacklen; i++) { + Jim_DecrRefCount(interp, e.stack[i]); + } + } + if (e.stack != staticStack) { + Jim_Free(e.stack); + } + return retcode; +} + +int Jim_GetBoolFromExpr(Jim_Interp *interp, Jim_Obj *exprObjPtr, int *boolPtr) +{ + int retcode; + jim_wide wideValue; + double doubleValue; + Jim_Obj *exprResultPtr; + + retcode = Jim_EvalExpression(interp, exprObjPtr, &exprResultPtr); + if (retcode != JIM_OK) + return retcode; + + if (JimGetWideNoErr(interp, exprResultPtr, &wideValue) != JIM_OK) { + if (Jim_GetDouble(interp, exprResultPtr, &doubleValue) != JIM_OK) { + Jim_DecrRefCount(interp, exprResultPtr); + return JIM_ERR; + } + else { + Jim_DecrRefCount(interp, exprResultPtr); + *boolPtr = doubleValue != 0; + return JIM_OK; + } + } + *boolPtr = wideValue != 0; + + Jim_DecrRefCount(interp, exprResultPtr); + return JIM_OK; +} + + + + +typedef struct ScanFmtPartDescr +{ + char *arg; + char *prefix; + size_t width; + int pos; + char type; + char modifier; +} ScanFmtPartDescr; + + +typedef struct ScanFmtStringObj +{ + jim_wide size; + char *stringRep; + size_t count; + size_t convCount; + size_t maxPos; + const char *error; + char *scratch; + ScanFmtPartDescr descr[1]; +} ScanFmtStringObj; + + +static void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr); +static void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr); +static void UpdateStringOfScanFmt(Jim_Obj *objPtr); + +static const Jim_ObjType scanFmtStringObjType = { + "scanformatstring", + FreeScanFmtInternalRep, + DupScanFmtInternalRep, + UpdateStringOfScanFmt, + JIM_TYPE_NONE, +}; + +void FreeScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *objPtr) +{ + JIM_NOTUSED(interp); + Jim_Free((char *)objPtr->internalRep.ptr); + objPtr->internalRep.ptr = 0; +} + +void DupScanFmtInternalRep(Jim_Interp *interp, Jim_Obj *srcPtr, Jim_Obj *dupPtr) +{ + size_t size = (size_t) ((ScanFmtStringObj *) srcPtr->internalRep.ptr)->size; + ScanFmtStringObj *newVec = (ScanFmtStringObj *) Jim_Alloc(size); + + JIM_NOTUSED(interp); + memcpy(newVec, srcPtr->internalRep.ptr, size); + dupPtr->internalRep.ptr = newVec; + dupPtr->typePtr = &scanFmtStringObjType; +} + +static void UpdateStringOfScanFmt(Jim_Obj *objPtr) +{ + JimSetStringBytes(objPtr, ((ScanFmtStringObj *) objPtr->internalRep.ptr)->stringRep); +} + + +static int SetScanFmtFromAny(Jim_Interp *interp, Jim_Obj *objPtr) +{ + ScanFmtStringObj *fmtObj; + char *buffer; + int maxCount, i, approxSize, lastPos = -1; + const char *fmt = objPtr->bytes; + int maxFmtLen = objPtr->length; + const char *fmtEnd = fmt + maxFmtLen; + int curr; + + Jim_FreeIntRep(interp, objPtr); + + for (i = 0, maxCount = 0; i < maxFmtLen; ++i) + if (fmt[i] == '%') + ++maxCount; + + approxSize = sizeof(ScanFmtStringObj) + +(maxCount + 1) * sizeof(ScanFmtPartDescr) + +maxFmtLen * sizeof(char) + 3 + 1 + + maxFmtLen * sizeof(char) + 1 + + maxFmtLen * sizeof(char) + +(maxCount + 1) * sizeof(char) + +1; + fmtObj = (ScanFmtStringObj *) Jim_Alloc(approxSize); + memset(fmtObj, 0, approxSize); + fmtObj->size = approxSize; + fmtObj->maxPos = 0; + fmtObj->scratch = (char *)&fmtObj->descr[maxCount + 1]; + fmtObj->stringRep = fmtObj->scratch + maxFmtLen + 3 + 1; + memcpy(fmtObj->stringRep, fmt, maxFmtLen); + buffer = fmtObj->stringRep + maxFmtLen + 1; + objPtr->internalRep.ptr = fmtObj; + objPtr->typePtr = &scanFmtStringObjType; + for (i = 0, curr = 0; fmt < fmtEnd; ++fmt) { + int width = 0, skip; + ScanFmtPartDescr *descr = &fmtObj->descr[curr]; + + fmtObj->count++; + descr->width = 0; + + if (*fmt != '%' || fmt[1] == '%') { + descr->type = 0; + descr->prefix = &buffer[i]; + for (; fmt < fmtEnd; ++fmt) { + if (*fmt == '%') { + if (fmt[1] != '%') + break; + ++fmt; + } + buffer[i++] = *fmt; + } + buffer[i++] = 0; + } + + ++fmt; + + if (fmt >= fmtEnd) + goto done; + descr->pos = 0; + if (*fmt == '*') { + descr->pos = -1; + ++fmt; + } + else + fmtObj->convCount++; + + if (sscanf(fmt, "%d%n", &width, &skip) == 1) { + fmt += skip; + + if (descr->pos != -1 && *fmt == '$') { + int prev; + + ++fmt; + descr->pos = width; + width = 0; + + if ((lastPos == 0 && descr->pos > 0) + || (lastPos > 0 && descr->pos == 0)) { + fmtObj->error = "cannot mix \"%\" and \"%n$\" conversion specifiers"; + return JIM_ERR; + } + + for (prev = 0; prev < curr; ++prev) { + if (fmtObj->descr[prev].pos == -1) + continue; + if (fmtObj->descr[prev].pos == descr->pos) { + fmtObj->error = + "variable is assigned by multiple \"%n$\" conversion specifiers"; + return JIM_ERR; + } + } + + if (sscanf(fmt, "%d%n", &width, &skip) == 1) { + descr->width = width; + fmt += skip; + } + if (descr->pos > 0 && (size_t) descr->pos > fmtObj->maxPos) + fmtObj->maxPos = descr->pos; + } + else { + + descr->width = width; + } + } + + if (lastPos == -1) + lastPos = descr->pos; + + if (*fmt == '[') { + int swapped = 1, beg = i, end, j; + + descr->type = '['; + descr->arg = &buffer[i]; + ++fmt; + if (*fmt == '^') + buffer[i++] = *fmt++; + if (*fmt == ']') + buffer[i++] = *fmt++; + while (*fmt && *fmt != ']') + buffer[i++] = *fmt++; + if (*fmt != ']') { + fmtObj->error = "unmatched [ in format string"; + return JIM_ERR; + } + end = i; + buffer[i++] = 0; + + while (swapped) { + swapped = 0; + for (j = beg + 1; j < end - 1; ++j) { + if (buffer[j] == '-' && buffer[j - 1] > buffer[j + 1]) { + char tmp = buffer[j - 1]; + + buffer[j - 1] = buffer[j + 1]; + buffer[j + 1] = tmp; + swapped = 1; + } + } + } + } + else { + + if (strchr("hlL", *fmt) != 0) + descr->modifier = tolower((int)*fmt++); + + descr->type = *fmt; + if (strchr("efgcsndoxui", *fmt) == 0) { + fmtObj->error = "bad scan conversion character"; + return JIM_ERR; + } + else if (*fmt == 'c' && descr->width != 0) { + fmtObj->error = "field width may not be specified in %c " "conversion"; + return JIM_ERR; + } + else if (*fmt == 'u' && descr->modifier == 'l') { + fmtObj->error = "unsigned wide not supported"; + return JIM_ERR; + } + } + curr++; + } + done: + return JIM_OK; +} + + + +#define FormatGetCnvCount(_fo_) \ + ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->convCount +#define FormatGetMaxPos(_fo_) \ + ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->maxPos +#define FormatGetError(_fo_) \ + ((ScanFmtStringObj*)((_fo_)->internalRep.ptr))->error + +static Jim_Obj *JimScanAString(Jim_Interp *interp, const char *sdescr, const char *str) +{ + char *buffer = Jim_StrDup(str); + char *p = buffer; + + while (*str) { + int c; + int n; + + if (!sdescr && isspace(UCHAR(*str))) + break; + + n = utf8_tounicode(str, &c); + if (sdescr && !JimCharsetMatch(sdescr, c, JIM_CHARSET_SCAN)) + break; + while (n--) + *p++ = *str++; + } + *p = 0; + return Jim_NewStringObjNoAlloc(interp, buffer, p - buffer); +} + + +static int ScanOneEntry(Jim_Interp *interp, const char *str, int pos, int strLen, + ScanFmtStringObj * fmtObj, long idx, Jim_Obj **valObjPtr) +{ + const char *tok; + const ScanFmtPartDescr *descr = &fmtObj->descr[idx]; + size_t scanned = 0; + size_t anchor = pos; + int i; + Jim_Obj *tmpObj = NULL; + + + *valObjPtr = 0; + if (descr->prefix) { + for (i = 0; pos < strLen && descr->prefix[i]; ++i) { + + if (isspace(UCHAR(descr->prefix[i]))) + while (pos < strLen && isspace(UCHAR(str[pos]))) + ++pos; + else if (descr->prefix[i] != str[pos]) + break; + else + ++pos; + } + if (pos >= strLen) { + return -1; + } + else if (descr->prefix[i] != 0) + return 0; + } + + if (descr->type != 'c' && descr->type != '[' && descr->type != 'n') + while (isspace(UCHAR(str[pos]))) + ++pos; + + scanned = pos - anchor; + + + if (descr->type == 'n') { + + *valObjPtr = Jim_NewIntObj(interp, anchor + scanned); + } + else if (pos >= strLen) { + + return -1; + } + else if (descr->type == 'c') { + int c; + scanned += utf8_tounicode(&str[pos], &c); + *valObjPtr = Jim_NewIntObj(interp, c); + return scanned; + } + else { + + if (descr->width > 0) { + size_t sLen = utf8_strlen(&str[pos], strLen - pos); + size_t tLen = descr->width > sLen ? sLen : descr->width; + + tmpObj = Jim_NewStringObjUtf8(interp, str + pos, tLen); + tok = tmpObj->bytes; + } + else { + + tok = &str[pos]; + } + switch (descr->type) { + case 'd': + case 'o': + case 'x': + case 'u': + case 'i':{ + char *endp; + jim_wide w; + + int base = descr->type == 'o' ? 8 + : descr->type == 'x' ? 16 : descr->type == 'i' ? 0 : 10; + + + if (base == 0) { + w = jim_strtoull(tok, &endp); + } + else { + w = strtoull(tok, &endp, base); + } + + if (endp != tok) { + + *valObjPtr = Jim_NewIntObj(interp, w); + + + scanned += endp - tok; + } + else { + scanned = *tok ? 0 : -1; + } + break; + } + case 's': + case '[':{ + *valObjPtr = JimScanAString(interp, descr->arg, tok); + scanned += Jim_Length(*valObjPtr); + break; + } + case 'e': + case 'f': + case 'g':{ + char *endp; + double value = strtod(tok, &endp); + + if (endp != tok) { + + *valObjPtr = Jim_NewDoubleObj(interp, value); + + scanned += endp - tok; + } + else { + scanned = *tok ? 0 : -1; + } + break; + } + } + if (tmpObj) { + Jim_FreeNewObj(interp, tmpObj); + } + } + return scanned; +} + + +Jim_Obj *Jim_ScanString(Jim_Interp *interp, Jim_Obj *strObjPtr, Jim_Obj *fmtObjPtr, int flags) +{ + size_t i, pos; + int scanned = 1; + const char *str = Jim_String(strObjPtr); + int strLen = Jim_Utf8Length(interp, strObjPtr); + Jim_Obj *resultList = 0; + Jim_Obj **resultVec = 0; + int resultc; + Jim_Obj *emptyStr = 0; + ScanFmtStringObj *fmtObj; + + + JimPanic((fmtObjPtr->typePtr != &scanFmtStringObjType, "Jim_ScanString() for non-scan format")); + + fmtObj = (ScanFmtStringObj *) fmtObjPtr->internalRep.ptr; + + if (fmtObj->error != 0) { + if (flags & JIM_ERRMSG) + Jim_SetResultString(interp, fmtObj->error, -1); + return 0; + } + + emptyStr = Jim_NewEmptyStringObj(interp); + Jim_IncrRefCount(emptyStr); + + resultList = Jim_NewListObj(interp, NULL, 0); + if (fmtObj->maxPos > 0) { + for (i = 0; i < fmtObj->maxPos; ++i) + Jim_ListAppendElement(interp, resultList, emptyStr); + JimListGetElements(interp, resultList, &resultc, &resultVec); + } + + for (i = 0, pos = 0; i < fmtObj->count; ++i) { + ScanFmtPartDescr *descr = &(fmtObj->descr[i]); + Jim_Obj *value = 0; + + + if (descr->type == 0) + continue; + + if (scanned > 0) + scanned = ScanOneEntry(interp, str, pos, strLen, fmtObj, i, &value); + + if (scanned == -1 && i == 0) + goto eof; + + pos += scanned; + + + if (value == 0) + value = Jim_NewEmptyStringObj(interp); + + if (descr->pos == -1) { + Jim_FreeNewObj(interp, value); + } + else if (descr->pos == 0) + + Jim_ListAppendElement(interp, resultList, value); + else if (resultVec[descr->pos - 1] == emptyStr) { + + Jim_DecrRefCount(interp, resultVec[descr->pos - 1]); + Jim_IncrRefCount(value); + resultVec[descr->pos - 1] = value; + } + else { + + Jim_FreeNewObj(interp, value); + goto err; + } + } + Jim_DecrRefCount(interp, emptyStr); + return resultList; + eof: + Jim_DecrRefCount(interp, emptyStr); + Jim_FreeNewObj(interp, resultList); + return (Jim_Obj *)EOF; + err: + Jim_DecrRefCount(interp, emptyStr); + Jim_FreeNewObj(interp, resultList); + return 0; +} + + +static void JimPrngInit(Jim_Interp *interp) +{ +#define PRNG_SEED_SIZE 256 + int i; + unsigned int *seed; + time_t t = time(NULL); + + interp->prngState = Jim_Alloc(sizeof(Jim_PrngState)); + + seed = Jim_Alloc(PRNG_SEED_SIZE * sizeof(*seed)); + for (i = 0; i < PRNG_SEED_SIZE; i++) { + seed[i] = (rand() ^ t ^ clock()); + } + JimPrngSeed(interp, (unsigned char *)seed, PRNG_SEED_SIZE * sizeof(*seed)); + Jim_Free(seed); +} + + +static void JimRandomBytes(Jim_Interp *interp, void *dest, unsigned int len) +{ + Jim_PrngState *prng; + unsigned char *destByte = (unsigned char *)dest; + unsigned int si, sj, x; + + + if (interp->prngState == NULL) + JimPrngInit(interp); + prng = interp->prngState; + + for (x = 0; x < len; x++) { + prng->i = (prng->i + 1) & 0xff; + si = prng->sbox[prng->i]; + prng->j = (prng->j + si) & 0xff; + sj = prng->sbox[prng->j]; + prng->sbox[prng->i] = sj; + prng->sbox[prng->j] = si; + *destByte++ = prng->sbox[(si + sj) & 0xff]; + } +} + + +static void JimPrngSeed(Jim_Interp *interp, unsigned char *seed, int seedLen) +{ + int i; + Jim_PrngState *prng; + + + if (interp->prngState == NULL) + JimPrngInit(interp); + prng = interp->prngState; + + + for (i = 0; i < 256; i++) + prng->sbox[i] = i; + + for (i = 0; i < seedLen; i++) { + unsigned char t; + + t = prng->sbox[i & 0xFF]; + prng->sbox[i & 0xFF] = prng->sbox[seed[i]]; + prng->sbox[seed[i]] = t; + } + prng->i = prng->j = 0; + + for (i = 0; i < 256; i += seedLen) { + JimRandomBytes(interp, seed, seedLen); + } +} + + +static int Jim_IncrCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + jim_wide wideValue, increment = 1; + Jim_Obj *intObjPtr; + + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "varName ?increment?"); + return JIM_ERR; + } + if (argc == 3) { + if (Jim_GetWide(interp, argv[2], &increment) != JIM_OK) + return JIM_ERR; + } + intObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED); + if (!intObjPtr) { + + wideValue = 0; + } + else if (Jim_GetWide(interp, intObjPtr, &wideValue) != JIM_OK) { + return JIM_ERR; + } + if (!intObjPtr || Jim_IsShared(intObjPtr)) { + intObjPtr = Jim_NewIntObj(interp, wideValue + increment); + if (Jim_SetVariable(interp, argv[1], intObjPtr) != JIM_OK) { + Jim_FreeNewObj(interp, intObjPtr); + return JIM_ERR; + } + } + else { + + Jim_InvalidateStringRep(intObjPtr); + JimWideValue(intObjPtr) = wideValue + increment; + + if (argv[1]->typePtr != &variableObjType) { + + Jim_SetVariable(interp, argv[1], intObjPtr); + } + } + Jim_SetResult(interp, intObjPtr); + return JIM_OK; +} + + +#define JIM_EVAL_SARGV_LEN 8 +#define JIM_EVAL_SINTV_LEN 8 + + +static int JimUnknown(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int retcode; + + if (interp->unknown_called > 50) { + return JIM_ERR; + } + + + + if (Jim_GetCommand(interp, interp->unknown, JIM_NONE) == NULL) + return JIM_ERR; + + interp->unknown_called++; + + retcode = Jim_EvalObjPrefix(interp, interp->unknown, argc, argv); + interp->unknown_called--; + + return retcode; +} + +static int JimInvokeCommand(Jim_Interp *interp, int objc, Jim_Obj *const *objv) +{ + int retcode; + Jim_Cmd *cmdPtr; + +#if 0 + printf("invoke"); + int j; + for (j = 0; j < objc; j++) { + printf(" '%s'", Jim_String(objv[j])); + } + printf("\n"); +#endif + + if (interp->framePtr->tailcallCmd) { + + cmdPtr = interp->framePtr->tailcallCmd; + interp->framePtr->tailcallCmd = NULL; + } + else { + cmdPtr = Jim_GetCommand(interp, objv[0], JIM_ERRMSG); + if (cmdPtr == NULL) { + return JimUnknown(interp, objc, objv); + } + JimIncrCmdRefCount(cmdPtr); + } + + if (interp->evalDepth == interp->maxEvalDepth) { + Jim_SetResultString(interp, "Infinite eval recursion", -1); + retcode = JIM_ERR; + goto out; + } + interp->evalDepth++; + + + Jim_SetEmptyResult(interp); + if (cmdPtr->isproc) { + retcode = JimCallProcedure(interp, cmdPtr, objc, objv); + } + else { + interp->cmdPrivData = cmdPtr->u.native.privData; + retcode = cmdPtr->u.native.cmdProc(interp, objc, objv); + } + interp->evalDepth--; + +out: + JimDecrCmdRefCount(interp, cmdPtr); + + return retcode; +} + +int Jim_EvalObjVector(Jim_Interp *interp, int objc, Jim_Obj *const *objv) +{ + int i, retcode; + + + for (i = 0; i < objc; i++) + Jim_IncrRefCount(objv[i]); + + retcode = JimInvokeCommand(interp, objc, objv); + + + for (i = 0; i < objc; i++) + Jim_DecrRefCount(interp, objv[i]); + + return retcode; +} + +int Jim_EvalObjPrefix(Jim_Interp *interp, Jim_Obj *prefix, int objc, Jim_Obj *const *objv) +{ + int ret; + Jim_Obj **nargv = Jim_Alloc((objc + 1) * sizeof(*nargv)); + + nargv[0] = prefix; + memcpy(&nargv[1], &objv[0], sizeof(nargv[0]) * objc); + ret = Jim_EvalObjVector(interp, objc + 1, nargv); + Jim_Free(nargv); + return ret; +} + +static void JimAddErrorToStack(Jim_Interp *interp, ScriptObj *script) +{ + if (!interp->errorFlag) { + + interp->errorFlag = 1; + Jim_IncrRefCount(script->fileNameObj); + Jim_DecrRefCount(interp, interp->errorFileNameObj); + interp->errorFileNameObj = script->fileNameObj; + interp->errorLine = script->linenr; + + JimResetStackTrace(interp); + + interp->addStackTrace++; + } + + + if (interp->addStackTrace > 0) { + + + JimAppendStackTrace(interp, Jim_String(interp->errorProc), script->fileNameObj, script->linenr); + + if (Jim_Length(script->fileNameObj)) { + interp->addStackTrace = 0; + } + + Jim_DecrRefCount(interp, interp->errorProc); + interp->errorProc = interp->emptyObj; + Jim_IncrRefCount(interp->errorProc); + } +} + +static int JimSubstOneToken(Jim_Interp *interp, const ScriptToken *token, Jim_Obj **objPtrPtr) +{ + Jim_Obj *objPtr; + + switch (token->type) { + case JIM_TT_STR: + case JIM_TT_ESC: + objPtr = token->objPtr; + break; + case JIM_TT_VAR: + objPtr = Jim_GetVariable(interp, token->objPtr, JIM_ERRMSG); + break; + case JIM_TT_DICTSUGAR: + objPtr = JimExpandDictSugar(interp, token->objPtr); + break; + case JIM_TT_EXPRSUGAR: + objPtr = JimExpandExprSugar(interp, token->objPtr); + break; + case JIM_TT_CMD: + switch (Jim_EvalObj(interp, token->objPtr)) { + case JIM_OK: + case JIM_RETURN: + objPtr = interp->result; + break; + case JIM_BREAK: + + return JIM_BREAK; + case JIM_CONTINUE: + + return JIM_CONTINUE; + default: + return JIM_ERR; + } + break; + default: + JimPanic((1, + "default token type (%d) reached " "in Jim_SubstObj().", token->type)); + objPtr = NULL; + break; + } + if (objPtr) { + *objPtrPtr = objPtr; + return JIM_OK; + } + return JIM_ERR; +} + +static Jim_Obj *JimInterpolateTokens(Jim_Interp *interp, const ScriptToken * token, int tokens, int flags) +{ + int totlen = 0, i; + Jim_Obj **intv; + Jim_Obj *sintv[JIM_EVAL_SINTV_LEN]; + Jim_Obj *objPtr; + char *s; + + if (tokens <= JIM_EVAL_SINTV_LEN) + intv = sintv; + else + intv = Jim_Alloc(sizeof(Jim_Obj *) * tokens); + + for (i = 0; i < tokens; i++) { + switch (JimSubstOneToken(interp, &token[i], &intv[i])) { + case JIM_OK: + case JIM_RETURN: + break; + case JIM_BREAK: + if (flags & JIM_SUBST_FLAG) { + + tokens = i; + continue; + } + + + case JIM_CONTINUE: + if (flags & JIM_SUBST_FLAG) { + intv[i] = NULL; + continue; + } + + + default: + while (i--) { + Jim_DecrRefCount(interp, intv[i]); + } + if (intv != sintv) { + Jim_Free(intv); + } + return NULL; + } + Jim_IncrRefCount(intv[i]); + Jim_String(intv[i]); + totlen += intv[i]->length; + } + + + if (tokens == 1 && intv[0] && intv == sintv) { + Jim_DecrRefCount(interp, intv[0]); + return intv[0]; + } + + objPtr = Jim_NewStringObjNoAlloc(interp, NULL, 0); + + if (tokens == 4 && token[0].type == JIM_TT_ESC && token[1].type == JIM_TT_ESC + && token[2].type == JIM_TT_VAR) { + + objPtr->typePtr = &interpolatedObjType; + objPtr->internalRep.dictSubstValue.varNameObjPtr = token[0].objPtr; + objPtr->internalRep.dictSubstValue.indexObjPtr = intv[2]; + Jim_IncrRefCount(intv[2]); + } + else if (tokens && intv[0] && intv[0]->typePtr == &sourceObjType) { + + JimSetSourceInfo(interp, objPtr, intv[0]->internalRep.sourceValue.fileNameObj, intv[0]->internalRep.sourceValue.lineNumber); + } + + + s = objPtr->bytes = Jim_Alloc(totlen + 1); + objPtr->length = totlen; + for (i = 0; i < tokens; i++) { + if (intv[i]) { + memcpy(s, intv[i]->bytes, intv[i]->length); + s += intv[i]->length; + Jim_DecrRefCount(interp, intv[i]); + } + } + objPtr->bytes[totlen] = '\0'; + + if (intv != sintv) { + Jim_Free(intv); + } + + return objPtr; +} + + +static int JimEvalObjList(Jim_Interp *interp, Jim_Obj *listPtr) +{ + int retcode = JIM_OK; + + JimPanic((Jim_IsList(listPtr) == 0, "JimEvalObjList() invoked on non-list.")); + + if (listPtr->internalRep.listValue.len) { + Jim_IncrRefCount(listPtr); + retcode = JimInvokeCommand(interp, + listPtr->internalRep.listValue.len, + listPtr->internalRep.listValue.ele); + Jim_DecrRefCount(interp, listPtr); + } + return retcode; +} + +int Jim_EvalObjList(Jim_Interp *interp, Jim_Obj *listPtr) +{ + SetListFromAny(interp, listPtr); + return JimEvalObjList(interp, listPtr); +} + +int Jim_EvalObj(Jim_Interp *interp, Jim_Obj *scriptObjPtr) +{ + int i; + ScriptObj *script; + ScriptToken *token; + int retcode = JIM_OK; + Jim_Obj *sargv[JIM_EVAL_SARGV_LEN], **argv = NULL; + Jim_Obj *prevScriptObj; + + if (Jim_IsList(scriptObjPtr) && scriptObjPtr->bytes == NULL) { + return JimEvalObjList(interp, scriptObjPtr); + } + + Jim_IncrRefCount(scriptObjPtr); + script = JimGetScript(interp, scriptObjPtr); + if (!JimScriptValid(interp, script)) { + Jim_DecrRefCount(interp, scriptObjPtr); + return JIM_ERR; + } + + Jim_SetEmptyResult(interp); + + token = script->token; + +#ifdef JIM_OPTIMIZATION + if (script->len == 0) { + Jim_DecrRefCount(interp, scriptObjPtr); + return JIM_OK; + } + if (script->len == 3 + && token[1].objPtr->typePtr == &commandObjType + && token[1].objPtr->internalRep.cmdValue.cmdPtr->isproc == 0 + && token[1].objPtr->internalRep.cmdValue.cmdPtr->u.native.cmdProc == Jim_IncrCoreCommand + && token[2].objPtr->typePtr == &variableObjType) { + + Jim_Obj *objPtr = Jim_GetVariable(interp, token[2].objPtr, JIM_NONE); + + if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) { + JimWideValue(objPtr)++; + Jim_InvalidateStringRep(objPtr); + Jim_DecrRefCount(interp, scriptObjPtr); + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + } +#endif + + script->inUse++; + + + prevScriptObj = interp->currentScriptObj; + interp->currentScriptObj = scriptObjPtr; + + interp->errorFlag = 0; + argv = sargv; + + for (i = 0; i < script->len && retcode == JIM_OK; ) { + int argc; + int j; + + + argc = token[i].objPtr->internalRep.scriptLineValue.argc; + script->linenr = token[i].objPtr->internalRep.scriptLineValue.line; + + + if (argc > JIM_EVAL_SARGV_LEN) + argv = Jim_Alloc(sizeof(Jim_Obj *) * argc); + + + i++; + + for (j = 0; j < argc; j++) { + long wordtokens = 1; + int expand = 0; + Jim_Obj *wordObjPtr = NULL; + + if (token[i].type == JIM_TT_WORD) { + wordtokens = JimWideValue(token[i++].objPtr); + if (wordtokens < 0) { + expand = 1; + wordtokens = -wordtokens; + } + } + + if (wordtokens == 1) { + + switch (token[i].type) { + case JIM_TT_ESC: + case JIM_TT_STR: + wordObjPtr = token[i].objPtr; + break; + case JIM_TT_VAR: + wordObjPtr = Jim_GetVariable(interp, token[i].objPtr, JIM_ERRMSG); + break; + case JIM_TT_EXPRSUGAR: + wordObjPtr = JimExpandExprSugar(interp, token[i].objPtr); + break; + case JIM_TT_DICTSUGAR: + wordObjPtr = JimExpandDictSugar(interp, token[i].objPtr); + break; + case JIM_TT_CMD: + retcode = Jim_EvalObj(interp, token[i].objPtr); + if (retcode == JIM_OK) { + wordObjPtr = Jim_GetResult(interp); + } + break; + default: + JimPanic((1, "default token type reached " "in Jim_EvalObj().")); + } + } + else { + wordObjPtr = JimInterpolateTokens(interp, token + i, wordtokens, JIM_NONE); + } + + if (!wordObjPtr) { + if (retcode == JIM_OK) { + retcode = JIM_ERR; + } + break; + } + + Jim_IncrRefCount(wordObjPtr); + i += wordtokens; + + if (!expand) { + argv[j] = wordObjPtr; + } + else { + + int len = Jim_ListLength(interp, wordObjPtr); + int newargc = argc + len - 1; + int k; + + if (len > 1) { + if (argv == sargv) { + if (newargc > JIM_EVAL_SARGV_LEN) { + argv = Jim_Alloc(sizeof(*argv) * newargc); + memcpy(argv, sargv, sizeof(*argv) * j); + } + } + else { + + argv = Jim_Realloc(argv, sizeof(*argv) * newargc); + } + } + + + for (k = 0; k < len; k++) { + argv[j++] = wordObjPtr->internalRep.listValue.ele[k]; + Jim_IncrRefCount(wordObjPtr->internalRep.listValue.ele[k]); + } + + Jim_DecrRefCount(interp, wordObjPtr); + + + j--; + argc += len - 1; + } + } + + if (retcode == JIM_OK && argc) { + + retcode = JimInvokeCommand(interp, argc, argv); + + if (Jim_CheckSignal(interp)) { + retcode = JIM_SIGNAL; + } + } + + + while (j-- > 0) { + Jim_DecrRefCount(interp, argv[j]); + } + + if (argv != sargv) { + Jim_Free(argv); + argv = sargv; + } + } + + + if (retcode == JIM_ERR) { + JimAddErrorToStack(interp, script); + } + + else if (retcode != JIM_RETURN || interp->returnCode != JIM_ERR) { + + interp->addStackTrace = 0; + } + + + interp->currentScriptObj = prevScriptObj; + + Jim_FreeIntRep(interp, scriptObjPtr); + scriptObjPtr->typePtr = &scriptObjType; + Jim_SetIntRepPtr(scriptObjPtr, script); + Jim_DecrRefCount(interp, scriptObjPtr); + + return retcode; +} + +static int JimSetProcArg(Jim_Interp *interp, Jim_Obj *argNameObj, Jim_Obj *argValObj) +{ + int retcode; + + const char *varname = Jim_String(argNameObj); + if (*varname == '&') { + + Jim_Obj *objPtr; + Jim_CallFrame *savedCallFrame = interp->framePtr; + + interp->framePtr = interp->framePtr->parent; + objPtr = Jim_GetVariable(interp, argValObj, JIM_ERRMSG); + interp->framePtr = savedCallFrame; + if (!objPtr) { + return JIM_ERR; + } + + + objPtr = Jim_NewStringObj(interp, varname + 1, -1); + Jim_IncrRefCount(objPtr); + retcode = Jim_SetVariableLink(interp, objPtr, argValObj, interp->framePtr->parent); + Jim_DecrRefCount(interp, objPtr); + } + else { + retcode = Jim_SetVariable(interp, argNameObj, argValObj); + } + return retcode; +} + +static void JimSetProcWrongArgs(Jim_Interp *interp, Jim_Obj *procNameObj, Jim_Cmd *cmd) +{ + + Jim_Obj *argmsg = Jim_NewStringObj(interp, "", 0); + int i; + + for (i = 0; i < cmd->u.proc.argListLen; i++) { + Jim_AppendString(interp, argmsg, " ", 1); + + if (i == cmd->u.proc.argsPos) { + if (cmd->u.proc.arglist[i].defaultObjPtr) { + + Jim_AppendString(interp, argmsg, "?", 1); + Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].defaultObjPtr); + Jim_AppendString(interp, argmsg, " ...?", -1); + } + else { + + Jim_AppendString(interp, argmsg, "?arg...?", -1); + } + } + else { + if (cmd->u.proc.arglist[i].defaultObjPtr) { + Jim_AppendString(interp, argmsg, "?", 1); + Jim_AppendObj(interp, argmsg, cmd->u.proc.arglist[i].nameObjPtr); + Jim_AppendString(interp, argmsg, "?", 1); + } + else { + const char *arg = Jim_String(cmd->u.proc.arglist[i].nameObjPtr); + if (*arg == '&') { + arg++; + } + Jim_AppendString(interp, argmsg, arg, -1); + } + } + } + Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s%#s\"", procNameObj, argmsg); + Jim_FreeNewObj(interp, argmsg); +} + +#ifdef jim_ext_namespace +int Jim_EvalNamespace(Jim_Interp *interp, Jim_Obj *scriptObj, Jim_Obj *nsObj) +{ + Jim_CallFrame *callFramePtr; + int retcode; + + + callFramePtr = JimCreateCallFrame(interp, interp->framePtr, nsObj); + callFramePtr->argv = &interp->emptyObj; + callFramePtr->argc = 0; + callFramePtr->procArgsObjPtr = NULL; + callFramePtr->procBodyObjPtr = scriptObj; + callFramePtr->staticVars = NULL; + callFramePtr->fileNameObj = interp->emptyObj; + callFramePtr->line = 0; + Jim_IncrRefCount(scriptObj); + interp->framePtr = callFramePtr; + + + if (interp->framePtr->level == interp->maxCallFrameDepth) { + Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1); + retcode = JIM_ERR; + } + else { + + retcode = Jim_EvalObj(interp, scriptObj); + } + + + interp->framePtr = interp->framePtr->parent; + JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE); + + return retcode; +} +#endif + +static int JimCallProcedure(Jim_Interp *interp, Jim_Cmd *cmd, int argc, Jim_Obj *const *argv) +{ + Jim_CallFrame *callFramePtr; + int i, d, retcode, optargs; + ScriptObj *script; + + + if (argc - 1 < cmd->u.proc.reqArity || + (cmd->u.proc.argsPos < 0 && argc - 1 > cmd->u.proc.reqArity + cmd->u.proc.optArity)) { + JimSetProcWrongArgs(interp, argv[0], cmd); + return JIM_ERR; + } + + if (Jim_Length(cmd->u.proc.bodyObjPtr) == 0) { + + return JIM_OK; + } + + + if (interp->framePtr->level == interp->maxCallFrameDepth) { + Jim_SetResultString(interp, "Too many nested calls. Infinite recursion?", -1); + return JIM_ERR; + } + + + callFramePtr = JimCreateCallFrame(interp, interp->framePtr, cmd->u.proc.nsObj); + callFramePtr->argv = argv; + callFramePtr->argc = argc; + callFramePtr->procArgsObjPtr = cmd->u.proc.argListObjPtr; + callFramePtr->procBodyObjPtr = cmd->u.proc.bodyObjPtr; + callFramePtr->staticVars = cmd->u.proc.staticVars; + + + script = JimGetScript(interp, interp->currentScriptObj); + callFramePtr->fileNameObj = script->fileNameObj; + callFramePtr->line = script->linenr; + + Jim_IncrRefCount(cmd->u.proc.argListObjPtr); + Jim_IncrRefCount(cmd->u.proc.bodyObjPtr); + interp->framePtr = callFramePtr; + + + optargs = (argc - 1 - cmd->u.proc.reqArity); + + + i = 1; + for (d = 0; d < cmd->u.proc.argListLen; d++) { + Jim_Obj *nameObjPtr = cmd->u.proc.arglist[d].nameObjPtr; + if (d == cmd->u.proc.argsPos) { + + Jim_Obj *listObjPtr; + int argsLen = 0; + if (cmd->u.proc.reqArity + cmd->u.proc.optArity < argc - 1) { + argsLen = argc - 1 - (cmd->u.proc.reqArity + cmd->u.proc.optArity); + } + listObjPtr = Jim_NewListObj(interp, &argv[i], argsLen); + + + if (cmd->u.proc.arglist[d].defaultObjPtr) { + nameObjPtr =cmd->u.proc.arglist[d].defaultObjPtr; + } + retcode = Jim_SetVariable(interp, nameObjPtr, listObjPtr); + if (retcode != JIM_OK) { + goto badargset; + } + + i += argsLen; + continue; + } + + + if (cmd->u.proc.arglist[d].defaultObjPtr == NULL || optargs-- > 0) { + retcode = JimSetProcArg(interp, nameObjPtr, argv[i++]); + } + else { + + retcode = Jim_SetVariable(interp, nameObjPtr, cmd->u.proc.arglist[d].defaultObjPtr); + } + if (retcode != JIM_OK) { + goto badargset; + } + } + + + retcode = Jim_EvalObj(interp, cmd->u.proc.bodyObjPtr); + +badargset: + + + interp->framePtr = interp->framePtr->parent; + JimFreeCallFrame(interp, callFramePtr, JIM_FCF_REUSE); + + + if (interp->framePtr->tailcallObj) { + do { + Jim_Obj *tailcallObj = interp->framePtr->tailcallObj; + + interp->framePtr->tailcallObj = NULL; + + if (retcode == JIM_EVAL) { + retcode = Jim_EvalObjList(interp, tailcallObj); + if (retcode == JIM_RETURN) { + interp->returnLevel++; + } + } + Jim_DecrRefCount(interp, tailcallObj); + } while (interp->framePtr->tailcallObj); + + + if (interp->framePtr->tailcallCmd) { + JimDecrCmdRefCount(interp, interp->framePtr->tailcallCmd); + interp->framePtr->tailcallCmd = NULL; + } + } + + + if (retcode == JIM_RETURN) { + if (--interp->returnLevel <= 0) { + retcode = interp->returnCode; + interp->returnCode = JIM_OK; + interp->returnLevel = 0; + } + } + else if (retcode == JIM_ERR) { + interp->addStackTrace++; + Jim_DecrRefCount(interp, interp->errorProc); + interp->errorProc = argv[0]; + Jim_IncrRefCount(interp->errorProc); + } + + return retcode; +} + +int Jim_EvalSource(Jim_Interp *interp, const char *filename, int lineno, const char *script) +{ + int retval; + Jim_Obj *scriptObjPtr; + + scriptObjPtr = Jim_NewStringObj(interp, script, -1); + Jim_IncrRefCount(scriptObjPtr); + + if (filename) { + Jim_Obj *prevScriptObj; + + JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), lineno); + + prevScriptObj = interp->currentScriptObj; + interp->currentScriptObj = scriptObjPtr; + + retval = Jim_EvalObj(interp, scriptObjPtr); + + interp->currentScriptObj = prevScriptObj; + } + else { + retval = Jim_EvalObj(interp, scriptObjPtr); + } + Jim_DecrRefCount(interp, scriptObjPtr); + return retval; +} + +int Jim_Eval(Jim_Interp *interp, const char *script) +{ + return Jim_EvalObj(interp, Jim_NewStringObj(interp, script, -1)); +} + + +int Jim_EvalGlobal(Jim_Interp *interp, const char *script) +{ + int retval; + Jim_CallFrame *savedFramePtr = interp->framePtr; + + interp->framePtr = interp->topFramePtr; + retval = Jim_Eval(interp, script); + interp->framePtr = savedFramePtr; + + return retval; +} + +int Jim_EvalFileGlobal(Jim_Interp *interp, const char *filename) +{ + int retval; + Jim_CallFrame *savedFramePtr = interp->framePtr; + + interp->framePtr = interp->topFramePtr; + retval = Jim_EvalFile(interp, filename); + interp->framePtr = savedFramePtr; + + return retval; +} + +#include + +int Jim_EvalFile(Jim_Interp *interp, const char *filename) +{ + FILE *fp; + char *buf; + Jim_Obj *scriptObjPtr; + Jim_Obj *prevScriptObj; + struct stat sb; + int retcode; + int readlen; + + if (stat(filename, &sb) != 0 || (fp = fopen(filename, "rt")) == NULL) { + Jim_SetResultFormatted(interp, "couldn't read file \"%s\": %s", filename, strerror(errno)); + return JIM_ERR; + } + if (sb.st_size == 0) { + fclose(fp); + return JIM_OK; + } + + buf = Jim_Alloc(sb.st_size + 1); + readlen = fread(buf, 1, sb.st_size, fp); + if (ferror(fp)) { + fclose(fp); + Jim_Free(buf); + Jim_SetResultFormatted(interp, "failed to load file \"%s\": %s", filename, strerror(errno)); + return JIM_ERR; + } + fclose(fp); + buf[readlen] = 0; + + scriptObjPtr = Jim_NewStringObjNoAlloc(interp, buf, readlen); + JimSetSourceInfo(interp, scriptObjPtr, Jim_NewStringObj(interp, filename, -1), 1); + Jim_IncrRefCount(scriptObjPtr); + + prevScriptObj = interp->currentScriptObj; + interp->currentScriptObj = scriptObjPtr; + + retcode = Jim_EvalObj(interp, scriptObjPtr); + + + if (retcode == JIM_RETURN) { + if (--interp->returnLevel <= 0) { + retcode = interp->returnCode; + interp->returnCode = JIM_OK; + interp->returnLevel = 0; + } + } + if (retcode == JIM_ERR) { + + interp->addStackTrace++; + } + + interp->currentScriptObj = prevScriptObj; + + Jim_DecrRefCount(interp, scriptObjPtr); + + return retcode; +} + +static void JimParseSubst(struct JimParserCtx *pc, int flags) +{ + pc->tstart = pc->p; + pc->tline = pc->linenr; + + if (pc->len == 0) { + pc->tend = pc->p; + pc->tt = JIM_TT_EOL; + pc->eof = 1; + return; + } + if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) { + JimParseCmd(pc); + return; + } + if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) { + if (JimParseVar(pc) == JIM_OK) { + return; + } + + pc->tstart = pc->p; + flags |= JIM_SUBST_NOVAR; + } + while (pc->len) { + if (*pc->p == '$' && !(flags & JIM_SUBST_NOVAR)) { + break; + } + if (*pc->p == '[' && !(flags & JIM_SUBST_NOCMD)) { + break; + } + if (*pc->p == '\\' && pc->len > 1) { + pc->p++; + pc->len--; + } + pc->p++; + pc->len--; + } + pc->tend = pc->p - 1; + pc->tt = (flags & JIM_SUBST_NOESC) ? JIM_TT_STR : JIM_TT_ESC; +} + + +static int SetSubstFromAny(Jim_Interp *interp, struct Jim_Obj *objPtr, int flags) +{ + int scriptTextLen; + const char *scriptText = Jim_GetString(objPtr, &scriptTextLen); + struct JimParserCtx parser; + struct ScriptObj *script = Jim_Alloc(sizeof(*script)); + ParseTokenList tokenlist; + + + ScriptTokenListInit(&tokenlist); + + JimParserInit(&parser, scriptText, scriptTextLen, 1); + while (1) { + JimParseSubst(&parser, flags); + if (parser.eof) { + + break; + } + ScriptAddToken(&tokenlist, parser.tstart, parser.tend - parser.tstart + 1, parser.tt, + parser.tline); + } + + + script->inUse = 1; + script->substFlags = flags; + script->fileNameObj = interp->emptyObj; + Jim_IncrRefCount(script->fileNameObj); + SubstObjAddTokens(interp, script, &tokenlist); + + + ScriptTokenListFree(&tokenlist); + +#ifdef DEBUG_SHOW_SUBST + { + int i; + + printf("==== Subst ====\n"); + for (i = 0; i < script->len; i++) { + printf("[%2d] %s '%s'\n", i, jim_tt_name(script->token[i].type), + Jim_String(script->token[i].objPtr)); + } + } +#endif + + + Jim_FreeIntRep(interp, objPtr); + Jim_SetIntRepPtr(objPtr, script); + objPtr->typePtr = &scriptObjType; + return JIM_OK; +} + +static ScriptObj *Jim_GetSubst(Jim_Interp *interp, Jim_Obj *objPtr, int flags) +{ + if (objPtr->typePtr != &scriptObjType || ((ScriptObj *)Jim_GetIntRepPtr(objPtr))->substFlags != flags) + SetSubstFromAny(interp, objPtr, flags); + return (ScriptObj *) Jim_GetIntRepPtr(objPtr); +} + +int Jim_SubstObj(Jim_Interp *interp, Jim_Obj *substObjPtr, Jim_Obj **resObjPtrPtr, int flags) +{ + ScriptObj *script = Jim_GetSubst(interp, substObjPtr, flags); + + Jim_IncrRefCount(substObjPtr); + script->inUse++; + + *resObjPtrPtr = JimInterpolateTokens(interp, script->token, script->len, flags); + + script->inUse--; + Jim_DecrRefCount(interp, substObjPtr); + if (*resObjPtrPtr == NULL) { + return JIM_ERR; + } + return JIM_OK; +} + +void Jim_WrongNumArgs(Jim_Interp *interp, int argc, Jim_Obj *const *argv, const char *msg) +{ + Jim_Obj *objPtr; + Jim_Obj *listObjPtr = Jim_NewListObj(interp, argv, argc); + + if (*msg) { + Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, msg, -1)); + } + Jim_IncrRefCount(listObjPtr); + objPtr = Jim_ListJoin(interp, listObjPtr, " ", 1); + Jim_DecrRefCount(interp, listObjPtr); + + Jim_IncrRefCount(objPtr); + Jim_SetResultFormatted(interp, "wrong # args: should be \"%#s\"", objPtr); + Jim_DecrRefCount(interp, objPtr); +} + +typedef void JimHashtableIteratorCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, + Jim_HashEntry *he, int type); + +#define JimTrivialMatch(pattern) (strpbrk((pattern), "*[?\\") == NULL) + +static Jim_Obj *JimHashtablePatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr, + JimHashtableIteratorCallbackType *callback, int type) +{ + Jim_HashEntry *he; + Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0); + + + if (patternObjPtr && JimTrivialMatch(Jim_String(patternObjPtr))) { + he = Jim_FindHashEntry(ht, Jim_String(patternObjPtr)); + if (he) { + callback(interp, listObjPtr, he, type); + } + } + else { + Jim_HashTableIterator htiter; + JimInitHashTableIterator(ht, &htiter); + while ((he = Jim_NextHashEntry(&htiter)) != NULL) { + if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), he->key, 0)) { + callback(interp, listObjPtr, he, type); + } + } + } + return listObjPtr; +} + + +#define JIM_CMDLIST_COMMANDS 0 +#define JIM_CMDLIST_PROCS 1 +#define JIM_CMDLIST_CHANNELS 2 + +static void JimCommandMatch(Jim_Interp *interp, Jim_Obj *listObjPtr, + Jim_HashEntry *he, int type) +{ + Jim_Cmd *cmdPtr = Jim_GetHashEntryVal(he); + Jim_Obj *objPtr; + + if (type == JIM_CMDLIST_PROCS && !cmdPtr->isproc) { + + return; + } + + objPtr = Jim_NewStringObj(interp, he->key, -1); + Jim_IncrRefCount(objPtr); + + if (type != JIM_CMDLIST_CHANNELS || Jim_AioFilehandle(interp, objPtr)) { + Jim_ListAppendElement(interp, listObjPtr, objPtr); + } + Jim_DecrRefCount(interp, objPtr); +} + + +static Jim_Obj *JimCommandsList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int type) +{ + return JimHashtablePatternMatch(interp, &interp->commands, patternObjPtr, JimCommandMatch, type); +} + + +#define JIM_VARLIST_GLOBALS 0 +#define JIM_VARLIST_LOCALS 1 +#define JIM_VARLIST_VARS 2 + +#define JIM_VARLIST_VALUES 0x1000 + +static void JimVariablesMatch(Jim_Interp *interp, Jim_Obj *listObjPtr, + Jim_HashEntry *he, int type) +{ + Jim_Var *varPtr = Jim_GetHashEntryVal(he); + + if (type != JIM_VARLIST_LOCALS || varPtr->linkFramePtr == NULL) { + Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, he->key, -1)); + if (type & JIM_VARLIST_VALUES) { + Jim_ListAppendElement(interp, listObjPtr, varPtr->objPtr); + } + } +} + + +static Jim_Obj *JimVariablesList(Jim_Interp *interp, Jim_Obj *patternObjPtr, int mode) +{ + if (mode == JIM_VARLIST_LOCALS && interp->framePtr == interp->topFramePtr) { + return interp->emptyObj; + } + else { + Jim_CallFrame *framePtr = (mode == JIM_VARLIST_GLOBALS) ? interp->topFramePtr : interp->framePtr; + return JimHashtablePatternMatch(interp, &framePtr->vars, patternObjPtr, JimVariablesMatch, mode); + } +} + +static int JimInfoLevel(Jim_Interp *interp, Jim_Obj *levelObjPtr, + Jim_Obj **objPtrPtr, int info_level_cmd) +{ + Jim_CallFrame *targetCallFrame; + + targetCallFrame = JimGetCallFrameByInteger(interp, levelObjPtr); + if (targetCallFrame == NULL) { + return JIM_ERR; + } + + if (targetCallFrame == interp->topFramePtr) { + Jim_SetResultFormatted(interp, "bad level \"%#s\"", levelObjPtr); + return JIM_ERR; + } + if (info_level_cmd) { + *objPtrPtr = Jim_NewListObj(interp, targetCallFrame->argv, targetCallFrame->argc); + } + else { + Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0); + + Jim_ListAppendElement(interp, listObj, targetCallFrame->argv[0]); + Jim_ListAppendElement(interp, listObj, targetCallFrame->fileNameObj); + Jim_ListAppendElement(interp, listObj, Jim_NewIntObj(interp, targetCallFrame->line)); + *objPtrPtr = listObj; + } + return JIM_OK; +} + + + +static int Jim_PutsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "?-nonewline? string"); + return JIM_ERR; + } + if (argc == 3) { + if (!Jim_CompareStringImmediate(interp, argv[1], "-nonewline")) { + Jim_SetResultString(interp, "The second argument must " "be -nonewline", -1); + return JIM_ERR; + } + else { + fputs(Jim_String(argv[2]), stdout); + } + } + else { + puts(Jim_String(argv[1])); + } + return JIM_OK; +} + + +static int JimAddMulHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op) +{ + jim_wide wideValue, res; + double doubleValue, doubleRes; + int i; + + res = (op == JIM_EXPROP_ADD) ? 0 : 1; + + for (i = 1; i < argc; i++) { + if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) + goto trydouble; + if (op == JIM_EXPROP_ADD) + res += wideValue; + else + res *= wideValue; + } + Jim_SetResultInt(interp, res); + return JIM_OK; + trydouble: + doubleRes = (double)res; + for (; i < argc; i++) { + if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK) + return JIM_ERR; + if (op == JIM_EXPROP_ADD) + doubleRes += doubleValue; + else + doubleRes *= doubleValue; + } + Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes)); + return JIM_OK; +} + + +static int JimSubDivHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int op) +{ + jim_wide wideValue, res = 0; + double doubleValue, doubleRes = 0; + int i = 2; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "number ?number ... number?"); + return JIM_ERR; + } + else if (argc == 2) { + if (Jim_GetWide(interp, argv[1], &wideValue) != JIM_OK) { + if (Jim_GetDouble(interp, argv[1], &doubleValue) != JIM_OK) { + return JIM_ERR; + } + else { + if (op == JIM_EXPROP_SUB) + doubleRes = -doubleValue; + else + doubleRes = 1.0 / doubleValue; + Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes)); + return JIM_OK; + } + } + if (op == JIM_EXPROP_SUB) { + res = -wideValue; + Jim_SetResultInt(interp, res); + } + else { + doubleRes = 1.0 / wideValue; + Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes)); + } + return JIM_OK; + } + else { + if (Jim_GetWide(interp, argv[1], &res) != JIM_OK) { + if (Jim_GetDouble(interp, argv[1], &doubleRes) + != JIM_OK) { + return JIM_ERR; + } + else { + goto trydouble; + } + } + } + for (i = 2; i < argc; i++) { + if (Jim_GetWide(interp, argv[i], &wideValue) != JIM_OK) { + doubleRes = (double)res; + goto trydouble; + } + if (op == JIM_EXPROP_SUB) + res -= wideValue; + else + res /= wideValue; + } + Jim_SetResultInt(interp, res); + return JIM_OK; + trydouble: + for (; i < argc; i++) { + if (Jim_GetDouble(interp, argv[i], &doubleValue) != JIM_OK) + return JIM_ERR; + if (op == JIM_EXPROP_SUB) + doubleRes -= doubleValue; + else + doubleRes /= doubleValue; + } + Jim_SetResult(interp, Jim_NewDoubleObj(interp, doubleRes)); + return JIM_OK; +} + + + +static int Jim_AddCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_ADD); +} + + +static int Jim_MulCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return JimAddMulHelper(interp, argc, argv, JIM_EXPROP_MUL); +} + + +static int Jim_SubCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_SUB); +} + + +static int Jim_DivCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return JimSubDivHelper(interp, argc, argv, JIM_EXPROP_DIV); +} + + +static int Jim_SetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "varName ?newValue?"); + return JIM_ERR; + } + if (argc == 2) { + Jim_Obj *objPtr; + + objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG); + if (!objPtr) + return JIM_ERR; + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + + if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK) + return JIM_ERR; + Jim_SetResult(interp, argv[2]); + return JIM_OK; +} + +static int Jim_UnsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i = 1; + int complain = 1; + + while (i < argc) { + if (Jim_CompareStringImmediate(interp, argv[i], "--")) { + i++; + break; + } + if (Jim_CompareStringImmediate(interp, argv[i], "-nocomplain")) { + complain = 0; + i++; + continue; + } + break; + } + + while (i < argc) { + if (Jim_UnsetVariable(interp, argv[i], complain ? JIM_ERRMSG : JIM_NONE) != JIM_OK + && complain) { + return JIM_ERR; + } + i++; + } + return JIM_OK; +} + + +static int Jim_WhileCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "condition body"); + return JIM_ERR; + } + + + while (1) { + int boolean, retval; + + if ((retval = Jim_GetBoolFromExpr(interp, argv[1], &boolean)) != JIM_OK) + return retval; + if (!boolean) + break; + + if ((retval = Jim_EvalObj(interp, argv[2])) != JIM_OK) { + switch (retval) { + case JIM_BREAK: + goto out; + break; + case JIM_CONTINUE: + continue; + break; + default: + return retval; + } + } + } + out: + Jim_SetEmptyResult(interp); + return JIM_OK; +} + + +static int Jim_ForCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int retval; + int boolean = 1; + Jim_Obj *varNamePtr = NULL; + Jim_Obj *stopVarNamePtr = NULL; + + if (argc != 5) { + Jim_WrongNumArgs(interp, 1, argv, "start test next body"); + return JIM_ERR; + } + + + if ((retval = Jim_EvalObj(interp, argv[1])) != JIM_OK) { + return retval; + } + + retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean); + + +#ifdef JIM_OPTIMIZATION + if (retval == JIM_OK && boolean) { + ScriptObj *incrScript; + ExprByteCode *expr; + jim_wide stop, currentVal; + Jim_Obj *objPtr; + int cmpOffset; + + + expr = JimGetExpression(interp, argv[2]); + incrScript = JimGetScript(interp, argv[3]); + + + if (incrScript == NULL || incrScript->len != 3 || !expr || expr->len != 3) { + goto evalstart; + } + + if (incrScript->token[1].type != JIM_TT_ESC || + expr->token[0].type != JIM_TT_VAR || + (expr->token[1].type != JIM_TT_EXPR_INT && expr->token[1].type != JIM_TT_VAR)) { + goto evalstart; + } + + if (expr->token[2].type == JIM_EXPROP_LT) { + cmpOffset = 0; + } + else if (expr->token[2].type == JIM_EXPROP_LTE) { + cmpOffset = 1; + } + else { + goto evalstart; + } + + + if (!Jim_CompareStringImmediate(interp, incrScript->token[1].objPtr, "incr")) { + goto evalstart; + } + + + if (!Jim_StringEqObj(incrScript->token[2].objPtr, expr->token[0].objPtr)) { + goto evalstart; + } + + + if (expr->token[1].type == JIM_TT_EXPR_INT) { + if (Jim_GetWide(interp, expr->token[1].objPtr, &stop) == JIM_ERR) { + goto evalstart; + } + } + else { + stopVarNamePtr = expr->token[1].objPtr; + Jim_IncrRefCount(stopVarNamePtr); + + stop = 0; + } + + + varNamePtr = expr->token[0].objPtr; + Jim_IncrRefCount(varNamePtr); + + objPtr = Jim_GetVariable(interp, varNamePtr, JIM_NONE); + if (objPtr == NULL || Jim_GetWide(interp, objPtr, ¤tVal) != JIM_OK) { + goto testcond; + } + + + while (retval == JIM_OK) { + + + + + if (stopVarNamePtr) { + objPtr = Jim_GetVariable(interp, stopVarNamePtr, JIM_NONE); + if (objPtr == NULL || Jim_GetWide(interp, objPtr, &stop) != JIM_OK) { + goto testcond; + } + } + + if (currentVal >= stop + cmpOffset) { + break; + } + + + retval = Jim_EvalObj(interp, argv[4]); + if (retval == JIM_OK || retval == JIM_CONTINUE) { + retval = JIM_OK; + + objPtr = Jim_GetVariable(interp, varNamePtr, JIM_ERRMSG); + + + if (objPtr == NULL) { + retval = JIM_ERR; + goto out; + } + if (!Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) { + currentVal = ++JimWideValue(objPtr); + Jim_InvalidateStringRep(objPtr); + } + else { + if (Jim_GetWide(interp, objPtr, ¤tVal) != JIM_OK || + Jim_SetVariable(interp, varNamePtr, Jim_NewIntObj(interp, + ++currentVal)) != JIM_OK) { + goto evalnext; + } + } + } + } + goto out; + } + evalstart: +#endif + + while (boolean && (retval == JIM_OK || retval == JIM_CONTINUE)) { + + retval = Jim_EvalObj(interp, argv[4]); + + if (retval == JIM_OK || retval == JIM_CONTINUE) { + + evalnext: + retval = Jim_EvalObj(interp, argv[3]); + if (retval == JIM_OK || retval == JIM_CONTINUE) { + + testcond: + retval = Jim_GetBoolFromExpr(interp, argv[2], &boolean); + } + } + } + out: + if (stopVarNamePtr) { + Jim_DecrRefCount(interp, stopVarNamePtr); + } + if (varNamePtr) { + Jim_DecrRefCount(interp, varNamePtr); + } + + if (retval == JIM_CONTINUE || retval == JIM_BREAK || retval == JIM_OK) { + Jim_SetEmptyResult(interp); + return JIM_OK; + } + + return retval; +} + + +static int Jim_LoopCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int retval; + jim_wide i; + jim_wide limit; + jim_wide incr = 1; + Jim_Obj *bodyObjPtr; + + if (argc != 5 && argc != 6) { + Jim_WrongNumArgs(interp, 1, argv, "var first limit ?incr? body"); + return JIM_ERR; + } + + if (Jim_GetWide(interp, argv[2], &i) != JIM_OK || + Jim_GetWide(interp, argv[3], &limit) != JIM_OK || + (argc == 6 && Jim_GetWide(interp, argv[4], &incr) != JIM_OK)) { + return JIM_ERR; + } + bodyObjPtr = (argc == 5) ? argv[4] : argv[5]; + + retval = Jim_SetVariable(interp, argv[1], argv[2]); + + while (((i < limit && incr > 0) || (i > limit && incr < 0)) && retval == JIM_OK) { + retval = Jim_EvalObj(interp, bodyObjPtr); + if (retval == JIM_OK || retval == JIM_CONTINUE) { + Jim_Obj *objPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG); + + retval = JIM_OK; + + + i += incr; + + if (objPtr && !Jim_IsShared(objPtr) && objPtr->typePtr == &intObjType) { + if (argv[1]->typePtr != &variableObjType) { + if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) { + return JIM_ERR; + } + } + JimWideValue(objPtr) = i; + Jim_InvalidateStringRep(objPtr); + + if (argv[1]->typePtr != &variableObjType) { + if (Jim_SetVariable(interp, argv[1], objPtr) != JIM_OK) { + retval = JIM_ERR; + break; + } + } + } + else { + objPtr = Jim_NewIntObj(interp, i); + retval = Jim_SetVariable(interp, argv[1], objPtr); + if (retval != JIM_OK) { + Jim_FreeNewObj(interp, objPtr); + } + } + } + } + + if (retval == JIM_OK || retval == JIM_CONTINUE || retval == JIM_BREAK) { + Jim_SetEmptyResult(interp); + return JIM_OK; + } + return retval; +} + +typedef struct { + Jim_Obj *objPtr; + int idx; +} Jim_ListIter; + +static void JimListIterInit(Jim_ListIter *iter, Jim_Obj *objPtr) +{ + iter->objPtr = objPtr; + iter->idx = 0; +} + +static Jim_Obj *JimListIterNext(Jim_Interp *interp, Jim_ListIter *iter) +{ + if (iter->idx >= Jim_ListLength(interp, iter->objPtr)) { + return NULL; + } + return iter->objPtr->internalRep.listValue.ele[iter->idx++]; +} + +static int JimListIterDone(Jim_Interp *interp, Jim_ListIter *iter) +{ + return iter->idx >= Jim_ListLength(interp, iter->objPtr); +} + + +static int JimForeachMapHelper(Jim_Interp *interp, int argc, Jim_Obj *const *argv, int doMap) +{ + int result = JIM_OK; + int i, numargs; + Jim_ListIter twoiters[2]; + Jim_ListIter *iters; + Jim_Obj *script; + Jim_Obj *resultObj; + + if (argc < 4 || argc % 2 != 0) { + Jim_WrongNumArgs(interp, 1, argv, "varList list ?varList list ...? script"); + return JIM_ERR; + } + script = argv[argc - 1]; + numargs = (argc - 1 - 1); + + if (numargs == 2) { + iters = twoiters; + } + else { + iters = Jim_Alloc(numargs * sizeof(*iters)); + } + for (i = 0; i < numargs; i++) { + JimListIterInit(&iters[i], argv[i + 1]); + if (i % 2 == 0 && JimListIterDone(interp, &iters[i])) { + result = JIM_ERR; + } + } + if (result != JIM_OK) { + Jim_SetResultString(interp, "foreach varlist is empty", -1); + return result; + } + + if (doMap) { + resultObj = Jim_NewListObj(interp, NULL, 0); + } + else { + resultObj = interp->emptyObj; + } + Jim_IncrRefCount(resultObj); + + while (1) { + + for (i = 0; i < numargs; i += 2) { + if (!JimListIterDone(interp, &iters[i + 1])) { + break; + } + } + if (i == numargs) { + + break; + } + + + for (i = 0; i < numargs; i += 2) { + Jim_Obj *varName; + + + JimListIterInit(&iters[i], argv[i + 1]); + while ((varName = JimListIterNext(interp, &iters[i])) != NULL) { + Jim_Obj *valObj = JimListIterNext(interp, &iters[i + 1]); + if (!valObj) { + + valObj = interp->emptyObj; + } + + Jim_IncrRefCount(valObj); + result = Jim_SetVariable(interp, varName, valObj); + Jim_DecrRefCount(interp, valObj); + if (result != JIM_OK) { + goto err; + } + } + } + switch (result = Jim_EvalObj(interp, script)) { + case JIM_OK: + if (doMap) { + Jim_ListAppendElement(interp, resultObj, interp->result); + } + break; + case JIM_CONTINUE: + break; + case JIM_BREAK: + goto out; + default: + goto err; + } + } + out: + result = JIM_OK; + Jim_SetResult(interp, resultObj); + err: + Jim_DecrRefCount(interp, resultObj); + if (numargs > 2) { + Jim_Free(iters); + } + return result; +} + + +static int Jim_ForeachCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return JimForeachMapHelper(interp, argc, argv, 0); +} + + +static int Jim_LmapCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + return JimForeachMapHelper(interp, argc, argv, 1); +} + + +static int Jim_LassignCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int result = JIM_ERR; + int i; + Jim_ListIter iter; + Jim_Obj *resultObj; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "varList list ?varName ...?"); + return JIM_ERR; + } + + JimListIterInit(&iter, argv[1]); + + for (i = 2; i < argc; i++) { + Jim_Obj *valObj = JimListIterNext(interp, &iter); + result = Jim_SetVariable(interp, argv[i], valObj ? valObj : interp->emptyObj); + if (result != JIM_OK) { + return result; + } + } + + resultObj = Jim_NewListObj(interp, NULL, 0); + while (!JimListIterDone(interp, &iter)) { + Jim_ListAppendElement(interp, resultObj, JimListIterNext(interp, &iter)); + } + + Jim_SetResult(interp, resultObj); + + return JIM_OK; +} + + +static int Jim_IfCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int boolean, retval, current = 1, falsebody = 0; + + if (argc >= 3) { + while (1) { + + if (current >= argc) + goto err; + if ((retval = Jim_GetBoolFromExpr(interp, argv[current++], &boolean)) + != JIM_OK) + return retval; + + if (current >= argc) + goto err; + if (Jim_CompareStringImmediate(interp, argv[current], "then")) + current++; + + if (current >= argc) + goto err; + if (boolean) + return Jim_EvalObj(interp, argv[current]); + + if (++current >= argc) { + Jim_SetResult(interp, Jim_NewEmptyStringObj(interp)); + return JIM_OK; + } + falsebody = current++; + if (Jim_CompareStringImmediate(interp, argv[falsebody], "else")) { + + if (current != argc - 1) + goto err; + return Jim_EvalObj(interp, argv[current]); + } + else if (Jim_CompareStringImmediate(interp, argv[falsebody], "elseif")) + continue; + + else if (falsebody != argc - 1) + goto err; + return Jim_EvalObj(interp, argv[falsebody]); + } + return JIM_OK; + } + err: + Jim_WrongNumArgs(interp, 1, argv, "condition ?then? trueBody ?elseif ...? ?else? falseBody"); + return JIM_ERR; +} + + + +int Jim_CommandMatchObj(Jim_Interp *interp, Jim_Obj *commandObj, Jim_Obj *patternObj, + Jim_Obj *stringObj, int nocase) +{ + Jim_Obj *parms[4]; + int argc = 0; + long eq; + int rc; + + parms[argc++] = commandObj; + if (nocase) { + parms[argc++] = Jim_NewStringObj(interp, "-nocase", -1); + } + parms[argc++] = patternObj; + parms[argc++] = stringObj; + + rc = Jim_EvalObjVector(interp, argc, parms); + + if (rc != JIM_OK || Jim_GetLong(interp, Jim_GetResult(interp), &eq) != JIM_OK) { + eq = -rc; + } + + return eq; +} + +enum +{ SWITCH_EXACT, SWITCH_GLOB, SWITCH_RE, SWITCH_CMD }; + + +static int Jim_SwitchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int matchOpt = SWITCH_EXACT, opt = 1, patCount, i; + Jim_Obj *command = 0, *const *caseList = 0, *strObj; + Jim_Obj *script = 0; + + if (argc < 3) { + wrongnumargs: + Jim_WrongNumArgs(interp, 1, argv, "?options? string " + "pattern body ... ?default body? or " "{pattern body ?pattern body ...?}"); + return JIM_ERR; + } + for (opt = 1; opt < argc; ++opt) { + const char *option = Jim_String(argv[opt]); + + if (*option != '-') + break; + else if (strncmp(option, "--", 2) == 0) { + ++opt; + break; + } + else if (strncmp(option, "-exact", 2) == 0) + matchOpt = SWITCH_EXACT; + else if (strncmp(option, "-glob", 2) == 0) + matchOpt = SWITCH_GLOB; + else if (strncmp(option, "-regexp", 2) == 0) + matchOpt = SWITCH_RE; + else if (strncmp(option, "-command", 2) == 0) { + matchOpt = SWITCH_CMD; + if ((argc - opt) < 2) + goto wrongnumargs; + command = argv[++opt]; + } + else { + Jim_SetResultFormatted(interp, + "bad option \"%#s\": must be -exact, -glob, -regexp, -command procname or --", + argv[opt]); + return JIM_ERR; + } + if ((argc - opt) < 2) + goto wrongnumargs; + } + strObj = argv[opt++]; + patCount = argc - opt; + if (patCount == 1) { + Jim_Obj **vector; + + JimListGetElements(interp, argv[opt], &patCount, &vector); + caseList = vector; + } + else + caseList = &argv[opt]; + if (patCount == 0 || patCount % 2 != 0) + goto wrongnumargs; + for (i = 0; script == 0 && i < patCount; i += 2) { + Jim_Obj *patObj = caseList[i]; + + if (!Jim_CompareStringImmediate(interp, patObj, "default") + || i < (patCount - 2)) { + switch (matchOpt) { + case SWITCH_EXACT: + if (Jim_StringEqObj(strObj, patObj)) + script = caseList[i + 1]; + break; + case SWITCH_GLOB: + if (Jim_StringMatchObj(interp, patObj, strObj, 0)) + script = caseList[i + 1]; + break; + case SWITCH_RE: + command = Jim_NewStringObj(interp, "regexp", -1); + + case SWITCH_CMD:{ + int rc = Jim_CommandMatchObj(interp, command, patObj, strObj, 0); + + if (argc - opt == 1) { + Jim_Obj **vector; + + JimListGetElements(interp, argv[opt], &patCount, &vector); + caseList = vector; + } + + if (rc < 0) { + return -rc; + } + if (rc) + script = caseList[i + 1]; + break; + } + } + } + else { + script = caseList[i + 1]; + } + } + for (; i < patCount && Jim_CompareStringImmediate(interp, script, "-"); i += 2) + script = caseList[i + 1]; + if (script && Jim_CompareStringImmediate(interp, script, "-")) { + Jim_SetResultFormatted(interp, "no body specified for pattern \"%#s\"", caseList[i - 2]); + return JIM_ERR; + } + Jim_SetEmptyResult(interp); + if (script) { + return Jim_EvalObj(interp, script); + } + return JIM_OK; +} + + +static int Jim_ListCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *listObjPtr; + + listObjPtr = Jim_NewListObj(interp, argv + 1, argc - 1); + Jim_SetResult(interp, listObjPtr); + return JIM_OK; +} + + +static int Jim_LindexCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr, *listObjPtr; + int i; + int idx; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "list ?index ...?"); + return JIM_ERR; + } + objPtr = argv[1]; + Jim_IncrRefCount(objPtr); + for (i = 2; i < argc; i++) { + listObjPtr = objPtr; + if (Jim_GetIndex(interp, argv[i], &idx) != JIM_OK) { + Jim_DecrRefCount(interp, listObjPtr); + return JIM_ERR; + } + if (Jim_ListIndex(interp, listObjPtr, idx, &objPtr, JIM_NONE) != JIM_OK) { + Jim_DecrRefCount(interp, listObjPtr); + Jim_SetEmptyResult(interp); + return JIM_OK; + } + Jim_IncrRefCount(objPtr); + Jim_DecrRefCount(interp, listObjPtr); + } + Jim_SetResult(interp, objPtr); + Jim_DecrRefCount(interp, objPtr); + return JIM_OK; +} + + +static int Jim_LlengthCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 2) { + Jim_WrongNumArgs(interp, 1, argv, "list"); + return JIM_ERR; + } + Jim_SetResultInt(interp, Jim_ListLength(interp, argv[1])); + return JIM_OK; +} + + +static int Jim_LsearchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + static const char * const options[] = { + "-bool", "-not", "-nocase", "-exact", "-glob", "-regexp", "-all", "-inline", "-command", + NULL + }; + enum + { OPT_BOOL, OPT_NOT, OPT_NOCASE, OPT_EXACT, OPT_GLOB, OPT_REGEXP, OPT_ALL, OPT_INLINE, + OPT_COMMAND }; + int i; + int opt_bool = 0; + int opt_not = 0; + int opt_nocase = 0; + int opt_all = 0; + int opt_inline = 0; + int opt_match = OPT_EXACT; + int listlen; + int rc = JIM_OK; + Jim_Obj *listObjPtr = NULL; + Jim_Obj *commandObj = NULL; + + if (argc < 3) { + wrongargs: + Jim_WrongNumArgs(interp, 1, argv, + "?-exact|-glob|-regexp|-command 'command'? ?-bool|-inline? ?-not? ?-nocase? ?-all? list value"); + return JIM_ERR; + } + + for (i = 1; i < argc - 2; i++) { + int option; + + if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + switch (option) { + case OPT_BOOL: + opt_bool = 1; + opt_inline = 0; + break; + case OPT_NOT: + opt_not = 1; + break; + case OPT_NOCASE: + opt_nocase = 1; + break; + case OPT_INLINE: + opt_inline = 1; + opt_bool = 0; + break; + case OPT_ALL: + opt_all = 1; + break; + case OPT_COMMAND: + if (i >= argc - 2) { + goto wrongargs; + } + commandObj = argv[++i]; + + case OPT_EXACT: + case OPT_GLOB: + case OPT_REGEXP: + opt_match = option; + break; + } + } + + argv += i; + + if (opt_all) { + listObjPtr = Jim_NewListObj(interp, NULL, 0); + } + if (opt_match == OPT_REGEXP) { + commandObj = Jim_NewStringObj(interp, "regexp", -1); + } + if (commandObj) { + Jim_IncrRefCount(commandObj); + } + + listlen = Jim_ListLength(interp, argv[0]); + for (i = 0; i < listlen; i++) { + int eq = 0; + Jim_Obj *objPtr = Jim_ListGetIndex(interp, argv[0], i); + + switch (opt_match) { + case OPT_EXACT: + eq = Jim_StringCompareObj(interp, argv[1], objPtr, opt_nocase) == 0; + break; + + case OPT_GLOB: + eq = Jim_StringMatchObj(interp, argv[1], objPtr, opt_nocase); + break; + + case OPT_REGEXP: + case OPT_COMMAND: + eq = Jim_CommandMatchObj(interp, commandObj, argv[1], objPtr, opt_nocase); + if (eq < 0) { + if (listObjPtr) { + Jim_FreeNewObj(interp, listObjPtr); + } + rc = JIM_ERR; + goto done; + } + break; + } + + + if (!eq && opt_bool && opt_not && !opt_all) { + continue; + } + + if ((!opt_bool && eq == !opt_not) || (opt_bool && (eq || opt_all))) { + + Jim_Obj *resultObj; + + if (opt_bool) { + resultObj = Jim_NewIntObj(interp, eq ^ opt_not); + } + else if (!opt_inline) { + resultObj = Jim_NewIntObj(interp, i); + } + else { + resultObj = objPtr; + } + + if (opt_all) { + Jim_ListAppendElement(interp, listObjPtr, resultObj); + } + else { + Jim_SetResult(interp, resultObj); + goto done; + } + } + } + + if (opt_all) { + Jim_SetResult(interp, listObjPtr); + } + else { + + if (opt_bool) { + Jim_SetResultBool(interp, opt_not); + } + else if (!opt_inline) { + Jim_SetResultInt(interp, -1); + } + } + + done: + if (commandObj) { + Jim_DecrRefCount(interp, commandObj); + } + return rc; +} + + +static int Jim_LappendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *listObjPtr; + int new_obj = 0; + int i; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "varName ?value value ...?"); + return JIM_ERR; + } + listObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED); + if (!listObjPtr) { + + listObjPtr = Jim_NewListObj(interp, NULL, 0); + new_obj = 1; + } + else if (Jim_IsShared(listObjPtr)) { + listObjPtr = Jim_DuplicateObj(interp, listObjPtr); + new_obj = 1; + } + for (i = 2; i < argc; i++) + Jim_ListAppendElement(interp, listObjPtr, argv[i]); + if (Jim_SetVariable(interp, argv[1], listObjPtr) != JIM_OK) { + if (new_obj) + Jim_FreeNewObj(interp, listObjPtr); + return JIM_ERR; + } + Jim_SetResult(interp, listObjPtr); + return JIM_OK; +} + + +static int Jim_LinsertCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int idx, len; + Jim_Obj *listPtr; + + if (argc < 3) { + Jim_WrongNumArgs(interp, 1, argv, "list index ?element ...?"); + return JIM_ERR; + } + listPtr = argv[1]; + if (Jim_IsShared(listPtr)) + listPtr = Jim_DuplicateObj(interp, listPtr); + if (Jim_GetIndex(interp, argv[2], &idx) != JIM_OK) + goto err; + len = Jim_ListLength(interp, listPtr); + if (idx >= len) + idx = len; + else if (idx < 0) + idx = len + idx + 1; + Jim_ListInsertElements(interp, listPtr, idx, argc - 3, &argv[3]); + Jim_SetResult(interp, listPtr); + return JIM_OK; + err: + if (listPtr != argv[1]) { + Jim_FreeNewObj(interp, listPtr); + } + return JIM_ERR; +} + + +static int Jim_LreplaceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int first, last, len, rangeLen; + Jim_Obj *listObj; + Jim_Obj *newListObj; + + if (argc < 4) { + Jim_WrongNumArgs(interp, 1, argv, "list first last ?element ...?"); + return JIM_ERR; + } + if (Jim_GetIndex(interp, argv[2], &first) != JIM_OK || + Jim_GetIndex(interp, argv[3], &last) != JIM_OK) { + return JIM_ERR; + } + + listObj = argv[1]; + len = Jim_ListLength(interp, listObj); + + first = JimRelToAbsIndex(len, first); + last = JimRelToAbsIndex(len, last); + JimRelToAbsRange(len, &first, &last, &rangeLen); + + + + if (first < len) { + + } + else if (len == 0) { + + first = 0; + } + else { + Jim_SetResultString(interp, "list doesn't contain element ", -1); + Jim_AppendObj(interp, Jim_GetResult(interp), argv[2]); + return JIM_ERR; + } + + + newListObj = Jim_NewListObj(interp, listObj->internalRep.listValue.ele, first); + + + ListInsertElements(newListObj, -1, argc - 4, argv + 4); + + + ListInsertElements(newListObj, -1, len - first - rangeLen, listObj->internalRep.listValue.ele + first + rangeLen); + + Jim_SetResult(interp, newListObj); + return JIM_OK; +} + + +static int Jim_LsetCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc < 3) { + Jim_WrongNumArgs(interp, 1, argv, "listVar ?index...? newVal"); + return JIM_ERR; + } + else if (argc == 3) { + + if (Jim_SetVariable(interp, argv[1], argv[2]) != JIM_OK) + return JIM_ERR; + Jim_SetResult(interp, argv[2]); + return JIM_OK; + } + return Jim_ListSetIndex(interp, argv[1], argv + 2, argc - 3, argv[argc - 1]); +} + + +static int Jim_LsortCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const argv[]) +{ + static const char * const options[] = { + "-ascii", "-nocase", "-increasing", "-decreasing", "-command", "-integer", "-real", "-index", "-unique", NULL + }; + enum + { OPT_ASCII, OPT_NOCASE, OPT_INCREASING, OPT_DECREASING, OPT_COMMAND, OPT_INTEGER, OPT_REAL, OPT_INDEX, OPT_UNIQUE }; + Jim_Obj *resObj; + int i; + int retCode; + + struct lsort_info info; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "?options? list"); + return JIM_ERR; + } + + info.type = JIM_LSORT_ASCII; + info.order = 1; + info.indexed = 0; + info.unique = 0; + info.command = NULL; + info.interp = interp; + + for (i = 1; i < (argc - 1); i++) { + int option; + + if (Jim_GetEnum(interp, argv[i], options, &option, NULL, JIM_ENUM_ABBREV | JIM_ERRMSG) + != JIM_OK) + return JIM_ERR; + switch (option) { + case OPT_ASCII: + info.type = JIM_LSORT_ASCII; + break; + case OPT_NOCASE: + info.type = JIM_LSORT_NOCASE; + break; + case OPT_INTEGER: + info.type = JIM_LSORT_INTEGER; + break; + case OPT_REAL: + info.type = JIM_LSORT_REAL; + break; + case OPT_INCREASING: + info.order = 1; + break; + case OPT_DECREASING: + info.order = -1; + break; + case OPT_UNIQUE: + info.unique = 1; + break; + case OPT_COMMAND: + if (i >= (argc - 2)) { + Jim_SetResultString(interp, "\"-command\" option must be followed by comparison command", -1); + return JIM_ERR; + } + info.type = JIM_LSORT_COMMAND; + info.command = argv[i + 1]; + i++; + break; + case OPT_INDEX: + if (i >= (argc - 2)) { + Jim_SetResultString(interp, "\"-index\" option must be followed by list index", -1); + return JIM_ERR; + } + if (Jim_GetIndex(interp, argv[i + 1], &info.index) != JIM_OK) { + return JIM_ERR; + } + info.indexed = 1; + i++; + break; + } + } + resObj = Jim_DuplicateObj(interp, argv[argc - 1]); + retCode = ListSortElements(interp, resObj, &info); + if (retCode == JIM_OK) { + Jim_SetResult(interp, resObj); + } + else { + Jim_FreeNewObj(interp, resObj); + } + return retCode; +} + + +static int Jim_AppendCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *stringObjPtr; + int i; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "varName ?value ...?"); + return JIM_ERR; + } + if (argc == 2) { + stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_ERRMSG); + if (!stringObjPtr) + return JIM_ERR; + } + else { + int new_obj = 0; + stringObjPtr = Jim_GetVariable(interp, argv[1], JIM_UNSHARED); + if (!stringObjPtr) { + + stringObjPtr = Jim_NewEmptyStringObj(interp); + new_obj = 1; + } + else if (Jim_IsShared(stringObjPtr)) { + new_obj = 1; + stringObjPtr = Jim_DuplicateObj(interp, stringObjPtr); + } + for (i = 2; i < argc; i++) { + Jim_AppendObj(interp, stringObjPtr, argv[i]); + } + if (Jim_SetVariable(interp, argv[1], stringObjPtr) != JIM_OK) { + if (new_obj) { + Jim_FreeNewObj(interp, stringObjPtr); + } + return JIM_ERR; + } + } + Jim_SetResult(interp, stringObjPtr); + return JIM_OK; +} + + +static int Jim_DebugCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ +#if !defined(JIM_DEBUG_COMMAND) + Jim_SetResultString(interp, "unsupported", -1); + return JIM_ERR; +#endif +} + + +static int Jim_EvalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int rc; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "arg ?arg ...?"); + return JIM_ERR; + } + + if (argc == 2) { + rc = Jim_EvalObj(interp, argv[1]); + } + else { + rc = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1)); + } + + if (rc == JIM_ERR) { + + interp->addStackTrace++; + } + return rc; +} + + +static int Jim_UplevelCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc >= 2) { + int retcode; + Jim_CallFrame *savedCallFrame, *targetCallFrame; + const char *str; + + + savedCallFrame = interp->framePtr; + + + str = Jim_String(argv[1]); + if ((str[0] >= '0' && str[0] <= '9') || str[0] == '#') { + targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]); + argc--; + argv++; + } + else { + targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL); + } + if (targetCallFrame == NULL) { + return JIM_ERR; + } + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv - 1, "?level? command ?arg ...?"); + return JIM_ERR; + } + + interp->framePtr = targetCallFrame; + if (argc == 2) { + retcode = Jim_EvalObj(interp, argv[1]); + } + else { + retcode = Jim_EvalObj(interp, Jim_ConcatObj(interp, argc - 1, argv + 1)); + } + interp->framePtr = savedCallFrame; + return retcode; + } + else { + Jim_WrongNumArgs(interp, 1, argv, "?level? command ?arg ...?"); + return JIM_ERR; + } +} + + +static int Jim_ExprCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *exprResultPtr; + int retcode; + + if (argc == 2) { + retcode = Jim_EvalExpression(interp, argv[1], &exprResultPtr); + } + else if (argc > 2) { + Jim_Obj *objPtr; + + objPtr = Jim_ConcatObj(interp, argc - 1, argv + 1); + Jim_IncrRefCount(objPtr); + retcode = Jim_EvalExpression(interp, objPtr, &exprResultPtr); + Jim_DecrRefCount(interp, objPtr); + } + else { + Jim_WrongNumArgs(interp, 1, argv, "expression ?...?"); + return JIM_ERR; + } + if (retcode != JIM_OK) + return retcode; + Jim_SetResult(interp, exprResultPtr); + Jim_DecrRefCount(interp, exprResultPtr); + return JIM_OK; +} + + +static int Jim_BreakCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 1) { + Jim_WrongNumArgs(interp, 1, argv, ""); + return JIM_ERR; + } + return JIM_BREAK; +} + + +static int Jim_ContinueCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 1) { + Jim_WrongNumArgs(interp, 1, argv, ""); + return JIM_ERR; + } + return JIM_CONTINUE; +} + + +static int Jim_ReturnCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + Jim_Obj *stackTraceObj = NULL; + Jim_Obj *errorCodeObj = NULL; + int returnCode = JIM_OK; + long level = 1; + + for (i = 1; i < argc - 1; i += 2) { + if (Jim_CompareStringImmediate(interp, argv[i], "-code")) { + if (Jim_GetReturnCode(interp, argv[i + 1], &returnCode) == JIM_ERR) { + return JIM_ERR; + } + } + else if (Jim_CompareStringImmediate(interp, argv[i], "-errorinfo")) { + stackTraceObj = argv[i + 1]; + } + else if (Jim_CompareStringImmediate(interp, argv[i], "-errorcode")) { + errorCodeObj = argv[i + 1]; + } + else if (Jim_CompareStringImmediate(interp, argv[i], "-level")) { + if (Jim_GetLong(interp, argv[i + 1], &level) != JIM_OK || level < 0) { + Jim_SetResultFormatted(interp, "bad level \"%#s\"", argv[i + 1]); + return JIM_ERR; + } + } + else { + break; + } + } + + if (i != argc - 1 && i != argc) { + Jim_WrongNumArgs(interp, 1, argv, + "?-code code? ?-errorinfo stacktrace? ?-level level? ?result?"); + } + + + if (stackTraceObj && returnCode == JIM_ERR) { + JimSetStackTrace(interp, stackTraceObj); + } + + if (errorCodeObj && returnCode == JIM_ERR) { + Jim_SetGlobalVariableStr(interp, "errorCode", errorCodeObj); + } + interp->returnCode = returnCode; + interp->returnLevel = level; + + if (i == argc - 1) { + Jim_SetResult(interp, argv[i]); + } + return JIM_RETURN; +} + + +static int Jim_TailcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (interp->framePtr->level == 0) { + Jim_SetResultString(interp, "tailcall can only be called from a proc or lambda", -1); + return JIM_ERR; + } + else if (argc >= 2) { + + Jim_CallFrame *cf = interp->framePtr->parent; + + Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG); + if (cmdPtr == NULL) { + return JIM_ERR; + } + + JimPanic((cf->tailcallCmd != NULL, "Already have a tailcallCmd")); + + + JimIncrCmdRefCount(cmdPtr); + cf->tailcallCmd = cmdPtr; + + + JimPanic((cf->tailcallObj != NULL, "Already have a tailcallobj")); + + cf->tailcallObj = Jim_NewListObj(interp, argv + 1, argc - 1); + Jim_IncrRefCount(cf->tailcallObj); + + + return JIM_EVAL; + } + return JIM_OK; +} + +static int JimAliasCmd(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *cmdList; + Jim_Obj *prefixListObj = Jim_CmdPrivData(interp); + + + cmdList = Jim_DuplicateObj(interp, prefixListObj); + Jim_ListInsertElements(interp, cmdList, Jim_ListLength(interp, cmdList), argc - 1, argv + 1); + + return JimEvalObjList(interp, cmdList); +} + +static void JimAliasCmdDelete(Jim_Interp *interp, void *privData) +{ + Jim_Obj *prefixListObj = privData; + Jim_DecrRefCount(interp, prefixListObj); +} + +static int Jim_AliasCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *prefixListObj; + const char *newname; + + if (argc < 3) { + Jim_WrongNumArgs(interp, 1, argv, "newname command ?args ...?"); + return JIM_ERR; + } + + prefixListObj = Jim_NewListObj(interp, argv + 2, argc - 2); + Jim_IncrRefCount(prefixListObj); + newname = Jim_String(argv[1]); + if (newname[0] == ':' && newname[1] == ':') { + while (*++newname == ':') { + } + } + + Jim_SetResult(interp, argv[1]); + + return Jim_CreateCommand(interp, newname, JimAliasCmd, prefixListObj, JimAliasCmdDelete); +} + + +static int Jim_ProcCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Cmd *cmd; + + if (argc != 4 && argc != 5) { + Jim_WrongNumArgs(interp, 1, argv, "name arglist ?statics? body"); + return JIM_ERR; + } + + if (JimValidName(interp, "procedure", argv[1]) != JIM_OK) { + return JIM_ERR; + } + + if (argc == 4) { + cmd = JimCreateProcedureCmd(interp, argv[2], NULL, argv[3], NULL); + } + else { + cmd = JimCreateProcedureCmd(interp, argv[2], argv[3], argv[4], NULL); + } + + if (cmd) { + + Jim_Obj *qualifiedCmdNameObj; + const char *cmdname = JimQualifyName(interp, Jim_String(argv[1]), &qualifiedCmdNameObj); + + JimCreateCommand(interp, cmdname, cmd); + + + JimUpdateProcNamespace(interp, cmd, cmdname); + + JimFreeQualifiedName(interp, qualifiedCmdNameObj); + + + Jim_SetResult(interp, argv[1]); + return JIM_OK; + } + return JIM_ERR; +} + + +static int Jim_LocalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int retcode; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?"); + return JIM_ERR; + } + + + interp->local++; + retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1); + interp->local--; + + + + if (retcode == 0) { + Jim_Obj *cmdNameObj = Jim_GetResult(interp); + + if (Jim_GetCommand(interp, cmdNameObj, JIM_ERRMSG) == NULL) { + return JIM_ERR; + } + if (interp->framePtr->localCommands == NULL) { + interp->framePtr->localCommands = Jim_Alloc(sizeof(*interp->framePtr->localCommands)); + Jim_InitStack(interp->framePtr->localCommands); + } + Jim_IncrRefCount(cmdNameObj); + Jim_StackPush(interp->framePtr->localCommands, cmdNameObj); + } + + return retcode; +} + + +static int Jim_UpcallCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "cmd ?args ...?"); + return JIM_ERR; + } + else { + int retcode; + + Jim_Cmd *cmdPtr = Jim_GetCommand(interp, argv[1], JIM_ERRMSG); + if (cmdPtr == NULL || !cmdPtr->isproc || !cmdPtr->prevCmd) { + Jim_SetResultFormatted(interp, "no previous command: \"%#s\"", argv[1]); + return JIM_ERR; + } + + cmdPtr->u.proc.upcall++; + JimIncrCmdRefCount(cmdPtr); + + + retcode = Jim_EvalObjVector(interp, argc - 1, argv + 1); + + + cmdPtr->u.proc.upcall--; + JimDecrCmdRefCount(interp, cmdPtr); + + return retcode; + } +} + + +static int Jim_ApplyCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "lambdaExpr ?arg ...?"); + return JIM_ERR; + } + else { + int ret; + Jim_Cmd *cmd; + Jim_Obj *argListObjPtr; + Jim_Obj *bodyObjPtr; + Jim_Obj *nsObj = NULL; + Jim_Obj **nargv; + + int len = Jim_ListLength(interp, argv[1]); + if (len != 2 && len != 3) { + Jim_SetResultFormatted(interp, "can't interpret \"%#s\" as a lambda expression", argv[1]); + return JIM_ERR; + } + + if (len == 3) { +#ifdef jim_ext_namespace + + nsObj = JimQualifyNameObj(interp, Jim_ListGetIndex(interp, argv[1], 2)); +#else + Jim_SetResultString(interp, "namespaces not enabled", -1); + return JIM_ERR; +#endif + } + argListObjPtr = Jim_ListGetIndex(interp, argv[1], 0); + bodyObjPtr = Jim_ListGetIndex(interp, argv[1], 1); + + cmd = JimCreateProcedureCmd(interp, argListObjPtr, NULL, bodyObjPtr, nsObj); + + if (cmd) { + + nargv = Jim_Alloc((argc - 2 + 1) * sizeof(*nargv)); + nargv[0] = Jim_NewStringObj(interp, "apply lambdaExpr", -1); + Jim_IncrRefCount(nargv[0]); + memcpy(&nargv[1], argv + 2, (argc - 2) * sizeof(*nargv)); + ret = JimCallProcedure(interp, cmd, argc - 2 + 1, nargv); + Jim_DecrRefCount(interp, nargv[0]); + Jim_Free(nargv); + + JimDecrCmdRefCount(interp, cmd); + return ret; + } + return JIM_ERR; + } +} + + + +static int Jim_ConcatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_SetResult(interp, Jim_ConcatObj(interp, argc - 1, argv + 1)); + return JIM_OK; +} + + +static int Jim_UpvarCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + Jim_CallFrame *targetCallFrame; + + + if (argc > 3 && (argc % 2 == 0)) { + targetCallFrame = Jim_GetCallFrameByLevel(interp, argv[1]); + argc--; + argv++; + } + else { + targetCallFrame = Jim_GetCallFrameByLevel(interp, NULL); + } + if (targetCallFrame == NULL) { + return JIM_ERR; + } + + + if (argc < 3) { + Jim_WrongNumArgs(interp, 1, argv, "?level? otherVar localVar ?otherVar localVar ...?"); + return JIM_ERR; + } + + + for (i = 1; i < argc; i += 2) { + if (Jim_SetVariableLink(interp, argv[i + 1], argv[i], targetCallFrame) != JIM_OK) + return JIM_ERR; + } + return JIM_OK; +} + + +static int Jim_GlobalCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int i; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "varName ?varName ...?"); + return JIM_ERR; + } + + if (interp->framePtr->level == 0) + return JIM_OK; + for (i = 1; i < argc; i++) { + + const char *name = Jim_String(argv[i]); + if (name[0] != ':' || name[1] != ':') { + if (Jim_SetVariableLink(interp, argv[i], argv[i], interp->topFramePtr) != JIM_OK) + return JIM_ERR; + } + } + return JIM_OK; +} + +static Jim_Obj *JimStringMap(Jim_Interp *interp, Jim_Obj *mapListObjPtr, + Jim_Obj *objPtr, int nocase) +{ + int numMaps; + const char *str, *noMatchStart = NULL; + int strLen, i; + Jim_Obj *resultObjPtr; + + numMaps = Jim_ListLength(interp, mapListObjPtr); + if (numMaps % 2) { + Jim_SetResultString(interp, "list must contain an even number of elements", -1); + return NULL; + } + + str = Jim_String(objPtr); + strLen = Jim_Utf8Length(interp, objPtr); + + + resultObjPtr = Jim_NewStringObj(interp, "", 0); + while (strLen) { + for (i = 0; i < numMaps; i += 2) { + Jim_Obj *objPtr; + const char *k; + int kl; + + objPtr = Jim_ListGetIndex(interp, mapListObjPtr, i); + k = Jim_String(objPtr); + kl = Jim_Utf8Length(interp, objPtr); + + if (strLen >= kl && kl) { + int rc; + rc = JimStringCompareLen(str, k, kl, nocase); + if (rc == 0) { + if (noMatchStart) { + Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart); + noMatchStart = NULL; + } + Jim_AppendObj(interp, resultObjPtr, Jim_ListGetIndex(interp, mapListObjPtr, i + 1)); + str += utf8_index(str, kl); + strLen -= kl; + break; + } + } + } + if (i == numMaps) { + int c; + if (noMatchStart == NULL) + noMatchStart = str; + str += utf8_tounicode(str, &c); + strLen--; + } + } + if (noMatchStart) { + Jim_AppendString(interp, resultObjPtr, noMatchStart, str - noMatchStart); + } + return resultObjPtr; +} + + +static int Jim_StringCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int len; + int opt_case = 1; + int option; + static const char * const options[] = { + "bytelength", "length", "compare", "match", "equal", "is", "byterange", "range", "replace", + "map", "repeat", "reverse", "index", "first", "last", "cat", + "trim", "trimleft", "trimright", "tolower", "toupper", "totitle", NULL + }; + enum + { + OPT_BYTELENGTH, OPT_LENGTH, OPT_COMPARE, OPT_MATCH, OPT_EQUAL, OPT_IS, OPT_BYTERANGE, OPT_RANGE, OPT_REPLACE, + OPT_MAP, OPT_REPEAT, OPT_REVERSE, OPT_INDEX, OPT_FIRST, OPT_LAST, OPT_CAT, + OPT_TRIM, OPT_TRIMLEFT, OPT_TRIMRIGHT, OPT_TOLOWER, OPT_TOUPPER, OPT_TOTITLE + }; + static const char * const nocase_options[] = { + "-nocase", NULL + }; + static const char * const nocase_length_options[] = { + "-nocase", "-length", NULL + }; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "option ?arguments ...?"); + return JIM_ERR; + } + if (Jim_GetEnum(interp, argv[1], options, &option, NULL, + JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) + return JIM_ERR; + + switch (option) { + case OPT_LENGTH: + case OPT_BYTELENGTH: + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "string"); + return JIM_ERR; + } + if (option == OPT_LENGTH) { + len = Jim_Utf8Length(interp, argv[2]); + } + else { + len = Jim_Length(argv[2]); + } + Jim_SetResultInt(interp, len); + return JIM_OK; + + case OPT_CAT:{ + Jim_Obj *objPtr; + if (argc == 3) { + + objPtr = argv[2]; + } + else { + int i; + + objPtr = Jim_NewStringObj(interp, "", 0); + + for (i = 2; i < argc; i++) { + Jim_AppendObj(interp, objPtr, argv[i]); + } + } + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + + case OPT_COMPARE: + case OPT_EQUAL: + { + + long opt_length = -1; + int n = argc - 4; + int i = 2; + while (n > 0) { + int subopt; + if (Jim_GetEnum(interp, argv[i++], nocase_length_options, &subopt, NULL, + JIM_ENUM_ABBREV) != JIM_OK) { +badcompareargs: + Jim_WrongNumArgs(interp, 2, argv, "?-nocase? ?-length int? string1 string2"); + return JIM_ERR; + } + if (subopt == 0) { + + opt_case = 0; + n--; + } + else { + + if (n < 2) { + goto badcompareargs; + } + if (Jim_GetLong(interp, argv[i++], &opt_length) != JIM_OK) { + return JIM_ERR; + } + n -= 2; + } + } + if (n) { + goto badcompareargs; + } + argv += argc - 2; + if (opt_length < 0 && option != OPT_COMPARE && opt_case) { + + Jim_SetResultBool(interp, Jim_StringEqObj(argv[0], argv[1])); + } + else { + if (opt_length >= 0) { + n = JimStringCompareLen(Jim_String(argv[0]), Jim_String(argv[1]), opt_length, !opt_case); + } + else { + n = Jim_StringCompareObj(interp, argv[0], argv[1], !opt_case); + } + Jim_SetResultInt(interp, option == OPT_COMPARE ? n : n == 0); + } + return JIM_OK; + } + + case OPT_MATCH: + if (argc != 4 && + (argc != 5 || + Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL, + JIM_ENUM_ABBREV) != JIM_OK)) { + Jim_WrongNumArgs(interp, 2, argv, "?-nocase? pattern string"); + return JIM_ERR; + } + if (opt_case == 0) { + argv++; + } + Jim_SetResultBool(interp, Jim_StringMatchObj(interp, argv[2], argv[3], !opt_case)); + return JIM_OK; + + case OPT_MAP:{ + Jim_Obj *objPtr; + + if (argc != 4 && + (argc != 5 || + Jim_GetEnum(interp, argv[2], nocase_options, &opt_case, NULL, + JIM_ENUM_ABBREV) != JIM_OK)) { + Jim_WrongNumArgs(interp, 2, argv, "?-nocase? mapList string"); + return JIM_ERR; + } + + if (opt_case == 0) { + argv++; + } + objPtr = JimStringMap(interp, argv[2], argv[3], !opt_case); + if (objPtr == NULL) { + return JIM_ERR; + } + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + + case OPT_RANGE: + case OPT_BYTERANGE:{ + Jim_Obj *objPtr; + + if (argc != 5) { + Jim_WrongNumArgs(interp, 2, argv, "string first last"); + return JIM_ERR; + } + if (option == OPT_RANGE) { + objPtr = Jim_StringRangeObj(interp, argv[2], argv[3], argv[4]); + } + else + { + objPtr = Jim_StringByteRangeObj(interp, argv[2], argv[3], argv[4]); + } + + if (objPtr == NULL) { + return JIM_ERR; + } + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + + case OPT_REPLACE:{ + Jim_Obj *objPtr; + + if (argc != 5 && argc != 6) { + Jim_WrongNumArgs(interp, 2, argv, "string first last ?string?"); + return JIM_ERR; + } + objPtr = JimStringReplaceObj(interp, argv[2], argv[3], argv[4], argc == 6 ? argv[5] : NULL); + if (objPtr == NULL) { + return JIM_ERR; + } + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + + + case OPT_REPEAT:{ + Jim_Obj *objPtr; + jim_wide count; + + if (argc != 4) { + Jim_WrongNumArgs(interp, 2, argv, "string count"); + return JIM_ERR; + } + if (Jim_GetWide(interp, argv[3], &count) != JIM_OK) { + return JIM_ERR; + } + objPtr = Jim_NewStringObj(interp, "", 0); + if (count > 0) { + while (count--) { + Jim_AppendObj(interp, objPtr, argv[2]); + } + } + Jim_SetResult(interp, objPtr); + return JIM_OK; + } + + case OPT_REVERSE:{ + char *buf, *p; + const char *str; + int len; + int i; + + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "string"); + return JIM_ERR; + } + + str = Jim_GetString(argv[2], &len); + buf = Jim_Alloc(len + 1); + p = buf + len; + *p = 0; + for (i = 0; i < len; ) { + int c; + int l = utf8_tounicode(str, &c); + memcpy(p - l, str, l); + p -= l; + i += l; + str += l; + } + Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len)); + return JIM_OK; + } + + case OPT_INDEX:{ + int idx; + const char *str; + + if (argc != 4) { + Jim_WrongNumArgs(interp, 2, argv, "string index"); + return JIM_ERR; + } + if (Jim_GetIndex(interp, argv[3], &idx) != JIM_OK) { + return JIM_ERR; + } + str = Jim_String(argv[2]); + len = Jim_Utf8Length(interp, argv[2]); + if (idx != INT_MIN && idx != INT_MAX) { + idx = JimRelToAbsIndex(len, idx); + } + if (idx < 0 || idx >= len || str == NULL) { + Jim_SetResultString(interp, "", 0); + } + else if (len == Jim_Length(argv[2])) { + + Jim_SetResultString(interp, str + idx, 1); + } + else { + int c; + int i = utf8_index(str, idx); + Jim_SetResultString(interp, str + i, utf8_tounicode(str + i, &c)); + } + return JIM_OK; + } + + case OPT_FIRST: + case OPT_LAST:{ + int idx = 0, l1, l2; + const char *s1, *s2; + + if (argc != 4 && argc != 5) { + Jim_WrongNumArgs(interp, 2, argv, "subString string ?index?"); + return JIM_ERR; + } + s1 = Jim_String(argv[2]); + s2 = Jim_String(argv[3]); + l1 = Jim_Utf8Length(interp, argv[2]); + l2 = Jim_Utf8Length(interp, argv[3]); + if (argc == 5) { + if (Jim_GetIndex(interp, argv[4], &idx) != JIM_OK) { + return JIM_ERR; + } + idx = JimRelToAbsIndex(l2, idx); + } + else if (option == OPT_LAST) { + idx = l2; + } + if (option == OPT_FIRST) { + Jim_SetResultInt(interp, JimStringFirst(s1, l1, s2, l2, idx)); + } + else { +#ifdef JIM_UTF8 + Jim_SetResultInt(interp, JimStringLastUtf8(s1, l1, s2, idx)); +#else + Jim_SetResultInt(interp, JimStringLast(s1, l1, s2, idx)); +#endif + } + return JIM_OK; + } + + case OPT_TRIM: + case OPT_TRIMLEFT: + case OPT_TRIMRIGHT:{ + Jim_Obj *trimchars; + + if (argc != 3 && argc != 4) { + Jim_WrongNumArgs(interp, 2, argv, "string ?trimchars?"); + return JIM_ERR; + } + trimchars = (argc == 4 ? argv[3] : NULL); + if (option == OPT_TRIM) { + Jim_SetResult(interp, JimStringTrim(interp, argv[2], trimchars)); + } + else if (option == OPT_TRIMLEFT) { + Jim_SetResult(interp, JimStringTrimLeft(interp, argv[2], trimchars)); + } + else if (option == OPT_TRIMRIGHT) { + Jim_SetResult(interp, JimStringTrimRight(interp, argv[2], trimchars)); + } + return JIM_OK; + } + + case OPT_TOLOWER: + case OPT_TOUPPER: + case OPT_TOTITLE: + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "string"); + return JIM_ERR; + } + if (option == OPT_TOLOWER) { + Jim_SetResult(interp, JimStringToLower(interp, argv[2])); + } + else if (option == OPT_TOUPPER) { + Jim_SetResult(interp, JimStringToUpper(interp, argv[2])); + } + else { + Jim_SetResult(interp, JimStringToTitle(interp, argv[2])); + } + return JIM_OK; + + case OPT_IS: + if (argc == 4 || (argc == 5 && Jim_CompareStringImmediate(interp, argv[3], "-strict"))) { + return JimStringIs(interp, argv[argc - 1], argv[2], argc == 5); + } + Jim_WrongNumArgs(interp, 2, argv, "class ?-strict? str"); + return JIM_ERR; + } + return JIM_OK; +} + + +static int Jim_TimeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + long i, count = 1; + jim_wide start, elapsed; + char buf[60]; + const char *fmt = "%" JIM_WIDE_MODIFIER " microseconds per iteration"; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "script ?count?"); + return JIM_ERR; + } + if (argc == 3) { + if (Jim_GetLong(interp, argv[2], &count) != JIM_OK) + return JIM_ERR; + } + if (count < 0) + return JIM_OK; + i = count; + start = JimClock(); + while (i-- > 0) { + int retval; + + retval = Jim_EvalObj(interp, argv[1]); + if (retval != JIM_OK) { + return retval; + } + } + elapsed = JimClock() - start; + sprintf(buf, fmt, count == 0 ? 0 : elapsed / count); + Jim_SetResultString(interp, buf, -1); + return JIM_OK; +} + + +static int Jim_ExitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + long exitCode = 0; + + if (argc > 2) { + Jim_WrongNumArgs(interp, 1, argv, "?exitCode?"); + return JIM_ERR; + } + if (argc == 2) { + if (Jim_GetLong(interp, argv[1], &exitCode) != JIM_OK) + return JIM_ERR; + } + interp->exitCode = exitCode; + return JIM_EXIT; +} + + +static int Jim_CatchCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int exitCode = 0; + int i; + int sig = 0; + + + jim_wide ignore_mask = (1 << JIM_EXIT) | (1 << JIM_EVAL) | (1 << JIM_SIGNAL); + static const int max_ignore_code = sizeof(ignore_mask) * 8; + + Jim_SetGlobalVariableStr(interp, "errorCode", Jim_NewStringObj(interp, "NONE", -1)); + + for (i = 1; i < argc - 1; i++) { + const char *arg = Jim_String(argv[i]); + jim_wide option; + int ignore; + + + if (strcmp(arg, "--") == 0) { + i++; + break; + } + if (*arg != '-') { + break; + } + + if (strncmp(arg, "-no", 3) == 0) { + arg += 3; + ignore = 1; + } + else { + arg++; + ignore = 0; + } + + if (Jim_StringToWide(arg, &option, 10) != JIM_OK) { + option = -1; + } + if (option < 0) { + option = Jim_FindByName(arg, jimReturnCodes, jimReturnCodesSize); + } + if (option < 0) { + goto wrongargs; + } + + if (ignore) { + ignore_mask |= ((jim_wide)1 << option); + } + else { + ignore_mask &= (~((jim_wide)1 << option)); + } + } + + argc -= i; + if (argc < 1 || argc > 3) { + wrongargs: + Jim_WrongNumArgs(interp, 1, argv, + "?-?no?code ... --? script ?resultVarName? ?optionVarName?"); + return JIM_ERR; + } + argv += i; + + if ((ignore_mask & (1 << JIM_SIGNAL)) == 0) { + sig++; + } + + interp->signal_level += sig; + if (Jim_CheckSignal(interp)) { + + exitCode = JIM_SIGNAL; + } + else { + exitCode = Jim_EvalObj(interp, argv[0]); + + interp->errorFlag = 0; + } + interp->signal_level -= sig; + + + if (exitCode >= 0 && exitCode < max_ignore_code && (((unsigned jim_wide)1 << exitCode) & ignore_mask)) { + + return exitCode; + } + + if (sig && exitCode == JIM_SIGNAL) { + + if (interp->signal_set_result) { + interp->signal_set_result(interp, interp->sigmask); + } + else { + Jim_SetResultInt(interp, interp->sigmask); + } + interp->sigmask = 0; + } + + if (argc >= 2) { + if (Jim_SetVariable(interp, argv[1], Jim_GetResult(interp)) != JIM_OK) { + return JIM_ERR; + } + if (argc == 3) { + Jim_Obj *optListObj = Jim_NewListObj(interp, NULL, 0); + + Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-code", -1)); + Jim_ListAppendElement(interp, optListObj, + Jim_NewIntObj(interp, exitCode == JIM_RETURN ? interp->returnCode : exitCode)); + Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-level", -1)); + Jim_ListAppendElement(interp, optListObj, Jim_NewIntObj(interp, interp->returnLevel)); + if (exitCode == JIM_ERR) { + Jim_Obj *errorCode; + Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorinfo", + -1)); + Jim_ListAppendElement(interp, optListObj, interp->stackTrace); + + errorCode = Jim_GetGlobalVariableStr(interp, "errorCode", JIM_NONE); + if (errorCode) { + Jim_ListAppendElement(interp, optListObj, Jim_NewStringObj(interp, "-errorcode", -1)); + Jim_ListAppendElement(interp, optListObj, errorCode); + } + } + if (Jim_SetVariable(interp, argv[2], optListObj) != JIM_OK) { + return JIM_ERR; + } + } + } + Jim_SetResultInt(interp, exitCode); + return JIM_OK; +} + +#ifdef JIM_REFERENCES + + +static int Jim_RefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 3 && argc != 4) { + Jim_WrongNumArgs(interp, 1, argv, "string tag ?finalizer?"); + return JIM_ERR; + } + if (argc == 3) { + Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], NULL)); + } + else { + Jim_SetResult(interp, Jim_NewReference(interp, argv[1], argv[2], argv[3])); + } + return JIM_OK; +} + + +static int Jim_GetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Reference *refPtr; + + if (argc != 2) { + Jim_WrongNumArgs(interp, 1, argv, "reference"); + return JIM_ERR; + } + if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL) + return JIM_ERR; + Jim_SetResult(interp, refPtr->objPtr); + return JIM_OK; +} + + +static int Jim_SetrefCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Reference *refPtr; + + if (argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "reference newValue"); + return JIM_ERR; + } + if ((refPtr = Jim_GetReference(interp, argv[1])) == NULL) + return JIM_ERR; + Jim_IncrRefCount(argv[2]); + Jim_DecrRefCount(interp, refPtr->objPtr); + refPtr->objPtr = argv[2]; + Jim_SetResult(interp, argv[2]); + return JIM_OK; +} + + +static int Jim_CollectCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 1) { + Jim_WrongNumArgs(interp, 1, argv, ""); + return JIM_ERR; + } + Jim_SetResultInt(interp, Jim_Collect(interp)); + + + while (interp->freeList) { + Jim_Obj *nextObjPtr = interp->freeList->nextObjPtr; + Jim_Free(interp->freeList); + interp->freeList = nextObjPtr; + } + + return JIM_OK; +} + + +static int Jim_FinalizeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "reference ?finalizerProc?"); + return JIM_ERR; + } + if (argc == 2) { + Jim_Obj *cmdNamePtr; + + if (Jim_GetFinalizer(interp, argv[1], &cmdNamePtr) != JIM_OK) + return JIM_ERR; + if (cmdNamePtr != NULL) + Jim_SetResult(interp, cmdNamePtr); + } + else { + if (Jim_SetFinalizer(interp, argv[1], argv[2]) != JIM_OK) + return JIM_ERR; + Jim_SetResult(interp, argv[2]); + } + return JIM_OK; +} + + +static int JimInfoReferences(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *listObjPtr; + Jim_HashTableIterator htiter; + Jim_HashEntry *he; + + listObjPtr = Jim_NewListObj(interp, NULL, 0); + + JimInitHashTableIterator(&interp->references, &htiter); + while ((he = Jim_NextHashEntry(&htiter)) != NULL) { + char buf[JIM_REFERENCE_SPACE + 1]; + Jim_Reference *refPtr = Jim_GetHashEntryVal(he); + const unsigned long *refId = he->key; + + JimFormatReference(buf, refPtr, *refId); + Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, buf, -1)); + } + Jim_SetResult(interp, listObjPtr); + return JIM_OK; +} +#endif + + +static int Jim_RenameCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "oldName newName"); + return JIM_ERR; + } + + if (JimValidName(interp, "new procedure", argv[2])) { + return JIM_ERR; + } + + return Jim_RenameCommand(interp, Jim_String(argv[1]), Jim_String(argv[2])); +} + +#define JIM_DICTMATCH_VALUES 0x0001 + +typedef void JimDictMatchCallbackType(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type); + +static void JimDictMatchKeys(Jim_Interp *interp, Jim_Obj *listObjPtr, Jim_HashEntry *he, int type) +{ + Jim_ListAppendElement(interp, listObjPtr, (Jim_Obj *)he->key); + if (type & JIM_DICTMATCH_VALUES) { + Jim_ListAppendElement(interp, listObjPtr, Jim_GetHashEntryVal(he)); + } +} + +static Jim_Obj *JimDictPatternMatch(Jim_Interp *interp, Jim_HashTable *ht, Jim_Obj *patternObjPtr, + JimDictMatchCallbackType *callback, int type) +{ + Jim_HashEntry *he; + Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0); + + + Jim_HashTableIterator htiter; + JimInitHashTableIterator(ht, &htiter); + while ((he = Jim_NextHashEntry(&htiter)) != NULL) { + if (patternObjPtr == NULL || JimGlobMatch(Jim_String(patternObjPtr), Jim_String((Jim_Obj *)he->key), 0)) { + callback(interp, listObjPtr, he, type); + } + } + + return listObjPtr; +} + + +int Jim_DictKeys(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr) +{ + if (SetDictFromAny(interp, objPtr) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, 0)); + return JIM_OK; +} + +int Jim_DictValues(Jim_Interp *interp, Jim_Obj *objPtr, Jim_Obj *patternObjPtr) +{ + if (SetDictFromAny(interp, objPtr) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResult(interp, JimDictPatternMatch(interp, objPtr->internalRep.ptr, patternObjPtr, JimDictMatchKeys, JIM_DICTMATCH_VALUES)); + return JIM_OK; +} + +int Jim_DictSize(Jim_Interp *interp, Jim_Obj *objPtr) +{ + if (SetDictFromAny(interp, objPtr) != JIM_OK) { + return -1; + } + return ((Jim_HashTable *)objPtr->internalRep.ptr)->used; +} + +int Jim_DictInfo(Jim_Interp *interp, Jim_Obj *objPtr) +{ + Jim_HashTable *ht; + unsigned int i; + + if (SetDictFromAny(interp, objPtr) != JIM_OK) { + return JIM_ERR; + } + + ht = (Jim_HashTable *)objPtr->internalRep.ptr; + + + printf("%d entries in table, %d buckets\n", ht->used, ht->size); + + for (i = 0; i < ht->size; i++) { + Jim_HashEntry *he = ht->table[i]; + + if (he) { + printf("%d: ", i); + + while (he) { + printf(" %s", Jim_String(he->key)); + he = he->next; + } + printf("\n"); + } + } + return JIM_OK; +} + +static int Jim_EvalEnsemble(Jim_Interp *interp, const char *basecmd, const char *subcmd, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *prefixObj = Jim_NewStringObj(interp, basecmd, -1); + + Jim_AppendString(interp, prefixObj, " ", 1); + Jim_AppendString(interp, prefixObj, subcmd, -1); + + return Jim_EvalObjPrefix(interp, prefixObj, argc, argv); +} + + +static int Jim_DictCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr; + int option; + static const char * const options[] = { + "create", "get", "set", "unset", "exists", "keys", "size", "info", + "merge", "with", "append", "lappend", "incr", "remove", "values", "for", + "replace", "update", NULL + }; + enum + { + OPT_CREATE, OPT_GET, OPT_SET, OPT_UNSET, OPT_EXISTS, OPT_KEYS, OPT_SIZE, OPT_INFO, + OPT_MERGE, OPT_WITH, OPT_APPEND, OPT_LAPPEND, OPT_INCR, OPT_REMOVE, OPT_VALUES, OPT_FOR, + OPT_REPLACE, OPT_UPDATE, + }; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "subcommand ?arguments ...?"); + return JIM_ERR; + } + + if (Jim_GetEnum(interp, argv[1], options, &option, "subcommand", JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + + switch (option) { + case OPT_GET: + if (argc < 3) { + Jim_WrongNumArgs(interp, 2, argv, "dictionary ?key ...?"); + return JIM_ERR; + } + if (Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, + JIM_ERRMSG) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResult(interp, objPtr); + return JIM_OK; + + case OPT_SET: + if (argc < 5) { + Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...? value"); + return JIM_ERR; + } + return Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 4, argv[argc - 1], JIM_ERRMSG); + + case OPT_EXISTS: + if (argc < 4) { + Jim_WrongNumArgs(interp, 2, argv, "dictionary key ?key ...?"); + return JIM_ERR; + } + else { + int rc = Jim_DictKeysVector(interp, argv[2], argv + 3, argc - 3, &objPtr, JIM_ERRMSG); + if (rc < 0) { + return JIM_ERR; + } + Jim_SetResultBool(interp, rc == JIM_OK); + return JIM_OK; + } + + case OPT_UNSET: + if (argc < 4) { + Jim_WrongNumArgs(interp, 2, argv, "varName key ?key ...?"); + return JIM_ERR; + } + if (Jim_SetDictKeysVector(interp, argv[2], argv + 3, argc - 3, NULL, 0) != JIM_OK) { + return JIM_ERR; + } + return JIM_OK; + + case OPT_KEYS: + if (argc != 3 && argc != 4) { + Jim_WrongNumArgs(interp, 2, argv, "dictionary ?pattern?"); + return JIM_ERR; + } + return Jim_DictKeys(interp, argv[2], argc == 4 ? argv[3] : NULL); + + case OPT_SIZE: + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "dictionary"); + return JIM_ERR; + } + else if (Jim_DictSize(interp, argv[2]) < 0) { + return JIM_ERR; + } + Jim_SetResultInt(interp, Jim_DictSize(interp, argv[2])); + return JIM_OK; + + case OPT_MERGE: + if (argc == 2) { + return JIM_OK; + } + if (Jim_DictSize(interp, argv[2]) < 0) { + return JIM_ERR; + } + + break; + + case OPT_UPDATE: + if (argc < 6 || argc % 2) { + + argc = 2; + } + break; + + case OPT_CREATE: + if (argc % 2) { + Jim_WrongNumArgs(interp, 2, argv, "?key value ...?"); + return JIM_ERR; + } + objPtr = Jim_NewDictObj(interp, argv + 2, argc - 2); + Jim_SetResult(interp, objPtr); + return JIM_OK; + + case OPT_INFO: + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "dictionary"); + return JIM_ERR; + } + return Jim_DictInfo(interp, argv[2]); + } + + return Jim_EvalEnsemble(interp, "dict", options[option], argc - 2, argv + 2); +} + + +static int Jim_SubstCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + static const char * const options[] = { + "-nobackslashes", "-nocommands", "-novariables", NULL + }; + enum + { OPT_NOBACKSLASHES, OPT_NOCOMMANDS, OPT_NOVARIABLES }; + int i; + int flags = JIM_SUBST_FLAG; + Jim_Obj *objPtr; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "?options? string"); + return JIM_ERR; + } + for (i = 1; i < (argc - 1); i++) { + int option; + + if (Jim_GetEnum(interp, argv[i], options, &option, NULL, + JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { + return JIM_ERR; + } + switch (option) { + case OPT_NOBACKSLASHES: + flags |= JIM_SUBST_NOESC; + break; + case OPT_NOCOMMANDS: + flags |= JIM_SUBST_NOCMD; + break; + case OPT_NOVARIABLES: + flags |= JIM_SUBST_NOVAR; + break; + } + } + if (Jim_SubstObj(interp, argv[argc - 1], &objPtr, flags) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResult(interp, objPtr); + return JIM_OK; +} + + +static int Jim_InfoCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int cmd; + Jim_Obj *objPtr; + int mode = 0; + + static const char * const commands[] = { + "body", "statics", "commands", "procs", "channels", "exists", "globals", "level", "frame", "locals", + "vars", "version", "patchlevel", "complete", "args", "hostname", + "script", "source", "stacktrace", "nameofexecutable", "returncodes", + "references", "alias", NULL + }; + enum + { INFO_BODY, INFO_STATICS, INFO_COMMANDS, INFO_PROCS, INFO_CHANNELS, INFO_EXISTS, INFO_GLOBALS, INFO_LEVEL, + INFO_FRAME, INFO_LOCALS, INFO_VARS, INFO_VERSION, INFO_PATCHLEVEL, INFO_COMPLETE, INFO_ARGS, + INFO_HOSTNAME, INFO_SCRIPT, INFO_SOURCE, INFO_STACKTRACE, INFO_NAMEOFEXECUTABLE, + INFO_RETURNCODES, INFO_REFERENCES, INFO_ALIAS, + }; + +#ifdef jim_ext_namespace + int nons = 0; + + if (argc > 2 && Jim_CompareStringImmediate(interp, argv[1], "-nons")) { + + argc--; + argv++; + nons = 1; + } +#endif + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "subcommand ?args ...?"); + return JIM_ERR; + } + if (Jim_GetEnum(interp, argv[1], commands, &cmd, "subcommand", JIM_ERRMSG | JIM_ENUM_ABBREV) + != JIM_OK) { + return JIM_ERR; + } + + + switch (cmd) { + case INFO_EXISTS: + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "varName"); + return JIM_ERR; + } + Jim_SetResultBool(interp, Jim_GetVariable(interp, argv[2], 0) != NULL); + break; + + case INFO_ALIAS:{ + Jim_Cmd *cmdPtr; + + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "command"); + return JIM_ERR; + } + if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) { + return JIM_ERR; + } + if (cmdPtr->isproc || cmdPtr->u.native.cmdProc != JimAliasCmd) { + Jim_SetResultFormatted(interp, "command \"%#s\" is not an alias", argv[2]); + return JIM_ERR; + } + Jim_SetResult(interp, (Jim_Obj *)cmdPtr->u.native.privData); + return JIM_OK; + } + + case INFO_CHANNELS: + mode++; +#ifndef jim_ext_aio + Jim_SetResultString(interp, "aio not enabled", -1); + return JIM_ERR; +#endif + + case INFO_PROCS: + mode++; + + case INFO_COMMANDS: + + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "?pattern?"); + return JIM_ERR; + } +#ifdef jim_ext_namespace + if (!nons) { + if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) { + return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1); + } + } +#endif + Jim_SetResult(interp, JimCommandsList(interp, (argc == 3) ? argv[2] : NULL, mode)); + break; + + case INFO_VARS: + mode++; + + case INFO_LOCALS: + mode++; + + case INFO_GLOBALS: + + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "?pattern?"); + return JIM_ERR; + } +#ifdef jim_ext_namespace + if (!nons) { + if (Jim_Length(interp->framePtr->nsObj) || (argc == 3 && JimGlobMatch("::*", Jim_String(argv[2]), 0))) { + return Jim_EvalPrefix(interp, "namespace info", argc - 1, argv + 1); + } + } +#endif + Jim_SetResult(interp, JimVariablesList(interp, argc == 3 ? argv[2] : NULL, mode)); + break; + + case INFO_SCRIPT: + if (argc != 2) { + Jim_WrongNumArgs(interp, 2, argv, ""); + return JIM_ERR; + } + Jim_SetResult(interp, JimGetScript(interp, interp->currentScriptObj)->fileNameObj); + break; + + case INFO_SOURCE:{ + jim_wide line; + Jim_Obj *resObjPtr; + Jim_Obj *fileNameObj; + + if (argc != 3 && argc != 5) { + Jim_WrongNumArgs(interp, 2, argv, "source ?filename line?"); + return JIM_ERR; + } + if (argc == 5) { + if (Jim_GetWide(interp, argv[4], &line) != JIM_OK) { + return JIM_ERR; + } + resObjPtr = Jim_NewStringObj(interp, Jim_String(argv[2]), Jim_Length(argv[2])); + JimSetSourceInfo(interp, resObjPtr, argv[3], line); + } + else { + if (argv[2]->typePtr == &sourceObjType) { + fileNameObj = argv[2]->internalRep.sourceValue.fileNameObj; + line = argv[2]->internalRep.sourceValue.lineNumber; + } + else if (argv[2]->typePtr == &scriptObjType) { + ScriptObj *script = JimGetScript(interp, argv[2]); + fileNameObj = script->fileNameObj; + line = script->firstline; + } + else { + fileNameObj = interp->emptyObj; + line = 1; + } + resObjPtr = Jim_NewListObj(interp, NULL, 0); + Jim_ListAppendElement(interp, resObjPtr, fileNameObj); + Jim_ListAppendElement(interp, resObjPtr, Jim_NewIntObj(interp, line)); + } + Jim_SetResult(interp, resObjPtr); + break; + } + + case INFO_STACKTRACE: + Jim_SetResult(interp, interp->stackTrace); + break; + + case INFO_LEVEL: + case INFO_FRAME: + switch (argc) { + case 2: + Jim_SetResultInt(interp, interp->framePtr->level); + break; + + case 3: + if (JimInfoLevel(interp, argv[2], &objPtr, cmd == INFO_LEVEL) != JIM_OK) { + return JIM_ERR; + } + Jim_SetResult(interp, objPtr); + break; + + default: + Jim_WrongNumArgs(interp, 2, argv, "?levelNum?"); + return JIM_ERR; + } + break; + + case INFO_BODY: + case INFO_STATICS: + case INFO_ARGS:{ + Jim_Cmd *cmdPtr; + + if (argc != 3) { + Jim_WrongNumArgs(interp, 2, argv, "procname"); + return JIM_ERR; + } + if ((cmdPtr = Jim_GetCommand(interp, argv[2], JIM_ERRMSG)) == NULL) { + return JIM_ERR; + } + if (!cmdPtr->isproc) { + Jim_SetResultFormatted(interp, "command \"%#s\" is not a procedure", argv[2]); + return JIM_ERR; + } + switch (cmd) { + case INFO_BODY: + Jim_SetResult(interp, cmdPtr->u.proc.bodyObjPtr); + break; + case INFO_ARGS: + Jim_SetResult(interp, cmdPtr->u.proc.argListObjPtr); + break; + case INFO_STATICS: + if (cmdPtr->u.proc.staticVars) { + int mode = JIM_VARLIST_LOCALS | JIM_VARLIST_VALUES; + Jim_SetResult(interp, JimHashtablePatternMatch(interp, cmdPtr->u.proc.staticVars, + NULL, JimVariablesMatch, mode)); + } + break; + } + break; + } + + case INFO_VERSION: + case INFO_PATCHLEVEL:{ + char buf[(JIM_INTEGER_SPACE * 2) + 1]; + + sprintf(buf, "%d.%d", JIM_VERSION / 100, JIM_VERSION % 100); + Jim_SetResultString(interp, buf, -1); + break; + } + + case INFO_COMPLETE: + if (argc != 3 && argc != 4) { + Jim_WrongNumArgs(interp, 2, argv, "script ?missing?"); + return JIM_ERR; + } + else { + char missing; + + Jim_SetResultBool(interp, Jim_ScriptIsComplete(interp, argv[2], &missing)); + if (missing != ' ' && argc == 4) { + Jim_SetVariable(interp, argv[3], Jim_NewStringObj(interp, &missing, 1)); + } + } + break; + + case INFO_HOSTNAME: + + return Jim_Eval(interp, "os.gethostname"); + + case INFO_NAMEOFEXECUTABLE: + + return Jim_Eval(interp, "{info nameofexecutable}"); + + case INFO_RETURNCODES: + if (argc == 2) { + int i; + Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0); + + for (i = 0; jimReturnCodes[i]; i++) { + Jim_ListAppendElement(interp, listObjPtr, Jim_NewIntObj(interp, i)); + Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, + jimReturnCodes[i], -1)); + } + + Jim_SetResult(interp, listObjPtr); + } + else if (argc == 3) { + long code; + const char *name; + + if (Jim_GetLong(interp, argv[2], &code) != JIM_OK) { + return JIM_ERR; + } + name = Jim_ReturnCode(code); + if (*name == '?') { + Jim_SetResultInt(interp, code); + } + else { + Jim_SetResultString(interp, name, -1); + } + } + else { + Jim_WrongNumArgs(interp, 2, argv, "?code?"); + return JIM_ERR; + } + break; + case INFO_REFERENCES: +#ifdef JIM_REFERENCES + return JimInfoReferences(interp, argc, argv); +#else + Jim_SetResultString(interp, "not supported", -1); + return JIM_ERR; +#endif + } + return JIM_OK; +} + + +static int Jim_ExistsCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr; + int result = 0; + + static const char * const options[] = { + "-command", "-proc", "-alias", "-var", NULL + }; + enum + { + OPT_COMMAND, OPT_PROC, OPT_ALIAS, OPT_VAR + }; + int option; + + if (argc == 2) { + option = OPT_VAR; + objPtr = argv[1]; + } + else if (argc == 3) { + if (Jim_GetEnum(interp, argv[1], options, &option, NULL, JIM_ERRMSG | JIM_ENUM_ABBREV) != JIM_OK) { + return JIM_ERR; + } + objPtr = argv[2]; + } + else { + Jim_WrongNumArgs(interp, 1, argv, "?option? name"); + return JIM_ERR; + } + + if (option == OPT_VAR) { + result = Jim_GetVariable(interp, objPtr, 0) != NULL; + } + else { + + Jim_Cmd *cmd = Jim_GetCommand(interp, objPtr, JIM_NONE); + + if (cmd) { + switch (option) { + case OPT_COMMAND: + result = 1; + break; + + case OPT_ALIAS: + result = cmd->isproc == 0 && cmd->u.native.cmdProc == JimAliasCmd; + break; + + case OPT_PROC: + result = cmd->isproc; + break; + } + } + } + Jim_SetResultBool(interp, result); + return JIM_OK; +} + + +static int Jim_SplitCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *str, *splitChars, *noMatchStart; + int splitLen, strLen; + Jim_Obj *resObjPtr; + int c; + int len; + + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "string ?splitChars?"); + return JIM_ERR; + } + + str = Jim_GetString(argv[1], &len); + if (len == 0) { + return JIM_OK; + } + strLen = Jim_Utf8Length(interp, argv[1]); + + + if (argc == 2) { + splitChars = " \n\t\r"; + splitLen = 4; + } + else { + splitChars = Jim_String(argv[2]); + splitLen = Jim_Utf8Length(interp, argv[2]); + } + + noMatchStart = str; + resObjPtr = Jim_NewListObj(interp, NULL, 0); + + + if (splitLen) { + Jim_Obj *objPtr; + while (strLen--) { + const char *sc = splitChars; + int scLen = splitLen; + int sl = utf8_tounicode(str, &c); + while (scLen--) { + int pc; + sc += utf8_tounicode(sc, &pc); + if (c == pc) { + objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart)); + Jim_ListAppendElement(interp, resObjPtr, objPtr); + noMatchStart = str + sl; + break; + } + } + str += sl; + } + objPtr = Jim_NewStringObj(interp, noMatchStart, (str - noMatchStart)); + Jim_ListAppendElement(interp, resObjPtr, objPtr); + } + else { + Jim_Obj **commonObj = NULL; +#define NUM_COMMON (128 - 9) + while (strLen--) { + int n = utf8_tounicode(str, &c); +#ifdef JIM_OPTIMIZATION + if (c >= 9 && c < 128) { + + c -= 9; + if (!commonObj) { + commonObj = Jim_Alloc(sizeof(*commonObj) * NUM_COMMON); + memset(commonObj, 0, sizeof(*commonObj) * NUM_COMMON); + } + if (!commonObj[c]) { + commonObj[c] = Jim_NewStringObj(interp, str, 1); + } + Jim_ListAppendElement(interp, resObjPtr, commonObj[c]); + str++; + continue; + } +#endif + Jim_ListAppendElement(interp, resObjPtr, Jim_NewStringObjUtf8(interp, str, 1)); + str += n; + } + Jim_Free(commonObj); + } + + Jim_SetResult(interp, resObjPtr); + return JIM_OK; +} + + +static int Jim_JoinCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *joinStr; + int joinStrLen; + + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "list ?joinString?"); + return JIM_ERR; + } + + if (argc == 2) { + joinStr = " "; + joinStrLen = 1; + } + else { + joinStr = Jim_GetString(argv[2], &joinStrLen); + } + Jim_SetResult(interp, Jim_ListJoin(interp, argv[1], joinStr, joinStrLen)); + return JIM_OK; +} + + +static int Jim_FormatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr; + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "formatString ?arg arg ...?"); + return JIM_ERR; + } + objPtr = Jim_FormatString(interp, argv[1], argc - 2, argv + 2); + if (objPtr == NULL) + return JIM_ERR; + Jim_SetResult(interp, objPtr); + return JIM_OK; +} + + +static int Jim_ScanCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *listPtr, **outVec; + int outc, i; + + if (argc < 3) { + Jim_WrongNumArgs(interp, 1, argv, "string format ?varName varName ...?"); + return JIM_ERR; + } + if (argv[2]->typePtr != &scanFmtStringObjType) + SetScanFmtFromAny(interp, argv[2]); + if (FormatGetError(argv[2]) != 0) { + Jim_SetResultString(interp, FormatGetError(argv[2]), -1); + return JIM_ERR; + } + if (argc > 3) { + int maxPos = FormatGetMaxPos(argv[2]); + int count = FormatGetCnvCount(argv[2]); + + if (maxPos > argc - 3) { + Jim_SetResultString(interp, "\"%n$\" argument index out of range", -1); + return JIM_ERR; + } + else if (count > argc - 3) { + Jim_SetResultString(interp, "different numbers of variable names and " + "field specifiers", -1); + return JIM_ERR; + } + else if (count < argc - 3) { + Jim_SetResultString(interp, "variable is not assigned by any " + "conversion specifiers", -1); + return JIM_ERR; + } + } + listPtr = Jim_ScanString(interp, argv[1], argv[2], JIM_ERRMSG); + if (listPtr == 0) + return JIM_ERR; + if (argc > 3) { + int rc = JIM_OK; + int count = 0; + + if (listPtr != 0 && listPtr != (Jim_Obj *)EOF) { + int len = Jim_ListLength(interp, listPtr); + + if (len != 0) { + JimListGetElements(interp, listPtr, &outc, &outVec); + for (i = 0; i < outc; ++i) { + if (Jim_Length(outVec[i]) > 0) { + ++count; + if (Jim_SetVariable(interp, argv[3 + i], outVec[i]) != JIM_OK) { + rc = JIM_ERR; + } + } + } + } + Jim_FreeNewObj(interp, listPtr); + } + else { + count = -1; + } + if (rc == JIM_OK) { + Jim_SetResultInt(interp, count); + } + return rc; + } + else { + if (listPtr == (Jim_Obj *)EOF) { + Jim_SetResult(interp, Jim_NewListObj(interp, 0, 0)); + return JIM_OK; + } + Jim_SetResult(interp, listPtr); + } + return JIM_OK; +} + + +static int Jim_ErrorCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + if (argc != 2 && argc != 3) { + Jim_WrongNumArgs(interp, 1, argv, "message ?stacktrace?"); + return JIM_ERR; + } + Jim_SetResult(interp, argv[1]); + if (argc == 3) { + JimSetStackTrace(interp, argv[2]); + return JIM_ERR; + } + interp->addStackTrace++; + return JIM_ERR; +} + + +static int Jim_LrangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr; + + if (argc != 4) { + Jim_WrongNumArgs(interp, 1, argv, "list first last"); + return JIM_ERR; + } + if ((objPtr = Jim_ListRange(interp, argv[1], argv[2], argv[3])) == NULL) + return JIM_ERR; + Jim_SetResult(interp, objPtr); + return JIM_OK; +} + + +static int Jim_LrepeatCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *objPtr; + long count; + + if (argc < 2 || Jim_GetLong(interp, argv[1], &count) != JIM_OK || count < 0) { + Jim_WrongNumArgs(interp, 1, argv, "count ?value ...?"); + return JIM_ERR; + } + + if (count == 0 || argc == 2) { + return JIM_OK; + } + + argc -= 2; + argv += 2; + + objPtr = Jim_NewListObj(interp, argv, argc); + while (--count) { + ListInsertElements(objPtr, -1, argc, argv); + } + + Jim_SetResult(interp, objPtr); + return JIM_OK; +} + +char **Jim_GetEnviron(void) +{ +#if defined(HAVE__NSGETENVIRON) + return *_NSGetEnviron(); +#else + #if !defined(NO_ENVIRON_EXTERN) + extern char **environ; + #endif + + return environ; +#endif +} + +void Jim_SetEnviron(char **env) +{ +#if defined(HAVE__NSGETENVIRON) + *_NSGetEnviron() = env; +#else + #if !defined(NO_ENVIRON_EXTERN) + extern char **environ; + #endif + + environ = env; +#endif +} + + +static int Jim_EnvCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const char *key; + const char *val; + + if (argc == 1) { + char **e = Jim_GetEnviron(); + + int i; + Jim_Obj *listObjPtr = Jim_NewListObj(interp, NULL, 0); + + for (i = 0; e[i]; i++) { + const char *equals = strchr(e[i], '='); + + if (equals) { + Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, e[i], + equals - e[i])); + Jim_ListAppendElement(interp, listObjPtr, Jim_NewStringObj(interp, equals + 1, -1)); + } + } + + Jim_SetResult(interp, listObjPtr); + return JIM_OK; + } + + if (argc < 2) { + Jim_WrongNumArgs(interp, 1, argv, "varName ?default?"); + return JIM_ERR; + } + key = Jim_String(argv[1]); + val = getenv(key); + if (val == NULL) { + if (argc < 3) { + Jim_SetResultFormatted(interp, "environment variable \"%#s\" does not exist", argv[1]); + return JIM_ERR; + } + val = Jim_String(argv[2]); + } + Jim_SetResult(interp, Jim_NewStringObj(interp, val, -1)); + return JIM_OK; +} + + +static int Jim_SourceCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + int retval; + + if (argc != 2) { + Jim_WrongNumArgs(interp, 1, argv, "fileName"); + return JIM_ERR; + } + retval = Jim_EvalFile(interp, Jim_String(argv[1])); + if (retval == JIM_RETURN) + return JIM_OK; + return retval; +} + + +static int Jim_LreverseCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + Jim_Obj *revObjPtr, **ele; + int len; + + if (argc != 2) { + Jim_WrongNumArgs(interp, 1, argv, "list"); + return JIM_ERR; + } + JimListGetElements(interp, argv[1], &len, &ele); + len--; + revObjPtr = Jim_NewListObj(interp, NULL, 0); + while (len >= 0) + ListAppendElement(revObjPtr, ele[len--]); + Jim_SetResult(interp, revObjPtr); + return JIM_OK; +} + +static int JimRangeLen(jim_wide start, jim_wide end, jim_wide step) +{ + jim_wide len; + + if (step == 0) + return -1; + if (start == end) + return 0; + else if (step > 0 && start > end) + return -1; + else if (step < 0 && end > start) + return -1; + len = end - start; + if (len < 0) + len = -len; + if (step < 0) + step = -step; + len = 1 + ((len - 1) / step); + if (len > INT_MAX) + len = INT_MAX; + return (int)((len < 0) ? -1 : len); +} + + +static int Jim_RangeCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + jim_wide start = 0, end, step = 1; + int len, i; + Jim_Obj *objPtr; + + if (argc < 2 || argc > 4) { + Jim_WrongNumArgs(interp, 1, argv, "?start? end ?step?"); + return JIM_ERR; + } + if (argc == 2) { + if (Jim_GetWide(interp, argv[1], &end) != JIM_OK) + return JIM_ERR; + } + else { + if (Jim_GetWide(interp, argv[1], &start) != JIM_OK || + Jim_GetWide(interp, argv[2], &end) != JIM_OK) + return JIM_ERR; + if (argc == 4 && Jim_GetWide(interp, argv[3], &step) != JIM_OK) + return JIM_ERR; + } + if ((len = JimRangeLen(start, end, step)) == -1) { + Jim_SetResultString(interp, "Invalid (infinite?) range specified", -1); + return JIM_ERR; + } + objPtr = Jim_NewListObj(interp, NULL, 0); + for (i = 0; i < len; i++) + ListAppendElement(objPtr, Jim_NewIntObj(interp, start + i * step)); + Jim_SetResult(interp, objPtr); + return JIM_OK; +} + + +static int Jim_RandCoreCommand(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + jim_wide min = 0, max = 0, len, maxMul; + + if (argc < 1 || argc > 3) { + Jim_WrongNumArgs(interp, 1, argv, "?min? max"); + return JIM_ERR; + } + if (argc == 1) { + max = JIM_WIDE_MAX; + } else if (argc == 2) { + if (Jim_GetWide(interp, argv[1], &max) != JIM_OK) + return JIM_ERR; + } else if (argc == 3) { + if (Jim_GetWide(interp, argv[1], &min) != JIM_OK || + Jim_GetWide(interp, argv[2], &max) != JIM_OK) + return JIM_ERR; + } + len = max-min; + if (len < 0) { + Jim_SetResultString(interp, "Invalid arguments (max < min)", -1); + return JIM_ERR; + } + maxMul = JIM_WIDE_MAX - (len ? (JIM_WIDE_MAX%len) : 0); + while (1) { + jim_wide r; + + JimRandomBytes(interp, &r, sizeof(jim_wide)); + if (r < 0 || r >= maxMul) continue; + r = (len == 0) ? 0 : r%len; + Jim_SetResultInt(interp, min+r); + return JIM_OK; + } +} + +static const struct { + const char *name; + Jim_CmdProc *cmdProc; +} Jim_CoreCommandsTable[] = { + {"alias", Jim_AliasCoreCommand}, + {"set", Jim_SetCoreCommand}, + {"unset", Jim_UnsetCoreCommand}, + {"puts", Jim_PutsCoreCommand}, + {"+", Jim_AddCoreCommand}, + {"*", Jim_MulCoreCommand}, + {"-", Jim_SubCoreCommand}, + {"/", Jim_DivCoreCommand}, + {"incr", Jim_IncrCoreCommand}, + {"while", Jim_WhileCoreCommand}, + {"loop", Jim_LoopCoreCommand}, + {"for", Jim_ForCoreCommand}, + {"foreach", Jim_ForeachCoreCommand}, + {"lmap", Jim_LmapCoreCommand}, + {"lassign", Jim_LassignCoreCommand}, + {"if", Jim_IfCoreCommand}, + {"switch", Jim_SwitchCoreCommand}, + {"list", Jim_ListCoreCommand}, + {"lindex", Jim_LindexCoreCommand}, + {"lset", Jim_LsetCoreCommand}, + {"lsearch", Jim_LsearchCoreCommand}, + {"llength", Jim_LlengthCoreCommand}, + {"lappend", Jim_LappendCoreCommand}, + {"linsert", Jim_LinsertCoreCommand}, + {"lreplace", Jim_LreplaceCoreCommand}, + {"lsort", Jim_LsortCoreCommand}, + {"append", Jim_AppendCoreCommand}, + {"debug", Jim_DebugCoreCommand}, + {"eval", Jim_EvalCoreCommand}, + {"uplevel", Jim_UplevelCoreCommand}, + {"expr", Jim_ExprCoreCommand}, + {"break", Jim_BreakCoreCommand}, + {"continue", Jim_ContinueCoreCommand}, + {"proc", Jim_ProcCoreCommand}, + {"concat", Jim_ConcatCoreCommand}, + {"return", Jim_ReturnCoreCommand}, + {"upvar", Jim_UpvarCoreCommand}, + {"global", Jim_GlobalCoreCommand}, + {"string", Jim_StringCoreCommand}, + {"time", Jim_TimeCoreCommand}, + {"exit", Jim_ExitCoreCommand}, + {"catch", Jim_CatchCoreCommand}, +#ifdef JIM_REFERENCES + {"ref", Jim_RefCoreCommand}, + {"getref", Jim_GetrefCoreCommand}, + {"setref", Jim_SetrefCoreCommand}, + {"finalize", Jim_FinalizeCoreCommand}, + {"collect", Jim_CollectCoreCommand}, +#endif + {"rename", Jim_RenameCoreCommand}, + {"dict", Jim_DictCoreCommand}, + {"subst", Jim_SubstCoreCommand}, + {"info", Jim_InfoCoreCommand}, + {"exists", Jim_ExistsCoreCommand}, + {"split", Jim_SplitCoreCommand}, + {"join", Jim_JoinCoreCommand}, + {"format", Jim_FormatCoreCommand}, + {"scan", Jim_ScanCoreCommand}, + {"error", Jim_ErrorCoreCommand}, + {"lrange", Jim_LrangeCoreCommand}, + {"lrepeat", Jim_LrepeatCoreCommand}, + {"env", Jim_EnvCoreCommand}, + {"source", Jim_SourceCoreCommand}, + {"lreverse", Jim_LreverseCoreCommand}, + {"range", Jim_RangeCoreCommand}, + {"rand", Jim_RandCoreCommand}, + {"tailcall", Jim_TailcallCoreCommand}, + {"local", Jim_LocalCoreCommand}, + {"upcall", Jim_UpcallCoreCommand}, + {"apply", Jim_ApplyCoreCommand}, + {NULL, NULL}, +}; + +void Jim_RegisterCoreCommands(Jim_Interp *interp) +{ + int i = 0; + + while (Jim_CoreCommandsTable[i].name != NULL) { + Jim_CreateCommand(interp, + Jim_CoreCommandsTable[i].name, Jim_CoreCommandsTable[i].cmdProc, NULL, NULL); + i++; + } +} + +void Jim_MakeErrorMessage(Jim_Interp *interp) +{ + Jim_Obj *argv[2]; + + argv[0] = Jim_NewStringObj(interp, "errorInfo", -1); + argv[1] = interp->result; + + Jim_EvalObjVector(interp, 2, argv); +} + +static void JimSetFailedEnumResult(Jim_Interp *interp, const char *arg, const char *badtype, + const char *prefix, const char *const *tablePtr, const char *name) +{ + int count; + char **tablePtrSorted; + int i; + + for (count = 0; tablePtr[count]; count++) { + } + + if (name == NULL) { + name = "option"; + } + + Jim_SetResultFormatted(interp, "%s%s \"%s\": must be ", badtype, name, arg); + tablePtrSorted = Jim_Alloc(sizeof(char *) * count); + memcpy(tablePtrSorted, tablePtr, sizeof(char *) * count); + qsort(tablePtrSorted, count, sizeof(char *), qsortCompareStringPointers); + for (i = 0; i < count; i++) { + if (i + 1 == count && count > 1) { + Jim_AppendString(interp, Jim_GetResult(interp), "or ", -1); + } + Jim_AppendStrings(interp, Jim_GetResult(interp), prefix, tablePtrSorted[i], NULL); + if (i + 1 != count) { + Jim_AppendString(interp, Jim_GetResult(interp), ", ", -1); + } + } + Jim_Free(tablePtrSorted); +} + +int Jim_GetEnum(Jim_Interp *interp, Jim_Obj *objPtr, + const char *const *tablePtr, int *indexPtr, const char *name, int flags) +{ + const char *bad = "bad "; + const char *const *entryPtr = NULL; + int i; + int match = -1; + int arglen; + const char *arg = Jim_GetString(objPtr, &arglen); + + *indexPtr = -1; + + for (entryPtr = tablePtr, i = 0; *entryPtr != NULL; entryPtr++, i++) { + if (Jim_CompareStringImmediate(interp, objPtr, *entryPtr)) { + + *indexPtr = i; + return JIM_OK; + } + if (flags & JIM_ENUM_ABBREV) { + if (strncmp(arg, *entryPtr, arglen) == 0) { + if (*arg == '-' && arglen == 1) { + break; + } + if (match >= 0) { + bad = "ambiguous "; + goto ambiguous; + } + match = i; + } + } + } + + + if (match >= 0) { + *indexPtr = match; + return JIM_OK; + } + + ambiguous: + if (flags & JIM_ERRMSG) { + JimSetFailedEnumResult(interp, arg, bad, "", tablePtr, name); + } + return JIM_ERR; +} + +int Jim_FindByName(const char *name, const char * const array[], size_t len) +{ + int i; + + for (i = 0; i < (int)len; i++) { + if (array[i] && strcmp(array[i], name) == 0) { + return i; + } + } + return -1; +} + +int Jim_IsDict(Jim_Obj *objPtr) +{ + return objPtr->typePtr == &dictObjType; +} + +int Jim_IsList(Jim_Obj *objPtr) +{ + return objPtr->typePtr == &listObjType; +} + +void Jim_SetResultFormatted(Jim_Interp *interp, const char *format, ...) +{ + + int len = strlen(format); + int extra = 0; + int n = 0; + const char *params[5]; + char *buf; + va_list args; + int i; + + va_start(args, format); + + for (i = 0; i < len && n < 5; i++) { + int l; + + if (strncmp(format + i, "%s", 2) == 0) { + params[n] = va_arg(args, char *); + + l = strlen(params[n]); + } + else if (strncmp(format + i, "%#s", 3) == 0) { + Jim_Obj *objPtr = va_arg(args, Jim_Obj *); + + params[n] = Jim_GetString(objPtr, &l); + } + else { + if (format[i] == '%') { + i++; + } + continue; + } + n++; + extra += l; + } + + len += extra; + buf = Jim_Alloc(len + 1); + len = snprintf(buf, len + 1, format, params[0], params[1], params[2], params[3], params[4]); + + va_end(args); + + Jim_SetResult(interp, Jim_NewStringObjNoAlloc(interp, buf, len)); +} + + +#ifndef jim_ext_package +int Jim_PackageProvide(Jim_Interp *interp, const char *name, const char *ver, int flags) +{ + return JIM_OK; +} +#endif +#ifndef jim_ext_aio +FILE *Jim_AioFilehandle(Jim_Interp *interp, Jim_Obj *fhObj) +{ + Jim_SetResultString(interp, "aio not enabled", -1); + return NULL; +} +#endif + + +#include +#include + + +static int subcmd_null(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + + return JIM_OK; +} + +static const jim_subcmd_type dummy_subcmd = { + "dummy", NULL, subcmd_null, 0, 0, JIM_MODFLAG_HIDDEN +}; + +static void add_commands(Jim_Interp *interp, const jim_subcmd_type * ct, const char *sep) +{ + const char *s = ""; + + for (; ct->cmd; ct++) { + if (!(ct->flags & JIM_MODFLAG_HIDDEN)) { + Jim_AppendStrings(interp, Jim_GetResult(interp), s, ct->cmd, NULL); + s = sep; + } + } +} + +static void bad_subcmd(Jim_Interp *interp, const jim_subcmd_type * command_table, const char *type, + Jim_Obj *cmd, Jim_Obj *subcmd) +{ + Jim_SetResult(interp, Jim_NewEmptyStringObj(interp)); + Jim_AppendStrings(interp, Jim_GetResult(interp), Jim_String(cmd), ", ", type, + " command \"", Jim_String(subcmd), "\": should be ", NULL); + add_commands(interp, command_table, ", "); +} + +static void show_cmd_usage(Jim_Interp *interp, const jim_subcmd_type * command_table, int argc, + Jim_Obj *const *argv) +{ + Jim_SetResult(interp, Jim_NewEmptyStringObj(interp)); + Jim_AppendStrings(interp, Jim_GetResult(interp), "Usage: \"", Jim_String(argv[0]), + " command ... \", where command is one of: ", NULL); + add_commands(interp, command_table, ", "); +} + +static void add_cmd_usage(Jim_Interp *interp, const jim_subcmd_type * ct, Jim_Obj *cmd) +{ + if (cmd) { + Jim_AppendStrings(interp, Jim_GetResult(interp), Jim_String(cmd), " ", NULL); + } + Jim_AppendStrings(interp, Jim_GetResult(interp), ct->cmd, NULL); + if (ct->args && *ct->args) { + Jim_AppendStrings(interp, Jim_GetResult(interp), " ", ct->args, NULL); + } +} + +static void set_wrong_args(Jim_Interp *interp, const jim_subcmd_type * command_table, Jim_Obj *subcmd) +{ + Jim_SetResultString(interp, "wrong # args: should be \"", -1); + add_cmd_usage(interp, command_table, subcmd); + Jim_AppendStrings(interp, Jim_GetResult(interp), "\"", NULL); +} + +const jim_subcmd_type *Jim_ParseSubCmd(Jim_Interp *interp, const jim_subcmd_type * command_table, + int argc, Jim_Obj *const *argv) +{ + const jim_subcmd_type *ct; + const jim_subcmd_type *partial = 0; + int cmdlen; + Jim_Obj *cmd; + const char *cmdstr; + const char *cmdname; + int help = 0; + + cmdname = Jim_String(argv[0]); + + if (argc < 2) { + Jim_SetResult(interp, Jim_NewEmptyStringObj(interp)); + Jim_AppendStrings(interp, Jim_GetResult(interp), "wrong # args: should be \"", cmdname, + " command ...\"\n", NULL); + Jim_AppendStrings(interp, Jim_GetResult(interp), "Use \"", cmdname, " -help ?command?\" for help", NULL); + return 0; + } + + cmd = argv[1]; + + + if (Jim_CompareStringImmediate(interp, cmd, "-help")) { + if (argc == 2) { + + show_cmd_usage(interp, command_table, argc, argv); + return &dummy_subcmd; + } + help = 1; + + + cmd = argv[2]; + } + + + if (Jim_CompareStringImmediate(interp, cmd, "-commands")) { + + Jim_SetResult(interp, Jim_NewEmptyStringObj(interp)); + add_commands(interp, command_table, " "); + return &dummy_subcmd; + } + + cmdstr = Jim_GetString(cmd, &cmdlen); + + for (ct = command_table; ct->cmd; ct++) { + if (Jim_CompareStringImmediate(interp, cmd, ct->cmd)) { + + break; + } + if (strncmp(cmdstr, ct->cmd, cmdlen) == 0) { + if (partial) { + + if (help) { + + show_cmd_usage(interp, command_table, argc, argv); + return &dummy_subcmd; + } + bad_subcmd(interp, command_table, "ambiguous", argv[0], argv[1 + help]); + return 0; + } + partial = ct; + } + continue; + } + + + if (partial && !ct->cmd) { + ct = partial; + } + + if (!ct->cmd) { + + if (help) { + + show_cmd_usage(interp, command_table, argc, argv); + return &dummy_subcmd; + } + bad_subcmd(interp, command_table, "unknown", argv[0], argv[1 + help]); + return 0; + } + + if (help) { + Jim_SetResultString(interp, "Usage: ", -1); + + add_cmd_usage(interp, ct, argv[0]); + return &dummy_subcmd; + } + + + if (argc - 2 < ct->minargs || (ct->maxargs >= 0 && argc - 2 > ct->maxargs)) { + Jim_SetResultString(interp, "wrong # args: should be \"", -1); + + add_cmd_usage(interp, ct, argv[0]); + Jim_AppendStrings(interp, Jim_GetResult(interp), "\"", NULL); + + return 0; + } + + + return ct; +} + +int Jim_CallSubCmd(Jim_Interp *interp, const jim_subcmd_type * ct, int argc, Jim_Obj *const *argv) +{ + int ret = JIM_ERR; + + if (ct) { + if (ct->flags & JIM_MODFLAG_FULLARGV) { + ret = ct->function(interp, argc, argv); + } + else { + ret = ct->function(interp, argc - 2, argv + 2); + } + if (ret < 0) { + set_wrong_args(interp, ct, argv[0]); + ret = JIM_ERR; + } + } + return ret; +} + +int Jim_SubCmdProc(Jim_Interp *interp, int argc, Jim_Obj *const *argv) +{ + const jim_subcmd_type *ct = + Jim_ParseSubCmd(interp, (const jim_subcmd_type *)Jim_CmdPrivData(interp), argc, argv); + + return Jim_CallSubCmd(interp, ct, argc, argv); +} + +#include +#include +#include +#include +#include + + +int utf8_fromunicode(char *p, unsigned uc) +{ + if (uc <= 0x7f) { + *p = uc; + return 1; + } + else if (uc <= 0x7ff) { + *p++ = 0xc0 | ((uc & 0x7c0) >> 6); + *p = 0x80 | (uc & 0x3f); + return 2; + } + else if (uc <= 0xffff) { + *p++ = 0xe0 | ((uc & 0xf000) >> 12); + *p++ = 0x80 | ((uc & 0xfc0) >> 6); + *p = 0x80 | (uc & 0x3f); + return 3; + } + + else { + *p++ = 0xf0 | ((uc & 0x1c0000) >> 18); + *p++ = 0x80 | ((uc & 0x3f000) >> 12); + *p++ = 0x80 | ((uc & 0xfc0) >> 6); + *p = 0x80 | (uc & 0x3f); + return 4; + } +} + +#include +#include + + +#define JIM_INTEGER_SPACE 24 +#define MAX_FLOAT_WIDTH 320 + +Jim_Obj *Jim_FormatString(Jim_Interp *interp, Jim_Obj *fmtObjPtr, int objc, Jim_Obj *const *objv) +{ + const char *span, *format, *formatEnd, *msg; + int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0; + static const char * const mixedXPG = + "cannot mix \"%\" and \"%n$\" conversion specifiers"; + static const char * const badIndex[2] = { + "not enough arguments for all format specifiers", + "\"%n$\" argument index out of range" + }; + int formatLen; + Jim_Obj *resultPtr; + + char *num_buffer = NULL; + int num_buffer_size = 0; + + span = format = Jim_GetString(fmtObjPtr, &formatLen); + formatEnd = format + formatLen; + resultPtr = Jim_NewEmptyStringObj(interp); + + while (format != formatEnd) { + char *end; + int gotMinus, sawFlag; + int gotPrecision, useShort; + long width, precision; + int newXpg; + int ch; + int step; + int doubleType; + char pad = ' '; + char spec[2*JIM_INTEGER_SPACE + 12]; + char *p; + + int formatted_chars; + int formatted_bytes; + const char *formatted_buf; + + step = utf8_tounicode(format, &ch); + format += step; + if (ch != '%') { + numBytes += step; + continue; + } + if (numBytes) { + Jim_AppendString(interp, resultPtr, span, numBytes); + numBytes = 0; + } + + + step = utf8_tounicode(format, &ch); + if (ch == '%') { + span = format; + numBytes = step; + format += step; + continue; + } + + + newXpg = 0; + if (isdigit(ch)) { + int position = strtoul(format, &end, 10); + if (*end == '$') { + newXpg = 1; + objIndex = position - 1; + format = end + 1; + step = utf8_tounicode(format, &ch); + } + } + if (newXpg) { + if (gotSequential) { + msg = mixedXPG; + goto errorMsg; + } + gotXpg = 1; + } else { + if (gotXpg) { + msg = mixedXPG; + goto errorMsg; + } + gotSequential = 1; + } + if ((objIndex < 0) || (objIndex >= objc)) { + msg = badIndex[gotXpg]; + goto errorMsg; + } + + p = spec; + *p++ = '%'; + + gotMinus = 0; + sawFlag = 1; + do { + switch (ch) { + case '-': + gotMinus = 1; + break; + case '0': + pad = ch; + break; + case ' ': + case '+': + case '#': + break; + default: + sawFlag = 0; + continue; + } + *p++ = ch; + format += step; + step = utf8_tounicode(format, &ch); + } while (sawFlag); + + + width = 0; + if (isdigit(ch)) { + width = strtoul(format, &end, 10); + format = end; + step = utf8_tounicode(format, &ch); + } else if (ch == '*') { + if (objIndex >= objc - 1) { + msg = badIndex[gotXpg]; + goto errorMsg; + } + if (Jim_GetLong(interp, objv[objIndex], &width) != JIM_OK) { + goto error; + } + if (width < 0) { + width = -width; + if (!gotMinus) { + *p++ = '-'; + gotMinus = 1; + } + } + objIndex++; + format += step; + step = utf8_tounicode(format, &ch); + } + + + gotPrecision = precision = 0; + if (ch == '.') { + gotPrecision = 1; + format += step; + step = utf8_tounicode(format, &ch); + } + if (isdigit(ch)) { + precision = strtoul(format, &end, 10); + format = end; + step = utf8_tounicode(format, &ch); + } else if (ch == '*') { + if (objIndex >= objc - 1) { + msg = badIndex[gotXpg]; + goto errorMsg; + } + if (Jim_GetLong(interp, objv[objIndex], &precision) != JIM_OK) { + goto error; + } + + + if (precision < 0) { + precision = 0; + } + objIndex++; + format += step; + step = utf8_tounicode(format, &ch); + } + + + useShort = 0; + if (ch == 'h') { + useShort = 1; + format += step; + step = utf8_tounicode(format, &ch); + } else if (ch == 'l') { + + format += step; + step = utf8_tounicode(format, &ch); + if (ch == 'l') { + format += step; + step = utf8_tounicode(format, &ch); + } + } + + format += step; + span = format; + + + if (ch == 'i') { + ch = 'd'; + } + + doubleType = 0; + + switch (ch) { + case '\0': + msg = "format string ended in middle of field specifier"; + goto errorMsg; + case 's': { + formatted_buf = Jim_GetString(objv[objIndex], &formatted_bytes); + formatted_chars = Jim_Utf8Length(interp, objv[objIndex]); + if (gotPrecision && (precision < formatted_chars)) { + + formatted_chars = precision; + formatted_bytes = utf8_index(formatted_buf, precision); + } + break; + } + case 'c': { + jim_wide code; + + if (Jim_GetWide(interp, objv[objIndex], &code) != JIM_OK) { + goto error; + } + + formatted_bytes = utf8_getchars(spec, code); + formatted_buf = spec; + formatted_chars = 1; + break; + } + case 'b': { + unsigned jim_wide w; + int length; + int i; + int j; + + if (Jim_GetWide(interp, objv[objIndex], (jim_wide *)&w) != JIM_OK) { + goto error; + } + length = sizeof(w) * 8; + + + + if (num_buffer_size < length + 1) { + num_buffer_size = length + 1; + num_buffer = Jim_Realloc(num_buffer, num_buffer_size); + } + + j = 0; + for (i = length; i > 0; ) { + i--; + if (w & ((unsigned jim_wide)1 << i)) { + num_buffer[j++] = '1'; + } + else if (j || i == 0) { + num_buffer[j++] = '0'; + } + } + num_buffer[j] = 0; + formatted_chars = formatted_bytes = j; + formatted_buf = num_buffer; + break; + } + + case 'e': + case 'E': + case 'f': + case 'g': + case 'G': + doubleType = 1; + + case 'd': + case 'u': + case 'o': + case 'x': + case 'X': { + jim_wide w; + double d; + int length; + + + if (width) { + p += sprintf(p, "%ld", width); + } + if (gotPrecision) { + p += sprintf(p, ".%ld", precision); + } + + + if (doubleType) { + if (Jim_GetDouble(interp, objv[objIndex], &d) != JIM_OK) { + goto error; + } + length = MAX_FLOAT_WIDTH; + } + else { + if (Jim_GetWide(interp, objv[objIndex], &w) != JIM_OK) { + goto error; + } + length = JIM_INTEGER_SPACE; + if (useShort) { + if (ch == 'd') { + w = (short)w; + } + else { + w = (unsigned short)w; + } + } + *p++ = 'l'; +#ifdef HAVE_LONG_LONG + if (sizeof(long long) == sizeof(jim_wide)) { + *p++ = 'l'; + } +#endif + } + + *p++ = (char) ch; + *p = '\0'; + + + if (width > length) { + length = width; + } + if (gotPrecision) { + length += precision; + } + + + if (num_buffer_size < length + 1) { + num_buffer_size = length + 1; + num_buffer = Jim_Realloc(num_buffer, num_buffer_size); + } + + if (doubleType) { + snprintf(num_buffer, length + 1, spec, d); + } + else { + formatted_bytes = snprintf(num_buffer, length + 1, spec, w); + } + formatted_chars = formatted_bytes = strlen(num_buffer); + formatted_buf = num_buffer; + break; + } + + default: { + + spec[0] = ch; + spec[1] = '\0'; + Jim_SetResultFormatted(interp, "bad field specifier \"%s\"", spec); + goto error; + } + } + + if (!gotMinus) { + while (formatted_chars < width) { + Jim_AppendString(interp, resultPtr, &pad, 1); + formatted_chars++; + } + } + + Jim_AppendString(interp, resultPtr, formatted_buf, formatted_bytes); + + while (formatted_chars < width) { + Jim_AppendString(interp, resultPtr, &pad, 1); + formatted_chars++; + } + + objIndex += gotSequential; + } + if (numBytes) { + Jim_AppendString(interp, resultPtr, span, numBytes); + } + + Jim_Free(num_buffer); + return resultPtr; + + errorMsg: + Jim_SetResultString(interp, msg, -1); + error: + Jim_FreeNewObj(interp, resultPtr); + Jim_Free(num_buffer); + return NULL; +} + + +#if defined(JIM_REGEXP) +#include +#include +#include +#include + + + +#define REG_MAX_PAREN 100 + + + +#define END 0 +#define BOL 1 +#define EOL 2 +#define ANY 3 +#define ANYOF 4 +#define ANYBUT 5 +#define BRANCH 6 +#define BACK 7 +#define EXACTLY 8 +#define NOTHING 9 +#define REP 10 +#define REPMIN 11 +#define REPX 12 +#define REPXMIN 13 +#define BOLX 14 +#define EOLX 15 +#define WORDA 16 +#define WORDZ 17 + +#define OPENNC 1000 +#define OPEN 1001 + + + + +#define CLOSENC 2000 +#define CLOSE 2001 +#define CLOSE_END (CLOSE+REG_MAX_PAREN) + +#define REG_MAGIC 0xFADED00D + + +#define OP(preg, p) (preg->program[p]) +#define NEXT(preg, p) (preg->program[p + 1]) +#define OPERAND(p) ((p) + 2) + + + + +#define FAIL(R,M) { (R)->err = (M); return (M); } +#define ISMULT(c) ((c) == '*' || (c) == '+' || (c) == '?' || (c) == '{') +#define META "^$.[()|?{+*" + +#define HASWIDTH 1 +#define SIMPLE 2 +#define SPSTART 4 +#define WORST 0 + +#define MAX_REP_COUNT 1000000 + +static int reg(regex_t *preg, int paren , int *flagp ); +static int regpiece(regex_t *preg, int *flagp ); +static int regbranch(regex_t *preg, int *flagp ); +static int regatom(regex_t *preg, int *flagp ); +static int regnode(regex_t *preg, int op ); +static int regnext(regex_t *preg, int p ); +static void regc(regex_t *preg, int b ); +static int reginsert(regex_t *preg, int op, int size, int opnd ); +static void regtail(regex_t *preg, int p, int val); +static void regoptail(regex_t *preg, int p, int val ); +static int regopsize(regex_t *preg, int p ); + +static int reg_range_find(const int *string, int c); +static const char *str_find(const char *string, int c, int nocase); +static int prefix_cmp(const int *prog, int proglen, const char *string, int nocase); + + +#ifdef DEBUG +static int regnarrate = 0; +static void regdump(regex_t *preg); +static const char *regprop( int op ); +#endif + + +static int str_int_len(const int *seq) +{ + int n = 0; + while (*seq++) { + n++; + } + return n; +} + +int regcomp(regex_t *preg, const char *exp, int cflags) +{ + int scan; + int longest; + unsigned len; + int flags; + +#ifdef DEBUG + fprintf(stderr, "Compiling: '%s'\n", exp); +#endif + memset(preg, 0, sizeof(*preg)); + + if (exp == NULL) + FAIL(preg, REG_ERR_NULL_ARGUMENT); + + + preg->cflags = cflags; + preg->regparse = exp; + + + preg->proglen = (strlen(exp) + 1) * 5; + preg->program = malloc(preg->proglen * sizeof(int)); + if (preg->program == NULL) + FAIL(preg, REG_ERR_NOMEM); + + regc(preg, REG_MAGIC); + if (reg(preg, 0, &flags) == 0) { + return preg->err; + } + + + if (preg->re_nsub >= REG_MAX_PAREN) + FAIL(preg,REG_ERR_TOO_BIG); + + + preg->regstart = 0; + preg->reganch = 0; + preg->regmust = 0; + preg->regmlen = 0; + scan = 1; + if (OP(preg, regnext(preg, scan)) == END) { + scan = OPERAND(scan); + + + if (OP(preg, scan) == EXACTLY) { + preg->regstart = preg->program[OPERAND(scan)]; + } + else if (OP(preg, scan) == BOL) + preg->reganch++; + + if (flags&SPSTART) { + longest = 0; + len = 0; + for (; scan != 0; scan = regnext(preg, scan)) { + if (OP(preg, scan) == EXACTLY) { + int plen = str_int_len(preg->program + OPERAND(scan)); + if (plen >= len) { + longest = OPERAND(scan); + len = plen; + } + } + } + preg->regmust = longest; + preg->regmlen = len; + } + } + +#ifdef DEBUG + regdump(preg); +#endif + + return 0; +} + +static int reg(regex_t *preg, int paren , int *flagp ) +{ + int ret; + int br; + int ender; + int parno = 0; + int flags; + + *flagp = HASWIDTH; + + + if (paren) { + if (preg->regparse[0] == '?' && preg->regparse[1] == ':') { + + preg->regparse += 2; + parno = -1; + } + else { + parno = ++preg->re_nsub; + } + ret = regnode(preg, OPEN+parno); + } else + ret = 0; + + + br = regbranch(preg, &flags); + if (br == 0) + return 0; + if (ret != 0) + regtail(preg, ret, br); + else + ret = br; + if (!(flags&HASWIDTH)) + *flagp &= ~HASWIDTH; + *flagp |= flags&SPSTART; + while (*preg->regparse == '|') { + preg->regparse++; + br = regbranch(preg, &flags); + if (br == 0) + return 0; + regtail(preg, ret, br); + if (!(flags&HASWIDTH)) + *flagp &= ~HASWIDTH; + *flagp |= flags&SPSTART; + } + + + ender = regnode(preg, (paren) ? CLOSE+parno : END); + regtail(preg, ret, ender); + + + for (br = ret; br != 0; br = regnext(preg, br)) + regoptail(preg, br, ender); + + + if (paren && *preg->regparse++ != ')') { + preg->err = REG_ERR_UNMATCHED_PAREN; + return 0; + } else if (!paren && *preg->regparse != '\0') { + if (*preg->regparse == ')') { + preg->err = REG_ERR_UNMATCHED_PAREN; + return 0; + } else { + preg->err = REG_ERR_JUNK_ON_END; + return 0; + } + } + + return(ret); +} + +static int regbranch(regex_t *preg, int *flagp ) +{ + int ret; + int chain; + int latest; + int flags; + + *flagp = WORST; + + ret = regnode(preg, BRANCH); + chain = 0; + while (*preg->regparse != '\0' && *preg->regparse != ')' && + *preg->regparse != '|') { + latest = regpiece(preg, &flags); + if (latest == 0) + return 0; + *flagp |= flags&HASWIDTH; + if (chain == 0) { + *flagp |= flags&SPSTART; + } + else { + regtail(preg, chain, latest); + } + chain = latest; + } + if (chain == 0) + (void) regnode(preg, NOTHING); + + return(ret); +} + +static int regpiece(regex_t *preg, int *flagp) +{ + int ret; + char op; + int next; + int flags; + int min; + int max; + + ret = regatom(preg, &flags); + if (ret == 0) + return 0; + + op = *preg->regparse; + if (!ISMULT(op)) { + *flagp = flags; + return(ret); + } + + if (!(flags&HASWIDTH) && op != '?') { + preg->err = REG_ERR_OPERAND_COULD_BE_EMPTY; + return 0; + } + + + if (op == '{') { + char *end; + + min = strtoul(preg->regparse + 1, &end, 10); + if (end == preg->regparse + 1) { + preg->err = REG_ERR_BAD_COUNT; + return 0; + } + if (*end == '}') { + max = min; + } + else { + preg->regparse = end; + max = strtoul(preg->regparse + 1, &end, 10); + if (*end != '}') { + preg->err = REG_ERR_UNMATCHED_BRACES; + return 0; + } + } + if (end == preg->regparse + 1) { + max = MAX_REP_COUNT; + } + else if (max < min || max >= 100) { + preg->err = REG_ERR_BAD_COUNT; + return 0; + } + if (min >= 100) { + preg->err = REG_ERR_BAD_COUNT; + return 0; + } + + preg->regparse = strchr(preg->regparse, '}'); + } + else { + min = (op == '+'); + max = (op == '?' ? 1 : MAX_REP_COUNT); + } + + if (preg->regparse[1] == '?') { + preg->regparse++; + next = reginsert(preg, flags & SIMPLE ? REPMIN : REPXMIN, 5, ret); + } + else { + next = reginsert(preg, flags & SIMPLE ? REP: REPX, 5, ret); + } + preg->program[ret + 2] = max; + preg->program[ret + 3] = min; + preg->program[ret + 4] = 0; + + *flagp = (min) ? (WORST|HASWIDTH) : (WORST|SPSTART); + + if (!(flags & SIMPLE)) { + int back = regnode(preg, BACK); + regtail(preg, back, ret); + regtail(preg, next, back); + } + + preg->regparse++; + if (ISMULT(*preg->regparse)) { + preg->err = REG_ERR_NESTED_COUNT; + return 0; + } + + return ret; +} + +static void reg_addrange(regex_t *preg, int lower, int upper) +{ + if (lower > upper) { + reg_addrange(preg, upper, lower); + } + + regc(preg, upper - lower + 1); + regc(preg, lower); +} + +static void reg_addrange_str(regex_t *preg, const char *str) +{ + while (*str) { + reg_addrange(preg, *str, *str); + str++; + } +} + +static int reg_utf8_tounicode_case(const char *s, int *uc, int upper) +{ + int l = utf8_tounicode(s, uc); + if (upper) { + *uc = utf8_upper(*uc); + } + return l; +} + +static int hexdigitval(int c) +{ + if (c >= '0' && c <= '9') + return c - '0'; + if (c >= 'a' && c <= 'f') + return c - 'a' + 10; + if (c >= 'A' && c <= 'F') + return c - 'A' + 10; + return -1; +} + +static int parse_hex(const char *s, int n, int *uc) +{ + int val = 0; + int k; + + for (k = 0; k < n; k++) { + int c = hexdigitval(*s++); + if (c == -1) { + break; + } + val = (val << 4) | c; + } + if (k) { + *uc = val; + } + return k; +} + +static int reg_decode_escape(const char *s, int *ch) +{ + int n; + const char *s0 = s; + + *ch = *s++; + + switch (*ch) { + case 'b': *ch = '\b'; break; + case 'e': *ch = 27; break; + case 'f': *ch = '\f'; break; + case 'n': *ch = '\n'; break; + case 'r': *ch = '\r'; break; + case 't': *ch = '\t'; break; + case 'v': *ch = '\v'; break; + case 'u': + if (*s == '{') { + + n = parse_hex(s + 1, 6, ch); + if (n > 0 && s[n + 1] == '}' && *ch >= 0 && *ch <= 0x1fffff) { + s += n + 2; + } + else { + + *ch = 'u'; + } + } + else if ((n = parse_hex(s, 4, ch)) > 0) { + s += n; + } + break; + case 'U': + if ((n = parse_hex(s, 8, ch)) > 0) { + s += n; + } + break; + case 'x': + if ((n = parse_hex(s, 2, ch)) > 0) { + s += n; + } + break; + case '\0': + s--; + *ch = '\\'; + break; + } + return s - s0; +} + +static int regatom(regex_t *preg, int *flagp) +{ + int ret; + int flags; + int nocase = (preg->cflags & REG_ICASE); + + int ch; + int n = reg_utf8_tounicode_case(preg->regparse, &ch, nocase); + + *flagp = WORST; + + preg->regparse += n; + switch (ch) { + + case '^': + ret = regnode(preg, BOL); + break; + case '$': + ret = regnode(preg, EOL); + break; + case '.': + ret = regnode(preg, ANY); + *flagp |= HASWIDTH|SIMPLE; + break; + case '[': { + const char *pattern = preg->regparse; + + if (*pattern == '^') { + ret = regnode(preg, ANYBUT); + pattern++; + } else + ret = regnode(preg, ANYOF); + + + if (*pattern == ']' || *pattern == '-') { + reg_addrange(preg, *pattern, *pattern); + pattern++; + } + + while (*pattern && *pattern != ']') { + + int start; + int end; + + pattern += reg_utf8_tounicode_case(pattern, &start, nocase); + if (start == '\\') { + pattern += reg_decode_escape(pattern, &start); + if (start == 0) { + preg->err = REG_ERR_NULL_CHAR; + return 0; + } + } + if (pattern[0] == '-' && pattern[1] && pattern[1] != ']') { + + pattern += utf8_tounicode(pattern, &end); + pattern += reg_utf8_tounicode_case(pattern, &end, nocase); + if (end == '\\') { + pattern += reg_decode_escape(pattern, &end); + if (end == 0) { + preg->err = REG_ERR_NULL_CHAR; + return 0; + } + } + + reg_addrange(preg, start, end); + continue; + } + if (start == '[' && pattern[0] == ':') { + static const char *character_class[] = { + ":alpha:", ":alnum:", ":space:", ":blank:", ":upper:", ":lower:", + ":digit:", ":xdigit:", ":cntrl:", ":graph:", ":print:", ":punct:", + }; + enum { + CC_ALPHA, CC_ALNUM, CC_SPACE, CC_BLANK, CC_UPPER, CC_LOWER, + CC_DIGIT, CC_XDIGIT, CC_CNTRL, CC_GRAPH, CC_PRINT, CC_PUNCT, + CC_NUM + }; + int i; + + for (i = 0; i < CC_NUM; i++) { + int n = strlen(character_class[i]); + if (strncmp(pattern, character_class[i], n) == 0) { + + pattern += n + 1; + break; + } + } + if (i != CC_NUM) { + switch (i) { + case CC_ALNUM: + reg_addrange(preg, '0', '9'); + + case CC_ALPHA: + if ((preg->cflags & REG_ICASE) == 0) { + reg_addrange(preg, 'a', 'z'); + } + reg_addrange(preg, 'A', 'Z'); + break; + case CC_SPACE: + reg_addrange_str(preg, " \t\r\n\f\v"); + break; + case CC_BLANK: + reg_addrange_str(preg, " \t"); + break; + case CC_UPPER: + reg_addrange(preg, 'A', 'Z'); + break; + case CC_LOWER: + reg_addrange(preg, 'a', 'z'); + break; + case CC_XDIGIT: + reg_addrange(preg, 'a', 'f'); + reg_addrange(preg, 'A', 'F'); + + case CC_DIGIT: + reg_addrange(preg, '0', '9'); + break; + case CC_CNTRL: + reg_addrange(preg, 0, 31); + reg_addrange(preg, 127, 127); + break; + case CC_PRINT: + reg_addrange(preg, ' ', '~'); + break; + case CC_GRAPH: + reg_addrange(preg, '!', '~'); + break; + case CC_PUNCT: + reg_addrange(preg, '!', '/'); + reg_addrange(preg, ':', '@'); + reg_addrange(preg, '[', '`'); + reg_addrange(preg, '{', '~'); + break; + } + continue; + } + } + + reg_addrange(preg, start, start); + } + regc(preg, '\0'); + + if (*pattern) { + pattern++; + } + preg->regparse = pattern; + + *flagp |= HASWIDTH|SIMPLE; + } + break; + case '(': + ret = reg(preg, 1, &flags); + if (ret == 0) + return 0; + *flagp |= flags&(HASWIDTH|SPSTART); + break; + case '\0': + case '|': + case ')': + preg->err = REG_ERR_INTERNAL; + return 0; + case '?': + case '+': + case '*': + case '{': + preg->err = REG_ERR_COUNT_FOLLOWS_NOTHING; + return 0; + case '\\': + ch = *preg->regparse++; + switch (ch) { + case '\0': + preg->err = REG_ERR_TRAILING_BACKSLASH; + return 0; + case 'A': + ret = regnode(preg, BOLX); + break; + case 'Z': + ret = regnode(preg, EOLX); + break; + case '<': + case 'm': + ret = regnode(preg, WORDA); + break; + case '>': + case 'M': + ret = regnode(preg, WORDZ); + break; + case 'd': + case 'D': + ret = regnode(preg, ch == 'd' ? ANYOF : ANYBUT); + reg_addrange(preg, '0', '9'); + regc(preg, '\0'); + *flagp |= HASWIDTH|SIMPLE; + break; + case 'w': + case 'W': + ret = regnode(preg, ch == 'w' ? ANYOF : ANYBUT); + if ((preg->cflags & REG_ICASE) == 0) { + reg_addrange(preg, 'a', 'z'); + } + reg_addrange(preg, 'A', 'Z'); + reg_addrange(preg, '0', '9'); + reg_addrange(preg, '_', '_'); + regc(preg, '\0'); + *flagp |= HASWIDTH|SIMPLE; + break; + case 's': + case 'S': + ret = regnode(preg, ch == 's' ? ANYOF : ANYBUT); + reg_addrange_str(preg," \t\r\n\f\v"); + regc(preg, '\0'); + *flagp |= HASWIDTH|SIMPLE; + break; + + default: + + + preg->regparse--; + goto de_fault; + } + break; + de_fault: + default: { + int added = 0; + + + preg->regparse -= n; + + ret = regnode(preg, EXACTLY); + + + + while (*preg->regparse && strchr(META, *preg->regparse) == NULL) { + n = reg_utf8_tounicode_case(preg->regparse, &ch, (preg->cflags & REG_ICASE)); + if (ch == '\\' && preg->regparse[n]) { + if (strchr("<>mMwWdDsSAZ", preg->regparse[n])) { + + break; + } + n += reg_decode_escape(preg->regparse + n, &ch); + if (ch == 0) { + preg->err = REG_ERR_NULL_CHAR; + return 0; + } + } + + + if (ISMULT(preg->regparse[n])) { + + if (added) { + + break; + } + + regc(preg, ch); + added++; + preg->regparse += n; + break; + } + + + regc(preg, ch); + added++; + preg->regparse += n; + } + regc(preg, '\0'); + + *flagp |= HASWIDTH; + if (added == 1) + *flagp |= SIMPLE; + break; + } + break; + } + + return(ret); +} + +static void reg_grow(regex_t *preg, int n) +{ + if (preg->p + n >= preg->proglen) { + preg->proglen = (preg->p + n) * 2; + preg->program = realloc(preg->program, preg->proglen * sizeof(int)); + } +} + + +static int regnode(regex_t *preg, int op) +{ + reg_grow(preg, 2); + + + preg->program[preg->p++] = op; + preg->program[preg->p++] = 0; + + + return preg->p - 2; +} + +static void regc(regex_t *preg, int b ) +{ + reg_grow(preg, 1); + preg->program[preg->p++] = b; +} + +static int reginsert(regex_t *preg, int op, int size, int opnd ) +{ + reg_grow(preg, size); + + + memmove(preg->program + opnd + size, preg->program + opnd, sizeof(int) * (preg->p - opnd)); + + memset(preg->program + opnd, 0, sizeof(int) * size); + + preg->program[opnd] = op; + + preg->p += size; + + return opnd + size; +} + +static void regtail(regex_t *preg, int p, int val) +{ + int scan; + int temp; + int offset; + + + scan = p; + for (;;) { + temp = regnext(preg, scan); + if (temp == 0) + break; + scan = temp; + } + + if (OP(preg, scan) == BACK) + offset = scan - val; + else + offset = val - scan; + + preg->program[scan + 1] = offset; +} + + +static void regoptail(regex_t *preg, int p, int val ) +{ + + if (p != 0 && OP(preg, p) == BRANCH) { + regtail(preg, OPERAND(p), val); + } +} + + +static int regtry(regex_t *preg, const char *string ); +static int regmatch(regex_t *preg, int prog); +static int regrepeat(regex_t *preg, int p, int max); + +int regexec(regex_t *preg, const char *string, size_t nmatch, regmatch_t pmatch[], int eflags) +{ + const char *s; + int scan; + + + if (preg == NULL || preg->program == NULL || string == NULL) { + return REG_ERR_NULL_ARGUMENT; + } + + + if (*preg->program != REG_MAGIC) { + return REG_ERR_CORRUPTED; + } + +#ifdef DEBUG + fprintf(stderr, "regexec: %s\n", string); + regdump(preg); +#endif + + preg->eflags = eflags; + preg->pmatch = pmatch; + preg->nmatch = nmatch; + preg->start = string; + + + for (scan = OPERAND(1); scan != 0; scan += regopsize(preg, scan)) { + int op = OP(preg, scan); + if (op == END) + break; + if (op == REPX || op == REPXMIN) + preg->program[scan + 4] = 0; + } + + + if (preg->regmust != 0) { + s = string; + while ((s = str_find(s, preg->program[preg->regmust], preg->cflags & REG_ICASE)) != NULL) { + if (prefix_cmp(preg->program + preg->regmust, preg->regmlen, s, preg->cflags & REG_ICASE) >= 0) { + break; + } + s++; + } + if (s == NULL) + return REG_NOMATCH; + } + + + preg->regbol = string; + + + if (preg->reganch) { + if (eflags & REG_NOTBOL) { + + goto nextline; + } + while (1) { + if (regtry(preg, string)) { + return REG_NOERROR; + } + if (*string) { +nextline: + if (preg->cflags & REG_NEWLINE) { + + string = strchr(string, '\n'); + if (string) { + preg->regbol = ++string; + continue; + } + } + } + return REG_NOMATCH; + } + } + + + s = string; + if (preg->regstart != '\0') { + + while ((s = str_find(s, preg->regstart, preg->cflags & REG_ICASE)) != NULL) { + if (regtry(preg, s)) + return REG_NOERROR; + s++; + } + } + else + + while (1) { + if (regtry(preg, s)) + return REG_NOERROR; + if (*s == '\0') { + break; + } + else { + int c; + s += utf8_tounicode(s, &c); + } + } + + + return REG_NOMATCH; +} + + +static int regtry( regex_t *preg, const char *string ) +{ + int i; + + preg->reginput = string; + + for (i = 0; i < preg->nmatch; i++) { + preg->pmatch[i].rm_so = -1; + preg->pmatch[i].rm_eo = -1; + } + if (regmatch(preg, 1)) { + preg->pmatch[0].rm_so = string - preg->start; + preg->pmatch[0].rm_eo = preg->reginput - preg->start; + return(1); + } else + return(0); +} + +static int prefix_cmp(const int *prog, int proglen, const char *string, int nocase) +{ + const char *s = string; + while (proglen && *s) { + int ch; + int n = reg_utf8_tounicode_case(s, &ch, nocase); + if (ch != *prog) { + return -1; + } + prog++; + s += n; + proglen--; + } + if (proglen == 0) { + return s - string; + } + return -1; +} + +static int reg_range_find(const int *range, int c) +{ + while (*range) { + + if (c >= range[1] && c <= (range[0] + range[1] - 1)) { + return 1; + } + range += 2; + } + return 0; +} + +static const char *str_find(const char *string, int c, int nocase) +{ + if (nocase) { + + c = utf8_upper(c); + } + while (*string) { + int ch; + int n = reg_utf8_tounicode_case(string, &ch, nocase); + if (c == ch) { + return string; + } + string += n; + } + return NULL; +} + +static int reg_iseol(regex_t *preg, int ch) +{ + if (preg->cflags & REG_NEWLINE) { + return ch == '\0' || ch == '\n'; + } + else { + return ch == '\0'; + } +} + +static int regmatchsimplerepeat(regex_t *preg, int scan, int matchmin) +{ + int nextch = '\0'; + const char *save; + int no; + int c; + + int max = preg->program[scan + 2]; + int min = preg->program[scan + 3]; + int next = regnext(preg, scan); + + if (OP(preg, next) == EXACTLY) { + nextch = preg->program[OPERAND(next)]; + } + save = preg->reginput; + no = regrepeat(preg, scan + 5, max); + if (no < min) { + return 0; + } + if (matchmin) { + + max = no; + no = min; + } + + while (1) { + if (matchmin) { + if (no > max) { + break; + } + } + else { + if (no < min) { + break; + } + } + preg->reginput = save + utf8_index(save, no); + reg_utf8_tounicode_case(preg->reginput, &c, (preg->cflags & REG_ICASE)); + + if (reg_iseol(preg, nextch) || c == nextch) { + if (regmatch(preg, next)) { + return(1); + } + } + if (matchmin) { + + no++; + } + else { + + no--; + } + } + return(0); +} + +static int regmatchrepeat(regex_t *preg, int scan, int matchmin) +{ + int *scanpt = preg->program + scan; + + int max = scanpt[2]; + int min = scanpt[3]; + + + if (scanpt[4] < min) { + + scanpt[4]++; + if (regmatch(preg, scan + 5)) { + return 1; + } + scanpt[4]--; + return 0; + } + if (scanpt[4] > max) { + return 0; + } + + if (matchmin) { + + if (regmatch(preg, regnext(preg, scan))) { + return 1; + } + + scanpt[4]++; + if (regmatch(preg, scan + 5)) { + return 1; + } + scanpt[4]--; + return 0; + } + + if (scanpt[4] < max) { + scanpt[4]++; + if (regmatch(preg, scan + 5)) { + return 1; + } + scanpt[4]--; + } + + return regmatch(preg, regnext(preg, scan)); +} + + +static int regmatch(regex_t *preg, int prog) +{ + int scan; + int next; + const char *save; + + scan = prog; + +#ifdef DEBUG + if (scan != 0 && regnarrate) + fprintf(stderr, "%s(\n", regprop(scan)); +#endif + while (scan != 0) { + int n; + int c; +#ifdef DEBUG + if (regnarrate) { + fprintf(stderr, "%3d: %s...\n", scan, regprop(OP(preg, scan))); + } +#endif + next = regnext(preg, scan); + n = reg_utf8_tounicode_case(preg->reginput, &c, (preg->cflags & REG_ICASE)); + + switch (OP(preg, scan)) { + case BOLX: + if ((preg->eflags & REG_NOTBOL)) { + return(0); + } + + case BOL: + if (preg->reginput != preg->regbol) { + return(0); + } + break; + case EOLX: + if (c != 0) { + + return 0; + } + break; + case EOL: + if (!reg_iseol(preg, c)) { + return(0); + } + break; + case WORDA: + + if ((!isalnum(UCHAR(c))) && c != '_') + return(0); + + if (preg->reginput > preg->regbol && + (isalnum(UCHAR(preg->reginput[-1])) || preg->reginput[-1] == '_')) + return(0); + break; + case WORDZ: + + if (preg->reginput > preg->regbol) { + + if (reg_iseol(preg, c) || !isalnum(UCHAR(c)) || c != '_') { + c = preg->reginput[-1]; + + if (isalnum(UCHAR(c)) || c == '_') { + break; + } + } + } + + return(0); + + case ANY: + if (reg_iseol(preg, c)) + return 0; + preg->reginput += n; + break; + case EXACTLY: { + int opnd; + int len; + int slen; + + opnd = OPERAND(scan); + len = str_int_len(preg->program + opnd); + + slen = prefix_cmp(preg->program + opnd, len, preg->reginput, preg->cflags & REG_ICASE); + if (slen < 0) { + return(0); + } + preg->reginput += slen; + } + break; + case ANYOF: + if (reg_iseol(preg, c) || reg_range_find(preg->program + OPERAND(scan), c) == 0) { + return(0); + } + preg->reginput += n; + break; + case ANYBUT: + if (reg_iseol(preg, c) || reg_range_find(preg->program + OPERAND(scan), c) != 0) { + return(0); + } + preg->reginput += n; + break; + case NOTHING: + break; + case BACK: + break; + case BRANCH: + if (OP(preg, next) != BRANCH) + next = OPERAND(scan); + else { + do { + save = preg->reginput; + if (regmatch(preg, OPERAND(scan))) { + return(1); + } + preg->reginput = save; + scan = regnext(preg, scan); + } while (scan != 0 && OP(preg, scan) == BRANCH); + return(0); + + } + break; + case REP: + case REPMIN: + return regmatchsimplerepeat(preg, scan, OP(preg, scan) == REPMIN); + + case REPX: + case REPXMIN: + return regmatchrepeat(preg, scan, OP(preg, scan) == REPXMIN); + + case END: + return 1; + + case OPENNC: + case CLOSENC: + return regmatch(preg, next); + + default: + if (OP(preg, scan) >= OPEN+1 && OP(preg, scan) < CLOSE_END) { + save = preg->reginput; + if (regmatch(preg, next)) { + if (OP(preg, scan) < CLOSE) { + int no = OP(preg, scan) - OPEN; + if (no < preg->nmatch && preg->pmatch[no].rm_so == -1) { + preg->pmatch[no].rm_so = save - preg->start; + } + } + else { + int no = OP(preg, scan) - CLOSE; + if (no < preg->nmatch && preg->pmatch[no].rm_eo == -1) { + preg->pmatch[no].rm_eo = save - preg->start; + } + } + return(1); + } + return(0); + } + return REG_ERR_INTERNAL; + } + + scan = next; + } + + return REG_ERR_INTERNAL; +} + +static int regrepeat(regex_t *preg, int p, int max) +{ + int count = 0; + const char *scan; + int opnd; + int ch; + int n; + + scan = preg->reginput; + opnd = OPERAND(p); + switch (OP(preg, p)) { + case ANY: + + while (!reg_iseol(preg, *scan) && count < max) { + count++; + scan++; + } + break; + case EXACTLY: + while (count < max) { + n = reg_utf8_tounicode_case(scan, &ch, preg->cflags & REG_ICASE); + if (preg->program[opnd] != ch) { + break; + } + count++; + scan += n; + } + break; + case ANYOF: + while (count < max) { + n = reg_utf8_tounicode_case(scan, &ch, preg->cflags & REG_ICASE); + if (reg_iseol(preg, ch) || reg_range_find(preg->program + opnd, ch) == 0) { + break; + } + count++; + scan += n; + } + break; + case ANYBUT: + while (count < max) { + n = reg_utf8_tounicode_case(scan, &ch, preg->cflags & REG_ICASE); + if (reg_iseol(preg, ch) || reg_range_find(preg->program + opnd, ch) != 0) { + break; + } + count++; + scan += n; + } + break; + default: + preg->err = REG_ERR_INTERNAL; + count = 0; + break; + } + preg->reginput = scan; + + return(count); +} + +static int regnext(regex_t *preg, int p ) +{ + int offset; + + offset = NEXT(preg, p); + + if (offset == 0) + return 0; + + if (OP(preg, p) == BACK) + return(p-offset); + else + return(p+offset); +} + +static int regopsize(regex_t *preg, int p ) +{ + + switch (OP(preg, p)) { + case REP: + case REPMIN: + case REPX: + case REPXMIN: + return 5; + + case ANYOF: + case ANYBUT: + case EXACTLY: { + int s = p + 2; + while (preg->program[s++]) { + } + return s - p; + } + } + return 2; +} + + +size_t regerror(int errcode, const regex_t *preg, char *errbuf, size_t errbuf_size) +{ + static const char *error_strings[] = { + "success", + "no match", + "bad pattern", + "null argument", + "unknown error", + "too big", + "out of memory", + "too many ()", + "parentheses () not balanced", + "braces {} not balanced", + "invalid repetition count(s)", + "extra characters", + "*+ of empty atom", + "nested count", + "internal error", + "count follows nothing", + "trailing backslash", + "corrupted program", + "contains null char", + }; + const char *err; + + if (errcode < 0 || errcode >= REG_ERR_NUM) { + err = "Bad error code"; + } + else { + err = error_strings[errcode]; + } + + return snprintf(errbuf, errbuf_size, "%s", err); +} + +void regfree(regex_t *preg) +{ + free(preg->program); +} + +#endif + +#if defined(_WIN32) || defined(WIN32) +#ifndef STRICT +#define STRICT +#endif +#define WIN32_LEAN_AND_MEAN +#include + +#if defined(HAVE_DLOPEN_COMPAT) +void *dlopen(const char *path, int mode) +{ + JIM_NOTUSED(mode); + + return (void *)LoadLibraryA(path); +} + +int dlclose(void *handle) +{ + FreeLibrary((HANDLE)handle); + return 0; +} + +void *dlsym(void *handle, const char *symbol) +{ + return GetProcAddress((HMODULE)handle, symbol); +} + +char *dlerror(void) +{ + static char msg[121]; + FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM, NULL, GetLastError(), + LANG_NEUTRAL, msg, sizeof(msg) - 1, NULL); + return msg; +} +#endif + +#ifdef _MSC_VER + +#include + + +int gettimeofday(struct timeval *tv, void *unused) +{ + struct _timeb tb; + + _ftime(&tb); + tv->tv_sec = tb.time; + tv->tv_usec = tb.millitm * 1000; + + return 0; +} + + +DIR *opendir(const char *name) +{ + DIR *dir = 0; + + if (name && name[0]) { + size_t base_length = strlen(name); + const char *all = + strchr("/\\", name[base_length - 1]) ? "*" : "/*"; + + if ((dir = (DIR *) Jim_Alloc(sizeof *dir)) != 0 && + (dir->name = (char *)Jim_Alloc(base_length + strlen(all) + 1)) != 0) { + strcat(strcpy(dir->name, name), all); + + if ((dir->handle = (long)_findfirst(dir->name, &dir->info)) != -1) + dir->result.d_name = 0; + else { + Jim_Free(dir->name); + Jim_Free(dir); + dir = 0; + } + } + else { + Jim_Free(dir); + dir = 0; + errno = ENOMEM; + } + } + else { + errno = EINVAL; + } + return dir; +} + +int closedir(DIR * dir) +{ + int result = -1; + + if (dir) { + if (dir->handle != -1) + result = _findclose(dir->handle); + Jim_Free(dir->name); + Jim_Free(dir); + } + if (result == -1) + errno = EBADF; + return result; +} + +struct dirent *readdir(DIR * dir) +{ + struct dirent *result = 0; + + if (dir && dir->handle != -1) { + if (!dir->result.d_name || _findnext(dir->handle, &dir->info) != -1) { + result = &dir->result; + result->d_name = dir->info.name; + } + } + else { + errno = EBADF; + } + return result; +} +#endif +#endif +#ifndef JIM_BOOTSTRAP_LIB_ONLY +#include +#include + + +#ifdef USE_LINENOISE +#ifdef HAVE_UNISTD_H + #include +#endif +#include "linenoise.h" +#else +#define MAX_LINE_LEN 512 +#endif + +char *Jim_HistoryGetline(const char *prompt) +{ +#ifdef USE_LINENOISE + return linenoise(prompt); +#else + int len; + char *line = malloc(MAX_LINE_LEN); + + fputs(prompt, stdout); + fflush(stdout); + + if (fgets(line, MAX_LINE_LEN, stdin) == NULL) { + free(line); + return NULL; + } + len = strlen(line); + if (len && line[len - 1] == '\n') { + line[len - 1] = '\0'; + } + return line; +#endif +} + +void Jim_HistoryLoad(const char *filename) +{ +#ifdef USE_LINENOISE + linenoiseHistoryLoad(filename); +#endif +} + +void Jim_HistoryAdd(const char *line) +{ +#ifdef USE_LINENOISE + linenoiseHistoryAdd(line); +#endif +} + +void Jim_HistorySave(const char *filename) +{ +#ifdef USE_LINENOISE + linenoiseHistorySave(filename); +#endif +} + +void Jim_HistoryShow(void) +{ +#ifdef USE_LINENOISE + + int i; + int len; + char **history = linenoiseHistory(&len); + for (i = 0; i < len; i++) { + printf("%4d %s\n", i + 1, history[i]); + } +#endif +} + +int Jim_InteractivePrompt(Jim_Interp *interp) +{ + int retcode = JIM_OK; + char *history_file = NULL; +#ifdef USE_LINENOISE + const char *home; + + home = getenv("HOME"); + if (home && isatty(STDIN_FILENO)) { + int history_len = strlen(home) + sizeof("/.jim_history"); + history_file = Jim_Alloc(history_len); + snprintf(history_file, history_len, "%s/.jim_history", home); + Jim_HistoryLoad(history_file); + } +#endif + + printf("Welcome to Jim version %d.%d\n", + JIM_VERSION / 100, JIM_VERSION % 100); + Jim_SetVariableStrWithStr(interp, JIM_INTERACTIVE, "1"); + + while (1) { + Jim_Obj *scriptObjPtr; + const char *result; + int reslen; + char prompt[20]; + + if (retcode != JIM_OK) { + const char *retcodestr = Jim_ReturnCode(retcode); + + if (*retcodestr == '?') { + snprintf(prompt, sizeof(prompt) - 3, "[%d] . ", retcode); + } + else { + snprintf(prompt, sizeof(prompt) - 3, "[%s] . ", retcodestr); + } + } + else { + strcpy(prompt, ". "); + } + + scriptObjPtr = Jim_NewStringObj(interp, "", 0); + Jim_IncrRefCount(scriptObjPtr); + while (1) { + char state; + char *line; + + line = Jim_HistoryGetline(prompt); + if (line == NULL) { + if (errno == EINTR) { + continue; + } + Jim_DecrRefCount(interp, scriptObjPtr); + retcode = JIM_OK; + goto out; + } + if (Jim_Length(scriptObjPtr) != 0) { + + Jim_AppendString(interp, scriptObjPtr, "\n", 1); + } + Jim_AppendString(interp, scriptObjPtr, line, -1); + free(line); + if (Jim_ScriptIsComplete(interp, scriptObjPtr, &state)) + break; + + snprintf(prompt, sizeof(prompt), "%c> ", state); + } +#ifdef USE_LINENOISE + if (strcmp(Jim_String(scriptObjPtr), "h") == 0) { + + Jim_HistoryShow(); + Jim_DecrRefCount(interp, scriptObjPtr); + continue; + } + + Jim_HistoryAdd(Jim_String(scriptObjPtr)); + if (history_file) { + Jim_HistorySave(history_file); + } +#endif + retcode = Jim_EvalObj(interp, scriptObjPtr); + Jim_DecrRefCount(interp, scriptObjPtr); + + if (retcode == JIM_EXIT) { + break; + } + if (retcode == JIM_ERR) { + Jim_MakeErrorMessage(interp); + } + result = Jim_GetString(Jim_GetResult(interp), &reslen); + if (reslen) { + printf("%s\n", result); + } + } + out: + Jim_Free(history_file); + return retcode; +} + +#include +#include +#include + + + +extern int Jim_initjimshInit(Jim_Interp *interp); + +static void JimSetArgv(Jim_Interp *interp, int argc, char *const argv[]) +{ + int n; + Jim_Obj *listObj = Jim_NewListObj(interp, NULL, 0); + + + for (n = 0; n < argc; n++) { + Jim_Obj *obj = Jim_NewStringObj(interp, argv[n], -1); + + Jim_ListAppendElement(interp, listObj, obj); + } + + Jim_SetVariableStr(interp, "argv", listObj); + Jim_SetVariableStr(interp, "argc", Jim_NewIntObj(interp, argc)); +} + +static void JimPrintErrorMessage(Jim_Interp *interp) +{ + Jim_MakeErrorMessage(interp); + fprintf(stderr, "%s\n", Jim_String(Jim_GetResult(interp))); +} + +void usage(const char* executable_name) +{ + printf("jimsh version %d.%d\n", JIM_VERSION / 100, JIM_VERSION % 100); + printf("Usage: %s\n", executable_name); + printf("or : %s [options] [filename]\n", executable_name); + printf("\n"); + printf("Without options: Interactive mode\n"); + printf("\n"); + printf("Options:\n"); + printf(" --version : prints the version string\n"); + printf(" --help : prints this text\n"); + printf(" -e CMD : executes command CMD\n"); + printf(" NOTE: all subsequent options will be passed as arguments to the command\n"); + printf(" [filename] : executes the script contained in the named file\n"); + printf(" NOTE: all subsequent options will be passed to the script\n\n"); +} + +int main(int argc, char *const argv[]) +{ + int retcode; + Jim_Interp *interp; + char *const orig_argv0 = argv[0]; + + + if (argc > 1 && strcmp(argv[1], "--version") == 0) { + printf("%d.%d\n", JIM_VERSION / 100, JIM_VERSION % 100); + return 0; + } + else if (argc > 1 && strcmp(argv[1], "--help") == 0) { + usage(argv[0]); + return 0; + } + + + interp = Jim_CreateInterp(); + Jim_RegisterCoreCommands(interp); + + + if (Jim_InitStaticExtensions(interp) != JIM_OK) { + JimPrintErrorMessage(interp); + } + + Jim_SetVariableStrWithStr(interp, "jim::argv0", orig_argv0); + Jim_SetVariableStrWithStr(interp, JIM_INTERACTIVE, argc == 1 ? "1" : "0"); + retcode = Jim_initjimshInit(interp); + + if (argc == 1) { + + if (retcode == JIM_ERR) { + JimPrintErrorMessage(interp); + } + if (retcode != JIM_EXIT) { + JimSetArgv(interp, 0, NULL); + retcode = Jim_InteractivePrompt(interp); + } + } + else { + + if (argc > 2 && strcmp(argv[1], "-e") == 0) { + + JimSetArgv(interp, argc - 3, argv + 3); + retcode = Jim_Eval(interp, argv[2]); + if (retcode != JIM_ERR) { + printf("%s\n", Jim_String(Jim_GetResult(interp))); + } + } + else { + Jim_SetVariableStr(interp, "argv0", Jim_NewStringObj(interp, argv[1], -1)); + JimSetArgv(interp, argc - 2, argv + 2); + retcode = Jim_EvalFile(interp, argv[1]); + } + if (retcode == JIM_ERR) { + JimPrintErrorMessage(interp); + } + } + if (retcode == JIM_EXIT) { + retcode = Jim_GetExitCode(interp); + } + else if (retcode == JIM_ERR) { + retcode = 1; + } + else { + retcode = 0; + } + Jim_FreeInterp(interp); + return retcode; +} +#endif ADDED autosetup/pkg-config.tcl Index: autosetup/pkg-config.tcl ================================================================== --- /dev/null +++ autosetup/pkg-config.tcl @@ -0,0 +1,134 @@ +# Copyright (c) 2016 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# @synopsis: +# +# The 'pkg-config' module allows package information to be found via pkg-config +# +# If not cross-compiling, the package path should be determined automatically +# by pkg-config. +# If cross-compiling, the default package path is the compiler sysroot. +# If the C compiler doesn't support -print-sysroot, the path can be supplied +# by the --sysroot option or by defining SYSROOT. +# +# PKG_CONFIG may be set to use an alternative to pkg-config + +use cc + +module-options { + sysroot:dir => "Override compiler sysroot for pkg-config search path" +} + +# @pkg-config-init ?required? +# +# Initialises the pkg-config system. Unless required is set to 0, +# it is a fatal error if the pkg-config +# This command will normally be called automatically as required, +# but it may be invoked explicitly if lack of pkg-config is acceptable. +# +# Returns 1 if ok, or 0 if pkg-config not found/usable (only if required=0) +# +proc pkg-config-init {{required 1}} { + if {[is-defined HAVE_PKG_CONFIG]} { + return [get-define HAVE_PKG_CONFIG] + } + set found 0 + + define PKG_CONFIG [get-env PKG_CONFIG pkg-config] + msg-checking "Checking for pkg-config..." + + if {[catch {exec [get-define PKG_CONFIG] --version} version]} { + msg-result "[get-define PKG_CONFIG] (not found)" + if {$required} { + user-error "No usable pkg-config" + } + } else { + msg-result $version + define PKG_CONFIG_VERSION $version + + set found 1 + + if {[opt-val sysroot] ne ""} { + define SYSROOT [file-normalize [opt-val sysroot]] + msg-result "Using specified sysroot [get-define SYSROOT]" + } elseif {[get-define build] ne [get-define host]} { + if {[catch {exec-with-stderr [get-define CC] -print-sysroot} result errinfo] == 0} { + # Use the compiler sysroot, if there is one + define SYSROOT $result + msg-result "Found compiler sysroot $result" + } else { + set msg "pkg-config: Cross compiling, but no compiler sysroot and no --sysroot supplied" + if {$required} { + user-error $msg + } else { + msg-result $msg + } + set found 0 + } + } + if {[is-defined SYSROOT]} { + set sysroot [get-define SYSROOT] + + # XXX: It's possible that these should be set only when invoking pkg-config + global env + set env(PKG_CONFIG_DIR) "" + # Do we need to try /usr/local as well or instead? + set env(PKG_CONFIG_LIBDIR) $sysroot/usr/lib/pkgconfig:$sysroot/usr/share/pkgconfig + set env(PKG_CONFIG_SYSROOT_DIR) $sysroot + } + } + define HAVE_PKG_CONFIG $found + return $found +} + +# @pkg-config module ?requirements? +# +# Use pkg-config to find the given module meeting the given requirements. +# e.g. +# +## pkg-config pango >= 1.37.0 +# +# If found, returns 1 and sets HAVE_PKG_PANGO to 1 along with: +# +## PKG_PANGO_VERSION to the found version +## PKG_PANGO_LIBS to the required libs (--libs-only-l) +## PKG_PANGO_LDFLAGS to the required linker flags (--libs-only-L) +## PKG_PANGO_CFLAGS to the required compiler flags (--cflags) +# +# If not found, returns 0. +# +proc pkg-config {module args} { + set ok [pkg-config-init] + + msg-checking "Checking for $module $args..." + + if {!$ok} { + msg-result "no pkg-config" + return 0 + } + + if {[catch {exec [get-define PKG_CONFIG] --modversion "$module $args"} version]} { + msg-result "not found" + configlog "pkg-config --modversion $module $args: $version" + return 0 + } + msg-result $version + set prefix [feature-define-name $module PKG_] + define HAVE_${prefix} + define ${prefix}_VERSION $version + define ${prefix}_LIBS [exec pkg-config --libs-only-l $module] + define ${prefix}_LDFLAGS [exec pkg-config --libs-only-L $module] + define ${prefix}_CFLAGS [exec pkg-config --cflags $module] + return 1 +} + +# @pkg-config-get module setting +# +# Convenience access to the results of pkg-config +# +# For example, [pkg-config-get pango CFLAGS] returns +# the value of PKG_PANGO_CFLAGS, or "" if not defined. +proc pkg-config-get {module name} { + set prefix [feature-define-name $module PKG_] + get-define ${prefix}_${name} "" +} ADDED autosetup/system.tcl Index: autosetup/system.tcl ================================================================== --- /dev/null +++ autosetup/system.tcl @@ -0,0 +1,283 @@ +# Copyright (c) 2010 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# @synopsis: +# +# This module supports common system interrogation and options +# such as --host, --build, --prefix, and setting srcdir, builddir, and EXEEXT +# +# It also support the 'feature' naming convention, where searching +# for a feature such as sys/type.h defines HAVE_SYS_TYPES_H +# +# It defines the following variables, based on --prefix unless overridden by the user: +# +## datadir +## sysconfdir +## sharedstatedir +## localstatedir +## infodir +## mandir +## includedir + +# Do "define defaultprefix myvalue" to set the default prefix *before* the first "use" +set defaultprefix [get-define defaultprefix /usr/local] + +module-options [subst -noc -nob { + host:host-alias => {a complete or partial cpu-vendor-opsys for the system where + the application will run (defaults to the same value as --build)} + build:build-alias => {a complete or partial cpu-vendor-opsys for the system + where the application will be built (defaults to the + result of running config.guess)} + prefix:dir => {the target directory for the build (defaults to '$defaultprefix')} + + # These (hidden) options are supported for autoconf/automake compatibility + exec-prefix: + bindir: + sbindir: + includedir: + mandir: + infodir: + libexecdir: + datadir: + libdir: + sysconfdir: + sharedstatedir: + localstatedir: + maintainer-mode=0 + dependency-tracking=0 +}] + +# Returns 1 if exists, or 0 if not +# +proc check-feature {name code} { + msg-checking "Checking for $name..." + set r [uplevel 1 $code] + define-feature $name $r + if {$r} { + msg-result "ok" + } else { + msg-result "not found" + } + return $r +} + +# @have-feature name ?default=0? +# +# Returns the value of the feature if defined, or $default if not. +# See 'feature-define-name' for how the feature name +# is translated into the define name. +# +proc have-feature {name {default 0}} { + get-define [feature-define-name $name] $default +} + +# @define-feature name ?value=1? +# +# Sets the feature 'define' to the given value. +# See 'feature-define-name' for how the feature name +# is translated into the define name. +# +proc define-feature {name {value 1}} { + define [feature-define-name $name] $value +} + +# @feature-checked name +# +# Returns 1 if the feature has been checked, whether true or not +# +proc feature-checked {name} { + is-defined [feature-define-name $name] +} + +# @feature-define-name name ?prefix=HAVE_? +# +# Converts a name to the corresponding define, +# e.g. sys/stat.h becomes HAVE_SYS_STAT_H. +# +# Converts * to P and all non-alphanumeric to underscore. +# +proc feature-define-name {name {prefix HAVE_}} { + string toupper $prefix[regsub -all {[^a-zA-Z0-9]} [regsub -all {[*]} $name p] _] +} + +# If $file doesn't exist, or it's contents are different than $buf, +# the file is written and $script is executed. +# Otherwise a "file is unchanged" message is displayed. +proc write-if-changed {file buf {script {}}} { + set old [readfile $file ""] + if {$old eq $buf && [file exists $file]} { + msg-result "$file is unchanged" + } else { + writefile $file $buf\n + uplevel 1 $script + } +} + +# @make-template template ?outfile? +# +# Reads the input file /$template and writes the output file $outfile. +# If $outfile is blank/omitted, $template should end with ".in" which +# is removed to create the output file name. +# +# Each pattern of the form @define@ is replaced with the corresponding +# define, if it exists, or left unchanged if not. +# +# The special value @srcdir@ is substituted with the relative +# path to the source directory from the directory where the output +# file is created, while the special value @top_srcdir@ is substituted +# with the relative path to the top level source directory. +# +# Conditional sections may be specified as follows: +## @if name == value +## lines +## @else +## lines +## @endif +# +# Where 'name' is a defined variable name and @else is optional. +# If the expression does not match, all lines through '@endif' are ignored. +# +# The alternative forms may also be used: +## @if name +## @if name != value +# +# Where the first form is true if the variable is defined, but not empty or 0 +# +# Currently these expressions can't be nested. +# +proc make-template {template {out {}}} { + set infile [file join $::autosetup(srcdir) $template] + + if {![file exists $infile]} { + user-error "Template $template is missing" + } + + # Define this as late as possible + define AUTODEPS $::autosetup(deps) + + if {$out eq ""} { + if {[file ext $template] ne ".in"} { + autosetup-error "make_template $template has no target file and can't guess" + } + set out [file rootname $template] + } + + set outdir [file dirname $out] + + # Make sure the directory exists + file mkdir $outdir + + # Set up srcdir and top_srcdir to be relative to the target dir + define srcdir [relative-path [file join $::autosetup(srcdir) $outdir] $outdir] + define top_srcdir [relative-path $::autosetup(srcdir) $outdir] + + set mapping {} + foreach {n v} [array get ::define] { + lappend mapping @$n@ $v + } + set result {} + foreach line [split [readfile $infile] \n] { + if {[info exists cond]} { + set l [string trimright $line] + if {$l eq "@endif"} { + unset cond + continue + } + if {$l eq "@else"} { + set cond [expr {!$cond}] + continue + } + if {$cond} { + lappend result $line + } + continue + } + if {[regexp {^@if\s+(\w+)(.*)} $line -> name expression]} { + lassign $expression equal value + set varval [get-define $name ""] + if {$equal eq ""} { + set cond [expr {$varval ni {"" 0}}] + } else { + set cond [expr {$varval eq $value}] + if {$equal ne "=="} { + set cond [expr {!$cond}] + } + } + continue + } + lappend result $line + } + writefile $out [string map $mapping [join $result \n]]\n + + msg-result "Created [relative-path $out] from [relative-path $template]" +} + +# build/host tuples and cross-compilation prefix +set build [opt-val build] +define build_alias $build +if {$build eq ""} { + define build [config_guess] +} else { + define build [config_sub $build] +} + +set host [opt-val host] +define host_alias $host +if {$host eq ""} { + define host [get-define build] + set cross "" +} else { + define host [config_sub $host] + set cross $host- +} +define cross [get-env CROSS $cross] + +set prefix [opt-val prefix $defaultprefix] + +# These are for compatibility with autoconf +define target [get-define host] +define prefix $prefix +define builddir $autosetup(builddir) +define srcdir $autosetup(srcdir) +# Allow this to come from the environment +define top_srcdir [get-env top_srcdir [get-define srcdir]] + +# autoconf supports all of these +set exec_prefix [opt-val exec-prefix $prefix] +define exec_prefix $exec_prefix +foreach {name defpath} { + bindir /bin + sbindir /sbin + libexecdir /libexec + libdir /lib +} { + define $name [opt-val $name $exec_prefix$defpath] +} +foreach {name defpath} { + datadir /share + sysconfdir /etc + sharedstatedir /com + localstatedir /var + infodir /share/info + mandir /share/man + includedir /include +} { + define $name [opt-val $name $prefix$defpath] +} + +define SHELL [get-env SHELL [find-an-executable sh bash ksh]] + +# Windows vs. non-Windows +switch -glob -- [get-define host] { + *-*-ming* - *-*-cygwin - *-*-msys { + define-feature windows + define EXEEXT .exe + } + default { + define EXEEXT "" + } +} + +# Display +msg-result "Host System...[get-define host]" +msg-result "Build System...[get-define build]" ADDED autosetup/test-tclsh Index: autosetup/test-tclsh ================================================================== --- /dev/null +++ autosetup/test-tclsh @@ -0,0 +1,20 @@ +# A small Tcl script to verify that the chosen +# interpreter works. Sometimes we might e.g. pick up +# an interpreter for a different arch. +# Outputs the full path to the interpreter + +if {[catch {info version} version] == 0} { + # This is Jim Tcl + if {$version >= 0.72} { + # Ensure that regexp works + regexp (a.*?) a + puts [info nameofexecutable] + exit 0 + } +} elseif {[catch {info tclversion} version] == 0} { + if {$version >= 8.5 && ![string match 8.5a* [info patchlevel]]} { + puts [info nameofexecutable] + exit 0 + } +} +exit 1 ADDED autosetup/tmake.auto Index: autosetup/tmake.auto ================================================================== --- /dev/null +++ autosetup/tmake.auto @@ -0,0 +1,66 @@ +# Copyright (c) 2016 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# Auto-load module for 'tmake' build system integration + +use init + +autosetup_add_init_type tmake "Tcl-based tmake build system" { + autosetup_check_create auto.def \ +{# Initial auto.def created by 'autosetup --init=tmake' +# vim:set syntax=tcl: + +use cc cc-lib cc-db cc-shared +use tmake + +# Add any user options here +# Really want a --configure that takes over the rest of the command line +options { +} + +cc-check-tools ar ranlib + +set objdir [get-env BUILDDIR objdir] + +make-config-header $objdir/include/autoconf.h +make-tmake-settings $objdir/settings.conf {[A-Z]*} +} + + autosetup_check_create project.spec \ +{# Initial project.spec created by 'autosetup --init=tmake' + +# vim:set syntax=tcl: +define? DESTDIR _install + +# XXX If configure creates additional/different files than include/autoconf.h +# that should be reflected here + +# We use [set AUTOREMAKE] here to avoid rebuilding settings.conf +# if the AUTOREMAKE command changes +Depends {settings.conf include/autoconf.h} auto.def -msg {note Configuring...} -do { + run [set AUTOREMAKE] >$build/config.out +} -onerror {puts [readfile $build/config.out]} -fatal +Clean config.out +DistClean --source config.log +DistClean settings.conf include/autoconf.h + +# If not configured, configure with default options +# Note that it is expected that configure will normally be run +# separately. This is just a convenience for a host build +define? AUTOREMAKE configure TOPBUILDDIR=$TOPBUILDDIR --conf=auto.def + +Load settings.conf + +# e.g. for up autoconf.h +IncludePaths include + +ifconfig CONFIGURED + +# Hmmm, but should we turn off AutoSubDirs? +#AutoSubDirs off +} + + if {![file exists build.spec]} { + puts "Note: I don't see build.spec. Try running: tmake --genie" + } +} ADDED autosetup/tmake.tcl Index: autosetup/tmake.tcl ================================================================== --- /dev/null +++ autosetup/tmake.tcl @@ -0,0 +1,52 @@ +# Copyright (c) 2011 WorkWare Systems http://www.workware.net.au/ +# All rights reserved + +# @synopsis: +# +# The 'tmake' module makes it easy to support the tmake build system. +# +# The following variables are set: +# +## CONFIGURED - to indicate that the project is configured + +use system + +module-options {} + +define CONFIGURED + +# @make-tmake-settings outfile patterns ... +# +# Examines all defined variables which match the given patterns (defaults to "*") +# and writes a tmake-compatible .conf file defining those variables. +# For example, if ABC is "3 monkeys" and ABC matches a pattern, then the file will include: +# +## define ABC {3 monkeys} +# +# If the file would be unchanged, it is not written. +# +# Typical usage is: +# +# make-tmake-settings [get-env BUILDDIR objdir]/settings.conf {[A-Z]*} +proc make-tmake-settings {file args} { + file mkdir [file dirname $file] + set lines {} + + if {[llength $args] == 0} { + set args * + } + + foreach n [lsort [dict keys [all-defines]]] { + foreach p $args { + if {[string match $p $n]} { + set value [get-define $n] + lappend lines "define $n [list $value]" + break + } + } + } + set buf [join $lines \n] + write-if-changed $file $buf { + msg-result "Created $file" + } +} ADDED bin/pidp8i.in Index: bin/pidp8i.in ================================================================== --- /dev/null +++ bin/pidp8i.in @@ -0,0 +1,45 @@ +#!/bin/sh +######################################################################## +# pidp8i.in - Attach the current terminal to the screen(1) session +# started by the SysV init script in etc/pidp8i-ini. +# +# Copyright © 2015-2017 Oscar Vermeulen and Warren Young +# +# Permission is hereby granted, free of charge, to any person obtaining +# a copy of this software and associated documentation files (the +# "Software"), to deal in the Software without restriction, including +# without limitation the rights to use, copy, modify, merge, publish, +# distribute, sublicense, and/or sell copies of the Software, and to +# permit persons to whom the Software is furnished to do so, subject to +# the following conditions: +# +# The above copyright notice and this permission notice shall be +# included in all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +# IN NO EVENT SHALL THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, +# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT +# OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE +# OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +# +# Except as contained in this notice, the names of the authors above +# shall not be used in advertising or otherwise to promote the sale, +# use or other dealings in this Software without prior written +# authorization from those authors. +######################################################################## + +if [ "$USER" != "@INSTUSR@" ] ; then exec su -c "$0" @INSTUSR@ ; fi + +procs=`screen -ls pidp8i | egrep '[0-9]+\.pidp8i' | wc -l` +if [ $procs -ne 0 ]; then + echo Joining simulator session already in progress... + screen -r +else + cat < +#include + +using namespace std; + +typedef vector vb; +typedef vb::const_iterator vbc; + +// Keeping n samples. To think about this concretely, imagine that it +// is 1 sample per millisecond over 0.1 sec, but realize that this is +// scaleable, so that how long 1/n seconds is doesn't affect the math. +static const size_t n = 100; + +// Decay function is 1 - x^2, meaning the most recent event is +// considered 100%, with older events having increasingly lesser effect +// on the overall brightness until we hit 0% consideration at the end of +// the sample set. +// +// We need to scale that so that the total area under the decay +// function's curve is 1, so that if we feed a 50% duty cycle in, we +// get 50% out, but if we skew the 1s toward the front of the sample +// set (i.e. closer to "now"), we get greater brightness than if they +// are skewed toward the past. +// +// The Pi ships with Mathematica, which answers this question with: +// +// Solve[Integrate[z * (1 - x^2), {x, 0, 1}] == 1, z] +// +// We get z = 1.5. +// +// If you want a different decay function, it needs to substitute for +// the 1 - x^2 bit. It needs to start at 1 and decay to 0 over the +// range [0 <= x <= 1]. Run that through Mathematica to find the +// resulting value of z that gives a total of 1 over the sample span. +static double f(double x, bool v) +{ + return v ? (1.5 * (1 - x * x)) : 0; +} + +// Given n bits representing the state of the LED at time x=1/n, return +// the total of applications of f on each bit. Order is most recent +// event first, so it takes the strongest effect. +static double cdf(const vb& vl) +{ + double t = 0; + for (size_t i = 0; i < n; ++i) { + // We divide each f() return by n because it represents only 1/n + // of the total area under the curve. This is a crude form of + // numeric integration. + t += f(i / double(n), vl[i]) / n; + } + return t; +} + +// Generate a series of sampled LED values, then run those sample sets +// through the above and show what brightness level that would generate. +int main() +{ + vb values(n); + + values.clear(); + for (size_t i = 0; i < n; ++i) { + values.push_back(true); + } + cout << "100% duty cycle: CDF = " << cdf(values) << endl; + + values.clear(); + for (size_t i = 0; i < n; ++i) { + values.push_back(i % 2 == 0); + } + cout << "50% duty cycle: CDF = " << cdf(values) << endl; + + values.clear(); + for (size_t i = 0; i < n; ++i) { + values.push_back(i % 4 == 0); + } + cout << "25% duty cycle: CDF = " << cdf(values) << endl; + + values.clear(); + for (size_t i = 0; i < n; ++i) { + values.push_back(i % 10 == 0); + } + cout << "10% duty cycle: CDF = " << cdf(values) << endl; + + values.assign(n, false); + for (size_t i = 0; i < n / 2; ++i) { + values[i] = true; + } + cout << "First half 'on': CDF = " << cdf(values) << endl; + + values.assign(n, false); + for (size_t i = n / 2; i < n; ++i) { + values[i] = true; + } + cout << "Second half 'on': CDF = " << cdf(values) << endl; + + values.assign(n, false); + values[0] = true; + cout << "1ms spike at the start: CDF = " << cdf(values) << endl; + + values.assign(n, false); + values[n - 1] = true; + cout << "1ms spike at the end: CDF = " << cdf(values) << endl; +} ADDED doc/vtedit-keypad.png Index: doc/vtedit-keypad.png ================================================================== --- /dev/null +++ doc/vtedit-keypad.png cannot compute difference between binary files ADDED doc/vtedit-keypad.svg Index: doc/vtedit-keypad.svg ================================================================== --- /dev/null +++ doc/vtedit-keypad.svg @@ -0,0 +1,874 @@ + + + + + VTEDIT Keypad Diagram + + + + + + + + + + + + + + + + + + + + + + + + + + + + + image/svg+xml + + VTEDIT Keypad Diagram + + December 2016 + + + Warren Young + + + + + This graphical diagram was created based on an ASCII diagram that came with the version of VTEDIT patched for VT100/ANSI terminals. + + + + + see ../SIMH-LICENSE.md + + + Englis + + + VTEDIT + PDP-8 + diagram + keypad + + + Diagram showing the function of the keypad keys when pressed in the version of VTEDIT patched for VT100/ANSI terminals. + + + + + + + + + + + + + + + + + + + + + + + + + 7OpenLine◆ 8Page◆ 9Mark/Quote◆ 4UpLine◆ 5DeleteChar◆ 6Delete/Restore 1Top ofPage◆• 2Bottomof Page 3Startof Line -SearchArg◆ ,End ofLine EnterSearchArg◆ 0DownLine◆ .SearchAgain◆ PF1SaveText◆• PF2TECOCmd◆ PF3PasteText PF4 + + + KEY + • command operates from Dot to Mark if Mark is set + ◆ takes opt arg as: ESC [-] <digits> <key(s)> + + ADDED etc/pidp8i-init.in Index: etc/pidp8i-init.in ================================================================== --- /dev/null +++ etc/pidp8i-init.in @@ -0,0 +1,148 @@ +#!/bin/sh +### BEGIN INIT INFO +# Provides: pidp8i +# Required-Start: $syslog +# Required-Stop: $syslog +# Default-Start: 2 3 4 5 +# Default-Stop: 0 6 +# Short-Description:PiDP-8/I simulator +# Description: The PiDP-8/I simulator is a modified version of +# the SimH PDP-8 simulator for the PiDP-8/I front +# panel project for the Raspberry Pi. +### END INIT INFO + +######################################################################## +# Init script for Oscar Vermeulen's PiDP-8/I emulator front panel. +# +# Original author: Mark G Thomas 2015-05-09 +# +# Copyright © 2015 Mark G Thomas +# Copyright © 2017 Warren Young +# +# Permission is hereby granted, free of charge, to any person obtaining +# a copy of this software and associated documentation files (the +# "Software"), to deal in the Software without restriction, including +# without limitation the rights to use, copy, modify, merge, publish, +# distribute, sublicense, and/or sell copies of the Software, and to +# permit persons to whom the Software is furnished to do so, subject to +# the following conditions: +# +# The above copyright notice and this permission notice shall be +# included in all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +# IN NO EVENT SHALL THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, +# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT +# OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE +# OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +# +# Except as contained in this notice, the names of the authors above +# shall not be used in advertising or otherwise to promote the sale, +# use or other dealings in this Software without prior written +# authorization from those authors. +######################################################################## + +PATH=/sbin:/usr/sbin:/bin:/usr/bin +umask 022 +. /lib/lsb/init-functions + +prefix="@ABSPREFIX@" +sim="$prefix/bin/pidp8i-sim" +scanswitch="$prefix/libexec/scanswitch" + +# Requires screen utility for detached pidp8i console functionality. +test -x /usr/bin/screen || ( echo "screen not found" && exit 0 ) + +# Also check for other needed binaries +test -x $scanswitch || ( echo "$scanswitch not found" && exit 0 ) +test -x $sim || ( echo "$sim not found" && exit 0 ) + +# Check if pidp8i is already runnning under screen. +# +is_running() { + procs=`screenu -ls pidp8i | egrep '[0-9]+\.pidp8i' | wc -l` + test $procs -gt 0 && return 0 || return 1 +} + +# Wrapper around screen(1) to drop privileges and pass given args +screenu() { + if [ "$USER" = "@INSTUSR@" ] + then + /usr/bin/screen $* + else + su -c "/usr/bin/screen $*" @INSTUSR@ + fi +} + +do_start() { + if is_running ; then + echo "PiDP-8/I is already running, not starting again." >&2 + exit 0 + fi + + # Regenerate SSH host keys if this is the first run on a fresh image + if [ ! -f /etc/ssh/ssh_host_ecdsa_key -a -x /usr/sbin/dpkg-reconfigure ] + then + log_daemon_msg "Regenerating SSH host keys..." "pidp8i" + /usr/sbin/dpkg-reconfigure openssh-server + fi + + $scanswitch >/dev/null 2>&1 + script=$? + if [ $script -eq 8 ]; then + echo "PiDP-8/I STOP switch detected, aborting." >&2 + exit 0 + elif [ $script -lt 8 ]; then + bscript="@BOOTDIR@/""$script"".script" + echo "Booting from $bscript..." + else + echo "Bad return value $script from $scanswitch!" + exit 1 + fi + + log_daemon_msg "Starting PiDP-8/I simulator" "pidp8i" + screenu -dmS pidp8i "$sim" $bscript + status=$? + log_end_msg $status + return $status +} + +do_stop() { + if ! is_running ; then + echo "PiDP-8/I is already stopped." >&2 + status=1 + else + log_daemon_msg "Stopping PiDP-8/I simulator" "pidp8i" + screenu -S pidp8i -X quit + status=$? + log_end_msg $status + fi + return $status +} + +case "$1" in + start) + do_start + ;; + + stop) + do_stop + ;; + + restart) + do_stop + do_start + ;; + + status) + screenu -ls pidp8i | egrep '[0-9]+\.pidp8i' + ;; + + *) + log_action_msg "Usage: /etc/init.d/pidp8i {start|stop|restart|status}" || true + exit 1 +esac + +exit 0 ADDED etc/sudoers.in Index: etc/sudoers.in ================================================================== --- /dev/null +++ etc/sudoers.in @@ -0,0 +1,2 @@ +@INSTUSR@ ALL=NOPASSWD: /bin/systemctl poweroff +@INSTUSR@ ALL=NOPASSWD: /bin/systemctl reboot ADDED examples/Makefile.in Index: examples/Makefile.in ================================================================== --- /dev/null +++ examples/Makefile.in @@ -0,0 +1,46 @@ +######################################################################## +# Makefile.in - Processed by autosetup's configure script to generate +# an intermediate GNU make(1) file for building the PiDP-8/I software +# from within its examples/ subdirectory. +# +# The resulting Makefile will redirect simple "make" calls to the top +# level as well as the major top-level targets (e.g. "make clean") but +# purposefully will not redirect anything like an installation or "run +# the system" type target. Its only purpose is to help out those who +# are working on the examples from within this directory. If you need +# to work on the wider system, do it from the project's top level. +# +# If you are seeing this at the top of a file called Makefile and you +# intend to make edits, do that in Makefile.in. Saying "make" will then +# re-build Makefile from that modified Makefile.in before proceeding to +# do the "make" operation. +# +# Copyright © 2017 Warren Young +# +# Permission is hereby granted, free of charge, to any person obtaining +# a copy of this software and associated documentation files (the +# "Software"), to deal in the Software without restriction, including +# without limitation the rights to use, copy, modify, merge, publish, +# distribute, sublicense, and/or sell copies of the Software, and to +# permit persons to whom the Software is furnished to do so, subject to +# the following conditions: +# +# The above copyright notice and this permission notice shall be +# included in all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +# IN NO EVENT SHALL THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, +# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT +# OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE +# OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +# +# Except as contained in this notice, the names of the authors above +# shall not be used in advertising or otherwise to promote the sale, +# use or other dealings in this Software without prior written +# authorization from those authors. +######################################################################## + +all clean ctags distclean tags reconfig: + cd @builddir@; make $@ ADDED examples/README.md Index: examples/README.md ================================================================== --- /dev/null +++ examples/README.md @@ -0,0 +1,291 @@ +# Example Programs + +## What's Provided + +The `examples` directory holds short example programs for your PiDP-8/I, +plus a number of subroutines you may find helpful in writing your own +programs: + +| Example | What It Does +----------------------------- +| `add.pal` | 2 + 3 = 5 The simplest program here; used below as a meta-example +| `hello.pal` | writes "HELLO, WORLD!" to the console; tests PRINTS subroutine +| `pep001.*` | Project Euler Problem #1 solutions, various languages +| `routines/decprt` | prints an unsigned 12-bit decimal integer to the console +| `routines/prints` | prints an ASCIIZ string stored as a series of 8-bit bytes to the console + +The `pep001.*` files are a case study series in solving a simple +problem, which lets you compare the solutions along several axes. Some +are much longer than others, but some will run faster and/or take less +memory. It is interesting to compare them. There are writeups on each of +these: + +* [**`pep001.pal`**][pal] — PAL8 Assembly Language +* [**`pep001.bas`**][bas] — OS/8 BASIC + +[pal]: https://tangentsoft.com/pidp8i/wiki?name=PEP001.PA +[bas]: https://tangentsoft.com/pidp8i/wiki?name=PEP001.BA + + +## How to Use the BASIC Examples + +To use the example BASIC program, simply transcribe it into OS/8 BASIC: + + .R BASIC + NEW OR OLD--NEW + FILE NAME--PAL001.BA + + READY + 10 FOR I = 1 TO 999 + 10 FOR I = 1 TO 999 + 20 A = I / 3 \ B = I / 5 + 30 IF INT(A) = A GOTO 60 + 40 IF INT(B) = B GOTO 60 + 50 GOTO 70 + 60 T = T + I + 70 NEXT I + 80 PRINT "TOTAL: "; T + 90 END + SAVE + + READY + RUN + + PAL001 BA 4A + + TOTAL: xxxxxxx + + READY + BYE + +If you're SSH'd into the PiDP-8/I, "transcribing" is simply a matter of +cut-and-paste into the terminal window. + +I've obscured the output on purpose, since I don't want this page to be +a spoiler for the Project Euler site. + +If you get a 2-letter code from BASIC in response to your `RUN` command, +it means you have an error in the program. See the BASIC section of the +OS/8 Handbook for a decoding guide. + + +## How to Use the Assembly Language Examples + +For each PAL8 assembly program in `examples/*.pal`, there are two +additional files: + +| Extension | Meaning +----------------------------- +| `*.pal` | the PAL8 assembly source code for the program +| `*.lst` | the human-readable assembler output +| `*.pt` | the machine-readable assembler output (RIM format) + +There are three ways to run these on your PiDP-8/I, each starting with +one of the above three files: + +1. Transcribe the assembly program text to a file within a PDP-8 + operating system and assemble it inside the simulator. + +2. Toggle the program in from the front panel. I can recommend this + method only for very short programs. + +3. Copy the `*.pt` file to a USB stick and use the PiDP-8/I's + [automatic media mounting feature][howto]. This is the fastest method. + +I cover each of these options below, in the same order as the list +above. + + +## Option 1: Transcribing the Assembly Code into an OS/8 Session + +To transcribe [`examples/add.pal`][pal] into the OS/8 simulation on a +PiDP-8/I: + + .R EDIT + *ADD.PA< + + #A ← append to ADD.PA + *0200 CLA CLL + MAIN, TAD A + TAD B + DCA C + HLT + A, 2 + B, 3 + C, + ← hit Ctrl-L to leave text edit mode + #E ← saves program text to disk + + .PAL ADD-LS + ERRORS DETECTED: 0 + LINKS GENERATED: 0 + + .DIR ADD.* /A + + ADD .PA 1 ADD .BN 1 ADD .LS 1 + + 399 FREE BLOCKS + +If you see some cryptic line from the assembler like `DE C` instead +of the `ERRORS DETECTED: 0` bit, an error has occurred. Table 3-3 in +my copy the OS/8 Handbook explains these. You will also have an `ADD.ER` +file explaining what happened. + +You can instead say `EXE ADD` to assemble and execute that program in a +single step, but beware that because the program halts the processor, +your OS/8 session also halts. If you take the opportunity as intended to +examine memory location `C` — 0207 — pressing `Start` to resume will +cause the processor to try executing the instruction at 0210, and who +knows what that will do? Even if you pass up the opportunity to examine +`C`, pressing `Start` immediately after the halt will do the same, +except that we know what it will do: it will try to execute the 0002 +value stored at `A` as an instruction! (I believe it means `AND` the +accumulator with memory location 2.) + +The solution to these problems is simple: + + .EDIT ADD ← don't need "R" because file exists + #R ← read first page in; isn't automatic! + #4D ← get rid of that pesky DCA line + #5I ← insert above "A" def'n, now on line 5 + JMP 7600 ← Ctrl-L again to exit edit mode + #E ← save and exit + + .EXE ADD + +As before, the processor stops, but this time because we didn't move the +result from the accumulator to memory location `C`, we can see the +answer on the accumulator line on the front panel. Pressing `Start` this +time continues to the next instruction which re-enters OS/8. Much nicer! + +As you can see, this option is the most educational, as it matches +the working experience of PDP-8 assembly language programmers back +in the day. The tools may differ — the user may prefer `TECO` over +`EDIT` or MACRO-8 over PAL8 — but the idea is the same regardless. + +If you have the finished assembly code already on your computer and are +SSH'd into the PiDP-8/I machine, there is a shortcut for all of the +above. At the OS/8 command line, say: + + .R PIP + *ADD.PA 0 so re-enter loop core + JMS SHOWST / exceeded threshold, so display subtotal and " + " + DCA STOTAL / take advantage of free zero left by SHOWST + TAD (PLUS-1) + JMS PRINTS + JMP MLCORE + +MLDONE, JMS SHOWST / done; show answer + TAD (CRLF-1) / don't need CLA; SHOWST left AC = 0 + JMS PRINTS + + / End program gracefully, either re-entering OS/8 if we can see + / that its entry point looks sane, or halting with the answer in + / AC so the user can see the answer on the front panel. +OS8ENT, / 7600, OS/8's entry point, happens to also be... +ENDG, 7600 / ...the group 2 variant of CLA; yes, we know, yuck! + TAD I OS8ENT + TAD OS8INS1 / add its negative + SNA CLA / if it's zero'd out, then... + JMP I OS8ENT / re-enter OS/8 + TAD STOTAL / else not running under OS/8... + HLT / so halt with STOTAL displayed in AC lights +OS8INS1,-4207 / first OS/8 instruction at entry point, negated + + +//// ISMOD0 //////////////////////////////////////////////////////////// +/ If passed AC divides evenly into CURR (in C-speak, CURR % AC == 0) +/ add CURR to STOTAL and return 0 in AC. Else, return nonzero in AC and +/ leave STOTAL untouched. + +ISMOD0, 0 + DCA DIVISOR / Divide CURR by DIVISOR, passed as AC + TAD CURR / load CURR into just-cleared AC + MQL DVI / move CURR to MQ, divide by DIVISOR... +DIVISOR,0 / ...quotient in MQ, remainder in AC + SZA + JMP I ISMOD0 / remainder nonzero, so leave early + + / Division left AC empty, so CURR divides evenly by DIVISOR! + TAD CURR / don't need to clear AC; prior test says AC == 0 + TAD STOTAL + DCA STOTAL + JMP I ISMOD0 + + +//// SHOWST //////////////////////////////////////////////////////////// +/ Write STOTAL value to terminal in decimal. We purposely do not follow +/ it with anything, as our callers variously follow it with " + " or a +/ CRLF pair. Leaves AC = 0 because DECRPT does. + +SHOWST, 0 + CLR + TAD STOTAL + JMS DECPRT / print answer on console, in decimal + JMP I SHOWST / and done + + +//// TYPE ////////////////////////////////////////////////////////////// +/ Send a character out to the terminal. Shared core of PRINTS and +/ DECPRT. + +TYPE, 0 + TSF + JMP .-1 + TLS + CLA + JMP I TYPE + + +//// PRINTS //////////////////////////////////////////////////////////// +/ Write an ASCIIZ string to the terminal. Expects to receive the +/ address of the string - 1 in AC. (The -1 hassle saves an instruction +/ or two in our use of an autoincrement register.) Uses the autoinc +/ register at location 10. + +SADDR=10 / autoinc register for walking the string +PRINTS, 0 + DCA SADDR / save AC as string address +PSNEXT, TAD I SADDR / load next character + SNA + JMP I PRINTS / found the null terminator; leave + JMS TYPE / Print that character + JMP PSNEXT / look at next character + + +//// DECPRT //////////////////////////////////////////////////////////// +/ Decimal number printer; variant of examples/routines/decprt.pal +/ Leaves AC = 0. + +DECPRT, 0 + DCA VALUE /SAVE INPUT + DCA DIGIT /CLEAR + TAD CNTRZA + DCA CNTRZB /SET COUNTER TO FOUR + TAD ADDRZA + DCA ARROW /SET TABLE POINTER + SKP + DCA VALUE /SAVE + CLL + TAD VALUE +ARROW, TAD TENPWR /SUBTRACT POWER OF TEN + SZL + ISZ DIGIT /DEVELOP BCD DIGIT + SZL + JMP ARROW-3 /LOOP + CLA /HAVE BCD DIGIT + TAD DIGIT /GET DIGIT + TAD K260 /MAKE IT ASCII + JMS TYPE + DCA DIGIT /CLEAR + ISZ ARROW /UPDATE POINTER + ISZ CNTRZB /DONE ALL FOUR? + JMP ARROW-1 /NO: CONTINUE + JMP I DECPRT /YES: EXIT + +ADDRZA, TAD TENPWR +CNTRZA, -4 +TENPWR, -1750 /ONE THOUSAND + -0144 /ONE HUNDRED + -0012 /TEN + -0001 /ONE +K260, 260 +VALUE, 0 +DIGIT, 0 +CNTRZB, 0 + + +//// Global Variables ////////////////////////////////////////////////// + +CURR, 0 / current number we're checking +STOTAL, 0 / subtotal, printed and reset occasionally + + +//// Constants ///////////////////////////////////////////////////////// + + DECIMAL +MAX, 999 / check natural numbers CURR to MAX; must be < 2048! +STMAX, 1024 / subtotal max; avoids overflow of 12-bit signed int + + OCTAL +CRLF, 15;12;0 / ASCII character values, zero-terminated +PLUS, 40;53;40;0 +ANSWER, 101;116;123;127;105;122;72;40;0 + + +//// END /////////////////////////////////////////////////////////////// +/ Assembler-generated constants will appear below this in the list file +$ ADDED examples/routines/decprt.pal Index: examples/routines/decprt.pal ================================================================== --- /dev/null +++ examples/routines/decprt.pal @@ -0,0 +1,44 @@ +/COPYRIGHT 1971, DIGITAL EQUIPMENT CORPORATION +/MAYNARD, MASSACHUSETTS +/DIGITAL 8-22-U +/UNSIGNED DECIMAL PRINT +/CALL WITH NUMBER TO BE TYPED IN C(AC) +/RETURN TO LOCATION FOLLOWING THE JMS +DECPRT, 0 + DCA VALUE /SAVE INPUT + DCA DIGIT /CLEAR + TAD CNTRZA + DCA CNTRZB /SET COUNTER TO FOUR + TAD ADDRZA + DCA ARROW /SET TABLE POINTER + SKP + DCA VALUE /SAVE + CLL + TAD VALUE +ARROW, TAD TENPWR /SUBTRACT POWER OF TEN + SZL + ISZ DIGIT /DEVELOP BCD DIGIT + SZL + JMP ARROW-3 /LOOP + CLA /HAVE BCD DIGIT + TAD DIGIT /GET DIGIT + TAD K260 /MAKE IT ASCII + TSF /OR TAD DIGIT + JMP .-1 /JMS TDIGIT(SEE 8-19-U) + TLS /TYPE DIGIT + CLA + DCA DIGIT /CLEAR + ISZ ARROW /UPDATE POINTER + ISZ CNTRZB /DONE ALL FOUR? + JMP ARROW-1 /NO: CONTINUE + JMP I DECPRT /YES: EXIT +ADDRZA, TAD TENPWR +CNTRZA, -4 +TENPWR, -1750 /ONE THOUSAND + -0144 /ONE HUNDRED + -0012 /TEN + -0001 /ONE +K260, 260 +VALUE, 0 +DIGIT, 0 +CNTRZB, 0 ADDED examples/routines/prints.pal Index: examples/routines/prints.pal ================================================================== --- /dev/null +++ examples/routines/prints.pal @@ -0,0 +1,52 @@ +/ PRINTS - Print an ASCIIZ string to the terminal +/ +/ It expects to receive the address of the string - 1 in AC. (The -1 +/ hassle saves an instruction or two in our use of an autoincrement +/ register.) +/ +/ This routine uses the autoinc register at location 10. +/ +/ Created by Warren Young of tangentsoft.com, 2016.11.30 +/ Improved by Rick Murphy of the PiDP-8/I mailing list, 2016.12.03 +/ +/ Copyright © 2016 Warren Young and Rick Murphy +/ +/ Permission is hereby granted, free of charge, to any person obtaining a +/ copy of this software and associated documentation files (the "Software"), +/ to deal in the Software without restriction, including without limitation +/ the rights to use, copy, modify, merge, publish, distribute, sublicense, +/ and/or sell copies of the Software, and to permit persons to whom the +/ Software is furnished to do so, subject to the following conditions: +/ +/ The above copyright notice and this permission notice shall be included in +/ all copies or substantial portions of the Software. +/ +/ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +/ IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +/ FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL +/ THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER +/ LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +/ FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +/ DEALINGS IN THE SOFTWARE. +/ +/ Except as contained in this notice, the names of the authors above shall +/ not be used in advertising or otherwise to promote the sale, use or other +/ dealings in this Software without prior written authorization from those +/ authors. +//////////////////////////////////////////////////////////////////////// + +TYPE, 0 / helper routine for sending a single character + TSF + JMP .-1 + TLS + CLA + JMP I TYPE + +SADDR=10 / autoinc register for walking the string +PRINTS, 0 + DCA SADDR / save AC as string address +PSNEXT, TAD I SADDR / load next character + SNA + JMP I PRINTS / found the null terminator; leave + JMS TYPE / print that character + JMP PSNEXT / look at next character ADDED labels/README.md Index: labels/README.md ================================================================== --- /dev/null +++ labels/README.md @@ -0,0 +1,63 @@ +# USB Stick Labels + +## What It Is + +This directory contains an Inkscape document (`*.svg`) containing the +DECtape logo and USB stick labels with graphics based on that label. +There are three example labels in the document: + +* **BIN Loader** for `media/copytoUSBsticks/binloader.pt` +* **FOCAL-69** for `media/copytoUSBsticks/focal.pt` +* **ADD.PA** for `examples/add.pt` + +These labels use the "DECtape" graphics even though they're paper tapes, +primarily because it's a nice graphic and I haven't bothered to draw +something appropriate to paper tapes yet. + +The labels print out at approximately 30×16mm each, which fits the USB +sticks I have here, but you may need to scale the printout for your +particular USB sticks. + + +## Affixing the Labels + +This document is not designed with any particular self-adhesive label +stock in mind. Instead, I simply use rubber cement as a contact adhesive +to affix these labels to the USB stick. + +Simply cut the label(s) you want to use out with scissors, paint both +the back of the label and the top of the USB stick with rubber cement, +and let it dry for a minute or so. When the glue is dry-looking, +carefully place the label where you want it on the USB stick. You won't +have much of a chance to move the label around after the two dried glue +patches touch, so be careful with your placement. + +Press the label firmly against the stick, pressing repeatedly to cover +the entire surface, then rub around the label gently to brush away any +excess cement. + +Protip: Use the part of the page you cut the labels out of as a +protective mat to work on. It will let you apply cement to the label +fully edge-to-edge without messing up your work surface. The labels will +be much more durable if there is no unglued bit near the edge for +fingernails and such to snag on. You were going to throw this excess +material away, so you might as well get one final use out of it, yes? + + +## Fonts + +This SVG file uses a non-free font called [Dottie][font] for the faux +dot matrix text. There are [free alternatives][alt], but none of the +ones I liked allow redistribution, so I couldn't include one of them in +this repository. + +[font]: https://www.fonts.com/font/ingrimayne-type/dottie/regular +[alt]: http://www.1001fonts.com/digital+dot-matrix-fonts.html + + +## PDF Version + +If you don't want to use one of those alternative fonts or simply like +the look of Dottie and don't need custom labels, this directory also +includes a PDF of the same design with the necessary subset of Dottie +embedded, so that you can print it out. ADDED labels/dectape-usb-key.pdf Index: labels/dectape-usb-key.pdf ================================================================== --- /dev/null +++ labels/dectape-usb-key.pdf cannot compute difference between binary files ADDED labels/dectape-usb-key.svg Index: labels/dectape-usb-key.svg ================================================================== --- /dev/null +++ labels/dectape-usb-key.svg @@ -0,0 +1,546 @@ + + + +PiDP-8/I USB key labelsimage/svg+xmlPiDP-8/I USB key labelsDecember 2016Warren Youngsee licenseEnglishlabelUSBDECPDP-8dot matrixDECtapeGraphical labels for use on USB sticks containing binary media images suitable for use with the PiDP-8/I's USB stick auto-attaching feature.DIGITAL EQUIPMENT CORPORATION +MAYNARD, MASSACHUSETTS, 01754 +REEL NO. +DATE + + + +BIN LOADERDEC-08-LBAA-PM5/10/67 SA:7777 +FOCAL-69DEC-08-AJAB-PB4/29/68 SA:0200 +ADD.PAPIDP-8/I Example11/27/16 SA:0200 + ADDED media/copytoUSBsticks/binloader.pt Index: media/copytoUSBsticks/binloader.pt ================================================================== --- /dev/null +++ media/copytoUSBsticks/binloader.pt cannot compute difference between binary files ADDED media/copytoUSBsticks/focal69.pt Index: media/copytoUSBsticks/focal69.pt ================================================================== --- /dev/null +++ media/copytoUSBsticks/focal69.pt cannot compute difference between binary files ADDED media/copytoUSBsticks/readme.txt Index: media/copytoUSBsticks/readme.txt ================================================================== --- /dev/null +++ media/copytoUSBsticks/readme.txt @@ -0,0 +1,37 @@ +The PiDP is typically used with a USB hub as its 'PiDP Universal Storage Device'. + +Image files (disk images, paper tape images, DECtape images) are then stored on a USB stick, +and when inserted to the USB hub the first image file can be mounted into the emulated device. + +The image files in this directory are typical candidates to put on USB sticks. + +Mounting works as follows: + +1. Select the device you want to mount on by setting the Data Field switches + + Switch Settings File Extension + -------------------------------------------------------------------------------- + 000 - mount USB paper tape on the high-speed paper tape reader .pt + 001 - mount USB paper tape on the paper tape punch .pt + 010 - mount DECtape on DT0 (TU55) .dt + 011 - mount DECtape on DT1 (TU55) .dt + 100 - mount 8" floppy disk on RX0 (RX01/02) .rx + 101 - mount 8" floppy disk on RX1 (RX01/02) .rx + 110 - mount 10MB removable disk cartridge on RL0 (RL8A) .rl + 111 - mount 10MB removable disk cartridge on RL1 (RL8A) .rl + +2. Toggle Sing_Step and Sing_Inst switches together + +3. The PiDP will scan all inserted USB sticks and mount the first unmounted image file for that device. + Scanning requires the image file to have the extension as per the above table. + This is equivalent to using the attach command from the simh command line. + +Notes: + +- Multiple image files can reside on one USB stick, as long as they do not have the same extension + (and your USB stick is large enough). + +- You can put any other files on the sticks too, the PiDP will just ignore them. + +- You can, of course, also just use the simh attach command to mount any image files on the SD card, + and ignore the "PiDP Universal USB Storage Device" altogether. ADDED media/etos/etos.txt Index: media/etos/etos.txt ================================================================== --- /dev/null +++ media/etos/etos.txt @@ -0,0 +1,30 @@ +At main console: +---------------- +To run ETOS: R ETOS to start the operating system. Hit return at the option prompt. + +To login enter LOGIN and then hit return which should then give the login prompt. No prompt will be displayed for entering the login command. At the prompt enter account number such as 0,3 and hit return. Then enter the password at the password prompt. On the distribution ETOS pack the following users exist: + +At terminal (telnet localhost 4000): +----------- + +LOGIN;0,4 USER1 + + +Users: +------ +Account Password +0,4 USER1 +0,5 USER2 + +Shutdown: +--------- +You can To shutdown enter +. ^VS (^V is control-V) +!PRIV 4040 +!SHUTUP + +See: +---- +http://www.pdp8.net/os/etos/ (introduction) +http://highgate.comm.sfu.ca/pdp8/index.html (manuals, search page for ETOS) +ftp://ftp.pdp8online.com/images/etos/ (disk images) ADDED media/etos/etosv5b-demo.rk05 Index: media/etos/etosv5b-demo.rk05 ================================================================== --- /dev/null +++ media/etos/etosv5b-demo.rk05 ADDED media/os8/LICENSE.md Index: media/os8/LICENSE.md ================================================================== --- /dev/null +++ media/os8/LICENSE.md @@ -0,0 +1,102 @@ +# Digital License Agreement + +This document is your Proof of License and the legal agreement governing +your use of the OS/8 software. + + +## 1 DEFINITION + +SOFTWARE TECHNOLOGY shall mean the sources and binaries to the OS/8, an +operating system that runs on PDP-8 computers. + +DIGITAL’S INTELLECTUAL PROPERTY RIGHTS shall mean DIGITAL’s patent, +copyright and trade secret rights in its SOFTWARE TECHNOLOGY. + + +## 2 LICENSE GRANT + +Digital grants to Customer a worldwide, non-exclusive, royalty-free +license under DIGITAL’s INTELLECTUAL PROPERTY RIGHTS to reproduce, +modify, use and distribute the SOFTWARE TECHNOLOGY solely for +non-commercial uses. + + +## 3 TECHNOLOGY TRANSFER AND ACCEPTANCE + +3.1 CUSTOMER acknowledges that it accepts the SOFTWARE TECHNOLOGY "AS +IS". + +3.2 DIGITAL is under no obligation to supply error corrections or +updates to the SOFTWARE TECHNOLOGY as they become available, or to +provide training, support or consulting for the SOFTWARE TECHNOLOGY. + + +## 4 WARRANTY DISCLAIMER/LIMITATION OF LIABILITY + +DIGITAL DISCLAIMS ALL WARRANTIES WITH REGARD TO ANY SOFTWARE TECHNOLOGY +LICENSED TO CUSTOMER HEREUNDER, INCLUDING ALL IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL DIGITAL BE LIABLE FOR +ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER +RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF +CONTRACT, NEGLIGENCE, INTELLECTUAL PROPERTY INFRINGEMENT OR OTHER +TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR +PERFORMANCE OF ANY SOFTWARE TECHNOLOGY LICENSE HEREUNDER. + + +## 5 INDEMNITY + +CUSTOMER will hold DIGITAL harmless against all liabilities, demands, +damages, expenses, or losses arising out of use by CUSTOMER of SOFTWARE +TECHNOLOGY or information furnished under this Agreement. + + +## 6 TERM AND TERMINATION + +6.1 This Agreement shall be effective until otherwise terminated. +Either party may terminate this Agreement at any time upon 30 days +written notice. + +6.2 If CUSTOMER shall fail to perform or observe any of the terms and +conditions to be performed or observed by it under this Agreement, +DIGITAL may in its sole discretion thereafter elect to terminate this +Agreement, and this Agreement and all the obligations owed and rights +granted herein to CUSTOMER shall immediately terminate. + +6.3 The parties agree that the termination of this Agreement shall not +release either party from any other liability which shall have accrued +to the other party at the time such termination becomes effective, nor +affect in any manner the survival of any right, duty or obligation of +either party. + +6.4 In the event of any termination of this Agreement for any reason, +CUSTOMER shall delete all original and all whole or partial copies and +derivatives of the SOFTWARE TECHNOLOGY provided to CUSTOMER under this +Agreement. CUSTOMER further shall cease to use and distribute the +SOFTWARE TECHNOLOGY in all forms immediately upon the date of +termination. + + +## 7 GENERAL TERMS + +7.1 This Agreement shall be governed by the laws of the Commonwealth of +Massachusetts. + +7.2 This Agreement imposes personal obligations on CUSTOMER. CUSTOMER +shall not assign any rights under this Agreement not specifically +transferable by its terms without the written consent of DIGITAL. + +7.3 The SOFTWARE TECHNOLOGY obtained under this Agreement may be subject +to US and other government export control regulations. CUSTOMER assures +that it will comply with these regulations whenever it exports or +re-exports a controlled product or technical data obtained from DIGITAL +or any product produced directly from the SOFTWARE TECHNOLOGY. + +7.4 The waiver of a breach hereunder may be effected only by a writing +signed by the waiving party and shall not constitute a waiver of any +other breach. + +7.5 CUSTOMER acknowledges that he has read this Agreement, understands +it and agrees to be bound by its term and further agrees that it is the +complete and exclusive statement of the Agreement between the parties +which supersedes all communications and understanding between the +parties relating to the subject matter of this Agreement. ADDED media/os8/os8.rk05 Index: media/os8/os8.rk05 ================================================================== --- /dev/null +++ media/os8/os8.rk05 cannot compute difference between binary files ADDED media/os8/os8.tu56 Index: media/os8/os8.tu56 ================================================================== --- /dev/null +++ media/os8/os8.tu56 cannot compute difference between binary files ADDED media/spacewar/spacewar.bin Index: media/spacewar/spacewar.bin ================================================================== --- /dev/null +++ media/spacewar/spacewar.bin cannot compute difference between binary files ADDED media/tss8/tss8_init.bin Index: media/tss8/tss8_init.bin ================================================================== --- /dev/null +++ media/tss8/tss8_init.bin cannot compute difference between binary files ADDED media/tss8/tss8_rf.dsk Index: media/tss8/tss8_rf.dsk ================================================================== --- /dev/null +++ media/tss8/tss8_rf.dsk cannot compute difference between binary files ADDED palbart/LICENSE.md Index: palbart/LICENSE.md ================================================================== --- /dev/null +++ palbart/LICENSE.md @@ -0,0 +1,16 @@ +# palbart License + +The following was extracted from the top of [`palbart.c`][1] in this +directory: + +--------- + +This is free software. There is no fee for using it. You may make any +changes that you wish and also give it away. If you can make commercial +product out of it, fine, but do not put any limits on the purchaser's +right to do the same. If you improve it or fix any bugs, it would be +nice if you told me and offered me a copy of the new version. + +--------- + +[1]: https://tangentsoft.com/pidp8i/doc/trunk/palbart/palbart.c ADDED palbart/palbart.1 Index: palbart/palbart.1 ================================================================== --- /dev/null +++ palbart/palbart.1 @@ -0,0 +1,200 @@ +.\" Hey, EMACS: -*- nroff -*- +.\" First parameter, NAME, should be all caps +.\" Second parameter, SECTION, should be 1-8, maybe w/ subsection +.\" other parameters are allowed: see man(7), man(1) +.TH PALBART 1 "January 16, 2000" +.\" Please adjust this date whenever revising the manpage. +.\" +.\" Some roff macros, for reference: +.\" .nh disable hyphenation +.\" .hy enable hyphenation +.\" .ad l left justify +.\" .ad b justify to both left and right margins +.\" .nf disable filling +.\" .fi enable filling +.\" .br insert line break +.\" .sp insert n+1 empty lines +.\" for manpage-specific macros, see man(7) +.SH NAME +palbart \- BART enhanced PDP8 crossassembler +.SH SYNOPSIS +.B palbart +.RI [options] inputfile +.br +.SH DESCRIPTION +This manual page documents briefly the +.B palbart +command. +It is a cross-assembler to for PDP/8 assembly language programs. +It will produce an output file in bin format, rim format, and using the +appropriate pseudo-ops, a combination of rim and bin formats. +A listing file is always produced and with an optional symbol table +and/or a symbol cross-reference (concordance). The permanent symbol +table can be output in a form that may be read back in so a customized +permanent symbol table can be produced. Any detected errors are output +to a separate file giving the filename in which they were detected +along with the line number, column number and error message as well as +marking the error in the listing file. +.PP +The following file name extensions are used: +.PP + .pal source code (input) +.PP + .lst assembly listing (output) +.PP + .bin assembly output in DEC's bin format (output) +.PP + .rim assembly output in DEC's rim format (output) +.PP + .err assembly errors detected (if any) (output) +.PP + .prm permanent symbol table in form suitable for reading after the EXPUNGE pseudo-op. + +.PP +.SH OPTIONS +A summary of options is included below. +.TP +.B \-d +Show symbol table at end of assembly +.TP +.B \-h +Display help. +.TP +.B \-l +Allow generation of literals (default is no literal generation) +Show version of program. +.TP +.B \-p +Generate a file with the permanent symbols in it. +(To get the current symbol table, assemble a file than has only +a $ in it.) +.TP +.B \-r +Produce output in rim format (default is bin format) +.TP +.B \-v +Display version information. +.TP +.B \-x +Generate a cross-reference (concordance) of user symbols. + +.SH DIAGNOSTICS +Assembler error diagnostics are output to an error file and inserted +in the listing file. Each line in the error file has the form +.PP +(:) : error: at Loc = +.PP +An example error message is: +.br +bintst.pal(17:9) : error: undefined symbol "UNDEF" at Loc = 07616 +.PP +The error diagnostics put in the listing start with a two character +error code (if appropriate) and a short message. A carat '^' is +placed under the item in error if appropriate. +An example error message is: +.PP + 17 07616 3000 DCA UNDEF +.br + UD undefined ^ +.br + 18 07617 1777 TAD I DUMMY +.PP +When an indirect is generated, an at character '@' is placed after the +the instruction value in the listing as an indicator as follows: +.PP + 14 03716 1777@ TAD OFFPAG +.PP +Undefined symbols are marked in the symbol table listing by prepending +a '?' to the symbol. Redefined symbols are marked in the symbol table +listing by prepending a '#' to the symbol. Examples are: +.PP + #REDEF 04567 +.br + SWITCH 07612 +.br + ?UNDEF 00000 +.PP +Refer to the code for the diagnostic messages generated. + +.SH BUGS +Only a minimal effort has been made to keep the listing format +anything like the PAL-8 listing format. +The operation of the conditional assembly pseudo-ops may not function +exactly as the DEC versions. I did not have any examples of these so +the implementation is my interpretation of how they should work. +.PP +The RIMPUNch and BINPUNch pseudo-ops do not change the binary output +file type that was specified on startup. This was intentional and +and allows rim formatted data to be output prior to the actual binary +formatted data. On UN*X style systems, the same effect can be achieved +ing the "cat" command, but on DOS/Windows systems, doing this was +a major chore. +.PP +The floating point input does not generate values exactly as the DEC +compiler does. I worked out several examples by hand and believe that +this implementation is slightly more accurate. If I am mistaken, +let me know and, if possible, a better method of generating the values. +.br + +.SH HISTORICAL NOTE +This assembler was written to support the fleet of PDP-8 systems +used by the Bay Area Rapid Transit System. As of early 1997, +this includes about 40 PDP-8/E systems driving the train destination +signs in passenger stations. + +.SH REFERENCES +This assembler is based on the pal assember by: +.br +Douglas Jones and +.br +Rich Coon + +.SH DISCLAIMER +See the symbol table for the set of pseudo-ops supported. +.PP +See the code for pseudo-ops that are not standard for PDP/8 assembly. +.PP +Refer to DEC's "Programming Languages (for the PDP/8)" for complete +documentation of pseudo-ops. +.PP +Refer to DEC's "Introduction to Programming (for the PDP/8)" or a +lower level introduction to the assembly language. + +.SH WARRANTY +If you don't like it the way it works or if it doesn't work, that's +tough. You're welcome to fix it yourself. That's what you get for +using free software. + +.SH COPYRIGHT NOTICE +This is free software. There is no fee for using it. You may make +any changes that you wish and also give it away. If you can make +a commercial product out of it, fine, but do not put any limits on +the purchaser's right to do the same. If you improve it or fix any +bugs, it would be nice if you told me and offered me a copy of the +new version. +Gary Messenbrink + +.SH VERSIONS + Version Date by Comments +.br + v1.0 12Apr96 GAM Original +.br + v1.1 18Nov96 GAM Permanent symbol table initialization error. +.br + v1.2 20Nov96 GAM Added BINPUNch and RIMPUNch pseudo-operators. +.br + v1.3 24Nov96 GAM Added DUBL pseudo-op (24 bit integer constants). +.br + v1.4 29Nov96 GAM Fixed bug in checksum generation. +.br + v2.1 08Dec96 GAM Added concordance processing (cross reference). +.br + v2.2 10Dec96 GAM Added FLTG psuedo-op (floating point constants). +.br + v2.3 2Feb97 GAM Fixed paging problem in cross reference output. +.br + v2.4 11Apr97 GAM Fixed problem with some labels being put in cross reference multiple times. + +.SH AUTHOR +This manual page was written by Vince Mulhollon , +for the Debian GNU/Linux system (but may be used by others). ADDED palbart/palbart.c Index: palbart/palbart.c ================================================================== --- /dev/null +++ palbart/palbart.c @@ -0,0 +1,4352 @@ +/******************************************************************************/ +/* */ +/* Program: PAL (BART version) */ +/* File: pal.c */ +/* Author: Gary A. Messenbrink */ +/* gam@rahul.net */ +/* */ +/* Purpose: A 2 pass PDP-8 pal-like assembler. */ +/* */ +/* PAL(1) */ +/* */ +/* NAME */ +/* pal - a PDP/8 pal-like assembler. */ +/* */ +/* SYNOPSIS: */ +/* pal [ -$ -d -h -e -l -p -r -t -v -x ] inputfile */ +/* */ +/* DESCRIPTION */ +/* This is a cross-assembler to for PDP/8 assembly language programs. */ +/* It will produce an output file in bin format, rim format, and using the */ +/* appropriate pseudo-ops, a combination of rim and bin formats. */ +/* A listing file is always produced and with an optional symbol table */ +/* and/or a symbol cross-reference (concordance). The permanent symbol */ +/* table can be output in a form that may be read back in so a customized */ +/* permanent symbol table can be produced. Any detected errors are output */ +/* to a separate file giving the filename in which they were detected */ +/* along with the line number, column number and error message as well as */ +/* marking the error in the listing file. */ +/* The following file name extensions are used: */ +/* .pal source code (input) */ +/* .lst assembly listing (output) */ +/* .bin assembly output in DEC's bin format (output) */ +/* .rim assembly output in DEC's rim format (output) */ +/* .err assembly errors detected (if any) (output) */ +/* .prm permanent symbol table in form suitable for reading after */ +/* the EXPUNGE pseudo-op. */ +/* */ +/* OPTIONS */ +/* -$ Allow files to not end with $ */ +/* -d Dump the symbol table at end of assembly */ +/* -h Show help */ +/* -e Don't allow generation of links */ +/* -l Allow generation of links (default is link generation) */ +/* -n No redefinition of permanent symbols with labels */ +/* -p Generate a file with the permanent symbols in it. */ +/* (To get the current symbol table, assemble a file than has only */ +/* a $ in it.) */ +/* -r Produce output in rim format (default is bin format) */ +/* -tN Set tab stops to N spaces (default is 8) */ +/* -v Display program version. */ +/* -x Generate a cross-reference (concordance) of user symbols. */ +/* */ +/* DIAGNOSTICS */ +/* Assembler error diagnostics are output to an error file and inserted */ +/* in the listing file. Each line in the error file has the form */ +/* */ +/* (:) : error: at Loc = */ +/* */ +/* An example error message is: */ +/* */ +/* bintst.pal(17:9) : error: undefined symbol "UNDEF" at Loc = 07616 */ +/* */ +/* The error diagnostics put in the listing start with a two character */ +/* error code (if appropriate) and a short message. A carat '^' is */ +/* placed under the item in error if appropriate. */ +/* An example error message is: */ +/* */ +/* 17 07616 3000 DCA UNDEF */ +/* UD undefined ^ */ +/* 18 07617 1777 TAD I DUMMY */ +/* */ +/* When an indirect is generated, an at character '@' is placed after the */ +/* the instruction value in the listing as an indicator as follows: */ +/* */ +/* 14 03716 1777@ TAD OFFPAG */ +/* */ +/* Undefined symbols are marked in the symbol table listing by prepending */ +/* a '?' to the symbol. Redefined symbols are marked in the symbol table */ +/* listing by prepending a '#' to the symbol. Examples are: */ +/* */ +/* #REDEF 04567 */ +/* SWITCH 07612 */ +/* ?UNDEF 00000 */ +/* */ +/* Refer to the code for the diagnostic messages generated. */ +/* */ +/* BUGS */ +/* This program will accept source that real PAL will not. To ensure */ +/* valid source assemble on real or simulated PDP-8. */ +/* Different PAL versions have different permanent symbols defined. This */ +/* program define more than and PAL version. By default redefining them */ +/* as a label is not an error. It is for normal PAL. The -n flag will */ +/* make redefining an error. */ +/* */ +/* Only a minimal effort has been made to keep the listing format */ +/* anything like the PAL-8 listing format. */ +/* The operation of the conditional assembly pseudo-ops may not function */ +/* exactly as the DEC versions. I did not have any examples of these so */ +/* the implementation is my interpretation of how they should work. */ +/* */ +/* The RIMPUNch and BINPUNch pseudo-ops do not change the binary output */ +/* file type that was specified on startup. This was intentional and */ +/* and allows rim formatted data to be output prior to the actual binary */ +/* formatted data. On UN*X style systems, the same effect can be achieved */ +/* by using the "cat" command, but on DOS/Windows systems, doing this was */ +/* a major chore. */ +/* */ +/* The floating point input does not generate values exactly as the DEC */ +/* compiler does. I worked out several examples by hand and believe that */ +/* this implementation is slightly more accurate. If I am mistaken, */ +/* let me know and, if possible, a better method of generating the values. */ +/* */ +/* CDF .-. */ +/* Generates 2201 when assembled at 5000. This looks like a bug in OS/8 */ +/* PAL */ +/* */ +/* BUILD and INSTALLATION */ +/* The current version has only been built under Linux. */ +/* Earlier versions have been built and successfully executed on: */ +/* a. Linux (80486 CPU)using gcc */ +/* b. RS/6000 (AIX 3.2.5) */ +/* c. Borland C++ version 3.1 (large memory model) */ +/* d. Borland C++ version 4.52 (large memory model) */ +/* with no modifications to the source code. */ +/* */ +/* On UNIX type systems, store the the program as the pal command */ +/* and on PC type systems, store it as pal.exe */ +/* */ +/* HISTORICAL NOTE: */ +/* This assembler was written to support the fleet of PDP-8 systems */ +/* used by the Bay Area Rapid Transit System. As of early 1997, */ +/* this includes about 40 PDP-8/E systems driving the train destination */ +/* signs in passenger stations. */ +/* */ +/* REFERENCES: */ +/* This assembler is based on the pal assembler by: */ +/* Douglas Jones and */ +/* Rich Coon */ +/* */ +/* DISCLAIMER: */ +/* See the symbol table for the set of pseudo-ops supported. */ +/* See the code for pseudo-ops that are not standard for PDP/8 assembly. */ +/* Refer to DEC's "Programming Languages (for the PDP/8)" for complete */ +/* documentation of pseudo-ops. */ +/* Refer to DEC's "Introduction to Programming (for the PDP/8)" or a */ +/* lower level introduction to the assembly language. */ +/* */ +/* WARRANTY: */ +/* If you don't like it the way it works or if it doesn't work, that's */ +/* tough. You're welcome to fix it yourself. That's what you get for */ +/* using free software. */ +/* */ +/* COPYRIGHT NOTICE: */ +/* This is free software. There is no fee for using it. You may make */ +/* any changes that you wish and also give it away. If you can make */ +/* a commercial product out of it, fine, but do not put any limits on */ +/* the purchaser's right to do the same. If you improve it or fix any */ +/* bugs, it would be nice if you told me and offered me a copy of the */ +/* new version. */ +/* */ +/* */ +/* Amendments Record: */ +/* Version Date by Comments */ +/* ------- ------- --- --------------------------------------------------- */ +/* v1.0 12Apr96 GAM Original */ +/* v1.1 18Nov96 GAM Permanent symbol table initialization error. */ +/* v1.2 20Nov96 GAM Added BINPUNch and RIMPUNch pseudo-operators. */ +/* v1.3 24Nov96 GAM Added DUBL pseudo-op (24 bit integer constants). */ +/* v1.4 29Nov96 GAM Fixed bug in checksum generation. */ +/* v2.1 08Dec96 GAM Added concordance processing (cross reference). */ +/* v2.2 10Dec96 GAM Added FLTG psuedo-op (floating point constants). */ +/* v2.3 2Feb97 GAM Fixed paging problem in cross reference output. */ +/* DJG: I started with the 2.5 RK version but found when looking on the net */ +/* later that multiple diverging version existed. I have tried to combine */ +/* the fixed into one version. I took the version info below from the versions*/ +/* I pulled from. */ +/* http://dustyoldcomputers.com/pdp-common/reference/host/index.html */ +/* http://www.dunnington.u-net.com/public/PDP-8/palbart.c */ +/* http://sourcecodebrowser.com/palbart/2.4/palbart-2_84_8c_source.html */ +/* http://packages.qa.debian.org/p/palbart.html */ +/* v2.4 11Apr97 GAM Fixed problem with some labels being put in cross */ +/* reference multiple times. */ +/* Started with RK version, Attempted to merge */ +/* GAM V2.4 and PNT change DJG */ +/* v2.4 29Oct07 RK Added 4 character tabstop; IOTs for TA8/E. */ +/* v2.4 19Jan03 PNT Added ASCII pseudo-op, like TEXT but not packed. */ +/* v2.5 03Nov07 RK Fixed buffer overflow problem in readLine and */ +/* increased symbol table size */ +/* v2.6 14Jul03 PNT Added missing TTY symbols, and "1st TTY" symbols. */ +/* v2.7 14Jun13 DJG David Gesswein djg@pdp8online.com */ +/* Merged other changes found online giving duplicate */ +/* Versions in the history */ +/* Didn't copy over deleting -l literal flag */ +/* All fixes to make it match OS/8 PAL8 better */ +/* Fixed handling of IFDEF type conditionals */ +/* Fixed excessive redefined symbol errors */ +/* PAL8 uses 12 bit symbols and this program label */ +/* symbols are 15 bit. */ +/* Added FILENAME and DEVNAME psuedo ops */ +/* Added OPR and KCF instructions. Fixed RMF */ +/* Allowed space after = */ +/* Prevented I and D from being deleted by EXPUNGE */ +/* Allowed permanent symbols to be redefined with error*/ +/* PAL8 updates without message. Error is just warning*/ +/* Fixed certain cases of memory reference generation */ +/* Allowed unary + */ +/* Fixed " character literal at end of line */ +/* Fixed errors in reloc handling */ +/* Fixed [CDF CIF type expressions */ +/* Made title default to first line */ +/* Fixed checksum when nopunch used */ +/* Fixed FIXTAB */ +/* Probably added more subtle bugs */ +/* v2.8 15Jun13 DJG Merged versions found on net. See above */ +/* Added * to RELOC addresses in listing */ +/* Changed default to literal/links on. Added -e to */ +/* turn off */ +/* Fixed PAGE when RELOC used */ +/* Changed SPF to TFL and SPI to TSK */ +/* Make error when changing permanent symbol to label */ +/* if -e flag is used */ +/* Allow space oring in IFZERO etc */ +/* Fixed handling of page zero overflow */ +/* v2.9 23Jun13 DJG Fixed properly all pages literal handling */ +/* changing page doesn't cause loss of last literal */ +/* location used. */ +/* Fixed bin generation if no origin set */ +/* v2.9a 01Jul13 DJG Fixed Comment. Binaries not updated */ +/* v2.10 08Feb14 DJG Changed trailer to 8 bytes since pip didn't like */ +/* trailer of one 0x80 */ +/* v2.11 19Apr15 DPI Fixed incorrect link generation with impled 0200 */ +/* starting address. Patch from Doug Ingrams */ +/* v2.12 28Apr15 DJG Fixed incorrect handling of reloc, expressions with */ +/* undefined symbols. Fixed conditional assembly with */ +/* undefined symbols. Added new flag to allow file to */ +/* not end with $ */ +/* v2.13 02May15 DPI Fixed bug in readLine when removing \r from a blank */ +/* line. Changed -s to -$ in -h display. Corrected */ +/* version comment. */ +/* v2.13 03May15 DJG Moved TITLE, BANK to new additional option. */ +/* Change release variable below when you update. Send changes back to */ +/* David Gesswein, djg@pdp8online.com. */ +/******************************************************************************/ + +#include +#include +#include +#include +#include + +char *release = "pal-2.13, 03 May 2015"; + +/* Set to 1 and use -e flag to make ( and [ literals errors */ +#define LITERAL_ERROR 0 + +#define LINELEN 132 +#define LIST_LINES_PER_PAGE 55 /* Includes 5 line page header. */ +#define NAMELEN 128 +#define SYMBOL_COLUMNS 5 +#define SYMLEN 7 +#define SYMBOL_TABLE_SIZE 4096 +#define TITLELEN 63 +#define XREF_COLUMNS 8 + +#define ADDRESS_FIELD 00177 +#define FIELD_FIELD 070000 +#define INDIRECT_BIT 00400 +#define LAST_PAGE_LOC 00177 +#define OP_CODE 07000 +#define PAGE_BIT 00200 + +#ifdef PAGE_SIZE +#undef PAGE_SIZE +#endif +#define PAGE_SIZE 00200 + +#define PAGE_FIELD 07600 +#define PAGE_ZERO_END 00200 + +/* Macro to get the number of elements in an array. */ +#define DIM(a) (sizeof(a)/sizeof(a[0])) + +/* Macro to get the address plus one of the end of an array. */ +#define BEYOND(a) ((a) + DIM(A)) + +#define is_blank(c) ((c==' ') || (c=='\t') || (c=='\f') || (c=='>')) +#define isend(c) ((c=='\0')|| (c=='\n')) +#define isdone(c) ((c=='/') || (isend(c)) || (c==';')) + +/* Macros for testing symbol attributes. Each macro evaluates to non-zero */ +/* (true) if the stated condition is met. */ +/* Use these to test attributes. The proper bits are extracted and then */ +/* tested. */ +#define M_CONDITIONAL(s) ((s & CONDITION) == CONDITION) +#define M_DEFINED(s) ((s & DEFINED) == DEFINED) +#define M_DUPLICATE(s) ((s & DUPLICATE) == DUPLICATE) +#define M_FIXED(s) ((s & FIXED) == FIXED) +#define M_LABEL(s) ((s & LABEL) == LABEL) +#define M_MRI(s) ((s & MRI) == MRI) +#define M_MRIFIX(s) ((s & MRIFIX) == MRIFIX) +#define M_PSEUDO(s) ((s & PSEUDO) == PSEUDO) +#define M_REDEFINED(s) ((s & REDEFINED) == REDEFINED) +#define M_UNDEFINED(s) (!M_DEFINED(s)) +#define M_PERM_REDEFINED(s) ((s & PERM_REDEFINED) == PERM_REDEFINED) + +/* This macro is used to test symbols by the conditional assembly pseudo-ops. */ +#define M_DEF(s) (M_DEFINED(s)) +#define M_COND(s) (M_CONDITIONAL(s)) +#define M_DEFINED_CONDITIONALLY(t) (M_DEF(t) && ((pass==1) ||!M_COND(t))) + +typedef unsigned char BOOL; +typedef unsigned char BYTE; +typedef short int WORD16; +typedef long int WORD32; + +#ifndef FALSE + #define FALSE 0 + #define TRUE (!FALSE) +#endif + +/* Line listing styles. Used to control listing of lines. */ +enum linestyle_t +{ + LINE, LINE_VAL, LINE_LOC_VAL, LOC_VAL +}; +typedef enum linestyle_t LINESTYLE_T; + +/* Symbol Types. */ +/* Note that the names that have FIX as the suffix contain the FIXED bit */ +/* included in the value. */ +/* */ +/* The CONDITION bit is used when processing the conditional assembly PSEUDO- */ +/* OPs (e.g., IFDEF). During pass 1 of the assembly, the symbol is either */ +/* defined or undefined. The condition bit is set when the symbol is defined */ +/* during pass 1 and reset on pass 2 at the location the symbol was defined */ +/* during pass 1. When processing conditionals during pass 2, if the symbol */ +/* is defined and the condition bit is set, the symbol is treated as if it */ +/* were undefined. This gives consistent behavior of the conditional */ +/* pseudo-ops during both pass 1 and pass 2. */ +enum symtyp +{ + UNDEFINED = 0000, + DEFINED = 0001, + FIXED = 0002, + MRI = 0004 | DEFINED, + LABEL = 0010 | DEFINED, + REDEFINED = 0020 | DEFINED, + DUPLICATE = 0040 | DEFINED, + PSEUDO = 0100 | FIXED | DEFINED, + CONDITION = 0200 | DEFINED, + PERM_REDEFINED = 0400, + MRIFIX = MRI | FIXED | DEFINED, + DEFFIX = DEFINED | FIXED +}; +typedef enum symtyp SYMTYP; + +enum pseudo_t +{ + BANK, BINPUNCH, DECIMAL, DUBL, EJECT, ENPUNCH, EXPUNGE, FIELD, + FIXMRI, FIXTAB, FLTG, IFDEF, IFNDEF, IFNZERO, IFZERO, NOPUNCH, + OCTAL, PAGE, PAUSE, RELOC, RIMPUNCH, SEGMNT, TEXT, TITLE, + XLIST, ZBLOCK, FILENAME, DEVICE, ASCII +}; +typedef enum pseudo_t PSEUDO_T; + +struct sym_t +{ + SYMTYP type; + char name[SYMLEN]; + WORD16 val; + int xref_index; + int xref_count; +}; +typedef struct sym_t SYM_T; + +struct lpool_t +{ + WORD16 loc; + WORD16 last_punched; + WORD16 pool[PAGE_SIZE]; +}; +typedef struct lpool_t LPOOL_T; + +struct emsg_t +{ + char *list; + char *file; +}; +typedef struct emsg_t EMSG_T; + +struct errsave_t +{ + char *mesg; + int col; +}; +typedef struct errsave_t ERRSAVE_T; + +struct fltg_ +{ + WORD16 exponent; + WORD32 mantissa; +}; +typedef struct fltg_ FLTG_T; + +/*----------------------------------------------------------------------------*/ + +/* Function Prototypes */ + +int binarySearch( char *name, int start, int symbol_count ); +int compareSymbols( const void *a, const void *b ); +void conditionFalse( void ); +void conditionTrue( void ); +SYM_T *defineLexeme( int start, int term, WORD16 val, SYMTYP type ); +SYM_T *defineSymbol( char *name, WORD16 val, SYMTYP type, WORD16 start); +void endOfBinary( void ); +void errorLexeme( EMSG_T *mesg, int col ); +void errorMessage( EMSG_T *mesg, int col ); +void errorSymbol( EMSG_T *mesg, char *name, int col ); +SYM_T *eval( void ); +WORD32 evalDubl( WORD32 initial_value ); +FLTG_T *evalFltg( void ); +SYM_T *evalSymbol( void ); +void getArgs( int argc, char *argv[] ); +WORD32 getDublExpr( void ); +WORD32 getDublExprs( void ); +FLTG_T *getFltgExpr( void ); +FLTG_T *getFltgExprs( void ); +SYM_T *getExpr( void ); +WORD16 getExprs( void ); +WORD16 incrementClc( void ); +void inputDubl( void ); +void inputFltg( void ); +WORD16 insertLiteral( LPOOL_T *pool, WORD16 value, int fieldpage_index ); +char *lexemeToName( char *name, int from, int term ); +void listLine( void ); +SYM_T *lookup( char *name ); +void moveToEndOfLine( void ); +void nextLexBlank( void ); +void nextLexeme( void ); +void normalizeFltg( FLTG_T *fltg ); +void onePass( void ); +void printCrossReference( void ); +void printErrorMessages( void ); +void printLine(char *line, WORD16 loc, WORD16 val, LINESTYLE_T linestyle); +void printPageBreak( void ); +void printPermanentSymbolTable( void ); +void printSymbolTable( void ); +BOOL pseudoOperators( PSEUDO_T val ); +void punchChecksum( void ); +void punchLocObject( WORD16 loc, WORD16 val ); +void punchLiteralPool( LPOOL_T *p, BOOL punch_page0 ); +void punchOutObject( WORD16 loc, WORD16 val ); +void punchLeader( int count ); +void punchObject( WORD16 val ); +void punchOrigin( WORD16 loc ); +void readLine( void ); +void saveError( char *mesg, int cc ); +BOOL testForLiteralCollision( WORD16 loc ); +void topOfForm( char *title, char *sub_title ); + +/*----------------------------------------------------------------------------*/ + +/* Table of pseudo-ops (directives) which are used to setup the symbol */ +/* table on startup and when the EXPUNGE pseudo-op is executed. */ +SYM_T pseudo[] = +{ + { PSEUDO, "ASCII", ASCII }, /* Put 8-bit ASCII into memory (see TEXT) */ + { PSEUDO, "BINPUN", BINPUNCH }, /* Output in Binary Loader format. */ + { PSEUDO, "DECIMA", DECIMAL }, /* Read literal constants in base 10. */ + { PSEUDO, "DEVICE", DEVICE }, /* Pack 6 bit device name into memory */ + { PSEUDO, "DUBL", DUBL }, /* Ignored (unsupported). */ + { PSEUDO, "EJECT", EJECT }, /* Eject a page in the listing. */ + { PSEUDO, "ENPUNC", ENPUNCH }, /* Turn on object code generation. */ + { PSEUDO, "EXPUNG", EXPUNGE }, /* Remove all symbols from symbol table. */ + { PSEUDO, "FIELD", FIELD }, /* Set origin to memory field. */ + { PSEUDO, "FILENA", FILENAME }, /* Pack 6 bit filename into memory. */ + { PSEUDO, "FIXMRI", FIXMRI }, /* Like =, but creates mem ref instruction*/ + { PSEUDO, "FIXTAB", FIXTAB }, /* Mark current symbols as permanent. */ + { PSEUDO, "FLTG", FLTG }, /* Ignored (unsupported). */ + { PSEUDO, "IFDEF", IFDEF }, /* Assemble if symbol is defined. */ + { PSEUDO, "IFNDEF", IFNDEF }, /* Assemble if symbol is not defined. */ + { PSEUDO, "IFNZER", IFNZERO }, /* Assemble if symbol value is not 0. */ + { PSEUDO, "IFNZRO", IFNZERO }, /* Assemble if symbol value is not 0. */ + { PSEUDO, "IFZERO", IFZERO }, /* Assemble if symbol value is 0. */ + { PSEUDO, "NOPUNC", NOPUNCH }, /* Turn off object code generation. */ + { PSEUDO, "OCTAL", OCTAL }, /* Read literal constants in base 8. */ + { PSEUDO, "PAGE", PAGE }, /* Set orign to page +1 or page n (0..37).*/ + { PSEUDO, "PAUSE", PAUSE }, /* Ignored */ + { PSEUDO, "RELOC", RELOC }, /* Assemble to run at a different address.*/ + { PSEUDO, "RIMPUN", RIMPUNCH }, /* Output in Read In Mode format. */ + { PSEUDO, "SEGMNT", SEGMNT }, /* Like page, but with page size=1K words.*/ + { PSEUDO, "TEXT", TEXT }, /* Pack 6 bit trimmed ASCII into memory. */ + { PSEUDO, "XLIST", XLIST }, /* Toggle listing generation. */ + { PSEUDO, "ZBLOCK", ZBLOCK }, /* Zero a block of memory. */ + { PSEUDO, "TITLE", TITLE }, /* Use the text string as a listing title.*/ + { PSEUDO, "BANK", BANK } /* Like field, select some 32K out of 128K*/ +}; +/* Number o extended pseudo operators to ignore unless command option specified + * to enable */ +#define NUMBER_ADDITIONAL_PSEUDO 2 + +/* Symbol Table */ +/* The table is put in lexical order on startup, so symbols can be */ +/* inserted as desired into the initial table. */ +/* really_permanent_symbols aren't removed by EXPUNGE */ +SYM_T really_permanent_symbols[] = +{ + { MRIFIX, "I", 00400 }, /* INDIRECT ADDRESSING */ + { MRIFIX, "Z", 00000 } /* PAGE ZERO ADDRESS */ +}; + +SYM_T permanent_symbols[] = +{ + /* Memory Reference Instructions */ + { MRIFIX, "AND", 00000 }, /* LOGICAL AND */ + { MRIFIX, "TAD", 01000 }, /* TWO'S COMPLEMENT ADD */ + { MRIFIX, "ISZ", 02000 }, /* INCREMENT AND SKIP IF ZERO */ + { MRIFIX, "DCA", 03000 }, /* DEPOSIT AND CLEAR ACC */ + { MRIFIX, "JMP", 05000 }, /* JUMP */ + { MRIFIX, "JMS", 04000 }, /* JUMP TO SUBROUTINE */ + /* Floating Point Interpreter Instructions */ + { MRIFIX, "FEXT", 00000 }, /* FLOATING EXIT */ + { MRIFIX, "FADD", 01000 }, /* FLOATING ADD */ + { MRIFIX, "FSUB", 02000 }, /* FLOATING SUBTRACT */ + { MRIFIX, "FMPY", 03000 }, /* FLOATING MULTIPLY */ + { MRIFIX, "FDIV", 04000 }, /* FLOATING DIVIDE */ + { MRIFIX, "FGET", 05000 }, /* FLOATING GET */ + { MRIFIX, "FPUT", 06000 }, /* FLOATING PUT */ + { FIXED, "FNOR", 07000 }, /* FLOATING NORMALIZE */ + { FIXED, "FEXT", 00000 }, /* EXIT FROM FLOATING POINT INTERPRETER */ + { FIXED, "SQUARE", 00001 }, /* SQUARE C(FAC) */ + { FIXED, "SQROOT", 00002 }, /* TAKE SQUARE ROOT OF C(FAC) */ + /* Group 1 Operate Microinstrcutions */ + { FIXED, "OPR", 07000 }, /* NO OPERATION */ + { FIXED, "NOP", 07000 }, /* NO OPERATION */ + { FIXED, "IAC", 07001 }, /* INCREMENT AC */ + { FIXED, "RAL", 07004 }, /* ROTATE AC AND LINK LEFT ONE */ + { FIXED, "RTL", 07006 }, /* ROTATE AC AND LINK LEFT TWO */ + { FIXED, "RAR", 07010 }, /* ROTATE AC AND LINK RIGHT ONE */ + { FIXED, "RTR", 07012 }, /* ROTATE AC AND LINK RIGHT TWO */ + { FIXED, "CML", 07020 }, /* COMPLEMENT LINK */ + { FIXED, "CMA", 07040 }, /* COMPLEMEMNT AC */ + { FIXED, "CLL", 07100 }, /* CLEAR LINK */ + { FIXED, "CLA", 07200 }, /* CLEAR AC */ + /* Group 2 Operate Microinstructions */ + { FIXED, "BSW", 07002 }, /* Swap bytes in AC (PDP/8e) */ + { FIXED, "HLT", 07402 }, /* HALT THE COMPUTER */ + { FIXED, "OSR", 07404 }, /* INCLUSIVE OR SR WITH AC */ + { FIXED, "SKP", 07410 }, /* SKIP UNCONDITIONALLY */ + { FIXED, "SNL", 07420 }, /* SKIP ON NON-ZERO LINK */ + { FIXED, "SZL", 07430 }, /* SKIP ON ZERO LINK */ + { FIXED, "SZA", 07440 }, /* SKIP ON ZERO AC */ + { FIXED, "SNA", 07450 }, /* SKIP ON NON=ZERO AC */ + { FIXED, "SMA", 07500 }, /* SKIP MINUS AC */ + { FIXED, "SPA", 07510 }, /* SKIP ON POSITIVE AC (ZERO IS POSITIVE) */ + /* Combined Operate Microinstructions */ + { FIXED, "CIA", 07041 }, /* COMPLEMENT AND INCREMENT AC */ + { FIXED, "STL", 07120 }, /* SET LINK TO 1 */ + { FIXED, "GLK", 07204 }, /* GET LINK (PUT LINK IN AC BIT 11) */ + { FIXED, "STA", 07240 }, /* SET AC TO -1 */ + { FIXED, "LAS", 07604 }, /* LOAD ACC WITH SR */ + /* MQ Instructions (PDP/8e) */ + { FIXED, "MQL", 07421 }, /* Load MQ from AC, then clear AC. */ + { FIXED, "MQA", 07501 }, /* Inclusive OR MQ with AC */ + { FIXED, "SWP", 07521 }, /* Swap AC and MQ */ + { FIXED, "ACL", 07701 }, /* Load MQ into AC */ + /* Program Interrupt */ + { FIXED, "IOT", 06000 }, + { FIXED, "ION", 06001 }, /* TURN INTERRUPT PROCESSOR ON */ + { FIXED, "IOF", 06002 }, /* TURN INTERRUPT PROCESSOR OFF */ + /* Program Interrupt, PDP-8/e */ + { FIXED, "SKON", 06000 }, /* Skip if interrupt on and turn int off. */ + { FIXED, "SRQ", 06003 }, /* Skip on interrupt request. */ + { FIXED, "GTF", 06004 }, /* Get interrupt flags. */ + { FIXED, "RTF", 06005 }, /* Restore interrupt flags. */ + { FIXED, "SGT", 06006 }, /* Skip on greater than flag. */ + { FIXED, "CAF", 06007 }, /* Clear all flags. */ + /* Keyboard/Reader */ + { FIXED, "KCF", 06030 }, /* CLEAR KEYBOAR FLAG */ + { FIXED, "KSF", 06031 }, /* SKIP ON KEYBOARD FLAG */ + { FIXED, "KCC", 06032 }, /* CLEAR KEYBOARD FLAG & READ CHAR */ + { FIXED, "KRS", 06034 }, /* READ KEYBOARD BUFFER (STATIC) */ + { FIXED, "KIE", 06035 }, /* AC11 TO KEYBD/RDR INT ENABLE F/F */ + { FIXED, "KRB", 06036 }, /* READ KEYBOARD BUFFER & CLEAR FLAG */ + /* Teleprinter/Punch */ + { FIXED, "TFL", 06040 }, /* SET TELEPRINTER/PUNCH FLAG */ + { FIXED, "TSF", 06041 }, /* SKIP ON TELEPRINTER FLAG */ + { FIXED, "TCF", 06042 }, /* CLEAR TELEPRINTER FLAG */ + { FIXED, "TPC", 06044 }, /* LOAD TELEPRINTER & PRINT */ + { FIXED, "TSK", 06045 }, /* SKIP IF TELETYPE INTERRUPT */ + { FIXED, "TLS", 06046 }, /* LOAD TELPRINTER & CLEAR FLAG */ + /* High Speed Paper Tape Reader */ + { FIXED, "RSF", 06011 }, /* SKIP ON READER FLAG */ + { FIXED, "RRB", 06012 }, /* READ READER BUFFER AND CLEAR FLAG */ + { FIXED, "RFC", 06014 }, /* READER FETCH CHARACTER */ + /* PC8-E High Speed Paper Tape Reader & Punch */ + { FIXED, "RPE", 06010 }, /* Set interrupt enable for reader/punch */ + { FIXED, "PCE", 06020 }, /* Clear interrupt enable for rdr/punch */ + { FIXED, "RCC", 06016 }, /* Read reader buffer, clear flags & buf, */ + /* and fetch character. */ + /* High Speed Paper Tape Punch */ + { FIXED, "PSF", 06021 }, /* SKIP ON PUNCH FLAG */ + { FIXED, "PCF", 06022 }, /* CLEAR ON PUNCH FLAG */ + { FIXED, "PPC", 06024 }, /* LOAD PUNCH BUFFER AND PUNCH CHARACTER* */ + { FIXED, "PLS", 06026 }, /* LOAD PUNCH BUFFER AND CLEAR FLAG */ + + /* DECassette TU60 (RK 20071008) */ + { FIXED, "KCLR", 06700 }, /* Clear all (clear A and B) */ + { FIXED, "KSDR", 06701 }, /* Skip if data flag set */ + { FIXED, "KSEN", 06702 }, /* Skip if EOT/BOT, not ready, or empty */ + { FIXED, "KSBF", 06703 }, /* Skip if ready flag set */ + { FIXED, "KLSA", 06704 }, /* AC4-11 -> A, clear A, -(AC4-11) -> A */ + { FIXED, "KSAF", 06705 }, /* Skip on any flag or error */ + { FIXED, "KGOA", 06706 }, /* Assert status A and transfer data to AC*/ + { FIXED, "KRSB", 06707 }, /* Transfer B -> AC4-11 */ + + /* DECtape Transport Type TU55 and DECtape Control Type TC01 */ + { FIXED, "DTRA", 06761 }, /* Contents of status register is ORed */ + /* into AC bits 0-9 */ + { FIXED, "DTCA", 06762 }, /* Clear status register A, all flags */ + /* undisturbed */ + { FIXED, "DTXA", 06764 }, /* Status register A loaded by exclusive */ + /* OR from AC. If AC bit 10=0, clear */ + /* error flags; if AC bit 11=0, DECtape */ + /* control flag is cleared. */ + { FIXED, "DTLA", 06766 }, /* Combination of DTCA and DTXA */ + { FIXED, "DTSF", 06771 }, /* Skip if error flag is 1 or if DECtape */ + /* control flag is 1 */ + { FIXED, "DTRB", 06772 }, /* Contents of status register B is */ + /* ORed into AC */ + { FIXED, "DTLB", 06774 }, /* Memory field portion of status */ + /* register B loaded from AC bits 6-8 */ + /* Disk File and Control, Type DF32 */ + { FIXED, "DCMA", 06601 }, /* CLEAR DISK MEMORY REQUEST AND */ + /* INTERRUPT FLAGS */ + { FIXED, "DMAR", 06603 }, /* LOAD DISK FROM AC, CLEAR AC READ */ + /* INTO CORE, CLEAR INTERRUPT FLAG */ + { FIXED, "DMAW", 06605 }, /* LOAD DISK FROM AC, WRITE ONTO DISK */ + /* FROM CORE, CLEAR INTERRUPT FLAG */ + { FIXED, "DCEA", 06611 }, /* CLEAR DISK EXTENDED ADDRESS AND */ + { FIXED, "DSAC", 06612 }, /* SKIP IF ADDRESS CONFIRMED FLAG = 1 */ + /* MEMORY ADDRESS EXTENSION REGISTER */ + { FIXED, "DEAL", 06615 }, /* CLEAR DISK EXTENDED ADDRESS AND */ + /* MEMORY ADDRESS EXTENSION REGISTER */ + /* AND LOAD SAME FROM AC */ + { FIXED, "DEAC", 06616 }, /* CLEAR AC, LOAD AC FROM DISK EXTENDED */ + /* ADDRESS REGISTER, SKIP IF ADDRESS */ + /* CONFIRMED FLAG = 1 */ + { FIXED, "DFSE", 06621 }, /* SKIP IF PARITY ERROR, DATA REQUEST */ + /* LATE, OR WRITE LOCK SWITCH FLAG = 0 */ + /* (NO ERROR) */ + { FIXED, "DFSC", 06622 }, /* SKIP IF COMPLETION FLAG = 1 (DATA */ + /* TRANSFER COMPLETE) */ + { FIXED, "DMAC", 06626 }, /* CLEAR AC, LOAD AC FROM DISK MEMORY */ + /* ADDRESS REGISTER */ + /* Disk File and Control, Type RF08 */ + { FIXED, "DCIM", 06611 }, + { FIXED, "DIML", 06615 }, + { FIXED, "DIMA", 06616 }, + { FIXED, "DISK", 06623 }, + { FIXED, "DCXA", 06641 }, + { FIXED, "DXAL", 06643 }, + { FIXED, "DXAC", 06645 }, + { FIXED, "DMMT", 06646 }, + /* Memory Extension Control, Type 183 */ + { FIXED, "CDF", 06201 }, /* CHANGE DATA FIELD */ + { FIXED, "CIF", 06202 }, /* CHANGE INSTRUCTION FIELD */ + { FIXED, "CDI", 06203 }, /* Change data & instrution field. */ + { FIXED, "RDF", 06214 }, /* READ DATA FIELD */ + { FIXED, "RIF", 06224 }, /* READ INSTRUCTION FIELD */ + { FIXED, "RIB", 06234 }, /* READ INTERRUPT BUFFER */ + { FIXED, "RMF", 06244 }, /* RESTORE MEMORY FIELD */ + /* Memory Parity, Type MP8/I (MP8/L) */ + { FIXED, "SMP", 06101 }, /* SKIP IF MEMORY PARITY FLAG = 0 */ + { FIXED, "CMP", 06104 }, /* CLEAR MEMORY PAIRTY FLAG */ + /* Memory Parity, Type MP8-E (PDP8/e) */ + { FIXED, "DPI", 06100 }, /* Disable parity interrupt. */ + { FIXED, "SNP", 06101 }, /* Skip if no parity error. */ + { FIXED, "EPI", 06103 }, /* Enable parity interrupt. */ + { FIXED, "CNP", 06104 }, /* Clear parity error flag. */ + { FIXED, "CEP", 06106 }, /* Check for even parity. */ + { FIXED, "SPO", 06107 }, /* Skip on parity option. */ + /* Data Communications Systems, Type 680I */ + { FIXED, "TTINCR", 06401 }, /* The content of the line select */ + /* register is incremented by one. */ + { FIXED, "TTI", 06402 }, /* The line status word is read and */ + /* sampled. If the line is active for */ + /* the fourth time, the line bit is */ + /* shifted into the character assembly */ + /* word. If the line bit is active for */ + /* a number of times less than four, */ + /* the count is incremented. If the */ + /* line is not active, the active/inac- */ + /* tive status of the line is recorded */ + { FIXED, "TTO", 06404 }, /* The character in the AC is shifted */ + /* right one position, zeros are shifted */ + /* into vacated positions, and the orig- */ + /* inal content of AC11 is transferred */ + /* out of the computer on the TTY line. */ + { FIXED, "TTCL", 06411 }, /* The line select register is cleared. */ + { FIXED, "TTSL", 06412 }, /* The line select register is loaded by */ + /* an OR transfer from the content of */ + /* of AC5-11, the the AC is cleared. */ + { FIXED, "TTRL", 06414 }, /* The content of the line select regis- */ + /* ter is read into AC5-11 by an OR */ + /* transfer. */ + { FIXED, "TTSKP", 06421 }, /* Skip if clock flag is a 1. */ + { FIXED, "TTXON", 06424 }, /* Clock 1 is enabled to request a prog- */ + /* ram interrupt and clock 1 flag is */ + /* cleared. */ + { FIXED, "TTXOF", 06422 }, /* Clock 1 is disabled from causing a */ + /* program interrupt and clock 1 flag */ + /* is cleared. */ +}; /* End-of-Symbols for Permanent Symbol Table */ + +/* Global variables */ +SYM_T *symtab; /* Symbol Table */ +int symbol_top; /* Number of entries in symbol table. */ + +SYM_T *fixed_symbols; /* Start of the fixed symbol table entries. */ +int number_of_fixed_symbols; + +/*----------------------------------------------------------------------------*/ + +WORD16 *xreftab; /* Start of the concordance table. */ + +ERRSAVE_T error_list[20]; +int save_error_count; + +#define GET_PAGE_INDEX(x) (((x) & 07600) >> 7) +#define MAX_PAGES 32 +LPOOL_T cp[MAX_PAGES]; /* Storage for page constants. */ +int max_page_used[MAX_PAGES]; + +char s_detected[] = "detected"; +char s_error[] = "error"; +char s_errors[] = "errors"; +char s_no[] = "No"; +char s_page[] = "Page"; +char s_symtable[] = "Symbol Table"; +char s_xref[] = "Cross Reference"; +char s_generated[] = "generated"; +char s_link[] = "link"; +char s_links[] = "links"; + +/* Assembler diagnostic messages. */ +/* Some attempt has been made to keep continuity with the PAL-III and */ +/* MACRO-8 diagnostic messages. If a diagnostic indicator, (e.g., IC) */ +/* exists, then the indicator is put in the listing as the first two */ +/* characters of the diagnostic message. The PAL-III indicators where used */ +/* when there was a choice between using MACRO-8 and PAL-III indicators. */ +/* The character pairs and their meanings are: */ +/* DT Duplicate Tag (symbol) */ +/* IC Illegal Character */ +/* ID Illegal Redefinition of a symbol. An attempt was made to give */ +/* a symbol a new value not via =. */ +/* IE Illegal Equals An equal sign was used in the wrong context, */ +/* (e.g., A+B=C, or TAD A+=B) */ +/* II Illegal Indirect An off page reference was made, but a literal */ +/* could not be generated because the indirect bit was already set. */ +/* IR Illegal Reference (address is not on current page or page zero) */ +/* ND No $ (the program terminator) at end of file. */ +/* PE Current, Non-Zero Page Exceeded (literal table flowed into code) */ +/* RD ReDefintion of a symbol */ +/* ST Symbol Table full */ +/* UA Undefined Address (undefined symbol) */ +/* ZE Zero Page Exceeded (see above, or out of space) */ +EMSG_T duplicate_label = { "DT duplicate", "duplicate label" }; +EMSG_T illegal_blank = { "IC illegal blank", "illegal blank" }; +EMSG_T illegal_character = { "IC illegal char", "illegal character" }; +EMSG_T illegal_expression = { "IC in expression", "illegal expression" }; +EMSG_T label_syntax = { "IC label syntax", "label syntax" }; +EMSG_T not_a_number = { "IC numeric syntax", "numeric syntax of" }; +EMSG_T number_not_radix = { "IC radix", "number not in current radix"}; +EMSG_T symbol_syntax = { "IC symbol syntax", "symbol syntax" }; +EMSG_T illegal_equals = { "IE illegal =", "illegal equals" }; +EMSG_T illegal_indirect = { "II off page", "illegal indirect" }; +EMSG_T illegal_reference = { "IR off page", "illegal reference" }; +EMSG_T undefined_symbol = { "UD undefined", "undefined symbol" }; +EMSG_T redefined_symbol = { "RD redefined", "redefined symbol" }; +EMSG_T illegal_redefine = { "ID redefined", "Illegal redefine of symbol" }; +EMSG_T literal_overflow = { "PE page exceeded", + "current page literal capacity exceeded" }; +EMSG_T pz_literal_overflow = { "ZE page exceeded", + "page zero capacity exceeded" }; +EMSG_T dubl_overflow = { "dubl overflow", "DUBL value overflow" }; +EMSG_T fltg_overflow = { "fltg overflow", "FLTG value overflow" }; +EMSG_T zblock_too_small = { "expr too small", "ZBLOCK value too small" }; +EMSG_T zblock_too_large = { "expr too large", "ZBLOCK value too large" }; +EMSG_T end_of_file = { "ND no $ at EOF", "No $ at End-of-File" }; +EMSG_T no_pseudo_op = { "not implemented", + "not implemented pseudo-op" }; +EMSG_T illegal_field_value = { "expr out of range", + "field value not in range of 0 through 7" }; +EMSG_T literal_gen_off = { "literals off", + "literal generation is off" }; +EMSG_T no_literal_value = { "no value", "no literal value" }; +EMSG_T text_string = { "no delimiter", + "text string delimiters not matched" }; +EMSG_T in_rim_mode = { "not OK in rim mode" + "FIELD pseudo-op not valid in RIM mode" }; +EMSG_T lt_expected = { "'<' expected", "'<' expected" }; +EMSG_T symbol_table_full = { "ST Symbol Tbl Full", + "Symbol Table Full" }; +/*----------------------------------------------------------------------------*/ + +FILE *errorfile; +FILE *infile; +FILE *listfile; +FILE *listsave; +FILE *objectfile; +FILE *objectsave; + +char errorpathname[NAMELEN]; +char filename[NAMELEN]; +char listpathname[NAMELEN]; +char objectpathname[NAMELEN]; +char *pathname; +char permpathname[NAMELEN]; + +int tabstops; /* number of characters to expand a tab to */ +int list_lineno; +int list_pageno; +char list_title[LINELEN]; +BOOL list_title_set; /* Set if TITLE pseudo-op used. */ +char line[LINELEN]; /* Input line. */ +int lineno; /* Current line number. */ +int page_lineno; /* print line number on current page. */ +BOOL listed; /* Listed flag. */ +BOOL listedsave; + +int cc; /* Column Counter (char position in line). */ +WORD16 checksum; /* Generated checksum */ +BOOL binary_data_output; /* Set true when data has been output. */ +WORD16 clc; /* Location counter */ +WORD16 cplc; /* Current page literal counter. */ +char delimiter; /* Character immediately after eval'd term. */ +int errors; /* Number of errors found so far. */ +int links; /* Number of links generated so far. */ +BOOL error_in_line; /* TRUE if error on current line. */ +int errors_pass_1; /* Number of errors on pass 1. */ +WORD16 field; /* Current field */ +WORD16 fieldlc; /* location counter without field portion. */ +BOOL fltg_input; /* TRUE when doing floating point input. */ +BOOL indirect_generated; /* TRUE if an off page address generated. */ +int last_xref_lexstart; /* Column where last xref symbol was located. */ +int last_xref_lineno; /* Line where last xref symbol was located. */ +int lexstartprev; /* Where previous lexeme started. */ +int lextermprev; /* Where previous lexeme ended. */ +int lexstart; /* Index of current lexeme on line. */ +int lexterm; /* Index of character after current lexeme. */ +BOOL literals_ok; /* Generate literals, ignore ID redefine err */ +BOOL perm_redef_error; /* Make redefining perm sym with labels error */ +int maxcc; /* Current line length. */ +BOOL overflow; /* Overflow flag for math routines. */ +int pass; /* Number of current pass. */ +BOOL print_permanent_symbols; +WORD16 pzlc; /* Page Zero literal counter. */ +WORD16 radix; /* Default number radix. */ +WORD16 reloc; /* The relocation distance. */ +BOOL rim_mode; /* Generate rim format, defaults to bin */ +BOOL dollar_not_required; /* $ not required at end of file */ +BOOL additional_enabled; /* True if extended functions over PAL8 */ + /* enabled */ +BOOL symtab_print; /* Print symbol table flag */ +BOOL xref; + +FLTG_T fltg_ac; /* Value holder for evalFltg() */ +SYM_T sym_eval = { DEFINED, "", 0 }; /* Value holder for eval() */ +SYM_T sym_getexpr = { DEFINED, "", 0 }; /* Value holder for getexpr() */ +SYM_T sym_undefined = { UNDEFINED, "", 0 };/* Symbol Table Terminator */ + + +/******************************************************************************/ +/* */ +/* Function: main */ +/* */ +/* Synopsis: Starting point. Controls order of assembly. */ +/* */ +/******************************************************************************/ +int main( int argc, char *argv[] ) +{ + int ix; + int space; + + /* Set the default values for global symbols. */ + binary_data_output = FALSE; + fltg_input = FALSE; + literals_ok = TRUE; + perm_redef_error = FALSE; + print_permanent_symbols = FALSE; + rim_mode = FALSE; + dollar_not_required = FALSE; + additional_enabled = FALSE; + symtab_print = FALSE; + xref = FALSE; + pathname = NULL; + + /* Get the options and pathnames */ + getArgs( argc, argv ); + + /* Setup the error file in case symbol table overflows while installing the */ + /* permanent symbols. */ + errorfile = fopen( errorpathname, "w" ); + if (errorfile == NULL) { + fprintf( stderr, "Could not open error file %s: %s\n", errorpathname, strerror(errno)); + exit( -1 ); + + } + errors = 0; + save_error_count = 0; + pass = 0; /* This is required for symbol table initialization. */ + symtab = (SYM_T *) malloc( sizeof( SYM_T ) * SYMBOL_TABLE_SIZE ); + + if( symtab == NULL ) + { + fprintf( stderr, "Could not allocate memory for symbol table.\n"); + exit( -1 ); + } + + /* Place end marker in symbol table. */ + symtab[0] = sym_undefined; + symbol_top = 0; + number_of_fixed_symbols = symbol_top; + fixed_symbols = &symtab[symbol_top - 1]; + + /* Enter the pseudo-ops into the symbol table */ + for( ix = 0; ix < DIM( pseudo ) - + (additional_enabled ? 0 : NUMBER_ADDITIONAL_PSEUDO) ; ix++ ) + { + defineSymbol( pseudo[ix].name, pseudo[ix].val, pseudo[ix].type, 0 ); + } + + /* Enter the predefined symbols into the table. */ + /* Also make them part of the permanent symbol table. */ + for( ix = 0; ix < DIM( really_permanent_symbols ); ix++ ) + { + defineSymbol( really_permanent_symbols[ix].name, + really_permanent_symbols[ix].val, + really_permanent_symbols[ix].type | DEFFIX , 0 ); + } + + /* Enter the predefined symbols into the table. */ + /* Also make them part of the permanent symbol table. */ + for( ix = 0; ix < DIM( permanent_symbols ); ix++ ) + { + defineSymbol( permanent_symbols[ix].name, + permanent_symbols[ix].val, + permanent_symbols[ix].type | DEFFIX , 0 ); + } + + number_of_fixed_symbols = symbol_top; + fixed_symbols = &symtab[symbol_top - 1]; + + /* Do pass one of the assembly */ + checksum = 0; + pass = 1; + page_lineno = LIST_LINES_PER_PAGE; + onePass(); + errors_pass_1 = errors; + + /* Set up for pass two */ + rewind( infile ); + /*Opened in main errorfile = fopen( errorpathname, "w" );*/ + objectfile = fopen( objectpathname, "wb" ); + if (objectfile == NULL) { + fprintf( stderr, "Could not open object file %s: %s\n", objectpathname, strerror(errno)); + exit( -1 ); + + } + objectsave = objectfile; + + listfile = fopen( listpathname, "w" ); + if (listfile == NULL) { + fprintf( stderr, "Could not open list file %s: %s\n", listpathname, strerror(errno)); + exit( -1 ); + + } + listsave = NULL; + + punchLeader( 0 ); + checksum = 0; + + /* Do pass two of the assembly */ + errors = 0; + save_error_count = 0; + page_lineno = LIST_LINES_PER_PAGE; + + if( xref ) + { + /* Get the amount of space that will be required for the concordance. */ + for( space = 0, ix = 0; ix < symbol_top; ix++ ) + { + symtab[ix].xref_index = space; /* Index into concordance table. */ + space += symtab[ix].xref_count + 1; + symtab[ix].xref_count = 0; /* Clear the count for pass 2. */ + + } + /* Allocate the necessary space. */ + xreftab = (WORD16 *) malloc( sizeof( WORD16 ) * space ); + + /* Clear the cross reference space. */ + for( ix = 0; ix < space; ix++ ) + { + xreftab[ix] = 0; + } + } + pass = 2; + onePass(); + + /* Undo effects of NOPUNCH for any following checksum */ + objectfile = objectsave; + punchChecksum(); + + /* Works great for trailer. */ + punchLeader( 8 ); + + /* undo effects of XLIST for any following output to listing file. */ + if( listfile == NULL ) + { + listfile = listsave; + } + + /* Display value of error counter. */ + if( errors == 0 ) + { + fprintf( listfile, "\n %s %s %s\n", s_no, s_detected, s_errors ); + } + else + { + fprintf( errorfile, "\n %d %s %s\n", errors, s_detected, + ( errors == 1 ? s_error : s_errors )); + fprintf( listfile, "\n %d %s %s\n", errors, s_detected, + ( errors == 1 ? s_error : s_errors )); + fprintf( stderr, " %d %s %s\n", errors, s_detected, + ( errors == 1 ? s_error : s_errors )); + } + /* Display value of link counter. */ + if( links == 0 ) + { + fprintf( listfile, " %s %s %s\n", s_no, s_links, s_generated ); + } + else + { + fprintf( errorfile, " %d %s %s\n", links, + ( links == 1 ? s_link : s_links ), + s_generated); + fprintf( listfile, " %d %s %s\n", links, + ( links == 1 ? s_link : s_links ), + s_generated); + fprintf( stderr, " %d %s %s\n", links, + ( links == 1 ? s_link : s_links ), + s_generated); + } + + if( symtab_print ) + { + printSymbolTable(); + } + + if( print_permanent_symbols ) + { + printPermanentSymbolTable(); + } + + if( xref ) + { + printCrossReference(); + } + + fclose( objectfile ); + fclose( listfile ); + fclose( errorfile ); + if( errors == 0 && errors_pass_1 == 0 ) + { + remove( errorpathname ); + } + + return( errors != 0 ); +} /* main() */ + +/******************************************************************************/ +/* */ +/* Function: getArgs */ +/* */ +/* Synopsis: Parse command line, set flags accordingly and setup input and */ +/* output files. */ +/* */ +/******************************************************************************/ +void getArgs( int argc, char *argv[] ) +{ + int len; + int ix, jx; + + /* Set the defaults */ + errorfile = NULL; + infile = NULL; + listfile = NULL; + listsave = NULL; + objectfile = NULL; + objectsave = NULL; + tabstops = 8; + + for( ix = 1; ix < argc; ix++ ) + { + if( argv[ix][0] == '-' ) + { + for( jx = 1; argv[ix][jx] != 0; jx++ ) + { + switch( argv[ix][jx] ) + { + case '$': + dollar_not_required = TRUE; + break; + + case 'd': + symtab_print = TRUE; + break; + + case 'a': + additional_enabled = TRUE; + break; + + case 'r': + rim_mode = TRUE; + break; + + case 'e': + literals_ok = FALSE; + break; + + case 'l': + literals_ok = TRUE; + break; + + case 'n': + perm_redef_error = TRUE; + break; + + case 'p': + print_permanent_symbols = TRUE; + break; + + /* Added -tN; RK 20071029 */ + /* Damn, this is ugly, we should use getopt() */ + case 't': + if (argv [ix][jx + 1]) { + tabstops = atoi (argv [ix] + (jx + 1)); + /* advance past numbers */ + for (jx++; argv [ix][jx]; jx++) ; + jx--; + } else { + ix++; + if (ix >= argc) { + fprintf( stderr, "%s: missing argument for -t, expected number of tabsopts\n", argv[0] ); + exit( -1 ); + } + for (jx = 0; argv [ix][jx]; jx++) ; + jx--; + tabstops = atoi (argv [ix]); + } + break; + + case 'x': + xref = TRUE; + break; + + case 'v': + fprintf( stderr, "%s\n", release ); + fflush( stderr ); + exit( -1 ); + break; + + default: + fprintf( stderr, "%s: unknown flag: %s\n", argv[0], argv[ix] ); + case 'h': + fprintf( stderr, " -$ -- allow file to not end with $\n" ); + fprintf( stderr, " -a -- enable additional function not in PAL8\n" ); + fprintf( stderr, " -d -- dump symbol table\n" ); + fprintf( stderr, " -e -- error if link generated\n" ); + fprintf( stderr, " -h -- show this help\n" ); + fprintf( stderr, " -l -- generate literal/link (default)\n" ); + fprintf( stderr, " -n -- no redefining with label permanent symbols\n" ); + fprintf( stderr, " -p -- output permanent symbols to file\n" ); + fprintf( stderr, " -r -- output rim format file\n" ); + fprintf( stderr, " -t N -- set tab stops to N\n" ); + fprintf( stderr, " -v -- display version\n" ); + fprintf( stderr, " -x -- output cross reference to file\n" ); + fflush( stderr ); + exit( -1 ); + } /* end switch */ + } /* end for */ + } + else + { + if( pathname != NULL ) + { + fprintf( stderr, "%s: too many input files\n", argv[0] ); + exit( -1 ); + } + pathname = &argv[ix][0]; + } + } /* end for */ + + if( pathname == NULL ) + { + fprintf( stderr, "%s: no input file specified\n", argv[0] ); + exit( -1 ); + } + + len = strlen( pathname ); + if( len > NAMELEN - 5 ) + { + fprintf( stderr, "%s: pathname \"%s\" too long\n", argv[0], pathname ); + exit( -1 ); + } + + /* Now open the input file. */ + if(( infile = fopen( pathname, "r" )) == NULL ) + { + fprintf( stderr, "%s: cannot open \"%s\": %s\n", argv[0], pathname, strerror(errno) ); + exit( -1 ); + } + + /* Now make the pathnames */ + /* Find last '.', if it exists. */ + jx = len - 1; + while( pathname[jx] != '.' && pathname[jx] != '/' + && pathname[jx] != '\\' && jx >= 0 ) + { + jx--; + } + + switch( pathname[jx] ) + { + case '.': + break; + + case '/': + case '\\': + jx = len; + break; + + default: + break; + } + + /* Add the pathname extensions. */ + strncpy( objectpathname, pathname, jx ); + objectpathname[jx] = '\0'; + strcat( objectpathname, rim_mode ? ".rim" : ".bin" ); + + strncpy( listpathname, pathname, jx ); + listpathname[jx] = '\0'; + strcat( listpathname, ".lst" ); + + strncpy( errorpathname, pathname, jx ); + errorpathname[jx] = '\0'; + strcat( errorpathname, ".err" ); + + strncpy( permpathname, pathname, jx ); + permpathname[jx] = '\0'; + strcat( permpathname, ".prm" ); + + /* Extract the filename from the path. */ + if( isalpha( pathname[0] ) && pathname[1] == ':' && pathname[2] != '\\' ) + { + pathname[1] = '\\'; /* MS-DOS style pathname */ + } + + jx = len - 1; + while( pathname[jx] != '/' && pathname[jx] != '\\' && jx >= 0 ) + { + jx--; + } + strcpy( filename, &pathname[jx + 1] ); + +} /* getArgs() */ + +/******************************************************************************/ +/* */ +/* Function: clearLiteralTable */ +/* */ +/* Synopsis: Clear the cp and max_page_used data storing literal */ +/* information. */ +/* */ +/******************************************************************************/ +void clearLiteralTable() +{ + int i; + + for (i = 0; i < DIM(cp); i++) + { + cp[i].loc = 0200; /* Points to end of page for [] operands. */ + cp[i].last_punched = 0200; /* Points to end of page for [] operands. */ + } + memset(max_page_used, 0, sizeof(max_page_used)); +} + +/******************************************************************************/ +/* */ +/* Function: onePass */ +/* */ +/* Synopsis: Do one assembly pass. */ +/* */ +/******************************************************************************/ +void onePass() +{ + char name[SYMLEN]; + WORD16 newclc; + BOOL scanning_line; + int start; + SYM_T *sym; + int term; + WORD16 val; + + clc = 0200; /* Default starting address is 200 octal. */ + field = 0; + fieldlc = clc & 07777; + reloc = 0; + clearLiteralTable(); + listed = TRUE; + lineno = 0; + list_pageno = 0; + list_lineno = 0; + last_xref_lexstart = 0; + last_xref_lineno = 0; + list_title_set = FALSE; + radix = 8; /* Initial radix is octal (base 8). */ + + if( !rim_mode ) + { + /* Put out initial origin if not in rim mode. */ + punchOrigin( clc ); + } + + while( TRUE ) + { + readLine(); + nextLexeme(); + + scanning_line = TRUE; + while( scanning_line ) + { + if( isend( line[lexstart] )) + { + scanning_line = FALSE; + } + else + { + switch( line[lexstart] ) + { + case '/': + scanning_line = FALSE; + break; + + case ';': + nextLexeme(); + break; + + case '$': + endOfBinary(); + return; + + case '*': + nextLexeme(); /* Skip '*', (set origin symbol) */ + newclc = ((getExpr())->val & 07777 ) | field; + /* Do not change Current Location Counter if an error occurred. */ + if( !error_in_line ) + { + if(( newclc & 07600 ) != ( clc & 07600 ) ) + { + /* Current page has changed. */ + punchLiteralPool( cp, 0 ); + } + clc = newclc - reloc; + fieldlc = clc & 07777; + + if( !rim_mode ) + { + /* Not rim mode, put out origin. */ + punchOrigin( clc ); + } + printLine( line, 0, fieldlc, LINE_VAL ); + } + break; + + default: + switch( line[lexterm] ) + { + case ',': + if( isalpha( line[lexstart] )) + { + /* Use lookup so symbol will not be counted as reference. */ + sym = lookup( lexemeToName( name, lexstart, lexterm )); + if( M_DEFINED( sym->type )) + { + if( (sym->val & 07777) != ( ( clc+reloc ) & 07777) && pass == 2 ) + { + errorSymbol( &duplicate_label, sym->name, lexstart ); + } + sym->type = sym->type | DUPLICATE; + } + /* Must call define on pass 2 to generate concordance. */ + defineLexeme( lexstart, lexterm, ( clc + reloc ), LABEL ); + } + else + { + errorLexeme( &label_syntax, lexstart ); + } + nextLexeme(); /* skip label */ + nextLexeme(); /* skip comma */ + break; + + case '=': + if( isalpha( line[lexstart] )) + { + start = lexstart; + term = lexterm; + delimiter = line[lexterm]; + nextLexBlank(); /* skip symbol */ + nextLexeme(); /* skip trailing =, allow blank */ + delimiter = line[lexterm]; + val = getExprs(); + defineLexeme( start, term, val, DEFINED ); + printLine( line, 0, val, LINE_VAL ); + } + else + { + errorLexeme( &symbol_syntax, lexstartprev ); + nextLexeme(); /* skip symbol */ + nextLexeme(); /* skip trailing = */ + getExprs(); /* skip expression */ + } + break; + + default: + if( isalpha( line[lexstart] )) + { + sym = evalSymbol(); + val = sym->val; + if( M_PSEUDO( sym->type )) + { + nextLexeme(); /* Skip symbol */ + scanning_line = pseudoOperators( (PSEUDO_T)val & 07777 ); + } + else + { + /* Identifier is not a pseudo-op, interpret as load value */ + punchOutObject( clc, getExprs() & 07777 ); + incrementClc(); + } + } + else + { + /* Identifier is a value, interpret as load value */ + punchOutObject( clc, getExprs() & 07777 ); + incrementClc(); + } + break; + } /* end switch */ + break; + } /* end switch */ + } /* end if */ + } /* end while( scanning_line ) */ + } /* end while( TRUE ) */ +} /* onePass() */ + + +/******************************************************************************/ +/* */ +/* Function: fixMRIInstruction */ +/* */ +/* Synopsis: Now that we have the final value figure out if page 0, current */ +/* page, or indirect needed and max final instruction */ +/* */ +/******************************************************************************/ +WORD16 fixMRIInstruction(WORD16 instruction, WORD16 value) +{ + /* Now have the address part of the MRI instruction. */ + if( value < 00200 ) + { + instruction |= value; /* Page zero MRI. */ + } + else if( (( fieldlc + reloc ) & 07600 ) <= value + && value <= ((( fieldlc + reloc ) & 07600) | 0177 )) + { + instruction |= ( PAGE_BIT | (value & ADDRESS_FIELD )); /* Current page MRI */ + } + else + { + if(( instruction & INDIRECT_BIT ) == INDIRECT_BIT ) + { + /* Already indirect, can't generate */ + errorSymbol( &illegal_indirect, NULL, lexstartprev ); + } + else + { + if( literals_ok ) + { + /* Now fix off page reference. */ + /* Search current page literal pool for needed instruction. */ + /* Set Indirect Current Page */ + instruction |= ( 00600 | insertLiteral( cp, value, GET_PAGE_INDEX(clc) )); + indirect_generated = TRUE; + if (pass == 2) + { + links++; + } + } + else + { + errorSymbol( &illegal_reference, NULL, lexstartprev ); + instruction |= ( value & 0177 ); + } + } + } + return instruction; +} +/******************************************************************************/ +/* */ +/* Function: getExprs */ +/* */ +/* Synopsis: Or together a list of blank separated expressions, from the */ +/* current lexeme onward. Leave the current lexeme as */ +/* the last one in the list. */ +/* */ +/******************************************************************************/ +WORD16 getExprs() +{ + SYM_T *symv; + SYM_T *symt; + WORD16 temp; + SYMTYP temp_type; + WORD16 value; + SYMTYP value_type; + BOOL MRI_held = FALSE; + WORD16 held_value = 0; + + symv = getExpr(); + value = symv->val; + value_type = symv->type; + + while( TRUE ) + { + if( isdone( line[lexstart] )) + { + if (MRI_held) + { + value = fixMRIInstruction(value, held_value); + } + return( value ); + } + switch( line[lexstart] ) + { + case ')': + case ']': + case '<': + if (MRI_held) + { + value = fixMRIInstruction(value, held_value); + } + return( value ); + + default: + break; + } + + /* Interpret space as logical or */ + symt = getExpr(); + temp = symt->val & 07777; + temp_type = symt->type; + + switch( value_type & (MRI | MRIFIX)) + { + case MRI: + case MRIFIX: + /* Previous symbol was a Memory Reference Instruction. */ + switch( temp_type & (MRI | MRIFIX) ) + { + case MRI: + case MRIFIX: + /* If we have held value don't or in more MRI's to instuction, they */ + /* are now instuction value */ + if (MRI_held) + { + held_value |= temp; + } + else + { + /* Current symbol is also a Memory Reference Instruction. */ + value |= temp; /* Just OR the MRI instructions. */ + } + break; + + default: + held_value |= temp; + MRI_held = TRUE; + break; + } + break; + + default: + if (value_type == UNDEFINED || temp_type == UNDEFINED) { + value = 0; + } else { + value |= temp; /* Normal 12 bit value. */ + } + break; + } + } /* end while */ +} /* getExprs() */ + + +/******************************************************************************/ +/* */ +/* Function: getExpr */ +/* */ +/* Synopsis: Get an expression, from the current lexeme onward, leave the */ +/* current lexeme as the one after the expression. Expressions */ +/* contain terminal symbols (identifiers) separated by operators. */ +/* */ +/******************************************************************************/ +SYM_T *getExpr() +{ + SYM_T *sym; + delimiter = line[lexterm]; + + + if( line[lexstart] == '-' ) + { + nextLexBlank(); + sym_getexpr = *(eval()); + sym_getexpr.val = ( - sym_getexpr.val ) & 07777; + } + else + { + if( line[lexstart] == '+' ) + { + nextLexBlank(); + } + sym_getexpr = *(eval()); + sym_getexpr.val = sym_getexpr.val & 07777; + } + + if( is_blank( delimiter )) + { + return( &sym_getexpr ); + } + + /* Here we assume the current lexeme is the operator separating the */ + /* previous operator from the next, if any. */ + while( TRUE ) + { + /* assert line[lexstart] == delimiter */ + if( is_blank( delimiter )) + { + return( &sym_getexpr ); + } + + switch( line[lexstart] ) + { + case '+': /* add */ + nextLexBlank(); /* skip over the operator */ + sym = eval(); + sym_getexpr.val += sym->val; + if (sym_getexpr.type == UNDEFINED || sym->type == UNDEFINED) { + sym_getexpr.val = 0; + sym_getexpr.type = UNDEFINED; + } + break; + + case '-': /* subtract */ + nextLexBlank(); /* skip over the operator */ + sym = eval(); + sym_getexpr.val -= sym->val; + if (sym_getexpr.type == UNDEFINED || sym->type == UNDEFINED) { + sym_getexpr.val = 0; + sym_getexpr.type = UNDEFINED; + } + break; + + case '^': /* multiply */ + nextLexBlank(); /* skip over the operator */ + sym = eval(); + sym_getexpr.val *= sym->val; + if (sym_getexpr.type == UNDEFINED || sym->type == UNDEFINED) { + sym_getexpr.val = 0; + sym_getexpr.type = UNDEFINED; + } + break; + + case '%': /* divide */ + nextLexBlank(); /* skip over the operator */ + sym = eval(); + sym_getexpr.val /= sym->val; + if (sym_getexpr.type == UNDEFINED || sym->type == UNDEFINED) { + sym_getexpr.val = 0; + sym_getexpr.type = UNDEFINED; + } + break; + + case '&': /* and */ + nextLexBlank(); /* skip over the operator */ + sym = eval(); + sym_getexpr.val &= sym->val; + if (sym_getexpr.type == UNDEFINED || sym->type == UNDEFINED) { + sym_getexpr.val = 0; + sym_getexpr.type = UNDEFINED; + } + break; + + case '!': /* or */ + nextLexBlank(); /* skip over the operator */ + sym = eval(); + sym_getexpr.val |= sym->val; + if (sym_getexpr.type == UNDEFINED || sym->type == UNDEFINED) { + sym_getexpr.val = 0; + sym_getexpr.type = UNDEFINED; + } + break; + + default: + if( isend( line[lexstart] )) + { + return( &sym_getexpr ); + } + + switch( line[lexstart] ) + { + case '/': + case ';': + case ')': + case ']': + case '<': + break; + + case '=': + errorMessage( &illegal_equals, lexstart ); + moveToEndOfLine(); + sym_getexpr.val = 0; + break; + + default: + errorMessage( &illegal_expression, lexstart ); + moveToEndOfLine(); + sym_getexpr.val = 0; + break; + } + return( &sym_getexpr ); + } + } /* end while */ +} /* getExpr() */ + + +/******************************************************************************/ +/* */ +/* Function: eval */ +/* */ +/* Synopsis: Get the value of the current lexeme, set delimiter and advance.*/ +/* */ +/******************************************************************************/ +SYM_T *eval() +{ + WORD16 digit; + int from; + WORD16 loc; + SYM_T *sym; + WORD16 val; + + val = 0; + + delimiter = line[lexterm]; + if( isalpha( line[lexstart] )) + { + sym = evalSymbol(); + if( M_UNDEFINED( sym->type ) && pass == 2 ) + { + errorSymbol( &undefined_symbol, sym->name, lexstart ); + nextLexeme(); + return( sym ); + } + else + { + nextLexeme(); + return( sym ); + } + } + else if( isdigit( line[lexstart] )) + { + from = lexstart; + val = 0; + while( from < lexterm ) + { + if( isdigit( line[from] )) + { + digit = (WORD16) line[from++] - (WORD16) '0'; + if( digit < radix ) + { + val = val * radix + digit; + } + else + { + errorLexeme( &number_not_radix, from - 1 ); + val = 0; + from = lexterm; + } + } + else + { + errorLexeme( ¬_a_number, lexstart ); + val = 0; + from = lexterm; + } + } + nextLexeme(); + sym_eval.val = val; + return( &sym_eval ); + } + else + { + switch( line[lexstart] ) + { + case '"': /* Character literal */ + if( cc + 1 <= maxcc ) + { + val = line[lexstart + 1] | 0200; + delimiter = line[lexstart + 2]; + cc = lexstart + 2; + } + else + { + errorMessage( &no_literal_value, lexstart ); + } + nextLexeme(); + break; + + case '.': /* Value of Current Location Counter */ + val = (clc & 07777) + reloc; + nextLexeme(); + break; + + case '[': /* Generate literal on page zero. */ + if( !literals_ok && LITERAL_ERROR) + { + errorMessage( &literal_gen_off, lexstart ); + } + nextLexBlank(); /* Skip bracket */ + val = getExprs() & 07777; + + if( line[lexstart] == ']' ) + { + nextLexBlank(); /* Skip end bracket */ + } + + sym_eval.val = (literals_ok || !LITERAL_ERROR) ? insertLiteral( cp , val, + GET_PAGE_INDEX(field)) : 0; + return( &sym_eval ); + + case '(': /* Generate literal on current page. */ + if( !literals_ok && LITERAL_ERROR) + { + errorMessage( &literal_gen_off, lexstart ); + } + + nextLexBlank(); /* Skip paren */ + val = getExprs() & 07777; + + if( line[lexstart] == ')' ) + { + nextLexBlank(); /* Skip end paren */ + } + + loc = (literals_ok || !LITERAL_ERROR) ? insertLiteral( cp, val, GET_PAGE_INDEX(clc) ) : 0; + sym_eval.val = loc + (( clc + reloc ) & 077600 ); + return( &sym_eval ); + + default: + switch( line[lexstart] ) + { + case '=': + errorMessage( &illegal_equals, lexstart ); + moveToEndOfLine(); + break; + + default: + errorMessage( &illegal_character, lexstart ); + break; + } + val = 0; /* On error, set value to zero. */ + nextLexBlank(); /* Go past illegal character. */ + } + } + sym_eval.val = val; + return( &sym_eval ); +} /* eval() */ + + +/******************************************************************************/ +/* */ +/* Function: inputDubl */ +/* */ +/* Synopsis: Get the value of the current lexeme as a double word. */ +/* */ +/******************************************************************************/ +void inputDubl() +{ + WORD32 dublvalue; + BOOL scanning_line; + + scanning_line = TRUE; + do + { + while( scanning_line ) + { + if( isend( line[lexstart] )) + { + scanning_line = FALSE; + } + else + { + switch( line[lexstart] ) + { + case '/': + scanning_line = FALSE; + break; + + case ';': + nextLexeme(); + break; + + case '+': + delimiter = line[lexterm]; + nextLexBlank(); + case '-': + default: + if( isdigit( line[lexstart] ) || line[lexstart] == '-' ) + { + dublvalue = getDublExprs(); + punchOutObject( clc, (WORD16)(( dublvalue >> 12 ) & 07777 )); + incrementClc(); + punchOutObject( clc, (WORD16)( dublvalue & 07777 )); + incrementClc(); + } + else + { + return; /* Non-numeric input, back to assembly. */ + } + break; + } /* end switch */ + } /* end if */ + + if( error_in_line ) + { + return; /* Error occurred, exit DUBL input mode. */ + } + } /* end while( scanning_line ) */ + readLine(); + nextLexeme(); + scanning_line = TRUE; + } + while( TRUE ); +} /* inputDubl() */ + + +/******************************************************************************/ +/* */ +/* Function: getDublExprs */ +/* */ +/* Synopsis: Get a DUBL expression. */ +/* */ +/******************************************************************************/ +WORD32 getDublExprs() +{ + WORD32 dublvalue; + + dublvalue = getDublExpr(); + + while( TRUE ) + { + if( isdone( line[lexstart] )) + { + return( dublvalue ); + } + else + { + errorMessage( &illegal_expression, lexstart - 1 ); + return( 0 ); + } + } /* end while */ +} /* getDublExprs() */ + + +/******************************************************************************/ +/* */ +/* Function: getDublExpr */ +/* */ +/* Synopsis: Get the value of the current lexeme as a double word. The */ +/* number is always considered to have a decimal radix. */ +/* */ +/******************************************************************************/ +WORD32 getDublExpr() +{ + WORD32 dublvalue; + + delimiter = line[lexterm]; + if( line[lexstart] == '-' ) + { + nextLexBlank(); + dublvalue = evalDubl( 0 ); + nextLexeme(); + /* Test for any value greater than 23 bits in length. */ + if( (unsigned long int)dublvalue > 040000000L ) + { + errorMessage( &dubl_overflow, lexstart ); + dublvalue = 0; + } + dublvalue = -dublvalue; + } + else + { + dublvalue = evalDubl( 0 ); + nextLexeme(); + /* Test for any value greater than 23 bits in length. */ + if( (unsigned long int)dublvalue > 037777777L ) + { + errorMessage( &dubl_overflow, lexstart ); + dublvalue = 0; + } + } + + if( is_blank( delimiter )) + { + return( dublvalue ); + } + + /* Here we assume the current lexeme is the operator separating the */ + /* previous operator from the next, if any. */ + while( TRUE ) + { + /* assert line[lexstart] == delimiter */ + if( is_blank( delimiter )) + { + errorMessage( &illegal_expression, lexstart ); + moveToEndOfLine(); + dublvalue = 0; + return( dublvalue ); + } + + switch( line[lexstart] ) + { + case '+': /* add */ + case '-': /* subtract */ + case '^': /* multiply */ + case '%': /* divide */ + case '&': /* and */ + case '!': /* or */ + errorMessage( &illegal_expression, lexstart ); + moveToEndOfLine(); + dublvalue = 0; + break; + + default: + if( isend( line[lexstart] )) + { + return( dublvalue ); + } + + switch( line[lexstart] ) + { + case '/': + case ';': + break; + + default: + errorMessage( &illegal_expression, lexstart ); + moveToEndOfLine(); + dublvalue = 0; + break; + } + return( dublvalue ); + } + } /* end while */ +} /* getDublExpr() */ + + +/******************************************************************************/ +/* */ +/* Function: evalDubl */ +/* */ +/* Synopsis: Get the value of the current lexeme as a double word. The */ +/* number is always considered to have a decimal radix. */ +/* */ +/******************************************************************************/ +WORD32 evalDubl( WORD32 initial_value ) +{ + WORD32 digit; + int from; + WORD32 dublvalue; + WORD32 olddublvalue; + + overflow = FALSE; + delimiter = line[lexterm]; + from = lexstart; + dublvalue = initial_value; + + while( from < lexterm ) + { + if( isdigit( line[from] )) + { + olddublvalue = dublvalue; + digit = (WORD32)( line[from++] - '0' ); + dublvalue = dublvalue * 10 + digit; + if( dublvalue < olddublvalue ) + { + overflow = TRUE; + } + } + else + { + errorLexeme( ¬_a_number, from ); + dublvalue = 0; + from = lexterm; + } + } + return( dublvalue ); +} /* evalDubl() */ + + +/******************************************************************************/ +/* */ +/* Function: inputFltg */ +/* */ +/* Synopsis: Get the value of the current lexeme as a Floating Point const. */ +/* */ +/******************************************************************************/ +void inputFltg() +{ + FLTG_T *fltg; + BOOL scanning_line; + + fltg_input = TRUE; /* Set lexeme scanner for floating point. */ + scanning_line = TRUE; + while( TRUE ) + { + while( scanning_line ) + { + if( isend( line[lexstart] )) + { + scanning_line = FALSE; + } + else + { + switch( line[lexstart] ) + { + case '/': + scanning_line = FALSE; + break; + + case ';': + nextLexeme(); + break; + + case '+': + delimiter = line[lexterm]; + nextLexBlank(); + case '-': + default: + if( isdigit( line[lexstart] ) || line[lexstart] == '-' ) + { + fltg = getFltgExprs(); + punchOutObject( clc, ( fltg->exponent & 07777 )); + incrementClc(); + punchOutObject( clc, (WORD16)(( fltg->mantissa >> 12 ) & 07777 )); + incrementClc(); + punchOutObject( clc, (WORD16)( fltg->mantissa & 07777 )); + incrementClc(); + } + else + { + fltg_input = FALSE; /* Reset lexeme scanner. */ + return; /* Non-numeric input, back to assembly. */ + } + break; + } /* end switch */ + } /* end if */ + + if( error_in_line ) + { + fltg_input = FALSE; /* Reset lexeme scanner. */ + return; /* Error occurred, exit FLTG input mode. */ + } + } /* end while( scanning_line ) */ + readLine(); + nextLexeme(); + scanning_line = TRUE; + } +} /* inputFltg() */ + + +/******************************************************************************/ +/* */ +/* Function: getFltgExprs */ +/* */ +/* Synopsis: Get a FLTG expression. */ +/* */ +/******************************************************************************/ +FLTG_T *getFltgExprs() +{ + FLTG_T *fltg; + + fltg = getFltgExpr(); + + while( TRUE ) + { + if( isdone( line[lexstart] )) + { + return( fltg ); + } + else + { + errorMessage( &illegal_expression, lexstart - 1 ); + return( 0 ); + } + } /* end while */ +} /* getFltgExprs() */ + + +/******************************************************************************/ +/* */ +/* Function: getFltgExpr */ +/* */ +/* Synopsis: Get the value of the current lexeme as a double word. The */ +/* number is always considered to have a decimal radix. */ +/* */ +/******************************************************************************/ +FLTG_T *getFltgExpr() +{ + FLTG_T *fltg; + + delimiter = line[lexterm]; + fltg = evalFltg(); + /* Test for any value greater than 23 bits in length. */ + if( (unsigned long int)fltg->mantissa> 077777777L ) + { + errorMessage( &fltg_overflow, lexstart ); + } + + if( is_blank( delimiter )) + { + return( fltg ); + } + + /* Here we assume the current lexeme is the operator separating the */ + /* previous operator from the next, if any. */ + while( TRUE ) + { + /* assert line[lexstart] == delimiter */ + if( is_blank( delimiter )) + { + errorMessage( &illegal_expression, lexstart ); + moveToEndOfLine(); + fltg = 0; + return( fltg ); + } + + switch( line[lexstart] ) + { + case '+': /* add */ + case '-': /* subtract */ + case '^': /* multiply */ + case '%': /* divide */ + case '&': /* and */ + case '!': /* or */ + errorMessage( &illegal_expression, lexstart ); + moveToEndOfLine(); + fltg = NULL; + break; + + default: + if( isend( line[lexstart] )) + { + return( fltg ); + } + + switch( line[lexstart] ) + { + case '/': + case ';': + break; + + default: + errorMessage( &illegal_expression, lexstart ); + moveToEndOfLine(); + fltg = NULL; + break; + } + return( fltg ); + } + } /* end while */ +} /* getFltgExpr() */ + + +/******************************************************************************/ +/* */ +/* Function: evalFltg */ +/* */ +/* Synopsis: Get the value of the current lexeme as a floating point value. */ +/* Floating point input is alwasy considered decimal. */ +/* The general format of a floating point number is: */ +/* +-ddd.dddE+-dd where each d is a decimal digit. */ +/* */ +/******************************************************************************/ +FLTG_T *evalFltg() +{ + int current_state; + int current_col; + WORD16 exponent; + FLTG_T *fltg; + WORD32 input_value; + BOOL negate; + BOOL negate_exponent; + int next_state; + int right_digits; + + /* This uses a lexical analyzer to parse the floating point format. */ + static BYTE state_table[][10] = + { + /* 0 1 2 3 4 5 6 Oolumn index */ + /* + - d . E sp p State Comment */ + { 2, 1, 3, 4, 10, 10, 10 }, /* 0 Initial state. */ + { 11, 11, 3, 4, 11, 11, 11 }, /* 1 - */ + { 11, 11, 3, 4, 11, 11, 11 }, /* 2 + */ + { 10, 10, 10, 4, 6, 10, 10 }, /* 3 # (+-ddd) */ + { 11, 11, 5, 11, 11, 10, 10 }, /* 4 . (+-ddd.) */ + { 11, 11, 11, 11, 6, 10, 11 }, /* 5 # (+-ddd.ddd) */ + { 8, 7, 9, 11, 11, 11, 11 }, /* 6 E (+-ddd.dddE) */ + { 11, 11, 9, 11, 11, 11, 11 }, /* 7 - (+-ddd.dddE- */ + { 11, 11, 9, 11, 11, 11, 11 }, /* 8 + (+-ddd.dddE+ */ + { 11, 11, 11, 11, 11, 10, 11 } /* 9 # (+-ddd.dddE+-dd */ + /* 10 Completion state */ + /* 11 Error state. */ + }; + + delimiter = line[lexterm]; + fltg = &fltg_ac; + fltg->exponent = 0; + fltg->mantissa = 0; + input_value = 0; + negate = FALSE; + negate_exponent = FALSE; + next_state = 0; + exponent = 0; + right_digits = 0; + current_state = 0; + + while( TRUE ) + { + /* Classify character. This is the column index. */ + switch( line[lexstart] ) + { + case '+': + current_col = 0; + break; + + case '-': + current_col = 1; + break; + + case '.': + current_col = 3; + break; + + case 'E': case 'e': + current_col = 4; + break; + + default: + if( isdigit( line[lexstart] )) + { + current_col = 2; + } + else if( isdone( line[lexstart] )) + { + current_col = 5; + } + else + { + current_col = 6; + } + break; + } + + next_state = state_table[current_state][current_col]; + + switch( next_state ) + { + case 1: /* - */ + negate = TRUE; + case 2: /* + */ + delimiter = line[lexterm]; /* Move past the + or - character. */ + nextLexBlank(); + break; + + case 3: /* Number (+-ddd) */ + input_value = evalDubl( 0 ); /* Integer part of the number. */ + nextLexeme(); /* Move past previous lexeme. */ + break; + + case 4: + delimiter = line[lexterm]; + nextLexBlank(); /* Move past the . character. */ + break; + + case 5: /* . (+-ddd.ddd) */ + /* Fractional part of the number. */ + input_value = evalDubl( input_value ); + right_digits = lexterm - lexstart;/* Digit count to right of decimal. */ + nextLexeme(); /* Move past previous lexeme. */ + break; + + case 6: /* E (+-ddd.dddE) */ + delimiter = line[lexterm]; /* Move past the E. */ + nextLexBlank(); + break; + + case 7: /* - (+-ddd.dddE-) */ + negate_exponent = TRUE; + case 8: /* + (+-ddd.dddE+) */ + delimiter = line[lexterm]; /* Move past the + or - character. */ + nextLexBlank(); + break; + + case 9: /* # (+-ddd.dddE+-dd) */ + exponent = (int)evalDubl( 0 ); /* Exponent of floating point number. */ + if( negate_exponent ) { exponent = - exponent; } + nextLexeme(); /* Move past previous lexeme. */ + break; + + case 10: /* Floating number parsed, convert */ + /* the number. */ + /* Get the exponent for the number as input. */ + exponent -= right_digits; + + /* Remove trailing zeros and adjust the exponent accordingly. */ + while(( input_value % 10 ) == 0 ) + { + input_value /= 10; + exponent++; + } + + /* Convert the number to floating point. The number is calculated with */ + /* a 27 bit mantissa to improve precision. The extra 3 bits are */ + /* discarded after the result has been calculated. */ + fltg->exponent = 26; + fltg->mantissa = input_value << 3; + normalizeFltg( fltg ); + + + while( exponent != 0 ) + { + if( exponent < 0 ) + { + /* Decimal point is to the left. */ + fltg->mantissa /= 10; + normalizeFltg( fltg ); + exponent++; + } + else if( exponent > 0 ) + { + /* Decimal point is to the right. */ + fltg->mantissa *= 10; + normalizeFltg( fltg ); + exponent--; + } + } + + /* Discard the extra precsion used for calculating the number. */ + fltg->mantissa >>= 3; + fltg->exponent -= 3; + if( negate ) + { + fltg->mantissa = (- fltg->mantissa ) & 077777777L; + } + return( fltg ); + + case 11: /* Error in format. */ + /* Not a properly constructued floating point number. */ + return( fltg ); + default: + break; + } + /* Set state for next pass through the loop. */ + current_state = next_state; + } +} /* evalFltg() */ + + + +/******************************************************************************/ +/* */ +/* Function: normalizeFltg */ +/* */ +/* Synopsis: Normalize a PDP-8 double precision floating point number. */ +/* */ +/******************************************************************************/ +void normalizeFltg( FLTG_T *fltg ) +{ + /* Normalize the floating point number. */ + if( fltg->mantissa != 0 ) + { + if(( fltg->mantissa & ~0x3FFFFFFL ) == 0 ) + { + while(( fltg->mantissa & ~0x1FFFFFFL ) == 0 ) + + { + fltg->mantissa <<= 1; + fltg->exponent--; + } + } + else + { + while(( fltg->mantissa & ~0x3FFFFFFL ) != 0 ) + { + fltg->mantissa >>= 1; + fltg->exponent++; + } + } + } + else + { + fltg->exponent = 0; + } + return; +} + + +/******************************************************************************/ +/* */ +/* Function: incrementClc */ +/* */ +/* Synopsis: Set the next assembly location. Test for collision with */ +/* the literal tables. */ +/* */ +/******************************************************************************/ +WORD16 incrementClc() +{ + testForLiteralCollision( clc ); + + /* Incrementing the location counter is not to change field setting. */ + clc = ( clc & 070000 ) + (( clc + 1 ) & 07777 ); + fieldlc = clc & 07777; + return( clc ); +} /* incrementClc() */ + + +/******************************************************************************/ +/* */ +/* Function: testForLiteralCollision */ +/* */ +/* Synopsis: Test the given location for collision with the literal tables. */ +/* */ +/******************************************************************************/ +BOOL testForLiteralCollision( WORD16 loc ) +{ + WORD16 pagelc; + BOOL result = FALSE; + WORD16 tmppage; + int tmpfield; + + tmpfield = GET_PAGE_INDEX(loc); + tmppage = loc & 07600; + pagelc = loc & 00177; + + if ( pagelc > max_page_used[tmpfield] ) + { + max_page_used[tmpfield] = pagelc; + } + if ( pagelc >= cp[tmpfield].loc ) + { + if ( tmppage == 0 ) + { + errorMessage( &pz_literal_overflow, -1 ); + } + else + { + errorMessage( &literal_overflow, -1 ); + } + result = TRUE; + } + + return( result ); +} /* testForLiteralCollision() */ + + +/******************************************************************************/ +/* */ +/* Function: readLine */ +/* */ +/* Synopsis: Get next line of input. Print previous line if needed. */ +/* */ +/******************************************************************************/ +void readLine() +{ + WORD16 ix; + WORD16 iy; + char inpline[LINELEN]; + + listLine(); /* List previous line if needed. */ + lineno++; /* Count lines read. */ + indirect_generated = FALSE; /* Mark no indirect address generated. */ + listed = FALSE; /* Mark as not listed. */ + cc = 0; /* Initialize column counter. */ + lexstartprev = 0; + + error_in_line = FALSE; + if(( fgets( inpline, LINELEN - 1, infile )) == NULL ) + { + inpline[0] = '$'; + inpline[1] = '\n'; + inpline[2] = '\0'; + if (!dollar_not_required) { + error_in_line = TRUE; + } + } + + /* Remove any tabs from the input line by inserting the required number */ + /* of spaces to simulate N character tab stops, where N defaults to 8 and */ + /* is set by the command line option -t. (RK 20071029) */ + /* Ignore \r if there is one. (DPI 20150501) */ + for( ix = 0, iy = 0; inpline[ix] != '\0' && iy < (LINELEN - 2); ix++ ) + { + switch( inpline[ix] ) + { + case '\t': + do + { + line[iy] = ' '; + iy++; + } + while(( iy % tabstops ) != 0 && iy < (LINELEN - 2)); + break; + + case '\r': /* dont copy the carriage return */ + break; + + default: + line[iy] = inpline[ix]; + iy++; + break; + } + } + if (iy >= (LINELEN - 2)) { + line [iy] = '\n'; + iy++; + } + line[iy] = '\0'; + + maxcc = iy; /* Save the current line length. */ + /* Save the first line for possible use as the listing title. */ + if( lineno == 1 ) + { + strcpy( list_title, line ); + } +} /* readLine() */ + + +/******************************************************************************/ +/* */ +/* Function: listLine */ +/* */ +/* Synopsis: Output a line to the listing file. */ +/* */ +/******************************************************************************/ +void listLine() +/* generate a line of listing if not already done! */ +{ + if( listfile != NULL && listed == FALSE ) + { + printLine( line, 0, 0, LINE ); + } +} /* listLine() */ + + +/******************************************************************************/ +/* */ +/* Function: printPageBreak */ +/* */ +/* Synopsis: Output a Top of Form and listing header if new page necessary. */ +/* */ +/******************************************************************************/ +void printPageBreak() +{ + if( page_lineno >= LIST_LINES_PER_PAGE ) + /* ( list_lineno % LIST_LINES_PER_PAGE ) == 0 ) */ + { + if( !list_title_set ) + { + /* strcpy( list_title, line ); */ + if( list_title[strlen(list_title) - 1] == '\n' ) + { + list_title[strlen(list_title) - 1] = '\0'; + } + if( strlen( list_title ) > TITLELEN ) + { + list_title[TITLELEN] = '\0'; + } + list_title_set = TRUE; + } + topOfForm( list_title, NULL ); + + } +} /* printPageBreak() */ + + +/******************************************************************************/ +/* */ +/* Function: printLine */ +/* */ +/* Synopsis: Output a line to the listing file with new page if necessary. */ +/* */ +/******************************************************************************/ +void printLine( char *line, WORD16 loc, WORD16 val, LINESTYLE_T linestyle ) +{ + char rlc; + + if( listfile == NULL ) + { + save_error_count = 0; + return; + } + + printPageBreak(); + + list_lineno++; + page_lineno++; + + if (reloc == 0) + { + rlc = ' '; + } + else + { + rlc = '*'; + } + + switch( linestyle ) + { + default: + case LINE: + fprintf(listfile, "%5d ", lineno ); + fputs( line, listfile ); + listed = TRUE; + break; + + case LINE_VAL: + fprintf(listfile, "%5d %4.4o ", lineno, val ); + fputs( line, listfile ); + listed = TRUE; + break; + + case LINE_LOC_VAL: + if( !listed ) + { + if( indirect_generated ) + { + fprintf( listfile, "%5d %5.5o%c %4.4o@ ", lineno, loc, rlc, val ); + } + else + { + fprintf( listfile, "%5d %5.5o%c %4.4o ", lineno, loc, rlc, val ); + } + fputs( line, listfile ); + listed = TRUE; + } + else + { + fprintf( listfile, " %5.5o%c %4.4o\n", loc, rlc, val ); + } + break; + + case LOC_VAL: + fprintf( listfile, " %5.5o%c %4.4o\n", loc, rlc, val ); + break; + } + printErrorMessages(); +} /* printLine() */ + + +/******************************************************************************/ +/* */ +/* Function: printErrorMessages */ +/* */ +/* Synopsis: Output any error messages from the current list of errors. */ +/* */ +/******************************************************************************/ +void printErrorMessages() +{ + WORD16 ix; + WORD16 iy; + + if( listfile != NULL ) + { + /* If any errors, display them now. */ + for( iy = 0; iy < save_error_count; iy++ ) + { + printPageBreak(); + fprintf( listfile, "%-18.18s", error_list[iy].mesg ); + if( error_list[iy].col >= 0 ) + { + for( ix = 0; ix < error_list[iy].col; ix++ ) + { + if( line[ix] == '\t' ) + { + putc( '\t', listfile ); + } + else + { + putc( ' ', listfile ); + } + } + fputs( "^", listfile ); + list_lineno++; + page_lineno++; + } + fputs( "\n", listfile ); + } + } + save_error_count = 0; +} /* printErrorMessages() */ + + +/******************************************************************************/ +/* */ +/* Function: endOfBinary */ +/* */ +/* Synopsis: Outputs both literal tables at the end of a binary segment. */ +/* */ +/******************************************************************************/ +void endOfBinary() +{ + /* Punch page 0 also. */ + punchLiteralPool( cp, 1 ); + if( error_in_line ) + { + listed = TRUE; + clc = ( clc & 070000 ) + (( clc - 1 ) & 07777 ); + errorMessage( &end_of_file, -1 ); + clc = ( clc & 070000 ) + (( clc + 1 ) & 07777 ); + } + else + { + listLine(); /* List line if not done yet. */ + } + return; +} /* endOfBinary() */ + + +/******************************************************************************/ +/* */ +/* Function: punchChecksum */ +/* */ +/* Synopsis: Output a checksum if the current mode requires it and an */ +/* object file exists. */ +/* */ +/******************************************************************************/ +void punchChecksum() +{ + /* If the assembler has output any BIN data output the checksum. */ + if( binary_data_output && !rim_mode ) + { + punchLocObject( 0, checksum ); + } + binary_data_output = FALSE; + checksum = 0; +} /* punchChecksum() */ + + +/******************************************************************************/ +/* */ +/* Function: punchLeader */ +/* */ +/* Synopsis: Generate 2 feet of leader on object file, as per DEC */ +/* documentation. Paper tape has 10 punches per inch. */ +/* */ +/******************************************************************************/ +void punchLeader( int count ) +{ + int ix; + + /* If value is zero, set to the default of 2 feet of leader. */ + count = ( count == 0 ) ? 240 : count; + + if( objectfile != NULL ) + { + for( ix = 0; ix < count; ix++ ) + { + fputc( 0200, objectfile ); + } + } +} /* punchLeader() */ + + +/******************************************************************************/ +/* */ +/* Function: punchOrigin */ +/* */ +/* Synopsis: Output an origin to the object file. */ +/* */ +/******************************************************************************/ +void punchOrigin( WORD16 loc ) +{ + punchObject((( loc >> 6 ) & 0077 ) | 0100 ); + punchObject( loc & 0077 ); +} /* punchOrigin() */ + + +/******************************************************************************/ +/* */ +/* Function: punchObject */ +/* */ +/* Synopsis: Put one character to object file and include it in checksum. */ +/* */ +/******************************************************************************/ +void punchObject( WORD16 val ) +{ + val &= 0377; + if( objectfile != NULL ) + { + fputc( val, objectfile ); + checksum += val; + } + binary_data_output = TRUE; +} /* punchObject() */ + + +/******************************************************************************/ +/* */ +/* Function: punchOutObject */ +/* */ +/* Synopsis: Output the current line and then then punch value to the */ +/* object file. */ +/* */ +/******************************************************************************/ +void punchOutObject( WORD16 loc, WORD16 val ) +{ + /* Adding reloc makes printout agree with PAL8 where is prints the */ + /* relocated address, not the address in the BIN file */ + printLine( line,( ( field | loc ) + reloc ), val, LINE_LOC_VAL ); + punchLocObject( loc, val ); +} /* punchOutObject() */ + +/******************************************************************************/ +/* */ +/* Function: punchLocObject */ +/* */ +/* Synopsis: Output the word (with origin if rim format) to the object file.*/ +/* */ +/******************************************************************************/ +void punchLocObject( WORD16 loc, WORD16 val ) +{ + if( rim_mode ) + { + punchOrigin( loc ); + } + punchObject(( val >> 6 ) & 0077 ); + punchObject( val & 0077 ); +} /* punchLocObject() */ + + +/******************************************************************************/ +/* */ +/* Function: punchLiteralPool */ +/* */ +/* Synopsis: Output the current page data. */ +/* */ +/******************************************************************************/ +void punchLiteralPool( LPOOL_T *p, BOOL punch_page0 ) +{ + WORD16 loc; + WORD16 tmplc; + int lpool_page = 0; /* Silence false uninitialized error from GCC */ + int i; + + for (i = MAX_PAGES-1; i >= 0; i--) { + lpool_page = (i << 7) & 07600; + + if ( p[i].loc != p[i].last_punched && (punch_page0 || lpool_page != 0) ) + { + if( !rim_mode ) + { + /* Put out origin if not in rim mode. */ + punchOrigin( p[i].loc | lpool_page ); + } + /* Put the literals in the object file. */ + for( loc = p[i].loc; loc < p[i].last_punched; loc++ ) + { + tmplc = loc + lpool_page; + printLine( line, (field | tmplc), p[i].pool[loc], LOC_VAL ); + punchLocObject( tmplc, p[i].pool[loc] ); + } + p[i].last_punched = p[i].loc; + } + } +} /* punchLiteralPool() */ + + +/******************************************************************************/ +/* */ +/* Function: insertLiteral */ +/* */ +/* Synopsis: Add a value to the given literal pool if not already in pool. */ +/* Return the location of the value in the pool. */ +/* */ +/******************************************************************************/ +WORD16 insertLiteral( LPOOL_T *pool, WORD16 value, int fieldpage_index ) +{ + WORD16 ix; + LPOOL_T *p; + + p = &pool[fieldpage_index]; + + /* Search the literal pool for any occurence of the needed value. */ + ix = PAGE_SIZE - 1; + while( ix >= p->loc && p->pool[ix] != value ) + { + ix--; + } + + /* Check if value found in literal pool. If not, then insert value. */ + if( ix < p->loc ) + { + (p->loc)--; + p->pool[p->loc] = value; + ix = p->loc; + if( max_page_used[fieldpage_index] >= p->loc ) { + if ( (fieldpage_index & 017) == 0 ) + { + errorMessage( &pz_literal_overflow, -1 ); + } + else + { + errorMessage( &literal_overflow, -1 ); + } + } + } + return( ix ); +} /* insertLiteral() */ + + +/******************************************************************************/ +/* */ +/* Function: printSymbolTable */ +/* */ +/* Synopsis: Output the symbol table. */ +/* */ +/******************************************************************************/ +void printSymbolTable() +{ + int col; + int cx; + char *fmt; + int ix; + char mark; + int page; + int row; + int symbol_base; + int symbol_lines; + + symbol_base = number_of_fixed_symbols; + + for( page=0, list_lineno=0, col=0, ix=symbol_base; ix < symbol_top; page++ ) + { + topOfForm( list_title, s_symtable ); + symbol_lines = LIST_LINES_PER_PAGE - page_lineno; + + for( row = 0; page_lineno < LIST_LINES_PER_PAGE && ix < symbol_top; row++) + { + list_lineno++; + page_lineno++; + fprintf( listfile, "%5d", list_lineno ); + + for( col = 0; col < SYMBOL_COLUMNS && ix < symbol_top; col++ ) + { + /* Get index of symbol for the current line and column */ + cx = symbol_lines * ( SYMBOL_COLUMNS * page + col ) + row; + cx += symbol_base; + + /* Make sure that there is a symbol to be printed. */ + if( number_of_fixed_symbols <= cx && cx < symbol_top ) + { + switch( symtab[cx].type & LABEL ) + { + case LABEL: + fmt = " %c%-6.6s %5.5o "; + break; + + default: + fmt = " %c%-6.6s %4.4o "; + break; + } + + switch( symtab[cx].type & ( DEFINED | REDEFINED )) + { + case UNDEFINED: + mark = '?'; + break; + + case REDEFINED: + mark = '#'; + break; + + default: + mark = ' '; + break; + } + fprintf( listfile, fmt, mark, symtab[cx].name, symtab[cx].val ); + ix++; + } + } + fprintf( listfile, "\n" ); + } + } +} /* printSymbolTable() */ + + +/******************************************************************************/ +/* */ +/* Function: printPermanentSymbolTable */ +/* */ +/* Synopsis: Output the permanent symbol table to a file suitable for */ +/* being input after the EXPUNGE pseudo-op. */ +/* */ +/******************************************************************************/ +void printPermanentSymbolTable() +{ + int ix; + FILE *permfile; + char *s_type; + + if(( permfile = fopen( permpathname, "w" )) == NULL ) + { + exit( 2 ); + } + + fprintf( permfile, "/ PERMANENT SYMBOL TABLE\n/\n" ); + fprintf( permfile, " EXPUNGE\n/\n" ); + /* Print the memory reference instructions first. */ + s_type = "FIXMRI"; + for( ix = 0; ix < symbol_top; ix++ ) + { + if( M_MRI( symtab[ix].type )) + { + fprintf( permfile, "%-7s %s=%4.4o\n", + s_type, symtab[ix].name, symtab[ix].val ); + } + } + + s_type = " "; + for( ix = 0; ix < symbol_top; ix++ ) + { + if( M_FIXED( symtab[ix].type )) + { + if( !M_MRI( symtab[ix].type ) && !M_PSEUDO( symtab[ix].type )) + { + fprintf( permfile, "%-7s %s=%4.4o\n", + s_type, symtab[ix].name, symtab[ix].val ); + } + } + } + fprintf( permfile, "/\n FIXTAB\n" ); + fclose( permfile ); +} /* printPermanentSymbolTable() */ + + +/******************************************************************************/ +/* */ +/* Function: printCrossReference */ +/* */ +/* Synopsis: Output a cross reference (concordance) for the file being */ +/* assembled. */ +/* */ +/******************************************************************************/ +void printCrossReference() +{ + int ix; + int symbol_base; + int xc; + int xc_index; + int xc_refcount; + int xc_cols; + + /* Force top of form for first page. */ + page_lineno = LIST_LINES_PER_PAGE; + + list_lineno = 0; + symbol_base = number_of_fixed_symbols; + + for( ix = symbol_base; ix < symbol_top; ix++ ) + { + list_lineno++; + page_lineno++; + if( page_lineno >= LIST_LINES_PER_PAGE ) + { + topOfForm( list_title, s_xref ); + } + + fprintf( listfile, "%5d", list_lineno ); + + /* Get reference count & index into concordance table for this symbol. */ + xc_refcount = symtab[ix].xref_count; + xc_index = symtab[ix].xref_index; + /* Determine how to label symbol on concordance. */ + switch( symtab[ix].type & ( DEFINED | REDEFINED )) + { + case UNDEFINED: + fprintf( listfile, " U "); + break; + + case REDEFINED: + fprintf( listfile, " M %5d ", xreftab[xc_index] ); + break; + + default: + fprintf( listfile, " A %5d ", xreftab[xc_index] ); + break; + } + fprintf( listfile, "%-6.6s ", symtab[ix].name ); + + /* Output the references, 8 numbers per line after symbol name. */ + for( xc_cols = 0, xc = 1; xc < xc_refcount + 1; xc++, xc_cols++ ) + { + if( xc_cols >= XREF_COLUMNS ) + { + xc_cols = 0; + page_lineno++; + if( page_lineno >= LIST_LINES_PER_PAGE ) + { + topOfForm( list_title, s_xref); + } + list_lineno++; + fprintf( listfile, "\n%5d%-19s", list_lineno, " " ); + } + fprintf( listfile, " %5d", xreftab[xc_index + xc] ); + } + fprintf( listfile, "\n" ); + } +} /* printCrossReference() */ + + +/******************************************************************************/ +/* */ +/* Function: topOfForm */ +/* */ +/* Synopsis: Prints title and sub-title on top of next page of listing. */ +/* */ +/******************************************************************************/ +void topOfForm( char *title, char *sub_title ) +{ + char temp[10]; + + list_pageno++; + strcpy( temp, s_page ); + sprintf( temp, "%s %d", s_page, list_pageno ); + + /* Output a top of form if not the first page of the listing. */ + if( list_pageno > 1 ) + { + fprintf( listfile, "\f" ); + } + fprintf( listfile, "\n\n\n %-63s %10s\n", title, temp ); + + /* Reset the current page line counter. */ + page_lineno = 3; + if( sub_title != NULL ) + { + fprintf( listfile, "%80s\n", sub_title ); + page_lineno++; + } + else + { + fprintf( listfile, "\n" ); + page_lineno++; + } + fprintf( listfile, "\n" ); + page_lineno++; +} /* topOfForm() */ + + +/******************************************************************************/ +/* */ +/* Function: lexemeToName */ +/* */ +/* Synopsis: Convert the current lexeme into a string. */ +/* */ +/******************************************************************************/ +char *lexemeToName( char *name, int from, int term ) +{ + int to; + + to = 0; + + while( from < term && to < ( SYMLEN - 1 )) + { + name[to++] = toupper( line[from++] ); + } + + while( to < SYMLEN ) + { + name[to++] = '\0'; + } + return( name ); +} /* lexemeToName() */ + +/******************************************************************************/ +/* */ +/* Function: defineLexeme */ +/* */ +/* Synopsis: Put lexeme into symbol table with a value. */ +/* */ +/******************************************************************************/ +SYM_T *defineLexeme( int start, /* start of lexeme being defined. */ + int term, /* end+1 of lexeme being defined. */ + WORD16 val, /* value of lexeme being defined. */ + SYMTYP type ) /* how symbol is being defined. */ +{ + char name[SYMLEN]; + + lexemeToName( name, start, term); + return( defineSymbol( name, val, type, start )); +} /* defineLexeme() */ + + +/******************************************************************************/ +/* */ +/* Function: defineSymbol */ +/* */ +/* Synopsis: Define a symbol in the symbol table, enter symbol name if not */ +/* not already in table. */ +/* */ +/******************************************************************************/ +SYM_T *defineSymbol( char *name, WORD16 val, SYMTYP type, WORD16 start ) +{ + SYM_T *sym; + int xref_count; + + if( strlen( name ) < 1 ) + { + return( &sym_undefined ); /* Protect against non-existent names. */ + } + sym = lookup( name ); + /* OS/8 PAL8 seems to allow permanent symbold to be redefined without error */ + if( ( M_FIXED( sym->type ) && pass == 1 && perm_redef_error ) || + (M_PERM_REDEFINED( sym->type ) && (sym->val != val)) ) + { + type |= PERM_REDEFINED; + } + + xref_count = 0; /* Set concordance for normal defintion. */ + + if( M_DEFINED( sym->type )) + { + if( pass == 2 && ( (sym->val & 07777) != (val & 07777) || M_PERM_REDEFINED(sym->type)) ) + { + /* Generate diagnostic if redefining a symbol. */ + if( M_PERM_REDEFINED( sym->type ) && (M_LABEL(sym->type) || M_LABEL(type)) ) + { + errorSymbol( &illegal_redefine, sym->name, start ); + } else + { + /* Generate diagnostic if redefining a symbol. */ + if( M_REDEFINED( sym->type ) && (M_LABEL(sym->type) || M_LABEL(type)) ) + { + errorSymbol( &redefined_symbol, sym->name, start ); + } + } + type = type | REDEFINED; + sym->xref_count++; /* Referenced suymbol, count it. */ + xref_count = sym->xref_count; + } + } + + if( pass == 2 && xref ) + { + /* Put the definition line number in the concordance table. */ + /* Defined symbols are not counted as references. */ + xreftab[sym->xref_index] = lineno; + /* Put the line number in the concordance table. */ + xreftab[sym->xref_index + xref_count] = lineno; + } + + /* Now set the value and the type. */ + sym->val = ( M_LABEL(type) ) ? val : val & 07777; + sym->type = ( pass == 1 ) ? ( type | CONDITION ) : type; + return( sym ); +} /* defineSymbol() */ + + +/******************************************************************************/ +/* */ +/* Function: lookup */ +/* */ +/* Synopsis: Find a symbol in table. If not in table, enter symbol in */ +/* table as undefined. Return address of symbol in table. */ +/* */ +/******************************************************************************/ +SYM_T *lookup( char *name ) +{ + int ix; /* Insertion index */ + int lx; /* Left index */ + int rx; /* Right index */ + + /* First search the permanent symbols. */ + lx = 0; + ix = binarySearch( name, lx, number_of_fixed_symbols ); + + /* If symbol not in permanent symbol table. */ + if( ix < 0 ) + { + /* Now try the user symbol table. */ + ix = binarySearch( name, number_of_fixed_symbols, symbol_top ); + + /* If symbol not in user symbol table. */ + if( ix < 0 ) + { + /* Must put symbol in table if index is negative. */ + ix = ~ix; + if( symbol_top + 1 >= SYMBOL_TABLE_SIZE ) + { + errorSymbol( &symbol_table_full, name, lexstart ); + exit( 1 ); + } + + for( rx = symbol_top; rx >= ix; rx-- ) + { + symtab[rx + 1] = symtab[rx]; + } + symbol_top++; + + /* Enter the symbol as UNDEFINED with a value of zero. */ + strcpy( symtab[ix].name, name ); + symtab[ix].type = UNDEFINED; + symtab[ix].val = 0; + symtab[ix].xref_count = 0; + if( xref && pass == 2 ) + { + xreftab[symtab[ix].xref_index] = 0; + } + } + } + + return( &symtab[ix] ); /* Return the location of the symbol. */ +} /* lookup() */ + + +/******************************************************************************/ +/* */ +/* Function: binarySearch */ +/* */ +/* Synopsis: Searches the symbol table within the limits given. If the */ +/* symbol is not in the table, it returns the insertion point. */ +/* */ +/******************************************************************************/ +int binarySearch( char *name, int start, int symbol_count ) +{ + int lx; /* Left index */ + int mx; /* Middle index */ + int rx; /* Right index */ + int compare; /* Results of comparison */ + + lx = start; + rx = symbol_count - 1; + while( lx <= rx ) + { + mx = ( lx + rx ) / 2; /* Find center of search area. */ + + compare = strcmp( name, symtab[mx].name ); + + if( compare < 0 ) + { + rx = mx - 1; + } + else if( compare > 0 ) + { + lx = mx + 1; + } + else + { + return( mx ); /* Found a match in symbol table. */ + } + } /* end while */ + return( ~lx ); /* Return insertion point. */ +} /* binarySearch() */ + + +/******************************************************************************/ +/* */ +/* Function: compareSymbols */ +/* */ +/* Synopsis: Used to presort the symbol table when starting assembler. */ +/* */ +/******************************************************************************/ +int compareSymbols( const void *a, const void *b ) +{ + return( strcmp( ((SYM_T *) a)->name, ((SYM_T *) b)->name )); +} /* compareSymbols() */ + + +/******************************************************************************/ +/* */ +/* Function: evalSymbol */ +/* */ +/* Synopsis: Get the pointer for the symbol table entry if exists. */ +/* If symbol doesn't exist, return a pointer to the undefined sym */ +/* */ +/******************************************************************************/ +SYM_T *evalSymbol() +{ + char name[SYMLEN]; + SYM_T *sym; + + sym = lookup( lexemeToName( name, lexstart, lexterm )); + + /* The symbol goes in the concordance iff it is in a different position in */ + /* the assembler source file. */ + if( lexstart != last_xref_lexstart || lineno != last_xref_lineno ) + { + sym->xref_count++; /* Count the number of references to symbol. */ + last_xref_lexstart = lexstart; + last_xref_lineno = lineno; + + /* Put the line number in the concordance table. */ + if( xref && pass == 2 ) + { + xreftab[sym->xref_index + sym->xref_count] = lineno; + } + } + + return( sym ); +} /* evalSymbol() */ + + +/******************************************************************************/ +/* */ +/* Function: moveToEndOfLine */ +/* */ +/* Synopsis: Move the parser input to the end of the current input line. */ +/* */ +/******************************************************************************/ +void moveToEndOfLine() +{ + while( !isend( line[cc] )) cc++; + lexstart = cc; + lexterm = cc; + lexstartprev = lexstart; +} /* moveToEndOfLine() */ + +/******************************************************************************/ +/* */ +/* Function: nextLexeme */ +/* */ +/* Synopsis: Get the next lexical element from input line. */ +/* */ +/******************************************************************************/ +void nextLexeme() +{ + /* Save start column of previous lexeme for diagnostic messages. */ + lexstartprev = lexstart; + lextermprev = lexterm; + + while( is_blank( line[cc] )) { cc++; } + lexstart = cc; + + if( isalnum( line[cc] )) + { + while( isalnum( line[cc] )) { cc++; } + } + else if( isend( line[cc] )) + { + /* End-of-Line, don't advance cc! */ + } + else + { + switch( line[cc] ) + { + case '"': /* Quoted letter */ + if( cc + 2 < maxcc ) + { + cc++; + cc++; + } + else + { + errorMessage( &no_literal_value, lexstart ); + cc++; + } + break; + + case '/': /* Comment, don't advance cc! */ + break; + + default: /* All other punctuation. */ + cc++; + break; + } + } + lexterm = cc; +} /* nextLexeme() */ + + +/******************************************************************************/ +/* */ +/* Function: nextLexBlank */ +/* */ +/* Synopsis: Used to prevent illegal blanks in expressions. */ +/* */ +/******************************************************************************/ +void nextLexBlank() +{ + nextLexeme(); + if( is_blank( delimiter )) + { + errorMessage( &illegal_blank, lexstart - 1 ); + } + delimiter = line[lexterm]; +} /* nextLexBlank() */ + + +/******************************************************************************/ +/* */ +/* Function: pseudoOperators */ +/* */ +/* Synopsis: Process pseudo-ops (directives). */ +/* */ +/******************************************************************************/ +BOOL pseudoOperators( PSEUDO_T val ) +{ + int count, count2; + int delim; + int index; + int ix; + int lexstartsave; + WORD16 newfield; + WORD16 oldclc; + int pack; + BOOL status; + SYM_T *sym; + FILE *temp; + int term; + WORD16 value; + char os8_name[8]; + int reloc_clc; + + status = TRUE; + switch( (PSEUDO_T) val ) + { + case ASCII: + /* added 18-Jan-2003 PNT -- derived from TEXT */ + delim = line[lexstart]; + index = lexstart + 1; + while( line[index] != delim && !isend( line[index] )) + { + punchOutObject( clc, (line[index] & 127) | 128 ); + incrementClc(); + index++; + } + if( isend( line[index] )) + { + cc = index; + lexterm = cc; + errorMessage( &text_string, cc ); + } + else + { + cc = index + 1; + lexterm = cc; + } + nextLexeme(); + break; + + case BANK: + errorSymbol( &no_pseudo_op, "BANK", lexstartprev ); + /* should select a different 32K out of 128K */ + break; + + case BINPUNCH: + /* If there has been data output and this is a mode switch, set up to */ + /* output data in BIN mode. */ + if( binary_data_output && rim_mode ) + { + clearLiteralTable(); + punchLeader( 8 ); /* Generate a short leader/trailer. */ + checksum = 0; + binary_data_output = FALSE; + } + rim_mode = FALSE; + break; + + case DECIMAL: + radix = 10; + break; + + case DUBL: + inputDubl(); + break; + + case EJECT: + page_lineno = LIST_LINES_PER_PAGE; /* This will force a page break. */ + status = FALSE; /* This will force reading of next line */ + break; + + case ENPUNCH: + if( pass == 2 ) + { + objectfile = objectsave; + } + break; + + case EXPUNGE: /* Erase symbol table */ + if( pass == 1 ) + { + symtab[0] = sym_undefined; + symbol_top = 0; + number_of_fixed_symbols = symbol_top; + fixed_symbols = &symtab[symbol_top - 1]; + + /* Enter the pseudo-ops into the symbol table. */ + for( ix = 0; ix < DIM( pseudo ); ix++ ) + { + defineSymbol( pseudo[ix].name, pseudo[ix].val, pseudo[ix].type, 0 ); + } + /* Enter the really permanent symbols into the table. */ + /* Also make them part of the permanent symbol table. */ + for( ix = 0; ix < DIM( really_permanent_symbols ); ix++ ) + { + defineSymbol( really_permanent_symbols[ix].name, + really_permanent_symbols[ix].val, + really_permanent_symbols[ix].type | DEFFIX , 0 ); + } + number_of_fixed_symbols = symbol_top; + fixed_symbols = &symtab[symbol_top - 1]; + + } + break; + + case FIELD: + /* Punch page 0 also */ + punchLiteralPool( cp, 1 ); + newfield = field >> 12; + lexstartsave = lexstartprev; + if( isdone( line[lexstart] )) + { + newfield += 1; /* Blank FIELD directive. */ + } + else + { + newfield = (getExpr())->val; /* FIELD with argument. */ + } + + if( rim_mode ) + { + errorMessage( &in_rim_mode, lexstartsave ); /* Can't change fields. */ + } + else if( newfield > 7 || newfield < 0 ) + { + errorMessage( &illegal_field_value, lexstartprev ); + } + else + { + value = (( newfield & 0007 ) << 3 ) | 00300; + punchObject( value ); + if( objectfile != NULL ) /* Only fix checksum if punching */ + { + checksum -= value; /* Field punches are not added to checksum. */ + } + field = newfield << 12; + } + + clc = 0200 | field; + fieldlc = clc & 07777; + + if( !rim_mode ) + { + punchOrigin( clc ); + } + + clearLiteralTable(); + + break; + + case FIXMRI: + if( line[lexterm] == '=' && isalpha( line[lexstart] )) + { + lexstartsave = lexstart; + term = lexterm; + nextLexeme(); /* Skip symbol. */ + nextLexeme(); /* Skip trailing = */ + defineLexeme( lexstartsave, term, getExprs(), MRI ); + } + else + { + errorLexeme( &symbol_syntax, lexstart ); + nextLexeme(); /* Skip symbol. */ + nextLexeme(); /* Skip trailing = */ + (void) getExprs(); /* Skip expression. */ + } + break; + + case FIXTAB: + if (pass == 1) /* Only fix on first pass, on second all are defined */ + { + /* Mark all current symbols as permanent symbols. */ + for( ix = 0; ix < symbol_top; ix++ ) + { + symtab[ix].type = symtab[ix].type | FIXED; + } + number_of_fixed_symbols = symbol_top; + fixed_symbols = &symtab[symbol_top - 1]; + + /* Re-sort the symbol table */ + qsort( symtab, symbol_top, sizeof(symtab[0]), compareSymbols ); + } + break; + + case FLTG: + inputFltg(); + /* errorSymbol( &no_pseudo_op, "FLTG", lexstartprev ); */ + break; + + case IFDEF: + if( isalpha( line[lexstart] )) + { + sym = evalSymbol(); + nextLexeme(); + if( M_DEFINED_CONDITIONALLY( sym->type )) + { + conditionTrue(); + } + else + { + conditionFalse(); + } + } + else + { + errorLexeme( &label_syntax, lexstart ); + } + break; + + case IFNDEF: + if( isalpha( line[lexstart] )) + { + sym = evalSymbol(); + nextLexeme(); + if( M_DEFINED_CONDITIONALLY( sym->type )) + { + conditionFalse(); + } + else + { + conditionTrue(); + } + } + else + { + errorLexeme( &label_syntax, lexstart ); + } + break; + + case IFNZERO: + if( getExprs() == 0 ) + { + conditionFalse(); + } + else + { + conditionTrue(); + } + break; + + case IFZERO: + if( getExprs() == 0 ) + { + conditionTrue(); + } + else + { + conditionFalse(); + } + break; + + case NOPUNCH: + if( pass == 2 ) + { + objectfile = NULL; + } + break; + + case OCTAL: + radix = 8; + break; + + case PAGE: + reloc_clc = clc + reloc; + punchLiteralPool( cp, 0 ); + oldclc = clc; + if( isdone( line[lexstart] )) + { + clc = (( reloc_clc + 0177 ) & 077600) - reloc; /* No argumnet. */ + fieldlc = clc & 07777; + } + else + { + value = (getExpr())->val; + clc = field + (( value & 037 ) << 7 ) - reloc; + fieldlc = clc & 07777; + } + testForLiteralCollision( clc + reloc ); + + if( !rim_mode && clc != oldclc ) + { + punchOrigin( clc ); + } + break; + + case PAUSE: + break; + + case RELOC: + if( isdone( line[lexstart] )) + { + reloc = 0; /* Blank RELOC directive. */ + } + else + { + value = (getExpr())->val; /* RELOC with argument. */ + reloc = (value & 07777) - ( clc & 07777); + } + break; + + case RIMPUNCH: + /* If the assembler has output any BIN data, output the literal tables */ + /* and the checksum for what has been assembled and setup for RIM mode. */ + if( binary_data_output && !rim_mode ) + { + endOfBinary(); + clearLiteralTable(); + punchChecksum(); + punchLeader( 8 ); /* Generate a short leader/trailer. */ + } + rim_mode = TRUE; + break; + + case SEGMNT: + punchLiteralPool( cp, 0 ); + if( isdone( line[lexstart] )) + { /* No argument. */ + clc = ( clc & 06000 ) + 02000; + fieldlc = clc & 07777; + } + else + { + getExpr(); + clc = ( val & 003 ) << 10; + fieldlc = clc & 07777; + } + if( !rim_mode ) + { + punchOrigin( clc ); + } + testForLiteralCollision( clc ); + break; + + case TEXT: + delim = line[lexstart]; + pack = 0; + count = 0; + index = lexstart + 1; + while( line[index] != delim && !isend( line[index] )) + { + pack = ( pack << 6 ) | ( line[index] & 077 ); + count++; + if( count > 1 ) + { + punchOutObject( clc, pack ); + incrementClc(); + count = 0; + pack = 0; + } + index++; + } + + if( count != 0 ) + { + punchOutObject( clc, pack << 6 ); + incrementClc(); + } + else + { + punchOutObject( clc, 0 ); + incrementClc(); + } + + if( isend( line[index] )) + { + cc = index; + lexterm = cc; + errorMessage( &text_string, cc ); + } + else + { + cc = index + 1; + lexterm = cc; + } + nextLexeme(); + break; + + case FILENAME: + memset(os8_name, 0, sizeof(os8_name)); + delimiter=line[lexstart]; + if (delimiter != '.') + { + for (index = lexstart, count = 0; index < lexterm && count < 6; index++) + { + os8_name[count++] = line[index]; + } + delimiter=line[lexterm]; + if (delimiter == '.') + { + nextLexeme(); /* Skip . */ + } + } + nextLexeme(); + if (delimiter == '.') + { + for (index = lexstart, count = 6; index < lexterm && count < 8; index++) + { + os8_name[count++] = line[index]; + } + } + + pack = 0; + count = 0; + for (count2 = 0; count2 < 8; count2++) + { + pack = ( pack << 6 ) | ( os8_name[count2] & 077 ); + count++; + if( count > 1 ) + { + punchOutObject( clc, pack ); + incrementClc(); + count = 0; + pack = 0; + } + } + nextLexeme(); + break; + + case DEVICE: + memset(os8_name, 0, sizeof(os8_name)); + for (index = lexstart, count = 0; index < lexterm && count < 4; index++) + { + os8_name[count++] = line[index]; + } + + pack = 0; + count = 0; + for (count2 = 0; count2 < 4; count2++) + { + pack = ( pack << 6 ) | ( os8_name[count2] & 077 ); + count++; + if( count > 1 ) + { + punchOutObject( clc, pack ); + incrementClc(); + count = 0; + pack = 0; + } + } + + nextLexeme(); + break; + + case TITLE: + delim = line[lexstart]; + ix = lexstart + 1; + /* Find string delimiter. */ + do + { + if( list_title[ix] == delim && list_title[ix + 1] == delim ) + { + ix++; + } + ix++; + } while( line[ix] != delim && !isend(line[ix]) ); + + if( line[ix] == delim ) + { + count = 0; + ix = lexstart + 1; + do + { + if( list_title[ix] == delim && list_title[ix + 1] == delim ) + { + ix++; + } + list_title[count] = line[ix]; + count++; + ix++; + list_title[count] = '\0'; + } while( line[ix] != delim && !isend(line[ix]) ); + + if( strlen( list_title ) > TITLELEN ) + { + list_title[TITLELEN] = '\0'; + } + + cc = ix + 1; + lexterm = cc; + page_lineno = LIST_LINES_PER_PAGE;/* Force top of page for new titles. */ + list_title_set = TRUE; + } + else + { + cc = ix; + lexterm = cc; + errorMessage( &text_string, cc ); + } + + nextLexeme(); + break; + + case XLIST: + if( isdone( line[lexstart] )) + { + temp = listfile; /* Blank XLIST directive. */ + listfile = listsave; + listsave = temp; + } + else + { + if( (getExpr())->val == 0 ) + { + if( listfile == NULL ) + { + listfile = listsave; + listsave = NULL; + } + } + else + { + if( listfile != NULL ) + { + listsave = listfile; + listfile = NULL; + } + } + } + break; + + case ZBLOCK: + value = (getExpr())->val; + if( value < 0 ) + { + errorMessage( &zblock_too_small, lexstartprev ); + } + else if( value + ( clc & 07777 ) - 1 > 07777 ) + { + errorMessage( &zblock_too_large, lexstartprev ); + } + else + { + for( ; value > 0; value-- ) + { + punchOutObject( clc, 0 ); + incrementClc(); + } + } + + break; + + default: + break; + } /* end switch for pseudo-ops */ + return( status ); +} /* pseudoOperators() */ + + +/******************************************************************************/ +/* */ +/* Function: conditionFalse */ +/* */ +/* Synopsis: Called when a false conditional has been evaluated. */ +/* Lex should be the opening <; ignore all text until */ +/* the closing >. */ +/* */ +/******************************************************************************/ +void conditionFalse() +{ + int level; + + if( line[lexstart] == '<' ) + { + /* Invariant: line[cc] is the next unexamined character. */ + level = 1; + while( level > 0 ) + { + if( isend( line[cc] )) + { + readLine(); + } + else + { + switch( line[cc] ) + { + case '>': + level--; + cc++; + break; + + case '<': + level++; + cc++; + break; + + case '$': + level = 0; + cc++; + break; + + default: + cc++; + break; + } /* end switch */ + } /* end if */ + } /* end while */ + nextLexeme(); + } + else + { + errorMessage( <_expected, lexstart ); + } +} /* conditionFalse() */ + +/******************************************************************************/ +/* */ +/* Function: conditionTrue */ +/* */ +/* Synopsis: Called when a true conditional has been evaluated. */ +/* Lex should be the opening <; skip it and setup for */ +/* normal assembly. */ +/* */ +/******************************************************************************/ +void conditionTrue() +{ + if( line[lexstart] == '<' ) + { + nextLexeme(); /* Skip the opening '<' */ + } + else + { + errorMessage( <_expected, lexstart ); + } +} /* conditionTrue() */ + + +/******************************************************************************/ +/* */ +/* Function: errorLexeme */ +/* */ +/* Synopsis: Display an error message using the current lexical element. */ +/* */ +/******************************************************************************/ +void errorLexeme( EMSG_T *mesg, int col ) +{ + char name[SYMLEN]; + + errorSymbol( mesg, lexemeToName( name, lexstart, lexterm ), col ); +} /* errorLexeme() */ + + +/******************************************************************************/ +/* */ +/* Function: errorSymbol */ +/* */ +/* Synopsis: Display an error message with a given string. */ +/* */ +/******************************************************************************/ +void errorSymbol( EMSG_T *mesg, char *name, int col ) +{ + char linecol[12]; + char *s; + + if( pass == 2 ) + { + s = ( name == NULL ) ? "" : name ; + errors++; + sprintf( linecol, "(%d:%d)", lineno, col + 1 ); + fprintf( errorfile, "%s%-9s : error: %s \"%s\" at Loc = %5.5o\n", + filename, linecol, mesg->file, s, clc ); + saveError( mesg->list, col ); + } + error_in_line = TRUE; +} /* errorSymbol() */ + + +/******************************************************************************/ +/* */ +/* Function: errorMessage */ +/* */ +/* Synopsis: Display an error message without a name argument. */ +/* */ +/******************************************************************************/ +void errorMessage( EMSG_T *mesg, int col ) +{ + char linecol[12]; + + if( pass == 2 ) + { + errors++; + sprintf( linecol, "(%d:%d)", lineno, col + 1 ); + fprintf( errorfile, "%s%-9s : error: %s at Loc = %5.5o\n", + filename, linecol, mesg->file, clc ); + saveError( mesg->list, col ); + } + error_in_line = TRUE; +} /* errorMessage() */ + +/******************************************************************************/ +/* */ +/* Function: saveError */ +/* */ +/* Synopsis: Save the current error in a list so it may displayed after the */ +/* the current line is printed. */ +/* */ +/******************************************************************************/ +void saveError( char *mesg, int col ) +{ + if( save_error_count < DIM( error_list )) + { + error_list[save_error_count].mesg = mesg; + error_list[save_error_count].col = col; + save_error_count++; + } + error_in_line = TRUE; + + if( listed ) + { + printErrorMessages(); + } +} /* saveError() */ +/* End-of-File */ ADDED pics/wy/back.jpg Index: pics/wy/back.jpg ================================================================== --- /dev/null +++ pics/wy/back.jpg cannot compute difference between binary files ADDED pics/wy/front.jpg Index: pics/wy/front.jpg ================================================================== --- /dev/null +++ pics/wy/front.jpg cannot compute difference between binary files ADDED pics/wy/power-switch.png Index: pics/wy/power-switch.png ================================================================== --- /dev/null +++ pics/wy/power-switch.png cannot compute difference between binary files ADDED pics/wy/serial-db9.jpg Index: pics/wy/serial-db9.jpg ================================================================== --- /dev/null +++ pics/wy/serial-db9.jpg cannot compute difference between binary files ADDED pics/wy/serial-kk.jpg Index: pics/wy/serial-kk.jpg ================================================================== --- /dev/null +++ pics/wy/serial-kk.jpg cannot compute difference between binary files ADDED pics/wy/system.jpg Index: pics/wy/system.jpg ================================================================== --- /dev/null +++ pics/wy/system.jpg cannot compute difference between binary files ADDED schematics/power-switch.gsch Index: schematics/power-switch.gsch ================================================================== --- /dev/null +++ schematics/power-switch.gsch @@ -0,0 +1,58 @@ +v 20130925 2 +C 39600 60100 1 0 0 5V-plus-1.sym +{ +T 39600 60100 5 10 1 1 0 0 1 +pinnumber=1 +} +C 39700 58200 1 0 0 gnd-1.sym +{ +T 39600 58400 5 10 1 1 0 0 1 +pinnumber=7 +} +C 40100 58200 1 0 0 gnd-1.sym +{ +T 40000 58400 5 10 1 1 0 0 1 +pinnumber=8 +} +C 40000 60100 1 0 0 5V-plus-1.sym +{ +T 40000 60100 5 10 1 1 0 0 1 +pinnumber=2 +} +C 38500 60600 1 270 0 switch-spst-1.sym +{ +T 39200 60200 5 10 0 0 270 0 1 +device=SPST +T 38800 60400 5 10 1 1 270 0 1 +refdes=Switch +} +N 40200 59300 40200 60100 4 +N 39800 58500 39800 58700 4 +N 40200 58500 40200 59000 4 +C 37900 60300 1 0 0 BNC-1.sym +{ +T 38250 60950 5 10 0 0 0 0 1 +device=BNC +T 37900 61000 5 10 1 1 0 0 1 +refdes=DC Jack +} +B 39400 57800 1200 3000 3 0 0 0 -1 -1 0 -1 -1 -1 -1 -1 +{ +T 40700 60100 5 10 1 1 270 0 1 +name=Expansion Port Pins +} +N 38000 60300 38000 58700 4 +N 38000 58700 39800 58700 4 +N 38000 59000 40200 59000 4 +N 39800 60100 39800 59600 4 +N 38500 59600 39800 59600 4 +N 38500 59300 38500 59800 4 +N 40200 59300 38500 59300 4 +N 38400 60800 38500 60800 4 +N 38500 60800 38500 60600 4 +T 37800 56300 9 10 1 0 0 0 5 +Copyright © 2016 by Warren Young + +This file is licensed under the terms of +the SIMH license, a copy of which is in +../SIMH-LICENSE.md. ADDED src/Makefile.in Index: src/Makefile.in ================================================================== --- /dev/null +++ src/Makefile.in @@ -0,0 +1,47 @@ +######################################################################## +# Makefile.in - Processed by autosetup's configure script to generate +# an intermediate GNU make(1) file for building the PiDP-8/I software +# from within its src/ subdirectory. +# +# The resulting Makefile will redirect simple "make" calls to the top +# level as well as the major top-level targets (e.g. "make clean") but +# purposefully will not redirect anything like an installation or "run +# the system" type target. Its only purpose is to help out those who +# are working on the PiDP-8/I project's C source code from within this +# directory. If you need to work on the wider system, do it from the +# project's top level. +# +# If you are seeing this at the top of a file called Makefile and you +# intend to make edits, do that in Makefile.in. Saying "make" will then +# re-build Makefile from that modified Makefile.in before proceeding to +# do the "make" operation. +# +# Copyright © 2017 Warren Young +# +# Permission is hereby granted, free of charge, to any person obtaining +# a copy of this software and associated documentation files (the +# "Software"), to deal in the Software without restriction, including +# without limitation the rights to use, copy, modify, merge, publish, +# distribute, sublicense, and/or sell copies of the Software, and to +# permit persons to whom the Software is furnished to do so, subject to +# the following conditions: +# +# The above copyright notice and this permission notice shall be +# included in all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +# IN NO EVENT SHALL THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, +# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT +# OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE +# OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +# +# Except as contained in this notice, the names of the authors above +# shall not be used in advertising or otherwise to promote the sale, +# use or other dealings in this Software without prior written +# authorization from those authors. +######################################################################## + +all clean ctags distclean tags reconfig: + cd @builddir@; make $@ ADDED src/PDP8/Makefile.in Index: src/PDP8/Makefile.in ================================================================== --- /dev/null +++ src/PDP8/Makefile.in @@ -0,0 +1,47 @@ +######################################################################## +# Makefile.in - Processed by autosetup's configure script to generate +# an intermediate GNU make(1) file for building the PiDP-8/I software +# from within its src/PDP8 subdirectory. +# +# The resulting Makefile will redirect simple "make" calls to the top +# level as well as the major top-level targets (e.g. "make clean") but +# purposefully will not redirect anything like an installation or "run +# the system" type target. Its only purpose is to help out those who +# are working on the PiDP-8/I project's C source code from within this +# directory. If you need to work on the wider system, do it from the +# project's top level. +# +# If you are seeing this at the top of a file called Makefile and you +# intend to make edits, do that in Makefile.in. Saying "make" will then +# re-build Makefile from that modified Makefile.in before proceeding to +# do the "make" operation. +# +# Copyright © 2017 Warren Young +# +# Permission is hereby granted, free of charge, to any person obtaining +# a copy of this software and associated documentation files (the +# "Software"), to deal in the Software without restriction, including +# without limitation the rights to use, copy, modify, merge, publish, +# distribute, sublicense, and/or sell copies of the Software, and to +# permit persons to whom the Software is furnished to do so, subject to +# the following conditions: +# +# The above copyright notice and this permission notice shall be +# included in all copies or substantial portions of the Software. +# +# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +# IN NO EVENT SHALL THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, +# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT +# OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE +# OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. +# +# Except as contained in this notice, the names of the authors above +# shall not be used in advertising or otherwise to promote the sale, +# use or other dealings in this Software without prior written +# authorization from those authors. +######################################################################## + +all clean ctags distclean tags reconfig: + cd @builddir@; make $@ ADDED src/PDP8/pdp8_clk.c Index: src/PDP8/pdp8_clk.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_clk.c @@ -0,0 +1,183 @@ +/* pdp8_clk.c: PDP-8 real-time clock simulator + + Copyright (c) 1993-2012, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + clk real time clock + + 18-Apr-12 RMS Added clock coscheduling + 18-Jun-07 RMS Added UNIT_IDLE flag + 01-Mar-03 RMS Aded SET/SHOW CLK FREQ support + 04-Oct-02 RMS Added DIB, device number support + 30-Dec-01 RMS Removed for generalized timers + 05-Sep-01 RMS Added terminal multiplexor support + 17-Jul-01 RMS Moved function prototype + 05-Mar-01 RMS Added clock calibration support + + Note: includes the IOT's for both the PDP-8/E and PDP-8/A clocks +*/ + +#include "pdp8_defs.h" + +extern int32 int_req, int_enable, dev_done, stop_inst; + +int32 clk_tps = 60; /* ticks/second */ +int32 tmxr_poll = 16000; /* term mux poll */ + +int32 clk (int32 IR, int32 AC); +t_stat clk_svc (UNIT *uptr); +t_stat clk_reset (DEVICE *dptr); +t_stat clk_set_freq (UNIT *uptr, int32 val, CONST char *cptr, void *desc); +t_stat clk_show_freq (FILE *st, UNIT *uptr, int32 val, CONST void *desc); + +/* CLK data structures + + clk_dev CLK device descriptor + clk_unit CLK unit descriptor + clk_reg CLK register list +*/ + +DIB clk_dib = { DEV_CLK, 1, { &clk } }; + +UNIT clk_unit = { UDATA (&clk_svc, UNIT_IDLE, 0), 16000 }; + +REG clk_reg[] = { + { FLDATAD (DONE, dev_done, INT_V_CLK, "device done flag") }, + { FLDATAD (ENABLE, int_enable, INT_V_CLK, "interrupt enable flag") }, + { FLDATAD (INT, int_req, INT_V_CLK, "interrupt pending flag") }, + { DRDATAD (TIME, clk_unit.wait, 24, "clock interval"), REG_NZ + PV_LEFT }, + { DRDATA (TPS, clk_tps, 8), PV_LEFT + REG_HRO }, + { NULL } + }; + +MTAB clk_mod[] = { + { MTAB_XTD|MTAB_VDV, 50, NULL, "50HZ", + &clk_set_freq, NULL, NULL }, + { MTAB_XTD|MTAB_VDV, 60, NULL, "60HZ", + &clk_set_freq, NULL, NULL }, + { MTAB_XTD|MTAB_VDV, 0, "FREQUENCY", NULL, + NULL, &clk_show_freq, NULL }, + { MTAB_XTD|MTAB_VDV, 0, "DEVNO", NULL, NULL, &show_dev }, + { 0 } + }; + +DEVICE clk_dev = { + "CLK", &clk_unit, clk_reg, clk_mod, + 1, 0, 0, 0, 0, 0, + NULL, NULL, &clk_reset, + NULL, NULL, NULL, + &clk_dib, 0 + }; + +/* IOT routine + + IOT's 6131-6133 are the PDP-8/E clock + IOT's 6135-6137 are the PDP-8/A clock +*/ + +int32 clk (int32 IR, int32 AC) +{ +switch (IR & 07) { /* decode IR<9:11> */ + + case 1: /* CLEI */ + int_enable = int_enable | INT_CLK; /* enable clk ints */ + int_req = INT_UPDATE; /* update interrupts */ + return AC; + + case 2: /* CLDI */ + int_enable = int_enable & ~INT_CLK; /* disable clk ints */ + int_req = int_req & ~INT_CLK; /* update interrupts */ + return AC; + + case 3: /* CLSC */ + if (dev_done & INT_CLK) { /* flag set? */ + dev_done = dev_done & ~INT_CLK; /* clear flag */ + int_req = int_req & ~INT_CLK; /* clear int req */ + return IOT_SKP + AC; + } + return AC; + + case 5: /* CLLE */ + if (AC & 1) /* test AC<11> */ + int_enable = int_enable | INT_CLK; + else int_enable = int_enable & ~INT_CLK; + int_req = INT_UPDATE; /* update interrupts */ + return AC; + + case 6: /* CLCL */ + dev_done = dev_done & ~INT_CLK; /* clear flag */ + int_req = int_req & ~INT_CLK; /* clear int req */ + return AC; + + case 7: /* CLSK */ + return (dev_done & INT_CLK)? IOT_SKP + AC: AC; + + default: + return (stop_inst << IOT_V_REASON) + AC; + } /* end switch */ +} + +/* Unit service */ + +t_stat clk_svc (UNIT *uptr) +{ +dev_done = dev_done | INT_CLK; /* set done */ +int_req = INT_UPDATE; /* update interrupts */ +tmxr_poll = sim_rtcn_calb (clk_tps, TMR_CLK); /* calibrate clock */ +sim_activate_after (uptr, 1000000/clk_tps); /* reactivate unit */ +return SCPE_OK; +} + +/* Reset routine */ + +t_stat clk_reset (DEVICE *dptr) +{ +dev_done = dev_done & ~INT_CLK; /* clear done, int */ +int_req = int_req & ~INT_CLK; +int_enable = int_enable & ~INT_CLK; /* clear enable */ +if (!sim_is_running) { /* RESET (not CAF)? */ + tmxr_poll = sim_rtcn_init_unit (&clk_unit, clk_unit.wait, TMR_CLK);/* init 100Hz timer */ + sim_activate_after (&clk_unit, 1000000/clk_tps); /* activate 100Hz unit */ + } +return SCPE_OK; +} + +/* Set frequency */ + +t_stat clk_set_freq (UNIT *uptr, int32 val, CONST char *cptr, void *desc) +{ +if (cptr) + return SCPE_ARG; +if ((val != 50) && (val != 60)) + return SCPE_IERR; +clk_tps = val; +return SCPE_OK; +} + +/* Show frequency */ + +t_stat clk_show_freq (FILE *st, UNIT *uptr, int32 val, CONST void *desc) +{ +fprintf (st, (clk_tps == 50)? "50Hz": "60Hz"); +return SCPE_OK; +} ADDED src/PDP8/pdp8_cpu.c Index: src/PDP8/pdp8_cpu.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_cpu.c @@ -0,0 +1,1727 @@ +/* pdp8_cpu.c: PDP-8 CPU simulator + + Copyright (c) 1993-2016, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + ---------------------------------------------------------------------------- + + Portions copyright (c) 2015-2017, Oscar Vermeulen, Ian Schofield, and + Warren Young + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the names of the authors above shall + not be used in advertising or otherwise to promote the sale, use or other + dealings in this Software without prior written authorization from those + authors. + + ---------------------------------------------------------------------------- + + cpu central processor + + 18-Sep-16 RMS Added alternate dispatch table for non-contiguous devices + 17-Sep-13 RMS Fixed boot in wrong field problem (Dave Gesswein) + 28-Apr-07 RMS Removed clock initialization + 30-Oct-06 RMS Added idle and infinite loop detection + 30-Sep-06 RMS Fixed SC value after DVI overflow (Don North) + 22-Sep-05 RMS Fixed declarations (Sterling Garwood) + 16-Aug-05 RMS Fixed C++ declaration and cast problems + 06-Nov-04 RMS Added =n to SHOW HISTORY + 31-Dec-03 RMS Fixed bug in set_cpu_hist + 13-Oct-03 RMS Added instruction history + Added TSC8-75 support (Bernhard Baehr) + 12-Mar-03 RMS Added logical name support + 04-Oct-02 RMS Revamped device dispatching, added device number support + 06-Jan-02 RMS Added device enable/disable routines + 30-Dec-01 RMS Added old PC queue + 16-Dec-01 RMS Fixed bugs in EAE + 07-Dec-01 RMS Revised to use new breakpoint package + 30-Nov-01 RMS Added RL8A, extended SET/SHOW support + 16-Sep-01 RMS Fixed bug in reset routine, added KL8A support + 10-Aug-01 RMS Removed register from declarations + 17-Jul-01 RMS Moved function prototype + 07-Jun-01 RMS Fixed bug in JMS to non-existent memory + 25-Apr-01 RMS Added device enable/disable support + 18-Mar-01 RMS Added DF32 support + 05-Mar-01 RMS Added clock calibration support + 15-Feb-01 RMS Added DECtape support + 14-Apr-99 RMS Changed t_addr to unsigned + + The register state for the PDP-8 is: + + AC<0:11> accumulator + MQ<0:11> multiplier-quotient + L link flag + PC<0:11> program counter + IF<0:2> instruction field + IB<0:2> instruction buffer + DF<0:2> data field + UF user flag + UB user buffer + SF<0:6> interrupt save field + + The PDP-8 has three instruction formats: memory reference, I/O transfer, + and operate. The memory reference format is: + + 0 1 2 3 4 5 6 7 8 9 10 11 + +--+--+--+--+--+--+--+--+--+--+--+--+ + | op |in|zr| page offset | memory reference + +--+--+--+--+--+--+--+--+--+--+--+--+ + + <0:2> mnemonic action + + 000 AND AC = AC & M[MA] + 001 TAD L'AC = AC + M[MA] + 010 DCA M[MA] = AC, AC = 0 + 011 ISZ M[MA] = M[MA] + 1, skip if M[MA] == 0 + 100 JMS M[MA] = PC, PC = MA + 1 + 101 JMP PC = MA + + <3:4> mode action + 00 page zero MA = IF'0'IR<5:11> + 01 current page MA = IF'PC<0:4>'IR<5:11> + 10 indirect page zero MA = xF'M[IF'0'IR<5:11>] + 11 indirect current page MA = xF'M[IF'PC<0:4>'IR<5:11>] + + where x is D for AND, TAD, ISZ, DCA, and I for JMS, JMP. + + Memory reference instructions can access an address space of 32K words. + The address space is divided into eight 4K word fields; each field is + divided into thirty-two 128 word pages. An instruction can directly + address, via its 7b offset, locations 0-127 on page zero or on the current + page. All 32k words can be accessed via indirect addressing and the + instruction and data field registers. If an indirect address is in + locations 0010-0017 of any field, the indirect address is incremented + and rewritten to memory before use. + + The I/O transfer format is as follows: + + 0 1 2 3 4 5 6 7 8 9 10 11 + +--+--+--+--+--+--+--+--+--+--+--+--+ + | op | device | pulse | I/O transfer + +--+--+--+--+--+--+--+--+--+--+--+--+ + + The IO transfer instruction sends the the specified pulse to the + specified I/O device. The I/O device may take data from the AC, + return data to the AC, initiate or cancel operations, or skip on + status. + + The operate format is as follows: + + +--+--+--+--+--+--+--+--+--+--+--+--+ + | 1| 1| 1| 0| | | | | | | | | operate group 1 + +--+--+--+--+--+--+--+--+--+--+--+--+ + | | | | | | | | + | | | | | | | +--- increment AC 3 + | | | | | | +--- rotate 1 or 2 4 + | | | | | +--- rotate left 4 + | | | | +--- rotate right 4 + | | | +--- complement L 2 + | | +--- complement AC 2 + | +--- clear L 1 + +-- clear AC 1 + + +--+--+--+--+--+--+--+--+--+--+--+--+ + | 1| 1| 1| 1| | | | | | | | 0| operate group 2 + +--+--+--+--+--+--+--+--+--+--+--+--+ + | | | | | | | + | | | | | | +--- halt 3 + | | | | | +--- or switch register 3 + | | | | +--- reverse skip sense 1 + | | | +--- skip on L != 0 1 + | | +--- skip on AC == 0 1 + | +--- skip on AC < 0 1 + +-- clear AC 2 + + +--+--+--+--+--+--+--+--+--+--+--+--+ + | 1| 1| 1| 1| | | | | | | | 1| operate group 3 + +--+--+--+--+--+--+--+--+--+--+--+--+ + | | | | \______/ + | | | | | + | | +--|-----+--- EAE command 3 + | | +--- AC -> MQ, 0 -> AC 2 + | +--- MQ v AC --> AC 2 + +-- clear AC 1 + + The operate instruction can be microprogrammed to perform operations + on the AC, MQ, and link. + + This routine is the instruction decode routine for the PDP-8. + It is called from the simulator control program to execute + instructions in simulated memory, starting at the simulated PC. + It runs until 'reason' is set non-zero. + + General notes: + + 1. Reasons to stop. The simulator can be stopped by: + + HALT instruction + breakpoint encountered + unimplemented instruction and stop_inst flag set + I/O error in I/O simulator + + 2. Interrupts. Interrupts are maintained by three parallel variables: + + dev_done device done flags + int_enable interrupt enable flags + int_req interrupt requests + + In addition, int_req contains the interrupt enable flag, the + CIF not pending flag, and the ION not pending flag. If all + three of these flags are set, and at least one interrupt request + is set, then an interrupt occurs. + + 3. Non-existent memory. On the PDP-8, reads to non-existent memory + return zero, and writes are ignored. In the simulator, the + largest possible memory is instantiated and initialized to zero. + Thus, only writes outside the current field (indirect writes) need + be checked against actual memory size. + + 3. Adding I/O devices. These modules must be modified: + + pdp8_defs.h add device number and interrupt definitions + pdp8_sys.c add sim_devices table entry +*/ + +/* ---PiDP change------------------------------------------------------------------------------------------- */ +#include "pidp8i.h" +/* ---PiDP end---------------------------------------------------------------------------------------------- */ + +#define PCQ_SIZE 64 /* must be 2**n */ +#define PCQ_MASK (PCQ_SIZE - 1) +#define PCQ_ENTRY pcq[pcq_p = (pcq_p - 1) & PCQ_MASK] = MA +#define UNIT_V_NOEAE (UNIT_V_UF) /* EAE absent */ +#define UNIT_NOEAE (1 << UNIT_V_NOEAE) +#define UNIT_V_MSIZE (UNIT_V_UF + 1) /* dummy mask */ +#define UNIT_MSIZE (1 << UNIT_V_MSIZE) +#define OP_KSF 06031 /* for idle */ + +#define HIST_PC 0x40000000 +#define HIST_MIN 64 +#define HIST_MAX 65536 + +typedef struct { + int32 pc; + int32 ea; + int16 ir; + int16 opnd; + int16 lac; + int16 mq; + } InstHistory; + +uint16 M[MAXMEMSIZE] = { 0 }; /* main memory */ +int32 saved_LAC = 0; /* saved L'AC */ +int32 saved_MQ = 0; /* saved MQ */ +int32 saved_PC = 0; /* saved IF'PC */ +int32 saved_DF = 0; /* saved Data Field */ +int32 IB = 0; /* Instruction Buffer */ +int32 SF = 0; /* Save Field */ +int32 emode = 0; /* EAE mode */ +int32 gtf = 0; /* EAE gtf flag */ +int32 SC = 0; /* EAE shift count */ +int32 UB = 0; /* User mode Buffer */ +int32 UF = 0; /* User mode Flag */ +int32 OSR = 0; /* Switch Register */ +int32 tsc_ir = 0; /* TSC8-75 IR */ +int32 tsc_pc = 0; /* TSC8-75 PC */ +int32 tsc_cdf = 0; /* TSC8-75 CDF flag */ +int32 tsc_enb = 0; /* TSC8-75 enabled */ +int32 cpu_astop = 0; /* address stop */ +int16 pcq[PCQ_SIZE] = { 0 }; /* PC queue */ +int32 pcq_p = 0; /* PC queue ptr */ +REG *pcq_r = NULL; /* PC queue reg ptr */ +int32 dev_done = 0; /* dev done flags */ +int32 int_enable = INT_INIT_ENABLE; /* intr enables */ +int32 int_req = 0; /* intr requests */ +int32 stop_inst = 0; /* trap on ill inst */ +int32 (*dev_tab[DEV_MAX])(int32 IR, int32 dat); /* device dispatch */ +int32 hst_p = 0; /* history pointer */ +int32 hst_lnt = 0; /* history length */ +InstHistory *hst = NULL; /* instruction history */ + +t_stat cpu_ex (t_value *vptr, t_addr addr, UNIT *uptr, int32 sw); +t_stat cpu_dep (t_value val, t_addr addr, UNIT *uptr, int32 sw); +t_stat cpu_reset (DEVICE *dptr); +t_stat cpu_set_size (UNIT *uptr, int32 val, CONST char *cptr, void *desc); +t_stat cpu_set_hist (UNIT *uptr, int32 val, CONST char *cptr, void *desc); +t_stat cpu_show_hist (FILE *st, UNIT *uptr, int32 val, CONST void *desc); +t_bool build_dev_tab (void); + +/* CPU data structures + + cpu_dev CPU device descriptor + cpu_unit CPU unit descriptor + cpu_reg CPU register list + cpu_mod CPU modifier list +*/ + +UNIT cpu_unit = { UDATA (NULL, UNIT_FIX + UNIT_BINK, MAXMEMSIZE) }; + +REG cpu_reg[] = { + { ORDATAD (PC, saved_PC, 15, "program counter") }, + { ORDATAD (AC, saved_LAC, 12, "accumulator") }, + { FLDATAD (L, saved_LAC, 12, "link") }, + { ORDATAD (MQ, saved_MQ, 12, "multiplier-quotient") }, + { ORDATAD (SR, OSR, 12, "front panel switches") }, + { GRDATAD (IF, saved_PC, 8, 3, 12, "instruction field") }, + { GRDATAD (DF, saved_DF, 8, 3, 12, "data field") }, + { GRDATAD (IB, IB, 8, 3, 12, "instruction field buffter") }, + { ORDATAD (SF, SF, 7, "save field") }, + { FLDATAD (UB, UB, 0, "user mode buffer") }, + { FLDATAD (UF, UF, 0, "user mode flag") }, + { ORDATAD (SC, SC, 5, "EAE shift counter") }, + { FLDATAD (GTF, gtf, 0, "EAE greater than flag") }, + { FLDATAD (EMODE, emode, 0, "EAE mode (0 = A, 1 = B)") }, + { FLDATAD (ION, int_req, INT_V_ION, "interrupt enable") }, + { FLDATAD (ION_DELAY, int_req, INT_V_NO_ION_PENDING, "interrupt enable delay for ION") }, + { FLDATAD (CIF_DELAY, int_req, INT_V_NO_CIF_PENDING, "interrupt enable delay for CIF") }, + { FLDATAD (PWR_INT, int_req, INT_V_PWR, "power fail interrupt") }, + { FLDATAD (UF_INT, int_req, INT_V_UF, "user mode violation interrupt") }, + { ORDATAD (INT, int_req, INT_V_ION+1, "interrupt pending flags"), REG_RO }, + { ORDATAD (DONE, dev_done, INT_V_DIRECT, "device done flags"), REG_RO }, + { ORDATAD (ENABLE, int_enable, INT_V_DIRECT, "device interrupt enable flags"), REG_RO }, + { BRDATAD (PCQ, pcq, 8, 15, PCQ_SIZE, "PC prior to last JMP, JMS, or interrupt; most recent PC change first"), REG_RO+REG_CIRC }, + { ORDATA (PCQP, pcq_p, 6), REG_HRO }, + { FLDATAD (STOP_INST, stop_inst, 0, "stop on undefined instruction") }, + { ORDATAD (WRU, sim_int_char, 8, "interrupt character") }, + { NULL } + }; + +MTAB cpu_mod[] = { + { UNIT_NOEAE, UNIT_NOEAE, "no EAE", "NOEAE", NULL }, + { UNIT_NOEAE, 0, "EAE", "EAE", NULL }, + { MTAB_XTD|MTAB_VDV, 0, "IDLE", "IDLE", &sim_set_idle, &sim_show_idle }, + { MTAB_XTD|MTAB_VDV, 0, NULL, "NOIDLE", &sim_clr_idle, NULL }, + { UNIT_MSIZE, 4096, NULL, "4K", &cpu_set_size }, + { UNIT_MSIZE, 8192, NULL, "8K", &cpu_set_size }, + { UNIT_MSIZE, 12288, NULL, "12K", &cpu_set_size }, + { UNIT_MSIZE, 16384, NULL, "16K", &cpu_set_size }, + { UNIT_MSIZE, 20480, NULL, "20K", &cpu_set_size }, + { UNIT_MSIZE, 24576, NULL, "24K", &cpu_set_size }, + { UNIT_MSIZE, 28672, NULL, "28K", &cpu_set_size }, + { UNIT_MSIZE, 32768, NULL, "32K", &cpu_set_size }, + { MTAB_XTD|MTAB_VDV|MTAB_NMO|MTAB_SHP, 0, "HISTORY", "HISTORY", + &cpu_set_hist, &cpu_show_hist }, + { 0 } + }; + +DEVICE cpu_dev = { + "CPU", &cpu_unit, cpu_reg, cpu_mod, + 1, 8, 15, 1, 8, 12, + &cpu_ex, &cpu_dep, &cpu_reset, + NULL, NULL, NULL, + NULL, 0 + }; + + +t_stat sim_instr (void) +{ +int32 IR, MB, IF, DF, LAC, MQ; +uint32 PC, MA; +int32 device, pulse, temp, iot_data; +t_stat reason; + +/* Restore register state */ + +if (build_dev_tab ()) /* build dev_tab */ + return SCPE_STOP; +PC = saved_PC & 007777; /* load local copies */ +IF = saved_PC & 070000; +DF = saved_DF & 070000; +LAC = saved_LAC & 017777; +MQ = saved_MQ & 07777; +int_req = INT_UPDATE; +reason = 0; + + +/* ---PiDP add--------------------------------------------------------------------------------------------- */ +// Set some register values we care about which may not get values +// before we need them, and which weren't set above. +MA = MB = IR = 0; + +// Light up LEDs for 1st time. Only needed when STOP switch set at start. +set_pidp8i_leds(PC, MA, MB, IR, LAC, MQ, IF, DF, SC, int_req, + pls_fetch); +/* ---PiDP end---------------------------------------------------------------------------------------------- */ + + +/* Main instruction fetch/decode loop */ + +while (reason == 0) { /* loop until halted */ + +/* ---PiDP add--------------------------------------------------------------------------------------------- */ + awfulHackFlag = 0; // no do script pending. Did I mention awful? +/* ---PiDP end---------------------------------------------------------------------------------------------- */ + + if (sim_interval <= 0) { /* check clock queue */ + if ((reason = sim_process_event ())) + break; + } + +/* ---PiDP add--------------------------------------------------------------------------------------------- */ + + switch (handle_flow_control_switches(M, &PC, &MA, &MB, &LAC, &IF, + &DF, &int_req)) { + case pft_stop: + // Don't choke off the SIMH event queue handler. + sim_interval = sim_interval - 1; + + // Update LEDs even in STOP mode. + // + // Note M[MA] used in this call, not MB. If we pass MB, the + // simulator never processes Ctrl-E in STOP mode. FIXME? + set_pidp8i_leds(PC, MA, M[MA], IR, LAC, MQ, IF, DF, SC, + int_req, pls_fetch); + + // Go no further in STOP mode. In particular, fetch no more + // instructions, and do not touch PC! + continue; + + case pft_halt: + // Clear all registers and halt simulator + PC = saved_PC = 0; + IF = saved_PC = 0; + DF = saved_DF = 0; + LAC = saved_LAC = 0; + MQ = saved_MQ = 0; + int_req = 0; + reason = STOP_HALT; + continue; + + case pft_normal: + // execute normally + break; + } + +/* ---PiDP end---------------------------------------------------------------------------------------------- */ + + if (int_req > INT_PENDING) { /* interrupt? */ + int_req = int_req & ~INT_ION; /* interrupts off */ + SF = (UF << 6) | (IF >> 9) | (DF >> 12); /* form save field */ + IF = IB = DF = UF = UB = 0; /* clear mem ext */ + PCQ_ENTRY; /* save old PC */ + M[0] = PC; /* save PC in 0 */ + PC = 1; /* fetch next from 1 */ + } + + MA = IF | PC; /* form PC */ + if (sim_brk_summ && + sim_brk_test (MA, (1u << SIM_BKPT_V_SPC) | SWMASK ('E'))) { /* breakpoint? */ + reason = STOP_IBKPT; /* stop simulation */ + break; + } + + IR = M[MA]; /* fetch instruction */ + + int_req = int_req | INT_NO_ION_PENDING; /* clear ION delay */ + sim_interval = sim_interval - 1; + +/* ---PiDP add--------------------------------------------------------------------------------------------- */ + + // Update the front panel LEDs with the results of our instruction + // fetch. This is above the goto label below because while in + // single instruction mode, there is no point updating the LEDs + // until we fetch another instruction, as above. Until we get + // another CONT press and fetch another instruction, the LEDs are + // already set correctly. + set_pidp8i_leds(PC, MA, M[MA], IR, LAC, MQ, IF, DF, SC, + int_req, pls_fetch); + +/* ---PiDP end---------------------------------------------------------------------------------------------- */ + + PC = (PC + 1) & 07777; /* increment PC */ + +/* Instruction decoding. + + The opcode (IR<0:2>), indirect flag (IR<3>), and page flag (IR<4>) + are decoded together. This produces 32 decode points, four per + major opcode. For IOT, the extra decode points are not useful; + for OPR, only the group flag (IR<3>) is used. + + AND, TAD, ISZ, DCA calculate a full 15b effective address. + JMS, JMP calculate a 12b field-relative effective address. + + Autoindex calculations always occur within the same field as the + instruction fetch. The field must exist; otherwise, the instruction + fetched would be 0000, and indirect addressing could not occur. + + Note that MA contains IF'PC. +*/ + + if (hst_lnt) { /* history enabled? */ + int32 ea; + + hst_p = (hst_p + 1); /* next entry */ + if (hst_p >= hst_lnt) + hst_p = 0; + hst[hst_p].pc = MA | HIST_PC; /* save PC, IR, LAC, MQ */ + hst[hst_p].ir = IR; + hst[hst_p].lac = LAC; + hst[hst_p].mq = MQ; + if (IR < 06000) { /* mem ref? */ + if (IR & 0200) + ea = (MA & 077600) | (IR & 0177); + else ea = IF | (IR & 0177); /* direct addr */ + if (IR & 0400) { /* indirect? */ + if (IR < 04000) { /* mem operand? */ + if ((ea & 07770) != 00010) + ea = DF | M[ea]; + else ea = DF | ((M[ea] + 1) & 07777); + } + else { /* no, jms/jmp */ + if ((ea & 07770) != 00010) + ea = IB | M[ea]; + else ea = IB | ((M[ea] + 1) & 07777); + } + } + hst[hst_p].ea = ea; /* save eff addr */ + hst[hst_p].opnd = M[ea]; /* save operand */ + } + } + +switch ((IR >> 7) & 037) { /* decode IR<0:4> */ + +/* Opcode 0, AND */ + + case 000: /* AND, dir, zero */ + MA = IF | (IR & 0177); /* dir addr, page zero */ + LAC = LAC & (M[MA] | 010000); + break; + + case 001: /* AND, dir, curr */ + MA = (MA & 077600) | (IR & 0177); /* dir addr, curr page */ + LAC = LAC & (M[MA] | 010000); + break; + + case 002: /* AND, indir, zero */ + MA = IF | (IR & 0177); /* dir addr, page zero */ + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = DF | M[MA]; + else MA = DF | (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + LAC = LAC & (M[MA] | 010000); + break; + + case 003: /* AND, indir, curr */ + MA = (MA & 077600) | (IR & 0177); /* dir addr, curr page */ + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = DF | M[MA]; + else MA = DF | (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + LAC = LAC & (M[MA] | 010000); + break; + +/* Opcode 1, TAD */ + + case 004: /* TAD, dir, zero */ + MA = IF | (IR & 0177); /* dir addr, page zero */ + LAC = (LAC + M[MA]) & 017777; + break; + + case 005: /* TAD, dir, curr */ + MA = (MA & 077600) | (IR & 0177); /* dir addr, curr page */ + LAC = (LAC + M[MA]) & 017777; + break; + + case 006: /* TAD, indir, zero */ + MA = IF | (IR & 0177); /* dir addr, page zero */ + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = DF | M[MA]; + else MA = DF | (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + LAC = (LAC + M[MA]) & 017777; + break; + + case 007: /* TAD, indir, curr */ + MA = (MA & 077600) | (IR & 0177); /* dir addr, curr page */ + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = DF | M[MA]; + else MA = DF | (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + LAC = (LAC + M[MA]) & 017777; + break; + +/* Opcode 2, ISZ */ + + case 010: /* ISZ, dir, zero */ + MA = IF | (IR & 0177); /* dir addr, page zero */ + M[MA] = MB = (M[MA] + 1) & 07777; /* field must exist */ + if (MB == 0) + PC = (PC + 1) & 07777; + break; + + case 011: /* ISZ, dir, curr */ + MA = (MA & 077600) | (IR & 0177); /* dir addr, curr page */ + M[MA] = MB = (M[MA] + 1) & 07777; /* field must exist */ + if (MB == 0) + PC = (PC + 1) & 07777; + break; + + case 012: /* ISZ, indir, zero */ + MA = IF | (IR & 0177); /* dir addr, page zero */ + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = DF | M[MA]; + else MA = DF | (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + MB = (M[MA] + 1) & 07777; + if (MEM_ADDR_OK (MA)) + M[MA] = MB; + if (MB == 0) + PC = (PC + 1) & 07777; + break; + + case 013: /* ISZ, indir, curr */ + MA = (MA & 077600) | (IR & 0177); /* dir addr, curr page */ + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = DF | M[MA]; + else MA = DF | (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + MB = (M[MA] + 1) & 07777; + if (MEM_ADDR_OK (MA)) + M[MA] = MB; + if (MB == 0) + PC = (PC + 1) & 07777; + break; + +/* Opcode 3, DCA */ + + case 014: /* DCA, dir, zero */ + MA = IF | (IR & 0177); /* dir addr, page zero */ + M[MA] = LAC & 07777; + LAC = LAC & 010000; + break; + + case 015: /* DCA, dir, curr */ + MA = (MA & 077600) | (IR & 0177); /* dir addr, curr page */ + M[MA] = LAC & 07777; + LAC = LAC & 010000; + break; + + case 016: /* DCA, indir, zero */ + MA = IF | (IR & 0177); /* dir addr, page zero */ + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = DF | M[MA]; + else MA = DF | (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + if (MEM_ADDR_OK (MA)) + M[MA] = LAC & 07777; + LAC = LAC & 010000; + break; + + case 017: /* DCA, indir, curr */ + MA = (MA & 077600) | (IR & 0177); /* dir addr, curr page */ + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = DF | M[MA]; + else MA = DF | (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + if (MEM_ADDR_OK (MA)) + M[MA] = LAC & 07777; + LAC = LAC & 010000; + break; + +/* Opcode 4, JMS. From Bernhard Baehr's description of the TSC8-75: + + (In user mode) the current JMS opcode is moved to the ERIOT register, the ECDF + flag is cleared. The address of the JMS instruction is loaded into the ERTB + register and the TSC8-75 I/O flag is raised. When the TSC8-75 is enabled, the + target addess of the JMS is loaded into PC, but nothing else (loading of IF, UF, + clearing the interrupt inhibit flag, storing of the return address in the first + word of the subroutine) happens. When the TSC8-75 is disabled, the JMS is performed + as usual. */ + + case 020: /* JMS, dir, zero */ + PCQ_ENTRY; + MA = IR & 0177; /* dir addr, page zero */ + if (UF) { /* user mode? */ + tsc_ir = IR; /* save instruction */ + tsc_cdf = 0; /* clear flag */ + } + if (UF && tsc_enb) { /* user mode, TSC enab? */ + tsc_pc = (PC - 1) & 07777; /* save PC */ + int_req = int_req | INT_TSC; /* request intr */ + } + else { /* normal */ + IF = IB; /* change IF */ + UF = UB; /* change UF */ + int_req = int_req | INT_NO_CIF_PENDING; /* clr intr inhibit */ + MA = IF | MA; + if (MEM_ADDR_OK (MA)) + M[MA] = PC; + } + PC = (MA + 1) & 07777; + break; + + case 021: /* JMS, dir, curr */ + PCQ_ENTRY; + MA = (MA & 007600) | (IR & 0177); /* dir addr, curr page */ + if (UF) { /* user mode? */ + tsc_ir = IR; /* save instruction */ + tsc_cdf = 0; /* clear flag */ + } + if (UF && tsc_enb) { /* user mode, TSC enab? */ + tsc_pc = (PC - 1) & 07777; /* save PC */ + int_req = int_req | INT_TSC; /* request intr */ + } + else { /* normal */ + IF = IB; /* change IF */ + UF = UB; /* change UF */ + int_req = int_req | INT_NO_CIF_PENDING; /* clr intr inhibit */ + MA = IF | MA; + if (MEM_ADDR_OK (MA)) + M[MA] = PC; + } + PC = (MA + 1) & 07777; + break; + + case 022: /* JMS, indir, zero */ + PCQ_ENTRY; + MA = IF | (IR & 0177); /* dir addr, page zero */ + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = M[MA]; + else MA = (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + if (UF) { /* user mode? */ + tsc_ir = IR; /* save instruction */ + tsc_cdf = 0; /* clear flag */ + } + if (UF && tsc_enb) { /* user mode, TSC enab? */ + tsc_pc = (PC - 1) & 07777; /* save PC */ + int_req = int_req | INT_TSC; /* request intr */ + } + else { /* normal */ + IF = IB; /* change IF */ + UF = UB; /* change UF */ + int_req = int_req | INT_NO_CIF_PENDING; /* clr intr inhibit */ + MA = IF | MA; + if (MEM_ADDR_OK (MA)) + M[MA] = PC; + } + PC = (MA + 1) & 07777; + break; + + case 023: /* JMS, indir, curr */ + PCQ_ENTRY; + MA = (MA & 077600) | (IR & 0177); /* dir addr, curr page */ + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = M[MA]; + else MA = (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + if (UF) { /* user mode? */ + tsc_ir = IR; /* save instruction */ + tsc_cdf = 0; /* clear flag */ + } + if (UF && tsc_enb) { /* user mode, TSC enab? */ + tsc_pc = (PC - 1) & 07777; /* save PC */ + int_req = int_req | INT_TSC; /* request intr */ + } + else { /* normal */ + IF = IB; /* change IF */ + UF = UB; /* change UF */ + int_req = int_req | INT_NO_CIF_PENDING; /* clr intr inhibit */ + MA = IF | MA; + if (MEM_ADDR_OK (MA)) + M[MA] = PC; + } + PC = (MA + 1) & 07777; + break; + +/* Opcode 5, JMP. From Bernhard Baehr's description of the TSC8-75: + + (In user mode) the current JMP opcode is moved to the ERIOT register, the ECDF + flag is cleared. The address of the JMP instruction is loaded into the ERTB + register and the TSC8-75 I/O flag is raised. Then the JMP is performed as usual + (including the setting of IF, UF and clearing the interrupt inhibit flag). */ + + + case 024: /* JMP, dir, zero */ + PCQ_ENTRY; + MA = IR & 0177; /* dir addr, page zero */ + if (UF) { /* user mode? */ + tsc_ir = IR; /* save instruction */ + tsc_cdf = 0; /* clear flag */ + if (tsc_enb) { /* TSC8 enabled? */ + tsc_pc = (PC - 1) & 07777; /* save PC */ + int_req = int_req | INT_TSC; /* request intr */ + } + } + IF = IB; /* change IF */ + UF = UB; /* change UF */ + int_req = int_req | INT_NO_CIF_PENDING; /* clr intr inhibit */ + PC = MA; + break; + +/* If JMP direct, also check for idle (KSF/JMP *-1) and infinite loop */ + + case 025: /* JMP, dir, curr */ + PCQ_ENTRY; + MA = (MA & 007600) | (IR & 0177); /* dir addr, curr page */ + if (UF) { /* user mode? */ + tsc_ir = IR; /* save instruction */ + tsc_cdf = 0; /* clear flag */ + if (tsc_enb) { /* TSC8 enabled? */ + tsc_pc = (PC - 1) & 07777; /* save PC */ + int_req = int_req | INT_TSC; /* request intr */ + } + } + if (sim_idle_enab && /* idling enabled? */ + (IF == IB)) { /* to same bank? */ + if (MA == ((PC - 2) & 07777)) { /* 1) JMP *-1? */ + if (!(int_req & (INT_ION|INT_TTI)) && /* iof, TTI flag off? */ + (M[IB|((PC - 2) & 07777)] == OP_KSF)) /* next is KSF? */ + sim_idle (TMR_CLK, FALSE); /* we're idle */ + } /* end JMP *-1 */ + else if (MA == ((PC - 1) & 07777)) { /* 2) JMP *? */ + if (!(int_req & INT_ION)) /* iof? */ + reason = STOP_LOOP; /* then infinite loop */ + else if (!(int_req & INT_ALL)) /* ion, not intr? */ + sim_idle (TMR_CLK, FALSE); /* we're idle */ + } /* end JMP */ + } /* end idle enabled */ + IF = IB; /* change IF */ + UF = UB; /* change UF */ + int_req = int_req | INT_NO_CIF_PENDING; /* clr intr inhibit */ + PC = MA; + break; + + case 026: /* JMP, indir, zero */ + PCQ_ENTRY; + MA = IF | (IR & 0177); /* dir addr, page zero */ + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = M[MA]; + else MA = (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + if (UF) { /* user mode? */ + tsc_ir = IR; /* save instruction */ + tsc_cdf = 0; /* clear flag */ + if (tsc_enb) { /* TSC8 enabled? */ + tsc_pc = (PC - 1) & 07777; /* save PC */ + int_req = int_req | INT_TSC; /* request intr */ + } + } + IF = IB; /* change IF */ + UF = UB; /* change UF */ + int_req = int_req | INT_NO_CIF_PENDING; /* clr intr inhibit */ + PC = MA; + break; + + case 027: /* JMP, indir, curr */ + PCQ_ENTRY; + MA = (MA & 077600) | (IR & 0177); /* dir addr, curr page */ + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = M[MA]; + else MA = (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + if (UF) { /* user mode? */ + tsc_ir = IR; /* save instruction */ + tsc_cdf = 0; /* clear flag */ + if (tsc_enb) { /* TSC8 enabled? */ + tsc_pc = (PC - 1) & 07777; /* save PC */ + int_req = int_req | INT_TSC; /* request intr */ + } + } + IF = IB; /* change IF */ + UF = UB; /* change UF */ + int_req = int_req | INT_NO_CIF_PENDING; /* clr intr inhibit */ + PC = MA; + break; + +/* Opcode 7, OPR group 1 */ + + case 034:case 035: /* OPR, group 1 */ + switch ((IR >> 4) & 017) { /* decode IR<4:7> */ + case 0: /* nop */ + break; + case 1: /* CML */ + LAC = LAC ^ 010000; + break; + case 2: /* CMA */ + LAC = LAC ^ 07777; + break; + case 3: /* CMA CML */ + LAC = LAC ^ 017777; + break; + case 4: /* CLL */ + LAC = LAC & 07777; + break; + case 5: /* CLL CML = STL */ + LAC = LAC | 010000; + break; + case 6: /* CLL CMA */ + LAC = (LAC ^ 07777) & 07777; + break; + case 7: /* CLL CMA CML */ + LAC = (LAC ^ 07777) | 010000; + break; + case 010: /* CLA */ + LAC = LAC & 010000; + break; + case 011: /* CLA CML */ + LAC = (LAC & 010000) ^ 010000; + break; + case 012: /* CLA CMA = STA */ + LAC = LAC | 07777; + break; + case 013: /* CLA CMA CML */ + LAC = (LAC | 07777) ^ 010000; + break; + case 014: /* CLA CLL */ + LAC = 0; + break; + case 015: /* CLA CLL CML */ + LAC = 010000; + break; + case 016: /* CLA CLL CMA */ + LAC = 07777; + break; + case 017: /* CLA CLL CMA CML */ + LAC = 017777; + break; + } /* end switch opers */ + + if (IR & 01) /* IAC */ + LAC = (LAC + 1) & 017777; + switch ((IR >> 1) & 07) { /* decode IR<8:10> */ + case 0: /* nop */ + break; + case 1: /* BSW */ + LAC = (LAC & 010000) | ((LAC >> 6) & 077) | ((LAC & 077) << 6); + break; + case 2: /* RAL */ + LAC = ((LAC << 1) | (LAC >> 12)) & 017777; + break; + case 3: /* RTL */ + LAC = ((LAC << 2) | (LAC >> 11)) & 017777; + break; + case 4: /* RAR */ + LAC = ((LAC >> 1) | (LAC << 12)) & 017777; + break; + case 5: /* RTR */ + LAC = ((LAC >> 2) | (LAC << 11)) & 017777; + break; + case 6: /* RAL RAR - undef */ + LAC = LAC & (IR | 010000); /* uses AND path */ + break; + case 7: /* RTL RTR - undef */ + LAC = (LAC & 010000) | (MA & 07600) | (IR & 0177); + break; /* uses address path */ + } /* end switch shifts */ + break; /* end group 1 */ + +/* OPR group 2. From Bernhard Baehr's description of the TSC8-75: + + (In user mode) HLT (7402), OSR (7404) and microprogrammed combinations with + HLT and OSR: Additional to raising a user mode interrupt, the current OPR + opcode is moved to the ERIOT register and the ECDF flag is cleared. */ + + case 036:case 037: /* OPR, groups 2, 3 */ + if ((IR & 01) == 0) { /* group 2 */ + switch ((IR >> 3) & 017) { /* decode IR<6:8> */ + case 0: /* nop */ + break; + case 1: /* SKP */ + PC = (PC + 1) & 07777; + break; + case 2: /* SNL */ + if (LAC >= 010000) + PC = (PC + 1) & 07777; + break; + case 3: /* SZL */ + if (LAC < 010000) + PC = (PC + 1) & 07777; + break; + case 4: /* SZA */ + if ((LAC & 07777) == 0) + PC = (PC + 1) & 07777; + break; + case 5: /* SNA */ + if ((LAC & 07777) + != 0) PC = (PC + 1) & 07777; + break; + case 6: /* SZA | SNL */ + if ((LAC == 0) || (LAC >= 010000)) + PC = (PC + 1) & 07777; + break; + case 7: /* SNA & SZL */ + if ((LAC != 0) && (LAC < 010000)) + PC = (PC + 1) & 07777; + break; + case 010: /* SMA */ + if ((LAC & 04000) != 0) + PC = (PC + 1) & 07777; + break; + case 011: /* SPA */ + if ((LAC & 04000) == 0) + PC = (PC + 1) & 07777; + break; + case 012: /* SMA | SNL */ + if (LAC >= 04000) + PC = (PC + 1) & 07777; + break; + case 013: /* SPA & SZL */ + if (LAC < 04000) + PC = (PC + 1) & 07777; + break; + case 014: /* SMA | SZA */ + if (((LAC & 04000) != 0) || ((LAC & 07777) == 0)) + PC = (PC + 1) & 07777; + break; + case 015: /* SPA & SNA */ + if (((LAC & 04000) == 0) && ((LAC & 07777) != 0)) + PC = (PC + 1) & 07777; + break; + case 016: /* SMA | SZA | SNL */ + if ((LAC >= 04000) || (LAC == 0)) + PC = (PC + 1) & 07777; + break; + case 017: /* SPA & SNA & SZL */ + if ((LAC < 04000) && (LAC != 0)) + PC = (PC + 1) & 07777; + break; + } /* end switch skips */ + if (IR & 0200) /* CLA */ + LAC = LAC & 010000; + if ((IR & 06) && UF) { /* user mode? */ + int_req = int_req | INT_UF; /* request intr */ + tsc_ir = IR; /* save instruction */ + tsc_cdf = 0; /* clear flag */ + } + else { + if (IR & 04) { /* OSR */ +//--- PiDP add-------------------------------------------------------------------------- + OSR = get_switch_register(); /* FIXME: [fad3ad73ea] */ +//--- PiDP end-------------------------------------------------------------------------- + LAC = LAC | OSR; + } + if (IR & 02) { /* HLT */ +//--- PiDP change-------------------------------------------------------------------------- + // reason = STOP_HALT; + set_stop_mode(); +//--- end of PiDP change-------------------------------------------------------------------------- + } + } + break; + } /* end if group 2 */ + +/* OPR group 3 standard + + MQA!MQL exchanges AC and MQ, as follows: + + temp = MQ; + MQ = LAC & 07777; + LAC = LAC & 010000 | temp; +*/ + + temp = MQ; /* group 3 */ + if (IR & 0200) /* CLA */ + LAC = LAC & 010000; + if (IR & 0020) { /* MQL */ + MQ = LAC & 07777; + LAC = LAC & 010000; + } + if (IR & 0100) /* MQA */ + LAC = LAC | temp; + if ((IR & 0056) && (cpu_unit.flags & UNIT_NOEAE)) { + reason = stop_inst; /* EAE not present */ + break; + } + +/* OPR group 3 EAE + + The EAE operates in two modes: + + Mode A, PDP-8/I compatible + Mode B, extended capability + + Mode B provides eight additional subfunctions; in addition, some + of the Mode A functions operate differently in Mode B. + + The mode switch instructions are decoded explicitly and cannot be + microprogrammed with other EAE functions (SWAB performs an MQL as + part of standard group 3 decoding). If mode switching is decoded, + all other EAE timing is suppressed. +*/ + + if (IR == 07431) { /* SWAB */ + emode = 1; /* set mode flag */ + break; + } + if (IR == 07447) { /* SWBA */ + emode = gtf = 0; /* clear mode, gtf */ + break; + } + +/* If not switching modes, the EAE operation is determined by the mode + and IR<6,8:10>: + + <6:10> mode A mode B comments + + 0x000 NOP NOP + 0x001 SCL ACS + 0x010 MUY MUY if mode B, next = address + 0x011 DVI DVI if mode B, next = address + 0x100 NMI NMI if mode B, clear AC if + result = 4000'0000 + 0x101 SHL SHL if mode A, extra shift + 0x110 ASR ASR if mode A, extra shift + 0x111 LSR LSR if mode A, extra shift + 1x000 SCA SCA + 1x001 SCA + SCL DAD + 1x010 SCA + MUY DST + 1x011 SCA + DVI SWBA NOP if not detected earlier + 1x100 SCA + NMI DPSZ + 1x101 SCA + SHL DPIC must be combined with MQA!MQL + 1x110 SCA + ASR DCM must be combined with MQA!MQL + 1x111 SCA + LSR SAM + + EAE instructions which fetch memory operands use the CPU's DEFER + state to read the first word; if the address operand is in locations + x0010 - x0017, it is autoincremented. +*/ + + if (emode == 0) /* mode A? clr gtf */ + gtf = 0; + switch ((IR >> 1) & 027) { /* decode IR<6,8:10> */ + + case 020: /* mode A, B: SCA */ + LAC = LAC | SC; + break; + case 000: /* mode A, B: NOP */ + break; + + case 021: /* mode B: DAD */ + if (emode) { + MA = IF | PC; + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = DF | M[MA]; + else MA = DF | (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + MQ = MQ + M[MA]; + MA = DF | ((MA + 1) & 07777); + LAC = (LAC & 07777) + M[MA] + (MQ >> 12); + MQ = MQ & 07777; + PC = (PC + 1) & 07777; + break; + } + LAC = LAC | SC; /* mode A: SCA then */ + case 001: /* mode B: ACS */ + if (emode) { + SC = LAC & 037; + LAC = LAC & 010000; + } + else { /* mode A: SCL */ + SC = (~M[IF | PC]) & 037; + PC = (PC + 1) & 07777; + } + break; + + case 022: /* mode B: DST */ + if (emode) { + MA = IF | PC; + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = DF | M[MA]; + else MA = DF | (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + if (MEM_ADDR_OK (MA)) + M[MA] = MQ & 07777; + MA = DF | ((MA + 1) & 07777); + if (MEM_ADDR_OK (MA)) + M[MA] = LAC & 07777; + PC = (PC + 1) & 07777; + break; + } + LAC = LAC | SC; /* mode A: SCA then */ + case 002: /* MUY */ + MA = IF | PC; + if (emode) { /* mode B: defer */ + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = DF | M[MA]; + else MA = DF | (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + } + temp = (MQ * M[MA]) + (LAC & 07777); + LAC = (temp >> 12) & 07777; + MQ = temp & 07777; + PC = (PC + 1) & 07777; + SC = 014; /* 12 shifts */ + break; + + case 023: /* mode B: SWBA */ + if (emode) + break; + LAC = LAC | SC; /* mode A: SCA then */ + case 003: /* DVI */ + MA = IF | PC; + if (emode) { /* mode B: defer */ + if ((MA & 07770) != 00010) /* indirect; autoinc? */ + MA = DF | M[MA]; + else MA = DF | (M[MA] = (M[MA] + 1) & 07777); /* incr before use */ + } + if ((LAC & 07777) >= M[MA]) { /* overflow? */ + LAC = LAC | 010000; /* set link */ + MQ = ((MQ << 1) + 1) & 07777; /* rotate MQ */ + SC = 0; /* no shifts */ + } + else { + temp = ((LAC & 07777) << 12) | MQ; + MQ = temp / M[MA]; + LAC = temp % M[MA]; + SC = 015; /* 13 shifts */ + } + PC = (PC + 1) & 07777; + break; + + case 024: /* mode B: DPSZ */ + if (emode) { + if (((LAC | MQ) & 07777) == 0) + PC = (PC + 1) & 07777; + break; + } + LAC = LAC | SC; /* mode A: SCA then */ + case 004: /* NMI */ + temp = (LAC << 12) | MQ; /* preserve link */ + for (SC = 0; ((temp & 017777777) != 0) && + (temp & 040000000) == ((temp << 1) & 040000000); SC++) + temp = temp << 1; + LAC = (temp >> 12) & 017777; + MQ = temp & 07777; + if (emode && ((LAC & 07777) == 04000) && (MQ == 0)) + LAC = LAC & 010000; /* clr if 4000'0000 */ + break; + + case 025: /* mode B: DPIC */ + if (emode) { + temp = (LAC + 1) & 07777; /* SWP already done! */ + LAC = MQ + (temp == 0); + MQ = temp; + break; + } + LAC = LAC | SC; /* mode A: SCA then */ + case 5: /* SHL */ + SC = (M[IF | PC] & 037) + (emode ^ 1); /* shift+1 if mode A */ + if (SC > 25) /* >25? result = 0 */ + temp = 0; + else temp = ((LAC << 12) | MQ) << SC; /* <=25? shift LAC:MQ */ + LAC = (temp >> 12) & 017777; + MQ = temp & 07777; + PC = (PC + 1) & 07777; + SC = emode? 037: 0; /* SC = 0 if mode A */ + break; + + case 026: /* mode B: DCM */ + if (emode) { + temp = (-LAC) & 07777; /* SWP already done! */ + LAC = (MQ ^ 07777) + (temp == 0); + MQ = temp; + break; + } + LAC = LAC | SC; /* mode A: SCA then */ + case 6: /* ASR */ + SC = (M[IF | PC] & 037) + (emode ^ 1); /* shift+1 if mode A */ + temp = ((LAC & 07777) << 12) | MQ; /* sext from AC0 */ + if (LAC & 04000) + temp = temp | ~037777777; + if (emode && (SC != 0)) + gtf = (temp >> (SC - 1)) & 1; + if (SC > 25) + temp = (LAC & 04000)? -1: 0; + else temp = temp >> SC; + LAC = (temp >> 12) & 017777; + MQ = temp & 07777; + PC = (PC + 1) & 07777; + SC = emode? 037: 0; /* SC = 0 if mode A */ + break; + + case 027: /* mode B: SAM */ + if (emode) { + temp = LAC & 07777; + LAC = MQ + (temp ^ 07777) + 1; /* L'AC = MQ - AC */ + gtf = (temp <= MQ) ^ ((temp ^ MQ) >> 11); + break; + } + LAC = LAC | SC; /* mode A: SCA then */ + case 7: /* LSR */ + SC = (M[IF | PC] & 037) + (emode ^ 1); /* shift+1 if mode A */ + temp = ((LAC & 07777) << 12) | MQ; /* clear link */ + if (emode && (SC != 0)) + gtf = (temp >> (SC - 1)) & 1; + if (SC > 24) /* >24? result = 0 */ + temp = 0; + else temp = temp >> SC; /* <=24? shift AC:MQ */ + LAC = (temp >> 12) & 07777; + MQ = temp & 07777; + PC = (PC + 1) & 07777; + SC = emode? 037: 0; /* SC = 0 if mode A */ + break; + } /* end switch */ + break; /* end case 7 */ + +/* Opcode 6, IOT. From Bernhard Baehr's description of the TSC8-75: + + (In user mode) Additional to raising a user mode interrupt, the current IOT + opcode is moved to the ERIOT register. When the IOT is a CDF instruction (62x1), + the ECDF flag is set, otherwise it is cleared. */ + + case 030:case 031:case 032:case 033: /* IOT */ + if (UF) { /* privileged? */ + int_req = int_req | INT_UF; /* request intr */ + tsc_ir = IR; /* save instruction */ + if ((IR & 07707) == 06201) /* set/clear flag */ + tsc_cdf = 1; + else tsc_cdf = 0; + break; + } + device = (IR >> 3) & 077; /* device = IR<3:8> */ + +/* --------------------------------------------------------------------------------------------------------- */ +// the IOT ION, IOF do not light pause, anything else does: +/* --------------------------------------------------------------------------------------------------------- */ + + pulse = IR & 07; /* pulse = IR<9:11> */ + iot_data = LAC & 07777; /* AC unchanged */ + switch (device) { /* decode IR<3:8> */ + + case 000: /* CPU control */ + switch (pulse) { /* decode IR<9:11> */ + + case 0: /* SKON */ + if (int_req & INT_ION) + PC = (PC + 1) & 07777; + int_req = int_req & ~INT_ION; + break; + + case 1: /* ION */ + int_req = (int_req | INT_ION) & ~INT_NO_ION_PENDING; + break; + + case 2: /* IOF */ + int_req = int_req & ~INT_ION; + break; + + case 3: /* SRQ */ + if (int_req & INT_ALL) + PC = (PC + 1) & 07777; + break; + + case 4: /* GTF */ + LAC = (LAC & 010000) | + ((LAC & 010000) >> 1) | (gtf << 10) | + (((int_req & INT_ALL) != 0) << 9) | + (((int_req & INT_ION) != 0) << 7) | SF; + break; + + case 5: /* RTF */ + gtf = ((LAC & 02000) >> 10); + UB = (LAC & 0100) >> 6; + IB = (LAC & 0070) << 9; + DF = (LAC & 0007) << 12; + LAC = ((LAC & 04000) << 1) | iot_data; + int_req = (int_req | INT_ION) & ~INT_NO_CIF_PENDING; + break; + + case 6: /* SGT */ + if (gtf) + PC = (PC + 1) & 07777; + break; + + case 7: /* CAF */ + gtf = 0; + emode = 0; + int_req = int_req & INT_NO_CIF_PENDING; + dev_done = 0; + int_enable = INT_INIT_ENABLE; + LAC = 0; + reset_all (1); /* reset all dev */ + break; + } /* end switch pulse */ + break; /* end case 0 */ + + case 020:case 021:case 022:case 023: + case 024:case 025:case 026:case 027: /* memory extension */ + +/* --------------------------------------------------------------------------------------------------------- */ +// Memory extension does not trigger IOP pauses --> do not light pause +/* --------------------------------------------------------------------------------------------------------- */ + + switch (pulse) { /* decode IR<9:11> */ + + case 1: /* CDF */ + DF = (IR & 0070) << 9; + break; + + case 2: /* CIF */ + IB = (IR & 0070) << 9; + int_req = int_req & ~INT_NO_CIF_PENDING; + break; + + case 3: /* CDF CIF */ + DF = IB = (IR & 0070) << 9; + int_req = int_req & ~INT_NO_CIF_PENDING; + break; + + case 4: + switch (device & 07) { /* decode IR<6:8> */ + + case 0: /* CINT */ + int_req = int_req & ~INT_UF; + break; + + case 1: /* RDF */ + LAC = LAC | (DF >> 9); + break; + + case 2: /* RIF */ + LAC = LAC | (IF >> 9); + break; + + case 3: /* RIB */ + LAC = LAC | SF; + break; + + case 4: /* RMF */ + UB = (SF & 0100) >> 6; + IB = (SF & 0070) << 9; + DF = (SF & 0007) << 12; + int_req = int_req & ~INT_NO_CIF_PENDING; + break; + + case 5: /* SINT */ + if (int_req & INT_UF) + PC = (PC + 1) & 07777; + break; + + case 6: /* CUF */ + UB = 0; + int_req = int_req & ~INT_NO_CIF_PENDING; + break; + + case 7: /* SUF */ + UB = 1; + int_req = int_req & ~INT_NO_CIF_PENDING; + break; + } /* end switch device */ + break; + + default: + reason = stop_inst; + break; + } /* end switch pulse */ + break; /* end case 20-27 */ + + case 010: /* power fail */ + switch (pulse) { /* decode IR<9:11> */ + + case 1: /* SBE */ + break; + + case 2: /* SPL */ + if (int_req & INT_PWR) + PC = (PC + 1) & 07777; + break; + + case 3: /* CAL */ + int_req = int_req & ~INT_PWR; + break; + + default: + reason = stop_inst; + break; + } /* end switch pulse */ + break; /* end case 10 */ + + default: /* I/O device */ + if (dev_tab[device]) { /* dev present? */ +/* ---PiDP add--------------------------------------------------------------------------------------------- */ + // Any other device will trigger IOP, so light pause + set_pidp8i_leds(PC, MA, MB, IR, LAC, MQ, IF, DF, SC, + int_req, pls_pause); +/* ---PiDP end---------------------------------------------------------------------------------------------- */ + iot_data = dev_tab[device] (IR, iot_data); + LAC = (LAC & 010000) | (iot_data & 07777); + if (iot_data & IOT_SKP) + PC = (PC + 1) & 07777; + if (iot_data >= IOT_REASON) + reason = iot_data >> IOT_V_REASON; + } + else reason = stop_inst; /* stop on flag */ + break; + } /* end switch device */ + break; /* end case IOT */ + } /* end switch opcode */ + +/* ---PiDP add--------------------------------------------------------------------------------------------- */ + if (IR < 05000) + set_pidp8i_leds(PC, MA, MB, IR, LAC, MQ, IF, DF, SC, + int_req, pls_execute); +/* ---PiDP end---------------------------------------------------------------------------------------------- */ + + } /* end while */ + +/* Simulation halted */ + +saved_PC = IF | (PC & 07777); /* save copies */ +saved_DF = DF & 070000; +saved_LAC = LAC & 017777; +saved_MQ = MQ & 07777; +pcq_r->qptr = pcq_p; /* update pc q ptr */ +return reason; +} /* end sim_instr */ + +/* Reset routine */ + +t_stat cpu_reset (DEVICE *dptr) +{ +int_req = (int_req & ~INT_ION) | INT_NO_CIF_PENDING; +saved_DF = IB = saved_PC & 070000; +UF = UB = gtf = emode = 0; +pcq_r = find_reg ("PCQ", NULL, dptr); +if (pcq_r) + pcq_r->qptr = 0; +else return SCPE_IERR; +sim_brk_types = SWMASK ('E') | SWMASK('I'); +sim_brk_dflt = SWMASK ('E'); +return SCPE_OK; +} + +/* Set PC for boot (PC<14:12> will typically be 0) */ + +void cpu_set_bootpc (int32 pc) +{ +saved_PC = pc; /* set PC, IF */ +saved_DF = IB = pc & 070000; /* set IB, DF */ +return; +} + +/* Memory examine */ + +t_stat cpu_ex (t_value *vptr, t_addr addr, UNIT *uptr, int32 sw) +{ +if (addr >= MEMSIZE) + return SCPE_NXM; +if (vptr != NULL) + *vptr = M[addr] & 07777; +return SCPE_OK; +} + +/* Memory deposit */ + +t_stat cpu_dep (t_value val, t_addr addr, UNIT *uptr, int32 sw) +{ +if (addr >= MEMSIZE) + return SCPE_NXM; +M[addr] = val & 07777; +return SCPE_OK; +} + +/* Memory size change */ + +t_stat cpu_set_size (UNIT *uptr, int32 val, CONST char *cptr, void *desc) +{ +int32 mc = 0; +uint32 i; + +if ((val <= 0) || (val > MAXMEMSIZE) || ((val & 07777) != 0)) + return SCPE_ARG; +for (i = val; i < MEMSIZE; i++) + mc = mc | M[i]; +if ((mc != 0) && (!get_yn ("Really truncate memory [N]?", FALSE))) + return SCPE_OK; +MEMSIZE = val; +for (i = MEMSIZE; i < MAXMEMSIZE; i++) + M[i] = 0; +return SCPE_OK; +} + +/* Change device number for a device */ + +t_stat set_dev (UNIT *uptr, int32 val, CONST char *cptr, void *desc) +{ +DEVICE *dptr; +DIB *dibp; +uint32 newdev; +t_stat r; + +if (cptr == NULL) + return SCPE_ARG; +if (uptr == NULL) + return SCPE_IERR; +dptr = find_dev_from_unit (uptr); +if (dptr == NULL) + return SCPE_IERR; +dibp = (DIB *) dptr->ctxt; +if (dibp == NULL) + return SCPE_IERR; +newdev = get_uint (cptr, 8, DEV_MAX - 1, &r); /* get new */ +if ((r != SCPE_OK) || (newdev == dibp->dev)) + return r; +dibp->dev = newdev; /* store */ +return SCPE_OK; +} + +/* Show device number for a device */ + +t_stat show_dev (FILE *st, UNIT *uptr, int32 val, CONST void *desc) +{ +DEVICE *dptr; +DIB *dibp; + +if (uptr == NULL) + return SCPE_IERR; +dptr = find_dev_from_unit (uptr); +if (dptr == NULL) + return SCPE_IERR; +dibp = (DIB *) dptr->ctxt; +if (dibp == NULL) + return SCPE_IERR; +fprintf (st, "devno=%02o", dibp->dev); +if (dibp->num > 1) + fprintf (st, "-%2o", dibp->dev + dibp->num - 1); +return SCPE_OK; +} + +/* CPU device handler - should never get here! */ + +int32 bad_dev (int32 IR, int32 AC) +{ +return (SCPE_IERR << IOT_V_REASON) | AC; /* broken! */ +} + +/* Build device dispatch table */ + +t_bool build_dev_tab (void) +{ +DEVICE *dptr; +DIB *dibp; +uint32 i, j; +static const uint8 std_dev[] = { + 000, 010, 020, 021, 022, 023, 024, 025, 026, 027 + }; + +for (i = 0; i < DEV_MAX; i++) /* clr table */ + dev_tab[i] = NULL; +for (i = 0; i < ((uint32) sizeof (std_dev)); i++) /* std entries */ + dev_tab[std_dev[i]] = &bad_dev; +for (i = 0; (dptr = sim_devices[i]) != NULL; i++) { /* add devices */ + dibp = (DIB *) dptr->ctxt; /* get DIB */ + if (dibp && !(dptr->flags & DEV_DIS)) { /* enabled? */ + if (dibp->dsp_tbl) { /* dispatch table? */ + DIB_DSP *dspp = dibp->dsp_tbl; /* set ptr */ + for (j = 0; j < dibp->num; j++, dspp++) { /* loop thru tbl */ + if (dspp->dsp) { /* any dispatch? */ + if (dev_tab[dspp->dev]) { /* already filled? */ + sim_printf ("%s device number conflict at %02o\n", + sim_dname (dptr), dibp->dev + j); + return TRUE; + } + dev_tab[dspp->dev] = dspp->dsp; /* fill */ + } /* end if dsp */ + } /* end for j */ + } /* end if dsp_tbl */ + else { /* inline dispatches */ + for (j = 0; j < dibp->num; j++) { /* loop thru disp */ + if (dibp->dsp[j]) { /* any dispatch? */ + if (dev_tab[dibp->dev + j]) { /* already filled? */ + sim_printf ("%s device number conflict at %02o\n", + sim_dname (dptr), dibp->dev + j); + return TRUE; + } + dev_tab[dibp->dev + j] = dibp->dsp[j]; /* fill */ + } /* end if dsp */ + } /* end for j */ + } /* end else */ + } /* end if enb */ + } /* end for i */ +return FALSE; +} + +/* Set history */ + +t_stat cpu_set_hist (UNIT *uptr, int32 val, CONST char *cptr, void *desc) +{ +int32 i, lnt; +t_stat r; + +if (cptr == NULL) { + for (i = 0; i < hst_lnt; i++) + hst[i].pc = 0; + hst_p = 0; + return SCPE_OK; + } +lnt = (int32) get_uint (cptr, 10, HIST_MAX, &r); +if ((r != SCPE_OK) || (lnt && (lnt < HIST_MIN))) + return SCPE_ARG; +hst_p = 0; +if (hst_lnt) { + free (hst); + hst_lnt = 0; + hst = NULL; + } +if (lnt) { + hst = (InstHistory *) calloc (lnt, sizeof (InstHistory)); + if (hst == NULL) + return SCPE_MEM; + hst_lnt = lnt; + } +return SCPE_OK; +} + +/* Show history */ + +t_stat cpu_show_hist (FILE *st, UNIT *uptr, int32 val, CONST void *desc) +{ +int32 l, k, di, lnt; +const char *cptr = (const char *) desc; +t_stat r; +t_value sim_eval; +InstHistory *h; + +if (hst_lnt == 0) /* enabled? */ + return SCPE_NOFNC; +if (cptr) { + lnt = (int32) get_uint (cptr, 10, hst_lnt, &r); + if ((r != SCPE_OK) || (lnt == 0)) + return SCPE_ARG; + } +else lnt = hst_lnt; +di = hst_p - lnt; /* work forward */ +if (di < 0) + di = di + hst_lnt; +fprintf (st, "PC L AC MQ ea IR\n\n"); +for (k = 0; k < lnt; k++) { /* print specified */ + h = &hst[(++di) % hst_lnt]; /* entry pointer */ + if (h->pc & HIST_PC) { /* instruction? */ + l = (h->lac >> 12) & 1; /* link */ + fprintf (st, "%05o %o %04o %04o ", h->pc & ADDRMASK, l, h->lac & 07777, h->mq); + if (h->ir < 06000) + fprintf (st, "%05o ", h->ea); + else fprintf (st, " "); + sim_eval = h->ir; + if ((fprint_sym (st, h->pc & ADDRMASK, &sim_eval, &cpu_unit, SWMASK ('M'))) > 0) + fprintf (st, "(undefined) %04o", h->ir); + if (h->ir < 04000) + fprintf (st, " [%04o]", h->opnd); + fputc ('\n', st); /* end line */ + } /* end else instruction */ + } /* end for */ +return SCPE_OK; +} ADDED src/PDP8/pdp8_ct.c Index: src/PDP8/pdp8_ct.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_ct.c @@ -0,0 +1,729 @@ +/* pdp8_ct.c: PDP-8 cassette tape simulator + + Copyright (c) 2006-2013, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + ct TA8E/TU60 cassette tape + + 17-Sep-07 RMS Changed to use central set_bootpc routine + 13-Aug-07 RMS Fixed handling of BEOT + 06-Aug-07 RMS Foward op at BOT skips initial file gap + 30-May-07 RMS Fixed typo (Norm Lastovica) + + Magnetic tapes are represented as a series of variable records + of the form: + + 32b byte count + byte 0 + byte 1 + : + byte n-2 + byte n-1 + 32b byte count + + If the byte count is odd, the record is padded with an extra byte + of junk. File marks are represented by a byte count of 0. + + Cassette format differs in one very significant way: it has file gaps + rather than file marks. If the controller spaces or reads into a file + gap and then reverses direction, the file gap is not seen again. This + is in contrast to magnetic tapes, where the file mark is a character + sequence and is seen again if direction is reversed. In addition, + cassettes have an initial file gap which is automatically skipped on + forward operations from beginning of tape. + + Note that the read and write sequences for the cassette are asymmetric: + + Read: KLSA /SELECT READ + KGOA /INIT READ, CLEAR DF + + KGOA /READ 1ST CHAR, CLEAR DF + DCA CHAR + : + + KGOA /READ LAST CHAR, CLEAR DF + DCA CHAR + + KLSA /SELECT CRC MODE + KGOA /READ 1ST CRC + + KGOA /READ 2ND CRC + + + Write: KLSA /SELECT WRITE + TAD CHAR /1ST CHAR + KGOA /INIT WRITE, CHAR TO BUF, CLEAR DF + + : + TAD CHAR /LAST CHAR + KGOA /CHAR TO BUF, CLEAR DF + + KLSA /SELECT CRC MODE + KGOA /WRITE CRC, CLEAR DF + +*/ + +#include "pdp8_defs.h" +#include "sim_tape.h" + +#define CT_NUMDR 2 /* #drives */ +#define FNC u3 /* unit function */ +#define UST u4 /* unit status */ +#define CT_MAXFR (CT_SIZE) /* max record lnt */ +#define CT_SIZE 93000 /* chars/tape */ + +/* Status Register A */ + +#define SRA_ENAB 0200 /* enable */ +#define SRA_V_UNIT 6 /* unit */ +#define SRA_M_UNIT (CT_NUMDR - 1) +#define SRA_V_FNC 3 /* function */ +#define SRA_M_FNC 07 +#define SRA_READ 00 +#define SRA_REW 01 +#define SRA_WRITE 02 +#define SRA_SRF 03 +#define SRA_WFG 04 +#define SRA_SRB 05 +#define SRA_CRC 06 +#define SRA_SFF 07 +#define SRA_2ND 010 +#define SRA_IE 0001 /* int enable */ +#define GET_UNIT(x) (((x) >> SRA_V_UNIT) & SRA_M_UNIT) +#define GET_FNC(x) (((x) >> SRA_V_FNC) & SRA_M_FNC) + +/* Function code flags */ + +#define OP_WRI 01 /* op is a write */ +#define OP_REV 02 /* op is rev motion */ +#define OP_FWD 04 /* op is fwd motion */ + +/* Unit status flags */ + +#define UST_REV (OP_REV) /* last op was rev */ +#define UST_GAP 01 /* last op hit gap */ + +/* Status Register B, ^ = computed on the fly */ + +#define SRB_WLE 0400 /* "write lock err" */ +#define SRB_CRC 0200 /* CRC error */ +#define SRB_TIM 0100 /* timing error */ +#define SRB_BEOT 0040 /* ^BOT/EOT */ +#define SRB_EOF 0020 /* end of file */ +#define SRB_EMP 0010 /* ^drive empty */ +#define SRB_REW 0004 /* rewinding */ +#define SRB_WLK 0002 /* ^write locked */ +#define SRB_RDY 0001 /* ^ready */ +#define SRB_ALLERR (SRB_WLE|SRB_CRC|SRB_TIM|SRB_BEOT|SRB_EOF|SRB_EMP) +#define SRB_XFRERR (SRB_WLE|SRB_CRC|SRB_TIM|SRB_EOF) + +extern int32 int_req, stop_inst; +extern UNIT cpu_unit; + +uint32 ct_sra = 0; /* status reg A */ +uint32 ct_srb = 0; /* status reg B */ +uint32 ct_db = 0; /* data buffer */ +uint32 ct_df = 0; /* data flag */ +uint32 ct_write = 0; /* TU60 write flag */ +uint32 ct_bptr = 0; /* buf ptr */ +uint32 ct_blnt = 0; /* buf length */ +int32 ct_stime = 1000; /* start time */ +int32 ct_ctime = 100; /* char latency */ +uint32 ct_stopioe = 1; /* stop on error */ +uint8 *ct_xb = NULL; /* transfer buffer */ +static uint8 ct_fnc_tab[SRA_M_FNC + 1] = { + OP_FWD, 0 , OP_WRI|OP_FWD, OP_REV, + OP_WRI|OP_FWD, OP_REV, 0, OP_FWD + }; + +int32 ct70 (int32 IR, int32 AC); +t_stat ct_svc (UNIT *uptr); +t_stat ct_reset (DEVICE *dptr); +t_stat ct_attach (UNIT *uptr, CONST char *cptr); +t_stat ct_detach (UNIT *uptr); +t_stat ct_boot (int32 unitno, DEVICE *dptr); +uint32 ct_updsta (UNIT *uptr); +int32 ct_go_start (int32 AC); +int32 ct_go_cont (UNIT *uptr, int32 AC); +t_stat ct_map_err (UNIT *uptr, t_stat st); +UNIT *ct_busy (void); +void ct_set_df (t_bool timchk); +t_bool ct_read_char (void); +uint32 ct_crc (uint8 *buf, uint32 cnt); + +/* CT data structures + + ct_dev CT device descriptor + ct_unit CT unit list + ct_reg CT register list + ct_mod CT modifier list +*/ + +DIB ct_dib = { DEV_CT, 1, { &ct70 } }; + +UNIT ct_unit[] = { + { UDATA (&ct_svc, UNIT_ATTABLE+UNIT_ROABLE, CT_SIZE) }, + { UDATA (&ct_svc, UNIT_ATTABLE+UNIT_ROABLE, CT_SIZE) }, + }; + +REG ct_reg[] = { + { ORDATAD (CTSRA, ct_sra, 8, "status register A") }, + { ORDATAD (CTSRB, ct_srb, 8, "status register B") }, + { ORDATAD (CTDB, ct_db, 8, "data buffer") }, + { FLDATAD (CTDF, ct_df, 0, "data flag") }, + { FLDATAD (RDY, ct_srb, 0, "ready flag") }, + { FLDATAD (WLE, ct_srb, 8, "write lock error") }, + { FLDATAD (WRITE, ct_write, 0, "TA60 write operation flag") }, + { FLDATAD (INT, int_req, INT_V_CT, "interrupt request") }, + { DRDATAD (BPTR, ct_bptr, 17, "buffer pointer") }, + { DRDATAD (BLNT, ct_blnt, 17, "buffer length") }, + { DRDATAD (STIME, ct_stime, 24, "operation start time"), PV_LEFT + REG_NZ }, + { DRDATAD (CTIME, ct_ctime, 24, "character latency"), PV_LEFT + REG_NZ }, + { FLDATAD (STOP_IOE, ct_stopioe, 0, "stop on I/O errors flag") }, + { URDATA (UFNC, ct_unit[0].FNC, 8, 4, 0, CT_NUMDR, REG_HRO) }, + { URDATA (UST, ct_unit[0].UST, 8, 2, 0, CT_NUMDR, REG_HRO) }, + { URDATAD (POS, ct_unit[0].pos, 10, T_ADDR_W, 0, + CT_NUMDR, PV_LEFT | REG_RO, "position, units 0-1") }, + { FLDATA (DEVNUM, ct_dib.dev, 6), REG_HRO }, + { NULL } + }; + +MTAB ct_mod[] = { + { MTUF_WLK, 0, "write enabled", "WRITEENABLED", NULL }, + { MTUF_WLK, MTUF_WLK, "write locked", "LOCKED", NULL }, +// { MTAB_XTD|MTAB_VUN, 0, "FORMAT", "FORMAT", +// &sim_tape_set_fmt, &sim_tape_show_fmt, NULL }, + { MTAB_XTD|MTAB_VUN, 0, "CAPACITY", NULL, + NULL, &sim_tape_show_capac, NULL }, + { MTAB_XTD|MTAB_VDV, 0, "DEVNO", "DEVNO", + &set_dev, &show_dev, NULL }, + { 0 } + }; + +DEVICE ct_dev = { + "CT", ct_unit, ct_reg, ct_mod, + CT_NUMDR, 10, 31, 1, 8, 8, + NULL, NULL, &ct_reset, + &ct_boot, &ct_attach, &ct_detach, + &ct_dib, DEV_DISABLE | DEV_DIS | DEV_DEBUG | DEV_TAPE + }; + +/* IOT routines */ + +int32 ct70 (int32 IR, int32 AC) +{ +int32 srb; +UNIT *uptr; + +srb = ct_updsta (NULL); /* update status */ +switch (IR & 07) { /* decode IR<9:11> */ + + case 0: /* KCLR */ + ct_reset (&ct_dev); /* reset the world */ + break; + + case 1: /* KSDR */ + if (ct_df) + AC |= IOT_SKP; + break; + + case 2: /* KSEN */ + if (srb & SRB_ALLERR) + AC |= IOT_SKP; + break; + + case 3: /* KSBF */ + if ((srb & SRB_RDY) && !(srb & SRB_EMP)) + AC |= IOT_SKP; + break; + + case 4: /* KLSA */ + ct_sra = AC & 0377; + ct_updsta (NULL); + return ct_sra ^ 0377; + + case 5: /* KSAF */ + if (ct_df || (srb & (SRB_ALLERR|SRB_RDY))) + AC |= IOT_SKP; + break; + + case 6: /* KGOA */ + ct_df = 0; /* clear data flag */ + if ((uptr = ct_busy ())) /* op in progress? */ + AC = ct_go_cont (uptr, AC); /* yes */ + else AC = ct_go_start (AC); /* no, start */ + ct_updsta (NULL); + break; + + case 7: /* KSRB */ + return srb & 0377; + } /* end switch */ + +return AC; +} + +/* Start a new operation - cassette is not busy */ + +int32 ct_go_start (int32 AC) +{ +UNIT *uptr = ct_dev.units + GET_UNIT (ct_sra); +uint32 fnc = GET_FNC (ct_sra); +uint32 flg = ct_fnc_tab[fnc]; +uint32 old_ust = uptr->UST; + +if (DEBUG_PRS (ct_dev)) fprintf (sim_deb, + ">>CT start: op=%o, old_sta = %o, pos=%d\n", + fnc, uptr->UST, uptr->pos); +if ((ct_sra & SRA_ENAB) && (uptr->flags & UNIT_ATT)) { /* enabled, att? */ + ct_srb &= ~(SRB_XFRERR|SRB_REW); /* clear err, rew */ + if (flg & OP_WRI) { /* write-type op? */ + if (sim_tape_wrp (uptr)) { /* locked? */ + ct_srb |= SRB_WLE; /* set flag, abort */ + return AC; + } + ct_write = 1; /* set TU60 wr flag */ + ct_db = AC & 0377; + } + else { + ct_write = 0; + ct_db = 0; + } + ct_srb &= ~SRB_BEOT; /* tape in motion */ + if (fnc == SRA_REW) /* rew? set flag */ + ct_srb |= SRB_REW; + if ((fnc != SRA_REW) && !(flg & OP_WRI)) { /* read cmd? */ + t_mtrlnt t; + t_stat st; + uptr->UST = flg & UST_REV; /* save direction */ + if (sim_tape_bot (uptr) && (flg & OP_FWD)) { /* spc/read fwd bot? */ + st = sim_tape_rdrecf (uptr, ct_xb, &t, CT_MAXFR); /* skip file gap */ + if (st != MTSE_TMK) /* not there? */ + sim_tape_rewind (uptr); /* restore tap pos */ + else old_ust = 0; /* defang next */ + } + if ((old_ust ^ uptr->UST) == (UST_REV|UST_GAP)) { /* rev in gap? */ + if (DEBUG_PRS (ct_dev)) fprintf (sim_deb, + ">>CT skip gap: op=%o, old_sta = %o, pos=%d\n", + fnc, uptr->UST, uptr->pos); + if (uptr->UST) /* skip file gap */ + sim_tape_rdrecr (uptr, ct_xb, &t, CT_MAXFR); + else sim_tape_rdrecf (uptr, ct_xb, &t, CT_MAXFR); + } + } + else uptr->UST = 0; + ct_bptr = 0; /* init buffer */ + ct_blnt = 0; + uptr->FNC = fnc; /* save function */ + sim_activate (uptr, ct_stime); /* schedule op */ + } +if ((fnc == SRA_READ) || (fnc == SRA_CRC)) /* read or CRC? */ + return 0; /* get "char" */ +return AC; +} + +/* Continue an in-progress operation - cassette is in motion */ + +int32 ct_go_cont (UNIT *uptr, int32 AC) +{ +int32 fnc = GET_FNC (ct_sra); + +switch (fnc) { /* case on function */ + + case SRA_READ: /* read */ + return ct_db; /* return data */ + + case SRA_WRITE: /* write */ + ct_db = AC & 0377; /* save data */ + break; + + case SRA_CRC: /* CRC */ + if ((uptr->FNC & SRA_M_FNC) != SRA_CRC) /* if not CRC */ + uptr->FNC = SRA_CRC; /* start CRC seq */ + if (!ct_write) /* read? AC <- buf */ + return ct_db; + break; + + default: + break; + } + +return AC; +} + +/* Unit service */ + +t_stat ct_svc (UNIT *uptr) +{ +uint32 i, crc; +uint32 flgs = ct_fnc_tab[uptr->FNC & SRA_M_FNC]; +t_mtrlnt tbc; +t_stat st, r; + +if ((uptr->flags & UNIT_ATT) == 0) { /* not attached? */ + ct_updsta (uptr); /* update status */ + return (ct_stopioe? SCPE_UNATT: SCPE_OK); + } +if (((flgs & OP_REV) && sim_tape_bot (uptr)) || /* rev at BOT or */ + ((flgs & OP_FWD) && sim_tape_eot (uptr))) { /* fwd at EOT? */ + ct_srb |= SRB_BEOT; /* error */ + ct_updsta (uptr); /* op done */ + return SCPE_OK; + } + +r = SCPE_OK; +switch (uptr->FNC) { /* case on function */ + + case SRA_READ: /* read start */ + st = sim_tape_rdrecf (uptr, ct_xb, &ct_blnt, CT_MAXFR); /* get rec */ + if (st == MTSE_RECE) /* rec in err? */ + ct_srb |= SRB_CRC; + else if (st != MTSE_OK) { /* other error? */ + r = ct_map_err (uptr, st); /* map error */ + break; + } + crc = ct_crc (ct_xb, ct_blnt); /* calculate CRC */ + ct_xb[ct_blnt++] = (crc >> 8) & 0377; /* append to buffer */ + ct_xb[ct_blnt++] = crc & 0377; + uptr->FNC |= SRA_2ND; /* next state */ + sim_activate (uptr, ct_ctime); /* sched next char */ + return SCPE_OK; + + case SRA_READ|SRA_2ND: /* read char */ + if (!ct_read_char ()) /* read, overrun? */ + break; + ct_set_df (TRUE); /* set data flag */ + sim_activate (uptr, ct_ctime); /* sched next char */ + return SCPE_OK; + + case SRA_WRITE: /* write start */ + for (i = 0; i < CT_MAXFR; i++) /* clear buffer */ + ct_xb[i] = 0; + uptr->FNC |= SRA_2ND; /* next state */ + sim_activate (uptr, ct_ctime); /* sched next char */ + return SCPE_OK; + + case SRA_WRITE|SRA_2ND: /* write char */ + if ((ct_bptr < CT_MAXFR) && /* room in buf? */ + ((uptr->pos + ct_bptr) < uptr->capac)) /* room on tape? */ + ct_xb[ct_bptr++] = ct_db; /* store char */ + ct_set_df (TRUE); /* set data flag */ + sim_activate (uptr, ct_ctime); /* sched next char */ + return SCPE_OK; + + case SRA_CRC: /* CRC */ + if (ct_write) { /* write? */ + if ((st = sim_tape_wrrecf (uptr, ct_xb, ct_bptr)))/* write, err? */ + r = ct_map_err (uptr, st); /* map error */ + break; /* write done */ + } + ct_read_char (); /* get second CRC */ + ct_set_df (FALSE); /* set df */ + uptr->FNC |= SRA_2ND; /* next state */ + sim_activate (uptr, ct_ctime); + return SCPE_OK; + + case SRA_CRC|SRA_2ND: /* second read CRC */ + if (ct_bptr != ct_blnt) { /* partial read? */ + crc = ct_crc (ct_xb, ct_bptr); /* actual CRC */ + if (crc != 0) /* must be zero */ + ct_srb |= SRB_CRC; + } + break; /* read done */ + + case SRA_WFG: /* write file gap */ + if ((st = sim_tape_wrtmk (uptr))) /* write tmk, err? */ + r = ct_map_err (uptr, st); /* map error */ + break; + + case SRA_REW: /* rewind */ + sim_tape_rewind (uptr); + ct_srb |= SRB_BEOT; /* set BOT */ + break; + + case SRA_SRB: /* space rev blk */ + if ((st = sim_tape_sprecr (uptr, &tbc))) /* space rev, err? */ + r = ct_map_err (uptr, st); /* map error */ + break; + + case SRA_SRF: /* space rev file */ + while ((st = sim_tape_sprecr (uptr, &tbc)) == MTSE_OK) ; + r = ct_map_err (uptr, st); /* map error */ + break; + + case SRA_SFF: /* space fwd file */ + while ((st = sim_tape_sprecf (uptr, &tbc)) == MTSE_OK) ; + r = ct_map_err (uptr, st); /* map error */ + break; + + default: /* never get here! */ + return SCPE_IERR; + } /* end case */ + +ct_updsta (uptr); /* update status */ +if (DEBUG_PRS (ct_dev)) fprintf (sim_deb, + ">>CT done: op=%o, statusA = %o, statusB = %o, pos=%d\n", + uptr->FNC, ct_sra, ct_srb, uptr->pos); +return r; +} + +/* Update controller status */ + +uint32 ct_updsta (UNIT *uptr) +{ +int32 srb; + +if (uptr == NULL) { /* unit specified? */ + uptr = ct_busy (); /* use busy unit */ + if ((uptr == NULL) && (ct_sra & SRA_ENAB)) /* none busy? */ + uptr = ct_dev.units + GET_UNIT (ct_sra); /* use sel unit */ + } +else if (ct_srb & SRB_EOF) /* save gap */ + uptr->UST |= UST_GAP; +if (uptr) { /* any unit? */ + ct_srb &= ~(SRB_WLK|SRB_EMP|SRB_RDY); /* clear dyn flags */ + if ((uptr->flags & UNIT_ATT) == 0) /* unattached? */ + ct_srb = (ct_srb | SRB_EMP|SRB_WLK) & ~SRB_REW; /* empty, locked */ + if (!sim_is_active (uptr)) { /* not busy? */ + ct_srb = (ct_srb | SRB_RDY) & ~SRB_REW; /* ready, ~rew */ + } + if (sim_tape_wrp (uptr) || (ct_srb & SRB_REW)) /* locked or rew? */ + ct_srb |= SRB_WLK; /* set locked */ + } +if (ct_sra & SRA_ENAB) /* can TA see TU60? */ + srb = ct_srb; +else srb = 0; /* no */ +if ((ct_sra & SRA_IE) && /* int enabled? */ + (ct_df || (srb & (SRB_ALLERR|SRB_RDY)))) /* any flag? */ + int_req |= INT_CT; /* set int req */ +else int_req &= ~INT_CT; /* no, clr int req */ +return srb; +} + +/* Set data flag */ + +void ct_set_df (t_bool timchk) +{ +if (ct_df && timchk) /* flag still set? */ + ct_srb |= SRB_TIM; +ct_df = 1; /* set data flag */ +if (ct_sra & SRA_IE) /* if ie, int req */ + int_req |= INT_CT; +return; +} + +/* Read character */ + +t_bool ct_read_char (void) +{ +if (ct_bptr < ct_blnt) { /* more chars? */ + ct_db = ct_xb[ct_bptr++]; + return TRUE; + } +ct_db = 0; +ct_srb |= SRB_CRC; /* overrun */ +return FALSE; +} + +/* Test if controller busy */ + +UNIT *ct_busy (void) +{ +uint32 u; +UNIT *uptr; + +for (u = 0; u < CT_NUMDR; u++) { /* loop thru units */ + uptr = ct_dev.units + u; + if (sim_is_active (uptr)) + return uptr; + } +return NULL; +} + +/* Calculate CRC on buffer */ + +uint32 ct_crc (uint8 *buf, uint32 cnt) +{ +uint32 crc, i, j; + +crc = 0; +for (i = 0; i < cnt; i++) { + crc = crc ^ (((uint32) buf[i]) << 8); + for (j = 0; j < 8; j++) { + if (crc & 1) + crc = (crc >> 1) ^ 0xA001; + else crc = crc >> 1; + } + } +return crc; +} + +/* Map error status */ + +t_stat ct_map_err (UNIT *uptr, t_stat st) +{ +switch (st) { + + case MTSE_FMT: /* illegal fmt */ + case MTSE_UNATT: /* unattached */ + ct_srb |= SRB_CRC; + case MTSE_OK: /* no error */ + return SCPE_IERR; /* never get here! */ + + case MTSE_TMK: /* end of file */ + ct_srb |= SRB_EOF; + break; + + case MTSE_IOERR: /* IO error */ + ct_srb |= SRB_CRC; /* set crc err */ + if (ct_stopioe) + return SCPE_IOERR; + break; + + case MTSE_INVRL: /* invalid rec lnt */ + ct_srb |= SRB_CRC; /* set crc err */ + return SCPE_MTRLNT; + + case MTSE_RECE: /* record in error */ + case MTSE_EOM: /* end of medium */ + ct_srb |= SRB_CRC; /* set crc err */ + break; + + case MTSE_BOT: /* reverse into BOT */ + ct_srb |= SRB_BEOT; /* set BOT */ + break; + + case MTSE_WRP: /* write protect */ + ct_srb |= SRB_WLE; /* set wlk err */ + break; + } + +return SCPE_OK; +} + +/* Reset routine */ + +t_stat ct_reset (DEVICE *dptr) +{ +uint32 u; +UNIT *uptr; + +ct_sra = 0; +ct_srb = 0; +ct_df = 0; +ct_db = 0; +ct_write = 0; +ct_bptr = 0; +ct_blnt = 0; +int_req = int_req & ~INT_CT; /* clear interrupt */ +for (u = 0; u < CT_NUMDR; u++) { /* loop thru units */ + uptr = ct_dev.units + u; + sim_cancel (uptr); /* cancel activity */ + sim_tape_reset (uptr); /* reset tape */ + } +if (ct_xb == NULL) + ct_xb = (uint8 *) calloc (CT_MAXFR + 2, sizeof (uint8)); +if (ct_xb == NULL) + return SCPE_MEM; +return SCPE_OK; +} + +/* Attach routine */ + +t_stat ct_attach (UNIT *uptr, CONST char *cptr) +{ +t_stat r; + +r = sim_tape_attach (uptr, cptr); +if (r != SCPE_OK) + return r; +ct_updsta (NULL); +uptr->UST = 0; +return r; +} + +/* Detach routine */ + +t_stat ct_detach (UNIT* uptr) +{ +t_stat r; + +if (!(uptr->flags & UNIT_ATT)) /* check attached */ + return SCPE_OK; +r = sim_tape_detach (uptr); +ct_updsta (NULL); +uptr->UST = 0; +return r; +} + +/* Bootstrap routine */ + +#define BOOT_START 04000 +#define BOOT_LEN (sizeof (boot_rom) / sizeof (int16)) + +static const uint16 boot_rom[] = { + 01237, /* BOOT, TAD M50 /change CRC to REW */ + 01206, /* CRCCHK, TAD L260 /crc op */ + 06704, /* KLSA /load op */ + 06706, /* KGOA /start */ + 06703, /* KSBF /ready? */ + 05204, /* RDCOD, JMP .-1 /loop */ + 07264, /* L260, CML STA RAL /L = 1, AC = halt */ + 06702, /* KSEN /error? */ + 07610, /* SKP CLA /halt on any error */ + 03211, /* DCA . /except REW or FFG */ + 03636, /* DCA I PTR /TAD I PTR mustn't change L */ + 01205, /* TAD RDCOD /read op */ + 06704, /* KLSA /load op */ + 06706, /* KGOA /start */ + 06701, /* LOOP, KSDF /data ready? */ + 05216, /* JMP .-1 /loop */ + 07002, /* BSW /to upper 6b */ + 07430, /* SZL /second byte? */ + 01636, /* TAD I PTR /yes */ + 07022, /* CML BSW /swap back */ + 03636, /* DCA I PTR /store in mem */ + 07420, /* SNL /done with both bytes? */ + 02236, /* ISZ PTR /yes, bump mem ptr */ + 02235, /* ISZ KNT /done with record? */ + 05215, /* JMP LOOP /next byte */ + 07346, /* STA CLL RTL */ + 07002, /* BSW /AC = 7757 */ + 03235, /* STA KNT /now read 200 byte record */ + 05201, /* JMP CRCCHK /go check CRC */ + 07737, /* KNT, 7737 /1's compl of byte count */ + 03557, /* PTR, 3557 /load point */ + 07730, /* M50, 7730 /CLA SPA SZL */ + }; + +t_stat ct_boot (int32 unitno, DEVICE *dptr) +{ +size_t i; +extern uint16 M[]; + +if ((ct_dib.dev != DEV_CT) || unitno) /* only std devno */ + return STOP_NOTSTD; +for (i = 0; i < BOOT_LEN; i++) + M[BOOT_START + i] = boot_rom[i]; +cpu_set_bootpc (BOOT_START); +return SCPE_OK; +} ADDED src/PDP8/pdp8_defs.h Index: src/PDP8/pdp8_defs.h ================================================================== --- /dev/null +++ src/PDP8/pdp8_defs.h @@ -0,0 +1,258 @@ +/* pdp8_defs.h: PDP-8 simulator definitions + + Copyright (c) 1993-2016, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + 18-Sep-16 RMS Added support for 16 additional terminals + 18-Sep-13 RMS Added set_bootpc prototype + 18-Apr-12 RMS Removed separate timer for additional terminals; + Added clock_cosched prototype + 22-May-10 RMS Added check for 64b definitions + 21-Aug-07 RMS Added FPP8 support + 13-Dec-06 RMS Added TA8E support + 30-Oct-06 RMS Added infinite loop stop + 13-Oct-03 RMS Added TSC8-75 support + 04-Oct-02 RMS Added variable device number support + 20-Jan-02 RMS Fixed bug in TTx interrupt enable initialization + 25-Nov-01 RMS Added RL8A support + 16-Sep-01 RMS Added multiple KL support + 18-Mar-01 RMS Added DF32 support + 15-Feb-01 RMS Added DECtape support + 14-Apr-99 RMS Changed t_addr to unsigned + 19-Mar-95 RMS Added dynamic memory size + 02-May-94 RMS Added non-existent memory handling + + The author gratefully acknowledges the help of Max Burnet, Richie Lary, + and Bill Haygood in resolving questions about the PDP-8 +*/ + +#ifndef PDP8_DEFS_H_ +#define PDP8_DEFS_H_ 0 + +#include "sim_defs.h" /* simulator defns */ + +#if defined(USE_INT64) || defined(USE_ADDR64) +#error "PDP-8 does not support 64b values!" +#endif + +/* Simulator stop codes */ + +#define STOP_RSRV 1 /* must be 1 */ +#define STOP_HALT 2 /* HALT */ +#define STOP_IBKPT 3 /* breakpoint */ +#define STOP_OPBKPT 4 /* Opcode/Instruction breakpoint */ +#define STOP_NOTSTD 5 /* non-std devno */ +#define STOP_DTOFF 6 /* DECtape off reel */ +#define STOP_LOOP 7 /* infinite loop */ + +/* Memory */ + +#define MAXMEMSIZE 32768 /* max memory size */ +#define MEMSIZE (cpu_unit.capac) /* actual memory size */ +#define ADDRMASK (MAXMEMSIZE - 1) /* address mask */ +#define MEM_ADDR_OK(x) (((uint32) (x)) < MEMSIZE) + +/* IOT subroutine return codes */ + +#define IOT_V_SKP 12 /* skip */ +#define IOT_V_REASON 13 /* reason */ +#define IOT_SKP (1 << IOT_V_SKP) +#define IOT_REASON (1 << IOT_V_REASON) +#define IORETURN(f,v) ((f)? (v): SCPE_OK) /* stop on error */ + +/* Timers */ + +#define TMR_CLK 0 /* timer 0 = clock */ + +/* Device information block */ + +#define DEV_MAXBLK 8 /* max dev block */ +#define DEV_MAX 64 /* total devices */ + +typedef struct { + uint32 dev; /* device number */ + int32 (*dsp)(int32 IR, int32 dat); /* dispatch */ + } DIB_DSP; + +typedef struct { + uint32 dev; /* base dev number */ + uint32 num; /* number of slots */ + int32 (*dsp[DEV_MAXBLK])(int32 IR, int32 dat); + DIB_DSP *dsp_tbl; /* optional table */ + } DIB; + +/* Standard device numbers */ + +#define DEV_PTR 001 /* paper tape reader */ +#define DEV_PTP 002 /* paper tape punch */ +#define DEV_TTI 003 /* console input */ +#define DEV_TTO 004 /* console output */ +#define DEV_CLK 013 /* clock */ +#define DEV_TSC 036 +#define DEV_KJ8 040 /* extra terminals */ +#define DEV_FPP 055 /* floating point */ +#define DEV_DF 060 /* DF32 */ +#define DEV_RF 060 /* RF08 */ +#define DEV_RL 060 /* RL8A */ +#define DEV_LPT 066 /* line printer */ +#define DEV_MT 070 /* TM8E */ +#define DEV_CT 070 /* TA8E */ +#define DEV_RK 074 /* RK8E */ +#define DEV_RX 075 /* RX8E/RX28 */ +#define DEV_DTA 076 /* TC08 */ +#define DEV_TD8E 077 /* TD8E */ + +/* Extra PTO8/KL8JA devices */ + +#define DEV_TTI1 040 +#define DEV_TTO1 041 +#define DEV_TTI2 042 +#define DEV_TTO2 043 +#define DEV_TTI3 044 +#define DEV_TTO3 045 +#define DEV_TTI4 046 +#define DEV_TTO4 047 +#define DEV_TTI5 034 +#define DEV_TTO5 035 +#define DEV_TTI6 011 +#define DEV_TTO6 012 +#define DEV_TTI7 030 +#define DEV_TTO7 031 +#define DEV_TTI8 032 +#define DEV_TTO8 033 +#define DEV_TTI9 050 +#define DEV_TTO9 051 +#define DEV_TTI10 052 +#define DEV_TTO10 053 +#define DEV_TTI11 054 +#define DEV_TTO11 055 /* conflict: FPP */ +#define DEV_TTI12 056 /* conflict: FPP */ +#define DEV_TTO12 057 +#define DEV_TTI13 070 /* conflict: CT, MT */ +#define DEV_TTO13 071 +#define DEV_TTI14 036 /* conflict: TSC */ +#define DEV_TTO14 037 +#define DEV_TTI15 072 +#define DEV_TTO15 073 +#define DEV_TTI16 006 +#define DEV_TTO16 007 + +/* Interrupt flags + + The interrupt flags consist of three groups: + + 1. Devices with individual interrupt enables. These record + their interrupt requests in device_done and their enables + in device_enable, and must occupy the low bit positions. + + 2. Devices without interrupt enables. These record their + interrupt requests directly in int_req, and must occupy + the middle bit positions. + + 3. Overhead. These exist only in int_req and must occupy the + high bit positions. + + Because the PDP-8 does not have priority interrupts, the order + of devices within groups does not matter. + + Note: all extra KL input and output interrupts must be assigned + to contiguous bits. +*/ + +#define INT_V_START 0 /* enable start */ +#define INT_V_LPT (INT_V_START+0) /* line printer */ +#define INT_V_PTP (INT_V_START+1) /* tape punch */ +#define INT_V_PTR (INT_V_START+2) /* tape reader */ +#define INT_V_TTO (INT_V_START+3) /* terminal */ +#define INT_V_TTI (INT_V_START+4) /* keyboard */ +#define INT_V_CLK (INT_V_START+5) /* clock */ +#define INT_V_TTO1 (INT_V_START+6) /* tto1 */ +//#define INT_V_TTO2 (INT_V_START+7) /* tto2 */ +//#define INT_V_TTO3 (INT_V_START+8) /* tto3 */ +//#define INT_V_TTO4 (INT_V_START+9) /* tto4 */ +#define INT_V_TTI1 (INT_V_START+10) /* tti1 */ +//#define INT_V_TTI2 (INT_V_START+11) /* tti2 */ +//#define INT_V_TTI3 (INT_V_START+12) /* tti3 */ +//#define INT_V_TTI4 (INT_V_START+13) /* tti4 */ +#define INT_V_DIRECT (INT_V_START+14) /* direct start */ +#define INT_V_RX (INT_V_DIRECT+0) /* RX8E */ +#define INT_V_RK (INT_V_DIRECT+1) /* RK8E */ +#define INT_V_RF (INT_V_DIRECT+2) /* RF08 */ +#define INT_V_DF (INT_V_DIRECT+3) /* DF32 */ +#define INT_V_MT (INT_V_DIRECT+4) /* TM8E */ +#define INT_V_DTA (INT_V_DIRECT+5) /* TC08 */ +#define INT_V_RL (INT_V_DIRECT+6) /* RL8A */ +#define INT_V_CT (INT_V_DIRECT+7) /* TA8E int */ +#define INT_V_PWR (INT_V_DIRECT+8) /* power int */ +#define INT_V_UF (INT_V_DIRECT+9) /* user int */ +#define INT_V_TSC (INT_V_DIRECT+10) /* TSC8-75 int */ +#define INT_V_FPP (INT_V_DIRECT+11) /* FPP8 */ +#define INT_V_OVHD (INT_V_DIRECT+12) /* overhead start */ +#define INT_V_NO_ION_PENDING (INT_V_OVHD+0) /* ion pending */ +#define INT_V_NO_CIF_PENDING (INT_V_OVHD+1) /* cif pending */ +#define INT_V_ION (INT_V_OVHD+2) /* interrupts on */ + +#define INT_LPT (1 << INT_V_LPT) +#define INT_PTP (1 << INT_V_PTP) +#define INT_PTR (1 << INT_V_PTR) +#define INT_TTO (1 << INT_V_TTO) +#define INT_TTI (1 << INT_V_TTI) +#define INT_CLK (1 << INT_V_CLK) +#define INT_TTO1 (1 << INT_V_TTO1) +//#define INT_TTO2 (1 << INT_V_TTO2) +//#define INT_TTO3 (1 << INT_V_TTO3) +//#define INT_TTO4 (1 << INT_V_TTO4) +#define INT_TTI1 (1 << INT_V_TTI1) +//#define INT_TTI2 (1 << INT_V_TTI2) +//#define INT_TTI3 (1 << INT_V_TTI3) +//#define INT_TTI4 (1 << INT_V_TTI4) +#define INT_RX (1 << INT_V_RX) +#define INT_RK (1 << INT_V_RK) +#define INT_RF (1 << INT_V_RF) +#define INT_DF (1 << INT_V_DF) +#define INT_MT (1 << INT_V_MT) +#define INT_DTA (1 << INT_V_DTA) +#define INT_RL (1 << INT_V_RL) +#define INT_CT (1 << INT_V_CT) +#define INT_PWR (1 << INT_V_PWR) +#define INT_UF (1 << INT_V_UF) +#define INT_TSC (1 << INT_V_TSC) +#define INT_FPP (1 << INT_V_FPP) +#define INT_NO_ION_PENDING (1 << INT_V_NO_ION_PENDING) +#define INT_NO_CIF_PENDING (1 << INT_V_NO_CIF_PENDING) +#define INT_ION (1 << INT_V_ION) +#define INT_DEV_ENABLE ((1 << INT_V_DIRECT) - 1) /* devices w/enables */ +#define INT_ALL ((1 << INT_V_OVHD) - 1) /* all interrupts */ +#define INT_INIT_ENABLE (INT_TTI+INT_TTO+INT_PTR+INT_PTP+INT_LPT) | \ + (INT_TTI1+INT_TTO1) +#define INT_PENDING (INT_ION+INT_NO_CIF_PENDING+INT_NO_ION_PENDING) +#define INT_UPDATE ((int_req & ~INT_DEV_ENABLE) | (dev_done & int_enable)) + +/* Function prototypes */ + +t_stat set_dev (UNIT *uptr, int32 val, CONST char *cptr, void *desc); +t_stat show_dev (FILE *st, UNIT *uptr, int32 val, CONST void *desc); + +void cpu_set_bootpc (int32 pc); + +#endif ADDED src/PDP8/pdp8_df.c Index: src/PDP8/pdp8_df.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_df.c @@ -0,0 +1,382 @@ +/* pdp8_df.c: DF32 fixed head disk simulator + + Copyright (c) 1993-2013, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + df DF32 fixed head disk + + 17-Sep-13 RMS Changed to use central set_bootpc routine + 03-Sep-13 RMS Added explicit void * cast + 15-May-06 RMS Fixed bug in autosize attach (Dave Gesswein) + 07-Jan-06 RMS Fixed unaligned register access bug (Doug Carman) + 04-Jan-04 RMS Changed sim_fsize calling sequence + 26-Oct-03 RMS Cleaned up buffer copy code + 26-Jul-03 RMS Fixed bug in set size routine + 14-Mar-03 RMS Fixed variable platter interaction with save/restore + 03-Mar-03 RMS Fixed autosizing + 02-Feb-03 RMS Added variable platter and autosizing support + 04-Oct-02 RMS Added DIBs, device number support + 28-Nov-01 RMS Added RL8A support + 25-Apr-01 RMS Added device enable/disable support + + The DF32 is a head-per-track disk. It uses the three cycle data break + facility. To minimize overhead, the entire DF32 is buffered in memory. + + Two timing parameters are provided: + + df_time Interword timing, must be non-zero + df_burst Burst mode, if 0, DMA occurs cycle by cycle; otherwise, + DMA occurs in a burst +*/ + +#include "pdp8_defs.h" +#include + +#define UNIT_V_AUTO (UNIT_V_UF + 0) /* autosize */ +#define UNIT_V_PLAT (UNIT_V_UF + 1) /* #platters - 1 */ +#define UNIT_M_PLAT 03 +#define UNIT_PLAT (UNIT_M_PLAT << UNIT_V_PLAT) +#define UNIT_GETP(x) ((((x) >> UNIT_V_PLAT) & UNIT_M_PLAT) + 1) +#define UNIT_AUTO (1 << UNIT_V_AUTO) +#define UNIT_PLAT (UNIT_M_PLAT << UNIT_V_PLAT) + +/* Constants */ + +#define DF_NUMWD 2048 /* words/track */ +#define DF_NUMTR 16 /* tracks/disk */ +#define DF_DKSIZE (DF_NUMTR * DF_NUMWD) /* words/disk */ +#define DF_NUMDK 4 /* disks/controller */ +#define DF_WC 07750 /* word count */ +#define DF_MA 07751 /* mem address */ +#define DF_WMASK (DF_NUMWD - 1) /* word mask */ + +/* Parameters in the unit descriptor */ + +#define FUNC u4 /* function */ +#define DF_READ 2 /* read */ +#define DF_WRITE 4 /* write */ + +/* Status register */ + +#define DFS_PCA 04000 /* photocell status */ +#define DFS_DEX 03700 /* disk addr extension */ +#define DFS_MEX 00070 /* mem addr extension */ +#define DFS_DRL 00004 /* data late error */ +#define DFS_WLS 00002 /* write lock error */ +#define DFS_NXD 00002 /* non-existent disk */ +#define DFS_PER 00001 /* parity error */ +#define DFS_ERR (DFS_DRL | DFS_WLS | DFS_PER) +#define DFS_V_DEX 6 +#define DFS_V_MEX 3 + +#define GET_MEX(x) (((x) & DFS_MEX) << (12 - DFS_V_MEX)) +#define GET_DEX(x) (((x) & DFS_DEX) << (12 - DFS_V_DEX)) +#define GET_POS(x) ((int) fmod (sim_gtime() / ((double) (x)), \ + ((double) DF_NUMWD))) +#define UPDATE_PCELL if (GET_POS (df_time) < 6) df_sta = df_sta | DFS_PCA; \ + else df_sta = df_sta & ~DFS_PCA + +extern uint16 M[]; +extern int32 int_req, stop_inst; +extern UNIT cpu_unit; + +int32 df_sta = 0; /* status register */ +int32 df_da = 0; /* disk address */ +int32 df_done = 0; /* done flag */ +int32 df_wlk = 0; /* write lock */ +int32 df_time = 10; /* inter-word time */ +int32 df_burst = 1; /* burst mode flag */ +int32 df_stopioe = 1; /* stop on error */ + +int32 df60 (int32 IR, int32 AC); +int32 df61 (int32 IR, int32 AC); +int32 df62 (int32 IR, int32 AC); +t_stat df_svc (UNIT *uptr); +t_stat pcell_svc (UNIT *uptr); +t_stat df_reset (DEVICE *dptr); +t_stat df_boot (int32 unitno, DEVICE *dptr); +t_stat df_attach (UNIT *uptr, CONST char *cptr); +t_stat df_set_size (UNIT *uptr, int32 val, CONST char *cptr, void *desc); + +/* DF32 data structures + + df_dev RF device descriptor + df_unit RF unit descriptor + pcell_unit photocell timing unit (orphan) + df_reg RF register list +*/ + +DIB df_dib = { DEV_DF, 3, { &df60, &df61, &df62 } }; + +UNIT df_unit = { + UDATA (&df_svc, UNIT_FIX+UNIT_ATTABLE+UNIT_BUFABLE+UNIT_MUSTBUF, + DF_DKSIZE) + }; + +REG df_reg[] = { + { ORDATAD (STA, df_sta, 12, "status, disk and memory address extension") }, + { ORDATAD (DA, df_da, 12, "low order disk address") }, + { ORDATAD (WC, M[DF_WC], 12, "word count (in memory)"), REG_FIT }, + { ORDATAD (MA, M[DF_MA], 12, "memory address (in memory)"), REG_FIT }, + { FLDATAD (DONE, df_done, 0, "device done flag") }, + { FLDATAD (INT, int_req, INT_V_DF, "interrupt pending flag") }, + { ORDATAD (WLS, df_wlk, 8, "write lock switches") }, + { DRDATAD (TIME, df_time, 24, "rotational delay, per word"), REG_NZ + PV_LEFT }, + { FLDATAD (BURST, df_burst, 0, "burst flag") }, + { FLDATAD (STOP_IOE, df_stopioe, 0, "stop on I/O error") }, + { DRDATA (CAPAC, df_unit.capac, 18), REG_HRO }, + { ORDATA (DEVNUM, df_dib.dev, 6), REG_HRO }, + { NULL } + }; + +MTAB df_mod[] = { + { UNIT_PLAT, (0 << UNIT_V_PLAT), NULL, "1P", &df_set_size }, + { UNIT_PLAT, (1 << UNIT_V_PLAT), NULL, "2P", &df_set_size }, + { UNIT_PLAT, (2 << UNIT_V_PLAT), NULL, "3P", &df_set_size }, + { UNIT_PLAT, (3 << UNIT_V_PLAT), NULL, "4P", &df_set_size }, + { MTAB_XTD|MTAB_VDV, 0, "DEVNO", "DEVNO", + &set_dev, &show_dev, NULL }, + { 0 } + }; + +DEVICE df_dev = { + "DF", &df_unit, df_reg, df_mod, + 1, 8, 17, 1, 8, 12, + NULL, NULL, &df_reset, + &df_boot, &df_attach, NULL, + &df_dib, DEV_DISABLE + }; + +/* IOT routines */ + +int32 df60 (int32 IR, int32 AC) +{ +int32 t; +int32 pulse = IR & 07; + +UPDATE_PCELL; /* update photocell */ +if (pulse & 1) { /* DCMA */ + df_da = 0; /* clear disk addr */ + df_done = 0; /* clear done */ + df_sta = df_sta & ~DFS_ERR; /* clear errors */ + int_req = int_req & ~INT_DF; /* clear int req */ + } +if (pulse & 6) { /* DMAR, DMAW */ + df_da = df_da | AC; /* disk addr |= AC */ + df_unit.FUNC = pulse & ~1; /* save function */ + t = (df_da & DF_WMASK) - GET_POS (df_time); /* delta to new loc */ + if (t < 0) /* wrap around? */ + t = t + DF_NUMWD; + sim_activate (&df_unit, t * df_time); /* schedule op */ + AC = 0; /* clear AC */ + } +return AC; +} + +/* Based on the hardware implementation. DEAL and DEAC work as follows: + + 6615 pulse 1 = clear df_sta + pulse 4 = df_sta = df_sta | AC + AC = AC | old_df_sta + 6616 pulse 2 = clear AC, skip if address confirmed + pulse 4 = df_sta = df_sta | AC = 0 (nop) + AC = AC | old_df_sta +*/ + +int32 df61 (int32 IR, int32 AC) +{ +int32 old_df_sta = df_sta; +int32 pulse = IR & 07; + +UPDATE_PCELL; /* update photocell */ +if (pulse & 1) /* DCEA */ + df_sta = df_sta & ~(DFS_DEX | DFS_MEX); /* clear dex, mex */ +if (pulse & 2) /* DSAC */ + AC = ((df_da & DF_WMASK) == GET_POS (df_time))? IOT_SKP: 0; +if (pulse & 4) { + df_sta = df_sta | (AC & (DFS_DEX | DFS_MEX)); /* DEAL */ + AC = AC | old_df_sta; /* DEAC */ + } +return AC; +} + +int32 df62 (int32 IR, int32 AC) +{ +int32 pulse = IR & 07; + +UPDATE_PCELL; /* update photocell */ +if (pulse & 1) { /* DFSE */ + if ((df_sta & DFS_ERR) == 0) + AC = AC | IOT_SKP; + } +if (pulse & 2) { /* DFSC */ + if (pulse & 4) /* for DMAC */ + AC = AC & ~07777; + else if (df_done) + AC = AC | IOT_SKP; + } +if (pulse & 4) /* DMAC */ + AC = AC | df_da; +return AC; +} + +/* Unit service + + Note that for reads and writes, memory addresses wrap around in the + current field. This code assumes the entire disk is buffered. +*/ + +t_stat df_svc (UNIT *uptr) +{ +int32 pa, t, mex; +uint32 da; +int16 *fbuf = (int16 *) uptr->filebuf; + +UPDATE_PCELL; /* update photocell */ +if ((uptr->flags & UNIT_BUF) == 0) { /* not buf? abort */ + df_done = 1; + int_req = int_req | INT_DF; /* update int req */ + return IORETURN (df_stopioe, SCPE_UNATT); + } + +mex = GET_MEX (df_sta); +da = GET_DEX (df_sta) | df_da; /* form disk addr */ +do { + if (da >= uptr->capac) { /* nx disk addr? */ + df_sta = df_sta | DFS_NXD; + break; + } + M[DF_WC] = (M[DF_WC] + 1) & 07777; /* incr word count */ + M[DF_MA] = (M[DF_MA] + 1) & 07777; /* incr mem addr */ + pa = mex | M[DF_MA]; /* add extension */ + if (uptr->FUNC == DF_READ) { /* read? */ + if (MEM_ADDR_OK (pa)) M[pa] = fbuf[da]; /* if !nxm, read wd */ + } + else { /* write */ + t = (da >> 14) & 07; /* check wr lock */ + if ((df_wlk >> t) & 1) /* locked? set err */ + df_sta = df_sta | DFS_WLS; + else { /* not locked */ + fbuf[da] = M[pa]; /* write word */ + if (da >= uptr->hwmark) uptr->hwmark = da + 1; + } + } + da = (da + 1) & 0377777; /* incr disk addr */ + } while ((M[DF_WC] != 0) && (df_burst != 0)); /* brk if wc, no brst */ + +if ((M[DF_WC] != 0) && ((df_sta & DFS_ERR) == 0)) /* more to do? */ + sim_activate (&df_unit, df_time); /* sched next */ +else { + if (uptr->FUNC != DF_READ) + da = (da - 1) & 0377777; + df_done = 1; /* done */ + int_req = int_req | INT_DF; /* update int req */ + } +df_sta = (df_sta & ~DFS_DEX) | ((da >> (12 - DFS_V_DEX)) & DFS_DEX); +df_da = da & 07777; /* separate disk addr */ +return SCPE_OK; +} + +/* Reset routine */ + +t_stat df_reset (DEVICE *dptr) +{ +df_sta = df_da = 0; +df_done = 1; +int_req = int_req & ~INT_DF; /* clear interrupt */ +sim_cancel (&df_unit); +return SCPE_OK; +} + +/* Bootstrap routine */ + +#define OS8_START 07750 +#define OS8_LEN (sizeof (os8_rom) / sizeof (int16)) +#define DM4_START 00200 +#define DM4_LEN (sizeof (dm4_rom) / sizeof (int16)) + +static const uint16 os8_rom[] = { + 07600, /* 7750, CLA CLL ; also word count */ + 06603, /* 7751, DMAR ; also address */ + 06622, /* 7752, DFSC ; done? */ + 05352, /* 7753, JMP .-1 ; no */ + 05752 /* 7754, JMP @.-2 ; enter boot */ + }; + +static const uint16 dm4_rom[] = { + 00200, 07600, /* 0200, CLA CLL */ + 00201, 06603, /* 0201, DMAR ; read */ + 00202, 06622, /* 0202, DFSC ; done? */ + 00203, 05202, /* 0203, JMP .-1 ; no */ + 00204, 05600, /* 0204, JMP @.-4 ; enter boot */ + 07750, 07576, /* 7750, 7576 ; word count */ + 07751, 07576 /* 7751, 7576 ; address */ + }; + +t_stat df_boot (int32 unitno, DEVICE *dptr) +{ +size_t i; + +if (sim_switches & SWMASK ('D')) { + for (i = 0; i < DM4_LEN; i = i + 2) + M[dm4_rom[i]] = dm4_rom[i + 1]; + cpu_set_bootpc (DM4_START); + } +else { + for (i = 0; i < OS8_LEN; i++) + M[OS8_START + i] = os8_rom[i]; + cpu_set_bootpc (OS8_START); + } +return SCPE_OK; +} + +/* Attach routine */ + +t_stat df_attach (UNIT *uptr, CONST char *cptr) +{ +uint32 p, sz; +uint32 ds_bytes = DF_DKSIZE * sizeof (int16); + +if ((uptr->flags & UNIT_AUTO) && (sz = sim_fsize_name (cptr))) { + p = (sz + ds_bytes - 1) / ds_bytes; + if (p >= DF_NUMDK) + p = DF_NUMDK - 1; + uptr->flags = (uptr->flags & ~UNIT_PLAT) | + (p << UNIT_V_PLAT); + } +uptr->capac = UNIT_GETP (uptr->flags) * DF_DKSIZE; +return attach_unit (uptr, cptr); +} + +/* Change disk size */ + +t_stat df_set_size (UNIT *uptr, int32 val, CONST char *cptr, void *desc) +{ +if (val < 0) + return SCPE_IERR; +if (uptr->flags & UNIT_ATT) + return SCPE_ALATT; +uptr->capac = UNIT_GETP (val) * DF_DKSIZE; +uptr->flags = uptr->flags & ~UNIT_AUTO; +return SCPE_OK; +} ADDED src/PDP8/pdp8_dt.c Index: src/PDP8/pdp8_dt.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_dt.c @@ -0,0 +1,1343 @@ +/* pdp8_dt.c: PDP-8 DECtape simulator + + Copyright (c) 1993-2013, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + dt TC08/TU56 DECtape + + 17-Sep-13 RMS Changed to use central set_bootpc routine + 23-Jun-06 RMS Fixed switch conflict in ATTACH + 07-Jan-06 RMS Fixed unaligned register access bug (Doug Carman) + 16-Aug-05 RMS Fixed C++ declaration and cast problems + 25-Jan-04 RMS Revised for device debug support + 09-Jan-04 RMS Changed sim_fsize calling sequence, added STOP_OFFR + 18-Oct-03 RMS Fixed bugs in read all, tightened timing + 25-Apr-03 RMS Revised for extended file support + 14-Mar-03 RMS Fixed sizing interaction with save/restore + 17-Oct-02 RMS Fixed bug in end of reel logic + 04-Oct-02 RMS Added DIB, device number support + 12-Sep-02 RMS Added support for 16b format + 30-May-02 RMS Widened POS to 32b + 06-Jan-02 RMS Changed enable/disable support + 30-Nov-01 RMS Added read only unit, extended SET/SHOW support + 24-Nov-01 RMS Changed POS, STATT, LASTT, FLG to arrays + 29-Aug-01 RMS Added casts to PDP-18b packup routine + 17-Jul-01 RMS Moved function prototype + 11-May-01 RMS Fixed bug in reset + 25-Apr-01 RMS Added device enable/disable support + 18-Apr-01 RMS Changed to rewind tape before boot + 19-Mar-01 RMS Changed bootstrap to support 4k disk monitor + 15-Mar-01 RMS Added 129th word to PDP-8 format + + PDP-8 DECtapes are represented in memory by fixed length buffer of 16b words. + Three file formats are supported: + + 18b/36b 256 words per block [256 x 18b] + 16b 256 words per block [256 x 16b] + 12b 129 words per block [129 x 12b] + + When a 16b or 18/36bb DECtape file is read in, it is converted to 12b format. + + DECtape motion is measured in 3b lines. Time between lines is 33.33us. + Tape density is nominally 300 lines per inch. The format of a DECtape (as + taken from the TD8E formatter) is: + + reverse end zone 8192 reverse end zone codes ~ 10 feet + reverse buffer 200 interblock codes + block 0 + : + block n + forward buffer 200 interblock codes + forward end zone 8192 forward end zone codes ~ 10 feet + + A block consists of five 18b header words, a tape-specific number of data + words, and five 18b trailer words. All systems except the PDP-8 use a + standard block length of 256 words; the PDP-8 uses a standard block length + of 86 words (x 18b = 129 words x 12b). + + Because a DECtape file only contains data, the simulator cannot support + write timing and mark track and can only do a limited implementation + of read all and write all. Read all assumes that the tape has been + conventionally written forward: + + header word 0 0 + header word 1 block number (for forward reads) + header words 2,3 0 + header word 4 checksum (for reverse reads) + : + trailer word 4 checksum (for forward reads) + trailer words 3,2 0 + trailer word 1 block number (for reverse reads) + trailer word 0 0 + + Write all writes only the data words and dumps the non-data words in the + bit bucket. +*/ + +#include "pdp8_defs.h" + +#define DT_NUMDR 8 /* #drives */ +#define UNIT_V_WLK (UNIT_V_UF + 0) /* write locked */ +#define UNIT_V_8FMT (UNIT_V_UF + 1) /* 12b format */ +#define UNIT_V_11FMT (UNIT_V_UF + 2) /* 16b format */ +#define UNIT_WLK (1 << UNIT_V_WLK) +#define UNIT_8FMT (1 << UNIT_V_8FMT) +#define UNIT_11FMT (1 << UNIT_V_11FMT) +#define STATE u3 /* unit state */ +#define LASTT u4 /* last time update */ +#define WRITTEN u5 /* device buffer is dirty and needs flushing */ +#define DT_WC 07754 /* word count */ +#define DT_CA 07755 /* current addr */ +#define UNIT_WPRT (UNIT_WLK | UNIT_RO) /* write protect */ + +/* System independent DECtape constants */ + +#define DT_LPERMC 6 /* lines per mark track */ +#define DT_BLKWD 1 /* blk no word in h/t */ +#define DT_CSMWD 4 /* checksum word in h/t */ +#define DT_HTWRD 5 /* header/trailer words */ +#define DT_EZLIN (8192 * DT_LPERMC) /* end zone length */ +#define DT_BFLIN (200 * DT_LPERMC) /* buffer length */ +#define DT_BLKLN (DT_BLKWD * DT_LPERMC) /* blk no line in h/t */ +#define DT_CSMLN (DT_CSMWD * DT_LPERMC) /* csum line in h/t */ +#define DT_HTLIN (DT_HTWRD * DT_LPERMC) /* header/trailer lines */ + +/* 16b, 18b, 36b DECtape constants */ + +#define D18_WSIZE 6 /* word size in lines */ +#define D18_BSIZE 384 /* block size in 12b */ +#define D18_TSIZE 578 /* tape size */ +#define D18_LPERB (DT_HTLIN + (D18_BSIZE * DT_WSIZE) + DT_HTLIN) +#define D18_FWDEZ (DT_EZLIN + (D18_LPERB * D18_TSIZE)) +#define D18_CAPAC (D18_TSIZE * D18_BSIZE) /* tape capacity */ + +#define D18_NBSIZE ((D18_BSIZE * D8_WSIZE) / D18_WSIZE) +#define D18_FILSIZ (D18_NBSIZE * D18_TSIZE * sizeof (int32)) +#define D11_FILSIZ (D18_NBSIZE * D18_TSIZE * sizeof (int16)) + +/* 12b DECtape constants */ + +#define D8_WSIZE 4 /* word size in lines */ +#define D8_BSIZE 129 /* block size in 12b */ +#define D8_TSIZE 1474 /* tape size */ +#define D8_LPERB (DT_HTLIN + (D8_BSIZE * DT_WSIZE) + DT_HTLIN) +#define D8_FWDEZ (DT_EZLIN + (D8_LPERB * D8_TSIZE)) +#define D8_CAPAC (D8_TSIZE * D8_BSIZE) /* tape capacity */ +#define D8_FILSIZ (D8_CAPAC * sizeof (int16)) + +/* This controller */ + +#define DT_CAPAC D8_CAPAC /* default */ +#define DT_WSIZE D8_WSIZE + +/* Calculated constants, per unit */ + +#define DTU_BSIZE(u) (((u)->flags & UNIT_8FMT)? D8_BSIZE: D18_BSIZE) +#define DTU_TSIZE(u) (((u)->flags & UNIT_8FMT)? D8_TSIZE: D18_TSIZE) +#define DTU_LPERB(u) (((u)->flags & UNIT_8FMT)? D8_LPERB: D18_LPERB) +#define DTU_FWDEZ(u) (((u)->flags & UNIT_8FMT)? D8_FWDEZ: D18_FWDEZ) +#define DTU_CAPAC(u) (((u)->flags & UNIT_8FMT)? D8_CAPAC: D18_CAPAC) + +#define DT_LIN2BL(p,u) (((p) - DT_EZLIN) / DTU_LPERB (u)) +#define DT_LIN2OF(p,u) (((p) - DT_EZLIN) % DTU_LPERB (u)) +#define DT_LIN2WD(p,u) ((DT_LIN2OF (p,u) - DT_HTLIN) / DT_WSIZE) +#define DT_BLK2LN(p,u) (((p) * DTU_LPERB (u)) + DT_EZLIN) +#define DT_QREZ(u) (((u)->pos) < DT_EZLIN) +#define DT_QFEZ(u) (((u)->pos) >= ((uint32) DTU_FWDEZ (u))) +#define DT_QEZ(u) (DT_QREZ (u) || DT_QFEZ (u)) + +/* Status register A */ + +#define DTA_V_UNIT 9 /* unit select */ +#define DTA_M_UNIT 07 +#define DTA_UNIT (DTA_M_UNIT << DTA_V_UNIT) +#define DTA_V_MOT 7 /* motion */ +#define DTA_M_MOT 03 +#define DTA_V_MODE 6 /* mode */ +#define DTA_V_FNC 3 /* function */ +#define DTA_M_FNC 07 +#define FNC_MOVE 00 /* move */ +#define FNC_SRCH 01 /* search */ +#define FNC_READ 02 /* read */ +#define FNC_RALL 03 /* read all */ +#define FNC_WRIT 04 /* write */ +#define FNC_WALL 05 /* write all */ +#define FNC_WMRK 06 /* write timing */ +#define DTA_V_ENB 2 /* int enable */ +#define DTA_V_CERF 1 /* clr error flag */ +#define DTA_V_CDTF 0 /* clr DECtape flag */ +#define DTA_FWDRV (1u << (DTA_V_MOT + 1)) +#define DTA_STSTP (1u << DTA_V_MOT) +#define DTA_MODE (1u << DTA_V_MODE) +#define DTA_ENB (1u << DTA_V_ENB) +#define DTA_CERF (1u << DTA_V_CERF) +#define DTA_CDTF (1u << DTA_V_CDTF) +#define DTA_RW (07777 & ~(DTA_CERF | DTA_CDTF)) + +#define DTA_GETUNIT(x) (((x) >> DTA_V_UNIT) & DTA_M_UNIT) +#define DTA_GETMOT(x) (((x) >> DTA_V_MOT) & DTA_M_MOT) +#define DTA_GETFNC(x) (((x) >> DTA_V_FNC) & DTA_M_FNC) + +/* Status register B */ + +#define DTB_V_ERF 11 /* error flag */ +#define DTB_V_MRK 10 /* mark trk err */ +#define DTB_V_END 9 /* end zone err */ +#define DTB_V_SEL 8 /* select err */ +#define DTB_V_PAR 7 /* parity err */ +#define DTB_V_TIM 6 /* timing err */ +#define DTB_V_MEX 3 /* memory extension */ +#define DTB_M_MEX 07 +#define DTB_MEX (DTB_M_MEX << DTB_V_MEX) +#define DTB_V_DTF 0 /* DECtape flag */ +#define DTB_ERF (1u << DTB_V_ERF) +#define DTB_MRK (1u << DTB_V_MRK) +#define DTB_END (1u << DTB_V_END) +#define DTB_SEL (1u << DTB_V_SEL) +#define DTB_PAR (1u << DTB_V_PAR) +#define DTB_TIM (1u << DTB_V_TIM) +#define DTB_DTF (1u << DTB_V_DTF) +#define DTB_ALLERR (DTB_ERF | DTB_MRK | DTB_END | DTB_SEL | \ + DTB_PAR | DTB_TIM) +#define DTB_GETMEX(x) (((x) & DTB_MEX) << (12 - DTB_V_MEX)) + +/* DECtape state */ + +#define DTS_V_MOT 3 /* motion */ +#define DTS_M_MOT 07 +#define DTS_STOP 0 /* stopped */ +#define DTS_DECF 2 /* decel, fwd */ +#define DTS_DECR 3 /* decel, rev */ +#define DTS_ACCF 4 /* accel, fwd */ +#define DTS_ACCR 5 /* accel, rev */ +#define DTS_ATSF 6 /* @speed, fwd */ +#define DTS_ATSR 7 /* @speed, rev */ +#define DTS_DIR 01 /* dir mask */ +#define DTS_V_FNC 0 /* function */ +#define DTS_M_FNC 07 +#define DTS_OFR 7 /* "off reel" */ +#define DTS_GETMOT(x) (((x) >> DTS_V_MOT) & DTS_M_MOT) +#define DTS_GETFNC(x) (((x) >> DTS_V_FNC) & DTS_M_FNC) +#define DTS_V_2ND 6 /* next state */ +#define DTS_V_3RD (DTS_V_2ND + DTS_V_2ND) /* next next */ +#define DTS_STA(y,z) (((y) << DTS_V_MOT) | ((z) << DTS_V_FNC)) +#define DTS_SETSTA(y,z) uptr->STATE = DTS_STA (y, z) +#define DTS_SET2ND(y,z) uptr->STATE = (uptr->STATE & 077) | \ + ((DTS_STA (y, z)) << DTS_V_2ND) +#define DTS_SET3RD(y,z) uptr->STATE = (uptr->STATE & 07777) | \ + ((DTS_STA (y, z)) << DTS_V_3RD) +#define DTS_NXTSTA(x) (x >> DTS_V_2ND) + +/* Operation substates */ + +#define DTO_WCO 1 /* wc overflow */ +#define DTO_SOB 2 /* start of block */ + +/* Logging */ + +#define LOG_MS 001 /* move, search */ +#define LOG_RW 002 /* read, write */ +#define LOG_BL 004 /* block # lblk */ + +#define DT_UPDINT if ((dtsa & DTA_ENB) && (dtsb & (DTB_ERF | DTB_DTF))) \ + int_req = int_req | INT_DTA; \ + else int_req = int_req & ~INT_DTA; +#define ABS(x) (((x) < 0)? (-(x)): (x)) + +extern uint16 M[]; +extern int32 int_req; +extern UNIT cpu_unit; + +int32 dtsa = 0; /* status A */ +int32 dtsb = 0; /* status B */ +int32 dt_ltime = 12; /* interline time */ +int32 dt_dctime = 40000; /* decel time */ +int32 dt_substate = 0; +int32 dt_logblk = 0; +int32 dt_stopoffr = 0; + +int32 dt76 (int32 IR, int32 AC); +int32 dt77 (int32 IR, int32 AC); +t_stat dt_svc (UNIT *uptr); +t_stat dt_reset (DEVICE *dptr); +t_stat dt_attach (UNIT *uptr, CONST char *cptr); +void dt_flush (UNIT *uptr); +t_stat dt_detach (UNIT *uptr); +t_stat dt_boot (int32 unitno, DEVICE *dptr); +void dt_deselect (int32 oldf); +void dt_newsa (int32 newf); +void dt_newfnc (UNIT *uptr, int32 newsta); +t_bool dt_setpos (UNIT *uptr); +void dt_schedez (UNIT *uptr, int32 dir); +void dt_seterr (UNIT *uptr, int32 e); +int32 dt_comobv (int32 val); +int32 dt_csum (UNIT *uptr, int32 blk); +int32 dt_gethdr (UNIT *uptr, int32 blk, int32 relpos, int32 dir); + +/* DT data structures + + dt_dev DT device descriptor + dt_unit DT unit list + dt_reg DT register list + dt_mod DT modifier list +*/ + +DIB dt_dib = { DEV_DTA, 2, { &dt76, &dt77 } }; + +UNIT dt_unit[] = { + { UDATA (&dt_svc, UNIT_8FMT+UNIT_FIX+UNIT_ATTABLE+ + UNIT_DISABLE+UNIT_ROABLE, DT_CAPAC) }, + { UDATA (&dt_svc, UNIT_8FMT+UNIT_FIX+UNIT_ATTABLE+ + UNIT_DISABLE+UNIT_ROABLE, DT_CAPAC) }, + { UDATA (&dt_svc, UNIT_8FMT+UNIT_FIX+UNIT_ATTABLE+ + UNIT_DISABLE+UNIT_ROABLE, DT_CAPAC) }, + { UDATA (&dt_svc, UNIT_8FMT+UNIT_FIX+UNIT_ATTABLE+ + UNIT_DISABLE+UNIT_ROABLE, DT_CAPAC) }, + { UDATA (&dt_svc, UNIT_8FMT+UNIT_FIX+UNIT_ATTABLE+ + UNIT_DISABLE+UNIT_ROABLE, DT_CAPAC) }, + { UDATA (&dt_svc, UNIT_8FMT+UNIT_FIX+UNIT_ATTABLE+ + UNIT_DISABLE+UNIT_ROABLE, DT_CAPAC) }, + { UDATA (&dt_svc, UNIT_8FMT+UNIT_FIX+UNIT_ATTABLE+ + UNIT_DISABLE+UNIT_ROABLE, DT_CAPAC) }, + { UDATA (&dt_svc, UNIT_8FMT+UNIT_FIX+UNIT_ATTABLE+ + UNIT_DISABLE+UNIT_ROABLE, DT_CAPAC) } + }; + +REG dt_reg[] = { + { ORDATAD (DTSA, dtsa, 12, "status register A") }, + { ORDATAD (DTSB, dtsb, 12, "status register B") }, + { FLDATAD (INT, int_req, INT_V_DTA, "interrupt pending flag") }, + { FLDATAD (ENB, dtsa, DTA_V_ENB, "interrupt enable flag") }, + { FLDATAD (DTF, dtsb, DTB_V_DTF, "DECtape flag") }, + { FLDATAD (ERF, dtsb, DTB_V_ERF, "error flag") }, + { ORDATAD (WC, M[DT_WC], 12, "word count (memory location 7755)"), REG_FIT }, + { ORDATAD (CA, M[DT_CA], 12, "current address (memory location 7754)"), REG_FIT }, + { DRDATAD (LTIME, dt_ltime, 24, "time between lines"), REG_NZ | PV_LEFT }, + { DRDATAD (DCTIME, dt_dctime, 24, "time to decelerate to a full stop"), REG_NZ | PV_LEFT }, + { ORDATAD (SUBSTATE, dt_substate, 2, "read/write command substate") }, + { DRDATA (LBLK, dt_logblk, 12), REG_HIDDEN }, + { URDATAD (POS, dt_unit[0].pos, 10, T_ADDR_W, 0, + DT_NUMDR, PV_LEFT | REG_RO, "position, in lines, units 0 to 7") }, + { URDATAD (STATT, dt_unit[0].STATE, 8, 18, 0, + DT_NUMDR, REG_RO, "unit state, units 0 to 7") }, + { URDATA (LASTT, dt_unit[0].LASTT, 10, 32, 0, + DT_NUMDR, REG_HRO) }, + { FLDATAD (STOP_OFFR, dt_stopoffr, 0, "stop on off-reel error") }, + { ORDATA (DEVNUM, dt_dib.dev, 6), REG_HRO }, + { NULL } + }; + +MTAB dt_mod[] = { + { UNIT_WLK, 0, "write enabled", "WRITEENABLED", NULL }, + { UNIT_WLK, UNIT_WLK, "write locked", "LOCKED", NULL }, + { UNIT_8FMT + UNIT_11FMT, 0, "18b", NULL, NULL }, + { UNIT_8FMT + UNIT_11FMT, UNIT_8FMT, "12b", NULL, NULL }, + { UNIT_8FMT + UNIT_11FMT, UNIT_11FMT, "16b", NULL, NULL }, + { MTAB_XTD|MTAB_VDV, 0, "DEVNO", "DEVNO", + &set_dev, &show_dev, NULL }, + { 0 } + }; + +DEBTAB dt_deb[] = { + { "MOTION", LOG_MS }, + { "DATA", LOG_RW }, + { "BLOCK", LOG_BL }, + { NULL, 0 } + }; + +DEVICE dt_dev = { + "DT", dt_unit, dt_reg, dt_mod, + DT_NUMDR, 8, 24, 1, 8, 12, + NULL, NULL, &dt_reset, + &dt_boot, &dt_attach, &dt_detach, + &dt_dib, DEV_DISABLE | DEV_DEBUG, 0, + dt_deb, NULL, NULL + }; + +/* IOT routines */ + +int32 dt76 (int32 IR, int32 AC) +{ +int32 pulse = IR & 07; +int32 old_dtsa = dtsa, fnc; +UNIT *uptr; + +if (pulse & 01) /* DTRA */ + AC = AC | dtsa; +if (pulse & 06) { /* select */ + if (pulse & 02) /* DTCA */ + dtsa = 0; + if (pulse & 04) { /* DTXA */ + if ((AC & DTA_CERF) == 0) dtsb = dtsb & ~DTB_ALLERR; + if ((AC & DTA_CDTF) == 0) dtsb = dtsb & ~DTB_DTF; + dtsa = dtsa ^ (AC & DTA_RW); + AC = 0; /* clr AC */ + } + if ((old_dtsa ^ dtsa) & DTA_UNIT) + dt_deselect (old_dtsa); + uptr = dt_dev.units + DTA_GETUNIT (dtsa); /* get unit */ + fnc = DTA_GETFNC (dtsa); /* get fnc */ + if (((uptr->flags) & UNIT_DIS) || /* disabled? */ + (fnc >= FNC_WMRK) || /* write mark? */ + ((fnc == FNC_WALL) && (uptr->flags & UNIT_WPRT)) || + ((fnc == FNC_WRIT) && (uptr->flags & UNIT_WPRT))) + dt_seterr (uptr, DTB_SEL); /* select err */ + else dt_newsa (dtsa); + DT_UPDINT; + } +return AC; +} + +int32 dt77 (int32 IR, int32 AC) +{ +int32 pulse = IR & 07; + +if ((pulse & 01) && (dtsb & (DTB_ERF |DTB_DTF))) /* DTSF */ + AC = IOT_SKP | AC; +if (pulse & 02) /* DTRB */ + AC = AC | dtsb; +if (pulse & 04) { /* DTLB */ + dtsb = (dtsb & ~DTB_MEX) | (AC & DTB_MEX); + AC = AC & ~07777; /* clear AC */ + } +return AC; +} + +/* Unit deselect */ + +void dt_deselect (int32 oldf) +{ +int32 old_unit = DTA_GETUNIT (oldf); +UNIT *uptr = dt_dev.units + old_unit; +int32 old_mot = DTS_GETMOT (uptr->STATE); + +if (old_mot >= DTS_ATSF) /* at speed? */ + dt_newfnc (uptr, DTS_STA (old_mot, DTS_OFR)); +else if (old_mot >= DTS_ACCF) /* accelerating? */ + DTS_SET2ND (DTS_ATSF | (old_mot & DTS_DIR), DTS_OFR); +return; +} + +/* Command register change + + 1. If change in motion, stop to start + - schedule acceleration + - set function as next state + 2. If change in motion, start to stop + - if not already decelerating (could be reversing), + schedule deceleration + 3. If change in direction, + - if not decelerating, schedule deceleration + - set accelerating (other dir) as next state + - set function as next next state + 4. If not accelerating or at speed, + - schedule acceleration + - set function as next state + 5. If not yet at speed, + - set function as next state + 6. If at speed, + - set function as current state, schedule function +*/ + +void dt_newsa (int32 newf) +{ +int32 new_unit, prev_mot, new_fnc; +int32 prev_mving, new_mving, prev_dir, new_dir; +UNIT *uptr; + +new_unit = DTA_GETUNIT (newf); /* new, old units */ +uptr = dt_dev.units + new_unit; +if ((uptr->flags & UNIT_ATT) == 0) { /* new unit attached? */ + dt_seterr (uptr, DTB_SEL); /* no, error */ + return; + } +prev_mot = DTS_GETMOT (uptr->STATE); /* previous motion */ +prev_mving = prev_mot != DTS_STOP; /* previous moving? */ +prev_dir = prev_mot & DTS_DIR; /* previous dir? */ +new_mving = (newf & DTA_STSTP) != 0; /* new moving? */ +new_dir = (newf & DTA_FWDRV) != 0; /* new dir? */ +new_fnc = DTA_GETFNC (newf); /* new function? */ + +if ((prev_mving | new_mving) == 0) /* stop to stop */ + return; + +if (new_mving & ~prev_mving) { /* start? */ + if (dt_setpos (uptr)) /* update pos */ + return; + sim_cancel (uptr); /* stop current */ + sim_activate (uptr, dt_dctime - (dt_dctime >> 2)); /* schedule acc */ + DTS_SETSTA (DTS_ACCF | new_dir, 0); /* state = accel */ + DTS_SET2ND (DTS_ATSF | new_dir, new_fnc); /* next = fnc */ + return; + } + +if (prev_mving & ~new_mving) { /* stop? */ + if ((prev_mot & ~DTS_DIR) != DTS_DECF) { /* !already stopping? */ + if (dt_setpos (uptr)) /* update pos */ + return; + sim_cancel (uptr); /* stop current */ + sim_activate (uptr, dt_dctime); /* schedule decel */ + } + DTS_SETSTA (DTS_DECF | prev_dir, 0); /* state = decel */ + return; + } + +if (prev_dir ^ new_dir) { /* dir chg? */ + if ((prev_mot & ~DTS_DIR) != DTS_DECF) { /* !already stopping? */ + if (dt_setpos (uptr)) /* update pos */ + return; + sim_cancel (uptr); /* stop current */ + sim_activate (uptr, dt_dctime); /* schedule decel */ + } + DTS_SETSTA (DTS_DECF | prev_dir, 0); /* state = decel */ + DTS_SET2ND (DTS_ACCF | new_dir, 0); /* next = accel */ + DTS_SET3RD (DTS_ATSF | new_dir, new_fnc); /* next next = fnc */ + return; + } + +if (prev_mot < DTS_ACCF) { /* not accel/at speed? */ + if (dt_setpos (uptr)) /* update pos */ + return; + sim_cancel (uptr); /* cancel cur */ + sim_activate (uptr, dt_dctime - (dt_dctime >> 2)); /* sched accel */ + DTS_SETSTA (DTS_ACCF | new_dir, 0); /* state = accel */ + DTS_SET2ND (DTS_ATSF | new_dir, new_fnc); /* next = fnc */ + return; + } + +if (prev_mot < DTS_ATSF) { /* not at speed? */ + DTS_SET2ND (DTS_ATSF | new_dir, new_fnc); /* next = fnc */ + return; + } + +dt_newfnc (uptr, DTS_STA (DTS_ATSF | new_dir, new_fnc));/* state = fnc */ +return; +} + +/* Schedule new DECtape function + + This routine is only called if + - the selected unit is attached + - the selected unit is at speed (forward or backward) + + This routine + - updates the selected unit's position + - updates the selected unit's state + - schedules the new operation +*/ + +void dt_newfnc (UNIT *uptr, int32 newsta) +{ +int32 fnc, dir, blk, unum, relpos, newpos; +uint32 oldpos; + +oldpos = uptr->pos; /* save old pos */ +if (dt_setpos (uptr)) /* update pos */ + return; +uptr->STATE = newsta; /* update state */ +fnc = DTS_GETFNC (uptr->STATE); /* set variables */ +dir = DTS_GETMOT (uptr->STATE) & DTS_DIR; +unum = (int32) (uptr - dt_dev.units); +if (oldpos == uptr->pos) /* bump pos */ + uptr->pos = uptr->pos + (dir? -1: 1); +blk = DT_LIN2BL (uptr->pos, uptr); + +if (dir? DT_QREZ (uptr): DT_QFEZ (uptr)) { /* wrong ez? */ + dt_seterr (uptr, DTB_END); /* set ez flag, stop */ + return; + } +sim_cancel (uptr); /* cancel cur op */ +dt_substate = DTO_SOB; /* substate = block start */ +switch (fnc) { /* case function */ + + case DTS_OFR: /* off reel */ + if (dir) /* rev? < start */ + newpos = -1000; + else newpos = DTU_FWDEZ (uptr) + DT_EZLIN + 1000; /* fwd? > end */ + break; + + case FNC_MOVE: /* move */ + dt_schedez (uptr, dir); /* sched end zone */ + if (DEBUG_PRI (dt_dev, LOG_MS)) fprintf (sim_deb, ">>DT%d: moving %s\n", + unum, (dir? "backward": "forward")); + return; /* done */ + + case FNC_SRCH: /* search */ + if (dir) newpos = DT_BLK2LN ((DT_QFEZ (uptr)? + DTU_TSIZE (uptr): blk), uptr) - DT_BLKLN - DT_WSIZE; + else newpos = DT_BLK2LN ((DT_QREZ (uptr)? + 0: blk + 1), uptr) + DT_BLKLN + (DT_WSIZE - 1); + if (DEBUG_PRI (dt_dev, LOG_MS)) + fprintf (sim_deb, ">>DT%d: searching %s]\n", + unum, (dir? "backward": "forward")); + break; + + case FNC_WRIT: /* write */ + case FNC_READ: /* read */ + case FNC_RALL: /* read all */ + case FNC_WALL: /* write all */ + if (DT_QEZ (uptr)) { /* in "ok" end zone? */ + if (dir) + newpos = DTU_FWDEZ (uptr) - DT_HTLIN - DT_WSIZE; + else newpos = DT_EZLIN + DT_HTLIN + (DT_WSIZE - 1); + break; + } + relpos = DT_LIN2OF (uptr->pos, uptr); /* cur pos in blk */ + if ((relpos >= DT_HTLIN) && /* in data zone? */ + (relpos < (DTU_LPERB (uptr) - DT_HTLIN))) { + dt_seterr (uptr, DTB_SEL); + return; + } + if (dir) + newpos = DT_BLK2LN (((relpos >= (DTU_LPERB (uptr) - DT_HTLIN))? + blk + 1: blk), uptr) - DT_HTLIN - DT_WSIZE; + else newpos = DT_BLK2LN (((relpos < DT_HTLIN)? + blk: blk + 1), uptr) + DT_HTLIN + (DT_WSIZE - 1); + break; + + default: + dt_seterr (uptr, DTB_SEL); /* bad state */ + return; + } + +sim_activate (uptr, ABS (newpos - ((int32) uptr->pos)) * dt_ltime); +return; +} + +/* Update DECtape position + + DECtape motion is modeled as a constant velocity, with linear + acceleration and deceleration. The motion equations are as follows: + + t = time since operation started + tmax = time for operation (accel, decel only) + v = at speed velocity in lines (= 1/dt_ltime) + + Then: + at speed dist = t * v + accel dist = (t^2 * v) / (2 * tmax) + decel dist = (((2 * t * tmax) - t^2) * v) / (2 * tmax) + + This routine uses the relative (integer) time, rather than the absolute + (floating point) time, to allow save and restore of the start times. +*/ + +t_bool dt_setpos (UNIT *uptr) +{ +uint32 new_time, ut, ulin, udelt; +int32 mot = DTS_GETMOT (uptr->STATE); +int32 unum, delta; + +new_time = sim_grtime (); /* current time */ +ut = new_time - uptr->LASTT; /* elapsed time */ +if (ut == 0) /* no time gone? exit */ + return FALSE; +uptr->LASTT = new_time; /* update last time */ +switch (mot & ~DTS_DIR) { /* case on motion */ + + case DTS_STOP: /* stop */ + delta = 0; + break; + + case DTS_DECF: /* slowing */ + ulin = ut / (uint32) dt_ltime; + udelt = dt_dctime / dt_ltime; + delta = ((ulin * udelt * 2) - (ulin * ulin)) / (2 * udelt); + break; + + case DTS_ACCF: /* accelerating */ + ulin = ut / (uint32) dt_ltime; + udelt = (dt_dctime - (dt_dctime >> 2)) / dt_ltime; + delta = (ulin * ulin) / (2 * udelt); + break; + + case DTS_ATSF: /* at speed */ + delta = ut / (uint32) dt_ltime; + break; + } + +if (mot & DTS_DIR) /* update pos */ + uptr->pos = uptr->pos - delta; +else uptr->pos = uptr->pos + delta; +if (((int32) uptr->pos < 0) || + ((int32) uptr->pos > (DTU_FWDEZ (uptr) + DT_EZLIN))) { + detach_unit (uptr); /* off reel? */ + uptr->STATE = uptr->pos = 0; + unum = (int32) (uptr - dt_dev.units); + if (unum == DTA_GETUNIT (dtsa)) /* if selected, */ + dt_seterr (uptr, DTB_SEL); /* error */ + return TRUE; + } +return FALSE; +} + +/* Unit service + + Unit must be attached, detach cancels operation +*/ + +t_stat dt_svc (UNIT *uptr) +{ +int32 mot = DTS_GETMOT (uptr->STATE); +int32 dir = mot & DTS_DIR; +int32 fnc = DTS_GETFNC (uptr->STATE); +int16 *fbuf = (int16 *) uptr->filebuf; +int32 unum = uptr - dt_dev.units; +int32 blk, wrd, ma, relpos, dat; +uint32 ba; + +/* Motion cases + + Decelerating - if next state != stopped, must be accel reverse + Accelerating - next state must be @speed, schedule function + At speed - do functional processing +*/ + +switch (mot) { + + case DTS_DECF: case DTS_DECR: /* decelerating */ + if (dt_setpos (uptr)) /* upd pos; off reel? */ + return IORETURN (dt_stopoffr, STOP_DTOFF); + uptr->STATE = DTS_NXTSTA (uptr->STATE); /* advance state */ + if (uptr->STATE) /* not stopped? */ + sim_activate (uptr, dt_dctime - (dt_dctime >> 2)); /* must be reversing */ + return SCPE_OK; + + case DTS_ACCF: case DTS_ACCR: /* accelerating */ + dt_newfnc (uptr, DTS_NXTSTA (uptr->STATE)); /* adv state, sched */ + return SCPE_OK; + + case DTS_ATSF: case DTS_ATSR: /* at speed */ + break; /* check function */ + + default: /* other */ + dt_seterr (uptr, DTB_SEL); /* state error */ + return SCPE_OK; + } + +/* Functional cases + + Move - must be at end zone + Search - transfer block number, schedule next block + Off reel - detach unit (it must be deselected) +*/ + +if (dt_setpos (uptr)) /* upd pos; off reel? */ + return IORETURN (dt_stopoffr, STOP_DTOFF); +if (DT_QEZ (uptr)) { /* in end zone? */ + dt_seterr (uptr, DTB_END); /* end zone error */ + return SCPE_OK; + } +blk = DT_LIN2BL (uptr->pos, uptr); /* get block # */ +switch (fnc) { /* at speed, check fnc */ + + case FNC_MOVE: /* move */ + dt_seterr (uptr, DTB_END); /* end zone error */ + return SCPE_OK; + + case FNC_SRCH: /* search */ + if (dtsb & DTB_DTF) { /* DTF set? */ + dt_seterr (uptr, DTB_TIM); /* timing error */ + return SCPE_OK; + } + sim_activate (uptr, DTU_LPERB (uptr) * dt_ltime);/* sched next block */ + M[DT_WC] = (M[DT_WC] + 1) & 07777; /* incr word cnt */ + ma = DTB_GETMEX (dtsb) | M[DT_CA]; /* get mem addr */ + if (MEM_ADDR_OK (ma)) /* store block # */ + M[ma] = blk & 07777; + if (((dtsa & DTA_MODE) == 0) || (M[DT_WC] == 0)) + dtsb = dtsb | DTB_DTF; /* set DTF */ + break; + + case DTS_OFR: /* off reel */ + detach_unit (uptr); /* must be deselected */ + uptr->STATE = uptr->pos = 0; /* no visible action */ + break; + +/* Read has four subcases + + Start of block, not wc ovf - check that DTF is clear, otherwise normal + Normal - increment MA, WC, copy word from tape to memory + if read dir != write dir, bits must be scrambled + if wc overflow, next state is wc overflow + if end of block, possibly set DTF, next state is start of block + Wc ovf, not start of block - + if end of block, possibly set DTF, next state is start of block + Wc ovf, start of block - if end of block reached, timing error, + otherwise, continue to next word +*/ + + case FNC_READ: /* read */ + wrd = DT_LIN2WD (uptr->pos, uptr); /* get word # */ + switch (dt_substate) { /* case on substate */ + + case DTO_SOB: /* start of block */ + if (dtsb & DTB_DTF) { /* DTF set? */ + dt_seterr (uptr, DTB_TIM); /* timing error */ + return SCPE_OK; + } + if (DEBUG_PRI (dt_dev, LOG_RW) || + (DEBUG_PRI (dt_dev, LOG_BL) && (blk == dt_logblk))) + fprintf (sim_deb, ">>DT%d: reading block %d %s%s\n", + unum, blk, (dir? "backward": "forward"), + ((dtsa & DTA_MODE)? " continuous": " ")); + dt_substate = 0; /* fall through */ + case 0: /* normal read */ + M[DT_WC] = (M[DT_WC] + 1) & 07777; /* incr WC, CA */ + M[DT_CA] = (M[DT_CA] + 1) & 07777; + ma = DTB_GETMEX (dtsb) | M[DT_CA]; /* get mem addr */ + ba = (blk * DTU_BSIZE (uptr)) + wrd; /* buffer ptr */ + dat = fbuf[ba]; /* get tape word */ + if (dir) /* rev? comp obv */ + dat = dt_comobv (dat); + if (MEM_ADDR_OK (ma)) /* mem addr legal? */ + M[ma] = dat; + if (M[DT_WC] == 0) /* wc ovf? */ + dt_substate = DTO_WCO; + case DTO_WCO: /* wc ovf, not sob */ + if (wrd != (dir? 0: DTU_BSIZE (uptr) - 1)) /* not last? */ + sim_activate (uptr, DT_WSIZE * dt_ltime); + else { + dt_substate = dt_substate | DTO_SOB; + sim_activate (uptr, ((2 * DT_HTLIN) + DT_WSIZE) * dt_ltime); + if (((dtsa & DTA_MODE) == 0) || (M[DT_WC] == 0)) + dtsb = dtsb | DTB_DTF; /* set DTF */ + } + break; + + case DTO_WCO | DTO_SOB: /* next block */ + if (wrd == (dir? 0: DTU_BSIZE (uptr))) /* end of block? */ + dt_seterr (uptr, DTB_TIM); /* timing error */ + else sim_activate (uptr, DT_WSIZE * dt_ltime); + break; + } + + break; + +/* Write has four subcases + + Start of block, not wc ovf - check that DTF is clear, set block direction + Normal - increment MA, WC, copy word from memory to tape + if wc overflow, next state is wc overflow + if end of block, possibly set DTF, next state is start of block + Wc ovf, not start of block - + copy 0 to tape + if end of block, possibly set DTF, next state is start of block + Wc ovf, start of block - schedule end zone +*/ + + case FNC_WRIT: /* write */ + wrd = DT_LIN2WD (uptr->pos, uptr); /* get word # */ + switch (dt_substate) { /* case on substate */ + + case DTO_SOB: /* start block */ + if (dtsb & DTB_DTF) { /* DTF set? */ + dt_seterr (uptr, DTB_TIM); /* timing error */ + return SCPE_OK; + } + if (DEBUG_PRI (dt_dev, LOG_RW) || + (DEBUG_PRI (dt_dev, LOG_BL) && (blk == dt_logblk))) + fprintf (sim_deb, ">>DT%d: writing block %d %s%s\n", unum, blk, + (dir? "backward": "forward"), + ((dtsa & DTA_MODE)? " continuous": " ")); + dt_substate = 0; /* fall through */ + case 0: /* normal write */ + M[DT_WC] = (M[DT_WC] + 1) & 07777; /* incr WC, CA */ + M[DT_CA] = (M[DT_CA] + 1) & 07777; + case DTO_WCO: /* wc ovflo */ + ma = DTB_GETMEX (dtsb) | M[DT_CA]; /* get mem addr */ + ba = (blk * DTU_BSIZE (uptr)) + wrd; /* buffer ptr */ + dat = dt_substate? 0: M[ma]; /* get word */ + if (dir) /* rev? comp obv */ + dat = dt_comobv (dat); + fbuf[ba] = dat; /* write word */ + uptr->WRITTEN = TRUE; + if (ba >= uptr->hwmark) + uptr->hwmark = ba + 1; + if (M[DT_WC] == 0) + dt_substate = DTO_WCO; + if (wrd != (dir? 0: DTU_BSIZE (uptr) - 1)) /* not last? */ + sim_activate (uptr, DT_WSIZE * dt_ltime); + else { + dt_substate = dt_substate | DTO_SOB; + sim_activate (uptr, ((2 * DT_HTLIN) + DT_WSIZE) * dt_ltime); + if (((dtsa & DTA_MODE) == 0) || (M[DT_WC] == 0)) + dtsb = dtsb | DTB_DTF; /* set DTF */ + } + break; + + case DTO_WCO | DTO_SOB: /* all done */ + dt_schedez (uptr, dir); /* sched end zone */ + break; + } + + break; + +/* Read all has two subcases + + Not word count overflow - increment MA, WC, copy word from tape to memory + Word count overflow - schedule end zone +*/ + + case FNC_RALL: + switch (dt_substate) { /* case on substate */ + + case 0: case DTO_SOB: /* read in progress */ + if (dtsb & DTB_DTF) { /* DTF set? */ + dt_seterr (uptr, DTB_TIM); /* timing error */ + return SCPE_OK; + } + relpos = DT_LIN2OF (uptr->pos, uptr); /* cur pos in blk */ + M[DT_WC] = (M[DT_WC] + 1) & 07777; /* incr WC, CA */ + M[DT_CA] = (M[DT_CA] + 1) & 07777; + ma = DTB_GETMEX (dtsb) | M[DT_CA]; /* get mem addr */ + if ((relpos >= DT_HTLIN) && /* in data zone? */ + (relpos < (DTU_LPERB (uptr) - DT_HTLIN))) { + wrd = DT_LIN2WD (uptr->pos, uptr); + ba = (blk * DTU_BSIZE (uptr)) + wrd; + dat = fbuf[ba]; /* get tape word */ + if (dir) /* rev? comp obv */ + dat = dt_comobv (dat); + } + else dat = dt_gethdr (uptr, blk, relpos, dir); /* get hdr */ + sim_activate (uptr, DT_WSIZE * dt_ltime); + if (MEM_ADDR_OK (ma)) /* mem addr legal? */ + M[ma] = dat; + if (M[DT_WC] == 0) + dt_substate = DTO_WCO; + if (((dtsa & DTA_MODE) == 0) || (M[DT_WC] == 0)) + dtsb = dtsb | DTB_DTF; /* set DTF */ + break; + + case DTO_WCO: case DTO_WCO | DTO_SOB: /* all done */ + dt_schedez (uptr, dir); /* sched end zone */ + break; + } /* end case substate */ + + break; + +/* Write all has two subcases + + Not word count overflow - increment MA, WC, copy word from memory to tape + Word count overflow - schedule end zone +*/ + + case FNC_WALL: + switch (dt_substate) { /* case on substate */ + + case 0: case DTO_SOB: /* read in progress */ + if (dtsb & DTB_DTF) { /* DTF set? */ + dt_seterr (uptr, DTB_TIM); /* timing error */ + return SCPE_OK; + } + relpos = DT_LIN2OF (uptr->pos, uptr); /* cur pos in blk */ + M[DT_WC] = (M[DT_WC] + 1) & 07777; /* incr WC, CA */ + M[DT_CA] = (M[DT_CA] + 1) & 07777; + ma = DTB_GETMEX (dtsb) | M[DT_CA]; /* get mem addr */ + if ((relpos >= DT_HTLIN) && /* in data zone? */ + (relpos < (DTU_LPERB (uptr) - DT_HTLIN))) { + dat = M[ma]; /* get mem word */ + if (dir) + dat = dt_comobv (dat); + wrd = DT_LIN2WD (uptr->pos, uptr); + ba = (blk * DTU_BSIZE (uptr)) + wrd; + fbuf[ba] = dat; /* write word */ + if (ba >= uptr->hwmark) + uptr->hwmark = ba + 1; + } + /* ignore hdr */ + sim_activate (uptr, DT_WSIZE * dt_ltime); + if (M[DT_WC] == 0) + dt_substate = DTO_WCO; + if (((dtsa & DTA_MODE) == 0) || (M[DT_WC] == 0)) + dtsb = dtsb | DTB_DTF; /* set DTF */ + break; + + case DTO_WCO: case DTO_WCO | DTO_SOB: /* all done */ + dt_schedez (uptr, dir); /* sched end zone */ + break; + } /* end case substate */ + break; + + default: + dt_seterr (uptr, DTB_SEL); /* impossible state */ + break; + } + +DT_UPDINT; /* update interrupts */ +return SCPE_OK; +} + +/* Reading the header is complicated, because 18b words are being parsed + out 12b at a time. The sequence of word numbers is directionally + sensitive + + Forward Reverse + Word Word Content Word Word Content + (abs) (rel) (abs) (rel) + + 137 8 fwd csm'00 6 6 rev csm'00 + 138 9 0000 5 5 0000 + 139 10 0000 4 4 0000 + 140 11 0000 3 3 0000 + 141 12 00'lo rev blk 2 2 00'lo fwd blk + 142 13 hi rev blk 1 1 hi fwd blk + 143 14 0000 0 0 0000 + 0 0 0000 143 14 0000 + 1 1 0000 142 13 0000 + 2 2 hi fwd blk 141 12 hi rev blk + 3 3 lo fwd blk'00 140 11 lo rev blk'00 + 4 4 0000 139 10 0000 + 5 5 0000 138 9 0000 + 6 6 0000 137 8 0000 + 7 7 rev csm 136 7 00'fwd csm +*/ + +int32 dt_gethdr (UNIT *uptr, int32 blk, int32 relpos, int32 dir) +{ +if (relpos >= DT_HTLIN) + relpos = relpos - (DT_WSIZE * DTU_BSIZE (uptr)); +if (dir) { /* reverse */ + switch (relpos / DT_WSIZE) { + case 6: /* rev csm */ + return 077; + case 2: /* lo fwd blk */ + return dt_comobv ((blk & 077) << 6); + case 1: /* hi fwd blk */ + return dt_comobv (blk >> 6); + case 12: /* hi rev blk */ + return (blk >> 6) & 07777; + case 11: /* lo rev blk */ + return ((blk & 077) << 6); + case 7: /* fwd csum */ + return (dt_comobv (dt_csum (uptr, blk)) << 6); + default: /* others */ + return 07777; + } + } +else { /* forward */ + switch (relpos / DT_WSIZE) { + case 8: /* fwd csum */ + return (dt_csum (uptr, blk) << 6); + case 12: /* lo rev blk */ + return dt_comobv ((blk & 077) << 6); + case 13: /* hi rev blk */ + return dt_comobv (blk >> 6); + case 2: /* hi fwd blk */ + return ((blk >> 6) & 07777); + case 3: /* lo fwd blk */ + return ((blk & 077) << 6); + case 7: /* rev csum */ + return 077; + default: /* others */ + break; + } + } +return 0; +} + +/* Utility routines */ + +/* Set error flag */ + +void dt_seterr (UNIT *uptr, int32 e) +{ +int32 mot = DTS_GETMOT (uptr->STATE); + +dtsa = dtsa & ~DTA_STSTP; /* clear go */ +dtsb = dtsb | DTB_ERF | e; /* set error flag */ +if (mot >= DTS_ACCF) { /* ~stopped or stopping? */ + sim_cancel (uptr); /* cancel activity */ + if (dt_setpos (uptr)) /* update position */ + return; + sim_activate (uptr, dt_dctime); /* sched decel */ + DTS_SETSTA (DTS_DECF | (mot & DTS_DIR), 0); /* state = decel */ + } +DT_UPDINT; +return; +} + +/* Schedule end zone */ + +void dt_schedez (UNIT *uptr, int32 dir) +{ +int32 newpos; + +if (dir) /* rev? rev ez */ + newpos = DT_EZLIN - DT_WSIZE; +else newpos = DTU_FWDEZ (uptr) + DT_WSIZE; /* fwd? fwd ez */ +sim_activate (uptr, ABS (newpos - ((int32) uptr->pos)) * dt_ltime); +return; +} + +/* Complement obverse routine */ + +int32 dt_comobv (int32 dat) +{ +dat = dat ^ 07777; /* compl obverse */ +dat = ((dat >> 9) & 07) | ((dat >> 3) & 070) | + ((dat & 070) << 3) | ((dat & 07) << 9); +return dat; +} + +/* Checksum routine */ + +int32 dt_csum (UNIT *uptr, int32 blk) +{ +int16 *fbuf = (int16 *) uptr->filebuf; +int32 ba = blk * DTU_BSIZE (uptr); +int32 i, csum, wrd; + +csum = 077; /* init csum */ +for (i = 0; i < DTU_BSIZE (uptr); i++) { /* loop thru buf */ + wrd = fbuf[ba + i] ^ 07777; /* get ~word */ + csum = csum ^ (wrd >> 6) ^ wrd; + } +return (csum & 077); +} + +/* Reset routine */ + +t_stat dt_reset (DEVICE *dptr) +{ +int32 i, prev_mot; +UNIT *uptr; + +for (i = 0; i < DT_NUMDR; i++) { /* stop all activity */ + uptr = dt_dev.units + i; + if (sim_is_running) { /* CAF? */ + prev_mot = DTS_GETMOT (uptr->STATE); /* get motion */ + if ((prev_mot & ~DTS_DIR) > DTS_DECF) { /* accel or spd? */ + if (dt_setpos (uptr)) /* update pos */ + continue; + sim_cancel (uptr); + sim_activate (uptr, dt_dctime); /* sched decel */ + DTS_SETSTA (DTS_DECF | (prev_mot & DTS_DIR), 0); + } + } + else { + sim_cancel (uptr); /* sim reset */ + uptr->STATE = 0; + uptr->LASTT = sim_grtime (); + } + } +dtsa = dtsb = 0; /* clear status */ +DT_UPDINT; /* reset interrupt */ +return SCPE_OK; +} + +/* Bootstrap routine + + This is actually the 4K disk monitor bootstrap, which also + works with OS/8. The reverse is not true - the OS/8 bootstrap + doesn't work with the disk monitor. +*/ + +#define BOOT_START 0200 +#define BOOT_LEN (sizeof (boot_rom) / sizeof (int16)) + +static const uint16 boot_rom[] = { + 07600, /* 200, CLA CLL */ + 01216, /* TAD MVB ; move back */ + 04210, /* JMS DO ; action */ + 01217, /* TAD K7577 ; addr */ + 03620, /* DCA I CA */ + 01222, /* TAD RDF ; read fwd */ + 04210, /* JMS DO ; action */ + 05600, /* JMP I 200 ; enter boot */ + 00000, /* DO, 0 */ + 06766, /* DTCA!DTXA ; start tape */ + 03621, /* DCA I WC ; clear wc */ + 06771, /* DTSF ; wait */ + 05213, /* JMP .-1 */ + 05610, /* JMP I DO */ + 00600, /* MVB, 0600 */ + 07577, /* K7577, 7757 */ + 07755, /* CA, 7755 */ + 07754, /* WC, 7754 */ + 00220 /* RF, 0220 */ + }; + +t_stat dt_boot (int32 unitno, DEVICE *dptr) +{ +size_t i; + +if (unitno) /* only unit 0 */ + return SCPE_ARG; +if (dt_dib.dev != DEV_DTA) /* only std devno */ + return STOP_NOTSTD; +dt_unit[unitno].pos = DT_EZLIN; +for (i = 0; i < BOOT_LEN; i++) + M[BOOT_START + i] = boot_rom[i]; +cpu_set_bootpc (BOOT_START); +return SCPE_OK; +} + +/* Attach routine + + Determine 12b, 16b, or 18b/36b format + Allocate buffer + If 16b or 18b, read 16b or 18b format and convert to 12b in buffer + If 12b, read data into buffer +*/ + +t_stat dt_attach (UNIT *uptr, CONST char *cptr) +{ +uint32 pdp18b[D18_NBSIZE]; +uint16 pdp11b[D18_NBSIZE], *fbuf; +int32 i, k; +int32 u = uptr - dt_dev.units; +t_stat r; +uint32 ba, sz; + +r = attach_unit (uptr, cptr); /* attach */ +if (r != SCPE_OK) return r; /* fail? */ +if ((sim_switches & SIM_SW_REST) == 0) { /* not from rest? */ + uptr->flags = (uptr->flags | UNIT_8FMT) & ~UNIT_11FMT; + if (sim_switches & SWMASK ('F')) /* att 18b? */ + uptr->flags = uptr->flags & ~UNIT_8FMT; + else if (sim_switches & SWMASK ('S')) /* att 16b? */ + uptr->flags = (uptr->flags | UNIT_11FMT) & ~UNIT_8FMT; + else if (!(sim_switches & SWMASK ('A')) && /* autosize? */ + (sz = sim_fsize (uptr->fileref))) { + if (sz == D11_FILSIZ) + uptr->flags = (uptr->flags | UNIT_11FMT) & ~UNIT_8FMT; + else if (sz > D8_FILSIZ) + uptr->flags = uptr->flags & ~UNIT_8FMT; + } + } +uptr->capac = DTU_CAPAC (uptr); /* set capacity */ +uptr->filebuf = calloc (uptr->capac, sizeof (uint16)); +if (uptr->filebuf == NULL) { /* can't alloc? */ + detach_unit (uptr); + return SCPE_MEM; + } +fbuf = (uint16 *) uptr->filebuf; /* file buffer */ +sim_printf ("%s%d: ", sim_dname (&dt_dev), u); +if (uptr->flags & UNIT_8FMT) + sim_printf ("12b format"); +else if (uptr->flags & UNIT_11FMT) + sim_printf ("16b format"); +else sim_printf ("18b/36b format"); +sim_printf (", buffering file in memory\n"); +uptr->io_flush = dt_flush; +if (uptr->flags & UNIT_8FMT) /* 12b? */ + uptr->hwmark = fxread (uptr->filebuf, sizeof (uint16), + uptr->capac, uptr->fileref); +else { /* 16b/18b */ + for (ba = 0; ba < uptr->capac; ) { /* loop thru file */ + if (uptr->flags & UNIT_11FMT) { + k = fxread (pdp11b, sizeof (uint16), D18_NBSIZE, uptr->fileref); + for (i = 0; i < k; i++) + pdp18b[i] = pdp11b[i]; + } + else k = fxread (pdp18b, sizeof (uint32), D18_NBSIZE, uptr->fileref); + if (k == 0) + break; + for ( ; k < D18_NBSIZE; k++) pdp18b[k] = 0; + for (k = 0; k < D18_NBSIZE; k = k + 2) { /* loop thru blk */ + fbuf[ba] = (pdp18b[k] >> 6) & 07777; + fbuf[ba + 1] = ((pdp18b[k] & 077) << 6) | + ((pdp18b[k + 1] >> 12) & 077); + fbuf[ba + 2] = pdp18b[k + 1] & 07777; + ba = ba + 3; + } /* end blk loop */ + } /* end file loop */ + uptr->hwmark = ba; + } /* end else */ +uptr->flags = uptr->flags | UNIT_BUF; /* set buf flag */ +uptr->pos = DT_EZLIN; /* beyond leader */ +uptr->LASTT = sim_grtime (); /* last pos update */ +return SCPE_OK; +} + +/* Detach routine + + Cancel in progress operation + If 12b, write buffer to file + If 16b or 18b, convert 12b buffer to 16b or 18b and write to file + Deallocate buffer +*/ +void dt_flush (UNIT* uptr) +{ +uint32 pdp18b[D18_NBSIZE]; +uint16 pdp11b[D18_NBSIZE], *fbuf; +int32 i, k; +uint32 ba; + +if (uptr->WRITTEN && uptr->hwmark && ((uptr->flags & UNIT_RO)== 0)) { /* any data? */ + rewind (uptr->fileref); /* start of file */ + fbuf = (uint16 *) uptr->filebuf; /* file buffer */ + if (uptr->flags & UNIT_8FMT) /* PDP8? */ + fxwrite (uptr->filebuf, sizeof (uint16), /* write file */ + uptr->hwmark, uptr->fileref); + else { /* 16b/18b */ + for (ba = 0; ba < uptr->hwmark; ) { /* loop thru buf */ + for (k = 0; k < D18_NBSIZE; k = k + 2) { + pdp18b[k] = ((uint32) (fbuf[ba] & 07777) << 6) | + ((uint32) (fbuf[ba + 1] >> 6) & 077); + pdp18b[k + 1] = ((uint32) (fbuf[ba + 1] & 077) << 12) | + ((uint32) (fbuf[ba + 2] & 07777)); + ba = ba + 3; + } /* end loop blk */ + if (uptr->flags & UNIT_11FMT) { /* 16b? */ + for (i = 0; i < D18_NBSIZE; i++) + pdp11b[i] = pdp18b[i]; + fxwrite (pdp11b, sizeof (uint16), + D18_NBSIZE, uptr->fileref); + } + else fxwrite (pdp18b, sizeof (uint32), + D18_NBSIZE, uptr->fileref); + } /* end loop buf */ + } /* end else */ + if (ferror (uptr->fileref)) + sim_perror ("I/O error"); + } +uptr->WRITTEN = FALSE; /* no longer dirty */ +} + +t_stat dt_detach (UNIT* uptr) +{ +int u = (int)(uptr - dt_dev.units); + +if (!(uptr->flags & UNIT_ATT)) /* attached? */ + return SCPE_OK; +if (sim_is_active (uptr)) { + sim_cancel (uptr); + if ((u == DTA_GETUNIT (dtsa)) && (dtsa & DTA_STSTP)) { + dtsb = dtsb | DTB_ERF | DTB_SEL | DTB_DTF; + DT_UPDINT; + } + uptr->STATE = uptr->pos = 0; + } +if (uptr->hwmark && ((uptr->flags & UNIT_RO)== 0)) { /* any data? */ + sim_printf ("%s%d: writing buffer to file\n", sim_dname (&dt_dev), u); + dt_flush (uptr); + } /* end if hwmark */ +free (uptr->filebuf); /* release buf */ +uptr->flags = uptr->flags & ~UNIT_BUF; /* clear buf flag */ +uptr->filebuf = NULL; /* clear buf ptr */ +uptr->flags = (uptr->flags | UNIT_8FMT) & ~UNIT_11FMT; /* default fmt */ +uptr->capac = DT_CAPAC; /* default size */ +return detach_unit (uptr); +} ADDED src/PDP8/pdp8_fpp.c Index: src/PDP8/pdp8_fpp.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_fpp.c @@ -0,0 +1,1513 @@ +/* pdp8_fpp.c: PDP-8 floating point processor (FPP8A) + + Copyright (c) 2007-2011, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + fpp FPP8A floating point processor + + 03-Jan-10 RMS Initialized variables statically, for VMS compiler + 19-Apr-09 RHM FPICL does not clear all command and status reg bits + modify fpp_reset to conform with FPP + 27-Mar-09 RHM Fixed handling of Underflow fix (zero FAC on underflow) + Implemented FPP division and multiplication algorithms + FPP behavior on traps - FEXIT does not update APT + Follow FPP settings for OPADD + Correct detection of DP add/sub overflow + Detect and handle add/sub overshift + Single-step mode made consistent with FPP + Write calculation results prior to traps + 24-Mar-09 RMS Many fixes from Rick Murphy: + Fix calculation of ATX shift amount + Added missing () to read, write XR macros + Fixed indirect address calculation + Fixed == written as = in normalization + Fixed off-by-one count bug in multiplication + Removed extraneous ; in divide + Fixed direction of compare in divide + Fixed count direction bug in alignment + + Floating point formats: + + 00 01 02 03 04 05 06 07 08 09 10 11 + +--+--+--+--+--+--+--+--+--+--+--+--+ + | S| hi integer | : double precision + +--+--+--+--+--+--+--+--+--+--+--+--+ + | lo integer | + +--+--+--+--+--+--+--+--+--+--+--+--+ + + 00 01 02 03 04 05 06 07 08 09 10 11 + +--+--+--+--+--+--+--+--+--+--+--+--+ + | S| exponent | : floating point + +--+--+--+--+--+--+--+--+--+--+--+--+ + | S| hi fraction | + +--+--+--+--+--+--+--+--+--+--+--+--+ + | lo fraction | + +--+--+--+--+--+--+--+--+--+--+--+--+ + + + 00 01 02 03 04 05 06 07 08 09 10 11 + +--+--+--+--+--+--+--+--+--+--+--+--+ + | S| exponent | : extended precision + +--+--+--+--+--+--+--+--+--+--+--+--+ + | S| hi fraction | + +--+--+--+--+--+--+--+--+--+--+--+--+ + | next fraction | + +--+--+--+--+--+--+--+--+--+--+--+--+ + | next fraction | + +--+--+--+--+--+--+--+--+--+--+--+--+ + | next fraction | + +--+--+--+--+--+--+--+--+--+--+--+--+ + | lo fraction | + +--+--+--+--+--+--+--+--+--+--+--+--+ + + Exponents are 2's complement, as are fractions. Normalized numbers have + the form: + + 0.0...0 + 0. + 1. + 1.1...0 + + Note that 1.0...0 is normalized but considered illegal, since it cannot + be represented as a positive number. When a result is normalized, 1.0...0 + is converted to 1.1...0 with exp+1. +*/ + +#include "pdp8_defs.h" + +extern int32 int_req; +extern uint16 M[]; +extern int32 stop_inst; +extern UNIT cpu_unit; + +#define SEXT12(x) (((x) & 04000)? (x) | ~07777: (x) & 03777) + +/* Index registers are in memory */ + +#define fpp_read_xr(xr) fpp_read (fpp_xra + (xr)) +#define fpp_write_xr(xr,d) fpp_write (fpp_xra + (xr), d) + +/* Command register */ + +#define FPC_DP 04000 /* integer double */ +#define FPC_UNFX 02000 /* exit on fl undf */ +#define FPC_FIXF 01000 /* lock mem field */ +#define FPC_IE 00400 /* int enable */ +#define FPC_V_FAST 4 /* startup bits */ +#define FPC_M_FAST 017 +#define FPC_LOCK 00010 /* lockout */ +#define FPC_V_APTF 0 +#define FPC_M_APTF 07 /* apta field */ +#define FPC_STA (FPC_DP|FPC_LOCK) +#define FPC_GETFAST(x) (((x) >> FPC_V_FAST) & FPC_M_FAST) +#define FPC_GETAPTF(x) (((x) >> FPC_V_APTF) & FPC_M_APTF) + +/* Status register */ + +#define FPS_DP (FPC_DP) /* integer double */ +#define FPS_TRPX 02000 /* trap exit */ +#define FPS_HLTX 01000 /* halt exit */ +#define FPS_DVZX 00400 /* div zero exit */ +#define FPS_IOVX 00200 /* int ovf exit */ +#define FPS_FOVX 00100 /* flt ovf exit */ +#define FPS_UNF 00040 /* underflow */ +#define FPS_XXXM 00020 /* FADDM/FMULM */ +#define FPS_LOCK (FPC_LOCK) /* lockout */ +#define FPS_EP 00004 /* ext prec */ +#define FPS_PAUSE 00002 /* paused */ +#define FPS_RUN 00001 /* running */ + +/* Floating point number: 3-6 words */ + +#define FPN_FRSIGN 04000 +#define FPN_NFR_FP 2 /* std precision */ +#define FPN_NFR_EP 5 /* ext precision */ +#define FPN_NFR_MDS 6 /* mul/div precision */ +#define EXACT (uint32)((fpp_sta & FPS_EP)? FPN_NFR_EP: FPN_NFR_FP) +#define EXTEND ((uint32) FPN_NFR_EP) + +typedef struct { + int32 exp; + uint32 fr[FPN_NFR_MDS+1]; + } FPN; + +uint32 fpp_apta = 0; /* APT pointer */ +uint32 fpp_aptsvf = 0; /* APT saved field */ +uint32 fpp_opa = 0; /* operand pointer */ +uint32 fpp_fpc = 0; /* FP PC */ +uint32 fpp_bra = 0; /* base reg pointer */ +uint32 fpp_xra = 0; /* indx reg pointer */ +uint32 fpp_cmd = 0; /* command */ +uint32 fpp_sta = 0; /* status */ +uint32 fpp_flag = 0; /* flag */ +FPN fpp_ac; /* FAC */ +uint32 fpp_ssf = 0; /* single-step flag */ +uint32 fpp_last_lockbit = 0; /* last lockbit */ + +static FPN fpp_zero = { 0, { 0, 0, 0, 0, 0 } }; +static FPN fpp_one = { 1, { 02000, 0, 0, 0, 0 } }; + +int32 fpp55 (int32 IR, int32 AC); +int32 fpp56 (int32 IR, int32 AC); +void fpp_load_apt (uint32 apta); +void fpp_dump_apt (uint32 apta, uint32 sta); +uint32 fpp_1wd_dir (uint32 ir); +uint32 fpp_2wd_dir (uint32 ir); +uint32 fpp_indir (uint32 ir); +uint32 fpp_ad15 (uint32 hi); +uint32 fpp_adxr (uint32 ir, uint32 base_ad); +void fpp_add (FPN *a, FPN *b, uint32 sub); +void fpp_mul (FPN *a, FPN *b); +void fpp_div (FPN *a, FPN *b); +t_bool fpp_imul (FPN *a, FPN *b); +uint32 fpp_fr_add (uint32 *c, uint32 *a, uint32 *b, uint32 cnt); +void fpp_fr_sub (uint32 *c, uint32 *a, uint32 *b, uint32 cnt); +void fpp_fr_mul (uint32 *c, uint32 *a, uint32 *b, t_bool fix); +t_bool fpp_fr_div (uint32 *c, uint32 *a, uint32 *b); +uint32 fpp_fr_neg (uint32 *a, uint32 cnt); +int32 fpp_fr_cmp (uint32 *a, uint32 *b, uint32 cnt); +int32 fpp_fr_test (uint32 *a, uint32 v0, uint32 cnt); +uint32 fpp_fr_abs (uint32 *a, uint32 *b, uint32 cnt); +void fpp_fr_fill (uint32 *a, uint32 v, uint32 cnt); +void fpp_fr_lshn (uint32 *a, uint32 sc, uint32 cnt); +void fpp_fr_lsh12 (uint32 *a, uint32 cnt); +void fpp_fr_lsh1 (uint32 *a, uint32 cnt); +void fpp_fr_rsh1 (uint32 *a, uint32 sign, uint32 cnt); +void fpp_fr_algn (uint32 *a, uint32 sc, uint32 cnt); +t_bool fpp_cond_met (uint32 cond); +t_bool fpp_norm (FPN *a, uint32 cnt); +void fpp_round (FPN *a); +t_bool fpp_test_xp (FPN *a); +void fpp_copy (FPN *a, FPN *b); +void fpp_zcopy (FPN *a, FPN *b); +void fpp_read_op (uint32 ea, FPN *a); +void fpp_write_op (uint32 ea, FPN *a); +uint32 fpp_read (uint32 ea); +void fpp_write (uint32 ea, uint32 val); +uint32 apt_read (uint32 ea); +void apt_write (uint32 ea, uint32 val); +t_stat fpp_svc (UNIT *uptr); +t_stat fpp_reset (DEVICE *dptr); + +/* FPP data structures + + fpp_dev FPP device descriptor + fpp_unit FPP unit descriptor + fpp_reg FPP register list +*/ + +DIB fpp_dib = { DEV_FPP, 2, { &fpp55, &fpp56 } }; + +UNIT fpp_unit = { UDATA (&fpp_svc, 0, 0) }; + +REG fpp_reg[] = { + { ORDATAD (FPACE, fpp_ac.exp, 12, "floating accumulator") }, + { ORDATAD (FPAC0, fpp_ac.fr[0], 12, "first mantissa") }, + { ORDATAD (FPAC1, fpp_ac.fr[1], 12, "second mantissa") }, + { ORDATAD (FPAC2, fpp_ac.fr[2], 12, "third mantissa") }, + { ORDATAD (FPAC3, fpp_ac.fr[3], 12, "fourth mantissa") }, + { ORDATAD (FPAC4, fpp_ac.fr[4], 12, "fifth mantissa") }, + { ORDATAD (CMD, fpp_cmd, 12, "FPP command register") }, + { ORDATAD (STA, fpp_sta, 12, "status register") }, + { ORDATAD (APTA, fpp_apta, 15, "active parameter table (APT) pointer") }, + { GRDATAD (APTSVF, fpp_aptsvf, 8, 3, 12, "APT field") }, + { ORDATAD (FPC, fpp_fpc, 15, "floating program counter") }, + { ORDATAD (BRA, fpp_bra, 15, "base register") }, + { ORDATAD (XRA, fpp_xra, 15, "pointer to index register 0") }, + { ORDATAD (OPA, fpp_opa, 15, "operand address register") }, + { ORDATAD (SSF, fpp_ssf, 12, "single step flag") }, + { ORDATAD (LASTLOCK, fpp_last_lockbit, 12, "lockout from FPCOM") }, + { FLDATAD (FLAG, fpp_flag, 0, "done flag") }, + { NULL } + }; + +DEVICE fpp_dev = { + "FPP", &fpp_unit, fpp_reg, NULL, + 1, 10, 31, 1, 8, 8, + NULL, NULL, &fpp_reset, + NULL, NULL, NULL, + &fpp_dib, DEV_DISABLE | DEV_DIS + }; + +/* IOT routines */ + +int32 fpp55 (int32 IR, int32 AC) +{ +switch (IR & 07) { /* decode IR<9:11> */ + + case 1: /* FPINT */ + return (fpp_flag? IOT_SKP | AC: AC); /* skip on flag */ + + case 2: /* FPICL */ + fpp_reset (&fpp_dev); /* reset device */ + break; + + case 3: /* FPCOM */ + if (!fpp_flag && !(fpp_sta & FPS_RUN)) { /* flag clr, !run? */ + fpp_cmd = AC; /* load cmd */ + fpp_last_lockbit = fpp_cmd & FPS_LOCK; /* remember lock state */ + fpp_sta = (fpp_sta & ~FPC_STA) | /* copy flags */ + (fpp_cmd & FPC_STA); /* to status */ + } + break; + + case 4: /* FPHLT */ + if (fpp_sta & FPS_RUN) { /* running? */ + if (fpp_sta & FPS_PAUSE) /* paused? */ + fpp_fpc = (fpp_fpc - 1) & ADDRMASK; /* decr FPC */ + fpp_sta &= ~FPS_PAUSE; /* no longer paused */ + sim_cancel (&fpp_unit); /* stop execution */ + fpp_dump_apt (fpp_apta, FPS_HLTX); /* dump APT */ + fpp_ssf = 1; /* assume sstep */ + } + else if (!fpp_flag) + fpp_ssf = 1; /* FPST sing steps */ + if (fpp_sta & FPS_DVZX) /* fix diag timing */ + fpp_sta |= FPS_HLTX; + break; + + case 5: /* FPST */ + if (!fpp_flag && !(fpp_sta & FPS_RUN)) { /* flag clr, !run? */ + if (fpp_ssf) + fpp_sta |= fpp_last_lockbit; + fpp_sta &= ~FPS_HLTX; /* Clear halted */ + fpp_apta = (FPC_GETAPTF (fpp_cmd) << 12) | AC; + fpp_load_apt (fpp_apta); /* load APT */ + fpp_opa = fpp_fpc; + sim_activate (&fpp_unit, 0); /* start unit */ + return IOT_SKP | AC; + } + if ((fpp_sta & (FPS_RUN|FPS_PAUSE)) == (FPS_RUN|FPS_PAUSE)) { + fpp_sta &= ~FPS_PAUSE; /* continue */ + sim_activate (&fpp_unit, 0); /* start unit */ + return (IOT_SKP | AC); + } + break; + + case 6: /* FPRST */ + return fpp_sta; + + case 7: /* FPIST */ + if (fpp_flag) { /* if flag set */ + uint32 old_sta = fpp_sta; + fpp_flag = 0; /* clr flag, status */ + fpp_sta &= ~(FPS_DP|FPS_EP|FPS_TRPX|FPS_DVZX|FPS_IOVX|FPS_FOVX|FPS_UNF); + int_req &= ~INT_FPP; /* clr int req */ + return IOT_SKP | old_sta; /* ret old status */ + } + break; + + default: + return (stop_inst << IOT_V_REASON) | AC; + } /* end switch */ + +return AC; +} + +int32 fpp56 (int32 IR, int32 AC) +{ +switch (IR & 07) { /* decode IR<9:11> */ + + case 7: /* FPEP */ + if ((AC & 04000) && !(fpp_sta & FPS_RUN)) { /* if AC0, not run, */ + fpp_sta = (fpp_sta | FPS_EP) & ~FPS_DP; /* set ep */ + AC = 0; + } + break; + + default: + return (stop_inst << IOT_V_REASON) | AC; + } /* end switch */ + +return AC; +} + +/* Service routine */ + +t_stat fpp_svc (UNIT *uptr) +{ +FPN x; +uint32 ir, op, op2, op3, ad, ea, wd; +uint32 i; +int32 sc; + +fpp_ac.exp = SEXT12 (fpp_ac.exp); /* sext AC exp */ +do { /* repeat */ + ir = fpp_read (fpp_fpc); /* get instr */ + fpp_fpc = (fpp_fpc + 1) & ADDRMASK; /* incr FP PC */ + op = (ir >> 7) & 037; /* get op+mode */ + op2 = (ir >> 3) & 017; /* get subop */ + op3 = ir & 07; /* get field/xr */ + fpp_sta &= ~FPS_XXXM; /* not mem op */ + + switch (op) { /* case on op+mode */ + case 000: /* operates */ + + switch (op2) { /* case on subop */ + case 000: /* no-operands */ + switch (op3) { /* case on subsubop */ + + case 0: /* FEXIT */ + /* if already trapped, don't update APT, just update status */ + if (fpp_sta & (FPS_DVZX|FPS_IOVX|FPS_FOVX|FPS_UNF)) + fpp_sta |= FPS_HLTX; + else + fpp_dump_apt (fpp_apta, 0); + break; + + case 1: /* FPAUSE */ + fpp_sta |= FPS_PAUSE; + break; + + case 2: /* FCLA */ + fpp_copy (&fpp_ac, &fpp_zero); /* clear FAC */ + break; + + case 3: /* FNEG */ + fpp_fr_neg (fpp_ac.fr, EXACT); /* do exact length */ + break; + + case 4: /* FNORM */ + if (!(fpp_sta & FPS_DP)) { /* fp or ep only */ + fpp_copy (&x, &fpp_ac); /* copy AC */ + fpp_norm (&x, EXACT); /* do exact length */ + fpp_copy (&fpp_ac, &x); /* copy back */ + } + break; + + case 5: /* STARTF */ + if (fpp_sta & FPS_EP) { /* if ep, */ + fpp_copy (&x, &fpp_ac); /* copy AC */ + fpp_round (&x); /* round */ + fpp_copy (&fpp_ac, &x); /* copy back */ + } + fpp_sta &= ~(FPS_DP|FPS_EP); + break; + + case 6: /* STARTD */ + fpp_sta = (fpp_sta | FPS_DP) & ~FPS_EP; + break; + + case 7: /* JAC */ + fpp_fpc = ((fpp_ac.fr[0] & 07) << 12) | fpp_ac.fr[1]; + break; + } + break; + + case 001: /* ALN */ + if (op3 != 0) { /* if xr, */ + wd = fpp_read_xr (op3); /* use val */ + fpp_opa = fpp_xra + op3; + } + else wd = 027; /* else 23 */ + if (!(fpp_sta & FPS_DP)) { /* fp or ep? */ + sc = (SEXT12(wd) - fpp_ac.exp) & 07777; /* alignment */ + sc = SEXT12 (sc); + fpp_ac.exp = SEXT12(wd); /* new exp */ + } + else sc = SEXT12 (wd); /* dp - simple cnt */ + if (sc < 0) /* left? */ + fpp_fr_lshn (fpp_ac.fr, -sc, EXACT); + else fpp_fr_algn (fpp_ac.fr, sc, EXACT); + if (fpp_fr_test (fpp_ac.fr, 0, EXACT) == 0) /* zero? */ + fpp_ac.exp = 0; /* clean exp */ + break; + + case 002: /* ATX */ + if (fpp_sta & FPS_DP) /* dp? */ + fpp_write_xr (op3, fpp_ac.fr[1]); /* xr<-FAC<12:23> */ + else { + fpp_copy (&x, &fpp_ac); /* copy AC */ + sc = 027 - x.exp; /* shift amt */ + if (sc < 0) /* left? */ + fpp_fr_lshn (x.fr, -sc, EXACT); + else fpp_fr_algn (x.fr, sc, EXACT); + fpp_write_xr (op3, x.fr[1]); /* xr<-val<12:23> */ + } + break; + + case 003: /* XTA */ + for (i = FPN_NFR_FP; i < FPN_NFR_EP; i++) + x.fr[i] = 0; /* clear FOP2-4 */ + x.fr[1] = fpp_read_xr (op3); /* get XR value */ + x.fr[0] = (x.fr[1] & 04000)? 07777: 0; + x.exp = 027; /* standard exp */ + if (!(fpp_sta & FPS_DP)) { /* fp or ep? */ + fpp_norm (&x, EXACT); /* normalize */ + } + fpp_copy (&fpp_ac, &x); /* result to AC */ + if (fpp_sta & FPS_DP) /* dp skips exp */ + fpp_ac.exp = x.exp; /* so force copy */ + fpp_opa = fpp_xra + op3; + break; + + case 004: /* NOP */ + break; + + case 005: /* STARTE */ + if (!(fpp_sta & FPS_EP)) { + fpp_sta = (fpp_sta | FPS_EP) & ~FPS_DP; + for (i = FPN_NFR_FP; i < FPN_NFR_EP; i++) + fpp_ac.fr[i] = 0; /* clear FAC2-4 */ + } + break; + + case 010: /* LDX */ + wd = fpp_ad15 (0); /* load XR immed */ + fpp_write_xr (op3, wd); + fpp_opa = fpp_xra + op3; + break; + + case 011: /* ADDX */ + wd = fpp_ad15 (0); + wd = wd + fpp_read_xr (op3); /* add to XR immed */ + fpp_write_xr (op3, wd); /* trims to 12b */ + fpp_opa = fpp_xra + op3; + break; + + default: + return stop_inst; + } /* end case subop */ + break; + + case 001: /* FLDA */ + ea = fpp_1wd_dir (ir); + fpp_read_op (ea, &fpp_ac); + break; + + case 002: + ea = fpp_2wd_dir (ir); + fpp_read_op (ea, &fpp_ac); + if (fpp_sta & FPS_DP) + fpp_opa = ea + 1; + else fpp_opa = ea + 2; + break; + + case 003: + ea = fpp_indir (ir); + fpp_read_op (ea, &fpp_ac); + break; + + case 004: /* jumps and sets */ + ad = fpp_ad15 (op3); /* get 15b address */ + switch (op2) { /* case on subop */ + + case 000: case 001: case 002: case 003: /* cond jump */ + case 004: case 005: case 006: case 007: + if (fpp_cond_met (op2)) /* br if cond */ + fpp_fpc = ad; + break; + + case 010: /* SETX */ + fpp_xra = ad; + break; + + case 011: /* SETB */ + fpp_bra = ad; + break; + + case 012: /* JSA */ + fpp_write (ad, 01030 + (fpp_fpc >> 12)); /* save return */ + fpp_write (ad + 1, fpp_fpc); /* trims to 12b */ + fpp_fpc = (ad + 2) & ADDRMASK; + fpp_opa = fpp_fpc - 1; + break; + + case 013: /* JSR */ + fpp_write (fpp_bra + 1, 01030 + (fpp_fpc >> 12)); + fpp_write (fpp_bra + 2, fpp_fpc); /* trims to 12b */ + fpp_opa = fpp_fpc = ad; + break; + + default: + return stop_inst; + } /* end case subop */ + break; + + case 005: /* FADD */ + ea = fpp_1wd_dir (ir); + fpp_read_op (ea, &x); + fpp_add (&fpp_ac, &x, 0); + break; + + case 006: + ea = fpp_2wd_dir (ir); + fpp_read_op (ea, &x); + fpp_add (&fpp_ac, &x, 0); + break; + + case 007: + ea = fpp_indir (ir); + fpp_read_op (ea, &x); + fpp_add (&fpp_ac, &x, 0); + break; + + case 010: { /* JNX */ + uint32 xrn = op2 & 07; + ad = fpp_ad15 (op3); /* get 15b addr */ + wd = fpp_read_xr (xrn); /* read xr */ + if (op2 & 010) { /* inc? */ + wd = (wd + 1) & 07777; + fpp_write_xr (xrn, wd); /* ++xr */ + } + if (wd != 0) /* xr != 0? */ + fpp_fpc = ad; /* jump */ + break; + } + case 011: /* FSUB */ + ea = fpp_1wd_dir (ir); + fpp_read_op (ea, &x); + fpp_add (&fpp_ac, &x, 1); + break; + + case 012: + ea = fpp_2wd_dir (ir); + fpp_read_op (ea, &x); + fpp_add (&fpp_ac, &x, 1); + break; + + case 013: + ea = fpp_indir (ir); + fpp_read_op (ea, &x); + fpp_add (&fpp_ac, &x, 1); + break; + + case 014: /* TRAP3 */ + case 020: /* TRAP4 */ + fpp_opa = fpp_ad15 (op3); + fpp_dump_apt (fpp_apta, FPS_TRPX); + break; + + case 015: /* FDIV */ + ea = fpp_1wd_dir (ir); + fpp_read_op (ea, &x); + fpp_div (&fpp_ac, &x); + break; + + case 016: + ea = fpp_2wd_dir (ir); + fpp_read_op (ea, &x); + fpp_div (&fpp_ac, &x); + break; + + case 017: + ea = fpp_indir (ir); + fpp_read_op (ea, &x); + fpp_div (&fpp_ac, &x); + break; + + case 021: /* FMUL */ + ea = fpp_1wd_dir (ir); + fpp_read_op (ea, &x); + fpp_mul (&fpp_ac, &x); + break; + + case 022: + ea = fpp_2wd_dir (ir); + fpp_read_op (ea, &x); + fpp_mul (&fpp_ac, &x); + break; + + case 023: + ea = fpp_indir (ir); + fpp_read_op (ea, &x); + fpp_mul (&fpp_ac, &x); + break; + + case 024: /* LTR */ + fpp_copy (&fpp_ac, (fpp_cond_met (op2 & 07)? &fpp_one: &fpp_zero)); + break; + + case 025: /* FADDM */ + fpp_sta |= FPS_XXXM; + ea = fpp_1wd_dir (ir); + fpp_read_op (ea, &x); + fpp_add (&x, &fpp_ac, 0); + fpp_write_op (ea, &x); /* store result */ + break; + + case 026: + fpp_sta |= FPS_XXXM; + ea = fpp_2wd_dir (ir); + fpp_read_op (ea, &x); + fpp_add (&x, &fpp_ac, 0); + fpp_write_op (ea, &x); /* store result */ + break; + + case 027: + fpp_sta |= FPS_XXXM; + ea = fpp_indir (ir); + fpp_read_op (ea, &x); + fpp_add (&x, &fpp_ac, 0); + fpp_write_op (ea, &x); /* store result */ + break; + + case 030: /* IMUL/LEA */ + ea = fpp_2wd_dir (ir); /* 2-word direct */ + if (fpp_sta & FPS_DP) { /* dp? */ + fpp_read_op (ea, &x); /* IMUL */ + fpp_imul (&fpp_ac, &x); + } + else { /* LEA */ + fpp_sta = (fpp_sta | FPS_DP) & ~FPS_EP; /* set dp */ + fpp_ac.fr[0] = (ea >> 12) & 07; + fpp_ac.fr[1] = ea & 07777; + } + break; + + case 031: /* FSTA */ + ea = fpp_1wd_dir (ir); + fpp_write_op (ea, &fpp_ac); + break; + + case 032: + ea = fpp_2wd_dir (ir); + fpp_write_op (ea, &fpp_ac); + break; + + case 033: + ea = fpp_indir (ir); + fpp_write_op (ea, &fpp_ac); + break; + + case 034: /* IMULI/LEAI */ + ea = fpp_indir (ir); /* 1-word indir */ + if (fpp_sta & FPS_DP) { /* dp? */ + fpp_read_op (ea, &x); /* IMUL */ + fpp_imul (&fpp_ac, &x); + } + else { /* LEA */ + fpp_sta = (fpp_sta | FPS_DP) & ~FPS_EP; /* set dp */ + fpp_ac.fr[0] = (ea >> 12) & 07; + fpp_ac.fr[1] = ea & 07777; + fpp_opa = ea; + } + break; + + case 035: /* FMULM */ + fpp_sta |= FPS_XXXM; + ea = fpp_1wd_dir (ir); + fpp_read_op (ea, &x); + fpp_mul (&x, &fpp_ac); + fpp_write_op (ea, &x); /* store result */ + break; + + case 036: + fpp_sta |= FPS_XXXM; + ea = fpp_2wd_dir (ir); + fpp_read_op (ea, &x); + fpp_mul (&x, &fpp_ac); + fpp_write_op (ea, &x); /* store result */ + break; + + case 037: + fpp_sta |= FPS_XXXM; + ea = fpp_indir (ir); + fpp_read_op (ea, &x); + fpp_mul (&x, &fpp_ac); + fpp_write_op (ea, &x); /* store result */ + break; + } /* end sw op+mode */ + + if (fpp_ssf) { + fpp_dump_apt (fpp_apta, FPS_HLTX); /* dump APT */ + fpp_ssf = 0; + } + + if (sim_interval) + sim_interval = sim_interval - 1; + } while ((sim_interval > 0) && + ((fpp_sta & (FPS_RUN|FPS_PAUSE|FPS_LOCK)) == (FPS_RUN|FPS_LOCK))); +if ((fpp_sta & (FPS_RUN|FPS_PAUSE)) == FPS_RUN) + sim_activate (uptr, 1); +fpp_ac.exp &= 07777; /* mask AC exp */ +return SCPE_OK; +} + +/* Address decoding routines */ + +uint32 fpp_1wd_dir (uint32 ir) +{ +uint32 ad; + +ad = fpp_bra + ((ir & 0177) * 3); /* base + 3*7b off */ +if (fpp_sta & FPS_DP) /* dp? skip exp */ + ad = ad + 1; +ad = ad & ADDRMASK; +if (fpp_sta & FPS_DP) + fpp_opa = ad + 1; +else fpp_opa = ad + 2; +return ad; +} + +uint32 fpp_2wd_dir (uint32 ir) +{ +uint32 ad; + +ad = fpp_ad15 (ir); /* get 15b addr */ +return fpp_adxr (ir, ad); /* do indexing */ +} + +uint32 fpp_indir (uint32 ir) +{ +uint32 ad, wd1, wd2; + +ad = fpp_bra + ((ir & 07) * 3); /* base + 3*3b off */ +wd1 = fpp_read (ad + 1); /* bp+off points to */ +wd2 = fpp_read (ad + 2); +ad = ((wd1 & 07) << 12) | wd2; /* indirect ptr */ + +ad = fpp_adxr (ir, ad); /* do indexing */ +if (fpp_sta & FPS_DP) + fpp_opa = ad + 1; +else fpp_opa = ad + 2; +return ad; +} + +uint32 fpp_ad15 (uint32 hi) +{ +uint32 ad; + +ad = ((hi & 07) << 12) | fpp_read (fpp_fpc); /* 15b addr */ +fpp_fpc = (fpp_fpc + 1) & ADDRMASK; /* incr FPC */ +return ad; /* return addr */ +} + +uint32 fpp_adxr (uint32 ir, uint32 base_ad) +{ +uint32 xr, wd; + +xr = (ir >> 3) & 07; +wd = fpp_read_xr (xr); /* get xr */ +if (ir & 0100) { /* increment? */ + wd = (wd + 1) & 07777; /* inc, rewrite */ + fpp_write_xr (xr, wd); + } +if (xr != 0) { /* indexed? */ + if (fpp_sta & FPS_EP) + wd = wd * 6; /* scale by len */ + else if (fpp_sta & FPS_DP) + wd = wd * 2; + else wd = wd * 3; + return (base_ad + wd) & ADDRMASK; /* return index */ + } +else return base_ad & ADDRMASK; /* return addr */ +} + +/* Computation routines */ + +/* Fraction/floating add */ + +void fpp_add (FPN *a, FPN *b, uint32 sub) +{ +FPN x, y, z; +uint32 c, ediff; + +fpp_zcopy (&x, a); /* copy opnds */ +fpp_zcopy (&y, b); +if (sub) /* subtract? */ + fpp_fr_neg (y.fr, EXACT); /* neg B, exact */ +if (fpp_sta & FPS_DP) { /* dp? */ + uint32 cout = fpp_fr_add (z.fr, x.fr, y.fr, EXTEND);/* z = a + b */ + uint32 zsign = z.fr[0] & FPN_FRSIGN; + cout = (cout? 04000: 0); /* make sign bit */ + /* overflow is indicated when signs are equal and overflow does not + match the result sign bit */ + fpp_copy (a, &z); /* result is z */ + if (!((x.fr[0] ^ y.fr[0]) & FPN_FRSIGN) && (cout != zsign)) { + fpp_copy (a, &z); /* copy out result */ + fpp_dump_apt (fpp_apta, FPS_IOVX); /* int ovf? */ + return; + } + } +else { /* fp or ep */ + if (fpp_fr_test (b->fr, 0, EXACT) == 0) /* B == 0? */ + z = x; /* result is A */ + else if (fpp_fr_test (a->fr, 0, EXACT) == 0) /* A == 0? */ + z = y; /* result is B */ + else { /* fp or ep */ + if (x.exp < y.exp) { /* |a| < |b|? */ + z = x; /* exchange ops */ + x = y; + y = z; + } + ediff = x.exp - y.exp; /* exp diff */ + if (ediff <= (uint32) ((fpp_sta & FPS_EP)? 59: 24)) { /* any add? */ + z.exp = x.exp; /* result exp */ + if (ediff != 0) /* any align? */ + fpp_fr_algn (y.fr, ediff, EXTEND); /* align, 60b */ + c = fpp_fr_add (z.fr, x.fr, y.fr, EXTEND); /* add fractions */ + if ((((x.fr[0] ^ y.fr[0]) & FPN_FRSIGN) == 0) && /* same signs? */ + (c || /* carry out? */ + ((~x.fr[0] & z.fr[0] & FPN_FRSIGN)))) { /* + to - change? */ + fpp_fr_rsh1 (z.fr, c << 11, EXTEND); /* rsh, insert cout */ + z.exp = z.exp + 1; /* incr exp */ + } /* end same signs */ + } /* end in range */ + else z = x; /* ovrshift */ + } /* end ops != 0 */ + if (fpp_norm (&z, EXTEND)) /* norm, !exact? */ + fpp_round (&z); /* round */ + fpp_copy (a, &z); /* copy out */ + fpp_test_xp (&z); /* ovf, unf? */ + } /* end else */ +return; +} + +/* Fraction/floating multiply */ + +void fpp_mul (FPN *a, FPN *b) +{ +FPN x, y, z; + +fpp_zcopy (&x, a); /* copy opnds */ +fpp_zcopy (&y, b); +if ((fpp_fr_test(y.fr, 0, EXACT-1) == 0) && (y.fr[EXACT-1] < 2)) { + y.exp = 0; + y.fr[EXACT-1] = 0; +} +if (fpp_sta & FPS_DP) /* dp? */ + fpp_fr_mul (z.fr, x.fr, y.fr, TRUE); /* mult frac */ +else { /* fp or ep */ + fpp_norm (&x, EXACT); + fpp_norm (&y, EXACT); + z.exp = x.exp + y.exp; /* add exp */ + fpp_fr_mul (z.fr, x.fr, y.fr, TRUE); /* mult frac */ + if (fpp_norm (&z, EXTEND)) /* norm, !exact? */ + fpp_round (&z); /* round */ + fpp_copy (a, &z); + if (z.exp > 2047) + fpp_dump_apt (fpp_apta, FPS_FOVX); /* trap */ + return; + } +fpp_copy (a, &z); /* result is z */ +return; +} + +/* Fraction/floating divide */ + +void fpp_div (FPN *a, FPN *b) +{ +FPN x, y, z; + +if (fpp_fr_test (b->fr, 0, EXACT) == 0) { /* divisor 0? */ + fpp_dump_apt (fpp_apta, FPS_DVZX); /* error */ + return; + } +if (fpp_fr_test (a->fr, 0, EXACT) == 0) /* dividend 0? */ + return; /* quotient is 0 */ +fpp_zcopy (&x, a); /* copy opnds */ +fpp_zcopy (&y, b); +if (fpp_sta & FPS_DP) { /* dp? */ + if (fpp_fr_div (z.fr, x.fr, y.fr)) { /* fr div, ovflo? */ + fpp_dump_apt (fpp_apta, FPS_IOVX); /* error */ + return; + } + fpp_copy (a, &z); /* result is z */ + } +else { /* fp or ep */ + fpp_norm (&y, EXACT); /* norm divisor */ + if (fpp_fr_test (x.fr, 04000, EXACT) == 0) { /* divd 1.000...? */ + x.fr[0] = 06000; /* fix */ + x.exp = x.exp + 1; + } + z.exp = x.exp - y.exp; /* calc exp */ + if (fpp_fr_div (z.fr, x.fr, y.fr)) { /* fr div, ovflo? */ + uint32 cin = (a->fr[0] ^ b->fr[0]) & FPN_FRSIGN; + fpp_fr_rsh1 (z.fr, cin, EXTEND); /* rsh, insert sign */ + z.exp = z.exp + 1; /* incr exp */ + } + if (fpp_norm (&z, EXTEND)) /* norm, !exact? */ + fpp_round (&z); /* round */ + fpp_copy (a, &z); + if (z.exp > 2048) { /* underflow? */ + if (fpp_cmd & FPC_UNFX) { /* trap? */ + fpp_dump_apt (fpp_apta, FPS_UNF); + return; + } + } + } +return; +} + +/* Integer multiply - returns true if overflow */ + +t_bool fpp_imul (FPN *a, FPN *b) +{ +uint32 sext; +FPN x, y, z; + +fpp_zcopy (&x, a); /* copy args */ +fpp_zcopy (&y, b); +fpp_fr_mul (z.fr, x.fr, y.fr, FALSE); /* mult fracs */ +a->fr[0] = z.fr[1]; /* low 24b */ +a->fr[1] = z.fr[2]; +if ((a->fr[0] == 0) && (a->fr[1] == 0)) /* fpp zeroes exp */ + a->exp = 0; /* even in dp mode */ +sext = (z.fr[2] & FPN_FRSIGN)? 07777: 0; +if (((z.fr[0] | z.fr[1] | sext) != 0) && /* hi 25b == 0 */ + ((z.fr[0] & z.fr[1] & sext) != 07777)) { /* or 777777774? */ + fpp_dump_apt (fpp_apta, FPS_IOVX); + return TRUE; + } +return FALSE; +} + +/* Auxiliary floating point routines */ + +t_bool fpp_cond_met (uint32 cond) +{ +switch (cond) { + + case 0: + return (fpp_fr_test (fpp_ac.fr, 0, EXACT) == 0); + + case 1: + return (fpp_fr_test (fpp_ac.fr, 0, EXACT) >= 0); + + case 2: + return (fpp_fr_test (fpp_ac.fr, 0, EXACT) <= 0); + + case 3: + return 1; + + case 4: + return (fpp_fr_test (fpp_ac.fr, 0, EXACT) != 0); + + case 5: + return (fpp_fr_test (fpp_ac.fr, 0, EXACT) < 0); + + case 6: + return (fpp_fr_test (fpp_ac.fr, 0, EXACT) > 0); + + case 7: + return (fpp_ac.exp > 027); + } +return 0; +} + +/* Normalization - returns TRUE if rounding possible, FALSE if exact */ + +t_bool fpp_norm (FPN *a, uint32 cnt) +{ +if (fpp_fr_test (a->fr, 0, cnt) == 0) { /* zero? */ + a->exp = 0; /* clean exp */ + return FALSE; /* don't round */ + } +while (((a->fr[0] == 0) && !(a->fr[1] & 04000)) || /* lead 13b same? */ + ((a->fr[0] == 07777) && (a->fr[1] & 04000))) { + fpp_fr_lsh12 (a->fr, cnt); /* move word */ + a->exp = a->exp - 12; + } +while (((a->fr[0] ^ (a->fr[0] << 1)) & FPN_FRSIGN) == 0) { /* until norm */ + fpp_fr_lsh1 (a->fr, cnt); /* shift 1b */ + a->exp = a->exp - 1; + } +if (fpp_fr_test (a->fr, 04000, EXACT) == 0) { /* 4000...0000? */ + a->fr[0] = 06000; /* chg to 6000... */ + a->exp = a->exp + 1; /* with exp+1 */ + return FALSE; /* don't round */ + } +return TRUE; +} + +/* Exact fp number copy */ + +void fpp_copy (FPN *a, FPN *b) +{ +uint32 i; + +if (!(fpp_sta & FPS_DP)) + a->exp = b->exp; +for (i = 0; i < EXACT; i++) + a->fr[i] = b->fr[i]; +return; +} + +/* Zero extended fp number copy (60b) */ + +void fpp_zcopy (FPN *a, FPN *b) +{ +uint32 i; + +a->exp = b->exp; +for (i = 0; i < FPN_NFR_EP; i++) { + if ((i < FPN_NFR_FP) || (fpp_sta & FPS_EP)) + a->fr[i] = b->fr[i]; + else a->fr[i] = 0; + } +a->fr[i++] = 0; +a->fr[i] = 0; +return; +} + +/* Test exp for overflow or underflow, returns TRUE on trap */ + +t_bool fpp_test_xp (FPN *a) +{ +if (a->exp > 2047) { /* overflow? */ + fpp_dump_apt (fpp_apta, FPS_FOVX); /* trap */ + return TRUE; + } +if (a->exp < -2048) { /* underflow? */ + if (fpp_cmd & FPC_UNFX) { /* trap? */ + fpp_dump_apt (fpp_apta, FPS_UNF); + return TRUE; + } + fpp_copy (a, &fpp_zero); /* flush to 0 */ + } +return FALSE; +} + +/* Round dp/fp value */ + +void fpp_round (FPN *a) +{ +int32 i; +uint32 cin, afr0_sign; + +if (fpp_sta & FPS_EP) /* ep? */ + return; /* don't round */ +afr0_sign = a->fr[0] & FPN_FRSIGN; /* save input sign */ +cin = afr0_sign? 03777: 04000; +for (i = FPN_NFR_FP; i >= 0; i--) { /* 3 words */ + a->fr[i] = a->fr[i] + cin; /* add in carry */ + cin = (a->fr[i] >> 12) & 1; + a->fr[i] = a->fr[i] & 07777; + } +if (!(fpp_sta & FPS_DP) && /* fp? */ + (afr0_sign ^ (a->fr[0] & FPN_FRSIGN))) { /* sign change? */ + fpp_fr_rsh1 (a->fr, afr0_sign, EXACT); /* rsh, insert sign */ + a->exp = a->exp + 1; + } +return; +} + +/* N-precision integer routines */ + +/* Fraction add/sub */ + +uint32 fpp_fr_add (uint32 *c, uint32 *a, uint32 *b, uint32 cnt) + +{ +uint32 i, cin; + +for (i = cnt, cin = 0; i > 0; i--) { + c[i - 1] = a[i - 1] + b[i - 1] + cin; + cin = (c[i - 1] >> 12) & 1; + c[i - 1] = c[i - 1] & 07777; + } +return cin; +} + +void fpp_fr_sub (uint32 *c, uint32 *a, uint32 *b, uint32 cnt) +{ +uint32 i, cin; + +for (i = cnt, cin = 0; i > 0; i--) { + c[i - 1] = a[i - 1] - b[i - 1] - cin; + cin = (c[i - 1] >> 12) & 1; + c[i - 1] = c[i - 1] & 07777; + } +return; +} + +/* Fraction multiply - always develop 60b, multiply is + either 24b*24b or 60b*60b + + This is a signed multiply. The shift in for signed multiply is + technically ALU_N XOR ALU_V. This can be simplified as follows: + + a-sign c-sign result-sign cout overflow N XOR V = shift in + + 0 0 0 0 0 0 + 0 0 1 0 1 0 + 0 1 0 1 0 0 + 0 1 1 0 0 1 + 1 0 0 1 0 0 + 1 0 1 0 0 1 + 1 1 0 1 1 1 + 1 1 1 1 0 1 + + If a-sign == c-sign, shift-in = a-sign + If a-sign != c-sign, shift-in = result-sign + */ + +void fpp_fr_mul (uint32 *c, uint32 *a, uint32 *b, t_bool fix) +{ +uint32 i, cnt, lo, wc, fill, b_sign; + +b_sign = b[0] & FPN_FRSIGN; /* remember b's sign */ + +fpp_fr_fill (c, 0, FPN_NFR_MDS); /* clr answer */ +if (fpp_sta & FPS_EP) /* ep? */ + lo = FPN_NFR_EP; /* low order mpyr word */ +else + lo = FPN_NFR_FP; /* low order mpyr word */ + +if (fix) + fpp_fr_algn (a, 12, FPN_NFR_MDS + 1); /* fill left with sign */ +wc = 2; /* 3 words at start */ +fill = 0; +cnt = lo * 12; /* total steps */ +for (i = 0; i < cnt; i++) { + if ((i % 12) == 0) { + wc++; /* do another word */ + lo--; /* and next mpyr word */ + fpp_fr_algn (c, 24, wc + 1); + c[wc] = 0; + c[0] = c[1] = fill; /* propagate sign */ + } + if (b[lo] & FPN_FRSIGN) /* mpyr bit set? */ + fpp_fr_add(c, a, c, wc); + fill = ((c[0] & FPN_FRSIGN) ? 07777 : 0); /* remember sign */ + fpp_fr_lsh1 (c, wc); /* shift the result */ + fpp_fr_lsh1 (b + lo, 1); /* shift mpcd */ + + } + +if (!fix) /* imul shifts result */ + fpp_fr_rsh1 (c, c[0] & FPN_FRSIGN, EXACT + 1); /* result is 1 wd right */ +if (b_sign) { /* if mpyr was negative */ + if (fix) + fpp_fr_lsh12 (a, FPN_NFR_MDS+1); /* restore a */ + fpp_fr_sub (c, c, a, EXACT); /* adjust result */ + fpp_fr_sub (c, c, a, EXACT); + } + +return; +} + +/* Fraction divide */ + +t_bool fpp_fr_div (uint32 *c, uint32 *a, uint32 *b) +{ +uint32 i, old_c, lo, cnt, sign, b_sign, addsub, limit; +/* Number of words processed by each divide step */ +static uint32 limits[7] = {6, 6, 5, 4, 3, 3, 2}; + +fpp_fr_fill (c, 0, FPN_NFR_MDS); /* clr answer */ +sign = (a[0] ^ b[0]) & FPN_FRSIGN; /* sign of result */ +b_sign = (b[0] & FPN_FRSIGN); +if (a[0] & FPN_FRSIGN) /* |a| */ + fpp_fr_neg (a, EXACT); +if (fpp_sta & FPS_EP) /* ep? 6 words */ + lo = FPN_NFR_EP-1; +else lo = FPN_NFR_FP-1; /* fp, dp? 3 words */ +cnt = (lo + 1) * 12; +addsub = 04000; /* setup first op */ +for (i = 0; i < cnt; i++) { /* loop */ + limit = limits[i / 12]; /* how many wds this time */ + fpp_fr_lsh1 (c, FPN_NFR_MDS); /* shift quotient */ + if (addsub ^ b_sign) /* diff signs, subtr */ + fpp_fr_sub (a, a, b, limit); /* divd - divr */ + else + fpp_fr_add (a, a, b, limit); /* restore */ + if (!(a[0] & FPN_FRSIGN)) { + c[lo] |= 1; /* set quo bit */ + addsub = 04000; /* sign for nxt loop */ + } + else addsub = 0; + fpp_fr_lsh1 (a, limit); /* shift dividend */ + } +old_c = c[0]; /* save ho quo */ +if (sign) /* expect neg ans? */ + fpp_fr_neg (c, EXTEND); /* -quo */ +if (old_c & FPN_FRSIGN) /* sign set before */ + return TRUE; /* neg? */ +return FALSE; +} + +/* Negate - 24b or 60b */ + +uint32 fpp_fr_neg (uint32 *a, uint32 cnt) +{ +uint32 i, cin; + +for (i = cnt, cin = 1; i > 0; i--) { + a[i - 1] = (~a[i - 1] + cin) & 07777; + cin = (cin != 0 && a[i - 1] == 0); + } +return cin; +} + +/* Test (compare to x'0...0) - 24b or 60b */ + +int32 fpp_fr_test (uint32 *a, uint32 v0, uint32 cnt) +{ +uint32 i; + +if (a[0] != v0) + return (a[0] & FPN_FRSIGN)? -1: +1; +for (i = 1; i < cnt; i++) { + if (a[i] != 0) + return (a[0] & FPN_FRSIGN)? -1: +1; + } +return 0; +} + +/* Fraction compare - 24b or 60b */ + +int32 fpp_fr_cmp (uint32 *a, uint32 *b, uint32 cnt) +{ +uint32 i; + +if ((a[0] ^ b[0]) & FPN_FRSIGN) + return (b[0] & FPN_FRSIGN)? +1: -1; +for (i = 0; i < cnt; i++) { + if (a[i] > b[i]) + return (b[0] & FPN_FRSIGN)? +1: -1; + if (a[i] < b[i]) + return (b[0] & FPN_FRSIGN)? -1: +1; + } +return 0; +} + +/* Fraction fill */ + +void fpp_fr_fill (uint32 *a, uint32 v, uint32 cnt) +{ +uint32 i; + +for (i = 0; i < cnt; i++) + a[i] = v; +return; +} + +/* Left shift n (unsigned) */ + +void fpp_fr_lshn (uint32 *a, uint32 sc, uint32 cnt) +{ +uint32 i; + +if (sc >= (cnt * 12)) { /* out of range? */ + fpp_fr_fill (a, 0, cnt); + return; + } +while (sc >= 12) { /* word shift? */ + fpp_fr_lsh12 (a, cnt); + sc = sc - 12; + } +if (sc == 0) /* any more? */ + return; +for (i = 1; i < cnt; i++) /* bit shift */ + a[i - 1] = ((a[i - 1] << sc) | (a[i] >> (12 - sc))) & 07777; +a[cnt - 1] = (a[cnt - 1] << sc) & 07777; +return; +} + +/* Left shift 12b (unsigned) */ + +void fpp_fr_lsh12 (uint32 *a, uint32 cnt) +{ +uint32 i; + +for (i = 1; i < cnt; i++) + a[i - 1] = a[i]; +a[cnt - 1] = 0; +return; +} + +/* Left shift 1b (unsigned) */ + +void fpp_fr_lsh1 (uint32 *a, uint32 cnt) +{ +uint32 i; + +for (i = 1; i < cnt; i++) + a[i - 1] = ((a[i - 1] << 1) | (a[i] >> 11)) & 07777; +a[cnt - 1] = (a[cnt - 1] << 1) & 07777; +return; +} + +/* Right shift 1b, with shift in */ + +void fpp_fr_rsh1 (uint32 *a, uint32 sign, uint32 cnt) +{ +uint32 i; + +for (i = cnt - 1; i > 0; i--) + a[i] = ((a[i] >> 1) | (a[i - 1] << 11)) & 07777; +a[0] = (a[0] >> 1) | sign; +return; +} + +/* Right shift n (signed) */ + +void fpp_fr_algn (uint32 *a, uint32 sc, uint32 cnt) +{ +uint32 i, sign; + +sign = (a[0] & FPN_FRSIGN)? 07777: 0; +if (sc >= (cnt * 12)) { /* out of range? */ + fpp_fr_fill (a, sign, cnt); + return; + } +while (sc >= 12) { + for (i = cnt - 1; i > 0; i--) + a[i] = a[i - 1]; + a[0] = sign; + sc = sc - 12; + } +if (sc == 0) + return; +for (i = cnt - 1; i > 0; i--) + a[i] = ((a[i] >> sc) | (a[i - 1] << (12 - sc))) & 07777; +a[0] = ((a[0] >> sc) | (sign << (12 - sc))) & 07777; +return; +} + +/* Read/write routines */ + +void fpp_read_op (uint32 ea, FPN *a) +{ +uint32 i; + +if (!(fpp_sta & FPS_DP)) { + a->exp = fpp_read (ea++); + a->exp = SEXT12 (a->exp); + } +for (i = 0; i < EXACT; i++) + a->fr[i] = fpp_read (ea + i); +return; +} + +void fpp_write_op (uint32 ea, FPN *a) +{ +uint32 i; + +fpp_opa = ea + 2; +if (!(fpp_sta & FPS_DP)) + fpp_write (ea++, a->exp); +for (i = 0; i < EXACT; i++) + fpp_write (ea + i, a->fr[i]); +return; +} + +uint32 fpp_read (uint32 ea) +{ +ea = ea & ADDRMASK; +if (fpp_cmd & FPC_FIXF) + ea = fpp_aptsvf | (ea & 07777); +return M[ea]; +} + +void fpp_write (uint32 ea, uint32 val) +{ +ea = ea & ADDRMASK; +if (fpp_cmd & FPC_FIXF) + ea = fpp_aptsvf | (ea & 07777); +if (MEM_ADDR_OK (ea)) + M[ea] = val & 07777; +return; +} + +uint32 apt_read (uint32 ea) +{ +ea = ea & ADDRMASK; +return M[ea]; +} + +void apt_write (uint32 ea, uint32 val) +{ +ea = ea & ADDRMASK; +if (MEM_ADDR_OK (ea)) + M[ea] = val & 07777; +return; +} + +/* Utility routines */ + +void fpp_load_apt (uint32 ad) +{ +uint32 wd0, i; + +wd0 = apt_read (ad++); +fpp_fpc = ((wd0 & 07) << 12) | apt_read (ad++); +if (FPC_GETFAST (fpp_cmd) != 017) { + fpp_xra = ((wd0 & 00070) << 9) | apt_read (ad++); + fpp_bra = ((wd0 & 00700) << 6) | apt_read (ad++); + fpp_opa = ((wd0 & 07000) << 3) | apt_read (ad++); + fpp_ac.exp = apt_read (ad++); + for (i = 0; i < EXACT; i++) + fpp_ac.fr[i] = apt_read (ad++); + } +fpp_aptsvf = (ad - 1) & 070000; +fpp_sta |= FPS_RUN; +return; +} + +void fpp_dump_apt (uint32 ad, uint32 sta) +{ +uint32 wd0, i; + +wd0 = (fpp_fpc >> 12) & 07; +if (FPC_GETFAST (fpp_cmd) != 017) + wd0 = wd0 | + ((fpp_opa >> 3) & 07000) | + ((fpp_bra >> 6) & 00700) | + ((fpp_xra >> 9) & 00070); +apt_write (ad++, wd0); +apt_write (ad++, fpp_fpc); +if (FPC_GETFAST (fpp_cmd) != 017) { + apt_write (ad++, fpp_xra); + apt_write (ad++, fpp_bra); + apt_write (ad++, fpp_opa); + apt_write (ad++, fpp_ac.exp); + for (i = 0; i < EXACT; i++) + apt_write (ad++, fpp_ac.fr[i]); + } +fpp_sta = (fpp_sta | sta) & ~FPS_RUN; +fpp_flag = 1; +if (fpp_cmd & FPC_IE) + int_req |= INT_FPP; +return; +} + +/* Reset routine */ + +t_stat fpp_reset (DEVICE *dptr) +{ +sim_cancel (&fpp_unit); +fpp_flag = 0; +fpp_last_lockbit = 0; +int_req &= ~INT_FPP; +if (sim_switches & SWMASK ('P')) { + fpp_apta = 0; + fpp_aptsvf = 0; + fpp_fpc = 0; + fpp_bra = 0; + fpp_xra = 0; + fpp_opa = 0; + fpp_ac = fpp_zero; + fpp_ssf = 0; + fpp_sta = 0; + fpp_cmd = 0; + } +else { + fpp_sta &= ~(FPS_DP|FPS_EP|FPS_TRPX|FPS_DVZX|FPS_IOVX|FPS_FOVX|FPS_UNF); + fpp_cmd &= (FPC_DP|FPC_UNFX|FPC_IE); + } + +return SCPE_OK; +} ADDED src/PDP8/pdp8_lp.c Index: src/PDP8/pdp8_lp.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_lp.c @@ -0,0 +1,188 @@ +/* pdp8_lp.c: PDP-8 line printer simulator + + Copyright (c) 1993-2016, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + lpt LP8E line printer + + 16-Dec-16 DJG Added IOT 6660 to allow WPS WS78 3.4 to print + 19-Jan-07 RMS Added UNIT_TEXT + 25-Apr-03 RMS Revised for extended file support + 04-Oct-02 RMS Added DIB, enable/disable, device number support + 30-May-02 RMS Widened POS to 32b +*/ + +#include "pdp8_defs.h" + +extern int32 int_req, int_enable, dev_done, stop_inst; + +int32 lpt_err = 0; /* error flag */ +int32 lpt_stopioe = 0; /* stop on error */ + +int32 lpt (int32 IR, int32 AC); +t_stat lpt_svc (UNIT *uptr); +t_stat lpt_reset (DEVICE *dptr); +t_stat lpt_attach (UNIT *uptr, CONST char *cptr); +t_stat lpt_detach (UNIT *uptr); + +/* LPT data structures + + lpt_dev LPT device descriptor + lpt_unit LPT unit descriptor + lpt_reg LPT register list +*/ + +DIB lpt_dib = { DEV_LPT, 1, { &lpt } }; + +UNIT lpt_unit = { + UDATA (&lpt_svc, UNIT_SEQ+UNIT_ATTABLE+UNIT_TEXT, 0), SERIAL_OUT_WAIT + }; + +REG lpt_reg[] = { + { ORDATAD (BUF, lpt_unit.buf, 8,"last data item processed") }, + { FLDATAD (ERR, lpt_err, 0, "error status flag") }, + { FLDATAD (DONE, dev_done, INT_V_LPT, "device done flag") }, + { FLDATAD (ENABLE, int_enable, INT_V_LPT, "interrupt enable flag") }, + { FLDATAD (INT, int_req, INT_V_LPT, "interrupt pending flag") }, + { DRDATAD (POS, lpt_unit.pos, T_ADDR_W, "position in the output file"), PV_LEFT }, + { DRDATAD (TIME, lpt_unit.wait, 24, "time from I/O initiation to interrupt"), PV_LEFT }, + { FLDATAD (STOP_IOE, lpt_stopioe, 0, "stop on I/O error") }, + { ORDATA (DEVNUM, lpt_dib.dev, 6), REG_HRO }, + { NULL } + }; + +MTAB lpt_mod[] = { + { MTAB_XTD|MTAB_VDV, 0, "DEVNO", "DEVNO", + &set_dev, &show_dev, NULL }, + { 0 } + }; + +DEVICE lpt_dev = { + "LPT", &lpt_unit, lpt_reg, lpt_mod, + 1, 10, 31, 1, 8, 8, + NULL, NULL, &lpt_reset, + NULL, &lpt_attach, &lpt_detach, + &lpt_dib, DEV_DISABLE + }; + +/* IOT routine */ + +int32 lpt (int32 IR, int32 AC) +{ +switch (IR & 07) { /* decode IR<9:11> */ + + case 0: /* PKSTF */ + dev_done = dev_done | INT_LPT; /* set flag */ + int_req = INT_UPDATE; /* update interrupts */ + return AC; + + case 1: /* PSKF */ + return (dev_done & INT_LPT)? IOT_SKP + AC: AC; + + case 2: /* PCLF */ + dev_done = dev_done & ~INT_LPT; /* clear flag */ + int_req = int_req & ~INT_LPT; /* clear int req */ + return AC; + + case 3: /* PSKE */ + return (lpt_err)? IOT_SKP + AC: AC; + + case 6: /* PCLF!PSTB */ + dev_done = dev_done & ~INT_LPT; /* clear flag */ + int_req = int_req & ~INT_LPT; /* clear int req */ + + case 4: /* PSTB */ + lpt_unit.buf = AC & 0177; /* load buffer */ + if ((lpt_unit.buf == 015) || (lpt_unit.buf == 014) || + (lpt_unit.buf == 012)) { + sim_activate (&lpt_unit, lpt_unit.wait); + return AC; + } + return (lpt_svc (&lpt_unit) << IOT_V_REASON) + AC; + + case 5: /* PSIE */ + int_enable = int_enable | INT_LPT; /* set enable */ + int_req = INT_UPDATE; /* update interrupts */ + return AC; + + case 7: /* PCIE */ + int_enable = int_enable & ~INT_LPT; /* clear enable */ + int_req = int_req & ~INT_LPT; /* clear int req */ + return AC; + + default: + return (stop_inst << IOT_V_REASON) + AC; + } /* end switch */ +} + +/* Unit service */ + +t_stat lpt_svc (UNIT *uptr) +{ +dev_done = dev_done | INT_LPT; /* set done */ +int_req = INT_UPDATE; /* update interrupts */ +if ((uptr->flags & UNIT_ATT) == 0) { + lpt_err = 1; + return IORETURN (lpt_stopioe, SCPE_UNATT); + } +fputc (uptr->buf, uptr->fileref); /* print char */ +uptr->pos = ftell (uptr->fileref); +if (ferror (uptr->fileref)) { /* error? */ + sim_perror ("LPT I/O error"); + clearerr (uptr->fileref); + return SCPE_IOERR; + } +return SCPE_OK; +} + +/* Reset routine */ + +t_stat lpt_reset (DEVICE *dptr) +{ +lpt_unit.buf = 0; +dev_done = dev_done & ~INT_LPT; /* clear done, int */ +int_req = int_req & ~INT_LPT; +int_enable = int_enable | INT_LPT; /* set enable */ +lpt_err = (lpt_unit.flags & UNIT_ATT) == 0; +sim_cancel (&lpt_unit); /* deactivate unit */ +return SCPE_OK; +} + +/* Attach routine */ + +t_stat lpt_attach (UNIT *uptr, CONST char *cptr) +{ +t_stat reason; + +reason = attach_unit (uptr, cptr); +lpt_err = (lpt_unit.flags & UNIT_ATT) == 0; +return reason; +} + +/* Detach routine */ + +t_stat lpt_detach (UNIT *uptr) +{ +lpt_err = 1; +return detach_unit (uptr); +} ADDED src/PDP8/pdp8_mt.c Index: src/PDP8/pdp8_mt.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_mt.c @@ -0,0 +1,661 @@ +/* pdp8_mt.c: PDP-8 magnetic tape simulator + + Copyright (c) 1993-2011, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + mt TM8E/TU10 magtape + + 16-Feb-06 RMS Added tape capacity checking + 16-Aug-05 RMS Fixed C++ declaration and cast problems + 18-Mar-05 RMS Added attached test to detach routine + 25-Apr-03 RMS Revised for extended file support + 29-Mar-03 RMS Added multiformat support + 04-Mar-03 RMS Fixed bug in SKTR + 01-Mar-03 RMS Fixed interrupt handling + Revised for magtape library + 30-Oct-02 RMS Revised BOT handling, added error record handling + 04-Oct-02 RMS Added DIBs, device number support + 30-Aug-02 RMS Revamped error handling + 28-Aug-02 RMS Added end of medium support + 30-May-02 RMS Widened POS to 32b + 22-Apr-02 RMS Added maximum record length test + 06-Jan-02 RMS Changed enable/disable support + 30-Nov-01 RMS Added read only unit, extended SET/SHOW support + 24-Nov-01 RMS Changed UST, POS, FLG to arrays + 25-Apr-01 RMS Added device enable/disable support + 04-Oct-98 RMS V2.4 magtape format + 22-Jan-97 RMS V2.3 magtape format + 01-Jan-96 RMS Rewritten from TM8-E Maintenance Manual + + Magnetic tapes are represented as a series of variable records + of the form: + + 32b byte count + byte 0 + byte 1 + : + byte n-2 + byte n-1 + 32b byte count + + If the byte count is odd, the record is padded with an extra byte + of junk. File marks are represented by a byte count of 0. +*/ + +#include "pdp8_defs.h" +#include "sim_tape.h" + +#define MT_NUMDR 8 /* #drives */ +#define USTAT u3 /* unit status */ +#define MT_MAXFR (1 << 16) /* max record lnt */ +#define WC_SIZE (1 << 12) /* max word count */ +#define WC_MASK (WC_SIZE - 1) + +/* Command/unit - mt_cu */ + +#define CU_V_UNIT 9 /* unit */ +#define CU_M_UNIT 07 +#define CU_PARITY 00400 /* parity select */ +#define CU_IEE 00200 /* error int enable */ +#define CU_IED 00100 /* done int enable */ +#define CU_V_EMA 3 /* ext mem address */ +#define CU_M_EMA 07 +#define CU_EMA (CU_M_EMA << CU_V_EMA) +#define CU_DTY 00002 /* drive type */ +#define CU_UNPAK 00001 /* 6b vs 8b mode */ +#define GET_UNIT(x) (((x) >> CU_V_UNIT) & CU_M_UNIT) +#define GET_EMA(x) (((x) & CU_EMA) << (12 - CU_V_EMA)) + +/* Function - mt_fn */ + +#define FN_V_FNC 9 /* function */ +#define FN_M_FNC 07 +#define FN_UNLOAD 00 +#define FN_REWIND 01 +#define FN_READ 02 +#define FN_CMPARE 03 +#define FN_WRITE 04 +#define FN_WREOF 05 +#define FN_SPACEF 06 +#define FN_SPACER 07 +#define FN_ERASE 00400 /* erase */ +#define FN_CRC 00200 /* read CRC */ +#define FN_GO 00100 /* go */ +#define FN_INC 00040 /* incr mode */ +#define FN_RMASK 07700 /* readable bits */ +#define GET_FNC(x) (((x) >> FN_V_FNC) & FN_M_FNC) + +/* Status - stored in mt_sta or (*) uptr->USTAT */ + +#define STA_ERR (04000 << 12) /* error */ +#define STA_REW (02000 << 12) /* *rewinding */ +#define STA_BOT (01000 << 12) /* *start of tape */ +#define STA_REM (00400 << 12) /* *offline */ +#define STA_PAR (00200 << 12) /* parity error */ +#define STA_EOF (00100 << 12) /* *end of file */ +#define STA_RLE (00040 << 12) /* rec lnt error */ +#define STA_DLT (00020 << 12) /* data late */ +#define STA_EOT (00010 << 12) /* *end of tape */ +#define STA_WLK (00004 << 12) /* *write locked */ +#define STA_CPE (00002 << 12) /* compare error */ +#define STA_ILL (00001 << 12) /* illegal */ +#define STA_9TK 00040 /* 9 track */ +/* #define STA_BAD 00020 *//* bad tape?? */ +#define STA_INC 00010 /* increment error */ +#define STA_LAT 00004 /* lateral par error */ +#define STA_CRC 00002 /* CRC error */ +#define STA_LON 00001 /* long par error */ + +#define STA_CLR (FN_RMASK | 00020) /* always clear */ +#define STA_DYN (STA_REW | STA_BOT | STA_REM | STA_EOF | \ + STA_EOT | STA_WLK) /* kept in USTAT */ + +extern uint16 M[]; +extern int32 int_req, stop_inst; +extern UNIT cpu_unit; + +int32 mt_cu = 0; /* command/unit */ +int32 mt_fn = 0; /* function */ +int32 mt_ca = 0; /* current address */ +int32 mt_wc = 0; /* word count */ +int32 mt_sta = 0; /* status register */ +int32 mt_db = 0; /* data buffer */ +int32 mt_done = 0; /* mag tape flag */ +int32 mt_time = 10; /* record latency */ +int32 mt_stopioe = 1; /* stop on error */ +uint8 *mtxb = NULL; /* transfer buffer */ + +int32 mt70 (int32 IR, int32 AC); +int32 mt71 (int32 IR, int32 AC); +int32 mt72 (int32 IR, int32 AC); +t_stat mt_svc (UNIT *uptr); +t_stat mt_reset (DEVICE *dptr); +t_stat mt_attach (UNIT *uptr, CONST char *cptr); +t_stat mt_detach (UNIT *uptr); +int32 mt_updcsta (UNIT *uptr); +int32 mt_ixma (int32 xma); +t_stat mt_map_err (UNIT *uptr, t_stat st); +t_stat mt_vlock (UNIT *uptr, int32 val, CONST char *cptr, void *desc); +UNIT *mt_busy (void); +void mt_set_done (void); + +/* MT data structures + + mt_dev MT device descriptor + mt_unit MT unit list + mt_reg MT register list + mt_mod MT modifier list +*/ + +DIB mt_dib = { DEV_MT, 3, { &mt70, &mt71, &mt72 } }; + +UNIT mt_unit[] = { + { UDATA (&mt_svc, UNIT_ATTABLE+UNIT_DISABLE+UNIT_ROABLE, 0) }, + { UDATA (&mt_svc, UNIT_ATTABLE+UNIT_DISABLE+UNIT_ROABLE, 0) }, + { UDATA (&mt_svc, UNIT_ATTABLE+UNIT_DISABLE+UNIT_ROABLE, 0) }, + { UDATA (&mt_svc, UNIT_ATTABLE+UNIT_DISABLE+UNIT_ROABLE, 0) }, + { UDATA (&mt_svc, UNIT_ATTABLE+UNIT_DISABLE+UNIT_ROABLE, 0) }, + { UDATA (&mt_svc, UNIT_ATTABLE+UNIT_DISABLE+UNIT_ROABLE, 0) }, + { UDATA (&mt_svc, UNIT_ATTABLE+UNIT_DISABLE+UNIT_ROABLE, 0) }, + { UDATA (&mt_svc, UNIT_ATTABLE+UNIT_DISABLE+UNIT_ROABLE, 0) } + }; + +REG mt_reg[] = { + { ORDATAD (CMD, mt_cu, 12, "command") }, + { ORDATAD (FNC, mt_fn, 12, "function") }, + { ORDATAD (CA, mt_ca, 12, "memory address") }, + { ORDATAD (WC, mt_wc, 12, "word count") }, + { ORDATAD (DB, mt_db, 12, "data buffer") }, + { GRDATAD (STA, mt_sta, 8, 12, 12, "status buffer") }, + { ORDATAD (STA2, mt_sta, 6, "secondary status") }, + { FLDATAD (DONE, mt_done, 0, "device done flag") }, + { FLDATAD (INT, int_req, INT_V_MT, "interrupt pending flag") }, + { FLDATAD (STOP_IOE, mt_stopioe, 0, "stop on I/O error") }, + { DRDATAD (TIME, mt_time, 24, "record delay"), PV_LEFT }, + { URDATAD (UST, mt_unit[0].USTAT, 8, 16, 0, MT_NUMDR, 0, "unit status, units 0 to 7") }, + { URDATAD (POS, mt_unit[0].pos, 10, T_ADDR_W, 0, + MT_NUMDR, PV_LEFT | REG_RO, "position, units 0 to 7") }, + { FLDATA (DEVNUM, mt_dib.dev, 6), REG_HRO }, + { NULL } + }; + +MTAB mt_mod[] = { + { MTUF_WLK, 0, "write enabled", "WRITEENABLED", &mt_vlock }, + { MTUF_WLK, MTUF_WLK, "write locked", "LOCKED", &mt_vlock }, + { MTAB_XTD|MTAB_VUN, 0, "FORMAT", "FORMAT", + &sim_tape_set_fmt, &sim_tape_show_fmt, NULL }, + { MTAB_XTD|MTAB_VUN, 0, "CAPACITY", "CAPACITY", + &sim_tape_set_capac, &sim_tape_show_capac, NULL }, + { MTAB_XTD|MTAB_VDV, 0, "DEVNO", "DEVNO", + &set_dev, &show_dev, NULL }, + { 0 } + }; + +DEVICE mt_dev = { + "MT", mt_unit, mt_reg, mt_mod, + MT_NUMDR, 10, 31, 1, 8, 8, + NULL, NULL, &mt_reset, + NULL, &mt_attach, &mt_detach, + &mt_dib, DEV_DISABLE | DEV_TAPE + }; + +/* IOT routines */ + +int32 mt70 (int32 IR, int32 AC) +{ +int32 f; +UNIT *uptr; + +uptr = mt_dev.units + GET_UNIT (mt_cu); /* get unit */ +switch (IR & 07) { /* decode IR<9:11> */ + + case 1: /* LWCR */ + mt_wc = AC; /* load word count */ + return 0; + + case 2: /* CWCR */ + mt_wc = 0; /* clear word count */ + return AC; + + case 3: /* LCAR */ + mt_ca = AC; /* load mem address */ + return 0; + + case 4: /* CCAR */ + mt_ca = 0; /* clear mem address */ + return AC; + + case 5: /* LCMR */ + if (mt_busy ()) /* busy? illegal op */ + mt_sta = mt_sta | STA_ILL | STA_ERR; + mt_cu = AC; /* load command reg */ + mt_updcsta (mt_dev.units + GET_UNIT (mt_cu)); + return 0; + + case 6: /* LFGR */ + if (mt_busy ()) /* busy? illegal op */ + mt_sta = mt_sta | STA_ILL | STA_ERR; + mt_fn = AC; /* load function */ + if ((mt_fn & FN_GO) == 0) { /* go set? */ + mt_updcsta (uptr); /* update status */ + return 0; + } + f = GET_FNC (mt_fn); /* get function */ + if (((uptr->flags & UNIT_ATT) == 0) || + sim_is_active (uptr) || + (((f == FN_WRITE) || (f == FN_WREOF)) && sim_tape_wrp (uptr)) + || (((f == FN_SPACER) || (f == FN_REWIND)) && sim_tape_bot (uptr))) { + mt_sta = mt_sta | STA_ILL | STA_ERR; /* illegal op error */ + mt_set_done (); /* set done */ + mt_updcsta (uptr); /* update status */ + return 0; + } + uptr->USTAT = uptr->USTAT & STA_WLK; /* clear status */ + if (f == FN_UNLOAD) { /* unload? */ + detach_unit (uptr); /* set offline */ + uptr->USTAT = STA_REW | STA_REM; /* rewinding, off */ + mt_set_done (); /* set done */ + } + else if (f == FN_REWIND) { /* rewind */ + uptr->USTAT = uptr->USTAT | STA_REW; /* rewinding */ + mt_set_done (); /* set done */ + } + else mt_done = 0; /* clear done */ + mt_updcsta (uptr); /* update status */ + sim_activate (uptr, mt_time); /* start io */ + return 0; + + case 7: /* LDBR */ + if (mt_busy ()) /* busy? illegal op */ + mt_sta = mt_sta | STA_ILL | STA_ERR; + mt_db = AC; /* load buffer */ + mt_set_done (); /* set done */ + mt_updcsta (uptr); /* update status */ + return 0; + } /* end switch */ + +return (stop_inst << IOT_V_REASON) + AC; /* ill inst */ +} + +int32 mt71 (int32 IR, int32 AC) +{ +UNIT *uptr; + +uptr = mt_dev.units + GET_UNIT (mt_cu); +switch (IR & 07) { /* decode IR<9:11> */ + + case 1: /* RWCR */ + return mt_wc; /* read word count */ + + case 2: /* CLT */ + mt_reset (&mt_dev); /* reset everything */ + return AC; + + case 3: /* RCAR */ + return mt_ca; /* read mem address */ + + case 4: /* RMSR */ + return ((mt_updcsta (uptr) >> 12) & 07777); /* read status */ + + case 5: /* RCMR */ + return mt_cu; /* read command */ + + case 6: /* RFSR */ + return (((mt_fn & FN_RMASK) | (mt_updcsta (uptr) & ~FN_RMASK)) + & 07777); /* read function */ + + case 7: /* RDBR */ + return mt_db; /* read data buffer */ + } + +return (stop_inst << IOT_V_REASON) + AC; /* ill inst */ +} + +int32 mt72 (int32 IR, int32 AC) +{ +UNIT *uptr; + +uptr = mt_dev.units + GET_UNIT (mt_cu); /* get unit */ +switch (IR & 07) { /* decode IR<9:11> */ + + case 1: /* SKEF */ + return (mt_sta & STA_ERR)? IOT_SKP + AC: AC; + + case 2: /* SKCB */ + return (!mt_busy ())? IOT_SKP + AC: AC; + + case 3: /* SKJD */ + return mt_done? IOT_SKP + AC: AC; + + case 4: /* SKTR */ + return (!sim_is_active (uptr) && + (uptr->flags & UNIT_ATT))? IOT_SKP + AC: AC; + + case 5: /* CLF */ + if (!sim_is_active (uptr)) mt_reset (&mt_dev); /* if TUR, zap */ + else { /* just ctrl zap */ + mt_sta = 0; /* clear status */ + mt_done = 0; /* clear done */ + mt_updcsta (uptr); /* update status */ + } + return AC; + } /* end switch */ + +return (stop_inst << IOT_V_REASON) + AC; /* ill inst */ +} + +/* Unit service + + If rewind done, reposition to start of tape, set status + else, do operation, set done, interrupt +*/ + +t_stat mt_svc (UNIT *uptr) +{ +int32 f, i, p, u, wc, xma; +t_mtrlnt tbc, cbc; +t_bool passed_eot; +uint16 c, c1, c2; +t_stat st, r = SCPE_OK; + +u = (int32) (uptr - mt_dev.units); /* get unit number */ +f = GET_FNC (mt_fn); /* get command */ +xma = GET_EMA (mt_cu) + mt_ca; /* get mem addr */ +wc = WC_SIZE - mt_wc; /* get wc */ + +if (uptr->USTAT & STA_REW) { /* rewind? */ + sim_tape_rewind (uptr); /* update position */ + if (uptr->flags & UNIT_ATT) /* still on line? */ + uptr->USTAT = (uptr->USTAT & STA_WLK) | STA_BOT; + else uptr->USTAT = STA_REM; + if (u == GET_UNIT (mt_cu)) { /* selected? */ + mt_set_done (); /* set done */ + mt_updcsta (uptr); /* update status */ + } + return SCPE_OK; + } + +if ((uptr->flags & UNIT_ATT) == 0) { /* if not attached */ + uptr->USTAT = STA_REM; /* unit off line */ + mt_sta = mt_sta | STA_ILL | STA_ERR; /* illegal operation */ + mt_set_done (); /* set done */ + mt_updcsta (uptr); /* update status */ + return IORETURN (mt_stopioe, SCPE_UNATT); + } + +passed_eot = sim_tape_eot (uptr); /* passed eot? */ +switch (f) { /* case on function */ + + case FN_READ: /* read */ + case FN_CMPARE: /* read/compare */ + st = sim_tape_rdrecf (uptr, mtxb, &tbc, MT_MAXFR); /* read rec */ + if (st == MTSE_RECE) /* rec in err? */ + mt_sta = mt_sta | STA_PAR | STA_ERR; + else if (st != MTSE_OK) { /* other error? */ + r = mt_map_err (uptr, st); /* map error */ + mt_sta = mt_sta | STA_RLE | STA_ERR; /* err, eof/eom, tmk */ + break; + } + cbc = (mt_cu & CU_UNPAK)? wc: wc * 2; /* expected bc */ + if (tbc != cbc) /* wrong size? */ + mt_sta = mt_sta | STA_RLE | STA_ERR; + if (tbc < cbc) { /* record small? */ + cbc = tbc; /* use smaller */ + wc = (mt_cu & CU_UNPAK)? cbc: (cbc + 1) / 2; + } + for (i = p = 0; i < wc; i++) { /* copy buffer */ + xma = mt_ixma (xma); /* increment xma */ + mt_wc = (mt_wc + 1) & 07777; /* incr word cnt */ + if (mt_cu & CU_UNPAK) c = mtxb[p++]; + else { + c1 = mtxb[p++] & 077; + c2 = mtxb[p++] & 077; + c = (c1 << 6) | c2; + } + if ((f == FN_READ) && MEM_ADDR_OK (xma)) + M[xma] = c; + else if ((f == FN_CMPARE) && (M[xma] != c)) { + mt_sta = mt_sta | STA_CPE | STA_ERR; + break; + } + } + break; + + case FN_WRITE: /* write */ + tbc = (mt_cu & CU_UNPAK)? wc: wc * 2; + for (i = p = 0; i < wc; i++) { /* copy buf to tape */ + xma = mt_ixma (xma); /* incr mem addr */ + if (mt_cu & CU_UNPAK) + mtxb[p++] = M[xma] & 0377; + else { + mtxb[p++] = (M[xma] >> 6) & 077; + mtxb[p++] = M[xma] & 077; + } + } + if ((st = sim_tape_wrrecf (uptr, mtxb, tbc))) { /* write rec, err? */ + r = mt_map_err (uptr, st); /* map error */ + xma = GET_EMA (mt_cu) + mt_ca; /* restore xma */ + } + else mt_wc = 0; /* ok, clear wc */ + break; + + case FN_WREOF: + if ((st = sim_tape_wrtmk (uptr))) /* write tmk, err? */ + r = mt_map_err (uptr, st); /* map error */ + break; + + case FN_SPACEF: /* space forward */ + do { + mt_wc = (mt_wc + 1) & 07777; /* incr wc */ + if ((st = sim_tape_sprecf (uptr, &tbc))) { /* space rec fwd, err? */ + r = mt_map_err (uptr, st); /* map error */ + break; /* stop */ + } + } while ((mt_wc != 0) && (passed_eot || !sim_tape_eot (uptr))); + break; + + case FN_SPACER: /* space reverse */ + do { + mt_wc = (mt_wc + 1) & 07777; /* incr wc */ + if ((st = sim_tape_sprecr (uptr, &tbc))) { /* space rec rev, err? */ + r = mt_map_err (uptr, st); /* map error */ + break; /* stop */ + } + } while (mt_wc != 0); + break; + } /* end case */ + +if (!passed_eot && sim_tape_eot (uptr)) /* just passed EOT? */ + uptr->USTAT = uptr->USTAT | STA_EOT; +mt_cu = (mt_cu & ~CU_EMA) | ((xma >> (12 - CU_V_EMA)) & CU_EMA); +mt_ca = xma & 07777; /* update mem addr */ +mt_set_done (); /* set done */ +mt_updcsta (uptr); /* update status */ +return r; +} + +/* Update controller status */ + +int32 mt_updcsta (UNIT *uptr) +{ +mt_sta = (mt_sta & ~(STA_DYN | STA_CLR)) | (uptr->USTAT & STA_DYN); +if (((mt_sta & STA_ERR) && (mt_cu & CU_IEE)) || + (mt_done && (mt_cu & CU_IED))) + int_req = int_req | INT_MT; +else int_req = int_req & ~INT_MT; +return mt_sta; +} + +/* Test if controller busy */ + +UNIT *mt_busy (void) +{ +int32 u; +UNIT *uptr; + +for (u = 0; u < MT_NUMDR; u++) { /* loop thru units */ + uptr = mt_dev.units + u; + if (sim_is_active (uptr) && ((uptr->USTAT & STA_REW) == 0)) + return uptr; + } +return NULL; +} + +/* Increment extended memory address */ + +int32 mt_ixma (int32 xma) /* incr extended ma */ +{ +int32 v; + +v = ((xma + 1) & 07777) | (xma & 070000); /* wrapped incr */ +if (mt_fn & FN_INC) { /* increment mode? */ + if (xma == 077777) /* at limit? error */ + mt_sta = mt_sta | STA_INC | STA_ERR; + else v = xma + 1; /* else 15b incr */ + } +return v; +} + +/* Set done */ + +void mt_set_done (void) +{ +mt_done = 1; /* set done */ +mt_fn = mt_fn & ~(FN_CRC | FN_GO | FN_INC); /* clear func<4:6> */ +return; +} + +/* Map tape error status */ + +t_stat mt_map_err (UNIT *uptr, t_stat st) +{ +switch (st) { + + case MTSE_FMT: /* illegal fmt */ + case MTSE_UNATT: /* unattached */ + mt_sta = mt_sta | STA_ILL | STA_ERR; + case MTSE_OK: /* no error */ + return SCPE_IERR; /* never get here! */ + + case MTSE_TMK: /* end of file */ + uptr->USTAT = uptr->USTAT | STA_EOF; /* set EOF */ + mt_sta = mt_sta | STA_ERR; + break; + + case MTSE_IOERR: /* IO error */ + mt_sta = mt_sta | STA_PAR | STA_ERR; /* set par err */ + if (mt_stopioe) + return SCPE_IOERR; + break; + + case MTSE_INVRL: /* invalid rec lnt */ + mt_sta = mt_sta | STA_PAR | STA_ERR; /* set par err */ + return SCPE_MTRLNT; + + case MTSE_RECE: /* record in error */ + case MTSE_EOM: /* end of medium */ + mt_sta = mt_sta | STA_PAR | STA_ERR; /* set par err */ + break; + + case MTSE_BOT: /* reverse into BOT */ + uptr->USTAT = uptr->USTAT | STA_BOT; /* set status */ + mt_sta = mt_sta | STA_ERR; + break; + + case MTSE_WRP: /* write protect */ + mt_sta = mt_sta | STA_ILL | STA_ERR; /* illegal operation */ + break; + } + +return SCPE_OK; +} + +/* Reset routine */ + +t_stat mt_reset (DEVICE *dptr) +{ +int32 u; +UNIT *uptr; + +mt_cu = mt_fn = mt_wc = mt_ca = mt_db = mt_sta = mt_done = 0; +int_req = int_req & ~INT_MT; /* clear interrupt */ +for (u = 0; u < MT_NUMDR; u++) { /* loop thru units */ + uptr = mt_dev.units + u; + sim_cancel (uptr); /* cancel activity */ + sim_tape_reset (uptr); /* reset tape */ + if (uptr->flags & UNIT_ATT) uptr->USTAT = + (sim_tape_bot (uptr)? STA_BOT: 0) | + (sim_tape_wrp (uptr)? STA_WLK: 0); + else uptr->USTAT = STA_REM; + } +if (mtxb == NULL) + mtxb = (uint8 *) calloc (MT_MAXFR, sizeof (uint8)); +if (mtxb == NULL) + return SCPE_MEM; +return SCPE_OK; +} + +/* Attach routine */ + +t_stat mt_attach (UNIT *uptr, CONST char *cptr) +{ +t_stat r; +int32 u = uptr - mt_dev.units; /* get unit number */ + +r = sim_tape_attach (uptr, cptr); +if (r != SCPE_OK) + return r; +uptr->USTAT = STA_BOT | (sim_tape_wrp (uptr)? STA_WLK: 0); +if (u == GET_UNIT (mt_cu)) + mt_updcsta (uptr); +return r; +} + +/* Detach routine */ + +t_stat mt_detach (UNIT* uptr) +{ +int32 u = uptr - mt_dev.units; /* get unit number */ + +if (!(uptr->flags & UNIT_ATT)) /* check for attached */ + return SCPE_OK; +if (!sim_is_active (uptr)) + uptr->USTAT = STA_REM; +if (u == GET_UNIT (mt_cu)) + mt_updcsta (uptr); +return sim_tape_detach (uptr); +} + +/* Write lock/enable routine */ + +t_stat mt_vlock (UNIT *uptr, int32 val, CONST char *cptr, void *desc) +{ +int32 u = uptr - mt_dev.units; /* get unit number */ + +if ((uptr->flags & UNIT_ATT) && (val || sim_tape_wrp (uptr))) + uptr->USTAT = uptr->USTAT | STA_WLK; +else uptr->USTAT = uptr->USTAT & ~STA_WLK; +if (u == GET_UNIT (mt_cu)) + mt_updcsta (uptr); +return SCPE_OK; +} ADDED src/PDP8/pdp8_pt.c Index: src/PDP8/pdp8_pt.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_pt.c @@ -0,0 +1,291 @@ +/* pdp8_pt.c: PDP-8 paper tape reader/punch simulator + + Copyright (c) 1993-2013, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + ptr,ptp PC8E paper tape reader/punch + + 17-Mar-13 RMS Modified to use central set_bootpc routine + 25-Apr-03 RMS Revised for extended file support + 04-Oct-02 RMS Added DIBs + 30-May-02 RMS Widened POS to 32b + 30-Nov-01 RMS Added read only unit support + 30-Mar-98 RMS Added RIM loader as PTR bootstrap +*/ + +#include "pdp8_defs.h" + +extern int32 int_req, int_enable, dev_done, stop_inst; + +int32 ptr_stopioe = 0, ptp_stopioe = 0; /* stop on error */ + +int32 ptr (int32 IR, int32 AC); +int32 ptp (int32 IR, int32 AC); +t_stat ptr_svc (UNIT *uptr); +t_stat ptp_svc (UNIT *uptr); +t_stat ptr_reset (DEVICE *dptr); +t_stat ptp_reset (DEVICE *dptr); +t_stat ptr_boot (int32 unitno, DEVICE *dptr); + +/* PTR data structures + + ptr_dev PTR device descriptor + ptr_unit PTR unit descriptor + ptr_reg PTR register list +*/ + +DIB ptr_dib = { DEV_PTR, 1, { &ptr } }; + +UNIT ptr_unit = { + UDATA (&ptr_svc, UNIT_SEQ+UNIT_ATTABLE+UNIT_ROABLE, 0), + SERIAL_IN_WAIT + }; + +REG ptr_reg[] = { + { ORDATAD (BUF, ptr_unit.buf, 8, "last data item processed") }, + { FLDATAD (DONE, dev_done, INT_V_PTR, "device done flag") }, + { FLDATAD (ENABLE, int_enable, INT_V_PTR, "interrupt enable flag") }, + { FLDATAD (INT, int_req, INT_V_PTR, "interrupt pending flag") }, + { DRDATAD (POS, ptr_unit.pos, T_ADDR_W, "position in the input file"), PV_LEFT }, + { DRDATAD (TIME, ptr_unit.wait, 24, "time from I/O initiation to interrupt"), PV_LEFT }, + { FLDATAD (STOP_IOE, ptr_stopioe, 0, "stop on I/O error") }, + { NULL } + }; + +MTAB ptr_mod[] = { + { MTAB_XTD|MTAB_VDV, 0, "DEVNO", NULL, NULL, &show_dev }, + { 0 } + }; + +DEVICE ptr_dev = { + "PTR", &ptr_unit, ptr_reg, ptr_mod, + 1, 10, 31, 1, 8, 8, + NULL, NULL, &ptr_reset, + &ptr_boot, NULL, NULL, + &ptr_dib, 0 }; + +/* PTP data structures + + ptp_dev PTP device descriptor + ptp_unit PTP unit descriptor + ptp_reg PTP register list +*/ + +DIB ptp_dib = { DEV_PTP, 1, { &ptp } }; + +UNIT ptp_unit = { + UDATA (&ptp_svc, UNIT_SEQ+UNIT_ATTABLE, 0), SERIAL_OUT_WAIT + }; + +REG ptp_reg[] = { + { ORDATAD (BUF, ptp_unit.buf, 8, "last data item processed") }, + { FLDATAD (DONE, dev_done, INT_V_PTP, "device done flag") }, + { FLDATAD (ENABLE, int_enable, INT_V_PTP, "interrupt enable flag") }, + { FLDATAD (INT, int_req, INT_V_PTP, "interrupt pending flag") }, + { DRDATAD (POS, ptp_unit.pos, T_ADDR_W, "position in the output file"), PV_LEFT }, + { DRDATAD (TIME, ptp_unit.wait, 24, "time from I/O initiation to interrupt"), PV_LEFT }, + { FLDATAD (STOP_IOE, ptp_stopioe, 0, "stop on I/O error") }, + { NULL } + }; + +MTAB ptp_mod[] = { + { MTAB_XTD|MTAB_VDV, 0, "DEVNO", NULL, NULL, &show_dev }, + { 0 } + }; + +DEVICE ptp_dev = { + "PTP", &ptp_unit, ptp_reg, ptp_mod, + 1, 10, 31, 1, 8, 8, + NULL, NULL, &ptp_reset, + NULL, NULL, NULL, + &ptp_dib, 0 + }; + +/* Paper tape reader: IOT routine */ + +int32 ptr (int32 IR, int32 AC) +{ +switch (IR & 07) { /* decode IR<9:11> */ + + case 0: /* RPE */ + int_enable = int_enable | (INT_PTR+INT_PTP); /* set enable */ + int_req = INT_UPDATE; /* update interrupts */ + return AC; + + case 1: /* RSF */ + return (dev_done & INT_PTR)? IOT_SKP + AC: AC; + + case 6: /* RFC!RRB */ + sim_activate (&ptr_unit, ptr_unit.wait); + case 2: /* RRB */ + dev_done = dev_done & ~INT_PTR; /* clear flag */ + int_req = int_req & ~INT_PTR; /* clear int req */ + return (AC | ptr_unit.buf); /* or data to AC */ + + case 4: /* RFC */ + sim_activate (&ptr_unit, ptr_unit.wait); + dev_done = dev_done & ~INT_PTR; /* clear flag */ + int_req = int_req & ~INT_PTR; /* clear int req */ + return AC; + + default: + return (stop_inst << IOT_V_REASON) + AC; + } /* end switch */ +} + +/* Unit service */ + +t_stat ptr_svc (UNIT *uptr) +{ +int32 temp; + +if ((ptr_unit.flags & UNIT_ATT) == 0) /* attached? */ + return IORETURN (ptr_stopioe, SCPE_UNATT); +if ((temp = getc (ptr_unit.fileref)) == EOF) { + if (feof (ptr_unit.fileref)) { + if (ptr_stopioe) + sim_printf ("PTR end of file\n"); + else return SCPE_OK; + } + else sim_perror ("PTR I/O error"); + clearerr (ptr_unit.fileref); + return SCPE_IOERR; + } +dev_done = dev_done | INT_PTR; /* set done */ +int_req = INT_UPDATE; /* update interrupts */ +ptr_unit.buf = temp & 0377; +ptr_unit.pos = ptr_unit.pos + 1; +return SCPE_OK; +} + +/* Reset routine */ + +t_stat ptr_reset (DEVICE *dptr) +{ +ptr_unit.buf = 0; +dev_done = dev_done & ~INT_PTR; /* clear done, int */ +int_req = int_req & ~INT_PTR; +int_enable = int_enable | INT_PTR; /* set enable */ +sim_cancel (&ptr_unit); /* deactivate unit */ +return SCPE_OK; +} + +/* Paper tape punch: IOT routine */ + +int32 ptp (int32 IR, int32 AC) +{ +switch (IR & 07) { /* decode IR<9:11> */ + + case 0: /* PCE */ + int_enable = int_enable & ~(INT_PTR+INT_PTP); /* clear enables */ + int_req = INT_UPDATE; /* update interrupts */ + return AC; + + case 1: /* PSF */ + return (dev_done & INT_PTP)? IOT_SKP + AC: AC; + + case 2: /* PCF */ + dev_done = dev_done & ~INT_PTP; /* clear flag */ + int_req = int_req & ~INT_PTP; /* clear int req */ + return AC; + + case 6: /* PLS */ + dev_done = dev_done & ~INT_PTP; /* clear flag */ + int_req = int_req & ~INT_PTP; /* clear int req */ + case 4: /* PPC */ + ptp_unit.buf = AC & 0377; /* load punch buf */ + sim_activate (&ptp_unit, ptp_unit.wait); /* activate unit */ + return AC; + + default: + return (stop_inst << IOT_V_REASON) + AC; + } /* end switch */ +} + +/* Unit service */ + +t_stat ptp_svc (UNIT *uptr) +{ +dev_done = dev_done | INT_PTP; /* set done */ +int_req = INT_UPDATE; /* update interrupts */ +if ((ptp_unit.flags & UNIT_ATT) == 0) /* attached? */ + return IORETURN (ptp_stopioe, SCPE_UNATT); +if (putc (ptp_unit.buf, ptp_unit.fileref) == EOF) { + sim_perror ("PTP I/O error"); + clearerr (ptp_unit.fileref); + return SCPE_IOERR; + } +ptp_unit.pos = ptp_unit.pos + 1; +return SCPE_OK; +} + +/* Reset routine */ + +t_stat ptp_reset (DEVICE *dptr) +{ +ptp_unit.buf = 0; +dev_done = dev_done & ~INT_PTP; /* clear done, int */ +int_req = int_req & ~INT_PTP; +int_enable = int_enable | INT_PTP; /* set enable */ +sim_cancel (&ptp_unit); /* deactivate unit */ +return SCPE_OK; +} + +/* Bootstrap routine */ + +#define BOOT_START 07756 +#define BOOT_LEN (sizeof (boot_rom) / sizeof (int16)) + +static const uint16 boot_rom[] = { + 06014, /* 7756, RFC */ + 06011, /* 7757, LOOP, RSF */ + 05357, /* JMP .-1 */ + 06016, /* RFC RRB */ + 07106, /* CLL RTL*/ + 07006, /* RTL */ + 07510, /* SPA*/ + 05374, /* JMP 7774 */ + 07006, /* RTL */ + 06011, /* RSF */ + 05367, /* JMP .-1 */ + 06016, /* RFC RRB */ + 07420, /* SNL */ + 03776, /* DCA I 7776 */ + 03376, /* 7774, DCA 7776 */ + 05357, /* JMP 7757 */ + 00000, /* 7776, 0 */ + 05301 /* 7777, JMP 7701 */ + }; + +t_stat ptr_boot (int32 unitno, DEVICE *dptr) +{ +size_t i; +extern uint16 M[]; + +if (ptr_dib.dev != DEV_PTR) /* only std devno */ + return STOP_NOTSTD; +for (i = 0; i < BOOT_LEN; i++) + M[BOOT_START + i] = boot_rom[i]; +cpu_set_bootpc (BOOT_START); +return SCPE_OK; +} ADDED src/PDP8/pdp8_rf.c Index: src/PDP8/pdp8_rf.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_rf.c @@ -0,0 +1,448 @@ +/* pdp8_rf.c: RF08 fixed head disk simulator + + Copyright (c) 1993-2013, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + rf RF08 fixed head disk + + 17-Sep-13 RMS Changed to use central set_bootpc routine + 03-Sep-13 RMS Added explicit void * cast + 15-May-06 RMS Fixed bug in autosize attach (Dave Gesswein) + 07-Jan-06 RMS Fixed unaligned register access bug (Doug Carman) + 04-Jan-04 RMS Changed sim_fsize calling sequence + 26-Oct-03 RMS Cleaned up buffer copy code + 26-Jul-03 RMS Fixed bug in set size routine + 14-Mar-03 RMS Fixed variable platter interaction with save/restore + 03-Mar-03 RMS Fixed autosizing + 02-Feb-03 RMS Added variable platter and autosizing support + 04-Oct-02 RMS Added DIB, device number support + 28-Nov-01 RMS Added RL8A support + 25-Apr-01 RMS Added device enable/disable support + 19-Mar-01 RMS Added disk monitor bootstrap, fixed IOT decoding + 15-Feb-01 RMS Fixed 3 cycle data break sequence + 14-Apr-99 RMS Changed t_addr to unsigned + 30-Mar-98 RMS Fixed bug in RF bootstrap + + The RF08 is a head-per-track disk. It uses the three cycle data break + facility. To minimize overhead, the entire RF08 is buffered in memory. + + Two timing parameters are provided: + + rf_time Interword timing, must be non-zero + rf_burst Burst mode, if 0, DMA occurs cycle by cycle; otherwise, + DMA occurs in a burst +*/ + +#include "pdp8_defs.h" +#include + +#define UNIT_V_AUTO (UNIT_V_UF + 0) /* autosize */ +#define UNIT_V_PLAT (UNIT_V_UF + 1) /* #platters - 1 */ +#define UNIT_M_PLAT 03 +#define UNIT_GETP(x) ((((x) >> UNIT_V_PLAT) & UNIT_M_PLAT) + 1) +#define UNIT_AUTO (1 << UNIT_V_AUTO) +#define UNIT_PLAT (UNIT_M_PLAT << UNIT_V_PLAT) + +/* Constants */ + +#define RF_NUMWD 2048 /* words/track */ +#define RF_NUMTR 128 /* tracks/disk */ +#define RF_DKSIZE (RF_NUMTR * RF_NUMWD) /* words/disk */ +#define RF_NUMDK 4 /* disks/controller */ +#define RF_WC 07750 /* word count */ +#define RF_MA 07751 /* mem address */ +#define RF_WMASK (RF_NUMWD - 1) /* word mask */ + +/* Parameters in the unit descriptor */ + +#define FUNC u4 /* function */ +#define RF_READ 2 /* read */ +#define RF_WRITE 4 /* write */ + +/* Status register */ + +#define RFS_PCA 04000 /* photocell status */ +#define RFS_DRE 02000 /* data req enable */ +#define RFS_WLS 01000 /* write lock status */ +#define RFS_EIE 00400 /* error int enable */ +#define RFS_PIE 00200 /* photocell int enb */ +#define RFS_CIE 00100 /* done int enable */ +#define RFS_MEX 00070 /* memory extension */ +#define RFS_DRL 00004 /* data late error */ +#define RFS_NXD 00002 /* non-existent disk */ +#define RFS_PER 00001 /* parity error */ +#define RFS_ERR (RFS_WLS + RFS_DRL + RFS_NXD + RFS_PER) +#define RFS_V_MEX 3 + +#define GET_MEX(x) (((x) & RFS_MEX) << (12 - RFS_V_MEX)) +#define GET_POS(x) ((int) fmod (sim_gtime() / ((double) (x)), \ + ((double) RF_NUMWD))) +#define UPDATE_PCELL if (GET_POS(rf_time) < 6) rf_sta = rf_sta | RFS_PCA; \ + else rf_sta = rf_sta & ~RFS_PCA +#define RF_INT_UPDATE if ((rf_done && (rf_sta & RFS_CIE)) || \ + ((rf_sta & RFS_ERR) && (rf_sta & RFS_EIE)) || \ + ((rf_sta & RFS_PCA) && (rf_sta & RFS_PIE))) \ + int_req = int_req | INT_RF; \ + else int_req = int_req & ~INT_RF + +extern uint16 M[]; +extern int32 int_req, stop_inst; +extern UNIT cpu_unit; + +int32 rf_sta = 0; /* status register */ +int32 rf_da = 0; /* disk address */ +int32 rf_done = 0; /* done flag */ +int32 rf_wlk = 0; /* write lock */ +int32 rf_time = 10; /* inter-word time */ +int32 rf_burst = 1; /* burst mode flag */ +int32 rf_stopioe = 1; /* stop on error */ + +int32 rf60 (int32 IR, int32 AC); +int32 rf61 (int32 IR, int32 AC); +int32 rf62 (int32 IR, int32 AC); +int32 rf64 (int32 IR, int32 AC); +t_stat rf_svc (UNIT *uptr); +t_stat pcell_svc (UNIT *uptr); +t_stat rf_reset (DEVICE *dptr); +t_stat rf_boot (int32 unitno, DEVICE *dptr); +t_stat rf_attach (UNIT *uptr, CONST char *cptr); +t_stat rf_set_size (UNIT *uptr, int32 val, CONST char *cptr, void *desc); + +/* RF08 data structures + + rf_dev RF device descriptor + rf_unit RF unit descriptor + pcell_unit photocell timing unit (orphan) + rf_reg RF register list +*/ + +DIB rf_dib = { DEV_RF, 5, { &rf60, &rf61, &rf62, NULL, &rf64 } }; + +UNIT rf_unit = { + UDATA (&rf_svc, UNIT_FIX+UNIT_ATTABLE+ + UNIT_BUFABLE+UNIT_MUSTBUF, RF_DKSIZE) + }; + +UNIT pcell_unit = { UDATA (&pcell_svc, 0, 0) }; + +REG rf_reg[] = { + { ORDATAD (STA, rf_sta, 12, "status") }, + { ORDATAD (DA, rf_da, 20, "low order disk address") }, + { ORDATAD (WC, M[RF_WC], 12, "word count (in memory)"), REG_FIT }, + { ORDATAD (MA, M[RF_MA], 12, "memory address (in memory)"), REG_FIT }, + { FLDATAD (DONE, rf_done, 0, "device done flag") }, + { FLDATAD (INT, int_req, INT_V_RF, "interrupt pending flag") }, + { ORDATAD (WLK, rf_wlk, 32, "write lock switches") }, + { DRDATAD (TIME, rf_time, 24, "rotational delay, per word"), REG_NZ + PV_LEFT }, + { FLDATAD (BURST, rf_burst, 0, "burst flag") }, + { FLDATAD (STOP_IOE, rf_stopioe, 0, "stop on I/O error") }, + { DRDATA (CAPAC, rf_unit.capac, 21), REG_HRO }, + { ORDATA (DEVNUM, rf_dib.dev, 6), REG_HRO }, + { NULL } + }; + +MTAB rf_mod[] = { + { UNIT_PLAT, (0 << UNIT_V_PLAT), NULL, "1P", &rf_set_size }, + { UNIT_PLAT, (1 << UNIT_V_PLAT), NULL, "2P", &rf_set_size }, + { UNIT_PLAT, (2 << UNIT_V_PLAT), NULL, "3P", &rf_set_size }, + { UNIT_PLAT, (3 << UNIT_V_PLAT), NULL, "4P", &rf_set_size }, + { UNIT_AUTO, UNIT_AUTO, "autosize", "AUTOSIZE", NULL }, + { MTAB_XTD|MTAB_VDV, 0, "DEVNO", "DEVNO", + &set_dev, &show_dev, NULL }, + { 0 } + }; + +DEVICE rf_dev = { + "RF", &rf_unit, rf_reg, rf_mod, + 1, 8, 20, 1, 8, 12, + NULL, NULL, &rf_reset, + &rf_boot, &rf_attach, NULL, + &rf_dib, DEV_DISABLE | DEV_DIS + }; + +/* IOT routines */ + +int32 rf60 (int32 IR, int32 AC) +{ +int32 t; +int32 pulse = IR & 07; + +UPDATE_PCELL; /* update photocell */ +if (pulse & 1) { /* DCMA */ + rf_da = rf_da & ~07777; /* clear DAR<8:19> */ + rf_done = 0; /* clear done */ + rf_sta = rf_sta & ~RFS_ERR; /* clear errors */ + RF_INT_UPDATE; /* update int req */ + } +if (pulse & 6) { /* DMAR, DMAW */ + rf_da = rf_da | AC; /* DAR<8:19> |= AC */ + rf_unit.FUNC = pulse & ~1; /* save function */ + t = (rf_da & RF_WMASK) - GET_POS (rf_time); /* delta to new loc */ + if (t < 0) /* wrap around? */ + t = t + RF_NUMWD; + sim_activate (&rf_unit, t * rf_time); /* schedule op */ + AC = 0; /* clear AC */ + } +return AC; +} + +int32 rf61 (int32 IR, int32 AC) +{ +int32 pulse = IR & 07; + +UPDATE_PCELL; /* update photocell */ +switch (pulse) { /* decode IR<9:11> */ + + case 1: /* DCIM */ + rf_sta = rf_sta & 07007; /* clear STA<3:8> */ + int_req = int_req & ~INT_RF; /* clear int req */ + sim_cancel (&pcell_unit); /* cancel photocell */ + return AC; + + case 2: /* DSAC */ + return ((rf_da & RF_WMASK) == GET_POS (rf_time))? IOT_SKP: 0; + + case 5: /* DIML */ + rf_sta = (rf_sta & 07007) | (AC & 0770); /* STA<3:8> <- AC */ + if (rf_sta & RFS_PIE) /* photocell int? */ + sim_activate (&pcell_unit, (RF_NUMWD - GET_POS (rf_time)) * + rf_time); + else sim_cancel (&pcell_unit); + RF_INT_UPDATE; /* update int req */ + return 0; /* clear AC */ + + case 6: /* DIMA */ + return rf_sta; /* AC <- STA<0:11> */ + } + +return AC; +} + +int32 rf62 (int32 IR, int32 AC) +{ +int32 pulse = IR & 07; + +UPDATE_PCELL; /* update photocell */ +if (pulse & 1) { /* DFSE */ + if (rf_sta & RFS_ERR) + AC = AC | IOT_SKP; + } +if (pulse & 2) { /* DFSC */ + if (pulse & 4) /* for DMAC */ + AC = AC & ~07777; + else if (rf_done) + AC = AC | IOT_SKP; + } +if (pulse & 4) /* DMAC */ + AC = AC | (rf_da & 07777); +return AC; +} + +int32 rf64 (int32 IR, int32 AC) +{ +int32 pulse = IR & 07; + +UPDATE_PCELL; /* update photocell */ +switch (pulse) { /* decode IR<9:11> */ + + case 1: /* DCXA */ + rf_da = rf_da & 07777; /* clear DAR<0:7> */ + break; + + case 3: /* DXAL */ + rf_da = rf_da & 07777; /* clear DAR<0:7> */ + case 2: /* DXAL w/o clear */ + rf_da = rf_da | ((AC & 0377) << 12); /* DAR<0:7> |= AC */ + AC = 0; /* clear AC */ + break; + + case 5: /* DXAC */ + AC = 0; /* clear AC */ + case 4: /* DXAC w/o clear */ + AC = AC | ((rf_da >> 12) & 0377); /* AC |= DAR<0:7> */ + break; + + default: + AC = (stop_inst << IOT_V_REASON) + AC; + break; + } /* end switch */ + +if ((uint32) rf_da >= rf_unit.capac) + rf_sta = rf_sta | RFS_NXD; +else rf_sta = rf_sta & ~RFS_NXD; +RF_INT_UPDATE; +return AC; +} + +/* Unit service + + Note that for reads and writes, memory addresses wrap around in the + current field. This code assumes the entire disk is buffered. +*/ + +t_stat rf_svc (UNIT *uptr) +{ +int32 pa, t, mex; +int16 *fbuf = (int16 *) uptr->filebuf; + +UPDATE_PCELL; /* update photocell */ +if ((uptr->flags & UNIT_BUF) == 0) { /* not buf? abort */ + rf_sta = rf_sta | RFS_NXD; + rf_done = 1; + RF_INT_UPDATE; /* update int req */ + return IORETURN (rf_stopioe, SCPE_UNATT); + } + +mex = GET_MEX (rf_sta); +do { + if ((uint32) rf_da >= rf_unit.capac) { /* disk overflow? */ + rf_sta = rf_sta | RFS_NXD; + break; + } + M[RF_WC] = (M[RF_WC] + 1) & 07777; /* incr word count */ + M[RF_MA] = (M[RF_MA] + 1) & 07777; /* incr mem addr */ + pa = mex | M[RF_MA]; /* add extension */ + if (uptr->FUNC == RF_READ) { /* read? */ + if (MEM_ADDR_OK (pa)) /* if !nxm */ + M[pa] = fbuf[rf_da]; /* read word */ + } + else { /* write */ + t = ((rf_da >> 15) & 030) | ((rf_da >> 14) & 07); + if ((rf_wlk >> t) & 1) /* write locked? */ + rf_sta = rf_sta | RFS_WLS; + else { /* not locked */ + fbuf[rf_da] = M[pa]; /* write word */ + if (((uint32) rf_da) >= uptr->hwmark) + uptr->hwmark = rf_da + 1; + } + } + rf_da = (rf_da + 1) & 03777777; /* incr disk addr */ + } while ((M[RF_WC] != 0) && (rf_burst != 0)); /* brk if wc, no brst */ + +if ((M[RF_WC] != 0) && ((rf_sta & RFS_ERR) == 0)) /* more to do? */ + sim_activate (&rf_unit, rf_time); /* sched next */ +else { + rf_done = 1; /* done */ + RF_INT_UPDATE; /* update int req */ + } +return SCPE_OK; +} + +/* Photocell unit service */ + +t_stat pcell_svc (UNIT *uptr) +{ +rf_sta = rf_sta | RFS_PCA; /* set photocell */ +if (rf_sta & RFS_PIE) { /* int enable? */ + sim_activate (&pcell_unit, RF_NUMWD * rf_time); + int_req = int_req | INT_RF; + } +return SCPE_OK; +} + +/* Reset routine */ + +t_stat rf_reset (DEVICE *dptr) +{ +rf_sta = rf_da = 0; +rf_done = 1; +int_req = int_req & ~INT_RF; /* clear interrupt */ +sim_cancel (&rf_unit); +sim_cancel (&pcell_unit); +return SCPE_OK; +} + +/* Bootstrap routine */ + +#define OS8_START 07750 +#define OS8_LEN (sizeof (os8_rom) / sizeof (int16)) +#define DM4_START 00200 +#define DM4_LEN (sizeof (dm4_rom) / sizeof (int16)) + +static const uint16 os8_rom[] = { + 07600, /* 7750, CLA CLL ; also word count */ + 06603, /* 7751, DMAR ; also address */ + 06622, /* 7752, DFSC ; done? */ + 05352, /* 7753, JMP .-1 ; no */ + 05752 /* 7754, JMP @.-2 ; enter boot */ + }; + +static const uint16 dm4_rom[] = { + 00200, 07600, /* 0200, CLA CLL */ + 00201, 06603, /* 0201, DMAR ; read */ + 00202, 06622, /* 0202, DFSC ; done? */ + 00203, 05202, /* 0203, JMP .-1 ; no */ + 00204, 05600, /* 0204, JMP @.-4 ; enter boot */ + 07750, 07576, /* 7750, 7576 ; word count */ + 07751, 07576 /* 7751, 7576 ; address */ + }; + +t_stat rf_boot (int32 unitno, DEVICE *dptr) +{ +size_t i; + +if (rf_dib.dev != DEV_RF) /* only std devno */ + return STOP_NOTSTD; +if (sim_switches & SWMASK ('D')) { + for (i = 0; i < DM4_LEN; i = i + 2) + M[dm4_rom[i]] = dm4_rom[i + 1]; + cpu_set_bootpc (DM4_START); + } +else { + for (i = 0; i < OS8_LEN; i++) + M[OS8_START + i] = os8_rom[i]; + cpu_set_bootpc (OS8_START); + } +return SCPE_OK; +} + +/* Attach routine */ + +t_stat rf_attach (UNIT *uptr, CONST char *cptr) +{ +uint32 sz, p; +uint32 ds_bytes = RF_DKSIZE * sizeof (int16); + +if ((uptr->flags & UNIT_AUTO) && (sz = sim_fsize_name (cptr))) { + p = (sz + ds_bytes - 1) / ds_bytes; + if (p >= RF_NUMDK) + p = RF_NUMDK - 1; + uptr->flags = (uptr->flags & ~UNIT_PLAT) | + (p << UNIT_V_PLAT); + } +uptr->capac = UNIT_GETP (uptr->flags) * RF_DKSIZE; +return attach_unit (uptr, cptr); +} + +/* Change disk size */ + +t_stat rf_set_size (UNIT *uptr, int32 val, CONST char *cptr, void *desc) +{ +if (val < 0) + return SCPE_IERR; +if (uptr->flags & UNIT_ATT) + return SCPE_ALATT; +uptr->capac = UNIT_GETP (val) * RF_DKSIZE; +uptr->flags = uptr->flags & ~UNIT_AUTO; +return SCPE_OK; +} ADDED src/PDP8/pdp8_rk.c Index: src/PDP8/pdp8_rk.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_rk.c @@ -0,0 +1,463 @@ +/* pdp8_rk.c: RK8E cartridge disk simulator + + Copyright (c) 1993-2013, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + rk RK8E/RK05 cartridge disk + + 17-Sep-13 RMS Changed to use central set_bootpc routine + 18-Mar-13 RMS Raised RK_MIN so that RKLFMT will work (Mark Pizzolato) + 25-Apr-03 RMS Revised for extended file support + 04-Oct-02 RMS Added DIB, device number support + 06-Jan-02 RMS Changed enable/disable support + 30-Nov-01 RMS Added read only unit, extended SET/SHOW support + 24-Nov-01 RMS Converted FLG to array, made register names consistent + 25-Apr-01 RMS Added device enable/disable support + 29-Jun-96 RMS Added unit enable/disable support +*/ + +#include "pdp8_defs.h" + +/* Constants */ + +#define RK_NUMSC 16 /* sectors/surface */ +#define RK_NUMSF 2 /* surfaces/cylinder */ +#define RK_NUMCY 203 /* cylinders/drive */ +#define RK_NUMWD 256 /* words/sector */ +#define RK_SIZE (RK_NUMCY * RK_NUMSF * RK_NUMSC * RK_NUMWD) + /* words/drive */ +#define RK_NUMDR 4 /* drives/controller */ +#define RK_M_NUMDR 03 + +/* Flags in the unit flags word */ + +#define UNIT_V_HWLK (UNIT_V_UF + 0) /* hwre write lock */ +#define UNIT_V_SWLK (UNIT_V_UF + 1) /* swre write lock */ +#define UNIT_HWLK (1 << UNIT_V_HWLK) +#define UNIT_SWLK (1 << UNIT_V_SWLK) +#define UNIT_WPRT (UNIT_HWLK|UNIT_SWLK|UNIT_RO) /* write protect */ + +/* Parameters in the unit descriptor */ + +#define CYL u3 /* current cylinder */ +#define FUNC u4 /* function */ + +/* Status register */ + +#define RKS_DONE 04000 /* transfer done */ +#define RKS_HMOV 02000 /* heads moving */ +#define RKS_SKFL 00400 /* drive seek fail */ +#define RKS_NRDY 00200 /* drive not ready */ +#define RKS_BUSY 00100 /* control busy error */ +#define RKS_TMO 00040 /* timeout error */ +#define RKS_WLK 00020 /* write lock error */ +#define RKS_CRC 00010 /* CRC error */ +#define RKS_DLT 00004 /* data late error */ +#define RKS_STAT 00002 /* drive status error */ +#define RKS_CYL 00001 /* cyl address error */ +#define RKS_ERR (RKS_BUSY+RKS_TMO+RKS_WLK+RKS_CRC+RKS_DLT+RKS_STAT+RKS_CYL) + +/* Command register */ + +#define RKC_M_FUNC 07 /* function */ +#define RKC_READ 0 +#define RKC_RALL 1 +#define RKC_WLK 2 +#define RKC_SEEK 3 +#define RKC_WRITE 4 +#define RKC_WALL 5 +#define RKC_V_FUNC 9 +#define RKC_IE 00400 /* interrupt enable */ +#define RKC_SKDN 00200 /* set done on seek done */ +#define RKC_HALF 00100 /* 128W sector */ +#define RKC_MEX 00070 /* memory extension */ +#define RKC_V_MEX 3 +#define RKC_M_DRV 03 /* drive select */ +#define RKC_V_DRV 1 +#define RKC_CYHI 00001 /* high cylinder addr */ + +#define GET_FUNC(x) (((x) >> RKC_V_FUNC) & RKC_M_FUNC) +#define GET_DRIVE(x) (((x) >> RKC_V_DRV) & RKC_M_DRV) +#define GET_MEX(x) (((x) & RKC_MEX) << (12 - RKC_V_MEX)) + +/* Disk address */ + +#define RKD_V_SECT 0 /* sector */ +#define RKD_M_SECT 017 +#define RKD_V_SUR 4 /* surface */ +#define RKD_M_SUR 01 +#define RKD_V_CYL 5 /* cylinder */ +#define RKD_M_CYL 0177 +#define GET_CYL(x,y) ((((x) & RKC_CYHI) << (12-RKD_V_CYL)) | \ + (((y) >> RKD_V_CYL) & RKD_M_CYL)) +#define GET_DA(x,y) ((((x) & RKC_CYHI) << 12) | y) + +/* Reset commands */ + +#define RKX_CLS 0 /* clear status */ +#define RKX_CLC 1 /* clear control */ +#define RKX_CLD 2 /* clear drive */ +#define RKX_CLSA 3 /* clear status alt */ + +#define RK_INT_UPDATE if (((rk_sta & (RKS_DONE + RKS_ERR)) != 0) && \ + ((rk_cmd & RKC_IE) != 0)) \ + int_req = int_req | INT_RK; \ + else int_req = int_req & ~INT_RK +#define RK_MIN 50 +#define MAX(x,y) (((x) > (y))? (x): (y)) + +extern uint16 M[]; +extern int32 int_req, stop_inst; +extern UNIT cpu_unit; + +int32 rk_busy = 0; /* controller busy */ +int32 rk_sta = 0; /* status register */ +int32 rk_cmd = 0; /* command register */ +int32 rk_da = 0; /* disk address */ +int32 rk_ma = 0; /* memory address */ +int32 rk_swait = 10, rk_rwait = 10; /* seek, rotate wait */ +int32 rk_stopioe = 1; /* stop on error */ + +int32 rk (int32 IR, int32 AC); +t_stat rk_svc (UNIT *uptr); +t_stat rk_reset (DEVICE *dptr); +t_stat rk_boot (int32 unitno, DEVICE *dptr); +void rk_go (int32 function, int32 cylinder); + +/* RK-8E data structures + + rk_dev RK device descriptor + rk_unit RK unit list + rk_reg RK register list + rk_mod RK modifiers list +*/ + +DIB rk_dib = { DEV_RK, 1, { &rk } }; + +UNIT rk_unit[] = { + { UDATA (&rk_svc, UNIT_FIX+UNIT_ATTABLE+UNIT_DISABLE+ + UNIT_ROABLE, RK_SIZE) }, + { UDATA (&rk_svc, UNIT_FIX+UNIT_ATTABLE+UNIT_DISABLE+ + UNIT_ROABLE, RK_SIZE) }, + { UDATA (&rk_svc, UNIT_FIX+UNIT_ATTABLE+UNIT_DISABLE+ + UNIT_ROABLE, RK_SIZE) }, + { UDATA (&rk_svc, UNIT_FIX+UNIT_ATTABLE+UNIT_DISABLE+ + UNIT_ROABLE, RK_SIZE) } + }; + +REG rk_reg[] = { + { ORDATAD (RKSTA, rk_sta, 12, "status") }, + { ORDATAD (RKCMD, rk_cmd, 12, "disk command") }, + { ORDATAD (RKDA, rk_da, 12, "disk address") }, + { ORDATAD (RKMA, rk_ma, 12, "current memory address") }, + { FLDATAD (BUSY, rk_busy, 0, "control busy flag") }, + { FLDATAD (INT, int_req, INT_V_RK, "interrupt pending flag") }, + { DRDATAD (STIME, rk_swait, 24, "seek time, per cylinder"), PV_LEFT }, + { DRDATAD (RTIME, rk_rwait, 24, "rotational delay"), PV_LEFT }, + { FLDATAD (STOP_IOE, rk_stopioe, 0, "stop on I/O error") }, + { ORDATA (DEVNUM, rk_dib.dev, 6), REG_HRO }, + { NULL } + }; + +MTAB rk_mod[] = { + { UNIT_HWLK, 0, "write enabled", "WRITEENABLED", NULL }, + { UNIT_HWLK, UNIT_HWLK, "write locked", "LOCKED", NULL }, + { MTAB_XTD|MTAB_VDV, 0, "DEVNO", "DEVNO", + &set_dev, &show_dev, NULL }, + { 0 } + }; + +DEVICE rk_dev = { + "RK", rk_unit, rk_reg, rk_mod, + RK_NUMDR, 8, 24, 1, 8, 12, + NULL, NULL, &rk_reset, + &rk_boot, NULL, NULL, + &rk_dib, DEV_DISABLE + }; + +/* IOT routine */ + +int32 rk (int32 IR, int32 AC) +{ +int32 i; +UNIT *uptr; + +switch (IR & 07) { /* decode IR<9:11> */ + + case 0: /* unused */ + return (stop_inst << IOT_V_REASON) + AC; + + case 1: /* DSKP */ + return (rk_sta & (RKS_DONE + RKS_ERR))? /* skip on done, err */ + IOT_SKP + AC: AC; + + case 2: /* DCLR */ + rk_sta = 0; /* clear status */ + switch (AC & 03) { /* decode AC<10:11> */ + + case RKX_CLS: /* clear status */ + if (rk_busy != 0) rk_sta = rk_sta | RKS_BUSY; + case RKX_CLSA: /* clear status alt */ + break; + + case RKX_CLC: /* clear control */ + rk_cmd = rk_busy = 0; /* clear registers */ + rk_ma = rk_da = 0; + for (i = 0; i < RK_NUMDR; i++) + sim_cancel (&rk_unit[i]); + break; + + case RKX_CLD: /* reset drive */ + if (rk_busy != 0) + rk_sta = rk_sta | RKS_BUSY; + else rk_go (RKC_SEEK, 0); /* seek to 0 */ + break; + } /* end switch AC */ + break; + + case 3: /* DLAG */ + if (rk_busy != 0) + rk_sta = rk_sta | RKS_BUSY; + else { + rk_da = AC; /* load disk addr */ + rk_go (GET_FUNC (rk_cmd), GET_CYL (rk_cmd, rk_da)); + } + break; + + case 4: /* DLCA */ + if (rk_busy != 0) + rk_sta = rk_sta | RKS_BUSY; + else rk_ma = AC; /* load curr addr */ + break; + + case 5: /* DRST */ + uptr = rk_dev.units + GET_DRIVE (rk_cmd); /* selected unit */ + rk_sta = rk_sta & ~(RKS_HMOV + RKS_NRDY); /* clear dynamic */ + if ((uptr->flags & UNIT_ATT) == 0) + rk_sta = rk_sta | RKS_NRDY; + if (sim_is_active (uptr)) + rk_sta = rk_sta | RKS_HMOV; + return rk_sta; + + case 6: /* DLDC */ + if (rk_busy != 0) + rk_sta = rk_sta | RKS_BUSY; + else { + rk_cmd = AC; /* load command */ + rk_sta = 0; /* clear status */ + } + break; + + case 7: /* DMAN */ + break; + } /* end case pulse */ + +RK_INT_UPDATE; /* update int req */ +return 0; /* clear AC */ +} + +/* Initiate new function + + Called with function, cylinder, to allow recalibrate as well as + load and go to be processed by this routine. + + Assumes that the controller is idle, and that updating of interrupt + request will be done by the caller. +*/ + +void rk_go (int32 func, int32 cyl) +{ +int32 t; +UNIT *uptr; + +if (func == RKC_RALL) /* all? use standard */ + func = RKC_READ; +if (func == RKC_WALL) +func = RKC_WRITE; +uptr = rk_dev.units + GET_DRIVE (rk_cmd); /* selected unit */ +if ((uptr->flags & UNIT_ATT) == 0) { /* not attached? */ + rk_sta = rk_sta | RKS_DONE | RKS_NRDY | RKS_STAT; + return; + } +if (sim_is_active (uptr) || (cyl >= RK_NUMCY)) { /* busy or bad cyl? */ + rk_sta = rk_sta | RKS_DONE | RKS_STAT; + return; + } +if ((func == RKC_WRITE) && (uptr->flags & UNIT_WPRT)) { + rk_sta = rk_sta | RKS_DONE | RKS_WLK; /* write and locked? */ + return; + } +if (func == RKC_WLK) { /* write lock? */ + uptr->flags = uptr->flags | UNIT_SWLK; + rk_sta = rk_sta | RKS_DONE; + return; + } +t = abs (cyl - uptr->CYL) * rk_swait; /* seek time */ +if (func == RKC_SEEK) { /* seek? */ + sim_activate (uptr, MAX (RK_MIN, t)); /* schedule */ + rk_sta = rk_sta | RKS_DONE; /* set done */ + } +else { + sim_activate (uptr, t + rk_rwait); /* schedule */ + rk_busy = 1; /* set busy */ + } +uptr->FUNC = func; /* save func */ +uptr->CYL = cyl; /* put on cylinder */ +return; +} + +/* Unit service + + If seek, complete seek command + Else complete data transfer command + + The unit control block contains the function and cylinder address for + the current command. + + Note that memory addresses wrap around in the current field. +*/ + +static uint16 fill[RK_NUMWD/2] = { 0 }; +t_stat rk_svc (UNIT *uptr) +{ +int32 err, wc, wc1, awc, swc, pa, da; +UNIT *seluptr; + +if (uptr->FUNC == RKC_SEEK) { /* seek? */ + seluptr = rk_dev.units + GET_DRIVE (rk_cmd); /* see if selected */ + if ((uptr == seluptr) && ((rk_cmd & RKC_SKDN) != 0)) { + rk_sta = rk_sta | RKS_DONE; + RK_INT_UPDATE; + } + return SCPE_OK; + } + +if ((uptr->flags & UNIT_ATT) == 0) { /* not att? abort */ + rk_sta = rk_sta | RKS_DONE | RKS_NRDY | RKS_STAT; + rk_busy = 0; + RK_INT_UPDATE; + return IORETURN (rk_stopioe, SCPE_UNATT); + } + +if ((uptr->FUNC == RKC_WRITE) && (uptr->flags & UNIT_WPRT)) { + rk_sta = rk_sta | RKS_DONE | RKS_WLK; /* write and locked? */ + rk_busy = 0; + RK_INT_UPDATE; + return SCPE_OK; + } + +pa = GET_MEX (rk_cmd) | rk_ma; /* phys address */ +da = GET_DA (rk_cmd, rk_da) * RK_NUMWD * sizeof (int16);/* disk address */ +swc = wc = (rk_cmd & RKC_HALF)? RK_NUMWD / 2: RK_NUMWD; /* get transfer size */ +if ((wc1 = ((rk_ma + wc) - 010000)) > 0) /* if wrap, limit */ + wc = wc - wc1; +err = fseek (uptr->fileref, da, SEEK_SET); /* locate sector */ + +if ((uptr->FUNC == RKC_READ) && (err == 0) && MEM_ADDR_OK (pa)) { /* read? */ + awc = fxread (&M[pa], sizeof (int16), wc, uptr->fileref); + for ( ; awc < wc; awc++) /* fill if eof */ + M[pa + awc] = 0; + err = ferror (uptr->fileref); + if ((wc1 > 0) && (err == 0)) { /* field wraparound? */ + pa = pa & 070000; /* wrap phys addr */ + awc = fxread (&M[pa], sizeof (int16), wc1, uptr->fileref); + for ( ; awc < wc1; awc++) /* fill if eof */ + M[pa + awc] = 0; + err = ferror (uptr->fileref); + } + } + +if ((uptr->FUNC == RKC_WRITE) && (err == 0)) { /* write? */ + fxwrite (&M[pa], sizeof (int16), wc, uptr->fileref); + err = ferror (uptr->fileref); + if ((wc1 > 0) && (err == 0)) { /* field wraparound? */ + pa = pa & 070000; /* wrap phys addr */ + fxwrite (&M[pa], sizeof (int16), wc1, uptr->fileref); + err = ferror (uptr->fileref); + } + if ((rk_cmd & RKC_HALF) && (err == 0)) { /* fill half sector */ + fxwrite (fill, sizeof (int16), RK_NUMWD/2, uptr->fileref); + err = ferror (uptr->fileref); + } + } + +rk_ma = (rk_ma + swc) & 07777; /* incr mem addr reg */ +rk_sta = rk_sta | RKS_DONE; /* set done */ +rk_busy = 0; +RK_INT_UPDATE; + +if (err != 0) { + sim_perror ("RK I/O error"); + clearerr (uptr->fileref); + return SCPE_IOERR; + } +return SCPE_OK; +} + +/* Reset routine */ + +t_stat rk_reset (DEVICE *dptr) +{ +int32 i; +UNIT *uptr; + +rk_cmd = rk_ma = rk_da = rk_sta = rk_busy = 0; +int_req = int_req & ~INT_RK; /* clear interrupt */ +for (i = 0; i < RK_NUMDR; i++) { /* stop all units */ + uptr = rk_dev.units + i; + sim_cancel (uptr); + uptr->flags = uptr->flags & ~UNIT_SWLK; + uptr->CYL = uptr->FUNC = 0; + } +return SCPE_OK; +} + +/* Bootstrap routine */ + +#define BOOT_START 023 +#define BOOT_UNIT 032 +#define BOOT_LEN (sizeof (boot_rom) / sizeof (int16)) + +static const uint16 boot_rom[] = { + 06007, /* 23, CAF */ + 06744, /* 24, DLCA ; addr = 0 */ + 01032, /* 25, TAD UNIT ; unit no */ + 06746, /* 26, DLDC ; command, unit */ + 06743, /* 27, DLAG ; disk addr, go */ + 01032, /* 30, TAD UNIT ; unit no, for OS */ + 05031, /* 31, JMP . */ + 00000 /* UNIT, 0 ; in bits <9:10> */ + }; + +t_stat rk_boot (int32 unitno, DEVICE *dptr) +{ +size_t i; + +if (rk_dib.dev != DEV_RK) /* only std devno */ + return STOP_NOTSTD; +for (i = 0; i < BOOT_LEN; i++) + M[BOOT_START + i] = boot_rom[i]; +M[BOOT_UNIT] = (unitno & RK_M_NUMDR) << 1; +cpu_set_bootpc (BOOT_START); +return SCPE_OK; +} ADDED src/PDP8/pdp8_rl.c Index: src/PDP8/pdp8_rl.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_rl.c @@ -0,0 +1,703 @@ +/* pdp8_rl.c: RL8A cartridge disk simulator + + Copyright (c) 1993-2013, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + rl RL8A cartridge disk + + 17-Sep-13 RMS Changed to use central set_bootpc routine + 25-Oct-05 RMS Fixed IOT 61 decode bug (David Gesswein) + 16-Aug-05 RMS Fixed C++ declaration and cast problems + 04-Jan-04 RMS Changed attach routine to use sim_fsize + 25-Apr-03 RMS Revised for extended file support + 04-Oct-02 RMS Added DIB, device number support + 06-Jan-02 RMS Changed enable/disable support + 30-Nov-01 RMS Cloned from RL11 + + The RL8A is a four drive cartridge disk subsystem. An RL01 drive + consists of 256 cylinders, each with 2 surfaces containing 40 sectors + of 256 bytes. An RL02 drive has 512 cylinders. + + The RL8A controller has several serious complications. + - Seeking is relative to the current disk address; this requires + keeping accurate track of the current cylinder. + - The RL8A will not switch heads or cross cylinders during transfers. + - The RL8A operates in 8b and 12b mode, like the RX8E; in 12b mode, it + packs 2 12b words into 3 bytes, creating a 170 "word" sector with + one wasted byte. Multi-sector transfers in 12b mode don't work. +*/ + +#include "pdp8_defs.h" + +/* Constants */ + +#define RL_NUMBY 256 /* 8b bytes/sector */ +#define RL_NUMSC 40 /* sectors/surface */ +#define RL_NUMSF 2 /* surfaces/cylinder */ +#define RL_NUMCY 256 /* cylinders/drive */ +#define RL_NUMDR 4 /* drives/controller */ +#define RL_MAXFR (1 << 12) /* max transfer */ +#define RL01_SIZE (RL_NUMCY*RL_NUMSF*RL_NUMSC*RL_NUMBY) /* words/drive */ +#define RL02_SIZE (RL01_SIZE * 2) /* words/drive */ +#define RL_BBMAP 014 /* sector for bblk map */ +#define RL_BBID 0123 /* ID for bblk map */ + +/* Flags in the unit flags word */ + +#define UNIT_V_WLK (UNIT_V_UF + 0) /* write lock */ +#define UNIT_V_RL02 (UNIT_V_UF + 1) /* RL01 vs RL02 */ +#define UNIT_V_AUTO (UNIT_V_UF + 2) /* autosize enable */ +#define UNIT_V_DUMMY (UNIT_V_UF + 3) /* dummy flag */ +#define UNIT_DUMMY (1u << UNIT_V_DUMMY) +#define UNIT_WLK (1u << UNIT_V_WLK) +#define UNIT_RL02 (1u << UNIT_V_RL02) +#define UNIT_AUTO (1u << UNIT_V_AUTO) +#define UNIT_WPRT (UNIT_WLK | UNIT_RO) /* write protect */ + +/* Parameters in the unit descriptor */ + +#define TRK u3 /* current cylinder */ +#define STAT u4 /* status */ + +/* RLDS, NI = not implemented, * = kept in STAT, ^ = kept in TRK */ + +#define RLDS_LOAD 0 /* no cartridge */ +#define RLDS_LOCK 5 /* lock on */ +#define RLDS_BHO 0000010 /* brushes home NI */ +#define RLDS_HDO 0000020 /* heads out NI */ +#define RLDS_CVO 0000040 /* cover open NI */ +#define RLDS_HD 0000100 /* head select ^ */ +#define RLDS_RL02 0000200 /* RL02 */ +#define RLDS_DSE 0000400 /* drv sel err NI */ +#define RLDS_VCK 0001000 /* vol check * */ +#define RLDS_WGE 0002000 /* wr gate err * */ +#define RLDS_SPE 0004000 /* spin err * */ +#define RLDS_STO 0010000 /* seek time out NI */ +#define RLDS_WLK 0020000 /* wr locked */ +#define RLDS_HCE 0040000 /* hd curr err NI */ +#define RLDS_WDE 0100000 /* wr data err NI */ +#define RLDS_ATT (RLDS_HDO+RLDS_BHO+RLDS_LOCK) /* att status */ +#define RLDS_UNATT (RLDS_CVO+RLDS_LOAD) /* unatt status */ +#define RLDS_ERR (RLDS_WDE+RLDS_HCE+RLDS_STO+RLDS_SPE+RLDS_WGE+ \ + RLDS_VCK+RLDS_DSE) /* errors bits */ + +/* RLCSA, seek = offset/rw = address (also uptr->TRK) */ + +#define RLCSA_DIR 04000 /* direction */ +#define RLCSA_HD 02000 /* head select */ +#define RLCSA_CYL 00777 /* cyl offset */ +#define GET_CYL(x) ((x) & RLCSA_CYL) +#define GET_TRK(x) ((((x) & RLCSA_CYL) * RL_NUMSF) + \ + (((x) & RLCSA_HD)? 1: 0)) +#define GET_DA(x) ((GET_TRK(x) * RL_NUMSC) + rlsa) + +/* RLCSB, function/unit select */ + +#define RLCSB_V_FUNC 0 /* function */ +#define RLCSB_M_FUNC 07 +#define RLCSB_MNT 0 +#define RLCSB_CLRD 1 +#define RLCSB_GSTA 2 +#define RLCSB_SEEK 3 +#define RLCSB_RHDR 4 +#define RLCSB_WRITE 5 +#define RLCSB_READ 6 +#define RLCSB_RNOHDR 7 +#define RLCSB_V_MEX 3 /* memory extension */ +#define RLCSB_M_MEX 07 +#define RLCSB_V_DRIVE 6 /* drive */ +#define RLCSB_M_DRIVE 03 +#define RLCSB_V_IE 8 /* int enable */ +#define RLCSB_IE (1u << RLCSB_V_IE) +#define RLCSB_8B 01000 /* 12b/8b */ +#define RCLS_MNT 02000 /* maint NI */ +#define RLCSB_RW 0001777 /* read/write */ +#define GET_FUNC(x) (((x) >> RLCSB_V_FUNC) & RLCSB_M_FUNC) +#define GET_MEX(x) (((x) >> RLCSB_V_MEX) & RLCSB_M_MEX) +#define GET_DRIVE(x) (((x) >> RLCSB_V_DRIVE) & RLCSB_M_DRIVE) + +/* RLSA, disk sector */ + +#define RLSA_V_SECT 6 /* sector */ +#define RLSA_M_SECT 077 +#define GET_SECT(x) (((x) >> RLSA_V_SECT) & RLSA_M_SECT) + +/* RLER, error register */ + +#define RLER_DRDY 00001 /* drive ready */ +#define RLER_DRE 00002 /* drive error */ +#define RLER_HDE 01000 /* header error */ +#define RLER_INCMP 02000 /* incomplete */ +#define RLER_ICRC 04000 /* CRC error */ +#define RLER_MASK 07003 + +/* RLSI, silo register, used only in read header */ + +#define RLSI_V_TRK 6 /* track */ + +extern uint16 M[]; +extern int32 int_req; +extern UNIT cpu_unit; + +uint8 *rlxb = NULL; /* xfer buffer */ +int32 rlcsa = 0; /* control/status A */ +int32 rlcsb = 0; /* control/status B */ +int32 rlma = 0; /* memory address */ +int32 rlwc = 0; /* word count */ +int32 rlsa = 0; /* sector address */ +int32 rler = 0; /* error register */ +int32 rlsi = 0, rlsi1 = 0, rlsi2 = 0; /* silo queue */ +int32 rl_lft = 0; /* silo left/right */ +int32 rl_done = 0; /* done flag */ +int32 rl_erf = 0; /* error flag */ +int32 rl_swait = 10; /* seek wait */ +int32 rl_rwait = 10; /* rotate wait */ +int32 rl_stopioe = 1; /* stop on error */ + +int32 rl60 (int32 IR, int32 AC); +int32 rl61 (int32 IR, int32 AC); +t_stat rl_svc (UNIT *uptr); +t_stat rl_reset (DEVICE *dptr); +void rl_set_done (int32 error); +t_stat rl_boot (int32 unitno, DEVICE *dptr); +t_stat rl_attach (UNIT *uptr, CONST char *cptr); +t_stat rl_set_size (UNIT *uptr, int32 val, CONST char *cptr, void *desc); +t_stat rl_set_bad (UNIT *uptr, int32 val, CONST char *cptr, void *desc); + +/* RL8A data structures + + rl_dev RL device descriptor + rl_unit RL unit list + rl_reg RL register list + rl_mod RL modifier list +*/ + +DIB rl_dib = { DEV_RL, 2, { &rl60, &rl61 } }; + +UNIT rl_unit[] = { + { UDATA (&rl_svc, UNIT_FIX+UNIT_ATTABLE+UNIT_DISABLE+UNIT_AUTO+ + UNIT_ROABLE, RL01_SIZE) }, + { UDATA (&rl_svc, UNIT_FIX+UNIT_ATTABLE+UNIT_DISABLE+UNIT_AUTO+ + UNIT_ROABLE, RL01_SIZE) }, + { UDATA (&rl_svc, UNIT_FIX+UNIT_ATTABLE+UNIT_DISABLE+UNIT_AUTO+ + UNIT_ROABLE, RL01_SIZE) }, + { UDATA (&rl_svc, UNIT_FIX+UNIT_ATTABLE+UNIT_DISABLE+UNIT_AUTO+ + UNIT_ROABLE, RL01_SIZE) } + }; + +REG rl_reg[] = { + { ORDATAD (RLCSA, rlcsa, 12, "control/status A") }, + { ORDATAD (RLCSB, rlcsb, 12, "control/status B") }, + { ORDATAD (RLMA, rlma, 12, "memory address") }, + { ORDATAD (RLWC, rlwc, 12, "word count") }, + { ORDATAD (RLSA, rlsa, 6, "sector address") }, + { ORDATAD (RLER, rler, 12, "error flags") }, + { ORDATAD (RLSI, rlsi, 16, "silo top word") }, + { ORDATAD (RLSI1, rlsi1, 16, "silo second word") }, + { ORDATAD (RLSI2, rlsi2, 16, "silo third word") }, + { FLDATAD (RLSIL, rl_lft, 0, "silo read left/right flag") }, + { FLDATAD (INT, int_req, INT_V_RL, "interrupt request") }, + { FLDATAD (DONE, rl_done, INT_V_RL, "done flag") }, + { FLDATA (IE, rlcsb, RLCSB_V_IE) }, + { FLDATAD (ERR, rl_erf, 0, "composite error flag") }, + { DRDATAD (STIME, rl_swait, 24, "seek time, per cylinder"), PV_LEFT }, + { DRDATAD (RTIME, rl_rwait, 24, "rotational delay"), PV_LEFT }, + { URDATA (CAPAC, rl_unit[0].capac, 10, T_ADDR_W, 0, + RL_NUMDR, PV_LEFT + REG_HRO) }, + { FLDATAD (STOP_IOE, rl_stopioe, 0, "stop on I/O error") }, + { ORDATA (DEVNUM, rl_dib.dev, 6), REG_HRO }, + { NULL } + }; + +MTAB rl_mod[] = { + { UNIT_WLK, 0, "write enabled", "WRITEENABLED", NULL }, + { UNIT_WLK, UNIT_WLK, "write locked", "LOCKED", NULL }, + { UNIT_DUMMY, 0, NULL, "BADBLOCK", &rl_set_bad }, + { (UNIT_RL02+UNIT_ATT), UNIT_ATT, "RL01", NULL, NULL }, + { (UNIT_RL02+UNIT_ATT), (UNIT_RL02+UNIT_ATT), "RL02", NULL, NULL }, + { (UNIT_AUTO+UNIT_RL02+UNIT_ATT), 0, "RL01", NULL, NULL }, + { (UNIT_AUTO+UNIT_RL02+UNIT_ATT), UNIT_RL02, "RL02", NULL, NULL }, + { (UNIT_AUTO+UNIT_ATT), UNIT_AUTO, "autosize", NULL, NULL }, + { UNIT_AUTO, UNIT_AUTO, NULL, "AUTOSIZE", NULL }, + { (UNIT_AUTO+UNIT_RL02), 0, NULL, "RL01", &rl_set_size }, + { (UNIT_AUTO+UNIT_RL02), UNIT_RL02, NULL, "RL02", &rl_set_size }, + { MTAB_XTD|MTAB_VDV, 0, "DEVNO", "DEVNO", + &set_dev, &show_dev, NULL }, + { 0 } + }; + +DEVICE rl_dev = { + "RL", rl_unit, rl_reg, rl_mod, + RL_NUMDR, 8, 24, 1, 8, 8, + NULL, NULL, &rl_reset, + &rl_boot, &rl_attach, NULL, + &rl_dib, DEV_DISABLE | DEV_DIS + }; + +/* IOT routines */ + +int32 rl60 (int32 IR, int32 AC) +{ +int32 curr, offs, newc, maxc; +UNIT *uptr; + +switch (IR & 07) { /* case IR<9:11> */ + + case 0: /* RLDC */ + rl_reset (&rl_dev); /* reset device */ + break; + + case 1: /* RLSD */ + if (rl_done) /* skip if done */ + AC = IOT_SKP; + else AC = 0; + rl_done = 0; /* clear done */ + int_req = int_req & ~INT_RL; /* clear intr */ + return AC; + + case 2: /* RLMA */ + rlma = AC; + break; + + case 3: /* RLCA */ + rlcsa = AC; + break; + + case 4: /* RLCB */ + rlcsb = AC; + rl_done = 0; /* clear done */ + rler = rl_erf = 0; /* clear errors */ + int_req = int_req & ~INT_RL; /* clear intr */ + rl_lft = 0; /* clear silo ptr */ + uptr = rl_dev.units + GET_DRIVE (rlcsb); /* select unit */ + switch (GET_FUNC (rlcsb)) { /* case on func */ + + case RLCSB_CLRD: /* clear drive */ + uptr->STAT = uptr->STAT & ~RLDS_ERR; /* clear errors */ + case RLCSB_MNT: /* mnt */ + rl_set_done (0); + break; + + case RLCSB_SEEK: /* seek */ + curr = GET_CYL (uptr->TRK); /* current cylinder */ + offs = GET_CYL (rlcsa); /* offset */ + if (rlcsa & RLCSA_DIR) { /* in or out? */ + newc = curr + offs; /* out */ + maxc = (uptr->flags & UNIT_RL02)? + RL_NUMCY * 2: RL_NUMCY; + if (newc >= maxc) newc = maxc - 1; + } + else { + newc = curr - offs; /* in */ + if (newc < 0) newc = 0; + } + uptr->TRK = newc | (rlcsa & RLCSA_HD); + sim_activate (uptr, rl_swait * abs (newc - curr)); + break; + + default: /* data transfer */ + sim_activate (uptr, rl_swait); /* activate unit */ + break; + } /* end switch func */ + break; + + case 5: /* RLSA */ + rlsa = GET_SECT (AC); + break; + + case 6: /* spare */ + return 0; + + case 7: /* RLWC */ + rlwc = AC; + break; + } /* end switch pulse */ + +return 0; /* clear AC */ +} + +int32 rl61 (int32 IR, int32 AC) +{ +int32 dat; +UNIT *uptr; + +switch (IR & 07) { /* case IR<9:11> */ + + case 0: /* RRER */ + uptr = rl_dev.units + GET_DRIVE (rlcsb); /* select unit */ + if (!sim_is_active (uptr) && /* update drdy */ + (uptr->flags & UNIT_ATT)) + rler = rler | RLER_DRDY; + else rler = rler & ~RLER_DRDY; + dat = rler & RLER_MASK; + break; + + case 1: /* RRWC */ + dat = rlwc; + break; + + case 2: /* RRCA */ + dat = rlcsa; + break; + + case 3: /* RRCB */ + dat = rlcsb; + break; + + case 4: /* RRSA */ + dat = (rlsa << RLSA_V_SECT) & 07777; + break; + + case 5: /* RRSI */ + if (rl_lft) { /* silo left? */ + dat = (rlsi >> 8) & 0377; /* get left 8b */ + rlsi = rlsi1; /* ripple */ + rlsi1 = rlsi2; + } + else dat = rlsi & 0377; /* get right 8b */ + rl_lft = rl_lft ^ 1; /* change side */ + break; + + case 6: /* spare */ + return AC; + + case 7: /* RLSE */ + if (rl_erf) /* skip if err */ + dat = IOT_SKP | AC; + else dat = AC; + rl_erf = 0; + break; + } /* end switch pulse */ + +return dat; +} + +/* Service unit timeout + + If seek in progress, complete seek command + Else complete data transfer command + + The unit control block contains the function and cylinder for + the current command. +*/ + +t_stat rl_svc (UNIT *uptr) +{ +int32 err, wc, maxc; +int32 i, j, func, da, bc, wbc; +uint32 ma; + +func = GET_FUNC (rlcsb); /* get function */ +if (func == RLCSB_GSTA) { /* get status? */ + rlsi = uptr->STAT | + ((uptr->TRK & RLCSA_HD)? RLDS_HD: 0) | + ((uptr->flags & UNIT_ATT)? RLDS_ATT: RLDS_UNATT); + if (uptr->flags & UNIT_RL02) + rlsi = rlsi | RLDS_RL02; + if (uptr->flags & UNIT_WPRT) + rlsi = rlsi | RLDS_WLK; + rlsi2 = rlsi1 = rlsi; + rl_set_done (0); /* done */ + return SCPE_OK; + } + +if ((uptr->flags & UNIT_ATT) == 0) { /* attached? */ + uptr->STAT = uptr->STAT | RLDS_SPE; /* spin error */ + rl_set_done (RLER_INCMP); /* flag error */ + return IORETURN (rl_stopioe, SCPE_UNATT); + } + +if ((func == RLCSB_WRITE) && (uptr->flags & UNIT_WPRT)) { + uptr->STAT = uptr->STAT | RLDS_WGE; /* write and locked */ + rl_set_done (RLER_DRE); /* flag error */ + return SCPE_OK; + } + +if (func == RLCSB_SEEK) { /* seek? */ + rl_set_done (0); /* done */ + return SCPE_OK; + } + +if (func == RLCSB_RHDR) { /* read header? */ + rlsi = (GET_TRK (uptr->TRK) << RLSI_V_TRK) | rlsa; + rlsi1 = rlsi2 = 0; + rl_set_done (0); /* done */ + return SCPE_OK; + } + +if (((func != RLCSB_RNOHDR) && (GET_CYL (uptr->TRK) != GET_CYL (rlcsa))) + || (rlsa >= RL_NUMSC)) { /* bad cyl or sector? */ + rl_set_done (RLER_HDE | RLER_INCMP); /* flag error */ + return SCPE_OK; + } + +ma = (GET_MEX (rlcsb) << 12) | rlma; /* get mem addr */ +da = GET_DA (rlcsa) * RL_NUMBY; /* get disk addr */ +wc = 010000 - rlwc; /* get true wc */ +if (rlcsb & RLCSB_8B) { /* 8b mode? */ + bc = wc; /* bytes to xfr */ + maxc = (RL_NUMSC - rlsa) * RL_NUMBY; /* max transfer */ + if (bc > maxc) /* trk ovrun? limit */ + wc = bc = maxc; + } +else { + bc = ((wc * 3) + 1) / 2; /* 12b mode */ + if (bc > RL_NUMBY) { /* > 1 sector */ + bc = RL_NUMBY; /* cap xfer */ + wc = (RL_NUMBY * 2) / 3; + } + } + +err = fseek (uptr->fileref, da, SEEK_SET); + +if ((func >= RLCSB_READ) && (err == 0) && /* read (no hdr)? */ + MEM_ADDR_OK (ma)) { /* valid bank? */ + i = fxread (rlxb, sizeof (int8), bc, uptr->fileref); + err = ferror (uptr->fileref); + for ( ; i < bc; i++) /* fill buffer */ + rlxb[i] = 0; + for (i = j = 0; i < wc; i++) { /* store buffer */ + if (rlcsb & RLCSB_8B) /* 8b mode? */ + M[ma] = rlxb[i] & 0377; /* store */ + else if (i & 1) { /* odd wd 12b? */ + M[ma] = ((rlxb[j + 1] >> 4) & 017) | + (((uint16) rlxb[j + 2]) << 4); + j = j + 3; + } + else M[ma] = rlxb[j] | /* even wd 12b */ + ((((uint16) rlxb[j + 1]) & 017) << 8); + ma = (ma & 070000) + ((ma + 1) & 07777); + } /* end for */ + } /* end if wr */ + +if ((func == RLCSB_WRITE) && (err == 0)) { /* write? */ + for (i = j = 0; i < wc; i++) { /* fetch buffer */ + if (rlcsb & RLCSB_8B) /* 8b mode? */ + rlxb[i] = M[ma] & 0377; /* fetch */ + else if (i & 1) { /* odd wd 12b? */ + rlxb[j + 1] = rlxb[j + 1] | ((M[ma] & 017) << 4); + rlxb[j + 2] = ((M[ma] >> 4) & 0377); + j = j + 3; + } + else { /* even wd 12b */ + rlxb[j] = M[ma] & 0377; + rlxb[j + 1] = (M[ma] >> 8) & 017; + } + ma = (ma & 070000) + ((ma + 1) & 07777); + } /* end for */ + wbc = (bc + (RL_NUMBY - 1)) & ~(RL_NUMBY - 1); /* clr to */ + for (i = bc; i < wbc; i++) /* end of blk */ + rlxb[i] = 0; + fxwrite (rlxb, sizeof (int8), wbc, uptr->fileref); + err = ferror (uptr->fileref); + } /* end write */ + +rlwc = (rlwc + wc) & 07777; /* final word count */ +if (rlwc != 0) /* completed? */ + rler = rler | RLER_INCMP; +rlma = (rlma + wc) & 07777; /* final word addr */ +rlsa = rlsa + ((bc + (RL_NUMBY - 1)) / RL_NUMBY); +rl_set_done (0); + +if (err != 0) { /* error? */ + sim_perror ("RL I/O error"); + clearerr (uptr->fileref); + return SCPE_IOERR; + } +return SCPE_OK; +} + +/* Set done and possibly errors */ + +void rl_set_done (int32 status) +{ +rl_done = 1; +rler = rler | status; +if (rler) + rl_erf = 1; +if (rlcsb & RLCSB_IE) + int_req = int_req | INT_RL; +else int_req = int_req & ~INT_RL; +return; +} + +/* Device reset + + Note that the RL8A does NOT recalibrate its drives on RESET +*/ + +t_stat rl_reset (DEVICE *dptr) +{ +int32 i; +UNIT *uptr; + +rlcsa = rlcsb = rlsa = rler = 0; +rlma = rlwc = 0; +rlsi = rlsi1 = rlsi2 = 0; +rl_lft = 0; +rl_done = 0; +rl_erf = 0; +int_req = int_req & ~INT_RL; +for (i = 0; i < RL_NUMDR; i++) { + uptr = rl_dev.units + i; + sim_cancel (uptr); + uptr->STAT = 0; + } +if (rlxb == NULL) + rlxb = (uint8 *) calloc (RL_MAXFR, sizeof (uint8)); +if (rlxb == NULL) + return SCPE_MEM; +return SCPE_OK; +} + +/* Attach routine */ + +t_stat rl_attach (UNIT *uptr, CONST char *cptr) +{ +uint32 p; +t_stat r; + +uptr->capac = (uptr->flags & UNIT_RL02)? RL02_SIZE: RL01_SIZE; +r = attach_unit (uptr, cptr); /* attach unit */ +if (r != SCPE_OK) /* error? */ + return r; +uptr->TRK = 0; /* cyl 0 */ +uptr->STAT = RLDS_VCK; /* new volume */ +if ((p = sim_fsize (uptr->fileref)) == 0) { /* new disk image? */ + if (uptr->flags & UNIT_RO) + return SCPE_OK; + return rl_set_bad (uptr, 0, NULL, NULL); + } +if ((uptr->flags & UNIT_AUTO) == 0) /* autosize? */ + return r; +if (p > (RL01_SIZE * sizeof (int16))) { + uptr->flags = uptr->flags | UNIT_RL02; + uptr->capac = RL02_SIZE; + } +else { + uptr->flags = uptr->flags & ~UNIT_RL02; + uptr->capac = RL01_SIZE; + } +return SCPE_OK; +} + +/* Set size routine */ + +t_stat rl_set_size (UNIT *uptr, int32 val, CONST char *cptr, void *desc) +{ +if (uptr->flags & UNIT_ATT) + return SCPE_ALATT; +uptr->capac = (val & UNIT_RL02)? RL02_SIZE: RL01_SIZE; +return SCPE_OK; +} + +/* Factory bad block table creation routine + + This routine writes the OS/8 specific bad block map in track 0, sector 014 (RL_BBMAP): + + words 0 magic number = 0123 (RL_BBID) + words 1-n block numbers + : + words n+1 end of table = 0 + + Inputs: + uptr = pointer to unit + val = ignored + Outputs: + sta = status code +*/ + +t_stat rl_set_bad (UNIT *uptr, int32 val, CONST char *cptr, void *desc) +{ +int32 i, da = RL_BBMAP * RL_NUMBY; + +if ((uptr->flags & UNIT_ATT) == 0) + return SCPE_UNATT; +if (uptr->flags & UNIT_RO) + return SCPE_RO; +if (!get_yn ("Create bad block table? [N]", FALSE)) + return SCPE_OK; +if (fseek (uptr->fileref, da, SEEK_SET)) + return SCPE_IOERR; +rlxb[0] = RL_BBID; +for (i = 1; i < RL_NUMBY; i++) + rlxb[i] = 0; +fxwrite (rlxb, sizeof (uint8), RL_NUMBY, uptr->fileref); +if (ferror (uptr->fileref)) + return SCPE_IOERR; +return SCPE_OK; +} + +/* Bootstrap */ + +#define BOOT_START 1 /* start */ +#define BOOT_UNIT 02006 /* unit number */ +#define BOOT_LEN (sizeof (boot_rom) / sizeof (int16)) + +static const uint16 boot_rom[] = { + 06600, /* BT, RLDC ; reset */ + 07201, /* 02, CLA IAC ; clr drv = 1 */ + 04027, /* 03, JMS GO ; do io */ + 01004, /* 04, TAD 4 ; rd hdr fnc */ + 04027, /* 05, JMS GO ; do io */ + 06615, /* 06, RRSI ; rd hdr lo */ + 07002, /* 07, BSW ; swap */ + 07012, /* 10, RTR ; lo cyl to L */ + 06615, /* 11, RRSI ; rd hdr hi */ + 00025, /* 12, AND 25 ; mask = 377 */ + 07004, /* 13, RTL ; get cyl */ + 06603, /* 14, RLCA ; set addr */ + 07325, /* 15, CLA STL IAC RAL ; seek = 3 */ + 04027, /* 16, JMS GO ; do io */ + 07332, /* 17, CLA STL RTR ; dir in = 2000 */ + 06605, /* 20, RLSA ; sector */ + 01026, /* 21, TAD (-200) ; one sector */ + 06607, /* 22, RLWC ; word cnt */ + 07327, /* 23, CLA STL IAC RTL ; read = 6*/ + 04027, /* 24, JMS GO ; do io */ + 00377, /* 25, JMP 377 ; start */ + 07600, /* 26, -200 ; word cnt */ + 00000, /* GO, 0 ; subr */ + 06604, /* 30, RLCB ; load fnc */ + 06601, /* 31, RLSD ; wait */ + 05031, /* 32, JMP .-1 ; */ + 06617, /* 33, RLSE ; error? */ + 05427, /* 34, JMP I GO ; no, ok */ + 05001 /* 35, JMP BT ; restart */ + }; + + +t_stat rl_boot (int32 unitno, DEVICE *dptr) +{ +size_t i; + +if (unitno) /* only unit 0 */ + return SCPE_ARG; +if (rl_dib.dev != DEV_RL) /* only std devno */ + return STOP_NOTSTD; +rl_unit[unitno].TRK = 0; +for (i = 0; i < BOOT_LEN; i++) + M[BOOT_START + i] = boot_rom[i]; +cpu_set_bootpc (BOOT_START); +return SCPE_OK; +} ADDED src/PDP8/pdp8_rx.c Index: src/PDP8/pdp8_rx.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_rx.c @@ -0,0 +1,754 @@ +/* pdp8_rx.c: RX8E/RX01, RX28/RX02 floppy disk simulator + + Copyright (c) 1993-2013, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + rx RX8E/RX01, RX28/RX02 floppy disk + + 17-Sep-13 RMS Changed to use central set_bootpc routine + 03-Sep-13 RMS Added explicit void * cast + 15-May-06 RMS Fixed bug in autosize attach (Dave Gesswein) + 04-Jan-04 RMS Changed sim_fsize calling sequence + 05-Nov-03 RMS Fixed bug in RX28 read status (Charles Dickman) + 26-Oct-03 RMS Cleaned up buffer copy code, fixed double density write + 25-Apr-03 RMS Revised for extended file support + 14-Mar-03 RMS Fixed variable size interaction with save/restore + 03-Mar-03 RMS Fixed autosizing + 08-Oct-02 RMS Added DIB, device number support + Fixed reset to work with disabled device + 15-Sep-02 RMS Added RX28/RX02 support + 06-Jan-02 RMS Changed enable/disable support + 30-Nov-01 RMS Added read only unit, extended SET/SHOW support + 24-Nov-01 RMS Converted FLG to array + 17-Jul-01 RMS Fixed warning from VC++ 6 + 26-Apr-01 RMS Added device enable/disable support + 13-Apr-01 RMS Revised for register arrays + 14-Apr-99 RMS Changed t_addr to unsigned + 15-Aug-96 RMS Fixed bug in LCD + + An RX01 diskette consists of 77 tracks, each with 26 sectors of 128B. + An RX02 diskette consists of 77 tracks, each with 26 sectors of 128B + (single density) or 256B (double density). Tracks are numbered 0-76, + sectors 1-26. The RX8E (RX28) can store data in 8b mode or 12b mode. + In 8b mode, the controller reads or writes 128 bytes (128B or 256B) + per sector. In 12b mode, it reads or writes 64 (64 or 128) 12b words + per sector. The 12b words are bit packed into the first 96 (192) bytes + of the sector; the last 32 (64) bytes are zeroed on writes. +*/ + +#include "pdp8_defs.h" + +#define RX_NUMTR 77 /* tracks/disk */ +#define RX_M_TRACK 0377 +#define RX_NUMSC 26 /* sectors/track */ +#define RX_M_SECTOR 0177 /* cf Jones!! */ +#define RX_NUMBY 128 /* bytes/sector */ +#define RX2_NUMBY 256 +#define RX_NUMWD (RX_NUMBY / 2) /* words/sector */ +#define RX2_NUMWD (RX2_NUMBY / 2) +#define RX_SIZE (RX_NUMTR * RX_NUMSC * RX_NUMBY) /* bytes/disk */ +#define RX2_SIZE (RX_NUMTR * RX_NUMSC * RX2_NUMBY) +#define RX_NUMDR 2 /* drives/controller */ +#define RX_M_NUMDR 01 +#define UNIT_V_WLK (UNIT_V_UF + 0) /* write locked */ +#define UNIT_V_DEN (UNIT_V_UF + 1) /* double density */ +#define UNIT_V_AUTO (UNIT_V_UF + 2) /* autosize */ +#define UNIT_WLK (1u << UNIT_V_WLK) +#define UNIT_DEN (1u << UNIT_V_DEN) +#define UNIT_AUTO (1u << UNIT_V_AUTO) +#define UNIT_WPRT (UNIT_WLK | UNIT_RO) /* write protect */ + +#define IDLE 0 /* idle state */ +#define CMD8 1 /* 8b cmd, ho next */ +#define RWDS 2 /* rw, sect next */ +#define RWDT 3 /* rw, track next */ +#define RWXFR 4 /* rw, transfer */ +#define FILL 5 /* fill buffer */ +#define EMPTY 6 /* empty buffer */ +#define SDCNF 7 /* set dens, conf next */ +#define SDXFR 8 /* set dens, transfer */ +#define CMD_COMPLETE 9 /* set done next */ +#define INIT_COMPLETE 10 /* init compl next */ + +#define RXCS_V_FUNC 1 /* function */ +#define RXCS_M_FUNC 7 +#define RXCS_FILL 0 /* fill buffer */ +#define RXCS_EMPTY 1 /* empty buffer */ +#define RXCS_WRITE 2 /* write sector */ +#define RXCS_READ 3 /* read sector */ +#define RXCS_SDEN 4 /* set density (RX28) */ +#define RXCS_RXES 5 /* read status */ +#define RXCS_WRDEL 6 /* write del data */ +#define RXCS_ECODE 7 /* read error code */ +#define RXCS_DRV 0020 /* drive */ +#define RXCS_MODE 0100 /* mode */ +#define RXCS_MAINT 0200 /* maintenance */ +#define RXCS_DEN 0400 /* density (RX28) */ +#define RXCS_GETFNC(x) (((x) >> RXCS_V_FUNC) & RXCS_M_FUNC) + +#define RXES_CRC 0001 /* CRC error NI */ +#define RXES_ID 0004 /* init done */ +#define RXES_RX02 0010 /* RX02 (RX28) */ +#define RXES_DERR 0020 /* density err (RX28) */ +#define RXES_DEN 0040 /* density (RX28) */ +#define RXES_DD 0100 /* deleted data */ +#define RXES_DRDY 0200 /* drive ready */ + +#define TRACK u3 /* current track */ +#define READ_RXDBR ((rx_csr & RXCS_MODE)? AC | (rx_dbr & 0377): rx_dbr) +#define CALC_DA(t,s,b) (((t) * RX_NUMSC) + ((s) - 1)) * b + +extern int32 int_req, int_enable, dev_done; + +int32 rx_28 = 0; /* controller type */ +int32 rx_tr = 0; /* xfer ready flag */ +int32 rx_err = 0; /* error flag */ +int32 rx_csr = 0; /* control/status */ +int32 rx_dbr = 0; /* data buffer */ +int32 rx_esr = 0; /* error status */ +int32 rx_ecode = 0; /* error code */ +int32 rx_track = 0; /* desired track */ +int32 rx_sector = 0; /* desired sector */ +int32 rx_state = IDLE; /* controller state */ +int32 rx_cwait = 100; /* command time */ +int32 rx_swait = 10; /* seek, per track */ +int32 rx_xwait = 1; /* tr set time */ +int32 rx_stopioe = 0; /* stop on error */ +uint8 rx_buf[RX2_NUMBY] = { 0 }; /* sector buffer */ +int32 rx_bptr = 0; /* buffer pointer */ + +int32 rx (int32 IR, int32 AC); +t_stat rx_svc (UNIT *uptr); +t_stat rx_reset (DEVICE *dptr); +t_stat rx_boot (int32 unitno, DEVICE *dptr); +t_stat rx_set_size (UNIT *uptr, int32 val, CONST char *cptr, void *desc); +t_stat rx_attach (UNIT *uptr, CONST char *cptr); +void rx_cmd (void); +void rx_done (int32 esr_flags, int32 new_ecode); +t_stat rx_settype (UNIT *uptr, int32 val, CONST char *cptr, void *desc); +t_stat rx_showtype (FILE *st, UNIT *uptr, int32 val, CONST void *desc); + +/* RX8E data structures + + rx_dev RX device descriptor + rx_unit RX unit list + rx_reg RX register list + rx_mod RX modifier list +*/ + +DIB rx_dib = { DEV_RX, 1, { &rx } }; + +UNIT rx_unit[] = { + { UDATA (&rx_svc, UNIT_FIX+UNIT_ATTABLE+UNIT_BUFABLE+UNIT_MUSTBUF+ + UNIT_ROABLE, RX_SIZE) }, + { UDATA (&rx_svc, UNIT_FIX+UNIT_ATTABLE+UNIT_BUFABLE+UNIT_MUSTBUF+ + UNIT_ROABLE, RX_SIZE) } + }; + +REG rx_reg[] = { + { ORDATAD (RXCS, rx_csr, 12, "status") }, + { ORDATAD (RXDB, rx_dbr, 12, "data buffer") }, + { ORDATAD (RXES, rx_esr, 12, "error status") }, + { ORDATA (RXERR, rx_ecode, 8) }, + { ORDATAD (RXTA, rx_track, 8, "current track") }, + { ORDATAD (RXSA, rx_sector, 8, "current sector") }, + { DRDATAD (STAPTR, rx_state, 4, "controller state"), REG_RO }, + { DRDATAD (BUFPTR, rx_bptr, 8, "buffer pointer") }, + { FLDATAD (TR, rx_tr, 0, "transfer ready flag") }, + { FLDATAD (ERR, rx_err, 0, "error flag") }, + { FLDATAD (DONE, dev_done, INT_V_RX, "done flag") }, + { FLDATAD (ENABLE, int_enable, INT_V_RX, "interrupt enable flag") }, + { FLDATAD (INT, int_req, INT_V_RX, "interrupt pending flag") }, + { DRDATAD (CTIME, rx_cwait, 24, "command completion time"), PV_LEFT }, + { DRDATAD (STIME, rx_swait, 24, "seek time per track"), PV_LEFT }, + { DRDATAD (XTIME, rx_xwait, 24, "transfer ready delay"), PV_LEFT }, + { FLDATAD (STOP_IOE, rx_stopioe, 0, "stop on I/O error") }, + { BRDATAD (SBUF, rx_buf, 8, 8, RX2_NUMBY, "sector buffer array") }, + { FLDATA (RX28, rx_28, 0), REG_HRO }, + { URDATA (CAPAC, rx_unit[0].capac, 10, T_ADDR_W, 0, + RX_NUMDR, REG_HRO | PV_LEFT) }, + { ORDATA (DEVNUM, rx_dib.dev, 6), REG_HRO }, + { NULL } + }; + +MTAB rx_mod[] = { + { UNIT_WLK, 0, "write enabled", "WRITEENABLED", NULL }, + { UNIT_WLK, UNIT_WLK, "write locked", "LOCKED", NULL }, + { MTAB_XTD | MTAB_VDV, 1, NULL, "RX28", &rx_settype, NULL, NULL }, + { MTAB_XTD | MTAB_VDV, 0, NULL, "RX8E", &rx_settype, NULL, NULL }, + { MTAB_XTD | MTAB_VDV, 0, "TYPE", NULL, NULL, &rx_showtype, NULL }, + { (UNIT_DEN+UNIT_ATT), UNIT_ATT, "single density", NULL, NULL }, + { (UNIT_DEN+UNIT_ATT), (UNIT_DEN+UNIT_ATT), "double density", NULL, NULL }, + { (UNIT_AUTO+UNIT_DEN+UNIT_ATT), 0, "single density", NULL, NULL }, + { (UNIT_AUTO+UNIT_DEN+UNIT_ATT), UNIT_DEN, "double density", NULL, NULL }, + { (UNIT_AUTO+UNIT_ATT), UNIT_AUTO, "autosize", NULL, NULL }, + { UNIT_AUTO, UNIT_AUTO, NULL, "AUTOSIZE", NULL }, + { (UNIT_AUTO+UNIT_DEN), 0, NULL, "SINGLE", &rx_set_size }, + { (UNIT_AUTO+UNIT_DEN), UNIT_DEN, NULL, "DOUBLE", &rx_set_size }, + { MTAB_XTD|MTAB_VDV, 0, "DEVNO", "DEVNO", + &set_dev, &show_dev, NULL }, + { 0 } + }; + +DEVICE rx_dev = { + "RX", rx_unit, rx_reg, rx_mod, + RX_NUMDR, 8, 20, 1, 8, 8, + NULL, NULL, &rx_reset, + &rx_boot, &rx_attach, NULL, + &rx_dib, DEV_DISABLE + }; + +/* IOT routine */ + +int32 rx (int32 IR, int32 AC) +{ +int32 drv = ((rx_csr & RXCS_DRV)? 1: 0); /* get drive number */ + +switch (IR & 07) { /* decode IR<9:11> */ + + case 0: /* unused */ + break; + + case 1: /* LCD */ + if (rx_state != IDLE) /* ignore if busy */ + return AC; + dev_done = dev_done & ~INT_RX; /* clear done, int */ + int_req = int_req & ~INT_RX; + rx_tr = rx_err = 0; /* clear flags */ + rx_bptr = 0; /* clear buf pointer */ + if (rx_28 && (AC & RXCS_MODE)) { /* RX28 8b mode? */ + rx_dbr = rx_csr = AC & 0377; /* save 8b */ + rx_tr = 1; /* xfer is ready */ + rx_state = CMD8; /* wait for part 2 */ + } + else { + rx_dbr = rx_csr = AC; /* save new command */ + rx_cmd (); /* issue command */ + } + return 0; /* clear AC */ + + case 2: /* XDR */ + switch (rx_state & 017) { /* case on state */ + + case EMPTY: /* emptying buffer */ + sim_activate (&rx_unit[drv], rx_xwait); /* sched xfer */ + return READ_RXDBR; /* return data reg */ + + case CMD8: /* waiting for cmd */ + rx_dbr = AC & 0377; + rx_csr = (rx_csr & 0377) | ((AC & 017) << 8); + rx_cmd (); + break; + + case RWDS:case RWDT:case FILL:case SDCNF: /* waiting for data */ + rx_dbr = AC; /* save data */ + sim_activate (&rx_unit[drv], rx_xwait); /* schedule */ + break; + + default: /* default */ + return READ_RXDBR; /* return data reg */ + } + break; + + case 3: /* STR */ + if (rx_tr != 0) { + rx_tr = 0; + return IOT_SKP + AC; + } + break; + + case 4: /* SER */ + if (rx_err != 0) { + rx_err = 0; + return IOT_SKP + AC; + } + break; + + case 5: /* SDN */ + if ((dev_done & INT_RX) != 0) { + dev_done = dev_done & ~INT_RX; + int_req = int_req & ~INT_RX; + return IOT_SKP + AC; + } + break; + + case 6: /* INTR */ + if (AC & 1) + int_enable = int_enable | INT_RX; + else int_enable = int_enable & ~INT_RX; + int_req = INT_UPDATE; + break; + + case 7: /* INIT */ + rx_reset (&rx_dev); /* reset device */ + break; + } /* end case pulse */ + +return AC; +} + +void rx_cmd (void) +{ +int32 drv = ((rx_csr & RXCS_DRV)? 1: 0); /* get drive number */ + +switch (RXCS_GETFNC (rx_csr)) { /* decode command */ + + case RXCS_FILL: + rx_state = FILL; /* state = fill */ + rx_tr = 1; /* xfer is ready */ + rx_esr = rx_esr & RXES_ID; /* clear errors */ + break; + + case RXCS_EMPTY: + rx_state = EMPTY; /* state = empty */ + rx_esr = rx_esr & RXES_ID; /* clear errors */ + sim_activate (&rx_unit[drv], rx_xwait); /* sched xfer */ + break; + + case RXCS_READ: case RXCS_WRITE: case RXCS_WRDEL: + rx_state = RWDS; /* state = get sector */ + rx_tr = 1; /* xfer is ready */ + rx_esr = rx_esr & RXES_ID; /* clear errors */ + break; + + case RXCS_SDEN: + if (rx_28) { /* RX28? */ + rx_state = SDCNF; /* state = get conf */ + rx_tr = 1; /* xfer is ready */ + rx_esr = rx_esr & RXES_ID; /* clear errors */ + break; + } /* else fall thru */ + default: + rx_state = CMD_COMPLETE; /* state = cmd compl */ + sim_activate (&rx_unit[drv], rx_cwait); /* sched done */ + break; + } /* end switch func */ + +return; +} + +/* Unit service; the action to be taken depends on the transfer state: + + IDLE Should never get here + RWDS Save sector, set TR, set RWDT + RWDT Save track, set RWXFR + RWXFR Read/write buffer + FILL copy dbr to rx_buf[rx_bptr], advance ptr + if rx_bptr > max, finish command, else set tr + EMPTY if rx_bptr > max, finish command, else + copy rx_buf[rx_bptr] to dbr, advance ptr, set tr + CMD_COMPLETE copy requested data to dbr, finish command + INIT_COMPLETE read drive 0, track 1, sector 1 to buffer, finish command + + For RWDT and CMD_COMPLETE, the input argument is the selected drive; + otherwise, it is drive 0. +*/ + +t_stat rx_svc (UNIT *uptr) +{ +int32 i, func, byptr, bps, wps; +int8 *fbuf = (int8 *) uptr->filebuf; +uint32 da; +#define PTR12(x) (((x) + (x) + (x)) >> 1) + +if (rx_28 && (uptr->flags & UNIT_DEN)) /* RX28 and double density? */ + bps = RX2_NUMBY; /* double bytes/sector */ +else bps = RX_NUMBY; /* RX8E, normal count */ +wps = bps / 2; +func = RXCS_GETFNC (rx_csr); /* get function */ +switch (rx_state) { /* case on state */ + + case IDLE: /* idle */ + return SCPE_IERR; + + case EMPTY: /* empty buffer */ + if (rx_csr & RXCS_MODE) { /* 8b xfer? */ + if (rx_bptr >= bps) { /* done? */ + rx_done (0, 0); /* set done */ + break; /* and exit */ + } + rx_dbr = rx_buf[rx_bptr]; /* else get data */ + } + else { + byptr = PTR12 (rx_bptr); /* 12b xfer */ + if (rx_bptr >= wps) { /* done? */ + rx_done (0, 0); /* set done */ + break; /* and exit */ + } + rx_dbr = (rx_bptr & 1)? /* get data */ + ((rx_buf[byptr] & 017) << 8) | rx_buf[byptr + 1]: + (rx_buf[byptr] << 4) | ((rx_buf[byptr + 1] >> 4) & 017); + } + rx_bptr = rx_bptr + 1; + rx_tr = 1; + break; + + case FILL: /* fill buffer */ + if (rx_csr & RXCS_MODE) { /* 8b xfer? */ + rx_buf[rx_bptr] = rx_dbr; /* fill buffer */ + rx_bptr = rx_bptr + 1; + if (rx_bptr < bps) /* if more, set xfer */ + rx_tr = 1; + else rx_done (0, 0); /* else done */ + } + else { + byptr = PTR12 (rx_bptr); /* 12b xfer */ + if (rx_bptr & 1) { /* odd or even? */ + rx_buf[byptr] = (rx_buf[byptr] & 0360) | ((rx_dbr >> 8) & 017); + rx_buf[byptr + 1] = rx_dbr & 0377; + } + else { + rx_buf[byptr] = (rx_dbr >> 4) & 0377; + rx_buf[byptr + 1] = (rx_dbr & 017) << 4; + } + rx_bptr = rx_bptr + 1; + if (rx_bptr < wps) /* if more, set xfer */ + rx_tr = 1; + else { + for (i = PTR12 (wps); i < bps; i++) + rx_buf[i] = 0; /* else fill sector */ + rx_done (0, 0); /* set done */ + } + } + break; + + case RWDS: /* wait for sector */ + rx_sector = rx_dbr & RX_M_SECTOR; /* save sector */ + rx_tr = 1; /* set xfer ready */ + rx_state = RWDT; /* advance state */ + return SCPE_OK; + + case RWDT: /* wait for track */ + rx_track = rx_dbr & RX_M_TRACK; /* save track */ + rx_state = RWXFR; + sim_activate (uptr, /* sched done */ + rx_swait * abs (rx_track - uptr->TRACK)); + return SCPE_OK; + + case RWXFR: /* transfer */ + if ((uptr->flags & UNIT_BUF) == 0) { /* not buffered? */ + rx_done (0, 0110); /* done, error */ + return IORETURN (rx_stopioe, SCPE_UNATT); + } + if (rx_track >= RX_NUMTR) { /* bad track? */ + rx_done (0, 0040); /* done, error */ + break; + } + uptr->TRACK = rx_track; /* now on track */ + if ((rx_sector == 0) || (rx_sector > RX_NUMSC)) { /* bad sect? */ + rx_done (0, 0070); /* done, error */ + break; + } + if (rx_28 && /* RX28? */ + (((uptr->flags & UNIT_DEN) != 0) ^ + ((rx_csr & RXCS_DEN) != 0))) { /* densities agree? */ + rx_done (RXES_DERR, 0240); /* no, error */ + break; + } + da = CALC_DA (rx_track, rx_sector, bps); /* get disk address */ + if (func == RXCS_WRDEL) /* del data? */ + rx_esr = rx_esr | RXES_DD; + if (func == RXCS_READ) { /* read? */ + for (i = 0; i < bps; i++) rx_buf[i] = fbuf[da + i]; + } + else { /* write */ + if (uptr->flags & UNIT_WPRT) { /* locked? */ + rx_done (0, 0100); /* done, error */ + break; + } + for (i = 0; i < bps; i++) + fbuf[da + i] = rx_buf[i]; + da = da + bps; + if (da > uptr->hwmark) + uptr->hwmark = da; + } + rx_done (0, 0); /* done */ + break; + + case SDCNF: /* confirm set density */ + if ((rx_dbr & 0377) != 0111) { /* confirmed? */ + rx_done (0, 0250); /* no, error */ + break; + } + rx_state = SDXFR; /* next state */ + sim_activate (uptr, rx_cwait * 100); /* schedule operation */ + break; + + case SDXFR: /* erase disk */ + for (i = 0; i < (int32) uptr->capac; i++) + fbuf[i] = 0; + uptr->hwmark = uptr->capac; + if (rx_csr & RXCS_DEN) + uptr->flags = uptr->flags | UNIT_DEN; + else uptr->flags = uptr->flags & ~UNIT_DEN; + rx_done (0, 0); + break; + + case CMD_COMPLETE: /* command complete */ + if (func == RXCS_ECODE) { /* read ecode? */ + rx_dbr = rx_ecode; /* set dbr */ + rx_done (0, -1); /* don't update */ + } + else if (rx_28) { /* no, read sta; RX28? */ + rx_esr = rx_esr & ~RXES_DERR; /* assume dens match */ + if (((uptr->flags & UNIT_DEN) != 0) ^ /* densities mismatch? */ + ((rx_csr & RXCS_DEN) != 0)) + rx_done (RXES_DERR, 0240); /* yes, error */ + else rx_done (0, 0); /* no, ok */ + } + else rx_done (0, 0); /* RX8E status */ + break; + + case INIT_COMPLETE: /* init complete */ + rx_unit[0].TRACK = 1; /* drive 0 to trk 1 */ + rx_unit[1].TRACK = 0; /* drive 1 to trk 0 */ + if ((rx_unit[0].flags & UNIT_BUF) == 0) { /* not buffered? */ + rx_done (RXES_ID, 0010); /* init done, error */ + break; + } + da = CALC_DA (1, 1, bps); /* track 1, sector 1 */ + for (i = 0; i < bps; i++) /* read sector */ + rx_buf[i] = fbuf[da + i]; + rx_done (RXES_ID, 0); /* set done */ + if ((rx_unit[1].flags & UNIT_ATT) == 0) + rx_ecode = 0020; + break; + } /* end case state */ + +return SCPE_OK; +} + +/* Command complete. Set done and put final value in interface register, + return to IDLE state. +*/ + +void rx_done (int32 esr_flags, int32 new_ecode) +{ +int32 drv = (rx_csr & RXCS_DRV)? 1: 0; + +rx_state = IDLE; /* now idle */ +dev_done = dev_done | INT_RX; /* set done */ +int_req = INT_UPDATE; /* update ints */ +rx_esr = (rx_esr | esr_flags) & ~(RXES_DRDY|RXES_RX02|RXES_DEN); +if (rx_28) /* RX28? */ + rx_esr = rx_esr | RXES_RX02; +if (rx_unit[drv].flags & UNIT_ATT) { /* update drv rdy */ + rx_esr = rx_esr | RXES_DRDY; + if (rx_unit[drv].flags & UNIT_DEN) /* update density */ + rx_esr = rx_esr | RXES_DEN; + } +if (new_ecode > 0) /* test for error */ + rx_err = 1; +if (new_ecode < 0) /* don't update? */ + return; +rx_ecode = new_ecode; /* update ecode */ +rx_dbr = rx_esr; /* update RXDB */ +return; +} + +/* Reset routine. The RX is one of the few devices that schedules + an I/O transfer as part of its initialization */ + +t_stat rx_reset (DEVICE *dptr) +{ +rx_dbr = rx_csr = 0; /* 12b mode, drive 0 */ +rx_esr = rx_ecode = 0; /* clear error */ +rx_tr = rx_err = 0; /* clear flags */ +rx_track = rx_sector = 0; /* clear address */ +rx_state = IDLE; /* ctrl idle */ +dev_done = dev_done & ~INT_RX; /* clear done, int */ +int_req = int_req & ~INT_RX; +int_enable = int_enable & ~INT_RX; +sim_cancel (&rx_unit[1]); /* cancel drive 1 */ +if (dptr->flags & DEV_DIS) /* disabled? */ + sim_cancel (&rx_unit[0]); +else if (rx_unit[0].flags & UNIT_BUF) { /* attached? */ + rx_state = INIT_COMPLETE; /* yes, sched init */ + sim_activate (&rx_unit[0], rx_swait * abs (1 - rx_unit[0].TRACK)); + } +else rx_done (rx_esr | RXES_ID, 0010); /* no, error */ +return SCPE_OK; +} + +/* Attach routine */ + +t_stat rx_attach (UNIT *uptr, CONST char *cptr) +{ +uint32 sz; + +if ((uptr->flags & UNIT_AUTO) && (sz = sim_fsize_name (cptr))) { + if (sz > RX_SIZE) + uptr->flags = uptr->flags | UNIT_DEN; + else uptr->flags = uptr->flags & ~UNIT_DEN; + } +uptr->capac = (uptr->flags & UNIT_DEN)? RX2_SIZE: RX_SIZE; +return attach_unit (uptr, cptr); +} + +/* Set size routine */ + +t_stat rx_set_size (UNIT *uptr, int32 val, CONST char *cptr, void *desc) +{ +if (uptr->flags & UNIT_ATT) + return SCPE_ALATT; +if ((rx_28 == 0) && val) /* not on RX8E */ + return SCPE_NOFNC; +uptr->capac = val? RX2_SIZE: RX_SIZE; +return SCPE_OK; +} + +/* Set controller type */ + +t_stat rx_settype (UNIT *uptr, int32 val, CONST char *cptr, void *desc) +{ +int32 i; + +if ((val < 0) || (val > 1) || (cptr != NULL)) + return SCPE_ARG; +if (val == rx_28) + return SCPE_OK; +for (i = 0; i < RX_NUMDR; i++) { + if (rx_unit[i].flags & UNIT_ATT) + return SCPE_ALATT; + } +for (i = 0; i < RX_NUMDR; i++) { + if (val) + rx_unit[i].flags = rx_unit[i].flags | UNIT_DEN | UNIT_AUTO; + else rx_unit[i].flags = rx_unit[i].flags & ~(UNIT_DEN | UNIT_AUTO); + rx_unit[i].capac = val? RX2_SIZE: RX_SIZE; + } +rx_28 = val; +return SCPE_OK; +} + +/* Show controller type */ + +t_stat rx_showtype (FILE *st, UNIT *uptr, int32 val, CONST void *desc) +{ +if (rx_28) fprintf (st, "RX28"); +else fprintf (st, "RX8E"); +return SCPE_OK; +} + +/* Bootstrap routine */ + +#define BOOT_START 022 +#define BOOT_ENTRY 022 +#define BOOT_INST 060 +#define BOOT_LEN (sizeof (boot_rom) / sizeof (int16)) +#define BOOT2_START 020 +#define BOOT2_ENTRY 033 +#define BOOT2_LEN (sizeof (boot2_rom) / sizeof (int16)) + +static const uint16 boot_rom[] = { + 06755, /* 22, SDN */ + 05022, /* 23, JMP .-1 */ + 07126, /* 24, CLL CML RTL ; read command + */ + 01060, /* 25, TAD UNIT ; unit no */ + 06751, /* 26, LCD ; load read+unit */ + 07201, /* 27, CLA IAC ; AC = 1 */ + 04053, /* 30, JMS LOAD ; load sector */ + 04053, /* 31, JMS LOAD ; load track */ + 07104, /* 32, CLL RAL ; AC = 2 */ + 06755, /* 33, SDN */ + 05054, /* 34, JMP LOAD+1 */ + 06754, /* 35, SER */ + 07450, /* 36, SNA ; more to do? */ + 07610, /* 37, CLA SKP ; error */ + 05046, /* 40, JMP 46 ; go empty */ + 07402, /* 41-45, HALT ; error */ + 07402, + 07402, + 07402, + 07402, + 06751, /* 46, LCD ; load empty */ + 04053, /* 47, JMS LOAD ; get data */ + 03002, /* 50, DCA 2 ; store */ + 02050, /* 51, ISZ 50 ; incr store */ + 05047, /* 52, JMP 47 ; loop until done */ + 00000, /* LOAD, 0 */ + 06753, /* 54, STR */ + 05033, /* 55, JMP 33 */ + 06752, /* 56, XDR */ + 05453, /* 57, JMP I LOAD */ + 07024, /* UNIT, CML RAL ; for unit 1 */ + 06030 /* 61, KCC */ + }; + +static const uint16 boot2_rom[] = { + 01061, /* READ, TAD UNIT ; next unit+den */ + 01046, /* 21, TAD CON360 ; add in 360 */ + 00060, /* 22, AND CON420 ; mask to 420 */ + 03061, /* 23, DCA UNIT ; 400,420,0,20... */ + 07327, /* 24, STL CLA IAC RTL ; AC = 6 = read */ + 01061, /* 25, TAD UNIT ; +unit+den */ + 06751, /* 26, LCD ; load cmd */ + 07201, /* 27, CLA IAC; ; AC = 1 = trksec */ + 04053, /* 30, JMS LOAD ; load trk */ + 04053, /* 31, JMS LOAD ; load sec */ + 07004, /* CN7004, RAL ; AC = 2 = empty */ + 06755, /* START, SDN ; done? */ + 05054, /* 34, JMP LOAD+1 ; check xfr */ + 06754, /* 35, SER ; error? */ + 07450, /* 36, SNA ; AC=0 on start */ + 05020, /* 37, JMP RD ; try next den,un */ + 01061, /* 40, TAD UNIT ; +unit+den */ + 06751, /* 41, LCD ; load cmd */ + 01061, /* 42, TAD UNIT ; set 60 for sec boot */ + 00046, /* 43, AND CON360 ; only density */ + 01032, /* 44, TAD CN7004 ; magic */ + 03060, /* 45, DCA 60 */ + 00360, /* CON360, 360 ; NOP */ + 04053, /* 47, JMS LOAD ; get data */ + 03002, /* 50, DCA 2 ; store */ + 02050, /* 51, ISZ .-1 ; incr store */ + 05047, /* 52, JMP .-3 ; loop until done */ + 00000, /* LOAD, 0 */ + 06753, /* 54, STR ; xfr ready? */ + 05033, /* 55, JMP 33 ; no, chk done */ + 06752, /* 56, XDR ; get word */ + 05453, /* 57, JMP I 53 ; return */ + 00420, /* CON420, 420 ; toggle */ + 00020 /* UNIT, 20 ; unit+density */ + }; + +t_stat rx_boot (int32 unitno, DEVICE *dptr) +{ +size_t i; +extern uint16 M[]; + +if (rx_dib.dev != DEV_RX) /* only std devno */ + return STOP_NOTSTD; +if (rx_28) { + for (i = 0; i < BOOT2_LEN; i++) + M[BOOT2_START + i] = boot2_rom[i]; + cpu_set_bootpc (BOOT2_ENTRY); + } +else { + for (i = 0; i < BOOT_LEN; i++) + M[BOOT_START + i] = boot_rom[i]; + M[BOOT_INST] = unitno? 07024: 07004; + cpu_set_bootpc (BOOT_ENTRY); + } +return SCPE_OK; +} ADDED src/PDP8/pdp8_sys.c Index: src/PDP8/pdp8_sys.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_sys.c @@ -0,0 +1,1015 @@ +/* pdp8_sys.c: PDP-8 simulator interface + + Copyright (c) 1993-2016, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + 15-Dec-16 RMS Added PKSTF (Dave Gesswein) + 17-Sep-13 RMS Fixed recognition of initial field change (Dave Gesswein) + 24-Mar-09 RMS Added link to FPP + 24-Jun-08 RMS Fixed bug in new rim loader (Don North) + 24-May-08 RMS Fixed signed/unsigned declaration inconsistency + 03-Sep-07 RMS Added FPP8 support + Rewrote rim and binary loaders + 15-Dec-06 RMS Added TA8E support, IOT disambiguation + 30-Oct-06 RMS Added infinite loop stop + 18-Oct-06 RMS Re-ordered device list + 17-Oct-03 RMS Added TSC8-75, TD8E support, DECtape off reel message + 25-Apr-03 RMS Revised for extended file support + 30-Dec-01 RMS Revised for new TTX + 26-Nov-01 RMS Added RL8A support + 17-Sep-01 RMS Removed multiconsole support + 16-Sep-01 RMS Added TSS/8 packed char support, added KL8A support + 27-May-01 RMS Added multiconsole support + 18-Mar-01 RMS Added DF32 support + 14-Mar-01 RMS Added extension detection of RIM binary tapes + 15-Feb-01 RMS Added DECtape support + 30-Oct-00 RMS Added support for examine to file + 27-Oct-98 RMS V2.4 load interface + 10-Apr-98 RMS Added RIM loader support + 17-Feb-97 RMS Fixed bug in handling of bin loader fields +*/ + +#include "pdp8_defs.h" +#include + +extern DEVICE cpu_dev; +extern UNIT cpu_unit; +extern DEVICE tsc_dev; +extern DEVICE fpp_dev; +extern DEVICE ptr_dev, ptp_dev; +extern DEVICE tti_dev, tto_dev; +extern DEVICE clk_dev, lpt_dev; +extern DEVICE rk_dev, rl_dev; +extern DEVICE rx_dev; +extern DEVICE df_dev, rf_dev; +extern DEVICE dt_dev, td_dev; +extern DEVICE mt_dev, ct_dev; +extern DEVICE ttix_dev, ttox_dev; +extern REG cpu_reg[]; +extern uint16 M[]; + +t_stat fprint_sym_fpp (FILE *of, t_value *val); +t_stat parse_sym_fpp (CONST char *cptr, t_value *val); +CONST char *parse_field (CONST char *cptr, uint32 max, uint32 *val, uint32 c); +CONST char *parse_fpp_xr (CONST char *cptr, uint32 *xr, t_bool inc); +int32 test_fpp_addr (uint32 ad, uint32 max); + +/* SCP data structures and interface routines + + sim_name simulator name string + sim_PC pointer to saved PC register descriptor + sim_emax maximum number of words for examine/deposit + sim_devices array of pointers to simulated devices + sim_consoles array of pointers to consoles (if more than one) + sim_stop_messages array of pointers to stop messages + sim_load binary loader +*/ + +char sim_name[] = "PDP-8"; + +REG *sim_PC = &cpu_reg[0]; + +int32 sim_emax = 4; + +DEVICE *sim_devices[] = { + &cpu_dev, + &tsc_dev, + &fpp_dev, + &clk_dev, + &ptr_dev, + &ptp_dev, + &tti_dev, + &tto_dev, + &ttix_dev, + &ttox_dev, + &lpt_dev, + &rk_dev, + &rl_dev, + &rx_dev, + &df_dev, + &rf_dev, + &dt_dev, + &td_dev, + &mt_dev, + &ct_dev, + NULL + }; + +const char *sim_stop_messages[] = { + "Unknown error", + "Unimplemented instruction", + "HALT instruction", + "Breakpoint", + "Opcode Breakpoint", + "Non-standard device number", + "DECtape off reel", + "Infinite loop" + }; + +/* Ambiguous device list - these devices have overlapped IOT codes */ + +DEVICE *amb_dev[] = { + &rl_dev, + &ct_dev, + &td_dev, + NULL + }; + +#define AMB_RL (1 << 12) +#define AMB_CT (2 << 12) +#define AMB_TD (3 << 12) + +/* RIM loader format consists of alternating pairs of addresses and 12-bit + words. It can only operate in field 0 and is not checksummed. +*/ + +t_stat sim_load_rim (FILE *fi) +{ +int32 origin, hi, lo, wd; + +origin = 0200; +do { /* skip leader */ + if ((hi = getc (fi)) == EOF) + return SCPE_FMT; + } while ((hi == 0) || (hi >= 0200)); +do { /* data block */ + if ((lo = getc (fi)) == EOF) + return SCPE_FMT; + wd = (hi << 6) | lo; + if (wd > 07777) + origin = wd & 07777; + else M[origin++ & 07777] = wd; + if ((hi = getc (fi)) == EOF) + return SCPE_FMT; + } while (hi < 0200); /* until trailer */ +return SCPE_OK; +} + +/* BIN loader format consists of a string of 12-bit words (made up from + 7-bit characters) between leader and trailer (200). The last word on + tape is the checksum. A word with the "link" bit set is a new origin; + a character > 0200 indicates a change of field. +*/ + +int32 sim_bin_getc (FILE *fi, uint32 *newf) +{ +int32 c, rubout; + +rubout = 0; /* clear toggle */ +while ((c = getc (fi)) != EOF) { /* read char */ + if (rubout) /* toggle set? */ + rubout = 0; /* clr, skip */ + else if (c == 0377) /* rubout? */ + rubout = 1; /* set, skip */ + else if (c > 0200) /* channel 8 set? */ + *newf = (c & 070) << 9; /* change field */ + else return c; /* otherwise ok */ + } +return EOF; +} + +t_stat sim_load_bin (FILE *fi) +{ +int32 hi, lo, wd, csum, t; +uint32 field, newf, origin; +int32 sections_read = 0; + +for (;;) { + csum = origin = field = newf = 0; /* init */ + do { /* skip leader */ + if ((hi = sim_bin_getc (fi, &newf)) == EOF) { + if (sections_read != 0) { + sim_printf ("%d sections sucessfully read\n\r", sections_read); + return SCPE_OK; + } + else + return SCPE_FMT; + } + } while ((hi == 0) || (hi >= 0200)); + for (;;) { /* data blocks */ + if ((lo = sim_bin_getc (fi, &newf)) == EOF) /* low char */ + return SCPE_FMT; + wd = (hi << 6) | lo; /* form word */ + t = hi; /* save for csum */ + if ((hi = sim_bin_getc (fi, &newf)) == EOF) /* next char */ + return SCPE_FMT; + if (hi == 0200) { /* end of tape? */ + if ((csum - wd) & 07777) { /* valid csum? */ + if (sections_read != 0) + sim_printf ("%d sections sucessfully read\n\r", sections_read); + return SCPE_CSUM; + } + if (!(sim_switches & SWMASK ('A'))) /* Load all sections? */ + return SCPE_OK; + sections_read++; + break; + } + csum = csum + t + lo; /* add to csum */ + if (wd > 07777) /* chan 7 set? */ + origin = wd & 07777; /* new origin */ + else { /* no, data */ + if ((field | origin) >= MEMSIZE) + return SCPE_NXM; + M[field | origin] = wd; + origin = (origin + 1) & 07777; + } + field = newf; /* update field */ + } + } +return SCPE_IERR; +} + +/* Binary loader + Two loader formats are supported: RIM loader (-r) and BIN (-b) loader. */ + +t_stat sim_load (FILE *fileref, CONST char *cptr, CONST char *fnam, int flag) +{ +if ((*cptr != 0) || (flag != 0)) + return SCPE_ARG; +if ((sim_switches & SWMASK ('R')) || /* RIM format? */ + (match_ext (fnam, "RIM") && !(sim_switches & SWMASK ('B')))) + return sim_load_rim (fileref); +else return sim_load_bin (fileref); /* no, BIN */ +} + +/* Symbol tables */ + +#define I_V_FL 18 /* flag start */ +#define I_M_FL 07 /* flag mask */ +#define I_V_NPN 0 /* no operand */ +#define I_V_FLD 1 /* field change */ +#define I_V_MRF 2 /* mem ref */ +#define I_V_IOT 3 /* general IOT */ +#define I_V_OP1 4 /* operate 1 */ +#define I_V_OP2 5 /* operate 2 */ +#define I_V_OP3 6 /* operate 3 */ +#define I_V_IOA 7 /* ambiguous IOT */ +#define I_NPN (I_V_NPN << I_V_FL) +#define I_FLD (I_V_FLD << I_V_FL) +#define I_MRF (I_V_MRF << I_V_FL) +#define I_IOT (I_V_IOT << I_V_FL) +#define I_OP1 (I_V_OP1 << I_V_FL) +#define I_OP2 (I_V_OP2 << I_V_FL) +#define I_OP3 (I_V_OP3 << I_V_FL) +#define I_IOA (I_V_IOA << I_V_FL) + +static const int32 masks[] = { + 07777, 07707, 07000, 07000, + 07416, 07571, 017457, 077777, + }; + +/* Ambiguous device mnemonics must precede default mnemonics */ + +static const char *opcode[] = { + "SKON", "ION", "IOF", "SRQ", /* std IOTs */ + "GTF", "RTF", "SGT", "CAF", + "RPE", "RSF", "RRB", "RFC", "RFC RRB", /* reader/punch */ + "PCE", "PSF", "PCF", "PPC", "PLS", + "KCF", "KSF", "KCC", "KRS", "KIE", "KRB", /* console */ + "TLF", "TSF", "TCF", "TPC", "SPI", "TLS", + "SBE", "SPL", "CAL", /* power fail */ + "CLEI", "CLDI", "CLSC", "CLLE", "CLCL", "CLSK", /* clock */ + "CINT", "RDF", "RIF", "RIB", /* mem mmgt */ + "RMF", "SINT", "CUF", "SUF", + "RLDC", "RLSD", "RLMA", "RLCA", /* RL - ambiguous */ + "RLCB", "RLSA", "RLWC", + "RRER", "RRWC", "RRCA", "RRCB", + "RRSA", "RRSI", "RLSE", + "KCLR", "KSDR", "KSEN", "KSBF", /* CT - ambiguous */ + "KLSA", "KSAF", "KGOA", "KRSB", + "SDSS", "SDST", "SDSQ", /* TD - ambiguous */ + "SDLC", "SDLD", "SDRC", "SDRD", + "ADCL", "ADLM", "ADST", "ADRB", /* A/D */ + "ADSK", "ADSE", "ADLE", "ADRS", + "DCMA", "DMAR", "DMAW", /* DF/RF */ + "DCIM", "DSAC", "DIML", "DIMA", + "DCEA", "DEAL", "DEAC", + "DFSE", "DFSC", "DISK", "DMAC", + "DCXA", "DXAL", "DXAC", + "PKSTF", "PSKF", "PCLF", "PSKE", /* LPT */ + "PSTB", "PSIE", "PCLF PSTB", "PCIE", + "LWCR", "CWCR", "LCAR", /* MT */ + "CCAR", "LCMR", "LFGR", "LDBR", + "RWCR", "CLT", "RCAR", + "RMSR", "RCMR", "RFSR", "RDBR", + "SKEF", "SKCB", "SKJD", "SKTR", "CLF", + "DSKP", "DCLR", "DLAG", /* RK */ + "DLCA", "DRST", "DLDC", "DMAN", + "LCD", "XDR", "STR", /* RX */ + "SER", "SDN", "INTR", "INIT", + "DTRA", "DTCA", "DTXA", "DTLA", /* DT */ + "DTSF", "DTRB", "DTLB", + "ETDS", "ESKP", "ECTF", "ECDF", /* TSC75 */ + "ERTB", "ESME", "ERIOT", "ETEN", + "FFST", "FPINT", "FPICL", "FPCOM", /* FPP8 */ + "FPHLT", "FPST", "FPRST", "FPIST", + "FMODE", "FMRB", + "FMRP", "FMDO", "FPEP", + + "CDF", "CIF", "CIF CDF", + "AND", "TAD", "ISZ", "DCA", "JMS", "JMP", "IOT", + "NOP", "NOP2", "NOP3", "SWAB", "SWBA", + "STL", "GLK", "STA", "LAS", "CIA", + "BSW", "RAL", "RTL", "RAR", "RTR", "RAL RAR", "RTL RTR", + "SKP", "SNL", "SZL", + "SZA", "SNA", "SZA SNL", "SNA SZL", + "SMA", "SPA", "SMA SNL", "SPA SZL", + "SMA SZA", "SPA SNA", "SMA SZA SNL", "SPA SNA SZL", + "SCL", "MUY", "DVI", "NMI", "SHL", "ASR", "LSR", + "SCA", "SCA SCL", "SCA MUY", "SCA DVI", + "SCA NMI", "SCA SHL", "SCA ASR", "SCA LSR", + "ACS", "MUY", "DVI", "NMI", "SHL", "ASR", "LSR", + "SCA", "DAD", "DST", "SWBA", + "DPSZ", "DPIC", "DCIM", "SAM", + "CLA", "CLL", "CMA", "CML", "IAC", /* encode only */ + "CLA", "OAS", "HLT", + "CLA", "MQA", "MQL", + NULL, NULL, NULL, NULL, /* decode only */ + NULL + }; + +static const int32 opc_val[] = { + 06000+I_NPN, 06001+I_NPN, 06002+I_NPN, 06003+I_NPN, + 06004+I_NPN, 06005+I_NPN, 06006+I_NPN, 06007+I_NPN, + 06010+I_NPN, 06011+I_NPN, 06012+I_NPN, 06014+I_NPN, 06016+I_NPN, + 06020+I_NPN, 06021+I_NPN, 06022+I_NPN, 06024+I_NPN, 06026+I_NPN, + 06030+I_NPN, 06031+I_NPN, 06032+I_NPN, 06034+I_NPN, 06035+I_NPN, 06036+I_NPN, + 06040+I_NPN, 06041+I_NPN, 06042+I_NPN, 06044+I_NPN, 06045+I_NPN, 06046+I_NPN, + 06101+I_NPN, 06102+I_NPN, 06103+I_NPN, + 06131+I_NPN, 06132+I_NPN, 06133+I_NPN, 06135+I_NPN, 06136+I_NPN, 06137+I_NPN, + 06204+I_NPN, 06214+I_NPN, 06224+I_NPN, 06234+I_NPN, + 06244+I_NPN, 06254+I_NPN, 06264+I_NPN, 06274+I_NPN, + 06600+I_IOA+AMB_RL, 06601+I_IOA+AMB_RL, 06602+I_IOA+AMB_RL, 06603+I_IOA+AMB_RL, + 06604+I_IOA+AMB_RL, 06605+I_IOA+AMB_RL, 06607+I_IOA+AMB_RL, + 06610+I_IOA+AMB_RL, 06611+I_IOA+AMB_RL, 06612+I_IOA+AMB_RL, 06613+I_IOA+AMB_RL, + 06614+I_IOA+AMB_RL, 06615+I_IOA+AMB_RL, 06617+I_IOA+AMB_RL, + 06700+I_IOA+AMB_CT, 06701+I_IOA+AMB_CT, 06702+I_IOA+AMB_CT, 06703+I_IOA+AMB_CT, + 06704+I_IOA+AMB_CT, 06705+I_IOA+AMB_CT, 06706+I_IOA+AMB_CT, 06707+I_IOA+AMB_CT, + 06771+I_IOA+AMB_TD, 06772+I_IOA+AMB_TD, 06773+I_IOA+AMB_TD, + 06774+I_IOA+AMB_TD, 06775+I_IOA+AMB_TD, 06776+I_IOA+AMB_TD, 06777+I_IOA+AMB_TD, + 06530+I_NPN, 06531+I_NPN, 06532+I_NPN, 06533+I_NPN, /* AD */ + 06534+I_NPN, 06535+I_NPN, 06536+I_NPN, 06537+I_NPN, + 06660+I_NPN, 06601+I_NPN, 06603+I_NPN, 06605+I_NPN, /* DF/RF */ + 06611+I_NPN, 06612+I_NPN, 06615+I_NPN, 06616+I_NPN, + 06611+I_NPN, 06615+I_NPN, 06616+I_NPN, + 06621+I_NPN, 06622+I_NPN, 06623+I_NPN, 06626+I_NPN, + 06641+I_NPN, 06643+I_NPN, 06645+I_NPN, + 06661+I_NPN, 06662+I_NPN, 06663+I_NPN, /* LPT */ + 06664+I_NPN, 06665+I_NPN, 06666+I_NPN, 06667+I_NPN, + 06701+I_NPN, 06702+I_NPN, 06703+I_NPN, /* MT */ + 06704+I_NPN, 06705+I_NPN, 06706+I_NPN, 06707+I_NPN, + 06711+I_NPN, 06712+I_NPN, 06713+I_NPN, + 06714+I_NPN, 06715+I_NPN, 06716+I_NPN, 06717+I_NPN, + 06721+I_NPN, 06722+I_NPN, 06723+I_NPN, 06724+I_NPN, 06725+I_NPN, + 06741+I_NPN, 06742+I_NPN, 06743+I_NPN, /* RK */ + 06744+I_NPN, 06745+I_NPN, 06746+I_NPN, 06747+I_NPN, + 06751+I_NPN, 06752+I_NPN, 06753+I_NPN, /* RX */ + 06754+I_NPN, 06755+I_NPN, 06756+I_NPN, 06757+I_NPN, + 06761+I_NPN, 06762+I_NPN, 06764+I_NPN, 06766+I_NPN, /* DT */ + 06771+I_NPN, 06772+I_NPN, 06774+I_NPN, + 06360+I_NPN, 06361+I_NPN, 06362+I_NPN, 06363+I_NPN, /* TSC */ + 06364+I_NPN, 06365+I_NPN, 06366+I_NPN, 06367+I_NPN, + 06550+I_NPN, 06551+I_NPN, 06552+I_NPN, 06553+I_NPN, /* FPP8 */ + 06554+I_NPN, 06555+I_NPN, 06556+I_NPN, 06557+I_NPN, + 06561+I_NPN, 06563+I_NPN, + 06564+I_NPN, 06565+I_NPN, 06567+I_NPN, + + 06201+I_FLD, 06202+I_FLD, 06203+I_FLD, + 00000+I_MRF, 01000+I_MRF, 02000+I_MRF, 03000+I_MRF, + 04000+I_MRF, 05000+I_MRF, 06000+I_IOT, + 07000+I_NPN, 07400+I_NPN, 07401+I_NPN, 07431+I_NPN, 07447+I_NPN, + 07120+I_NPN, 07204+I_NPN, 07240+I_NPN, 07604+I_NPN, 07041+I_NPN, + 07002+I_OP1, 07004+I_OP1, 07006+I_OP1, + 07010+I_OP1, 07012+I_OP1, 07014+I_OP1, 07016+I_OP1, + 07410+I_OP2, 07420+I_OP2, 07430+I_OP2, + 07440+I_OP2, 07450+I_OP2, 07460+I_OP2, 07470+I_OP2, + 07500+I_OP2, 07510+I_OP2, 07520+I_OP2, 07530+I_OP2, + 07540+I_OP2, 07550+I_OP2, 07560+I_OP2, 07570+I_OP2, + 07403+I_OP3, 07405+I_OP3, 07407+I_OP3, + 07411+I_OP3, 07413+I_OP3, 07415+I_OP3, 07417+I_OP3, + 07441+I_OP3, 07443+I_OP3, 07445+I_OP3, 07447+I_OP3, + 07451+I_OP3, 07453+I_OP3, 07455+I_OP3, 07457+I_OP3, + 017403+I_OP3, 017405+I_OP3, 0174017+I_OP3, + 017411+I_OP3, 017413+I_OP3, 017415+I_OP3, 017417+I_OP3, + 017441+I_OP3, 017443+I_OP3, 017445+I_OP3, 017447+I_OP3, + 017451+I_OP3, 017453+I_OP3, 017455+I_OP3, 017457+I_OP3, + 07200+I_OP1, 07100+I_OP1, 07040+I_OP1, 07020+I_OP1, 07001+I_OP1, + 07600+I_OP2, 07404+I_OP2, 07402+I_OP2, + 07601+I_OP3, 07501+I_OP3, 07421+I_OP3, + 07000+I_OP1, 07400+I_OP2, 07401+I_OP3, 017401+I_OP3, + -1 + }; + +/* Symbol tables for FPP-8 */ + +#define F_V_FL 18 /* flag start */ +#define F_M_FL 017 /* flag mask */ +#define F_V_NOP12 0 /* no opnd 12b */ +#define F_V_NOP9 1 /* no opnd 9b */ +#define F_V_AD15 2 /* 15b dir addr */ +#define F_V_AD15X 3 /* 15b dir addr indx */ +#define F_V_IMMX 4 /* 12b immm indx */ +#define F_V_X 5 /* index */ +#define F_V_MRI 6 /* mem ref ind */ +#define F_V_MR1D 7 /* mem ref dir 1 word */ +#define F_V_MR2D 8 /* mem ref dir 2 word */ +#define F_V_LEMU 9 /* LEA/IMUL */ +#define F_V_LEMUI 10 /* LEAI/IMULI */ +#define F_V_LTR 11 /* LTR */ +#define F_V_MRD 12 /* mem ref direct (enc) */ +#define F_NOP12 (F_V_NOP12 << F_V_FL) +#define F_NOP9 (F_V_NOP9 << F_V_FL) +#define F_AD15 (F_V_AD15 << F_V_FL) +#define F_AD15X (F_V_AD15X << F_V_FL) +#define F_IMMX (F_V_IMMX << F_V_FL) +#define F_X (F_V_X << F_V_FL) +#define F_MRI (F_V_MRI << F_V_FL) +#define F_MR1D (F_V_MR1D << F_V_FL) +#define F_MR2D (F_V_MR2D << F_V_FL) +#define F_LEMU (F_V_LEMU << F_V_FL) +#define F_LEMUI (F_V_LEMUI << F_V_FL) +#define F_LTR (F_V_LTR << F_V_FL) +#define F_MRD (F_V_MRD << F_V_FL) + +static const uint32 fmasks[] = { + 07777, 07770, 07770, 07600, + 07770, 07770, 07600, 07600, + 07600, 017600, 017600, 07670, + 07777 + }; + +/* Memory references are encode dir / decode 1D / decode 2D / indirect */ + +static const char *fopcode[] = { + "FEXIT", "FPAUSE", "FCLA", "FNEG", + "FNORM", "STARTF", "STARTD", "JAC", + "ALN", "ATX", "XTA", + "FNOP", "STARTE", + "LDX", "ADDX", + "FLDA", "FLDA", "FLDA", "FLDAI", + "JEQ", "JGE", "JLE", "JA", + "JNE", "JLT", "JGT", "JAL", + "SETX", "SETB", "JSA", "JSR", + "FADD", "FADD", "FADD", "FADDI", + "JNX", + "FSUB", "FSUB", "FSUB", "FSUBI", + "TRAP3", + "FDIV", "FDIV", "FDIV", "FDIVI", + "TRAP4", + "FMUL", "FMUL", "FMUL", "FMULI", + "LTREQ", "LTRGE", "LTRLE", "LTRA", + "LTRNE", "LTRLT", "LTRGT", "LTRAL", + "FADDM", "FADDM", "FADDM", "FADDMI", + "IMUL", "LEA", + "FSTA", "FSTA", "FSTA", "FSTAI", + "IMULI", "LEAI", + "FMULM", "FMULM", "FMULM", "FMULMI", + NULL + }; + +static const int32 fop_val[] = { + 00000+F_NOP12, 00001+F_NOP12, 00002+F_NOP12, 00003+F_NOP12, + 00004+F_NOP12, 00005+F_NOP12, 00006+F_NOP12, 00007+F_NOP12, + 00010+F_X, 00020+F_X, 00030+F_X, + 00040+F_NOP9, 00050+F_NOP9, + 00100+F_IMMX, 00110+F_IMMX, + 00000+F_MRD, 00200+F_MR1D, 00400+F_MR2D, 00600+F_MRI, + 01000+F_AD15, 01010+F_AD15, 01020+F_AD15, 01030+F_AD15, + 01040+F_AD15, 01050+F_AD15, 01060+F_AD15, 01070+F_AD15, + 01100+F_AD15, 01110+F_AD15, 01120+F_AD15, 01130+F_AD15, + 01000+F_MRD, 01200+F_MR1D, 01400+F_MR2D, 01600+F_MRI, + 02000+F_AD15X, + 02000+F_MRD, 02200+F_MR1D, 02400+F_MR2D, 02600+F_MRI, + 03000+F_AD15, + 03000+F_MRD, 03200+F_MR1D, 03400+F_MR2D, 03600+F_MRI, + 04000+F_AD15, + 04000+F_MRD, 04200+F_MR1D, 04400+F_MR2D, 04600+F_MRI, + 05000+F_LTR, 05010+F_LTR, 05020+F_LTR, 05030+F_LTR, + 05040+F_LTR, 05050+F_LTR, 05060+F_LTR, 05070+F_LTR, + 05000+F_MRD, 05200+F_MR1D, 05400+F_MR2D, 05600+F_MRI, + 016000+F_LEMU, 006000+F_LEMU, + 06000+F_MRD, 06200+F_MR1D, 06400+F_MR2D, 06600+F_MRI, + 017000+F_LEMUI, 007000+F_LEMUI, + 07000+F_MRD, 07200+F_MR1D, 07400+F_MR2D, 07600+F_MRI, + -1 + }; + +/* Operate decode + + Inputs: + *of = output stream + inst = mask bits + Class = instruction class code + sp = space needed? + Outputs: + status = space needed +*/ + +int32 fprint_opr (FILE *of, int32 inst, int32 Class, int32 sp) +{ +int32 i, j; + +for (i = 0; opc_val[i] >= 0; i++) { /* loop thru ops */ + j = (opc_val[i] >> I_V_FL) & I_M_FL; /* get class */ + if ((j == Class) && (opc_val[i] & inst)) { /* same class? */ + inst = inst & ~opc_val[i]; /* mask bit set? */ + fprintf (of, (sp? " %s": "%s"), opcode[i]); + sp = 1; + } + } +return sp; +} + +/* Symbolic decode + + Inputs: + *of = output stream + addr = current PC + *val = pointer to data + *uptr = pointer to unit + sw = switches + Outputs: + return = status code +*/ + +#define FMTASC(x) ((x) < 040)? "<%03o>": "%c", (x) +#define SIXTOASC(x) (((x) >= 040)? (x): (x) + 0100) +#define TSSTOASC(x) ((x) + 040) + +t_stat fprint_sym (FILE *of, t_addr addr, t_value *val, + UNIT *uptr, int32 sw) +{ +int32 cflag, i, j, sp, inst, disp, opc; +extern int32 emode; +t_stat r; + +cflag = (uptr == NULL) || (uptr == &cpu_unit); +inst = val[0]; +if (sw & SWMASK ('A')) { /* ASCII? */ + if (inst > 0377) + return SCPE_ARG; + fprintf (of, FMTASC (inst & 0177)); + return SCPE_OK; + } +if (sw & SWMASK ('C')) { /* characters? */ + fprintf (of, "%c", SIXTOASC ((inst >> 6) & 077)); + fprintf (of, "%c", SIXTOASC (inst & 077)); + return SCPE_OK; + } +if (sw & SWMASK ('T')) { /* TSS8 packed? */ + fprintf (of, "%c", TSSTOASC ((inst >> 6) & 077)); + fprintf (of, "%c", TSSTOASC (inst & 077)); + return SCPE_OK; + } +if ((sw & SWMASK ('F')) && /* FPP8? */ + ((r = fprint_sym_fpp (of, val)) != SCPE_ARG)) + return r; +if (!(sw & SWMASK ('M'))) + return SCPE_ARG; + +/* Instruction decode */ + +opc = (inst >> 9) & 07; /* get major opcode */ +if (opc == 07) /* operate? */ + inst = inst | ((emode & 1) << 12); /* include EAE mode */ +if (opc == 06) { /* IOT? */ + DEVICE *dptr; + DIB *dibp; + uint32 dno = (inst >> 3) & 077; + for (i = 0; (dptr = amb_dev[i]) != NULL; i++) { /* check amb devices */ + if ((dptr->ctxt == NULL) || /* no DIB or */ + (dptr->flags & DEV_DIS)) continue; /* disabled? skip */ + dibp = (DIB *) dptr->ctxt; /* get DIB */ + if ((dno >= dibp->dev) || /* IOT for this dev? */ + (dno < (dibp->dev + dibp->num))) { + inst = inst | ((i + 1) << 12); /* disambiguate */ + break; /* done */ + } + } + } + +for (i = 0; opc_val[i] >= 0; i++) { /* loop thru ops */ + j = (opc_val[i] >> I_V_FL) & I_M_FL; /* get class */ + if ((opc_val[i] & 077777) == (inst & masks[j])) { /* match? */ + + switch (j) { /* case on class */ + + case I_V_NPN: case I_V_IOA: /* no operands */ + fprintf (of, "%s", opcode[i]); /* opcode */ + break; + + case I_V_FLD: /* field change */ + fprintf (of, "%s %-o", opcode[i], (inst >> 3) & 07); + break; + + case I_V_MRF: /* mem ref */ + disp = inst & 0177; /* displacement */ + fprintf (of, "%s%s", opcode[i], ((inst & 00400)? " I ": " ")); + if (inst & 0200) { /* current page? */ + if (cflag) + fprintf (of, "%-o", (addr & 07600) | disp); + else fprintf (of, "C %-o", disp); + } + else fprintf (of, "%-o", disp); /* page zero */ + break; + + case I_V_IOT: /* IOT */ + fprintf (of, "%s %-o", opcode[i], inst & 0777); + break; + + case I_V_OP1: /* operate group 1 */ + sp = fprint_opr (of, inst & 0361, j, 0); + if (opcode[i]) + fprintf (of, (sp? " %s": "%s"), opcode[i]); + break; + + case I_V_OP2: /* operate group 2 */ + if (opcode[i]) + fprintf (of, "%s", opcode[i]); /* skips */ + fprint_opr (of, inst & 0206, j, opcode[i] != NULL); + break; + + case I_V_OP3: /* operate group 3 */ + sp = fprint_opr (of, inst & 0320, j, 0); + if (opcode[i]) + fprintf (of, (sp? " %s": "%s"), opcode[i]); + break; + } /* end case */ + + return SCPE_OK; + } /* end if */ + } /* end for */ +return SCPE_ARG; +} + +/* Symbolic input + + Inputs: + *cptr = pointer to input string + addr = current PC + *uptr = pointer to unit + *val = pointer to output values + sw = switches + Outputs: + status = error status +*/ + +t_stat parse_sym (CONST char *cptr, t_addr addr, UNIT *uptr, t_value *val, int32 sw) +{ +uint32 cflag, d, i, j, k; +t_stat r; +char gbuf[CBUFSIZE]; + +cflag = (uptr == NULL) || (uptr == &cpu_unit); +while (isspace (*cptr)) cptr++; /* absorb spaces */ +if ((sw & SWMASK ('A')) || ((*cptr == '\'') && cptr++)) { /* ASCII char? */ + if (cptr[0] == 0) /* must have 1 char */ + return SCPE_ARG; + val[0] = (t_value) cptr[0] | 0200; + return SCPE_OK; + } +if ((sw & SWMASK ('C')) || ((*cptr == '"') && cptr++)) { /* sixbit string? */ + if (cptr[0] == 0) /* must have 1 char */ + return SCPE_ARG; + val[0] = (((t_value) cptr[0] & 077) << 6) | + ((t_value) cptr[1] & 077); + return SCPE_OK; + } +if ((sw & SWMASK ('T')) || ((*cptr == '"') && cptr++)) { /* TSS8 string? */ + if (cptr[0] == 0) /* must have 1 char */ + return SCPE_ARG; + val[0] = (((t_value) (cptr[0] - 040) & 077) << 6) | + ((t_value) (cptr[1] - 040) & 077); + return SCPE_OK; + } +if ((r = parse_sym_fpp (cptr, val)) != SCPE_ARG) /* FPP8 inst? */ + return r; + +/* Instruction parse */ + +cptr = get_glyph (cptr, gbuf, 0); /* get opcode */ +for (i = 0; (opcode[i] != NULL) && (strcmp (opcode[i], gbuf) != 0) ; i++) ; +if (opcode[i] == NULL) + return SCPE_ARG; +val[0] = opc_val[i] & 07777; /* get value */ +j = (opc_val[i] >> I_V_FL) & I_M_FL; /* get class */ + +switch (j) { /* case on class */ + + case I_V_IOT: /* IOT */ + if ((cptr = parse_field (cptr, 0777, &d, 0)) == NULL) + return SCPE_ARG; /* get dev+pulse */ + val[0] = val[0] | d; + break; + + case I_V_FLD: /* field */ + for (cptr = get_glyph (cptr, gbuf, 0); gbuf[0] != 0; + cptr = get_glyph (cptr, gbuf, 0)) { + for (i = 0; (opcode[i] != NULL) && + (strcmp (opcode[i], gbuf) != 0) ; i++) ; + if (opcode[i] != NULL) { + k = (opc_val[i] >> I_V_FL) & I_M_FL; + if (k != j) + return SCPE_ARG; + val[0] = val[0] | (opc_val[i] & 07777); + } + else { + d = get_uint (gbuf, 8, 07, &r); + if (r != SCPE_OK) + return SCPE_ARG; + val[0] = val[0] | (d << 3); + break; + } + } + break; + + case I_V_MRF: /* mem ref */ + cptr = get_glyph (cptr, gbuf, 0); /* get next field */ + if (strcmp (gbuf, "I") == 0) { /* indirect? */ + val[0] = val[0] | 0400; + cptr = get_glyph (cptr, gbuf, 0); + } + if ((k = (strcmp (gbuf, "C") == 0)) || (strcmp (gbuf, "Z") == 0)) { + if ((cptr = parse_field (cptr, 0177, &d, 0)) == NULL) + return SCPE_ARG; + val[0] = val[0] | d | (k? 0200: 0); + } + else { + d = get_uint (gbuf, 8, 07777, &r); + if (r != SCPE_OK) + return SCPE_ARG; + if (d <= 0177) + val[0] = val[0] | d; + else if (cflag && (((addr ^ d) & 07600) == 0)) + val[0] = val[0] | (d & 0177) | 0200; + else return SCPE_ARG; + } + break; + + case I_V_OP1: case I_V_OP2: case I_V_OP3: /* operates */ + case I_V_NPN: case I_V_IOA: + for (cptr = get_glyph (cptr, gbuf, 0); gbuf[0] != 0; + cptr = get_glyph (cptr, gbuf, 0)) { + for (i = 0; (opcode[i] != NULL) && + (strcmp (opcode[i], gbuf) != 0) ; i++) ; + k = opc_val[i] & 07777; + if ((opcode[i] == NULL) || (((k ^ val[0]) & 07000) != 0)) + return SCPE_ARG; + val[0] = val[0] | k; + } + break; + } /* end case */ + +if (*cptr != 0) return SCPE_ARG; /* junk at end? */ +return SCPE_OK; +} + +/* FPP8 instruction decode */ + +t_stat fprint_sym_fpp (FILE *of, t_value *val) +{ +uint32 wd1, wd2, xr4b, xr3b, ad15; +uint32 i, j; +extern uint32 fpp_bra, fpp_cmd; + +wd1 = (uint32) val[0] | ((fpp_cmd & 04000) << 1); +wd2 = (uint32) val[1]; +xr4b = (wd1 >> 3) & 017; +xr3b = wd1 & 07; +ad15 = (xr3b << 12) | wd2; + +for (i = 0; fop_val[i] >= 0; i++) { /* loop thru ops */ + j = (fop_val[i] >> F_V_FL) & F_M_FL; /* get class */ + if ((fop_val[i] & 017777) == (wd1 & fmasks[j])) { /* match? */ + + switch (j) { /* case on class */ + case F_V_NOP12: + case F_V_NOP9: + case F_V_LTR: /* no operands */ + fprintf (of, "%s", fopcode[i]); + break; + + case F_V_X: /* index */ + fprintf (of, "%s %o", fopcode[i], xr3b); + break; + + case F_V_IMMX: /* index imm */ + fprintf (of, "%s %-o,%o", fopcode[i], wd2, xr3b); + return -1; /* extra word */ + + case F_V_AD15: /* 15b address */ + fprintf (of, "%s %-o", fopcode[i], ad15); + return -1; /* extra word */ + + case F_V_AD15X: /* 15b addr, indx */ + fprintf (of, "%s %-o", fopcode[i], ad15); + if (xr4b >= 010) + fprintf (of, ",%o+", xr4b & 7); + else fprintf (of, ",%o", xr4b); + return -1; /* extra word */ + + case F_V_MR1D: /* 1 word direct */ + ad15 = (fpp_bra + (3 * (wd1 & 0177))) & ADDRMASK; + fprintf (of, "%s %-o", fopcode[i], ad15); + break; + + case F_V_LEMU: + case F_V_MR2D: /* 2 word direct */ + fprintf (of, "%s %-o", fopcode[i], ad15); + if (xr4b >= 010) + fprintf (of, ",%o+", xr4b & 7); + else if (xr4b != 0) + fprintf (of, ",%o", xr4b); + return -1; /* extra word */ + + case F_V_LEMUI: + case F_V_MRI: /* indirect */ + ad15 = (fpp_bra + (3 * xr3b)) & ADDRMASK; + fprintf (of, "%s %-o", fopcode[i], ad15); + if (xr4b >= 010) + fprintf (of, ",%o+", xr4b & 7); + else if (xr4b != 0) + fprintf (of, ",%o", xr4b); + break; + + case F_V_MRD: /* encode only */ + return SCPE_IERR; + } + + return SCPE_OK; + } /* end if */ + } /* end for */ +return SCPE_ARG; +} + +/* FPP8 instruction parse */ + +t_stat parse_sym_fpp (CONST char *cptr, t_value *val) +{ +uint32 i, j, ad, xr; +int32 broff, nwd; +char gbuf[CBUFSIZE]; + +cptr = get_glyph (cptr, gbuf, 0); /* get opcode */ +for (i = 0; (fopcode[i] != NULL) && (strcmp (fopcode[i], gbuf) != 0) ; i++) ; +if (fopcode[i] == NULL) return SCPE_ARG; +val[0] = fop_val[i] & 07777; /* get value */ +j = (fop_val[i] >> F_V_FL) & F_M_FL; /* get class */ +xr = 0; +nwd = 0; + +switch (j) { /* case on class */ + + case F_V_NOP12: + case F_V_NOP9: + case F_V_LTR: /* no operands */ + break; + + case F_V_X: /* 3b XR */ + if ((cptr = parse_field (cptr, 07, &xr, 0)) == NULL) + return SCPE_ARG; + val[0] |= xr; + break; + + case F_V_IMMX: /* 12b, XR */ + if ((cptr = parse_field (cptr, 07777, &ad, ',')) == NULL) + return SCPE_ARG; + if ((*cptr == 0) || + ((cptr = parse_fpp_xr (cptr, &xr, FALSE)) == NULL)) + return SCPE_ARG; + val[0] |= xr; + val[++nwd] = ad; + break; + + case F_V_AD15: /* 15b addr */ + if ((cptr = parse_field (cptr, 077777, &ad, 0)) == NULL) + return SCPE_ARG; + val[0] |= (ad >> 12) & 07; + val[++nwd] = ad & 07777; + break; + + case F_V_AD15X: /* 15b addr, idx */ + if ((cptr = parse_field (cptr, 077777, &ad, ',')) == NULL) + return SCPE_ARG; + if ((*cptr == 0) || + ((cptr = parse_fpp_xr (cptr, &xr, FALSE)) == NULL)) + return SCPE_ARG; + val[0] |= ((xr << 3) | ((ad >> 12) & 07)); + val[++nwd] = ad & 07777; + break; + + case F_V_LEMUI: + case F_V_MRI: /* indirect */ + if ((cptr = parse_field (cptr, 077777, &ad, ',')) == NULL) + return SCPE_ARG; + if ((*cptr != 0) && + ((cptr = parse_fpp_xr (cptr, &xr, TRUE)) == NULL)) + return SCPE_ARG; + if ((broff = test_fpp_addr (ad, 07)) < 0) + return SCPE_ARG; + val[0] |= ((xr << 3) | broff); + break; + + case F_V_MRD: /* direct */ + if ((cptr = parse_field (cptr, 077777, &ad, ',')) == NULL) + return SCPE_ARG; + if (((broff = test_fpp_addr (ad, 0177)) < 0) || + (*cptr != 0)) { + if ((*cptr != 0) && + ((cptr = parse_fpp_xr (cptr, &xr, TRUE)) == NULL)) + return SCPE_ARG; + val[0] |= (00400 | (xr << 3) | ((ad >> 12) & 07)); + val[++nwd] = ad & 07777; + } + else val[0] |= (00200 | broff); + break; + + case F_V_LEMU: + if ((cptr = parse_field (cptr, 077777, &ad, ',')) == NULL) + return SCPE_ARG; + if ((*cptr != 0) && + ((cptr = parse_fpp_xr (cptr, &xr, TRUE)) == NULL)) + return SCPE_ARG; + val[0] |= ((xr << 3) | ((ad >> 12) & 07)); + val[++nwd] = ad & 07777; + break; + + case F_V_MR1D: + case F_V_MR2D: + return SCPE_IERR; + } /* end case */ + +if (*cptr != 0) return SCPE_ARG; /* junk at end? */ +return -nwd; +} + +/* Parse field */ + +CONST char *parse_field (CONST char *cptr, uint32 max, uint32 *val, uint32 c) +{ +char gbuf[CBUFSIZE]; +t_stat r; + +cptr = get_glyph (cptr, gbuf, c); /* get field */ +*val = get_uint (gbuf, 8, max, &r); +if (r != SCPE_OK) + return NULL; +return cptr; +} + +/* Parse index register */ + +CONST char *parse_fpp_xr (CONST char *cptr, uint32 *xr, t_bool inc) +{ +char gbuf[CBUFSIZE]; +uint32 len; +t_stat r; + +cptr = get_glyph (cptr, gbuf, 0); /* get field */ +len = strlen (gbuf); +if (gbuf[len - 1] == '+') { + if (!inc) + return NULL; + gbuf[len - 1] = 0; + *xr = 010; + } +else *xr = 0; +*xr += get_uint (gbuf, 8, 7, &r); +if (r != SCPE_OK) + return NULL; +return cptr; +} + +/* Test address in range of base register */ + +int32 test_fpp_addr (uint32 ad, uint32 max) +{ +uint32 off; +extern uint32 fpp_bra; + +off = ad - fpp_bra; +if (((off % 3) != 0) || + (off > (max * 3))) + return -1; +return ((int32) off / 3); +} ADDED src/PDP8/pdp8_td.c Index: src/PDP8/pdp8_td.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_td.c @@ -0,0 +1,955 @@ +/* pdp8_td.c: PDP-8 simple DECtape controller (TD8E) simulator + + Copyright (c) 1993-2013, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + This module was inspired by Gerold Pauler's TD8E simulator for Doug Jones' + PDP8 simulator but tracks the hardware implementation more closely. + + td TD8E/TU56 DECtape + + 17-Sep-13 RMS Changed to use central set_bootpc routine + 23-Mar-11 RMS Fixed SDLC to clear AC (from Dave Gesswein) + 23-Jun-06 RMS Fixed switch conflict in ATTACH + 16-Aug-05 RMS Fixed C++ declaration and cast problems + 09-Jan-04 RMS Changed sim_fsize calling sequence, added STOP_OFFR + + PDP-8 DECtapes are represented in memory by fixed length buffer of 12b words. + Three file formats are supported: + + 18b/36b 256 words per block [256 x 18b] + 16b 256 words per block [256 x 16b] + 12b 129 words per block [129 x 12b] + + When a 16b or 18/36b DECtape file is read in, it is converted to 12b format. + + DECtape motion is measured in 3b lines. Time between lines is 33.33us. + Tape density is nominally 300 lines per inch. The format of a DECtape (as + taken from the TD8E formatter) is: + + reverse end zone 8192 reverse end zone codes ~ 10 feet + reverse buffer 200 interblock codes + block 0 + : + block n + forward buffer 200 interblock codes + forward end zone 8192 forward end zone codes ~ 10 feet + + A block consists of five 18b header words, a tape-specific number of data + words, and five 18b trailer words. All systems except the PDP-8 use a + standard block length of 256 words; the PDP-8 uses a standard block length + of 86 words (x 18b = 129 words x 12b). + + Because a DECtape file only contains data, the simulator cannot support + write timing and mark track and can only do a limited implementation + of non-data words. Read assumes that the tape has been conventionally + written forward: + + header word 0 0 + header word 1 block number (for forward reads) + header words 2,3 0 + header word 4 checksum (for reverse reads) + : + trailer word 4 checksum (for forward reads) + trailer words 3,2 0 + trailer word 1 block number (for reverse reads) + trailer word 0 0 + + Write modifies only the data words and dumps the non-data words in the + bit bucket. +*/ + +#include "pdp8_defs.h" + +#define DT_NUMDR 2 /* #drives */ +#define UNIT_V_WLK (UNIT_V_UF + 0) /* write locked */ +#define UNIT_V_8FMT (UNIT_V_UF + 1) /* 12b format */ +#define UNIT_V_11FMT (UNIT_V_UF + 2) /* 16b format */ +#define UNIT_WLK (1 << UNIT_V_WLK) +#define UNIT_8FMT (1 << UNIT_V_8FMT) +#define UNIT_11FMT (1 << UNIT_V_11FMT) +#define STATE u3 /* unit state */ +#define LASTT u4 /* last time update */ +#define WRITTEN u5 /* device buffer is dirty and needs flushing */ +#define UNIT_WPRT (UNIT_WLK | UNIT_RO) /* write protect */ + +/* System independent DECtape constants */ + +#define DT_LPERMC 6 /* lines per mark track */ +#define DT_EZLIN (8192 * DT_LPERMC) /* end zone length */ +#define DT_BFLIN (200 * DT_LPERMC) /* end zone buffer */ +#define DT_HTLIN (5 * DT_LPERMC) /* lines per hdr/trlr */ + +/* 16b, 18b, 36b DECtape constants */ + +#define D18_WSIZE 6 /* word size in lines */ +#define D18_BSIZE 384 /* block size in 12b */ +#define D18_TSIZE 578 /* tape size */ +#define D18_LPERB (DT_HTLIN + (D18_BSIZE * DT_WSIZE) + DT_HTLIN) +#define D18_FWDEZ (DT_EZLIN + (D18_LPERB * D18_TSIZE)) +#define D18_CAPAC (D18_TSIZE * D18_BSIZE) /* tape capacity */ + +#define D18_NBSIZE ((D18_BSIZE * D8_WSIZE) / D18_WSIZE) +#define D18_FILSIZ (D18_NBSIZE * D18_TSIZE * sizeof (int32)) +#define D11_FILSIZ (D18_NBSIZE * D18_TSIZE * sizeof (int16)) + +/* 12b DECtape constants */ + +#define D8_WSIZE 4 /* word size in lines */ +#define D8_BSIZE 129 /* block size in 12b */ +#define D8_TSIZE 1474 /* tape size */ +#define D8_LPERB (DT_HTLIN + (D8_BSIZE * DT_WSIZE) + DT_HTLIN) +#define D8_FWDEZ (DT_EZLIN + (D8_LPERB * D8_TSIZE)) +#define D8_CAPAC (D8_TSIZE * D8_BSIZE) /* tape capacity */ +#define D8_FILSIZ (D8_CAPAC * sizeof (int16)) + +/* This controller */ + +#define DT_CAPAC D8_CAPAC /* default */ +#define DT_WSIZE D8_WSIZE + +/* Calculated constants, per unit */ + +#define DTU_BSIZE(u) (((u)->flags & UNIT_8FMT)? D8_BSIZE: D18_BSIZE) +#define DTU_TSIZE(u) (((u)->flags & UNIT_8FMT)? D8_TSIZE: D18_TSIZE) +#define DTU_LPERB(u) (((u)->flags & UNIT_8FMT)? D8_LPERB: D18_LPERB) +#define DTU_FWDEZ(u) (((u)->flags & UNIT_8FMT)? D8_FWDEZ: D18_FWDEZ) +#define DTU_CAPAC(u) (((u)->flags & UNIT_8FMT)? D8_CAPAC: D18_CAPAC) + +#define DT_LIN2BL(p,u) (((p) - DT_EZLIN) / DTU_LPERB (u)) +#define DT_LIN2OF(p,u) (((p) - DT_EZLIN) % DTU_LPERB (u)) + +/* Command register */ + +#define TDC_UNIT 04000 /* unit select */ +#define TDC_FWDRV 02000 /* fwd/rev */ +#define TDC_STPGO 01000 /* stop/go */ +#define TDC_RW 00400 /* read/write */ +#define TDC_MASK 07400 /* implemented */ +#define TDC_GETUNIT(x) (((x) & TDC_UNIT)? 1: 0) + +/* Status register */ + +#define TDS_WLO 00200 /* write lock */ +#define TDS_TME 00100 /* timing/sel err */ + +/* Mark track register and codes */ + +#define MTK_MASK 077 +#define MTK_REV_END 055 /* rev end zone */ +#define MTK_INTER 025 /* interblock */ +#define MTK_FWD_BLK 026 /* fwd block */ +#define MTK_REV_GRD 032 /* reverse guard */ +#define MTK_FWD_PRE 010 /* lock, etc */ +#define MTK_DATA 070 /* data */ +#define MTK_REV_PRE 073 /* lock, etc */ +#define MTK_FWD_GRD 051 /* fwd guard */ +#define MTK_REV_BLK 045 /* rev block */ +#define MTK_FWD_END 022 /* fwd end zone */ + +/* DECtape state */ + +#define STA_STOP 0 /* stopped */ +#define STA_DEC 2 /* decelerating */ +#define STA_ACC 4 /* accelerating */ +#define STA_UTS 6 /* up to speed */ +#define STA_DIR 1 /* fwd/rev */ + +#define ABS(x) (((x) < 0)? (-(x)): (x)) +#define MTK_BIT(c,p) (((c) >> (DT_LPERMC - 1 - ((p) % DT_LPERMC))) & 1) + +/* State and declarations */ + +int32 td_cmd = 0; /* command */ +int32 td_dat = 0; /* data */ +int32 td_mtk = 0; /* mark track */ +int32 td_slf = 0; /* single line flag */ +int32 td_qlf = 0; /* quad line flag */ +int32 td_tme = 0; /* timing error flag */ +int32 td_csum = 0; /* save check sum */ +int32 td_qlctr = 0; /* quad line ctr */ +int32 td_ltime = 20; /* interline time */ +int32 td_dctime = 40000; /* decel time */ +int32 td_stopoffr = 0; +static uint8 tdb_mtk[DT_NUMDR][D18_LPERB]; /* mark track bits */ + +int32 td77 (int32 IR, int32 AC); +t_stat td_svc (UNIT *uptr); +t_stat td_reset (DEVICE *dptr); +t_stat td_attach (UNIT *uptr, CONST char *cptr); +void td_flush (UNIT *uptr); +t_stat td_detach (UNIT *uptr); +t_stat td_boot (int32 unitno, DEVICE *dptr); +t_bool td_newsa (int32 newf); +t_bool td_setpos (UNIT *uptr); +int32 td_header (UNIT *uptr, int32 blk, int32 line); +int32 td_trailer (UNIT *uptr, int32 blk, int32 line); +int32 td_read (UNIT *uptr, int32 blk, int32 line); +void td_write (UNIT *uptr, int32 blk, int32 line, int32 datb); +int32 td_set_mtk (int32 code, int32 u, int32 k); +t_stat td_show_pos (FILE *st, UNIT *uptr, int32 val, CONST void *desc); + +extern uint16 M[]; + +/* TD data structures + + td_dev DT device descriptor + td_unit DT unit list + td_reg DT register list + td_mod DT modifier list +*/ + +DIB td_dib = { DEV_TD8E, 1, { &td77 } }; + +UNIT td_unit[] = { + { UDATA (&td_svc, UNIT_8FMT+UNIT_FIX+UNIT_ATTABLE+ + UNIT_DISABLE+UNIT_ROABLE, DT_CAPAC) }, + { UDATA (&td_svc, UNIT_8FMT+UNIT_FIX+UNIT_ATTABLE+ + UNIT_DISABLE+UNIT_ROABLE, DT_CAPAC) } + }; + +REG td_reg[] = { + { GRDATAD (TDCMD, td_cmd, 8, 4, 8, "command register") }, + { ORDATAD (TDDAT, td_dat, 12, "data register") }, + { ORDATAD (TDMTK, td_mtk, 6, "mark track register") }, + { FLDATAD (TDSLF, td_slf, 0, "single line flag") }, + { FLDATAD (TDQLF, td_qlf, 0, "quad line flag") }, + { FLDATAD (TDTME, td_tme, 0, "timing error flag") }, + { ORDATAD (TDQL, td_qlctr, 2, "quad line counter") }, + { ORDATA (TDCSUM, td_csum, 6), REG_RO }, + { DRDATAD (LTIME, td_ltime, 31, "time between lines"), REG_NZ | PV_LEFT }, + { DRDATAD (DCTIME, td_dctime, 31, "time to decelerate to a full stop"), REG_NZ | PV_LEFT }, + { URDATAD (POS, td_unit[0].pos, 10, T_ADDR_W, 0, + DT_NUMDR, PV_LEFT | REG_RO, "positions, in lines, units 0 and 1") }, + { URDATAD (STATT, td_unit[0].STATE, 8, 18, 0, + DT_NUMDR, REG_RO, "unit state, units 0 and 1") }, + { URDATA (LASTT, td_unit[0].LASTT, 10, 32, 0, + DT_NUMDR, REG_HRO) }, + { FLDATAD (STOP_OFFR, td_stopoffr, 0, "stop on off-reel error") }, + { ORDATA (DEVNUM, td_dib.dev, 6), REG_HRO }, + { NULL } + }; + +MTAB td_mod[] = { + { UNIT_WLK, 0, "write enabled", "WRITEENABLED", NULL }, + { UNIT_WLK, UNIT_WLK, "write locked", "LOCKED", NULL }, + { UNIT_8FMT + UNIT_11FMT, 0, "18b", NULL, NULL }, + { UNIT_8FMT + UNIT_11FMT, UNIT_8FMT, "12b", NULL, NULL }, + { UNIT_8FMT + UNIT_11FMT, UNIT_11FMT, "16b", NULL, NULL }, + { MTAB_XTD|MTAB_VDV, 0, "DEVNO", "DEVNO", + &set_dev, &show_dev, NULL }, + { MTAB_XTD|MTAB_VUN|MTAB_NMO, 0, "POSITION", NULL, NULL, &td_show_pos }, + { 0 } + }; + +DEVICE td_dev = { + "TD", td_unit, td_reg, td_mod, + DT_NUMDR, 8, 24, 1, 8, 12, + NULL, NULL, &td_reset, + &td_boot, &td_attach, &td_detach, + &td_dib, DEV_DISABLE | DEV_DIS + }; + +/* IOT routines */ + +int32 td77 (int32 IR, int32 AC) +{ +int32 pulse = IR & 07; +int32 u = TDC_GETUNIT (td_cmd); /* get unit */ +int32 diff, t; + +switch (pulse) { + + case 01: /* SDSS */ + if (td_slf) + return AC | IOT_SKP; + break; + + case 02: /* SDST */ + if (td_tme) + return AC | IOT_SKP; + break; + + case 03: /* SDSQ */ + if (td_qlf) + return AC | IOT_SKP; + break; + + case 04: /* SDLC */ + td_tme = 0; /* clear tim err */ + diff = (td_cmd ^ AC) & TDC_MASK; /* cmd changes */ + td_cmd = AC & TDC_MASK; /* update cmd */ + if ((diff != 0) && (diff != TDC_RW)) { /* signif change? */ + if (td_newsa (td_cmd)) /* new command */ + return AC | (IORETURN (td_stopoffr, STOP_DTOFF) << IOT_V_REASON); + } + AC = 0; + break; + + case 05: /* SDLD */ + td_slf = 0; /* clear flags */ + td_qlf = 0; + td_qlctr = 0; + td_dat = AC; /* load data reg */ + break; + + case 06: /* SDRC */ + td_slf = 0; /* clear flags */ + td_qlf = 0; + td_qlctr = 0; + t = td_cmd | td_mtk; /* form status */ + if (td_tme || !(td_unit[u].flags & UNIT_ATT)) /* tim/sel err? */ + t = t | TDS_TME; + if (td_unit[u].flags & UNIT_WPRT) /* write locked? */ + t = t | TDS_WLO; + return t; /* return status */ + + case 07: /* SDRD */ + td_slf = 0; /* clear flags */ + td_qlf = 0; + td_qlctr = 0; + return td_dat; /* return data */ + } + +return AC; +} + +/* Command register change (start/stop, forward/reverse, new unit) + + 1. If change in motion, stop to start + - schedule up to speed + - set function as next state + 2. If change in motion, start to stop, or change in direction + - schedule stop +*/ + +t_bool td_newsa (int32 newf) +{ +int32 prev_mving, new_mving, prev_dir, new_dir; +UNIT *uptr; + +uptr = td_dev.units + TDC_GETUNIT (newf); /* new unit */ +if ((uptr->flags & UNIT_ATT) == 0) /* new unit attached? */ + return FALSE; + +new_mving = ((newf & TDC_STPGO) != 0); /* new moving? */ +prev_mving = (uptr->STATE != STA_STOP); /* previous moving? */ +new_dir = ((newf & TDC_FWDRV) != 0); /* new dir? */ +prev_dir = ((uptr->STATE & STA_DIR) != 0); /* previous dir? */ + +td_mtk = 0; /* mark trk reg cleared */ + +if (!prev_mving && !new_mving) /* stop from stop? */ + return FALSE; + +if (new_mving && !prev_mving) { /* start from stop? */ + if (td_setpos (uptr)) /* update pos */ + return TRUE; + sim_cancel (uptr); /* stop current */ + sim_activate (uptr, td_dctime - (td_dctime >> 2)); /* sched accel */ + uptr->STATE = STA_ACC | new_dir; /* set status */ + td_slf = td_qlf = td_qlctr = 0; /* clear state */ + return FALSE; + } + +if ((prev_mving && !new_mving) || /* stop from moving? */ + (prev_dir != new_dir)) { /* dir chg while moving? */ + if (uptr->STATE >= STA_ACC) { /* not stopping? */ + if (td_setpos (uptr)) /* update pos */ + return TRUE; + sim_cancel (uptr); /* stop current */ + sim_activate (uptr, td_dctime); /* schedule decel */ + uptr->STATE = STA_DEC | prev_dir; /* set status */ + td_slf = td_qlf = td_qlctr = 0; /* clear state */ + } + return FALSE; + } + +return FALSE; +} + +/* Update DECtape position + + DECtape motion is modeled as a constant velocity, with linear + acceleration and deceleration. The motion equations are as follows: + + t = time since operation started + tmax = time for operation (accel, decel only) + v = at speed velocity in lines (= 1/td_ltime) + + Then: + at speed dist = t * v + accel dist = (t^2 * v) / (2 * tmax) + decel dist = (((2 * t * tmax) - t^2) * v) / (2 * tmax) + + This routine uses the relative (integer) time, rather than the absolute + (floating point) time, to allow save and restore of the start times. +*/ + +t_bool td_setpos (UNIT *uptr) +{ +uint32 new_time, ut, ulin, udelt; +int32 delta; + +new_time = sim_grtime (); /* current time */ +ut = new_time - uptr->LASTT; /* elapsed time */ +if (ut == 0) /* no time gone? exit */ + return FALSE; +uptr->LASTT = new_time; /* update last time */ +switch (uptr->STATE & ~STA_DIR) { /* case on motion */ + + case STA_STOP: /* stop */ + delta = 0; + break; + + case STA_DEC: /* slowing */ + ulin = ut / (uint32) td_ltime; + udelt = td_dctime / td_ltime; + delta = ((ulin * udelt * 2) - (ulin * ulin)) / (2 * udelt); + break; + + case STA_ACC: /* accelerating */ + ulin = ut / (uint32) td_ltime; + udelt = (td_dctime - (td_dctime >> 2)) / td_ltime; + delta = (ulin * ulin) / (2 * udelt); + break; + + case STA_UTS: /* at speed */ + delta = ut / (uint32) td_ltime; + break; + } + +if (uptr->STATE & STA_DIR) /* update pos */ + uptr->pos = uptr->pos - delta; +else uptr->pos = uptr->pos + delta; +if (((int32) uptr->pos < 0) || + ((int32) uptr->pos > (DTU_FWDEZ (uptr) + DT_EZLIN))) { + detach_unit (uptr); /* off reel */ + sim_cancel (uptr); /* no timing pulses */ + return TRUE; + } +return FALSE; +} + +/* Unit service - unit is either changing speed, or it is up to speed */ + +t_stat td_svc (UNIT *uptr) +{ +int32 mot = uptr->STATE & ~STA_DIR; +int32 dir = uptr->STATE & STA_DIR; +int32 unum = uptr - td_dev.units; +int32 su = TDC_GETUNIT (td_cmd); +int32 mtkb, datb; + +/* Motion cases + + Decelerating - if go, next state must be accel as specified by td_cmd + Accelerating - next state must be up to speed, fall through + Up to speed - process line */ + +if (mot == STA_STOP) /* stopped? done */ + return SCPE_OK; +if ((uptr->flags & UNIT_ATT) == 0) { /* not attached? */ + uptr->STATE = uptr->pos = 0; /* also done */ + return SCPE_UNATT; + } + +switch (mot) { /* case on motion */ + + case STA_DEC: /* deceleration */ + if (td_setpos (uptr)) /* upd pos; off reel? */ + return IORETURN (td_stopoffr, STOP_DTOFF); + if ((unum != su) || !(td_cmd & TDC_STPGO)) /* not sel or stop? */ + uptr->STATE = 0; /* stop */ + else { /* selected and go */ + uptr->STATE = STA_ACC | /* accelerating */ + ((td_cmd & TDC_FWDRV)? STA_DIR: 0); /* in new dir */ + sim_activate (uptr, td_dctime - (td_dctime >> 2)); + } + return SCPE_OK; + + case STA_ACC: /* accelerating */ + if (td_setpos (uptr)) /* upd pos; off reel? */ + return IORETURN (td_stopoffr, STOP_DTOFF); + uptr->STATE = STA_UTS | dir; /* set up to speed */ + break; + + case STA_UTS: /* up to speed */ + if (dir) /* adjust position */ + uptr->pos = uptr->pos - 1; + else uptr->pos = uptr->pos + 1; + uptr->LASTT = sim_grtime (); /* save time */ + if (((int32) uptr->pos < 0) || /* off reel? */ + (uptr->pos >= (((uint32) DTU_FWDEZ (uptr)) + DT_EZLIN))) { + detach_unit (uptr); + return IORETURN (td_stopoffr, STOP_DTOFF); + } + break; /* check function */ + } + +/* At speed - process the current line + + Once the TD8E is running at speed, it operates line by line. If reading, + the current mark track bit is shifted into the mark track register, and + the current data nibble (3b) is shifted into the data register. If + writing, the current mark track bit is shifted into the mark track + register, the top nibble from the data register is written to tape, and + the data register is shifted up. The complexity here comes from + synthesizing the mark track, based on tape position, and the header data. */ + +sim_activate (uptr, td_ltime); /* sched next line */ +if (unum != su) /* not sel? done */ + return SCPE_OK; +td_slf = 1; /* set single */ +td_qlctr = (td_qlctr + 1) % DT_WSIZE; /* count words */ +if (td_qlctr == 0) { /* lines mod 4? */ + if (td_qlf) { /* quad line set? */ + td_tme = 1; /* timing error */ + td_cmd = td_cmd & ~TDC_RW; /* clear write */ + } + else td_qlf = 1; /* no, set quad */ + } + +datb = 0; /* assume no data */ +if (uptr->pos < (DT_EZLIN - DT_BFLIN)) /* rev end zone? */ + mtkb = MTK_BIT (MTK_REV_END, uptr->pos); +else if (uptr->pos < DT_EZLIN) /* rev buffer? */ + mtkb = MTK_BIT (MTK_INTER, uptr->pos); +else if (uptr->pos < ((uint32) DTU_FWDEZ (uptr))) { /* data zone? */ + int32 blkno = DT_LIN2BL (uptr->pos, uptr); /* block # */ + int32 lineno = DT_LIN2OF (uptr->pos, uptr); /* line # within block */ + if (lineno < DT_HTLIN) { /* header? */ + if ((td_cmd & TDC_RW) == 0) /* read? */ + datb = td_header (uptr, blkno, lineno); /* get nibble */ + } + else if (lineno < (DTU_LPERB (uptr) - DT_HTLIN)) { /* data? */ + if (td_cmd & TDC_RW) /* write? */ + td_write (uptr, blkno, /* write data nibble */ + lineno - DT_HTLIN, /* data rel line num */ + (td_dat >> 9) & 07); + else datb = td_read (uptr, blkno, /* no, read */ + lineno - DT_HTLIN); + } + else if ((td_cmd & TDC_RW) == 0) /* trailer; read? */ + datb = td_trailer (uptr, blkno, lineno - /* get trlr nibble */ + (DTU_LPERB (uptr) - DT_HTLIN)); + mtkb = tdb_mtk[unum][lineno]; + } +else if (uptr->pos < (((uint32) DTU_FWDEZ (uptr)) + DT_BFLIN)) + mtkb = MTK_BIT (MTK_INTER, uptr->pos); /* fwd buffer? */ +else mtkb = MTK_BIT (MTK_FWD_END, uptr->pos); /* fwd end zone */ + +if (dir) { /* reverse? */ + mtkb = mtkb ^ 01; /* complement mark bit, */ + datb = datb ^ 07; /* data bits */ + } +td_mtk = ((td_mtk << 1) | mtkb) & MTK_MASK; /* shift mark reg */ +td_dat = ((td_dat << 3) | datb) & 07777; /* shift data reg */ +return SCPE_OK; +} + +/* Header read - reads out 18b words in 3b increments + + word lines contents + 0 0-5 0 + 1 6-11 block number + 2 12-17 0 + 3 18-23 0 + 4 24-29 reverse checksum (0777777) +*/ + +int32 td_header (UNIT *uptr, int32 blk, int32 line) +{ +int32 nibp; + +switch (line) { + + case 8: case 9: case 10: case 11: /* block num */ + nibp = 3 * (DT_LPERMC - 1 - (line % DT_LPERMC)); + return (blk >> nibp) & 07; + + case 24: case 25: case 26: case 27: case 28: case 29: /* rev csum */ + return 07; /* 777777 */ + + default: + return 0; + } +} + +/* Trailer read - reads out 18b words in 3b increments + Checksum is stored to avoid double calculation + + word lines contents + 0 0-5 forward checksum (lines 0-1, rest 0) + 1 6-11 0 + 2 12-17 0 + 3 18-23 reverse block mark + 4 24-29 0 + + Note that the reverse block mark (when read forward) appears + as the complement obverse (3b nibbles swapped end for end and + complemented). +*/ + +int32 td_trailer (UNIT *uptr, int32 blk, int32 line) +{ +int32 nibp, i, ba; +int16 *fbuf= (int16 *) uptr->filebuf; + +switch (line) { + + case 0: + td_csum = 07777; /* init csum */ + ba = blk * DTU_BSIZE (uptr); + for (i = 0; i < DTU_BSIZE (uptr); i++) /* loop thru buf */ + td_csum = (td_csum ^ ~fbuf[ba + i]) & 07777; + td_csum = ((td_csum >> 6) ^ td_csum) & 077; + return (td_csum >> 3) & 07; + + case 1: + return (td_csum & 07); + + case 18: case 19: case 20: case 21: + nibp = 3 * (line % DT_LPERMC); + return ((blk >> nibp) & 07) ^ 07; + + default: + return 0; + } +} + +/* Data read - convert block number/data line # to offset in data array */ + +int32 td_read (UNIT *uptr, int32 blk, int32 line) +{ +int16 *fbuf = (int16 *) uptr->filebuf; /* buffer */ +uint32 ba = blk * DTU_BSIZE (uptr); /* block base */ +int32 nibp = 3 * (DT_WSIZE - 1 - (line % DT_WSIZE)); /* nibble pos */ + +ba = ba + (line / DT_WSIZE); /* block addr */ +return (fbuf[ba] >> nibp) & 07; /* get data nibble */ +} + +/* Data write - convert block number/data line # to offset in data array */ + +void td_write (UNIT *uptr, int32 blk, int32 line, int32 dat) +{ +int16 *fbuf = (int16 *) uptr->filebuf; /* buffer */ +uint32 ba = blk * DTU_BSIZE (uptr); /* block base */ +int32 nibp = 3 * (DT_WSIZE - 1 - (line % DT_WSIZE)); /* nibble pos */ + +ba = ba + (line / DT_WSIZE); /* block addr */ +fbuf[ba] = (fbuf[ba] & ~(07 << nibp)) | (dat << nibp); /* upd data nibble */ +uptr->WRITTEN = TRUE; +if (ba >= uptr->hwmark) /* upd length */ + uptr->hwmark = ba + 1; +return; +} + +/* Reset routine */ + +t_stat td_reset (DEVICE *dptr) +{ +int32 i; +UNIT *uptr; + +for (i = 0; i < DT_NUMDR; i++) { /* stop all activity */ + uptr = td_dev.units + i; + if (sim_is_running) { /* CAF? */ + if (uptr->STATE >= STA_ACC) { /* accel or uts? */ + if (td_setpos (uptr)) /* update pos */ + continue; + sim_cancel (uptr); + sim_activate (uptr, td_dctime); /* sched decel */ + uptr->STATE = STA_DEC | (uptr->STATE & STA_DIR); + } + } + else { + sim_cancel (uptr); /* sim reset */ + uptr->STATE = 0; + uptr->LASTT = sim_grtime (); + } + } +td_slf = td_qlf = td_qlctr = 0; /* clear state */ +td_cmd = td_dat = td_mtk = 0; +td_csum = 0; +return SCPE_OK; +} + +/* Bootstrap routine - OS/8 only + + 1) Read reverse until reverse end zone (mark track is complement obverse) + 2) Read forward until mark track code 031. This is a composite code from + the last 4b of the forward block number and the first two bits of the + reverse guard (01 -0110 01- 1010). There are 16 lines before the first + data word. + 3) Store data words from 7354 to end of page. This includes header and + trailer words. + 4) Continue at location 7400. +*/ + +#define BOOT_START 07300 +#define BOOT_LEN (sizeof (boot_rom) / sizeof (int16)) + +static const uint16 boot_rom[] = { + 01312, /* ST, TAD L4MT ;=2000, reverse */ + 04312, /* JMS L4MT ; rev lk for 022 */ + 04312, /* JMS L4MT ; fwd lk for 031 */ + 06773, /* DAT, SDSQ ; wait for 12b */ + 05303, /* JMP .-1 */ + 06777, /* SDRD ; read word */ + 03726, /* DCA I BUF ; store */ + 02326, /* ISZ BUF ; incr ptr */ + 05303, /* JMP DAT ; if not 0, cont */ + 05732, /* JMP I SCB ; jump to boot */ + 02000, /* L4MT,2000 ; overwritten */ + 01300, /* TAD ST ; =1312, go */ + 06774, /* SDLC ; new command */ + 06771, /* MTK, SDSS ; wait for mark */ + 05315, /* JMP .-1 */ + 06776, /* SDRC ; get mark code */ + 00331, /* AND K77 ; mask to 6b */ + 01327, /* CMP, TAD MCD ; got target code? */ + 07640, /* SZA CLA ; skip if yes */ + 05315, /* JMP MTK ; wait for mark */ + 02321, /* ISZ CMP ; next target */ + 05712, /* JMP I L4MT ; exit */ + 07354, /* BUF, 7354 ; loading point */ + 07756, /* MCD, -22 ; target 1 */ + 07747, /* -31 ; target 2 */ + 00077, /* 77 ; mask */ + 07400 /* SCB, 7400 ; secondary boot */ + }; + +t_stat td_boot (int32 unitno, DEVICE *dptr) +{ +size_t i; + +if (unitno) + return SCPE_ARG; /* only unit 0 */ +if (td_dib.dev != DEV_TD8E) + return STOP_NOTSTD; /* only std devno */ +td_unit[unitno].pos = DT_EZLIN; +for (i = 0; i < BOOT_LEN; i++) + M[BOOT_START + i] = boot_rom[i]; +cpu_set_bootpc (BOOT_START); +return SCPE_OK; +} + +/* Attach routine + + Determine 12b, 16b, or 18b/36b format + Allocate buffer + If 16b or 18b, read 16b or 18b format and convert to 12b in buffer + If 12b, read data into buffer + Set up mark track bit array +*/ + +t_stat td_attach (UNIT *uptr, CONST char *cptr) +{ +uint32 pdp18b[D18_NBSIZE]; +uint16 pdp11b[D18_NBSIZE], *fbuf; +int32 i, k, mtkpb; +int32 u = uptr - td_dev.units; +t_stat r; +uint32 ba, sz; + +r = attach_unit (uptr, cptr); /* attach */ +if (r != SCPE_OK) /* fail? */ + return r; +if ((sim_switches & SIM_SW_REST) == 0) { /* not from rest? */ + uptr->flags = (uptr->flags | UNIT_8FMT) & ~UNIT_11FMT; + if (sim_switches & SWMASK ('F')) /* att 18b? */ + uptr->flags = uptr->flags & ~UNIT_8FMT; + else if (sim_switches & SWMASK ('S')) /* att 16b? */ + uptr->flags = (uptr->flags | UNIT_11FMT) & ~UNIT_8FMT; + else if (!(sim_switches & SWMASK ('A')) && /* autosize? */ + (sz = sim_fsize (uptr->fileref))) { + if (sz == D11_FILSIZ) + uptr->flags = (uptr->flags | UNIT_11FMT) & ~UNIT_8FMT; + else if (sz > D8_FILSIZ) + uptr->flags = uptr->flags & ~UNIT_8FMT; + } + } +uptr->capac = DTU_CAPAC (uptr); /* set capacity */ +uptr->filebuf = calloc (uptr->capac, sizeof (int16)); +if (uptr->filebuf == NULL) { /* can't alloc? */ + detach_unit (uptr); + return SCPE_MEM; + } +fbuf = (uint16 *) uptr->filebuf; /* file buffer */ +sim_printf ("%s%d: ", sim_dname (&td_dev), u); +if (uptr->flags & UNIT_8FMT) + sim_printf ("12b format"); +else if (uptr->flags & UNIT_11FMT) + sim_printf ("16b format"); +else sim_printf ("18b/36b format"); +sim_printf (", buffering file in memory\n"); +uptr->io_flush = td_flush; +if (uptr->flags & UNIT_8FMT) /* 12b? */ + uptr->hwmark = fxread (uptr->filebuf, sizeof (uint16), + uptr->capac, uptr->fileref); +else { /* 16b/18b */ + for (ba = 0; ba < uptr->capac; ) { /* loop thru file */ + if (uptr->flags & UNIT_11FMT) { + k = fxread (pdp11b, sizeof (uint16), D18_NBSIZE, uptr->fileref); + for (i = 0; i < k; i++) + pdp18b[i] = pdp11b[i]; + } + else k = fxread (pdp18b, sizeof (uint32), D18_NBSIZE, uptr->fileref); + if (k == 0) + break; + for ( ; k < D18_NBSIZE; k++) + pdp18b[k] = 0; + for (k = 0; k < D18_NBSIZE; k = k + 2) { /* loop thru blk */ + fbuf[ba] = (pdp18b[k] >> 6) & 07777; + fbuf[ba + 1] = ((pdp18b[k] & 077) << 6) | + ((pdp18b[k + 1] >> 12) & 077); + fbuf[ba + 2] = pdp18b[k + 1] & 07777; + ba = ba + 3; + } /* end blk loop */ + } /* end file loop */ + uptr->hwmark = ba; + } /* end else */ +uptr->flags = uptr->flags | UNIT_BUF; /* set buf flag */ +uptr->pos = DT_EZLIN; /* beyond leader */ +uptr->LASTT = sim_grtime (); /* last pos update */ +uptr->STATE = STA_STOP; /* stopped */ + +mtkpb = (DTU_BSIZE (uptr) * DT_WSIZE) / DT_LPERMC; /* mtk codes per blk */ +k = td_set_mtk (MTK_INTER, u, 0); /* fill mark track */ +k = td_set_mtk (MTK_FWD_BLK, u, k); /* bit array */ +k = td_set_mtk (MTK_REV_GRD, u, k); +for (i = 0; i < 4; i++) + k = td_set_mtk (MTK_FWD_PRE, u, k); +for (i = 0; i < (mtkpb - 4); i++) + k = td_set_mtk (MTK_DATA, u, k); +for (i = 0; i < 4; i++) + k = td_set_mtk (MTK_REV_PRE, u, k); +k = td_set_mtk (MTK_FWD_GRD, u, k); +k = td_set_mtk (MTK_REV_BLK, u, k); +k = td_set_mtk (MTK_INTER, u, k); +return SCPE_OK; +} + +/* Detach routine + + If 12b, write buffer to file + If 16b or 18b, convert 12b buffer to 16b or 18b and write to file + Deallocate buffer +*/ + +void td_flush (UNIT* uptr) +{ +uint32 pdp18b[D18_NBSIZE]; +uint16 pdp11b[D18_NBSIZE], *fbuf; +int32 i, k; +uint32 ba; + +if (uptr->WRITTEN && uptr->hwmark && ((uptr->flags & UNIT_RO)== 0)) { /* any data? */ + rewind (uptr->fileref); /* start of file */ + fbuf = (uint16 *) uptr->filebuf; /* file buffer */ + if (uptr->flags & UNIT_8FMT) /* PDP8? */ + fxwrite (uptr->filebuf, sizeof (uint16), /* write file */ + uptr->hwmark, uptr->fileref); + else { /* 16b/18b */ + for (ba = 0; ba < uptr->hwmark; ) { /* loop thru buf */ + for (k = 0; k < D18_NBSIZE; k = k + 2) { + pdp18b[k] = ((uint32) (fbuf[ba] & 07777) << 6) | + ((uint32) (fbuf[ba + 1] >> 6) & 077); + pdp18b[k + 1] = ((uint32) (fbuf[ba + 1] & 077) << 12) | + ((uint32) (fbuf[ba + 2] & 07777)); + ba = ba + 3; + } /* end loop blk */ + if (uptr->flags & UNIT_11FMT) { /* 16b? */ + for (i = 0; i < D18_NBSIZE; i++) + pdp11b[i] = pdp18b[i]; + fxwrite (pdp11b, sizeof (uint16), + D18_NBSIZE, uptr->fileref); + } + else fxwrite (pdp18b, sizeof (uint32), + D18_NBSIZE, uptr->fileref); + } /* end loop buf */ + } /* end else */ + if (ferror (uptr->fileref)) + sim_perror ("I/O error"); + } +uptr->WRITTEN = FALSE; /* no longer dirty */ +} + +t_stat td_detach (UNIT* uptr) +{ +int u = (int)(uptr - td_dev.units); + +if (!(uptr->flags & UNIT_ATT)) + return SCPE_OK; +if (uptr->hwmark && ((uptr->flags & UNIT_RO)== 0)) { /* any data? */ + sim_printf ("%s%d: writing buffer to file\n", sim_dname (&td_dev), u); + td_flush (uptr); + } /* end if hwmark */ +free (uptr->filebuf); /* release buf */ +uptr->flags = uptr->flags & ~UNIT_BUF; /* clear buf flag */ +uptr->filebuf = NULL; /* clear buf ptr */ +uptr->flags = (uptr->flags | UNIT_8FMT) & ~UNIT_11FMT; /* default fmt */ +uptr->capac = DT_CAPAC; /* default size */ +uptr->pos = uptr->STATE = 0; +sim_cancel (uptr); /* no more pulses */ +return detach_unit (uptr); +} + +/* Set mark track code into bit array */ + +int32 td_set_mtk (int32 code, int32 u, int32 k) +{ +int32 i; + +for (i = 5; i >= 0; i--) + tdb_mtk[u][k++] = (code >> i) & 1; +return k; +} + +/* Show position */ + +t_stat td_show_pos (FILE *st, UNIT *uptr, int32 val, CONST void *desc) +{ +if ((uptr->flags & UNIT_ATT) == 0) return SCPE_UNATT; +if (uptr->pos < DT_EZLIN) /* rev end zone? */ + fprintf (st, "Reverse end zone\n"); +else if (uptr->pos < ((uint32) DTU_FWDEZ (uptr))) { /* data zone? */ + int32 blkno = DT_LIN2BL (uptr->pos, uptr); /* block # */ + int32 lineno = DT_LIN2OF (uptr->pos, uptr); /* line # within block */ + fprintf (st, "Block %d, line %d, ", blkno, lineno); + if (lineno < DT_HTLIN) /* header? */ + fprintf (st, "header cell %d, nibble %d\n", + lineno / DT_LPERMC, lineno % DT_LPERMC); + else if (lineno < (DTU_LPERB (uptr) - DT_HTLIN)) /* data? */ + fprintf (st, "data word %d, nibble %d\n", + (lineno - DT_HTLIN) / DT_WSIZE, (lineno - DT_HTLIN) % DT_WSIZE); + else fprintf (st, "trailer cell %d, nibble %d\n", + (lineno - (DTU_LPERB (uptr) - DT_HTLIN)) / DT_LPERMC, + (lineno - (DTU_LPERB (uptr) - DT_HTLIN)) % DT_LPERMC); + } +else fprintf (st, "Forward end zone\n"); /* fwd end zone */ +return SCPE_OK; +} + ADDED src/PDP8/pdp8_tsc.c Index: src/PDP8/pdp8_tsc.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_tsc.c @@ -0,0 +1,158 @@ +/* pdp8_tsc.c: PDP-8 ETOS timesharing option board (TSC8-75) + + Copyright (c) 2003-2011, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + This module is based on Bernhard Baehr's PDP-8/E simulator + + PDP-8/E Simulator Source Code + + Copyright ) 2001-2003 Bernhard Baehr + + TSC8iots.c - IOTs for the TSC8-75 Board plugin + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program; if not, write to the Free Software + Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA + + tsc TSC8-75 option board +*/ + +#include "pdp8_defs.h" + +extern int32 int_req; +extern int32 SF; +extern int32 tsc_ir; /* "ERIOT" */ +extern int32 tsc_pc; /* "ERTB" */ +extern int32 tsc_cdf; /* "ECDF" */ +extern int32 tsc_enb; /* enable */ + +#define UNIT_V_SN699 (UNIT_V_UF + 0) /* SN 699 or above */ +#define UNIT_SN699 (1 << UNIT_V_SN699) + +int32 tsc (int32 IR, int32 AC); +t_stat tsc_reset (DEVICE *dptr); + +/* TSC data structures + + tsc_dev TSC device descriptor + tsc_unit TSC unit descriptor + tsc_reg TSC register list +*/ + +DIB tsc_dib = { DEV_TSC, 1, { &tsc } }; + +UNIT tsc_unit = { UDATA (NULL, UNIT_SN699, 0) }; + +REG tsc_reg[] = { + { ORDATAD (IR, tsc_ir, 12, "most recently trapped instruction") }, + { ORDATAD (PC, tsc_pc, 12, "PC of most recently trapped instruction") }, + { FLDATAD (CDF, tsc_cdf, 0, "1 if trapped instruction is CDF, 0 otherwise") }, + { FLDATAD (ENB, tsc_enb, 0, "interrupt enable flag") }, + { FLDATAD (INT, int_req, INT_V_TSC, "interrupt pending flag") }, + { NULL } + }; + +MTAB tsc_mod[] = { + { UNIT_SN699, UNIT_SN699, "ESME", "ESME", NULL }, + { UNIT_SN699, 0, "no ESME", "NOESME", NULL }, + { 0 } + }; + +DEVICE tsc_dev = { + "TSC", &tsc_unit, tsc_reg, tsc_mod, + 1, 10, 31, 1, 8, 8, + NULL, NULL, &tsc_reset, + NULL, NULL, NULL, + &tsc_dib, DEV_DISABLE | DEV_DIS + }; + +/* IOT routine */ + +int32 tsc (int32 IR, int32 AC) +{ +switch (IR & 07) { /* decode IR<9:11> */ + + case 0: /* ETDS */ + tsc_enb = 0; /* disable int req */ + int_req = int_req & ~INT_TSC; /* clear flag */ + break; + + case 1: /* ESKP */ + return (int_req & INT_TSC)? IOT_SKP + AC: AC; /* skip on int req */ + + case 2: /* ECTF */ + int_req = int_req & ~INT_TSC; /* clear int req */ + break; + + case 3: /* ECDF */ + AC = AC | ((tsc_ir >> 3) & 07); /* read "ERIOT"<6:8> */ + if (tsc_cdf) /* if cdf, skip */ + AC = AC | IOT_SKP; + tsc_cdf = 0; + break; + + case 4: /* ERTB */ + return tsc_pc; + + case 5: /* ESME */ + if (tsc_unit.flags & UNIT_SN699) { /* enabled? */ + if (tsc_cdf && ((tsc_ir & 070) >> 3) == (SF & 07)) { + AC = AC | IOT_SKP; + tsc_cdf = 0; + } + } + break; + + case 6: /* ERIOT */ + return tsc_ir; + + case 7: /* ETEN */ + tsc_enb = 1; + break; + } /* end switch */ + +return AC; +} + +/* Reset routine */ + +t_stat tsc_reset (DEVICE *dptr) +{ +tsc_ir = 0; +tsc_pc = 0; +tsc_cdf = 0; +tsc_enb = 0; +int_req = int_req & ~INT_TSC; +return SCPE_OK; +} ADDED src/PDP8/pdp8_tt.c Index: src/PDP8/pdp8_tt.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_tt.c @@ -0,0 +1,285 @@ +/* pdp8_tt.c: PDP-8 console terminal simulator + + Copyright (c) 1993-2016, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + tti,tto KL8E terminal input/output + + 18-Apr-12 RMS Revised to use clock coscheduling + 18-Jun-07 RMS Added UNIT_IDLE flag to console input + 18-Oct-06 RMS Synced keyboard to clock + 30-Sep-06 RMS Fixed handling of non-printable characters in KSR mode + 22-Nov-05 RMS Revised for new terminal processing routines + 28-May-04 RMS Removed SET TTI CTRL-C + 29-Dec-03 RMS Added console output backpressure support + 25-Apr-03 RMS Revised for extended file support + 02-Mar-02 RMS Added SET TTI CTRL-C + 22-Dec-02 RMS Added break support + 01-Nov-02 RMS Added 7B/8B support + 04-Oct-02 RMS Added DIBs, device number support + 30-May-02 RMS Widened POS to 32b + 07-Sep-01 RMS Moved function prototypes +*/ + +#include "pdp8_defs.h" +#include "sim_tmxr.h" +#include + +extern int32 int_req, int_enable, dev_done, stop_inst; +extern int32 tmxr_poll; + +int32 tti (int32 IR, int32 AC); +int32 tto (int32 IR, int32 AC); +t_stat tti_svc (UNIT *uptr); +t_stat tto_svc (UNIT *uptr); +t_stat tti_reset (DEVICE *dptr); +t_stat tto_reset (DEVICE *dptr); +t_stat tty_set_mode (UNIT *uptr, int32 val, CONST char *cptr, void *desc); + +/* TTI data structures + + tti_dev TTI device descriptor + tti_unit TTI unit descriptor + tti_reg TTI register list + tti_mod TTI modifiers list +*/ + +DIB tti_dib = { DEV_TTI, 1, { &tti } }; + +UNIT tti_unit = { UDATA (&tti_svc, UNIT_IDLE|TT_MODE_KSR, 0), SERIAL_IN_WAIT }; + +REG tti_reg[] = { + { ORDATAD (BUF, tti_unit.buf, 8, "last data item processed") }, + { FLDATAD (DONE, dev_done, INT_V_TTI, "device done flag") }, + { FLDATAD (ENABLE, int_enable, INT_V_TTI, "interrupt enable flag") }, + { FLDATAD (INT, int_req, INT_V_TTI, "interrupt pending flag") }, + { DRDATAD (POS, tti_unit.pos, T_ADDR_W, "number of characters input"), PV_LEFT }, + { DRDATAD (TIME, tti_unit.wait, 24, "input polling interval (if 0, the keyboard is polled synchronously with the clock)"), PV_LEFT+REG_NZ }, + { NULL } + }; + +MTAB tti_mod[] = { + { TT_MODE, TT_MODE_KSR, "KSR", "KSR", &tty_set_mode }, + { TT_MODE, TT_MODE_7B, "7b", "7B", &tty_set_mode }, + { TT_MODE, TT_MODE_8B, "8b", "8B", &tty_set_mode }, + { TT_MODE, TT_MODE_7P, "7b", NULL, NULL }, + { MTAB_XTD|MTAB_VDV, 0, "DEVNO", NULL, NULL, &show_dev, NULL }, + { 0 } + }; + +DEVICE tti_dev = { + "TTI", &tti_unit, tti_reg, tti_mod, + 1, 10, 31, 1, 8, 8, + NULL, NULL, &tti_reset, + NULL, NULL, NULL, + &tti_dib, 0 + }; + +uint32 tti_buftime; /* time input character arrived */ + +/* TTO data structures + + tto_dev TTO device descriptor + tto_unit TTO unit descriptor + tto_reg TTO register list +*/ + +DIB tto_dib = { DEV_TTO, 1, { &tto } }; + +UNIT tto_unit = { UDATA (&tto_svc, TT_MODE_KSR, 0), SERIAL_OUT_WAIT }; + +REG tto_reg[] = { + { ORDATAD (BUF, tto_unit.buf, 8, "last date item processed") }, + { FLDATAD (DONE, dev_done, INT_V_TTO, "device done flag") }, + { FLDATAD (ENABLE, int_enable, INT_V_TTO, "interrupt enable flag") }, + { FLDATAD (INT, int_req, INT_V_TTO, "interrupt pending flag") }, + { DRDATAD (POS, tto_unit.pos, T_ADDR_W, "number of characters output"), PV_LEFT }, + { DRDATAD (TIME, tto_unit.wait, 24, "time form I/O initiation to interrupt"), PV_LEFT }, + { NULL } + }; + +MTAB tto_mod[] = { + { TT_MODE, TT_MODE_KSR, "KSR", "KSR", &tty_set_mode }, + { TT_MODE, TT_MODE_7B, "7b", "7B", &tty_set_mode }, + { TT_MODE, TT_MODE_8B, "8b", "8B", &tty_set_mode }, + { TT_MODE, TT_MODE_7P, "7p", "7P", &tty_set_mode }, + { MTAB_XTD|MTAB_VDV, 0, "DEVNO", NULL, NULL, &show_dev }, + { 0 } + }; + +DEVICE tto_dev = { + "TTO", &tto_unit, tto_reg, tto_mod, + 1, 10, 31, 1, 8, 8, + NULL, NULL, &tto_reset, + NULL, NULL, NULL, + &tto_dib, 0 + }; + +/* Terminal input: IOT routine */ + +int32 tti (int32 IR, int32 AC) +{ +switch (IR & 07) { /* decode IR<9:11> */ + case 0: /* KCF */ + dev_done = dev_done & ~INT_TTI; /* clear flag */ + int_req = int_req & ~INT_TTI; + return AC; + + case 1: /* KSF */ + return (dev_done & INT_TTI)? IOT_SKP + AC: AC; + + case 2: /* KCC */ + dev_done = dev_done & ~INT_TTI; /* clear flag */ + int_req = int_req & ~INT_TTI; + return 0; /* clear AC */ + + case 4: /* KRS */ + return (AC | tti_unit.buf); /* return buffer */ + + case 5: /* KIE */ + if (AC & 1) + int_enable = int_enable | (INT_TTI+INT_TTO); + else int_enable = int_enable & ~(INT_TTI+INT_TTO); + int_req = INT_UPDATE; /* update interrupts */ + return AC; + + case 6: /* KRB */ + dev_done = dev_done & ~INT_TTI; /* clear flag */ + int_req = int_req & ~INT_TTI; + sim_activate_abs (&tti_unit, tti_unit.wait); /* check soon for more input */ + return (tti_unit.buf); /* return buffer */ + + default: + return (stop_inst << IOT_V_REASON) + AC; + } /* end switch */ +} + +/* Unit service */ + +t_stat tti_svc (UNIT *uptr) +{ +int32 c; + +sim_clock_coschedule (uptr, tmxr_poll); /* continue poll */ +if ((dev_done & INT_TTI) && /* prior character still pending and < 500ms? */ + ((sim_os_msec () - tti_buftime) < 500)) + return SCPE_OK; +if ((c = sim_poll_kbd ()) < SCPE_KFLAG) /* no char or error? */ + return c; +if (c & SCPE_BREAK) /* break? */ + uptr->buf = 0; +else uptr->buf = sim_tt_inpcvt (c, TT_GET_MODE (uptr->flags) | TTUF_KSR); +tti_buftime = sim_os_msec (); +uptr->pos = uptr->pos + 1; +dev_done = dev_done | INT_TTI; /* set done */ +int_req = INT_UPDATE; /* update interrupts */ +return SCPE_OK; +} + +/* Reset routine */ + +t_stat tti_reset (DEVICE *dptr) +{ +tmxr_set_console_units (&tti_unit, &tto_unit); +tti_unit.buf = 0; +dev_done = dev_done & ~INT_TTI; /* clear done, int */ +int_req = int_req & ~INT_TTI; +int_enable = int_enable | INT_TTI; /* set enable */ +if (!sim_is_running) /* RESET (not CAF)? */ + sim_activate (&tti_unit, KBD_WAIT (tti_unit.wait, tmxr_poll)); +return SCPE_OK; +} + +/* Terminal output: IOT routine */ + +int32 tto (int32 IR, int32 AC) +{ +switch (IR & 07) { /* decode IR<9:11> */ + + case 0: /* TLF */ + dev_done = dev_done | INT_TTO; /* set flag */ + int_req = INT_UPDATE; /* update interrupts */ + return AC; + + case 1: /* TSF */ + return (dev_done & INT_TTO)? IOT_SKP + AC: AC; + + case 2: /* TCF */ + dev_done = dev_done & ~INT_TTO; /* clear flag */ + int_req = int_req & ~INT_TTO; /* clear int req */ + return AC; + + case 5: /* SPI */ + return (int_req & (INT_TTI+INT_TTO))? IOT_SKP + AC: AC; + + case 6: /* TLS */ + dev_done = dev_done & ~INT_TTO; /* clear flag */ + int_req = int_req & ~INT_TTO; /* clear int req */ + case 4: /* TPC */ + sim_activate (&tto_unit, tto_unit.wait); /* activate unit */ + tto_unit.buf = AC; /* load buffer */ + return AC; + + default: + return (stop_inst << IOT_V_REASON) + AC; + } /* end switch */ +} + +/* Unit service */ + +t_stat tto_svc (UNIT *uptr) +{ +int32 c; +t_stat r; + +c = sim_tt_outcvt (uptr->buf, TT_GET_MODE (uptr->flags) | TTUF_KSR); +if (c >= 0) { + if ((r = sim_putchar_s (c)) != SCPE_OK) { /* output char; error? */ + sim_activate (uptr, uptr->wait); /* try again */ + return ((r == SCPE_STALL)? SCPE_OK: r); /* if !stall, report */ + } + } +dev_done = dev_done | INT_TTO; /* set done */ +int_req = INT_UPDATE; /* update interrupts */ +uptr->pos = uptr->pos + 1; +return SCPE_OK; +} + +/* Reset routine */ + +t_stat tto_reset (DEVICE *dptr) +{ +tto_unit.buf = 0; +dev_done = dev_done & ~INT_TTO; /* clear done, int */ +int_req = int_req & ~INT_TTO; +int_enable = int_enable | INT_TTO; /* set enable */ +sim_cancel (&tto_unit); /* deactivate unit */ +return SCPE_OK; +} + +t_stat tty_set_mode (UNIT *uptr, int32 val, CONST char *cptr, void *desc) +{ +tti_unit.flags = (tti_unit.flags & ~TT_MODE) | val; +tto_unit.flags = (tto_unit.flags & ~TT_MODE) | val; +return SCPE_OK; +} ADDED src/PDP8/pdp8_ttx.c Index: src/PDP8/pdp8_ttx.c ================================================================== --- /dev/null +++ src/PDP8/pdp8_ttx.c @@ -0,0 +1,546 @@ +/* pdp8_ttx.c: PDP-8 additional terminals simulator + + Copyright (c) 1993-2016, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + ttix,ttox PT08/KL8JA terminal input/output + + 18-Sep-16 RMS Expanded support to 16 terminals + 11-Oct-13 RMS Poll TTIX immediately to pick up initial connect (Mark Pizzolato) + 18-Apr-12 RMS Revised to use clock coscheduling + 19-Nov-08 RMS Revised for common TMXR show routines + 07-Jun-06 RMS Added UNIT_IDLE flag + 06-Jul-06 RMS Fixed bug in DETACH routine + 22-Nov-05 RMS Revised for new terminal processing routines + 29-Jun-05 RMS Added SET TTOXn DISCONNECT + Fixed bug in SET LOG/NOLOG + 21-Jun-05 RMS Fixed bug in SHOW CONN/STATS + 05-Jan-04 RMS Revised for tmxr library changes + 09-May-03 RMS Added network device flag + 25-Apr-03 RMS Revised for extended file support + 22-Dec-02 RMS Added break support + 02-Nov-02 RMS Added 7B/8B support + 04-Oct-02 RMS Added DIB, device number support + 22-Aug-02 RMS Updated for changes to sim_tmxr.c + 06-Jan-02 RMS Added device enable/disable support + 30-Dec-01 RMS Complete rebuild + 30-Nov-01 RMS Added extended SET/SHOW support + + This module implements 1-16 individual serial interfaces similar in function + to the console. These interfaces are mapped to Telnet based connections as + though they were the four lines of a terminal multiplexor. The connection + polling mechanism is superimposed onto the keyboard of the first interface. + + The done and enable flags are maintained locally, and only a master interrupt + request is maintained in global register dev_done. Because this is actually + an interrupt request flag, the corresponding bit in int_enable must always + be set to 1. +*/ + +#include "pdp8_defs.h" +#include "sim_sock.h" +#include "sim_tmxr.h" +#include + +#define TTX_MAXL 16 +#define TTX_INIL 4 + +#define TTX_GETLN(x) (((x) >> 4) & TTX_MASK) + +extern int32 int_req, int_enable, dev_done, stop_inst; +extern int32 tmxr_poll; + +uint32 ttix_done = 0; /* input ready flags */ +uint32 ttox_done = 0; /* output ready flags */ +uint32 ttx_enbl = 0; /* intr enable flags */ +uint8 ttix_buf[TTX_MAXL] = { 0 }; /* input buffers */ +uint8 ttox_buf[TTX_MAXL] = { 0 }; /* output buffers */ +TMLN ttx_ldsc[TTX_MAXL] = { {0} }; /* line descriptors */ +TMXR ttx_desc = { TTX_INIL, 0, 0, ttx_ldsc }; /* mux descriptor */ +#define ttx_lines ttx_desc.lines + +int32 ttix (int32 IR, int32 AC); +int32 ttox (int32 IR, int32 AC); +t_stat ttix_svc (UNIT *uptr); +t_stat ttox_svc (UNIT *uptr); +int32 ttx_getln (int32 inst); +void ttx_new_flags (uint32 newi, uint32 newo, uint32 newe); +t_stat ttx_reset (DEVICE *dptr); +t_stat ttx_attach (UNIT *uptr, CONST char *cptr); +t_stat ttx_detach (UNIT *uptr); +void ttx_reset_ln (int32 i); +t_stat ttx_vlines (UNIT *uptr, int32 val, CONST char *cptr, void *desc); +t_stat ttx_show_devno (FILE *st, UNIT *uptr, int32 val, CONST void *desc); + +#define TTIX_SET_DONE(ln) ttx_new_flags (ttix_done | (1u << (ln)), ttox_done, ttx_enbl) +#define TTIX_CLR_DONE(ln) ttx_new_flags (ttix_done & ~(1u << (ln)), ttox_done, ttx_enbl) +#define TTIX_TST_DONE(ln) ((ttix_done & (1u << (ln))) != 0) +#define TTOX_SET_DONE(ln) ttx_new_flags (ttix_done, ttox_done | (1u << (ln)), ttx_enbl) +#define TTOX_CLR_DONE(ln) ttx_new_flags (ttix_done, ttox_done & ~(1u << (ln)), ttx_enbl) +#define TTOX_TST_DONE(ln) ((ttox_done & (1u << (ln))) != 0) +#define TTX_SET_ENBL(ln) ttx_new_flags (ttix_done, ttox_done, ttx_enbl | (1u << (ln))) +#define TTX_CLR_ENBL(ln) ttx_new_flags (ttix_done, ttox_done, ttx_enbl & ~(1u << (ln))) +#define TTX_TST_ENBL(ln) ((ttx_enbl & (1u << (ln))) != 0) + +/* TTIx data structures + + ttix_dev TTIx device descriptor + ttix_unit TTIx unit descriptor + ttix_reg TTIx register list + ttix_mod TTIx modifiers list +*/ + +DIB_DSP ttx_dsp[TTX_MAXL * 2] = { + { DEV_TTI1, &ttix }, { DEV_TTO1, &ttox }, + { DEV_TTI2, &ttix }, { DEV_TTO2, &ttox }, + { DEV_TTI3, &ttix }, { DEV_TTO3, &ttox }, + { DEV_TTI4, &ttix }, { DEV_TTO4, &ttox }, + { DEV_TTI5, &ttix }, { DEV_TTO5, &ttox }, + { DEV_TTI6, &ttix }, { DEV_TTO6, &ttox }, + { DEV_TTI7, &ttix }, { DEV_TTO7, &ttox }, + { DEV_TTI8, &ttix }, { DEV_TTO8, &ttox }, + { DEV_TTI9, &ttix }, { DEV_TTO9, &ttox }, + { DEV_TTI10, &ttix }, { DEV_TTO10, &ttox }, + { DEV_TTI11, &ttix }, { DEV_TTO11, &ttox }, + { DEV_TTI12, &ttix }, { DEV_TTO12, &ttox }, + { DEV_TTI13, &ttix }, { DEV_TTO13, &ttox }, + { DEV_TTI14, &ttix }, { DEV_TTO14, &ttox }, + { DEV_TTI15, &ttix }, { DEV_TTO15, &ttox }, + { DEV_TTI16, &ttix }, { DEV_TTO16, &ttox } + }; + +DIB ttx_dib = { DEV_TTI1, TTX_INIL * 2, { &ttix, &ttox }, ttx_dsp }; + +UNIT ttix_unit = { UDATA (&ttix_svc, UNIT_IDLE|UNIT_ATTABLE, 0), SERIAL_IN_WAIT }; + +REG ttix_reg[] = { + { BRDATAD (BUF, ttix_buf, 8, 8, TTX_MAXL, "input buffer, lines 0 to 15") }, + { ORDATAD (DONE, ttix_done, TTX_MAXL, "device done flag (line 0 rightmost)") }, + { ORDATAD (ENABLE, ttx_enbl, TTX_MAXL, "interrupt enable flag") }, + { FLDATA (SUMDONE, dev_done, INT_V_TTI1), REG_HRO }, + { FLDATA (SUMENABLE, int_enable, INT_V_TTI1), REG_HRO }, + { DRDATAD (TIME, ttix_unit.wait, 24, "initial polling interval"), REG_NZ + PV_LEFT }, + { DRDATA (LINES, ttx_desc.lines, 6), REG_HRO }, + { NULL } + }; + +MTAB ttix_mod[] = { + { MTAB_VDV, 0, "LINES", "LINES", &ttx_vlines, &tmxr_show_lines, (void *) &ttx_desc }, + { MTAB_VDV, 0, "DEVNO", NULL, NULL, &ttx_show_devno, (void *) &ttx_desc }, + { UNIT_ATT, UNIT_ATT, "SUMMARY", NULL, NULL, &tmxr_show_summ, (void *) &ttx_desc }, + { MTAB_VDV, 1, NULL, "DISCONNECT", &tmxr_dscln, NULL, (void *) &ttx_desc }, + { MTAB_VDV | MTAB_NMO, 1, "CONNECTIONS", NULL, NULL, &tmxr_show_cstat, (void *) &ttx_desc }, + { MTAB_VDV | MTAB_NMO, 0, "STATISTICS", NULL, NULL, &tmxr_show_cstat, (void *) &ttx_desc }, + { 0 } + }; + +/* debugging bitmaps */ +#define DBG_XMT TMXR_DBG_XMT /* display Transmitted Data */ +#define DBG_RCV TMXR_DBG_RCV /* display Received Data */ +#define DBG_RET TMXR_DBG_RET /* display Returned Received Data */ +#define DBG_CON TMXR_DBG_CON /* display connection activities */ +#define DBG_TRC TMXR_DBG_TRC /* display trace routine calls */ + +DEBTAB ttx_debug[] = { + {"XMT", DBG_XMT, "Transmitted Data"}, + {"RCV", DBG_RCV, "Received Data"}, + {"RET", DBG_RET, "Returned Received Data"}, + {"CON", DBG_CON, "connection activities"}, + {"TRC", DBG_TRC, "trace routine calls"}, + {0} +}; + +DEVICE ttix_dev = { + "TTIX", &ttix_unit, ttix_reg, ttix_mod, + 1, 10, 31, 1, 8, 8, + &tmxr_ex, &tmxr_dep, &ttx_reset, + NULL, &ttx_attach, &ttx_detach, + &ttx_dib, DEV_MUX | DEV_DISABLE | DEV_DEBUG, + 0, ttx_debug + }; + +/* TTOx data structures + + ttox_dev TTOx device descriptor + ttox_unit TTOx unit descriptor + ttox_reg TTOx register list +*/ + +UNIT ttox_unit[] = { + { UDATA (&ttox_svc, TT_MODE_UC, 0), SERIAL_OUT_WAIT }, + { UDATA (&ttox_svc, TT_MODE_UC, 0), SERIAL_OUT_WAIT }, + { UDATA (&ttox_svc, TT_MODE_UC, 0), SERIAL_OUT_WAIT }, + { UDATA (&ttox_svc, TT_MODE_UC, 0), SERIAL_OUT_WAIT }, + { UDATA (&ttox_svc, TT_MODE_UC+UNIT_DIS, 0), SERIAL_OUT_WAIT }, + { UDATA (&ttox_svc, TT_MODE_UC+UNIT_DIS, 0), SERIAL_OUT_WAIT }, + { UDATA (&ttox_svc, TT_MODE_UC+UNIT_DIS, 0), SERIAL_OUT_WAIT }, + { UDATA (&ttox_svc, TT_MODE_UC+UNIT_DIS, 0), SERIAL_OUT_WAIT }, + { UDATA (&ttox_svc, TT_MODE_UC+UNIT_DIS, 0), SERIAL_OUT_WAIT }, + { UDATA (&ttox_svc, TT_MODE_UC+UNIT_DIS, 0), SERIAL_OUT_WAIT }, + { UDATA (&ttox_svc, TT_MODE_UC+UNIT_DIS, 0), SERIAL_OUT_WAIT }, + { UDATA (&ttox_svc, TT_MODE_UC+UNIT_DIS, 0), SERIAL_OUT_WAIT }, + { UDATA (&ttox_svc, TT_MODE_UC+UNIT_DIS, 0), SERIAL_OUT_WAIT }, + { UDATA (&ttox_svc, TT_MODE_UC+UNIT_DIS, 0), SERIAL_OUT_WAIT }, + { UDATA (&ttox_svc, TT_MODE_UC+UNIT_DIS, 0), SERIAL_OUT_WAIT }, + { UDATA (&ttox_svc, TT_MODE_UC+UNIT_DIS, 0), SERIAL_OUT_WAIT } + }; + +REG ttox_reg[] = { + { BRDATAD (BUF, ttox_buf, 8, 8, TTX_MAXL, "last data item processed, lines 0 to 3") }, + { ORDATAD (DONE, ttox_done, TTX_MAXL, "device done flag (line 0 rightmost)") }, + { ORDATAD (ENABLE, ttx_enbl, TTX_MAXL, "interrupt enable flag") }, + { FLDATA (SUMDONE, dev_done, INT_V_TTO1), REG_HRO }, + { FLDATA (SUMENABLE, int_enable, INT_V_TTO1), REG_HRO }, + { URDATAD (TIME, ttox_unit[0].wait, 10, 24, 0, + TTX_MAXL, PV_LEFT, "line from I/O initiation to interrupt, lines 0 to 3") }, + { NULL } + }; + +MTAB ttox_mod[] = { + { TT_MODE, TT_MODE_UC, "UC", "UC", NULL }, + { TT_MODE, TT_MODE_7B, "7b", "7B", NULL }, + { TT_MODE, TT_MODE_8B, "8b", "8B", NULL }, + { TT_MODE, TT_MODE_7P, "7p", "7P", NULL }, + { MTAB_VDV, 0, "DEVNO", NULL, NULL, &ttx_show_devno, &ttx_desc }, + { MTAB_XTD|MTAB_VUN, 0, NULL, "DISCONNECT", + &tmxr_dscln, NULL, &ttx_desc }, + { MTAB_XTD|MTAB_VUN|MTAB_NC, 0, "LOG", "LOG", + &tmxr_set_log, &tmxr_show_log, &ttx_desc }, + { MTAB_XTD|MTAB_VUN|MTAB_NC, 0, NULL, "NOLOG", + &tmxr_set_nolog, NULL, &ttx_desc }, + { 0 } + }; + +DEVICE ttox_dev = { + "TTOX", ttox_unit, ttox_reg, ttox_mod, + TTX_MAXL, 10, 31, 1, 8, 8, + NULL, NULL, &ttx_reset, + NULL, NULL, NULL, + NULL, DEV_DISABLE | DEV_DEBUG, + 0, ttx_debug + }; + +/* Terminal input: IOT routine */ + +int32 ttix (int32 inst, int32 AC) +{ +int32 pulse = inst & 07; /* IOT pulse */ +int32 ln = ttx_getln (inst); /* line # */ + +if (ln < 0) /* bad line #? */ + return (SCPE_IERR << IOT_V_REASON) | AC; + +switch (pulse) { /* case IR<9:11> */ + + case 0: /* KCF */ + TTIX_CLR_DONE (ln); /* clear flag */ + break; + + case 1: /* KSF */ + return (TTIX_TST_DONE (ln))? IOT_SKP | AC: AC; + + case 2: /* KCC */ + TTIX_CLR_DONE (ln); /* clear flag */ + sim_activate_abs (&ttix_unit, ttix_unit.wait); /* check soon for more input */ + return 0; /* clear AC */ + + case 4: /* KRS */ + return (AC | ttix_buf[ln]); /* return buf */ + + case 5: /* KIE */ + if (AC & 1) + TTX_SET_ENBL (ln); + else TTX_CLR_ENBL (ln); + break; + + case 6: /* KRB */ + TTIX_CLR_DONE (ln); /* clear flag */ + sim_activate_abs (&ttix_unit, ttix_unit.wait); /* check soon for more input */ + return ttix_buf[ln]; /* return buf */ + + default: + return (stop_inst << IOT_V_REASON) | AC; + } /* end switch */ + +return AC; +} + +/* Unit service */ + +t_stat ttix_svc (UNIT *uptr) +{ +int32 ln, c, temp; + +if ((uptr->flags & UNIT_ATT) == 0) /* attached? */ + return SCPE_OK; +sim_clock_coschedule (uptr, tmxr_poll); /* continue poll */ +ln = tmxr_poll_conn (&ttx_desc); /* look for connect */ +if (ln >= 0) /* got one? */ + ttx_ldsc[ln].rcve = 1; /* set rcv enable */ +tmxr_poll_rx (&ttx_desc); /* poll for input */ +for (ln = 0; ln < ttx_lines; ln++) { /* loop thru lines */ + if (ttx_ldsc[ln].conn) { /* connected? */ + if (TTIX_TST_DONE (ln)) /* last char still pending? */ + continue; + if ((temp = tmxr_getc_ln (&ttx_ldsc[ln]))) { /* get char */ + if (temp & SCPE_BREAK) /* break? */ + c = 0; + else c = sim_tt_inpcvt (temp, TT_GET_MODE (ttox_unit[ln].flags)); + ttix_buf[ln] = c; + TTIX_SET_DONE (ln); /* set flag */ + } + } + } +return SCPE_OK; +} + +/* Terminal output: IOT routine */ + +int32 ttox (int32 inst, int32 AC) +{ +int32 pulse = inst & 07; /* pulse */ +int32 ln = ttx_getln (inst); /* line # */ + +if (ln < 0) /* bad line #? */ + return (SCPE_IERR << IOT_V_REASON) | AC; + +switch (pulse) { /* case IR<9:11> */ + + case 0: /* TLF */ + TTOX_SET_DONE (ln); /* set flag */ + break; + + case 1: /* TSF */ + return (TTOX_TST_DONE (ln))? IOT_SKP | AC: AC; + + case 2: /* TCF */ + TTOX_CLR_DONE (ln); /* clear flag */ + break; + + case 5: /* SPI */ + if ((TTIX_TST_DONE (ln) || TTOX_TST_DONE (ln)) /* either done set */ + && TTX_TST_ENBL (ln)) /* and enabled? */ + return IOT_SKP | AC; + return AC; + + case 6: /* TLS */ + TTOX_CLR_DONE (ln); /* clear flag */ + case 4: /* TPC */ + sim_activate (&ttox_unit[ln], ttox_unit[ln].wait); /* activate */ + ttox_buf[ln] = AC & 0377; /* load buffer */ + break; + + default: + return (stop_inst << IOT_V_REASON) | AC; + } /* end switch */ + +return AC; +} + +/* Unit service */ + +t_stat ttox_svc (UNIT *uptr) +{ +int32 c, ln = uptr - ttox_unit; /* line # */ + +if (ttx_ldsc[ln].conn) { /* connected? */ + if (ttx_ldsc[ln].xmte) { /* tx enabled? */ + TMLN *lp = &ttx_ldsc[ln]; /* get line */ + c = sim_tt_outcvt (ttox_buf[ln], TT_GET_MODE (ttox_unit[ln].flags)); + if (c >= 0) /* output char */ + tmxr_putc_ln (lp, c); + tmxr_poll_tx (&ttx_desc); /* poll xmt */ + } + else { + tmxr_poll_tx (&ttx_desc); /* poll xmt */ + sim_activate (uptr, ttox_unit[ln].wait); /* wait */ + return SCPE_OK; + } + } +TTOX_SET_DONE (ln); /* set done */ +return SCPE_OK; +} + +/* Flag routine + + Global dev_done is used as a master interrupt; therefore, global + int_enable must always be set +*/ + +void ttx_new_flags (uint32 newidone, uint32 newodone, uint32 newenbl) +{ +ttix_done = newidone; +ttox_done = newodone; +ttx_enbl = newenbl; +if ((ttix_done & ttx_enbl) != 0) + dev_done |= INT_TTI1; +else dev_done &= ~INT_TTI1; +if ((ttox_done & ttx_enbl) != 0) + dev_done |= INT_TTO1; +else dev_done &= ~INT_TTO1; +int_enable |= (INT_TTI1 | INT_TTO1); +int_req = INT_UPDATE; +return; +} + +/* Compute relative line number, based on table of device numbers */ + +int32 ttx_getln (int32 inst) +{ +int32 i; +int32 device = (inst >> 3) & 077; /* device = IR<3:8> */ + +for (i = 0; i < (ttx_lines * 2); i++) { /* loop thru disp tbl */ + if (device == ttx_dsp[i].dev) /* dev # match? */ + return (i >> 1); /* return line # */ + } +return -1; +} + +/* Reset routine */ + +t_stat ttx_reset (DEVICE *dptr) +{ +int32 ln; + +if (dptr->flags & DEV_DIS) { /* sync enables */ + ttix_dev.flags |= DEV_DIS; + ttox_dev.flags |= DEV_DIS; + } +else { + ttix_dev.flags &= ~DEV_DIS; + ttox_dev.flags &= ~DEV_DIS; + } +if (ttix_unit.flags & UNIT_ATT) /* if attached, */ + sim_activate (&ttix_unit, tmxr_poll); /* activate */ +else sim_cancel (&ttix_unit); /* else stop */ +for (ln = 0; ln < TTX_MAXL; ln++) /* for all lines */ + ttx_reset_ln (ln); /* reset line */ +int_enable |= (INT_TTI1 | INT_TTO1); /* set master enable */ +return SCPE_OK; +} + +/* Reset line n */ + +void ttx_reset_ln (int32 ln) +{ +uint32 mask = (1u << ln); + +ttix_buf[ln] = 0; /* clr buf */ +ttox_buf[ln] = 0; /* clr done, set enbl */ +ttx_new_flags (ttix_done & ~mask, ttox_done & ~mask, ttx_enbl | mask); +sim_cancel (&ttox_unit[ln]); /* stop output */ +return; +} + +/* Attach master unit */ + +t_stat ttx_attach (UNIT *uptr, CONST char *cptr) +{ +t_stat r; + +r = tmxr_attach (&ttx_desc, uptr, cptr); /* attach */ +if (r != SCPE_OK) /* error */ + return r; +sim_activate (uptr, 0); /* start poll at once */ +return SCPE_OK; +} + +/* Detach master unit */ + +t_stat ttx_detach (UNIT *uptr) +{ +int32 i; +t_stat r; + +r = tmxr_detach (&ttx_desc, uptr); /* detach */ +for (i = 0; i < TTX_MAXL; i++) /* all lines, */ + ttx_ldsc[i].rcve = 0; /* disable rcv */ +sim_cancel (uptr); /* stop poll */ +return r; +} + +/* Change number of lines */ + +t_stat ttx_vlines (UNIT *uptr, int32 val, CONST char *cptr, void *desc) +{ +int32 newln, i, t; +t_stat r; + +if (cptr == NULL) + return SCPE_ARG; +newln = get_uint (cptr, 10, TTX_MAXL, &r); +if ((r != SCPE_OK) || (newln == ttx_lines)) + return r; +if (newln == 0) + return SCPE_ARG; +if (newln < ttx_lines) { + for (i = newln, t = 0; i < ttx_lines; i++) + t = t | ttx_ldsc[i].conn; + if (t && !get_yn ("This will disconnect users; proceed [N]?", FALSE)) + return SCPE_OK; + for (i = newln; i < ttx_lines; i++) { + if (ttx_ldsc[i].conn) { + tmxr_linemsg (&ttx_ldsc[i], "\r\nOperator disconnected line\r\n"); + tmxr_reset_ln (&ttx_ldsc[i]); /* reset line */ + } + ttox_unit[i].flags |= UNIT_DIS; + ttx_reset_ln (i); + } + } +else { + for (i = ttx_lines; i < newln; i++) { + ttox_unit[i].flags &= ~UNIT_DIS; + ttx_reset_ln (i); + } + } +ttx_lines = newln; +ttx_dib.num = newln * 2; +return SCPE_OK; +} + +/* Show device numbers */ +t_stat ttx_show_devno (FILE *st, UNIT *uptr, int32 val, CONST void *desc) +{ +int32 i, dev_offset; +DEVICE *dptr; + +if (uptr == NULL) + return SCPE_IERR; +dptr = find_dev_from_unit (uptr); +if (dptr == NULL) + return SCPE_IERR; +/* Select correct devno entry for Input or Output device */ +if (dptr->name[2] == 'O') + dev_offset = 1; +else + dev_offset = 0; + +fprintf(st, "devno="); +for (i = 0; i < ttx_lines; i++) { + fprintf(st, "%02o%s", ttx_dsp[i*2+dev_offset].dev, i < ttx_lines-1 ? + "," : ""); +} +return SCPE_OK; +} + ADDED src/PDP8/pidp8i.c.in Index: src/PDP8/pidp8i.c.in ================================================================== --- /dev/null +++ src/PDP8/pidp8i.c.in @@ -0,0 +1,523 @@ +/* pidp8i.c: PiDP-8/I additions to the PDP-8 simulator + + Copyright © 2015-2017 by Oscar Vermeulen, Ian Schofield, and + Warren Young + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the names of the authors above shall + not be used in advertising or otherwise to promote the sale, use or other + dealings in this Software without prior written authorization from those + authors. +*/ + +#include "pidp8i.h" + +#include "../gpio-common.h" + +#include // for USB stick searching + + +//// EXPORTED GLOBALS ////////////////////////////////////////////////// + +// truly terrible even for me - break out of sim and start new script in scp.c +int awfulHackFlag = 0; + + +//// INTERNAL GLOBALS AND CONSTANTS //////////////////////////////////// + +// Single-shot flag for the STOP switch. It's global because several of +// the functions below need to examine or modify it, since more than +// just the STOP switch handler can put us into STOP mode. +static int swStop = 0; + + +//// set_pidp8i_leds /////////////////////////////////////////////////// +// Given all of the PDP-8's internal registers that affect the front +// panel display, modify the GPIO thread's LED state values accordingly. +// +// Also update the LED brightness values based on those new states. + +void set_pidp8i_leds (uint32 sPC, uint32 sMA, uint16 sMB, + uint16 sIR, int32 sLAC, int32 sMQ, int32 sIF, int32 sDF, + int32 sSC, int32 int_req, pidp8i_led_state_t eTT) +{ + // First time thru, allocate temp working space so we can flash the + // LED values over instantaneously, avoiding the need for cross- + // thread locking to get a coherent display update. + // + // Allocated dynamically only because C doesn't let us say + // temp_led_status[nledrows] on the stack, because nledrows + // isn't const-enough for C. (It is for C++; grrr.) + #define LS_BYTES (nledrows * sizeof(uint16)) + static uint16* temp_led_status = 0; + if (temp_led_status == 0) temp_led_status = malloc(LS_BYTES); + + // Groups 0-4, easy cases: single-register LED strings + temp_led_status[0] = (uint32) sPC; + temp_led_status[1] = (uint32) sMA; + temp_led_status[2] = (uint32) sMB; + temp_led_status[3] = (uint32) sLAC; + temp_led_status[4] = (uint32) sMQ; + + // Group 5a: instruction type column, decoded from current instruction + // in the IR register + uint32 tempLeds = 0; + switch ((sIR & 0xE00) >> 9) { + case 0: tempLeds |= (1 << 11); break; // 000 AND + case 1: tempLeds |= (1 << 10); break; // 001 TAD + case 2: tempLeds |= (1 << 9); break; // 010 DCA + case 3: tempLeds |= (1 << 8); break; // 011 ISZ + case 4: tempLeds |= (1 << 7); break; // 100 JMS + case 5: tempLeds |= (1 << 6); break; // 101 JMP + case 6: tempLeds |= (1 << 5); break; // 110 IOT + case 7: tempLeds |= (1 << 4); break; // 111-0 and 111-1 OPR group 1 & 2 + } + + // Group 5b: first three LEDs at the top of the next column over + if ((((sIR & 0xE00) >> 9) <= 5) && // is it a memory reference instruction? + ((sIR & 0x100) != 0)) { // is it indirect addressing? + tempLeds += (1 << 1); // then set Defer LED + } + if (eTT == pls_execute) tempLeds |= (1 << 2); // set Execute LED + if (eTT == pls_fetch) tempLeds |= (1 << 3); // set Fetch LED + + // Group 5 is done: set LEDs all at once + temp_led_status[5] = tempLeds; + + // Group 6: remaining LEDs in upper right block plus step count LEDs. + // Some of these are handled in the main instruction decoding loop. + tempLeds = 0; + if (eTT == pls_pause) tempLeds |= (1 << 8); // set Pause LED + if (int_req & INT_ION) tempLeds |= (1 << 9); // set ION LED + if (swStop == 0) tempLeds |= (1 << 7); // set Run LED + tempLeds |= ((uint32)(sSC) & 0x1f) << 2; // set Step Count LEDs + temp_led_status[6] = tempLeds; + + // Group 7: DF, IF, and Link. + // + // DF and IF are shifted up 12 bits for the simulator's convenience so + // they can simply be OR'd with PC to construct 15-bit addresses, so + // shift these values down to their positions in the LED string. + // + // Then OR in the Link bit, which SIMH keeps in bit 12 (0-based) of + // the 13-bit LAC register. + tempLeds = (uint32) (sDF >> 3) | (sIF >> 6); + tempLeds |= (uint32) ((sLAC & 010000) >> 7); + temp_led_status[7] = tempLeds; + + // Set all the LED values instantaneously. (If the compiler here + // doesn't implement this atomically, it's near-to; it may actually + // be a single CPU instruction.) + memcpy(ledstatus, temp_led_status, LS_BYTES); +} + + +//// mount_usb_stick_file ////////////////////////////////////////////// +// Search for a PDP-8 media image in one of the Pi's USB auto-mount +// directories and attempt to ATTACH it to the simulator. + +static void mount_usb_stick_file (int devNo, char *devCode) +{ + char sFoundFile[CBUFSIZE] = { '\0' }; + char sUSBPath[CBUFSIZE]; // will be "/media/usb0" etc + char fileExtension[4]; // will be ".RX" etc + int i, j; + + // Build expected file name extension from the first two characters of + // the passed-in device code. + fileExtension[0] = '.'; // extension starts with a . + strncpy (fileExtension + 1, devCode, 2); // extension is PT, RX, RL etc + fileExtension[2] = '\0'; // chop off device number + + // Forget the prior file attached to this PDP-8 device. The only reason + // we keep track is so we don't have the same media image file attached + // to both devices of a given type we support. That is, you can't have + // a given floppy image file attached to both RX01 drives, but you *can* + // repeatedly re-ATTACH the same floppy image to the first RX01 drive. + static char mountedFiles[8][CBUFSIZE]; + mountedFiles[devNo][0] = '\0'; + + for (i = 0; i < 8 && sFoundFile[0] == '\0'; ++i) { + // search all 8 USB mount points, numbered 0-7 + snprintf (sUSBPath, sizeof (sUSBPath), "/media/usb%d", i); + DIR *pDir = opendir (sUSBPath); + if (pDir) { + struct dirent* pDirent; + while ((pDirent = readdir (pDir)) != 0) { // search all files in directory + if (strstr (pDirent->d_name, fileExtension)) { + snprintf (sFoundFile, sizeof (sFoundFile), "%s/%s", + sUSBPath, pDirent->d_name); + for (j = 0; j < 7; ++j) { + if (strncmp (mountedFiles[j], sFoundFile, CBUFSIZE) == 0) { + break; // already mounted; skip next + } + } + if (j == 7) { + // Media image file is not already mounted, so leave while + // loop with path set to mount it + break; + } + else { + // It's mounted, so forget its path, else we will stop + // searching the other USB mount points + sFoundFile[0] = '\0'; + } + } + } + + closedir (pDir); + } + else { + // Not a Pi or the USB auto-mounting software isn't installed + printf ("\r\nCannot open %s: %s\r\n", sUSBPath, strerror (errno)); + return; + } + } + + if (sFoundFile[0]) { // no file found, exit + if (access (sFoundFile, R_OK) == 0) { + if (attach_cmd ((int32) 0, sFoundFile) == SCPE_OK) { // issue ATTACH command + // add file to mount list + strncpy (mountedFiles[devNo], sFoundFile, CBUFSIZE); + printf ("\r\nMounted %s %s\r\n", devCode, mountedFiles[devNo]); + } + else { + printf ("\r\nSIMH error mounting %s\r\n", devCode); + } + } + else { + printf ("\r\nCannot read medium image %s from USB: %s\r\n", + sFoundFile, strerror (errno)); + } + } + else { + printf ("\r\nNo unmounted %s file found\r\n", devCode); + } +} + + +//// handle_sing_step ////////////////////////////////////////////////// +// Handle SING_STEP combinations as nonstandard functions with respect +// to a real PDP-8, since SIMH doesn't try to emulate the PDP-8's +// single-stepping mode — not to be confused with single-instruction +// mode, which SIMH *does* emulate — so the SING_STEP switch is free +// for our nonstandard uses. +// +// This is separate from handle_flow_control_switches() only because +// there are so many cases here that it would obscure the overall flow +// of our calling function to do all this there. + +static pidp8i_flow_t handle_sing_step(int closed) +{ + // If SING_STEP is open, we do nothing here except reset the single-shot + // flag if it was set. + static int single_shot = 0; + if (!closed) { + single_shot = 0; + return pft_normal; + } + + // There are two sets of SING_STEP combos: first up are those where the + // other switches involved have to be set already, and the function is + // triggered as soon as SING_STEP closes. These are functions we don't + // want re-executing repeatedly while SING_STEP remains closed. + if (single_shot == 0) { + // SING_STEP switch was open last we knew, and now it's closed, so + // set the single-shot flag. + single_shot = 1; + + // 1. Convert DF switch values to a device number, which + // we will map to a PDP-8 device type, then attempt to + // ATTACH some unmounted medium from USB to that device + // + // We treat DF == 0 as nothing to mount, since we use + // SING_STEP for other things, so we need a way to + // decide which meaning of SING_STEP to take here. + // + // The shift by 9 is how many non-DF bits are below + // DF in switchstatus[1] + // + // The bit complement is because closed DF switches show + // as 0, because they're dragging the pull-up down, but + // we want those treated as 1s, and vice versa. + uint16_t css1 = ~switchstatus[1]; + int swDevice = (css1 & SS1_DF_ALL) >> 9; + if (swDevice) { + char swDevCode[4] = { '\0' }; + switch (swDevice) { + case 1: strcpy(swDevCode, "ptr"); break; // PTR paper tape reader + case 2: strcpy(swDevCode, "ptp"); break; // High speed paper tape punch + case 3: strcpy(swDevCode, "dt0"); break; // TC08 DECtape (#8 is first!) + case 4: strcpy(swDevCode, "dt1"); break; + case 5: strcpy(swDevCode, "rx0"); break; // RX8E (8/e peripheral!) + case 6: strcpy(swDevCode, "rx1"); break; + case 7: strcpy(swDevCode, "rl0"); break; // RL8A + } + if (swDevCode[0]) mount_usb_stick_file(swDevice, swDevCode); + } + + // 2. Do the same with IF, except that the switch value + // is used to decide which boot script to restart with via + // SIMH's DO command. + // + // The shift value of 6 is because the IF switches are 3 + // down from the DF switches above. + int swScript = (css1 & SS1_IF_ALL) >> 6; + if (swScript) { + // build filename from IF value + char sScript[256]; + snprintf(sScript, sizeof(sScript), "@BOOTDIR@/%d.script", swScript); + printf("\r\n\nRebooting %s\r\n\r\n", sScript); + awfulHackFlag = swScript; // this triggers a do command after leaving the simulator run. + return pft_halt; + } + } // end if single-shot flag clear + else { + // Now handle the second set of SING_STEP special-function + // combos, being those where the switches can be pressed in any + // order, so that we take action when the last one of the set + // closes, no matter which one that is. These immediately exit + // the SIMH instruction interpreter, so they won't re-execute + // merely because the human isn't fast enough to lift his finger + // by the time the next iteration of that loop starts. + + // 3. Scan for host poweroff command (Sing_Step + Sing_Inst + Stop) + if ((switchstatus[2] & (SS2_S_INST | SS2_STOP)) == 0) { + printf("\r\nShutdown\r\n\r\n"); + awfulHackFlag = 8; // this triggers an exit command after leaving the simulator run. + if (spawn_cmd (0, "sudo /bin/systemctl poweroff") != SCPE_OK) { + printf("\r\n\r\npoweroff failed\r\n\r\n"); + } + return pft_halt; + } + + // 4. Scan for host reboot command (Sing_Step + Sing_Inst + Start) + if ((switchstatus[2] & (SS2_S_INST | SS2_START)) == 0) { + printf("\r\nReboot\r\n\r\n"); + awfulHackFlag = 8; // this triggers an exit command after leaving the simulator run. + if (spawn_cmd (0, "sudo /bin/systemctl reboot") != SCPE_OK) { + printf("\r\n\r\nreboot failed\r\n\r\n"); + } + return pft_halt; + } + + #if 0 + // These combos once meant something, but no longer do. If you + // reassign them, think carefully whether they should continue to + // be handled here and not above in the "if" branch. If nothing + // prevents your function from being re-executed while SING_STEP + // remains closed and re-execution would be bad, move the test + // under the aegis of the single_shot flag. + + // 5. Sing_Step + Sing_Inst + Load Add + if ((switchstatus[2] & (SS2_S_INST | SS2_L_ADD)) == 0) { } + + // 6. Sing_Step + Sing_Inst + Deposit + if ((switchstatus[2] & (SS2_S_INST | SS2_DEP)) == 0) { } + #endif + } + + return pft_normal; +} + + +//// handle_flow_control_switches ////////////////////////////////////// +// Process all of the PiDP-8/I front panel switches that can affect the +// flow path of the PDP-8 simulator's instruction interpretation loop, +// returning a code telling the simulator our decision. +// +// The simulator passes in pointers to PDP-8 registers we may modify as +// a side effect of handling these switches. + +pidp8i_flow_t handle_flow_control_switches(uint16* pM, + uint32 *pPC, uint32 *pMA, int32 *pMB, int32 *pLAC, int32 *pIF, + int32 *pDF, int32* pint_req) +{ + // Exit early if the blink() thread has not attached itself to the GPIO + // peripheral in the Pi, since that means we cannot safely interpret the + // data in the switchstatus array. This is especially important on + // non-Pi hosts, since switchstatus will remain zeroed, which we would + // interpret as "all switches are pressed!", causing havoc. + // + // It would be cheaper for our caller to check this for us and skip the + // call, but there's no good reason to expose such implementations + // details to it. We're trying to keep the PDP-8 simulator's CPU core + // as free of PiDP-8/I details as is practical. + if (!pidp8i_gpio_present) return pft_normal; + + // Handle the nonstandard SING_STEP + X combos, some of which halt + // the processor. + if (handle_sing_step ((switchstatus[2] & SS2_S_STEP) == 0) == pft_halt) { + return pft_halt; + } + + // Check for SING_INST switch close... + static int swSingInst = 0; + if (((switchstatus[2] & SS2_S_INST) == 0) && (swSingInst == 0)) { + // Put the processor in stop mode until we get a CONT or START + // switch closure. Technically this is wrong according to DEC's + // docs: we're supposed to finish executing the next instruction + // before we "clear the RUN flip-flop" in DEC terms, whereas + // we're testing these switches before we fetch the next + // instruction. Show me how it matters, and I'll fix it. :) + swSingInst = 1; + swStop = 1; + } + + // ...and SING_INST switch open + if (swSingInst && (switchstatus[2] & SS2_S_INST)) { + swSingInst = 0; + } + + // Check for START switch press... + static int swStart = 0; + if (((switchstatus[2] & SS2_START) == 0) && (swStart == 0)) { + *pint_req = *pint_req & ~INT_ION; // disable ION. says so in handbook, true? + *pLAC = 0; // clear L and AC; + *pMB = 0; // clear MB. + *pMA = *pPC & 07777; // transfer PC into MA (FIXME: does IR make this unnecessary?) + swStop = 0; // START cancels STOP mode + swSingInst = 0; // allow SING INST mode re-entry + swStart = 1; // make it single-shot + } + + // ...and START switch release + if (swStart && (switchstatus[2] & SS2_START)) { + swStart = 0; + } + + // Check for CONT switch press... + static int swCont = 0; + if (((switchstatus[2] & SS2_CONT) == 0) && (swCont < 2)) { + if (swCont == 0) { + // On the initial CONT press, release stop mode regardless + // of how it was enabled to execute the next instruction. + // + // FIXME: Are we handling MB correctly? [973271ae36] + swStop = 0; + swCont = 1; // make it single-shot + } + else if (swCont == 1) { + // The second time we come back in here while the CONT + // switch is still down -- the human is too slow to + // release it between iterations -- we stop paying attention + // to it until the switch opens; check below. Re-enter stop + // mode if SING_INST is still closed, else leave stop mode + // because we must have stopped via STOP or HLT. + swStop = !!swSingInst; + swCont = 2; + } + } + + // ...and CONT switch release + if (swCont && (switchstatus[2] & SS2_CONT)) { + swCont = 0; + } + + // Check for LOAD_ADD switch press. (No "and release" beacuse it's + // harmless if this keeps happening until the slow human releases the + // switch. This function is idempotent.) + if ((switchstatus[2] & SS2_L_ADD) == 0) { + // Copy SR into PC. We're XORing instead of masking and copying + // because the switchstatus bits are opposite what we want here: we + // get a 0 from the GPIO peripheral when the switch is closed, which + // is the switch's "1" position. + *pPC = switchstatus[0] ^ 07777; + + // Copy DF switch settings to DF register + // + // The shift is because the DF positions inside the switchstatus[1] + // register happen to be 3 bit positions off of where we want them + // in DF here: we want to be able to logically OR PC and DF to make + // 15-bit data access addresses. + // + // We complement the bits here for the same reason we XOR'd the PC + // value above. + uint16_t css1 = ~switchstatus[1]; + *pDF = (css1 & SS1_DF_ALL) << 3; + + // Do the same for IF. The only difference comes from the fact that + // IF is the next 3 bits down in switchstatus[1]. + *pIF = (css1 & SS1_IF_ALL) << 6; + } + + // Check for DEP switch press... + static int swDep = 0; + if (((switchstatus[2] & SS2_DEP) == 0) && (swDep == 0)) { + pM[*pPC] = switchstatus[0] ^ 07777; // XOR rationale above + /* ??? in 66 handbook: strictly speaking, SR goes into AC, + then AC into MB. Does it clear AC afterwards? If not, needs fix */ + *pMB = pM[*pPC]; + *pMA = *pPC & 07777; // MA trails PC on FP + *pPC = (*pPC + 1) & 07777; // increment PC + swDep = 1; // make it single-shot + } + + // ...and DEP switch release + if (swDep && (switchstatus[2] & SS2_DEP)) { + swDep = 0; + } + + // Check for EXAM switch press... + static int swExam = 0; + if (((switchstatus[2] & SS2_EXAM) == 0) && (swExam == 0)) { + *pMB = pM[*pPC]; + *pMA = *pPC & 07777; // MA trails PC on FP + *pPC = (*pPC + 1) & 07777; // increment PC + swExam = 1; // make it single-shot + } + + // ...and EXAM switch release + if (swExam && (switchstatus[2] & SS2_EXAM)) { + swExam = 0; + } + + // Check for STOP switch press. No "and release" because we get out of + // STOP mode with START or CONT, not by releasing STOP, and while in + // STOP mode, this switch's function is idempotent. + if ((switchstatus[2] & SS2_STOP) == 0) { + swStop = 1; + } + + // If any of the above put us into STOP mode, go no further. In + // particular, fetch no more instructions, and do not touch PC! + if (swStop == 1) return pft_stop; + + return pft_normal; +} + + +//// get_switch_register /////////////////////////////////////////////// +// Return the current contents of the switch register + +int32 get_switch_register(void) +{ + return switchstatus[0] ^ 07777; +} + + +//// set_stop_mode ///////////////////////////////////////////////////// +// Set the STOP mode flag. This is a wrapper around a module-global +// variable that the CPU simulator core currently needs to set. + +void set_stop_mode(void) +{ + swStop = 1; +} ADDED src/PDP8/pidp8i.h Index: src/PDP8/pidp8i.h ================================================================== --- /dev/null +++ src/PDP8/pidp8i.h @@ -0,0 +1,60 @@ +/* pidp8i.h: Interface between PiDP-8/I additions and the stock SIMH PDP-8 + simulator + + Copyright © 2015-2017 by Oscar Vermeulen and Warren Young + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the names of the authors above shall + not be used in advertising or otherwise to promote the sale, use or other + dealings in this Software without prior written authorization from those + authors. +*/ + +#if !defined(PIDP8I_H) +#define PIDP8I_H + +#include "pdp8_defs.h" + +typedef enum { + pft_normal, + pft_halt, + pft_stop, +} pidp8i_flow_t; + +typedef enum { + pls_fetch, + pls_execute, + pls_pause, +} pidp8i_led_state_t; + +extern int awfulHackFlag; + +extern int32 get_switch_register(void); + +extern pidp8i_flow_t handle_flow_control_switches(uint16* pM, + uint32 *pPC, uint32 *pMA, int32 *pMB, int32 *pLAC, int32 *pIF, + int32 *pDF, int32* pint_req); + +extern void set_pidp8i_leds (uint32 sPC, uint32 sMA, uint16 sMB, + uint16 sIR, int32 sLAC, int32 sMQ, int32 sIF, int32 sDF, + int32 sSC, int32 int_req, pidp8i_led_state_t eTT); +extern void set_stop_mode(void); + +#endif // !defined(PIDP8I_H) ADDED src/gpio-common.c.in Index: src/gpio-common.c.in ================================================================== --- /dev/null +++ src/gpio-common.c.in @@ -0,0 +1,404 @@ +/* + * gpio-common.c: functions common to both gpio.c and gpio-nls.c + * + * Copyright © 2015-2017 Oscar Vermeulen and Warren Young + * + * Permission is hereby granted, free of charge, to any person obtaining a + * copy of this software and associated documentation files (the "Software"), + * to deal in the Software without restriction, including without limitation + * the rights to use, copy, modify, merge, publish, distribute, sublicense, + * and/or sell copies of the Software, and to permit persons to whom the + * Software is furnished to do so, subject to the following conditions: + * + * The above copyright notice and this permission notice shall be included in + * all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + * THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + * DEALINGS IN THE SOFTWARE. + * + * Except as contained in this notice, the names of the authors above shall + * not be used in advertising or otherwise to promote the sale, use or other + * dealings in this Software without prior written authorization from those + * authors. + * + * www.obsolescenceguaranteed.blogspot.com + * + * The only communication with the main program (simh): + * - external variable ledstatus is read to determine which leds to light. + * - external variable switchstatus is updated with current switch settings. +*/ + +#include "gpio-common.h" + +#include "config.h" + +#include +#include +#include + +#include +#include +#include +#include +#ifdef HAVE_TIME_H +# include +#endif + +#define BLOCK_SIZE (4*1024) + + +// Flag set after we successfully init the GPIO mechanism. While this +// is false, the rest of the code knows not to expect useful values for +// LED and switch states. It is also useful as a cross-thread signal, +// since merely starting the blink() thread doesn't tell you whether it +// managed to lock the GPIO device. +uint8_t pidp8i_gpio_present; + +struct bcm2835_peripheral gpio; // needs initialisation + + +// A constant meaning "indeterminate milliseconds", used for error +// returns from ms_time() and for the case where the switch is in the +// stable state in the switch_state array. +static const ms_time_t na_ms = (ms_time_t)-1; + + +// Adjust columns to scan based on whether the serial mod was done, as +// that affects the free GPIOs for our use, and how the PCB connects +// them to the LED matrix. +#ifdef PCB_SERIAL_MOD +uint8_t cols[] = {13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 3, 2}; +#else +uint8_t cols[] = {13, 12, 11, 10, 9, 8, 7, 6, 5, 4, 15, 14}; +#endif + +uint8_t ledrows[] = {20, 21, 22, 23, 24, 25, 26, 27}; + +uint8_t rows[] = {16, 17, 18}; + +// Array sizes. Must be declared twice because we need to export them, +// and C doesn't have true const, as C++ does. +#define NCOLS (sizeof(cols) / sizeof(cols[0])) +#define NLEDROWS (sizeof(ledrows) / sizeof(ledrows[0])) +#define NROWS (sizeof(rows) / sizeof(rows[0])) +const size_t ncols = NCOLS; +const size_t nledrows = NLEDROWS; +const size_t nrows = NROWS; + +// The public switch and LED API: other threads poke values into +// ledstatus to affect our GPIO LED pin driving loop and read values +// from switchstatus to discover our current published value of the +// switch states. The latter may differ from the *actual* switch +// states due to the debouncing procedure. +uint16_t switchstatus[NROWS]; // bitfield: sparse nrows x ncols switch matrix +uint16_t ledstatus[NLEDROWS]; // bitfield: sparse nledrows x ncols LED matrix + +// Time-delayed reaction to switch changes to debounce the contacts. +// This is especially important with the incandescent lamp simulation +// feature enabled since that speeds up the GPIO scanning loop, making +// it more susceptible to contact bounce. +struct switch_state { + // switch state currently reported via switchstatus[] + int stable_state; + + // ms the switch state has been != stable_state, or na_ms + // if it is currently in that same state + ms_time_t last_change; +}; +static struct switch_state gss[NROWS][NCOLS]; +int gss_initted = 0; +static const ms_time_t debounce_ms = 50; // time switch state must remain stable + +// Name of GPIO memory-mapped device +static const char* gpio_mem_dev = "/dev/gpiomem"; + + +// Exposes the physical address defined in the passed structure +int map_peripheral(struct bcm2835_peripheral *p) +{ + // Open the GPIO device + if ((p->mem_fd = open(gpio_mem_dev, O_RDWR|O_SYNC) ) < 0) { +#ifdef DEBUG + printf("Failed to open %s: %s\n", gpio_mem_dev, strerror(errno)); + puts("Disabling PiDP-8/I front panel functionality."); +#endif + return -1; + } + + // Attempt to lock it. If we can't, another program has it locked, + // so we shouldn't keep running; it'll just end in tears. + if (flock(p->mem_fd, LOCK_EX | LOCK_NB) < 0) { + if (errno == EWOULDBLOCK) { + printf("Failed to lock %s. Only one PiDP-8/I\n", gpio_mem_dev); + puts("program can be running at a given time."); + } + else { + printf("Failed to lock %s: %s\n", gpio_mem_dev, strerror(errno)); + puts("Only one PiDP-8/I program can be running at a given time."); + } + return -1; + } + + // Map the GPIO peripheral into our address space + if ((p->map = mmap( + NULL, BLOCK_SIZE, PROT_READ|PROT_WRITE, MAP_SHARED, + p->mem_fd, + p->addr_p)) == MAP_FAILED) { + perror("mmap"); + return -1; + } + + // Success! + p->addr = (volatile unsigned int *)p->map; + pidp8i_gpio_present = 1; + return 0; +} + + +void unmap_peripheral(struct bcm2835_peripheral *p) +{ + // Unwind the map_peripheral() steps in reverse order + if (pidp8i_gpio_present) { + if (p->mem_fd > 0) { + if (p->map) munmap(p->map, BLOCK_SIZE); + flock(p->mem_fd, LOCK_UN); + close(p->mem_fd); + } + pidp8i_gpio_present = 0; + } +} + + +unsigned bcm_host_get_peripheral_address(void) // find Pi's GPIO base address +{ + unsigned address = ~0; + FILE *fp = fopen("/proc/device-tree/soc/ranges", "rb"); + if (fp) + { unsigned char buf[4]; + fseek(fp, 4, SEEK_SET); + if (fread(buf, 1, sizeof buf, fp) == sizeof buf) + address = buf[0] << 24 | buf[1] << 16 | buf[2] << 8 | buf[3] << 0; + fclose(fp); + } + + return address == ~0 ? 0x20000000 : address; +} + + +void sleep_ns(ns_time_t ns) +{ + struct timespec ts = { 0, ns }; +#if defined(HAVE_CLOCK_NANOSLEEP) + clock_nanosleep(CLOCK_REALTIME, 0, &ts, NULL); +#elif defined(HAVE_NANOSLEEP) + nanosleep(&ts, NULL); +#elif defined(HAVE_USLEEP) + usleep(ns / 1000); +#else +# error Cannot build GPIO controller without high-res "sleep" function! +#endif +} + + +// Like time(2) except that it returns milliseconds since the Unix epoch +ms_time_t ms_time(ms_time_t* pt) +{ + struct timeval tv; + if (gettimeofday(&tv, 0) == 0) { + ms_time_t t = (ms_time_t)(tv.tv_sec / 1000.0 + tv.tv_usec * 1000.0); + if (pt) *pt = t; + return t; + } + else { + return na_ms; + } +} + + +// Save given switch state ss into the exported switchstatus bitfield +// so the simulator core will see it. (Constrast the gss matrix, +// which holds our internal view of the unstable truth.) +static void report_ss(int row, int col, int ss, + struct switch_state* pss) +{ + pss->stable_state = ss; + pss->last_change = na_ms; + + int mask = 1 << col; + if (ss) switchstatus[row] |= mask; + else switchstatus[row] &= ~mask; + + #ifdef DEBUG + printf("%cSS[%d][%02d] = %d ", gss_initted ? 'N' : 'I', row, col, ss); + #endif +} + + +// Given the state of the switch at (row,col), work out if this requires +// a change in our exported switch state. +void debounce_switch(int row, int col, int ss, ms_time_t now_ms) +{ + struct switch_state* pss = &gss[row][col]; + + if (!gss_initted) { + // First time thru, so set this switch's module-global and + // exported state to its defaults now that we know the switch's + // initial state. + report_ss(row, col, ss, pss); + } + else if (ss == pss->stable_state) { + // This switch is still/again in the state we consider "stable", + // which we are reporting in our switchstatus bitfield. Reset + // the debounce timer in case it is returning to its stable + // state from a brief blip into the other state. + pss->last_change = na_ms; + } + else if (pss->last_change == na_ms) { + // This switch just left what we consider the "stable" state, so + // start the debounce timer. + pss->last_change = now_ms; + } + else if ((now_ms - pss->last_change) > debounce_ms) { + // Switch has been in the new state long enough for the contacts + // to have stopped bouncing: report its state change to outsiders. + report_ss(row, col, ss, pss); + } + // else, switch was in the new state both this time and the one prior, + // but it hasn't been there long enough to report it +} + + +// Write a configuration string tag. +static const char* pi_type(int p) +{ + if (p == 0x20200000) { + return "pi1+"; + } + else { + FILE* fp = fopen("/proc/device-tree/model", "r"); + if (fp) { + static char ac[60]; + if (fgets(ac, sizeof(ac), fp) && (strlen(ac) > 20)) { + if (strstr(ac, "Raspberry Pi ") == ac) { + int series = atoi(ac + 13); + char model = 'x'; + char* pm = strstr(ac, " Model "); + if (pm) model = tolower(pm[7]); + snprintf(ac, sizeof(ac), "pi%d%c", series, model); + return ac; + } + } + return "pi2+"; + } + } + + return 0; // not a Pi +} + + +// The GPIO thread entry point: initializes GPIO and then calls +// the blink_core() implementation linked to this program. + +void *blink(void *terminate) +{ + // Find GPIO address (it varies by Pi model) + gpio.addr_p = bcm_host_get_peripheral_address() + 0x200000; + + // Set thread to real time priority + struct sched_param sp; + sp.sched_priority = 4; // not high, just above the minimum of 1 + int rt = pthread_setschedparam(pthread_self(), SCHED_FIFO, &sp) == 0; + + // Map the GPIO peripheral, but hold off exiting if it fails, until + // we report its absence in the config line. + int mapped = map_peripheral(&gpio) == 0; + + // Tell the user about our configuration, succinctly + const char* pt = pi_type(mapped ? gpio.addr_p : 0); + printf( + "PiDP-8/I @VERSION@ [%s] [@LED_DRIVER_MODULE@ls] [%spcb]%s" +#ifdef DEBUG + " [debug]" +#endif + "%s", + pt ? pt : "cake", // pt == 0 == not a Pi + pt ? +#ifdef PCB_SERIAL_MOD + "ser" : +#else + "std" : +#endif + "no", + mapped ? " [gpio]" : "", + rt ? " [rt]" : "" + ); + + // Hand off control to the blink_core() variant linked to this + // program: either the new incandescent lamp simulator or the old + // stock version. + if (mapped) { + // initialise GPIO (all pins used as inputs, with pull-ups enabled on cols) + // INSERT CODE HERE TO SET GPIO 14 AND 15 TO I/O INSTEAD OF ALT 0. + // AT THE MOMENT, USE "sudo ./gpio mode 14 in" and "sudo ./gpio mode 15 in". "sudo ./gpio readall" to verify. + #define pgpio (&gpio) + int i; + for (i = 0; i +#include +#include +#include + +#include +#include +#include + + +// GPIO setup macros. Always use INP_GPIO(x) before using OUT_GPIO(x) +#define INP_GPIO(g) *(pgpio->addr + ((g)/10)) &= ~(7<<(((g)%10)*3)) +#define OUT_GPIO(g) *(pgpio->addr + ((g)/10)) |= (1<<(((g)%10)*3)) +#define SET_GPIO_ALT(g,a) *(pgpio->addr + (((g)/10))) |= (((a)<=3?(a) + 4:(a)==4?3:2)<<(((g)%10)*3)) + +#define GPIO_SET *(pgpio->addr + 7) // sets bits which are 1 ignores bits which are 0 +#define GPIO_CLR *(pgpio->addr + 10) // clears bits which are 1 ignores bits which are 0 + +#define GPIO_READ(g) *(pgpio->addr + 13) &= (1<<(g)) + +#define GPIO_PULL *(pgpio->addr + 37) // pull up/pull down +#define GPIO_PULLCLK0 *(pgpio->addr + 38) // pull up/pull down clock + + +// Switch masks, SSn, used against switchstatus[n] +#define SS0_SR_B11 04000 +#define SS0_SR_B10 02000 +#define SS0_SR_B09 01000 +#define SS0_SR_B08 00400 +#define SS0_SR_B07 00200 +#define SS0_SR_B06 00100 +#define SS0_SR_B05 00040 +#define SS0_SR_B04 00020 +#define SS0_SR_B03 00010 +#define SS0_SR_B02 00004 +#define SS0_SR_B01 00002 +#define SS0_SR_B00 00001 + +#define SS1_DF_B2 04000 +#define SS1_DF_B1 02000 +#define SS1_DF_B0 01000 +#define SS1_DF_ALL (SS1_DF_B2 | SS1_DF_B1 | SS1_DF_B0) + +#define SS1_IF_B2 00400 +#define SS1_IF_B1 00200 +#define SS1_IF_B0 00100 +#define SS1_IF_ALL (SS1_IF_B2 | SS1_IF_B1 | SS1_IF_B0) + +#define SS2_START 04000 +#define SS2_L_ADD 02000 +#define SS2_DEP 01000 +#define SS2_EXAM 00400 +#define SS2_CONT 00200 +#define SS2_STOP 00100 +#define SS2_S_STEP 00040 +#define SS2_S_INST 00020 + +// Info for accessing the GPIO peripheral on the SoC +struct bcm2835_peripheral { + uint32_t addr_p; + int mem_fd; + void *map; + volatile unsigned int *addr; +}; + +typedef uint64_t ns_time_t; +typedef useconds_t us_time_t; +typedef uint32_t ms_time_t; + +extern uint16_t switchstatus[]; +extern uint16_t ledstatus[]; +extern uint8_t cols[]; +extern uint8_t ledrows[]; +extern uint8_t rows[]; +extern const size_t ncols, nledrows, nrows; +extern uint8_t pidp8i_gpio_present; + +extern int gss_initted; + +extern void *blink(void *ptr); // thread entry point to the gpio module +extern unsigned bcm_host_get_peripheral_address(void); +extern void debounce_switch(int row, int col, int ss, ms_time_t now_ms); +extern int map_peripheral(struct bcm2835_peripheral *p); +extern ms_time_t ms_time(ms_time_t* pt); +extern void sleep_ns(ns_time_t ns); +#define sleep_us(us) usleep(us) +#define sleep_ms(ms) usleep(ms * 1000) +void unmap_peripheral(struct bcm2835_peripheral *p); + +#endif // !defined(PIDP8I_GPIO_H) ADDED src/gpio-ils.c Index: src/gpio-ils.c ================================================================== --- /dev/null +++ src/gpio-ils.c @@ -0,0 +1,149 @@ +/* + * gpio-ils.c: implements blink_core() for Ian Schofield's incandescent + * lamp simulator + * + * Copyright © 2015-2017 Oscar Vermeulen, Ian Schofield, and Warren Young + * + * Permission is hereby granted, free of charge, to any person obtaining a + * copy of this software and associated documentation files (the "Software"), + * to deal in the Software without restriction, including without limitation + * the rights to use, copy, modify, merge, publish, distribute, sublicense, + * and/or sell copies of the Software, and to permit persons to whom the + * Software is furnished to do so, subject to the following conditions: + * + * The above copyright notice and this permission notice shall be included in + * all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + * THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + * DEALINGS IN THE SOFTWARE. + * + * Except as contained in this notice, the names of the authors above shall + * not be used in advertising or otherwise to promote the sale, use or other + * dealings in this Software without prior written authorization from those + * authors. + * + * www.obsolescenceguaranteed.blogspot.com +*/ + +#include "gpio-common.h" + +#include "sim_defs.h" + + +//// CONSTANTS ///////////////////////////////////////////////////////// + +// Brightness range is [0, MAX_BRIGHTNESS) truncated. +#define MAX_BRIGHTNESS 32 + +// On each iteration, we add or subtract a proportion of the current LED +// value back to it as its new brightness, based on the LED's current +// internal state. This gives a nonlinear increase/decrease behavior, +// where rising from "off" or dropping from "full-on" is fast to start +// and slows down as it approaches its destination. +// +// We use an asymmetric function depending on whether the LED is turning +// on or off to better mimic the behavior of an incandescent lamp, which +// reaches full brightness faster than it turns fully off. +#define RISING_FACTOR 0.02 +#define FALLING_FACTOR 0.008 + + +//// blink_core //////////////////////////////////////////////////////// +// The GPIO module's main loop core, called from thread entry point in +// gpio-common.c. + +void blink_core(struct bcm2835_peripheral* pgpio, int* terminate) +{ + int i, j, k; + const us_time_t intervl = 5; // light each row of leds 5 µs + ms_time_t now_ms; + + float brtval[96]; + uint8 brctr[96], bctr = 0, ndx; + memset(brtval, 0, sizeof (brtval)); + + while (*terminate == 0) { + // prepare for lighting LEDs by setting col pins to output + for (i = 0; i < ncols; i++) { + INP_GPIO(cols[i]); + OUT_GPIO(cols[i]); // Define cols as output + } + if (bctr == 0) { + memset(brctr, 0, sizeof (brctr)); + bctr = MAX_BRIGHTNESS; + } + + // Increase or decrease each LED's brightness based on whether + // it is currently enabled. These values affect the duty cycle + // of the signal put out by the GPIO thread to each LED, thus + // controlling brightness. + float *p = brtval; + for (int row = 0; row < nledrows; ++row) { + for (int col = 0, msk = 1; col < ncols; ++col, ++p, msk <<= 1) { + if (ledstatus[row] & msk) + *p += (MAX_BRIGHTNESS - *p) * RISING_FACTOR; + else + *p -= *p * FALLING_FACTOR; + } + } + + // light up LEDs + for (i = ndx = 0; i < nledrows; i++) { + // Toggle columns for this ledrow (which LEDs should be on (CLR = on)) + for (k = 0; k < ncols; k++, ndx++) { + if (++brctr[ndx] < brtval[ndx]) + GPIO_CLR = 1 << cols[k]; + else + GPIO_SET = 1 << cols[k]; + } + + // Toggle this ledrow on + INP_GPIO(ledrows[i]); + GPIO_SET = 1 << ledrows[i]; // test for flash problem + OUT_GPIO(ledrows[i]); + + sleep_us(intervl); + + // Toggle ledrow off + GPIO_CLR = 1 << ledrows[i]; // superstition + INP_GPIO(ledrows[i]); + + sleep_us(intervl); + } + + // prepare for reading switches + ms_time(&now_ms); + for (i = 0; i < ncols; i++) { + INP_GPIO(cols[i]); // flip columns to input. Need internal pull-ups enabled. + } + + // read three rows of switches + for (i = 0; i < nrows; i++) { + INP_GPIO(rows[i]); + OUT_GPIO(rows[i]); // turn on one switch row + GPIO_CLR = 1 << rows[i]; // and output 0V to overrule built-in pull-up from column input pin + + sleep_ns(intervl * 1000 / 100); + + for (j = 0; j < ncols; j++) { // ncols switches in each row + int ss = GPIO_READ(cols[j]); + debounce_switch(i, j, !!ss, now_ms); + } + + INP_GPIO(rows[i]); // stop sinking current from this row of switches + } + + fflush(stdout); + gss_initted = 1; + bctr--; + +#if defined(HAVE_SCHED_YIELD) + sched_yield(); +#endif + } +} ADDED src/gpio-nls.c Index: src/gpio-nls.c ================================================================== --- /dev/null +++ src/gpio-nls.c @@ -0,0 +1,107 @@ +/* + * gpio-nls.c: implements blink_core() with the original simple LED driver + * + * This file differs from gpio.c in that it does not include the + * incandescent lamp simulator feature by Ian Schofield. It is + * more directly descended from the original gpio.c by Oscar Vermeulen. + * + * Copyright © 2015-2017 Oscar Vermeulen and Warren Young + * + * Permission is hereby granted, free of charge, to any person obtaining a + * copy of this software and associated documentation files (the "Software"), + * to deal in the Software without restriction, including without limitation + * the rights to use, copy, modify, merge, publish, distribute, sublicense, + * and/or sell copies of the Software, and to permit persons to whom the + * Software is furnished to do so, subject to the following conditions: + * + * The above copyright notice and this permission notice shall be included in + * all copies or substantial portions of the Software. + * + * THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + * IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + * FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + * THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + * LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + * FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + * DEALINGS IN THE SOFTWARE. + * + * Except as contained in this notice, the names of the authors above shall + * not be used in advertising or otherwise to promote the sale, use or other + * dealings in this Software without prior written authorization from those + * authors. + * + * www.obsolescenceguaranteed.blogspot.com +*/ + +#include "gpio-common.h" + + +//// blink_core //////////////////////////////////////////////////////// +// The GPIO module's main loop core, called from thread entry point in +// gpio-common.c. + +void blink_core(struct bcm2835_peripheral* pgpio, int* terminate) +{ + int i, j, k; + const us_time_t intervl = 300; // light each row of leds 300 µs + ms_time_t now_ms; + + while (*terminate == 0) { + // prepare for lighting LEDs by setting col pins to output + for (i = 0; i < ncols; i++) { + INP_GPIO(cols[i]); + OUT_GPIO(cols[i]); // Define cols as output + } + + // light up LEDs + for (i = 0; i < nledrows; i++) { + // Toggle columns for this ledrow (which LEDs should be on (CLR = on)) + for (k = 0; k > 6) & 1) == 1 ) // STOP switch enabled, + return 8; // 8: STOP enabled, no bootscript + else + return (switchscan[0] >> 6) & 07; // 0-7: x.script to be used in PiDP-8/I +} + ADDED src/scp.c.in Index: src/scp.c.in ================================================================== --- /dev/null +++ src/scp.c.in @@ -0,0 +1,11970 @@ +/* scp.c: simulator control program + + Copyright (c) 1993-2016, Robert M Supnik + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + ROBERT M SUPNIK BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER + IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN + CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the name of Robert M Supnik shall not be + used in advertising or otherwise to promote the sale, use or other dealings + in this Software without prior written authorization from Robert M Supnik. + + ---------------------------------------------------------------------------- + + Portions copyright (c) 2015-2017, Oscar Vermeulen and Warren Young + + Permission is hereby granted, free of charge, to any person obtaining a + copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included in + all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR + IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + THE AUTHORS LISTED ABOVE BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER + LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING + FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER + DEALINGS IN THE SOFTWARE. + + Except as contained in this notice, the names of the authors above shall + not be used in advertising or otherwise to promote the sale, use or other + dealings in this Software without prior written authorization from those + authors. + + ---------------------------------------------------------------------------- + + 08-Mar-16 RMS Added shutdown flag for detach_all + 20-Mar-12 MP Fixes to "SHOW SHOW" commands + 06-Jan-12 JDB Fixed "SHOW DEVICE" with only one enabled unit (Dave Bryan) + 25-Sep-11 MP Added the ability for a simulator built with + SIM_ASYNCH_IO to change whether I/O is actually done + asynchronously by the new scp command SET ASYNCH and + SET NOASYNCH + 22-Sep-11 MP Added signal catching of SIGHUP and SIGTERM to cause + simulator STOP. This allows an externally signalled + event (i.e. system shutdown, or logoff) to signal a + running simulator of these events and to allow + reasonable actions to be taken. This will facilitate + running a simulator as a 'service' on *nix platforms, + given a sufficiently flexible simulator .ini file. + 20-Apr-11 MP Added expansion of %STATUS% and %TSTATUS% in do command + arguments. STATUS is the numeric value of the last + command error status and TSTATUS is the text message + relating to the last command error status + 17-Apr-11 MP Changed sim_rest to defer attaching devices until after + device register contents have been restored since some + attach activities may reference register contained info. + 29-Jan-11 MP Adjusted sim_debug to: + - include the simulator timestamp (sim_gtime) + as part of the prefix for each line of output + - write complete lines at a time (avoid asynch I/O issues). + 05-Jan-11 MP Added Asynch I/O support + 22-Jan-11 MP Added SET ON, SET NOON, ON, GOTO and RETURN command support + 13-Jan-11 MP Added "SHOW SHOW" and "SHOW SHOW" commands + 05-Jan-11 RMS Fixed bug in deposit stride for numeric input (John Dundas) + 23-Dec-10 RMS Clarified some help messages (Mark Pizzolato) + 08-Nov-10 RMS Fixed handling of DO with no arguments (Dave Bryan) + 22-May-10 RMS Added *nix READLINE support (Mark Pizzolato) + 08-Feb-09 RMS Fixed warnings in help printouts + 29-Dec-08 RMS Fixed implementation of MTAB_NC + 24-Nov-08 RMS Revised RESTORE unit logic for consistency + 05-Sep-08 JDB "detach_all" ignores error status returns if shutting down + 17-Aug-08 RMS Revert RUN/BOOT to standard, rather than powerup, reset + 25-Jul-08 JDB DO cmd missing params now default to null string + 29-Jun-08 JDB DO cmd sub_args now allows "\\" to specify literal backslash + 04-Jun-08 JDB label the patch delta more clearly + 31-Mar-08 RMS Fixed bug in local/global register search (Mark Pizzolato) + Fixed bug in restore of RO units (Mark Pizzolato) + 06-Feb-08 RMS Added SET/SHO/NO BR with default argument + 18-Jul-07 RMS Modified match_ext for VMS ext;version support + 28-Apr-07 RMS Modified sim_instr invocation to call sim_rtcn_init_all + Fixed bug in get_sim_opt + Fixed bug in restoration with changed memory size + 08-Mar-07 JDB Fixed breakpoint actions in DO command file processing + 30-Jan-07 RMS Fixed bugs in get_ipaddr + 17-Oct-06 RMS Added idle support + 04-Oct-06 JDB DO cmd failure now echoes cmd unless -q + 30-Aug-06 JDB detach_unit returns SCPE_UNATT if not attached + 14-Jul-06 RMS Added sim_activate_abs + 02-Jun-06 JDB Fixed do_cmd to exit nested files on assertion failure + Added -E switch to do_cmd to exit on any error + 14-Feb-06 RMS Upgraded save file format to V3.5 + 18-Jan-06 RMS Added fprint_stopped_gen + Added breakpoint spaces + Fixed unaligned register access (Doug Carman) + 22-Sep-05 RMS Fixed declarations (Sterling Garwood) + 30-Aug-05 RMS Revised to trim trailing spaces on file names + 25-Aug-05 RMS Added variable default device support + 23-Aug-05 RMS Added Linux line history support + 16-Aug-05 RMS Fixed C++ declaration and cast problems + 01-May-05 RMS Revised syntax for SET DEBUG (Dave Bryan) + 22-Mar-05 JDB Modified DO command to allow ten-level nesting + 18-Mar-05 RMS Moved DETACH tests into detach_unit (Dave Bryan) + Revised interface to fprint_sym, fparse_sym + 13-Mar-05 JDB ASSERT now requires a conditional operator + 07-Feb-05 RMS Added ASSERT command (Dave Bryan) + 02-Feb-05 RMS Fixed bug in global register search + 26-Dec-04 RMS Qualified SAVE examine, RESTORE deposit with SIM_SW_REST + 10-Nov-04 JDB Fixed logging of errors from cmds in "do" file + 05-Nov-04 RMS Moved SET/SHOW DEBUG under CONSOLE hierarchy + Renamed unit OFFLINE/ONLINE to DISABLED/ENABLED (Dave Bryan) + Revised to flush output files after simulation stop (Dave Bryan) + 15-Oct-04 RMS Fixed HELP to suppress duplicate descriptions + 27-Sep-04 RMS Fixed comma-separation options in set (David Bryan) + 09-Sep-04 RMS Added -p option for RESET + 13-Aug-04 RMS Qualified RESTORE detach with SIM_SW_REST + 17-Jul-04 JDB DO cmd file open failure retries with ".sim" appended + 17-Jul-04 RMS Added ECHO command (Dave Bryan) + 12-Jul-04 RMS Fixed problem ATTACHing to read only files + (John Dundas) + 28-May-04 RMS Added SET/SHOW CONSOLE + 14-Feb-04 RMS Updated SAVE/RESTORE (V3.2) + RMS Added debug print routines (Dave Hittner) + RMS Added sim_vm_parse_addr and sim_vm_fprint_addr + RMS Added REG_VMAD support + RMS Split out libraries + RMS Moved logging function to SCP + RMS Exposed step counter interface(s) + RMS Fixed double logging of SHOW BREAK (Mark Pizzolato) + RMS Fixed implementation of REG_VMIO + RMS Added SET/SHOW DEBUG, SET/SHOW DEBUG, + SHOW MODIFIERS, SHOW RADIX + RMS Changed sim_fsize to take uptr argument + 29-Dec-03 RMS Added Telnet console output stall support + 01-Nov-03 RMS Cleaned up implicit detach on attach/restore + Fixed bug in command line read while logging (Mark Pizzolato) + 01-Sep-03 RMS Fixed end-of-file problem in dep, idep + Fixed error on trailing spaces in dep, idep + 15-Jul-03 RMS Removed unnecessary test in reset_all + 15-Jun-03 RMS Added register flag REG_VMIO + 25-Apr-03 RMS Added extended address support (V3.0) + Fixed bug in SAVE (Peter Schorn) + Added u5, u6 fields + Added logical name support + 03-Mar-03 RMS Added sim_fsize + 27-Feb-03 RMS Fixed bug in multiword deposits to files + 08-Feb-03 RMS Changed sim_os_sleep to void, match_ext to char* + Added multiple actions, .ini file support + Added multiple switch evaluations per line + 07-Feb-03 RMS Added VMS support for ! (Mark Pizzolato) + 01-Feb-03 RMS Added breakpoint table extension, actions + 14-Jan-03 RMS Added missing function prototypes + 10-Jan-03 RMS Added attach/restore flag, dynamic memory size support, + case sensitive SET options + 22-Dec-02 RMS Added ! (OS command) feature (Mark Pizzolato) + 17-Dec-02 RMS Added get_ipaddr + 02-Dec-02 RMS Added EValuate command + 16-Nov-02 RMS Fixed bug in register name match algorithm + 13-Oct-02 RMS Fixed Borland compiler warnings (Hans Pufal) + 05-Oct-02 RMS Fixed bugs in set_logon, ssh_break (David Hittner) + Added support for fixed buffer devices + Added support for Telnet console, removed VT support + Added help + Added VMS file optimizations (Robert Alan Byer) + Added quiet mode, DO with parameters, GUI interface, + extensible commands (Brian Knittel) + Added device enable/disable commands + 14-Jul-02 RMS Fixed exit bug in do, added -v switch (Brian Knittel) + 17-May-02 RMS Fixed bug in fxread/fxwrite error usage (found by + Norm Lastovic) + 02-May-02 RMS Added VT emulation interface, changed {NO}LOG to SET {NO}LOG + 22-Apr-02 RMS Fixed laptop sleep problem in clock calibration, added + magtape record length error (Jonathan Engdahl) + 26-Feb-02 RMS Fixed initialization bugs in do_cmd, get_aval + (Brian Knittel) + 10-Feb-02 RMS Fixed problem in clock calibration + 06-Jan-02 RMS Moved device enable/disable to simulators + 30-Dec-01 RMS Generalized timer packaged, added circular arrays + 19-Dec-01 RMS Fixed DO command bug (John Dundas) + 07-Dec-01 RMS Implemented breakpoint package + 05-Dec-01 RMS Fixed bug in universal register logic + 03-Dec-01 RMS Added read-only units, extended SET/SHOW, universal registers + 24-Nov-01 RMS Added unit-based registers + 16-Nov-01 RMS Added DO command + 28-Oct-01 RMS Added relative range addressing + 08-Oct-01 RMS Added SHOW VERSION + 30-Sep-01 RMS Relaxed attach test in BOOT + 27-Sep-01 RMS Added queue count routine, fixed typo in ex/mod + 17-Sep-01 RMS Removed multiple console support + 07-Sep-01 RMS Removed conditional externs on function prototypes + Added special modifier print + 31-Aug-01 RMS Changed int64 to t_int64 for Windoze (V2.7) + 18-Jul-01 RMS Minor changes for Macintosh port + 12-Jun-01 RMS Fixed bug in big-endian I/O (Dave Conroy) + 27-May-01 RMS Added multiple console support + 16-May-01 RMS Added logging + 15-May-01 RMS Added features from Tim Litt + 12-May-01 RMS Fixed missing return in disable_cmd + 25-Mar-01 RMS Added ENABLE/DISABLE + 14-Mar-01 RMS Revised LOAD/DUMP interface (again) + 05-Mar-01 RMS Added clock calibration support + 05-Feb-01 RMS Fixed bug, DETACH buffered unit with hwmark = 0 + 04-Feb-01 RMS Fixed bug, RESTORE not using device's attach routine + 21-Jan-01 RMS Added relative time + 22-Dec-00 RMS Fixed find_device for devices ending in numbers + 08-Dec-00 RMS V2.5a changes + 30-Oct-00 RMS Added output file option to examine + 11-Jul-99 RMS V2.5 changes + 13-Apr-99 RMS Fixed handling of 32b addresses + 04-Oct-98 RMS V2.4 changes + 20-Aug-98 RMS Added radix commands + 05-Jun-98 RMS Fixed bug in ^D handling for UNIX + 10-Apr-98 RMS Added switches to all commands + 26-Oct-97 RMS Added search capability + 25-Jan-97 RMS Revised data types + 23-Jan-97 RMS Added bi-endian I/O + 06-Sep-96 RMS Fixed bug in variable length IEXAMINE + 16-Jun-96 RMS Changed interface to parse/print_sym + 06-Apr-96 RMS Added error checking in reset all + 07-Jan-96 RMS Added register buffers in save/restore + 11-Dec-95 RMS Fixed ordering bug in save/restore + 22-May-95 RMS Added symbolic input + 13-Apr-95 RMS Added symbolic printouts +*/ + +/* Macros and data structures */ + +#ifdef PIDP8I +#include +#include +#include +#include // for sleep() + +extern void *blink(void *ptr); // the real-time multiplexing process to start up +#endif + +#define NOT_MUX_USING_CODE /* sim_tmxr library provider or agnostic */ + +#include "sim_defs.h" +#include "sim_rev.h" +#include "sim_disk.h" +#include "sim_tape.h" +#include "sim_ether.h" +#include "sim_serial.h" +#if defined (USE_SIM_VIDEO) +#include "sim_video.h" +#endif +#include "sim_sock.h" +#include "sim_frontpanel.h" +#include +#include +#include +#include +#if defined(_WIN32) +#include +#include +#include +#else +#include +#endif +#include +#include + +#if defined(HAVE_DLOPEN) /* Dynamic Readline support */ +#include +#endif + +#ifndef MAX +#define MAX(a,b) (((a) >= (b)) ? (a) : (b)) +#endif + +/* search logical and boolean ops */ + +#define SCH_OR 0 /* search logicals */ +#define SCH_AND 1 +#define SCH_XOR 2 +#define SCH_E 0 /* search booleans */ +#define SCH_N 1 +#define SCH_G 2 +#define SCH_L 3 +#define SCH_EE 4 +#define SCH_NE 5 +#define SCH_GE 6 +#define SCH_LE 7 + +#define MAX_DO_NEST_LVL 20 /* DO cmd nesting level */ +#define SRBSIZ 1024 /* save/restore buffer */ +#define SIM_BRK_INILNT 4096 /* bpt tbl length */ +#define SIM_BRK_ALLTYP 0xFFFFFFFB +#define UPDATE_SIM_TIME \ + if (1) { \ + int32 _x; \ + AIO_LOCK; \ + if (sim_clock_queue == QUEUE_LIST_END) \ + _x = noqueue_time; \ + else \ + _x = sim_clock_queue->time; \ + sim_time = sim_time + (_x - sim_interval); \ + sim_rtime = sim_rtime + ((uint32) (_x - sim_interval)); \ + if (sim_clock_queue == QUEUE_LIST_END) \ + noqueue_time = sim_interval; \ + else \ + sim_clock_queue->time = sim_interval; \ + AIO_UNLOCK; \ + } \ + else \ + (void)0 \ + +#define SZ_D(dp) (size_map[((dp)->dwidth + CHAR_BIT - 1) / CHAR_BIT]) +#define SZ_R(rp) \ + (size_map[((rp)->width + (rp)->offset + CHAR_BIT - 1) / CHAR_BIT]) +#if defined (USE_INT64) +#define SZ_LOAD(sz,v,mb,j) \ + if (sz == sizeof (uint8)) v = *(((uint8 *) mb) + ((uint32) j)); \ + else if (sz == sizeof (uint16)) v = *(((uint16 *) mb) + ((uint32) j)); \ + else if (sz == sizeof (uint32)) v = *(((uint32 *) mb) + ((uint32) j)); \ + else v = *(((t_uint64 *) mb) + ((uint32) j)); +#define SZ_STORE(sz,v,mb,j) \ + if (sz == sizeof (uint8)) *(((uint8 *) mb) + j) = (uint8) v; \ + else if (sz == sizeof (uint16)) *(((uint16 *) mb) + ((uint32) j)) = (uint16) v; \ + else if (sz == sizeof (uint32)) *(((uint32 *) mb) + ((uint32) j)) = (uint32) v; \ + else *(((t_uint64 *) mb) + ((uint32) j)) = v; +#else +#define SZ_LOAD(sz,v,mb,j) \ + if (sz == sizeof (uint8)) v = *(((uint8 *) mb) + ((uint32) j)); \ + else if (sz == sizeof (uint16)) v = *(((uint16 *) mb) + ((uint32) j)); \ + else v = *(((uint32 *) mb) + ((uint32) j)); +#define SZ_STORE(sz,v,mb,j) \ + if (sz == sizeof (uint8)) *(((uint8 *) mb) + ((uint32) j)) = (uint8) v; \ + else if (sz == sizeof (uint16)) *(((uint16 *) mb) + ((uint32) j)) = (uint16) v; \ + else *(((uint32 *) mb) + ((uint32) j)) = v; +#endif +#define GET_SWITCHES(cp) \ + if ((cp = get_sim_sw (cp)) == NULL) return SCPE_INVSW +#define GET_RADIX(val,dft) \ + if (sim_switches & SWMASK ('O')) val = 8; \ + else if (sim_switches & SWMASK ('D')) val = 10; \ + else if (sim_switches & SWMASK ('H')) val = 16; \ + else val = dft; + +#ifdef PIDP8I +extern int awfulHackFlag; +#endif + +/* Asynch I/O support */ +#if defined (SIM_ASYNCH_IO) +pthread_mutex_t sim_asynch_lock = PTHREAD_MUTEX_INITIALIZER; +pthread_cond_t sim_asynch_wake = PTHREAD_COND_INITIALIZER; + +pthread_mutex_t sim_timer_lock = PTHREAD_MUTEX_INITIALIZER; +pthread_cond_t sim_timer_wake = PTHREAD_COND_INITIALIZER; +pthread_mutex_t sim_tmxr_poll_lock = PTHREAD_MUTEX_INITIALIZER; +pthread_cond_t sim_tmxr_poll_cond = PTHREAD_COND_INITIALIZER; +int32 sim_tmxr_poll_count; +pthread_t sim_asynch_main_threadid; +UNIT * volatile sim_asynch_queue; +t_bool sim_asynch_enabled = TRUE; +int32 sim_asynch_check; +int32 sim_asynch_latency = 4000; /* 4 usec interrupt latency */ +int32 sim_asynch_inst_latency = 20; /* assume 5 mip simulator */ + +int sim_aio_update_queue (void) +{ +int migrated = 0; + +AIO_ILOCK; +if (AIO_QUEUE_VAL != QUEUE_LIST_END) { /* List !Empty */ + UNIT *q, *uptr; + int32 a_event_time; + do + q = AIO_QUEUE_VAL; + while (q != AIO_QUEUE_SET(QUEUE_LIST_END, q)); /* Grab current queue */ + while (q != QUEUE_LIST_END) { /* List !Empty */ + sim_debug (SIM_DBG_AIO_QUEUE, sim_dflt_dev, "Migrating Asynch event for %s after %d instructions\n", sim_uname(q), q->a_event_time); + ++migrated; + uptr = q; + q = q->a_next; + uptr->a_next = NULL; /* hygiene */ + if (uptr->a_activate_call != &sim_activate_notbefore) { + a_event_time = uptr->a_event_time-((sim_asynch_inst_latency+1)/2); + if (a_event_time < 0) + a_event_time = 0; + } + else + a_event_time = uptr->a_event_time; + AIO_IUNLOCK; + uptr->a_activate_call (uptr, a_event_time); + if (uptr->a_check_completion) { + sim_debug (SIM_DBG_AIO_QUEUE, sim_dflt_dev, "Calling Completion Check for asynch event on %s\n", sim_uname(uptr)); + uptr->a_check_completion (uptr); + } + AIO_ILOCK; + } + } +AIO_IUNLOCK; +return migrated; +} + +void sim_aio_activate (ACTIVATE_API caller, UNIT *uptr, int32 event_time) +{ +AIO_ILOCK; +sim_debug (SIM_DBG_AIO_QUEUE, sim_dflt_dev, "Queueing Asynch event for %s after %d instructions\n", sim_uname(uptr), event_time); +if (uptr->a_next) { + uptr->a_activate_call = sim_activate_abs; + } +else { + UNIT *q; + uptr->a_event_time = event_time; + uptr->a_activate_call = caller; + do { + q = AIO_QUEUE_VAL; + uptr->a_next = q; /* Mark as on list */ + } while (q != AIO_QUEUE_SET(uptr, q)); + } +AIO_IUNLOCK; +sim_asynch_check = 0; /* try to force check */ +if (sim_idle_wait) { + sim_debug (TIMER_DBG_IDLE, &sim_timer_dev, "waking due to event on %s after %d instructions\n", sim_uname(uptr), event_time); + pthread_cond_signal (&sim_asynch_wake); + } +} +#else +t_bool sim_asynch_enabled = FALSE; +#endif + +/* The per-simulator init routine is a weak global that defaults to NULL + The other per-simulator pointers can be overrriden by the init routine */ + +WEAK void (*sim_vm_init) (void); +char* (*sim_vm_read) (char *ptr, int32 size, FILE *stream) = NULL; +void (*sim_vm_post) (t_bool from_scp) = NULL; +CTAB *sim_vm_cmd = NULL; +void (*sim_vm_sprint_addr) (char *buf, DEVICE *dptr, t_addr addr) = NULL; +void (*sim_vm_fprint_addr) (FILE *st, DEVICE *dptr, t_addr addr) = NULL; +t_addr (*sim_vm_parse_addr) (DEVICE *dptr, CONST char *cptr, CONST char **tptr) = NULL; +t_value (*sim_vm_pc_value) (void) = NULL; +t_bool (*sim_vm_is_subroutine_call) (t_addr **ret_addrs) = NULL; +t_bool (*sim_vm_fprint_stopped) (FILE *st, t_stat reason) = NULL; + +/* Prototypes */ + +/* Set and show command processors */ + +t_stat set_dev_radix (DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat set_dev_enbdis (DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat set_dev_debug (DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat set_unit_enbdis (DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat ssh_break (FILE *st, const char *cptr, int32 flg); +t_stat show_cmd_fi (FILE *ofile, int32 flag, CONST char *cptr); +t_stat show_config (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat show_queue (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat show_time (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat show_mod_names (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat show_show_commands (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat show_log_names (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat show_dev_radix (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat show_dev_debug (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat show_dev_logicals (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat show_dev_modifiers (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat show_dev_show_commands (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat show_version (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat show_default (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat show_break (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat show_on (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat sim_show_send (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat sim_show_expect (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat show_device (FILE *st, DEVICE *dptr, int32 flag); +t_stat show_unit (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag); +t_stat show_all_mods (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flg, int32 *toks); +t_stat show_one_mod (FILE *st, DEVICE *dptr, UNIT *uptr, MTAB *mptr, CONST char *cptr, int32 flag); +t_stat sim_save (FILE *sfile); +t_stat sim_rest (FILE *rfile); + +/* Breakpoint package */ + +t_stat sim_brk_init (void); +t_stat sim_brk_set (t_addr loc, int32 sw, int32 ncnt, CONST char *act); +t_stat sim_brk_clr (t_addr loc, int32 sw); +t_stat sim_brk_clrall (int32 sw); +t_stat sim_brk_show (FILE *st, t_addr loc, int32 sw); +t_stat sim_brk_showall (FILE *st, int32 sw); +CONST char *sim_brk_getact (char *buf, int32 size); +BRKTAB *sim_brk_new (t_addr loc, uint32 btyp); +char *sim_brk_clract (void); + +FILE *stdnul; + +/* Command support routines */ + +SCHTAB *get_rsearch (CONST char *cptr, int32 radix, SCHTAB *schptr); +SCHTAB *get_asearch (CONST char *cptr, int32 radix, SCHTAB *schptr); +int32 test_search (t_value *val, SCHTAB *schptr); +static const char *get_glyph_gen (const char *iptr, char *optr, char mchar, t_bool uc, t_bool quote, char escape_char); +int32 get_switches (const char *cptr); +CONST char *get_sim_sw (CONST char *cptr); +t_stat get_aval (t_addr addr, DEVICE *dptr, UNIT *uptr); +t_value get_rval (REG *rptr, uint32 idx); +void put_rval (REG *rptr, uint32 idx, t_value val); +void fprint_help (FILE *st); +void fprint_stopped (FILE *st, t_stat r); +void fprint_capac (FILE *st, DEVICE *dptr, UNIT *uptr); +void fprint_sep (FILE *st, int32 *tokens); +char *read_line (char *ptr, int32 size, FILE *stream); +char *read_line_p (const char *prompt, char *ptr, int32 size, FILE *stream); +REG *find_reg_glob (CONST char *ptr, CONST char **optr, DEVICE **gdptr); +char *sim_trim_endspc (char *cptr); + +/* Forward references */ + +t_stat scp_attach_unit (DEVICE *dptr, UNIT *uptr, const char *cptr); +t_stat scp_detach_unit (DEVICE *dptr, UNIT *uptr); +t_bool qdisable (DEVICE *dptr); +t_stat attach_err (UNIT *uptr, t_stat stat); +t_stat detach_all (int32 start_device, t_bool shutdown); +t_stat assign_device (DEVICE *dptr, const char *cptr); +t_stat deassign_device (DEVICE *dptr); +t_stat ssh_break_one (FILE *st, int32 flg, t_addr lo, int32 cnt, CONST char *aptr); +t_stat exdep_reg_loop (FILE *ofile, SCHTAB *schptr, int32 flag, CONST char *cptr, + REG *lowr, REG *highr, uint32 lows, uint32 highs); +t_stat ex_reg (FILE *ofile, t_value val, int32 flag, REG *rptr, uint32 idx); +t_stat dep_reg (int32 flag, CONST char *cptr, REG *rptr, uint32 idx); +t_stat exdep_addr_loop (FILE *ofile, SCHTAB *schptr, int32 flag, const char *cptr, + t_addr low, t_addr high, DEVICE *dptr, UNIT *uptr); +t_stat ex_addr (FILE *ofile, int32 flag, t_addr addr, DEVICE *dptr, UNIT *uptr); +t_stat dep_addr (int32 flag, const char *cptr, t_addr addr, DEVICE *dptr, + UNIT *uptr, int32 dfltinc); +void fprint_fields (FILE *stream, t_value before, t_value after, BITFIELD* bitdefs); +t_stat step_svc (UNIT *ptr); +t_stat expect_svc (UNIT *ptr); +t_stat shift_args (char *do_arg[], size_t arg_count); +t_stat set_on (int32 flag, CONST char *cptr); +t_stat set_verify (int32 flag, CONST char *cptr); +t_stat set_message (int32 flag, CONST char *cptr); +t_stat set_quiet (int32 flag, CONST char *cptr); +t_stat set_asynch (int32 flag, CONST char *cptr); +t_stat sim_show_asynch (FILE *st, DEVICE *dptr, UNIT *uptr, int32 flag, CONST char *cptr); +t_stat do_cmd_label (int32 flag, CONST char *cptr, CONST char *label); +void int_handler (int signal); +t_stat set_prompt (int32 flag, CONST char *cptr); +t_stat sim_set_asynch (int32 flag, CONST char *cptr); +t_stat sim_set_environment (int32 flag, CONST char *cptr); +static const char *get_dbg_verb (uint32 dbits, DEVICE* dptr); + +/* Global data */ + +DEVICE *sim_dflt_dev = NULL; +UNIT *sim_clock_queue = QUEUE_LIST_END; +int32 sim_interval = 0; +int32 sim_switches = 0; +FILE *sim_ofile = NULL; +TMLN *sim_oline = NULL; +MEMFILE *sim_mfile = NULL; +SCHTAB *sim_schrptr = FALSE; +SCHTAB *sim_schaptr = FALSE; +DEVICE *sim_dfdev = NULL; +UNIT *sim_dfunit = NULL; +DEVICE **sim_internal_devices = NULL; +uint32 sim_internal_device_count = 0; +int32 sim_opt_out = 0; +int32 sim_is_running = 0; +t_bool sim_processing_event = FALSE; +uint32 sim_brk_summ = 0; +uint32 sim_brk_types = 0; +BRKTYPTAB *sim_brk_type_desc = NULL; /* type descriptions */ +uint32 sim_brk_dflt = 0; +uint32 sim_brk_match_type; +t_addr sim_brk_match_addr; +char *sim_brk_act[MAX_DO_NEST_LVL]; +char *sim_brk_act_buf[MAX_DO_NEST_LVL]; +BRKTAB **sim_brk_tab = NULL; +int32 sim_brk_ent = 0; +int32 sim_brk_lnt = 0; +int32 sim_brk_ins = 0; +int32 sim_quiet = 0; +int32 sim_step = 0; +static double sim_time; +static uint32 sim_rtime; +static int32 noqueue_time; +volatile int32 stop_cpu = 0; +static char **sim_argv; +t_value *sim_eval = NULL; +static t_value sim_last_val; +static t_addr sim_last_addr; +FILE *sim_log = NULL; /* log file */ +FILEREF *sim_log_ref = NULL; /* log file file reference */ +FILE *sim_deb = NULL; /* debug file */ +FILEREF *sim_deb_ref = NULL; /* debug file file reference */ +int32 sim_deb_switches = 0; /* debug switches */ +struct timespec sim_deb_basetime; /* debug timestamp relative base time */ +char *sim_prompt = NULL; /* prompt string */ +static FILE *sim_gotofile; /* the currently open do file */ +static int32 sim_goto_line[MAX_DO_NEST_LVL+1]; /* the current line number in the currently open do file */ +static int32 sim_do_echo = 0; /* the echo status of the currently open do file */ +static int32 sim_show_message = 1; /* the message display status of the currently open do file */ +static int32 sim_on_inherit = 0; /* the inherit status of on state and conditions when executing do files */ +static int32 sim_do_depth = 0; + +static int32 sim_on_check[MAX_DO_NEST_LVL+1]; +static char *sim_on_actions[MAX_DO_NEST_LVL+1][SCPE_MAX_ERR+1]; +static char sim_do_filename[MAX_DO_NEST_LVL+1][CBUFSIZE]; +static const char *sim_do_ocptr[MAX_DO_NEST_LVL+1]; +static const char *sim_do_label[MAX_DO_NEST_LVL+1]; + +t_stat sim_last_cmd_stat; /* Command Status */ + +static SCHTAB sim_stabr; /* Register search specifier */ +static SCHTAB sim_staba; /* Memory search specifier */ + +static UNIT sim_step_unit = { UDATA (&step_svc, 0, 0) }; +static UNIT sim_expect_unit = { UDATA (&expect_svc, 0, 0) }; +#if defined USE_INT64 +static const char *sim_si64 = "64b data"; +#else +static const char *sim_si64 = "32b data"; +#endif +#if defined USE_ADDR64 +static const char *sim_sa64 = "64b addresses"; +#else +static const char *sim_sa64 = "32b addresses"; +#endif +const char *sim_savename = sim_name; /* Simulator Name used in SAVE/RESTORE images */ + +/* Tables and strings */ + +const char save_vercur[] = "V4.0"; +const char save_ver40[] = "V4.0"; +const char save_ver35[] = "V3.5"; +const char save_ver32[] = "V3.2"; +const char save_ver30[] = "V3.0"; +const struct scp_error { + const char *code; + const char *message; + } scp_errors[1+SCPE_MAX_ERR-SCPE_BASE] = + {{"NXM", "Address space exceeded"}, + {"UNATT", "Unit not attached"}, + {"IOERR", "I/O error"}, + {"CSUM", "Checksum error"}, + {"FMT", "Format error"}, + {"NOATT", "Unit not attachable"}, + {"OPENERR", "File open error"}, + {"MEM", "Memory exhausted"}, + {"ARG", "Invalid argument"}, + {"STEP", "Step expired"}, + {"UNK", "Unknown command"}, + {"RO", "Read only argument"}, + {"INCOMP", "Command not completed"}, + {"STOP", "Simulation stopped"}, + {"EXIT", "Goodbye"}, + {"TTIERR", "Console input I/O error"}, + {"TTOERR", "Console output I/O error"}, + {"EOF", "End of file"}, + {"REL", "Relocation error"}, + {"NOPARAM", "No settable parameters"}, + {"ALATT", "Unit already attached"}, + {"TIMER", "Hardware timer error"}, + {"SIGERR", "Signal handler setup error"}, + {"TTYERR", "Console terminal setup error"}, + {"SUB", "Subscript out of range"}, + {"NOFNC", "Command not allowed"}, + {"UDIS", "Unit disabled"}, + {"NORO", "Read only operation not allowed"}, + {"INVSW", "Invalid switch"}, + {"MISVAL", "Missing value"}, + {"2FARG", "Too few arguments"}, + {"2MARG", "Too many arguments"}, + {"NXDEV", "Non-existent device"}, + {"NXUN", "Non-existent unit"}, + {"NXREG", "Non-existent register"}, + {"NXPAR", "Non-existent parameter"}, + {"NEST", "Nested DO command limit exceeded"}, + {"IERR", "Internal error"}, + {"MTRLNT", "Invalid magtape record length"}, + {"LOST", "Console Telnet connection lost"}, + {"TTMO", "Console Telnet connection timed out"}, + {"STALL", "Console Telnet output stall"}, + {"AFAIL", "Assertion failed"}, + {"INVREM", "Invalid remote console command"}, + {"NOTATT", "Not attached"}, + {"EXPECT", "Expect matched"}, + {"REMOTE", "remote console command"}, + }; + +const size_t size_map[] = { sizeof (int8), + sizeof (int8), sizeof (int16), sizeof (int32), sizeof (int32) +#if defined (USE_INT64) + , sizeof (t_int64), sizeof (t_int64), sizeof (t_int64), sizeof (t_int64) +#endif +}; + +const t_value width_mask[] = { 0, + 0x1, 0x3, 0x7, 0xF, + 0x1F, 0x3F, 0x7F, 0xFF, + 0x1FF, 0x3FF, 0x7FF, 0xFFF, + 0x1FFF, 0x3FFF, 0x7FFF, 0xFFFF, + 0x1FFFF, 0x3FFFF, 0x7FFFF, 0xFFFFF, + 0x1FFFFF, 0x3FFFFF, 0x7FFFFF, 0xFFFFFF, + 0x1FFFFFF, 0x3FFFFFF, 0x7FFFFFF, 0xFFFFFFF, + 0x1FFFFFFF, 0x3FFFFFFF, 0x7FFFFFFF, 0xFFFFFFFF +#if defined (USE_INT64) + , 0x1FFFFFFFF, 0x3FFFFFFFF, 0x7FFFFFFFF, 0xFFFFFFFFF, + 0x1FFFFFFFFF, 0x3FFFFFFFFF, 0x7FFFFFFFFF, 0xFFFFFFFFFF, + 0x1FFFFFFFFFF, 0x3FFFFFFFFFF, 0x7FFFFFFFFFF, 0xFFFFFFFFFFF, + 0x1FFFFFFFFFFF, 0x3FFFFFFFFFFF, 0x7FFFFFFFFFFF, 0xFFFFFFFFFFFF, + 0x1FFFFFFFFFFFF, 0x3FFFFFFFFFFFF, 0x7FFFFFFFFFFFF, 0xFFFFFFFFFFFFF, + 0x1FFFFFFFFFFFFF, 0x3FFFFFFFFFFFFF, 0x7FFFFFFFFFFFFF, 0xFFFFFFFFFFFFFF, + 0x1FFFFFFFFFFFFFF, 0x3FFFFFFFFFFFFFF, + 0x7FFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFF, + 0x1FFFFFFFFFFFFFFF, 0x3FFFFFFFFFFFFFFF, + 0x7FFFFFFFFFFFFFFF, 0xFFFFFFFFFFFFFFFF +#endif + }; + +static const char simh_help[] = + /***************** 80 character line width template *************************/ + "1Commands\n" +#define HLP_RESET "*Commands Resetting Devices" + /***************** 80 character line width template *************************/ + "2Resetting Devices\n" + " The RESET command (abbreviation RE) resets a device or the entire simulator\n" + " to a predefined condition. If switch -p is specified, the device is reset\n" + " to its power-up state:\n\n" + "++RESET reset all devices\n" + "++RESET -p powerup all devices\n" + "++RESET ALL reset all devices\n" + "++RESET reset specified device\n\n" + " Typically, RESET stops any in-progress I/O operation, clears any interrupt\n" + " request, and returns the device to a quiescent state. It does not clear\n" + " main memory or affect I/O connections.\n" +#define HLP_EXAMINE "*Commands Examining_and_Changing_State" +#define HLP_IEXAMINE "*Commands Examining_and_Changing_State" +#define HLP_DEPOSIT "*Commands Examining_and_Changing_State" +#define HLP_IDEPOSIT "*Commands Examining_and_Changing_State" + /***************** 80 character line width template *************************/ + "2Examining and Changing State\n" + " There are four commands to examine and change state:\n\n" + "++EXAMINE (abbreviated E) examines state\n" + "++DEPOSIT (abbreviated D) changes state\n" + "++IEXAMINE (interactive examine, abbreviated IE) examines state and allows\n" + "++++the user to interactively change it\n" + "++IDEPOSIT (interactive deposit, abbreviated ID) allows the user to\n" + "++++interactively change state\n\n" + " All four commands take the form\n\n" + "++command {modifiers} \n\n" + " Deposit must also include a deposit value at the end of the command.\n\n" + " There are four kinds of modifiers: switches, device/unit name, search\n" + " specifier, and for EXAMINE, output file. Switches have been described\n" + " previously. A device/unit name identifies the device and unit whose\n" + " address space is to be examined or modified. If no device is specified,\n" + " the CPU (main memory)is selected; if a device but no unit is specified,\n" + " unit 0 of the device is selected.\n\n" + " The search specifier provides criteria for testing addresses or registers\n" + " to see if they should be processed. A specifier consists of a logical\n" + " operator, a relational operator, or both, optionally separated by spaces.\n\n" + "++{ } \n\n" + /***************** 80 character line width template *************************/ + " where the logical operator is & (and), | (or), or ^ (exclusive or), and the\n" + " relational operator is = or == (equal), ! or != (not equal), >= (greater\n" + " than or equal), > (greater than), <= (less than or equal), or < (less than).\n" + " If a logical operator is specified without a relational operator, it is\n" + " ignored. If a relational operator is specified without a logical operator,\n" + " no logical operation is performed. All comparisons are unsigned.\n\n" + " The output file modifier redirects command output to a file instead of the\n" + " console. An output file modifier consists of @ followed by a valid file\n" + " name.\n\n" + " Modifiers may be specified in any order. If multiple modifiers of the\n" + " same type are specified, later modifiers override earlier modifiers. Note\n" + " that if the device/unit name comes after the search specifier, the search\n" + " values will interpreted in the radix of the CPU, rather than of the\n" + " device/unit.\n\n" + " The \"object list\" consists of one or more of the following, separated by\n" + " commas:\n\n" + /***************** 80 character line width template *************************/ + "++register the specified register\n" + "++register[sub1-sub2] the specified register array locations,\n" + "++ starting at location sub1 up to and\n" + "++ including location sub2\n" + "++register[sub1/length] the specified register array locations,\n" + "++ starting at location sub1 up to but\n" + "++ not including sub1+length\n" + "++register[ALL] all locations in the specified register\n" + "++ array\n" + "++register1-register2 all the registers starting at register1\n" + "++ up to and including register2\n" + "++address the specified location\n" + "++address1-address2 all locations starting at address1 up to\n" + "++ and including address2\n" + "++address/length all location starting at address up to\n" + "++ but not including address+length\n" + "++STATE all registers in the device\n" + "++ALL all locations in the unit\n" + "++$ the last value displayed by an EXAMINE command\n" + " interpreted as an address\n" + "3Switches\n" + " Switches can be used to control the format of display information:\n\n" + /***************** 80 character line width template *************************/ + "++-a display as ASCII\n" + "++-c display as character string\n" + "++-m display as instruction mnemonics\n" + "++-o display as octal\n" + "++-d display as decimal\n" + "++-h display as hexadecimal\n\n" + " The simulators typically accept symbolic input (see documentation with each\n" + " simulator).\n\n" + "3Examples\n" + " Examples:\n\n" + "++ex 1000-1100 examine 1000 to 1100\n" + "++de PC 1040 set PC to 1040\n" + "++ie 40-50 interactively examine 40:50\n" + "++ie >1000 40-50 interactively examine the subset\n" + "++ of locations 40:50 that are >1000\n" + "++ex rx0 50060 examine 50060, RX unit 0\n" + "++ex rx sbuf[3-6] examine SBUF[3] to SBUF[6] in RX\n" + "++de all 0 set main memory to 0\n" + "++de &77>0 0 set all addresses whose low order\n" + "++ bits are non-zero to 0\n" + "++ex -m @memdump.txt 0-7777 dump memory to file\n\n" + " Note: to terminate an interactive command, simply type a bad value\n" + " (eg, XYZ) when input is requested.\n" +#define HLP_EVALUATE "*Commands Evaluating_Instructions" + /***************** 80 character line width template *************************/ + "2Evaluating Instructions\n" + " The EVAL command evaluates a symbolic expression and returns the equivalent\n" + " numeric value. This is useful for obtaining numeric arguments for a search\n" + " command:\n\n" + "++EVAL \n" + /***************** 80 character line width template *************************/ + "2Loading and Saving Programs\n" +#define HLP_LOAD "*Commands Loading_and_Saving_Programs LOAD" + "3LOAD\n" + " The LOAD command (abbreviation LO) loads a file in binary loader format:\n\n" + "++LOAD {implementation options}\n\n" + " The types of formats supported are implementation specific. Options (such\n" + " as load within range) are also implementation specific.\n\n" +#define HLP_DUMP "*Commands Loading_and_Saving_Programs DUMP" + "3DUMP\n" + " The DUMP command (abbreviation DU) dumps memory in binary loader format:\n\n" + "++DUMP {implementation options}\n\n" + " The types of formats supported are implementation specific. Options (such\n" + " as dump within range) are also implementation specific.\n" + /***************** 80 character line width template *************************/ + "2Saving and Restoring State\n" +#define HLP_SAVE "*Commands Saving_and_Restoring_State SAVE" + "3SAVE\n" + " The SAVE command (abbreviation SA) save the complete state of the simulator\n" + " to a file. This includes the contents of main memory and all registers,\n" + " and the I/O connections of devices:\n\n" + "++SAVE \n\n" +#define HLP_RESTORE "*Commands Saving_and_Restoring_State RESTORE" + "3RESTORE\n" + " The RESTORE command (abbreviation REST, alternately GET) restores a\n" + " previously saved simulator state:\n\n" + "++RESTORE \n" + "4Switches\n" + " Switches can influence the output and behavior of the RESTORE command\n\n" + "++-Q Suppresses version warning messages\n" + "++-D Suppress detaching and attaching devices during a restore\n" + "++-F Overrides the related file timestamp validation check\n" + "\n" + "4Notes:\n" + " 1) SAVE file format compresses zeroes to minimize file size.\n" + " 2) The simulator can't restore active incoming telnet sessions to\n" + " multiplexer devices, but the listening ports will be restored across a\n" + " save/restore.\n" + /***************** 80 character line width template *************************/ + "2Running A Simulated Program\n" +#define HLP_RUN "*Commands Running_A_Simulated_Program RUN" + "3RUN\n" + " The RUN command (abbreviated RU) resets all devices, deposits its argument\n" + " (if given) in the PC, and starts execution. If no argument is given,\n" + " execution starts at the current PC.\n" +#define HLP_GO "*Commands Running_A_Simulated_Program GO" + "3GO\n" + " The GO command does not reset devices, deposits its argument (if given)\n" + " in the PC, and starts execution. If no argument is given, execution\n" + " starts at the current PC.\n" +#define HLP_CONTINUE "*Commands Running_A_Simulated_Program CONTINUE" + "3CONTINUE\n" + " The CONT command (abbreviated CO) does not reset devices and resumes\n" + " execution at the current PC.\n" +#define HLP_STEP "*Commands Running_A_Simulated_Program STEP" + "3STEP\n" + " The STEP command (abbreviated S) resumes execution at the current PC for\n" + " the number of instructions given by its argument. If no argument is\n" + " supplied, one instruction is executed.\n" + "4Switches\n" + " If the STEP command is invoked with the -T switch, the step command will\n" + " cause execution to run for microseconds rather than instructions.\n" +#define HLP_NEXT "*Commands Running_A_Simulated_Program NEXT" + "3NEXT\n" + " The NEXT command (abbreviated N) resumes execution at the current PC for\n" + " one instruction, attempting to execute through a subroutine calls.\n" + " If the next instruction to be executed is not a subroutine call,\n" + " one instruction is executed.\n" +#define HLP_BOOT "*Commands Running_A_Simulated_Program BOOT" + "3BOOT\n" + " The BOOT command (abbreviated BO) resets all devices and bootstraps the\n" + " device and unit given by its argument. If no unit is supplied, unit 0 is\n" + " bootstrapped. The specified unit must be attached.\n" + /***************** 80 character line width template *************************/ + "2Stopping The Simulator\n" + " Programs run until the simulator detects an error or stop condition, or\n" + " until the user forces a stop condition.\n" + "3Simulator Detected Stop Conditions\n" + " These simulator-detected conditions stop simulation:\n\n" + "++- HALT instruction. If a HALT instruction is decoded, simulation stops.\n" + "++- Breakpoint. The simulator may support breakpoints (see below).\n" + "++- I/O error. If an I/O error occurs during simulation of an I/O\n" + "+++operation, and the device stop-on-I/O-error flag is set, simulation\n" + "+++usually stops.\n\n" + "++- Processor condition. Certain processor conditions can stop\n" + "+++simulation; these are described with the individual simulators.\n" + "3User Specified Stop Conditions\n" + " Typing the interrupt character stops simulation. The interrupt character\n" + " is defined by the WRU (where are you) console option and is initially set\n" + " to 005 (^E).\n\n" + /***************** 80 character line width template *************************/ +#define HLP_BREAK "*Commands Stopping_The_Simulator User_Specified_Stop_Conditions BREAK" +#define HLP_NOBREAK "*Commands Stopping_The_Simulator User_Specified_Stop_Conditions BREAK" + "4Breakpoints\n" + " A simulator may offer breakpoint capability. A simulator may define\n" + " breakpoints of different types, identified by letter (for example, E for\n" + " execution, R for read, W for write, etc). At the moment, most simulators\n" + " support only E (execution) breakpoints.\n\n" + " Associated with a breakpoint are a count and, optionally, one or more\n" + " actions. Each time the breakpoint is taken, the associated count is\n" + " decremented. If the count is less than or equal to 0, the breakpoint\n" + " occurs; otherwise, it is deferred. When the breakpoint occurs, the\n" + " optional actions are automatically executed.\n\n" + " A breakpoint is set by the BREAK or the SET BREAK commands:\n\n" + "++BREAK {-types} {{[count]},{addr range...}}{;action;action...}\n" + "++SET BREAK {-types} {{[count]},{addr range...}}{;action;action...}\n\n" + " If no type is specified, the simulator-specific default breakpoint type\n" + " (usually E for execution) is used. If no address range is specified, the\n" + " current PC is used. As with EXAMINE and DEPOSIT, an address range may be a\n" + " single address, a range of addresses low-high, or a relative range of\n" + " address/length.\n" + /***************** 80 character line width template *************************/ + "5Displaying Breakpoints\n" + " Currently set breakpoints can be displayed with the SHOW BREAK command:\n\n" + "++SHOW {-C} {-types} BREAK {ALL|{,...}}\n\n" + " Locations with breakpoints of the specified type are displayed.\n\n" + " The -C switch displays the selected breakpoint(s) formatted as commands\n" + " which may be subsequently used to establish the same breakpoint(s).\n\n" + "5Removing Breakpoints\n" + " Breakpoints can be cleared by the NOBREAK or the SET NOBREAK commands.\n" + "5Examples\n" + "++BREAK set E break at current PC\n" + "++BREAK -e 200 set E break at 200\n" + "++BREAK 2000/2[2] set E breaks at 2000,2001 with count = 2\n" + "++BREAK 100;EX AC;D MQ 0 set E break at 100 with actions EX AC and\n" + "+++++++++D MQ 0\n" + "++BREAK 100; delete action on break at 100\n\n" + /***************** 80 character line width template *************************/ + "2Connecting and Disconnecting Devices\n" + " Except for main memory and network devices, units are simulated as\n" + " unstructured binary disk files in the host file system. Before using a\n" + " simulated unit, the user must specify the file to be accessed by that unit.\n" +#define HLP_ATTACH "*Commands Connecting_and_Disconnecting_Devices ATTACH" + "3ATTACH\n" + " The ATTACH (abbreviation AT) command associates a unit and a file:\n" + "++ATTACH \n\n" + " Some devices have more detailed or specific help available with:\n\n" + "++HELP ATTACH\n\n" + "4Switches\n" + "5-n\n" + " If the -n switch is specified when an attach is executed, a new file is\n" + " created, and an appropriate message is printed.\n" + "5-e\n" + " If the file does not exist, and the -e switch was not specified, a new\n" + " file is created, and an appropriate message is printed. If the -e switch\n" + " was specified, a new file is not created, and an error message is printed.\n" + "5-r\n" + " If the -r switch is specified, or the file is write protected, ATTACH tries\n" + " to open the file read only. If the file does not exist, or the unit does\n" + " not support read only operation, an error occurs. Input-only devices, such\n" + " as paper-tape readers, and devices with write lock switches, such as disks\n" + " and tapes, support read only operation; other devices do not. If a file is\n" + " attached read only, its contents can be examined but not modified.\n" + "5-q\n" + " If the -q switch is specified when creating a new file (-n) or opening one\n" + " read only (-r), the message announcing this fact is suppressed.\n" + "5-f\n" + " For simulated magnetic tapes, the ATTACH command can specify the format of\n" + " the attached tape image file:\n\n" + "++ATTACH -f \n\n" + " The currently supported tape image file formats are:\n\n" + "++SIMH SIMH simulator format\n" + "++E11 E11 simulator format\n" + "++TPC TPC format\n" + "++P7B Pierce simulator 7-track format\n\n" + /***************** 80 character line width template *************************/ + " For some simulated disk devices, the ATTACH command can specify the format\n" + " of the attached disk image file:\n\n" + "++ATTACH -f \n\n" + " The currently supported disk image file formats are:\n\n" + "++SIMH SIMH simulator format\n" + "++VHD Virtual Disk format\n" + "++RAW platform specific access to physical disk or\n" + "++ CDROM drives\n" + " The disk format can also be set with the SET command prior to ATTACH:\n\n" + "++SET FORMAT=\n" + "++ATT \n\n" + /***************** 80 character line width template *************************/ + " The format of an attached tape or disk file can be displayed with the SHOW\n" + " command:\n" + "++SHOW FORMAT\n" + " For Telnet-based terminal emulation devices, the ATTACH command associates\n" + " the master unit with a TCP/IP listening port:\n\n" + "++ATTACH \n\n" + " The port is a decimal number between 1 and 65535 that is not already used\n" + " other TCP/IP applications.\n" + " For Ethernet emulators, the ATTACH command associates the simulated Ethernet\n" + " with a physical Ethernet device:\n\n" + "++ATTACH \n" + /***************** 80 character line width template *************************/ +#define HLP_DETACH "*Commands Connecting_and_Disconnecting_Devices DETACH" + "3DETACH\n" + " The DETACH (abbreviation DET) command breaks the association between a unit\n" + " and a file, port, or network device:\n\n" + "++DETACH ALL detach all units\n" + "++DETACH detach specified unit\n" + " The EXIT command performs an automatic DETACH ALL.\n" + "2Controlling Simulator Operating Environment\n" + "3Working Directory\n" +#define HLP_CD "*Commands Controlling_Simulator_Operating_Environment Working_Directory CD" + "4CD\n" + " Set the current working directory:\n" + "++CD path\n" + "4SET_DEFAULT\n" + " Set the current working directory:\n" + "++SET DEFAULT path\n" +#define HLP_PWD "*Commands Controlling_Simulator_Operating_Environment Working_Directory PWD" + "4PWD\n" + "++PWD\n" + " Display the current working directory:\n" + "2Listing Files\n" +#define HLP_DIR "*Commands Listing_Files DIR" + "3DIR\n" + "++DIR {path} list directory files\n" +#define HLP_LS "*Commands Listing_Files LS" + "3LS\n" + "++LS {path} list directory files\n" + "2Displaying Files\n" +#define HLP_TYPE "*Commands Displaying_Files TYPE" + "3TYPE\n" + "++TYPE {file} display a file contents\n" +#define HLP_CAT "*Commands Displaying_Files CAT" + "3CAT\n" + "++CAT {file} display a file contents\n" +#define HLP_SET "*Commands SET" + "2SET\n" + /***************** 80 character line width template *************************/ +#define HLP_SET_CONSOLE "*Commands SET CONSOLE" + "3Console\n" + "+set console arg{,arg...} set console options\n" + "+set console WRU specify console drop to simh character\n" + "+set console BRK specify console Break character\n" + "+set console DEL specify console delete character\n" + "+set console PCHAR specify console printable characters\n" + "+set console SPEED=speed{*factor}\n" + "++++++++ specify console input data rate\n" + "+set console TELNET=port specify console telnet port\n" + "+set console TELNET=LOG=log_file\n" + "++++++++ specify console telnet logging to the\n" + "++++++++ specified destination {LOG,STDOUT,STDERR,\n" + "++++++++ DEBUG or filename)\n" + "+set console TELNET=NOLOG disables console telnet logging\n" + "+set console TELNET=BUFFERED[=bufsize]\n" + "++++++++ specify console telnet buffering\n" + "+set console TELNET=NOBUFFERED\n" + "++++++++ disables console telnet buffering\n" + "+set console TELNET=UNBUFFERED\n" + "++++++++ disables console telnet buffering\n" + "+set console NOTELNET disable console telnet\n" + "+set console SERIAL=serialport[;config]\n" + "++++++++ specify console serial port and optionally\n" + "++++++++ the port config (i.e. ;9600-8n1)\n" + "+set console NOSERIAL disable console serial session\n" + "+set console SPEED=nn{*fac} specifies the maximum console port input rate\n" + /***************** 80 character line width template *************************/ +#define HLP_SET_REMOTE "*Commands SET REMOTE" + "3Remote\n" + "+set remote TELNET=port specify remote console telnet port\n" + "+set remote NOTELNET disables remote console\n" + "+set remote BUFFERSIZE=bufsize\n" + "++++++++ specify remote console command output buffer\n" + "++++++++ size\n" + "+set remote CONNECTIONS=n specify number of concurrent remote\n" + "++++++++ console sessions\n" + "+set remote TIMEOUT=n specify number of seconds without input\n" + "++++++++ before automatic continue\n" + "+set remote MASTER enable master mode remote console\n" + "+set remote NOMASTER disable remote master mode console\n" +#define HLP_SET_DEFAULT "*Commands SET Working_Directory" + "3Working Directory\n" + "+set default set the current directory\n" + "+cd set the current directory\n" +#define HLP_SET_LOG "*Commands SET Log" + "3Log\n" + " Interactions with the simulator session (at the \"sim>\" prompt\n" + " can be recorded to a log file\n\n" + "+set log log_file specify the log destination\n" + "++++++++ (STDOUT,DEBUG or filename)\n" + "+set nolog disables any currently active logging\n" + "4Switches\n" + " By default, log output is written at the end of the specified log file.\n" + " A new log file can created if the -N switch is used on the command line.\n" +#define HLP_SET_DEBUG "*Commands SET Debug" + /***************** 80 character line width template *************************/ + "3Debug\n" + "+set debug debug_file specify the debug destination\n" + "++++++++ (STDOUT,STDERR,LOG or filename)\n" + "+set nodebug disables any currently active debug output\n" + "4Switches\n" + " Debug message output contains a timestamp which indicates the number of\n" + " simulated instructions which have been executed prior to the debug event.\n\n" + " Debug message output can be enhanced to contain additional, potentially\n" + " useful information.\n" + "5-T\n" + " The -T switch causes debug output to contain a time of day displayed\n" + " as hh:mm:ss.msec.\n" + "5-A\n" + " The -A switch causes debug output to contain a time of day displayed\n" + " as seconds.msec.\n" + "5-R\n" + " The -R switch causes the time of day displayed due to the -T or -A\n" + " switches to be relative to the start time of debugging. If neither\n" + " -T or -A is explicitly specified, -T is implied.\n" + "5-P\n" + " The -P switch adds the output of the PC (Program Counter) to each debug\n" + " message.\n" + "5-N\n" + " The -N switch causes a new/empty file to be written to. The default\n" + " is to append to an existing debug log file.\n" + "5-D\n" + " The -D switch causes data blob output to also display the data as\n" + " RADIX-50 characters.\n" + "5-E\n" + " The -E switch causes data blob output to also display the data as\n" + " EBCDIC characters.\n" +#define HLP_SET_BREAK "*Commands SET Breakpoints" + "3Breakpoints\n" + "+set break set breakpoints\n" + "+set nobreak clear breakpoints\n" + /***************** 80 character line width template *************************/ +#define HLP_SET_THROTTLE "*Commands SET Throttle" + "3Throttle\n" + "+set throttle {x{M|K|%%}}|{x/t}\n" + "++++++++ set simulation rate\n" + "+set nothrottle set simulation rate to maximum\n" +#define HLP_SET_CLOCKS "*Commands SET Clocks" + "3Clock\n" +#if defined (SIM_ASYNCH_CLOCKS) + "+set clock asynch enable asynchronous clocks\n" + "+set clock noasynch disable asynchronous clocks\n" +#endif + "+set clock nocatchup disable catchup clock ticks\n" + "+set clock catchup enable catchup clock ticks\n" + "+set clock calib=n%% specify idle calibration skip %%\n" +#define HLP_SET_ASYNCH "*Commands SET Asynch" + "3Asynch\n" + "+set asynch enable asynchronous I/O\n" + "+set noasynch disable asynchronous I/O\n" +#define HLP_SET_ENVIRON "*Commands SET Asynch" + "3Environment\n" + "+set environment name=val set environment variable\n" + "+set environment name clear environment variable\n" +#define HLP_SET_ON "*Commands SET Command_Status_Trap_Dispatching" + "3Command Status Trap Dispatching\n" + "+set on enables error checking after command\n" + "++++++++ execution\n" + "+set noon disables error checking after command\n" + "++++++++ execution\n" + "+set on inherit enables inheritance of ON state and\n" + "++++++++ actions into do command files\n" + "+set on noinherit disables inheritance of ON state and\n" + "++++++++ actions into do command files\n" +#define HLP_SET_VERIFY "*Commands SET Command_Execution_Display" +#define HLP_SET_VERIFY "*Commands SET Command_Execution_Display" + "3Command Execution Display\n" + "+set verify re-enables display of command file\n" + "++++++++ processed commands\n" + "+set verbose re-enables display of command file\n" + "++++++++ processed commands\n" + "+set noverify disables display of command file processed\n" + "++++++++ commands\n" + "+set noverbose disables display of command file processed\n" + "++++++++ commands\n" +#define HLP_SET_MESSAGE "*Commands SET Command_Error_Status_Display" + "3Command Error Status Display\n" + "+set message re-enables display of command file error\n" + "++++++++ messages\n" + "+set nomessage disables display of command file error\n" + "++++++++ messages\n" +#define HLP_SET_QUIET "*Commands SET Command_Output_Display" + "3Command Output Display\n" + "+set quiet disables suppression of some output and\n" + "++++++++ messages\n" + "+set noquiet re-enables suppression of some output and\n" + "++++++++ messages\n" +#define HLP_SET_PROMPT "*Commands SET Command_Prompt" + "3Command Prompt\n" + "+set prompt \"string\" sets an alternate simulator prompt string\n" + "3Device and Unit\n" + "+set OCT|DEC|HEX set device display radix\n" + "+set ENABLED enable device\n" + "+set DISABLED disable device\n" + "+set DEBUG{=arg} set device debug flags\n" + "+set NODEBUG={arg} clear device debug flags\n" + "+set arg{,arg...} set device parameters (see show modifiers)\n" + "+set ENABLED enable unit\n" + "+set DISABLED disable unit\n" + "+set arg{,arg...} set unit parameters (see show modifiers)\n" + "+help set displays the device specific set commands\n" + "++++++++ available\n" + /***************** 80 character line width template *************************/ +#define HLP_SHOW "*Commands SHOW" + "2SHOW\n" + "+sh{ow} {-c} br{eak} show breakpoints\n" + "+sh{ow} con{figuration} show configuration\n" + "+sh{ow} cons{ole} {arg} show console options\n" + "+sh{ow} {-ei} dev{ices} show devices\n" + "+sh{ow} fea{tures} show system devices with descriptions\n" + "+sh{ow} m{odifiers} show modifiers for all devices\n" + "+sh{ow} s{how} show SHOW commands for all devices\n" + "+sh{ow} n{ames} show logical names\n" + "+sh{ow} q{ueue} show event queue\n" + "+sh{ow} ti{me} show simulated time\n" + "+sh{ow} th{rottle} show simulation rate\n" + "+sh{ow} a{synch} show asynchronouse I/O state\n" + "+sh{ow} ve{rsion} show simulator version\n" + "+sh{ow} def{ault} show current directory\n" + "+sh{ow} re{mote} show remote console configuration\n" + "+sh{ow} RADIX show device display radix\n" + "+sh{ow} DEBUG show device debug flags\n" + "+sh{ow} MODIFIERS show device modifiers\n" + "+sh{ow} NAMES show device logical name\n" + "+sh{ow} SHOW show device SHOW commands\n" + "+sh{ow} {arg,...} show device parameters\n" + "+sh{ow} {arg,...} show unit parameters\n" + "+sh{ow} ethernet show ethernet devices\n" + "+sh{ow} serial show serial devices\n" + "+sh{ow} multiplexer show open multiplexer devices\n" +#if defined(USE_SIM_VIDEO) + "+sh{ow} video show video capabilities\n" +#endif + "+sh{ow} clocks show calibrated timer information\n" + "+sh{ow} throttle show throttle info\n" + "+sh{ow} on show on condition actions\n" + "+h{elp} show displays the device specific show commands\n" + "++++++++ available\n" +#define HLP_SHOW_CONFIG "*Commands SHOW" +#define HLP_SHOW_DEVICES "*Commands SHOW" +#define HLP_SHOW_FEATURES "*Commands SHOW" +#define HLP_SHOW_QUEUE "*Commands SHOW" +#define HLP_SHOW_TIME "*Commands SHOW" +#define HLP_SHOW_MODIFIERS "*Commands SHOW" +#define HLP_SHOW_NAMES "*Commands SHOW" +#define HLP_SHOW_SHOW "*Commands SHOW" +#define HLP_SHOW_VERSION "*Commands SHOW" +#define HLP_SHOW_DEFAULT "*Commands SHOW" +#define HLP_SHOW_CONSOLE "*Commands SHOW" +#define HLP_SHOW_REMOTE "*Commands SHOW" +#define HLP_SHOW_BREAK "*Commands SHOW" +#define HLP_SHOW_LOG "*Commands SHOW" +#define HLP_SHOW_DEBUG "*Commands SHOW" +#define HLP_SHOW_THROTTLE "*Commands SHOW" +#define HLP_SHOW_ASYNCH "*Commands SHOW" +#define HLP_SHOW_ETHERNET "*Commands SHOW" +#define HLP_SHOW_SERIAL "*Commands SHOW" +#define HLP_SHOW_MULTIPLEXER "*Commands SHOW" +#define HLP_SHOW_VIDEO "*Commands SHOW" +#define HLP_SHOW_CLOCKS "*Commands SHOW" +#define HLP_SHOW_ON "*Commands SHOW" +#define HLP_SHOW_SEND "*Commands SHOW" +#define HLP_SHOW_EXPECT "*Commands SHOW" +#define HLP_HELP "*Commands HELP" + /***************** 80 character line width template *************************/ + "2HELP\n" + "+h{elp} type this message\n" + "+h{elp} type help for command\n" + "+h{elp} type help for device\n" + "+h{elp} registers type help for device register variables\n" + "+h{elp} attach type help for device specific ATTACH command\n" + "+h{elp} set type help for device specific SET commands\n" + "+h{elp} show type help for device specific SHOW commands\n" + "+h{elp} type help for device specific command\n" + /***************** 80 character line width template *************************/ + "2Altering The Simulated Configuration\n" + " In most simulators, the SET DISABLED command removes the\n" + " specified device from the configuration. A DISABLED device is invisible\n" + " to running programs. The device can still be RESET, but it cannot be\n" + " ATTAChed, DETACHed, or BOOTed. SET ENABLED restores a disabled\n" + " device to a configuration.\n\n" + " Most multi-unit devices allow units to be enabled or disabled:\n\n" + "++SET ENABLED\n" + "++SET DISABLED\n\n" + " When a unit is disabled, it will not be displayed by SHOW DEVICE.\n\n" +#define HLP_ASSIGN "*Commands Logical_Names" +#define HLP_DEASSIGN "*Commands Logical_Names" + "2Logical Names\n" + " The standard device names can be supplemented with logical names. Logical\n" + " names must be unique within a simulator (that is, they cannot be the same\n" + " as an existing device name). To assign a logical name to a device:\n\n" + "++ASSIGN assign log-name to device\n\n" + " To remove a logical name:\n\n" + "++DEASSIGN remove logical name\n\n" + " To show the current logical name assignment:\n\n" + "++SHOW NAMES show logical name, if any\n\n" + " To show all logical names:\n\n" + "++SHOW NAMES\n\n" + /***************** 80 character line width template *************************/ +#define HLP_DO "*Commands Executing_Command_Files" + "2Executing Command Files\n" + " The simulator can execute command files with the DO command:\n\n" + "++DO {arguments...} execute commands in file\n\n" + " The DO command allows command files to contain substitutable arguments.\n" + " The string %%n, where n is between 1 and 9, is replaced with argument n\n" + " from the DO command line. The string %%0 is replaced with .\n" + " The sequences \\%% and \\\\ are replaced with the literal characters %% and \\,\n" + " respectively. Arguments with spaces can be enclosed in matching single\n" + " or double quotation marks.\n\n" + " DO commands may be nested up to ten invocations deep.\n\n" + "3Switches\n" + " If the switch -v is specified, the commands in the file are echoed before\n" + " they are executed.\n\n" + " If the switch -e is specified, command processing (including nested command\n" + " invocations) will be aborted if a command error is encountered.\n" + " (Simulation stop never abort processing; use ASSERT to catch unexpected\n" + " stops.) Without the switch, all errors except ASSERT failures will be\n" + " ignored, and command processing will continue.\n\n" + " If the switch -o is specified, the on conditions and actions from the\n" + " calling command file will be inherited in the command file being invoked.\n" + " If the switch -q is specified, the quiet mode will be explicitly enabled\n" + " for the called command file, otherwise quiet mode is inherited from the\n" + " calling context.\n" + /***************** 80 character line width template *************************/ +#define HLP_GOTO "*Commands Executing_Command_Files GOTO" + "3GOTO\n" + " Commands in a command file execute in sequence until either an error\n" + " trap occurs (when a command completes with an error status), or when an\n" + " explict request is made to start command execution elsewhere with the\n" + " GOTO command:\n\n" + "++GOTO