From 6a0c3bba084cf42972f43dcd2f92b83f3e81c3ae Mon Sep 17 00:00:00 2001 From: "Eric S. Raymond" Date: Fri, 22 Apr 1994 12:00:00 -0400 Subject: [PATCH] INTERCAL 0.12 release. Hour/minute/second of the timestamp is unreliable. (This is a retrospective comment.) --- BUGS | 101 +- Makefile | 64 +- NEWS | 141 +++ READ.ME | 123 ++- THEORY | 51 - cesspool.c | 408 -------- cesspool.h | 18 - doc/THEORY | 58 ++ doc/ick.txt | 577 +++++++++++ doc/intercal.ms | 1589 ++++++++++++++++++++++++++++++ intercal.sty => doc/intercal.sty | 0 intercal.tex => doc/intercal.tex | 0 intercal.man => doc/intercal.txt | 0 fiddle.c | 124 --- ick-wrapper.c | 49 - ick.h | 51 - ick.y | 277 ------ intercal.el | 176 ++++ intercal.lsm | 18 + lose.c | 20 - lose.h | 52 - pit/CATALOG | 70 ++ pit/Makefile | 61 ++ pit/blinkers | 16 + pit/bubble.doc | 110 +++ pit/bubble.i | 94 ++ pit/glider | 14 + pit/gun | 90 ++ pit/icat.i | 23 + pit/iogerunds.doc | 10 + pit/iogerunds.i | 20 + pit/lib/1910.doc | 34 + pit/lib/lib2.i | 51 + pit/lib/plus.i | 16 + pit/lib/syslib.i | 290 ++++++ pit/life.doc | 163 +++ pit/life.i | 276 ++++++ pit/life2.doc | 46 + pit/life2.i | 268 +++++ pit/pi.doc | 107 ++ pit/pi.i | 137 +++ pit/primes.doc | 18 + pit/primes.i | 86 ++ pit/random.doc | 23 + pit/random.i | 20 + pit/sample.i | 28 + pit/sink.doc | 5 + pit/sink.i | 3 + pit/t_tet | 12 + pit/testcompile | 8 + pit/tests/limits.3i | 5 + pit/tests/limits.i | 5 + pit/tests/test1.i | 83 ++ pit/tests/test16bit.i | 7 + pit/tests/test2.i | 187 ++++ pit/tests/testarray.i | 24 + pit/tests/testcf.i | 22 + pit/tests/testlib2.i | 62 ++ pit/tests/testops.3i | 18 + pit/tests/testops.5i | 17 + pit/tests/testsplat.i | 10 + sample.i | 27 - src/Makefile | 83 ++ src/arrgghh.c | 83 ++ src/cesspool.c | 581 +++++++++++ src/cesspool.h | 46 + feh.c => src/feh.c | 647 +++++------- src/fiddle.c | 245 +++++ src/ick-wrap.c | 48 + src/ick.h | 87 ++ src/ick.y | 349 +++++++ lexer.l => src/lexer.l | 116 ++- src/lose.c | 25 + src/lose.h | 126 +++ src/numerals.c | 112 +++ src/perpetrate.c | 399 ++++++++ src/sizes.h | 7 + 77 files changed, 7804 insertions(+), 1613 deletions(-) create mode 100644 NEWS delete mode 100644 THEORY delete mode 100644 cesspool.c delete mode 100644 cesspool.h create mode 100644 doc/THEORY create mode 100644 doc/ick.txt create mode 100644 doc/intercal.ms rename intercal.sty => doc/intercal.sty (100%) rename intercal.tex => doc/intercal.tex (100%) rename intercal.man => doc/intercal.txt (100%) delete mode 100644 fiddle.c delete mode 100644 ick-wrapper.c delete mode 100644 ick.h delete mode 100644 ick.y create mode 100644 intercal.el create mode 100644 intercal.lsm delete mode 100644 lose.c delete mode 100644 lose.h create mode 100644 pit/CATALOG create mode 100644 pit/Makefile create mode 100644 pit/blinkers create mode 100644 pit/bubble.doc create mode 100644 pit/bubble.i create mode 100644 pit/glider create mode 100644 pit/gun create mode 100644 pit/icat.i create mode 100644 pit/iogerunds.doc create mode 100644 pit/iogerunds.i create mode 100644 pit/lib/1910.doc create mode 100644 pit/lib/lib2.i create mode 100644 pit/lib/plus.i create mode 100644 pit/lib/syslib.i create mode 100644 pit/life.doc create mode 100644 pit/life.i create mode 100644 pit/life2.doc create mode 100644 pit/life2.i create mode 100644 pit/pi.doc create mode 100644 pit/pi.i create mode 100644 pit/primes.doc create mode 100644 pit/primes.i create mode 100644 pit/random.doc create mode 100644 pit/random.i create mode 100644 pit/sample.i create mode 100644 pit/sink.doc create mode 100644 pit/sink.i create mode 100644 pit/t_tet create mode 100755 pit/testcompile create mode 100644 pit/tests/limits.3i create mode 100644 pit/tests/limits.i create mode 100644 pit/tests/test1.i create mode 100644 pit/tests/test16bit.i create mode 100644 pit/tests/test2.i create mode 100644 pit/tests/testarray.i create mode 100644 pit/tests/testcf.i create mode 100644 pit/tests/testlib2.i create mode 100644 pit/tests/testops.3i create mode 100644 pit/tests/testops.5i create mode 100644 pit/tests/testsplat.i delete mode 100644 sample.i create mode 100644 src/Makefile create mode 100644 src/arrgghh.c create mode 100644 src/cesspool.c create mode 100644 src/cesspool.h rename feh.c => src/feh.c (54%) create mode 100644 src/fiddle.c create mode 100644 src/ick-wrap.c create mode 100644 src/ick.h create mode 100644 src/ick.y rename lexer.l => src/lexer.l (55%) create mode 100644 src/lose.c create mode 100644 src/lose.h create mode 100644 src/numerals.c create mode 100644 src/perpetrate.c create mode 100644 src/sizes.h diff --git a/BUGS b/BUGS index 56d50c4..2dcbc58 100644 --- a/BUGS +++ b/BUGS @@ -1,57 +1,56 @@ - NEW FEATURES IN C-INTERCAL - -1. As a convenience to all you junior birdmen out there, `NINER' is accepted as - a synonym for `NINE' in INTERCAL input. - -2. The COME FROM statement is now compiled. You may write - - PLEASE COME FROM (n) - - and the effect will be that whenever execution reaches statement label n, - it will immediately transfer control to the statement following the - COME FROM. Conditional COME FROM is possible; ABSTAIN FROM COMING FROM and - REINSTATE COMING FROM are both valid. DON'T COME FROM is a no-op (until - reinstated). Finally; NEXTING to the label `target' of an un-abstained - COME FROM *will* cause control to be transferred to the statement following - the COME FROM. - BUGS -1) INTERCAL would be intrinsically a crock even if it worked right. - -2) The INTERCAL-72 handling of invalid statements isn't implemented; instead - they raise a normal compile-time error. This is because I haven't figured - out how to force YACC to do the needed thing yet. It means C-INTERCAL - can't compile the INTERCAL-72 system library yet. Isn't compatibility - wonderful? I may have to go to a handcrafted LL(1) parser to fix this... - -3) Error-checking could be improved. Not all the errors listed in the - manual are actually detected (of those listed in lose.h, E123, E621, E632, - E562, E579, E436, E017, E275, E182, E129, E139, and E778 are implemented). - In this respect C-INTERCAL follows nobly in the tradition of many production - compilers. - -4) Proper C code is generated for array operations, but the runtime-library - hooks for the dynamic memory management needed to make the code work are - stubbed out. I'm poor at array-bashing. Rachel Millian has promised to - implement this for the next release. - -5) The Roman-numeral output from INTERCAL isn't quite as butchered as it ought - to be, because neither I nor the implementor could figure out what the frotz - the note in the INTERCAL-72 manual about modulo 4000 and I and M and all - that was really supposed to mean. - -6) The manual is mangled in spots. I'm in touch with the INTERCAL-72 authors - and we'll try to fix this in the next release, assuming there *is* a next - release. +There are still some known bugs in INTERCAL (and no doubt many we don't even +suspect as yet). The following list accumulates current bug reports and +TO DO agenda items from the major INTERCAL hackers through version 0.10. + +ESR = Eric S. Raymond +SS = Steve Swales +LLH = Louis Howell + +1) (ESR) INTERCAL would be intrinsically a crock even if it worked right. + +2) (ESR) Error-checking could be improved. Not all the errors listed in the + manual are actually detected (of those listed in lose.h, E000, E197, E200, + and E774 are never emitted). In this respect C-INTERCAL follows + nobly in the tradition of many production compilers. + +3) (SS) The system library syslib.i does not appear to work 100% as advertised. + +4) (LLH) The lexical analyzer is not completely independent of newlines. + There is a conflict between the fact that newlines should be + ignored almost everywhere, and the facts that the error mechanism + wants to know about line numbers and the splat mechanism wants + statements from the original program. + + The way these issues are currently resolved by the compiler is + a bit over-complicated, but seems to work properly in almost + every respect. I see only two problems: First, splat operation + prints only the text line on which a typo was detected, not the + whole statement. Second, for debugging purposes the text lines + are printed as comments in the degenerated C code. These + comments are only properly aligned with the degenerated code + if the program has exactly one statement per line. (See + pit/tests/testsplat.i for examples.) + + Neither of these problems is a big deal, which is why I haven't + worried about them too much. The best solution I can see is + to make "phase 1" of the lexer into a preprocessor able to + correctly separate statements. It could then either add or + remove newlines to put the program into one statement per line + format, or put markers between statements for the main lexer + to detect. Either way, it would be a good bit of work for a + relatively small gain, and anyone trying it should make sure + the result isn't buggier than the current version. + +5) (ESR) We can't use flex to generate the lexical analyzer. The + frustrating thing is that it *almost* works; only some sources + (including icat.i, pi.i and both life programs) fail. Looking + at the parsing trace suggests that flex is returning something to + yacc/bison that does not cause it to terminate as it should. TO DO -1. Test this loser on something other than the sample program. - -2. Add more optimization templates, esp. the idioms for &, |, ^, ~. - -3. Input format internationalization -- allow WRITE IN input digits in - major languages such as Nahuatl, Tagalog, Sanskrit, and Basque. +1. (ESR) Add more optimization templates, esp. the idioms for &, |, ^, ~. -4. Forget this @!%$#! crock and take a long vacation. +2. (ESR) Forget this @!%$#! crock and take a long vacation. diff --git a/Makefile b/Makefile index 451f2a3..dc40bcb 100644 --- a/Makefile +++ b/Makefile @@ -1,48 +1,16 @@ -# Makefile for the INTERCAL compiler - -YDEBUG = -v -t -SYSTYPE = -DATT # -DBSD for Berkeley systems -CFLAGS = -I. $(SYSTYPE) -g -LDFLAGS = -lg - -DOCS = READ.ME intercal.man intercal.tex intercal.sty BUGS THEORY -SOURCES = cesspool.[ch] feh.c fiddle.c ick.[yh] lose.[ch] lexer.l - -all: ick libick.a - -ick: y.tab.o lexer.o feh.o lose.o fiddle.o - $(CC) y.tab.o lexer.o feh.o lose.o fiddle.o $(LDFLAGS) -o ick - -y.tab.h y.tab.c: ick.y - @echo "expect 13 shift/reduce conflicts" - yacc -d $(YDEBUG) ick.y - -lextest: y.tab.h lexer.c ick.h - $(CC) -DMAIN lexer.c -ll -o lextest - -y.tab.o: y.tab.c ick.h lose.h -lexer.o: lexer.c y.tab.h ick.h -feh.o: feh.c y.tab.h ick.h lose.h -cesspool.o: cesspool.c cesspool.h lose.h -lose.o: lose.h - -libick.a: cesspool.o lose.o fiddle.o - ar cr libick.a cesspool.o lose.o fiddle.o - -install: - cp cesspool.h /usr/include - cp libick.a /usr/lib - cp ick /usr/bin - -clean: - rm -f yacc.* y.tab.* y.output *~ *.[oa] lexer.c lextest ick - rm -f sample.c sample ick.shar Part1.sh Part2.sh - -shar: - shar $(DOCS) Makefile $(SOURCES) ick-wrapper.c sample.i >ick.shar - -mailable: - shar $(DOCS) Makefile >Part1.sh - shar $(SOURCES) ick-wrapper.c sample.i >Part2.sh - - +# +# Utility productions for the INTERCAL distribution +# +ick.tar: + (cd ..; tar cvf ick.tar `cat intercal-0.12/MANIFEST`) + mv ../ick.tar . + +ick.tar.Z: ick.tar + compress ick.tar + +ick.tar.gz: ick.tar + gzip ick.tar + +SHAROPTS = -l63 -n intercal -o intercal -a -s esr@snark.thyrsus.com +ick.shar: + (cd ..; shar $(SHAROPTS) `cat intercal-0.12/MANIFEST` >ick.shar) diff --git a/NEWS b/NEWS new file mode 100644 index 0000000..ef6784a --- /dev/null +++ b/NEWS @@ -0,0 +1,141 @@ + NEW IN THIS RELEASE + + Release 0.12 (by Eric S. Raymond) + +1. The code now compiles and runs under Linux, using bison and lex. It does + *not* yet work with flex; C.P. Osborne's patches for 0.11 turned out not + to be sufficient (at least for flex 2.4.6 under Linux using the -l option). + See the BUGS list. + +2. Note 3 under 0.11 was incorrect. We're in conformance after all. + +3. The politesse check is a little smarter about programs too small to + conform to the 1/5-to-1/3 criterion. All the pit programs have been + checked for conformance. Also, the politesse error message now tells + you the offending program's line count. + + Release 0.11 (by Eric S. Raymond) + +1. Incorporated changes by Jan-Pieter Cornet for + magical inclusion of the system library. These address an outstanding bug + + 2. (SS) The `system library' should be precompiled and `linked' to user + written code, at least optionally. Doing this with the current compiler + presents a few problems. + + which has accordingly been removed from the BUGS file. They also fix a + previously unknown bug; due to a minor oversight in the lexer, it was not + possible to ABSTAIN FROM WRITING IN or READING OUT. Jan also contributed + a test program that demonstrates gerund abstention. + +2. Despite the obvious appeal of the idea, and much discussion on + alt.lang.intercal, I decided *not* to add Klingon; maintaining two parallel + grammars just so the compiler could support SVO and OSV languages would be + too painful. There was also a minor mess near case-sensitivity in the + digits. The workaround kluges I was offered instead failed to satisfy. + +3. We fess up to a violation of the INTERCAL-72 standard. That implementation, + instead of accepting an entire multiple-digit number per line of input, + expected one digit per *card image* (input line). It is unclear how + INTERCAL-72 programs ever managed to input more than one number. + +4. Added patches by C.P.Osborne to make the lexer work + using flex, for Linux and BSD/386 support. I didn't use his error-reporting + patch, though; instead, I changed the parser to catch errors at logical-line + level. I also kept the N in `RESUBNIT'; this is a carefully preserved + feature of INTERCAL-72. + +5. Volapuk digits are now recognized on input. TO DO: Recognize Volapuk + keywords, including gerunds. + + Release 0.10 (by Eric S. Raymond) + +1. It is now possible to undo a line-number abstention with a gerund + reinstatement, or undo a gerund abstention with a line-number + reinstatement. In previous versions, gerund abstention/reinstatements and + line-number abstention/reinstatements were independent of each other. + +2. After release 0.5, I wrote in the TO DO list as follows: + + 2. (ESR) Input format internationalization -- allow WRITE IN input digits in + major languages such as Nahuatl, Tagalog, Sanskrit, and Basque. + + The twisted loons in the alt.folklore.computers crowd loved this idea, + and I actually got sent digit lists for Nahuatl, Tagalog, Sanskrit, and + Basque -- also, Kwakiutl, Georgian, Ojibwe. and Albanian. I've left + out Albanian (didn't want to keep track of the dipthong diacritical) + and Ojibwe (no zero digit). So: Nahuatl, Tagalog, Sanskrit, Basque, + Georgian, and Kwakiutl are now supported in addition to English. + +3. The THEORY document has been significantly revised. + + Release 0.9 (by Eric S. Raymond) + +1. An embarrassing port bug in the INTERCAL skeleton has been fixed + +2. Jamie Zawinski's suggestion for an improved E333 error message has + been accepted. + +3. Added and improved documentation for pit programs. + +4. The install production in the Makefile now puts lose.h in place + as well as cesspool.h. + +5. You can now set the C compiler to be used as a back end by INTERCAL + by setting the environment variable CC. The default is cc. + + Release 0.8 (many hacks on 0.7 by Eric Raymond) + +1. A previously undocumented `feature' of the Princeton compiler, + revealed by Don Woods, is now emulated. If fewer than 1/5 or more + than 1/3 of a program's statements contain the qualifier `PLEASE', the + program is rejected with an entertaining error message. Programs in pit + have been hacked to pass the politesse test. + +2. The `sample' program now works correctly, thanks to Louis Howell. Also, + he has contributed new programs to calculate pi and to search for prime + numbers. + +3. An intercal mode for GNU Emacs is included. It helps programmers deal with + the new politesse check by randomly expanding the abbrev "do" to DO PLEASE + or PLEASE DO about 1/4 of the time. + +4. Improvements in code generation for NEXT/RESUME. + +5. Fixes to the optimizer; it handles the results of optimized MINGLEs + correctly now. Also, added a rewrite rule that checks for the + equality-test idiom using XOR. + +6. The original error messages from the Princeton compiler have been restored. + +The documentation has been updated to reflect these changes. + + Release 0.7 (by Louis Howell) + +In addition to bug fixes, new features in this version include arrays, +character I/O, modified (hopefully improved!) semantics for the COME +FROM statement, extensions to bases other than 2, new INTERCAL programs, +and new documentation. + + Release 0.6 (by Steve Swales) + +1. Restored Princeton documentation (courtesy of Michael Ernst). + +2. Added -@ usage option to ick. + +3. Added [+/-]help, [+/-]traditional, and [+/-]wimpmode options for +generated programs; [+/-]traditional is a no-op at this point. + +4. Various bug fixes, esp. in lexical analysis. + + Release 0.5 (ESR's original pre-release) + +1. As a convenience to all you junior birdmen out there, `NINER' is accepted as + a synonym for `NINE' in INTERCAL input. + +2. The COME FROM statement is now compiled. + + ------------- + +For details on COME FROM and other extensions to C-INTERCAL, see +doc/ick.txt. diff --git a/READ.ME b/READ.ME index 1201b11..4e5d479 100644 --- a/READ.ME +++ b/READ.ME @@ -1,50 +1,101 @@ - C-INTERCAL (v 0.5) + Release Notes for C-INTERCAL + version 0.12 - NOTE! THIS IS A PRE-RELEASE VERSION WITH SOME KNOWN BUGS! - SEE THE `BUGS' FILE FOR DETAILS, AND EARN THE ETERNAL GRATITUDE - OF THE HUGE, BUSTLING INTERCAL COMMUNITY BY FIXING THEM! + DISCREDITS This package is an implementation of the language INTERCAL designed by Don -Woods and James Lyon, who have since spent most of twenty years trying to +Woods and James Lyon, who have since spent more than twenty years trying to live it down. -The implementation was created by Eric S. Raymond (...!uunet!snark!eric) -during a fit of lunacy from which he has since mostly recovered. The files -included are: - -READ.ME -- this file -intercal.man -- The INTERCAL manual (read this next!) -intercal.tex -- TeX source form -intercal.sty -- TeX style file -THEORY -- some notes on the internals of the INTERCAL compiler -BUGS -- notes pertaining to this release - -Makefile -- makefile for the INTERCAL compiler -lexer.l -- the lexical analyzer specification (in LEX) -ick.y -- the grammar specification (in YACC) -ick.h -- compilation types and defines -feh.c -- INTERCAL-to-C code generator -fiddle.c -- the INTERCAL operators -lose.[ch] -- INTERCAL compile- and run-time error handling -ick-wrapper.c -- the driver for generated C-from-INTERCAL code -cesspool.c -- the INTERCAL runtime support code -cesspool.h -- interface fr. generated code to the INTERCAL runtime support - -sample.i -- a sample INTERCAL program (from the manual) - -You want a man page? Man pages are for wimps. To compile an INTERCAL +This implementation was created by Eric S. Raymond +during a fit of lunacy from which he has since mostly recovered. It has +been considerably hacked upon and improved by Steve Swales, Michael Ernst, +Louis Howell (who wrote the array support stubbed out in Eric's original +version), and others. + +You can surf to the latest version of this package, and related resources, from +http://www.ccil.org/~esr/home.html. + + FILES + +The compiler itself is in the src directory. Setting a symbol in the +makefile will allow you to install it and its libraries and support files +in a directory of your choice. The doc directory contains (surprise!) +documentation, and pit contains various examples of INTERCAL source code, +writhing in agony. + +The files included are: + +READ.ME -- this file +BUGS -- current bug and to-do list +NEWS -- info on features and fixes new in this release +intercal.el -- elisp for editing INTERCAL code under GNU Emacs + +doc/intercal.txt -- The INTERCAL manual (read this next!) +doc/intercal.tex -- TeX source form +doc/intercal.sty -- TeX style file +doc/intercal.ms -- the manual in nroffable form +doc/ick.txt -- new features in C-INTERCAL +doc/THEORY -- some notes on the internals of the INTERCAL compiler + +src/Makefile -- makefile for the INTERCAL compiler +src/lexer.l -- the lexical analyzer specification (in LEX) +src/ick.y -- the grammar specification (in YACC) +src/ick.h -- compilation types and defines +src/perpetrate.c -- main routine for compiler +src/feh.c -- INTERCAL-to-C code generator +src/fiddle.c -- the INTERCAL operators +src/lose.[ch] -- INTERCAL compile- and run-time error handling +src/ick-wrap.c -- the driver for generated C-from-INTERCAL code +src/arrgghh.c -- option argument parsing for generated programs +src/cesspool.c -- the INTERCAL runtime support code +src/cesspool.h -- interface to INTERCAL runtime support +src/numerals.c -- numerals table for INTERCAL input + +pit/* -- sample INTERCAL code; see pit/CATALOG + + HOW TO GET STARTED + +You want a man page? Man pages are for wimps. To compile an INTERCAL program `foo.i' to executable code, just do ick foo.i -There's a -d option that leaves the generated `foo.c' in place for -inspection (suppressing compilation to machine code), and an -O option -that enables the (hah!) optimizer. Other than that, yer on yer own. +There's a -c option that leaves the generated `foo.c' in place for inspection +(suppressing compilation to machine code), a -d option that enables verbose +parse reporting from the YACC parser, a -t option that requires strict +INTERCAL-72 compliance (rejecting COME FROM and the extensions for bases other +than two) and an -O option that enables the (hah!) optimizer. Invoking ick -? +prints a usage message. Other than that, yer on yer own. -One other switch affects C-intercal's runtime behavior. The `-C' +Another switch affects C-INTERCAL's runtime behavior. The `-C' option forces output in "clockface" mode, for superstitious users who believe writing "IV" upside-down offends IVPITER and would rather see IIII. -Report bugs, if you absolutely must, to the author. Or post them to -alt.lang.intercal. Or something. +Steve Swales added [+/-]help, [+/-]traditional, and [+/-]wimpmode options in +the 0.6 release. The help option (with either + or -) triggers a 'usage' +message. + +The +traditional option is presently a no-op. + +Steve writes: "The wimpmode option is the most interesting. I found myself +always running my test programs with filters on both ends to work around the +'nifty' intercal number representations. This was so painful that I decided it +would be LESS painful (and a lot less code) if I added a 'wimp' option. With +the +wimpmode option, the user is subjected to a humiliating message about what +a wimp he or she is to use this mode, but after that is allowed to use +conventional numerical notation. While such a mode doubtless violates to some +extent the INTERCAL philosophy, the fact that a 'unbutcher' command has been +posted clearly indicates the need for it. Anyway... if you don't like it, don't +use it... the default is -wimpmode (i.e. NOT wimp mode)." + + SPREADING THE BLAME + +The latest version of INTERCAL is kept available at the Retrocomputing Museun, +ftp:locke.ccil.org:pub/retro. + +There is, in addition, an occasionally active USENET newsgroup devoted to the +language: alt.lang.intercal. + + diff --git a/THEORY b/THEORY deleted file mode 100644 index f08b592..0000000 --- a/THEORY +++ /dev/null @@ -1,51 +0,0 @@ - INTERCAL IMPLEMENTOR'S NOTES - -This C-INTERCAL compiler is a very conventional implementation using YACC and -LEX. Each line of INTERCAL is translated into a C if()-then; the guard part -is used to implement abstentions and RESUMES, and the arm part translates the -`body' of the corresponding INTERCAL statement. - -The generated C code is plugged into the template file ick-wrapper.c inside -main(). It needs to be linked with cesspool.o, fiddle.o and lose.o. Cesspool.o -is the code that implements the storage manager; fiddle.o implements the -INTERCAL operators; and lose.o is the code that generates INTERCAL's error -messages. - -The abstain[] array in the generated C is used to track line and label -abstentions; if member i is on, the statement on line i is being abstained -from. Labels are mapped to line numbers in the code checker, just before -optimization. - -The gerund variables at the top of the template file are used to implement -gerund abstentions (ABSTAIN FROM CALCULATING etc). The guard part of each -generated C statement checks the appropriate variable. - -RESUMES are implemented by setting skipto to the location at which execution -is to resume, then jumping to the top of the program and skipping all the -guard/arm pairs before the proper NEXT. - -The parser builds an array of tuples, one for each INTERCAL statement. Most -tuples have node trees attached. Once all tuples have been generated, -the compile-time checker and optimizer phases can do consistency checks -and expression-tree rewrites. Finally, the tuples are ground out as C code -by the emit() function. - -The optimizer does constant folding for all five operators. It also checks -for the idiom for `test for nonzeroness'. - -Calculations are fully type-checked at compile time; they have to be because -(as I read the manual) the 16- and 32-bit versions of the unary ops do -different things. The only potential problem here is that the typechecker -has to assume that :m ~ :n has the type of :n (32-bit) even though the -result might fit in 16 bits. At run-time everything is calculated in 32 -bits. When INTERCAL-72 was designed 32 bits was expensive; now it's cheap. -Really, the only reason for retaining a 16-bit type at all is for the -irritation value of it (yes, C-INTERCAL *does* enforce the 16-bit limit -on constants). - -Note that the spectacular ugliness of INTERCAL syntax requires that the lexical -analyzer have two levels. One, embedded in the input() function, handles -logical-line continuation and the ! abbrev, and stashes each logical line away -in a buffer accessible to the code generator (this is necessary for the * -construct to be compiled correctly). The upper level is generated by lex(1) and -does normal tokenizing for YACC. diff --git a/cesspool.c b/cesspool.c deleted file mode 100644 index d817a28..0000000 --- a/cesspool.c +++ /dev/null @@ -1,408 +0,0 @@ -/* cesspool.c -- storage management and runtime support for INTERCAL */ -/* LINTLIBRARY */ -#include -#include "cesspool.h" -#include "lose.h" - -/********************************************************************** - * - * The following functions manipulate the nexting stack - * - *********************************************************************/ - -#define MAXNEXT 80 - -int next[MAXNEXT]; -int nextindex = 0; - -void pushnext(n) -int n; -{ - if (nextindex < MAXNEXT) - next[nextindex++] = n; - else - lose(lineno, E123); -} - -unsigned int popnext(n) -int n; -{ - nextindex -= n; - if (nextindex < 0) { - nextindex = 0; - return(-1); - } - return(next[nextindex]); -} - -unsigned int resume(n) -unsigned int n; -{ - if (n == 0) - lose(lineno, E621); - else if ((n = popnext(n)) == -1) - lose(lineno, E632); - else - return(n); -} - -/********************************************************************** - * - * The following functions implement the INTERCAL I/O model - * - *********************************************************************/ - -unsigned int pin(width) -int width; -{ - char buf[BUFSIZ], *cp, *strtok(); - unsigned int result = 0; - - if (fgets(buf, BUFSIZ, stdin) == (char *)NULL) - lose(lineno, E562); - buf[strlen(buf)-1] = '\0'; - - cp = strtok(buf, " "); - do { - int digit; - - if (strcmp(cp, "OH") == 0 || strcmp(cp, "ZERO") == 0) - digit = 0; - else if (strcmp(cp, "ONE") == 0) - digit = 1; - else if (strcmp(cp, "TWO") == 0) - digit = 2; - else if (strcmp(cp, "THREE") == 0) - digit = 3; - else if (strcmp(cp, "FOUR") == 0) - digit = 4; - else if (strcmp(cp, "FIVE") == 0) - digit = 5; - else if (strcmp(cp, "SIX") == 0) - digit = 6; - else if (strcmp(cp, "SEVEN") == 0) - digit = 7; - else if (strcmp(cp, "EIGHT") == 0) - digit = 8; - else if (strcmp(cp, "NINE") == 0 || strcmp(cp, "NINER") == 0) - digit = 9; - else - lose(lineno, E579); - - result = result * 10 + digit; - } while - (cp = strtok((char *)NULL, " ")); - - if (width == 16 && result > 0xffff) - lose(lineno, E579); - return(result); -} - -/********************************************************************** - * - * Butchered Roman numerals implemented by - * Michael Ernst, mernst@theory.lcs.mit.edu. May 7, 1990 - * - * The INTERCAL manual hints that 3999 should translate to MMMIM - * (compare MMMCMXCIX) without specifying what the translation is. - * That may be a typo; in any case, this implementation isn't that - * butchered. - * - *********************************************************************/ - -#define MAXDIGITS 10 /* max base 10 digits */ -#define MAXROMANS (MAXDIGITS*4+1) /* max chars in translation */ - -/* - * The first column tells how many of the succeeding columns are used. - * The other columns refer to the columns of br_equiv and br_overbar. - */ -static int br_trans[10][5] = -{ - {0, 0, 0, 0, 0}, - {1, 0, 0, 0, 0}, - {2, 0, 0, 0, 0}, - {3, 0, 0, 0, 0}, - {2, 1, 2, 0, 0}, /* or use {4, 0, 0, 0, 0} */ - {1, 2, 0, 0, 0}, - {2, 2, 1, 0, 0}, - {3, 2, 1, 1, 0}, - {4, 2, 1, 1, 1}, - {2, 1, 3, 0, 0} -}; - -/* - * butcher places in the string result the "butchered" Roman numeral for val. - * This string should be printed at the beginning of a line; it spans two - * lines and already contains newlines. - */ - -static void butcher(val, result) -unsigned long val; -char *result; -{ - int i, j; - int digitsig, digitval; - char res[MAXROMANS], ovb[MAXROMANS]; - - /* We need FOUR columns because of the odd way that M and I interact. */ - static char br_equiv[MAXDIGITS][4] = - { - {'I', 'I', 'V', 'X'}, {'X', 'X', 'L', 'C'}, - {'C', 'C', 'D', 'M'}, {'M', 'I', 'V', 'X'}, - {'X', 'X', 'L', 'C'}, {'C', 'C', 'D', 'M'}, - {'M', 'i', 'v', 'x'}, {'x', 'x', 'l', 'c'}, - {'c', 'c', 'd', 'm'}, {'m', 'i', 'v', 'x'}, - }; - - static char br_overbar[MAXDIGITS][4] = - { - {' ', ' ', ' ', ' '}, - {' ', ' ', ' ', ' '}, - {' ', ' ', ' ', ' '}, - {' ', '_', '_', '_'}, - {'_', '_', '_', '_'}, - {'_', '_', '_', '_'}, - {'_', ' ', ' ', ' '}, - {' ', ' ', ' ', ' '}, - {' ', ' ', ' ', ' '}, - {' ', '_', '_', '_'}, - }; - - if (val == 0) - (void) strcpy(result, "_\n \n"); - else - { - res[MAXROMANS-1] = 0; - ovb[MAXROMANS-1] = 0; - i = MAXROMANS-1; - - /* the significance of the current digit is 10 ** digitsig */ - for (digitsig = 0; (digitsig < MAXDIGITS) && (val > 0); digitsig++) - { - digitval = val % 10; - for (j = br_trans[digitval][0]; j > 0; j--) - { - /* printf("In j loop: %d %d\n", j, i); */ - res[--i] = br_equiv[digitsig][br_trans[digitval][j]]; - ovb[i] = br_overbar[digitsig][br_trans[digitval][j]]; - } - val = val / 10; - } - - j = i; - while (*result++ = ovb[j++]) - continue; - *--result = '\n'; - - j = i; - while (*++result = res[j++]) - continue; - *result++ = '\n'; - *result = '\0'; - } -} - -void clockface(mode) -/* enable or disable clockface mode (output IIII instead of IV) */ -bool mode; -{ - if (mode) - { - /* clockface mode */ - br_trans[4][0] = 4; - br_trans[4][1] = 0; - br_trans[4][2] = 0; - } - else - { - /* normal mode */ - br_trans[4][0] = 2; - br_trans[4][1] = 1; - br_trans[4][2] = 2; - } -} - -void pout(val) -/* output in `butchered' Roman numerals; see manual, part 4.4.13 */ -unsigned int val; -{ - char result[2*MAXROMANS+1]; - - butcher(val, result); - (void) puts(result); -} - -/********************************************************************** - * - * The following functions implement the INTERCAL array model - * - *********************************************************************/ - -/*VARARGS3*/ -unsigned int aget(type, index, dim) -/* return the value of the array location given by the 4th-nth args */ -unsigned int type, index; -int dim; -{ - /* - * The function may abort if no resize() has been executed for the - * array, or if any member of the tuple is zero. - */ -} - -/*VARARGS4*/ -void aput(value, type, index, dim) -/* set the value of an array location given by the 5th-nth args */ -unsigned int value, type, index; -int dim; -{ - /* - * The function may abort if no resize() has been executed for the - * array, or if any member of the tuple is zero. - */ -} - -/*VARARGS3*/ -void resize(type, index, dim) -/* resize an array to the shape of the 4th-nth args */ -unsigned int type, index; -int dim; -{ - /* - * The function may abort if any member of the tuple is zero. - * If the array being resized exists, it should preserve the contents - * of whatever sub-volume remains in the resized version. - */ -} - -static void arraycopy(type, index, target, source) -/* stash away an array variable's value */ -unsigned int type, index; -char **target, *source; -{ -} - -/********************************************************************** - * - * The following functions implement save/retrieve - * - * If you want a more sophisticated dynamic allocation strategy, - * go ahead and implement one! *I'm* sure not stopping you... - * - *********************************************************************/ - -#define MAXSAVE 100 - -typedef struct /* this is a save-stack element */ -{ - int type; /* variable type */ - int index; /* variable's index within the type */ - int depth; /* depth of stash */ - union /* the data itself */ - { - short onespot; - int twospot; - short *tail; - int *hybrid; - } save; -} -stashbox; - -static stashbox stashes[MAXSAVE]; - -void stashinit() -{ - memset(stashes, '\0', sizeof(stashes)); -} - -static stashbox *fetch(type, index) -/* restore the value of a variable from the save stack */ -unsigned int type, index; -{ - stashbox *sp, *tp = (stashbox *)NULL; - int depthfound = 0; - - for (sp = stashes; sp < stashes + MAXSAVE; sp++) - if (sp->type == type && sp->index == index && sp->depth > depthfound) - { - depthfound = sp->depth; - tp = sp; - } - - return(tp); -} - -void stash(type, index, from) -/* stash away the variable's value */ -char *from; -unsigned int type, index; -{ - stashbox *sp, *op = fetch(type, index); - - for (sp = stashes; sp < stashes + MAXSAVE; sp++) - if (sp->type == 0) - { - if (op) - sp->depth = op->depth + 1; - else - sp->depth = 0; - if (type == ONESPOT) - memcpy((char *)&sp->save.onespot, from,sizeof(unsigned short)); - else if (type == TWOSPOT) - memcpy((char *)&sp->save.twospot, from, sizeof(unsigned int)); - else if (type == TAIL) - arraycopy((char **)&sp->save.tail, from); - else if (type == HYBRID) - arraycopy((char **)&sp->save.hybrid, from); - return; - } - lose(E222); -} - -void retrieve(to, type, index) -char **to; -unsigned int type, index; -{ - stashbox *sp; - - if ((sp = fetch(type, index)) == (stashbox *)NULL) - lose(E436); - else - { - if (type == ONESPOT) - memcpy(to, (char *)&sp->save.onespot, sizeof(unsigned short)); - else if (type == TWOSPOT) - memcpy(to, (char *)&sp->save.twospot, sizeof(unsigned int)); - else if (type == TAIL) - { - free(to); /* free storage allocated for array copy */ - *to = (char *)&sp->save.tail; - } - else if (type == HYBRID) - { - free(to); /* free storage allocated for array copy */ - *to = (char *)&sp->save.hybrid; - } - sp->type = 0; /* mark this stashbox free */ - } -} - -/********************************************************************** - * - * The following function is used for random error generation - * - *********************************************************************/ - -unsigned int roll(n) -/* return TRUE on n% chance, FALSE otherwise */ -unsigned int n; -{ -#ifdef USG - return(lrand48() % 100 < n); -#else - return(rand() % 100 < n); -#endif /* UNIX */ -} - -/* cesspool.c ends here */ diff --git a/cesspool.h b/cesspool.h deleted file mode 100644 index 44251a4..0000000 --- a/cesspool.h +++ /dev/null @@ -1,18 +0,0 @@ -/* cesspool.h -- interface to INTERCAL storage manager and runtime support */ - -typedef int bool; -#define TRUE 1 -#define FALSE 0 - -extern unsigned int aget(), pin(), roll(), popnext(), resume(); -extern void pushnext(), resize(), stashinit(), stash(), retrieve(), aput(); -extern void clockface(), pout(); - -extern int lineno; - -#define ONESPOT 0 -#define TWOSPOT 1 -#define TAIL 2 -#define HYBRID 3 - -/* cesspool.h ends here */ diff --git a/doc/THEORY b/doc/THEORY new file mode 100644 index 0000000..2087f5c --- /dev/null +++ b/doc/THEORY @@ -0,0 +1,58 @@ + INTERCAL IMPLEMENTOR'S NOTES + by ESR + +The C-INTERCAL compiler has a very conventional implementation using YACC and +LEX. Each line of INTERCAL is translated into a C if()-then; the guard part +is used to implement abstentions and RESUMES, and the arm part translates the +`body' of the corresponding INTERCAL statement. + +The generated C code is plugged into the template file ick-wrap.c +inside main(). It needs to be linked with cesspool.o, fiddle.o and +lose.o (these are in libick.a, with the new routine, arrgghh.o). +Cesspool.o is the code that implements the storage manager; fiddle.o +implements the INTERCAL operators; and lose.o is the code that +generates INTERCAL's error messages. The routine arrgghh.o parses the +new command line arguments. + +The abstain[] array in the generated C is used to track line and label +abstentions; if member i is on, the statement on line i is being +abstained from. If gerund abstentions/reinstatements are present in +the code, a second array recording the type of each statement in +generated into the runtime, and used to ensure that these operations +are translated into abstention-guard changes on all appropriate line numbers. + +Labels are mapped to line numbers in the code checker, just before +optimization. + +RESUMES are implemented with a branch to a generated switch statement +that executes a goto to the appropriate label. + +The parser builds an array of tuples, one for each INTERCAL statement. Most +tuples have node trees attached. Once all tuples have been generated, +the compile-time checker and optimizer phases can do consistency checks +and expression-tree rewrites. Finally, the tuples are ground out as C code +by the emit() function. + +The optimizer does constant folding for all five operators. It also checks +for the idioms for `test for equality' and `test for nonzeroness'. + +Calculations are fully type-checked at compile time; they have to be because +(as I read the manual) the 16- and 32-bit versions of the unary ops do +different things. The only potential problem here is that the typechecker +has to assume that :m ~ :n has the type of :n (32-bit) even though the +result might fit in 16 bits. At run-time everything is calculated in 32 +bits. When INTERCAL-72 was designed 32 bits was expensive; now it's cheap. +Really, the only reason for retaining a 16-bit type at all is for the +irritation value of it (yes, C-INTERCAL *does* enforce the 16-bit limit +on constants). + +Note that the spectacular ugliness of INTERCAL syntax requires that +the lexical analyzer have two levels. One, embedded in the input() +function, handles the backquote and bang constructs, and stashes the +input line away in a buffer for the splat construct's benefit. The +upper level is generated by lex(1) and does normal tokenizing for YACC. + +Note that numeral tokens for input are defined in a symbol table (numerals.c) +that is directly included in the run-time library module (cesspool.c). This +avoids having to put the the size of the numerals array in an extern. To add +new numeral tokens, simply put them in the numerals initializer. diff --git a/doc/ick.txt b/doc/ick.txt new file mode 100644 index 0000000..6b2e864 --- /dev/null +++ b/doc/ick.txt @@ -0,0 +1,577 @@ + + + THE C-INTERCAL SUPPLEMENTAL REFERENCE MANUAL + + Version 0.7 by Louis Howell, 12/16/91 + Version 0.8 info by Eric S. Raymond, 01/18/92 + + +1. CONTRADICTION (with apologies to A. A. Milne) + +In which we attempt to justify the existence of this file to you, +the reader, who since you are reading the file have probably already +accepted, at least provisionally, its right to exist. + +1.1 JUSTIFICATION + +Verily it is written, "When a program is useful it must be changed, +when it is useless it must be documented." + +The intention is that, unlike the original manual, this file should +not be cast in stone, but rather should change to reflect later +additions or modifications to the language. Just keep it neat and +accurate, ok? + + +2. CONSTRUCTS FROM INTERCAL-72 + +In which we discuss the detailed behavior of some features that have +either changed from the original version of the language, or were not +completely specified in the original manual. + +2.1 SELECT + +The original manual defines the return type of a SELECT operation +to depend on the number of bits SELECTed. The present compiler +takes the easier route of defining the return type to be that of +the right operand, independent of its actual value. This form has +the advantage that all types can be determined at compile time. +Putting in run time type checking would add significant overhead and +complication, to effect a very minor change in language semantics. + +The only time this distinction makes any difference is when a +unary operator is applied to the SELECT result. This happens +extremely rarely in practice, the only known instance being the +32-bit greater-than test in the standard library, where an XOR +operator is applied to the result of SELECTing a number against +itself. The authors first SELECT the result against #65535$#65535 +to insure that XOR sees a 32-bit value. With the current compiler +this extra step is unnecessary, but harmless. + +The cautious programmer should write code that does not depend on +the compiler version being used. We therefore suggest the following +guideline for determining the SELECT return type: + + A SELECT operation with a 16-bit right operand returns a 16-bit + value. The return type of a SELECT operation with a 32-bit right + operand is undefined, but is guaranteed to be an acceptable input + to a MINGLE operation so long as 16 or fewer bits are actually + selected. Correct code should not depend on whether the return + type is 16 or 32 bits. + +2.2 IGNORE + +Though the manual states that the value of an IGNOREd variable cannot +change, it is unclear about whether or not a statement which appears +to change an IGNOREd variable is executed or not. This may appear to +be a "If a tree falls in the forest..." type of question, but if the +statement in question has other side effects it is not. + +Since another mechanism already exists for ABSTAINing from a +statement, we suggest that IGNORE only prevent the changing of the +specific variable in question, not the execution of the entire +statement. In the present version of the language this only makes +a difference for the WRITE IN statement. Attempting to WRITE IN +to an IGNOREd variable will cause a number to be read from the input, +which will be discarded since it cannot be stored in the variable. + +Various proposals to make assignment an operator, unlike the '=' +operator in C, would depend more heavily on this condition. It's +not clear whether such a feature is worth adding to the language, but +if it is it should be done right. + + +3. COME FROM + +In which we try to precisely define a statement that should never +have been born, but is nevertheless one of the more useful statements +in INTERCAL. + +3.1 BACKGROUND + +The earliest known description of the COME FROM statement in the computing +literature is in [R. L. Clark, "A linguistic contribution to GOTO-less +programming," Commun. ACM 27 (1984), pp. 349--350], part of the famous April +Fools issue of CACM. The subsequent rush by language designers to include the +statement in their languages was underwhelming, one might even say nonexistent. +Eric Raymond therefore decided that COME FROM would be an appropriate addition +to INTERCAL, and proceeded to implement it in his C-INTERCAL compiler. Louis +Howell tested the implementation by actually using it for the life2.i program +included in this distribution and fixed some bugs. + +3.2 DESCRIPTION + +There are two useful ways to visualize the action of the COME FROM +statement. The simpler is to see that it acts like a GOTO when the +program is traced backwards in time. More precisely, the statements + +(1) DO + . + . + . +(2) DO COME FROM (1) + +should be thought of as being equivalent to + +(1) DO +(2) DO GOTO (3) + . + . + . +(3) DO NOTHING + +if INTERCAL actually had a GOTO statement at all, which of course it +doesn't. + +What this boils down to is that the statement DO COME FROM (label), +anywhere in the program, places a kind of invisible trap door +immediately after statement (label). Execution or abstention of that +statement is immediately followed by an unconditional jump to the +COME FROM, unless the (label)ed statement is an executed NEXT, in which +case the jump occurs if the program attempts to RESUME back to that +NEXT statement. It is an error for more than one COME FROM to refer +to the same (label). + +Modification of the target statement by ABSTAIN or by the % qualifier +affects only that statement, not the subsequent jump. Such +modifications to the COME FROM itself, however, do affect the jump. +Encountering the COME FROM statement itself, rather than its target, +has no effect. + +In the current C-INTERCAL implementation, the compiler places a simple +label at the location of the COME FROM in the program, while all of the +machinery for checking for abstention and conditional execution and +actually performing the jump is placed immediately after the code for +the target statement. + + +4. OUTSIDE COMMUNICATION + +In which we try to remedy the fact that, due to I/O limitations, INTERCAL +can not even in principle perform the same tasks as other languages. It +is hoped that this addition will permit INTERCAL users to waste vast +quantities of computer time well into the 21st century. + +4.1 MOTIVATION + +One of the goals of INTERCAL was to provide a language which, though +different from all other languages, is nevertheless theoretically +capable of all the same tasks. The original version failed to +accomplish this because its I/O functions could not handle arbitrary +streams of bits, or even arbitrary sequences of characters. A +language which can't even send its input directly to its output +can hardly be considered as capable as other languages. + +4.2 TURING TEXT MODEL + +To remedy this problem, character I/O is now provided in a form based +on the "Turing Text" model, originally proposed by Jon Blow. The +INTERCAL programmer can access this capability by placing a one- +dimensional array in the list of items given to a WRITE IN or READ OUT +statement. On execution of the statement, the elements of the array +will, from first to last, be either loaded from the input or sent +to the output, as appropriate, in the manner described below. There +is currently no support for I/O involving higher-dimensional arrays, +but some form of graphics might be a possible 2-D interpretation. + +The heart of the Turing Text model is the idea of a continuous loop +of tape containing, in order, all the characters in the machine's +character set. When a character is received by the input routine, +the tape is advanced the appropriate number of spaces to bring +that character under the tape head, and the number of spaces the +tape was moved is the number that is actually seen by the INTERCAL +program. Another way to say this is that the number placed in an +INTERCAL array is the difference between the character just +received and the previous character, modulo the number of characters +in the machine character set. + +Output works in just the opposite fashion, except that the characters +being output come from the other side of the tape. From this position +the characters on the tape appear to be in reverse order, and are +individually backwards as well. (We would show you what it looks +like, but we don't have a font with backwards letters available. +Use your imagination.) The effect is that a number is taken out +of an INTERCAL array, subtracted from the last character output--- +i.e., the result of the last subtraction---and then sent on down +the output channel. The only catch is that the character as seen +by the INTERCAL program is the mirror-image of the character as +seen by the machine and the user. The bits of the character are +therefore taken in reverse order as it is sent to the output. +Note that this bit reversal affects only the character seen by +the outside world; it does not affect the character stored internally +by the program, from which the next output number will be subtracted. +All subtractions are done modulo the number of characters in the +character set. + +Two different tapes are used for input and for output to allow for +future expansion of the language to include multiple input and +output channels. Both tapes start at character 0 when a program +begins execution. On input, when an end of file marker is reached +the number placed in the array is one greater than the highest- +numbered character on the tape. + +4.3 EXAMPLE PROGRAM + +If all this seems terribly complicated, it should be made perfectly +clear by the following example program, which simply maps its input +to its output (like a simplified UN*X "cat"). It assumes that +characters are 8 bits long, but that's fine since the current version +of the compiler does too. Standard library routines for addition +and subtraction are not included here, as they are listed in the +original manual. + + DO ,1 <- #1 + DO .4 <- #0 + DO .5 <- #0 + DO COME FROM (30) + DO WRITE IN ,1 + DO .1 <- ,1SUB#1 + DO (10) NEXT + PLEASE GIVE UP +(20) PLEASE RESUME '?.1$#256'~'#256$#256' +(10) DO (20) NEXT + DO FORGET #1 + DO .2 <- .4 + DO (1000) NEXT + DO .4 <- .3~#255 + DO .3 <- !3~#15'$!3~#240' + DO .3 <- !3~#15'$!3~#240' + DO .2 <- !3~#15'$!3~#240' + DO .1 <- .5 + DO (1010) NEXT + DO .5 <- .2 + DO ,1SUB#1 <- .3 +(30) PLEASE READ OUT ,1 + +For each number received in the input array, the program first tests +the #256 bit to see if the end of file has been reached. If not, the +previous input character is subtracted off to obtain the current +input character. Then the order of the bits is reversed to find +out what character should be sent to the output, and the result +is subtracted from the last character sent. Finally, the difference +is placed in an array and given to a READ OUT statement. See? +We told you it was simple! + + +5. TriINTERCAL + +In which it is revealed that bitwise operations are too ordinary for +hard-core INTERCAL programmers, and extensions to other bases are +discussed. These are not, strictly speaking, extensions to INTERCAL +itself, but rather new dialects sharing most of the features of the +parent language. + +5.1 MOTIVATION + +INTERCAL is really a pretty sissy language. It tries hard to be +different, but when you get right down to its roots, what do you find? +You find bits, that's what. Plain old ones and zeroes, in groups of +16 and 32, just like every other language you've ever heard of. And +what operations can you perform on these bits? The INTERCAL operators +may arrange and permute them in weird and wonderful ways, but at the +bit level the operators are the same AND, OR and XOR you've seen +countless times before. + +Once the prospective INTERCAL programmer masters the unusual syntax, +she finds herself working with the familiar Boolean operators on +perfectly ordinary unsigned integer words. Even the constants she uses +are familiar. After all, who would not immediately recognize #65535 +and #32768? It may take a just a moment more to figure out #65280, +and #21845 and #43690 could be puzzles until she notices that they +sum to #65535, but basically she's still on her home turf. The 16-bit +limit on constants actually works in the programmer's favor by insuring +that very long anonymous constants can not appear in INTERCAL programs. +And this is in a language that is supposed to be different from any +other! + +5.2 ABANDON ALL HOPE... + +Standard INTERCAL is based on variables consisting of ordinary bits +and familiar Boolean operations on those bits. In pursuit of uniqueness, +it seems appropriate to provide a new dialect, otherwise identical to +INTERCAL, which instead uses variables consisting of trits, i.e. ternary +digits, and operators based on tritwise logical operations. This is +intended to be a separate dialect, rather than an extension to INTERCAL +itself, for a number of reasons. Doing it this way avoids word-length +conflicts, does not spoil the elegance of the Spartan INTERCAL operator +set, and dodges the objections of those who might feel it too great an +alteration to the original language. Primarily, though, giving INTERCAL +programmers the ability to switch numeric base at will amounts to +excessive functionality. So much better that a programmer choose a base +at the outset and then be forced to stick with it for the remainder of +the program. + +5.3 COMPILER OPERATION + +The same compiler, ick, supports both INTERCAL and TriINTERCAL. +This has the advantage that future bug fixes and additions to the +language not related to arithmetic immediately apply to both versions. +The compiler recognizes INTERCAL source files by the extension '.i', +and TriINTERCAL source files by the extension '.3i'. It's as simple +as that. There is no way to mix INTERCAL and TriINTERCAL source in +the same program, and it is not always possible to determine which +dialect a program is written in just by looking at the source code. + +5.4 DATA TYPES + +The two TriINTERCAL data types are 10-trit unsigned integers and +20-trit unsigned integers. All INTERCAL syntax for distinguishing +data types is ported to these new types in the obvious way. Small +words may contain numbers from #0 to #59048, large words may contain +numbers from #0$#0 to #59048$#59048. Errors are signaled for constants +greater than #59048 and for attempts to WRITE IN numbers too large +for a given variable or array element to hold. + +Note that though TriINTERCAL considers all numbers to be unsigned, +nothing prevents the programmer from implementing arithmetic operations +that treat their operands as signed. Three's complement is one obvious +choice, but balanced ternary notation is also a possibility. This +latter is a very pretty and symmetrical system in which all 2 trits +are treated as if they had the value -1. + +5.5 OPERATORS + +The TriINTERCAL operators are designed to inherit the relevant properties +of the standard INTERCAL operators, so that both can be considered as +merely different aspects of the same Platonic ideal. (Not that the word +"ideal" is ever particularly relevant when used in connection with +INTERCAL.) + +5.5.1 BINARY OPERATORS I + +The binary operators carry over from the original language with only +minor changes. The MINGLE operator ($) creates a 20-trit word by +alternating trits from its two 10-trit operands. The SELECT operator (~) +is a little more complicated, since the ternary tritmask may contain 0, 1, +and 2 trits. If we observe that the SELECT operation on binary operands +amounts to a bitwise AND and some rearrangement of bits, it seems +appropriate to base the SELECT for ternary operands on a tritwise AND in +the analogous fashion. We therefore postpone the definition of SELECT +until we know what a tritwise AND looks like. + +5.5.2 UNARY OPERATORS + +The unary operators in INTERCAL are all derived from the familiar +Boolean operations on single bits. To extend these operations to trits, +we first ask ourselves what the important properties of these operations +are that we wish to be preserved, then design the tritwise operators so +that they behave in a similar fashion. + +5.5.2.1 UNARY LOGICAL OPERATORS + +Let's start with AND and OR. To begin with, these can be considered +"choice" or "preference" operators, as they always return one of their +operands. AND can be described as wanting to return 0, but returning 1 +if it is given no other choice, i.e., if both operands are 1. Similarly, +OR wants to return 1 but returns 0 if that is its only choice. From +this it is immediately apparent that each operator has an identity +element that "always loses", and a dominator element that "always wins". + +AND and OR are commutative and associative, and each distributes +over the other. They are also symmetric with each other, in the sense +that AND looks like OR and OR looks like AND when the roles of 0 and 1 +are interchanged (De Morgan's Laws). This symmetry property seems to be +a key element to the idea that these are logical, rather than arithmetic, +operators. In a three-valued logic we would similarly expect a three- +way symmetry among the three values 0, 1 and 2 and the three operators +AND, OR and (of course) BUT. + +The following tritwise operations have all the desired properties: +OR returns the greater of its two operands. That is, it returns 2 if +it can get it, else it tries to return 1, and it returns 0 only if both +operands are 0. AND wants to return 0, will return 2 if it can't get +0, and returns 1 only if forced. BUT wants 1, will take 0, and tries +to avoid 2. The equivalents to De Morgan's Laws apply to rotations +of the three elements, e.g., 0 -> 1, 1 -> 2, 2 -> 0. Each operator +distributes over exactly one other operator, so the property +"X distributes over Y" is not transitive. The question of which way +this distributivity ring goes around is left as an exercise for the +student. + +In TriINTERCAL programs the '@' (whirlpool) symbol denotes the unary +tritwise BUT operation. You can think of the whirlpool as drawing +values preferentially towards the central value 1. Alternatively, +you can think of it as drawing your soul and your sanity inexorably +down... + +On the other hand, maybe it's best you NOT think of it that way. + +A few comments about how these operators can be used. OR acts like +a tritwise maximum operation. AND can be used with tritmasks. 0's +in a mask wipe out the corresponding elements in the other operand, +while 1's let the corresponding elements pass through unchanged. 2's +in a mask consolidate the values of nonzero elements, as both 1's and +2's in the other operand yield 2's in the output. BUT can be used to +create "partial tritmasks". 0's in a mask let BUT eliminate 2's from +the other operand while leaving other values unchanged. Of course, +the symmetry property guarantees that the operators don't really +behave differently from each other in any fundamental way; the apparent +differences come from the intuitive view that a 0 trit is "not set" +while a 1 or 2 trit is "set". + +5.5.2.1.1 BINARY OPERATORS II + +At this point we can define SELECT, since we now know what the +tritwise AND looks like. SELECT takes the binary tritwise AND of +its two operands. It shifts all the trits of the result corresponding +to 2's in the right operand over to the right (low) end of the result, +then follows them with all the output trits corresponding to 1's in +the right operand. Trits corresponding to 0's in the right operand, +which are all 0 anyway, occupy the remaining space at the left end of +the output word. Both 10-trit and 20-trit operands are accepted, +and are padded with zeroes on the left if necessary. The output +type is determined the same way as in standard INTERCAL. + +5.5.2.2 UNARY ARITHMETIC OPERATORS + +Now that we've got all that settled, what about XOR? This is +easily the most-useful of the three unary INTERCAL operators, +because it combines in one package the operations ADD WITHOUT CARRY, +SUBTRACT WITHOUT BORROW, BITWISE NOT-EQUAL, and BITWISE NOT. In +TriINTERCAL we can't have all of these in the same operator, since +addition and subtraction are no longer the same thing. The solution +is to split the XOR concept into two operators. The ADD WITHOUT CARRY +operation is represented by the new '^' (sharkfin) symbol, while the +old '?' symbol represents SUBTRACT WITHOUT BORROW. The reason for +this choice is so that '?' will also represent the TRITWISE NOT-EQUAL +operation. + +Note that '?', unlike the other four unary operators, is not +symmetrical. It should be thought of as rotating its operand one trit +to the right (with wraparound) and then subtracting off the trits of +the original number. These subtractions are done without borrowing, +i.e., trit-by-trit modulo 3. + +5.5.3 EXAMPLES + +The TriINTERCAL operators really aren't all that bad once you get +used to them. Let's look at a few examples to show how they can +be used in practice. In all of these examples the input value is +contained in the 10-trit variable .3. + +In INTERCAL, single-bit values often have to be converted from +{0,1} to {1,2} for use in RESUME statements. Examples of how to do +this appear in the original manual. In TriINTERCAL the expression +"^.3$#1"~#1 sends 0 -> 1 and 1 -> 2. If the 1-trit input value can +take on any of its three possible states, however, we will also have +to deal with the 2 case. The expression "V.3$#1"~#1 sends {0,1} -> 1 +and 2 -> 2. To test if a trit is set, we can use "V'"&.3$#2"~#1'$#1"~#1, +sending 0 -> 1 and {1,2} -> 2. To reverse the test we use +"?'"&.3$#2"~#1'$#1"~#1, sending 0 -> 2 and {1,2} -> 1. Note that we +have not been taking full advantage of the new SELECT operator. These +last two expressions can be simplified into "V!3~#2'$#1"~#1 and +"?!3~#2'$#1"~#1, which perform exactly the same mappings. Finally, if +we need a 3-way test, we can use "@'"^.3$#7"~#4'$#2"~#10, which +obviously sends 0 -> 1, 1 -> 2, and 2 -> 3. + +For an unrelated example, the expression "^.3$.3"~"#0$#29524" +converts all of the 1-trits of .3 into 2's and all of the 2-trits +into 1's. In balanced ternary, where 2-trits represent -1 values, +this is the negation operation. + +5.6 BEYOND TERNARY... + +While we're at it, we might as well extend this multiple bases +business a little farther. The ick compiler actually recognizes +filename suffixes of the form '.Ni', where N is any number from 2 +to 7. 2 of course gives standard INTERCAL, while 3 gives TriINTERCAL. +We cut off before 8 because octal notation is the smallest base used +to facilitate human-to-machine communication, and this seems quite +contrary to the basic principles behind INTERCAL. The small data +types hold 16 bits, 10 trits, 8 quarts, 6 quints, 6 sexts, or 5 septs, +and the large types are always twice this size. + +As for operators, '?' is always SUBTRACT WITHOUT BORROW, and '^' +is always ADD WITHOUT CARRY. 'V' is the OR operation and always +returns the max of its inputs. '&' is the AND operation, which chooses +0 if possible but otherwise returns the max of the inputs. '@' is BUT, +which prefers 1, then 0, then the max of the remaining possibilities. +Rather than add more special symbols forever, a numeric modifier may +be placed directly before the '@' symbol to indicate the operation +that prefers one of the digits not already represented. Thus in files +ending in '.5i', the permitted unary operators are '?', '^', '&', '@', +'2@', '3@', and 'V'. Use of such barbarisms as '0@' to represent '&' +are not permitted, nor is the use of '@' or '^' in files with either +of the extensions '.i' or '.2i'. Why not? You just can't, that's why. +Don't ask so many questions. + +As a closing example, we note that in balanced quinary notation, +where 3 means -2 and 4 means -1, the negation operation can be written +as either + + DO .1 <- "^'"^.3$.3"~"#0$#3906"'$'"^.3$.3"~"#0$#3906"'"~"#0$#3906" + +or as + + DO .1 <- "^.3$.3"~"#0$#3906" + DO .1 <- "^.1$.1"~"#0$#3906" + +These work because multiplication by -1 is the same as multiplication +by 4, modulo 5. + +Now go beat your head up against the wall for a while. + + +6. UNDOCUMENTED FEATURES FROM INTERCAL-72 + +A feature of INTERCAL-72 not documented in the manual was that it +required a certain level of politesse from the programmer. If fewer than +1/5th of the program statements included the PLEASE qualifier, the program +would be rejected as insufficiently polite. If more than 1/3rd of them +included PLEASE, the program would be rejected as excessively polite. + +This check has been implemented in C-INTERCAL. To assist programmers in +coping with it, the intercal.el mode included with the distribution randomly +expands "do " in entered source to "DO PLEASE" or "PLEASE DO" 1/4th of the +time. + + +7. AUTOMAGICAL INCLUSION OF THE SYSTEM LIBRARY + +The C-INTERCAL compiler will automatically include the system library if a DO +(1xxx) NEXT statement is used, and if no (1xxx) labels are defined anywhere, +where (1xxx) is a label in the 1000-1999 range, inclusive. This was not +an INTERCAL-72 feature. + + +8. MODIFIED INPUT BEHAVIOR + +The INTERCAL-72 implementation, instead of accepting an entire multiple-digit +number per line of input, expected one digit per *card image* (input line). +It is unclear how INTERCAL-72 programs ever managed to input more than one +number. + + +9. NEW ERROR MESSAGES IN C-INTERCAL + +The following error codes are new in C-INTERCAL. + +111 You tried to use a C-INTERCAL extension with the `traditional' flag on. + +127 Can't find syslib.i file when it's needed for magical inclusion. + +222 Out of stash space. + +333 Too many variables. + +444 A COME FROM statement references a non-existent line label. + +555 More than one COME FROM references the same label. + +666 Too many source lines. + +777 No such source file. + +888 Can't open C output file + +999 Can't open C skeleton file. + +998 Source file name with invalid extension (use .i or .[3-7]i). + +997 Illegal possession of a controlled unary operator. + + +9. END OF FILE + +Can't you read? Beat it! There's nothing left. Why don't you lie +down and take a stress pill? diff --git a/doc/intercal.ms b/doc/intercal.ms new file mode 100644 index 0000000..5d17587 --- /dev/null +++ b/doc/intercal.ms @@ -0,0 +1,1589 @@ +.ND +.ds vb V\v'-0.2'\h'-0.6'\-\v'0.2' +.TL +.sp 3 +THE INTERCAL PROGRAMMING LANGUAGE +.br +REFERENCE MANUAL +.AU +.sp 3 +Donald R. Woods +.br +and +.br +James M. Lyon +.AB no +.AE +.LP +.sp 20 +.ce 2 +\(co \fICopyright Donald R. Woods +and James M. Lyon 1973\fR +.ds CH INTERCAL +.bp +.NH 1 +INTRODUCTION +.LP +The names you are about to ignore are true. However, the story has been changed +significantly. Any resemblance of the programming language portrayed here +to other programming languages, living or dead, is purely coincidental. +.NH 2 +Origin and Purpose +.LP +The INTERCAL programming language was designed the morning of May 26, 1972 +by Donald R. Woods and James M. Lyon, at Princeton University. Exactly when +in the morning will become apparent in the course of this manual. It was +inspired by one ambition; to have a compiler language which has nothing at +all in common with any other major language. By 'major' was meant anything +with which the authors were at all familiar, e.g., FORTRAN, BASIC, COBOL, +ALGOL, SNOBOL, SPITBOL, FOCAL, SOLVE, TEACH, APL, LISP, and PL/I. For the +most part, INTERCAL has remained true to this goal, sharing only the basic +elements such as variables, arrays, and the ability to do I/O, and eschewing +all conventional operations other than the assignment statement (FORTRAN +"="). +.NH 2 +Acronym +.LP +The full name of the compiler is "Compiler Language With No Pronounceable +Acronym", which is, for obvious reasons, abbreviated "INTERCAL". +.NH 2 +Acknowledgments +.LP +The authors are deeply indebted to Eric M. Van and Daniel J. Warmenhoven, +without whose unwitting assistance this manual would still have been +possible. +.nr % 1 +.ds CH - % - +.NH 1 +FUNDAMENTAL CONCEPTS +.LP +In this section an attempt is made to describe how and why INTERCAL may be +used; i.e., what it is like and what it is good for. +.NH 2 +Sample Program +.LP +Shown below is a relatively simple INTERCAL program which will read in 32-bit +unsigned integers, treat them as signed, 2's-complement numbers, and print out +their absolute values. The program exits if the absolute value is zero. Note +in particular the inversion routine (statements 6 through 14), which could +be greatly simplified if the subroutine library (see section 5) were used. +.LP +A more detailed analysis of a program is made in section 6 of this manual. +.LP +.nf +.cs R 24 + DO (5) NEXT + (5) DO FORGET #1 + PLEASE WRITE IN :1 + DO .1 <- '\*(vb":1~'#32768\(ct#0'"\(ct#1'~#3 + DO (1) NEXT + DO :1 <- "'\*(vb":1~'#65535\(ct#0'"\(ct#65535' + ~'#0\(ct#65535'"\(ct"'\*(vb":1~'#0\(ct#65535'" + \(ct#65535'~'#0\(ct#65535'" + DO :2 <- #1 + PLEASE DO (4) NEXT + (4) DO FORGET #1 + DO .1 <- "\*(vb':1~:2'\(ct#1"~#3 + DO :1 <- "'\*(vb":1~'#65535\(ct#0'"\(ct":2~'#65535 + \(ct#0'"'~'#0\(ct#65535'"\(ct"'\*(vb":1~'#0 + \(ct#65535'"\(ct":2~'#65535\(ct#0'"'~'#0\(ct#65535'" + DO (1) NEXT + DO :2 <- ":2~'#0\(ct#65535'" + \(ct"'":2~'#65535\(ct#0'"\(ct#0'~'#32767\(ct#1'" + DO (4) NEXT + (2) DO RESUME .1 + (1) PLEASE DO (2) NEXT + PLEASE FORGET #1 + DO READ OUT :1 + PLEASE DO .1 <- '\*(vb"':1~:1'~#1"\(ct#1'~#3 + DO (3) NEXT + PLEASE DO (5) NEXT + (3) DO (2) NEXT + PLEASE GIVE UP +.cs R +.fi +.NH 2 +Uses for INTERCAL +.LP +INTERCAL's main advantage over other programming languages is its strict +simplicity. It has few capabilities, and thus there are few restrictions to +be kept in mind. Since it is an exceedingly easy language to learn, one +might expect it would be a good language for initiating novice programmers. +Perhaps surprising, than, is the fact that it would be more likely to +initiate a novice into a search for another line of work. As it turns out, +INTERCAL is more useful (which isn't saying much) as a challenge to +professional programmers. Those who doubt this need only refer back to the +sample program in section 2.1. This 22-statement program took somewhere +from 15 to 30 minutes to write, whereas the same objectives can be achieved +by single-statement programs in either SNOBOL; +.LP +.nf + PLEASE INPUT POS(0) ('-' ! '') + + (SPAN('0123456789') $ OUTPUT) + + *NE(OUTPUT) :S(PLEASE)F(END) +.fi +.LP +or APL; +.LP +.nf + [1] \(->0\(!=\(sq\(<-\(or\(sq +.fi +.LP +Admittedly, neither of these is likely to appear more intelligible to +anyone unfamiliar with the languages involved, but they took roughly 60 +seconds and 15 seconds, respectively, to write. Such is the overwhelming +power of INTERCAL! +.LP +The other major importance of INTERCAL lies in its seemingly inexhaustible +capacity for amazing one's fellow programmers, confounding programming shop +managers, winning friends, and influencing people. It is a well-known and +oft-demonstrated fact that a person whose work is incomprehensible is held +in high esteem. For example, if one were to state that the simplest way to +store a value of 65536 in a 32-bit INTERCAL variable is: +.IP + DO :1 <- #0\(ct#256 +.LP +any sensible programmer would say that that was absurd. Since this is +indeed the simplest method, the programmer would be made to look foolish in +front of his boss, who would of course happened to turn up, as bosses are +wont to do. The effect would be no less devastating for the programmer +having been correct. +.NH 1 +DESCRIPTION +.LP +The examples of INTERCAL programming which have appeared in the preceding +sections of this manual have probably seemed highly esoteric to the reader +unfamiliar with the language. With the aim of making them more so, we +present here a description of INTERCAL. +.NH 2 +Variables +.LP +INTERCAL allows only 2 different types of variables, the +.B "16-bit integer" +and the +.B "32-bit integer." +These are represented by a spot (.) or two-spot +(:), respectively, followed by any number between 1 and 65535, inclusive. +These variables may contain only non-negative numbers; thus they have the +respective ranges of values: 0 to 65535 and 0 to 4294967295. Note: .123 and +:123 are two distinct variables. On the other hand, .1 and .0001 are +identical. Furthermore, the latter may NOT be written as 1E-3. +.NH 2 +Constants +.LP +.B Constants +are 16-bit values only and may range from 0 to 65535. They are +prefixed by a mesh (#). Caution! Under no circumstances confuse the mesh +with the interleave operator, except under confusing circumstances! +.NH 2 +Arrays +.LP +.B Arrays +are represented by a tail (,) for 16-bit values, or a hybrid (;) for +32-bit values, followed by a number between 1 and 65535, inclusive. The +number is suffixed by the word SUB, followed by the subscripts, separated +optionally by spaces. Subscripts may be any expressions, including those +involving subscripted variables. This occasionally leads to ambiguous +constructions, which are resolved as discussed in section 3.4.3. Definition +of array dimensions will be discussed later in greater detail, since +discussing it in less detail would be difficult. As before, ,123 and ;123 +are distinct. In summary, .123, :123, #123, ,123, and :123 are all +distinct. +.NH 2 +Operators +.LP +INTERCAL recognizes 5 operators--2 binary and 3 unary. Please be kind to +our operators: they may not be very intelligent, but they're all we've got. +In a sense, all 5 operators are binary, as they are all bit-oriented, but +it is not our purpose here to quibble about bits of trivia. +.NH 3 +Binary Operators +.LP +The binary operators are \fBinterleave\fR (also called \fBmingle\fR) +and \fBselect\fR, which +are represented by a change (\(ct) and a sqiggle [sic] (~), respectively. +.LP +The interleave operator takes two 16-bit values and produces a 32-bit result +by alternating the bits of the operands. Thus, #65535\(ct#0 has the 32-bit +binary form 101010....10 or 2863311530 decimal, while #0\(ct#65535 = +0101....01 binary = 1431655765 decimal, and #255\(ct#255 is equivalent to +#65535. +.LP +The select operator takes from the first operand whichever bits correspond +to 1's in the second operand, and packs these bits to the right in the result. +Both operands are automatically padded on the left with zeros to 32 bits +before the selection takes place, so the variable types are unrestricted. +If more than 16 bits are selected, the result is a 32-bit value, otherwise +it is a 16-bit value. For example, #179~#201 (binary value 10110011~11001001) +selects from the first argument the 8th, 7th, 4th, and 1st from last bits, +namely, 1001, which = 9. But #201~#179 selects from binary 11001001 the 8th, +6th, 5th, 2nd, and 1st from last bits, giving 10001 = 17. #179~#179 has the +value 31, while #201~#201 has the value 15. +.LP +Perhaps a simpler way of understanding the operation of the select operator +would be to examine the logic diagram on the following page (Figure 1), which +performs the select operation upon two 8-bit values, A and B. The gates used +are Warmenhovian logic gates, which means the outputs have four possible +values: low, high, undefined (value of an uninitialized flip-flop), and +oscillating (output of a NOR gate with one input low and the other input +connected to the output). These values are represented symbolically +by '0', '1', '?', and '\(es'. +Note in particular that, while NOT-0 is 1 and NOT-1 +is 0 as in two-valued logic, NOT-? is ? and NOT-\(es is \(es. The functions +of the various gates are listed in Table 1. +.bp +.sp 20 +.ce 1 +Figure 1 goes here with above page number. +.bp +.sp 10 +.ps 8 +.vs 10 +.nf +.cs R 24 +.ds cp \(ci\v'-0.08'\h'-0.67'+\v'0.08' + __________________________________________________________ + |\e \e + | \e 1. Logic gate. Inputs A, B. Output O = AB. \e + | \e \e + | \e \e 2. Logic gate. Inputs A, B, C. Output O = A+BC. \e + | |\e \e \e + | | \e \e 3. Logic gate. Inputs A, B. Output O = A+AB. \e + | | \e \e \e + | | |\e \e 4. Logic gate. Inputs A, B. Output O = AB \*(cp -(A+-B) \e + | | | \e \e \e + | | | \e \e 5. Logic gate. Inputs A, B. Output O = A\*(cpA + AA \e + | | | \e \e \e + | | | \e \e 6. Uninitialized flip-flop. Inputs none. Output O = ? \e + | | | \e \e \e + | | | \e \e 7. Flip-flop-flap. Inputs A, B, C. Output O = 1 if \e + | | | \e \e A=0 or B+C=0 and A=1. O = 0 if AC=1, B=0. O = \(es if \e + | | | \e \e AB=1, C=0. O = ? if ABC=1. O as yet undetermined \e + | | | \e \e for other Warmenhovian inputs. See Figure 2. \e + | | | \e \e \e + | | | \e \e 8. Bus line. \e + | | | \e \e \e +.sp -1 + __________________________________________________________ + | | | \e | | + | | | | | _____________________________________________________ | + | | | | | | | | | | | | + | | | | | | | | | | | | + | | | | | | | | | | | | + | | | | | | | | | | | | + | | | | | | | | | | | | + \e|__| | | | \e|__| | | | + | | | | | | + | | | | | | + | | | | | | + | | | | | | + | | | | | | + | | | | | | + | | | | | | + | | | | | | + | | | | | | + | | | | | | + | | | | | | + | | | | | | + | | | | | | + | | | | | | + | | | | | | + | | | | | | + | | | | | | + | | | | | | + \e|__| \e|__| +.cs R +.fi +.ps 10 +.vs 12 +.sp +.ce 1 +Table 1. Logical (and other) functions. +.bp +.sp 20 +.ce 1 +Figure 2 goes here with above page number. +.bp +.sp 20 +.ce 1 +Rest of Figure 1 goes here with above page number. +.bp +.NH 3 +Unary Operators +.LP +The unary operators are & (logical \fBAND\fR), V (logical \fBOR\fR), +and \*(vb (logical +\fBXOR\fR). This last character is obtained by overpunching a worm (\-) on a V +(V). The operator is inserted between the spot, two-spot, mesh, or +what-have-you, and the integer, thus: .&123, #\*(vb123. Multiple unary +operators may not be concatenated, thus the form #\*(vb&123 is invalid. This +will be covered later when precedence is discussed. These operators perform +their respective logical operations on all pairs of adjacent bits, the +result from the first and last bits going into the first bit of the result. +The effect is that of rotating the operand one place to the right and +ANDing, ORing, or XORing with its initial value. Thus, #&77 (binary = +1001101) is binary 0000000000000100 = 4, #V77 is binary 1000000001101111 = +32879, and #\*(vb77 is binary 1000000001101011 = 32875. +.NH 3 +Precedence +.LP +Precedence of operators is as follows: +.sp 10 +(The remainder of this page intentionally left blank)\** +.FS +Keep in mind that the aim in designing INTERCAL was to have no +precedents. +.FE +.bp +.LP +This precedence (or lack thereof) may be overruled by grouping expressions +between pairs of sparks (') or rabbit-ears ("). Thus '#165\(ct#203'~#358 +(binary value '10100101\(ct11001011'~101100110) has the value 15, but +#165\(ct'#203~#358' has the value 34815, and #165\(ct#203~#358 is invalid +syntax and is completely valueless (except perhaps as an educational tool +to the programmer). A unary operator is applied to a sparked or rabbit-eared +expression by inserting the operator immediately following the opening spark +or ears. Thus, the invalid expression #\*(vb&123, +which was described earlier, +could be coded as '\*(vb#&123' or '\*(vb"{"'. +Note: In the interests of +simplifying the sometimes overly-complex form of expressions, INTERCAL allows +a spark-spot combination ('.) to be replaced with a wow (!). Thus '.1~.2' +is equivalent to !1~.2', and 'V.1\(ct.2' is equivalent to "V!1\(ct.2'". +.LP +Combining a rabbit-ears with a spot to form a rabbit (\o'".') is not permitted, +although the programmer is free to use it should he find an EBCDIC reader +which will properly translate a 12-3-7-8 punch. +.LP +Sparks and/or rabbit-ears must also be used to distinguish among such +otherwise ambiguous subscripted and multiply-subscripted expressions as: +.LP +.nf + ,1 SUB #1 ~ #2 + ,1 SUB ,2 SUB #1 #2 #3 + ,1 SUB " ,2 SUB " ,3 SUB #1 " #2 " " #3 " +.fi +.LP +The third case may be isolated into either of its possible interpretations +by simply changing some pairs of rabbit-ears to sparks, instead of adding +more ears (which would only confuse the issue further). Ambiguous cases are +defined as those for which the compiler being used finds a legitimate +interpretation which is different from that which the user had in mind. See +also section 8.1. +.NH 1 +STATEMENTS +.LP +In this section is described the format of INTERCAL statements. +.NH 2 +General Format +.LP +Statements may be entered in 'free format'. That is, more than one statement +may occur on a single card, and a statement may begin on one card and end +on a later one. Note that if this is done, all intervening cards and portions +thereof must be part of the same statement. That this restriction is necessary +is immediately apparent from the following example of what might occur if +statements could be interlaced. +.LP +.nf + DO .1 <- ".1\(ct'&:51~"#\*(vb1c!12~;&75SUB"\*(vb'V.1~ + DO .2 <- '"!1\(ct"&';\*(vb79SUB",&7SUB:173"'~!\*(vb9\(ct + .2'\(ct,&1SUB:5~#33578"'"'"~'#65535\(ct"\*(vb'V#&85'"' + #8196'"'~.1"\(ct.2'~'#&5\(ct"'#1279\(ct#4351'~#65535"' +.fi +.LP +The above statements are obviously meaningless. (For that matter, so are +the statements +.LP +.nf + DO .1 <- ".1\(ct"&:51~"#\*(vb1\(ct!12~;&75SUB"\*(vb'V.1~ + .2'\(ct,&1SUB:5~#333578"'"'"~#65535\(ct"\*(vb'V#&85'"' + DO .2 <- '"!1\(ct"&';\*(vb79SUB",&7SUB:173"'~!\*(vb9\(ct + #8196'"'~.1"\(ct.2'~'#&5\(ct"'#1279\(ct#4351'~#65535"' +.fi +.LP +but this is not of interest here.) +.LP +Spaces may be used freely to enhance program legibility (or at least reduce +program illegibility), with the restriction that no word of a statement +identifier (see section 4.3) may contain any spaces. +.NH 2 +Labels +.LP +A statement may begin with a +.B "logical line label" +enclosed in wax-wane pairs +(()). A statement may not have more than one label, although it is possible +to omit the label entirely. A line label is any integer from 1 to 65535, +which must be unique within each program. The user is cautioned, however, +that many line labels between 1000 and 1999 are used in the INTERCAL System +Library functions. +.NH 2 +Identifiers and Qualifiers +.LP +After the line label (if any), must follow one of the following statement +identifiers: DO, PLEASE, or PLEASE DO. These may be used interchangeably to +improve the aesthetics of the program. The identifier is then followed by +either, neither, or both of the following optional parameters (qualifiers): +(1) either of the character strings NOT or N'T, which causes the statement +to be automatically abstained from (see section 4.4.9) when execution +begins, and (2) a number between 0 and 100, preceded by a double-oh-seven +(%), which causes the statement to have only the specified percent chance +of being executed each time it is encountered in the course of execution. +.NH 2 +Statements +.LP +Following the qualifiers (or, if none are used, the identifier) must occur +one of the 13 valid operations. (Exception: see section 4.5.) These are +described individually in sections 4.4.1 through 4.4.13. +.NH 3 +Calculate +.LP +The INTERCAL equivalent of the half-mesh (=) in FORTRAN, BASIC, PL/I, and +others, is represented by an angle (<) followed by a worm (-). This +combination is read 'gets'. 32-bit variables may be assigned 16-bit values, +which are padded on the left with 16 zero bits. 16-bit variables may be +assigned 32-bit values only if the value is less than 65535. Thus, to +invert the least significant bit of the first element of 16-bit +2-dimensional array number 1, one could write: +.IP +,1SUB#1#1 <- '\*(vb,1SUB#1#1\(ct#1'~'#0\(ct#65535' +.LP +Similarly to SNOBOL and SPITBOL, INTERCAL uses the angle-worm to define the +dimensions of arrays. An example will probably best describe the format. +To define 32-bit array number 7 as 3-dimensional, the first dimension being +seven, the second being the current value of 16-bit variable number seven, +and the third being the current value of the seventh element of 16-bit array +number seven (which is one-dimensional) mingled with the last three bits of +32-bit variable number seven, one would write (just before they came to take +him away): +.IP +;7 <- #7 BY .7 BY ",7SUB#7"\(ct':7~#7' +.LP +This is, of course, different from the statement: +.IP +;7 <- #7 BY .7 BY ,7SUB"#7\(ct':7~#7'" +.LP +INTERCAL also permits the redefining of array dimensioning, which is done +the same way as is the initial dimensioning. All values of items in an array +are lost upon redimensioning, unless they have been STASHed (see section +4.4.5), in which case restoring them also restores the old dimensions. +.NH 3 +NEXT +.LP +The NEXT statement is used both for subroutine calls and for unconditional +transfers. This statement takes the form: +.IP +DO (label) NEXT +.LP +(or, of course, +.IP +PLEASE DO (label) NEXT +.LP +etc.), where (label) represents any logical line label which appears in the +program. The effect of such a statement is to transfer control to the +statement specified, and to store in a push down list (which is initially +empty) the location from which the transfer takes place. Items may be +removed from this list and may be discarded or used to return to the +statement immediately following the NEXT statement. These operations are +described in sections 4.4.3 and 4.4.4 respectively. The programmer is +generally advised to discard any stack entries which he does not intend to +utilize, since the stack has a maximum depth of 79 entries. A program's +attempting to initiate an 80th level of NEXTing will result on the fatal +error message, "PROGRAM HAS DISAPPEARED INTO THE BLACK LAGOON." +.NH 3 +FORGET +.LP +The statement PLEASE FORGET exp, where exp represents any expression +(except colloquial and facial expressions), causes the expression to be +evaluated, and the specified number of entries to be removed from the +NEXTing stack and discarded. An attempt to FORGET more levels of NEXTing +than are currently stacked will cause the stack to be emptied, and no error +condition is indicated. This is because the condition is not considered to +be an error. As described in section 4.4.2, it is good programming practice +to execute a DO FORGET #1 after using a NEXT statement as an unconditional +transfer, so that the stack does not get cluttered up with unused entries: +.LP +.nf +.cs R 24 + DO (123) NEXT + . + . + (123) DO FORGET #1 +.cs R +.fi +.NH 3 +RESUME +.LP +The statement PLEASE RESUME exp has the same effect as FORGET, except that +program control is returned to the statement immediately following the NEXT +statement which stored in the stack the last entry to be removed. Note that +a rough equivalent of the FORTRAN computed GO TO and BASIC ON exp GO TO is +performed by a sequence of the form: +.LP +.nf +.cs R 24 + DO (1) NEXT + . + . + (1) DO (2) NEXT + PLEASE FORGET #1 + . + . + (2) DO RESUME .1 +.cs R +.fi +.LP +Unlike the FORGET statement, an attempt to RESUME more levels of NEXTing than +been stacked will cause program termination. See also section 4.4.11. +.NH 3 +STASH +.LP +Since subroutines are not explicitly implemented in INTERCAL, the NEXT and +RESUME statements must be used to execute common routines. However, as +these routines might use the same variables as the main program, it is +necessary for them to save the values of any variables whose values they +alter, and later restore them. This process is simplified by the STASH +state ment, which has the form DO STASH list, where list represents a +string of one or more variable or array names, separated by intersections +(+). Thus +.IP +PLEASE STASH .123+:123+,123 +.LP +stashes the values of two variables and one entire array. The values are +left intact, and copies thereof are saved for later retrieval by (what else?) +the RETRIEVE statement (see section 4.4.6). It is not possible to STASH +single array items. +.NH 3 +RETRIEVE +.LP +PLEASE RETRIEVE list restores the previously STASHed values of the variables +and arrays named in the list. If a value has been stashed more than once, +the most recently STASHed values are RETRIEVEd, and a second RETRIEVE will +restore the second most recent values STASHed. Attempting to RETRIEVE a +value which has not been STASHed will result in the error message, "THROW +STICK BEFORE RETRIEVING." +.NH 3 +IGNORE +.LP +The statement DO IGNORE list causes all subsequent statements to have no +effect upon variables and/or arrays named in the list. Thus, for example, +after the sequence +.LP +.nf + DO .1 <- #1 + PLEASE IGNORE .1 + DO .1 <- #0 +.fi +.LP +16-bit variable number 1 would have the value 1, not 0. Inputting (see +section 4.4.12) into an IGNOREd variable also has no effect. The condition +is annulled via the REMEMBER statement (see section 4.4.8). Note that, when +a variable is being IGNOREd, its value, though immutable, is still +available for use in expressions and the like. +.NH 3 +REMEMBER +.LP +PLEASE REMEMBER list terminates the effect of the IGNORE statement for all +variables and/or arrays named in the list. It does not matter if a variable +has been IGNOREd more than once, nor is it an error if the variable has not +been IGNOREd at all. +.NH 3 +ABSTAIN +.LP +INTERCAL contains no simple equivalent to an IF statement or computed GO +TO, making it difficult to combine similar sections of code into a single +routine which occasionally skips around certain statements. The IGNORE +statement (see section 4.4.7) is helpful in some cases, but a more viable +method is often required. In keeping with the goal of INTERCAL having +nothing in common with any other language, this is made possible via the +ABSTAIN statement. +.LP +This statement takes on one of two forms. It may not take on both at any one +time. DO ABSTAIN FROM (label) causes the statement whose logical line label +is (label) to be abstained form. PLEASE ABSTAIN FROM gerund list causes all +statements of the specified type(s) to be abstained from, as in +.LP +.nf + PLEASE ABSTAIN FROM STASHING + PLEASE ABSTAIN FROM IGNORING + FORGETTING + PLEASE ABSTAIN FROM NEXTING + or PLEASE ABSTAIN FROM CALCULATING +.fi +.LP +Statements may also be automatically abstained from at the start of +execution via the NOT or N'T parameter (see section 4.3). +.LP +If, in the course of execution, a statement is encountered which is being +abstained from, it is ignored and control passes to the next statement in +the program (unless it, too, is being abstained from). +.LP +The statement DO ABSTAIN FROM ABSTAINING is perfectly valid, as is DO ABSTAIN +FROM REINSTATING (although this latter is not usually recommended). However, +the statement DO ABSTAIN FROM GIVING UP is not accepted, even though DON'T +GIVE UP is. +.NH 3 +REINSTATE +.LP +The REINSTATE statement, like the ABSTAIN, takes as an argument either a +line label or a gerund list. No other form of argument is permitted. For +example, the following is an invalid argument: +.LP +.nf + Given: x\(!=0, y\(!=0, Prove: x+y=0 + Since x\(!=0, then x+1\(!=1, x+a\(!=a, x+y\(!=y. + But what is y? y is anything but 0. + Thus x+y \(!= anything but 0. + Since x+y cannot equal anything but 0, x+y=0. + + Q.E.D. +.fi +.LP +REINSTATEment nullifies the effects of an abstention. Either form of +REINSTATEment can be used to "free" a statement, regardless of whether the +statement was abstained from by gerund list, line label, or NOT. Thus, +PLEASE REINSTATE REINSTATING is not necessarily an irrelevant statement, +since it might free a DON'T REINSTATE command or a REINSTATE the line label +of which was abstained from. However, DO REINSTATE GIVING UP is invalid, +and attempting to REINSTATE a GIVE UP statement by line label will have no +effect. Note that this insures that DON'T GIVE UP will always be a +"do-nothing" statement. +.NH 3 +GIVE UP +.LP +PLEASE GIVE UP is used to exit from a program. It has the effect of a PLEASE +RESUME #80. DON'T GIVE UP, as noted in section 4.4.10, is effectively a null +statement. +.NH 3 +Input +.LP +Input is accomplished with the statement DO WRITE IN list, where list +represents a string of variables and/or elements or arrays, separated by +intersections. Numbers are represented on cards, each number on a separate +card, by spelling out each digit (in English) and separating the digits +with one or more spaces. A zero (0) may be spelled as either ZERO or OH. +Thus the range of (32-bit) input values permissible extends from ZERO (or +OH) through FOUR TWO NINE FOUR NINE SIX SEVEN TWO NINE FIVE. +.LP +Attempting to write in a value greater than or equal to SIX FIVE FIVE three +six for a 16-bit variable will result in the error message, "DON'T BYTE OFF +MORE THAN YOU CAN CHEW." +.NH 3 +Output +.LP +Values may be output to the printer, one value per line, via the statement +DO READ OUT list, where the list contains variables, array elements, and/or +constants. Output is in the form of "extended" Roman numerals (also called +"butchered" Roman numerals), with an overline (\(rn) indicating the value below +is "times 1000", and lower-case letters indicating "times 1000000". Zero +is indicated by an overline with no character underneath. Thus, the range +of (32-bit) output values possible is from \(rn through +\o"i\(rn"\o"v\(rn"ccxciv\o"C\(rn"\o"M\(rn"\o"L\(rn"\o"X\(rn"\o"V\(rn"\o"I\(rn"\o"I\(rn"CCXCV. +Note: For values whose residues modulo 1000000 are less than 4000, M is +used to represent 1000; for values whose residues are 4000 or greater, +\o"I\(rn" is +used. Thus #3999 would read out as MMMIM while #4000 would read out as +\o"I\(rn"\o"V\(rn". +Similar rules apply to the use of \o"M\(rn" and i for 1000000, +and to that of m and \o"i\(rn" +for 1000000000. +.NH 2 +Comments +.LP +Unrecognizable statements, as noted in section 7, are flagged with a splat +(*) during compilation, and are not considered fatal errors unless they +are encountered during execution, at which time the statement (as input at +compilation time) is printed and execution is terminated. This allows for +an interesting (and, by necessity, unique) means of including comments in +an INTERCAL listing. For example, the statement: +.sp 1 +* PLEASE NOTE THAT THIS LINE HAS NO EFFECT +.LP +will be ignored during execution due to the inclusion of the NOT qualifier. +User-supplied error messages are also easy to implement: +.sp 1 +* DO SOMETHING ABOUT OVERFLOW IN ;3 +.LP +as are certain simple conditional errors: +.LP +.nf +.cs R 24 +* (123) DON'T YOU REALIZE THIS STATEMENT SHOULD ONLY BE ENCOUNTERED + ONCE? + PLEASE REINSTATE (123) +.cs R +.fi +.LP +This pair of statements will cause an error exit the second time they are +encountered. Caution!! The appearance of a statement identifier in an +intended comment will be taken as the beginning of a new statement. Thus, +the first example on the preceding page could not have been: +.sp 1 +* PLEASE NOTE THAT THIS LINE DOES NOTHING +.LP +The third example, however, is valid, despite the appearance of two cases +of D-space-O, since INTERCAL does not ignore extraneous spaces in statement +identifiers. +.bp +.NH 1 +SUBROUTINE LIBRARY +.LP +INTERCAL provides several built-in subroutines to which control can be +transferred to perform various operations. These operations include many +useful functions which are not easily representable in INTERCAL, such as +addition, subtraction, etc. +.NH 2 +Usage +.LP +In general, the operands are .1, .2, etc., or :1, :2, etc., and the result(s) +are stored in what would have been the next operand(s). For instance, one +routine adds .1 to .2 and store the sum in .3, with .4 being used to indicate +overflow. All variables not used for results are left unchanged. +.NH 2 +Available Functions +.LP +At the time of this writing, only the most fundamental operations are offered +in the library, as a more complete selection would require prohibitive time +and coree to implement. These functions, along with their corresponding entry +points (entered via DO (entry) NEXT) are listed below. +.LP +.nf +.cs R 24 + (1000) .3 <- .1 plus .2, error exit on overflow + (1009) .3 <- .1 plus .2 + .4 <- #1 if no overflow, else .4 <- #2 + (1010) .3 <- .1 minus .2, no action on overflow + (1020) .1 <- .1 plus #1, no action on overflow + (1030) .3 <- .1 times .2, error exit on overflow + (1039) .3 <- .1 times .2 + .4 <- #1 if no overflow, else .4 <- #2 + (1040) .3 <- .1 divided by .2 + .3 <- #0 if .2 is #0 + (1050) .2 <- :1 divided by .1, error exit on overflow + .2 <- #0 if .1 is #0 + + (1500) :3 <- :1 plus :2, error exit on overflow + (1509) :3 <- :1 plus :2 + :4 <- #1 if no overflow, else :4 <- #2 + (1510) :3 <- :1 minus :2, no action on overflow + (1520) :1 <- .1 concatenated with .2 + (1525) This subroutine is intended solely for internal + use within the subroutine library and is therefore + not described here. Its effect is to shift .3 + logically 8 bits to the left. + (1530) :1 <- .1 times .2 + (1540) :3 <- :1 times :2, error exit on overflow + (1549) :3 <- :1 times :2 + :4 <- #1 if no overflow, else :4 <- #2 + (1550) :3 <- :1 divided by :2 + :3 <- #0 if :2 is #0 + + (1900) .1 <- uniform random no. from #0 to #65535 + (1910) .2 <- normal random no. from #0 to .1, with + standard deviation .1 divided by #12 +.cs R +.fi +.bp +.NH 1 +PROGRAMMING HINTS +.LP +For the user looking to become more familiar with the INTERCAL language, we +present in this section an analysis of a complex program, as well as some +suggested projects for the ambitious programmer. +.LP +Considering the effort involved in writing an INTERCAL program, it was +decided in putting together this manual to use an already existing program +for instructive analysis. Since there was only one such program available, +we have proceeded to use it. It is known as the "INTERCAL System Library." +.NH 2 +Description +.LP +The program listing begins on the second page following. It is in the same +format as would be produced by the Princeton INTERCAL compiler in FORMAT +mode with WIDTH=62 (see section 8). For a description of the functions +performed by the Library, see section 5.2. +.NH 2 +Analysis +.LP +We shall not attempt to discuss here the algorithms used, but rather we +shall point out some of the general techniques applicable to a wide range +of problems. +.LP +Statements 10, 14, 15, and 26 make up a virtual "computed GO TO". When +statement 10 is executed, control passes eventually to statement 16 or 11, +depending on whether .5 contains #1 or #2, respectively. The value of .5 +is determined in statement 9, which demonstrates another handy technique. +To turn an expression, exp, with value #0 or #1, into #1 or #2 (for use in +a "GO TO"), use "\*(vb'exp'\(ct#1"~#3. +To reverse the condition (i.e., convert #0 +to #2 and leave #1 alone) use "\*(vb'exp'\(ct#2"~#3. +.LP +Certain conditions are easily checked. For example, to test for zero, +select the value from itself and select the bottom bit (see statement 54). +To test for all bits being 1's, select the value from itself and select the +top bit (see statement 261). The test for greater than, performed in +statements 192 and 193 on 32-bit values, employs binary logical operations, +which are performed as follows: +.IP +'\*(vb.1\(ct.2'~'#0\(ct#65535' +.LP +for 16-bit values or, for 32-bit values: +.LP +.nf + "'\*(vb":1~'#65535\(ct30'"\(ct":2~'#65535\(ct#0'"'~'#0 + \(ct#65535'"\(ct"'\*(vb":1~'#0\(ct#65535'"\(ct":2~'#0 + \(ct#65535'"'~'#0\(ct#65535'" +.fi +.LP +(The proofs are left as an exercise to the reader.) +.LP +Testing for greater-than with 16-bit values is somewhat simpler and is done +with the pair of statements: +.LP +.nf + DO .C <- '\*(vb.Ac.B'~'#0\(ct#65535' + DO .C <- '&"'.A~.C'~'"\*(vb'\*(vb.C~.C'\(ct#32768" + ~"#0\(ct#65535"'"\(ct".C~.C"'~#1 +.fi +.LP +This sets .C (a dummy variable) to #1 if .A > .B, and #0 otherwise. The +expression may be expanded as described above to instead set .C to #1 or +#2. +.LP +Note also in statement 220 the occurrence of ~"#65535\(ct#65535". Although +these operations select the entire value, they are not extraneous, as they +ensure that the forthcoming \*(vbs will be operating on 32-bit values. +.LP +In several virtual computed GO TOs the DO FORGET #1 (statement 15 in the +earlier example) has been omitted, since the next transfer of control would +be a DO RESUME #1. By making this a DO RESUME #2 instead, the FORGET may +be forgotten. +.LP +In statement 64, note that .2 is STASHed twice by a single statement. This +is perfectly legal. +.LP +Lastly, note in statements 243 and 214 respectively, expressions for +shifting 16- and 32-bit variables logically one place to the left. +Statement 231 demonstrates right-shifting for 32-bit variables. +.bp +.NH 2 +Program Listing +.LP +.nf +.cs R 24 + 1 (1000) PLEASE IGNORE .4 + 2 PLEASE ABSTAIN FROM (1005) + 3 (1009) DO STASH .1 + .2 + .5 + .6 + 4 DO .4 <- #1 + 5 DO (1004) NEXT + 6 (1004) PLEASE FORGET #1 + 7 DO .3 <- '\*(vb.1\(ct.2'~'#0\(ct#65535' + 8 DO .6 <- '&.1\(ct.2'~'#0\(ct#65535' + 9 PLEASE DO .5 <- "\*(vb!6~#32768'\(ct#1"~#3 + 10 DO (1002) NEXT + 11 DO .4 <- #2 + 12 (1005) DO (1006) NEXT +* 13 (1999) DOUBLE OR SINGLE PRECISION OVERFLOW + 14 (1002) DO (1001) NEXT + 15 (1006) PLEASE FORGET #1 + 16 DO .5 <- '\*(vb"!6~.6'~#1"\(ct#1'~#3 + 17 DO (1003) NEXT + 18 DO .1 <- .3 + 19 DO .2 <- !6\(ct#0'~'#32767\(ct#1' + 20 DO (1004) NEXT + 21 (1003) DO (1001) NEXT + 22 DO REINSTATE (1005) + 23 (1007) PLEASE RETRIEVE .1 + .2 + .5 + .6 + 24 DO REMEMBER .4 + 25 PLEASE RESUME #2 + 26 (1001) DO RESUME .5 + 27 (1010) DO STASH .1 + .2 + .4 + 28 DO .4 <- .1 + 29 DO .1 <- '\*(vb.2\(ct#65535'~'#0\(ct#65535' + 30 DO (1020) NEXT + 31 PLEASE DO .2 <- .4 + 32 PLEASE DO (1009) NEXT + 33 DO RETRIEVE .1 + .2 + .4 + 34 PLEASE RESUME #1 + 35 (1020) DO STASH .2 + .3 + 36 DO .2 <- #1 + 37 PLEASE DO (1021) NEXT + 38 (1021) DO FORGET #1 + 39 DO .3 <- "\*(vb!1~.2'\(ct#1"~#3 + 40 PLEASE DO .1 <- '\*(vb.1\(ct.2'~'#0\(ct#65535' + 41 DO (1022) NEXT + 42 DO .2 <- !2\(ct#0'~'#32767\(ct#1' + 43 DO (1021) NEXT + 44 (1023) PLEASE RESUME .3 + 45 (1022) DO (1023) NEXT + 46 PLEASE RETRIEVE .2 + .3 + 47 PLEASE RESUME #2 + 48 (1030) DO ABSTAIN FROM (1033) + 49 PLEASE ABSTAIN FROM (1032) + 50 (1039) DO STASH :1 + .5 + 51 DO (1530) NEXT + 52 DO .3 <- :1~#65535 + 53 PLEASE DO .5 <- :1~'#65280\(ct#65280' + 54 DO .5 <- '\*(vb"!5~.5'~#1"\(ct#1'~#3 + 55 DO (1031) NEXT + 56 (1032) DO (1033) NEXT + 57 DO (1999) NEXT + 58 (1031) DO (1001) NEXT + 59 (1033) DO .4 <- .5 + 60 DO REINSTATE (1032) + 61 PLEASE REINSTATE (1033) + 62 DO RETRIEVE :1 + .5 + 63 PLEASE RESUME #2 + 64 (1040) PLEASE STASH .1 + .2 + .2 + :1 + :2 + :3 + 65 DO .2 <- #0 + 66 DO (1520) NEXT + 67 DO STASH :1 + 68 PLEASE RETRIEVE .2 + 69 DO .1 <- .2 + 70 DO .2 <- #0 + 71 PLEASE DO (1520) NEXT + 72 DO :2 <- :1 + 73 DO RETRIEVE .1 + .2 + :1 + 74 DO (1550) NEXT + 75 PLEASE DO .3 <- :3 + 76 DO RETRIEVE :1 + :2 + :3 + 77 DO RESUME #1 + 78 (1050) PLEASE STASH :2 + :3 + .5 + 79 DO :2 <- .1 + 80 PLEASE DO (1550) NEXT + 81 DO .5 <- :3~'#65280\(ct#65280' + 82 DO .5 <- '\*(vb"!5~.5'~#1"\(ct#1'~#3 + 83 DO (1051) NEXT + 84 DO (1999) NEXT + 85 (1051) DO (1001) NEXT + 86 DO .2 <- :3 + 87 PLEASE RETRIEVE :2 + :3 + .5 + 88 DO RESUME #2 + 89 (1500) PLEASE ABSTAIN FROM (1502) + 90 PLEASE ABSTAIN FROM (1506) + 91 (1509) PLEASE STASH :1 + .1 + .2 + .3 + .4 + .5 + .6 + 92 DO .1 <- :1~#65535 + 93 PLEASE DO .2 <- :2~#65535 + 94 DO (1009) NEXT + 95 DO .5 <- .3 + 96 PLEASE DO .6 <- .4 + 97 DO .1 <- :1~'#65280\(ct#65280' + 98 DO .2 <- :2~'#65280\(ct#65280' + 99 DO (1009) NEXT + 100 DO .1 <- .3 + 101 PLEASE DO (1503) NEXT + 102 DO .6 <- .4 + 103 DO .2 <- #1 + 104 DO (1009) NEXT + 105 DO .1 <- .3 + 106 DO (1501) NEXT + 107 (1504) PLEASE RESUME .6 + 108 (1503) DO (1504) NEXT + 109 (1501) DO .2 <- .5 + 110 DO .5 <- '\*(vb"'&.6\(ct.4'~#1"\(ct#2'~#3 + 111 DO (1505) NEXT + 112 (1506) DO (1502) NEXT + 113 PLEASE DO (1999) NEXT + 114 (1505) DO (1001) NEXT + 115 (1502) DO :4 <- .5 + 116 DO (1520) NEXT + 117 DO :3 <- :1 + 118 PLEASE RETRIEVE :1 + .1 + .2 + .3 + .4 + .5 + .6 + 119 DO REINSTATE (1502) + 120 DO REINSTATE (1506) + 121 PLEASE RESUME #3 + 122 (1510) DO STASH :1 + :2 + :4 + 123 DO :1 <- "'\*(vb":2~'#65535\(ct#0'"\(ct#65535'~'#0\(ct#6553 + 5'"\(ct"'\*(vb":2~'#0\(ct#65535'"\(ct#65535'~'#0\(ct#65535 + '" + 124 DO :2 <- #1 + 125 DO (1509) NEXT + 126 PLEASE RETRIEVE :1 + 127 DO :2 <- :3 + 128 PLEASE DO (1509) NEXT + 129 DO RETRIEVE :2 + :4 + 130 PLEASE RESUME #1 + 131 (1520) PLEASE STASH .3 + .4 + 132 DO .3 <- .1~#43690 + 133 DO (1525) NEXT + 134 PLEASE DO .4 <- 'V.3\(ct".2~#43690"'~'#0\(ct#65535' + 135 DO .3 <- .1~#21845 + 136 PLEASE DO (1525) NEXT + 137 DO :1 <- .4\(ct"'V.3\(ct".2~#21845"'~'#0\(ct#65535'" + 138 PLEASE RETRIEVE .3 + .4 + 139 DO RESUME #1 + 140 (1525) DO .3 <- '"'"'"!3\(ct#0'~'#32767\(ct#1'"\(ct#0'~'#32767 + \(ct#1'"\(ct#0'~'#16383\(ct#3'"\(ct#0'~'#4095\(ct#15' + 141 PLEASE RESUME #1 + 142 (1530) DO STASH :2 + :3 + .3 + .5 + 143 DO :1 <- #0 + 144 DO :2 <- .2 + 145 DO .3 <- #1 + 146 DO (1535) NEXT + 147 (1535) PLEASE FORGET #1 + 148 DO .5 <- "\*(vb!1~.3'\(ct#1"~#3 + 149 DO (1531) NEXT + 150 DO (1500) NEXT + 151 DO :1 <- :3 + 152 PLEASE DO (1533) NEXT + 153 (1531) PLEASE DO (1001) NEXT + 154 (1533) DO FORGET #1 + 155 DO .3 <- !3\(ct#0'~'#32767\(ct#1' + 156 DO :2 <- ":2~'#0\(ct#65535'"\(ct"'":2~'#32767\(ct#0'"\(ct# + 0'~'#32767\(ct#1'" + 157 PLEASE DO .5 <- "\*(vb!3~.3'\(ct#1"~#3 + 158 DO (1532) NEXT + 159 DO (1535) NEXT + 160 (1532) DO (1001) NEXT + 161 PLEASE RETRIEVE :2 + :3 + .3 + .5 + 162 DO RESUME #2 + 163 (1540) PLEASE ABSTAIN FROM (1541) + 164 DO ABSTAIN FROM (1542) + 165 (1549) PLEASE STASH :1 + :2 + :4 + :5 + .1 + .2 + .5 + 166 DO .1 <- :1~#65535 + 167 PLEASE DO .2 <- :2~'#65280\(ct#65280' + 168 DO .5 <- :1~'#65280\(ct#65280' + 169 DO (1530) NEXT + 170 DO :3 <- :1 + 171 DO .2 <- :2~#65535 + 172 PLEASE DO (1530) NEXT + 173 DO :5 <- :1 + 174 DO .1 <- .5 + 175 DO (1530) NEXT + 176 DO :4 <- :1 + 177 PLEASE DO :1 <- ":3~'#65280\(ct#65280'"\(ct":5~'#652 + 80\(ct#65280'" + 178 DO .5 <- ':1~:1'~#1 + 179 DO .2 <- :2~'#65280\(ct#65280' + 180 DO (1530) NEXT + 181 PLEASE DO .5 <- '"':1~:1'~#1"\(ct.5'~#3 + 182 DO .1 <- :3~#65535 + 183 DO .2 <- #0 + 184 DO (1520) NEXT + 185 PLEASE DO :2 <- :1 + 186 PLEASE DO .1 <- :4~#65535 + 187 DO (1520) NEXT + 188 DO (1509) NEXT + 189 DO .5 <- !5\(ct":4~#3"'~#15 + 190 DO :1 <- :3 + 191 DO :2 <- :5 + 192 DO (1509) NEXT + 193 PLEASE DO .5 <- !5\(ct":4~#3"'~#63 + 194 DO .5 <- '\*(vb"!5~.5'~#1"\(ct#1'~#3 + 195 PLEASE RETRIEVE :4 + 196 (1541) DO :4 <- .5 + 197 DO (1543) NEXT + 198 (1542) DO (1544) NEXT + 199 PLEASE DO (1999) NEXT + 200 (1543) DO (1001) NEXT + 201 (1544) DO REINSTATE (1541) + 202 PLEASE REINSTATE (1542) + 203 PLEASE RETRIEVE :1 + :2 + :5 + .1 + .2 + .5 + 204 DO RESUME #2 + 205 (1550) DO STASH :1 + :4 + :5 + .5 + 206 DO :3 <- #0 + 207 DO .5 <- '\*(vb"':2~:2'~#1"\(ct#1'~#3 + 208 PLEASE DO (1551) NEXT + 209 DO :4 <- #1 + 210 PLEASE DO (1553) NEXT + 211 (1553) DO FORGET #1 + 212 DO .5 <- '\*(vb":2~'#32768\(ct#0'"\(ct#2'~#3 + 213 DO (1552) NEXT + 214 DO :2 <- ":2~'#0\(ct#65535'"\(ct"'":2~'#32767\(ct#0'"\(ct# + 0'~'#32767\(ct#1'" + 215 PLEASE DO :4 <- ":4~'#0\(ct#65535'"\(ct"'":4~'#32767 + \(ct#0'"\(ct#0'~'#32767\(ct#1'" + 216 DO (1553) NEXT + 217 (1552) DO (1001) NEXT + 218 (1556) PLEASE FORGET #1 + 219 DO :5 <- "'\*(vb":1~'#65535\(ct#0'"\(ct":2~'#65535\(ct#0'"' + ~'#0\(ct#65535'"\(ct"'\*(vb":1~'#0\(ct#65535'"\(ct":2~'#0\(ct + #65535'"'~'#0\(ct#65535'" + 220 DO .5 <- '\*(vb"'&"':2~:5'~'"'\*(vb"'\*(vb":5~:5"~"#65535~ + #65535"'~'#65535\(ct#0'"\(ct#32768'~'#0\(ct#65535'" + \(ct"'\*(vb":5~:5"~"#65535\(ct#65535"'~'#0\(ct#65535'"' + "\(ct"':5~:5'~#1"'~#1"\(ct#2'~#3 + 221 DO (1554) NEXT + 222 DO :5 <- :3 + 223 DO (1510) NEXT + 224 PLEASE DO :1 <- :3 + 225 DO :3 <- "'V":4~'#65535\(ct#0'"\(ct":5~'#65535\(ct#0'"' + ~'#0\(ct#65535'"\(ct"'V":4~'#0\(ct#65535'"\(ct":5~'#0\(ct + #65535'"'~'#0\(ct#65535'" + 226 DO (1555) NEXT + 227 (1554) PLEASE DO (1001) NEXT + 228 (1555) DO FORGET #1 + 229 DO .5 <- "\*(vb':4~#1'\(ct#2"~#3 + 230 DO (1551) NEXT + 231 DO :2 <- ":2~'#0\(ct#65534'"\(ct":2~'#65535\(ct#0'" + 232 DO :4 <- ":4~'#0\(ct#65534'"\(ct":4~'#65535\(ct#0'" + 233 PLEASE DO (1556) NEXT + 234 (1551) DO (1001) NEXT + 235 PLEASE RETRIEVE :1 + :4 + :5 + .5 + 236 PLEASE RESUME #2 + 237 (1900) DO STASH .2 + .3 + .5 + 238 DO .1 <- #0 + 239 DO .2 <- #1 + 240 PLEASE DO (1901) NEXT + 241 (1901) DO FORGET #1 + 242 DO %50 .1 <- 'V.1\(ct.2'~'#0\(ct#65535' + 243 DO .2 <- !2\(ct#0'~'#32767\(ct#1' + 244 PLEASE DO .5 <- "\*(vb!2~.2'\(ct#1"~#3 + 245 DO (1902) NEXT + 246 DO (1901) NEXT + 247 (1902) DO (1001) NEXT + 248 DO RETRIEVE .2 + .3 + .5 + 249 PLEASE RESUME #2 + 250 (1910) PLEASE STASH .1 + .3 + .5 + :1 + :2 + :3 + 251 DO .3 <- #65524 + 252 DO :1 <- #6 + 253 DO (1911) NEXT +* 254 PLEASE NOTE THAT YOU CAN'T GET THERE FROM HERE + 255 (1912) DO (1001) NEXT + 256 (1911) DO FORGET #1 + 257 PLEASE DO (1900) NEXT + 258 DO :2 <- .1 + 259 DO (1500) NEXT + 260 PLEASE DO :1 <- :3 + 261 DO .1 <- .3 + 262 DO (1020) NEXT + 263 PLEASE DO .3 <- .1 + 264 DO .5 <- '\*(vb"!3~.3'~#1"\(ct#2'~#3 + 265 DO (1912) NEXT + 266 DO .1 <- #12 + 267 PLEASE DO (1050) NEXT + 268 DO RETRIEVE .1 + 269 DO (1530) NEXT + 270 DO :2 <- #32768 + 271 DO (1500) NEXT + 272 PLEASE DO .2 <- :3~'#65280\(ct#65280' + 273 PLEASE RETRIEVE .3 + .5 + :1 + :2 + :3 + 274 DO RESUME #1 +.cs R +.fi +.bp +.NH 2 +Programming Suggestions +.LP +For the novice INTERCAL programmer, we provide here a list of suggested +INTERCAL programming projects: +.LP +Write an integer exponentiation subroutine. :1 <- .1 raised to the .2 power. +.LP +Write a double-precision sorting subroutine. Given 32-bit array ;1 of size +:1, sort the contents into numerically increasing order, leaving the results +in ;1. +.LP +Generate a table of prime numbers. +.LP +Put together a floating-point library, using 32-bit variables to represent +floating-point numbers (let the upper half be the mantissa and the lower +half be the characteristic). The library should be capable of performing +floating-point addition, subtraction, multiplication, and division, as well +as the natural logarithm function. +.LP +Program a Fast Fourier Transform (FFT). This project would probably entail +the writing of the floating-point library as well as sine and cosine functions. +.LP +Calculate, to :1 places, the value of pi. +.bp +.NH 1 +ERROR MESSAGES +.LP +Due to INTERCAL's implementation of comment lines (see section 4.5), most +error messages are produced during execution instead of during compilation. +All errors except those not causing immediate termination of program execution +are treated as fatal. +.NH 2 +Format +.LP +All error messages appear in the following form: +.LP +.nf + ICLnnnI (error message) + ON THE WAY TO STATEMENT nnnn + CORRECT SOURCE AND RESUBMIT +.fi +.LP +The message varies depending upon the error involved. For undecodable +statements the message is the statement itself. The second line tells +which statement would have been executed next had the error not occurred. +Note that if the error is due to 80 attempted levels of NEXTing, the +statement which would have been executed next need not be anywhere near the +statement causing the error. +.NH 2 +Messages +.LP +Brief descriptions of the different error types are listed below according +to message number. +.IP 000 +An undecodable statement has been encountered in the course of +execution. Note that keypunching errors can be slightly disastrous, +since if 'FORGET' were misspelled F-O-R-G-E-R, the results would +probably not be those desired. Extreme misspellings may have even +more surprising consequences. For example, misspelling 'FORGET' +R-E-S-U-M-E could have drastic results. +.IP 017 +An expression contains a syntax error. +.IP 079 +Improper use has been made of statement identifiers. +.IP 099 +Improper use has been made of statement identifiers. +.IP 123 +Program has attempted 80 levels of NEXTing. +.IP 129 +Program has attempted to transfer to a non-existent line label. +.IP 139 +An ABSTAIN or REINSTATE statement references a non-existent line label. +.IP 182 +A line label has been multiply defined. +.IP 197 +An invalid line label has been encountered. +.IP 200 +An expression involves an unidentified variable. +.IP 240 +An attempt has been made to give an array a dimension of zero. +.IP 241 +Invalid dimensioning information was supplied in defining or using +an array. +.IP 275 +A 32-bit value has been assigned to a 16-bit variable. +.IP 436 +A retrieval has been attempted for an unSTASHed value. +.IP 533 +A WRITE IN statement or interleave (\(ct) operation has produced a +value requiring over 32 bits to represent. +.IP 562 +Insufficient data. +.IP 579 +Input data is invalid. +.IP 621 +The expression of a RESUME statement evaluated to #0. +.IP 632 +Program execution was terminated via a RESUME statement instead of +GIVE UP. +.IP 633 +Execution has passed beyond the last statement of the program. +.IP 774 +A compiler error has occurred (see section 8.1). +.IP 778 +An unexplainable compiler error has occurred (see J. Lyon or D. Woods). +.NH 1 +JCL +.LP +The information contained in the following section applies +only to the Princeton compiler, run under OS/360. +.NH 2 +The Princeton Compiler +.LP +The Princeton compiler, written in SPITBOL (a variant of +SNOBOL), performs the compilation in two stages. First the +INTERCAL source is converted into SPITBOL source, then the +latter is compiled and executed. +.LP +It should be noted that the Princeton compiler fails to +properly interpret certain multiply-subscripted expressions, +such as: +.sp +.IP +",1SUB",2SUB#1"#2" +.sp +.LP +This is not a "bug". Being documented, it is merely a +"restriction". Such cases may be resolved by alternating +sparks and ears in various levels of expression nesting: +.sp +.IP +",1SUB',2SUB#1'#2" +.sp +.LP +which is advisable in any case, since INTERCAL expressions +are unreadable enough as is. +.LP +Since there is currently no catalogued procedure for +invoking the compiler, the user must include the in-line +procedure shown on the following page in his job before the +compilation step. Copies of this in-line procedure may be +obtained at any keypunch if the proper keys are struck. +.LP +The compiler is then executed in the usual manner: +.LP +.nf + + // EXEC INTERCAL[,PARM='parameters'] + //COMPILE.SYSIN DD * + {INTERCAL source deck} + /* + //EXECUTE.SYSWRITE DD * + {input data} + /* + +.fi +.LP +The various parameters are described following the in-line +procedure. At most one parameter from each set may apply to +a given compilation; if more than one are specified, the +results are undefined, and may vary depending upon the +particular set of options. The default parameters are +underlined. +.bp +.nf + //INTERCAL PROC + //COMPILE EXEC PGM=INTERCAL + //STEPLIB DD DSN=U.INTERCAL.LIBRARY,DISP=SHR + // DD DSN=SYS1.FORTLIB,DISP=SHR + //SYSPRINT DD SYSOUT=A,DCB=(BLKSIZE=992,LRECL=137,RECFM=VBA) + //SYSPUNCH DD DUMMY + //SCRATCH DD DSN=&COMPSET,UNIT=SYSDA,SPACE=(CYL,(3,1)),DISP=(,PASS) + //EXECUTE EXEC PGM=EXECUTE,COND=(4,LT) \** + //SOURCES DD DSN=U.INTERCAL.SOURCES,DISP=SHR + //STEPLIB DD DSN=U.INTERCAL.LIBRARY,DISP=SHR + // DD DSN=SYS5.SPITLIB,DISP=SHR + // DD DSN=SYS1.FORTLIB,DISP=SHR + //SYSIN DD DSN=&COMPSET,DISP=(OLD,DELETE) + //SYSOBJ DD SYSOUT=B,DCB=(BLKSIZE=80,LRECL=80,RECFM=F) + //SYSPRINT DD SYSOUT=A,DCB=(BLKSIZE=992,LRECL=137,RECFM=VBA) + //SYSPUNCH DD DUMMY + // PEND +.fi +.FS +Pending acquisition of SPITBOL release 3.0, the SOURCES +DD card must be replaced by the five cards: +.nf + //NOOPTPFX DD DSN=U.INTERCAL.SOURCES(NOOPTPFX),DISP=SHR + //NOOPTSUB DD DSN=U.INTERCAL.SOURCES(NOOPTSUB),DISP=SHR + //OPTPFX DD DSN=U.INTERCAL.SOURCES(OPTPFX),DISP=SHR + //OPTSUB DD DSN=U.INTERCAL.SOURCES(OPTSUB),DISP=SHR + //PRELIM DD DSN=U.INTERCAL.SOURCES(PRELIM),DISP=SHR +.fi +.FE +.ce 1 +Figure 3. Inline procedure for using INTERCAL. +.LP +.B OPT +.br +NOOPT +.IP +In the default mode, the compiler will print a +list of all options in effect, including the +defaults for unspecified parameter groups and the +effective option for those sets where one was +specified. If NOOPT is requested, it causes the +default mode to be assumed. +.LP +.B OPTSUB +.br +NOOPTSUB +.br +NOSUB +.IP +Unless 'NOOPTSUB' is requested, the System Library +is optimized, resulting in much more rapid +NOSUB processing of function calls. Specifying NOOPTSUB +causes the non-optimized INTERCAL code shown in +section 6.3 to be used, whereas NOSUB requests +that the System Library be omitted altogether. +.LP +IAMBIC +.br +.B PROSE +.IP +The IAMBIC parameter permits the programmer to use +poetic license and thus write in verse. If the +reader does not believe it possible to write verse +in INTERCAL, he should send the authors a stamped, +self-addressed envelope, along with any INTERCAL +program, and they will provide one which is verse. +.LP +.B FORMAT +.br +NOFORMAT +.IP +In FORMAT mode, each statement printed is put on a +separate line (or lines). In NOFORMAT mode, the +free-format source is printed exactly as input. +In this latter case, statement numbers are +provided only for the first statement on a card, +and they may be only approximate. Also, +unrecognizable statements are not flagged. +.LP +SEQ +.br +.B NOSEQ +.IP +If the source deck has sequence numbers in columns +73 through 80, specifying 'SEQ' will cause them to +be ignored. +.LP +.B SOURCE +.br +NOSOURCE +.IP +If NOSOURCE is selected, all source listing is +suppressed. +.LP +LIST +.br +.B NOLIST +.IP +If LIST is specified, the compiler will provide a +list of statement numbers catalogued according to +type of statement. The compiler uses this table +to perform abstentions by gerund. +.IP "WIDTH=nn" +This sets the width (in number of characters) of +the output line for FORMAT mode output. The +default is +.B 132. +.LP +CODE +.br +.B NOCODE +.IP +Include 'CODE' in the parameter list to obtain a +listing of the SPITBOL code produced for each +INTERCAL statement. +.IP "LINES=nn" +This determines the number of lines per page, +during both compilation and execution. The +default is +.B 60. +.LP +DECK +.br +.B NODECK +.IP +Selecting 'DECK' will cause the compiler to punch +out a SPITBOL object deck which may then be run +without reinvoking the INTERCAL (or SPITBOL) +compiler. +.LP +.B KIDDING +.br +NOKIDDING +.IP +Select NOKIDDING to eliminate the snide remarks +which ordinarily accompany INTERCAL error +messages. +.LP +.B GO +.br +NOGO +.IP +Specifying 'NOGO' will cause the program to be +compiled but not executed. EXECUTE/NOEXECUTE may +be substituted for GO/NOGO, but this will result +in an error, and GO will be assumed. +.LP +.B BUG +.br +NOBUG +.IP +Under the default, there is a fixed probability of +a fatal compiler bug being worked at random into +the program being compiled. Encountering this bug +during execution results in error message 774 (see +section 7.2). This probability is reduced to zero +under 'NOBUG'. This does not affect the +probability (presumably negligible) of error +message 778. +.NH 2 +Other INTERCAL Compilers +.LP +There are no other INTERCAL compilers. \** +.FS +Note that this document pre-dates Eric Raymond's C-INTERCAL compiler, and +an Atari implementation mentioned on the final page of this document. +.FE +.ds CH TONSIL A\** +.bp +.LP +The Official INTERCAL Character Set +.FS +Since all other reference manuals have Appendices, it was decided that +the INTERCAL manual should contain some other type of removable organ. +.FE +.nr * \n*+1 +.nr PG \n%+1 +.LP +Tabulated on page \n(PG are all the characters used in INTERCAL, excepting +letters and digits, along with their names and interpretations. Also +included are several characters not used in INTERCAL, which are presented +for completeness and to allow for future expansion. +.FS +This footnote intentionally unreferenced. +.FE +.ds CH - % - +.bp +.nr * \n*-1 +.TS +box; +c c c +l l l. +Character Name Use (if any) += +\. spot identify 16-bit variable +: two-spot identify 32-bit variable +, tail identify 16-bit array +; hybrid identify 32-bit array +# mesh identify constant +\&= half-mesh +' spark grouper +` backspark +! wow equivalent to spark-spot +? what \fIunary exlusive OR (ASCII)\fR +" rabbit-ears grouper +\o'".' rabbit equivalent to ears-spot +| spike +% double-oh-seven percentage qualifier +\- worm used with angles +< angle used with worms +> right angle +( wax precedes line label +) wane follows line label +[ U turn +] U turn back +{ embrace +} bracelet +* splat flags invalid statements +& ampersand\** unary logical AND +V V (or book) unary logical OR +\*(vb bookworm (or universal qualifier) unary exclusive OR +$ big money \fIbinary mingle (ASCII)\fR +\(ct change binary mingle +~ sqiggle binary select +\&_ flat worm +\(rn overline indicates "times 1000" ++ intersection separates list items +/ slat +\e backslat +@ whirlpool +\(no hookworm +^ shark (or simply sharkfin) +\o"#*\(sq" blotch +.TE +.ce 1 +Table 2 (top view). INTERCAL character set. +.FS +Got any better ideas? +.FE +.ds CH NOTES ON THE ATARI IMPLEMENTATION +.bp +.LP +The Atari implementation of INTERCAL differs from the original Princeton +.ds CH INTERCAL +version primarily in the use of ASCII rather than EBCDIC. Since there is no +"change" sign (\(ct) in ASCII, we have substituted the "big money" ($) as the +mingle operator. We feel that this correctly represents the increasing cost +of software in relation to hardware. (Consider that in 1970 one could get +RUNOFF for free, to run on a $20K machine, whereas today a not quite as +powerful formatter costs $99 and runs on a $75 machine.) We also feel that +there should be no defensible contention that INTERCAL has any sense. +Also, since overpunches are difficult to read on the average VDT, the +exclusive-or operator may be written ?. This correctly expresses the +average person's reaction on first encountering exclusive-or, especially on +a PDP-11. Note that in both of these cases, the over-punched symbol may +also be used if one is masochistic, or concerned with portability to the +Princeton compiler. The correct over-punch for "change" is "c/" +and the correct over-punch for \*(vb is "V-". These codes will be +properly printed if you have a proper printer, and the corresponding EBCDIC +code will be produced by the /IBM option on the LIST command. diff --git a/intercal.sty b/doc/intercal.sty similarity index 100% rename from intercal.sty rename to doc/intercal.sty diff --git a/intercal.tex b/doc/intercal.tex similarity index 100% rename from intercal.tex rename to doc/intercal.tex diff --git a/intercal.man b/doc/intercal.txt similarity index 100% rename from intercal.man rename to doc/intercal.txt diff --git a/fiddle.c b/fiddle.c deleted file mode 100644 index e268f9c..0000000 --- a/fiddle.c +++ /dev/null @@ -1,124 +0,0 @@ -/* - * fiddle.c -- functions that implement the five INTERCAL operators - * - * We link these to the compiler, too, in order to do constant folding - */ - -#define BIT(n, q) (((q) & (1 << (n))) != 0) - -unsigned int mingle(r, s) -unsigned int r, s; -{ - return ( - (BIT(15, r) << 31) | - (BIT(15, s) << 30) | - (BIT(14, r) << 29) | - (BIT(14, s) << 28) | - (BIT(13, r) << 27) | - (BIT(13, s) << 26) | - (BIT(12, r) << 25) | - (BIT(12, s) << 24) | - (BIT(11, r) << 23) | - (BIT(11, s) << 22) | - (BIT(10, r) << 21) | - (BIT(10, s) << 20) | - (BIT( 9, r) << 19) | - (BIT( 9, s) << 18) | - (BIT( 8, r) << 17) | - (BIT( 8, s) << 16) | - (BIT( 7, r) << 15) | - (BIT( 7, s) << 14) | - (BIT( 6, r) << 13) | - (BIT( 6, s) << 12) | - (BIT( 5, r) << 11) | - (BIT( 5, s) << 10) | - (BIT( 4, r) << 9) | - (BIT( 4, s) << 8) | - (BIT( 3, r) << 7) | - (BIT( 3, s) << 6) | - (BIT( 2, r) << 5) | - (BIT( 2, s) << 4) | - (BIT( 1, r) << 3) | - (BIT( 1, s) << 2) | - (BIT( 0, r) << 1) | - (BIT( 0, s) << 0)); -} - -unsigned int select(r, s) -unsigned int r, s; -{ - int i, n = 0, result = 0; - - for (i = 0; i < 32; i++) - if (BIT(i, s)) - result |= BIT(i,r) << n++; - return(result); -} - -unsigned int and16(n) -unsigned int n; -{ - unsigned int m = (n >> 1); - - if (n & 1) - m |= 0x8000; - - return(m & n); -} - -unsigned int or16(n) -unsigned int n; -{ - unsigned int m = (n >> 1); - - if (n & 1) - m |= 0x8000; - - return(m | n); -} - -unsigned int xor16(n) -unsigned int n; -{ - unsigned int m = (n >> 1); - - if (n & 1) - m |= 0x8000; - - return(m ^ n); -} - -unsigned int and32(n) -unsigned int n; -{ - unsigned int m = (n >> 1); - - if (n & 1) - m |= 0x80000000; - - return(m & n); -} - -unsigned int or32(n) -unsigned int n; -{ - unsigned int m = (n >> 1); - - if (n & 1) - m |= 0x80000000; - - return(m | n); -} - -unsigned int xor32(n) -unsigned int n; -{ - unsigned int m = (n >> 1); - - if (n & 1) - m |= 0x80000000; - - return(m ^ n); -} - -/* fiddle.c */ diff --git a/ick-wrapper.c b/ick-wrapper.c deleted file mode 100644 index 915eedd..0000000 --- a/ick-wrapper.c +++ /dev/null @@ -1,49 +0,0 @@ -/* $A.c -- generated C-code file for INTERCAL program $A.i */ - -#include - -extern unsigned int interleave(), select(); -extern unsigned int and16(), or16(), xor16(), and32(), or32(), xor32(); - -int lineno; - -static int abstained[$B]$C; -$D - -main() -{ - /* declare and initialize gerund variables */ - int calculating = TRUE; - int nexting = TRUE; - int forgetting = TRUE; - int resuming = TRUE; - int stashing = TRUE; - int retrieving = TRUE; - int ignoring = TRUE; - int remembering = TRUE; - int abstaining = TRUE; - int reinstating = TRUE; - int readingout = TRUE; - int writingin = TRUE; - int comingfrom = TRUE; - - int skipto = 0; - - /* set seed for random error generation */ -#ifdef USG - srand48(time((long *)0) + getpid()); -#else - srand(time((long *)0)); -#endif /* UNIX */ - - /* set up stash storage */ - stashinit(); - - $E - -top: - /* degenerated code */ -$F - lose($B+1,"633 Execution has passed beyond the last statment of the program."); -} - diff --git a/ick.h b/ick.h deleted file mode 100644 index 8183163..0000000 --- a/ick.h +++ /dev/null @@ -1,51 +0,0 @@ -/* ick.h -- compilation types for intercal parser */ - -typedef int bool; -#define TRUE 1 -#define FALSE 0 - -/* - * We choose this value for maximum number of possible source lines on - * the theory that no human mind could grok more lines of INTERCAL than - * this and still retain any vestige of sanity. - */ -#define MAXLINES 1000 - -/* - * Similarly for maximum number of variable stashes - */ -#define MAXSTASHES 100 - -typedef struct node_t -{ - int opcode; /* operator or type code */ - unsigned int constant; /* constant data attached */ - int width; /* is this 32-bit data? */ - struct node_t *lval, *rval; /* attached expression nodes */ -} node; - -/* unary-op types -- values for token of type UNARY */ -#define AND 0 -#define OR 1 -#define XOR 2 - -typedef struct tuple_t -{ - unsigned int label; /* label # of this statement */ - unsigned int comefrom; /* if NZ, a COME FROM touches this */ - unsigned int exechance; /* chance of execution */ - unsigned int type; /* statement type */ -#define SPLATTERED -1 /* it's undecodeable */ - union - { - unsigned int target; /* for NEXT statements */ - node *node; /* attached expression node(s) */ - } u; - int lineno; /*For splatters*/ -} tuple; - -/* the lexical analyzer keeps copies of the source logical lines */ -extern char *textlines[MAXLINES]; -extern int yylineno; - -/* ick.h ends here */ diff --git a/ick.y b/ick.y deleted file mode 100644 index 7d2c400..0000000 --- a/ick.y +++ /dev/null @@ -1,277 +0,0 @@ -/***************************************************************************** - -NAME - ick.y -- grammar for the INTERCAL language - -DESCRIPTION - This YACC grammar parses the INTERCAL language by Don R. Woods and -James M. Lyon. - -*****************************************************************************/ - -%{ -#include -#include "ick.h" -#include "lose.h" - -extern node *newnode(), *cons(); -extern tuple *newtuple(); -extern unsigned int intern(); -extern int yylineno; - -static node *rlist; /* pointer to current right-hand node list */ -static node *llist; /* pointer to current left-hand node list */ -static node *np; /* variable for building node lists */ -static int whichline = 1; - -#define ACTION(x, nt, nn) x = newtuple(); x->type = nt; x->u.node = nn -#define TARGET(x, nt, nn) x = newtuple(); x->type = nt; x->u.target = nn -%} - -%start program - -%union -{ - int numval; /* a numeric value */ - tuple *tuple; /* a code tuple */ - node *node; /* an expression-tree node */ -} - -/* - * Don't change this statement token list gratuitously! - * Some code in feh.c depends on GETS being the least - * statement type and on the order of the ones following. - */ -%token GETS RESIZE NEXT FORGET RESUME STASH RETRIEVE IGNORE REMEMBER ABSTAIN -%token REINSTATE DISABLE ENABLE GIVE_UP READ_OUT WRITE_IN COME_FROM - -%token DO PLEASE NOT MESH ONESPOT TWOSPOT TAIL HYBRID -%token MINGLE SELECT SPARK EARS SUB BY GERUND BADCHAR - -%token NUMBER UNARY OHOHSEVEN GERUND LABEL -%token INTERSECTION - -%token NEWLINE - -%type expr varlist outlist variable constant lvalue inlist outlist -%type subscr byexpr scalar array initem outitem sublist -%type perform -%type please - -%% /* beginning of rules section */ - -/* A program description consists of a sequence of statements */ -program : /* EMPTY */ - | program statemnt NEWLINE - { - whichline++; - } - ; - -statemnt: command - | error - {splat();} - ; - -/* - * Each command consists of an optional label, followed by a preamble, - * followed by the statement body - */ -command : /* EMPTY */ /* blank line is OK */ - | please perform - {$2->label = 0; $2->exechance = $1;} - | please OHOHSEVEN perform - {$3->label = 0; $3->exechance = $2;} - | LABEL please perform - {$3->label = $1; $3->exechance = $2;} - | LABEL please OHOHSEVEN perform - {$4->label = $1; $4->exechance = $2;} - ; - -/* There are several forms of preamble */ -please : DO {$$ = 100;} - | NOT {$$ = 0;} - | DO NOT {$$ = 0;} - | PLEASE {$$ = 100;} - | DO PLEASE {$$ = 100;} - | PLEASE DO {$$ = 100;} - | PLEASE NOT {$$ = 0;} - ; - -/* Here's how to parse statement bodies */ -perform : lvalue GETS expr {ACTION($$, GETS,cons(GETS,$1,$3));} - | array GETS byexpr {ACTION($$,RESIZE,cons(RESIZE,$1,$3));} - | LABEL NEXT {TARGET($$, NEXT, $1);} - | FORGET expr {ACTION($$, FORGET, $2);} - | RESUME expr {ACTION($$, RESUME, $2);} - | STASH varlist {ACTION($$, STASH, rlist);} - | RETRIEVE varlist {ACTION($$, RETRIEVE, rlist);} - | IGNORE varlist {ACTION($$, IGNORE, rlist);} - | REMEMBER varlist {ACTION($$, REMEMBER, rlist);} - | ABSTAIN LABEL {TARGET($$, ABSTAIN, $2);} - | ABSTAIN gerunds {ACTION($$, DISABLE, rlist);} - | REINSTATE LABEL {TARGET($$, REINSTATE, $2);} - | REINSTATE gerunds {ACTION($$, ENABLE, rlist);} - | WRITE_IN inlist {ACTION($$, WRITE_IN, $2);} - | READ_OUT outlist {ACTION($$, READ_OUT, $2);} - | GIVE_UP {ACTION($$, GIVE_UP, 0);} - | COME_FROM LABEL {TARGET($$, COME_FROM, $2);} - | error {splat();} - ; - -/* gerund lists are used by ABSTAIN and REINSTATE */ -gerunds : GERUND - {rlist = np = newnode(); np->constant = $1;} - | gerunds INTERSECTION GERUND - { - np->rval = newnode(); - np = np->rval; - np->constant = $3; - } - ; - -/* OK, here's what a variable reference looks like */ -variable: scalar | array; - -lvalue : scalar | subscr; - -scalar : ONESPOT NUMBER - { - $$ = newnode(); - $$->opcode = ONESPOT; - $$->constant = intern(ONESPOT, $2); - } - | TWOSPOT NUMBER - { - $$ = newnode(); - $$->opcode = TWOSPOT; - $$->constant = intern(TWOSPOT, $2); - } - ; - -array : TAIL NUMBER - { - $$ = newnode(); - $$->opcode = TAIL; - $$->constant = intern(TAIL, $2); - } - | HYBRID NUMBER - { - $$ = newnode(); - $$->opcode = HYBRID; - $$->constant = intern(HYBRID, $2); - } - ; - -/* And a constant looks like this */ -constant: MESH NUMBER - { - /* enforce the 16-bit constant constraint */ - if ($2 > 0xffff) - lose(yylineno, E017); - $$ = newnode(); - $$->opcode = MESH; - $$->constant = $2; - } - ; - -/* variable lists are used in STASH, RETRIEVE, IGNORE, REMEMBER */ -varlist : variable {rlist = np = $1;} - | varlist INTERSECTION variable {np = np->rval = newnode();} - ; - -/* scalars and subscript exprs are permitted in WRITE IN lists */ -initem : scalar | subscr; -inlist : initem INTERSECTION inlist {$$=cons(INTERSECTION,$1,$3);} - | initem {$$=cons(INTERSECTION,$1,0);} - -/* scalars, subscript exprs & constants are permitted in READ OUT lists */ -outitem : scalar | subscr | constant; -outlist : outitem INTERSECTION outlist {$$=cons(INTERSECTION,$1,$3);} - | outitem {$$=cons(INTERSECTION,$1,0);} - ; - -/* Now the gnarly part -- expression syntax */ - -/* Support array subscripts (as lvalues) */ -subscr : array SUB sublist {$$ = cons(SUB, $1, $3);} - ; -sublist : expr sublist {$$ = cons(INTERSECTION, $1, $2);} - | expr {$$ = cons(INTERSECTION, $1, 0);} - ; - -/* Support array dimension assignment */ -byexpr : expr BY byexpr {$$ = cons(BY, $1, $3);} - | expr {$$ = cons(BY, $1, 0);} - ; - -/* here goes the general expession syntax */ -preftype: MESH | ONESPOT | TWOSPOT | TAIL | HYBRID; - -expr : variable {$$ = $1;} - | constant {$$ = $1;} - - /* deal with the bizarre unary-op syntax */ - | preftype UNARY NUMBER - { - $$ = newnode(); - $$->opcode = $2; - $$->rval = newnode(); - $$->rval->opcode = MESH; - $$->rval->constant = $3; - } - - /* Now deal with the screwy unary-op interaction with grouping */ - | SPARK UNARY expr SPARK - { - $$ = newnode(); - $$->opcode = $2; - $$->rval = $3; - } - | EARS UNARY expr EARS - { - $$ = newnode(); - $$->opcode = $2; - $$->rval = $3; - } - - | expr SELECT expr {$$ = cons(SELECT, $1, $3);} - | expr MINGLE expr {$$ = cons(MINGLE, $1, $3);} - | SPARK expr SPARK {$$ = $2;} - | EARS expr EARS {$$ = $2;} - | subscr {$$ = $1;} - ; - -%% - -tuple *splat() -/* try to recover from an invalid statement. */ -{ - extern FILE *yyin; - tuple *sp; - - /* we're going to do our own resynchronization */ - yyerrok; - yyclearin; - - /* - * This is called "weird sex with the lexical analyzer". The idea - * here is to skip to the next newline, but to do it with our - * private getc() in order to save the line's characters. - * - * With a bit more effort we could implement the full, hideous - * semantics of splat, i.e. that another statement identifier - * (DO or PLEASE) in the statement takes us back to normal parsing. - * But I'm not feeling that twisted just now. - */ -#undef getc - while (getc(yyin) != '\n') - continue; - ungetc('\n', yyin); - - /* generate a placeholder tuple for the text line */ - TARGET(sp, SPLATTERED, 0); - return(sp); -} - -/* ick.y ends here */ diff --git a/intercal.el b/intercal.el new file mode 100644 index 0000000..178d3d9 --- /dev/null +++ b/intercal.el @@ -0,0 +1,176 @@ +;;; intercal.el -- mode for editing INTERCAL code + +;; This mode was written by Eric S. Raymond +;; for the C-INTERCAL distribution, and is copyrighted by him 1992. Free +;; redistribution encouraged. Someday, maybe, this will be made part of GNU. + +;; This mode provides abbrevs for C-INTERCAL's statements, including COME FROM. +;; These abbrevs are context-sensitive and will generate either verb or gerund +;; form as appropriate. The keys RET, ( and * are also bound in useful ways. + +;; The intercal-politesse-level adjustment purports to assist the hapless +;; INTERCAL programmer in meeting INTERCAL's Miss Manners requirement. In +;; INTERCAL-72 and C-INTERCAL releases after 0.7, no fewer than 1/5 and no +;; more than 1/3 of the program statements must contain a PLEASE to gratify +;; the iron whim of the INTERCAL compiler; this mode assists by randomly +;; expanding some fraction of the "do" abbrevs typed to PLEASE DO or DO PLEASE. +;; The intercal-politesse-level constant is the denominator of this fraction. + +;; $Id: intercal.el,v 1.4 1994/09/22 09:08:00 esr Exp $ + +(defconst intercal-politesse-level 4 + "Fraction of DOs that are automagically expanded to PLEASE DO, DO PLEASE.") + +(defvar intercal-mode-map nil + "Keymap for INTERCAL mode.") +(if intercal-mode-map + nil + (setq intercal-mode-map (make-sparse-keymap)) + (define-key intercal-mode-map "\t" 'tab-to-tab-stop) + (define-key intercal-mode-map "\r" 'intercal-return) + (define-key intercal-mode-map "(" 'intercal-paren) + (define-key intercal-mode-map "*" 'intercal-splat) + (define-key intercal-mode-map "\177" 'backward-delete-char-untabify) + ) + +(defvar intercal-mode-syntax-table nil + "Syntax table in use in Intercal-mode buffers.") + +(if intercal-mode-syntax-table + nil + (let ((table (make-syntax-table))) + (modify-syntax-entry ?\\ "\\" table) + (modify-syntax-entry ?+ "." table) + (modify-syntax-entry ?- "." table) + (modify-syntax-entry ?= "." table) + (modify-syntax-entry ?% "." table) + (modify-syntax-entry ?< "." table) + (modify-syntax-entry ?> "." table) + (modify-syntax-entry ?& "." table) + (modify-syntax-entry ?| "." table) + (modify-syntax-entry ?\' "\"" table) + (setq intercal-mode-syntax-table table))) + +(defvar intercal-mode-abbrev-table nil + "*Abbrev table in use in Intercal-mode buffers.") +(if intercal-mode-abbrev-table + nil + (define-abbrev-table 'intercal-mode-abbrev-table ()) + (define-abbrev intercal-mode-abbrev-table "pl" "PLEASE" nil) + (define-abbrev intercal-mode-abbrev-table "ne" "" 'intercal-ne-abbrev) + (define-abbrev intercal-mode-abbrev-table "fo" "" 'intercal-fo-abbrev) + (define-abbrev intercal-mode-abbrev-table "res" "" 'intercal-res-abbrev) + (define-abbrev intercal-mode-abbrev-table "st" "" 'intercal-st-abbrev) + (define-abbrev intercal-mode-abbrev-table "ret" "" 'intercal-ret-abbrev) + (define-abbrev intercal-mode-abbrev-table "ig" "" 'intercal-ig-abbrev) + (define-abbrev intercal-mode-abbrev-table "rem" "" 'intercal-rem-abbrev) + (define-abbrev intercal-mode-abbrev-table "ab" "" 'intercal-ab-abbrev) + (define-abbrev intercal-mode-abbrev-table "rei" "" 'intercal-rei-abbrev) + (define-abbrev intercal-mode-abbrev-table "gi" "" 'intercal-gi-abbrev) + (define-abbrev intercal-mode-abbrev-table "rea" "" 'intercal-rea-abbrev) + (define-abbrev intercal-mode-abbrev-table "wr" "" 'intercal-wr-abbrev) + (define-abbrev intercal-mode-abbrev-table "co" "" 'intercal-co-abbrev) + (define-abbrev intercal-mode-abbrev-table "do" "" 'intercal-do-abbrev) + ) + +(defun use-gerund () + (save-excursion + (beginning-of-line) + (or (looking-at ".*ABSTAIN") (looking-at ".*REINSTATE")))) + +(defmacro make-intercal-abbrev (sym gerund verb) + (list 'defun sym '() (list 'insert (list 'if '(use-gerund) gerund verb)))) + +(make-intercal-abbrev intercal-ne-abbrev "NEXTING" "NEXT") +(make-intercal-abbrev intercal-fo-abbrev "FORGETTING" "FORGET") +(make-intercal-abbrev intercal-res-abbrev "RESUMING" "RESUME") +(make-intercal-abbrev intercal-st-abbrev "STASHING" "STASH") +(make-intercal-abbrev intercal-ret-abbrev "RETRIEVING" "RETRIEVE") +(make-intercal-abbrev intercal-ig-abbrev "IGNORING" "IGNORE") +(make-intercal-abbrev intercal-rem-abbrev "REMEMBERING" "REMEMBER") +(make-intercal-abbrev intercal-ab-abbrev "ABSTAINING" "ABSTAIN FROM") +(make-intercal-abbrev intercal-rei-abbrev "REINSTATING" "REINSTATE") +(make-intercal-abbrev intercal-gi-abbrev "GIVING UP" "GIVE UP") +(make-intercal-abbrev intercal-rea-abbrev "READING IN" "READ IN") +(make-intercal-abbrev intercal-wr-abbrev "WRITING OUT" "WRITE OUT") +(make-intercal-abbrev intercal-co-abbrev "COMING FROM" "COME FROM") + +(defun intercal-do-abbrev () + "Emit a DO (usually). Occasionally, emit DO PLEASE or PLEASE DO." + (insert + (if (zerop (% (random) intercal-politesse-level)) + (if (% (random) 2) "PLEASE DO" "DO PLEASE") + "DO") + )) + +(defun intercal-return () + "Insert LFD + tab, to bring us back to code-indent level." + (interactive) + (if (eolp) (delete-horizontal-space)) + (insert "\n") + (tab-to-tab-stop) + ) + +(defun intercal-paren () + "Generate an INTERCAL label." + (interactive) + (if (and (bolp) (looking-at "[ \t]\\|$")) + (insert (format "(%d)" + (save-restriction + (widen) + (save-excursion + (beginning-of-line) + (1+ (count-lines 1 (point)))))) + "\t") + (insert "("))) + +(defun intercal-splat () + "Begin an INTERCAL comment." + (interactive) + (insert "*") + (forward-char -1) + (delete-horizontal-space) + (forward-char 1) + (insert " ") +) + +(defun intercal-mode () + "A major editing mode for the language Intercal. +It activates the following abbrevs (each one appropriately modified to a +gerund if it occurs on a line with ABSTAIN or REINSTATE). + +ab ABSTAIN co COME FROM fo FORGET +gi GIVE UP ig IGNORE ne NEXT +rea READ IN rei REINSTATE rem REMEMBER +res RESUME ret RETRIEVE st STASH +wr WRITE OUT pl PLEASE + +Carriage return takes you to the first tab stop (code indent level). +Certain other single keys are bound to things which may or may not be useful. +You may consider discovering these one of the pleasures awaiting you in your +discovery of INTERCAL's unique ambience. + +Turning on Intercal mode calls the value of the variable intercal-mode-hook +with no args, if that value is non-nil." + (interactive) + (kill-all-local-variables) + (use-local-map intercal-mode-map) + (setq major-mode 'intercal-mode) + (setq mode-name "Intercal") + (setq local-abbrev-table intercal-mode-abbrev-table) + (set-syntax-table intercal-mode-syntax-table) + (make-local-variable 'comment-start) + (setq comment-start "* ") + (make-local-variable 'comment-end) + (setq comment-end "") + (make-local-variable 'comment-column) + (setq comment-column 32) + (make-local-variable 'require-final-newline) + (setq require-final-newline t) + (setq abbrev-mode t) + (setq abbrev-all-caps t) + (run-hooks 'intercal-mode-hook)) + +(provide 'intercal-mode) + +;;; intercal.el ends here diff --git a/intercal.lsm b/intercal.lsm new file mode 100644 index 0000000..7fb0d41 --- /dev/null +++ b/intercal.lsm @@ -0,0 +1,18 @@ +Begin3 +Title: intercal +Version: 0.12 +Entered-date: Tue Mar 22 12:42:31 EST 1995 +Description: An implementation of the language INTERCAL, legendary for + its perversity and horribleness (this version adds COME FROM + for extra flavor). Includes language manual and examples + including possibly the entire extant body of INTERCAL code. +Keywords: language, compiler, retrocomputing +Author: esr@snark.thyrsus.com (Eric S. Raymond) +Maintained-by: esr@snark.thyrsus.com (Eric S. Raymond) +Primary-site: locke.ccil.org /pub/esr + intercal-0.12 +Platform: All +Copying-policy: BSD-like +End + + diff --git a/lose.c b/lose.c deleted file mode 100644 index ef9f043..0000000 --- a/lose.c +++ /dev/null @@ -1,20 +0,0 @@ -/* - * lose.c -- report INTERCAL compile- or run-time error - */ -/*LINTLIBRARY*/ -#include - -void lose(n, m) -int n; -char *m; -{ - (void) fprintf(stderr, - "ICL%c%c%cI %s\n ON THE WAY TO STATEMENT %04d\n", - m[0], m[1], m[2], m+4, n); - (void) fprintf(stderr, " CORRECT SOURCE AND RESUBMIT\n"); - exit(atoi(m)); -} - -/* lose.c ends here */ - - diff --git a/lose.h b/lose.h deleted file mode 100644 index b77c0a4..0000000 --- a/lose.h +++ /dev/null @@ -1,52 +0,0 @@ -/* lose.h --- error message strings - -/* - * These error messages are documented in the INTERCAL-72 manual. - */ -#define E000 "000 An undecodable statement has been encountered in the course of execution." -#define E017 "017 CAN'T YOU SPELL, YOU HOPELESS DWEEB?\n\ - (An expression contains a syntax error.)" -#define E079 "079 Improper use has been made of statement identifiers." -#define E099 "099 Improper use has been made of statement identifiers." -#define E123 "123 YOUR PROGRAM HAS VANISHED INTO THE BLACK LAGOON!\n\ - (Program has attempted 80 levels of NEXTing.)" -#define E129 "129 Program has attempted to transfer to a non-existent line label." -#define E139 "139 An ABSTAIN or REINSTATE statement references a non-existent line label." -#define E182 "182 A line label has been multiply defined." -#define E197 "197 An invalid line label has been encountered." -#define E200 "200 An expression involves an unidentified variable." -#define E240 "240 An attempt has been made to give an array a dimension of zero." -#define E241 "241 Invalid dimensioning information was supplied in defining or using an array." -#define E275 "275 DON'T BYTE OFF MORE THAN YOU CAN CHEW\n\ - A 32-bit value has been assigned to a 16-bit variable." -#define E436 "436 THROW STICK BEFORE RETRIEVING!\n\ - (A retrieval has been attempted for an unSTASHed value)." -#define E533 "533 A WRITE IN statement or interleave ($) operation has produced value requiring over 32 bits to represent." -#define E562 "562 Insufficient data." -#define E579 "579 Input data is invalid." -#define E621 "621 The expression of a RESUME statement evaluated to #0." -#define E632 "632 THE NEXT STACK RUPTURES. ALL DIE. OH, THE EMBARRASSMENT!\n\ - (Program execution terminated via a RESUME statement instead of GIVE UP)." -#define E633 "633 YOU HAVE FALLEN OFF THE EDGE OF THE WORLD. BYE-BYE!\n\ - (Execution has passed beyond the last statement of the program.)" -#define E774 "774 A compiler error has occurred (see section 8.1)." -#define E778 "778 An unexplainable compiler error has occurred (see J. Lyon or B. Woods)." - -/* - * These errors are unique to C-INTERCAL - */ -#define E222 "222 Out of stash space." -#define E333 "333 Too many variables." -#define E444 "444 A COME FROM statement references a non-existent line label." -#define E555 "555 More than one COME FROM references the same label." -#define E666 "666 Too many source lines." -#define E777 "777 No such source file." -#define E888 "888 Can't open C output file" -#define E999 "999 Can't open C skeleton file." - -extern void lose(); - -/* lose.h ends here */ - - - diff --git a/pit/CATALOG b/pit/CATALOG new file mode 100644 index 0000000..ee1f2fd --- /dev/null +++ b/pit/CATALOG @@ -0,0 +1,70 @@ +This is the directory of programs written in INTERCAL. It is named +pit because src was already taken---that's where source code for the +compiler lives---and pit seemed an appropriate place to throw +INTERCAL programs anyway. Most of these are no doubt full of bugs. +Don't complain, you're lucky if anything written in INTERCAL works +at all. + +The subdirectory lib contains code fragments that are not complete +programs. + +Contents: + +from original manual: + sample.i Returns absolute value of a 16-bit 2s-complement number + lib/syslib.i Standard library + +by Jon Blow + sink.i Simple test program + random.i Random number program + lib/plus.i Increment .1 + +by Hans Olsson + lib/1910.doc Listing of a random number routine. Hans said he wrote this + because he couldn't find (1910) in the system library, but + it's there in our lib/syslib.i. We keep this around as an + example. (What? Throw away INTERCAL code? Perish the thought!) + +by Louis Howell + life.i Conway's game of Life, standard INTERCAL version + life2.i This version uses COME FROM and character output + blinkers + t_tet + glider + gun Input files for both Life programs + bubble.i Bubble sort + icat.i Sends input to output + lib/lib2.i Currently contains only a decrement routine, see life.doc + pi.i Calculate pi + primes.i Find prime numbers + +The subdirectory tests contains some programs written only to test the +compiler. + +by David Moews + test1.i prints DO THIS TEST HAS BEEN SUCCESSFULLY COMPLETED + test2.i reads in two numbers and multiplies their product + +David Moews wrote of the latter (test2.i): + +The following program reads in two numbers and then prints their product. +It consists of a trivial calling program followed by a cleaned-up version +of a portion of the INTERCAL subroutine library. (Only a portion of +the INTERCAL subroutine library is present in the posted manual, and +that portion is full of typos.) + +by Jan-Pieter Cornet + iogerunds.i demonstrate gerund abstention + +The programs test16bit.i, testarray.i, testcf.i, testlib2.i, +limits.{i,3i}, testops.{3i,5i}, testsplat.i, were all written by Louis +Howell. Of these, testcf.i might be considered an interesting +puzzle---try to figure out what it's doing. The others are pretty +boring, but are included as diagnostics and because so few other +example programs exist. Not all of these even produce interesting +diagnostic output; it may be necessary to look at the degenerated C +code to determine if the compiler is doing the right thing. + + +End of file CATALOG +------------------- diff --git a/pit/Makefile b/pit/Makefile new file mode 100644 index 0000000..8509236 --- /dev/null +++ b/pit/Makefile @@ -0,0 +1,61 @@ +# +# Torture-tester for the INTERCAL compiler +# + +SOURCES = \ + ./sample.i \ + ./bubble.i \ + ./icat.i \ + ./tests/limits.i \ + ./tests/test1.i \ + ./tests/test16bit.i \ + ./tests/testarray.i \ + ./tests/testcf.i \ + ./tests/testlib2.i \ + ./tests/test2.i \ + ./tests/testlimits.i \ + ./tests/testsplat.i \ + ./random.i \ + ./iogerunds.i \ + ./pi.i \ + ./lib/lib2.i \ + ./lib/syslib.i \ + ./lib/plus.i \ + ./primes.i \ + ./life.i \ + ./life2.i \ + ./sink.i + +TARGETS = \ + ./sample \ + ./bubble \ + ./icat \ + ./tests/limits \ + ./tests/test1 \ + ./tests/test16bit \ + ./tests/testarray \ + ./tests/testcf \ + ./tests/testlib2 \ + ./tests/test2 \ + ./tests/testlimits \ + ./tests/testsplat \ + ./random \ + ./iogerunds \ + ./pi \ + ./lib/lib2 \ + ./lib/syslib \ + ./lib/plus \ + ./primes \ + ./life \ + ./life2 \ + ./sink + +test: + testcompile $(SOURCES) + +lines: + wc -l $(SOURCES) + +clean: + rm -f $(TARGETS) + diff --git a/pit/blinkers b/pit/blinkers new file mode 100644 index 0000000..8707fc3 --- /dev/null +++ b/pit/blinkers @@ -0,0 +1,16 @@ +NINE +FIVE +THREE +TWO +THREE +THREE +THREE +FOUR +THREE +SIX +THREE +SEVEN +THREE +EIGHT +THREE +ZERO diff --git a/pit/bubble.doc b/pit/bubble.doc new file mode 100644 index 0000000..a513ff7 --- /dev/null +++ b/pit/bubble.doc @@ -0,0 +1,110 @@ + +As documentation for the program bubble.i, I am including below the +original posting message, with the program itself deleted. The +present program bubble.i is nearly identical to the one that was +posted. The only difference is that I have now fixed the compiler +bug that made the temporary variable .4 necessary, so that variable +has been eliminated from the current version of the program. The +old version of the compare-and-exchange routine, where this variable +was used, is included at the end of the file. + + Louis Howell + November 24, 1991 + +----------------------------------------------------------------------------- + +Article: 120 of alt.lang.intercal +From: howell@grover.llnl.gov (Louis Howell) +Newsgroups: alt.lang.intercal +Subject: Bubble sort routine +Date: Thu, 7 Feb 91 18:56:34 PST + +I am including below an Intercal bubble sort routine along with a +program to call it, which you may find amusing. The program first +reads the number of elements to be sorted, then reads that many +numbers, then sorts those numbers and prints them out from highest +to lowest. There must be at least two elements to be sorted. + +There are several interesting things about this program. First, it +uses a new version of the (2000) and (2010) decrement routine. This +one is functionally identical to the one included with the Life program, +but is streamlined by eliminating the need for the temporary variable .3, +and thus should run significantly faster. + +The program itself uses my best effort towards passing a routine as an +argument to another routine. I have separated out the compare-and-exchange +routine from the rest of the bubble sort on the assumption that people +might want to sort different things in different ways. You could also +use this bubble sort to sort 32 bit arrays, for example, or to sort arrays +in the opposite order, or to sort arrays starting at some index other +than 1. It was therefore desirable to not only separate out the +compare-and-exchange function, but avoid telling the bubble sort routine +where this function is, or even what array it is sorting. (This reduces +the bubble sort to nothing more than a nested pair of loops, but one +can easily envision wanting to do something similar with more complicated +routines.) + +The program therefore operates as follows: Main program initializes array, +then jumps to head of c-and-e routine, which immediately jumps to bubble +sort. Return addresses for both the main program and the subroutine are +now available on the RESUME stack. The bubble sort expects .1 to contain +the number of elements to be sorted, and proceeds to go through the +necessary loops. Each time through the loop, the bubble sort returns to +the c-and-e routine with the indices of the elements to be compared +stored in .1 and .2; the c-and-e routine does its job then jumps back +into the bubble sort. When the bubble sort finishes its loops it jumps +back to the main program using the return address which has been sitting +on the bottom of the stack all this time. Main program prints out results. + +The loops used by the bubble sort are equivalent to the Fortran + DO 20 I = N,2,-1 + DO 10 J = N-1,1,-1 +The way this is accomplished is pretty incomprehensible, as the loop +tests aren't independent---they share some code between them. See how +fast you can figure out how they work. Hint: If you can't see why the +last statement is DO RESUME #4 (instead of #3), you have not yet +achieved enlightenment. + +In the c-and-e routine the temporary variable .4 is not really necessary. +It is used to work around a bug in the array implementation which prevents +you from using two different subscripts on the same array in the same +statement. Chances are this will be fixed before the array stuff is +released, in which case .4 should be eliminated by folding the pairs of +statements together in the obvious way. + +On with the program--- + + + [Program deleted, see bubble.i for the current version.] + + +This is the original version of the compare-and-exchange routine: + + PLEASE NOTE COMPARE AND EXCHANGE ROUTINE +(500) PLEASE ABSTAIN FROM (502) + DO (3000) NEXT + DO (501) NEXT +(501) PLEASE FORGET #1 +(502) DO (3010) NEXT + PLEASE REINSTATE (502) + DO .4 <- ",1SUB.1" + DO .3 <- '?.4$,1SUB.2'~'#0$#65535' + DO .3 <- '?"'& "'",1SUB.1"~.3'~'"?'?.3~.3'$#32768"~"#0$#65535"'" $ + ".3~.3"'~#1" $ + #1'~#3 + DO (503) NEXT + DO .3 <- ,1 SUB .1 + DO .4 <- ,1 SUB .2 + DO ,1 SUB .1 <- .4 + DO ,1 SUB .2 <- .3 + DO (501) NEXT +(504) PLEASE RESUME .3 +(503) DO (504) NEXT + PLEASE FORGET #1 + DO (501) NEXT + +-- +Louis Howell + + "But when we got into the street I viddied that thinking is for the gloopy +ones and that the oomny ones use like inspiration and what Bog sends." diff --git a/pit/bubble.i b/pit/bubble.i new file mode 100644 index 0000000..3a777db --- /dev/null +++ b/pit/bubble.i @@ -0,0 +1,94 @@ + + DO WRITE IN .2 + DO ,1 <- .2 + + PLEASE NOTE INITIAL SEQUENCE INPUT + DO .1 <- .2 + DO (110) NEXT +(110) PLEASE FORGET #1 + DO WRITE IN ,1 SUB .1 + DO (111) NEXT +(112) DO (2010) NEXT + PLEASE FORGET #2 + DO (110) NEXT +(111) DO (112) NEXT + PLEASE FORGET #1 + + PLEASE NOTE CALLING SORT ROUTINE INDIRECTLY + DO .1 <- .2 + DO (500) NEXT + + PLEASE NOTE SORTED SEQUENCE OUTPUT + DO .1 <- .2 + DO (210) NEXT +(210) PLEASE FORGET #1 + DO READ OUT ,1 SUB .1 + DO (211) NEXT +(212) DO (2010) NEXT + PLEASE FORGET #2 + DO (210) NEXT +(211) DO (212) NEXT + PLEASE FORGET #1 + + PLEASE GIVE UP + + PLEASE NOTE COMPARE AND EXCHANGE ROUTINE +(500) PLEASE ABSTAIN FROM (502) + DO (3000) NEXT + DO (501) NEXT +(501) PLEASE FORGET #1 +(502) DO (3010) NEXT + PLEASE REINSTATE (502) + DO .3 <- '?",1SUB.1"$,1SUB.2'~'#0$#65535' + DO .3 <- '?"'& "'",1SUB.1"~.3'~'"?'?.3~.3'$#32768"~"#0$#65535"'" $ + ".3~.3"'~#1" $ + #1'~#3 + DO (503) NEXT + DO .3 <- ,1 SUB .1 + DO ,1 SUB .1 <- ,1 SUB .2 + DO ,1 SUB .2 <- .3 + DO (501) NEXT +(504) PLEASE RESUME .3 +(503) DO (504) NEXT + PLEASE FORGET #1 + DO (501) NEXT + + + PLEASE NOTE BUBBLE SORT ROUTINE + PLEASE NOTE THAT EXCHANGE ROUTINE SHOULD NOT CHANGE .1 OR .2 +(3000) PLEASE STASH .1 + .2 + DO .2 <- .1 + DO (2000) NEXT + DO (3001) NEXT +(3001) PLEASE FORGET #1 + DO RESUME #1 +(3011) DO (2010) NEXT + PLEASE FORGET #1 + DO (3001) NEXT +(3010) DO (3011) NEXT + DO (3012) NEXT +(3013) DO .1 <- .2 + DO (2010) NEXT + PLEASE FORGET #2 + DO .2 <- .1 + DO (3010) NEXT + DO RESUME #1 +(3012) DO (3013) NEXT + PLEASE RETRIEVE .1 + .2 + DO RESUME #4 + +(2010) PLEASE ABSTAIN FROM (2004) +(2000) PLEASE STASH .2 + DO .2 <- #1 + DO (2001) NEXT +(2001) PLEASE FORGET #1 + DO .1 <- '?.1$.2'~'#0$#65535' + DO (2002) NEXT + DO .2 <- !2$#0'~'#32767$#1' + DO (2001) NEXT +(2003) PLEASE RESUME "?!1~.2'$#1"~#3 +(2002) DO (2003) NEXT + PLEASE RETRIEVE .2 +(2004) PLEASE RESUME #2 + PLEASE DO REINSTATE (2004) + PLEASE RESUME '?"!1~.1'~#1"$#2'~#6 diff --git a/pit/glider b/pit/glider new file mode 100644 index 0000000..69baa28 --- /dev/null +++ b/pit/glider @@ -0,0 +1,14 @@ +NINE +NINE +ZERO +TWO +FOUR +THREE +FOUR +FOUR +FOUR +FOUR +THREE +THREE +TWO +OH diff --git a/pit/gun b/pit/gun new file mode 100644 index 0000000..7c4c0b7 --- /dev/null +++ b/pit/gun @@ -0,0 +1,90 @@ +THREE EIGHT +TWO ZERO +ZERO +TWO +SIX +TWO +SEVEN +THREE +SIX +THREE +SEVEN +ONE THREE +SIX +ONE THREE +SEVEN +ONE THREE +EIGHT +ONE FOUR +FIVE +ONE FOUR +NINE +ONE FIVE +FOUR +ONE FIVE +ONE ZERO +ONE SIX +FIVE +ONE SIX +NINE +ONE SEVEN +SIX +ONE SEVEN +SEVEN +ONE SEVEN +EIGHT +ONE EIGHT +SIX +ONE EIGHT +SEVEN +ONE EIGHT +EIGHT +TWO THREE +FOUR +TWO THREE +FIVE +TWO THREE +SIX +TWO FOUR +THREE +TWO FOUR +FOUR +TWO FOUR +SIX +TWO FOUR +SEVEN +TWO FIVE +THREE +TWO FIVE +FOUR +TWO FIVE +SIX +TWO FIVE +SEVEN +TWO SIX +THREE +TWO SIX +FOUR +TWO SIX +FIVE +TWO SIX +SIX +TWO SIX +SEVEN +TWO SEVEN +TWO +TWO SEVEN +THREE +TWO SEVEN +SEVEN +TWO SEVEN +EIGHT +THREE SIX +FOUR +THREE SIX +FIVE +THREE SEVEN +FOUR +THREE SEVEN +FIVE +ZERO diff --git a/pit/icat.i b/pit/icat.i new file mode 100644 index 0000000..18f342e --- /dev/null +++ b/pit/icat.i @@ -0,0 +1,23 @@ + PLEASE DO ,1 <- #1 + DO .4 <- #0 + DO .5 <- #0 + PLEASE DO COME FROM (30) + DO WRITE IN ,1 + DO .1 <- ,1SUB#1 + DO (10) NEXT + PLEASE GIVE UP +(20) PLEASE RESUME '?.1$#256'~'#256$#256' +(10) DO (20) NEXT + DO FORGET #1 + PLEASE DO .2 <- .4 + DO (1000) NEXT + DO .4 <- .3~#255 + PLEASE DO .3 <- !3~#15'$!3~#240' + DO .3 <- !3~#15'$!3~#240' + DO .2 <- !3~#15'$!3~#240' + PLEASE DO .1 <- .5 + DO (1010) NEXT + DO .5 <- .2 + DO ,1SUB#1 <- .3 +(30) PLEASE READ OUT ,1 + diff --git a/pit/iogerunds.doc b/pit/iogerunds.doc new file mode 100644 index 0000000..dc65d88 --- /dev/null +++ b/pit/iogerunds.doc @@ -0,0 +1,10 @@ +Jan-Pieter Cornet writes: + +You might want to try the following program (I've just been hacking this up, +and it costed me considerable more time than adding the gerund I/O things. +But that's the power of intercal...) This program will ask for a number +and might print it then, except that it doesn't ask the first time but + _ +assumes ONE TWO THREE. Oh and it never prints but just exits in case that +would've been printed (I did my best to make that part as unreadable as +possible. did it work? :) diff --git a/pit/iogerunds.i b/pit/iogerunds.i new file mode 100644 index 0000000..f18128b --- /dev/null +++ b/pit/iogerunds.i @@ -0,0 +1,20 @@ + DO .1 <- #123 + DO ABSTAIN FROM WRITING IN + DO COME FROM (123) +(100) DO WRITE IN .1 + PLEASE .2 <- #1 + DO %50 .2 <- !2$#0' + PLEASE DO (42) NEXT + DO ABSTAIN FROM READING OUT + PLEASE COME FROM (69) + DO READ OUT .1 + DO REINSTATE READING OUT +(123) PLEASE REINSTATE (100) +(42) DO (43) NEXT + DO FORGET #1 + DO (105) NEXT + PLEASE GIVE UP +(105) DO (106) NEXT +(69) DON'T GIVE UP +(106) PLEASE DO RESUME "'?"!1~.1'~#1"$#1'~#1"$'".1~.1"~#1' +(43) DO RESUME .2 diff --git a/pit/lib/1910.doc b/pit/lib/1910.doc new file mode 100644 index 0000000..e091fd4 --- /dev/null +++ b/pit/lib/1910.doc @@ -0,0 +1,34 @@ +From ucbvax!bloom-beacon!eru!luth!sunic!lth.se!newsuser Thu May 17 19:51:02 PDT 1990 + +Sorry, but I couldn't find the (1910)-routine so I wrote one, which +will do it's job, IF the (1900)-routine is as the manual says ( you know +it isn't ). At least I hope it works because the manual is not very clear +about this routine. + + +(1910) PLEASE STASH .3 + :3 + :1 + :2 + DO :1 <- #32768 + PLEASE .2 <- #1 + PLEASE (1911) NEXT +(1911) DO FORGET #1 + DO STASH .1 + DO (1900) NEXT + PLEASE :2 <- .1 + DO RETRIEVE .1 + DO (1500) NEXT + PLEASE DO :1 <- :3 + DO (1010) NEXT + PLEASE .1 <- .3 + DO (1912) NEXT + DO (1911) NEXT +(1912) PLEASE (1913) NEXT + DO .2 <- :1~'#65280$#65280' + PLEASE RETRIEVE :2 + .3 + :1 + :3 + DO RESUME #2 +(1914) PLEASE RESUME #1$"'.1~.1'~#1" +(1913) PLEASE (1914) NEXT +-- +---------- +Hans Olsson Email: f88ho@efd.lth.se + Snail: K[MN[RSV[GEN 8:118 + 222 45 Lund Sweden diff --git a/pit/lib/lib2.i b/pit/lib/lib2.i new file mode 100644 index 0000000..ce988cf --- /dev/null +++ b/pit/lib/lib2.i @@ -0,0 +1,51 @@ +(2010) PLEASE ABSTAIN FROM (2004) +(2000) PLEASE STASH .2 + DO .2 <- #1 + DO (2001) NEXT +(2001) PLEASE FORGET #1 + DO .1 <- '?.1$.2'~'#0$#65535' + DO (2002) NEXT + DO .2 <- !2$#0'~'#32767$#1' + DO (2001) NEXT +(2003) PLEASE RESUME "?!1~.2'$#1"~#3 +(2002) DO (2003) NEXT + PLEASE RETRIEVE .2 +(2004) PLEASE RESUME #2 + DO REINSTATE (2004) + PLEASE RESUME '?"!1~.1'~#1"$#2'~#6 +(2020) PLEASE STASH .2 + .3 + DO (1021) NEXT +(2030) DO STASH .1 + .5 + DO .3 <- #0 + DO .5 <- '?"!2~.2'~#1"$#1'~#3 + PLEASE DO (2031) NEXT + DO .4 <- #1 + PLEASE DO (2033) NEXT +(2033) DO FORGET #1 + DO .5 <- '?".2~#32768"$#2'~#3 + DO (2032) NEXT + DO .2 <- !2$#0'~'#32767$#1' + PLEASE DO .4 <- !4$#0'~'#32767$#1' + DO (2033) NEXT +(2032) DO (1001) NEXT +(2036) PLEASE FORGET #1 + DO .5 <- '?.1$.2'~'#0$#65535' + DO .5 <- '?"'&"!2~.5'~'"?'?.5~.5'$#32768"~"#0$#65535"'"$ + ".5~.5"'~#1"$#2'~#3 + DO (2034) NEXT + DO .5 <- .3 + DO (1010) NEXT + PLEASE DO .1 <- .3 + DO .3 <- 'V.4$.5'~'#0$#65535' + DO (2035) NEXT +(2034) PLEASE DO (1001) NEXT +(2035) DO FORGET #1 + DO .5 <- "?'.4~#1'$#2"~#3 + DO (2031) NEXT + DO .2 <- .2~#65534 + DO .4 <- .4~#65534 + PLEASE DO (2036) NEXT +(2031) DO (1001) NEXT + PLEASE DO .4 <- .1 + DO RETRIEVE .1 + .5 + PLEASE RESUME #2 diff --git a/pit/lib/plus.i b/pit/lib/plus.i new file mode 100644 index 0000000..436f14c --- /dev/null +++ b/pit/lib/plus.i @@ -0,0 +1,16 @@ +(2000) PLEASE DO STASH .1 + .2 + .3 + DO .2 <- #1 + DO (2001) NEXT +(2001) PLEASE FORGET #1 + DO .3 <- "?!1~#1'$#1"~#3 + DO (2002) NEXT + PLEASE DO .2 <- !2$#1'~'#65535$#1' + DO .1 <- .1~#65534 + DO (2001) NEXT +(2002) PLEASE DO (2003) NEXT + DO RETRIEVE .1 + DO .3 <- .1 + PLEASE DO .1 <- '?.2$.3'~'#0$#65535' + DO RETRIEVE .2 + .3 + DO RESUME #2 +(2003) DO RESUME .3 diff --git a/pit/lib/syslib.i b/pit/lib/syslib.i new file mode 100644 index 0000000..7536f03 --- /dev/null +++ b/pit/lib/syslib.i @@ -0,0 +1,290 @@ + PLEASE KNOCK BEFORE ENTERING + + (1000) PLEASE IGNORE .4 + PLEASE ABSTAIN FROM (1005) + (1009) DO STASH .1 + .2 + .5 + .6 + DO .4 <- #1 + DO (1004) NEXT + (1004) PLEASE FORGET #1 + DO .3 <- '?.1$.2'~'#0$#65535' + DO .6 <- '&.1$.2'~'#0$#65535' + PLEASE DO .5 <- "?!6~#32768'$#1"~#3 + DO (1002) NEXT + DO .4 <- #2 + (1005) DO (1006) NEXT + (1999) DOUBLE OR SINGLE PRECISION OVERFLOW + (1002) DO (1001) NEXT + (1006) PLEASE FORGET #1 + DO .5 <- '?"!6~.6'~#1"$#1'~#3 + DO (1003) NEXT + DO .1 <- .3 + DO .2 <- !6$#0'~'#32767$#1' + DO (1004) NEXT + (1003) DO (1001) NEXT + DO REINSTATE (1005) + (1007) PLEASE RETRIEVE .1 + .2 + .5 + .6 + DO REMEMBER .4 + PLEASE RESUME #2 + (1001) DO RESUME .5 + (1010) DO STASH .1 + .2 + .4 + DO .4 <- .1 + DO .1 <- '?.2$#65535'~'#0$#65535' + DO (1020) NEXT + PLEASE DO .2 <- .4 + PLEASE DO (1009) NEXT + DO RETRIEVE .1 + .2 + .4 + PLEASE RESUME #1 + (1020) DO STASH .2 + .3 + DO .2 <- #1 + PLEASE DO (1021) NEXT + (1021) DO FORGET #1 + DO .3 <- "?!1~.2'$#1"~#3 + PLEASE DO .1 <- '?.1$.2'~'#0$#65535' + DO (1022) NEXT + DO .2 <- !2$#0'~'#32767$#1' + DO (1021) NEXT + (1023) PLEASE RESUME .3 + (1022) DO (1023) NEXT + PLEASE RETRIEVE .2 + .3 + PLEASE RESUME #2 + (1030) DO ABSTAIN FROM (1033) + PLEASE ABSTAIN FROM (1032) + (1039) DO STASH :1 + .5 + DO (1530) NEXT + DO .3 <- :1~#65535 + PLEASE DO .5 <- :1~'#65280$#65280' + DO .5 <- '?"!5~.5'~#1"$#1'~#3 + DO (1031) NEXT + (1032) DO (1033) NEXT + DO (1999) NEXT + (1031) DO (1001) NEXT + (1033) DO .4 <- .5 + DO REINSTATE (1032) + PLEASE REINSTATE (1033) + DO RETRIEVE :1 + .5 + PLEASE RESUME #2 + (1040) PLEASE STASH .1 + .2 + .2 + :1 + :2 + :3 + DO .2 <- #0 + DO (1520) NEXT + DO STASH :1 + PLEASE RETRIEVE .2 + DO .1 <- .2 + DO .2 <- #0 + PLEASE DO (1520) NEXT + DO :2 <- :1 + DO RETRIEVE .1 + .2 + :1 + DO (1550) NEXT + PLEASE DO .3 <- :3 + DO RETRIEVE :1 + :2 + :3 + DO RESUME #1 + (1050) PLEASE STASH :2 + :3 + .5 + DO :2 <- .1 + PLEASE DO (1550) NEXT + DO .5 <- :3~'#65280$#65280' + DO .5 <- '?"!5~.5'~#1"$#1'~#3 + DO (1051) NEXT + DO (1999) NEXT + (1051) DO (1001) NEXT + DO .2 <- :3 + PLEASE RETRIEVE :2 + :3 + .5 + DO RESUME #2 + (1500) PLEASE ABSTAIN FROM (1502) + PLEASE ABSTAIN FROM (1506) + (1509) PLEASE STASH :1 + .1 + .2 + .3 + .4 + .5 + .6 + DO .1 <- :1~#65535 + PLEASE DO .2 <- :2~#65535 + DO (1009) NEXT + DO .5 <- .3 + PLEASE DO .6 <- .4 + DO .1 <- :1~'#65280$#65280' + DO .2 <- :2~'#65280$#65280' + DO (1009) NEXT + DO .1 <- .3 + PLEASE DO (1503) NEXT + DO .6 <- .4 + DO .2 <- #1 + DO (1009) NEXT + DO .1 <- .3 + DO (1501) NEXT + (1504) PLEASE RESUME .6 + (1503) DO (1504) NEXT + (1501) DO .2 <- .5 + DO .5 <- '?"'&.6$.4'~#1"$#2'~#3 + DO (1505) NEXT + (1506) DO (1502) NEXT + PLEASE DO (1999) NEXT + (1505) DO (1001) NEXT + (1502) DO :4 <- .5 + DO (1520) NEXT + DO :3 <- :1 + PLEASE RETRIEVE :1 + .1 + .2 + .3 + .4 + .5 + .6 + DO REINSTATE (1502) + DO REINSTATE (1506) + PLEASE RESUME #3 + (1510) DO STASH :1 + :2 + :4 + DO :1 <- "'?":2~'#65535$#0'"$#65535'~'#0$#6553 + 5'"$"'?":2~'#0$#65535'"$#65535'~'#0$#65535 + '" + DO :2 <- #1 + DO (1509) NEXT + PLEASE RETRIEVE :1 + DO :2 <- :3 + PLEASE DO (1509) NEXT + DO RETRIEVE :2 + :4 + PLEASE RESUME #1 + (1520) PLEASE STASH .3 + .4 + DO .3 <- .1~#43690 + DO (1525) NEXT + PLEASE DO .4 <- 'V.3$".2~#43690"'~'#0$#65535' + DO .3 <- .1~#21845 + PLEASE DO (1525) NEXT + DO :1 <- .4$"'V.3$".2~#21845"'~'#0$#65535'" + PLEASE RETRIEVE .3 + .4 + DO RESUME #1 + (1525) DO .3 <- '"'"'"!3$#0'~'#32767$#1'"$#0'~'#32767 + $#1'"$#0'~'#16383$#3'"$#0'~'#4095$#15' + PLEASE RESUME #1 + (1530) DO STASH :2 + :3 + .3 + .5 + DO :1 <- #0 + DO :2 <- .2 + DO .3 <- #1 + DO (1535) NEXT + (1535) PLEASE FORGET #1 + DO .5 <- "?!1~.3'$#1"~#3 + DO (1531) NEXT + DO (1500) NEXT + DO :1 <- :3 + PLEASE DO (1533) NEXT + (1531) PLEASE DO (1001) NEXT + (1533) DO FORGET #1 + DO .3 <- !3$#0'~'#32767$#1' + DO :2 <- ":2~'#0$#65535'"$"'":2~'#32767$#0'"$# + 0'~'#32767$#1'" + PLEASE DO .5 <- "?!3~.3'$#1"~#3 + DO (1532) NEXT + DO (1535) NEXT + (1532) DO (1001) NEXT + PLEASE RETRIEVE :2 + :3 + .3 + .5 + DO RESUME #2 + (1540) PLEASE ABSTAIN FROM (1541) + DO ABSTAIN FROM (1542) + (1549) PLEASE STASH :1 + :2 + :4 + :5 + .1 + .2 + .5 + DO .1 <- :1~#65535 + PLEASE DO .2 <- :2~'#65280$#65280' + DO .5 <- :1~'#65280$#65280' + DO (1530) NEXT + DO :3 <- :1 + DO .2 <- :2~#65535 + PLEASE DO (1530) NEXT + DO :5 <- :1 + DO .1 <- .5 + DO (1530) NEXT + DO :4 <- :1 + PLEASE DO :1 <- ":3~'#65280$#65280'"$":5~'#652 + 80$#65280'" + DO .5 <- ':1~:1'~#1 + DO .2 <- :2~'#65280$#65280' + DO (1530) NEXT + PLEASE DO .5 <- '"':1~:1'~#1"$.5'~#3 + DO .1 <- :3~#65535 + DO .2 <- #0 + DO (1520) NEXT + PLEASE DO :2 <- :1 + PLEASE DO .1 <- :4~#65535 + DO (1520) NEXT + DO (1509) NEXT + DO .5 <- !5$":4~#3"'~#15 + DO :1 <- :3 + DO :2 <- :5 + DO (1509) NEXT + PLEASE DO .5 <- !5$":4~#3"'~#63 + DO .5 <- '?"!5~.5'~#1"$#1'~#3 + PLEASE RETRIEVE :4 + (1541) DO :4 <- .5 + DO (1543) NEXT + (1542) DO (1544) NEXT + PLEASE DO (1999) NEXT + (1543) DO (1001) NEXT + (1544) DO REINSTATE (1541) + PLEASE REINSTATE (1542) + PLEASE RETRIEVE :1 + :2 + :5 + .1 + .2 + .5 + DO RESUME #2 + (1550) DO STASH :1 + :4 + :5 + .5 + DO :3 <- #0 + DO .5 <- '?"':2~:2'~#1"$#1'~#3 + PLEASE DO (1551) NEXT + DO :4 <- #1 + PLEASE DO (1553) NEXT + (1553) DO FORGET #1 + DO .5 <- '?":2~'#32768$#0'"$#2'~#3 + DO (1552) NEXT + DO :2 <- ":2~'#0$#65535'"$"'":2~'#32767$#0'"$# + 0'~'#32767$#1'" + PLEASE DO :4 <- ":4~'#0$#65535'"$"'":4~'#32767 + $#0'"$#0'~'#32767$#1'" + DO (1553) NEXT + (1552) DO (1001) NEXT + (1556) PLEASE FORGET #1 + DO :5 <- "'?":1~'#65535$#0'"$":2~'#65535$#0'"' + ~'#0$#65535'"$"'?":1~'#0$#65535'"$":2~'#0$ + #65535'"'~'#0$#65535'" + DO .5 <- '?"'&"':2~:5'~'"'?"'?":5~:5"~"#65535~ + #65535"'~'#65535$#0'"$#32768'~'#0$#65535'" + $"'?":5~:5"~"#65535$#65535"'~'#0$#65535'"' + "$"':5~:5'~#1"'~#1"$#2'~#3 + DO (1554) NEXT + DO :5 <- :3 + DO (1510) NEXT + PLEASE DO :1 <- :3 + DO :3 <- "'V":4~'#65535$#0'"$":5~'#65535$#0'"' + ~'#0$#65535'"$"'V":4~'#0$#65535'"$":5~'#0$ + #65535'"'~'#0$#65535'" + DO (1555) NEXT + (1554) PLEASE DO (1001) NEXT + (1555) DO FORGET #1 + DO .5 <- "?':4~#1'$#2"~#3 + DO (1551) NEXT + DO :2 <- ":2~'#0$#65534'"$":2~'#65535$#0'" + DO :4 <- ":4~'#0$#65534'"$":4~'#65535$#0'" + PLEASE DO (1556) NEXT + (1551) DO (1001) NEXT + PLEASE RETRIEVE :1 + :4 + :5 + .5 + PLEASE RESUME #2 + (1900) DO STASH .2 + .3 + .5 + DO .1 <- #0 + DO .2 <- #1 + PLEASE DO (1901) NEXT + (1901) DO FORGET #1 + DO %50 .1 <- 'V.1$.2'~'#0$#65535' + DO .2 <- !2$#0'~'#32767$#1' + PLEASE DO .5 <- "?!2~.2'$#1"~#3 + DO (1902) NEXT + DO (1901) NEXT + (1902) DO (1001) NEXT + DO RETRIEVE .2 + .3 + .5 + PLEASE RESUME #2 + (1910) PLEASE STASH .1 + .3 + .5 + :1 + :2 + :3 + DO .3 <- #65524 + DO :1 <- #6 + DO (1911) NEXT + PLEASE NOTE THAT YOU CAN'T GET THERE FROM HERE + (1912) DO (1001) NEXT + (1911) DO FORGET #1 + PLEASE DO (1900) NEXT + DO :2 <- .1 + DO (1500) NEXT + PLEASE DO :1 <- :3 + DO .1 <- .3 + DO (1020) NEXT + PLEASE DO .3 <- .1 + DO .5 <- '?"!3~.3'~#1"$#2'~#3 + DO (1912) NEXT + DO .1 <- #12 + PLEASE DO (1050) NEXT + DO RETRIEVE .1 + DO (1530) NEXT + DO :2 <- #32768 + DO (1500) NEXT + PLEASE DO .2 <- :3~'#65280$#65280' + PLEASE RETRIEVE .3 + .5 + :1 + :2 + :3 + DO RESUME #1 diff --git a/pit/life.doc b/pit/life.doc new file mode 100644 index 0000000..50c4316 --- /dev/null +++ b/pit/life.doc @@ -0,0 +1,163 @@ + +As documentation for the program life.i, I am including below the original +posting message, with the program itself deleted. The present program +life.i is nearly identical to the one that was posted. The only two +changes are that I have fixed a bug where a 32-bit number was assigned +to a 16-bit variable, and I have streamlined the decrement routine--- +entry points (2000) and (2010)---by eliminating a temporary variable. +The old versions of these code fragments are included at the end of +the file. + + Louis Howell + November 24, 1991 + +----------------------------------------------------------------------------- + +Article: 115 of alt.lang.intercal +From: howell@grover.llnl.gov (Louis Howell) +Newsgroups: alt.lang.intercal +Subject: Life with Intercal (long) +Date: Mon, 28 Jan 91 09:17:36 PST + +I suppose some of you are wondering if anyone ever actually writes anything +in Intercal, or if we all just sit around beating on the compiler and +talking about how wonderful this crock would be if XXX feature were added +to it. I submit the following beast as a demonstration that a vaguely +interesting program can be written in the language. Of course, none of +you can actually RUN this program, since the 0.6 compiler doesn't handle +arrays. Take my word for it that it works, and I promise to finish up +a couple of remaining details in the array implementation and send it +off to Steve Real Soon Now (sometime this week, with luck). + +The program first takes three numbers as input: The dimensions of the +grid and the desired number of time steps. It then accepts pairs of +numbers indicating which cells are live in the initial state; this +list of pairs is terminated by a ZERO or OH. Then it plays Life. +When the final timestep is reached, or when the system overflows the +grid, the program prints out pairs of numbers indicating which cells +were live in the last state reached, followed by the number of time +steps that were actually executed. + +The implementation is not as efficient as it could be by a long shot--- +I just wanted to get something that worked. I use two arrays, ,1 and ,2, +both with dimensions .11 BY .12. At each time step the next position +based on data in ,1 is computed and stored in ,2 for all cells in the +interior of the grid. Then this portion of the grid is copied back +into ,1. (The cells on the edge of the grid are never changed, they just +hold zeroes that are seen by the neighborhood calculations of interior +cells.) Then the current time step is incremented, and if equal to the +desired final time step the program jumps to the output routine. If +not, it checks the ring of cells next in from the edge cells. If it +finds three live cells in a row on one of the interior edges it jumps +to the output routine, since on the next timestep the configuration +would overflow into the boundary ring. Note that this boundary check +is not done until after the first time step, so the user is responsible +for providing an input state that is not about to overflow. + +An overflow recovery procedure that actually increased the size of the +grid might be interesting, but wouldn't be terribly practical since +any configuration that throws off gliders would quickly push it to the +limit. + +The following configuration has four live cells and grows into traffic +lights. To see the blinkers in the other position, change the final +time step from ONE OH to NINE or ONE ONE. + +ONE ONE +ONE ONE +ONE OH +FIVE +SIX +SIX +SIX +SEVEN +SIX +SIX +SEVEN +OH + +This is a glider aimed up the main diagonal. Specifying ZERO for the +final timestep tells the program to run until overflow, since the first +test is at step one. In this case it halts at step XVI with the glider +translated four cells up the diagonal. You can make it run longer by +increasing the dimensions of the array. + +NINE +NINE +ZERO +TWO +FOUR +THREE +FOUR +FOUR +FOUR +FOUR +THREE +THREE +TWO +OH + +Here are a few of the features of the program which may be of interest to +Intercal programmers. One obvious one not mentioned in the manual is the +test for equality: XOR the two numbers and test if the result is zero. +There are many examples of indexed loops. The loops over array indices +fall into two different classes, decrement and branch on zero, and +decrement and branch on equal. The time step loop uses increment and +branch on equal. The nested loop computing the next state has three +indices for each dimension, since it is easier to keep i-1, i and i+1 +around than to recompute them on the fly. This also allows me to use +the simpler branch on zero test at the base of these loops since i-1 was +already available. + +Three new subroutines may be of general interest. Line (2000) is the +entry point for a decrement routine setting .1 <- .1 minus #1. This +is very similar to the increment routine (1020) in the system library, +which I also use. Line (2010) is the decrement and branch on zero +operation. It decrements .1, then if .1 is not zero returns to the +calling point, but if .1 is zero pops an additional entry off the +RESUME stack and returns to that point instead. Line (2020) is an +alternative entry point to the (1020) routine which performs an add +bit operation. It sets .1 <- .1 plus .2, where .2 is already known +to be either #0 or #1. + +The need for some kind of string I/O is painfully obvious. It would be +so much nicer to be able to show the final state using a grid of O's and +.'s instead of having to print out all the coordinates. I have some more +ideas about string I/O which I will post later. + +Enough talk, on with the program: + + + [Program deleted, see life.i for the current version.] + + +This is where the original program had an assignment type error: + + DO .2 <- #0$#65535 + DO .1 <- "?'"V.1$,1SUB.7.8"~.2'$#3"~.2 + DO ,2 SUB .7.8 <- "?!1~.1'$#1"~#1 + +This is the old, less efficient version of the decrement routine: + +(2010) PLEASE ABSTAIN FROM (2004) +(2000) PLEASE STASH .2 + .3 + DO .2 <- #1 + DO (2001) NEXT +(2001) PLEASE FORGET #1 + DO .1 <- '?.1$.2'~'#0$#65535' + DO .3 <- "?!1~.2'$#1"~#3 + DO (2002) NEXT + DO .2 <- !2$#0'~'#32767$#1' + DO (2001) NEXT +(2003) PLEASE RESUME .3 +(2002) DO (2003) NEXT + PLEASE RETRIEVE .2 + .3 +(2004) PLEASE RESUME #2 + PLEASE DO REINSTATE (2004) + PLEASE RESUME '?"!1~.1'~#1"$#2'~#6 + +-- +Louis Howell + + "But when we got into the street I viddied that thinking is for the gloopy +ones and that the oomny ones use like inspiration and what Bog sends." diff --git a/pit/life.i b/pit/life.i new file mode 100644 index 0000000..e58eec1 --- /dev/null +++ b/pit/life.i @@ -0,0 +1,276 @@ + + PLEASE NOTE BEGINNING OF BEGINNING + DO WRITE IN .11 + DO WRITE IN .12 + DO ,1 <- .11 BY .12 + DO ,2 <- .11 BY .12 + DO WRITE IN .13 + DO .14 <- #0 + + PLEASE NOTE INITIALIZING ,1 TO ZEROES + DO .2 <- .11 + DO .1 <- .12 + DO (110) NEXT +(110) PLEASE FORGET #1 + DO ,1 SUB .2.1 <- #0 + DO (111) NEXT +(112) DO (2010) NEXT + PLEASE FORGET #2 + DO (110) NEXT +(111) DO (112) NEXT + DO (113) NEXT +(114) DO .1 <- .2 + DO (2010) NEXT + PLEASE FORGET #3 + DO .2 <- .1 + DO .1 <- .12 + DO (110) NEXT +(113) DO (114) NEXT + PLEASE FORGET #2 + + PLEASE NOTE INITIAL POSITION INPUT + DO (120) NEXT +(120) PLEASE FORGET #1 + DO WRITE IN .1 + DO (121) NEXT + DO WRITE IN .2 + DO ,1 SUB .1.2 <- #1 + DO (120) NEXT +(122) DO RESUME "?!1~.1'$#1"~#3 +(121) DO (122) NEXT + PLEASE FORGET #1 + + PLEASE NOTE END OF BEGINNING, BEGINNING OF MIDDLE + DO (200) NEXT +(200) DO FORGET #1 + + PLEASE NOTE PUTTING NEXT POSITION IN ,2 + DO .1 <- .11 + DO .9 <- .1 + DO (2000) NEXT + DO .7 <- .1 + DO (2000) NEXT + DO .5 <- .1 + DO .1 <- .12 + DO .10 <- .1 + DO (2000) NEXT + DO .8 <- .1 + DO (2000) NEXT + DO .6 <- .1 + DO (210) NEXT +(210) PLEASE FORGET #1 + + DO .1 <- #0 + DO .2 <- ,1 SUB .5.6 + DO (2020) NEXT + DO .2 <- ,1 SUB .5.8 + DO (2020) NEXT + DO .2 <- ,1 SUB .5.10 + DO (2020) NEXT + DO .2 <- ,1 SUB .7.6 + DO (2020) NEXT + DO .2 <- ,1 SUB .7.10 + DO (2020) NEXT + DO .2 <- ,1 SUB .9.6 + DO (2020) NEXT + DO .2 <- ,1 SUB .9.8 + DO (2020) NEXT + DO .2 <- ,1 SUB .9.10 + DO (2020) NEXT + DO :2 <- #0$#65535 + DO .1 <- "?'"V.1$,1SUB.7.8"~:2'$#3"~:2 + DO ,2 SUB .7.8 <- "?!1~.1'$#1"~#1 + + DO (211) NEXT +(212) DO .10 <- .8 + DO .8 <- .6 + DO .1 <- .6 + DO (2010) NEXT + PLEASE FORGET #2 + DO .6 <- .1 + DO (210) NEXT +(211) DO (212) NEXT + DO (213) NEXT +(214) DO .9 <- .7 + DO .7 <- .5 + DO .1 <- .5 + DO (2010) NEXT + PLEASE FORGET #3 + DO .5 <- .1 + DO .1 <- .12 + DO .10 <- .1 + DO (2000) NEXT + DO .8 <- .1 + DO (2000) NEXT + DO .6 <- .1 + DO (210) NEXT +(213) DO (214) NEXT + PLEASE FORGET #2 + + PLEASE NOTE COPYING ,2 BACK INTO ,1 + DO .1 <- .11 + DO (2000) NEXT + DO .2 <- .1 + DO .1 <- .12 + DO (2000) NEXT + DO (220) NEXT +(220) PLEASE FORGET #1 + DO ,1 SUB .2.1 <- ,2 SUB .2.1 + DO (221) NEXT + DO (220) NEXT +(222) DO (2000) NEXT + DO .3 <- "?.1$#1"~"#0$#65535" + PLEASE RESUME '?"!3~.3'~#1"$#1'~#3 +(221) DO (222) NEXT + PLEASE FORGET #1 + DO (223) NEXT + DO .2 <- .1 + DO .1 <- .12 + DO (2000) NEXT + DO (220) NEXT +(224) DO .1 <- .2 + DO (2000) NEXT + DO .3 <- "?.1$#1"~"#0$#65535" + PLEASE RESUME '?"!3~.3'~#1"$#1'~#3 +(223) DO (224) NEXT + PLEASE FORGET #1 + + PLEASE NOTE INCREMENT TIMESTEP AND TEST + DO .1 <- .14 + DO (1020) NEXT + DO .14 <- .1 + DO (231) NEXT + DO (299) NEXT +(232) DO .3 <- "?.14$.13"~"#0$#65535" + PLEASE RESUME '?"!3~.3'~#1"$#2'~#3 +(231) DO (232) NEXT + DO FORGET #1 + + PLEASE NOTE OVERFLOW TESTING + DO .1 <- .11 + DO (2000) NEXT + DO .5 <- .1 + DO .1 <- .12 + DO (2000) NEXT + DO .6 <- .1 + DO .7 <- #0 + DO .8 <- #0 + DO (240) NEXT +(240) PLEASE FORGET #1 + DO .2 <- ,1 SUB #2.6 + DO .1 <- .7 + DO (500) NEXT + DO .7 <- .1 + DO .2 <- ,1 SUB .5.6 + DO .1 <- .8 + DO (500) NEXT + DO .8 <- .1 + DO (241) NEXT + DO .6 <- .1 + DO (240) NEXT +(242) DO .1 <- .6 + DO (2000) NEXT + DO .3 <- "?.1$#1"~"#0$#65535" + PLEASE RESUME '?"!3~.3'~#1"$#1'~#3 +(241) DO (242) NEXT + PLEASE FORGET #1 + + DO .1 <- .11 + DO (2000) NEXT + DO .5 <- .1 + DO .1 <- .12 + DO (2000) NEXT + DO .6 <- .1 + DO .7 <- #0 + DO .8 <- #0 + DO (250) NEXT +(250) PLEASE FORGET #1 + DO .2 <- ,1 SUB .5#2 + DO .1 <- .7 + DO (500) NEXT + DO .7 <- .1 + DO .2 <- ,1 SUB .5.6 + DO .1 <- .8 + DO (500) NEXT + DO .8 <- .1 + DO (251) NEXT + DO .5 <- .1 + DO (250) NEXT +(252) DO .1 <- .5 + DO (2000) NEXT + DO .3 <- "?.1$#1"~"#0$#65535" + PLEASE RESUME '?"!3~.3'~#1"$#1'~#3 +(251) DO (252) NEXT + PLEASE FORGET #1 + + DO (200) NEXT + +(299) DO FORGET #1 + PLEASE NOTE END OF MIDDLE, BEGINNING OF END + + PLEASE NOTE FINAL POSITION OUTPUT + DO .2 <- .11 + DO .1 <- .12 + DO (310) NEXT +(310) PLEASE FORGET #1 + DO (321) NEXT + DO READ OUT .2 + DO READ OUT .1 + DO (323) NEXT +(322) PLEASE RESUME "?',1 SUB .2.1'$#1"~#3 +(321) DO (322) NEXT +(323) PLEASE FORGET #1 + DO (311) NEXT +(312) DO (2010) NEXT + PLEASE FORGET #2 + DO (310) NEXT +(311) DO (312) NEXT + DO (313) NEXT +(314) DO .1 <- .2 + DO (2010) NEXT + PLEASE FORGET #3 + DO .2 <- .1 + DO .1 <- .12 + DO (310) NEXT +(313) DO (314) NEXT + PLEASE FORGET #2 + + DO READ OUT .14 + + PLEASE NOTE END OF END + PLEASE GIVE UP + + +(500) DO (501) NEXT + DO .1 <- #0 + PLEASE RESUME #1 +(502) PLEASE RESUME '?.2$#2'~#3 +(501) DO (502) NEXT + DO (2020) NEXT + DO (503) NEXT + PLEASE RESUME #2 +(504) DO .2 <- "?.1$#3"~"#0$#65535" + PLEASE RESUME '?"!2~.2'~#1"$#1'~#3 +(503) DO (504) NEXT + PLEASE FORGET #3 + DO (299) NEXT + +(2010) PLEASE ABSTAIN FROM (2004) +(2000) PLEASE STASH .2 + DO .2 <- #1 + DO (2001) NEXT +(2001) PLEASE FORGET #1 + DO .1 <- '?.1$.2'~'#0$#65535' + DO (2002) NEXT + DO .2 <- !2$#0'~'#32767$#1' + DO (2001) NEXT +(2003) PLEASE RESUME "?!1~.2'$#1"~#3 +(2002) DO (2003) NEXT + PLEASE RETRIEVE .2 +(2004) PLEASE RESUME #2 + PLEASE DO REINSTATE (2004) + PLEASE RESUME '?"!1~.1'~#1"$#2'~#6 + +(2020) PLEASE STASH .2 + .3 + DO (1021) NEXT + diff --git a/pit/life2.doc b/pit/life2.doc new file mode 100644 index 0000000..2f5fe13 --- /dev/null +++ b/pit/life2.doc @@ -0,0 +1,46 @@ + +life2.i is a revised version of my Life program, differing in two +ways from the original. First, throughout the program I have +streamlined the loops by using COME FROM statements and combining +initialization and re-initialization phases where practical. Second, +instead of just printing the coordinates of live cells, I use the new +binary output feature to print out the board as an array of .'s and +O's. This new output section is made into a subroutine---entry point +(300)---which I call from within the main loop as well as at the end of +the program. If you don't want to see the position at every time step, +just remove the call to (300) from within the main loop, and only the +final position will be printed. + +Notes for programmers: The output routine prints the state matrix a +full line at a time, using a 1-D array one cell longer than a row of +the matrix. This final cell is used to print a line feed (ASCII 012) +at the end of each line. Live cells are represented as O's (0117), +while dead cells are shown as .'s (056). If your machine does not +use ASCII or does not use LF to terminate lines this may not work. +The INTERCAL output routine reverses the order of bits in each of +these characters, so the constants hard-coded into the program are +#242 for 'O', #116 for '.', and #80 for '\n'. The value of the last +character output, which is needed by the Turing Text output model, +is stored in .2. This variable is initialized to #0 and then STASHed +at the beginning of the program, then RETRIEVEd by the output routine +each time it is called. This is opposite from the usual way STASH is +used, but I was feeling a little twisted the day I wrote all this. + +There is still considerable room for improvement in the (300) output +algorithm. With printing at each time step the program spends +roughly two-thirds of its time doing output, and I suspect that +most of that is squandered in the (1010) subtraction routine. It +should be possible to greatly speed up the process by precomputing +and storing all the possible differences. Except for initialization +there are only six to consider: "LF-.", ".-LF", "O-.", ".-O", ".-.", +and "O-O". Of these the first two occur predictably at the beginning +and end of each line, and the last two are trivially zero. The +necessary program logic would be a little more complex; perhaps it +could be done with array indexing? Consider it a challenge! + +Despite all its inefficiencies, the INTERCAL version on a Sparc 1 is +still faster than the first Life program I ever wrote, in BASIC on +a TRS-80, by a factor of about 50. Sobering thought. + + Louis Howell + December 15, 1991 diff --git a/pit/life2.i b/pit/life2.i new file mode 100644 index 0000000..4c800ba --- /dev/null +++ b/pit/life2.i @@ -0,0 +1,268 @@ + + PLEASE NOTE BEGINNING OF BEGINNING + DO WRITE IN .11 + DO WRITE IN .12 + DO ,1 <- .11 BY .12 + DO ,2 <- .11 BY .12 + DO WRITE IN .13 + DO .14 <- #0 + DO .1 <- .11 + DO (1020) NEXT + DO .4 <- .1 + DO ,3 <- .4 + DO .2 <- #0 + PLEASE STASH .2 + + PLEASE NOTE INITIALIZING ,1 TO ZEROES + DO .1 <- .11 + PLEASE COME FROM (116) + DO .2 <- .1 + DO .1 <- .12 + PLEASE COME FROM (113) + DO ,1 SUB .2.1 <- #0 + DO (111) NEXT +(112) DO (2010) NEXT +(113) PLEASE FORGET #2 +(111) DO (112) NEXT + DO (114) NEXT +(115) DO .1 <- .2 + DO (2010) NEXT +(116) PLEASE FORGET #3 +(114) DO (115) NEXT + PLEASE FORGET #2 + + PLEASE NOTE INITIAL POSITION INPUT + PLEASE COME FROM (123) + DO WRITE IN .1 + DO (121) NEXT + DO WRITE IN .2 +(123) DO ,1 SUB .1.2 <- #1 +(122) DO RESUME "?!1~.1'$#1"~#3 +(121) DO (122) NEXT + PLEASE FORGET #1 + + PLEASE NOTE END OF BEGINNING, BEGINNING OF MIDDLE + DO COME FROM (298) + + PLEASE NOTE PRINTING CURRENT POSITION + DO (300) NEXT + + PLEASE NOTE PUTTING NEXT POSITION IN ,2 + DO .1 <- .11 + DO .9 <- .1 + DO (2000) NEXT + DO .7 <- .1 + DO (2000) NEXT + PLEASE COME FROM (216) + DO .5 <- .1 + DO .1 <- .12 + DO .10 <- .1 + DO (2000) NEXT + DO .8 <- .1 + DO (2000) NEXT + PLEASE COME FROM (213) + DO .6 <- .1 + + DO .1 <- #0 + DO .2 <- ,1 SUB .5.6 + DO (2020) NEXT + DO .2 <- ,1 SUB .5.8 + DO (2020) NEXT + DO .2 <- ,1 SUB .5.10 + DO (2020) NEXT + DO .2 <- ,1 SUB .7.6 + DO (2020) NEXT + DO .2 <- ,1 SUB .7.10 + DO (2020) NEXT + DO .2 <- ,1 SUB .9.6 + DO (2020) NEXT + DO .2 <- ,1 SUB .9.8 + DO (2020) NEXT + DO .2 <- ,1 SUB .9.10 + DO (2020) NEXT + DO :2 <- #0$#65535 + DO .1 <- "?'"V.1$,1SUB.7.8"~:2'$#3"~:2 + DO ,2 SUB .7.8 <- "?!1~.1'$#1"~#1 + + DO (211) NEXT +(212) DO .10 <- .8 + DO .8 <- .6 + DO .1 <- .6 + DO (2010) NEXT +(213) PLEASE FORGET #2 +(211) DO (212) NEXT + DO (214) NEXT +(215) DO .9 <- .7 + DO .7 <- .5 + DO .1 <- .5 + DO (2010) NEXT +(216) PLEASE FORGET #3 +(214) DO (215) NEXT + PLEASE FORGET #2 + + PLEASE NOTE COPYING ,2 BACK INTO ,1 + DO .1 <- .11 + DO (2000) NEXT + PLEASE COME FROM (226) + DO .2 <- .1 + DO .1 <- .12 + DO (2000) NEXT + PLEASE COME FROM (223) + DO ,1 SUB .2.1 <- ,2 SUB .2.1 +(223) DO (221) NEXT +(222) DO (2000) NEXT + DO .3 <- "?.1$#1"~"#0$#65535" + PLEASE RESUME '?"!3~.3'~#1"$#1'~#3 +(221) DO (222) NEXT + PLEASE FORGET #1 +(226) DO (224) NEXT +(225) DO .1 <- .2 + DO (2000) NEXT + DO .3 <- "?.1$#1"~"#0$#65535" + PLEASE RESUME '?"!3~.3'~#1"$#1'~#3 +(224) DO (225) NEXT + PLEASE FORGET #1 + + PLEASE NOTE INCREMENT TIMESTEP AND TEST + DO .1 <- .14 + DO (1020) NEXT + DO .14 <- .1 + DO (231) NEXT + DO (299) NEXT +(232) DO .3 <- "?.14$.13"~"#0$#65535" + PLEASE RESUME '?"!3~.3'~#1"$#2'~#3 +(231) DO (232) NEXT + DO FORGET #1 + + PLEASE NOTE OVERFLOW TESTING + DO .7 <- #0 + DO .8 <- #0 + DO .1 <- .11 + DO (2000) NEXT + DO .5 <- .1 + DO .1 <- .12 + DO (2000) NEXT + DO COME FROM (243) + DO .6 <- .1 + DO .2 <- ,1 SUB #2.6 + DO .1 <- .7 + DO (500) NEXT + DO .7 <- .1 + DO .2 <- ,1 SUB .5.6 + DO .1 <- .8 + DO (500) NEXT + DO .8 <- .1 +(243) DO (241) NEXT +(242) DO .1 <- .6 + DO (2000) NEXT + DO .3 <- "?.1$#1"~"#0$#65535" + PLEASE RESUME '?"!3~.3'~#1"$#1'~#3 +(241) DO (242) NEXT + PLEASE FORGET #1 + + DO .7 <- #0 + DO .8 <- #0 + DO .1 <- .12 + DO (2000) NEXT + DO .6 <- .1 + DO .1 <- .11 + DO (2000) NEXT + DO COME FROM (253) + DO .5 <- .1 + DO .2 <- ,1 SUB .5#2 + DO .1 <- .7 + DO (500) NEXT + DO .7 <- .1 + DO .2 <- ,1 SUB .5.6 + DO .1 <- .8 + DO (500) NEXT + DO .8 <- .1 +(253) DO (251) NEXT +(252) DO .1 <- .5 + DO (2000) NEXT + DO .3 <- "?.1$#1"~"#0$#65535" + PLEASE RESUME '?"!3~.3'~#1"$#1'~#3 +(251) DO (252) NEXT +(298) PLEASE FORGET #1 + +(299) DO FORGET #1 + PLEASE NOTE END OF MIDDLE, BEGINNING OF END + + PLEASE NOTE PRINTING FINAL POSITION + DO (300) NEXT + + PLEASE NOTE END OF END + PLEASE GIVE UP + + +(300) PLEASE NOTE POSITION OUTPUT ROUTINE + DO READ OUT .14 + PLEASE RETRIEVE .2 + DO .6 <- .12 + PLEASE COME FROM (316) + DO .5 <- #1 + PLEASE COME FROM (313) + DO .1 <- .2 + DO (301) NEXT + DO .2 <- #242 + DO (303) NEXT +(302) PLEASE RESUME "?',1 SUB .5.6'$#1"~#3 +(301) DO (302) NEXT + DO .2 <- #116 +(303) PLEASE FORGET #1 + DO (1010) NEXT + DO ,3 SUB .5 <- .3 +(313) DO (311) NEXT +(312) DO .1 <- .5 + DO (1020) NEXT + DO .5 <- .1 + DO .3 <- "?.5$.4"~"#0$#65535" + PLEASE RESUME '?"!3~.3'~#1"$#1'~#3 +(311) DO (312) NEXT + DO .1 <- .2 + DO .2 <- #80 + DO (1010) NEXT + DO ,3 SUB .4 <- .3 + PLEASE READ OUT ,3 + DO (314) NEXT +(315) DO .1 <- .6 + DO (2010) NEXT + PLEASE FORGET #3 +(316) DO .6 <- .1 +(314) DO (315) NEXT + DO PLEASE STASH .2 + PLEASE RESUME #3 + +(500) DO (501) NEXT + DO .1 <- #0 + PLEASE RESUME #1 +(502) PLEASE RESUME '?.2$#2'~#3 +(501) DO (502) NEXT + DO (2020) NEXT + DO (503) NEXT + PLEASE RESUME #2 +(504) DO .2 <- "?.1$#3"~"#0$#65535" + PLEASE RESUME '?"!2~.2'~#1"$#1'~#3 +(503) DO (504) NEXT + PLEASE FORGET #3 + DO (299) NEXT + +(2010) PLEASE ABSTAIN FROM (2004) +(2000) PLEASE STASH .2 + DO .2 <- #1 + DO (2001) NEXT +(2001) PLEASE FORGET #1 + DO .1 <- '?.1$.2'~'#0$#65535' + DO (2002) NEXT + DO .2 <- !2$#0'~'#32767$#1' + DO (2001) NEXT +(2003) PLEASE RESUME "?!1~.2'$#1"~#3 +(2002) DO (2003) NEXT + PLEASE RETRIEVE .2 +(2004) PLEASE RESUME #2 + PLEASE DO REINSTATE (2004) + PLEASE RESUME '?"!1~.1'~#1"$#2'~#6 + +(2020) PLEASE STASH .2 + .3 + DO (1021) NEXT + diff --git a/pit/pi.doc b/pit/pi.doc new file mode 100644 index 0000000..a5244c1 --- /dev/null +++ b/pit/pi.doc @@ -0,0 +1,107 @@ +From howell@grover.llnl.gov (Louis Howell) Fri Jan 3 12:31:20 1992 +From: howell@grover.llnl.gov (Louis Howell) +Path: snark!cbmvax!uunet!uunet!spool.mu.edu!agate!bionet!raven.alaska.edu!lll-winken!grover.llnl.gov!howell +Newsgroups: alt.lang.intercal +Subject: pi.doc +Message-ID: <114696@lll-winken.LLNL.GOV> +Date: 3 Jan 92 17:31:20 GMT +Date-Received: 4 Jan 92 11:08:10 GMT +Sender: usenet@lll-winken.LLNL.GOV +Distribution: world +Organization: Lawrence Livermore National Laboratory +Nntp-Posting-Host: grover.llnl.gov +Lines: 91 + +Those of you who've bothered to actually run the "mystery program" I +posted last week will have realized that it prints out digits of pi. +If you didn't get it, never fear. Eric is putting it into his new +0.8 release, which he is eager to finish soon. The program is pi.i, +and the stuff below this line is pi.doc: + +--------------- + +pi.i is easily the most twisted and obscure INTERCAL program I've yet +written. I say that because even I don't fully understand why it +works. The program writes in one number from the input, then prints +out that many digits of pi. There are no fancy INTERCAL tricks here; +all it does is simple integer arithmetic. + +The algorithm used comes from an old TECO macro that was recently +discussed on alt.lang.teco. Mark Henderson posted a translation +into C, which at least made it easier to read, if not much easier to +understand. I played around with that program a bit, fixed a couple +of minor bugs which may or may not have existed in the original TECO, +and modified it a bit to put in into a form that would be easy to +translate into INTERCAL. That modified program, which corresponds +closely to the algorithm in pi.i, is reproduced at the end of this +file. + +The INTERCAL version has only been tested up to a hundred digits, +which took almost 30 minutes on a Sparc 1. The C version below, +with variables declared unsigned short to correspond to the INTERCAL, +gives up to 535 accurate digits and then starts printing garbage, +presumably because of an overflow. If the declarations are changed +to short only the first 262 digits are accurate, while using int +yields thousands of accurate digits. Though I don't understand +what the inner loop is doing, it looks like the largest numbers +encountered are O(n), where n is the number of digits requested. +If, as I expect, the present INTERCAL version does fail after about +535 digits, it could easily be converted to a 32-bit form which +would run as long as almost anyone would desire. + +The only feature likely to be of utility in other INTERCAL programs +is the new (2030) routine, which performs a 16-bit division with +remainder. It is faster than the (1040) routine for two reasons: +First, it is a true 16-bit version, whereas the (1040) routine just +shifts over its operands and then calls the 32-bit division routine +(1550). Second, the (1550) routine generates a remainder as part of +the computation, but then simply throws it away. I needed the +remainder, so I have my (2030) routine return it in .4 and the +quotient in .3. In other respects this is just a 16-bit translation +of the (1550) routine. + + Louis Howell + December 30, 1991 + + + +#include +unsigned short line[10000]; +main(argc,argv) +int argc; +char *argv[]; +{ + unsigned short n, a, i, q, v, dummy, h=0, w=0; + + if (argc==2) + n=atoi(argv[1]); + else + n=20; + + n+=2; + + for (i=(n*10)/3 ; i > 0 ; i--) { + line[i-1] = 2; + } + + for (dummy=0; dummy < n; dummy++) { + q=0; + for (i=(n*10)/3 ; i > 0 ; i--) { + a = line[i-1] * 10 + (q*i); + q=a/(i*2-1); + line[i-1] = a%(i*2-1); + } + v = w; + w = h+(q/10); + h = q%10; + if (w==10) { + w=0; + v++; + } + if (dummy!=0) + printf("%d", v); + } + printf("\n"); +} + + diff --git a/pit/pi.i b/pit/pi.i new file mode 100644 index 0000000..e133d7a --- /dev/null +++ b/pit/pi.i @@ -0,0 +1,137 @@ + PLEASE WRITE IN .10 + DO .1 <- .10~#65534 + DO (1020) NEXT + DO .10 <- !1$.10'~'#32767$#1' + DO .1 <- .10 + DO .2 <- #10 + PLEASE DO (1030) NEXT + DO .1 <- .3 + DO .2 <- #3 + DO (1040) NEXT + DO .9 <- .3 + + DO ,1 <- .9 + DO .1 <- .9 + PLEASE COME FROM (13) + DO ,1 SUB .1 <- #2 + DO (11) NEXT +(12) DO (2010) NEXT +(13) PLEASE FORGET #2 +(11) DO (12) NEXT + + DO .15 <- #0 + DO .16 <- #0 + DO (100) NEXT + DO .1 <- .10 + DO (2000) NEXT + PLEASE COME FROM (23) + DO .10 <- .1 + DO (100) NEXT + PLEASE READ OUT .17 + DO .1 <- .10 + DO (21) NEXT +(22) DO (2010) NEXT +(23) PLEASE FORGET #2 +(21) DO (22) NEXT + PLEASE FORGET #2 + PLEASE GIVE UP + +(100) DO .14 <- #0 + DO .12 <- .9 + PLEASE COME FROM (103) + DO .1 <- .14 + DO .2 <- .12 + DO (1030) NEXT + DO .14 <- .3 + DO .1 <- ,1 SUB .12 + DO .2 <- #10 + DO (1030) NEXT + DO .1 <- .3 + DO .2 <- .14 + DO (1000) NEXT + DO .1 <- !12$#0'~'#32767$#1' + DO (2000) NEXT + DO .2 <- .1 + DO .1 <- .3 + DO (2030) NEXT + DO .14 <- .3 + DO ,1 SUB .12 <- .4 + DO .1 <- .12 + DO (101) NEXT +(102) DO (2010) NEXT + DO .12 <- .1 +(103) PLEASE FORGET #2 +(101) DO (102) NEXT + DO .17 <- .16 + DO .1 <- .14 + DO .2 <- #10 + DO (2030) NEXT + DO .1 <- .15 + DO .2 <- .3 + DO (1000) NEXT + DO .16 <- .3 + DO .15 <- .4 + DO .5 <- '?.16$#10'~#85 + DO .5 <- "?!5~.5'$#2"~#3 + DO (104) NEXT + DO .16 <- #0 + DO .1 <- .17 + DO (1020) NEXT + DO .17 <- .1 + PLEASE RESUME #2 +(104) DO (1001) NEXT + PLEASE RESUME #3 + + +(2010) PLEASE ABSTAIN FROM (2004) +(2000) PLEASE STASH .2 + DO .2 <- #1 + DO (2001) NEXT +(2001) PLEASE FORGET #1 + DO .1 <- '?.1$.2'~'#0$#65535' + DO (2002) NEXT + DO .2 <- !2$#0'~'#32767$#1' + DO (2001) NEXT +(2003) PLEASE RESUME "?!1~.2'$#1"~#3 +(2002) DO (2003) NEXT + PLEASE RETRIEVE .2 +(2004) PLEASE RESUME #2 + PLEASE DO REINSTATE (2004) + PLEASE RESUME '?"!1~.1'~#1"$#2'~#6 +(2020) PLEASE STASH .2 + .3 + DO (1021) NEXT +(2030) DO STASH .1 + .5 + DO .3 <- #0 + DO .5 <- '?"!2~.2'~#1"$#1'~#3 + PLEASE DO (2031) NEXT + DO .4 <- #1 + PLEASE DO (2033) NEXT +(2033) DO FORGET #1 + DO .5 <- '?".2~#32768"$#2'~#3 + DO (2032) NEXT + DO .2 <- !2$#0'~'#32767$#1' + PLEASE DO .4 <- !4$#0'~'#32767$#1' + DO (2033) NEXT +(2032) DO (1001) NEXT +(2036) PLEASE FORGET #1 + DO .5 <- '?.1$.2'~'#0$#65535' + DO .5 <- '?"'&"!2~.5'~'"?'?.5~.5'$#32768"~"#0$#65535"'"$ + ".5~.5"'~#1"$#2'~#3 + DO (2034) NEXT + DO .5 <- .3 + DO (1010) NEXT + PLEASE DO .1 <- .3 + DO .3 <- 'V.4$.5'~'#0$#65535' + DO (2035) NEXT +(2034) PLEASE DO (1001) NEXT +(2035) DO FORGET #1 + DO .5 <- "?'.4~#1'$#2"~#3 + DO (2031) NEXT + DO .2 <- .2~#65534 + DO .4 <- .4~#65534 + PLEASE DO (2036) NEXT +(2031) DO (1001) NEXT + PLEASE DO .4 <- .1 + PLEASE RETRIEVE .1 + .5 + PLEASE RESUME #2 + PLEASE NOTE THAT YOU DON'T HAVE TO APPEND STANDARD LIBRARY HERE diff --git a/pit/primes.doc b/pit/primes.doc new file mode 100644 index 0000000..6e9b1b3 --- /dev/null +++ b/pit/primes.doc @@ -0,0 +1,18 @@ +primes.i is a simple program for printing out a list of prime numbers. +It has an outer loop variable .11 and an inner loop variable .13, both +of which start at #3 and advance through odd numbers. .13 contains the +numbers being tested as possible divisors of .11, which is the number +being tested for primality. Each time through the inner loop a 16-bit +division with remainder routine (2030) is called to divide .11 by .13. +If .13 is greater than the quotient then .11 is known to be prime and +is printed out. If the remainder is #0, on the other hand, then .11 +is known to be composite and the inner loop is terminated prematurely. + +The termination test for the outer loop is controlled by statement (22), +which tests to see if the high bit of (.11-#1)/#2 is set. You can +modify this statement to test some other bit if you want the program +to terminate sooner. It took over 17 hours on a Sparc 1 for this +program to find all 16-bit primes. + + Louis Howell + December 30, 1991 diff --git a/pit/primes.i b/pit/primes.i new file mode 100644 index 0000000..48ad322 --- /dev/null +++ b/pit/primes.i @@ -0,0 +1,86 @@ + DO READ OUT #2 + DO .10 <- #1 + PLEASE COME FROM (23) + DO .11 <- !10$#1'~'#32767$#1' + DO .12 <- #1 + PLEASE COME FROM (16) + DO .13 <- !12$#1'~'#32767$#1' + DO .1 <- .11 + DO .2 <- .13 + DO (2030) NEXT + DO (11) NEXT +(15) DO (13) NEXT +(13) DO .3 <- "?!4~.4'$#2"~#3 + DO (14) NEXT + PLEASE FORGET #1 + DO .1 <- .12 + DO (1020) NEXT +(16) DO .12 <- .1 +(12) DO .3 <- '?.2$.3'~'#0$#65535' + DO .3 <- '?"'&"!2~.3'~'"?'?.3~.3'$#32768"~"#0$#65535"'"$ + ".3~.3"'~#1"$#2'~#3 +(14) PLEASE RESUME .3 +(11) DO (12) NEXT + DO FORGET #1 + PLEASE READ OUT .11 + DO COME FROM (15) + DO .1 <- .10 + DO (1020) NEXT + DO .10 <- .1 +(23) DO (21) NEXT +(22) PLEASE RESUME "?!10~#32768'$#2"~#3 +(21) DO (22) NEXT + DO FORGET #1 + PLEASE GIVE UP + +(2010) PLEASE ABSTAIN FROM (2004) +(2000) PLEASE STASH .2 + DO .2 <- #1 + DO (2001) NEXT +(2001) PLEASE FORGET #1 + DO .1 <- '?.1$.2'~'#0$#65535' + DO (2002) NEXT + DO .2 <- !2$#0'~'#32767$#1' + DO (2001) NEXT +(2003) PLEASE RESUME "?!1~.2'$#1"~#3 +(2002) DO (2003) NEXT + PLEASE RETRIEVE .2 +(2004) PLEASE RESUME #2 + PLEASE DO REINSTATE (2004) + PLEASE RESUME '?"!1~.1'~#1"$#2'~#6 +(2020) PLEASE STASH .2 + .3 + DO (1021) NEXT +(2030) DO STASH .1 + .5 + DO .3 <- #0 + DO .5 <- '?"!2~.2'~#1"$#1'~#3 + PLEASE DO (2031) NEXT + DO .4 <- #1 + PLEASE DO (2033) NEXT +(2033) DO FORGET #1 + DO .5 <- '?".2~#32768"$#2'~#3 + DO (2032) NEXT + DO .2 <- !2$#0'~'#32767$#1' + PLEASE DO .4 <- !4$#0'~'#32767$#1' + DO (2033) NEXT +(2032) DO (1001) NEXT +(2036) PLEASE FORGET #1 + DO .5 <- '?.1$.2'~'#0$#65535' + DO .5 <- '?"'&"!2~.5'~'"?'?.5~.5'$#32768"~"#0$#65535"'"$ + ".5~.5"'~#1"$#2'~#3 + DO (2034) NEXT + DO .5 <- .3 + DO (1010) NEXT + PLEASE DO .1 <- .3 + DO .3 <- 'V.4$.5'~'#0$#65535' + DO (2035) NEXT +(2034) PLEASE DO (1001) NEXT +(2035) DO FORGET #1 + DO .5 <- "?'.4~#1'$#2"~#3 + DO (2031) NEXT + DO .2 <- .2~#65534 + DO .4 <- .4~#65534 + PLEASE DO (2036) NEXT +(2031) DO (1001) NEXT + PLEASE DO .4 <- .1 + PLEASE RETRIEVE .1 + .5 + PLEASE RESUME #2 diff --git a/pit/random.doc b/pit/random.doc new file mode 100644 index 0000000..1769090 --- /dev/null +++ b/pit/random.doc @@ -0,0 +1,23 @@ + DO (1900) NEXT + DO READ OUT .1 + PLEASE GIVE UP +(1900) DO STASH .2 + .3 + DO .3 <- #65535 + DO (1903) NEXT +(1903) PLEASE FORGET #1 + DO .2 <- #0 + PLEASE %50 IGNORE .2 + DO .2 <- #1 + PLEASE REMEMBER .2 + DO .1 <- !1$.2'~"#65535$#1" + DO .3 <- .3~#65534 + DO (1902) NEXT + DO (1903) NEXT +(1902) DO (1904) NEXT + DO RETRIEVE .2 + .3 + DO FORGET #1 + PLEASE RESUME #1 +(1904) PLEASE RESUME '?"!3~.3'~#1"$#1'~#3 + +Random.i: Store a random number between 0 and 65535 in .1 + (blojo@ocf.berkeley.edu) diff --git a/pit/random.i b/pit/random.i new file mode 100644 index 0000000..38b37e7 --- /dev/null +++ b/pit/random.i @@ -0,0 +1,20 @@ + DO (1900) NEXT + DO READ OUT .1 + PLEASE GIVE UP +(1900) DO STASH .2 + .3 + DO .3 <- #65535 + DO (1903) NEXT +(1903) PLEASE FORGET #1 + DO .2 <- #0 + PLEASE %50 IGNORE .2 + DO .2 <- #1 + PLEASE REMEMBER .2 + DO .1 <- !1$.2'~"#65535$#1" + DO .3 <- .3~#65534 + DO (1902) NEXT + DO (1903) NEXT +(1902) DO (1904) NEXT + DO RETRIEVE .2 + .3 + DO FORGET #1 + PLEASE RESUME #1 +(1904) PLEASE RESUME '?"!3~.3'~#1"$#1'~#3 diff --git a/pit/sample.i b/pit/sample.i new file mode 100644 index 0000000..d173b72 --- /dev/null +++ b/pit/sample.i @@ -0,0 +1,28 @@ + DO (5) NEXT + (5) DO FORGET #1 + PLEASE WRITE IN :1 + DO .1 <- '?":1~'#32768$#0'"$#1'~#3 + DO (1) NEXT + DO :1 <- "'?":1~'#65535$#0'"$#65535' + ~'#0$#65535'"$"'?":1~'#0$#65535'" + $#65535'~'#0$#65535'" + DO :2 <- #1 + PLEASE DO (4) NEXT + (4) DO FORGET #1 + DO .1 <- "?':1~:2'$#1"~#3 + DO :1 <- "'?":1~'#65535$#0'"$":2~'#65535 + $#0'"'~'#0$#65535'"$"'?":1~'#0 + $#65535'"$":2~'#0$#65535'"'~'#0$#65535'" + DO (1) NEXT + DO :2 <- ":2~'#0$#65535'" + $"'":2~'#65535$#0'"$#0'~'#32767$#1'" + DO (4) NEXT + (2) DO RESUME .1 + (1) PLEASE DO (2) NEXT + PLEASE FORGET #1 + DO READ OUT :1 + PLEASE DO .1 <- '?"':1~:1'~#1"$#1'~#3 + DO (3) NEXT + PLEASE DO (5) NEXT + (3) DO (2) NEXT + PLEASE GIVE UP diff --git a/pit/sink.doc b/pit/sink.doc new file mode 100644 index 0000000..c268888 --- /dev/null +++ b/pit/sink.doc @@ -0,0 +1,5 @@ +(1999) PLEASE DO (1999) NEXT + +Sink.i: A program I wrote just to see if the guy who wrote the compiler + was faithful. :) + (blojo@ocf.berkeley.edu) diff --git a/pit/sink.i b/pit/sink.i new file mode 100644 index 0000000..2d4c8e2 --- /dev/null +++ b/pit/sink.i @@ -0,0 +1,3 @@ +(1999) PLEASE DO (1999) NEXT + DO NOTE THAT YOU CAN'T GET HERE FROM THERE + DO ANYTHING YOU WANT ON THIS LINE, IT WON'T HAPPEN ANYWAY diff --git a/pit/t_tet b/pit/t_tet new file mode 100644 index 0000000..54106e6 --- /dev/null +++ b/pit/t_tet @@ -0,0 +1,12 @@ +ONE ONE +ONE ONE +ONE OH +FIVE +SIX +SIX +SIX +SEVEN +SIX +SIX +SEVEN +OH diff --git a/pit/testcompile b/pit/testcompile new file mode 100755 index 0000000..5dd5a08 --- /dev/null +++ b/pit/testcompile @@ -0,0 +1,8 @@ +# +# testcompile -- testcompile all named sources using ick: +# +for x in $* +do + echo "Test-compiling $x"; + ../src/ick $x; +done diff --git a/pit/tests/limits.3i b/pit/tests/limits.3i new file mode 100644 index 0000000..3abd646 --- /dev/null +++ b/pit/tests/limits.3i @@ -0,0 +1,5 @@ + PLEASE DO .1 <- #59048 + DO :1 <- #59048 + DO WRITE IN .1 + :1 + DO READ OUT .1 + :1 + PLEASE GIVE UP diff --git a/pit/tests/limits.i b/pit/tests/limits.i new file mode 100644 index 0000000..5ea5522 --- /dev/null +++ b/pit/tests/limits.i @@ -0,0 +1,5 @@ + PLEASE DO .1 <- #65535 + DO :1 <- #65535 + DO WRITE IN .1 + :1 + DO READ OUT .1 + :1 + PLEASE GIVE UP diff --git a/pit/tests/test1.i b/pit/tests/test1.i new file mode 100644 index 0000000..7e94426 --- /dev/null +++ b/pit/tests/test1.i @@ -0,0 +1,83 @@ + PLEASE DO (1) NEXT + DO ERROR: NEXTING NOT WORKING + DO SECTION A: CONTROL FLOW +(1) DO FORGET #1 + DO .1 <- #2 + PLEASE DO (2) NEXT + DO (11) NEXT + DO ERROR: IGNORING NOT WORKING +(7) DO FORGET #2 + DO REMEMBER .1 + DO .1 <- #2 + DO (12) NEXT + DO ABSTAIN FROM (50) +(50) PLEASE DO (51) NEXT + DO ABSTAIN FROM (52) + DO REINSTATE (52) +(52) PLEASE DO (123) NEXT + DO ERROR: LABEL REINSTATING NOT WORKING +(123) PLEASE DO FORGET #1 + DO .1 <- #2 + DO STASH .1 + DO .1 <- #1 + DO RETRIEVE .1 + PLEASE DO (125) NEXT + PLEASE DO (124) NEXT +(125) PLEASE DO (126) NEXT + DO ERROR: RETRIEVING OR STASHING NOT WORKING +(126) DO RESUME .1 + DO ERROR +(12) PLEASE DO (13) NEXT + DO ERROR: REMEMBERING NOT WORKING +(13) DO RESUME .1 + DO ERROR +(11) PLEASE DO (111) NEXT + DO (7) NEXT +(111) DO .1 <- #1 + DO IGNORE .1 + DO .1 <- #2 + DO RESUME .1 +(2) DO (5) NEXT + DO ERROR +(5) DO RESUME .1 + DO ERROR: RESUMING NOT WORKING +(51) DO ERROR: LABEL ABSTENTION NOT WORKING + DO SECTION B: CALCULATION +(124) PLEASE FORGET #1 + DO .1 <- #3 + DO .1 <- .&1 + PLEASE DO (501) NEXT + DO ERROR IN & OPERATION +(501) PLEASE DO (502) NEXT + DO ERROR IN & OPERATION +(502) PLEASE DO (603) NEXT + DO FORGET #2 + DO .1 <- #2 + DO .1 <- .V1 + PLEASE DO (601) NEXT + DO .2 <- #32773 + DO .2 <- .?2 + DO .2 <- .&2 + PLEASE DO (701) NEXT + DO .1 <- #7~#5 + PLEASE DO (901) NEXT + DO .1 <- #1$#0 + DO (950) NEXT + DO THIS TEST HAS BEEN SUCCESSFULLY COMPLETED +(950) PLEASE DO (951) NEXT + DO ERROR IN $'ING +(951) DO RESUME .1 +(901) PLEASE DO (902) NEXT + DO ~ ERROR +(902) PLEASE DO (903) NEXT + DO ~ ERROR +(903) DO RESUME .1 +(701) PLEASE DO (702) NEXT + DO ERROR IN ? XOR OPERATION +(702) PLEASE DO (603) NEXT + DO ERROR IN ? XOR OPERATION +(601) PLEASE DO (602) NEXT + DO ERROR IN V OPERATION +(602) PLEASE DO (603) NEXT + DO ERROR IN V OPERATION +(603) DO RESUME .1 diff --git a/pit/tests/test16bit.i b/pit/tests/test16bit.i new file mode 100644 index 0000000..7704939 --- /dev/null +++ b/pit/tests/test16bit.i @@ -0,0 +1,7 @@ + PLEASE DO .1 <- #1$'#1$#0' + DO READ OUT .1 + DO .1 <- #32768$'#1$#32768' + DO READ OUT .1 + DO :1 <- #32768$'#1$#32768' + DO READ OUT :1 + PLEASE DO GIVE UP diff --git a/pit/tests/test2.i b/pit/tests/test2.i new file mode 100644 index 0000000..09fe111 --- /dev/null +++ b/pit/tests/test2.i @@ -0,0 +1,187 @@ +DO WRITE IN .1 +DO WRITE IN .2 +DO (1030) NEXT +DO READ OUT .3 +DO GIVE UP +(1000) PLEASE IGNORE .4 + PLEASE ABSTAIN FROM (1005) +(1009) DO STASH .1 + .2 + .5 + .6 + DO .4 <- #1 + DO (1004) NEXT +(1004) PLEASE FORGET #1 + DO .3 <- '?.1$.2'~'#0$#65535' + DO .6 <- '&.1$.2'~'#0$#65535' + PLEASE DO .5 <- "?!6~#32768'$#1"~#3 + DO (1002) NEXT + DO .4 <- #2 +(1005) DO (1006) NEXT +(1999) DOUBLE OR SINGLE PRECISION OVERFLOW +(1002) DO (1001) NEXT +(1006) PLEASE FORGET #1 + DO .5 <- '?"!6~.6'~#1"$#1'~#3 + DO (1003) NEXT + DO .1 <- .3 + DO .2 <- !6$#0'~'#32767$#1' + DO (1004) NEXT +(1003) DO (1001) NEXT + DO REINSTATE (1005) +(1007) PLEASE RETRIEVE .1 + .2 + .5 + .6 + DO REMEMBER .4 + PLEASE RESUME #2 +(1001) DO RESUME .5 +(1010) DO STASH .1 + .2 + .4 + DO .4 <- .1 + DO .1 <- '?.2$#65535'~'#0$#65535' + DO (1020) NEXT + PLEASE DO .2 <- .4 + PLEASE DO (1009) NEXT + DO RETRIEVE .1 + .2 + .4 + PLEASE RESUME #1 +(1020) DO STASH .2 + .3 + DO .2 <- #1 + PLEASE DO (1021) NEXT +(1021) DO FORGET #1 + DO .3 <- "?!1~.2'$#1"~#3 + PLEASE DO .1 <- '?.1$.2'~'#0$#65535' + DO (1022) NEXT + DO .2 <- !2$#0'~'#32767$#1' + DO (1021) NEXT +(1023) PLEASE RESUME .3 +(1022) DO (1023) NEXT + PLEASE RETRIEVE .2 + .3 + PLEASE RESUME #2 +(1030) DO ABSTAIN FROM (1033) + PLEASE ABSTAIN FROM (1032) +(1039) DO STASH :1 + .5 + DO (1530) NEXT + DO .3 <- :1~#65535 + PLEASE DO .5 <- :1~'#65280$#65280' + DO .5 <- '?"!5~.5'~#1"$#1'~#3 + DO (1031) NEXT +(1032) DO (1033) NEXT + DO (1999) NEXT +(1031) DO (1001) NEXT +(1033) DO .4 <- .5 + DO REINSTATE (1032) + PLEASE REINSTATE (1033) + DO RETRIEVE :1 + .5 + PLEASE RESUME #2 +(1500) PLEASE ABSTAIN FROM (1502) + PLEASE ABSTAIN FROM (1506) +(1509) PLEASE STASH :1 + .1 + .2 + .3 + .4 + .5 + .6 + DO .1 <- :1~#65535 + PLEASE DO .2 <- :2~#65535 + DO (1009) NEXT + DO .5 <- .3 + PLEASE DO .6 <- .4 + DO .1 <- :1~'#65280$#65280' + DO .2 <- :2~'#65280$#65280' + DO (1009) NEXT + DO .1 <- .3 + PLEASE DO (1503) NEXT + DO .6 <- .4 + DO .2 <- #1 + DO (1009) NEXT + DO .1 <- .3 + DO (1501) NEXT +(1504) PLEASE RESUME .6 +(1503) DO (1504) NEXT +(1501) DO .2 <- .5 + DO .5 <- '?"'&.6$.4'~#1"$#2'~#3 + DO (1505) NEXT +(1506) DO (1502) NEXT + PLEASE DO (1999) NEXT +(1505) DO (1001) NEXT +(1502) DO :4 <- .5 + DO (1520) NEXT + DO :3 <- :1 + PLEASE RETRIEVE :1 + .1 + .2 + .3 + .4 + .5 + .6 + DO REINSTATE (1502) + DO REINSTATE (1506) + PLEASE RESUME #3 +(1510) DO STASH :1 + :2 + :4 + DO :1 <- "'?":2~'#65535$#0'"$#65535'~'#0$#65535 +'"$"'?":2~'#0$#65535'"$#65535'~'#0$#65535'" + DO :2 <- #1 + DO (1509) NEXT + PLEASE RETRIEVE :1 + DO :2 <- :3 + PLEASE DO (1509) NEXT + DO RETRIEVE :2 + :4 + PLEASE RESUME #1 +(1520) PLEASE STASH .3 + .4 + DO .3 <- .1~#43690 + DO (1525) NEXT + PLEASE DO .4 <- 'V.3$".2~#43690"'~'#0$#65535' + DO .3 <- .1~#21845 + PLEASE DO (1525) NEXT + DO :1 <- .4$"'V.3$".2~#21845"'~'#0$#65535'" + PLEASE RETRIEVE .3 + .4 + DO RESUME #1 +(1525) DO .3 <- '"'"'"!3$#0'~'#32767$#1'"$#0'~'#32767 +$#1'"$#0'~'#16383$#3'"$#0'~'#4095$#15' + PLEASE RESUME #1 +(1530) DO STASH :2 + :3 + .3 + .5 + DO :1 <- #0 + DO :2 <- .2 + DO .3 <- #1 + DO (1535) NEXT +(1535) PLEASE FORGET #1 + DO .5 <- "?!1~.3'$#1"~#3 + DO (1531) NEXT + DO (1500) NEXT + DO :1 <- :3 + PLEASE DO (1533) NEXT +(1531) PLEASE DO (1001) NEXT +(1533) DO FORGET #1 + DO .3 <- !3$#0'~'#32767$#1' + DO :2 <- ":2~'#0$#65535'"$"'":2~'#32767$#0'"$# +0'~'#32767$#1'" + PLEASE DO .5 <- "?!3~.3'$#1"~#3 + DO (1532) NEXT + DO (1535) NEXT +(1532) DO (1001) NEXT + PLEASE RETRIEVE :2 + :3 + .3 + .5 + DO RESUME #2 +(1540) PLEASE ABSTAIN FROM (1541) + DO ABSTAIN FROM (1542) +(1549) PLEASE STASH :1 + :2 + :4 + :5 + .1 + .2 + .5 + DO .1 <- :1~#65535 + PLEASE DO .2 <- :2~'#65280$#65280' + DO .5 <- :1~'#65280$#65280' + DO (1530) NEXT + DO :3 <- :1 + DO .2 <- :2~#65535 + PLEASE DO (1530) NEXT + DO :5 <- :1 + DO .1 <- .5 + DO (1530) NEXT + DO :4 <- :1 + PLEASE DO :1 <- ":3~'#65280$#65280'"$":5~'#65280$#65280'" + DO .5 <- ':1~:1'~#1 + DO .2 <- :2~'#65280$#65280' + DO (1530) NEXT + PLEASE DO .5 <- '"':1~:1'~#1"$.5'~#3 + DO .1 <- :3~#65535 + DO .2 <- #0 + DO (1520) NEXT + PLEASE DO :2 <- :1 + PLEASE DO .1 <- :4~#65535 + DO (1520) NEXT + DO (1509) NEXT + DO .5 <- !5$":4~#3"'~#15 + DO :1 <- :3 + DO :2 <- :5 + DO (1509) NEXT + PLEASE DO .5 <- !5$":4~#3"'~#63 + DO .5 <- '?"!5~.5'~#1"$#1'~#3 + PLEASE RETRIEVE :4 +(1541) DO :4 <- .5 + DO (1543) NEXT +(1542) DO (1544) NEXT + PLEASE DO (1999) NEXT +(1543) DO (1001) NEXT +(1544) DO REINSTATE (1541) + PLEASE REINSTATE (1542) + PLEASE RETRIEVE :1 + :2 + :5 + .1 + .2 + .5 + DO RESUME #2 diff --git a/pit/tests/testarray.i b/pit/tests/testarray.i new file mode 100644 index 0000000..944c694 --- /dev/null +++ b/pit/tests/testarray.i @@ -0,0 +1,24 @@ + PLEASE DO ,1 <- #3 BY #3 + DO ;2 <- #6 + DO ,2 <- #6 + DO .1 <- #1 + DO .2 <- #1 + DO ,1 SUB .2.1 <- #1 + DO ;2 SUB #5 <- #1 + DO .1 <- "?',1 SUB .2.1'$#1"~#3 + DO .2 <- ,1 SUB #1 ;2 SUB #5 + DO .1 <- .2~,1 SUB #1 #1 + PLEASE STASH .1 + ,2 + ;2 + ,1 + ,3 + DO ,1 <- #500 + DO ,1 SUB #1 <- #112 + PLEASE DO READ OUT ,1 SUB .2 + PLEASE RETRIEVE ,2 + ,1 + ,3 + DO .1 <- #?1 + DO .1 <- .?1 + PLEASE DO READ OUT ,1 SUB #1 #1 + DO .1 <- .2$,&1 SUB #1 #1 + PLEASE DO READ OUT .1 + DO .1 <- .2$,V1 SUB #1 #1 + PLEASE DO READ OUT .1 + + PLEASE GIVE UP diff --git a/pit/tests/testcf.i b/pit/tests/testcf.i new file mode 100644 index 0000000..2be5abd --- /dev/null +++ b/pit/tests/testcf.i @@ -0,0 +1,22 @@ + DO COME FROM (80) + PLEASE %50 REINSTATE (10) + DO .1 <- #1 +(10) DO NOT %99 .1 <- #2 + DO .1 <- #3 + PLEASE COME FROM (10) + DO READ OUT .1 + DO .1 <- #1 +(20) DO %50 .1 <- #2 + DO .1 <- #3 +(30) PLEASE %50 COME FROM (20) + DO LOSE + PLEASE %90 COME FROM (30) +(40) PLEASE ABSTAIN FROM (50) + DO READ OUT .1 +(50) PLEASE COME FROM (40) +(60) DO (70) NEXT + DO GIVE UP +(70) DO READ OUT #65535 + DO RESUME #1 + DO WIN +(80) DO COME FROM (60) diff --git a/pit/tests/testlib2.i b/pit/tests/testlib2.i new file mode 100644 index 0000000..4f54795 --- /dev/null +++ b/pit/tests/testlib2.i @@ -0,0 +1,62 @@ + +DO (10) NEXT + +(10) PLEASE FORGET #1 + DO WRITE IN .1 + DO (2000) NEXT + DO READ OUT .1 + DO GIVE UP + +(20) PLEASE FORGET #1 + DO WRITE IN .1 + DO (22) NEXT +(21) DO (2010) NEXT + DO READ OUT .1 +(22) PLEASE FORGET #1 + DO (21) NEXT + DO READ OUT .1 + DO GIVE UP + +(30) PLEASE FORGET #1 + DO WRITE IN .1 + DO WRITE IN .2 + DO (2020) NEXT + DO READ OUT .1 + DO GIVE UP + + + +(2010) PLEASE ABSTAIN FROM (2004) +(2000) PLEASE STASH .2 + DO .2 <- #1 + DO (2001) NEXT +(2001) PLEASE FORGET #1 + DO .1 <- '?.1$.2'~'#0$#65535' + DO (2002) NEXT + DO .2 <- !2$#0'~'#32767$#1' + DO (2001) NEXT +(2003) PLEASE RESUME "?!1~.2'$#1"~#3 +(2002) DO (2003) NEXT + PLEASE RETRIEVE .2 +(2004) PLEASE RESUME #2 + PLEASE DO REINSTATE (2004) + PLEASE RESUME '?"!1~.1'~#1"$#2'~#6 + +(2020) PLEASE STASH .2 + .3 + DO (1021) NEXT + + + + (1020) DO STASH .2 + .3 + DO .2 <- #1 + PLEASE DO (1021) NEXT + (1021) DO FORGET #1 + DO .3 <- "?!1~.2'$#1"~#3 + PLEASE DO .1 <- '?.1$.2'~'#0$#65535' + DO (1022) NEXT + DO .2 <- !2$#0'~'#32767$#1' + DO (1021) NEXT + (1023) PLEASE RESUME .3 + (1022) DO (1023) NEXT + PLEASE RETRIEVE .2 + .3 + PLEASE RESUME #2 diff --git a/pit/tests/testops.3i b/pit/tests/testops.3i new file mode 100644 index 0000000..ca109ff --- /dev/null +++ b/pit/tests/testops.3i @@ -0,0 +1,18 @@ + PLEASE WRITE IN .3 + DO .1 <- "^.3$#1"~#1 + DO READ OUT .1 + DO .1 <- "V.3$#1"~#1 + PLEASE DO READ OUT .1 + DO .1 <- "V'"&.3$#2"~#1'$#1"~#1 + DO READ OUT .1 + DO .1 <- "?'"&.3$#2"~#1'$#1"~#1 + PLEASE DO READ OUT .1 + DO .1 <- "V!3~#2'$#1"~#1 + DO READ OUT .1 + DO .1 <- "?!3~#2'$#1"~#1 + PLEASE DO READ OUT .1 + DO .1 <- "@'"^.3$#7"~#4'$#2"~#10 + DO READ OUT .1 + DO .1 <- "^.3$.3"~"#0$#29524" + PLEASE DO READ OUT .1 + PLEASE GIVE UP diff --git a/pit/tests/testops.5i b/pit/tests/testops.5i new file mode 100644 index 0000000..c0ca101 --- /dev/null +++ b/pit/tests/testops.5i @@ -0,0 +1,17 @@ + PLEASE WRITE IN .3 + DO .1 <- "^'"^.3$.3"~"#0$#3906"'$'"^.3$.3"~"#0$#3906"'"~"#0$#3906" + PLEASE DO READ OUT .1 + DO .1 <- "^.3$.3"~"#0$#3906" + DO .1 <- "^.1$.1"~"#0$#3906" + DO READ OUT .1 + DO .1 <- "&.3$#1"~#1 + PLEASE DO READ OUT .1 + DO .1 <- "@.3$#1"~#1 + DO READ OUT .1 + DO .1 <- "2@.3$#1"~#1 + PLEASE DO READ OUT .1 + DO .1 <- "3@.3$#1"~#1 + DO READ OUT .1 + DO .1 <- "V.3$#1"~#1 + PLEASE DO READ OUT .1 + PLEASE GIVE UP diff --git a/pit/tests/testsplat.i b/pit/tests/testsplat.i new file mode 100644 index 0000000..73312e1 --- /dev/null +++ b/pit/tests/testsplat.i @@ -0,0 +1,10 @@ + PLEASE DO READ + OUT #1 + DO READ OUT #2 DO READ OUT #3 + DO %50 RED OUT #4 DO READ OUT #5 + DO READ OUT #6 DO RED OUT #7 + DO RED + OUT #8 + DO READ + OUTT #9 + DO PLEASE GIVE UP diff --git a/sample.i b/sample.i deleted file mode 100644 index ce2da87..0000000 --- a/sample.i +++ /dev/null @@ -1,27 +0,0 @@ - DO (5) NEXT - (5) DO FORGET #1 - PLEASE WRITE IN :1 - DO .1 <- 'V":1~'#32768$#0'"$#1'~#3 - DO (1) NEXT - DO :1 <- "'V":1~'#65535$#0'"$#65535' \ - ~'#0$#65535'"$"'V":1~'#0$#65535'" \ - $#65535'~'#0$#65535'" - DO :2 <- #1 - PLEASE DO (4) NEXT - (4) DO FORGET #1 - DO .1 <- "'V":1~'#65535$#0'"$":2~'#65535 \ - $#0'"'~'#0$#65535'"$"'V":1~'#0 \ - $#65535'"$":2~'#65535$#0'"'~'#0$#65535'" - DO (1) NEXT - DO :2 <- ":2~'#0$#65535'" \ - $"'":2~'#65535$#0'"$#0'~'#32767$#1'" - DO (4) NEXT - (2) DO RESUME .1 - (1) PLEASE DO (2) NEXT - PLEASE FORGET #1 - DO READ OUT :1 - PLEASE DO .1 <- '?"':1~:1'~#1"$#1'~#3 - DO (3) NEXT - PLEASE DO (5) NEXT - (3) DO (2) NEXT - PLEASE GIVE UP diff --git a/src/Makefile b/src/Makefile new file mode 100644 index 0000000..50a3e1e --- /dev/null +++ b/src/Makefile @@ -0,0 +1,83 @@ +# Makefile for the INTERCAL compiler + +# Set BINDIR, INCDIR, LIBDIR to the locations where you want "make install" +# to install the executable, include files, and library for the compiler. +# The compiler will look there for the stuff it needs when you compile +# INTERCAL programs. INCDIR and LIBDIR can be this directory if you don't +# want to "make install", e.g., if you don't trust makefiles moving stuff +# all over creation behind your back. +# (/dev/null may be another good choice :-)) + +DVMT=/home/esr/export/intercal-0.12 + +BINDIR = $(DVMT)/bin +INCDIR = $(DVMT)/lib +LIBDIR = $(DVMT)/lib +#INCDIR = $(PWD) +#LIBDIR = $(PWD) + +# To cope with BSD's losing linker, comment the next line out +NR = @echo "Real UNIXes don't need " + +YDEBUG = -vlt +DEBUG = -g -DDEBUG +# DEBUG = -O +CFLAGS = -I. $(DEBUG) -DICKINCLUDEDIR=\"$(INCDIR)\" \ + -DICKLIBDIR=\"$(LIBDIR)\" -DYYDEBUG +LDFLAGS = + +# Warning: using flex does not work yet! +LEX = lex +#LEX = flex -l + +# However, you can use either yacc or bison +YACC = yacc +#YACC = bison -y + +CSOURCES = ick.y lexer.l feh.c lose.c fiddle.c perpetrate.c +ISOURCES = cesspool.c arrgghh.c ick-wrap.c +HEADERS = ick.h lose.h sizes.h +SOURCES = $(CSOURCES) $(ISOURCES) $(HEADERS) + +all: ick libick.a + +ick: ick.o lexer.o feh.o lose.o fiddle.o perpetrate.o + $(CC) perpetrate.o ick.o lexer.o feh.o lose.o fiddle.o $(LDFLAGS) -o ick + +y.tab.h ick.c: ick.y + $(YACC) -d $(YDEBUG) ick.y + mv y.tab.c ick.c + +lexer.c: lexer.l + $(LEX) $(LFLAGS) lexer.l + mv lex.yy.c lexer.c + +# Uncomment the following if using a stock lex +# LEXLIBS = -ll +lextest: y.tab.h lexer.c ick.h lose.o + $(CC) -DMAIN lexer.c lose.o $(LEXLIBS) -o lextest + +ick.o: ick.c ick.h lose.h sizes.h +lexer.o: lexer.c y.tab.h ick.h +feh.o: feh.c y.tab.h ick.h lose.h sizes.h +perpetrate.o: perpetrate.c y.tab.h ick.h lose.h +cesspool.o: cesspool.c numerals.c cesspool.h lose.h sizes.h +lose.o: lose.h +fiddle.o: sizes.h + +libick.a: cesspool.o lose.o fiddle.o arrgghh.o + ar cr libick.a cesspool.o lose.o fiddle.o arrgghh.o + $(NR) ranlib libick.a + +install: all + cp ick $(BINDIR) + cp lose.h cesspool.h ick-wrap.c $(INCDIR) + cp libick.a ../pit/lib/syslib.i $(LIBDIR) + $(NR) ranlib $(LIBDIR)/libick.a + +clean: + rm -f yacc.* y.tab.* y.output *~ *.[oa] lexer.c ick.c lextest ick + +TAGS: $(SOURCES) + etags $(SOURCES) + diff --git a/src/arrgghh.c b/src/arrgghh.c new file mode 100644 index 0000000..4124f59 --- /dev/null +++ b/src/arrgghh.c @@ -0,0 +1,83 @@ +/* + * SYNOPSIS: parseargs(argc,argv) + * FILE : parseargs.c + * AUTHOR : Steve Swales + * DATE: October 7, 1990 + * PURPOSE: Parse arguments for INTERCAL programs. + */ +#include +#include "lose.h" + +int traditional = 1; +int wimp_mode = 0; + +void +parseargs(argc,argv) +int argc; +char **argv; +{ + register int i, j; + static int helpflag = -1; + static char *flags[] = { + "help", + "wimpmode", + "traditional" + }; + static int *bools[] = { + &helpflag, + &wimp_mode, + &traditional + }; + static nflags = (sizeof(flags)/sizeof(flags[0])); + + for(i = 1;i < argc;i++) { + if(argv[i][0] != '+' && argv[i][0] != '-') { + break; + } + for(j = 0; j < nflags;j++) { + if(0 == strcmp(argv[i]+1,flags[j])) { + *(bools[j]) = (argv[i][0] == '+'); + break; + } + } + if(j == nflags) { + fprintf(stderr,"%s: can't grok %s\n",argv[0],argv[i]); + helpflag = 1; + } + } + if(helpflag != -1) { + if(!helpflag) { + fprintf(stderr, + "Once you start messing with INTERCAL... \n"); + fprintf(stderr,"\t\tthere is no help for you!\n\n"); + sleep(3); + } + fprintf(stderr,"Current flags (and current state) are:\n"); + for(i = 0;i < nflags;i++) { + fprintf(stderr,"\t[+/-]%-20.20s\t(%s)\n",flags[i], + (*(bools[i]) == 1)?"ON":((*(bools[i]) == 0)?"OFF":"???")); + } + fprintf(stderr,"All flags must be preceded by either + or -, which\n"); + fprintf(stderr," usually will mean turn on or turn off something,\n"); + fprintf(stderr," but not always, and not all of them currently\n"); + fprintf(stderr," do anything, but you can switch them on or off\n"); + fprintf(stderr," if you like anyway. Isn't this helpful?\n\n"); + fflush(stderr); + sleep(3); + lose(E778, 0, (char *)NULL); + } + if(wimp_mode) { + fprintf(stderr,"How sad... you have selected to run an INTERCAL\n"); + fprintf(stderr,"program in WIMP MODE.\n\n"); + fprintf(stderr,"This means that:\n"); + fprintf(stderr," A) Rather than the nifty input like:\n"); + fprintf(stderr,"\tONE NINER SEVEN TWO OH SIX THREE,\n"); + fprintf(stderr," and even niftier output like:\n"); + fprintf(stderr,"\t______\n"); + fprintf(stderr,"\tMCMLXXMMLXIII,\n"); + fprintf(stderr," you will have to settle for plain old number\n"); + fprintf(stderr," representations like 1972063; and,\n"); + fprintf(stderr," B) You are a WIMP!\n\n"); + fflush(stderr); + } +} diff --git a/src/cesspool.c b/src/cesspool.c new file mode 100644 index 0000000..9ac6f45 --- /dev/null +++ b/src/cesspool.c @@ -0,0 +1,581 @@ +/* cesspool.c -- storage management and runtime support for INTERCAL */ +/* LINTLIBRARY */ +#include +#include +#include "sizes.h" +#include "cesspool.h" +#include "lose.h" + +#include "numerals.c" + +/********************************************************************** + * + * The following functions manipulate the nexting stack + * + *********************************************************************/ + +#define MAXNEXT 80 + +int next[MAXNEXT]; +int nextindex = 0; + +void pushnext(n) +int n; +{ + if (nextindex < MAXNEXT) + next[nextindex++] = n; + else + lose(E123, lineno, (char *)NULL); +} + +unsigned int popnext(n) +int n; +{ + nextindex -= n; + if (nextindex < 0) { + nextindex = 0; + return(-1); + } + return(next[nextindex]); +} + +unsigned int resume(n) +unsigned int n; +{ + if (n == 0) + lose(E621, lineno, (char *)NULL); + else if ((n = popnext(n)) == -1) + lose(E632, lineno, (char *)NULL); + else + return(n); +} + +/********************************************************************** + * + * The following functions implement the INTERCAL I/O model + * + *********************************************************************/ + +unsigned int pin() +{ + char buf[BUFSIZ], *cp, *strtok(); + unsigned int result = 0; + int n; + extern int wimp_mode; + + if (fgets(buf, BUFSIZ, stdin) == (char *)NULL) + lose(E562, lineno, (char *)NULL); + buf[strlen(buf)-1] = '\0'; + + if(wimp_mode) { + result = atoi(buf); + n = 1; + } + else + { + for(n=0,cp = strtok(buf, " ");cp;cp = strtok((char *)NULL, " "),n++) + { + int digit = -1; + numeral *np; + + for (np = numerals; np < numerals + sizeof(numerals)/sizeof(numeral); np++) + if (strcmp(np->name, cp) == 0) + { + digit = np->value; + break; + } + + if (digit == -1) + lose(E579, lineno, cp); + + if (result < 429496729 || result == 429496729 && digit < 6) + result = result * 10 + digit; + else + lose(E533, lineno, (char *)NULL); + } + } + if (!n) + lose(E562, lineno, (char *)NULL); + if (result > Max_large) + lose(E533, lineno, (char *)NULL); + return(result); +} + +/********************************************************************** + * + * Butchered Roman numerals implemented by + * Michael Ernst, mernst@theory.lcs.mit.edu. May 7, 1990 + * + * The INTERCAL manual hints that 3999 should translate to MMMIM + * (compare MMMCMXCIX) without specifying what the translation is. + * That may be a typo; in any case, this implementation isn't that + * butchered. + * + *********************************************************************/ + +#define MAXDIGITS 10 /* max base 10 digits */ +#define MAXROMANS (MAXDIGITS*4+1) /* max chars in translation */ + +/* + * The first column tells how many of the succeeding columns are used. + * The other columns refer to the columns of br_equiv and br_overbar. + */ +static int br_trans[10][5] = +{ + {0, 0, 0, 0, 0}, + {1, 0, 0, 0, 0}, + {2, 0, 0, 0, 0}, + {3, 0, 0, 0, 0}, + {2, 1, 2, 0, 0}, /* or use {4, 0, 0, 0, 0} */ + {1, 2, 0, 0, 0}, + {2, 2, 1, 0, 0}, + {3, 2, 1, 1, 0}, + {4, 2, 1, 1, 1}, + {2, 1, 3, 0, 0} +}; + +/* + * butcher places in the string result the "butchered" Roman numeral for val. + * This string should be printed at the beginning of a line; it spans two + * lines and already contains newlines. + * + * 11/24/91 LHH: Removed unnecessary final newline. + */ + +static void butcher(val, result) +unsigned long val; +char *result; +{ + int i, j; + int digitsig, digitval; + char res[MAXROMANS], ovb[MAXROMANS]; + + /* We need FOUR columns because of the odd way that M and I interact. */ + static char br_equiv[MAXDIGITS][4] = + { + {'I', 'I', 'V', 'X'}, {'X', 'X', 'L', 'C'}, + {'C', 'C', 'D', 'M'}, {'M', 'I', 'V', 'X'}, + {'X', 'X', 'L', 'C'}, {'C', 'C', 'D', 'M'}, + {'M', 'i', 'v', 'x'}, {'x', 'x', 'l', 'c'}, + {'c', 'c', 'd', 'm'}, {'m', 'i', 'v', 'x'}, + }; + + static char br_overbar[MAXDIGITS][4] = + { + {' ', ' ', ' ', ' '}, + {' ', ' ', ' ', ' '}, + {' ', ' ', ' ', ' '}, + {' ', '_', '_', '_'}, + {'_', '_', '_', '_'}, + {'_', '_', '_', '_'}, + {'_', ' ', ' ', ' '}, + {' ', ' ', ' ', ' '}, + {' ', ' ', ' ', ' '}, + {' ', '_', '_', '_'}, + }; + + if (val == 0) +/* Final newline will be added by puts. + (void) strcpy(result, "_\n \n"); +*/ + (void) strcpy(result, "_\n"); + else + { + res[MAXROMANS-1] = 0; + ovb[MAXROMANS-1] = 0; + i = MAXROMANS-1; + + /* the significance of the current digit is 10 ** digitsig */ + for (digitsig = 0; (digitsig < MAXDIGITS) && (val > 0); digitsig++) + { + digitval = val % 10; + for (j = br_trans[digitval][0]; j > 0; j--) + { + /* printf("In j loop: %d %d\n", j, i); */ + res[--i] = br_equiv[digitsig][br_trans[digitval][j]]; + ovb[i] = br_overbar[digitsig][br_trans[digitval][j]]; + } + val = val / 10; + } + + j = i; + while (*result++ = ovb[j++]) + continue; + *--result = '\n'; + + j = i; + while (*++result = res[j++]) + continue; +/* Final newline will be added by puts. + *result++ = '\n'; +*/ + *result = '\0'; + } +} + +void clockface(mode) +/* enable or disable clockface mode (output IIII instead of IV) */ +bool mode; +{ + if (mode) + { + /* clockface mode */ + br_trans[4][0] = 4; + br_trans[4][1] = 0; + br_trans[4][2] = 0; + } + else + { + /* normal mode */ + br_trans[4][0] = 2; + br_trans[4][1] = 1; + br_trans[4][2] = 2; + } +} + +void pout(val) +/* output in `butchered' Roman numerals; see manual, part 4.4.13 */ +unsigned int val; +{ + char result[2*MAXROMANS+1]; + extern int wimp_mode; + + if(wimp_mode) { + printf("%d\n",val); + } + else { + butcher(val, result); + (void) puts(result); + } + fflush(stdout); +} + +/********************************************************************** + * + * The following two routines implement bitwise I/O. They assume + * 8 bit characters, but there's no reason more general versions + * could not be written. + * + *********************************************************************/ + +void binin(type,a,forget) +unsigned int type; +array *a; +bool forget; +{ + static unsigned lastin = 0; + int i, c, v; + + if (a->rank != 1) + lose(E241, lineno, (char *)NULL); + + for (i = 0 ; i < a->dims[0] ; i++) { + v = ((c=getchar()) == EOF) ? 256 : (c - lastin) % 256; + lastin = c; + if (!forget) { + if (type == TAIL) + a->data.tail[i] = v; + else + a->data.hybrid[i] = v; + } + } +} + +void binout(type,a) +unsigned int type; +array *a; +{ + static unsigned lastout = 0; + unsigned c; + int i; + + if (a->rank != 1) + lose(E241, lineno, (char *)NULL); + + for (i = 0 ; i < a->dims[0] ; i++) { + if (type == TAIL) + c = lastout - a->data.tail[i]; + else + c = lastout - a->data.hybrid[i]; + lastout = c; + c = (c & 0x0f) << 4 | (c & 0xf0) >> 4; + c = (c & 0x33) << 2 | (c & 0xcc) >> 2; + c = (c & 0x55) << 1 | (c & 0xaa) >> 1; + putchar(c); + } +} + +/********************************************************************** + * + * The following assignment function performs IGNORE and type checks + * + *********************************************************************/ + +unsigned int assign(dest,type,forget,value) +char *dest; +unsigned int type, value; +bool forget; +{ + unsigned int retval; + if (type == ONESPOT || type == TAIL) { + if (value > Max_small) + lose(E275, lineno, (char *)NULL); + if (forget) + retval = value; + else { + retval = *(type16*)dest; + *(type16*)dest = value; + } + } + else if (type == TWOSPOT || type == HYBRID) { + if (forget) + retval = value; + else { + retval = *(type32*)dest; + *(type32*)dest = value; + } + } + return retval; +} + +/********************************************************************** + * + * The following functions implement the INTERCAL array model + * + *********************************************************************/ + +char *aref(va_alist) va_dcl +/* return a pointer to the array location specified by args */ +{ + unsigned int type; + array *a; + unsigned int v; + va_list ap; + int i, address = 0; + + va_start(ap); + type = va_arg(ap, unsigned int); + a = va_arg(ap, array*); + + if (va_arg(ap, unsigned int) != a->rank) + lose(E241, lineno, (char *)NULL); + + for (i = 0 ; i < a->rank ; i++) { + v = va_arg(ap, unsigned int); + if (v == 0 || v > a->dims[i]) + lose(E241, lineno, (char *)NULL); + address = address * a->dims[i] + v - 1; + } + + va_end(ap); + + if (type == TAIL) + return (char*)&a->data.tail[address]; + else + return (char*)&a->data.hybrid[address]; +} + +void resize(va_alist) va_dcl +/* resize an array to the given shape */ +{ + unsigned int type; + array *a; + bool forget; + unsigned int r, v; + va_list ap; + int i, prod = 1; + + va_start(ap); + type = va_arg(ap, unsigned int); + a = va_arg(ap, array*); + forget = va_arg(ap, bool); + + r = va_arg(ap, unsigned int); + if (!forget) { + a->rank = r; + if (a->dims) + free((char*)a->dims); + a->dims = (unsigned int*) malloc(a->rank * sizeof(unsigned int)); + if (a->dims == NULL) + lose(E241, lineno, (char *)NULL); + } + + for (i = 0 ; i < r ; i++) { + v = va_arg(ap, unsigned int); + if (v == 0) + lose(E240, lineno, (char *)NULL); + if (!forget) { + a->dims[i] = v; + prod *= v; + } + } + + if (!forget) { + if (type == TAIL) { + if (a->data.tail) + free((char *)a->data.tail); + a->data.tail = (type16*)malloc(prod * sizeof(type16)); + if (a->data.tail == NULL) + lose(E241, lineno, (char *)NULL); + } + else { + if (a->data.hybrid) + free((char *)a->data.hybrid); + a->data.hybrid = (type32*)malloc(prod * sizeof(type32)); + if (a->data.hybrid == NULL) + lose(E241, lineno, (char *)NULL); + } + } + + va_end(ap); +} + +/********************************************************************** + * + * The following functions implement save/retrieve + * + *********************************************************************/ + +typedef struct stashbox_t /* this is a save-stack element */ +{ + int type; /* variable type */ + int index; /* variable's index within the type */ + union /* the data itself */ + { + type16 onespot; + type32 twospot; + array *a; + } save; + struct stashbox_t *next; /* pointer to next-older stashbox */ +} stashbox; + +static stashbox *first; + +void stashinit() +{ + first = NULL; +} + +static stashbox *fetch(type, index) +/* find a stashed variable in the save stack and extract it */ +unsigned int type, index; +{ + stashbox **pp = &first, *sp = first; + + while (sp && (sp->type != type || sp->index != index)) { + pp = &sp->next; + sp = sp->next; + } + if (sp) + *pp = sp->next; + + return (sp); +} + +void stash(type, index, from) +/* stash away the variable's value */ +char *from; +unsigned int type, index; +{ + /* create a new stashbox and push it onto the stack */ + stashbox *sp = (stashbox*)malloc(sizeof(stashbox)); + if (sp == NULL) lose(E222, lineno, (char *)NULL); + sp->next = first; + first = sp; + + /* store the variable in it */ + sp->type = type; + sp->index = index; + if (type == ONESPOT) + memcpy((char *)&sp->save.onespot, from, sizeof(type16)); + else if (type == TWOSPOT) + memcpy((char *)&sp->save.twospot, from, sizeof(type32)); + else if (type == TAIL | type == HYBRID) { + array *a = (array*)from; + int i, prod; + sp->save.a = (array*)malloc(sizeof(array)); + if (sp->save.a == NULL) lose(E222, lineno, (char *)NULL); + sp->save.a->rank = a->rank; + sp->save.a->dims = (unsigned int*)malloc(a->rank * sizeof(unsigned int)); + if (sp->save.a->dims == NULL) lose(E222, lineno, (char *)NULL); + memcpy((char*)sp->save.a->dims, (char*)a->dims, + a->rank * sizeof(unsigned int)); + prod = a->rank ? 1 : 0; + for (i = 0 ; i < a->rank ; i++) { + prod *= a->dims[i]; + } + if (type == TAIL) { + sp->save.a->data.tail = + (type16*)malloc(prod * sizeof(type16)); + if (sp->save.a->data.tail == NULL) lose(E222, lineno, (char *)NULL); + memcpy((char *)sp->save.a->data.tail, + (char*)a->data.tail, prod * sizeof(type16)); + } + else { + sp->save.a->data.hybrid = + (type32*)malloc(prod * sizeof(type32)); + if (sp->save.a->data.hybrid == NULL) lose(E222, lineno, (char *)NULL); + memcpy((char *)sp->save.a->data.hybrid, + (char*)a->data.hybrid, prod * sizeof(type32)); + } + } + return; +} + +void retrieve(to, type, index, forget) +/* restore the value of a variable from the save stack */ +char *to; +unsigned int type, index; +bool forget; +{ + stashbox *sp; + + if ((sp = fetch(type, index)) == (stashbox *)NULL) + lose(E436, lineno, (char *)NULL); + else if (!forget) { + if (type == ONESPOT) + memcpy(to, (char *)&sp->save.onespot, sizeof(type16)); + else if (type == TWOSPOT) + memcpy(to, (char *)&sp->save.twospot, sizeof(type32)); + else if (type == TAIL | type == HYBRID) { + array *a = (array*)to; + if (a->rank) { + free(a->dims); + if (type == TAIL) + free(a->data.tail); + else + free(a->data.hybrid); + memcpy(to, (char*)sp->save.a, sizeof(array)); + } + free(sp->save.a); + } + } + else if (type == TAIL | type == HYBRID) { + free(sp->save.a->dims); + if (type == TAIL) + free(sp->save.a->data.tail); + else + free(sp->save.a->data.hybrid); + free(sp->save.a); + } + free(sp); +} + +/********************************************************************** + * + * The following function is used for random error generation + * + *********************************************************************/ + +unsigned int roll(n) +/* return TRUE on n% chance, FALSE otherwise */ +unsigned int n; +{ +#ifdef USG + return(lrand48() % 100 < n); +#else + return(rand() % 100 < n); +#endif /* UNIX */ +} + +/* cesspool.c ends here */ diff --git a/src/cesspool.h b/src/cesspool.h new file mode 100644 index 0000000..652b83a --- /dev/null +++ b/src/cesspool.h @@ -0,0 +1,46 @@ +/* cesspool.h -- interface to INTERCAL storage manager and runtime support */ + +#include + +typedef int bool; +#define TRUE 1 +#define FALSE 0 + +extern char *aref(); +extern unsigned int aget(), pin(), roll(), popnext(), resume(), assign(); +extern void pushnext(), resize(), stashinit(), stash(), retrieve(), aput(); +extern void clockface(), pout(); + +extern int lineno; + +#define ONESPOT 0 +#define TWOSPOT 1 +#define TAIL 2 +#define HYBRID 3 + +/* the following two types must both promote to unsigned int in expressions */ + +typedef unsigned short type16; +typedef unsigned int type32; + +typedef struct array_t +{ + int rank; + unsigned int *dims; + union + { + type16 *tail; + type32 *hybrid; + } data; +} array; + +typedef struct +{ + char *name; + int value; +} +numeral; + +extern numeral numerals[]; + +/* cesspool.h ends here */ diff --git a/feh.c b/src/feh.c similarity index 54% rename from feh.c rename to src/feh.c index 9117a4e..806f53b 100644 --- a/feh.c +++ b/src/feh.c @@ -4,34 +4,20 @@ NAME feh.c -- code-generator back-end for ick parser DESCRIPTION - This module provides storage manglement and code degeneration -for the INTERCAL compiler. + This module provides storage manglement, code degeneration, +and optimizations of dubious value for the INTERCAL compiler. ****************************************************************************/ /*LINTLIBRARY */ #include -#include +#include "sizes.h" #include "ick.h" #include "y.tab.h" #include "lose.h" -extern unsigned int mingle(), select(); -extern unsigned int and16(), or16(), xor16(), and32(), or32(), xor32(); - -extern char linebuf[]; -extern int yydebug, yylineno; - -/* compilation options */ -static bool dooptimize; /* do optimizations? (controlled by -O) */ -static bool clockface; /* set up output to do IIII for IV */ - -#define SKELETON "ick-wrapper.c" - -int lineno; /* current source line number; lose() uses it */ - int yyerror() { - lose(yylineno, E017); + /* lose(E017, yylineno, (char *)NULL); */ } /************************************************************************* @@ -70,18 +56,6 @@ node *car, *cdr; * **************************************************************************/ -/* this maps the `external' name of a variable to an internal array index */ -typedef struct -{ - int type; - int extindex; - int intindex; -} -atom; - -static atom oblist[MAXSTASHES], *obdex; -static int nonespots, ntwospots, ntails, nhybrids; - unsigned int intern(type, index) { atom *x; @@ -92,8 +66,8 @@ unsigned int intern(type, index) return(x->intindex); /* else we must intern a new symbol */ - if (obdex >= oblist + MAXSTASHES) - lose(yylineno, E333); + if (obdex >= oblist + MAXVARS) + lose(E333, yylineno, (char *)NULL); obdex->type = type; obdex->extindex = index; if (type == ONESPOT) @@ -115,9 +89,7 @@ unsigned int intern(type, index) * **************************************************************************/ -static tuple tuples[MAXLINES]; - -static void treset() +void treset() { memset(tuples, '\0', sizeof(tuple) * MAXLINES); nonespots = ntwospots = ntails = nhybrids = 0; @@ -129,7 +101,7 @@ tuple *newtuple() /* allocate and zero out a new expression tuple */ { if (lineno >= MAXLINES) - lose(yylineno, E666); + lose(E666, yylineno, (char *)NULL); else return(tuples + lineno++); } @@ -143,7 +115,7 @@ tuple *newtuple() * **************************************************************************/ -static void typecast(np) +void typecast(np) node *np; { /* recurse so we typecast each node after all its subnodes */ @@ -159,14 +131,17 @@ node *np; */ if (np->opcode == MESH || np->opcode == ONESPOT || np->opcode == TAIL) np->width = 16; - else if (np->opcode==TWOSPOT ||np->opcode==HYBRID ||np->opcode==MINGLE) + else if (np->opcode == TWOSPOT || np->opcode == HYBRID + || np->opcode == MINGLE || np->opcode == MESH32) np->width = 32; - else if (np->opcode == AND || np->opcode == OR || np->opcode == XOR) + else if (np->opcode == AND || np->opcode == OR || np->opcode == XOR || + np->opcode == FIN || + (np->opcode >= WHIRL && np->opcode <= WHIRL5)) np->width = np->rval->width; else if (np->opcode == SELECT) np->width = np->rval->width; /* n-bit select has an n-bit result */ else if (np->opcode == SUB) - np->width = np->rval->width; /* tpe of the array */ + np->width = np->lval->width; /* type of the array */ } /************************************************************************* @@ -180,22 +155,25 @@ node *np; * **************************************************************************/ -static void codecheck() +void codecheck() { tuple *tp, *up; /* check for assignment type mismatches */ + /* This check can't be done at compile time---RTFM. [LHH] */ +/* for (tp = tuples; tp < tuples + lineno; tp++) if (tp->type == GETS) - if (tp->u.node->lval->width == 16 && tp->u.node->lval->width == 32) - lose(tp - tuples + 1, E275); + if (tp->u.node->lval->width == 16 && tp->u.node->rval->width == 32) + lose(E275, tp - tuples + 1, (char *)NULL); +*/ /* check for duplicate labels */ for (tp = tuples; tp < tuples + lineno; tp++) if (tp->label) for (up = tuples; up < tuples + lineno; up++) if (tp != up && tp->label == up->label) - lose(tp - tuples + 1, E182); + lose(E182, tp - tuples + 1, (char *)NULL); /* * Check that every NEXT, ABSTAIN, REINSTATE and COME_FROM actually has a @@ -214,23 +192,27 @@ static void codecheck() foundit = TRUE; break; } + if (!foundit) { if (tp->type == NEXT) - lose(tp - tuples + 1, E129); + lose(E129, tp - tuples + 1, (char *)NULL); else if (tp->type == COME_FROM) - lose(tp - tuples + 1, E444); + lose(E444, tp - tuples + 1, (char *)NULL); + else + lose(E139, tp - tuples + 1, (char *)NULL); + } + /* tell the other tuple if it is a COME FROM target */ + else if (tp->type == COME_FROM) + { + if (up->comefrom) + lose(E555, yylineno, (char *)NULL); else - lose(tp - tuples + 1, E139); + up->comefrom = tp - tuples + 1; } /* this substitutes line numbers for label numbers */ else if (tp->type != NEXT) { - if (tp->type == COME_FROM) - if (up->comefrom) - lose(yylineno, E555); - else - up->comefrom = tp - tuples + 1; tp->u.target = up - tuples + 1; } } @@ -244,12 +226,9 @@ static void codecheck() * **************************************************************************/ -/* optimizer node codes -- must make sure these don't collide with y.tab.h */ -#define TESTNZ 300 /* test for non-zero */ +#define ISCONSTANT(np, v) ((np->opcode == MESH || np->opcode == MESH32) && np->constant == v) -#define ISCONSTANT(np, v) (np->opcode == MESH && np->constant == v) - -static void rfree(np) +void rfree(np) /* recursively free the given node and all nodes underneath */ node *np; { @@ -260,7 +239,7 @@ node *np; free(np); } -static int requal(mp, np) +int requal(mp, np) /* do two node trees represent the same expression? */ node *mp, *np; { @@ -276,7 +255,7 @@ node *mp, *np; return(TRUE); } -static void optimize(np) +void optimize(np) node *np; { /* recurse so we simplify each node after all its subnodes */ @@ -298,10 +277,21 @@ node *np; np->width = 16; } + /* equality test by XOR */ + if (np->opcode == TESTNZ && np->rval->opcode == XOR) + { + node *tp = np->rval; + + np->opcode = EQUALS; + np->lval = tp->lval; + np->rval = tp->rval; + free(np->rval); + } + /* fold MINGLE operations on constants */ if (np->opcode==MINGLE && (np->lval->opcode==MESH&&np->rval->opcode==MESH)) { - np->opcode = MESH; + np->opcode = MESH32; np->constant = mingle(np->lval->constant, np->rval->constant); free(np->lval); free(np->rval); @@ -311,7 +301,7 @@ node *np; if (np->opcode == SELECT && (np->lval->opcode==MESH && np->rval->opcode==MESH)) { np->opcode = MESH; - np->constant = select(np->lval->constant, np->rval->constant); + np->constant = iselect(np->lval->constant, np->rval->constant); free(np->lval); free(np->rval); } @@ -343,7 +333,7 @@ node *np; /************************************************************************* * - * Code generation + * Code degeneration * * The theory behind this crock is that we've been handed a pointer to * a tuple representing a single INTERCAL statement, possibly with an @@ -355,39 +345,32 @@ node *np; * **************************************************************************/ -typedef struct -{ - int value; - char *name; -} -assoc; - /* * If the order of statement-token defines in ick.y ever changes, - * this will need to be resolved. + * this will need to be reordered. */ -static char *enablers[] = +char *enablers[MAXTYPES] = { - /* GETS */ "calculating", - /* RESIZE */ "calculating", - /* NEXT */ "nexting", - /* FORGET */ "forgetting", - /* RESUME */ "resuming", - /* STASH */ "stashing", - /* RETRIEVE */ "retrieving", - /* IGNORE */ "ignoring", - /* REMEMBER */ "remembering", - /* ABSTAIN */ "abstaining", - /* REINSTATE */ "reinstating", - /* DISABLE */ "abstaining", - /* ENABLE */ "reinstating", - /* GIVE_UP */ "givingup", /* never used */ - /* READ_OUT */ "readingout", - /* WRITE_IN */ "writingin", - /* COME_FROM */ "comingfrom", + "GETS", + "RESIZE", + "NEXT", + "FORGET", + "RESUME", + "STASH", + "RETRIEVE", + "IGNORE", + "REMEMBER", + "ABSTAIN", + "REINSTATE", + "DISABLE", + "ENABLE", + "GIVE_UP", + "READ_OUT", + "WRITE_IN", + "COME_FROM", }; -static assoc vartypes[] = +assoc vartypes[] = { ONESPOT, "ONESPOT", TWOSPOT, "TWOSPOT", @@ -396,7 +379,7 @@ static assoc vartypes[] = 0, (char *)NULL }; -static assoc forgetbits[] = +assoc forgetbits[] = { ONESPOT, "oneforget", TWOSPOT, "twoforget", @@ -405,25 +388,25 @@ static assoc forgetbits[] = 0, (char *)NULL }; -static assoc varstores[] = +assoc varstores[] = { - ONESPOT, "onespot", - TWOSPOT, "twospot", + ONESPOT, "onespots", + TWOSPOT, "twospots", TAIL, "tails", HYBRID, "hybrids", 0, (char *)NULL }; -static assoc typedefs[] = +assoc typedefs[] = { - ONESPOT, "short", - TWOSPOT, "int", - TAIL, "unsigned short *", - HYBRID, "unsigned int *", + ONESPOT, "type16", + TWOSPOT, "type32", + TAIL, "type16", + HYBRID, "type32", 0, (char *)NULL }; -static char *nameof(value, table) +char *nameof(value, table) /* return string corresponding to value in table */ int value; assoc table[]; @@ -436,7 +419,7 @@ assoc table[]; return((char *)NULL); } -static void prvar(np, fp) +void prvar(np, fp) /* print out args to pass to storage manager for reference */ node *np; FILE *fp; @@ -455,34 +438,37 @@ FILE *fp; break; case TAIL: - (void) fprintf(fp, "TAIL, %d", np->constant); + (void) fprintf(fp, "TAIL, &tails[%d]", np->constant); break; case HYBRID: - (void) fprintf(fp, "HYBRID, %d", np->constant); + (void) fprintf(fp, "HYBRID, &hybrids[%d]", np->constant); break; case SUB: - dim = 0; - for (sp = np->rval; sp; sp = sp->rval) - dim++; - (void) fprintf(fp, "%s, %d, %d, ", - nameof(np->lval->opcode, vartypes), - np->lval->constant, - dim); - for (np = np->rval; np; np = np->rval) { - extern void prexpr(); + void prexpr(); + node *sp; - prexpr(np->lval, fp); + (void) fprintf(fp, "aref("); + prvar(np->lval, fp); + + dim = 0; + for (sp = np->rval ; sp ; sp = sp->rval) + dim++; + (void) fprintf(fp, ", %d", dim); + + for (sp = np->rval ; sp ; sp = sp->rval) { (void) fprintf(fp, ", "); - } - (void) fprintf(" 0"); + prexpr(sp->lval, fp); + } + (void) fprintf(fp, ")"); + } break; } } -static void prexpr(np, fp) +void prexpr(np, fp) /* print out C-function equivalent of an expression */ FILE *fp; node *np; @@ -498,7 +484,7 @@ node *np; break; case SELECT: - (void) fprintf(fp, "select("); + (void) fprintf(fp, "iselect("); prexpr(np->lval, fp); (void) fprintf(fp, ", "); prexpr(np->rval, fp); @@ -523,19 +509,50 @@ node *np; (void) fprintf(fp, ")"); break; + case EQUALS: + (void) fprintf(fp, "("); + prexpr(np->lval, fp); + (void) fprintf(fp, " == "); + prexpr(np->rval, fp); + (void) fprintf(fp, ")"); + break; + + case FIN: + if (Base < 3) + lose(E997, lineno, (char *)NULL); + (void) fprintf(fp, "fin%d(", np->width); + prexpr(np->rval, fp); + (void) fprintf(fp, ")"); + break; + + case WHIRL: + case WHIRL2: + case WHIRL3: + case WHIRL4: + case WHIRL5: + if (np->opcode - WHIRL + 3 > Base) + lose(E997, lineno, (char *)NULL); + (void) fprintf(fp, "whirl%d(%d, ", np->width, np->opcode - WHIRL + 1); + prexpr(np->rval, fp); + (void) fprintf(fp, ")"); + break; + case MESH: (void) fprintf(fp, "0x%x", np->constant); break; + case MESH32: + (void) fprintf(fp, "0x%lx", np->constant); + break; + case ONESPOT: case TWOSPOT: prvar(np, fp); break; case SUB: - (void) fprintf(fp, "aget(%s"); + (void) fprintf(fp, "*(%s*)", nameof(np->lval->opcode, typedefs)); prvar(np, fp); - (void) fprintf(fp, ")"); break; /* cases from here down are generated by the optimizer */ @@ -549,6 +566,23 @@ node *np; (void) free(np); } +char *nice_text(text) +char *text; +{ +#define MAXNICEBUF 512 + static char buf[MAXNICEBUF]; + char *cp; + + for(cp = buf;*text;cp++,text++) { + if(*text == '"' || *text == '\\') { + (*cp++) = '\\'; + } + *cp = *text; + } + *cp = '\0'; + return buf; +} + void emit(tn, fp) /* emit code for the given tuple */ tuple *tn; @@ -556,86 +590,76 @@ FILE *fp; { node *np, *sp; int dim; + char *name; + static int make_cf_target = 0; - if (yydebug) + if (yydebug || compile_only) (void) fprintf(fp, " /* line %03d: %s */\n", tn - tuples + 1, textlines[tn-tuples+1]); + /* don't make a label if we are emitting the jump to a COME FROM */ + if (make_cf_target) + tn->label = 0; if (tn->label) (void) fprintf(fp, "L%d:\n", tn->label); - if (tn->type == COME_FROM) + /* if this is a COME FROM statement, just make a label and jump to end */ + if (tn->type == COME_FROM && !make_cf_target) { - (void) fprintf(fp, "C%d:\n", tn - tuples + 1); - return; + (void) fprintf(fp, "C%d:\n", tn->u.target); + goto comefrom; } /* emit conditional-execution prefixes */ - if (tn->type == NEXT) - { - (void) fprintf(fp, " if (skipto == %d) skipto = 0; else\n", tn-tuples+1); - (void) fprintf(fp, " if (!skipto && "); - } - else - (void) fprintf(fp, " if (!skipto && ", tn - tuples + 1); - if (tn->exechance && tn->exechance < 100) + (void) fprintf(fp, " if ("); + if (tn->exechance < 100) (void) fprintf(fp, "roll(%d) && ", tn->exechance); - if (tn->type == GIVE_UP) - (void) fprintf(fp, "!abstained[(lineno = %d)-1])\n", tn - tuples + 1); - else - (void) fprintf(fp, "!abstained[(lineno = %d)-1] && %s)\n", - tn-tuples + 1, enablers[tn->type-GETS]); + (void) fprintf(fp, "!abstained[(lineno = %d)-1])\n", tn - tuples + 1); (void) fprintf(fp, " {\n"); - if (tn->comefrom) - (void) fprintf(fp, - "\tif (!abstained[%d-1] && comingfrom)\t/* COME FROM */\n\t goto C%d;\n", - tn->comefrom, tn->comefrom); - /* now emit the code for the statement body */ switch(tn->type) { case GETS: np = tn->u.node; - (void) fprintf(fp,"\tif (!%s[%d])\n\t ", - nameof(np->lval->opcode, forgetbits), - np->constant); - if (np->lval->opcode == ONESPOT || np->lval->opcode == TWOSPOT) - { - prvar(np->lval, fp); - (void) fprintf(fp, " = "); - prexpr(tn->u.node->rval, fp); + if (np->lval->opcode != SUB) { + sp = np->lval; + (void) fprintf(fp,"\t(void) assign((char*)&"); } - else - { - (void) fprintf(fp, "aput("); - prexpr(tn->u.node->rval, fp); - (void) fprintf(fp, ", "); - prvar(np->lval, fp); - (void) fprintf(fp, ")"); + else { + sp = np->lval->lval; + (void) fprintf(fp,"\t(void) assign("); } - (void) fprintf(fp, ";\n"); + prvar(np->lval, fp); + (void) fprintf(fp,", %s", nameof(sp->opcode, vartypes)); + (void) fprintf(fp,", %s[%d], ", nameof(sp->opcode, forgetbits), + sp->constant); + prexpr(np->rval, fp); + (void) fprintf(fp,");\n"); break; case RESIZE: - (void) fprintf(fp, "\tresize("); - prvar(tn->u.node->lval, fp); + np = tn->u.node; dim = 0; for (sp = np->rval; sp; sp = sp->rval) - dim++; - (void) fprintf(fp, " %d,", dim); - for (np = np->rval; np; np = np->rval) - { - prexpr(np->lval, fp); - fprintf(fp, ", "); + dim++; + (void) fprintf(fp, "\tresize("); + prvar(np->lval, fp); + (void) fprintf(fp, ", %s[%d]", nameof(np->lval->opcode, forgetbits), + np->lval->constant); + (void) fprintf(fp, ", %d", dim); + for (sp = np->rval; sp; sp = sp->rval) { + (void) fprintf(fp, ", "); + prexpr(sp->lval, fp); } - (void) fprintf(fp, "0"); - (void) fprintf(fp, ");\n"); + (void) fprintf(fp, ");\n"); break; case NEXT: - (void) fprintf(fp, "\tpushnext(%d); goto L%d;\n",tn - tuples + 1,tn->u.target); + (void) fprintf(fp, + "\tpushnext(%d); goto L%d; N%d:;\n", + tn - tuples + 1, tn->u.target, tn - tuples + 1); break; case RESUME: @@ -652,7 +676,7 @@ FILE *fp; case STASH: for (np = tn->u.node; np; np = np->rval) - (void) fprintf(fp, "\tstash(%s, %d, %s[%d]);\n", + (void) fprintf(fp, "\tstash(%s, %d, %s+%d);\n", nameof(np->opcode, vartypes), np->constant, nameof(np->opcode, varstores), np->constant); @@ -660,42 +684,58 @@ FILE *fp; case RETRIEVE: for (np = tn->u.node; np; np = np->rval) - (void) fprintf(fp, "\tretrieve(&%s[%d], %s, %d);\n", - nameof(np->opcode, varstores), np->constant, - nameof(np->opcode, vartypes), - np->constant); + (void) fprintf(fp, "\tretrieve(%s+%d, %s, %d, %s[%d]);\n", + nameof(np->opcode, varstores), np->constant, + nameof(np->opcode, vartypes), + np->constant, + nameof(np->opcode, forgetbits), + np->constant); break; case IGNORE: for (np = tn->u.node; np; np = np->rval) (void) fprintf(fp,"\t%s[%d] = TRUE;\n", - nameof(np->lval->opcode, forgetbits), + nameof(np->opcode, forgetbits), np->constant); break; case REMEMBER: for (np = tn->u.node; np; np = np->rval) (void) fprintf(fp,"\t%s[%d] = FALSE;\n", - nameof(np->lval->opcode, forgetbits), + nameof(np->opcode, forgetbits), np->constant); break; case ABSTAIN: - (void) fprintf(fp, "\tabstained[%d-1] = FALSE;\n", tn->u.target); + (void) fprintf(fp, "\tabstained[%d-1] = TRUE;\n", tn->u.target); break; case REINSTATE: - (void) fprintf(fp, "\tabstained[%d-1] = TRUE;\n", tn->u.target); + (void) fprintf(fp, "\tabstained[%d-1] = FALSE;\n", tn->u.target); break; case ENABLE: for (np = tn->u.node; np; np = np->rval) - (void) fprintf(fp, "\t%s = TRUE;\n", enablers[np->constant-GETS]); + { + (void) fprintf(fp, + "\tint i;\n\n\tfor (i = 0; i < sizeof(linetype)/sizeof(int); i++)\n"); + (void) fprintf(fp, + "\t if (linetype[i] == %s)\n", enablers[np->constant-GETS]); + (void) fprintf(fp, + "\t\tabstained[i] = FALSE;\n"); + } break; case DISABLE: for (np = tn->u.node; np; np = np->rval) - (void) fprintf(fp, "\t%s = FALSE;\n", enablers[np->constant-GETS]); + { + (void) fprintf(fp, + "\tint i;\n\n\tfor (i = 0; i < sizeof(linetype)/sizeof(int); i++)\n"); + (void) fprintf(fp, + "\t if (linetype[i] == %s)\n", enablers[np->constant-GETS]); + (void) fprintf(fp, + "\t\tabstained[i] = TRUE;\n"); + } break; case GIVE_UP: @@ -703,238 +743,81 @@ FILE *fp; break; case WRITE_IN: - for (np = tn->u.node; np; np = np->rval) - { - np = tn->u.node; - (void) fprintf(fp,"\tif (!%s[%d])\n\t ", + for (np = tn->u.node; np; np = np->rval) { + if (np->lval->opcode == TAIL || np->lval->opcode == HYBRID) { + (void) fprintf(fp,"\tbinin("); + prvar(np->lval, fp); + (void) fprintf(fp, ", %s[%d]", nameof(np->lval->opcode, forgetbits), - np->constant); - if (np->lval->opcode == ONESPOT || np->lval->opcode == TWOSPOT) - { - prvar(np->lval, fp); - (void) fprintf(fp, " = pin()"); + np->lval->constant); + (void) fprintf(fp,");\n"); + } + else { + if (np->lval->opcode != SUB) { + sp = np->lval; + (void) fprintf(fp,"\t(void) assign((char*)&"); } - else - { - (void) fprintf(fp, "aput(pin(), "); - prvar(np->lval, fp); - (void) fprintf(fp, ")"); + else { + sp = np->lval->lval; + (void) fprintf(fp,"\t(void) assign("); } - (void) fprintf(fp, ";\n"); + prvar(np->lval, fp); + (void) fprintf(fp,", %s", nameof(sp->opcode, vartypes)); + (void) fprintf(fp,", %s[%d]", nameof(sp->opcode, forgetbits), + sp->constant); + (void) fprintf(fp,", pin());\n"); + } } break; case READ_OUT: for (np = tn->u.node; np; np = np->rval) { + if (np->lval->opcode == TAIL || np->lval->opcode == HYBRID) { + (void) fprintf(fp,"\tbinout("); + prvar(np->lval, fp); + (void) fprintf(fp,");\n"); + } + else { (void) fprintf(fp, "\tpout("); prexpr(np->lval, fp); (void) fprintf(fp, ");\n"); + } } break; + case COME_FROM: + (void) fprintf(fp,"\tgoto C%d;\n", tn->u.target); + break; + case SPLATTERED: + /* + fprintf(stderr,"compiling a splat... line = %d (%s)\n", + tn->lineno,textlines[tn->lineno]); + */ + (void) fprintf(fp,"\t(void) puts(\"%s\");\n", + nice_text(textlines[tn->lineno])); (void) fprintf(fp, - "(void) puts(\"%s\");\n", textlines[tn->lineno]); - (void) fprintf(fp, - "exit(%d);\n", tn->lineno); + "\texit(%d);\n", tn->lineno); break; default: - lose(tn - tuples + 1, E778); + lose(E778, tn - tuples + 1, (char *)NULL); break; } (void) fprintf(fp, " }\n"); -} -/************************************************************************* - * - * Driver code - * - **************************************************************************/ + comefrom: -void abend() -{ - lose(yylineno, E778); -} + /* if the statement that was just degenerated was a COME FROM target, + emit the code for the jump to the COME FROM. */ -main(argc, argv) -int argc; -char *argv[]; -{ - extern char *optarg; /* set by getopt */ - extern int optind; /* set by getopt */ - char buf[BUFSIZ], buf2[BUFSIZ]; - tuple *tp; - atom *op; - int c; - - while ((c = getopt(argc, argv, "dOC")) != EOF) - { - switch (c) - { - case 'd': - yydebug = 1; - break; - - case 'C': - clockface = TRUE; - break; - - case 'O': - dooptimize = TRUE; - break; - } + if (tn->comefrom && !make_cf_target) { + make_cf_target = 1; + emit(tuples + tn->comefrom - 1, fp); + make_cf_target = 0; } - - (void) signal(SIGSEGV, abend); - (void) signal(SIGBUS, abend); - - for (; optind < argc; optind++) - if (freopen(argv[optind], "r", stdin) == (FILE *)NULL) - lose(0, E777); - else - { - FILE *ifp, *ofp; - int maxabstain; - - /* zero out tuple and oblist storage */ - treset(); - - /* compile tuples from current input source */ - yyparse(); - - /* - * Now propagate type information up the expression tree. - * We need to do this because the unary-logical operations - * are sensitive to the type widths of their operands, so - * we have to generate different code depending on the - * deducible type of the operand. - */ - for (tp = tuples; tp < tuples + lineno; tp++) - if (tp->type == GETS || tp->type == RESIZE - || tp->type == FORGET || tp->type == RESUME) - typecast(tp->u.node); - - codecheck(); /* check for compile-time errors */ - - /* perform optimizations */ - if (dooptimize) - for (tp = tuples; tp < tuples + lineno; tp++) - if (tp->type == GETS || tp->type == RESIZE - || tp->type == FORGET || tp->type == RESUME) - optimize(tp->u.node); - - /* strip off the file extension */ - argv[optind][strlen(argv[optind]) - 2] = '\0'; - - /* set up the generated C output file name */ - (void) strcpy(buf, argv[optind]); - (void) strcat(buf, ".c"); - if ((ofp = fopen(buf, "w")) == (FILE *)NULL) - lose(0, E888); - - /* now substitute in tokens in the skeleton */ - if ((ifp = fopen(SKELETON, "r")) == (FILE *)NULL) - lose(0, E999); - buf[strlen(buf) - 2] = '\0'; - - while ((c = fgetc(ifp)) != EOF) - if (c != '$') - (void) fputc(c, ofp); - else switch(fgetc(ifp)) - { - case 'A': /* source name stem */ - (void) fputs(buf, ofp); - break; - - case 'B': /* # of source lines */ - (void) fprintf(ofp, "%d", lineno); - break; - - case 'C': /* initial abstentions */ - maxabstain = 0; - for (tp = tuples; tp < tuples + lineno; tp++) - if (tp->exechance == 0 && tp - tuples + 1 > maxabstain) - maxabstain = tp - tuples + 1; - if (maxabstain) - { - (void) fprintf(ofp, " = {"); - for (tp = tuples; tp < tuples + maxabstain; tp++) - (void) fprintf(ofp, "%d, ", !tp->exechance); - (void) fprintf(ofp, "}"); - } - break; - - case 'D': /* extern to intern map */ - if (nonespots) - { - (void) fprintf(ofp, - "static unsigned int onespots[%d];\n", - nonespots); - (void) fprintf(ofp, - "static bool oneforget[%d];\n", - nonespots); - } - if (ntwospots) - { - (void) fprintf(ofp, - "static unsigned int twospots[%d];\n", - ntwospots); - (void) fprintf(ofp, - "static bool twoforget[%d];\n", - ntwospots); - } - if (ntails) - { - (void) fprintf(ofp, - "static unsigned int *tails[%d];\n", - ntails); - (void) fprintf(ofp, - "static bool tailforget[%d];\n", - ntails); - } - if (nhybrids) - { - (void) fprintf(ofp, - "static unsigned int *hybrids[%d];\n", - nhybrids); - (void) fprintf(ofp, - "static bool hyforget[%d];\n", - nhybrids); - } - if (yydebug) - for (op = oblist; op < obdex; op++) - (void) fprintf(ofp, "/* %s %d -> %d */\n", - nameof(op->type, vartypes), - op->extindex, - op->intindex); - break; - - case 'E': - if (clockface) - (void) fprintf(ofp, "clockface(TRUE);"); - break; - - case 'F': /* degenerated code */ - for (tp = tuples; tp < tuples + lineno; tp++) - emit(tp, ofp); - break; - } - - (void) fclose(ifp); - (void) fclose(ofp); - - /* OK, now sic the C compiler on the results */ - if (!yydebug) - { - (void) sprintf(buf2, "cc %s.c -I. -L. -lick -o %s", buf, buf); - (void) system(buf2); - (void) strcat(buf, ".c"); - (void) unlink(buf); - } - } } /* feh.c ends here */ diff --git a/src/fiddle.c b/src/fiddle.c new file mode 100644 index 0000000..5f83d7f --- /dev/null +++ b/src/fiddle.c @@ -0,0 +1,245 @@ +/* + * fiddle.c -- functions that implement the five INTERCAL operators + * + * We link these to the compiler, too, in order to do constant folding + */ + +#include "sizes.h" + +unsigned int mingle(r, s) +register unsigned int r, s; +{ + if (Base == 2) { + r = ((r & 0x0000ff00) << 8) | (r & 0x000000ff); + r = ((r & 0x00f000f0) << 4) | (r & 0x000f000f); + r = ((r & 0x0c0c0c0c) << 2) | (r & 0x03030303); + r = ((r & 0x22222222) << 1) | (r & 0x11111111); + s = ((s & 0x0000ff00) << 8) | (s & 0x000000ff); + s = ((s & 0x00f000f0) << 4) | (s & 0x000f000f); + s = ((s & 0x0c0c0c0c) << 2) | (s & 0x03030303); + s = ((s & 0x22222222) << 1) | (s & 0x11111111); + return (r << 1) | s; + } + else { + unsigned int i, result = 0, fac = 1; + for (i = 0 ; i < Small_digits ; i++) { + result += fac * (s % Base); + s /= Base; + fac *= Base; + result += fac * (r % Base); + r /= Base; + fac *= Base; + } + return result; + } +} + +unsigned int iselect(r, s) +register unsigned int r, s; +{ + if (Base == 2) { + register unsigned int i = 1, t = 0; + while (s) { + if (s & i) { + t |= r & i; + s ^= i; + i <<= 1; + } + else { + s >>= 1; + r >>= 1; + } + } + return(t); + } + else { + unsigned int i, j, result = 0, fac, digit, ofac = 1; + for (j = Base - 1 ; j > 0 ; j--) { + fac = 1; + for (i = 0; i < Large_digits ; i++) { + if ((s / fac) % Base == j) { + digit = (r / fac) % Base; + if (digit) + result += ofac * (digit > j ? digit : j); + ofac *= Base; + } + fac *= Base; + } + } + return result; + } +} + +unsigned int whirl(len,p,n) +unsigned int len,p,n; +{ + unsigned int i, fac = 1, result = 0, d1, d2, dsave; + d1 = n % Base; + dsave = d1; + for (i = 1 ; i <= len ; i++) { + d2 = d1; + d1 = (i < len) ? (n /= Base, n % Base) : dsave; + if (d1 <= p) + result += fac * ((d2 < d1 || d2 > p) ? d1 : d2); + else + result += fac * ((d2 < d1 && d2 > p) ? d1 : d2); + fac *= Base; + } + return result; +} + +unsigned int and16(n) +unsigned int n; +{ + if (Base == 2) { + unsigned int m = (n >> 1); + if (n & 1) + m |= 0x8000; + return(m & n); + } + else { + return whirl(Small_digits,0,n); + } +} + +unsigned int or16(n) +unsigned int n; +{ + if (Base == 2) { + unsigned int m = (n >> 1); + if (n & 1) + m |= 0x8000; + return(m | n); + } + else { + return whirl(Small_digits,Base-1,n); + } +} + +unsigned int whirl16(p,n) +unsigned int p,n; +{ + return whirl(Small_digits,p,n); +} + +unsigned int and32(n) +unsigned int n; +{ + if (Base == 2) { + unsigned int m = (n >> 1); + if (n & 1) + m |= 0x80000000; + return(m & n); + } + else { + return whirl(Large_digits,0,n); + } +} + +unsigned int or32(n) +unsigned int n; +{ + if (Base == 2) { + unsigned int m = (n >> 1); + if (n & 1) + m |= 0x80000000; + return(m | n); + } + else { + return whirl(Large_digits,Base-1,n); + } +} + +unsigned int whirl32(p,n) +unsigned int p,n; +{ + return whirl(Large_digits,p,n); +} + +unsigned int xor(len,n) +unsigned int len,n; +{ + unsigned int i, fac = 1, result = 0, d1, d2, dsave; + d1 = n % Base; + dsave = d1; + for (i = 1 ; i <= len ; i++) { + d2 = d1; + d1 = (i < len) ? (n /= Base, n % Base) : dsave; + result += fac * ((Base + d1 - d2) % Base); + fac *= Base; + } + return result; +} + +unsigned int xor16(n) +unsigned int n; +{ + if (Base == 2) { + unsigned int m = (n >> 1); + if (n & 1) + m |= 0x8000; + return(m ^ n); + } + else { + return xor(Small_digits,n); + } +} + +unsigned int xor32(n) +unsigned int n; +{ + if (Base == 2) { + unsigned int m = (n >> 1); + if (n & 1) + m |= 0x80000000; + return(m ^ n); + } + else { + return xor(Large_digits,n); + } +} + +unsigned int fin(len,n) +unsigned int len,n; +{ + unsigned int i, fac = 1, result = 0, d1, d2, dsave; + d1 = n % Base; + dsave = d1; + for (i = 1 ; i <= len ; i++) { + d2 = d1; + d1 = (i < len) ? (n /= Base, n % Base) : dsave; + result += fac * ((d1 + d2) % Base); + fac *= Base; + } + return result; +} + +unsigned int fin16(n) +unsigned int n; +{ + if (Base == 2) { + unsigned int m = (n >> 1); + if (n & 1) + m |= 0x8000; + return(m ^ n); + } + else { + return fin(Small_digits,n); + } +} + +unsigned int fin32(n) +unsigned int n; +{ + if (Base == 2) { + unsigned int m = (n >> 1); + if (n & 1) + m |= 0x80000000; + return(m ^ n); + } + else { + return fin(Large_digits,n); + } +} + +/* fiddle.c */ diff --git a/src/ick-wrap.c b/src/ick-wrap.c new file mode 100644 index 0000000..771cbe0 --- /dev/null +++ b/src/ick-wrap.c @@ -0,0 +1,48 @@ +/* $A.c -- generated C-code file for INTERCAL program $A.i */ + +#include +#include + +extern unsigned int mingle(), iselect(); +extern unsigned int and16(), or16(), xor16(), and32(), or32(), xor32(); +extern unsigned int whirl16(), whirl32(), fin16(), fin32(); + +int lineno; + +static int abstained[$B]$C; +$D +$E + +main(argc,argv) +int argc; +char **argv; +{ + int skipto = 0; + + parseargs(argc,argv); + + /* set seed for random error generation */ +#ifdef USG + srand48(time((long *)0) + getpid()); +#else + srand(time((long *)0)); +#endif /* UNIX */ + + /* set up stash storage */ + stashinit(); + + $F + + /* degenerated code */ +$G + lose(E633, $B+1, (char *)0); + + /* generated switch for resumes */ + top: + switch(skipto) + { + $H + } +} + +/* Generated code for $A.i ends here */ diff --git a/src/ick.h b/src/ick.h new file mode 100644 index 0000000..30cfc58 --- /dev/null +++ b/src/ick.h @@ -0,0 +1,87 @@ +/* ick.h -- compilation types for intercal parser */ + +typedef int bool; +#define TRUE 1 +#define FALSE 0 + +/* + * We choose this value for maximum number of possible source lines on + * the theory that no human mind could grok more lines of INTERCAL than + * this and still retain any vestige of sanity. + */ +#define MAXLINES 1000 + +/* + * Similarly for maximum number of variables + */ +#define MAXVARS 100 + +/* + * Maximum supported statement types; should be equal to (COME_FROM - GETS + 1) + */ +#define MAXTYPES 17 + +typedef struct node_t +{ + int opcode; /* operator or type code */ + unsigned long constant; /* constant data attached */ + int width; /* is this 32-bit data? */ + struct node_t *lval, *rval; /* attached expression nodes */ +} node; + +typedef struct tuple_t +{ + unsigned int label; /* label # of this statement */ + unsigned int comefrom; /* if NZ, a COME FROM touches this */ + int exechance; /* chance of execution */ + unsigned int type; /* statement type */ + union + { + unsigned int target; /* for NEXT statements */ + node *node; /* attached expression node(s) */ + } u; + int lineno; /* for splatters*/ +} tuple; + +/* this maps the `external' name of a variable to an internal array index */ +typedef struct +{ + int type; + int extindex; + int intindex; +} +atom; + +typedef struct +{ + int value; + char *name; +} +assoc; + +extern atom oblist[MAXVARS], *obdex; +extern int nonespots, ntwospots, ntails, nhybrids; + +extern tuple tuples[MAXLINES]; + +extern char *enablers[MAXTYPES]; +extern assoc vartypes[]; + +/* the lexical analyzer keeps copies of the source logical lines */ +extern char *textlines[MAXLINES]; +extern int yylineno; + +extern unsigned int mingle(), iselect(); +extern unsigned int and16(), or16(), xor16(), and32(), or32(), xor32(); +extern unsigned int whirl16(), whirl32(), fin16(), fin32(); + +extern int yydebug; +extern int yylineno; +extern int politesse; + +/* compilation options */ +extern bool compile_only; /* just compile into C, don't run the linker */ + +extern int lineno; /* current source line number; lose() uses it */ + +/* ick.h ends here */ diff --git a/src/ick.y b/src/ick.y new file mode 100644 index 0000000..14c7a75 --- /dev/null +++ b/src/ick.y @@ -0,0 +1,349 @@ +/***************************************************************************** + +NAME + ick.y -- grammar for the INTERCAL language + +DESCRIPTION + This YACC grammar parses the INTERCAL language by designed by Don R. Woods +and James M. Lyon. There are two syntax extensions over the original +INTERCAL-72 language; the COME FROM statement, and the prefixed forms of the +WHIRL operator. + +*****************************************************************************/ + +%{ +#include +#include "sizes.h" +#include "ick.h" +#include "lose.h" + +#define yylex() lexer() + +extern node *newnode(), *cons(); +extern tuple *newtuple(); +extern unsigned int intern(); +extern int yylineno, traditional; + +static node *rlist; /* pointer to current right-hand node list */ +static node *llist; /* pointer to current left-hand node list */ +static node *np; /* variable for building node lists */ + +#define ACTION(x, nt, nn) {x = newtuple(); x->type = nt; x->u.node=nn;} +#define TARGET(x, nt, nn) {x = newtuple(); x->type = nt; x->u.target=nn;} +#define NEWFANGLED if (traditional) lose(E111,yylineno,(char*)NULL); else +%} + +%start program + +%union +{ + int numval; /* a numeric value */ + tuple *tuple; /* a code tuple */ + node *node; /* an expression-tree node */ +} + +/* + * Don't change this statement token list gratuitously! + * Some code in feh.c depends on GETS being the least + * statement type and on the order of the ones following. + */ +%token GETS RESIZE NEXT FORGET RESUME STASH RETRIEVE IGNORE REMEMBER ABSTAIN +%token REINSTATE DISABLE ENABLE GIVE_UP READ_OUT WRITE_IN COME_FROM + +%token DO PLEASE NOT MESH ONESPOT TWOSPOT TAIL HYBRID +%token MINGLE SELECT SPARK EARS SUB BY BADCHAR + +%token NUMBER UNARY OHOHSEVEN GERUND LABEL +%token INTERSECTION + +/* + * These are not tokens returned by the lexer, but they are used as + * tokens elsewhere. We define them here to insure that the values + * will not conflict with the other tokens. It is important that + * WHIRL through WHIRL5 be a continuous sequence. + */ +%token SPLATTERED TESTNZ EQUALS AND OR XOR FIN MESH32 +%token WHIRL WHIRL2 WHIRL3 WHIRL4 WHIRL5 + +%type expr varlist variable constant lvalue inlist outlist +%type subscr byexpr scalar array initem outitem sublist +%type unambig subscr1 sublist1 oparray osubscr osubscr1 +%type perform +%type please preftype + +%nonassoc EARS SPARK +%nonassoc HIGHPREC + +%% /* beginning of rules section */ + +/* A program description consists of a sequence of statements */ +program : /* EMPTY */ + | program command + ; + +/* + * Each command consists of an optional label, followed by a preamble, + * followed by an optional probability, followed by the statement body. + * Negative exechance values indicate initial abstentions, and will be + * made positive before code is emitted. + */ +command : please perform + {$2->label = 0; $2->exechance = $1 * 100;} + | please OHOHSEVEN perform + {$3->label = 0; $3->exechance = $1 * $2;} + | LABEL please perform + {$3->label = $1; $3->exechance = $2 * 100;} + | LABEL please OHOHSEVEN perform + {$4->label = $1; $4->exechance = $2 * $3;} + | error + {lose(E017, yylineno, (char *)NULL);} + ; + +/* There are two forms of preamble returned by the lexer */ +please : DO {$$ = 1;} + | DO NOT {$$ = -1;} + ; + +/* Here's how to parse statement bodies */ +perform : lvalue GETS expr {ACTION($$, GETS, cons(GETS,$1,$3));} + | array GETS byexpr {ACTION($$, RESIZE, cons(RESIZE,$1,$3));} + | LABEL NEXT {TARGET($$, NEXT, $1);} + | FORGET expr {ACTION($$, FORGET, $2);} + | RESUME expr {ACTION($$, RESUME, $2);} + | STASH varlist {ACTION($$, STASH, rlist);} + | RETRIEVE varlist {ACTION($$, RETRIEVE, rlist);} + | IGNORE varlist {ACTION($$, IGNORE, rlist);} + | REMEMBER varlist {ACTION($$, REMEMBER, rlist);} + | ABSTAIN LABEL {TARGET($$, ABSTAIN, $2);} + | ABSTAIN gerunds {ACTION($$, DISABLE, rlist);} + | REINSTATE LABEL {TARGET($$, REINSTATE, $2);} + | REINSTATE gerunds {ACTION($$, ENABLE, rlist);} + | WRITE_IN inlist {ACTION($$, WRITE_IN, $2);} + | READ_OUT outlist {ACTION($$, READ_OUT, $2);} + | GIVE_UP {ACTION($$, GIVE_UP, 0);} + | COME_FROM LABEL {NEWFANGLED {TARGET($$,COME_FROM,$2)}} + | BADCHAR {yyclearin; $$ = splat();} + | error {yyclearin; $$ = splat();} + ; + +/* gerund lists are used by ABSTAIN and REINSTATE */ +gerunds : GERUND + {rlist = np = newnode(); np->constant = $1;} + | gerunds INTERSECTION GERUND + { + np->rval = newnode(); + np = np->rval; + np->constant = $3; + } + ; + +/* OK, here's what a variable reference looks like */ +variable: scalar | array; + +lvalue : scalar | subscr; + +scalar : ONESPOT NUMBER + { + $$ = newnode(); + $$->opcode = ONESPOT; + $$->constant = intern(ONESPOT, $2); + } + | TWOSPOT NUMBER + { + $$ = newnode(); + $$->opcode = TWOSPOT; + $$->constant = intern(TWOSPOT, $2); + } + ; + +array : TAIL NUMBER + { + $$ = newnode(); + $$->opcode = TAIL; + $$->constant = intern(TAIL, $2); + } + | HYBRID NUMBER + { + $$ = newnode(); + $$->opcode = HYBRID; + $$->constant = intern(HYBRID, $2); + } + ; + +/* Array with unary operator is a special intermediate case; these + nodes will be rearranged when the subscript list is added */ +oparray : TAIL UNARY NUMBER + { + $$ = newnode(); + $$->opcode = $2; + $$->rval = newnode(); + $$->rval->opcode = TAIL; + $$->rval->constant = intern(TAIL, $3); + } + | HYBRID UNARY NUMBER + { + $$ = newnode(); + $$->opcode = $2; + $$->rval = newnode(); + $$->rval->opcode = HYBRID; + $$->rval->constant = intern(HYBRID, $3); + } + ; + +/* And a constant looks like this */ +constant: MESH NUMBER + { + /* enforce the 16-bit constant constraint */ + if ($2 > Max_small) + lose(E017, yylineno, (char *)NULL); + $$ = newnode(); + $$->opcode = MESH; + $$->constant = $2; + } + ; + +/* variable lists are used in STASH, RETRIEVE, IGNORE, REMEMBER */ +varlist : variable {rlist = np = $1;} + | varlist INTERSECTION variable {np = np->rval = $3; + /* newnode(); */ } + ; + +/* scalars and subscript exprs are permitted in WRITE IN lists */ +/* new: arrays are also permitted to allow for bitwise I/0 */ +initem : scalar | subscr | array; +inlist : initem INTERSECTION inlist {$$=cons(INTERSECTION,$1,$3);} + | initem {$$=cons(INTERSECTION,$1,0);} + +/* scalars, subscript exprs & constants are permitted in READ OUT lists */ +/* new: arrays are also permitted to allow for bitwise I/0 */ +outitem : scalar | subscr | constant | array; +outlist : outitem INTERSECTION outlist {$$=cons(INTERSECTION,$1,$3);} + | outitem {$$=cons(INTERSECTION,$1,0);} + ; + +/* Now the gnarly part -- expression syntax */ + +/* Support array dimension assignment */ +byexpr : expr BY byexpr {$$ = cons(BY, $1, $3);} + | expr {$$ = cons(BY, $1, 0);} + ; + +/* Support array subscripts (as lvalues) */ +subscr : subscr1 {$$ = $1;} + | array SUB sublist {$$ = cons(SUB, $1, $3);} + ; +subscr1 : array SUB sublist1 {$$ = cons(SUB, $1, $3);} + ; +sublist : unambig sublist {$$ = cons(INTERSECTION, $1, $2);} + | unambig sublist1 {$$ = cons(INTERSECTION, $1, $2);} + ; +sublist1: subscr1 {$$ = cons(INTERSECTION, $1, 0);} + | osubscr1 {$$ = cons(INTERSECTION, $1, 0);} + | unambig %prec HIGHPREC {$$ = cons(INTERSECTION, $1, 0);} + ; + +/* Unary operators with arrays act like arrays only in expressions */ +osubscr : osubscr1 {$$ = $1;} + | oparray SUB sublist + {$$ = $1; $$->rval = cons(SUB, $$->rval, $3);} + ; +osubscr1: oparray SUB sublist1 + {$$ = $1; $$->rval = cons(SUB, $$->rval, $3);} + ; + +/* here goes the general expession syntax */ +expr : unambig {$$ = $1;} + | unambig SELECT unambig {$$ = cons(SELECT, $1, $3);} + | unambig SELECT subscr {$$ = cons(SELECT, $1, $3);} + | unambig SELECT osubscr {$$ = cons(SELECT, $1, $3);} + | unambig MINGLE unambig {$$ = cons(MINGLE, $1, $3);} + | unambig MINGLE subscr {$$ = cons(MINGLE, $1, $3);} + | unambig MINGLE osubscr {$$ = cons(MINGLE, $1, $3);} + | subscr {$$ = $1;} + | osubscr {$$ = $1;} + ; + +preftype: MESH {$$=MESH; } | ONESPOT {$$=ONESPOT;} | TWOSPOT {$$=TWOSPOT;}; + +unambig : variable {$$ = $1;} + | constant {$$ = $1;} + + /* deal with the bizarre unary-op syntax */ + | preftype UNARY NUMBER + { + $$ = newnode(); + $$->opcode = $2; + $$->rval = newnode(); + $$->rval->opcode = $1; + if($1 == MESH) { + /* enforce the 16-bit constant constraint */ + if ($3 > Max_small) + lose(E017, yylineno, (char *)NULL); + $$->rval->constant = $3; + } + else { + $$->rval->constant = intern($1, $3); + } + } + + /* Now deal with the screwy unary-op interaction with grouping */ + | SPARK UNARY expr SPARK + { + $$ = newnode(); + $$->opcode = $2; + $$->rval = $3; + } + | EARS UNARY expr EARS + { + $$ = newnode(); + $$->opcode = $2; + $$->rval = $3; + } + + | SPARK expr SPARK {$$ = $2;} + | EARS expr EARS {$$ = $2;} + ; + +%% + +tuple *splat() +/* try to recover from an invalid statement. */ +{ + extern FILE *yyin; + tuple *sp; + int tok, i, lineno; + extern bool re_send_token; + + /* + * The idea + * here is to skip to the next DO, PLEASE or label, then unget that token. + * which we can do with a tricky flag on the lexer (re_send_token). + */ + lineno = yylineno; + + /* fprintf(stderr,"attempting to splat at line %d....\n",lineno); */ + for(i = 0,re_send_token = FALSE;;i++) { + tok = lexer(); + if (!tok) + { + re_send_token = TRUE; + tok = ' '; /* scanner must not see a NUL */ + break; + } + else if (tok == DO || tok == PLEASE || tok == LABEL) { + re_send_token = TRUE; + break; + } + } + /* + fprintf(stderr,"found %d on line %d after %d other tokens.\n", + tok,yylineno,i); + */ + + /* generate a placeholder tuple for the text line */ + TARGET(sp, SPLATTERED, 0); + sp->lineno = lineno; + return(sp); +} + +/* ick.y ends here */ diff --git a/lexer.l b/src/lexer.l similarity index 55% rename from lexer.l rename to src/lexer.l index fabdc4e..5a97890 100644 --- a/lexer.l +++ b/src/lexer.l @@ -1,18 +1,66 @@ %{ #include #include +#include +#include #include "ick.h" #include "y.tab.h" +#include "lose.h" + +#ifdef YYLINENO_BY_HAND +int yylineno = 1; +#endif /* YYLINENO_BY_HAND */ #ifdef MAIN YYSTYPE yylval; #endif /* MAIN */ char *textlines[MAXLINES]; +int politesse = 0; static char linebuf[YYLMAX]; static char *lineptr = linebuf; +bool re_send_token = FALSE; + +int lexer() +{ + static int tok = BADCHAR; + + if (re_send_token) + re_send_token = FALSE; + else + { + tok = yylex(); +#ifdef YYDEBUG + if (yydebug) + (void) (void) fprintf(stdout, "yylex: returning token %d\n", tok); +#endif /* YYDEBUG */ + } + +#ifdef YYDEBUG + if (yydebug) + (void) (void) fprintf(stdout, "lexer: returning token %d\n", tok); +#endif /* YYDEBUG */ + return(tok); +} + +int myatoi(text) +char *text; +{ +#define MAXTEXT 100 + static char buf[MAXTEXT]; + register int i; + + for(buf[i = 0] = '\0';*text && i < MAXTEXT;text++) { + if(isdigit(*text)) { + buf[i++] = *text; + } + } + buf[i] = '\0'; + return atoi(buf); +} + /* * The spectacular ugliness of INTERCAL syntax requires that the lexical * analyzer have two levels. One, embedded in the getc() function, handles @@ -26,14 +74,21 @@ static char *lineptr = linebuf; int getc(fp) FILE *fp; { - bool bangflag = FALSE; + static bool bangflag = FALSE; + static bool backflag = FALSE; if (bangflag) { bangflag = FALSE; - *lineptr++ = '!'; + /* *lineptr++ = '!'; */ return('.'); } + else if (backflag) /* converting ctrl-H (backspace) to two chars "^H" */ + { + backflag = FALSE; + /* *lineptr++ = '\010'; */ + return('H'); + } else { int c = fgetc(fp); @@ -43,27 +98,39 @@ FILE *fp; *lineptr = '\0'; return(EOF); } +#ifdef BACKSLASH_CONTINUATION else if (c == '\\') { do { c = fgetc(fp); +#ifdef YYLINENO_BY_HAND + if( c == '\n' ) yylineno++; +#endif /* YYLINENO_BY_HAND */ } while (c != '\\' && isspace(c)); } - +#endif /* BACKSLASH_CONTINUATION */ if (c == '!') { *lineptr++ = '!'; bangflag = TRUE; return(c = '\''); } + else if (c == '\010') /* convert ctrl-H (backspace) to + two chars "^" and "H" so lex can take it */ + { + *lineptr++ = '\010'; + backflag = TRUE; + return(c = '^'); + } else if (c == '\n') { - extern char *strdup(); - *lineptr = '\0'; lineptr = linebuf; - textlines[yylineno] = strdup(linebuf); + textlines[yylineno] = strcpy((char *)malloc(1+strlen(linebuf)),linebuf); +#ifdef YYLINENO_BY_HAND + yylineno++; +#endif /* YYLINENO_BY_HAND */ return('\n'); } else @@ -78,36 +145,46 @@ FILE *fp; %} W [\ \t\n]* -D [0-9][0-9]* +D [0-9][\ \t\n0-9]* %% -[0-9][0-9]* {yylval.numval = atoi(yytext); return(NUMBER);} +{D} {yylval.numval = myatoi(yytext); return(NUMBER);} \. {return(ONESPOT);} \: {return(TWOSPOT);} \, {return(TAIL);} \; {return(HYBRID);} \# {return(MESH);} +"C^H/" | \$ {return(MINGLE);} \~ {return(SELECT);} \& {yylval.numval = AND; return(UNARY);} V {yylval.numval = OR; return(UNARY);} +"V^H-" | \? {yylval.numval = XOR; return(UNARY);} +\^ {yylval.numval = FIN; return(UNARY);} +@ {yylval.numval = WHIRL; return(UNARY);} +[2-5]{W}@ {yylval.numval = WHIRL + myatoi(yytext) - 1; return(UNARY);} \' {return(SPARK);} \" {return(EARS);} -\({D}\) {yylval.numval = atoi(yytext + 1); return(LABEL);} +\({W}{D}\) {yylval.numval = myatoi(yytext); return(LABEL);} DO {return(DO);} -PLEASE {return(DO);} -PLEASE{W}DO {return(DO);} +PLEASE {politesse++; return(DO);} +DO{W}PLEASE {politesse++; return(DO);} +PLEASE{W}DO {politesse++; return(DO);} NOT {return(NOT);} -DON\'T {return(NOT);} +N\'T {return(NOT);} -\%{D} {yylval.numval = atoi(yytext + 1); return(OHOHSEVEN);} +\%{W}{D} {yylval.numval = myatoi(yytext); + if (yylval.numval && yylval.numval < 100) + return(OHOHSEVEN); + else + lose(E017, yylineno, (char *)NULL);} SUB {return(SUB);} BY {return(BY);} @@ -132,15 +209,17 @@ ABSTAIN{W}FROM {return(ABSTAIN);} ABSTAINING {yylval.numval = ABSTAIN; return(GERUND);} REINSTATE {return(REINSTATE);} REINSTATING {yylval.numval = REINSTATE; return(GERUND);} -\+ {return(INTERSECTION);} -GIVE{W}UP {return(GIVE_UP);} READ{W}OUT {return(READ_OUT);} +READING{W}OUT {yylval.numval = READ_OUT; return(GERUND);} WRITE{W}IN {return(WRITE_IN);} +WRITING{W}IN {yylval.numval = WRITE_IN; return(GERUND);} COME{W}FROM {return(COME_FROM);} COMING{W}FROM {yylval.numval = COME_FROM; return(GERUND);} +GIVE{W}UP {return(GIVE_UP);} -[\ \t][\ \t]* ; -\n {return(NEWLINE);} +\+ {return(INTERSECTION);} + +{W} ; . {yylval.numval = yytext[0]; return(BADCHAR);} @@ -164,8 +243,7 @@ main() } #endif /* MAIN */ -static int yywrap() +int yywrap() { return(EOF); } - diff --git a/src/lose.c b/src/lose.c new file mode 100644 index 0000000..d12389e --- /dev/null +++ b/src/lose.c @@ -0,0 +1,25 @@ +/* + * lose.c -- report INTERCAL compile- or run-time error + */ +/*LINTLIBRARY*/ +#include + +void lose(m, n, s) +char *m; +int n; +char *s; +{ + (void) fprintf(stderr, + "ICL%c%c%cI\t", + m[0], m[1], m[2]); + if (s) + (void) fprintf(stderr, m + 4, s, n); + else + (void) fprintf(stderr, m + 4, n); + (void) fprintf(stderr, " CORRECT SOURCE AND RESUBNIT\n"); + exit(atoi(m)); +} + +/* lose.c ends here */ + + diff --git a/src/lose.h b/src/lose.h new file mode 100644 index 0000000..c4e39f8 --- /dev/null +++ b/src/lose.h @@ -0,0 +1,126 @@ +/* lose.h --- error message strings + +/* + * Note: these error message texts, with one exception, are direct from + * the Princeton compiler (INTERCAL-72) sources (transmitted by Don Woods). + * The one exception is E632, which in INTERCAL-72 had the error message + * PROGRAM ATTEMPTED TO EXIT WITHOUT ERROR MESSAGE + * ESR's "THE NEXT STACK HAS RUPTURED!..." has been retained on the grounds + * that it is more obscure and much funnier. For context, find a copy of + * Joe Haldeman's SF short story "A !Tangled Web", first published in + * Analog magazine sometime in 1983 and later anthologized in the author's + * "Infinite Dreams" (Ace 1985). + */ +/* An undecodable statement has been encountered in the course of execution."*/ +#define E000 "000 %s\n\ + ON THE WAY TO %d\n" +/* An expression contains a syntax error. */ +#define E017 "017 DO YOU EXPECT ME TO FIGURE THIS OUT?\n\ + ON THE WAY TO %d\n" +/* Improper use has been made of statement identifiers. */ +#define E079 "079 PROGRAMMER IS INSUFFICIENTLY POLITE\n\ + ON THE WAY TO %d\n" +/* Improper use has been made of statement identifiers. */ +#define E099 "099 PROGRAMMER IS OVERLY POLITE\n\ + ON THE WAY TO %d\n" +/* Program has attempted 80 levels of NEXTing */ +#define E123 "123 PROGRAM HAS DISAPPEARED INTO THE BLACK LAGOON\n\ + ON THE WAY TO %d\n" +/* Program has attempted to transfer to a non-existent line label */ +#define E129 "129 PROGRAM HAS GOTTEN LOST\n\ + ON THE WAY TO WHO KNOWS WHERE\n" +/* An ABSTAIN or REINSTATE statement references a non-existent line label */ +#define E139 "139 I WASN'T PLANNING TO GO THERE ANYWAY\n\ + ON THE WAY TO %d\n" +/* A line label has been multiply defined. */ +#define E182 "182 YOU MUST LIKE THIS LABEL A LOT!\n\ + ON THE WAY TO %d\n" +/* An invalid line label has been encountered. */ +#define E197 "197 SO! 65535 LABELS AREN'T ENOUGH FOR YOU?\n\ + ON THE WAY TO %d\n" +/* An expression involves an unidentified variable. */ +#define E200 "200 NOTHING VENTURED, NOTHING GAINED\n\ + ON THE WAY TO %d\n" +/* An attempt has been made to give an array a dimension of zero. */ +#define E240 "240 ERROR HANDLER PRINTED SNIDE REMARK\n\ + ON THE WAY TO %d\n" +/* Invalid dimensioning information was supplied + * in defining or using an array. */ +#define E241 "241 VARIABLES MAY NOT BE STORED IN WEST HYPERSPACE\n\ + ON THE WAY TO %d\n" +/* A 32-bit value has been assigned to a 16-bit variable. */ +#define E275 "275 DON'T BYTE OFF MORE THAN YOU CAN CHEW\n\ + ON THE WAY TO %d\n" +/* A retrieval has been attempted for an unSTASHed value. */ +#define E436 "436 THROW STICK BEFORE RETRIEVING!\n\ + ON THE WAY TO %d\n" +/* A WRITE IN statement or interleave ($) operation + * has produced value requiring over 32 bits to represent. */ +#define E533 "533 YOU WANT MAYBE WE SHOULD IMPLEMENT 64-BIT VARIABLES?\n\ + ON THE WAY TO %d\n" +/* Insufficient data. (raised by reading past EOF) */ +#define E562 "562 I DO NOT COMPUTE\n\ + ON THE WAY TO %d\n" +/* Input data is invalid. */ +#define E579 "579 WHAT BASE AND/OR LANGUAGE INCLUDES %s?\n\ + ON THE WAY TO %d\n" +/* The expression of a RESUME statement evaluated to #0. */ +#define E621 "621 ERROR TYPE 621 ENCOUNTERED\n\ + ON THE WAY TO %d\n" +/* Program execution terminated via a RESUME statement instead of GIVE UP. */ +#define E632 "632 THE NEXT STACK RUPTURES. ALL DIE. OH, THE EMBARRASSMENT!\n\ + ON THE WAY TO %d\n" +/* Execution has passed beyond the last statement of the program. */ +#define E633 "633 PROGRAM FELL OFF THE EDGE\n\n\ + ON THE WAY TO THE NEW WORLD\n" +/* A compiler error has occurred (see section 8.1). */ +#define E774 "774 RANDOM COMPILER BUG\n\ + ON THE WAY TO %d\n" +/* An unexplainable compiler error has occurred (see J. Lyon or D. Woods). */ +#define E778 "778 UNEXPLAINED COMPILER BUG\n\ + ON THE WAY TO %d\n" + +/* + * These errors are unique to C-INTERCAL. They ought to be documented in + * the revised manual. + */ +/* You tried to use a C-INTERCAL extension with the `traditional' flag on */ +#define E111 "111 COMMUNIST PLOT DETECTED, COMPILER IS SUICIDING\n\ + ON THE WAY TO %d\n" +/* Cannot find the magically included system library */ +#define E127 "127 SAYING 'ABRACADABRA' WITHOUT A MAGIC WAND WON'T DO YOU ANY GOOD\n\ + ON THE WAY TO THE CLOSET\n" +/* Out of stash space */ +#define E222 "222 BUMMER, DUDE!\n\ + ON THE WAY TO %d\n" +/* Too many variables. */ +#define E333 "333 YOU CAN'T HAVE EVERYTHING, WHERE WOULD YOU PUT IT?\n\ + ON THE WAY TO %d\n" +/* A COME FROM statement references a non-existent line label. */ +#define E444 "444 IT CAME FROM BEYOND SPACE\n\ + ON THE WAY TO %d\n" +/* More than one COME FROM references the same label. */ +#define E555 "555 FLOW DIAGRAM IS EXCESSIVELY CONNECTED\n\ + ON THE WAY TO %d\n" +/* Too many source lines. */ +#define E666 "666 COMPILER HAS INDIGESTION\n\ + ON THE WAY TO %d\n" +/* No such source file. */ +#define E777 "777 A SOURCE IS A SOURCE, OF COURSE, OF COURSE\n\ + ON THE WAY TO %d\n" +/* Can't open C output file */ +#define E888 "888 I HAVE NO FILE AND I MUST SCREAM\n\ + ON THE WAY TO %d\n" +/* Can't open C skeleton file. */ +#define E999 "999 NO SKELETON IN MY CLOSET, WOE IS ME!\n\ + ON THE WAY TO %d\n" +/* Source file name with invalid extension (use .i or .[3-7]i). */ +#define E998 "998 EXCUSE ME,\n\ + YOU MUST HAVE ME CONFUSED WITH SOME OTHER COMPILER\n" +/* Illegal possession of a controlled unary operator. */ +#define E997 "997 ILLEGAL POSSESSION OF A CONTROLLED UNARY OPERATOR.\n\ + ON THE WAY TO %d\n" + +extern void lose(); + +/* lose.h ends here */ diff --git a/src/numerals.c b/src/numerals.c new file mode 100644 index 0000000..0d816fb --- /dev/null +++ b/src/numerals.c @@ -0,0 +1,112 @@ +/* + * numeral.c -- internationalization support for INTERCAL input. + * + * After release 0.5, I wrote: + * + * 2. (ESR) Input format internationalization -- allow WRITE IN input digits in + * major languages such as Nahuatl, Tagalog, Sanskrit, and Basque. + * + * The twisted loons in the alt.folklore.computers crowd loved this + * idea, and I actually got sent digit lists for Nahuatl, Tagalog, + * Sanskrit, and Basque -- also, Kwakiutl, Georgian, Ojibwe. Albanian, + * and Volap\"uk. I've left out Albanian (didn't want to keep track + * of the dipthong diacritical) and Ojibwe (no zero digit). So: + * Nahuatl, Tagalog, Sanskrit, Basque, Georgian, Kwakiutl, and + * Volap\"uk are now supported in addition to English. */ + +numeral numerals[] = +{ +/* English */ + "OH", 0, + "ZERO", 0, + "ONE", 1, + "TWO", 2, + "THREE", 3, + "FOUR", 4, + "FIVE", 5, + "SIX", 6, + "SEVEN", 7, + "EIGHT", 8, + "NINE", 9, + "NINER", 9, /* For all you junior birdmen */ +/* Sanskrit */ + "SUTYA", 0, /* Retroflex s, pronounced halfway to sh */ + "SHUTYA", 0, + "EKA", 1, + "DVI", 2, + "TRI", 3, + "CHATUR", 4, + "PANCHAN", 5, + "SHASH", 6, + "SAPTAM", 7, + "ASHTAN", 8, + "NAVAN", 9, +/* Basque */ + "ZEROA", 0, + "BAT", 1, + "BI", 2, + "HIRO", 3, + "LAU", 4, + "BORTZ", 5, + "SEI", 6, + "ZAZPI", 7, + "ZORTZI", 8, + "BEDERATZI", 9, +/* Tagalog */ + "WALA", 0, + "ISA", 1, + "DALAWA", 2, + "TATLO", 3, + "APAT", 4, + "LIMA", 5, + "ANIM", 6, + "PITO", 7, + "WALO", 8, + "SIYAM", 9, +/* Classical Nahuatl */ + "AHTLE", 0, /* Actually `nothing'; no separate zero word is known */ + "CE", 1, + "OME", 2, + "IEI", 3, + "NAUI", 4, + "NACUILI", 5, + "CHIQUACE", 6, + "CHICOME", 7, + "CHICUE", 8, + "CHICUNAUI", 9, +/* Georgian */ + "NULI", 0, + "ERTI", 1, + "ORI", 2, + "SAMI", 3, + "OTXI", 4, + "XUTI", 5, + "EKSVI", 6, + "SHVIDI", 7, + "RVA", 8, + "CXRA", 9, +/* Kwakiutl (technically, Kwak'wala) */ + "KE'YOS", 0, /* Actually `nothing'; no separate zero word is known */ + "'NEM", 1, + "MAL'H", 2, + "YUDEXW", 3, + "MU", 4, + "SEK'A", 5, + "Q'ETL'A", 6, + "ETLEBU", 7, + "MALHGWENALH", 8, + "'NA'NE'MA", 9, +/* Volap\"uk */ + "NOS", 0, + "BAL", 1, + "TEL", 2, + "KIL", 3, + "FOL", 4, + "LUL", 5, + "M\\\"AL", 6, + "VEL", 7, + "J\\\"OL", 8, + "Z\\\"UL", 9, +}; + +/* numeral.c ends here */ diff --git a/src/perpetrate.c b/src/perpetrate.c new file mode 100644 index 0000000..b930300 --- /dev/null +++ b/src/perpetrate.c @@ -0,0 +1,399 @@ +/**************************************************************************** + +NAME + perpetrate.c -- main routine for C-INTERCAL compiler. + +DESCRIPTION + This is where all the dirty work begins and ends. + +****************************************************************************/ +/*LINTLIBRARY */ +#include +#include +#include "ick.h" +#include "y.tab.h" +#include "lose.h" + +#ifndef ICKINCLUDEDIR +#define ICKINCLUDEDIR "/usr/local/include" +#endif +#ifndef ICKLIBDIR +#define ICKLIBDIR "/usr/local/lib" +#endif +#ifndef CC +#define CC "cc" +#endif + +/* compilation options */ +bool dooptimize; /* do optimizations? (controlled by -O) */ +bool clockface; /* set up output to do IIII for IV */ +bool compile_only; /* just compile into C, don't run the linker */ +bool traditional; /* insist on strict INTERCAL-72 conformance */ + +#define SKELETON "ick-wrap.c" +#define SYSLIB "syslib.i" + +/* numeric base defaults, exported to other files */ +int Base = 2; +int Small_digits = 16; +int Large_digits = 32; +unsigned int Max_small = 0xffff; +unsigned int Max_large = 0xffffffff; + +int lineno; /* current source line number; lose() uses it */ + +/* currently supported numeric bases, not exported */ +static int maxbase = 7; +static int smallsizes[8] = {0, 0, 16, 10, 8, 6, 6, 5}; +static unsigned int maxsmalls[8] = + {0, 0, 65535, 59048, 65535, 15624, 46655, 16806}; + +static char *compiler; + +atom oblist[MAXVARS], *obdex; +int nonespots, ntwospots, ntails, nhybrids; + +tuple tuples[MAXLINES]; + +static void abend(int signim) +{ + lose(E778, yylineno, (char *)NULL); +} + +main(argc, argv) +int argc; +char *argv[]; +{ + extern char *optarg; /* set by getopt */ + extern int optind; /* set by getopt */ + char buf[BUFSIZ], buf2[BUFSIZ], *chp, *strrchr(); + tuple *tp; + atom *op; + int c; + char *includedir, *libdir, *getenv(); + FILE *ifp, *ofp; + int maxabstain; + bool needsyslib; + void print_usage(); + + if (!(includedir = getenv("ICKINCLUDEDIR"))) + includedir = ICKINCLUDEDIR; + if (!(libdir = getenv("ICKLIBDIR"))) + libdir = ICKLIBDIR; + if (!(compiler = getenv("CC"))) + compiler = CC; + + while ((c = getopt(argc, argv, "cdtOC@")) != EOF) + { + switch (c) + { + case 'c': + compile_only = 1; + break; + + case 'd': + yydebug = compile_only = 1; + break; + + case 'C': + clockface = TRUE; + break; + + case 't': + traditional = 1; + break; + + case 'O': + dooptimize = TRUE; + break; + + case '?': + default: + case '@': + print_usage(argv[0],"cdtCO"); + exit(1); + break; + } + } + + (void) signal(SIGSEGV, abend); +#ifdef SIGBUS + (void) signal(SIGBUS, abend); +#endif /* SIGBUS */ + + (void) sprintf(buf2,"%s/%s",includedir,SKELETON); + + /* now substitute in tokens in the skeleton */ + if ((ifp = fopen(buf2, "r")) == (FILE *)NULL) + lose(E999, 0, (char *)NULL); + buf[strlen(buf) - 2] = '\0'; + + for (; optind < argc; optind++) + { + if (freopen(argv[optind], "r", stdin) == (FILE *)NULL) + lose(E777, 0, (char *)NULL); + else + { + /* strip off the file extension */ + if(!(chp = strrchr(argv[optind],'.'))) + { + lose(E998, 0, (char *)NULL); + } + *chp++ = '\0'; + + /* determine the file type from the extension */ + while (strcmp(chp,"i")) + { + long strtol(); + Base = strtol(chp,&chp,10); + if (Base < 2 || Base > maxbase) + lose(E998, 0, (char *)NULL); + else if (traditional && Base != 2) + lose(E111, 0, (char *)NULL); + Small_digits = smallsizes[Base]; + Large_digits = 2 * Small_digits; + Max_small = maxsmalls[Base]; + if (Max_small == 0xffff) + Max_large = 0xffffffff; + else + Max_large = (Max_small + 1) * (Max_small + 1) - 1; + } + + /* zero out tuple and oblist storage */ + treset(); + politesse = 0; + + /* compile tuples from current input source */ + yyparse(); + + /* + * Miss Manners lives. + */ + if (yylineno > 2) + if (politesse == 0 || yylineno / politesse > 5) + lose(E079, yylineno, (char *)NULL); + else if (yylineno / politesse < 3) + lose(E099, yylineno, (char *)NULL); + + /* + * check if we need to magically include the system library + */ + needsyslib = FALSE; + for (tp = tuples; tp < tuples + lineno; tp++) { + /* + * If some label in the (1000)-(2000) range is defined, + * then clearly the syslib is already there, so we + * can stop searching and won't need the syslib. + */ + if (tp->label >= 1000 && tp->label <= 1999) { + needsyslib = FALSE; + break; + } + /* + * If some label in the (1000)-(2000) range is being + * called, we might need the system library. + */ + if (tp->type == NEXT && tp->u.target >= 1000 && + tp->u.target <= 1999 ) + needsyslib = TRUE; + } + if ( needsyslib ) { + (void) sprintf(buf2, "%s/%s", ICKLIBDIR, SYSLIB); + if ( freopen(buf2, "r", stdin) == (FILE*) NULL ) { + lose(E127, 0, (char*) NULL); + } + yyparse(); + } + + /* + * Now propagate type information up the expression tree. + * We need to do this because the unary-logical operations + * are sensitive to the type widths of their operands, so + * we have to generate different code depending on the + * deducible type of the operand. + */ + for (tp = tuples; tp < tuples + lineno; tp++) + if (tp->type == GETS || tp->type == RESIZE + || tp->type == FORGET || tp->type == RESUME) + typecast(tp->u.node); + + codecheck(); /* check for compile-time errors */ + + /* perform optimizations */ + if (dooptimize) + for (tp = tuples; tp < tuples + lineno; tp++) + if (tp->type == GETS || tp->type == RESIZE + || tp->type == FORGET || tp->type == RESUME) + optimize(tp->u.node); + + /* set up the generated C output file name */ + (void) strcpy(buf, argv[optind]); + (void) strcat(buf, ".c"); + if ((ofp = fopen(buf, "w")) == (FILE *)NULL) + lose(E888, 0, (char *)NULL); + + fseek(ifp,0L,0); /* rewind skeleton file */ + + while ((c = fgetc(ifp)) != EOF) + if (c != '$') + (void) fputc(c, ofp); + else switch(fgetc(ifp)) + { + case 'A': /* source name stem */ + (void) fputs(argv[optind], ofp); + break; + + case 'B': /* # of source lines */ + (void) fprintf(ofp, "%d", lineno); + break; + + case 'C': /* initial abstentions */ + maxabstain = 0; + for (tp = tuples; tp < tuples + lineno; tp++) + if (tp->exechance <= 0 && tp - tuples + 1 > maxabstain) + maxabstain = tp - tuples + 1; + if (maxabstain) + { + (void) fprintf(ofp, " = {"); + for (tp = tuples; tp < tuples + maxabstain; tp++) + if (tp->exechance > 0) + (void) fprintf(ofp, "0, "); + else { + (void) fprintf(ofp, "1, "); + tp->exechance = -tp->exechance; + } + (void) fprintf(ofp, "}"); + } + break; + + case 'D': /* linetypes array for abstention handling */ + maxabstain = 0; + for (tp = tuples; tp < tuples + lineno; tp++) + if (tp->type == ENABLE || tp->type == DISABLE) + maxabstain++; + if (maxabstain) + { + int i; + + (void) fprintf(ofp, "#define UNKNOWN\t\t0\n"); + for (i = 0; i < sizeof(enablers)/sizeof(char *); i++) + (void) fprintf(ofp, + "#define %s\t%d\n", + enablers[i], i+1); + + (void) fprintf(ofp, "int linetype[] = {\n"); + for (tp = tuples; tp < tuples + lineno; tp++) + if (tp->type >= GETS && tp->type <= COME_FROM) + (void) fprintf(ofp, + " %s,\n", + enablers[tp->type - GETS]); + else + (void) fprintf(ofp, " UNKNOWN,\n"); + (void) fprintf(ofp, "};\n"); + } + break; + + case 'E': /* extern to intern map */ + (void) fprintf(ofp,"int Base = %d;\n",Base); + (void) fprintf(ofp,"int Small_digits = %d;\n", + Small_digits); + (void) fprintf(ofp,"int Large_digits = %d;\n", + Large_digits); + (void) fprintf(ofp,"unsigned int Max_small = 0x%x;\n", + Max_small); + (void) fprintf(ofp,"unsigned int Max_large = 0x%x;\n", + Max_large); + if (nonespots) + { + (void) fprintf(ofp, + "static type16 onespots[%d];\n", + nonespots); + (void) fprintf(ofp, + "static bool oneforget[%d];\n", + nonespots); + } + if (ntwospots) + { + (void) fprintf(ofp, + "static type32 twospots[%d];\n", + ntwospots); + (void) fprintf(ofp, + "static bool twoforget[%d];\n", + ntwospots); + } + if (ntails) + { + (void) fprintf(ofp, + "static array tails[%d];\n", + ntails); + (void) fprintf(ofp, + "static bool tailforget[%d];\n", + ntails); + } + if (nhybrids) + { + (void) fprintf(ofp, + "static array hybrids[%d];\n", + nhybrids); + (void) fprintf(ofp, + "static bool hyforget[%d];\n", + nhybrids); + } + if (yydebug | compile_only) + for (op = oblist; op < obdex; op++) + (void) fprintf(ofp, " /* %s %d -> %d */\n", + nameof(op->type, vartypes), + op->extindex, + op->intindex); + break; + + case 'F': + if (clockface) + (void) fprintf(ofp, "clockface(TRUE);"); + break; + + case 'G': /* degenerated code */ + for (tp = tuples; tp < tuples + lineno; tp++) + emit(tp, ofp); + break; + + case 'H': + for (tp = tuples; tp < tuples + lineno; tp++) + if (tp->type == NEXT) + (void) fprintf(ofp, + "\tcase %d: goto N%d; break;\n", + tp - tuples + 1, tp - tuples + 1); + break; + } + + (void) fclose(ofp); + + /* OK, now sic the C compiler on the results */ + if (!compile_only) + { + (void) sprintf(buf2, + "%s %s -I%s -L%s -lick -o %s", + compiler, buf, includedir, libdir, + argv[optind]); + (void) system(buf2); + (void) unlink(buf); + } + } + } + (void) fclose(ifp); +} + +void print_usage(prog,options) +char *prog, *options; +{ + fprintf(stderr,"Usage: %s [-%s] [ ... ]\n",prog,options); + fprintf(stderr,"\t-c\t:compile INTERCAL to C, but don't compile C\n"); + fprintf(stderr,"\t-d\t:print debugging information (implies -c)\n"); + fprintf(stderr,"\t-t\t:traditional mode, accept only INTERCAL-72\n"); + fprintf(stderr,"\t-C\t:clockface output (e.g. use IIII instead of IV)\n"); + fprintf(stderr,"\t-O\t:attempt to optimize generated code\n"); + fprintf(stderr,"\t\tINTERCAL source file(s) (use extension .i)\n"); + fprintf(stderr,"\t\teach file produces a separate output program.\n"); +} + +/* perpetrate.c ends here */ diff --git a/src/sizes.h b/src/sizes.h new file mode 100644 index 0000000..811cc57 --- /dev/null +++ b/src/sizes.h @@ -0,0 +1,7 @@ +/* sizes.h -- constants defining the numeric base for Intercal variations */ + +extern int Base; +extern int Small_digits; +extern int Large_digits; +extern unsigned int Max_small; +extern unsigned int Max_large; -- 2.43.0